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) |
274 |
(coding-system-get cs 'safe-charsets)))))) |
(coding-system-get cs 'safe-charsets)))))) |
275 |
(sort-coding-systems (coding-system-list 'base-only)))))) |
(sort-coding-systems (coding-system-list 'base-only)))))) |
276 |
|
|
277 |
(defvar mm-coding-system-priorities nil |
(defcustom mm-coding-system-priorities |
278 |
"Preferred coding systems for encoding outgoing mails. |
(if (boundp 'current-language-environment) |
279 |
|
(let ((lang (symbol-value 'current-language-environment))) |
280 |
More than one suitable coding systems may be found for some texts. By |
(cond ((string= lang "Japanese") |
281 |
default, a coding system with the highest priority is used to encode |
;; Japanese users may prefer iso-2022-jp to shift-jis. |
282 |
outgoing mails (see `sort-coding-systems'). If this variable is set, |
'(iso-2022-jp iso-2022-jp-2 japanese-shift-jis |
283 |
it overrides the default priority. For example, Japanese users may |
iso-latin-1 utf-8))))) |
284 |
prefer iso-2022-jp to japanese-shift-jis: |
"Preferred coding systems for encoding outgoing messages. |
285 |
|
|
286 |
\(setq mm-coding-system-priorities |
More than one suitable coding system may be found for some text. |
287 |
'(iso-2022-jp iso-2022-jp-2 japanese-shift-jis utf-8)) |
By default, the coding system with the highest priority is used |
288 |
") |
to encode outgoing messages (see `sort-coding-systems'). If this |
289 |
|
variable is set, it overrides the default priority." |
290 |
|
:type '(repeat (symbol :tag "Coding system")) |
291 |
|
:group 'mime) |
292 |
|
|
293 |
;; Why on earth was this broken out? -- fx |
;; ?? |
294 |
(defvar mm-use-find-coding-systems-region |
(defvar mm-use-find-coding-systems-region |
295 |
(fboundp 'find-coding-systems-region) |
(fboundp 'find-coding-systems-region) |
296 |
"Use `find-coding-systems-region' to find proper coding systems.") |
"Use `find-coding-systems-region' to find proper coding systems. |
297 |
|
|
298 |
|
Setting it to nil is useful on Emacsen supporting Unicode if sending |
299 |
|
mail with multiple parts is preferred to sending a Unicode one.") |
300 |
|
|
301 |
;;; Internal variables: |
;;; Internal variables: |
302 |
|
|
304 |
|
|
305 |
(defun mm-mule-charset-to-mime-charset (charset) |
(defun mm-mule-charset-to-mime-charset (charset) |
306 |
"Return the MIME charset corresponding to the given Mule CHARSET." |
"Return the MIME charset corresponding to the given Mule CHARSET." |
307 |
(if (fboundp 'find-coding-systems-for-charsets) |
(if (and (fboundp 'find-coding-systems-for-charsets) |
308 |
|
(fboundp 'sort-coding-systems)) |
309 |
(let (mime) |
(let (mime) |
310 |
(dolist (cs (find-coding-systems-for-charsets (list charset))) |
(dolist (cs (sort-coding-systems |
311 |
|
(copy-sequence |
312 |
|
(find-coding-systems-for-charsets (list charset))))) |
313 |
(unless mime |
(unless mime |
314 |
(when cs |
(when cs |
315 |
(setq mime (or (coding-system-get cs :mime-charset) |
(setq mime (or (coding-system-get cs :mime-charset) |
337 |
((null charset) |
((null charset) |
338 |
charset) |
charset) |
339 |
;; Running in a non-MULE environment. |
;; Running in a non-MULE environment. |
340 |
((null (mm-get-coding-system-list)) |
((or (null (mm-get-coding-system-list)) |
341 |
|
(not (fboundp 'coding-system-get))) |
342 |
charset) |
charset) |
343 |
;; ascii |
;; ascii |
344 |
((eq charset 'us-ascii) |
((eq charset 'us-ascii) |
354 |
charset) |
charset) |
355 |
;; Translate invalid charsets. |
;; Translate invalid charsets. |
356 |
((let ((cs (cdr (assq charset mm-charset-synonym-alist)))) |
((let ((cs (cdr (assq charset mm-charset-synonym-alist)))) |
357 |
(and cs (mm-coding-system-p charset) cs))) |
(and cs (mm-coding-system-p cs) cs))) |
358 |
;; Last resort: search the coding system list for entries which |
;; Last resort: search the coding system list for entries which |
359 |
;; have the right mime-charset in case the canonical name isn't |
;; have the right mime-charset in case the canonical name isn't |
360 |
;; defined (though it should be). |
;; defined (though it should be). |
398 |
(or (get-charset-property charset 'preferred-coding-system) |
(or (get-charset-property charset 'preferred-coding-system) |
399 |
(get-charset-property charset 'prefered-coding-system))) |
(get-charset-property charset 'prefered-coding-system))) |
400 |
|
|
401 |
|
;; Mule charsets shouldn't be used. |
402 |
|
(defsubst mm-guess-charset () |
403 |
|
"Guess Mule charset from the language environment." |
404 |
|
(or |
405 |
|
mail-parse-mule-charset ;; cached mule-charset |
406 |
|
(progn |
407 |
|
(setq mail-parse-mule-charset |
408 |
|
(and (boundp 'current-language-environment) |
409 |
|
(car (last |
410 |
|
(assq 'charset |
411 |
|
(assoc current-language-environment |
412 |
|
language-info-alist)))))) |
413 |
|
(if (or (not mail-parse-mule-charset) |
414 |
|
(eq mail-parse-mule-charset 'ascii)) |
415 |
|
(setq mail-parse-mule-charset |
416 |
|
(or (car (last (assq mail-parse-charset |
417 |
|
mm-mime-mule-charset-alist))) |
418 |
|
;; default |
419 |
|
'latin-iso8859-1))) |
420 |
|
mail-parse-mule-charset))) |
421 |
|
|
422 |
(defun mm-charset-after (&optional pos) |
(defun mm-charset-after (&optional pos) |
423 |
"Return charset of a character in current buffer at position POS. |
"Return charset of a character in current buffer at position POS. |
424 |
If POS is nil, it defauls to the current point. |
If POS is nil, it defauls to the current point. |
435 |
(if (and charset (not (memq charset '(ascii eight-bit-control |
(if (and charset (not (memq charset '(ascii eight-bit-control |
436 |
eight-bit-graphic)))) |
eight-bit-graphic)))) |
437 |
charset |
charset |
438 |
(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))))))) |
|
439 |
|
|
440 |
(defun mm-mime-charset (charset) |
(defun mm-mime-charset (charset) |
441 |
"Return the MIME charset corresponding to the given Mule CHARSET." |
"Return the MIME charset corresponding to the given Mule CHARSET." |
465 |
(setq result (cons head result))) |
(setq result (cons head result))) |
466 |
(nreverse result))) |
(nreverse result))) |
467 |
|
|
468 |
;; 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 |
469 |
;; setting. I think it's used inconsistently. -- fx |
;; default multibyteness. See mm-default-multibyte-p. |
470 |
(defsubst mm-multibyte-p () |
(eval-and-compile |
|
"Say whether multibyte is enabled." |
|
471 |
(if (and (not (featurep 'xemacs)) |
(if (and (not (featurep 'xemacs)) |
472 |
(boundp 'enable-multibyte-characters)) |
(boundp 'enable-multibyte-characters)) |
473 |
enable-multibyte-characters |
(defun mm-multibyte-p () |
474 |
(featurep 'mule))) |
"Non-nil if multibyte is enabled in the current buffer." |
475 |
|
enable-multibyte-characters) |
476 |
|
(defun mm-multibyte-p () (featurep 'mule)))) |
477 |
|
|
478 |
|
(defun mm-default-multibyte-p () |
479 |
|
"Return non-nil if the session is multibyte. |
480 |
|
This affects whether coding conversion should be attempted generally." |
481 |
|
(if (featurep 'mule) |
482 |
|
(if (boundp 'default-enable-multibyte-characters) |
483 |
|
default-enable-multibyte-characters |
484 |
|
t))) |
485 |
|
|
486 |
(defun mm-sort-coding-systems-predicate (a b) |
(defun mm-sort-coding-systems-predicate (a b) |
487 |
(> (length (memq a mm-coding-system-priorities)) |
(let ((priorities |
488 |
(length (memq b mm-coding-system-priorities)))) |
(mapcar (lambda (cs) |
489 |
|
;; Note: invalid entries are dropped silently |
490 |
|
(and (coding-system-p cs) |
491 |
|
(coding-system-base cs))) |
492 |
|
mm-coding-system-priorities))) |
493 |
|
(> (length (memq a priorities)) |
494 |
|
(length (memq b priorities))))) |
495 |
|
|
496 |
(defun mm-find-mime-charset-region (b e) |
(defun mm-find-mime-charset-region (b e) |
497 |
"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. |
507 |
(when mm-coding-system-priorities |
(when mm-coding-system-priorities |
508 |
(setq systems |
(setq systems |
509 |
(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. |
|
510 |
(setq systems (delq 'compound-text systems)) |
(setq systems (delq 'compound-text systems)) |
511 |
(unless (equal systems '(undecided)) |
(unless (equal systems '(undecided)) |
512 |
(while systems |
(while systems |
513 |
(let* ((head (pop systems)) |
(let* ((head (pop systems)) |
514 |
(cs (or (coding-system-get head :mime-charset) |
(cs (or (coding-system-get head :mime-charset) |
515 |
(coding-system-get head 'mime-charset)))) |
(coding-system-get head 'mime-charset)))) |
516 |
(if cs |
;; The mime-charset (`x-ctext') of |
517 |
|
;; `compound-text' is not in the IANA list. We |
518 |
|
;; shouldn't normally use anything here with a |
519 |
|
;; mime-charset having an `x-' prefix. |
520 |
|
;; Fixme: Allow this to be overridden, since |
521 |
|
;; there is existing use of x-ctext. |
522 |
|
;; Also people apparently need the coding system |
523 |
|
;; `iso-2022-jp-3' (which Mule-UCS defines with |
524 |
|
;; mime-charset, though it's not valid). |
525 |
|
(if (and cs |
526 |
|
(not (string-match "^[Xx]-" (symbol-name cs))) |
527 |
|
;; UTF-16 of any variety is invalid for |
528 |
|
;; text parts and, unfortunately, has |
529 |
|
;; mime-charset defined both in Mule-UCS |
530 |
|
;; and versions of Emacs. (The name |
531 |
|
;; might be `mule-utf-16...' or |
532 |
|
;; `utf-16...'.) |
533 |
|
(not (string-match "utf-16" (symbol-name cs)))) |
534 |
(setq systems nil |
(setq systems nil |
535 |
charsets (list cs)))))) |
charsets (list cs)))))) |
536 |
charsets)) |
charsets)) |
537 |
;; Fixme: won't work for unibyte Emacs 22: |
;; Fixme: won't work for unibyte Emacs 22: |
538 |
|
|
539 |
;; Otherwise we're not multibyte, XEmacs or a single coding |
;; Otherwise we're not multibyte, we're XEmacs, or a single |
540 |
;; system won't cover it. |
;; coding system won't cover it. |
541 |
(setq charsets |
(setq charsets |
542 |
(mm-delete-duplicates |
(mm-delete-duplicates |
543 |
(mapcar 'mm-mime-charset |
(mapcar 'mm-mime-charset |
553 |
(put 'mm-with-unibyte-buffer 'lisp-indent-function 0) |
(put 'mm-with-unibyte-buffer 'lisp-indent-function 0) |
554 |
(put 'mm-with-unibyte-buffer 'edebug-form-spec '(body)) |
(put 'mm-with-unibyte-buffer 'edebug-form-spec '(body)) |
555 |
|
|
556 |
|
(defmacro mm-with-multibyte-buffer (&rest forms) |
557 |
|
"Create a temporary buffer, and evaluate FORMS there like `progn'. |
558 |
|
Use multibyte mode for this." |
559 |
|
`(let ((default-enable-multibyte-characters t)) |
560 |
|
(with-temp-buffer ,@forms))) |
561 |
|
(put 'mm-with-multibyte-buffer 'lisp-indent-function 0) |
562 |
|
(put 'mm-with-multibyte-buffer 'edebug-form-spec '(body)) |
563 |
|
|
564 |
(defmacro mm-with-unibyte-current-buffer (&rest forms) |
(defmacro mm-with-unibyte-current-buffer (&rest forms) |
565 |
"Evaluate FORMS with current buffer temporarily made unibyte. |
"Evaluate FORMS with current buffer temporarily made unibyte. |
566 |
Also bind `default-enable-multibyte-characters' to nil. |
Also bind `default-enable-multibyte-characters' to nil. |
582 |
(put 'mm-with-unibyte-current-buffer 'edebug-form-spec '(body)) |
(put 'mm-with-unibyte-current-buffer 'edebug-form-spec '(body)) |
583 |
|
|
584 |
(defmacro mm-with-unibyte (&rest forms) |
(defmacro mm-with-unibyte (&rest forms) |
585 |
"Eval the FORMS with the default value of `enable-multibyte-characters' nil, ." |
"Eval the FORMS with the default value of `enable-multibyte-characters' nil." |
586 |
`(let (default-enable-multibyte-characters) |
`(let (default-enable-multibyte-characters) |
587 |
,@forms)) |
,@forms)) |
588 |
(put 'mm-with-unibyte 'lisp-indent-function 0) |
(put 'mm-with-unibyte 'lisp-indent-function 0) |
589 |
(put 'mm-with-unibyte 'edebug-form-spec '(body)) |
(put 'mm-with-unibyte 'edebug-form-spec '(body)) |
590 |
|
|
591 |
|
(defmacro mm-with-multibyte (&rest forms) |
592 |
|
"Eval the FORMS with the default value of `enable-multibyte-characters' t." |
593 |
|
`(let ((default-enable-multibyte-characters t)) |
594 |
|
,@forms)) |
595 |
|
(put 'mm-with-multibyte 'lisp-indent-function 0) |
596 |
|
(put 'mm-with-multibyte 'edebug-form-spec '(body)) |
597 |
|
|
598 |
(defun mm-find-charset-region (b e) |
(defun mm-find-charset-region (b e) |
599 |
"Return a list of Emacs charsets in the region B to E." |
"Return a list of Emacs charsets in the region B to E." |
600 |
(cond |
(cond |
660 |
|
|
661 |
(defun mm-insert-file-contents (filename &optional visit beg end replace |
(defun mm-insert-file-contents (filename &optional visit beg end replace |
662 |
inhibit) |
inhibit) |
663 |
"Like `insert-file-contents', q.v., but only reads in the file. |
"Like `insert-file-contents', but only reads in the file. |
664 |
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 |
665 |
to advanced Emacs features, such as file-name-handlers, format decoding, |
to advanced Emacs features, such as file-name-handlers, format decoding, |
666 |
find-file-hooks, etc. |
`find-file-hooks', etc. |
667 |
If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'. |
If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'. |
668 |
This function ensures that none of these modifications will take place." |
This function ensures that none of these modifications will take place." |
669 |
(let ((format-alist nil) |
(let ((format-alist nil) |
690 |
saying what text to write. |
saying what text to write. |
691 |
Optional fourth argument specifies the coding system to use when |
Optional fourth argument specifies the coding system to use when |
692 |
encoding the file. |
encoding the file. |
693 |
If INHIBIT is non-nil, inhibit mm-inhibit-file-name-handlers." |
If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'." |
694 |
(let ((coding-system-for-write |
(let ((coding-system-for-write |
695 |
(or codesys mm-text-coding-system-for-write |
(or codesys mm-text-coding-system-for-write |
696 |
mm-text-coding-system)) |
mm-text-coding-system)) |
702 |
(append mm-inhibit-file-name-handlers |
(append mm-inhibit-file-name-handlers |
703 |
inhibit-file-name-handlers) |
inhibit-file-name-handlers) |
704 |
inhibit-file-name-handlers))) |
inhibit-file-name-handlers))) |
705 |
(append-to-file start end filename))) |
(write-region start end filename t 'no-message) |
706 |
|
(message "Appended to %s" filename))) |
707 |
|
|
708 |
(defun mm-write-region (start end filename &optional append visit lockname |
(defun mm-write-region (start end filename &optional append visit lockname |
709 |
coding-system inhibit) |
coding-system inhibit) |
710 |
|
|
711 |
"Like `write-region'. |
"Like `write-region'. |
712 |
If INHIBIT is non-nil, inhibit mm-inhibit-file-name-handlers." |
If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'." |
713 |
(let ((coding-system-for-write |
(let ((coding-system-for-write |
714 |
(or coding-system mm-text-coding-system-for-write |
(or coding-system mm-text-coding-system-for-write |
715 |
mm-text-coding-system)) |
mm-text-coding-system)) |
733 |
(push dir result)) |
(push dir result)) |
734 |
(push path result)))) |
(push path result)))) |
735 |
|
|
736 |
;; It is not a MIME function, but some MIME functions use it. |
;; Fixme: This doesn't look useful where it's used. |
737 |
(defalias 'mm-make-temp-file |
(if (fboundp 'detect-coding-region) |
738 |
(if (fboundp 'make-temp-file) |
(defun mm-detect-coding-region (start end) |
739 |
'make-temp-file |
"Like `detect-coding-region' except returning the best one." |
740 |
(lambda (prefix &optional dir-flag) |
(let ((coding-systems |
741 |
(let ((file (expand-file-name |
(detect-coding-region (point) (point-max)))) |
742 |
(make-temp-name prefix) |
(or (car-safe coding-systems) |
743 |
(if (fboundp 'temp-directory) |
coding-systems))) |
744 |
(temp-directory) |
(defun mm-detect-coding-region (start end) |
745 |
temporary-file-directory)))) |
(let ((point (point))) |
746 |
(if dir-flag |
(goto-char start) |
747 |
(make-directory file)) |
(skip-chars-forward "\0-\177" end) |
748 |
file)))) |
(prog1 |
749 |
|
(if (eq (point) end) 'ascii (mm-guess-charset)) |
750 |
|
(goto-char point))))) |
751 |
|
|
752 |
|
(if (fboundp 'coding-system-get) |
753 |
|
(defun mm-detect-mime-charset-region (start end) |
754 |
|
"Detect MIME charset of the text in the region between START and END." |
755 |
|
(let ((cs (mm-detect-coding-region start end))) |
756 |
|
(coding-system-get cs 'mime-charset))) |
757 |
|
(defun mm-detect-mime-charset-region (start end) |
758 |
|
"Detect MIME charset of the text in the region between START and END." |
759 |
|
(let ((cs (mm-detect-coding-region start end))) |
760 |
|
cs))) |
761 |
|
|
762 |
|
|
763 |
(provide 'mm-util) |
(provide 'mm-util) |
764 |
|
|