84 |
string) |
string) |
85 |
|
|
86 |
;;;###autoload |
;;;###autoload |
87 |
(defun truncate-string-to-width (str end-column &optional start-column padding) |
(defun truncate-string-to-width (str end-column |
88 |
|
&optional start-column padding ellipsis) |
89 |
"Truncate string STR to end at column END-COLUMN. |
"Truncate string STR to end at column END-COLUMN. |
90 |
The optional 3rd arg START-COLUMN, if non-nil, specifies |
The optional 3rd arg START-COLUMN, if non-nil, specifies the starting |
91 |
the starting column; that means to return the characters occupying |
column; that means to return the characters occupying columns |
92 |
columns START-COLUMN ... END-COLUMN of STR. |
START-COLUMN ... END-COLUMN of STR. Both END-COLUMN and START-COLUMN |
93 |
|
are specified in terms of character display width in the current |
94 |
The optional 4th arg PADDING, if non-nil, specifies a padding character |
buffer; see also `char-width'. |
95 |
to add at the end of the result if STR doesn't reach column END-COLUMN, |
|
96 |
or if END-COLUMN comes in the middle of a character in STR. |
The optional 4th arg PADDING, if non-nil, specifies a padding |
97 |
PADDING is also added at the beginning of the result |
character (which should have a display width of 1) to add at the end |
98 |
if column START-COLUMN appears in the middle of a character in STR. |
of the result if STR doesn't reach column END-COLUMN, or if END-COLUMN |
99 |
|
comes in the middle of a character in STR. PADDING is also added at |
100 |
|
the beginning of the result if column START-COLUMN appears in the |
101 |
|
middle of a character in STR. |
102 |
|
|
103 |
If PADDING is nil, no padding is added in these cases, so |
If PADDING is nil, no padding is added in these cases, so |
104 |
the resulting string may be narrower than END-COLUMN." |
the resulting string may be narrower than END-COLUMN. |
105 |
|
|
106 |
|
If ELLIPSIS is non-nil, it should be a string which will replace the |
107 |
|
end of STR (including any padding) if it extends beyond END-COLUMN, |
108 |
|
unless the display width of STR is equal to or less than the display |
109 |
|
width of ELLIPSIS. If it is non-nil and not a string, then ELLIPSIS |
110 |
|
defaults to \"...\"." |
111 |
(or start-column |
(or start-column |
112 |
(setq start-column 0)) |
(setq start-column 0)) |
113 |
(let ((len (length str)) |
(when (and ellipsis (not (stringp ellipsis))) |
114 |
|
(setq ellipsis "...")) |
115 |
|
(let ((str-len (length str)) |
116 |
|
(str-width (string-width str)) |
117 |
|
(ellipsis-len (if ellipsis (length ellipsis) 0)) |
118 |
|
(ellipsis-width (if ellipsis (string-width ellipsis) 0)) |
119 |
(idx 0) |
(idx 0) |
120 |
(column 0) |
(column 0) |
121 |
(head-padding "") (tail-padding "") |
(head-padding "") (tail-padding "") |
125 |
(setq ch (aref str idx) |
(setq ch (aref str idx) |
126 |
column (+ column (char-width ch)) |
column (+ column (char-width ch)) |
127 |
idx (1+ idx))) |
idx (1+ idx))) |
128 |
(args-out-of-range (setq idx len))) |
(args-out-of-range (setq idx str-len))) |
129 |
(if (< column start-column) |
(if (< column start-column) |
130 |
(if padding (make-string end-column padding) "") |
(if padding (make-string end-column padding) "") |
131 |
(if (and padding (> column start-column)) |
(when (and padding (> column start-column)) |
132 |
(setq head-padding (make-string (- column start-column) padding))) |
(setq head-padding (make-string (- column start-column) padding))) |
133 |
(setq from-idx idx) |
(setq from-idx idx) |
134 |
(if (< end-column column) |
(when (>= end-column column) |
135 |
(setq idx from-idx) |
(if (and (< end-column str-width) |
136 |
|
(> str-width ellipsis-width)) |
137 |
|
(setq end-column (- end-column ellipsis-width)) |
138 |
|
(setq ellipsis "")) |
139 |
(condition-case nil |
(condition-case nil |
140 |
(while (< column end-column) |
(while (< column end-column) |
141 |
(setq last-column column |
(setq last-column column |
143 |
ch (aref str idx) |
ch (aref str idx) |
144 |
column (+ column (char-width ch)) |
column (+ column (char-width ch)) |
145 |
idx (1+ idx))) |
idx (1+ idx))) |
146 |
(args-out-of-range (setq idx len))) |
(args-out-of-range (setq idx str-len))) |
147 |
(if (> column end-column) |
(when (> column end-column) |
148 |
(setq column last-column idx last-idx)) |
(setq column last-column |
149 |
(if (and padding (< column end-column)) |
idx last-idx)) |
150 |
(setq tail-padding (make-string (- end-column column) padding)))) |
(when (and padding (< column end-column)) |
151 |
(setq str (substring str from-idx idx)) |
(setq tail-padding (make-string (- end-column column) padding)))) |
152 |
(if padding |
(concat head-padding (substring str from-idx idx) |
153 |
(concat head-padding str tail-padding) |
tail-padding ellipsis)))) |
154 |
str)))) |
|
155 |
|
;;; Test suite for truncate-string-to-width |
156 |
|
;; (dolist (test '((("" 0) . "") |
157 |
|
;; (("x" 1) . "x") |
158 |
|
;; (("xy" 1) . "x") |
159 |
|
;; (("xy" 2 1) . "y") |
160 |
|
;; (("xy" 0) . "") |
161 |
|
;; (("xy" 3) . "xy") |
162 |
|
;; (("$AVP(B" 0) . "") |
163 |
|
;; (("$AVP(B" 1) . "") |
164 |
|
;; (("$AVP(B" 2) . "$AVP(B") |
165 |
|
;; (("$AVP(B" 1 nil ? ) . " ") |
166 |
|
;; (("$AVPND(B" 3 1 ? ) . " ") |
167 |
|
;; (("x$AVP(Bx" 2) . "x") |
168 |
|
;; (("x$AVP(Bx" 3) . "x$AVP(B") |
169 |
|
;; (("x$AVP(Bx" 3) . "x$AVP(B") |
170 |
|
;; (("x$AVP(Bx" 4 1) . "$AVP(Bx") |
171 |
|
;; (("kor$(CGQ(Be$(C1[(Ban" 8 1 ? ) . "or$(CGQ(Be$(C1[(B") |
172 |
|
;; (("kor$(CGQ(Be$(C1[(Ban" 7 2 ? ) . "r$(CGQ(Be ") |
173 |
|
;; (("" 0 nil nil "...") . "") |
174 |
|
;; (("x" 3 nil nil "...") . "x") |
175 |
|
;; (("$AVP(B" 3 nil nil "...") . "$AVP(B") |
176 |
|
;; (("foo" 3 nil nil "...") . "foo") |
177 |
|
;; (("foo" 2 nil nil "...") . "fo") ;; XEmacs failure? |
178 |
|
;; (("foobar" 6 0 nil "...") . "foobar") |
179 |
|
;; (("foobarbaz" 6 nil nil "...") . "foo...") |
180 |
|
;; (("foobarbaz" 7 2 nil "...") . "ob...") |
181 |
|
;; (("foobarbaz" 9 3 nil "...") . "barbaz") |
182 |
|
;; (("$B$3(Bh$B$s(Be$B$K(Bl$B$A(Bl$B$O(Bo" 15 1 ? t) . " h$B$s(Be$B$K(Bl$B$A(Bl$B$O(Bo") |
183 |
|
;; (("$B$3(Bh$B$s(Be$B$K(Bl$B$A(Bl$B$O(Bo" 14 1 ? t) . " h$B$s(Be$B$K(Bl$B$A(B...") |
184 |
|
;; (("x" 3 nil nil "$(0GnM$(B") . "x") |
185 |
|
;; (("$AVP(B" 2 nil nil "$(0GnM$(B") . "$AVP(B") |
186 |
|
;; (("$AVP(B" 1 nil ?x "$(0GnM$(B") . "x") ;; XEmacs error |
187 |
|
;; (("$AVPND(B" 3 nil ? "$(0GnM$(B") . "$AVP(B ") ;; XEmacs error |
188 |
|
;; (("foobarbaz" 4 nil nil "$(0GnM$(B") . "$(0GnM$(B") |
189 |
|
;; (("foobarbaz" 5 nil nil "$(0GnM$(B") . "f$(0GnM$(B") |
190 |
|
;; (("foobarbaz" 6 nil nil "$(0GnM$(B") . "fo$(0GnM$(B") |
191 |
|
;; (("foobarbaz" 8 3 nil "$(0GnM$(B") . "b$(0GnM$(B") |
192 |
|
;; (("$B$3(Bh$B$s(Be$B$K(Bl$B$A(Bl$B$O(Bo" 14 4 ?x "$BF|K\8l(B") . "xe$B$KF|K\8l(B") |
193 |
|
;; (("$B$3(Bh$B$s(Be$B$K(Bl$B$A(Bl$B$O(Bo" 13 4 ?x "$BF|K\8l(B") . "xex$BF|K\8l(B") |
194 |
|
;; )) |
195 |
|
;; (let (ret) |
196 |
|
;; (condition-case e |
197 |
|
;; (setq ret (apply #'truncate-string-to-width (car test))) |
198 |
|
;; (error (setq ret e))) |
199 |
|
;; (unless (equal ret (cdr test)) |
200 |
|
;; (error "%s: expected %s, got %s" |
201 |
|
;; (prin1-to-string (cons 'truncate-string-to-width (car test))) |
202 |
|
;; (prin1-to-string (cdr test)) |
203 |
|
;; (if (consp ret) |
204 |
|
;; (format "error: %s: %s" (car ret) |
205 |
|
;; (prin1-to-string (cdr ret))) |
206 |
|
;; (prin1-to-string ret)))))) |
207 |
|
|
208 |
;;; For backward compatibility ... |
;;; For backward compatibility ... |
209 |
;;;###autoload |
;;;###autoload |
370 |
|
|
371 |
(provide 'mule-util) |
(provide 'mule-util) |
372 |
|
|
373 |
|
;; Local Variables: |
374 |
|
;; coding: iso-2022-7bit |
375 |
|
;; End: |
376 |
|
|
377 |
;;; mule-util.el ends here |
;;; mule-util.el ends here |