mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-22 21:50:45 -08:00
gnus-shorten-url: Improve and avoid args-out-of-range error
'gnus-shorten-url' (used by 'gnus-summary-browse-url') ignored fragment identifiers and didn't check substring bounds, in some cases leading to runtime errors, e.g.: (gnus-shorten-url "https://some.url.with/path/and#also_a_long_target" 40) ;; => Lisp error: (args-out-of-range "/path/and" -18 nil) This commit makes it account for #fragments and fixes faulty string computation. (bug#39980) Do not merge to master, where the helper is put to subr-x.el. * lisp/gnus/gnus-sum.el (gnus--string-truncate-left): New helper function (copied from 'ediff-truncate-string-left'). (gnus-shorten-url): Use it and don't drop #fragments.
This commit is contained in:
parent
1dfc497fac
commit
81d07da788
1 changed files with 17 additions and 7 deletions
|
|
@ -9493,16 +9493,26 @@ The 1st element is the button named by `gnus-collect-urls-primary-text'."
|
||||||
(push primary urls))
|
(push primary urls))
|
||||||
(delete-dups urls)))
|
(delete-dups urls)))
|
||||||
|
|
||||||
|
;; cf. `ediff-truncate-string-left', to become `string-truncate-left'
|
||||||
|
;; in Emacs 28
|
||||||
|
(defun gnus--string-truncate-left (string length)
|
||||||
|
"Truncate STRING to LENGTH, replacing initial surplus with \"...\"."
|
||||||
|
(let ((strlen (length string)))
|
||||||
|
(if (<= strlen length)
|
||||||
|
string
|
||||||
|
(setq length (max 0 (- length 3)))
|
||||||
|
(concat "..." (substring string (max 0 (- strlen 1 length)))))))
|
||||||
|
|
||||||
(defun gnus-shorten-url (url max)
|
(defun gnus-shorten-url (url max)
|
||||||
"Return an excerpt from URL."
|
"Return an excerpt from URL not exceeding MAX characters."
|
||||||
(if (<= (length url) max)
|
(if (<= (length url) max)
|
||||||
url
|
url
|
||||||
(let ((parsed (url-generic-parse-url url)))
|
(let* ((parsed (url-generic-parse-url url))
|
||||||
(concat (url-host parsed)
|
(host (url-host parsed))
|
||||||
"..."
|
(rest (concat (url-filename parsed)
|
||||||
(substring (url-filename parsed)
|
(when-let ((target (url-target parsed)))
|
||||||
(- (length (url-filename parsed))
|
(concat "#" target)))))
|
||||||
(max (- max (length (url-host parsed))) 0)))))))
|
(concat host (gnus--string-truncate-left rest (- max (length host)))))))
|
||||||
|
|
||||||
(defun gnus-summary-browse-url (&optional external)
|
(defun gnus-summary-browse-url (&optional external)
|
||||||
"Scan the current article body for links, and offer to browse them.
|
"Scan the current article body for links, and offer to browse them.
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue