From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.ciao.gmane.io!not-for-mail From: =?utf-8?B?xaB0xJtww6FuIE7Em21lYw==?= Newsgroups: gmane.emacs.devel Subject: Re: master 188bd80: gnus-shorten-url: Improve and avoid args-out-of-range error Date: Tue, 14 Apr 2020 11:26:22 +0200 Message-ID: <87k12ia05d.fsf@gmail.com> References: <20200413102415.23314.52412@vcs0.savannah.gnu.org> <20200413102417.445E520D0C@vcs0.savannah.gnu.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="ciao.gmane.io:159.69.161.202"; logging-data="33699"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/28.0.50 (gnu/linux) Cc: emacs-devel@gnu.org To: Stefan Monnier Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Tue Apr 14 11:26:31 2020 Return-path: Envelope-to: ged-emacs-devel@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1jOHpu-0008be-IO for ged-emacs-devel@m.gmane-mx.org; Tue, 14 Apr 2020 11:26:30 +0200 Original-Received: from localhost ([::1]:54880 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jOHpt-00029v-JM for ged-emacs-devel@m.gmane-mx.org; Tue, 14 Apr 2020 05:26:29 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:58891) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jOHpF-0001aU-Ku for emacs-devel@gnu.org; Tue, 14 Apr 2020 05:25:51 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1jOHpD-0001Up-Mo for emacs-devel@gnu.org; Tue, 14 Apr 2020 05:25:49 -0400 Original-Received: from mail-wr1-x429.google.com ([2a00:1450:4864:20::429]:37780) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1jOHpD-0001US-7l for emacs-devel@gnu.org; Tue, 14 Apr 2020 05:25:47 -0400 Original-Received: by mail-wr1-x429.google.com with SMTP id k1so6243373wrx.4 for ; Tue, 14 Apr 2020 02:25:47 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:in-reply-to:references:user-agent:date :message-id:mime-version; bh=ChvrisEA53M1HIkXWpNLTCE2emUXssXGdFrT9TsjWSY=; b=UwVqwdKG6IjTjONc43kzZs6TYuePLFKRjacSKd8hbLTOYRonDIxI+qmiKxmpagOUDK lIpG/zaM6O5bpLO8vdq1zrJSUgkqEzu9Cp7K5J46tJk4u7Rc1Cyf+4W6g2yhvhWBxQps PMQApZbAq+aqI/OKee7ZoNI+Q9r0mPvI1zy62V5Jfrz5ZGEsJ9j/iSVCvVwVL8miCAZi /CHxlGl0y+3IgeLK3+FbsFx/oaDDhMRn0ahe9JsaHC84eEznUX3uDxaL3sNTKKFV5T2J 3ZfthQz5IcDAV3d7A1XCwOSyWvwZu/FNanzVJDLvdr2ozDKzgZzq9I/or1My6cXet6WQ eQUA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:in-reply-to:references :user-agent:date:message-id:mime-version; bh=ChvrisEA53M1HIkXWpNLTCE2emUXssXGdFrT9TsjWSY=; b=WsEksD5rBaWpXTR5J9NzDRWFUDkD0eoyiMTh4DmHeuVVtGodAzb/EIlsxYBGPejOa3 M6AxjJDlRkwiET5fkOiQejfmJFpmKJqsyr4rETr0A2He3G2XxIK+qhTV/h6DO4NKoMzw 1g5Ga5RW3h13Yt45eASGjZhpn2/KTkzQdIoivBS5hnl0tEL3XoIIIQ36duSFBSXqtBwW KDpcZjD4yFLwZlLhngA36VbRrajC+z79+bhXNUWsQQ3K3b5U8P4+DTJOguQ1W5tkfg+w Or2GohuCwfZVVKKA3RVJxJPzhItbLYzSn2/HYNIM2eGhTKWyWutnCItiH0UYQsia6DHh 0XEg== X-Gm-Message-State: AGi0PuaznI13EdMefS2ksNHo6VsayChn///NiyC9OUDJozIslmvMGNZ0 GsdmY1jckZYMTTMlJwgDOeVzi2AP X-Google-Smtp-Source: APiQypLUAckyrsAR7WYGMH85+JQXKRgx8UobQ3WmBL7L09xn2iT+Mcuwx5NFgs9QttwsCIuaoUFE/w== X-Received: by 2002:adf:fe41:: with SMTP id m1mr22567382wrs.52.1586856345848; Tue, 14 Apr 2020 02:25:45 -0700 (PDT) Original-Received: from localhost ([185.112.167.47]) by smtp.gmail.com with ESMTPSA id z18sm12196590wrw.41.2020.04.14.02.25.44 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 14 Apr 2020 02:25:44 -0700 (PDT) In-Reply-To: (Stefan Monnier's message of "Mon, 13 Apr 2020 12:51:58 -0400") X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 2a00:1450:4864:20::429 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.23 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.io gmane.emacs.devel:246931 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable On Mon, 13 Apr 2020 12:51:58 -0400 Stefan Monnier wrote: >> +;;;###autoload >> +(defun string-truncate-left (string length) >> + "Truncate STRING to LENGTH, replacing initial surplus with \"...\"." >> + (let ((strlen (length string))) >> + (if (<=3D strlen length) >> + string >> + (setq length (max 0 (- length 3))) >> + (concat "..." (substring string (max 0 (- strlen 1 length))))))) > > This should of course rely on string-width rather than string-length, > but more importantly, it should obey `truncate-string-ellipsis` and > it should be "closer" to `truncate-string-to-width` (they should likely > be in the same file, and with similar sounding names). > Maybe it should even be merged with `truncate-string-to-width`. As the commit message says, that's really just a renamed helper function originally used by ediff for file names (and now also in `gnus-shorten-url'). Rewriting it to use `string-width' will require adjusting the callers, too, but that's probably a good thing, as it should lead to more correct results with strings containing wide characters. Still not necessarily really correct results, though, as AFAICT the "columns" which `string-width' speaks about are just an approximation, depending on the fonts used. E.g. with the default Chinese font emacs -Q uses on my system, I get roughly 8.5 "columns" per 5 Chinese characters, not 10 as claimed by `string-width'. I also don't understand why the result of `string-width' should depend on `current-language-environment', e.g. with "Chinese-GBK", (string-width "=E2=80=A6") returns 2 (why?!), with "English" or "UTF-8" it returns 1, even though the display (font, "columns") stays the same for all of them. As for possible merging with `truncate-string-to-width', I don't think I'm up to it; I was struggling to understand its doc string, let alone the implementation. Here's what I was able to come up with (BTW, I have little experience with RTL scripts, but, doesn't in that case the ellipsis end up on the logically wrong side, i.e. with the beginning/end of string reversed?): --=-=-= Content-Type: text/x-patch; charset=utf-8 Content-Disposition: inline; filename=0001-string-truncate-left-Use-string-width-and-truncate-s.patch Content-Transfer-Encoding: quoted-printable >From ad95727d0858767f14b27f412b12281a1a279870 Mon Sep 17 00:00:00 2001 From: =3D?UTF-8?q?=3DC5=3DA0t=3DC4=3D9Bp=3DC3=3DA1n=3D20N=3DC4=3D9Bmec?=3D = 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)) =20 -;;;###autoload -(defun string-truncate-left (string length) - "Truncate STRING to LENGTH, replacing initial surplus with \"...\"." - (let ((strlen (length string))) - (if (<=3D 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))) =20 (defun gnus-shorten-url (url max) - "Return an excerpt from URL not exceeding MAX characters." - (if (<=3D (length url) max) + "Return an excerpt from URL not exceeding MAX \"columns\". +For the meaning of \"column\" see `truncate-string-to-width'." + (if (<=3D (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)))= )))) =20 (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))))) =20 +;;;###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 (<=3D strwidth width) + string + (let ((ellipsis-width (string-width truncate-string-ellipsis))) + (if (>=3D 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))))))) =20 @@ -1265,12 +1265,12 @@ ediff-draw-dir-diffs (if (=3D (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 (=3D (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 (=3D (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/interna= tional/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 =20 ;; Copyright (C) 2002-2020 Free Software Foundation, Inc. =20 @@ -81,4 +81,49 @@ mule-util-test-truncate-create (dotimes (i (length mule-util-test-truncate-data)) (mule-util-test-truncate-create i)) =20 -;;; 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 "=E6=88=91=E7=9A=84=E8=80=81=E7= =94=B0=E9=87=8E" 10) + "=E6=88=91=E7=9A=84=E8=80=81=E7=94=B0=E9=87=8E")) + (should (equal (truncate-string-left "=E7=A2=A9=E9=BC=A0=E7=A2=A9=E9= =BC=A0=EF=BC=8C=E7=94=AD=E9=A3=9F=E6=88=91=E5=8F=94" 10) + "...=E9=A3=9F=E6=88=91=E5=8F=94")) + (should (equal (truncate-string-left "=E7=A2=A9=E9=BC=A0=E7=A2=A9=E9= =BC=A0=EF=BC=8C=E7=94=AD=E9=A3=9F=E6=88=91=E5=8F=94" 3) + "=E5=8F=94")) + (should (equal (truncate-string-left "=E7=A2=A9=E9=BC=A0=E7=A2=A9=E9= =BC=A0=EF=BC=8Cjojky" 10) + "...=EF=BC=8Cjojky"))) + (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 "=E6=88=91=E7=9A=84=E8=80=81=E7= =94=B0=E9=87=8E" 10) + "=E6=88=91=E7=9A=84=E8=80=81=E7=94=B0=E9=87=8E")) + (should (equal (truncate-string-left "=E7=A2=A9=E9=BC=A0=E7=A2=A9=E9= =BC=A0=EF=BC=8C=E7=94=AD=E9=A3=9F=E6=88=91=E5=8F=94" 10) + "......=E6=88=91=E5=8F=94")) + (should (equal (truncate-string-left "=E7=A2=A9=E9=BC=A0=E7=A2=A9=E9= =BC=A0=EF=BC=8C=E7=94=AD=E9=A3=9F=E6=88=91=E5=8F=94" 3) + "=E5=8F=94")) + (should (equal (truncate-string-left "=E7=A2=A9=E9=BC=A0=E7=A2=A9=E9= =BC=A0=EF=BC=8Cjojky" 10) + "......ojky"))) + (let ((truncate-string-ellipsis "=E2=80=A6")) + (should (equal (truncate-string-left "ahojky jojky mojky" 10) + "=E2=80=A6jky mojky")) + (should (equal (truncate-string-left "jojky" 3) + "=E2=80=A6ky")) + (should (equal (truncate-string-left "=E6=88=91=E7=9A=84=E8=80=81=E7= =94=B0=E9=87=8E" 10) + "=E6=88=91=E7=9A=84=E8=80=81=E7=94=B0=E9=87=8E")) + (should (equal (truncate-string-left "=E7=A2=A9=E9=BC=A0=E7=A2=A9=E9= =BC=A0=EF=BC=8C=E7=94=AD=E9=A3=9F=E6=88=91=E5=8F=94" 10) + "=E2=80=A6=E7=94=AD=E9=A3=9F=E6=88=91=E5=8F=94")) + (should (equal (truncate-string-left "=E7=A2=A9=E9=BC=A0=E7=A2=A9=E9= =BC=A0=EF=BC=8C=E7=94=AD=E9=A3=9F=E6=88=91=E5=8F=94" 3) + "=E2=80=A6=E5=8F=94")) + (should (equal (truncate-string-left "=E7=A2=A9=E9=BC=A0=E7=A2=A9=E9= =BC=A0=EF=BC=8Cjojky" 10) + "=E2=80=A6=E9=BC=A0=EF=BC=8Cjojky")))) + +;;; mule-util-tests.el ends here --=20 2.26.0 --=-=-=--