Mercurial > hg > xemacs-beta

comparison lisp/mule/mule-misc.el @ 422:95016f13131a r21-2-19

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-19
author cvs
date Mon, 13 Aug 2007 11:25:01 +0200
parents 41dbb7a9d5f2
children
comparison
equal deleted inserted replaced
421:fff06e11db74 422:95016f13131a
62 using a window system." 62 using a window system."
63 (let ((col 0) 63 (let ((col 0)
64 (len (length string)) 64 (len (length string))
65 (i 0)) 65 (i 0))
66 (while (< i len) 66 (while (< i len)
67 (setq col (+ col (charset-columns (char-charset (aref string i))))) 67 (setq col (+ col (charset-width (char-charset (aref string i)))))
68 (setq i (1+ i))) 68 (setq i (1+ i)))
69 col)) 69 col))
70 70
71 (defalias 'string-columns 'string-width) 71 (defalias 'string-columns 'string-width)
72 (make-obsolete 'string-columns 'string-width) 72 (make-obsolete 'string-columns 'string-width)
168 1) 168 1)
169 (defalias 'char-length 'char-bytes) 169 (defalias 'char-length 'char-bytes)
170 170
171 (defun char-width (character) 171 (defun char-width (character)
172 "Return number of columns a CHARACTER occupies when displayed." 172 "Return number of columns a CHARACTER occupies when displayed."
173 (charset-columns (char-charset character))) 173 (charset-width (char-charset character)))
174 174
175 (defalias 'char-columns 'char-width) 175 (defalias 'char-columns 'char-width)
176 (make-obsolete 'char-columns 'char-width) 176 (make-obsolete 'char-columns 'char-width)
177 177
178 (defalias 'find-charset-string 'charsets-in-string) 178 (defalias 'find-charset-string 'charsets-in-string)
312 ;; ENABLE-FUNCTION should be a function of no arguments that will be called 312 ;; ENABLE-FUNCTION should be a function of no arguments that will be called
313 ;; when the language environment is made current." 313 ;; when the language environment is made current."
314 ;; (put env-sym 'quail-environ-doc-string doc-string) 314 ;; (put env-sym 'quail-environ-doc-string doc-string)
315 ;; (put env-sym 'set-quail-environ enable-function)) 315 ;; (put env-sym 'set-quail-environ enable-function))
316 316
317
318 ;;; @ coding-system category
319 ;;;
320
321 (defun coding-system-get (coding-system prop)
322 "Extract a value from CODING-SYSTEM's property list for property PROP."
323 (or (plist-get
324 (get (coding-system-name coding-system) 'coding-system-property)
325 prop)
326 (condition-case nil
327 (coding-system-property coding-system prop)
328 (error nil))))
329
330 (defun coding-system-put (coding-system prop val)
331 "Change value in CODING-SYSTEM's property list PROP to VAL."
332 (put (coding-system-name coding-system)
333 'coding-system-property
334 (plist-put (get (coding-system-name coding-system)
335 'coding-system-property)
336 prop val)))
337
338 (defun coding-system-category (coding-system)
339 "Return the coding category of CODING-SYSTEM."
340 (or (coding-system-get coding-system 'category)
341 (let ((type (coding-system-type coding-system)))
342 (cond ((eq type 'no-conversion)
343 'no-conversion)
344 ((eq type 'shift-jis)
345 'shift-jis)
346 ((eq type 'ucs-4)
347 'ucs-4)
348 ((eq type 'utf-8)
349 'utf-8)
350 ((eq type 'big5)
351 'big5)
352 ((eq type 'iso2022)
353 (cond ((coding-system-lock-shift coding-system)
354 'iso-lock-shift)
355 ((coding-system-seven coding-system)
356 'iso-7)
357 (t
358 (let ((dim 0)
359 ccs
360 (i 0))
361 (while (< i 4)
362 (setq ccs (coding-system-charset coding-system i))
363 (if (and ccs
364 (> (charset-dimension ccs) dim))
365 (setq dim (charset-dimension ccs))
366 )
367 (setq i (1+ i)))
368 (cond ((= dim 1) 'iso-8-1)
369 ((= dim 2) 'iso-8-2)
370 (t 'iso-8-designate))
371 ))))))))
372
317 ;;; mule-misc.el ends here 373 ;;; mule-misc.el ends here