émile — a journey with Emacs

;;; early-init.el -*- lexical-binding: t -*-

;;; init.el -*- lexical-binding: t -*-

(setopt mode-line-front-space "-"
        mode-line-end-spaces '(:eval "-%-"))

(add-hook 'emacs-startup-hook #'winner-mode)

(require 'consult)
(require 'modus-themes)
(require 'ef-themes)
(require 'doric-themes)
(require 'standard-themes)

(setopt ef-themes-mixed-fonts nil)

(defvar my/initial-theme 'ef-spring)

(add-hook 'emacs-startup-hook #'my/load-initial-theme)

(defun my/load-initial-theme ()
  (modus-themes-select my/initial-theme))

(setq vc-follow-symlinks t)

(defmacro my/package (name &rest args)
  "Configure a package.
NAME is an unquoted symbol to use as the package name.  The
remaining ARGS are unquoted forms to be evaluated after load time,
or other facilities designated by the following keywords:

‘:autoload’ specifies unquoted symbols for which autoloads should
be generated.  This can help overcome missing autoloads in
certain packages.

‘:init’ means the following forms should be evaluated before the
package is loaded.

‘:config’ means the following forms should be evaluated after the
package is loaded.

When the package configuration is compiled, it automatically
requires all packages, so it can report unknown variables and
functions."
  (declare (indent defun))
  (let ((accum :config)     ; The type of argument we're currently accumulating.
        autos               ; Accumulated autoload statements.
        inits               ; Accumulated initialization forms.
        afters)             ; Accumulated after-load forms.
    (unless (symbolp name)
      (error "Package name must be a symbol (unquoted)"))
    (dolist (arg args)
      (cond
       ((eq arg :init) (setq accum :init))
       ((eq arg :config) (setq accum :config))
       ((eq arg :autoload)
        (setq accum :autoload))
       ;; The accumulators store forms in reverse order until they're used.
       ((eq accum :init) (setq inits (cons arg inits)))
       ((eq accum :config) (setq afters (cons arg afters)))
       ((eq accum :autoload)
        (setq autos (cons `(autoload ',arg ,(symbol-name name) nil t) autos)))
       (t (error "Unexpected case"))))
    (cons 'progn
          (append
           (unless (null autos)
             `((eval-and-compile . ,(nreverse autos))))
           (nreverse inits)
           (unless (null afters)
             `((with-eval-after-load ',name . ,(nreverse afters))))))))

(defmacro my/define-key (keymap key def)
  "Call ‘define-key’, possibly using ‘kbd’ to expand the KEY.
Pass KEYMAP and DEF without alteration."
  `(define-key ,keymap
     ,(cond
       ((stringp key) (kbd key))
       ((vectorp key) key)
       (t `(kbd ,key)))
     ,def))

(defmacro my/bind (&rest args)
  "Define alternating key/definition pairs in ARGS.
Optionally, ARGS begins with a keymap; if not, use ‘global-map’.
Each key is potentially routed through ‘kbd’."
  (declare (indent defun))
  (let ((keymap 'global-map))
    ;; Override the keymap if first arg is a symbol.
    (when (symbolp (car args))
      (setq keymap (car args)
            args (cdr args)))
    (cons 'progn
          (cl-loop
           for a = args then (cddr a)
           until (null a)
           collect `(my/define-key ,keymap ,(car a) ,(cadr a))))))

(defmacro my/unbind (&rest args)
  "Unbind the keys in ARGS.
Optionally, ARGS begins with a keymap; if not, use ‘global-map’.
Each key is potentially routed through ‘kbd’."
  (declare (indent defun))
  (let* ((keymap 'global-map))
    (when (symbolp (car args))
      (setq keymap (car args)
            args (cdr args)))
    (cons 'progn
          (mapcar (lambda (key) `(my/define-key ,keymap ,key nil)) args))))

(my/keymap-command my/roam-keymap)
(my/keymap-command my/pair-keymap)
(my/keymap-command my/outline-keymap)

;;;; Modal editing

(my/package meow                ; Yet another modal editing system
  :autoload
  ;; The default autoload for ‘meow-global-mode’ loads only ‘meow-core’, which
  ;; then doesn't trigger this configuration.  So it's crucial that we redirect
  ;; its autoload to global ‘meow’ library.
  meow-global-mode
  :init
  (add-hook 'emacs-startup-hook #'meow-global-mode -10)
  :config
  ;; Some Meow-ish commands work differently depending on whether there is a
  ;; selection.  We can integrate our custom commands with that mechanism.
  (add-to-list 'meow-selection-command-fallback
               '(my/eval-dwim . eval-expression))
  (add-to-list 'meow-selection-command-fallback
               '(my/meow-append . my/meow-forward-append))
  (setq meow-cheatsheet-layout meow-cheatsheet-layout-dvorak
        meow-goto-line-function #'goto-line
        meow-expand-exclude-mode-list nil)
  ;; Let's use ‹M-g› to escape insert mode.  It previously led to ‘goto-map’ but
  ;; we can put those commands elsewhere.
  (my/bind meow-insert-state-keymap
    [escape] #'meow-insert-exit
    "M-g" #'meow-insert-exit)
  (my/bind meow-motion-state-keymap
    "M-g" #'ignore
    [escape] #'ignore))

(defun my/meow-overwrite ()
  "Switch to insert state, but in ‘overwrite-mode’."
  (interactive)
  (meow-insert)
  (overwrite-mode 1))

(defun my/meow-line-maybe-viz (n &optional expand)
  "Select the current line, or N lines, EXPAND if appropriate."
  (interactive "p")
  (if visual-line-mode
      (meow-visual-line n expand)
    (meow-line n expand)))

(defun my/meow-append ()
  "Work like ‘meow-append’ when there is an active selection.
Otherwise, fallback to ‘my/meow-forward-append’. This ensures
that append works differently from insert."
  (interactive)
  (meow--with-selection-fallback
   (meow-append)))

(defun my/meow-forward-append ()
  "Move forward one character, then insert.
If we're at end of line or end of buffer, insert a space first.
This ensures that append works differently from insert. It's
similar to setting ‘meow-use-cursor-position-hack’, but that
doesn't seem cognizant of the end of line (and may have other
effects on other commands)."
  (interactive)
  (if (eolp)
      (insert " ")
    (forward-char))
  (meow--switch-state 'insert))

;;;;; Paired delimiters as text objects

(defmacro my/pair (key sym open close)
  "Define the characters OPEN and CLOSE as a pair.
That means we populate the ‘meow-char-thing-table’ and
‘insert-pair-alist’ with KEY and SYM."
  (let ((pair-var (gensym "pair"))
        (def-var (gensym "def")))
    `(let ((,pair-var '(,open ,close))
           (,def-var ',(cons (format "insert-%c%s%c" open sym close)
                             #'insert-pair)))
       (add-to-list 'insert-pair-alist ,pair-var)
       ,(when (< open 128)
          `(my/bind my/pair-keymap
             ,(string open) ,def-var
             ,(format "M-%c" open) ,def-var))
       ,(when (and key (not (= key open)))
          `(progn
             (add-to-list 'insert-pair-alist (cons ,key ,pair-var))
             (my/bind my/pair-keymap
               ,(string key) ,def-var
               ,(format "M-%c" key) ,def-var)))
       ;; meow-thing, at least with the “pair” spec, doesn't seem to work when
       ;; the open/close chars are the same.
       ,(unless (= open close)
          `(let ((th '(pair (,(string open)) (,(string close)))))
             (meow-thing-register ',sym th th)
             (add-to-list 'meow-char-thing-table ',(cons open sym))
             ,(when key
                `(add-to-list 'meow-char-thing-table ',(cons key sym))))))))

(add-hook 'meow-global-mode-hook #'my/meow-thing-pair-setup)
(defun my/meow-thing-pair-setup ()
  "Configure meow-thing and ‘insert-pair’ characters."
  ;; Might be simplest to clear and start from nil.
  (setq insert-pair-alist nil)
  ;; Adjust the mapping from letter keys to things
  (setq meow-char-thing-table
        (delete '(?g . string)
                (delete '(?e . symbol) meow-char-thing-table)))
  (add-to-list 'meow-char-thing-table '(?n . string))
  (add-to-list 'meow-char-thing-table '(?o . symbol))
  (add-to-list 'meow-char-thing-table '(?e . page))
  (add-to-list 'meow-char-thing-table '(?\] . page))
  (meow-thing-register 'page #'my/meow-inner-of-page #'my/meow-bounds-of-page)
  (add-to-list 'meow-char-thing-table '(?k . org-block))
  (meow-thing-register 'org-block
                       #'my/meow-inner-of-org-block
                       #'my/meow-bounds-of-org-block)
  ;; At this stage, thing-letters "acefghijkmqrstuxyz" are still available.
  (my/bind my/pair-keymap "d" #'my/delete-surround)
  (my/pair ?r  round    ?\( ?\)) ; U+0028,0029 parenthesis
  (my/pair ?s  square   ?\[ ?\]) ; U+005B,005D square bracket
  (my/pair ?c  curly    ?{  ?})  ; U+007B,007C curly bracket
  (my/pair ?a  angle    ?‹  ?›)  ; U+2039,203A single angle quote     \flq  .<
  (my/pair ?g  guill    ?«  ?»)  ; U+00AB,00BB double angle/guillemet \flqq <<
  (my/pair ?q  quote    ?‘  ?’)  ; U+2018,2019 single quote           \lq   '<
  (my/pair ?u  dquote   ?“  ?”)  ; U+201C,201D double quote           \ldq
  (my/pair ?f  feather  ?᚛  ?᚜)  ; U+169B,169C ogham feather mark
  (my/pair ?h  html     ?<  ?>)  ; U+003C,003E less/greater than
  (my/pair ?x  tex      ?`  ?')  ; U+0060,0027 teX grave/apostrophe
  ;; We're left with "eijkmtyz".
  ;; (my/pair ?e  corner   ?｢  ?｣); U+FF62,FF63 halfwidth corner bracket     !<
  ;; (my/pair ?m  mangle   ?⟨  ?⟩); U+27E8,27E9 math angle bracket   \langle ,<
  (my/pair ?y  tquote   ?\" ?\") ; U+0022      typewriter quote
  (my/pair ?t  code     ?~  ?~)  ; U+007E      tilde
  (my/pair ?v  verbatim ?=  ?=)  ; U+007E      tilde
  (my/pair ?k  emph     ?*  ?*)  ; U+002A      asterisk/emphasis/bold
  (my/pair ?i  strike   ?+  ?+)  ; U+002B      plus/strikeout
  (my/pair ?j  under    ?_  ?_)  ; U+005F      low line/underscore/underline
  (my/pair ?z  tick     ?`  ?`)  ; U+0060      backtick/grave [conflict w/teX]
  (my/pair nil slant    ?/  ?/)  ; U+002F      slash/slant/italic
  (my/pair nil squote   ?'  ?')) ; U+0027      apostrophe/single quote

;;;;; Form-feed pages as text objects

(defun my/meow-inner-of-page ()
  "Report the inner content of a page, up to the form feed delimiter."
  (cons (save-excursion
          (unless (looking-back page-delimiter nil)
            (backward-page))
          (point))
        (save-excursion
          (forward-page)
          ;; Actually, stop before the newline preceding the form feed.
          (when (looking-back page-delimiter (- (point) 10))
            (end-of-line 0))
          (point))))

(defun my/meow-bounds-of-page ()
  "Report the bounds of a page, including the form feed."
  (cons (save-excursion
          (unless (looking-back page-delimiter nil)
            (backward-page))
          (point))
        (save-excursion
          (forward-page)
          (point))))

(my/package org-element)

(defun my/meow-inner-of-org-block ()
  "Report the bounds of the inner portion of an ‘org-mode’ block."
  (let ((region (my/meow-bounds-of-org-block)))
    (cons (save-excursion
            (goto-char (car region))
            (forward-line)
            (point))
          (save-excursion
            (goto-char (cdr region))
            (forward-line -2)
            (point)))))

(defun my/meow-bounds-of-org-block ()
  "Report the bounds of an ‘org-mode’ block, including the delimiter lines."
  (let ((case-fold-search t))
    (save-excursion
      (re-search-forward "#\\+end_" nil 'noerror)
      (let ((element (org-element-at-point)))
        (if (string-match-p "block" (symbol-name (org-element-type element)))
            (cons (org-element-begin element)
                  (org-element-end element))
          (user-error "Not in a block"))))))

(defun my/add-dot-gz (path)
  "Add the ‘.gz’ extension to PATH."
  (concat path ".gz"))

;; Undo is becoming slow. I have ‘undo-tree-limit’ set to 80,000,000 and
;; ‘undo-limit’ set to 160,000. It may be that the compression/decompression is
;; what makes it feel slow? *No* it’s slow when it gets big enough, even without
;; compression.

(my/package undo-tree           ; Treat undo history as a tree
  :init
  (setopt undo-tree-auto-save-history nil)
  (add-hook 'emacs-startup-hook #'global-undo-tree-mode)
  :config
  ;; (advice-add #'undo-tree-make-history-save-file-name
  ;;             :filter-return
  ;;             #'my/add-dot-gz)
  (my/bind undo-tree-map "C-_" nil)) ; Use for text-scale-adjust

;;;; Text structure and navigation

(my/package outline             ; Outline-format documents and code
  (my/bind my/outline-keymap
    "a"   #'outline-show-all
    "b"   #'outline-backward-same-level
    "c"   #'outline-hide-entry
    "d"   #'outline-hide-subtree
    "e"   #'outline-show-entry
    "f"   #'outline-forward-same-level
    "TAB" #'outline-show-children
    "k"   #'outline-show-branches
    "l"   #'outline-hide-leaves
    "RET" #'outline-insert-heading
    "n"   #'outline-next-visible-heading
    "o"   #'outline-hide-other
    "p"   #'outline-previous-visible-heading
    "q"   #'outline-hide-sublevels
    "s"   #'outline-show-subtree
    "t"   #'outline-hide-body
    "u"   #'outline-up-heading
    "v"   #'outline-move-subtree-down
    "^"   #'outline-move-subtree-up
    "@"   #'outline-mark-subtree
    "<"   #'outline-promote
    ">"   #'outline-demote))

(my/package avy                 ; Jump and select in visible text quickly
  :autoload
  avy-goto-word-0-above avy-goto-word-0-below
  avy-goto-whitespace-end-above avy-goto-whitespace-end-below
  :init
  (with-eval-after-load 'isearch
    (my/bind isearch-mode-map "C-'" #'avy-isearch))
  :config
  ;; It may be convenient if this doesn't overlay with ‘avy-dispatch-alist’.
  (setq avy-keys '(?h ?u ?t ?e ?n ?o ?d ?i ?s ?a)))

(my/package drag-stuff
  :init
  (add-hook 'ledger-mode-hook #'drag-stuff-mode)
  (add-hook 'prog-mode-hook #'drag-stuff-mode)
  :config
  (setq drag-stuff-modifier '(meta shift))
  (drag-stuff-define-keys))

;;;; Files and directories

(my/package recentf             ; Track recently opened files
  :init
  (add-hook 'emacs-startup-hook #'recentf-mode)
  :config
  (setq recentf-max-saved-items 1024)
  (add-to-list 'recentf-exclude "\\.age\\|\\.gpg\\'")
  (add-to-list 'recentf-exclude "^/\\(?:ssh\\|su\\|sudo\\)?:")
  (add-to-list 'recentf-exclude
               (regexp-opt
                (list (recentf-expand-file-name no-littering-var-directory)
                      (recentf-expand-file-name no-littering-etc-directory)))))

(my/package saveplace           ; Automatically save our position in files
  :init
  (setopt save-place-save-skipped nil
          save-place-skip-check-regexp
          (rx (or
               ;; Decompiled from default value using ‘xr-pp’
               (seq bos "/"
                    (or "cdrom" "floppy" "mnt"
                        (seq (opt (zero-or-more (not (any "/:@"))) "@")
                             (zero-or-more (not (any "/:@")))
                             (not (any "./:@")) ":")))
               ;; Avoid loading crypto libraries on saveplace startup
               (seq (or ".age" ".gpg") eos))))
  (add-hook 'emacs-startup-hook #'save-place-mode))

(my/package autorevert          ; Revert buffers when files on disk change
  :init
  (add-hook 'prog-mode-hook #'auto-revert-mode)
  (add-hook 'latex-mode-hook #'auto-revert-mode)
  (add-hook 'org-mode-hook #'auto-revert-mode)
  (add-hook 'dired-mode-hook #'auto-revert-mode))

(my/package persist-state       ; Regularly save history, bookmarks, etc.
  :init
  (add-hook 'emacs-startup-hook #'persist-state-mode))

(defun my/yes (&rest _args)
  "Always answer yes."
  t)

(my/package dired               ; Directory-browsing buffer and commands
  :init
  (advice-add #'shell-command--same-buffer-confirm
              :override #'my/yes)
  :config
  (require 'dired-x)
  (add-hook 'dired-mode-hook #'dired-hide-details-mode)
  (my/bind dired-mode-map
    "E" #'wdired-change-to-wdired-mode
    "@" #'dired-create-empty-file)
  (add-to-list 'dired-guess-shell-alist-user
               '("\\.pdf\\'" "okular" "xournalpp"))
  (add-to-list 'dired-guess-shell-alist-user '("\\.\\'" "caja"))
  (add-to-list 'dired-guess-shell-alist-user
               '("\\.xopp\\'" "xournalpp"))
  (add-to-list 'dired-guess-shell-alist-user
               '("\\.\\(od[tps]\\|\\(doc\\|xls\\|ppt\\)x?\\)\\'" "libreoffice"))
  (add-to-list 'display-buffer-alist
               (cons "\\*Async Shell Command\\*.*"
                     (cons #'display-buffer-no-window nil))))

(my/package dired-x             ; Extra directory/file commands
  :autoload
  dired-x-find-file dired-x-find-file-other-window
  :init
  (my/bind
    [remap find-file] #'dired-x-find-file
    [remap find-file-other-window] #'dired-x-find-file-other-window))

(add-hook 'find-file-hook #'my/dont-persist-decrypted-data)
(defun my/dont-persist-decrypted-data ()
  "Disable backups, auto-save, and persistent undo for encrypted files."
  (when (and buffer-file-name
             (string-match "\\.\\(age\\|gpg\\)\\'" buffer-file-name))
    (message "AGE: inhibiting backups etc")
    (setq-local backup-inhibited t)
    (setq-local undo-tree-auto-save-history nil)
    (auto-save-mode -1)))

(my/package age
  :init
  (add-to-list 'file-name-handler-alist '("\\.age\\'" . age-file-handler))
  :config
  (setq age-default-identity "~/.ssh/id_ed25519"
        age-default-recipient "~/.ssh/id_ed25519.pub"))

;;;; Version control

(my/bind ctl-x-map
  "v g" #'magit-file-dispatch ; ‹SPC x v g›, clobbers ‘vc-annotate’
  "v b" #'vc-annotate)

;;;; Fonts and themes

(my/package face-remap          ; Built-in for global text scale adjustment
  :init
  (my/bind
    "C-+" #'global-text-scale-adjust
    "C-_" #'my/global-text-scale-decrement)
  :config
  (setopt frame-resize-pixelwise t
          global-text-scale-adjust-resizes-frames nil))

(defun my/global-text-scale-decrement ()
  "Decrement the font size of all faces.
The command ‘global-text-scale-adjust’ relies on the last key
pressed to determine whether to increment or decrement, but it
doesn't recognize underscore to be equivalent to minus.  So we
force it to decrement with this wrapper."
  (interactive)
  (global-text-scale-adjust -1))

(when (member "Iosevka Fixed Slab" (font-family-list))
  (set-face-attribute 'default nil :font "Iosevka Fixed 12")
  (face-spec-reset-face 'variable-pitch)
  (face-spec-reset-face 'fixed-pitch)
  (face-spec-reset-face 'fixed-pitch-serif))

;;;; Margins and fringes

(my/package display-line-numbers ; What it says on the tin!
  :init
  (add-hook 'prog-mode-hook #'display-line-numbers-mode)
  :config
  (setq display-line-numbers-grow-only t))

(my/package display-fill-column-indicator ; Right margin demarcation
  :init
  (add-hook 'prog-mode-hook #'display-fill-column-indicator-mode))

(add-hook 'display-fill-column-indicator-mode-hook #'my/set-fill-column)
(defun my/set-fill-column (&optional col)
  "Set ‘fill-column’ to COL (default 80) unless already set locally."
  (unless (assoc 'fill-column (buffer-local-variables))
    (setq fill-column (or col 80))))

;;;; Minibuffer

(my/package savehist            ; Save minibuffer input history
  :init
  (add-hook 'emacs-startup-hook #'savehist-mode))

(my/package which-key           ; Display available keybindings in popup
  :init
  (add-hook 'emacs-startup-hook #'which-key-mode)
  :config
  (setq
   which-key-show-early-on-C-h t
   which-key-idle-delay 0.7
   which-key-idle-secondary-delay 0.3
   ;; Arrows and ellipses are too wide in Iosevka.  Setting the following
   ;; means arrow keys will show up as “left” and “right”.
   which-key-dont-use-unicode nil
   which-key-separator " "
   which-key-add-column-padding 1
   which-key-sort-order #'which-key-key-order-alpha
   which-key-sort-uppercase-first nil))

(my/package vertico-directory   ; Directory navigation in vertico
  (add-hook 'rfn-eshadow-update-overlay-hook #'vertico-directory-tidy))

(my/package vertico             ; Vertical interactive minibuffer completion
  :init
  (setq enable-recursive-minibuffers t
        read-file-name-completion-ignore-case t
        read-buffer-completion-ignore-case t
        completion-ignore-case t)
  (add-hook 'emacs-startup-hook #'vertico-mode)
  :config
  (add-hook 'vertico-mode-hook #'vertico-indexed-mode)
  (my/bind vertico-map
    "RET" #'vertico-directory-enter
    "DEL" #'vertico-directory-delete-char
    "M-DEL" #'vertico-directory-delete-word))

(my/package orderless           ; Complete by matching regexps in any order
  :init
  (setq completion-styles '(orderless basic)
        completion-category-defaults nil
        completion-category-overrides '((file (styles partial-completion)))))

(my/package consult             ; More featureful ‘completing-read’
  :init
  (my/bind
    [remap switch-to-buffer] #'consult-buffer
    [remap switch-to-buffer-other-window] #'consult-buffer-other-window
    [remap switch-to-buffer-other-frame] #'consult-buffer-other-frame)
  :config
  (setq imenu-max-item-length 150))

(my/package consult-imenu
  (push '(?h "Headings" font-lock-comment-face)
        (plist-get (alist-get 'emacs-lisp-mode consult-imenu-config) :types)))

(add-hook 'emacs-lisp-mode-hook #'my/augment-elisp-imenu)
(defun my/augment-elisp-imenu ()
  "Add package configs and headings to ‘imenu-generic-expression’."
  (setq imenu-generic-expression
        (assoc-delete-all "Headings"
                          (assoc-delete-all "Packages" imenu-generic-expression)))
  (push '("Headings" "^;;;;* \\(.*\\)$" 1) imenu-generic-expression)
  (push `("Packages"
          ,(concat "^(my/package \\(" (rx lisp-mode-symbol) "\\)") 1)
        imenu-generic-expression))

;;;; Mode line

(defun my/mode-name (sym name)
  "Specify a mode indicator for major-mode SYM with indicator NAME."
  (pcase sym
    ('fundamental-mode "Ø")
    ('lisp-interaction-mode "iLisp")
    ('python-mode "Py")
    (_
     (cond
      ((stringp name)
       (replace-regexp-in-string "\\bMagit\\b" "Mg" name 'fixedcase))
      (t name)))))

(my/package embark
  :init
  (my/bind "M-]" #'embark-act)
  :config
  (require 'embark-consult))

;;;; Programming

(defun my/eval-dwim ()
  "Evaluate active region as Lisp code; else prompt for expression."
  (interactive)
  (meow--with-selection-fallback
   (eval-region (region-beginning) (region-end))))

(add-hook 'prog-mode-hook #'column-number-mode)

(my/package hl-todo             ; Highlight “TODO” & similar keywords
  :init
  (add-hook 'prog-mode-hook #'hl-todo-mode))

(my/package rainbow-mode        ; Colorize color names and specs
  :init
  ;; I tried applying rainbow-mode in help-mode-hook so that inspecting
  ;; variables (such as palettes) containing color codes would show the colors.
  ;; Unfortunately, this broke list-faces-display, which also derives from
  ;; help-mode.
  (dolist (h '(emacs-lisp-mode-hook
               nix-mode-hook racket-mode-hook
               php-mode-hook
               python-mode-hook
               graphviz-dot-mode-hook))
    (add-hook h #'rainbow-mode))
  :config
  (setq rainbow-x-colors-major-mode-list nil))

(my/package envrc               ; Buffer-local direnv integration
  :init
  (add-hook 'emacs-startup-hook #'envrc-global-mode))

(my/package dockerfile-mode     ; Editing dockerfiles
  :init
  (add-to-list 'auto-mode-alist
               (cons "/Dockerfile\\b" #'dockerfile-mode)))

(my/package olivetti
  :init
  (put 'olivetti-body-width 'safe-local-variable 'integerp))

(my/package ansi-color
  :init
  (add-hook 'compilation-filter-hook 'ansi-color-compilation-filter))

;;;; Text documents

(setq sentence-end-double-space nil)

(defvar ispell-dictionary-alist)

(add-hook 'flyspell-mode-hook #'my/fix-ispell-apostrophe)
(defun my/fix-ispell-apostrophe ()
  "Fixes contractions (e.g. shouldn't) aren't not being checked properly.
See https://github.com/casouri/lunarymacs/blob/master/star/checker.el#L44-L49."
  (add-to-list
   'ispell-dictionary-alist
   '("en_US" "[[:alpha:]]" "[^[:alpha:]]" "['’]" nil
     ("-d" "en_US") nil utf-8)))

(my/package flyspell
  (my/unbind flyspell-mode-map "C-M-i"))

(my/package pdf-tools
  :init
  (pdf-loader-install 'no-query 'skip-dependencies))

(add-hook 'org-mode-hook #'my/org-prettify-symbols)
(defun my/org-prettify-symbols ()
  "Set up pretty symbols for ‘org-mode’."
  (setq
   prettify-symbols-unprettify-at-point nil
   prettify-symbols-alist
   '((":results" . ?➡)
     ("#+begin_export"  . ?┌)
     ("#+end_export"    . ?└)
     ("#+begin_center"  . ?┬)
     ("#+end_center"    . ?┴)
     ("#+begin_example" . ?┏)
     ("#+end_example"   . ?┗)
     ("#+begin_quote"   . ?»)
     ("#+end_quote"     . ?«)
     ("#+begin_src"     . ?◇)
     ("#+end_src"       . ?◆)
     ("#+begin_verse"   . ?□)
     ("#+end_verse"     . ?■)
     ("#+BEGIN:"        . ?╭)
     ("#+END:"          . ?╰)
     ("#+begin_comment" . ?╓)
     ("#+end_comment"   . ?╙)))
  (prettify-symbols-mode))

(make-variable-buffer-local 'org-format-latex-options)

;; A mode to update org dblocks.
(define-minor-mode my/org-update-dblocks-mode
  "Automatically update org dblocks upon save.
TODO: maybe also update on load. That could be a distinct minor mode, or
an option setting."
  :lighter ""
  (if my/org-update-dblocks-mode
      (add-hook 'before-save-hook #'org-update-all-dblocks nil t)
    (remove-hook 'before-save-hook #'org-update-all-dblocks t)))

;; A mode to scale LaTeX blocks.
(defcustom my/org-format-latex-scale 2.0
  "Scale factor applied to images generated from latex blocks."
  :safe #'numberp :type 'number :group 'org)

(define-minor-mode my/org-format-latex-scale-mode
  "Patch a scale factor into ‘org-format-latex-options’."
  :lighter " TeXs"
  (setq org-format-latex-options
        (plist-put (copy-tree org-format-latex-options)
                   :scale
                   (if my/org-format-latex-scale-mode
                       my/org-format-latex-scale
                     (plist-get
                      (default-value 'org-format-latex-options)
                      :scale)))))

(my/package org
  :init
  (setq org-export-backends '(ascii html latex beamer))
  :config
  (require 'ol-notmuch)
  (my/bind ctl-x-map "l" #'org-store-link)
  (my/unbind org-mode-map
    "C-c C-x C-p" ; org-previous-link vs org-set-property
    "C-c ["       ; org-agenda-file-to-front
    "C-c ]")      ; org-remove-file
  (put 'org-remove-file 'disabled t)
  (put 'org-agenda-file-to-front 'disabled t)
  (put 'org-agenda-files 'risky-local-variable-p t)
  (add-to-list 'org-src-lang-modes '("dot" . graphviz-dot))
  (setq org-babel-load-languages ; setopt would issue warning re ledger
        '((dot . t) (python . t) (ledger . t) (emacs-lisp . t)))
  ;; Could create better correspondence between ‘org-file-apps’ and
  ;; ‘dired-guess-shell-alist-user’.
  (add-to-list 'org-file-apps
               '("\\.\\(?:od[tps]\\|\\(?:doc\\|xls\\|ppt\\)x?\\)\\'"
                 . "libreoffice %s"))
  (add-to-list 'org-file-apps
               '("\\.pdf\\'" . "okular %s"))
  (setq org-directory "~/u/notes"
        org-agenda-files '("~/u/notes/agenda/")
        org-agenda-skip-unavailable-files t
        org-enforce-todo-dependencies t
        org-use-fast-todo-selection t
        org-tags-exclude-from-inheritance '("project" "agenda")
        org-todo-keywords
        '((sequence "PROJ(p)" "TODO(t)" "WAIT(w)" "|" "DONE(d)" "STOP(s)"))
        org-todo-keyword-faces
        '(("PROJ" . custom-button-pressed)
          ("WAIT" . custom-button-mouse))))

(my/package calendar
  :init
  (setq calendar-week-start-day 1))

(defun my/org-agenda-cmp-quick (a b)
  "Compare org entries A and B by whether they are tagged ‘quick’."
  (let* ((qa (member "quick" (last (get-text-property 1 'tags a))))
         (qb (member "quick" (last (get-text-property 1 'tags b)))))
    (cond
     ((and qa (not qb)) -1)
     ((and (not qa) qb) +1))))

(add-hook 'org-agenda-finalize-hook #'my/bob)
(defun my/bob ()
  "Move point to the beginning of the buffer."
  (goto-char (point-min)))

(my/package org-agenda
  :init
  (add-hook 'org-agenda-mode-hook #'hl-line-mode)
  :config
  (my/bind org-agenda-mode-map "C-o" #'casual-agenda-tmenu)
  (setq org-agenda-dim-blocked-tasks t
        org-refile-targets '((org-agenda-files . (:maxlevel . 2)))
        org-refile-use-outline-path 'file
        org-outline-path-complete-in-steps nil
        org-reverse-note-order t
        org-refile-allow-creating-parent-nodes nil
        org-stuck-projects
        ;; NOTE — One problem with using the scheduled tag in this way: if an
        ;; incomplete project has just one complete and scheduled (in the past)
        ;; child, then it doesn't show up as stuck.
        '("/PROJ" ("TODO" "WAIT") ("scheduled") "")
        org-agenda-cmp-user-defined #'my/org-agenda-cmp-quick
        org-agenda-sorting-strategy
        '((agenda habit-down todo-state-down time-up urgency-down category-keep)
          (todo   urgency-down user-defined-up category-keep)
          (tags   urgency-down category-keep)
          (search category-keep))
        org-agenda-custom-commands
        '(("d" "Day view and TODO/WAIT"
           ((agenda ""
                    ((org-agenda-span 1)
                     (org-agenda-overriding-header "")))
            ;; (tags-todo "quick/TODO")
            (todo "TODO"
                  ((org-agenda-overriding-header "")
                   (org-agenda-dim-blocked-tasks 'invisible)))
            (todo "WAIT"
                  ((org-agenda-overriding-header "")))))
          ("p" "Project list"
           ((todo "PROJ")))
          ("w" "Waiting list"
           ((todo "WAIT"))))))

(defun my/org-format-cpt-letter ()
  (interactive)
  (let* ((names (seq-filter
                 (lambda (x) (not (seq-contains-p ":0123456789" (aref x 0))))
                 (split-string (substring-no-properties (org-get-heading)))))
         (name-first (car names))
         (name (string-join names " "))
         (email (or (org-entry-get (point) "EMAIL")
                    (error "Missing EMAIL")))
         (id (or (org-entry-get (point) "LIU_ID")
                 (error "Missing LIU_ID")))
         (program (or (org-entry-get (point) "PROGRAM")
                      (error "Missing PROGRAM")))
         (pronoun (org-entry-get (point) "PRONOUNS"))
         (pronoun-possess (pcase pronoun
                            ("he" "his")
                            ("she" "her")
                            (_ (error "Unhandled pronoun"))))
         (pronoun-object (pcase pronoun
                           ("he" "him")
                           ("she" "her")
                           (_ (error "Unhandled pronoun")))))
    (insert (format
             "
** CPT approval [%s]
To: Steve Chin <Steve.Chin@liu.edu>
Cc: %s <%s>
Subject: CPT approval | %s %s

Dear Steve,

Our %s student %s (%s) is seeking approval for CPT. I am attaching %s offer letter for an internship that commences <DATE>.

%s is making good progress toward completion of %s degree, and I approve the request.

Thank you,"
             (format-time-string "%F")
             name email
             name id
             program
             name id
             pronoun-object
             name-first
             pronoun-possess))))

(defun my/org-format-opt-letter ()
  (interactive)
  (let* ((names (seq-filter
                 (lambda (x) (not (seq-contains-p ":0123456789" (aref x 0))))
                 (split-string (substring-no-properties (org-get-heading)))))
         (name-first (car names))
         (name (string-join names " "))
         (email (or (org-entry-get (point) "EMAIL")
                    (error "Missing EMAIL")))
         (id (or (org-entry-get (point) "LIU_ID")
                 (error "Missing LIU_ID")))
         (program (or (org-entry-get (point) "PROGRAM")
                      (error "Missing PROGRAM")))
         (pronoun (org-entry-get (point) "PRONOUNS"))
         (pronoun-object (pcase pronoun
                           ("he" "him")
                           ("she" "her")
                           (_ (error "Unhandled pronoun")))))
    (insert (format
             "
** OPT approval [%s]
To: Steve Chin <Steve.Chin@liu.edu>
Cc: %s <%s>
Subject: OPT approval | %s %s

Dear Steve,

I have reviewed the transcript of %s (%s), and I am pleased to report that %s is expected to complete the requirements for the %s degree at the end of the current semester. I recommend %s for OPT.

Congratulations, %s!

Thanks,"
             (format-time-string "%F")
             name email
             name id
             name id
             pronoun
             program
             pronoun-object
             name-first))))

(my/package electric
  :init
  (add-hook 'org-mode-hook #'electric-quote-local-mode))

(my/package org-pretty-tags
  :init
  (add-hook 'org-mode-hook #'org-pretty-tags-global-mode)
  :config
  (setq org-pretty-tags-surrogate-strings
        '(("project" . "¶"))))

(defun my/org-dailies-insert-previous ()
  "Insert a direct link to the previous page in org-roam dailies."
  (interactive)
  (let ((r (save-window-excursion
             (org-roam-dailies-goto-previous-note)
             (goto-char (point-min))
             (cons (org-id-get) (org-get-title)))))
    (insert (format "[[id:%s][← %s]]"
                    (car r) (cdr r)))))

(my/package org-roam
  :autoload org-roam-ref-remove
  :init
  (my/bind my/roam-keymap
    "," #'org-roam-dailies-capture-date
    "." #'org-roam-dailies-capture-today
    "/" #'org-roam-buffer-display-dedicated
    ";" #'org-roam-dailies-capture-tomorrow
    "[" #'my/org-dailies-insert-previous
    "c" #'org-roam-capture
    "d" #'org-roam-dailies-goto-date
    "f" #'org-roam-node-find
    "i" #'org-roam-node-insert
    "t" #'org-roam-dailies-goto-today
    "w" #'org-roam-ui-open)
  :config
  (my/bind my/roam-keymap
    "b" #'org-roam-buffer-toggle
    "`" #'org-roam-ref-add
    "~" #'org-roam-ref-remove)
  (add-hook 'org-roam-mode-hook #'olivetti-mode)
  (add-hook 'org-mode-hook #'org-roam-db-autosync-mode)
  (add-to-list 'display-buffer-alist
               '("\\*org-roam\\*"
                 (display-buffer-in-direction)
                 (direction . right)
                 (window-width . 0.33)
                 (window-height . fit-window-to-buffer)))
  (setq org-roam-directory "~/u/notes"
        org-roam-completion-everywhere t
        org-roam-node-display-template "${title} ${tags}"))

(my/package consult-denote
  :init
  (with-eval-after-load 'denote
    (consult-denote-mode)))

(my/package denote
  :init
  (add-hook 'dired-mode-hook #'denote-dired-mode)
  :config
  (setopt denote-directory "~/u/denotes"
          denote-date-prompt-use-org-read-date t)
  (denote-rename-buffer-mode 1))

;;;; Documentation

(my/package info                ; GNU documentation system
  ;; ‹M-n› is overridden in ‘Info-mode-map’ to be ‘clone-buffer’.  That can be
  ;; useful in info, but let it fall back to motion state's ‘scroll-up-line’.
  ;; I was accustomed to ‹SPC› and ‹S-SPC› scrolling up and down in info, we can
  ;; use ‹PgUp› and ‹PgDn› for that.
  (my/bind Info-mode-map
    [prior] #'Info-scroll-down
    [next] #'Info-scroll-up))

;;;; Applications

(my/package browse-url
  :init
  (setq browse-url-browser-function #'browse-url-firefox))

(my/package ledger-mode         ; Support for “ledger” accounting tool
  (my/bind ledger-reconcile-mode-map "." #'ledger-reconcile-toggle)
  (setq ledger-highlight-xact-under-point nil)
  (with-eval-after-load 'meow
    (add-to-list 'meow-mode-state-list '(ledger-reconcile-mode . motion))))

(my/package calc
  (my/bind calc-mode-map "C-o" #'casual-calc-tmenu))

(my/package calc-ext
  (my/bind calc-alg-map "C-o" #'casual-calc-tmenu))

(when-let* ((msmtpq (executable-find "msmtpq")))
  (setq send-mail-function 'sendmail-send-it
        sendmail-program msmtpq
        mail-specify-envelope-from t
        mail-envelope-from 'header))

(defvar my/notmuch-delete-tags '("+deleted" "-unread")
  "List of tag changes to apply to a message or thread when it is deleted.")

(make-variable-buffer-local 'shr-width)

(my/package shr
  :config
  (setq shr-max-width 90))

(add-hook 'notmuch-show-mode-hook #'my/notmuch-show-adjust-width)
(defun my/notmuch-show-adjust-width (&rest _)
  "Adjust ‘shr-width’ based on window size."
  (setq shr-width
        (min shr-max-width (floor (* 0.8 (window-max-chars-per-line)))))
  (message "shr-width set to %s" shr-width))

(defvar notmuch-saved-searches)

(defun my/notmuch-jump ()
  "Invoke a notmuch query using last input event and ‘notmuch-saved-searches’."
  (interactive)
  (let ((k (char-to-string (logand last-input-event #x7ffffff))))
    (dolist (saved-search notmuch-saved-searches)
      (when (equal k (plist-get saved-search :key))
        (notmuch-search (plist-get saved-search :query))))))

(defun my/notmuch-show-open-in-icedove ()
  "Open current message in Icedove (Thunderbird)."
  (interactive)
  (start-process "icedove-mid" nil "icedove"
                 (concat "m" (notmuch-show-get-message-id))))

(my/package notmuch-show
  :autoload notmuch-show-get-message-id)

(my/package notmuch
  :init
  ;; ‹SPC x m {KEY}› triggers ‹C-x M-{KEY}›, which is almost empty.  It blocks
  ;;   ‘compose-mail’, so put that on ‹SPC x m c›
  (setopt notmuch-saved-searches
          '((:name "LIU Inbox"
                   :query "tag:inbox and not tag:bulk and folder:/msliu/"
                   :key "i")
            (:name "Zoho Inbox"
                   :query "tag:inbox and not tag:bulk and folder:/cnz/"
                   :key "z")
            (:name "Bulk"
                   :query "tag:inbox and tag:bulk"
                   :key "b")
            (:name "Drafts"
                   :query "tag:draft"
                   :key "d")))
  (dolist (saved-search notmuch-saved-searches)
    (let ((k (plist-get saved-search :key)))
      (when k
        (my/bind ctl-x-map (concat "M-" k)
          (cons (concat "notmuch " (plist-get saved-search :name))
                #'my/notmuch-jump)))))
  (my/bind ctl-x-map
    "M-c" #'notmuch-mua-new-mail
    "M-m" #'notmuch
    "M-s" #'notmuch-search)
  (define-mail-user-agent 'my/notmuch-user-agent
    #'notmuch-mua-mail
    #'notmuch-mua-send-and-exit
    #'notmuch-mua-kill-buffer
    'notmuch-mua-send-hook)
  (setq mail-user-agent 'my/notmuch-user-agent)
  :autoload
  notmuch-mua-kill-buffer
  notmuch-mua-mail
  notmuch-mua-new-mail
  notmuch-mua-send-and-exit
  :config
  (require 'shr)
  (advice-add #'notmuch-show-refresh-view
              :before #'my/notmuch-show-adjust-width)
  (with-eval-after-load 'meow
    (add-to-list 'meow-mode-state-list '(notmuch-search-mode . motion))
    (add-to-list 'meow-mode-state-list '(notmuch-show-mode . motion)))
  (my/bind notmuch-hello-mode-map "!" #'my/notmuch-inbox-roulette)
  (my/bind notmuch-search-mode-map "d" #'my/notmuch-search-delete-thread)
  (my/bind notmuch-show-mode-map
    "d" #'my/notmuch-show-delete-message-then-next-or-next-thread
    "D" #'my/notmuch-show-delete-thread-then-next
    "&" #'my/notmuch-show-open-in-icedove)
  (setq-default notmuch-search-oldest-first nil
                notmuch-search-sort-order 'newest-first)
  (setq mm-discouraged-alternatives '("text/plain")
        notmuch-multipart/alternative-discouraged '("text/plain" "multipart/related")
        notmuch-always-prompt-for-sender t
        notmuch-fcc-dirs nil
        notmuch-hello-thousands-separator ","
        notmuch-archive-tags '("-inbox" "-unread")
        notmuch-draft-tags '("+draft" "-inbox")
        notmuch-mua-cite-function #'message-cite-original-without-signature
        notmuch-tagging-keys
        `((,(kbd "a") notmuch-archive-tags "Archive")
          (,(kbd "u") notmuch-show-mark-read-tags "Mark read")
          (,(kbd "f") ("+flagged") "Flag")
          (,(kbd "s") ("+spam" "-inbox" "-unread") "Mark as spam")
          (,(kbd "d") my/notmuch-delete-tags "Delete"))))

(defun my/notmuch-search-delete-thread (&optional undelete beg end)
  "Delete the currently selected thread or region.

With prefix arg, UNDELETE. The region is provided by BEG and END."
  (interactive (cons current-prefix-arg (notmuch-interactive-region)))
  (notmuch-search-tag
   (notmuch-tag-change-list my/notmuch-delete-tags undelete) beg end)
  (when (eq beg end)
    (notmuch-search-next-thread)))

(defun my/notmuch-show-delete-message-then-next-or-next-thread
    (&optional undelete)
  "Delete current message then show next open one, possibly in the next thread.

With prefix arg, UNDELETE and don't show next."
  (interactive "P")
  (apply #'notmuch-show-tag-message
         (notmuch-tag-change-list my/notmuch-delete-tags undelete))
  (unless (or undelete (notmuch-show-next-open-message))
    (notmuch-show-next-thread t)))

(defun my/notmuch-show-delete-thread-then-next (&optional undelete)
  "Delete all messages in the current buffer, then show next thread from search.

With prefix arg, UNDELETE and don't show next."
  (interactive "P")
  (notmuch-show-tag-all
   (notmuch-tag-change-list my/notmuch-delete-tags undelete))
  (unless undelete
    (notmuch-show-next-thread t)))

(defun my/notmuch-inbox-roulette ()
  "Choose one random message from work inbox."
  (interactive)
  (notmuch-search
   (concat
    "tag:inbox and "
    (string-chop-newline
     (shell-command-to-string
      (concat "notmuch search --output=threads tag:inbox and not tag:bulk "
              "and folder:/msliu/ | shuf -n1"))))))

(defun my/message-is-liu ()
  "Within a message composition buffer, determine whether sender is LIU."
  (save-excursion
    (message-goto-from)
    (looking-back "@liu\\.edu>" nil)))

(add-hook 'message-setup-hook #'my/message-set-draft-folder)
(defun my/message-set-draft-folder ()
  "Set ‘notmuch-draft-folder’ based on sender identity."
  (setq notmuch-draft-folder
        (if (my/message-is-liu)
            "msliu/Drafts"
          "cnz/Drafts")))

(my/package message
  :config
  ;; TODO: is it a shame that this doesn't use mode-specific map? Can maps have
  ;; bindings conditional on modes (or other predicate), and if so, how do they
  ;; show up in which-key? Ideally ‹C-c '› or ‹SPC '› will be ‘org-edit-special’
  ;; in ‘org-mode’, and this binding in ‘message-mode’.
  (my/bind message-mode-map
    "C-c '" #'org-mime-edit-mail-in-org-mode
    "C-c RET h" #'org-mime-htmlize)
  (setq mail-host-address (concat (system-name) ".contrapunctus.net")
        message-citation-line-format "On %a %e %b, *%N* wrote:\n"
        message-citation-line-function #'message-insert-formatted-citation-line
        message-yank-prefix ""
        message-yank-cited-prefix ""
        message-yank-empty-prefix ""
        message-indent-citation-function
        (list #'message-indent-citation
              #'my/org-mime-citation-hook))
  (add-hook 'message-send-hook #'org-mime-confirm-when-no-multipart))

(defun my/org-mime-citation-hook ()
  "Wrap the cited message in an Org quote block."
  (insert "\n\n")
  (org-insert-structure-template "quote"))

(add-hook 'org-mime-src-mode-hook #'my/org-writing-setup)
(defun my/org-writing-setup ()
  "Configure org with preferred settings for writing."
  (interactive)
  (olivetti-mode 1)
  (org-indent-mode 1)
  (flyspell-mode 1)
  (setq org-hide-emphasis-markers t
        fill-column 9999))

(add-hook 'org-mime-plain-text-hook #'my/untabify-buffer)
(add-hook 'org-mime-html-hook #'my/untabify-buffer)

(add-hook 'org-mime-html-hook #'my/org-mime-augment-html-style)
(defun my/org-mime-augment-html-style ()
  "Fix up some HTML styles in email, especially the signature."
  (save-excursion
    (org-mime-change-class-style "org-right" "text-align: right"))
  (save-excursion
    (org-mime-change-element-style
     "blockquote" "border-left: 2px solid #ccc; padding-left: 1ex"))
  (org-mime-change-class-style "signature" "color: #666")
  (if (re-search-forward "<i>\\(Chris League</i>\\)" nil t)
      (replace-match
       "<i style=\"font-family: serif; color: #363; font-size: 115%\">\\1"))
  (while (re-search-forward "<a href=" nil t)
    (replace-match "<a style=\"text-decoration: none; color: #27a\" href=")))

(my/package org-mime
  :autoload
  org-mime-edit-mail-in-org-mode
  org-mime-confirm-when-no-multipart
  org-mime-change-class-style
  org-mime-change-element-style
  :config
  (setq org-mime-mail-signature-separator "^--signature follows--$"
        org-mime-export-ascii 'utf-8
        org-mime-export-options
        '(:with-latex imagemagick
                      :section-numbers nil
                      :with-special-strings nil ; Don't convert --, ---, ...
                      :with-title nil
                      :with-author nil
                      :with-toc nil)))

;;;; Encode/decode commands

(my/package qp                  ; Quoted-printable encoding for email
  :autoload quoted-printable-encode-region)

(defun my/base64-encode-region (beg end)
  "Encode the region between BEG and END using base64.
Unlike ‘base64-encode-region’, this command allows for multibyte
text.  It first encodes the text to bytes using
‘buffer-file-coding-system’."
  (interactive "r")
  (encode-coding-region beg end buffer-file-coding-system)
  (base64-encode-region (region-beginning) (region-end)))

(defun my/quoted-printable-encode-region (beg end)
  "Encode the region between BEG and END using quoted-printable.
Unlike ‘quoted-printable-encode-region’, this command allows for
multibyte text.  It first encodes the text to bytes using
‘buffer-file-coding-system’."
  (interactive "r")
  (encode-coding-region beg end buffer-file-coding-system)
  (quoted-printable-encode-region (region-beginning) (region-end)))

(defun my/base64-decode-region (beg end)
  "Decode the region between BEG and END using base64.
Unlike ‘base64-decode-region’, it then converts the raw bytes
back to text, assuming ‘buffer-file-coding-system’."
  (interactive "r")
  (base64-decode-region beg end)
  (decode-coding-region
   (region-beginning) (region-end) buffer-file-coding-system))

(defun my/quoted-printable-decode-region (beg end)
  "Decode the region between BEG and END using quoted-printable.
Unlike ‘quoted-printable-decode-region’, it then converts the raw
bytes back to text, assuming ‘buffer-file-coding-system’."
  (interactive "r")
  (quoted-printable-decode-region beg end)
  (decode-coding-region
   (region-beginning) (region-end) buffer-file-coding-system))


;;;; More commands for working with pairs

(defun my/is-surround-p (open close)
  "Test whether OPEN and CLOSE are a matching set of surround characters."
  (catch 'result
    (dolist (pair-spec insert-pair-alist)
      (pcase pair-spec
        ((and `(,fst ,snd)
              (guard (= fst open))
              (guard (= snd close)))
         (throw 'result pair-spec))
        ((and `(,_ ,fst ,snd)
              (guard (= fst open))
              (guard (= snd close)))
         (throw 'result (cdr pair-spec)))))))

(defun my/delete-surround ()
  "Delete a surround-pair around region.
If instead, region includes the surround-pair, that works as a
fallback.  There currently is no fallback if there's no selected
region (but there could be)."
  (interactive)
  (meow--with-selection-fallback
   (let ((start (1- (region-beginning)))
         (end (region-end))
         deactivate-mark)
     ;; Do we have matching surround characters just outside the region?
     (unless (my/is-surround-p (char-after start) (char-after end))
       ;; If not, maybe it's inside the region?
       (setq start (1+ start)
             end (1- end))
       (unless (my/is-surround-p (char-after start) (char-after end))
         (error "Cannot find a surround pair to delete")))
     ;; Delete end first, so it doesn't change position of start
     (save-mark-and-excursion
       (goto-char end) (delete-char 1)
       (goto-char start) (delete-char 1))
     (activate-mark))))

;;;; MacOS modifiers

;; Need ‘defvar’ to avoid byte-compile warnings on Linux, but setting values
;; within the here does not take effect on Darwin.
(defvar mac-command-modifier)
(defvar mac-option-modifier)
(defvar mac-right-option-modifier)
(when (eq window-system 'ns)
  ;; So then need ‘setq’ to change settings on Darwin.
  (setq mac-command-modifier 'meta)
  (setq mac-option-modifier 'super)
  (setq mac-right-option-modifier 'control))

;;;; Keybinding and modal setup functions

(add-hook 'emacs-startup-hook #'my/keymap-tweaks)
(defun my/keymap-tweaks ()
  "Apply some tweaks and remapping with existing keymaps."
  ;;╭─────┬─────┬─────┬─────┬─────┬─────╮  ╭─────┬─────┬─────┬─────┬─────┬─────╮
  ;;│ + = │ ! 1 │ @ 2 │ # 3 │ $ 4 │ % 5 │  │ ^ 6 │ & 7 │ * 8 │ ( 9 │ ) 0 │ | \ │
  ;;│scale│     │popgm│srved│seldi│     │  │ win+│     │ calc│ kmac│ kmac│     │
  ;;│ cpos│mxwin│splt↓│splt→│ +win│+fram│  │+2col│     │+char│     │scale│trinp│
  ;;├─────┼─────┼─────┼─────┼─────┼─────┤  ├─────┼─────┼─────┼─────┼─────┼─────┤
  ;;│ TAB │ " ' │ < , │ > . │   P │   Y │  │   F │   G │   C │   R │   L │ ? / │
  ;;│     │     │ ←scr│ scr→│     │     │  │     │     │     │ ffro│     │     │
  ;;│     │abrv+│     │filpr│+proj│     │  │ffile│+C-M-│ exit│+rect│     │     │
  ;;├─────┼─────┼─────┼─────┼─────┼─────┤  ├─────┼─────┼─────┼─────┼─────┼─────┤
  ;;│ ~ ` │   A │   O │   E │   U │   I │  │   D │   H │   T │   N │   S │ _ - │
  ;;│     │     │     │     │     │ifile│  │lsdir│     │     │goalc│     │     │
  ;;│ →err│+abrv│delbl│←eval│undtr│ndent│  │dired│     │trlin│+naro│ save│scale│
  ;;├─────┼─────┼─────┼─────┼─────┼─────┤  ├─────┼─────┼─────┼─────┼─────┼─────┤
  ;;│SHIFT│ : ; │   Q │   J │   K │   X │  │   B │   M │   W │   V │   Z │SHIFT│
  ;;│     │     │     │     │ kbuf│     │  │     │     │     │ffalt│     │     │
  ;;│     │cmtln│  rom│ jdir│+kmac│     │  │lsbuf│  +M-│writf│  +vc│rpeat│     │
  ;;╰─────┼─────┼─────┼─────┼─────┼─────╯  ╰─────┼─────┼─────┼─────┼─────┼─────╯
  ;;      │ { [ │ WIN │LEFT │RIGHT│              │  UP │DOWN │ WIN │ } ] │
  ;;      │hwin-├─────┴─────┴─────╯ ╍╍╍╍╍╍╍╍╍╍╍╍ ╰─────┴─────┴─────┤hwin+│
  ;;      │ ?+M-│                  ‹SPC x› layout                  │→page│
  ;;      ╰─────╯                ╍╍╍╍╍╍╍╍╍╍╍╍╍╍╍╍╍╍                ╰─────╯

  ;; ‹SPC x 1› ‘delete-other-windows’ (mxwin), also on ‹SPC v›
  ;; ‹SPC x 2› ‘split-window-below’ (splt↓)
  ;; ‹SPC x 3› ‘split-window-right’ (splt→)
  ;; ‹SPC x 4› other-window commands (+win)
  ;; ‹SPC x 5› other-frame commands (+fram)
  ;; ‹SPC x 6› two-column commands (+2col)
  ;; ‹SPC x 7› unused
  ;; ‹SPC x 8› unicode & emoji character menus (+char)
  ;; ‹SPC x 9› unused
  ;; ‹SPC x 0› ‘text-scale-adjust’ (scale)

  ;; ‹SPC x !› unused
  ;; ‹SPC x @› ‘pop-global-mark’ (popgm)
  ;; ‹SPC x #› ‘server-edit’ (srved), TODO: ‘server-edit-abort’?
  ;; ‹SPC x $› ‘set-selective-display’ (seldi), a type of folding
  ;; ‹SPC x %› unused
  ;; ‹SPC x ^› ‘enlarge-window’ (win+), TODO: ‘shrink-window’?
  ;; ‹SPC x &› unused
  ;; ‹SPC x *› ‘calc-dispatch’ (calc)
  ;; ‹SPC x (› ‘meow-start-kmacro’ (kmac), same as ‹SPC x k s›
  ;; ‹SPC x )› ‘meow-end-kmacro’

  ;; ‹SPC x +› ‘text-scale-adjust’ (scale)
  ;; ‹SPC x =› scale vs ‘what-cursor-position’ (cpos) — I don't use single-
  ;;   buffer scale much, so force that to use ‹+›
  (my/unbind ctl-x-map "C-=")

  ;; ‹SPC x \› ‘activate-transient-input-method’ (trinp)
  ;; ‹SPC x |› unused
  ;; ‹SPC x "› unused
  ;; ‹SPC x '› ‘expand-abbrev’ (abrv+)
  ;; ‹SPC x <› ‘scroll-left’ (←scr), also ‹C-next› but disabled
  ;; ‹SPC x >› ‘scroll-right’ (scr→), also ‹C-prior›
  ;; ‹SPC x ,› unused
  ;; ‹SPC x .› ‘set-fill-prefix’ (filpr)
  ;; ‹SPC x ?› unused
  ;; ‹SPC x /› unused

  ;; ‹SPC x a› ‘abbrev-map’ (+abrv), which isn't very crowded!
  ;; ‹SPC x b› ‘list-buffers’ (lsbuf), hides ‹C-x b› which we put on ‹SPC b›
  ;; ‹SPC x c› (exit)
  ;; ‹SPC x d› ‘list-directory’ (lsdir), less useful than ‘dired’ —redirect
  (my/bind ctl-x-map "C-d" nil "D" #'list-directory)

  ;; ‹SPC x e› ‘eval-last-sexp’ (←eval) vs end/execute keyboard macro TODO
  ;; ‹SPC x f› ‘find-file’ (ffile) vs ‘set-fill-column’ —okay
  ;; ‹SPC x g {KEY}› triggers ‹C-x C-M-{KEY}› which isn't crowded.
  ;; ‹SPC x h› unused, was ‘mark-whole-buffer’, easier to achieve with ‹.b›
  (my/unbind ctl-x-map "h")

  ;; ‹SPC x i› ‘indent-rigidly’ (ndent) sometimes useful, but maybe
  ;;   ‘insert-file’ (ifile) needs a better home (TODO), maybe with embark
  (my/bind ctl-x-map "I" #'insert-file)

  ;; ‹SPC x j› ‘dired-jump’ (jdir)
  ;; ‹SPC x k› kmacro commands (+kmac) vs ‘kill-buffer’ (kbuf) which can maybe
  ;;   be done using embark TODO
  (my/bind ctl-x-map "K" #'kill-buffer)

  ;; ‹SPC x l› unused: was ‘downcase-region’, but use dwim on ‹M-l›; otherwise
  ;;   ‘count-lines-page’, not very useful either.  Better to apply a generic
  ;;   ‘count-lines’ to a selection.
  (my/unbind ctl-x-map "C-l" "l")

  ;; ‹SPC x n› ‘set-goal-column’ (goalc) but ‘narrow-map’ (+naro) more useful
  (my/bind ctl-x-map "C-n" nil "N" #'set-goal-column)

  ;; ‹SPC x o› ‘delete-blank-lines’ (delbl), hides ‹C-x o›: we put on ‹SPC o›
  ;; ‹SPC x p› project commands (+proj), was ‘mark-page’ which maybe could be a
  ;;   meow thing? TODO
  (my/unbind ctl-x-map "C-p")

  ;; ‹SPC x q› ‘read-only-mode’ (rom), ‘kbd-macro-query’ also on ‹SPC x k q›
  ;; ‹SPC x r› rectangle/register map (+rect), was ‘find-file-read-only’ (ffro)
  ;;   which is less important, so remap.
  (my/bind ctl-x-map "C-r" nil "R" #'find-file-read-only)

  ;; ‹SPC x s› ‘save-buffer’ (save) vs ‘save-some-buffers’ —okay I think but
  ;;   let's also save using ‹SPC s›.  The other one is okay as ‹SPC x SPC s›
  ;; ‹SPC x t› ‘transpose-lines’ (trlin) hides ‘tab-prefix-map’ —okay
  ;; ‹SPC x u› ‘undo-tree-visualize’ (undtr), was ‘upcase-region’ but that's
  ;;   dwim on ‹M-u›
  (my/unbind ctl-x-map "C-u")

  ;; ‹SPC x v› ‘vc-prefix-map’ (+vc), was ‘find-alternate-file’ (ffalt)
  (my/bind ctl-x-map "C-v" nil "V" #'find-alternate-file)

  ;; ‹SPC x w› ‘write-file’ (writf), hides ‘window-prefix-map’, which are
  ;;   relatively unused windowing commands that could be elsewhere
  ;; ‹SPC x x› ‘exchange-point-and-mark’ (expm), hides ‘ctl-x-x-map’ which I
  ;;   sometimes use, but could be elsewhere (maybe buffer embark actions)
  ;; ‹SPC x y› unused
  ;; ‹SPC x z› ‘suspend-frame’ (zfram) —don't like, hides ‘repeat’ (rpeat) which
  ;;   I don't *yet* find useful.
  (my/unbind ctl-x-map "C-z")
  (my/bind
    "M-(" #'my/pair-keymap      ; Replaces ‘insert-parentheses’
    [remap downcase-word] #'downcase-dwim      ; M-l
    [remap upcase-word] #'upcase-dwim          ; M-u
    [remap capitalize-word] #'capitalize-dwim)) ; M-c

;;;; Afterword

(my/package server              ; Act as a server to support client frames
  :autoload server-running-p)

(add-hook 'after-init-hook #'my/start-server)
(defun my/start-server ()
  "Start the server, unless already running."
  (unless (or (daemonp) (server-running-p))
    (server-mode)))