Merge from gnus--rel--5.10

Revision: emacs@sv.gnu.org/emacs--rel--22--patch-272

3 files changed, 91 insertions, 21 deletions

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index d934d6c2c2e..d4b770287e3 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,15 @@
+2008-05-25  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+	* gnus-art.el (gnus-button-alist): Exclude newline in RFC2396-compliant
+	url pattern; remove duplicate one.
+	(gnus-article-extend-url-button): New function.
+	(gnus-article-add-buttons): Use it.
+	(gnus-button-push): Use concatenated url that it makes.
+
+2008-05-07  Teodor Zlatanov  <tzz@lifelogs.com>
+
+	* gnus-registry.el: Adjusted copyright dates and added a keyword.
+
 2008-04-24  Luca Capello  <luca@pca.it>  (tiny change)
 
 	* mm-encode.el (mm-safer-encoding): Add optional argument `type'.
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index d509fd414f7..742532b0c5e 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -6668,13 +6668,10 @@ positives are possible."
      ;; here to determine where it ends.
      1 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-key 3)
     ;; This is how URLs _should_ be embedded in text (RFC 1738, RFC 2396)...
-    ("<URL: *\\([^<>]*\\)>"
+    ("<URL: *\\([^\n<>]*\\)>"
      1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1)
     ;; RFC 2396 (2.4.3., delims) ...
-    ("\"URL: *\\([^\"]*\\)\""
-     1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1)
-    ;; RFC 2396 (2.4.3., delims) ...
-    ("\"URL: *\\([^\"]*\\)\""
+    ("\"URL: *\\([^\n\"]*\\)\""
      1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1)
     ;; Raw URLs.
     (gnus-button-url-regexp
@@ -6902,19 +6899,79 @@ specified by `gnus-button-alist'."
 	(setq regexp (eval (car entry)))
 	(goto-char beg)
 	(while (re-search-forward regexp nil t)
-	  (let* ((start (and entry (match-beginning (nth 1 entry))))
-		 (end (and entry (match-end (nth 1 entry))))
-		 (from (match-beginning 0)))
+	  (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)))
 		       (not (gnus-button-in-region-p
 			     start end 'gnus-callback)))
 	      ;; That optional form returned non-nil, so we add the
 	      ;; button.
-	      (gnus-article-add-button
-	       start end 'gnus-button-push
-	       (car (push (set-marker (make-marker) from)
-			  gnus-button-marker-list))))))))))
+	      (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)))))))))
+
+(defun gnus-article-extend-url-button (beg start end)
+  "Extend url button if url is folded into two or more lines.
+Return non-nil if button is extended.  BEG is a marker that points to
+the beginning position of a text containing url.  START and END are
+the endpoints of a url button before it is extended.  The concatenated
+url is put as the `gnus-button-url' overlay property on the button."
+  (let ((opoint (point))
+	(points (list start end))
+	url delim regexp)
+    (prog1
+	(when (and (progn
+		     (goto-char end)
+		     (not (looking-at "[\t ]*[\">]")))
+		   (progn
+		     (goto-char start)
+		     (string-match
+		      "\\(?:\"\\|\\(<\\)\\)[\t ]*\\(?:url[\t ]*:[\t ]*\\)?\\'"
+		      (buffer-substring (point-at-bol) start)))
+		   (progn
+		     (setq url (list (buffer-substring start end))
+			   delim (if (match-beginning 1) ">" "\""))
+		     (beginning-of-line)
+		     (setq regexp (concat
+				   (when (and (looking-at
+					       message-cite-prefix-regexp)
+					      (< (match-end 0) start))
+				     (regexp-quote (match-string 0)))
+				   "\
+\[\t ]*\\(?:\\([^\t\n \">]+\\)[\t ]*$\\|\\([^\t\n \">]*\\)[\t ]*"
+				   delim "\\)"))
+		     (while (progn
+			      (forward-line 1)
+			      (and (looking-at regexp)
+				   (prog1
+				       (match-beginning 1)
+				     (push (or (match-string 2)
+					       (match-string 1))
+					   url)
+				     (push (setq end (or (match-end 2)
+							 (match-end 1)))
+					   points)
+				     (push (or (match-beginning 2)
+					       (match-beginning 1))
+					   points)))))
+		     (match-beginning 2)))
+	  (let (gnus-article-mouse-face widget-mouse-face)
+	    (while points
+	      (gnus-article-add-button (pop points) (pop points)
+				       'gnus-button-push beg)))
+	  (let ((overlay (gnus-make-overlay start end)))
+	    (gnus-overlay-put overlay 'evaporate t)
+	    (gnus-overlay-put overlay 'gnus-button-url
+			      (list (mapconcat 'identity (nreverse url) "")))
+	    (when gnus-article-mouse-face
+	      (gnus-overlay-put overlay 'mouse-face gnus-article-mouse-face)))
+	  t)
+      (goto-char opoint))))
 
 ;; Add buttons to the head of an article.
 (defun gnus-article-add-buttons-to-head ()
@@ -7016,12 +7073,14 @@ specified by `gnus-button-alist'."
     (let* ((entry (gnus-button-entry))
 	   (inhibit-point-motion-hooks t)
 	   (fun (nth 3 entry))
-	   (args (mapcar (lambda (group)
-			   (let ((string (match-string group)))
-			     (gnus-set-text-properties
-			      0 (length string) nil string)
-			     string))
-			 (nthcdr 4 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))
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el
index 11c5e3624d5..903676e1a9b 100644
--- a/lisp/gnus/gnus-registry.el
+++ b/lisp/gnus/gnus-registry.el
@@ -1,10 +1,9 @@
 ;;; gnus-registry.el --- article registry for Gnus
 
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
 
 ;; Author: Ted Zlatanov <tzz@lifelogs.com>
-;; Keywords: news
+;; Keywords: news registry
 
 ;; This file is part of GNU Emacs.