From 5c37068ff0ef82ee7c395048b5571f75eb0d7ab2 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Tue, 1 Aug 2023 20:30:22 -0500 Subject: meh --- init.el | 2351 +++++++++++++++++++++++++++++++++++++++++------------------- readme.txt | 4 - 2 files changed, 1624 insertions(+), 731 deletions(-) delete mode 100644 readme.txt diff --git a/init.el b/init.el index c6d361b..a0324cf 100644 --- a/init.el +++ b/init.el @@ -1,23 +1,132 @@ -;;; ~/.emacs -*- mode: emacs-lisp; lexical-binding: t; -*- +;;; ~/.emacs -*- mode: emacs-lisp; lexical-binding: t; -*- ;; by Case Duckworth -;; Bankruptcy 10: "Annoyance" +;; License: GPLv3 -;;; Commentary: +(setopt custom-file (locate-user-emacs-file "custom.el")) +(load custom-file :noerror) -;; This is my Emacs configuration. There are many like it but this -;; one is mine. -;; -;; For the tenth time! +(add-hook 'after-init-hook + (lambda () (load (locate-user-emacs-file "private") :noerror))) -;;; Code: +(require 'package) +(add-to-list 'package-archives '("melpa" . "https://melpa.org/packages/") t) +(package-initialize) -(add-hook 'after-init-hook - (lambda () - (load (locate-user-emacs-file "private")))) +(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) -;;; Definitions: +(setopt inhibit-startup-screen t) +(setopt initial-buffer-choice t) +(setopt initial-scratch-message + ;; ";; Emacs!\n\n" + nil) -(defun reset-faces () +(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 @@ -31,7 +140,6 @@ font-lock-number-face font-lock-keyword-face font-lock-set-face - font-lock-warning-face font-lock-punctuation-face font-lock-constant-face font-lock-type-face @@ -40,76 +148,38 @@ font-lock-misc-punctuation-face font-lock-bracket-face)) (face-spec-set face '((t :foreground unspecified - :background 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 electric-pair-local-mode-disable () - "Disable `electric-pair-mode', locally." - (electric-pair-local-mode -1)) - -(defun kill-this-buffer (&optional buffer-or-name) - "Kill this buffer, or BUFFER-OR-NAME. -When called interactvely, the user will be prompted when passing -\\[universal-argument]." - (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))))) - -(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)) - -(defun other-window-or-switch-buffer (&optional arg) - "Switch to the other window. -If a window is the only buffer on a frame, switch buffer. When -run with \\[universal-argument], unconditionally switch buffer." - (interactive "P") - (if (or arg (one-window-p)) - (switch-to-buffer (other-buffer) nil t) - (other-window 1))) - -(defun cycle-spacing@ (&optional n) - ;; `cycle-spacing' is wildly different in 29.1 over 28. - "Negate N argument on `cycle-spacing'. -That is, with a positive N, deletes newlines as well, leaving -N -spaces. If N is negative, it will not delete newlines and leave -N spaces." - (interactive "*p") - (cycle-spacing (- n))) (defun first-frame@set-fonts () (remove-hook 'server-after-make-frame-hook @@ -158,486 +228,489 @@ N spaces." (setopt tab-bar-show t) (tab-bar-mode)) -(defun renz/sort-by-alpha-length (elems) - "Sort ELEMS first alphabetically, then by length." - (sort elems (lambda (c1 c2) - (or (string-version-lessp c1 c2) - (< (length c1) (length c2)))))) - -(defun renz/sort-by-history (elems) - "Sort ELEMS by minibuffer history. -Use `mct-sort-sort-by-alpha-length' if no history is available." - (if-let ((hist (and (not (eq minibuffer-history-variable t)) - (symbol-value minibuffer-history-variable)))) - (minibuffer--sort-by-position hist elems) - (renz/sort-by-alpha-length elems))) - -(defun renz/completion-category () - "Return completion category." - (when-let ((window (active-minibuffer-window))) - (with-current-buffer (window-buffer window) - (completion-metadata-get - (completion-metadata (buffer-substring-no-properties - (minibuffer-prompt-end) - (max (minibuffer-prompt-end) (point))) - minibuffer-completion-table - minibuffer-completion-predicate) - 'category)))) - -(defun renz/sort-multi-category (elems) - "Sort ELEMS per completion category." - (pcase (renz/completion-category) - ('nil elems) ; no sorting - ('kill-ring elems) - ('project-file (renz/sort-by-alpha-length elems)) - (_ (renz/sort-by-history elems)))) - -(defvar no-tabs-modes '(emacs-lisp-mode - lisp-mode - scheme-mode - python-mode - haskell-mode) - "Modes /not/ to indent with tabs.") +(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))) -(defun indent-tabs-mode-maybe () - (if (apply #'derived-mode-p no-tabs-modes) - (indent-tabs-mode -1) - (indent-tabs-mode 1))) +(run-after-init-or-first-frame #'first-frame@set-fonts) -(define-minor-mode truncate-lines-mode - "Buffer-local mode to toggle `truncate-lines'." - :lighter "" - (setq-local truncate-lines truncate-lines-mode)) +(setopt frame-resize-pixelwise t) +(setopt window-resize-pixelwise t) -;;; Region or buffer stuff +(defun tab-bar-end-space () + `((end menu-item " " ignore))) -(defun call-with-region-or-buffer (fn &rest _r) - "Call function FN with current region or buffer. -Good to use for :around advice." - (if (region-active-p) - (funcall fn (region-beginning) (region-end)) - (funcall fn (point-min) (point-max)))) +(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) -(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 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)))) - - -(defun vc-remote-off () - "Turn VC off when remote." - (when (file-remote-p (buffer-file-name)) - (setq-local vc-handled-backends nil))) - -(defun +titlecase-sentence-style-dwim (&optional arg) - "Titlecase a sentence. -With prefix ARG, toggle the value of -`titlecase-downcase-sentences' before sentence-casing." - (interactive "P") - (let ((titlecase-downcase-sentences (if arg (not titlecase-downcase-sentences) - titlecase-downcase-sentences))) - (titlecase-dwim 'sentence))) +(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) + " "))) -(defun +titlecase-org-headings () - (interactive) - (require 'org) - (save-excursion - (goto-char (point-min)) - ;; See also `org-map-tree'. I'm not using that function because I want to - ;; skip the first headline. A better solution would be to patch - ;; `titlecase-line' to ignore org-mode metadata (TODO cookies, tags, etc). - (let ((level (funcall outline-level)) - (org-special-ctrl-a/e t)) - (while (and (progn (outline-next-heading) - (> (funcall outline-level) level)) - (not (eobp))) - (titlecase-region (progn (org-beginning-of-line) (point)) - (progn (org-end-of-line) (point))))))) +(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))) -(defcustom browse-url-safe-browser-functions nil - "\"Safe\" browser functions." - :type '(repeat-function)) + +;;; Completion and minibuffer -(defun browse-url-browser-function-safe-p (fn) - "Return t if FN is a \"safe\" browser function." - (memq f (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))))))) +(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) -(put 'browse-url-browser-function 'safe-local-variable - 'browse-url-browser-function-safe-p) +(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) -;;; Packages: +;;; Text editing -(require 'package) -(add-to-list 'package-archives '("melpa" . "https://melpa.org/packages/") t) -(package-initialize) +(setopt fill-column 80) +(global-so-long-mode) -(defun ensure-package (pkg &optional localp) - "Esnure PKG is installed from repositories. -If LOCALP is t, add ~/src/PKG.el to `load-path'. -If LOCALP is a string, add that directory to the `load-path'." - (cond - ((stringp localp) - (and (file-exists-p localp) - (add-to-list 'load-path localp))) - (localp - (ensure-package pkg - (expand-file-name - (format "~/src/%s.el" - (symbol-name pkg))))) - (:else - (unless (package-installed-p pkg) - (unless (ignore-errors (package-install pkg)) - (package-refresh-contents) - (package-install pkg)))))) - -;; Install packages here. Acutal configuration is done in the Configuration -;; section. -(ensure-package 'consult) -(ensure-package 'marginalia) -(ensure-package 'visual-fill-column) -(ensure-package 'adaptive-wrap) -(ensure-package 'geiser) -(when (executable-find "csi") - (ensure-package 'geiser-chicken)) -(ensure-package 'avy) -(ensure-package 'zzz-to-char) -(ensure-package 'hungry-delete) -(ensure-package 'undohist) -(ensure-package 'jinx) -(ensure-package 'markdown-mode) -(ensure-package 'anzu) - -;; Local packages -(ensure-package 'scule t) -(ensure-package 'frowny t) -(ensure-package 'hippie-completing-read t) -(ensure-package 'mode-line-bell t) -(ensure-package 'titlecase t) -(ensure-package 'jabber t) +(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) -;;; Jabber +(add-hook 'ibuffer-mode-hook #'hl-line-mode) -(use-package jabber - :load-path "~/src/jabber.el" - :defer t - :bind-keymap (("C-c j" . jabber-global-keymap)) - :preface nil - (setq-default jabber-chat-buffer-format "*%n*" - jabber-browse-buffer-format "*%n*" - jabber-groupchat-buffer-format "*%n*" - jabber-muc-private-buffer-format "*%n*") - :custom-face - (jabber-activity-face ((t :inherit jabber-chat-prompt-foreign - :foreground unspecified - :weight normal))) - (jabber-activity-personal-face ((t :inherit jabber-chat-prompt-local - :foreground unspecified - :weight bold))) - (jabber-chat-prompt-local ((t :inherit minibuffer-prompt - :foreground unspecified - :weight normal - :slant italic))) - (jabber-chat-prompt-foreign ((t :inherit warning - :foreground unspecified - :weight normal))) - (jabber-chat-prompt-system ((t :inherit font-lock-doc-face - :foreground unspecified))) - (jabber-rare-time-face ((t :inherit font-lock-comment-face - :foreground unspecified - :underline nil))) - :config - (require 'jabber-httpupload nil t) - (setopt jabber-auto-reconnect t - jabber-last-read-marker "~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~" - jabber-muc-decorate-presence-patterns - '(("\\( enters the room ([^)]+)\\| has left the chatroom\\)$" . nil) - ("Mode #.*" . jabber-muc-presence-dim) - ("." . jabber-muc-presence-dim)) - jabber-activity-make-strings #'jabber-activity-make-strings-shorten - jabber-rare-time-format - (format " - - - - - %%H:%d %%F" - (let ((min (string-to-number (format-time-string "%M")))) - (* 5 (floor min 5)))) - jabber-muc-header-line-format '(" " jabber-muc-topic)) - - (setopt jabber-groupchat-prompt-format "%n. " - jabber-chat-local-prompt-format "%n. " - jabber-chat-foreign-prompt-format "%n. " - jabber-muc-private-foreign-prompt-format "%g/%n. ") - - (keymap-global-set "C-c C-SPC" #'jabber-activity-switch-to) - (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) - - (add-hook 'jabber-post-connect-hooks #'jabber-enable-carbons) - (remove-hook 'jabber-alert-muc-hooks 'jabber-muc-echo) - (remove-hook 'jabber-alert-presence-hooks 'jabber-presence-echo) - (add-hook 'jabber-chat-mode-hook 'visual-line-mode) - (add-hook 'jabber-chat-mode-hook (defun jabber-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)))))) - - (when (fboundp 'jabber-chat-update-focus) - (add-hook 'window-configuration-change-hook #'jabber-chat-update-focus))) +(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)))) - -;;; Configuration: +(delete-selection-mode) -(setopt custom-file (locate-user-emacs-file "custom.el")) -(load custom-file :noerror) +(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)) -;;; General keybinding changes +(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))))) -(keymap-global-set "M-o" #'other-window-or-switch-buffer) -(keymap-global-set "M-SPC" #'cycle-spacing@) -(keymap-global-set "M-u" #'universal-argument) -(keymap-set universal-argument-map "M-u" #'universal-argument-more) +;;; Prose -;;; Theme +(add-hook 'text-mode-hook #'visual-line-mode) -(if (daemonp) - (add-hook 'server-after-make-frame-hook #'first-frame@set-fonts) - (run-with-idle-timer 1 nil #'first-frame@set-fonts)) +(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))) -(tool-bar-mode -1) +(crux-with-region-or-buffer org-fk-region) -(setopt modus-themes2-bold-constructs nil - modus-themes-italic-constructs t - modus-themes-variable-pitch-ui t) +(when (package-ensure 'scule t t) + (keymap-global-set "M-c" scule-map)) -(add-hook 'modus-themes-after-load-theme-hook #'reset-faces) +(when (package-ensure 'titlecase t) + (keymap-set scule-map "M-t" #'titlecase-dwim)) -(load-theme 'modus-vivendi :no-confirm :no-enable) -(load-theme 'modus-operandi :no-confirm) +(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)))) -(add-hook 'text-mode-hook #'visual-line-mode) -(add-hook 'prog-mode-hook #'auto-fill-mode) -(add-hook 'prog-mode-hook #'display-fill-column-indicator-mode) +(package-ensure 'markdown-mode) -;;; Mode line - -(defvar mode-line-position - '("" - (:propertize - ("" - (:eval (if line-number-mode "%3l" "")) - (:eval (if column-number-mode - (if column-number-indicator-zero-based - "/%2c" - "/%2C") - ""))) - display (min-width (3.0))) - (:propertize (" [" (-3 "%p") "] ") - display (min-width (6.0))))) +;;; Programming -(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 - mode-line-misc-info - mode-line-end-spaces))) +(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) -;; Remove modes from mode-line -(dolist (minor-mode '(frowny-mode - whitespace-mode - hungry-delete-mode)) - (setf (alist-get minor-mode minor-mode-alist) (list "")) - (add-hook (intern (format "%s-hook" minor-mode)) - (lambda () - (setf (alist-get minor-mode minor-mode-alist) (list ""))))) +(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) -;;; Completion & minibuffer +(when (package-ensure 'dumb-jump) + (add-hook 'xref-backend-functions #'dumb-jump-xref-activate)) -(fido-vertical-mode) -(minibuffer-depth-indicate-mode) +(add-hook 'prog-mode-hook #'prettify-symbols-mode) -(setopt completion-auto-help (not icomplete-mode) - completion-auto-select 'second-tab - completions-header-format nil - completions-max-height 12 - completions-format 'one-column - completion-styles '(basic partial-completion emacs22 flex) - completion-ignore-case t - read-buffer-completion-ignore-case t - read-file-name-completion-ignore-case t - completions-detailed t - enable-recursive-minibuffers t - file-name-shadow-properties '(invisible t intangible t) - minibuffer-eldef-shorten-default t - minibuffer-prompt-properties '( read-only t - cursor-intangible t - face minibuffer-prompt) - window-resize-pixelwise t - frame-resize-pixelwise t) - -(add-hook 'completion-list-mode-hook #'truncate-lines-mode) -(add-hook 'minibuffer-setup-hook #'truncate-lines-mode) - -;; Up/down when completing in the minibuffer -;; (define-key minibuffer-local-map (kbd "C-p") #'minibuffer-previous-completion) -;; (define-key minibuffer-local-map (kbd "C-n") #'minibuffer-next-completion) - -;; Up/down when competing in a normal buffer -;; (define-key completion-in-region-mode-map (kbd "C-p") #'minibuffer-previous-completion) -;; (define-key completion-in-region-mode-map (kbd "C-n") #'minibuffer-next-completion) - -(setopt completions-sort #'renz/sort-multi-category) +(keymap-global-set "M-:" #'pp-eval-expression) -(setopt tab-always-indent 'complete) +;; Tabs -(file-name-shadow-mode) -(minibuffer-electric-default-mode) +(setopt tab-width 8) -(scroll-bar-mode -1) -(menu-bar-mode -1) +(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 electric-pair-skip-whitespace 'chomp) -(electric-pair-mode) - (setopt sh-basic-offset tab-width) +(setopt perl-indent-level tab-width) -(keymap-set emacs-lisp-mode-map "C-c C-c" #'eval-defun) -(keymap-set emacs-lisp-mode-map "C-c C-k" #'eval-buffer) -(keymap-set lisp-interaction-mode-map "C-c C-c" #'eval-defun) -(keymap-set lisp-interaction-mode-map "C-c C-k" #'eval-buffer) - -(advice-add 'indent-region :around #'call-with-region-or-buffer) -(advice-add 'tabify :around #'call-with-region-or-buffer) -(advice-add 'untabify :around #'call-with-region-or-buffer) +;; Scheme -(with-eval-after-load 'scheme - (keymap-unset scheme-mode-map "M-o" t) - ;; Comparse "keywords" --- CHICKEN (http://wiki.call-cc.org/eggref/5/comparse) - (put 'sequence* 'scheme-indent-function 1) - (put 'satisfies 'scheme-indent-function 1) +(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)) -(with-eval-after-load 'geiser-mode - (keymap-set geiser-mode-map "C-c C-k" #'geiser-eval-buffer-and-go) - (keymap-unset geiser-mode-map "C-." t)) - - -(with-eval-after-load 'visual-fill-column - (setopt visual-fill-column-center-text t - visual-fill-column-width (+ fill-column 2)) - (advice-add 'text-scale-adjust :after #'visual-fill-column-adjust)) -(add-hook 'visual-line-mode-hook #'visual-fill-column-mode) -(add-hook 'visual-line-mode-hook #'adaptive-wrap-prefix-mode) - -(setopt major-mode - (lambda () ; guess major mode from buffer name - (unless buffer-file-name - (let ((buffer-file-name (buffer-name))) - (set-auto-mode))))) - -;; Dialogs -(unless (boundp 'use-short-answers) - (fset 'yes-or-no-p 'y-or-n-p)) - -(setopt read-answer-short t - use-dialog-box nil - use-file-dialog nil - use-short-answers t) - -(require 'savehist) -(setopt history-length 1024 - history-delete-duplicates t - ;; savehist-file (etc/ "savehist.el") - savehist-save-minibuffer-history t - savehist-autosave-interval 30) -(savehist-mode) -;; Killing and yanking -(setopt kill-do-not-save-duplicates t - kill-read-only-ok t - ;; XXX: This setting causes an error message the first time it's - ;; called: "Selection owner couldn't convert: TIMESTAMP". I have - ;; absolutely no idea why I get this error, but it's generated in - ;; `x_get_foreign_selection'. I also can't inhibit the message or - ;; do anything else with it, so for now, I'll just live with the - ;; message. - save-interprogram-paste-before-kill t - yank-pop-change-selection t) -(delete-selection-mode) +(require 'autoinsert) +(setf/assoc auto-insert-alist + "\\.scm" + '(nil "#!/bin/sh" \n + "#| -*- scheme -*-" \n + "exec csi -ss \"$0\" \"$@\"" \n + _ \n + "|#" \n \n)) -;; Notifying the user -(setopt echo-keystrokes 0.01 - ring-bell-function #'ignore) +;; Emacs lisp -;; Point and mark -(setopt set-mark-command-repeat-pop t) +(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 -;; The system -(setopt read-process-output-max (* 10 1024 1024)) +(add-hook 'after-init-hook + (lambda () + (define-advice eval-buffer (:after (&rest _) message) + (message "Buffer %s evaluated." (current-buffer))))) -;; Startup -(setopt inhibit-startup-screen t - initial-buffer-choice t - initial-scratch-message nil) + +;;; Files -(define-advice startup-echo-area-message (:override ()) - (if (get-buffer "*Warnings*") - ";_;" - "^_^")) +(setopt auto-revert-verbose nil) +(setopt global-auto-revert-non-file-buffers t) +(global-auto-revert-mode) -;; Text editing -(setopt fill-column 80 - sentence-end-double-space nil - tab-width 8 - tab-always-indent 'complete) -(global-so-long-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 show-paren-delay 0.01 - show-paren-style 'parenthesis - show-paren-when-point-in-periphery t - show-paren-when-point-inside-paren t) -(show-paren-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 - coding-system-for-read 'utf-8-unix - coding-system-for-write 'utf-8-unix - default-process-coding-system '(utf-8-unix . utf-8-unix) - locale-coding-system 'utf-8-unix) +(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) @@ -651,117 +724,87 @@ If LOCALP is a string, add that directory to the `load-path'." (set-selection-coding-system 'utf-8) (set-clipboard-coding-system 'utf-8))) +;; Undo +(when (package-ensure 'undohist) + (undohist-initialize)) -;; Files -(setopt auto-revert-verbose nil - global-auto-revert-non-file-buffers t - create-lockfiles nil - find-file-visit-truename t - mode-require-final-newline t - view-read-only t - save-silently t) -(global-auto-revert-mode) +;;; ... -(setopt auto-save-default nil - auto-save-interval 1 - auto-save-no-message t - auto-save-timeout 1 - auto-save-visited-interval 1 - 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 bookmark-save-flag 1) -(setopt backup-by-copying t - version-control t - kept-new-versions 8 - kept-old-versions 8 - delete-old-versions t) -(setq-default backup-directory-alist - `(("^/dev/shm" . nil) - ("^/tmp" . nil) - (,(getenv "XDG_RUNTIME_DIR") . nil) - ("." . ,(locate-user-emacs-file "backup")))) - -(require 'recentf) -(setopt - recentf-max-menu-items 500 - recentf-max-saved-items nil ; Save the whole list - recentf-auto-cleanup 'mode - recentf-case-fold-search t) -;; (add-to-list 'recentf-exclude etc/) -(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) - -(require 'saveplace) -(setopt - save-place-forget-unreadable-files (eq system-type - 'gnu/linux)) -(save-place-mode) - -(require 'uniquify) -(setq uniquify-after-kill-buffer-p t - uniquify-buffer-name-style 'forward - uniquify-ignore-buffers-re "^\\*" - uniquify-separator path-separator) - -(setq-local vc-follow-symlinks t - vc-make-backup-files t) - -;; Whitespace -(require 'whitespace) -(setopt whitespace-style - '(face trailing tabs tab-mark)) -(global-whitespace-mode) -(add-hook 'before-save-hook #'delete-trailing-whitespace-except-current-line) - -;; Native compilation -(setopt native-comp-async-report-warnings-errors 'silent - native-comp-deferred-compilation t - native-compile-target-directory - (locate-user-emacs-file "eln")) -(when (boundp 'native-comp-eln-load-path) - (add-to-list 'native-comp-eln-load-path native-compile-target-directory)) -(when (fboundp 'startup-redirect-eln-cache) - (startup-redirect-eln-cache native-compile-target-directory)) +(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) -(global-goto-address-mode) +(setf/assoc display-buffer-alist + "\\`\\*Warnings\\*" + '((display-buffer-no-window))) -;; Winner (winner-mode) -;;; Hooks -(add-hook 'after-save-hook #'executable-make-buffer-file-executable-if-script-p) -(add-hook 'find-file-not-found-functions #'create-missing-directories) -(add-hook 'find-file-hook #'vc-remote-off) -(add-hook 'dired-mode-hook #'hl-line-mode) -(add-hook 'org-agenda-mode-hook #'hl-line-mode) - -;;; Tab bar - -(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) -;;(setopt tab-bar-show t) -;;(tab-bar-mode) ; done after setting fonts - -;;; Org mode +(setopt set-mark-command-repeat-pop t) -(keymap-global-set "C-c a" #'org-agenda) -(keymap-global-set "C-c c" #'org-capture) -(setopt org-clock-clocked-in-display 'frame-title - org-clock-frame-title-format - '("%b" " - " (t org-mode-line-string)) - org-tags-column (- (- fill-column 3)) - org-log-into-drawer t - org-clock-into-drawer 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) -;;; Spelling +(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?" @@ -772,12 +815,140 @@ If LOCALP is a string, add that directory to the `load-path'." (put 'ispell-local-words 'safe-local-variable 'list-of-strings-p) -(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)) +(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) -;;; org-return-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) @@ -872,12 +1043,36 @@ itself. Other values of ARG will call `newline' with that ARG." (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-RET" #'org-table-copy-down|org-return-dwim)) - -;;; Copy rich text to the keyboard - + (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")) @@ -889,20 +1084,6 @@ Should be a list of strings---the command line. Defaults to 'wl-copy' on wayland and 'xclip' on Xorg." :type '(repeat string)) -;; Thanks to Oleh Krehel: -;; https://emacs.stackexchange.com/questions/54292/copy-results-of-org-export-directly-to-clipboard -;; So. Emacs can't do this itself because it doesn't support sending clipboard -;; or selection contents as text/html. We have to use xclip instead. -;; (defun org-to-html-to-clipboard (&rest org-export-args) -;; "Export current org buffer to HTML, then copy it to the clipboard. -;; ORG-EXPORT-ARGS are passed to `org-export-to-file'." -;; (let ((f (make-temp-file "org-html-export"))) -;; (apply #'org-export-to-file 'html f org-export-args) -;; (start-process "xclip" " *xclip*" -;; "xclip" "-verbose" "-i" f -;; "-t" "text/html" "-selection" "clipboard") -;; (message "HTML pasted to clipboard."))) - (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'." @@ -920,110 +1101,826 @@ ORG-EXPORT-ARGS are passed to `org-export-to-buffer'." (kill-buffer-and-window)) (message "HTML copied to clipboard."))) -;; Wayland version.. TODO: make it work for both -;; (defun org-to-html-to-clipboard (&rest org-export-args) - ;; "Export current org buffer to HTML, then copy it to the clipboard. -;; ORG-EXPORT-ARGS are passed to `org-export-to-file'." - ;; (let ((buf (generate-new-buffer "*org-html-clipboard*" t))) - ;; (apply #'org-export-to-buffer 'html buf org-export-args) - ;; (with-current-buffer buf - ;; (call-process-region (point-min) (point-max) - ;; "wl-copy" nil nil nil - ;; "-t" "text/html") - ;; (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)) -(undohist-initialize) - -(require 'hungry-delete) -(setopt hungry-delete-chars-to-skip " \t" - hungry-delete-skip-regexp (format "[%s]" hungry-delete-chars-to-skip) - hungry-delete-join-reluctantly nil) -(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) -(global-hungry-delete-mode) - -(setopt avy-background t - avy-keys (string-to-list "asdfghjklqwertyuiopzxcvbnm")) -(keymap-global-set "M-j" #'avy-goto-char-timer) -(keymap-set isearch-mode-map "M-j" #'avy-isearch) -(keymap-global-set "M-z" #'zzz-to-char) - -(marginalia-mode) - -(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) - -(keymap-set minibuffer-local-map "M-n" #'consult-history) -(keymap-set minibuffer-local-map "M-p" #'consult-history) - -(setopt completion-in-region-function #'consult-completion-in-region - xref-show-xrefs-function #'consult-xref - xref-show-definitions-function #'consult-xref) - -(setopt initial-scratch-message ";;; Emacs!\n\n") +;; (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)))))) -(keymap-global-set "C-x C-b" #'ibuffer) -(add-hook 'ibuffer-hook #'hl-line-mode) +(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)) -(require 'scule) -(keymap-global-set "M-c" scule-map) -(autoload 'titlecase-dwim "titlecase" nil t) -(keymap-set scule-map "M-t" #'titlecase-dwim) +(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) -;; Use M-u for prefix keys -(keymap-global-set "M-u" #'universal-argument) -(keymap-set universal-argument-map "M-u" #'universal-argument-more) +(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 -(autoload 'frowny-mode "frowny" nil t) -(add-hook 'jabber-chat-mode-hook #'frowny-mode) -(add-hook 'jabber-chat-mode-hook #'electric-pair-local-mode-disable) +(keymap-global-set "C-x C-j" #'dired-jump) +(with-eval-after-load 'dired + (keymap-set dired-mode-map "C-j" #'dired-up-directory)) -(autoload 'hippie-completing-read "hippie-completing-read" nil t) -(keymap-global-set "M-/" #'hippie-completing-read) +(setopt dired-auto-revert-buffer t) +(setopt dired-dwim-target t) ; dired-dwim-target-next ? -(setopt mode-line-bell-flash-time 0.25) -(autoload 'mode-line-bell-mode "mode-line-bell" nil t) -(mode-line-bell-mode) + +;;; Browsing the web -(keymap-global-set "C-x C-k" #'kill-this-buffer) +(setopt browse-url-browser-function #'eww-browse-url) -(require 'anzu) -(global-anzu-mode) -(setopt search-default-mode t - anzu-mode-lighter "" - anzu-deactivate-region t) +(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))))))) -(global-set-key [remap query-replace] #'anzu-query-replace-regexp) -(global-set-key [remap query-replace-regexp] #'anzu-query-replace) -(define-key isearch-mode-map [remap isearch-query-replace] - #'anzu-isearch-query-replace-regexp) -(define-key isearch-mode-map [remap isearch-query-replace-regexp] - #'anzu-isearch-query-replace) +(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))) diff --git a/readme.txt b/readme.txt deleted file mode 100644 index a140bbf..0000000 --- a/readme.txt +++ /dev/null @@ -1,4 +0,0 @@ -~/.config/emacs - -this is my 10th bankruptcy, or the beginning of it. -I'm moving my ~/.emacs to, yes, ~/.emacs and adding this repo to my etc repo. -- cgit 1.4.1-21-gabe81