*** empty log message ***
[gnus] / lisp / mm-bodies.el
index 54594cf..c9b24b5 100644 (file)
@@ -1,5 +1,5 @@
 ;;; 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>
 
 ;;; Code:
 
+(eval-and-compile
+  (or (fboundp  'base64-decode-region)
+      (require 'base64))
+  (autoload 'binhex-decode-region "binhex"))
+
 (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.
@@ -33,50 +45,142 @@ 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."
-  (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-mule-charset-to-mime-charset (car charsets)))
-             start)
-         (when (not (mm-coding-system-equal
-                     mime-charset buffer-file-coding-system))
-           (while (not (eobp))
-             (if (eq (char-charset (following-char)) 'ascii)
-                 (when start
-                   (mm-encode-coding-region start (point) mime-charset)
-                   (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."
-  (if (null (delq 'ascii (find-charset-region (point-min) (point-max))))
-      '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-body (charset)
+(defun mm-decode-content-transfer-encoding (encoding &optional type)
+  (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 type)
+  "Decode the current article that has been encoded with ENCODING.
+The characters in CHARSET should then be decoded."
+  (setq charset (or charset mail-parse-charset))
   (save-excursion
-    (mm-decode-coding-region (point-min) (point-max) charset)))
+    (when 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))
+                  ;; buffer-file-coding-system
+                                       ;Article buffer is nil coding system
+                                       ;in XEmacs
+                  enable-multibyte-characters
+                  (or (not (eq mule-charset 'ascii))
+                      (setq mule-charset mail-parse-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)