[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 3a7894e: Improve shr/eww handling of mailto URLs
From: |
Basil L. Contovounesios |
Subject: |
master 3a7894e: Improve shr/eww handling of mailto URLs |
Date: |
Fri, 22 May 2020 11:42:40 -0400 (EDT) |
branch: master
commit 3a7894ecd11c66337e7aea8ade8f47673d290a24
Author: Basil L. Contovounesios <address@hidden>
Commit: Basil L. Contovounesios <address@hidden>
Improve shr/eww handling of mailto URLs
* lisp/net/eww.el (eww): Use function-put in place of put, as
recommended in "(elisp) Symbol Plists".
(eww-follow-link):
* lisp/net/shr.el (shr-browse-url): Rather than call browse-url-mail
directly, call browse-url which respects the user options
browse-url-handlers and browse-url-mailto-function. (Bug#41133)
(shr--current-link-region): Return nil if there is no link at point.
(shr--blink-link): Adapt accordingly.
(shr-fill-line, shr-indent, shr-table-body): Refactor to avoid some
unnecessary allocations.
* etc/NEWS: Announce that eww-follow-link and shr-browse-url support
custom URL handlers.
---
etc/NEWS | 18 +++++++++++++
lisp/net/eww.el | 30 +++++++++++----------
lisp/net/shr.el | 84 +++++++++++++++++++++++++--------------------------------
3 files changed, 70 insertions(+), 62 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index 4533dc4..eb73bd6 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -356,6 +356,24 @@ symbol property to the browsing functions. With a new
command
'browse-url-with-browser-kind', an URL can explicitly be browsed with
either an internal or external browser.
+** SHR
+
+---
+*** The command 'shr-browse-url' now supports custom mailto handlers.
+Clicking on or otherwise following a 'mailto:' link in a HTML buffer
+rendered by SHR previously invoked the command 'browse-url-mailto'.
+This is still the case by default, but if you customize
+'browse-url-mailto-function' or 'browse-url-handlers' to call some
+other function, it will now be called instead of the default.
+
+** EWW
+
+---
+*** The command 'eww-follow-link' now supports custom mailto handlers.
+The function that is invoked when clicking on or otherwise following a
+'mailto:' link in an EWW buffer can now be customized. For more
+information, see the related entry about 'shr-browse-url' above.
+
** Project
*** New user option 'project-vc-merge-submodules'.
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index a6c1abd..2a70560 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -307,10 +307,10 @@ the default EWW buffer."
(insert (format "Loading %s..." url))
(goto-char (point-min)))
(let ((url-mime-accept-string eww-accept-content-types))
- (url-retrieve url 'eww-render
+ (url-retrieve url #'eww-render
(list url nil (current-buffer)))))
-(put 'eww 'browse-url-browser-kind 'internal)
+(function-put 'eww 'browse-url-browser-kind 'internal)
(defun eww--dwim-expand-url (url)
(setq url (string-trim url))
@@ -375,8 +375,8 @@ engine used."
(let ((region-string (buffer-substring (region-beginning) (region-end))))
(if (not (string-match-p "\\`[ \n\t\r\v\f]*\\'" region-string))
(eww region-string)
- (call-interactively 'eww)))
- (call-interactively 'eww)))
+ (call-interactively #'eww)))
+ (call-interactively #'eww)))
(defun eww-open-in-new-buffer ()
"Fetch link at point in a new EWW buffer."
@@ -1013,7 +1013,7 @@ just re-display the HTML already fetched."
(eww-display-html 'utf-8 url (plist-get eww-data :dom)
(point) (current-buffer)))
(let ((url-mime-accept-string eww-accept-content-types))
- (url-retrieve url 'eww-render
+ (url-retrieve url #'eww-render
(list url (point) (current-buffer) encode))))))
;; Form support.
@@ -1576,8 +1576,10 @@ If EXTERNAL is double prefix, browse in new buffer."
(cond
((not url)
(message "No link under point"))
- ((string-match "^mailto:" url)
- (browse-url-mail url))
+ ((string-match-p "\\`mailto:" url)
+ ;; This respects the user options `browse-url-handlers'
+ ;; and `browse-url-mailto-function'.
+ (browse-url url))
((and (consp external) (<= (car external) 4))
(funcall browse-url-secondary-browser-function url)
(shr--blink-link))
@@ -1615,7 +1617,7 @@ Use link at point if there is one, else the current
page's URL."
(eww-current-url))))
(if (not url)
(message "No URL under point")
- (url-retrieve url 'eww-download-callback (list url)))))
+ (url-retrieve url #'eww-download-callback (list url)))))
(defun eww-download-callback (status url)
(unless (plist-get status :error)
@@ -2128,12 +2130,12 @@ entries (if any) will be removed from the list.
Only the properties listed in `eww-desktop-data-save' are included.
Generally, the list should not include the (usually overly large)
:dom, :source and :text properties."
- (let ((history (mapcar 'eww-desktop-data-1
- (cons eww-data eww-history))))
- (list :history (if eww-desktop-remove-duplicates
- (cl-remove-duplicates
- history :test 'eww-desktop-history-duplicate)
- history))))
+ (let ((history (mapcar #'eww-desktop-data-1
+ (cons eww-data eww-history))))
+ (list :history (if eww-desktop-remove-duplicates
+ (cl-remove-duplicates
+ history :test #'eww-desktop-history-duplicate)
+ history))))
(defun eww-restore-desktop (file-name buffer-name misc-data)
"Restore an eww buffer from its desktop file record.
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 1f80ab7..03260c9 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -135,7 +135,7 @@ same domain as the main data."
This is used for cid: URLs, and the function is called with the
cid: URL as the argument.")
-(defvar shr-put-image-function 'shr-put-image
+(defvar shr-put-image-function #'shr-put-image
"Function called to put image and alt string.")
(defface shr-strike-through '((t :strike-through t))
@@ -365,25 +365,20 @@ If the URL is already at the front of the kill ring act
like
(shr-copy-url url)))
(defun shr--current-link-region ()
- (let ((current (get-text-property (point) 'shr-url))
- start)
- (save-excursion
- ;; Go to the beginning.
- (while (and (not (bobp))
- (equal (get-text-property (point) 'shr-url) current))
- (forward-char -1))
- (unless (equal (get-text-property (point) 'shr-url) current)
- (forward-char 1))
- (setq start (point))
- ;; Go to the end.
- (while (and (not (eobp))
- (equal (get-text-property (point) 'shr-url) current))
- (forward-char 1))
- (list start (point)))))
+ "Return the start and end positions of the URL at point, if any.
+Value is a pair of positions (START . END) if there is a non-nil
+`shr-url' text property at point; otherwise nil."
+ (when (get-text-property (point) 'shr-url)
+ (let* ((end (or (next-single-property-change (point) 'shr-url)
+ (point-max)))
+ (beg (or (previous-single-property-change end 'shr-url)
+ (point-min))))
+ (cons beg end))))
(defun shr--blink-link ()
- (let* ((region (shr--current-link-region))
- (overlay (make-overlay (car region) (cadr region))))
+ "Briefly fontify URL at point with the face `shr-selected-link'."
+ (when-let* ((region (shr--current-link-region))
+ (overlay (make-overlay (car region) (cdr region))))
(overlay-put overlay 'face 'shr-selected-link)
(run-at-time 1 nil (lambda ()
(delete-overlay overlay)))))
@@ -437,7 +432,7 @@ the URL of the image to the kill buffer instead."
(if (not url)
(message "No image under point")
(message "Inserting %s..." url)
- (url-retrieve url 'shr-image-fetched
+ (url-retrieve url #'shr-image-fetched
(list (current-buffer) (1- (point)) (point-marker))
t))))
@@ -463,7 +458,7 @@ size, and full-buffer size."
(when (> (- (point) start) 2)
(delete-region start (1- (point)))))
(message "Inserting %s..." url)
- (url-retrieve url 'shr-image-fetched
+ (url-retrieve url #'shr-image-fetched
(list (current-buffer) (1- (point)) (point-marker)
(list (cons 'size
(cond ((or (eq size 'default)
@@ -493,7 +488,7 @@ size, and full-buffer size."
((fboundp function)
(apply function dom args))
(t
- (apply 'shr-generic dom args)))))
+ (apply #'shr-generic dom args)))))
(defun shr-descend (dom)
(let ((function
@@ -730,9 +725,10 @@ size, and full-buffer size."
(let ((gap-start (point))
(face (get-text-property (point) 'face)))
;; Extend the background to the end of the line.
- (if face
- (insert (propertize "\n" 'face (shr-face-background face)))
- (insert "\n"))
+ (insert ?\n)
+ (when face
+ (put-text-property (1- (point)) (point)
+ 'face (shr-face-background face)))
(shr-indent)
(when (and (> (1- gap-start) (point-min))
(get-text-property (point) 'shr-url)
@@ -935,12 +931,11 @@ size, and full-buffer size."
(defun shr-indent ()
(when (> shr-indentation 0)
- (insert
- (if (not shr-use-fonts)
- (make-string shr-indentation ?\s)
- (propertize " "
- 'display
- `(space :width (,shr-indentation)))))))
+ (if (not shr-use-fonts)
+ (insert-char ?\s shr-indentation)
+ (insert ?\s)
+ (put-text-property (1- (point)) (point)
+ 'display `(space :width (,shr-indentation))))))
(defun shr-fontize-dom (dom &rest types)
(let ((start (point)))
@@ -987,16 +982,11 @@ the mouse click event."
(cond
((not url)
(message "No link under point"))
- ((string-match "^mailto:" url)
- (browse-url-mail url))
+ (external
+ (funcall browse-url-secondary-browser-function url)
+ (shr--blink-link))
(t
- (if external
- (progn
- (funcall browse-url-secondary-browser-function url)
- (shr--blink-link))
- (browse-url url (if new-window
- (not browse-url-new-window-flag)
- browse-url-new-window-flag)))))))
+ (browse-url url (xor new-window browse-url-new-window-flag))))))
(defun shr-save-contents (directory)
"Save the contents from URL in a file."
@@ -1005,7 +995,7 @@ the mouse click event."
(if (not url)
(message "No link under point")
(url-retrieve (shr-encode-url url)
- 'shr-store-contents (list url directory)))))
+ #'shr-store-contents (list url directory)))))
(defun shr-store-contents (status url directory)
(unless (plist-get status :error)
@@ -1156,7 +1146,6 @@ width/height instead."
;; url-cache-extract autoloads url-cache.
(declare-function url-cache-create-filename "url-cache" (url))
-(autoload 'browse-url-mail "browse-url")
(defun shr-get-image-data (url)
"Get image data for URL.
@@ -1230,7 +1219,7 @@ START, and END. Note that START and END should be
markers."
(funcall shr-put-image-function
image (buffer-substring start end))
(delete-region (point) end))))
- (url-retrieve url 'shr-image-fetched
+ (url-retrieve url #'shr-image-fetched
(list (current-buffer) start end)
t t)))))
@@ -1679,7 +1668,7 @@ The preference is a float determined from
`shr-prefer-media-type'."
(or alt "")))
(insert " ")
(url-queue-retrieve
- (shr-encode-url url) 'shr-image-fetched
+ (shr-encode-url url) #'shr-image-fetched
(list (current-buffer) start (set-marker (make-marker) (point))
(list :width width :height height))
t
@@ -2006,12 +1995,11 @@ BASE is the URL of the HTML being rendered."
(cond
((null tbodies)
dom)
- ((= (length tbodies) 1)
+ ((null (cdr tbodies))
(car tbodies))
(t
;; Table with multiple tbodies. Convert into a single tbody.
- `(tbody nil ,@(cl-reduce 'append
- (mapcar 'dom-non-text-children tbodies)))))))
+ `(tbody nil ,@(mapcan #'dom-non-text-children tbodies))))))
(defun shr--fix-tbody (tbody)
(nconc (list 'tbody (dom-attributes tbody))
@@ -2311,8 +2299,8 @@ flags that control whether to collect or render objects."
(dolist (column row)
(aset natural-widths i (max (aref natural-widths i) column))
(setq i (1+ i)))))
- (let ((extra (- (apply '+ (append suggested-widths nil))
- (apply '+ (append widths nil))
+ (let ((extra (- (apply #'+ (append suggested-widths nil))
+ (apply #'+ (append widths nil))
(* shr-table-separator-pixel-width (1+ (length widths)))))
(expanded-columns 0))
;; We have extra, unused space, so divide this space amongst the
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- master 3a7894e: Improve shr/eww handling of mailto URLs,
Basil L. Contovounesios <=