path: root/eww-conf.el

;;; eww-conf.el --- My configurations for Emacs Web Wowser -*- lexical-binding: t; -*-

;;; Author: Durand
;;; Created: 2021-01-20

;;; Commentary:

;; Simple configurations for the great Emacs Web Wowser

;;; Code:

(require 'eww)
(require 'shr)

(setq browse-url-browser-function #'durand-browse-url)
(setq browse-url-secondary-browser-function 'browse-url-default-browser)

(setq eww-bookmarks-directory load-file-directory)

(setq eww-search-prefix "https://searx.jsdurand.xyz/searx/search?q=")
(setq eww-restore-desktop t)
(setq eww-desktop-remove-duplicates t)
(setq eww-suggest-uris '(eww-links-at-point thing-at-point-url-at-point))
(setq eww-browse-url-new-window-is-tab nil)

;;; Open URL in an external browser if given a prefix argument.

(defun durand-browse-url (url &optional arg)
  "Open URL in a browser.
If ARG is nil, open in EWW.  Otherwise, open in an external browser."
  (cond
   (arg (funcall browse-url-secondary-browser-function url))
   ((eww-browse-url url))))

;;; Elpher integration

(use-package "elpher" 'elpher)

(defun eww-open-elpher (old url &rest args)
  "Use Elpher to open the URL if needed."
  (cond
   ((member (url-type (url-generic-parse-url url))
            (list "gemini" "gopher"))
    (elpher-go url))
   ((apply old (cons url args)))))

(advice-add #'eww-browse-url :around #'eww-open-elpher)
(advice-add #'eww :around #'eww-open-elpher)

;;; Use pdf-view to view PDF files if available.

(setq mailcap-prefer-mailcap-viewers nil)

(setq mailcap-user-mime-data
      '(((viewer . pdf-view-mode)
         (type . "application/pdf")
         (test . window-system))
        ((viewer . doc-view-mode)
         (type . "application/pdf")
         (test . window-system))))

;; key-bindings

(define-key global-map (vector ?\s-w) 'durand-eww-map)

;;;###autoload
(fset 'durand-eww-map
      (let ((map (list 'keymap "EWW")))
        (define-key map (vector ?b) #'eww-visit-bookmark)
        (define-key map (vector ?e) #'eww-dwim)
        map))

(define-key eww-link-keymap (kbd "v") nil) ; stop overriding `eww-view-source'
(define-key eww-mode-map (kbd "L") #'eww-list-bookmarks)
(define-key eww-mode-map (vector ?f) #'eww-find-feed)
(define-key eww-mode-map (vector ?b) #'eww-visit-bookmark)
(define-key eww-mode-map (vector ?e) #'eww-dwim)
(define-key eww-mode-map (vector ?o) #'eww-open-in-new-buffer)
(define-key eww-mode-map (vector ?E) #'eww-visit-url-on-page)
(define-key eww-mode-map (vector ?J) #'eww-jump-to-url-on-page)
(define-key eww-mode-map (vector ?m) #'eww-add-bookmark)
(define-key eww-mode-map (vector ?d) #'durand-eww-download)
(define-key dired-mode-map (kbd "E") #'eww-open-file) ; to render local HTML files
(define-key eww-buffers-mode-map (kbd "d") #'eww-bookmark-kill)   ; it actually deletes
(define-key eww-bookmark-mode-map (kbd "d") #'eww-bookmark-kill)  ; same

(setq shr-use-colors nil)             ; t is bad for accessibility
(setq shr-use-fonts nil)              ; t is not for me
(setq shr-max-image-proportion 0.6)
(setq shr-image-animate nil)          ; No GIFs, thank you!
(setq shr-width nil)                  ; check `prot-eww-readable'
(setq shr-discard-aria-hidden t)
(setq shr-cookie-policy nil)

;; This feels quicker.
(cond ((version<= "28" emacs-version))
      ((setq eww-retrieve-command '("wget" "--quiet" "--output-document=-"))))

(define-key eww-mode-map (vector 'C-tab)
  #'durand-eww-goto-search-result)

;;;###autoload
(defun durand-eww-goto-search-result ()
  "Go to the search results on a search page.
Otherwise, just go to the beginning of the page."
  (interactive)
  (save-match-data
    (cond
     ((string-match-p "searx\\." (plist-get eww-data :url))
      (re-search-forward "search results"))
     ((goto-char (point-min)))))
  (recenter 0))

;;; the following are adapted from Protesilaos' dotemacs.

;;;###autoload
(defconst eww-name-separator "-"
  "The separator between the title and the mark EWW in the \
names.")

;;;###autoload
(defun eww-rename-buffer ()
  "Rename EWW buffer using page title or URL.
To be used by `eww-after-render-hook'."
  (let ((name (cond
               ((and (plist-get eww-data :title)
                     (not (string= (plist-get eww-data :title) "")))
                (plist-get eww-data :title))
               ((plist-get eww-data :url)))))
    (rename-buffer (format "*%s %s eww*" name eww-name-separator) t)))

(add-hook 'eww-after-render-hook #'eww-rename-buffer)
(advice-add 'eww-back-url :after #'eww-rename-buffer)
(advice-add 'eww-forward-url :after #'eww-rename-buffer)

;;;###autoload
(defvar eww-visited-history nil
  "History of visited URLs.")

;;;###autoload
(defun eww-record-history ()
  "Store URL in `eww-visited-history'.
To be used by `eww-after-render-hook'."
  (add-to-history 'eww-visited-history (plist-get eww-data :url)))

(add-hook 'eww-after-render-hook #'eww-record-history)
(advice-add 'eww-back-url :after #'eww-record-history)
(advice-add 'eww-forward-url :after #'eww-record-history)

;;;; Commands

;;;###autoload
(defun eww-dwim (url &optional arg)
  "Visit a URL, maybe from `eww-prompt-history', with completion.
With optional prefix ARG (\\[universal-argument]) open URL in a
new eww buffer.
If URL does not look like a valid link, run a web query using
`eww-search-prefix'.
When called from an eww buffer, provide the current link as
default candidate."
  (interactive
   (list
    (completing-read "Run EWW on: "
                     (delete-dups (append eww-visited-history eww-prompt-history))
                     nil nil nil 'eww-prompt-history (plist-get eww-data :url) t)
    current-prefix-arg))
  (eww url (cond (arg 4))))

;;;###autoload
(defun eww-visit-bookmark (&optional arg)
  "Visit bookmarked URL.
With optional prefix ARG (\\[universal-argument]) open URL in a
new EWW buffer."
  (interactive "P")
  (eww-read-bookmarks)
  (let ((candidates (mapcar
                     (lambda (element)
                       (plist-get element :url))
                     eww-bookmarks)))
    (eww (completing-read "Visit EWW bookmark: " candidates)
         (cond (arg 4)))))

;;;###autoload
(defun eww-visit-url-on-page (&optional arg)
  "Visit URL from list of links on the page using completion.
With optional prefix ARG (\\[universal-argument]) open URL in a
new EWW buffer."
  (interactive "P")
  (cond
   ((derived-mode-p 'eww-mode)
    (let (links)
      (save-excursion
        (goto-char (point-max))
        (while (text-property-search-backward 'shr-url nil nil t)
          (cond
           ((and (get-text-property (point) 'shr-url)
                 (not (get-text-property (point) 'eww-form)))
            (setq links
                  (cons (format "%s @ %s"
                                (button-label (point))
                                (propertize (get-text-property (point) 'shr-url) 'face 'link))
                        links))))))
      (let* ((selection (completing-read "Browse URL from page: " links nil t))
             (match-ending (progn (string-match " @ " selection)
                                 (match-end 0)))
             (url (substring-no-properties selection match-ending)))
        (eww url (cond (arg 4))))))))

;;;###autoload
(defun eww-jump-to-url-on-page ()
  "Jump to URL position on the page using completion.
With optional prefix ARG (\\[universal-argument]) open URL in a
new EWW buffer."
  (interactive)
  (cond
   ((derived-mode-p 'eww-mode)
    (let ((links))
      (save-excursion
        (goto-char (point-max))
        (while (text-property-search-backward 'shr-url nil nil t)
          (cond
           ((and (get-text-property (point) 'shr-url)
                 (not (get-text-property (point) 'eww-form)))
            (setq links
                  (cons (format "%s @ %s ~ %d"
                                (button-label (point))
                                (propertize (get-text-property (point) 'shr-url) 'face 'link)
                                (point))
                        links))))))
      (let* ((selection (completing-read "Jump to URL on page: " links nil t))
             (match-ending (progn (string-match " ~ " selection)
                                  (match-end 0)))
             (position (string-to-number
                        (substring-no-properties selection match-ending))))
        (goto-char position)
        (durand-pulse-pulse-line))))))

(defvar eww-occur-feed-regexp
  (concat "\\(rss\\|atom\\)\\+xml.\\(.\\|\n\\)"
          ".*href=[\"']\\(.*?\\)[\"']")
  "Regular expression to match web feeds in HTML source.")

;;;###autoload
(defun eww-find-feed ()
  "Produce bespoke buffer with RSS/Atom links from XML source."
  (interactive)
  (let* ((url (or (plist-get eww-data :start)
                  (plist-get eww-data :contents)
                  (plist-get eww-data :home)
                  (plist-get eww-data :url)))
         (title (or (plist-get eww-data :title) url))
         (source (plist-get eww-data :source))
         (buf-name (format "*feeds: %s %s eww*" title
                           eww-name-separator))
         (inhibit-read-only t)
         (base-url (replace-regexp-in-string "\\(.*/\\)[^/]+\\'" "\\1" url)))
    (cond
     (source
      (with-temp-buffer
        (insert source)
        (occur-1 eww-occur-feed-regexp "\\3" (list (current-buffer)) buf-name))
      ;; Comment by Protesilaos:
      ;; Handle relative URLs, so that we get an absolute URL out of them.
      ;; Findings like "rss.xml" are not particularly helpful.
      ;;
      ;; NOTE 2021-03-31: the base-url heuristic may not always be
      ;; correct, though it has worked in all websites I have tested it
      ;; in.
      (cond
       ((get-buffer buf-name)
        (with-current-buffer (get-buffer buf-name)
          (goto-char (point-min))
          (cond
           ((re-search-forward browse-url-button-regexp nil t))
           ((re-search-forward ".*" nil t)
            (replace-match (concat base-url "\\&"))))))))
     (t
      ;; Sometimes a page has no sources
      (let ((nodes (dom-search
                    (plist-get eww-data :dom)
                    (lambda (node)
                      (and
                       (eq (dom-tag node) 'link)
                       (dom-attr node 'type)
                       (string-match "\\(?:rss\\|atom\\)\\+xml"
                                     (dom-attr node 'type)))))))
        (with-current-buffer (get-buffer-create buf-name)
          (mapc (lambda (node)
                  (insert (dom-attr node 'title)
                          " - "
                          (dom-attr node 'href)
                          "\n"))
                nodes))
        (display-buffer (get-buffer buf-name)))))))

;; REVIEW: the line containing the universal argument looks longer in
;; the source form, and when expanded in the help buffer, it will fit
;; perfectly.  But this does not seem to be the right approach, since
;; this makes it harder to people to read the sources.  Is it possible
;; to process the documentation string in the help buffer, so that the
;; documentation strings look nice in every place.

;;;###autoload
(defun durand-eww-download (&optional url name dir)
  "Download URL to DIR as NAME.
URL defaults to the link at point if any, else to the current
page's URL.

NAME defaults to the title of the current page if it can be
found, else to the last component of the current page's URL, if
any.  In addition, the name will be suitably processed so that it
fits into a file name.

DIR defaults to `eww-download-directory'.

In interactive uses, with a universal argument (\\[universal-argument]), prompt
for URL, NAME, and DIR, providing the default values for the 
users to select."
  (interactive
   (cond
    (current-prefix-arg
     (list (let ((default-url (or (get-text-property (point) 'shr-url)
                                  (eww-current-url))))
             (read-string (cond
                           ((and (stringp default-url)
                                 (not (string= default-url "")))
                            (format "Download URL (default %s): "
                                    default-url))
                           ("Download URL: "))
                          nil nil default-url))
           (let ((default-title
                   (or (plist-get eww-data :title)
                       (file-name-nondirectory
                        (eww-current-url)))))
             (read-string (cond
                           ((and (stringp default-title)
                                 (not (string= default-title "")))
                            (format "Download as (default %s) "
                                    default-title))
                           ("Download as "))
                          nil nil default-title))
           (read-file-name
            "Download to: " eww-download-directory
            eww-download-directory nil nil
            #'file-accessible-directory-p)))
    ((list (or (get-text-property (point) 'shr-url) (eww-current-url))
           (or (plist-get eww-data :title)
               (file-name-nondirectory (eww-current-url)))
           eww-download-directory))))
  ;; eww-download-directory might be a function
  (cond
   ((functionp dir) (setq dir (funcall dir))))
  ;; Check the validity of DIR
  (cond ((and (stringp dir) (not (string= dir ""))
              (file-accessible-directory-p dir)))
        ((and (stringp dir) (not (string= dir ""))
              (file-exists-p dir))
         (user-error "%s is an existing file that is not a directory"
                     dir))
        ((and (stringp dir) (not (string= dir "")))
         ;; create the dir for the user
         (cond ((y-or-n-p "Create a directory to download to? ")
                (make-directory dir t))
               ((user-error "A non-existent directory"))))
        ((user-error "DIR should be a non-empty string, but got %S"
                     dir)))
  ;; Check the validity of NAME
  (cond
   ((and (stringp name) (not (string= name ""))))
   ((let ((default (or (plist-get eww-data :title)
                       (file-name-nondirectory
                        (eww-current-url)))))
      (and (stringp default) (not (string= default ""))
           (setq name default))))
   ((user-error "NAME should be a non-empty string, but got %S"
                name)))
  ;; sluggish the name -- taken from Protesilaos' codes
  (setq name
        (downcase
         (replace-regexp-in-string
          "-$" ""
          (replace-regexp-in-string
           "--+" "-"
           (replace-regexp-in-string
            "\\s-+" "-"
            (replace-regexp-in-string
             "[][{}!@#$%^&*()_=+'\"?,.\|;:~`‘’“”]*" "" name))))))
  
  ;; Check the validity of URL
  (cond
   ((and (stringp url) (not (string= url ""))))
   ((user-error "URL should be a non-empty string, but got %S"
                url)))
  (url-retrieve url #'durand-eww-download-callback
                (list name dir)))

;;;###autoload
(defun durand-eww-download-callback (status name dir)
  "The callback function for `durand-eww-download'.
For the meaning of STATUS, see the documentation of
`url-retrieve'.

For the meanings of NAME and DIR, see the documentation of
`durand-eww-download'."
  (cond
   ((plist-get status :error)
    (user-error "Error: %S" (plist-get status :error))))
  (let ((file (eww-make-unique-file-name name dir)))
    (goto-char (point-min))
    (re-search-forward "\r?\n\r?\n")
    (let ((coding-system-for-write 'no-conversion))
      (write-region (point) (point-max) file))
    (message "Saved %s" file)))

;;; Bookmark integration

;;;; Readbable mode distinction

;; This section modifies the behaviour of `eww-readable' so that when
;; we are viewing readable parts of the webpage, there is a variable
;; saying so.

(defvar durand-eww-readable-p nil
  "If non-nil, we are viewing the readable parts of a webpage.")

(make-variable-buffer-local 'durand-eww-readable-p)

(defun eww-non-readable-h ()
  "Set `durand-eww-readable-p' to nil."
  (setq-local durand-eww-readable-p nil))

(defun eww-readable-h ()
  "Set `durand-eww-readable-p' to t."
  (setq-local durand-eww-readable-p t))

(add-hook 'eww-after-render-hook #'eww-non-readable-h -10)

(advice-add #'eww-readable :after #'eww-readable-h)

;;;; Making records

;; This section defines functions to make bookmarks for EWW buffers
;; and to jump to those bookmarks.

(defun durand-eww-bookmark-make-record ()
  "Return a bookmark record for the current page."
  (cond
   ((not (derived-mode-p 'eww-mode))
    (user-error "Making an EWW bookmark for a non-EWW buffer")))
  (let* ((url (plist-get eww-data :url))
         (title (format "(EWW) %s" (plist-get eww-data :title)))
         (position (point))
         (readablep durand-eww-readable-p)
         (defaults (delq nil (list 'defaults title url))))
    (cond
     ((null url) (user-error "No link for the current page")))
    (append
     (list
      title
      (cons 'location url)
      (cons 'handler #'durand-eww-bookmark-jump)
      (cons 'readablep readablep)
      defaults)
     (bookmark-make-record-default 'no-file nil position))))

;; Copied from Protesilaos' dotemacs
(defun durand-eww-set-bookmark-record-function ()
  "Set appropriate `bookmark-make-record-function'.
Intended for use with `eww-mode-hook'."
  (setq-local
   bookmark-make-record-function #'durand-eww-bookmark-make-record))

(add-hook 'eww-mode-hook #'durand-eww-set-bookmark-record-function)

;;;; Jumping

;; HACK: Use an advice to temporarily override the definition of
;; pop-to-buffer.

(defun durand-pop-to-buffer-advice (buffer &rest args)
  "Set BUFFER and ignore ARGS.
Just a temporary advice to override `pop-to-buffer'."
  (set-buffer buffer))

;; NOTE: It works with jumping in another window.

;; This is added in Emacs-29.
(put 'durand-eww-bookmark-jump 'bookmark-handler-type "EWW")

;;;###autoload
(defun durand-eww-bookmark-jump (bookmark)
  "Jump to BOOKMARK in EWW.
This is intended to be the handler for bookmark records created
by `durand-eww-bookmark-make-record'.

If there is already a buffer visiting the URL of the bookmark,
simply jump to that buffer and try to restore the point there.
Otherwise, fetch URL and afterwards try to restore the point."
  (let ((handler (bookmark-get-handler bookmark))
        (location (bookmark-prop-get bookmark 'location))
        (front (cons 'front-context-string
                     (bookmark-get-front-context-string bookmark)))
        (rear (cons 'rear-context-string
                    (bookmark-get-rear-context-string bookmark)))
        (position (cons 'position (bookmark-get-position bookmark)))
        (eww-buffers
         (delq
          nil
          (mapcar
           (lambda (buffer)
             (cond
              ((and
                (buffer-live-p buffer)
                (provided-mode-derived-p
                 (buffer-local-value
                  'major-mode buffer)
                 'eww-mode))
               buffer)))
           (buffer-list))))
        buffer)
    (cond
     ((and (stringp location)
           (not (string= location ""))
           (eq handler #'durand-eww-bookmark-jump))
      (let (reuse-p)
        (mapc
         (lambda (temp-buffer)
           (cond
            ((string=
              (plist-get
               (buffer-local-value 'eww-data temp-buffer)
               :url)
              location)
             (setq reuse-p temp-buffer)
             (setq buffer temp-buffer))))
         eww-buffers)
        ;; Don't switch to that buffer, otherwise it will cause
        ;; problems if we want to open the bookmark in another window.
        (cond
         (reuse-p
          (set-buffer reuse-p)
          ;; we may use the default handler to restore the position
          ;; here
          (with-current-buffer reuse-p
            (goto-char (cdr position))
            (cond
             ((and
               (stringp (cdr front))
               (search-forward (cdr front) nil t))
              (goto-char (match-beginning 0))))
            (cond
             ((and (stringp (cdr rear))
                   (search-forward (cdr rear) nil t))
              (goto-char (match-end 0))))))
         (t
          ;; HACK, GIANT HACK!
          
          (advice-add #'pop-to-buffer :override
                      #'durand-pop-to-buffer-advice)
          (eww location 4)
          ;; after the `set-buffer' in `eww', the current buffer is
          ;; the buffer we want
          (setq buffer (current-buffer))
          ;; restore the definition of pop-to-buffer...
          (advice-remove
           #'pop-to-buffer #'durand-pop-to-buffer-advice)
          ;; add a hook to restore the position

          ;; make sure each hook function is unique, so that different
          ;; hooks don't interfere with each other.
          (let ((function-symbol
                 (intern
                  (format
                   "eww-render-hook-%s"
                   (bookmark-name-from-full-record
                    (bookmark-get-bookmark bookmark))))))
            (fset function-symbol
                  (lambda ()
                    (remove-hook
                     'eww-after-render-hook function-symbol)
                    ;; if the bookmark records a readable webpage,
                    ;; enter readable mode again.
                    (cond
                     ((bookmark-prop-get bookmark 'readablep)
                      (eww-readable)))
                    (bookmark-default-handler
                     (list
                      "" (cons 'buffer buffer)
                      front rear position))))
            ;; make sure this hook is added after the hook that sets
            ;; the readable mode to nil, so that the readable mode is
            ;; correctly set to t.
            (add-hook 'eww-after-render-hook function-symbol 10))))))
     ((user-error "Cannot jump to this bookmark")))))

(provide 'eww-conf)

;;; eww-conf.el ends here