1 ;;; mm-util.el --- Utility functions for Mule and low level things
2 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003
3 ;; Free Software Foundation, Inc.
5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
6 ;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
7 ;; This file is part of GNU Emacs.
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; GNU Emacs is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 ;; Boston, MA 02111-1307, USA.
28 (eval-when-compile (require 'cl))
34 (let ((nfunc (intern (format "mm-%s" (car elem)))))
35 (if (fboundp (car elem))
36 (defalias nfunc (car elem))
37 (defalias nfunc (cdr elem)))))
38 '((decode-coding-string . (lambda (s a) s))
39 (encode-coding-string . (lambda (s a) s))
40 (encode-coding-region . ignore)
41 (coding-system-list . ignore)
42 (decode-coding-region . ignore)
44 (coding-system-equal . equal)
45 (annotationp . ignore)
46 (set-buffer-file-coding-system . ignore)
48 . (lambda (charset int)
56 (mapcar (lambda (e) (list (symbol-name (car e))))
57 mm-mime-mule-charset-alist)
60 . (lambda (from to string) ;; stolen (and renamed) from nnheader.el
61 "Replace characters in STRING from FROM to TO."
62 (let ((string (substring string 0)) ;Copy string.
65 ;; Replace all occurrences of FROM with TO.
67 (when (= (aref string idx) from)
71 (string-as-unibyte . identity)
72 (string-make-unibyte . identity)
73 (string-as-multibyte . identity)
74 (multibyte-string-p . ignore)
75 ;; It is not a MIME function, but some MIME functions use it.
76 (make-temp-file . (lambda (prefix &optional dir-flag)
77 (let ((file (expand-file-name
78 (make-temp-name prefix)
79 (if (fboundp 'temp-directory)
81 temporary-file-directory))))
83 (make-directory file))
85 (insert-byte . insert-char)
86 (multibyte-char-to-unibyte . identity))))
89 (defalias 'mm-char-or-char-int-p
91 ((fboundp 'char-or-char-int-p) 'char-or-char-int-p)
92 ((fboundp 'char-valid-p) 'char-valid-p)
96 (defalias 'mm-read-coding-system
98 ((fboundp 'read-coding-system)
99 (if (and (featurep 'xemacs)
100 (<= (string-to-number emacs-version) 21.1))
101 (lambda (prompt &optional default-coding-system)
102 (read-coding-system prompt))
103 'read-coding-system))
104 (t (lambda (prompt &optional default-coding-system)
105 "Prompt the user for a coding system."
107 prompt (mapcar (lambda (s) (list (symbol-name (car s))))
108 mm-mime-mule-charset-alist)))))))
110 (defvar mm-coding-system-list nil)
111 (defun mm-get-coding-system-list ()
112 "Get the coding system list."
113 (or mm-coding-system-list
114 (setq mm-coding-system-list (mm-coding-system-list))))
116 (defun mm-coding-system-p (sym)
117 "Return non-nil if SYM is a coding system."
118 (if (fboundp 'coding-system-p)
119 (coding-system-p sym)
120 (memq sym (mm-get-coding-system-list))))
122 (defvar mm-charset-synonym-alist
124 ;; Perfectly fine? A valid MIME name, anyhow.
125 ,@(unless (mm-coding-system-p 'big5)
127 ;; Not in XEmacs, but it's not a proper MIME charset anyhow.
128 ,@(unless (mm-coding-system-p 'x-ctext)
129 '((x-ctext . ctext)))
130 ;; Apparently not defined in Emacs 20, but is a valid MIME name.
131 ,@(unless (mm-coding-system-p 'gb2312)
132 '((gb2312 . cn-gb-2312)))
133 ;; ISO-8859-15 is very similar to ISO-8859-1. But it's _different_!
134 ,@(unless (mm-coding-system-p 'iso-8859-15)
135 '((iso-8859-15 . iso-8859-1)))
136 ;; Windows-1252 is actually a superset of Latin-1. See also
137 ;; `gnus-article-dumbquotes-map'.
138 ,@(unless (mm-coding-system-p 'windows-1252)
139 (if (mm-coding-system-p 'cp1252)
140 '((windows-1252 . cp1252))
141 '((windows-1252 . iso-8859-1))))
142 ;; Windows-1250 is a variant of Latin-2 heavily used by Microsoft
143 ;; Outlook users in Czech republic. Use this to allow reading of their
144 ;; e-mails. cp1250 should be defined by M-x codepage-setup.
145 ,@(if (and (not (mm-coding-system-p 'windows-1250))
146 (mm-coding-system-p 'cp1250))
147 '((windows-1250 . cp1250)))
149 "A mapping from invalid charset names to the real charset names.")
151 (defvar mm-binary-coding-system
153 ((mm-coding-system-p 'binary) 'binary)
154 ((mm-coding-system-p 'no-conversion) 'no-conversion)
156 "100% binary coding system.")
158 (defvar mm-text-coding-system
159 (or (if (memq system-type '(windows-nt ms-dos ms-windows))
160 (and (mm-coding-system-p 'raw-text-dos) 'raw-text-dos)
161 (and (mm-coding-system-p 'raw-text) 'raw-text))
162 mm-binary-coding-system)
163 "Text-safe coding system (For removing ^M).")
165 (defvar mm-text-coding-system-for-write nil
166 "Text coding system for write.")
168 (defvar mm-auto-save-coding-system
170 ((mm-coding-system-p 'utf-8-emacs) ; Mule 7
171 (if (memq system-type '(windows-nt ms-dos ms-windows))
172 (if (mm-coding-system-p 'utf-8-emacs-dos)
173 'utf-8-emacs-dos mm-binary-coding-system)
175 ((mm-coding-system-p 'emacs-mule)
176 (if (memq system-type '(windows-nt ms-dos ms-windows))
177 (if (mm-coding-system-p 'emacs-mule-dos)
178 'emacs-mule-dos mm-binary-coding-system)
180 ((mm-coding-system-p 'escape-quoted) 'escape-quoted)
181 (t mm-binary-coding-system))
182 "Coding system of auto save file.")
184 (defvar mm-universal-coding-system mm-auto-save-coding-system
185 "The universal coding system.")
187 ;; Fixme: some of the cars here aren't valid MIME charsets. That
188 ;; should only matter with XEmacs, though.
189 (defvar mm-mime-mule-charset-alist
191 (iso-8859-1 latin-iso8859-1)
192 (iso-8859-2 latin-iso8859-2)
193 (iso-8859-3 latin-iso8859-3)
194 (iso-8859-4 latin-iso8859-4)
195 (iso-8859-5 cyrillic-iso8859-5)
196 ;; Non-mule (X)Emacs uses the last mule-charset for 8bit characters.
197 ;; The fake mule-charset, gnus-koi8-r, tells Gnus that the default
198 ;; charset is koi8-r, not iso-8859-5.
199 (koi8-r cyrillic-iso8859-5 gnus-koi8-r)
200 (iso-8859-6 arabic-iso8859-6)
201 (iso-8859-7 greek-iso8859-7)
202 (iso-8859-8 hebrew-iso8859-8)
203 (iso-8859-9 latin-iso8859-9)
204 (iso-8859-14 latin-iso8859-14)
205 (iso-8859-15 latin-iso8859-15)
206 (viscii vietnamese-viscii-lower)
207 (iso-2022-jp latin-jisx0201 japanese-jisx0208 japanese-jisx0208-1978)
208 (euc-kr korean-ksc5601)
209 (gb2312 chinese-gb2312)
210 (big5 chinese-big5-1 chinese-big5-2)
212 (thai-tis620 thai-tis620)
213 (iso-2022-7bit ethiopic arabic-1-column arabic-2-column)
214 (iso-2022-jp-2 latin-iso8859-1 greek-iso8859-7
215 latin-jisx0201 japanese-jisx0208-1978
216 chinese-gb2312 japanese-jisx0208
217 korean-ksc5601 japanese-jisx0212
219 (iso-2022-int-1 latin-iso8859-1 greek-iso8859-7
220 latin-jisx0201 japanese-jisx0208-1978
221 chinese-gb2312 japanese-jisx0208
222 korean-ksc5601 japanese-jisx0212
223 chinese-cns11643-1 chinese-cns11643-2)
224 (iso-2022-int-1 latin-iso8859-1 latin-iso8859-2
225 cyrillic-iso8859-5 greek-iso8859-7
226 latin-jisx0201 japanese-jisx0208-1978
227 chinese-gb2312 japanese-jisx0208
228 korean-ksc5601 japanese-jisx0212
229 chinese-cns11643-1 chinese-cns11643-2
230 chinese-cns11643-3 chinese-cns11643-4
231 chinese-cns11643-5 chinese-cns11643-6
233 ,(if (or (not (fboundp 'charsetp)) ;; non-Mule case
234 (charsetp 'unicode-a)
235 (not (mm-coding-system-p 'mule-utf-8)))
236 '(utf-8 unicode-a unicode-b unicode-c unicode-d unicode-e)
237 ;; If we have utf-8 we're in Mule 5+.
240 (coding-system-get 'mule-utf-8 'safe-charsets)))))
241 "Alist of MIME-charset/MULE-charsets.")
243 ;; Correct by construction, but should be unnecessary:
245 (when (and (not (featurep 'xemacs))
246 (fboundp 'coding-system-list)
247 (fboundp 'sort-coding-systems))
248 (setq mm-mime-mule-charset-alist
253 (when (and (or (coding-system-get cs :mime-charset) ; Emacs 22
254 (coding-system-get cs 'mime-charset))
255 (not (eq t (coding-system-get cs 'safe-charsets))))
256 (list (cons (or (coding-system-get cs :mime-charset)
257 (coding-system-get cs 'mime-charset))
259 (coding-system-get cs 'safe-charsets))))))
260 (sort-coding-systems (coding-system-list 'base-only))))))
262 (defvar mm-hack-charsets '(iso-8859-15 iso-2022-jp-2)
263 "A list of special charsets.
264 Valid elements include:
265 `iso-8859-15' convert ISO-8859-1, -9 to ISO-8859-15 if ISO-8859-15 exists.
266 `iso-2022-jp-2' convert ISO-2022-jp to ISO-2022-jp-2 if ISO-2022-jp-2 exists."
269 (defvar mm-iso-8859-15-compatible
270 '((iso-8859-1 "\xA4\xA6\xA8\xB4\xB8\xBC\xBD\xBE")
271 (iso-8859-9 "\xA4\xA6\xA8\xB4\xB8\xBC\xBD\xBE\xD0\xDD\xDE\xF0\xFD\xFE"))
272 "ISO-8859-15 exchangeable coding systems and inconvertible characters.")
274 (defvar mm-iso-8859-x-to-15-table
275 (and (fboundp 'coding-system-p)
276 (mm-coding-system-p 'iso-8859-15)
279 (if (mm-coding-system-p (car cs))
280 (let ((c (string-to-char
281 (decode-coding-string "\341" (car cs)))))
282 (cons (char-charset c)
285 (decode-coding-string "\341" 'iso-8859-15)) c)
286 (string-to-list (decode-coding-string (car (cdr cs))
289 mm-iso-8859-15-compatible))
290 "A table of the difference character between ISO-8859-X and ISO-8859-15.")
292 (defcustom mm-coding-system-priorities
293 (if (boundp 'current-language-environment)
294 (let ((lang (symbol-value 'current-language-environment)))
295 (cond ((string= lang "Japanese")
296 ;; Japanese users may prefer iso-2022-jp to shift-jis.
297 '(iso-2022-jp iso-2022-jp-2 japanese-shift-jis
298 iso-latin-1 utf-8)))))
299 "Preferred coding systems for encoding outgoing mails.
301 More than one suitable coding system may be found for some text. By
302 default, the coding system with the highest priority is used to encode
303 outgoing mails (see `sort-coding-systems'). If this variable is set,
304 it overrides the default priority."
305 :type '(repeat (symbol :tag "Coding system"))
309 (defvar mm-use-find-coding-systems-region
310 (fboundp 'find-coding-systems-region)
311 "Use `find-coding-systems-region' to find proper coding systems.
313 Setting it to nil is useful on Emacsen supporting Unicode if sending
314 mail with multiple parts is preferred to sending a Unicode one.")
316 ;;; Internal variables:
320 (defun mm-mule-charset-to-mime-charset (charset)
321 "Return the MIME charset corresponding to the given Mule CHARSET."
322 (if (and (fboundp 'find-coding-systems-for-charsets)
323 (fboundp 'sort-coding-systems))
325 (dolist (cs (sort-coding-systems
327 (find-coding-systems-for-charsets (list charset)))))
330 (setq mime (or (coding-system-get cs :mime-charset)
331 (coding-system-get cs 'mime-charset))))))
333 (let ((alist mm-mime-mule-charset-alist)
336 (when (memq charset (cdar alist))
337 (setq out (caar alist)
342 (defun mm-charset-to-coding-system (charset &optional lbt)
343 "Return coding-system corresponding to CHARSET.
344 CHARSET is a symbol naming a MIME charset.
345 If optional argument LBT (`unix', `dos' or `mac') is specified, it is
346 used as the line break code type of the coding system."
347 (when (stringp charset)
348 (setq charset (intern (downcase charset))))
350 (setq charset (intern (format "%s-%s" charset lbt))))
354 ;; Running in a non-MULE environment.
355 ((or (null (mm-get-coding-system-list))
356 (not (fboundp 'coding-system-get)))
359 ((eq charset 'us-ascii)
361 ;; Check to see whether we can handle this charset. (This depends
362 ;; on there being some coding system matching each `mime-charset'
363 ;; property defined, as there should be.)
364 ((and (mm-coding-system-p charset)
365 ;;; Doing this would potentially weed out incorrect charsets.
367 ;;; (eq charset (coding-system-get charset 'mime-charset))
370 ;; Translate invalid charsets.
371 ((let ((cs (cdr (assq charset mm-charset-synonym-alist))))
372 (and cs (mm-coding-system-p cs) cs)))
373 ;; Last resort: search the coding system list for entries which
374 ;; have the right mime-charset in case the canonical name isn't
375 ;; defined (though it should be).
377 ;; mm-get-coding-system-list returns a list of cs without lbt.
379 (dolist (c (mm-get-coding-system-list))
381 (eq charset (or (coding-system-get c :mime-charset)
382 (coding-system-get c 'mime-charset))))
386 (defsubst mm-replace-chars-in-string (string from to)
387 (mm-subst-char-in-string from to string))
390 (defvar mm-emacs-mule (and (not (featurep 'xemacs))
391 (boundp 'default-enable-multibyte-characters)
392 default-enable-multibyte-characters
393 (fboundp 'set-buffer-multibyte))
394 "True in Emacs with Mule.")
397 (defun mm-enable-multibyte ()
398 "Set the multibyte flag of the current buffer.
399 Only do this if the default value of `enable-multibyte-characters' is
400 non-nil. This is a no-op in XEmacs."
401 (set-buffer-multibyte t))
402 (defalias 'mm-enable-multibyte 'ignore))
405 (defun mm-disable-multibyte ()
406 "Unset the multibyte flag of in the current buffer.
407 This is a no-op in XEmacs."
408 (set-buffer-multibyte nil))
409 (defalias 'mm-disable-multibyte 'ignore)))
411 (defun mm-preferred-coding-system (charset)
412 ;; A typo in some Emacs versions.
413 (or (get-charset-property charset 'preferred-coding-system)
414 (get-charset-property charset 'prefered-coding-system)))
416 ;; Mule charsets shouldn't be used.
417 (defsubst mm-guess-charset ()
418 "Guess Mule charset from the language environment."
420 mail-parse-mule-charset ;; cached mule-charset
422 (setq mail-parse-mule-charset
423 (and (boundp 'current-language-environment)
426 (assoc current-language-environment
427 language-info-alist))))))
428 (if (or (not mail-parse-mule-charset)
429 (eq mail-parse-mule-charset 'ascii))
430 (setq mail-parse-mule-charset
431 (or (car (last (assq mail-parse-charset
432 mm-mime-mule-charset-alist)))
435 mail-parse-mule-charset)))
437 (defun mm-charset-after (&optional pos)
438 "Return charset of a character in current buffer at position POS.
439 If POS is nil, it defauls to the current point.
440 If POS is out of range, the value is nil.
441 If the charset is `composition', return the actual one."
442 (let ((char (char-after pos)) charset)
443 (if (< (mm-char-int char) 128)
444 (setq charset 'ascii)
445 ;; charset-after is fake in some Emacsen.
446 (setq charset (and (fboundp 'char-charset) (char-charset char)))
447 (if (eq charset 'composition) ; Mule 4
448 (let ((p (or pos (point))))
449 (cadr (find-charset-region p (1+ p))))
450 (if (and charset (not (memq charset '(ascii eight-bit-control
451 eight-bit-graphic))))
453 (mm-guess-charset))))))
455 (defun mm-mime-charset (charset)
456 "Return the MIME charset corresponding to the given Mule CHARSET."
457 (if (eq charset 'unknown)
458 (error "The message contains non-printable characters, please use attachment"))
459 (if (and (fboundp 'coding-system-get) (fboundp 'get-charset-property))
460 ;; This exists in Emacs 20.
462 (and (mm-preferred-coding-system charset)
463 (or (coding-system-get
464 (mm-preferred-coding-system charset) :mime-charset)
466 (mm-preferred-coding-system charset) 'mime-charset)))
467 (and (eq charset 'ascii)
469 (mm-preferred-coding-system charset)
470 (mm-mule-charset-to-mime-charset charset))
471 ;; This is for XEmacs.
472 (mm-mule-charset-to-mime-charset charset)))
474 (defun mm-delete-duplicates (list)
475 "Simple substitute for CL `delete-duplicates', testing with `equal'."
478 (setq head (car list))
479 (setq list (delete head list))
480 (setq result (cons head result)))
484 (if (and (not (featurep 'xemacs))
485 (boundp 'enable-multibyte-characters))
486 (defun mm-multibyte-p ()
487 "Non-nil if multibyte is enabled in the current buffer."
488 enable-multibyte-characters)
489 (defun mm-multibyte-p () (featurep 'mule))))
491 (defun mm-iso-8859-x-to-15-region (&optional b e)
492 (if (fboundp 'char-charset)
493 (let (charset item c inconvertible)
495 (if e (narrow-to-region b e))
496 (goto-char (point-min))
497 (skip-chars-forward "\0-\177")
500 ((not (setq item (assq (char-charset (setq c (char-after)))
501 mm-iso-8859-x-to-15-table)))
503 ((memq c (cdr (cdr item)))
504 (setq inconvertible t)
507 (insert-before-markers (prog1 (+ c (car (cdr item)))
509 (skip-chars-forward "\0-\177")))
510 (not inconvertible))))
512 (defun mm-sort-coding-systems-predicate (a b)
515 ;; Note: invalid entries are dropped silently
516 (and (coding-system-p cs)
517 (coding-system-base cs)))
518 mm-coding-system-priorities)))
519 (> (length (memq a priorities))
520 (length (memq b priorities)))))
522 (defun mm-find-mime-charset-region (b e &optional hack-charsets)
523 "Return the MIME charsets needed to encode the region between B and E.
524 nil means ASCII, a single-element list represents an appropriate MIME
525 charset, and a longer list means no appropriate charset."
527 ;; The return possibilities of this function are a mess...
528 (or (and (mm-multibyte-p)
529 mm-use-find-coding-systems-region
530 ;; Find the mime-charset of the most preferred coding
531 ;; system that has one.
532 (let ((systems (find-coding-systems-region b e)))
533 (when mm-coding-system-priorities
535 (sort systems 'mm-sort-coding-systems-predicate)))
536 (setq systems (delq 'compound-text systems))
537 (unless (equal systems '(undecided))
539 (let* ((head (pop systems))
540 (cs (or (coding-system-get head :mime-charset)
541 (coding-system-get head 'mime-charset))))
542 ;; The mime-charset (`x-ctext') of
543 ;; `compound-text' is not in the IANA list. We
544 ;; shouldn't normally use anything here with a
545 ;; mime-charset having an `x-' prefix.
546 ;; Fixme: allow this to be overridden, since
547 ;; there is existing use of x-ctext.
548 ;; Also people apparently need the coding system
549 ;; `iso-2022-jp-3', which Mule-UCS defines.
551 (not (string-match "^[Xx]-" (symbol-name cs))))
553 charsets (list cs))))))
555 ;; Otherwise we're not multibyte, we're XEmacs or a single
556 ;; coding system won't cover it.
558 (mm-delete-duplicates
559 (mapcar 'mm-mime-charset
561 (mm-find-charset-region b e))))))
562 (if (and (> (length charsets) 1)
563 (memq 'iso-8859-15 charsets)
564 (memq 'iso-8859-15 hack-charsets)
565 (save-excursion (mm-iso-8859-x-to-15-region b e)))
566 (mapcar (lambda (x) (setq charsets (delq (car x) charsets)))
567 mm-iso-8859-15-compatible))
568 (if (and (memq 'iso-2022-jp-2 charsets)
569 (memq 'iso-2022-jp-2 hack-charsets))
570 (setq charsets (delq 'iso-2022-jp charsets)))
573 (defmacro mm-with-unibyte-buffer (&rest forms)
574 "Create a temporary buffer, and evaluate FORMS there like `progn'.
575 Use unibyte mode for this."
576 `(let (default-enable-multibyte-characters)
577 (with-temp-buffer ,@forms)))
578 (put 'mm-with-unibyte-buffer 'lisp-indent-function 0)
579 (put 'mm-with-unibyte-buffer 'edebug-form-spec '(body))
581 (defmacro mm-with-unibyte-current-buffer (&rest forms)
582 "Evaluate FORMS with current buffer temporarily made unibyte.
583 Also bind `default-enable-multibyte-characters' to nil.
584 Equivalent to `progn' in XEmacs"
585 (let ((multibyte (make-symbol "multibyte"))
586 (buffer (make-symbol "buffer")))
588 (let ((,multibyte enable-multibyte-characters)
589 (,buffer (current-buffer)))
591 (let (default-enable-multibyte-characters)
592 (set-buffer-multibyte nil)
595 (set-buffer-multibyte ,multibyte)))
596 (let (default-enable-multibyte-characters)
598 (put 'mm-with-unibyte-current-buffer 'lisp-indent-function 0)
599 (put 'mm-with-unibyte-current-buffer 'edebug-form-spec '(body))
601 (defmacro mm-with-unibyte (&rest forms)
602 "Eval the FORMS with the default value of `enable-multibyte-characters' nil, ."
603 `(let (default-enable-multibyte-characters)
605 (put 'mm-with-unibyte 'lisp-indent-function 0)
606 (put 'mm-with-unibyte 'edebug-form-spec '(body))
608 (defun mm-find-charset-region (b e)
609 "Return a list of Emacs charsets in the region B to E."
611 ((and (mm-multibyte-p)
612 (fboundp 'find-charset-region))
613 ;; Remove composition since the base charsets have been included.
614 ;; Remove eight-bit-*, treat them as ascii.
615 (let ((css (find-charset-region b e)))
616 (mapcar (lambda (cs) (setq css (delq cs css)))
617 '(composition eight-bit-control eight-bit-graphic
621 ;; We are in a unibyte buffer or XEmacs non-mule, so we futz around a bit.
624 (narrow-to-region b e)
625 (goto-char (point-min))
626 (skip-chars-forward "\0-\177")
631 (and (boundp 'current-language-environment)
632 (car (last (assq 'charset
633 (assoc current-language-environment
634 language-info-alist))))))
635 (if (eq charset 'ascii) (setq charset nil))
638 (car (last (assq mail-parse-charset
639 mm-mime-mule-charset-alist)))))
640 (list 'ascii (or charset 'latin-iso8859-1)))))))))
642 (if (fboundp 'shell-quote-argument)
643 (defalias 'mm-quote-arg 'shell-quote-argument)
644 (defun mm-quote-arg (arg)
645 "Return a version of ARG that is safe to evaluate in a shell."
646 (let ((pos 0) new-pos accum)
647 ;; *** bug: we don't handle newline characters properly
648 (while (setq new-pos (string-match "[]*[;!'`\"$\\& \t{} |()<>]" arg pos))
649 (push (substring arg pos new-pos) accum)
651 (push (list (aref arg new-pos)) accum)
652 (setq pos (1+ new-pos)))
655 (apply 'concat (nconc (nreverse accum) (list (substring arg pos))))))))
657 (defun mm-auto-mode-alist ()
658 "Return an `auto-mode-alist' with only the .gz (etc) thingies."
659 (let ((alist auto-mode-alist)
662 (when (listp (cdar alist))
663 (push (car alist) out))
667 (defvar mm-inhibit-file-name-handlers
668 '(jka-compr-handler image-file-handler)
669 "A list of handlers doing (un)compression (etc) thingies.")
671 (defun mm-insert-file-contents (filename &optional visit beg end replace
673 "Like `insert-file-contents', q.v., but only reads in the file.
674 A buffer may be modified in several ways after reading into the buffer due
675 to advanced Emacs features, such as file-name-handlers, format decoding,
676 find-file-hooks, etc.
677 If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'.
678 This function ensures that none of these modifications will take place."
679 (let ((format-alist nil)
680 (auto-mode-alist (if inhibit nil (mm-auto-mode-alist)))
681 (default-major-mode 'fundamental-mode)
682 (enable-local-variables nil)
683 (after-insert-file-functions nil)
684 (enable-local-eval nil)
685 (find-file-hooks nil)
686 (inhibit-file-name-operation (if inhibit
687 'insert-file-contents
688 inhibit-file-name-operation))
689 (inhibit-file-name-handlers
691 (append mm-inhibit-file-name-handlers
692 inhibit-file-name-handlers)
693 inhibit-file-name-handlers)))
694 (insert-file-contents filename visit beg end replace)))
696 (defun mm-append-to-file (start end filename &optional codesys inhibit)
697 "Append the contents of the region to the end of file FILENAME.
698 When called from a function, expects three arguments,
699 START, END and FILENAME. START and END are buffer positions
700 saying what text to write.
701 Optional fourth argument specifies the coding system to use when
703 If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'."
704 (let ((coding-system-for-write
705 (or codesys mm-text-coding-system-for-write
706 mm-text-coding-system))
707 (inhibit-file-name-operation (if inhibit
709 inhibit-file-name-operation))
710 (inhibit-file-name-handlers
712 (append mm-inhibit-file-name-handlers
713 inhibit-file-name-handlers)
714 inhibit-file-name-handlers)))
715 (append-to-file start end filename)))
717 (defun mm-write-region (start end filename &optional append visit lockname
718 coding-system inhibit)
720 "Like `write-region'.
721 If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'."
722 (let ((coding-system-for-write
723 (or coding-system mm-text-coding-system-for-write
724 mm-text-coding-system))
725 (inhibit-file-name-operation (if inhibit
727 inhibit-file-name-operation))
728 (inhibit-file-name-handlers
730 (append mm-inhibit-file-name-handlers
731 inhibit-file-name-handlers)
732 inhibit-file-name-handlers)))
733 (write-region start end filename append visit lockname)))
735 (defun mm-image-load-path (&optional package)
737 (dolist (path load-path (nreverse result))
738 (if (file-directory-p
739 (setq dir (concat (file-name-directory
740 (directory-file-name path))
741 "etc/" (or package "gnus/"))))
743 (push path result))))
745 ;; Fixme: This doesn't look useful where it's used.
746 (if (fboundp 'detect-coding-region)
747 (defun mm-detect-coding-region (start end)
748 "Like `detect-coding-region' except returning the best one."
749 (let ((coding-systems
750 (detect-coding-region (point) (point-max))))
751 (or (car-safe coding-systems)
753 (defun mm-detect-coding-region (start end)
754 (let ((point (point)))
756 (skip-chars-forward "\0-\177" end)
758 (if (eq (point) end) 'ascii (mm-guess-charset))
759 (goto-char point)))))
761 (if (fboundp 'coding-system-get)
762 (defun mm-detect-mime-charset-region (start end)
763 "Detect MIME charset of the text in the region between START and END."
764 (let ((cs (mm-detect-coding-region start end)))
765 (coding-system-get cs 'mime-charset)))
766 (defun mm-detect-mime-charset-region (start end)
767 "Detect MIME charset of the text in the region between START and END."
768 (let ((cs (mm-detect-coding-region start end)))
774 ;;; mm-util.el ends here