;;; 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 eww-bookmarks-directory load-file-directory)

(setq eww-search-prefix "https://lite.duckduckgo.com/lite/?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 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)))))))

(provide 'eww-conf)

;;; eww-conf.el ends here