From mboxrd@z Thu Jan 1 00:00:00 1970 Path: main.gmane.org!not-for-mail From: Colin Walters Newsgroups: gmane.emacs.devel Subject: Re: API changes Date: 18 May 2002 15:54:53 -0400 Sender: emacs-devel-admin@gnu.org Message-ID: <1021751693.16292.1954.camel@space-ghost> References: <3CCAA9FF.4000905@666.com> <200204290505.g3T556106038@aztec.santafe.edu> <1020493576.5286.5.camel@space-ghost> <013e01c1fd9e$af600450$772efea9@neeeeeee> NNTP-Posting-Host: localhost.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-7ltHKH/Gq01olKUNIEd4" X-Trace: main.gmane.org 1021755057 5587 127.0.0.1 (18 May 2002 20:50:57 GMT) X-Complaints-To: usenet@main.gmane.org NNTP-Posting-Date: Sat, 18 May 2002 20:50:57 +0000 (UTC) Cc: emacs-devel@gnu.org, xemacs-design@xemacs.org Return-path: Original-Received: from quimby.gnus.org ([80.91.224.244]) by main.gmane.org with esmtp (Exim 3.33 #1 (Debian)) id 179BAH-0001S0-00 for ; Sat, 18 May 2002 22:50:57 +0200 Original-Received: from fencepost.gnu.org ([199.232.76.164]) by quimby.gnus.org with esmtp (Exim 3.12 #1 (Debian)) id 179BNP-00021A-00 for ; Sat, 18 May 2002 23:04:32 +0200 Original-Received: from localhost ([127.0.0.1] helo=fencepost.gnu.org) by fencepost.gnu.org with esmtp (Exim 3.34 #1 (Debian)) id 179BAY-0001g6-00; Sat, 18 May 2002 16:51:14 -0400 Original-Received: from monk.debian.net ([216.185.54.61] helo=monk.verbum.org) by fencepost.gnu.org with esmtp (Exim 3.34 #1 (Debian)) id 179B9v-0001f5-00 for ; Sat, 18 May 2002 16:50:35 -0400 Original-Received: from space-ghost.verbum.private (freedom.cis.ohio-state.edu [164.107.60.183]) (using TLSv1 with cipher EDH-RSA-DES-CBC3-SHA (168/168 bits)) (Client CN "space-ghost.verbum.org", Issuer "monk.verbum.org" (verified OK)) by monk.verbum.org (Postfix (Debian/GNU)) with ESMTP id 1D2D174000BA; Sat, 18 May 2002 16:50:24 -0400 (EDT) Original-Received: by space-ghost.verbum.private (Postfix (Debian/GNU), from userid 1000) id E5CA9806B92; Sat, 18 May 2002 15:54:53 -0400 (EDT) Original-To: Ben Wing In-Reply-To: <013e01c1fd9e$af600450$772efea9@neeeeeee> X-Mailer: Ximian Evolution 1.0.3 Errors-To: emacs-devel-admin@gnu.org X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.0.9 Precedence: bulk List-Help: List-Post: List-Subscribe: , List-Id: Emacs development discussions. List-Unsubscribe: , List-Archive: Xref: main.gmane.org gmane.emacs.devel:4099 X-Report-Spam: http://spam.gmane.org/gmane.emacs.devel:4099 --=-7ltHKH/Gq01olKUNIEd4 Content-Type: text/plain Content-Transfer-Encoding: 7bit > OK, i agree with the change and I made it. I'm attaching the new code. Well, I was about halfway through implementing it myself, so I just went ahead and finished my implementation. Along the way, there were enough different cases to worry about that I wrote a little test suite; please find it attached, along with my implementation. Try typing M-C-x on the test suite; your implementation seems to behave differently when the string is truncated, but too small to contain the ellipsis. In that case I just returned the truncated string. On the other test suite entries we agreed on the output. (Incidentally, something is strange with your mail; your comments came *after* the ----- Original Message ----- delimiter) --=-7ltHKH/Gq01olKUNIEd4 Content-Disposition: attachment; filename=tstw-test.el Content-Transfer-Encoding: quoted-printable Content-Type: text/x-emacs-lisp; name=tstw-test.el; charset=ISO-8859-1 ;; -*- mode: emacs-lisp; coding: iso-2022-7bit -*- ;;;###autoload (defun truncate-string-to-width (str end-column &optional start-column padding ellipsis) "Truncate string STR to end at column END-COLUMN. The optional 3rd arg START-COLUMN, if non-nil, specifies the starting column; that means to return the characters occupying columns START-COLUMN ... END-COLUMN of STR. Both END-COLUMN and START-COLUMN are specified in terms of character display width in the current buffer; see also `char-width'. The optional 4th arg PADDING, if non-nil, specifies a padding character (which should have a display width of 1) to add at the end of the result if STR doesn't reach column END-COLUMN, or if END-COLUMN comes in the middle of a character in STR. PADDING is also added at the beginning of the result if column START-COLUMN appears in the middle of a character in STR. If PADDING is nil, no padding is added in these cases, so the resulting string may be narrower than END-COLUMN. If ELLIPSIS is non-nil, it should be a string which will replace the end of STR (including any padding) if it extends beyond END-COLUMN, unless the display width of STR is equal to or less than the display width of ELLIPSIS. If it is non-nil and not a string, then ELLIPSIS defaults to \"...\"." (or start-column (setq start-column 0)) (when (and ellipsis (not (stringp ellipsis))) (setq ellipsis "...")) (let ((str-len (length str)) (str-width (string-width str)) (ellipsis-len (if ellipsis (length ellipsis) 0)) (ellipsis-width (if ellipsis (string-width ellipsis) 0)) (idx 0) (column 0) (head-padding "") (tail-padding "") ch last-column last-idx from-idx) (condition-case nil (while (< column start-column) (setq ch (aref str idx) column (+ column (char-width ch)) idx (1+ idx))) (args-out-of-range (setq idx str-len))) (if (< column start-column) (if padding (make-string end-column padding) "") (when (and padding (> column start-column)) (setq head-padding (make-string (- column start-column) padding))) (setq from-idx idx) (when (>=3D end-column column) (if (and (< end-column str-width) (> str-width ellipsis-width)) (setq end-column (- end-column ellipsis-width)) (setq ellipsis "")) (condition-case nil (while (< column end-column) (setq last-column column last-idx idx ch (aref str idx) column (+ column (char-width ch)) idx (1+ idx))) (args-out-of-range (setq idx str-len))) (when (> column end-column) (setq column last-column idx last-idx)) (when (and padding (< column end-column)) (setq tail-padding (make-string (- end-column column) padding)))) (concat head-padding (substring str from-idx idx) tail-padding ellipsis)))) (dolist (test '( (("" 0) . "") (("x" 1) . "x") (("xy" 1) . "x") (("xy" 2 1) . "y") (("xy" 0) . "") (("xy" 3) . "xy") (("=1B$AVP=1B(B" 0) . "") (("=1B$AVP=1B(B" 1) . "") (("=1B$AVP=1B(B" 2) . "=1B$AVP=1B(B") (("=1B$AVP=1B(B" 1 nil ? ) . " ") (("=1B$AVPND=1B(B" 3 1 ? ) . " ") (("x=1B$AVP=1B(Bx" 2) . "x") (("x=1B$AVP=1B(Bx" 3) . "x=1B$AVP=1B(B") (("x=1B$AVP=1B(Bx" 3) . "x=1B$AVP=1B(B") (("x=1B$AVP=1B(Bx" 4 1) . "=1B$AVP=1B(Bx") (("kor=1B$(CGQ=1B(Be=1B$(C1[=1B(Ban" 8 1 ? ) . "or=1B$(CGQ=1B(Be=1B$(C1[= =1B(B") (("kor=1B$(CGQ=1B(Be=1B$(C1[=1B(Ban" 7 2 ? ) . "r=1B$(CGQ=1B(Be ") (("" 0 nil nil "...") . "") (("x" 3 nil nil "...") . "x") (("=1B$AVP=1B(B" 3 nil nil "...") . "=1B$AVP=1B(B") (("foo" 3 nil nil "...") . "foo") (("foo" 2 nil nil "...") . "fo") ;; XEmacs failure? (("foobar" 6 0 nil "...") . "foobar") (("foobarbaz" 6 nil nil "...") . "foo...") (("foobarbaz" 7 2 nil "...") . "ob...") (("foobarbaz" 9 3 nil "...") . "barbaz") (("=1B$B$3=1B(Bh=1B$B$s=1B(Be=1B$B$K=1B(Bl=1B$B$A=1B(Bl=1B$B$O=1B(Bo" 15 = 1 ? t) . " h=1B$B$s=1B(Be=1B$B$K=1B(Bl=1B$B$A=1B(Bl=1B$B$O=1B(Bo") (("=1B$B$3=1B(Bh=1B$B$s=1B(Be=1B$B$K=1B(Bl=1B$B$A=1B(Bl=1B$B$O=1B(Bo" 14 = 1 ? t) . " h=1B$B$s=1B(Be=1B$B$K=1B(Bl=1B$B$A=1B(B...") (("x" 3 nil nil "=1B$(0GnM$=1B(B") . "x") (("=1B$AVP=1B(B" 2 nil nil "=1B$(0GnM$=1B(B") . "=1B$AVP=1B(B") (("=1B$AVP=1B(B" 1 nil ?x "=1B$(0GnM$=1B(B") . "x") ;; XEmacs error (("=1B$AVPND=1B(B" 3 nil ? "=1B$(0GnM$=1B(B") . "=1B$AVP=1B(B ") ;; XEma= cs error (("foobarbaz" 4 nil nil "=1B$(0GnM$=1B(B") . "=1B$(0GnM$=1B(B") (("foobarbaz" 5 nil nil "=1B$(0GnM$=1B(B") . "f=1B$(0GnM$=1B(B") (("foobarbaz" 6 nil nil "=1B$(0GnM$=1B(B") . "fo=1B$(0GnM$=1B(B") (("foobarbaz" 8 3 nil "=1B$(0GnM$=1B(B") . "b=1B$(0GnM$=1B(B") (("=1B$B$3=1B(Bh=1B$B$s=1B(Be=1B$B$K=1B(Bl=1B$B$A=1B(Bl=1B$B$O=1B(Bo" 14 = 4 ?x "=1B$BF|K\8l=1B(B") . "xe=1B$B$KF|K\8l=1B(B") (("=1B$B$3=1B(Bh=1B$B$s=1B(Be=1B$B$K=1B(Bl=1B$B$A=1B(Bl=1B$B$O=1B(Bo" 13 = 4 ?x "=1B$BF|K\8l=1B(B") . "xex=1B$BF|K\8l=1B(B") )) (let (ret) (condition-case e=20 (setq ret (apply #'truncate-string-to-width (car test))) (error (setq ret e))) (unless (equal ret (cdr test)) (error "%s: expected %s, got %s" (prin1-to-string (cons 'truncate-string-to-width (car test))) (prin1-to-string (cdr test)) (if (consp ret) (format "error: %s: %s" (car ret) (prin1-to-string (cdr ret))) (prin1-to-string ret)))))) --=-7ltHKH/Gq01olKUNIEd4--