1 |
;;; mm-util.el --- Utility functions for Mule and low level things |
;;; mm-util.el --- Utility functions for Mule and low level things |
2 |
;; Copyright (C) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc. |
;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004 |
3 |
|
;; Free Software Foundation, Inc. |
4 |
|
|
5 |
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
6 |
;; MORIOKA Tomohiko <morioka@jaist.ac.jp> |
;; MORIOKA Tomohiko <morioka@jaist.ac.jp> |
25 |
|
|
26 |
;;; Code: |
;;; Code: |
27 |
|
|
28 |
(eval-when-compile |
(eval-when-compile (require 'cl)) |
|
(require 'cl) |
|
|
(defvar mm-mime-mule-charset-alist)) |
|
29 |
(require 'mail-prsvr) |
(require 'mail-prsvr) |
30 |
|
|
31 |
(eval-and-compile |
(eval-and-compile |
41 |
(coding-system-list . ignore) |
(coding-system-list . ignore) |
42 |
(decode-coding-region . ignore) |
(decode-coding-region . ignore) |
43 |
(char-int . identity) |
(char-int . identity) |
|
(device-type . ignore) |
|
44 |
(coding-system-equal . equal) |
(coding-system-equal . equal) |
45 |
(annotationp . ignore) |
(annotationp . ignore) |
46 |
(set-buffer-file-coding-system . ignore) |
(set-buffer-file-coding-system . ignore) |
69 |
(setq idx (1+ idx))) |
(setq idx (1+ idx))) |
70 |
string))) |
string))) |
71 |
(string-as-unibyte . identity) |
(string-as-unibyte . identity) |
72 |
|
(string-make-unibyte . identity) |
73 |
(string-as-multibyte . identity) |
(string-as-multibyte . identity) |
74 |
(multibyte-string-p . ignore) |
(multibyte-string-p . ignore) |
75 |
(point-at-bol . line-beginning-position) |
;; It is not a MIME function, but some MIME functions use it. |
76 |
(point-at-eol . line-end-position) |
(make-temp-file . (lambda (prefix &optional dir-flag) |
77 |
|
(let ((file (expand-file-name |
78 |
|
(make-temp-name prefix) |
79 |
|
(if (fboundp 'temp-directory) |
80 |
|
(temp-directory) |
81 |
|
temporary-file-directory)))) |
82 |
|
(if dir-flag |
83 |
|
(make-directory file)) |
84 |
|
file))) |
85 |
(insert-byte . insert-char) |
(insert-byte . insert-char) |
86 |
(multibyte-char-to-unibyte . identity)))) |
(multibyte-char-to-unibyte . identity)))) |
87 |
|
|
92 |
((fboundp 'char-valid-p) 'char-valid-p) |
((fboundp 'char-valid-p) 'char-valid-p) |
93 |
(t 'identity)))) |
(t 'identity)))) |
94 |
|
|
95 |
|
;; Fixme: This seems always to be used to read a MIME charset, so it |
96 |
|
;; should be re-named and fixed (in Emacs) to offer completion only on |
97 |
|
;; proper charset names (base coding systems which have a |
98 |
|
;; mime-charset defined). XEmacs doesn't believe in mime-charset; |
99 |
|
;; test with |
100 |
|
;; `(or (coding-system-get 'iso-8859-1 'mime-charset) |
101 |
|
;; (coding-system-get 'iso-8859-1 :mime-charset))' |
102 |
|
;; Actually, there should be an `mm-coding-system-mime-charset'. |
103 |
(eval-and-compile |
(eval-and-compile |
104 |
(defalias 'mm-read-coding-system |
(defalias 'mm-read-coding-system |
105 |
(cond |
(cond |
121 |
(or mm-coding-system-list |
(or mm-coding-system-list |
122 |
(setq mm-coding-system-list (mm-coding-system-list)))) |
(setq mm-coding-system-list (mm-coding-system-list)))) |
123 |
|
|
124 |
(defun mm-coding-system-p (sym) |
(defun mm-coding-system-p (cs) |
125 |
"Return non-nil if SYM is a coding system." |
"Return non-nil if CS is a symbol naming a coding system. |
126 |
(or (and (fboundp 'coding-system-p) (coding-system-p sym)) |
In XEmacs, also return non-nil if CS is a coding system object." |
127 |
(memq sym (mm-get-coding-system-list)))) |
(if (fboundp 'find-coding-system) |
128 |
|
(find-coding-system cs) |
129 |
|
(if (fboundp 'coding-system-p) |
130 |
|
(coding-system-p cs) |
131 |
|
;; Is this branch ever actually useful? |
132 |
|
(memq cs (mm-get-coding-system-list))))) |
133 |
|
|
134 |
(defvar mm-charset-synonym-alist |
(defvar mm-charset-synonym-alist |
135 |
`( |
`( |
142 |
;; Apparently not defined in Emacs 20, but is a valid MIME name. |
;; Apparently not defined in Emacs 20, but is a valid MIME name. |
143 |
,@(unless (mm-coding-system-p 'gb2312) |
,@(unless (mm-coding-system-p 'gb2312) |
144 |
'((gb2312 . cn-gb-2312))) |
'((gb2312 . cn-gb-2312))) |
145 |
;; ISO-8859-15 is very similar to ISO-8859-1. |
;; ISO-8859-15 is very similar to ISO-8859-1. But it's _different_! |
146 |
;; But this is just wrong. --fx |
,@(unless (mm-coding-system-p 'iso-8859-15) |
|
,@(unless (mm-coding-system-p 'iso-8859-15) ; Emacs 21 defines it. |
|
147 |
'((iso-8859-15 . iso-8859-1))) |
'((iso-8859-15 . iso-8859-1))) |
148 |
|
;; BIG-5HKSCS is similar to, but different than, BIG-5. |
149 |
|
,@(unless (mm-coding-system-p 'big5-hkscs) |
150 |
|
'((big5-hkscs . big5))) |
151 |
;; Windows-1252 is actually a superset of Latin-1. See also |
;; Windows-1252 is actually a superset of Latin-1. See also |
152 |
;; `gnus-article-dumbquotes-map'. |
;; `gnus-article-dumbquotes-map'. |
153 |
,@(unless (mm-coding-system-p 'windows-1252) |
,@(unless (mm-coding-system-p 'windows-1252) |
157 |
;; Windows-1250 is a variant of Latin-2 heavily used by Microsoft |
;; Windows-1250 is a variant of Latin-2 heavily used by Microsoft |
158 |
;; Outlook users in Czech republic. Use this to allow reading of their |
;; Outlook users in Czech republic. Use this to allow reading of their |
159 |
;; e-mails. cp1250 should be defined by M-x codepage-setup. |
;; e-mails. cp1250 should be defined by M-x codepage-setup. |
|
|
|
|
;; This is not TRT, the MIME name, windows-1250, should be an |
|
|
;; alias, and cp1250 should have a mime-charset property, per |
|
|
;; code-page.el. -- fx |
|
160 |
,@(if (and (not (mm-coding-system-p 'windows-1250)) |
,@(if (and (not (mm-coding-system-p 'windows-1250)) |
161 |
(mm-coding-system-p 'cp1250)) |
(mm-coding-system-p 'cp1250)) |
162 |
'((windows-1250 . cp1250))) |
'((windows-1250 . cp1250))) |
182 |
|
|
183 |
(defvar mm-auto-save-coding-system |
(defvar mm-auto-save-coding-system |
184 |
(cond |
(cond |
185 |
((mm-coding-system-p 'utf-8-emacs) |
((mm-coding-system-p 'utf-8-emacs) ; Mule 7 |
186 |
(if (memq system-type '(windows-nt ms-dos ms-windows)) |
(if (memq system-type '(windows-nt ms-dos ms-windows)) |
187 |
(if (mm-coding-system-p 'utf-8-emacs-dos) |
(if (mm-coding-system-p 'utf-8-emacs-dos) |
188 |
'utf-8-emacs-dos mm-binary-coding-system) |
'utf-8-emacs-dos mm-binary-coding-system) |
304 |
mm-iso-8859-15-compatible)) |
mm-iso-8859-15-compatible)) |
305 |
"A table of the difference character between ISO-8859-X and ISO-8859-15.") |
"A table of the difference character between ISO-8859-X and ISO-8859-15.") |
306 |
|
|
307 |
(defvar mm-coding-system-priorities nil |
(defcustom mm-coding-system-priorities |
308 |
"Preferred coding systems for encoding outgoing mails. |
(if (boundp 'current-language-environment) |
309 |
|
(let ((lang (symbol-value 'current-language-environment))) |
310 |
More than one suitable coding systems may be found for some texts. By |
(cond ((string= lang "Japanese") |
311 |
default, a coding system with the highest priority is used to encode |
;; Japanese users may prefer iso-2022-jp to shift-jis. |
312 |
outgoing mails (see `sort-coding-systems'). If this variable is set, |
'(iso-2022-jp iso-2022-jp-2 japanese-shift-jis |
313 |
it overrides the default priority. For example, Japanese users may |
iso-latin-1 utf-8))))) |
314 |
prefer iso-2022-jp to japanese-shift-jis: |
"Preferred coding systems for encoding outgoing messages. |
315 |
|
|
316 |
\(setq mm-coding-system-priorities |
More than one suitable coding system may be found for some text. |
317 |
'(iso-2022-jp iso-2022-jp-2 japanese-shift-jis utf-8)) |
By default, the coding system with the highest priority is used |
318 |
") |
to encode outgoing messages (see `sort-coding-systems'). If this |
319 |
|
variable is set, it overrides the default priority." |
320 |
|
:type '(repeat (symbol :tag "Coding system")) |
321 |
|
:group 'mime) |
322 |
|
|
323 |
;; Why on earth was this broken out? -- fx |
;; ?? |
324 |
(defvar mm-use-find-coding-systems-region |
(defvar mm-use-find-coding-systems-region |
325 |
(fboundp 'find-coding-systems-region) |
(fboundp 'find-coding-systems-region) |
326 |
"Use `find-coding-systems-region' to find proper coding systems.") |
"Use `find-coding-systems-region' to find proper coding systems. |
327 |
|
|
328 |
|
Setting it to nil is useful on Emacsen supporting Unicode if sending |
329 |
|
mail with multiple parts is preferred to sending a Unicode one.") |
330 |
|
|
331 |
;;; Internal variables: |
;;; Internal variables: |
332 |
|
|
334 |
|
|
335 |
(defun mm-mule-charset-to-mime-charset (charset) |
(defun mm-mule-charset-to-mime-charset (charset) |
336 |
"Return the MIME charset corresponding to the given Mule CHARSET." |
"Return the MIME charset corresponding to the given Mule CHARSET." |
337 |
(if (fboundp 'find-coding-systems-for-charsets) |
(if (and (fboundp 'find-coding-systems-for-charsets) |
338 |
|
(fboundp 'sort-coding-systems)) |
339 |
(let (mime) |
(let (mime) |
340 |
(dolist (cs (find-coding-systems-for-charsets (list charset))) |
(dolist (cs (sort-coding-systems |
341 |
|
(copy-sequence |
342 |
|
(find-coding-systems-for-charsets (list charset))))) |
343 |
(unless mime |
(unless mime |
344 |
(when cs |
(when cs |
345 |
(setq mime (or (coding-system-get cs :mime-charset) |
(setq mime (or (coding-system-get cs :mime-charset) |
367 |
((null charset) |
((null charset) |
368 |
charset) |
charset) |
369 |
;; Running in a non-MULE environment. |
;; Running in a non-MULE environment. |
370 |
((null (mm-get-coding-system-list)) |
((or (null (mm-get-coding-system-list)) |
371 |
|
(not (fboundp 'coding-system-get))) |
372 |
charset) |
charset) |
373 |
;; ascii |
;; ascii |
374 |
((eq charset 'us-ascii) |
((eq charset 'us-ascii) |
384 |
charset) |
charset) |
385 |
;; Translate invalid charsets. |
;; Translate invalid charsets. |
386 |
((let ((cs (cdr (assq charset mm-charset-synonym-alist)))) |
((let ((cs (cdr (assq charset mm-charset-synonym-alist)))) |
387 |
(and cs (mm-coding-system-p charset) cs))) |
(and cs (mm-coding-system-p cs) cs))) |
388 |
;; Last resort: search the coding system list for entries which |
;; Last resort: search the coding system list for entries which |
389 |
;; have the right mime-charset in case the canonical name isn't |
;; have the right mime-charset in case the canonical name isn't |
390 |
;; defined (though it should be). |
;; defined (though it should be). |
413 |
"Set the multibyte flag of the current buffer. |
"Set the multibyte flag of the current buffer. |
414 |
Only do this if the default value of `enable-multibyte-characters' is |
Only do this if the default value of `enable-multibyte-characters' is |
415 |
non-nil. This is a no-op in XEmacs." |
non-nil. This is a no-op in XEmacs." |
416 |
(set-buffer-multibyte t)) |
(set-buffer-multibyte 'to)) |
417 |
(defalias 'mm-enable-multibyte 'ignore)) |
(defalias 'mm-enable-multibyte 'ignore)) |
418 |
|
|
419 |
(if mm-emacs-mule |
(if mm-emacs-mule |
428 |
(or (get-charset-property charset 'preferred-coding-system) |
(or (get-charset-property charset 'preferred-coding-system) |
429 |
(get-charset-property charset 'prefered-coding-system))) |
(get-charset-property charset 'prefered-coding-system))) |
430 |
|
|
431 |
|
;; Mule charsets shouldn't be used. |
432 |
|
(defsubst mm-guess-charset () |
433 |
|
"Guess Mule charset from the language environment." |
434 |
|
(or |
435 |
|
mail-parse-mule-charset ;; cached mule-charset |
436 |
|
(progn |
437 |
|
(setq mail-parse-mule-charset |
438 |
|
(and (boundp 'current-language-environment) |
439 |
|
(car (last |
440 |
|
(assq 'charset |
441 |
|
(assoc current-language-environment |
442 |
|
language-info-alist)))))) |
443 |
|
(if (or (not mail-parse-mule-charset) |
444 |
|
(eq mail-parse-mule-charset 'ascii)) |
445 |
|
(setq mail-parse-mule-charset |
446 |
|
(or (car (last (assq mail-parse-charset |
447 |
|
mm-mime-mule-charset-alist))) |
448 |
|
;; default |
449 |
|
'latin-iso8859-1))) |
450 |
|
mail-parse-mule-charset))) |
451 |
|
|
452 |
(defun mm-charset-after (&optional pos) |
(defun mm-charset-after (&optional pos) |
453 |
"Return charset of a character in current buffer at position POS. |
"Return charset of a character in current buffer at position POS. |
454 |
If POS is nil, it defauls to the current point. |
If POS is nil, it defauls to the current point. |
465 |
(if (and charset (not (memq charset '(ascii eight-bit-control |
(if (and charset (not (memq charset '(ascii eight-bit-control |
466 |
eight-bit-graphic)))) |
eight-bit-graphic)))) |
467 |
charset |
charset |
468 |
(or |
(mm-guess-charset)))))) |
|
mail-parse-mule-charset ;; cached mule-charset |
|
|
(progn |
|
|
(setq mail-parse-mule-charset |
|
|
(and (boundp 'current-language-environment) |
|
|
(car (last |
|
|
(assq 'charset |
|
|
(assoc current-language-environment |
|
|
language-info-alist)))))) |
|
|
(if (or (not mail-parse-mule-charset) |
|
|
(eq mail-parse-mule-charset 'ascii)) |
|
|
(setq mail-parse-mule-charset |
|
|
(or (car (last (assq mail-parse-charset |
|
|
mm-mime-mule-charset-alist))) |
|
|
;; Fixme: don't fix that! |
|
|
'latin-iso8859-1))) |
|
|
mail-parse-mule-charset))))))) |
|
469 |
|
|
470 |
(defun mm-mime-charset (charset) |
(defun mm-mime-charset (charset) |
471 |
"Return the MIME charset corresponding to the given Mule CHARSET." |
"Return the MIME charset corresponding to the given Mule CHARSET." |
495 |
(setq result (cons head result))) |
(setq result (cons head result))) |
496 |
(nreverse result))) |
(nreverse result))) |
497 |
|
|
498 |
;; It's not clear whether this is supposed to mean the global or local |
;; Fixme: This is used in places when it should be testing the |
499 |
;; setting. I think it's used inconsistently. -- fx |
;; default multibyteness. See mm-default-multibyte-p. |
500 |
(defsubst mm-multibyte-p () |
(eval-and-compile |
|
"Say whether multibyte is enabled." |
|
501 |
(if (and (not (featurep 'xemacs)) |
(if (and (not (featurep 'xemacs)) |
502 |
(boundp 'enable-multibyte-characters)) |
(boundp 'enable-multibyte-characters)) |
503 |
enable-multibyte-characters |
(defun mm-multibyte-p () |
504 |
(featurep 'mule))) |
"Non-nil if multibyte is enabled in the current buffer." |
505 |
|
enable-multibyte-characters) |
506 |
|
(defun mm-multibyte-p () (featurep 'mule)))) |
507 |
|
|
508 |
|
(defun mm-default-multibyte-p () |
509 |
|
"Return non-nil if the session is multibyte. |
510 |
|
This affects whether coding conversion should be attempted generally." |
511 |
|
(if (featurep 'mule) |
512 |
|
(if (boundp 'default-enable-multibyte-characters) |
513 |
|
default-enable-multibyte-characters |
514 |
|
t))) |
515 |
|
|
516 |
(defun mm-iso-8859-x-to-15-region (&optional b e) |
(defun mm-iso-8859-x-to-15-region (&optional b e) |
517 |
(if (fboundp 'char-charset) |
(if (fboundp 'char-charset) |
529 |
(setq inconvertible t) |
(setq inconvertible t) |
530 |
(forward-char)) |
(forward-char)) |
531 |
(t |
(t |
532 |
(insert (prog1 (+ c (car (cdr item))) (delete-char 1)))) |
(insert-before-markers (prog1 (+ c (car (cdr item))) |
533 |
(skip-chars-forward "\0-\177")))) |
(delete-char 1))))) |
534 |
|
(skip-chars-forward "\0-\177"))) |
535 |
(not inconvertible)))) |
(not inconvertible)))) |
536 |
|
|
537 |
(defun mm-sort-coding-systems-predicate (a b) |
(defun mm-sort-coding-systems-predicate (a b) |
538 |
(> (length (memq a mm-coding-system-priorities)) |
(let ((priorities |
539 |
(length (memq b mm-coding-system-priorities)))) |
(mapcar (lambda (cs) |
540 |
|
;; Note: invalid entries are dropped silently |
541 |
|
(and (coding-system-p cs) |
542 |
|
(coding-system-base cs))) |
543 |
|
mm-coding-system-priorities))) |
544 |
|
(> (length (memq a priorities)) |
545 |
|
(length (memq b priorities))))) |
546 |
|
|
547 |
(defun mm-find-mime-charset-region (b e &optional hack-charsets) |
(defun mm-find-mime-charset-region (b e &optional hack-charsets) |
548 |
"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. |
558 |
(when mm-coding-system-priorities |
(when mm-coding-system-priorities |
559 |
(setq systems |
(setq systems |
560 |
(sort systems 'mm-sort-coding-systems-predicate))) |
(sort systems 'mm-sort-coding-systems-predicate))) |
|
;; Fixme: The `mime-charset' (`x-ctext') of `compound-text' |
|
|
;; is not in the IANA list. |
|
561 |
(setq systems (delq 'compound-text systems)) |
(setq systems (delq 'compound-text systems)) |
562 |
(unless (equal systems '(undecided)) |
(unless (equal systems '(undecided)) |
563 |
(while systems |
(while systems |
564 |
(let* ((head (pop systems)) |
(let* ((head (pop systems)) |
565 |
(cs (or (coding-system-get head :mime-charset) |
(cs (or (coding-system-get head :mime-charset) |
566 |
(coding-system-get head 'mime-charset)))) |
(coding-system-get head 'mime-charset)))) |
567 |
(if cs |
;; The mime-charset (`x-ctext') of |
568 |
|
;; `compound-text' is not in the IANA list. We |
569 |
|
;; shouldn't normally use anything here with a |
570 |
|
;; mime-charset having an `x-' prefix. |
571 |
|
;; Fixme: Allow this to be overridden, since |
572 |
|
;; there is existing use of x-ctext. |
573 |
|
;; Also people apparently need the coding system |
574 |
|
;; `iso-2022-jp-3' (which Mule-UCS defines with |
575 |
|
;; mime-charset, though it's not valid). |
576 |
|
(if (and cs |
577 |
|
(not (string-match "^[Xx]-" (symbol-name cs))) |
578 |
|
;; UTF-16 of any variety is invalid for |
579 |
|
;; text parts and, unfortunately, has |
580 |
|
;; mime-charset defined both in Mule-UCS |
581 |
|
;; and versions of Emacs. (The name |
582 |
|
;; might be `mule-utf-16...' or |
583 |
|
;; `utf-16...'.) |
584 |
|
(not (string-match "utf-16" (symbol-name cs)))) |
585 |
(setq systems nil |
(setq systems nil |
586 |
charsets (list cs)))))) |
charsets (list cs)))))) |
587 |
charsets)) |
charsets)) |
588 |
;; Otherwise we're not multibyte, XEmacs or a single coding |
;; Otherwise we're not multibyte, we're XEmacs, or a single |
589 |
;; system won't cover it. |
;; coding system won't cover it. |
590 |
(setq charsets |
(setq charsets |
591 |
(mm-delete-duplicates |
(mm-delete-duplicates |
592 |
(mapcar 'mm-mime-charset |
(mapcar 'mm-mime-charset |
593 |
(delq 'ascii |
(delq 'ascii |
594 |
(mm-find-charset-region b e)))))) |
(mm-find-charset-region b e)))))) |
595 |
(if (and (memq 'iso-8859-15 charsets) |
(if (and (> (length charsets) 1) |
596 |
|
(memq 'iso-8859-15 charsets) |
597 |
(memq 'iso-8859-15 hack-charsets) |
(memq 'iso-8859-15 hack-charsets) |
598 |
(save-excursion (mm-iso-8859-x-to-15-region b e))) |
(save-excursion (mm-iso-8859-x-to-15-region b e))) |
599 |
(mapcar (lambda (x) (setq charsets (delq (car x) charsets))) |
(mapcar (lambda (x) (setq charsets (delq (car x) charsets))) |
611 |
(put 'mm-with-unibyte-buffer 'lisp-indent-function 0) |
(put 'mm-with-unibyte-buffer 'lisp-indent-function 0) |
612 |
(put 'mm-with-unibyte-buffer 'edebug-form-spec '(body)) |
(put 'mm-with-unibyte-buffer 'edebug-form-spec '(body)) |
613 |
|
|
614 |
|
(defmacro mm-with-multibyte-buffer (&rest forms) |
615 |
|
"Create a temporary buffer, and evaluate FORMS there like `progn'. |
616 |
|
Use multibyte mode for this." |
617 |
|
`(let ((default-enable-multibyte-characters t)) |
618 |
|
(with-temp-buffer ,@forms))) |
619 |
|
(put 'mm-with-multibyte-buffer 'lisp-indent-function 0) |
620 |
|
(put 'mm-with-multibyte-buffer 'edebug-form-spec '(body)) |
621 |
|
|
622 |
(defmacro mm-with-unibyte-current-buffer (&rest forms) |
(defmacro mm-with-unibyte-current-buffer (&rest forms) |
623 |
"Evaluate FORMS with current buffer temporarily made unibyte. |
"Evaluate FORMS with current buffer temporarily made unibyte. |
624 |
Also bind `default-enable-multibyte-characters' to nil. |
Also bind `default-enable-multibyte-characters' to nil. |
640 |
(put 'mm-with-unibyte-current-buffer 'edebug-form-spec '(body)) |
(put 'mm-with-unibyte-current-buffer 'edebug-form-spec '(body)) |
641 |
|
|
642 |
(defmacro mm-with-unibyte (&rest forms) |
(defmacro mm-with-unibyte (&rest forms) |
643 |
"Eval the FORMS with the default value of `enable-multibyte-characters' nil, ." |
"Eval the FORMS with the default value of `enable-multibyte-characters' nil." |
644 |
`(let (default-enable-multibyte-characters) |
`(let (default-enable-multibyte-characters) |
645 |
,@forms)) |
,@forms)) |
646 |
(put 'mm-with-unibyte 'lisp-indent-function 0) |
(put 'mm-with-unibyte 'lisp-indent-function 0) |
647 |
(put 'mm-with-unibyte 'edebug-form-spec '(body)) |
(put 'mm-with-unibyte 'edebug-form-spec '(body)) |
648 |
|
|
649 |
|
(defmacro mm-with-multibyte (&rest forms) |
650 |
|
"Eval the FORMS with the default value of `enable-multibyte-characters' t." |
651 |
|
`(let ((default-enable-multibyte-characters t)) |
652 |
|
,@forms)) |
653 |
|
(put 'mm-with-multibyte 'lisp-indent-function 0) |
654 |
|
(put 'mm-with-multibyte 'edebug-form-spec '(body)) |
655 |
|
|
656 |
(defun mm-find-charset-region (b e) |
(defun mm-find-charset-region (b e) |
657 |
"Return a list of Emacs charsets in the region B to E." |
"Return a list of Emacs charsets in the region B to E." |
658 |
(cond |
(cond |
718 |
|
|
719 |
(defun mm-insert-file-contents (filename &optional visit beg end replace |
(defun mm-insert-file-contents (filename &optional visit beg end replace |
720 |
inhibit) |
inhibit) |
721 |
"Like `insert-file-contents', q.v., but only reads in the file. |
"Like `insert-file-contents', but only reads in the file. |
722 |
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 |
723 |
to advanced Emacs features, such as file-name-handlers, format decoding, |
to advanced Emacs features, such as file-name-handlers, format decoding, |
724 |
find-file-hooks, etc. |
`find-file-hooks', etc. |
725 |
If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'. |
If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'. |
726 |
This function ensures that none of these modifications will take place." |
This function ensures that none of these modifications will take place." |
727 |
(let ((format-alist nil) |
(let ((format-alist nil) |
748 |
saying what text to write. |
saying what text to write. |
749 |
Optional fourth argument specifies the coding system to use when |
Optional fourth argument specifies the coding system to use when |
750 |
encoding the file. |
encoding the file. |
751 |
If INHIBIT is non-nil, inhibit mm-inhibit-file-name-handlers." |
If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'." |
752 |
(let ((coding-system-for-write |
(let ((coding-system-for-write |
753 |
(or codesys mm-text-coding-system-for-write |
(or codesys mm-text-coding-system-for-write |
754 |
mm-text-coding-system)) |
mm-text-coding-system)) |
760 |
(append mm-inhibit-file-name-handlers |
(append mm-inhibit-file-name-handlers |
761 |
inhibit-file-name-handlers) |
inhibit-file-name-handlers) |
762 |
inhibit-file-name-handlers))) |
inhibit-file-name-handlers))) |
763 |
(append-to-file start end filename))) |
(write-region start end filename t 'no-message) |
764 |
|
(message "Appended to %s" filename))) |
765 |
|
|
766 |
(defun mm-write-region (start end filename &optional append visit lockname |
(defun mm-write-region (start end filename &optional append visit lockname |
767 |
coding-system inhibit) |
coding-system inhibit) |
768 |
|
|
769 |
"Like `write-region'. |
"Like `write-region'. |
770 |
If INHIBIT is non-nil, inhibit mm-inhibit-file-name-handlers." |
If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'." |
771 |
(let ((coding-system-for-write |
(let ((coding-system-for-write |
772 |
(or coding-system mm-text-coding-system-for-write |
(or coding-system mm-text-coding-system-for-write |
773 |
mm-text-coding-system)) |
mm-text-coding-system)) |
791 |
(push dir result)) |
(push dir result)) |
792 |
(push path result)))) |
(push path result)))) |
793 |
|
|
794 |
;; It is not a MIME function, but some MIME functions use it. |
;; Fixme: This doesn't look useful where it's used. |
795 |
(defalias 'mm-make-temp-file |
(if (fboundp 'detect-coding-region) |
796 |
(if (fboundp 'make-temp-file) |
(defun mm-detect-coding-region (start end) |
797 |
'make-temp-file |
"Like `detect-coding-region' except returning the best one." |
798 |
(lambda (prefix &optional dir-flag) |
(let ((coding-systems |
799 |
(let ((file (expand-file-name |
(detect-coding-region (point) (point-max)))) |
800 |
(make-temp-name prefix) |
(or (car-safe coding-systems) |
801 |
(if (fboundp 'temp-directory) |
coding-systems))) |
802 |
(temp-directory) |
(defun mm-detect-coding-region (start end) |
803 |
temporary-file-directory)))) |
(let ((point (point))) |
804 |
(if dir-flag |
(goto-char start) |
805 |
(make-directory file)) |
(skip-chars-forward "\0-\177" end) |
806 |
file)))) |
(prog1 |
807 |
|
(if (eq (point) end) 'ascii (mm-guess-charset)) |
808 |
|
(goto-char point))))) |
809 |
|
|
810 |
|
(if (fboundp 'coding-system-get) |
811 |
|
(defun mm-detect-mime-charset-region (start end) |
812 |
|
"Detect MIME charset of the text in the region between START and END." |
813 |
|
(let ((cs (mm-detect-coding-region start end))) |
814 |
|
(coding-system-get cs 'mime-charset))) |
815 |
|
(defun mm-detect-mime-charset-region (start end) |
816 |
|
"Detect MIME charset of the text in the region between START and END." |
817 |
|
(let ((cs (mm-detect-coding-region start end))) |
818 |
|
cs))) |
819 |
|
|
820 |
|
|
821 |
(provide 'mm-util) |
(provide 'mm-util) |
822 |
|
|