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

;;; Bookmark integration

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

;;;; Making records

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

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

;;;###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
              ((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
          (bookmark-default-handler
           (list "" (cons 'buffer buffer) front rear)))
         ;; eww will pop the buffer, so we manually do the jobs: the
         ;; codes are adapted from the codes for `eww'.

         ;; the buffer will be renamed afterwards, so it does not
         ;; matter here
         ((let ((temp-buffer (generate-new-buffer "*eww*")))
            (setq buffer temp-buffer)
            (set-buffer temp-buffer)
            (with-current-buffer temp-buffer
              (eww-setup-buffer)
              ;; Check whether the domain only uses "Highly
              ;; Restricted" Unicode IDNA characters.  If not,
              ;; transform to punycode to indicate that there may be
              ;; funny business going on.
              (let ((parsed (url-generic-parse-url location)))
                (when (url-host parsed)
                  (unless (puny-highly-restrictive-domain-p
                           (url-host parsed))
                    (setf (url-host parsed)
                          (puny-encode-domain (url-host parsed)))))
                ;; When the URL is on the form "http://a/../../../g",
                ;; chop off all the leading "/.."s.
                (when (url-filename parsed)
                  (while (string-match
                          "\\`/[.][.]/" (url-filename parsed))
                    (setf (url-filename parsed)
                          (substring (url-filename parsed) 3))))
                (setq location (url-recreate-url parsed)))
              (plist-put eww-data :url location)
              (plist-put eww-data :title "")
              (eww-update-header-line-format)
              (let ((inhibit-read-only t))
                (insert (format "Loading %s..." location))
                (goto-char (point-min)))
              (let ((url-mime-accept-string
                     eww-accept-content-types))
                (eww-retrieve
                 location #'eww-render
                 (list location nil (current-buffer)))
                ;; Now the buffer is setup, we shall try to restore
                ;; the point.  But the buffer might not be ready yet,
                ;; so we use the render hook for this purpose.
                (add-hook
                 'eww-after-render-hook
                 (defun durand-eww-bookmark-restore-point-hook ()
                   "Restore the point after render."
                   (remove-hook
                    'eww-after-render-hook
                    #'durand-eww-bookmark-restore-point-hook
                    t)
                   (bookmark-default-handler
                    (list
                     "" (cons 'buffer buffer) front rear)))
                 nil t))))))))
     ((user-error "Cannot jump to this bookmark")))))

(provide 'eww-conf)

;;; eww-conf.el ends here