24 |
|
|
25 |
;;; Code: |
;;; Code: |
26 |
|
|
27 |
(eval-when-compile (require 'cl)) |
(eval-when-compile |
28 |
|
(require 'cl) |
29 |
|
(defvar mm-mime-mule-charset-alist)) |
30 |
(require 'mail-prsvr) |
(require 'mail-prsvr) |
31 |
|
|
32 |
(eval-and-compile |
(eval-and-compile |
72 |
string))) |
string))) |
73 |
(string-as-unibyte . identity) |
(string-as-unibyte . identity) |
74 |
(string-as-multibyte . identity) |
(string-as-multibyte . identity) |
75 |
(multibyte-string-p . ignore)))) |
(multibyte-string-p . ignore) |
76 |
|
(point-at-bol . line-beginning-position) |
77 |
|
(point-at-eol . line-end-position) |
78 |
|
(insert-byte . insert-char) |
79 |
|
(multibyte-char-to-unibyte . identity)))) |
80 |
|
|
81 |
(eval-and-compile |
(eval-and-compile |
82 |
(defalias 'mm-char-or-char-int-p |
(defalias 'mm-char-or-char-int-p |
123 |
,@(unless (mm-coding-system-p 'gb2312) |
,@(unless (mm-coding-system-p 'gb2312) |
124 |
'((gb2312 . cn-gb-2312))) |
'((gb2312 . cn-gb-2312))) |
125 |
;; ISO-8859-15 is very similar to ISO-8859-1. |
;; ISO-8859-15 is very similar to ISO-8859-1. |
126 |
|
;; But this is just wrong. --fx |
127 |
,@(unless (mm-coding-system-p 'iso-8859-15) ; Emacs 21 defines it. |
,@(unless (mm-coding-system-p 'iso-8859-15) ; Emacs 21 defines it. |
128 |
'((iso-8859-15 . iso-8859-1))) |
'((iso-8859-15 . iso-8859-1))) |
129 |
;; Windows-1252 is actually a superset of Latin-1. See also |
;; Windows-1252 is actually a superset of Latin-1. See also |
130 |
;; `gnus-article-dumbquotes-map'. |
;; `gnus-article-dumbquotes-map'. |
131 |
,@(unless (mm-coding-system-p 'windows-1252) |
,@(unless (mm-coding-system-p 'windows-1252) |
132 |
(if (mm-coding-system-p 'cp1252) |
(if (mm-coding-system-p 'cp1252) |
133 |
'((windows-1252 . cp1252)) |
'((windows-1252 . cp1252)) |
134 |
'((windows-1252 . iso-8859-1)))) |
'((windows-1252 . iso-8859-1)))) |
135 |
;; Windows-1250 is a variant of Latin-2 heavily used by Microsoft |
;; Windows-1250 is a variant of Latin-2 heavily used by Microsoft |
136 |
;; Outlook users in Czech republic. Use this to allow reading of their |
;; Outlook users in Czech republic. Use this to allow reading of their |
137 |
;; e-mails. cp1250 should be defined by M-x codepage-setup. |
;; e-mails. cp1250 should be defined by M-x codepage-setup. |
138 |
|
|
139 |
|
;; This is not TRT, the MIME name, windows-1250, should be an |
140 |
|
;; alias, and cp1250 should have a mime-charset property, per |
141 |
|
;; code-page.el. -- fx |
142 |
,@(if (and (not (mm-coding-system-p 'windows-1250)) |
,@(if (and (not (mm-coding-system-p 'windows-1250)) |
143 |
(mm-coding-system-p 'cp1250)) |
(mm-coding-system-p 'cp1250)) |
144 |
'((windows-1250 . cp1250))) |
'((windows-1250 . cp1250))) |
164 |
|
|
165 |
(defvar mm-auto-save-coding-system |
(defvar mm-auto-save-coding-system |
166 |
(cond |
(cond |
167 |
|
((mm-coding-system-p 'utf-8-emacs) |
168 |
|
(if (memq system-type '(windows-nt ms-dos ms-windows)) |
169 |
|
(if (mm-coding-system-p 'utf-8-emacs-dos) |
170 |
|
'utf-8-emacs-dos mm-binary-coding-system) |
171 |
|
'utf-8-emacs)) |
172 |
((mm-coding-system-p 'emacs-mule) |
((mm-coding-system-p 'emacs-mule) |
173 |
(if (memq system-type '(windows-nt ms-dos ms-windows)) |
(if (memq system-type '(windows-nt ms-dos ms-windows)) |
174 |
(if (mm-coding-system-p 'emacs-mule-dos) |
(if (mm-coding-system-p 'emacs-mule-dos) |
247 |
'nconc |
'nconc |
248 |
(mapcar |
(mapcar |
249 |
(lambda (cs) |
(lambda (cs) |
250 |
(when (and (coding-system-get cs 'mime-charset) |
(when (and (or (coding-system-get cs :mime-charset) ; Emacs 22 |
251 |
|
(coding-system-get cs 'mime-charset)) |
252 |
(not (eq t (coding-system-get cs 'safe-charsets)))) |
(not (eq t (coding-system-get cs 'safe-charsets)))) |
253 |
(list (cons (coding-system-get cs 'mime-charset) |
(list (cons (or (coding-system-get cs :mime-charset) |
254 |
|
(coding-system-get cs 'mime-charset)) |
255 |
(delq 'ascii |
(delq 'ascii |
256 |
(coding-system-get cs 'safe-charsets)))))) |
(coding-system-get cs 'safe-charsets)))))) |
257 |
(sort-coding-systems (coding-system-list 'base-only)))))) |
(sort-coding-systems (coding-system-list 'base-only)))))) |
263 |
`iso-2022-jp-2' convert ISO-2022-jp to ISO-2022-jp-2 if ISO-2022-jp-2 exists." |
`iso-2022-jp-2' convert ISO-2022-jp to ISO-2022-jp-2 if ISO-2022-jp-2 exists." |
264 |
) |
) |
265 |
|
|
266 |
(defvar mm-iso-8859-15-compatible |
(defvar mm-iso-8859-15-compatible |
267 |
'((iso-8859-1 "\xA4\xA6\xA8\xB4\xB8\xBC\xBD\xBE") |
'((iso-8859-1 "\xA4\xA6\xA8\xB4\xB8\xBC\xBD\xBE") |
268 |
(iso-8859-9 "\xA4\xA6\xA8\xB4\xB8\xBC\xBD\xBE\xD0\xDD\xDE\xF0\xFD\xFE")) |
(iso-8859-9 "\xA4\xA6\xA8\xB4\xB8\xBC\xBD\xBE\xD0\xDD\xDE\xF0\xFD\xFE")) |
269 |
"ISO-8859-15 exchangeable coding systems and inconvertible characters.") |
"ISO-8859-15 exchangeable coding systems and inconvertible characters.") |
271 |
(defvar mm-iso-8859-x-to-15-table |
(defvar mm-iso-8859-x-to-15-table |
272 |
(and (fboundp 'coding-system-p) |
(and (fboundp 'coding-system-p) |
273 |
(mm-coding-system-p 'iso-8859-15) |
(mm-coding-system-p 'iso-8859-15) |
274 |
(mapcar |
(mapcar |
275 |
(lambda (cs) |
(lambda (cs) |
276 |
(if (mm-coding-system-p (car cs)) |
(if (mm-coding-system-p (car cs)) |
277 |
(let ((c (string-to-char |
(let ((c (string-to-char |
278 |
(decode-coding-string "\341" (car cs))))) |
(decode-coding-string "\341" (car cs))))) |
279 |
(cons (char-charset c) |
(cons (char-charset c) |
280 |
(cons |
(cons |
281 |
(- (string-to-char |
(- (string-to-char |
282 |
(decode-coding-string "\341" 'iso-8859-15)) c) |
(decode-coding-string "\341" 'iso-8859-15)) c) |
283 |
(string-to-list (decode-coding-string (car (cdr cs)) |
(string-to-list (decode-coding-string (car (cdr cs)) |
284 |
(car cs)))))) |
(car cs)))))) |
285 |
'(gnus-charset 0))) |
'(gnus-charset 0))) |
286 |
mm-iso-8859-15-compatible)) |
mm-iso-8859-15-compatible)) |
299 |
'(iso-2022-jp iso-2022-jp-2 japanese-shift-jis utf-8)) |
'(iso-2022-jp iso-2022-jp-2 japanese-shift-jis utf-8)) |
300 |
") |
") |
301 |
|
|
302 |
|
;; Why on earth was this broken out? -- fx |
303 |
(defvar mm-use-find-coding-systems-region |
(defvar mm-use-find-coding-systems-region |
304 |
(fboundp 'find-coding-systems-region) |
(fboundp 'find-coding-systems-region) |
305 |
"Use `find-coding-systems-region' to find proper coding systems.") |
"Use `find-coding-systems-region' to find proper coding systems.") |
315 |
(dolist (cs (find-coding-systems-for-charsets (list charset))) |
(dolist (cs (find-coding-systems-for-charsets (list charset))) |
316 |
(unless mime |
(unless mime |
317 |
(when cs |
(when cs |
318 |
(setq mime (coding-system-get cs 'mime-charset))))) |
(setq mime (or (coding-system-get cs :mime-charset) |
319 |
|
(coding-system-get cs 'mime-charset)))))) |
320 |
mime) |
mime) |
321 |
(let ((alist mm-mime-mule-charset-alist) |
(let ((alist mm-mime-mule-charset-alist) |
322 |
out) |
out) |
365 |
;; Do we need -lbt? |
;; Do we need -lbt? |
366 |
(dolist (c (mm-get-coding-system-list)) |
(dolist (c (mm-get-coding-system-list)) |
367 |
(if (and (null cs) |
(if (and (null cs) |
368 |
(eq charset (coding-system-get c 'mime-charset))) |
(eq charset (or (coding-system-get c :mime-charset) |
369 |
|
(coding-system-get c 'mime-charset)))) |
370 |
(setq cs c))) |
(setq cs c))) |
371 |
cs)))) |
cs)))) |
372 |
|
|
378 |
(boundp 'default-enable-multibyte-characters) |
(boundp 'default-enable-multibyte-characters) |
379 |
default-enable-multibyte-characters |
default-enable-multibyte-characters |
380 |
(fboundp 'set-buffer-multibyte)) |
(fboundp 'set-buffer-multibyte)) |
381 |
"Emacs mule.") |
"True in Emacs with Mule.") |
|
|
|
|
(defvar mm-mule4-p (and mm-emacs-mule |
|
|
(fboundp 'charsetp) |
|
|
(not (charsetp 'eight-bit-control))) |
|
|
"Mule version 4.") |
|
382 |
|
|
383 |
(if mm-emacs-mule |
(if mm-emacs-mule |
384 |
(defun mm-enable-multibyte () |
(defun mm-enable-multibyte () |
393 |
"Unset the multibyte flag of in the current buffer. |
"Unset the multibyte flag of in the current buffer. |
394 |
This is a no-op in XEmacs." |
This is a no-op in XEmacs." |
395 |
(set-buffer-multibyte nil)) |
(set-buffer-multibyte nil)) |
396 |
(defalias 'mm-disable-multibyte 'ignore)) |
(defalias 'mm-disable-multibyte 'ignore))) |
|
|
|
|
(if mm-mule4-p |
|
|
(defun mm-enable-multibyte-mule4 () |
|
|
"Enable multibyte in the current buffer. |
|
|
Only used in Emacs Mule 4." |
|
|
(set-buffer-multibyte t)) |
|
|
(defalias 'mm-enable-multibyte-mule4 'ignore)) |
|
|
|
|
|
(if mm-mule4-p |
|
|
(defun mm-disable-multibyte-mule4 () |
|
|
"Disable multibyte in the current buffer. |
|
|
Only used in Emacs Mule 4." |
|
|
(set-buffer-multibyte nil)) |
|
|
(defalias 'mm-disable-multibyte-mule4 'ignore))) |
|
397 |
|
|
398 |
(defun mm-preferred-coding-system (charset) |
(defun mm-preferred-coding-system (charset) |
399 |
;; A typo in some Emacs versions. |
;; A typo in some Emacs versions. |
410 |
(setq charset 'ascii) |
(setq charset 'ascii) |
411 |
;; charset-after is fake in some Emacsen. |
;; charset-after is fake in some Emacsen. |
412 |
(setq charset (and (fboundp 'char-charset) (char-charset char))) |
(setq charset (and (fboundp 'char-charset) (char-charset char))) |
413 |
(if (eq charset 'composition) |
(if (eq charset 'composition) ; Mule 4 |
414 |
(let ((p (or pos (point)))) |
(let ((p (or pos (point)))) |
415 |
(cadr (find-charset-region p (1+ p)))) |
(cadr (find-charset-region p (1+ p)))) |
416 |
(if (and charset (not (memq charset '(ascii eight-bit-control |
(if (and charset (not (memq charset '(ascii eight-bit-control |
442 |
;; This exists in Emacs 20. |
;; This exists in Emacs 20. |
443 |
(or |
(or |
444 |
(and (mm-preferred-coding-system charset) |
(and (mm-preferred-coding-system charset) |
445 |
(coding-system-get |
(or (coding-system-get |
446 |
(mm-preferred-coding-system charset) 'mime-charset)) |
(mm-preferred-coding-system charset) :mime-charset) |
447 |
|
(coding-system-get |
448 |
|
(mm-preferred-coding-system charset) 'mime-charset))) |
449 |
(and (eq charset 'ascii) |
(and (eq charset 'ascii) |
450 |
'us-ascii) |
'us-ascii) |
451 |
(mm-preferred-coding-system charset) |
(mm-preferred-coding-system charset) |
479 |
(goto-char (point-min)) |
(goto-char (point-min)) |
480 |
(skip-chars-forward "\0-\177") |
(skip-chars-forward "\0-\177") |
481 |
(while (not (eobp)) |
(while (not (eobp)) |
482 |
(cond |
(cond |
483 |
((not (setq item (assq (char-charset (setq c (char-after))) |
((not (setq item (assq (char-charset (setq c (char-after))) |
484 |
mm-iso-8859-x-to-15-table))) |
mm-iso-8859-x-to-15-table))) |
485 |
(forward-char)) |
(forward-char)) |
486 |
((memq c (cdr (cdr item))) |
((memq c (cdr (cdr item))) |
507 |
;; system that has one. |
;; system that has one. |
508 |
(let ((systems (find-coding-systems-region b e))) |
(let ((systems (find-coding-systems-region b e))) |
509 |
(when mm-coding-system-priorities |
(when mm-coding-system-priorities |
510 |
(setq systems |
(setq systems |
511 |
(sort systems 'mm-sort-coding-systems-predicate))) |
(sort systems 'mm-sort-coding-systems-predicate))) |
512 |
;; Fixme: The `mime-charset' (`x-ctext') of `compound-text' |
;; Fixme: The `mime-charset' (`x-ctext') of `compound-text' |
513 |
;; is not in the IANA list. |
;; is not in the IANA list. |
514 |
(setq systems (delq 'compound-text systems)) |
(setq systems (delq 'compound-text systems)) |
515 |
(unless (equal systems '(undecided)) |
(unless (equal systems '(undecided)) |
516 |
(while systems |
(while systems |
517 |
(let ((cs (coding-system-get (pop systems) 'mime-charset))) |
(let* ((head (pop systems)) |
518 |
|
(cs (or (coding-system-get head :mime-charset) |
519 |
|
(coding-system-get head 'mime-charset)))) |
520 |
(if cs |
(if cs |
521 |
(setq systems nil |
(setq systems nil |
522 |
charsets (list cs)))))) |
charsets (list cs)))))) |
523 |
charsets)) |
charsets)) |
524 |
;; Otherwise we're not multibyte, XEmacs or a single coding |
;; Otherwise we're not multibyte, XEmacs or a single coding |
525 |
;; system won't cover it. |
;; system won't cover it. |
526 |
(setq charsets |
(setq charsets |
527 |
(mm-delete-duplicates |
(mm-delete-duplicates |
528 |
(mapcar 'mm-mime-charset |
(mapcar 'mm-mime-charset |
529 |
(delq 'ascii |
(delq 'ascii |
547 |
(put 'mm-with-unibyte-buffer 'edebug-form-spec '(body)) |
(put 'mm-with-unibyte-buffer 'edebug-form-spec '(body)) |
548 |
|
|
549 |
(defmacro mm-with-unibyte-current-buffer (&rest forms) |
(defmacro mm-with-unibyte-current-buffer (&rest forms) |
550 |
"Evaluate FORMS with current current buffer temporarily made unibyte. |
"Evaluate FORMS with current buffer temporarily made unibyte. |
551 |
Also bind `default-enable-multibyte-characters' to nil. |
Also bind `default-enable-multibyte-characters' to nil. |
552 |
Equivalent to `progn' in XEmacs" |
Equivalent to `progn' in XEmacs" |
553 |
(let ((multibyte (make-symbol "multibyte")) |
(let ((multibyte (make-symbol "multibyte")) |
554 |
(buffer (make-symbol "buffer"))) |
(buffer (make-symbol "buffer"))) |
555 |
`(if mm-emacs-mule |
`(if mm-emacs-mule |
556 |
(let ((,multibyte enable-multibyte-characters) |
(let ((,multibyte enable-multibyte-characters) |
557 |
(,buffer (current-buffer))) |
(,buffer (current-buffer))) |
558 |
(unwind-protect |
(unwind-protect |
566 |
(put 'mm-with-unibyte-current-buffer 'lisp-indent-function 0) |
(put 'mm-with-unibyte-current-buffer 'lisp-indent-function 0) |
567 |
(put 'mm-with-unibyte-current-buffer 'edebug-form-spec '(body)) |
(put 'mm-with-unibyte-current-buffer 'edebug-form-spec '(body)) |
568 |
|
|
|
(defmacro mm-with-unibyte-current-buffer-mule4 (&rest forms) |
|
|
"Evaluate FORMS there like `progn' in current buffer. |
|
|
Mule4 only." |
|
|
(let ((multibyte (make-symbol "multibyte")) |
|
|
(buffer (make-symbol "buffer"))) |
|
|
`(if mm-mule4-p |
|
|
(let ((,multibyte enable-multibyte-characters) |
|
|
(,buffer (current-buffer))) |
|
|
(unwind-protect |
|
|
(let (default-enable-multibyte-characters) |
|
|
(set-buffer-multibyte nil) |
|
|
,@forms) |
|
|
(set-buffer ,buffer) |
|
|
(set-buffer-multibyte ,multibyte))) |
|
|
(let (default-enable-multibyte-characters) |
|
|
,@forms)))) |
|
|
(put 'mm-with-unibyte-current-buffer-mule4 'lisp-indent-function 0) |
|
|
(put 'mm-with-unibyte-current-buffer-mule4 'edebug-form-spec '(body)) |
|
|
|
|
569 |
(defmacro mm-with-unibyte (&rest forms) |
(defmacro mm-with-unibyte (&rest forms) |
570 |
"Eval the FORMS with the default value of `enable-multibyte-characters' nil, ." |
"Eval the FORMS with the default value of `enable-multibyte-characters' nil, ." |
571 |
`(let (default-enable-multibyte-characters) |
`(let (default-enable-multibyte-characters) |
642 |
A buffer may be modified in several ways after reading into the buffer due |
A buffer may be modified in several ways after reading into the buffer due |
643 |
to advanced Emacs features, such as file-name-handlers, format decoding, |
to advanced Emacs features, such as file-name-handlers, format decoding, |
644 |
find-file-hooks, etc. |
find-file-hooks, etc. |
645 |
If INHIBIT is non-nil, inhibit mm-inhibit-file-name-handlers. |
If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'. |
646 |
This function ensures that none of these modifications will take place." |
This function ensures that none of these modifications will take place." |
647 |
(let ((format-alist nil) |
(let ((format-alist nil) |
648 |
(auto-mode-alist (if inhibit nil (mm-auto-mode-alist))) |
(auto-mode-alist (if inhibit nil (mm-auto-mode-alist))) |