From ad95727d0858767f14b27f412b12281a1a279870 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=C5=A0t=C4=9Bp=C3=A1n=20N=C4=9Bmec?= Date: Tue, 14 Apr 2020 11:08:50 +0200 Subject: [PATCH] string-truncate-left: Use string-width and truncate-string-ellipsis https://lists.gnu.org/archive/html/emacs-devel/2020-04/msg00734.html * lisp/emacs-lisp/subr-x.el (string-truncate-left): Rename and move... * lisp/international/mule-util.el (truncate-string-left): ...here. Use 'string-width' instead of 'string-length', respect 'truncate-string-ellipsis'. All callers changed. * lisp/gnus/gnus-sum.el (gnus-shorten-url): Use 'string-width'. * test/lisp/international/mule-util-tests.el (truncate-string-left): New test. --- lisp/emacs-lisp/subr-x.el | 9 ---- lisp/gnus/gnus-sum.el | 7 ++-- lisp/international/mule-util.el | 13 ++++++ lisp/vc/ediff-mult.el | 14 +++---- test/lisp/international/mule-util-tests.el | 49 +++++++++++++++++++++- 5 files changed, 71 insertions(+), 21 deletions(-) diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 9f96ac50d1..044c9aada0 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -236,15 +236,6 @@ string-trim TRIM-LEFT and TRIM-RIGHT default to \"[ \\t\\n\\r]+\"." (string-trim-left (string-trim-right string trim-right) trim-left)) -;;;###autoload -(defun 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 6f367692dd..2aa4e483c0 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -9494,15 +9494,16 @@ gnus-collect-urls (delete-dups urls))) (defun gnus-shorten-url (url max) - "Return an excerpt from URL not exceeding MAX characters." - (if (<= (length url) max) + "Return an excerpt from URL not exceeding MAX \"columns\". +For the meaning of \"column\" see `truncate-string-to-width'." + (if (<= (string-width url) max) url (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))))))) + (concat host (truncate-string-left rest (- max (string-width host))))))) (defun gnus-summary-browse-url (&optional external) "Scan the current article body for links, and offer to browse them. diff --git a/lisp/international/mule-util.el b/lisp/international/mule-util.el index caa5747817..693601ea45 100644 --- a/lisp/international/mule-util.el +++ b/lisp/international/mule-util.el @@ -129,6 +129,19 @@ truncate-string-to-width (concat head-padding (substring str from-idx idx) tail-padding ellipsis))))) +;;;###autoload +(defun truncate-string-left (string width) + "Truncate STRING to WIDTH, replacing initial surplus with an ellipsis. +The ellipsis used is the value of `truncate-string-ellipsis'." + (let ((strwidth (string-width string))) + (if (<= strwidth width) + string + (let ((ellipsis-width (string-width truncate-string-ellipsis))) + (if (>= ellipsis-width width) + (truncate-string-to-width string strwidth (- strwidth width)) + (concat truncate-string-ellipsis + (truncate-string-to-width + string strwidth (+ (- strwidth width) ellipsis-width)))))))) ;;; Nested alist handler. ;; Nested alist is alist whose elements are also nested alist. diff --git a/lisp/vc/ediff-mult.el b/lisp/vc/ediff-mult.el index 2b1b07927f..6a6a2da7b9 100644 --- a/lisp/vc/ediff-mult.el +++ b/lisp/vc/ediff-mult.el @@ -1171,7 +1171,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 - (string-truncate-left + (truncate-string-left (ediff-abbreviate-file-name fname) max-filename-width))))))) @@ -1265,12 +1265,12 @@ ediff-draw-dir-diffs (if (= (mod membership-code ediff-membership-code1) 0) ; dir1 (let ((beg (point))) (insert (format "%-27s" - (string-truncate-left + (truncate-string-left (ediff-abbreviate-file-name (if (file-directory-p (concat dir1 file)) (file-name-as-directory file) file)) - 24))) + 27))) ;; format of meta info in the dir-diff-buffer: ;; (filename-tail filename-full otherdir1 otherdir2 otherdir3) (ediff-set-meta-overlay @@ -1280,12 +1280,12 @@ ediff-draw-dir-diffs (if (= (mod membership-code ediff-membership-code2) 0) ; dir2 (let ((beg (point))) (insert (format "%-26s" - (string-truncate-left + (truncate-string-left (ediff-abbreviate-file-name (if (file-directory-p (concat dir2 file)) (file-name-as-directory file) file)) - 24))) + 26))) (ediff-set-meta-overlay beg (point) (list meta-buf file (concat dir2 file) dir1 dir2 dir3))) @@ -1294,12 +1294,12 @@ ediff-draw-dir-diffs (if (= (mod membership-code ediff-membership-code3) 0) ; dir3 (let ((beg (point))) (insert (format " %-25s" - (string-truncate-left + (truncate-string-left (ediff-abbreviate-file-name (if (file-directory-p (concat dir3 file)) (file-name-as-directory file) file)) - 24))) + 25))) (ediff-set-meta-overlay beg (point) (list meta-buf file (concat dir3 file) dir1 dir2 dir3))) diff --git a/test/lisp/international/mule-util-tests.el b/test/lisp/international/mule-util-tests.el index c571782d63..403b355bb6 100644 --- a/test/lisp/international/mule-util-tests.el +++ b/test/lisp/international/mule-util-tests.el @@ -1,4 +1,4 @@ -;;; mule-util --- tests for international/mule-util.el +;;; mule-util-tests --- tests for international/mule-util.el ;; Copyright (C) 2002-2020 Free Software Foundation, Inc. @@ -81,4 +81,49 @@ mule-util-test-truncate-create (dotimes (i (length mule-util-test-truncate-data)) (mule-util-test-truncate-create i)) -;;; mule-util.el ends here +(ert-deftest truncate-string-left () + (let ((truncate-string-ellipsis "...")) + (should (equal (truncate-string-left "ahojky jojky mojky" 10) + "...y mojky")) + (should (equal (truncate-string-left "jojky mojky" 10) + "...y mojky")) + (should (equal (truncate-string-left "jojky" 10) + "jojky")) + (should (equal (truncate-string-left "jojky" 3) + "jky")) + (should (equal (truncate-string-left "我的老田野" 10) + "我的老田野")) + (should (equal (truncate-string-left "碩鼠碩鼠，甭食我叔" 10) + "...食我叔")) + (should (equal (truncate-string-left "碩鼠碩鼠，甭食我叔" 3) + "叔")) + (should (equal (truncate-string-left "碩鼠碩鼠，jojky" 10) + "...，jojky"))) + (let ((truncate-string-ellipsis "......")) + (should (equal (truncate-string-left "ahojky jojky mojky" 10) + "......ojky")) + (should (equal (truncate-string-left "jojky" 3) + "jky")) + (should (equal (truncate-string-left "我的老田野" 10) + "我的老田野")) + (should (equal (truncate-string-left "碩鼠碩鼠，甭食我叔" 10) + "......我叔")) + (should (equal (truncate-string-left "碩鼠碩鼠，甭食我叔" 3) + "叔")) + (should (equal (truncate-string-left "碩鼠碩鼠，jojky" 10) + "......ojky"))) + (let ((truncate-string-ellipsis "…")) + (should (equal (truncate-string-left "ahojky jojky mojky" 10) + "…jky mojky")) + (should (equal (truncate-string-left "jojky" 3) + "…ky")) + (should (equal (truncate-string-left "我的老田野" 10) + "我的老田野")) + (should (equal (truncate-string-left "碩鼠碩鼠，甭食我叔" 10) + "…甭食我叔")) + (should (equal (truncate-string-left "碩鼠碩鼠，甭食我叔" 3) + "…叔")) + (should (equal (truncate-string-left "碩鼠碩鼠，jojky" 10) + "…鼠，jojky")))) + +;;; mule-util-tests.el ends here -- 2.26.0