[Emacs-diffs] /srv/bzr/emacs/trunk r102906: gnus-art.el (gnus-article-add-buttons): Simplify condition.

[Katsumi Yamaoka]

------------------------------------------------------------
revno: 102906
author: Gnus developers <address@hidden>
committer: Katsumi Yamaoka <address@hidden>
branch nick: trunk
timestamp: Wed 2011-01-19 22:22:18 +0000
message:
  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.
modified:
  lisp/gnus/ChangeLog
  lisp/gnus/gnus-art.el
  lisp/gnus/spam.el

=== modified file 'lisp/gnus/ChangeLog'
--- a/lisp/gnus/ChangeLog       2011-01-16 02:21:30 +0000
+++ b/lisp/gnus/ChangeLog       2011-01-19 22:22:18 +0000
@@ -1,3 +1,15 @@
+2011-01-19  Tom Rauchenwald  <address@hidden>  (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  <address@hidden>
+
+       * 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  <address@hidden>
 
        * message.el (message-mail): A compose-mail function should

=== modified file 'lisp/gnus/gnus-art.el'
--- a/lisp/gnus/gnus-art.el     2011-01-14 17:18:41 +0000
+++ b/lisp/gnus/gnus-art.el     2011-01-19 22:22:18 +0000
@@ -4413,7 +4413,6 @@
   (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 @@
   (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 @@
          (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 @@
   "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 @@
          (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 @@
     (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)

=== modified file 'lisp/gnus/spam.el'
--- a/lisp/gnus/spam.el 2011-01-14 17:18:41 +0000
+++ b/lisp/gnus/spam.el 2011-01-19 22:22:18 +0000
@@ -2726,9 +2726,8 @@
               (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