Commit c9087628 authored by Miles Bader's avatar Miles Bader
Browse files

Merge from gnus--rel--5.10

parent 16cf244e
2008-05-25 Katsumi Yamaoka <>
* 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 <>
* gnus-registry.el: Adjusted copyright dates and added a keyword.
2008-04-24 Luca Capello <> (tiny change)
* mm-encode.el (mm-safer-encoding): Add optional argument `type'.
......@@ -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.
......@@ -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.
start end 'gnus-button-push
(car (push (set-marker (make-marker) from)
(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)
(when (and (progn
(goto-char end)
(not (looking-at "[\t ]*[\">]")))
(goto-char start)
"\\(?:\"\\|\\(<\\)\\)[\t ]*\\(?:url[\t ]*:[\t ]*\\)?\\'"
(buffer-substring (point-at-bol) start)))
(setq url (list (buffer-substring start end))
delim (if (match-beginning 1) ">" "\""))
(setq regexp (concat
(when (and (looking-at
(< (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)
(match-beginning 1)
(push (or (match-string 2)
(match-string 1))
(push (setq end (or (match-end 2)
(match-end 1)))
(push (or (match-beginning 2)
(match-beginning 1))
(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)))
(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)))
0 (length string) nil 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)))
0 (length string) nil string)
(nthcdr 4 entry)))))
((fboundp fun)
(apply fun args))
;;; 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 <>
;; Keywords: news
;; Keywords: news registry
;; This file is part of GNU Emacs.
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment