path: root/.emacs.d/init-spw.el

;;; init-spw.el --- Sean's Emacs configuration  -*- lexical-binding: t; -*-

;;; 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 a
;; 'spw' feature.

;;; Code:

(eval-and-compile
  ;; 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 (concat user-emacs-directory "site-lisp"))

  ;; 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 (concat user-emacs-directory "initlibs") t))

(require 'cl-lib)
(require 'diminish)
(require 'highlight-80+)
(require 'seq)
(require 'subr-x)

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

You should call `package-initialize' before using this macro, to
add places the library might be available to `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
  (declare (indent 1))
  (let ((libs (mapcar (lambda (l) (if (symbolp l) (symbol-name l) l))
                      (if (listp libraries) libraries (list libraries)))))
    `(unless (member nil (mapcar #'locate-library ',libs))
       ,@forms)))

(setq package-archives '(("GNU ELPA" . "https://elpa.gnu.org/packages/")
                         ("MELPA Stable" . "https://stable.melpa.org/packages/")
                         ("MELPA" . "https://melpa.org/packages/"))
      package-archive-priorities '(("GNU ELPA" . 10)
                                   ("MELPA Stable" . 5)
                                   ("MELPA" . 0)))

(defmacro spw/bind-command-with-cycling (bindings generator &optional on-exit map)
  (list 'spw/bind-command-with-cycling*
	(spw/expand-binding-pairs bindings)
	`(lambda (_ignore)
	   ,generator)
	`(lambda ()
	   ,on-exit)
	map))

(cl-defmacro spw/bind-command-with-ret-val-cycling
    (bindings
     &optional
     (generator '(spw/buffer-ring-cycle-lambda))
     on-exit
     map)
  (list 'spw/bind-command-with-cycling*
	(spw/expand-binding-pairs bindings)
	`(lambda (ret-val)
	   ,generator)
	`(lambda ()
	   ,on-exit)
	map))

(defun spw/expand-binding-pairs (bindings)
  (macroexp-quote
   (mapcar (lambda (binding)
	     (cond
	      ((and (vectorp binding) (eq 'remap (aref binding 0)))
	       (cons binding (aref binding 1)))
	      (t
	       binding)))
	   (if (or (vectorp bindings) (not (listp (cdr bindings))))
	       (list bindings)
	     bindings))))

(cl-defmacro spw/buffer-ring-cycle-lambda
    (&optional
     (ring '(spw/buffer-siblings-ring ret-val))
     (action '(switch-to-buffer buffer nil t))
     &key
     (start 0))
  `(when-let ((buffers ,ring)
	      (buffers-pos ,start))
     (lambda (count)
       (interactive "p")
       (setq buffers-pos (+ count buffers-pos))
       (let ((buffer (ring-ref buffers buffers-pos)))
	 ,action))))

(defun spw/bind-command-with-cycling* (bindings generator &optional on-exit map)
  (dolist (binding bindings)
    (let ((binding-fn (intern (concat "spw/"
				      (spw/drop-prefix
				       "spw/"
				       (symbol-name (cdr binding)))
				      "-with-transient-cycling"))))
      (fset binding-fn
	    (lambda ()
	      (interactive)
	      (let ((ret-val (call-interactively (cdr binding))))
		(when-let ((cycling-function (funcall generator ret-val))
			   (tmap (make-sparse-keymap)))
		  (define-key
		    tmap
		    [left]
		    (lambda (count)
		      (interactive "p")
		      (funcall cycling-function (* -1 count))))
		  (define-key tmap [right] cycling-function)
		  (set-transient-map tmap t on-exit)))))
      (if map
	  (define-key map (car binding) binding-fn)
	(global-set-key (car binding) binding-fn)))))

(defun spw/drop-prefix (prefix string)
  (if (string-prefix-p prefix string)
      (substring string (length prefix))
    string))

(defun spw/get-wm ()
  (when (executable-find "wmctrl")
    (let (wm
	  (display-env (getenv "DISPLAY")))
      (unwind-protect
	  (progn
	    (setenv "DISPLAY" (frame-parameter (selected-frame) 'display))
	    (setq wm (nth 1
			  (split-string (car (process-lines "wmctrl" "-m"))))))
	(setenv "DISPLAY" display-env))
      wm)))


;;;; Startup & basic preferences

(setq custom-file (concat user-emacs-directory "init-custom.el"))
(load (concat user-emacs-directory "init-custom"))

;; It would be nice to be able to use *scratch* for both plain text and ad hoc
;; elisp, but since I want always to edit lisp with paredit turned on, it's
;; not possible to combine these two things in one buffer.  So use Eshell or
;; IELM for ad hoc elisp (Eshell alone not enough because of IELM's
;; `ielm-change-working-buffer', which has no Eshell equivalent yet).  Might
;; consider adding a binding which creates or switches to a Lisp Interaction
;; buffer called *lisp*.
(setq initial-major-mode #'fundamental-mode
      initial-scratch-message nil)
(global-set-key "\C-cl" #'ielm)

;; for consistency with Eshell
(with-eval-after-load 'ielm
  (define-key ielm-map "\C-j" nil))

;; Put all auto-save files under ~/.emacs.d, both local and TRAMP.
;; Put local backups under ~/.emacs.d and TRAMP backups under remote
;; ~/.emacs.d.  So 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 (string-to-number "700" 8)))
  (setq backup-directory-alist `(("." . ,backups-dir))
        auto-save-file-name-transforms `((".*" ,auto-saves-dir t))
        tramp-auto-save-directory auto-saves-dir))
(setq backup-by-copying-when-linked t
      backup-by-copying-when-mismatch t
      tramp-backup-directory-alist backup-directory-alist)

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

(defun spw/do-mouse-setup ()
  (when (string= "i3" (spw/get-wm))
    ;; only do this once, as if open any text terminal frames, don't want
    ;; focus follow mouse to be turned off in graphical frames
    (remove-function after-focus-change-function #'spw/do-mouse-setup)
    (setq mouse-autoselect-window t
          focus-follows-mouse t
	  desktop-restore-forces-onscreen nil)

    ;; disable `mouse-autoselect-window' during `display-buffer', to avoid
    ;; surprise focus changes -- some code that calls `display-buffer'
    ;; does not expect `mouse-autoselect-window' to be on.  E.g.
    ;; `magit-status' can leave focus in the wrong window without this
    (advice-add 'display-buffer
		:around #'spw/disable-mouse-autoselect-window)))
(add-function :after after-focus-change-function #'spw/do-mouse-setup)

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

(fset 'yes-or-no-p #'y-or-n-p)

(setq confirm-kill-emacs #'y-or-n-p)

;; choice of font and size is driven by aim to fit eighty columns of
;; text in both halves of my laptop's monitor
(defvar spw/preferred-latin-fonts  '("Cousine-10"))
(defvar spw/preferred-han-fonts    '("Noto Serif CJK JP-10"))
(defvar spw/preferred-hangul-fonts '("Noto Serif CJK KR-10"))
(defun spw/first-available-font (fonts)
  (car (seq-drop-while
        (lambda (font) (not (find-font (font-spec :name font))))
        fonts)))
(defun spw/select-cousine ()
  (buffer-face-set
   (face-remap-add-relative 'default :family "Cousine" :height 100)))
(defun spw/do-font-setup ()
  (when (display-graphic-p)
    ;; harmless if function is not there to be removed
    (remove-function after-focus-change-function #'spw/do-font-setup)

    (when-let ((latin-font
                (spw/first-available-font spw/preferred-latin-fonts)))
      (set-face-font 'default latin-font))
    (when-let ((han-font (spw/first-available-font spw/preferred-han-fonts)))
      (dolist (charset '(kana han symbol cjk-misc bopomofo))
        (set-fontset-font t charset han-font)))
    (when-let ((hangul-font
                (spw/first-available-font spw/preferred-hangul-fonts)))
      (set-fontset-font t 'hangul hangul-font))

    ;; again on laptop, need to fit a bit more in these windows than can
    ;; with Inconsolata
    ;; (when (find-font (font-spec :name "Cousine-10"))
    ;;   (dolist (pair '(;; (org . org-mode-hook)
    ;;                   (org-agenda . org-agenda-mode-hook)))
    ;;     (eval-after-load (car pair)
    ;;       `(add-hook ',(cdr pair) #'spw/select-cousine))))
    ))

;; `find-font' will fail until there is a graphical frame, which might
;; not be yet, so set up a hook (which will remove itself after
;; running once) to do the font setup
(if (daemonp)
    (add-function :after after-focus-change-function #'spw/do-font-setup)
  (spw/do-font-setup))

(when (fboundp 'set-scroll-bar-mode) (set-scroll-bar-mode nil))
(when (fboundp 'tool-bar-mode) (tool-bar-mode 0))
(when (fboundp 'menu-bar-mode) (menu-bar-mode 0))
(when (fboundp 'blink-cursor-mode) (blink-cursor-mode 0))
(setq x-stretch-cursor t)
(setq-default cursor-type 'box)

;; On remote hosts in the UTC timezone, assume I'm in Arizona.  This
;; is relevant for using Org-mode.  Note that hosts in the UK will be
;; in GMT/BST, not UTC
(when (and (not (eq system-type 'windows-nt))
           (string= (cadr (current-time-zone)) "UTC"))
  (set-time-zone-rule "/usr/share/zoneinfo/America/Phoenix"))

;; Save my place in buffers, but only with newer Emacs.  With older
;; Emacs, the additions to `find-file-hook', `kill-emacs-hook' and
;; `kill-buffer-hook' made by `save-place' kept disappearing, unless I
;; enabled save-place using use-package's `:defer' keyword.  Adding
;; the hooks in this init file didn't work either.  See older dotfiles
;; repo commits
(when (version< "25.1" emacs-version)
  ;; if save-place is slowing down quitting Emacs, uncomment this:
  ;; (setq save-place-forget-unreadable-files nil)
  (save-place-mode 1))

;; This is an alternative way to activate the mark temporarily when
;; `transient-mark-mode' is off, and whether it's on or off, makes it
;; easier to operate on adjacent whole lines where the set of lines is
;; not surrounded by blank lines such that `mark-paragraph' can be
;; used.  A possible enhancement would be to enter a transient mode in
;; which C-n and C-p can select additional whole lines.
(defun spw/expand-region-to-whole-lines-and-activate ()
  (interactive)
  (when (> (point) (mark))
    (exchange-point-and-mark))
  (beginning-of-line)
  (set-mark (save-excursion (goto-char (mark)) (beginning-of-line 2) (point)))
  (activate-mark transient-mark-mode))
;; used to have it on M-+
(global-set-key "\C-cL" #'spw/expand-region-to-whole-lines-and-activate)

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

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

(setq transient-mark-mode nil

      ;; Disadvantage of this is that re-setting the mark right after popping
      ;; to it, to go and edit somewhere in destination buffer and then come
      ;; back, requires *remembering that* C-u C-u prefix is needed, and if
      ;; popping fewer than four times, it's more keystrokes.  I'm not sure
      ;; how distracting it is going to be to have to remember to do that, and
      ;; how often I want to re-set the mark right after popping to it, so
      ;; turning this on experimentally.
      ;;
      ;; Hmm, with `repeat' easily accessible on C-z, might not need this.
      set-mark-command-repeat-pop t)
(defun spw/remap-mark-command (command &optional map)
  "Remap a mark-* command to temporarily activate Transient Mark mode."
  (let* ((cmd (symbol-name command))
         (fun (intern (concat "spw/" cmd)))
         (doc (concat "Call `"
                      cmd
                      "' and temporarily activate Transient Mark mode.")))
    (fset fun `(lambda ()
                 ,doc
                 (interactive)
                 (call-interactively #',command)
                 (activate-mark)))
    (if map
        (define-key map (vector 'remap command) fun)
      (global-set-key (vector 'remap command) fun))))
(dolist (command '(mark-word
                   mark-sexp
                   mark-paragraph
                   mark-defun
                   mark-page
                   mark-whole-buffer
		   ;; see bug#42663
		   rectangle-mark-mode))
  (spw/remap-mark-command command))
(with-eval-after-load 'org
  (spw/remap-mark-command 'org-mark-subtree org-mode-map)
  (spw/remap-mark-command 'org-mark-element org-mode-map))

(fset 'indicate-copied-region #'ignore)

(setq disabled-command-function nil)

(show-paren-mode 1)
(setq show-paren-when-point-in-periphery t) ; useful for C-M-d
(defun spw/no-blink-matching-paren (orig-fun &rest args)
  (let ((blink-matching-paren nil))
    (apply orig-fun args)))
(with-eval-after-load 'paredit
  (advice-add 'paredit-move-past-close-and-newline
	      :around #'spw/no-blink-matching-paren))

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

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

;; ... and resettle the previous occupant of C-w
;; (we want to use a key which is already globally bound so that we know it is
;; likely to still be available in other major modes, and 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 need to rebind that
;; somewhere)
(global-set-key "\C-x\C-d" #'kill-region)

;; also make `zap-up-to-char' available
(global-set-key "\M-Z" #'zap-up-to-char)

;; We cannot reliably distinguish <C-backspace> from <backspace> so I
;; want to avoid getting into a habit of typing <C-backspace> into
;; Emacs.  Many terminal emulators send ^? for <backspace> and ^H for
;; <C-backspace> these days, or the other way around, but not all of
;; them.  Since Firefox binds <C-backspace> to delete words backwards
;; (apparently following some Microsoft products), there's some risk
;; here, so unbind
(global-unset-key [C-backspace])

(setq uniquify-buffer-name-style 'post-forward)

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

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

;; Not sure about this: although `suspend-frame' is bound to both C-x C-z and
;; C-z, C-z is a standard UNIX shell binding, so it might not be best to
;; rebind it.  On the other hand I hardly ever make use of shell job control
;; with Emacs, since if I have Emacs, then I have Eshell.
(global-set-key "\C-z" #'repeat)

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

(setq auth-source-save-behavior nil)

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

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

(setq kill-read-only-ok t)

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

;; and a binding to get the version on disk
(defun spw/revert-buffer ()
  (interactive)
  (revert-buffer nil t))
(global-set-key "\C-cr" #'spw/revert-buffer)

;; Since these don't work in text terminals, unbind them to avoid developing
;; any habits of using them.  They're less useful now that typing digit
;; arguments with M- requires holding down the meta key only for the first
;; digit
(let ((i ?0))
  (while (<= i ?9)
    (global-set-key (read (format "[?\\C-%c]" i)) nil)
    (setq i (1+ i))))
(global-set-key [?\C--] nil)
(let ((i ?0))
  (while (<= i ?9)
    (global-set-key (read (format "[?\\C-%c]" i)) nil)
    (setq i (1+ i))))
(global-set-key [?\C-\M--] nil)

;; C-x o is easier to type than these, but these are wanted for tapping
;; repeatedly when there are more than two windows
(defun spw/other-window-noselect (count &optional interactive)
  (interactive "p\np")
  (cl-flet ((old-select-window (symbol-function 'select-window)))
    (cl-letf (((symbol-function 'select-window)
	       (lambda (window &rest _ignore)
		 (old-select-window window 'mark-for-redisplay))))
      (other-window count nil interactive))))
(defun spw/backward-other-window-noselect (count &optional interactive)
  (interactive "p\np")
  (spw/other-window-noselect (* -1 count) interactive))
(spw/bind-command-with-cycling
 ;; don't select the windows we cycle through, so that the window where we
 ;; started becomes the most recently selected window
 (([?\C-x left] . spw/backward-other-window-noselect)
  ([?\C-x right] . spw/other-window-noselect))
 #'spw/other-window-noselect
 ;; select the destination window again with NOSELECT nil
 ;; TODO is not working sometimes ...?
 (progn
   (message "selecting the current window, %s" (selected-window))
   (select-window (selected-window))))

;; ... and resettle old occupants of C-x <left> and C-x <right>.  This is a
;; bit complicated but we want these commands to be easily repeatable but also
;; avoid setting a transient map containing self-insert chars, as might want
;; to type those right after switching.
;;
;; A possible improvement would be to have C-c b always take you back to the
;; buffer you were in before starting to use these commands.  E.g. C-c w
;; <left> <left> C-c b would take you back to where you started, and then C-c
;; b would take you back to where C-c w <left> <left> took you.
(defun spw/maybe-next-buffer ()
  (interactive)
  (cl-destructuring-bind
      (message command) (if (window-next-buffers)
			    '("Went forwards" next-buffer)
			  '("Went backwards" previous-buffer))
    (call-interactively `,command)
    (message message)))
(spw/bind-command-with-cycling
 ;; Note `previous-buffer' and `next-buffer' actually use
 ;; `switch-to-prev-buffer' and `switch-to-next-buffer' as subroutines, so
 ;; buffers previously shown in the selected window come up first, as
 ;; desired.
 ;;
 ;; Although C-c b can go backwards, really it's for going forwards; it is a
 ;; little tricky to use the arrow keys correctly right after C-c b if it
 ;; unexpectedly took us backwards (if we were expecting to go backwards,
 ;; would have used C-c w).
 ;;
 ;; The fallback to going backwards is there only because it would be worse to
 ;; go round to the end of the list of buffers, but perhaps it should just do
 ;; nothing?
 ;;
 ;; 'w' is for "window's buffers".
 (("\C-cw" . previous-buffer)
  ("\C-cb" . spw/maybe-next-buffer))
 (lambda (count)
   (interactive "p")
   (if (> count 0)
       (next-buffer count)
     (previous-buffer (* -1 count)))))

(setq switch-to-prev-buffer-skip 'this)

;; similar binding strategy for `winner-mode': make it repeatable; avoid
;; binding a self-insert char to the transient map; and avoid binding global
;; C-c <left>/<right> as might want these for something else
(setq winner-dont-bind-my-keys t)
(winner-mode 1)
(spw/bind-command-with-cycling
 ;; it's C-c q because this is a bit like `quit-restore-window'
 ("\C-cq" . winner-undo)
 (lambda (count)
   (interactive "p")
   (if (> count 0)
       (winner-redo)
     (setq this-command 'winner-undo)
     (winner-undo))))

;; also add useful cycling with arrow keys to C-x p e, C-h i, C-x 4 b
;; C-x 4 C-o, and others
(with-eval-after-load 'project
  (spw/bind-command-with-ret-val-cycling
   ("e" . project-eshell)
   nil
   nil
   ;; bind into project-prefix-map, rather than just a remap, so that works
   ;; under C-x 4 p too
   project-prefix-map))
(spw/bind-command-with-cycling
 [remap info]
 (spw/buffer-ring-cycle-lambda
  (spw/buffer-siblings-ring (get-buffer "*info*"))))
(spw/bind-command-with-ret-val-cycling
 ([remap switch-to-buffer]
  [remap switch-to-buffer-other-window]
  [remap switch-to-buffer-other-frame]))
(spw/bind-command-with-ret-val-cycling
 ([remap display-buffer]

  ;; `switch-to-buffer-other-tab' uses `display-buffer' so needs to be in this
  ;; invocation of `spw/bind-command-with-ret-val-cycling,' not the previous
  [remap switch-to-buffer-other-tab]

  ;; For some reason, in the case of `display-buffer-other-frame' only, the
  ;; transient map gets immediately cancelled, under i3, at least.  Fine on
  ;; text terminals
  [remap display-buffer-other-frame])

 (spw/buffer-ring-cycle-lambda
  (spw/buffer-siblings-ring (window-buffer ret-val))
  (with-selected-window ret-val
    (let ((display-buffer-overriding-action '((display-buffer-same-window)
					      (inhibit-same-window . nil))))
      (display-buffer buffer)))))

;; For when the buffer's name isn't much help for switching to it, as is often
;; the case with notmuch buffers.  Commented out for now because the transient
;; cycling appended to C-x b and C-x 4 C-o now includes buffers of the same
;; major mode after cloned siblings, so I think I can do without these
;; additional bindings.
;; (defun spw/read-major-mode-buffer-ring ()
;;   (let ((buffer-lists (make-hash-table)))
;;     (dolist (buffer (buffer-list))
;;       (with-current-buffer buffer
;; 	(puthash major-mode
;; 		 (cons buffer (gethash major-mode buffer-lists))
;; 		 buffer-lists)))
;;     (let* ((mode (intern (completing-read "Major mode: "
;; 					  (hash-table-keys buffer-lists)
;; 					  nil
;; 					  t)))
;; 	   (ring (make-ring (length (gethash mode buffer-lists)))))
;;       (dolist (buffer (gethash mode buffer-lists) ring)
;; 	(ring-insert ring buffer)))))
;; (defun spw/switch-to-major-mode-buffer ()
;;   (interactive)
;;   (let ((ring (spw/read-major-mode-buffer-ring)))
;;     (pop-to-buffer-same-window (ring-ref ring 0))
;;     ring))
;; (defun spw/display-major-mode-buffer ()
;;   (interactive)
;;   (let ((ring (spw/read-major-mode-buffer-ring)))
;;     (cons
;;      (display-buffer (ring-ref ring 0))
;;      ring)))
;; (spw/bind-command-with-ret-val-cycling
;;  ("\C-cb\C-o" . spw/display-major-mode-buffer)
;;  (spw/buffer-ring-cycle-lambda
;;   (cdr ret-val)
;;   (with-selected-window (car ret-val)
;;     (let ((display-buffer-overriding-action '((display-buffer-same-window)
;; 					      (inhibit-same-window . nil))))
;;       (display-buffer buffer)))))
;; (spw/bind-command-with-ret-val-cycling
;;  ("\C-cbb" . spw/switch-to-major-mode-buffer)
;;  (spw/buffer-ring-cycle-lambda
;;   (and (ring-p ret-val) ret-val)))

;; 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
(defun spw/turn-on-auto-fill-comments ()
  "Turn on filling comments."
  (setq-local comment-auto-fill-only-comments t)
  (turn-on-auto-fill))
(add-hook 'prog-mode-hook #'spw/turn-on-auto-fill-comments)

(setq enable-recursive-minibuffers t)

(setq sentence-end-double-space t)

(setq next-line-add-newlines nil)

(electric-indent-mode 1)

(setq debian-changelog-mailing-address (getenv "DEBEMAIL"))

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

;; ;; something involved in setting bookmarks likes to try to kill the
;; ;; bookmarks file buffer which means an annoying y/n query since
;; ;; something likes setting the modified flag without actually
;; ;; modifying anything.  So save it, or for the very frequently
;; ;; called `kill-buffer', clear modification flag for these bogus
;; ;; modifications
;; ;; TODO fix this upstream
;; (defun bookmark-write-file--save-bookmarks-buffer (&rest ignore)
;;   (when (get-buffer "emacs-bookmarks")
;;     (with-current-buffer (get-buffer "emacs-bookmarks")
;;       (save-buffer))))
;; (advice-add 'bookmark-write-file :before #'bookmark-write-file--save-bookmarks-buffer)
;; (defun kill-buffer--clear-modified (&rest ignore)
;;   (when (get-buffer "emacs-bookmarks")
;;     (with-current-buffer (get-buffer "emacs-bookmarks")
;;       (set-buffer-modified-p nil))))
;; (advice-add 'kill-buffer :before #'kill-buffer--clear-modified)

(setq column-number-mode t)

(setq vc-follow-symlinks t)

(setq dabbrev-case-fold-search t)

(setq require-final-newline t)

(ansi-color-for-comint-mode-on)

(add-hook 'after-save-hook
          #'executable-make-buffer-file-executable-if-script-p)

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

(setq select-active-regions t
      mouse-drag-copy-region t
      select-enable-primary t
      select-enable-clipboard t
      mouse-yank-at-point t
      yank-pop-change-selection nil
      save-interprogram-paste-before-kill t
      x-select-enable-clipboard-manager t)
(global-set-key [mouse-2] #'mouse-yank-primary)

;; disable line numbering primarily so that killing and copying stack
;; entries puts the number alone in the kill-ring
;; (setq calc-line-numbering nil)

;; (setq scroll-preserve-screen-position t)

(global-set-key "\C-cgm" #'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
(define-key isearch-mode-map "\M-c" nil)
;; can reuse this as its normal meaning not wanted during Isearch
(define-key isearch-mode-map "\C-cc" #'isearch-toggle-case-fold)

;; avoid setting the background colour on text terminals
(dolist (ws '(x w32 ns))
  (add-to-list 'window-system-default-frame-alist
	       `(,ws . ((background-color . "#FFFFF6")))))

(diminish 'eldoc-mode)

(setq tab-bar-show 1
      tab-bar-new-button-show nil
      tab-bar-close-button-show nil)
;; this makes C-x t o like my (customised) C-x o
(defun spw/tabs-without-current ()
    (cl-remove-if (lambda (tab)
		    (eq (car tab) 'current-tab))
		  (funcall tab-bar-tabs-function)))
(let (recent-tab-old-time)
  (defun spw/tab-bar-switch-with-record (fn &rest args)
    (interactive)
    (when-let ((tabs (spw/tabs-without-current)))
      ;; If the most recent tab is not the one we end up at after exiting the
      ;; transient map, we will want to set that tab's time back to what it
      ;; was before we changed tabs, as if we had never selected it.  So
      ;; record that info so we can do that.
      (setq recent-tab-old-time
	    (apply #'min (mapcar (lambda (tab) (alist-get 'time tab)) tabs)))
      (apply fn args)))
  (defun spw/tab-prev (n)
    (interactive "p")
    (spw/tab-next (* -1 n)))
  (defun spw/tab-bar-switch-to-recent-tab ()
    (interactive)
    (spw/tab-bar-switch-with-record #'tab-bar-switch-to-recent-tab))
  (defun spw/tab-next (n)
    (interactive "p")
    (spw/tab-bar-switch-with-record #'tab-bar-switch-to-next-tab n))
  (spw/bind-command-with-cycling
   (([?\C-c ?t left] . spw/tab-prev)
    ([?\C-c ?t ?o] . spw/tab-bar-switch-to-recent-tab)
    ([remap tab-next] . spw/tab-bar-switch-to-recent-tab)
    ([?\C-c ?t right] . spw/tab-next))
   (lambda (count)
     (interactive "p")
     ;; We are moving away from the current tab, so restore its time as if we
     ;; had never selected it, and store the time of the tab we're moving to
     ;; in case we need to do that a second time.
     (let ((next-tab-old-time
	    (let* ((tabs (funcall tab-bar-tabs-function))
		   (current-index (seq-position (mapcar #'car tabs)
						'current-tab))
		   (new-index (mod (+ current-index count)
				   (length tabs))))
	      (alist-get 'time (nth new-index tabs)))))
       (tab-bar-switch-to-next-tab count)
       (setf (alist-get 'time (car (seq-sort-by (lambda (tab)
						  (alist-get 'time tab))
						#'>
						(spw/tabs-without-current))))
	     recent-tab-old-time)
       (setq recent-tab-old-time next-tab-old-time)))))

(setq diff-font-lock-prettify t)

(global-so-long-mode 1)


;;;; TRAMP

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

(with-eval-after-load 'tramp
  ;; activate direct-async-process for all non-multihop SSH connections
  (add-to-list 'tramp-connection-properties
	       `(,(regexp-quote "/ssh:") "direct-async-process" t)))


;;;; Electric pairs

;; This mode sometimes gets thing wrong, and I've considered turning it off
;; and just doing things manually, but it does mean that non-paredit buffers
;; are a bit more like paredit buffers, and on balance I think that
;; consistency is the least surprising way to have things (not going to give
;; up paredit!)
;;
;; I think using this mode frees up M-( for rebinding as can just use C-M-SPC
;; (, but it does not free up M-), which remains useful for tapping repeatedly
;; when editing Lisp (using ) RET is less convenient for repeating).  We might
;; globally bind M-( to a paredit manipulation command, or bind it
;; mode-specifically; for example, `paredit-wrap-sexp' (different from
;; `paredit-wrap-round') might be on M-( in Lisp modes

(electric-pair-mode 1)

;; disable when paredit, cperl active as those modes are also trying to keep
;; things paired; better not to have two of them at it.  note that this will
;; be ignored for characters in `electric-pair-pairs' or
;; `electric-pair-text-pairs' (as appropriate to the context) such that, for
;; example, typing a backtick in a comment when editing Lisp will insert a
;; corresponding apostrophe.  possibly, then, I want to disable
;; `electric-pair-mode' more aggressively, perhaps by locally removing its
;; entry in `post-self-insert-hook'
(defun spw/electric-pair-inhibit-predicate (char)
  (or (bound-and-true-p paredit-mode)
      (bound-and-true-p cperl-mode)
      (electric-pair-conservative-inhibit char)))
(setq-default electric-pair-inhibit-predicate
	      #'spw/electric-pair-inhibit-predicate)

(defun spw/add-mode-electric-pairs (lib mode pairs)
  (let ((hook (intern (concat (symbol-name mode) "-hook")))
	(fn (intern (concat "spw/add-" (symbol-name mode) "-electric-pairs"))))
    (fset fn `(lambda ()
		,(concat "Add my additional electric pairs for `"
			 (symbol-name mode)
			 "'.")
		(setq-local electric-pair-pairs
			    (append electric-pair-pairs ,pairs)
			    electric-pair-text-pairs
			    (append electric-pair-text-pairs ,pairs))))
    (eval-after-load lib `(add-hook ,hook #',fn))))

;; take care adding things here -- only if would *never* want to use the
;; opening character on its own in that major mode (and then, should probably
;; be in the mode's syntax table)
(spw/add-mode-electric-pairs 'markdown-mode 'markdown-mode '((?` . ?`)))

;; Following sets up keys to behave as if they are in
;; `electric-pair-pairs'/`electric-pair-text-pairs' only when the region is
;; active (useful after hitting M-@ and/or C-M-SPC a few times).  Just for
;; consistency with paredit, as I keep finding myself expecting things to work
;; that way in other modes
(defun spw/add-mode-wrapping-pairs (lib mode pairs)
  (let ((map (intern (concat (symbol-name mode) "-map")))
	(fn (intern (concat "spw/set-" (symbol-name mode) "-wrapping-keys"))))
    (fset fn `(lambda ()
		"Rebind some self-insert keys to wrap when the region is active."
		(dolist (pair ',pairs)
		  ;; complexity here is due to fact there is
		  ;; `self-insert-command' but also things like
		  ;; `org-self-insert-command' to account for
		  (let ((old (if (memq pair spw/global-wrapping-pairs)
				 'self-insert-command
			       (with-temp-buffer
				 (funcall ',mode)
				 (key-binding (vector (car pair))))))
			(cmd (intern (concat "spw/"
					     ,(symbol-name mode)
					     "-" (vector (car pair))))))
		    (unless (eq old cmd)
		      (fset cmd `(lambda ()
				   ,(concat "`"
					    (symbol-name old)
					    "' unless the region is active, in which case wrap region with '"
					    (vector (car pair))
					    "'.")
				   (interactive)
				   (if (use-region-p)
				       ;; might want to set
				       ;; `parens-requires-spaces' here
				       (insert-pair nil ,(car pair) ,(cdr pair))
				     (call-interactively ',old))))
		      (define-key ,map (vector (car pair)) cmd))))))
    (eval-after-load lib fn)))

(defvar spw/global-wrapping-pairs
  '((?' . ?'))
  "Like `spw/add-mode-wrapping-pairs' but for the global map.")

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

(dolist (pair spw/global-wrapping-pairs)
  (let ((cmd (intern (concat "spw/self-insert-" (vector (car pair))))))
    (fset cmd `(lambda ()
		 (interactive)
		 (if (use-region-p)
		     (insert-pair nil ,(car pair) ,(cdr pair))
		   (call-interactively 'self-insert-command))))
    (global-set-key (vector (car pair)) cmd)))


;;;; Icomplete

(setq resize-mini-windows 'grow-only)

(when (>= emacs-major-version 27)
  (fido-mode 1)

  ;; 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.
  ;;
  ;; 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]       #'icomplete-fido-ret)
  (define-key icomplete-fido-mode-map (kbd "RET") #'icomplete-fido-exit)

  ;; Default binding for this function, M-TAB, may not be available to Emacs
  ;; as it is commonly used by window managers etc., and this is very useful
  ;; when renaming files.
  ;;
  ;; M-j is a better key to rebind than C-j because in C-M-j is bound to the
  ;; same thing as M-j in the default global map
  (define-key icomplete-fido-mode-map [?\M-j] #'icomplete-force-complete)

  ;; Preserve some standard bindings for editing text in the minibuffer.  We
  ;; might consider binding M-,/M-. to cycle completions because their normal
  ;; bindings aren't likely to be needed when completing, and unlike
  ;; C-,/C-. they work in text terminals
  (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))


;;;; The Emacs shell

;; this makes Eshell completions behave a bit more like bash
(setq eshell-cmpl-cycle-completions nil)

(with-eval-after-load 'eshell
  (add-to-list 'eshell-modules-list 'eshell-tramp))

(defun spw/insert-last-argument ()
  (interactive)
  (insert "$_"))

(defvar spw/eshell-external-shell-prefix "bash -c ")

(defun spw/eshell-wrap-or-unwrap-input-for-external-shell ()
  "Wrap a pipeline and pass to the OS shell, bypassing Eshell's pipelining.

If on an empty Eshell command line, first get the previous input
from the history.  After that, if already on a wrapped pipeline,
unwrap it for editing.

Supports redirecting the final output into Emacs buffers when the
redirects appear at the very end of the input.

Useful for pipelines which will move a lot of data, for which
Eshell's pipelining support can be too slow.  Assumes a single
line of input, as is typically the case when preparing pipelines
to be run by the OS shell."
  (interactive)
  (when (save-excursion
	  (eshell-bol)
	  (or (eq (point) (point-max)) (looking-at "\n")))
    (eshell-previous-input 1))
  (save-excursion
    (eshell-bol)
    (let ((wrapped (looking-at spw/eshell-external-shell-prefix))
	  (beg (point)))
      (end-of-line)
      (replace-region-contents
       beg (point)
       (if wrapped
	   #'spw/eshell-unwrap-input-for-external-shell
	 #'spw/eshell-wrap-input-for-external-shell))
      (unless wrapped (eshell-send-input)))))

(defun spw/eshell-wrap-input-for-external-shell ()
  (let ((redirects))
    (when (re-search-forward "\s+>+\s*#<" nil t)
      (setq redirects (buffer-substring (match-beginning 0) (point-max)))
      (delete-region (match-beginning 0) (point-max)))
    (concat spw/eshell-external-shell-prefix "'"
	    (replace-regexp-in-string "'" "'\\\\''" (buffer-string))
	    "'" redirects)))

(defun spw/eshell-unwrap-input-for-external-shell ()
  (delete-char (1+ (length spw/eshell-external-shell-prefix)))
  (when (re-search-forward "\s+>+\s*#<" nil 1)
    (goto-char (match-beginning 0)))
  (skip-chars-backward "\s")
  (delete-char -1) ; remove the closing single quote
  (let ((beg (point)))
    (beginning-of-line)
    (while (re-search-forward "'\\\\''" beg t)
      (replace-match "'")))
  (buffer-string))

;; seems `eshell-mode-map' is globally nil
(defun spw/define-eshell-keys ()
  (define-key eshell-mode-map "\M-." #'spw/insert-last-argument)
  (define-key eshell-mode-map "\C-cib"
    #'spw/eshell-wrap-or-unwrap-input-for-external-shell))
(add-hook 'eshell-mode-hook #'spw/define-eshell-keys)

;;; prompt

;; I prefer to have a prompt which is just '>' followed by no space, as that's
;; nice and compact, but adding a space after the prompt means we can use
;; yasnippets to input commands
(setq
 ;; this is the old one using '>'
 ;;(setq eshell-prompt-function
 ;;      (lambda ()
 ;;	(let ((pwd (if (string= (expand-file-name "~/") default-directory)
 ;;		       (eshell/pwd)
 ;;		     (abbreviate-file-name (eshell/pwd)))))
 ;;	  (if (zerop eshell-last-command-status)
 ;;	      (concat pwd ">")
 ;;	    (format "%s %s>" eshell-last-command-status pwd))))
 ;;      eshell-prompt-regexp "^[^>\n]*>")

 ;; and this is one with spaces
 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]* % ")

;;; misc. functions

;; used in 'cd/' yasnippet
(defun spw/eshell-tramp-cd ()
  (let* ((whole (eshell/pwd))
	 (localname (tramp-file-name-localname
		     (tramp-dissect-file-name whole)))
	 (localname-start (string-match localname whole)))
    (concat "cd " (substring whole 0 localname-start) "/")))

;;; commands to get to shell buffers -- sometimes useful to prefix with C-x 4 1

(defun spw/eshell-here ()
  "Switch to an Eshell in `default-directory', creating one if necessary."
  (interactive)
  (if (eq major-mode 'eshell-mode)
      ;; switch to another Eshell in the current directory
      (eshell t)
    (let ((dir default-directory)
	  (buffers (buffer-list)))
      (while (and buffers
		  (not (with-current-buffer (car buffers)
			 (and (eq major-mode 'eshell-mode)
			      (equal default-directory dir)))))
	(setq buffers (cdr buffers)))
      (if (car buffers)
	  (pop-to-buffer (car buffers))
	(eshell t)))))

(defconst spw/project-eshells-regexp
  "\\`\\*\\(.+\\)-eshell\\*[><0-9]*\\'")

(defun spw/cycle-eshells ()
  "Cycle through all Eshell buffers."
  (interactive)
  (let ((project (project-current))
	(current-eshell (and (eq major-mode 'eshell-mode)
			     (current-buffer)))
	project-eshells
	other-eshells)
    (dolist (buffer (buffer-list))
      (with-current-buffer buffer
	(when (and (eq major-mode 'eshell-mode)
		   (not (eq buffer current-eshell)))
	  (cond
	   ;; First check if we're generated by `project-eshell'; if so,
	   ;; include in the buffers to be cycled through only if we're for
	   ;; the current project.  An Eshell started by `project-eshell' may
	   ;; lose its association with the project if I cd to somewhere else,
	   ;; (e.g. to ~/.emacs.d from ~/src/dotfiles/.emacs.d) but at least
	   ;; for the purposes of the present command, it is more useful to
	   ;; consider it to remain one of the project's Eshells (as
	   ;; `project-eshell' effectively does)
	   ((string-match spw/project-eshells-regexp (buffer-name))
	    (when (and project
		       (string= (match-string 1 (buffer-name))
			    (file-name-nondirectory
			     (directory-file-name
			      (project-root project)))))
	      (push buffer project-eshells)))
	   ;; Now look at the current project for this non-`project-eshell'
	   ;; Eshell -- Eshells generated using C-c e h within the current
	   ;; project should also be included (if we want to avoid cycling
	   ;; through these can use C-x p e which too has arrow key cycling)
	   ((equal project (project-current))
	    (push buffer project-eshells))
	   ;; If this Eshell which is not for the current project is the most
	   ;; recently used Eshell, consider it to be an Eshell for the
	   ;; current project -- idea is that we show the most recently used
	   ;; Eshell first unless it's a `project-eshell' Eshell for another
	   ;; project
	   ((not (or other-eshells project-eshells))
	    (push buffer project-eshells))
	   ;; All remaining Eshells
	   (t
	    (push buffer other-eshells))))))
    (if-let ((eshell-buffers
	      ;; reverse of the order we want to cycle through them in
	      (append (and current-eshell (list current-eshell))
		      other-eshells
		      project-eshells)))
	(let ((ring (make-ring (length eshell-buffers))))
	  (dolist (buffer eshell-buffers)
	    (ring-insert ring buffer))
	  (pop-to-buffer (ring-ref ring 0))
	  ;; return the ring, to be used by transient cycling functions
	  ring)
      ;; if no Eshells except possibly generated by `project-eshell' for other
      ;; projects, start a new Eshell in HOME
      (let ((default-directory (expand-file-name "~")))
	(eshell t)))))

;; C-c e e is the main way to get back to the most recent shell session; C-c e
;; h and C-x p e are for when we don't have one yet for the current task (or
;; when we don't know whether we have one -- when we haven't run any shell
;; commands yet in our attempts to accomplish this task)
(global-set-key "\C-ceh" #'spw/eshell-here)
(spw/bind-command-with-ret-val-cycling
 ("\C-cee" . spw/cycle-eshells)
 (spw/buffer-ring-cycle-lambda
  (and (ring-p ret-val) ret-val)))

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

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


;;;; Miscellaneous functions

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

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

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

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

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

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

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

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

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

;; For safety we shouldn't have a key bound to `recompile', so have this.
;; Complements C-x p c, for the case where we want to compile an individual
;; with a custom `compile-command', like my papers which are typeset with
;; pandoc
(defun spw/compile-or-maybe-recompile ()
  (interactive)
  (if-let ((compilation-windows
	    (cl-remove-if-not (lambda (window)
				(with-current-buffer (window-buffer window)
				  (eq major-mode 'compilation-mode)))
			      (window-list))))
      (with-current-buffer (window-buffer (seq-first compilation-windows))
	(call-interactively 'recompile))
    ;; (delete-other-windows)
    (call-interactively 'compile)))
(global-set-key "\C-cc" #'spw/compile-or-maybe-recompile)

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

(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)))
      ;; want this or something like it as part of the public API (feature
      ;; request submitted to Emacs' bug tracker
      (project-remember-project project)))
  (call-interactively 'project-switch-project))
(global-set-key "\C-cp" #'spw/register-programming-projects-and-switch)

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

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

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

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

(defun spw/window-to-frame ()
  "Like `tear-off-window' but to be invoked from the keyboard."
  (interactive)
  (let ((buffer (current-buffer))
	(display-buffer-overriding-action '(display-buffer-pop-up-frame)))
    (delete-window)
    (display-buffer buffer)))
(global-set-key "\C-cff" #'spw/window-to-frame)

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

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

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

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

(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)))
    (when (and (file-exists-p source) (not (file-exists-p dest)))
      (dired-copy-file source dest nil)
      (revert-buffer)
      (dired-previous-line 1)
      (dired-find-file))))

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

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

(defun spw/use-tabs-not-frames ()
  "Whether to pop up new tabs instead of new frames.
Should be t when do not have a good way to handle having lots of
open frames, as I do have under i3 with its tabbed layout (which
I use by default)."
  (or (not (memq (framep (selected-frame)) '(x)))
      (not (string= "i3" (spw/get-wm)))))

;; if we're going to be using multiple frames, make `frame-title-format' not
;; depend on whether there are multiple frames right now
(add-function :after after-focus-change-function #'spw/set-frame-title-format)
(defun spw/set-frame-title-format ()
  (unless (spw/use-tabs-not-frames)
    (remove-function after-focus-change-function #'spw/set-frame-title-format)
    (setq frame-title-format "%b")))

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

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

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

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

(defun spw/get-mru-window ()
  "Like `get-mru-window' but also consider the minibuffer."
  (let (best-window best-time time)
    (dolist (window (window-list-1) best-window)
      (setq time (window-use-time window))
      (when (and (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 M-1 C-x o
      (call-interactively #'other-window)
    (select-window (spw/get-mru-window))))
(global-set-key [remap other-window] #'spw/back-and-forth)

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

(defconst spw/buffer-siblings-major-modes
  '(("\\`*unsent mail" . message-mode))
  "Alist mapping regexps to major modes.
Buffers whose names match a regexp are considered to be
associated with buffers with the major mode, regardless of what
major mode is actually active in the buffer.")

(defun spw/buffer-siblings-ring (buffer)
  "Return ring of BUFFER clones and buffers sharing the clones' major mode.
BUFFER itself is the first element of the ring, and then the
clones of BUFFER, and then buffers merely sharing the major mode
of the family of clones.

Whether a buffer is considered a clone of BUFFER is determined by
its name alone.  So clones produced by `clone-buffer' and
`clone-indirect-buffer' will be counted as siblings, but so will
the two Eshell buffers produced if you type \\[project-eshell]
and then \\[universal-argument] \\[project-eshell], as the same
naming scheme is used.  This is desirable.

The (singular) major mode of the family of clones is determined
using heuristics, as it is expected that clones of a buffer may
have different major modes -- that's one of the reasons for
making indirect clones."
  (let (buffers
	(clones-hash (make-hash-table))
	mode
	(root-name (if (string-match "\\`\\(.+\\)<[0-9]+>\\'"
				     (buffer-name buffer))
		       (match-string 1 (buffer-name buffer))
		     (buffer-name buffer))))
    (let* ((clones-regexp
	    (concat "\\`" (regexp-quote root-name) "\\(<[0-9]+>\\)?\\'"))
	   (pred (lambda (b) (string-match clones-regexp (buffer-name b)))))
      ;; Build a list of the clones
      (setq buffers (cl-remove-if-not pred (buffer-list)))
      ;; Also build a hash of the clones so that we can answer the question of
      ;; whether an arbitrary buffer is one of the clones in constant time
      (dolist (buffer buffers)
	(puthash buffer t clones-hash))
      (setq mode
	    (or
	     ;; 1. See if this buffer name is associated with a particular
	     ;; mode.
	     (cl-loop for pair in spw/buffer-siblings-major-modes
		      if (string-match (car pair) root-name)
		      return (cdr pair))
	     ;; 2. If only one buffer or root clone is visiting a file, use
	     ;; major mode of that one buffer or root clone.  Don't
	     ;; consider arbitrary clones visiting files, as this may be
	     ;; because user cloned, edited down, changed major mode and
	     ;; wrote to a file.  The only case we want to catch here is
	     ;; the root of a family of indirect clones, basically.
	     (and (eq 1 (length buffers))
		  (with-current-buffer (car buffers)
		    major-mode))
	     (when-let ((root-clone (cl-find-if
				     (lambda (b)
				       (string= root-name (buffer-name b)))
				     buffers)))
	       (with-current-buffer root-clone
		 (and (buffer-file-name)
		      major-mode)))
	     ;; 3. See if the name of one of the clones is a substring of its
	     ;; major mode, and if so, use that mode.  So *eww* -> eww-mode.
	     ;; If there are cases this heuristic will get wrong, add to
	     ;; `spw/buffer-siblings-major-modes' to override.
	     (let ((root-root-name (regexp-quote
				    (if (string-match "\\`\\*\\(.+\\)\\*\\'"
						      root-name)
					(match-string 1 root-name)
				      root-name)))
		   (case-fold-search t))
	       (cl-loop for buffer in buffers
			for mode = (symbol-name
				    (with-current-buffer buffer major-mode))
			if (string-match root-root-name mode)
			return mode))
	     ;; 4. Fallback.
	     (with-current-buffer buffer major-mode))))
    (dolist (buffer (buffer-list))
      (with-current-buffer buffer
	(when (and (eq mode major-mode)
		   ;; This is where we make use of our hash of the clones
		   (not (gethash buffer clones-hash)))
	  (push buffer buffers))))
    (let (;; Ensure that original buffer is the first one inserted
	  ;; into the ring, so that cycling through the ring starting from
	  ;; the original buffer makes sense.  Usually the original buffer
	  ;; will be the most recently selected buffer and so highest in
	  ;; (buffer-list), but when we are called by
	  ;; `spw/display-buffer-with-transient-cycling' and similar
	  ;; functions wrapping `display-buffer' not `switch-to-buffer', this
	  ;; will not be the case
	  (reversed (nreverse (cons buffer (remove buffer buffers))))
	  (ring (make-ring (length buffers))))
      (dolist (buffer reversed ring)
	(ring-insert ring buffer)))))

(defun spw/locate-source-library (library)
  (interactive (list (read-library-name)))
  (find-file-other-window (locate-library (concat library ".el"))))

(defun spw/flatten (list)
  "Non-destructive list flatten."
  (cl-labels
      ((flatten (list)
		(let (accum)
		  (dolist (element list accum)
		    (if (atom element)
			(push element accum)
		      (setq accum (append (flatten element) accum)))))))
    (nreverse (flatten list))))

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

(with-eval-after-load 'message
  (spw/when-library-available message-templ
    (defun spw/unfinalise-message ()
      (interactive)
      (setq spw/message-normalised nil)
      (message "Message marked as not normalised"))
    (define-key message-mode-map [f7] #'spw/unfinalise-message)

    (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))
    (define-key message-mode-map [f8] #'spw/normalise-message)

    (defun spw/message-kill-and-normalise ()
      (interactive)
      (newline)
      (message-kill-to-signature)
      (spw/normalise-message))
    (define-key message-mode-map [f9] #'spw/message-kill-and-normalise)

    (defun spw/message-maybe-sign ()
      ;; no PGP signing on athena
      (unless (string= (system-name) "athena")
	;; 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))))
    (setq
     message-templ-alist
     '(("default" ("From" . "Sean Whitton <spwhitton@spwhitton.name>"))
       ("UA" ("From" . "Sean Whitton <spwhitton@email.arizona.edu>")))
     message-templ-config-alist
     `(("^\\(To\\|Cc\\|Bcc\\):.+\\(@.*debian\\.org\\|sgo-software-announce\\)"
	,#'spw/message-maybe-sign)
       ("^\\(To\\|Cc\\|Bcc\\):.+@.+\\(\.edu\\|\.ac\.uk\\)" "UA"))))

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

  ;; 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))
      (call-interactively #'mail-add-attachment)))
  (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))
  (defun spw/mutt-mail-header-separator ()
    (when (string-match-p "^mutt-" (buffer-name))
      (setq-local mail-header-separator "")))
  (add-hook 'message-mode-hook #'spw/mutt-mail-header-separator)

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

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

  ;; it's a really long line with notmuch, causing unwanted line wrapping
  (add-to-list 'message-hidden-headers "^User-Agent:")

  (defun spw/message-newline-and-reformat (arg)
    "Like `message-newline-and-reformat', but remove unneeded lines."
    (interactive "P")
    (message-newline-and-reformat arg)
    (save-excursion
      (forward-line -2)
      (while (and (looking-at message-cite-prefix-regexp)
		  (looking-at paragraph-start))
	(kill-line 1)
	(beginning-of-line 0)))
    (save-excursion
      (forward-line 2)
      (while (and (looking-at message-cite-prefix-regexp)
		  (looking-at paragraph-start))
	(kill-line 1))))
  (define-key message-mode-map [remap message-newline-and-reformat]
    #'spw/message-newline-and-reformat)

  ;; disable openwith-mode when sending mail (i.e. attach the PDF,
  ;; rather than opening it in evince and aborting the send)
  (require 'mm-util)
  (add-to-list 'mm-inhibit-file-name-handlers 'openwith-file-handler)

  ;; disable openwith-mode when certain other functions are running
  (defun spw/without-openwith (orig-fun &rest args)
    (let ((inhibit-file-name-handlers (cons 'openwith-file-handler
					    inhibit-file-name-handlers)))
      (apply orig-fun args)))
  (with-eval-after-load 'ox-odt
    (advice-add 'org-odt-export-to-odt :around #'spw/without-openwith))

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


;;;; Dired

(setq dired-recursive-deletes 'top
      dired-recursive-copies 'always
      dired-clean-confirm-killing-deleted-buffers nil
      dired-dwim-target t
      dired-listing-switches "--group-directories-first -alh")

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

	;; exclude all dotfiles (no need for . and .. in dired, I think)
	dired-omit-files "\\`\\."))

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

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

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

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

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


;;;; EWW

(setq shr-max-width 80)

(defun spw/eww-readable-once ()
  (unwind-protect
      (eww-readable)
    (remove-hook 'eww-after-render-hook #'spw/eww-readable-once)))

(defun spw/next-eww-readable ()
  (add-hook 'eww-after-render-hook #'spw/eww-readable-once))

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


;;;; Assorted packages

(spw/when-library-available paredit
  (dolist (hook '(lisp-mode-hook
                  emacs-lisp-mode-hook
                  lisp-interaction-mode-hook
		  eval-expression-minibuffer-setup-hook))
    (add-to-list hook 'enable-paredit-mode))

  (with-eval-after-load 'ielm
    (add-to-list 'ielm-mode-hook 'enable-paredit-mode))
  (with-eval-after-load 'scheme
    (add-to-list 'scheme-mode-hook 'enable-paredit-mode))
  (with-eval-after-load 'xscheme
    (add-to-list 'xscheme-start-hook 'enable-paredit-mode))
  (with-eval-after-load 'slime-repl
    (add-to-list 'slime-repl-mode-hook 'enable-paredit-mode)))

(with-eval-after-load 'paredit
  (diminish 'paredit-mode)

  (defun spw/paredit-unix-word-rubout ()
    (interactive)
    (if (save-excursion (skip-chars-backward "[:space:]\n")
			(paredit-in-comment-p))
	(spw/unix-word-rubout)
      (backward-kill-sexp)))
  (define-key paredit-mode-map "\C-w" #'spw/paredit-unix-word-rubout)

  (define-key paredit-mode-map "\M-r" nil)
  (define-key paredit-mode-map "\M-R" #'paredit-raise-sexp)

  (define-key paredit-mode-map "\M-s" nil)
  (define-key paredit-mode-map "\M-U" #'paredit-splice-sexp)

  ;; better to use negative args with global bindings of C-M-u and C-M-d
  (define-key paredit-mode-map (kbd "C-M-n") nil)
  (define-key paredit-mode-map (kbd "C-M-p") nil)

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

(spw/when-library-available elisp-slime-nav
  (dolist (hook '(emacs-lisp-mode-hook ielm-mode-hook))
          (add-hook hook #'elisp-slime-nav-mode)))

(with-eval-after-load 'elisp-slime-nav
  (diminish 'elisp-slime-nav-mode))

;; find lines violating 80 cols rule
;;
;; highlight-80+.el is no longer maintained because author suggests using
;; `whitespace-mode'; however, customising whitespace-mode to display only
;; long lines, and not all the stuff it usually displays, means it can't be
;; toggled on and off to quickly show other whitespace, which can be useful
;;
;; note that highlight-80+ has the advantage over the likes of pre-Emacs 27
;; fill-column-indicator of not using overlays, which easily conflict with
;; other packages
(setq-default fill-column 78)
(let (mode)
  (if (>= emacs-major-version 27)
      (setq mode 'display-fill-column-indicator-mode)
    (autoload 'highlight-80+-mode "highlight-80+")
    (setq mode 'highlight-80+-mode)
    (with-eval-after-load 'highlight-80+
      (diminish 'highlight-80+-mode)))
  (dolist (pair '((prog-mode . prog-mode-hook)
		  (message . message-mode-hook)))
    (eval-after-load (car pair)
      `(add-hook ',(cdr pair) #',mode))))

;; ensure that magit adds to project-prefix-map and project-switch-commands as
;; soon as project.el commands are invoked
(spw/when-library-available magit
  (eval-after-load 'project '(require 'magit)))

(with-eval-after-load 'magit
  (setq
   ;; by default, don't pass -f to `git remote add`
   magit-remote-arguments nil
   ;; by default, don't pass --ff to `git cherry-pick`
   magit-cherry-pick-arguments nil

   magit-push-always-verify nil)

  ;; drop "Unpulled from pushremote" which doesn't make sense with how
  ;; I use push remotes
  (remove-hook 'magit-status-sections-hook
               #'magit-insert-unpulled-from-pushremote)

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

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

  ;; reclaim
  (define-key magit-mode-map "\M-w" nil)

  (when (version< (magit-version) "3.0.0")
    (defun spw/project-magit ()
      (interactive)
      (magit-status-internal (project-root (project-current t))))

    (with-eval-after-load 'project
      (define-key project-prefix-map "m" #'spw/project-magit)
      (add-to-list 'project-switch-commands '(?m "Magit" spw/project-magit)))))

(spw/when-library-available ws-butler
  (require 'ws-butler)
  (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))

  (ws-butler-global-mode))

(spw/when-library-available redtick
  (global-set-key "\C-cP" #'redtick-mode)
  (setq redtick-history-file nil))

(spw/when-library-available notmuch
  ;; Loading notmuch will load init-notmuch.el where this function is
  ;; defined (see next `with-eval-after-load' form)
  (autoload 'spw/next-unread-group "notmuch")

  ;; Ensure notmuch does its `message-mode' configuration and that my
  ;; notmuch-config.el gets loaded before certain commands happen.  An
  ;; alternative to advising `compose-mail' and friends here would be
  ;; to remap its keys to `notmuch-mua-new-mail', but it is nice to
  ;; have things work correctly if some lisp code somewhere calls
  ;; `compose-mail' or friends
  (defun spw/load-notmuch (&rest _ignore)
    (require 'notmuch))
  (dolist (cmd '(compose-mail
                 compose-mail-other-window
                 compose-mail-other-frame
                 notmuch-jump-search
                 notmuch-hello))
    (advice-add cmd :before #'spw/load-notmuch))

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

;; init-notmuch.el used to be notmuch-config.el, but notmuch.el's
;; mechanism for loading notmuch-config.el does not respect
;; `load-prefer-newer', so work around the problem by using
;; our own init-notmuch.el and `with-eval-after-load' form for now
(with-eval-after-load 'notmuch
  (load (concat user-emacs-directory "init-notmuch")))

(with-eval-after-load 'org-d20
  (setq org-d20-dice-sound
        "~/annex/media/sounds/147531__ziembee__diceland.wav"
        ;; 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 nov-text-width 80))

(spw/when-library-available mailscripts
  (global-set-key "\C-cvt" #'notmuch-extract-thread-patches-projectile)
  (global-set-key "\C-cvw" #'notmuch-extract-message-patches-projectile)
  (global-set-key "\C-cgb" #'notmuch-slurp-debbug)
  (global-set-key "\C-cgB" #'notmuch-slurp-this-debbug)
  (setq mailscripts-extract-patches-branch-prefix "mail/"
        mailscripts-detach-head-from-existing-branch t
	mailscripts-project-library 'project))

(spw/when-library-available ggtags
  (setq ggtags-mode-line-project-name nil)
  (dolist (hook '(cperl-mode-hook c-mode-hook))
    (add-hook hook #'ggtags-mode)))

(spw/when-library-available org-roam
  (autoload 'org-roam-dailies-today "org-roam")

  (setq org-roam-directory (expand-file-name "~/doc/notes"))

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

  (defun spw/org-roam-dailies-ring ()
    (let* ((today-file (concat (format-time-string "%F") ".org"))
	   (files (directory-files
		   org-roam-directory
		   nil
		   "\\`[0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\.org\\'"))
	   (ring (make-ring (length files))))
      ;; rotate the list so we begin with today or the closest day after today
      (let ((today (cl-do* ((files files (rest files))
			    (next (rest files) (rest files)))
		       ((or (not next)
			    (string= today-file (car next))
			    (string-lessp today-file (car next)))
			(setcdr files nil)
			next))))
	(setq files (append today files)))
      (dolist (file (nreverse files) ring)
	(ring-insert ring file))))
  (defun spw/org-roam-dailies-prev (n)
    (interactive "p")
    (spw/org-roam-dailies-next (* -1 n)))
  (defun spw/org-roam-dailies-today ()
    (interactive)
    (call-interactively #'org-roam-dailies-today)
    (cons (spw/org-roam-dailies-ring) 0))
  (defun spw/org-roam-dailies-next (n)
    (interactive "p")
    (let ((today-file (concat (format-time-string "%F") ".org"))
	  (ring (spw/org-roam-dailies-ring)))
      ;; special case: if positive arg and the first item in the ring is not
      ;; today, we need to start one earlier
      (when (and (> n 0)
		 (not (string= today-file (ring-ref ring 0))))
	(decf n))
      (find-file (concat org-roam-directory "/" (ring-ref ring n)))
      (cons ring n)))
  (spw/bind-command-with-ret-val-cycling
   (([?\C-c ?o left] . spw/org-roam-dailies-prev)
    ("\C-cod" . spw/org-roam-dailies-today)
    ([?\C-c ?o right] . spw/org-roam-dailies-next))
   (spw/buffer-ring-cycle-lambda
    (car ret-val)
    (find-file (concat org-roam-directory "/" buffer))
    :start (cdr ret-val)))

  ;; don't bother starting it up until we open something in Org-mode
  (with-eval-after-load 'org
    (unless org-roam-mode (org-roam-mode 1))))

(with-eval-after-load 'org-roam
  (diminish 'org-roam-mode)

  (define-key org-mode-map "\C-cor" #'org-roam)
  (define-key org-mode-map "\C-cir" #'org-roam-insert-immediate))

(spw/when-library-available openwith
  (defun spw/exts-regexp (&rest strings)
    (concat "\\." (regexp-opt strings) "\\'"))

  (setq openwith-associations
	`(("\\.pdf\\'"
	   "evince" (file))
	  (,(spw/exts-regexp
	     "ogg" "mp3" "flac"
	     "mkv" "webm" "avi" "mp4" "wmv" "flv" "mov")
	   "mpv" (file))
	  (,(spw/exts-regexp
	     "caf")
	   "vlc" (file))
	  (,(spw/exts-regexp
	     "doc" "docx" "odt" "pages" "xls" "xlsx" "ppt" "pptx" "potx")
	   "soffice" (file))
	  ("\\.hwp\\'"
	   "hanword" (file))
	  (,(spw/exts-regexp
	     "jpg" "JPG" "jpeg" "png" "gif")
	   "eog" (file))))

  (openwith-mode 1)

  ;; openwith reduces the chances we hit this threshold so can set it higher
  (setq large-file-warning-threshold 500000000))

(spw/when-library-available yasnippet
  (yas-global-mode 1)
  (diminish 'yas-minor-mode)

  ;; kill warnings about snippets that use backquoted lisp to change
  ;; the buffer
  (unless (boundp 'warning-suppress-types)
    (setq warning-suppress-types nil))
  (push '(yasnippet backquote-change) warning-suppress-types))

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

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

(spw/when-library-available rainbow-delimiters
  (dolist (hook '(lisp-mode-hook
                  emacs-lisp-mode-hook
                  lisp-interaction-mode-hook
		  eval-expression-minibuffer-setup-hook))
    (add-to-list hook 'rainbow-delimiters-mode))

  (with-eval-after-load 'scheme-mode
    (dolist (hook '(scheme-mode-hook
                    inferior-scheme-mode-hook))
      (add-to-list hook 'rainbow-delimiters-mode))))

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

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

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

(spw/when-library-available haskell-mode
  (setq haskell-indentation-layout-offset 4
	haskell-indentation-left-offset 4
	haskell-indentation-show-indentations nil

	;; this tends to get in the way
	haskell-mode-contextual-import-completion nil))

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

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

(spw/when-library-available orgalist
  ;; contents of function from upstream docs
  (defun spw/activate-orgalist ()
    (yas-minor-mode -1)
    (orgalist-mode 1)
    (yas-minor-mode))

  (with-eval-after-load 'message
    (add-hook 'message-mode-hook #'spw/activate-orgalist)))


;;;; Lisp

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

(with-eval-after-load 'xscheme
  (define-key scheme-mode-map "\eo" nil)
  (define-key scheme-mode-map "\C-c\C-l" #'xscheme-send-buffer)

  (define-key scheme-mode-map "\ez" nil))

;; to use this, mkdir & change to ~/local/clhs, then expand hyperspec tarball
;; I have stored in annex
(setq common-lisp-hyperspec-root (concat "file://"
					 (expand-file-name
					  "~/local/clhs/HyperSpec/")))
(add-to-list 'browse-url-handlers '("/local/clhs/HyperSpec/" . eww))

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


;;;; Org-mode

;; these should be set before Org gets loaded, because used by functions in
;; this file, or because docstrings say they have to be set early
(setq
 ;; set it early as functions in this file might want it
 org-directory "~/doc/org"

 ;; disable this so I can start lines with "P. 211 - " to refer to a page
 ;; rather than start a bulleted list
 org-list-allow-alphabetical nil

 org-enforce-todo-checkbox-dependencies t)

(global-set-key "\C-coc" #'org-capture)
(global-set-key "\C-col" #'org-store-link)
(global-set-key "\C-coa" #'org-agenda)

(dolist (fn '(spw/org-agenda-file-to-front
	      spw/org-remove-file
	      org-save-all-org-buffers))
  (autoload fn "org"))

;; defined in init-org.el
(global-set-key "\C-co[" #'spw/org-agenda-file-to-front)
(global-set-key "\C-co]" #'spw/org-remove-file)

(with-eval-after-load 'org
  (load (concat user-emacs-directory "init-org")))

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


;;;; C and friends

;; the built-in 'linux' style doesn't explicitly include tabs, so with
;; indent-tabs-mode set to nil, cc-mode will not use tabs.  But the
;; kernel style guide mandates tabs, so make a slightly modified style
;; TODO fix in the 'linux' style in upstream Emacs?
(c-add-style "linux-tabs" '("linux" (indent-tabs-mode . t)))
(setq c-default-style "linux-tabs")

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

;;; 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 frame for serious source editing, from
;; which `compile' or `project-compile' is called, and one Emacs 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,
           ;; because we can't seem to set breakpoints anymore
         (spw/quit-gud)
	 (spw/start-gud))
        (16 ;; quit the GUD session
         (spw/quit-gud))
        (t ;; restore the GUD session's window(s)
         (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdbmi)
             (progn
               (gdb-restore-windows)
               ;; ensure (gdb) prompt at bottom of its window
               (recenter (window-body-height)))
           (switch-to-buffer-other-window gud-comint-buffer))))
    ;; start a new GUD session
    (spw/start-gud)))

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


;;;; Perl

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

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

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

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

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

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

(with-eval-after-load 'cperl-mode
  (define-key cperl-mode-map "\C-ciu" #'spw/perl-add-use)
  (define-key cperl-mode-map "\C-cc" #'spw/perltidy-block-or-buffer))

;;; init-spw.el ends here