123 |
|
|
124 |
(defun mm-coding-system-p (cs) |
(defun mm-coding-system-p (cs) |
125 |
"Return non-nil if CS is a symbol naming a coding system. |
"Return non-nil if CS is a symbol naming a coding system. |
126 |
In XEmacs, also return non-nil if CS is a coding system object." |
In XEmacs, also return non-nil if CS is a coding system object. |
127 |
|
If CS is available, return CS itself in Emacs, and return a coding |
128 |
|
system object in XEmacs." |
129 |
(if (fboundp 'find-coding-system) |
(if (fboundp 'find-coding-system) |
130 |
(find-coding-system cs) |
(find-coding-system cs) |
131 |
(if (fboundp 'coding-system-p) |
(if (fboundp 'coding-system-p) |
132 |
(coding-system-p cs) |
(when (coding-system-p cs) |
133 |
|
cs) |
134 |
;; Is this branch ever actually useful? |
;; Is this branch ever actually useful? |
135 |
(memq cs (mm-get-coding-system-list))))) |
(car (memq cs (mm-get-coding-system-list)))))) |
136 |
|
|
137 |
(defvar mm-charset-synonym-alist |
(defvar mm-charset-synonym-alist |
138 |
`( |
`( |
222 |
(big5 chinese-big5-1 chinese-big5-2) |
(big5 chinese-big5-1 chinese-big5-2) |
223 |
(tibetan tibetan) |
(tibetan tibetan) |
224 |
(thai-tis620 thai-tis620) |
(thai-tis620 thai-tis620) |
225 |
|
(windows-1251 cyrillic-iso8859-5) |
226 |
(iso-2022-7bit ethiopic arabic-1-column arabic-2-column) |
(iso-2022-7bit ethiopic arabic-1-column arabic-2-column) |
227 |
(iso-2022-jp-2 latin-iso8859-1 greek-iso8859-7 |
(iso-2022-jp-2 latin-iso8859-1 greek-iso8859-7 |
228 |
latin-jisx0201 japanese-jisx0208-1978 |
latin-jisx0201 japanese-jisx0208-1978 |
229 |
chinese-gb2312 japanese-jisx0208 |
chinese-gb2312 japanese-jisx0208 |
230 |
korean-ksc5601 japanese-jisx0212 |
korean-ksc5601 japanese-jisx0212) |
|
katakana-jisx0201) |
|
231 |
(iso-2022-int-1 latin-iso8859-1 greek-iso8859-7 |
(iso-2022-int-1 latin-iso8859-1 greek-iso8859-7 |
232 |
latin-jisx0201 japanese-jisx0208-1978 |
latin-jisx0201 japanese-jisx0208-1978 |
233 |
chinese-gb2312 japanese-jisx0208 |
chinese-gb2312 japanese-jisx0208 |
242 |
chinese-cns11643-3 chinese-cns11643-4 |
chinese-cns11643-3 chinese-cns11643-4 |
243 |
chinese-cns11643-5 chinese-cns11643-6 |
chinese-cns11643-5 chinese-cns11643-6 |
244 |
chinese-cns11643-7) |
chinese-cns11643-7) |
245 |
|
(iso-2022-jp-3 latin-jisx0201 japanese-jisx0208-1978 japanese-jisx0208 |
246 |
|
japanese-jisx0213-1 japanese-jisx0213-2) |
247 |
|
(shift_jis latin-jisx0201 katakana-jisx0201 japanese-jisx0208) |
248 |
,(if (or (not (fboundp 'charsetp)) ;; non-Mule case |
,(if (or (not (fboundp 'charsetp)) ;; non-Mule case |
249 |
(charsetp 'unicode-a) |
(charsetp 'unicode-a) |
250 |
(not (mm-coding-system-p 'mule-utf-8))) |
(not (mm-coding-system-p 'mule-utf-8))) |
255 |
(coding-system-get 'mule-utf-8 'safe-charsets))))) |
(coding-system-get 'mule-utf-8 'safe-charsets))))) |
256 |
"Alist of MIME-charset/MULE-charsets.") |
"Alist of MIME-charset/MULE-charsets.") |
257 |
|
|
258 |
;; Correct by construction, but should be unnecessary: |
(defun mm-enrich-utf-8-by-mule-ucs () |
259 |
;; XEmacs hates it. |
"Make the `utf-8' MIME charset usable by the Mule-UCS package. |
260 |
(when (and (not (featurep 'xemacs)) |
This function will run when the `un-define' module is loaded under |
261 |
(fboundp 'coding-system-list) |
XEmacs, and fill the `utf-8' entry in `mm-mime-mule-charset-alist' |
262 |
(fboundp 'sort-coding-systems)) |
with Mule charsets. It is completely useless for Emacs." |
263 |
(setq mm-mime-mule-charset-alist |
(unless (cdr (delete '(mm-enrich-utf-8-by-mule-ucs) |
264 |
(apply |
(assoc "un-define" after-load-alist))) |
265 |
'nconc |
(setq after-load-alist |
266 |
(mapcar |
(delete '("un-define") after-load-alist))) |
267 |
(lambda (cs) |
(when (boundp 'unicode-basic-translation-charset-order-list) |
268 |
(when (and (or (coding-system-get cs :mime-charset) ; Emacs 22 |
(condition-case nil |
269 |
(coding-system-get cs 'mime-charset)) |
(let ((val (delq |
270 |
(not (eq t (coding-system-get cs 'safe-charsets)))) |
'ascii |
271 |
(list (cons (or (coding-system-get cs :mime-charset) |
(copy-sequence |
272 |
(coding-system-get cs 'mime-charset)) |
(symbol-value |
273 |
(delq 'ascii |
'unicode-basic-translation-charset-order-list)))) |
274 |
(coding-system-get cs 'safe-charsets)))))) |
(elem (assq 'utf-8 mm-mime-mule-charset-alist))) |
275 |
(sort-coding-systems (coding-system-list 'base-only)))))) |
(if elem |
276 |
|
(setcdr elem val) |
277 |
|
(setq mm-mime-mule-charset-alist |
278 |
|
(nconc mm-mime-mule-charset-alist |
279 |
|
(list (cons 'utf-8 val)))))) |
280 |
|
(error)))) |
281 |
|
|
282 |
|
;; Correct by construction, but should be unnecessary for Emacs: |
283 |
|
(if (featurep 'xemacs) |
284 |
|
(eval-after-load "un-define" '(mm-enrich-utf-8-by-mule-ucs)) |
285 |
|
(when (and (fboundp 'coding-system-list) |
286 |
|
(fboundp 'sort-coding-systems)) |
287 |
|
(let ((css (sort-coding-systems (coding-system-list 'base-only))) |
288 |
|
cs mime mule alist) |
289 |
|
(while css |
290 |
|
(setq cs (pop css) |
291 |
|
mime (or (coding-system-get cs :mime-charset) ; Emacs 22 |
292 |
|
(coding-system-get cs 'mime-charset))) |
293 |
|
(when (and mime |
294 |
|
(not (eq t (setq mule |
295 |
|
(coding-system-get cs 'safe-charsets)))) |
296 |
|
(not (assq mime alist))) |
297 |
|
(push (cons mime (delq 'ascii mule)) alist))) |
298 |
|
(setq mm-mime-mule-charset-alist (nreverse alist))))) |
299 |
|
|
300 |
(defcustom mm-coding-system-priorities |
(defcustom mm-coding-system-priorities |
301 |
(if (boundp 'current-language-environment) |
(if (boundp 'current-language-environment) |
302 |
(let ((lang (symbol-value 'current-language-environment))) |
(let ((lang (symbol-value 'current-language-environment))) |
303 |
(cond ((string= lang "Japanese") |
(cond ((string= lang "Japanese") |
304 |
;; Japanese users may prefer iso-2022-jp to shift-jis. |
;; Japanese users prefer iso-2022-jp to euc-japan or |
305 |
'(iso-2022-jp iso-2022-jp-2 japanese-shift-jis |
;; shift_jis, however iso-8859-1 should be used when |
306 |
iso-latin-1 utf-8))))) |
;; there are only ASCII text and Latin-1 characters. |
307 |
|
'(iso-8859-1 iso-2022-jp iso-2022-jp-2 shift_jis utf-8))))) |
308 |
"Preferred coding systems for encoding outgoing messages. |
"Preferred coding systems for encoding outgoing messages. |
309 |
|
|
310 |
More than one suitable coding system may be found for some text. |
More than one suitable coding system may be found for some text. |
331 |
"Return the MIME charset corresponding to the given Mule CHARSET." |
"Return the MIME charset corresponding to the given Mule CHARSET." |
332 |
(if (and (fboundp 'find-coding-systems-for-charsets) |
(if (and (fboundp 'find-coding-systems-for-charsets) |
333 |
(fboundp 'sort-coding-systems)) |
(fboundp 'sort-coding-systems)) |
334 |
(let (mime) |
(let ((css (sort (sort-coding-systems |
335 |
(dolist (cs (sort-coding-systems |
(find-coding-systems-for-charsets (list charset))) |
336 |
(copy-sequence |
'mm-sort-coding-systems-predicate)) |
337 |
(find-coding-systems-for-charsets (list charset))))) |
cs mime) |
338 |
(unless mime |
(while (and (not mime) |
339 |
(when cs |
css) |
340 |
(setq mime (or (coding-system-get cs :mime-charset) |
(when (setq cs (pop css)) |
341 |
(coding-system-get cs 'mime-charset)))))) |
(setq mime (or (coding-system-get cs :mime-charset) |
342 |
|
(coding-system-get cs 'mime-charset))))) |
343 |
mime) |
mime) |
344 |
(let ((alist mm-mime-mule-charset-alist) |
(let ((alist (mapcar (lambda (cs) |
345 |
|
(assq cs mm-mime-mule-charset-alist)) |
346 |
|
(sort (mapcar 'car mm-mime-mule-charset-alist) |
347 |
|
'mm-sort-coding-systems-predicate))) |
348 |
out) |
out) |
349 |
(while alist |
(while alist |
350 |
(when (memq charset (cdar alist)) |
(when (memq charset (cdar alist)) |
516 |
(let ((priorities |
(let ((priorities |
517 |
(mapcar (lambda (cs) |
(mapcar (lambda (cs) |
518 |
;; Note: invalid entries are dropped silently |
;; Note: invalid entries are dropped silently |
519 |
(and (coding-system-p cs) |
(and (setq cs (mm-coding-system-p cs)) |
520 |
(coding-system-base cs))) |
(coding-system-base cs))) |
521 |
mm-coding-system-priorities))) |
mm-coding-system-priorities))) |
522 |
(> (length (memq a priorities)) |
(and (setq a (mm-coding-system-p a)) |
523 |
(length (memq b priorities))))) |
(if (setq b (mm-coding-system-p b)) |
524 |
|
(> (length (memq (coding-system-base a) priorities)) |
525 |
|
(length (memq (coding-system-base b) priorities))) |
526 |
|
t)))) |
527 |
|
|
528 |
(defun mm-find-mime-charset-region (b e) |
(defun mm-find-mime-charset-region (b e) |
529 |
"Return the MIME charsets needed to encode the region between B and E. |
"Return the MIME charsets needed to encode the region between B and E. |