Function: gnus-article-extend-url-button

gnus-article-extend-url-button is a byte-compiled function defined in gnus-art.el.gz.

Signature

(gnus-article-extend-url-button BEG START END)

Documentation

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.

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/gnus-art.el.gz
(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 (line-beginning-position) 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)
	    (while points
	      (gnus-article-add-button (pop points) (pop points)
				       'gnus-button-push
				       (list beg (assq 'gnus-button-url-regexp
						       gnus-button-alist)))))
	  (let ((overlay (make-overlay start end)))
	    (overlay-put overlay 'evaporate t)
	    (overlay-put overlay 'gnus-button-url
			 (list (mapconcat #'identity (nreverse url) "")))
	    (when gnus-article-mouse-face
	      (overlay-put overlay 'mouse-face gnus-article-mouse-face)))
	  t)
      (goto-char opoint))))