* mm-util.el (mm-with-unibyte-current-buffer): Set the default
[gnus] / lisp / mm-util.el
index 22a4b76..74cd23f 100644 (file)
@@ -1,5 +1,5 @@
 ;;; mm-util.el --- Utility functions for MIME things
-;; Copyright (C) 1998,99 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;     MORIOKA Tomohiko <morioka@jaist.ac.jp>
@@ -24,6 +24,8 @@
 
 ;;; Code:
 
+(require 'mail-prsvr)
+
 (defvar mm-mime-mule-charset-alist
   '((us-ascii ascii)
     (iso-8859-1 latin-iso8859-1)
     (iso-8859-3 latin-iso8859-3)
     (iso-8859-4 latin-iso8859-4)
     (iso-8859-5 cyrillic-iso8859-5)
-    (koi8-r cyrillic-iso8859-5)
+    ;; Non-mule (X)Emacs uses the last mule-charset for 8bit characters.
+    ;; The fake mule-charset, gnus-koi8-r, tells Gnus that the default 
+    ;; charset is koi8-r, not iso-8859-5.
+    (koi8-r cyrillic-iso8859-5 gnus-koi8-r)
     (iso-8859-6 arabic-iso8859-6)
     (iso-8859-7 greek-iso8859-7)
     (iso-8859-8 hebrew-iso8859-8)
                    chinese-cns11643-1 chinese-cns11643-2
                    chinese-cns11643-3 chinese-cns11643-4
                    chinese-cns11643-5 chinese-cns11643-6
-                   chinese-cns11643-7))
+                   chinese-cns11643-7)
+    (utf-8 unicode-a unicode-b unicode-c unicode-d unicode-e))
   "Alist of MIME-charset/MULE-charsets.")
 
-
 (eval-and-compile
   (mapcar
    (lambda (elem)
           prompt (mapcar (lambda (s) (list (symbol-name (car s))))
                          mm-mime-mule-charset-alist)))))))
 
+(eval-and-compile
+  (defalias 'mm-char-or-char-int-p
+    (cond 
+     ((fboundp 'char-or-char-int-p) 'char-or-char-int-p)
+     ((fboundp 'char-valid-p) 'char-valid-p) 
+     (t 'identity))))
+
 (defvar mm-coding-system-list nil)
 (defun mm-get-coding-system-list ()
   "Get the coding system list."
@@ -213,7 +225,26 @@ used as the line break code type of the coding system."
 If POS is nil, it defauls to the current point.
 If POS is out of range, the value is nil.
 If the charset is `composition', return the actual one."
-  (let ((charset (charset-after pos)))
+  (let ((charset (cond 
+                 ((fboundp 'charset-after)
+                  (charset-after pos))
+                 ((fboundp 'char-charset)
+                  (char-charset (char-after pos)))
+                 ((< (mm-char-int (char-after pos)) 128)
+                  'ascii)
+                 (mail-parse-mule-charset ;; cached mule-charset
+                  mail-parse-mule-charset)
+                 ((boundp 'current-language-environment)
+                  (let ((entry (assoc current-language-environment 
+                                      language-info-alist)))
+                    (setq mail-parse-mule-charset
+                          (or (car (last (assq 'charset entry)))
+                              'latin-iso8859-1))))
+                 (t                       ;; figure out the charset
+                  (setq mail-parse-mule-charset
+                        (or (car (last (assq mail-parse-charset
+                                             mm-mime-mule-charset-alist)))
+                            'latin-iso8859-1))))))
     (if (eq charset 'composition)
        (let ((p (or pos (point))))
          (cadr (find-charset-region p (1+ p))))
@@ -221,7 +252,7 @@ If the charset is `composition', return the actual one."
 
 (defun mm-mime-charset (charset)
   "Return the MIME charset corresponding to the MULE CHARSET."
-  (if (fboundp 'coding-system-get)
+  (if (and (fboundp 'coding-system-get) (fboundp 'get-charset-property))
       ;; This exists in Emacs 20.
       (or
        (and (mm-preferred-coding-system charset)
@@ -234,6 +265,15 @@ If the charset is `composition', return the actual one."
     ;; This is for XEmacs.
     (mm-mule-charset-to-mime-charset charset)))
 
+(defun mm-delete-duplicates (list)
+  "Simple  substitute for CL `delete-duplicates', testing with `equal'."
+  (let (result head)
+    (while list
+      (setq head (car list))
+      (setq list (delete head list))
+      (setq result (cons head result)))
+    (nreverse result)))
+
 (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
@@ -241,7 +281,7 @@ If the charset is `composition', return the actual one."
                                (mm-find-charset-region b e)))))
     (when (memq 'iso-2022-jp-2 charsets)
       (setq charsets (delq 'iso-2022-jp charsets)))
-    (setq charsets (delete-duplicates charsets))
+    (setq charsets (mm-delete-duplicates charsets))
     (if (and (> (length charsets) 1)
             (fboundp 'find-coding-systems-region)
             (memq 'utf-8 (find-coding-systems-region b e)))
@@ -294,7 +334,9 @@ See also `with-temp-file' and `with-output-to-string'."
                   (coding-system-for-read mm-binary-coding-system)
                   (coding-system-for-write mm-binary-coding-system))
               (set-buffer-multibyte nil)
+              (setq-default enable-multibyte-characters nil)
               ,@forms)
+          (setq-default enable-multibyte-characters ,multibyte)
           (set-buffer-multibyte ,multibyte))))))
 (put 'mm-with-unibyte-current-buffer 'lisp-indent-function 0)
 (put 'mm-with-unibyte-current-buffer 'edebug-form-spec '(body))
@@ -329,7 +371,10 @@ See also `with-temp-file' and `with-output-to-string'."
        (skip-chars-forward "\0-\177")
        (if (eobp)
            '(ascii)
-         (delq nil (list 'ascii mail-parse-charset))))))
+         (delq nil (list 'ascii 
+                         (or (car (last (assq mail-parse-charset
+                                              mm-mime-mule-charset-alist)))
+                             'latin-iso8859-1)))))))
    (t
     ;; We are in a unibyte buffer, so we futz around a bit.
     (save-excursion
@@ -341,7 +386,9 @@ See also `with-temp-file' and `with-output-to-string'."
          (skip-chars-forward "\0-\177")
          (if (eobp)
              '(ascii)
-           (delq nil (list 'ascii (car (last (assq 'charset entry))))))))))))
+           (delq nil (list 'ascii 
+                           (or (car (last (assq 'charset entry)))
+                               'latin-iso8859-1))))))))))
 
 (defun mm-read-charset (prompt)
   "Return a charset."