diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 908df6e3333..a7c7e267583 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -3063,28 +3063,57 @@ Otherwise, the restored buffer will contain a prompt to do so by using (put 'eww-bookmark-jump 'bookmark-handler-type "EWW") -(provide 'eww) - ;;; Alternate links (RSS and Atom feeds, etc.) (defun eww--alternate-urls (dom &optional base) - "Return an alist of alternate links in DOM. + "Return a list of alternate links in DOM. -Each element is a list of the form (URL TYPE TITLE) where URL is -the href attribute of the link expanded relative to BASE, TYPE is -its type attribute, and TITLE is its title attribute. If any of -these attributes is absent, the corresponding element is nil." - (let ((alternates - (seq-filter - (lambda (attrs) (string= (alist-get 'rel attrs) - "alternate")) - (mapcar #'dom-attributes (dom-by-tag dom 'link))))) - (mapcar (lambda (alternate) - (list (url-expand-file-name (alist-get 'href alternate) - base) - (alist-get 'type alternate) - (alist-get 'title alternate))) - alternates))) +Each element is a string URL, which is the the href attribute of the +link, expanded relative to BASE. Each URL has text properties \\+`type' +which is the link's type attribute, and \\+`title', its title attribute." + (seq-keep + (lambda (link) + (let ((attrs (dom-attributes link))) + (when (equal (alist-get 'rel attrs) "alternate") + (propertize + (url-expand-file-name (alist-get 'href attrs) base) + 'type (alist-get 'type attrs) + 'title (or (alist-get 'title attrs) ""))))) + (dom-by-tag dom 'link))) + +(defun eww--alternate-urls-affixation (urls) + (let ((url-max-width + (seq-max (cons 0 (mapcar #'string-pixel-width urls)))) + (title-max-width + (seq-max + (cons 0 (mapcar + (lambda (url) + (string-pixel-width (get-text-property 0 'title url))) + urls)))) + (sep-width (string-pixel-width " "))) + (mapcar + (lambda (url) + (let ((title (get-text-property 0 'title url))) + (list + url "" + (propertize + (concat + (propertize + " " 'display + `( space :width + (,(+ sep-width + (- url-max-width (string-pixel-width url)))))) + title + (when-let* ((type (get-text-property 0 'type url))) + (concat + (propertize + " " 'display + `( space :width + (,(+ sep-width + (- title-max-width (string-pixel-width title)))))) + "[" type "]"))) + 'face 'completions-annotations)))) + urls))) (defun eww-read-alternate-url () "Get the URL of an alternate link of this page. @@ -3092,46 +3121,17 @@ these attributes is absent, the corresponding element is nil." If there is just one alternate link, return its URL. If there are multiple alternate links, prompt for one in the minibuffer with completion. If there are none, return nil." - (when-let* ((alternates (eww--alternate-urls - (plist-get eww-data :dom) - (plist-get eww-data :url)))) - (let ((url-max-width - (seq-max (mapcar #'string-pixel-width - (mapcar #'car alternates)))) - (title-max-width - (seq-max (mapcar #'string-pixel-width - (mapcar #'caddr alternates)))) - (sep-width (string-pixel-width " "))) - (if (cdr alternates) - (completing-read - "Alternate URL: " - (completion-table-with-metadata - alternates - `((annotation-function - . ,(lambda (feed) - (let* ((attrs (alist-get feed - alternates - nil - nil - #'string=)) - (type (car attrs)) - (title (cadr attrs))) - (concat - (propertize " " 'display - `(space :align-to - (,(+ sep-width - url-max-width)))) - title - (when type - (concat - (propertize " " 'display - `(space :align-to - (,(+ (* 2 sep-width) - url-max-width - title-max-width)))) - "[" type "]")))))))) - nil t) - (caar alternates))))) + (when-let* ((alts (eww--alternate-urls (plist-get eww-data :dom) + (plist-get eww-data :url)))) + (if (cdr alts) + ;; Multiple alternate links, prompt the user to select one. + (completing-read + "Alternate URL: " + (completion-table-with-metadata + alts `((affixation-function . eww--alternate-urls-affixation))) + nil t) + ;; Just one alternate link, return it without prompting. + (caar alts)))) (defun eww-copy-alternate-url () "Copy the alternate URL of the current page into the kill ring. @@ -3147,4 +3147,5 @@ version or an RSS feed." (message "Copied %s to kill ring" url)) (user-error "No alternate links found on this page!"))) +(provide 'eww) ;;; eww.el ends here