Importing Pterodactyl Gnus v0.87.

[elisp/gnus.git-] / lisp / mm-util.el

diff --git a/lisp/mm-util.el b/lisp/mm-util.el
index 13b5fdd..2ade070 100644 (file)
--- a/lisp/mm-util.el
+++ b/lisp/mm-util.el
@@ -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>

@@ -26,22 +26,25 @@
 
 (defvar mm-running-xemacs (string-match "XEmacs" emacs-version))
 
 
 (defvar mm-running-xemacs (string-match "XEmacs" emacs-version))
 

-(defvar mm-binary-coding-system 
-    (if mm-running-xemacs
-       'binary 'no-conversion)
-    "100% binary coding system.")   
+(defvar mm-running-ntemacs
+  (and (not mm-running-xemacs)
+       (string-match "nt" system-configuration)))

 
 

-(defvar mm-default-coding-system nil
-  "The default coding system to use.")  
+(defvar mm-binary-coding-system
+  (if mm-running-xemacs
+      'binary 'no-conversion)
+  "100% binary coding system.")

 
 

-(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.")
+(defvar mm-text-coding-system
+  (cond
+   ((not (fboundp 'coding-system-p)) nil)
+   (mm-running-xemacs  ;; XEmacs
+    '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-mime-mule-charset-alist
   '((us-ascii ascii)
 
 (defvar mm-mime-mule-charset-alist
   '((us-ascii ascii)

@@ -55,16 +58,21 @@ 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)

+    (viscii vietnamese-viscii-lower)

     (iso-2022-jp-2 japanese-jisx0208)
     (iso-2022-jp latin-jisx0201
                 japanese-jisx0208-1978)
     (euc-kr korean-ksc5601)
     (cn-gb-2312 chinese-gb2312)
     (cn-big5 chinese-big5-1 chinese-big5-2)
     (iso-2022-jp-2 japanese-jisx0208)
     (iso-2022-jp latin-jisx0201
                 japanese-jisx0208-1978)
     (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

@@ -115,23 +123,15 @@ 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.")
+(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.")
+
+;;; Internal variables:

 
 

-;;;Internal variable
-(defvar mm-charset-iso-8859-1-forced nil)
+;;; 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."

@@ -151,19 +151,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)

@@ -198,22 +193,30 @@ 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-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 (get-charset-property charset 'prefered-coding-system)
+           (coding-system-get
+            (get-charset-property charset 'prefered-coding-system)
+            'mime-charset))
+       (and (eq charset 'ascii)
+           'us-ascii)
+       (get-charset-property charset 'prefered-coding-system)
+       (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)))))
+    (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)

@@ -249,8 +252,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

@@ -260,8 +263,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

@@ -275,6 +277,28 @@ 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)))))))
+

 (provide 'mm-util)
 
 ;;; mm-util.el ends here
 (provide 'mm-util)
 
 ;;; mm-util.el ends here