;;; init.el --- Sean's Emacs init  -*- lexical-binding:t;no-byte-compile:t -*-

;; Except for parts marked as authored by others, this file is
;;
;; Copyright (C) 2010-2024  Sean Whitton <spwhitton@spwhitton.name>
;;
;; and is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this file.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; We use a prefix "spw/" for functions and variables defined in files
;; matching ~/.emacs.d/*.el, since the "spw-" and "spw--" prefixes would be
;; for a file called "spw.el" with a defined API, providing an `spw' feature.
;;
;; Aim for compatibility with the version of Emacs included in Debian stable.
;;
;; Bind only key sequences reserved for users or which are already bound to
;; commands I don't use often, where those bindings are well-established and
;; thus (i) not likely to be rebound by upstream to commands that I do use
;; often; and (ii) not likely to be bound by third party packages.
;; For example, we resettle `kill-region' to C-x C-d.  C-x g was tacitly
;; reserved by upstream to Magit, so that's available.  But not M-o or C-M-z.
;;
;; Rough convention to use C-c LETTER for global personal bindings and
;; sequences beginning C-z for mode-specific personal bindings.  One exception
;; is some prefix maps under C-z, like C-z 4 and C-z 5, which are meant to
;; mirror the corresponding prefix maps under C-x.  Use <F5> through <F9> for
;; mode-specific bindings or leave free for temporary keyboard macro bindings.

;;; Code:

;; libs in ~/.emacs.d/site-lisp can override system packages.
;; This is for my personal, possibly-patched versions of libraries.
(add-to-list 'load-path
	     (directory-file-name
	      (expand-file-name "site-lisp/" user-emacs-directory)))

;; libs in ~/.emacs.d/initlibs are overridden by system packages.
;; This is for fallback copies of libraries I don't want to be without.
(add-to-list 'load-path
	     (directory-file-name
	      (expand-file-name "initlibs/" user-emacs-directory))
	     t)

;; gdbmacs loads Gnus out of ~/src/emacs/primary/, if it's there & compiled.
(when (string= (daemonp) "gdbmacs")
  (let ((gnus-primary (expand-file-name "~/src/emacs/primary/lisp/gnus/")))
    (when (file-directory-p gnus-primary)
      (when-let* ((gnus-lib (locate-library "gnus"))
		  (gnus-lib-dir (file-name-directory gnus-lib))
		  (gnus-lib-cons
		   (or (member (directory-file-name gnus-lib-dir) load-path)
		       (member gnus-lib-dir load-path))))
	(cl-loop for f in (directory-files-recursively gnus-primary
						       emacs-lisp-file-regexp)
		 always (file-exists-p (byte-compile-dest-file f))
		 finally (rplaca gnus-lib-cons
				 (directory-file-name gnus-primary)))))))

(require 'cl-lib)
(require 'subr-x)
(require 'paredit)
(require 'ws-butler)
(require 'mode-local)
(require 'transient-cycles)

;;;; Customisation & appearance

;; The customisation system is additionally used to save safe local variable
;; values, SSL certificate overrides etc. (cf. `customize-push-and-save').
;; Most of these should not be committed to git: they're often host-specific,
;; usually only relevant for a short time, and sometimes private.
;; So we use a disposable, local custom file, and `custom-theme-set-faces',
;; `customize-set-variable' and `custom-theme-set-variables' in this file.
;; (Re `setopt' vs. `customize-set-variable': former is for when we're making
;; a dynamic change that is not just host-specific but session-specific.)
(load (setq custom-file (expand-file-name "custom" user-emacs-directory))
      'noerror 'nomessage 'nosuffix)

(custom-theme-set-faces
 'user
 '(default ((t (:weight medium :height 105 :foundry "SRC" :family "Hack"))))
 '(fixed-pitch ((t (:foundry "SRC" :family "Hack"))))
 '(variable-pitch ((t (:weight regular :height 120
		       :foundry "bitstream" :family "Bitstream Charter"))))
 ;; We want to handle the `variable-pitch'/`variable-pitch-text' distinction
 ;; using `spw/maybe-scale-basic-faces' instead.
 '(variable-pitch-text ((t (:inherit variable-pitch))))

 '(comint-highlight-prompt ((t (:inherit minibuffer-prompt :weight bold))))
 '(fill-column-indicator ((t (:background "light gray"))))

 ;; The colour is from the Lucid build of Emacs.
 '(region ((t (:extend t :background "#EECD82")))))

;; Set background colour but don't touch text terminals.
(dolist (ws '(x pgtk w32 ns))
  (add-to-list
   'window-system-default-frame-alist
   ;; If we were not started with --daemon or by 'emacsclient -a ""', then
   ;; we're probably a shortlived instance of Emacs just to test something.
   ;; Set a different background colour to more easily distinguish frames
   ;; belonging to shortlived instances from those belonging to main instance.
   `(,ws
     . ((background-color
	 . ,(pcase (daemonp)
	      ('nil "#F0FFF0") ("gdbmacs" "#F5F5DC") (_ "#FFFFF6")))))))

(defun spw/maybe-scale-basic-faces (frame)
  "Entry for `window-size-change-functions' to increase font sizes,
relative to those set by the call to `custom-theme-set-faces' above, for
frames on wide monitors, except where doing so would itself prevent fitting
two 80-column windows side-by-side in the frame."
  (when (display-graphic-p frame)
   (let ((wide-monitor-p (> (cadddr (assoc 'geometry
					   (frame-monitor-attributes frame)))
			    1635)))
     (when (or wide-monitor-p
	       ;; Check whether a previous call made any changes we might need
	       ;; to undo if FRAME has moved to a smaller display.
	       (not (eq scroll-bar-mode
			(frame-parameter frame 'vertical-scroll-bars)))
	       (= (face-attribute 'default :height frame) 120)
	       (= (face-attribute 'variable-pitch :height frame) 151))
       (let* (;; Above 1635 you can scale up and still fit two 80-col windows.
	      ;; Below 1315 you can't fit the two windows even w/o scaling up.
	      (medium-p (> 1635 (frame-pixel-width frame) 1315))
	      (scale-up-p (and wide-monitor-p (not medium-p))))
	 (modify-frame-parameters
	  frame
	  `(;; Can fit two 80-col windows only if we disable scroll bars.
	    (vertical-scroll-bars . ,(and (not (and wide-monitor-p medium-p))
					  scroll-bar-mode))))
	 ;; Check Emacs found the relevant font on this window system, else
	 ;; our height values might be invalid.
	 (when (find-font (font-spec :foundry "SRC" :family "Hack") frame)
	   (set-face-attribute 'default frame
			       :height (if scale-up-p 120 105)))
	 (when (find-font (font-spec :foundry "bitstream"
				     :family "Bitstream Charter")
			  frame)
	   (set-face-attribute 'variable-pitch frame
			       :height (if scale-up-p 151 120))))))))
(add-to-list 'window-size-change-functions #'spw/maybe-scale-basic-faces)

;;; `frame--current-background-mode' assumes that TERM=screen-256color means a
;;; dark background.  But if we're in tmux then I can always have a light
;;; background by typing C-\ W (see ~/.tmux.conf).

;; Handle 'emacs -nw' initial frames.
(when (and (framep terminal-frame)
	   (cl-find-if
	    (apply-partially #'string-prefix-p "TMUX=") initial-environment))
  (set-terminal-parameter terminal-frame 'background-mode 'light))

;; Handle 'emacsclient -tc' frames.
;; Require that TMUX is set in the frame's own environment parameter.
;; The hook is run with the new tty frame selected.
(defun spw/set-tmux-background-mode ()
  (when (and (frame-parameter nil 'environment)	; check it has one
	     (getenv "TMUX" (selected-frame)))
    (set-terminal-parameter nil 'background-mode 'light)))
(add-hook 'tty-setup-hook #'spw/set-tmux-background-mode)

(custom-theme-set-variables
 'user
 '(Man-notify-method 'aggressive)
 '(after-save-hook '(executable-make-buffer-file-executable-if-script-p))
 '(async-shell-command-buffer 'rename-buffer)
 '(auth-source-save-behavior nil)
 '(auto-save-file-name-transforms '((".*" "~/.emacs.d/auto-saves/" t)))
 '(backup-by-copying-when-linked t)
 '(backup-directory-alist '(("." . "~/.emacs.d/backups/")))
 '(c-default-style "linux")
 '(calc-kill-line-numbering nil)
 '(column-number-mode t)
 '(comint-prompt-read-only t)
 '(compilation-scroll-output 'first-error)
 '(compilation-skip-threshold 2)
 '(completion-styles '(flex))
 '(confirm-kill-emacs 'y-or-n-p)
 '(copy-region-blink-delay 0)
 '(copyright-names-regexp "Sean Whitton")
 '(copyright-year-ranges t)
 '(cursor-type 'box)

 ;; C-u M-\ to delete only before point, M-SPC M-SPC to delete only after.
 '(cycle-spacing-actions '(just-one-space (delete-space-after -)))

 '(dabbrev-case-fold-search t)
 '(display-fill-column-indicator-character 32)
 '(ediff-split-window-function 'split-window-horizontally)
 '(eldoc-minor-mode-string nil)
 '(emacs-lisp-docstring-fill-column 75)
 '(enable-recursive-minibuffers t)
 '(fill-column 78)
 '(font-lock-maximum-decoration
   '((lisp-mode . 1) (consfigurator-lisp-mode . 1) (t . t)))
 '(gc-cons-threshold 16777216)
 '(gdb-many-windows t)

 ;; This is helpful when gdb-many-windows is turned off.
 '(gdb-show-main t)

 '(global-so-long-mode t)
 '(help-window-keep-selected t)
 '(imenu-auto-rescan t)
 '(inferior-lisp-program "sbcl")
 '(initial-major-mode 'spw/scratch-lisp-interaction-mode)
 '(kill-read-only-ok t)

 ;; Bypass MTA rewriting user@localhost.
 '(mail-envelope-from 'header)
 '(mail-specify-envelope-from t)

 '(mail-user-agent 'gnus-user-agent)
 '(mailscripts-detach-head-from-existing-branch 'ask)
 '(mailscripts-extract-patches-branch-prefix "mail/")
 '(mailscripts-project-library 'project)

 ;; `cperl-mode' doesn't try to indent lines within a POD, and usefully font
 ;; locks scalars that are members of hashes and arrays.
 '(major-mode-remap-alist '((perl-mode . cperl-mode)))

 ;; Works only for self-insert chars and undone by changes in window manager
 ;; focus, but less annoying than `mouse-avoidance-mode'.
 '(make-pointer-invisible t)

 '(minibuffer-follows-selected-frame nil)
 '(mode-line-compact 'long)

 ;; X primary selection-like behaviour within Emacs even when not available
 ;; outside.
 '(mouse-drag-copy-region t)

 ;; See `make-pointer-invisible'.
 '(mouse-highlight 1)

 '(mouse-yank-at-point t)
 '(native-comp-async-jobs-number 1)
 '(native-comp-async-report-warnings-errors 'silent)
 '(proced-enable-color-flag t)
 '(proced-show-remote-processes t)
 '(project-switch-commands 'project-prefix-or-any-command)
 '(read-buffer-completion-ignore-case t)
 '(read-file-name-completion-ignore-case t)
 '(read-mail-command 'gnus)
 '(read-minibuffer-restore-windows nil)
 '(remember-data-file "~/local/tmp/scratch")
 '(remember-notes-buffer-name "*scratch*")
 '(remote-file-name-inhibit-delete-by-moving-to-trash t)
 '(require-final-newline t)

 ;; See <https://debbugs.gnu.org/53728>.
 '(save-interprogram-paste-before-kill nil)

 ;; If quitting Emacs is slow set `save-place-forget-unreadable-files' to nil.
 '(save-place-mode t)

 '(savehist-additional-variables '(compile-history log-edit-comment-ring))
 '(savehist-mode t)
 '(select-active-regions 'only)
 '(select-enable-primary t)
 '(send-mail-function 'sendmail-send-it)
 '(shell-command-prompt-show-cwd t)

 ;; Useful for C-M-d.
 '(show-paren-when-point-in-periphery t)

 '(shr-max-width 78)
 '(slime-load-failed-fasl 'never)
 '(tab-bar-history-mode t)
 '(tab-bar-show 1)
 '(text-mode-ispell-word-completion nil)

 ;; Put TRAMP auto-saves under local `user-emacs-directory'.
 '(tramp-auto-save-directory "~/.emacs.d/auto-saves/")
 ;; Put TRAMP backups under remote ~/.emacs.d/.
 '(tramp-backup-directory-alist '(("." . "~/.emacs.d/backups/")))

 '(tramp-copy-size-limit nil)
 '(tramp-default-method "rsync")

 ;; Rely on my ~/.ssh/config.
 '(tramp-use-connection-share nil)

 ;; Manual says this should improve performance.
 '(tramp-verbose 1)

 '(transient-cycles-buffer-siblings-mode t)
 '(transient-cycles-tab-bar-mode t)
 '(transient-cycles-window-buffers-cycle-backwards-key [134217777]) ; M-1
 '(transient-cycles-window-buffers-cycle-forwards-key [134217780])  ; M-4
 '(transient-cycles-window-buffers-mode t)
 '(uniquify-buffer-name-style 'forward nil (uniquify))
 '(use-short-answers t)

 ;; Rebind otherwise useless self-insert keys, and means existing C-x C-r,
 ;; C-x 4 r etc. usable for getting into the mode.
 '(view-read-only t)

 '(warning-suppress-types '((comp)))
 '(window-combination-resize t)
 '(x-stretch-cursor t))


;;;; Configuration helpers

(defmacro spw/when-library-available (libraries &rest forms)
  "Evaluate FORMS when optional LIBRARIES is/are on the `load-path'.

Libraries, not features, since we can't know whether features are
available on the `load-path' without actually loading libraries,
which we want to avoid at Emacs startup.

Use this only after `package-initialize' has been called,
i.e. not in `early-init-file', so that places LIBRARIES might be
available are present in the `load-path'."
  (declare (indent 1))
  `(when ,(if (listp libraries)
	      `(cl-every #'locate-library ',(mapcar #'symbol-name libraries))
	    `(locate-library ,(symbol-name libraries)))
     ,@forms))

(defmacro spw/reclaim-keys-from (feature map &rest keys)
  "Unbind each of KEYS in MAP after FEATURE is loaded."
  `(with-eval-after-load ',feature
     (when (boundp ',map)	       ; handle older Emacsen/package versions
       ,@(cl-loop for key in keys collect `(define-key ,map ,key nil)))))

(defmacro spw/feature-define-keys (features &rest bindings)
  (declare (indent 1))
  (macroexp-progn
   (cl-loop
    with defns
    = (cl-loop for (k b) on bindings by #'cddr
	       if (symbolp b) collect `(,k #',b) else collect (list k b))
    for feature in (if (listp features) features (list features))
    for name = (if (listp feature) (car feature) feature)
    for map = (if (listp feature)
		  (cadr feature)
		(let ((name (symbol-name name)))
		  (intern (format (if (string-suffix-p "-mode" name)
				      "%s-map" "%s-mode-map")
				  name))))
    for form = `(when (boundp ',map)	; for older Emacsen/package versions
		  ,@(cl-loop for df in defns collect `(define-key ,map ,@df)))
    if name collect `(with-eval-after-load ',name ,form) else collect form)))

(defmacro spw/feature-add-hook (function &rest features)
  (declare (indent 1))
  (macroexp-progn
   (cl-loop
    for feature in (if (listp features) features (list features))
    for name = (if (listp feature) (car feature) feature)
    for hook = (if (listp feature)
		   (cadr feature)
		 (let ((name (symbol-name name)))
		   (intern (format (if (string-suffix-p "-mode" name)
				       "%s-hook" "%s-mode-hook")
				   name))))
    for form = `(add-hook ',hook #',function)
    if name collect `(with-eval-after-load ',name ,form) else collect form)))

(defmacro spw/feature-add-to-list (list-var feature &rest elements)
  (declare (indent 2))
  `(with-eval-after-load ',feature
     ,@(cl-loop for el in elements collect `(add-to-list ',list-var ,el))))

(cl-defmacro spw/define-skeleton
    (command (mode &key abbrev key (file `',mode)
		   (map (intern (concat (symbol-name mode) "-map")))
		   (tbl (intern (concat (symbol-name mode) "-abbrev-table"))))
	     docstring interactor &rest rest-of-skeleton)
  "Wrapper for `define-skeleton' to make it easy to use the
skeleton with a prefix argument, to wrap several interregions or
an active region, but also easy to use with an abbrev, for when
there is nothing already typed that should be wrapped."
  (declare (indent 2))
  (let* ((inverted (gensym))
	 (key (and key map
		   `((define-key ,map ,key
				 ;; Invert the prefix argument as expect to
				 ;; use the binding to wrap interregions more
				 ;; often than to wrap words.
				 (lambda (&optional arg)
				   (interactive "*P")
				   (let ((,inverted (and arg (* -1 arg))))
				     (,command ,inverted ,inverted)))))))
	 (abbrev
	  (and abbrev tbl
	       ;; E.g. `minibuffer-mode-abbrev-table' unbound before Emacs 29.
	       `((when (boundp ',tbl)
		   (define-abbrev ,tbl ,abbrev "" #',command :system t))))))
    `(progn
       (define-skeleton ,command ,docstring ,interactor ,@rest-of-skeleton)
       ,@(and (or key abbrev)
	      (if file
		  `((with-eval-after-load ,file ,@key ,@abbrev))
		`(,@key ,@abbrev))))))

(defmacro spw/add-once-hook (hook function &optional depth local)
  "Add a hook which removes itself when called.
For something which should happen just once."
  (let ((fun (gensym)))
    `(letrec ((,fun (lambda (&rest args)
		      (remove-hook ,hook ,fun ,local)
		      (apply ,function args))))
       (add-hook ,hook ,fun ,depth ,local))))

(defconst spw/fqdn
  (cond ((string-prefix-p (format "%s." (system-name)) mail-host-address)
	 mail-host-address)
	((executable-find "perl")
	 (shell-command-to-string
	  "perl -mNet::Domain=hostfqdn -e'print hostfqdn'")))
  "The fully qualified domain name of the system running Emacs, if
that's something we can determine.")

(defun spw/on-host-p (host)
  ;; If HOST looks like an FQDN, require that `spw/fqdn' is non-nil and equal.
  (string= host (if (cl-find ?. host) spw/fqdn (system-name))))

(defun spw/on-host-primary-p (host)
  (and (eq (daemonp) t) (spw/on-host-p host)))

;; This is a combination of the two `transient-cycles-define-commands' forms
;; for `transient-cycles-buffer-siblings-mode'.  We could factor this out of
;; those and make it part of the library's API, but currently those two forms
;; also serve as nice usage examples for `transient-cycles-define-commands'.
(defmacro spw/transient-cycles-define-buffer-switch
    (commands &rest keyword-arguments)
  (declare (indent 0))
  (let ((window (gensym))
	(prev-buffers (gensym)))
    `(transient-cycles-define-commands (,window ,prev-buffers)
       ,(cl-loop for command in commands
		 for (original lambda . body)
		   = (if (proper-list-p command) command
		       `(,command (&rest args)
			  ,(interactive-form (cdr command))
			  (apply #',(cdr command) args)))
		 collect
		 `(,original ,lambda
		   ,@(and (listp (car body))
			  (eq (caar body) 'interactive) (list (pop body)))
		   (let ((ret-val ,(macroexp-progn body)))
		     (when (windowp ret-val) (setq ,window ret-val))
		     (setq ,prev-buffers (window-prev-buffers ,window))
		     ret-val)))
       (transient-cycles-buffer-ring-cycler
	:ring (cl-etypecase ret-val
		(buffer (transient-cycles-buffer-siblings-ring ret-val))
		(window (transient-cycles-buffer-siblings-ring
			 (window-buffer ret-val)))
		(ring ret-val))
	:action (if (windowp ret-val)
		    (with-selected-window ret-val
		      (let ((display-buffer-overriding-action
			     '((display-buffer-same-window)
			       (inhibit-same-window . nil))))
			(display-buffer buffer)))
		  (switch-to-buffer buffer t t)))
       :on-exit (if ,window
		    (progn (set-window-next-buffers ,window nil)
			   (set-window-prev-buffers ,window ,prev-buffers))
		  (switch-to-buffer (current-buffer) nil t)
		  (set-window-next-buffers nil nil)
		  (set-window-prev-buffers nil ,prev-buffers))
       . ,keyword-arguments)))

(defmacro spw/macroexp-for (lambda-list items &rest body)
  (declare (indent 2))
  (let ((macro (gensym)))
    `(cl-macrolet ((,macro ,lambda-list ,@body))
       ,@(cl-loop for item in items collect
		  (cons macro (if (listp item) item (list item)))))))


;;;; The *scratch* buffer

;; This uses `pop-to-buffer-same-window' and so obeys `display-buffer-alist'.
(global-set-key "\C-xl" #'scratch-buffer)

(defun spw/eval-print-last-sexp (orig-fun &rest args)
  (require 'pp)
  (let ((start (point-marker))
	(pp-use-max-width t)
	(pp-max-width fill-column)
	(eval-expression-print-level 20)
	(eval-expression-print-length 500))
    (skip-chars-backward "[:space:]\n")
    (delete-region (point) start)
    (apply orig-fun args)
    (save-excursion (goto-char start) (indent-pp-sexp t))
    (set-marker start nil)
    (terpri (current-buffer) t)))
(dolist (cmd '(eval-print-last-sexp
	       edebug-eval-print-last-sexp

	       ;; Not quite traditional Emacs C-j, but close enough.
	       xscheme-send-previous-expression))
  (advice-add cmd :around #'spw/eval-print-last-sexp))

;;; Persistent *scratch*, for the primary daemon only, to avoid conflicts.
;;; Unlike ~/doc/howm/refile.org and C-c c c, this does not require ~/doc/
;;; checked out.  And we get one per machine, which can be convenient.
;;;
;;; We used to have a separate *notes* without Paredit and in `text-mode'.
;;; But using one buffer for both Lisp evaluation and rough notes means that
;;; we can have a single i3/Sway binding for both purposes.
;;; If another major mode is really required, can just create a new buffer.
;;; This relies for its usability on `spw/scratch-lisp-interaction-mode'.

(defun spw/remember-notes-setup ()
  (when (zerop (buffer-size))
    ;; `after-init-hook' is early enough that `initial-scratch-message' would
    ;; be inserted for us by `command-line-1', but this is simpler given that
    ;; we have to advise `get-scratch-buffer-create' too.
    (insert (substitute-command-keys initial-scratch-message))
    (set-buffer-modified-p nil))
  (setq default-directory (expand-file-name "~/")))
(spw/feature-add-hook spw/remember-notes-setup
  (remember remember-notes-mode-hook))

(defun spw/hijack-scratch ()
  ;; Switch such that right after startup 'q' takes us to *scratch*, as usual.
  (switch-to-buffer (remember-notes)))

(unless (stringp (daemonp))
  (add-hook 'after-init-hook #'spw/hijack-scratch)
  (advice-add 'get-scratch-buffer-create :override #'remember-notes))

;;; Something like IELM's `ielm-change-working-buffer', the key feature which
;;; distinguishes IELM from both `lisp-interaction-mode' and Eshell.  Thanks
;;; to this, and Eshell, I don't ever need IELM.

(defun spw/lisp-interaction-wrap-with-buffer (buffer regionp)
  "Wrap the region or preceding form in `with-current-buffer'."
  (interactive
   (list (read-buffer
	  "Buffer to make current: "
	  (let ((candidate
		 (window-buffer
		  (spw/get-mru-window
		   (lambda (w) (minibufferp (window-buffer w)))))))
	    (cond ((and candidate (not (eq (current-buffer) candidate)))
		   candidate)
		  ((buffer-local-boundp
		    'spw/lisp-interaction-target-buffer
		    (current-buffer))
		   spw/lisp-interaction-target-buffer))))
	 (use-region-p)))
  (setq-local spw/lisp-interaction-target-buffer buffer)
  (save-excursion
    (unless regionp (forward-sexp -1))
    (insert-pair 1 ?\( ?\))
    (deactivate-mark)
    (insert (format "with-current-buffer \"%s\"" buffer))
    ;; Not a full `indent-sexp' as that might reduce readability if what we're
    ;; wrapping has just been yanked straight in from elsewhere.  But avoid
    ;; next sexp being directly under opening paren of `with-current-buffer'.
    (newline-and-indent))
  (when (or (not regionp) (> (point) (mark))) (up-list)))
(define-key lisp-interaction-mode-map
    "\C-z\C-b" #'spw/lisp-interaction-wrap-with-buffer)

(defun spw/lisp-interaction-wrap-with-buffer-and-eval (buffer)
  "Like `spw/lisp-interaction-wrap-with-buffer' followed by C-j."
  (interactive
   (list (or (and (not current-prefix-arg)
		  (buffer-local-boundp 'spw/lisp-interaction-target-buffer
				       (current-buffer))
		  spw/lisp-interaction-target-buffer)
	     (read-buffer "Buffer to make current: "))))
  (deactivate-mark)
  (spw/lisp-interaction-wrap-with-buffer buffer nil)
  (eval-print-last-sexp))
(define-key lisp-interaction-mode-map
    "\C-z\C-j" #'spw/lisp-interaction-wrap-with-buffer-and-eval)


;;;; System and files

;; On remote hosts in the UTC timezone, assume I'm in the UK.
;; This is relevant for using Org-mode, dired timestamps, etc..  Note that
;; hosts in the UK will be in GMT or BST, not UTC, so this won't affect those.
(when (and (string= "UTC" (cadr (current-time-zone)))
	   (memq system-type '(gnu gnu/linux gnu/kfreebsd)))
  (setenv "TZ" nil)
  (set-time-zone-rule "/usr/share/zoneinfo/Europe/London"))

;;; Opening files in external programs
;;;
;;; For years I used the classic `openwith-mode', but it often breaks other
;;; Emacs features, and I am not keen on the hack of signalling an error to
;;; avoid the execution of things like `after-find-file'.  I think that all I
;;; actually require is that C-x C-f and RET in dired are able to open files
;;; in external programs, with a prefix argument to suppress, plus a binding
;;; to reopen the current buffer in an external program.
;;;
;;; If in fact something more like `openwith-mode' is wanted, let's try
;;; implementing it as :around advice which prepends the handler to
;;; `inhibit-file-name-handlers' only for the duration of specific commands.
;;; We could cl-letf `after-find-file' to just kill the buffer, and also bind
;;; `large-file-warning-threshold' to a large value in the advice.

(defvar spw/external-programs
  (cl-flet ((for-exts (cmd &rest exts)
	      (cl-loop for ext in exts collect (cons ext cmd))))
    (pcase system-type
      ((or 'ms-dos 'windows-nt) nil)	; reserved for later
      (_ `(("pdf" . "evince %s")
	   ,@(for-exts "vlc %s"
		       "ogg" "mp3" "flac" "caf"
		       "mkv" "webm" "avi" "mp4" "wmv" "flv" "mov")
	   ,@(for-exts "soffice %s" "doc" "docx"
		       "odt" "ods" "xls" "xlsx" "ppt" "pptx" "potx")
	   ("hwp" . "hanword %s")
	   ,@(for-exts "eog %s" "jpg" "jpeg" "png" "gif")))))
  "Association list of file extensions to shell commands with which
to open them using `spw/try-external-open'")

(defun spw/try-external-open (filename &optional interactive)
  (interactive (list (or (buffer-file-name)
			 (user-error "This buffer is not visiting a file"))
		     t))
  (cl-flet ((die (msg)
	      ;; Just return nil if we were called from Lisp.
	      (and interactive (user-error msg))))
    (let ((unixp (not (memq system-type '(ms-dos windows-nt)))))
      (if (and unixp (not (or (getenv "DISPLAY") (getenv "WAYLAND_DISPLAY"))))
	  (die "No DISPLAY")
	(if (file-remote-p filename)
	    (die "Not a local file")
	  (if (file-directory-p filename)
	      (die "Is a directory")
	    (if-let ((ext (file-name-extension filename))
		     (program
		      (cdr
		       (assoc
			(downcase ext) spw/external-programs #'string=)))
		     (cmd (format program (shell-quote-argument
					   (expand-file-name filename)))))
		(always
		 (set-process-query-on-exit-flag
		  (start-process-shell-command
		   "spw/try-external-open-process" nil
		   ;; On Unix-like, set process up to outlive Emacs.
		   (if unixp (concat "exec nohup " cmd " >/dev/null") cmd))
		  (not unixp)))
	      (die "No external program association"))))))))
(global-set-key "\C-cgf" #'spw/try-external-open)

(defun spw/find-file (filename &optional arg)
  (interactive
   (list (read-file-name
	  "Find file: " nil default-directory 'confirm-after-completion)
	 current-prefix-arg))
  (or (and (not arg) (spw/try-external-open filename))
      (find-file filename t)))
(global-set-key [remap find-file] #'spw/find-file)

(defun spw/dired-find-file (&optional arg)
  (interactive "P")
  (or (and (not arg) (spw/try-external-open (dired-get-file-for-visit)))
      (dired-find-file)))
(with-eval-after-load 'dired
  (define-key dired-mode-map [remap dired-find-file] #'spw/dired-find-file))


;;;; General editing

(define-minor-mode spw/personal-bindings-mode
  "A simple way to overcome problems overriding major mode bindings.
To be used only when it seems to be necessary."
  :init-value t :lighter nil :keymap (make-sparse-keymap) :global t)

;; Regarding `set-mark-command-repeat-pop': if this is set to t, then
;; re-setting the mark right after popping to it -- to go and edit somewhere
;; near the destination and then come back, say -- requires remembering that a
;; C-u C-u prefix is needed; that cognitive load outweighs a few extra C-u
;; when this is nil, I think.  And the cost of forgetting is high: you've lost
;; the position, and it might take quite a few keypresses to get back there.
;;
;; Further, if you pop fewer than four times and then want to set a mark, that
;; requires no fewer keystrokes with this set to t than with it set to nil.
;; There is also `repeat' to repeatedly pop.
;;
;; If we had a dedicated key for setting a deactivated mark, distinct from the
;; key used to pop marks, then these remarks would not apply, and we could set
;; `set-mark-command-repeat-pop' to t.

;; Swap C-SPC and C-SPC C-SPC in Transient Mark mode.
(defun spw/set-mark-command (orig-fun arg)
  (if (and (eq last-command 'set-mark-command)
	   (not mark-active) (eql (point) (mark t)))
      ;; Binding `last-command' and popping the mark is not necessary given
      ;; the current implementation of `set-mark-command', but we don't want
      ;; to depend on that.
      ;; The idea is that when Transient Mark mode is on, invoking the command
      ;; twice is the canonical way to set a deactivated mark, but we want
      ;; invoking the command twice to mean setting a mark and activating it.
      (let ((last-command 'ignore))
	(pop-mark)
	(cl-letf (((symbol-function 'message) #'ignore))
	  (funcall orig-fun arg))
	(message "Mark activated"))
    (let ((inhibit (or mark-active
		       (and arg (not (> (prefix-numeric-value arg) 4))))))
      (funcall orig-fun arg)
      (unless inhibit
        (setq deactivate-mark 'dont-save)))))
(advice-add 'set-mark-command :around #'spw/set-mark-command)

;; Swap C-x C-x and C-u C-x C-x in Transient Mark mode.
(defun spw/exchange-point-and-mark (args)
  (list (if (and transient-mark-mode (not mark-active))
	    (not (car args))
	  (car args))))
(advice-add 'exchange-point-and-mark
	    :filter-args #'spw/exchange-point-and-mark)

(setq disabled-command-function nil)

(defun spw/no-blink-matching-paren (orig-fun &rest args)
  (let ((blink-matching-paren nil))
    (apply orig-fun args)))
(advice-add 'paredit-move-past-close-and-newline
	    :around #'spw/no-blink-matching-paren)

;; Make C-w and <M-backspace> the same as the defaults of the UNIX tty
;; line editor and GNU readline, respectively: C-w deletes back to
;; whitespace, <M-backspace> to the nearest word boundary.  I can't
;; have my full Emacs config on arbitrary hosts, but by configuring
;; Emacs in this way, I can have consistent line editing almost everywhere,
;; and moreover, kill back to whitespace is often what's wanted, for
;; correcting typos and just for deletion, e.g. of whole e-mail addresses,
;; whole long form command line arguments in Eshell, etc.
(defun spw/unix-word-rubout (arg &optional pos neg)
  (interactive "p")
  ;; Do skip over \n because `backward-kill-word' does.
  (unless pos (setq pos "[:space:]\n"))
  (unless neg (setq neg "^[:space:]\n"))
  (undo-boundary)
  (let ((start (point)))
    ;; Go only backwards.
    (dotimes (_ (abs arg))
      (skip-chars-backward pos)
      (skip-chars-backward neg))
    ;; Skip forward over any read-only text (e.g. an Eshell or comint prompt).
    (when-let ((beg (and (get-char-property (point) 'read-only)
			 (next-single-char-property-change
			  (point) 'read-only nil start))))
      (goto-char beg))
    (kill-region start (point))))
(global-set-key "\C-w" 'spw/unix-word-rubout)
(global-set-key "\M-\d" 'backward-kill-word)

;; Resettle the previous occupant of C-w.  This has to be a key which can also
;; be bound in .inputrc, so C-z is out as that is used for shell job control.
;; (Don't need `list-directory' as always use dired, so no resettlement.)
(global-set-key "\C-x\C-d" #'kill-region)

;; Previously, I used M-- in front of C-M-u and C-M-d in both Paredit and
;; non-Paredit buffers, and reclaimed C-M-p and C-M-n from Paredit.  However,
;; the global bindings of C-M-p and C-M-n have not proved themselves useful.
(global-set-key [?\C-\M-n] #'up-list)
(global-set-key [?\C-\M-p] "\C-u-\C-\M-d")

;; C-x C-z, and just M-x, remain for getting at upstream's C-z binding.
;; If upstream make changes such that C-z and C-x C-z are different, we could
;; bind C-z C-m to upstream's C-z.
(global-set-key "\C-z" (define-prefix-command 'spw/ctl-z-map))

;; This is used to drop marks used for killing, or pushed after yanking, in
;; order to access a mark which was set for navigational purposes.  There's an
;; in-built C-x C-x so that it is easy to see whether enough non-navigational
;; marks have been popped.
;;
;; C-z C-z is easy to type repeatedly, and to follow up with a final C-x C-x,
;; because the two modified letter keys are on the same side of the keyboard.
;; Could use C-x C-SPC or C-z C-x for this, moving existing bindings under
;; (other parts of) `spw/ctl-z-map'.
;; C-x SPC and C-z C-SPC aren't easy to type repeatedly.
(defun spw/pop-mark-and-exchange ()
  (interactive)
  (if (memq last-command '(exchange-point-and-mark spw/pop-mark-and-exchange))
      (pop-to-mark-command)
    (pop-mark))
  (message "Mark popped")
  (exchange-point-and-mark))
(define-key spw/ctl-z-map "\C-z" #'spw/pop-mark-and-exchange)

;; Bind a key simply to (re-)activate the mark which does not
;; involve moving point, as `exchange-point-and-mark' does.  This is
;; useful if you use isearch to select a region but realise only after
;; you've left the intended start of the region that you need to do a
;; second isearch to extend it far enough: e.g. C-s 1st C-z C-x C-s 2nd RET
;;
;; Activating the region prevents the second isearch from resetting
;; the mark.  Having this binding removes the need to activate the
;; region before entering the first isearch, which is useful both with
;; and without `transient-mark-mode'.
;;
;; This makes C-z C-x a sort of prefix command: "execute the next command in
;; temporary Transient Mark mode / as if Transient Mark mode were turned on".
;;
;; C-z C-SPC might be another good option for this.
(defun spw/activate-mark (&rest _ignore)
  (interactive)
  (activate-mark))
(define-key spw/ctl-z-map "\C-x" #'spw/activate-mark)

;; Is a binding for `zap-up-to-char' needed in addition to one for
;; `zap-to-char'?  If you don't need to insert any text before the target
;; char, then M-z CHAR CHAR is equivalent to using `zap-up-to-char' with CHAR,
;; and is easy to type.  If you do need to insert, you can just M-z CHAR, type
;; or yank, and then type CHAR again to conclude.  By contrast, replacing use
;; of `zap-to-char' with `zap-up-to-char' is not so easy, as you might need to
;; switch from typing M-z to typing C-d, for example.
;;
;; At the very least this demonstrates that `zap-to-char' more deserves to be
;; on an easy-to-strike key than does `zap-up-to-char'.  So for now, make the
;; other command available on a less valuable key.
;;
;; Hmm, might be good to add `paredit-zap-to-char' which doesn't actually
;; delete some delimiters.
(spw/macroexp-for (keymap key def)
    (((current-global-map) [remap zap-to-char] zap-to-char)
     (spw/personal-bindings-mode-map "\M-`" zap-up-to-char))
  (let ((new (intern (concat "spw/" (symbol-name def))))
	(args (gensym)))
    `(progn (defun ,new (&rest ,args)
	      ,(interactive-form def)
	      (let (case-fold-search)
		(apply #',def ,args)))
	    (define-key ,keymap ,key #',new))))

(defun spw/before-zap (_arg char &optional interactive)
  (when (and interactive (eql char (char-after)))
    (delete-forward-char 1)))
(advice-add 'zap-to-char :before #'spw/before-zap)
(advice-add 'zap-up-to-char :before #'spw/before-zap)

(global-set-key [remap dabbrev-expand] #'hippie-expand)

;; In an emacsclient(1) frame, or a buffer spawned by an Eshell process
;; calling emacsclient(1), this is like '<ESC>ZZ' in vi.
(global-set-key "\C-cz" "\C-x\C-s\C-x#")

;; always update buffers when files change on disk -- if we want to go back to
;; the version of the file we had in Emacs, we can just hit undo
(setq auto-revert-use-notify nil)
(global-auto-revert-mode 1)

;; C-x x g should not ask for confirmation.
(global-set-key "\C-xxg" (lambda ()
			   (interactive)
			   (revert-buffer (not current-prefix-arg) t)))

;; These don't work in text terminals, so unbind to avoid developing any
;; habits of using them.  Further, if the goal is to avoid having to release
;; modifier keys between typing numeric prefix arguments and commands, then in
;; most cases this will mean one-handed chording, which should be avoided.  If
;; the goal is instead to reduce the total number of keypresses, then it
;; should be sufficient to use only the M- bindings, releasing the meta key
;; after typing the first digit or minus sign.  But that's a minor benefit
;; over just starting with C-u.  Indeed, I rebind M-0..9 for other purposes.
;;
;; (M-- remains bound to `negative-argument' because it's particularly useful
;; for 'M-- M-l' and 'M-- M-u'.  So, C-u and M-- are the two keys I use to
;; supply non-negative and negative numeric prefix arguments, respectively.)
(cl-loop for i from ?0 to ?9
	 for key = (read (format "[?\\C-%c]" i))
	 do (global-unset-key key) (define-key esc-map key nil))
(global-set-key [?\C--] nil)
(global-set-key [?\C-\M--] nil)

(with-eval-after-load 'diff-mode
  (cl-loop with map = (lookup-key diff-mode-map "\e")
	   for i from ?0 to ?9
	   do (define-key map (char-to-string i) nil)))

;; Similarly, we cannot reliably distinguish <C-backspace> from <backspace>.
;; Many terminal emulators send ^? for <backspace> and ^H for <C-backspace>,
;; or the other way around, but not all of them.  Firefox binds <C-backspace>
;; to delete words backwards (apparently following some Microsoft products),
;; so there's some risk of developing a habit of using it.
(global-unset-key [C-backspace])

;; filling of comments -- we don't want to set
;; `comment-auto-fill-only-comments' always on because in Org-mode, for
;; example, we want auto fill both inside and outside of comments
(add-hook 'prog-mode-hook #'turn-on-auto-fill)
(setq-mode-local prog-mode comment-auto-fill-only-comments t)

(spw/feature-add-hook display-fill-column-indicator-mode
  prog-mode message conf-mode)

(add-hook 'text-mode-hook #'goto-address-mode)
(add-hook 'prog-mode-hook #'goto-address-prog-mode)

(global-set-key "\C-cih" #'add-file-local-variable-prop-line)

;; don't do anything with abbrevs if ~/doc is not checked out
(defvar spw/doc-abbrevs-file (expand-file-name "~/doc/emacs-abbrevs"))
(when (file-exists-p spw/doc-abbrevs-file)
  (setq abbrev-file-name spw/doc-abbrevs-file)
  (quietly-read-abbrev-file)

  (setq save-abbrevs 'silently)

  (setq-default abbrev-mode t)
  (setf (cadr (assq 'abbrev-mode minor-mode-alist)) nil))

;; similar
(defvar spw/doc-bookmarks-file (expand-file-name "~/doc/emacs-bookmarks"))
(when (file-exists-p spw/doc-bookmarks-file)
  (setq bookmark-default-file spw/doc-bookmarks-file
        bookmark-save-flag 1))

;; For files that must be in American English, add both these lines:
;;
;;    <!-- Local IspellDict: en_US -->
;;    <!-- Local IspellPersDict: ~/doc/aspell-en_US -->
;;
(let ((default-dictionary (expand-file-name "~/doc/aspell-en_GB")))
  (when (and (executable-find "aspell") (file-exists-p default-dictionary))
    ;; Emacs 29: use setopt
    (setq ispell-personal-dictionary default-dictionary)))

(global-set-key "\C-h\C-m" #'man)
(global-set-key "\C-cgp" #'cperl-perldoc)
(global-set-key "\C-cgk" #'save-buffers-kill-emacs)

;; Have M-c, M-l and M-u be consistent in all of them exiting Isearch -- the
;; fact that M-c doesn't keeps tripping me up.  While we're here, drop similar
;; isearch-mode-map bindings; all these commands have a binding under M-s too.
(spw/reclaim-keys-from isearch isearch-mode-map "\M-c" "\M-e" "\M-r")

;; Also replace C-w in isearch-mode-map, which also trips me up sometimes.
(defun spw/isearch-yank-word-or-char-hook ()
  (unless (eq this-command #'isearch-yank-word-or-char)
    (define-key isearch-mode-map "\C-w" nil)
    (remove-hook 'post-command-hook #'spw/isearch-yank-word-or-char-hook)))
(defun spw/isearch-yank-word-or-char ()
  (interactive)
  (setq this-command #'isearch-yank-word-or-char)
  (call-interactively #'isearch-yank-word-or-char)
  (define-key isearch-mode-map "\C-w" #'isearch-yank-word-or-char)
  (add-hook 'post-command-hook #'spw/isearch-yank-word-or-char-hook))
(define-key isearch-mode-map "\C-w" nil)
(define-key isearch-mode-map "\C-z\C-w" #'spw/isearch-yank-word-or-char)

;; Invert meaning of C-u for M-= except when the region is active.
(defun spw/count-words ()
  (interactive)
  (if (or (use-region-p) (not current-prefix-arg))
      (call-interactively #'count-words)
    (setq current-prefix-arg nil)
    (call-interactively #'count-words-region)))
(global-set-key [remap count-words-region] #'spw/count-words)

;; Don't have RET try to reindent before inserting a newline, only indent
;; afterwards.  The reindentation is only occasionally helpful, I find, and
;; often it does the wrong thing.
(setq-default electric-indent-inhibit t)

;; Make it easy to use M-a to reach beginning of first sentence of a comment.
(defun spw/backward-sentence-skip-forward ()
  (interactive)
  (call-interactively #'backward-sentence) (skip-syntax-forward " <"))
(global-set-key [remap backward-sentence] #'spw/backward-sentence-skip-forward)

;; See `comint-prompt-read-only'.
(spw/feature-define-keys comint
  [remap kill-region] comint-kill-region
  [remap kill-whole-line] comint-kill-whole-line)

(spw/define-skeleton
    spw/minibuffer-cd-skel (minibuffer-mode :abbrev "cd" :file nil)
  "" (shell-quote-argument
      (expand-file-name (read-directory-name "Run command in dir: " "~/")))
  "cd " str " && " _)

(global-set-key "\C-cd" #'duplicate-line)

(setq skeleton-end-newline nil)

;;; Electric pairs when the region is active
;;;
;;; I used to have `electric-pair-mode' switched on, based on the idea that it
;;; makes non-paredit buffers a bit more like paredit buffers, and that's the
;;; least surprising way to have things, given that I'm not going to give up
;;; paredit.  However, even with `electric-pair-conservative-inhibit', I still
;;; frequently found myself with unwanted insertion.  It also makes C-w much
;;; less effective for correcting mistakes, because you end up with junk to
;;; the right of point as well as to the left.
;;;
;;; Add back a way to wrap the active region in paired delimiters; useful
;;; after hitting M-@ and/or C-M-SPC a few times.  This is the main paredit
;;; feature that I find myself expecting to work in other modes.
;;;
;;; An alternative is to deactivate `electric-pair-mode' only in `text-mode'.

(defvar spw/wrapping-pairs
  '((emacs-lisp-mode (?` . ?'))
    (org-mode (?* . ?*) (?/ . ?/) (?= . ?=))))

(defvar spw/global-wrapping-pairs
  '((?{ . ?}) (?< . ?>) (?\( . ?\)) (?\[ . ?\]) (?' . ?') (?\" . ?\"))
  "Like `spw/add-wrapping-pairs' but for all major modes.")

(defun spw/wrapping-pairs-post-self-insert-function ()
  (let ((parens-require-spaces nil)
	(match (or (cdr (assoc last-command-event spw/global-wrapping-pairs))
		   (cdr (assoc last-command-event
			       (cdr (assoc major-mode spw/wrapping-pairs)))))))
    (when (and match (use-region-p) (eq (char-before) last-command-event))
      ;; See `electric--after-char-pos' if this needs to be more complex.
      (delete-region (point) (1- (point)))
      ;; Moving point and mark to just outside the two characters we insert.
      ;; Note that this makes us inconsistent with `paredit-doublequote' etc.
      (save-excursion (insert-pair nil last-command-event match))
      (if (> (point) (mark))
	  (progn (forward-char 1) (set-mark (1- (mark))))
	(set-mark (1+ (mark))) (forward-char -1)))))
(add-hook 'post-self-insert-hook
	  #'spw/wrapping-pairs-post-self-insert-function
	  50)			     ; depth same as `electric-pair-mode' uses

;;; Icomplete

(custom-theme-set-variables
 'user
 '(icomplete-hide-common-prefix nil)
 '(icomplete-in-buffer t)
 '(icomplete-mode t)
 '(icomplete-show-matches-on-no-input t)
 '(icomplete-tidy-shadowed-file-names t))

;; Possibly we could call `minibuffer-complete-word' if we know we're
;; completing the name of a Lisp symbol.
(spw/reclaim-keys-from minibuffer minibuffer-local-completion-map " " "?")

(setq completion-ignore-case t)

(defun spw/minibuffer-completing-file-name-p ()
  ;; See `icomplete--category'.
  (eq (completion-metadata-get
       (completion-metadata (minibuffer-contents)
			    minibuffer-completion-table
			    minibuffer-completion-predicate)
       'category)
      'file))

;;; Most common actions are to select the top completion in the way that
;;; `icomplete-fido-ret' does, and to exit with the current input.  So these
;;; two get single keypresses, TAB and RET.  We tweak the former such that RET
;;; is required to exit with input which has no matches.  This helps avoid
;;; creating bogus buffers, file-visiting or otherwise, when I mistype.
;;;
;;; Choose RET for exiting with current input because then RET behaves the
;;; same in `read-string' and `completing-read'.  This makes completion less
;;; obtrusive given how some commands provide completion even when they are
;;; mostly used to enter arbitrary strings (e.g. `notmuch-search').
;;;
;;; Don't resettle the previous occupant of <TAB>, `minibuffer-complete',
;;; because an `icomplete-mode' user hardly uses it.

;; This is something like a reimplementation of `icomplete-fido-ret'.
(defun spw/icomplete-tab ()
  (interactive)
  (when-let* ((current (car completion-all-sorted-completions)))
    (if (and (window-minibuffer-p)
	     (not (and (spw/minibuffer-completing-file-name-p)
		       (file-directory-p
			(if-let ((dir (file-name-directory
				       (minibuffer-contents))))
			    (expand-file-name (directory-file-name current)
					      (substitute-env-vars dir))
			  current)))))
	(icomplete-force-complete-and-exit)
      ;; For in-buffer completion it should always be fine to just call
      ;; `icomplete-force-complete', and not exit, because of how in-buffer
      ;; completion uses a transient map (an alternative would be to guess
      ;; whether completing a file name, e.g. (string-suffix-p "/" current)).
      ;; However, if after calling `icomplete-force-complete' there is now
      ;; only one candidate remaining then it's the one we just selected, so
      ;; do exit completion.
      (icomplete-force-complete)
      (unless (window-minibuffer-p)
	(letrec ((buf (current-buffer))
		 (fun (lambda ()
			(advice-remove 'icomplete-post-command-hook fun)
			(with-current-buffer buf
			  (when (atom (cdr completion-all-sorted-completions))
			    (completion-in-region-mode -1))))))
	  (advice-add 'icomplete-post-command-hook :after fun))))))
(define-key icomplete-minibuffer-map [?\t] #'spw/icomplete-tab)

(advice-add 'completion-at-point :after #'minibuffer-hide-completions)

(define-key icomplete-minibuffer-map [remap minibuffer-complete-and-exit] nil)

;; This is based on `icomplete--fido-ccd'.
(defun spw/update-completion-category-overrides ()
  (pcase-dolist (`(,cat . ,props) completion-category-defaults)
    (setf (alist-get cat completion-category-overrides)
	  (or (alist-get cat completion-category-overrides)
	      (cl-loop for entry in props
		       for (prop . val) = entry
		       if (and (eq prop 'styles) (not (memq 'external val)))
		       collect `(,prop . (flex . ,(remq 'flex val)))
		       else collect entry)))))
(add-hook 'icomplete-minibuffer-setup-hook
	  #'spw/update-completion-category-overrides)
(add-hook 'completion-in-region-mode-hook
	  #'spw/update-completion-category-overrides)

;; This is a bit like `icomplete-fido-backward-updir'.
(defun spw/icomplete-choose-rubout ()
  (when (and (window-minibuffer-p) (spw/minibuffer-completing-file-name-p))
    (let ((map (make-sparse-keymap)))
      (define-key map "\C-w" (lambda (arg)
			       (interactive "p")
			       (spw/unix-word-rubout arg "/:[:space:]\n"
						     "^/:[:space:]\n")))
      (use-local-map (make-composed-keymap map (current-local-map))))))
(add-hook 'icomplete-minibuffer-setup-hook #'spw/icomplete-choose-rubout)

;; Preserve standard bindings for editing text in the minibuffer.
(define-key icomplete-minibuffer-map [?\C-j] nil)

;; Bind M-, and M-. to cycle completions; their normal bindings aren't likely
;; to be needed when completing, and unlike C-, and C-. they work in text
;; terminals.  Alternatives might be C-M-r and C-M-s.
(define-key icomplete-minibuffer-map [?\M-.] #'icomplete-forward-completions)
(define-key icomplete-minibuffer-map [?\M-,] #'icomplete-backward-completions)

(defun spw/empty-minibuffer ()
  (interactive)
  (kill-region (minibuffer-prompt-end) (point-max)))
(define-key minibuffer-local-map "\C-l" #'spw/empty-minibuffer)


;;;; Buffers and windows

(defvar spw/arrow-keys-mode-map
  (let ((map (make-sparse-keymap)))
    (dolist (key '(up down left right
		      S-up S-down S-left S-right
		      M-up M-down M-left M-right))
      (define-key map (vector ?\C-z key) #'spw/arrow-keys-mode-passthru))
    map)
  "Keymap for `spw/arrow-keys-mode'.")

(define-minor-mode spw/arrow-keys-mode
  "Apply the bindings in `spw/arrow-keys-mode-map', but
additionally bind the sequences of C-z followed by each of the
four arrow keys to activate a transient map in which the four
arrow keys have the bindings they would have absent this mode.

Permits globally re-binding the four arrow keys without rendering
it impossible to access mode-specific bindings for those four
keys (e.g. the use of the left and right arrow keys in
`fido-mode' minibuffers)."
  ;; :init-value t
  :lighter nil :keymap spw/arrow-keys-mode-map :global t)

(defun spw/arrow-keys-mode-passthru ()
  (interactive)
  ;; Possibly we could cache the map in a buffer-local variable.  It'd get
  ;; cleared if the major mode changes, but we'd also need to figure out
  ;; clearing it (but not recomputing it until and unless this function is
  ;; called) if the minor modes change.
  (let ((map (make-sparse-keymap))
	(cell (cl-find 'spw/arrow-keys-mode minor-mode-map-alist :key #'car)))
    (cl-letf (((car cell) nil))
      (dolist (key '([up] [down] [left] [right]
		     [S-up] [S-down] [S-left] [S-right]
		     [M-up] [M-down] [M-left] [M-right]))
	(define-key map key (key-binding key))))
    (let ((key (vector last-command-event)))
      (call-interactively (lookup-key map key) t key))
    (set-transient-map map t)))

(defun spw/get-mru-window (&optional exclude)
  "Like `get-mru-window' but also consider the minibuffer, and
don't consider windows satisfying the predicate EXCLUDE."
  (let (best-window best-time time)
    (dolist (window (window-list-1) best-window)
      (setq time (window-use-time window))
      (when (and (not (and exclude (funcall exclude window)))
		 (not (eq window (selected-window)))
		 (or (not best-time) (> time best-time)))
	(setq best-time time)
	(setq best-window window)))))

(defun spw/back-and-forth (arg)
  (interactive "P")
  (if arg
      ;; if there's a prefix arg then just `other-window', so that's still
      ;; available on C-u 1 C-x o
      (call-interactively #'other-window)
    (if-let ((window (spw/get-mru-window)))
	(select-window window)
      (user-error "No other window to select"))))
(global-set-key [remap other-window] #'spw/back-and-forth)

;;; Initial motivation for `transient-cycles' work is that we want all these
;;; commands to be easily repeatable but without setting a transient map which
;;; binds self-insert chars, as might want to type those just after switching.
;;;
;;; We don't bind any modified arrow keys because there is a good chance they
;;; don't get through to text mode Emacs.  If I have to make regular use of a
;;; terminal to which *un*modified arrow keys don't get through, or arrive as
;;; sequences which already belong to other keys, one idea is to add
;;; C-c/C-z {h,j,k,l} to `input-decode-map' for the arrow keys (or bind them
;;; to commands setting `unread-command-events'), without any transient maps.
;;;
;;; Previously we used <left>/<right> for custom next- and previous-window
;;; commands with transient cycling, and didn't use any windmove commands.
;;; However, because <left>/<right> are my default transient cycling keys,
;;; this led to situations where I tried to use <left>/<right> to switch
;;; window and found myself continuing transient cycling for the previous
;;; command instead.  So, should probably avoid putting anything on unmodified
;;; <left>/<right>.  We could still put something on unmodified <down>/<up>,
;;; which I used to use for `tab-bar-history-mode' forward & back commands.
;;; (`spw/arrow-keys-mode' made it feasible to bind things to unmodified arrow
;;; keys in the global map.  That's disabled at present, as the unmodified
;;; arrow keys are not in use.)
;;;
;;; We might put one of the other sets of windmove commands, such as
;;; windmove-swap-states-* commands, on C-z M-7/8/9/0, or possibly
;;; C-c w M-7/8/9/0.  C-c <left>/<right> are also available, as they tacitly
;;; belong to `winner-mode' / `tab-bar-history-mode'.

(defvar spw/windmove-transient-map (make-sparse-keymap))

(spw/macroexp-for (key direction)
    (("\M-7" "left") ("\M-8" "down") ("\M-9" "up") ("\M-0" "right"))
  (let* ((init (intern (format "spw/windmove-%s" direction)))
	 (noselect (intern (format "spw/windmove-%s-noselect" direction)))
	 (noselect-body
	  `(cl-flet ((old-s-w (symbol-function 'select-window)))
	     (cl-letf (((symbol-function 'select-window)
			(lambda (window &rest _ignore)
			  (old-s-w window 'mark-for-redisplay))))
	       (call-interactively #',(intern
				       (format "windmove-%s" direction)))))))
    `(progn (defun ,noselect () (interactive) ,noselect-body)
	    (define-key spw/windmove-transient-map ,key #',noselect)
	    (defun ,init ()
	      (interactive)
	      ;; Don't select the windows we move through, so that the
	      ;; window where we started becomes the most recently
	      ;; selected window.  Then in the ON-EXIT function, select
	      ;; the destination window again with the NOSELECT argument
	      ;; to `select-window' nil.
	      ,noselect-body
	      (set-transient-map spw/windmove-transient-map t
				 (lambda ()
				   (select-window (selected-window)))))
	    (global-set-key ,key #',init))))

;; We might resettle `pop-global-mark' to C-z C-SPC.
(define-key ctl-x-map "\C-@" #'transient-cycles-window-buffers-back-and-forth)
(define-key ctl-x-map [?\C-\s] #'transient-cycles-window-buffers-back-and-forth)

;; Now using `tab-bar-history-mode' instead of `winner-mode' because (i) it
;; keeps history per tab; (ii) it doesn't delete windows from old window
;; configurations, which makes it faster to identify visually when you've
;; reached the target configuration; (iii) it handles multiple windows in a
;; configuration displaying the same buffer better; specifically, unlike
;; `winner-mode', `tab-bar-history-mode' does not restore just one value for
;; point for all of the windows in the configuration showing a single buffer.
(transient-cycles-define-commands ()
  (("\M-2" . tab-bar-history-back)
   ("\M-3" . tab-bar-history-forward))
  (lambda (_ignore)
    (lambda (count)
      (interactive "p")
      (if (> count 0) (tab-bar-history-forward) (tab-bar-history-back))))
  :cycle-backwards-key "\M-2" :cycle-forwards-key "\M-3")

(define-key transient-cycles-window-buffers-mode-map "\M-1" #'previous-buffer)
(define-key transient-cycles-window-buffers-mode-map "\M-4" #'next-buffer)

;; Start transient cycling among the current buffer's siblings.
;; Can be usefully prefixed with C-x 4 4 etc. to start cycling elsewhere.
(defun spw/cycle-from-here ()
  (interactive)
  (push last-command-event unread-command-events)
  (let (display-buffer-alist)
    ;; NORECORD nil because we *do* want the current buffer pushed to the
    ;; window's previous buffers.
    (pop-to-buffer-same-window (current-buffer))))
(spw/transient-cycles-define-buffer-switch
  (([?\C-x left] . spw/cycle-from-here)
   ([?\C-x right] . spw/cycle-from-here)))

(defun spw/display-buffer-pop-up-or-same-window (buffer alist)
  (if (eq (window-buffer (selected-window)) buffer)
      (display-buffer-same-window buffer alist)
    (display-buffer-pop-up-window buffer (cl-acons 'inhibit-same-window t
						   alist))))

(setq display-buffer-alist
      `(;; This is meant to say: for these buffers which, unusually, do not
	;; benefit from being as tall as possible, always display them in the
	;; other window (in the sense of `find-file-other-window' in stock
	;; Emacs), but if that means splitting vertically, make the window
	;; shorter than it would otherwise be, to allow more lines to the
	;; buffer on the other side of the split (in the case where displaying
	;; the buffer in the other window means splitting horizontally, we are
	;; already allowing as many lines as we can to buffer on the other
	;; side of the split).
	;;
	;; I don't think eshell and scheme would be suitable for
	;; `display-buffer-in-side-window' (at the bottom) because they are
	;; not purely informational -- they're for doing stuff in, and so
	;; should be one of the main (usually two) windows of the frame.  But
	;; not sure about this.  I might just use `spw--window-to-frame' when
	;; they are not purely informational.  How much of an advantage of
	;; side windows is the way in which they can be toggled on and off?
	(,(concat "^\\*" (regexp-opt '("eshell" "scratch" "compilation"
				       "scheme" "inferior-lisp"
				       "slime-repl" "sly-mrepl")))
	 spw/display-buffer-pop-up-or-same-window
	 (window-height . 0.20)
	 (preserve-size . (nil . t)))

	("^\\*vc\\(?:-reflog\\)?-diff\\*"
	 spw/display-buffer-pop-up-or-same-window)

	;; These SLIME windows don't benefit from a lot of height and it is
	;; useful to have them be independent of the main two windows
	;; displaying code, the listener, etc.
	;; Get going by hitting C-c C-z to bring up the REPL.
	,@(cl-loop for i upfrom -1
		   for re in '("^\\*\\(?:slime\\|sly\\)-compilation"
			       "^\\*\\(?:slime\\|sly\\)-inspector"
			       "^\\*\\(?:sldb\\|sly-db\\).+/1\\*$"
			       "^\\*\\(?:sldb\\|sly-db\\)")
		   collect `(,re display-buffer-in-side-window
				 (window-height . 0.30)
				 (slot . ,i)
				 (side . bottom)))

	("^\\*Calendar\\*$"
	 (display-buffer-reuse-window display-buffer-below-selected)
         (window-height . fit-window-to-buffer))

	("^\\*Annotate " display-buffer-full-frame)))

;; Ensure that C-x 4 C-o &c. do not reuse the selected window.
;;
;; `display-buffer-fallback-action' is a constant so cons once in advance.
(let ((ac `(,(car display-buffer-fallback-action) (inhibit-same-window . t))))
  (defun spw/display-buffer (orig-fun &rest args)
    (if (memq this-command
	      '(display-buffer
		project-display-buffer
		transient-cycles-cmd-display-buffer
		transient-cycles-cmd-spw/display-recent-major-mode-buffer))
	(let ((display-buffer-overriding-action ac))
	  (apply orig-fun args))
      (apply orig-fun args))))
(advice-add #'display-buffer :around #'spw/display-buffer)

(defun spw/window-toggle-side-windows ()
    "Like `window-toggle-side-windows', but (i) if the selected
window is a side window, change focus to the most recently used
non-side window first, and upon restore, attempt to restore focus
to the side window; and (ii) if there is no saved side window
state, attempt to produce some useful side window(s)."
  (interactive)
  (cond ((window-parameter nil 'window-side)
	 ;; We're in a side window.
	 (set-frame-parameter nil 'spw/window-side-focused (current-buffer))
	 (select-window (spw/get-mru-window
			 (lambda (w) (window-parameter w 'window-side)))
			'mark-for-redisplay)
	 (window-toggle-side-windows))
	((window-with-parameter 'window-side)
	 ;; There's a side window but it's not selected.
	 (set-frame-parameter nil 'spw/window-side-focused nil)
	 (window-toggle-side-windows))
	((frame-parameter nil 'spw/window-side-focused)
	 ;; We're restoring and we should attempt to restore focus.
	 (window-toggle-side-windows)
	 (when-let ((w (get-buffer-window
			(frame-parameter nil 'spw/window-side-focused))))
	   (select-window w)))
	(t
	 ;; We're restoring and we should not attempt to restore focus.
	 (if (frame-parameter nil 'window-state)
	     (window-toggle-side-windows)
	   ;; There's no saved state.  Attempt to produce useful side windows.
	   (cond ((and (project-current)
		       (directory-files
			(project-root (project-current)) nil "\\.asd\\'"))
		  (if (ignore-errors (slime-output-buffer))
		      (slime-switch-to-output-buffer)
		    (let ((default-directory (expand-file-name "~/")))
		      (slime))))
		 (t (error "No side windows state & no heuristic")))))))
;; Possibly this command should go on M-5 or M-6.
(global-set-key [remap window-toggle-side-windows]
		#'spw/window-toggle-side-windows)

(defun spw/delete-other-windows--toggle-side-windows
    (&optional window &rest _ignore)
  "Save any side window state before deleting other windows such that side
windows can be recovered using `window-toggle-side-windows'.

A limitation is that when `window-toggle-side-windows' is subsequently used
the non-side windows deleted by `delete-other-windows' will also reappear."
  (when (window-parameter window 'window-side)
    (window-toggle-side-windows (window-frame window))))
(advice-add 'delete-other-windows
	    :before #'spw/delete-other-windows--toggle-side-windows)

;; Thanks to `transient-cycles-tab-bar-mode', this makes C-x t o like my
;; (rebound) C-x o.
(define-key tab-prefix-map "o" #'tab-bar-switch-to-recent-tab)
(define-key tab-prefix-map "O" nil)	; easy to hit by accident

(define-key tab-prefix-map [left] #'tab-previous)
(define-key tab-prefix-map [right] #'tab-next)

(define-key spw/ctl-z-map "3" "\C-x1\C-x3")

(define-key ctl-x-5-map "\C-j" "\C-x55\C-x\C-j")
(define-key tab-prefix-map "\C-j" "\C-xtt\C-x\C-j")

;;; For when the buffer's name isn't much help for switching to it, as is
;;; often the case with `notmuch-show' buffers.  We select the most recent
;;; buffer but then transient cycling can take us to other buffers of the same
;;; major mode.

(defun spw/read-major-mode-recent-buffer ()
  (let ((buffers (make-hash-table)))
    (dolist (buffer (buffer-list))
      (with-current-buffer buffer
	(unless (gethash major-mode buffers)
	  (puthash major-mode buffer buffers))))
    (list
     (gethash
      (intern
       (completing-read
	"Most recent buffer of major mode: " (hash-table-keys buffers) nil t))
      buffers))))

(spw/transient-cycles-define-buffer-switch
  ((("\C-zb" . spw/switch-to-recent-major-mode-buffer) (buffer)
      (interactive (spw/read-major-mode-recent-buffer))
      (switch-to-buffer buffer t))

   (("\C-z4b" . spw/switch-to-recent-major-mode-buffer-other-window) (buffer)
      (interactive (spw/read-major-mode-recent-buffer))
      (switch-to-buffer-other-window buffer t))

   (("\C-z5b" . spw/switch-to-recent-major-mode-buffer-other-frame) (buffer)
      (interactive (spw/read-major-mode-recent-buffer))
      (switch-to-buffer-other-frame buffer t))

   (("\C-z4\C-o" . spw/display-recent-major-mode-buffer) (buffer)
      (interactive (spw/read-major-mode-recent-buffer))
      (display-buffer buffer))))


;;;; TRAMP

(with-eval-after-load 'tramp
  (add-to-list 'tramp-connection-properties
	       ;; Activate direct-async-process for all non-multihop SSH
	       ;; connections.
	       '("/ssh:" "direct-async-process" t)
	       ;; session-timeout is about dropping a connection for security
	       ;; reasons alone: never do that.
	       '(nil "session-timeout" nil))

  (add-to-list 'tramp-remote-path 'tramp-own-remote-path))

(unless (string-match			; Emacs 28: unquote and `string-search'
	 (regexp-quote tramp-file-name-regexp) vc-ignore-dir-regexp)
  (setq vc-ignore-dir-regexp
	(format "\\(?:%s\\)\\|\\(?:%s\\)"
		vc-ignore-dir-regexp tramp-file-name-regexp)))


;;;; The Emacs shell

(custom-theme-set-variables
 'user
 ;; This makes Eshell completions a bit more like bash's.
 '(eshell-cmpl-cycle-completions nil)

 '(eshell-cmpl-ignore-case t)
 '(eshell-hist-ignoredups 'erase)
 '(eshell-history-append t)
 '(eshell-history-size 5000)
 '(eshell-save-history-on-exit nil))
(spw/feature-add-to-list eshell-modules-list esh-module
  'eshell-elecslash 'eshell-tramp 'eshell-xtra)
(spw/feature-add-to-list eshell-visual-commands em-term
  "locmaint" "gen-DSA" "gen-ELA")

(with-eval-after-load 'esh-cmd
  (add-hook 'eshell-pre-command-hook
	    (lambda ()
	      (eshell-write-history nil eshell-history-append))))

;; We could have an optional argument to kill any input and reinsert it after
;; running the command, and even restore point within that input.  Might be
;; useful in `spw/eshell-jump' & interactively.
(defun spw/eshell-insert-and-send (&rest args)
  (delete-region eshell-last-output-end (point-max))
  (when (> eshell-last-output-end (point))
    (goto-char eshell-last-output-end))
  (apply #'insert-and-inherit args)
  (eshell-send-input))

(defun spw/eshell-cd (dir)
  (spw/eshell-insert-and-send "cd " (eshell-quote-argument dir)))

;;; Ideas behind the following two functions due to Protesilaos Stavrou.

(defun spw/eshell-cd-recent-dir (&optional arg)
  (interactive "P")
  (let ((directory (completing-read
		    (if arg
			"Dired in other window (directory): "
		      "Switch to directory: ")
		    (ring-elements eshell-last-dir-ring) nil t)))
    (if arg (dired-other-window directory) (spw/eshell-cd directory))))
(with-eval-after-load 'em-hist
  (define-key eshell-hist-mode-map "\C-zd" #'spw/eshell-cd-recent-dir))
;; With this set to nil, recent dirs are not saved to disk, such that the
;; history of recent dirs is effectively buffer-local.
(setq eshell-last-dir-ring-file-name nil)

(defun spw/eshell-cd-project-root ()
  (interactive)
  (if-let ((project (project-current)))
      (spw/eshell-cd (project-root project))
    (user-error "No current project")))
(with-eval-after-load 'esh-mode
  (define-key eshell-mode-map "\C-zp" #'spw/eshell-cd-project-root))

(spw/define-skeleton spw/eshell-libexec
    (eshell-mode :abbrev "le" :file "esh-mode")
  "" "" "~/" '(eshell-electric-forward-slash) "src/dotfiles/scripts/")

;;; getting to Eshell buffers

(defun spw/eshell-jump (&optional chdir busy-okay)
  "Pop to a recently-used Eshell that isn't busy, or start a fresh one.
Return a ring for transient cycling among other Eshells, in the order of most
recent use.  An Eshell is busy if there's a command running, or it's narrowed
(in the latter case, this was probably done with C-u C-c C-r).
When BUSY-OKAY is `interactive', an Eshell is additionally considered busy
when there is a partially-entered command.

Non-nil CHDIR requests an Eshell that's related to `default-directory'.
Specifically, if CHDIR is non-nil, pop to an Eshell in `default-directory',
pop to an Eshell under the current project root and change its directory to
`default-directory', or start a fresh Eshell in `default-directory'.
If CHDIR is `project', use the current project root as `default-directory'.
In `dired-mode', unless CHDIR is `strict', use the result of calling
`dired-current-directory' as `default-directory'.

Non-nil BUSY-OKAY requests ignoring whether Eshells are busy.  This makes
it easy to return to Eshells with long-running commands.
If BUSY-OKAY is `interactive', as it is interactively, ignore whether Eshells
are busy unless there is a prefix argument, and unconditionally start a fresh
Eshell if the prefix argument is 16 or greater (e.g. with C-u C-u).
If BUSY-OKAY is `fresh', unconditionally start a fresh Eshell, whether or not
an Eshell that isn't busy already exists.
Any other non-nil value means to ignore whether Eshells are busy.

If BUSY-OKAY is `interactive', `this-command' is equal to `last-command',
and there is no prefix argument, set the prefix argument to the numeric
value of the last prefix argument multiplied by 4, and also bind
`display-buffer-overriding-action' to use the selected window.
Thus, M-& M-& is equivalent to M-& C-u M-&, and M-& M-& M-& is equivalent to
M-& C-u M-& C-u C-u M-&.  This streamlines the case where this command takes
you to a buffer that's busy but you need one that isn't, but note that with
the current implementation transient cycling is restarted, so the busy buffer
will become the most recently selected buffer.

Some ideas behind these behaviours are as follows.

- Just like Lisp REPLs, we do not normally need a lot of different Eshells;
  it is fine for shell history associated with different tasks to become
  mixed together.  But we do require an easy way to start new Eshells when
  other Eshells are already busy running commands.

- Rename *eshell* to *eshell*<N>, but don't ever rename *eshell*<N> back to
  *eshell*, because that is a conventional workflow -- upstream M-&, C-h i,
  M-x ielm, M-x compile etc. always take you to the unnumbered buffer,
  possibly renaming the numbered one out of the way.

  We do nevertheless reuse Eshells, not for the sake of creating fewer, but
  just so that this command can be used to get back to the most recent few
  Eshells you were working in, to see output.

- We'll sometimes use C-x 4 1 in front of this command, and if we're
  already in an Eshell, we might use C-x 4 4 C-x <left>/<right> to cycle to
  another Eshell in another window, or a sequence like M-& C-u M-&, which
  doesn't bind `display-buffer-overriding-action'.

- It's not especially convenient to distinguish between `project-eshell'
  and `eshell' Eshells.  We just want a way to quickly obtain an Eshell in
  the project root, and bind that to C-x p e.

- Except when `this-command' is equal to `last-command', don't do anything
  special when the current buffer is the one we'd pop to, as previous
  versions of this command did.  That sort of context-dependent behavioural
  variation reduces the speed with which one can use the command because
  you have to think more about what it will do."
  (interactive '(nil interactive))
  (require 'eshell)
  (let* ((default-directory (or (and (not (eq chdir 'strict))
				     (eq major-mode 'dired-mode)
				     (dired-current-directory))
				default-directory))
	 (current-project (and (not (file-remote-p default-directory))
			       (project-current)))
	 (proj-root (and current-project (project-root current-project)))
	 (target-directory (expand-file-name
			    (or (and (eq chdir 'project) proj-root)
				default-directory)))
	 (again (and (not current-prefix-arg) (eq busy-okay 'interactive)
		     (eq this-command last-command)))
	 (display-buffer-overriding-action
	  (if again '(display-buffer-same-window (inhibit-same-window . nil))
	    display-buffer-overriding-action))
	 (orig-busy-okay busy-okay)
	 target-directory-eshells other-eshells
	 most-recent-eshell same-project-eshell target-directory-eshell)
    ;; It's important that `transient-cycles-cmd-spw/eshell-jump' never sees
    ;; this prefix argument because it has its own meanings for C-u & C-u C-u.
    ;; This means that C-u M-! and M-! M-! are different, which is desirable.
    ;;
    ;; We could multiply by 16 if `last-prefix-arg' is nil and the current
    ;; buffer is an Eshell that's not busy.  The idea would be that when M-&
    ;; takes us to a non-busy buffer, a second M-& would only take us to the
    ;; same buffer, so skip over that step and do C-u C-u M-&.
    ;; However, this simpler design has the advantage that if I know I want a
    ;; non-busy Eshell I can just hit M-& M-& without looking and I know I'll
    ;; get the most recent non-busy Eshell in the right directory.
    (when again
      (setq current-prefix-arg (* 4 (prefix-numeric-value last-prefix-arg))))
    (when (eq orig-busy-okay 'interactive)
      (setq busy-okay
	    (cond ((>= (prefix-numeric-value current-prefix-arg) 16) 'fresh)
		  ((not current-prefix-arg) t))))
    (cl-flet ((busy-p (buffer)
		(or (get-buffer-process buffer)
		    (with-current-buffer buffer
		      (or (buffer-narrowed-p)
			  (and (eq orig-busy-okay 'interactive)
			       (> (point-max) eshell-last-output-end))))))
	      (fresh-eshell ()
		(when-let ((buffer (get-buffer eshell-buffer-name)))
		  (with-current-buffer buffer (rename-uniquely)))
		(let ((default-directory
		       (if chdir target-directory (expand-file-name "~/"))))
		  (eshell))))
      (dolist (buffer (buffer-list))
	(with-current-buffer buffer
	  (when (eq major-mode 'eshell-mode)
	    (let ((in-target-p
		   (and chdir (string= default-directory target-directory))))
	      (push buffer
		    (if in-target-p target-directory-eshells other-eshells))
	      (cond ((and (not chdir) (not most-recent-eshell)
			  (or busy-okay (not (busy-p buffer))))
		     (setq most-recent-eshell buffer))
		    ((and in-target-p (not target-directory-eshell)
			  (or busy-okay (not (busy-p buffer))))
		     (setq target-directory-eshell buffer))
		    ((and chdir proj-root (not same-project-eshell)
			  ;; We'll change its directory so it mustn't be busy.
			  (not (busy-p buffer))
			  (file-in-directory-p default-directory proj-root))
		     (setq same-project-eshell buffer)))))))
      (cond ((eq busy-okay 'fresh) (fresh-eshell))
	    ((and chdir target-directory-eshell)
	     (pop-to-buffer target-directory-eshell))
	    ((and chdir same-project-eshell)
	     (pop-to-buffer same-project-eshell)
	     (spw/eshell-cd target-directory))
	    (most-recent-eshell		; CHDIR nil
	     (pop-to-buffer most-recent-eshell))
	    (t (fresh-eshell))))
    ;; In an interactive call where we specifically requested an Eshell that's
    ;; not busy, ensure it's ready for us to enter a command.
    ;; Otherwise, it's useful to be able to jump back to exactly where we were
    ;; in an Eshell, and when called from Lisp, let the caller decide what to
    ;; do about where we are in the buffer, and about any partially-entered
    ;; command (e.g. see `spw/dired-copy-filename-as-kill').
    (when (and (not busy-okay) (eq orig-busy-okay 'interactive))
      (goto-char (point-max)))
    (let* ((all (delq (current-buffer)
		      (nconc other-eshells target-directory-eshells)))
	   (ring (make-ring (1+ (length all)))))
      (dolist (buffer all)
	(ring-insert ring buffer))
      (ring-insert ring (current-buffer))
      ring)))
(put 'spw/project-eshell 'project-aware t)

(spw/reclaim-keys-from dired-x dired-mode-map "\M-!")
(spw/reclaim-keys-from term term-raw-map "\M-!" "\M-&")

(spw/transient-cycles-define-buffer-switch
  ((("\M-!" . spw/eshell-jump) (arg)
      (interactive "p")
      (let ((>>> (and (> arg 1) (format " >>>#<buffer %s>" (buffer-name)))))
	(prog1 (spw/eshell-jump (> arg 4) (and (= arg 1) 'interactive))
	  (when >>>
	    (let ((there (save-excursion
			   (goto-char (point-max))
			   (skip-syntax-backward "\\s-")
			   (- (point) (length >>>)))))
	      (unless (and (>= there 0)
			   (string= >>> (buffer-substring there (point-max))))
		(save-excursion
		  (goto-char (point-max))
		  (insert >>>)
		  (backward-char (length >>>))
		  (when (> (point) eshell-last-output-end)
		    (just-one-space)))))))))
   ;; This could be on C-z C-j, like `dired-jump', w/ corresponding C-z 4 C-j
   ;; and C-z 5 C-j.  But I'd want C-z 4 C-j much more often than C-z C-j.
   (("\M-&" . spw/eshell-jump-from-here) ()
      (interactive)
      (spw/eshell-jump t 'interactive))))

(with-eval-after-load 'project
  (when (boundp 'project-prefix-map)	; for Emacs 27
    (spw/transient-cycles-define-buffer-switch
      ((("e" . spw/project-eshell) ()
	  (interactive)
	  (spw/eshell-jump 'project 'interactive)))
      ;; Bind into project-prefix-map, rather than adding a remap, so that we
      ;; have it under C-x 4 p, C-x 5 p etc. too.
      :keymap project-prefix-map)))
(put 'transient-cycles-cmd-spw/project-eshell 'project-aware t)


;;;; Miscellaneous functions & commands
;;;; This is meant to be like ~/src/dotfiles/bin & ~/src/dotfiles/scripts, not
;;;; so much about Emacs startup, except that we do want them always loaded.

;; This is an alternative way to activate the mark temporarily when
;; `transient-mark-mode' is off, and whether it's on or off, makes it
;; easier to operate on adjacent whole lines where the set of lines is
;; not surrounded by blank lines such that `mark-paragraph' can be
;; used.
(defun spw/ensure-whole-lines-mode (edge &optional set-mark)
  (interactive "p")
  (when (or set-mark (not (mark t)))
    (set-mark (point)))
  (letrec ((start) (end)
	   (hook
	    (lambda ()
	      (if mark-active
		  (unless isearch-mode
		    (let ((swap (> (point) (mark))))
		      (when swap (exchange-point-and-mark))
		      (goto-char
		       (if (cl-minusp edge)
			   (pos-eol (and (not (eolp))
					 (or (not start) (< (point) start))
					 0))
			 (pos-bol (and (eql start (pos-bol)) (> (point) start)
				       2))))
		      (setq start (point))
		      (unless (= (point) (mark))
			(exchange-point-and-mark)
			(goto-char
			 (if (cl-plusp edge)
			     (pos-bol (and (not (bolp))
					   (or (not end) (> (point) end))
					   2))
			   (pos-eol (and (eql end (pos-eol)) (< (point) end)
					 0))))
			(setq end (point))
			(unless swap (exchange-point-and-mark)))))
		(remove-hook 'post-command-hook hook t)
		(remove-hook 'isearch-mode-end-hook hook t)))))
    (activate-mark transient-mark-mode)
    (add-hook 'post-command-hook hook nil t)
    (add-hook 'isearch-mode-end-hook hook nil t)))
(define-key spw/ctl-z-map "\s" #'spw/ensure-whole-lines-mode)

;; If know the name of group might try `gnus-read-ephemeral-gmane-group' (and
;; if that works well, might want to make this function prompt for a group to
;; pass to that function, and if blank, do what function does now).
(defun spw/browse-gmane ()
  (interactive)
  (gnus-no-server)
  (gnus-group-browse-foreign-server '(nntp "news.gmane.io")))
(global-set-key "\C-cgG" #'spw/browse-gmane)

(defun spw/org-reformat-subtree ()
  (interactive)
  ;; we have to set the mark, rather than just narrowing to the subtree, or
  ;; just using `outline-back-to-heading'/`outline-next-heading', because of
  ;; how `org-fill-paragraph' works
  (save-mark-and-excursion
    ;; widen, because otherwise it is trickier to ensure just one line at end
    ;; of subtree
    (save-restriction
      (widen)
      ;; basic reformatting of the text
      (let ((transient-mark-mode t))
	(org-mark-subtree)
	(forward-line 1)
	(call-interactively 'org-fill-paragraph)
	(call-interactively 'indent-region)
	(beginning-of-line 0))
      ;; ensure a newline before headline unless first line of buffer
      (unless (or (equal (point) (point-min))
		  (looking-back "\n\n" nil))
	(open-line 1)
	(forward-line 1))
      ;; ensure no newline before metadata
      (delete-blank-lines)
      ;; ensure a single newline after all metadata
      (org-end-of-meta-data t)
      (open-line 2)
      (delete-blank-lines)
      ;; ensure a single newline at end of subtree
      (exchange-point-and-mark)
      (open-line 2)
      (delete-blank-lines))))
(global-set-key "\C-co\M-q" #'spw/org-reformat-subtree)

(defun spw/compact-blank-lines ()
  "Replace blocks of multiple blank lines with single blank lines."
  (interactive)
  (save-excursion
    (goto-char (point-min))
    (while (search-forward-regexp "\n\n\n+" nil t)
      (replace-match "\n\n"))))

(defun spw/vc-rename-visited-file ()
  (interactive)
  (if-let ((file-name (and (vc-backend buffer-file-name) buffer-file-name)))
      (vc-rename-file file-name (read-file-name "Rename to: "))
    (user-error "Buffer is not visiting any VC-controlled file")))

;; `vc-rename-file' is quite fussy, to a git user, so want
;; `rename-visited-file' even for files under version control.
(global-set-key "\C-cR"  #'rename-visited-file)
(global-set-key "\C-cvR" #'spw/vc-rename-visited-file)

;; It's sometimes useful to do C-u M-~ C-c D to temporarily delete something
;; just while running a cmd, say, knowing we'll be prompted to save it later.
;;
;; Another reason for wanting this is that `vc-delete-file' can be fussy too.
;;
;; There is also C-x C-j D but that asks for confirmation.
(defun spw/delete-visited-file (arg)
  (interactive "P")
  (if-let ((file-name (buffer-file-name)))
      ;; No need to ask for confirmation when we aren't killing the buffer.
      (progn (delete-file file-name)
	     (if arg (message "Deleted %s" file-name) (bury-buffer)))
    (user-error "Buffer is not visiting any file")))

(defun spw/vc-delete-visited-file ()
  (interactive)
  (if-let ((file-name (and (vc-backend buffer-file-name) buffer-file-name)))
      (vc-delete-file file-name)
    (user-error "Buffer is not visiting any VC-controlled file")))

(global-set-key "\C-cD"  #'spw/delete-visited-file)
(global-set-key "\C-cvD" #'spw/vc-delete-visited-file)

(defun spw/link-stat-block (start end)
  (interactive "r")
  (when-let ((region-text (buffer-substring start end)))
    (org-insert-link
     nil
     (concat "file:~/annex/gaming/5eblocks/" region-text ".png")
     region-text)))

;; Possibly this should be replaced with something like `project-find-regexp'
;;
;; Input e.g.: lisp "Emacs configuration"
(defun spw/git-grep-docs (words)
  (interactive "sSearch for words/quoted phrases in text docs: ")
  (vc-git-grep (concat "git --no-pager grep -n --color -iw "
		       (mapconcat (lambda (word)
				    (concat "-e " (shell-quote-argument word)))
				  (split-string-and-unquote words) " ")
		       " -- \"*.org\" \"*.tex\" \"*.md\" :!org/archive")
	       nil (expand-file-name "~/doc")))
(global-set-key "\C-cog" #'spw/git-grep-docs)

;; this is called by .dir-locals.el in ~/doc/{pres,papers}
(defun spw/set-pandoc-compile-command (&rest exts)
  (setq-local compile-command
              (concat "make "
                      (mapconcat
                       (lambda (ext)
			 (file-name-nondirectory
			  (concat (file-name-sans-extension
				   (buffer-file-name))
				  "."
				  ext)))
                       (or exts '("pdf"))
		       " ")))
  (local-set-key "\C-z\C-c" #'compile))

(defun spw/all-programming-projects ()
  (call-process "src-register-all")
  (let ((default-directory (expand-file-name "~/src")))
    (mapcar (lambda (line) (substring line 9))
	    (remove "" (process-lines "mr" "list")))))

(defun spw/register-programming-projects-and-switch ()
  (interactive)
  (dolist (directory (spw/all-programming-projects))
    (when-let ((project (project-current nil directory)))
      (project-remember-project project)))
  (call-interactively 'project-switch-project))
(global-set-key "\C-cp" #'spw/register-programming-projects-and-switch)

(defun spw/src-dirs-not-projects ()
  "Return dirs under ~/src which contain repos but are not themselves repos."
  (let ((projects (make-hash-table :test 'equal)))
    (dolist (project (spw/all-programming-projects))
      (puthash project t projects))
    (cl-labels ((dirs-below (dir)
			    (let ((contents
				   (cl-delete-if-not
				    (lambda (f)
				      (and (file-directory-p f)
					   (not (gethash f projects))))
				    (directory-files dir t "[^.]"))))
			      (nconc contents
				     (mapcan #'dirs-below contents)))))
      (dirs-below (expand-file-name "~/src")))))

(defun spw/clone-repo ()
  (interactive)
  (let*
      ((method
	(completing-read "Method: "
			 '("git clone" "dgit clone" "debcheckout" "mr -fd co")
			 nil t))
       (mrp (string= method "mr -fd co"))
       (destination
	(and (not mrp)
	     (expand-file-name
	      (completing-read "Destination: "
			       (nconc (mapcar #'abbreviate-file-name
					      (spw/src-dirs-not-projects))
				      '("~/tmp" "~/src"))
			       nil t))))
       (source (read-from-minibuffer "What to clone: "))
       (buffer (get-buffer-create "*Repository Clone Output*"))
       (default-directory (or destination (expand-file-name "~/"))))
    (make-directory
     (file-name-directory (directory-file-name (or destination source))) t)
    (with-current-buffer buffer (erase-buffer))
    (message "Cloning...")
    (if (zerop (call-process-shell-command
		(if mrp (format "mr -fd %s co" source)
		  (format "%s %s" method source))
		nil buffer))
	(let* ((right-chopped
		(progn (string-match "\\(\\.git\\)?/?\\'" source)
		       (substring source 0 (match-beginning 0))))
	       (repo-dir
		(if mrp (expand-file-name (concat "~/" source))
		  (file-name-concat
		   (file-name-as-directory destination)
		   (if (string-match "[/:][^/:]*\\'" right-chopped)
		       (substring right-chopped (1+ (match-beginning 0)))
		     right-chopped)))))
	  (bury-buffer buffer)
	  (unless mrp (call-process "src-register-all"))
	  (dired (if (file-directory-p repo-dir) repo-dir destination))
	  (when-let ((project (project-current nil)))
	    (project-remember-project project)))
      (display-buffer buffer))))
(global-set-key "\C-cvc" #'spw/clone-repo)

;; author unknown
(defun spw/toggle-frame-split ()
  "Toggle the orientation of a two-window split.

Useful after resizing the frame."
  (interactive)
  (when (= (count-windows) 2)
      (let* ((this-win-buffer (window-buffer))
             (next-win-buffer (window-buffer (next-window)))
             (this-win-edges (window-edges (selected-window)))
             (next-win-edges (window-edges (next-window)))
             (this-win-2nd (not (and (<= (car this-win-edges)
                                         (car next-win-edges))
                                     (<= (cadr this-win-edges)
                                         (cadr next-win-edges)))))
             (splitter
              (if (= (car this-win-edges)
                     (car (window-edges (next-window))))
                  'split-window-horizontally
                'split-window-vertically)))
        (delete-other-windows)
        (let ((first-win (selected-window)))
          (funcall splitter)
          (when this-win-2nd (other-window 1))
          (set-window-buffer (selected-window) this-win-buffer)
          (set-window-buffer (next-window) next-win-buffer)
          (select-window first-win)
          (when this-win-2nd (other-window 1))))))
(define-key spw/personal-bindings-mode-map "\M-5" #'spw/toggle-frame-split)

(defun spw/maybe-toggle-split-after-resize (frame)
  (when (and (framep frame)
	     (frame-size-changed-p frame)
	     (= (count-windows nil frame) 2))
    (with-selected-frame frame
      (cl-labels ((toggleable-window-p (window)
		    (with-current-buffer (window-buffer window)
		      (not (derived-mode-p 'gnus-summary-mode))))
		  (window-info (window)
		    (and (toggleable-window-p window)
			 (cons (window-buffer window)
			       (cons (window-prev-buffers window)
				     (window-next-buffers window)))))
		  (set-window-info (window info)
		    (set-window-buffer window (car info))
		    (set-window-prev-buffers window (cadr info))
		    (set-window-next-buffers window (cddr info))))
	(when-let* ((this-info (window-info (selected-window)))
		    (next-info (window-info (next-window)))
		    (width (frame-width))
		    (this-edges (window-edges (selected-window)))
		    (next-edges (window-edges (next-window))))
	  (when (or (and (< width split-width-threshold)
			 (/= (car this-edges) (car next-edges)))
		    (and (>= width split-width-threshold)
			 (/= (cadr this-edges) (cadr next-edges))))
	    ;; Ensure we start with a fresh window.
	    (split-window)
	    (other-window 1)
	    (delete-other-windows)

	    (if (and (<= (car this-edges) (car next-edges))
		     (<= (cadr this-edges) (cadr next-edges)))
		;; Want to use `pop-to-buffer' for the second window s.t. my
		;; rule for REPLs in `display-buffer-alist' takes effect.
		(progn (set-window-info (selected-window) this-info)
		       (save-selected-window
			 (pop-to-buffer (car next-info))
			 (set-window-info (selected-window) next-info)))
	      (set-window-info (selected-window) next-info)
	      (pop-to-buffer (car this-info))
	      (set-window-info (selected-window) this-info))))))))
(add-to-list 'window-size-change-functions
	     #'spw/maybe-toggle-split-after-resize)

;; orig http://blog.gleitzman.com/post/35416335505/hunting-for-unicode-in-emacs
(defun spw/unicode-hunt ()
  "Destroy some special Unicode characters like smart quotes."
  (interactive)
  (let ((unicode-map '(("[\u2018\|\u2019\|\u201A\|\uFFFD]" . "'")
                       ("[\u201c\|\u201d\|\u201e]" . "\"")
                       ("[\u2013\|\u2014]" . "-")
                       ("\u2026" . "...")
                       ("\u00A9" . "(c)")
                       ("\u00AE" . "(r)")
                       ("\u2122" . "TM")
                       ("[\u02DC\|\u00A0]" . " "))))
    (save-excursion
      (cl-loop for (key . value) in unicode-map
            do
            (goto-char (point-min))
            (while (re-search-forward key nil t)
              (replace-match value))))))

(cl-defun spw/myrepos-global-action
    (action &optional (command (concat "mr -s " action)))
  (require 'term)
  (let ((buffer (get-buffer-create (format "*myrepos %s*" action))))
    (with-current-buffer buffer
      (term-mode)
      (setq-local revert-buffer-function
		  (lambda (&rest _ignore)
		    (spw/myrepos-global-action action command))
		  default-directory (expand-file-name "~/"))
      (term-exec buffer "mr" "sh" nil (list "-c" command))
      (let ((inhibit-read-only t)) (erase-buffer))
      ;; Work around Emacs bug#48716, which breaks mr's --minimal option.
      (term-char-mode))
    (display-buffer buffer)))
(global-set-key "\C-cgr" (lambda ()
			   (interactive)
			   (spw/myrepos-global-action
			    "status" "src-register-all && mr -ms status")))
(global-set-key "\C-cgs" (lambda ()
			   (interactive)
			   (spw/myrepos-global-action "sync")))

;; There are many variations on this online.  This one by Robert Bost, based
;; on work by Steve Yegge, Colin Doering and others
(defun spw/rotate-windows (arg)
  "Rotate your windows, reversing direction if ARG."
  (interactive "P")
  (if (not (> (count-windows) 1))
      (message "You can't rotate a single window!")
    (let* ((rotate-times (prefix-numeric-value arg))
           (direction (if (or (< rotate-times 0) (equal arg '(4)))
                          'reverse 'identity)))
      (dotimes (_ (abs rotate-times))
        (dotimes (i (- (count-windows) 1))
          (let* ((w1 (elt (funcall direction (window-list)) i))
                 (w2 (elt (funcall direction (window-list)) (+ i 1)))
                 (b1 (window-buffer w1))
                 (b2 (window-buffer w2))
                 (s1 (window-start w1))
                 (s2 (window-start w2))
                 (p1 (window-point w1))
                 (p2 (window-point w2)))
            (set-window-buffer-start-and-point w1 b2 s2 p2)
            (set-window-buffer-start-and-point w2 b1 s1 p1)))))))
;; This gets this key because we're likely to want to invoke it repeatedly.
(define-key spw/personal-bindings-mode-map "\M-6" #'spw/rotate-windows)

;; some influence here from Michael Stapelberg's config -- we both had a
;; function to do this, I discovered
(defun spw/recipient-first-name ()
  "Attempt to extract the first name of the recipient of a `message-mode' message.

Used in my `message-mode' yasnippets."
  (if-let ((to (save-excursion
		 (save-restriction
		   (message-narrow-to-headers-or-head)
		   (message-fetch-field "To")))))
      (let ((full-name (car (mail-extract-address-components to))))
	(if (string-match "\\([^ ]+\\)" full-name)
	    (let ((first-name (match-string 0 full-name)))
	      (cond
	       ;; some names which may be in a longer form in the From header
	       ;; but which I would never type out in full in a salutation
               ((string= first-name "Nathaniel") "Nathan")
               ((string= first-name "Thomas") "Tom")
               (t first-name)))
	  ;; no spaces -- assume whole thing is an alias and use it
	  full-name))
    ""))

(spw/define-skeleton spw/message-dear
    (message-mode :abbrev "dear" :file "message")
  ""
  (completing-read "Dear " (ignore-errors (list (spw/recipient-first-name))))
  '(when (setq v1 (looking-at ">")) (forward-line -2))
  "Dear " str "," \n \n
  '(when v1 (forward-line 2)))

(spw/define-skeleton spw/message-hello
    (message-mode :abbrev "hl" :file "message")
  ""
  (completing-read "Hello " (ignore-errors (list (spw/recipient-first-name))))
  '(when (setq v1 (looking-at ">")) (forward-line -2))
  "Hello " str '(when (zerop (length str)) (delete-backward-char 1)) "," \n \n
  '(when v1 (forward-line 2)))

(spw/define-skeleton spw/message-thanks
    (message-mode :abbrev "ty" :file "message")
  ""
  (completing-read "Dear " (ignore-errors (list (spw/recipient-first-name))))
  '(when (setq v1 (looking-at ">")) (forward-line -2))
  "Dear " str "," \n \n "Thank you for your e-mail." \n \n
  '(when v1 (forward-line 2)))

(defun spw/copy-to-annotated ()
  (interactive)
  (let* ((source (expand-file-name (dired-file-name-at-point)))
         (ext (file-name-extension source))
         (dest (replace-regexp-in-string
                (concat "\\." ext "$")
                (concat " - annotated." ext)
                source))
	 (dired-copy-dereference t))
    (when (and (file-exists-p source) (not (file-exists-p dest)))
      (dired-copy-file source dest nil)
      (revert-buffer)
      (dired-previous-line 1)
      (spw/dired-find-file))))

;; `debian-bug' is oriented towards reporting bugs against installed packages.
;; This function allows reporting against any suite or release, and doesn't
;; run package-specific reportbug scripts.
(defun spw/bts-submit (type package suite subject severity)
  (interactive
   (let ((type (completing-read "Report bug against: "
				'("Source" "Package") nil t)))
     (list type
	   (read-from-minibuffer
	    (format "%s package name: "
		    (pcase type ("Source" "Source") ("Package" "Binary"))))
	   (completing-read "Suite or codename (default unstable): "
			    '("experimental" "unstable" "testing"
			      "stable" "oldstable" "oldoldstable")
			    nil nil nil nil "unstable")
	   (read-from-minibuffer "Bug subject: ")
	   (completing-read "Severity (default normal): "
			    '("critical" "grave" "serious"
			      "important" "normal" "minor" "wishlist")
			    nil t nil nil "normal"))))
  (let* ((rmadison (shell-command-to-string
		    (format "rmadison --suite=%s %s" suite package)))
         (version (nth 1 (split-string rmadison "|" t "[[:blank:]]+"))))
    (compose-mail "Debian Bug Tracking System <submit@bugs.debian.org>"
		  (format "%s: %s" package subject))
    (insert
     (format "%s: %s\nVersion: %s%s\n\nDear maintainer,\n\n"
	     type package version (if (string= severity "normal") ""
				    (format "\nSeverity: %s" severity))))))

(defun spw/use-tabs-not-frames (&optional frame)
  "Whether to pop up new tabs instead of new frames.
Should be t when do not have a good way to handle having lots of open
frames, as I do have under i3/swaywm with its tabbed layout, which is my
default layout."
  (not (and spw/tiling-wm-p
	    (memq (framep (or frame (selected-frame))) '(x pgtk)))))

(defun spw/save-buffer-for-later ()
  (interactive)
  (if (spw/use-tabs-not-frames)
      (call-interactively #'spw/save-buffer-to-tab-for-later)
    (call-interactively #'spw/save-buffer-to-frame-for-later)))

;; possibly we want to set the window of the new frame to be dedicated to this
;; buffer, to prevent it being reused to display something else, thus sending
;; the buffer we wanted to save off down the buffer list
(defun spw/save-buffer-to-frame-for-later (buffer &optional rename)
  (interactive (list (current-buffer) current-prefix-arg))
  (let ((frame (selected-frame))
	(display-buffer-overriding-action '((display-buffer-pop-up-frame)
					    (inhibit-same-window . t))))
    (save-selected-window
      (display-buffer (spw/maybe-clone-buffer buffer rename)))
    (raise-frame frame)
    (when rename
      (switch-to-buffer (other-buffer) nil t))))

(defun spw/maybe-clone-buffer (buffer rename)
  (with-current-buffer buffer
    (cond
     ((buffer-file-name)
      ;; file-visiting buffers we don't clone, even indirectly, as that is
      ;; rarely what's wanted; should explicitly request an indirect clone
      buffer)
     (rename
      (rename-uniquely)
      buffer)
     (t
      (clone-buffer)))))

;; Clone buffer is for when we want to have two versions of the buffer with
;; different contents; using it does not imply that we want to prevent either
;; buffer's contents from being overwritten by, e.g., calling `compile' again
;; in a different source tree or navigating to a different Info node, nor that
;; we particularly want to avoid either buffer sinking down the buffer list
;; and being forgotten
;; (global-set-key "\C-cnn" #'clone-buffer)  ;; now on C-x x n

;; In this case, by contrast, we're saying that we want two versions of the
;; buffer specifically because (i) we don't want the buffer contents to be
;; overwritten by, e.g., calling `compile' again or navigating to a different
;; web page; and/or (ii) we want to be reminded to come back to (a particular
;; point in) the buffer by giving it its own frame or tab, in a way that's
;; lightweight and doesn't involve adding TODO entries
(global-set-key "\C-cS" #'spw/save-buffer-for-later)
;; (global-set-key "\C-cns" #'spw/save-buffer-for-later)

;; Finally, this is for when we just want to protect the buffer contents from
;; being overwritten and nothing more
;; (global-set-key "\C-cnr" #'rename-uniquely) ;; now on C-x x u

(defun spw/set-other-window-to-scroll (arg)
  "Set `other-window-scroll-buffer' to the most recently used window.
Single prefix argument to clear."
  ;; possibly we want to do other things with multiple C-u in the future
  (interactive "P")
  (if arg
      (kill-local-variable 'other-window-scroll-buffer)
    (setq-local other-window-scroll-buffer
		(window-buffer (spw/get-mru-window)))
    (message "C-M-v will scroll %s" (window-buffer (get-mru-window)))))
(global-set-key "\C-cV" #'spw/set-other-window-to-scroll)

(defun spw/update-environment (&rest pairs)
  "Update env vars like DISPLAY, SSH_AUTH_SOCK etc.
Called by '~/src/dotfiles/bin/emacsclient --spw/update-environment'."
  (cl-flet ((set-all ()
	      (cl-loop for (var val) on pairs by #'cddr do (setenv var val))))
    (with-current-buffer (get-buffer-create "*scratch*") (set-all))
    (let ((slime-connections (and (bound-and-true-p slime-default-connection)
				  (list slime-default-connection)))
	  (cl-form `(cl:handler-case (cl:require "ASDF")
   		      (cl:error ())
		      (:no-error (r)
		        (cl:declare (cl:ignore r))
			. ,(cl-loop for (var val) on pairs by #'cddr collect
				    `(cl:setf (uiop:getenv ,var) ,val))))))
      (dolist (buffer (buffer-list))
	(with-current-buffer buffer
	  (cond ((eq major-mode 'eshell-mode) (set-all))
		((bound-and-true-p slime-buffer-connection)
		 (cl-pushnew slime-buffer-connection slime-connections)))))
      (dolist (connection slime-connections)
	(let ((slime-dispatching-connection connection))
	  (slime-eval cl-form))))))

(defun spw/daemon-pid (&optional name)
  ;; We don't use `server-eval-at' because perhaps we are trying to attach gdb
  ;; to a wedged Emacs.
  (let ((socket (file-name-concat server-socket-dir (or name "server"))))
    (and (file-exists-p socket)
	 (cl-loop
	  with min and min-age
	  for line in (process-lines "ss" "-Hplx" "src" socket)
	  for pid = (if (string-match "pid=\\([[:digit:]]+\\)" line)
			(match-string 1 line)
		      (error "Unexpected output from ss(8)"))
	  for age = (string-to-number
		     (or (car (process-lines "ps" "h" "-o" "etimes" pid))
			 (error "Couldn't find age of process %s" pid)))
	  when (or (not min-age) (< age min-age))
	  do (setq min (string-to-number pid) min-age age)
	  finally return min))))

(defvar-local spw/gdbmacs-target-pid nil)
(defvar-local spw/gdbmacs-target-name nil)

(defun spw/gdbmacs-attach (&optional name)
  (require 'gdb-mi)
  (let (pid
	(arg (if name (concat "--fg-daemon=" name) "--fg-daemon"))
	(proc (get-buffer-process gud-comint-buffer)))
    (when (and proc (string= gdb-inferior-status "signal-received"))
      ;; Avoid wiping out useful info.
      (error "Possibly Emacs just crashed; not attaching for now"))
    ;; Don't interrupt non-gdb usage of gdbmacs just because the primary
    ;; daemon prints to stdout.  It's often just "Reverting buffer ‘foo.org’".
    (setopt gdb-display-io-nopopup t)
    (cl-flet ((run-or-continue ()
		(gdb-wait-for-pending
		 (lambda ()
		   (with-current-buffer gud-comint-buffer
		     (setq spw/gdbmacs-target-pid pid
			   spw/gdbmacs-target-name name))
		   (if pid
		       (gud-basic-call "continue")
		     (gud-basic-call "set cwd ~")
		     (gdb-wait-for-pending
		      (lambda () (gud-basic-call "run"))))))))
      (gdb-wait-for-pending
       (if (and proc
		;; Check it looks safe to re-use existing gdb process.
		(string-prefix-p "exited" gdb-inferior-status)
		(file-in-directory-p
		 (buffer-local-value 'default-directory gud-comint-buffer)
		 (expand-file-name "~/src/emacs/primary/")))
	   (lambda ()
	     (gud-basic-call (if (setq pid (spw/daemon-pid name))
				 (format "attach %d" pid)
			       (format "set args %s" arg)))
	     (run-or-continue))
	 ;; Start up a new process.
	 (lambda ()
	   (when (buffer-live-p gud-comint-buffer)
	     (when proc (set-process-query-on-exit-flag proc nil))
	     (kill-buffer gud-comint-buffer))
	   (gdb-wait-for-pending
	    (lambda ()
	      (let ((default-directory
		     (expand-file-name "~/src/emacs/primary/"))
		    (gdb-debuginfod-enable-setting
		     (if (eq gdb-debuginfod-enable-setting 'ask)
			 nil
		       gdb-debuginfod-enable-setting)))
		(gdb (if (setq pid (spw/daemon-pid name))
			 (format "gdb -i=mi --pid=%d src/emacs" pid)
		       (format "gdb -i=mi --args src/emacs %s" arg))))
	      (run-or-continue)))))))))

;; C-c C-z to attempt to return control to the debugger.
;;
;; In the --fg-daemon case, AIUI we are here working around this:
;;     <https://lwn.net/Articles/909496/>.
(defun spw/comint-stop-subjob (orig-fun)
  (if-let ((pid (or spw/gdbmacs-target-pid
		    (setq spw/gdbmacs-target-pid
			  (spw/daemon-pid spw/gdbmacs-target-name)))))
      (signal-process pid 'SIGTSTP)
    (funcall orig-fun)))
(advice-add 'comint-stop-subjob :around #'spw/comint-stop-subjob)

;; flock(1) starting daemons named the same as us so that instances of my
;; emacsclient(1) wrapper wait on us completing our exit before trying to
;; start us again.
(defun spw/daemon-lock-self ()
  (when (and (daemonp) (executable-find "flock") (executable-find "sleep"))
    (let ((file
	   (file-name-concat
	    (or (getenv "XDG_RUNTIME_DIR") (format "/run/user/%d" (user-uid)))
	    "spw_emacsclient"
	    (cl-etypecase (daemonp) (string (daemonp)) (t "server")))))
      (set-process-query-on-exit-flag
       (start-process "spw_emacsclient" nil
		      "flock" "-E" "0" "-n" file "sleep" "20")
       nil))))
(when (fboundp 'file-name-concat)	; for Emacs 27 compat
  (add-hook 'kill-emacs-hook #'spw/daemon-lock-self -99))

(defun spw/may-pass-to-gdbmacs-p ()
  (and (display-graphic-p)
       (not (string= (daemonp) "gdbmacs"))
       (eq (server-running-p "gdbmacs") t)))

;; open a frame on a new workspace with only the relevant dired buffer open,
;; eval this form: (global-set-key "\C-cG" #'spw/grading-advance)
;; and then use C-c G to open the first item (will need C-c f t after just
;; this first one, and also maybe C-i =)
(defun spw/grading-advance ()
  (interactive)
  (unless (eq major-mode 'dired-mode)
    (when (eq major-mode 'org-mode)
      (ignore-errors (org-ctrl-c-ctrl-c)))
    (save-buffer)
    (other-window 1))
  (dired-display-file)
  (dired-next-line 1)
  (let ((pdf (dired-get-filename)))
    (dired-next-line 1)
    (other-window 1)
    (goto-char (point-min))

    ;; assignment-specific
    (search-forward "Grammar")
    (org-cycle)
    (set-goal-column nil)
    ;; (overwrite-mode 1)

    (start-process "pdf" "pdf" "xdg-open" pdf)
    (sleep-for 1)
    (call-process-shell-command
     (concat (if (executable-find "i3-msg") "i3-msg" "swaymsg")
	     " move right"))
    (let ((pdf-words (substring (with-temp-buffer
				  (call-process-shell-command
				   (concat "pdftotext "
					   (shell-quote-argument pdf)
					   " - | wc -w")
				   nil
				   (current-buffer))
				  (buffer-string))
				0
				-1)))
      (message (concat pdf-words " words")))))

(defun spw/untabify-project ()
  (interactive)
  (save-window-excursion
    (dolist (file (project-files
		   (project-current nil (project-prompt-project-dir))))

      (find-file file)
      (untabify (point-min) (point-max)))))

(defun spw/go-to-consfig ()
  (interactive)
  ;; (let ((repo (expand-file-name "~/src/cl/consfig")))
  ;;   (unless (file-directory-p repo)
  ;;     (user-error "Consfig git repo not found"))
  ;;   (dired repo))
  (cl-flet ((load ()
              (slime-load-system "com.silentflame.consfig")
              (spw/add-once-hook
               'slime-compilation-finished-hook
               (lambda (notes)
		 ;; see `slime-maybe-show-compilation-log'
                 (unless (memq 'slime-maybe-show-compilation-log
			       slime-compilation-finished-hook)
                   (slime-create-compilation-log notes))
                 (when (slime-compilation-result.successp
			slime-last-compilation-result)
		   (slime-change-directory (expand-file-name "~/"))
                   (slime-repl-set-package "COM.SILENTFLAME.CONSFIG"))))))
    (if (ignore-errors (slime-output-buffer))
	(progn (slime-switch-to-output-buffer)
	       (setq-local default-directory (expand-file-name "~/"))
	       (load))
      (let ((default-directory (expand-file-name "~/"))) (slime))
      (spw/add-once-hook 'slime-connected-hook #'load))))
(global-set-key "\C-cgc" #'spw/go-to-consfig)

(defun spw/go-to-cl-user ()
  (interactive)
  (if (not (ignore-errors (slime-output-buffer)))
      (let ((default-directory (expand-file-name "~/")))
	(slime))
    (slime-switch-to-output-buffer)
    (slime-repl-set-package "CL-USER")))
(global-set-key "\C-cgl" #'spw/go-to-cl-user)

;; These configure flags are for my workstation development builds.  We do not
;; have --with-native-compilation at present for the following reasons:
;;
;; - it results in laptop churning away natively compiling all installed
;;   addons when it may very well be on battery power, even if it was plugged
;;   in for the build;
;;
;; - it makes bootstrap builds very slow, though there is work going on to
;;   improve that; and
;;
;; - Emacs's Makefile rules for the .eln files are as yet somewhat flaky,
;;   meaning that they don't always get recompiled when they need to.
;;
;; The configure flags in "confmacs0" are for when I am actively debugging
;; Emacs.  The flags in "confmacsg" are for day-to-day use, where I still want
;; some debugging information available in case of an unexpected crash.  The
;; flags in "confmacs0" are recommended by etc/DEBUG, but other than
;; --enable-check-lisp-object-type, they do noticeably slow Emacs down,
;; especially Icomplete, and most of the time I'm working either on things
;; other than Emacs or on Emacs at the Lisp level.  "confmacsg" seems to be
;; acceptably fast, and using these abbrevs to reconfigue and rebuild Emacs's
;; C core back and forth is quick (the .elc stick around).
;;
;; We don't append "&& make" to the abbrev because I use 'C-x p c' to build.
;;
;; Order the flags such that ones I'm more likely to want to manually edit or
;; remove for a particular build come later in the list.  In particular, have
;; --enable-check-lisp-object-type come last in the abbrev expansions because
;; we sometimes need to quickly reconfigure without it, such that Lisp objects
;; aren't structs and can be used in break point conditions.
;;
;; Delete the cache each time because we're often changing CFLAGS.  It's still
;; worth passing -C because configure often gets rerun by the Makefile when I
;; rebase onto origin/master -- there is no --disable-maintainer-mode.
(with-eval-after-load 'esh-mode
  (dolist (conf '(("confmacs0"
		   "--with-pgtk" "--without-native-compilation"
		   "--enable-checking='yes,glyphs'"
		   "CFLAGS='-O0 -g3'"
		   "--enable-check-lisp-object-type")
		  ("confmacsg"
		   "--with-pgtk" "--without-native-compilation"
		   "--enable-checking='yes,glyphs'"
		   "CFLAGS='-Og -g3'"
		   "--enable-check-lisp-object-type")))
    (define-abbrev eshell-mode-abbrev-table (car conf)
      (string-join (cons "rm -f config.cache; ./configure -C" (cdr conf)) " ")
      nil :system t)))

(defun spw/read-athenet-lxc ()
  (let (lxcs
	(file (expand-file-name "~/src/cl/consfig/hosts.lisp")))
    (unless (file-exists-p file)
      (user-error "Looks like consfig not checked out"))
    (with-current-buffer (find-file-noselect file)
      (save-excursion
	(save-restriction
	  (widen)
	  (goto-char (point-min))
	  (while (re-search-forward
		  "(define-athenet-container \\([a-z0-9-.]+\\)
\\s-*\"\\([a-z0-9-.]+\\)"
		  nil t)
	    (push (list (substring-no-properties (match-string 1))
			(substring-no-properties (match-string 2)))
		  lxcs)))))
    (assoc (completing-read "LXC: " lxcs nil t) lxcs #'string=)))

(defun spw/ssh-and-lxc-attach-term (container host)
  (interactive (spw/read-athenet-lxc))
  (start-process "ssh-and-tmux" nil "foot" "ssh-and-tmux" host
		 (format "--container-name=%s" container)
"--container-cmd=lxc-unpriv-attach -n %s --keep-var TERM --clear-env -vHOME=/root"))
(global-set-key "\C-cgL" #'spw/ssh-and-lxc-attach-term)

(defun spw/proced-root ()
  (interactive)
  (require 'proced)
  (let ((default-directory "/sudo::")
	(proced-show-remote-processes t)
	(buffer (get-buffer "*Proced root*")))
    (if buffer (pop-to-buffer buffer)
      (proced)
      (rename-buffer "*Proced root*")
      (proced-filter-interactive 'all))))
(global-set-key "\C-cgt" #'proced)
(global-set-key "\C-cga" #'spw/proced-root)

(defun spw/copy-to-scratch ()
  (interactive)
  (if (char-equal (char-after) ?\()
      (let ((form (buffer-substring (point)
				    (save-excursion (forward-sexp) (point)))))
	(scratch-buffer)
	(unless (and (bolp) (eolp) (looking-back "\n\n"))
	  (goto-char (point-at-eol))
	  (newline 2))
	(insert form)
	;; Move so as to be ready for editing, rather than immediate C-x C-e.
	(down-list -1))
    (user-error "Not at beginning of a sexp")))
(define-key spw/ctl-z-map "l" #'spw/copy-to-scratch)

(defun spw/org-title ()
  (interactive)
  (goto-char (point-min))
  (if (search-forward "#+title: " nil t)
      (move-end-of-line 1)
    (unless (eolp) (open-line 1))
    (insert "#+title: ")))
(spw/feature-define-keys org "\C-z\C-t" spw/org-title)

(defun spw/check-debian-upstream-merge ()
  "Verify a sponsee's Git merge of a new upstream release."
  (interactive)
  (if-let ((merge (log-view-current-tag)))
      (cl-flet ((no-diff-p (&rest args)
		  (zerop (apply #'call-process "git" nil nil nil
				"diff" "--exit-code" args))))
	(message
	 (if (no-diff-p (format "%1$s^..%1$s" merge) "--" "debian" )
	     (if (no-diff-p (format "%1$s^2..%1$s" merge) "--"  ":!debian")
		 "Merge seems correct"
	       "Unexpected upstream changes; no packaging changes")
	   "Unexpected packaging changes; haven't checked upstream import")))
    (user-error "No commit at point")))

;; Supports only a single debugging session per Emacs instance.
;; One reason for this is that GUD doesn't expose its logic for finding the
;; GUD buffer debugging a given program, nor really for determining which
;; debugger (gdb, perldb, ..) is being run.
;;
;; Does not support hiding GUD's window(s).  Just use C-x 1 from the source
;; buffer.  Then invoke this command to bring GUD's window(s) back.
;;
;; The idea is to have a one Emacs frame/tab for source editing, from which
;; `compile' or `project-compile' is called, and one Emacs frame/tab for GUD.
(defun spw/run-or-restore-gud (arg)
  (interactive "P")
  (require 'gdb-mi)
  (if (or arg (not (and (bound-and-true-p gud-comint-buffer)
			(get-buffer-process gud-comint-buffer))))
      ;; Start a new debugging session even if one already exists.
      ;; Killing `gud-comint-buffer' is the documented way to quit an
      ;; existing session.
      (let* ((cmd (cl-case major-mode
		    (c-mode 'gdb) (cperl-mode 'perldb) (python-mode 'pdb)
		    (t (intern (completing-read "GUD command: "
						'(gdb perldb pdb) nil t)))))
	     (args
	      (advice-eval-interactive-spec (cadr (interactive-form cmd)))))
	(when (buffer-live-p gud-comint-buffer)
	  (when-let ((proc (get-buffer-process gud-comint-buffer)))
	    (set-process-query-on-exit-flag proc nil))
	  (kill-buffer gud-comint-buffer))
	(gdb-wait-for-pending (lambda () (apply cmd args))))
    ;; Restore the session.
    (cl-case (buffer-local-value 'gud-minor-mode gud-comint-buffer)
      (gdbmi (gdb-restore-windows)
	     ;; Try to ensure prompt is at the bottom of its window.
	     (recenter (window-body-height)))
      (t (pop-to-buffer gud-comint-buffer)))))
(global-set-key "\C-cgd" #'spw/run-or-restore-gud)

(defun spw/fill-rest-of-paragraph ()
  (interactive)
  (let ((string (ignore-errors (cdr (bounds-of-thing-at-point 'string)))))
    (fill-region-as-paragraph
     (car (bounds-of-thing-at-point 'sentence))
     (cond (string (min string (cdr (bounds-of-thing-at-point 'paragraph))))
	   ((cl-fifth (syntax-ppss))
	    (min (cdr (bounds-of-thing-at-point 'paragraph))
		 (progn
		   ;; Move to last line of comment or first non-comment line.
		   (while (cl-fifth (syntax-ppss (pos-eol 2))))
		   (if (save-excursion
			 (and (cl-fifth (syntax-ppss (1- (point))))
			      (re-search-backward "\\w" (pos-bol) t)))
		       ;; At end of e.g. a GNU-style C comment.
		       (point)
		     ;; At the end of e.g. a Linux-style C comment, or on the
		     ;; first line after e.g. a shell script comment.
		     (pos-eol 0)))))
	   (t (cdr (bounds-of-thing-at-point 'paragraph))))))
  (when (bolp)
    (backward-char 1)
    (skip-syntax-backward "\"")))
(global-set-key "\C-cq" #'fill-region-as-paragraph)
(global-set-key "\C-ce" #'spw/fill-rest-of-paragraph)
(global-set-key "\C-cj" "\M-j\C-ce")


;;;; Terminal emulation

;;; Make C-c and C-z escape chars too.  In particular, this ensures that have
;;; to hit C-c twice to actually SIGINT something, like in Eshell.  C-d still
;;; requires pressing just once because that's how it is in `term-line-mode'.

(defvar spw/term-raw-ctl-c-escape-map)
(defvar spw/term-raw-ctl-z-escape-map)

(with-eval-after-load 'term
  (term-set-escape-char ?\C-x)

  ;; Copy so as to include the other `term-raw-escape-map' bindings, e.g. M-x.

  (setq spw/term-raw-ctl-c-escape-map (copy-keymap term-raw-escape-map))
  (set-keymap-parent spw/term-raw-ctl-c-escape-map mode-specific-map)
  (define-key spw/term-raw-ctl-c-escape-map "\C-c" #'term-send-raw)
  (define-key term-raw-map "\C-c" spw/term-raw-ctl-c-escape-map)

  (setq spw/term-raw-ctl-z-escape-map (copy-keymap term-raw-escape-map))
  (set-keymap-parent spw/term-raw-ctl-z-escape-map spw/ctl-z-map)
  (define-key spw/term-raw-ctl-z-escape-map "\C-z" #'term-send-raw)
  (define-key term-raw-map "\C-z" spw/term-raw-ctl-z-escape-map))


;;;; Composing mail

(custom-theme-set-variables
 'user
 ;; So locmaint will catch them.
 '(message-auto-save-directory "~/tmp/")

 '(message-citation-line-format "On %a %d %b %Y at %I:%M%p %Z, %N wrote:\12")
 '(message-citation-line-function 'message-insert-formatted-citation-line)

 ;; For compatibility.
 '(message-forward-as-mime nil)
 '(message-forward-before-signature nil)
 '(message-forward-included-headers
   '("^From:" "^Subject:" "^Date:" "^To:" "^Cc:" "^Message-ID:"))
 '(message-make-forward-subject-function '(message-forward-subject-fwd))

 '(message-ignored-resent-headers
   "^Return-receipt\\|^X-Gnus\\|^Gnus-Warning:\\|^>?From \\|^Delivered-To:\\|^\\(?:X-\\)?Content-Length:\\|^X-UIDL:\\|^X-TUID:\\|^\\(?:X-\\)?Status:\\|^Lines:")

 ;; Bypass MTA rewriting user@localhost.
 '(message-sendmail-envelope-from 'header)

 '(message-wash-forwarded-subjects t)
 '(mm-decrypt-option 'known)
 '(mm-default-directory "~/tmp/")
 '(mm-file-name-rewrite-functions
   '(mm-file-name-delete-control mm-file-name-delete-gotchas
				 mm-file-name-trim-whitespace
				 mm-file-name-collapse-whitespace
				 mm-file-name-replace-whitespace))

 ;; So I can read copies in my sent mail directory.
 '(mml-secure-openpgp-encrypt-to-self t)

 '(mml-secure-openpgp-sign-with-sender t)
 '(nnmail-extra-headers '(To Cc List-Id))
 '(notmuch-address-use-company nil))

(defvar spw/debian-bts-pseudoheader-regexp
  ;; "^\\([A-Za-z][a-z]+: [^ ]+\\|[cC]ontrol: .+\\)$"
  "^[A-Za-z][a-z]+: [^ ]+"
  "Regexp matching Debian BTS pseudoheaders.")
(defvar-local spw/message-normalised nil
  "Whether `spw/message-normalise' has been run in this buffer.")

(defun spw/unfinalise-message ()
  (interactive)
  (setq spw/message-normalised nil)
  (message "Message marked as not ready to send"))

(defun spw/normalise-message (arg)
  "Auto-format a message; to be used just prior to sending it.

The state after this function has been called is meant to be like
mutt's review view, after exiting EDITOR."
  (interactive "P")
  (message-templ-config-exec)
  (save-excursion
    (spw/message-goto-body)
    ;; also skip over Debian BTS pseudoheaders, which shouldn't be touched
    (when (looking-at spw/debian-bts-pseudoheader-regexp)
      (cl-loop do (forward-line 1)
	    while (looking-at spw/debian-bts-pseudoheader-regexp))
      (if (looking-at "\n")
	  (forward-line 1)
	(insert "\n")))
    (let ((body (point)))
      ;; add blank lines between quoted and unquoted text
      (while (not (eobp))
	(when (looking-at
	       "\\(^>[^\n]+\n\\{1\\}[^>\n]\\|^[^>\n][^\n]*\n>\\)")
	  (forward-line 1)
	  (open-line 1))
	(forward-line 1))
      (goto-char body)
      ;; ensure there is at least a basic salutation
      (unless (looking-at "^[A-Z].+,\n\n")
	(insert "Hello,\n\n"))
      (message-goto-signature)
      (unless (eobp) (end-of-line -1))
      ;; delete trailing whitespace in message body, when that message body
      ;; exists (this protects signature dashes and empty headers)
      (when (< body (point))
        (delete-trailing-whitespace body (point)))
      ;; make any remaining trailing whitespace visible to the user
      (setq-local show-trailing-whitespace t)
      ;; ensure there is a newline before the signature dashes
      (unless (bolp)
	(insert "\n"))))
  (spw/compact-blank-lines)
  (undo-boundary)
  ;; (when arg
  ;;   (save-excursion
  ;; 	(save-restriction
  ;;       (narrow-to-region body (point))
  ;;       (message-fill-yanked-message)))
  ;;   (message "Hit undo if the quoted message was too aggressively wrapped"))
  (if arg
      (message "Normalised but not marked ready to send")
    (setq spw/message-normalised t)))

(defun spw/message-kill-and-normalise (arg)
  (interactive "P")
  (newline)
  (message-kill-to-signature)
  (spw/normalise-message arg))

(defun spw/message-send-and-exit ()
  (interactive)
  (when (or spw/message-normalised
	    (y-or-n-p "Send message which has not been marked ready?"))
    (call-interactively #'message-send-and-exit)))

(defun spw/message-maybe-sign ()
  ;; no PGP signing on athena
  (unless (spw/on-host-p "athena.silentflame.com")
    ;; avoid clobbering a 'signencrypt' tag added when replying to an
    ;; encrypted message
    (if (mml-secure-is-encrypted-p)
        (mml-secure-message-sign-encrypt)
      (mml-secure-message-sign-pgpmime))))

;; for interactive use this is more useful than `message-goto-body' (we don't
;; want to advise the latter because functions like
;; `notmuch-mua-check-no-misplaced-secure-tag' use it)
(defun spw/message-goto-body ()
  (interactive)
  (message-goto-body)
  (when (looking-at "^<#\\(secure\\|part\\) ") (forward-line 1))
  (point))

;; Michael Stapelberg points out that for most purposes
;; `mail-add-attachment' suffices and requires less typing than
;; `mml-attach-file', so use it by default, and gather attachments together
;; at the end of the message
(defun spw/message-add-attachment ()
  (interactive)
  (require 'sendmail)
  (save-excursion
    (goto-char (point-max))
    (terpri (current-buffer) t)
    (call-interactively #'mail-add-attachment)))

(defun spw/message-newline-and-reformat (arg)
  "Like `message-newline-and-reformat', but remove unneeded lines."
  (interactive "P")
  (with-undo-amalgamate
    (message-newline-and-reformat arg)
    (let ((re (concat message-cite-prefix-regexp "\\s-*$")))
      (save-excursion
	(forward-line -2)
	(while (looking-at re)
	  (delete-region (point) (1+ (line-end-position)))
	  (beginning-of-line 0)))
      (save-excursion
	(forward-line 2)
	(while (looking-at re)
	  (delete-region (point) (1+ (line-end-position))))))))

;; `message-ignored-resent-headers' removes X-TUID, but we want to remove
;; User-Agent & Date only when we're editing the message to be resent; I use
;; `gnus-summary-resend-message-edit' only for composing mail using an old
;; message as a template ("edit as new"), not actually editing and resending.
(defun spw/gnus-summary-resend-message-edit ()
  (message-remove-header "^Date:\\|^User-Agent:" t))
(advice-add 'gnus-summary-resend-message-edit
	    :after #'spw/gnus-summary-resend-message-edit)

;; Also cf. `message-reduce-to-to-cc'.
(defun spw/message-merge-To-Cc ()
  (interactive)
  (let ((new (save-excursion
	       (save-restriction
		 (message-narrow-to-headers-or-head)
		 (format "%s, %s"
			 (message-fetch-field "to")
			 (message-fetch-field "cc"))))))
    (message-replace-header "To" new)
    (message-remove-header "Cc")))

(spw/macroexp-for (cmd)
    (compose-mail compose-mail-other-window compose-mail-other-frame
		  mailscripts-prepare-patch
		  mailscripts-git-format-patch-attach
		  bongo-playlist)
  (let ((new (intern (concat "spw/" (symbol-name cmd)))))
    `(progn (defun ,new (&rest args)
	      ,(interactive-form cmd)
	      (if (spw/may-pass-to-gdbmacs-p)
		  (ignore-error server-return-invalid-read-syntax
		    (server-eval-at
		     "gdbmacs"
		     `(with-selected-frame
			  (make-frame '((display
					 . ,(frame-parameter nil 'display))))
			(let ((default-directory ,default-directory)
			      (current-prefix-arg ',current-prefix-arg)
			      (display-buffer-overriding-action
			       '(display-buffer-same-window
				 (inhibit-same-window . nil))))
			  (apply #',',cmd ',args)))))
		(apply #',cmd args)))
	    (global-set-key [remap ,cmd] #',new))))

(with-eval-after-load 'message
  (spw/when-library-available message-templ
    (define-key message-mode-map [f7] #'spw/unfinalise-message)
    (define-key message-mode-map "\C-z\C-u"  #'spw/unfinalise-message)
    (define-key message-mode-map [f8] #'spw/normalise-message)
    (define-key message-mode-map "\C-z\C-c"  #'spw/normalise-message)
    (define-key message-mode-map [f9] #'spw/message-kill-and-normalise)
    (define-key message-mode-map "\C-z\C-v"  #'spw/message-kill-and-normalise))

  (define-key message-mode-map
      [remap message-goto-body] #'spw/message-goto-body)
  (define-key message-mode-map "\C-c\C-s" #'message-goto-subject)
  (define-key message-mode-map "\C-c\C-fm" #'spw/message-merge-To-Cc)

  (define-key message-mode-map
      [remap mml-attach-file] #'spw/message-add-attachment)

  ;; This relies on user.primary_email, user.other_email notmuch config keys.
  (spw/when-library-available notmuch-address
    (require 'notmuch-address) (notmuch-address-setup))

  (add-hook 'message-mode-hook #'footnote-mode)

  (define-key message-mode-map
      [remap message-newline-and-reformat] #'spw/message-newline-and-reformat)

  (define-key message-mode-map
	      [remap message-send-and-exit] #'spw/message-send-and-exit)

  (add-hook 'message-sent-hook #'gnus-score-followup-article))


;;;; Dired

(custom-theme-set-variables
 'user
 '(dired-clean-up-buffers-too nil)
 '(dired-dwim-target t)
 '(dired-free-space 'separate)
 '(dired-isearch-filenames t)
 '(dired-listing-switches "--group-directories-first -alh")
 '(dired-omit-files "\\`[.]?#\\|\\`[.][.]?\\'\\|\\`\\.git\\'")
 '(dired-recursive-copies 'always))

;; this is the way you're meant to request dired-aux, not just dired-x,
;; according to (info "(dired-x) Installation")
(with-eval-after-load 'dired (require 'dired-x))

;; docs say to use:
;;     (add-hook 'dired-mode-hook (lambda () (dired-omit-mode 1)))
;; however the following ensures that inserted subdirs also get omitted:
(setq-default dired-omit-mode t)

(add-hook 'dired-mode-hook #'turn-on-gnus-dired-mode)

(spw/when-library-available git-annex
  ;; can't wrap this in a `with-eval-after-load' for dired because want it to
  ;; go ahead and advise `read-only-mode'
  (require 'git-annex))

(defun spw/dired-copy-filename-as-kill (&optional arg)
  (interactive "P")
  (let* ((subdir (dired-get-subdir))
	 (files
          ;; We treat as primary the meanings of the prefix argument to
	  ;; `dired-copy-filename-as-kill', then try to call `spw/eshell-jump'
	  ;; in a way that corresponds.  Thus, there isn't a way to express a
	  ;; prefix argument to 'M-&', but can use, e.g., C-u C-u M-& C-x o &.
	  ;; (It wouldn't make sense to pass a prefix argument to 'M-!').
	  ;;
	  ;; Invoking with '!', and no prefix argument, is a shortcut for
	  ;; copying absolute paths, and behaving more like 'M-!' than 'M-&'.
	  (cond (subdir
		 (spw/eshell-jump)
		 (ensure-list subdir))
		((if arg
		     (zerop (prefix-numeric-value arg))
		   (char-equal last-command-event ?!))
		 (prog1 (dired-get-marked-files) (spw/eshell-jump)))
                ((consp arg)
                 (prog1 (dired-get-marked-files t)
		   (spw/eshell-jump 'strict)))
                (t
                 (prog1 (dired-get-marked-files
			 'no-dir (and arg (prefix-numeric-value arg)))
		   (spw/eshell-jump t)))))
         (string
          (mapconcat (lambda (file)
                       (if (string-match-p "[ \"']" file)
                           (format "%S" file)
                         file))
                     files
                     " ")))
    (unless (string-empty-p string)
      (let ((empty-p (= eshell-last-output-end (point-max))))
	;; If we're somewhere else in the buffer, jump to the end.
	;; This means that if you want to insert the filenames into an old
	;; command you're editing, you have to C-c RET first.
	(when (> eshell-last-output-end (point))
	  (goto-char (point-max)))
	(save-restriction
	  (when (= eshell-last-output-end (point))
	    (narrow-to-region (point) (point-max)))
	  (just-one-space))
	(insert string)
	(just-one-space)
	(when empty-p
	  (goto-char eshell-last-output-end)
	  ;; (when-let* ((default (dired-guess-default files)))
	  ;;   (if (listp default)
	  ;; 	(let ((completion-at-point-functions
	  ;; 	       (list (lambda () (list (point) (point) default)))))
	  ;; 	  (completion-at-point))
	  ;;     (insert default)))
	  )))))
(spw/feature-define-keys dired
  "!" #'spw/dired-copy-filename-as-kill
  "&" #'spw/dired-copy-filename-as-kill)


;;;; EWW

;; this should ensure that M-a and M-e work for most webpages
(add-hook 'eww-mode-hook (lambda ()
			   (setq-local sentence-end-double-space nil)))

;; eww bookmarks don't have short names associated to them, just page titles,
;; so for places we visit a lot the normal bookmarks system seems more
;; appropriate.  adapted from bookmark-w3m.el.

(defun spw/bookmark-eww-bookmark-make-record ()
  "Make an Emacs bookmark entry for an Eww buffer."
  `(,(plist-get eww-data :title)
    ,@(bookmark-make-record-default 'no-file)
    (url . ,(eww-current-url))
    (handler . spw/bookmark-eww-bookmark-jump)
    (defaults . (,(plist-get eww-data :title)))))

(defun spw/bookmark-eww-bookmark-jump (bookmark)
  (eww (bookmark-prop-get bookmark 'url))
  (bookmark-default-handler
   `(""
     (buffer . ,(current-buffer))
     . ,(bookmark-get-bookmark-record bookmark))))

(add-hook 'eww-mode-hook
	  (lambda ()
	    (setq-local bookmark-make-record-function
			#'spw/bookmark-eww-bookmark-make-record)))


;;;; Gnus

(custom-theme-set-variables
 'user
 '(gnus-article-skip-boring t)
 '(gnus-auto-center-summary nil)
 '(gnus-auto-select-next 'slightly-quietly)
 '(gnus-buttonized-mime-types
   '("text/x-\\(?:diff\\|patch\\)" "multipart/\\(?:alternative\\|signed\\)"))
 '(gnus-directory "~/local/News/")
 '(gnus-extra-headers '(To Cc List-Id))
 '(gnus-gcc-mark-as-read t)
 '(gnus-global-score-files '("~/doc/News/"))
 '(gnus-interactive-exit 'quiet)
 '(gnus-kill-files-directory "~/src/athpriv/News/")

 ;; Would prefer nil but t seems advisable for notmuch groups.
 '(gnus-kill-summary-on-exit t)

 '(gnus-large-ephemeral-newsgroup 8000)
 '(gnus-large-newsgroup 8000)
 '(gnus-mark-article-hook '(spw/gnus-mark-article-hook))
 '(gnus-message-archive-group "sent")
 '(gnus-message-archive-method '(nnmaildir "fmail" (directory "~/.fmail/")))
 '(gnus-permanently-visible-groups "^nnmaildir\\+fmail:\\(?:notes\\|sent\\)$")
 '(gnus-read-newsrc-file nil)
 '(gnus-refer-thread-use-search '(("nnmaildir:fmail")))
 '(gnus-save-killed-list
   "^\\(?:[^n]\\|n[^n]\\|nn[^s]\\|nns[^e]\\|nnse[^l]\\|nnsel[^e]\\|nnsele[^c]\\|nnselec[^t]\\|nnselect[^:]\\)")
 '(gnus-save-newsrc-file nil)
 '(gnus-search-default-engines '((nnmaildir . notmuch)))
 '(gnus-search-notmuch-remove-prefix "~/.fmail/")
 '(gnus-secondary-select-methods
   '((nnmaildir "fmail" (directory "~/.fmail/"))))
 '(gnus-sum-thread-tree-false-root "")
 '(gnus-sum-thread-tree-indent " ")
 '(gnus-sum-thread-tree-leaf-with-other "├► ")
 '(gnus-sum-thread-tree-root "")
 '(gnus-sum-thread-tree-single-leaf "╰► ")
 '(gnus-sum-thread-tree-vertical "│")
 '(gnus-summary-line-format "%U%R%z %(%12&user-date;  %*%-23,23f%)  %B%s\12")
 '(gnus-summary-mode-line-format "Gnus: %u&summary;%g [%A] %Z")
 '(gnus-summary-thread-gathering-function 'gnus-gather-threads-by-references)
 '(gnus-suppress-duplicates t)
 '(gnus-thread-sort-functions
   '(gnus-thread-sort-by-number gnus-thread-sort-by-total-score))
 '(gnus-topic-display-empty-topics nil)
 '(gnus-update-message-archive-method t)
 '(gnus-user-date-format-alist
   '((32042 . "%2l:%M%#p")
     (118823 . "Yest %2l:%M%#p")
     (604800 . "%a %2l:%M%#p")
     (16102447 . "%d %B")
     (t . "%Y-%b-%d"))))

(with-eval-after-load 'gnus
  (cond ((spw/on-host-p "chiark.greenend.org.uk")
	 (setq gnus-select-method
	       '(nntp "chiark"
		      (nntp-address "news.chiark.greenend.org.uk")
		      (nntp-open-connection-function
		       spw/nntp-open-authinfo-kludge))))
	;; If NNTPSERVER has been configured by the local administrator,
	;; accept Gnus's defaults.  Otherwise, set the default select method
	;; to nnnil so that typing 'M-x gnus' does not hang.
	((not (gnus-getenv-nntpserver))
	 (setq gnus-select-method '(nnnil "")))))

(defmacro spw/defun-pass-to-gdbmacs (name arglist &rest body)
  (declare (indent 2))
  (let ((parsed-body (macroexp-parse-body body))
	(arglist-names
	 (cl-loop for entry in arglist
		  if (eq entry '&rest) do (error "Not implemented")
		  else unless (eq entry '&optional) collect entry)))
    `(defun ,name ,arglist
       ,@(car parsed-body)
       (if (spw/may-pass-to-gdbmacs-p)
	   ;; We'd like to bind `display-buffer-overriding-action', but Gnus
	   ;; doesn't respect that when it starts up.
	   (ignore-error server-return-invalid-read-syntax
	     (server-eval-at
	      "gdbmacs" `(with-selected-frame
			     (make-frame
			      '((display
				 . ,(frame-parameter nil 'display))))
			   (let ((default-directory ,default-directory))
			     ,(list ',name ,@arglist-names)))))
	 ,@(cdr parsed-body)))))

(spw/defun-pass-to-gdbmacs spw/reset-gnus ()
  "Prepare to move Gnus session to another host, or just reset its state.

We want Gnus running on just one machine at once to avoid conflicts in
automatic updates to score files, and to avoid mail appearing to come back
unread."
  (interactive)
  (when (gnus-alive-p)
    (pop-to-buffer-same-window gnus-group-buffer)
    (gnus-group-exit))
  (if (gnus-alive-p)
      (user-error "Gnus still running")
    (delete-file "~/.newsrc.eld")
    (dolist (mailbox (delete "annex"
			     (directory-files "~/.fmail/" nil "[[:alpha:]]")))
      (delete-directory (format "~/.fmail/%s/.nnmaildir/" mailbox) t))
    (let ((default-directory (expand-file-name "~/src/athpriv/")))
      (spw/eshell-jump 'strict)
      (spw/eshell-insert-and-send "mr autoci && mr up && mr push"))))

(defvar gnus-always-read-dribble-file)

(defun spw/gnus-startup-wrapper (orig-fun &rest args)
  (let ((daemon (and (file-directory-p "~/.fmail/") (daemonp))))
    (cond ((and daemon (not (file-exists-p "~/.newsrc.eld")))
	   (user-error "Must use dedicated Emacs for Gnus first run"))
	  ((and daemon (not (string= "gdbmacs" daemon))
		(not (spw/on-host-primary-p "athena.silentflame.com")))
	   (user-error "This is not the Gnusmacs you're looking for"))
	  ((not (or daemon
		    (yes-or-no-p "Confirm ~/src/athpriv/ up-to-date")))
	   (user-error "Aborting"))))
  (let ((gc-cons-percentage 0.6)
	(gc-cons-threshold 402653184)
	(gnus-always-read-dribble-file (file-exists-p "~/.newsrc.eld")))
    (apply orig-fun args)))
(advice-add 'gnus :around #'spw/gnus-startup-wrapper)
(advice-add 'gnus-no-server :around #'spw/gnus-startup-wrapper)

(spw/defun-pass-to-gdbmacs spw/gnus (&optional fetch-and-inbox)
  (interactive "P")
  (require 'gnus)
  (if fetch-and-inbox
      ;; We want to see mail that we think has just come in.  This is the only
      ;; time we call 'notmuch new' without --no-hooks from Emacs rather than
      ;; just waiting for cron, because it's slow.
      (let* ((group (cl-case (prefix-numeric-value current-prefix-arg)
		      (4 "nnselect:Process-Weekend")
		      (16 "nnselect:Process-Weekday")))
	     (buffer (gnus-summary-buffer-name group)))
	(unless (gnus-alive-p) (gnus))
	(unless (spw/on-host-p "athena.silentflame.com")
	  (with-temp-message "Fetching from all accounts on athena ..."
	    (call-process "ssh" nil nil nil "athena"
			  "sh" "-lc" "movemymail")))
	(with-temp-message "Fetching mail locally ..."
	  (call-process "movemymail"))
	(if (not (get-buffer buffer))
	    (gnus-group-read-group nil t group)
	  (pop-to-buffer-same-window buffer)
	  (gnus-summary-rescan-group)))
    (if (not (gnus-alive-p))
	(gnus)
      (pop-to-buffer-same-window gnus-group-buffer)
      (when (buffer-live-p spw/saveable-notmuch-nnselect-summary)
	(gnus-group-jump-to-group
	 (buffer-local-value 'gnus-newsgroup-name
			     spw/saveable-notmuch-nnselect-summary))))))
(global-set-key "\C-cgn" #'spw/gnus)

(defun spw/gnus-goto-all-articles (group article)
  (require 'gnus)
  (if (gnus-alive-p) (pop-to-buffer-same-window gnus-group-buffer) (gnus))
  (gnus-group-jump-to-group group)
  (gnus-group-get-new-news-this-group)
  (gnus-group-jump-to-group group)
  ;; `gnus-topic-read-group' won't ever select an article if none are unread.
  (gnus-topic-select-group t)
  (when (and article (derived-mode-p 'gnus-summary-mode))
    (gnus-summary-next-page)))

(spw/defun-pass-to-gdbmacs spw/gnus-goto-notes ()
  (interactive)
  (spw/gnus-goto-all-articles "nnmaildir+fmail:notes" t))
(global-set-key "\C-cgN" #'spw/gnus-goto-notes)

(spw/defun-pass-to-gdbmacs spw/gnus-goto-sent ()
  (interactive)
  (spw/gnus-goto-all-articles "nnmaildir+fmail:sent" nil))
(global-set-key "\C-cgS" #'spw/gnus-goto-sent)

(defvar spw/gnus-notmuch-history)

(spw/defun-pass-to-gdbmacs spw/gnus-notmuch-ephemeral-search
    (query &optional limit thread)
  (interactive
   (list (read-string "Query: " nil 'spw/gnus-notmuch-history)
	 (and current-prefix-arg (prefix-numeric-value current-prefix-arg))
	 ;; With (thread . t) messages not matching the search can easily
	 ;; swamp the message(s) we're looking for.
	 ;; Instead, can type 'A T' to view whole threads.
	 nil))
  (require 'gnus)
  (if (gnus-alive-p)
      (when (derived-mode-p 'gnus-article-mode 'gnus-summary-mode)
	(if (spw/use-tabs-not-frames)
	    (tab-bar-new-tab)
	  (select-frame (make-frame-command)))
	(let ((del (if (spw/use-tabs-not-frames) #'tab-close #'delete-frame)))
	  (spw/add-once-hook
	   'gnus-summary-prepared-hook
	   (lambda () (add-hook 'gnus-summary-prepare-exit-hook del nil t)))))
    (gnus))
  (let ((gnus-large-ephemeral-newsgroup
	 (and (eql limit 0) gnus-large-ephemeral-newsgroup)))
    (gnus-group-read-ephemeral-group
     (concat "nnselect-" (message-unique-id)) (list 'nnselect "nnselect")
     nil (cons (current-buffer) gnus-current-window-configuration) nil nil
     `((score-file . "all.SCORE") (adapt-file . "all.ADAPT")
       (gnus-thread-sort-functions '(gnus-thread-sort-by-most-recent-number))
       (nnselect-specs
	. ((nnselect-function . gnus-search-run-query)
	   (nnselect-args
	    . ((search-group-spec ("nnmaildir:fmail"))
	       (search-query-spec
		(thread . ,thread) (query . ,query) (raw . t)
		(limit . ,(cl-case limit (0 nil) ((nil) 100) (t limit))))))))
       (nnselect-artlist . nil)))))
(global-set-key "\C-cgm" #'spw/gnus-notmuch-ephemeral-search)

;; Adapted from chiark:~matthewv/.gnus and originally from
;; <http://www.greenend.org.uk/rjk/2000/08/29/authinfo.html>.
(defun spw/nntp-open-authinfo-kludge (buffer)
  "Open a connection to NNTP server using 'authinfo-kludge'."
  (prog1 (start-process "nntpd" buffer "authinfo-kludge" nntp-address)
    (set-buffer buffer)
    (nntp-wait-for-string "^\r*200")
    (beginning-of-line)
    (delete-region (point-min) (point))))

(defun spw/notmuch-connective (word)
  (let ((sep (format " %s " word))
	(f (apply-partially #'format "(%s)")))
    (lambda (&rest queries)
      (mapconcat f (flatten-tree queries) sep))))

(defalias 'spw/nm| (spw/notmuch-connective "or"))
(defalias 'spw/nm& (spw/notmuch-connective "and"))
(defalias 'spw/nm~ (apply-partially #'format "not (%s)"))

(defvar spw/personal-sources)
(defvar spw/work-sources)
(defvar spw/feed-sources)
(defvar spw/bulk-sources)
(defvar spw/other-process-groups)
(defvar spw/browse-groups)

(defvar spw/gnus-all-process-groups)

;;; We don't have "Sent" and "Flagged" saved searches because all flagged are
;;; visible at the top of nnmaildir+fmail:inbox and I used the "Sent" saved
;;; search to see only recent sent mail, which is just nnmaildir+fmail:sent.
;;;
;;; Flagging is used (i) in the short term to collect a list of messages for
;;; processing together (e.g. student questions for a review session, arriving
;;; over the course of a week); and (ii) in the medium term to indicate which
;;; messages in a thread are pertinent when returning to the thread from a
;;; link in an Org TODO.  Examples of the latter include messages with review
;;; comments I want to check are addressed by a revised series, and in a long
;;; thread, which messages actually contain information relevant to the task.
;;;
;;; It might be cool to use flagging with Gnus adaptive scoring, but we would
;;; want such flags to be automatically removed at some point so that the
;;; messages could be archived by archive-fmail-to-annex.  But then flags set
;;; for (i) and (ii) would get arbitrarily removed too.

(defun spw/sync-notmuch-nnselect-groups ()
  "Add or update all my Gnus-saved notmuch searches."
  (interactive)
  (when (file-directory-p
	 (expand-file-name "~/.local/share/notmuch/default/xapian/"))
    (let* ((process-groups
	    `(;; To process Inbox Zero-style in distinct inboxes.
	      ;;
	      ;; `spw/bulk-sources' is for excluding things like notifications
	      ;; that are addressed directly to me, e.g. from GitLab installs.
	      ("Weekday"
	       ,(spw/nm& (spw/nm| spw/personal-sources spw/work-sources)
			 (spw/nm~ (spw/nm| spw/bulk-sources))))
	      ("Weekend"
	       ,(spw/nm&
		 (spw/nm| spw/personal-sources)
		 (spw/nm~ (spw/nm| spw/bulk-sources spw/work-sources))))
	      ,@spw/other-process-groups))
	   (process-groups
	    (cl-loop with never-process
		     = (spw/nm~
			(spw/nm|
			 spw/feed-sources "folder:notes" "folder:sent"))
		     for (name . queries) in process-groups collect
		     (cons name (spw/nm& (spw/nm| queries) never-process))))
	   (browse-groups
	    (named-let recurse (accum (remaining spw/browse-groups))
	      (cond ((null remaining) (nreverse accum))
		    ((cl-every #'stringp (ensure-list (cdar remaining)))
		     (recurse (cons (car remaining) accum) (cdr remaining)))
		    (t (recurse accum (nconc (copy-sequence (cdar remaining))
					     (cdr remaining)))))))
	   (categorised (spw/nm| (mapcar #'cdr process-groups)
				 (mapcar #'cdr browse-groups)))

	   (process-groups
	    `(;; Groups/lists where I don't know how or whether I want to
	      ;; follow them; I may have subscribed just to post something.
	      ("Uncategorised other"
	       . ,(spw/nm~ (spw/nm| spw/feed-sources categorised)))
	      . ,process-groups))
	   (browse-groups
	    `(;; Content not from mailing lists and not otherwise categorised
	      ;; -- previously such items would fall into "uncategorised
	      ;; unread" but that's wrong because I've explicitly subscribed
	      ;; to each of these.
	      ("Uncategorised feeds"
	       ,(spw/nm& (spw/nm| spw/feed-sources) (spw/nm~ categorised)))
	      . ,browse-groups))

	   (groups
	    (nconc
	     (cl-loop
	      for (name . queries) in browse-groups collect
	      `(,name (thread . t) (query . ,(spw/nm| queries)) (raw . t)))
	     (cl-loop for (name . query) in process-groups collect
		      `(,(concat "Process-" name)
			(thread . nil) (query . ,query) (raw . t))))))
      (setq spw/gnus-all-process-groups
	    (spw/nm| (mapcar #'cdr process-groups)))
      (require 'gnus) (require 'nnselect)
      (unless (gnus-alive-p) (gnus-no-server))

      ;; Kill all summaries in case any of their queries have changed.
      ;; Possibly we should kill only `spw/saveable-notmuch-nnselect-summary',
      ;; and only if it's not ephemeral.
      (catch 'done
	(dolist (buffer (buffer-list))
	  (when (buffer-local-value 'gnus-dead-summary-mode buffer)
	    (throw 'done (kill-buffer buffer)))))
      (gnus-offer-save-summaries)

      (with-current-buffer gnus-group-buffer
	(gnus-topic-mode 0)
	(cl-loop
	 initially (goto-char (point-max)) for (name . alist) in groups
	 for nname = (nnselect-add-prefix name)
	 for specs = `((nnselect-function . gnus-search-run-query)
		       (nnselect-args
			. ((search-query-spec . ,alist)
			   (search-group-spec ("nnmaildir:fmail")))))
	 ;; We're only really interested in recent mail for all these saved
	 ;; searches: for older mail I do ephemeral searches.  Take advantage
	 ;; of this to limit the number of results we're ever asking Gnus to
	 ;; read.  An alternative to "not folder:annex" might be "tag:unread".
	 do (cl-callf spw/nm& (cdr (assq 'query alist)) "not folder:annex")
	 if (gnus-group-entry nname) do
	 (gnus-group-set-parameter nname 'nnselect-specs specs)
	 ;; From `gnus-group-make-search-group' (though marked "temporary"?).
	 else do (gnus-group-make-group name (list 'nnselect "nnselect")
					nil `((nnselect-specs . ,specs)
					      (nnselect-always-regenerate . t)
					      (nnselect-rescan . t)))
	 ;; Manual recommends keeping mail groups on levels 1 and 2.
	 ;; We have browse groups higher for `gnus-group-best-unread-group'.
	 ;; Then `.'  to jump to the first processing group, `,' to jump to
	 ;; the first browse group.
	 do (gnus-group-set-subscription
	     nname (if (string-prefix-p "Process-" name) 2 1)))
	(gnus-group-set-subscription "nnmaildir+fmail:notes" 2)

	;; Process-Weekday/Process-Weekend distinction not currently in use.
	(gnus-group-set-subscription "nnselect:Process-Weekend" 7)

	;; Finally, group buffer setup.  If we want to add groups other than
	;; my nnselect groups to topics, we might have starting values
	;; `spw/gnus-topic-topology' and `spw/gnus-topic-alist' in .gnus.el,
	;; upon which this code would base its work.

	(setq
	 ;; It's not necessary to alter `gnus-variable-list' like this but it
	 ;; might be less confusing not to see in .newsrc.eld values for these
	 ;; variables which will always be ignored.
	 gnus-variable-list
	 (cl-set-difference gnus-variable-list
			    '(gnus-topic-alist gnus-topic-topology))

	 gnus-topic-alist
	 (list (cl-list*
		"Inboxes"
		"nnselect:Process-Weekday"
		"nnselect:Process-Weekend"
		"nnselect:Process-Uncategorised other"
		(cl-loop for (group . _) in spw/other-process-groups collect
			 (nnselect-add-prefix (concat "Process-" group))))
	       (list "Publications" "nnselect:Uncategorised feeds"))
	 gnus-topic-topology
	 (named-let recurse ((accum
			      (copy-tree
			       '((("Inboxes" visible)) ("Gnus" visible))))
			     (remaining spw/browse-groups)
			     topic)
	   (cond ((null remaining) (nreverse accum))
		 ((cl-every #'stringp (ensure-list (cdar remaining)))
		  (push (nnselect-add-prefix (caar remaining))
			(alist-get topic gnus-topic-alist nil nil #'string=))
		  (recurse accum (cdr remaining) topic))
		 (t (let* ((new-topic (caar remaining))
			   (new-topology
			    (recurse nil (cdar remaining) new-topic)))
		      (recurse (cons (cons `(,new-topic visible) new-topology)
				     accum)
			       (cdr remaining)
			       topic))))))
	(rplacd (last gnus-topic-topology) (copy-tree '((("misc" visible)))))

	(gnus-topic-mode 1)
	(gnus-group-list-groups)
	(gnus-topic-move-matching "^\\(?:nndraft:\\|nnmaildir\\)" "misc")
	(gnus-group-sort-topic		; actually sorts in all topics
	 (lambda (info1 info2)
	   (let ((group1 (gnus-group-real-name (gnus-info-group info1)))
		 (group2 (gnus-group-real-name (gnus-info-group info2))))
	     ;; Ensure we can't move Weekend->Weekday at end of group, and
	     ;; that otherwise they are first within their group
	     (or (string= group1 "Process-Weekday")
		 (and (string= group1 "Process-Weekend")
		      (not (string= group2 "Process-Weekday")))
		 (and (not (string-prefix-p "Process-Week" group2))
		      (string< group1 group2)))))
	 nil)

	;; Any nnselect groups in the root group at this point must be old
	;; searches I've dropped from .gnus.el.
	(cl-loop for group in (cdr (assoc "Gnus" gnus-topic-alist #'string=))
		 when (string-prefix-p "nnselect:" group) do
		 (gnus-group-jump-to-group group) (gnus-topic-kill-group 1))

	;; Ensure inbox maildir group is unsubscribed because it will have
	;; unread messages whenever any nnselect group does, but we don't want
	;; to read any of them by entering it.  Do this here instead of
	;; modifying `gnus-auto-subscribed-groups' to exclude the inbox
	;; because we want to re-unsubscribe in case I subscribed to it since
	;; this function last ran.
	;;
	;; Put inbox and annex maildirs on a level >`gnus-activate-level' such
	;; that they are each activated only when entering an nnselect group
	;; with messages from that maildir.  This speeds up Gnus startup.
	(gnus-group-set-subscription "nnmaildir+fmail:inbox" 7)
	(when (gnus-group-entry "nnmaildir+fmail:annex")
	  (gnus-group-set-subscription "nnmaildir+fmail:annex" 7))

	(gnus-group-list-groups)
	(gnus-group-best-unread-group)))))
(with-eval-after-load 'gnus-start
  (add-hook 'gnus-started-hook #'spw/sync-notmuch-nnselect-groups))
(advice-add 'gnus-group-read-init-file
	    :after #'spw/sync-notmuch-nnselect-groups)

(defun spw/gnus-specs-search-notmuch-p (&optional specs group)
  (and-let* ((specs
	      (or specs
		  (gnus-group-get-parameter (or group gnus-newsgroup-name)
					    'nnselect-specs t))))
    (require 'gnus-search)
    (gnus-search-notmuch-p
     (gnus-search-server-to-engine
      (caadr (assq 'search-group-spec (cdr (assq 'nnselect-args specs))))))))

(defvar spw/this-command-notmuch-updated-p nil)
(defvar spw/saveable-notmuch-nnselect-summary nil)
(defvar gnus-group-is-exiting-p)

(defun spw/set-first-notmuch-nnselect-summary ()
  (cond ((and gnus-group-is-exiting-p
	      (eq (current-buffer) spw/saveable-notmuch-nnselect-summary))
	 (setq spw/saveable-notmuch-nnselect-summary nil))
	((and (not gnus-group-is-exiting-p)
	      (spw/gnus-specs-search-notmuch-p)
	      (not (buffer-live-p spw/saveable-notmuch-nnselect-summary)))
	 (setq spw/saveable-notmuch-nnselect-summary (current-buffer)))))
(spw/feature-add-hook spw/set-first-notmuch-nnselect-summary
  (gnus-sum gnus-select-group-hook)
  (gnus-sum gnus-summary-prepare-exit-hook))

(defun spw/gnus-summary-exit (orig-fun &rest args)
  (if (and (spw/gnus-specs-search-notmuch-p)
	   (not (eq (current-buffer) spw/saveable-notmuch-nnselect-summary)))
      (gnus-summary-exit-no-update t)
    (apply orig-fun args)))
(advice-add 'gnus-summary-exit :around #'spw/gnus-summary-exit)

(defun spw/gnus-summary-exit-no-update (&optional no-questions)
  (list (or (and (spw/gnus-specs-search-notmuch-p)
		 (not (eq (current-buffer)
			  spw/saveable-notmuch-nnselect-summary)))
	    no-questions)))
(advice-add 'gnus-summary-exit-no-update
	    :filter-args #'spw/gnus-summary-exit-no-update)

(defun gnus-user-format-function-summary (_ignore)
  (if (and (spw/gnus-specs-search-notmuch-p)
	   (not (eq (current-buffer) spw/saveable-notmuch-nnselect-summary)))
      "%%%%"
    ""))

(defun spw/nnselect-update-notmuch (group &optional specs _info)
  (when (and (not spw/this-command-notmuch-updated-p)
	     (spw/gnus-specs-search-notmuch-p specs group))
    (let* ((lock (expand-file-name "~/.nomovemymail"))
	   (already-blocked-p (file-exists-p lock)))
      (unless already-blocked-p
	;; Block the cron job; 'notmuch new' with --no-hooks will still run.
	(with-temp-file lock))
      ;; Rescan nnmaildir+fmail:inbox to ensure we display new mail.
      (gnus-activate-group "nnmaildir+fmail:inbox" 'scan)
      ;; Update notmuch database before querying it.
      (call-process "notmuch" nil nil nil "new" "--no-hooks")
      ;; We want to avoid
      ;; (i)  changing the db between the calls to `nnselect-request-group'
      ;;      and `nnselect-request-headers' that occur when entering a group
      ;;      (see received mail date:@1681255438); and
      ;; (ii) updating over and over again in `gnus-group-get-new-news'.
      (setq spw/this-command-notmuch-updated-p t)
      (spw/add-once-hook 'post-command-hook
			 (lambda ()
			   (unless already-blocked-p (delete-file lock))
			   (setq spw/this-command-notmuch-updated-p nil))))))
(advice-add 'nnselect-generate-artlist :before #'spw/nnselect-update-notmuch)

(defun spw/gnus-group-nnselect-query (group)
  (when-let ((specs (gnus-group-get-parameter group 'nnselect-specs t)))
    (cdr (assq 'query
	       (cdr (assq 'search-query-spec
			  (cdr (assq 'nnselect-args specs))))))))

;; This simple scheme means that we can always tell whether we're in a
;; processing view just by looking at the mode line.
(defun spw/gnus-summary-processing-view-p ()
  (string-prefix-p "nnselect:Process-" gnus-newsgroup-name))

(defun spw/all-group-process-view-ids (group)
  (when-let* ((query (spw/gnus-group-nnselect-query group))
	      (overlap (spw/nm& "tag:unread" spw/gnus-all-process-groups
				(format "thread:\"{%s}\""
					(string-replace "\"" "\"\"" query)))))
    (call-process "notmuch" nil nil nil "new" "--no-hooks")
    (mapcar (lambda (line) (format "<%s>" (substring line 3)))
	    (process-lines "notmuch" "search" "--output=messages"
			   "--format=text" "--format-version=4" overlap))))

;; Empty hash table means we know there is no mail from processing views.
;; nil means we haven't yet / couldn't check, so no catching up is allowed.
;;
;; Note that this machinery can be defeated by `gnus-summary-clear-*'.
;; We call notmuch(1) in `spw/all-group-process-view-ids' to update its idea
;; of what's unread, but if there is more than one copy of a message, both
;; marked seen, and then one of them is marked unread by Gnus, notmuch won't
;; restore tag:unread.
(defvar-local spw/process-view-ids nil)

(defun spw/check-group-process-view-ids (&optional id)
  (if spw/process-view-ids
      (or (not id) (gethash id spw/process-view-ids))
    (let ((ids (spw/all-group-process-view-ids gnus-newsgroup-name))
	  (table (make-hash-table :test #'equal)))
      (dolist (id ids) (puthash id t table))
      ;; Only point the variable at the table if we got this far.
      (setq spw/process-view-ids table)
      ;; Now try the check again.
      (or (not id) (gethash id spw/process-view-ids)))))

(with-eval-after-load 'gnus-sum
  (add-hook 'gnus-summary-generate-hook
	    (lambda () (setq spw/process-view-ids nil))))

(defun spw/gnus-mark-article-hook ()
  "Don't mark any mail from processing views as read just for viewing it."
  (unless (or (spw/gnus-summary-processing-view-p)
	      (memq (gnus-summary-article-mark)
		    (list gnus-read-mark gnus-del-mark)))
    (if (spw/check-group-process-view-ids (gnus-summary-header "message-id"))
	(message "Not marking mail from processing views as read")
      (gnus-summary-mark-read-and-unread-as-read))))

(defun spw/guard-gnus-group-catchup (group &optional _all)
  (when (string-prefix-p "nnselect:Process-" group)
    (user-error "Cannot catch up processing views"))
  (when (spw/all-group-process-view-ids group)
    (error "This group contains articles from processing views")))
(advice-add 'gnus-group-catchup :before #'spw/guard-gnus-group-catchup)

(defun spw/guard-gnus-summary-catchup (&rest _ignore)
  ;; `gnus-group-select-group' also calls `gnus-summary-catchup'.
  (when (string-prefix-p "gnus-summary-catchup" (symbol-name this-command))
    (when (spw/gnus-summary-processing-view-p)
      (user-error "Cannot catch up processing views"))
    ;; We could pay attention to the TO-HERE and REVERSE arguments and check
    ;; only those IDs, though it'd be slower.
    (unless (and (spw/check-group-process-view-ids)
		 (zerop (hash-table-count spw/process-view-ids)))
      (error "This group/range may contain articles from processing views"))))
(advice-add 'gnus-summary-catchup :before #'spw/guard-gnus-summary-catchup)

(defun spw/gnus-summary-mark-as-read-backward (n)
  (interactive "p")
  (spw/gnus-summary-mark-as-read-forward (- n)))

(defun spw/gnus-summary-mark-as-read-forward (n)
  (interactive "p")
  (unless (zerop n)
    (let* ((processing-p (or (spw/gnus-summary-processing-view-p)
			     (spw/check-group-process-view-ids
			      (gnus-summary-header "message-id"))))
	   (mark (if processing-p gnus-read-mark gnus-del-mark)))
      (when processing-p (setq n (if (> 0 n) -1 1)))
      (gnus-set-global-variables)
      (if (not (get-buffer-window gnus-article-buffer t))
	  (gnus-summary-mark-forward n mark gnus-inhibit-user-auto-expire)
	(save-excursion (gnus-summary-mark-forward n mark))
	(if (> 0 n) (gnus-summary-prev-unread-article)
	  (gnus-summary-next-unread-article))))))

;; See (info "(gnus) Generic Marking Commands").
(with-eval-after-load 'gnus-sum
  (define-key gnus-summary-mode-map [remap gnus-summary-mark-as-read-backward]
	      #'spw/gnus-summary-mark-as-read-backward)
  (define-key gnus-summary-mode-map [remap gnus-summary-mark-as-read-forward]
	      #'spw/gnus-summary-mark-as-read-forward)

  ;; Given how we use flagging, described above, it makes sense to advance to
  ;; the next message after flagging ...
  (define-key gnus-summary-mode-map [remap gnus-summary-tick-article-backward]
	      #'gnus-summary-put-mark-as-ticked-prev)
  (define-key gnus-summary-mode-map [remap gnus-summary-tick-article-forward]
	      #'gnus-summary-put-mark-as-ticked-next)

  ;; ... and then for consistency we want M-u the same as '!' and 'd'.
  ;; (We might otherwise just leave M-u with its default behaviour.)
  (define-key gnus-summary-mode-map [remap gnus-summary-clear-mark-backward]
	      #'gnus-summary-put-mark-as-unread-prev)
  (define-key gnus-summary-mode-map [remap gnus-summary-clear-mark-forward]
	      #'gnus-summary-put-mark-as-unread-next))

;; Unlike `notmuch-extract-thread-patches' and
;; `notmuch-extract-message-patches', it does not make sense to check out a
;; branch when performing an action which will not make a commit.  If that's
;; wanted, the code which calls `spw/gnus-mime-apply-part' should perform the
;; checkout.
;;
;; Probably also want `spw/gnus-article-apply-part' for summary buffers.
(defun spw/gnus-mime-apply-part ()
  (interactive)
  (let ((default-directory (expand-file-name (project-prompt-project-dir))))
    (gnus-mime-pipe-part "git apply")))
(with-eval-after-load 'gnus-art
  (define-key gnus-mime-button-map "a" #'spw/gnus-mime-apply-part))

(dolist (fn '(gnus-mime-save-part-and-strip
	      gnus-article-save-part-and-strip
	      gnus-article-replace-part
	      gnus-article-delete-part))
  (advice-add fn :override #'ignore))

(defun spw/gnus-summary-kill-thread (orig-fun &optional unmark)
  (save-excursion
    (funcall orig-fun unmark))
  (unless unmark
    (gnus-summary-next-unread-article)))
(advice-add 'gnus-summary-kill-thread :around #'spw/gnus-summary-kill-thread)

(defun spw/gnus-summary-kill-whole-thread (&optional unmark)
  (interactive "P")
  (gnus-summary-top-thread)
  (gnus-summary-kill-thread unmark))
(with-eval-after-load 'gnus-sum
  (define-key gnus-summary-mode-map "k" #'spw/gnus-summary-kill-whole-thread))

;;; Following bindings go under 'v' because that is reserved to Gnus users.

;; There's an alternative to having a dedicated command for this described in
;; (info "(gnus) Security"), "Snarfing OpenPGP keys".
(defun spw/gnus-import-gpg ()
  (interactive)
  (gnus-summary-save-in-pipe "gpg --decrypt | gpg --import" t)
  (display-buffer "*Shell Command Output*"))
(with-eval-after-load 'gnus-sum
  (define-key gnus-summary-mode-map "vg" #'spw/gnus-import-gpg))

(defun spw/gnus-reader ()
  (interactive)
  ;; Can't use `gnus-eval-in-buffer-window' because we want eww buffer to be
  ;; left selected, if that's what we use.
  (gnus-summary-select-article-buffer)
  (save-excursion
    (goto-char (point-min))
    (cond
     ((re-search-forward
       "https://www.wsj.com/.*-WSJNewsPaper-[0-9-]+\\.pdf" nil t)
      (call-process-shell-command
       (format "evince %s"
	       (shell-quote-argument
		(buffer-substring-no-properties (match-beginning 0) (point))))
       nil 0)
      ;; We used an external program, so switch back.
      (gnus-article-show-summary))
     (t
      (re-search-forward "^URL:\\( \\|\n\\)")
      (let ((url (buffer-substring-no-properties (point) (line-end-position))))
	;; alternative to eww readable view:
	;; (start-process "firefox" nil "firefox"
	;;                "-new-window"
	;;                (concat "about:reader?url=" url))
	;;
	;; There is also Gnus's `A w' binding.
	(spw/add-once-hook 'eww-after-render-hook #'eww-readable)
	(let ((saved gnus-summary-buffer))
	  (eww url)
	  (setq-local gnus-summary-buffer saved)))))))
(with-eval-after-load 'gnus-sum
  (define-key gnus-summary-mode-map "vo" #'spw/gnus-reader))

(spw/feature-define-keys eww
  "h" gnus-article-show-summary
  "=" gnus-summary-expand-window)

;; In a group with patches, try to expunge messages not relevant for reviewing
;; those patches.  Optional numeric prefix argument specifies the version of
;; the series to review, in case there is more than one series in the summary
;; buffer.  Include ticked messages, as these may contain unresolved review
;; comments on older versions of the series.
;;
;; In the case where you want to compare the new series against review
;; comments on the old series, and the series are in different threads, use
;; C-c g m to open a distinct summary buffer for each thread, in two frames,
;; use this command in the buffer with the new series, and possibly use / m to
;; see only ticked articles in the old series' summary buffer.
(defun spw/gnus-summary-limit-to-patches (&optional reroll-count)
  (interactive "P")
  (gnus-summary-limit-to-subject
   (if reroll-count
       (cl-case (prefix-numeric-value reroll-count)
	 (1 "\\[.*PATCH\\(?:[^v]*\\|.*v1.*\\)\\]")
	 (t (format "\\[.*PATCH.*v%s.*\\]"
		    (prefix-numeric-value reroll-count))))
     "\\[.*PATCH.*\\]"))
  (gnus-summary-limit-to-subject (regexp-opt '("Re:" "Info received")) nil t)
  ;; Would be good also to reinsert all unread messages.
  (gnus-summary-insert-ticked-articles))
(with-eval-after-load 'gnus-sum
  (define-key gnus-summary-mode-map "vf" #'spw/gnus-summary-limit-to-patches))

(defun spw/gnus-summary-save-all-parts ()
  "Save all parts to ~/tmp/."
  (interactive)
  (gnus-summary-save-parts "" (expand-file-name "~/tmp/") current-prefix-arg))

(defun spw/gnus-summary-save-all-attachments ()
  "Save all attachments to ~/tmp/."
  (interactive)
  (gnus-eval-in-buffer-window gnus-article-buffer
    ;; `gnus-summary-save-parts' has some alternative ways to get the handles
    ;; if `gnus-article-mime-handles' is nil.
    (let ((handles gnus-article-mime-handles))
      (when (stringp (car handles)) (pop handles))
      (mapc #'mm-save-part (cl-remove-if-not #'mm-handle-filename handles)))))

(with-eval-after-load 'gnus-sum
  ;; Like `X m' binding.
  (define-key gnus-summary-mode-map
	      "vm" #'spw/gnus-summary-save-all-attachments)
  (define-key gnus-summary-mode-map "vM" #'spw/gnus-summary-save-all-parts))

(defun spw/org-gnus-follow-link (orig-fun &optional group article)
  (if (not article)
      (apply orig-fun group nil)
    (spw/gnus-notmuch-ephemeral-search (concat "id:" article) 0 t)
    (gnus-summary-goto-article article)))
(advice-add 'org-gnus-follow-link :around #'spw/org-gnus-follow-link)

(defun spw/gnus-purelymail-trash (n)
  (interactive "p")
  (gnus-summary-move-article n "nnmaildir+fmail:trash"))
(with-eval-after-load 'gnus-sum
  (define-key gnus-summary-mode-map
	      [remap gnus-summary-delete-article] #'spw/gnus-purelymail-trash))

(defun spw/gnus-purelymail-learn-spam (n)
  (interactive "p")
  (save-excursion (gnus-summary-mark-forward n))
  (gnus-summary-move-article n "nnmaildir+fmail:junk")
  (gnus-summary-next-unread-article))
(with-eval-after-load 'gnus-sum
  (define-key gnus-summary-mode-map [f5] #'spw/gnus-purelymail-learn-spam)
  (define-key gnus-summary-mode-map "\C-z\C-s" #'spw/gnus-purelymail-learn-spam))


;;;; rcirc

(custom-theme-set-variables
 'user
 '(rcirc-default-full-name "Sean Whitton [spwhitton@spwhitton.name]")
 '(rcirc-default-nick "spwhitton")
 '(rcirc-default-user-name "spwhitton")
 '(rcirc-display-server-buffer nil)
 '(rcirc-log-directory "~/local/irclogs")
 '(rcirc-log-filename-function 'spw/rcirc-generate-log-filename)
 '(rcirc-log-flag t)
 '(rcirc-time-format "%b/%d %H:%M ")
 '(rcirc-track-abbreviate-flag nil)
 '(rcirc-track-ignore-server-buffer-flag t)
 '(rcirc-track-minor-mode t))

(defun spw/rcirc-generate-log-filename (process target)
  (concat (file-name-concat (format-time-string "%Y/%m")
			    (process-name process) (or target "server"))
	  ".log"))

(defalias 'rcirc-handler-305 #'ignore)
(defalias 'rcirc-handler-306 #'ignore)

(defun spw/irc-autoaway ()
  (dolist (process (rcirc-process-list))
    (rcirc-send-string process "AWAY :This Emacs is idle"))
  (spw/add-once-hook 'post-command-hook
		     (lambda ()
		       (dolist (process (rcirc-process-list))
			 (rcirc-send-string process "AWAY :")))))

(when (spw/on-host-primary-p "athena.silentflame.com")
  (run-with-idle-timer
   120 nil (lambda ()
	     (load (expand-file-name "irc-init" user-emacs-directory))
	     (irc nil)
	     (defvar spw/irc-autoaway-timer
	       (run-with-idle-timer 240 t #'spw/irc-autoaway)))))

(defun spw/rcirc-log-for-mail (process sender response target text)
  (with-rcirc-process-buffer process
    (when (and (string= "PRIVMSG" response)
	       (or (string= sender target)
		   (string-match-p
		    (format "\\`\\(?:spwhitton\\|seanw\\|%s\\).? " rcirc-nick)
		    text)))
      (with-temp-buffer
	(let ((time (format-time-string rcirc-time-format))
	      (name (rcirc-generate-new-buffer-name process target)))
	  (insert
	   (if (string= sender target)
	       (format "\n\n%s\t\t%s\n\n    " time name)
	     (format "\n\n%s\t\t%s\n\n    <%s> " time name sender))))
	(insert text)
	(fill-region (pos-bol) (point))
	(write-region nil nil "~/local/irclogs/mail.log" t 'silent)))))
(spw/feature-add-hook spw/rcirc-log-for-mail (rcirc rcirc-print-functions))

(defun spw/rcirc-mail-hilights ()
  (when (file-exists-p "~/local/irclogs/mail.log")
    (ignore-errors
      (rename-file "~/local/irclogs/mail.log" "~/local/irclogs/mail.log.tmp"))
    (let (mail-signature
	  (mail-from-style 'parens)
	  (user-full-name "Cron Daemon")
	  (user-mail-address user-login-name))
      (mail 'new user-login-name "IRC messages")
      (mail-text) (insert-file "~/local/irclogs/mail.log.tmp")
      (mail-text) (delete-blank-lines) (delete-blank-lines)
      (let ((inhibit-quit t))
       (mail-send)
       (kill-buffer)
       (delete-file "~/local/irclogs/mail.log.tmp")))))

(when (spw/on-host-primary-p "athena.silentflame.com")
  (defvar spw/rcirc-mail-hilights-timer
    (run-at-time t 21600 #'spw/rcirc-mail-hilights)))

(defun spw/rcirc-dak (cmd)
  (if-let ((buffer (get-buffer "#debian-ftp-private@OFTC"))
	   (process (get-buffer-process "*OFTC*")))
      (progn (pop-to-buffer buffer)
	     (rcirc-send-privmsg process "#debian-ftp-private" cmd))
    (user-error "Missing buffer or process")))

(spw/feature-define-keys rcirc
  "\C-z\C-n" (lambda () (interactive) (spw/rcirc-dak "!lock NEW"))
  "\C-z\C-r" (lambda () (interactive) (spw/rcirc-dak "!lock rm"))
  "\C-z\C-o" (lambda () (interactive) (spw/rcirc-dak "!lock override"))
  "\C-z\C-u" (lambda () (interactive) (spw/rcirc-dak "!unlock")))


;;;; VC

(custom-theme-set-variables
 'user
 '(git-rebase-confirm-cancel nil)
 '(vc-deduce-backend-nonvc-modes t)
 '(vc-find-revision-no-save t)
 '(vc-follow-symlinks t)

 ;; We might also consider -B.
 '(vc-git-diff-switches '("--patch-with-stat" "-M" "-C"))

 '(vc-git-print-log-follow t))

;; Avoid `log-edit-show-files' window becoming most recently used for C-x o.
(with-eval-after-load 'log-edit
  (customize-set-variable 'log-edit-hook
			  (delete 'log-edit-show-files log-edit-hook)))
(spw/feature-add-to-list log-edit-hook log-edit 'spw/log-edit-show-diff)

(require 'git-commit nil t)

(spw/when-library-available mailscripts
  (global-set-key "\C-cvm" #'spw/mailscripts-prepare-patch)
  ;; Want a dedicated binding for this because often need it with Debian BTS.
  (global-set-key "\C-cvw" #'spw/mailscripts-git-format-patch-attach)

  (spw/feature-define-keys ((gnus-sum gnus-summary-mode-map)
			    (gnus-art gnus-article-mode-map))
    "vt" notmuch-extract-thread-patches-to-project
    "vw" mailscripts-extract-message-patches-to-project))

;; Emacs 30: move into `custom-theme-set-variables' call.
(when (>= emacs-major-version 30)
  (setopt vc-git-log-switches '("--format=fuller" "--stat")))

(defun spw/log-view-set-mark-command ()
  (interactive)
  (let ((beg (car (log-view-current-entry))))
    (if (and beg (> (point) (save-excursion (goto-char beg) (pos-eol))))
	(progn (setq this-command 'set-mark-command)
	       (call-interactively #'set-mark-command))
      (spw/ensure-whole-lines-mode 1 t))))

(defun spw/log-view-git-range ()
  (let* ((beg (use-region-beginning))
	 (start (and beg (cadr (log-view-current-entry beg))))
	 (end (and beg (region-end)))
	 (finish (and end (cadr (log-view-current-entry end)))))
    (setq deactivate-mark 'dont-save)
    (cond ((or (not beg) (< (count-lines beg end) 2))
	   ;; Leave it to the user to type "-1" if that's wanted.
	   (cadr (log-view-current-entry (point))))
	  ((> beg end) (format "%s..%s" start finish))
	  (t (format "%s..%s" finish start)))))

(defun spw/log-view-eshell-git-range (&optional subcommand)
  (interactive)
  (let ((buffer (current-buffer))
	(range (spw/log-view-git-range))
	(default-directory (project-root (project-current))))
    (spw/eshell-jump t)
    (when (> (point-max) eshell-last-output-end)
      (eshell-interrupt-process))
    (insert "git ")
    (when subcommand (insert subcommand ?\s))
    (save-excursion (insert ?\s range))))

(defun spw/log-view-git-cherry-pick ()
  (interactive)
  (spw/log-view-eshell-git-range "cherry-pick"))

(defun spw/log-view-git-fixup (&optional instant)
  (interactive "P")
  (let ((project-root (project-root (project-current)))
	(summary
	 (format "Summary: fixup! %s\n\n"
		 (cadr
		  (process-lines
		   "git" "rev-list" "--format=%s" (log-view-current-tag)))))
	(previous (format "%s~1" (log-view-current-tag))))
    (if (and (get-buffer "*vc-log*")
	     (with-current-buffer "*vc-log*"
	       (file-equal-p project-root (project-root (project-current)))))
	(progn (pop-to-buffer "*vc-log*")
	       (erase-buffer)
	       (insert summary)
	       (call-interactively #'log-edit-done)
	       (when instant
		 (let ((process-environment
			(cons "EDITOR=true" process-environment)))
		   (call-process "git" nil "*log-view-instant-fixup*" nil
				 "rebase" "-i" "--autosquash" previous)))
	       (when (derived-mode-p 'vc-git-log-view-mode)
		 (revert-buffer)))
      (require 'log-edit)
      (log-edit-remember-comment summary)
      (message "Pushed fixup! commit summary to Log Edit comment ring"))))

(defun spw/log-view-git-rebase (&optional interactive)
  (interactive "P")
  (deactivate-mark)
  (spw/log-view-eshell-git-range
   (if interactive "rebase -i --autosquash" "rebase")))

(defun spw/log-view-copy-git-range ()
  (interactive)
  (let ((range (spw/log-view-git-range)))
    (kill-new range)
    (message "Copied \"%s\" to kill ring." range)))

(defun spw/log-view-git-reset (&optional hard)
  (interactive "P")
  (deactivate-mark)
  (spw/log-view-eshell-git-range (if hard "reset --hard" "reset --mixed")))

(defun spw/log-view-msg-this ()
  (interactive)
  (when-let ((beg (car (log-view-current-entry))))
    (let ((expanded (get-text-property beg 'log-view-entry-expanded)))
      (log-view-toggle-entry-display)
      (unless expanded (log-view-diff (point) (point))))))

(defun spw/log-view-msg-next (n)
  (interactive "p")
  (log-view-msg-next n)
  (when-let ((beg (car (log-view-current-entry))))
    (unless (get-text-property beg 'log-view-entry-expanded)
      (log-view-toggle-entry-display)))
  (log-view-diff (point) (point))
  (setq deactivate-mark nil))

(defun spw/log-view-msg-prev (n)
  (interactive "p")
  (spw/log-view-msg-next (- n)))

(spw/feature-define-keys ((vc-git vc-git-log-view-mode-map))
  "\C-z:" spw/log-view-eshell-git-range
  "\C-zA" spw/log-view-git-cherry-pick
  "\C-zf" spw/log-view-git-fixup
  "\C-zF" "\C-u\C-zf"
  "\C-zr" spw/log-view-git-rebase
  "\C-zi" "\C-u\C-zr"
  "\C-zw" spw/log-view-copy-git-range
  "\C-zx" spw/log-view-git-reset
  "\C-zX" "\C-u\C-zx")

(spw/feature-define-keys log-view
  "\C-@" spw/log-view-set-mark-command
  [?\C- ] spw/log-view-set-mark-command
  "\s" scroll-other-window
  "" scroll-other-window-down
  "\t" spw/log-view-msg-this
  "\M-n" spw/log-view-msg-next
  "\M-p" spw/log-view-msg-prev)

(defun spw/vc-diff-no-select (orig-fun &rest args)
  (save-selected-window (apply orig-fun args)))
;; Not `vc-root-diff', as often we want to edit that for a partial commit.
(dolist (cmd '(vc-diff log-view-diff log-view-diff-changeset))
  (advice-add cmd :around #'spw/vc-diff-no-select))

(defun eshell/rld ()
  (interactive)
  (require 'vc)
  (save-selected-window
   (vc-diff-internal t `(Git (,(project-root (project-current))))
		     "@{1}" "@{0}" nil "*vc-reflog-diff*")))
(global-set-key "\C-cv=" #'eshell/rld)

(defun spw/log-edit-show-diff ()
  "Unless directly committing a diff, immediately show what we're committing."
  (interactive)
  (unless (and vc-parent-buffer
	       (with-current-buffer vc-parent-buffer
		 (derived-mode-p 'diff-mode)))
    (log-edit-show-diff)))

(spw/feature-define-keys ((project project-prefix-map))
  "L" #'vc-print-root-log "D" #'vc-root-diff "\C-x\C-j" #'project-dired)

(defun spw/eshell-find-git-subcommand ()
  (or (and-let* ((gitdir
		  (ignore-errors
		    (car (process-lines "git" "rev-parse" "--git-dir")))))
	;; See git's contrib/completion/git-prompt.sh.
	;; More than one of these could be in progress, so the order matters.
	;; See also how `vc-git--cmds-in-progress' returns a list.
	(cond ((file-exists-p (expand-file-name "REVERT_HEAD" gitdir))
	       "revert")
	      ((file-exists-p (expand-file-name "CHERRY_PICK_HEAD" gitdir))
	       "cherry-pick")
	      ((file-exists-p
		(expand-file-name "rebase-apply/applying" gitdir))
	       "am")
	      ((file-exists-p (expand-file-name "BISECT_START" gitdir))
	       "bisect")
	      ((file-exists-p (expand-file-name "MERGE_HEAD" gitdir))
	       "merge")
	      ((or (file-directory-p (expand-file-name "rebase-merge" gitdir))
		   (file-exists-p
		    (expand-file-name "rebase-apply/rebasing" gitdir)))
	       "rebase")))
      (user-error "Cannot determine what git command is in progress")))

(defun spw/eshell-git-abort ()
  (interactive)
  (let* ((subcommand (spw/eshell-find-git-subcommand))
	 (option (pcase subcommand
		   ("bisect" "reset")
		   (_        "--abort"))))
    (spw/eshell-insert-and-send "git " subcommand ?\s option)))

(defun spw/eshell-git-continue ()
  (interactive)
  (spw/eshell-insert-and-send
   "git " (spw/eshell-find-git-subcommand) ?\s "--continue"))

(spw/feature-define-keys ((esh-mode eshell-mode-map))
  "\C-z\C-c" spw/eshell-git-continue "\C-z\C-v" spw/eshell-git-abort)

;; C-z C-v to discard changes.
;; Save only buffers that weren't already modified.
(defun spw/diff-discard-hunk ()
  (interactive)
  (let* (diff-advance-after-apply-hunk
	 (buffer (car (diff-find-source-location)))
	 (to-save (and (not (buffer-modified-p buffer)) buffer)))
    ;; We cannot just bind `display-buffer-no-window' into
    ;; `display-buffer-overriding-action' because `diff-apply-hunk' assumes
    ;; `display-buffer' returns non-nil.  See docstring for
    ;; `display-buffer-no-window'.
    (save-window-excursion (diff-apply-hunk t))
    (diff-hunk-kill)
    (when to-save
      (with-current-buffer to-save
	(basic-save-buffer)))))

(defun spw/diff-kill-to-bob ()
  (interactive)
  (diff-beginning-of-hunk t)
  (when (save-excursion (re-search-backward diff-hunk-header-re nil t))
   (let ((end (point-marker)))
     (goto-char (point-min))
     (unwind-protect
	 (while (not (= (point) end))
	   (diff-hunk-kill))
       (set-marker end nil)))))

(defun spw/diff-kill-to-eob ()
  (interactive)
  (diff-beginning-of-hunk t)
  (when (save-excursion (forward-line 1)
			(re-search-forward diff-hunk-header-re nil t))
   (let ((end (point)))
     (diff-hunk-next 1)
     (while (not (= (point) end))
       (diff-hunk-kill)))))

;; Might want to upstream some or all of the functionality bound here, if it
;; proves often enough useful.
(spw/feature-define-keys diff-mode
  "\C-z\M-<" spw/diff-kill-to-bob
  "\C-z\M->" spw/diff-kill-to-eob
  "\C-z\C-c" "\C-z\M-<\C-z\M->"
  "\C-z\C-v" spw/diff-discard-hunk
  "\C-z\M-s" "\C-c\C-s\M-k\M-p\C-n"
  "\C-z\C-s" "\C-c\C-s\M-p\M-p\M-k\C-n")

;; Ensure that after two C-x C-q, we retain our `diff-mode' bindings.
;; (We can't use `setq-mode-local': Emacs bug#60787.)
(defun spw/disable-view-read-only ()
  (setq-local view-read-only nil))
(spw/feature-add-hook spw/disable-view-read-only diff-mode)

(defun spw/vc-next-action-for-git-fixup ()
  (interactive)
  (call-interactively #'vc-next-action)
  (let ((display-buffer-overriding-action
	 '(display-buffer-same-window (inhibit-same-window . nil))))
    (call-interactively #'vc-print-root-log))
  (message "Move point to the commit to fixup! into and type C-z f or C-z F"))
(global-set-key "\C-cvf" 'spw/vc-next-action-for-git-fixup)


;;;; Assorted packages

;; message-mode is sensitive to trailing whitespace in sig dashes and empty
;; headers.  markdown-mode is sensitive in empty headers (e.g. "# " which I
;; use in writing essays) and newlines that indicate paragraph flow (obscure
;; Markdown feature)
;;
;; The message-mode case is handled by `spw/normalise-message', which is
;; better than setting `ws-butler-trim-predicate' to a complicated function
;; because the code in `spw/normalise-message' gets called less often.  Could
;; try setting `ws-butler-trim-predicate' to handle the markdown-mode case,
;; but chances are someday I'll want to use that obscure markdown-mode feature
(define-globalized-minor-mode spw/ws-butler-global-mode ws-butler-mode
  (lambda () (when (buffer-file-name) (ws-butler-mode 1)))
  :predicate '((not markdown-mode
		    message-mode
		    lisp-interaction-mode)
	       prog-mode text-mode))
(spw/ws-butler-global-mode 1)

(autoload 'redtick "redtick")
(global-set-key "\C-cP" #'redtick)
(autoload 'redtick-mode "redtick")
(global-set-key "\C-cgP" #'redtick-mode)

(with-eval-after-load 'org-d20
  (setq org-d20-dice-sound
        "~/annex/media/sounds/147531__ziembee__diceland.wav"
	org-d20-display-rolls-buffer t
        ;; the roll20 tokens I'm using for NPCs are lettered
        org-d20-letter-monsters t
        ;; ... and they come in only two colours, so let's just have
        ;; one monster per letter
        org-d20-continue-monster-numbering t)

  (define-key org-d20-mode-map [f5]          #'org-d20-initiative-dwim)
  (define-key org-d20-mode-map [f6]          #'org-d20-damage)

  (define-key org-d20-mode-map [f7]          (lambda (arg)
					       (interactive "P")
					       (call-interactively
						(if arg
						    #'org-d20-roll-last
						  #'org-d20-roll))))
  (define-key org-d20-mode-map [f8]          #'org-d20-roll-at-point)
  (define-key org-d20-mode-map [f9]          (lambda (arg)
					       (interactive "P")
					       (call-interactively
						(if arg
						    #'org-d20-d%
						  #'org-d20-d20)))))

(customize-set-variable 'nov-text-width 78)
(spw/when-library-available nov
  (add-to-list 'auto-mode-alist '("\\.epub\\'" . nov-mode)))

(setq ggtags-mode-line-project-name nil)

(spw/when-library-available ggtags
  (dolist (hook '(cperl-mode-hook c-mode-hook))
    (add-hook hook #'ggtags-mode)))

(spw/when-library-available rainbow-mode
  (dolist (hook '(html-mode-hook css-mode-hook))
    (add-hook hook 'rainbow-mode)))

(custom-theme-set-variables
 'user
 '(haskell-indentation-layout-offset 4)
 '(haskell-indentation-left-offset 4))

(spw/feature-add-hook subword-mode haskell-mode)

;; Use a local hook to turn on an appropriate indentation mode.  Use
;; `haskell-indentation-mode' by default, but if our .dir-locals.el specifies
;; `indent-tabs-mode', we should instead use my `haskell-tab-indent-mode'.
(spw/when-library-available haskell-tab-indent
  (spw/feature-add-hook (lambda ()
			  (add-hook 'hack-local-variables-hook
				    (lambda ()
				      (if indent-tabs-mode
					  (haskell-tab-indent-mode 1)
					(haskell-indentation-mode 1)))
				    nil t))
    haskell-mode))

(spw/when-library-available orgalist
  (spw/feature-add-hook orgalist-mode message))

(spw/feature-add-hook orgtbl-mode message)

(custom-theme-set-variables
 'user
 '(bongo-default-directory "~/annex/music/")
 '(bongo-insert-album-covers t)
 '(bongo-insert-whole-directory-trees t)
 '(bongo-mode-line-indicator-mode nil)
 '(bongo-prefer-library-buffers nil))

(spw/feature-add-hook (lambda ()
			(dired-hide-details-mode
			 (if bongo-dired-library-mode 1 -1)))
  (bongo bongo-dired-library-mode-hook))

(defun spw/make-bongo-dired ()
  (dired-noselect bongo-default-directory))

(defun spw/maybe-activate-or-deactivate-bongo-dired-library-mode ()
  (require 'bongo)
  (if (eq major-mode 'wdired-mode)
      (bongo-dired-library-mode 0)
    (when (file-in-directory-p default-directory bongo-default-directory)
      (bongo-dired-library-mode 1))))

;; follow with 'h' to get to dired browse
(global-set-key "\C-cM" #'bongo-playlist)

(spw/when-library-available bongo
  ;; at first launch, ensure a buffer with `bongo-dired-library-mode' exists,
  ;; so 'h' takes us there, rather than to a library buffer
  (advice-add 'bongo-default-playlist-buffer :before #'spw/make-bongo-dired)

  ;; apparently bongo-dired-library-mode can interfere with wdired, so toggle
  (add-hook 'dired-mode-hook
	    #'spw/maybe-activate-or-deactivate-bongo-dired-library-mode)
  (advice-add 'wdired-change-to-wdired-mode
	      :after #'spw/maybe-activate-or-deactivate-bongo-dired-library-mode)
  (advice-add 'wdired-change-to-dired-mode
	      :after #'spw/maybe-activate-or-deactivate-bongo-dired-library-mode))

;; 'v' again to exit
(global-set-key "\C-cgv" #'volume)

(with-eval-after-load 'elpher
  ;; standard Emacs conventions
  (define-key elpher-mode-map "l" #'elpher-back)
  (define-key elpher-mode-map "d" #'elpher-back-to-start)
  (define-key elpher-mode-map "<" #'elpher-root-dir)

  (add-hook 'elpher-mode-hook (lambda () (variable-pitch-mode 1))))


;;;; Lisp

(find-function-setup-keys)

;; This defeats `slime-repl-mode-map' grabbing backspace from Paredit.
;; Unconditionally unbinding should be safe as always use Paredit for Lisp.
(define-key lisp-mode-shared-map "\177" nil)

;; Catch custom defining forms, and include them at the top level of the menu.
;; We completely replace the default value, rather than appending to the list,
;; because a basic expression to find custom defining forms will also find
;; everything that the default value finds, and indeed merge them into the top
;; level of the menu, anyway.
(setq lisp-imenu-generic-expression
      (rx-let ((spc (in blank ?\n))
	       (sym (| word (syntax symbol)))
	       ;; For Emacs 28.
	       (lisp-mode-symbol (+ (| (syntax word)
				       (syntax symbol)
				       (: "\\" nonl)))))
	`((nil ,(rx bol (0+ blank) ?\( (opt "spw/") (opt "cl-") "def"
		    (| (1+ word)
		       (: "ine-"
			  ;; Require symbol constituents next, but we don't
			  ;; want to index calls to `define-key' ...
			  ;; There is also `define-abbrev'.
			  (| (: (in "a-jl-z0-9-") (0+ sym))
			     (: ?k (opt (in "a-df-z0-9-") (0+ sym)))
			     (: "ke" (opt (in "a-xz0-9-") (0+ sym)))
			     (: "key" (1+ sym)))))
		    (1+ spc) (opt ?') (group lisp-mode-symbol)
		    ;; Exclude declarations like (defvar FOO) in Elisp.
		    (1+ spc) (not ?\)))
	       1))))

(defun spw/consfig-indentation-hints ()
  (put 'spwcrontab 'common-lisp-indent-function '1)
  (put 'kvm-boots-trusted-chroot. 'common-lisp-indent-function '1)
  (put 'kvm-boots-lvm-lv. 'common-lisp-indent-function '1)
  (put 'athenet-container-for. 'common-lisp-indent-function '3))
(advice-add 'activate-consfigurator-indentation-hints
	    :after #'spw/consfig-indentation-hints)

;; Without xscheme, the *scheme* buffer is not Paredit-compatible.
(with-eval-after-load 'scheme (require 'xscheme))

(spw/reclaim-keys-from xscheme scheme-mode-map "\eo" "\ez")
(spw/feature-define-keys ((xscheme scheme-mode-map))
  "\C-j" xscheme-send-previous-expression "\C-z\C-e" #'xscheme-send-buffer)

(let ((tb (expand-file-name "~/annex/media/HyperSpec-7-0.tar.gz"))
      (hd (expand-file-name "~/local/clhs/HyperSpec/")))
  (when (and (file-exists-p tb) (not (file-directory-p hd)))
    (make-directory (expand-file-name "~/local/clhs/" t))
    (let ((default-directory "~/local/clhs/"))
      (call-process-shell-command (concat "tar xfz " tb))))
  (when (file-directory-p hd)
    (setq common-lisp-hyperspec-root (concat "file://" hd))
    (when (boundp 'browse-url-handlers)	; Emacs 27
      (add-to-list 'browse-url-handlers '("/local/clhs/HyperSpec/" . eww)))))

;; `hyperspec-lookup' unconditionally uses a symbol at point, but we have
;; SLIME's C-c C-d h for that.
(defun spw/hyperspec-lookup ()
  (interactive)
  (with-temp-buffer (call-interactively #'hyperspec-lookup)))
(global-set-key "\C-cgh" #'spw/hyperspec-lookup)

(defvar spw/last-command-was-slime-async-eval nil)
(defvar spw/last-slime-async-eval-command-frame nil)

(defun spw/record-last-command-was-slime-async-eval (&rest ignore)
  (spw/add-once-hook 'pre-command-hook
		     (lambda ()
		       (setq spw/last-command-was-slime-async-eval nil)))
  (setq spw/last-command-was-slime-async-eval t
	spw/last-slime-async-eval-command-frame (selected-frame)))
(dolist (f '(slime-repl-return slime-mrepl-return
	     slime-compile-region slime-compile-file sldb-eval-in-frame
	     sldb-invoke-restart-0 sldb-invoke-restart-1
	     sldb-invoke-restart-2 sldb-invoke-restart-3
	     sldb-invoke-restart-4 sldb-invoke-restart-5
	     sldb-invoke-restart-6 sldb-invoke-restart-7
	     sldb-invoke-restart-8 sldb-invoke-restart-9
	     slime-interactive-eval slime-interrupt spw/go-to-consfig))
  (advice-add f :after #'spw/record-last-command-was-slime-async-eval))

;; Here we assume that (spw/use-tabs-not-frames) yields nil.
(defun spw/sldb-avoid-focus-grab (orig-fun &rest args)
  "Don't allow the Slime debugger to grab keyboard focus unless we are sure
that the user is expecting that it might pop up."
  (if spw/last-command-was-slime-async-eval
      (apply orig-fun args)
    (save-selected-window
      (if (frame-live-p spw/last-slime-async-eval-command-frame)
	  (with-selected-frame spw/last-slime-async-eval-command-frame
	    (apply orig-fun args))
	(apply orig-fun args))))
  (setq spw/last-slime-async-eval-command-frame nil))
(advice-add 'sldb-display-buffer :around #'spw/sldb-avoid-focus-grab)

(defun spw/slime-repl-header-line (&optional pwd)
  (with-current-buffer (slime-connection-output-buffer)
    (let* ((pwd
	    (abbreviate-file-name
	     (string-remove-suffix "/" (or pwd
					   (slime-eval
					    '(swank:default-directory))))))
	   (conn (slime-connection))
	   (host (car (process-contact conn))))
      (setq header-line-format
	    (format "%s@%s:%s  Port: %s  Pid: %s"
		    (slime-lisp-implementation-type)
		    (if (string= "localhost" host) system-name host)
		    (propertize pwd 'face 'bold)
		    (slime-connection-port conn) (slime-pid))))))
(advice-add 'slime-repl-insert-banner :before #'spw/slime-repl-header-line)
(advice-add 'slime-set-default-directory :after #'spw/slime-repl-header-line)
(with-eval-after-load 'slime-repl
  (add-hook 'slime-change-directory-hooks #'spw/slime-repl-header-line))
(with-eval-after-load 'slime
  (setq slime-contribs (remq 'slime-banner slime-contribs)))

(defun spw/slime-clear-source-registry ()
  (interactive)
  (slime-repl-shortcut-eval-async '(asdf:clear-source-registry) #'message))

(with-eval-after-load 'slime-repl
  (defslime-repl-shortcut nil ("clear-source-registry")
    (:handler #'spw/slime-clear-source-registry)))

(defun spw/comment-form (n)
  "Replacement for \\[comment-line] in Lisp modes which is more
likely to keep parentheses balanced."
  (interactive "p")
  (if (use-region-p)
      (comment-line n)
    (let ((begin (point))
          (end (line-end-position)))
      (skip-chars-forward "; \t" end)
      (forward-sexp)
      (unless (> (point) (line-end-position))
        (comment-or-uncomment-region begin (point))))))
(define-key lisp-mode-shared-map [?\C-x ?\C-\;] #'spw/comment-form)
(when (boundp 'lisp-data-mode-map)	; Emacs 27
  (define-key lisp-data-mode-map [?\C-x ?\C-\;] #'spw/comment-form))

;; Loading `slime' puts `slime-macrostep' on `load-path'.
;; `slime-macrostep' knows how to load an embedded copy of `macrostep'.
(with-eval-after-load 'slime (require 'slime-macrostep))
(when-let ((lib (cl-find-if #'locate-library '("macrostep" "slime"))))
  (autoload 'macrostep-expand lib nil t))
(define-key lisp-mode-shared-map "\C-ze" #'macrostep-expand)

;; Ignore Genera/Zmacs file attributes that a number of CL systems include.
(dolist (var '(base package syntax Base Package Syntax BASE PACKAGE SYNTAX))
  (cl-pushnew var ignored-local-variables))

;;; Paredit

(spw/feature-add-hook enable-paredit-mode
  (nil lisp-data-mode-hook) (nil emacs-lisp-mode-hook)
  (nil eval-expression-minibuffer-setup-hook)
  scheme (xscheme xscheme-start-hook) slime-repl)

(defun spw/paredit-unix-word-rubout (arg)
  (interactive "p")
  (cond ((save-excursion
	   (skip-chars-backward "[:space:]\n") (paredit-in-comment-p))
	 (spw/unix-word-rubout arg))
	((paredit-in-string-p)
	 (let ((start (1+ (car (paredit-string-start+end-points)))))
	   (if (> (point) start)
	       (save-restriction
		 (narrow-to-region start (point)) (spw/unix-word-rubout arg))
	     (paredit-backward-delete-in-string))))
	(t (backward-kill-sexp (abs arg)))))
(define-key paredit-mode-map "\C-w" #'spw/paredit-unix-word-rubout)

(spw/macroexp-for (key command)
    (;; This fixes RET in 'M-:'.
     ([?\r] paredit-RET)
     ;; This fixes C-j in `lisp-interaction-mode', `edebug-eval-mode' etc.
     ([?\C-j] paredit-C-j))
  (let ((new-command (intern (format "spw/%s" command))))
    `(progn (defun ,new-command ()
	      ,(format
		"Defer to major mode's binding for %s if present, else `%s'."
		(key-description key) command)
	      (interactive)
	      (call-interactively
	       (if-let* ((map (current-local-map))
			 (binding (lookup-key map ,key)))
		   binding
		 #',command)))
	    (define-key paredit-mode-map ,key #',new-command))))

;; Fix M-a, M-e, M-k and C-x DEL in Lisp string literals.
(defun spw/paredit-narrow-to-string (orig-fun &rest args)
  (save-restriction
    (when (and paredit-mode (paredit-in-string-p))
      (cl-destructuring-bind (beg . end) (paredit-string-start+end-points)
	(narrow-to-region (1+ beg) end)))
    (apply orig-fun args)))
(dolist (cmd '(backward-sentence forward-sentence
	       backward-kill-sentence kill-sentence))
  (advice-add cmd :around #'spw/paredit-narrow-to-string))

(spw/reclaim-keys-from paredit paredit-mode-map "\M-r" "\M-s" "\M-?")
(define-key paredit-mode-map "\M-R" #'paredit-raise-sexp)
(define-key paredit-mode-map "\M-U" #'paredit-splice-sexp)
(define-key paredit-mode-map "\M-C" #'paredit-convolute-sexp)

(defun spw/paredit-try-expand-list (old)
  "Fix `try-expand-list' with `paredit-mode'."
  (or old (not paredit-mode)
      (always (delete-region (point) (progn (paredit-forward-up) (point))))))
(advice-add 'try-expand-list :after-while #'spw/paredit-try-expand-list)

;; Drop `try-expand-line', and move completion of Lisp symbols earlier than
;; `try-expand-list'.
(define-key paredit-mode-map [remap dabbrev-expand]
	    (make-hippie-expand-function
	     '(try-complete-file-name-partially try-complete-file-name
	       try-expand-all-abbrevs
	       try-complete-lisp-symbol-partially try-complete-lisp-symbol
	       try-expand-list
	       try-expand-dabbrev try-expand-dabbrev-all-buffers
	       try-expand-dabbrev-from-kill)))

(defun spw/paredit-no-space-after (endp delimiter)
  (rx-let ((comma-at (: ?, (0+ (any ?, ?@))))
	   (sharpsign (: (opt comma-at) ?#)))
    (or endp (save-excursion
	       (skip-syntax-backward "^-" (pos-bol))
	       (skip-syntax-forward "(")
	       (not (looking-at
		     (cl-case delimiter
		       (?\" (rx sharpsign (| ?? ?p ?P ?~ "!~")))
		       (?\( (rx (| comma-at (: sharpsign (| ?? ?~ "!~")))))
		       (t (rx sharpsign (| ?? ?~ "!~"))))))))))
(add-to-list
 'paredit-space-for-delimiter-predicates #'spw/paredit-no-space-after)

(defun spw/paredit-insert-comment-before-defun ()
  "Don't use three semicolons immediately before a top-level form."
  (when (and (not (looking-at "\n\n")) (looking-back "^;;; "))
    (delete-char -2) (insert " ")))
(advice-add 'paredit-insert-comment
	    :after #'spw/paredit-insert-comment-before-defun)

(defun spw/scratch-paredit-in-lisp-p ()
  "Does point's paragraph look to be within a defun?"
  (or
   ;; Is point at an empty paragraph, ready to start typing it?  Assume Lisp.
   (save-excursion
     (goto-char (pos-bol 0))
     (looking-at (rx (| (: buffer-start (= 2 (* blank) ?\n))
			(: (= 2 (* blank) ?\n) (* blank) (| ?\n buffer-end))
			(: (* blank) ?\n (* blank) buffer-end)))))
   ;; This code attempts to classify non-empty paragraphs.
   (save-excursion
     ;; Unless we're already right before a paragraph, skip backwards into the
     ;; previous paragraph.
     (unless (looking-at "[[:space:]]*\n[[:space:]]*[^[:space:]\n]+")
       (skip-chars-backward "[:space:]\n"))
     (catch 'done
       (while t
	 ;; Go back to the start of the paragraph.
       	 (re-search-backward "\\`\\|^\\s-*$" nil t)
	 ;; Examine the syntax of the first character of the paragraph.
	 ;; If it's whitespace, we need to go back and check the previous
	 ;; paragraph, to handle multiple paragraphs within a defun.
	 (let ((syn
		(char-syntax
		 (char-after
		  ;; (1+ point) unless at end of buffer or on first line of a
		  ;; paragraph beginning right at the beginning of the buffer.
		  (and (not (eobp))
		       (not (and (bobp)
				 (looking-at "[[:space:]]*[^[:space:]\n]")))
		       (1+ (point)))))))
	   (cond ((bobp)             (throw 'done (eq syn ?\()))
		 ((eq syn ?\()       (throw 'done t))
		 ((not (eq syn ?\s)) (throw 'done nil))))
	 (skip-chars-backward "[:space:]\n"))))))

(define-derived-mode spw/scratch-lisp-interaction-mode lisp-interaction-mode
  "Lisp Interaction"
  (let (;; Bind `minor-mode-map-alist' such that our call to `key-binding'
	;; ignores the bindings of minor modes that have priority over
	;; Paredit.  This avoids an infinite loop if one of those minor modes
	;; wants to defer to our binding, e.g. in the way `orgtbl-mode' does.
	(minor-mode-map-alist
	 (or (cdr (cl-member 'paredit-mode minor-mode-map-alist :key #'car))
	     minor-mode-map-alist))
	(map (make-sparse-keymap)))
    (set-keymap-parent map paredit-mode-map)
    (named-let define-keys ((from paredit-mode-map) (into map) (prefix []))
      (map-keymap
       (lambda (event paredit-binding)
	 ;; `paredit-mode-map' has no parents; otherwise, we should
	 ;; conditionalise on (eq (lookup-key keymap key) paredit-binding).
	 (let* ((key (vector event))
		(prefixed (vconcat prefix key)))
	   (cond ((keymapp paredit-binding)
		  (let ((map (make-sparse-keymap)))
		    (define-key into key map)
		    (define-keys paredit-binding map prefixed)))
		 ((commandp paredit-binding)
		  (when-let* ((normal-binding (key-binding prefixed))
			      (new-binding
			       (intern (format "spw/scratch-%s"
					       (if (symbolp paredit-binding)
						   paredit-binding
						 (gensym))))))
		    (defalias new-binding
		      (lambda ()
			(interactive)
			(call-interactively
			 (if (spw/scratch-paredit-in-lisp-p)
			     paredit-binding
			   normal-binding)))
		      (format "Like `%s', but for `spw/scratch-lisp-interaction-mode'."
			      paredit-binding))
		    (define-key into key new-binding))))))
       from))
    (push `(paredit-mode . ,map) minor-mode-overriding-map-alist))
  (setq-local fill-paragraph-function
	      (lambda (&optional justify)
		(and (spw/scratch-paredit-in-lisp-p)
		     (lisp-fill-paragraph justify)))
	      normal-auto-fill-function
	      (lambda ()
		(and (not (spw/scratch-paredit-in-lisp-p))
		     (let (comment-start) (do-auto-fill)))))
  ;; (orgtbl-mode 1) ; appears to break `eldoc-mode' and/or `show-paren-mode'
  (spw/when-library-available orgalist (orgalist-mode 1)))
(define-key spw/scratch-lisp-interaction-mode-map "\M-q" #'fill-paragraph)
;; Override earlier `setq-mode-local' for `prog-mode'.
(setq-mode-local spw/scratch-lisp-interaction-mode
		 comment-auto-fill-only-comments nil)


;;;; Text mode

(add-hook 'text-mode-hook #'turn-on-auto-fill)

;; for writing notes on ftp-master.debian.org
(add-to-list 'auto-mode-alist '("dak[A-Za-z0-9_]+\\'" . text-mode))
;; make sure we can copy/paste from local Emacs into terminal
(defun spw/maybe-disable-electric-indent-local ()
  (when (string-match "\\(?:tmp[A-Za-z0-9_]+\\.txt\\|dak[A-Za-z0-9_]+\\)\\'"
                      (buffer-name))
    (electric-indent-local-mode 0)))
(add-to-list 'text-mode-hook #'spw/maybe-disable-electric-indent-local)

(spw/define-skeleton spw/markdown-meta (markdown-mode :abbrev "meta")
  "" "Variable: " "[[!meta " str "=\"" _ "\"]")

(spw/define-skeleton spw/ftp-other (text-mode :key "\C-z\C-o" :file nil)
  "" "" "+----------------------+" \n "|    Other comments    |" \n
  "+----------------------+" \n \n -)

(spw/define-skeleton spw/ftp-reject (text-mode :key "\C-z\C-r" :file nil)
  "" ""
  "+----------------------+" \n "|   REJECT reasoning   |" \n
  "+----------------------+" \n \n _ \n \n
  "+----------------------+" \n "|         N.B.         |" \n
  "+----------------------+" \n \n
  "This review may not be exhaustive.  Please check your source package
against your d/copyright and the ftpmaster REJECT-FAQ, throughly,
before uploading to NEW again." \n \n
"Thank you for your time and contribution!" \n \n "Sean")

(spw/define-skeleton spw/ftp-prod (text-mode :key "\C-z\C-p" :file nil)
  "" "" "Hello,\n\n" _ "\n\n-- \nSean Whitton")


;;;; Org-mode

(custom-theme-set-faces
 'user
 '(org-code ((t (:inherit (shadow fixed-pitch)))))
 '(org-date ((t (:inherit fixed-pitch :foreground "Purple" :underline t))))
 '(org-verbatim ((t (:inherit (shadow fixed-pitch))))))

(custom-theme-set-variables
 'user
 ;; Sometimes set to nil in .dir-locals.el, e.g. in ~/doc/newpapers.
 '(org-adapt-indentation t nil)

 '(org-agenda-entry-text-maxlines 3)
 '(org-agenda-files "~/doc/emacs-org-agenda-files")
 '(org-agenda-persistent-filter t)
 '(org-agenda-remove-times-when-in-prefix 'beg)

 ;; Interacts badly with `tab-bar-history-mode'.
 '(org-agenda-restore-windows-after-quit nil)

 '(org-agenda-skip-deadline-if-done t)
 '(org-agenda-skip-deadline-prewarning-if-scheduled 3)
 '(org-agenda-skip-scheduled-if-deadline-is-shown 'not-today)
 '(org-agenda-skip-scheduled-if-done t)
 '(org-agenda-skip-timestamp-if-done t)
 '(org-agenda-start-on-weekday nil)
 '(org-agenda-sticky t)
 '(org-agenda-timegrid-use-ampm t)
 '(org-agenda-todo-ignore-scheduled 'future)
 '(org-agenda-window-setup 'current-window)
 '(org-archive-location "~/doc/archive/howm/archive.org::* From %s")
 '(org-archive-save-context-info '(time file olpath))
 '(org-archive-subtree-save-file-p t)
 '(org-blank-before-new-entry '((heading . t) (plain-list-item . auto)))

 ;; Turn off to avoid git merge conflicts.
 '(org-bookmark-names-plist nil)

 '(org-cycle-separator-lines 0)
 '(org-deadline-warning-days 60)
 '(org-default-notes-file "~/doc/howm/refile.org")
 '(org-directory "~/doc/howm/")
 '(org-enforce-todo-checkbox-dependencies t)
 '(org-enforce-todo-dependencies t)
 '(org-fold-catch-invisible-edits 'show)
 '(org-fold-show-context-detail
   '((agenda . local) (bookmark-jump . lineage) (isearch . lineage)
     (default . ancestors-full)))
 '(org-footnote-section "Notes")
 '(org-imenu-depth 4)

 ;; So I can start lines with \"P. 211 - \" to refer to p. 211, rather than
 ;; starting a list.
 '(org-list-allow-alphabetical nil)

 '(org-list-demote-modify-bullet
   '(("-" . "+") ("+" . "*") ("*" . "-") ("1." . "-") ("1)" . "-")))
 '(org-list-use-circular-motion t)
 '(org-log-done 'time)
 '(org-log-into-drawer t)

 ;; Cluttering, and information probably in git.
 '(org-log-repeat nil)

 '(org-log-states-order-reversed nil)

 ;; Desirable with `icomplete-mode'.
 '(org-outline-path-complete-in-steps nil)

 '(org-read-date-prefer-future 'time)
 '(org-refile-allow-creating-parent-nodes 'confirm)
 '(org-refile-targets '((org-agenda-files :maxlevel . 5) (nil :maxlevel . 5)))
 '(org-refile-use-outline-path 'file)
 '(org-special-ctrl-a/e t)
 '(org-special-ctrl-k t)
 '(org-startup-folded nil)

 ;; Ensures buffer text doesn't go beyond 80 columns.
 '(org-startup-indented nil)

 '(org-tags-match-list-sublevels 'indented)
 '(org-todo-keyword-faces
   '(("SOMEDAY" :foreground "#0000FF" :weight bold)
     ("NEXT" :foreground "#DD0000" :weight bold)))
 '(org-todo-keywords
   '((sequence "TODO(t)" "NEXT(n)" "|" "DONE(d)")
     (sequence "WAITING(w@)" "SOMEDAY(s)" "|" "CANCELLED(c)")))
 '(org-treat-S-cursor-todo-selection-as-state-change nil)
 '(org-treat-insert-todo-heading-as-state-change t)
 '(org-use-fast-todo-selection 'expert)
 '(org-yank-folded-subtrees nil))

(global-set-key "\C-coc" #'org-capture)
(global-set-key "\C-col" #'org-store-link)
(global-set-key "\C-coa" #'org-agenda)
(global-set-key "\C-co[" #'org-agenda-file-to-front)
(global-set-key "\C-co]" #'org-remove-file)

(setq
 ;; we just use a completely custom agenda view
 ;; org-agenda-todo-ignore-with-date nil
 ;; org-agenda-todo-list-sublevels nil
 ;; org-agenda-skip-additional-timestamps-same-entry nil

 ;; inline tasks
 ;; prefix arg can be used to override this setting
 org-inlinetask-default-state "TODO"

 ;; we don't actually use Org's built-in stuck project support,
 ;; instead generating our own review agenda from scratch which
 ;; includes the right tasks.  See the view assigned to the '#' key
 org-stuck-projects '("TODO" '("NEXT") nil "")

 ;; org-yank-adjusted-subtrees t
 ;; org-yank-folded-subtrees nil

 org-tag-alist
 '((:startgroup)
   ;; ("@Tucson"       . ?t)
   ;; ("@Sheffield"    . ?s)
   ("@Home"         . ?h)
   ("@Office"       . ?o)
   (:endgroup)
   ;; ("@iPad"         . ?i)
   ;; following are needed when at times when I'm regularly accessing
   ;; my Org-mode agenda over SSH
   ;; (:startgroup)
   ;; ("@Emacs"        . ?e) ; SSH Emacs only
   ;; ("@workstation"  . ?m) ; on my fully set-up personal (m)achine
   ;; (:endgroup)
   ("Weekdays"      . ?w) ; inc. academic work
   ("Debian"        . ?d)
   ("FLOSS"         . ?f)

   ;; these two probably don't need to be in the list; can remove to
   ;; reclaim the shortcut keys
   ("NOARCHIVE"     . ?N)
   ("NOAGENDA"      . ?A))

 org-capture-templates-contexts
 '(("t" "m" ((in-mode		. "gnus-summary-mode")))
   ("t"     ((not-in-mode	. "gnus-summary-mode")))
   ("T"     ((in-mode		. "gnus-summary-mode")))
   ("m"     ((in-mode		. "gnus-summary-mode"))))
 org-capture-templates
 '(("t" "Task to be refiled" entry (file org-default-notes-file)
    "* TODO %^{Title}\n%?")
   ("T" "Task to be refiled" entry (file org-default-notes-file)
    "* TODO %^{Title}\n%?")
   ("n" "Information to be refiled" entry (file org-default-notes-file)
    "* %^{Title}\n%?")
   ("m" "Task from mail to be refiled" entry (file org-default-notes-file)
    ;; Lisp is to filter square brackets out of the subject as these mean that
    ;; the Org-mode link does not properly form.  In Org 9.3, the escaping
    ;; syntax for links has changed, so might be able to do something smarter
    ;; than this
    "* TODO [[gnus:%:group#%:message-id][%^{Title|\"%(replace-regexp-in-string \"\\\\\\[\\\\\\|\\\\\\]\" \"\" \"%:subject\")\" from %:fromname}]]\n%?")

   ;; ("a" "Appointment" entry (file+datetree "~/doc/howm/diary.org")
   ;;     "* %^{Time} %^{Title & location}
   ;; %^t" :immediate-finish t)
   ;;    ("A" "Appointment (untimed)" entry (file+datetree "~/doc/howm/diary.org")
   ;;     "* %^{Title & location}
   ;; %^t" :immediate-finish t)

   ("s" "Task for the future to be refiled" entry (file org-default-notes-file)
    "* SOMEDAY %^{Title}\n%?")
   ("d" "Diary entry" entry (file+datetree "~/.labbook.gpg")
    "* %^{Title}\n%U\n\n%?")
   ("u" "URI on clipboard" entry (file org-default-notes-file)
    "* SOMEDAY [[%^{URI|%x}][%^{Title}]]" :immediate-finish t)))

;; `org-forward-paragraph', `org-backward-paragraph' and `org-mark-element' do
;; not leave point where someone who uses `forward-paragraph',
;; `backward-paragraph', `mark-paragraph' very regularly would expect, so
;; allow M-h, M-{ and M-} to have their global bindings.
(spw/reclaim-keys-from org org-mode-map "\M-{" "\M-}" "\M-h"
		       [remap backward-paragraph] [remap forward-paragraph]
		       [remap mark-paragraph])

;; With recent Org we need to unset these variables, too, to have the keys
;; behave as normal.
(defun spw/restore-standard-paragraphs ()
  (kill-local-variable 'paragraph-start)
  (kill-local-variable 'paragraph-separate))

(with-eval-after-load 'org
  (require 'org-agenda)
  (require 'org-inlinetask)
  (require 'org-checklist nil t)

  ;; With the new exporter in Org version 8, must explicitly require the
  ;; exporters I want to use.
  (require 'ox-odt) (require 'ox-ascii)
  ;; (require 'ox-beamer)			; broken on Emacs 30.0.50

  (add-hook 'org-agenda-mode-hook #'hl-line-mode)
  (add-hook 'org-mode-hook #'spw/restore-standard-paragraphs)

  ;; for cyling remote visibility
  (define-key org-agenda-mode-map " " #'org-agenda-cycle-show)

  ;; This works well whether or not `org-adapt-indentation' is t for a buffer.
  (define-key org-mode-map "
" (lambda () (interactive) (org-return t)))

  ;; `org-forward-element', `org-backward-element' are already on C-M-a and
  ;; C-M-e, so for consistency, put `org-mark-element' on C-M-h
  (define-key org-mode-map (kbd "C-M-h") #'org-mark-element)

  (font-lock-add-keywords
   'org-mode `(;; Variable pitch default font without causing misalignment.
	       ;; Regexp derived from Göktuğ Kayaalp's org-variable-pitch.el.
	       (,(rx bol (or (: (0+ blank)
				(or (: (or (+ digit) letter) (in ".)"))
				    (: (or (in "-+") (1+ blank "*"))
				       (opt blank "[" (in "-X ") "]")))
				blank)
			     (1+ blank)
			     (: (1+ "*") blank)))
		0 '(face (:inherit fixed-pitch)) prepend)

	       ;; Howm goto and come-from links.
	       ;; There is `howm-mode-keyword-face' to customise but it
	       ;; doesn't extend to the text of the link.
	       (,(rx (: (or ">>>" "<<<") blank (0+ not-newline)))
		0 `(face (:inherit fixed-pitch
			  :height ,(face-attribute 'default :height)))
		prepend))
   t)
  (add-hook 'org-mode-hook
	    (lambda () (face-remap-add-relative 'default 'variable-pitch)))

  (define-key org-agenda-mode-map "\C-cgf" #'spw/org-agenda-priority-filter))

(defun spw/org-agenda-priority-filter (arg)
  "Hide low-priority items.  If ARG, hide slightly fewer."
  (interactive "P")
  (push (regexp-opt (if arg '("[#A]" "Appt") '("[#A]" "[#B]" "Appt")))
	org-agenda-regexp-filter)
  (org-agenda-filter-apply org-agenda-regexp-filter 'regexp))

;; used by %.docx target in ~/doc/newpapers/philos.mk before commit f3bbd7ec3
(defun spw/process-org-essay-for-pandoc-export ()
  (goto-char (point-max))
  (insert "\n\n")
  (unless (string-match "submission" (buffer-file-name))
    (insert "\n-----\n")
    (insert "/This =.docx/.pdf= generated from plain text master/\n\n")
    (insert (concat "/at " (format-time-string "%-I:%M%#p %Z, %-d %B %Y")
		    ;; " by user =" (user-login-name) "="
		    ;; " on host =" (system-name) "="
		    "/\n")))
  (insert "* References"))

(defun spw/save-my-doc-buffers ()
  "Save all buffers visiting files under ~/doc/.
Called by doccheckin script."
  (let ((root (expand-file-name "~/doc/")))
    (dolist (buffer (buffer-list))
      ;; Avoid recreating most files deleted by `spw/delete-visited-file'.
      (when (and (buffer-modified-p buffer)
		 (or (string-prefix-p root (buffer-file-name buffer))
		     (with-current-buffer buffer
		       (bound-and-true-p remember-notes-mode))))
	(with-current-buffer buffer (basic-save-buffer))))))

;;; Org-mode export
;;;
;;; Org-mode's export engine is great for producing versions of arbitrary Org
;;; files which are more easily shareable with people who don't use Emacs.
;;; For this purpose, exporting to PDF via .odt and LibreOffice's headless
;;; mode is less complex than going via LaTeX, and additionally produces a
;;; .docx which looks the same as the .pdf, which is often wanted for sending
;;; to others.  Keep export engine config simple so that exporting works
;;; robustly.
;;;
;;; For longer term projects where (i) the goal is to produce an output file
;;; distinct from what we edit, rather than simply wanting to export something
;;; for the benefit of non-Emacs users, and/or (ii) for whatever reason we
;;; want to produce PS/PDF with LaTeX, possibly via Pandoc, it is preferable
;;; to have build scripts and/or Makefiles alongside the source files such
;;; that the output files can be rebuilt noninteractively and the external
;;; dependencies are clearly defined -- so, we don't want our document build
;;; to rely on Org-mode export config in this init file, but it would be okay
;;; to rely on Org-mode export config in a separate .el file loaded into Emacs
;;; batch mode.
;;;
;;; (Experience suggests that just authoring in plain LaTeX is probably most
;;; robust, except where we want to produce .docx files, in which case
;;; probably Pandoc with Org-mode source (as is done in ~/doc/newpapers))

;; setting this means if we type C-c C-e o O then the PDF opens for inspection
(setq org-odt-preferred-output-format "pdf")
(spw/feature-add-to-list org-file-apps org '(system . "xdg-open %s"))

;; ... but also ensure we get a .docx (would be better to make
;; `org-odt-preferred-output-format' accept a list)
(defun spw/org-odt-export-docx (&rest ignore)
  (let ((org-input (concat (file-name-sans-extension (buffer-file-name))
			   ".odt")))
    (org-odt-convert org-input "docx")))
(advice-add 'org-odt-export-to-odt :after #'spw/org-odt-export-docx)


;;;; Org-mode agenda

(setq
 org-agenda-custom-commands
 '(;; Minimal agenda on 'a' and a fuller agenda on 'A'.  The idea is to open
   ;; the 'A' agenda, schedule tasks to be done today, and then reference 'a'
   ;; throughout the day.  This is mainly for times when the full agenda has
   ;; too much information that picking out what to do next takes too long.
   ;; At other times, can comment out the minimal view and move the full view
   ;; to 'a', as I had it from approx. 2015--2022.
   ("a" "Primary agenda view"
    ((agenda "day" ((org-agenda-span 'day)
                    (org-agenda-overriding-header
                     "Tasks, appointments and waiting tasks to be chased today")
                    ;; (org-agenda-time-grid nil)
                    (org-agenda-include-diary t)
		    (org-agenda-include-deadlines nil))))
    ((org-agenda-start-with-log-mode t)
     ;; (org-agenda-tag-filter-preset '("-Sariul"))
     ;; (org-agenda-start-with-entry-text-mode t)
     (org-agenda-start-with-follow-mode nil)))
   ("A" "Daily planning view"
    ((agenda "day" ((org-agenda-span 'day)
                    (org-agenda-time-grid nil)
		    (org-agenda-include-diary t)
                    (org-agenda-overriding-header
                     "Plan for today & upcoming deadlines")
		    (org-agenda-skip-function #'spw/skip-routine)))
     (agenda "" ((org-agenda-span 3)
                 (org-agenda-start-day "+1d")
                 (org-agenda-time-grid nil)
                 (org-agenda-repeating-timestamp-show-all t)
                 (org-agenda-include-deadlines nil) ; avoid duplication
                 (org-agenda-entry-types '(:timestamp :sexp :deadline))
                 (org-agenda-show-all-dates nil)
                 (org-agenda-include-diary t)
                 (org-agenda-overriding-header "Coming up")))
     (todo "TODO|NEXT" ((org-agenda-todo-ignore-scheduled t)
			;; Used to have this bound to `far' because I often
			;; set deadlines on tasks far in the future that I
			;; can't complete until much closer to the deadline.
			;; An example is archiving files at the end of an
			;; academic year.
			;;
			;; Currently have it bound to `all' to avoid too much
			;; duplication in this agenda view when a large number
			;; of items have deadlines.  Possibly we could modify
			;; the skip function such that deadlined tasks with
			;; only certain categories are excluded, where those
			;; categories tend to contain many deadlines.
                        (org-agenda-todo-ignore-deadlines 'all)
                        (org-agenda-overriding-header
                         "Unscheduled standalone tasks & project next actions")
                        (org-agenda-skip-function #'spw/skip-non-actionable)))))
   ("#" "Weekly review view"
    ((todo "WAITING" ((org-agenda-todo-ignore-scheduled t)
                      (org-agenda-todo-ignore-deadlines nil)
                      (org-agenda-todo-ignore-with-date nil)
                      (org-agenda-overriding-header
                       "Waiting on others & not scheduled to chase up")))
     (todo "TODO|NEXT" ((org-agenda-todo-ignore-with-date t)
                        (org-agenda-overriding-header "Stuck projects")
                        (org-agenda-skip-function #'spw/skip-non-stuck-projects)))
     (tags "LEVEL=1+REFILE"
           ((org-agenda-todo-ignore-with-date nil)
            (org-agenda-todo-ignore-deadlines nil)
            (org-agenda-todo-ignore-scheduled nil)
            (org-agenda-overriding-header
             "Items to add context tag and priority, and refile")))

     ;; This view shows *only top-level* TODOs (i.e. projects) that
     ;; are complete (and that, for safety, contain no incomplete
     ;; (sub)projects or tasks).  Sometimes I want to archive complete
     ;; subprojects of very large projects that are not yet complete,
     ;; but I don't want to have to make that decision when looking at
     ;; my review agenda.  I can archive these as required.
     ;;
     ;; Add the NOARCHIVE tag if want to stop something from appearing
     ;; in this list, because for whatever reason don't want to
     ;; archive it (e.g. tasks which are in top-level headings
     ;; labelled by semester in Arizona.org (e.g. "* Fall 2019"),
     ;; which I archive all at once after that semester)
     (todo "DONE|CANCELLED"
           ((org-agenda-overriding-header "Tasks to be archived")
            (org-agenda-todo-ignore-scheduled nil)
            (org-agenda-todo-ignore-deadlines nil)
            (org-agenda-todo-ignore-with-date nil)
            (org-agenda-skip-function
             #'spw/skip-incomplete-projects-and-all-subprojects-and-NOARCHIVE)))

     ;; to find files which were mistakenly not added to
     ;; `org-agenda-files'.  to exclude whole files from this list,
     ;; when they contains TODOs for state tracking but I don't need
     ;; to worry about those TODOs except when visiting the file, just
     ;; add #+FILETAGS: NOAGENDA
     (todo "TODO|NEXT|WAITING"
           ((org-agenda-overriding-header
             "Tasks from outside of org-agenda-files")
            (org-agenda-files (spw/org-non-agenda-files))
            (org-agenda-skip-function #'spw/skip-subprojects-and-NOAGENDA)))))

   ("d" "Two month diary" agenda ""
    ((org-agenda-span 60)
     ;; (org-agenda-start-on-weekday 1)
     (org-agenda-time-grid nil)
     ;; (org-agenda-repeating-timestamp-show-all t)
     (org-deadline-warning-days 0)
     (org-agenda-include-deadlines t)
     (org-agenda-skip-deadline-prewarning-if-scheduled nil)
     (org-agenda-entry-types '(:timestamp :sexp :deadline))
     (org-agenda-show-all-dates nil)
     (org-agenda-include-diary t)
     (org-agenda-remove-tags t)
     (org-agenda-overriding-header "Sean's diary for the next two months")))))

(defun spw/org-agenda-filter-by-tag (&rest _ignore)
  (when org-agenda-entry-text-mode (org-agenda-entry-text-mode)))
(advice-add 'org-agenda-filter-by-tag :before #'spw/org-agenda-filter-by-tag)

(defun spw/org-auto-exclude-function (tag)
  (let ((hour-of-day
	 ;; (info "(elisp) Time of Day") suggests you really are meant to use
	 ;; `substring' to get at the hour of the day
         (string-to-number (substring (current-time-string) 11 13))))
    (and
     (cond
       ;; tags passed to org-agenda-auto-exclude-function always
       ;; lower case per Org version 6.34 changelog

       ;; ;; only show La Aldea tasks when on hephaestus
       ;; ((string= tag "@laaldea")
       ;;  (not (string= (system-name) "hephaestus")))

       ;; always hide FLOSS, since I tend to to a tag filter to look at
       ;; those on their own
       ((string= tag "floss")
	t)

       ;; determine whether to hide work or home tasks depending on the
       ;; time of day
       ((string= tag (if (< hour-of-day 16)
                         "@laaldea" "ua"))
	t)

       ;; hide campus tasks in evening
       ((and (string= tag "@campus") (> hour-of-day 16))
	t)
       ((and (string= tag "@office") (> hour-of-day 16))
	t)

       ;; ;; hide office tasks when at home
       ;; ((string= tag "@office")
       ;;  (string= (system-name) "hephaestus"))

       ;; ((string= tag "@campus")
       ;;  (string= (system-name) "athena"))
       ;; ((string= tag "@workstation")
       ;;  (not (or (string= (system-name) "iris")
       ;;           (string= (system-name) "zephyr")
       ;;           (string= (system-name) "hephaestus"))))
       ;; ((string= tag "ua")
       ;;  (= (calendar-day-of-week (calendar-current-date)) 6))
       )
     (concat "-" tag))))
(setq org-agenda-auto-exclude-function #'spw/org-auto-exclude-function)

;;; agenda skipping functions.  Many of these are adapted from Bernt
;;; Hansen's http://doc.norang.ca/org-mode.html

(defmacro spw/has-subheading-such-that (pred)
  `(catch 'matches
     (save-excursion
       (save-restriction
	 (org-narrow-to-subtree)
	 (while (ignore-errors (outline-next-heading))
	   (when ,pred (throw 'matches t)))))))

(defmacro spw/skip-when (condition)
  "Skip trees where CONDITION is false when evaluated when point is on the headline of the tree."
  `(let ((next-headline (save-excursion (outline-next-heading))))
     (when ,condition
       (or next-headline
           ;; if there is no next headline, skip by going to the end
           ;; of the buffer.  An alternative would be (save-excursion
           ;; (forward-line 1) (point))
           (point-max)))))

(defun spw/is-task-or-project-p ()
  (and (not (org-before-first-heading-p))
       (member (org-get-todo-state) org-todo-keywords-1)))

(defun spw/is-project-p ()
  "Any task with a todo keyword subtask"
  (and (spw/is-task-or-project-p)
       (spw/has-subheading-such-that (spw/is-task-or-project-p))))

(defun spw/is-subproject-p ()
  "Any task which is a subtask of another project"
  (and (spw/is-task-or-project-p)
       (catch 'is-subproject
	 (save-excursion
	   (while (org-up-heading-safe)
	     (when (spw/is-task-or-project-p)
	       (throw 'is-subproject t)))))))

(defun spw/is-task-p ()
  "Any task with a todo keyword and no subtask"
  (and (spw/is-task-or-project-p)
       (not (spw/has-subheading-such-that (spw/is-task-or-project-p)))))

(defun spw/skip-subprojects-and-NOAGENDA ()
  "Skip trees that are subprojects, and trees with (possibly
inherited) NOAGENDA tag"
  (spw/skip-when (or (spw/is-subproject-p)
                     (member "NOAGENDA" (org-get-tags)))))

(defun spw/skip-projects-with-scheduled-or-deadlined-subprojects ()
  "Skip projects that have subtasks, where at least one of those
  is scheduled or deadlined"
  (spw/skip-when (spw/has-scheduled-or-deadlined-subproject-p)))

(defun spw/skip-subprojects-and-projects-with-scheduled-or-deadlined-subprojects ()
  "Skip subprojects projects that have subtasks, where at least
  one of those is scheduled or deadlined."
  (spw/skip-when
   (or (spw/is-subproject-p)
       (spw/has-scheduled-or-deadlined-subproject-p))))

(defun spw/skip-incomplete-projects-and-all-subprojects-and-NOARCHIVE ()
  "Skip all subprojects and projects with subprojects not yet
completed, and trees with (possibly inherited) NOARCHIVE tag"
  (spw/skip-when
   (or (spw/is-subproject-p)
       (spw/has-incomplete-subproject-or-task-p)
       (member "NOARCHIVE" (org-get-tags)))))

(defun spw/skip-non-stuck-projects ()
  (spw/skip-when
   (or (spw/is-task-p)
       (spw/has-scheduled-or-deadlined-subproject-p)
       (spw/has-next-action-p))))

(defun spw/skip-routine ()
  (spw/skip-when (and (org-agenda-skip-entry-if 'scheduled)
		      (string= "Routine" (org-get-category)))))

(defun spw/skip-non-actionable ()
  "Skip:
- anything tagged @Sheffield when I'm in Tucson
- anything tagged @Tucson when I'm in Sheffield
- projects (i.e. has subtasks)
- subtasks of projects that are not NEXT actions
- subtasks of SOMEDAY projects
- subtasks of WAITING projects
- subtasks of scheduled projects

In the last case, the idea is that if I've scheduled the project
then I intend to tackle all the NEXT actions on that date (or at
least the next chunk of them); I've broken the project down into
NEXT actions but not for the purpose of handling them on
different occasions."
  (spw/skip-when
   (or
    ;; #1
    ;; melete is a laptop, but usually it's not in Sheffield
    ;; (and (spw/on-host-p "melete.silentflame.com")
    ;;      (member "@Sheffield" (org-get-tags)))
    ;; #2
    (and (spw/on-host-p "zephyr.silentflame.com")
         (member "@Tucson" (org-get-tags)))
    ;; #3
    (spw/is-project-p)

    ;; we used to skip deadlined standalone tasks but actually those
    ;; are actionable in general
    ;; (and (spw/is-task-p)
    ;;      (org-agenda-skip-entry-if 'deadline))

    ;; #4--#7
    (and (spw/is-subproject-p)
         (or
          ;; #4
          (not (string= (nth 2 (org-heading-components)) "NEXT"))
          (save-excursion
            (and
             (org-up-heading-safe)
             (or
              ;; # 5
              (string= (nth 2 (org-heading-components)) "SOMEDAY")
              ;; # 6
              (string= (nth 2 (org-heading-components)) "WAITING")
              ;; # 7
              (org-agenda-skip-entry-if 'scheduled)))))))))

(defun spw/has-scheduled-or-deadlined-subproject-p ()
  "A task that has a scheduled or deadlined subproject"
  (and (not (org-before-first-heading-p))
       (spw/has-subheading-such-that
	(and (spw/is-task-or-project-p)
	     (org-agenda-skip-entry-if 'scheduled 'deadline)))))

(defun spw/has-next-action-p ()
  "A task that has a NEXT subproject"
  (spw/has-subheading-such-that (string= (org-get-todo-state) "NEXT")))

(defun spw/has-incomplete-subproject-or-task-p ()
  "A task that has an incomplete subproject or task."
  (spw/has-subheading-such-that
   (not (member (org-get-todo-state) '("DONE" "CANCELLED")))))

(defun spw/org-non-agenda-files ()
  "Return a list of all Org files which are not normally part of my agenda"
  (let ((agenda-files (org-agenda-files)))
    (cl-remove-if
     (lambda (file)
       (or (member file agenda-files)
	   (let ((name (file-name-nondirectory file)))
	     (or (string-prefix-p "." name)
		 ;; Exclude older files whose filenames aren't dates.
		 ;; Most of those used to be in ~/doc/org/philos and this
		 ;; function ignored that directory.  There are a few files
		 ;; this gets wrong, e.g. entzlist.org.
		 (not (cl-digit-char-p (string-to-char name)))))))
     (directory-files-recursively
      (expand-file-name org-directory) "\\.org\\'" nil))))


;;;; Diary

(custom-theme-set-variables
 'user
 '(appt-display-diary nil)
 '(appt-display-interval 6)
 '(calendar-date-display-form
   '((format "%s-%.2d-%.2d %.3s" year (string-to-number month)
	     (string-to-number day) dayname)))
 '(calendar-date-style 'iso)
 '(calendar-week-start-day 1)
 '(diary-file "~/doc/emacs-diary")
 '(diary-list-entries-hook
   '(diary-include-other-diary-files diary-sort-entries))
 '(diary-mark-entries-hook '(diary-mark-included-diary-files))
 '(holiday-bahai-holidays nil)
 '(holiday-hebrew-holidays nil)
 '(holiday-islamic-holidays nil))

;; Don't bind `diary' globally as for viewing purposes we use Org agenda
;; bindings, and for editing purposes just C-x b suffices.
(global-set-key "\C-cC" #'calendar)

(when (file-readable-p "~/doc/emacs-diary")
  (require 'org-agenda)	; for `org-class'
  (unless
      (bound-and-true-p appt-timer)    ; avoid msgs when `eval-buffer' init.el
    (appt-activate 1))
  (add-to-list 'auto-mode-alist
	       `(,(format "\\`%s\\'" (expand-file-name "~/doc/emacs-diary"))
		  . diary-mode)))

(defun spw/diary-archive-entry (year)
  "Archive diary entry at point to archive for YEAR."
  (interactive (list (nth 5 (decode-time))))
  (goto-char (line-beginning-position))
  (while (looking-at "[[:blank:]]+") (forward-line -1))
  (let ((start (point)))
    (forward-line 1)
    (while (looking-at "[[:blank:]]+") (forward-line 1))
    (append-to-file start (point) (format "~/doc/archive/emacs-diary-%d" year))
    (delete-region start (point))
    (when (and (bolp) (eolp)) (delete-blank-lines))))
(with-eval-after-load 'diary-lib
  (define-key diary-mode-map "\C-z\C-a" #'spw/diary-archive-entry))

(defvar spw/archiveable-diary-entries-re
  (rx bol (? ?&)
      (or
       ;; Basic dated entries.  We're using the Y/M/D not D/M/Y because I have
       ;; to deal with dates written by both Americans and Europeans and using
       ;; the ISO order seems to result in fewer mistakes overall.
       (seq (group-n 1 (** 2 4 num))
	    (or ?/ ?-) (group-n 2 (** 1 2 num))
	    (or ?/ ?-) (group-n 3 (** 1 2 num)))
       ;; Blocks.  The (0+ nonl) is because the call might occur within a call
       ;; to another function.
       (seq "%%(" (0+ nonl) (or "diary-block" "org-class") " "
	    (1+ num) " " (1+ num) " " (1+ num)
	    " " (group-n 1 (** 2 4 num))
	    " " (group-n 2 (** 1 2 num))
	    " " (group-n 3 (** 1 2 num)) ")")))
  "Regexp matching diary entries of mine which are candidates for
automatic removal from `diary-file', if dated in the past.")

(defun spw/diary-archive-old-entries ()
  "Archive diary entries which are dated in the past.
Helps keep the length of `diary-file' manageable."
  (interactive)
  (save-excursion
    (goto-char (point-min))
    (let* ((date (cdddr (decode-time)))
	   (today (encode-time (cl-list* 0 0 0 date)))
	   (tail (cdddr date)))
      (while (re-search-forward spw/archiveable-diary-entries-re nil t)
	(let ((y (string-to-number (match-string 1)))
	      (m (string-to-number (match-string 2)))
	      (d (string-to-number (match-string 3))))
	  (when (> 100 y) (cl-incf y 2000))
	  (when (time-less-p (encode-time (cl-list* 0 0 0 d m y tail)) today)
	    (spw/diary-archive-entry y)))))))
(with-eval-after-load 'diary-lib
  (define-key diary-mode-map "\C-z\C-c" #'spw/diary-archive-old-entries))

(defun spw/export-diary-web-view ()
  "Update athena's ~/local/diary-export.html.

On athena, for the purpose of anonymous access, there is a
manually-created symlink to ~/local/diary-export.html from a
private name under ~/local/pub/hidden/.

We don't use the FILES parameter in the entry for \"d\" in
`org-agenda-custom-commands' to do this because the destination
~/local/diary-export.html is valid only for athena."
  ;; For an alternative approach see the code of `diary-mail-entries', but
  ;; would insert into a buffer visiting ~/local/diary-export.html not a mail
  ;; composition buffer.
  (let (org-agenda-sticky
	(default-directory (expand-file-name "~/doc/")))
    (call-process-shell-command "git pull-safe")
    (save-window-excursion
      (org-agenda nil "d")
      ;; Use HTML not plain text primarily so that links are more readable.
      (org-agenda-write "~/local/diary-export.html"))))

(when (spw/on-host-primary-p "athena.silentflame.com")
  ;; Update the web view every four hours.
  (defvar spw/export-diary-web-view-timer
    (run-at-time t 14400 #'spw/export-diary-web-view)))


;;;; Howm

(custom-theme-set-variables
 'user
 '(howm-directory "~/doc/howm/")
 '(howm-file-name-format "%Y/%Y-%m-%d-%H%M.org")
 '(howm-keyword-file "~/doc/howm/.howm-keys")
 '(howm-view-use-grep t))

(setq howm-prefix "\C-cc"

      ;; Use Org-mode style because our notes are in `org-mode'.
      howm-date-format "%Y-%m-%d %a"
      howm-dtime-body-format "%Y-%m-%d %a %H:%M"
      howm-dtime-format "[%Y-%m-%d %a %H:%M]"
      howm-view-title-header "#+title:"

      howm-template
      '(;; If it is to have a title, add it after writing some content.
	;; We have point start before %file as we will often want to delete
	;; the link or replace its target.
	"%date%cursor %file\n\n"

	;; Literature note, will write a title before any content.  We make
	;; the title a come-from link such that the literature note appears
	;; early in the list of results if we follow a goto link with the same
	;; title as the literature note.
	;;
	;; Have point start before %file, not ready to insert a title, for
	;; consistency with the other template.  (However, we will indeed
	;; often replace the link target with a URL, PDF filename etc..)
	"#+title: <<< %title\n%date%cursor %file\n\n")

      howm-buffer-name-limit 40
      howm-buffer-name-total-limit 40)

;; Default sorting for certain views.
(defun spw/howm-list-all (&rest ignore)
  (howm-view-sort-by-reverse-date))
(advice-add 'howm-list-recent :after #'howm-view-sort-by-mtime)
(advice-add 'howm-list-all :after #'spw/howm-list-all)

(spw/reclaim-keys-from howm-menu howm-menu-mode-map "\C-h")
(spw/reclaim-keys-from riffle riffle-summary-mode-map "\C-h")
(spw/reclaim-keys-from howm-view howm-view-contents-mode-map "\C-h")

;; Alternatively we might rename the file and buffer based on the title, for
;; notes that have one.  But not clear that achieves anything, and it
;; introduces complexity because we would probably want to transform titles.
(spw/feature-add-hook howm-mode-set-buffer-name
  howm (howm howm-after-save-hook))

;; Incrementally replace #+TITLE in old notes.
(defun spw/howm-replace-title-option ()
  (when howm-mode
    (save-excursion
      (save-restriction
	(widen)
	(goto-char (point-min))
	(let (case-fold-search)
	  (when (re-search-forward "^#\\+TITLE: " nil t)
	    (replace-match "#+title: " t)))))))
(spw/when-library-available howm
  (add-hook 'before-save-hook #'spw/howm-replace-title-option))

(defun spw/howm-directory-howm-mode ()
  (when-let ((file (buffer-file-name)))
    (when (file-in-directory-p file howm-directory)
      (howm-mode 1))))
(spw/when-library-available howm
  (with-eval-after-load 'org
    (add-hook 'org-mode-hook #'spw/howm-directory-howm-mode)))

;; Have the global bindings set up right away if we've Howm.
(when (file-directory-p "~/doc/howm/") (require 'howm nil t))


;;;; C and friends

;; following setting also part of Linux kernel style, but it's from
;; newcomment.el, not cc-mode, so must be set in addition to
;; `c-default-style' -- and it's my preference in general
(setq comment-style 'extra-line)

(with-eval-after-load 'cc-mode
  ;; Use the mode-specific paren binding.  Default M-( binding will insert
  ;; spaces before the paren which is not called for by all C styles
  (define-key c-mode-base-map "\M-(" #'c-electric-paren)

  ;; I've seen this interact badly with electric-indent-mode (which is now on
  ;; globally by default, and has been on locally in c-mode for longer I
  ;; believe) outside of comments, but I cannot currently reproduce the
  ;; problem.  Can always just use C-M-j and M-q within comments
  (define-key c-mode-base-map (kbd "RET") #'c-context-line-break)

  ;; would be nice to have a global version of this
  (define-key c-mode-base-map "\C-o" #'c-context-open-line))

;; M-; is adequate for GNU-style comments.  This is for other styles.
(spw/define-skeleton spw/cc-com (c-mode :abbrev "comm" :file 'cc-mode)
  "" nil "/*" \n
  " * " '(c-indent-line-or-region) - \n "*/" '(c-indent-line-or-region))


;;;; Perl

(custom-theme-set-variables
 'user
 ;; See `cperl-indent-parens-as-block'.
 '(cperl-close-paren-offset -4)

 '(cperl-indent-level 4)

 ;; Makes it easier to use longer names for subroutines.
 '(cperl-indent-parens-as-block t)

 '(cperl-lineup-step 1))

(defun spw/perl-add-use (module)
  (interactive "suse ")
  (let ((line (concat "use " module
                      (and (not (string-match ";$" module)) ";"))))
    (save-excursion
      (goto-char (point-min))
      (while (re-search-forward "^use " nil t))
      (forward-line 1)
      (open-line 1)
      (insert line)
      (message (concat "Inserted: " line)))))

(defun spw/perltidy-region (begin end)
  (interactive "r")
  (let ((perltidy-env (getenv "PERLTIDY")))
    (setenv "PERLTIDY"
            (or (concat (expand-file-name
                         (locate-dominating-file
                          (buffer-file-name)
                          ".perltidyrc")) ".perltidyrc")
                perltidy-env))
    (shell-command-on-region begin end "perltidy -q" nil t)
    (font-lock-ensure)
    (setenv "PERLTIDY" perltidy-env)))

;; an older version of this would use the region if it's active, but that
;; rarely produces good results -- perltidy would get the indentation wrong
(defun spw/perltidy-block-or-buffer (&optional arg)
  "Run perltidy on the current block or the whole buffer."
  (interactive "P")
  (if arg
      (spw/perltidy-region (point-min) (point-max))
    (save-excursion
      ;; move to start of current top level block, and tidy that
      ;; (it will probably be the current subroutine).  Although
      ;; `backward-up-list' docstring says that point can end up
      ;; anywhere if there's an error, and this code will always
      ;; produce an error when it tries to call `backward-up-list'
      ;; when it's already at the top level, in fact
      ;; `backward-up-list' does not seem to move point once we
      ;; are at the top level
      ;;
      ;; note that we can't use `beginning-of-defun' as not every top
      ;; level perl block is a defun to Emacs
      (cl-loop for count upfrom 1
	       for start = (point)
	       do (ignore-errors (backward-up-list))
	       until (= start (point))
	       finally (if (= count 1)
			   ;; we didn't move; do whole buffer
			   (spw/perltidy-region (point-min) (point-max))
			 ;; tidy the top level block
			 (let ((begin (line-beginning-position)))
			   (forward-sexp)
			   (forward-line)
			   (spw/perltidy-region begin (point))))))))

(spw/feature-define-keys cperl-mode
  "\C-ciu" spw/perl-add-use "\C-z\C-c" spw/perltidy-block-or-buffer)

;; TODO Take "head" as input too so that we can do =method and =func too.
(spw/define-skeleton spw/cperl-headsub (cperl-mode :abbrev "headsub")
  ""
  "Name and arguments: "
  "=head " str \n \n
  _ \n \n
  "=cut" \n \n
  "sub " (substring str 0 (cl-position ?\( str)) " {" \n
  > _ \n
  "}")

(spw/define-skeleton spw/cperl-trytiny (cperl-mode :abbrev "try")
  ""
  nil
  "#<<<" \n
  "try {" \n _ ?\n
  "} catch {" '(cperl-indent-line) \n _ \n "};" '(cperl-indent-line)
  \n "#>>>")

;; This is for turning one-liners into small scripts.
(spw/define-skeleton spw/cperl-shebang (cperl-mode :abbrev "shebang")
  "" (read-string "Command line options: " "-w") ; e.g. -wln
  "#!/usr/bin/perl " str "\n\n")

(spw/define-skeleton spw/cperl-program (cperl-mode :abbrev "use5")
  "" nil (and (buffer-file-name)
	      (not (file-name-extension (buffer-file-name)))
	      "#!/usr/bin/env perl\n")
  "use 5.036;\n\n" -)

(spw/define-skeleton spw/cperl-package (cperl-mode :abbrev "package")
  ""
  (progn (setq v1 (file-name-base (buffer-file-name)))
	 (read-string (concat "...::" v1 " ")))
  "package " str "::" v1 \n \n
  "use 5.036;\n\n" - "\n\n1;")

;;; init.el ends here