+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
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 <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)
- (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 -----
(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 <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)
- (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)
(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)
"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)))
(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)
(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)
(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-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
(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))
"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)))
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)
(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.
`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))
\"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)
(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:
;;; 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)
(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)
;;; 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))
(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))
(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)))
;; 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))))
\f
;;;; Spam determination.
(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
(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)
(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"
projects / elisp / gnus.git- / commitdiff