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.