Sync up with Pterodactyl Gnus v0.83.

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

diff --git a/lisp/mm-util.el b/lisp/mm-util.el
index 29c65ac..dfad2a2 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>

@@ -24,16 +24,27 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(defvar mm-binary-coding-system 
-    (if (string-match "XEmacs" emacs-version)
-       'binary 'no-conversion)
-    "100% binary coding system.")   
+(defvar mm-running-xemacs (string-match "XEmacs" emacs-version))

 
 

-(defvar mm-default-coding-system nil
-  "The default coding system to use.")  
+(defvar mm-running-ntemacs
+  (and (not mm-running-xemacs)
+       (string-match "nt" system-configuration)))

 
 

-(defvar mm-known-charsets '(iso-8859-1)
-  "List of known charsets.")
+(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
+    '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)

@@ -47,16 +58,21 @@
     (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

@@ -107,23 +123,15 @@
   (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."

@@ -143,18 +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))
-        (memq charset mm-known-charsets))
+   ((null (mm-get-coding-system-list))

     charset)
    ;; ascii
    ((eq charset 'us-ascii)
     charset)
    ;; ascii
    ((eq charset 'us-ascii)

@@ -189,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)

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

@@ -250,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

@@ -265,6 +277,15 @@ 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)))
+

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