Mercurial > hg > xemacs-beta

comparison lisp/mule/mule-misc.el @ 165:5a88923fcbfe r20-3b9

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b9
author cvs
date Mon, 13 Aug 2007 09:44:42 +0200
parents 585fb297b004
children 6075d714658b
comparison
equal deleted inserted replaced
164:4e0740e5aab2 165:5a88923fcbfe
151 ;;; Common API emulation functions for GNU Emacs-merged Mule. 151 ;;; Common API emulation functions for GNU Emacs-merged Mule.
152 ;;; As suggested by MORIOKA Tomohiko 152 ;;; As suggested by MORIOKA Tomohiko
153 153
154 ;; Following definition were imported from Emacs/mule-delta. 154 ;; Following definition were imported from Emacs/mule-delta.
155 155
156 (defun truncate-string-to-width (str width &optional start-column padding) 156 ;; Function `truncate-string-to-width' was moved to mule-util.el.
157 "Truncate string STR to fit in WIDTH columns.
158 Optional 1st arg START-COLUMN if non-nil specifies the starting column.
159 Optional 2nd arg PADDING if non-nil, space characters are padded at
160 the head and tail of the resulting string to fit in WIDTH if necessary.
161 If PADDING is nil, the resulting string may be narrower than WIDTH."
162 (or start-column
163 (setq start-column 0))
164 (let ((len (length str))
165 (idx 0)
166 (column 0)
167 (head-padding "") (tail-padding "")
168 ch last-column last-idx from-idx)
169 (condition-case nil
170 (while (< column start-column)
171 (setq ch (sref str idx)
172 column (+ column (char-width ch))
173 idx (+ idx (char-bytes ch))))
174 (args-out-of-range (setq idx len)))
175 (if (< column start-column)
176 (if padding (make-string width ?\ ) "")
177 (if (and padding (> column start-column))
178 (setq head-padding (make-string (- column start-column) ?\ )))
179 (setq from-idx idx)
180 (condition-case nil
181 (while (< column width)
182 (setq last-column column
183 last-idx idx
184 ch (sref str idx)
185 column (+ column (char-width ch))
186 idx (+ idx (char-bytes ch))))
187 (args-out-of-range (setq idx len)))
188 (if (> column width)
189 (setq column last-column idx last-idx))
190 (if (and padding (< column width))
191 (setq tail-padding (make-string (- width column) ?\ )))
192 (setq str (substring str from-idx idx))
193 (if padding
194 (concat head-padding str tail-padding)
195 str))))
196
197 ;;; For backward compatiblity ...
198 ;;;###autoload
199 (defalias 'truncate-string 'truncate-string-to-width)
200 (make-obsolete 'truncate-string 'truncate-string-to-width)
201 157
202 ;; end of imported definition 158 ;; end of imported definition
203 159
204 160
205 (defalias 'sref 'aref) 161 (defalias 'sref 'aref)