Add MIME security button.
[gnus] / lisp / mm-decode.el
index b0ff1d8..9f3e4fc 100644 (file)
@@ -994,8 +994,17 @@ If RECURSIVE, search recursively."
            (setq result (buffer-substring (point-min) (point-max)))))))
     result))
 
+(defvar mm-security-handle nil)
+
+(defsubst mm-set-handle-multipart-parameter (handle parameter value)
+  ;; HANDLE could be a CTL.
+  (if handle
+      (put-text-property 0 (length (car handle)) parameter value 
+                        (car handle))))
+
 (defun mm-possibly-verify-or-decrypt (parts ctl)
   (let ((subtype (cadr (split-string (car ctl) "/")))
+       (mm-security-handle ctl) ;; (car CTL) is the type.
        protocol func functest)
     (cond 
      ((equal subtype "signed")
@@ -1024,14 +1033,12 @@ If RECURSIVE, search recursively."
               (format "Verify signed (%s) part? "
                       (or (nth 2 (assoc protocol mm-verify-function-alist))
                           (format "protocol=%s" protocol))))))
-         (condition-case err
-             (save-excursion
-               (if func
-                   (funcall func parts ctl)
-                 (error (format "Unknown sign protocol (%s)" protocol))))
-           (error
-            (unless (y-or-n-p (format "%s, continue? " err))
-              (error "Verify failure."))))))
+         (save-excursion
+           (if func
+               (funcall func parts ctl)
+             (mm-set-handle-multipart-parameter 
+              mm-security-handle 'gnus-details 
+              (format "Unknown sign protocol (%s)" protocol))))))
      ((equal subtype "encrypted")
       (unless (setq protocol (mail-content-type-get ctl 'protocol))
        ;; The message is broken.
@@ -1056,14 +1063,12 @@ If RECURSIVE, search recursively."
               (format "Decrypt (%s) part? "
                       (or (nth 2 (assoc protocol mm-decrypt-function-alist))
                           (format "protocol=%s" protocol))))))
-         (condition-case err
-             (save-excursion
-               (if func
-                   (setq parts (funcall func parts ctl))
-                 (error (format "Unknown encrypt protocol (%s)" protocol))))
-           (error
-            (unless (y-or-n-p (format "%s, continue? " err))
-              (error "Decrypt failure."))))))
+         (save-excursion
+           (if func
+               (setq parts (funcall func parts ctl))
+             (mm-set-handle-multipart-parameter 
+              mm-security-handle 'gnus-details 
+              (format "Unknown encrypt protocol (%s)" protocol))))))
      (t nil))
     parts))