From: yamaoka Date: Sat, 10 Jan 2004 02:23:11 +0000 (+0000) Subject: Synch to No Gnus 200401092242. X-Git-Tag: t-gnus-6_17_4-quimby-~1145 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;ds=sidebyside;h=ec6bccad2a77180e2aa0676ce6f72677eb13aa84;p=elisp%2Fgnus.git- Synch to No Gnus 200401092242. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 137284c..abc709c 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,56 @@ +2004-01-09 Jesper Harder + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 * canlock.el (canlock-insert-header): Remove excessive grouping in diff --git a/lisp/deuglify.el b/lisp/deuglify.el index ef10ac4..42c7514 100644 --- 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") - (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) - (let ((len12 (- (match-end 2) (match-beginning 1))) + (let ((len12 (- (match-end 2) (match-beginning 1))) (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." - (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 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) - (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 ----- @@ -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." - (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) - (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 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) - (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) diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 3868945..84d47b8 100644 --- 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) - (save-excursion - (set-buffer gnus-article-buffer) + (gnus-with-article-buffer (let ((inhibit-point-motion-hooks t) - buffer-read-only (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) @@ -2652,11 +2650,9 @@ always hide." "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) - (let* ((buffer-read-only nil) - (start (point)) + (let* ((start (point)) (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 - (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) @@ -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 - (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) @@ -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) - (save-excursion - (set-buffer gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer 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 - (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 @@ -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." - (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)) @@ -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)) - (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))) @@ -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) - (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) - (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) @@ -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) - (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. @@ -6855,10 +6841,8 @@ It does this by highlighting everything after `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)) @@ -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)) - (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) @@ -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) - (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: @@ -6986,15 +6961,12 @@ specified by `gnus-button-alist'." ;;; 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) - (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) @@ -7132,8 +7104,7 @@ specified by `gnus-button-alist'." (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) diff --git a/lisp/mm-bodies.el b/lisp/mm-bodies.el index 3475168..68278b4 100644 --- a/lisp/mm-bodies.el +++ b/lisp/mm-bodies.el @@ -26,10 +26,6 @@ ;;; 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)) diff --git a/lisp/pop3.el b/lisp/pop3.el index ef87289..7d120e0 100644 --- 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)))) -;; 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)) @@ -539,7 +518,9 @@ If NOW, use that time instead." (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))) diff --git a/lisp/spam.el b/lisp/spam.el index 090d880..22c1dcf 100644 --- a/lisp/spam.el +++ b/lisp/spam.el @@ -817,47 +817,64 @@ Respects the process/prefix convention." ;; 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) - (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)))) ;;;; 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) + (fake-headers (spam-generate-fake-headers article)) (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) - (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) @@ -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-hook 'spam-find-spam)) + (add-hook 'gnus-summary-prepared-hook 'spam-find-spam)) (defun spam-unload-hook () "Uninstall the spam.el hooks"