X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=lisp%2Fmule%2Fmule-misc.el;h=2a411dde8c13323bf5548bc07f5c37f70b08ca93;hp=5311b2499760c2061298cea75718295f6a42b91a;hb=b5eeb6918c29470b36f8461c402eb0c65cb19bd2;hpb=da416a1945940b3f952144475eb1a1357430527d diff --git a/lisp/mule/mule-misc.el b/lisp/mule/mule-misc.el index 5311b24..2a411dd 100644 --- a/lisp/mule/mule-misc.el +++ b/lisp/mule/mule-misc.el @@ -64,7 +64,7 @@ using a window system." (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,14 +163,14 @@ If each element of LIST is not a string, it is converted to string (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) @@ -208,19 +208,6 @@ because its `find-charset-string' ignores ASCII charset." ; (cons charset dest) ; )))) -(defun char-octet (ch &optional n) - "Return the octet numbered N (should be 0 or 1) of char CH. -N defaults to 0 if omitted." - (let ((split (split-char ch))) - (setq n (or n 0)) - (cond ((eq n 0) - (nth 1 split)) - ((eq n 1) - (nth 2 split)) - (t (error "n must be 0 or 1"))))) -;; Made obsolete June 15, 1999. Delete ASAP. -(make-obsolete 'char-octet "Use split-char") - ;(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." @@ -314,4 +301,60 @@ when the language environment is made current." ;; (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