Importing Pterodactyl Gnus v0.54.

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

diff --git a/lisp/mm-util.el b/lisp/mm-util.el
index b36c62b..51ab0f0 100644 (file)
--- a/lisp/mm-util.el
+++ b/lisp/mm-util.el
@@ -24,6 +24,9 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

+(defvar mm-default-coding-system nil
+  "The default coding system to use.")  
+

 (defvar mm-known-charsets '(iso-8859-1)
   "List of known charsets.")
 
 (defvar mm-known-charsets '(iso-8859-1)
   "List of known charsets.")
 

@@ -66,50 +69,44 @@
 
 
 (eval-and-compile
 
 
 (eval-and-compile

-  (if (fboundp 'decode-coding-string)
-      (fset 'mm-decode-coding-string 'decode-coding-string)
-    (fset 'mm-decode-coding-string (lambda (s a) s)))
-
-  (if (fboundp 'encode-coding-string)
-      (fset 'mm-encode-coding-string 'encode-coding-string)
-    (fset 'mm-encode-coding-string (lambda (s a) s)))
-
-  (if (fboundp 'encode-coding-region)
-      (fset 'mm-encode-coding-region 'encode-coding-region)
-    (fset 'mm-encode-coding-region 'ignore))
-
-  (if (fboundp 'decode-coding-region)
-      (fset 'mm-decode-coding-region 'decode-coding-region)
-    (fset 'mm-decode-coding-region 'ignore))
-
-  (if (fboundp 'coding-system-list)
-      (fset 'mm-coding-system-list 'coding-system-list)
-    (fset 'mm-coding-system-list 'ignore))
-
-  (if (fboundp 'char-int)
-      (fset 'mm-char-int 'char-int)
-    (fset 'mm-char-int 'identity))
-
-  (if (fboundp 'coding-system-equal)
-      (fset 'mm-coding-system-equal 'coding-system-equal)
-    (fset 'mm-coding-system-equal 'equal))
-
-  (if (fboundp 'read-coding-system)
-      (fset 'mm-read-coding-system 'read-coding-system)
-    (defun mm-read-coding-system (prompt)
-      "Prompt the user for a coding system."
-      (completing-read
-       prompt (mapcar (lambda (s) (list (symbol-name (car s))))
-                     mm-mime-mule-charset-alist)))))
+  (mapcar
+   (lambda (elem)
+     (let ((nfunc (intern (format "mm-%s" (car elem)))))
+       (if (fboundp (car elem))
+          (fset nfunc (car elem))
+        (fset nfunc (cdr elem)))))
+   '((decode-coding-string . (lambda (s a) s))
+     (encode-coding-string . (lambda (s a) s))
+     (encode-coding-region . ignore)
+     (coding-system-list . ignore)
+     (decode-coding-region . ignore)
+     (char-int . identity)
+     (device-type . ignore)
+     (coding-system-equal . equal)
+     (annotationp . ignore)
+     (set-buffer-file-coding-system . ignore)
+     (make-char
+      . (lambda (charset int)
+         (int-to-char int)))
+     (read-coding-system
+      . (lambda (prompt)
+         "Prompt the user for a coding system."
+         (completing-read
+          prompt (mapcar (lambda (s) (list (symbol-name (car s))))
+                         mm-mime-mule-charset-alist)))))))

 
 

+(defvar mm-coding-system-list nil)
+(defun mm-get-coding-system-list ()
+  "Get the 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
 
 (defvar mm-charset-coding-system-alist
   (let ((rest

-        '((us-ascii . iso-8859-1)
-          (gb2312 . cn-gb-2312)
+        '((gb2312 . cn-gb-2312)

           (iso-2022-jp-2 . iso-2022-7bit-ss2)
           (x-ctext . ctext)))
           (iso-2022-jp-2 . iso-2022-7bit-ss2)
           (x-ctext . ctext)))

-       (systems (mm-coding-system-list))
+       (systems (mm-get-coding-system-list))

        dest)
     (while rest
       (let ((pair (car rest)))
        dest)
     (while rest
       (let ((pair (car rest)))

@@ -119,6 +116,8 @@
     dest)
   "Charset/coding system alist.")
 
     dest)
   "Charset/coding system alist.")
 

+;;;Internal variable
+(defvar mm-charset-iso-8859-1-forced nil)

 
 (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."

@@ -138,6 +137,9 @@ 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
        (or (cdr (assq charset mm-charset-coding-system-alist))
            charset))
   (setq charset
        (or (cdr (assq charset mm-charset-coding-system-alist))
            charset))

@@ -145,11 +147,14 @@ used as the line break code type of the coding system."
     (setq charset (intern (format "%s-%s" charset lbt))))
   (cond
    ;; Running in a non-MULE environment.
     (setq charset (intern (format "%s-%s" charset lbt))))
   (cond
    ;; Running in a non-MULE environment.

-   ((and (null (mm-coding-system-list))
+   ((and (null (mm-get-coding-system-list))

         (memq charset mm-known-charsets))
     charset)
         (memq charset mm-known-charsets))
     charset)

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

    ;; Check to see whether we can handle this charset.
    ;; Check to see whether we can handle this charset.

-   ((memq charset (mm-coding-system-list))
+   ((memq charset (mm-get-coding-system-list))

     charset)
    ;; Nope.
    (t
     charset)
    ;; Nope.
    (t

@@ -167,23 +172,90 @@ used as the line break code type of the coding system."
       (setq idx (1+ idx)))
     string))
 
       (setq idx (1+ idx)))
     string))
 

-(defun mm-enable-multibyte ()
+(defsubst mm-enable-multibyte ()

   "Enable multibyte in the current buffer."
   "Enable multibyte in the current buffer."

-  (when (fboundp 'set-buffer-multibyte)
+  (when (and (fboundp 'set-buffer-multibyte)
+            (default-value 'enable-multibyte-characters))

     (set-buffer-multibyte t)))
 
     (set-buffer-multibyte t)))
 

-(defun mm-insert-rfc822-headers (charset encoding)
-  "Insert text/plain headers with CHARSET and ENCODING."
-  (insert "MIME-Version: 1.0\n")
-  (insert "Content-Type: text/plain; charset=\""
-         (downcase (symbol-name charset)) "\"\n")
-  (insert "Content-Transfer-Encoding: "
-         (downcase (symbol-name encoding)) "\n"))
-
-(defun mm-content-type-charset (header)
-  "Return the charset parameter from HEADER."
-  (when (string-match "charset *= *\"? *\\([-0-9a-zA-Z_]+\\)\"? *$" header)
-    (intern (downcase (match-string 1 header)))))
+(defsubst mm-disable-multibyte ()
+  "Disable multibyte in the current buffer."
+  (when (fboundp 'set-buffer-multibyte)
+    (set-buffer-multibyte nil)))
+
+(defun mm-mime-charset (charset b e)
+  (if (fboundp 'coding-system-get)
+      (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)))))
+    (mm-mule-charset-to-mime-charset charset)))
+
+(defsubst mm-multibyte-p ()
+  "Say whether multibyte is enabled."
+  (and (boundp 'enable-multibyte-characters)
+       enable-multibyte-characters))
+
+(defmacro mm-with-unibyte-buffer (&rest forms)
+  "Create a temporary buffer, and evaluate FORMS there like `progn'.
+See also `with-temp-file' and `with-output-to-string'."
+  (let ((temp-buffer (make-symbol "temp-buffer"))
+       (multibyte (make-symbol "multibyte")))
+    `(if (not (boundp 'enable-multibyte-characters))
+        (with-temp-buffer ,@forms)
+       (let ((,multibyte (default-value 'enable-multibyte-characters))
+            ,temp-buffer)
+        (unwind-protect
+            (progn
+              (setq-default enable-multibyte-characters nil)
+              (setq ,temp-buffer
+                    (get-buffer-create (generate-new-buffer-name " *temp*")))
+              (unwind-protect
+                  (with-current-buffer ,temp-buffer
+                    (let ((buffer-file-coding-system 'binary))
+                      ,@forms))
+                (and (buffer-name ,temp-buffer)
+                     (kill-buffer ,temp-buffer))))
+          (setq-default enable-multibyte-characters ,multibyte))))))
+(put 'mm-with-unibyte-buffer 'lisp-indent-function 0)
+(put 'mm-with-unibyte-buffer 'edebug-form-spec '(body))
+
+(defun mm-find-charset-region (b e)
+  "Return a list of charsets in the region."
+  (cond
+   ((and (boundp 'enable-multibyte-characters)
+        enable-multibyte-characters)
+    (find-charset-region b e))
+   ((not (boundp 'current-language-environment))
+    (save-excursion
+      (save-restriction
+       (narrow-to-region b e)
+       (goto-char (point-min))
+       (skip-chars-forward "\0-\177")
+       (if (eobp)
+           '(ascii)
+         ;;;!!!bogus
+         (list 'ascii 'latin-iso8859-1)))))
+   (t
+    ;; We are in a unibyte buffer, so we futz around a bit.
+    (save-excursion
+      (save-restriction
+       (narrow-to-region b e)
+       (goto-char (point-min))
+       (let ((entry (assoc (capitalize current-language-environment)
+                           language-info-alist)))
+         (skip-chars-forward "\0-\177")
+         (if (eobp)
+             '(ascii)
+           (list 'ascii (car (last (assq 'charset entry)))))))))))

 
 (provide 'mm-util)
 
 
 (provide 'mm-util)