Importing Pterodactyl Gnus v0.95.
[elisp/gnus.git-] / lisp / mm-util.el
index 6da9c66..a8e8f8b 100644 (file)
@@ -1,5 +1,5 @@
 ;;; mm-util.el --- Utility functions for MIME things
 ;;; mm-util.el --- Utility functions for MIME things
-;; Copyright (C) 1998 Free Software Foundation, Inc.
+;; Copyright (C) 1998,99 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;     MORIOKA Tomohiko <morioka@jaist.ac.jp>
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;     MORIOKA Tomohiko <morioka@jaist.ac.jp>
 
 ;;; Code:
 
 
 ;;; Code:
 
-(defvar mm-running-xemacs (string-match "XEmacs" emacs-version))
+(defconst mm-running-xemacs (string-match "XEmacs" emacs-version))
 
 
-(defvar mm-running-ntemacs 
-  (and (not mm-running-xemacs) 
-       (string-match "nt" system-configuration)))
+(defconst mm-binary-coding-system
+  (if mm-running-xemacs
+      'binary 'no-conversion)
+  "100% binary coding system.")
 
 
-(defvar mm-binary-coding-system 
-    (if mm-running-xemacs
-       'binary 'no-conversion)
-    "100% binary coding system.")   
-
-(defvar mm-text-coding-system 
-  (cond 
-   ((not (fboundp 'coding-system-p)) nil)
-   (mm-running-xemacs  ;; XEmacs
-    (and (coding-system-p 'no-conversion) 'no-conversion))
-   (mm-running-ntemacs ;; NTEmacs
-    (and (coding-system-p 'raw-text-dos) 'raw-text-dos))
-   ((coding-system-p 'raw-text) 'raw-text) ;; Emacs
-   (t nil))
-  "100% text coding system, for removing ^M.")
-
-(defvar mm-default-coding-system nil
-  "The default coding system to use.")  
-
-(defvar mm-known-charsets '(iso-8859-1)
-  "List of known charsets.
-Use this under non-Mule Emacsen to specify which charsets your Emacs
-can display.  Also see `mm-default-charset'.")
-
-(defvar mm-default-charset 'iso-8859-1
-  "Default charset assumed to be used when viewing non-ASCII characters.
-This variable is used only in non-Mule Emacsen.")
+(defconst mm-text-coding-system
+  (and (fboundp 'coding-system-list)
+   (if (memq system-type '(windows-nt ms-dos ms-windows))
+       'raw-text-dos 'raw-text))
+  "Text-safe coding system (For removing ^M).")
 
 (defvar mm-mime-mule-charset-alist
   '((us-ascii ascii)
 
 (defvar mm-mime-mule-charset-alist
   '((us-ascii ascii)
@@ -70,16 +49,19 @@ This variable is used only in non-Mule Emacsen.")
     (iso-8859-7 greek-iso8859-7)
     (iso-8859-8 hebrew-iso8859-8)
     (iso-8859-9 latin-iso8859-9)
     (iso-8859-7 greek-iso8859-7)
     (iso-8859-8 hebrew-iso8859-8)
     (iso-8859-9 latin-iso8859-9)
-    (iso-2022-jp-2 japanese-jisx0208)
-    (iso-2022-jp latin-jisx0201
-                japanese-jisx0208-1978)
+    (viscii vietnamese-viscii-lower)
+    (iso-2022-jp latin-jisx0201 japanese-jisx0208 japanese-jisx0208-1978)
     (euc-kr korean-ksc5601)
     (cn-gb-2312 chinese-gb2312)
     (cn-big5 chinese-big5-1 chinese-big5-2)
     (euc-kr korean-ksc5601)
     (cn-gb-2312 chinese-gb2312)
     (cn-big5 chinese-big5-1 chinese-big5-2)
+    (tibetan tibetan)
+    (thai-tis620 thai-tis620)
+    (iso-2022-7bit ethiopic arabic-1-column arabic-2-column)
     (iso-2022-jp-2 latin-iso8859-1 greek-iso8859-7
                   latin-jisx0201 japanese-jisx0208-1978
                   chinese-gb2312 japanese-jisx0208
     (iso-2022-jp-2 latin-iso8859-1 greek-iso8859-7
                   latin-jisx0201 japanese-jisx0208-1978
                   chinese-gb2312 japanese-jisx0208
-                  korean-ksc5601 japanese-jisx0212)
+                  korean-ksc5601 japanese-jisx0212
+                  katakana-jisx0201)
     (iso-2022-int-1 latin-iso8859-1 greek-iso8859-7
                    latin-jisx0201 japanese-jisx0208-1978
                    chinese-gb2312 japanese-jisx0208
     (iso-2022-int-1 latin-iso8859-1 greek-iso8859-7
                    latin-jisx0201 japanese-jisx0208-1978
                    chinese-gb2312 japanese-jisx0208
@@ -130,23 +112,27 @@ This variable is used only in non-Mule Emacsen.")
   (or mm-coding-system-list
       (setq mm-coding-system-list (mm-coding-system-list))))
 
   (or mm-coding-system-list
       (setq mm-coding-system-list (mm-coding-system-list))))
 
-(defvar mm-charset-coding-system-alist
-  (let ((rest
-        '((gb2312 . cn-gb-2312)
-          (iso-2022-jp-2 . iso-2022-7bit-ss2)
-          (x-ctext . ctext)))
-       (systems (mm-get-coding-system-list))
-       dest)
-    (while rest
-      (let ((pair (car rest)))
-       (unless (memq (car pair) systems)
-         (setq dest (cons pair dest))))
-      (setq rest (cdr rest)))
-    dest)
-  "Charset/coding system alist.")
-
-;;;Internal variable
-(defvar mm-charset-iso-8859-1-forced nil)
+(defvar mm-charset-synonym-alist
+  '((big5 . cn-big5)
+    (gb2312 . cn-gb-2312)
+    (x-ctext . ctext))
+  "A mapping from invalid charset names to the real charset names.")
+
+(defconst mm-auto-save-coding-system
+  (cond 
+   ((memq 'emacs-mule (mm-get-coding-system-list))
+    (if (memq system-type '(windows-nt ms-dos ms-windows))
+       'emacs-mule-dos 'emacs-mule))
+   ((memq 'escape-quoted (mm-get-coding-system-list))
+    'escape-quoted)
+   ((memq 'no-conversion (mm-get-coding-system-list))
+    'no-conversion)
+   (t nil))
+  "Coding system of auto save file.")
+
+;;; Internal variables:
+
+;;; Functions:
 
 (defun mm-mule-charset-to-mime-charset (charset)
   "Return the MIME charset corresponding to MULE CHARSET."
 
 (defun mm-mule-charset-to-mime-charset (charset)
   "Return the MIME charset corresponding to MULE CHARSET."
@@ -166,19 +152,14 @@ If optional argument LBT (`unix', `dos' or `mac') is specified, it is
 used as the line break code type of the coding system."
   (when (stringp charset)
     (setq charset (intern (downcase charset))))
 used as the line break code type of the coding system."
   (when (stringp charset)
     (setq charset (intern (downcase charset))))
-  (if (and mm-charset-iso-8859-1-forced 
-          (eq charset 'iso-8859-1))
-      (setq charset mm-charset-iso-8859-1-forced))
   (setq charset
   (setq charset
-       (or (cdr (assq charset mm-charset-coding-system-alist))
+       (or (cdr (assq charset mm-charset-synonym-alist))
            charset))
   (when lbt
     (setq charset (intern (format "%s-%s" charset lbt))))
   (cond
    ;; Running in a non-MULE environment.
            charset))
   (when lbt
     (setq charset (intern (format "%s-%s" charset lbt))))
   (cond
    ;; Running in a non-MULE environment.
-   ((and (null (mm-get-coding-system-list))
-        (or (eq charset mm-default-charset)
-            (memq charset mm-known-charsets)))
+   ((null (mm-get-coding-system-list))
     charset)
    ;; ascii
    ((eq charset 'us-ascii)
     charset)
    ;; ascii
    ((eq charset 'us-ascii)
@@ -205,6 +186,7 @@ used as the line break code type of the coding system."
 (defsubst mm-enable-multibyte ()
   "Enable multibyte in the current buffer."
   (when (and (fboundp 'set-buffer-multibyte)
 (defsubst mm-enable-multibyte ()
   "Enable multibyte in the current buffer."
   (when (and (fboundp 'set-buffer-multibyte)
+             (boundp 'enable-multibyte-characters)
             (default-value 'enable-multibyte-characters))
     (set-buffer-multibyte t)))
 
             (default-value 'enable-multibyte-characters))
     (set-buffer-multibyte t)))
 
@@ -213,22 +195,36 @@ used as the line break code type of the coding system."
   (when (fboundp 'set-buffer-multibyte)
     (set-buffer-multibyte nil)))
 
   (when (fboundp 'set-buffer-multibyte)
     (set-buffer-multibyte nil)))
 
-(defun mm-mime-charset (charset b e)
+(defun mm-preferred-coding-system (charset)
+  ;; A typo in some Emacs versions.
+  (or (get-charset-property charset 'prefered-coding-system)
+      (get-charset-property charset 'preffered-coding-system)))
+
+(defun mm-mime-charset (charset)
+  "Return the MIME charset corresponding to the MULE CHARSET."
   (if (fboundp 'coding-system-get)
   (if (fboundp 'coding-system-get)
+      ;; This exists in Emacs 20.
       (or
       (or
-       (and
-       mm-default-coding-system
-       (let ((safe (coding-system-get mm-default-coding-system
-                                      'safe-charsets)))
-         (or (eq safe t) (memq charset safe)))
-       (coding-system-get mm-default-coding-system 'mime-charset))
-       (coding-system-get
-       (get-charset-property charset 'prefered-coding-system)
-       'mime-charset)
-       (car (memq charset (find-coding-systems-region
-                          (point-min) (point-max)))))
+       (and (mm-preferred-coding-system charset)
+           (coding-system-get
+            (mm-preferred-coding-system charset) 'mime-charset))
+       (and (eq charset 'ascii)
+           'us-ascii)
+       (mm-preferred-coding-system charset)
+       (mm-mule-charset-to-mime-charset charset))
+    ;; This is for XEmacs.
     (mm-mule-charset-to-mime-charset charset)))
 
     (mm-mule-charset-to-mime-charset charset)))
 
+(defun mm-find-mime-charset-region (b e)
+  "Return the MIME charsets needed to encode the region between B and E."
+  (let ((charsets
+        (mapcar 'mm-mime-charset
+                (delq 'ascii
+                      (mm-find-charset-region b e)))))
+    (when (memq 'iso-2022-jp-2 charsets)
+      (setq charsets (delq 'iso-2022-jp charsets)))
+    (delete-duplicates charsets)))
+
 (defsubst mm-multibyte-p ()
   "Say whether multibyte is enabled."
   (and (boundp 'enable-multibyte-characters)
 (defsubst mm-multibyte-p ()
   "Say whether multibyte is enabled."
   (and (boundp 'enable-multibyte-characters)
@@ -264,8 +260,8 @@ See also `with-temp-file' and `with-output-to-string'."
   "Return a list of charsets in the region."
   (cond
    ((and (boundp 'enable-multibyte-characters)
   "Return a list of charsets in the region."
   (cond
    ((and (boundp 'enable-multibyte-characters)
-        enable-multibyte-characters
-        (fboundp 'find-charset-region))
+        enable-multibyte-characters
+        (fboundp 'find-charset-region))
     (find-charset-region b e))
    ((not (boundp 'current-language-environment))
     (save-excursion
     (find-charset-region b e))
    ((not (boundp 'current-language-environment))
     (save-excursion
@@ -275,8 +271,7 @@ See also `with-temp-file' and `with-output-to-string'."
        (skip-chars-forward "\0-\177")
        (if (eobp)
            '(ascii)
        (skip-chars-forward "\0-\177")
        (if (eobp)
            '(ascii)
-         ;;;!!!bogus
-         (list 'ascii 'latin-iso8859-1)))))
+         (delq nil (list 'ascii mail-parse-charset))))))
    (t
     ;; We are in a unibyte buffer, so we futz around a bit.
     (save-excursion
    (t
     ;; We are in a unibyte buffer, so we futz around a bit.
     (save-excursion
@@ -290,6 +285,53 @@ See also `with-temp-file' and `with-output-to-string'."
              '(ascii)
            (list 'ascii (car (last (assq 'charset entry)))))))))))
 
              '(ascii)
            (list 'ascii (car (last (assq 'charset entry)))))))))))
 
+(defun mm-read-charset (prompt)
+  "Return a charset."
+  (intern
+   (completing-read
+    prompt
+    (mapcar (lambda (e) (list (symbol-name (car e))))
+           mm-mime-mule-charset-alist)
+    nil t)))
+
+(defun mm-quote-arg (arg)
+  "Return a version of ARG that is safe to evaluate in a shell."
+  (let ((pos 0) new-pos accum)
+    ;; *** bug: we don't handle newline characters properly
+    (while (setq new-pos (string-match "[]*[;!'`\"$\\& \t{} |()<>]" arg pos))
+      (push (substring arg pos new-pos) accum)
+      (push "\\" accum)
+      (push (list (aref arg new-pos)) accum)
+      (setq pos (1+ new-pos)))
+    (if (= pos 0)
+        arg
+      (apply 'concat (nconc (nreverse accum) (list (substring arg pos)))))))
+
+(defun mm-auto-mode-alist ()
+  "Return an `auto-mode-alist' with only the .gz (etc) thingies."
+  (let ((alist auto-mode-alist)
+       out)
+    (while alist
+      (when (listp (cdar alist))
+       (push (car alist) out))
+      (pop alist))
+    (nreverse out)))
+
+(defun mm-insert-file-contents (filename &optional visit beg end replace)
+  "Like `insert-file-contents', q.v., but only reads in the file.
+A buffer may be modified in several ways after reading into the buffer due
+to advanced Emacs features, such as file-name-handlers, format decoding,
+find-file-hooks, etc.
+  This function ensures that none of these modifications will take place."
+  (let ((format-alist nil)
+       (auto-mode-alist (mm-auto-mode-alist))
+       (default-major-mode 'fundamental-mode)
+       (enable-local-variables nil)
+        (after-insert-file-functions nil)
+       (enable-local-eval nil)
+       (find-file-hooks nil))
+    (insert-file-contents filename visit beg end replace)))
+
 (provide 'mm-util)
 
 ;;; mm-util.el ends here
 (provide 'mm-util)
 
 ;;; mm-util.el ends here