Mercurial > hg > xemacs-beta

comparison lisp/mule/mule-misc.el @ 82:6a378aca36af r20-0b91

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b91
author cvs
date Mon, 13 Aug 2007 09:07:36 +0200
parents 131b0175ea99
children 360340f9fd5f
comparison
equal deleted inserted replaced
81:ebca3d831cea 82:6a378aca36af
51 ; (nreverse l))) 51 ; (nreverse l)))
52 52
53 (defun string-to-char-list (str) 53 (defun string-to-char-list (str)
54 (mapcar 'identity str)) 54 (mapcar 'identity str))
55 55
56 ;;; Slower, albeit more elegant, implementation?? 56 (defun string-width (string)
57 ;; (defun string-columns (string)
58 ;; "Return number of columns STRING occupies when displayed.
59 ;; Uses the charset-columns attribute of the characters in STRING,
60 ;; which may not accurately represent the actual display width in a
61 ;; window system."
62 ;; (loop for c across string
63 ;; sum (charset-columns (char-charset c))))
64
65 (defun string-columns (string)
66 "Return number of columns STRING occupies when displayed. 57 "Return number of columns STRING occupies when displayed.
67 Uses the charset-columns attribute of the characters in STRING, 58 Uses the charset-columns attribute of the characters in STRING,
68 which may not accurately represent the actual display width when 59 which may not accurately represent the actual display width when
69 using a window system." 60 using a window system."
70 (let ((col 0) 61 (let ((col 0)
73 (while (< i len) 64 (while (< i len)
74 (setq col (+ col (charset-columns (char-charset (aref string i))))) 65 (setq col (+ col (charset-columns (char-charset (aref string i)))))
75 (setq i (1+ i))) 66 (setq i (1+ i)))
76 col)) 67 col))
77 68
78 (defalias 'string-width 'string-columns) 69 (defalias 'string-columns 'string-width)
70 (make-obsolete 'string-columns 'string-width)
79 71
80 (defun delete-text-in-column (from to) 72 (defun delete-text-in-column (from to)
81 "Delete the text between column FROM and TO (exclusive) of the current line. 73 "Delete the text between column FROM and TO (exclusive) of the current line.
82 Nil of FORM or TO means the current column. 74 Nil of FORM or TO means the current column.
83 If there's a charcter across the borders, the character is replaced with 75 If there's a charcter across the borders, the character is replaced with
152 (if (and (consp buffer-undo-list) 144 (if (and (consp buffer-undo-list)
153 ;; if car is nil. 145 ;; if car is nil.
154 (null (car buffer-undo-list)) ) 146 (null (car buffer-undo-list)) )
155 (setq buffer-undo-list (cdr buffer-undo-list)) )) 147 (setq buffer-undo-list (cdr buffer-undo-list)) ))
156 148
149
157 ;;; Common API emulation functions for GNU Emacs-merged Mule. 150 ;;; Common API emulation functions for GNU Emacs-merged Mule.
158 ;;; As suggested by MORIOKA Tomohiko 151 ;;; As suggested by MORIOKA Tomohiko
159 (defun truncate-string (str width &optional start-column) 152
160 "Truncate STR to fit in WIDTH columns. 153 ;; Following definition were imported from Emacs/mule-delta.
161 Optional non-nil arg START-COLUMN specifies the starting column." 154
162 (substring str (or start-column 0) width)) 155 (defun truncate-string-to-width (str width &optional start-column padding)
156 "Truncate string STR to fit in WIDTH columns.
157 Optional 1st arg START-COLUMN if non-nil specifies the starting column.
158 Optional 2nd arg PADDING if non-nil, space characters are padded at
159 the head and tail of the resulting string to fit in WIDTH if necessary.
160 If PADDING is nil, the resulting string may be narrower than WIDTH."
161 (or start-column
162 (setq start-column 0))
163 (let ((len (length str))
164 (idx 0)
165 (column 0)
166 (head-padding "") (tail-padding "")
167 ch last-column last-idx from-idx)
168 (condition-case nil
169 (while (< column start-column)
170 (setq ch (sref str idx)
171 column (+ column (char-width ch))
172 idx (+ idx (char-bytes ch))))
173 (args-out-of-range (setq idx len)))
174 (if (< column start-column)
175 (if padding (make-string width ?\ ) "")
176 (if (and padding (> column start-column))
177 (setq head-padding (make-string (- column start-column) ?\ )))
178 (setq from-idx idx)
179 (condition-case nil
180 (while (< column width)
181 (setq last-column column
182 last-idx idx
183 ch (sref str idx)
184 column (+ column (char-width ch))
185 idx (+ idx (char-bytes ch))))
186 (args-out-of-range (setq idx len)))
187 (if (> column width)
188 (setq column last-column idx last-idx))
189 (if (and padding (< column width))
190 (setq tail-padding (make-string (- width column) ?\ )))
191 (setq str (substring str from-idx idx))
192 (if padding
193 (concat head-padding str tail-padding)
194 str))))
195
196 ;;; For backward compatiblity ...
197 ;;;###autoload
198 (defalias 'truncate-string 'truncate-string-to-width)
199 (make-obsolete 'truncate-string 'truncate-string-to-width)
200
201 ;; end of imported definition
202
163 203
164 (defalias 'sref 'aref) 204 (defalias 'sref 'aref)
165 (defalias 'map-char-concat 'mapcar) 205 (defalias 'map-char-concat 'mapcar)
166 (defun char-bytes (chr) 1) 206 (defun char-bytes (character)
167 (defun char-length (chr) 1) 207 "Return number of length a CHARACTER occupies in a string or buffer.
168 208 It returns only 1 in XEmacs. It is for compatibility with MULE 2.3."
169 (defun char-columns (character) 209 1)
210 (defalias 'char-length 'char-bytes)
211
212 (defun char-width (character)
170 "Return number of columns a CHARACTER occupies when displayed." 213 "Return number of columns a CHARACTER occupies when displayed."
171 (charset-columns (char-charset character))) 214 (charset-columns (char-charset character)))
172 215
216 (defalias 'char-columns 'char-width)
217 (make-obsolete 'char-columns 'char-width)
218
173 (defalias 'charset-description 'charset-doc-string) 219 (defalias 'charset-description 'charset-doc-string)
174 220
175 (defalias 'find-charset-string 'charsets-in-string) 221 (defalias 'find-charset-string 'charsets-in-string)
176 (defalias 'find-charset-region 'charsets-in-region) 222 (defalias 'find-charset-region 'charsets-in-region)
177 223
178 (defun find-non-ascii-charset-string (string) 224 (defun find-non-ascii-charset-string (string)
179 "Return a list of charsets in the STRING except ascii. 225 "Return a list of charsets in the STRING except ascii.
180 For compatibility with Mule" 226 It might be available for compatibility with Mule 2.3,
227 because its `find-charset-string' ignores ASCII charset."
181 (delq 'ascii (charsets-in-string string))) 228 (delq 'ascii (charsets-in-string string)))
182 229
183 (defun find-non-ascii-charset-region (start end) 230 (defun find-non-ascii-charset-region (start end)
184 "Return a list of charsets except ascii 231 "Return a list of charsets except ascii in the region between START and END.
185 in the region between START and END. 232 It might be available for compatibility with Mule 2.3,
186 For compatibility with Mule" 233 because its `find-charset-string' ignores ASCII charset."
187 (delq 'ascii (charsets-in-region start end))) 234 (delq 'ascii (charsets-in-region start end)))
188
189 ;(defun truncate-string-to-column (str width &optional start-column)
190 ; "Truncate STR to fit in WIDTH columns.
191 ;Optional non-nil arg START-COLUMN specifies the starting column."
192 ; (or start-column
193 ; (setq start-column 0))
194 ; (let ((max-width (string-width str))
195 ; (len (length str))
196 ; (from 0)
197 ; (column 0)
198 ; to-prev to ch)
199 ; (if (>= width max-width)
200 ; (setq width max-width))
201 ; (if (>= start-column width)
202 ; ""
203 ; (while (< column start-column)
204 ; (setq ch (aref str from)
205 ; column (+ column (char-width ch))
206 ; from (+ from (char-octets ch))))
207 ; (if (< width max-width)
208 ; (progn
209 ; (setq to from)
210 ; (while (<= column width)
211 ; (setq ch (aref str to)
212 ; column (+ column (char-width ch))
213 ; to-prev to
214 ; to (+ to (char-octets ch))))
215 ; (setq to to-prev)))
216 ; (substring str from to))))
217 235
218 236
219 ;;; Language environments 237 ;;; Language environments
220 238
221 (defvar current-language-environment nil) 239 (defvar current-language-environment nil)