Merge from gnus--devo--0

Revision: emacs@sv.gnu.org/emacs--devo--0--patch-955

7 files changed, 180 insertions, 86 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index fffb1e03f60..fb82a128413 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -18,6 +18,10 @@
 	* calc/calc.el (calc-set-mode-line): Use `math-lang-name'
 	to set language name.
 
+2007-12-10  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+	* pgg.el (pgg-run-at-time, pgg-cancel-timer): Use eval-and-compile.
+
 2007-12-10  Stefan Monnier  <monnier@iro.umontreal.ca>
 
 	* server.el (server-select-display): Fix important typo.
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index cda28979cb1..d8bb4876269 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,38 @@
+2007-12-15  Reiner Steib  <Reiner.Steib@gmx.de>
+
+	* gnus-art.el (article-verify-x-pgp-sig): Add reference to X-PGP-Sig
+	format document.
+	(gnus-mime-delete-part): Don't write description line if empty.
+	(gnus-article-encrypt-body): Add confirmation for gnus-novice-user.
+
+2007-12-14  Johan Bockg,Ae(Brd  <bojohan@gnu.org>
+
+	* gnus-sum.el (gnus-summary-mark-unread-as-read)
+	(gnus-summary-mark-read-and-unread-as-read)
+	(gnus-summary-mark-current-read-and-unread-as-read)
+	(gnus-summary-mark-unread-as-ticked): Doc fix.
+	`gnus-mark-article-hook', not `gnus-summary-mark-article-hook'.
+
+2007-12-14  Reiner Steib  <Reiner.Steib@gmx.de>
+
+	* gnus-sum.el (gnus-summary-prev-article): Fix doc string.  Reported by
+	Christoph Conrad <christoph.conrad@gmx.de>.
+
+2007-12-14  Reiner Steib  <Reiner.Steib@gmx.de>
+
+	* gnus-util.el (gnus-y-or-n-p, gnus-yes-or-no-p): Alias to y-or-n-p and
+	yes-or-no-p.
+
+2007-12-11  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+	* mm-decode.el (mm-add-meta-html-tag): New function.
+	(mm-save-part-to-file, mm-pipe-part): Use it
+
+	* gnus-art.el (gnus-article-browse-delete-temp-files): Use
+	gnus-y-or-n-p instead of y-or-n-p.
+	(gnus-article-browse-html-parts): Work with message/external-body; use
+	mm-add-meta-html-tag.
+
 2007-12-11  Glenn Morris  <rgm@gnu.org>
 
 	* gnus-cache.el: Require gnus-sum not just when compiling.
@@ -74,6 +109,10 @@
 	* spam.el (gnus-extract-address-components):
 	Declare as functions.
 
+2007-12-10  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+	* gnus-art.el (gnus-article-browse-html-parts): Decode CTE.
+
 2007-12-09  Glenn Morris  <rgm@gnu.org>
 
 	* gnus-uu.el (gnus-uu-yenc-article): Use insert-buffer-substring.
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index d8f03ff2cb8..e984372543d 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -2782,9 +2782,9 @@ summary buffer."
 	     (or how
 		 (setq how gnus-article-browse-delete-temp)))
     (when (and (eq how 'ask)
-	       (y-or-n-p (format
-			  "Delete all %s temporary HTML file(s)? "
-			  (length gnus-article-browse-html-temp-list)))
+	       (gnus-y-or-n-p (format
+			       "Delete all %s temporary HTML file(s)? "
+			       (length gnus-article-browse-html-temp-list)))
 	       (setq how t)))
     (dolist (file gnus-article-browse-html-temp-list)
       (when (and (file-exists-p file)
@@ -2802,61 +2802,63 @@ summary buffer."
   "View all \"text/html\" parts from LIST.
 Recurse into multiparts."
   ;; Internal function used by `gnus-article-browse-html-article'.
-  (let ((showed))
+  (let (type file charset tmp-file showed)
     ;; Find and show the html-parts.
     (dolist (handle list)
       ;; If HTML, show it:
-      (when (listp handle)
-	(cond ((and (bufferp (car handle))
-		    (string-match "text/html" (car (mm-handle-type handle))))
-	       (let ((tmp-file (mm-make-temp-file
-				;; Do we need to care for 8.3 filenames?
-				"mm-" nil ".html"))
-		     (charset (mail-content-type-get (mm-handle-type handle)
-						     'charset)))
-		 (if charset
-		     ;; Add a meta html tag to specify charset.
-		     (mm-with-unibyte-buffer
-		       (insert (with-current-buffer (mm-handle-buffer handle)
-				 (if (eq charset 'gnus-decoded)
-				     (mm-encode-coding-string
-				      (buffer-string)
-				      (setq charset 'utf-8))
-				   (buffer-string))))
-		       (setq charset (format "\
-<meta http-equiv=\"Content-Type\" content=\"text/html; charset=%s\">"
-					     charset))
-		       (goto-char (point-min))
-		       (let ((case-fold-search t))
-			 (cond (;; Don't modify existing meta tag.
-				(re-search-forward "\
-<meta[\t\n\r ]+http-equiv=\"content-type\"[^>]+>"
-						   nil t))
-			       ((re-search-forward "<head>[\t\n\r ]*" nil t)
-				(insert charset "\n"))
-			       (t
-				(re-search-forward "\
-<html\\(?:[\t\n\r ]+[^>]+\\|[\t\n\r ]*\\)>[\t\n\r ]*"
-						   nil t)
-				(insert "<head>\n" charset "\n</head>\n"))))
+      (cond ((not (listp handle)))
+	    ((or (equal (car (setq type (mm-handle-type handle))) "text/html")
+		 (and (equal (car type) "message/external-body")
+		      (setq file (or (mail-content-type-get type 'name)
+				     (mail-content-type-get
+				      (mm-handle-disposition handle)
+				      'filename)))
+		      (or (mm-handle-cache handle)
+			  (condition-case code
+			      (progn (mm-extern-cache-contents handle) t)
+			    (error
+			     (gnus-message 3 "%s" (error-message-string code))
+			     (when (>= gnus-verbose 3) (sit-for 2))
+			     nil)))
+		      (progn
+			(setq handle (mm-handle-cache handle)
+			      type (mm-handle-type handle))
+			(equal (car type) "text/html"))))
+	     (when (or (setq charset (mail-content-type-get type 'charset))
+		       (not file))
+	       (setq tmp-file (mm-make-temp-file
+			       ;; Do we need to care for 8.3 filenames?
+			       "mm-" nil ".html")))
+	     (if charset
+		 ;; Add a meta html tag to specify charset.
+		 (mm-with-unibyte-buffer
+		   (insert (if (eq charset 'gnus-decoded)
+			       (mm-encode-coding-string (mm-get-part handle)
+							(setq charset 'utf-8))
+			     (mm-get-part handle)))
+		   (if (or (mm-add-meta-html-tag handle charset)
+			   (not file))
 		       (mm-write-region (point-min) (point-max)
-					tmp-file nil nil nil 'binary t))
-		   (mm-save-part-to-file handle tmp-file))
-		 (add-to-list 'gnus-article-browse-html-temp-list tmp-file)
-		 (add-hook 'gnus-summary-prepare-exit-hook
-			   'gnus-article-browse-delete-temp-files)
-		 (add-hook 'gnus-exit-gnus-hook
-			   (lambda  ()
-			     (gnus-article-browse-delete-temp-files t)))
-		 ;; FIXME: Warn if there's an <img> tag?
-		 (browse-url-of-file tmp-file)
-		 (setq showed t)))
-	      ;; If multipart, recurse
-	      ((and (stringp (car handle))
-		    (string-match "^multipart/" (car handle))
-		    (setq showed
-			  (or showed
-			      (gnus-article-browse-html-parts handle))))))))
+					tmp-file nil nil nil 'binary t)
+		     (setq tmp-file nil)))
+	       (when tmp-file
+		 (mm-save-part-to-file handle tmp-file)))
+	     (when tmp-file
+	       (add-to-list 'gnus-article-browse-html-temp-list tmp-file))
+	     (add-hook 'gnus-summary-prepare-exit-hook
+		       'gnus-article-browse-delete-temp-files)
+	     (add-hook 'gnus-exit-gnus-hook
+		       (lambda  ()
+			 (gnus-article-browse-delete-temp-files t)))
+	     ;; FIXME: Warn if there's an <img> tag?
+	     (browse-url-of-file (or tmp-file (expand-file-name file)))
+	     (setq showed t))
+	    ;; If multipart, recurse
+	    ((and (stringp (car handle))
+		  (string-match "^multipart/" (car handle))
+		  (setq showed
+			(or showed
+			    (gnus-article-browse-html-parts handle)))))))
     showed))
 
 ;; FIXME: Documentation in texi/gnus.texi missing.
@@ -3916,6 +3918,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
 
 (defun article-verify-x-pgp-sig ()
   "Verify X-PGP-Sig."
+  ;; <ftp://ftp.isc.org/pub/pgpcontrol/FORMAT>
   (interactive)
   (if (gnus-buffer-live-p gnus-original-article-buffer)
       (let ((sig (with-current-buffer gnus-original-article-buffer
@@ -4724,8 +4727,9 @@ Deleting parts may malfunction or destroy the article; continue? "))
 	   (handles gnus-article-mime-handles)
 	   (none "(none)")
 	   (description
-	    (mail-decode-encoded-word-string (or (mm-handle-description data)
-						 none)))
+	    (let ((desc (mm-handle-description data)))
+	      (when desc
+		(mail-decode-encoded-word-string desc))))
 	   (filename
 	    (or (mail-content-type-get (mm-handle-disposition data) 'filename)
 		none))
@@ -4743,7 +4747,8 @@ Deleting parts may malfunction or destroy the article; continue? "))
 	    "| Type:           " type "\n"
 	    "| Filename:       " filename "\n"
 	    "| Size (encoded): " bsize " Byte\n"
-	    "| Description:    " description "\n"
+	    (when description
+	      (concat    "| Description:    " description "\n"))
 	    "`----\n"))
 	  (setcdr data
 		  (cdr (mm-make-handle
@@ -8003,6 +8008,11 @@ For example:
 			 gnus-article-encrypt-protocol-alist
 			 nil t))
     current-prefix-arg))
+  ;; User might hit `K E' instead of `K e', so prompt once.
+  (when (and gnus-article-encrypt-protocol
+	     gnus-novice-user)
+    (unless (gnus-y-or-n-p "Really encrypt article(s)? ")
+      (error "Encrypt aborted.")))
   (let ((func (cdr (assoc protocol gnus-article-encrypt-protocol-alist))))
     (unless func
       (error "Can't find the encrypt protocol %s" protocol))
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 2f4ccb7307c..62068d85a80 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -7658,7 +7658,7 @@ If BACKWARD, the previous article is selected instead of the next."
 	(gnus-summary-article-subject))))
 
 (defun gnus-summary-prev-article (&optional unread subject)
-  "Select the article after the current one.
+  "Select the article before the current one.
 If UNREAD is non-nil, only unread articles are selected."
   (interactive "P")
   (gnus-summary-next-article unread subject t))
@@ -10830,12 +10830,12 @@ The difference between N and the number of marks cleared is returned."
   (gnus-summary-mark-forward (- n) gnus-unread-mark))
 
 (defun gnus-summary-mark-unread-as-read ()
-  "Intended to be used by `gnus-summary-mark-article-hook'."
+  "Intended to be used by `gnus-mark-article-hook'."
   (when (memq gnus-current-article gnus-newsgroup-unreads)
     (gnus-summary-mark-article gnus-current-article gnus-read-mark)))
 
 (defun gnus-summary-mark-read-and-unread-as-read (&optional new-mark)
-  "Intended to be used by `gnus-summary-mark-article-hook'."
+  "Intended to be used by `gnus-mark-article-hook'."
   (let ((mark (gnus-summary-article-mark)))
     (when (or (gnus-unread-mark-p mark)
 	      (gnus-read-mark-p mark))
@@ -10843,7 +10843,7 @@ The difference between N and the number of marks cleared is returned."
 				 (or new-mark gnus-read-mark)))))
 
 (defun gnus-summary-mark-current-read-and-unread-as-read (&optional new-mark)
-  "Intended to be used by `gnus-summary-mark-article-hook'."
+  "Intended to be used by `gnus-mark-article-hook'."
   (let ((mark (gnus-summary-article-mark)))
     (when (or (gnus-unread-mark-p mark)
 	      (gnus-read-mark-p mark))
@@ -10851,7 +10851,7 @@ The difference between N and the number of marks cleared is returned."
 				 (or new-mark gnus-read-mark)))))
 
 (defun gnus-summary-mark-unread-as-ticked ()
-  "Intended to be used by `gnus-summary-mark-article-hook'."
+  "Intended to be used by `gnus-mark-article-hook'."
   (when (memq gnus-current-article gnus-newsgroup-unreads)
     (gnus-summary-mark-article gnus-current-article gnus-ticked-mark)))
 
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index 7b36c07da62..56aacf0d5a6 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -337,15 +337,23 @@ Symbols are also allowed; their print names are used instead."
 
 ;; Two silly functions to ensure that all `y-or-n-p' questions clear
 ;; the echo area.
-(defun gnus-y-or-n-p (prompt)
-  (prog1
-      (y-or-n-p prompt)
-    (message "")))
-
-(defun gnus-yes-or-no-p (prompt)
-  (prog1
-      (yes-or-no-p prompt)
-    (message "")))
+;;
+;; Do we really need these aliases?  Workarounds for bugs in the corresponding
+;; Emacs functions?  Maybe these bug are no longer present in any supported
+;; (X)Emacs version?  Alias them to the original functions and see if anyone
+;; reports a problem.  If not, replace with original functions.  --rsteib
+;;
+;; (defun gnus-y-or-n-p (prompt)
+;;   (prog1
+;;       (y-or-n-p prompt)
+;;     (message "")))
+;; (defun gnus-yes-or-no-p (prompt)
+;;   (prog1
+;;       (yes-or-no-p prompt)
+;;     (message "")))
+
+(defalias 'gnus-y-or-n-p 'y-or-n-p)
+(defalias 'gnus-yes-or-no-p 'yes-or-no-p)
 
 ;; By Frank Schmitt <ich@Frank-Schmitt.net>. Allows to have
 ;; age-depending date representations. (e.g. just the time if it's
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index 9de9b3d354e..e2c23d9db5a 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -1239,9 +1239,39 @@ PROMPT overrides the default one used to ask user for a file name."
 	   (mm-save-part-to-file handle file)
 	   file))))
 
+(defun mm-add-meta-html-tag (handle &optional charset)
+  "Add meta html tag to specify CHARSET of HANDLE in the current buffer.
+CHARSET defaults to the one HANDLE specifies.  Existing meta tag that
+specifies charset will not be modified.  Return t if meta tag is added
+or replaced."
+  (when (equal (mm-handle-media-type handle) "text/html")
+    (when (or charset
+	      (setq charset (mail-content-type-get (mm-handle-type handle)
+						   'charset)))
+      (setq charset (format "\
+<meta http-equiv=\"Content-Type\" content=\"text/html; charset=%s\">" charset))
+      (let ((case-fold-search t))
+	(goto-char (point-min))
+	(if (re-search-forward "\
+<meta\\s-+http-equiv=[\"']?content-type[\"']?\\s-+content=[\"']\
+text/\\(\\sw+\\)\\(?:\;\\s-*charset=\\(.+?\\)\\)?[\"'][^>]*>" nil t)
+	    (if (and (match-beginning 2)
+		     (string-match "\\`html\\'" (match-string 1)))
+		;; Don't modify existing meta tag.
+		nil
+	      ;; Replace it with the one specifying charset.
+	      (replace-match charset)
+	      t)
+	  (if (re-search-forward "<head>\\s-*" nil t)
+	      (insert charset "\n")
+	    (re-search-forward "<html\\(?:\\s-+[^>]+\\|\\s-*\\)>\\s-*" nil t)
+	    (insert "<head>\n" charset "\n</head>\n"))
+	  t)))))
+
 (defun mm-save-part-to-file (handle file)
   (mm-with-unibyte-buffer
     (mm-insert-part handle)
+    (mm-add-meta-html-tag handle)
     (let ((current-file-modes (default-file-modes)))
       (set-default-file-modes mm-attachment-file-modes)
       (unwind-protect
@@ -1258,6 +1288,7 @@ PROMPT overrides the default one used to ask user for a file name."
 	  (read-string "Shell command on MIME part: " mm-last-shell-command)))
     (mm-with-unibyte-buffer
       (mm-insert-part handle)
+      (mm-add-meta-html-tag handle)
       (let ((coding-system-for-write 'binary))
 	(shell-command-on-region (point-min) (point-max) command nil)))))
 
diff --git a/lisp/pgg.el b/lisp/pgg.el
index 74b6ed7cb22..26911974ea6 100644
--- a/lisp/pgg.el
+++ b/lisp/pgg.el
@@ -42,12 +42,10 @@
 ;;;
 
 (eval-when-compile
-  (unless (featurep 'xemacs)
-    (defalias 'pgg-run-at-time 'run-at-time)
-    (defalias 'pgg-cancel-timer 'cancel-timer))
-
-  (when (featurep 'xemacs)
-    (defmacro pgg-run-at-time-1 (time repeat function args)
+  ;; Define it as a null macro for Emacs in order to suppress a byte
+  ;; compile warning that Emacs 21 issues.
+  (defmacro pgg-run-at-time-1 (time repeat function args)
+    (when (featurep 'xemacs)
       (if (condition-case nil
 	      (let ((delete-itimer 'delete-itimer)
 		    (itimer-driver-start 'itimer-driver-start)
@@ -105,19 +103,23 @@
 			itimer
 			(append (list itimer function) args)))))
 		 1e-9 (if time (max time 1e-9) 1e-9)
-		 nil t itimers ,repeat ,function ,args))))
+		 nil t itimers ,repeat ,function ,args))))))
 
-    (defun pgg-run-at-time (time repeat function &rest args)
-      "Emulating function run as `run-at-time'.
+(eval-and-compile
+  (if (featurep 'xemacs)
+      (progn
+	(defun pgg-run-at-time (time repeat function &rest args)
+	  "Emulating function run as `run-at-time'.
 TIME should be nil meaning now, or a number of seconds from now.
 Return an itimer object which can be used in either `delete-itimer'
 or `cancel-timer'."
-      (pgg-run-at-time-1 time repeat function args))
-    (defun pgg-cancel-timer (timer)
-      "Emulate cancel-timer for xemacs."
-      (let ((delete-itimer 'delete-itimer))
-        (funcall delete-itimer timer)))
-    ))
+	  (pgg-run-at-time-1 time repeat function args))
+	(defun pgg-cancel-timer (timer)
+	  "Emulate cancel-timer for xemacs."
+	  (let ((delete-itimer 'delete-itimer))
+	    (funcall delete-itimer timer))))
+    (defalias 'pgg-run-at-time 'run-at-time)
+    (defalias 'pgg-cancel-timer 'cancel-timer)))
 
 (defun pgg-invoke (func scheme &rest args)
   (progn