Mercurial > emacs
changeset 80591:ffc29d3b77cb
Merge from gnus--rel--5.10
Revision: emacs@sv.gnu.org/emacs--rel--22--patch-272
| author | Miles Bader <miles@gnu.org> |
|---|---|
| date | Mon, 26 May 2008 07:03:02 +0000 |
| parents | 3c39bed710aa |
| children | 8436412d2e08 |
| files | lisp/gnus/ChangeLog lisp/gnus/gnus-art.el lisp/gnus/gnus-registry.el |
| diffstat | 3 files changed, 91 insertions(+), 21 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/gnus/ChangeLog Sun May 25 20:09:05 2008 +0000 +++ b/lisp/gnus/ChangeLog Mon May 26 07:03:02 2008 +0000 @@ -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'.
--- a/lisp/gnus/gnus-art.el Sun May 25 20:09:05 2008 +0000 +++ b/lisp/gnus/gnus-art.el Mon May 26 07:03:02 2008 +0000 @@ -6668,13 +6668,10 @@ ;; 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 @@ (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 @@ (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))
--- a/lisp/gnus/gnus-registry.el Sun May 25 20:09:05 2008 +0000 +++ b/lisp/gnus/gnus-registry.el Mon May 26 07:03:02 2008 +0000 @@ -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.