Mercurial > emacs
comparison lisp/international/mule-util.el @ 17092:e7920fdc4948
(truncate-string-to-width): Argument PADDING can be a padding character.
author | Kenichi Handa <handa@m17n.org> |
---|---|
date | Wed, 26 Feb 1997 12:55:23 +0000 |
parents | 70194012fb3a |
children | c913160e34a7 |
comparison
equal
deleted
inserted
replaced
17091:06d52b56fdd5 | 17092:e7920fdc4948 |
---|---|
74 | 74 |
75 ;;;###autoload | 75 ;;;###autoload |
76 (defun truncate-string-to-width (str width &optional start-column padding) | 76 (defun truncate-string-to-width (str width &optional start-column padding) |
77 "Truncate string STR to fit in WIDTH columns. | 77 "Truncate string STR to fit in WIDTH columns. |
78 Optional 1st arg START-COLUMN if non-nil specifies the starting column. | 78 Optional 1st arg START-COLUMN if non-nil specifies the starting column. |
79 Optional 2nd arg PADDING if non-nil, space characters are padded at | 79 Optional 2nd arg PADDING if non-nil is a padding character to be padded at |
80 the head and tail of the resulting string to fit in WIDTH if necessary. | 80 the head and tail of the resulting string to fit in WIDTH if necessary. |
81 If PADDING is nil, the resulting string may be narrower than WIDTH." | 81 If PADDING is nil, the resulting string may be narrower than WIDTH." |
82 (or start-column | 82 (or start-column |
83 (setq start-column 0)) | 83 (setq start-column 0)) |
84 (let ((len (length str)) | 84 (let ((len (length str)) |
91 (setq ch (sref str idx) | 91 (setq ch (sref str idx) |
92 column (+ column (char-width ch)) | 92 column (+ column (char-width ch)) |
93 idx (+ idx (char-bytes ch)))) | 93 idx (+ idx (char-bytes ch)))) |
94 (args-out-of-range (setq idx len))) | 94 (args-out-of-range (setq idx len))) |
95 (if (< column start-column) | 95 (if (< column start-column) |
96 (if padding (make-string width ?\ ) "") | 96 (if padding (make-string width padding) "") |
97 (if (and padding (> column start-column)) | 97 (if (and padding (> column start-column)) |
98 (setq head-padding (make-string (- column start-column) ?\ ))) | 98 (setq head-padding (make-string (- column start-column) ?\ ))) |
99 (setq from-idx idx) | 99 (setq from-idx idx) |
100 (condition-case nil | 100 (condition-case nil |
101 (while (< column width) | 101 (while (< column width) |
106 idx (+ idx (char-bytes ch)))) | 106 idx (+ idx (char-bytes ch)))) |
107 (args-out-of-range (setq idx len))) | 107 (args-out-of-range (setq idx len))) |
108 (if (> column width) | 108 (if (> column width) |
109 (setq column last-column idx last-idx)) | 109 (setq column last-column idx last-idx)) |
110 (if (and padding (< column width)) | 110 (if (and padding (< column width)) |
111 (setq tail-padding (make-string (- width column) ?\ ))) | 111 (setq tail-padding (make-string (- width column) padding))) |
112 (setq str (substring str from-idx idx)) | 112 (setq str (substring str from-idx idx)) |
113 (if padding | 113 (if padding |
114 (concat head-padding str tail-padding) | 114 (concat head-padding str tail-padding) |
115 str)))) | 115 str)))) |
116 | 116 |