Skip to content
Newer
Older
100644 244 lines (214 sloc) 7.62 KB
aac2eb1 - Rename emu-20.el to mcs-20.el.
morioka authored Sep 17, 1998
1 ;;; mcs-om.el --- MIME charset implementation for Mule 1.* and Mule 2.*
2
3 ;; Copyright (C) 1995,1996,1997,1998 MORIOKA Tomohiko
4
5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
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
eefe87e Update FSF's address in GPL notices.
yamaoka authored Jul 6, 2005
22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
23 ;; Boston, MA 02110-1301, USA.
aac2eb1 - Rename emu-20.el to mcs-20.el.
morioka authored Sep 17, 1998
24
25 ;;; Code:
26
27 (require 'poem)
28
2073495 Merge apel-mcs-2-9_12_2.
morioka authored Feb 27, 1999
29 (defsubst lbt-to-string (lbt)
30 (cdr (assq lbt '((nil . nil)
31 (CRLF . "\r\n")
32 (CR . "\r")
33 (dos . "\r\n")
34 (mac . "\r"))))
35 )
36
37 (defun encode-mime-charset-region (start end charset &optional lbt)
aac2eb1 - Rename emu-20.el to mcs-20.el.
morioka authored Sep 17, 1998
38 "Encode the text between START and END as MIME CHARSET."
2073495 Merge apel-mcs-2-9_12_2.
morioka authored Feb 27, 1999
39 (let ((cs (mime-charset-to-coding-system charset lbt)))
aac2eb1 - Rename emu-20.el to mcs-20.el.
morioka authored Sep 17, 1998
40 (if cs
41 (code-convert start end *internal* cs)
2073495 Merge apel-mcs-2-9_12_2.
morioka authored Feb 27, 1999
42 (if (and lbt (setq cs (mime-charset-to-coding-system charset)))
43 (let ((newline (lbt-to-string lbt)))
44 (save-excursion
45 (save-restriction
46 (narrow-to-region start end)
47 (code-convert (point-min) (point-max) *internal* cs)
48 (if newline
49 (goto-char (point-min))
50 (while (search-forward "\n" nil t)
51 (replace-match newline))))))))))
aac2eb1 - Rename emu-20.el to mcs-20.el.
morioka authored Sep 17, 1998
52
53 (defun decode-mime-charset-region (start end charset &optional lbt)
54 "Decode the text between START and END as MIME CHARSET."
2073495 Merge apel-mcs-2-9_12_2.
morioka authored Feb 27, 1999
55 (let ((cs (mime-charset-to-coding-system charset lbt)))
aac2eb1 - Rename emu-20.el to mcs-20.el.
morioka authored Sep 17, 1998
56 (if cs
57 (code-convert start end cs *internal*)
58 (if (and lbt (setq cs (mime-charset-to-coding-system charset)))
2073495 Merge apel-mcs-2-9_12_2.
morioka authored Feb 27, 1999
59 (let ((newline (lbt-to-string lbt)))
60 (if newline
aac2eb1 - Rename emu-20.el to mcs-20.el.
morioka authored Sep 17, 1998
61 (save-excursion
62 (save-restriction
63 (narrow-to-region start end)
64 (goto-char (point-min))
65 (while (search-forward newline nil t)
66 (replace-match "\n")))
67 (code-convert (point-min) (point-max) cs *internal*))
68 (code-convert start end cs *internal*)))))))
69
2073495 Merge apel-mcs-2-9_12_2.
morioka authored Feb 27, 1999
70 (defun encode-mime-charset-string (string charset &optional lbt)
aac2eb1 - Rename emu-20.el to mcs-20.el.
morioka authored Sep 17, 1998
71 "Encode the STRING as MIME CHARSET."
2073495 Merge apel-mcs-2-9_12_2.
morioka authored Feb 27, 1999
72 (let ((cs (mime-charset-to-coding-system charset lbt)))
aac2eb1 - Rename emu-20.el to mcs-20.el.
morioka authored Sep 17, 1998
73 (if cs
74 (code-convert-string string *internal* cs)
2073495 Merge apel-mcs-2-9_12_2.
morioka authored Feb 27, 1999
75 (if (and lbt (setq cs (mime-charset-to-coding-system charset)))
76 (let ((newline (lbt-to-string lbt)))
77 (if newline
78 (with-temp-buffer
79 (insert string)
80 (code-convert (point-min) (point-max) *internal* cs)
81 (goto-char (point-min))
82 (while (search-forward "\n" nil t)
83 (replace-match newline))
84 (buffer-string))
85 (decode-coding-string string cs)))
86 string))))
aac2eb1 - Rename emu-20.el to mcs-20.el.
morioka authored Sep 17, 1998
87
88 (defun decode-mime-charset-string (string charset &optional lbt)
89 "Decode the STRING which is encoded in MIME CHARSET."
2073495 Merge apel-mcs-2-9_12_2.
morioka authored Feb 27, 1999
90 (let ((cs (mime-charset-to-coding-system charset lbt)))
aac2eb1 - Rename emu-20.el to mcs-20.el.
morioka authored Sep 17, 1998
91 (if cs
92 (decode-coding-string string cs)
93 (if (and lbt (setq cs (mime-charset-to-coding-system charset)))
2073495 Merge apel-mcs-2-9_12_2.
morioka authored Feb 27, 1999
94 (let ((newline (lbt-to-string lbt)))
95 (if newline
aac2eb1 - Rename emu-20.el to mcs-20.el.
morioka authored Sep 17, 1998
96 (with-temp-buffer
2073495 Merge apel-mcs-2-9_12_2.
morioka authored Feb 27, 1999
97 (insert string)
98 (goto-char (point-min))
99 (while (search-forward newline nil t)
100 (replace-match "\n"))
101 (code-convert (point-min) (point-max) cs *internal*)
102 (buffer-string))
aac2eb1 - Rename emu-20.el to mcs-20.el.
morioka authored Sep 17, 1998
103 (decode-coding-string string cs)))
104 string))))
105
106 (cond
9e891e8 * mcs-om.el (TopLevel): Don't refer to `running-emacs-19_29-or-later'…
yamaoka authored Feb 14, 1999
107 ((and (>= emacs-major-version 19) (>= emacs-minor-version 29))
aac2eb1 - Rename emu-20.el to mcs-20.el.
morioka authored Sep 17, 1998
108 ;; for MULE 2.3 based on Emacs 19.34.
109 (defun write-region-as-mime-charset (charset start end filename
110 &optional append visit lockname)
111 "Like `write-region', q.v., but code-convert by MIME CHARSET."
112 (let ((file-coding-system
113 (or (mime-charset-to-coding-system charset)
114 *noconv*)))
115 (write-region start end filename append visit lockname)))
116 )
117 (t
118 ;; for MULE 2.3 based on Emacs 19.28.
119 (defun write-region-as-mime-charset (charset start end filename
120 &optional append visit lockname)
121 "Like `write-region', q.v., but code-convert by MIME CHARSET."
122 (let ((file-coding-system
123 (or (mime-charset-to-coding-system charset)
124 *noconv*)))
125 (write-region start end filename append visit)))
126 ))
127
128
129 ;;; @ to coding-system
130 ;;;
131
0519cbf Avoid error when cyrillic.el is not found.
morioka authored Dec 20, 1998
132 (condition-case nil
133 (require 'cyrillic)
134 (error nil))
aac2eb1 - Rename emu-20.el to mcs-20.el.
morioka authored Sep 17, 1998
135
136 (defvar mime-charset-coding-system-alist
137 '((iso-8859-1 . *ctext*)
138 (x-ctext . *ctext*)
139 (gb2312 . *euc-china*)
140 (koi8-r . *koi8*)
141 (iso-2022-jp-2 . *iso-2022-ss2-7*)
142 (x-iso-2022-jp-2 . *iso-2022-ss2-7*)
143 (shift_jis . *sjis*)
144 (x-shiftjis . *sjis*)
145 ))
146
147 (defsubst mime-charset-to-coding-system (charset &optional lbt)
2073495 Merge apel-mcs-2-9_12_2.
morioka authored Feb 27, 1999
148 "Return coding-system corresponding with CHARSET.
149 CHARSET is a symbol whose name is MIME charset.
150 If optional argument LBT (`CRLF', `LF', `CR', `unix', `dos' or `mac')
151 is specified, it is used as line break code type of coding-system."
aac2eb1 - Rename emu-20.el to mcs-20.el.
morioka authored Sep 17, 1998
152 (if (stringp charset)
153 (setq charset (intern (downcase charset)))
154 )
155 (setq charset (or (cdr (assq charset mime-charset-coding-system-alist))
156 (intern (concat "*" (symbol-name charset) "*"))))
157 (if lbt
158 (setq charset (intern (format "%s%s" charset
159 (cond ((eq lbt 'CRLF) 'dos)
160 ((eq lbt 'LF) 'unix)
161 ((eq lbt 'CR) 'mac)
162 (t lbt)))))
163 )
164 (if (coding-system-p charset)
165 charset
166 ))
167
168
169 ;;; @ detection
170 ;;;
171
172 (defvar charsets-mime-charset-alist
173 (let ((alist
174 '(((lc-ascii) . us-ascii)
175 ((lc-ascii lc-ltn1) . iso-8859-1)
176 ((lc-ascii lc-ltn2) . iso-8859-2)
177 ((lc-ascii lc-ltn3) . iso-8859-3)
178 ((lc-ascii lc-ltn4) . iso-8859-4)
179 ;;; ((lc-ascii lc-crl) . iso-8859-5)
180 ((lc-ascii lc-crl) . koi8-r)
181 ((lc-ascii lc-arb) . iso-8859-6)
182 ((lc-ascii lc-grk) . iso-8859-7)
183 ((lc-ascii lc-hbw) . iso-8859-8)
184 ((lc-ascii lc-ltn5) . iso-8859-9)
185 ((lc-ascii lc-roman lc-jpold lc-jp) . iso-2022-jp)
186 ((lc-ascii lc-kr) . euc-kr)
187 ((lc-ascii lc-cn) . gb2312)
188 ((lc-ascii lc-big5-1 lc-big5-2) . big5)
189 ((lc-ascii lc-roman lc-ltn1 lc-grk
190 lc-jpold lc-cn lc-jp lc-kr
191 lc-jp2) . iso-2022-jp-2)
192 ((lc-ascii lc-roman lc-ltn1 lc-grk
193 lc-jpold lc-cn lc-jp lc-kr lc-jp2
194 lc-cns1 lc-cns2) . iso-2022-int-1)
195 ((lc-ascii lc-roman
196 lc-ltn1 lc-ltn2 lc-crl lc-grk
197 lc-jpold lc-cn lc-jp lc-kr lc-jp2
198 lc-cns1 lc-cns2 lc-cns3 lc-cns4
199 lc-cns5 lc-cns6 lc-cns7) . iso-2022-int-1)
200 ))
201 dest)
202 (while alist
203 (catch 'not-found
204 (let ((pair (car alist)))
205 (setq dest
206 (append dest
207 (list
208 (cons (mapcar (function
209 (lambda (cs)
210 (if (boundp cs)
211 (symbol-value cs)
212 (throw 'not-found nil)
213 )))
214 (car pair))
215 (cdr pair)))))))
216 (setq alist (cdr alist)))
217 dest))
218
219 (defvar default-mime-charset 'x-ctext
220 "Default value of MIME-charset.
221 It is used when MIME-charset is not specified.
222 It must be symbol.")
223
2073495 Merge apel-mcs-2-9_12_2.
morioka authored Feb 27, 1999
224 (defvar default-mime-charset-for-write
225 default-mime-charset
226 "Default value of MIME-charset for encoding.
227 It is used when suitable MIME-charset is not found.
228 It must be symbol.")
229
aac2eb1 - Rename emu-20.el to mcs-20.el.
morioka authored Sep 17, 1998
230 (defun detect-mime-charset-region (start end)
231 "Return MIME charset for region between START and END."
2073495 Merge apel-mcs-2-9_12_2.
morioka authored Feb 27, 1999
232 (or (charsets-to-mime-charset
233 (cons lc-ascii (find-charset-region start end)))
234 default-mime-charset-for-write))
aac2eb1 - Rename emu-20.el to mcs-20.el.
morioka authored Sep 17, 1998
235
236
237 ;;; @ end
238 ;;;
239
d52455a Add product information.
keiichi authored Dec 20, 1999
240 (require 'product)
241 (product-provide (provide 'mcs-om) (require 'apel-ver))
aac2eb1 - Rename emu-20.el to mcs-20.el.
morioka authored Sep 17, 1998
242
243 ;;; mcs-om.el ends here
Something went wrong with that request. Please try again.