Importing Oort Gnus v0.06.

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

diff --git a/lisp/mm-util.el b/lisp/mm-util.el
index e64e325..18bf4d7 100644 (file)
--- a/lisp/mm-util.el
+++ b/lisp/mm-util.el
@@ -121,7 +121,7 @@
        '((iso-8859-15 . iso-8859-1)))
     ;; Windows-1252 is actually a superset of Latin-1.  See also
     ;; `gnus-article-dumbquotes-map'.
-    ,@(unless (mm-coding-system-p 'windows-1252)       
+    ,@(unless (mm-coding-system-p 'windows-1252)
        (if (mm-coding-system-p 'cp1252)
           '((windows-1252 . cp1252))
         '((windows-1252 . iso-8859-1))))
@@ -245,7 +245,7 @@ Valid elements include:
 `iso-2022-jp-2'  convert ISO-2022-jp to ISO-2022-jp-2 if ISO-2022-jp-2 exists."
 )
 
-(defvar mm-iso-8859-15-compatible 
+(defvar mm-iso-8859-15-compatible
   '((iso-8859-1 "\xA4\xA6\xA8\xB4\xB8\xBC\xBD\xBE")
     (iso-8859-9 "\xA4\xA6\xA8\xB4\xB8\xBC\xBD\xBE\xD0\xDD\xDE\xF0\xFD\xFE"))
   "ISO-8859-15 exchangeable coding systems and inconvertible characters.")
@@ -253,16 +253,16 @@ Valid elements include:
 (defvar mm-iso-8859-x-to-15-table
   (and (fboundp 'coding-system-p)
        (mm-coding-system-p 'iso-8859-15)
-       (mapcar 
+       (mapcar
        (lambda (cs)
          (if (mm-coding-system-p (car cs))
-             (let ((c (string-to-char 
+             (let ((c (string-to-char
                        (decode-coding-string "\341" (car cs)))))
                (cons (char-charset c)
                      (cons
-                      (- (string-to-char 
+                      (- (string-to-char
                           (decode-coding-string "\341" 'iso-8859-15)) c)
-                      (string-to-list (decode-coding-string (car (cdr cs)) 
+                      (string-to-list (decode-coding-string (car (cdr cs))
                                                             (car cs))))))
            '(gnus-charset 0)))
        mm-iso-8859-15-compatible))
@@ -283,7 +283,10 @@ prefer iso-2022-jp to japanese-shift-jis:
 
 (defvar mm-use-find-coding-systems-region
   (fboundp 'find-coding-systems-region)
-  "Use `find-coding-systems-region' to find proper coding systems.")
+  "Use `find-coding-systems-region' to find proper coding systems.
+
+Setting it to nil is useful on Emacsen supporting Unicode if sending
+mail with multiple parts is preferred to sending a Unicode one.")
 
 ;;; Internal variables:
 
@@ -358,7 +361,7 @@ used as the line break code type of the coding system."
                             default-enable-multibyte-characters
                             (fboundp 'set-buffer-multibyte))
     "Emacs mule.")
-  
+
   (defvar mm-mule4-p (and mm-emacs-mule
                          (fboundp 'charsetp)
                          (not (charsetp 'eight-bit-control)))
@@ -385,7 +388,7 @@ This is a no-op in XEmacs."
 Only used in Emacs Mule 4."
        (set-buffer-multibyte t))
     (defalias 'mm-enable-multibyte-mule4 'ignore))
-  
+
   (if mm-mule4-p
       (defun mm-disable-multibyte-mule4 ()
        "Disable multibyte in the current buffer.
@@ -478,15 +481,15 @@ If the charset is `composition', return the actual one."
          (goto-char (point-min))
          (skip-chars-forward "\0-\177")
          (while (not (eobp))
-           (cond 
-            ((not (setq item (assq (char-charset (setq c (char-after))) 
+           (cond
+            ((not (setq item (assq (char-charset (setq c (char-after)))
                                    mm-iso-8859-x-to-15-table)))
              (forward-char))
             ((memq c (cdr (cdr item)))
              (setq inconvertible t)
              (forward-char))
             (t
-             (insert-before-markers (prog1 (+ c (car (cdr item))) 
+             (insert-before-markers (prog1 (+ c (car (cdr item)))
                                       (delete-char 1))))
            (skip-chars-forward "\0-\177"))))
        (not inconvertible))))
@@ -507,7 +510,7 @@ charset, and a longer list means no appropriate charset."
             ;; system that has one.
             (let ((systems (find-coding-systems-region b e)))
               (when mm-coding-system-priorities
-                (setq systems 
+                (setq systems
                       (sort systems 'mm-sort-coding-systems-predicate)))
               ;; Fixme: The `mime-charset' (`x-ctext') of `compound-text'
               ;; is not in the IANA list.
@@ -521,7 +524,7 @@ charset, and a longer list means no appropriate charset."
               charsets))
        ;; Otherwise we're not multibyte, XEmacs or a single coding
        ;; system won't cover it.
-       (setq charsets 
+       (setq charsets
              (mm-delete-duplicates
               (mapcar 'mm-mime-charset
                       (delq 'ascii
@@ -550,8 +553,8 @@ Also bind `default-enable-multibyte-characters' to nil.
 Equivalent to `progn' in XEmacs"
   (let ((multibyte (make-symbol "multibyte"))
        (buffer (make-symbol "buffer")))
-    `(if mm-emacs-mule 
-        (let ((,multibyte enable-multibyte-characters)
+    `(if mm-emacs-mule
+        (let ((,multibyte enable-multibyte-characters)
               (,buffer (current-buffer)))
           (unwind-protect
               (let (default-enable-multibyte-characters)
@@ -570,7 +573,7 @@ Mule4 only."
   (let ((multibyte (make-symbol "multibyte"))
        (buffer (make-symbol "buffer")))
     `(if mm-mule4-p
-        (let ((,multibyte enable-multibyte-characters)
+        (let ((,multibyte enable-multibyte-characters)
               (,buffer (current-buffer)))
           (unwind-protect
               (let (default-enable-multibyte-characters)
@@ -752,6 +755,45 @@ If INHIBIT is non-nil, inhibit mm-inhibit-file-name-handlers."
     (let ((cs (mm-detect-coding-region start end)))
       cs)))
 
+(defun mm-guess-mime-charset ()
+  "Guess the default MIME charset from the language environment."
+  (let ((language-info
+        (and (boundp 'current-language-environment)
+             (assoc current-language-environment
+                    language-info-alist)))
+       item)
+    (cond
+     ((null language-info)
+      'iso-8859-1)
+     ((setq item
+           (cadr
+            (or (assq 'coding-priority language-info)
+                (assq 'coding-system language-info))))
+      (if (fboundp 'coding-system-get)
+         (or (coding-system-get item 'mime-charset)
+             item)
+       item))
+     ((setq item (car (last (assq 'charset language-info))))
+      (if (eq item 'ascii)
+         'iso-8859-1
+       (mm-mime-charset item)))
+     (t
+      'iso-8859-1))))
+
+;; It is not a MIME function, but some MIME functions use it.
+(defalias 'mm-make-temp-file
+  (if (fboundp 'make-temp-file)
+      'make-temp-file
+    (lambda (prefix &optional dir-flag)
+      (let ((file (expand-file-name
+                  (make-temp-name prefix)
+                  (if (fboundp 'temp-directory)
+                      (temp-directory)
+                    temporary-file-directory))))
+       (if dir-flag
+           (make-directory file))
+       file))))
+
 (provide 'mm-util)
 
 ;;; mm-util.el ends here