X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=lisp%2Fmule%2Fmule-misc.el;h=eeecb2f6ca946b7e75db8db113d7d801def198ee;hb=5d1822b6fca5b7f9ae63776b870251689248a637;hp=fe9948f2b8db319c8d43fc4438d9c496c455e4d0;hpb=976b002b16336930724ae22476014583ad022e7d;p=chise%2Fxemacs-chise.git.1 diff --git a/lisp/mule/mule-misc.el b/lisp/mule/mule-misc.el index fe9948f..eeecb2f 100644 --- a/lisp/mule/mule-misc.el +++ b/lisp/mule/mule-misc.el @@ -19,7 +19,7 @@ ;; General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the +;; along with XEmacs; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. @@ -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) @@ -190,53 +190,34 @@ It might be available for compatibility with Mule 2.3, 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-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 - -(defun set-buffer-process-coding-system (decoding encoding) - "Set coding systems for the process associated with the current buffer. -DECODING is the coding system to be used to decode input from the process, -ENCODING is the coding system to be used to encode output to the process. - -For a list of possible values of CODING-SYSTEM, use \\[list-coding-systems]." - (interactive - "zCoding-system for process input: \nzCoding-system for process output: ") - (let ((proc (get-buffer-process (current-buffer)))) - (if (null proc) - (error "no process") - (check-coding-system decoding) - (check-coding-system encoding) - (set-process-coding-system proc decoding encoding))) - (force-mode-line-update)) +;(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) +; )))) ;;; Language environments @@ -301,4 +282,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 value) + "Change value in CODING-SYSTEM's property list PROP to VALUE." + (put (coding-system-name coding-system) + 'coding-system-property + (plist-put (get (coding-system-name coding-system) + 'coding-system-property) + prop value))) + +(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