From: "Štěpán Němec" <stepnem@gmail.com>
To: 39980@debbugs.gnu.org
Subject: bug#39980: [PATCH] gnus-shorten-url: Improve and avoid args-out-of-range error
Date: Sun, 8 Mar 2020 10:06:30 +0100 [thread overview]
Message-ID: <20200308090630.41238-1-stepnem@gmail.com> (raw)
'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, reusing existing helper function.
* lisp/vc/ediff-init.el
(ediff-truncate-string-left): Rename to 'string-truncate-left'.
* lisp/emacs-lisp/subr-x.el (string-truncate-left): Move here.
* lisp/vc/ediff-mult.el (ediff-meta-insert-file-info1) (ediff-draw-dir-diffs):
'ediff-draw-dir-diffs' renamed to 'string-truncate-left'.
* lisp/gnus/gnus-sum.el (gnus-shorten-url): Fix args-out-of-range
error, don't drop #fragments, use 'string-truncate-left'.
---
lisp/emacs-lisp/subr-x.el | 8 ++++++++
lisp/gnus/gnus-sum.el | 14 +++++++-------
lisp/vc/ediff-init.el | 10 ----------
lisp/vc/ediff-mult.el | 10 ++++++----
4 files changed, 21 insertions(+), 21 deletions(-)
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 044c9aada0..baf20131cc 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -236,6 +236,14 @@ string-trim
TRIM-LEFT and TRIM-RIGHT default to \"[ \\t\\n\\r]+\"."
(string-trim-left (string-trim-right string trim-right) trim-left))
+(defsubst 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)))))))
+
(defsubst string-blank-p (string)
"Check whether STRING is either empty or only whitespace.
The following characters count as whitespace here: space, tab, newline and
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index a47e657623..6f367692dd 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -9494,15 +9494,15 @@ gnus-collect-urls
(delete-dups urls)))
(defun gnus-shorten-url (url max)
- "Return an excerpt from URL."
+ "Return an excerpt from URL not exceeding MAX characters."
(if (<= (length url) max)
url
- (let ((parsed (url-generic-parse-url url)))
- (concat (url-host parsed)
- "..."
- (substring (url-filename parsed)
- (- (length (url-filename parsed))
- (max (- max (length (url-host parsed))) 0)))))))
+ (let* ((parsed (url-generic-parse-url url))
+ (host (url-host parsed))
+ (rest (concat (url-filename parsed)
+ (when-let ((target (url-target parsed)))
+ (concat "#" target)))))
+ (concat host (string-truncate-left rest (- max (length host)))))))
(defun gnus-summary-browse-url (&optional external)
"Scan the current article body for links, and offer to browse them.
diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el
index cbd8c0d322..c7498064dc 100644
--- a/lisp/vc/ediff-init.el
+++ b/lisp/vc/ediff-init.el
@@ -1524,16 +1524,6 @@ ediff-strip-last-dir
(setq dir (substring dir 0 pos)))
(ediff-abbreviate-file-name (file-name-directory dir))))
-(defun ediff-truncate-string-left (str newlen)
- ;; leave space for ... on the left
- (let ((len (length str))
- substr)
- (if (<= len newlen)
- str
- (setq newlen (max 0 (- newlen 3)))
- (setq substr (substring str (max 0 (- len 1 newlen))))
- (concat "..." substr))))
-
(defsubst ediff-nonempty-string-p (string)
(and (stringp string) (not (string= string ""))))
diff --git a/lisp/vc/ediff-mult.el b/lisp/vc/ediff-mult.el
index fee87e8352..5dcb42eb64 100644
--- a/lisp/vc/ediff-mult.el
+++ b/lisp/vc/ediff-mult.el
@@ -113,6 +113,8 @@ ediff-mult
(require 'ediff-wind)
(require 'ediff-util)
+(eval-when-compile
+ (require 'subr-x)) ; string-truncate-left
;; meta-buffer
(ediff-defvar-local ediff-meta-buffer nil "")
@@ -1172,7 +1174,7 @@ ediff-meta-insert-file-info1
;; abbreviate the file name, if file exists
(if (and (not (stringp fname)) (< file-size -1))
"-------" ; file doesn't exist
- (ediff-truncate-string-left
+ (string-truncate-left
(ediff-abbreviate-file-name fname)
max-filename-width)))))))
@@ -1266,7 +1268,7 @@ ediff-draw-dir-diffs
(if (= (mod membership-code ediff-membership-code1) 0) ; dir1
(let ((beg (point)))
(insert (format "%-27s"
- (ediff-truncate-string-left
+ (string-truncate-left
(ediff-abbreviate-file-name
(if (file-directory-p (concat dir1 file))
(file-name-as-directory file)
@@ -1281,7 +1283,7 @@ ediff-draw-dir-diffs
(if (= (mod membership-code ediff-membership-code2) 0) ; dir2
(let ((beg (point)))
(insert (format "%-26s"
- (ediff-truncate-string-left
+ (string-truncate-left
(ediff-abbreviate-file-name
(if (file-directory-p (concat dir2 file))
(file-name-as-directory file)
@@ -1295,7 +1297,7 @@ ediff-draw-dir-diffs
(if (= (mod membership-code ediff-membership-code3) 0) ; dir3
(let ((beg (point)))
(insert (format " %-25s"
- (ediff-truncate-string-left
+ (string-truncate-left
(ediff-abbreviate-file-name
(if (file-directory-p (concat dir3 file))
(file-name-as-directory file)
--
2.25.1
next reply other threads:[~2020-03-08 9:06 UTC|newest]
Thread overview: 19+ messages / expand[flat|nested] mbox.gz Atom feed top
2020-03-08 9:06 Štěpán Němec [this message]
2020-03-14 11:41 ` bug#39980: [PATCH] gnus-shorten-url: Improve and avoid args-out-of-range error Lars Ingebrigtsen
2020-03-14 16:34 ` Štěpán Němec
2020-03-14 18:03 ` Lars Ingebrigtsen
2020-03-14 18:12 ` Štěpán Němec
2020-03-14 18:15 ` Eli Zaretskii
2020-03-28 14:17 ` Štěpán Němec
2020-04-02 11:01 ` Lars Ingebrigtsen
2020-04-12 9:53 ` Štěpán Němec
2020-04-12 10:33 ` Eli Zaretskii
2020-04-12 10:49 ` Štěpán Němec
2020-04-12 11:05 ` Eli Zaretskii
2020-04-12 11:47 ` Štěpán Němec
2020-04-12 13:38 ` Eli Zaretskii
2020-04-12 14:13 ` Štěpán Němec
2020-04-12 14:35 ` Eli Zaretskii
2020-04-12 20:02 ` Štěpán Němec
2020-04-13 4:26 ` Eli Zaretskii
2020-04-13 10:31 ` Štěpán Němec
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20200308090630.41238-1-stepnem@gmail.com \
--to=stepnem@gmail.com \
--cc=39980@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).