(coding-system-get): New function.
authortomo <tomo>
Mon, 28 Jun 1999 13:40:59 +0000 (13:40 +0000)
committertomo <tomo>
Mon, 28 Jun 1999 13:40:59 +0000 (13:40 +0000)
(coding-system-put): New function.
(coding-system-category): New function.

lisp/mule/mule-misc.el

index 8de1883..a8524e0 100644 (file)
@@ -313,4 +313,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 'iso-2022-jp 'mnemonics)
+       (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