;;; 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"))))
 '(comint-highlight-prompt ((t (:inherit minibuffer-prompt :weight bold))))
 '(fill-column-indicator ((t (:background "light gray"))))
 '(fixed-pitch ((t (:foundry "SRC" :family "Hack"))))
 '(org-code ((t (:inherit (shadow fixed-pitch)))))
 '(org-date ((t (:inherit fixed-pitch :foreground "Purple" :underline t))))
 '(org-verbatim ((t (:inherit (shadow fixed-pitch)))))
 '(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
	 . ,(pcase (daemonp)
	      ('nil "honeydew") ("gdbmacs" "linen") (_ "#FFFFF6")))))))

(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 (or wide-monitor-p
	      ;; Check whether a previous call made any changes we might need
	      ;; to undo if FRAME has moved to a smaller display.
	      (not (eq scroll-bar-mode
		       (frame-parameter frame 'vertical-scroll-bars)))
	      (= (face-attribute 'default :height frame) 120)
	      (= (face-attribute 'variable-pitch :height frame) 151))
      (let* (;; Above 1635 you can scale up and still fit two 80-col windows.
	     ;; Below 1315 you can't fit the two windows even w/o scaling up.
	     (medium-p (> 1635 (frame-pixel-width frame) 1315))
	     (scale-up-p (and wide-monitor-p (not medium-p))))
	(modify-frame-parameters
	 frame
	 `(;; Can fit two 80-col windows only if we disable scroll bars.
	   (vertical-scroll-bars . ,(and (not (and wide-monitor-p medium-p))
					 scroll-bar-mode))))
	;; Check Emacs found the relevant font on this window system, else our
	;; height values might be invalid.
	(when (find-font (font-spec :foundry "SRC" :family "Hack") frame)
	  (set-face-attribute 'default frame :height (if scale-up-p 120 105)))
	(when (find-font (font-spec :foundry "bitstream"
				    :family "Bitstream Charter")
			 frame)
	  (set-face-attribute 'variable-pitch frame
			      :height (if scale-up-p 151 120)))))))
(add-to-list 'window-size-change-functions #'spw/maybe-scale-basic-faces)

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

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

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

(custom-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-default-directory "~/annex/music/")
 '(bongo-insert-album-covers t)
 '(bongo-insert-whole-directory-trees t)
 '(bongo-mode-line-indicator-mode nil)
 '(bongo-prefer-library-buffers nil)
 '(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)
 '(comint-prompt-read-only 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)
 '(cperl-close-paren-offset -4 nil nil "See `cperl-indent-parens-as-block'.")
 '(cperl-indent-level 4)
 '(cperl-indent-parens-as-block t nil nil "Makes it easier to use longer names for subroutines.")
 '(cperl-lineup-step 1)
 '(cursor-type 'box)
 '(cycle-spacing-actions '(just-one-space) nil nil "Restore Emacs 28 behaviour of M-SPC.")
 '(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))
 '(dired-clean-up-buffers-too nil)
 '(dired-dwim-target t)
 '(dired-free-space 'separate)
 '(dired-isearch-filenames t)
 '(dired-listing-switches "--group-directories-first -alh")
 '(dired-omit-files "\\`\\." nil nil "Exclude all dotfiles (no need for . and .. in dired afaict).")
 '(dired-recursive-copies 'always)
 '(display-fill-column-indicator-character 32)
 '(emacs-lisp-docstring-fill-column 75)
 '(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)
 '(eshell-visual-commands
   '("vi" "screen" "tmux" "top" "htop" "less" "more" "mutt" "locmaint"))
 '(fido-mode t)
 '(fill-column 78)
 '(gc-cons-threshold 16777216)
 '(gdb-many-windows t)
 '(global-so-long-mode t)
 '(gnus-article-skip-boring t)
 '(gnus-auto-center-summary nil)
 '(gnus-auto-select-next 'slightly-quietly)
 '(gnus-buttonized-mime-types
   '("text/x-\\(?:diff\\|patch\\)" "multipart/\\(?:alternative\\|signed\\)"))
 '(gnus-directory "~/local/News/")
 '(gnus-extra-headers '(To Cc List-Id))
 '(gnus-gcc-mark-as-read t)
 '(gnus-interactive-exit 'quiet)
 '(gnus-kill-files-directory "~/src/athpriv/News/")
 '(gnus-kill-summary-on-exit t nil nil "Would prefer nil but t seems advisable for notmuch groups.")
 '(gnus-large-ephemeral-newsgroup 8000)
 '(gnus-large-newsgroup 8000)
 '(gnus-mark-article-hook '(spw/gnus-mark-article-hook))
 '(gnus-message-archive-group "sent")
 '(gnus-message-archive-method '(nnmaildir "fmail" (directory "~/.fmail/")))
 '(gnus-permanently-visible-groups "^nnmaildir\\+fmail:\\(?:notes\\|sent\\)$")
 '(gnus-read-newsrc-file nil)
 '(gnus-save-killed-list
   "^\\(?:[^n]\\|n[^n]\\|nn[^s]\\|nns[^e]\\|nnse[^l]\\|nnsel[^e]\\|nnsele[^c]\\|nnselec[^t]\\|nnselect[^:]\\)")
 '(gnus-save-newsrc-file nil)
 '(gnus-search-default-engines '((nnmaildir . notmuch)))
 '(gnus-search-notmuch-remove-prefix "~/.fmail/")
 '(gnus-secondary-select-methods '((nnmaildir "fmail" (directory "~/.fmail/"))))
 '(gnus-sum-thread-tree-false-root "")
 '(gnus-sum-thread-tree-indent " ")
 '(gnus-sum-thread-tree-leaf-with-other "├► ")
 '(gnus-sum-thread-tree-root "")
 '(gnus-sum-thread-tree-single-leaf "╰► ")
 '(gnus-sum-thread-tree-vertical "│")
 '(gnus-summary-line-format "%U%R%z %(%12&user-date;  %*%-23,23f%)  %B%s\12")
 '(gnus-summary-thread-gathering-function 'gnus-gather-threads-by-references)
 '(gnus-suppress-duplicates t)
 '(gnus-thread-sort-functions
   '(gnus-thread-sort-by-number gnus-thread-sort-by-total-score))
 '(gnus-topic-display-empty-topics nil)
 '(gnus-update-message-archive-method t)
 '(gnus-user-date-format-alist
   '((32042 . "%2l:%M%#p")
     (118823 . "Yest %2l:%M%#p")
     (604800 . "%a %2l:%M%#p")
     (16102447 . "%d %B")
     (t . "%Y-%b-%d")))
 '(haskell-indentation-layout-offset 4)
 '(haskell-indentation-left-offset 4)
 '(holiday-bahai-holidays nil)
 '(holiday-hebrew-holidays nil)
 '(holiday-islamic-holidays nil)
 '(howm-directory "~/doc/howm/")
 '(howm-file-name-format "%Y/%Y-%m-%d-%H%M.org")
 '(howm-keyword-file "~/doc/howm/.howm-keys")
 '(howm-view-use-grep t)
 '(imenu-auto-rescan t)
 '(kill-read-only-ok t)
 '(log-edit-hook
   '(log-edit-insert-message-template log-edit-insert-cvs-template log-edit-insert-changelog spw/log-edit-show-diff) nil nil "Drop log-edit-show-files to avoid its window becoming most recently used for C-x o.")
 '(magit-define-global-key-bindings nil)
 '(magit-diff-refine-hunk 'all)
 '(magit-save-repository-buffers nil)
 '(mail-envelope-from 'header nil nil "Bypass MTA rewriting user@localhost.")
 '(mail-specify-envelope-from t nil nil "Bypass MTA rewriting user@localhost.")
 '(mail-user-agent 'gnus-user-agent)
 '(mailscripts-detach-head-from-existing-branch 'ask)
 '(mailscripts-extract-patches-branch-prefix "mail/")
 '(mailscripts-project-library 'project)
 '(make-pointer-invisible t nil nil "Works only for self-insert chars and undone by changes in window manager focus, but less annoying than `mouse-avoidance-mode'.")
 '(message-auto-save-directory "~/tmp/" nil nil "So locmaint will catch them.")
 '(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-forward-as-mime nil nil nil "For compatibility.")
 '(message-forward-before-signature nil nil nil "For compatibility.")
 '(message-forward-included-headers
   '("^From:" "^Subject:" "^Date:" "^To:" "^Cc:" "^Message-ID:") nil nil "For compatibility.")
 '(message-ignored-resent-headers
   "^Return-receipt\\|^X-Gnus\\|^Gnus-Warning:\\|^>?From \\|^Delivered-To:\\|^\\(?:X-\\)?Content-Length:\\|^X-UIDL:\\|^X-TUID:\\|^\\(?:X-\\)?Status:\\|^Lines:")
 '(message-make-forward-subject-function '(message-forward-subject-fwd) nil nil "For compatibility.")
 '(message-sendmail-envelope-from 'header nil nil "Bypass MTA rewriting user@localhost.")
 '(message-wash-forwarded-subjects t)
 '(minibuffer-follows-selected-frame nil)
 '(mm-default-directory "~/tmp/")
 '(mm-file-name-rewrite-functions
   '(mm-file-name-delete-control mm-file-name-delete-gotchas mm-file-name-trim-whitespace mm-file-name-collapse-whitespace mm-file-name-replace-whitespace))
 '(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-highlight 1 nil nil "See `make-pointer-invisible'.")
 '(mouse-yank-at-point t)
 '(native-comp-async-jobs-number 1)
 '(native-comp-async-report-warnings-errors 'silent)
 '(nnmail-extra-headers '(To Cc List-Id))
 '(notmuch-address-use-company nil)
 '(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-remove-times-when-in-prefix 'beg)
 '(org-agenda-restore-windows-after-quit nil nil nil "Interacts badly with `tab-bar-history-mode'.")
 '(org-agenda-skip-deadline-if-done t)
 '(org-agenda-skip-deadline-prewarning-if-scheduled 3)
 '(org-agenda-skip-scheduled-if-deadline-is-shown 'not-today)
 '(org-agenda-skip-scheduled-if-done t)
 '(org-agenda-skip-timestamp-if-done t)
 '(org-agenda-start-on-weekday nil)
 '(org-agenda-sticky t)
 '(org-agenda-timegrid-use-ampm t)
 '(org-agenda-todo-ignore-scheduled 'future)
 '(org-agenda-window-setup 'current-window)
 '(org-archive-location "~/doc/archive/howm/archive.org::* From %s")
 '(org-archive-save-context-info '(time file olpath))
 '(org-archive-subtree-save-file-p t)
 '(org-blank-before-new-entry '((heading . t) (plain-list-item . auto)))
 '(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/howm/refile.org")
 '(org-directory "~/doc/howm/")
 '(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 nil)
 '(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-commands
   '((project-find-file "Find file")
     (project-find-regexp "Find regexp")
     (project-find-dir "Find directory")
     (project-vc-dir "VC-Dir")
     (spw/project-vc-root-diff "VC-Diff" "D")
     (spw/project-vc-print-root-log "VC-Log" "L")
     (transient-cycles-cmd-spw/project-eshell "Eshell")))
 '(project-switch-use-entire-map t)
 '(rcirc-default-full-name "Sean Whitton [spwhitton@spwhitton.name]")
 '(rcirc-default-nick "spwhitton")
 '(rcirc-default-user-name "spwhitton")
 '(rcirc-display-server-buffer nil)
 '(rcirc-log-directory "~/local/irclogs")
 '(rcirc-log-filename-function 'spw/rcirc-generate-log-filename)
 '(rcirc-log-flag t)
 '(rcirc-time-format "%b/%d %H:%M ")
 '(rcirc-track-abbrevate-flag nil)
 '(rcirc-track-ignore-server-buffer-flag t)
 '(rcirc-track-minor-mode t)
 '(read-mail-command 'gnus)
 '(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-bar-history-mode t)
 '(tab-bar-show 1)
 '(tramp-use-ssh-controlmaster-options nil nil nil "Rely on my ~/.ssh/config.")
 '(tramp-verbose 1 nil nil "Manual says this should improve performance.")
 '(transient-cycles-buffer-siblings-mode t)
 '(transient-cycles-tab-bar-mode t)
 '(transient-cycles-window-buffers-cycle-backwards-key [134217777] nil nil "M-1.")
 '(transient-cycles-window-buffers-cycle-forwards-key [134217780] nil nil "M-4.")
 '(transient-cycles-window-buffers-mode t)
 '(transient-mark-mode nil)
 '(uniquify-buffer-name-style 'post-forward nil (uniquify))
 '(use-short-answers t)
 '(vc-find-revision-no-save t)
 '(vc-follow-symlinks t)
 '(vc-git-print-log-follow t)
 '(view-read-only t nil nil "Rebind otherwise useless self-insert keys, and means existing C-x C-r, C-x 4 r etc. usable for getting into mode.")
 '(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 #'symbol-name libraries))
	    `(locate-library ,(symbol-name libraries)))
     ,@forms))

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

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

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

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

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

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

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

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

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


;;;; 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/howm/refile.org and C-c c c, *notes* does not require ~/doc/
;; checked out.  And we get one per machine, which can be convenient.
(global-set-key "\C-xg" #'remember-notes)
(global-set-key "\C-xl" #'scratch-buffer)

(defun spw/paredit-ctl-j ()
  "Replacement for `paredit-newline' which does traditional Emacs
Lisp Interaction C-j in `lisp-interaction-mode' and similar."
  (interactive)
  (require 'pp)
  (if-let
      ((command
	(alist-get
	 major-mode
	 '((lisp-interaction-mode . eval-print-last-sexp)
	   (edebug-eval-mode . edebug-eval-print-last-sexp)

	   ;; Not quite a traditional Emacs C-j, but close enough.
	   (scheme-interaction-mode . xscheme-send-previous-expression)))))
      (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)


;;;; System and files

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

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

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

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

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

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

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

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


;;;; General editing

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

;; 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-6 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-6 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))
(define-key spw/personal-bindings-mode-map "\M-5" #'spw/activate-mark)

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

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

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

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

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

;; Sort of an abbreviation for C-z C-z C-x C-x C-x.
(defun spw/e-p-a-m-a-p-m-a-e-p-a-m-repeatable ()
  (interactive)
  (spw/exchange-point-and-mark-and-pop-mark)
  (exchange-point-and-mark)
  (let ((map (make-sparse-keymap)))
    (define-key map "z" #'repeat) (set-transient-map map t)))
(define-key spw/ctl-z-map "\C-x" #'spw/e-p-a-m-a-p-m-a-e-p-a-m-repeatable)

;; 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/personal-bindings-mode-map
	      "\M-`" (case-sensitively zap-up-to-char)))

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

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

;; always update buffers when files change on disk -- if we want to go back to
;; the version of the file we had in Emacs, we can just hit undo
(setq auto-revert-use-notify nil)
(global-auto-revert-mode 1)
(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.  Further, if the goal is to avoid having to release
;; modifier keys between typing numeric prefix arguments and commands, then in
;; most cases this will mean one-handed chording, which should be avoided.  If
;; the goal is instead to reduce the total number of keypresses, then it
;; should be sufficient to use only the M- bindings, releasing the meta key
;; after typing the first digit or minus sign.  But that's a minor benefit
;; over just starting with C-u.  Indeed, I rebind M-0..9 for other purposes.
;;
;; (M-- remains bound to `negative-argument' because it's particularly useful
;; for 'M-- M-l' and 'M-- M-u'.  So, C-u and M-- are the two keys I use to
;; supply non-negative and negative numeric prefix arguments, respectively.)
(cl-loop for i from ?0 to ?9
	 for key = (read (format "[?\\C-%c]" i))
	 do (global-unset-key key) (define-key esc-map key nil))
(global-set-key [?\C--] nil)
(global-set-key [?\C-\M--] nil)

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

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

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

(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-h\C-m" #'man)
(global-set-key "\C-cgp" #'cperl-perldoc)
(global-set-key "\C-cgk" #'save-buffers-kill-emacs)

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

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

(diminish 'eldoc-mode)

;; Invert meaning of C-u for M-= except when the region is active (though,
;; M-6 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)

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

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

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

(setq skeleton-end-newline nil)

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

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

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

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

;;; Icomplete

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

(defun spw/icomplete-choose-rubout ()
  ;; See `icomplete--category'.
  (when (eq (completion-metadata-get
	     (completion-metadata
	      (buffer-substring-no-properties (minibuffer-prompt-end) (point))
	      minibuffer-completion-table
	      minibuffer-completion-predicate)
	     'category)
	    'file)
    (let ((map (make-sparse-keymap)))
      (define-key
       map "\C-w"
       (lambda (arg)
	 (interactive "p")
	 (spw/unix-word-rubout arg "/:[:space:]\n" "^/:[:space:]\n")))
      (use-local-map (make-composed-keymap map (current-local-map))))))
(add-hook 'icomplete-minibuffer-setup-hook #'spw/icomplete-choose-rubout)

(define-key icomplete-fido-mode-map "\C-l"
	    (lambda ()
	      (interactive)
	      (kill-region (minibuffer-prompt-end) (point-max))))

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


;;;; Buffers and windows

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

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

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

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

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

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

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

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

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

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

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

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

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

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

	;; We want `inhibit-same-window' t except when popping to a buffer
	;; that's already selected, e.g. hitting 'g' in a *vc-diff* buffer.
	,@(let ((re "\\*\\(?:notes\\|vc\\(?:-reflog\\)?-diff\\)\\*"))
	    `((,(lambda (buffer _action)
		  (and (buffer-match-p re buffer)
		       (eq buffer (window-buffer (selected-window)))))
	       display-buffer-same-window)

	      (,re
	       display-buffer-pop-up-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 [remap window-toggle-side-windows]
		#'spw/window-toggle-side-windows)

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

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

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

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

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

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

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

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

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

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

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

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


;;;; TRAMP

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

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

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


;;;; The Emacs shell

;; 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
;; running the command, and even restore point within that input.  Might be
;; useful in `spw/eshell-jump' & interactively.
(defun spw/eshell-insert-and-send (&rest args)
  (delete-region eshell-last-output-end (point-max))
  (when (> eshell-last-output-end (point))
    (goto-char eshell-last-output-end))
  (apply #'insert-and-inherit args)
  (eshell-send-input))

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

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

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

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

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

  (This duplicates the functionality of `spw/cycle-forwards-from-here' and
  `spw/cycle-backwards-from-here', so we might do something else that's
  useful and Eshell-specific.)

- 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 (not (eq chdir 'strict))
				     (eq major-mode 'dired-mode)
				     (dired-current-directory))
				default-directory))
	 (current-project (and (not (file-remote-p default-directory))
			       (project-current)))
	 (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/reclaim-keys-from term term-raw-map "\M-!" "\M-&")

(spw/transient-cycles-define-buffer-switch
  ((("\M-!" . spw/eshell-jump) (arg)
      (interactive "p")
      (let ((>>> (and (> arg 1) (format " >>>#<buffer %s>" (buffer-name)))))
	(prog1 (spw/eshell-jump 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)))

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

;; This is an alternative way to activate the mark temporarily when
;; `transient-mark-mode' is off, and whether it's on or off, makes it
;; easier to operate on adjacent whole lines where the set of lines is
;; not surrounded by blank lines such that `mark-paragraph' can be
;; used.  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 "\M-6" #'spw/expand-region-to-whole-lines-and-activate)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

Useful after resizing the frame."
  (interactive)
  (when (= (count-windows) 2)
      (let* ((this-win-buffer (window-buffer))
             (next-win-buffer (window-buffer (next-window)))
             (this-win-edges (window-edges (selected-window)))
             (next-win-edges (window-edges (next-window)))
             (this-win-2nd (not (and (<= (car this-win-edges)
                                         (car next-win-edges))
                                     (<= (cadr this-win-edges)
                                         (cadr next-win-edges)))))
             (splitter
              (if (= (car this-win-edges)
                     (car (window-edges (next-window))))
                  'split-window-horizontally
                'split-window-vertically)))
        (delete-other-windows)
        (let ((first-win (selected-window)))
          (funcall splitter)
          (when this-win-2nd (other-window 1))
          (set-window-buffer (selected-window) this-win-buffer)
          (set-window-buffer (next-window) next-win-buffer)
          (select-window first-win)
          (when this-win-2nd (other-window 1))))))
(global-set-key "\C-cwt" #'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-cvd" #'spw/dotfiles-rebase)

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

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

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

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

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

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

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

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

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

(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-cws" #'spw/save-buffer-for-later)
;; (global-set-key "\C-cns" #'spw/save-buffer-for-later)

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

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

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

(defun spw/daemon-pid (&optional name)
  ;; We don't use `server-eval-at' because perhaps we are trying to attach gdb
  ;; to a wedged Emacs.
  (let ((socket (file-name-concat server-socket-dir (or name "server"))))
    (and (file-exists-p socket)
	 (and-let* ((output (car (process-lines "ss" "-Hplx" "src" socket))))
	   (and (string-match "pid=\\([[:digit:]]+\\)" output)
		(string-to-number (match-string 1 output)))))))

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

(defun spw/gdbmacs-attach (&optional name)
  (require 'gdb-mi)
  (let (pid
	(arg (if name (concat "--fg-daemon=" name) "--fg-daemon"))
	(proc (get-buffer-process gud-comint-buffer)))
    (when (and proc (string= gdb-inferior-status "signal-received"))
      ;; Avoid wiping out useful info.
      (error "Possibly Emacs just crashed; not attaching for now"))
    (cl-flet ((run-or-continue ()
		(gdb-wait-for-pending
		 (lambda ()
		   (with-current-buffer gud-comint-buffer
		     (setq spw/gdbmacs-target-pid pid
			   spw/gdbmacs-target-name name))
		   (if pid
		       (gud-basic-call "continue")
		     (gud-basic-call "set cwd ~")
		     (gdb-wait-for-pending
		      (lambda () (gud-basic-call "run"))))))))
      (gdb-wait-for-pending
       (if (and proc
		;; Check it looks safe to re-use existing gdb process.
		(string-prefix-p "exited" gdb-inferior-status)
		(file-in-directory-p
		 (buffer-local-value 'default-directory gud-comint-buffer)
		 (expand-file-name "~/src/emacs/")))
	   (lambda ()
	     (gud-basic-call (if (setq pid (spw/daemon-pid name))
				 (format "attach %d" pid)
			       (format "set args %s" arg)))
	     (run-or-continue))
	 ;; Start up a new process.
	 (lambda ()
	   (when (buffer-live-p gud-comint-buffer)
	     (when proc (set-process-query-on-exit-flag proc nil))
	     (kill-buffer gud-comint-buffer))
	   (gdb-wait-for-pending
	    (lambda ()
	      (let ((default-directory (expand-file-name "~/src/emacs/")))
		(gdb (if (setq pid (spw/daemon-pid name))
			 (format "gdb -i=mi --pid=%d src/emacs" pid)
		       (format "gdb -i=mi --args src/emacs %s" arg))))
	      (run-or-continue)))))))))

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

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

(defun spw/may-pass-to-gdbmacs-p ()
  (and (display-graphic-p)
       (not (string= (daemonp) "gdbmacs"))
       (spw/daemon-pid "gdbmacs")))

;; 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.
;;
;; The configure flags in "confmacs0" are for when I am actively debugging
;; Emacs.  The flags in "confmacsg" are for day-to-day use, where I still want
;; some debugging information available in case of an unexpected crash.  The
;; flags in "confmacs0" are recommended by etc/DEBUG, but other than
;; --enable-check-lisp-object-type, they do noticeably slow Emacs down,
;; especially Icomplete, and most of the time I'm working either on things
;; other than Emacs or on Emacs at the Lisp level.  "confmacsg" seems to be
;; acceptably fast, and using these abbrevs to reconfigue and rebuild Emacs's
;; C core back and forth is quick (the .elc stick around).
;;
;; We don't append "&& make" to the abbrev because I use 'C-x p c' to build.
;;
;; Order the flags such that ones I'm more likely to want to manually edit or
;; remove for a particular build come later in the list.  In particular, have
;; --enable-check-lisp-object-type come last in the abbrev expansions because
;; we sometimes need to quickly reconfigure without it, such that Lisp objects
;; aren't structs and can be used in break point conditions.
;;
;; Delete the cache each time because we're often changing CFLAGS.  It's still
;; worth passing -C because configure often gets rerun by the Makefile when I
;; rebase onto origin/master -- there is no --disable-maintainer-mode.
(with-eval-after-load 'esh-mode
  (dolist (conf '(("confmacs0"
		   "--with-pgtk"
		   "--enable-checking='yes,glyphs'"
		   "CFLAGS='-O0 -g3'"
		   "--enable-check-lisp-object-type")
		  ("confmacsg"
		   "--with-pgtk"
		   "--enable-checking='yes,glyphs'"
		   "CFLAGS='-Og -g3'"
		   "--enable-check-lisp-object-type")))
    (define-abbrev eshell-mode-abbrev-table (car conf)
      (string-join (cons "rm -f config.cache; ./configure -C" (cdr conf)) " ")
      nil :system t)))

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

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

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

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

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

(defun spw/git-format-patch (args &optional new)
  "Git-specific `vc-prepare-patch' w/ non-nil `vc-prepare-patches-separately'.
We want to take advantage of the -<n> and -v arguments to
git-format-patch(1), and also of how it numbers the patches."
  (interactive "sgit format-patch \nP")
  (let* ((patches-from default-directory)
	 (v (and (string-match "\\_<-\\(?:v\\|-reroll-count\\)\\([0-9]+\\)\\b"
			       args)
		 (match-string 1 args)))
	 (prefix (format "[%sPATCH%s] "
			 (if (string-match "\\_<--rfc\\b" args) "RFC " "")
			 (if v (concat " v" v) ""))))
    (compose-mail nil prefix nil (not new))
    (save-excursion
      (goto-char (point-max))
      (terpri (current-buffer) t)
      (mapc #'mail-add-attachment
	    (let ((default-directory patches-from))
	      (apply #'process-lines
		     "git" "format-patch"
		     (split-string-and-unquote args)))))))


;;;; Terminal emulation

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

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

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

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

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

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


;;;; Composing mail

(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-send-and-exit ()
  (interactive)
  (when (or spw/message-normalised
	    (y-or-n-p "Send message which has not been auto-formatted?"))
    (call-interactively #'message-send-and-exit)))

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

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

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

(defun spw/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))))))))

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

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

(cl-macrolet
    ((define-simple-pass-to-gdbmacs (cmd)
       (let ((new (intern (concat "spw/" (symbol-name cmd)))))
	 `(progn
	    (defun ,new ()
	      (interactive)
	      (if (spw/may-pass-to-gdbmacs-p)
		  (server-eval-at
		   "gdbmacs"
		   `(let ((display-buffer-overriding-action
			   '(display-buffer-pop-up-frame
			     (pop-up-frame-parameters
			      (display . ,(frame-parameter nil 'display)))))
			  (current-prefix-arg ',current-prefix-arg))
		      (call-interactively #',',cmd)))
		(call-interactively #',cmd)))
	    (global-set-key [remap ,cmd] #',new)))))
  (define-simple-pass-to-gdbmacs compose-mail)
  (define-simple-pass-to-gdbmacs compose-mail-other-window)
  (define-simple-pass-to-gdbmacs compose-mail-other-frame))

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

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

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

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

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

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

  ;; 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
	      [remap message-send-and-exit] #'spw/message-send-and-exit)

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


;;;; 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
  ;; can't wrap this in a `with-eval-after-load' for dired because want it to
  ;; go ahead and advise `read-only-mode'
  (require 'git-annex))

(defun spw/dired-copy-filename-as-kill (&optional arg)
  (interactive "P")
  (let* ((subdir (dired-get-subdir))
	 (files
          ;; We treat as primary the meanings of the prefix argument to
	  ;; `dired-copy-filename-as-kill', then try to call `spw/eshell-jump'
	  ;; in a way that corresponds.  Thus, there isn't a way to express a
	  ;; prefix argument to 'M-&', but one can use, e.g., C-u M-& C-x o &.
	  ;; (It wouldn't make sense to pass a prefix argument to 'M-!').
	  ;;
	  ;; Invoking with '!', and no prefix argument, is a shortcut for
	  ;; copying absolute paths, and behaving more like 'M-!' than 'M-&'.
	  (cond (subdir
		 (prog1 (ensure-list subdir) (spw/eshell-jump)))
		((if arg
		     (zerop (prefix-numeric-value arg))
		   (char-equal last-command-event ?!))
		 (prog1 (dired-get-marked-files) (spw/eshell-jump)))
                ((consp arg)
                 (prog1 (dired-get-marked-files t)
		   (spw/eshell-jump nil 'strict)))
                (t
                 (prog1 (dired-get-marked-files
			 'no-dir (and arg (prefix-numeric-value arg)))
		   (spw/eshell-jump nil t)))))
         (string
          (mapconcat (lambda (file)
                       (if (string-match-p "[ \"']" file)
                           (format "%S" file)
                         file))
                     files
                     " ")))
    (unless (string-empty-p string)
      (if (= (point) eshell-last-output-end)
	  (save-excursion (insert ?\s string ?\s))
	(just-one-space)
	(insert string)
	(just-one-space)))))
(spw/feature-define-keys dired
  "!" #'spw/dired-copy-filename-as-kill
  "&" #'spw/dired-copy-filename-as-kill)


;;;; EWW

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

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

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

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

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


;;;; Gnus

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

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

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

(defun spw/gnus-startup-wrapper (orig-fun &rest args)
  (when-let ((daemon (and (file-directory-p "~/.fmail/") (daemonp))))
    (unless (file-exists-p "~/.newsrc.eld")
      (user-error "Must use dedicated Emacs for Gnus first run"))
    (unless (string= "gdbmacs" daemon)
      (user-error "This is not the Gnusmacs you're looking for")))
  (let ((gc-cons-percentage 0.6)
	(gc-cons-threshold 402653184)
	(gnus-always-read-dribble-file (file-exists-p "~/.newsrc.eld")))
    (apply orig-fun args)))
(advice-add 'gnus :around #'spw/gnus-startup-wrapper)
(advice-add 'gnus-no-server :around #'spw/gnus-startup-wrapper)

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

(defun spw/gnus-goto (group)
  (require 'gnus)
  (if (gnus-alive-p) (pop-to-buffer-same-window gnus-group-buffer) (gnus))
  (gnus-group-jump-to-group group)
  (call-interactively #'gnus-topic-select-group))

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

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

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

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

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

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

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

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

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

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

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

      ;; Kill all summaries in case any of their queries have changed.
      (catch 'done
	(dolist (buffer (buffer-list))
	  (when (buffer-local-value 'gnus-dead-summary-mode buffer)
	    (throw 'done (kill-buffer buffer)))))
      (gnus-offer-save-summaries)

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

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

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

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

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

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

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

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

;; Rescan nnmaildir+fmail:inbox too, else rescanning the nnselect group will
;; not display any new mail.
(defun spw/gnus-request-group-scan (group _info)
  (when (eq 'nnselect (car (gnus-find-method-for-group group)))
    (gnus-activate-group "nnmaildir+fmail:inbox" 'scan)))
(advice-add 'gnus-request-group-scan :before #'spw/gnus-request-group-scan)

;; This works around Emacs bug#56592 without relying on duplicate suppression.
(defun spw/gnus-summary-read-group (orig-fun group show-all &rest args)
  (let ((nnselectp (string-prefix-p "nnselect:" group))
	(some-unread-before-p (cl-plusp (gnus-group-unread group))))
    (when nnselectp
      (with-current-buffer gnus-group-buffer
	(save-excursion
	  (gnus-group-goto-group group)
	  (gnus-group-get-new-news-this-group 1))))
    (let ((some-unread-after-p (cl-plusp (gnus-group-unread group))))
      (cond ((and nnselectp (not show-all)
		  some-unread-before-p (not some-unread-after-p))
	     ;; Ensure we return nil for `gnus-summary-next-group'.
	     (ignore (message "No more unread articles")))
	    ;; `gnus-group-read-group' passes SHOW-ALL t if it thinks the
	    ;; group has no unread messages.  Override that.
	    ((and nnselectp
		  (not (and current-prefix-arg
			    (memq this-command '(gnus-topic-read-group
						 gnus-topic-select-group))))
		  (not some-unread-before-p) some-unread-after-p)
	     (apply orig-fun group nil args))
	    (t (apply orig-fun group show-all args))))))
(advice-add 'gnus-summary-read-group :around #'spw/gnus-summary-read-group)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

(with-eval-after-load 'gnus-sum
  (define-key gnus-summary-mode-map "k" "ToTkg")
  (define-key gnus-summary-mode-map "\M-k" "Tkg"))

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

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

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

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

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

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

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

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

(defun spw/gnus-warp-to-article ()
  (interactive)
  (let* ((specs
	  (gnus-group-get-parameter gnus-newsgroup-name 'nnselect-specs t)))
    (if (gnus-search-notmuch-p
	 (gnus-search-server-to-engine
	  (caadr (assq 'search-group-spec
		       (cdr (assq 'nnselect-args specs))))))
	(let* ((mid (gnus-summary-header "message-id"))
	       (search (concat "id:" (string-trim mid "<" ">"))))
	  (spw/gnus-notmuch-ephemeral-search search 0 t)
	  (gnus-summary-goto-article mid))
      (gnus-warp-to-article))))
(with-eval-after-load 'gnus-sum
  (define-key gnus-summary-mode-map
	      [remap gnus-warp-to-article] #'spw/gnus-warp-to-article))

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

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

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

(defun spw/gnus-with-expert (orig-fun &rest args)
  (let ((gnus-expert-user t)) (apply orig-fun args)))
(advice-add #'gnus-summary-exit-no-update :around #'spw/gnus-with-expert)


;;;; rcirc

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

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

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

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

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

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

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


;;;; VC

;;; Want Magit installed for `git-commit-mode', `git-rebase-mode' and these
;;; reflog commands.  Otherwise, I prefer how VC is more buffer-oriented, such
;;; as in eschewing the (singular) Git staging area for `diff-mode' buffers.

(require 'git-commit nil t)

(global-set-key "\C-cvr" #'magit-reflog-current)
(global-set-key "\C-cvH" #'magit-reflog-head)
(global-set-key "\C-cvO" #'magit-reflog-other)

(spw/reclaim-keys-from magit magit-mode-map "\M-w")

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

(defun spw/log-view-eshell-git-range (&optional subcommand revert)
  (interactive)
  (let ((buffer (current-buffer))
	(range (spw/log-view-git-range))
	(default-directory (project-root (project-current))))
    (spw/eshell-jump nil t)
    (when (> (point-max) eshell-last-output-end)
      (eshell-interrupt-process))
    (insert "git ")
    (when subcommand (insert subcommand ?\ ))
    (save-excursion (insert ?\  range))
    (when revert
      (spw/add-once-hook 'eshell-post-command-hook
			 (lambda ()
			   (when (eq this-command 'eshell-send-input)
			     (save-selected-window
			       (with-current-buffer buffer
				 (revert-buffer)))))
			 nil t))))

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

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

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

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

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

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

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

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

(spw/feature-define-keys log-view
  "\C-z:" spw/log-view-eshell-git-range
  "\C-zA" spw/log-view-git-cherry-pick
  "\C-zf" spw/log-view-git-fixup
  "\C-zr" spw/log-view-git-rebase
  "\C-zi" "\C-u\C-zr"
  "\C-zw" spw/log-view-copy-git-range
  "\C-zx" spw/log-view-git-reset
  "\s" scroll-other-window
  "" scroll-other-window-down
  "\t" spw/log-view-msg-this
  "\M-n" spw/log-view-msg-next
  "\M-p" spw/log-view-msg-prev)

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

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

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

;;; If we just add `vc-print-root-log' to `project-switch-commands', it seems
;;; to work, but if you try to expand any commits it'll try to run git(1) in
;;; the old project/dir, not the new one.  `vc-root-diff' has issues too.
;;; So add these commands instead.

(defun spw/project-vc-root-diff ()
  (interactive)
  (with-current-buffer
      (dired-noselect (project-root (project-current t)))
    (vc-root-diff nil)))

(defun spw/project-vc-print-root-log ()
  (interactive)
  (with-current-buffer
      (dired-noselect (project-root (project-current t)))
    (vc-print-root-log)))

(defun spw/eshell-find-git-subcommand (option)
  (if-let ((subcommand
	    (save-excursion
	      (goto-char (point-max))
	      (and (re-search-backward
		    "\\bgit \\([a-z-]+\\) --\\(?:abort\\|continue\\)\\b"
		    nil t)
		   (match-string 1)))))
      (spw/eshell-insert-and-send "git " subcommand ?\  option)
    (user-error "Cannot determine what git command is in progress")))

(defun spw/eshell-git-abort ()
  (interactive)
  (spw/eshell-find-git-subcommand "--abort"))

(defun spw/eshell-git-continue ()
  (interactive)
  (spw/eshell-find-git-subcommand "--continue"))

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

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

(defun spw/vc-next-action-for-git-fixup ()
  (interactive)
  (save-window-excursion (call-interactively #'vc-next-action))
  (call-interactively #'vc-print-root-log)
  (message "Move point to the commit to fixup! into and type C-z f"))
(global-set-key "\C-cvf" 'spw/vc-next-action-for-git-fixup)


;;;; Assorted packages

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

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

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

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

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

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

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

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

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

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

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

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

(spw/feature-add-hook orgtbl-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 ()
  (require 'bongo)
  (if (eq major-mode 'wdired-mode)
      (bongo-dired-library-mode 0)
    (when (file-in-directory-p default-directory bongo-default-directory)
      (bongo-dired-library-mode 1))))

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

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

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

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

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

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


;;;; Lisp

(find-function-setup-keys)

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

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

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

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

(spw/when-library-available consfigurator
  (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)))

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

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

(spw/reclaim-keys-from xscheme scheme-mode-map "\eo" "\ez")
(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")

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

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

(with-eval-after-load 'slime
  (defvar spw/last-command-was-slime-async-eval nil)
  (defvar spw/last-slime-async-eval-command-frame nil)

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

  (advice-add 'sldb-setup :around #'spw/sldb-setup-avoid-focus-grab))

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

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

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

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

;;; Paredit

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

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

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

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

(defun spw/paredit-no-space-after (endp delimiter)
  (or endp (cl-case delimiter
	     (?\( (cl-case (char-before)
		    (?, nil)
		    (?@ (not (char-equal ?, (char-before (1- (point))))))))
	     (?\" (not (and (char-equal ?# (char-before (1- (point))))
			    (memql (char-before) '(?p ?P ??)))))
	     (t t))))
(add-to-list
 'paredit-space-for-delimiter-predicates #'spw/paredit-no-space-after)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

;; setting this means if we type C-c C-e o O then the PDF opens for inspection
(setq org-odt-preferred-output-format "pdf")
(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)


;;;; Org-mode agenda

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

(defun spw/skip-routine ()
  (spw/skip-when (string= "Routine" (org-get-category))))

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

In the last case, the idea is that if I've scheduled the project
then I intend to tackle all the NEXT actions on that date (or at
least the next chunk of them); I've broken the project down into
NEXT actions but not for the purpose of handling them on
different occasions."
  (spw/skip-when
   (or
    ;; #1
    ;; melete is a laptop, but usually it's not in Sheffield
    (and (or (spw/on-host-p "melete.silentflame.com")
	     (spw/on-host-p "erebus.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)))
    (cl-remove-if
     (lambda (file)
       (or (member file agenda-files)
	   (let ((name (file-name-nondirectory file)))
	     (or (string-prefix-p "." name)
		 ;; Exclude older files whose filenames aren't dates.
		 ;; Most of those used to be in ~/doc/org/philos and this
		 ;; function ignored that directory.  There are a few files
		 ;; this gets wrong, e.g. entzlist.org.
		 (not (cl-digit-char-p (string-to-char name)))))))
     (directory-files-recursively
      (expand-file-name org-directory) "\\.org\\'" nil))))


;;;; Diary

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

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

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

(defvar spw/archiveable-diary-entries-re
  (rx bol (? ?&)
      (or
       ;; Basic dated entries.  We're using the Y/M/D not D/M/Y because I have
       ;; to deal with dates written by both Americans and Europeans and using
       ;; the ISO order seems to result in fewer mistakes overall.
       (seq (group-n 1 (** 2 4 num))
	    (or ?/ ?-) (group-n 2 (** 1 2 num))
	    (or ?/ ?-) (group-n 3 (** 1 2 num)))
       ;; Blocks.  The (0+ 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* ((date (cdddr (decode-time)))
	   (today (encode-time (cl-list* 0 0 0 date)))
	   (tail (cdddr date)))
      (while (re-search-forward spw/archiveable-diary-entries-re nil t)
	(let ((y (string-to-number (match-string 1)))
	      (m (string-to-number (match-string 2)))
	      (d (string-to-number (match-string 3))))
	  (when (> 100 y) (cl-incf y 2000))
	  (when (time-less-p (encode-time (cl-list* 0 0 0 d m y tail)) today)
	    (spw/diary-archive-entry y)))))))
(with-eval-after-load 'diary-lib
  (define-key diary-mode-map "\C-z\C-c" #'spw/diary-archive-old-entries))

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

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

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

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


;;;; Howm

(setq howm-prefix "\C-cc"

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

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

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

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

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

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

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

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

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

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


;;;; C and friends

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

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

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

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

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

;;; 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-cgd" #'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))

(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