X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mcs-xm.el;h=cc484ebfa5298717e018b372825b0fa4de49e2a0;hb=a28bd2cf8a18a82d6bc79d107c362faf46e3817c;hp=cd16617d5cb23d1e4410067be5989405ebbf453b;hpb=53ef90a1f58736cf2d5422246ef5f2211e7511c9;p=elisp%2Fapel.git diff --git a/mcs-xm.el b/mcs-xm.el index cd16617..cc484eb 100644 --- a/mcs-xm.el +++ b/mcs-xm.el @@ -1,9 +1,9 @@ ;;; mcs-xm.el --- MIME charset implementation for XEmacs-mule -;; Copyright (C) 1997,1998 Free Software Foundation, Inc. +;; Copyright (C) 1997,1998,1999,2000 Free Software Foundation, Inc. -;; Author: MORIOKA Tomohiko -;; Keywords: emulation, compatibility, Mule +;; Author: MORIOKA Tomohiko +;; Keywords: MIME-charset, coding-system, emulation, compatibility, Mule ;; This file is part of APEL (A Portable Emacs Library). @@ -29,23 +29,27 @@ ;;; Code: -(require 'mcs-20) +(require 'poem) -(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) ))) (defcustom mime-charset-decoder-alist - '((iso-2022-jp . decode-mime-charset-region-with-iso646-unification) - (iso-2022-jp-2 . decode-mime-charset-region-with-iso646-unification) - (x-ctext . decode-mime-charset-region-with-iso646-unification) - (hz-gb-2312 . decode-mime-charset-region-for-hz) - (t . decode-mime-charset-region-default)) + (let ((alist + '((hz-gb-2312 . decode-mime-charset-region-for-hz) + (t . decode-mime-charset-region-default)))) + (if (featurep 'utf-2000) + alist + (list* + '(iso-2022-jp . decode-mime-charset-region-with-iso646-unification) + '(iso-2022-jp-2 . decode-mime-charset-region-with-iso646-unification) + alist))) "Alist MIME-charset vs. decoder function." :group 'i18n :type '(repeat (cons mime-charset function))) @@ -56,55 +60,8 @@ (decode-coding-region start end cs) ))) -(defcustom mime-iso646-character-unification-alist - `,(let (dest - (i 33)) - (while (< i 92) - (setq dest - (cons (cons (char-to-string (make-char 'latin-jisx0201 i)) - (format "%c" i)) - dest)) - (setq i (1+ i))) - (setq i 93) - (while (< i 126) - (setq dest - (cons (cons (char-to-string (make-char 'latin-jisx0201 i)) - (format "%c" i)) - dest)) - (setq i (1+ i))) - (nreverse dest)) - "Alist unified string vs. canonical string." - :group 'i18n - :type '(repeat (cons string string))) - -(defcustom mime-unified-character-face nil - "*Face of unified character." - :group 'i18n - :type 'face) - -(defcustom mime-character-unification-limit-size 2048 - "*Limit size to unify characters." - :group 'i18n - :type 'integer) - -(defun decode-mime-charset-region-with-iso646-unification (start end charset - lbt) - (decode-mime-charset-region-default start end charset lbt) - (if (<= (- end start) mime-character-unification-limit-size) - (save-excursion - (let ((rest mime-iso646-character-unification-alist)) - (while rest - (let ((pair (car rest))) - (goto-char (point-min)) - (while (search-forward (car pair) nil t) - (let ((str (cdr pair))) - (put-text-property 0 (length str) - 'face mime-unified-character-face str) - (replace-match str 'fixed-case 'literal) - ) - )) - (setq rest (cdr rest))))) - )) +(unless (featurep 'utf-2000) + (require 'mcs-xmu)) (defun decode-mime-charset-region-for-hz (start end charset lbt) (if lbt @@ -124,9 +81,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))) @@ -146,7 +103,7 @@ (defvar charsets-mime-charset-alist - '(((ascii) . us-ascii) + `(((ascii) . us-ascii) ((ascii latin-iso8859-1) . iso-8859-1) ((ascii latin-iso8859-2) . iso-8859-2) ((ascii latin-iso8859-3) . iso-8859-3) @@ -157,28 +114,82 @@ ((ascii greek-iso8859-7) . iso-8859-7) ((ascii hebrew-iso8859-8) . iso-8859-8) ((ascii latin-iso8859-9) . iso-8859-9) - ((ascii latin-jisx0201 - japanese-jisx0208-1978 japanese-jisx0208) . iso-2022-jp) - ((ascii latin-jisx0201 - katakana-jisx0201 japanese-jisx0208) . shift_jis) + ,(if (featurep 'utf-2000) + '((ascii latin-jisx0201 + japanese-jisx0208-1978 + japanese-jisx0208 + japanese-jisx0208-1990) . iso-2022-jp) + '((ascii latin-jisx0201 + japanese-jisx0208-1978 japanese-jisx0208) + . iso-2022-jp)) + ,(if (featurep 'utf-2000) + '((ascii latin-jisx0201 + japanese-jisx0208-1978 + japanese-jisx0208 + japanese-jisx0208-1990 + japanese-jisx0213-1 + japanese-jisx0213-2) . iso-2022-jp-3) + '((ascii latin-jisx0201 + japanese-jisx0208-1978 japanese-jisx0208 + japanese-jisx0213-1 + japanese-jisx0213-2) . iso-2022-jp-3)) + ,(if (featurep 'utf-2000) + '((ascii latin-jisx0201 katakana-jisx0201 + japanese-jisx0208-1990) . shift_jis) + '((ascii latin-jisx0201 + katakana-jisx0201 japanese-jisx0208) . shift_jis)) ((ascii korean-ksc5601) . euc-kr) - ((ascii chinese-gb2312) . cn-gb) - ((ascii chinese-big5-1 chinese-big5-2) . cn-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 chinese-gb2312) . gb2312) + ((ascii chinese-big5-1 chinese-big5-2) . big5) + ((ascii thai-xtis) . tis-620) + ,(if (featurep 'utf-2000) + '((ascii latin-jisx0201 latin-iso8859-1 + greek-iso8859-7 + japanese-jisx0208-1978 japanese-jisx0208 + japanese-jisx0208-1990 + japanese-jisx0212 + chinese-gb2312 + korean-ksc5601) . iso-2022-jp-2) + '((ascii latin-jisx0201 latin-iso8859-1 + greek-iso8859-7 + japanese-jisx0208-1978 japanese-jisx0208 + japanese-jisx0212 + chinese-gb2312 + korean-ksc5601) . 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) )) +(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 ;;; -(provide 'mcs-xm) +(require 'product) +(product-provide (provide 'mcs-xm) (require 'apel-ver)) ;;; mcs-xm.el ends here