*** empty log message ***

[gnus] / lisp / mm-bodies.el

diff --git a/lisp/mm-bodies.el b/lisp/mm-bodies.el
index c77276c..c9b24b5 100644 (file)
--- a/lisp/mm-bodies.el
+++ b/lisp/mm-bodies.el
@@ -1,5 +1,5 @@
 ;;; mm-bodies.el --- Functions for decoding MIME things
 ;;; mm-bodies.el --- Functions for decoding 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,13 +26,18 @@
 
 (eval-and-compile
   (or (fboundp  'base64-decode-region)
 
 (eval-and-compile
   (or (fboundp  'base64-decode-region)

-      (require 'base64)))
+      (require 'base64))
+  (autoload 'binhex-decode-region "binhex"))

 
 (require 'mm-util)
 (require 'rfc2047)
 (require 'qp)
 (require 'uudecode)
 
 
 (require 'mm-util)
 (require 'rfc2047)
 (require 'qp)
 (require 'uudecode)
 

+;; 8bit treatment gets any char except: 0x32 - 0x7f, CR, LF, TAB, BEL,
+;; BS, vertical TAB, form feed, and ^_
+(defvar mm-8bit-char-regexp "[^\x20-\x7f\r\n\t\x7\x8\xb\xc\x1f]")
+

 (defun mm-encode-body ()
   "Encode a body.
 Should be called narrowed to the body that is to be encoded.
 (defun mm-encode-body ()
   "Encode a body.
 Should be called narrowed to the body that is to be encoded.


@@ -40,101 +45,143 @@ If there is more than one non-ASCII MULE charset, then list of found
 MULE charsets are returned.
 If successful, the MIME charset is returned.
 If no encoding was done, nil is returned."
 MULE charsets are returned.
 If successful, the MIME charset is returned.
 If no encoding was done, nil is returned."

-  (save-excursion
-    (goto-char (point-min))
-    (let ((charsets
-          (delq 'ascii (find-charset-region (point-min) (point-max))))
-         charset)
-      (cond
-       ;; No encoding.
-       ((null charsets)
-       nil)
-       ;; Too many charsets.
-       ((> (length charsets) 1)
-       charsets)
-       ;; We encode.
-       (t
-       (let ((mime-charset 
-              (mm-mime-charset (car charsets) (point-min) (point-max)))
-             start)
-         (when (or t
-                   ;; We always decode.
-                   (not (mm-coding-system-equal
-                         mime-charset buffer-file-coding-system)))
-           (while (not (eobp))
-             (if (eq (char-charset (following-char)) 'ascii)
-                 (when start
-                   (save-restriction
-                     (narrow-to-region start (point))
-                     (mm-encode-coding-region start (point) mime-charset)
-                     (goto-char (point-max)))
-                   (setq start nil))
-               (unless start
-                 (setq start (point))))
-             (forward-char 1))
-           (when start
-             (mm-encode-coding-region start (point) mime-charset)
-             (setq start nil)))
-         mime-charset))))))
+  (if (not (featurep 'mule))
+      ;; In the non-Mule case, we search for non-ASCII chars and
+      ;; return the value of `mm-default-charset' if any are found.
+      (save-excursion
+       (goto-char (point-min))
+       (if (re-search-forward "[^\x0-\x7f]" nil t)
+           (or mail-parse-charset
+               (mm-read-charset "Charset used in the article: "))
+         ;; The logic in `mml-generate-mime-1' confirms that it's OK
+         ;; to return nil here.
+         nil))
+    (save-excursion
+      (goto-char (point-min))
+      (let ((charsets
+            (delq 'ascii (mm-find-charset-region (point-min) (point-max))))
+           charset)
+       (cond
+        ;; No encoding.
+        ((null charsets)
+         nil)
+        ;; Too many charsets.
+        ((> (length charsets) 1)
+         charsets)
+        ;; We encode.
+        (t
+         (let ((mime-charset (mm-mime-charset (car charsets)))
+               start)
+           (when (or t
+                     ;; We always decode.
+                     (not (mm-coding-system-equal
+                           mime-charset buffer-file-coding-system)))
+             (while (not (eobp))
+               (if (eq (char-charset (char-after)) 'ascii)
+                   (when start
+                     (save-restriction
+                       (narrow-to-region start (point))
+                       (mm-encode-coding-region start (point) mime-charset)
+                       (goto-char (point-max)))
+                     (setq start nil))
+                 (unless start
+                   (setq start (point))))
+               (forward-char 1))
+             (when start
+               (mm-encode-coding-region start (point) mime-charset)
+               (setq start nil)))
+           mime-charset)))))))

 
 (defun mm-body-encoding ()
   "Return the encoding of the current buffer."
 
 (defun mm-body-encoding ()
   "Return the encoding of the current buffer."

-  (if (and  
-       (null (delq 'ascii (find-charset-region (point-min) (point-max))))
-       ;;;!!!The following is necessary because the function
-       ;;;!!!above seems to return the wrong result under Emacs 20.3.
-       ;;;!!!Sometimes.
-       (save-excursion
-        (goto-char (point-min))
-        (skip-chars-forward "\0-\177")
-        (eobp)))
-      '7bit
-    '8bit))
+  (cond
+   ((not (featurep 'mule))
+    (if (save-excursion
+         (goto-char (point-min))
+         (re-search-forward mm-8bit-char-regexp nil t))
+       '8bit
+      '7bit))
+   (t
+    ;; Mule version
+    (if (and (null (delq 'ascii
+                        (mm-find-charset-region (point-min) (point-max))))
+            ;;!!!The following is necessary because the function
+            ;;!!!above seems to return the wrong result under
+            ;;!!!Emacs 20.3.  Sometimes.
+            (save-excursion
+              (goto-char (point-min))
+              (skip-chars-forward "\0-\177")
+              (eobp)))
+       '7bit
+      '8bit))))

 
 ;;;
 ;;; Functions for decoding
 ;;;
 
 (defun mm-decode-content-transfer-encoding (encoding &optional type)
 
 ;;;
 ;;; Functions for decoding
 ;;;
 
 (defun mm-decode-content-transfer-encoding (encoding &optional type)

-  (cond
-   ((eq encoding 'quoted-printable)
-    (quoted-printable-decode-region (point-min) (point-max)))
-   ((eq encoding 'base64)
-    (prog1
-       (condition-case ()
-           (base64-decode-region (point-min) (point-max))
-         (error nil))
-      (when (equal type "text/plain")
-       (goto-char (point-min))
-       (while (search-forward "\r\n" nil t)
-         (replace-match "\n" t t)))))
-   ((memq encoding '(7bit 8bit binary))
-    )
-   ((null encoding)
-    )
-   ((eq encoding 'x-uuencode)
-    (condition-case ()
-       (uudecode-decode-region (point-min) (point-max))
-      (error nil)))
-   (t
-    (error "Can't decode encoding %s" encoding))))
+  (prog1
+      (condition-case error
+         (cond
+          ((eq encoding 'quoted-printable)
+           (quoted-printable-decode-region (point-min) (point-max)))
+          ((eq encoding 'base64)
+           (base64-decode-region (point-min) (point-max)))
+          ((memq encoding '(7bit 8bit binary))
+           )
+          ((null encoding)
+           )
+          ((eq encoding 'x-uuencode)
+           (funcall mm-uu-decode-function (point-min) (point-max)))
+          ((eq encoding 'x-binhex)
+           (funcall mm-uu-binhex-decode-function (point-min) (point-max)))
+          ((functionp encoding)
+           (funcall encoding (point-min) (point-max)))
+          (t
+           (message "Unknown encoding %s; defaulting to 8bit" encoding)))
+       (error
+        (message "Error while decoding: %s" error)
+        nil))
+    (when (and
+          (memq encoding '(base64 x-uuencode x-binhex))
+          (equal type "text/plain"))
+      (goto-char (point-min))
+      (while (search-forward "\r\n" nil t)
+       (replace-match "\n" t t)))))

 
 

-(defun mm-decode-body (charset &optional encoding)
+(defun mm-decode-body (charset &optional encoding type)

   "Decode the current article that has been encoded with ENCODING.
 The characters in CHARSET should then be decoded."
   "Decode the current article that has been encoded with ENCODING.
 The characters in CHARSET should then be decoded."

-  (setq charset (or charset rfc2047-default-charset))
+  (setq charset (or charset mail-parse-charset))

   (save-excursion
     (when encoding
   (save-excursion
     (when encoding

-      (mm-decode-content-transfer-encoding encoding))
+      (mm-decode-content-transfer-encoding encoding type))

     (when (featurep 'mule)
       (let (mule-charset)
        (when (and charset
                   (setq mule-charset (mm-charset-to-coding-system charset))
     (when (featurep 'mule)
       (let (mule-charset)
        (when (and charset
                   (setq mule-charset (mm-charset-to-coding-system charset))

-                  buffer-file-coding-system
+                  ;; buffer-file-coding-system
+                                       ;Article buffer is nil coding system
+                                       ;in XEmacs
+                  enable-multibyte-characters

                   (or (not (eq mule-charset 'ascii))
                   (or (not (eq mule-charset 'ascii))

-                      (setq mule-charset rfc2047-default-charset)))
+                      (setq mule-charset mail-parse-charset)))

          (mm-decode-coding-region (point-min) (point-max) mule-charset))))))
 
          (mm-decode-coding-region (point-min) (point-max) mule-charset))))))
 

+(defun mm-decode-string (string charset)
+  "Decode STRING with CHARSET."
+  (setq charset (or charset mail-parse-charset))
+  (or
+   (when (featurep 'mule)
+     (let (mule-charset)
+       (when (and charset
+                 (setq mule-charset (mm-charset-to-coding-system charset))
+                 enable-multibyte-characters
+                 (or (not (eq mule-charset 'ascii))
+                     (setq mule-charset mail-parse-charset)))
+        (mm-decode-coding-string string mule-charset))))
+   string))
+

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