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