From 672022e7fb15d230475b97e72c09b43c1ac10555 Mon Sep 17 00:00:00 2001 From: Gnus developers Date: Wed, 19 Jan 2011 22:22:18 +0000 Subject: [PATCH] gnus-art.el (gnus-article-add-buttons): Simplify condition. (gnus-button-push): Remove gnus-button-entry function, it fails heavily if you have the same regexp several times. (gnus-button-push): Fix matching when regexp is symbol. spam.el (spam-spamassassin-register-with-sa-learn): Insert a full From header with a date and "nobody" as the sender. --- lisp/gnus/ChangeLog | 12 +++++++ lisp/gnus/gnus-art.el | 92 +++++++++++++++++++-------------------------------- lisp/gnus/spam.el | 5 ++- 3 files changed, 48 insertions(+), 61 deletions(-) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index b3d9ac82a9e..128e4bf024e 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,15 @@ +2011-01-19 Tom Rauchenwald (tiny change) + + * spam.el (spam-spamassassin-register-with-sa-learn): Insert a full + From header with a date and "nobody" as the sender. + +2011-01-19 Julien Danjou + + * gnus-art.el (gnus-article-add-buttons): Simplify condition. + (gnus-button-push): Remove gnus-button-entry function, it fails heavily + if you have the same regexp several times. + (gnus-button-push): Fix matching when regexp is symbol. + 2011-01-15 Glenn Morris * message.el (message-mail): A compose-mail function should diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 36944267ad2..7c56acfebd4 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -4413,7 +4413,6 @@ commands: (gnus-update-format-specifications nil 'article-mode) (set (make-local-variable 'page-delimiter) gnus-page-delimiter) (set (make-local-variable 'gnus-page-broken) nil) - (make-local-variable 'gnus-button-marker-list) (make-local-variable 'gnus-article-current-summary) (make-local-variable 'gnus-article-mime-handles) (make-local-variable 'gnus-article-decoded-p) @@ -4436,10 +4435,6 @@ commands: (mm-enable-multibyte) (gnus-run-mode-hooks 'gnus-article-mode-hook)) -(defvar gnus-button-marker-list nil - "Regexp matching any of the regexps from `gnus-button-alist'. -Internal variable.") - (defun gnus-article-setup-buffer () "Initialize the article buffer." (let* ((name (if gnus-single-article-buffer "*Article*" @@ -4483,8 +4478,6 @@ Internal variable.") (setq gnus-article-mime-handle-alist nil) (buffer-disable-undo) (setq buffer-read-only t) - ;; This list just keeps growing if we don't reset it. - (setq gnus-button-marker-list nil) (unless (eq major-mode 'gnus-article-mode) (gnus-article-mode)) (setq truncate-lines gnus-article-truncate-lines) @@ -7726,28 +7719,16 @@ It does this by highlighting everything after "Say whether PROP exists in the region." (text-property-not-all b e prop nil)) -(defun gnus-article-add-buttons (&optional force) +(defun gnus-article-add-buttons () "Find external references in the article and make buttons of them. \"External references\" are things like Message-IDs and URLs, as specified by `gnus-button-alist'." - (interactive (list 'force)) + (interactive) (gnus-with-article-buffer (let ((inhibit-point-motion-hooks t) (case-fold-search t) (alist gnus-button-alist) beg entry regexp) - ;; Remove all old markers. - (let (marker entry new-list) - (while (setq marker (pop gnus-button-marker-list)) - (if (or (< marker (point-min)) (>= marker (point-max))) - (push marker new-list) - (goto-char marker) - (when (setq entry (gnus-button-entry)) - (put-text-property (match-beginning (nth 1 entry)) - (match-end (nth 1 entry)) - 'gnus-callback nil)) - (set-marker marker nil))) - (setq gnus-button-marker-list new-list)) ;; We skip the headers. (article-goto-body) (setq beg (point)) @@ -7758,18 +7739,16 @@ specified by `gnus-button-alist'." (let ((start (match-beginning (nth 1 entry))) (end (match-end (nth 1 entry))) (from (match-beginning 0))) - (when (and (or (eq t (nth 2 entry)) - (eval (nth 2 entry))) + (when (and (eval (nth 2 entry)) (not (gnus-button-in-region-p start end 'gnus-callback))) ;; That optional form returned non-nil, so we add the ;; button. (setq from (set-marker (make-marker) from)) - (push from gnus-button-marker-list) (unless (and (eq (car entry) 'gnus-button-url-regexp) (gnus-article-extend-url-button from start end)) (gnus-article-add-button start end - 'gnus-button-push from) + 'gnus-button-push (list from entry)) (gnus-put-text-property start end 'gnus-string (buffer-substring-no-properties @@ -7916,41 +7895,38 @@ url is put as the `gnus-button-url' overlay property on the button." (let ((gnus-article-mime-handle-alist-1 gnus-article-mime-handle-alist)) (gnus-set-mode-line 'article)))) -(defun gnus-button-entry () - ;; Return the first entry in `gnus-button-alist' matching this place. - (let ((alist gnus-button-alist) - (entry nil)) - (while alist - (setq entry (pop alist)) - (if (looking-at (eval (car entry))) - (setq alist nil) - (setq entry nil))) - entry)) - -(defun gnus-button-push (marker) +(defun gnus-button-push (marker-and-entry) ;; Push button starting at MARKER. (save-excursion - (goto-char marker) - (let* ((entry (gnus-button-entry)) - (inhibit-point-motion-hooks t) - (fun (nth 3 entry)) - (args (or (and (eq (car entry) 'gnus-button-url-regexp) - (get-char-property marker 'gnus-button-url)) - (mapcar (lambda (group) - (let ((string (match-string group))) - (set-text-properties - 0 (length string) nil string) - string)) - (nthcdr 4 entry))))) - (cond - ((fboundp fun) - (apply fun args)) - ((and (boundp fun) - (fboundp (symbol-value fun))) - (apply (symbol-value fun) args)) - (t - (gnus-message 1 "You must define `%S' to use this button" - (cons fun args))))))) + (let* ((marker (car marker-and-entry)) + (entry (cadr marker-and-entry)) + (regexp (car entry)) + (inhibit-point-motion-hooks t)) + (goto-char marker) + ;; This is obviously true, or something bad is happening :) + ;; But we need it to have the match-data + (when (looking-at (or (if (symbolp regexp) + (symbol-value regexp) + regexp))) + (let ((fun (nth 3 entry)) + (args (or (and (eq (car entry) 'gnus-button-url-regexp) + (get-char-property marker 'gnus-button-url)) + (mapcar (lambda (group) + (let ((string (match-string group))) + (set-text-properties + 0 (length string) nil string) + string)) + (nthcdr 4 entry))))) + + (cond + ((fboundp fun) + (apply fun args)) + ((and (boundp fun) + (fboundp (symbol-value fun))) + (apply (symbol-value fun) args)) + (t + (gnus-message 1 "You must define `%S' to use this button" + (cons fun args))))))))) (defun gnus-parse-news-url (url) (let (scheme server port group message-id articles) diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el index 194668e8dc8..3bce27625d0 100644 --- a/lisp/gnus/spam.el +++ b/lisp/gnus/spam.el @@ -2726,9 +2726,8 @@ With a non-nil REMOVE, remove the ADDRESSES." (with-current-buffer summary-buffer-name (setq article-string (spam-get-article-as-string article))) (when (stringp article-string) - (insert "From \n") ; mbox separator (sa-learn only checks the - ; first five chars, so we can get away with - ; a bogus line)) + ;; mbox separator + (insert (concat "From nobody " (current-time-string) "\n")) (insert article-string) (insert "\n")))) ;; call sa-learn on all messages at the same time -- 2.11.4.GIT