path: root/custom/jao-custom-eww.el

;; -*- lexical-binding: t -*-

;;; integration with browse-url and afio
(defun jao-eww-browse-url (url &rest _r)
  "Browse URL using eww."
  (if (derived-mode-p 'eww-mode)
      (eww url)
    (jao-afio-goto-www)
    (select-window (frame-first-window))
    (let* ((url (url-encode-url url))
           (bf (seq-find `(lambda (b)
                            (with-current-buffer b
                              (string= ,url
                                       (url-encode-url (eww-current-url)))))
                         (jao-eww-session-eww-buffers))))
      (cond (bf (switch-to-buffer bf))
            ((string-match-p url "^file://") (eww-open-file url))
            (t (eww url 4))))))

(setq jao-browse-url-function #'jao-eww-browse-url)
(setq eww-use-browse-url "^\\(gemini\\|gopher\\):")

;;; multipart html renderer
(defun jao-shr-html-renderer (handle)
  (let ((fill-column nil)
        (shr-width 150)
        (shr-max-width 150))
    (mm-shr handle)))

(setq mm-text-html-renderer #'jao-shr-html-renderer)

;;; opening URLs
(defun jao-eww-copy-link ()
  (interactive)
  (when-let* ((lnk (or (car (eww-links-at-point)) (eww-current-url))))
    (message "%s" lnk)
    (kill-new lnk)))

(defun jao-eww-browse (arg)
    (interactive "P" eww-mode)
    (setq eww-prompt-history
          (cl-remove-duplicates eww-prompt-history :test #'string=))
    (let ((url (completing-read (if arg "eww in new buffer: " "eww: ")
                                eww-prompt-history nil nil nil
                                'eww-prompt-history (eww-current-url))))
      (eww url (when arg 4))))

(defun jao-eww-browse-new ()
  (interactive nil eww-mode)
  (jao-eww-browse t))

(defun jao-eww-reload (images)
  (interactive "P" eww-mode)
  (if images
      (let ((shr-blocked-images nil))
        (eww-reload t))
    (call-interactively 'eww-reload)))

;;; consult narrowing
(with-eval-after-load "consult"
  (defvar jao-eww-consult-history nil)
  (defvar jao-eww-buffer-source
    (list :name "eww buffer"
          :category 'eww-buffer
          :hidden t
          :narrow (cons ?e "eww")
          :annotate (lambda (c) (get-text-property 0 'url c))
          :history 'jao-eww-consult-history
          :action (lambda (b)
                    (jao-afio-goto-www)
                    (switch-to-buffer (get-text-property 0 'buffer b)))
          :items
          (lambda ()
            (seq-map (lambda (b)
                       (with-current-buffer b
                         (let ((tl (or (plist-get eww-data :title) ""))
                               (url (or (eww-current-url) (buffer-name))))
                           (propertize (if (string-blank-p tl) url tl)
                                       'buffer b 'url url))))
                     (seq-filter #'jao-www--buffer-p (buffer-list))))))
  (jao-consult-add-buffer-source 'jao-eww-buffer-source))

;;; images
(defun jao-eww-next-image ()
  (interactive nil eww-mode)
  (when-let* ((p (text-property-search-forward 'image-displayer nil nil t)))
    (goto-char (prop-match-beginning p))))

;;; close page and reopen
(defvar jao-eww--closed-urls ())

(defun jao-eww-close ()
  (interactive nil eww-mode)
  (when-let* ((current (eww-current-url)))
    (add-to-list 'jao-eww--closed-urls current))
  (let ((nxt (car (jao-eww-session-invisible-buffers))))
    (kill-current-buffer)
    (when nxt (switch-to-buffer nxt nil t))))

(defun jao-eww-reopen (arg)
  (interactive "P")
  (if (> (length jao-eww--closed-urls) 0)
      (let ((url (completing-read "URL: " jao-eww--closed-urls)))
        (jao-afio-goto-www)
        (setq jao-eww--closed-urls (remove url jao-eww--closed-urls))
        (eww url (when arg 4)))
    (message "No previously closed URLs.")))

(defun jao-eww-reopen-new ()
  (interactive)
  (jao-eww-reopen t))

;;; sessions
(use-package jao-eww-session
  :custom ((jao-eww-session-file "~/.emacs.d/cache/eww-session.eld")))

;;; eww to org
(defun jao-eww-to-org (&optional dest)
  (interactive)
  (unless (org-region-active-p)
    (let ((shr-width 80)) (eww-readable)))
  (let* ((start (if (org-region-active-p) (region-beginning) (point-min)))
         (end (if (org-region-active-p) (region-end) (point-max)))
         (link (eww-current-url))
         (title (plist-get eww-data :title))
         (buff (save-current-buffer (or dest (jao-org-notes-create title)))))
    (with-current-buffer buff
      (insert "#+link: " link "\n\n")
      (org-mode))
    (save-excursion
      (goto-char start)
      (while (< (point) end)
        (let* ((p (point))
               (props (text-properties-at p))
               (k (seq-find (lambda (x) (plist-get props x))
                            '(shr-url image-url outline-level face)))
               (prop (and k (list k (plist-get props k))))
               (next (if prop
                         (next-single-property-change p (car prop) nil end)
                       (next-property-change p nil end)))
               (txt (buffer-substring (point) next))
               (txt (replace-regexp-in-string "\\*" "·" txt)))
          (with-current-buffer buff
            (insert
             (pcase prop
               ((and (or `(shr-url ,url) `(image-url ,url))
                     (guard (string-match-p "^http" url)))
                (let ((tt (replace-regexp-in-string "\n\\([^$]\\)" " \\1" txt)))
                  (org-link-make-string url tt)))
               (`(outline-level ,n)
                (concat (make-string (- (* 2 n) 1) ?*) " " txt "\n"))
               ('(face italic) (format "/%s/ " (string-trim txt)))
               ('(face bold) (format "*%s* " (string-trim txt)))
               (_ txt))))
          (goto-char next))))
    (pop-to-buffer buff)
    (goto-char (point-min))))

;;; rdrview
;; https://jiewawa.me/2024/04/another-way-of-integrating-mozilla-readability-in-emacs-eww/
(define-minor-mode eww-rdrview-mode
  "Toggle whether to use `rdrview' to make eww buffers more readable."
  :lighter " R"
  (if eww-rdrview-mode
      (progn
        (setq eww-retrieve-command '("rdrview" "-T" "title,sitename,body" "-H"))
        (add-hook 'eww-after-render-hook #'eww-rdrview-update-title))
    (progn
      (setq eww-retrieve-command nil)
      (remove-hook 'eww-after-render-hook #'eww-rdrview-update-title))))

(defun eww-rdrview-update-title ()
  "Change title key in `eww-data' with first line of buffer.
It should be the title of the web page as returned by `rdrview'"
  (save-excursion
    (goto-char (point-min))
    (plist-put eww-data :title (string-trim (thing-at-point 'line t))))
  (eww--after-page-change))

(defun eww-rdrview-toggle-and-reload ()
  "Toggle `eww-rdrview-mode' and reload page in current eww buffer."
  (interactive)
  (if eww-rdrview-mode (eww-rdrview-mode -1)
    (eww-rdrview-mode 1))
  (eww-reload))
;;; auto-readable
(defvar jao-eww-auto-readable-urls
  (regexp-opt '("guardian.co.uk" "theguardian.com" "github.com" "eldiario.es")))

(defun jao-eww-autoread ()
  (when (string-match-p jao-eww-auto-readable-urls (or (eww-current-url)))
    (eww-readable)))

(add-hook 'eww-after-render-hook #'jao-eww-autoread)
;;; package
(use-package shr
  :custom ((shr-width nil)
           (shr-use-colors t)
           (shr-use-fonts nil)
           (shr-max-width 160)
           (shr-blocked-images nil)
           (shr-inhibit-images t)
           (shr-max-image-proportion 0.8)
           (shr-hr-line ?―)))

(use-package eww
  :demand t
  :custom ((eww-browse-url-new-window-is-tab nil)
           (eww-download-directory jao-sink-dir)
           (eww-header-line-format " %u")
           (eww-form-checkbox-selected-symbol "☒")
           (eww-buffer-name-length 180)
           ;; (eww-readable-urls '("guardian\\.co\\.uk"
           ;;                      "theguardian\\.com"
           ;;                      "eldiario\\.es"
           ;;                      "theconversation"))
           )

  :config
  (with-eval-after-load "org" (require 'ol-eww nil t))

  (defun jao-eww-buffer-name ()
    (when-let* ((s (or (plist-get eww-data :title)
                      (plist-get eww-data :url))))
      (when (not (string-blank-p s)) (format "%s" s))))
  (setq eww-auto-rename-buffer #'jao-eww-buffer-name)

  (defun jao-eww-readable (rdrview)
    (interactive "P" eww-mode)
    (if rdrview
        (eww-rdrview-toggle-and-reload)
      (eww-readable)))

  :bind (:map eww-mode-map (("b" . eww-back-url)
                            ("B" . eww-forward-url)
                            ("d" . jao-download)
                            ("f" . link-hint-open-link)
                            ("F" . embark-on-link)
                            ("L" . eww-forward-url)
                            ("N" . jao-eww-next-image)
                            ("o" . jao-eww-browse)
                            ("O" . jao-eww-browse-new)
                            ("r" . jao-eww-reload)
                            ("R" . jao-eww-readable)
                            ("s" . eww-search-words)
                            ("S" . jao-eww-browse-new)
                            ("T" . jao-mastodon-toot-url)
                            ("u" . jao-eww-reopen)
                            ("U" . jao-eww-reopen-new)
                            ("w" . jao-eww-to-org)
                            ("q" . jao-eww-close)
                            ("x" . jao-rss-subscribe)
                            ("y" . jao-eww-copy-link)
                            ("\\" . eww-view-source)
                            ("C-c C-w" . jao-eww-close)
                            ("M-i" . eww-toggle-images))))

;;; fixes for shr image rendering
(require 'shr)

(defun jao-shr--kill-nl (p)
  (save-excursion
    (goto-char p)
    (when (looking-at-p "\n") (delete-char 1))))

(defun jao-shr-tag-img (fn &rest args)
  (let ((p (point)))
    (prog1 (apply fn args)
      (when (> (point) p) (jao-shr--kill-nl p)))))

(defun jao-shr-insert (fn &rest args)
  (let ((p (when (and (not (bolp))
                      (get-text-property (1- (point)) 'image-url))
             (point))))
    (prog1 (apply fn args)
      (when (and p (> (point) p)) (jao-shr--kill-nl p)))))

(advice-add 'shr-tag-img :around #'jao-shr-tag-img)
(advice-add 'shr-insert :around #'jao-shr-insert)

;; (advice-remove 'shr-tag-img #'jao-shr-tag-img)
;; (advice-remove 'shr-insert #'jao-shr-insert)

;;; .
(provide 'jao-custom-eww)