(install-detect-elisp-directory): Fixed.

[elisp/apel.git] / mcs-xm.el

diff --git a/mcs-xm.el b/mcs-xm.el
index 946cc7d..19cbc2b 100644 (file)
--- a/mcs-xm.el
+++ b/mcs-xm.el
@@ -32,9 +32,9 @@
 (require 'mcs-20)
 
 
-(defun encode-mime-charset-region (start end charset)
+(defun encode-mime-charset-region (start end charset &optional lbt)
   "Encode the text between START and END as MIME CHARSET."
-  (let ((cs (mime-charset-to-coding-system charset)))
+  (let ((cs (mime-charset-to-coding-system charset lbt)))
     (if cs
        (encode-coding-region start end cs)
       )))
@@ -57,7 +57,8 @@
       )))
 
 (defcustom mime-iso646-character-unification-alist
-  `,(let (dest
+  (eval-when-compile
+    (let (dest
          (i 33))
       (while (< i 92)
        (setq dest
@@ -72,7 +73,7 @@
                          (format "%c" i))
                    dest))
        (setq i (1+ i)))
-      (nreverse dest))
+      (nreverse dest)))
   "Alist unified string vs. canonical string."
   :group 'i18n
   :type '(repeat (cons string string)))
@@ -95,8 +96,8 @@
        (let ((rest mime-iso646-character-unification-alist))
          (while rest
            (let ((pair (car rest)))
-             (goto-char (point-min))
-             (while (search-forward (car pair) nil t)
+             (goto-char start)
+             (while (search-forward (car pair) end t)
                (let ((str (cdr pair)))
                  (put-text-property 0 (length str)
                                     'face mime-unified-character-face str)
@@ -124,9 +125,9 @@
                       (assq t mime-charset-decoder-alist)))))
     (funcall func start end charset lbt)))
 
-(defsubst encode-mime-charset-string (string charset)
+(defsubst encode-mime-charset-string (string charset &optional lbt)
   "Encode the STRING as MIME CHARSET."
-  (let ((cs (mime-charset-to-coding-system charset)))
+  (let ((cs (mime-charset-to-coding-system charset lbt)))
     (if cs
        (encode-coding-string string cs)
       string)))
@@ -162,29 +163,42 @@
     ((ascii latin-jisx0201
            katakana-jisx0201 japanese-jisx0208)        . shift_jis)
     ((ascii korean-ksc5601)                            . euc-kr)
-    ((ascii chinese-gb2312)                            . cn-gb-2312)
-    ((ascii chinese-big5-1 chinese-big5-2)             . cn-big5)
+    ((ascii chinese-gb2312)                            . gb2312)
+    ((ascii chinese-big5-1 chinese-big5-2)             . big5)
     ((ascii latin-iso8859-1 greek-iso8859-7
            latin-jisx0201 japanese-jisx0208-1978
            chinese-gb2312 japanese-jisx0208
            korean-ksc5601 japanese-jisx0212)           . iso-2022-jp-2)
-    ((ascii latin-iso8859-1 greek-iso8859-7
-           latin-jisx0201 japanese-jisx0208-1978
-           chinese-gb2312 japanese-jisx0208
-           korean-ksc5601 japanese-jisx0212
-           chinese-cns11643-1 chinese-cns11643-2)      . iso-2022-int-1)
-    ;; ((ascii latin-iso8859-1 latin-iso8859-2
-    ;;         cyrillic-iso8859-5 greek-iso8859-7
+    ;; ((ascii latin-iso8859-1 greek-iso8859-7
     ;;         latin-jisx0201 japanese-jisx0208-1978
     ;;         chinese-gb2312 japanese-jisx0208
     ;;         korean-ksc5601 japanese-jisx0212
-    ;;         chinese-cns11643-1 chinese-cns11643-2
-    ;;         chinese-cns11643-3 chinese-cns11643-4
-    ;;         chinese-cns11643-5 chinese-cns11643-6
-    ;;         chinese-cns11643-7)                         . iso-2022-int-1)
+    ;;         chinese-cns11643-1 chinese-cns11643-2)      . iso-2022-int-1)
     ))
 
 
+(defun coding-system-to-mime-charset (coding-system)
+  "Convert CODING-SYSTEM to a MIME-charset.
+Return nil if corresponding MIME-charset is not found."
+  (setq coding-system
+       (coding-system-name (coding-system-base coding-system)))
+  (or (car (rassq coding-system mime-charset-coding-system-alist))
+      coding-system))
+
+(defun mime-charset-list ()
+  "Return a list of all existing MIME-charset."
+  (let ((dest (mapcar (function car) mime-charset-coding-system-alist))
+       (rest (coding-system-list))
+       cs)
+    (while rest
+      (setq cs (coding-system-name (coding-system-base (car rest))))
+      (or (rassq cs mime-charset-coding-system-alist)
+         (memq cs dest)
+         (setq dest (cons cs dest)))
+      (setq rest (cdr rest)))
+    dest))
+
+
 ;;; @ end
 ;;;