;;; 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-2022  Sean Whitton <spwhitton@spwhitton.name>
;;
;; and is released under the terms of the GNU GPL as published by the FSF;
;; either version 3, or (at your option) any later version.

;;; 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.
;;
;; Prefer using the customise interface for variables, faces and enabling and
;; disabling global minor modes, except when we want to associate an extended
;; comment to a number of settings (typically we use the customise interface's
;; facility for adding comments for only short comments).
;;
;; 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 (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 (expand-file-name "initlibs/" user-emacs-directory) t)

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

;;;; Customisation & appearance

(custom-set-faces
 ;; custom-set-faces was added by Custom.
 ;; If you edit it by hand, you could mess it up, so be careful.
 ;; Your init file should contain only one such instance.
 ;; If there is more than one, they won't work right.
 '(default ((t (:weight medium :height 105 :foundry "SRC" :family "Hack"))))
 '(fill-column-indicator ((t (:background "light gray"))))
 '(fixed-pitch ((t (:foundry "SRC" :family "Hack"))))
 '(region ((t (:extend t :background "#EECD82"))) nil "Colour is from the Lucid build.")
 '(variable-pitch ((t (:weight regular :height 120 :foundry "bitstream" :family "Bitstream Charter"))))
 '(variable-pitch-text ((t (:inherit variable-pitch))) nil "Handled by `spw/maybe-scale-basic-faces' instead."))

;; 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 . ,(if (daemonp) "#FFFFF6" "alice blue"))))))

(defun spw/set-fontset-fonts ()
  "Set some fonts for specific charsets.

This has to happen after there's at least one graphical frame, or
the fonts won't be found and so won't be set.  We use
`after-focus-change-function' for this.  We could call this
function unconditionally if (not (daemonp)), but it's simpler to
always go via `after-focus-change-function'."
  (when (display-graphic-p)
    (remove-function after-focus-change-function #'spw/set-fontset-fonts)
    (let ((spec (font-spec :name "Noto Serif CJK JP")))
      (dolist (charset '(kana han symbol cjk-misc bopomofo))
	(set-fontset-font t charset spec)))
    (set-fontset-font t 'hangul (font-spec :name "Noto Serif CJK KR"))))
(add-function :after after-focus-change-function #'spw/set-fontset-fonts)

(defun spw/maybe-scale-basic-faces (frame)
  "Entry for `window-size-change-functions' to increase font sizes
from those set by `custom-set-faces' for frames on wide monitors,
except where doing so would itself prevent fitting two 80-column
windows side-by-side in the frame."
  (let ((wide-monitor-p
	 (> (cadddr (assoc 'geometry (frame-monitor-attributes frame))) 1635)))
    (when (and (frame-size-changed-p frame)
	       (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 (and (string= "SRC" (face-attribute 'default :foundry frame))
		   (string= "Hack" (face-attribute 'default :family frame)))
	  (set-face-attribute 'default frame :height (if scale-up-p 120 105)))
	(when (and (string= "bitstream"
			    (face-attribute 'variable-pitch :foundry frame))
		   (string= "Bitstream Charter"
			    (face-attribute 'variable-pitch :family 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)

(custom-set-variables
 ;; custom-set-variables was added by Custom.
 ;; If you edit it by hand, you could mess it up, so be careful.
 ;; Your init file should contain only one such instance.
 ;; If there is more than one, they won't work right.
 '(after-save-hook '(executable-make-buffer-file-executable-if-script-p))
 '(appt-display-diary nil)
 '(appt-display-interval 6)
 '(async-shell-command-buffer 'rename-buffer)
 '(auth-source-save-behavior nil)
 '(backup-by-copying-when-linked t)
 '(blink-cursor-mode nil)
 '(bongo-mode-line-indicator-mode nil)
 '(c-default-style "linux")
 '(calc-kill-line-numbering nil)
 '(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)
 '(column-number-mode t)
 '(compilation-scroll-output 'first-error)
 '(confirm-kill-emacs 'y-or-n-p)
 '(copy-region-blink-delay 0)
 '(copyright-names-regexp "Sean Whitton")
 '(copyright-year-ranges t)
 '(cursor-type 'box)
 '(dabbrev-case-fold-search t)
 '(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))
 '(diff-font-lock-prettify t)
 '(dired-async-mode t)
 '(dired-clean-confirm-killing-deleted-buffers nil)
 '(dired-dwim-target t)
 '(dired-free-space 'separate)
 '(dired-isearch-filenames t)
 '(dired-listing-switches "--group-directories-first -alh")
 '(dired-omit-files "\\`\\." nil nil "Exclude all dotfiles (no need for . and .. in dired afaict).")
 '(dired-recursive-copies 'always)
 '(display-fill-column-indicator-character 32)
 '(enable-recursive-minibuffers t)
 '(eshell-cmpl-cycle-completions nil nil nil "This makes Eshell completions a bit more like bash's.")
 '(eshell-history-size 5000)
 '(fido-mode t)
 '(fill-column 78)
 '(gc-cons-threshold 16777216)
 '(gdb-many-windows t)
 '(global-so-long-mode t)
 '(gnus-posting-styles
   '((".*"
      (address "spwhitton@spwhitton.name")
      (name "Sean Whitton"))
     ("chiark\\..*"
      (address "spwhitton@chiark.greenend.org.uk"))))
 '(gnutls-algorithm-priority "NORMAL:-VERS-TLS1.3" nil nil "Seems needed to make HTTPS connections on Debian buster (at least).")
 '(gnutls-min-prime-bits 1024)
 '(gnutls-verify-error t)
 '(haskell-indentation-layout-offset 4)
 '(haskell-indentation-left-offset 4)
 '(holiday-bahai-holidays nil)
 '(holiday-hebrew-holidays nil)
 '(holiday-islamic-holidays nil)
 '(imenu-auto-rescan t)
 '(kill-read-only-ok t)
 '(magit-define-global-key-bindings nil)
 '(magit-diff-refine-hunk 'all)
 '(magit-save-repository-buffers nil)
 '(mail-user-agent 'notmuch-user-agent)
 '(mailscripts-detach-head-from-existing-branch 'ask)
 '(mailscripts-extract-patches-branch-prefix "mail/")
 '(mailscripts-project-library 'project)
 '(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)
 '(message-kill-buffer-on-exit t)
 '(message-templ-alist
   '(("default"
      ("From" . "Sean Whitton <spwhitton@spwhitton.name>"))
     ("UA"
      ("From" . "Sean Whitton <spwhitton@email.arizona.edu>"))))
 '(minibuffer-follows-selected-frame nil)
 '(mm-default-directory "~/tmp/")
 '(mml-secure-openpgp-encrypt-to-self t nil nil "So I can read copies in my sent mail directory.")
 '(mml-secure-openpgp-sign-with-sender t)
 '(mode-line-compact 'long)
 '(mouse-drag-copy-region t nil nil "X primary selection-like behaviour within Emacs even when not available outside.")
 '(mouse-yank-at-point t)
 '(native-comp-async-report-warnings-errors 'silent)
 '(network-security-level 'high)
 '(notmuch-archive-tags '("-unread"))
 '(notmuch-fcc-dirs "sent -unread")
 '(notmuch-mua-cite-function 'message-cite-original-without-signature)
 '(notmuch-mua-user-agent-function
   '(lambda nil
      (format "Notmuch/%s Emacs/%s (%s)" notmuch-emacs-version emacs-version system-configuration)) nil nil "Drop notmuch homepage URI to reduce length.")
 '(notmuch-show-all-tags-list t)
 '(notmuch-show-insert-text/plain-hook
   '(notmuch-wash-convert-inline-patch-to-part notmuch-wash-wrap-long-lines notmuch-wash-tidy-citations notmuch-wash-elide-blank-lines notmuch-wash-excerpt-citations))
 '(nov-text-width 78)
 '(org-adapt-indentation t nil nil "Sometimes set to nil in .dir-locals.el, e.g. in ~/doc/newpapers.")
 '(org-agenda-entry-text-maxlines 3)
 '(org-agenda-files "~/doc/emacs-org-agenda-files")
 '(org-agenda-persistent-filter t)
 '(org-agenda-restore-windows-after-quit t)
 '(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-archive-location "~/doc/org/archive/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)))
 '(org-bookmark-names-plist nil nil nil "Turn off to avoid git merge conflicts.")
 '(org-catch-invisible-edits 'show)
 '(org-cycle-separator-lines 0)
 '(org-deadline-warning-days 60)
 '(org-default-notes-file "~/doc/org/refile.org")
 '(org-directory "~/doc/org/")
 '(org-enforce-todo-checkbox-dependencies t)
 '(org-enforce-todo-dependencies t)
 '(org-footnote-section "Notes")
 '(org-imenu-depth 4)
 '(org-list-allow-alphabetical nil nil nil "So I can start lines with \"P. 211 - \" to refer to p. 211 not start a list.")
 '(org-list-demote-modify-bullet
   '(("-" . "+")
     ("+" . "*")
     ("*" . "-")
     ("1." . "-")
     ("1)" . "-")))
 '(org-list-use-circular-motion t)
 '(org-log-done 'time)
 '(org-log-into-drawer t)
 '(org-log-repeat nil nil nil "Cluttering, and information probably in git.")
 '(org-log-states-order-reversed nil)
 '(org-outline-path-complete-in-steps nil nil nil "Desirable with `fido-mode'.")
 '(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-show-context-detail
   '((agenda . local)
     (bookmark-jump . lineage)
     (isearch . lineage)
     (default . ancestors-full)))
 '(org-special-ctrl-a/e t)
 '(org-special-ctrl-k t)
 '(org-startup-folded t)
 '(org-startup-indented nil nil nil "Ensures buffer text doesn't go beyond 80 columns.")
 '(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)
 '(project-switch-use-entire-map t)
 '(read-minibuffer-restore-windows nil)
 '(remember-data-file "~/local/tmp/emacs-notes")
 '(remember-notes-initial-major-mode 'text-mode)
 '(require-final-newline t)
 '(safe-local-variable-values
   '((ispell-extra-args "--lang=en_US")
     (eval spw/set-pandoc-compile-command "docx" "pdf")))
 '(save-interprogram-paste-before-kill nil nil nil "See <https://debbugs.gnu.org/53728>.")
 '(save-place-mode t nil nil "If quitting Emacs is slow, set `save-place-forget-unreadable-files' to nil.")
 '(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)
 '(show-paren-when-point-in-periphery t nil nil "Useful for C-M-d.")
 '(shr-max-width 78)
 '(tab-always-indent 'complete nil nil "M-TAB not consistently available to Emacs.")
 '(tab-bar-history-mode t)
 '(tab-bar-show 1)
 '(tool-bar-mode nil)
 '(transient-cycles-buffer-siblings-cycle-backwards-key [up])
 '(transient-cycles-buffer-siblings-cycle-forwards-key [down])
 '(transient-cycles-buffer-siblings-mode t)
 '(transient-cycles-default-cycle-backwards-key [up])
 '(transient-cycles-default-cycle-forwards-key [down])
 '(transient-cycles-tab-bar-mode t)
 '(transient-cycles-window-buffers-cycle-backwards-key [up])
 '(transient-cycles-window-buffers-cycle-forwards-key [down])
 '(transient-cycles-window-buffers-mode t)
 '(transient-mark-mode nil)
 '(uniquify-buffer-name-style 'post-forward nil (uniquify))
 '(use-short-answers t)
 '(vc-follow-symlinks t)
 '(warning-suppress-types '((comp)))
 '(which-func-modes '(lisp-mode emacs-lisp-mode c-mode))
 '(which-function-mode t)
 '(window-combination-resize t)
 '(ws-butler-global-mode 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 (apply-partially #'format "%s") libraries))
	    `(locate-library ,(format "%s" 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
    (dolist (key ',keys) (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 collect `(,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 forms = (cl-loop for defn in defns collect `(define-key ,map . ,defn))
    if name collect `(with-eval-after-load ',name . ,forms) else nconc forms)))

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

(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
	       `((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 ((sym (gensym)))
    `(progn (fset ',sym (lambda (&rest args)
			  (remove-hook ,hook ',sym ,local)
			  (apply ,function args)))
	    (add-hook ,hook ',sym ,depth ,local))))

(defmacro spw/add-once-advice (where place function &optional props)
  "Add a piece of advice which removes itself when called.
For something which should happen just once."
  (let ((sym (gensym)))
    `(progn (fset ',sym (lambda (&rest args)
			  (advice-remove ,place #',sym)
			  (apply ,function args)))
	    (advice-add ,place ,where #',sym ,props))))

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

;; 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 (original lambda . body) in commands 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)))


;;;; The *scratch* and *notes* buffers

;; We want Paredit in *scratch* but then it is not practical to use it for
;; temporarily holding other plain text.  So drop "notes you don't want to
;; save" from `initial-scratch-message' (using the Emacs 20 text as a base).
;;
;; We have C-x g or just creating new buffers for holding other plain text.
;; The main difference between these is that the former starts in `text-mode'.
(setq initial-scratch-message
      ";; This buffer is for Lisp evaluation.
;; If you want to create a file, visit that file with \\[find-file],
;; then enter the text in that file\\='s own buffer.\n\n")

;; These use `pop-to-buffer-same-window', so obey `display-buffer-alist'.
;;
;; Unlike ~/doc/org/refile.org and ~/doc/notes/days/, *notes* does not require
;; ~/doc/ checked out.  And we get one per machine, which can be convenient.
(global-set-key "\C-xl" #'scratch-buffer)
(global-set-key "\C-xg" #'remember-notes)

(defun spw/paredit-ctl-j ()
  "Replacement for `paredit-newline' which does traditional Emacs
Lisp Interaction C-j in `lisp-interaction-mode' and similar."
  (interactive)
  (if-let ((command
	    (alist-get major-mode
		       '((lisp-interaction-mode . eval-print-last-sexp)
			 (edebug-eval-mode . edebug-eval-print-last-sexp)))))
      (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)
	(call-interactively command)
	(save-excursion (goto-char start) (indent-pp-sexp t))
	(set-marker start nil)
	(terpri (current-buffer) t))
    (call-interactively #'paredit-newline)))
(define-key paredit-mode-map "\C-j" #'spw/paredit-ctl-j)

;;; 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)
  (spw/paredit-ctl-j))
(define-key lisp-interaction-mode-map
    "\C-z\C-j" #'spw/lisp-interaction-wrap-with-buffer-and-eval)


;;;; Miscellaneous preferences

;; Put all auto-save files under ~/.emacs.d, both local and TRAMP.  Put local
;; backups under local ~/.emacs.d and TRAMP backups under remote ~/.emacs.d.
;; E.g. when editing a file /sudo::/foo on laptop, its auto-saves will go to
;; /home/spwhitton/.emacs.d but its backups will go to /root/.emacs.d.
(let ((backups-dir (concat user-emacs-directory "backups/"))
      (auto-saves-dir (concat user-emacs-directory "auto-saves/")))
  (dolist (dir (list backups-dir auto-saves-dir))
    (make-directory dir t) (chmod dir #o700))
  (setq backup-directory-alist `(("." . ,backups-dir))
        auto-save-file-name-transforms `((".*" ,auto-saves-dir t))
        tramp-auto-save-directory auto-saves-dir
	tramp-backup-directory-alist backup-directory-alist))

(defvar spw/tiling-wm-p nil
  "Have we had at least one frame managed by a tiling window manager?")

(defun spw/disable-mouse-autoselect-window (orig-fun &rest args)
    (let ((mouse-autoselect-window nil))
      (apply orig-fun args)))

;; 'emacsclient --spw/update-environment' supplies us with I3SOCK, so if we
;; see that variable we know there is at least one frame under i3 or swaywm,
;; and so we want to set `mouse-autoselect-window' and `focus-follows-mouse'
;; to t.  As we can't do that frame-locally, once they're set they're set.
;;
;; On the other hand, ideally functions like `spw/save-buffer-for-later'
;; decide whether to open a new frame or a new tab frame-locally, so we used
;; to temporarily set DISPLAY to (frame-parameter (selected-frame) 'display)
;; and then call wmctrl(1) to get the name of the window manager for that
;; frame, and stored it in a frame parameter.  But that only works for X11,
;; not Wayland.  So for now we just set a boolean `spw/tiling-wm-p' frame
;; parameter to which functions like `spw/save-buffer-for-later' can respond.
(defun spw/detect-tiling-wm (frame)
  (unless (or spw/tiling-wm-p
	      (not (setq spw/tiling-wm-p
			 (or (getenv "I3SOCK") (getenv "SWAYSOCK")))))
    (setq focus-follows-mouse t
	  mouse-autoselect-window t
	  desktop-restore-forces-onscreen nil)
    ;; Disable `mouse-autoselect-window' during `display-buffer', to avoid
    ;; surprise focus changes -- some code that calls `display-buffer' does
    ;; not expect `mouse-autoselect-window' to be on.  E.g.  `magit-status'
    ;; can leave focus in the wrong window without this.
    (advice-add 'display-buffer :around #'spw/disable-mouse-autoselect-window))
  ;; If X or Sway, we know we have a usable primary selection, so turn off
  ;; additionally copying to the clipboard.  See also NEWS.24.
  (setq select-enable-clipboard
	(not (or spw/tiling-wm-p (eq (framep frame) 'x)))))
(add-to-list 'after-make-frame-functions #'spw/detect-tiling-wm)

;; this works only for self-insert chars and gets undone by changes in
;; window manager focus, but it's something (and
;; `mouse-avoidance-mode' tends to be more annoying than helpful)
(setq mouse-highlight 1
      make-pointer-invisible t)

(defun spw/use-tabs-not-frames ()
  "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 I use by default)."
  (not (and spw/tiling-wm-p (memq (framep (selected-frame)) '(x pgtk)))))

;; On remote hosts in the UTC timezone, assume I'm in Arizona.  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" "MST")
  (set-time-zone-rule "/usr/share/zoneinfo/America/Phoenix"))

;; 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.  A possible enhancement would be to enter a transient mode in
;; which C-n and C-p can select additional whole lines.
(defun spw/expand-region-to-whole-lines-and-activate ()
  (interactive)
  (when (> (point) (mark))
    (exchange-point-and-mark))
  (beginning-of-line)
  (set-mark (save-excursion (goto-char (mark)) (beginning-of-line 2) (point)))
  (activate-mark transient-mark-mode))
;; used to have it on M-+
(global-set-key "\C-cL" #'spw/expand-region-to-whole-lines-and-activate)

;; Also 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 first M-i C-s second 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 M-i a sort of prefix command: "execute the next command in
;; temporary Transient Mark mode / as if Transient Mark mode were turned on"
(defun spw/activate-mark (&rest _ignore)
  (interactive)
  (activate-mark))
(global-set-key "\M-i" #'spw/activate-mark)

;; resettle the previous occupant of M-i
(global-set-key "\M-I" #'tab-to-tab-stop)

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

(defmacro spw/remap-mark-commands (feature map &rest commands)
  "Remap commands to temporarily activate Transient Mark mode."
  (declare (indent 2))
  (let ((forms
	  (cl-loop for cmd in commands for key = (vector 'remap cmd)
		   for newcmd = (intern (format "spw/%s" (symbol-name cmd)))
		   collect `(defun ,newcmd ()
			      (interactive)
			      (call-interactively #',cmd) (activate-mark))
		   if map collect `(define-key ,map ,key #',newcmd)
		   else collect `(global-set-key ,key #',newcmd))))
    (if feature `(with-eval-after-load ',feature ,@forms) `(progn ,@forms))))

(spw/remap-mark-commands nil nil
  mark-word mark-sexp mark-paragraph mark-defun
  mark-page mark-whole-buffer rectangle-mark-mode)

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

;; If NNTPSERVER has been configured by the local administrator, accept Gnus'
;; defaults.  Otherwise, set the default select method to nnnil so that typing
;; 'M-x gnus' does not hang.
(with-eval-after-load 'gnus
  (unless (gnus-getenv-nntpserver) (setq gnus-select-method '(nnnil ""))))

;; if know the name of group might want to 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-cgn" #'gnus)
(global-set-key "\C-cgG" #'spw/browse-gmane)

;; 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)
  (interactive "p")
  (undo-boundary)
  (let ((start (point)))
    ;; Do skip over \n because `backward-kill-word' does.  Go only backwards.
    (dotimes (_ (abs arg))
      (skip-chars-backward "[:space:]\n")
      (skip-chars-backward "^[:space:]\n"))
    ;; skip forward over any read-only text (e.g. an EShell 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)

;; C-x C-z remains 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))

;; Convenient to drop the additional mark pushed after a yank and after
;; killing the region.  C-z C-z is only a bit shorter, but much easier to
;; remember and to type, than the equivalent sequence C-x C-x C-u C-SPC.
;; Alternatives might be C-x C-SPC, C-x SPC or C-z C-x, moving existing
;; bindings for those under (other parts of) `spw/ctl-z-map'.
;;
;; A common sequence is C-z C-z C-x C-x to get rid of the yank/kill mark and
;; then exchange with a mark that was set primarily for navigational purposes.
;; That too is easy to type on this scheme because the two modified letter
;; keys are on the same side of the keyboard.
;;
;; It would be nice to have this command on a single key, but only if it is
;; easy to follow it up with C-x C-x.
(defun spw/exchange-point-and-mark-and-pop-mark ()
  (interactive)
  (exchange-point-and-mark)
  (set-mark-command t)
  (message "Mark popped"))
(define-key spw/ctl-z-map "\C-z" #'spw/exchange-point-and-mark-and-pop-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.
(cl-macrolet ((case-sensitively (cmd)
		(let ((args (gensym)))
		  `(lambda (&rest ,args)
		     ,(interactive-form cmd)
		     (let (case-fold-search)
		       (apply #',cmd ,args))))))
  (global-set-key [remap zap-to-char] (case-sensitively zap-to-char))
  (define-key spw/ctl-z-map "z" (case-sensitively zap-up-to-char)))

(global-set-key "\M-/" #'hippie-expand)

;; In an emacsclient frame, or a buffer spawned by an eshell process calling
;; emacsclient, this is like '<esc>ZZ' in vi.
(defun spw/save-buffers-kill-emacsclient-noconfirm ()
  (interactive)
  (save-buffer)
  (server-edit))
(global-set-key "\C-cz" #'spw/save-buffers-kill-emacsclient-noconfirm)

(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?
	("\\(\\*\\(eshell\\|scratch\\|compilation\\|scheme\\)\\|-eshell\\*\\)"
	 (display-buffer-pop-up-window display-buffer-same-window)
	 (window-height . 0.20)
	 (preserve-size . (nil . t))
	 (inhibit-same-window . t))

	("\\*notes\\*"
	 (display-buffer-pop-up-window display-buffer-same-window)
	 (inhibit-same-window . t))

	;; 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, Magit etc.  Get going by hitting C-c C-z to bring
	;; up the REPL.
	("\\*\\(slime\\|sly\\)-\\(inspector\\|compilation\\)\\*"
	 display-buffer-in-side-window
	 (window-height . 0.30)
	 (slot . 2)
	 (side . bottom))
	("^\\*\\(sldb\\|sly-db\\)"
	 display-buffer-in-side-window
	 (window-height . 0.30)
	 (slot . 1) ;; might have nested debuggers replace the repl in slot 0
	 (side . bottom))
	;; Keep the repl visible even when we're in the debugger, as there
	;; might be useful output there even though we can't evaluate anything
	;; else (at least with Slime).
	("^\\*\\(slime-repl\\|sly-mrepl\\|inferior-lisp\\)"
	 (display-buffer-reuse-window display-buffer-in-side-window)
	 (window-height . 0.30)
	 (slot . 0)
	 (side . bottom))

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

;; 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")))))))
(global-set-key "\C-cs" #'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)

;; Make `read-only-mode' and `view-mode' basically the same thing -- if the
;; file is read-only then why not rebind the self-insert keys to do something
;; else, esp. c/e/q to get back to where we were.  This also means we have
;; C-x C-r, C-x 4 r, C-x 5 r and C-x C-q available to get into `view-mode'
(setq view-read-only t)
(with-eval-after-load 'view
  (define-key view-mode-map "e" #'View-exit-and-edit)

  ;; already indicated by '%%'/'%*' in mode line
  (diminish 'view-mode))

;; 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)
(diminish 'auto-revert-mode)

;; Work around lack of <https://github.com/magit/magit/pull/4591>.
(setq magit-auto-revert-mode nil)

;; 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.  In recent Emacs you can release the meta key after
;; typing the first digit or minus sign of a numeric argument, rendering these
;; other bindings less useful anyway.
(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)

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

(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-noselect (arg)
  (interactive "P")
  (if arg
      ;; if there's a prefix arg then just `other-window', so that's still
      ;; available on M-1 C-x o
      (call-interactively #'other-window)
    (select-window (spw/get-mru-window) 'mark-for-redisplay)))
(global-set-key [remap other-window] #'spw/back-and-forth-noselect)

(defun spw/other-window-noselect (count &optional interactive)
  (interactive "p\np")
  (cl-flet ((old-select-window (symbol-function 'select-window)))
    (cl-letf (((symbol-function 'select-window)
	       (lambda (window &rest _ignore)
		 (old-select-window window 'mark-for-redisplay))))
      (other-window count nil interactive))))

;; C-x o is easier to type than these, but these are wanted for tapping
;; repeatedly when there are more than two windows.  We could allow left/right
;; to have their normal bindings when there is only one window.
(transient-cycles-define-commands ()
  ;; Don't select the windows we cycle through, so that the window where we
  ;; started becomes the most recently selected window.
  (([right] . spw/other-window-noselect)
   (([left] . spw/backward-other-window-noselect)
        (count &optional interactive)
      (interactive "p\np")
      (spw/other-window-noselect (* -1 count) interactive)))
  (lambda (_ignore) #'spw/other-window-noselect)
  ;; Select the destination window again with NOSELECT nil.
  :on-exit (select-window (selected-window)) :keymap spw/arrow-keys-mode-map
  :cycle-backwards-key [left] :cycle-forwards-key [right])

;; ... and resettle old occupants of C-x <left> and C-x <right>.  This is a
;; bit complicated but we want these commands to be easily repeatable but also
;; avoid setting a transient map containing self-insert chars, as might want
;; to type those right after switching.
(define-key spw/arrow-keys-mode-map [down] #'transient-cycles-cmd-next-buffer)
(define-key spw/arrow-keys-mode-map [up] #'transient-cycles-cmd-previous-buffer)

;; Add bindings under C-c in addition to the arrow keys for use with terminals
;; that have no arrow keys.  'w' is for "window's buffers".
;;
;; Commented out atm because not much use as the subsequent transient cycling
;; uses the arrow keys!
;; (define-key transient-cycles-window-buffers-mode-map "\C-cb"
;;   #'transient-cycles-cmd-next-buffer)
;; (define-key transient-cycles-window-buffers-mode-map "\C-cw"
;;   #'transient-cycles-cmd-previous-buffer)

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

;; ... and resettle previous occupant.
(define-key spw/ctl-z-map "\C-@" #'pop-global-mark)
(define-key spw/ctl-z-map [?\C-\s] #'pop-global-mark)

;; Similar binding strategy for `tab-bar-history-mode': make it repeatable;
;; avoid binding a self-insert char to the transient map; and avoid binding
;; global C-c <left>/<right> as might want these for something else.
;;
;; 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 ()
  ;; Global bindings for these on [up]/[down] in `spw/arrow-keys-mode-map'.
  (([?\C-x left] . tab-bar-history-back)
   ([?\C-x right] . tab-bar-history-forward))
  (lambda (_ignore)
    (lambda (count)
      (interactive "p")
      (if (> count 0) (tab-bar-history-forward) (tab-bar-history-back))))
  :cycle-backwards-key [left] :cycle-forwards-key [right])

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

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

(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)
  (diminish 'abbrev-mode))

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

(when (executable-find "xdg-open")
  (setq browse-url-generic-program "xdg-open"
	browse-url-browser-function #'browse-url-generic))

(global-set-key "\C-cgm" #'man) ; might use C-h C-m
(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)

(diminish 'eldoc-mode)

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

(when (executable-find "bash")
  (setq shell-file-name "bash")
  (setenv "BASH_ENV" (expand-file-name "~/.bash_defns")))

;; Invert meaning of C-u for M-= except when the region is active (though,
;; M-i M-= is easier to type than C-u M-=).
(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)

(global-set-key "\C-cq" #'fill-region-as-paragraph)

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


;;;; TRAMP

;; rely on my ~/.ssh/config
(setq tramp-use-ssh-controlmaster-options nil)

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


;;;; 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 (cl-incf (point)) (cl-decf (mark)))
	(cl-incf (mark)) (cl-decf (point))))))
(add-hook 'post-self-insert-hook
	  #'spw/wrapping-pairs-post-self-insert-function
	  50)			     ; depth same as `electric-pair-mode' uses


;;;; Icomplete

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

;; 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 slightly 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 a `fido-mode' user hardly uses it
(define-key icomplete-fido-mode-map [?\t]
	    (lambda ()
	      (interactive)
	      (when completion-all-sorted-completions
		(call-interactively #'icomplete-fido-ret))))
(define-key icomplete-fido-mode-map [?\r] #'icomplete-fido-exit)

;; Default binding for this function, M-TAB, may not be available to Emacs
;; as it is commonly used by window managers etc., and this is very useful
;; when renaming files.  Also, when typing a path to a remote file on a host
;; we're not connected to use, this can be used to cause TRAMP to open a
;; connection and thereby get filename completion going, though it is
;; smoother to start by using C-x d to connect to the host and only then
;; using C-x C-f.
;;
;; M-j is a better key to rebind than C-j because in C-M-j is bound to the
;; same thing as M-j in the default global map
(define-key icomplete-fido-mode-map [?\M-j] #'icomplete-force-complete)

;; Preserve some standard bindings for editing text in the minibuffer.
(define-key icomplete-minibuffer-map [?\C-j] nil)
(define-key icomplete-fido-mode-map  [?\C-r] nil)
(define-key icomplete-fido-mode-map  [?\C-s] 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-fido-mode-map [?\M-.] #'icomplete-forward-completions)
(define-key icomplete-fido-mode-map [?\M-,] #'icomplete-backward-completions)


;;;; The Emacs shell

;; This is like HISTCONTROL=ignorespace:ignoredups and 'shopt -s histappend'
;; in my ~/.bashrc: append most commands to the shared history file, but don't
;; load that file except when a fresh Eshell buffer is created.
(setq eshell-save-history-on-exit nil)
(defun spw/eshell-append-history ()
  (when (and eshell-history-file-name
	     (symbolp (file-locked-p eshell-history-file-name)))
    (unless (get-buffer " *eshell history*")
      (lock-file eshell-history-file-name)
      (with-current-buffer (get-buffer-create " *eshell history*" t)
	(when (file-exists-p eshell-history-file-name)
	  (insert-file-contents eshell-history-file-name))))
    (let ((latest (substring-no-properties (ring-ref eshell-history-ring 0))))
      (with-current-buffer (get-buffer " *eshell history*")
	(let* ((nlines (car (buffer-line-statistics)))
	       (excess (- nlines eshell-history-size))
	       (previous
		(and (cl-plusp nlines)
		     (save-excursion
		       (goto-char (1- (point-max)))
		       (buffer-substring (point-at-bol) (point-at-eol))))))
	  (unless (or (string-match "^\\s-" latest)
		      (and previous (string= previous latest)))
	    (unless (cl-minusp excess)
	      (forward-line (1+ excess))
	      (delete-region (point-min) (point)))
	    (save-excursion
	      (goto-char (point-max))
	      (let ((start (point)))
		(insert latest "\n")
		(subst-char-in-region start (1- (point)) ?\n ?\177)))
	    (write-region (point-min) (point-max) eshell-history-file-name nil
			  'silent)))))))
(with-eval-after-load 'esh-cmd
  (add-hook 'eshell-pre-command-hook #'spw/eshell-append-history))
(with-eval-after-load 'esh-mode
  (add-hook 'eshell-mode-hook
	    (lambda ()
	      (remove-hook 'eshell-exit-hook #'eshell-write-history t))))

;; We could have an optional argument to kill any input and reinsert it after
;; changing directory, and even restore point within that input.  Might be
;; useful in `spw/eshell-jump' & interactively.
(defun spw/eshell-cd (dir)
  (delete-region eshell-last-output-end (point-max))
  (when (> eshell-last-output-end (point))
    (goto-char eshell-last-output-end))
  (insert-and-inherit "cd " (eshell-quote-argument dir))
  (eshell-send-input))

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

(defun spw/eshell-search-history ()
  (interactive)
  (when (> eshell-last-output-end (point))
    (error "Point not located after prompt"))
  (let* ((icomplete-prospects-height 3)
	 (input
	  (completing-read
	   "Previous input: " (ring-elements eshell-history-ring) nil t)))
    (delete-region eshell-last-output-end (point))
    (insert-and-inherit input)))
(with-eval-after-load 'em-hist
  (define-key eshell-hist-mode-map "\M-r" #'spw/eshell-search-history))
(with-eval-after-load 'em-smart
  (add-to-list 'eshell-smart-display-navigate-list 'spw/eshell-search-history))

(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-z\C-d" #'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-z\C-r" #'spw/eshell-cd-project-root))

;; Work around Emacs bugs #54976 and #54977.
(with-eval-after-load 'esh-module
  (dolist (module '(eshell-elecslash eshell-tramp eshell-xtra))
    (when (locate-library (format "em-%s" (substring (symbol-name module) 7)))
      (add-to-list 'eshell-modules-list module))))

(spw/reclaim-keys-from em-hist eshell-hist-mode-map [up] [down])

;;; prompt

;; Previously used "~/>" -- no trailing space -- where we appended the
;; additional forward slash at the end of the pwd as otherwise it is a bit too
;; short when we're directly inside HOME.  An alternative approach used before
;; that was to call `abbreviate-file-name' only when not directly inside HOME.
(setq eshell-prompt-function
      (lambda ()
	(if (zerop eshell-last-command-status)
	    (concat (abbreviate-file-name (eshell/pwd)) " % ")
	  (format "%s %s %% " eshell-last-command-status
		  (abbreviate-file-name (eshell/pwd)))))
      eshell-prompt-regexp "^[^%\n]* % ")

;;; getting to Eshell buffers

(defun spw/eshell-jump (&optional arg chdir)
  "Pop to the most recently used Eshell not already running a
command, and offer transient cycling among other Eshells, unless
one or more of the following apply:

- If a command is running in all Eshells, start a new one.
  Similarly if all buffers are narrowed; that was probably done
  with C-u C-c C-r, and so such buffers are probably in use.

- If CHDIR, and there is no Eshell in `default-directory' nor any
  Eshell under the current project root, start a new Eshell in
  `default-directory'

- If CHDIR and there is an Eshell in `default-directory', switch
  to that Eshell instead.

- If CHDIR and there is an Eshell under the current project root,
  switch to that Eshell instead, and change its directory to
  `default-directory'.

- If both ARG and CHDIR, or if CHDIR and the current buffer is an
  Eshell buffer, unconditionally start a new Eshell in
  `default-directory'.

  (I.e. C-u may be used to override reusing an existing Eshell,
  and separately, if we are already in the buffer that the
  command would have taken us to, assume we want a fresh one.)

- If not CHDIR and the current buffer is an Eshell that's not
  running a command, activate transient cycling to make it easy
  to get back to another Eshell.  (This is the only case in which
  we do not use `pop-to-buffer' or equivalent, so C-x 4 4 must be
  used to cycle in another window.)

- If CHDIR is `project', as above except that use the root of the
  current project instead of `default-directory', and select an
  Eshell already in the root of the project even if it's busy.

  (The latter exception is to make it easy to use C-x p e to get
  back to long-running builds in project roots for which I'm not
  using C-x p c, such as Debian package builds.)

The 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 need to
  start a new Eshell 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 -- 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 Eshell, we might use C-x 4 4 to start the
  cycling in another window.

- 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."
  (interactive "P")
  (require 'eshell)
  (let* ((default-directory (or (and (eq major-mode 'dired-mode)
				     (dired-current-directory))
				default-directory))
	 (current-project (and (not (file-remote-p default-directory))
			       (project-current)))
	 (project-root (and current-project (project-root current-project)))
	 (target-directory (expand-file-name
			    (or (and (eq chdir 'project) project-root)
				default-directory)))
	 target-directory-eshell same-project-eshell all-eshells)
    (cl-flet ((busy-p (buffer)
		(or (get-buffer-process buffer)
		    (with-current-buffer buffer (buffer-narrowed-p))))
	      (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)
	    (push buffer all-eshells)
	    (when chdir
	      (cond ((and (not target-directory-eshell)
			  (or (not (busy-p buffer)) (eq chdir 'project))
			  (string= default-directory target-directory))
		     (setq target-directory-eshell buffer))
		    ((and project-root (not same-project-eshell)
			  (not (busy-p buffer))
			  (file-in-directory-p default-directory project-root))
		     (setq same-project-eshell buffer)))))))
      (let ((current-eshell (and (eq major-mode 'eshell-mode)
				 (not (busy-p (current-buffer)))
				 (current-buffer))))
	(cond ((and chdir (or arg current-eshell))
	       (fresh-eshell))
	      ((and chdir target-directory-eshell)
	       (pop-to-buffer target-directory-eshell))
	      ((and chdir same-project-eshell)
	       (pop-to-buffer same-project-eshell)
	       (goto-char (point-max))
	       (spw/eshell-cd target-directory))
	      (chdir
	       (fresh-eshell))
	      ((not current-eshell)
	       (if-let ((buf (cl-find-if-not #'busy-p (reverse all-eshells))))
		   (pop-to-buffer buf)
		 (fresh-eshell)))
	      ;; If `display-buffer-overriding-action' has some entries, pop
	      ;; to ourselves, to allow subsequent cycling to a different
	      ;; Eshell in another window, and similar.  E.g. M-! C-x 4 4 M-!.
	      ((or (car display-buffer-overriding-action)
		   (cdr display-buffer-overriding-action))
	       (pop-to-buffer (current-buffer)))))
      (let* ((all (delete (current-buffer) all-eshells))
	     (ring (make-ring (1+ (length all)))))
	(dolist (buffer all)
	  (ring-insert ring buffer))
	(ring-insert ring (current-buffer))
	ring))))

(spw/reclaim-keys-from dired-x dired-mode-map "\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 nil (> arg 4))
	  (when >>>
	    (let ((there (save-excursion
			   (goto-char (point-max))
			   (skip-syntax-backward "\\s-")
			   (- (point) (length >>>)))))
	      (unless (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) (arg)
      (interactive "P")
      (spw/eshell-jump arg t))))

(with-eval-after-load 'project
  (when (boundp 'project-prefix-map)	; for Emacs 27
    (spw/transient-cycles-define-buffer-switch
      ((("e" .  spw/project-eshell) (arg)
	  (interactive "P")
	  (spw/eshell-jump arg 'project)))
      ;; 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)
    ;; Update project-switch-commands accordingly.
    (when-let ((cell (assoc 'project-eshell project-switch-commands)))
      (setcar cell #'transient-cycles-cmd-spw/project-eshell))))

;;; my commands -- like defining functions in .bashrc where simple aliases are
;;; not enough

(defun eshell/package-plan-unpack (package)
  (let* ((patches (progn
		    (string-match "\\(.+\\)-\\([^-]+\\)" package)
		    (expand-file-name (concat "~/src/package-plan/patches/"
					      (match-string 1 package)
					      "/"
					      (match-string 2 package))))))
    (make-directory patches t)
    (eshell/cd "/tmp")
    (eshell-command (concat "cabal unpack --pristine " package))
    (make-symbolic-link patches (concat "/tmp/" package "/patches"))
    (eshell/cd (concat "/tmp/" package))
    (eshell-command "ls ${readlink patches}")))

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

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

;; Just rename -- don't try to update git, unless arg.  Since `vc-rename-file'
;; is quite fussy (from the point of view of a git user) it is good to have
;; something which will always just go ahead and rename
(defun spw/rename-file-and-buffer (arg)
  (interactive "P")
  (let ((file-name (buffer-file-name)))
    (if (and file-name (file-exists-p file-name))
	(let ((new-file-name (read-from-minibuffer "New name: " file-name)))
	  (make-directory (file-name-directory new-file-name) t)
	  (if (and (vc-backend file-name) arg)
	      (vc-rename-file file-name new-file-name)
	    (rename-file file-name new-file-name t)
	    (set-visited-file-name new-file-name t t)))
      (rename-buffer (read-from-minibuffer "New name: " (buffer-name))))))

(defun spw/vc-rename-this-file ()
  (interactive)
  (spw/rename-file-and-buffer t))

(global-set-key "\C-cR"  #'spw/rename-file-and-buffer)
(global-set-key "\C-cvR" #'spw/vc-rename-this-file)

;; Likewise, just delete, unless arg, as `vc-delete-file' can be fussy too
(defun spw/delete-file-and-buffer (arg)
  (interactive "P")
  (when-let ((file-name (buffer-file-name)))
    (if (and (vc-backend file-name) arg)
	(vc-delete-file file-name)
      (when (y-or-n-p (format "Delete %s?" file-name))
	(delete-file file-name)
	(kill-buffer)))))

(defun spw/kill-this-buffer ()
  (interactive)
  (kill-buffer (current-buffer)))
(global-set-key "\C-ck" #'spw/kill-this-buffer)

(defun spw/vc-delete-this-file ()
  (interactive)
  (spw/delete-file-and-buffer t))

(global-set-key "\C-cD"  #'spw/delete-file-and-buffer)
(global-set-key "\C-cvD" #'spw/vc-delete-this-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))))))
(global-set-key "\C-cft" #'spw/toggle-frame-split)

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

(defun spw/dotfiles-rebase ()
  "Rebase & push dotfiles."
  (interactive)
  (let ((default-directory (expand-file-name "~/src/dotfiles/"))
        (buffer (get-buffer-create "*dotfiles rebase*")))
    (display-buffer buffer)
    (async-shell-command "git-dotfiles-rebase" "*dotfiles rebase*")))
(global-set-key "\C-cgd" #'spw/dotfiles-rebase)

(cl-defun spw/myrepos-global-action
    (action &optional (command (concat "mr -s " action)))
  (require 'term)
  (let* ((name (format "*myrepos %s*" action))
	 (buffer (get-buffer-create name)))
    (with-current-buffer buffer
      (erase-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 name "sh" nil (list "-c" command)))
    (let ((window (display-buffer buffer)))
      (when-let ((proc (get-buffer-process buffer)))
	(set-process-sentinel
	 proc (lambda (&rest ignore)
		(with-current-buffer buffer
		  (goto-char (point-min))
		  ;; Reimplement mr's --minimal option, as currently it does
		  ;; not succeed in erasing the "mr ACTION: " lines.
		  (save-excursion
		    (while (re-search-forward
			    (format "^mr %s: \\S-.*/.*\n\n" action) nil t)
		      (delete-region (match-beginning 0) (match-end 0)))))
		(when (window-live-p window)
		  (with-selected-window window (goto-char (point-min))))))))))
(global-set-key "\C-cgr" (lambda ()
			   (interactive)
			   (spw/myrepos-global-action
			    "status" "src-register-all && mr -s status")))
(global-set-key "\C-cgs" (lambda ()
			   (interactive)
			   (spw/myrepos-global-action "sync")))

;; Note there is C-x 5 2 to get the buffer in a new frame without disturbing
;; existing window layout.
(defun spw/window-to-frame ()
  "Like `tear-off-window' but to be invoked from the keyboard."
  (interactive)
  (let ((buffer (current-buffer))
	(display-buffer-overriding-action '(display-buffer-pop-up-frame)))
    (delete-window)
    (display-buffer buffer)))
(global-set-key "\C-cff" #'spw/window-to-frame)

;; 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)))))))
(global-set-key "\C-cfr" #'spw/rotate-windows)

;; not sure if this is needed -- if I need a terminal emulator to run an
;; ncurses problem, am I going to want to do that from `default-directory'?
(defun spw/open-term-here ()
  "Open a terminal emulator in current directory."
  (interactive)
  (call-process "xfce4-terminal" nil 0 nil
                (concat "--working-directory="
                        (expand-file-name  default-directory))
                "-e"  "/bin/bash"))
;; C-c e was for eshells but C-c g t is already in use
(global-set-key "\C-cet" #'spw/open-term-here)

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

;; With these skeletons, and taking advantage of how `notmuch-message-mode'
;; leaves point and mark around the quoted text, can immediately use C-x C-d
;; to kill it all if no need to quote, or C-x C-x to hop back to the top for
;; using M-RET to interleave responses.

(spw/define-skeleton spw/message-dear
    (notmuch-message-mode :abbrev "dear" :file 'notmuch-mua)
  ""
  (read-string "Dear " (ignore-errors (spw/recipient-first-name)))
  "Dear " str "," \n ?\n
  (when (> (mark) (point)) (exchange-point-and-mark) '\n) - "\n")

(spw/define-skeleton spw/message-hello
    (notmuch-message-mode :abbrev "hl" :file 'notmuch-mua)
  ""
  (read-string "Hello " (ignore-errors (spw/recipient-first-name)))
  "Hello " str "," \n ?\n
  (when (> (mark) (point)) (exchange-point-and-mark) '\n) - "\n")

(spw/define-skeleton spw/message-thanks
    (notmuch-message-mode :abbrev "ty" :file 'notmuch-mua)
  ""
  (read-string "Dear " (ignore-errors (spw/recipient-first-name)))
  "Dear " str "," \n \n "Thank you for your e-mail." \n \n
  '(exchange-point-and-mark) \n - "\n")

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

(defun spw/sid-report-bug (package subject)
  (interactive "sSource or binary package name: \nsSubject: ")
  (let* ((type (completing-read "Report bug against: "
                                    '("Source" "Package") nil t))
         (rmadison (shell-command-to-string
                    (concat "rmadison --suite=unstable " package)))
         (version (nth 1 (split-string rmadison "|" t " "))))
    (compose-mail)
    (message-goto-to)
    (insert "Debian Bug Tracking System <submit@bugs.debian.org>")
    (message-goto-subject)
    (insert package ": " subject)
    (message-goto-body)
    (insert type ": " package "\n" "Version: " version "\n")))

;; this one doesn't need a binding as it doesn't come up enough
(defun spw/notmuch-decrypt-inline ()
  (interactive)
  (call-interactively #'mark-whole-buffer)
  (call-interactively #'epa-decrypt-armor-in-region))

;; if we're going to be using multiple frames, make `frame-title-format' not
;; depend on whether there are multiple frames right now
(add-function :after after-focus-change-function #'spw/set-frame-title-format)
(defun spw/set-frame-title-format ()
  (unless (spw/use-tabs-not-frames)
    (remove-function after-focus-change-function #'spw/set-frame-title-format)
    (setq frame-title-format
	  (concat "%b - "
		  (if (file-in-directory-p
		       invocation-directory (expand-file-name "~"))
		      "in-tree" "installed")
		  " GNU Emacs at " system-name)
	  icon-title-format frame-title-format)))

(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-cfs" #'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

;; version of `kill-buffer-and-window' which can handle a frame with only a
;; single window
(defun spw/kill-buffer-and-window ()
  (interactive)
  (if (one-window-p)
      (when (kill-buffer)
	(if (length> (funcall tab-bar-tabs-function) 1)
	    (tab-close)
	  (delete-frame)))
    (kill-buffer-and-window)))
(global-set-key [remap kill-buffer-and-window] #'spw/kill-buffer-and-window)

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

(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/locate-source-library (library)
  (interactive (list (read-library-name)))
  (find-file-other-window (locate-library (concat library ".el"))))

;; unimplemented: update values in any Lisp image we may have
(defun spw/propagate-new-environment ()
  "After '~/src/dotfiles/bin/emacsclient --spw/update-environment'
has updated our env vars, propagate to subenvironments.  Called
by that script, which see."
  (dolist (var '("DISPLAY" "WAYLAND_DISPLAY"
		 "SSH_ASKPASS" "SSH_AUTH_SOCK"
		 "SSH_AGENT_PID" "SSH_CONNECTION"
		 "WINDOWID" "XAUTHORITY" "I3SOCK" "SWAYSOCK"
		 "XDG_SESSION_TYPE" "XDG_CURRENT_SESSION"))
    (when-let ((new-value (getenv var)))
      (dolist (buffer (buffer-list))
	;; 1. Eshells
	(with-current-buffer buffer
	  (when (eq major-mode 'eshell-mode)
	    (setenv var new-value)))))))

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

;; 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.
;;
;; Most of the time I'm working either on things other than Emacs or on Emacs
;; at the Lisp level, and these etc/DEBUG-recommended options, other than
;; --enable-check-lisp-object-type, really do slow Emacs down.  It is quite
;; quick to reconfigure and rebuild Emacs's C core with and without debug
;; flags (the .elc and .eln stick around).  Use an abbrev, without "&& make",
;; to make it easy to reconfigure without the flags.  This also makes it quick
;; to reconfigure without --enable-check-lisp-object-type, for example, so
;; that Lisp objects aren't structs and can be used in break point conditions.
;;
;; Delete the cache each time because I often change 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
  (define-abbrev eshell-mode-abbrev-table "confmacs"
    (string-join '("rm -f config.cache; ./configure -C"
		   "--with-pgtk"
		   "--enable-checking='yes,glyphs'"
		   "CFLAGS='-O0 -g3'"
		   "--enable-check-lisp-object-type")
		 " ")
    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)


;;;; Composing mail

(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 ()
  "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)
  (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"))
  (setq spw/message-normalised t))

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

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

;; 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/mutt-mail-header-separator ()
  (when (string-match "^mutt-" (buffer-name))
    (setq-local mail-header-separator "")))

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

;; Use this to mark sent mail as containing unresolved comments., e.g. when
;; responding to a patch posting.  Remove the flag from the message when the
;; next version of the patch series is seen to resolve the review comments.
;;
;; Don't use this for review comments where I'll notice, without effort,
;; that the revised series does not address the comments.  E.g. don't flag a
;; review comment only objecting to a clone-and-hack of a function: I'll
;; notice the clone-and-hack if it still remains in the revised series, so
;; no need to go back and look at that review comment on the previous series
(defun spw/message-fcc-flag ()
  (interactive)
  (save-excursion (message-goto-fcc) (insert " +spw::unresolved")))

(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 [f8] #'spw/normalise-message)
    (define-key message-mode-map [f9] #'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
      [remap mml-attach-file] #'spw/message-add-attachment)

  ;; mutt uses a blank line to separate the headers from the message body;
  ;; tell Emacs about that, for the case where mutt invokes emacsclient as
  ;; EDITOR
  (add-to-list 'auto-mode-alist '("/mutt-.+$" . message-mode))
  (add-hook 'message-mode-hook #'spw/mutt-mail-header-separator)

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

  ;; this is for the benefit of mutt
  (add-hook 'message-mode-hook #'message-goto-body)

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

  (define-key message-mode-map "\C-ciu" #'spw/message-fcc-flag))


;;;; Dired

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

  (with-eval-after-load 'magit
    (require 'magit-annex)

    (define-key git-annex-dired-map "f" #'magit-annex-file-action-popup)))

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


;;;; 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))
  (let ((unixp (not (memq system-type '(ms-dos windows-nt)))))
    (and (or (not unixp) (getenv "DISPLAY") (getenv "WAYLAND_DISPLAY"))
	 (not (file-remote-p filename)) (not (file-directory-p filename))
	 (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)))))
	     (progn
	       (set-process-query-on-exit-flag
		(start-process-shell-command
		 "spw/try-external-open-process" nil
		 ;; On Unix-like, set things up so process will outlive Emacs.
		 (if unixp (concat "exec nohup " cmd " >/dev/null") cmd))
		(not unixp))
	       t)
	   ;; Just return nil if we were called from Lisp.
	   (and interactive (user-error "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))


;;;; The Notmuch e-mail system's Emacs interface

(setq notmuch-tagging-keys '(("u" ("+unread") "Mark as unread")
                             ("s" ("-unread" "+spam") "Mark as spam")

                             ;; 'm' for 'mute'
                             ("m" ("-unread" "+spw::killed") "Kill thread")

                             ;; for work mail sent to a personal
                             ;; address, or similar
                             ("w" ("+spw::work") "Mark as work-related")

                             ("b" ("+spw::browse") "Mark for browsing")
                             ("d" ("-unread" "+deleted") "Send to trash")
                             ("f" ("-unread" "+flagged") "Unread->flagged")
                             ("F" ("-flagged") "Unflag message"))

      ;; default is t, but given that notmuch searches run to the
      ;; beginning of time, and we are likely to want recent mail, we want
      ;; newer e-mails at the top
      notmuch-search-oldest-first nil

      ;; Don't collapse cited text.  We ought to be able to just remove
      ;; `notmuch-wash-excerpt-citations' from
      ;; `notmuch-show-insert-text/plain-hook', but that function is also
      ;; responsible for colouring cited text (this is an upstream bug:
      ;; that function does the colouring for performance reasons but the
      ;; right answer is to use fontlocking, not overlays, for the
      ;; colouring)
      notmuch-wash-citation-lines-prefix 10000
      notmuch-wash-citation-lines-suffix 10000

      ;; have Emacs set envelope-from to bypass my MTA rewriting of
      ;; user@localhost
      mail-specify-envelope-from t
      mail-envelope-from 'header
      message-sendmail-envelope-from 'header

      ;; when 'unread' is being used as an inbox, want manual resolution
      ;; of messages
      notmuch-show-mark-read-function 'ignore
      notmuch-show-mark-read-tags nil
      ;; but always resolve when I write a reply
      notmuch-message-replied-tags '("-unread" "+replied")

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

(spw/when-library-available notmuch
  ;; Ensure `notmuch-user-agent' is loaded, `notmuch-saved-searches' is
  ;; populated etc. when I invoke certain commands soon after starting Emacs.
  (defun spw/require-notmuch (&rest ignore) (require 'notmuch))
  (dolist (cmd '(compose-mail notmuch-jump-search notmuch-hello
                 compose-mail-other-window compose-mail-other-frame))
    (advice-add cmd :before #'spw/require-notmuch)))

(advice-add #'notmuch-bury-or-kill-this-buffer :override #'bury-buffer)

;; An alternative would be just to bind `notmuch-hello' to C-c m, as s, j
;; and <f9> have appropriate bindings in `notmuch-hello-mode' such that the
;; following complete sequences would still call their associated commands.
(global-set-key "\C-cms" #'notmuch-search)
(global-set-key "\C-cmj" #'notmuch-jump-search)
(global-set-key "\C-cmm" #'notmuch-hello)
(global-set-key [?\C-c ?m f9] #'spw/next-unread-group)

(with-eval-after-load 'notmuch
  (require 'notmuch) (require 'notmuch-hello) (require 'notmuch-message)

  (advice-add 'notmuch-tree-archive-thread :after #'notmuch-tree-next-thread)

  (define-key notmuch-message-mode-map "\C-c\C-s" #'message-goto-subject)

  (define-key notmuch-show-mode-map "\C-cg.g" #'spw/notmuch-import-gpg)
  (define-key notmuch-show-mode-map "\C-cg.a"
    #'spw/notmuch-show-apply-part-to-project)

  ;; we want these not to be adjacent keys
  (define-key notmuch-search-mode-map [f5]		#'spw/spam-message)
  (define-key notmuch-search-mode-map "S"		#'spw/spam-message)
  (define-key notmuch-search-mode-map [f7]		#'spw/kill-thread)
  (define-key notmuch-search-mode-map "\M-k"		#'spw/kill-thread)
  (define-key notmuch-search-mode-map ","		#'spw/maybe-kill-thread)
  (define-key notmuch-search-mode-map [f9]		#'spw/next-unread-group)

  ;; ditto
  (define-key notmuch-show-mode-map   [f5]		#'spw/spam-message)
  (define-key notmuch-show-mode-map   "S"		#'spw/spam-message)
  (define-key notmuch-show-mode-map   [f7]		#'spw/kill-thread)
  (define-key notmuch-show-mode-map   "\M-k"		#'spw/kill-thread)
  (define-key notmuch-show-mode-map   ","		#'spw/maybe-kill-thread)

  ;; ditto
  (define-key notmuch-tree-mode-map   [f5]		#'spw/spam-message)
  (define-key notmuch-tree-mode-map   "S"		#'spw/spam-message)
  (define-key notmuch-tree-mode-map   [f7]		#'spw/kill-thread)
  (define-key notmuch-tree-mode-map   "\M-k"		#'spw/kill-thread)
  (define-key notmuch-tree-mode-map   [f9]		#'spw/next-unread-group)

  (define-key notmuch-hello-mode-map  [f9]		#'spw/next-unread-group)

  (define-key notmuch-tree-mode-map   "\C-cgo"		#'spw/notmuch-reader)
  (define-key notmuch-tree-mode-map   "\C-z\C-c"	#'spw/notmuch-catchup)

  (define-key notmuch-show-mode-map   "\C-cgo"		#'spw/notmuch-reader)
  (define-key notmuch-search-mode-map "\C-z\C-c"	#'spw/notmuch-catchup)

  (define-key notmuch-show-mode-map " "
    #'spw/notmuch-show-advance-and-archive)

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

  (define-key notmuch-show-mode-map "\C-cgf"
    #'spw/notmuch-show-filter-thread-patches)
  (define-key notmuch-show-mode-map "\C-cgi"
    #'spw/notmuch-show-with-remote-images)

  (add-hook 'notmuch-show-mode-hook #'variable-pitch-mode)

  (unless spw/lists-browse-searches (spw/standard-notmuch-saved-searches)))

(defun spw/notmuch-import-gpg ()
  (interactive)
  (when (get-buffer "*notmuch-pipe*")
    (with-current-buffer "*notmuch-pipe*"
      (let ((buffer-read-only nil))
        (erase-buffer))))
  (notmuch-show-pipe-message t "gpg --decrypt | gpg --import")
  (display-buffer "*notmuch-pipe*"))

;; 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/notmuch-show-apply-part-projectile' should perform the checkout
(defun spw/notmuch-show-apply-part-to-project ()
  (interactive)
  (let ((default-directory (expand-file-name (project-prompt-project-dir))))
    (notmuch-show-apply-to-current-part-handle
     (lambda (handle)
       (mm-pipe-part handle "git apply")))))

(defun spw/kill-thread ()
  (interactive)
  (cl-case major-mode
    (notmuch-show-mode
     (notmuch-show-tag '("+spw::killed"))
     (notmuch-show-archive-thread-then-next))
    (notmuch-tree-mode
     (notmuch-tree-close-message-window)
     (notmuch-tree-tag '("+spw::killed"))
     (notmuch-tree-archive-thread)
     (unless (notmuch-tree-get-match)
       (notmuch-tree-next-matching-message))
     (notmuch-tree-show-message nil))
    (notmuch-search-mode
     ;; here we want to avoid tagging every message in the thread to reduce
     ;; pressure on nmbug-spw.git -- so we just pick the first of the matched
     ;; messages
     (notmuch-tag
      (car (split-string (car (plist-get (notmuch-search-get-result) :query))))
      '("+spw::killed"))
     (notmuch-search-archive-thread)))
  (message "Thread killed"))

(defun spw/spam-message ()
  (interactive)
  (cl-case major-mode
    (notmuch-show-mode
     (notmuch-show-tag '("-unread" "+spam"))
     (notmuch-show-archive-message-then-next-or-next-thread))
    (notmuch-tree-mode
     (notmuch-tree-tag '("-unread" "+spam"))
     (notmuch-tree-next-matching-message)))
  (message "Message marked as spam"))

(defun spw/notmuch-reader ()
  (interactive)
  (with-current-buffer (or notmuch-tree-message-buffer (current-buffer))
    (save-excursion
      (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))
       (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))
	  (spw/add-once-hook 'eww-after-render-hook #'eww-readable)
	  (eww url)))))))

(defun spw/notmuch-show-stable-matching-query ()
  (let (ids)
    (notmuch-show-mapc
     (lambda ()
       (let ((props (notmuch-show-get-message-properties)))
	 (when (plist-get props :match)
	   (push (concat "id:" (plist-get props :id)) ids)))))
    (string-join ids " ")))

(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)"))
(defalias 'spw/th{ (apply-partially #'format "thread:{%s}"))

(defvar spw/lists-readall nil
  "Lists where I want to read all posts as though they're addressed
directly to me.  These get inserted into my main inbox view.")

(defvar spw/lists-browse nil
  "Lists I want to read like newsgroups, though with no expiry
and manual catchup.  Use `spw/next-unread-group' to read new postings.")

(defvar spw/lists-archiveonly nil
  "Lists to which I'm subscribed only because I want to archive all
postings.  notmuch post-new hook should mark as read.")

(defvar spw/weekday-only-mail
  (spw/nm| "to:spwhitton@email.arizona.edu" "from:arizona.edu"
	   (spw/th{ "tag:spw::work"))
  "Mail to be filtered out of processing views at the weekend.")

(defvar spw/readall nil)
(defvar spw/lists-browse-searches nil)
(defun spw/standard-notmuch-saved-searches ()
  (interactive)
  (setq notmuch-saved-searches nil spw/lists-browse-searches nil)
  (when (file-exists-p (locate-user-emacs-file "notmuch-private.el"))
    (load (locate-user-emacs-file "notmuch-private"))
    (cl-loop for group in spw/lists-browse
             for name = (if (atom group)
                            ;; Assume we got a List: search and extract the
                            ;; first component of the List-Id to use as the
                            ;; name of the search.
                            (if (string-match ":\\([^.]+\\)\\." group)
				(match-string 1 group)
                              (error "Could not extract a list name"))
			  (plist-get group :name))
             for query
	       = (if (atom group) group (spw/nm| (plist-get group :queries)))
             for usearch = `(:name ,(concat name " unread")
                                   :search-type nil :sort-order newest-first
                                   :query ,(spw/nm& "tag:unread" query))

	     ;; We used to add the search without tag:unread with the idea of
	     ;; accessing from `notmuch-hello' and then using
	     ;; `notmuch-search-filter' to find something in particular.  But
	     ;; I just do toplevel searches.
             ;; collect `(:name ,name :search-type nil :sort-order newest-first
             ;;                 :query ,query :key ,(plist-get group :key))
             ;; into searches

             ;; Add tag:unread search as a saved search so buffers created by
             ;; `spw/next-unread-group' get a reasonable name.
             collect usearch into searches
             collect (list :search usearch
                           :catchup-method (plist-get group :catchup-method))
             into browse-searches
             finally (setq notmuch-saved-searches searches
                           spw/lists-browse-searches browse-searches)))
  (setq spw/readall (spw/nm& (spw/nm~ (spw/th{ "tag:spw::browse"))
			     (spw/nm| "query:inbox" spw/lists-readall)))
  (let* ((to-process (spw/nm& "tag:unread" spw/readall))
	 (feeds (spw/nm| "from:rss2email@athena.silentflame.com"
			 "from:gmi2email@athena.silentflame.com"))
	 (categorised
	  (spw/nm| spw/readall spw/lists-archiveonly
		   (cl-loop for search in spw/lists-browse
			    if (atom search) collect search
			    else collect (plist-get search :queries))))

	 ;; 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& "tag:unread" feeds (spw/nm~ categorised)))

	 ;; 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& "tag:unread" (spw/nm~ feeds) (spw/nm~ categorised))))

    (push `(:search (:name "Uncategorised feeds" :query ,uncategorised-feeds)
		    :catchup-method :archive)
	  spw/lists-browse-searches)
    (rplacd (last spw/lists-browse-searches)
	    `((:search
	       (:name "uncategorised unread" :query ,uncategorised-other))))

    ;; Prepend inbox views for processing the day's mail addressed to me.
    (setq notmuch-saved-searches
	  (cl-list*
	   `(:name "Weekday unread" :key "u" :search-type nil
		   :sort-order oldest-first :query ,to-process)
	   `(:name "Weekend unread" :key "w" :search-type nil
		   :sort-order oldest-first
		   :query ,(spw/nm& to-process
				    (spw/nm~ spw/weekday-only-mail)))
	   `(:name "Uncategorised feeds" :key "r" :search-type nil
		   :sort-order newest-first :query ,uncategorised-feeds)
	   notmuch-saved-searches))

    ;; Append some miscellaneous views.
    (rplacd (last notmuch-saved-searches)
	    `((:name "Flagged" :key "f" :search-type tree :query "tag:flagged")
	      (:name "Sent" :key "s" :search-type nil
                     :sort-order newest-first
                     :query ,(spw/nm|
			      (mapcar (apply-partially #'concat "from:")
				      (notmuch-user-emails))))
	      (:name "Drafts" :key "d" :search-type nil
                     :sort-order newest-first :query "tag:draft")
	      (:name "Imported series" :key "p" :search-type nil
                     :sort-order newest-first
                     :query "subject:\"/PATCH .+ imported/\"")
	      (:name "Phone notes" :key "n" :search-type nil
		     :sort-order newest-first :query "folder:notes")
	      (:name "Uncategorised unread" :key "U" :search-type nil
		     :sort-order newest-first :query ,uncategorised-other)))))

(defun spw/notmuch-catchup-by-archive ()
  (interactive)
  (when (and (memq major-mode '(notmuch-tree-mode notmuch-search-mode))
	     (y-or-n-p "Are you sure you want to mark all as read?")
	     spw/readall)
    (let ((query (if (eq major-mode 'notmuch-tree-mode)
		     (notmuch-tree-get-query)
		   (notmuch-search-get-query))))
      (notmuch-tag (spw/nm& query (spw/nm~ spw/readall)) '("-unread")))
    (spw/next-unread-group)))

(defun spw/maybe-kill-thread (&optional resolve)
  (interactive "p")
  (unless (bound-and-true-p spw/readall)
    (error "`spw/readall' not defined; unsafe to proceed"))
  (let* ((thread-id
	  (cl-ecase major-mode
	    (notmuch-search-mode
	     (concat "thread:"
		     (plist-get (notmuch-search-get-result) :thread)))
	    (notmuch-show-mode notmuch-show-thread-id)))
	 (message-ids
	  (cl-ecase major-mode
	    (notmuch-search-mode
	     (car (notmuch-search-find-stable-query)))
	    (notmuch-show-mode (spw/notmuch-show-stable-matching-query))))
	 (method-buffer (or notmuch-show-parent-buffer (current-buffer)))
	 (catchup-method (and (buffer-local-boundp
			       'spw/notmuch-catchup-method method-buffer)
			      (buffer-local-value
			       'spw/notmuch-catchup-method method-buffer)))
	 (killp (not (eq :archive catchup-method))))
    ;; If any messages match `spw/readall' then for safety user must call
    ;; `spw/kill-thread', which has a harder-to-press binding.
    (unless (zerop
	     (string-to-number
	      (notmuch-saved-search-count (spw/nm& thread-id spw/readall))))
      (user-error "Some messages in thread match `spw/readall'"))
    ;; Catchup only the messages that were matched by the saved search.
    (notmuch-tag message-ids '("-unread"))
    ;; Kill unless we are in / came from a search in which we catchup by
    ;; marking all as read.  This means we can call this function to work
    ;; through groups with either catchup method.
    ;;
    ;; As in `spw/kill-thread' for `notmuch-search-mode', want to tag only a
    ;; single message with spw::killed.
    (when killp
      (notmuch-tag (car (split-string message-ids)) '("+spw::killed")))
    (when resolve
      (cl-case major-mode
	(notmuch-search-mode
	 (let* ((result (notmuch-search-get-result))
		(tags (remove "unread" (plist-get result :tags))))
	   (notmuch-search-update-result
	    (plist-put result
		       :tags (if killp (cons "spw::killed" tags) tags))))
	 (notmuch-search-next-thread))
	(notmuch-show-mode (notmuch-show-next-thread t))))))

(defun spw/notmuch-catchup-by-killing ()
  (interactive)
  (when (and (eq major-mode 'notmuch-search-mode)
	     (y-or-n-p "Are you sure you want to kill all threads?"))
    (goto-char (point-min))
    (while (notmuch-search-get-result)
      ;; Don't touch unless there are unread messages, so that we skip over
      ;; threads which have been manually processed -- this is in case I
      ;; just archived the thread without killing it, and want any new
      ;; messages to show up as unread.
      ;;
      ;; We can't rely on (plist-get (notmuch-show-get-result) :tags) here
      ;; because that might be out-of-date if the thread was archived from
      ;; `notmuch-show-mode' rather than this buffer, and we can't refresh
      ;; the buffer as we don't want to kill any newly-arrived threads
      (unless
	  (zerop
	   (string-to-number
	    (notmuch-saved-search-count
	     (spw/nm& "tag:unread" (car (notmuch-search-find-stable-query))))))
	(ignore-error user-error (spw/maybe-kill-thread)))
      (notmuch-search-next-thread))
    (spw/next-unread-group)))

(defun spw/notmuch-show-advance-and-archive ()
  "Like `notmuch-show-advance-and-archive' but confirm thread archive.

Note that this does not archive individual messages are you
scroll through them."
  (interactive)
  (when (or ;; since we have a confirmation, it's fine to archive when point
	 ;; it not yet at the bottom of the window
	 (pos-visible-in-window-p (point-max))
	 (notmuch-show-advance))
    (if (or (pos-visible-in-window-p (point-min))
	    (let ((map (make-sparse-keymap)))
	      (set-keymap-parent map query-replace-map)
	      (define-key map " " 'ignore)
	      ;; override usual map so SPC cannot confirm the archive, to
	      ;; avoid accidental archives
	      (let ((query-replace-map map))
		(y-or-n-p "Mark all as read before moving on?"))))
	(when (and notmuch-show-thread-id notmuch-archive-tags)
	  ;; only tag messages which would have been expanded when we opened
	  ;; the thread
	  (notmuch-tag (spw/notmuch-show-stable-matching-query)
		       (notmuch-tag-change-list notmuch-archive-tags nil))
	  (notmuch-show-next-thread t))
      (notmuch-show-next-thread-show))))

;; use on views produced by `spw/next-unread-group'
(defun spw/notmuch-catchup (arg)
  (interactive "P")
  (if (or arg (and (boundp 'spw/notmuch-catchup-method)
		   (eq :archive spw/notmuch-catchup-method)))
      (spw/notmuch-catchup-by-archive)
    (spw/notmuch-catchup-by-killing))
  (message "Group caught up"))

(defun spw/next-unread-group ()
  (interactive)
  (let ((already-looking (boundp 'spw/more-unread-groups))
        (queries (bound-and-true-p spw/more-unread-groups))
        (remaining))
    (when already-looking
      (when (eq major-mode 'notmuch-tree-mode)
	(notmuch-tree-close-message-window))
      (kill-buffer (current-buffer)))
    (if (or (and already-looking (not queries))
            (not (setq remaining
		       (cl-loop with queries
			          = (or queries spw/lists-browse-searches)
				if (and queries
					(zerop
					 (string-to-number
					  (notmuch-saved-search-count
					   (plist-get
					    (plist-get (car queries) :search)
					    :query)))))
				do (pop queries) else return queries))))
	(set-transient-map
	 (let ((map (make-sparse-keymap)))
	   (define-key map [f9] #'spw/next-unread-group) map))
      (let* ((search (plist-get (car remaining) :search))
	     (name (plist-get search :name)))
	;; I think that a tree-style view is probably best for browsing
	;; groups, but atm notmuch-tree's use of windows is a bit inflexible,
	;; so use notmuch-search
	;; (notmuch-tree search nil nil
	;;               (concat "*notmuch-tree-saved-search-" name "*"))
	(notmuch-search (plist-get search :query) t)
	;; renaming the buffer seems to break refreshing it & reversing the
	;; sort order
	;; (rename-buffer
	;;  (concat "*notmuch-saved-search-"
	;;          (plist-get (plist-get (car remaining) :search) :name) "*")
	;;  t)
	(set (make-local-variable 'spw/more-unread-groups) (cdr remaining))
	(set (make-local-variable 'spw/notmuch-catchup-method)
	     (plist-get (car remaining) :catchup-method)))
      (put 'spw/more-unread-groups 'permanent-local t)
      (put 'spw/notmuch-catchup-method 'permanent-local t))))

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

;; In a thread with patches, try to collapse 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 thread.  Include spw::unresolved mail, 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 unresolved
;; review comments on the old series, and the series are in different threads,
;; open each thread in a separate buffer (probably in separate frames).  Run
;; this command in the new series' buffer and hit `l tag:spw::unresolved RET'
;; in the old series' buffer
(defun spw/notmuch-show-filter-thread-patches (&optional reroll-count)
  (interactive "P")
  (let ((subject-filter
         (if reroll-count
             (let ((n (prefix-numeric-value reroll-count)))
               (if (= n 1)
		   (concat "("
			   "subject:/\\[.*PATCH[^v]*\\]/"
			   "or"
			   "subject:/\\[.*PATCH.*v1.*\\]/"
			   ")")
                 (concat "subject:/\\[.*PATCH.*v"
			 (number-to-string n)
			 ".*\\]/")))
           "subject:/\\[.*PATCH.*\\]/ ")))
    (notmuch-show-filter-thread
     (concat "tag:unread or tag:spw::unresolved or ("
             subject-filter
             " and not subject:'Re:' and not subject:'Info received')"))))

(defun spw/notmuch-show-with-remote-images ()
  (interactive)
  (setq-local notmuch-show-text/html-blocked-images nil
	      notmuch-multipart/alternative-discouraged '("text/plain"))
  (notmuch-show-refresh-view))


;;;; Assorted packages

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

(diminish 'paredit-mode)

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

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

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

(defun spw/lisp-hippie-expand ()
  "Remove some `hippie-expand' functions which interact poorly with paredit."
  (make-local-variable 'hippie-expand-try-functions-list)
  (dolist (fun '(try-expand-line try-expand-list))
    (setq hippie-expand-try-functions-list
          (remq fun hippie-expand-try-functions-list))))
(add-hook 'paredit-mode-hook #'spw/lisp-hippie-expand)

(defun spw/paredit-no-space-after (endp delimiter)
  (or endp
      (let ((two-before (buffer-substring (- (point) 2) (point))))
	(cl-case delimiter
	  (?\(
	   (not
	    (or (char-equal (char-before) ?,) (string= ",@" two-before))))
	  (?\"
	   (not
	    (or (string= "#P" two-before) (string= "#?" two-before))))
	  (t t)))))
(add-to-list
 'paredit-space-for-delimiter-predicates #'spw/paredit-no-space-after)

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

(spw/when-library-available magit
  ;; Ensure we add magit to project-prefix-map and project-switch-commands as
  ;; soon as a project.el command is invoked.
  (eval-after-load 'project '(require 'magit)))

(global-set-key "\C-cgg" #'magit-file-dispatch)

(spw/reclaim-keys-from magit magit-mode-map "\M-w")
(with-eval-after-load 'magit
  ;; drop "Unpulled from pushremote" which doesn't make sense with how
  ;; I use push remotes
  (remove-hook 'magit-status-sections-hook
               #'magit-insert-unpulled-from-pushremote)

  ;; replace unpushed-to-upstream-or-recent with unpushed-to-upstream
  ;; (undoing recent change to show "Recent commits" after pushing
  ;; everything)
  ;; from: https://github.com/magit/magit/issues/3230
  (magit-add-section-hook 'magit-status-sections-hook
                          #'magit-insert-unpushed-to-upstream
                          #'magit-insert-unpushed-to-upstream-or-recent
                          'replace)

  ;; try to prevent unpushed commits section being collapsed
  (add-to-list 'magit-section-initial-visibility-alist '(unpushed . show))

  (require 'magit-extras)
  ;; magit-extra's code to do this is conditional on `project-switch-commands'
  ;; having its default value.  Always add it.
  (with-eval-after-load 'project
    (when (boundp 'project-prefix-map)	; for Emacs 27 compat
      (define-key project-prefix-map "m" #'magit-project-status)
      (add-to-list 'project-switch-commands '(magit-project-status "Magit") t))))

(diminish 'ws-butler-mode)

;; 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
(setq ws-butler-global-exempt-modes '(markdown-mode message-mode))

(global-set-key "\C-cP" #'redtick)
(global-set-key "\C-cgP" #'redtick-mode)
(setq redtick-history-file nil)

;; Insert a copy of the timer earlier in the mode line for when the standard
;; one is pushed out of visibility by a long buffer name in a narrow window.
(with-eval-after-load 'redtick
  (let ((addition
	 '(:eval (cond ((and redtick-mode (redtick--selected-window-p))
			(list redtick--current-bar " "))
		       (redtick-mode "  "))))
	(format (default-value 'mode-line-format)))
    (unless (member addition format)
      (catch 'done
	(while (setq format (cdr format))
	  (when (eq (cadr format) 'mode-line-buffer-identification)
	    (throw 'done (rplacd format (cons addition (cdr format))))))))))

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

(spw/when-library-available nov
  (add-to-list 'auto-mode-alist '("\\.epub\\'" . nov-mode)))

(global-set-key "\C-cvt" #'notmuch-extract-thread-patches-to-project)
(global-set-key "\C-cvw" #'notmuch-extract-message-patches-to-project)
(global-set-key "\C-cgb" #'notmuch-slurp-debbug)
(global-set-key "\C-cgB" #'notmuch-slurp-this-debbug)

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

(setq org-roam-v2-ack t)

(spw/when-library-available org-roam
  (dolist (fn '(org-roam-dailies-goto-next-note
		org-roam-dailies-goto-previous-note))
    (autoload fn "org-roam-dailies"))

  (setq org-roam-directory (expand-file-name "~/doc/notes")
	org-roam-dailies-directory "days/"
	org-roam-capture-templates
	'(("c" "concept" plain "%?" :if-new
	   (file+head "%<%Y%m%d%H%M%S>-${slug}.org" "#+TITLE: ${title}\n")
	   :unnarrowed t :immediate-finish t)
	  ("l" "literature" plain "- topics ::\n- source :: %?" :if-new
	   (file+head "%<%Y%m%d%H%M%S>-${slug}.org" "#+TITLE: ${title}\n")
	   :unnarrowed t)))

  (global-set-key "\C-cof" #'org-roam-node-find)

  ;; An alternative would be to bind C-c o <left>/<right> to
  ;; org-roam-dailies-goto-yesterday and -tomorrow, but that would mean the
  ;; keys have different meanings in and out of Org-mode buffers.
  (transient-cycles-define-commands ()
    (([?\C-c ?o left] . org-roam-dailies-goto-previous-note)
     ("\C-cod" . org-roam-dailies-goto-today)
     ([?\C-c ?o right] . org-roam-dailies-goto-next-note))
    (lambda (_ignore) #'org-roam-dailies-goto-next-note)
    :cycle-backwards-key [left] :cycle-forwards-key [right])

  ;; don't bother starting it up until we open something in Org-mode
  (with-eval-after-load 'org
    (when (file-directory-p org-roam-directory)
      (org-roam-db-autosync-enable))))

(spw/feature-define-keys ((org-roam org-mode-map))
  "\C-cir" org-roam-node-insert "\C-cor" org-roam-buffer-toggle)

;; company is used by notmuch for address completion; otherwise unused
(with-eval-after-load 'company
  (setq company-idle-delay nil
        company-echo-delay 0)

  ;; prefer my global C-w binding
  (define-key company-active-map "\C-w" nil)
  ;; resettle
  (define-key company-active-map "\M-o" #'company-show-location))

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

(setq ebib-preload-bib-files (list (expand-file-name "~/doc/spw.bib"))
      ebib-index-display-fields '(title)
      ebib-save-xrefs-first t)

(with-eval-after-load 'ebib
  (setq ebib-hidden-fields (delete "translator" ebib-hidden-fields)))

(with-eval-after-load 'haskell-mode
  (add-hook 'haskell-mode-hook 'subword-mode)

  (spw/when-library-available haskell-tab-indent
    ;; 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'
    (add-hook 'haskell-mode-hook
              (lambda ()
		(add-hook 'hack-local-variables-hook
                          (lambda ()
                            (if indent-tabs-mode
				(haskell-tab-indent-mode 1)
                              (haskell-indentation-mode 1)))
                          nil t)))))

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

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

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

(setq bongo-default-directory (expand-file-name "~/annex/music/")
      bongo-prefer-library-buffers nil
      bongo-insert-whole-directory-trees t)

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

(defun spw/disable-gnutls-verify (&rest ignore)
  (setq-local gnutls-verify-error nil))

(with-eval-after-load 'elpher
  ;; see #981148
  (advice-add 'elpher-get-host-response :before #'spw/disable-gnutls-verify)

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

(spw/when-library-available consfigurator
  (defun spw/consfig-indentation-hints ()
    (put 'spwcrontab 'common-lisp-indent-function '1)
    (put 'kvm-boots-trusted-chroot. '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)
  (with-eval-after-load 'cl-indent
    (activate-consfigurator-indentation-hints))
  (with-eval-after-load 'slime-cl-indent
    (activate-consfigurator-indentation-hints)))


;;;; Lisp

(define-key emacs-lisp-mode-map "\C-z\C-e" #'eval-buffer)

;; Add an `imenu-generic-expression' entry for macros from Consfigurator and
;; from my consfig.  Would be better to somehow use .dir-locals.el.
(defun spw/lisp-mode-imenu-setup ()
  (cl-pushnew '(nil "^\\s-*(def\\(?:ine-athenet-\\(?:router\\|container\\)\
\\|prop\\(?:list\\|spec\\)?\\|host\\)\\s-+\\([-A-Za-z0-9.+]+\\)" 1)
	      imenu-generic-expression))

(with-eval-after-load 'lisp-mode
  ;; Experimental addition to syntax table for CL-INTERPOL.
  (modify-syntax-entry ?? "_ p" lisp-mode-syntax-table)

  (add-to-list 'lisp-mode-hook #'spw/lisp-mode-imenu-setup))

(spw/reclaim-keys-from xscheme scheme-mode-map "\eo" "\ez")
(with-eval-after-load 'xscheme
  (define-key scheme-mode-map "\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)))))

(global-set-key "\C-cgh" #'hyperspec-lookup)

(spw/remap-mark-commands slime-presentations slime-editing-map
  slime-mark-presentation)

;; `inf-lisp' says this is a defcustom and `slime' says it is a defvar, so
;; `custom-save-variables' will print the NOW field in the corresponding
;; argument to `custom-set-variables' as t or nil depending on whether or not
;; `inf-lisp' and/or `slime' happen to be loaded, and possibly even depending
;; on the order in which they were loaded.  To prevent spurious changes to the
;; NOW field randomly showing up in git diffs of init.el, set the variable
;; without using the customisation interface.
(setq inferior-lisp-program "sbcl")

(with-eval-after-load 'slime
  (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-setup-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-setup :around #'spw/sldb-setup-avoid-focus-grab))

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

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

(with-eval-after-load 'sly
  ;; restore SLIME's a/q debugger keys
  (define-key sly-db-mode-map "q" #'sly-db-quit)
  (define-key sly-db-mode-map "Q" nil)

  ;; have C-c C-z obey `display-buffer-alist'
  ;; https://github.com/joaotavora/sly/issues/428
  (defun spw/sly-mrepl ()
    (interactive)
    (sly-mrepl #'pop-to-buffer))
  (define-key sly-mode-map "\C-c\C-z" #'spw/sly-mrepl)

  (defun spw/sly-db-show-first-line ()
    (unless (pos-visible-in-window-p (point-min))
      (goto-char (point-min))))
  (add-hook 'sly-db-hook #'spw/sly-db-show-first-line)

  ;; C-r should always search buffer text
  ;; (define-key sly-mrepl-mode-map "\M-r" #'comint-history-isearch-backward)
  (defun spw/reset-comint-history-isearch ()
    (setq-local comint-history-isearch nil))
  (add-hook 'sly-mrepl-hook #'spw/reset-comint-history-isearch))

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


;;;; Text mode

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

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

(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)
   ("@LaAldea"      . ?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)
   ("UA"            . ?w) ; 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		. "notmuch-show-mode")))
   ("t"     ((not-in-mode	. "notmuch-show-mode")))
   ("T"     ((in-mode		. "notmuch-show-mode")))
   ("m"     ((in-mode		. "notmuch-show-mode")))
   ("f"     ((in-mode		. "notmuch-show-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 [[notmuch:id:%:message-id][%^{Title|\"%(replace-regexp-in-string \"\\\\\\[\\\\\\|\\\\\\]\" \"\" \"%:subject\")\" from %:fromname}]]\n%?")

   ;; This will show a thread with only flagged messages expanded.
   ;;
   ;; The purpose of this is for cases where there are multiple actionable
   ;; messages in a single thread, such that I want to view them all in a
   ;; single buffer.  I flag those, and create a link to the thread using
   ;; this snippet.  Creating Org links to individual messages would not
   ;; achieve this.  And having an 'inbox' tag which represents actionable
   ;; but read messages would add overhead as I'd have to get used to
   ;; removing that tag from messages, and sort out syncing the tag.  The
   ;; case comes up too rarely for it to be worth doing that.
   ("f" "All flagged messages in current thread" entry (file org-default-notes-file)
    "* TODO [[notmuch:thread:{id:%:message-id} and tag:flagged][%^{Title|Flagged messages in thread \"%(replace-regexp-in-string \"\\\\\\[\\\\\\|\\\\\\]\" \"\" \"%:subject\")\"}]]\n%?")

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

(spw/remap-mark-commands org org-mode-map org-mark-subtree org-mark-element)

(with-eval-after-load 'org
  (require 'org-agenda) (require 'org-inlinetask)
  (require 'ol-notmuch nil t) (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)

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

  ;; Variable pitch default font without causing misalignment.  Regexp to
  ;; achieve this derived from Göktuğ Kayaalp's org-variable-pitch.el.
  (font-lock-add-keywords
   'org-mode `((,(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))
   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 (if arg "\[#A\]\\|Appt" "\[#[AB]\]\\|Appt")
	org-agenda-regexp-filter)
  (org-agenda-filter-apply org-agenda-regexp-filter 'regexp))

;; see %.docx target in ~/doc/newpapers/philos.mk
(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))
      (when (string-prefix-p root (buffer-file-name buffer))
	(with-current-buffer buffer (basic-save-buffer))))))

;; the default value for `org-notmuch-open-function' is
;; `org-notmuch-follow-link', but that function is broken: it calls
;; `notmuch-show' with a search query rather than a thread ID.  This
;; causes `notmuch-show-thread-id' to be populated with a value
;; which is not a thread ID, which breaks various other things
;;
;; so use a custom function instead
(defun spw/org-notmuch-follow-link (search)
  (let ((thread-id
	 (car (process-lines notmuch-command
			     "search"
			     "--output=threads"
			     "--limit=1"
                             "--format=text"
                             "--format-version=4"
			     search))))
    (notmuch-show thread-id nil nil search
                  (concat "*notmuch-" search "*"))))
(setq org-notmuch-open-function #'spw/org-notmuch-follow-link)


;;;; 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")))
     (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)
                        (org-agenda-todo-ignore-deadlines 'far)
                        (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-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-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 (or (spw/on-host-p "melete.silentflame.com")
	     (spw/on-host-p "hephaestus.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)
    ;;      (spw/org-has-deadline-p))

    ;; #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
              (spw/org-is-scheduled-p)))))))))

;; We look only right after the headline for SCHEDULED: and DEADLINE:, whereas
;; `org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item' searches
;; until the next headline.  This should be okay because I only ever put those
;; on the line right after the headline.
(cl-macrolet ((task-with-first-line-such-that (&body forms)
		`(and (spw/is-task-or-project-p)
		      (save-excursion (beginning-of-line-text 2) ,@forms))))
  (defun spw/org-is-scheduled-p ()
    "A task that is scheduled."
    (task-with-first-line-such-that
     (when (looking-at (org-re-timestamp 'deadline))
       (goto-char (match-end 0)) (skip-syntax-forward "\\s-"))
     (looking-at (org-re-timestamp 'scheduled))))

  (defun spw/org-has-deadline-p ()
    "A task that has a deadline."
    (task-with-first-line-such-that
     (when (looking-at (org-re-timestamp 'scheduled))
       (goto-char (match-end 0)) (skip-syntax-forward "\\s-"))
     (looking-at (org-re-timestamp 'deadline))))

  (defun spw/org-is-scheduled-or-deadlined-p ()
    "A task that is scheduled or has a deadline."
    (task-with-first-line-such-that
     (looking-at (org-re-timestamp 'scheduled-or-deadline)))))

(defun spw/has-scheduled-or-deadlined-subproject-p ()
  "A task that has a scheduled or deadlined subproject"
  (spw/has-subheading-such-that (spw/org-is-scheduled-or-deadlined-p)))

(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))
	(ignore-dirs (mapcar (lambda (dir)
			       (expand-file-name
				(concat org-directory "/" dir)))
			     '("archive" "philos"))))
    (cl-remove-if (lambda (file)
		    (or (member file agenda-files)
			(string-prefix-p "." (file-name-nondirectory file))))
		  (directory-files-recursively
		   (expand-file-name org-directory)
		   "\\.org\\'"
		   nil
		   (lambda (dir) (not (member dir ignore-dirs)))))))


;;;; 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")
(with-eval-after-load 'org
  (add-to-list 'org-file-apps '(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)


;;;; Diary

;; 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'
  (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+ anychar) is because the call might occur within a
       ;; call to another function.
       (seq "%%(" (0+ anychar) (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 ((now (current-time))
	  (tail (nthcdr 6 (decode-time))))
      (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)) now)
	    (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-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)))

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

;;; gdb & GUD

;; this is for when gdb-many-windows is turned off: still show the
;; source of the program's main(), please
(setq gdb-show-main t)

(defun spw/start-gud ()
  (interactive)
  (cl-case major-mode
    ('c-mode
     (call-interactively 'gdb)
     (setq mouse-autoselect-window t))
    ('cperl-mode
     (call-interactively 'perldb))
    ('python-mode
     (call-interactively 'pdb))))

(defun spw/quit-gud ()
  (interactive)
  (cl-case (buffer-local-value 'gud-minor-mode gud-comint-buffer)
    ('gdbmi
     (gud-basic-call "quit"))
    ('perldb
     (gud-basic-call "q"))
    ('pdb
     (gud-basic-call "q"))))

;; Supports only a single debugging session per Emacs instance, i.e., don't
;; try to debug both C and Perl at once.  The 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 call this command to bring GUD's window(s) back.
;;
;; The idea is to have a one Emacs tab or frame for serious source editing,
;; from which `compile' or `project-compile' is called, and one Emacs tab or
;; frame for GUD
(defun spw/run-or-restore-gud (arg)
  (interactive "p")
  (if (and (boundp 'gud-comint-buffer)
           (get-buffer-process gud-comint-buffer))
      (cl-case arg
        (4 ;; restart the GUD session, either to debug something else,
           ;; or because we can't seem to set breakpoints anymore
         (spw/quit-gud)
	 (spw/start-gud))
        (16 ;; quit the GUD session
         (spw/quit-gud))
        (t ;; restore the GUD session's window(s)
         (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdbmi)
             (progn
               (gdb-restore-windows)
               ;; ensure (gdb) prompt at bottom of its window
               (recenter (window-body-height)))
           (switch-to-buffer-other-window gud-comint-buffer))))
    ;; start a new GUD session
    (spw/start-gud)))

(global-set-key "\C-cd" #'spw/run-or-restore-gud)


;;;; Perl

;; using `cperl-mode' instead of `perl-mode' because the former doesn't try to
;; indent lines within a POD, and because syntax highlighting of whether a
;; scalar is from a hash or array is useful.  but, unsure whether I really
;; benefit from cperl's electric features; might try to turn those off

(add-to-list 'auto-mode-alist '("\\.\\([pP][Llm]\\|al\\)\\'" . cperl-mode))
(add-to-list 'interpreter-mode-alist '("\\(mini\\)?perl5?" . cperl-mode))

;; not sure these are consistent with my ~/.perltidyrc; if not, should try to
;; fix that
(setq cperl-indent-level 4
      cperl-indent-wrt-brace t
      cperl-lineup-step 1
      ;; advantage of following two lines is that we are not
      ;; penalised for choosing long and descriptive subroutine names
      cperl-indent-parens-as-block t
      cperl-close-paren-offset -4)

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

(spw/define-skeleton spw/cperl-shebang (cperl-mode :abbrev "shebang")
  "" (read-string "Command line options: " "-w")
  "#!/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/perl\n\n")
  "use 5.032;\nuse strict;\nuse warnings;\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.032;\nuse strict;\nuse warnings;\n\n" - "\n\n1;")

;;; init.el ends here