Mercurial > emacs

changeset 87300:b968c7f9a8b4

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merge from gnus--devo--0 Revision: emacs@sv.gnu.org/emacs--devo--0--patch-955
author Miles Bader <miles@gnu.org>
date Sun, 16 Dec 2007 04:31:33 +0000
parents a524d1739a14
children 1d6e3255f024
files doc/misc/ChangeLog doc/misc/gnus.texi lisp/ChangeLog lisp/gnus/ChangeLog lisp/gnus/gnus-art.el lisp/gnus/gnus-sum.el lisp/gnus/gnus-util.el lisp/gnus/mm-decode.el lisp/pgg.el
diffstat 9 files changed, 184 insertions(+), 86 deletions(-) [+]
line wrap: on
line diff
--- a/doc/misc/ChangeLog	Sat Dec 15 11:37:25 2007 +0000
+++ b/doc/misc/ChangeLog	Sun Dec 16 04:31:33 2007 +0000
@@ -1,3 +1,7 @@
+2007-12-14  Sven Joachim  <svenjoac@gmx.de>
+
+	* gnus.texi (Score Variables): Fix typo.
+
 2007-12-07  Michael Albinus  <michael.albinus@gmx.de>
 
 	* dbus.texi (Synchronous Methods): Adapt dbus-call-method.
--- a/doc/misc/gnus.texi	Sat Dec 15 11:37:25 2007 +0000
+++ b/doc/misc/gnus.texi	Sun Dec 16 04:31:33 2007 +0000
@@ -20529,7 +20529,7 @@
 @vindex gnus-score-uncacheable-files
 @cindex score cache
 All score files are normally cached to avoid excessive re-loading of
-score files.  However, if this might make your Emacs grow big and
+score files.  However, this might make your Emacs grow big and
 bloated, so this regexp can be used to weed out score files unlikely
 to be needed again.  It would be a bad idea to deny caching of
 @file{all.SCORE}, while it might be a good idea to not cache
--- a/lisp/ChangeLog	Sat Dec 15 11:37:25 2007 +0000
+++ b/lisp/ChangeLog	Sun Dec 16 04:31:33 2007 +0000
@@ -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.
--- a/lisp/gnus/ChangeLog	Sat Dec 15 11:37:25 2007 +0000
+++ b/lisp/gnus/ChangeLog	Sun Dec 16 04:31:33 2007 +0000
@@ -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.
--- a/lisp/gnus/gnus-art.el	Sat Dec 15 11:37:25 2007 +0000
+++ b/lisp/gnus/gnus-art.el	Sun Dec 16 04:31:33 2007 +0000
@@ -2782,9 +2782,9 @@
 	     (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 @@
   "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 @@
 
 (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 @@
 	   (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 @@
 	    "| 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 @@
 			 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))
--- a/lisp/gnus/gnus-sum.el	Sat Dec 15 11:37:25 2007 +0000
+++ b/lisp/gnus/gnus-sum.el	Sun Dec 16 04:31:33 2007 +0000
@@ -7658,7 +7658,7 @@
 	(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 @@
   (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 @@
 				 (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 @@
 				 (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)))
 
--- a/lisp/gnus/gnus-util.el	Sat Dec 15 11:37:25 2007 +0000
+++ b/lisp/gnus/gnus-util.el	Sun Dec 16 04:31:33 2007 +0000
@@ -337,15 +337,23 @@
 
 ;; 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 "")))
+;;
+;; 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 "")))
 
-(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
--- a/lisp/gnus/mm-decode.el	Sat Dec 15 11:37:25 2007 +0000
+++ b/lisp/gnus/mm-decode.el	Sun Dec 16 04:31:33 2007 +0000
@@ -1239,9 +1239,39 @@
 	   (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 @@
 	  (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)))))
 
--- a/lisp/pgg.el	Sat Dec 15 11:37:25 2007 +0000
+++ b/lisp/pgg.el	Sun Dec 16 04:31:33 2007 +0000
@@ -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