emacs: lisp/gnus/gnus-art.el comparison

comparison lisp/gnus/gnus-art.el @ 112372:539ff9c0e704

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.

author	Katsumi Yamaoka <yamaoka@jpl.org>
date	Wed, 19 Jan 2011 22:22:18 +0000
parents	c24551a0cd95
children	f279fb6c0f32

comparison

equal deleted inserted replaced

-:1a3d4c7ba327
+:539ff9c0e704
 (when gnus-summary-tool-bar-map
 (set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map)))
 (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)
 (make-local-variable 'gnus-article-mime-handle-alist)
 (make-local-variable 'gnus-article-wash-types)
 (setq buffer-read-only t
 	show-trailing-whitespace nil)
 (set-syntax-table gnus-article-mode-syntax-table)
 (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*"
 		 (concat "*Article " gnus-newsgroup-name "*")))
 	    (setq gnus-article-mime-handles nil))
 	  ;; Set it to nil in article-buffer!
 	  (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)
 	  (current-buffer))
 (with-current-buffer (gnus-get-buffer-create name)
 (defun gnus-button-in-region-p (b e prop)
 "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))
 (while (setq entry (pop alist))
 	(setq regexp (eval (car entry)))
 	(goto-char beg)
 	(while (re-search-forward regexp nil t)
 	  (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))
+	    (when (and (eval (nth 2 entry))
-			   (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
 			       start end))))))))))
 	 (cons 'article-type (cons 'signature
 				   gnus-hidden-properties)))))
 (let ((gnus-article-mime-handle-alist-1 gnus-article-mime-handle-alist))
 (gnus-set-mode-line 'article))))
-(defun gnus-button-entry ()
+(defun gnus-button-push (marker-and-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)
 ;; Push button starting at MARKER.
 (save-excursion
-(goto-char marker)
+(let* ((marker (car marker-and-entry))
-(let* ((entry (gnus-button-entry))
+(entry (cadr marker-and-entry))
-	   (inhibit-point-motion-hooks t)
+(regexp (car entry))
-	   (fun (nth 3 entry))
+(inhibit-point-motion-hooks t))
-	   (args (or (and (eq (car entry) 'gnus-button-url-regexp)
+(goto-char marker)
-			  (get-char-property marker 'gnus-button-url))
+;; This is obviously true, or something bad is happening :)
-		     (mapcar (lambda (group)
+;; But we need it to have the match-data
-			       (let ((string (match-string group)))
+(when (looking-at (or (if (symbolp regexp)
-				 (set-text-properties
+(symbol-value regexp)
-				  0 (length string) nil string)
+regexp)))
-				 string))
+(let ((fun (nth 3 entry))
-			     (nthcdr 4 entry)))))
+(args (or (and (eq (car entry) 'gnus-button-url-regexp)
-(cond
+(get-char-property marker 'gnus-button-url))
-((fboundp fun)
+(mapcar (lambda (group)
-	(apply fun args))
+(let ((string (match-string group)))
-((and (boundp fun)
+(set-text-properties
-	     (fboundp (symbol-value fun)))
+0 (length string) nil string)
-	(apply (symbol-value fun) args))
+string))
-(t
+(nthcdr 4 entry)))))
-	(gnus-message 1 "You must define `%S' to use this button"
-		      (cons fun args)))))))
+(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)
 (with-temp-buffer
 (insert url)

Mercurial > emacs

comparison lisp/gnus/gnus-art.el @ 112372:539ff9c0e704