;;; 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 an ;; '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/") ("NonGNU ELPA" . "https://elpa.nongnu.org/nongnu/") ("MELPA Stable" . "https://stable.melpa.org/packages/") ("MELPA" . "https://melpa.org/packages/")) package-archive-priorities '(("GNU ELPA" . 10) ("NonGNU 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)))) ;; Might be useful to bind C-c k in the transient map to ;; kill the current buffer and cycle one step. (define-key tmap [right] cycling-function) (set-transient-map tmap t on-exit) ;; showing a message here is wanted because experience has ;; shown that sometimes it can be hard to remember whether ;; or not the transient map remains active (message "Use / to cycle"))))) (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 () (if (string= (getenv "XDG_SESSION_TYPE") "wayland") (getenv "XDG_CURRENT_DESKTOP") (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)))) (defmacro spw/add-once-hook (hook function &optional depth local) "Add a hook which removes itself when called. For something which should happen just once." (let ((sym (cl-gensym))) `(progn (fset ',sym (lambda (&rest args) (remove-hook ,hook ',sym ,local) (apply ,function args))) (add-hook ,hook ',sym ,depth ,local)))) (defmacro spw/add-once-advice (where place function &optional props) "Add a piece of advice which removes itself when called. For something which should happen just once." (let ((sym (cl-gensym))) `(progn (fset ',sym (lambda (&rest args) (advice-remove ,place #',sym) (apply ,function args))) (advice-add ,place ,where #',sym ,props)))) ;;;; 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/store-frame-wm (frame) (set-frame-parameter frame 'spw/window-manager (with-selected-frame frame (spw/get-wm)))) (add-to-list 'after-make-frame-functions #'spw/store-frame-wm) (defun spw/disable-mouse-autoselect-window (orig-fun &rest args) (let ((mouse-autoselect-window nil)) (apply orig-fun args))) (defun spw/tiling-window-manager-setup (&rest _ignore) "Change settings for optimal usage if we have frames running under i3." (if (cl-find-if (lambda (e) (member e '("i3" "sway"))) (mapcar (lambda (f) (frame-parameter f 'spw/window-manager)) (frame-list))) (progn (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)) (setq mouse-autoselect-window nil focus-follows-mouse nil desktop-restore-forces-onscreen t) (advice-remove 'display-buffer #'spw/disable-mouse-autoselect-window))) (add-to-list 'after-make-frame-functions #'spw/tiling-window-manager-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) (setq use-short-answers t) (setq confirm-kill-emacs #'y-or-n-p) (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 pgtk))) (not (member (frame-parameter nil 'spw/window-manager) '("i3" "sway"))))) ;; 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 '("Inconsolata-13" "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)) (when (and (not (spw/use-tabs-not-frames)) (find-font (font-spec :name "Cousine-10")) (find-font (font-spec :name "Inconsolata-13"))) (add-to-list 'window-size-change-functions #'spw/maybe-change-frame-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)) (defun spw/maybe-change-frame-font (frame) (when (frame-size-changed-p frame) (let ((wanted-font ;; Between these pixel widths is roughly where we can get two ;; vertical windows in if we shrink our font a bit; if much larger, ;; we can get two without shrinking, and if much smaller, shrinking ;; will not help. Mainly used with my C-i - i3 binding (if (and (> (frame-pixel-width frame) 1300) (< (frame-pixel-width frame) 1485)) "Cousine-10" "Inconsolata-13"))) (unless (string= (frame-parameter frame 'font-parameter) wanted-font) (set-frame-font (font-spec :name wanted-font)))))) (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-i 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 ;; If this is set to t, then re-setting the mark right after popping to ;; it -- to go and edit somewhere near the destination and then come ;; back, say -- requires remembering that a C-u C-u prefix is needed; ;; that cognitive load outweighs a few extra C-u when this is nil, I ;; think. And the cost of forgetting is high: you've lost the position, ;; and it might take quite a few keypresses to get back there. ;; ;; Further, if you pop fewer than four times and then want to set a ;; mark, that requires no fewer keystrokes with this set to t than with ;; it set to nil. There is also `repeat' to repeatedly pop. set-mark-command-repeat-pop nil) (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)) (with-eval-after-load 'slime-presentations (spw/remap-mark-command 'slime-mark-presentation slime-editing-map)) (if (>= emacs-major-version 28) (setq copy-region-blink-delay 0) (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 the same as the defaults of the UNIX tty ;; line editor and GNU readline, respectively: C-w deletes back to ;; whitespace, 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) ;; Is a binding for `zap-up-to-char' needed in addition to one for ;; `zap-to-char'? If you don't need to insert any text before the target ;; char, then M-z CHAR CHAR is equivalent to using `zap-up-to-char' with CHAR, ;; and is easy to type. If you do need to insert, you can just M-z CHAR, type ;; or yank, and then type CHAR again to conclude. By contrast, replacing use ;; of `zap-to-char' with `zap-up-to-char' is not so easy, as you might need to ;; switch from typing M-z to typing C-d, for example. ;; ;; At the very least this demonstrates that `zap-to-char' more deserves to be ;; on an easy-to-strike key than does `zap-up-to-char'. So for now, make the ;; other command available on a less valuable key. ;; ;; Hmm, might be good to add `paredit-zap-to-char' which doesn't actually ;; delete some delimiters. (global-set-key "\M-Z" #'zap-up-to-char) ;; We cannot reliably distinguish from so I ;; want to avoid getting into a habit of typing into ;; Emacs. Many terminal emulators send ^? for and ^H for ;; these days, or the other way around, but not all of ;; them. Since Firefox binds 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 '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 rebinding 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)) ;; These SLIME windows don't benefit from a lot of height and it is ;; useful to have them be independent of the main two windows ;; displaying code, Magit etc. Get going by hitting C-c C-z to bring ;; up the REPL. ("\\*\\(slime\\|sly\\)-\\(inspector\\|compilation\\)\\*" display-buffer-in-side-window (window-height . 0.30) (slot . 2) (side . bottom)) ("^\\*\\(sldb\\|sly-db\\)" display-buffer-in-side-window (window-height . 0.30) (slot . 1) ;; might have nested debuggers replace the repl in slot 0 (side . bottom)) ;; Keep the repl visible even when we're in the debugger, as there ;; might be useful output there even though we can't evaluate anything ;; else (at least with Slime). ("^\\*\\(slime-repl\\|sly-mrepl\\|inferior-lisp\\)" (display-buffer-reuse-window display-buffer-in-side-window) (window-height . 0.30) (slot . 0) (side . bottom)))) (defun spw/window-toggle-side-windows () "Like `window-toggle-side-windows', but if the selected window is a side window, change focus to the most recently used non-side window first." (interactive) (when (window-parameter nil 'window-side) (select-window (spw/get-mru-window (lambda (w) (window-parameter w 'window-side))) 'mark-for-redisplay)) (window-toggle-side-windows)) ;; F9 is another option but it is nice to reserve that for short-lived ;; keyboard macros (global-set-key "\C-cs" #'spw/window-toggle-side-windows) (defun spw/delete-other-windows--toggle-side-windows (&optional window &rest _ignore) "Save any side window state before deleting other windows such that side windows can be recovered using `window-toggle-side-windows'. A limitation is that when `window-toggle-side-windows' is subsequently used the non-side windows deleted by `delete-other-windows' will also reappear." (when (window-parameter window 'window-side) (window-toggle-side-windows (window-frame window)))) (advice-add 'delete-other-windows :before #'spw/delete-other-windows--toggle-side-windows) (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) ;; C-x x g should not ask for confirmation, but avoid globally binding ;; `revert-buffer-query' (defun spw/revert-buffer () (interactive) (revert-buffer nil t)) (global-set-key "\C-xxg" #'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) ([remap other-window] . spw/back-and-forth-noselect) ([?\C-x right] . spw/other-window-noselect)) #'spw/other-window-noselect ;; select the destination window again with NOSELECT nil (select-window (selected-window))) ;; ... and resettle old occupants of C-x and C-x . 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 ;; 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 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 / 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) ;; update project-switch-commands accordingly (when (assoc 'project-eshell project-switch-commands) (setcar (assoc 'project-eshell project-switch-commands) #'spw/project-eshell-with-transient-cycling))) (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 ;; I believe this sometimes causes hangs when using pgtk under swaywm. ;; 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 pgtk w32 ns)) (add-to-list 'window-system-default-frame-alist `(,ws . ((background-color . "#FFFFF6"))))) ;; colour is from the Lucid build (set-face-attribute 'region nil :background "#EECD82") (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) (setq async-shell-command-buffer 'rename-buffer shell-command-prompt-show-cwd t) (when (executable-find "bash") (setq shell-file-name "bash") (setenv "BASH_ENV" (expand-file-name "~/.bash_defns"))) (setq native-comp-async-report-warnings-errors 'silent) (setq inferior-lisp-program "sbcl") (unless (boundp 'warning-suppress-types) (setq warning-suppress-types nil)) (cl-pushnew '(comp) warning-suppress-types :test #'cl-tree-equal) ;;;; 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 when the region is active ;; I used to have `electric-pair-mode' switched on, based on the idea that it ;; makes non-paredit buffers a bit more like paredit buffers, and that's the ;; least surprising way to have things, given that I'm not going to give up ;; paredit. However, even with `electric-pair-conservative-inhibit', I still ;; frequently found myself with unwanted insertion. It also makes C-w much ;; less effective for correcting mistakes, because you end up with junk to the ;; right of point as well as to the left. ;; ;; Add back a way to wrap the active region in paired delimiters; useful after ;; hitting M-@ and/or C-M-SPC a few times. This is the main paredit feature ;; that I find myself expecting to work in other modes. ;; ;; An alternative is to deactivate `electric-pair-mode' only in `text-mode'. (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 '((?` . ?'))) ;; add global pairs to Org-mode because it has its own self-inserting cmd (spw/add-mode-wrapping-pairs 'org 'org-mode `(,@spw/global-wrapping-pairs (?* . ?*) (?/ . ?/) (?= . ?=))) (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 , `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. Also, when typing a path to a remote file on a host ;; we're not connected to use, this can be used to cause TRAMP to open a ;; connection and thereby get filename completion going, though it is ;; smoother to start by using C-x d to connect to the host and only then ;; using C-x C-f. ;; ;; M-j is a better key to rebind than C-j because in C-M-j is bound to the ;; same thing as M-j in the default global map (define-key icomplete-fido-mode-map [?\M-j] #'icomplete-force-complete) ;; Preserve some standard bindings for editing text in the minibuffer. 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 "$_")) (defun spw/shell-pipeline (pipeline) (throw 'eshell-replace-command (eshell-parse-command shell-file-name (list shell-command-switch pipeline)))) (defun spw/parse-shell-pipeline (original) "Extract Eshell-specific redirects from pipeline. Does not handle quoting." (with-temp-buffer (cl-loop initially (insert original) (goto-char (point-min)) with pipeline with redirects ;; search forward to something which looks like a redirect while (search-forward-regexp "[0-9]?>+&?[0-9]?\\s-*\\S-" nil t) for beg = (match-beginning 0) do (forward-char -1) ; start from beginning of the redirect target (when-let ((end (cond ;; this is a redirect to a process or buffer ((looking-at "#<") (forward-char 1) (1+ (eshell-find-delimiter ?\< ?\>))) ;; this is a redirect to a virtual target ((and (looking-at "/\\S-+") (assoc (match-string 0) eshell-virtual-targets)) (match-end 0))))) ;; we found an Eshell-specific redirect; extract it (push (buffer-substring-no-properties beg end) redirects) (delete-region beg end) (just-one-space)) finally return (cons (string-trim (buffer-string)) (and redirects (string-join redirects " ")))))) (defun spw/shell-pipeline (pipeline) (throw 'eshell-replace-command (eshell-parse-command shell-file-name (list shell-command-switch pipeline)))) ;; would be good to replace lines from (setq end (point-marker)) onwards with ;; some Eshell defcustom which has the effect of making all expansions ;; performed by `eshell-expand-input-functions' not visible to the user -- ;; i.e. the unexpanded input goes into the history ring and remains visible in ;; the buffer, but the expanded input goes into the Eshell parser (defun spw/expand-to-shell-pipeline (beg end) "When Eshell input begins with '!!', pass it to the OS shell. This bypasses Eshell's own pipelining. Useful for pipelines which will move a lot of data, for which Eshell's pipelining support can be too slow. Also useful for pipelines to be run on remote hosts, to avoid having to roundtrip all the data." (save-excursion (goto-char beg) (when (looking-at "!!\s*") (let ((beg (copy-marker beg)) (end (copy-marker end)) (original (buffer-substring beg end)) (unexpander (gensym)) (old-input-filter eshell-input-filter)) (cl-destructuring-bind (pipeline . redirects) (spw/parse-shell-pipeline (buffer-substring-no-properties (match-end 0) end)) (delete-region beg end) (insert "spw/shell-pipeline ") (prin1 pipeline (current-buffer)) (when redirects (insert " " redirects)) (setq end (point-marker)) (fset unexpander (lambda () (remove-hook 'eshell-post-command-hook unexpander t) (setq eshell-input-filter old-input-filter) (save-excursion (goto-char beg) (delete-region beg end) (insert original)) (eshell-add-input-to-history original))) (add-hook 'eshell-post-command-hook unexpander t t) (setq eshell-input-filter #'ignore)))))) ;; (add-to-list 'eshell-expand-input-functions #'spw/expand-to-shell-pipeline) ;; seems `eshell-mode-map' is globally nil (defun spw/define-eshell-keys () (define-key eshell-mode-map "\M-." #'spw/insert-last-argument)) (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) "/"))) ;;; getting to Eshell buffers (defun spw/eshell-jump (arg &optional chdir) "Pop to *eshell*, and offer cycling among other Eshells, unless one of the following special circumstances applies: - If a command is running in *eshell*, rename that buffer out of the way and start a new one. - If CHDIR, and there is no Eshell in `default-directory', also change the directory of *eshell* to `default-directory'. - If CHDIR and there is an Eshell in `default-directory', including one generated by `project-eshell', switch to that Eshell instead of *eshell*. - If both ARG and CHDIR, or if CHDIR and the current buffer is an Eshell buffer which is not running a command, unconditionally start a new Eshell in `default-directory'. - If not CHDIR and the current buffer is *eshell*, activate transient cycling to make it easy to get back to another Eshell. (This is the only case in which we do not use `pop-to-buffer' or equivalent, so C-x 4 4 must be used to cycle in another window.) For the purpose of cycling, Eshells generated by `project-eshell' are sorted below Eshells generated by this function. The ideas behind this behaviour are as follows. - Just like Lisp REPLs, we do not normally need a lot of different Eshells; it is fine for shell history associated with different tasks to become mixed together. But we do need to start a new Eshell when other Eshells are already busy running commands. - Rename *eshell* to *eshell*, but don't ever rename *eshell* back to *eshell*, because that is a conventional workflow -- M-&, C-h i, M-x ielm, M-x compile etc. always take you to the unnumbered buffer, possibly renaming the numbered one out of the way. This is why we don't try to reuse Eshells especially aggressively; for example, we could find an *eshell* not running a command a rename it to *eshell*, but we don't. - Don't pay attention to the current project, as an old version of this code did, because if we're using C-c e e and/or C-c e h rather than C-x p e, we are probably working in a project-agnostic way. Thus, among the `project-eshell' Eshells available to cycle through, don't prioritise those of the current project (for example by moving them to the front) -- if we explicitly want those, can use C-x p e. - Treat C-x p e as the primary way to get to Eshells in project roots, and avoid changing the directories of those Eshells, as it is surprising when C-x p e doesn't take us to an Eshell which is ready to run commands in the project root (another possibility would be to change the dir back to the project root in this case). - It is assumed we'll sometimes use C-x 4 1 in front of this command, and if we're already in Eshell, we might use C-x 4 4 to start the cycling in another window." (interactive "P") (require 'eshell) (cl-flet ((project-eshell-eshell-p () (string-match "\\`\\*.+-eshell\\*[><0-9]*\\'" (buffer-name))) (fresh-eshell () (when-let ((buffer (get-buffer eshell-buffer-name))) (with-current-buffer buffer (rename-uniquely))) (let ((default-directory (if chdir default-directory (expand-file-name "~")))) (eshell)))) (let ((current-eshell (and (eq major-mode 'eshell-mode) (not (project-eshell-eshell-p)) (not (get-buffer-process (current-buffer))) (current-buffer))) (initial-default-directory default-directory) default-directory-eshell project-eshells other-eshells) ;; Populate our two lists of all Eshells. (dolist (buffer (buffer-list)) (with-current-buffer buffer (when (eq major-mode 'eshell-mode) (if (and chdir (not default-directory-eshell) (string= default-directory initial-default-directory) (not (get-buffer-process buffer))) (setq default-directory-eshell buffer) (push buffer (if (project-eshell-eshell-p) project-eshells other-eshells)))))) ;; Now `pop-to-buffer' if we're going to do that. (cond ((and chdir (or arg current-eshell)) (fresh-eshell)) ((and chdir default-directory-eshell) (pop-to-buffer default-directory-eshell)) ((or chdir (not (string= (buffer-name) eshell-buffer-name))) (if-let ((buffer (get-buffer eshell-buffer-name))) (if (get-buffer-process buffer) (fresh-eshell) (pop-to-buffer buffer) (goto-char (point-max)) (when chdir (eshell-interrupt-process) ; to clear input (insert "cd" " " ?\" initial-default-directory ?\") (eshell-send-input))) (fresh-eshell))) ;; If `display-buffer-overriding-action' has some entries, pop to ;; ourselves, to allow subsequent cycling to a different Eshell in ;; another window. E.g. C-x e e C-x 4 4 C-x e e ((cl-find-if-not #'null display-buffer-overriding-action) (pop-to-buffer (current-buffer)))) ;; Finally, generate and return a ring for cycling purposes. (let* ((all (delete (current-buffer) (nconc project-eshells other-eshells))) (ring (make-ring (1+ (length all))))) (dolist (buffer all) (ring-insert ring buffer)) (ring-insert ring (current-buffer)) ring)))) (defun spw/eshell-jump-from-here (arg) (interactive "P") (spw/eshell-jump arg t)) (spw/bind-command-with-ret-val-cycling (("\C-cee" . spw/eshell-jump) ("\C-ceh" . spw/eshell-jump-from-here)) (spw/buffer-ring-cycle-lambda 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/kill-this-buffer () (interactive) (kill-buffer (current-buffer))) (global-set-key "\C-ck" #'spw/kill-this-buffer) (defun spw/vc-delete-this-file () (interactive) (spw/delete-file-and-buffer t)) (global-set-key "\C-cD" #'spw/delete-file-and-buffer) (global-set-key "\C-cvD" #'spw/vc-delete-this-file) (defun spw/link-stat-block (start end) (interactive "r") (when-let ((region-text (buffer-substring start end))) (org-insert-link nil (concat "file:~/annex/gaming/5eblocks/" region-text ".png") region-text))) ;; Possibly this should be replaced with something like `project-find-regexp' ;; ;; Input e.g.: lisp "Emacs configuration" (defun spw/git-grep-docs (words) (interactive "sSearch for words/quoted phrases in text docs: ") (vc-git-grep (concat "git --no-pager grep -n --color -iw " (mapconcat (lambda (word) (concat "-e " (shell-quote-argument word))) (split-string-and-unquote words) " ") " -- \"*.org\" \"*.tex\" \"*.md\" :!org/archive") nil (expand-file-name "~/doc"))) (global-set-key "\C-cog" #'spw/git-grep-docs) ;; 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))) (project-remember-project project))) (call-interactively 'project-switch-project)) (global-set-key "\C-cp" #'spw/register-programming-projects-and-switch) (defun spw/src-dirs-not-projects () "Return dirs under ~/src which contain repos but are not themselves repos." (let ((projects (make-hash-table :test 'equal))) (dolist (project (spw/all-programming-projects)) (puthash project t projects)) (cl-labels ((dirs-below (dir) (let ((contents (cl-delete-if-not (lambda (f) (and (file-directory-p f) (not (gethash f projects)))) (directory-files dir t "[^.]")))) (nconc contents (mapcan #'dirs-below contents))))) (dirs-below (expand-file-name "~/src"))))) ;; would be useful to have `mr -fd foo co' support (defun spw/clone-repo (command destination source) (interactive (list (completing-read "Method: " '("git clone" "dgit clone" "debcheckout") nil t) (expand-file-name (completing-read "Destination: " (nconc (mapcar #'abbreviate-file-name (spw/src-dirs-not-projects)) '("~/tmp" "~/src")) nil t)) (read-from-minibuffer "What to clone: "))) (let ((default-directory destination) (buffer (get-buffer-create "*Repository Clone Output*"))) (with-current-buffer buffer (erase-buffer)) (message "Cloning...") (if (eq 0 (call-process-shell-command (concat command " " source) nil buffer)) (let ((repo-dir (concat (file-name-as-directory destination) (let ((right-chopped (if (string-match "\\(\\.git\\)?/?\\'" source) (substring source 0 (match-beginning 0)) source))) (if (string-match "[/:][^/:]*\\'" right-chopped) (substring right-chopped (1+ (match-beginning 0))) right-chopped))))) (call-process "src-register-all") (bury-buffer buffer) (dired (if (file-directory-p repo-dir) repo-dir destination))) (display-buffer buffer)))) (global-set-key "\C-cvc" #'spw/clone-repo) ;; author unknown (defun spw/toggle-frame-split () "Toggle the orientation of a two-window split. Useful after resizing the frame." (interactive) (when (= (count-windows) 2) (let* ((this-win-buffer (window-buffer)) (next-win-buffer (window-buffer (next-window))) (this-win-edges (window-edges (selected-window))) (next-win-edges (window-edges (next-window))) (this-win-2nd (not (and (<= (car this-win-edges) (car next-win-edges)) (<= (cadr this-win-edges) (cadr next-win-edges))))) (splitter (if (= (car this-win-edges) (car (window-edges (next-window)))) 'split-window-horizontally 'split-window-vertically))) (delete-other-windows) (let ((first-win (selected-window))) (funcall splitter) (when this-win-2nd (other-window 1)) (set-window-buffer (selected-window) this-win-buffer) (set-window-buffer (next-window) next-win-buffer) (select-window first-win) (when this-win-2nd (other-window 1)))))) (global-set-key "\C-cft" #'spw/toggle-frame-split) ;; orig http://blog.gleitzman.com/post/35416335505/hunting-for-unicode-in-emacs (defun spw/unicode-hunt () "Destroy some special Unicode characters like smart quotes." (interactive) (let ((unicode-map '(("[\u2018\|\u2019\|\u201A\|\uFFFD]" . "'") ("[\u201c\|\u201d\|\u201e]" . "\"") ("[\u2013\|\u2014]" . "-") ("\u2026" . "...") ("\u00A9" . "(c)") ("\u00AE" . "(r)") ("\u2122" . "TM") ("[\u02DC\|\u00A0]" . " ")))) (save-excursion (cl-loop for (key . value) in unicode-map do (goto-char (point-min)) (while (re-search-forward key nil t) (replace-match value)))))) (defun spw/dotfiles-rebase () "Rebase & push dotfiles." (interactive) (let ((default-directory (expand-file-name "~/src/dotfiles/")) (buffer (get-buffer-create "*dotfiles rebase*"))) (display-buffer buffer) (async-shell-command "git-dotfiles-rebase" "*dotfiles rebase*"))) (global-set-key "\C-cgd" #'spw/dotfiles-rebase) (defun spw/mrs (&rest ignore) (interactive) (let ((buffer (get-buffer-create "*mrs*"))) (with-current-buffer buffer (erase-buffer) (term-mode) (setq-local revert-buffer-function #'spw/mrs default-directory (expand-file-name "~")) (term-exec buffer "*mrs*" "sh" nil '("-c" "src-register-all && mr -s status"))) (when-let ((proc (get-buffer-process buffer)) (window (display-buffer buffer))) (set-process-sentinel proc (lambda (&rest ignore) (with-selected-window window (goto-char (point-min)))))))) (global-set-key "\C-cgr" #'spw/mrs) (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 ") (message-goto-subject) (insert package ": " subject) (message-goto-body) (insert type ": " package "\n" "Version: " version "\n"))) ;; this one doesn't need a binding as it doesn't come up enough (defun spw/notmuch-decrypt-inline () (interactive) (call-interactively #'mark-whole-buffer) (call-interactively #'epa-decrypt-armor-in-region)) ;; if we're going to be using multiple frames, make `frame-title-format' not ;; depend on whether there are multiple frames right now (add-function :after after-focus-change-function #'spw/set-frame-title-format) (defun spw/set-frame-title-format () (unless (spw/use-tabs-not-frames) (remove-function after-focus-change-function #'spw/set-frame-title-format) (setq frame-title-format "%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) ;; now on C-x x n ;; In this case, by contrast, we're saying that we want two versions of the ;; buffer specifically because (i) we don't want the buffer contents to be ;; overwritten by, e.g., calling `compile' again or navigating to a different ;; web page; and/or (ii) we want to be reminded to come back to (a particular ;; point in) the buffer by giving it its own frame or tab, in a way that's ;; lightweight and doesn't involve adding TODO entries (global-set-key "\C-cfs" #'spw/save-buffer-for-later) (global-set-key "\C-cns" #'spw/save-buffer-for-later) ;; Finally, this is for when we just want to protect the buffer contents from ;; being overwritten and nothing more ;; (global-set-key "\C-cnr" #'rename-uniquely) ;; now on C-x x u ;; version of `kill-buffer-and-window' which can handle a frame with only a ;; single window (defun spw/kill-buffer-and-window () (interactive) (if (one-window-p) (when (kill-buffer) (if (> (length (funcall tab-bar-tabs-function)) 1) (tab-close) (delete-frame))) (kill-buffer-and-window))) (global-set-key [remap kill-buffer-and-window] #'spw/kill-buffer-and-window) (defun spw/get-mru-window (&optional exclude) "Like `get-mru-window' but also consider the minibuffer, and don't consider windows satisfying the predicate EXCLUDE." (let (best-window best-time time) (dolist (window (window-list-1) best-window) (setq time (window-use-time window)) (when (and (not (and exclude (funcall exclude window))) (not (eq window (selected-window))) (or (not best-time) (> time best-time))) (setq best-time time) (setq best-window window))))) (defun spw/back-and-forth-noselect (arg) (interactive "P") (if arg ;; if there's a prefix arg then just `other-window', so that's still ;; available on M-1 C-x o (call-interactively #'other-window) (select-window (spw/get-mru-window) 'mark-for-redisplay))) (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")))) ;; unimplemented: update values in any Lisp image we may have (defun spw/propagate-new-environment () "After ~/src/dotfiles/bin/update-emacs-daemon-environment has updated our environment variables, propagate to subenvironments. Called by that script using emacsclient(1)." (dolist (var '("DISPLAY" "WAYLAND_DISPLAY" "SSH_ASKPASS" "SSH_AUTH_SOCK" "SSH_AGENT_PID" "SSH_CONNECTION" "WINDOWID" "XAUTHORITY" "XDG_SESSION_TYPE" "XDG_CURRENT_SESSION" "I3SOCK" "SWAYSOCK")) (when-let ((new-value (getenv var))) (dolist (buffer (buffer-list)) ;; 1. Eshells (with-current-buffer buffer (when (eq major-mode 'eshell-mode) (setenv var new-value))))))) ;; open a frame on a new workspace with only the relevant dired buffer open, ;; eval this form: (global-set-key "\C-cG" #'spw/grading-advance) ;; and then use C-c G to open the first item (will need C-c f t after just ;; this first one, and also maybe C-i =) (defun spw/grading-advance () (interactive) (unless (eq major-mode 'dired-mode) (save-buffer) (other-window 1)) (dired-display-file) (dired-next-line 1) (let ((pdf (dired-get-filename))) (dired-next-line 1) (other-window 1) (goto-char (point-min)) ;; assignment-specific (search-forward "Grammar") (org-cycle) ;; (overwrite-mode 1) (start-process "pdf" "pdf" "xdg-open" pdf) (sleep-for 0.5) (call-process-shell-command (concat (if (executable-find "i3-msg") "i3-msg" "swaymsg") "move right")) (let ((pdf-words (substring (with-temp-buffer (call-process-shell-command (concat "pdftotext " (shell-quote-argument pdf) " - | wc -w") nil (current-buffer)) (buffer-string)) 0 -1))) (message (concat pdf-words " words"))))) (defun spw/untabify-project () (interactive) (save-window-excursion (dolist (file (project-files (project-current nil (project-prompt-project-dir)))) (find-file file) (untabify (point-min) (point-max))))) (defun spw/go-to-consfig () (interactive) ;; (let ((repo (expand-file-name "~/src/cl/consfig"))) ;; (unless (file-directory-p repo) ;; (user-error "Consfig git repo not found")) ;; (dired repo)) (cl-flet ((load () (slime-load-system "com.silentflame.consfig") (spw/add-once-hook 'slime-compilation-finished-hook (lambda (notes) ;; see `slime-maybe-show-compilation-log' (unless (memq 'slime-maybe-show-compilation-log slime-compilation-finished-hook) (slime-create-compilation-log notes)) (when (slime-compilation-result.successp slime-last-compilation-result) (slime-repl-set-package "COM.SILENTFLAME.CONSFIG")))))) (if (and (fboundp 'slime-output-buffer) (slime-output-buffer)) (progn (slime-switch-to-output-buffer) (load)) (slime) (spw/add-once-hook 'slime-connected-hook #'load)))) (global-set-key "\C-cgc" #'spw/go-to-consfig) ;;;; 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 ready to send")) (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 ")) ("UA" ("From" . "Sean Whitton "))) 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) ;; 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))) ;; eww bookmarks don't have short names associated to them, just page titles, ;; so for places we visit a lot the normal bookmarks system seems more ;; appropriate. adapted from bookmark-w3m.el. (defun spw/bookmark-eww-bookmark-make-record () "Make an Emacs bookmark entry for an Eww buffer." `(,(plist-get eww-data :title) ,@(bookmark-make-record-default 'no-file) (url . ,(eww-current-url)) (handler . spw/bookmark-eww-bookmark-jump) (defaults . (,(plist-get eww-data :title))))) (defun spw/bookmark-eww-bookmark-jump (bookmark) (eww (bookmark-prop-get bookmark 'url)) (bookmark-default-handler `("" (buffer . ,(current-buffer)) . ,(bookmark-get-bookmark-record bookmark)))) (add-hook 'eww-mode-hook (lambda () (setq-local bookmark-make-record-function #'spw/bookmark-eww-bookmark-make-record))) ;;;; 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 'sly-mrepl (add-to-list 'sly-mrepl-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 ;; these two settings are now in ~/.emacs.d/transient/values.el for newer ;; magit; keep them here for when using older magit. ;; 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) (if (version< "3.0.0" (magit-version)) (require 'magit-extras) (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 '(spw/project-magit "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) (global-set-key "\C-cgP" #'redtick-mode) (setq redtick-history-file nil)) (spw/when-library-available notmuch ;; Loading notmuch will load notmuch-config.el where this function is ;; defined. (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 have appropriate bindings in `notmuch-hello-mode' such that the ;; following complete sequences would still call their associated commands (global-set-key "\C-cms" #'notmuch-search) (global-set-key "\C-cmj" #'notmuch-jump-search) (global-set-key "\C-cmm" #'notmuch-hello) (global-set-key [?\C-c ?m f9] #'spw/next-unread-group)) (with-eval-after-load 'org-d20 (setq org-d20-dice-sound "~/annex/media/sounds/147531__ziembee__diceland.wav" org-d20-display-rolls-buffer t ;; the roll20 tokens I'm using for NPCs are lettered org-d20-letter-monsters t ;; ... and they come in only two colours, so let's just have ;; one monster per letter org-d20-continue-monster-numbering t) (define-key org-d20-mode-map [f5] #'org-d20-initiative-dwim) (define-key org-d20-mode-map [f6] #'org-d20-damage) (define-key org-d20-mode-map [f7] (lambda (arg) (interactive "P") (call-interactively (if arg #'org-d20-roll-last #'org-d20-roll)))) (define-key org-d20-mode-map [f8] #'org-d20-roll-at-point) (define-key org-d20-mode-map [f9] (lambda (arg) (interactive "P") (call-interactively (if arg #'org-d20-d% #'org-d20-d20))))) (spw/when-library-available nov (add-to-list 'auto-mode-alist '("\\.epub\\'" . nov-mode)) (setq 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 (dolist (fn '(org-roam-setup org-roam-dailies-goto-previous-note org-roam-dailies-goto-today org-roam-dailies-goto-next-note)) (autoload fn "org-roam")) (setq org-roam-v2-ack t org-roam-directory (expand-file-name "~/doc/notes") org-roam-dailies-directory "days/") (global-set-key "\C-cof" #'org-roam-node-find) ;; An alternative would be to bind C-c o / to ;; org-roam-dailies-goto-yesterday and -tomorrow, but that would mean the ;; keys have different meanings in and out of Org-mode buffers. (spw/bind-command-with-ret-val-cycling (([?\C-c ?o left] . org-roam-dailies-goto-previous-note) ("\C-cod" . org-roam-dailies-goto-today) ([?\C-c ?o right] . org-roam-dailies-goto-next-note)) #'org-roam-dailies-find-next-note) ;; don't bother starting it up until we open something in Org-mode (with-eval-after-load 'org (org-roam-db-autosync-enable))) (with-eval-after-load 'org-roam (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" "ods" "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) ;; disable openwith-mode when certain functions are running (defun spw/without-openwith (orig-fun &rest args) (let ((active openwith-mode)) (prog2 (when active (openwith-mode 0)) (apply orig-fun args) (when active (openwith-mode 1))))) (with-eval-after-load 'org (advice-add 'org-open-file :around #'spw/without-openwith)) (with-eval-after-load 'ox-odt (advice-add 'org-odt-export-to-odt :around #'spw/without-openwith))) (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 (cl-pushnew '(yasnippet backquote-change) warning-suppress-types :test #'cl-tree-equal)) ;; company is used by notmuch for address completion; otherwise unused (with-eval-after-load 'company (setq company-idle-delay nil company-echo-delay 0) ;; prefer my global C-w binding (define-key company-active-map "\C-w" nil) ;; resettle (define-key company-active-map "\M-o" #'company-show-location)) (spw/when-library-available rainbow-mode (dolist (hook '(html-mode-hook css-mode-hook)) (add-hook hook 'rainbow-mode))) (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))) (spw/when-library-available bongo (setq bongo-default-directory (expand-file-name "~/annex/music/") bongo-prefer-library-buffers nil bongo-insert-whole-directory-trees t) ;; at first launch, ensure a buffer with `bongo-dired-library-mode' exists, ;; so 'h' takes us there, rather than to a library buffer (defun spw/make-bongo-dired () (dired bongo-default-directory)) (advice-add 'bongo-default-playlist-buffer :before #'spw/make-bongo-dired) ;; follow with 'h' to get to dired browse (global-set-key "\C-cM" #'bongo-playlist) ;; apparently bongo-dired-library-mode can interfere with wdired, so toggle (defun spw/maybe-activate-or-deactivate-bongo-dired-library-mode () (if (eq major-mode 'wdired-mode) (bongo-dired-library-mode 0) (when (string-match-p (concat "\\`" bongo-default-directory) (expand-file-name default-directory)) (bongo-dired-library-mode 1)))) (add-hook 'dired-mode-hook #'spw/maybe-activate-or-deactivate-bongo-dired-library-mode) (advice-add 'wdired-change-to-wdired-mode :after #'spw/maybe-activate-or-deactivate-bongo-dired-library-mode) (advice-add 'wdired-change-to-dired-mode :after #'spw/maybe-activate-or-deactivate-bongo-dired-library-mode)) (spw/when-library-available volume ;; 'v' again to exit (global-set-key "\C-cgv" #'volume)) (with-eval-after-load 'elpher ;; see #981148 (defun spw/disable-gnutls-verify (&rest ignore) (setq-local gnutls-verify-error nil)) (advice-add 'elpher-get-host-response :before #'spw/disable-gnutls-verify) ;; standard Emacs conventions (define-key elpher-mode-map "l" #'elpher-back) (define-key elpher-mode-map "d" #'elpher-back-to-start) (define-key elpher-mode-map "<" #'elpher-root-dir) (add-hook 'elpher-mode-hook (lambda () (variable-pitch-mode 1)))) (spw/when-library-available consfigurator (with-eval-after-load 'cl-indent (activate-consfigurator-indentation-hints) ;; These are for definitions from my consfig. (put 'spwcrontab 'common-lisp-indent-function '1) (put 'kvm-boots-trusted-chroot. 'common-lisp-indent-function '1))) ;;;; 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)) (let ((tb (expand-file-name "~/annex/media/HyperSpec-7-0.tar.gz")) (hd (expand-file-name "~/local/clhs/HyperSpec/"))) (when (and (file-exists-p tb) (not (file-directory-p hd))) (make-directory (expand-file-name "~/local/clhs/" t)) (let ((default-directory "~/local/clhs/")) (call-process-shell-command (concat "tar xfz " tb)))) (when (file-directory-p hd) (setq common-lisp-hyperspec-root (concat "file://" hd)) (add-to-list 'browse-url-handlers '("/local/clhs/HyperSpec/" . eww)))) (global-set-key "\C-cgh" #'hyperspec-lookup) (with-eval-after-load 'slime (defvar spw/last-command-was-slime-async-eval nil) (defvar spw/last-slime-async-eval-command-frame nil) (defun spw/record-last-command-was-slime-async-eval (&rest ignore) (spw/add-once-hook 'pre-command-hook (lambda () (setq spw/last-command-was-slime-async-eval nil))) (setq spw/last-command-was-slime-async-eval t spw/last-slime-async-eval-command-frame (selected-frame))) (dolist (f '(slime-repl-return slime-mrepl-return slime-compile-region slime-compile-file sldb-eval-in-frame sldb-invoke-restart-0 sldb-invoke-restart-1 sldb-invoke-restart-2 sldb-invoke-restart-3 sldb-invoke-restart-4 sldb-invoke-restart-5 sldb-invoke-restart-6 sldb-invoke-restart-7 sldb-invoke-restart-8 sldb-invoke-restart-9 slime-interactive-eval slime-interrupt)) (advice-add f :after #'spw/record-last-command-was-slime-async-eval)) ;; Here we assume that (spw/use-tabs-not-frames) yields nil. (defun spw/sldb-setup-avoid-focus-grab (orig-fun &rest args) "Don't allow the Slime debugger to grab keyboard focus unless we are sure that the user is expecting that it might pop up." (if spw/last-command-was-slime-async-eval (apply orig-fun args) (save-selected-window (if (frame-live-p spw/last-slime-async-eval-command-frame) (with-selected-frame spw/last-slime-async-eval-command-frame (apply orig-fun args)) (apply orig-fun args)))) (setq spw/last-slime-async-eval-command-frame nil)) (advice-add 'sldb-setup :around #'spw/sldb-setup-avoid-focus-grab)) (with-eval-after-load 'slime-repl (defun spw/slime-clear-source-registry () (interactive) (slime-repl-shortcut-eval-async '(asdf:clear-source-registry) #'message)) (defslime-repl-shortcut nil ("clear-source-registry") (:handler #'spw/slime-clear-source-registry))) (with-eval-after-load 'sly ;; restore SLIME's a/q debugger keys (define-key sly-db-mode-map "q" #'sly-db-quit) (define-key sly-db-mode-map "Q" nil) ;; have C-c C-z obey `display-buffer-alist' ;; https://github.com/joaotavora/sly/issues/428 (defun spw/sly-mrepl () (interactive) (sly-mrepl #'pop-to-buffer)) (define-key sly-mode-map "\C-c\C-z" #'spw/sly-mrepl) (defun spw/sly-db-show-first-line () (unless (pos-visible-in-window-p (point-min)) (goto-char (point-min)))) (add-hook 'sly-db-hook #'spw/sly-db-show-first-line) ;; C-r should always search buffer text ;; (define-key sly-mrepl-mode-map "\M-r" #'comint-history-isearch-backward) (defun spw/reset-comint-history-isearch () (setq-local comint-history-isearch nil)) (add-hook 'sly-mrepl-hook #'spw/reset-comint-history-isearch)) ;;;; 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 tab or frame for serious source editing, ;; from which `compile' or `project-compile' is called, and one Emacs tab or ;; frame for GUD (defun spw/run-or-restore-gud (arg) (interactive "p") (if (and (boundp 'gud-comint-buffer) (get-buffer-process gud-comint-buffer)) (cl-case arg (4 ;; restart the GUD session, either to debug something else, ;; or because we can't seem to set breakpoints anymore (spw/quit-gud) (spw/start-gud)) (16 ;; quit the GUD session (spw/quit-gud)) (t ;; restore the GUD session's window(s) (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 'gdbmi) (progn (gdb-restore-windows) ;; ensure (gdb) prompt at bottom of its window (recenter (window-body-height))) (switch-to-buffer-other-window gud-comint-buffer)))) ;; start a new GUD session (spw/start-gud))) (global-set-key "\C-cd" #'spw/run-or-restore-gud) ;;;; Perl ;; using `cperl-mode' instead of `perl-mode' because the former doesn't try to ;; indent lines within a POD, and because syntax highlighting of whether a ;; scalar is from a hash or array is useful. but, unsure whether I really ;; benefit from cperl's electric features; might try to turn those off (add-to-list 'auto-mode-alist '("\\.\\([pP][Llm]\\|al\\)\\'" . cperl-mode)) (add-to-list 'interpreter-mode-alist '("\\(mini\\)?perl5?" . cperl-mode)) ;; not sure these are consistent with my ~/.perltidyrc; if not, should try to ;; fix that (setq cperl-electric-parens t cperl-indent-level 4 cperl-indent-wrt-brace t cperl-lineup-step 1 ;; advantage of following two lines is that we are not ;; penalised for choosing long and descriptive subroutine names cperl-indent-parens-as-block t cperl-close-paren-offset -4) (defun spw/perl-add-use (module) (interactive "suse ") (let ((line (concat "use " module (and (not (string-match ";$" module)) ";")))) (save-excursion (goto-char (point-min)) (while (re-search-forward "^use " nil t)) (forward-line 1) (open-line 1) (insert line) (message (concat "Inserted: " line))))) (defun spw/perltidy-region (begin end) (interactive "r") (let ((perltidy-env (getenv "PERLTIDY"))) (setenv "PERLTIDY" (or (concat (expand-file-name (locate-dominating-file (buffer-file-name) ".perltidyrc")) ".perltidyrc") perltidy-env)) (shell-command-on-region begin end "perltidy -q" nil t) (font-lock-ensure) (setenv "PERLTIDY" perltidy-env))) ;; an older version of this would use the region if it's active, but that ;; rarely produces good results -- perltidy would get the indentation wrong (defun spw/perltidy-block-or-buffer (&optional arg) "Run perltidy on the current block or the whole buffer." (interactive "P") (if arg (spw/perltidy-region (point-min) (point-max)) (save-excursion ;; move to start of current top level block, and tidy that ;; (it will probably be the current subroutine). Although ;; `backward-up-list' docstring says that point can end up ;; anywhere if there's an error, and this code will always ;; produce an error when it tries to call `backward-up-list' ;; when it's already at the top level, in fact ;; `backward-up-list' does not seem to move point once we ;; are at the top level ;; ;; note that we can't use `beginning-of-defun' as not every top ;; level perl block is a defun to Emacs (cl-loop for count upfrom 1 for start = (point) do (ignore-errors (backward-up-list)) until (= start (point)) finally (if (= count 1) ;; we didn't move; do whole buffer (spw/perltidy-region (point-min) (point-max)) ;; tidy the top level block (let ((begin (line-beginning-position))) (forward-sexp) (forward-line) (spw/perltidy-region begin (point)))))))) (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