From: yamaoka <yamaoka>
Date: Tue, 7 Nov 2000 22:22:50 +0000 (+0000)
Subject: Synch with Gnus.
X-Git-Tag: t-gnus-6_14-quimby-before-installer-changed-~2
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=9c2c16020432e48be5ed5a551fa556379af46f37;p=elisp%2Fgnus.git-

Synch with Gnus.
---

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index a92b3bf..ff59a59 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,17 @@
+2000-11-07 14:33:19  ShengHuo ZHU  <zsh@cs.rochester.edu>
+
+	* gnus-art.el (gnus-mime-display-part): Show MIME security button.
+	(gnus-insert-mime-security-button): New function.
+	* mm-decode.el (mm-possibly-verify-or-decrypt): Add security info.
+	* mml2015.el:  Add security info when verify or decrypt.
+	* mm-uu.el (mm-uu-pgp-signed-extract): Use multipart.
+	(mm-uu-pgp-encrypted-extract): Ditto.
+
+2000-11-07 08:49:36  ShengHuo ZHU  <zsh@cs.rochester.edu>
+
+	* mm-decode.el (mm-display-parts): New function.
+	* gnus-art.el (gnus-mime-view-all-parts): Use it. Remove parts first.
+
 2000-02-02 Alexandre Oliva <oliva@lsd.ic.unicamp.br>
 
 	* gnus-mlspl.el: Documentation tweaks.
diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el
index 84fa1bd..acf82c9 100644
--- a/lisp/gnus-art.el
+++ b/lisp/gnus-art.el
@@ -3352,11 +3352,14 @@ value of the variable `gnus-show-mime' is non-nil."
     (let ((handles (or handles gnus-article-mime-handles))
 	  (mail-parse-charset gnus-newsgroup-charset)
 	  (mail-parse-ignored-charsets 
-	   (save-excursion (set-buffer gnus-summary-buffer)
-			   gnus-newsgroup-ignored-charsets)))
-      (if (stringp (car handles))
-	  (gnus-mime-view-all-parts (cdr handles))
-	(mapcar 'mm-display-part handles)))))
+	   (with-current-buffer gnus-summary-buffer
+	     gnus-newsgroup-ignored-charsets)))
+      (mm-remove-parts handles)
+      (goto-char (point-min))
+      (or (search-forward "\n\n") (goto-char (point-max)))
+      (let (buffer-read-only)
+	(delete-region (point) (point-max)))
+      (mm-display-parts handles))))
 
 (defun gnus-mime-save-part-and-strip ()
   "Save the MIME part under point then replace it with an external body."
@@ -3857,10 +3860,12 @@ In no internal viewer is available, use an external viewer."
    ((equal (car handle) "multipart/signed")
     (or (memq 'signed gnus-article-wash-types)
 	(push 'signed gnus-article-wash-types))
+    (gnus-insert-mime-security-button handle)
     (gnus-mime-display-mixed (cdr handle)))
    ((equal (car handle) "multipart/encrypted")
     (or (memq 'encrypted gnus-article-wash-types)
 	(push 'encrypted gnus-article-wash-types))
+    (gnus-insert-mime-security-button handle)
     (gnus-mime-display-mixed (cdr handle)))
    (t
     (gnus-mime-display-mixed (cdr handle)))))
@@ -5529,6 +5534,79 @@ For example:
 	    (gnus-cache-update-article
 	     (car gnus-article-current) (cdr gnus-article-current))))))))
 
+(defvar gnus-mime-security-button-line-format "%{%([[%t:%i]]%)%}\n"
+  "The following specs can be used:
+%t  The security MIME type
+%i  Additional info")
+
+(defvar gnus-mime-security-button-line-format-alist
+  '((?t gnus-tmp-type ?s)
+    (?i gnus-tmp-info ?s)))
+
+(defvar gnus-mime-security-button-map
+  (let ((map (make-sparse-keymap)))
+    (set-keymap-parent map gnus-article-mode-map)
+    (define-key map gnus-mouse-2 'gnus-article-push-button)
+    (define-key map "\r" 'gnus-article-press-button)
+    map))
+
+(defvar gnus-mime-security-details-buffer nil)
+
+(defun gnus-mime-security-show-details (handle)
+  (let ((details (mm-handle-multipart-ctl-parameter handle 'gnus-details)))
+    (if details
+	(progn
+	  (if (gnus-buffer-live-p gnus-mime-security-details-buffer)
+	      (with-current-buffer gnus-mime-security-details-buffer
+		(erase-buffer)
+		t)
+	    (setq gnus-mime-security-details-buffer
+		  (gnus-get-buffer-create "*MIME Security Details*")))
+	  (with-current-buffer gnus-mime-security-details-buffer
+	    (insert details))
+	  (pop-to-buffer gnus-mime-security-details-buffer))
+      (gnus-message 5 "No details."))))
+
+(defun gnus-insert-mime-security-button (handle &optional displayed)
+  (let* ((protocol (mm-handle-multipart-ctl-parameter handle 'protocol))
+	 (gnus-tmp-type
+	  (concat 
+	   (or (nth 2 (assoc protocol mm-verify-function-alist))
+	       (nth 2 (assoc protocol mm-decrypt-function-alist))
+	       "Unknown")
+	   (if (equal (car handle) "multipart/signed")
+	       " Signed" " Encrypted")))
+	 (gnus-tmp-info
+	  (or (mm-handle-multipart-ctl-parameter handle 'gnus-info)
+	      "Undecided"))
+	 b e)
+    (unless (bolp)
+      (insert "\n"))
+    (setq b (point))
+    (gnus-eval-format
+     gnus-mime-security-button-line-format 
+     gnus-mime-security-button-line-format-alist
+     `(local-map ,gnus-mime-security-button-map
+		 keymap ,gnus-mime-security-button-map
+		 gnus-callback gnus-mime-security-show-details
+		 article-type annotation
+		 gnus-data ,handle))
+    (setq e (point))
+    (widget-convert-button
+     'link b e
+     :mime-handle handle
+     :action 'gnus-widget-press-button
+     :button-keymap gnus-mime-security-button-map
+     :help-echo
+     (lambda (widget/window &optional overlay pos)
+       ;; Needed to properly clear the message due to a bug in
+       ;; wid-edit (XEmacs only).
+       (if (boundp 'help-echo-owns-message)
+	   (setq help-echo-owns-message t))
+       (format
+	"%S: show detail"
+	(aref gnus-mouse-2 0))))))
+
 
 ;;; @ for mime-view
 ;;;
diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el
index 344d05e..d2f9257 100644
--- a/lisp/mm-decode.el
+++ b/lisp/mm-decode.el
@@ -418,6 +418,16 @@ The original alist is not modified.  See also `destructive-alist-to-plist'."
       (insert-buffer-substring obuf beg)
       (current-buffer))))
 
+(defun mm-display-parts (handle &optional no-default)
+  (if (stringp (car handle))
+      (mapcar 'mm-display-parts (cdr handle))
+    (if (bufferp (car handle))
+	(save-restriction
+	  (narrow-to-region (point) (point))
+	  (mm-display-part handle)
+	  (goto-char (point-max)))
+      (mapcar 'mm-display-parts handle))))
+
 (defun mm-display-part (handle &optional no-default)
   "Display the MIME part represented by HANDLE.
 Returns nil if the part is removed; inline if displayed inline;
@@ -984,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")
@@ -1014,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.
@@ -1046,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))
 
diff --git a/lisp/mm-uu.el b/lisp/mm-uu.el
index 47aa032..46fc4f1 100644
--- a/lisp/mm-uu.el
+++ b/lisp/mm-uu.el
@@ -257,23 +257,22 @@ To disable dissecting shar codes, for instance, add
     (t (y-or-n-p "Verify pgp signed part?")))))
 
 (defun mm-uu-pgp-signed-extract ()
-  (or (memq 'signed gnus-article-wash-types)
-      (push 'signed gnus-article-wash-types))
-  (let ((buf (mm-uu-copy-to-buffer start-point end-point)))
+  (let ((buf (mm-uu-copy-to-buffer start-point end-point))
+	(mm-security-handle (list (format "multipart/signed"))))
+    (mm-set-handle-multipart-parameter 
+     mm-security-handle 'protocol "application/pgp-signature")
     (with-current-buffer buf
-      (condition-case err
-	  (funcall (mml2015-clear-verify-function))
-	(error
-	 (unless (y-or-n-p (format "%s, continue?" err))
-	   (kill-buffer buf)
-	   (error "Verify failure."))))
+      (funcall (mml2015-clear-verify-function))
       (goto-char (point-min))
       (if (search-forward "\n\n" nil t)
 	  (delete-region (point-min) (point)))
       (if (re-search-forward mm-uu-pgp-beginning-signature nil t)
 	  (delete-region (match-beginning 0) (point-max))))
-    (mm-make-handle buf
-		    '("text/plain"  (charset . gnus-decoded)))))
+    (setcdr mm-security-handle
+	    (list
+	     (mm-make-handle buf
+			     '("text/plain"  (charset . gnus-decoded)))))
+    mm-security-handle))
 
 (defun mm-uu-pgp-encrypted-test ()
   (and
@@ -286,18 +285,17 @@ To disable dissecting shar codes, for instance, add
     (t (y-or-n-p "Decrypt pgp encrypted part?")))))
 
 (defun mm-uu-pgp-encrypted-extract ()
-  (or (memq 'encrypted gnus-article-wash-types)
-      (push 'encrypted gnus-article-wash-types))
-  (let ((buf (mm-uu-copy-to-buffer start-point end-point)))
+  (let ((buf (mm-uu-copy-to-buffer start-point end-point))
+	(mm-security-handle (list (format "multipart/encrypted"))))
+    (mm-set-handle-multipart-parameter 
+     mm-security-handle 'protocol "application/pgp-encrypted")
     (with-current-buffer buf
-      (condition-case err
-	  (funcall (mml2015-clear-decrypt-function))
-	(error
-	 (unless (y-or-n-p (format "%s, continue?" err))
-	   (kill-buffer buf)
-	   (error "Decrypt failure.")))))
-    (mm-make-handle buf
-		    '("text/plain"  (charset . gnus-decoded)))))
+      (funcall (mml2015-clear-decrypt-function)))
+    (setcdr mm-security-handle
+	    (list
+	     (mm-make-handle buf
+			     '("text/plain"  (charset . gnus-decoded)))))
+    mm-security-handle))
 
 (defun mm-uu-gpg-key-skip-to-last ()
   (let ((point (point))
diff --git a/lisp/mml2015.el b/lisp/mml2015.el
index dfd62be..973d50f 100644
--- a/lisp/mml2015.el
+++ b/lisp/mml2015.el
@@ -77,27 +77,49 @@
 (defvar mml2015-verify-function 'mailcrypt-verify)
 
 (defun mml2015-mailcrypt-decrypt (handle ctl)
-  (let (child handles result)
-    (unless (setq child (mm-find-part-by-type 
-			 (cdr handle) 
-			 "application/octet-stream" nil t))
-      (error "Corrupted pgp-encrypted part."))
-    (with-temp-buffer
-      (mm-insert-part child)
-      (setq result (funcall mml2015-decrypt-function))
-      (unless (car result)
-	(error "Decrypting error."))
-      (setq handles (mm-dissect-buffer t)))
-    (mm-destroy-parts handle)
-    (if (listp (car handles))
-	handles
-      (list handles))))
+  (catch 'error
+    (let (child handles result)
+      (unless (setq child (mm-find-part-by-type 
+			   (cdr handle) 
+			   "application/octet-stream" nil t))
+	(mm-set-handle-multipart-parameter 
+	 mm-security-handle 'gnus-info "Corrupted")
+	(throw 'error handle))
+      (with-temp-buffer
+	(mm-insert-part child)
+	(setq result 
+	      (condition-case err
+		  (funcall mml2015-decrypt-function)
+		(error 
+		 (mm-set-handle-multipart-parameter 
+		  mm-security-handle 'gnus-details (cadr err)) 
+		 nil)))
+	(unless (car result)
+	  (mm-set-handle-multipart-parameter 
+	   mm-security-handle 'gnus-info "Failed")
+	  (throw 'error handle))
+	(setq handles (mm-dissect-buffer t)))
+      (mm-destroy-parts handle)
+      (mm-set-handle-multipart-parameter 
+       mm-security-handle 'gnus-info "OK")
+      (if (listp (car handles))
+	  handles
+	(list handles)))))
 
 (defun mml2015-mailcrypt-clear-decrypt ()
   (let (result)
-    (setq result (funcall mml2015-decrypt-function))
-    (unless (car result)
-      (error "Decrypting error."))))
+    (setq result 
+	  (condition-case err
+	      (funcall mml2015-decrypt-function)
+	    (error 
+	     (mm-set-handle-multipart-parameter 
+	      mm-security-handle 'gnus-details (cadr err)) 
+	     nil)))
+    (if (car result)
+	(mm-set-handle-multipart-parameter 
+	 mm-security-handle 'gnus-info "OK")
+      (mm-set-handle-multipart-parameter 
+       mm-security-handle 'gnus-info "Failed"))))
 
 (defun mml2015-fix-micalg (alg)
   (upcase
@@ -106,31 +128,53 @@
      alg)))
 
 (defun mml2015-mailcrypt-verify (handle ctl)
-  (let (part)
-    (unless (setq part (mm-find-raw-part-by-type 
-			 ctl (or (mail-content-type-get ctl 'protocol)
-				 "application/pgp-signature")
-			 t))
-      (error "Corrupted pgp-signature part."))
-    (with-temp-buffer
-      (insert "-----BEGIN PGP SIGNED MESSAGE-----\n")
-      (insert (format "Hash: %s\n\n" 
-		      (or (mml2015-fix-micalg
-			   (mail-content-type-get ctl 'micalg))
-			  "SHA1")))
-      (insert part "\n")
-      (goto-char (point-max))
-      (unless (setq part (mm-find-part-by-type 
-			   (cdr handle) "application/pgp-signature" nil t))
-	(error "Corrupted pgp-signature part."))
-      (mm-insert-part part)
-      (unless (funcall mml2015-verify-function)
-	(error "Verify error.")))
-    handle))
+  (catch 'error
+    (let (part)
+      (unless (setq part (mm-find-raw-part-by-type 
+			  ctl (or (mail-content-type-get ctl 'protocol)
+				  "application/pgp-signature")
+			  t))
+	(mm-set-handle-multipart-parameter 
+	 mm-security-handle 'gnus-info "Corrupted")
+	(throw 'error handle))
+      (with-temp-buffer
+	(insert "-----BEGIN PGP SIGNED MESSAGE-----\n")
+	(insert (format "Hash: %s\n\n" 
+			(or (mml2015-fix-micalg
+			     (mail-content-type-get ctl 'micalg))
+			    "SHA1")))
+	(insert part "\n")
+	(goto-char (point-max))
+	(unless (setq part (mm-find-part-by-type 
+			    (cdr handle) "application/pgp-signature" nil t))
+	  (mm-set-handle-multipart-parameter 
+	   mm-security-handle 'gnus-info "Corrupted")
+	  (throw 'error handle))
+	(mm-insert-part part)
+	(unless (condition-case err
+		    (funcall mml2015-verify-function)
+		  (error 
+		   (mm-set-handle-multipart-parameter 
+		    mm-security-handle 'gnus-details (cadr err)) 
+		   nil))
+	  (mm-set-handle-multipart-parameter 
+	   mm-security-handle 'gnus-info "Failed")
+	  (throw 'error handle)))
+      (mm-set-handle-multipart-parameter 
+       mm-security-handle 'gnus-info "OK")
+      handle)))
 
 (defun mml2015-mailcrypt-clear-verify ()
-  (unless (funcall mml2015-verify-function)
-    (error "Verify error.")))
+  (if (condition-case err
+	  (funcall mml2015-verify-function)
+	(error 
+	 (mm-set-handle-multipart-parameter 
+	  mm-security-handle 'gnus-details (cadr err)) 
+	 nil))
+      (mm-set-handle-multipart-parameter 
+       mm-security-handle 'gnus-info "OK")
+    (mm-set-handle-multipart-parameter 
+     mm-security-handle 'gnus-info "Failed")))
 
 (defun mml2015-mailcrypt-sign (cont)
   (mc-sign-generic (message-options-get 'message-sender)
@@ -227,7 +271,9 @@
       ;; Some wrong with the return value, check plain text buffer.
       (if (> (point-max) (point-min))
 	  '(t)
-	(pop-to-buffer mml2015-result-buffer)
+	(mm-set-handle-multipart-parameter 
+	 mm-security-handle 'gnus-details 
+	 (buffer-string mml2015-result-buffer))
 	nil))))
 
 (defun mml2015-gpg-decrypt (handle ctl)
@@ -237,29 +283,41 @@
 (defun mml2015-gpg-clear-decrypt ()
   (let (result)
     (setq result (mml2015-gpg-decrypt-1))
-    (unless (car result)
-      (error "Decrypting error."))))
+    (if (car result)
+	(mm-set-handle-multipart-parameter 
+	 mm-security-handle 'gnus-info "OK")
+      (mm-set-handle-multipart-parameter 
+       mm-security-handle 'gnus-info "Failed"))))
 
 (defun mml2015-gpg-verify (handle ctl)
-  (let (part message signature)
-    (unless (setq part (mm-find-raw-part-by-type 
-			 ctl (or (mail-content-type-get ctl 'protocol)
-				 "application/pgp-signature")
-			 t))
-      (error "Corrupted pgp-signature part."))
-    (with-temp-buffer
-      (setq message (current-buffer))
-      (insert part)
+  (catch 'error
+    (let (part message signature)
+      (unless (setq part (mm-find-raw-part-by-type 
+			  ctl (or (mail-content-type-get ctl 'protocol)
+				  "application/pgp-signature")
+			  t))
+	(mm-set-handle-multipart-parameter 
+	 mm-security-handle 'gnus-info "Corrupted")
+	(throw 'error handle))
       (with-temp-buffer
-	(setq signature (current-buffer))
-	(unless (setq part (mm-find-part-by-type 
-			    (cdr handle) "application/pgp-signature" nil t))
-	  (error "Corrupted pgp-signature part."))
-	(mm-insert-part part)
-	(unless (gpg-verify message signature mml2015-result-buffer)
-	  (pop-to-buffer mml2015-result-buffer)
-	  (error "Verify error.")))))
-  handle)
+	(setq message (current-buffer))
+	(insert part)
+	(with-temp-buffer
+	  (setq signature (current-buffer))
+	  (unless (setq part (mm-find-part-by-type 
+			      (cdr handle) "application/pgp-signature" nil t))
+	    (mm-set-handle-multipart-parameter 
+	     mm-security-handle 'gnus-info "Corrupted")
+	    (throw 'error handle))
+	  (mm-insert-part part)
+	  (unless (gpg-verify message signature mml2015-result-buffer)
+	    (mm-set-handle-multipart-parameter 
+	     mm-security-handle 'gnus-details 
+	     (buffer-string mml2015-result-buffer))
+	    (mm-set-handle-multipart-parameter 
+	     mm-security-handle 'gnus-info "Failed")
+	    (throw 'error handle))))
+      handle)))
 
 (defun mml2015-gpg-sign (cont)
   (let ((boundary 
diff --git a/texi/ChangeLog b/texi/ChangeLog
index a2205a8..bdfdd34 100644
--- a/texi/ChangeLog
+++ b/texi/ChangeLog
@@ -1,3 +1,7 @@
+2000-11-07  Martin Buchholz <martin@xemacs.org>
+
+	* gnus.texi: Doc fix.
+
 2000-11-01  Kai Gro,A_(Bjohann  <Kai.Grossjohann@CS.Uni-Dortmund.DE>
 
 	* gnus.texi (Fancy Mail Splitting): Explain
diff --git a/texi/gnus.texi b/texi/gnus.texi
index 37c1fcd..32e438a 100644
--- a/texi/gnus.texi
+++ b/texi/gnus.texi
@@ -14451,7 +14451,7 @@ predicates an additional score rule is superfluous.
 
 Predicates of @code{high} or @code{low} download articles in respect of
 their scores in relationship to @code{gnus-agent-high-score} and
-@code{gnus-agent-low-score} as descibed below.
+@code{gnus-agent-low-score} as described below.
 
 To gain even finer control of what is to be regarded eligible for
 download a predicate can consist of a number of predicates with logical