Forgemacs' Literate Emacs Configuration

(let ((brew-bin "/home/linuxbrew/.linuxbrew/bin"))
  (when (file-directory-p brew-bin)
    ;; 1. Homebrew's programs
    (setenv "PATH" (concat brew-bin ":" (getenv "PATH")))
    (add-to-list 'exec-path brew-bin)

    ;; 2. Add package config mapping (Crucial for building R packages like showtext/sysfonts)
    (setenv "PKG_CONFIG_PATH" "/home/linuxbrew/.linuxbrew/lib/pkgconfig:/home/linuxbrew/.linuxbrew/share/pkgconfig")

    ;; 3. Route ESS interactive sessions (M-x R)
    (setq inferior-ess-r-program "/home/linuxbrew/.linuxbrew/opt/r/bin/R")

    ;; 4. Route Org Babel background evaluation (C-c C-c)
    (setq org-babel-R-command "/home/linuxbrew/.linuxbrew/opt/r/bin/R --slave --no-save")))

(defvar bmp/command-usage-file
  (expand-file-name "command-usage.el" no-littering-var-directory)
  "Where command counts are kept.")

(defvar bmp/command-usage (make-hash-table :test 'equal)
  "Counts, keyed by (COMMAND . HOW): HOW is a key description or \"M-x\".")

(defvar bmp/command-usage-since nil
  "When counting started.")

(defvar bmp/command-usage-ignored
  '(self-insert-command org-self-insert-command
    execute-extended-command ignore handle-switch-frame
    mouse-set-point mouse-drag-region)
  "Commands not counted (typing, M-x itself and mouse housekeeping).")

(defvar bmp/command-usage-extra-emacs-keys
  '(("<delete>" "C-d" delete-forward-char)
    ("C-<backspace>" "M-DEL" backward-kill-word)
    ("<wheel-down>" "C-v" scroll-up-command)
    ("<wheel-up>" "M-v" scroll-down-command))
  "Keys with an Emacs equivalent that guru-mode does not cover.")

(defun bmp/command-usage--emacs-keys ()
  "Return (KEY EMACS-KEY COMMAND) for every key with an Emacs equivalent.
Taken from guru-mode's own list, plus `bmp/command-usage-extra-emacs-keys';
KEY is normalised the way `key-description' writes it."
  (mapcar (lambda (cell)
            (list (key-description (kbd (car cell))) (cadr cell) (caddr cell)))
          (append (bound-and-true-p guru-affected-bindings-list)
                  bmp/command-usage-extra-emacs-keys)))

(defvar bmp/command-usage--via-mx nil
  "Command being run from M-x, already counted.")

(defun bmp/command-usage--count (command how)
  (when (and command (symbolp command)
             (not (memq command bmp/command-usage-ignored)))
    (cl-incf (gethash (cons command how) bmp/command-usage 0))))

(defun bmp/command-usage--record ()
  "Count the command just run, with the keys used (post-command)."
  (if (eq this-command bmp/command-usage--via-mx)
      (setq bmp/command-usage--via-mx nil)
    (let* ((keys (key-description (this-single-command-keys)))
           (how (if (string-empty-p keys) "(called by another command)" keys))
           (command
            (if (symbolp this-command)
                this-command
              ;; guru-mode runs keys like <down> through an anonymous
              ;; wrapper; count them as the command they stand for
              (or (nth 2 (assoc keys (bmp/command-usage--emacs-keys)))
                  '<anonymous>))))
      (bmp/command-usage--count command how))))

(defun bmp/command-usage--record-mx (_prefix &optional command-name &rest _)
  "Count the command named COMMAND-NAME, run from M-x."
  (let ((command (and command-name (intern-soft command-name))))
    (when command
      (setq bmp/command-usage--via-mx command)
      (bmp/command-usage--count command "M-x"))))

(defun bmp/command-usage-save ()
  "Write the counts to `bmp/command-usage-file'."
  (when (> (hash-table-count bmp/command-usage) 0)
    (let (alist)
      (maphash (lambda (k v) (push (cons k v) alist)) bmp/command-usage)
      (with-temp-file bmp/command-usage-file
        (let ((print-length nil) (print-level nil))
          (prin1 (list :since bmp/command-usage-since :counts alist)
                 (current-buffer)))))))

(defun bmp/command-usage-load ()
  "Read saved counts, if any."
  (setq bmp/command-usage-since (format-time-string "%F"))
  (when (file-exists-p bmp/command-usage-file)
    (let ((data (with-temp-buffer
                  (insert-file-contents bmp/command-usage-file)
                  (ignore-errors (read (current-buffer))))))
      (when data
        (setq bmp/command-usage-since (plist-get data :since))
        (dolist (entry (plist-get data :counts))
          (puthash (car entry) (cdr entry) bmp/command-usage))))))

(defun bmp/command-usage-reset ()
  "Forget all counts and start again from today."
  (interactive)
  (when (yes-or-no-p "Forget all command counts? ")
    (clrhash bmp/command-usage)
    (setq bmp/command-usage-since (format-time-string "%F"))
    (when (file-exists-p bmp/command-usage-file)
      (delete-file bmp/command-usage-file))
    (message "Command counts reset")))

(bmp/command-usage-load)
(add-hook 'post-command-hook #'bmp/command-usage--record)
(advice-add 'execute-extended-command :before #'bmp/command-usage--record-mx)
(run-with-idle-timer 600 t #'bmp/command-usage-save)
(add-hook 'kill-emacs-hook #'bmp/command-usage-save)

;; --- The report
(defun bmp/command-usage--package (command)
  "Return the package COMMAND comes from, or \"emacs\" for built-ins."
  (let* ((def (and (fboundp command) (symbol-function command)))
         ;; Not loaded yet: Elpaca keeps all autoloads in one cache file,
         ;; so use the library the autoload points to
         (file (if (autoloadp def)
                   (locate-library (nth 1 def))
                 (ignore-errors (symbol-file command 'defun)))))
    (cond ((subrp (indirect-function command)) "emacs") ; written in C
          ((null file) "?")
          ((string-match "/elpaca/builds/\\([^/]+\\)/" file) (match-string 1 file))
          ((string-match "/elpaca/sources/\\([^/]+\\)/" file) (match-string 1 file))
          (t "emacs"))))

(defun bmp/command-usage--emacs-q-bindings (keys)
  "Ask a clean Emacs (emacs -Q) what KEYS run, as an alist."
  (let ((form (format "(prin1 (mapcar (lambda (k) (cons k (let ((b (keymap-lookup global-map k))) (cond ((null b) nil) ((symbolp b) b) ((keymapp b) 'prefix) (t 'other))))) '%S))"
                      keys)))
    (ignore-errors
      (car (read-from-string
            (with-output-to-string
              (call-process (expand-file-name invocation-name invocation-directory)
                            nil standard-output nil "-Q" "--batch" "--eval" form)))))))

(defun bmp/command-usage--total (pred)
  (let ((table (make-hash-table :test 'equal)))
    (maphash (lambda (k v) (when (funcall pred k) (cl-incf (gethash k table 0) v)))
             bmp/command-usage)
    table))

(defun bmp/command-usage--sorted (table)
  (let (rows)
    (maphash (lambda (k v) (push (cons k v) rows)) table)
    (sort rows (lambda (a b) (> (cdr a) (cdr b))))))

(defun bmp/command-usage--mode-active-p (pkg)
  "Non-nil if PKG has a minor mode switched on (so it works without commands)."
  (seq-some (lambda (name)
              (let ((sym (intern-soft name)))
                (and sym (boundp sym) (default-value sym))))
            (list (concat pkg "-mode") (concat "global-" pkg "-mode")
                  (concat pkg "-global-mode"))))

(defvar-keymap bmp/command-usage-report-mode-map
  :doc "Keys in the command usage report."
  "n" #'org-next-visible-heading
  "p" #'org-previous-visible-heading
  "TAB" #'org-cycle
  "<backtab>" #'org-shifttab
  "g" #'bmp/command-usage-report
  "q" #'quit-window)

(define-minor-mode bmp/command-usage-report-mode
  "Read-only navigation for the command usage report.
\\{bmp/command-usage-report-mode-map}"
  :lighter " Usage")

(defun bmp/command-usage--section (title explanation header)
  "Insert a section TITLE with its EXPLANATION and a table HEADER."
  (unless (bolp) (insert "\n"))
  (insert "\n* " title "\n" explanation "\n\n| "
          (string-join header " | ") " |\n|-\n"))

(defun bmp/command-usage-report ()
  "Show which commands and keys I use, and packages I do not."
  (interactive)
  (bmp/command-usage-save)
  (let* ((total 0)
         (emacs-keys (bmp/command-usage--emacs-keys))
         (by-command (make-hash-table :test 'eq))
         (by-package (make-hash-table :test 'equal))
         (mx (make-hash-table :test 'eq))
         (keys (make-hash-table :test 'equal))
         (indirect "(called by another command)"))
    (maphash (lambda (k v)
               (cl-incf total v)
               (cl-incf (gethash (car k) by-command 0) v)
               (cl-incf (gethash (bmp/command-usage--package (car k)) by-package 0) v)
               (cond ((equal (cdr k) "M-x") (cl-incf (gethash (car k) mx 0) v))
                     ((equal (cdr k) indirect))
                     (t (cl-incf (gethash (cdr k) keys 0) v))))
             bmp/command-usage)
    (with-current-buffer (get-buffer-create "*Command usage*")
      (let ((inhibit-read-only t))
        (erase-buffer)
        (org-mode)
        (insert (format "#+title: Command usage since %s\n\n%d commands counted. n / p: next / previous section, TAB: fold, g: refresh, q: quit.\n\n"
                        bmp/command-usage-since total))
        ;; 1
        (bmp/command-usage--section
         "Commands run with M-x that have a key"
         "Commands I typed with M-x although they have a key; the key is quicker."
         '("Command" "Times via M-x" "Its key"))
        (dolist (row (bmp/command-usage--sorted mx))
          (let ((key (where-is-internal (car row) nil t)))
            (when key
              (insert (format "| %s | %d | %s |\n" (car row) (cdr row)
                              (key-description key))))))
        ;; 2
        (bmp/command-usage--section
         "Keys with a standard Emacs equivalent"
         "Arrow, Home/End, Page Up/Down, Delete and similar keys I pressed, with the Emacs key for the same command (guru-mode's list, plus Ctrl-Backspace, Delete and the mouse wheel)."
         '("I pressed" "Times" "Emacs key" "Command"))
        (dolist (row (bmp/command-usage--sorted keys))
          (let ((entry (assoc (car row) emacs-keys)))
            (when entry
              (insert (format "| %s | %d | %s | %s |\n" (car row) (cdr row)
                              (nth 1 entry) (nth 2 entry))))))
        ;; 3
        (bmp/command-usage--section
         "My keys that replace a stock Emacs binding"
         "Global keys I used whose command differs from a clean Emacs (emacs -Q), so habits here will not carry over to a stock Emacs. Keys in mode-specific maps (Org, Magit...) are not included."
         '("Key" "My command" "Times" "emacs -Q has"))
        (let* ((global (seq-filter
                        (lambda (row)
                          (and (not (assoc (car row) emacs-keys))
                               (let ((cmd (ignore-errors (keymap-lookup global-map (car row)))))
                                 (and cmd (symbolp cmd)))))
                        (bmp/command-usage--sorted keys)))
               (defaults (bmp/command-usage--emacs-q-bindings (mapcar #'car global))))
          (dolist (row global)
            (let ((mine (keymap-lookup global-map (car row)))
                  (stock (cdr (assoc (car row) defaults))))
              (when (and stock (not (eq stock mine)))
                (insert (format "| %s | %s | %d | %s |\n"
                                (car row) mine (cdr row) stock))))))
        ;; 4
        (bmp/command-usage--section
         "Most used commands"
         "Everything counted, however it was run (keys, M-x, or called by other commands)."
         '("Command" "Times" "Package"))
        (dolist (row (seq-take (bmp/command-usage--sorted by-command) 40))
          (insert (format "| %s | %d | %s |\n" (car row) (cdr row)
                          (bmp/command-usage--package (car row)))))
        ;; 5
        (bmp/command-usage--section
         "Installed packages none of whose commands I used"
         "Packages installed on their own (not as a dependency) with no command counted. Those working through a mode are in use without commands; umbrella packages (such as casual-suite, whose commands come from casual) always appear here."
         '("Package" "Note"))
        (when (fboundp 'elpaca--queued)
          (dolist (pair (sort (copy-sequence (elpaca--queued))
                              (lambda (a b) (string< (car a) (car b)))))
            (let ((pkg (symbol-name (car pair))))
              (unless (or (elpaca<-dependents (cdr pair))
                          (gethash pkg by-package)
                          (member pkg '("elpaca" "elpaca-use-package")))
                (insert (format "| %s | %s |\n" pkg
                                (cond ((bmp/command-usage--mode-active-p pkg)
                                       "works through a mode, so keep")
                                      ((featurep (car pair)) "loaded, but no commands used")
                                      (t "not loaded since start-up"))))))))
        (org-table-map-tables #'org-table-align t)
        (goto-char (point-min))
        (org-fold-show-all))
      (read-only-mode 1)
      (bmp/command-usage-report-mode 1)
      (pop-to-buffer (current-buffer)))))

(use-package ef-themes
  :ensure t
  :config
  (setq ef-themes-mixed-fonts t
        ef-themes-variable-pitch-ui t)
  (mapc #'disable-theme custom-enabled-themes)

  (defun bmp/load-theme-once ()
    "Load the theme on the first client frame, then stop."
    (load-theme 'ef-owl :no-confirm)
    (remove-hook 'server-after-make-frame-hook #'bmp/load-theme-once))

  (if (daemonp)
      (add-hook 'server-after-make-frame-hook #'bmp/load-theme-once)
    (load-theme 'ef-owl :no-confirm)))

(use-package rainbow-mode
  :ensure t
  :config
  (add-hook 'prog-mode-hook 'rainbow-mode))

(setq spacious-padding-widths
      '( :internal-border-width 10
         :header-line-width 4
         :mode-line-width 0
         :tab-width 4
         :right-divider-width 10
         :scroll-bar-width 2))

(use-package spacious-padding
  :ensure t
  :hook (after-init . spacious-padding-mode))

(defun bmp/apply-frame-settings (frame)
  "Apply UI settings to newly created client frames.
Popup capture frames (see [[*Provide Emacs externally]]) are not maximized."
  (modify-frame-parameters
   frame
   `(,@(unless (frame-parameter frame 'prot-window-popup-frame)
         '((fullscreen . maximized)))
     (vertical-scroll-bars . nil)
     (internal-border-width . 2)
     (background-color . "#292c2f"))))

(add-hook 'after-make-frame-functions #'bmp/apply-frame-settings)

;; Apply immediately if not running as a daemon
(when (not (daemonp))
  (bmp/apply-frame-settings (selected-frame)))

(custom-set-faces
 `(variable-pitch ((t (:family "EB Garamond" :height 120))))
 `(fixed-pitch ((t (:family "FiraCode Nerd Font Mono" :height 100)))))

(set-frame-font "FiraCode Nerd Font Mono")

(set-face-attribute 'default nil :font "FiraCode Nerd Font Mono" :height 100)

(setf use-default-font-for-symbols nil)
;; Colour emoji are drawn natively (Emacs 29+); Symbola covers other symbols
(set-fontset-font t 'emoji "Noto Color Emoji" nil 'prepend)
(set-fontset-font t 'symbol "Noto Color Emoji" nil 'append)
(set-fontset-font t 'symbol "Symbola" nil 'append)

(use-package nerd-icons
  :ensure t)

(use-package nerd-icons-ibuffer
  :ensure t
  :hook (ibuffer-mode . nerd-icons-ibuffer-mode))

(use-package nerd-icons-corfu
  :ensure t
  :after corfu
  :config
  (add-to-list 'corfu-margin-formatters #'nerd-icons-corfu-formatter))

(setq tab-bar-close-button-show nil
      tab-bar-new-button-show nil
      tab-bar-tab-hints nil
      tab-bar-auto-width nil
      tab-bar-separator " "
      tab-bar-format '(tab-bar-format-tabs tab-bar-separator
                       tab-bar-format-align-right tab-bar-format-global))

(defvar bmp/tab-bar-name-width 18
  "Every tab name is shown in exactly this many characters.")

(defun bmp/tab-bar--tab-buffer (tab)
  "Return the buffer shown in TAB's selected window.
The tab's name carries it (see `bmp/tab-bar-tab-name')."
  (if (eq (car tab) 'current-tab)
      (window-buffer (or (minibuffer-selected-window) (selected-window)))
    (let ((name (alist-get 'name tab)))
      (or (and (stringp name) (get-text-property 0 'bmp-tab-buffer name))
          (and (stringp name) (get-buffer name))))))

(defun bmp/tab-bar--raw-name (tab buffer)
  "Name for TAB showing BUFFER, before shortening (see the rules above)."
  (if (not (buffer-live-p buffer))
      (or (and tab (alist-get 'name tab)) "")
    (with-current-buffer buffer
      (let ((file (buffer-file-name (or (buffer-base-buffer) buffer))))
        (cond
         ((and file (derived-mode-p 'org-mode) (org-get-title)))
         (file (file-name-nondirectory file))
         ((bound-and-true-p dired-directory)
          (file-name-as-directory
           (file-name-nondirectory (directory-file-name default-directory))))
         (t (string-remove-prefix
             "./" (string-trim (buffer-name) "[ *]+" "[ *]+"))))))))

(defun bmp/tab-bar--display-name (tab buffer)
  "TAB's name, cut to `bmp/tab-bar-name-width' with … and padded."
  (truncate-string-to-width (bmp/tab-bar--raw-name tab buffer)
                            bmp/tab-bar-name-width nil ?\s "…"))

(defun bmp/tab-bar-tab-name ()
  "Name a tab after the buffer in its selected window.
This is also the name `C-x t RET' lists; the buffer is kept on it."
  (let ((buffer (window-buffer (or (minibuffer-selected-window) (selected-window)))))
    (propertize (string-trim-right (bmp/tab-bar--display-name nil buffer))
                'bmp-tab-buffer buffer)))

(defun bmp/tab-bar--mode-with-icon (mode)
  "Return MODE, or its nearest parent mode, that nerd-icons has an icon for."
  (cl-loop for m = mode then (get m 'derived-mode-parent)
           while m
           when (assq m nerd-icons-mode-icon-alist) return m))

(defun bmp/tab-bar--icon (buffer)
  "Icon for BUFFER, found from its mode rather than a fixed list."
  (require 'nerd-icons)
  (if (not (buffer-live-p buffer))
      (nerd-icons-codicon "nf-cod-window")
    (with-current-buffer buffer
      (let ((known (bmp/tab-bar--mode-with-icon major-mode)))
        (cond
         ((or buffer-file-name (eq known major-mode))
          (nerd-icons-icon-for-buffer))
         (known (let ((spec (cdr (assq known nerd-icons-mode-icon-alist))))
                  (apply (car spec) (cdr spec))))
         ((bound-and-true-p dired-directory) (nerd-icons-codicon "nf-cod-folder"))
         ((derived-mode-p 'prog-mode) (nerd-icons-codicon "nf-cod-code"))
         ((derived-mode-p 'comint-mode 'term-mode 'eshell-mode)
          (nerd-icons-octicon "nf-oct-terminal"))
         ((derived-mode-p 'text-mode) (nerd-icons-codicon "nf-cod-file"))
         ((derived-mode-p 'special-mode) (nerd-icons-codicon "nf-cod-list_flat"))
         (t (nerd-icons-codicon "nf-cod-window")))))))

(defun bmp/tab-bar-tab-name-format (tab _i)
  "Show TAB as its icon and short name.
Activity tabs (see below) show a briefcase and the activity's name; tabs
I renamed (`C-x t r') show their buffer's icon and the name I gave."
  (let* ((current (eq (car tab) 'current-tab))
         (activity (alist-get 'activity (cdr tab)))
         (explicit (alist-get 'explicit-name tab))
         (buffer (bmp/tab-bar--tab-buffer tab))
         (icon (copy-sequence
                (if activity
                    (nerd-icons-codicon "nf-cod-briefcase")
                  (bmp/tab-bar--icon buffer))))
         (name (if (or activity explicit)
                   (truncate-string-to-width (alist-get 'name tab)
                                             bmp/tab-bar-name-width nil ?\s "…")
                 (bmp/tab-bar--display-name tab buffer)))
         (face (funcall tab-bar-tab-face-function tab)))
    (if current
        (add-face-text-property 0 (length icon) face 'append icon)
      (put-text-property 0 (length icon) 'face
                         (list :family nerd-icons-font-family :inherit face)
                         icon))
    (concat (propertize " " 'face face)
            icon
            (propertize (format " %s " name) 'face face))))

(defun bmp/tab-bar-faces (&rest _)
  "Flat, padded tabs in the current ef theme's colours."
  (when (seq-some (lambda (theme) (string-prefix-p "ef-" (symbol-name theme)))
                  custom-enabled-themes)
    (ef-themes-with-colors
      (set-face-attribute 'tab-bar nil :background bg-dim :box nil)
      (set-face-attribute 'tab-bar-tab nil :background bg-main :foreground fg-main
                          :weight 'bold :box `(:line-width (2 . 6) :color ,bg-main)
                          :underline `(:color ,accent-0 :position 0))
      (set-face-attribute 'tab-bar-tab-inactive nil :background bg-dim :foreground fg-dim
                          :weight 'normal :box `(:line-width (2 . 6) :color ,bg-dim)
                          :underline nil))))

(setq tab-bar-tab-name-function #'bmp/tab-bar-tab-name
      tab-bar-tab-name-format-function #'bmp/tab-bar-tab-name-format)
(add-hook 'enable-theme-functions #'bmp/tab-bar-faces)
(bmp/tab-bar-faces)
(tab-bar-mode 1)

(use-package activities
  :ensure t
  :custom
  ;; Activity tabs show a briefcase icon instead of the "α: " prefix
  (activities-name-prefix "")
  ;; Keep activities out of my bookmarks; the dashboard lists them instead
  (activities-bookmark-store nil)
  :init
  (activities-mode 1)
  (activities-tabs-mode 1)
  :bind (("C-x C-a C-n" . activities-new)
         ("C-x C-a C-d" . activities-define)
         ("C-x C-a C-a" . activities-resume)
         ("C-x C-a C-s" . activities-suspend)
         ("C-x C-a C-k" . activities-kill)
         ("C-x C-a RET" . activities-switch)
         ("C-x C-a b" . activities-switch-buffer)
         ("C-x C-a g" . activities-revert)
         ("C-x C-a l" . activities-list)))

;; An "Activities" section on the dashboard; selecting one resumes it
(defun bmp/dashboard-insert-activities (list-size)
  "Insert up to LIST-SIZE activities into the dashboard."
  (require 'activities)
  (dashboard-insert-section
   "Activities:"
   (dashboard-subseq (sort (mapcar #'car activities-activities) #'string<) list-size)
   list-size
   'activities
   (dashboard-get-shortcut 'activities)
   `(lambda (&rest _) (activities-resume (activities-named ,el)))
   el))

(with-eval-after-load 'dashboard
  (add-to-list 'dashboard-item-generators
               '(activities . bmp/dashboard-insert-activities))
  ;; Lower case: dashboard binds it to jump forward and its upper case back
  (add-to-list 'dashboard-item-shortcuts '(activities . "a"))
  (add-to-list 'dashboard-heading-icons
               '(activities . (nerd-icons-codicon "nf-cod-briefcase"))))

;; Emacs 30's vtable cannot redraw a table with no rows, so discarding
;; the last activity in C-x C-a l raised an error; close the list instead
(defun bmp/activities-list-close-when-empty (orig &rest args)
  "Call ORIG with ARGS, unless this is the activities list and it is empty."
  (if (and (equal (buffer-name) "*Activities*")
           (null activities-activities))
      (quit-window 'kill)
    (apply orig args)))

(advice-add 'vtable-revert-command :around #'bmp/activities-list-close-when-empty)

(defun bmp/transparency (value)
  "Sets the transparency of the frame window. 0=transparent/100=opaque"
  (interactive "nTransparency Value(0=transparent|100=opaque): ")
  (set-frame-parameter nil 'alpha-background value)
  (setf (alist-get 'alpha-background default-frame-alist) value))

(use-package dashboard
  :ensure t
  :config
  (dashboard-setup-startup-hook)
  :custom
  (dashboard-startup-banner (concat user-emacs-directory "gnu_color.webp"))
  (dashboard-image-banner-max-height 180)
  (dashboard-banner-logo-title nil)
  (dashboard-center-content t)
  (dashboard-vertically-center-content t)
  (dashboard-icon-type 'nerd-icons)
  (dashboard-set-heading-icons t)
  (dashboard-set-file-icons t)
  (dashboard-footer-icon nil)
  (dashboard-projects-backend 'project-el)
  (dashboard-display-icons-p t)
  (dashboard-items '(
                     (recents . 5)
                     (projects . 5)
                     (bookmarks . 5)
                     (activities . 5)   ; see [[*Tabs]]
                     ))
  (dashboard-path-style 'truncate-middle)
  (dashboard-path-max-length 50)
  (dashboard-bookmarks-item-format "%s")
  (dashboard-force-refresh t))

(defun bmp/dashboard-buffer ()
  "Rebuild the dashboard with a fresh fortune and return its buffer."
  (require 'dashboard)
  (setq dashboard-footer-messages
        (list (let ((inhibit-message t)) (fortune-message))))
  (dashboard-insert-startupify-lists t)
  (get-buffer dashboard-buffer-name))

(with-eval-after-load 'dashboard
  (add-hook 'window-size-change-functions #'dashboard-resize-on-hook 100)
  (add-hook 'window-setup-hook #'dashboard-resize-on-hook))

(setq initial-buffer-choice #'bmp/dashboard-buffer)

(defun bmp/dired-has-listing-p (&rest _)
  "Return non-nil when the current Dired buffer has a directory listing."
  (bound-and-true-p dired-subdir-alist))

(use-package nerd-icons-dired
  :ensure t
  :hook
  (dired-mode . nerd-icons-dired-mode)
  :config
  ;; Icons are drawn again after every listing (`dired-after-readin-hook'),
  ;; so skip the first refresh in a buffer that has no listing yet.
  (advice-add 'nerd-icons-dired--refresh :before-while
              #'bmp/dired-has-listing-p))

(use-package focus
  :ensure t)

(defvar bmp-conventional-commit-types
  '("feat" "fix" "docs" "style" "refactor" "perf" "test" "build" "ci" "chore" "revert"))

(defcustom bmp-conventional-commit-checks '(type-format summary-nopunct summary-length)
  "List of Conventional Commits checks."
  :type '(set (const type-format) (const summary-nopunct) (const summary-length))
  :group 'git-commit)

(defun bmp-git-commit-check-conventional-commits (force)
  "Enforce Conventional Commits (full summary)."
  (save-excursion
    (goto-char (point-min))
    ;; Skip comments, find first real line
    (when (re-search-forward "^\\([^#]\\)" nil t)
      (beginning-of-line)
      (let* ((summary (string-trim (thing-at-point 'line t)))
             (type-match (string-match
                          "^\\([a-z]+\\)\\(!?\\)\\(\\([a-z0-9]+\\)?:\\)?\\s-+\\(.*\\)"
                          summary))
             (commit-type (and type-match (match-string 1 summary)))
             (breaking (and type-match (match-string 2 summary)))
             (description (and type-match (match-string 5 summary))))


        (and
         ;; Check 1: FORMAT
         (or (not (memq 'type-format bmp-conventional-commit-checks))
             type-match
             (y-or-n-p (format "Invalid format: '%s'\nTry: feat: %s\nCommit anyway? "
                               summary (string-capitalize summary))))

         ;; Check 2: TYPE
         (or (not (memq 'type-format bmp-conventional-commit-checks))
             (null commit-type)
             (member commit-type bmp-conventional-commit-types)
             (y-or-n-p (format "Unknown type '%s'%s. Valid: %s\nCommit anyway? "
                               commit-type
                               (if breaking " (breaking!)" "")
                               (mapconcat #'identity bmp-conventional-commit-types ", "))))

         ;; Check 3: LENGTH
         (or (not (memq 'summary-length bmp-conventional-commit-checks))
             (<= (length summary) 50)
             (y-or-n-p "Summary too long (>50 chars). Continue? "))

         ;; Check 4: PUNCTUATION
         (or (not (memq 'summary-nopunct bmp-conventional-commit-checks))
             (null description)
             (not (string-match-p "[.!?;,:]$" description))
             (y-or-n-p "No trailing punctuation. Commit anyway? ")))))))



;; Magit configuration
(use-package magit
  :ensure t
  :bind ("C-x g" . magit-status)
  :init
  (setq magit-define-global-key-bindings nil)
  (setq magit-section-visibility-indicator '(" ▼"))
  :config
  (setq git-commit-summary-max-length 50)
  (setq git-commit-fill-column 72)
  (setq git-commit-style-convention-checks nil)
  (setq magit-refresh-status-buffer nil)
  (setq magit-diff-refine-hunk t)
  (add-hook 'after-save-hook 'magit-after-save-refresh-status t)
  (add-to-list 'git-commit-finish-query-functions
               #'bmp-git-commit-check-conventional-commits))

(use-package diff-hl
  :ensure t
  :config
  (global-diff-hl-mode)
  (diff-hl-flydiff-mode)
  (add-hook 'dired-mode-hook 'diff-hl-dired-mode)
  (add-hook 'magit-pre-refresh-hook 'diff-hl-magit-pre-refresh)
  (add-hook 'magit-post-refresh-hook 'diff-hl-magit-post-refresh)
  ;; C-x v * (or a click on a change mark in the fringe) shows the hunk
  ;; in a popup, with keys to revert, stage or move to the next hunk
  (setq diff-hl-show-hunk-function #'diff-hl-show-hunk-posframe)
  (global-diff-hl-show-hunk-mouse-mode 1))

(use-package winner
  :ensure nil
  :defer 1
  :config
  (winner-mode))

(use-package buffer-name-relative
  :ensure t
  :config
  (buffer-name-relative-mode 1))

(use-package bufler
  :ensure t)

(use-package ibuffer
  :hook (ibuffer-mode . ibuffer-auto-mode)
  :defer t)

(use-package consult-dir
  :ensure t
  :after vertico consult
  :bind (("C-x C-d" . consult-dir)
         :map vertico-map
         ("C-x C-d" . consult-dir)
         ("C-x C-j" . consult-dir-jump-file))
  :config
  (setq consult-dir-project-list-function #'consult-dir-project-dirs))

(file-name-shadow-mode 1)
(setq delete-by-moving-to-trash t)
(setq dired-dwim-target t)
(add-hook 'dired-mode-hook #'dired-hide-details-mode)
(setq dired-guess-shell-alist-user
  '(("\\.\\(png\\|jpe?g\\|tiff\\)" "feh" "xdg-open")
    ("\\.\\(mp[34]\\|m4a\\|ogg\\|flac\\|webm\\|mkv\\)" "mpv" "xdg-open")
  (".*" "xdg-open")))
(setq dired-recursive-copies 'always)
(setq dired-recursive-deletes 'always)

(use-package dired-sidebar
  :bind (("C-x C-n" . dired-sidebar-toggle-sidebar))
  :ensure t
  :commands (dired-sidebar-toggle-sidebar)
  :init
  (add-hook 'dired-sidebar-mode-hook
            (lambda ()
              (unless (file-remote-p default-directory)
                (auto-revert-mode))))
  :config
  (push 'toggle-window-split dired-sidebar-toggle-hidden-commands)
  (push 'rotate-windows dired-sidebar-toggle-hidden-commands)

  (setq dired-sidebar-subtree-line-prefix "__")
  (setq dired-sidebar-theme 'nerd-icons)
  (setq dired-sidebar-use-term-integration t)
  (setq dired-sidebar-use-custom-font t))

(use-package ready-player
  :ensure t
  :config
  (ready-player-mode +1))

(use-package dired-preview
  :ensure t
  :after ready-player
  :config
  (setq dired-preview-max-size (expt 2 20))
  (setq dired-preview-delay 2)
  (setq dired-preview-ignored-extensions-regexp
        (concat "\\."
                "\\(gz\\|"
                "zst\\|"
                "tar\\|"
                "xz\\|"
                "rar\\|"
                "zip\\|"
                "iso\\|"
                "gpg\\|"
                "epub"
                "\\)"))
  (dired-preview-global-mode 1))

(defun bmp/ready-player-dired-preview-play-toggle ()
  "Call `ready-player-toggle-play-stop' on the currently previewed media file."
  (interactive)
  (dired-preview-with-window
    (if-let* ((file buffer-file-name)
             (media (concat "\\." (regexp-opt ready-player-supported-media t) "\\'"))
             (_ (string-match-p media file)))
        (call-interactively #'ready-player-toggle-play-stop)
      (user-error "Cannot do something useful with `ready-player' here"))))

(require 'view)

(add-hook
 'view-mode-hook
 (lambda ()
   (cond ((derived-mode-p 'org-mode)
          (define-key view-mode-map (kbd "p") 'org-previous-visible-heading)
          (define-key view-mode-map (kbd "n") 'org-next-visible-heading))
         ((derived-mode-p 'markdown-mode)
          (define-key view-mode-map (kbd "p") 'markdown-outline-previous)
          (define-key view-mode-map (kbd "n") 'markdown-outline-next))
         ((derived-mode-p 'html-mode)
          (define-key view-mode-map (kbd "p") 'sgml-skip-tag-backward)
          (define-key view-mode-map (kbd "n") 'sgml-skip-tag-forward))
         ((derived-mode-p 'python-mode)
          (define-key view-mode-map (kbd "p") 'python-nav-backward-block)
          (define-key view-mode-map (kbd "n") 'python-nav-forward-block))
         ((derived-mode-p 'emacs-lisp-mode)
          (define-key view-mode-map (kbd "p") 'backward-sexp)
          (define-key view-mode-map (kbd "n") 'forward-sexp))
         ((derived-mode-p 'makefile-mode)
          (define-key view-mode-map (kbd "p") 'makefile-previous-dependency)
          (define-key view-mode-map (kbd "n") 'makefile-next-dependency))
         ((derived-mode-p 'c-mode)
          (define-key view-mode-map (kbd "p") 'c-beginning-of-defun)
          (define-key view-mode-map (kbd "n") 'c-end-of-defun))
         (t
          (define-key view-mode-map (kbd "p") 'scroll-down-command)
          (define-key view-mode-map (kbd "n") 'scroll-up-command)))))

(use-package bookmark
  :ensure nil
  :defer t)

(use-package bm
  :ensure t
  :config
  (setq bm-cycle-all-buffers t)
  (add-hook 'kill-buffer-hook #'bm-buffer-save)
  (add-hook 'kill-emacs-hook #'(lambda nil
    (bm-buffer-save-all)
    (bm-repository-save)))
  (add-hook 'after-save-hook #'bm-buffer-save)
  (add-hook 'find-file-hook   #'bm-buffer-restore)
  (add-hook 'after-revert-hook #'bm-buffer-restore)
  (setq bm-marker 'bm-marker-right)
  (global-set-key (kbd "<C-f2>") 'bm-toggle)
  (global-set-key (kbd "<f2>")   'bm-next)
  (global-set-key (kbd "<S-f2>") 'bm-previous)
  (global-set-key (kbd "<left-fringe> <mouse-5>") 'bm-next-mouse)
  (global-set-key (kbd "<left-fringe> <mouse-4>") 'bm-previous-mouse)
  (global-set-key (kbd "<left-fringe> <mouse-1>") 'bm-toggle-mouse))

(use-package org
  :ensure nil
  :demand t  ;; CRITICAL: Forces Elpaca's Org to load immediately, beating the built-in version
  :init
  ;; 1. Bulletproof auto-mode registration using the strict string-end anchor (\\')
  (add-to-list 'auto-mode-alist '("\\.\\(org\\|org_archive\\)\\'" . org-mode))

  ;; --- Basic Customization ---
  ;; Inline images and LaTeX previews are not rendered when every file
  ;; opens; add "#+startup: inlineimages latexpreview" to notes that want it.
  (setq org-agenda-start-with-log-mode t
        org-log-done 'time
        org-log-into-drawer t
        org-startup-indented t
        org-pretty-entities t
        org-use-sub-superscripts "{}"
        org-hide-emphasis-markers t
        org-image-actual-width '(300)
        org-fold-catch-invisible-edits 'smart)

  (add-hook 'org-mode-hook 'variable-pitch-mode)
  (add-hook 'org-mode-hook 'visual-line-mode)

  ;; Force the export subsystem to load immediately (fixes the C-c C-e delay)
  (require 'ox)
  ;; <s TAB and friends for inserting blocks
  (require 'org-tempo)

  :config
  ;; 2. Explicit Keybindings: Hardcoded directly into the map to bypass any use-package macro quirks
  (define-key org-mode-map (kbd "C-M-<return>") 'org-insert-subheading)
  (define-key org-mode-map (kbd "C-c C-e") 'org-export-dispatch)

  ;; --- Org Configuration ---
  (require 'oc-basic)
  (unless (functionp 'org-link-make-string)
    (fset 'org-link-make-string 'org-make-link-string))

  (with-eval-after-load 'ox-latex
    (add-to-list 'org-latex-classes
                 '("org-plain-latex"
                   "\\documentclass{article}\n[NO-DEFAULT-PACKAGES]\n[PACKAGES]\n[EXTRA]"
                   ("\\section{%s}" . "\\section*{%s}")
                   ("\\subsection{%s}" . "\\subsection*{%s}")
                   ("\\subsubsection{%s}" . "\\subsubsection*{%s}")
                   ("\\paragraph{%s}" . "\\paragraph*{%s}")
                   ("\\subparagraph{%s}" . "\\subparagraph*{%s}")))
    (setq org-latex-listings t)
    (add-to-list 'org-latex-packages-alist '("" "listings"))
    (add-to-list 'org-latex-packages-alist '("" "color"))
    (add-to-list 'org-latex-packages-alist '("AUTO" "babel" t ("pdflatex" "xelatex" "lualatex")))
    (add-to-list 'org-latex-packages-alist '("AUTO" "polyglossia" t ("xelatex" "lualatex"))))

  (org-babel-do-load-languages
   'org-babel-load-languages
   '((C . t) (css . t) (dot . t) (emacs-lisp . t)
     (java . t) (latex . t) (makefile . t) (org . t) (perl . t)
     (python . t) (R . t) (shell . t) (sql . t))))


(elpaca-wait)

(use-package ob-http
  :ensure t
  :after org
  :config
  (add-to-list 'org-babel-load-languages '(http . t))
  (org-babel-do-load-languages 'org-babel-load-languages org-babel-load-languages))

(use-package org-appear
  :ensure t
  :after org
  :hook
  (org-mode . org-appear-mode))

(use-package org-autolist
  :ensure t
  :hook (org-mode . org-autolist-mode))

(use-package org-tidy
  :ensure t
  :hook
  (org-mode . org-tidy-mode)
  :config
  (setq org-tidy-properties-style 'fringe)
  ;; "Protecting" a hidden drawer puts a key map of org-tidy's own beside it,
  ;; which replaced Org's keys there (C-<return>, C-c , and others
  ;; reported as undefined at the end of a heading line)
  (setq org-tidy-protect-overlay nil))

(use-package org-modern
  :ensure t
  :hook (org-mode . org-modern-mode)
  :custom
  (org-modern-star 'replace)
  (org-modern-replace-stars "◉")
  (org-modern-list '((?- . "◉") (?* . "◉") (?+ . "◦")))
  (org-modern-table nil)
  ;; Same as the default t, but as a list: org-link-beautify adds its
  ;; "transcribe" block to this with `add-to-list', which fails on t.
  (org-modern-block-name '((t . t))))

(use-package org-modern-indent
  :ensure (:host github :repo "jdtsmith/org-modern-indent")
  :config
  ;; As recommended upstream: run after org-modern in `org-mode-hook'
  (add-hook 'org-mode-hook #'org-modern-indent-mode 90))

(setq org-babel-results-keyword "results")

(setq org-src-fontify-natively t)

(setq org-structure-template-alist
      '(("c" . "center\n")
        ("C" . "comment\n")
        ("e" . "example\n")
        ("q" . "quote\n")
        ("v" . "verse\n")
        ("E" . "export")
        ("a" . "export ascii\n")
        ("h" . "export html\n")
        ("l" . "export latex\n")
        ("M" . "export markdown\n")
        ("m" . "markdown\n")
        ("P" . "src py\n")
        ("j" . "src java\n")
        ("s" . "src\n")
        ("t" . "tex\n")
        ("el" . "src emacs-lisp\n")
        ("ein" . "src emacs-lisp :tangle ~/.config/emacs/init.el\n")
        ("py" . "src python\n")
        ("sh" . "src sh\n")
        ("md" . "src markdown\n")
        ("go" . "src go\n")
        ("tex" . "src tex\n")
        ("java" . "src java\n")
        ("sr" . "src R\n")
        ))

(defun bmp/packages--forms (form)
  "Return every `use-package' and `elpaca' form inside FORM."
  (when (and (consp form)
             ;; Quoted lists are data (such as Elpaca's own recipe), not code
             (not (memq (car form) '(quote \` function))))
    (if (and (memq (car form) '(use-package elpaca)) (cdr form))
        (list form)
      (let (found)
        (while (consp form)
          (setq found (nconc found (bmp/packages--forms (car form)))
                form (cdr form)))
        found))))

(defun bmp/packages--declared ()
  "Packages this Org file sets up, in order: (NAME KEYWORDS HEADING).
Only blocks that are tangled count; code kept for reference is skipped."
  (let (packages)
    (org-babel-map-src-blocks nil
      (let* ((info (org-babel-get-src-block-info 'no-eval))
             (tangle (cdr (assq :tangle (nth 2 info)))))
        (when (and (equal lang "emacs-lisp") tangle (not (equal tangle "no")))
          (let ((heading (save-excursion (org-back-to-heading t)
                                         (org-get-heading t t t t))))
            (with-temp-buffer
              (insert body)
              (goto-char (point-min))
              (condition-case nil
                  (while t
                    (dolist (form (bmp/packages--forms (read (current-buffer))))
                      (let ((name (if (consp (cadr form)) (car (cadr form)) (cadr form))))
                        ;; (use-package emacs ...) holds Emacs's own settings
                        (when (and (symbolp name) (not (keywordp name))
                                   (not (memq name '(emacs \`)))
                                   (not (assq name packages)))
                          (push (list name (if (eq (car form) 'use-package) (cddr form) nil)
                                      heading)
                                packages)))))
                (error nil)))))))
    (nreverse packages)))

(defun bmp/packages--loads (keywords)
  "When a package with use-package KEYWORDS is loaded, in a few words."
  (cond ((null keywords) "at start-up")
        ((plist-get keywords :demand) "at start-up")
        ((let ((how (seq-filter (lambda (k) (plist-member keywords k))
                                '(:hook :bind :bind* :commands :mode :interpreter :defer))))
           (and how (concat "when needed ("
                            (mapconcat (lambda (k) (substring (symbol-name k) 1)) how ", ")
                            ")"))))
        ((plist-get keywords :after)
         (format "after %s" (mapconcat (lambda (p) (format "%s" p))
                                       (ensure-list (plist-get keywords :after)) ", ")))
        (t "at start-up")))

(defun bmp/packages--url (e)
  "Web address of Elpaca package E's repository, if known."
  (let* ((recipe (elpaca<-recipe e))
         ;; GNU ELPA recipes give (ADDRESS . NAME); MELPA ones say :fetcher, not :host
         (repo (let ((r (plist-get recipe :repo))) (if (consp r) (car r) r)))
         (repo (or repo (plist-get recipe :url)))
         (host (or (plist-get recipe :host) (plist-get recipe :fetcher))))
    (cond ((and (stringp repo) (string-match-p "\\`https?://" repo))
           (string-remove-suffix ".git" repo))
          ((and (stringp repo) (memq host '(github gitlab codeberg sourcehut)))
           (format "https://%s/%s"
                   (pcase host
                     ('github "github.com") ('gitlab "gitlab.com")
                     ('codeberg "codeberg.org") ('sourcehut "git.sr.ht")
                     (_ (format "%s" host)))
                   (if (eq host 'sourcehut) (concat "~" repo) repo))))))

(defun bmp/packages--summary (file)
  "The one-line description at the top of the Emacs Lisp FILE."
  (when (and file (file-exists-p file))
    (require 'lisp-mnt)
    (ignore-errors (lm-summary file))))

(defun bmp/packages--owner (name)
  "Where library NAME comes from: (elpaca . E), (builtin . FILE) or nil.
Extensions such as vertico-directory belong to the package that ships them."
  (let ((e (ignore-errors (elpaca-get name)))
        (lib (locate-library (symbol-name name))))
    (cond (e (cons 'elpaca e))
          ((null lib) nil)
          ((string-match "/elpaca/builds/\\([^/]+\\)/" lib)
           (let ((owner (ignore-errors (elpaca-get (intern (match-string 1 lib))))))
             (and owner (cons 'elpaca owner))))
          ((file-in-directory-p lib (expand-file-name "../lisp" data-directory))
           (cons 'builtin lib)))))

(defun bmp/packages--source-file (lib)
  "The .el (or .el.gz) source next to the compiled library LIB."
  (let ((el (concat (file-name-sans-extension lib) ".el")))
    (cond ((file-exists-p el) el)
          ((file-exists-p (concat el ".gz")) (concat el ".gz")))))

(defun bmp/packages--cell (string)
  "STRING made safe for an Org table cell."
  (string-trim (replace-regexp-in-string "|" "/" (or string ""))))

(defun bmp/packages-write (&optional dir)
  "Write packages.org next to this Org file (or in DIR): every package it sets up.
The list comes from this file's `use-package' and `elpaca' forms; the
description, version and dependencies from the package itself and Elpaca."
  (interactive)
  (let* ((declared (bmp/packages--declared))
         (names (mapcar #'car declared))
         (needed nil)
         (rows
          (mapcar
           (lambda (p)
             (pcase-let* ((`(,name ,keywords ,heading) p)
                          (owner (bmp/packages--owner name))
                          (e (and (eq (car owner) 'elpaca) (cdr owner)))
                          (own (and e (eq (elpaca<-id e) name)))  ; its own package
                          (url (and e (bmp/packages--url e)))
                          (lib (locate-library (symbol-name name)))
                          (main (or (and lib (bmp/packages--source-file lib))
                                    (and own (ignore-errors
                                               (expand-file-name (elpaca--main-file e)
                                                                 (elpaca<-source-dir e))))))
                          (commit (and e (ignore-errors
                                           (car (process-lines "git" "-C" (elpaca<-source-dir e)
                                                               "log" "-1" "--format=%h (%cs)")))))
                          (version (cond ((and e own) commit)
                                         (e (format "part of %s, %s" (elpaca<-id e) commit))
                                         ((eq (car owner) 'builtin)
                                          (format "built-in (Emacs %s)" emacs-version))
                                         (t "not found")))
                          (deps (and own (seq-remove (lambda (d) (eq d 'emacs))
                                                     (mapcar #'car (ignore-errors (elpaca--dependencies e)))))))
               ;; Packages Elpaca installed only because something here needs them
               (dolist (d (and own (ignore-errors (elpaca-dependencies name '(emacs)))))
                 (unless (or (memq d names) (not (ignore-errors (elpaca-get d))))
                   (cl-pushnew d needed)))
               (format "| %s | %s | [[*%s][%s]] | %s | %s | %s |"
                       (if url (format "[[%s][%s]]" url name) name)
                       (bmp/packages--cell (bmp/packages--summary main))
                       heading (bmp/packages--cell heading)
                       (bmp/packages--loads keywords)
                       version
                       (bmp/packages--cell (mapconcat #'symbol-name deps ", ")))))
           declared))
         (file (expand-file-name "packages.org"
                                 (or dir (file-name-directory (buffer-file-name (buffer-base-buffer)))))))
    (with-temp-file file
      (insert "# Generated by bmp/packages-write when the site is exported; do not edit.\n\n"
              (format "%d packages are set up in this file; %d more are installed only because they need them%s.\n\n"
                      (length rows) (length needed)
                      (if needed
                          (concat ": " (mapconcat #'symbol-name (sort needed #'string<) ", "))
                        ""))
              "| Package | What it is | Configured in | Loads | Version | Depends on |\n|-\n"
              (string-join rows "\n") "\n")
      (delay-mode-hooks (org-mode))
      (goto-char (point-min))
      (when (re-search-forward "^|" nil t)
        (org-table-align)))
    (message "Wrote %s (%d packages)" file (length rows))
    file))

(defun bmp/export-site ()
  "Write packages.org (see `bmp/packages-write'), then export this file
to index.html with the site theme in assets/forgemacs/."
  (interactive)
  (bmp/packages-write)
  (let ((org-html-doctype "html5")
        (org-html-html5-fancy t)
        ;; Code is coloured by class (one per Emacs face), so the site's
        ;; light and dark modes can colour it, instead of this Emacs
        ;; theme's colours written into every span
        (org-html-htmlize-output-type 'css)
        ;; The theme draws the table rules; Org's default attributes
        ;; (border, rules, frame) add borders of their own
        (org-html-table-default-attributes nil)
        (org-html-head-include-scripts nil)
        (org-html-metadata-timestamp-format "%I:%M%p, %a %e %b %Y")
        ;; The format below is only used when the postamble is t; the
        ;; default, auto, writes Org's own "Created:" footer instead
        (org-html-postamble t)
        (org-html-postamble-format
         '(("en" "<p class=\"author\">Author: %a </p>\n<p class=\"date\">Modified: %C</p><p class=\"author\"><a href=\"&#109;&#97;&#105;&#108;&#116;&#111;&#58;&#109;&#97;&#105;&#108;&#64;&#98;&#104;&#97;&#114;&#97;&#116;&#104;&#112;&#97;&#108;&#97;&#118;&#97;&#108;&#108;&#105;&#46;&#99;&#111;&#109;\" target=\"_blank\" rel=\"noopener\">Questions</a></p>"))))
    (org-export-to-file 'html "index.html")))

(defun bmp/export-tangle-init ()
  "Export this file to index.html (see `bmp/export-site'), then tangle it."
  (interactive)
  (bmp/export-site)
  (org-babel-tangle))

(use-package corg
  :ensure (:host github :repo "isamert/corg.el"))

(add-hook 'org-mode-hook #'corg-setup)

(use-package ob-compile
  :ensure t
  :config (add-hook 'compilation-finish-functions #'ob-compile-save-file))

(use-package org-fragtog
  :ensure t
  :after org
  :hook
  (org-mode . org-fragtog-mode)
  :custom
  (org-startup-with-latex-preview t)
  :config
  ;; Not `auto' colours: Org 10 then reads the face at point, which is nil
  ;; when a whole buffer is previewed on opening, and `org-mode' fails.
  (setq org-format-latex-options
        (plist-put org-format-latex-options :scale 1)))

(use-package valign
  :ensure t)

(add-hook 'org-mode-hook #'valign-mode)

(defun bmp/valign-skip-org-indent-realign ()
  "Stop valign realigning every table each time org-indent finishes.
valign still aligns tables as they are displayed; this extra pass took
84% of the time in large notes with many tables."
  (advice-remove 'org-indent-initialize-agent #'valign--org-indent-advice))

;; valign adds the advice whenever it is turned on, so remove it afterwards
(add-hook 'valign-mode-hook #'bmp/valign-skip-org-indent-realign)

(defun bmp/org-sum-list-with-commas (val-list)
  "Takes a list of strings from an Org table, strips commas, sums them,
and returns the total cleanly formatted with thousands separators and bolded."
  (let ((total 0))
    (dolist (item val-list)
      ;; Force the item to a string, clear commas, and add to running total
      (let ((clean-string (replace-regexp-in-string "," "" (format "%s" item))))
        (setq total (+ total (string-to-number clean-string)))))

    (let ((total-str (number-to-string total)))
      ;; Inject thousands commas natively back into the final summation string
      (while (string-match "\\([-+]?[0-9]+\\)\\([0-9]\\{3\\}\\)" total-str)
        (setq total-str (replace-match "\\1,\\2" nil nil total-str)))

      ;; Output the total wrapped in bold markdown asterisks
      (format "*%s*" total-str))))

(defvar bmp/org-image-resize-timer nil
  "Pending timer for `bmp/org-image-resize'.")

(defun bmp/org-image-resize-frame (frame)
  "Fit inline images in every Org window on FRAME to the window width."
  (when (frame-live-p frame)
    (dolist (win (window-list frame 'no-minibuf))
      (with-selected-window win
        (when (derived-mode-p 'org-mode)
          (setq-local org-image-actual-width
                      (if (< (window-total-width) 80)
                          (window-pixel-width)
                        (* 80 (window-font-width))))
          (org-link-preview-refresh))))))

(defun bmp/org-image-resize (frame)
  "Refit Org images on FRAME once resizing has settled."
  (when (timerp bmp/org-image-resize-timer)
    (cancel-timer bmp/org-image-resize-timer))
  (setq bmp/org-image-resize-timer
        (run-with-idle-timer 0.5 nil #'bmp/org-image-resize-frame frame)))

(add-hook 'window-size-change-functions #'bmp/org-image-resize)

  (defun bmp/display-inline-images ()
  (condition-case nil
      (org-link-preview-region)
    (error nil)))

(add-hook 'org-babel-after-execute-hook 'bmp/display-inline-images 'append)

(use-package djvu
  :ensure t)

(use-package org-noter
  :ensure t
  :after pdf-tools nov org-roam
  :config
  (setq org-noter-always-create-frame t)
  (org-noter-enable-org-roam-integration))

(with-eval-after-load 'org-noter
  (setq org-noter-arrow-background-color "yellow"
        org-noter-arrow-foreground-color "red"))

;; org-noter narrows the notes buffer to the document's heading; jinx's
;; background check then reaches outside the narrowed part and fails with
;; args-out-of-range, so spell-checking is off in noter sessions only.
(add-hook 'org-noter-notes-mode-hook
          (lambda () (when (bound-and-true-p jinx-mode) (jinx-mode -1))))
;; In that narrowed copy, org-modern-indent's block brackets from folded
;; headings pile up as a column of corners below the last heading.
(add-hook 'org-noter-notes-mode-hook
          (lambda ()
            (when (bound-and-true-p org-modern-indent-mode)
              (org-modern-indent-mode -1))))

(use-package org-rich-yank
  :ensure t
  ;; Loaded at start-up: it notes where copied text came from only once
  ;; it is loaded, so C-M-y can wrap it in the right source block
  :demand t
  :bind (:map org-mode-map
              ("C-M-y" . org-rich-yank)))

(use-package toc-org
  :ensure t
  :after org
  :init (add-hook 'org-mode-hook #'toc-org-enable))

(use-package org-auto-tangle
  :ensure t
  :after org
  :hook (org-mode . org-auto-tangle-mode))

(use-package org-transclusion
  :ensure t
  :after org
  :bind
  (:map global-map
        ("<f12>" . #'org-transclusion-add)
        ("C-c t" . #'org-transclusion-mode))
  :config
  ;; Pick a note from org-roam's database (fast) before falling back to
  ;; Org's general link prompt, whose id: completion scans every note
  (setq org-transclusion-insert-link-functions
        '(org-roam-node-insert org-insert-link)))

(defvar orgfold-directory (expand-file-name "orgfold/" no-littering-var-directory)
  "Directory holding the saved fold state of Org files.")

(defun orgfold-get-fold-info-file-name ()
  "Return the fold-state file for the current buffer's file."
  (expand-file-name (concat (url-hexify-string (file-truename (buffer-file-name)))
                            ".fold")
                    orgfold-directory))

(defun orgfold-save ()
  (save-excursion
    (goto-char (point-min))

    (let (foldstates)
      (unless (looking-at outline-regexp)
        (outline-next-visible-heading 1))

      (while (not (eobp))
        ;; Org 9.6+ folds with text properties, not overlays
        (push (and (invisible-p (line-end-position)) t) foldstates)
        (outline-next-visible-heading 1))

      (make-directory orgfold-directory t)
      (with-temp-file (orgfold-get-fold-info-file-name)
        (prin1 (nreverse foldstates) (current-buffer))))))

(defun orgfold-restore ()
  (save-excursion
    (goto-char (point-min))
    (let* ((foldfile (orgfold-get-fold-info-file-name))
           (foldstates
            (when (file-readable-p foldfile)
              (with-temp-buffer
                (insert-file-contents foldfile)
                (when (> (buffer-size) 0)
                  (read (current-buffer)))))))

      (when foldstates
        (org-fold-show-all)
        (goto-char (point-min))

        (unless (looking-at outline-regexp)
          (outline-next-visible-heading 1))

        (while (and foldstates
                    (not (eobp)))
          (when (pop foldstates)
            (org-fold-hide-subtree))

          (outline-next-visible-heading 1))

        (message "Restored saved folding")))))


(add-hook 'org-mode-hook 'orgfold-activate)

(defun orgfold-activate ()
  (when (and (buffer-file-name) (not (buffer-base-buffer)))
    (orgfold-restore)
    (add-hook 'kill-buffer-hook 'orgfold-kill-buffer nil t)))

(defun bmp/orgfold-forget ()
  "Delete the saved fold state of this file; Org's start-up settings apply again."
  (interactive)
  (let ((file (orgfold-get-fold-info-file-name)))
    (remove-hook 'kill-buffer-hook 'orgfold-kill-buffer t)
    (when (file-exists-p file)
      (delete-file file))
    (message "Fold state forgotten; #+startup and :VISIBILITY: apply next time")))

(defun orgfold-kill-buffer ()
  ;; Don't save folding info for unsaved buffers, or for indirect buffers
  ;; such as org-capture's, which have no file of their own but inherit
  ;; this hook from the note's buffer.
  (when (and (buffer-file-name)
             (not (buffer-base-buffer))
             (not (buffer-modified-p)))
    (orgfold-save)))

(use-package org-bookmark-heading
  :ensure t
  :after org)

;; Org sets a bookmark after every capture and refile; with
;; org-bookmark-heading each was renamed after its heading, so they
;; piled up in C-x r l.  Without these names Org sets none.
(setq org-bookmark-names-plist nil)

;; ============================================================
;; HAM Radio Call Sign to QRZ.com Link Conversion
;; Author: BMP
;; Description: Converts the HAM radio call sign at point
;;              to a QRZ.com link, on request
;; ============================================================

(defcustom bmp/ham-qrz-timeout 10
  "Timeout in seconds for QRZ.com verification requests.
                Increase this value if you have a slow internet connection."
  :type 'integer
  :group 'org)

(defun bmp/ham-callsign-at-point ()
  "Detect and return a HAM radio call sign at the current cursor position.

  Supports multiple call sign formats:

  1. Standard ITU format (99% of calls):
     - 1-3 letters prefix + digit + letter-based suffix
     - Examples: W1AW, VU2GLJ, KD2XYZ, G3ABC

  2. Digit-prefix format (Israel, Croatia, etc.):
     - Starts with digit, followed by letter(s), digit, suffix
     - Examples: 4X1AB, 9A1A, 3D2AB

  3. New Indian format (June 2025):
     - VU2/VU3 + digit(1-9) + 2 letters
     - Examples: VU22AR, VU33IG

  Returns uppercased call sign or nil if invalid."
  (let ((word (thing-at-point 'word t)))
    (when (and word
               (>= (length word) 4)  ; Minimum 4 chars (blocks A1A, W1A)
               (or
                ;; Pattern 1: Standard format (letter prefix)
                ;; [A-Z]{1,3} + [0-9] + (all letters OR letters+digit+2+letters)
                (string-match-p
                 "^[A-Z]\\{1,3\\}[0-9]\\([A-Z]+\\|[A-Z]+[0-9][A-Z]\\{2,\\}\\)$"
                 (upcase word))

                ;; Pattern 2: Digit-prefix format (Israel, Croatia, Fiji, etc.)
                ;; [0-9] + [A-Z]{1,2} + [0-9] + [A-Z]{1,4}
                (string-match-p
                 "^[0-9][A-Z]\\{1,2\\}[0-9][A-Z]+$"
                 (upcase word))

                ;; Pattern 3: New Indian format
                ;; VU + [2 or 3] + [1-9] + [exactly 2 letters]
                (string-match-p
                 "^VU[23][1-9][A-Z]\\{2\\}$"
                 (upcase word))))
      (upcase word))))

(defun bmp/ham-check-qrz (callsign)
  "Verify if a HAM radio CALLSIGN exists on QRZ.com database.

              This function performs a synchronous HTTP request to QRZ.com to check
              if the given call sign has a valid entry in their database. It's useful
              to prevent creating dead links for non-existent or invalid call signs.

              Arguments:
                CALLSIGN - String representing the HAM radio call sign to verify

              Returns:
                - t (true) if the call sign exists on QRZ.com
                - nil if the call sign is not found, network error, or timeout

              Implementation details:
                - Uses Emacs built-in 'url' library for HTTP requests
                - Timeout: Configurable via `bmp/ham-qrz-timeout` (default 10 seconds)
                - Detection method: Searches for 'No results found' text in response
                - Automatically cleans up the buffer after checking
                - Can be cancelled with C-g (keyboard-quit)

              Error handling:
                - Network failures return nil with error message
                - Timeout returns nil with timeout message
                - User can press C-g to cancel the operation

              Note: This function requires an active internet connection."
  (require 'url)
  (condition-case err
      (let* ((url (format "https://www.qrz.com/db/%s" callsign))
             (url-request-extra-headers '(("User-Agent" . "Emacs")))
             (buffer (progn
                       (message "Contacting QRZ.com (press C-g to cancel)...")
                       (url-retrieve-synchronously url t nil bmp/ham-qrz-timeout))))
        (if (not buffer)
            (progn
              (message "Timeout: QRZ.com did not respond within %d seconds"
                       bmp/ham-qrz-timeout)
              nil)
          (with-current-buffer buffer
            (goto-char (point-min))
            (let ((exists (not (search-forward "No results found" nil t))))
              (kill-buffer buffer)
              (if exists
                  (message "Call sign %s verified on QRZ.com" callsign)
                (message "Call sign %s not found on QRZ.com" callsign))
              exists))))
    (quit
     ;; Handle C-g gracefully
     (message "QRZ.com check cancelled by user")
     nil)
    (error
     ;; Handle other errors (network issues, etc.)
     (message "Error checking QRZ.com: %s" (error-message-string err))
     nil)))

(defun bmp/ham-convert-to-qrz-link ()
  "Interactively convert HAM call sign at point to an Org mode QRZ.com link.

                  This function is designed to be called manually (via M-x) to convert
                  a HAM radio call sign under the cursor into a clickable Org mode link
                  that points to the call sign's page on QRZ.com.

                  Workflow:
                    1. Detects if there's a valid call sign at the current cursor position
                    2. Verifies the call sign exists on QRZ.com (network request)
                    3. Prompts user for confirmation before converting
                    4. Replaces the plain text call sign with an Org link

                  Example transformation:
                    Before: W1AW
                    After:  [[https://www.qrz.com/db/W1AW](https://www.qrz.com/db/W1AW)[W1AW]]

                  User interaction:
                    - Shows status messages during QRZ.com verification
                    - Asks 'Convert CALLSIGN to QRZ.com link? (y or n)'
                    - Only proceeds if user confirms with 'y'

                  Error handling:
                    - Displays message if no valid call sign found at point
                    - Displays message if call sign doesn't exist on QRZ.com

                  Network requirement: Active internet connection needed for verification."
  (interactive)
  (let ((callsign (bmp/ham-callsign-at-point)))
    (if (not callsign)
        (message "No valid HAM call sign found at point")
      (message "Checking %s on QRZ.com..." callsign)
      (if (bmp/ham-check-qrz callsign)
          (when (y-or-n-p (format "Convert %s to QRZ.com link? " callsign))
            (let* ((bounds (bounds-of-thing-at-point 'word))
                   (url (concat "https://www.qrz.com/db/" callsign))
                   (link-text (concat "[[" url "][" callsign "]]")))
              (delete-region (car bounds) (cdr bounds))
              (insert link-text)
              (message "Converted to QRZ link!")))
        (message "Call sign %s not found on QRZ.com" callsign)))))

(use-package jinx
  :ensure t
  :hook (emacs-startup . global-jinx-mode)
  :bind (("M-$" . jinx-correct)
         ("C-M-$" . jinx-languages))
  :config

  (setq jinx-languages "en_GB"))

(defun jinx--add-to-abbrev (overlay word)
  "Add abbreviation to `global-abbrev-table'.
   The misspelled word is taken from OVERLAY.  WORD is the corrected word."
  (let ((abbrev (buffer-substring-no-properties
                 (overlay-start overlay)
                 (overlay-end overlay))))
    (message "Abbrev: %s -> %s" abbrev word)
    (define-abbrev global-abbrev-table abbrev word)))

(advice-add 'jinx--correct-replace :before #'jinx--add-to-abbrev)

systemctl --user disable --now homebrew.languagetool

(use-package langtool
  :ensure t
  :config
  (setq langtool-default-language "en-GB"
        langtool-mother-tongue "en"
        langtool-http-server-host "localhost"
        langtool-http-server-port 8081
        langtool-bin nil
        langtool-language-tool-server-jar nil))

;; --- The server: started on demand, stopped when idle
(defvar bmp/langtool-unit "homebrew.languagetool"
  "Systemd user unit of the LanguageTool server.")
(defvar bmp/langtool-idle-minutes 10
  "Stop the LanguageTool server after this many minutes without a check.")
(defvar bmp/langtool--stop-timer nil)

(defun bmp/langtool--server-up-p ()
  "Return non-nil if the LanguageTool server answers properly."
  (require 'url)
  (let ((buffer (ignore-errors
                  (url-retrieve-synchronously
                   "http://127.0.0.1:8081/v2/languages" t nil 2))))
    (when buffer
      (with-current-buffer buffer
        (prog1 (and (bound-and-true-p url-http-end-of-headers)
                    (eql (bound-and-true-p url-http-response-status) 200))
          (kill-buffer))))))

(defun bmp/langtool--ensure-server (&rest _)
  "Start the LanguageTool service if needed and wait until it answers."
  (unless (bmp/langtool--server-up-p)
    (call-process "systemctl" nil nil nil "--user" "start" bmp/langtool-unit)
    (let ((deadline (+ (float-time) 180)))
      (while (not (bmp/langtool--server-up-p))
        (when (> (float-time) deadline)
          (user-error "LanguageTool did not start; see journalctl --user -u %s"
                      bmp/langtool-unit))
        (message "Starting LanguageTool (C-g to stop waiting)...")
        (sleep-for 1))))
  (when (timerp bmp/langtool--stop-timer)
    (cancel-timer bmp/langtool--stop-timer))
  (setq bmp/langtool--stop-timer
        (run-at-time (* 60 bmp/langtool-idle-minutes) nil
                     #'bmp/langtool--stop-server)))

(defun bmp/langtool--stop-server ()
  "Stop the LanguageTool service in the background."
  (setq bmp/langtool--stop-timer nil)
  (start-process "langtool-stop" nil
                 "systemctl" "--user" "stop" bmp/langtool-unit))

(add-hook 'kill-emacs-hook
          (lambda () (when (timerp bmp/langtool--stop-timer)
                       (bmp/langtool--stop-server))))

;; --- Rules: default, permanent, session and buffer levels
(defvar bmp/langtool-default-disabled-rules
  '("WHITESPACE_RULE" "MORFOLOGIK_RULE_EN_GB" "OXFORD_SPELLING_Z_NOT_S")
  "Rules off unless changed with `bmp/langtool-rule'.")
(defvar bmp/langtool-rules-file
  (expand-file-name "langtool-disabled-rules.el" no-littering-var-directory)
  "Where the permanent list of disabled rules is kept once changed.")
(defvar bmp/langtool-session-disabled-rules nil
  "Rules off for this Emacs session.")
(defvar-local bmp/langtool-buffer-disabled-rules nil
  "Rules off in this buffer.")

(defun bmp/langtool--permanent-rules ()
  "Return the permanent list (the saved one, or the defaults)."
  (if (file-exists-p bmp/langtool-rules-file)
      (with-temp-buffer
        (insert-file-contents bmp/langtool-rules-file)
        (read (current-buffer)))
    bmp/langtool-default-disabled-rules))

(defun bmp/langtool--save-permanent (rules)
  (make-directory (file-name-directory bmp/langtool-rules-file) t)
  (with-temp-file bmp/langtool-rules-file
    (insert ";; Rules LanguageTool skips; edit with M-x bmp/langtool-rules\n")
    (prin1 (sort (delete-dups (copy-sequence rules)) #'string<) (current-buffer))
    (insert "\n")))

(defun bmp/langtool--apply-rules (&rest _)
  "Give langtool the rules off at every level, before a check."
  (setq langtool-disabled-rules
        (delete-dups (append (bmp/langtool--permanent-rules)
                             bmp/langtool-session-disabled-rules
                             bmp/langtool-buffer-disabled-rules))))

(defun bmp/langtool-rule ()
  "Show the rule of the LanguageTool issue at point and turn it off."
  (interactive)
  (let* ((ov (car (langtool--current-error-overlays)))
         (rule (and ov (overlay-get ov 'langtool-rule-id))))
    (unless rule
      (user-error "No LanguageTool issue at point"))
    (pcase (read-char-choice
            (format "%s: %s\nTurn off in this [b]uffer, this [s]ession, [p]ermanently, or [q]uit? "
                    rule (overlay-get ov 'langtool-simple-message))
            '(?b ?s ?p ?q))
      (?b (cl-pushnew rule bmp/langtool-buffer-disabled-rules :test #'equal))
      (?s (cl-pushnew rule bmp/langtool-session-disabled-rules :test #'equal))
      (?p (bmp/langtool--save-permanent
           (cons rule (bmp/langtool--permanent-rules))))
      (?q (setq rule nil)))
    (when rule
      ;; Remove that rule's marks now; the next check leaves it out
      (dolist (o (langtool--overlays-region (point-min) (point-max)))
        (when (equal (overlay-get o 'langtool-rule-id) rule)
          (delete-overlay o)))
      (message "%s is off" rule))))

(defun bmp/langtool-rules ()
  "List the rules that are off, and turn one back on."
  (interactive)
  (let* ((rows (append
                (mapcar (lambda (r) (cons (format "%-32s permanent" r) (cons 'permanent r)))
                        (bmp/langtool--permanent-rules))
                (mapcar (lambda (r) (cons (format "%-32s session" r) (cons 'session r)))
                        bmp/langtool-session-disabled-rules)
                (mapcar (lambda (r) (cons (format "%-32s this buffer" r) (cons 'buffer r)))
                        bmp/langtool-buffer-disabled-rules)))
         (choice (cdr (assoc (completing-read "Turn back on (rule  level): "
                                              (mapcar #'car rows) nil t)
                             rows))))
    (pcase (car choice)
      ('permanent (bmp/langtool--save-permanent
                   (remove (cdr choice) (bmp/langtool--permanent-rules))))
      ('session (setq bmp/langtool-session-disabled-rules
                      (remove (cdr choice) bmp/langtool-session-disabled-rules)))
      ('buffer (setq bmp/langtool-buffer-disabled-rules
                     (remove (cdr choice) bmp/langtool-buffer-disabled-rules))))
    (message "%s is on again; run the check again to see its issues" (cdr choice))))

;; --- Encoding: send every character percent-encoded
(defvar bmp/langtool--text-start nil
  "Buffer position where the text being checked starts.")

(defun bmp/langtool--query-string (query)
  "Like `url-build-query-string', but also encodes % and +."
  (mapconcat (lambda (kv)
               (concat (url-hexify-string (format "%s" (car kv))) "="
                       (url-hexify-string (format "%s" (or (cadr kv) "")))))
             query "&"))

(defun bmp/langtool--encode-query (orig &optional begin finish lang)
  "Build the request with ORIG, encoding it fully; note where text starts."
  (let ((bmp/langtool--text-start (or begin (point-min))))
    (cl-letf (((symbol-function 'url-build-query-string)
               #'bmp/langtool--query-string))
      (funcall orig begin finish lang))))

;; --- Only prose: blank out everything else, keeping positions
(defvar bmp/langtool-max-chars 200000
  "Largest amount of prose (after masking) sent in one check.")

(defvar bmp/langtool-skip-elements
  '(src-block example-block export-block fixed-width comment-block
    keyword property-drawer drawer planning clock latex-environment)
  "Org elements replaced by spaces before checking.")

(defvar bmp/langtool-placeholder-objects
  '(latex-fragment inline-src-block code verbatim)
  "Org objects replaced by a placeholder word before checking.")

(defun bmp/langtool--non-prose-ranges ()
  "Return (BEG END FILL) for each part of the buffer that is not prose."
  (let ((tree (org-element-parse-buffer))
        ranges)
    (org-element-map tree bmp/langtool-skip-elements
      (lambda (el) (push (list (org-element-begin el) (org-element-end el) ?\s)
                         ranges)))
    ;; Code block results (#+RESULTS: and what follows)
    (org-element-map tree org-element-all-elements
      (lambda (el) (when (org-element-property :results el)
                     (push (list (org-element-begin el) (org-element-end el) ?\s)
                           ranges))))
    (org-element-map tree bmp/langtool-placeholder-objects
      (lambda (el) (push (list (org-element-begin el)
                               (- (org-element-end el) (org-element-post-blank el))
                               ?x)
                         ranges)))
    ;; Links: the address and brackets, not the description
    (org-element-map tree 'link
      (lambda (el)
        (let ((cb (org-element-contents-begin el))
              (ce (org-element-contents-end el))
              (end (- (org-element-end el) (org-element-post-blank el))))
          (if cb
              (progn (push (list (org-element-begin el) cb ?\s) ranges)
                     (push (list ce end ?x) ranges))
            (push (list (org-element-begin el) end ?x) ranges)))))
    ranges))

(defun bmp/langtool-mask-non-prose (query)
  "In Org buffers, blank out what is not prose in QUERY's text.
Stop if the remaining prose is over `bmp/langtool-max-chars'."
  (let ((text (assoc "text" query))
        (start (or bmp/langtool--text-start (point-min))))
    (when text
      (let ((s (copy-sequence (cadr text))))
        (when (derived-mode-p 'org-mode)
          (pcase-dolist (`(,b ,e ,fill) (bmp/langtool--non-prose-ranges))
            (cl-loop for p from (max b start) below e
                     for i = (- p start)
                     while (< i (length s))
                     unless (eq (aref s i) ?\n)
                     do (aset s i fill)))
          (setcar (cdr text) s))
        (let ((prose (length (replace-regexp-in-string "[ \n]+" " " s))))
          (when (> prose bmp/langtool-max-chars)
            (user-error "%d characters of prose is over the %d limit; use M-x bmp/langtool-check-section or select a region"
                        prose bmp/langtool-max-chars))))))
  query)

(defun bmp/langtool-check-section ()
  "Check the Org heading at point, with its subheadings."
  (interactive)
  (save-excursion
    (org-back-to-heading t)
    (org-mark-subtree)
    (langtool-check)))

(with-eval-after-load 'langtool
  (setq langtool-client-filter-query-function #'bmp/langtool-mask-non-prose)
  (advice-add 'langtool-client--make-post-data :around #'bmp/langtool--encode-query)
  (advice-add 'langtool-check-buffer :before #'bmp/langtool--ensure-server)
  (advice-add 'langtool-check-buffer :before #'bmp/langtool--apply-rules))

(use-package pulsar
  :ensure t
  :config
  (setq pulsar-pulse t)
  (setq pulsar-delay 0.055)
  (setq pulsar-iterations 10)
  (setq pulsar-face 'pulsar-magenta)
  (setq pulsar-highlight-face 'pulsar-yellow)

  (let ((map global-map))
    (define-key map (kbd "C-c h p") #'pulsar-pulse-line)
    (define-key map (kbd "C-c h h") #'pulsar-highlight-line))

  ;; One flash (blue) where the cursor is when the minibuffer opens
  (add-hook 'minibuffer-setup-hook #'pulsar-pulse-line-blue)

  ;; integration with the `consult' package:
  (add-hook 'consult-after-jump-hook #'pulsar-recenter-top)
  (add-hook 'consult-after-jump-hook #'pulsar-reveal-entry)

  ;; integration with the built-in `imenu':
  (add-hook 'imenu-after-jump-hook #'pulsar-recenter-top)
  (add-hook 'imenu-after-jump-hook #'pulsar-reveal-entry)

  (pulsar-global-mode 1))

(use-package smartparens
  :ensure t
  :config
  (require 'smartparens-config)

  (add-hook 'org-mode-hook #'smartparens-mode)
  (add-hook 'css-base-mode-hook #'smartparens-mode)
  (add-hook 'python-base-mode-hook #'smartparens-mode)
  ;; Don't let electric-pair insert a second bracket where smartparens is on
  (add-hook 'smartparens-mode-hook
            (lambda () (electric-pair-local-mode (if smartparens-mode -1 1))))
  (add-hook 'minibuffer-setup-hook 'turn-on-smartparens-strict-mode)

  ;; Smartparens highlights matching pairs (Org markup like =…= too), so
  ;; Emacs's own bracket highlighting, on by default, is turned off
  (show-smartparens-global-mode t)
  (show-paren-mode -1)

  (sp-with-modes '(minibuffer-inactive-mode minibuffer-mode)
    (sp-local-pair "'" nil :actions nil)
    (sp-local-pair "(" nil :wrap "C-("))

  (sp-with-modes 'org-mode
    (sp-local-pair "=" "=" :wrap "C-="))

  (sp-with-modes 'web-mode
    (sp-local-pair "{{#if" "{{/if")
    (sp-local-pair "{{#unless" "{{/unless"))


  (sp-with-modes '(tex-mode plain-tex-mode latex-mode)
    (sp-local-tag "i" "\"<" "\">"))


  (defun my-add-space-after-sexp-insertion (id action _context)
    (when (eq action 'insert)
      (save-excursion
        (forward-char (sp-get-pair id :cl-l))
        (when (or (eq (char-syntax (following-char)) ?w)
                  (looking-at (sp--get-opening-regexp)))
          (insert " ")))))

  (defun my-add-space-before-sexp-insertion (id action _context)
    (when (eq action 'insert)
      (save-excursion
        (backward-char (length id))
        (when (or (eq (char-syntax (preceding-char)) ?w)
                  (and (looking-back (sp--get-closing-regexp))
                       (not (eq (char-syntax (preceding-char)) ?'))))
          (insert " ")))))

  (sp-with-modes sp--lisp-modes
    (sp-local-pair "(" nil
                   :wrap "C-("
                   :pre-handlers '(my-add-space-before-sexp-insertion)
                   :post-handlers '(my-add-space-after-sexp-insertion))))

(electric-pair-mode 1)

(setq electric-quote-paragraph t
      electric-quote-comment t)

(setq electric-pair-pairs '(
                            (?\( . ?\))
                            (?\< . ?\>)
                            (?\[ . ?\])
                            (?\{ . ?\})
                            (?\~ . ?\~)
                            ))

(use-package recentf
  :ensure nil
  :hook (after-init . recentf-mode)
  :config
  (setq recentf-max-saved-items 100)
  (setq recentf-max-menu-items 25)
  (setq recentf-save-file-modes nil)
  (setq recentf-keep nil)
  (setq recentf-auto-cleanup nil)
  (setq recentf-initialize-file-name-history nil)
  (setq recentf-filename-handlers nil)
  (setq recentf-show-file-shortcuts-flag nil))

(use-package vundo
  :ensure t
  :bind ("C-x C-u" . vundo)
  :config
  (setq vundo-compact-display t)
  (setq vundo-window-max-height 8)
  (setq vundo-glyph-alist vundo-unicode-symbols)
  (set-face-attribute 'vundo-default nil :family "FiraCode Nerd Font Mono")
  (ef-themes-with-colors
    (set-face-foreground 'vundo-node fg-main)
    (set-face-foreground 'vundo-stem fg-dim)
    (set-face-foreground 'vundo-saved green-cooler)
    (set-face-foreground 'vundo-last-saved green)
    (set-face-foreground 'vundo-highlight fg-changed)))

(use-package undo-fu-session
  :ensure t
  :config
  (add-to-list 'undo-fu-session-incompatible-major-modes 'org-mode)
  (setq undo-fu-session-incompatible-files '("/COMMIT_EDITMSG\\'" "/git-rebase-todo\\'"))
  (undo-fu-session-global-mode))

(use-package markdown-mode
  :ensure t
  :mode ("README\\.md\\.njk\\'" . gfm-mode)
  :hook ((markdown-mode . variable-pitch-mode)
         (markdown-mode . visual-line-mode)
         (markdown-mode . valign-mode))
  :custom
  (markdown-command '("pandoc" "--from=gfm" "--to=html5"))
  ;; Markup hidden; C-c C-x C-m and C-c C-x C-l show it in this buffer
  (markdown-hide-markup t)
  (markdown-hide-urls t)
  (markdown-fontify-code-blocks-natively t)
  (markdown-list-item-bullets '("•" "◦" "–"))
  (markdown-enable-math t)
  ;; Images: local ones on request (C-c C-x C-i), never from the web
  (markdown-display-remote-images nil)
  (markdown-max-image-size '(300 . nil)))

(add-to-list 'auto-mode-alist '("\\.njk\\'" . web-mode))
(add-to-list 'auto-mode-alist
             '("\\.\\(?:md\\|markdown\\|mkd\\|mdown\\|mkdn\\|mdwn\\)\\'" . markdown-mode))
(add-to-list 'auto-mode-alist '("README\\.md\\'" . gfm-mode))

(use-package csv-mode
  ;; Installed in [[*Using Elpaca.el]], before casual pulls it in
  :ensure nil
  :config
  (add-hook 'csv-mode-hook 'csv-guess-set-separator))

(add-to-list 'auto-mode-alist '("\\.csv\\'" . csv-mode))

(defvar bmp/libretranslate-url "http://127.0.0.1:5000/translate"
  "Local LibreTranslate endpoint.")

(defvar bmp/translate-default-languages "en,eo,es,fr,de"
  "Languages written to the env file the first time it is created.")

(defvar bmp/translate-env-file
  (expand-file-name "~/.config/libretranslate/languages.env")
  "File holding LT_LOAD_ONLY, read by the libretranslate service.")

(defvar bmp/translate-idle-minutes 10
  "Stop the LibreTranslate service after this many minutes without use.")

(defvar bmp/translate--stop-timer nil)

(defun bmp/translate--ensure-env-file ()
  "Create `bmp/translate-env-file' from the defaults if it is missing."
  (unless (file-exists-p bmp/translate-env-file)
    (make-directory (file-name-directory bmp/translate-env-file) t)
    (with-temp-file bmp/translate-env-file
      (insert "LT_LOAD_ONLY=" bmp/translate-default-languages "\n"))))

(defun bmp/translate--json (url &optional timeout)
  "Fetch URL and return its JSON body as an alist, or nil.
Only a complete HTTP 200 reply counts: while the server is starting, a
refused connection can still give back an empty reply buffer."
  (require 'url)
  (let ((buffer (ignore-errors
                  (url-retrieve-synchronously url t nil (or timeout 10)))))
    (when buffer
      (with-current-buffer buffer
        (prog1 (and (bound-and-true-p url-http-end-of-headers)
                    (eql (bound-and-true-p url-http-response-status) 200)
                    (ignore-errors
                      (json-parse-string
                       (decode-coding-string
                        (buffer-substring-no-properties
                         url-http-end-of-headers (point-max))
                        'utf-8)
                       :object-type 'alist :array-type 'list)))
          (kill-buffer))))))

(defun bmp/translate--languages-url ()
  (replace-regexp-in-string "/translate\\'" "/languages" bmp/libretranslate-url))

(defun bmp/translate--server-up-p ()
  "Return non-nil if the LibreTranslate server answers properly."
  (and (bmp/translate--json (bmp/translate--languages-url) 2) t))

(defun bmp/translate--systemctl (action)
  "Run systemctl --user ACTION on the libretranslate service.
Stopping runs in the background so Emacs never waits for it; other
actions wait, because the server is needed straight afterwards."
  (if (equal action "stop")
      (start-process "libretranslate-stop" nil
                     "systemctl" "--user" "stop" "libretranslate")
    (call-process "systemctl" nil nil nil "--user" action "libretranslate")))

(defun bmp/translate--ensure-server ()
  "Start the LibreTranslate service if needed and wait until it answers."
  (unless (bmp/translate--server-up-p)
    (bmp/translate--ensure-env-file)
    (bmp/translate--systemctl "start")
    (let ((deadline (+ (float-time) 600)))
      (while (not (bmp/translate--server-up-p))
        (when (> (float-time) deadline)
          (user-error "LibreTranslate did not start; see journalctl --user -u libretranslate"))
        (message "Starting LibreTranslate (C-g to stop waiting)...")
        (sleep-for 1)))
    (message "LibreTranslate is ready")))

(defun bmp/translate--schedule-stop ()
  "Stop the service after `bmp/translate-idle-minutes' without use."
  (when (timerp bmp/translate--stop-timer)
    (cancel-timer bmp/translate--stop-timer))
  (setq bmp/translate--stop-timer
        (run-at-time (* 60 bmp/translate-idle-minutes) nil
                     #'bmp/translate--systemctl "stop")))

(add-hook 'kill-emacs-hook
          (lambda ()
            (when (timerp bmp/translate--stop-timer)
              (bmp/translate--systemctl "stop"))))

(defun bmp/translate-add-language (code)
  "Add language CODE (for example \"ja\") to the LibreTranslate service.
The service is restarted if running; the new models are downloaded on
its next start."
  (interactive "sLanguage code to add (e.g. ja, it, pt): ")
  (bmp/translate--ensure-env-file)
  (with-temp-buffer
    (insert-file-contents bmp/translate-env-file)
    (goto-char (point-min))
    (if (re-search-forward "^LT_LOAD_ONLY=\\(.*\\)$" nil t)
        (let* ((beg (match-beginning 1))
               (end (match-end 1))
               (codes (split-string (match-string 1) "," t "[ \t]+")))
          (when (member code codes)
            (user-error "%s is already loaded" code))
          (delete-region beg end)
          (goto-char beg)
          (insert (string-join (append codes (list code)) ",")))
      (goto-char (point-max))
      (insert "LT_LOAD_ONLY=" bmp/translate-default-languages "," code "\n"))
    (write-region nil nil bmp/translate-env-file))
  (when (bmp/translate--server-up-p)
    (bmp/translate--systemctl "restart"))
  (message "Added %s; its models download the next time LibreTranslate starts"
           code))

(defun bmp/translate-languages ()
  "Return the language codes loaded in the local LibreTranslate server.
Starts the server if needed."
  (bmp/translate--ensure-server)
  (let ((languages (bmp/translate--json (bmp/translate--languages-url))))
    (unless languages
      (user-error "LibreTranslate did not answer at %s" bmp/libretranslate-url))
    (mapcar (lambda (language) (alist-get 'code language)) languages)))

(defun bmp/translate (beg end source target &optional replace)
  "Translate the region from BEG to END from SOURCE into TARGET.
Uses the local LibreTranslate server.  SOURCE may be \"auto\" to let it
detect the language.  Show the result and copy it to the kill ring.
With a prefix argument REPLACE, replace the region instead."
  (interactive
   (if (use-region-p)
       (let ((languages (bmp/translate-languages)))
         (list (region-beginning) (region-end)
               (completing-read "Translate from (default auto): "
                                (cons "auto" languages) nil t nil nil "auto")
               (completing-read "Translate to: " languages nil t)
               current-prefix-arg))
     (user-error "Select the text to translate first")))
  (require 'url)
  (bmp/translate--ensure-server)
  (bmp/translate--schedule-stop)
  (let* ((url-request-method "POST")
         (url-request-extra-headers '(("Content-Type" . "application/json")))
         (url-request-data
          (encode-coding-string
           (json-encode `(("q" . ,(buffer-substring-no-properties beg end))
                          ("source" . ,source)
                          ("target" . ,target)))
           'utf-8))
         (result (alist-get 'translatedText
                            (bmp/translate--json bmp/libretranslate-url 60))))
    (unless result
      (user-error "LibreTranslate returned no translation; see journalctl --user -u libretranslate"))
    (if replace
        (progn (delete-region beg end)
               (goto-char beg)
               (insert result))
      (kill-new result)
      (message "%s" result))))

(use-package yasnippet
  :ensure t
  :demand t
  :config
  (yas-global-mode 1)
  )

(add-to-list 'warning-suppress-types '(yasnippet backquote-change))

(use-package yasnippet-snippets
  :ensure t
  :after yasnippet)

# Create ~/.config/emacs/config/yasnippet/snippets/org-mode folder
if [ -d ~/.config/emacs/config/yasnippet/snippets/org-mode ]
then
    echo "Org-mode snippets folder exists"
else
    echo "Org-mode snippets folder does not exist"
    mkdir -p ~/.config/emacs/config/yasnippet/snippets/org-mode/
fi

(use-package calc
  :defer t)

(use-package savehist
  :ensure nil
  :hook (after-init . savehist-mode)
  :config
  (setq history-length 100)
  (setq history-delete-duplicates t)
  (setq savehist-save-minibuffer-history t))

(use-package dabbrev
  :ensure nil
  :commands (dabbrev-expand dabbrev-completion)
  :config
  (setq dabbrev-abbrev-char-regexp "\\sw\\|\\s_")
  (setq dabbrev-abbrev-skip-leading-regexp "[$*/=~']")
  (setq dabbrev-backward-only nil)
  (setq dabbrev-case-distinction 'case-replace)
  (setq dabbrev-case-fold-search nil)
  (setq dabbrev-case-replace 'case-replace)
  (setq dabbrev-check-other-buffers t)
  (setq dabbrev-eliminate-newlines t)
  (setq dabbrev-upcase-means-case-search t)
  (setq dabbrev-ignored-buffer-modes
        '(archive-mode image-mode doc-view-mode pdf-view-mode tags-table-mode)))

(setq-default abbrev-mode t)

(setq save-abbrevs 'silently)

(bind-key "M-/" 'hippie-expand)

(remove-hook 'save-some-buffers-functions #'abbrev--possibly-save)

(setq hippie-expand-try-functions-list
    '(yas-hippie-try-expand
      try-expand-all-abbrevs
      try-complete-file-name-partially
      try-complete-file-name
      try-expand-dabbrev
      try-expand-dabbrev-from-kill
      try-expand-dabbrev-all-buffers
      try-expand-list
      try-expand-line
      try-complete-lisp-symbol-partially
      try-complete-lisp-symbol))

(use-package minibuffer
  :ensure nil
  :config
  (setq completions-format 'one-column)
  (setq completion-auto-help 'always)
  (setq completion-auto-select t)
  (setq completions-detailed t)
  (setq completion-show-inline-help t)
  (setq completions-max-height 48)
  (setq completions-header-format (propertize "%s candidates:\n" 'face 'bold-italic))
  (setq completions-highlight-face 'completions-highlight)
  (setq minibuffer-completion-auto-choose t)
  ;; Completion styles are set in one place, in [[*Orderless]]
  (setq minibuffer-visible-completions t))

(use-package corfu
  :ensure t
  :custom
  (corfu-auto t)
  (corfu-cycle t)
  (corfu-preselect 'prompt)
  :config
  (setq corfu-popupinfo-delay (cons nil 1.0))
  (corfu-history-mode 1)
  (with-eval-after-load 'savehist
    (add-to-list 'savehist-additional-variables 'corfu-history))
  :bind
  (:map corfu-map
        ("TAB" . corfu-next)
        ([tab] . corfu-next)
        ("M-TAB" . corfu-previous)
        ([backtab] . corfu-previous))
  :init
  (global-corfu-mode)
  (corfu-popupinfo-mode))

(use-package cape
  :ensure t
  :bind (("C-c ip" . completion-at-point)
         ("C-c it" . complete-tag)
         ("C-c id" . cape-dabbrev)
         ("C-c ih" . cape-history)
         ("C-c if" . cape-file)
         ("C-c ik" . cape-keyword)
         ("C-c is" . cape-symbol)
         ("C-c ia" . cape-abbrev)
         ("C-c il" . cape-line)
         ("C-c iw" . cape-dict)
         ("C-c i\\" . cape-tex)
         ("C-c i_" . cape-tex)
         ("C-c i^" . cape-tex)
         ("C-c i&" . cape-sgml)
         ("C-c ir" . cape-rfc1345))
  :init
  (add-to-list 'completion-at-point-functions #'cape-dabbrev)
  (add-to-list 'completion-at-point-functions #'cape-abbrev)
  (add-to-list 'completion-at-point-functions #'cape-file)
  (add-to-list 'completion-at-point-functions #'cape-elisp-block)
  (add-to-list 'completion-at-point-functions #'cape-history)
  (add-to-list 'completion-at-point-functions #'cape-keyword)
  (add-to-list 'completion-at-point-functions #'cape-tex))

(use-package consult
  :ensure nil
  :bind
  (
   ("C-x M-:" . consult-complex-command)
   ("C-x b" . consult-buffer)
   ("C-x 4 b" . consult-buffer-other-window)
   ("C-x 5 b" . consult-buffer-other-frame)
   ("C-x r b" . consult-bookmark)
   ("C-x p b" . consult-project-buffer)
   ("M-y" . consult-yank-pop)
   ("M-s d" . consult-find)
   ("M-s D" . consult-locate)
   ("M-s g" . consult-grep)
   ("M-s G" . consult-git-grep)
   ("M-s r" . consult-ripgrep)
   ("M-s l" . consult-line)
   ("M-s L" . consult-line-multi)
   ("M-s k" . consult-keep-lines)
   ("M-s u" . consult-focus-lines)
   :map isearch-mode-map
   ("M-e" . consult-isearch-history)
   ("M-s e" . consult-isearch-history)
   ("M-s l" . consult-line)
   ("M-s L" . consult-line-multi)
   :map minibuffer-local-map
   ("M-s" . consult-history)
   ("M-r" . consult-history)
   :map consult-narrow-map
   ("?" . consult-narrow-help))
  :config
  (setq consult-line-numbers-widen t)
  (setq consult-async-min-input 3)
  (setq consult-async-input-debounce 0.5)
  (setq consult-async-input-throttle 0.8)
  (setq consult-find-args
        (concat "find . -not ( "
                "-path */.git* -prune "
                "-or -path */.cache* -prune )"))
  (setq consult-preview-key 'any)
  (setq consult-project-function nil)
  (setq consult-narrow-key "<")

  (add-to-list 'consult-mode-histories '(vc-git-log-edit-mode . log-edit-comment-ring))

  (require 'consult-imenu)

  (with-eval-after-load 'pulsar
    (setq consult-after-jump-hook nil)
    (dolist (fn '(pulsar-recenter-top pulsar-reveal-entry))
      (add-hook 'consult-after-jump-hook fn))))

(use-package consult-yasnippet
  :ensure t)

(use-package embark
  :ensure t
  :bind
  (("C-." . embark-act)
   ("C-;" . embark-dwim)
   ("C-h B" . embark-bindings))
  :config
  (setq prefix-help-command #'embark-prefix-help-command)
  (setq embark-confirm-act-all nil)
  (setq embark-mixed-indicator-both nil)
  (setq embark-mixed-indicator-delay 1.0)
  (setq embark-indicators '(embark-mixed-indicator embark-highlight-indicator))
  (setq embark-verbose-indicator-nested nil)
  (setq embark-verbose-indicator-buffer-sections '(bindings))
  (setq embark-verbose-indicator-excluded-actions
        '(embark-cycle embark-act-all embark-collect embark-export embark-insert)))

(use-package embark-consult
  :ensure t
  :after consult)

(use-package vertico
  :ensure t
  :config
  (setq vertico-scroll-margin 0)
  (setq vertico-count 5)
  (setq vertico-resize t)
  (setq vertico-cycle t)
  (vertico-multiform-mode 1)
  (vertico-mode 1))

(use-package emacs
  :init
  (defun crm-indicator (args)
    (cons (format "[CRM%s] %s"
                  (replace-regexp-in-string
                   "\\`\\[.*?]\\*\\|\\[.*?]\\*\\'" ""
                   crm-separator)
                  (car args))
          (cdr args)))
  (advice-add #'completing-read-multiple :filter-args #'crm-indicator)
  (setq minibuffer-prompt-properties
        '(read-only t cursor-intangible t face minibuffer-prompt))
  (add-hook 'minibuffer-setup-hook #'cursor-intangible-mode)
  (setq enable-recursive-minibuffers t))

(use-package vertico-directory
  :after vertico
  :ensure nil
  :bind
  (:map vertico-map
        ("RET" . vertico-directory-enter)
        ("DEL" . vertico-directory-delete-char)
        ("M-DEL" . vertico-directory-delete-word))
  :hook
  (rfn-eshadow-update-overlay . vertico-directory-tidy))

(setq vertico-multiform-categories
      '((buffer flat (vertico-cycle . t))))

(use-package orderless
  :ensure t
  :config

  (defun +orderless--consult-suffix ()
    "Regexp which matches the end of string with Consult tofu support."
    (if (and (boundp 'consult--tofu-char) (boundp 'consult--tofu-range))
        (format "[%c-%c]*$"
                consult--tofu-char
                (+ consult--tofu-char consult--tofu-range -1))
      "$"))

  (defun +orderless-consult-dispatch (word _index _total)
    (cond
     ((string-suffix-p "$" word)
      `(orderless-regexp . ,(concat (substring word 0 -1) (+orderless--consult-suffix))))
     ((and (or minibuffer-completing-file-name
               (derived-mode-p 'eshell-mode))
           (string-match-p "\\`\\.." word))
      `(orderless-regexp . ,(concat "\\." (substring word 1) (+orderless--consult-suffix))))))

  (orderless-define-completion-style +orderless-with-initialism
    (orderless-matching-styles '(orderless-initialism orderless-literal orderless-regexp)))

  (setq completion-styles '(orderless basic)
        completion-category-defaults nil
        completion-category-overrides '((file (styles partial-completion))
                                        (command (styles +orderless-with-initialism))
                                        (variable (styles +orderless-with-initialism))
                                        (symbol (styles +orderless-with-initialism)))
        orderless-component-separator #'orderless-escapable-split-on-space
        orderless-style-dispatchers (list #'+orderless-consult-dispatch
                                          #'orderless-affix-dispatch))

  :bind ( :map minibuffer-local-completion-map
          ("SPC" . nil)
          ("?" . nil))
  )

(use-package marginalia
  :ensure t
  :after compat
  :defer 1
  :bind (("M-A" . marginalia-cycle)
         :map minibuffer-local-map
         ("M-A" . marginalia-cycle))
  :config
  (setq marginalia-max-relative-age 0)
  (marginalia-mode t))

(use-package nerd-icons-completion
  :ensure t
  :after marginalia
  :config
  (nerd-icons-completion-mode t)
  (add-hook 'marginalia-mode-hook #'nerd-icons-completion-marginalia-setup))

(use-package pdf-tools
    :ensure t
    :mode (("\\.pdf$" . pdf-view-mode))
    :hook ((pdf-view-mode . auto-revert-mode)
           (pdf-view-mode . (lambda () (cua-mode 0)))
           (pdf-view-mode . pdf-view-midnight-minor-mode)
           (pdf-view-mode . pdf-annot-minor-mode))
    :config
    ;; 1. Prevent pdf-tools from trying to use dnf on this immutable host
    (setq pdf-tools-install-build-options '("--no-error-if-failed"))

    ;; 2. Give Homebrew's poppler to epdfinfo only: its build (pkg-config)
    ;; and its runtime (LD_LIBRARY_PATH), without changing the environment
    ;; of anything else Emacs starts. When Homebrew updates poppler,
    ;; `pdf-tools-install' finds the new version and rebuilds epdfinfo.
    (defun bmp/with-brew-poppler (orig &rest args)
      "Call ORIG with ARGS, with Homebrew's poppler visible to epdfinfo."
      (let* ((opt "/home/linuxbrew/.linuxbrew/opt/")
             (pkgconfig (append (file-expand-wildcards (concat opt "*/lib/pkgconfig"))
                                (file-expand-wildcards (concat opt "*/share/pkgconfig"))))
             (process-environment
              (append (list "LD_LIBRARY_PATH=/home/linuxbrew/.linuxbrew/lib"
                            "PKG_CONFIG=/home/linuxbrew/.linuxbrew/bin/pkg-config"
                            (concat "PKG_CONFIG_PATH=" (string-join pkgconfig ":")))
                      process-environment)))
        (apply orig args)))
    (dolist (fn '(pdf-tools-install pdf-info-check-epdfinfo
                  pdf-info-process-assert-running))
      (advice-add fn :around #'bmp/with-brew-poppler))

    ;; 3. Preferences
    (setq pdf-info-epdfinfo-program
          (expand-file-name "elpaca/builds/pdf-tools/server/epdfinfo" user-emacs-directory))
    (setq-default pdf-view-display-size 'fit-width)
    (setq pdf-tools-install-no-query t)

    ;; 4. Initialize
    (pdf-tools-install t))

(use-package nov
  :ensure t)

(add-to-list 'auto-mode-alist '("\\.epub\\'" . nov-mode))

;; Customize font
(defun my-nov-font-setup ()
  (face-remap-add-relative 'variable-pitch :family "EB Garamond"
                           :height 1.0))
(add-hook 'nov-mode-hook 'my-nov-font-setup)

;; Text width
(setq nov-text-width 80)
(setq visual-fill-column-center-text t)
(add-hook 'nov-mode-hook 'visual-line-mode)
(add-hook 'nov-mode-hook 'visual-fill-column-mode)

(use-package calibredb
  :ensure t
  :defer t
  :config
  (setq calibredb-root-dir bmp/calibre-directory)
  (setq calibredb-db-dir (expand-file-name "metadata.db" calibredb-root-dir))
  (setq calibredb-library-alist (list (list bmp/calibre-directory)))
  (setq calibredb-id-width 4)
  (setq calibredb-comment-width 0)
  (setq calibredb-tag-width 0)
  (setq calibredb-size-show t)
  (setq calibredb-format-width 12)
  (setq calibredb-format-nerd-icons t))

(defun bmp/calibredb-open-file-with-emacs (&optional candidate)
  "Open file with Emacs.
Optional argument CANDIDATE is the selected item."
  (interactive "P")
  (unless candidate
    (setq candidate (car (calibredb-find-candidate-at-point))))
  (find-file (calibredb-get-file-path candidate t)))

(use-package emacstv
  :ensure (:host github :repo "emacstv/emacstv.github.io" :files (:defaults "*.org")))

# Create ~/.config/mpv folder
if [ -d ~/.config/mpv ]
then
    echo "MPV folder exists"
else
    echo "MPV folder does not exist"
    mkdir -p ~/.config/mpv
fi

ytdl-raw-options='ignore-config=,sub-langs="en,en-US",write-subs=,write-auto-subs='
sub-auto=fuzzy
slang=en,eng,enUS,en-US

(use-package eglot
    :ensure nil
    :after jsonrpc
    :hook
    ((sh-mode bash-ts-mode
      c-mode c-ts-mode c++-mode c++-ts-mode
      go-mode go-ts-mode
      rust-mode rust-ts-mode
      html-mode html-ts-mode
      css-mode css-ts-mode
      python-mode python-ts-mode) . eglot-ensure)
    :bind (:map
           eglot-mode-map
           ("C-c c a" . eglot-code-actions)
           ("C-c c o" . eglot-code-actions-organize-imports)
           ("C-c c r" . eglot-rename)
           ("C-c c f" . eglot-format)
           ("C-c c d" . eldoc))
    :config
    (setq eglot-stay-out-of '(flymake))
    (setq-default eglot-workspace-configuration
                  '((:gopls .
                            ((staticcheck . t)
                             (matcher . "CaseSensitive")))))
    )

(use-package flymake
  :ensure t
  :hook (prog-mode . flymake-mode)
  :custom
  ;; The left fringe is diff-hl's (see [[*Diff-hl]])
  (flymake-fringe-indicator-position 'right-fringe)
  :bind (:map flymake-mode-map
              ;; Not C-c !, which Org uses to insert a timestamp
              ("C-c x n" . flymake-goto-next-error)
              ("C-c x p" . flymake-goto-prev-error)
              ;; flymake 1.4 starts this list from the diagnostic at point
              ;; and fails elsewhere; consult-flymake lists them all
              ("C-c x l" . consult-flymake)))

(use-package flymake-vale
  :ensure (
           :host github
           :repo "tpeacock19/flymake-vale"
           ))

(defvar bmp/vale-configs
  `((notes . ,(expand-file-name "~/.config/vale/.vale.ini"))
    (publish . ,(expand-file-name "~/.config/vale/publish.ini")))
  "Vale configurations: everyday notes, and writing to be published.")

(defvar-local bmp/vale-config nil
  "The vale configuration this buffer is checked with (notes or publish).")

(defun bmp/vale-use-config (name)
  "Check the current buffer with the vale configuration NAME."
  (setq bmp/vale-config name)
  (setq-local flymake-vale-program-args
              (list (concat "--config=" (alist-get name bmp/vale-configs)))))

(defun bmp/vale--publishing-p ()
  "Return non-nil if this buffer is a blog post (it has #+hugo_base_dir:)."
  (save-excursion
    (goto-char (point-min))
    (let ((case-fold-search t))
      (re-search-forward "^#\\+hugo_base_dir:" 4000 t))))

(defvar bmp/vale-max-line-length 60000
  "Do not run vale on files with longer lines; it cannot read them.")

(defun bmp/vale--long-line-p ()
  "Return non-nil if the buffer has a line longer than vale can read."
  (save-excursion
    (goto-char (point-min))
    (let (long)
      (while (and (not long) (not (eobp)))
        (setq long (> (- (line-end-position) (point)) bmp/vale-max-line-length))
        (forward-line 1))
      long)))

(defun bmp/flymake-vale--safe-output (orig output source start)
  "Parse vale's OUTPUT with ORIG; if vale reported an error, say so instead."
  (condition-case nil
      (funcall orig output source start)
    (error
     (message "vale could not check %s: %s" (buffer-name source)
              (if (string-match "\"Text\": *\"\\([^\"]*\\)\"" output)
                  (match-string 1 output)
                "unexpected output"))
     (with-current-buffer source (flymake-vale--check-all nil start)))))

(defun bmp/flymake-vale--existing-directory (orig &rest args)
  "Run vale (ORIG with ARGS) from a folder that exists.
A new note's folder is only created when the note is first saved, and
a process cannot start in a folder that does not exist yet."
  (let ((default-directory (if (file-directory-p default-directory)
                               default-directory
                             (expand-file-name "~/"))))
    (apply orig args)))

(with-eval-after-load 'flymake-vale
  (advice-add 'flymake-vale--output-to-errors :around #'bmp/flymake-vale--safe-output)
  (advice-add 'flymake-vale--start :around #'bmp/flymake-vale--existing-directory))

(defun bmp/flymake-vale-setup ()
  "Check prose with vale through flymake in Org, Markdown and text files.
Blog posts use the publish configuration, everything else the notes one.
Only when vale and its configuration are installed (see Prerequisites)."
  (when (and buffer-file-name
             (or (derived-mode-p 'org-mode 'markdown-mode)
                 (eq major-mode 'text-mode))
             (executable-find "vale")
             (file-exists-p (alist-get 'notes bmp/vale-configs))
             (not (bmp/vale--long-line-p)))
    (bmp/vale-use-config (if (bmp/vale--publishing-p) 'publish 'notes))
    (flymake-vale-load)
    (flymake-mode 1)))

(defun bmp/vale-toggle-config ()
  "Switch this buffer between the notes and publish vale configurations."
  (interactive)
  (bmp/vale-use-config (if (eq bmp/vale-config 'publish) 'notes 'publish))
  (when flymake-mode (flymake-start))
  (message "Vale: checking with the %s configuration" bmp/vale-config))

(add-hook 'text-mode-hook #'bmp/flymake-vale-setup)

(use-package treesit-auto
  :ensure t
  :custom
  (treesit-auto-install 'prompt)
  :config
  (treesit-auto-add-to-auto-mode-alist 'all)
  (global-treesit-auto-mode))

(use-package treesit-fold
  :ensure t
  :custom
  ;; The left fringe is diff-hl's (see [[*Diff-hl]])
  (treesit-fold-indicators-fringe 'right-fringe)
  :config
  (global-treesit-fold-indicators-mode 1))

claude        # log in with the Claude subscription, then /exit
/home/linuxbrew/.linuxbrew/bin/npm install -g @agentclientprotocol/claude-agent-acp
which claude claude-agent-acp   # both should be under /home/linuxbrew/.linuxbrew/bin

{
  "permissions": {
    "deny": [
      "Read(~/.config/emacs/secrets/**)",
      "Read(~/.gnupg/**)",
      "Read(**/.authinfo*)",
      "Read(~/.config/emacs/data/savehist.el)",
      "Read(~/.config/emacs/data/mastodon-client--token)",
      "Read(~/.config/emacs/data/ement*)",
      "Read(~/.config/emacs/data/agent-shell/**)"
    ]
  }
}

(use-package gptel
  :ensure t
  :commands (gptel gptel-send gptel-menu gptel-rewrite gptel-mode)
  :config
  (setq gptel-backend
        (gptel-make-anthropic "Claude"
          :stream t
          :key (lambda () (bmp/lookup-password :host "api.anthropic.com"))
          :models '(claude-sonnet-5-5 claude-opus-5-5 claude-haiku-5-5))
        gptel-model 'claude-sonnet-5-5
        gptel-default-mode 'org-mode
        gptel-org-branching-context t))

(defun bmp/agent-shell-dot-subdir (subdir)
  "Return a directory for agent-shell SUBDIR outside the current project."
  (expand-file-name
   (file-name-concat "agent-shell"
                     (file-name-nondirectory
                      (directory-file-name (agent-shell-cwd)))
                     subdir)
   no-littering-var-directory))

(use-package agent-shell
  :ensure t
  :commands (agent-shell agent-shell-toggle agent-shell-send-dwim
             agent-shell-send-region agent-shell-send-current-file)
  :config
  (setq agent-shell-anthropic-authentication
        (agent-shell-anthropic-make-authentication :login t)
        agent-shell-dot-subdir-function #'bmp/agent-shell-dot-subdir
        agent-shell-preferred-agent-config
        (agent-shell-anthropic-make-claude-code-config)))

;; Rely on file-change notifications instead of checking every buffer
;; every few seconds, which showed up as 7% of the time in a profile
(setq auto-revert-avoid-polling t)
(global-auto-revert-mode 1)

(defvar-keymap bmp/ai-map
  :doc "Keymap for AI assistants."
  "c" #'gptel                         ; open a gptel chat buffer
  "s" #'gptel-send                    ; send region / buffer up to point
  "m" #'gptel-menu                    ; model, context and options
  "r" #'gptel-rewrite                 ; rewrite the active region in place
  "a" #'agent-shell                   ; start or reuse a Claude Code session
  "t" #'agent-shell-toggle            ; show / hide the session
  "d" #'agent-shell-send-dwim         ; send region or error at point
  "f" #'agent-shell-send-current-file); send the current file

(keymap-global-set "C-c j" bmp/ai-map)

(setq plstore-cache-passphrase-for-symmetric-encryption t)

(advice-add 'plstore--decrypt :around
            (lambda (orig-fun &rest args)
              (let ((epg-pinentry-mode 'loopback))
                (apply orig-fun args))))

(use-package mastodon
  :ensure t
  :commands (mastodon)
  :init
  ;; My instance and username are personal (see [[*Personal and local settings]])
  (add-hook 'bmp/personal-loaded-hook
            (lambda ()
              (setq mastodon-instance-url bmp/mastodon-instance-url
                    mastodon-active-user bmp/mastodon-user)))
  ;; Keep token in a writable data path
  (setq mastodon-client--token-file
        (expand-file-name "data/mastodon-client--token" user-emacs-directory))

  :config
  ;; Standardize variables (Using a single setq to avoid void-function errors)
  (setq mastodon-toot-timestamp-format "%c"
        mastodon-toot--enable-completion-for-mentions "all"
        mastodon-toot--enable-custom-instance-emoji nil
        mastodon-tl--enable-relative-timestamps nil
        mastodon-tl--show-avatars t
        mastodon-media--enable-image-caching t
        mastodon-media--avatar-height 30
        mastodon-media--preview-max-height 200
        mastodon-tl--enable-proportional-font t
        mastodon-toot-enable-completion t
        mastodon-tl--highlight-current-toot t
        mastodon-images-in-notifs t
        mastodon-toot-display-orig-in-reply-buffer t
        mastodon-use-emojify nil)

  (mastodon-discover)

  ;; 1. Prevent crash on notification 404 errors
  (advice-add 'mastodon-notifications--update-check-cb :around
              (lambda (orig-fun json)
                (unless (and (listp json) (assoc 'error json))
                  (funcall orig-fun json))))

  ;; 2. Auto-fill handling
  (add-hook 'mastodon-toot-mode-hook (lambda () (auto-fill-mode -1))))

(setq ement-save-sessions t
      ement-directory-item-indent 4
      ement-room-left-margin-width 20
      ement-room-timestamp-header-with-date-format "%A : %d-%m-%Y"
      ement-room-image-initial-height 0.4
      ement-room-list-column-Name-max-width 32
      ement-room-list-column-Topic-max-width 42)

;; Install Ement.
(use-package ement
  :ensure t
  ;; Loaded when I connect (M-x ement-connect), not at start-up
  :defer t)

(use-package erc
  ;; Emacs's own ERC; no package needs a newer one
  :ensure nil
  ;; Loaded when I connect, not at start-up
  :defer t
  :config
  (setq erc-interpret-mirc-color t
        erc-kill-buffer-on-part t
        erc-kill-queries-on-quit t
        erc-kill-server-buffer-on-quit t
        erc-query-display 'buffer
        erc-server-coding-system '(utf-8 . utf-8)
        erc-use-auth-source-for-nickserv-password t
        erc-prompt-for-password nil
        erc-track-remove-disconnected-buffers t
        erc-track-exclude-types '("JOIN" "NICK" "PART" "QUIT" "MODE"
                                  "324" "329" "332" "333" "353" "477")
        erc-save-buffer-on-part t)

  (erc-track-mode 1)
  (erc-truncate-mode +1)
  (erc-ring-mode 1)
  (erc-fill-mode 1)
  (erc-scrolltobottom-mode 1))

;; My networks and channels are personal (see [[*Personal and local settings]])
(add-hook 'bmp/personal-loaded-hook
          (lambda ()
            (setq erc-autojoin-channels-alist bmp/irc-channels
                  erc-networks-alist bmp/irc-networks)))

(defun bmp/erc-clean-up ()
  "Clean up dead ERC buffers."
  (interactive)
  (mapc #'kill-buffer (erc-buffer-list (lambda () (null (erc-server-process-alive)))))
  (erc-update-mode-line))

;; If my nick is still held (a stale connection, or another client), ask
;; NickServ to hand it back with REGAIN (supported by Libera.Chat)
(setq erc-services-regain-alist
      '((Libera.Chat . erc-services-issue-regain)))

(defun bmp/erc-connect-with-auth (network host)
  "Connect to HOST with TLS, logging in with SASL from authinfo.
The authinfo line for HOST needs a login (my account and nick) and a
password.  SASL logs in to the account while connecting, whatever nick
the server gives me first, and `services-regain' then takes the nick back
if it is in use."
  (let* ((auth (bmp/lookup-auth :host host))
         (user (plist-get auth :user))
         (port (or (plist-get auth :port) 6697))
         (secret (plist-get auth :secret))
         (password (if (functionp secret) (funcall secret) secret)))
    (if (and user password)
        (let* ((erc-modules (append '(sasl services-regain) erc-modules))
               (buffer (progn
                         (message "Connecting to %s@%s (SASL)" user host)
                         (erc-tls :server host
                                  :port (string-to-number (format "%s" port))
                                  :nick user
                                  :user user
                                  :password password))))
          ;; On these SASL connections ERC's own autojoin did not join the
          ;; channels, although running it afterwards did; so run it once
          ;; the connection is complete (it skips channels already joined)
          (when (buffer-live-p buffer)
            (with-current-buffer buffer
              (add-hook 'erc-after-connect
                        (lambda (&rest _) (erc-autojoin--join))
                        90 t))))
      (message "❌ authinfo needs a login and password for %s — aborting connect"
               host))))

(defun bmp/erc-connect-anon (network host)
  "Connect to HOST using a nick from authinfo, without password."
  (let* ((auth (car (auth-source-search :host host :require '(:user))))
         (user (plist-get auth :user))
         (port (or (plist-get auth :port) 6697))
         (nick (or user "guest")))
    (message "Connecting anonymously to %s@%s" nick host)
    (erc-tls :server host
             :port (string-to-number (format "%s" port))
             :nick nick)))

(defun bmp/erc-connect-network (network host)
  (if (memq network bmp/irc-password-networks)
      (bmp/erc-connect-with-auth network host)
    (bmp/erc-connect-anon network host)))

(defun bmp/erc-connect-all ()
  "Manually connect to all ERC networks."
  (interactive)
  (dolist (entry erc-autojoin-channels-alist)
    (let* ((network (car entry))
           (host (cadr (assoc network erc-networks-alist))))
      (when host
        (bmp/erc-connect-network network host)))))

(defun bmp/erc-connect-all-with-refresh ()
  "Flush auth cache and connect to all ERC networks."
  (interactive)
  (auth-source-forget-all-cached)
  (bmp/erc-connect-all))

(use-package erc-hl-nicks
  :ensure t
  :after erc
  :config
  (add-to-list 'erc-modules 'hl-nicks))

(use-package erc-image
  :ensure t
  :after erc
  :config
  (setq erc-image-inline-rescale 300)
  (add-to-list 'erc-modules 'image))

(use-package f
  :ensure nil)

;; (use-package emacsql
;;   :ensure t)

(use-package magit-section
  :ensure nil)

(use-package org-roam
  :ensure t
  ;; Load at start-up, not on the first key press: the database sync,
  ;; citar-org-roam and org-mem (the agenda) all depend on it.
  :demand t
  :bind (("C-c n l" . org-roam-buffer-toggle)
         ("C-c n f" . org-roam-node-find)
         ("C-c n g" . org-roam-graph)
         ("C-c n i" . bmp/force-org-roam-node-insert)
         ("C-c n c" . org-roam-capture)
         ("C-c n j" . org-roam-dailies-capture-today)
         :map org-mode-map
         ("C-M-i" . completion-at-point))
  :config
  (setq org-roam-completion-everywhere t)
  ;; Syncthing keeps both versions when two devices change a note at once
  ;; ("*.sync-conflict-*.org"), plus old versions in .stversions/; they
  ;; carry the same IDs as the real note, so keep them out of org-roam
  ;; (org-mem already skips them)
  (setq org-roam-file-exclude-regexp
        (list org-attach-id-dir "\\.sync-conflict-" "/\\.stversions/"))
  ;; (setq org-roam-database-connector 'sqlite)

  ;; Templates for notes in the top of `org-roam-directory'; the
  ;; subdirectory commands below build the same set for a subdirectory.
  (setq org-roam-capture-templates (bmp/org-roam-templates))

  (setq org-roam-dailies-capture-templates
        '(("d" "Journal" entry "* %<%H:%M> %?"
           :target (file+head "%<%Y-%m-%d>.org" "#+title: %<%Y-%m-%d>\n"))
          ("t" "Task" entry "* TODO %?"
           :target (file+head+olp "%<%Y-%m-%d>.org" "#+title: %<%Y-%m-%d>\n"
                                  ("Tasks")))))

  ;; Web pages captured from the browser (see org-roam-protocol below)
  (setq org-roam-capture-ref-templates
        '(("r" "Web page" plain "${body}%?"
           :target (file+head "Web/%<%Y%m%d%H%M%S>-${slug}.org"
                              "#+title: ${title}\n#+date: %<%Y-%m-%d>\n#+filetags: :web:\n\n")
           :unnarrowed t)))

  (setq org-roam-node-display-template (concat "${title:*} " (propertize "${tags:10}" 'face 'org-tag)))
  (org-roam-db-autosync-mode)
  (require 'org-roam-protocol))

(defun bmp/tea-note ()
  "Return a tea note Org-roam entry string with dynamic filetags and formatted content."
  (let* ((name (org-roam-node-title org-roam-capture--node))
         (origin (completing-read "Origin: " '("Single Origin" "Blend")))
         (estate (when (string= origin "Single Origin")
                   (read-string "Estate: ")))
         (type-choice (completing-read "Type: "
                                       '("Green" "White" "Black" "Orthodox" "Tisane" "Oolong" "Other")))
         (type (if (string= type-choice "Other")
                   (read-string "Enter custom type: ")
                 type-choice))
         (grade (when (and (string= origin "Single Origin") (string= type "Black"))
                  (read-string "Grade (e.g. FTGFOP1, BOP, etc.): ")))
         (blend-details (when (and (string= origin "Blend") (string= type "Black"))
                          (read-string "Blend Details (mixture of grades): ")))
         (season (when (and (string= origin "Single Origin")
                            (member type '("Green" "White" "Black" "Orthodox")))
                   (let ((flush (completing-read "Season: "
                                                 '("First Flush" "Second Flush" "Monsoon Flush"
                                                   "Autumn Flush" "Winter Flush" "Other"))))
                     (if (string= flush "Other")
                         (read-string "Enter custom season: ")
                       flush))))
         (region (read-string "Region: "))
         (vendor (read-string "Vendor: "))
         (leaf-appearance (read-string "Leaf Appearance (Colour, Graininess, Size, Cleanliness, Bloom): "))
         (liquor-appearance (read-string "Liquor Appearance (Colour, Brightness, Fullness, Briskness): "))
         (infusion-appearance (read-string "Infusion Appearance: "))
         (liquor-taste (when (member type '("Black" "Tisane"))
                         (read-string "Taste of Liquor: ")))
         (primary-note (when (not (member type '("Black" "Tisane")))
                         (read-string "Primary Taste Note (e.g. sweet, grassy): ")))
         (secondary-note (when (not (member type '("Black" "Tisane")))
                           (read-string "Secondary Taste Note (e.g. nutty, floral): ")))
         (tail-note (when (not (member type '("Black" "Tisane")))
                      (read-string "Tail Note (e.g. mineral, bitter): ")))
         (liquor-aroma (read-string "Aroma of Liquor: "))
         (temperature (concat (read-string "Temperature (e.g. 85): ") "°C"))
         (time (concat (read-string "Steeping Time (in minutes): ") " minutes"))
         (infusions (read-string "Recommended No. of Infusions: "))
         (weight (concat (read-string "Weight per cup (e.g. 2.5): ") " g"))
         (date (format-time-string "%A, %d %b %Y"
                                   (org-read-date nil t nil "Tasting Date: ")))
         (price (concat "INR " (read-string "Price (e.g. 250): ")))
         (comments (read-string "Any other comments: "))
         (tags (mapconcat (lambda (s) (concat ":" (replace-regexp-in-string " " "_" (downcase s)) ":"))
                          (list origin type region vendor) "")))
    (concat
     ;; (format "#+title: %s\n" name)
     (format "#+filetags: %s\n\n" tags)
     "* Tea Details\n"
     (format "** Name: %s\n" name)
     (format "** Origin: %s\n" origin)
     (if estate         (format "** Estate: %s\n" estate) "")
     (if grade          (format "** Grade: %s\n" grade) "")
     (if blend-details  (format "** Blend Details: %s\n" blend-details) "")
     (if season         (format "** Season: %s\n" season) "")
     (format "** Type: %s\n" type)
     (format "** Region: %s\n" region)
     (format "** Vendor: %s\n" vendor)
     "** Appearance:\n"
     "| Element  | Description                                                       |\n"
     "|----------+-------------------------------------------------------------------|\n"
     (format "| Leaf     | %s |\n" leaf-appearance)
     (format "| Liquor   | %s |\n" liquor-appearance)
     (format "| Infusion | %s |\n" infusion-appearance)
     "** Taste of Liquor:\n"
     (if liquor-taste
         (format "%s\n" liquor-taste)
       (concat
        (format "*** Primary Note: %s\n" primary-note)
        (format "*** Secondary Note: %s\n" secondary-note)
        (format "*** Tail Note: %s\n" tail-note)))
     (format "** Aroma of Liquor: %s\n" liquor-aroma)
     "** Preparation:\n"
     (format "*** Temperature: %s\n" temperature)
     (format "*** Steeping Time: %s\n" time)
     (format "*** Recommended No. of Infusions: %s\n" infusions)
     (format "*** Per cup: %s\n" weight)
     "** Acquired/Tasted:\n"
     (format "*** Date: %s\n" date)
     (format "*** Price: %s\n" price)
     "* Comments:\n"
     (format "%s\n" comments))))

(defun bmp/tea-blend-note ()
  "Return a tea blend Org-roam entry string with base tea, additives, combinations, taste, and score tables."
  (let* ((blend-name (org-roam-node-title org-roam-capture--node))
         (base-tea (read-string "Base Tea: "))
         (additive-list '())
         (more-additives t)
         (date (format-time-string "%A, %d %b %Y"
                                   (org-read-date nil t nil "Date of Blend: ")))
         (possible-names (read-string "Possible Names (comma-separated): "))
         (comments (read-string "Final comments: ")))

    (while more-additives
      (let ((additive (read-string "Additive (leave empty to finish): ")))
        (if (string-empty-p additive)
            (setq more-additives nil)
          (push additive additive-list))))
    (setq additive-list (reverse additive-list))

    (let* ((tag-items (append (list base-tea) additive-list))
           (tags (mapconcat (lambda (s) (concat ":" (replace-regexp-in-string " " "_" (downcase s)) ":"))
                            (cons "blend" tag-items) "")))

      (let* ((num-combos (string-to-number (read-string "Number of combinations: ")))
             (combos '())
             (taste-table "")
             (score-table ""))

        (dotimes (i num-combos)
          (let ((row (list (format "%d" (1+ i)))))
            (push (concat (read-string (format "Combo %d - %s (g): " (1+ i) base-tea)) " g") row)
            (dolist (add additive-list)
              (push (concat (read-string (format "Combo %d - %s (g): " (1+ i) add)) " g") row))
            (setq combos (append combos (list (reverse row)))))

          (let ((leaf (read-string (format "Taste for Combo %d - Leaf: " (1+ i))))
                (liquor (read-string (format "Taste for Combo %d - Liquor: " (1+ i))))
                (infusion (read-string (format "Taste for Combo %d - Infusion: " (1+ i)))))
            (setq taste-table
                  (concat taste-table
                          (format "| %d | %s | %s | %s |\n" (1+ i) leaf liquor infusion))))

          (let* ((leaf-score (string-to-number (read-string (format "Score for Combo %d - Leaf (0–10): " (1+ i)))))
                 (liquor-score (string-to-number (read-string (format "Score for Combo %d - Liquor (0–10): " (1+ i)))))
                 (infusion-score (string-to-number (read-string (format "Score for Combo %d - Infusion (0–10): " (1+ i)))))
                 (total-score (+ leaf-score liquor-score infusion-score)))
            (setq score-table
                  (concat score-table
                          (format "| %d | %d | %d | %d | %d |\n"
                                  (1+ i) leaf-score liquor-score infusion-score total-score)))))

        (let* ((header-cols (append (list "S.No" base-tea) additive-list))
               (combo-header (concat "| " (mapconcat #'identity header-cols " | ") " |\n"))
               (divider (concat "|-" (mapconcat (lambda (_) "--------") header-cols "-+-") "|\n"))
               (combo-rows (mapconcat (lambda (row)
                                        (concat "| " (mapconcat #'identity row " | ") " |"))
                                      combos "\n"))
               (taste-header "| S.No | Leaf | Liquor | Infusion |\n|------+-------+--------+----------|\n")
               (score-header "| S.No | Leaf | Liquor | Infusion | Total |\n|------+-------+--------+----------+--------|\n"))

          (concat
           ;; (format "#+title: %s\n" blend-name)
           (format "#+filetags: %s\n\n" tags)
           (format "* Date of Blend: %s\n" date)
           (format "* Name: %s\n" blend-name)
           (format "* Base Tea: %s\n" base-tea)
           (format "* Additives: %s\n" (string-join additive-list ", "))
           "* Combinations:\n"
           combo-header divider combo-rows "\n"
           "* Taste Table:\n"
           taste-header taste-table "\n"
           "* Score Table:\n"
           score-header score-table "\n"
           "* Possible Names:\n"
           (format "%s\n" possible-names)
           "* Final Comments:\n"
           (format "%s\n" comments)))))))


(defun bmp/org-roam--subdirectories ()
  "Return the subdirectories of `org-roam-directory' that hold notes.
Hidden directories (such as .venv) and the Templates, images and daily
directories are left out."
  (let ((skip '("Templates" "images" "daily")))
    (sort
     (delq nil
           (mapcar (lambda (dir)
                     (let ((name (file-name-nondirectory (directory-file-name dir))))
                       (and (file-directory-p dir)
                            (not (string-prefix-p "." name))
                            (not (member name skip))
                            (file-relative-name dir org-roam-directory))))
                   (directory-files-recursively
                    org-roam-directory "" t
                    (lambda (dir)
                      (let ((name (file-name-nondirectory (directory-file-name dir))))
                        (not (or (string-prefix-p "." name) (member name skip))))))))
     #'string<)))

(defun bmp/org-roam--read-subdirectory ()
  "Ask for a subdirectory of `org-roam-directory'; empty means the top level.
A name that is not an existing subdirectory needs RET twice, so a note
title typed here by mistake does not become a new folder."
  (completing-read "Subdirectory (empty for the top level): "
                   (bmp/org-roam--subdirectories) nil 'confirm))

(defun bmp/org-roam--clean-tag (string)
  "Turn STRING into a valid Org tag."
  (replace-regexp-in-string "[ /]" "_" (directory-file-name string)))

(defun bmp/org-roam-filetags (subdir)
  "Return a #+filetags value: SUBDIR as a tag plus any extra tags asked for."
  (let* ((extra (split-string
                 (read-string "Extra tags (space separated, or leave blank): ")
                 "[ :]+" t))
         (tags (append (unless (string-empty-p subdir)
                         (list (bmp/org-roam--clean-tag subdir)))
                       (mapcar #'bmp/org-roam--clean-tag extra))))
    (if tags (concat ":" (string-join tags ":") ":") "")))

(defvar bmp/org-roam-templates-directory
  (expand-file-name "Templates/" org-roam-directory)
  "Directory of the note templates (tangled from this file).")

(defun bmp/org-roam-templates (&optional subdir)
  "Return org-roam capture templates for notes in SUBDIR.
SUBDIR is relative to `org-roam-directory'; nil or empty means its top."
  (let* ((subdir (if (and subdir (not (string-empty-p subdir)))
                     (file-name-as-directory subdir)
                   ""))
         (file (concat subdir "%<%Y%m%d%H%M%S>-${slug}.org"))
         (head (format "#+title: ${title}\n#+date: %%<%%Y-%%m-%%d>\n#+filetags: %%(bmp/org-roam-filetags %S)\n\n"
                       subdir))
         (title-only "#+title: ${title}\n")
         (template (lambda (name)
                     (list 'file (expand-file-name name bmp/org-roam-templates-directory)))))
    `(("d" "Default" plain "%?"
       :target (file+head ,file ,head) :unnarrowed t)
      ("b" "Book Notes" plain ,(funcall template "BookNotesTemplate.org")
       :target (file+head ,file ,head) :unnarrowed t)
      ("a" "Author" plain ,(funcall template "AuthorTemplate.org")
       :target (file+head ,file ,head) :unnarrowed t)
      ("p" "Podcast" plain ,(funcall template "PodcastTemplate.org")
       :target (file+head ,file ,head) :unnarrowed t)
      ("f" "RSS Feed" plain ,(funcall template "RSSFeedTemplate.org")
       :target (file+head ,file ,head) :unnarrowed t)
      ;; These two write their own #+filetags
      ("t" "Tea Note" plain (function bmp/tea-note)
       :target (file+head ,file ,title-only) :unnarrowed t)
      ("s" "Tea Blend" plain (function bmp/tea-blend-note)
       :target (file+head ,file ,title-only) :unnarrowed t))))

(defun bmp/org-roam--in-directory (subdir)
  "Return a node filter for notes under SUBDIR of `org-roam-directory'."
  (let ((dir (file-name-as-directory
              (file-truename (expand-file-name subdir org-roam-directory)))))
    (lambda (node) (string-prefix-p dir (org-roam-node-file node)))))

(defun bmp/org-roam-node-find-all ()
  "Find a note in a subdirectory, or create it there."
  (interactive)
  (let ((subdir (bmp/org-roam--read-subdirectory)))
    (org-roam-node-find nil nil (bmp/org-roam--in-directory subdir) nil
                        :templates (bmp/org-roam-templates subdir))))

(defun bmp/org-roam-capture-all ()
  "Capture to a note in a subdirectory, existing or new."
  (interactive)
  (let ((subdir (bmp/org-roam--read-subdirectory)))
    (org-roam-capture- :node (org-roam-node-read nil (bmp/org-roam--in-directory subdir))
                       :templates (bmp/org-roam-templates subdir))))

(defun bmp/org-roam-insert-in-subdirectory ()
  "Insert a link to a note in a subdirectory, creating it there if new."
  (interactive)
  (let ((subdir (bmp/org-roam--read-subdirectory)))
    (org-roam-node-insert (bmp/org-roam--in-directory subdir)
                          :templates (bmp/org-roam-templates subdir))))

(global-set-key (kbd "C-c n b") 'bmp/org-roam-node-find-all)
(global-set-key (kbd "C-c n n") 'bmp/org-roam-capture-all)
(global-set-key (kbd "C-c n a") 'bmp/org-roam-insert-in-subdirectory)

;; (setq org-roam-db-node-include-function
;;     (lambda ()
;;       (condition-case nil
;;           (not (member "ATTACH" (org-get-tags nil t)))
;;         (error t))))

(add-to-list 'display-buffer-alist
             '("\\*org-roam\\*"
               (display-buffer-in-side-window)
               (side . right)
               (slot . 0)
               (window-width . 0.33)
               (window-parameters . ((no-other-window . t)
                                     (no-delete-other-windows . t)))))

(setq org-roam-db-gc-threshold most-positive-fixnum)

(defun bmp/force-org-roam-node-insert ()
  "Bypass package conflicts and forcefully insert an Org-roam link with its title."
  (interactive)

  ;; 1. Wake up Org-roam and force a DB sync if the cache is cold
  (require 'org-roam)
  (unless org-roam-db-autosync-mode
    (org-roam-db-autosync-mode 1))

  (let* ((region-text (when (use-region-p)
                        (buffer-substring-no-properties (region-beginning) (region-end))))
         (node (org-roam-node-read region-text nil nil nil "Node: "))
         (id (org-roam-node-id node))
         (title (or region-text (org-roam-node-title node))))

    (if id
        (progn
          ;; Clear the highlighted text if there is any
          (when (use-region-p)
            (delete-region (region-beginning) (region-end)))
          ;; Force the exact bracket syntax, bypassing all package hooks
          (insert (format "[[id:%s][%s]]" id title)))

      ;; 2. If it's a NEW node, pass instructions to insert the link AFTER capture is finished
      (org-roam-capture- :node node
                         :props (list :finalize 'insert
                                      :insert-at (point-marker)
                                      :region-start (and (use-region-p) (region-beginning))
                                      :region-end (and (use-region-p) (region-end)))))))

(use-package org-download
  :ensure t
  :after org
  :bind
  ;; On the notes prefix, not Super (which belongs to KDE)
  (:map org-mode-map
        (("C-c n Y" . org-download-screenshot)
         ("C-c n y" . org-download-yank)))
  :config
  (add-hook 'dired-mode-hook 'org-download-enable)
  (setq org-download-heading-lvl nil)
  (setq-default org-download-heading-lvl nil)

  ;; Was (concat org-directory "images"), which gave ~/orgimages
  (setq-default org-download-image-dir (expand-file-name "images/" bmp/notes-directory)))


;; Citations: Zotero (Better BibTeX keeps these .bib files current) -> citar
;; The .bib files are personal (see [[*Personal and local settings]])
(add-hook 'bmp/personal-loaded-hook
          (lambda ()
            (let ((files (mapcar #'expand-file-name bmp/bibliography)))
              (setq citar-bibliography files
                    org-cite-global-bibliography files))))

(use-package citar
  :ensure t
  :custom
  (org-cite-insert-processor 'citar)
  (org-cite-follow-processor 'citar)
  (org-cite-activate-processor 'citar)
  :hook (org-mode . citar-capf-setup)
  :bind (("C-c b" . citar-open)
         :map org-mode-map
         ("C-c C-x @" . org-cite-insert)))

(use-package citar-embark
  :ensure t
  :after (citar embark)
  :config
  (citar-embark-mode 1))

(use-package citar-org-roam
  :ensure t
  :after (citar org-roam)
  :custom
  (citar-org-roam-subdir "References")
  (citar-org-roam-note-title-template "${author} - ${title}")
  :config
  (citar-org-roam-mode 1))

(use-package org-roam-ui
  :ensure
  (:host github :repo "org-roam/org-roam-ui" :branch "main" :files ("*.el" "out"))
  :after org-roam
  :config
  (setq org-roam-ui-sync-theme t
        org-roam-ui-follow t
        org-roam-ui-update-on-save t
        org-roam-ui-open-on-start nil))

(use-package consult-org-roam
  :ensure t
  :after org-roam
  :init
  (require 'consult-org-roam)
  (consult-org-roam-mode 1)
  :custom

  (consult-org-roam-grep-func #'consult-ripgrep)
  (consult-org-roam-buffer-narrow-key ?r)
  (consult-org-roam-buffer-after-buffers t)
  :config
  (consult-customize
   consult-org-roam-forward-links
   :preview-key "M-.")
  :bind
  ("C-c n e" . consult-org-roam-file-find)
  ("C-c n B" . consult-org-roam-backlinks)
  ("C-c n L" . consult-org-roam-forward-links)
  ("C-c n r" . consult-org-roam-search))

update-desktop-database ~/.local/share/applications
xdg-mime default org-protocol.desktop x-scheme-handler/org-protocol

[Desktop Entry]
Name=Org Protocol
Comment=Send links from the browser to Emacs (org-protocol)
Exec=emacsclient %u
Icon=emacs
Type=Application
Terminal=false
NoDisplay=true
MimeType=x-scheme-handler/org-protocol;

(setq org-todo-keywords
      '((sequence
         "TODO(t)"
         "STARTED(s!)"
         "WAITING(w@/!)"
         "SOMEDAY(.)" "BLOCKED(k@/!)" "|" "CANCELLED(c!)" "DONE(d!)")
        (sequence "RESEARCH(r)" "|" "POSTED-SM(q!)" "BOOKMARKED(b!)" "ZETTELED(z!)" "COMPLETE(x!)")
        (sequence "TOLEARN(-)" "|" "LEARNING(l!)")))

;; My tags are personal (see [[*Personal and local settings]])
(add-hook 'bmp/personal-loaded-hook
          (lambda () (setq org-tag-alist bmp/org-tags)))

(defun bmp/org-faces-from-theme (&rest _)
  "Take Org's TODO-keyword and priority colours from the current ef theme.
Runs whenever a theme is enabled, so the colours follow theme changes."
  (when (seq-some (lambda (theme) (string-prefix-p "ef-" (symbol-name theme)))
                  custom-enabled-themes)
    (ef-themes-with-colors
      (setq org-todo-keyword-faces
            `(("TODO" . (:foreground ,red :weight bold))
              ("STARTED" . (:foreground ,blue :weight bold))
              ("DONE" . (:foreground ,green :weight bold))
              ("CANCELLED" . (:foreground ,green :weight bold))
              ;; cyan-cooler (teal): plain cyan is almost the same as blue
              ("WAITING" . (:foreground ,cyan-cooler :weight bold))
              ("BLOCKED" . (:foreground ,yellow-warmer :weight bold))
              ("SOMEDAY" . (:foreground ,magenta :weight bold))))
      (setq org-priority-faces
            `((?A . (:background ,green :foreground ,bg-main))
              (?B . (:background ,blue :foreground ,bg-main))
              (?C . (:background ,cyan-cooler :foreground ,bg-main))))
      ;; org-modern draws keywords and priorities as labels with faces of
      ;; its own, so give it the same colours (as label backgrounds)
      (setq org-modern-todo-faces
            (mapcar (lambda (entry)
                      (cons (car entry)
                            (list :background (plist-get (cdr entry) :foreground)
                                  :foreground bg-main :weight 'bold)))
                    org-todo-keyword-faces)
            org-modern-priority-faces org-priority-faces))))

(add-hook 'enable-theme-functions #'bmp/org-faces-from-theme)
(bmp/org-faces-from-theme)

(setq org-log-done 'time)
(setq org-enforce-todo-dependencies t)
(setq org-track-ordered-property-with-tag t)

(setq org-agenda-dim-blocked-tasks t
      org-agenda-window-setup 'current-window
      org-agenda-current-time-string ""
      org-agenda-time-grid '((daily) () "" "")
      org-agenda-hide-tags-regexp ".*"
      org-agenda-block-separator nil
      org-agenda-compact-blocks t)

(setq org-agenda-prefix-format '((agenda . "  %?-2i %t ")
                 (todo . " %i %-12:c")
                                 (tags . " %i %-12:c")
                     (search . " %i %-12:c")))


(use-package org-mem
  :ensure t
  :after org org-roam
  :config
  ;; Scan all Org files a few seconds after start-up and keep the cache
  ;; current on save, so the agenda is complete from the first launch.
  (run-with-idle-timer 3 nil #'bmp/org-mem-start))

(defun bmp/org-mem-forget-missing ()
  "Drop deleted files from the lists org-mem takes folders from.
org-mem scans the folder of every recent file and every file Org knows by
ID; a deleted folder there stopped the scan with \"Directory not readable\"."
  (when (boundp 'recentf-list)
    (setq recentf-list (seq-filter (lambda (f) (or (file-remote-p f) (file-exists-p f)))
                                   recentf-list)))
  (when (and (boundp 'org-id-locations) (hash-table-p org-id-locations))
    (let (gone)
      (maphash (lambda (id file) (unless (file-exists-p file) (push id gone)))
               org-id-locations)
      (dolist (id gone) (remhash id org-id-locations))
      (setq org-id-files (delete-dups (hash-table-values org-id-locations))))))

(defun bmp/org-mem-start ()
  "Start org-mem's scan and updates, after forgetting deleted files."
  (bmp/org-mem-forget-missing)
  (org-mem-updater-mode 1))

(defun my-set-agenda-files (&rest _)
  (setq org-agenda-files
      (cl-loop
       for file in (org-mem-all-files)
       unless (string-search "archive" file)
       when (seq-find (lambda (entry)
                        (or (org-mem-entry-active-timestamps entry)
                            (org-mem-entry-todo-state entry)
                            (org-mem-entry-scheduled entry)
                            (org-mem-entry-deadline entry)))
                      (org-mem-entries-in file))
       collect file)))

(add-hook 'org-mem-post-full-scan-functions #'my-set-agenda-files)

(defun bmp/truename-cache-dedup (&rest _)
  "Remove the duplicate names truename-cache adds on every org-mem scan.
It records each file's names with `push' even when they are already
there, so the cache grew by thousands of entries a scan (57 MB after
four days) and every garbage collection got slower.  Each distinct name
is kept, so the cache stays valid."
  (when (boundp 'truename-cache--true<>wilds)
    (maphash (lambda (truename names)
               (puthash truename (delete-dups names) truename-cache--true<>wilds))
             truename-cache--true<>wilds)))

(add-hook 'org-mem-post-full-scan-functions #'bmp/truename-cache-dedup)

(defvar bmp/org-mem-rescan-idle-minutes 10
  "Minutes of idle time before org-mem rescans all my notes.")

(defun bmp/org-mem-rescan-timer (&rest _)
  "Rescan all notes after `bmp/org-mem-rescan-idle-minutes' idle minutes.
org-mem's own delay is ten times the last scan's duration, which for my
notes meant a full rescan every 20 idle seconds.  Saved files are picked
up at once anyway; the full rescan only catches files changed outside
Emacs (Syncthing), so it does not need to run that often."
  (unless (member org-mem-updater--reset-timer timer-idle-list)
    (setq org-mem-updater--reset-timer
          (run-with-idle-timer (* 60 bmp/org-mem-rescan-idle-minutes) t
                               #'org-mem--scan-full))))

(with-eval-after-load 'org-mem-updater
  (advice-add 'org-mem-updater-adjust-reset-timer :override #'bmp/org-mem-rescan-timer))

(setq org-mem-do-sync-with-org-id t)

(defun bmp/setup-org-mem ()
  "Turn on `org-mem-updater-mode' and rescan all Org files."
  (interactive)
  (org-mem-updater-mode)
  (org-mem-reset))

(defun bmp/log-done-task-to-daily ()
  "Note a task finished outside org-roam under \"Completed\" in today's daily.
Tasks in org-roam notes are left where they are, so a task is never
recorded in two places."
  (when (and (member org-state org-done-keywords)
             buffer-file-name
             (not (string-prefix-p (file-truename org-roam-directory)
                                   (file-truename buffer-file-name))))
    (condition-case err
        (let* ((heading (org-get-heading t t t t))
               (org-capture-initial
                (format "%s %s"
                        (org-link-make-string
                         (concat "file:" (abbreviate-file-name buffer-file-name)
                                 "::*" heading)
                         heading)
                        (format-time-string "[%H:%M]"))))
          (require 'org-roam-dailies)
          (org-roam-capture-
           :node (org-roam-node-create)
           :templates
           `(("c" "Completed task" item "%i"
              :target (file+head+olp
                       ,(concat org-roam-dailies-directory "%<%Y-%m-%d>.org")
                       "#+title: %<%Y-%m-%d>\n" ("Completed"))
              :immediate-finish t :kill-buffer t))
           :keys "c"))
      (error (message "Could not log the task to today's daily: %S" err)))))

(add-hook 'org-after-todo-state-change-hook #'bmp/log-done-task-to-daily)

(use-package org-ql
  :ensure t)

(use-package org-super-agenda
  :ensure t
  :config
  (org-super-agenda-mode)
  (setq org-super-agenda-groups
        '((:name " Today"
                 :deadline today
                 :date today
                 :scheduled today
                 :order 1
                 :face 'warning)
          (:name " Upcoming Deadlines"
                 :deadline future
                 :order 2)
          (:name " Work tasks"
                 :tag nil  ; filled in from `bmp/work-tags', see below
                 :order 4
                 :scheduled (nil today future))
          )))

;; My work tags are personal (see [[*Personal and local settings]])
(add-hook 'bmp/personal-loaded-hook
          (lambda ()
            (with-eval-after-load 'org-super-agenda
              (setq org-super-agenda-groups
                    (mapcar (lambda (group)
                              (if (plist-member group :tag)
                                  (plist-put (copy-sequence group) :tag bmp/work-tags)
                                group))
                            org-super-agenda-groups)))))

(use-package request
  :ensure t)

(use-package wallabag
  :defer t
  :ensure (:host github
                 :repo "chenyanming/wallabag.el"
                 :files ("*.el" "*.alist" "*.css"))
  :config
  (auth-source-forget-all-cached)
  (setq wallabag-host     (or (bmp/lookup-password :host "wallabag-host-pop") "")
        wallabag-username bmp/wallabag-user
        wallabag-password (bmp/lookup-password :host "wallabag-pwd")
        wallabag-clientid (or (bmp/lookup-password :host "wallabag-clientid") "")
        wallabag-secret   (or (bmp/lookup-password :host "wallabag-secret") ""))
  (add-hook 'wallabag-after-render-hook 'wallabag-search-update-and-clear-filter))

(defvar bmp/shaarli-description-length 500
  "Longest description taken from a post or page when nothing is selected.")

(defun bmp/hmac-sha512 (key message)
  "Return the HMAC-SHA512 of MESSAGE with KEY, as raw bytes."
  (let* ((block 128)
         (key (encode-coding-string key 'utf-8))
         (message (encode-coding-string message 'utf-8))
         (key (if (> (length key) block) (secure-hash 'sha512 key nil nil t) key))
         (key (concat key (apply #'unibyte-string (make-list (- block (length key)) 0))))
         (pad (lambda (byte)
                (apply #'unibyte-string (mapcar (lambda (c) (logxor c byte)) key)))))
    (secure-hash 'sha512
                 (concat (funcall pad #x5c)
                         (secure-hash 'sha512 (concat (funcall pad #x36) message)
                                      nil nil t))
                 nil nil t)))

(defun bmp/shaarli--token (secret)
  "Return a JWT for Shaarli's API, signed with SECRET."
  (let* ((encode (lambda (s) (base64url-encode-string
                              (encode-coding-string s 'utf-8) t)))
         (unsigned (concat (funcall encode "{\"typ\":\"JWT\",\"alg\":\"HS512\"}") "."
                           (funcall encode (format "{\"iat\":%d}" (floor (float-time)))))))
    (concat unsigned "." (base64url-encode-string (bmp/hmac-sha512 secret unsigned) t))))

(defun bmp/shaarli--first-paragraph (text)
  "Return TEXT's first non-empty paragraph, cut to the description length."
  (let ((para (seq-find (lambda (p) (not (string-blank-p p)))
                        (split-string (or text "") "\n[ \t]*\n"))))
    (truncate-string-to-width
     (string-trim (replace-regexp-in-string "[ \t\n]+" " " (or para "")))
     bmp/shaarli-description-length nil nil "…")))

(defun bmp/shaarli--html-text (html)
  "Return HTML rendered as plain text."
  (with-temp-buffer
    (insert html)
    (let ((shr-use-fonts nil))
      (ignore-errors (shr-render-region (point-min) (point-max))))
    (buffer-substring-no-properties (point-min) (point-max))))

(defun bmp/shaarli--elfeed-entry ()
  "Return the elfeed entry being viewed, or at point in the list."
  (cond ((derived-mode-p 'elfeed-show-mode) elfeed-show-entry)
        ((derived-mode-p 'elfeed-search-mode)
         (car (elfeed-search-selected)))))

(defun bmp/shaarli--context ()
  "Return (URL TITLE TEXT TAGS) for what I am looking at."
  (let ((selection (and (use-region-p)
                        (buffer-substring-no-properties (region-beginning) (region-end))))
        (entry (and (featurep 'elfeed) (bmp/shaarli--elfeed-entry))))
    (cond
     (entry
      (list (elfeed-entry-link entry)
            (elfeed-entry-title entry)
            (or selection
                (let ((content (elfeed-deref (elfeed-entry-content entry))))
                  (and content (if (eq (elfeed-entry-content-type entry) 'html)
                                   (bmp/shaarli--html-text content)
                                 content))))
            (mapcar #'symbol-name
                    (cl-set-difference (elfeed-entry-tags entry) '(unread star)))))
     ((derived-mode-p 'eww-mode)
      (list (plist-get eww-data :url) (plist-get eww-data :title)
            (or selection (buffer-substring-no-properties (point-min) (point-max)))
            nil))
     (t
      (let* ((link (and (derived-mode-p 'org-mode)
                        (let ((ctx (org-element-context)))
                          (and (eq (org-element-type ctx) 'link) ctx))))
             (url (or (get-text-property (point) 'shr-url)
                      (and link (org-element-property :raw-link link))
                      (thing-at-point 'url t)))
             ;; An Org link's description makes a good title
             (title (and link (org-element-contents-begin link)
                         (buffer-substring-no-properties
                          (org-element-contents-begin link)
                          (org-element-contents-end link)))))
        (list url title selection nil))))))

(defvar bmp/shaarli-force-ipv4 t
  "Connect to Shaarli over IPv4 only.
My Shaarli's host publishes an IPv6 address on which HTTPS does not answer
(October 2026), and Emacs tries IPv6 first, so requests hung.  Over IPv4
the API answers at once.  Set this to nil once HTTPS works over IPv6
(`curl -6 https://<host>/shaarli/api/v1/info' gives 401 quickly).")

(defun bmp/shaarli--ipv4-only (orig &rest args)
  "Call `make-network-process' (ORIG with ARGS) asking for IPv4."
  (apply orig (plist-put args :family 'ipv4)))

(defun bmp/shaarli--request (method path secret base &optional body)
  "Send METHOD to Shaarli's API PATH at BASE; return (STATUS . JSON).
Uses IPv4 only while `bmp/shaarli-force-ipv4' is set (see there why)."
  (require 'url)
  (when bmp/shaarli-force-ipv4
    (advice-add 'make-network-process :around #'bmp/shaarli--ipv4-only))
  (unwind-protect
      (bmp/shaarli--request-1 method path secret base body)
    (advice-remove 'make-network-process #'bmp/shaarli--ipv4-only)))

(defun bmp/shaarli--request-1 (method path secret base body)
  "Send the request for `bmp/shaarli--request'."
  (let* ((url-request-method method)
         (url-request-extra-headers
          `(("Authorization" . ,(concat "Bearer " (bmp/shaarli--token secret)))
            ("Content-Type" . "application/json")))
         (url-request-data (and body (encode-coding-string (json-encode body) 'utf-8)))
         (buffer (url-retrieve-synchronously
                  (concat (string-remove-suffix "/" base) "/api/v1/" path) t nil 30)))
    (unless buffer (user-error "Shaarli did not answer at %s" base))
    (with-current-buffer buffer
      (prog1 (cons (bound-and-true-p url-http-response-status)
                   (and (bound-and-true-p url-http-end-of-headers)
                        (ignore-errors
                          (json-parse-string
                           (decode-coding-string
                            (buffer-substring-no-properties url-http-end-of-headers
                                                            (point-max))
                            'utf-8)
                           :object-type 'alist :array-type 'list))))
        (kill-buffer)))))

(defun bmp/shaarli-add (&optional private)
  "Bookmark what I am looking at in Shaarli; public unless PRIVATE (C-u)."
  (interactive "P")
  (pcase-let* ((`(,url ,title ,text ,tags) (bmp/shaarli--context))
               (url (read-string "Bookmark URL: " url))
               (_ (when (string-blank-p url) (user-error "No address to bookmark")))
               (title (read-string "Title: " (or title url)))
               (description (read-string "Description: "
                                         (bmp/shaarli--first-paragraph text)))
               (tags (completing-read-multiple "Tags (comma-separated): " tags
                                               nil nil (string-join tags ",")))
               (base (bmp/lookup-password :host "shaarli-url"))
               (secret (bmp/lookup-password :host "shaarli-api-secret")))
    (unless (and base secret)
      (user-error "Add shaarli-url and shaarli-api-secret to authinfo"))
    (pcase-let ((`(,status . ,json)
                 (bmp/shaarli--request
                  "POST" "links" secret base
                  `((url . ,url) (title . ,title) (description . ,description)
                    (tags . ,(vconcat tags)) (private . ,(if private t :json-false))))))
      (pcase status
        (201 (message "Saved to Shaarli (%s): %s" (if private "private" "public") title))
        (409 (message "Already in Shaarli: %s" (or (alist-get 'title json) url)))
        (401 (user-error "Shaarli refused the token; check the API secret and that the REST API is on"))
        (_ (user-error "Shaarli answered %s" status))))))

(with-eval-after-load 'elfeed-search
  (keymap-set elfeed-search-mode-map "C-c s" #'bmp/shaarli-add))
(with-eval-after-load 'elfeed-show
  (keymap-set elfeed-show-mode-map "C-c s" #'bmp/shaarli-add))