Mercurial > hg > xemacs-beta
diff lisp/mule/mule-misc.el @ 398:74fd4e045ea6 r21-2-29
Import from CVS: tag r21-2-29
author | cvs |
---|---|
date | Mon, 13 Aug 2007 11:13:30 +0200 |
parents | 4f79e16b1112 |
children | 697ef44129c6 |
line wrap: on
line diff
--- a/lisp/mule/mule-misc.el Mon Aug 13 11:12:06 2007 +0200 +++ b/lisp/mule/mule-misc.el Mon Aug 13 11:13:30 2007 +0200 @@ -1,6 +1,6 @@ ;; mule-misc.el --- Miscellaneous Mule functions. -;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. +;; Copyright (C) 1995,1999 Electrotechnical Laboratory, JAPAN. ;; Licensed to the Free Software Foundation. ;; Copyright (C) 1992,93,94,95 Free Software Foundation, Inc. ;; Copyright (C) 1995 Amdahl Corporation. @@ -64,7 +64,7 @@ (len (length string)) (i 0)) (while (< i len) - (setq col (+ col (charset-columns (char-charset (aref string i))))) + (setq col (+ col (charset-width (char-charset (aref string i))))) (setq i (1+ i))) col)) @@ -163,20 +163,18 @@ (defalias 'sref 'aref) (defalias 'map-char-concat 'mapcar) (defun char-bytes (character) - "Return number of length a CHARACTER occupies in a string or buffer. -It returns only 1 in XEmacs. It is for compatibility with MULE 2.3." + "Return number of bytes a CHARACTER occupies in a string or buffer. +It always returns 1 in XEmacs. It is for compatibility with MULE 2.3." 1) (defalias 'char-length 'char-bytes) (defun char-width (character) "Return number of columns a CHARACTER occupies when displayed." - (charset-columns (char-charset character))) + (charset-width (char-charset character))) (defalias 'char-columns 'char-width) (make-obsolete 'char-columns 'char-width) -(defalias 'charset-description 'charset-doc-string) - (defalias 'find-charset-string 'charsets-in-string) (defalias 'find-charset-region 'charsets-in-region) @@ -192,23 +190,34 @@ because its `find-charset-string' ignores ASCII charset." (delq 'ascii (charsets-in-region start end))) -(defun split-char (char) - "Return list of charset and one or two position-codes of CHAR." - (let ((charset (char-charset char))) - (if (eq charset 'ascii) - (list charset (char-int char)) - (let ((i 0) - (len (charset-dimension charset)) - (code (if (integerp char) - char - (char-int char))) - dest) - (while (< i len) - (setq dest (cons (logand code 127) dest) - code (lsh code -7) - i (1+ i))) - (cons charset dest) - )))) +;(defun split-char (char) +; "Return list of charset and one or two position-codes of CHAR." +; (let ((charset (char-charset char))) +; (if (eq charset 'ascii) +; (list charset (char-int char)) +; (let ((i 0) +; (len (charset-dimension charset)) +; (code (if (integerp char) +; char +; (char-int char))) +; dest) +; (while (< i len) +; (setq dest (cons (logand code 127) dest) +; code (lsh code -7) +; i (1+ i))) +; (cons charset dest) +; )))) + +;(defun split-char-or-char-int (char) +; "Return list of charset and one or two position-codes of CHAR. +;CHAR must be character or integer." +; (if (characterp char) +; (split-char char) +; (let ((c (int-char char))) +; (if c +; (split-char c) +; (list 'ascii c) +; )))) ;;; Commands @@ -292,4 +301,60 @@ ;; (put env-sym 'quail-environ-doc-string doc-string) ;; (put env-sym 'set-quail-environ enable-function)) + +;;; @ coding-system category +;;; + +(defun coding-system-get (coding-system prop) + "Extract a value from CODING-SYSTEM's property list for property PROP." + (or (plist-get + (get (coding-system-name coding-system) 'coding-system-property) + prop) + (condition-case nil + (coding-system-property coding-system prop) + (error nil)))) + +(defun coding-system-put (coding-system prop val) + "Change value in CODING-SYSTEM's property list PROP to VAL." + (put (coding-system-name coding-system) + 'coding-system-property + (plist-put (get (coding-system-name coding-system) + 'coding-system-property) + prop val))) + +(defun coding-system-category (coding-system) + "Return the coding category of CODING-SYSTEM." + (or (coding-system-get coding-system 'category) + (let ((type (coding-system-type coding-system))) + (cond ((eq type 'no-conversion) + 'no-conversion) + ((eq type 'shift-jis) + 'shift-jis) + ((eq type 'ucs-4) + 'ucs-4) + ((eq type 'utf-8) + 'utf-8) + ((eq type 'big5) + 'big5) + ((eq type 'iso2022) + (cond ((coding-system-lock-shift coding-system) + 'iso-lock-shift) + ((coding-system-seven coding-system) + 'iso-7) + (t + (let ((dim 0) + ccs + (i 0)) + (while (< i 4) + (setq ccs (coding-system-charset coding-system i)) + (if (and ccs + (> (charset-dimension ccs) dim)) + (setq dim (charset-dimension ccs)) + ) + (setq i (1+ i))) + (cond ((= dim 1) 'iso-8-1) + ((= dim 2) 'iso-8-2) + (t 'iso-8-designate)) + )))))))) + ;;; mule-misc.el ends here