(truncate-string-to-width): New optional argument `ellipsis'. Add

commented-out test suite, and change coding to iso-2022-7bit.

diff --git a/lisp/international/mule-util.el b/lisp/international/mule-util.el
index e962c9be19a41a9c208e9c7455b4a9a406a72c2f..c3ec50bfa950b82d6d85e0aef7794dd6a3d600e1 100644 (file)
--- a/lisp/international/mule-util.el
+++ b/lisp/international/mule-util.el
@@ -84,23 +84,38 @@ TYPE should be `list' or `vector'."
   string)
 
 ;;;###autoload
-(defun truncate-string-to-width (str end-column &optional start-column padding)
+(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.
-
-The optional 4th arg PADDING, if non-nil, specifies a padding character
-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.
+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."
+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))
-  (let ((len (length str))
+  (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 "")
@@ -110,14 +125,17 @@ the resulting string may be narrower than END-COLUMN."
          (setq ch (aref str idx)
                column (+ column (char-width ch))
                idx (1+ idx)))
-      (args-out-of-range (setq idx len)))
+      (args-out-of-range (setq idx str-len)))
     (if (< column start-column)
        (if padding (make-string end-column padding) "")
-      (if (and padding (> column start-column))
-         (setq head-padding (make-string (- column start-column) padding)))
+      (when (and padding (> column start-column))
+       (setq head-padding (make-string (- column start-column) padding)))
       (setq from-idx idx)
-      (if (< end-column column)
-         (setq idx from-idx)
+      (when (>= 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
@@ -125,15 +143,67 @@ the resulting string may be narrower than END-COLUMN."
                    ch (aref str idx)
                    column (+ column (char-width ch))
                    idx (1+ idx)))
-         (args-out-of-range (setq idx len)))
-       (if (> column end-column)
-           (setq column last-column idx last-idx))
-       (if (and padding (< column end-column))
-           (setq tail-padding (make-string (- end-column column) padding))))
-      (setq str (substring str from-idx idx))
-      (if padding
-         (concat head-padding str tail-padding)
-       str))))
+         (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))))
+
+;;; Test suite for truncate-string-to-width
+;; (dolist (test '((("" 0) . "")
+;;             (("x" 1) . "x")
+;;             (("xy" 1) . "x")
+;;             (("xy" 2 1) . "y")
+;;             (("xy" 0) . "")
+;;             (("xy" 3) . "xy")
+;;             (("\e$AVP\e(B" 0) . "")
+;;             (("\e$AVP\e(B" 1) . "")
+;;             (("\e$AVP\e(B" 2) . "\e$AVP\e(B")
+;;             (("\e$AVP\e(B" 1 nil ? ) . " ")
+;;             (("\e$AVPND\e(B" 3 1 ? ) . "  ")
+;;             (("x\e$AVP\e(Bx" 2) . "x")
+;;             (("x\e$AVP\e(Bx" 3) . "x\e$AVP\e(B")
+;;             (("x\e$AVP\e(Bx" 3) . "x\e$AVP\e(B")
+;;             (("x\e$AVP\e(Bx" 4 1) . "\e$AVP\e(Bx")
+;;             (("kor\e$(CGQ\e(Be\e$(C1[\e(Ban" 8 1 ? ) . "or\e$(CGQ\e(Be\e$(C1[\e(B")
+;;             (("kor\e$(CGQ\e(Be\e$(C1[\e(Ban" 7 2 ? ) . "r\e$(CGQ\e(Be ")
+;;             (("" 0 nil nil "...") . "")
+;;             (("x" 3 nil nil "...") . "x")
+;;             (("\e$AVP\e(B" 3 nil nil "...") . "\e$AVP\e(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")
+;;             (("\e$B$3\e(Bh\e$B$s\e(Be\e$B$K\e(Bl\e$B$A\e(Bl\e$B$O\e(Bo" 15 1 ?  t) . " h\e$B$s\e(Be\e$B$K\e(Bl\e$B$A\e(Bl\e$B$O\e(Bo")
+;;             (("\e$B$3\e(Bh\e$B$s\e(Be\e$B$K\e(Bl\e$B$A\e(Bl\e$B$O\e(Bo" 14 1 ?  t) . " h\e$B$s\e(Be\e$B$K\e(Bl\e$B$A\e(B...")
+;;             (("x" 3 nil nil "\e$(0GnM$\e(B") . "x")
+;;             (("\e$AVP\e(B" 2 nil nil "\e$(0GnM$\e(B") . "\e$AVP\e(B")
+;;             (("\e$AVP\e(B" 1 nil ?x "\e$(0GnM$\e(B") . "x") ;; XEmacs error
+;;             (("\e$AVPND\e(B" 3 nil ?  "\e$(0GnM$\e(B") . "\e$AVP\e(B ") ;; XEmacs error
+;;             (("foobarbaz" 4 nil nil  "\e$(0GnM$\e(B") . "\e$(0GnM$\e(B")
+;;             (("foobarbaz" 5 nil nil  "\e$(0GnM$\e(B") . "f\e$(0GnM$\e(B")
+;;             (("foobarbaz" 6 nil nil  "\e$(0GnM$\e(B") . "fo\e$(0GnM$\e(B")
+;;             (("foobarbaz" 8 3 nil "\e$(0GnM$\e(B") . "b\e$(0GnM$\e(B")
+;;             (("\e$B$3\e(Bh\e$B$s\e(Be\e$B$K\e(Bl\e$B$A\e(Bl\e$B$O\e(Bo" 14 4 ?x "\e$BF|K\8l\e(B") . "xe\e$B$KF|K\8l\e(B")
+;;             (("\e$B$3\e(Bh\e$B$s\e(Be\e$B$K\e(Bl\e$B$A\e(Bl\e$B$O\e(Bo" 13 4 ?x "\e$BF|K\8l\e(B") . "xex\e$BF|K\8l\e(B")
+;;             ))
+;;   (let (ret)
+;;     (condition-case e 
+;;     (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))))))
 
 ;;; For backward compatibility ...
 ;;;###autoload
@@ -300,4 +370,8 @@ language environment LANG-ENV."
 \f
 (provide 'mule-util)
 
+;; Local Variables:
+;; coding: iso-2022-7bit
+;; End:
+
 ;;; mule-util.el ends here