From 3d42d13602bef3b80747a37f77730445216c2c7a Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Tue, 1 Aug 2023 20:31:55 -0500 Subject: Add emacs/init.el --- emacs/init.el | 1926 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 1926 insertions(+) create mode 100644 emacs/init.el diff --git a/emacs/init.el b/emacs/init.el new file mode 100644 index 0000000..a0324cf --- /dev/null +++ b/emacs/init.el @@ -0,0 +1,1926 @@ +;;; ~/.emacs -*- mode: emacs-lisp; lexical-binding: t; -*- +;; by Case Duckworth +;; License: GPLv3 + +(setopt custom-file (locate-user-emacs-file "custom.el")) +(load custom-file :noerror) + +(add-hook 'after-init-hook + (lambda () (load (locate-user-emacs-file "private") :noerror))) + +(require 'package) +(add-to-list 'package-archives '("melpa" . "https://melpa.org/packages/") t) +(package-initialize) + +(defun package-ensure (pkg &optional local require) + "Ensure PKG is installed. +PKG can be a symbol, a string, or a list. A symbol will be +installed using `package-install' from `package-archives'. A +string will use `package-vc-install', which see. If given a +list, it will be interpreted as a full set of arguments to one of +the above functions, depending on the type of its car. + +If LOCAL is t, add ~/src/PKG.el to `load-path' and generate +autoloads. If LOCAL is a string, Add that directory to +`load-path'. + +If REQUIRE is non-nil, require the package after installing it." + (setq pkg (ensure-list pkg)) + + (cond + (local + (unless (stringp local) + (setq local (expand-file-name + (format "~/src/%s.el" (car pkg))))) + (unless (file-directory-p local) + (user-error "Package directory does not exist: %s" local)) + (let ((autoload-file (expand-file-name + (format "%s-autoloads.el" (car pkg)) + local)) + (backup-inhibited t)) + (add-to-list 'load-path local) + (loaddefs-generate local autoload-file) + (load autoload-file nil t)) + (setq pkg (intern (format "%s" (car pkg))))) + + ((symbolp (car pkg)) + (unless (ignore-errors (apply #'package-install pkg)) + (package-refresh-contents) + (apply #'package-install pkg)) + (setq pkg (car pkg))) + + ((stringp (car pkg)) + (let ((pkg-name (intern (file-name-base (car pkg))))) + (unless (package-installed-p pkg-name) + (apply #'package-vc-install pkg)) + (setq pkg pkg-name)))) + + (when require + (require pkg)) + + pkg) + +(defmacro setf/assoc (alist key val &optional keep) + "Set KEY to VAL in ALIST using `assoc'/`equal' semantics. +Written as a convenience to writing out this long `alist-get' +call every time. If VAL is nil, the entry with KEY is removed from ALIST unless +KEEP is also non-nil." + `(setf (alist-get ,key ,alist nil ,(not keep) #'equal) + ,val)) + +(defmacro comment (&rest _) (declare (indent defun)) nil) + +(defun add-local-mode-hook (mode-hook hook func) + "Add FUNC to HOOK locally in buffers with MODE-HOOK." + (add-hook mode-hook + (lambda () (add-hook hook func nil t)))) + +(package-ensure 'crux) +(crux-reopen-as-root-mode) + +(crux-with-region-or-buffer indent-region) +(crux-with-region-or-buffer tabify) +(crux-with-region-or-buffer untabify) + +(keymap-global-set "C-c i" #'crux-find-user-init-file) + +(setopt auth-sources '(default + "secrets:passwords" + "~/.authinfo")) + +(setq disabled-command-function nil) + + +;;; Theme + +(setopt modus-themes-bold-constructs t) +(setopt modus-themes-italic-constructs t) +(setopt modus-themes-variable-pitch-ui t) +(setopt modus-themes-disable-other-themes t) + +(tool-bar-mode -1) +(menu-bar-mode -1) +(scroll-bar-mode -1) +(tooltip-mode -1) + +(setopt scroll-conservatively 101) + +(setopt read-answer-short t) +(setopt use-dialog-box nil) +(setopt use-file-dialog nil) +(setopt use-short-answers t) + +(setopt inhibit-startup-screen t) +(setopt initial-buffer-choice t) +(setopt initial-scratch-message + ;; ";; Emacs!\n\n" + nil) + +(setopt x-underline-at-descent-line t) +(setopt blink-cursor-delay 0.25) +(setopt blink-cursor-interval 0.25) +(setopt blink-cursor-blinks 4) + +(define-advice startup-echo-area-message (:override ()) + (if (get-buffer "*Warnings*") + ";_;" + "^_^")) + +(defun reset-faces (&rest _) + (dolist (face '(font-lock-regexp-face + font-lock-builtin-face + font-lock-variable-name-face + font-lock-preprocessor-face + font-lock-remove-face + font-lock-delimiter-face + font-lock-label-face + font-lock-operator-face + font-lock-property-face + font-lock-builtin-face + font-lock-number-face + font-lock-keyword-face + font-lock-set-face + font-lock-punctuation-face + font-lock-constant-face + font-lock-type-face + font-lock-function-name-face + font-lock-reference-face + font-lock-misc-punctuation-face + font-lock-bracket-face)) + (face-spec-set face '((t :foreground unspecified + :background unspecified)))) + (when-let ((current (cl-loop for modus in modus-themes-collection + if (memq modus custom-enabled-themes) + return modus + finally return nil))) + (modus-themes-with-colors + (dolist (face '(font-lock-doc-face + font-lock-string-face)) + (face-spec-set face `((t :foreground unspecified + :background unspecified + :slant italic)))) + ;; (face-spec-set 'font-lock-comment-face + ;; :inherit doesn't work for some reason?? + ;; `((t :foreground + ;; ,fg-alt))) + ))) +(advice-add 'load-theme :after #'reset-faces) + +(defvar dark-theme 'modus-vivendi-tinted) +(defvar light-theme 'modus-operandi-tinted) + +(load-theme dark-theme :no-confirm :no-enable) +(load-theme light-theme :no-confirm :no-enable) +(if (and (executable-find "darkman") + (let ((stat (shell-command "darkman get"))) + (and (= stat 0) + (equal (with-current-buffer shell-command-buffer-name + (buffer-substring (point-min) (point-max))) + "dark\n")))) + (load-theme dark-theme :no-confirm) + (load-theme light-theme :no-confirm)) + + +(defun first-frame@set-fonts () + (remove-hook 'server-after-make-frame-hook + #'first-frame@set-fonts) + (face-spec-set 'default + `((t :family "Recursive Mono Casual Static" + :height 110))) + (face-spec-set 'variable-pitch + `((t :family "Recursive Sans Casual Static" + :height 1.0))) + ;; Emojis + (cl-loop with ffl = (font-family-list) + for font in '("Noto Emoji" "Noto Color Emoji" + "Segoe UI Emoji" "Apple Color Emoji" + "FreeSans" "FreeMono" "FreeSerif" + "Unifont" "Symbola") + if (member font ffl) + do (set-fontset-font t 'symbol font)) + ;; International fonts + (cl-loop with ffl = (font-family-list) + for (charset . font) + in '((latin . "Noto Sans") + (han . "Noto Sans CJK SC Regular") + (kana . "Noto Sans CJK JP Regular") + (hangul . "Noto Sans CJK KR Regular") + (cjk-misc . "Noto Sans CJK KR Regular") + (khmer . "Noto Sans Khmer") + (lao . "Noto Sans Lao") + (burmese . "Noto Sans Myanmar") + (thai . "Noto Sans Thai") + (ethiopic . "Noto Sans Ethiopic") + (hebrew . "Noto Sans Hebrew") + (arabic . "Noto Sans Arabic") + (gujarati . "Noto Sans Gujarati") + (devanagari . "Noto Sans Devanagari") + (kannada . "Noto Sans Kannada") + (malayalam . "Noto Sans Malayalam") + (oriya . "Noto Sans Oriya") + (sinhala . "Noto Sans Sinhala") + (tamil . "Noto Sans Tamil") + (telugu . "Noto Sans Telugu") + (tibetan . "Noto Sans Tibetan")) + if (member font ffl) + do (set-fontset-font t charset font)) + ;; XXX: tab-bar does a weird thing, so i set it up here.... + (setopt tab-bar-show t) + (tab-bar-mode)) + +(defun run-after-init-or-first-frame (func) + "Run FUNC after init or after the first frame." + (if (daemonp) + (add-hook 'server-after-make-frame-hook func) + (add-hook 'after-init-hook func))) + +(run-after-init-or-first-frame #'first-frame@set-fonts) + +(setopt frame-resize-pixelwise t) +(setopt window-resize-pixelwise t) + +(defun tab-bar-end-space () + `((end menu-item " " ignore))) + +(add-to-list 'tab-bar-format 'tab-bar-format-align-right :append) +(add-to-list 'tab-bar-format 'tab-bar-format-global :append) +(add-to-list 'tab-bar-format 'tab-bar-end-space :append) + +(add-hook 'dired-mode-hook #'hl-line-mode) +(with-eval-after-load 'org-agenda + (add-hook 'org-agenda-mode-hook #'hl-line-mode)) + +(with-eval-after-load 'tabulated-list + (add-hook 'tabulated-list-mode-hook #'hl-line-mode)) + +(setopt echo-keystrokes 0.01) + +(setopt switch-to-buffer-in-dedicated-window 'pop) +(setopt switch-to-buffer-obey-display-actions t) + +(when (package-ensure 'adaptive-wrap) + (add-hook 'visual-line-mode-hook #'adaptive-wrap-prefix-mode)) + +;;; Ediff + +(setopt ediff-split-window-function #'split-window-horizontally) +(setopt ediff-window-setup-function #'ediff-setup-windows-plain) + +;;; Man pages + +(setopt Man-notify-method 'aggressive) + +;;; Mode-line + +(defun hide-minor-mode (mode &optional hook) + "Hide MODE from the mode-line. +HOOK is used to trigger the action, and defaults to MODE-hook." + (setf (alist-get mode minor-mode-alist) (list "")) + (add-hook (intern (or hook (format "%s-hook" mode))) + (lambda () (hide-minor-mode mode)))) + +(setq mode-line-modes + (let ((recursive-edit-help-echo + "Recursive edit, type M-C-c to get out")) + (list (propertize "%[" 'help-echo recursive-edit-help-echo) + `(:propertize ("" mode-name) + help-echo "Major mode\n\ +mouse-1: Display major mode menu\n\ +mouse-2: Show help for major mode\n\ +mouse-3: Toggle minor modes" + face bold + mouse-face mode-line-highlight + local-map ,mode-line-major-mode-keymap) + '("" mode-line-process) + `(:propertize ("" minor-mode-alist) + mouse-face mode-line-highlight + help-echo "Minor mode\n\ +mouse-1: Display minor mode menu\n\ +mouse-2: Show help for minor mode\n\ +mouse-3: Toggle minor modes" + local-map ,mode-line-minor-mode-keymap) + (propertize "%n" 'help-echo "mouse-2: Remove narrowing from buffer" + 'mouse-face 'mode-line-highlight + 'local-map (make-mode-line-mouse-map + 'mouse-2 #'mode-line-widen)) + (propertize "%]" 'help-echo recursive-edit-help-echo) + " "))) + +(setopt mode-line-format + '(("%e" + mode-line-front-space + (:propertize ("" + mode-line-client + mode-line-modified + mode-line-remote) + display (min-width (3.0))) + " " + mode-line-buffer-identification + (vc-mode + (" (" (:eval (string-trim vc-mode)) ")")) + " " + (mode-line-position + (" ∙ " mode-line-position)) + " ∙ " + mode-line-modes ; the one above + mode-line-misc-info + mode-line-end-spaces))) + + +;;; Completion and minibuffer + +(setopt tab-always-indent 'complete) +(setopt completion-styles '(basic partial-completion substring flex)) + +;; XXX: this is 'too good' when I'm in the process of typing out things. +;; (when (package-ensure "https://git.sr.ht/~pkal/typo") +;; (add-to-list 'completion-styles 'typo :append)) + +(setopt completion-ignore-case t) +(setopt read-buffer-completion-ignore-case t) +(setopt read-file-name-completion-ignore-case t) +(setopt completion-flex-nospace t) + +;; These aren't /that/ useful if you're not using *Completions*. +(setopt completions-detailed t) +(setopt completion-auto-help 'visible) +(setopt completion-auto-select 'second-tab) +(setopt completions-header-format nil) +(setopt completions-format 'one-column) +(setopt completions-max-height 20) + +;; (defun minibuffer-next-completion-or-line (n) +;; "Move to the next N completion in minibuffer, or Nth next line." +;; (interactive "p") +;; (if (and (eq last-command 'minibuffer-next-completion) +;; (not (minibufferp))) +;; (forward-line n) +;; (minibuffer-next-completion n))) + +;; (defun minibuffer-previous-completion-or-line (n) +;; "Move to the previous N completion, or Nth previous line." +;; (interactive "p") +;; (setq last-command 'minibuffer-next-completion-or-line) +;; (minibuffer-next-completion-or-line (- n))) + +(progn + (keymap-set minibuffer-local-map "C-p" + #'minibuffer-previous-completion) + (keymap-set minibuffer-local-map "C-n" + #'minibuffer-next-completion) + ;; (keymap-set completion-in-region-mode-map "C-p" + ;; #'minibuffer-previous-completion) + ;; (keymap-set completion-in-region-mode-map "C-n" + ;; #'minibuffer-next-completion) + ) + +(setf/assoc display-buffer-alist + "\\*Completions\\*" + '((display-buffer-reuse-mode-window))) + +(setopt enable-recursive-minibuffers t) +(minibuffer-depth-indicate-mode) +(minibuffer-electric-default-mode) + +(setopt file-name-shadow-properties '(invisible t intangible t)) +(file-name-shadow-mode) + +(define-minor-mode truncate-lines-local-mode + "Toggle `truncate-lines' in the current buffer." + :lighter "" + (setq-local truncate-lines truncate-lines-local-mode)) + +(add-hook 'completion-list-mode-hook #'truncate-lines-local-mode) +(add-hook 'minibuffer-setup-hook #'truncate-lines-local-mode) + +(when (package-ensure 'consult nil t) + (keymap-global-set "C-x b" #'consult-buffer) + (keymap-global-set "C-x 4 b" #'consult-buffer-other-window) + (keymap-global-set "C-x 5 b" #'consult-buffer-other-frame) + (keymap-global-set "C-x r b" #'consult-bookmark) + (keymap-global-set "M-y" #'consult-yank-pop) + (keymap-global-set "M-g g" #'consult-goto-line) + (keymap-global-set "M-g M-g" #'consult-goto-line) + (keymap-global-set "M-g o" #'consult-outline) + (keymap-global-set "M-g m" #'consult-mark) + (keymap-global-set "M-g i" #'consult-imenu) + (keymap-global-set "M-s d" #'consult-find) + (keymap-global-set "M-s D" #'consult-locate) + (keymap-global-set "M-s g" #'consult-grep) + (keymap-global-set "M-s G" #'consult-git-grep) + (keymap-global-set "M-s r" #'consult-ripgrep) + (keymap-global-set "M-s l" #'consult-line) + (keymap-global-set "M-s k" #'consult-keep-lines) + (keymap-global-set "M-s u" #'consult-focus-lines) + + (keymap-global-set "M-s e" #'consult-isearch-history) + (keymap-set isearch-mode-map "M-e" #'consult-isearch-history) + (keymap-set isearch-mode-map "M-s e" #'consult-isearch-history) + (keymap-set isearch-mode-map "M-s l" #'consult-line) + + (setopt xref-show-xrefs-function #'consult-xref) + (setopt xref-show-definitions-function #'xref-show-definitions-completing-read) + + (setopt consult-preview-key "M-.") + + (consult-customize + consult-ripgrep consult-git-grep consult-grep + consult-xref + :preview-key '(:debounce 0.4 any))) + +(when (package-ensure 'marginalia) + (marginalia-mode)) + +(setopt history-length t) +(setopt history-delete-duplicates t) +(setopt savehist-save-minibuffer-history t) +(setopt savehist-autosave-interval 5) +(savehist-mode) + + +;;; Text editing + +(setopt fill-column 80) +(global-so-long-mode) + +(defun cycle-spacing* (&optional n) + "Negate N argument on `cycle-spacing'." + (interactive "*p") + (cycle-spacing (- n))) +(keymap-global-set "M-SPC" #'cycle-spacing*) + +(when (package-ensure 'hungry-delete) + (setopt hungry-delete-chars-to-skip " \t") + (setopt hungry-delete-skip-regexp (format "[%s]" hungry-delete-chars-to-skip)) + (setopt hungry-delete-join-reluctantly nil) + (with-eval-after-load 'hungry-delete + (add-to-list 'hungry-delete-except-modes 'eshell-mode) + (add-to-list 'hungry-delete-except-modes 'nim-mode) + (add-to-list 'hungry-delete-except-modes 'python-mode) + (hide-minor-mode 'hungry-delete-mode)) + (global-hungry-delete-mode)) + +(setopt isearch-lazy-count t) +(setopt isearch-regexp-lax-whitespace t) +(setopt isearch-wrap-pause 'no) +(setopt search-default-mode t) +(setopt search-whitespace-regexp ".*?") ; swiper-style +(setopt search-ring-max 256) +(setopt regexp-search-ring-max 256) + +(define-advice isearch-cancel (:before () add-to-history) + "Add search string to history when canceling isearch." + (unless (string-equal "" isearch-string) + (isearch-update-ring isearch-string isearch-regexp))) + +(define-advice perform-replace (:around (fn &rest args) dont-exit-on-anykey) + "Don't exit replace for anykey that's not in `query-replace-map'." + (save-window-excursion + (cl-letf* ((lookup-key-orig + (symbol-function 'lookup-key)) + ((symbol-function 'lookup-key) + (lambda (map key &optional accept-default) + (or (apply lookup-key-orig map key accept-default) + (when (eq map query-replace-map) 'help))))) + (apply fn args)))) + +(when (package-ensure 'isearch-mb) + (with-eval-after-load 'isearch-mb + (with-eval-after-load 'consult + (add-to-list 'isearch-mb--with-buffer #'consult-isearch-history) + (keymap-set isearch-mb-minibuffer-map "M-r" #'consult-isearch-history) + (add-to-list 'isearch-mb--after-exit #'consult-line) + (keymap-set isearch-mb-minibuffer-map "M-s l" #'consult-line)) + (with-eval-after-load 'anzu + (add-to-list 'isearch-mb--after-exit #'anzu-isearch-query-replace) + (keymap-set isearch-mb-minibuffer-map "M-%" + #'anzu-isearch-query-replace))) + (isearch-mb-mode)) + +(when (package-ensure 'anzu) + (setopt anzu-mode-lighter "") + (setopt anzu-deactivate-region t) + (keymap-global-set "M-%" #'anzu-query-replace-regexp) + (keymap-global-set "C-M-%" #'anzu-query-replace) + (keymap-set isearch-mode-map "M-%" #'anzu-isearch-query-replace-regexp) + (keymap-set isearch-mode-map "C-M-%" #'anzu-isearch-query-replace) + (global-anzu-mode)) + +(keymap-global-set "M-/" #'hippie-expand) +(keymap-global-set "C-x C-b" #'ibuffer) + +(add-hook 'ibuffer-mode-hook #'hl-line-mode) + +(defun call-with-region-or-buffer (fn &rest _r) + "Call function FN with current region or buffer. +Good to use for :around advice." + ;; This `interactive' form is needed to override the advised function's form, + ;; to avoid errors when the region isn't active. This means that FN must take + ;; 2 arguments, the beginning and the end of the region to act on. + (interactive) + (if (region-active-p) + (funcall fn (region-beginning) (region-end)) + (funcall fn (point-min) (point-max)))) + +(delete-selection-mode) + +(when (package-ensure 'avy) + (setopt avy-background t) + (setopt avy-keys (string-to-list "asdfghjklqwertyuiopzxcvbnm")) + (keymap-global-set "M-j" #'avy-goto-char-timer) + (keymap-set isearch-mode-map "M-j" #'avy-isearch)) + +(when (package-ensure 'zzz-to-char) + (keymap-global-set "M-z" + (defun zzz-to-char* (arg) + (interactive "P") + (call-interactively + (if arg #'zzz-to-char #'zzz-to-char-up-to-char))))) + +;;; Prose + +(add-hook 'text-mode-hook #'visual-line-mode) + +(when (package-ensure 'olivetti) + (add-hook 'text-mode-hook #'olivetti-mode)) + +(when (package-ensure 'jinx) + (add-hook 'text-mode-hook #'jinx-mode) + (with-eval-after-load 'jinx + (keymap-set jinx-mode-map "M-$" #'jinx-correct) + (keymap-set jinx-mode-map "C-M-$" #'jinx-languages))) + +(defun org-fk-region (start end) + "Get the Flesch-Kincaid score of an `org-mode' region." + (interactive "r") + (let ((buf (get-buffer-create " *fk*" t))) + (shell-command-on-region start end + "pandoc -t plain -f org | ~/src/fk/fk.perl" + buf) + (with-current-buffer buf + (buffer-substring-no-properties (point-min) (- (point-max) 1))) + (kill-buffer buf))) + +(crux-with-region-or-buffer org-fk-region) + +(when (package-ensure 'scule t t) + (keymap-global-set "M-c" scule-map)) + +(when (package-ensure 'titlecase t) + (keymap-set scule-map "M-t" #'titlecase-dwim)) + +(setopt dictionary-default-popup-strategy "lev") ; Levenshtein distance 1 +(setopt dictionary-server "dict.org") +(setopt dictionary-use-single-buffer t) +(keymap-global-set "M-#" + (defun dictionary-lookup-dwim () + (interactive) + (unless (ignore-errors (dictionary-lookup-definition)) + (call-interactively #'dictionary-search)))) + +(package-ensure 'markdown-mode) + +;;; Programming + +(setopt electric-pair-skip-whitespace 'chomp) +(electric-pair-mode) + +(setopt show-paren-delay 0.01) +(setopt show-paren-style 'parenthesis) +(setopt show-paren-when-point-in-periphery t) +(setopt show-paren-when-point-inside-paren t) +(show-paren-mode) + +(add-hook 'prog-mode-hook #'auto-fill-mode) +(add-hook 'prog-mode-hook #'display-fill-column-indicator-mode) +(add-hook 'after-save-hook #'executable-make-buffer-file-executable-if-script-p) + +(when (package-ensure 'dumb-jump) + (add-hook 'xref-backend-functions #'dumb-jump-xref-activate)) + +(add-hook 'prog-mode-hook #'prettify-symbols-mode) + +(keymap-global-set "M-:" #'pp-eval-expression) + +;; Tabs + +(setopt tab-width 8) + +(defvar space-indent-modes '(emacs-lisp-mode + lisp-interaction-mode + lisp-mode + scheme-mode + python-mode + haskell-mode + text-mode) + "Modes to indent with spaces, not tabs.") + +(defun indent-tabs-mode-maybe () + (setq indent-tabs-mode + (if (apply #'derived-mode-p space-indent-modes) nil t))) +(add-hook 'prog-mode-hook #'indent-tabs-mode-maybe) + +(setopt sh-basic-offset tab-width) +(setopt perl-indent-level tab-width) + +;; Scheme + +(when (package-ensure 'geiser) + (when (executable-find "csi") + (when (package-ensure 'geiser-chicken) + (setf/assoc auto-mode-alist "\\.egg\\'" 'scheme-mode))) + (setopt scheme-program-name (or (executable-find "csi") + "scheme")) + (add-hook 'scheme-mode-hook #'geiser-mode)) + +(require 'autoinsert) +(setf/assoc auto-insert-alist + "\\.scm" + '(nil "#!/bin/sh" \n + "#| -*- scheme -*-" \n + "exec csi -ss \"$0\" \"$@\"" \n + _ \n + "|#" \n \n)) + +;; Emacs lisp + +(keymap-set emacs-lisp-mode-map "C-c C-c" #'eval-defun) +(keymap-set emacs-lisp-mode-map "C-c C-b" #'eval-buffer) +(keymap-set emacs-lisp-mode-map "C-c C-z" #'ielm) ; TODO: better-ize +(keymap-set lisp-interaction-mode-map "C-c C-c" #'eval-defun) +(keymap-set lisp-interaction-mode-map "C-c C-b" #'eval-buffer) +(keymap-set lisp-interaction-mode-map "C-c C-z" #'ielm) ; TODO: better-ize + +(add-hook 'after-init-hook + (lambda () + (define-advice eval-buffer (:after (&rest _) message) + (message "Buffer %s evaluated." (current-buffer))))) + + +;;; Files + +(setopt auto-revert-verbose nil) +(setopt global-auto-revert-non-file-buffers t) +(global-auto-revert-mode) + +(setopt create-lockfiles nil) +(setopt mode-require-final-newline t) +(setopt view-read-only t) +(setopt save-silently t) + +(setopt auto-save-default nil) +(setopt auto-save-no-message t) +(setopt auto-save-interval 2) +(setopt auto-save-timeout 2) +(setopt auto-save-visited-interval 2) +(setopt remote-file-name-inhibit-auto-save t) +(setopt remote-file-name-inhibit-auto-save-visited t) +(add-to-list 'auto-save-file-name-transforms + `(".*" ,(locate-user-emacs-file "auto-save/") t)) +(auto-save-visited-mode) + +(setopt backup-by-copying t) +(setopt version-control t) +(setopt kept-new-versions 3) +(setopt kept-old-versions 3) +(setopt delete-old-versions t) +(add-to-list 'backup-directory-alist '("^/dev/shm/" . nil)) +(add-to-list 'backup-directory-alist '("^/tmp/" . nil)) +(when-let ((xrd (getenv "XDG_RUNTIME_DIR"))) + (add-to-list 'backup-directory-alist (cons xrd nil))) +(add-to-list 'backup-directory-alist + (cons "." (locate-user-emacs-file "backup/")) + :append) + +(setopt recentf-max-menu-items 100) +(setopt recentf-max-saved-items nil) +(setopt recentf-case-fold-search t) +(with-eval-after-load 'recentf + (add-to-list 'recentf-exclude "-autoloads.el\\'")) +(add-hook 'buffer-list-update-hook #'recentf-track-opened-file) +(add-hook 'after-save-hook #'recentf-save-list) +(recentf-mode) + +(setopt save-place-forget-unreadable-files (eq system-type 'gnu/linux)) +(save-place-mode) + +;; Encodings +(set-language-environment "UTF-8") +(setopt buffer-file-coding-system 'utf-8-unix) +(setopt coding-system-for-read 'utf-8-unix) +(setopt coding-system-for-write 'utf-8-unix) +(setopt default-process-coding-system '(utf-8-unix . utf-8-unix)) +(setopt locale-coding-system 'utf-8-unix) +(set-charset-priority 'unicode) +(prefer-coding-system 'utf-8-unix) +(set-default-coding-systems 'utf-8-unix) +(set-terminal-coding-system 'utf-8-unix) +(set-keyboard-coding-system 'utf-8-unix) +(pcase system-type + ((or 'ms-dos 'windows-nt) + (set-clipboard-coding-system 'utf-16-le) + (set-selection-coding-system 'utf-16-le)) + (_ + (set-selection-coding-system 'utf-8) + (set-clipboard-coding-system 'utf-8))) + +;; Undo +(when (package-ensure 'undohist) + (undohist-initialize)) + +;;; ... + +(setopt bookmark-save-flag 1) + +(defun c-w-dwim (num) + "Delete NUM words backward, or the region if it's active." + (interactive "p") + (if (region-active-p) + (call-interactively #'kill-region) + (call-interactively #'backward-kill-word))) +(keymap-global-set "C-w" #'c-w-dwim) + +(setf/assoc display-buffer-alist + "\\`\\*Warnings\\*" + '((display-buffer-no-window))) + +(winner-mode) + +(setopt set-mark-command-repeat-pop t) + +(when (package-ensure 'embark nil t) + (when (and (package-installed-p 'consult) + (package-ensure 'embark-consult nil t)) + (add-hook 'embark-collect-mode-hook #'consult-preview-at-point-mode)) + (keymap-global-set "C-." #'embark-act) + (keymap-global-set "M-." #'embark-dwim) + (keymap-global-set "C-h B" #'embark-bindings) + (setopt prefix-help-command #'embark-prefix-help-command) + (setf/assoc display-buffer-alist + "\\`\\*Embark Collect \\(Live\\|Completions\\)\\*" + '(nil (window-parameters (mode-line-format . none))))) + +(setopt eldoc-documentation-strategy #'eldoc-documentation-compose-eagerly) +(setopt eldoc-idle-delay 0.01) + +(setopt recenter-positions '(top middle bottom)) + +(defmacro inhibit-messages (&rest body) + "Inhibit all messages in BODY." + (declare (indent defun)) + `(cl-letf (((symbol-function 'message) #'ignore)) + ,@body)) + +(add-hook 'find-file-not-found-functions + (defun create-missing-directories () + "Automatically create missing directories." + (let ((target-dir (file-name-directory buffer-file-name))) + (unless (file-exists-p target-dir) + (make-directory target-dir :parents))))) + +(setopt vc-follow-symlinks t) +(setopt vc-make-backup-files t) +(add-hook 'find-file-hook + (defun vc-remote-off () + "Turn VC off when remote." + (when (file-remote-p (buffer-file-name)) + (setq-local vc-handled-backends nil)))) +(with-eval-after-load 'vc-dir + (add-hook 'vc-dir-mode-hook #'hl-line-mode)) + +(defun vc-jump () + "Run `vc-dir' on the current directory. +Saves a keystroke." + (interactive) + (vc-dir default-directory)) +(keymap-global-set "C-x v j" #'vc-jump) + +(setopt whitespace-style '(face trailing tabs tab-mark)) +(global-whitespace-mode) +(hide-minor-mode 'whitespace-mode) +(add-hook 'before-save-hook + (defun delete-trailing-whitespace-except-current-line () + (save-excursion + (delete-trailing-whitespace (point-min) + (line-beginning-position)) + (delete-trailing-whitespace (line-end-position) + (point-max))))) + +(defun list-of-strings-p (x) + "Is X a list of strings?" + (and x + (listp x) + (cl-every #'stringp x))) + +(put 'ispell-local-words 'safe-local-variable + 'list-of-strings-p) + +(package-ensure '0x0) ; TODO: write my own package for rsync + +(when (package-ensure 'electric-cursor t) + (hide-minor-mode 'electric-cursor-mode) + (setopt electric-cursor-alist '((overwrite-mode . (hbar . 8)) + (t . box))) + (electric-cursor-mode)) + +(defun fill-double-space-sentences-region (start end) + "Fill from START to END, double-spacing sentences." + (let ((sentence-end-double-space t)) + (repunctuate-sentences :no-query start end) + (fill-region start end))) + +(defun unfill-region (start end &optional unfill-func) + "Unfill region from START to END." + (let ((fill-column most-positive-fixnum) + (fill-paragraph-function nil)) + (funcall (or unfill-func #'fill-region) start end))) + +(defun fill-or-unfill-region (start end &optional interactive) + "Fill or unfill from START to END." + (interactive "*r\np") + (if (and interactive + (eq last-command 'fill-or-unfill-region)) + ;; If called interactively more than once, toggle filling mode. + (if (with-current-buffer "*Messages*" + (goto-char (point-max)) + (goto-char (beginning-of-line)) + (looking-at "Unfilling")) + (fill-double-space-sentences-region start end) + (unfill-region start end #'fill-double-space-sentences-region)) + ;; Otherwise, detect filled status based on the length of lines in the + ;; region. If just one of them is longer than `fill-column', consider the + ;; region unfilled. + (let ((filled-p (cl-some (lambda (ln) (<= 1 (length ln) fill-column)) + (string-split (buffer-substring start end) + "[\n\r]+")))) + (if filled-p + (progn + (message "Unfilling region") + (unfill-region start end #'fill-double-space-sentences-region)) + (progn + (message "Filling region") + (fill-double-space-sentences-region start end)))))) + +(defun fill-or-unfill-dwim () + (interactive) + (save-mark-and-excursion + (unless (region-active-p) + (mark-paragraph)) + (call-interactively #'fill-or-unfill-region))) + +(keymap-global-set "M-q" #'fill-or-unfill-dwim) + +;; Fix annoying error messages when I type the key +(keymap-global-set "<0x100811d0>" #'ignore) ; Keychron +(keymap-global-set "" #'ignore) ; Laptop + +(keymap-global-set "M-u" #'universal-argument) +(keymap-set universal-argument-map "M-u" #'universal-argument-more) + +(defun kill-buffer-dwim (&optional buffer-or-name) + "Kill BUFFER-OR-NAME or the current buffer." + (interactive "P") + (cond + ((bufferp buffer-or-name) + (kill-buffer buffer-or-name)) + ((null buffer-or-name) + (kill-current-buffer)) + (:else + (kill-buffer (read-buffer "Kill: " nil :require-match))))) +(keymap-global-set "C-x C-k" #'kill-buffer-dwim) + +(defun other-window-dwim (&optional arg) + "Switch to another window/buffer. +Calls `other-window', which see, unless +- the current window is alone on its frame +- `other-window-dwim' is called with \\[universal-argument] +In these cases, switch to the last-used buffer." + (interactive "P") + (if (or arg (one-window-p)) + (switch-to-buffer (other-buffer) nil t) + (other-window 1))) +(keymap-global-set "M-o" #'other-window-dwim) +(keymap-global-set "C-x o" #'other-window-dwim) + +(defun delete-window-dwim () + "Delete the current window or bury its buffer. +If the current window is alone in its frame, bury the buffer +instead." + (interactive) + (unless (ignore-errors (delete-window) t) + (bury-buffer))) +(keymap-global-set "C-x 0" #'delete-window-dwim) + + +;;; Org mode + +(keymap-global-set "C-c a" #'org-agenda) +(keymap-global-set "C-c c" #'org-capture) +(keymap-global-set "C-c l" #'org-store-link) + +(setopt org-clock-clocked-in-display 'mode-line) +(setopt org-clock-out-remove-zero-time-clocks t) +(setopt org-clock-frame-title-format '("%b" " - " (t org-mode-line-string))) +(setopt org-tags-column (- (- fill-column 3))) +(setopt org-log-into-drawer t) +(setopt org-clock-into-drawer t) +(setopt org-special-ctrl-a/e t) +(setopt org-special-ctrl-k t) +(setopt org-archive-mark-done t) +(setopt org-agenda-window-setup 'current-window) +(setopt org-agenda-restore-windows-after-quit t) +(setopt org-agenda-skip-deadline-if-done t) +(setopt org-agenda-skip-scheduled-if-done t) +(setopt org-agenda-inhibit-startup t) +(setopt org-deadline-warning-days 0) +(setopt org-cycle-separator-lines 0) +(setopt org-agenda-span 10) +(setopt org-blank-before-new-entry '((heading . t) + (plain-list-item . nil))) + +(defvar-local org-agenda/setup-done nil) + +(add-hook 'org-agenda-after-show-hook + (defun org-agenda-after-show/setup () + (org-narrow-to-subtree) + (goto-char (point-min)) + (unless org-agenda/setup-done + (run-hooks 'org-mode-hook)) + (setq org-agenda/setup-done t))) + +;; org-return-dwim +;; https://github.com/alphapapa/unpackaged.el, +;; http://kitchingroup.cheme.cmu.edu/blog/2017/04/09/A-better-return-in-org-mode/ +(defun org-return-dwim (&optional arg) + "A helpful replacement for `org-return'. +When called interactively with \\[universal-argument], call `org-return' +itself. Other values of ARG will call `newline' with that ARG." + (interactive "P") + ;; Auto-fill if enabled + (when auto-fill-function + (dolist (func (ensure-list auto-fill-function)) + (funcall func))) + (cl-letf* ((el (org-element-at-point)) + ((symbol-function 'el-child-of) + (lambda (&rest types) + (org-element-lineage el types t)))) + (cond ; Figure out what we're going to do + (arg ; Handle prefix ARG + (pcase arg + ('(4) (org-return t nil t)) + (_ (newline arg t)))) + ((and org-return-follows-link ; Open a link + (el-child-of 'link)) + (org-open-at-point-global)) + ((org-at-heading-p) ; Open a paragraph after a heading + (let ((heading-start (org-entry-beginning-position))) + (goto-char (org-entry-end-position)) + (cond ((and (org-at-heading-p) ; Entry is only a heading + (= heading-start (org-entry-beginning-position))) + (end-of-line) + (newline 2)) + (:else ; Entry is more than a heading + (forward-line -1) + (end-of-line) + (when (org-at-heading-p) + ;; Open a paragraph + (forward-line) + (newline) + (forward-line -1)) + (while (not (looking-back "\\(?:[[:blank:]]?\n\\)\\{3\\}" nil)) + (newline)) + (forward-line -1))))) + ((org-at-item-checkbox-p) ; Insert a new checkbox item + (end-of-line) + (org-insert-todo-heading nil)) + ((org-in-item-p) ; Insert a new list item + (let* ((context (org-element-context el)) + (first-item-p (eq 'plain-list (car context))) + (itemp (eq 'item (car context))) + (emptyp (or + ;; This (regular) list item is empty + (eq (org-element-property :contents-begin context) + (org-element-property :contents-end context)) + ;; This (definition) list item is empty + (looking-at " *::"))) + (item-child-p (el-child-of 'item))) + (cond ((and itemp emptyp) + ;; This test has to be here even though it's the same as the + ;; :else clause, because an item that's empty will also satisfy + ;; the next clause. + (delete-region (line-beginning-position) (line-end-position)) + (newline)) + ((or first-item-p + (and itemp (not emptyp)) + item-child-p) + (org-end-of-item) + (org-insert-item)) + (:else + (delete-region (line-beginning-position) (line-end-position)) + (newline))))) + ((and (fboundp 'org-inlinetask-in-task-p) ; Just return for inline tasks + (org-inlinetask-in-task-p)) + (org-return)) + ((org-at-table-p) ; Insert a new table row + (cond ((save-excursion ; Empty row: end the table + (beginning-of-line) + (cl-loop with end = (line-end-position) + for cell = (org-element-table-cell-parser) + always (eq (org-element-property :contents-begin cell) + (org-element-property :contents-end cell)) + while (re-search-forward "|" end t))) + (delete-region (line-beginning-position) (line-end-position)) + (org-return)) + (:else ; Non-empty row + (org-return)))) + (:else ; Something else + (org-return))))) + +(defun org-table-copy-down|org-return-dwim (&optional n) + "Call `org-table-copy-down' or `+org-return' depending on context." + (interactive "P") + (if (org-table-check-inside-data-field 'noerror) + (org-table-copy-down (or n 1)) + (org-return-dwim n))) + +(defmacro org-insert-or-surround (character) + (let ((c (gensym))) + `(defun ,(intern (format "org-insert-or-surround-%s" character)) (arg) + ,(format "Insert %s or surround the region with it." character) + (interactive "p") + (let ((,c ,(if (stringp character) + (string-to-char character) + character))) + (if (org-region-active-p) + (let ((begin (region-beginning)) + (end (region-end))) + (save-mark-and-excursion + (deactivate-mark) + (goto-char begin) + (self-insert-command arg ,c) + (goto-char (+ 1 end)) + (self-insert-command arg ,c))) + (self-insert-command arg ,c)))))) + +(with-eval-after-load 'org + (keymap-set org-mode-map "RET" #'org-return-dwim) + (keymap-set org-mode-map "S-" #'org-table-copy-down|org-return-dwim) + (keymap-set org-mode-map "*" (org-insert-or-surround "*")) + (keymap-set org-mode-map "/" (org-insert-or-surround "/")) + (keymap-set org-mode-map "_" (org-insert-or-surround "_")) + (keymap-set org-mode-map "=" (org-insert-or-surround "=")) + (keymap-set org-mode-map "~" (org-insert-or-surround "~")) + (keymap-set org-mode-map "+" (org-insert-or-surround "+"))) + +;; Copy rich text to the keyboard +(defcustom clipboard-html-copy-program + (if (or (equal "wayland" + (getenv "XDG_SESSION_TYPE")) + (getenv "WAYLAND_DISPLAY")) + '("wl-copy" "-t" "text/html") + '("xclip" "-t" "text/html" "-selection" "clipboard")) + "Program to use to copy HTML to the clipboard. +Should be a list of strings---the command line. +Defaults to 'wl-copy' on wayland and 'xclip' on Xorg." + :type '(repeat string)) + +(defun org-export-html-copy (&rest org-export-args) + "Export current org buffer to HTML and copy to clipboard as rich text. +ORG-EXPORT-ARGS are passed to `org-export-to-buffer'." + (let ((buf (generate-new-buffer "*org-html-clipboard*" t))) + (apply #'org-export-to-buffer 'html buf org-export-args) + (with-current-buffer buf + (apply #'call-process-region + (point-min) + (point-max) + (car clipboard-html-copy-program) + nil ; don't delete text + nil ; discard the output + nil ; don't redisplay + (cdr clipboard-html-copy-program)) + (kill-buffer-and-window)) + (message "HTML copied to clipboard."))) + +(defun org-subtree-to-html-to-clipboard () + "Export current subtree to HTML." + (interactive) + (org-export-html-copy nil :subtree)) + +;; (info "(org) Breaking Down Tasks") +(defun org-summary-todo (n-done n-not-done) + "Switch entry to DONE when all subentries are done, to TODO otherwise." + (let (org-log-done org-log-states) ; turn off logging + (org-todo (if (= n-not-done 0) "DONE" "TODO")))) +(add-hook 'org-after-todo-statistics-hook #'org-summary-todo) + +;; Clean up the buffer view +(defun org-hide-drawers-except-point () + "Hide all drawers except for the one point is in." + ;; Most of this bit is taken from `org-fold--hide-drawers'. + (let ((pt (point)) + (begin (point-min)) + (end (point-max))) + (save-excursion + (goto-char begin) + (while (and (< (point) end) + (re-search-forward org-drawer-regexp end t)) + (if (org-fold-folded-p nil 'drawer) + (goto-char (org-fold-next-folding-state-change 'drawer nil end)) + (let* ((drawer (org-element-at-point)) + (type (org-element-type drawer)) + (el-begin (org-element-property :begin drawer)) + (el-end (org-element-property :end drawer))) + (when (memq type '(drawer property-drawer)) + (org-fold-hide-drawer-toggle + (if (< el-begin pt el-end) 'off 'on) + nil drawer) + (goto-char el-end)))))))) +(add-local-mode-hook 'org-mode-hook 'before-save-hook + #'org-hide-drawers-except-point) + +;; Fix braindead behavior +(with-eval-after-load 'org-mouse + (defun org--mouse-open-at-point (orig-fun &rest args) + (let ((context (org-context))) + (cond + ;; Don't org-cycle when clicking on headline stars. The biggest problem + ;; is that this function advises `org-open-at-point', so I can't C-c C-o + ;; from a headline star. + ;; ((assq :headline-stars context) (org-cycle)) + ((assq :checkbox context) (org-toggle-checkbox)) + ((assq :item-bullet context) + (let ((org-cycle-include-plain-lists t)) (org-cycle))) + ((org-footnote-at-reference-p) nil) + (t (apply orig-fun args)))))) + +(defun define-org-capture-template (description &rest args) + "Define an template for `org-capture-templates'. +Will not replace an existing template unless `:force' in ARGS is +non-nil. ARGS is a plist, which in addition to the additional +options `org-capture-templates' accepts (which see), also accepts +the following: `:keys', `:description', `:type', `:target', and +`:template'." + (declare (indent 1)) + (let* ((keys (plist-get args :keys)) + (type (plist-get args :type)) + (target (plist-get args :target)) + (template (plist-get args :template)) + (force (plist-get args :force)) + (template-value + (append + (list description) + (when (or type target template) + (list (or type 'entry) target template)) + (cl-loop for i from 0 below (length args) by 2 + unless (member (nth i args) + '( :keys :description :type + :target :template)) + append (list (nth i args) + (plist-get args (nth i args))))))) + (if (seq-find (lambda (el) (equal (car el) keys)) + org-capture-templates) + (and force + (setf (alist-get keys org-capture-templates nil nil #'equal) + template-value)) + (setf org-capture-templates + (append org-capture-templates + (list (cons keys template-value))))) + org-capture-templates)) + +(add-hook 'org-mode-hook + (defun org-mode-line-position () + (setq-local mode-line-position + '((:propertize + ("" mode-line-percent-position) + local-map mode-line-column-line-number-mode-map + display (min-width (5.0))) + (org-word-count-mode org-word-count-string)))) + (setq mode-line-misc-info + (delete '(org-word-count-mode org-word-count-string) + mode-line-misc-info))) + +;;; Org word count +;; also does Flesch-Kincaid reading level. +;; TODO: customization ... stuff. + +(defun fk-region (start end) + (interactive "r") + ;; (let* ((fk-buf (get-buffer-create " *fk*")) + ;; (fk-proc + ;; (start-process "fk" fk-buf "/home/acdw/src/fk/fk.perl"))) + ;; (set-process-sentinel fk-proc #'ignore) + ;; (process-send-region fk-proc start end) + ;; (process-send-eof fk-proc) + ;; (with-current-buffer fk-buf + ;; (goto-char (point-max)) + ;; (forward-line -1) + ;; (string-chop-newline (buffer-substring-no-properties + ;; (line-beginning-position) (point-max))))) + + (let ((shell-command-buffer-name (format " *fk/%s*" (buffer-name)))) + (shell-command-on-region start end "~/src/fk/fk.perl") + (with-current-buffer shell-command-buffer-name + (buffer-substring-no-properties (point-min) (- (point-max) 1)))) + ) + +(defun org-word-count-region (start end &optional interactive) + (interactive "r\np") + (when (derived-mode-p 'org-mode) + (save-window-excursion + (inhibit-messages + (let ((shell-command-buffer-name (format " *wc/%s*" (buffer-name))) + wc fk) + (shell-command-on-region start end + "pandoc -t plain -f org") + (with-current-buffer shell-command-buffer-name + (setq wc (count-words (point-min) (point-max))) + (setq fk (string-to-number (fk-region (point-min) (point-max))))) + (when interactive (message "%s" wc)) + (list wc fk)))))) + +(defvar-local org-word-count-string "" + "Number of words in buffer.") + +(defun update-org-word-count-string () + (when (derived-mode-p 'org-mode) + (setq org-word-count-string + (apply #'format " %dw/%.2ffk" + (org-word-count-region (point-min) (point-max)))))) + +(defvar org-word-count-timer nil + "Timer for `org-word-count'.") + +(define-minor-mode org-word-count-mode + "Count words and update the org-word-count-string." + :lighter " owc" + (cond + ((and (derived-mode-p 'org-mode) + org-word-count-mode) + (unless (timerp org-word-count-timer) + (setq org-word-count-timer + (run-with-idle-timer 1 t #'update-org-word-count-string)))) + (:else + (when (timerp org-word-count-timer) + (cancel-timer org-word-count-timer)) + (setq org-word-count-timer nil) + (setq org-word-count-mode nil)))) +(hide-minor-mode 'org-word-count-mode) + +(add-hook 'org-mode-hook #'org-word-count-mode) + +;;; Org recentering + +(defun org-recenter (&optional arg) + (interactive "P") + (if (or arg + (eq last-command 'org-recenter)) + (recenter-top-bottom arg) + (save-excursion + (unless (org-at-heading-p) + (ignore-errors (org-previous-visible-heading 1))) + (recenter-top-bottom 0)))) +(with-eval-after-load 'org + (keymap-set org-mode-map "C-l" #'org-recenter)) + +;;; Org links -- extra types + +(with-eval-after-load 'ol + (org-link-set-parameters "tel" :follow #'ignore) + (org-link-set-parameters "sms" :follow #'ignore)) + + +;;; Jabber + +;; (when (package-ensure 'jabber t t) +;; (setopt jabber-chat-buffer-format "*%n*") +;; (setopt jabber-browse-buffer-format "*%n*") +;; (setopt jabber-groupchat-buffer-format "*%n*") +;; (setopt jabber-muc-private-buffer-format "*%n*") + +;; (face-spec-set 'jabber-activity-face +;; '((t :inherit jabber-chat-prompt-foreign +;; :foreground unspecified +;; :weight normal))) +;; (face-spec-set 'jabber-activity-personal-face +;; '((t :inherit jabber-chat-prompt-local +;; :foreground unspecified +;; :weight bold))) +;; (face-spec-set 'jabber-chat-prompt-local +;; '((t :inherit minibuffer-prompt +;; :foreground unspecified +;; :weight normal +;; :slant italic))) +;; (face-spec-set 'jabber-chat-prompt-foreign +;; '((t :inherit warning +;; :foreground unspecified +;; :weight normal))) +;; (face-spec-set 'jabber-chat-prompt-system +;; '((t :inherit font-lock-doc-face +;; :foreground unspecified))) +;; (face-spec-set 'jabber-rare-time-face +;; '((t :inherit font-lock-comment-face +;; :foreground unspecified +;; :underline nil))) + +;; (setopt jabber-auto-reconnect t) +;; (setopt jabber-last-read-marker +;; "-------------------------------------------------------------------") +;; (setopt jabber-muc-decorate-presence-patterns +;; '(("\\( enters the room ([^)]+)\\| has left the chatroom\\)$" . nil) +;; ("Mode #.*" . jabber-muc-presence-dim) +;; ("." . jabber-muc-presence-dim))) +;; (setopt jabber-activity-make-strings #'jabber-activity-make-strings-shorten) +;; (setopt jabber-rare-time-format +;; (format " - - - - - %%H:%d %%F" +;; (let ((min (string-to-number (format-time-string "%M")))) +;; (* 5 (floor min 5))))) +;; (setopt jabber-muc-header-line-format '(" " jabber-muc-topic)) + +;; (setopt jabber-groupchat-prompt-format "%n. ") +;; (setopt jabber-chat-local-prompt-format "%n. ") +;; (setopt jabber-chat-foreign-prompt-format "%n. ") +;; (setopt jabber-muc-private-foreign-prompt-format "%g/%n. ") + +;; (defun jabber-connect-all* (&optional arg) +;; "Connect to all defined jabber accounts. +;; If called with ARG non-nil, or with \\[universal-argument], +;; disconnect first." +;; (interactive "P") +;; (when arg (jabber-disconnect)) +;; (jabber-connect-all)) + +;; (with-eval-after-load 'jabber +;; (keymap-global-set "C-c C-SPC" #'jabber-activity-switch-to) +;; (require 'jabber-httpupload nil t) +;; (map-keymap (lambda (key command) +;; (define-key jabber-global-keymap (vector (+ key #x60)) command)) +;; jabber-global-keymap) +;; (keymap-global-set "C-x C-j" #'dired-jump) +;; (keymap-set jabber-global-keymap "c" #'jabber-connect-all*) +;; (keymap-global-set "C-c j" jabber-global-keymap)) + +;; (remove-hook 'jabber-alert-muc-hooks #'jabber-muc-echo) +;; (remove-hook 'jabber-alert-presence-hooks #'jabber-presence-echo) +;; (add-hook 'jabber-post-connect-hooks #'jabber-enable-carbons) +;; (add-hook 'jabber-chat-mode-hook #'olivetti-mode) +;; (add-hook 'jabber-chat-mode-hook +;; (defun jabber-chat-mode-no-position () +;; (setq-local mode-line-position nil))) +;; (add-hook 'jabber-alert-muc-hooks +;; (defun jabber@highlight-acdw (&optional _ _ buf _ _) +;; (when buf +;; (with-current-buffer buf +;; (let ((regexp (rx word-boundary +;; "acdw" ; maybe get from the config? +;; word-boundary))) +;; (hi-lock-unface-buffer regexp) +;; (highlight-regexp regexp 'jabber-chat-prompt-local)))))) + +;; (add-hook 'jabber-chat-mode-hook +;; (defun electric-pair-local-disable () +;; (electric-pair-local-mode -1))) + +;; (when (fboundp 'jabber-chat-update-focus) +;; (add-hook 'window-configuration-change-hook #'jabber-chat-update-focus))) + + +;;; Dired + +(keymap-global-set "C-x C-j" #'dired-jump) +(with-eval-after-load 'dired + (keymap-set dired-mode-map "C-j" #'dired-up-directory)) + +(setopt dired-auto-revert-buffer t) +(setopt dired-dwim-target t) ; dired-dwim-target-next ? + + +;;; Browsing the web + +(setopt browse-url-browser-function #'eww-browse-url) + +(defcustom browse-url-safe-browser-functions nil + "\"Safe\" browser functions." + :type '(repeat-function)) + +(defun browse-url-browser-function-safe-p (fn) + "Return t if FN is a \"safe\" browser function." + (memq fn (append browse-url-safe-browser-functions + (mapcar (lambda (i) + (plist-get (cdr i) :value)) + (seq-filter (lambda (i) + (eq (car i) 'function-item)) + (cdr (get 'browse-url-browser-function + 'custom-type))))))) + +(put 'browse-url-browser-function 'safe-local-variable + 'browse-url-browser-function-safe-p) + +;;; EWW + +(setopt eww-use-browse-url ".") +(setopt eww-auto-rename-buffer 'title) +(setopt eww-default-download-directory + (or (xdg-user-dir "DOWNLOAD") + "~/Downloads")) +(setopt eww-history-limit nil) + +(defun eww-readable/olivetti () + (interactive) + (olivetti-mode +1) + (eww-readable) + (eww-reload t)) + +(with-eval-after-load 'eww + (keymap-set eww-mode-map "R" #'eww-readable/olivetti)) + +;; Use Emacs bookmarks for EWW +(defun bookmark-eww--make () + "Make eww bookmark record." + `((filename . ,(plist-get eww-data :url)) + (title . ,(plist-get eww-data :title)) + (time . ,(current-time-string)) + (handler . ,#'bookmark-eww-handler) + (defaults . (,(concat + ;; url without the https and path + (replace-regexp-in-string + "/.*" "" + (replace-regexp-in-string + "\\`https?://" "" + (plist-get eww-data :url))) + " - " + ;; page title + (replace-regexp-in-string + "\\` +\\| +\\'" "" + (replace-regexp-in-string + "[\n\t\r ]+" " " + (plist-get eww-data :title)))))))) + +(defun bookmark-eww-handler (bm) + "Handler for eww bookmarks." + (eww-browse-url (alist-get 'filename bm))) + +(defun bookmark-eww--setup () + "Setup eww bookmark integration." + (setq-local bookmark-make-record-function #'bookmark-eww--make)) +(add-hook 'eww-mode-hook #'bookmark-eww--setup) + +(with-eval-after-load 'eww + (define-key eww-mode-map "b" #'bookmark-set) + (define-key eww-mode-map "B" #'bookmark-jump)) + +;; Transforming URLs +;; `eww-transform-url' exists, but I like my package better. + +(when (package-ensure 'browse-url-transform t) + (setopt browse-url-transform-alist + `(;; Privacy-respecting alternatives + ("twitter\\.com" . "nitter.snopyta.org") + ("\\(?:\\(?:old\\.\\)?reddit\\.com\\)" . "libreddit.de") + ("medium\\.com" . "scribe.rip") + ;; Text-mode of non-text-mode sites + ("www\\.npr\\.org" . "text.npr.org") + ;; Ask for raw versions of paste sites + ("^.*dpaste\\.com.*$" . "\\&.txt") + ("bpa\\.st/\\(.*\\)" . "bpa.st/raw/\\1") + ("\\(paste\\.debian\\.net\\)/\\(.*\\)" . "\\1/plain/\\2") + ("\\(pastebin\\.com\\)/\\\(.*\\)" . "\\1/raw/\\2") + ("\\(paste\\.centos\\.org/view\\)/\\(.*\\)" . "\\1/raw/\\2"))) + (browse-url-transform-mode) + (hide-minor-mode 'browse-url-transform-mode)) + +(with-eval-after-load 'browse-url-transform + (setq eww-url-transformers ; `setopt' causes a warning about custom-type + '(eww-remove-tracking + browse-url-transform-url))) + +;; External browsers: firefox > chromium > chrome +(setq browse-url-firefox-program + (or (executable-find "firefox") + (executable-find "firefox-esr")) + browse-url-firefox-new-window-is-tab t + browse-url-firefox-arguments '("--new-tab") + + browse-url-chromium-program + (or (executable-find "chromium") + (executable-find "chromium-browser")) + + browse-url-chrome-program + (or (executable-find "chrome") + (executable-find "google-chrome-stable")) + + browse-url-secondary-browser-function + (cond (browse-url-firefox-program #'browse-url-firefox) + (browse-url-chromium-program #'browse-url-chromium) + (browse-url-chrome-program #'browse-url-chrome) + (t #'browse-url-default-browser))) + +(defmacro open-url-with (commandline &optional buffer error-buffer) + (let ((buffer (or buffer " *open-url-with*")) + (error-buffer (or error-buffer " *open-url-with/errors*"))) + `(lambda (url &rest _) + (cl-letf (((alist-get ,buffer + display-buffer-alist + nil nil #'equal) + '(display-buffer-no-window))) + (async-shell-command (format ,commandline url) + ,buffer + ,error-buffer))))) + +(defun add-browse-url-handler (regexp opener) + "Add OPENER to open REGEXP urls." + (setf/assoc browse-url-handlers + regexp + opener)) + +(add-browse-url-handler (rx (or (: ".pdf" eos) + (: ".PDF" eos))) + (open-url-with "zathura %s")) +(add-browse-url-handler (rx (or (: ".mp4" eos) + "youtube.com" + "piped.kavin.rocks")) + (open-url-with "mpv %s")) + +(when (package-ensure 'elpher) + (add-browse-url-handler (rx bos "gemini:") + #'elpher-browse-url-elpher)) + +;; Hinting at links +(when (package-ensure 'link-hint) + (setopt link-hint-avy-style 'at-full) + (setopt link-hint-avy-all-windows t) + (defvar link-hint-map + (define-keymap + :name "Open a link" + :prefix 'link-hint-map + "M-l" #'link-hint-open-link + "M-w" #'link-hint-copy-link)) + (keymap-global-set "M-l" 'link-hint-map)) + + +;;; Eshell + +(setopt eshell-modules-list + '(eshell-alias + eshell-banner + eshell-basic + eshell-cmpl + eshell-dirs + eshell-elecslash + eshell-extpipe + eshell-glob + eshell-hist + eshell-ls + eshell-pred + eshell-prompt + eshell-script + eshell-smart + eshell-unix)) + +(setopt eshell-banner-message "") +(setopt eshell-destroy-buffer-when-process-dies t) +(setopt eshell-error-if-no-glob t) +(setopt eshell-hist-ignoredups 'erase) +(setopt eshell-kill-on-exit t) +(setopt eshell-prefer-lisp-functions t) +(setopt eshell-prefer-lisp-variables t) +(setopt eshell-scroll-to-bottom-on-input 'this) +(setopt eshell-history-size 1024) +(setopt eshell-input-filter (lambda (input) + (or (eshell-input-filter-default input) + (eshell-input-filter-initial-space input)))) +(setopt eshell-prompt-function + (lambda () + (concat (if (= 0 eshell-last-command-status) + "^_^" + ";_;") + " " + (abbreviate-file-name (eshell/pwd)) + (if (= (user-uid) 0) + " # " + " $ ")))) +(setopt eshell-scroll-to-bottom-on-input 'this) + +(add-hook 'eshell-mode-hook + (defun eshell-setup () + (setq-local outline-regexp eshell-prompt-regexp) + (setq-local page-delimiter eshell-prompt-regexp) + (setq-local imenu-generic-expression + '(("Prompt" " \\($\\|#\\) \\(.*\\)" 2))) + (setq-local truncate-lines t))) + +(setenv "PAGER" (executable-find "cat")) + +(setopt eshell-where-to-jump 'begin) +(setopt eshell-review-quick-commands nil) +(setopt eshell-smart-space-goes-to-end t) + +(when (package-ensure 'eat) + (add-hook 'eshell-first-time-mode-hook #'eat-eshell-mode) + (with-eval-after-load 'eat + (keymap-unset eat-eshell-semi-char-mode-map "M-o" t))) + +(if (package-ensure 'eshell-toggle) + (keymap-global-set "C-z" #'eshell-toggle) + ;; If the package doesn't load for some reason, do the dumb thing instead + (defun eshellp (buffer-or-name) + (with-current-buffer buffer-or-name + (derived-mode-p 'eshell-mode))) + + (defun eshell-pop-up (&optional arg) + "Pop up an eshell in the `default-directory'. +NEW is passed to `eshell'." + (interactive "P") + (require 'eshell) + (let ((dir default-directory) + (display-comint-buffer-action 'pop-to-buffer)) + (if-let ((buf (and (not arg) + (or (get-buffer eshell-buffer-name) + (seq-find #'eshellp (reverse (buffer-list))))))) + (pop-to-buffer buf) + (eshell arg)) + ;; In the eshell buffer + (unless (file-equal-p default-directory dir) + (eshell/cd dir) + (eshell-send-input) + (goto-char (point-max))))) + + (keymap-global-set "C-z" #'eshell-pop-up) + (with-eval-after-load 'esh-mode + (keymap-set eshell-mode-map "C-z" #'quit-window))) + +(when (package-ensure 'wiki-abbrev t) + (wiki-abbrev-insinuate) + (add-hook 'text-mode-hook #'abbrev-mode)) + +;;; Dinghie + +(add-to-list 'mode-line-misc-info + '(buffer-ding-cookie (:propertize buffer-ding-cookie + face error)) + :append) + +(defvar buffer-ding-timer nil + "Timer for `buffer-ding'.") +(defvar buffer-ding-cookie nil + "Variable to hold the `face-remap-add-relative' cookie.") +(defcustom buffer-ding-timeout 0.25 + "How long to ding the buffer for.") + +(defun buffer-unding () + "Unflash the buffer after done `ding'ing." + ;; (face-remap-remove-relative buffer-ding-cookie) + (setq buffer-ding-cookie nil) + (force-mode-line-update t)) + +(defun buffer-ding () + "Flash the buffer for `ding'." + (cond + ((timerp buffer-ding-timer) + (cancel-timer buffer-ding-timer) + (setq buffer-ding-timer nil) + (buffer-ding)) + ((and (null buffer-ding-timer) + buffer-ding-cookie) + (setq buffer-ding-cookie nil) + (buffer-unding)) + (t + ;; (setq buffer-ding-cookie (face-remap-add-relative 'default 'error)) + (setq buffer-ding-cookie " Ding!") + (force-mode-line-update) + (run-with-timer buffer-ding-timeout nil #'buffer-unding)))) + +;; (setopt ring-bell-function (lambda () (pulse-momentary-highlight-region +;; (window-start) (window-end)))) + +(setopt ring-bell-function #'buffer-ding) +(add-hook 'isearch-mode-end-hook #'buffer-unding) + +(defun mapc-buffers (fn &rest modes) + (cl-loop for buf being the buffers + do (with-current-buffer buf + (when (or (null modes) + (apply #'derived-mode-p modes)) + (funcall fn))))) + +(defun mapc-buffers/progress (msg fn &rest modes) + (dolist-with-progress-reporter (buf (buffer-list)) msg + (with-current-buffer buf + (when (or (null modes) + (apply #'derived-mode-p modes)) + (funcall fn))))) + +;;; Flash! + +(defun flash-region@ (orig start end &rest args) + (apply orig start end args) + (pulse-momentary-highlight-region start end)) + +(advice-add 'eval-region :around #'flash-region@) +(with-eval-after-load 'geiser + (advice-add 'geiser-eval-region :around #'flash-region@)) + +;;; KeepassXC Integration + +(when (package-ensure 'keepassxc-shim t) + (keepassxc-shim-activate)) + +;;; RCIRC + +(when (require 'rcirc) + (setopt rcirc-default-full-name user-full-name) + (setopt rcirc-default-user-name user-login-name) + (setopt rcirc-authenticate-before-join t) + (setopt rcirc-display-server-buffer nil) + (setopt rcirc-buffer-maximum-lines 1000) + (setopt rcirc-kill-channel-buffers t) + (setopt rcirc-track-ignore-server-buffer-flag t) + + ;; Theming + (setopt rcirc-prompt "%t> ") + (setopt rcirc-default-part-reason "See You Space Cowboy . . .") + (setopt rcirc-default-quit-reason "(TLS connection improperly terminated)") + (setopt rcirc-url-max-length 24) + (setopt rcirc-response-formats + '(("PRIVMSG" . "<%N> %m") + ("NOTICE" . "-%N- %m") + ("ACTION" . "* %N %m") + ("COMMAND" . "%fs%m%f-") + ("ERROR" . "%fw!!! %m") + ("FAIL" . "(%fwFAIL%f-) %m") + ("WARN" . "(%fwWARN%f-) %m") + ("NOTE" . "(%fwNOTE%f-) %m") + (t . "%fp*** %fs%n %r %m"))) + + (face-spec-set 'rcirc-nick-in-message-full-line + '((t :foreground unspecified + :background unspecified + :weight unspecified + :inherit nil))) + + (add-to-list 'rcirc-omit-responses "NAMES") + + (defun chat/setup () + (whitespace-mode -1) + (electric-pair-local-mode -1) + ;; IDK what's the deal with this + (olivetti-mode +1) + (visual-line-mode -1) + (word-wrap-whitespace-mode +1)) + + (setq rcirc-debug-flag t) + + (advice-add 'rcirc :after + (defun enable-rcirc-track-minor-mode (&rest _) + (rcirc-track-minor-mode 1))) + + (defun rcirc-kill () + "Kill all rcirc buffers and turn off `rcirc-track-minor-mode'." + (interactive) + (mapc-buffers/progress "Killing rcirc buffers..." + (lambda () + (let ((kill-buffer-hook)) + (kill-buffer))) + 'rcirc-mode) + (dolist-with-progress-reporter (server rcirc-server-alist) + "Removing cached passwords..." + (when-let ((pwf (plist-get server :password-function))) + (setf (plist-get server :password) + pwf))) + (rcirc-track-minor-mode -1)) + + (add-hook 'rcirc-mode-hook #'chat/setup) + (add-hook 'rcirc-mode-hook #'rcirc-omit-mode) + (add-hook 'rcirc-track-minor-mode-hook + (defun rcirc-track@buffer-list-change () + (add-hook 'buffer-list-update-hook + #'rcirc-window-configuration-change))) + + ;; "Fix" some things + (setf rcirc-implemented-capabilities + ;; I don't use these, and they mess up display in a few of my chats + (delete "message-tags" rcirc-implemented-capabilities)) + + ;; Adding servers more better-er + (defun rcirc-add-server (name &rest spec) + "Add a server to `rcirc-server-alist' and `rcirc-authinfo' at once. +TODO: fully document" + (let ((name* (if (plist-get spec :host) + (plist-get spec :host) + name)) + (nick (or (plist-get spec :nick) + (bound-and-true-p rcirc-default-nick) + (bound-and-true-p user-login-name))) + (user-name (or (plist-get spec :user-name) + (plist-get spec :user) + (plist-get spec :nick) + (bound-and-true-p rcirc-default-user-name) + (bound-and-true-p rcirc-default-nick) + (bound-and-true-p user-login-name))) + (password (let ((password (or (plist-get spec :password) + (plist-get spec :pass)))) + ;; (cond + ;; ((functionp password) (funcall password)) + ;; ((stringp password) password)) + password + ))) + ;; Add the server to `rcirc-server-alist' + (setf (alist-get name* rcirc-server-alist nil nil #'equal) + (append + (list :nick nick + :user-name user-name) + (when password (list :password password)) + (when-let ((full-name (plist-get spec :full-name))) + (list :full-name full-name)) + (when-let ((channels (plist-get spec :channels))) + (list :channels channels)) + (when-let ((port (plist-get spec :port))) + (list :port port)) + (when-let ((encryption (plist-get spec :encryption))) + (list :encryption encryption)) + (when-let ((server-alias (or (plist-get spec :server-alias) + (and (plist-get spec :host) + name)))) + (list :server-alias server-alias)))) + ;; Add it to `rcirc-authinfo' + (when-let ((auth (plist-get spec :auth))) + (unless password (user-error "Trying to auth without a password")) + (setf (alist-get name* rcirc-authinfo nil nil #'equal) + (cl-case auth + (nickserv (list 'nickserv nick password)) + (bitlbee (list 'bitlbee nick password)) + (quakenet (list 'quakenet user-name password)) + (sasl (list 'sasl user-name password)) + ;; (chanserv) ; These two aren't supported. + ;; (certfp) + (t (user-error "Unsupported :auth type `%s'" + (plist-get plist :auth)))))) + ;; Return the server's name so that we don't leak authinfo + name)) + + (defun rcirc-resolve-passwords (&rest _) + (dolist-with-progress-reporter (s rcirc-server-alist) + "Resolving lambda passwords in `rcirc-server-alist...'" + (let ((pw (plist-get (cdr s) :password))) + (setf (plist-get (cdr s) :password-function) pw) + (setf (plist-get (cdr s) :password) + (if (functionp pw) (funcall pw) pw)))) + (dolist-with-progress-reporter (i rcirc-authinfo) + "Resolving lambda passwords in `rcirc-authinfo...'" + (let ((pw (cadddr i))) + (setf (cadddr i) + (if-let ((s (assoc (car i) rcirc-server-alist))) + (plist-get (cdr s) :password) + (if (functionp pw) (funcall pw) pw)))))) + + (advice-add 'rcirc :before #'rcirc-resolve-passwords) + + (defun rcirc/password (&rest spec) + (lambda () + (auth-info-password + (car + (apply #'auth-source-search spec))))) + + (setq rcirc-server-alist nil) + + (rcirc-add-server "tilde.town" + :host "localhost" :port 6969 + :channels '("#tildetown" "#newbirc") + :auth 'sasl + :password + (rcirc/password :host "localhost:6969" :user "acdw")) + ;; (rcirc-add-server "43beans.casa" + ;; :host "localhost" :port 6970 + ;; :channels '("#beans") + ;; :auth nil + ;; :password nil) + (rcirc-add-server "tilde.chat" + :host "irc.tilde.chat" :port 6697 :encryption 'tls + ;; :channels left blank. There's some kind of race + ;; condition in SASL and identd that means I authenticate + ;; before being fully authenticated? Or something. + ;; Tilde.chat's NickServ does autojoin, though, so that + ;; works out without an afternoon of debugging. + :auth 'sasl + :password (rcirc/password :host "tilde.chat" :user "acdw")) + (rcirc-add-server "m455.casa" + :port 6697 :encryption 'tls + :channels '("#basement" "#43beans") + :auth 'sasl + :password (rcirc/password :host "m455.casa" :user "acdw")) + (rcirc-add-server "libera.chat" + :host "irc.libera.chat" :port 6697 :encryption 'tls + :channels '("#emacs" "#rcirc") + :auth 'sasl + :password (rcirc/password :host "libera.chat" :user "acdw")) + ;; End of rcirc configuration. + ) + +(when (package-ensure 'web-mode) + (add-to-list 'auto-mode-alist '("\\.html?\\'" . web-mode)) + (add-to-list 'auto-mode-alist '("\\.phtml\\'" . web-mode)) + (add-to-list 'auto-mode-alist '("\\.tpl\\.php\\'" . web-mode)) + (add-to-list 'auto-mode-alist '("\\. [agj]sp\\'" . web-mode)) + (add-to-list 'auto-mode-alist '("\\.as[cp]x\\'" . web-mode)) + (add-to-list 'auto-mode-alist '("\\.erb\\'" . web-mode)) + (add-to-list 'auto-mode-alist '("\\.mustache\\'" . web-mode)) + (add-to-list 'auto-mode-alist '("\\.djhtml\\'" . web-mode))) -- cgit 1.4.1-21-gabe81