mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-01-18 18:05:07 +00:00
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.
This commit is contained in:
parent
8beb828a0b
commit
672022e7fb
@ -1,3 +1,15 @@
|
||||
2011-01-19 Tom Rauchenwald <sehnsucht.nach.unendlichkeit@quantentunnel.de> (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 <julien@danjou.info>
|
||||
|
||||
* 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 <rgm@gnu.org>
|
||||
|
||||
* message.el (message-mail): A compose-mail function should
|
||||
|
@ -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)
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user