X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mcs-e20.el;h=94ad2ed9ab363255c79e2c6e0291c1f658eec0d8;hb=7ac33fd4acbdd20e941426c25ee6ab4e086a9211;hp=f46d4913002248e52001b52359fa6245d5237077;hpb=028caf63058d5a78f65c79a41bfe938589f3f9cf;p=elisp%2Fapel.git diff --git a/mcs-e20.el b/mcs-e20.el index f46d491..94ad2ed 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,2000 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,14 @@ ;;; Code: -(defsubst encode-mime-charset-region (start end charset) +(require 'pces) +(eval-when-compile (require 'static)) + +(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 +48,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))) @@ -63,73 +66,122 @@ (defvar charsets-mime-charset-alist - '(((ascii) . us-ascii) - ((ascii latin-iso8859-1) . iso-8859-1) - ((ascii latin-iso8859-2) . iso-8859-2) - ((ascii latin-iso8859-3) . iso-8859-3) - ((ascii latin-iso8859-4) . iso-8859-4) -;;; ((ascii cyrillic-iso8859-5) . iso-8859-5) - ((ascii cyrillic-iso8859-5) . koi8-r) - ((ascii arabic-iso8859-6) . iso-8859-6) - ((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) - ((ascii korean-ksc5601) . euc-kr) - ((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 - 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) - )) - + (delq + nil + `(((ascii) . us-ascii) + ((ascii latin-iso8859-1) . iso-8859-1) + ((ascii latin-iso8859-2) . iso-8859-2) + ((ascii latin-iso8859-3) . iso-8859-3) + ((ascii latin-iso8859-4) . iso-8859-4) + ;;((ascii cyrillic-iso8859-5) . iso-8859-5) + ((ascii cyrillic-iso8859-5) . koi8-r) + ((ascii arabic-iso8859-6) . iso-8859-6) + ((ascii greek-iso8859-7) . iso-8859-7) + ((ascii hebrew-iso8859-8) . iso-8859-8) + ((ascii latin-iso8859-9) . iso-8859-9) + ,(if (find-coding-system 'iso-8859-14) + '((ascii latin-iso8859-14) . iso-8859-14)) + ,(if (find-coding-system 'iso-8859-15) + '((ascii latin-iso8859-15) . iso-8859-15)) + ((ascii latin-jisx0201 + japanese-jisx0208-1978 japanese-jisx0208) . iso-2022-jp) + ((ascii latin-jisx0201 + katakana-jisx0201 japanese-jisx0208) . shift_jis) + ((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) + ))) + +(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 ;;; -(require 'mcs-20) - -(provide 'mcs-e20) +(require 'product) +(product-provide (provide 'mcs-e20) (require 'apel-ver)) ;;; mcs-e20.el ends here