Merge from gnus--devo--0

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

9 files changed, 185 insertions, 87 deletions

diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog
index 89e4974490d..8e4eab56b15 100644
--- a/doc/misc/ChangeLog
+++ b/doc/misc/ChangeLog
@@ -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.
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 8ec39ce81fe..4a165c62b25 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -20529,7 +20529,7 @@ Suffix to add to the group name to arrive at the score file name
 @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
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