diff options
| -rw-r--r-- | emacs.el | 1913 |
1 files changed, 0 insertions, 1913 deletions
| diff --git a/emacs.el b/emacs.el deleted file mode 100644 index a609f61..0000000 --- a/emacs.el +++ /dev/null | |||
| @@ -1,1913 +0,0 @@ | |||
| 1 | ;;; ~/.emacs -*- mode: emacs-lisp; lexical-binding: t; -*- | ||
| 2 | ;; by Case Duckworth <acdw@acdw.net> | ||
| 3 | ;; License: GPLv3 | ||
| 4 | |||
| 5 | (setopt custom-file (locate-user-emacs-file "custom.el")) | ||
| 6 | (load custom-file :noerror) | ||
| 7 | |||
| 8 | (add-hook 'after-init-hook | ||
| 9 | (lambda () (load (locate-user-emacs-file "private") :noerror))) | ||
| 10 | |||
| 11 | (require 'package) | ||
| 12 | (add-to-list 'package-archives '("melpa" . "https://melpa.org/packages/") t) | ||
| 13 | (package-initialize) | ||
| 14 | |||
| 15 | (defun package-ensure (pkg &optional local require) | ||
| 16 | "Ensure PKG is installed. | ||
| 17 | PKG can be a symbol, a string, or a list. A symbol will be | ||
| 18 | installed using `package-install' from `package-archives'. A | ||
| 19 | string will use `package-vc-install', which see. If given a | ||
| 20 | list, it will be interpreted as a full set of arguments to one of | ||
| 21 | the above functions, depending on the type of its car. | ||
| 22 | |||
| 23 | If LOCAL is t, add ~/src/PKG.el to `load-path' and generate | ||
| 24 | autoloads. If LOCAL is a string, Add that directory to | ||
| 25 | `load-path'. | ||
| 26 | |||
| 27 | If REQUIRE is non-nil, require the package after installing it." | ||
| 28 | (setq pkg (ensure-list pkg)) | ||
| 29 | |||
| 30 | (cond | ||
| 31 | (local | ||
| 32 | (unless (stringp local) | ||
| 33 | (setq local (expand-file-name | ||
| 34 | (format "~/src/%s.el" (car pkg))))) | ||
| 35 | (unless (file-directory-p local) | ||
| 36 | (user-error "Package directory does not exist: %s" local)) | ||
| 37 | (let ((autoload-file (expand-file-name | ||
| 38 | (format "%s-autoloads.el" (car pkg)) | ||
| 39 | local)) | ||
| 40 | (backup-inhibited t)) | ||
| 41 | (add-to-list 'load-path local) | ||
| 42 | (loaddefs-generate local autoload-file) | ||
| 43 | (load autoload-file nil t)) | ||
| 44 | (setq pkg (intern (format "%s" (car pkg))))) | ||
| 45 | |||
| 46 | ((symbolp (car pkg)) | ||
| 47 | (unless (ignore-errors (apply #'package-install pkg)) | ||
| 48 | (package-refresh-contents) | ||
| 49 | (apply #'package-install pkg)) | ||
| 50 | (setq pkg (car pkg))) | ||
| 51 | |||
| 52 | ((stringp (car pkg)) | ||
| 53 | (let ((pkg-name (intern (file-name-base (car pkg))))) | ||
| 54 | (unless (package-installed-p pkg-name) | ||
| 55 | (apply #'package-vc-install pkg)) | ||
| 56 | (setq pkg pkg-name)))) | ||
| 57 | |||
| 58 | (when require | ||
| 59 | (require pkg)) | ||
| 60 | |||
| 61 | pkg) | ||
| 62 | |||
| 63 | (defmacro setf/assoc (alist key val &optional keep) | ||
| 64 | "Set KEY to VAL in ALIST using `assoc'/`equal' semantics. | ||
| 65 | Written as a convenience to writing out this long `alist-get' | ||
| 66 | call every time. If VAL is nil, the entry with KEY is removed from ALIST unless | ||
| 67 | KEEP is also non-nil." | ||
| 68 | `(setf (alist-get ,key ,alist nil ,(not keep) #'equal) | ||
| 69 | ,val)) | ||
| 70 | |||
| 71 | (defmacro comment (&rest _) (declare (indent defun)) nil) | ||
| 72 | |||
| 73 | (defun add-local-mode-hook (mode-hook hook func) | ||
| 74 | "Add FUNC to HOOK locally in buffers with MODE-HOOK." | ||
| 75 | (add-hook mode-hook | ||
| 76 | (lambda () (add-hook hook func nil t)))) | ||
| 77 | |||
| 78 | (package-ensure 'crux) | ||
| 79 | (crux-reopen-as-root-mode) | ||
| 80 | |||
| 81 | (crux-with-region-or-buffer indent-region) | ||
| 82 | (crux-with-region-or-buffer tabify) | ||
| 83 | (crux-with-region-or-buffer untabify) | ||
| 84 | |||
| 85 | (keymap-global-set "C-c i" #'crux-find-user-init-file) | ||
| 86 | |||
| 87 | (setopt auth-sources '(default | ||
| 88 | "secrets:passwords" | ||
| 89 | "~/.authinfo")) | ||
| 90 | |||
| 91 | (setq disabled-command-function nil) | ||
| 92 | |||
| 93 | |||
| 94 | ;;; Theme | ||
| 95 | |||
| 96 | (setopt modus-themes-bold-constructs nil) | ||
| 97 | (setopt modus-themes-italic-constructs t) | ||
| 98 | (setopt modus-themes-variable-pitch-ui t) | ||
| 99 | (setopt modus-themes-disable-other-themes t) | ||
| 100 | |||
| 101 | (tool-bar-mode -1) | ||
| 102 | (menu-bar-mode -1) | ||
| 103 | (scroll-bar-mode -1) | ||
| 104 | (tooltip-mode -1) | ||
| 105 | |||
| 106 | (setopt scroll-conservatively 101) | ||
| 107 | |||
| 108 | (setopt read-answer-short t) | ||
| 109 | (setopt use-dialog-box nil) | ||
| 110 | (setopt use-file-dialog nil) | ||
| 111 | (setopt use-short-answers t) | ||
| 112 | |||
| 113 | (setopt inhibit-startup-screen t) | ||
| 114 | (setopt initial-buffer-choice t) | ||
| 115 | (setopt initial-scratch-message | ||
| 116 | ;; ";; Emacs!\n\n" | ||
| 117 | nil) | ||
| 118 | |||
| 119 | (setopt x-underline-at-descent-line t) | ||
| 120 | (setopt blink-cursor-delay 0.25) | ||
| 121 | (setopt blink-cursor-interval 0.25) | ||
| 122 | (setopt blink-cursor-blinks 4) | ||
| 123 | |||
| 124 | (define-advice startup-echo-area-message (:override ()) | ||
| 125 | (if (get-buffer "*Warnings*") | ||
| 126 | ";_;" | ||
| 127 | "^_^")) | ||
| 128 | |||
| 129 | (defun reset-faces (&rest _) | ||
| 130 | (dolist (face '(font-lock-regexp-face | ||
| 131 | font-lock-builtin-face | ||
| 132 | font-lock-variable-name-face | ||
| 133 | font-lock-preprocessor-face | ||
| 134 | font-lock-remove-face | ||
| 135 | font-lock-delimiter-face | ||
| 136 | font-lock-label-face | ||
| 137 | font-lock-operator-face | ||
| 138 | font-lock-property-face | ||
| 139 | font-lock-builtin-face | ||
| 140 | font-lock-number-face | ||
| 141 | font-lock-keyword-face | ||
| 142 | font-lock-set-face | ||
| 143 | font-lock-punctuation-face | ||
| 144 | font-lock-constant-face | ||
| 145 | font-lock-type-face | ||
| 146 | font-lock-function-name-face | ||
| 147 | font-lock-reference-face | ||
| 148 | font-lock-misc-punctuation-face | ||
| 149 | font-lock-bracket-face)) | ||
| 150 | (face-spec-set face '((t :foreground unspecified | ||
| 151 | :background unspecified)))) | ||
| 152 | (when-let ((current (cl-loop for modus in modus-themes-collection | ||
| 153 | if (memq modus custom-enabled-themes) | ||
| 154 | return modus | ||
| 155 | finally return nil))) | ||
| 156 | (modus-themes-with-colors | ||
| 157 | (dolist (face '(font-lock-doc-face | ||
| 158 | font-lock-string-face)) | ||
| 159 | (face-spec-set face `((t :foreground unspecified | ||
| 160 | :background unspecified | ||
| 161 | :slant italic)))) | ||
| 162 | ;; (face-spec-set 'font-lock-comment-face | ||
| 163 | ;; :inherit doesn't work for some reason?? | ||
| 164 | ;; `((t :foreground | ||
| 165 | ;; ,fg-alt))) | ||
| 166 | ))) | ||
| 167 | (advice-add 'load-theme :after #'reset-faces) | ||
| 168 | |||
| 169 | (defvar dark-theme 'modus-vivendi-tinted) | ||
| 170 | (defvar light-theme 'modus-operandi-tinted) | ||
| 171 | |||
| 172 | (load-theme dark-theme :no-confirm :no-enable) | ||
| 173 | (load-theme light-theme :no-confirm :no-enable) | ||
| 174 | (if (and (executable-find "darkman") | ||
| 175 | (let ((stat (shell-command "darkman get"))) | ||
| 176 | (and (= stat 0) | ||
| 177 | (equal (with-current-buffer shell-command-buffer-name | ||
| 178 | (buffer-substring (point-min) (point-max))) | ||
| 179 | "dark\n")))) | ||
| 180 | (load-theme dark-theme :no-confirm) | ||
| 181 | (load-theme light-theme :no-confirm)) | ||
| 182 | |||
| 183 | |||
| 184 | (defun first-frame@set-fonts () | ||
| 185 | (remove-hook 'server-after-make-frame-hook | ||
| 186 | #'first-frame@set-fonts) | ||
| 187 | (face-spec-set 'default | ||
| 188 | `((t :family "Recursive Mono Casual Static" | ||
| 189 | :height 110))) | ||
| 190 | (face-spec-set 'variable-pitch | ||
| 191 | `((t :family "Recursive Sans Casual Static" | ||
| 192 | :height 1.0))) | ||
| 193 | ;; Emojis | ||
| 194 | (cl-loop with ffl = (font-family-list) | ||
| 195 | for font in '("Noto Emoji" "Noto Color Emoji" | ||
| 196 | "Segoe UI Emoji" "Apple Color Emoji" | ||
| 197 | "FreeSans" "FreeMono" "FreeSerif" | ||
| 198 | "Unifont" "Symbola") | ||
| 199 | if (member font ffl) | ||
| 200 | do (set-fontset-font t 'symbol font)) | ||
| 201 | ;; International fonts | ||
| 202 | (cl-loop with ffl = (font-family-list) | ||
| 203 | for (charset . font) | ||
| 204 | in '((latin . "Noto Sans") | ||
| 205 | (han . "Noto Sans CJK SC Regular") | ||
| 206 | (kana . "Noto Sans CJK JP Regular") | ||
| 207 | (hangul . "Noto Sans CJK KR Regular") | ||
| 208 | (cjk-misc . "Noto Sans CJK KR Regular") | ||
| 209 | (khmer . "Noto Sans Khmer") | ||
| 210 | (lao . "Noto Sans Lao") | ||
| 211 | (burmese . "Noto Sans Myanmar") | ||
| 212 | (thai . "Noto Sans Thai") | ||
| 213 | (ethiopic . "Noto Sans Ethiopic") | ||
| 214 | (hebrew . "Noto Sans Hebrew") | ||
| 215 | (arabic . "Noto Sans Arabic") | ||
| 216 | (gujarati . "Noto Sans Gujarati") | ||
| 217 | (devanagari . "Noto Sans Devanagari") | ||
| 218 | (kannada . "Noto Sans Kannada") | ||
| 219 | (malayalam . "Noto Sans Malayalam") | ||
| 220 | (oriya . "Noto Sans Oriya") | ||
| 221 | (sinhala . "Noto Sans Sinhala") | ||
| 222 | (tamil . "Noto Sans Tamil") | ||
| 223 | (telugu . "Noto Sans Telugu") | ||
| 224 | (tibetan . "Noto Sans Tibetan")) | ||
| 225 | if (member font ffl) | ||
| 226 | do (set-fontset-font t charset font)) | ||
| 227 | ;; XXX: tab-bar does a weird thing, so i set it up here.... | ||
| 228 | (setopt tab-bar-show t) | ||
| 229 | (tab-bar-mode)) | ||
| 230 | |||
| 231 | (defun run-after-init-or-first-frame (func) | ||
| 232 | "Run FUNC after init or after the first frame." | ||
| 233 | (if (daemonp) | ||
| 234 | (add-hook 'server-after-make-frame-hook func) | ||
| 235 | (add-hook 'after-init-hook func))) | ||
| 236 | |||
| 237 | (run-after-init-or-first-frame #'first-frame@set-fonts) | ||
| 238 | |||
| 239 | (setopt frame-resize-pixelwise t) | ||
| 240 | (setopt window-resize-pixelwise t) | ||
| 241 | |||
| 242 | (defun tab-bar-end-space () | ||
| 243 | `((end menu-item " " ignore))) | ||
| 244 | |||
| 245 | (add-to-list 'tab-bar-format 'tab-bar-format-align-right :append) | ||
| 246 | (add-to-list 'tab-bar-format 'tab-bar-format-global :append) | ||
| 247 | (add-to-list 'tab-bar-format 'tab-bar-end-space :append) | ||
| 248 | |||
| 249 | (add-hook 'dired-mode-hook #'hl-line-mode) | ||
| 250 | (with-eval-after-load 'org-agenda | ||
| 251 | (add-hook 'org-agenda-mode-hook #'hl-line-mode)) | ||
| 252 | |||
| 253 | (with-eval-after-load 'tabulated-list | ||
| 254 | (add-hook 'tabulated-list-mode-hook #'hl-line-mode)) | ||
| 255 | |||
| 256 | (setopt echo-keystrokes 0.01) | ||
| 257 | |||
| 258 | (setopt switch-to-buffer-in-dedicated-window 'pop) | ||
| 259 | (setopt switch-to-buffer-obey-display-actions t) | ||
| 260 | |||
| 261 | (when (package-ensure 'adaptive-wrap) | ||
| 262 | (add-hook 'visual-line-mode-hook #'adaptive-wrap-prefix-mode)) | ||
| 263 | |||
| 264 | ;;; Ediff | ||
| 265 | |||
| 266 | (setopt ediff-split-window-function #'split-window-horizontally) | ||
| 267 | (setopt ediff-window-setup-function #'ediff-setup-windows-plain) | ||
| 268 | |||
| 269 | ;;; Man pages | ||
| 270 | |||
| 271 | (setopt Man-notify-method 'aggressive) | ||
| 272 | |||
| 273 | ;;; Mode-line | ||
| 274 | |||
| 275 | (defun hide-minor-mode (mode &optional hook) | ||
| 276 | "Hide MODE from the mode-line. | ||
| 277 | HOOK is used to trigger the action, and defaults to MODE-hook." | ||
| 278 | (setf (alist-get mode minor-mode-alist) (list "")) | ||
| 279 | (add-hook (intern (or hook (format "%s-hook" mode))) | ||
| 280 | (lambda () (hide-minor-mode mode)))) | ||
| 281 | |||
| 282 | (setq mode-line-modes | ||
| 283 | (let ((recursive-edit-help-echo | ||
| 284 | "Recursive edit, type M-C-c to get out")) | ||
| 285 | (list (propertize "%[" 'help-echo recursive-edit-help-echo) | ||
| 286 | `(:propertize ("" mode-name) | ||
| 287 | help-echo "Major mode\n\ | ||
| 288 | mouse-1: Display major mode menu\n\ | ||
| 289 | mouse-2: Show help for major mode\n\ | ||
| 290 | mouse-3: Toggle minor modes" | ||
| 291 | face bold | ||
| 292 | mouse-face mode-line-highlight | ||
| 293 | local-map ,mode-line-major-mode-keymap) | ||
| 294 | '("" mode-line-process) | ||
| 295 | `(:propertize ("" minor-mode-alist) | ||
| 296 | mouse-face mode-line-highlight | ||
| 297 | help-echo "Minor mode\n\ | ||
| 298 | mouse-1: Display minor mode menu\n\ | ||
| 299 | mouse-2: Show help for minor mode\n\ | ||
| 300 | mouse-3: Toggle minor modes" | ||
| 301 | local-map ,mode-line-minor-mode-keymap) | ||
| 302 | (propertize "%n" 'help-echo "mouse-2: Remove narrowing from buffer" | ||
| 303 | 'mouse-face 'mode-line-highlight | ||
| 304 | 'local-map (make-mode-line-mouse-map | ||
| 305 | 'mouse-2 #'mode-line-widen)) | ||
| 306 | (propertize "%]" 'help-echo recursive-edit-help-echo) | ||
| 307 | " "))) | ||
| 308 | |||
| 309 | (setopt mode-line-format | ||
| 310 | '(("%e" | ||
| 311 | mode-line-front-space | ||
| 312 | (:propertize ("" | ||
| 313 | mode-line-client | ||
| 314 | mode-line-modified | ||
| 315 | mode-line-remote) | ||
| 316 | display (min-width (3.0))) | ||
| 317 | " " | ||
| 318 | mode-line-buffer-identification | ||
| 319 | (vc-mode | ||
| 320 | (" (" (:eval (string-trim vc-mode)) ")")) | ||
| 321 | " " | ||
| 322 | (mode-line-position | ||
| 323 | (" ∙ " mode-line-position)) | ||
| 324 | " ∙ " | ||
| 325 | mode-line-modes ; the one above | ||
| 326 | mode-line-misc-info | ||
| 327 | mode-line-end-spaces))) | ||
| 328 | |||
| 329 | |||
| 330 | ;;; Completion and minibuffer | ||
| 331 | |||
| 332 | (setopt tab-always-indent 'complete) | ||
| 333 | (setopt completion-styles '(basic partial-completion substring flex)) | ||
| 334 | |||
| 335 | ;; XXX: this is 'too good' when I'm in the process of typing out things. | ||
| 336 | ;; (when (package-ensure "https://git.sr.ht/~pkal/typo") | ||
| 337 | ;; (add-to-list 'completion-styles 'typo :append)) | ||
| 338 | |||
| 339 | (setopt completion-ignore-case t) | ||
| 340 | (setopt read-buffer-completion-ignore-case t) | ||
| 341 | (setopt read-file-name-completion-ignore-case t) | ||
| 342 | (setopt completion-flex-nospace t) | ||
| 343 | |||
| 344 | ;; These aren't /that/ useful if you're not using *Completions*. | ||
| 345 | (setopt completions-detailed t) | ||
| 346 | (setopt completion-auto-help 'visible) | ||
| 347 | (setopt completion-auto-select 'second-tab) | ||
| 348 | (setopt completions-header-format nil) | ||
| 349 | (setopt completions-format 'one-column) | ||
| 350 | (setopt completions-max-height 20) | ||
| 351 | |||
| 352 | ;; (defun minibuffer-next-completion-or-line (n) | ||
| 353 | ;; "Move to the next N completion in minibuffer, or Nth next line." | ||
| 354 | ;; (interactive "p") | ||
| 355 | ;; (if (and (eq last-command 'minibuffer-next-completion) | ||
| 356 | ;; (not (minibufferp))) | ||
| 357 | ;; (forward-line n) | ||
| 358 | ;; (minibuffer-next-completion n))) | ||
| 359 | |||
| 360 | ;; (defun minibuffer-previous-completion-or-line (n) | ||
| 361 | ;; "Move to the previous N completion, or Nth previous line." | ||
| 362 | ;; (interactive "p") | ||
| 363 | ;; (setq last-command 'minibuffer-next-completion-or-line) | ||
| 364 | ;; (minibuffer-next-completion-or-line (- n))) | ||
| 365 | |||
| 366 | (progn | ||
| 367 | (keymap-set minibuffer-local-map "C-p" | ||
| 368 | #'minibuffer-previous-completion) | ||
| 369 | (keymap-set minibuffer-local-map "C-n" | ||
| 370 | #'minibuffer-next-completion) | ||
| 371 | ;; (keymap-set completion-in-region-mode-map "C-p" | ||
| 372 | ;; #'minibuffer-previous-completion) | ||
| 373 | ;; (keymap-set completion-in-region-mode-map "C-n" | ||
| 374 | ;; #'minibuffer-next-completion) | ||
| 375 | ) | ||
| 376 | |||
| 377 | (setf/assoc display-buffer-alist | ||
| 378 | "\\*Completions\\*" | ||
| 379 | '((display-buffer-reuse-mode-window))) | ||
| 380 | |||
| 381 | (setopt enable-recursive-minibuffers t) | ||
| 382 | (minibuffer-depth-indicate-mode) | ||
| 383 | (minibuffer-electric-default-mode) | ||
| 384 | |||
| 385 | (setopt file-name-shadow-properties '(invisible t intangible t)) | ||
| 386 | (file-name-shadow-mode) | ||
| 387 | |||
| 388 | (define-minor-mode truncate-lines-local-mode | ||
| 389 | "Toggle `truncate-lines' in the current buffer." | ||
| 390 | :lighter "" | ||
| 391 | (setq-local truncate-lines truncate-lines-local-mode)) | ||
| 392 | |||
| 393 | (add-hook 'completion-list-mode-hook #'truncate-lines-local-mode) | ||
| 394 | (add-hook 'minibuffer-setup-hook #'truncate-lines-local-mode) | ||
| 395 | |||
| 396 | (when (package-ensure 'consult nil t) | ||
| 397 | (keymap-global-set "C-x b" #'consult-buffer) | ||
| 398 | (keymap-global-set "C-x 4 b" #'consult-buffer-other-window) | ||
| 399 | (keymap-global-set "C-x 5 b" #'consult-buffer-other-frame) | ||
| 400 | (keymap-global-set "C-x r b" #'consult-bookmark) | ||
| 401 | (keymap-global-set "M-y" #'consult-yank-pop) | ||
| 402 | (keymap-global-set "M-g g" #'consult-goto-line) | ||
| 403 | (keymap-global-set "M-g M-g" #'consult-goto-line) | ||
| 404 | (keymap-global-set "M-g o" #'consult-outline) | ||
| 405 | (keymap-global-set "M-g m" #'consult-mark) | ||
| 406 | (keymap-global-set "M-g i" #'consult-imenu) | ||
| 407 | (keymap-global-set "M-s d" #'consult-find) | ||
| 408 | (keymap-global-set "M-s D" #'consult-locate) | ||
| 409 | (keymap-global-set "M-s g" #'consult-grep) | ||
| 410 | (keymap-global-set "M-s G" #'consult-git-grep) | ||
| 411 | (keymap-global-set "M-s r" #'consult-ripgrep) | ||
| 412 | (keymap-global-set "M-s l" #'consult-line) | ||
| 413 | (keymap-global-set "M-s k" #'consult-keep-lines) | ||
| 414 | (keymap-global-set "M-s u" #'consult-focus-lines) | ||
| 415 | |||
| 416 | (keymap-global-set "M-s e" #'consult-isearch-history) | ||
| 417 | (keymap-set isearch-mode-map "M-e" #'consult-isearch-history) | ||
| 418 | (keymap-set isearch-mode-map "M-s e" #'consult-isearch-history) | ||
| 419 | (keymap-set isearch-mode-map "M-s l" #'consult-line) | ||
| 420 | |||
| 421 | (setopt xref-show-xrefs-function #'consult-xref) | ||
| 422 | (setopt xref-show-definitions-function #'xref-show-definitions-completing-read) | ||
| 423 | |||
| 424 | (setopt consult-preview-key "M-.") | ||
| 425 | |||
| 426 | (consult-customize | ||
| 427 | consult-ripgrep consult-git-grep consult-grep | ||
| 428 | consult-xref | ||
| 429 | :preview-key '(:debounce 0.4 any))) | ||
| 430 | |||
| 431 | (when (package-ensure 'marginalia) | ||
| 432 | (marginalia-mode)) | ||
| 433 | |||
| 434 | (setopt history-length t) | ||
| 435 | (setopt history-delete-duplicates t) | ||
| 436 | (setopt savehist-save-minibuffer-history t) | ||
| 437 | (setopt savehist-autosave-interval 5) | ||
| 438 | (savehist-mode) | ||
| 439 | |||
| 440 | |||
| 441 | ;;; Text editing | ||
| 442 | |||
| 443 | (setopt fill-column 80) | ||
| 444 | (global-so-long-mode) | ||
| 445 | |||
| 446 | (defun cycle-spacing* (&optional n) | ||
| 447 | "Negate N argument on `cycle-spacing'." | ||
| 448 | (interactive "*p") | ||
| 449 | (cycle-spacing (- n))) | ||
| 450 | (keymap-global-set "M-SPC" #'cycle-spacing*) | ||
| 451 | |||
| 452 | (when (package-ensure 'hungry-delete) | ||
| 453 | (setopt hungry-delete-chars-to-skip " \t") | ||
| 454 | (setopt hungry-delete-skip-regexp (format "[%s]" hungry-delete-chars-to-skip)) | ||
| 455 | (setopt hungry-delete-join-reluctantly nil) | ||
| 456 | (with-eval-after-load 'hungry-delete | ||
| 457 | (add-to-list 'hungry-delete-except-modes 'eshell-mode) | ||
| 458 | (add-to-list 'hungry-delete-except-modes 'nim-mode) | ||
| 459 | (add-to-list 'hungry-delete-except-modes 'python-mode) | ||
| 460 | (hide-minor-mode 'hungry-delete-mode)) | ||
| 461 | (global-hungry-delete-mode)) | ||
| 462 | |||
| 463 | (setopt isearch-lazy-count t) | ||
| 464 | (setopt isearch-regexp-lax-whitespace t) | ||
| 465 | (setopt isearch-wrap-pause 'no) | ||
| 466 | (setopt search-default-mode t) | ||
| 467 | (setopt search-whitespace-regexp ".*?") ; swiper-style | ||
| 468 | (setopt search-ring-max 256) | ||
| 469 | (setopt regexp-search-ring-max 256) | ||
| 470 | |||
| 471 | (define-advice isearch-cancel (:before () add-to-history) | ||
| 472 | "Add search string to history when canceling isearch." | ||
| 473 | (unless (string-equal "" isearch-string) | ||
| 474 | (isearch-update-ring isearch-string isearch-regexp))) | ||
| 475 | |||
| 476 | (define-advice perform-replace (:around (fn &rest args) dont-exit-on-anykey) | ||
| 477 | "Don't exit replace for anykey that's not in `query-replace-map'." | ||
| 478 | (save-window-excursion | ||
| 479 | (cl-letf* ((lookup-key-orig | ||
| 480 | (symbol-function 'lookup-key)) | ||
| 481 | ((symbol-function 'lookup-key) | ||
| 482 | (lambda (map key &optional accept-default) | ||
| 483 | (or (apply lookup-key-orig map key accept-default) | ||
| 484 | (when (eq map query-replace-map) 'help))))) | ||
| 485 | (apply fn args)))) | ||
| 486 | |||
| 487 | (when (package-ensure 'isearch-mb) | ||
| 488 | (with-eval-after-load 'isearch-mb | ||
| 489 | (with-eval-after-load 'consult | ||
| 490 | (add-to-list 'isearch-mb--with-buffer #'consult-isearch-history) | ||
| 491 | (keymap-set isearch-mb-minibuffer-map "M-r" #'consult-isearch-history) | ||
| 492 | (add-to-list 'isearch-mb--after-exit #'consult-line) | ||
| 493 | (keymap-set isearch-mb-minibuffer-map "M-s l" #'consult-line)) | ||
| 494 | (with-eval-after-load 'anzu | ||
| 495 | (add-to-list 'isearch-mb--after-exit #'anzu-isearch-query-replace) | ||
| 496 | (keymap-set isearch-mb-minibuffer-map "M-%" | ||
| 497 | #'anzu-isearch-query-replace))) | ||
| 498 | (isearch-mb-mode)) | ||
| 499 | |||
| 500 | (when (package-ensure 'anzu) | ||
| 501 | (setopt anzu-mode-lighter "") | ||
| 502 | (setopt anzu-deactivate-region t) | ||
| 503 | (keymap-global-set "M-%" #'anzu-query-replace-regexp) | ||
| 504 | (keymap-global-set "C-M-%" #'anzu-query-replace) | ||
| 505 | (keymap-set isearch-mode-map "M-%" #'anzu-isearch-query-replace-regexp) | ||
| 506 | (keymap-set isearch-mode-map "C-M-%" #'anzu-isearch-query-replace) | ||
| 507 | (global-anzu-mode)) | ||
| 508 | |||
| 509 | (keymap-global-set "M-/" #'hippie-expand) | ||
| 510 | (keymap-global-set "C-x C-b" #'ibuffer) | ||
| 511 | |||
| 512 | (add-hook 'ibuffer-mode-hook #'hl-line-mode) | ||
| 513 | |||
| 514 | (defun call-with-region-or-buffer (fn &rest _r) | ||
| 515 | "Call function FN with current region or buffer. | ||
| 516 | Good to use for :around advice." | ||
| 517 | ;; This `interactive' form is needed to override the advised function's form, | ||
| 518 | ;; to avoid errors when the region isn't active. This means that FN must take | ||
| 519 | ;; 2 arguments, the beginning and the end of the region to act on. | ||
| 520 | (interactive) | ||
| 521 | (if (region-active-p) | ||
| 522 | (funcall fn (region-beginning) (region-end)) | ||
| 523 | (funcall fn (point-min) (point-max)))) | ||
| 524 | |||
| 525 | (delete-selection-mode) | ||
| 526 | |||
| 527 | (when (package-ensure 'avy) | ||
| 528 | (setopt avy-background t) | ||
| 529 | (setopt avy-keys (string-to-list "asdfghjklqwertyuiopzxcvbnm")) | ||
| 530 | (keymap-global-set "M-j" #'avy-goto-char-timer) | ||
| 531 | (keymap-set isearch-mode-map "M-j" #'avy-isearch)) | ||
| 532 | |||
| 533 | (when (package-ensure 'zzz-to-char) | ||
| 534 | (keymap-global-set "M-z" | ||
| 535 | (defun zzz-to-char* (arg) | ||
| 536 | (interactive "P") | ||
| 537 | (call-interactively | ||
| 538 | (if arg #'zzz-to-char #'zzz-to-char-up-to-char))))) | ||
| 539 | |||
| 540 | ;;; Prose | ||
| 541 | |||
| 542 | (add-hook 'text-mode-hook #'visual-line-mode) | ||
| 543 | |||
| 544 | (when (package-ensure 'olivetti) | ||
| 545 | (add-hook 'text-mode-hook #'olivetti-mode)) | ||
| 546 | |||
| 547 | (when (package-ensure 'jinx) | ||
| 548 | (add-hook 'text-mode-hook #'jinx-mode) | ||
| 549 | (with-eval-after-load 'jinx | ||
| 550 | (keymap-set jinx-mode-map "M-$" #'jinx-correct) | ||
| 551 | (keymap-set jinx-mode-map "C-M-$" #'jinx-languages))) | ||
| 552 | |||
| 553 | (defun org-fk-region (start end) | ||
| 554 | "Get the Flesch-Kincaid score of an `org-mode' region." | ||
| 555 | (interactive "r") | ||
| 556 | (let ((buf (get-buffer-create " *fk*" t))) | ||
| 557 | (shell-command-on-region start end | ||
| 558 | "pandoc -t plain -f org | ~/src/fk/fk.perl" | ||
| 559 | buf) | ||
| 560 | (with-current-buffer buf | ||
| 561 | (buffer-substring-no-properties (point-min) (- (point-max) 1))) | ||
| 562 | (kill-buffer buf))) | ||
| 563 | |||
| 564 | (crux-with-region-or-buffer org-fk-region) | ||
| 565 | |||
| 566 | (when (package-ensure 'scule t t) | ||
| 567 | (keymap-global-set "M-c" scule-map)) | ||
| 568 | |||
| 569 | (when (package-ensure 'titlecase t) | ||
| 570 | (keymap-set scule-map "M-t" #'titlecase-dwim)) | ||
| 571 | |||
| 572 | (setopt dictionary-default-popup-strategy "lev") ; Levenshtein distance 1 | ||
| 573 | (setopt dictionary-server "dict.org") | ||
| 574 | (setopt dictionary-use-single-buffer t) | ||
| 575 | (keymap-global-set "M-#" | ||
| 576 | (defun dictionary-lookup-dwim () | ||
| 577 | (interactive) | ||
| 578 | (unless (ignore-errors (dictionary-lookup-definition)) | ||
| 579 | (call-interactively #'dictionary-search)))) | ||
| 580 | |||
| 581 | (package-ensure 'markdown-mode) | ||
| 582 | |||
| 583 | ;;; Programming | ||
| 584 | |||
| 585 | (setopt electric-pair-skip-whitespace 'chomp) | ||
| 586 | (electric-pair-mode) | ||
| 587 | |||
| 588 | (setopt show-paren-delay 0.01) | ||
| 589 | (setopt show-paren-style 'parenthesis) | ||
| 590 | (setopt show-paren-when-point-in-periphery t) | ||
| 591 | (setopt show-paren-when-point-inside-paren t) | ||
| 592 | (show-paren-mode) | ||
| 593 | |||
| 594 | (add-hook 'prog-mode-hook #'auto-fill-mode) | ||
| 595 | (add-hook 'prog-mode-hook #'display-fill-column-indicator-mode) | ||
| 596 | (add-hook 'after-save-hook #'executable-make-buffer-file-executable-if-script-p) | ||
| 597 | |||
| 598 | (when (package-ensure 'dumb-jump) | ||
| 599 | (add-hook 'xref-backend-functions #'dumb-jump-xref-activate)) | ||
| 600 | |||
| 601 | (add-hook 'prog-mode-hook #'prettify-symbols-mode) | ||
| 602 | |||
| 603 | (keymap-global-set "M-:" #'pp-eval-expression) | ||
| 604 | |||
| 605 | ;; Tabs | ||
| 606 | |||
| 607 | (setopt tab-width 8) | ||
| 608 | |||
| 609 | (defvar space-indent-modes '(emacs-lisp-mode | ||
| 610 | lisp-interaction-mode | ||
| 611 | lisp-mode | ||
| 612 | scheme-mode | ||
| 613 | python-mode | ||
| 614 | haskell-mode | ||
| 615 | text-mode) | ||
| 616 | "Modes to indent with spaces, not tabs.") | ||
| 617 | |||
| 618 | (defun indent-tabs-mode-maybe () | ||
| 619 | (setq indent-tabs-mode | ||
| 620 | (if (apply #'derived-mode-p space-indent-modes) nil t))) | ||
| 621 | (add-hook 'prog-mode-hook #'indent-tabs-mode-maybe) | ||
| 622 | |||
| 623 | (setopt sh-basic-offset tab-width) | ||
| 624 | (setopt perl-indent-level tab-width) | ||
| 625 | |||
| 626 | ;; Scheme | ||
| 627 | |||
| 628 | (when (package-ensure 'geiser) | ||
| 629 | (when (executable-find "csi") | ||
| 630 | (when (package-ensure 'geiser-chicken) | ||
| 631 | (setf/assoc auto-mode-alist "\\.egg\\'" 'scheme-mode))) | ||
| 632 | (setopt scheme-program-name (or (executable-find "csi") | ||
| 633 | "scheme")) | ||
| 634 | (add-hook 'scheme-mode-hook #'geiser-mode)) | ||
| 635 | |||
| 636 | (require 'autoinsert) | ||
| 637 | (setf/assoc auto-insert-alist | ||
| 638 | "\\.scm" | ||
| 639 | '(nil "#!/bin/sh" \n | ||
| 640 | "#| -*- scheme -*-" \n | ||
| 641 | "exec csi -ss \"$0\" \"$@\"" \n | ||
| 642 | _ \n | ||
| 643 | "|#" \n \n)) | ||
| 644 | |||
| 645 | ;; Emacs lisp | ||
| 646 | |||
| 647 | (keymap-set emacs-lisp-mode-map "C-c C-c" #'eval-defun) | ||
| 648 | (keymap-set emacs-lisp-mode-map "C-c C-b" #'eval-buffer) | ||
| 649 | (keymap-set emacs-lisp-mode-map "C-c C-z" #'ielm) ; TODO: better-ize | ||
| 650 | (keymap-set lisp-interaction-mode-map "C-c C-c" #'eval-defun) | ||
| 651 | (keymap-set lisp-interaction-mode-map "C-c C-b" #'eval-buffer) | ||
| 652 | (keymap-set lisp-interaction-mode-map "C-c C-z" #'ielm) ; TODO: better-ize | ||
| 653 | |||
| 654 | (add-hook 'after-init-hook | ||
| 655 | (lambda () | ||
| 656 | (define-advice eval-buffer (:after (&rest _) message) | ||
| 657 | (message "Buffer %s evaluated." (current-buffer))))) | ||
| 658 | |||
| 659 | |||
| 660 | ;;; Files | ||
| 661 | |||
| 662 | (setopt auto-revert-verbose nil) | ||
| 663 | (setopt global-auto-revert-non-file-buffers t) | ||
| 664 | (global-auto-revert-mode) | ||
| 665 | |||
| 666 | (setopt create-lockfiles nil) | ||
| 667 | (setopt mode-require-final-newline t) | ||
| 668 | (setopt view-read-only t) | ||
| 669 | (setopt save-silently t) | ||
| 670 | |||
| 671 | (setopt auto-save-default nil) | ||
| 672 | (setopt auto-save-no-message t) | ||
| 673 | (setopt auto-save-interval 2) | ||
| 674 | (setopt auto-save-timeout 2) | ||
| 675 | (setopt auto-save-visited-interval 2) | ||
| 676 | (setopt remote-file-name-inhibit-auto-save t) | ||
| 677 | (setopt remote-file-name-inhibit-auto-save-visited t) | ||
| 678 | (add-to-list 'auto-save-file-name-transforms | ||
| 679 | `(".*" ,(locate-user-emacs-file "auto-save/") t)) | ||
| 680 | (auto-save-visited-mode) | ||
| 681 | |||
| 682 | (setopt backup-by-copying t) | ||
| 683 | (setopt version-control t) | ||
| 684 | (setopt kept-new-versions 3) | ||
| 685 | (setopt kept-old-versions 3) | ||
| 686 | (setopt delete-old-versions t) | ||
| 687 | (add-to-list 'backup-directory-alist '("^/dev/shm/" . nil)) | ||
| 688 | (add-to-list 'backup-directory-alist '("^/tmp/" . nil)) | ||
| 689 | (when-let ((xrd (getenv "XDG_RUNTIME_DIR"))) | ||
| 690 | (add-to-list 'backup-directory-alist (cons xrd nil))) | ||
| 691 | (add-to-list 'backup-directory-alist | ||
| 692 | (cons "." (locate-user-emacs-file "backup/")) | ||
| 693 | :append) | ||
| 694 | |||
| 695 | (setopt recentf-max-menu-items 100) | ||
| 696 | (setopt recentf-max-saved-items nil) | ||
| 697 | (setopt recentf-case-fold-search t) | ||
| 698 | (with-eval-after-load 'recentf | ||
| 699 | (add-to-list 'recentf-exclude "-autoloads.el\\'")) | ||
| 700 | (add-hook 'buffer-list-update-hook #'recentf-track-opened-file) | ||
| 701 | (add-hook 'after-save-hook #'recentf-save-list) | ||
| 702 | (recentf-mode) | ||
| 703 | |||
| 704 | (setopt save-place-forget-unreadable-files (eq system-type 'gnu/linux)) | ||
| 705 | (save-place-mode) | ||
| 706 | |||
| 707 | ;; Encodings | ||
| 708 | (set-language-environment "UTF-8") | ||
| 709 | (setopt buffer-file-coding-system 'utf-8-unix) | ||
| 710 | (setopt coding-system-for-read 'utf-8-unix) | ||
| 711 | (setopt coding-system-for-write 'utf-8-unix) | ||
| 712 | (setopt default-process-coding-system '(utf-8-unix . utf-8-unix)) | ||
| 713 | (setopt locale-coding-system 'utf-8-unix) | ||
| 714 | (set-charset-priority 'unicode) | ||
| 715 | (prefer-coding-system 'utf-8-unix) | ||
| 716 | (set-default-coding-systems 'utf-8-unix) | ||
| 717 | (set-terminal-coding-system 'utf-8-unix) | ||
| 718 | (set-keyboard-coding-system 'utf-8-unix) | ||
| 719 | (pcase system-type | ||
| 720 | ((or 'ms-dos 'windows-nt) | ||
| 721 | (set-clipboard-coding-system 'utf-16-le) | ||
| 722 | (set-selection-coding-system 'utf-16-le)) | ||
| 723 | (_ | ||
| 724 | (set-selection-coding-system 'utf-8) | ||
| 725 | (set-clipboard-coding-system 'utf-8))) | ||
| 726 | |||
| 727 | ;; Undo | ||
| 728 | (when (package-ensure 'undohist) | ||
| 729 | (undohist-initialize)) | ||
| 730 | |||
| 731 | ;;; ... | ||
| 732 | |||
| 733 | (setopt bookmark-save-flag 1) | ||
| 734 | |||
| 735 | (defun c-w-dwim (num) | ||
| 736 | "Delete NUM words backward, or the region if it's active." | ||
| 737 | (interactive "p") | ||
| 738 | (if (region-active-p) | ||
| 739 | (call-interactively #'kill-region) | ||
| 740 | (call-interactively #'backward-kill-word))) | ||
| 741 | (keymap-global-set "C-w" #'c-w-dwim) | ||
| 742 | |||
| 743 | (setf/assoc display-buffer-alist | ||
| 744 | "\\`\\*Warnings\\*" | ||
| 745 | '((display-buffer-no-window))) | ||
| 746 | |||
| 747 | (winner-mode) | ||
| 748 | |||
| 749 | (setopt set-mark-command-repeat-pop t) | ||
| 750 | |||
| 751 | (when (package-ensure 'embark nil t) | ||
| 752 | (when (and (package-installed-p 'consult) | ||
| 753 | (package-ensure 'embark-consult nil t)) | ||
| 754 | (add-hook 'embark-collect-mode-hook #'consult-preview-at-point-mode)) | ||
| 755 | (keymap-global-set "C-." #'embark-act) | ||
| 756 | (keymap-global-set "M-." #'embark-dwim) | ||
| 757 | (keymap-global-set "C-h B" #'embark-bindings) | ||
| 758 | (setopt prefix-help-command #'embark-prefix-help-command) | ||
| 759 | (setf/assoc display-buffer-alist | ||
| 760 | "\\`\\*Embark Collect \\(Live\\|Completions\\)\\*" | ||
| 761 | '(nil (window-parameters (mode-line-format . none))))) | ||
| 762 | |||
| 763 | (setopt eldoc-documentation-strategy #'eldoc-documentation-compose-eagerly) | ||
| 764 | (setopt eldoc-idle-delay 0.01) | ||
| 765 | |||
| 766 | (setopt recenter-positions '(top middle bottom)) | ||
| 767 | |||
| 768 | (defmacro inhibit-messages (&rest body) | ||
| 769 | "Inhibit all messages in BODY." | ||
| 770 | (declare (indent defun)) | ||
| 771 | `(cl-letf (((symbol-function 'message) #'ignore)) | ||
| 772 | ,@body)) | ||
| 773 | |||
| 774 | (add-hook 'find-file-not-found-functions | ||
| 775 | (defun create-missing-directories () | ||
| 776 | "Automatically create missing directories." | ||
| 777 | (let ((target-dir (file-name-directory buffer-file-name))) | ||
| 778 | (unless (file-exists-p target-dir) | ||
| 779 | (make-directory target-dir :parents))))) | ||
| 780 | |||
| 781 | (setopt vc-follow-symlinks t) | ||
| 782 | (setopt vc-make-backup-files t) | ||
| 783 | (add-hook 'find-file-hook | ||
| 784 | (defun vc-remote-off () | ||
| 785 | "Turn VC off when remote." | ||
| 786 | (when (file-remote-p (buffer-file-name)) | ||
| 787 | (setq-local vc-handled-backends nil)))) | ||
| 788 | (with-eval-after-load 'vc-dir | ||
| 789 | (add-hook 'vc-dir-mode-hook #'hl-line-mode)) | ||
| 790 | |||
| 791 | (setopt whitespace-style '(face trailing tabs tab-mark)) | ||
| 792 | (global-whitespace-mode) | ||
| 793 | (hide-minor-mode 'whitespace-mode) | ||
| 794 | (add-hook 'before-save-hook | ||
| 795 | (defun delete-trailing-whitespace-except-current-line () | ||
| 796 | (save-excursion | ||
| 797 | (delete-trailing-whitespace (point-min) | ||
| 798 | (line-beginning-position)) | ||
| 799 | (delete-trailing-whitespace (line-end-position) | ||
| 800 | (point-max))))) | ||
| 801 | |||
| 802 | (defun list-of-strings-p (x) | ||
| 803 | "Is X a list of strings?" | ||
| 804 | (and x | ||
| 805 | (listp x) | ||
| 806 | (cl-every #'stringp x))) | ||
| 807 | |||
| 808 | (put 'ispell-local-words 'safe-local-variable | ||
| 809 | 'list-of-strings-p) | ||
| 810 | |||
| 811 | (package-ensure '0x0) ; TODO: write my own package for rsync | ||
| 812 | |||
| 813 | (when (package-ensure 'electric-cursor t) | ||
| 814 | (hide-minor-mode 'electric-cursor-mode) | ||
| 815 | (setopt electric-cursor-alist '((overwrite-mode . (hbar . 8)) | ||
| 816 | (t . box))) | ||
| 817 | (electric-cursor-mode)) | ||
| 818 | |||
| 819 | (defun fill-double-space-sentences-region (start end) | ||
| 820 | "Fill from START to END, double-spacing sentences." | ||
| 821 | (let ((sentence-end-double-space t)) | ||
| 822 | (repunctuate-sentences :no-query start end) | ||
| 823 | (fill-region start end))) | ||
| 824 | |||
| 825 | (defun unfill-region (start end &optional unfill-func) | ||
| 826 | "Unfill region from START to END." | ||
| 827 | (let ((fill-column most-positive-fixnum) | ||
| 828 | (fill-paragraph-function nil)) | ||
| 829 | (funcall (or unfill-func #'fill-region) start end))) | ||
| 830 | |||
| 831 | (defun fill-or-unfill-region (start end &optional interactive) | ||
| 832 | "Fill or unfill from START to END." | ||
| 833 | (interactive "*r\np") | ||
| 834 | (if (and interactive | ||
| 835 | (eq last-command 'fill-or-unfill-region)) | ||
| 836 | ;; If called interactively more than once, toggle filling mode. | ||
| 837 | (if (with-current-buffer "*Messages*" | ||
| 838 | (goto-char (point-max)) | ||
| 839 | (goto-char (beginning-of-line)) | ||
| 840 | (looking-at "Unfilling")) | ||
| 841 | (fill-double-space-sentences-region start end) | ||
| 842 | (unfill-region start end #'fill-double-space-sentences-region)) | ||
| 843 | ;; Otherwise, detect filled status based on the length of lines in the | ||
| 844 | ;; region. If just one of them is longer than `fill-column', consider the | ||
| 845 | ;; region unfilled. | ||
| 846 | (let ((filled-p (cl-some (lambda (ln) (<= 1 (length ln) fill-column)) | ||
| 847 | (string-split (buffer-substring start end) | ||
| 848 | "[\n\r]+")))) | ||
| 849 | (if filled-p | ||
| 850 | (progn | ||
| 851 | (message "Unfilling region") | ||
| 852 | (unfill-region start end #'fill-double-space-sentences-region)) | ||
| 853 | (progn | ||
| 854 | (message "Filling region") | ||
| 855 | (fill-double-space-sentences-region start end)))))) | ||
| 856 | |||
| 857 | (defun fill-or-unfill-dwim () | ||
| 858 | (interactive) | ||
| 859 | (save-mark-and-excursion | ||
| 860 | (unless (region-active-p) | ||
| 861 | (mark-paragraph)) | ||
| 862 | (call-interactively #'fill-or-unfill-region))) | ||
| 863 | |||
| 864 | (keymap-global-set "M-q" #'fill-or-unfill-dwim) | ||
| 865 | |||
| 866 | ;; Fix annoying error messages when I type the <FN> key | ||
| 867 | (keymap-global-set "<0x100811d0>" #'ignore) ; Keychron | ||
| 868 | (keymap-global-set "<WakeUp>" #'ignore) ; Laptop | ||
| 869 | |||
| 870 | (keymap-global-set "M-u" #'universal-argument) | ||
| 871 | (keymap-set universal-argument-map "M-u" #'universal-argument-more) | ||
| 872 | |||
| 873 | (defun kill-buffer-dwim (&optional buffer-or-name) | ||
| 874 | "Kill BUFFER-OR-NAME or the current buffer." | ||
| 875 | (interactive "P") | ||
| 876 | (cond | ||
| 877 | ((bufferp buffer-or-name) | ||
| 878 | (kill-buffer buffer-or-name)) | ||
| 879 | ((null buffer-or-name) | ||
| 880 | (kill-current-buffer)) | ||
| 881 | (:else | ||
| 882 | (kill-buffer (read-buffer "Kill: " nil :require-match))))) | ||
| 883 | (keymap-global-set "C-x C-k" #'kill-buffer-dwim) | ||
| 884 | |||
| 885 | (defun other-window-dwim (&optional arg) | ||
| 886 | "Switch to another window/buffer. | ||
| 887 | Calls `other-window', which see, unless | ||
| 888 | - the current window is alone on its frame | ||
| 889 | - `other-window-dwim' is called with \\[universal-argument] | ||
| 890 | In these cases, switch to the last-used buffer." | ||
| 891 | (interactive "P") | ||
| 892 | (if (or arg (one-window-p)) | ||
| 893 | (switch-to-buffer (other-buffer) nil t) | ||
| 894 | (other-window 1))) | ||
| 895 | (keymap-global-set "M-o" #'other-window-dwim) | ||
| 896 | (keymap-global-set "C-x o" #'other-window-dwim) | ||
| 897 | |||
| 898 | (defun delete-window-dwim () | ||
| 899 | "Delete the current window or bury its buffer. | ||
| 900 | If the current window is alone in its frame, bury the buffer | ||
| 901 | instead." | ||
| 902 | (interactive) | ||
| 903 | (unless (ignore-errors (delete-window) t) | ||
| 904 | (bury-buffer))) | ||
| 905 | (keymap-global-set "C-x 0" #'delete-window-dwim) | ||
| 906 | |||
| 907 | |||
| 908 | ;;; Org mode | ||
| 909 | |||
| 910 | (keymap-global-set "C-c a" #'org-agenda) | ||
| 911 | (keymap-global-set "C-c c" #'org-capture) | ||
| 912 | (keymap-global-set "C-c l" #'org-store-link) | ||
| 913 | |||
| 914 | (setopt org-clock-clocked-in-display 'mode-line) | ||
| 915 | (setopt org-clock-out-remove-zero-time-clocks t) | ||
| 916 | (setopt org-clock-frame-title-format '("%b" " - " (t org-mode-line-string))) | ||
| 917 | (setopt org-tags-column (- (- fill-column 3))) | ||
| 918 | (setopt org-log-into-drawer t) | ||
| 919 | (setopt org-clock-into-drawer t) | ||
| 920 | (setopt org-special-ctrl-a/e t) | ||
| 921 | (setopt org-special-ctrl-k t) | ||
| 922 | (setopt org-archive-mark-done t) | ||
| 923 | (setopt org-agenda-window-setup 'current-window) | ||
| 924 | (setopt org-agenda-restore-windows-after-quit t) | ||
| 925 | (setopt org-agenda-skip-deadline-if-done t) | ||
| 926 | (setopt org-agenda-skip-scheduled-if-done t) | ||
| 927 | (setopt org-agenda-inhibit-startup t) | ||
| 928 | (setopt org-deadline-warning-days 0) | ||
| 929 | (setopt org-cycle-separator-lines 0) | ||
| 930 | (setopt org-agenda-span 10) | ||
| 931 | (setopt org-blank-before-new-entry '((heading . t) | ||
| 932 | (plain-list-item . nil))) | ||
| 933 | |||
| 934 | (defvar-local org-agenda/setup-done nil) | ||
| 935 | |||
| 936 | (add-hook 'org-agenda-after-show-hook | ||
| 937 | (defun org-agenda-after-show/setup () | ||
| 938 | (org-narrow-to-subtree) | ||
| 939 | (goto-char (point-min)) | ||
| 940 | (unless org-agenda/setup-done | ||
| 941 | (run-hooks 'org-mode-hook)) | ||
| 942 | (setq org-agenda/setup-done t))) | ||
| 943 | |||
| 944 | ;; org-return-dwim | ||
| 945 | ;; https://github.com/alphapapa/unpackaged.el, | ||
| 946 | ;; http://kitchingroup.cheme.cmu.edu/blog/2017/04/09/A-better-return-in-org-mode/ | ||
| 947 | (defun org-return-dwim (&optional arg) | ||
| 948 | "A helpful replacement for `org-return'. | ||
| 949 | When called interactively with \\[universal-argument], call `org-return' | ||
| 950 | itself. Other values of ARG will call `newline' with that ARG." | ||
| 951 | (interactive "P") | ||
| 952 | ;; Auto-fill if enabled | ||
| 953 | (when auto-fill-function | ||
| 954 | (dolist (func (ensure-list auto-fill-function)) | ||
| 955 | (funcall func))) | ||
| 956 | (cl-letf* ((el (org-element-at-point)) | ||
| 957 | ((symbol-function 'el-child-of) | ||
| 958 | (lambda (&rest types) | ||
| 959 | (org-element-lineage el types t)))) | ||
| 960 | (cond ; Figure out what we're going to do | ||
| 961 | (arg ; Handle prefix ARG | ||
| 962 | (pcase arg | ||
| 963 | ('(4) (org-return t nil t)) | ||
| 964 | (_ (newline arg t)))) | ||
| 965 | ((and org-return-follows-link ; Open a link | ||
| 966 | (el-child-of 'link)) | ||
| 967 | (org-open-at-point-global)) | ||
| 968 | ((org-at-heading-p) ; Open a paragraph after a heading | ||
| 969 | (let ((heading-start (org-entry-beginning-position))) | ||
| 970 | (goto-char (org-entry-end-position)) | ||
| 971 | (cond ((and (org-at-heading-p) ; Entry is only a heading | ||
| 972 | (= heading-start (org-entry-beginning-position))) | ||
| 973 | (end-of-line) | ||
| 974 | (newline 2)) | ||
| 975 | (:else ; Entry is more than a heading | ||
| 976 | (forward-line -1) | ||
| 977 | (end-of-line) | ||
| 978 | (when (org-at-heading-p) | ||
| 979 | ;; Open a paragraph | ||
| 980 | (forward-line) | ||
| 981 | (newline) | ||
| 982 | (forward-line -1)) | ||
| 983 | (while (not (looking-back "\\(?:[[:blank:]]?\n\\)\\{3\\}" nil)) | ||
| 984 | (newline)) | ||
| 985 | (forward-line -1))))) | ||
| 986 | ((org-at-item-checkbox-p) ; Insert a new checkbox item | ||
| 987 | (end-of-line) | ||
| 988 | (org-insert-todo-heading nil)) | ||
| 989 | ((org-in-item-p) ; Insert a new list item | ||
| 990 | (let* ((context (org-element-context el)) | ||
| 991 | (first-item-p (eq 'plain-list (car context))) | ||
| 992 | (itemp (eq 'item (car context))) | ||
| 993 | (emptyp (or | ||
| 994 | ;; This (regular) list item is empty | ||
| 995 | (eq (org-element-property :contents-begin context) | ||
| 996 | (org-element-property :contents-end context)) | ||
| 997 | ;; This (definition) list item is empty | ||
| 998 | (looking-at " *::"))) | ||
| 999 | (item-child-p (el-child-of 'item))) | ||
| 1000 | (cond ((and itemp emptyp) | ||
| 1001 | ;; This test has to be here even though it's the same as the | ||
| 1002 | ;; :else clause, because an item that's empty will also satisfy | ||
| 1003 | ;; the next clause. | ||
| 1004 | (delete-region (line-beginning-position) (line-end-position)) | ||
| 1005 | (newline)) | ||
| 1006 | ((or first-item-p | ||
| 1007 | (and itemp (not emptyp)) | ||
| 1008 | item-child-p) | ||
| 1009 | (org-end-of-item) | ||
| 1010 | (org-insert-item)) | ||
| 1011 | (:else | ||
| 1012 | (delete-region (line-beginning-position) (line-end-position)) | ||
| 1013 | (newline))))) | ||
| 1014 | ((and (fboundp 'org-inlinetask-in-task-p) ; Just return for inline tasks | ||
| 1015 | (org-inlinetask-in-task-p)) | ||
| 1016 | (org-return)) | ||
| 1017 | ((org-at-table-p) ; Insert a new table row | ||
| 1018 | (cond ((save-excursion ; Empty row: end the table | ||
| 1019 | (beginning-of-line) | ||
| 1020 | (cl-loop with end = (line-end-position) | ||
| 1021 | for cell = (org-element-table-cell-parser) | ||
| 1022 | always (eq (org-element-property :contents-begin cell) | ||
| 1023 | (org-element-property :contents-end cell)) | ||
| 1024 | while (re-search-forward "|" end t))) | ||
| 1025 | (delete-region (line-beginning-position) (line-end-position)) | ||
| 1026 | (org-return)) | ||
| 1027 | (:else ; Non-empty row | ||
| 1028 | (org-return)))) | ||
| 1029 | (:else ; Something else | ||
| 1030 | (org-return))))) | ||
| 1031 | |||
| 1032 | (defun org-table-copy-down|org-return-dwim (&optional n) | ||
| 1033 | "Call `org-table-copy-down' or `+org-return' depending on context." | ||
| 1034 | (interactive "P") | ||
| 1035 | (if (org-table-check-inside-data-field 'noerror) | ||
| 1036 | (org-table-copy-down (or n 1)) | ||
| 1037 | (org-return-dwim n))) | ||
| 1038 | |||
| 1039 | (defmacro org-insert-or-surround (character) | ||
| 1040 | (let ((c (gensym))) | ||
| 1041 | `(defun ,(intern (format "org-insert-or-surround-%s" character)) (arg) | ||
| 1042 | ,(format "Insert %s or surround the region with it." character) | ||
| 1043 | (interactive "p") | ||
| 1044 | (let ((,c ,(if (stringp character) | ||
| 1045 | (string-to-char character) | ||
| 1046 | character))) | ||
| 1047 | (if (org-region-active-p) | ||
| 1048 | (let ((begin (region-beginning)) | ||
| 1049 | (end (region-end))) | ||
| 1050 | (save-mark-and-excursion | ||
| 1051 | (deactivate-mark) | ||
| 1052 | (goto-char begin) | ||
| 1053 | (self-insert-command arg ,c) | ||
| 1054 | (goto-char (+ 1 end)) | ||
| 1055 | (self-insert-command arg ,c))) | ||
| 1056 | (self-insert-command arg ,c)))))) | ||
| 1057 | |||
| 1058 | (with-eval-after-load 'org | ||
| 1059 | (keymap-set org-mode-map "RET" #'org-return-dwim) | ||
| 1060 | (keymap-set org-mode-map "S-<return>" #'org-table-copy-down|org-return-dwim) | ||
| 1061 | (keymap-set org-mode-map "*" (org-insert-or-surround "*")) | ||
| 1062 | (keymap-set org-mode-map "/" (org-insert-or-surround "/")) | ||
| 1063 | (keymap-set org-mode-map "_" (org-insert-or-surround "_")) | ||
| 1064 | (keymap-set org-mode-map "=" (org-insert-or-surround "=")) | ||
| 1065 | (keymap-set org-mode-map "~" (org-insert-or-surround "~")) | ||
| 1066 | (keymap-set org-mode-map "+" (org-insert-or-surround "+"))) | ||
| 1067 | |||
| 1068 | ;; Copy rich text to the keyboard | ||
| 1069 | (defcustom clipboard-html-copy-program | ||
| 1070 | (if (or (equal "wayland" | ||
| 1071 | (getenv "XDG_SESSION_TYPE")) | ||
| 1072 | (getenv "WAYLAND_DISPLAY")) | ||
| 1073 | '("wl-copy" "-t" "text/html") | ||
| 1074 | '("xclip" "-t" "text/html" "-selection" "clipboard")) | ||
| 1075 | "Program to use to copy HTML to the clipboard. | ||
| 1076 | Should be a list of strings---the command line. | ||
| 1077 | Defaults to 'wl-copy' on wayland and 'xclip' on Xorg." | ||
| 1078 | :type '(repeat string)) | ||
| 1079 | |||
| 1080 | (defun org-export-html-copy (&rest org-export-args) | ||
| 1081 | "Export current org buffer to HTML and copy to clipboard as rich text. | ||
| 1082 | ORG-EXPORT-ARGS are passed to `org-export-to-buffer'." | ||
| 1083 | (let ((buf (generate-new-buffer "*org-html-clipboard*" t))) | ||
| 1084 | (apply #'org-export-to-buffer 'html buf org-export-args) | ||
| 1085 | (with-current-buffer buf | ||
| 1086 | (apply #'call-process-region | ||
| 1087 | (point-min) | ||
| 1088 | (point-max) | ||
| 1089 | (car clipboard-html-copy-program) | ||
| 1090 | nil ; don't delete text | ||
| 1091 | nil ; discard the output | ||
| 1092 | nil ; don't redisplay | ||
| 1093 | (cdr clipboard-html-copy-program)) | ||
| 1094 | (kill-buffer-and-window)) | ||
| 1095 | (message "HTML copied to clipboard."))) | ||
| 1096 | |||
| 1097 | (defun org-subtree-to-html-to-clipboard () | ||
| 1098 | "Export current subtree to HTML." | ||
| 1099 | (interactive) | ||
| 1100 | (org-export-html-copy nil :subtree)) | ||
| 1101 | |||
| 1102 | ;; (info "(org) Breaking Down Tasks") | ||
| 1103 | (defun org-summary-todo (n-done n-not-done) | ||
| 1104 | "Switch entry to DONE when all subentries are done, to TODO otherwise." | ||
| 1105 | (let (org-log-done org-log-states) ; turn off logging | ||
| 1106 | (org-todo (if (= n-not-done 0) "DONE" "TODO")))) | ||
| 1107 | (add-hook 'org-after-todo-statistics-hook #'org-summary-todo) | ||
| 1108 | |||
| 1109 | ;; Clean up the buffer view | ||
| 1110 | (defun org-hide-drawers-except-point () | ||
| 1111 | "Hide all drawers except for the one point is in." | ||
| 1112 | ;; Most of this bit is taken from `org-fold--hide-drawers'. | ||
| 1113 | (let ((pt (point)) | ||
| 1114 | (begin (point-min)) | ||
| 1115 | (end (point-max))) | ||
| 1116 | (save-excursion | ||
| 1117 | (goto-char begin) | ||
| 1118 | (while (and (< (point) end) | ||
| 1119 | (re-search-forward org-drawer-regexp end t)) | ||
| 1120 | (if (org-fold-folded-p nil 'drawer) | ||
| 1121 | (goto-char (org-fold-next-folding-state-change 'drawer nil end)) | ||
| 1122 | (let* ((drawer (org-element-at-point)) | ||
| 1123 | (type (org-element-type drawer)) | ||
| 1124 | (el-begin (org-element-property :begin drawer)) | ||
| 1125 | (el-end (org-element-property :end drawer))) | ||
| 1126 | (when (memq type '(drawer property-drawer)) | ||
| 1127 | (org-fold-hide-drawer-toggle | ||
| 1128 | (if (< el-begin pt el-end) 'off 'on) | ||
| 1129 | nil drawer) | ||
| 1130 | (goto-char el-end)))))))) | ||
| 1131 | (add-local-mode-hook 'org-mode-hook 'before-save-hook | ||
| 1132 | #'org-hide-drawers-except-point) | ||
| 1133 | |||
| 1134 | ;; Fix braindead behavior | ||
| 1135 | (with-eval-after-load 'org-mouse | ||
| 1136 | (defun org--mouse-open-at-point (orig-fun &rest args) | ||
| 1137 | (let ((context (org-context))) | ||
| 1138 | (cond | ||
| 1139 | ;; Don't org-cycle when clicking on headline stars. The biggest problem | ||
| 1140 | ;; is that this function advises `org-open-at-point', so I can't C-c C-o | ||
| 1141 | ;; from a headline star. | ||
| 1142 | ;; ((assq :headline-stars context) (org-cycle)) | ||
| 1143 | ((assq :checkbox context) (org-toggle-checkbox)) | ||
| 1144 | ((assq :item-bullet context) | ||
| 1145 | (let ((org-cycle-include-plain-lists t)) (org-cycle))) | ||
| 1146 | ((org-footnote-at-reference-p) nil) | ||
| 1147 | (t (apply orig-fun args)))))) | ||
| 1148 | |||
| 1149 | (defun define-org-capture-template (description &rest args) | ||
| 1150 | "Define an template for `org-capture-templates'. | ||
| 1151 | Will not replace an existing template unless `:force' in ARGS is | ||
| 1152 | non-nil. ARGS is a plist, which in addition to the additional | ||
| 1153 | options `org-capture-templates' accepts (which see), also accepts | ||
| 1154 | the following: `:keys', `:description', `:type', `:target', and | ||
| 1155 | `:template'." | ||
| 1156 | (declare (indent 1)) | ||
| 1157 | (let* ((keys (plist-get args :keys)) | ||
| 1158 | (type (plist-get args :type)) | ||
| 1159 | (target (plist-get args :target)) | ||
| 1160 | (template (plist-get args :template)) | ||
| 1161 | (force (plist-get args :force)) | ||
| 1162 | (template-value | ||
| 1163 | (append | ||
| 1164 | (list description) | ||
| 1165 | (when (or type target template) | ||
| 1166 | (list (or type 'entry) target template)) | ||
| 1167 | (cl-loop for i from 0 below (length args) by 2 | ||
| 1168 | unless (member (nth i args) | ||
| 1169 | '( :keys :description :type | ||
| 1170 | :target :template)) | ||
| 1171 | append (list (nth i args) | ||
| 1172 | (plist-get args (nth i args))))))) | ||
| 1173 | (if (seq-find (lambda (el) (equal (car el) keys)) | ||
| 1174 | org-capture-templates) | ||
| 1175 | (and force | ||
| 1176 | (setf (alist-get keys org-capture-templates nil nil #'equal) | ||
| 1177 | template-value)) | ||
| 1178 | (setf org-capture-templates | ||
| 1179 | (append org-capture-templates | ||
| 1180 | (list (cons keys template-value))))) | ||
| 1181 | org-capture-templates)) | ||
| 1182 | |||
| 1183 | (add-hook 'org-mode-hook | ||
| 1184 | (defun org-mode-line-position () | ||
| 1185 | (setq-local mode-line-position | ||
| 1186 | '((:propertize | ||
| 1187 | ("" mode-line-percent-position) | ||
| 1188 | local-map mode-line-column-line-number-mode-map | ||
| 1189 | display (min-width (5.0))) | ||
| 1190 | (org-word-count-mode org-word-count-string)))) | ||
| 1191 | (setq mode-line-misc-info | ||
| 1192 | (delete '(org-word-count-mode org-word-count-string) | ||
| 1193 | mode-line-misc-info))) | ||
| 1194 | |||
| 1195 | ;;; Org word count | ||
| 1196 | ;; also does Flesch-Kincaid reading level. | ||
| 1197 | ;; TODO: customization ... stuff. | ||
| 1198 | |||
| 1199 | (defun fk-region (start end) | ||
| 1200 | (interactive "r") | ||
| 1201 | ;; (let* ((fk-buf (get-buffer-create " *fk*")) | ||
| 1202 | ;; (fk-proc | ||
| 1203 | ;; (start-process "fk" fk-buf "/home/acdw/src/fk/fk.perl"))) | ||
| 1204 | ;; (set-process-sentinel fk-proc #'ignore) | ||
| 1205 | ;; (process-send-region fk-proc start end) | ||
| 1206 | ;; (process-send-eof fk-proc) | ||
| 1207 | ;; (with-current-buffer fk-buf | ||
| 1208 | ;; (goto-char (point-max)) | ||
| 1209 | ;; (forward-line -1) | ||
| 1210 | ;; (string-chop-newline (buffer-substring-no-properties | ||
| 1211 | ;; (line-beginning-position) (point-max))))) | ||
| 1212 | |||
| 1213 | (let ((shell-command-buffer-name (format " *fk/%s*" (buffer-name)))) | ||
| 1214 | (shell-command-on-region start end "~/src/fk/fk.perl") | ||
| 1215 | (with-current-buffer shell-command-buffer-name | ||
| 1216 | (buffer-substring-no-properties (point-min) (- (point-max) 1)))) | ||
| 1217 | ) | ||
| 1218 | |||
| 1219 | (defun org-word-count-region (start end &optional interactive) | ||
| 1220 | (interactive "r\np") | ||
| 1221 | (when (derived-mode-p 'org-mode) | ||
| 1222 | (save-window-excursion | ||
| 1223 | (inhibit-messages | ||
| 1224 | (let ((shell-command-buffer-name (format " *wc/%s*" (buffer-name))) | ||
| 1225 | wc fk) | ||
| 1226 | (shell-command-on-region start end | ||
| 1227 | "pandoc -t plain -f org") | ||
| 1228 | (with-current-buffer shell-command-buffer-name | ||
| 1229 | (setq wc (count-words (point-min) (point-max))) | ||
| 1230 | (setq fk (string-to-number (fk-region (point-min) (point-max))))) | ||
| 1231 | (when interactive (message "%s" wc)) | ||
| 1232 | (list wc fk)))))) | ||
| 1233 | |||
| 1234 | (defvar-local org-word-count-string "" | ||
| 1235 | "Number of words in buffer.") | ||
| 1236 | |||
| 1237 | (defun update-org-word-count-string () | ||
| 1238 | (when (derived-mode-p 'org-mode) | ||
| 1239 | (setq org-word-count-string | ||
| 1240 | (apply #'format " %dw/%.2ffk" | ||
| 1241 | (org-word-count-region (point-min) (point-max)))))) | ||
| 1242 | |||
| 1243 | (defvar org-word-count-timer nil | ||
| 1244 | "Timer for `org-word-count'.") | ||
| 1245 | |||
| 1246 | (define-minor-mode org-word-count-mode | ||
| 1247 | "Count words and update the org-word-count-string." | ||
| 1248 | :lighter " owc" | ||
| 1249 | (cond | ||
| 1250 | ((and (derived-mode-p 'org-mode) | ||
| 1251 | org-word-count-mode) | ||
| 1252 | (unless (timerp org-word-count-timer) | ||
| 1253 | (setq org-word-count-timer | ||
| 1254 | (run-with-idle-timer 1 t #'update-org-word-count-string)))) | ||
| 1255 | (:else | ||
| 1256 | (when (timerp org-word-count-timer) | ||
| 1257 | (cancel-timer org-word-count-timer)) | ||
| 1258 | (setq org-word-count-timer nil) | ||
| 1259 | (setq org-word-count-mode nil)))) | ||
| 1260 | (hide-minor-mode 'org-word-count-mode) | ||
| 1261 | |||
| 1262 | (add-hook 'org-mode-hook #'org-word-count-mode) | ||
| 1263 | |||
| 1264 | ;;; Org recentering | ||
| 1265 | |||
| 1266 | (defun org-recenter (&optional arg) | ||
| 1267 | (interactive "P") | ||
| 1268 | (if (or arg | ||
| 1269 | (eq last-command 'org-recenter)) | ||
| 1270 | (recenter-top-bottom arg) | ||
| 1271 | (save-excursion | ||
| 1272 | (unless (org-at-heading-p) | ||
| 1273 | (ignore-errors (org-previous-visible-heading 1))) | ||
| 1274 | (recenter-top-bottom 0)))) | ||
| 1275 | (with-eval-after-load 'org | ||
| 1276 | (keymap-set org-mode-map "C-l" #'org-recenter)) | ||
| 1277 | |||
| 1278 | ;;; Org links -- extra types | ||
| 1279 | |||
| 1280 | (with-eval-after-load 'ol | ||
| 1281 | (org-link-set-parameters "tel" :follow #'ignore) | ||
| 1282 | (org-link-set-parameters "sms" :follow #'ignore)) | ||
| 1283 | |||
| 1284 | |||
| 1285 | ;;; Jabber | ||
| 1286 | |||
| 1287 | ;; (when (package-ensure 'jabber t t) | ||
| 1288 | ;; (setopt jabber-chat-buffer-format "*%n*") | ||
| 1289 | ;; (setopt jabber-browse-buffer-format "*%n*") | ||
| 1290 | ;; (setopt jabber-groupchat-buffer-format "*%n*") | ||
| 1291 | ;; (setopt jabber-muc-private-buffer-format "*%n*") | ||
| 1292 | |||
| 1293 | ;; (face-spec-set 'jabber-activity-face | ||
| 1294 | ;; '((t :inherit jabber-chat-prompt-foreign | ||
| 1295 | ;; :foreground unspecified | ||
| 1296 | ;; :weight normal))) | ||
| 1297 | ;; (face-spec-set 'jabber-activity-personal-face | ||
| 1298 | ;; '((t :inherit jabber-chat-prompt-local | ||
| 1299 | ;; :foreground unspecified | ||
| 1300 | ;; :weight bold))) | ||
| 1301 | ;; (face-spec-set 'jabber-chat-prompt-local | ||
| 1302 | ;; '((t :inherit minibuffer-prompt | ||
| 1303 | ;; :foreground unspecified | ||
| 1304 | ;; :weight normal | ||
| 1305 | ;; :slant italic))) | ||
| 1306 | ;; (face-spec-set 'jabber-chat-prompt-foreign | ||
| 1307 | ;; '((t :inherit warning | ||
| 1308 | ;; :foreground unspecified | ||
| 1309 | ;; :weight normal))) | ||
| 1310 | ;; (face-spec-set 'jabber-chat-prompt-system | ||
| 1311 | ;; '((t :inherit font-lock-doc-face | ||
| 1312 | ;; :foreground unspecified))) | ||
| 1313 | ;; (face-spec-set 'jabber-rare-time-face | ||
| 1314 | ;; '((t :inherit font-lock-comment-face | ||
| 1315 | ;; :foreground unspecified | ||
| 1316 | ;; :underline nil))) | ||
| 1317 | |||
| 1318 | ;; (setopt jabber-auto-reconnect t) | ||
| 1319 | ;; (setopt jabber-last-read-marker | ||
| 1320 | ;; "-------------------------------------------------------------------") | ||
| 1321 | ;; (setopt jabber-muc-decorate-presence-patterns | ||
| 1322 | ;; '(("\\( enters the room ([^)]+)\\| has left the chatroom\\)$" . nil) | ||
| 1323 | ;; ("Mode #.*" . jabber-muc-presence-dim) | ||
| 1324 | ;; ("." . jabber-muc-presence-dim))) | ||
| 1325 | ;; (setopt jabber-activity-make-strings #'jabber-activity-make-strings-shorten) | ||
| 1326 | ;; (setopt jabber-rare-time-format | ||
| 1327 | ;; (format " - - - - - %%H:%d %%F" | ||
| 1328 | ;; (let ((min (string-to-number (format-time-string "%M")))) | ||
| 1329 | ;; (* 5 (floor min 5))))) | ||
| 1330 | ;; (setopt jabber-muc-header-line-format '(" " jabber-muc-topic)) | ||
| 1331 | |||
| 1332 | ;; (setopt jabber-groupchat-prompt-format "%n. ") | ||
| 1333 | ;; (setopt jabber-chat-local-prompt-format "%n. ") | ||
| 1334 | ;; (setopt jabber-chat-foreign-prompt-format "%n. ") | ||
| 1335 | ;; (setopt jabber-muc-private-foreign-prompt-format "%g/%n. ") | ||
| 1336 | |||
| 1337 | ;; (defun jabber-connect-all* (&optional arg) | ||
| 1338 | ;; "Connect to all defined jabber accounts. | ||
| 1339 | ;; If called with ARG non-nil, or with \\[universal-argument], | ||
| 1340 | ;; disconnect first." | ||
| 1341 | ;; (interactive "P") | ||
| 1342 | ;; (when arg (jabber-disconnect)) | ||
| 1343 | ;; (jabber-connect-all)) | ||
| 1344 | |||
| 1345 | ;; (with-eval-after-load 'jabber | ||
| 1346 | ;; (keymap-global-set "C-c C-SPC" #'jabber-activity-switch-to) | ||
| 1347 | ;; (require 'jabber-httpupload nil t) | ||
| 1348 | ;; (map-keymap (lambda (key command) | ||
| 1349 | ;; (define-key jabber-global-keymap (vector (+ key #x60)) command)) | ||
| 1350 | ;; jabber-global-keymap) | ||
| 1351 | ;; (keymap-global-set "C-x C-j" #'dired-jump) | ||
| 1352 | ;; (keymap-set jabber-global-keymap "c" #'jabber-connect-all*) | ||
| 1353 | ;; (keymap-global-set "C-c j" jabber-global-keymap)) | ||
| 1354 | |||
| 1355 | ;; (remove-hook 'jabber-alert-muc-hooks #'jabber-muc-echo) | ||
| 1356 | ;; (remove-hook 'jabber-alert-presence-hooks #'jabber-presence-echo) | ||
| 1357 | ;; (add-hook 'jabber-post-connect-hooks #'jabber-enable-carbons) | ||
| 1358 | ;; (add-hook 'jabber-chat-mode-hook #'olivetti-mode) | ||
| 1359 | ;; (add-hook 'jabber-chat-mode-hook | ||
| 1360 | ;; (defun jabber-chat-mode-no-position () | ||
| 1361 | ;; (setq-local mode-line-position nil))) | ||
| 1362 | ;; (add-hook 'jabber-alert-muc-hooks | ||
| 1363 | ;; (defun jabber@highlight-acdw (&optional _ _ buf _ _) | ||
| 1364 | ;; (when buf | ||
| 1365 | ;; (with-current-buffer buf | ||
| 1366 | ;; (let ((regexp (rx word-boundary | ||
| 1367 | ;; "acdw" ; maybe get from the config? | ||
| 1368 | ;; word-boundary))) | ||
| 1369 | ;; (hi-lock-unface-buffer regexp) | ||
| 1370 | ;; (highlight-regexp regexp 'jabber-chat-prompt-local)))))) | ||
| 1371 | |||
| 1372 | ;; (add-hook 'jabber-chat-mode-hook | ||
| 1373 | ;; (defun electric-pair-local-disable () | ||
| 1374 | ;; (electric-pair-local-mode -1))) | ||
| 1375 | |||
| 1376 | ;; (when (fboundp 'jabber-chat-update-focus) | ||
| 1377 | ;; (add-hook 'window-configuration-change-hook #'jabber-chat-update-focus))) | ||
| 1378 | |||
| 1379 | |||
| 1380 | ;;; Dired | ||
| 1381 | |||
| 1382 | (keymap-global-set "C-x C-j" #'dired-jump) | ||
| 1383 | (with-eval-after-load 'dired | ||
| 1384 | (keymap-set dired-mode-map "C-j" #'dired-up-directory)) | ||
| 1385 | |||
| 1386 | (setopt dired-auto-revert-buffer t) | ||
| 1387 | (setopt dired-dwim-target t) ; dired-dwim-target-next ? | ||
| 1388 | |||
| 1389 | |||
| 1390 | ;;; Browsing the web | ||
| 1391 | |||
| 1392 | (setopt browse-url-browser-function #'eww-browse-url) | ||
| 1393 | |||
| 1394 | (defcustom browse-url-safe-browser-functions nil | ||
| 1395 | "\"Safe\" browser functions." | ||
| 1396 | :type '(repeat-function)) | ||
| 1397 | |||
| 1398 | (defun browse-url-browser-function-safe-p (fn) | ||
| 1399 | "Return t if FN is a \"safe\" browser function." | ||
| 1400 | (memq fn (append browse-url-safe-browser-functions | ||
| 1401 | (mapcar (lambda (i) | ||
| 1402 | (plist-get (cdr i) :value)) | ||
| 1403 | (seq-filter (lambda (i) | ||
| 1404 | (eq (car i) 'function-item)) | ||
| 1405 | (cdr (get 'browse-url-browser-function | ||
| 1406 | 'custom-type))))))) | ||
| 1407 | |||
| 1408 | (put 'browse-url-browser-function 'safe-local-variable | ||
| 1409 | 'browse-url-browser-function-safe-p) | ||
| 1410 | |||
| 1411 | ;;; EWW | ||
| 1412 | |||
| 1413 | (setopt eww-use-browse-url ".") | ||
| 1414 | (setopt eww-auto-rename-buffer 'title) | ||
| 1415 | (setopt eww-default-download-directory | ||
| 1416 | (or (xdg-user-dir "DOWNLOAD") | ||
| 1417 | "~/Downloads")) | ||
| 1418 | (setopt eww-history-limit nil) | ||
| 1419 | |||
| 1420 | (defun eww-readable/olivetti () | ||
| 1421 | (interactive) | ||
| 1422 | (olivetti-mode +1) | ||
| 1423 | (eww-readable) | ||
| 1424 | (eww-reload t)) | ||
| 1425 | |||
| 1426 | (with-eval-after-load 'eww | ||
| 1427 | (keymap-set eww-mode-map "R" #'eww-readable/olivetti)) | ||
| 1428 | |||
| 1429 | ;; Use Emacs bookmarks for EWW | ||
| 1430 | (defun bookmark-eww--make () | ||
| 1431 | "Make eww bookmark record." | ||
| 1432 | `((filename . ,(plist-get eww-data :url)) | ||
| 1433 | (title . ,(plist-get eww-data :title)) | ||
| 1434 | (time . ,(current-time-string)) | ||
| 1435 | (handler . ,#'bookmark-eww-handler) | ||
| 1436 | (defaults . (,(concat | ||
| 1437 | ;; url without the https and path | ||
| 1438 | (replace-regexp-in-string | ||
| 1439 | "/.*" "" | ||
| 1440 | (replace-regexp-in-string | ||
| 1441 | "\\`https?://" "" | ||
| 1442 | (plist-get eww-data :url))) | ||
| 1443 | " - " | ||
| 1444 | ;; page title | ||
| 1445 | (replace-regexp-in-string | ||
| 1446 | "\\` +\\| +\\'" "" | ||
| 1447 | (replace-regexp-in-string | ||
| 1448 | "[\n\t\r ]+" " " | ||
| 1449 | (plist-get eww-data :title)))))))) | ||
| 1450 | |||
| 1451 | (defun bookmark-eww-handler (bm) | ||
| 1452 | "Handler for eww bookmarks." | ||
| 1453 | (eww-browse-url (alist-get 'filename bm))) | ||
| 1454 | |||
| 1455 | (defun bookmark-eww--setup () | ||
| 1456 | "Setup eww bookmark integration." | ||
| 1457 | (setq-local bookmark-make-record-function #'bookmark-eww--make)) | ||
| 1458 | (add-hook 'eww-mode-hook #'bookmark-eww--setup) | ||
| 1459 | |||
| 1460 | (with-eval-after-load 'eww | ||
| 1461 | (define-key eww-mode-map "b" #'bookmark-set) | ||
| 1462 | (define-key eww-mode-map "B" #'bookmark-jump)) | ||
| 1463 | |||
| 1464 | ;; Transforming URLs | ||
| 1465 | ;; `eww-transform-url' exists, but I like my package better. | ||
| 1466 | |||
| 1467 | (when (package-ensure 'browse-url-transform t) | ||
| 1468 | (setopt browse-url-transform-alist | ||
| 1469 | `(;; Privacy-respecting alternatives | ||
| 1470 | ("twitter\\.com" . "nitter.snopyta.org") | ||
| 1471 | ("\\(?:\\(?:old\\.\\)?reddit\\.com\\)" . "libreddit.de") | ||
| 1472 | ("medium\\.com" . "scribe.rip") | ||
| 1473 | ;; Text-mode of non-text-mode sites | ||
| 1474 | ("www\\.npr\\.org" . "text.npr.org") | ||
| 1475 | ;; Ask for raw versions of paste sites | ||
| 1476 | ("^.*dpaste\\.com.*$" . "\\&.txt") | ||
| 1477 | ("bpa\\.st/\\(.*\\)" . "bpa.st/raw/\\1") | ||
| 1478 | ("\\(paste\\.debian\\.net\\)/\\(.*\\)" . "\\1/plain/\\2") | ||
| 1479 | ("\\(pastebin\\.com\\)/\\\(.*\\)" . "\\1/raw/\\2") | ||
| 1480 | ("\\(paste\\.centos\\.org/view\\)/\\(.*\\)" . "\\1/raw/\\2"))) | ||
| 1481 | (browse-url-transform-mode) | ||
| 1482 | (hide-minor-mode 'browse-url-transform-mode)) | ||
| 1483 | |||
| 1484 | (with-eval-after-load 'browse-url-transform | ||
| 1485 | (setq eww-url-transformers ; `setopt' causes a warning about custom-type | ||
| 1486 | '(eww-remove-tracking | ||
| 1487 | browse-url-transform-url))) | ||
| 1488 | |||
| 1489 | ;; External browsers: firefox > chromium > chrome | ||
| 1490 | (setq browse-url-firefox-program | ||
| 1491 | (or (executable-find "firefox") | ||
| 1492 | (executable-find "firefox-esr")) | ||
| 1493 | browse-url-firefox-new-window-is-tab t | ||
| 1494 | browse-url-firefox-arguments '("--new-tab") | ||
| 1495 | |||
| 1496 | browse-url-chromium-program | ||
| 1497 | (or (executable-find "chromium") | ||
| 1498 | (executable-find "chromium-browser")) | ||
| 1499 | |||
| 1500 | browse-url-chrome-program | ||
| 1501 | (or (executable-find "chrome") | ||
| 1502 | (executable-find "google-chrome-stable")) | ||
| 1503 | |||
| 1504 | browse-url-secondary-browser-function | ||
| 1505 | (cond (browse-url-firefox-program #'browse-url-firefox) | ||
| 1506 | (browse-url-chromium-program #'browse-url-chromium) | ||
| 1507 | (browse-url-chrome-program #'browse-url-chrome) | ||
| 1508 | (t #'browse-url-default-browser))) | ||
| 1509 | |||
| 1510 | (defmacro open-url-with (commandline &optional buffer error-buffer) | ||
| 1511 | (let ((buffer (or buffer " *open-url-with*")) | ||
| 1512 | (error-buffer (or error-buffer " *open-url-with/errors*"))) | ||
| 1513 | `(lambda (url &rest _) | ||
| 1514 | (cl-letf (((alist-get ,buffer | ||
| 1515 | display-buffer-alist | ||
| 1516 | nil nil #'equal) | ||
| 1517 | '(display-buffer-no-window))) | ||
| 1518 | (async-shell-command (format ,commandline url) | ||
| 1519 | ,buffer | ||
| 1520 | ,error-buffer))))) | ||
| 1521 | |||
| 1522 | (defun add-browse-url-handler (regexp opener) | ||
| 1523 | "Add OPENER to open REGEXP urls." | ||
| 1524 | (setf/assoc browse-url-handlers | ||
| 1525 | regexp | ||
| 1526 | opener)) | ||
| 1527 | |||
| 1528 | (add-browse-url-handler (rx (or (: ".pdf" eos) | ||
| 1529 | (: ".PDF" eos))) | ||
| 1530 | (open-url-with "zathura %s")) | ||
| 1531 | (add-browse-url-handler (rx (or (: ".mp4" eos) | ||
| 1532 | "youtube.com" | ||
| 1533 | "piped.kavin.rocks")) | ||
| 1534 | (open-url-with "mpv %s")) | ||
| 1535 | |||
| 1536 | (when (package-ensure 'elpher) | ||
| 1537 | (add-browse-url-handler (rx bos "gemini:") | ||
| 1538 | #'elpher-browse-url-elpher)) | ||
| 1539 | |||
| 1540 | ;; Hinting at links | ||
| 1541 | (when (package-ensure 'link-hint) | ||
| 1542 | (setopt link-hint-avy-style 'at-full) | ||
| 1543 | (setopt link-hint-avy-all-windows t) | ||
| 1544 | (defvar link-hint-map | ||
| 1545 | (define-keymap | ||
| 1546 | :name "Open a link" | ||
| 1547 | :prefix 'link-hint-map | ||
| 1548 | "M-l" #'link-hint-open-link | ||
| 1549 | "M-w" #'link-hint-copy-link)) | ||
| 1550 | (keymap-global-set "M-l" 'link-hint-map)) | ||
| 1551 | |||
| 1552 | |||
| 1553 | ;;; Eshell | ||
| 1554 | |||
| 1555 | (setopt eshell-modules-list | ||
| 1556 | '(eshell-alias | ||
| 1557 | eshell-banner | ||
| 1558 | eshell-basic | ||
| 1559 | eshell-cmpl | ||
| 1560 | eshell-dirs | ||
| 1561 | eshell-elecslash | ||
| 1562 | eshell-extpipe | ||
| 1563 | eshell-glob | ||
| 1564 | eshell-hist | ||
| 1565 | eshell-ls | ||
| 1566 | eshell-pred | ||
| 1567 | eshell-prompt | ||
| 1568 | eshell-script | ||
| 1569 | eshell-smart | ||
| 1570 | eshell-unix)) | ||
| 1571 | |||
| 1572 | (setopt eshell-banner-message "") | ||
| 1573 | (setopt eshell-destroy-buffer-when-process-dies t) | ||
| 1574 | (setopt eshell-error-if-no-glob t) | ||
| 1575 | (setopt eshell-hist-ignoredups 'erase) | ||
| 1576 | (setopt eshell-kill-on-exit t) | ||
| 1577 | (setopt eshell-prefer-lisp-functions t) | ||
| 1578 | (setopt eshell-prefer-lisp-variables t) | ||
| 1579 | (setopt eshell-scroll-to-bottom-on-input 'this) | ||
| 1580 | (setopt eshell-history-size 1024) | ||
| 1581 | (setopt eshell-input-filter (lambda (input) | ||
| 1582 | (or (eshell-input-filter-default input) | ||
| 1583 | (eshell-input-filter-initial-space input)))) | ||
| 1584 | (setopt eshell-prompt-function | ||
| 1585 | (lambda () | ||
| 1586 | (concat (if (= 0 eshell-last-command-status) | ||
| 1587 | "^_^" | ||
| 1588 | ";_;") | ||
| 1589 | " " | ||
| 1590 | (abbreviate-file-name (eshell/pwd)) | ||
| 1591 | (if (= (user-uid) 0) | ||
| 1592 | " # " | ||
| 1593 | " $ ")))) | ||
| 1594 | (setopt eshell-scroll-to-bottom-on-input 'this) | ||
| 1595 | |||
| 1596 | (add-hook 'eshell-mode-hook | ||
| 1597 | (defun eshell-setup () | ||
| 1598 | (setq-local outline-regexp eshell-prompt-regexp) | ||
| 1599 | (setq-local page-delimiter eshell-prompt-regexp) | ||
| 1600 | (setq-local imenu-generic-expression | ||
| 1601 | '(("Prompt" " \\($\\|#\\) \\(.*\\)" 2))) | ||
| 1602 | (setq-local truncate-lines t))) | ||
| 1603 | |||
| 1604 | (setenv "PAGER" (executable-find "cat")) | ||
| 1605 | |||
| 1606 | (setopt eshell-where-to-jump 'begin) | ||
| 1607 | (setopt eshell-review-quick-commands nil) | ||
| 1608 | (setopt eshell-smart-space-goes-to-end t) | ||
| 1609 | |||
| 1610 | (when (package-ensure 'eat) | ||
| 1611 | (add-hook 'eshell-first-time-mode-hook #'eat-eshell-mode) | ||
| 1612 | (with-eval-after-load 'eat | ||
| 1613 | (keymap-unset eat-eshell-semi-char-mode-map "M-o" t))) | ||
| 1614 | |||
| 1615 | (if (package-ensure 'eshell-toggle) | ||
| 1616 | (keymap-global-set "C-z" #'eshell-toggle) | ||
| 1617 | ;; If the package doesn't load for some reason, do the dumb thing instead | ||
| 1618 | (defun eshellp (buffer-or-name) | ||
| 1619 | (with-current-buffer buffer-or-name | ||
| 1620 | (derived-mode-p 'eshell-mode))) | ||
| 1621 | |||
| 1622 | (defun eshell-pop-up (&optional arg) | ||
| 1623 | "Pop up an eshell in the `default-directory'. | ||
| 1624 | NEW is passed to `eshell'." | ||
| 1625 | (interactive "P") | ||
| 1626 | (require 'eshell) | ||
| 1627 | (let ((dir default-directory) | ||
| 1628 | (display-comint-buffer-action 'pop-to-buffer)) | ||
| 1629 | (if-let ((buf (and (not arg) | ||
| 1630 | (or (get-buffer eshell-buffer-name) | ||
| 1631 | (seq-find #'eshellp (reverse (buffer-list))))))) | ||
| 1632 | (pop-to-buffer buf) | ||
| 1633 | (eshell arg)) | ||
| 1634 | ;; In the eshell buffer | ||
| 1635 | (unless (file-equal-p default-directory dir) | ||
| 1636 | (eshell/cd dir) | ||
| 1637 | (eshell-send-input) | ||
| 1638 | (goto-char (point-max))))) | ||
| 1639 | |||
| 1640 | (keymap-global-set "C-z" #'eshell-pop-up) | ||
| 1641 | (with-eval-after-load 'esh-mode | ||
| 1642 | (keymap-set eshell-mode-map "C-z" #'quit-window))) | ||
| 1643 | |||
| 1644 | (when (package-ensure 'wiki-abbrev t) | ||
| 1645 | (wiki-abbrev-insinuate) | ||
| 1646 | (add-hook 'text-mode-hook #'abbrev-mode)) | ||
| 1647 | |||
| 1648 | ;;; Dinghie | ||
| 1649 | |||
| 1650 | (add-to-list 'mode-line-misc-info | ||
| 1651 | '(buffer-ding-cookie (:propertize buffer-ding-cookie | ||
| 1652 | face error)) | ||
| 1653 | :append) | ||
| 1654 | |||
| 1655 | (defvar buffer-ding-timer nil | ||
| 1656 | "Timer for `buffer-ding'.") | ||
| 1657 | (defvar buffer-ding-cookie nil | ||
| 1658 | "Variable to hold the `face-remap-add-relative' cookie.") | ||
| 1659 | (defcustom buffer-ding-timeout 0.25 | ||
| 1660 | "How long to ding the buffer for.") | ||
| 1661 | |||
| 1662 | (defun buffer-unding () | ||
| 1663 | "Unflash the buffer after done `ding'ing." | ||
| 1664 | ;; (face-remap-remove-relative buffer-ding-cookie) | ||
| 1665 | (setq buffer-ding-cookie nil) | ||
| 1666 | (force-mode-line-update t)) | ||
| 1667 | |||
| 1668 | (defun buffer-ding () | ||
| 1669 | "Flash the buffer for `ding'." | ||
| 1670 | (cond | ||
| 1671 | ((timerp buffer-ding-timer) | ||
| 1672 | (cancel-timer buffer-ding-timer) | ||
| 1673 | (setq buffer-ding-timer nil) | ||
| 1674 | (buffer-ding)) | ||
| 1675 | ((and (null buffer-ding-timer) | ||
| 1676 | buffer-ding-cookie) | ||
| 1677 | (setq buffer-ding-cookie nil) | ||
| 1678 | (buffer-unding)) | ||
| 1679 | (t | ||
| 1680 | ;; (setq buffer-ding-cookie (face-remap-add-relative 'default 'error)) | ||
| 1681 | (setq buffer-ding-cookie " Ding!") | ||
| 1682 | (force-mode-line-update) | ||
| 1683 | (run-with-timer buffer-ding-timeout nil #'buffer-unding)))) | ||
| 1684 | |||
| 1685 | ;; (setopt ring-bell-function (lambda () (pulse-momentary-highlight-region | ||
| 1686 | ;; (window-start) (window-end)))) | ||
| 1687 | |||
| 1688 | (setopt ring-bell-function #'buffer-ding) | ||
| 1689 | (add-hook 'isearch-mode-end-hook #'buffer-unding) | ||
| 1690 | |||
| 1691 | (defun mapc-buffers (fn &rest modes) | ||
| 1692 | (cl-loop for buf being the buffers | ||
| 1693 | do (with-current-buffer buf | ||
| 1694 | (when (or (null modes) | ||
| 1695 | (apply #'derived-mode-p modes)) | ||
| 1696 | (funcall fn))))) | ||
| 1697 | |||
| 1698 | (defun mapc-buffers/progress (msg fn &rest modes) | ||
| 1699 | (dolist-with-progress-reporter (buf (buffer-list)) msg | ||
| 1700 | (with-current-buffer buf | ||
| 1701 | (when (or (null modes) | ||
| 1702 | (apply #'derived-mode-p modes)) | ||
| 1703 | (funcall fn))))) | ||
| 1704 | |||
| 1705 | ;;; Flash! | ||
| 1706 | |||
| 1707 | (defun flash-region@ (orig start end &rest args) | ||
| 1708 | (apply orig start end args) | ||
| 1709 | (pulse-momentary-highlight-region start end)) | ||
| 1710 | |||
| 1711 | (advice-add 'eval-region :around #'flash-region@) | ||
| 1712 | (with-eval-after-load 'geiser | ||
| 1713 | (advice-add 'geiser-eval-region :around #'flash-region@)) | ||
| 1714 | |||
| 1715 | ;;; KeepassXC Integration | ||
| 1716 | |||
| 1717 | (when (package-ensure 'keepassxc-shim t) | ||
| 1718 | (keepassxc-shim-activate)) | ||
| 1719 | |||
| 1720 | ;;; RCIRC | ||
| 1721 | |||
| 1722 | (when (require 'rcirc) | ||
| 1723 | (setopt rcirc-default-full-name user-full-name) | ||
| 1724 | (setopt rcirc-default-user-name user-login-name) | ||
| 1725 | (setopt rcirc-authenticate-before-join t) | ||
| 1726 | (setopt rcirc-display-server-buffer nil) | ||
| 1727 | (setopt rcirc-buffer-maximum-lines 1000) | ||
| 1728 | (setopt rcirc-kill-channel-buffers t) | ||
| 1729 | (setopt rcirc-track-ignore-server-buffer-flag t) | ||
| 1730 | |||
| 1731 | ;; Theming | ||
| 1732 | (setopt rcirc-prompt "%t> ") | ||
| 1733 | (setopt rcirc-default-part-reason "See You Space Cowboy . . .") | ||
| 1734 | (setopt rcirc-default-quit-reason "(TLS connection improperly terminated)") | ||
| 1735 | (setopt rcirc-url-max-length 24) | ||
| 1736 | (setopt rcirc-response-formats | ||
| 1737 | '(("PRIVMSG" . "<%N> %m") | ||
| 1738 | ("NOTICE" . "-%N- %m") | ||
| 1739 | ("ACTION" . "* %N %m") | ||
| 1740 | ("COMMAND" . "%fs%m%f-") | ||
| 1741 | ("ERROR" . "%fw!!! %m") | ||
| 1742 | ("FAIL" . "(%fwFAIL%f-) %m") | ||
| 1743 | ("WARN" . "(%fwWARN%f-) %m") | ||
| 1744 | ("NOTE" . "(%fwNOTE%f-) %m") | ||
| 1745 | (t . "%fp*** %fs%n %r %m"))) | ||
| 1746 | |||
| 1747 | (face-spec-set 'rcirc-nick-in-message-full-line | ||
| 1748 | '((t :foreground unspecified | ||
| 1749 | :background unspecified | ||
| 1750 | :weight unspecified | ||
| 1751 | :inherit nil))) | ||
| 1752 | |||
| 1753 | (add-to-list 'rcirc-omit-responses "NAMES") | ||
| 1754 | |||
| 1755 | (defun chat/setup () | ||
| 1756 | (whitespace-mode -1) | ||
| 1757 | (electric-pair-local-mode -1) | ||
| 1758 | ;; IDK what's the deal with this | ||
| 1759 | (olivetti-mode +1) | ||
| 1760 | (visual-line-mode -1) | ||
| 1761 | (word-wrap-whitespace-mode +1)) | ||
| 1762 | |||
| 1763 | (setq rcirc-debug-flag t) | ||
| 1764 | |||
| 1765 | (advice-add 'rcirc :after | ||
| 1766 | (defun enable-rcirc-track-minor-mode (&rest _) | ||
| 1767 | (rcirc-track-minor-mode 1))) | ||
| 1768 | |||
| 1769 | (defun rcirc-kill () | ||
| 1770 | "Kill all rcirc buffers and turn off `rcirc-track-minor-mode'." | ||
| 1771 | (interactive) | ||
| 1772 | (mapc-buffers/progress "Killing rcirc buffers..." | ||
| 1773 | (lambda () | ||
| 1774 | (let ((kill-buffer-hook)) | ||
| 1775 | (kill-buffer))) | ||
| 1776 | 'rcirc-mode) | ||
| 1777 | (rcirc-track-minor-mode -1)) | ||
| 1778 | |||
| 1779 | (add-hook 'rcirc-mode-hook #'chat/setup) | ||
| 1780 | (add-hook 'rcirc-mode-hook #'rcirc-omit-mode) | ||
| 1781 | (add-hook 'rcirc-track-minor-mode-hook | ||
| 1782 | (defun rcirc-track@buffer-list-change () | ||
| 1783 | (add-hook 'buffer-list-update-hook | ||
| 1784 | #'rcirc-window-configuration-change))) | ||
| 1785 | |||
| 1786 | ;; "Fix" some things | ||
| 1787 | (setf rcirc-implemented-capabilities | ||
| 1788 | ;; I don't use these, and they mess up display in a few of my chats | ||
| 1789 | (delete "message-tags" rcirc-implemented-capabilities)) | ||
| 1790 | |||
| 1791 | ;; Adding servers more better-er | ||
| 1792 | (defun rcirc-add-server (name &rest spec) | ||
| 1793 | "Add a server to `rcirc-server-alist' and `rcirc-authinfo' at once. | ||
| 1794 | TODO: fully document" | ||
| 1795 | (let ((name* (if (plist-get spec :host) | ||
| 1796 | (plist-get spec :host) | ||
| 1797 | name)) | ||
| 1798 | (nick (or (plist-get spec :nick) | ||
| 1799 | (bound-and-true-p rcirc-default-nick) | ||
| 1800 | (bound-and-true-p user-login-name))) | ||
| 1801 | (user-name (or (plist-get spec :user-name) | ||
| 1802 | (plist-get spec :user) | ||
| 1803 | (plist-get spec :nick) | ||
| 1804 | (bound-and-true-p rcirc-default-user-name) | ||
| 1805 | (bound-and-true-p rcirc-default-nick) | ||
| 1806 | (bound-and-true-p user-login-name))) | ||
| 1807 | (password (let ((password (or (plist-get spec :password) | ||
| 1808 | (plist-get spec :pass)))) | ||
| 1809 | ;; (cond | ||
| 1810 | ;; ((functionp password) (funcall password)) | ||
| 1811 | ;; ((stringp password) password)) | ||
| 1812 | password | ||
| 1813 | ))) | ||
| 1814 | ;; Add the server to `rcirc-server-alist' | ||
| 1815 | (setf (alist-get name* rcirc-server-alist nil nil #'equal) | ||
| 1816 | (append | ||
| 1817 | (list :nick nick | ||
| 1818 | :user-name user-name) | ||
| 1819 | (when password (list :password password)) | ||
| 1820 | (when-let ((full-name (plist-get spec :full-name))) | ||
| 1821 | (list :full-name full-name)) | ||
| 1822 | (when-let ((channels (plist-get spec :channels))) | ||
| 1823 | (list :channels channels)) | ||
| 1824 | (when-let ((port (plist-get spec :port))) | ||
| 1825 | (list :port port)) | ||
| 1826 | (when-let ((encryption (plist-get spec :encryption))) | ||
| 1827 | (list :encryption encryption)) | ||
| 1828 | (when-let ((server-alias (or (plist-get spec :server-alias) | ||
| 1829 | (and (plist-get spec :host) | ||
| 1830 | name)))) | ||
| 1831 | (list :server-alias server-alias)))) | ||
| 1832 | ;; Add it to `rcirc-authinfo' | ||
| 1833 | (when-let ((auth (plist-get spec :auth))) | ||
| 1834 | (unless password (user-error "Trying to auth without a password")) | ||
| 1835 | (setf (alist-get name* rcirc-authinfo nil nil #'equal) | ||
| 1836 | (cl-case auth | ||
| 1837 | (nickserv (list 'nickserv nick password)) | ||
| 1838 | (bitlbee (list 'bitlbee nick password)) | ||
| 1839 | (quakenet (list 'quakenet user-name password)) | ||
| 1840 | (sasl (list 'sasl user-name password)) | ||
| 1841 | ;; (chanserv) ; These two aren't supported. | ||
| 1842 | ;; (certfp) | ||
| 1843 | (t (user-error "Unsupported :auth type `%s'" | ||
| 1844 | (plist-get plist :auth)))))) | ||
| 1845 | ;; Return the server's name so that we don't leak authinfo | ||
| 1846 | name)) | ||
| 1847 | |||
| 1848 | (defun rcirc-resolve-passwords (&rest _) | ||
| 1849 | (dolist-with-progress-reporter (s rcirc-server-alist) | ||
| 1850 | "Resolving lambda passwords in `rcirc-server-alist...'" | ||
| 1851 | (let ((pw (plist-get (cdr s) :password))) | ||
| 1852 | (setf (plist-get (cdr s) :password) | ||
| 1853 | (if (functionp pw) (funcall pw) pw)))) | ||
| 1854 | (dolist-with-progress-reporter (i rcirc-authinfo) | ||
| 1855 | "Resolving lambda passwords in `rcirc-authinfo...'" | ||
| 1856 | (let ((pw (cadddr i))) | ||
| 1857 | (setf (cadddr i) | ||
| 1858 | (if-let ((s (assoc (car i) rcirc-server-alist))) | ||
| 1859 | (plist-get (cdr s) :password) | ||
| 1860 | (if (functionp pw) (funcall pw) pw)))))) | ||
| 1861 | |||
| 1862 | (advice-add 'rcirc :before #'rcirc-resolve-passwords) | ||
| 1863 | |||
| 1864 | (defun rcirc/password (&rest spec) | ||
| 1865 | (lambda () | ||
| 1866 | (auth-info-password | ||
| 1867 | (car | ||
| 1868 | (apply #'auth-source-search spec))))) | ||
| 1869 | |||
| 1870 | (setq rcirc-server-alist nil) | ||
| 1871 | |||
| 1872 | (rcirc-add-server "tilde.town" | ||
| 1873 | :host "localhost" :port 6969 | ||
| 1874 | :channels '("#tildetown" "#newbirc") | ||
| 1875 | :auth 'sasl | ||
| 1876 | :password | ||
| 1877 | (rcirc/password :host "localhost:6969" :user "acdw")) | ||
| 1878 | ;; (rcirc-add-server "43beans.casa" | ||
| 1879 | ;; :host "localhost" :port 6970 | ||
| 1880 | ;; :channels '("#beans") | ||
| 1881 | ;; :auth nil | ||
| 1882 | ;; :password nil) | ||
| 1883 | (rcirc-add-server "tilde.chat" | ||
| 1884 | :host "irc.tilde.chat" :port 6697 :encryption 'tls | ||
| 1885 | ;; :channels left blank. There's some kind of race | ||
| 1886 | ;; condition in SASL and identd that means I authenticate | ||
| 1887 | ;; before being fully authenticated? Or something. | ||
| 1888 | ;; Tilde.chat's NickServ does autojoin, though, so that | ||
| 1889 | ;; works out without an afternoon of debugging. | ||
| 1890 | :auth 'sasl | ||
| 1891 | :password (rcirc/password :host "tilde.chat" :user "acdw")) | ||
| 1892 | (rcirc-add-server "m455.casa" | ||
| 1893 | :port 6697 :encryption 'tls | ||
| 1894 | :channels '("#basement" "#43beans") | ||
| 1895 | :auth 'sasl | ||
| 1896 | :password (rcirc/password :host "m455.casa" :user "acdw")) | ||
| 1897 | (rcirc-add-server "libera.chat" | ||
| 1898 | :host "irc.libera.chat" :port 6697 :encryption 'tls | ||
| 1899 | :channels '("#emacs" "#rcirc") | ||
| 1900 | :auth 'sasl | ||
| 1901 | :password (rcirc/password :host "libera.chat" :user "acdw")) | ||
| 1902 | ;; End of rcirc configuration. | ||
| 1903 | ) | ||
| 1904 | |||
| 1905 | (when (package-ensure 'web-mode) | ||
| 1906 | (add-to-list 'auto-mode-alist '("\\.html?\\'" . web-mode)) | ||
| 1907 | (add-to-list 'auto-mode-alist '("\\.phtml\\'" . web-mode)) | ||
| 1908 | (add-to-list 'auto-mode-alist '("\\.tpl\\.php\\'" . web-mode)) | ||
| 1909 | (add-to-list 'auto-mode-alist '("\\. [agj]sp\\'" . web-mode)) | ||
| 1910 | (add-to-list 'auto-mode-alist '("\\.as[cp]x\\'" . web-mode)) | ||
| 1911 | (add-to-list 'auto-mode-alist '("\\.erb\\'" . web-mode)) | ||
| 1912 | (add-to-list 'auto-mode-alist '("\\.mustache\\'" . web-mode)) | ||
| 1913 | (add-to-list 'auto-mode-alist '("\\.djhtml\\'" . web-mode))) | ||