code.delx.au - gnu-emacs/blob - lisp/gnus/mm-util.el

   1 ;;; mm-util.el --- Utility functions for Mule and low level things
   2 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc.
   3
   4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   5 ;;      MORIOKA Tomohiko <morioka@jaist.ac.jp>
   6 ;; This file is part of GNU Emacs.
   7
   8 ;; GNU Emacs is free software; you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation; either version 2, or (at your option)
  11 ;; any later version.
  12
  13 ;; GNU Emacs is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  20 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  21 ;; Boston, MA 02111-1307, USA.
  22
  23 ;;; Commentary:
  24
  25 ;;; Code:
  26
  27 (eval-when-compile
  28   (require 'cl)
  29   (defvar mm-mime-mule-charset-alist))
  30 (require 'mail-prsvr)
  31
  32 (eval-and-compile
  33   (mapcar
  34    (lambda (elem)
  35      (let ((nfunc (intern (format "mm-%s" (car elem)))))
  36        (if (fboundp (car elem))
  37            (defalias nfunc (car elem))
  38          (defalias nfunc (cdr elem)))))
  39    '((decode-coding-string . (lambda (s a) s))
  40      (encode-coding-string . (lambda (s a) s))
  41      (encode-coding-region . ignore)
  42      (coding-system-list . ignore)
  43      (decode-coding-region . ignore)
  44      (char-int . identity)
  45      (device-type . ignore)
  46      (coding-system-equal . equal)
  47      (annotationp . ignore)
  48      (set-buffer-file-coding-system . ignore)
  49      (make-char
  50       . (lambda (charset int)
  51           (int-to-char int)))
  52      (read-charset
  53       . (lambda (prompt)
  54           "Return a charset."
  55           (intern
  56            (completing-read
  57             prompt
  58             (mapcar (lambda (e) (list (symbol-name (car e))))
  59                     mm-mime-mule-charset-alist)
  60             nil t))))
  61      (subst-char-in-string
  62       . (lambda (from to string) ;; stolen (and renamed) from nnheader.el
  63           "Replace characters in STRING from FROM to TO."
  64           (let ((string (substring string 0)) ;Copy string.
  65                 (len (length string))
  66                 (idx 0))
  67             ;; Replace all occurrences of FROM with TO.
  68             (while (< idx len)
  69               (when (= (aref string idx) from)
  70                 (aset string idx to))
  71               (setq idx (1+ idx)))
  72             string)))
  73      (string-as-unibyte . identity)
  74      (string-as-multibyte . identity)
  75      (multibyte-string-p . ignore)
  76      (insert-byte . insert))))
  77
  78 (eval-and-compile
  79   (defalias 'mm-char-or-char-int-p
  80     (cond
  81      ((fboundp 'char-or-char-int-p) 'char-or-char-int-p)
  82      ((fboundp 'char-valid-p) 'char-valid-p)
  83      (t 'identity))))
  84
  85 (eval-and-compile
  86   (defalias 'mm-read-coding-system
  87     (cond
  88      ((fboundp 'read-coding-system)
  89       (if (and (featurep 'xemacs)
  90                (<= (string-to-number emacs-version) 21.1))
  91           (lambda (prompt &optional default-coding-system)
  92             (read-coding-system prompt))
  93         'read-coding-system))
  94      (t (lambda (prompt &optional default-coding-system)
  95           "Prompt the user for a coding system."
  96           (completing-read
  97            prompt (mapcar (lambda (s) (list (symbol-name (car s))))
  98                           mm-mime-mule-charset-alist)))))))
  99
 100 (defvar mm-coding-system-list nil)
 101 (defun mm-get-coding-system-list ()
 102   "Get the coding system list."
 103   (or mm-coding-system-list
 104       (setq mm-coding-system-list (mm-coding-system-list))))
 105
 106 (defun mm-coding-system-p (sym)
 107   "Return non-nil if SYM is a coding system."
 108   (or (and (fboundp 'coding-system-p) (coding-system-p sym))
 109       (memq sym (mm-get-coding-system-list))))
 110
 111 (defvar mm-charset-synonym-alist
 112   `(
 113     ;; Perfectly fine?  A valid MIME name, anyhow.
 114     ,@(unless (mm-coding-system-p 'big5)
 115        '((big5 . cn-big5)))
 116     ;; Not in XEmacs, but it's not a proper MIME charset anyhow.
 117     ,@(unless (mm-coding-system-p 'x-ctext)
 118        '((x-ctext . ctext)))
 119     ;; Apparently not defined in Emacs 20, but is a valid MIME name.
 120     ,@(unless (mm-coding-system-p 'gb2312)
 121        '((gb2312 . cn-gb-2312)))
 122     ;; ISO-8859-15 is very similar to ISO-8859-1.
 123     ,@(unless (mm-coding-system-p 'iso-8859-15) ; Emacs 21 defines it.
 124        '((iso-8859-15 . iso-8859-1)))
 125     ;; Windows-1252 is actually a superset of Latin-1.  See also
 126     ;; `gnus-article-dumbquotes-map'.
 127     ,@(unless (mm-coding-system-p 'windows-1252)
 128        (if (mm-coding-system-p 'cp1252)
 129            '((windows-1252 . cp1252))
 130          '((windows-1252 . iso-8859-1))))
 131     ;; Windows-1250 is a variant of Latin-2 heavily used by Microsoft
 132     ;; Outlook users in Czech republic. Use this to allow reading of their
 133     ;; e-mails. cp1250 should be defined by M-x codepage-setup.
 134     ,@(if (and (not (mm-coding-system-p 'windows-1250))
 135                (mm-coding-system-p 'cp1250))
 136           '((windows-1250 . cp1250)))
 137     )
 138   "A mapping from invalid charset names to the real charset names.")
 139
 140 (defvar mm-binary-coding-system
 141   (cond
 142    ((mm-coding-system-p 'binary) 'binary)
 143    ((mm-coding-system-p 'no-conversion) 'no-conversion)
 144    (t nil))
 145   "100% binary coding system.")
 146
 147 (defvar mm-text-coding-system
 148   (or (if (memq system-type '(windows-nt ms-dos ms-windows))
 149           (and (mm-coding-system-p 'raw-text-dos) 'raw-text-dos)
 150         (and (mm-coding-system-p 'raw-text) 'raw-text))
 151       mm-binary-coding-system)
 152   "Text-safe coding system (For removing ^M).")
 153
 154 (defvar mm-text-coding-system-for-write nil
 155   "Text coding system for write.")
 156
 157 (defvar mm-auto-save-coding-system
 158   (cond
 159    ((mm-coding-system-p 'utf-8-emacs)
 160     (if (memq system-type '(windows-nt ms-dos ms-windows))
 161         (if (mm-coding-system-p 'utf-8-emacs-dos)
 162             'utf-8-emacs-dos mm-binary-coding-system)
 163       'utf-8-emacs))
 164    ((mm-coding-system-p 'emacs-mule)
 165     (if (memq system-type '(windows-nt ms-dos ms-windows))
 166         (if (mm-coding-system-p 'emacs-mule-dos)
 167             'emacs-mule-dos mm-binary-coding-system)
 168       'emacs-mule))
 169    ((mm-coding-system-p 'escape-quoted) 'escape-quoted)
 170    (t mm-binary-coding-system))
 171   "Coding system of auto save file.")
 172
 173 (defvar mm-universal-coding-system mm-auto-save-coding-system
 174   "The universal coding system.")
 175
 176 ;; Fixme: some of the cars here aren't valid MIME charsets.  That
 177 ;; should only matter with XEmacs, though.
 178 (defvar mm-mime-mule-charset-alist
 179   `((us-ascii ascii)
 180     (iso-8859-1 latin-iso8859-1)
 181     (iso-8859-2 latin-iso8859-2)
 182     (iso-8859-3 latin-iso8859-3)
 183     (iso-8859-4 latin-iso8859-4)
 184     (iso-8859-5 cyrillic-iso8859-5)
 185     ;; Non-mule (X)Emacs uses the last mule-charset for 8bit characters.
 186     ;; The fake mule-charset, gnus-koi8-r, tells Gnus that the default
 187     ;; charset is koi8-r, not iso-8859-5.
 188     (koi8-r cyrillic-iso8859-5 gnus-koi8-r)
 189     (iso-8859-6 arabic-iso8859-6)
 190     (iso-8859-7 greek-iso8859-7)
 191     (iso-8859-8 hebrew-iso8859-8)
 192     (iso-8859-9 latin-iso8859-9)
 193     (iso-8859-14 latin-iso8859-14)
 194     (iso-8859-15 latin-iso8859-15)
 195     (viscii vietnamese-viscii-lower)
 196     (iso-2022-jp latin-jisx0201 japanese-jisx0208 japanese-jisx0208-1978)
 197     (euc-kr korean-ksc5601)
 198     (gb2312 chinese-gb2312)
 199     (big5 chinese-big5-1 chinese-big5-2)
 200     (tibetan tibetan)
 201     (thai-tis620 thai-tis620)
 202     (iso-2022-7bit ethiopic arabic-1-column arabic-2-column)
 203     (iso-2022-jp-2 latin-iso8859-1 greek-iso8859-7
 204                    latin-jisx0201 japanese-jisx0208-1978
 205                    chinese-gb2312 japanese-jisx0208
 206                    korean-ksc5601 japanese-jisx0212
 207                    katakana-jisx0201)
 208     (iso-2022-int-1 latin-iso8859-1 greek-iso8859-7
 209                     latin-jisx0201 japanese-jisx0208-1978
 210                     chinese-gb2312 japanese-jisx0208
 211                     korean-ksc5601 japanese-jisx0212
 212                     chinese-cns11643-1 chinese-cns11643-2)
 213     (iso-2022-int-1 latin-iso8859-1 latin-iso8859-2
 214                     cyrillic-iso8859-5 greek-iso8859-7
 215                     latin-jisx0201 japanese-jisx0208-1978
 216                     chinese-gb2312 japanese-jisx0208
 217                     korean-ksc5601 japanese-jisx0212
 218                     chinese-cns11643-1 chinese-cns11643-2
 219                     chinese-cns11643-3 chinese-cns11643-4
 220                     chinese-cns11643-5 chinese-cns11643-6
 221                     chinese-cns11643-7)
 222     ,(if (or (not (fboundp 'charsetp)) ;; non-Mule case
 223              (charsetp 'unicode-a)
 224              (not (mm-coding-system-p 'mule-utf-8)))
 225          '(utf-8 unicode-a unicode-b unicode-c unicode-d unicode-e)
 226        ;; If we have utf-8 we're in Mule 5+.
 227        (append '(utf-8)
 228                (delete 'ascii
 229                        (coding-system-get 'mule-utf-8 'safe-charsets)))))
 230   "Alist of MIME-charset/MULE-charsets.")
 231
 232 ;; Correct by construction, but should be unnecessary:
 233 ;; XEmacs hates it.
 234 (when (and (not (featurep 'xemacs))
 235            (fboundp 'coding-system-list)
 236            (fboundp 'sort-coding-systems))
 237   (setq mm-mime-mule-charset-alist
 238         (apply
 239          'nconc
 240          (mapcar
 241           (lambda (cs)
 242             (when (and (or (coding-system-get cs :mime-charset) ; Emacs 22
 243                            (coding-system-get cs 'mime-charset))
 244                        (not (eq t (coding-system-get cs 'safe-charsets))))
 245               (list (cons (or (coding-system-get cs :mime-charset)
 246                               (coding-system-get cs 'mime-charset))
 247                           (delq 'ascii
 248                                 (coding-system-get cs 'safe-charsets))))))
 249           (sort-coding-systems (coding-system-list 'base-only))))))
 250
 251 (defvar mm-coding-system-priorities nil
 252   "Preferred coding systems for encoding outgoing mails.
 253
 254 More than one suitable coding systems may be found for some texts.  By
 255 default, a coding system with the highest priority is used to encode
 256 outgoing mails (see `sort-coding-systems').  If this variable is set,
 257 it overrides the default priority.  For example, Japanese users may
 258 prefer iso-2022-jp to japanese-shift-jis:
 259
 260 \(setq mm-coding-system-priorities
 261   '(iso-2022-jp iso-2022-jp-2 japanese-shift-jis utf-8))
 262 ")
 263
 264 (defvar mm-use-find-coding-systems-region
 265   (fboundp 'find-coding-systems-region)
 266   "Use `find-coding-systems-region' to find proper coding systems.")
 267
 268 ;;; Internal variables:
 269
 270 ;;; Functions:
 271
 272 (defun mm-mule-charset-to-mime-charset (charset)
 273   "Return the MIME charset corresponding to the given Mule CHARSET."
 274   (if (fboundp 'find-coding-systems-for-charsets)
 275       (let (mime)
 276         (dolist (cs (find-coding-systems-for-charsets (list charset)))
 277           (unless mime
 278             (when cs
 279               (setq mime (or (coding-system-get cs :mime-charset)
 280                              (coding-system-get cs 'mime-charset))))))
 281         mime)
 282     (let ((alist mm-mime-mule-charset-alist)
 283           out)
 284       (while alist
 285         (when (memq charset (cdar alist))
 286           (setq out (caar alist)
 287                 alist nil))
 288         (pop alist))
 289       out)))
 290
 291 (defun mm-charset-to-coding-system (charset &optional lbt)
 292   "Return coding-system corresponding to CHARSET.
 293 CHARSET is a symbol naming a MIME charset.
 294 If optional argument LBT (`unix', `dos' or `mac') is specified, it is
 295 used as the line break code type of the coding system."
 296   (when (stringp charset)
 297     (setq charset (intern (downcase charset))))
 298   (when lbt
 299     (setq charset (intern (format "%s-%s" charset lbt))))
 300   (cond
 301    ((null charset)
 302     charset)
 303    ;; Running in a non-MULE environment.
 304    ((null (mm-get-coding-system-list))
 305     charset)
 306    ;; ascii
 307    ((eq charset 'us-ascii)
 308     'ascii)
 309    ;; Check to see whether we can handle this charset.  (This depends
 310    ;; on there being some coding system matching each `mime-charset'
 311    ;; property defined, as there should be.)
 312    ((and (mm-coding-system-p charset)
 313 ;;; Doing this would potentially weed out incorrect charsets.
 314 ;;;      charset
 315 ;;;      (eq charset (coding-system-get charset 'mime-charset))
 316          )
 317     charset)
 318    ;; Translate invalid charsets.
 319    ((let ((cs (cdr (assq charset mm-charset-synonym-alist))))
 320       (and cs (mm-coding-system-p charset) cs)))
 321    ;; Last resort: search the coding system list for entries which
 322    ;; have the right mime-charset in case the canonical name isn't
 323    ;; defined (though it should be).
 324    ((let (cs)
 325       ;; mm-get-coding-system-list returns a list of cs without lbt.
 326       ;; Do we need -lbt?
 327       (dolist (c (mm-get-coding-system-list))
 328         (if (and (null cs)
 329                  (eq charset (or (coding-system-get c :mime-charset)
 330                                  (coding-system-get c 'mime-charset))))
 331             (setq cs c)))
 332       cs))))
 333
 334 (defsubst mm-replace-chars-in-string (string from to)
 335   (mm-subst-char-in-string from to string))
 336
 337 (eval-and-compile
 338   (defvar mm-emacs-mule (and (not (featurep 'xemacs))
 339                              (boundp 'default-enable-multibyte-characters)
 340                              default-enable-multibyte-characters
 341                              (fboundp 'set-buffer-multibyte))
 342     "True in Emacs with Mule.")
 343
 344   (if mm-emacs-mule
 345       (defun mm-enable-multibyte ()
 346         "Set the multibyte flag of the current buffer.
 347 Only do this if the default value of `enable-multibyte-characters' is
 348 non-nil.  This is a no-op in XEmacs."
 349         (set-buffer-multibyte t))
 350     (defalias 'mm-enable-multibyte 'ignore))
 351
 352   (if mm-emacs-mule
 353       (defun mm-disable-multibyte ()
 354         "Unset the multibyte flag of in the current buffer.
 355 This is a no-op in XEmacs."
 356         (set-buffer-multibyte nil))
 357     (defalias 'mm-disable-multibyte 'ignore)))
 358
 359 (defun mm-preferred-coding-system (charset)
 360   ;; A typo in some Emacs versions.
 361   (or (get-charset-property charset 'preferred-coding-system)
 362       (get-charset-property charset 'prefered-coding-system)))
 363
 364 (defun mm-charset-after (&optional pos)
 365   "Return charset of a character in current buffer at position POS.
 366 If POS is nil, it defauls to the current point.
 367 If POS is out of range, the value is nil.
 368 If the charset is `composition', return the actual one."
 369   (let ((char (char-after pos)) charset)
 370     (if (< (mm-char-int char) 128)
 371         (setq charset 'ascii)
 372       ;; charset-after is fake in some Emacsen.
 373       (setq charset (and (fboundp 'char-charset) (char-charset char)))
 374       (if (eq charset 'composition)     ; Mule 4
 375           (let ((p (or pos (point))))
 376             (cadr (find-charset-region p (1+ p))))
 377         (if (and charset (not (memq charset '(ascii eight-bit-control
 378                                                     eight-bit-graphic))))
 379             charset
 380           (or
 381            mail-parse-mule-charset ;; cached mule-charset
 382            (progn
 383              (setq mail-parse-mule-charset
 384                    (and (boundp 'current-language-environment)
 385                         (car (last
 386                               (assq 'charset
 387                                     (assoc current-language-environment
 388                                            language-info-alist))))))
 389              (if (or (not mail-parse-mule-charset)
 390                      (eq mail-parse-mule-charset 'ascii))
 391                  (setq mail-parse-mule-charset
 392                        (or (car (last (assq mail-parse-charset
 393                                             mm-mime-mule-charset-alist)))
 394                            ;; Fixme: don't fix that!
 395                            'latin-iso8859-1)))
 396              mail-parse-mule-charset)))))))
 397
 398 (defun mm-mime-charset (charset)
 399   "Return the MIME charset corresponding to the given Mule CHARSET."
 400   (if (eq charset 'unknown)
 401       (error "The message contains non-printable characters, please use attachment"))
 402   (if (and (fboundp 'coding-system-get) (fboundp 'get-charset-property))
 403       ;; This exists in Emacs 20.
 404       (or
 405        (and (mm-preferred-coding-system charset)
 406             (or (coding-system-get
 407                  (mm-preferred-coding-system charset) :mime-charset)
 408                 (coding-system-get
 409                  (mm-preferred-coding-system charset) 'mime-charset)))
 410        (and (eq charset 'ascii)
 411             'us-ascii)
 412        (mm-preferred-coding-system charset)
 413        (mm-mule-charset-to-mime-charset charset))
 414     ;; This is for XEmacs.
 415     (mm-mule-charset-to-mime-charset charset)))
 416
 417 (defun mm-delete-duplicates (list)
 418   "Simple  substitute for CL `delete-duplicates', testing with `equal'."
 419   (let (result head)
 420     (while list
 421       (setq head (car list))
 422       (setq list (delete head list))
 423       (setq result (cons head result)))
 424     (nreverse result)))
 425
 426 ;; It's not clear whether this is supposed to mean the global or local
 427 ;; setting.  I think it's used inconsistently.  -- fx
 428 (defsubst mm-multibyte-p ()
 429   "Say whether multibyte is enabled."
 430   (if (and (not (featurep 'xemacs))
 431            (boundp 'enable-multibyte-characters))
 432       enable-multibyte-characters
 433     (featurep 'mule)))
 434
 435 (defun mm-sort-coding-systems-predicate (a b)
 436   (> (length (memq a mm-coding-system-priorities))
 437      (length (memq b mm-coding-system-priorities))))
 438
 439 (defun mm-find-mime-charset-region (b e)
 440   "Return the MIME charsets needed to encode the region between B and E.
 441 nil means ASCII, a single-element list represents an appropriate MIME
 442 charset, and a longer list means no appropriate charset."
 443   (let (charsets)
 444     ;; The return possibilities of this function are a mess...
 445     (or (and (mm-multibyte-p)
 446              mm-use-find-coding-systems-region
 447              ;; Find the mime-charset of the most preferred coding
 448              ;; system that has one.
 449              (let ((systems (find-coding-systems-region b e)))
 450                (when mm-coding-system-priorities
 451                  (setq systems
 452                        (sort systems 'mm-sort-coding-systems-predicate)))
 453                ;; Fixme: The `mime-charset' (`x-ctext') of `compound-text'
 454                ;; is not in the IANA list.
 455                (setq systems (delq 'compound-text systems))
 456                (unless (equal systems '(undecided))
 457                  (while systems
 458                    (let* ((head (pop systems))
 459                           (cs (or (coding-system-get head :mime-charset)
 460                                   (coding-system-get head 'mime-charset))))
 461                      (if cs
 462                          (setq systems nil
 463                                charsets (list cs))))))
 464                charsets))
 465         ;; Fixme: won't work for unibyte Emacs 22:
 466
 467         ;; Otherwise we're not multibyte, XEmacs or a single coding
 468         ;; system won't cover it.
 469         (setq charsets
 470               (mm-delete-duplicates
 471                (mapcar 'mm-mime-charset
 472                        (delq 'ascii
 473                              (mm-find-charset-region b e))))))
 474     charsets))
 475
 476 (defmacro mm-with-unibyte-buffer (&rest forms)
 477   "Create a temporary buffer, and evaluate FORMS there like `progn'.
 478 Use unibyte mode for this."
 479   `(let (default-enable-multibyte-characters)
 480      (with-temp-buffer ,@forms)))
 481 (put 'mm-with-unibyte-buffer 'lisp-indent-function 0)
 482 (put 'mm-with-unibyte-buffer 'edebug-form-spec '(body))
 483
 484 (defmacro mm-with-unibyte-current-buffer (&rest forms)
 485   "Evaluate FORMS with current buffer temporarily made unibyte.
 486 Also bind `default-enable-multibyte-characters' to nil.
 487 Equivalent to `progn' in XEmacs"
 488   (let ((multibyte (make-symbol "multibyte"))
 489         (buffer (make-symbol "buffer")))
 490     `(if mm-emacs-mule
 491          (let ((,multibyte enable-multibyte-characters)
 492                (,buffer (current-buffer)))
 493            (unwind-protect
 494                (let (default-enable-multibyte-characters)
 495                  (set-buffer-multibyte nil)
 496                  ,@forms)
 497              (set-buffer ,buffer)
 498              (set-buffer-multibyte ,multibyte)))
 499        (let (default-enable-multibyte-characters)
 500          ,@forms))))
 501 (put 'mm-with-unibyte-current-buffer 'lisp-indent-function 0)
 502 (put 'mm-with-unibyte-current-buffer 'edebug-form-spec '(body))
 503
 504 (defmacro mm-with-unibyte (&rest forms)
 505   "Eval the FORMS with the default value of `enable-multibyte-characters' nil, ."
 506   `(let (default-enable-multibyte-characters)
 507      ,@forms))
 508 (put 'mm-with-unibyte 'lisp-indent-function 0)
 509 (put 'mm-with-unibyte 'edebug-form-spec '(body))
 510
 511 (defun mm-find-charset-region (b e)
 512   "Return a list of Emacs charsets in the region B to E."
 513   (cond
 514    ((and (mm-multibyte-p)
 515          (fboundp 'find-charset-region))
 516     ;; Remove composition since the base charsets have been included.
 517     ;; Remove eight-bit-*, treat them as ascii.
 518     (let ((css (find-charset-region b e)))
 519       (mapcar (lambda (cs) (setq css (delq cs css)))
 520               '(composition eight-bit-control eight-bit-graphic
 521                             control-1))
 522       css))
 523    (t
 524     ;; We are in a unibyte buffer or XEmacs non-mule, so we futz around a bit.
 525     (save-excursion
 526       (save-restriction
 527         (narrow-to-region b e)
 528         (goto-char (point-min))
 529         (skip-chars-forward "\0-\177")
 530         (if (eobp)
 531             '(ascii)
 532           (let (charset)
 533             (setq charset
 534                   (and (boundp 'current-language-environment)
 535                        (car (last (assq 'charset
 536                                         (assoc current-language-environment
 537                                                language-info-alist))))))
 538             (if (eq charset 'ascii) (setq charset nil))
 539             (or charset
 540                 (setq charset
 541                       (car (last (assq mail-parse-charset
 542                                        mm-mime-mule-charset-alist)))))
 543             (list 'ascii (or charset 'latin-iso8859-1)))))))))
 544
 545 (if (fboundp 'shell-quote-argument)
 546     (defalias 'mm-quote-arg 'shell-quote-argument)
 547   (defun mm-quote-arg (arg)
 548     "Return a version of ARG that is safe to evaluate in a shell."
 549     (let ((pos 0) new-pos accum)
 550       ;; *** bug: we don't handle newline characters properly
 551       (while (setq new-pos (string-match "[]*[;!'`\"$\\& \t{} |()<>]" arg pos))
 552         (push (substring arg pos new-pos) accum)
 553         (push "\\" accum)
 554         (push (list (aref arg new-pos)) accum)
 555         (setq pos (1+ new-pos)))
 556       (if (= pos 0)
 557           arg
 558         (apply 'concat (nconc (nreverse accum) (list (substring arg pos))))))))
 559
 560 (defun mm-auto-mode-alist ()
 561   "Return an `auto-mode-alist' with only the .gz (etc) thingies."
 562   (let ((alist auto-mode-alist)
 563         out)
 564     (while alist
 565       (when (listp (cdar alist))
 566         (push (car alist) out))
 567       (pop alist))
 568     (nreverse out)))
 569
 570 (defvar mm-inhibit-file-name-handlers
 571   '(jka-compr-handler image-file-handler)
 572   "A list of handlers doing (un)compression (etc) thingies.")
 573
 574 (defun mm-insert-file-contents (filename &optional visit beg end replace
 575                                          inhibit)
 576   "Like `insert-file-contents', q.v., but only reads in the file.
 577 A buffer may be modified in several ways after reading into the buffer due
 578 to advanced Emacs features, such as file-name-handlers, format decoding,
 579 find-file-hooks, etc.
 580 If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'.
 581   This function ensures that none of these modifications will take place."
 582   (let ((format-alist nil)
 583         (auto-mode-alist (if inhibit nil (mm-auto-mode-alist)))
 584         (default-major-mode 'fundamental-mode)
 585         (enable-local-variables nil)
 586         (after-insert-file-functions nil)
 587         (enable-local-eval nil)
 588         (find-file-hooks nil)
 589         (inhibit-file-name-operation (if inhibit
 590                                          'insert-file-contents
 591                                        inhibit-file-name-operation))
 592         (inhibit-file-name-handlers
 593          (if inhibit
 594              (append mm-inhibit-file-name-handlers
 595                      inhibit-file-name-handlers)
 596            inhibit-file-name-handlers)))
 597     (insert-file-contents filename visit beg end replace)))
 598
 599 (defun mm-append-to-file (start end filename &optional codesys inhibit)
 600   "Append the contents of the region to the end of file FILENAME.
 601 When called from a function, expects three arguments,
 602 START, END and FILENAME.  START and END are buffer positions
 603 saying what text to write.
 604 Optional fourth argument specifies the coding system to use when
 605 encoding the file.
 606 If INHIBIT is non-nil, inhibit mm-inhibit-file-name-handlers."
 607   (let ((coding-system-for-write
 608          (or codesys mm-text-coding-system-for-write
 609              mm-text-coding-system))
 610         (inhibit-file-name-operation (if inhibit
 611                                          'append-to-file
 612                                        inhibit-file-name-operation))
 613         (inhibit-file-name-handlers
 614          (if inhibit
 615              (append mm-inhibit-file-name-handlers
 616                      inhibit-file-name-handlers)
 617            inhibit-file-name-handlers)))
 618     (append-to-file start end filename)))
 619
 620 (defun mm-write-region (start end filename &optional append visit lockname
 621                               coding-system inhibit)
 622
 623   "Like `write-region'.
 624 If INHIBIT is non-nil, inhibit mm-inhibit-file-name-handlers."
 625   (let ((coding-system-for-write
 626          (or coding-system mm-text-coding-system-for-write
 627              mm-text-coding-system))
 628         (inhibit-file-name-operation (if inhibit
 629                                          'write-region
 630                                        inhibit-file-name-operation))
 631         (inhibit-file-name-handlers
 632          (if inhibit
 633              (append mm-inhibit-file-name-handlers
 634                      inhibit-file-name-handlers)
 635            inhibit-file-name-handlers)))
 636     (write-region start end filename append visit lockname)))
 637
 638 (defun mm-image-load-path (&optional package)
 639   (let (dir result)
 640     (dolist (path load-path (nreverse result))
 641       (if (file-directory-p
 642            (setq dir (concat (file-name-directory
 643                               (directory-file-name path))
 644                              "etc/" (or package "gnus/"))))
 645           (push dir result))
 646       (push path result))))
 647
 648 (provide 'mm-util)
 649
 650 ;;; mm-util.el ends here