Synch to No Gnus 200401092242.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 137284c..abc709c 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,56 @@
+2004-01-09  Jesper Harder  <harder@ifa.au.dk>
+
+       * gnus-art.el (article-decode-mime-words, article-babel)
+       (gnus-article-highlight-signature, gnus-article-add-buttons)
+       (gnus-signature-toggle): Use gnus-with-article-buffer.
+       
+       * gnus-art.el (gnus-article-highlight-headers)
+       (gnus-article-add-buttons-to-head): Use gnus-with-article-headers.
+       
+       * gnus-art.el (gnus-mm-display-part, gnus-article-wash-status)
+       (gnus-article-set-globals, gnus-request-article-this-buffer)
+       (gnus-button-message-id, gnus-article-maybe-hide-headers)
+       (gnus-mime-view-part-externally, gnus-mime-view-part-internally)
+       (gnus-mime-display-alternative): Use with-current-buffer.
+
+2004-01-09  Teodor Zlatanov  <tzz@lifelogs.com>
+
+       * spam.el (spam-generate-fake-headers): rewrite to be simpler,
+       also under 80 char limit, and call gnus-error if needed
+       (spam-fetch-article-header): finally fixed - it was a
+       buffer-local variable (gnus-newsgroup-data)
+       (spam-find-spam): use spam-generate-fake-headers, forget about
+       spam-insert-fake-headers
+       (spam-insert-fake-headers): removed
+
+2004-01-09  Jesper Harder  <harder@ifa.au.dk>
+
+       * deuglify.el (gnus-article-outlook-unwrap-lines)
+       (gnus-outlook-rearrange-article)
+       (gnus-outlook-repair-attribution-outlook)
+       (gnus-outlook-repair-attribution-block)
+       (gnus-outlook-repair-attribution-other): Remove redundant
+       save-excursion.
+
+2004-01-09  Teodor Zlatanov  <tzz@lifelogs.com>
+
+       * spam.el (spam-fetch-field-fast, spam-fetch-field-from-fast)
+       (spam-fetch-field-subject-fast)
+       (spam-fetch-field-message-id-fast, spam-generate-fake-headers)
+       (spam-fetch-article-header): new functions to deal with Gnus
+       internals for fast retrieval of article header data
+       (spam-initialize): put spam-find-spam in the gnus-summary-prepared-hook
+
+2004-01-09  Jesper Harder  <harder@ifa.au.dk>
+
+       * pop3.el (pop3-md5): Remove.
+       (pop3-apop): Replace pop3-md5 with md5.
+
+       * mm-bodies.el: base64 is always built-in.
+
+       * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): Use
+       with-current-buffer.
+

 2004-01-08  Katsumi Yamaoka  <yamaoka@jpl.org>
 
        * canlock.el (canlock-insert-header): Remove excessive grouping in
 2004-01-08  Katsumi Yamaoka  <yamaoka@jpl.org>
 
        * canlock.el (canlock-insert-header): Remove excessive grouping in

diff --git a/lisp/deuglify.el b/lisp/deuglify.el
index ef10ac4..42c7514 100644 (file)
--- a/lisp/deuglify.el
+++ b/lisp/deuglify.el
@@ -307,71 +307,67 @@ You can control what lines will be unwrapped by frobbing
 indicating the minimum and maximum length of an unwrapped citation line.  If
 NODISPLAY is non-nil, don't redisplay the article buffer."
   (interactive "P")
 indicating the minimum and maximum length of an unwrapped citation line.  If
 NODISPLAY is non-nil, don't redisplay the article buffer."
   (interactive "P")

-  (save-excursion
-    (let ((case-fold-search nil)
-         (inhibit-read-only t)
-         (cite-marks gnus-outlook-deuglify-cite-marks)
-         (no-wrap gnus-outlook-deuglify-no-wrap-chars)
-         (stop-chars gnus-outlook-deuglify-unwrap-stop-chars))
-      (gnus-with-article-buffer
-       (article-goto-body)
-       (while (re-search-forward
-               (concat
-                "^\\([ \t" cite-marks "]*\\)"
-                "\\([" cite-marks "].*[^\n " stop-chars "]\\)[ \t]?\n"
-                "\\1\\([^\n " cite-marks no-wrap "]+.*\\)$")
+  (let ((case-fold-search nil)
+       (inhibit-read-only t)
+       (cite-marks gnus-outlook-deuglify-cite-marks)
+       (no-wrap gnus-outlook-deuglify-no-wrap-chars)
+       (stop-chars gnus-outlook-deuglify-unwrap-stop-chars))
+    (gnus-with-article-buffer
+      (article-goto-body)
+      (while (re-search-forward
+             (concat
+              "^\\([ \t" cite-marks "]*\\)"
+              "\\([" cite-marks "].*[^\n " stop-chars "]\\)[ \t]?\n"
+              "\\1\\([^\n " cite-marks no-wrap "]+.*\\)$")

               nil t)
               nil t)

-         (let ((len12 (- (match-end 2) (match-beginning 1)))
+       (let ((len12 (- (match-end 2) (match-beginning 1)))

              (len3 (- (match-end 3) (match-beginning 3))))
              (len3 (- (match-end 3) (match-beginning 3))))

-           (if (and (> len12 gnus-outlook-deuglify-unwrap-min)
-                    (< (+ len12 len3) gnus-outlook-deuglify-unwrap-max))
-               (progn
-                 (replace-match "\\1\\2 \\3")
-                 (goto-char (match-beginning 0)))))))))
+         (if (and (> len12 gnus-outlook-deuglify-unwrap-min)
+                  (< (+ len12 len3) gnus-outlook-deuglify-unwrap-max))
+             (progn
+               (replace-match "\\1\\2 \\3")
+               (goto-char (match-beginning 0))))))))

   (unless nodisplay (gnus-outlook-display-article-buffer)))
 
 (defun gnus-outlook-rearrange-article (attr-start)
   "Put the text from ATTR-START to the end of buffer at the top of the article buffer."
   (unless nodisplay (gnus-outlook-display-article-buffer)))
 
 (defun gnus-outlook-rearrange-article (attr-start)
   "Put the text from ATTR-START to the end of buffer at the top of the article buffer."

-  (save-excursion
-    (let ((inhibit-read-only t)
-         (cite-marks gnus-outlook-deuglify-cite-marks))
-      (gnus-with-article-buffer
-       (article-goto-body)
-       ;; article does not start with attribution
-       (unless (= (point) attr-start)
-         (gnus-kill-all-overlays)
-         (let ((cur (point))
-               ;; before signature or end of buffer
-               (to (if (gnus-article-search-signature)
-                       (point)
-                     (point-max))))
-           ;; handle the case where the full quote is below the
-           ;; signature
-           (if (< to attr-start)
-               (setq to (point-max)))
-           (transpose-regions cur attr-start attr-start to)))))))
+  (let ((inhibit-read-only t)
+       (cite-marks gnus-outlook-deuglify-cite-marks))
+    (gnus-with-article-buffer
+      (article-goto-body)
+      ;; article does not start with attribution
+      (unless (= (point) attr-start)
+       (gnus-kill-all-overlays)
+       (let ((cur (point))
+             ;; before signature or end of buffer
+             (to (if (gnus-article-search-signature)
+                     (point)
+                   (point-max))))
+         ;; handle the case where the full quote is below the
+         ;; signature
+         (if (< to attr-start)
+             (setq to (point-max)))
+         (transpose-regions cur attr-start attr-start to))))))

 
 ;; John Doe <john.doe@some.domain> wrote in message
 ;; news:a87usw8$dklsssa$2@some.news.server...
 
 (defun gnus-outlook-repair-attribution-outlook ()
   "Repair a broken attribution line (Outlook)."
 
 ;; John Doe <john.doe@some.domain> wrote in message
 ;; news:a87usw8$dklsssa$2@some.news.server...
 
 (defun gnus-outlook-repair-attribution-outlook ()
   "Repair a broken attribution line (Outlook)."

-  (save-excursion
-    (let ((case-fold-search nil)
-         (inhibit-read-only t)
-         (cite-marks gnus-outlook-deuglify-cite-marks))
-      (gnus-with-article-buffer
-       (article-goto-body)
-       (if (re-search-forward
+  (let ((case-fold-search nil)
+       (inhibit-read-only t)
+       (cite-marks gnus-outlook-deuglify-cite-marks))
+    (gnus-with-article-buffer
+      (article-goto-body)
+      (when (re-search-forward

             (concat "^\\([^" cite-marks "].+\\)"
                     "\\(" gnus-outlook-deuglify-attrib-verb-regexp "\\)"
                     "\\(.*\n?[^\n" cite-marks "].*\\)?"
                     "\\(" gnus-outlook-deuglify-attrib-end-regexp "\\)$")
             nil t)
             (concat "^\\([^" cite-marks "].+\\)"
                     "\\(" gnus-outlook-deuglify-attrib-verb-regexp "\\)"
                     "\\(.*\n?[^\n" cite-marks "].*\\)?"
                     "\\(" gnus-outlook-deuglify-attrib-end-regexp "\\)$")
             nil t)

-           (progn
-             (gnus-kill-all-overlays)
-             (replace-match "\\1\\2\\4")
-             (match-beginning 0)))))))
+       (gnus-kill-all-overlays)
+       (replace-match "\\1\\2\\4")
+       (match-beginning 0)))))

 
 
 ;; ----- Original Message -----
 
 
 ;; ----- Original Message -----

@@ -382,42 +378,38 @@ NODISPLAY is non-nil, don't redisplay the article buffer."
 
 (defun gnus-outlook-repair-attribution-block ()
   "Repair a big broken attribution block."
 
 (defun gnus-outlook-repair-attribution-block ()
   "Repair a big broken attribution block."

-  (save-excursion
-    (let ((case-fold-search nil)
-         (inhibit-read-only t)
-         (cite-marks gnus-outlook-deuglify-cite-marks))
-      (gnus-with-article-buffer
-       (article-goto-body)
-       (if (re-search-forward
-            (concat "^[" cite-marks " \t]*--* ?[^-]+ [^-]+ ?--*\\s *\n"
+  (let ((case-fold-search nil)
+       (inhibit-read-only t)
+       (cite-marks gnus-outlook-deuglify-cite-marks))
+    (gnus-with-article-buffer
+      (article-goto-body)
+      (when (re-search-forward
+            (concat "^[" cite-marks " \t]*--* ?[^-]+ [^-]+ ?--*\\s *\n"

                     "[^\n:]+:[ \t]*\\([^\n]+\\)\n"
                     "\\([^\n:]+:[ \t]*[^\n]+\n\\)+")
             nil t)
                     "[^\n:]+:[ \t]*\\([^\n]+\\)\n"
                     "\\([^\n:]+:[ \t]*[^\n]+\n\\)+")
             nil t)

-           (progn
-             (gnus-kill-all-overlays)
-             (replace-match "\\1 wrote:\n")
-             (match-beginning 0)))))))
+       (gnus-kill-all-overlays)
+       (replace-match "\\1 wrote:\n")
+       (match-beginning 0)))))

 
 ;; On Wed, 16 Jan 2002 23:23:30 +0100, John Doe <john.doe@some.domain> wrote:
 
 (defun gnus-outlook-repair-attribution-other ()
   "Repair a broken attribution line (other user agents than Outlook)."
 
 ;; On Wed, 16 Jan 2002 23:23:30 +0100, John Doe <john.doe@some.domain> wrote:
 
 (defun gnus-outlook-repair-attribution-other ()
   "Repair a broken attribution line (other user agents than Outlook)."

-  (save-excursion
-    (let ((case-fold-search nil)
-         (inhibit-read-only t)
-         (cite-marks gnus-outlook-deuglify-cite-marks))
-      (gnus-with-article-buffer
-       (article-goto-body)
-       (if (re-search-forward
+  (let ((case-fold-search nil)
+       (inhibit-read-only t)
+       (cite-marks gnus-outlook-deuglify-cite-marks))
+    (gnus-with-article-buffer
+      (article-goto-body)
+      (when (re-search-forward

             (concat "^\\("gnus-outlook-deuglify-attrib-cut-regexp"\\)?"
                     "\\([^" cite-marks "].+\\)\n\\([^\n" cite-marks "].*\\)?"
                     "\\(" gnus-outlook-deuglify-attrib-verb-regexp "\\).*"
                     "\\(" gnus-outlook-deuglify-attrib-end-regexp "\\)$")
             nil t)
             (concat "^\\("gnus-outlook-deuglify-attrib-cut-regexp"\\)?"
                     "\\([^" cite-marks "].+\\)\n\\([^\n" cite-marks "].*\\)?"
                     "\\(" gnus-outlook-deuglify-attrib-verb-regexp "\\).*"
                     "\\(" gnus-outlook-deuglify-attrib-end-regexp "\\)$")
             nil t)

-           (progn
-             (gnus-kill-all-overlays)
-             (replace-match "\\4 \\5\\6\\7")
-             (match-beginning 0)))))))
+       (gnus-kill-all-overlays)
+       (replace-match "\\4 \\5\\6\\7")
+       (match-beginning 0)))))

 
 ;;;###autoload
 (defun gnus-article-outlook-repair-attribution (&optional nodisplay)
 
 ;;;###autoload
 (defun gnus-article-outlook-repair-attribution (&optional nodisplay)

diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el
index 3868945..84d47b8 100644 (file)
--- a/lisp/gnus-art.el
+++ b/lisp/gnus-art.el
@@ -2272,14 +2272,12 @@ unfolded."
 (defun article-decode-mime-words ()
   "Decode all MIME-encoded words in the article."
   (interactive)
 (defun article-decode-mime-words ()
   "Decode all MIME-encoded words in the article."
   (interactive)

-  (save-excursion
-    (set-buffer gnus-article-buffer)
+  (gnus-with-article-buffer

     (let ((inhibit-point-motion-hooks t)
     (let ((inhibit-point-motion-hooks t)

-         buffer-read-only

          (mail-parse-charset gnus-newsgroup-charset)
          (mail-parse-ignored-charsets
          (mail-parse-charset gnus-newsgroup-charset)
          (mail-parse-ignored-charsets

-          (save-excursion (set-buffer gnus-summary-buffer)
-                          gnus-newsgroup-ignored-charsets)))
+          (with-current-buffer gnus-summary-buffer
+            gnus-newsgroup-ignored-charsets)))

       (mail-decode-encoded-word-region (point-min) (point-max)))))
 
 (defun article-decode-charset (&optional prompt)
       (mail-decode-encoded-word-region (point-min) (point-max)))))
 
 (defun article-decode-charset (&optional prompt)

@@ -2652,11 +2650,9 @@ always hide."
   "Translate article using an online translation service."
   (interactive)
   (require 'babel)
   "Translate article using an online translation service."
   (interactive)
   (require 'babel)

-  (save-excursion
-    (set-buffer gnus-article-buffer)
+  (gnus-with-article-buffer

     (when (article-goto-body)
     (when (article-goto-body)

-      (let* ((buffer-read-only nil)
-            (start (point))
+      (let* ((start (point))

             (end (point-max))
             (orig (buffer-substring start end))
             (trans (babel-as-string orig)))
             (end (point-max))
             (orig (buffer-substring start end))
             (trans (babel-as-string orig)))

@@ -4661,8 +4657,8 @@ specified charset."
         (mm-inlined-types nil)
         (mail-parse-charset gnus-newsgroup-charset)
         (mail-parse-ignored-charsets
         (mm-inlined-types nil)
         (mail-parse-charset gnus-newsgroup-charset)
         (mail-parse-ignored-charsets

-         (save-excursion (set-buffer gnus-summary-buffer)
-                         gnus-newsgroup-ignored-charsets)))
+         (with-current-buffer gnus-summary-buffer
+           gnus-newsgroup-ignored-charsets)))

     (when handle
       (if (mm-handle-undisplayer handle)
          (mm-remove-part handle)
     (when handle
       (if (mm-handle-undisplayer handle)
          (mm-remove-part handle)

@@ -4678,8 +4674,8 @@ If no internal viewer is available, use an external viewer."
         (mm-inline-large-images t)
         (mail-parse-charset gnus-newsgroup-charset)
         (mail-parse-ignored-charsets
         (mm-inline-large-images t)
         (mail-parse-charset gnus-newsgroup-charset)
         (mail-parse-ignored-charsets

-         (save-excursion (set-buffer gnus-summary-buffer)
-                         gnus-newsgroup-ignored-charsets))
+         (with-current-buffer gnus-summary-buffer
+           gnus-newsgroup-ignored-charsets))

         buffer-read-only)
     (when handle
       (if (mm-handle-undisplayer handle)
         buffer-read-only)
     (when handle
       (if (mm-handle-undisplayer handle)

@@ -4790,8 +4786,7 @@ N is the numerical prefix."
              (mail-parse-charset gnus-newsgroup-charset)
              (mail-parse-ignored-charsets
               (if (gnus-buffer-live-p gnus-summary-buffer)
              (mail-parse-charset gnus-newsgroup-charset)
              (mail-parse-ignored-charsets
               (if (gnus-buffer-live-p gnus-summary-buffer)

-                  (save-excursion
-                    (set-buffer gnus-summary-buffer)
+                  (with-current-buffer gnus-summary-buffer

                     gnus-newsgroup-ignored-charsets)
                 nil)))
          (save-excursion
                     gnus-newsgroup-ignored-charsets)
                 nil)))
          (save-excursion

@@ -5180,8 +5175,8 @@ If displaying \"text/html\" is discouraged \(see
              (gnus-display-mime preferred)
            (let ((mail-parse-charset gnus-newsgroup-charset)
                  (mail-parse-ignored-charsets
              (gnus-display-mime preferred)
            (let ((mail-parse-charset gnus-newsgroup-charset)
                  (mail-parse-ignored-charsets

-                  (save-excursion (set-buffer gnus-summary-buffer)
-                                  gnus-newsgroup-ignored-charsets)))
+                  (with-current-buffer gnus-summary-buffer
+                    gnus-newsgroup-ignored-charsets)))

              (mm-display-part preferred)
              ;; Do highlighting.
              (save-excursion
              (mm-display-part preferred)
              ;; Do highlighting.
              (save-excursion

@@ -5233,8 +5228,7 @@ is the string to use when it is inactive.")
 
 (defun gnus-article-wash-status ()
   "Return a string which display status of article washing."
 
 (defun gnus-article-wash-status ()
   "Return a string which display status of article washing."

-  (save-excursion
-    (set-buffer gnus-article-buffer)
+  (with-current-buffer gnus-article-buffer

     (let ((cite (memq 'cite gnus-article-wash-types))
          (headers (memq 'headers gnus-article-wash-types))
          (boring (memq 'boring-headers gnus-article-wash-types))
     (let ((cite (memq 'cite gnus-article-wash-types))
          (headers (memq 'headers gnus-article-wash-types))
          (boring (memq 'boring-headers gnus-article-wash-types))

@@ -5284,8 +5278,8 @@ is the string to use when it is inactive.")
   "Hide unwanted headers if `gnus-have-all-headers' is nil.
 Provided for backwards compatibility."
   (when (and (or (not (gnus-buffer-live-p gnus-summary-buffer))
   "Hide unwanted headers if `gnus-have-all-headers' is nil.
 Provided for backwards compatibility."
   (when (and (or (not (gnus-buffer-live-p gnus-summary-buffer))

-                (not (save-excursion (set-buffer gnus-summary-buffer)
-                                     gnus-have-all-headers)))
+                (not (with-current-buffer gnus-summary-buffer
+                       gnus-have-all-headers)))

             (not gnus-inhibit-hiding))
     (gnus-article-hide-headers)))
 
             (not gnus-inhibit-hiding))
     (gnus-article-hide-headers)))
 

@@ -5745,16 +5739,14 @@ If given a prefix, show the hidden text instead."
                 gnus-summary-buffer
                 (get-buffer gnus-summary-buffer)
                 (gnus-buffer-exists-p gnus-summary-buffer)
                 gnus-summary-buffer
                 (get-buffer gnus-summary-buffer)
                 (gnus-buffer-exists-p gnus-summary-buffer)

-                (eq (cdr (save-excursion
-                           (set-buffer gnus-summary-buffer)
+                (eq (cdr (with-current-buffer gnus-summary-buffer

                            (assq article gnus-newsgroup-reads)))
                     gnus-canceled-mark))
            nil)
           ;; We first check `gnus-original-article-buffer'.
           ((and (get-buffer gnus-original-article-buffer)
                 (numberp article)
                            (assq article gnus-newsgroup-reads)))
                     gnus-canceled-mark))
            nil)
           ;; We first check `gnus-original-article-buffer'.
           ((and (get-buffer gnus-original-article-buffer)
                 (numberp article)

-                (save-excursion
-                  (set-buffer gnus-original-article-buffer)
+                (with-current-buffer gnus-original-article-buffer

                   (and (equal (car gnus-original-article) group)
                        (eq (cdr gnus-original-article) article))))
            (insert-buffer-substring gnus-original-article-buffer)
                   (and (equal (car gnus-original-article) group)
                        (eq (cdr gnus-original-article) article))))
            (insert-buffer-substring gnus-original-article-buffer)

@@ -6813,41 +6805,35 @@ do the highlighting.  See the documentation for those functions."
 (defun gnus-article-highlight-headers ()
   "Highlight article headers as specified by `gnus-header-face-alist'."
   (interactive)
 (defun gnus-article-highlight-headers ()
   "Highlight article headers as specified by `gnus-header-face-alist'."
   (interactive)

-  (save-excursion
-    (set-buffer gnus-article-buffer)
-    (save-restriction
-      (let ((alist gnus-header-face-alist)
-           (buffer-read-only nil)
-           (case-fold-search t)
-           (inhibit-point-motion-hooks t)
-           entry regexp header-face field-face from hpoints fpoints)
-       (article-narrow-to-head)
-       (while (setq entry (pop alist))
-         (goto-char (point-min))
-         (setq regexp (concat "^\\("
-                              (if (string-equal "" (nth 0 entry))
-                                  "[^\t ]"
-                                (nth 0 entry))
-                              "\\)")
-               header-face (nth 1 entry)
-               field-face (nth 2 entry))
-         (while (and (re-search-forward regexp nil t)
-                     (not (eobp)))
-           (beginning-of-line)
-           (setq from (point))
-           (unless (search-forward ":" nil t)
-             (forward-char 1))
-           (when (and header-face
-                      (not (memq (point) hpoints)))
-             (push (point) hpoints)
-             (gnus-put-text-property from (point) 'face header-face))
-           (when (and field-face
-                      (not (memq (setq from (point)) fpoints)))
-             (push from fpoints)
-             (if (re-search-forward "^[^ \t]" nil t)
-                 (forward-char -2)
-               (goto-char (point-max)))
-             (gnus-put-text-property from (point) 'face field-face))))))))
+  (gnus-with-article-headers
+    (let ((alist gnus-header-face-alist)
+         entry regexp header-face field-face from hpoints fpoints)
+      (while (setq entry (pop alist))
+       (goto-char (point-min))
+       (setq regexp (concat "^\\("
+                            (if (string-equal "" (nth 0 entry))
+                                "[^\t ]"
+                              (nth 0 entry))
+                            "\\)")
+             header-face (nth 1 entry)
+             field-face (nth 2 entry))
+       (while (and (re-search-forward regexp nil t)
+                   (not (eobp)))
+         (beginning-of-line)
+         (setq from (point))
+         (unless (search-forward ":" nil t)
+           (forward-char 1))
+         (when (and header-face
+                    (not (memq (point) hpoints)))
+           (push (point) hpoints)
+           (gnus-put-text-property from (point) 'face header-face))
+         (when (and field-face
+                    (not (memq (setq from (point)) fpoints)))
+           (push from fpoints)
+           (if (re-search-forward "^[^ \t]" nil t)
+               (forward-char -2)
+             (goto-char (point-max)))
+           (gnus-put-text-property from (point) 'face field-face)))))))

 
 (defun gnus-article-highlight-signature ()
   "Highlight the signature in an article.
 
 (defun gnus-article-highlight-signature ()
   "Highlight the signature in an article.

@@ -6855,10 +6841,8 @@ It does this by highlighting everything after
 `gnus-signature-separator' using `gnus-signature-face'."
   (interactive)
   (when gnus-signature-face
 `gnus-signature-separator' using `gnus-signature-face'."
   (interactive)
   (when gnus-signature-face

-    (save-excursion
-      (set-buffer gnus-article-buffer)
-      (let ((buffer-read-only nil)
-           (inhibit-point-motion-hooks t))
+    (gnus-with-article-buffer
+      (let ((inhibit-point-motion-hooks t))

        (save-restriction
          (when (gnus-article-narrow-to-signature)
            (gnus-overlay-put (gnus-make-overlay (point-min) (point-max))
        (save-restriction
          (when (gnus-article-narrow-to-signature)
            (gnus-overlay-put (gnus-make-overlay (point-min) (point-max))

@@ -6886,10 +6870,8 @@ It does this by highlighting everything after
 \"External references\" are things like Message-IDs and URLs, as
 specified by `gnus-button-alist'."
   (interactive (list 'force))
 \"External references\" are things like Message-IDs and URLs, as
 specified by `gnus-button-alist'."
   (interactive (list 'force))

-  (save-excursion
-    (set-buffer gnus-article-buffer)
-    (let ((buffer-read-only nil)
-         (inhibit-point-motion-hooks t)
+  (gnus-with-article-buffer
+    (let ((inhibit-point-motion-hooks t)

          (case-fold-search t)
          (alist gnus-button-alist)
          beg entry regexp)
          (case-fold-search t)
          (alist gnus-button-alist)
          beg entry regexp)

@@ -6930,40 +6912,33 @@ specified by `gnus-button-alist'."
 (defun gnus-article-add-buttons-to-head ()
   "Add buttons to the head of the article."
   (interactive)
 (defun gnus-article-add-buttons-to-head ()
   "Add buttons to the head of the article."
   (interactive)

-  (save-excursion
-    (set-buffer gnus-article-buffer)
-    (save-restriction
-      (let ((buffer-read-only nil)
-           (inhibit-point-motion-hooks t)
-           (case-fold-search t)
-           (alist gnus-header-button-alist)
-           entry beg end)
-       (article-narrow-to-head)
-       (while alist
-         ;; Each alist entry.
-         (setq entry (car alist)
-               alist (cdr alist))
-         (goto-char (point-min))
-         (while (re-search-forward (car entry) nil t)
-           ;; Each header matching the entry.
-           (setq beg (match-beginning 0))
-           (setq end (or (and (re-search-forward "^[^ \t]" nil t)
-                              (match-beginning 0))
-                         (point-max)))
-           (goto-char beg)
-           (while (re-search-forward (eval (nth 1 entry)) end t)
-             ;; Each match within a header.
-             (let* ((entry (cdr entry))
-                    (start (match-beginning (nth 1 entry)))
-                    (end (match-end (nth 1 entry)))
-                    (form (nth 2 entry)))
-               (goto-char (match-end 0))
-               (when (eval form)
-                 (gnus-article-add-button
-                  start end (nth 3 entry)
-                  (buffer-substring (match-beginning (nth 4 entry))
-                                    (match-end (nth 4 entry)))))))
-           (goto-char end)))))))
+  (gnus-with-article-headers
+    (let ((alist gnus-header-button-alist)
+         entry beg end)
+      (while alist
+       ;; Each alist entry.
+       (setq entry (pop alist))
+       (goto-char (point-min))
+       (while (re-search-forward (car entry) nil t)
+         ;; Each header matching the entry.
+         (setq beg (match-beginning 0))
+         (setq end (or (and (re-search-forward "^[^ \t]" nil t)
+                            (match-beginning 0))
+                       (point-max)))
+         (goto-char beg)
+         (while (re-search-forward (eval (nth 1 entry)) end t)
+           ;; Each match within a header.
+           (let* ((entry (cdr entry))
+                  (start (match-beginning (nth 1 entry)))
+                  (end (match-end (nth 1 entry)))
+                  (form (nth 2 entry)))
+             (goto-char (match-end 0))
+             (when (eval form)
+               (gnus-article-add-button
+                start end (nth 3 entry)
+                (buffer-substring (match-beginning (nth 4 entry))
+                                  (match-end (nth 4 entry)))))))
+         (goto-char end))))))

 
 ;;; External functions:
 
 
 ;;; External functions:
 

@@ -6986,15 +6961,12 @@ specified by `gnus-button-alist'."
 ;;; Internal functions:
 
 (defun gnus-article-set-globals ()
 ;;; Internal functions:
 
 (defun gnus-article-set-globals ()

-  (save-excursion
-    (set-buffer gnus-summary-buffer)
+  (with-current-buffer gnus-summary-buffer

     (gnus-set-global-variables)))
 
 (defun gnus-signature-toggle (end)
     (gnus-set-global-variables)))
 
 (defun gnus-signature-toggle (end)

-  (save-excursion
-    (set-buffer gnus-article-buffer)
-    (let ((buffer-read-only nil)
-         (inhibit-point-motion-hooks t)
+  (gnus-with-article-buffer
+    (let ((inhibit-point-motion-hooks t)

          (limit (next-single-property-change end 'mime-view-entity
                                              nil (point-max))))
       (if (text-property-any end limit 'article-type 'signature)
          (limit (next-single-property-change end 'mime-view-entity
                                              nil (point-max))))
       (if (text-property-any end limit 'article-type 'signature)

@@ -7132,8 +7104,7 @@ specified by `gnus-button-alist'."
 
 (defun gnus-button-message-id (message-id)
   "Fetch MESSAGE-ID."
 
 (defun gnus-button-message-id (message-id)
   "Fetch MESSAGE-ID."

-  (save-excursion
-    (set-buffer gnus-summary-buffer)
+  (with-current-buffer gnus-summary-buffer

     (gnus-summary-refer-article message-id)))
 
 (defun gnus-button-fetch-group (address)
     (gnus-summary-refer-article message-id)))
 
 (defun gnus-button-fetch-group (address)

diff --git a/lisp/mm-bodies.el b/lisp/mm-bodies.el
index 3475168..68278b4 100644 (file)
--- a/lisp/mm-bodies.el
+++ b/lisp/mm-bodies.el
@@ -26,10 +26,6 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(eval-and-compile
-  (or (fboundp  'base64-decode-region)
-      (require 'base64)))
-

 (eval-when-compile
   (defvar mm-uu-decode-function)
   (defvar mm-uu-binhex-decode-function))
 (eval-when-compile
   (defvar mm-uu-decode-function)
   (defvar mm-uu-binhex-decode-function))

diff --git a/lisp/pop3.el b/lisp/pop3.el
index ef87289..7d120e0 100644 (file)
--- a/lisp/pop3.el
+++ b/lisp/pop3.el
@@ -511,27 +511,6 @@ If NOW, use that time instead."
     (if (not (and response (string-match "+OK" response)))
        (pop3-quit process))))
 
     (if (not (and response (string-match "+OK" response)))
        (pop3-quit process))))
 

-;; When this file is being compiled in the Gnus (not T-gnus) source
-;; tree, `md5' might have been defined in w3/md5.el, ./lpath.el or one
-;; of some other libraries and `md5' will accept only 3 arguments.  We
-;; will deceive the byte-compiler not to say warnings.
-(eval-when-compile
-  (if (boundp 'byte-compile-function-environment)
-      (let ((def (assq 'md5 byte-compile-function-environment)))
-       (if def
-           (setcdr def '(lambda (object &optional start end
-                                        coding-system noerror)))
-         (setq byte-compile-function-environment
-               (cons '(md5 . (lambda (object &optional start end
-                                             coding-system noerror)))
-                     byte-compile-function-environment))))))
-
-;; Note that `pop3-md5' should never encode a given string to use for the
-;; apop authentication, so we should specify the `binary' coding system.
-(eval-and-compile
-  (defalias 'pop3-md5 (lambda (string)
-                       (md5 string nil nil 'binary))))
-

 (defun pop3-apop (process user)
   "Send alternate authentication information to the server."
   (let ((pass pop3-password))
 (defun pop3-apop (process user)
   "Send alternate authentication information to the server."
   (let ((pass pop3-password))

@@ -539,7 +518,9 @@ If NOW, use that time instead."
        (setq pass
              (read-passwd (format "Password for %s: " pop3-maildrop))))
     (if pass
        (setq pass
              (read-passwd (format "Password for %s: " pop3-maildrop))))
     (if pass

-       (let ((hash (pop3-md5 (concat pop3-timestamp pass))))
+       ;; Note that `md5' should never encode a given string to use for
+       ;; the apop authentication, so we should specify `binary'.
+       (let ((hash (md5 (concat pop3-timestamp pass) nil nil 'binary)))

          (pop3-send-command process (format "APOP %s %s" user hash))
          (let ((response (pop3-read-response process t)))
            (if (not (and response (string-match "+OK" response)))
          (pop3-send-command process (format "APOP %s %s" user hash))
          (let ((response (pop3-read-response process t)))
            (if (not (and response (string-match "+OK" response)))

diff --git a/lisp/spam.el b/lisp/spam.el
index 090d880..22c1dcf 100644 (file)
--- a/lisp/spam.el
+++ b/lisp/spam.el
@@ -817,47 +817,64 @@ Respects the process/prefix convention."
 ;;     article-filename
 ;;       nil)))
 
 ;;     article-filename
 ;;       nil)))
 

-(defun spam-fetch-field-fast (article field)
+(defun spam-fetch-field-fast (article field &optional prepared-data-header)

   "Fetch a field quickly, using the internal gnus-data-list function"
   (when (numberp article)
   "Fetch a field quickly, using the internal gnus-data-list function"
   (when (numberp article)

-    (let* ((header (assoc article (gnus-data-list nil)))
-          (data-header (if header (gnus-data-header header) nil)))
-      (cond
-       ((equal field 'from)
-       (mail-header-from data-header))
-       ((equal field 'message-id)
-       (mail-header-message-id data-header))
-       ((equal field 'subject)
-       (mail-header-subject data-header))
-       ((equal field 'references)
-       (mail-header-references data-header))
-       ((equal field 'date)
-       (mail-header-date data-header))
-       ((equal field 'xref)
-       (mail-header-xref data-header))
-       ((equal field 'extra)
-       (mail-header-extra data-header))
-       (t
-       nil)))))
-
-(defun spam-fetch-field-from-fast (article)
-  (spam-fetch-field-fast article 'from))
-
-(defun spam-fetch-field-subject-fast (article)
-  (spam-fetch-field-fast article 'subject))
-
-(defun spam-fetch-field-message-id-fast (article)
-  (spam-fetch-field-fast article 'message-id))
-
-(defun spam-insert-fake-headers (article)
-  (insert (format "From: %s\n" (spam-fetch-field-fast article 'from)))
-  (insert (format "Subject: %s\n" (spam-fetch-field-fast article 'subject)))
-  (insert (format "Message-ID: %s\n" (spam-fetch-field-fast article 'message-id)))
-  (insert (format "Date: %s\n" (spam-fetch-field-fast article 'date)))
-  (insert (format "References: %s\n" (spam-fetch-field-fast article 'references)))
-  (insert (format "Xref: %s\n" (spam-fetch-field-fast article 'xref)))
-  (when (spam-fetch-field-fast article 'extra)
-    (insert (format "%s\n" (spam-fetch-field-fast article 'extra)))))
+    (let* ((data-header (or prepared-data-header
+                           (spam-fetch-article-header article))))
+      (if (arrayp data-header)
+       (cond
+        ((equal field 'from)
+         (mail-header-from data-header))
+        ((equal field 'message-id)
+         (mail-header-message-id data-header))
+        ((equal field 'subject)
+         (mail-header-subject data-header))
+        ((equal field 'references)
+         (mail-header-references data-header))
+        ((equal field 'date)
+         (mail-header-date data-header))
+        ((equal field 'xref)
+         (mail-header-xref data-header))
+        ((equal field 'extra)
+         (mail-header-extra data-header))
+        (t
+         nil))
+       (gnus-error 5 "Article %d has a nil data header" article)))))
+
+(defun spam-fetch-field-from-fast (article &optional prepared-data-header)
+  (spam-fetch-field-fast article 'from prepared-data-header))
+
+(defun spam-fetch-field-subject-fast (article &optional prepared-data-header)
+  (spam-fetch-field-fast article 'subject prepared-data-header))
+
+(defun spam-fetch-field-message-id-fast (article &optional prepared-data-header)
+  (spam-fetch-field-fast article 'message-id prepared-data-header))
+
+(defun spam-generate-fake-headers (article)
+  (let ((dh (spam-fetch-article-header article)))
+    (if dh
+       (concat
+        (format 
+         (concat "From: %s\nSubject: %s\nMessage-ID: %s\n"
+                 "Date: %s\nReferences: %s\nXref: %s\n")
+         (spam-fetch-field-fast article 'from dh)
+         (spam-fetch-field-fast article 'subject dh)
+         (spam-fetch-field-fast article 'message-id dh)
+         (spam-fetch-field-fast article 'date dh)
+         (spam-fetch-field-fast article 'references dh)
+         (spam-fetch-field-fast article 'xref dh))
+        (when (spam-fetch-field-fast article 'extra dh)
+          (format "%s\n" (spam-fetch-field-fast article 'extra dh))))
+      (gnus-error
+       5
+       "spam-generate-fake-headers: article %d didn't have a valid header"
+       article))))
+
+(defun spam-fetch-article-header (article)
+  (save-excursion
+    (set-buffer gnus-summary-buffer)
+    (nth 3 (assq article gnus-newsgroup-data))))

 
 \f
 ;;;; Spam determination.
 
 \f
 ;;;; Spam determination.

@@ -1001,6 +1018,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
 
         (let* ((spam-split-symbolic-return t)
                (spam-split-symbolic-return-positive t)
 
         (let* ((spam-split-symbolic-return t)
                (spam-split-symbolic-return-positive t)

+               (fake-headers (spam-generate-fake-headers article))

                (split-return
                 (or registry-lookup
                     (with-temp-buffer
                (split-return
                 (or registry-lookup
                     (with-temp-buffer

@@ -1008,7 +1026,8 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
                           (gnus-request-article-this-buffer
                            article
                            group)
                           (gnus-request-article-this-buffer
                            article
                            group)

-                        (spam-insert-fake-headers article))
+                        ;; else, we fake the article
+                        (when fake-headers (insert fake-headers)))

                       (if (or (null first-method)
                               (equal first-method 'default))
                           (spam-split)
                       (if (or (null first-method)
                               (equal first-method 'default))
                           (spam-split)

@@ -1927,7 +1946,7 @@ REMOVE not nil, remove the ADDRESSES."
   (add-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit)
   (add-hook 'gnus-summary-prepare-hook 'spam-summary-prepare)
   (add-hook 'gnus-get-new-news-hook 'spam-setup-widening)
   (add-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit)
   (add-hook 'gnus-summary-prepare-hook 'spam-summary-prepare)
   (add-hook 'gnus-get-new-news-hook 'spam-setup-widening)

-  (add-hook 'gnus-summary-prepare-hook 'spam-find-spam))
+  (add-hook 'gnus-summary-prepared-hook 'spam-find-spam))

 
 (defun spam-unload-hook ()
   "Uninstall the spam.el hooks"
 
 (defun spam-unload-hook ()
   "Uninstall the spam.el hooks"