path: root/eww-conf.el

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

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

;;; Commentary:

;; Simply configurations for the great Emacs Web Wowser

;;; Code:

(require 'eww)
(require 'shr)

(setq browse-url-browser-function #'eww-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)

;;; 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))))
  ;; 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)))

(provide 'eww-conf)

;;; eww-conf.el ends here