* gnus-sum.el (gnus-summary-expire-articles): Save excursion.

[gnus] / lisp / mm-decode.el

diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el
index 55b9f8a..786a3be 100644 (file)
--- a/lisp/mm-decode.el
+++ b/lisp/mm-decode.el
@@ -31,11 +31,13 @@
 
 (eval-and-compile
   (autoload 'mm-inline-partial "mm-partial")
-  (autoload 'mm-inline-external-body "mm-extern"))
+  (autoload 'mm-inline-external-body "mm-extern")
+  (autoload 'mm-insert-inline "mm-view"))
 
 (defgroup mime-display ()
   "Display of MIME in mail and news articles."
   :link '(custom-manual "(emacs-mime)Customization")
+  :version "21.1"
   :group 'mail
   :group 'news
   :group 'multimedia)
@@ -243,12 +245,14 @@ to:
 
 (defvar mm-verify-function-alist
   '(("application/pgp-signature" mml2015-verify "PGP" mml2015-verify-test)
+    ("application/x-gnus-pgp-signature" mm-uu-pgp-signed-extract-1 "PGP" 
+     mm-uu-pgp-signed-test)
     ("application/pkcs7-signature" mml-smime-verify "S/MIME" 
      mml-smime-verify-test)
     ("application/x-pkcs7-signature" mml-smime-verify "S/MIME" 
      mml-smime-verify-test)))
 
-(defcustom mm-verify-option nil
+(defcustom mm-verify-option 'never
   "Option of verifying signed parts.
 `never', not verify; `always', always verify; 
 `known', only verify known protocols. Otherwise, ask user."
@@ -262,10 +266,12 @@ to:
 (autoload 'mml2015-decrypt-test "mml2015")
 
 (defvar mm-decrypt-function-alist
-  '(("application/pgp-encrypted" mml2015-decrypt "PGP" mml2015-decrypt-test)))
+  '(("application/pgp-encrypted" mml2015-decrypt "PGP" mml2015-decrypt-test)
+    ("application/x-gnus-pgp-encrypted" mm-uu-pgp-encrypted-extract-1 "PGP" 
+     mm-uu-pgp-encrypted-test)))
 
 (defcustom mm-decrypt-option nil
-  "Option of decrypting signed parts.
+  "Option of decrypting encrypted parts.
 `never', not decrypt; `always', always decrypt; 
 `known', only decrypt known protocols. Otherwise, ask user."
   :type '(choice (item always)
@@ -283,6 +289,15 @@ to:
 ;; Should we bind other key to minibuffer-complete-word?
 (define-key mm-viewer-completion-map " " 'self-insert-command) 
 
+(defvar mm-viewer-completion-map
+  (let ((map (make-sparse-keymap 'mm-viewer-completion-map)))
+    (set-keymap-parent map minibuffer-local-completion-map)
+    map)
+  "Keymap for input viewer with completion.")
+
+;; Should we bind other key to minibuffer-complete-word?
+(define-key mm-viewer-completion-map " " 'self-insert-command) 
+
 ;;; The functions.
 
 (defun mm-alist-to-plist (alist)
@@ -393,7 +408,7 @@ The original alist is not modified.  See also `destructive-alist-to-plist'."
                    (match-beginning 0)
                  (point-max)))))
     (setq boundary (concat (regexp-quote boundary) "[ \t]*$"))
-    (while (re-search-forward boundary end t)
+    (while (and (< (point) end) (re-search-forward boundary end t))
       (goto-char (match-beginning 0))
       (when start
        (save-excursion
@@ -402,7 +417,7 @@ The original alist is not modified.  See also `destructive-alist-to-plist'."
            (setq parts (nconc (list (mm-dissect-buffer t)) parts)))))
       (forward-line 2)
       (setq start (point)))
-    (when start
+    (when (and start (< start end))
       (save-excursion
        (save-restriction
          (narrow-to-region start end)
@@ -614,7 +629,7 @@ external if displayed external."
            (kill-buffer (get-text-property 0 'buffer handle))))
         ((and (listp handle)
               (stringp (car handle)))
-         (mm-destroy-parts (cdr handle)))
+         (mm-destroy-parts handle))
         (t
          (mm-destroy-part handle)))))))
 
@@ -740,7 +755,12 @@ external if displayed external."
 (defun mm-get-part (handle)
   "Return the contents of HANDLE as a string."
   (mm-with-unibyte-buffer
-    (mm-insert-part handle)
+    (insert (with-current-buffer (mm-handle-buffer handle)
+             (mm-with-unibyte-current-buffer-mule4
+               (buffer-string))))
+    (mm-decode-content-transfer-encoding
+     (mm-handle-encoding handle)
+     (mm-handle-media-type handle))
     (buffer-string)))
 
 (defun mm-insert-part (handle)
@@ -958,8 +978,9 @@ If RECURSIVE, search recursively."
 
 (defun mm-find-raw-part-by-type (ctl type &optional notp) 
   (goto-char (point-min))
-  (let* ((boundary (concat "\n--" (mail-content-type-get ctl 'boundary)))
-        (close-delimiter (concat (regexp-quote boundary) "--[ \t]*$"))
+  (let* ((boundary (concat "--" (mm-handle-multipart-ctl-parameter ctl 
+                                                                  'boundary)))
+        (close-delimiter (concat "^" (regexp-quote boundary) "--[ \t]*$"))
         start
         (end (save-excursion
                (goto-char (point-max))
@@ -967,14 +988,14 @@ If RECURSIVE, search recursively."
                    (match-beginning 0)
                  (point-max))))
         result)
-    (setq boundary (concat (regexp-quote boundary) "[ \t]*$"))
+    (setq boundary (concat "^" (regexp-quote boundary) "[ \t]*$"))
     (while (and (not result)
                (re-search-forward boundary end t))
       (goto-char (match-beginning 0))
       (when start
        (save-excursion
          (save-restriction
-           (narrow-to-region start (point))
+           (narrow-to-region start (1- (point)))
            (when (let ((ctl (ignore-errors 
                               (mail-header-parse-content-type 
                                (mail-fetch-field "content-type")))))
@@ -982,7 +1003,7 @@ If RECURSIVE, search recursively."
                        (not (equal (car ctl) type))
                      (equal (car ctl) type)))
              (setq result (buffer-substring (point-min) (point-max)))))))
-      (forward-line 2)
+      (forward-line 1)
       (setq start (point)))
     (when (and (not result) start)
       (save-excursion
@@ -998,6 +1019,7 @@ If RECURSIVE, search recursively."
     result))
 
 (defvar mm-security-handle nil)
+(defvar mm-security-from nil)
 
 (defsubst mm-set-handle-multipart-parameter (handle parameter value)
   ;; HANDLE could be a CTL.
@@ -1008,10 +1030,16 @@ If RECURSIVE, search recursively."
 (defun mm-possibly-verify-or-decrypt (parts ctl)
   (let ((subtype (cadr (split-string (car ctl) "/")))
        (mm-security-handle ctl) ;; (car CTL) is the type.
+       (mm-security-from
+        (save-restriction
+          (mail-narrow-to-head)
+          (cadr (mail-extract-address-components 
+                 (or (mail-fetch-field "from") "")))))
        protocol func functest)
     (cond 
      ((equal subtype "signed")
-      (unless (and (setq protocol (mail-content-type-get ctl 'protocol))
+      (unless (and (setq protocol 
+                        (mm-handle-multipart-ctl-parameter ctl 'protocol))
                   (not (equal protocol "multipart/mixed")))
        ;; The message is broken or draft-ietf-openpgp-multsig-01.
        (let ((protocols mm-verify-function-alist))
@@ -1043,7 +1071,8 @@ If RECURSIVE, search recursively."
               mm-security-handle 'gnus-details 
               (format "Unknown sign protocol (%s)" protocol))))))
      ((equal subtype "encrypted")
-      (unless (setq protocol (mail-content-type-get ctl 'protocol))
+      (unless (setq protocol 
+                   (mm-handle-multipart-ctl-parameter ctl 'protocol))
        ;; The message is broken.
        (let ((parts parts))
          (while parts