X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mcs-e20.el;h=00b621e791bd41a44029eec487941c1b8540b9ae;hb=6a035e2edc196d6f1f0482c4fec18332388313bf;hp=f46d4913002248e52001b52359fa6245d5237077;hpb=028caf63058d5a78f65c79a41bfe938589f3f9cf;p=elisp%2Fapel.git diff --git a/mcs-e20.el b/mcs-e20.el index f46d491..00b621e 100644 --- a/mcs-e20.el +++ b/mcs-e20.el @@ -1,8 +1,8 @@ ;;; mcs-e20.el --- MIME charset implementation for Emacs 20.1 and 20.2 -;; Copyright (C) 1996,1997,1998 Free Software Foundation, Inc. +;; Copyright (C) 1996,1997,1998,1999 Free Software Foundation, Inc. -;; Author: MORIOKA Tomohiko +;; Author: MORIOKA Tomohiko ;; Keywords: emulation, compatibility, Mule ;; This file is part of APEL (A Portable Emacs Library). @@ -28,11 +28,16 @@ ;;; Code: -(defsubst encode-mime-charset-region (start end charset) +(eval-when-compile + (require 'static) + (require 'poem) + ) + +(defsubst encode-mime-charset-region (start end charset &optional lbt) "Encode the text between START and END as MIME CHARSET." (let (cs) (if (and enable-multibyte-characters - (setq cs (mime-charset-to-coding-system charset))) + (setq cs (mime-charset-to-coding-system charset lbt))) (encode-coding-region start end cs) ))) @@ -45,11 +50,11 @@ ))) -(defsubst encode-mime-charset-string (string charset) +(defsubst encode-mime-charset-string (string charset &optional lbt) "Encode the STRING as MIME CHARSET." (let (cs) (if (and enable-multibyte-characters - (setq cs (mime-charset-to-coding-system charset))) + (setq cs (mime-charset-to-coding-system charset lbt))) (encode-coding-string string cs) string))) @@ -81,48 +86,92 @@ ((ascii korean-ksc5601) . euc-kr) ((ascii chinese-gb2312) . gb2312) ((ascii chinese-big5-1 chinese-big5-2) . big5) + ((ascii thai-tis620 composition) . tis-620) ((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 - 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) +; ((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 +; 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) )) +(defun-maybe coding-system-get (coding-system prop) + "Extract a value from CODING-SYSTEM's property list for property PROP." + (plist-get (coding-system-plist coding-system) prop) + ) (defun coding-system-to-mime-charset (coding-system) "Convert CODING-SYSTEM to a MIME-charset. Return nil if corresponding MIME-charset is not found." (or (car (rassq coding-system mime-charset-coding-system-alist)) - (coding-system-get coding-system 'mime-charset))) + (coding-system-get coding-system 'mime-charset) + )) -(defun mime-charset-list () +(defun-maybe-cond 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 (car rest)) - (unless (rassq cs mime-charset-coding-system-alist) - (if (setq cs (coding-system-get cs 'mime-charset)) + ((boundp 'coding-system-list) + (let ((dest (mapcar (function car) mime-charset-coding-system-alist)) + (rest coding-system-list) + cs) + (while rest + (setq cs (car rest)) + (unless (rassq cs mime-charset-coding-system-alist) + (if (setq cs (coding-system-get cs 'mime-charset)) + (or (rassq cs mime-charset-coding-system-alist) + (memq cs dest) + (setq dest (cons cs dest)) + ))) + (setq rest (cdr rest))) + dest)) + (t + (let ((dest (mapcar (function car) mime-charset-coding-system-alist)) + (rest (coding-system-list)) + cs) + (while rest + (setq cs (car rest)) + (unless (rassq cs mime-charset-coding-system-alist) + (when (setq cs (or (coding-system-get cs 'mime-charset) + (and + (setq cs (aref + (coding-system-get cs 'coding-spec) + 2)) + (string-match "(MIME:[ \t]*\\([^,)]+\\)" cs) + (match-string 1 cs)))) + (setq cs (intern (downcase cs))) (or (rassq cs mime-charset-coding-system-alist) - (memq cs dest) + (memq cs dest) (setq dest (cons cs dest)) ))) - (setq rest (cdr rest))) - dest)) + (setq rest (cdr rest))) + dest) + )) + +(static-when (and (string= (decode-coding-string "\e.A\eN!" 'ctext) "\eN!") + (or (not (find-coding-system 'x-ctext)) + (coding-system-get 'x-ctext 'apel))) + (unless (find-coding-system 'x-ctext) + (make-coding-system + 'x-ctext 2 ?x + "Compound text based generic encoding for decoding unknown messages." + '((ascii t) (latin-iso8859-1 t) t t + nil ascii-eol ascii-cntl nil locking-shift single-shift nil nil nil + init-bol nil nil) + '((safe-charsets . t) + (mime-charset . x-ctext))) + (coding-system-put 'x-ctext 'apel t) + )) ;;; @ end @@ -130,6 +179,7 @@ Return nil if corresponding MIME-charset is not found." (require 'mcs-20) -(provide 'mcs-e20) +(require 'product) +(product-provide (provide 'mcs-e20) (require 'apel-ver)) ;;; mcs-e20.el ends here