1 | ;;; mcs-e20.el --- MIME charset implementation for Emacs 20.1 and 20.2 |
---|
2 | |
---|
3 | ;; Copyright (C) 1996,1997,1998,1999,2000 Free Software Foundation, Inc. |
---|
4 | |
---|
5 | ;; Author: MORIOKA Tomohiko <tomo@m17n.org> |
---|
6 | ;; Keywords: emulation, compatibility, Mule |
---|
7 | |
---|
8 | ;; This file is part of APEL (A Portable Emacs Library). |
---|
9 | |
---|
10 | ;; This program is free software; you can redistribute it and/or |
---|
11 | ;; modify it under the terms of the GNU General Public License as |
---|
12 | ;; published by the Free Software Foundation; either version 2, or (at |
---|
13 | ;; your option) any later version. |
---|
14 | |
---|
15 | ;; This program is distributed in the hope that it will be useful, but |
---|
16 | ;; WITHOUT ANY WARRANTY; without even the implied warranty of |
---|
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
---|
18 | ;; General Public License for more details. |
---|
19 | |
---|
20 | ;; You should have received a copy of the GNU General Public License |
---|
21 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
---|
22 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
---|
23 | ;; Boston, MA 02111-1307, USA. |
---|
24 | |
---|
25 | ;;; Commentary: |
---|
26 | |
---|
27 | ;; This module requires Emacs 20.1 and 20.2. |
---|
28 | |
---|
29 | ;;; Code: |
---|
30 | |
---|
31 | (require 'pces) |
---|
32 | (eval-when-compile (require 'static)) |
---|
33 | |
---|
34 | (defsubst encode-mime-charset-region (start end charset &optional lbt) |
---|
35 | "Encode the text between START and END as MIME CHARSET." |
---|
36 | (let (cs) |
---|
37 | (if (and enable-multibyte-characters |
---|
38 | (setq cs (mime-charset-to-coding-system charset lbt))) |
---|
39 | (encode-coding-region start end cs) |
---|
40 | ))) |
---|
41 | |
---|
42 | (defsubst decode-mime-charset-region (start end charset &optional lbt) |
---|
43 | "Decode the text between START and END as MIME CHARSET." |
---|
44 | (let (cs) |
---|
45 | (if (and enable-multibyte-characters |
---|
46 | (setq cs (mime-charset-to-coding-system charset lbt))) |
---|
47 | (decode-coding-region start end cs) |
---|
48 | ))) |
---|
49 | |
---|
50 | |
---|
51 | (defsubst encode-mime-charset-string (string charset &optional lbt) |
---|
52 | "Encode the STRING as MIME CHARSET." |
---|
53 | (let (cs) |
---|
54 | (if (and enable-multibyte-characters |
---|
55 | (setq cs (mime-charset-to-coding-system charset lbt))) |
---|
56 | (encode-coding-string string cs) |
---|
57 | string))) |
---|
58 | |
---|
59 | (defsubst decode-mime-charset-string (string charset &optional lbt) |
---|
60 | "Decode the STRING as MIME CHARSET." |
---|
61 | (let (cs) |
---|
62 | (if (and enable-multibyte-characters |
---|
63 | (setq cs (mime-charset-to-coding-system charset lbt))) |
---|
64 | (decode-coding-string string cs) |
---|
65 | string))) |
---|
66 | |
---|
67 | |
---|
68 | (defvar charsets-mime-charset-alist |
---|
69 | '(((ascii) . us-ascii) |
---|
70 | ((ascii latin-iso8859-1) . iso-8859-1) |
---|
71 | ((ascii latin-iso8859-2) . iso-8859-2) |
---|
72 | ((ascii latin-iso8859-3) . iso-8859-3) |
---|
73 | ((ascii latin-iso8859-4) . iso-8859-4) |
---|
74 | ;;; ((ascii cyrillic-iso8859-5) . iso-8859-5) |
---|
75 | ((ascii cyrillic-iso8859-5) . koi8-r) |
---|
76 | ((ascii arabic-iso8859-6) . iso-8859-6) |
---|
77 | ((ascii greek-iso8859-7) . iso-8859-7) |
---|
78 | ((ascii hebrew-iso8859-8) . iso-8859-8) |
---|
79 | ((ascii latin-iso8859-9) . iso-8859-9) |
---|
80 | ((ascii latin-jisx0201 |
---|
81 | japanese-jisx0208-1978 japanese-jisx0208) . iso-2022-jp) |
---|
82 | ((ascii latin-jisx0201 |
---|
83 | katakana-jisx0201 japanese-jisx0208) . shift_jis) |
---|
84 | ((ascii korean-ksc5601) . euc-kr) |
---|
85 | ((ascii chinese-gb2312) . gb2312) |
---|
86 | ((ascii chinese-big5-1 chinese-big5-2) . big5) |
---|
87 | ((ascii thai-tis620 composition) . tis-620) |
---|
88 | ((ascii latin-iso8859-1 greek-iso8859-7 |
---|
89 | latin-jisx0201 japanese-jisx0208-1978 |
---|
90 | chinese-gb2312 japanese-jisx0208 |
---|
91 | korean-ksc5601 japanese-jisx0212) . iso-2022-jp-2) |
---|
92 | ; ((ascii latin-iso8859-1 greek-iso8859-7 |
---|
93 | ; latin-jisx0201 japanese-jisx0208-1978 |
---|
94 | ; chinese-gb2312 japanese-jisx0208 |
---|
95 | ; korean-ksc5601 japanese-jisx0212 |
---|
96 | ; chinese-cns11643-1 chinese-cns11643-2) . iso-2022-int-1) |
---|
97 | ; ((ascii latin-iso8859-1 latin-iso8859-2 |
---|
98 | ; cyrillic-iso8859-5 greek-iso8859-7 |
---|
99 | ; latin-jisx0201 japanese-jisx0208-1978 |
---|
100 | ; chinese-gb2312 japanese-jisx0208 |
---|
101 | ; korean-ksc5601 japanese-jisx0212 |
---|
102 | ; chinese-cns11643-1 chinese-cns11643-2 |
---|
103 | ; chinese-cns11643-3 chinese-cns11643-4 |
---|
104 | ; chinese-cns11643-5 chinese-cns11643-6 |
---|
105 | ; chinese-cns11643-7) . iso-2022-int-1) |
---|
106 | )) |
---|
107 | |
---|
108 | (defun-maybe coding-system-get (coding-system prop) |
---|
109 | "Extract a value from CODING-SYSTEM's property list for property PROP." |
---|
110 | (plist-get (coding-system-plist coding-system) prop) |
---|
111 | ) |
---|
112 | |
---|
113 | (defun coding-system-to-mime-charset (coding-system) |
---|
114 | "Convert CODING-SYSTEM to a MIME-charset. |
---|
115 | Return nil if corresponding MIME-charset is not found." |
---|
116 | (or (car (rassq coding-system mime-charset-coding-system-alist)) |
---|
117 | (coding-system-get coding-system 'mime-charset) |
---|
118 | )) |
---|
119 | |
---|
120 | (defun-maybe-cond mime-charset-list () |
---|
121 | "Return a list of all existing MIME-charset." |
---|
122 | ((boundp 'coding-system-list) |
---|
123 | (let ((dest (mapcar (function car) mime-charset-coding-system-alist)) |
---|
124 | (rest coding-system-list) |
---|
125 | cs) |
---|
126 | (while rest |
---|
127 | (setq cs (car rest)) |
---|
128 | (unless (rassq cs mime-charset-coding-system-alist) |
---|
129 | (if (setq cs (coding-system-get cs 'mime-charset)) |
---|
130 | (or (rassq cs mime-charset-coding-system-alist) |
---|
131 | (memq cs dest) |
---|
132 | (setq dest (cons cs dest)) |
---|
133 | ))) |
---|
134 | (setq rest (cdr rest))) |
---|
135 | dest)) |
---|
136 | (t |
---|
137 | (let ((dest (mapcar (function car) mime-charset-coding-system-alist)) |
---|
138 | (rest (coding-system-list)) |
---|
139 | cs) |
---|
140 | (while rest |
---|
141 | (setq cs (car rest)) |
---|
142 | (unless (rassq cs mime-charset-coding-system-alist) |
---|
143 | (when (setq cs (or (coding-system-get cs 'mime-charset) |
---|
144 | (and |
---|
145 | (setq cs (aref |
---|
146 | (coding-system-get cs 'coding-spec) |
---|
147 | 2)) |
---|
148 | (string-match "(MIME:[ \t]*\\([^,)]+\\)" cs) |
---|
149 | (match-string 1 cs)))) |
---|
150 | (setq cs (intern (downcase cs))) |
---|
151 | (or (rassq cs mime-charset-coding-system-alist) |
---|
152 | (memq cs dest) |
---|
153 | (setq dest (cons cs dest)) |
---|
154 | ))) |
---|
155 | (setq rest (cdr rest))) |
---|
156 | dest) |
---|
157 | )) |
---|
158 | |
---|
159 | (static-when (and (string= (decode-coding-string "\e.A\eN!" 'ctext) "\eN!") |
---|
160 | (or (not (find-coding-system 'x-ctext)) |
---|
161 | (coding-system-get 'x-ctext 'apel))) |
---|
162 | (unless (find-coding-system 'x-ctext) |
---|
163 | (make-coding-system |
---|
164 | 'x-ctext 2 ?x |
---|
165 | "Compound text based generic encoding for decoding unknown messages." |
---|
166 | '((ascii t) (latin-iso8859-1 t) t t |
---|
167 | nil ascii-eol ascii-cntl nil locking-shift single-shift nil nil nil |
---|
168 | init-bol nil nil) |
---|
169 | '((safe-charsets . t) |
---|
170 | (mime-charset . x-ctext))) |
---|
171 | (coding-system-put 'x-ctext 'apel t) |
---|
172 | )) |
---|
173 | |
---|
174 | |
---|
175 | ;;; @ end |
---|
176 | ;;; |
---|
177 | |
---|
178 | (require 'product) |
---|
179 | (product-provide (provide 'mcs-e20) (require 'apel-ver)) |
---|
180 | |
---|
181 | ;;; mcs-e20.el ends here |
---|