From 59a1f58695d09ab29ddf992b2c0711c94a4039ea Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Tue, 3 Jan 2023 23:03:03 -0600 Subject: Switch to use-package --- early-init.el | 121 ++- init.el | 2336 +++++++++++++++++------------------------- lisp/+browse-url.el | 189 +++- lisp/+cape.el | 25 + lisp/+custom.el | 52 - lisp/+emacs.el | 422 -------- lisp/+emms.el | 38 + lisp/+hungry-delete.el | 53 + lisp/+isearch.el | 24 + lisp/+notmuch.el | 52 +- lisp/+org-capture.el | 197 +--- lisp/+org.el | 268 +++-- lisp/+ox.el | 29 - lisp/+paredit.el | 26 + lisp/+tempo.el | 45 - lisp/+titlecase.el | 6 +- lisp/+window.el | 130 --- lisp/acdw-defaults.el | 292 ++++++ lisp/acdw-funs.el | 262 +++++ lisp/acdw-macs.el | 293 ++++++ lisp/acdw.el | 345 ++----- lisp/browse-url-transform.el | 45 - lisp/dawn.el | 109 -- lisp/def.el | 142 --- lisp/graveyard.el | 50 + lisp/init-org.el | 144 +++ lisp/org-word-count.el | 297 ------ lisp/pita.el | 69 -- lisp/private.el | 23 - lisp/scule.el | 61 -- lisp/upload-junk.el | 47 + lisp/yoke.el | 664 ++++++------ 32 files changed, 3083 insertions(+), 3773 deletions(-) create mode 100644 lisp/+cape.el delete mode 100644 lisp/+custom.el delete mode 100644 lisp/+emacs.el create mode 100644 lisp/+emms.el create mode 100644 lisp/+hungry-delete.el create mode 100644 lisp/+isearch.el delete mode 100644 lisp/+ox.el create mode 100644 lisp/+paredit.el delete mode 100644 lisp/+tempo.el delete mode 100644 lisp/+window.el create mode 100644 lisp/acdw-defaults.el create mode 100644 lisp/acdw-funs.el create mode 100644 lisp/acdw-macs.el delete mode 100644 lisp/browse-url-transform.el delete mode 100644 lisp/dawn.el delete mode 100644 lisp/def.el create mode 100644 lisp/graveyard.el create mode 100644 lisp/init-org.el delete mode 100644 lisp/org-word-count.el delete mode 100644 lisp/pita.el delete mode 100644 lisp/private.el delete mode 100644 lisp/scule.el create mode 100644 lisp/upload-junk.el diff --git a/early-init.el b/early-init.el index 8004342..b841ea5 100644 --- a/early-init.el +++ b/early-init.el @@ -1,98 +1,95 @@ -;;; early-init.el --- Emacs early init -*- lexical-binding: t; -*- +;;; early-init.el --- Emacs early init -*- lexical-binding: t -*- + ;; by C. Duckworth -;; Bankruptcy: 9 -;;; Speed up init +;; Bankruptcy: 9.3 + +;;; Debugging --- delete this when done bankrupting +(setf debug-on-error t + use-package-verbose t) + +;;; Speedy startup -;; Restore things after init (defvar +emacs--startup-restore-alist nil - "Variables and values to restore after init.") + "Variables to restore after startup.") -(add-hook 'emacs-startup-hook - (defun emacs-startup@restore-values () - "Restore values set during init. -This applies values in `+emacs--startup-restore-alist'." - (dolist (a +emacs--startup-restore-alist) - (set (car a) (cdr a))))) +(defun +emacs-startup@restore-variables () + "Restore variables set temporarily during startup." + (dolist (v +emacs--startup-restore-alist) + (set-default (car v) (cdr v)))) +(add-hook 'after-init-hook #'+emacs-startup@restore-variables) (defun +set-during-startup (variable value &optional restore) - "Set VARIABLE to VALUE during startup, but restore to RESTORE. -If RESTORE is nil or not passed, save the original value and -restore that." + "Set VARIABLE to VALUE during startup. +If RESTORE is non-nil, restore the variable's value to it. +Otherwise, save its original value and restore to that." (unless after-init-time (setf (alist-get variable +emacs--startup-restore-alist) - (or restore (symbol-value variable))) + (or restore (symbol-value variable))) (set-default variable value))) -;; Garbage collection (+set-during-startup 'gc-cons-threshold most-positive-fixnum) -(add-hook 'minibuffer-setup-hook (defun garbage-collect@minibuffer-enter () - (setf gc-cons-threshold most-positive-fixnum))) -(add-hook 'minibuffer-exit-hook (defun garbage-collect@minibuffer-exit () - (setf gc-cons-threshold 800000))) +;;; Distraction-free startup -;; Don't prematurely re-display (unless debug-on-error (+set-during-startup 'inhibit-redisplay t) (+set-during-startup 'inhibit-message t)) -;; Debug during init -(unless (eq debug-on-error 'startup) - (+set-during-startup 'debug-on-error 'init)) - -;;; Default frame settings +(setf warning-minimum-level :emergency) +(add-hook 'emacs-startup-hook + (defun +message-about-warnings () + (when-let ((warnings (get-buffer "*Warnings*"))) + (message "%s. %s." "There were init-time warnings" + "See the `*Warnings*' buffer.")))) (setf default-frame-alist '((tool-bar-lines . 0) - (menu-bar-lines . 0) - (vertical-scroll-bars) - (horizontal-scroll-bars)) + (menu-bar-lines . 0) + (vertical-scroll-bars . nil) + (horizontal-scroll-bars . nil)) frame-inhibit-implied-resize t frame-resize-pixelwise t window-resize-pixelwise t inhibit-x-resources t indicate-empty-lines nil - indicate-buffer-boundaries nil - ;; '((top . right) - ;; (bottom . right)) - ) + indicate-buffer-boundaries nil) + +;;; Packages -;;; Set up extra load paths and functionality +(require 'package) -(push (expand-file-name (locate-user-emacs-file "lisp")) load-path) -(require 'acdw) +(dolist (archive + '(("gnu-devel" . "https://elpa.gnu.org/devel/") + ("nongnu-devel" . "https://elpa.gnu.org/nongnu-devel/") + ("melpa" . "https://melpa.org/packages/"))) + (add-to-list 'package-archives archive :append)) -(+define-dir .etc (locate-user-emacs-file "etc") - "Directory for all of Emacs's various files. -See `no-littering' for examples.") +(setf package-archive-priorities + '(("gnu-devel" . 2) + ("nongnu-devel" . 1) + ("melpa" . 0) + ("gnu" . 0) + ("nongnu" . 0))) -(+define-dir sync/ (expand-file-name "~/Sync") - "My Syncthing directory.") +(package-initialize) -(+define-dir private/ (sync/ "emacs/private")) -(add-to-list 'load-path private/) +(unless package-archive-contents + (package-refresh-contents)) -;;; Packages +;; https://melpa.org/packages/archive-contents -(setf package-enable-at-startup nil - package-quickstart nil) +;;; Use-package -(require 'yoke) -(add-hook 'emacs-lisp-mode-hook #'yoke-imenu-insinuate) +(setf use-package-enable-imenu-support t + use-package-hook-name-suffix nil) -(yoke (compat "https://git.sr.ht/~pkal/compat")) +(require 'use-package) -(yoke (no-littering "https://github.com/emacscollective/no-littering") - (setf no-littering-etc-directory .etc - no-littering-var-directory .etc - custom-file (.etc "custom.el")) - (require 'no-littering) - (when (boundp 'native-comp-eln-load-path) - (setcar native-comp-eln-load-path (expand-file-name (.etc "eln-cache" t)))) - (when (boundp 'comp-eln-load-path) - (setcar comp-eln-load-path (expand-file-name (.etc "eln-cache" t)))) - (when (fboundp 'startup-redirect-eln-cache) - (startup-redirect-eln-cache (convert-standard-filename (.etc "eln-cache/"))))) +(setf use-package-compute-statistics debug-on-error) -(provide 'early-init) -;;; early-init.el ends here +(use-package use-package-vc + :load-path "~/src/emacs/use-package-vc.el" + :config + (define-advice package-vc-install (:around (orig &rest args) wtf) + (let ((package-archives nil)) + (apply orig args)))) diff --git a/init.el b/init.el index ffe7f81..3fcf374 100644 --- a/init.el +++ b/init.el @@ -1,1228 +1,977 @@ -;;; emacs init --- an init for emacs -*- lexical-binding: t; -*- +;;; init.el --- a config of one's own -*- lexical-binding: t; -*- ;; by C. Duckworth -;; URL: https://git.acdw.net/emacs -;; Bankruptcy: 9 -;; -;; Everyone is permitted to do whatever they like with this software -;; without limitation. This software comes without any warranty -;; whatsoever, but with two pieces of advice: -;; - Be kind to yourself. -;; - Make good choices. - -(yoke +emacs - (require* '+emacs '+window '+lisp) - ;; Settings - (setc truncate-string-ellipsis "…" - ring-bell-function #'ignore - read-file-name-completion-ignore-case t - comment-auto-fill-only-comments t - password-cache t - password-cache-expiry (* 60 60) - switch-to-buffer-in-dedicated-window 'pop - switch-to-buffer-obey-display-actions t - initial-buffer-choice (defun +initial-buffer-choose () - (cond - ((equal (get-buffer "*Messages*") - (other-buffer)) - (get-buffer "*scratch*")) - (:else (other-buffer))))) - ;; "Safe" variables - (dolist (var+pred - '((browse-url-browser-function - ;; All types defined by custom are safe. - . (lambda (f) - ;; Whooooo boy - (memq f (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 (car var+pred) 'safe-local-variable (cdr var+pred))) - ;; Keys - (defkeys t - "C-x C-k" #'kill-current-buffer - "C-/" #'undo-only - "C-?" #'undo-redo - "C-x C-c" (defun delete-frame-or-quit (arg) - (interactive "P") - (cond (arg (delete-frame nil :force)) - ((= 1 (length (frame-list))) - (and (yes-or-no-p "Kill emacs? ") - (save-buffers-kill-emacs t))) - (:else (delete-frame)))) - "C-x r q" (defun really-quit-emacs (arg) - (interactive "P") - (cond (arg (save-buffers-kill-emacs t)) - (:else (save-buffers-kill-terminal t)))) - "M-SPC" #'+cycle-spacing - ;; "M-/" #'hippie-expand ; `hippie-completing-read' - "M-=" #'count-words - "C-x C-b" #'ibuffer - "C-x 4 n" #'clone-buffer - "S-" #'mouse-set-mark - "C-x 0" #'+delete-window-or-bury-buffer - ;; "M-j" nil ; `avy' - "" nil - "C-z" nil - "M-o" #'other-window|switch-buffer - "C-M-;" #'+lisp-comment-or-uncomment-sexp - "C-x 5 z" #'suspend-frame - "C-x f" #'find-file - "C-c t" (defmap toggle-map - "A map for toggling various settings." - "d" (defmap toggle-debug-map - "Easily toggle debug flavors." - "e" #'toggle-debug-on-error - "q" #'toggle-debug-on-quit) - "w" #'toggle-word-wrap - "t" #'toggle-truncate-lines - "c" #'column-number-mode - "l" #'line-number-mode - "v" (defmap toggle-view-map - "Easily toggle UI elements' views." - "c" #'display-fill-column-indicator-mode - "l" #'display-line-numbers-mode - "m" #'menu-bar-mode - "t" #'tool-bar-mode - "s" #'scroll-bar-mode))) - (defkeys text-mode-map - "C-M-k" #'kill-paragraph - "C-o" (defun open-paragraph (&optional arg) - "Open a paragraph after paragraph at point. -A paragraph is defined as continguous non-empty lines of text -surrounded by empty lines, so opening a paragraph means to make -three blank lines, then place the point on the second one. - -Called with prefix ARG, open a paragraph before point." - ;; TODO: Take an integer as ARG, allowing for skipping paragraphs up and down. - (interactive "*P") - ;; Go to next blank line. This /isn't/ `end-of-paragraph-text' because - ;; that's weird with org, and I'm guessing other modes too. - (unless (looking-at "^$") (forward-line (if arg -1 +1))) - (while (and (not (looking-at "^$")) - (= 0 (forward-line (if arg -1 +1))))) - (newline) - (when arg (newline) (forward-line -2)) - (delete-blank-lines) - (newline 2) - (previous-line))) - ;; Hooks - (add-hook 'after-save-hook - #'executable-make-buffer-file-executable-if-script-p) - (add-hook 'minibuffer-setup-hook #'cursor-intangible-mode) - (add-hook 'find-file-not-found-functions #'+auto-create-missing-dirs) - (add-hook 'text-mode-hook #'abbrev-mode) - (add-hook 'find-file-hook #'+vc-off-when-remote) - (add-hook 'prog-mode-hook #'auto-fill-mode) - ;; Advice - (add-function :after after-focus-change-function - #'+save-some-buffers-debounce) - (define-advice keyboard-escape-quit (:around (fn &rest r) keep-window-open) - "Don't close quits on `keyboard-escape-quit'." - (let ((buffer-quit-function #'ignore)) - (apply fn r))) - ;; Faces - (set-face-attribute 'default nil :family "Comic Code" :height 100) - (set-face-attribute 'bold nil :family "Comic Code" :weight 'bold) - (set-face-attribute 'variable-pitch nil :family "Comic Code") - ;; Modes - (winner-mode)) - -(yoke custom ; This is `cus-edit' but meh - (require '+custom) - (setf custom-file (private/ "custom.el")) - (add-to-list* '+custom-allowed-variables - 'safe-local-variable-values - 'warning-suppress-types - 'ispell-buffer-session-localwords) - (eval-after init - (+custom-load-some-customizations :noerror))) - -;; (yoke modus-themes -;; (setc modus-themes-bold-constructs t -;; modus-themes-italic-constructs t -;; modus-themes-headings '((1 monochrome bold italic) -;; (2 monochrome bold) -;; (3 monochrom italic) -;; (t monochrome))) -;; (defhook modus-themes-after-load-theme-hook -;; :name modus-monochrome -;; (modus-themes-with-colors -;; (cl-loop for x being the symbols -;; if (string-match-p "\\`font-lock-.*-face\\'" -;; (symbol-name x)) -;; do -;; (custom-set-faces -;; `(,x ((,class :foreground -;; ,(cond -;; ((memq x '(font-lock-string-face -;; font-lock-doc-face -;; font-lock-doc-markup-face)) -;; fg-special-warm) -;; ((memq x '(font-lock-warning-face)) -;; fg-lang-warning) -;; ((memq x '(font-lock-comment-face)) -;; fg-alt) -;; (:else 'unspecified)) -;; :background unspecified -;; :weight -;; ,(cond -;; ((memq x '(font-lock-keyword-face)) -;; 'bold) -;; (:else 'normal)) -;; :slant -;; ,(cond -;; ((memq x '(font-lock-doc-face -;; font-lock-comment-face)) -;; 'italic) -;; (:else 'normal)) -;; :underline -;; ,(cond -;; ((memq x '(font-lock-warning-face)) -;; t) -;; (:else nil))))))))) -;; (when (or (custom-theme-enabled-p 'modus-operandi) -;; (custom-theme-enabled-p 'modus-vivendi)) -;; (modus-monochrome)) -;; (cond ((require 'dawn nil :noerrer) -;; (defhook +custom-after-load-hook -;; :name dawn@custom -;; (load-theme 'modus-operandi :noconfirm :noenable) -;; (load-theme 'modus-vivendi :noconfirm :noenable) -;; (dawn-schedule #'modus-themes-load-operandi -;; #'modus-themes-load-vivendi))) -;; (:else (modus-themes-load-operandi)))) - -(yoke time - (setc display-time-mail-function - (defun +notmuch-new-mail-p () - (plist-get (cl-find "inbox+unread" - (ignore-errors - (notmuch-hello-query-counts notmuch-saved-searches)) - :key (lambda (l) (plist-get l :name)) - :test #'equal) - :count)) - display-time-use-mail-icon nil - display-time-mail-string (format "⋅ Mail (%s)" (+notmuch-new-mail-p)) - read-mail-command #'+notmuch-goto - display-time-format " %a %-e, %H:%M" - ;; `display-time-format' makes these unnecessary, but I'll keep em - display-time-24hr-format t - display-time-day-and-date t - display-time-default-load-average nil) - (define-advice display-time-update (:after (&rest _) update-mail-count) - (setq display-time-mail-string (format "⋅ Mail (%s)" (+notmuch-new-mail-p)))) - (display-time-mode)) - -(yoke pita - (require 'pita) - (advice-add 'indent-region :before #'with-region-or-buffer)) - -(yoke (undo-fu-session "https://codeberg.org/ideasman42/emacs-undo-fu-session") - (setc undo-fu-session-incompatible-files '("/COMMIT_EDITMSG\\'" - "/git-rebase-todo\\'") - undo-fu-session-directory (.etc "undo/" t) - undo-fu-session-compression (cond - ((executable-find "gzip") 'gz) - ((executable-find "bzip2") 'bz2) - ((executable-find "xz") 'xz) - (t nil))) - (global-undo-fu-session-mode)) - -(yoke whitespace - (setc whitespace-line-column nil - whitespace-style '( face trailing - tabs tab-mark - indentation - space-after-tab space-before-tab)) - (defhook (text-mode-hook prog-mode-hook read-only-mode-hook) - :name +whitespace-mode-for-writable-buffers - :doc "Turn on `whitespace-mode' if the buffer is writable, off otherwise." - (whitespace-mode (if buffer-read-only -1 t))) - (defhook before-save-hook #'whitespace-cleanup) - (define-advice whitespace-cleanup (:around (fn &rest r) preserve-point) - (let ((col (current-column))) - (apply fn r) - (move-to-column col t) - (set-buffer-modified-p nil)))) - -(yoke elisp-mode - (setc eval-expression-print-length nil ; remove ellipses from `eval-expression' - eval-expression-print-level nil) - (defkeys (emacs-lisp-mode-map lisp-interaction-mode-map) - "C-c C-c" #'eval-defun - "C-c C-k" (defun +elisp-eval-region-or-buffer () - (interactive) - (cond - ((region-active-p) - (eval-region (region-beginning) (region-end)) - (message "Region evaluated.")) - (t - (eval-buffer) - (message "Buffer %s evaluated." (buffer-name))))) - "C-c C-z" #'ielm) - (define-advice eval-region (:around (fn beg end &rest args) pulse) - (apply fn beg end args) - (pulse-momentary-highlight-region beg end))) - -(yoke isearch - (defkeys t - "C-s" #'isearch-forward-regexp - "C-r" #'isearch-backward-regexp - "C-M-s" #'isearch-forward - "C-M-r" #'isearch-backward)) +;; Bankruptcy: 9.3 + +;;; Code: + +;;; Remove when done bankrupting + +(defkeys t "C-x C-c" #'restart-emacs) + +;;; My extras + +(push (expand-file-name (locate-user-emacs-file "lisp")) load-path) +(require 'acdw) ; Omnibus fun stuff + +;;; Basic defaults + +(use-package no-littering + :ensure t + :demand t + :custom + (no-littering-etc-directory etc/) + (no-littering-var-directory var/) + (custom-file (etc/ "custom.el")) + (auto-save-file-name-transforms `(("." ,(var/ "auto-save/") t))) + (auto-save-list-file-prefix (var/ "auto-save/.saves-" t)) + (backup-directory-alist `(("." . ,(var/ "backup/" t))))) + +(use-package custom-allowed + :load-path "~/src/emacs/custom-allowed/" + :custom + (custom-file (private/ "custom.el")) + :config + (dolist (var '(safe-local-variable-values + warning-suppress-types + ispell-buffer-session-localwords + calendar-latitude + calendar-longitude + user-full-name + user-mail-address)) + (add-to-list 'custom-allowed-variables var)) + :hook + (after-init-hook . custom-allowed-load-custom-file)) + +(use-package modus-themes + :load-path "~/usr/share/emacs/30.0.50/etc/themes/" + :custom + (modus-themes-bold-constructs t) + (modus-themes-italic-constructs t) + (modus-themes-variable-pitch-ui nil)) + +(use-package dawn + :load-path "~/src/emacs/dawn/" + :after modus-themes + :config + (load-theme 'modus-operandi :noconfirm :noenable) + (load-theme 'modus-vivendi :noconfirm :noenable) + (defhook custom-allowed-after-load-hook + (dawn-schedule-themes 'modus-operandi + 'modus-vivendi) + (set-face-attribute 'default nil + :family "IBM Plex Mono" + :height 100) + (set-face-attribute 'variable-pitch nil + :family "Georgia" + :height 1.2))) + +(use-package midnight + :config + (add-hook 'midnight-mode-hook #'recentf-cleanup) + (midnight-mode)) + +(use-package sophomore + :load-path "~/src/emacs/sophomore/" + :config + (sophomore-enable-all) + (sophomore-disable 'view-hello-file + 'describe-gnu-project + 'suspend-frame) + (sophomore-mode)) + +;;; Completions + +(use-package vertico + :ensure t + :custom + (resize-mini-windows 'grow-only) + (vertico-cycle t) + :init + (use-package vertico-directory + :after vertico + :config + (add-hook 'rfn-eshadow-update-overlay-hook #'vertico-directory-tidy)) + (vertico-mode)) + +(use-package marginalia + :ensure t + :demand t + :config + (add-hook 'minibuffer-setup-hook #'truncate-lines-local-mode) + (marginalia-mode)) -(yoke ispell - (require* '+ispell 'ispell) - (add-hook 'before-save-hook - #'+ispell-move-buffer-words-to-dir-locals-hook) - (setc ispell-program-name (or (executable-find "ispell") - (executable-find "aspell"))) - (put 'ispell-buffer-session-localwords - 'safe-local-variable #'+ispell-safe-local-p)) - - -(yoke mouse - ;; Brand new for Emacs 28: see https://ruzkuku.com/texts/emacs-mouse.html - ;; Actually, look at this as well: https://www.emacswiki.org/emacs/Mouse3 - (when (fboundp 'context-menu-mode) - (setc context-menu-functions '(context-menu-ffap - context-menu-region - context-menu-undo - ;; context-menu-dictionary - )) - (context-menu-mode +1)) - (dolist (click '(;; Fix scrolling in the margin - wheel-down double-wheel-down triple-wheel-down - wheel-up double-wheel-up triple-wheel-up)) - (global-set-key (vector 'right-margin click) 'mwheel-scroll) - (global-set-key (vector 'left-margin click) 'mwheel-scroll))) - -(yoke dired - (require 'dired-x) - (setc dired-recursive-copies 'always - dired-recursive-deletes 'always - dired-create-destination-dirs 'always - dired-do-revert-buffer t - dired-hide-details-hide-symlink-targets nil - dired-isearch-filenames 'dwim - delete-by-moving-to-trash t - dired-auto-revert-buffer t - dired-listing-switches "-AlF" - ls-lisp-dirs-first t - dired-ls-F-marks-symlinks t - dired-clean-confirm-killing-deleted-buffers nil - dired-no-confirm '(byte-compile - load chgrp chmod chown - copy move hardlink symlink - shell touch) - dired-dwim-target t) - (setq-local-hook dired-mode-hook - truncate-lines t) - (defkeys t - "C-x C-j" #'dired-jump - [remap list-directory] #'dired) - (defkeys ((dired-mode-map :after dired)) - "" #'dired-up-directory - "C-j" #'dired-up-directory) - (defhook dired-mode-hook - #'dired-hide-details-mode - #'hl-line-mode)) - -(yoke (dired-hacks "https://github.com/Fuco1/dired-hacks") - (defkeys dired-mode-map - "TAB" #'dired-subtree-sycle - "i" #'dired-subtree-toggle) - (defhook 'dired-mode-hook - #'dired-collapse-mode)) - -(yoke auth-source - (setc auth-sources `(default "secrets:passwords")) - (setq-local-hook authinfo-mode-hook - truncate-lines t)) - -(yoke (consult "https://github.com/minad/consult") - (require 'consult) - (setf register-preview-delay 0 - register-preview-function #'consult-register-format - xref-show-xrefs-function #'consult-xref - tab-always-indent 'complete - completion-in-region-function #'consult-completion-in-region - consult-narrow-key "<" - consult--regexp-compiler #'consult--default-regexp-compiler) +(use-package orderless + :ensure t + :custom + (completion-styles '(orderless basic)) + (completion-category-overrides + '((file (styles basic partial-completion))))) + +(use-package consult + :ensure t + :custom + (register-preview-delay 0.01) + (register-preview-function #'consult-register-format) + (xref-show-xrefs-function #'consult-xref) + (tab-always-indent 'complete) + (completion-in-region-function #'consult-completion-in-region) + (consult-narrow-key "<") + (consult--regexp-compiler #'consult--default-regexp-compiler) + :config (advice-add #'register-preview :override #'consult-register-window) - (define-key* (current-global-map) - ;; Etc - "M-S-x" #'consult-mode-command - ;; C-c bindings (mode-specific-map) - "C-c h" #'consult-history - "C-c b" #'consult-bookmark - "C-c k" #'consult-kmacro - ;; C-x bindings (ctl-x-map) - "C-x M-:" #'consult-complex-command - "C-x b" #'consult-buffer - "C-x 4 b" #'consult-buffer-other-window - "C-x 5 b" #'consult-buffer-other-frame - ;; Custom M-# bindings for fast register access - "M-#" #'consult-register-load - "M-'" #'consult-register-store - "C-M-#" #'consult-register - ;; Other custom bindings - "M-y" #'consult-yank-pop - ;;(" a" . consult-apropos) - ;; M-g bindings (goto-map) - "M-g e" #'consult-compile-error - "M-g f" #'consult-flymake ; or consult-flycheck - "M-g g" #'consult-goto-line - "M-g M-g" #'consult-goto-line - "M-g o" #'consult-outline ; or consult-org-heading - "M-g m" #'consult-mark - "M-g k" #'consult-global-mark - "M-g i" #'consult-imenu - "M-g M-i" #'consult-imenu - "M-g I" #'consult-imenu-multi - ;; M-s bindings (search-map) - "M-s f" #'consult-find - "M-s F" #'consult-locate - "M-s g" #'consult-grep - "M-s G" #'consult-git-grep - "M-s r" #'consult-ripgrep - "M-s l" #'consult-line - "M-s L" #'consult-line-multi - "M-s m" #'consult-multi-occur - "M-s k" #'consult-keep-lines - "M-s u" #'consult-focus-lines - ;; Isearch integration - "M-s e" #'consult-isearch-history) - (eval-after isearch-mode - (define-key* isearch-mode-map - "M-e" #'consult-isearch-history - "M-s e" #'consult-isearch-history - "M-s l" #'consult-line - "M-s L" #'consult-line-multi)) - (eval-after org - (define-key org-mode-map (kbd "M-g o") #'consult-org-heading)) - (eval-after consult-imenu - (setf (alist-get ?y (plist-get (alist-get 'emacs-lisp-mode - consult-imenu-config) - :types)) - '("Yoke")))) - -(yoke (orderless "https://github.com/oantolin/orderless") - (require 'orderless) - (setf completion-styles '(substring orderless basic) - completion-category-defaults nil - completion-category-overrides - '((file (styles basic partial-completion))) - orderless-component-separator #'orderless-escapable-split-on-space)) - -(yoke (vertico "https://github.com/minad/vertico") - (require 'vertico) - (setf resize-mini-windows 'grow-only - vertico-count-format nil - vertico-cycle t) - (vertico-mode) - (add-to-list 'load-path (expand-file-name "vertico/extensions" yoke-dir)) - (require 'vertico-directory) - (add-hook 'rfn-eshadow-update-overlay-hook #'vertico-directory-tidy)) - -(yoke (embark "https://github.com/oantolin/embark") - (require 'embark) - (setf prefix-help-command #'embark-prefix-help-command - embar-keymap-prompter-key ";") - (defkeys (t minibuffer-local-map) - "C-." #'embark-act - "M-." #'embark-dwim - " B" #'embark-bindings) - (define-key* embark-file-map - "l" #'vlf) - (eval-after (embark consult) - (require 'embark-consult) - (add-hook 'embark-collect-mode-hook #'consult-preview-at-point-mode))) - -(yoke (marginalia "https://github.com/minad/marginalia/") - (marginalia-mode)) + (define-advice completing-read-multiple (:filter-args (args) indicator) + (cons (format "[CRM%s] %s" + (replace-regexp-in-string + "\\`\\[.*?]\\*\\|\\[.*?]\\*\\'" "" + crm-separator) + (car args)) + (cdr args))) + :bind + (([remap switch-to-buffer] . consult-buffer) + ([remap switch-to-buffer-other-window] . consult-buffer-other-window) + ([remap switch-to-buffer-other-frame] . consult-buffer-other-frame) + ([remap yank-pop] . consult-yank-pop) + ("M-g g" . consult-goto-line) + ("M-g M-g" . consult-goto-line) + ("M-g i" . consult-imenu) + ("M-g M-i" . consult-imenu) + ("M-s l" . consult-line) + ("M-s f" . consult-find) + ("M-s M-f" . consult-find) + ("M-s g" . consult-grep) + ("M-s M-g" . consult-grep))) + +;;; General enhancements + +(use-package embark + :ensure t + :custom + (prefix-help-command #'embark-prefix-help-command) + :bind + (("C-." . embark-act) + ("M-." . embark-dwim) + ("C-h b" . embark-bindings)) + :custom + (add-to-list 'display-buffer-alist + '("\\`\\*Embark Collect \\(Live\\|Completions\\)\\*" + nil + (window-parameters (mode-line-format . none))))) + +(use-package embark-consult + :ensure t + :after (embark consult) + :hook (embark-collect-mode-hook . consult-preview-at-point-mode)) + +(use-package undo-fu-session + :ensure t + :custom + (undo-fu-session-directory (etc/ "undo/" t)) + (undo-fu-session-incompatible-files + '("/COMMIT_EDITMSG\\'" + "/git-rebase-todo\\'")) + (undo-fu-session-compression + (cl-loop for (exe . sym) in '(("gzip" . gz) + ("bzip2" . bz2) + ("xz" . xz)) + if (executable-find exe) + return sym)) + :config + (global-undo-fu-session-mode)) -(yoke (wgrep "https://github.com/mhayashi1120/Emacs-wgrep") - (require 'wgrep) - (define-key* grep-mode-map - "C-x C-q" #'wgrep-change-to-wgrep-mode)) +(use-package ws-butler + :ensure t + :custom + (ws-butler-trim-predicate (lambda (begin end) + (not (eq 'font-lock-string-face + (get-text-property end 'face))))) + :config + (ws-butler-global-mode)) + +(use-package minions + :ensure t + :config + (minions-mode)) -(yoke (slime "https://github.com/slime/slime") - :when (executable-find "sbcl") - (setc inferior-lisp-program (executable-find "sbcl")) - (defhook lisp-mode-hook - :name slime-mode-setup - (load (expand-file-name "~/quicklisp/slime-helper.el") :noerror) - (slime-mode)) - (eval-after slime - (setc slime-completion-at-point-functions - (delq 'slime-c-p-c-completion-at-point - slime-completion-at-point-functions)))) - -(yoke (puni "https://github.com/amaikinono/puni") - (electric-pair-mode) - (defkeys puni-mode-map - "C-)" #'puni-slurp-forward - "C-(" #'puni-slurp-backward - "C-}" #'puni-barf-forward - "C-{" #'puni-barf-backward - "M-(" (defun +puni-open-then-slurp-forward (&optional n) - (interactive "p") - (insert "()") - (backward-char) - (ignore-errors (puni-slurp-forward n)))) - (defhook (prog-mode-hook - lisp-interaction-mode-hook emacs-lisp-mode-hook - lisp-mode-hook scheme-mode-hook - ielm-mode-hook eval-expression-minibuffer-setup-hook) - #'puni-mode)) - -(yoke (hungry-delete "https://github.com/nflath/hungry-delete") - (setc hungry-delete-chars-to-skip " \t" - hungry-delete-join-reluctantly nil) - (eval-after hungry-delete - (add-to-list* 'hungry-delete-except-modes - #'eshell-mode - #'nim-mode - #'python-mode)) - (defun +hungry-delete-or (hd-fn fn arg) - (funcall (if (looking-back (format "[%s]" hungry-delete-chars-to-skip) arg) - hd-fn - fn) - arg)) - (defkeys puni-mode-map - [remap puni-backward-delete-char] - (defun +puni|hungry-delete-backward (arg) - (interactive "p") - (+hungry-delete-or #'hungry-delete-backward - #'puni-backward-delete-char - arg)) - [remap puni-forward-delete-char] - (defun +puni|hungry-delete-forward (arg) - (interactive "p") - (+hungry-delete-or #'hungry-delete-forward - #'puni-forward-delete-char - arg))) - (global-hungry-delete-mode)) +(use-package mode-line-bell + :vc ( :url "https://github.com/duckwork/mode-line-bell" + :rev "remap-face") + :custom + (mode-line-bell-flash-time 0.25) + :config + (mode-line-bell-mode)) + +(use-package electric-cursor + :load-path "~/src/emacs/electric-cursor/" + :custom + (electric-cursor-alist '((overwrite-mode . box) + (t . bar))) + (electric-cursor-mode)) -(yoke (cape "https://github.com/minad/cape") - ;; Insinuate in a lot of modes - (defvar +capes '(cape-file cape-dabbrev)) - (defun +cape-insinuate (hook capf &optional capes) - "Insinuate CAPES into a HOOK along with CAPF function. -CAPES defaults to `+capes'. CAPF will be made un-exclusive." - (setq-local-hook hook - completion-at-point-functions - (apply #'list (cape-capf-properties capf :exclusive 'no) - (or capes +capes)))) - (+cape-insinuate 'emacs-lisp-mode-hook #'elisp-completion-at-point)) - -(yoke (minions "https://github.com/tarsius/minions") - (minions-mode)) +(use-package visual-fill-column + :ensure t + :custom + (visual-fill-column-center-text t) + :hook ((visual-fill-column-mode-hook . visual-line-mode) + (eww-mode-hook . visual-fill-column-mode)) + :config + (advice-add 'text-scale-adjust :after #'visual-fill-column-adjust)) -(yoke (magit "https://github.com/magit/magit" - :load "lisp") - :depends ((transient "https://github.com/magit/transient" - :load "lisp") - (dash "https://github.com/magnars/dash.el") - (with-editor "https://github.com/magit/with-editor" - :load "lisp")) - (autoload #'transient--with-suspended-override "transient") - (autoload #'magit "magit" nil :interactive) - (defkeys t - "C-x g" #'magit)) +(use-package cape + :ensure t + :demand t + :init + (dolist (fn '(cape-file cape-dabbrev)) + (add-hook 'completion-at-point-functions fn 90)) + :config + (require '+cape) + (advice-add 'emacs-completion-at-point :around #'cape-wrap-nonexclusive) + (+cape-insinuate text-mode-hook ( cape-dict cape-ispell + cape-file cape-dabbrev))) + +(use-package wgrep + :ensure t + :custom + (wgrep-enable-key (kbd "C-x C-q")) + :bind (:map grep-mode-map + ("C-x C-q" . wgrep-change-to-wgrep-mode))) + +(progn + (use-package-statistics-gather :use-package 'mlscroll nil) + (use-package-ensure-elpa 'mlscroll + '(t) + 'nil) + (use-package-statistics-gather :preface 'mlscroll nil) + (eval-and-compile + (defhook modus-themes-after-load-theme-hook :name modus-themes-load@mlscroll + (mlscroll-mode -1) + (when + (or + (memq 'modus-vivendi custom-enabled-themes) + (memq 'modus-operandi custom-enabled-themes)) + (modus-themes-with-colors + (setf mlscroll-in-color fg-dim mlscroll-out-color bg-inactive))) + (eval-after 1 + (mlscroll-mode 1)))) + (defvar use-package--warning99 + (function + (lambda + (keyword err) + (let + ((msg + (format "%s/%s: %s" 'mlscroll keyword + (error-message-string err)))) + (display-warning 'use-package msg :error))))) + (condition-case-unless-debug err + (progn + (use-package-statistics-gather :init 'mlscroll nil) + (condition-case-unless-debug err + (when + (daemonp) + (add-hook 'server-after-make-frame + (function modus-themes-load@ml-scroll))) + (error + (funcall use-package--warning99 :init err))) + (run-with-idle-timer 1 nil + (function require) + 'mlscroll nil t) + (eval-after-load 'mlscroll + '(progn + (use-package-statistics-gather :config 'mlscroll nil) + (let + ((now + (current-time))) + (message "%s..." "Configuring package mlscroll") + (prog1 + (condition-case-unless-debug err + (progn + (modus-themes-load@mlscroll) + t) + (error + (funcall use-package--warning99 :config err))) + (let + ((elapsed + (float-time + (time-subtract + (current-time) + now)))) + (if + (> elapsed 0.1) + (message "%s...done (%.3fs)" "Configuring package mlscroll" elapsed) + (message "%s...done" "Configuring package mlscroll"))))) + (use-package-statistics-gather :config 'mlscroll t))) + (use-package-statistics-gather :init 'mlscroll t)) + (error + (funcall use-package--warning99 :catch err))) + (use-package-statistics-gather :preface 'mlscroll t) + (use-package-statistics-gather :use-package 'mlscroll t)) + +(use-package avy + :ensure t + :demand t + :custom + (avy-background t) + (avy-keys (string-to-list "asdfghjklqwertyuiopzxcvbnm")) + :bind (("M-j" . avy-goto-char-timer) + :map isearch-mode-map + ("M-j" . avy-isearch))) + +(use-package zzz-to-char + :ensure t + :bind (("M-z" . zzz-to-char))) + +;;; Searching + +(use-package isearch-mb + :ensure t + :custom + (isearch-lazy-count t) + (isearch-regexp-lax-whitespace t) + ;; Space matches whitespace, newlines, punctuation + (search-whitespace-regexp "\\W+") + (search-default-mode t "Search using regexp by default.") + ;; Space matches any sequence of characters in a line + ;; search-whitespace-regexp ".*?" + (isearch-wrap-pause 'no) + :config + (require '+isearch) + (advice-add 'isearch-cancel :before + #'+isearch-cancel@add-search-to-history) + (advice-add 'perform-replace :around + #'+perform-replace-dont-exit-on-anykey) + (eval-after (isearch-mb consult) + (add-to-list 'isearch-mb--after-exit #'consult-line) + (add-to-list 'isearch-mb--with-buffer #'consult-isearch-history) + (defkeys isearch-mb-minibuffer-map + "M-s l" #'consult-line + "M-r" #'consult-isearch-history)) + (eval-after (isearch-mb anzu) + (add-to-list 'isearch-mb--after-exit #'anzu-isearch-query-replace) + (defkeys isearch-mb-minibuffer-map + "M-%" #'anzu-isearch-query-replace-regexp + "C-M-%" #'anzu-isearch-query-replace)) + (isearch-mb-mode)) -(yoke (git-modes "https://github.com/magit/git-modes") - (require 'git-modes)) +(use-package anzu + :ensure t + :bind + (("M-%" . anzu-query-replace-regexp) + ("C-M-%" . anzu-query-replace))) -(yoke (visual-fill-column "https://codeberg.org/joostkremers/visual-fill-column") - (setc visual-fill-column-center-text t) - (add-hook 'visual-fill-column-mode-hook #'visual-line-mode) - (advice-add 'text-scale-adjust :after #'visual-fill-column-adjust)) +(use-package frowny + :load-path "~/src/emacs/frowny/" + :config + (global-frowny-mode)) -(yoke (org "https://git.savannah.gnu.org/git/emacs/org-mode.git" - :load "lisp") - :depends ((org-contrib "https://git.sr.ht/~bzg/org-contrib" - :load "lisp")) - ;; DON'T load system org - (setc load-path - (cl-remove-if (lambda (path) (string-match-p "lisp/org\\'" path)) - load-path)) - (setc org-adapt-indentation nil - org-auto-align-tags t - org-archive-mark-done t - org-fold-catch-invisible-edits 'show-and-error - org-clock-clocked-in-display 'mode-line - org-clock-frame-title-format (cons - '(t org-mode-line-string) - (cons " --- " frame-title-format)) - org-clock-string-limit 7 ; just the clock bit - ;; org-clock-string-limit 25 ; gives enough information - org-clock-persist nil - org-confirm-babel-evaluate nil - org-cycle-separator-lines 0 - org-directory (sync/ "org/" t) - org-ellipsis (or truncate-string-ellipsis "…") - org-fontify-done-headline t - org-fontify-quote-and-verse-blocks t - org-fontify-whole-heading-line t - org-hide-emphasis-markers t - org-html-coding-system 'utf-8-unix - org-image-actual-width (list (* (window-font-width) - (- fill-column 8))) - org-imenu-depth 3 - org-indent-indentation-per-level 0 - org-indent-mode-turns-on-hiding-stars nil - org-insert-heading-respect-content t - org-list-demote-modify-bullet '(("-" . "+") - ("+" . "-")) - org-log-done 'time - org-log-into-drawer t - org-num-skip-commented t - org-num-skip-unnumbered t - org-num-skip-footnotes t - org-outline-path-complete-in-steps nil - org-pretty-entities t - org-pretty-entities-include-sub-superscripts nil - org-refile-targets '((nil . (:maxlevel . 2)) - (org-agenda-files . (:maxlevel . 1))) - org-refile-use-outline-path 'file - org-special-ctrl-a/e t - org-special-ctrl-k t - org-src-fontify-natively t - org-src-tab-acts-natively t - org-src-window-setup 'current-window - org-startup-truncated nil - org-startup-with-inline-images t - org-tags-column -77 ;; (- (- fill-column 1 (length org-ellipsis))) - org-todo-keywords - '((sequence "TODO(t)" "WAIT(w@/!)" "ONGOING(o@)" - "|" "DONE(d!)" "ASSIGNED(a@/!)") - (sequence "|" "CANCELED(k@)") - (sequence "MEETING(m)")) - org-use-speed-commands t - org-emphasis-alist '(("*" org-bold) - ("/" org-italic) - ("_" org-underline) - ("=" org-verbatim) - ("~" org-code) - ("+" org-strikethrough))) - (defhook org-mode-hook - #'variable-pitch-mode - #'visual-fill-column-mode - #'turn-off-auto-fill - #'org-indent-mode - #'prettify-symbols-mode - #'abbrev-mode - (defhook ((before-save-hook nil :local)) - :name before-save@org-mode - (+org-hide-drawers-except-point) - (org-align-tags 'all))) - (eval-after org - (require '+org) - (org-clock-persistence-insinuate) - (+org-agenda-inhibit-hooks-mode) - (defkeys org-mode-map - "C-M-k" #'kill-paragraph - "C-M-t" #'transpose-paragraphs - "RET" #'+org-return-dwim - "S-" #'+org-table-copy-down|+org-return - "C-c C-o" #'+org-open-at-point-dwim)) - (eval-after ol ; org-link - (defmacro define-org-link-type (type args &rest body) - "Define an org link TYPE with ARGS that does something. - If BODY is blank, message the user about the link." - (declare (indent 2) (doc-string 3) (debug (sexp sexp def-body))) - (let ((fn (intern (format "org-%s-open" type))) - (body (or body `((message ,(format "%s: %%S" type) ,(car args))))) - (type-string (format "%s" type))) - `(prog1 - (defun ,fn ,args - ,@body) - (org-link-set-parameters ,type-string :follow #',fn)))) - (define-org-link-type sms (number _)) - (define-org-link-type tel (number _)))) - -(yoke org-word-count ; in lisp/ - (eval-after org - (require 'org-word-count) - (add-hook 'org-mode-hook #'org-word-count-mode))) - -(yoke org-agenda - (setq org-agenda-skip-deadline-if-done t - org-agenda-skip-scheduled-if-done t - org-agenda-span 10 - org-agenda-block-separator ?─ - org-agenda-time-grid - '((daily today require-timed) - (800 1000 1200 1400 1600 1800 2000) - " ┄┄┄┄┄ " "┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄") - org-agenda-current-time-string - "← now ─────────────────────────────────────────────────" - org-agenda-include-diary nil ; I use the org-diary features - org-agenda-todo-ignore-deadlines 'near - org-agenda-todo-ignore-scheduled 'future - org-agenda-include-deadlines t - org-deadline-warning-days 0 - org-agenda-show-future-repeats 'next - org-agenda-window-setup 'current-window - org-agenda-file-skip-regexp "sync-conflict") - (defcustom org-agenda-file-skip-regexp nil - "Files matching this regexp are removed from `org-agenda-files'." - :group 'org-agenda) - (define-advice org-agenda-files (:filter-return (files) skip-regexp) - (when org-agenda-file-skip-regexp - (setq files (seq-remove (lambda (file) - (string-match-p org-agenda-file-skip-regexp - file)) - files))) - files) - (setq-local-hook org-agenda-mode-hook - truncate-lines t) - (add-hook 'org-agenda-mode-hook #'hl-line-mode) - (add-hook 'org-agenda-after-show-hook #'org-narrow-to-subtree) +(use-package transpose-frame + :ensure t + :bind + (("C-x 5 t" . transpose-frame))) + +;;; Text editing + +(use-package org + :defer t + :after derived + :init + (require 'init-org) + (require '_work)) + +(use-package ispell + :custom + (ispell-program-name (choose-executable "ispell" "aspell")) + :config + (require '+ispell) + (add-hook 'before-save-hook + #'+ispell-move-buffer-words-to-dir-locals-hook) + (put 'ispell-buffer-session-localwords 'safe-local-variable + #'+ispell-safe-local-p)) + +(use-package flyspell + :hook org-mode-hook) + +(use-package flyspell-correct + :ensure t + :after flyspell + :custom + (flyspell-correct--cr-key ";") + :bind + (:map flyspell-mode-map + (("C-;" . flyspell-correct-wrapper) + ("" . +flyspell-correct-buffer))) + :config + (require '+flyspell-correct) + (defkeys flyspell-mode-map + "C-," nil + "C-." nil)) + +(use-package text-mode + :config + (defhook text-mode-hook + #'abbrev-mode)) + +(use-package filldent + :load-path "~/src/emacs/filldent/" + :bind + ("M-q" . filldent-dwim)) + +(use-package scule + :load-path "~/src/emacs/scule/" + :config (defkeys t - "C-c c" #'org-capture - "C-c a" #'org-agenda) - (eval-after org-capture - (require '+org-capture))) - -(yoke ox ; org-export - (eval-after org (require 'ox)) - (eval-after ox - (require* '+ox '(ox-md nil t)) - (+org-export-pre-hooks-insinuate)) - (setq org-export-coding-system 'utf-8-unix - org-export-headline-levels 8 - org-export-with-drawers nil - org-export-with-section-numbers nil - org-export-with-smart-quotes t - org-export-with-sub-superscripts t - org-export-with-toc nil)) - -(yoke (electric-cursor "https://codeberg.org/acdw/electric-cursor.el") - (setq electric-cursor-alist '((overwrite-mode . hbar) - (t . bar))) - (electric-cursor-mode)) + "M-c" (defmap scule-map + "Keymap for twiddling scules." + "M-u" #'scule-upcase + "M-l" #'scule-downcase + "M-c" #'scule-capitalize))) + +(use-package titlecase + :load-path "~/src/emacs/titlecase.el/" + :after org + :bind (:map scule-map + ("M-t" . titlecase-dwim)) + :config + (require '+titlecase)) + +;;; Programming + +(use-package prog-mode + :config + (defhook prog-mode-hook + #'auto-fill-mode + ;; Use `indent-tabs-mode' unless one of the following modes + (indent-tabs-mode (if (derived-mode-p 'emacs-lisp-mode + 'python-mode + 'haskell-mode) + -1 1)))) + +(use-package paredit + :ensure t + :preface + (defun +paredit-newline () + (interactive) + (call-interactively + (if (derived-mode-p 'lisp-interaction-mode) + #'eval-print-last-sexp + #'paredit-newline))) + :hook ((emacs-lisp-mode-hook + eval-expression-minibuffer-setup-hook + ielm-mode-hook lisp-interaction-mode-hook + lisp-mode-hook scheme-mode-hook + fennel-repl-mode-hook fennel-mode-hook + geiser-mode-hook geiser-repl-mode-hook + ielm-mode-hook) + . enable-paredit-mode) + :bind + (("C-j" . +paredit-newline)) + :config + (defkeys paredit-mode-map + "RET" nil + "M-s" nil) + (require '+paredit) + (add-to-list 'paredit-space-for-delimiter-predicates + #'+paredit-space-for-delimiter) + (eval-after (paredit eldoc) + (eldoc-add-command #'paredit-backward-delete #'paredit-close-round))) + +(use-package hungry-delete + :ensure t + :custom + (hungry-delete-chars-to-skip " \t") + (hungry-delete-join-reluctantly nil) + :config + (dolist (m '(eshell-mode + nim-mode + python-mode)) + (add-to-list 'hungry-delete-except-modes m)) + (require '+hungry-delete) + (eval-after paredit + (defkeys paredit-mode-map + [remap paredit-backward-delete] + (+hungry-delete-define-alternative + paredit-backward-delete hungry-delete-backward) + [remap paredit-forward-delete] + (+hungry-delete-define-alternative + paredit-forward-delete hungry-delete-forward))) + (global-hungry-delete-mode)) -(yoke _work - :depends ((bbdb "https://git.savannah.nongnu.org/git/bbdb.git" - :load "lisp") - (bbdb-vcard "https://github.com/tohojo/bbdb-vcard/")) - (setf bbdb-complete-mail-allow-cycling t - bbdb-file (private/ "bbdb")) - (defhook +custom-after-load-hook - :name _work@after-custom - (require* 'private '_work) - (require* 'bbdb 'bbdb-message) - (bbdb-initialize 'gnus 'message))) - -(yoke (org-taskwise "https://codeberg.org/acdw/org-taskwise.el")) - -(yoke scule - (require 'scule) - (defvar scule-map (let ((map (make-sparse-keymap))) - (define-key map (kbd "M-u") #'scule-upcase) - (define-key map (kbd "M-l") #'scule-downcase) - (define-key map (kbd "M-c") #'scule-capitalize) - map) - "Keymap for scule twiddling.") - (define-key* (current-global-map) - "M-c" scule-map - "M-u" #'universal-argument) - (define-key universal-argument-map (kbd "M-u") #'universal-argument-more)) - -(yoke (titlecase "https://codeberg.org/acdw/titlecase.el") - (eval-after titlecase - (add-to-list* 'titlecase-skip-words-regexps - (rx word-boundary - (+ (any upper digit)) - word-boundary))) - (eval-after scule - (define-key* scule-map - "M-t" #'titlecase-dwim))) - -(yoke (flyspell-correct "https://github.com/duckwork/flyspell-correct") - (eval-after flyspell - (require* 'flyspell-correct - `(+flyspell-correct ,(locate-user-emacs-file "lisp/+flyspell-correct"))) - (define-key* flyspell-mode-map - "C-;" #'flyspell-correct-wrapper - "" #'+flyspell-correct-buffer - "C-," nil - "C-." nil)) - (add-hook 'org-mode-hook #'flyspell-mode) - (setq flyspell-correct--cr-key ";")) - -(yoke (helpful "https://github.com/Wilfred/helpful") - :depends ((dash "https://github.com/magnars/dash.el") - (f "https://github.com/rejeep/f.el") - (s "https://github.com/magnars/s.el") - (elisp-refs "https://github.com/Wilfred/elisp-refs")) - (defkeys t - " f" #'helpful-callable - " v" #'helpful-variable - " k" #'helpful-key - " ." #'helpful-at-point - " o" #'helpful-symbol) - (unless (featurep 'info-look) - (run-with-idle-timer 5 nil (lambda () - (require 'info-look) - (let ((inhibit-message t)) - (info-lookup-setup-mode 'symbol - 'emacs-lisp-mode))))) - (defhook window-configuration-change-hook - :name side-window-setup - (setf fit-window-to-buffer-horizontally t - (alist-get (rx (or "*helpful" "*Help" "*info")) - display-buffer-alist nil nil #'string=) - `(display-buffer-in-side-window - ,@(if (< (frame-text-width) (frame-text-height)) - '((side . bottom) (window-height . 24)) - '((side . right) (window-width . fit-window-to-buffer))))))) - -(yoke (hippie-completing-read - "https://codeberg.org/acdw/hippie-completing-read.el") - (define-key* (current-global-map) - "M-/" #'hippie-completing-read)) - -(yoke dictionary ; Comes with Emacs 29! - (defkeys (t (org-mode-map :after org)) - "C-c d" #'dictionary-search) - (defkeys ((embark-identifier-map :after embark)) - "@" #'dictionary-search) - (setc dictionary-server (if (or (executable-find "dictd") - (file-exists-p "/usr/sbin/dictd")) ; oh debian - "localhost" - "dict.org")) - (setf (alist-get "^\\*Dictionary\\*" display-buffer-alist nil nil #'string=) - '((display-buffer-in-side-window) - (side . bottom) - (window-height . 20)))) - -(yoke (anzu "https://github.com/emacsorphanage/anzu") - (require 'anzu) - (global-anzu-mode) - (defkeys t - [remap query-replace] #'anzu-query-replace-regexp - [remap query-replace-regexp] #'anzu-query-replace) - (defkeys (isearch-mode-map (isearch-mb-minibuffer-map :after isearch-mb)) - [remap isearch-query-replace] #'anzu-isearch-query-replace-regexp - [remap isearch-query-replace-regexp] #'anzu-isearch-query-replace) - (defun anzu-qr@window (fn &rest r) - "ADVICE to query-replace from the beginning of the window." - (let ((scroll-margin 0)) - (cond ((region-active-p) - (apply fn r)) - (:else (save-excursion - (goto-char (window-start)) - (apply fn r)))))) - (advice-add 'anzu-query-replace-regexp :around #'anzu-qr@window) - (advice-add 'anzu-query-replace :around #'anzu-qr@window)) - -(yoke tempo - (require '+tempo)) - -(yoke (0x0 "https://gitlab.com/willvaughn/emacs-0x0") - (setf 0x0-default-server 'ttm) - (define-advice 0x0-shorten-uri (:around (fn server uri) use-0x0) - (interactive (list (cdr (assq 'envs 0x0-servers)) - (read-string "URI: "))) - (funcall fn server uri)) - (eval-after embark - (define-key* embark-region-map - "U" #'0x0-dwim))) - -(yoke (filldent "https://codeberg.org/acdw/filldent.el") - (define-advice canonically-space-region (:around (orig &rest r) double-space) - (let ((sentence-end-double-space t)) - (apply orig r))) - (defkeys t - "M-q" #'filldent-unfill-toggle)) - -(yoke (avy "https://github.com/abo-abo/avy") - (require 'avy) - (setf avy-background t - (alist-get ?. avy-dispatch-alist) - (defun avy-action-embark (pt) - (unwind-protect - (save-excursion - (goto-char pt) - (embark-act)) - (select-window - (cdr (ring-ref avy-ring 0)))) - t)) - (define-key* (current-global-map) - "M-j" #'avy-goto-char-timer) - (define-key* isearch-mode-map - "M-j" #'avy-isearch)) - -(yoke (frowny "https://codeberg.org/acdw/frowny.el") - (setf frowny-eyes (rx (any ":=") (opt "'") (? "-"))) - (global-frowny-mode)) +(use-package ediff + :custom + (ediff-keep-variants nil) + (ediff-split-window-function #'split-window-horizontally) + (ediff-window-setup-function #'ediff-setup-windows-plain)) -(yoke (isearch-mb "https://github.com/astoff/isearch-mb") - (eval-after (consult anzu) - (require 'isearch-mb) - (dolist (spec '((isearch-mb--with-buffer - ("M-e" . consult-isearch) - ("C-o" . loccur-isearch)) - (isearch-mb--after-exit - ("M-%" . anzu-isearch-query-replace) - ("M-s l" . consult-line)))) - (let ((isearch-mb-list (car spec)) - (isearch-mb-binds (cdr spec))) - (dolist (cell isearch-mb-binds) - (let ((key (car cell)) - (command (cdr cell))) - (when (fboundp command) - (add-to-list isearch-mb-list command) - (define-key isearch-mb-minibuffer-map (kbd key) command))))))) - (isearch-mb-mode)) +;;; Lisps -(yoke (keepassxc-shim "https://codeberg.org/acdw/keepassxc-shim.el") +(use-package elisp-mode + :custom + (eval-expression-print-length nil) + (eval-expression-print-level nil) + :preface + (defun elisp-eval-region|eval-buffer () + (interactive) + (if (region-active-p) + (let ((start (region-beginning)) + (end (region-end))) + (eval-region start end) + (message "Region from %s to %s evaluated." + start end)) + (eval-buffer) + (message "Buffer `%s' evaluated." (buffer-name)))) + (defkeys (emacs-lisp-mode-map lisp-interaction-mode-map) + "C-c C-c" #'eval-defun + "C-c C-k" #'elisp-eval-region|eval-buffer + "C-c C-z" #'ielm) + :config + (define-advice eval-region (:around (orig start end &rest args) pulse) + (apply orig start end args) + (pulse-momentary-highlight-region start end)) + (defhook emacs-lisp-mode-hook + (setq-local page-delimiter "^\\( \\|;;;+\\).*"))) + +(use-package macrostep + :ensure t + :after elisp-mode + :bind ( :map emacs-lisp-mode-map + ("C-c e" . macrostep-expand) + :map lisp-interaction-mode-map + ("C-c e" . macrostep-expand))) + +(use-package eros + :ensure t + :after elisp-mode + :custom (eros-eval-result-prefix "; ") + :hook emacs-lisp-mode-hook) + +(use-package package-lint + :ensure t) + +(use-package sly + :ensure t + :when (executable-find "sbcl") + :custom + (inferior-lisp-program (executable-find "sbcl")) + (sly-net-coding-system 'utf-8-unix) + :bind (:map sly-mode-map + (("C-c C-z" . sly-mrepl))) + :config + (sly-symbol-completion-mode -1)) + +(use-package edebug + :preface + (defun turn-off-eldoc-mode () + (eldoc-mode -1)) + :config + (add-hook 'edebug-mode-hook #'turn-off-eldoc-mode)) + +;;; Web languages + +(use-package web-mode + :ensure t + :mode ("\\.phtml\\'" + "\\.tpl\\.php\\'" + "\\.[agj]sp\\'" + "\\.as[cp]x\\'" + "\\.erb\\'" + "\\.mustache\\'" + "\\.djhtml\\'" + "\\.html?\\'")) + +;;; Applications + +(use-package dired + :init (require 'dired-x) + :custom + (dired-recursive-copies 'always) + (dired-recursive-deletes 'always) + (dired-create-destination-dirs 'always) + (dired-do-revert-buffer t) + (dired-hide-details-hide-symlink-targets nil) + (dired-isearch-filenames 'dwim) + (delete-by-moving-to-trash t) + (dired-auto-revert-buffer t) + (dired-listing-switches "-AlF") + (ls-lisp-dirs-first t) + (dired-ls-F-marks-symlinks t) + (dired-clean-confirm-killing-deleted-buffers nil) + (dired-no-confirm '(byte-compile + load chgrp chmod chown + copy move hardlink symlink + shell touch)) + (dired-dwim-target t) + :bind + (("C-x C-j" . dired-jump) + ([remap list-directory] . dired) + :map dired-mode-map + ("C-j" . dired-up-directory) + ("" . dired-up-directory)) + :init + (defhook dired-mode-hook + #'dired-hide-details-mode + #'hl-line-mode + #'truncate-lines-local-mode)) + +(use-package dired-subtree + :ensure t + :after dired + :bind (:map dired-mode-map + (("TAB" . dired-subtree-cycle) + ("i" . dired-subtree-toggle)))) + +(use-package dired-collapse + :ensure t + :hook dired-mode-hook) + +(use-package dired-hide-dotfiles + :ensure t + :bind (:map dired-mode-map + ("." . dired-hide-dotfiles-mode))) + +(use-package magit + :ensure t + :bind + ("C-x g" . magit)) + +(use-package auth-source + :custom + (auth-sources '(default "secrets:passwords")) + :config + (defhook authinfo-mode-hook + #'truncate-lines-local-mode)) + +(use-package keychain-environment + :ensure t + :when (executable-find "keychain") + :hook (after-init-hook . keychain-refresh-environment)) + +(use-package keepassxc-shim + :load-path "~/src/emacs/keepassxc-shim/" + :config (keepassxc-shim-activate)) -(yoke (keychain-environment "https://github.com/tarsius/keychain-environment") - :when (executable-find "keychain") - (keychain-refresh-environment)) - -(yoke (exec-path-from-shell "https://github.com/purcell/exec-path-from-shell") - :when (eq system-type 'gnu/linux) - (require 'exec-path-from-shell) - (dolist (var '("SSH_AUTH_SOCK" - "SSH_AGENT_PID" - "GPG_AGENT_INFO" - "LANG" - "LC_CTYPE" - "XDG_CONFIG_HOME" - "XDG_CONFIG_DIRS" - "XDG_DATA_HOME" - "XDG_DATA_DIRS" - "XDG_CACHE_HOME")) - (add-to-list 'exec-path-from-shell-variables var)) - (exec-path-from-shell-initialize)) - -(yoke (sophomore "https://codeberg.org/acdw/sophomore.el") - (sophomore-enable-all) - (sophomore-disable #'view-hello-file - #'describe-gnu-project) - (sophomore-disable-with 'confirm #'save-buffers-kill-terminal)) - -(yoke (macrostep "https://github.com/joddie/macrostep") - (eval-after elisp-mode (require 'macrostep)) - (define-key* '(emacs-lisp-mode-map - lisp-interaction-mode-map) - "C-c e" #'macrostep-expand)) - -(yoke (expand-region "https://github.com/magnars/expand-region.el") - (define-advice er/clear-history (:after (&rest _) refold-org) - (when (derived-mode-p 'org-mode) - (+org-hide-drawers-except-point) - (org-link-descriptive-ensure) - (font-lock-update))) - (defkeys t - "C-=" #'er/expand-region)) +(use-package eat + :ensure t + :commands eat-eshell-mode + :hook (eshell-load-hook . eat-eshell-mode)) + +(use-package dictionary + :custom + (dictionary-server (if (or (executable-find "dictd") + (file-exists-p "/usr/sbin/dictd")) ; debian + "localhost" + "dict.org")) + :bind + (("C-c d" . dictionary-search))) + +(use-package pdf-tools + :ensure t + :mode ("\\.[pP][dD][fF]\\'" . pdf-view-mode) + :magic ("%PDF" . pdf-view-mode) + :config + (pdf-tools-install)) -(yoke (embrace "https://github.com/cute-jumper/embrace.el") - :depends ((expand-region "https://github.com/magnars/expand-region.el")) - (defkeys t - "C-\"" #'embrace-commander) - (dolist (fnhook '((org-mode-hook embrace-org-mode-hook) - (ruby-mode-hook embrace-ruby-mode-hook) - (emacs-lisp-mode-hook embrace-emacs-lisp-mode-hook) - (latex-mode-hook embrace-LaTeX-mode-hook))) - (apply #'add-hook fnhook)) - (eval-after org - (defkeys org-mode-map - "C-\"" #'embrace-commander) - (defmacro org-insert-or-embrace (char) - "Define a function to insert CHAR, or `embrace' the region with it." - (let* ((fn-name (intern (format "org-insert-or-embrace-%s" char))) - (char (cond ((characterp char) char) - ((stringp char) (string-to-char char)) - (t (user-error "Bad format for char: %S" char))))) - `(defun ,fn-name (n) - ,(format "Insert N %ss, or surround the region with them." - (char-to-string char)) - (interactive "p") - (if (region-active-p) - (dotimes (_ n) - (embrace--add-internal (region-beginning) (region-end) ,char) - (forward-char 1)) - (self-insert-command n ,char))))) - (define-key* org-mode-map - "*" (org-insert-or-embrace "*") - "/" (org-insert-or-embrace "/") - "_" (org-insert-or-embrace "_") - "=" (org-insert-or-embrace "=") - "~" (org-insert-or-embrace "~") - "+" (org-insert-or-embrace "+")))) - -(yoke (notmuch "~/usr/share/emacs/site-lisp") - (eval-after bbdb - (require* 'notmuch '+notmuch '+message)) - (+define-dir notmuch/ (sync/ "emacs/notmuch") - "Notmuch configuration and data.") - (setf notmuch-init-file (notmuch/ "notmuch-init.el" t) - notmuch-address-save-filename (notmuch/ "addresses" t) - notmuch-address-use-company (featurep 'company) - notmuch-search-oldest-first nil - notmuch-archive-tags '("-inbox" "-unread") - notmuch-draft-tags '("+draft" "-inbox" "-unread") - mail-user-agent 'notmuch-user-agent - bbdb-mail-user-agent 'notmuch-user-agent - message-mail-user-agent t) - (define-key* (current-global-map) - "C-c m" #'notmuch-mua-new-mail - "C-c n" #'+notmuch-goto) - ;; Reading mail - (setf notmuch-show-indent-content nil) - (add-hook* '(notmuch-show-mode-hook - notmuch-message-mode-hook) +;;; Mail + +(use-package bbdb + :ensure t + :custom + (bbdb-complete-mail-allow-cycling t) + (bbdb-file (private/ "bbdb")) + :init + (defhook custom-allowed-after-load-hook + :name bbdb@after-custom + (require 'bbdb) + (require 'bbdb-message) + (bbdb-initialize 'message))) + +(use-package bbdb-vcard + :ensure t) + +(use-package notmuch + :load-path "~/usr/share/emacs/site-lisp/" + :preface + (defdir notmuch/ (sync/ "emacs/notmuch")) + :init + (use-package +notmuch + :after notmuch + :load-path "lisp/" + :bind (("C-c n" . +notmuch-goto) + :map notmuch-search-mode-map + ("!" . +notmuch-search-mark-spam) + :map notmuch-tree-mode-map + ("!" . +notmuch-search-mark-spam-then-next) + ("M-<" . +notmuch-tree-beginning) + ("M->" . +notmuch-tree-end)) + :hook (message-send-hook . +send-mail-dispatch) + :config + ;; Saved searches + (+notmuch-make-saved-search "inbox+unread" "m" 'tree "tag:inbox" "tag:unread" "NOT tag:Spam") + (+notmuch-make-saved-search "inbox" "i" 'tree "tag:inbox" "NOT tag:Spam") + (+notmuch-make-saved-search "lists+unread" "l" 'tree "tag:/List/" "tag:unread") + (+notmuch-make-saved-search "lists" "L" 'tree "tag:/List/") + (+notmuch-make-saved-search "unread" "u" 'tree "tag:unread" "NOT tag:Spam") + (+notmuch-make-saved-search "flagged" "f" 'tree "tag:flagged") + (+notmuch-make-saved-search "sent" "t" 'tree "tag:sent") + (+notmuch-make-saved-search "drafts" "d" 'tree "tag:draft") + (+notmuch-make-saved-search "all mail" "a" 'tree "*")) + (use-package message + :after notmuch + :hook (message-setup-hook . message-signature-setup) + :config (require '+message)) + (defhook (notmuch-show-mode-hook notmuch-message-mode-hook) #'visual-fill-column-mode) - (eval-after notmuch - (define-key* notmuch-search-mode-map - "RET" #'notmuch-search-show-thread - "M-RET" #'notmuch-tree-from-search-thread - "!" #'+notmuch-search-mark-spam) - (define-key* notmuch-tree-mode-map - "!" #'+notmuch-search-mark-spam-then-next - "M-<" (notmuch-tree--define-do-in-message-window - notmuch-tree-beginning-of-message beginning-of-buffer) - "M->" (notmuch-tree--define-do-in-message-window - notmuch-tree-end-of-message end-of-buffer))) - ;; Writing mail - (setf message-kill-buffer-on-exit t - message-auto-save-directory nil) - ;; Sending mail - (setf send-mail-function #'sendmail-send-it - mail-specify-envelope-from t - message-sendmail-envelope-from 'header - message-envelope-from 'header) - ;; Extras - (define-advice mm-save-part-to-file (:before (_handle file) create-directory) - (let ((directory (file-name-directory file))) - (when (yes-or-no-p (format "Directory %s doesn't exist. Create?" directory)) - (make-directory directory :parents)))) - (eval-after notmuch - (require '+notmuch) - (load notmuch-init-file :noerror) - (add-hook 'message-setup-hook #'+message-signature-setup) - (add-hook 'message-send-hook #'+send-mail-dispatch) - (advice-add 'notmuch-tag :filter-args #'+notmuch-correct-tags) - (advice-add 'notmuch-bury-or-kill-this-buffer :after - (defun +display-time@notmuch (&rest _) - ;; (display-time-event-handler) - (setq display-time-mail-string - (replace-regexp-in-string "(.*)" - (format "(%s)" (+notmuch-new-mail-p)) - display-time-mail-string)) - (display-time-update) - (force-mode-line-update))) - (add-to-list 'notmuch-message-headers "List-Post" :append) - (define-advice notmuch-mua-new-reply (:around (orig &rest r) list-aware) - "Make `notmuch-mua-new-reply' list-aware." - (let ((ml (notmuch-show-get-header :List-Post))) - (apply orig r) - (when ml - (with-buffer-modified-unmodified - (message-remove-header "To") - (message-add-header - (format "To: %s" - (replace-regexp-in-string "" "\\1" ml))) - (message-goto-body))))) - (setf notmuch-saved-searches (list - (list :name "inbox+unread" - :query (+notmuch-query-concat - "tag:inbox" - "tag:unread" - "NOT tag:Spam") - :key "m" - :search-type 'tree) - (list :name "inbox" - :query (+notmuch-query-concat - "tag:inbox" - "NOT tag:Spam") - :key "i" - :search-type 'tree) - (list :name "lists+unread" - :query (+notmuch-query-concat - "tag:/List/" - "tag:unread") - :key "l" - :search-type 'tree) - (list :name "lists" - :query "tag:/List/" - :key "L" - :search-type 'tree) - (list :name "unread" - :query (+notmuch-query-concat - "tag:unread" - "NOT tag:Spam") - :key "u" - :search-type 'tree) - (list :name "flagged" - :query "tag:flagged" - :key "f" - :search-type 'tree) - (list :name "sent" - :query "tag:sent" - :key "t" - :search-type 'tree) - (list :name "drafts" - :query "tag:draft" - :key "d" - :search-type 'tree) - (list :name "all mail" - :query "*" - :key "a" - :search-type 'tree))))) - -(yoke (cider "https://github.com/clojure-emacs/cider") - :depends ((clojure-mode "http://github.com/clojure-emacs/clojure-mode") - (parseedn "https://github.com/clojure-emacs/parseedn/") - (parseclj "https://github.com/clojure-emacs/parseclj/") ; parseedn - (queue "https://elpa.gnu.org/packages/queue-0.2.el" :type 'http) - (spinner "https://github.com/Malabarba/spinner.el") - (sesman "https://github.com/vspinu/sesman")) - :when (executable-find "clojure")) - -(yoke (web-mode "https://github.com/fxbois/web-mode") - (setf (alist-get (rx "." (or "htm" "html" "phtml" "tpl.php" - "asp" "gsp" "jsp" "ascx" "aspx" - "erb" "mustache" "djhtml") - eos) - auto-mode-alist nil nil #'string=) - 'web-mode)) - -(yoke (chicken-geiser "https://gitlab.com/emacs-geiser/chicken") - :depends ((geiser "https://gitlab.com/emacs-geiser/geiser" - :load "elisp")) - :when (executable-find "csi") - :pre ((autoload 'geiser-activate-implementation "geiser-impl")) - (autoload 'geiser "geiser" nil :interactive) - (add-hook 'scheme-mode-hook 'geiser-mode)) - -(yoke (zoom-frm "https://github.com/emacsmirror/zoom-frm") - :depends ((frame-cmds "https://github.com/emacsmirror/frame-cmds") - (frame-fns "https://github.com/emacsmirror/frame-fns")) - (define-key* (current-global-map) - "M-+" #'zoom-frm-in - "M-_" #'zoom-frm-out)) - -(yoke (jabber "https://codeberg.org/acdw/emacs-jabber") - :depends ((srv "https://github.com/legoscia/srv.el") - (fsm "https://elpa.gnu.org/packages/fsm-0.2.1.el" :type 'http)) - (setf jabber-account-list '(("acdw@hmm.st")) - jabber-auto-reconnect t - jabber-chat-buffer-format "xmpp:%n" - jabber-browse-buffer-format "xmpp-browse:%n" - jabber-groupchat-buffer-format "xmpp-muc:%n" - jabber-muc-private-buffer-format "xmpp-muc-private:%n" - jabber-groupchat-prompt-format "%>10n │ " - jabber-chat-local-prompt-format "%>10n │ " - jabber-chat-system-prompt-format " * * * * * *" - jabber-chat-foreign-prompt-format "%>10n │ " - jabber-muc-private-foreign-prompt-format "%g/%n " - jabber-last-read-marker "----------------------------------------" - jabber-muc-header-line-format '("" jabber-muc-topic) - jabber-muc-decorate-presence-patterns - '(("\\( enters the room ([^)]+)\\| has left the chatroom\\)$") - ("." . jabber-muc-presence-dim)) - jabber-activity-make-strings - #'jabber-activity-make-strings-shorten - ;; (defun +jabber-activity-make-strings (jids) - ;; (mapcar (lambda (jid) - ;; (cons jid - ;; (let ((s (jabber-activity-make-string-default jid))) - ;; (cond - ;; ((string-match-p "%" s) - ;; (replace-regexp-in-string "%.*" "" s)) - ;; (:else s))))) - ;; jids)) - jabber-rare-time-format " - - - - - - %H:%M %F") + :custom + (notmuch-init-file (notmuch/ "notmuch-init.el" t)) + (notmuch-address-save-filename (notmuch/ "addresses" t)) + (notmuch-address-use-company (featurep 'company)) + (notmuch-search-oldest-first nil) + (notmuch-archive-tags '("-inbox" "-unread")) + (notmuch-draft-tags '("+draft" "-inbox" "-unread")) + (mail-user-agent 'notmuch-user-agent) + (bbdb-mail-user-agent 'notmuch-user-agent) + (message-mail-user-agent t) + (notmuch-show-indent-content nil) + (message-kill-buffer-on-exit t) + (message-auto-save-directory nil) + (send-mail-function #'sendmail-send-it) + (mail-specify-envelope-from t) + (message-sendmail-envelope-from 'header) + (message-envelope-from 'header) + (notmuch-saved-searches nil) + :bind + (("C-c m" . notmuch-mua-new-mail) + :map notmuch-search-mode-map + ("RET" . notmuch-search-show-thread) + ("M-RET" . notmuch-tree-from-search-thread)) + :config + (load notmuch-init-file :noerror) + (advice-add 'notmuch-tag :filter-args #'+notmuch-correct-tags) + ;; Mailing lists + (add-to-list 'notmuch-message-headers "List-Post" :append) + (define-advice notmuch-mua-new-reply (:around (orig &rest r) list-aware) + "Make `notmuch-mua-new-reply' list-aware." + (let ((ml (notmuch-show-get-header :List-Post))) + (apply orig r) + (when ml + (with-buffer-modified-unmodified + (message-remove-header "To") + (message-add-header + (format "To: %s" + (replace-regexp-in-string "" "\\1" ml))) + (message-goto-body)))))) + +;;; The INTERNET + +(use-package link-hint + :ensure t + :demand t + :preface + (global-set-key (kbd "M-l") nil) + :custom + (link-hint-avy-style 'at-full) + (link-hint-avy-all-windows t) + :config + (require '+link-hint) + (+link-hint-open-secondary-setup) + (+link-hint-open-chrome-setup) + :bind + (("M-l M-l" . +link-hint-open-link) + ("M-l l" . +link-hint-open-link) + ("M-l M-o" . +link-hint-open-secondary) + ("M-l o" . +link-hint-open-secondary) + ("M-l M-m" . +link-hint-open-multiple-links) + ("M-l m" . +link-hint-open-multiple-links) + ("M-l M-w" . link-hint-copy-link) + ("M-l w" . link-hint-copy-link) + ("M-l M-c" . +link-hint-open-chrome) + ("M-l c" . +link-hint-open-chrome))) + +(use-package browse-url + :demand t + :preface + (require '+browse-url) + :config + (eval-after chd + (add-to-list 'browse-url-handlers (cons chd/url-regexps + #'browse-url-chrome)) + (add-to-list '+browse-url-other-safe-browser-functions + #'chd/browse-url)) + (put 'browse-url-browser-function 'safe-local-variable + #'+browse-url-browser-function-safe-p) + :custom + (browse-url-browser-function #'eww-browse-url) + (browse-url-chromium-program (choose-executable "chromium")) + (browse-url-chrome-program (choose-executable "chrome" "google-chrome-stable")) + (browse-url-firefox-program (choose-executable "firefox" "firefox-esr")) + (browse-url-firefox-new-window-is-tab t) + (browse-url-firefox-arguments '("--new-tab")) + (browse-url-generic-program (or browse-url-firefox-program + browse-url + browse-url-chrome-program)) + (browse-url-generic-args + (cl-loop for prog in '(firefox chromium chrome) + for progfn = (intern (format "browse-url-%s-program" + prog)) + for progargs = (intern (format "browse-url-%s-arguments" + prog)) + if (equal browse-url-generic-program + (symbol-value progfn)) + return (symbol-value progargs) + finally return nil)) + (browse-url-handlers + `(;; Videos + (,(+browse-url-matches "youtube\\.com" "youtu\\.be" + "invidious" "yewtu\\.be" + (rx "." (or "mp4" "gif" "mov" "MOV" "webm") + eos)) + . +browse-url-with-mpv) + ;; Music + (,(+browse-url-matches "soundcloud\\.com" "bandcamp\\.com" + (rx "." (or "ogg" "mp3" "opus" "m4a") eos)) + . +browse-url-with-mpv) + ;; Images + (,(+browse-url-matches "pbs\\.twimg\\.com" + (rx "." (or "jpeg" "jpg" "png" "bmp" "webp") + eos)) + . +browse-url-with-mpv-image) + ;; Blobs (binary files) + (,(+browse-url-matches (rx "." (or ".tar.gz" ".pdf") eos)) + . +browse-url-download) + ;; External URLs --- these are URLs that don't open in EWW very well, + ;; so I want to open them in the external browser. + (+browse-url-external-url-p . ,(if (featurep 'xwidget-internal) + #'xwidget-webkit-browse-url + browse-url-secondary-browser-function)))) + (+browse-url-external-domains '("github.com" "gitlab.com" "codeberg.org" + "tildegit.org" "git.tilde.town" + "google.com" "imgur.com" "twitch.tv" + "pixelfed" "instagram.com" + "bibliogram.art" "reddit.com" + "teddit.net" "libreddit.de" + "streamable.com" "spotify.com" + "hetzner.cloud" "melpa.org" + "twitter.com" ("^t\\.co$") + "nitter.snopyta.org" "nitter.net"))) + +(use-package browse-url-transform + :after browse-url + :load-path "~/src/emacs/browse-url-transform/" + :custom + (browse-url-transform-alist + `(;; Privacy-respecting alternatives + ("twitter\\.com" . "nitter.snopyta.org") + ("\\(?:\\(?:old\\.\\)?reddit\\.com\\)" . "libreddit.de") + ("medium\\.com" . "scribe.rip") + (".*substack\\.com.*" . ,substack-proxy) + ;; 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"))) + :config + (browse-url-transform-mode)) + +(use-package eww + :custom + (eww-use-browse-url ".") + :config + (defhook eww-mode-hook + (defhook ((visual-fill-column-mode nil :local)) + :name visual-fill-column@eww-mode-refresh + (eww-reload t))) + (defkeys eww-mode-map + "&" (+browse-url-switch-external-browser eww-mode + (plist-get eww-data :url)))) + +(use-package xwidget + :when (featurep 'xwidget-internal) + :preface + (setenv "WEBKIT_FORCE_SANDBOX" "0") ; This is probably a bad idea + :custom + (xwidget-webkit-cookie-file (cache/ "xwidget-cookies")) + (xwidget-webkit-download-dir (expand-file-name "~/var/download")) + :config + (defkeys xwidget-webkit-mode-map + "&" (+browse-url-switch-external-browser xwidget-webkit-mode + (xwidget-webkit-uri (xwidget-webkit-current-session))))) + +(use-package xwwp + :load-path "~/src/emacs/xwwp/" + :when (featurep 'xwidget-internal) + :custom + (xwwp-search-prefix "https://duckduckgo.com/?q=") + :bind (:map xwidget-webkit-mode-map + ("f" . xwwp-follow-link))) + +(use-package jabber + :load-path "~/src/emacs/emacs-jabber" + :custom + (jabber-account-list '(("acdw@hmm.st"))) + (jabber-auto-reconnect t) + (jabber-chat-buffer-format "xmpp:%n") + (jabber-browse-buffer-format "xmpp-browse:%n") + (jabber-groupchat-buffer-format "xmpp-muc:%n") + (jabber-muc-private-buffer-format "xmpp-muc-private:%n") + (jabber-groupchat-prompt-format "%>10n │ ") + (jabber-chat-local-prompt-format "%>10n │ ") + (jabber-chat-system-prompt-format " * * * * * *") + (jabber-chat-foreign-prompt-format "%>10n │ ") + (jabber-muc-private-foreign-prompt-format "%g/%n ") + (jabber-last-read-marker "----------------------------------------") + (jabber-muc-header-line-format '("" jabber-muc-topic)) + (jabber-muc-decorate-presence-patterns + '(("\\( enters the room ([^)]+)\\| has left the chatroom\\)$") + ("." . jabber-muc-presence-dim))) + (jabber-activity-make-strings + #'jabber-activity-make-strings-shorten) + (jabber-rare-time-format " - - - - - - %H:%M %F") + :custom-face + (jabber-chat-prompt-local ((t :inherit font-lock-keyword-face + :foreground unspecified))) + (jabber-activity-face ((t :inherit jabber-chat-prompt-foreign + :foreground unspecified + :weight normal))) + (jabber-activity-personal-face ((t :inherit font-lock-warning-face + :foreground unspecified + :weight bold))) + (jabber-chat-prompt-foreign ((t :inherit font-lock-constant-face + :foreground unspecified))) + (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))) + :init (defhook (jabber-chat-mode-hook jabber-browse-mode-hook jabber-roster-mode-hook jabber-console-mode-hook) :name jabber-ui-setup + (visual-fill-column-mode) (electric-pair-local-mode -1) (auto-fill-mode -1) - #'visual-fill-column-mode) - (setq-local-hook jabber-chat-mode-hook - wrap-prefix (format "%13s" " ")) - (defun +jabber-fix-keybinds-dammit () - "Jabber autoloads keybinds which is really annoying." - (define-key* (current-global-map) - "C-x C-j" #'dired-jump - "C-c j" jabber-global-keymap - "C-c C-SPC" #'jabber-activity-switch-to)) - (eval-after init (+jabber-fix-keybinds-dammit)) - (eval-after jabber - (require 'jabber-httpupload nil :noerror) - (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-alert-muc-hooks - (defun jabber@highlight-acdw (&optional _nick _group buf _text _title) - (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 'hi-blue)))))) - (add-hook 'window-configuration-change-hook #'jabber-chat-update-focus) - (+jabber-fix-keybinds-dammit) - (defkeys jabber-chat-mode-map - "C-l" (defun +jabber-recenter-last-read () - (interactive) - (cond - ((eq last-command '+jabber-recenter-last-read) - (setq this-command #'recenter) - (recenter -1)) - (:else - (save-excursion - (condition-case e - (re-search-backward jabber-last-read-marker) - (search-failed nil) - (:success - (recenter 3))))))))) - (defun jabber-chat-kill-buffers () - "Kill all `jabber-chat-mode' buffers." - (interactive) - (mapc-buffers (lambda () (message "%S" (buffer-name))) '(jabber-chat-mode))) - (defun jabber-chat@after-modus-themes-load () - (modus-themes-with-colors - (custom-set-faces - `(jabber-chat-prompt-foreign ((t :foreground unspecified - :inherit modus-themes-bold)) - :now) - `(jabber-chat-prompt-local ((t :foreground unspecified - :inherit modus-themes-bold)) - :now) - `(jabber-chat-prompt-system ((t :foreground unspecified - :inherit modus-themes-bold)) - :now) - `(jabber-activity-face ((t :slant italic))) - `(jabber-activity-personal-face ((t :slant italic :weight bold))) - `(jabber-rare-time-face ((t :inherit font-lock-comment-face))))) - (setq jabber-muc-nick-value - (pcase (frame--current-backround-mode (selected-frame)) - ('light 0.5) - ('dark 1.0)))) - (eval-after modus-themes - (add-hook 'modus-themes-after-load-theme-hook - #'jabber-chat@after-modus-themes-load)) - (when (or (custom-theme-enabled-p 'modus-operandi) - (custom-theme-enabled-p 'modus-vivendi)) - (jabber-chat@after-modus-themes-load)) - (eval-after (consult jabber) - ;; Jabber.el chat buffers source for `consult-buffer' + (setq-local wrap-prefix (format "%13s" " "))) + :bind-keymap ("C-c j" . jabber-global-keymap) + :bind (("C-c C-SPC" . jabber-activity-switch-to)) + :config + (global-set-key (kbd "C-x C-j") #'dired-jump) ; Extremely annoying fix + (require 'jabber-httpupload nil :noerror) + (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-alert-muc-hooks + (defun jabber@highlight-acdw (&optional _nick _group buf _text _title) + (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 'hi-blue)))))) + (add-hook 'window-configuration-change-hook #'jabber-chat-update-focus) + (eval-after consult (defvar jabber-chat-buffer-source `( :name "Jabber" :hidden nil @@ -1238,190 +987,3 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive." (add-to-list 'consult-buffer-sources 'jabber-chat-buffer-source :append) ;; Also hide xmpp buffers from regular buffer list (add-to-list 'consult-buffer-filter "\\`xmpp" nil #'string-equal))) - -(yoke (link-hint "https://github.com/noctuid/link-hint.el/") - :depends ((avy "https://github.com/abo-abo/avy")) - (require '+link-hint) - (+link-hint-open-secondary-setup) - (+link-hint-open-chrome-setup) - (setf link-hint-avy-style 'at-full - link-hint-avy-all-windows t) - (global-set-key (kbd "M-l") +link-hint-map) - (define-key* +link-hint-map - "M-l" #'+link-hint-open-link "l" #'+link-hint-open-link - "M-o" #'+link-hint-open-secondary "o" #'+link-hint-open-secondary - "M-m" #'+link-hint-open-multiple-links "m" #'+link-hint-open-multiple-links - "M-w" #'link-hint-copy-link "w" #'link-hint-copy-link - "M-c" #'+link-hint-open-chrome "c" #'+link-hint-open-chrome)) - -(yoke (elpher "git://thelambdalab.xyz/elpher.git") - (eval-after elpher - (define-key* elpher-mode-map - "l" #'elpher-back))) - -(yoke (epithet "https://github.com/oantolin/epithet") - (defhook (Info-selection-hook - help-mode-hook - occur-mode-hook - shell-mode-hook) - #'epithet-rename-buffer) - (cond ((boundp 'eww-auto-rename-buffer) - (setc eww-auto-rename-buffer 'title)) - (:else (defhook eww-after-render-hook #'epithet-rename-buffer)))) - -(yoke browse-url - (require '+browse-url) - (setf browse-url-browser-function #'eww-browse-url - browse-url-chrome-program (seq-some #'executable-find - '("chromium" "chrome" "google-chrome-stable")) - browse-url-firefox-program (seq-some #'executable-find - '("firefox" "firefox-esr")) - browse-url-generic-program (or browse-url-firefox-program - browse-url-chrome-program) - browse-url-firefox-new-window-is-tab t - browse-url-firefox-arguments "-new-tab" - browse-url-handlers `((video-url-p . +browse-url-with-mpv) - (music-url-p . +browse-url-with-mpv) - (image-url-p . +browse-image-with-mpv) - (blobp . +browse-url-download) - (external-url-p . ,browse-url-secondary-browser-function) - ;; HERE FOR REFERENCE --- OPEN MASTO URLS SOME WAY - (,(defun mastodon-url-p (url) - "Try to determine whether URL is a mastodon URL." - (string-match-p "/@[^/]+\\(/\\|/[[:digit:]]+\\)?$" url)) - . ,browse-url-secondary-browser-function))) - (+browse-url-make-external-viewer-handler "mpv" '("--cache-pause-wait=30" - "--cache-pause-initial=yes") - "Video URL: " - :fallback browse-url-secondary-browser-function) - (+browse-url-make-external-viewer-handler "mpv" '("--image-display-duration=inf") - "Image URL: " - :name +browse-image-with-mpv) - (defun video-url-p (url) "Is URL a video?" - (string-match-p (rx (or "youtube.com" "youtu.be" "invidious" "yewtu.be" - (seq "." (or "mp4" "gif" "mov" "MOV" "webm") eos))) - url)) - (defun music-url-p (url) "Is URL music?" - (string-match-p (rx "soundcloud.com" "bandcamp.com" - (seq "." (or "ogg" "mp3" "opus" "m4a" "flac") eos)) - url)) - (defun image-url-p (url) "Is URL an image?" - (string-match-p (rx - (or (: "." (or "jpeg" "jpg" "png" "bmp" "webp") eos) - "pbs.twimg.com")) - url)) - (defun external-url-p (url) "Should URL open in an external browser?" - (string-match-p (rx (or "github.com" "gitlab.com" "codeberg.org" - "tildegit.org" "git.tilde.town" "google.com" - "imgur.com" "twitch.tv" "pixelfed" "instagram.com" - "bibliogram.art" "reddit.com" "teddit.net" - ;; "twitter.com" "nitter" "t.co" - "streamable.com" "spotify.com" - "hetzner.cloud" "melpa.org")) - url)) - (defun blobp (url) "Is URL some other blob that can't open in Emacs?" - (string-match-p (rx (or (: (or ".tar.gz" ".pdf") - eos))) - url)) - (eval-after chd - (add-to-list 'browse-url-handlers (cons chd/url-regexps #'chd/browse-url))) - (require 'browse-url-transform) - (setf 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") - ("gist\\.github\\.com/\\(.*\\)" - . "gist.githubusercontent.com/\\1/raw/"))) - (browse-url-transform-mode)) - -(yoke eww - (setc eww-use-browse-url ".") - (eval-after eww - (defhook eww-mode-hook - #'visual-fill-column-mode - (defhook ((visual-fill-column-mode-hook nil :local)) - :name eww-mode-refresh@visual-fill-column - (eww-reload t))) - (defkeys eww-mode-map - "&" - (defun +eww-browse-with-external-browser (&optional url) - "Browse URL with an external browser and close eww." - (interactive nil eww-mode) - (condition-case e - ;; This is wrapped in a `condition-case' so that the eww window - ;; won't close if there's an error calling the browser. - (funcall browse-url-secondary-browser-function - (or url (plist-get eww-data :url))) - (:success - (when (null url) ; interactive - (quit-window))) - (t (signal (car e) (cdr e))))))) - (eval-after (eww link-hint) - (defkeys eww-mode-map - "f" #'+link-hint-open-link))) - -(yoke tab-bar - (setf tab-bar-show t - global-mode-string - '((jabber-activity-mode - (:eval - (let ((str (or (bound-and-true-p jabber-activity-mode-string) - ""))) - (concat (truncate-string-to-width str 20 nil nil t) - (if (< 0 (length str)) " ⋅" ""))))) - display-time-string - "|")) - (eval-after jabber - (defhook jabber-activity-mode-hook - (setf global-mode-string - '((jabber-activity-mode - (:eval - (let ((str (or (bound-and-true-p jabber-activity-mode-string) - ""))) - (concat (truncate-string-to-width str 20 nil nil t) - (if (< 0 (length str)) " ⋅" ""))))) - display-time-string - "|")))) - (add-to-list 'tab-bar-format 'tab-bar-format-align-right :append) - (add-to-list 'tab-bar-format 'tab-bar-format-global :append) - (tab-bar-mode)) - -(yoke (pdf-tools "https://github.com/vedang/pdf-tools" - :load "lisp") - :depends ((tablist "https://github.com/politza/tablist/")) - :when (executable-find "epdfinfo") ; installed from Debian repos - (pdf-tools-install)) - -(yoke which-function - (setf (alist-get 'which-function-mode mode-line-misc-info) - '((which-func-mode ; Only display if buffer supports it - (:eval (when (which-function) - (list "" which-func-format " ")))))) - (which-function-mode)) - -(yoke (zzz-to-char "https://github.com/mrkkrp/zzz-to-char") - :depends ((avy "https://github.com/abo-abo/avy")) - (setf zzz-to-char-reach 120) - (defkeys t - [remap zap-to-char] - (defun +zzz-to-char (&optional prefix) - "Run `zzz-up-to-char', or `zzz-to-char' with PREFIX." - (interactive "P") - (call-interactively (cond (prefix #'zzz-to-char) - (:else #'zzz-up-to-char)))))) - -(yoke sh-mode - (defhook sh-mode-hook - :name turn-off-sh-electric-here-document-mode - (sh-electric-here-document-mode -1))) - diff --git a/lisp/+browse-url.el b/lisp/+browse-url.el index 12e433c..b65b6f9 100644 --- a/lisp/+browse-url.el +++ b/lisp/+browse-url.el @@ -1,60 +1,101 @@ -;;; +browse-url.el -*- lexical-binding: t -*- +;;; +browse-url.el -*- lexical-binding: t; -*- (require 'browse-url) +(require 'cl-lib) +(require 'seq) +(require 'url-util) + +(defgroup +browse-url nil + "My `browse-url' extras." + :group 'browse-url) + +;;; External URL handlers (cl-defmacro +browse-url-make-external-viewer-handler - (viewer default-args - &optional (prompt "URL: ") - &key - (custom-group 'browse-url) - (name (intern (format "+browse-url-with-%s" viewer))) - doc vardoc - (varname (intern (format "%s-args" name))) - (fallback t)) - "Create a `browse-url' handler function calling VIEWER on the url. + (viewer + &key + args + (prompt "URL: ") + (program (executable-find (format "%s" viewer))) + (name (intern (format "+browse-url-with-%s" viewer))) + doc + (var (intern (format "%s-args" name))) + vardoc + (custom-group '+browse-url) + (fallback '(function browse-url-generic))) + "Create a `browse-url' handler function calling PROGRAM on the URL. This macro also creates a `customize' setting in CUSTOM-GROUP for -VIEWER's command-line arguments. DEFAULT-ARGS specifies the -default arguments for that setting. +PROGRAM's command-line arguments. ARGS specifies the +default arguments for this user option. + +PROGRAM defaults to the result of calling `executable-find' on VIEWER. -PROMPT is shown to the user in the function's `interactive' spec, -as an argument to `browse-url-interactive-arg'. +PROMPT is shown to the user in the function's `interactive' spec, as an argument +to `browse-url-interactive-arg'. The resulting function is named NAME, which defaults to -`+browse-url-wth-VIEWER'. The custom variable is named VARNAME, -which defaults to `NAME-args'. If DOC or VARDOC are provided, -they'll be the documentation of the function and variable -respectively; otherwise, basic docstrings are used. - -Finally, if FALLBACK is non-nil (by default, it's -`browse-url-generic'), the function will call that if unable to -start VIEWER." +`+browse-url-with-VIEWER'. The custom variable is named VAR, which defaults +to `NAME-args'. If DOC or VARDOC are provided, they'll be the documentation of +the function and variable respectively; otherwise a basic default doc-string is +used. + +If FALLBACK is non-nil (the default is `browse-url-generic'), the +generated function will call FALLBACK if unable to start PROGRAM +for some reason." (declare (indent 1)) `(progn - (defcustom ,varname ,default-args - ,(or doc (format "Arguments to pass to %s in `%s'." viewer name)) + (defcustom ,var ,args + ,(or vardoc (format "Arguments to pass to %s in `%s'." + viewer name)) :type '(repeat :tag "Command-line argument" string) :group ',custom-group) (defun ,name (url &optional new-window) - ,(or vardoc (format "Open URL in %s." viewer)) + ,(or doc (format "Open URL in %s." viewer)) (interactive (browse-url-interactive-arg ,prompt)) (let* ((url (browse-url-encode-url url)) (process-environment (browse-url-process-environment))) (message ,(format "Opening %%s in %s..." viewer) url) (unless (ignore-errors (apply #'start-process - (format "%s %s" ,viewer url) nil - ,viewer - (append ,varname (list url)))) + (format "%s %s" ',viewer url) + nil + ,program + (append ,var (list url)))) ,@(cond - ((eq fallback t) '((browse-url-generic url new-window))) (fallback `((funcall ,fallback url new-window))) - (:else `((message "Can't find viewer: `%s'" ,viewer) + (:else `((message "Can't find viewer: %s" ,viewer) nil)))))))) +;; Some default handlers + +(+browse-url-make-external-viewer-handler mpv + :args '("--cache-pause-wait=15" + "--cache-pause-initial=yes") + :prompt "Video URL: ") + +(+browse-url-make-external-viewer-handler mpv-image + :program (executable-find "mpv") + :args '("--image-display-duration=inf") + :prompt "Image URL: ") + +;;; Downloading + (defcustom +browse-url-download-open t - "Whether to open downloaded files afterward." - :group 'browse-url + "Whether to open downloaded files after downloading." :type 'boolean) +(defun +browse-url-download (url &rest _) + "Download URL to `eww-download-directory'." + (interactive "sDownload URL: ") + (let ((dir eww-download-directory)) + (when (functionp dir) (setq dir (funcall dir))) + (make-directory dir :parents) + (url-retrieve url + (lambda (s u d) + (let ((file (+browse-url-download-callback s u d))) + (when +browse-url-download-open + (browse-url-xdg-open file)))) + (list url dir)))) + (defun +browse-url-download-callback (status url dir) ;; A slight change to `eww-download-callback' that returns the downloaded ;; filename. @@ -71,18 +112,78 @@ start VIEWER." (message "Saved %s" file) file))) -(defun +browse-url-download (url &rest _) - "Download URL to `eww-download-directory'." - (interactive "sDownload URL: ") - (let ((dir eww-download-directory)) - (when (functionp dir) (setq dir (funcall dir))) - (make-directory dir :parents) - (url-retrieve url - (lambda (s u d) - (let ((file (+browse-url-download-callback s u d))) - (when +browse-url-download-open - (browse-url-xdg-open file)))) - (list url dir)))) +;;; URL matcher generators + +(defun +browse-url-matches (&rest regexps) + "Return a lambda that will determine if a url matches REGEXPS. +Each regexp will be tested in turn. The first one that matches +is returned by the lambda. + +This is a good function to use in key positions in `browse-url-handlers'." + `(lambda (url &optional new-window) + (cl-loop for regexp in ',regexps + if (string-match-p regexp url) + return regexp))) + +;;; External domains +;; Some domains just don't open well in `eww'. The following function and user +;; option define an easy way to automatically open those. + +(defcustom +browse-url-external-domains nil + "Domains to open in `browse-url-secondary-browser-function'. +This is just a list of strings. They'll be regexp-escaped and +passed to `+browse-url-external-url-p', which is a good function +to put in `browse-url-handlers'. + +If an item in this list is a list itself, it should contain one string, a valid +regexp that will not be regexp-quoted when matching against a url." + :type '(repeat (choice + (list :tag "Regexp" regexp) + (string :tag "Literal string")))) + +(defun +browse-url-external-url-p (url) + "Return t if URL is a member of `+browse-url-external-domains'. +This function only tests URL's domain." + (let ((host (url-host (url-generic-parse-url url)))) + (cl-loop for domain in +browse-url-external-domains + if (string-match-p (if (stringp domain) + (regexp-quote domain) + (car domain)) + host) + return t))) + +;;; Switch to an external browser from an Emacs browser + +(defmacro +browse-url-switch-external-browser (mode url-fetcher-form) + "Create a function for MODE to open an external browser. +URL-FETCHER-FORM will be used to get the URL of the current visited page." + (declare (indent 1)) + `(defun ,(intern (format "+browse-url-external-from-%s" mode)) + (&optional url) + "Browse URL with `browse-url-secondary-browser-function'. +This will close the current buffer." + (interactive nil ,mode) + (condition-case e + (funcall browse-url-secondary-browser-function + (or url ,url-fetcher-form)) + (:success (when (null url) (quit-window))) ; Interactive use + (t (signal (car e) (cdr e)))))) + +;;; Mark `browse-url-browser-function' as safe + +(defcustom +browse-url-other-safe-browser-functions nil + "Other safe browser functions." + :type '(repeat function)) + +(defun +browse-url-browser-function-safe-p (f) + "Return t if F is a safe browser function." + (memq f (append +browse-url-other-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))))))) (provide '+browse-url) ;;; +browse-url.el ends here diff --git a/lisp/+cape.el b/lisp/+cape.el new file mode 100644 index 0000000..37e88fe --- /dev/null +++ b/lisp/+cape.el @@ -0,0 +1,25 @@ +;;; cape.el -*- lexical-binding: t; -*- + +;;; Code: + +(require 'cape) + +(defmacro +cape-insinuate (hook capes &rest capfs) + "Insinuate CAPES for a mode. +Add a function to HOOK that will add CAPES to the local +`completion-at-point-functions' for that mode's buffer. If CAPFS +are given, mark them all as non-exclusive." + (let ((fn (intern (format "+cape-insinuate@%s" hook)))) + `(prog1 + ,@(when capes + `((defun ,fn () + ,@(cl-loop for cape in capes + collect `(add-hook 'completion-at-point-functions + #',cape 90 :local))) + (add-hook ',hook #',fn))) + ,@(cl-loop for capf in capfs + collect `(advice-add ',capf :around + #'cape-wrap-nonexclusive))))) + +(provide '+cape) +;;; +cape.el ends here diff --git a/lisp/+custom.el b/lisp/+custom.el deleted file mode 100644 index ba4c55d..0000000 --- a/lisp/+custom.el +++ /dev/null @@ -1,52 +0,0 @@ -;;; +custom.el -*- lexical-binding: t -*- - -(require 'cl-lib) -(require 'seq) - -(defgroup +custom nil - "Group for extra `customize' customizations." - :group 'customize) - -(defcustom +custom-allowed-variables nil - "Variables to load during `+custom-load-some-customizations'." - :type '(repeat symbol)) - -(defcustom +custom-allowed-faces nil - "Faces to load during `+custom-load-some-customziations'." - :type '(repeat face)) - -(defun +custom--filter-list (customlist allowlist) - "Filter CUSTOMLIST to only include those items in ALLOWLIST. -Each item in ALLOWLIST will be compared using `eq' to the `car' -of each item in CUSTOMLIST. Items in CUSTOMLIST not included in -ALLOWLIST will be removed from the return value." - (seq-filter (lambda (el) (memq (car el) allowlist)) - customlist)) - -(defcustom +custom-after-load-hook nil - "Hook run after loading the custom file." - :type 'hook) - -(defun +custom-load-some-customizations (&optional noerror - nomessage - nosuffix - must-suffix) - "Load `custom-file', ignoring most customizations. -Only faces included in `+custom-allowed-faces' and variables -included in `+custom-allowed-variables' will be loaded. - -All optional arguments---NOERROR, NOMESSAGE, NOSUFFIX, -MUST-SUFFIX---are passed to `load', which see." - (cl-letf (((symbol-function 'custom-set-faces) - (lambda (&rest args) - (apply #'custom-theme-set-faces 'user - (+custom--filter-list args +custom-allowed-faces)))) - ((symbol-function 'custom-set-variables) - (lambda (&rest args) - (apply #'custom-theme-set-variables 'user - (+custom--filter-list args +custom-allowed-variables))))) - (load custom-file noerror nomessage nosuffix must-suffix)) - (run-hooks '+custom-after-load-hook)) - -(provide '+custom) -;;; +custom.el ends here diff --git a/lisp/+emacs.el b/lisp/+emacs.el deleted file mode 100644 index 97377a3..0000000 --- a/lisp/+emacs.el +++ /dev/null @@ -1,422 +0,0 @@ -;;; +emacs.el --- measured defaults for Emacs -*- lexical-binding: t -*- - -;;; Commentary: - -;; I find myself copy-pasting a lot of "boilerplate" type code when -;; bankrupting my Emacs config and starting afresh. Instead of doing -;; that, I'm putting it here, where it'll be easier to include in my -;; config. - -;; Of course, some might say I could just ... stop bankrupting my -;; Emacs. But like, why would I want to? - -;; Other notable packages include -;; - https://git.sr.ht/~technomancy/better-defaults/ -;; - https://github.com/susam/emfy - -;;; Code: - -(require 'early-init (locate-user-emacs-file "early-init.el")) - -(defun +set-major-mode-from-buffer-name (&optional buf) - "Set the major mode for BUF from the buffer's name. -Do this only if the buffer is not visiting a file." - (unless buffer-file-name - (let ((buffer-file-name (buffer-name buf))) - (set-auto-mode)))) - - -;;; General settings - -(setq-default - apropos-do-all t - async-shell-command-buffer 'new-buffer - async-shell-command-display-buffer nil - auto-hscroll-mode 'current-line - auto-revert-verbose t - auto-save-default nil - auto-save-file-name-transforms `((".*" ,(.etc "auto-save/") ,(car (secure-hash-algorithms))) - (".*" ,(.etc "auto-save/") t)) - auto-save-interval 30 - auto-save-list-file-prefix (.etc "auto-save/.saves-" t) - auto-save-timeout 30 - auto-save-visited-interval 5 - auto-window-vscroll nil - backup-by-copying t - backup-directory-alist `((".*" . ,(.etc "backup/" t))) - blink-cursor-blinks 1 - comp-deferred-compilation nil - completion-category-defaults nil - completion-category-overrides '((file (styles . (partial-completion)))) - completion-ignore-case t - completion-styles '(substring partial-completion) - create-lockfiles nil - cursor-in-non-selected-windows 'hollow - cursor-type 'bar - custom-file (.etc "custom.el") - delete-old-versions t - echo-keystrokces 0.1 - ediff-window-setup-function 'ediff-setup-windows-plain - eldoc-echo-area-use-multiline-p nil - eldoc-idle-delay 0.1 - enable-recursive-minibuffers t - executable-prefix-env t - fast-but-imprecise-scrolling t - file-name-shadow-properties '(invisible t intangible t) - fill-column 80 - find-file-visit-truename t - frame-resize-pixelwise t - global-auto-revert-non-file-buffers t - global-mark-ring-max 100 - hscroll-margin 1 - hscroll-step 1 - imenu-auto-rescan t - image-use-external-converter (or (executable-find "convert") - (executable-find "gm") - (executable-find "ffmpeg")) - indent-tabs-mode nil - inhibit-startup-screen t - initial-buffer-choice t - kept-new-versions 6 - kept-old-versions 2 - kill-do-not-save-duplicates t - kill-read-only-ok t - kill-ring-max 500 - kmacro-ring-max 20 - load-prefer-newer noninteractive - major-mode '+set-major-mode-from-buffer-name - mark-ring-max 50 - minibuffer-eldef-shorten-default t - minibuffer-prompt-properties (list 'read-only t - 'cursor-intangible t - 'face 'minibuffer-prompt) - mode-require-final-newline 'visit-save - mouse-drag-copy-region t - mouse-wheel-progressive-speed nil - mouse-yank-at-point t - native-comp-async-report-warnings-errors 'silent - native-comp-deferred-compilation nil - read-answer-short t - read-buffer-completion-ignore-case t - ;; read-extended-command-predicate - ;; (when (fboundp - ;; 'command-completion-default-include-p) - ;; 'command-completion-default-include-p) - read-process-output-max 1048576 ; We’re in the future man. Set that to at least a megabyte - recenter-positions '(top 2 middle bottom) - regexp-search-ring-max 100 - regexp-search-ring-max 200 - save-interprogram-paste-before-kill t - save-some-buffers-default-predicate #'+save-some-buffers-p - scroll-conservatively 25 - scroll-margin 0 - scroll-preserve-screen-position 1 - scroll-step 1 - search-ring-max 200 - search-ring-max 200 - sentence-end-double-space t - set-mark-command-repeat-pop t - show-paren-delay 0 - show-paren-style 'parenthesis - show-paren-when-point-in-periphery t - show-paren-when-point-inside-paren t - ;;show-trailing-whitespace t - tab-bar-show 1 - tab-width 8 ; so alignment expecting the default looks right - tramp-backup-directory-alist backup-directory-alist - undo-limit 100000000 ; 10 MB - use-dialog-box nil - use-file-dialog nil - use-short-answers t - vc-follow-symlinks t - vc-make-backup-files t - version-control t - view-read-only t - visible-bell nil - window-resize-pixelwise t - x-select-enable-clipboard t - x-select-enable-primary t - yank-pop-change-selection t - ) - -;; Programming language offsets. -;; Set these after the initial block so I can use `tab-width' -(setq-default - c-basic-offset tab-width) - -;; Emacs 28 ships with an option, `use-short-answers', that makes this form -;; obsolete, but I still use 27 at work. -(when (version< emacs-version "28") - (fset 'yes-or-no-p 'y-or-n-p)) - - -;;; Encodings - -;; Allegedly, this is the only one you need... -(set-language-environment "UTF-8") -;; But I still set all of these, for fun. -(setq-default locale-coding-system 'utf-8-unix - coding-system-for-read 'utf-8-unix - coding-system-for-write 'utf-8-unix - buffer-file-coding-system 'utf-8-unix - default-process-coding-system '(utf-8-unix . utf-8-unix) - x-select-request-type '(UTF8_STRING - COMPOUND_TEXT - TEXT - STRING)) - -(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))) - - -;;; Modes - -(dolist (enable-mode '(global-auto-revert-mode - blink-cursor-mode - electric-pair-mode - show-paren-mode - global-so-long-mode - minibuffer-depth-indicate-mode - file-name-shadow-mode - minibuffer-electric-default-mode - delete-selection-mode - auto-save-visited-mode - ;; column-number-mode - )) - (when (fboundp enable-mode) - (funcall enable-mode +1))) - -(dolist (disable-mode '(tooltip-mode - tool-bar-mode - menu-bar-mode - scroll-bar-mode - horizontal-scroll-bar-mode)) - (when (fboundp disable-mode) - (funcall disable-mode -1))) - - -;;; Hooks - -(defun +auto-create-missing-dirs () - "Automatically create missing directories when finding a file." - ;; https://emacsredux.com/blog/2022/06/12/auto-create-missing-directories/ - (let ((target-dir (file-name-directory buffer-file-name))) - (unless (file-exists-p target-dir) - (make-directory target-dir t)))) - -(defvar +save-some-buffers-debounce-time nil - "Last time `+save-some-buffers-debounce' was run.") - -(defcustom +save-some-buffers-debounce-timeout 5 - "Number of seconds to wait before saving buffers again.") - -(defun +save-some-buffers-debounce (&rest _) - "Run `save-some-buffers', but only if it's been a while." - (unless (and +save-some-buffers-debounce-time - (< (- (time-convert nil 'integer) +save-some-buffers-debounce-time) - +save-some-buffers-debounce-timeout)) - (save-some-buffers t) - (setf +save-some-buffers-debounce-time (time-convert nil 'integer)))) - - -;;; Better-default functions ... - -(defun +cycle-spacing (&optional n preserve-nl-back mode) - "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. See docstring of `cycle-spacing' for the meaning of -PRESERVE-NL-BACK and MODE." - (interactive "*p") - (cycle-spacing (- n))) - -(defun +save-buffers-quit (&optional arg) - "Silently save each buffer, then kill the current connection. -If the current frame has no client, kill Emacs itself using -`save-buffers-kill-emacs' after confirming with the user. - -With prefix ARG, silently save all file-visiting buffers, then -kill without asking." - (interactive "P") - (save-some-buffers t) - (if (and (not (frame-parameter nil 'client)) - (and (not arg))) - (when (yes-or-no-p "Sure you want to quit? ") - (save-buffers-kill-emacs)) - (delete-frame nil :force))) - -(defun +kill-word-backward-or-region (&optional arg backward-kill-word-fn) - "Kill active region or ARG words backward. -BACKWARD-KILL-WORD-FN is the function to call to kill a word -backward. It defaults to `backward-kill-word'." - (interactive "P") - (call-interactively (if (region-active-p) - #'kill-region - (or backward-kill-word-fn #'backward-kill-word)))) - -(defun +backward-kill-word-wrapper (fn &optional arg) - "Kill backward using FN until the beginning of a word, smartly. -If point is on at the beginning of a line, kill the previous new -line. If the only thing before point on the current line is -whitespace, kill that whitespace. - -With argument ARG: if ARG is a number, just call FN -ARG times. Otherwise, just call FN." - ;; I want this to be a wrapper so that I can call other word-killing functions - ;; with it. It's *NOT* advice because those functions probably use - ;; `backward-kill-word' under the hood (looking at you, paredit), so advice - ;; will make things weird. - (if (null arg) - (cond - ((looking-back "^" 1) - (let ((delete-active-region nil)) - (delete-backward-char 1))) - ((looking-back "^[ ]*") - (delete-horizontal-space :backward-only)) - (t (call-interactively fn))) - (funcall fn (if (listp arg) 1 arg)))) - -(defun +backward-kill-word (&optional arg) - "Kill word backward using `backward-kill-word'. -ARG is passed to `backward-kill-word'." - (interactive "P") - (+backward-kill-word-wrapper #'backward-kill-word arg)) - -;;; ... and advice - -;; Indent the region after a yank. -(defun +yank@indent (&rest _) - "Indent the current region." - (indent-region (min (point) (mark)) (max (point) (mark)))) -;; (advice-add #'yank :after #'+yank@indent) -;; (advice-add #'yank-pop :after #'+yank@indent) - -;; https://old.reddit.com/r/emacs/comments/y92y4b/tramp_users_slowness_got_you_down_check/it3a35r/ -(defun +vc-off-when-remote () - (when (file-remote-p (buffer-file-name)) - (setq-local vc-handled-backends nil))) - - -;;; Extra functions - -(defun +save-some-buffers-p () - "Predicate for `save-some-buffers-default-predicate'. -It returns nil with remote files and those without attached files." - (and (buffer-file-name) - (not (file-remote-p (buffer-file-name))))) - -;; https://www.wwwtech.de/articles/2013/may/emacs:-jump-to-matching-paren-beginning-of-block -(defun +goto-matching-paren (&optional arg) - "Go to the matching paren, similar to vi's %." - (interactive "p") - (or arg (setf arg 1)) - (cond - ;; Check for "outside of bracket" positions - ((looking-at "[\[\(\{]") (forward-sexp arg)) - ((looking-back "[\]\)\}]" 1) (backward-sexp arg)) - ;; Otherwise, move from inside the bracket - ((looking-at "[\]\)\}]") (forward-char) (backward-sexp arg)) - ((looking-back "[\[\(\{]" 1) (backward-char) (forward-sexp arg)) - (t (up-list arg t t)))) - -(defun +delete-window-or-bury-buffer () - "Delete the current window, or bury the current buffer. -If the current window is the only window, bury the buffer." - (interactive) - (condition-case e - (delete-window) - (t (bury-buffer)))) - - -;;; Required libraries - -(when (require 'abbrev nil :noerror) - (setq-default abbrev-file-name (sync/ "abbrev.el") - save-abbrevs 'silent)) - -(when (require 'autorevert nil :noerror) - (setq-default global-auto-revert-non-file-buffers t - auto-revert-verbose nil) - (global-auto-revert-mode +1)) - -(when (require 'uniquify nil :noerror) - (setq-default uniquify-buffer-name-style 'forward - uniquify-separator path-separator - uniquify-after-kill-buffer-p t - uniquify-ignore-buffers-re "^\\*")) - -(when (require 'goto-addr) - (if (fboundp 'global-goto-address-mode) - (global-goto-address-mode +1) - (add-hook 'after-change-major-mode-hook 'goto-address-mode))) - -(when (require 'recentf nil :noerror) - (setq-default recentf-save-file (.etc "recentf.el") - recentf-max-menu-items 100 - recentf-max-saved-items nil - recentf-auto-cleanup 'mode) - (add-to-list 'recentf-exclude .etc) - (recentf-mode +1)) - -(when (require 'savehist nil :noerror) - (setq-default history-length t - history-delete-duplicates t - history-autosave-interval 60 - savehist-file (.etc "savehist.el") - ;; Other variables --- don't truncate any of these. - ;; `add-to-history' uses the values of these variables unless - ;; they're nil, in which case it falls back to `history-length'. - kill-ring-max 100 - mark-ring-max 100 - global-mark-ring-max 100 - regexp-search-ring-max 100 - search-ring-max 100 - kmacro-ring-max 100 - eww-history-limit 100) - (dolist (var '(extended-command-history - global-mark-ring - mark-ring - kill-ring - kmacro-ring - regexp-search-ring - search-ring)) - (add-to-list 'savehist-additional-variables var)) - (savehist-mode +1)) - -(when (require 'saveplace nil :noerror) - (setq-default save-place-file (.etc "places.el") - save-place-forget-unreadable-files (eq system-type 'gnu/linux)) - (save-place-mode +1)) - -;; (when (require 'tramp) -;; ;; thanks Irreal! https://irreal.org/blog/?p=895 -;; (add-to-list 'tramp-default-proxies-alist -;; '(nil "\\`root\\'" "/ssh:%h:")) -;; (add-to-list 'tramp-default-proxies-alist -;; '((regexp-quote (system-name)) nil nil))) - - -;;; Newer features -;; These aren't in older version of Emacs, but they're so nice. - -(when (fboundp 'repeat-mode) - (setq-default repeat-exit-key "g" - repeat-exit-timeout 5) - (repeat-mode +1)) - -(when (fboundp 'pixel-scroll-precision-mode) - (pixel-scroll-precision-mode +1)) - -(provide '+emacs) -;;; +emacs.el ends here diff --git a/lisp/+emms.el b/lisp/+emms.el new file mode 100644 index 0000000..a43daea --- /dev/null +++ b/lisp/+emms.el @@ -0,0 +1,38 @@ +;;; +emms.el -*- lexical-binding: t; -*- + +(defun +emms-streams (&optional file) + "Better interface for `emms-streams'. +If FILE is non-nil, use it. Otherwise use `emms-streams-file'. +If `emms-streams-file' is nil or this function is called with +\\[universal-argument], prompt the user." + (interactive + (list (cond + ((or emms-streams-file + (not current-prefix-arg)) + emms-streams-file) + (:else (read-file-name "Stream file: " + emms-source-file-default-directory))))) + (when (and (not (file-exists-p emms-streams-file)) + (y-or-n-p "Emms' bulit-in streams file hasn't been installed yet. Install it now?")) + (emms-streams-install)) + (let ((buf (get-buffer emms-streams-buffer-name))) + (when (not buf) + (with-current-buffer (get-buffer-create emms-streams-buffer-name) + (setq buf (current-buffer)) + (emms-playlist-mode) + (setq emms-playlist-buffer-p t) + (emms-playlist-set-playlist-buffer (current-buffer)) + (with-current-buffer (find-file-noselect emms-streams-file) + (cond + ((emms-source-playlist-native-p) + (emms-add-native-playlist emms-streams-file)) + ((emms-source-playlist-m3u-p) + (emms-add-m3u-playlist emms-streams-file)) + ((emms-source-playlist-pls-p) + (emms-add-pls-playlist emms-streams-file)) + (:else (error "Streams file `%s' isn't in a known format." + emms-streams-file)))))) + (switch-to-buffer buf))) + +(provide '+emms) +;;; +emms.el ends here diff --git a/lisp/+hungry-delete.el b/lisp/+hungry-delete.el new file mode 100644 index 0000000..601aecf --- /dev/null +++ b/lisp/+hungry-delete.el @@ -0,0 +1,53 @@ +;;; +hungry-delete.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2022 Case Duckworth + +;;; Code: + +(require 'hungry-delete) + +(defmacro +hungry-delete-define-alternative (func hd-func &optional direction) + "Define a `hungry-delete' alternative for FUNC. +If the adjacent characters in DIRECTION are one of +`hungry-delete-chars-to-skip', call HD-FUNC. Otherwise, call +FUNC. + +If DIRECTION is a positive integer or `forward', look forward. +If it's negative or `backward', look backward. If it's absent, +this macro will try to guess based on the names of FUNC and +HD-FUNC. + +This macro creates a function taking a prefix argument that's +passed to both of FUNC and HD-FUNC." + (let ((name (intern (format "%s|%s" func hd-func))) + (lookfn (cond + ((or (and (string-match-p "forward" (symbol-name func)) + (string-match-p "forward" (symbol-name hd-func)) + (not direction)) + (and (integerp direction) + (< 0 direction)) + (eq direction 'forward)) + 'looking-at) + ((or (and (string-match-p "backward" (symbol-name func)) + (string-match-p "backward" (symbol-name hd-func)) + (not direction)) + (and (integerp direction) + (> 0 direction)) + (eq direction 'backward)) + 'looking-back) + (:else (error "Bad direction: %S" direction)))) + (arg (gensym))) + `(defun ,name (,arg) + ,(concat (format "Do `%s' or `%s', depending on whitespace.\n" + func hd-func) + (format "Pass prefix argument %s to the underlying functions.\n" + (upcase (symbol-name arg))) + "This function was defined by `define-hungry-delete-alternative'.") + (interactive "*p") ; This is brittle + (if (,lookfn (format "[%s]" hungry-delete-chars-to-skip)) + (,hd-func (or ,arg 1)) + (,func ,arg))))) + +(provide '+hungry-delete) +;;; +hungry-delete.el ends here + diff --git a/lisp/+isearch.el b/lisp/+isearch.el new file mode 100644 index 0000000..3516ec4 --- /dev/null +++ b/lisp/+isearch.el @@ -0,0 +1,24 @@ +;;; +isearch.el --- iseach (and query-replace) extensions -*- lexical-binding: t; -*- + +;;; From https://github.com/astoff/isearch-mb/wiki + +(defun +isearch-cancel@add-search-to-history () + "Add search string to history also when canceling. +This should be used as `:before' advice on `isearch-cancel'." + (unless (string-equal "" isearch-string) + (isearch-update-ring isearch-string isearch-regexp))) + +(defun +perform-replace-dont-exit-on-anykey (orig &rest args) + "Don't exit replace for anykey that's not in `query-replace-map'. +This should be used as `:around' advice for `perform-replace'." + (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 orig args)))) + +(provide '+isearch) +;;; +isearch.el ends here diff --git a/lisp/+notmuch.el b/lisp/+notmuch.el index 74b9b77..5df6e5b 100644 --- a/lisp/+notmuch.el +++ b/lisp/+notmuch.el @@ -60,11 +60,11 @@ for search." 'notmuch-address-history))) (:else (defun notmuch-address-selection-function (prompt collection initial-input) - "Call (`completing-read' + "Call (`completing-read' PROMPT COLLECTION nil nil INITIAL-INPUT 'notmuch-address-history)" - (completing-read - prompt collection nil nil nil - 'notmuch-address-history))))) + (completing-read + prompt collection nil nil nil + 'notmuch-address-history))))) (defcustom +notmuch-spam-tags '("+spam" "+Spam") "A list of tag changes to apply when marking a thread as spam." @@ -101,5 +101,49 @@ This function advances the next thread when finished." (when (eq beg end) (notmuch-search-next-thread))) +(defun +notmuch-tree-beginning (&optional arg) + "Move point to beginning of message or tree, depending on ARG." + (interactive "P") + (cond + ((and (window-live-p notmuch-tree-message-window) + (not arg)) + (with-selected-window notmuch-tree-message-window + (beginning-of-buffer))) + (:else (beginning-of-buffer)))) + +(defun +notmuch-tree-end (&optional arg) + "Move point to end of message or tree, depending on ARG." + (interactive "P") + (cond + ((and (window-live-p notmuch-tree-message-window) + (not arg)) + (with-selected-window notmuch-tree-message-window + (end-of-buffer))) + (:else (end-of-buffer)))) + +(defun +notmuch-make-saved-search (name key search-type &rest queries) + "Wrapper to ease `notmuch-saved-searches' defining. +NAME, KEY, and SEARCH-TYPE are paired with the corresponding keywords in +`notmuch-saved-searches', which see. QUERIES are all concatenated together with +AND. If QUERIES is prepended with more keyword arguments, those are added to +the saved search as well." + (declare (indent 3)) + (let (extra-keywords) + (while (keywordp (car queries)) + (push (cadr queries) extra-keywords) + (push (car queries) extra-keywords) + (setf queries (cddr queries))) + (add-to-list 'notmuch-saved-searches + (append + (list :name name + :key key + :search-type search-type + :query (apply #'+notmuch-query-concat queries)) + (reverse extra-keywords)) + :append + (lambda (a b) + (equal (plist-get a :name) + (plist-get b :name)))))) + (provide '+notmuch) ;;; +notmuch.el ends here diff --git a/lisp/+org-capture.el b/lisp/+org-capture.el index 06dfcfd..2f7bf6a 100644 --- a/lisp/+org-capture.el +++ b/lisp/+org-capture.el @@ -1,164 +1,49 @@ -;;; +org-capture.el -*- lexical-binding: t; -*- +;;; +org-capture.el -*- lexical-binding: t; -*- ;;; Code: (require 'cl-lib) -(require 'acdw) -;; We don't require `org-capture' here because I'll have to require this library -;; to init.el /before/ org-capture is fully needed. But I do need to declare -;; `org-capture-templates'. +;; Don't /require/ `org-capture', since that'll pull in all of `org' and that'll +;; take a minute. Just let the compiler know that this variable exists. (defvar org-capture-templates nil) -(defun +org-capture--get (key &optional list) - "Find KEY in LIST, or return nil. -LIST defaults to `org-capture-templates'." - (alist-get key (or list org-capture-templates) nil nil #'equal)) - -;; Set it up as a generic value. Based on the one for `alist-get'. -(gv-define-expander +org-capture--get - (lambda (do key &optional alist) - (setf alist (or alist org-capture-templates)) - (macroexp-let2 macroexp-copyable-p k key - (gv-letplace (getter setter) alist - (macroexp-let2 nil p `(assoc ,k ,getter 'equal) - (funcall do `(cdr ,p) - (lambda (v) - (macroexp-let2 nil v v - (let ((set-exp - `(if ,p (setcdr ,p ,v) - ,(funcall setter - `(cons (setf ,p (cons ,k ,v)) - ,getter))))) - `(progn - ,set-exp - ,v)))))))))) - -(defun +org-capture-sort (&optional list) - "Sort LIST by string keys. -LIST is a symbol and defaults to `org-capture-templates'." - (setf list (or list 'org-capture-templates)) - (set list (sort (symbol-value list) (lambda (a b) - (string< (car a) (car b)))))) - -(defun +org-capture-sort-after-init (&optional list) - "Sort LIST with `+org-capture-sort' after Emacs init." - (+ensure-after-init #'+org-capture-sort)) - -;;;###autoload -(defun +org-capture-templates-setf (key value &optional list sort-after) - "Add KEY to LIST, using `setf'. -LIST is a symbol and defaults to `org-capture-templates' -- so -this function sets values on a list that's structured as such. - -Thus, KEY is a string key. If it's longer than one character, -this function will search LIST for each successive run of -characters before the final, ensuring sub-lists exist of the -form (CHARS DESCRIPTION). - -For example, if KEY is \"abc\", first a LIST item of the form (a -DESCRIPTION), if non-existant, will be added to the list (with a -default description), then an item of the -form (\"ab\" DESCRIPTION), before adding (KEY VALUE) to the LIST. - -VALUE is the template or group header required for -`org-capture-templates', which see. - -SORT-AFTER, when set to t, will call -`+org-capture-templates-sort' after setting, to ensure org can -properly process the variable." - ;; LIST defaults to `org-capture-templates' - (declare (indent 2)) - (unless list (setf list 'org-capture-templates)) - ;; Ensure VALUE is a list to cons properly - (unless (listp value) (setf value (list value))) - (when (> (length key) 1) - ;; Check for existence of groups. - (let ((expected (cl-loop for i from 1 to (1- (length key)) - collect (substring key 0 i) into keys - finally return keys))) - (cl-loop for ek in expected - if (not (+org-capture--get ek (symbol-value list))) do - (setf (+org-capture--get ek (symbol-value list)) - (list (format "(Group %s)" ek)))))) - (prog1 ;; Set KEY to VALUE - (setf (+org-capture--get key (symbol-value list)) value) - ;; Sort after, maybe - (when sort-after (+org-capture-sort list)))) - -(defun +org-template--ensure-path (keys &optional list) - "Ensure path of keys exists in `org-capture-templates'." - (unless list (setf list 'org-capture-templates)) - (when (> (length key) 1) - ;; Check for existence of groups. - (let ((expected (cl-loop for i from 1 to (1- (length key)) - collect (substring key 0 i) into keys - finally return keys))) - (cl-loop for ek in expected - if (not (+org-capture--get ek (symbol-value list))) do - (setf (+org-capture--get ek (symbol-value list)) - (list (format "(Group %s)" ek))))))) - -(defcustom +org-capture-default-type 'entry - "Default template for `org-capture-templates'." - :type '(choice (const :tag "Entry" entry) - (const :tag "Item" item) - (const :tag "Check Item" checkitem) - (const :tag "Table Line" table-line) - (const :tag "Plain Text" plain))) - -(defcustom +org-capture-default-target "" - "Default target for `org-capture-templates'." - ;; TODO: type - ) - -(defcustom +org-capture-default-template nil - "Default template for `org-capture-templates'." - ;; TODO: type - ) - -(defun +org-define-capture-templates-group (keys description) - "Add a group title to `org-capture-templates'." - (setf (+org-capture--get keys org-capture-templates) - (list description))) - -;; [[https://github.com/cadadr/configuration/blob/39813a771286e542af3aa333172858532c3bb257/emacs.d/gk/gk-org.el#L1573][from cadadr]] -(defun +org-define-capture-template (keys description &rest args) - "Define a capture template and necessary antecedents. -ARGS is a plist, which in addition to the additional options -`org-capture-templates' accepts, takes the following and places -them accordingly: :type, :target, and :template. Each of these -corresponds to the same field in `org-capture-templates's -docstring, which see. Likewise with KEYS and DESCRIPTION, which -are passed separately to the function. - -This function will also create all the necessary intermediate -capture keys needed for `org-capture'; that is, if KEYS is -\"wcp\", entries for \"w\" and \"wc\" will both be ensured in -`org-capture-templates'." - (declare (indent 2)) - ;; Check for existence of parent groups - (when (> (length keys) 1) - (let ((expected (cl-loop for i from 1 to (1- (length keys)) - collect (substring 0 i) into keys - finally return keys))) - (cl-loop - for ek in expected - if (not (+org-capture--get ek org-capture-templates)) - do (+org-define-capture-templates-group ek (format "(Group %s)" ek))))) - (if (null args) - ;; Add the title - (+org-define-capture-templates-group keys description) - ;; Add the capture template. - (setf (+org-capture--get keys org-capture-templates) - (append (list (or (plist-get args :type) - +org-capture-default-type) - (or ( plist-get args :target) - +org-capture-default-target) - (or (plist-get args :template) - +org-capture-default-template)) - (cl-loop for (key val) on args by #'cddr - unless (member key '(:type :target :template)) - append (list key val)))))) +;; https://github.com/cadadr/configuration/blob/39813a771286e542af3aa333172858532c3bb257/emacs.d/gk/gk-org.el#L1573 +(defun +org-capture-template-define (description &rest args) + "Define a capture template. +Creates a list and adds it to `org-capture-templates', if it's +not already there. ARGS is a plist, which in addition to the +additional options `org-capture-templates' accepts (which see), +takes the following and puts them in the right spot: `: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)) + (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))))))) + ;; The only way I know how to do this properly (add a value to the end of + ;; the list, if it exists; otherwise update it) is to do this weird if-setf + ;; dance. + (if (seq-find (lambda (el) (equal (car el) keys)) + org-capture-templates) + (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))))) + ;; Regardless of what we do, return the new value of + ;; `org-capture-templates'. + org-capture-templates)) (provide '+org-capture) -;;; +org-capture.el ends here +;;; +org-capture.el diff --git a/lisp/+org.el b/lisp/+org.el index 7698ec9..a148bd8 100644 --- a/lisp/+org.el +++ b/lisp/+org.el @@ -1,7 +1,13 @@ -;;; +org.el --- -*- lexical-binding: t -*- +;;; +org.el -*- lexical-binding: t; -*- -;;; Org Return DWIM -;; [[https://github.com/alphapapa/unpackaged.el][unpackaged]] and [[http://kitchingroup.cheme.cmu.edu/blog/2017/04/09/A-better-return-in-org-mode/][kitchin]] +;;; Code: + +(require 'cl-lib) +(require 'seq) + +;;; 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-element-descendant-of (type element) "Return non-nil if ELEMENT is a descendant of TYPE. @@ -94,53 +100,13 @@ With PREFIX, call `org-return'." (t ; Otherwise---just call `org-return'. (org-return)))) -(defun +org-table-copy-down|+org-return (&optional n) +(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))) -;;; Copy org trees as HTML - -;; Thanks to Oleh Krehel, via [[https://emacs.stackexchange.com/questions/54292/copy-results-of-org-export-directly-to-clipboard][this StackExchange question]]. -(defun +org-export-clip-to-html - (&optional async subtreep visible-only body-only ext-plist post-process) - "Export region to HTML, and copy it to the clipboard. -Arguments ASYNC, SUBTREEP, VISIBLE-ONLY, BODY-ONLY, EXT-PLIST, -and POST-PROCESS are passed to `org-export-to-file'." - (interactive) ; XXX: hould this be interactive? - (message "Exporting Org to HTML...") - (let ((org-tmp-file "/tmp/org.html")) - (org-export-to-file 'html org-tmp-file - async subtreep visible-only body-only ext-plist post-process) - (start-process "xclip" "*xclip*" - "xclip" "-verbose" - "-i" org-tmp-file - "-t" "text/html" - "-selection" "clipboard")) - (message "Exporting Org to HTML...done.")) - -;; Specialized functions -(defun +org-export-clip-subtree-to-html () - "Export current subtree to HTML." - (interactive) - (+org-export-clip-to-html nil :subtree)) - -;;; Unsmartify quotes and dashes and stuff. - -(defun +org-unsmartify () - "Replace \"smart\" punctuation with their \"dumb\" counterparts." - (interactive) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "[“”‘’–—]" nil t) - (let ((replace (pcase (match-string 0) - ((or "“" "”") "\"") - ((or "‘" "’") "'") - ("–" "--") - ("—" "---")))) - (replace-match replace nil nil))))) ;;; A ... different ... `org-open-at-point-dwim' ;; I honestly don't remember what the difference is between this and the @@ -177,20 +143,7 @@ and POST-PROCESS are passed to `org-export-to-file'." (org-up-heading-all 1)) (org-open-at-point arg))))) -;;; Skip invisible shit when moving around -(defun +org-ignore-invisible (fn &rest r) - ":around ADVICE to ignore invisible text in `org-mode' buffers." - ;; TODO: generalize to all modes - (cond ((and (derived-mode-p #'org-mode) - (org-invisible-p)) - (while (org-invisible-p) - (forward-char)) - (apply fn r)) - (t (apply fn r)))) - ;;; Faces - -;;; Better org faces ;; see `org-emphasis-alist' (defface org-bold '((t (:weight bold))) @@ -205,63 +158,152 @@ and POST-PROCESS are passed to `org-export-to-file'." (defface org-strikethrough '((t (:strike-through t))) "Strike-through face for `org-mode' documents.") -;; `org-verbatim' and `org-code' are apparently already things, so we skip them -;; here. - -;;; Inhibit hooks on `org-agenda' -;; It's really annoying when I call `org-agenda' and five hundred Ispell -;; processes are created because I have `flyspell-mode' in the hook. This mode -;; inhibits those hooks when entering the agenda, but runs them when opening the -;; actual buffer. - -(defun +org-agenda-inhibit-hooks (fn &rest r) - "Advice to inhibit hooks when entering `org-agenda'." - (let ((org-mode-hook nil)) - (apply fn r))) - -(defvar-local +org-hook-has-run-p nil - "Whether `org-mode-hook' has run in the current buffer.") - -(defun +org-agenda-switch-run-hooks (&rest _) - "Advice to run `org-mode-hook' when entering org-mode. -This should only fire when switching to a buffer from `org-agenda'." - (unless +org-hook-has-run-p - (run-hooks 'org-mode-hook) - (setq +org-hook-has-run-p t))) - -(define-minor-mode +org-agenda-inhibit-hooks-mode - "Inhibit `org-mode-hook' when opening `org-agenda'." - :lighter " A/h" - :global t - (cond (+org-agenda-inhibit-hooks-mode - (advice-add 'org-agenda :around #'+org-agenda-inhibit-hooks) - (advice-add 'org-agenda-switch-to :after #'+org-agenda-switch-run-hooks)) - (:else - (advice-remove 'org-agenda #'+org-agenda-inhibit-hooks) - (advice-remove 'org-agenda-switch-to #'+org-agenda-switch-run-hooks)))) - -;;; Drawers +;;; Unsmartify + +(defun +org-unsmartify () + "Replace \"smart\" punctuation with their \"dumb\" counterparts." + (interactive) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "[“”‘’–—]" nil t) + (let ((replace (pcase (match-string 0) + ((or "“" "”") "\"") + ((or "‘" "’") "'") + ("–" "--") + ("—" "---")))) + (replace-match replace nil nil))))) + +;;; Copy org trees as HTML +;; Thanks to Oleh Krehel: +;; https://emacs.stackexchange.com/questions/54292/copy-results-of-org-export-directly-to-clipboard + +(defun +org-export-clip-to-html + (&optional async subtreep visible-only body-only ext-plist post-process) + "Export region to HTML, and copy it to the clipboard. +Arguments ASYNC, SUBTREEP, VISIBLE-ONLY, BODY-ONLY, EXT-PLIST, +and POST-PROCESS are passed to `org-export-to-file'." + (interactive) ; XXX: hould this be interactive? + (message "Exporting Org to HTML...") + (let ((org-tmp-file "/tmp/org.html")) + (org-export-to-file 'html org-tmp-file + async subtreep visible-only body-only ext-plist post-process) + ;; XXX: figure out which clipboard to use, or use something in Emacs + (start-process "xclip" "*xclip*" + "xclip" "-verbose" + "-i" org-tmp-file + "-t" "text/html" + "-selection" "clipboard")) + (message "Exporting Org to HTML...done.")) + +;; Specialized functions +(defun +org-export-clip-subtree-to-html () + "Export current subtree to HTML." + (interactive) + (+org-export-clip-to-html nil :subtree)) + +;;; Hide drawers on save, except the currently-expanded one + (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)))))))) + "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)))))))) + +;;; Define `ol' link types + +(defmacro +org-link-define-type (type args &rest body) + "Define an org link TYPE. +A function named `+org-link-TYPE-open' will be created, with ARGS +as its arguments and BODY as its body. BODY can be blank, in +which case the user will be messaged (This is a good do-nothing +effect for exporting link types)." + (declare (indent 2) + (doc-string 3) + (debug (sexp sexp def-body))) + (let ((fn (intern (format "+org-link-%s-open" type))) + (body (or body `((message ,(format "%S: %%S" type) + ,(car args))))) + (type-string (format "%S" type))) + `(prog1 + (defun ,fn ,args ,@body) + (org-link-set-parameters ,type-string :follow #',fn)))) + +;;; Skip some files in `org-agenda' + +(defcustom org-agenda-file-skip-regexp nil + "Files matching this regexp are removed from `org-agenda-files'." + :group 'org-agenda) + +(defun org-agenda-files@skip-regexp (files) + "`:filter-return' advice to filter files in `org-agenda-file-skip-regexp'." + (when org-agenda-file-skip-regexp + (setq files + (seq-remove (lambda (file) + (string-match-p + org-agenda-file-skip-regexp file)) + files))) + files) + +;;; Prompt for stuff + +(defun +org-prompt-for-property (property &optional clipboardp insert list) + "Prompt for PROPERTY and return a properly-formatted string. +Pre-fill the input with clipboard contents if they match CLIPBOARDP. If +CLIPBOARDP is nil or missing, don't pre-fill. + +If INSERT is non-nil, insert the property into the property +drawer of the current org tree. + +If LIST is non-nil, return the result as a list instead of a string." + (let* ((kill (current-kill 0)) + (value (read-string (concat property ": ") + (when (and clipboardp + (or (eq clipboardp t) + (funcall clipboardp kill))) + kill)))) + (when insert + (org-set-property property value)) + (if list + (list property value) + (format ":%s: %s" property value)))) +(defun +org-prompt-tags (&optional prompt global) + (let* ((buffer (org-capture-get :buffer)) + (file (buffer-file-name (or (buffer-base-buffer buffer) buffer))) + (org-last-tags-completion-table + (org-global-tags-completion-table + (if global (org-agenda-files) (list file)))) + (org-add-colon-after-tag-completion t) + (ins (mapconcat + #'identity + (let ((crm-separator "[ \t]*:[ \t]*")) + (completing-read-multiple + (or prompt "Tags: ") + org-last-tags-completion-table nil nil nil + 'org-tags-history)) + ":"))) + (when (org-string-nw-p ins) + (prog1 (concat + (unless (eq (char-before) ?:) ":") + ins + (unless (eq (char-after) ?:) ":")) + (when (org-at-heading-p) (org-align-tags)))))) (provide '+org) +;;; +org.el ends here diff --git a/lisp/+ox.el b/lisp/+ox.el deleted file mode 100644 index 8748a55..0000000 --- a/lisp/+ox.el +++ /dev/null @@ -1,29 +0,0 @@ -;;; +ox.el --- org-export helpers -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -(require 'ox) - -;;; Run hooks before doing any exporting at all - -(defcustom +org-export-pre-hook nil - "Functions to run /before/ `org-export-as' does anything. -These will run on the buffer about to be exported, NOT a copy." - :type 'hook) - -(defun +org-export-pre-run-hooks (&rest _) - "Run hooks in `+org-export-pre-hook'." - (run-hooks '+org-export-pre-hook)) - -(defun +org-export-pre-hooks-insinuate () - "Advise `org-export-as' to run `+org-export-pre-hook'." - (advice-add 'org-export-as :before #'+org-export-pre-run-hooks)) - -(defun +org-export-pre-hooks-remove () - "Remove pre-hook advice on `org-export-as'." - (advice-remove 'org-export-as #'+org-export-pre-run-hooks)) - -(provide '+ox) -;;; +ox.el ends here diff --git a/lisp/+paredit.el b/lisp/+paredit.el new file mode 100644 index 0000000..ab176b8 --- /dev/null +++ b/lisp/+paredit.el @@ -0,0 +1,26 @@ +;;; +paredit.el -*- lexical-binding: t -*- + +;;; Fixing unquote-splicing behaviour with Paredit +;; https://www.n16f.net/blog/fixing-unquote-splicing-behaviour-with-paredit/ + +(require 'paredit) +(require 'seq) + +(defcustom +paredit-no-space-prefixes '(",@") + "Prefix strings to not insert a space after in `paredit'." + :group 'paredit + :type '(repeat string)) + +(defun +paredit-space-for-delimiter (endp delimiter) + (let ((point (point))) + (or endp + (seq-every-p + (lambda (prefix) + (and (> point (length prefix)) + (let ((start (- point (length prefix))) + (end point)) + (not (string= (buffer-substring start end) prefix))))) + +paredit-no-space-prefixes)))) + +(provide '+paredit) +;;; +paredit.el ends here diff --git a/lisp/+tempo.el b/lisp/+tempo.el deleted file mode 100644 index 2c81e54..0000000 --- a/lisp/+tempo.el +++ /dev/null @@ -1,45 +0,0 @@ -;;; +tempo.el --- easier tempo definition -*- lexical-binding: t -*- - -(require 'tempo) -(declare-function derived-mode-abbrev-table-name "tempo") - -;; TODO: I need to figure out where this function goes. -(defun delete2 (list &rest elems) - "Delete each element of ELEMS, and the next item, from LIST." - (let ((r nil)) - (while (consp list) - (if (member (car list) elems) - (setf list (cdr list)) - (setf r (cons (car list) r))) - (setf list (cdr list))) - (reverse r))) - -(defmacro define-tempo (tag doc &rest elements) - "Define a template and add its tag to MODE's abbrev-table. -TAG, DOC, and ELEMENTS are passed to `tempo-define-template', which see. -ABBREV, if given, is the abbrev string to use for template expansion -under MODE's abbrev-table. If ABBREV isn't given, TAG will be used." - (declare (indent 1)) - (let* ((template (gensym)) - (tag (cond ((stringp tag) tag) - ((symbolp tag) (symbol-name tag)) - (t (user-error "TAG must be a string or symbol: %S" tag)))) - (mode (or (plist-get elements :mode) nil)) - (abbrev (or (plist-get elements :abbrev) tag)) - (taglist (or (plist-get elements :taglist) nil)) - (table (let ((tname (and mode (derived-mode-abbrev-table-name mode)))) - (while (and tname (not (memq tname abbrev-table-name-list))) - (setq tname (and (get mode 'derived-mode-parent) - (derived-mode-abbrev-table-name - (get mode 'derived-mode-parent))))) - (or tname 'global-abbrev-table))) - (elements (delete2 elements :mode :abbrev :taglist))) - `(let ((,template (tempo-define-template ,tag - ',elements - ,(or abbrev tag) - ,doc - ,taglist))) - (define-abbrev ,table ,tag "" ,template :system t) - (put ,template 'no-self-insert t)))) - -(provide '+tempo) diff --git a/lisp/+titlecase.el b/lisp/+titlecase.el index 9266807..6defda7 100644 --- a/lisp/+titlecase.el +++ b/lisp/+titlecase.el @@ -22,11 +22,13 @@ With prefix ARG, toggle the value of ;; 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))) + (let ((level (funcall outline-level)) + (org-special-ctrl-a/e t)) (while (and (progn (outline-next-heading) (> (funcall outline-level) level)) (not (eobp))) - (titlecase-line))))) + (titlecase-region (org-beginning-of-line) + (org-end-of-line)))))) (provide '+titlecase) ;;; +titlecase.el ends here diff --git a/lisp/+window.el b/lisp/+window.el deleted file mode 100644 index 52b3712..0000000 --- a/lisp/+window.el +++ /dev/null @@ -1,130 +0,0 @@ -;;; +window.el --- Fixes for Emacs's window.el -*- lexical-binding: t; -*- - -;;; Commentary: - -;; Do I want to propose this change in the Emacs ML? - -;;; Code: - -(require 'window) - -;;; Split windows based on `window-total-width', not `window-width' -;; I have to just redefine these functions because the check is really deep in -;; there. - -(defun window-splittable-p (window &optional horizontal) - "Return non-nil if `split-window-sensibly' may split WINDOW. -Optional argument HORIZONTAL nil or omitted means check whether -`split-window-sensibly' may split WINDOW vertically. HORIZONTAL -non-nil means check whether WINDOW may be split horizontally. - -WINDOW may be split vertically when the following conditions -hold: -- `window-size-fixed' is either nil or equals `width' for the - buffer of WINDOW. -- `split-height-threshold' is an integer and WINDOW is at least as - high as `split-height-threshold'. -- When WINDOW is split evenly, the emanating windows are at least - `window-min-height' lines tall and can accommodate at least one - line plus - if WINDOW has one - a mode line. - -WINDOW may be split horizontally when the following conditions -hold: -- `window-size-fixed' is either nil or equals `height' for the - buffer of WINDOW. -- `split-width-threshold' is an integer and WINDOW is at least as - wide as `split-width-threshold'. -- When WINDOW is split evenly, the emanating windows are at least - `window-min-width' or two (whichever is larger) columns wide." - (when (and (window-live-p window) - (not (window-parameter window 'window-side))) - (with-current-buffer (window-buffer window) - (if horizontal - ;; A window can be split horizontally when its width is not - ;; fixed, it is at least `split-width-threshold' columns wide - ;; and at least twice as wide as `window-min-width' and 2 (the - ;; latter value is hardcoded). - (and (memq window-size-fixed '(nil height)) - ;; Testing `window-full-width-p' here hardly makes any - ;; sense nowadays. This can be done more intuitively by - ;; setting up `split-width-threshold' appropriately. - (numberp split-width-threshold) - (>= (window-total-width window) - (max split-width-threshold - (* 2 (max window-min-width 2))))) - ;; A window can be split vertically when its height is not - ;; fixed, it is at least `split-height-threshold' lines high, - ;; and it is at least twice as high as `window-min-height' and 2 - ;; if it has a mode line or 1. - (and (memq window-size-fixed '(nil width)) - (numberp split-height-threshold) - (>= (window-height window) - (max split-height-threshold - (* 2 (max window-min-height - (if mode-line-format 2 1)))))))))) - -(defun split-window-sensibly (&optional window) - "Split WINDOW in a way suitable for `display-buffer'. -WINDOW defaults to the currently selected window. -If `split-height-threshold' specifies an integer, WINDOW is at -least `split-height-threshold' lines tall and can be split -vertically, split WINDOW into two windows one above the other and -return the lower window. Otherwise, if `split-width-threshold' -specifies an integer, WINDOW is at least `split-width-threshold' -columns wide and can be split horizontally, split WINDOW into two -windows side by side and return the window on the right. If this -can't be done either and WINDOW is the only window on its frame, -try to split WINDOW vertically disregarding any value specified -by `split-height-threshold'. If that succeeds, return the lower -window. Return nil otherwise. - -By default `display-buffer' routines call this function to split -the largest or least recently used window. To change the default -customize the option `split-window-preferred-function'. - -You can enforce this function to not split WINDOW horizontally, -by setting (or binding) the variable `split-width-threshold' to -nil. If, in addition, you set `split-height-threshold' to zero, -chances increase that this function does split WINDOW vertically. - -In order to not split WINDOW vertically, set (or bind) the -variable `split-height-threshold' to nil. Additionally, you can -set `split-width-threshold' to zero to make a horizontal split -more likely to occur. - -Have a look at the function `window-splittable-p' if you want to -know how `split-window-sensibly' determines whether WINDOW can be -split." - (let ((window (or window (selected-window)))) - (or (and (window-splittable-p window) - ;; Split window vertically. - (with-selected-window window - (split-window-below))) - (and (window-splittable-p window t) - ;; Split window horizontally. - (with-selected-window window - (split-window-right))) - (and - ;; If WINDOW is the only usable window on its frame (it is - ;; the only one or, not being the only one, all the other - ;; ones are dedicated) and is not the minibuffer window, try - ;; to split it vertically disregarding the value of - ;; `split-height-threshold'. - (let ((frame (window-frame window))) - (or - (eq window (frame-root-window frame)) - (catch 'done - (walk-window-tree (lambda (w) - (unless (or (eq w window) - (window-dedicated-p w)) - (throw 'done nil))) - frame nil 'nomini) - t))) - (not (window-minibuffer-p window)) - (let ((split-height-threshold 0)) - (when (window-splittable-p window) - (with-selected-window window - (split-window-below)))))))) - -(provide '+window) -;;; +window.el ends here diff --git a/lisp/acdw-defaults.el b/lisp/acdw-defaults.el new file mode 100644 index 0000000..80b2bcc --- /dev/null +++ b/lisp/acdw-defaults.el @@ -0,0 +1,292 @@ +;;; acdw-defaults.el --- measured defaults for Emacs -*- lexical-binding: t -*- +;; by C. Duckworth + +;;; Commentary: + +;; I find myself copy-pasting a lot of "boilerplate" type code when +;; bankrupting my Emacs config and starting afresh. Instead of doing +;; that, I'm putting it here, where it'll be easier to include in my +;; config. + +;; Of course, some might say I could just ... stop bankrupting my +;; Emacs. But like, why would I want to? + +;;; Code: + +(require 'seq) + +(defvar default-ring-max 256 + "Default maximum for ring variables.") + +(unless (boundp 'use-short-answers) + (fset 'yes-or-no-p 'y-or-n-p)) + +(setc async-shell-command-buffer 'new-buffer + async-shell-command-display-buffer nil + auto-hscroll-mode t + auto-window-vscroll nil + cursor-in-non-selected-windows 'hollow + cursor-type 'bar + echo-keystrokes 0.01 + fast-but-imprecise-scrolling t + fill-column 80 + global-mark-ring-max default-ring-max + hscroll-margin 1 + hscroll-step 1 + inhibit-startup-screen t + initial-buffer-choice t + kill-do-not-save-duplicates t + kill-read-only-ok t + kill-ring-max default-ring-max + kmacro-ring-max default-ring-max + mark-ring-max default-ring-max + read-answer-short t + read-process-output-max (* 10 1024 1024) + ring-bell-function #'ignore + save-interprogram-paste-before-kill t + scroll-conservatively 25 + scroll-margin 0 + scroll-preserve-screen-position 1 + scroll-step 1 + sentence-end-double-space t + set-mark-command-repeat-pop t + tab-width 8 + undo-limit (* 10 1024 1024) + use-dialog-box nil + use-file-dialog nil + use-short-answers t + window-resize-pixelwise t + yank-pop-change-selection t) + +;;; Encodings + +;; Allegedly, this is the only one you need... +(set-language-environment "UTF-8") +;; But I still set all of these, for fun. +(setq-default 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 + x-select-request-type '(UTF8_STRING + COMPOUND_TEXT + TEXT + STRING)) + +(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))) + +;;; Modes + +(dolist (enable-mode '(;; Enable these modes on startup + delete-selection-mode + global-so-long-mode + )) + (funcall enable-mode +1)) + +(dolist (disable-mode '(;; Disable these modes on startup + horizontal-scroll-bar-mode + menu-bar-mode + scroll-bar-mode + tool-bar-mode + tooltip-mode + )) + (funcall disable-mode -1)) + +;;; Internal packages + +(when (require 'abbrev nil t) + (custom-set-variables + '(abbrev-file-name (sync/ "abbrev.el")) + '(save-abbrevs 'silently))) + +(when (require 'autorevert nil t) + (custom-set-variables + '(auto-revert-verbose nil) + '(global-auto-revert-non-file-buffers t)) + (global-auto-revert-mode +1)) + +(when (require 'comp nil t) + (custom-set-variables + '(native-comp-async-report-warnings-errors 'silent) + '(native-comp-deferred-compilation t))) + +(when (require 'custom nil t) + (custom-set-variables + '(custom-file (etc/ "custom.el")))) + +(when (require 'ediff nil t) + (custom-set-variables + '(ediff-window-setup-function #'ediff-setup-windows-plain))) + +(when (require 'eldoc nil t) + (custom-set-variables + '(eldoc-echo-area-use-multiline-p nil) + '(eldoc-idle-delay 0.1))) + +(when (require 'executable nil t) + (custom-set-variables + '(executable-prefix-env t))) + +(when (require 'files nil t) + (custom-set-variables + '(auto-save-default nil) + '(auto-save-interval 1) + '(auto-save-no-message t) + '(auto-save-timeout 1) + '(auto-save-visited-interval 1) + '(backup-by-copying t) + '(create-lockfiles nil) + '(delete-old-versions t) + '(find-file-visit-truename t) + '(kept-new-versions 8) + '(kept-old-versions 8) + '(mode-require-final-newline t) + '(version-control t) + '(view-read-only t)) + (dolist (h/f + '((after-save-hook . executable-make-buffer-file-executable-if-script-p) + (find-file-not-found-functions . create-missing-directories) + (find-file-hook . +vc-off@remote))) + (add-hook (car h/f) (cdr h/f))) + (auto-save-visited-mode)) + +(when (require 'frame nil t) + (custom-set-variables + '(blink-cursor-blinks 1) + '(blink-cursor-interval 0.25) + '(blink-cursor-delay 0.25)) + (blink-cursor-mode)) + +(when (require 'goto-addr nil t) + (if (fboundp 'global-goto-address-mode) + (global-goto-address-mode +1) + (add-hook 'after-change-major-mode-hook 'goto-address-mode))) + +(when (require 'ibuffer nil t) + (global-set-key (kbd "C-x C-b") #'ibuffer) + (add-hook 'ibuffer-mode-hook #'hl-line-mode)) + +(when (require 'image nil t) + (custom-set-variables + '(image-use-external-converter + (seq-some #'executable-find '("convert" "gm" "ffmpeg"))))) + +(when (require 'imenu nil t) + (custom-set-variables + '(imenu-auto-rescan t))) + +(when (require 'isearch nil t) + (custom-set-variables + '(regexp-search-ring-max default-ring-max) + '(search-ring-max default-ring-max))) + +(when (require 'minibuffer nil t) + (custom-set-variables + '(completion-category-defaults nil) + '(completion-category-overrides '((file (styles partial-completion)))) + '(completion-ignore-case t) + '(completion-styles '(substring partial-completion)) + '(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)) + '(read-buffer-completion-ignore-case t)) + (file-name-shadow-mode) + (minibuffer-electric-default-mode)) + +(when (require 'mouse nil t) + (custom-set-variables + '(mouse-drag-copy-region t) + '(mouse-wheel-progressive-speed nil) + '(mouse-yank-at-point t))) + +(when (require 'paren nil t) + (custom-set-variables + '(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) + (electric-pair-mode)) + +(when (require 'recentf nil t) + (custom-set-variables + '(recentf-save-file (var/ "recentf.el")) + '(recentf-max-menu-items default-ring-max) + '(recentf-max-saved-items nil) + '(recentf-auto-cleanup 'mode)) + (add-to-list 'recentf-exclude etc/) + (add-to-list 'recentf-exclude var/) + (add-to-list 'recentf-exclude cache/) + (add-to-list 'recentf-exclude "-autoloads.el\\'") + (recentf-mode +1)) + +(when (require 'savehist nil t) + (custom-set-variables + '(history-length 1024) + '(history-delete-duplicates t) + '(savehist-file (var/ "savehist.el")) + '(savehist-save-minibuffer-history t) + '(savehist-autosave-interval 30) + ;; Other variables --- don't truncate any of these. + ;; `add-to-history' uses the values of these variables unless + ;; they're nil, in which case it falls back to `history-length'. + '(kill-ring-max default-ring-max) + '(mark-ring-max default-ring-max) + '(global-mark-ring-max default-ring-max) + '(regexp-search-ring-max default-ring-max) + '(search-ring-max default-ring-max) + '(kmacro-ring-max default-ring-max) + '(eww-history-limit default-ring-max)) + (dolist (var '(global-mark-ring + mark-ring + kill-ring + kmacro-ring + regexp-search-ring + search-ring)) + (add-to-list 'savehist-additional-variables var)) + (savehist-mode +1)) + +(when (require 'saveplace nil t) + (custom-set-variables + '(save-place-file (var/ "places.el")) + '(save-place-forget-unreadable-files (eq system-type 'gnu/linux))) + (save-place-mode 1)) + +(when (require 'uniquify nil t) + (custom-set-variables + '(uniquify-after-kill-buffer-p t) + '(uniquify-buffer-name-style 'forward) + '(uniquify-ignore-buffers-re "^\\*") + '(uniquify-separator path-separator))) + +(when (require 'vc nil t) + (custom-set-variables + '(vc-follow-symlinks t) + '(vc-make-backup-files t))) + +(when (require 'window nil t) + (custom-set-variables + '(recenter-positions '(top 2 middle bottom)))) + +;;; New features + +(when (fboundp 'pixel-scroll-precision-mode) + (pixel-scroll-precision-mode)) + +(provide 'acdw-defaults) +;;; acdw-defaults.el ends here diff --git a/lisp/acdw-funs.el b/lisp/acdw-funs.el new file mode 100644 index 0000000..ed41a61 --- /dev/null +++ b/lisp/acdw-funs.el @@ -0,0 +1,262 @@ +;;; acdw-funs.el --- extra functions -*- lexical-binding: t -*- + + +;;; Cribs from CRUX --- Advice +;; https://github.com/bbatsov/crux + +;; All of these should go `:before' the function they're advising +(defun advise-region-or-buffer (&rest _) + "`:before' advice to work on the active region or whole buffer. +See also `with-region-or-buffer'." + (interactive (if mark-active + (list (region-beginning) (region-end)) + (list (point-min) (point-max))))) + +(defun advise-region-or-line (&rest _) + "`:before' advice to work on the active region or whole line. +See also `with-region-or-line'." + (interactive (if mark-active + (list (region-beginning) (region-end)) + (list (line-beginning-position) (line-end-position))))) + +(defun advise-region-or-to-eol (&rest _) + "`:before' advice to work on the active region or to end of line. +See also `with-region-or-to-eol'." + (INTERACTIVE (if mark-active + (list (region-beginning) (region-end)) + (list (point) (line-end-position))))) + + +;;; Other functions and whatnot + +(defun delete2 (list &rest elems) + "Delete each element of ELEMS, and the next item, from LIST." + (let ((r nil)) + (while (consp list) + (if (member (car list) elems) + (setf list (cdr list)) + (setf r (cons (car list) r))) + (setf list (cdr list))) + (reverse r))) + +(unless (fboundp 'ensure-list) + (defun ensure-list (object) + "Return OBJECT as a list. +If OBJECT is already a list, return OBJECT itself. If it's +not a list, return a one-element list containing OBJECT." + (if (listp object) + object + (list object)))) + +(defun +require (&rest features) + "Require FEATURES, plus my extras. +Each feature can be an atom (the feature name) or a list of the form +(FEATURE &optional FILENAME NOERROR), which is passed directly to +`require'. My extras are in lisp/ and named +FEATURE, so this +function will `require' them too---but not error if they don't +exist." + (dolist (feat features) + (apply #'require (ensure-list feat)) + (require (intern (format "+%s" feat)) nil :noerror))) + +;;; Improvements to default functions + +(defun +save-buffers-kill-terminal (arg) + "Delete the current frame, or quit Emacs. +This function is my customization of `save-buffers-kill-terminal'." + (interactive "P") + (cond (arg (delete-frame nil :force)) + ((= 1 (length (frame-list))) + (and (yes-or-no-p "Kill emacs? ") + (save-buffers-kill-emacs t))) + (:else (delete-frame)))) + +(defun really-quit-emacs (arg) + "Really, actually quit Emacs." + (interactive "P") + (cond (arg (save-buffers-kill-emacs t)) + (:else (save-buffers-kill-terminal t)))) + +(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 delete-window|bury-buffer () + "Delete the current window, or bury the current buffer. +If the current window is the only window, bury the buffer." + (interactive) + (condition-case e + (delete-window) + (t (bury-buffer)))) + +(defun other-window|switch-buffer (arg) + "Call `other-window' or `switch-buffer' depending on windows. +When called with prefix ARG, unconditionally switch buffer." + (interactive "P") + (if (or arg (one-window-p)) + (switch-to-buffer (other-buffer) nil t) + (other-window 1))) + +(defun open-paragraph (&optional arg) + "Open a paragraph after paragraph at point. +A paragraph is defined as continguous non-empty lines of text +surrounded by empty lines, so opening a paragraph means to make +three blank lines, then place the point on the second one. + +Called with prefix ARG, open a paragraph before point." + ;; TODO: Take an integer as ARG, allowing for skipping paragraphs up and down. + (interactive "*P") + ;; Go to next blank line. This /isn't/ `end-of-paragraph-text' because + ;; that's weird with org, and I'm guessing other modes too. + (unless (looking-at "^$") (forward-line (if arg -1 +1))) + (while (and (not (looking-at "^$")) + (= 0 (forward-line (if arg -1 +1))))) + (newline) + (when arg (newline) (forward-line -2)) + (delete-blank-lines) + (newline 2) + (previous-line)) + +(defun +initial-buffer () + (if (equal (get-buffer "*Messages*") + (other-buffer)) + (get-buffer "*scratch*") + (other-buffer))) + +(defun open-paragraph (&optional arg) + "Open a paragraph after paragraph at point. +A paragraph is defined as continguous non-empty lines of text +surrounded by empty lines, so opening a paragraph means to make +three blank lines, then place the point on the second one. + +Called with prefix ARG, open a paragraph before point." + ;; TODO: Take an integer as ARG, allowing for skipping paragraphs up and down. + (interactive "*P") + ;; Go to next blank line. This /isn't/ `end-of-paragraph-text' because + ;; that's weird with org, and I'm guessing other modes too. + (unless (looking-at "^$") (forward-line (if arg -1 +1))) + (while (and (not (looking-at "^$")) + (= 0 (forward-line (if arg -1 +1))))) + (newline) + (when arg (newline) (forward-line -2)) + (delete-blank-lines) + (newline 2) + (previous-line)) + +(defun create-missing-directories () + "Automatically create missing directories when finding a file." + ;; https://emacsredux.com/blog/2022/06/12/auto-create-missing-directories/ + (let ((target-dir (file-name-directory buffer-file-name))) + (unless (file-exists-p target-dir) + (make-directory target-dir t)))) + +(defun +vc-off@remote () + (when (file-remote-p (buffer-file-name)) + (setq-local vc-handled-backends nil))) + +(defun +auto-save-some-buffers (&rest _) + "Quietly run `save-some-buffers'." + (let ((inhibit-message t)) + (with-temp-message "" + (save-some-buffers t)))) + +(defun comment-lines (str &optional comment-char) + "Comment each line of STR. +Returns the new, commented, string. + +If COMMENT-CHAR is missing or nil, use `comment-start'." + (mapconcat (lambda (ln) + (concat (or comment-char comment-start) + ln)) + (string-lines str) + "\n")) + +(defun clamp (value min max) + "Clamp VALUE between MIN and MAX." + (min max (max min value))) + +(define-minor-mode truncate-lines-local-mode + "Truncate lines locally in a buffer." + :lighter " ..." + :group 'display + (setq-local truncate-lines truncate-lines-local-mode)) + +(defun mapc-buffers (func &optional predicate) + "Map FUNC over buffers matching PREDICATE. +Both FUNC and PREDICATE will be executed with no arguments and in +the context of each buffer. + +If PREDICATE is nil or not given, map FUNC over all buffers." + (cl-loop for buf being the buffers + do (with-current-buffer buf + (when (and predicate + (funcall predicate)) + (funcall func))))) + +(defun mapc-buffers-modes (func &rest modes) + "Map FUNC over buffers derived from MODES. +FUNC will be executed with no arguments and in the context of +each buffer." + (mapc-buffers func + (lambda () + (apply #'derived-mode-p modes)))) + +(defun ++concat (func strings) + "Concat STRINGS processed by FUNC. +Each of STRINGS can be a bare string or a list. Strings are +passed through as-is, but lists are passed to FUNC first as +arguments. Finally, all the resulting strings are `mapconcat'-ed +together. + +As a special case, if `:separator' is the first of STRINGS, the +string following will be used as a separator. Otherwise, a +newline will be used." + (let (separator) + (when (eq (car strings) :separator) + (setq separator (cadr strings) + strings (cddr strings))) + (mapconcat (lambda (s) + (cond + ((listp s) (apply func s)) + ((stringp s) s) + (t (user-error "Bad argument: %S" s)))) + strings + (or separator "\n")))) + +(defun nconcat (&rest strings) + "Concat STRINGS separated by SEPARATOR. +If `:separator' is the first of STRINGS, the next string will be used to +separate the rest of STRINGS." + (++concat #'concat strings)) + +(defun format-concat (&rest strings) + "Concatenate formatted STRINGS. +Each of STRINGS can be a bare string or a list. Bare strings are passed as-is +to `mapconcat' for concatenation and separation. Lists, however, are passed to +`format' first. + +If `:separator' is the first of STRINGS, the next string will be +used as a separator." + (++concat #'format strings)) + +(defun choose-executable (&rest programs) + "Return the first of PROGRAMS that exists in the system's $PATH." + (seq-some #'executable-find programs)) + +;;; Update packages more better-er + +(defun +package-update-all () + "Update all packages and vc packages." + (interactive) + (package-update-all) + ;; WTF! + (let ((package-archives-nil)) + (package-vc-update-all))) + +(provide 'acdw-funs) +;;; acdw-funs.el ends here diff --git a/lisp/acdw-macs.el b/lisp/acdw-macs.el new file mode 100644 index 0000000..e2258fa --- /dev/null +++ b/lisp/acdw-macs.el @@ -0,0 +1,293 @@ +;;; acdw-macs.el --- extra macros -*- lexical-binding: t; -*- + +(eval-when-compile + (require 'cl-lib) + (require 'tempo) + (declare-function derived-mode-abbrev-table-name "tempo")) + +;;; Extra functionality for `eval-after-load' + +(defun eval-after-init (thunk) + "Evaluate THUNK after Emacs initiation, or now if already initialized." + (if after-init-time + (funcall thunk) + (add-hook 'after-init-hook thunk))) + +(defmacro eval-after (prereqs &rest body) + "Evaluate body after PREREQS. +PREREQS can be a feature, a number, `t', or a list of those. + +Features are used as arguments to `eval-after-load'. Numbers are +used as arguments to `run-with-idle-timer'. `t' will ensure BODY +runs after Emacs's init time. + +When given a list of PREREQS, `eval-after' will nest each one +from left to right." + (declare (indent 1) (debug (form def-body))) + (setf prereqs (ensure-list prereqs)) + (if (null prereqs) + (macroexp-progn body) + (let* ((this (car prereqs)) + (form `((lambda () (eval-after ,(cdr prereqs) ,@body))))) + (cond + ((eq this :init) + (append '(eval-after-init) form)) + ((numberp this) + (append `(run-with-idle-timer ,this nil) form)) + ((symbolp this) + (append `(eval-after-load ',this) form)) + (:else (user-error "Eval-after: Bad prereq: %S" this)))))) + + +;;; Easier customization of options +;; At some point it might be nice to include more forms in the VAR slots, like +;; `setup's `:option' macro. + +(if (fboundp 'setopt) + ;; Emacs 29 introduces `setopt', which does basically the same thing as the + ;; macro below. Not exactly the same, of course---it uses `setopt--set' + ;; instead of `customize-set-variable'---but I'm going to trust the Emacs + ;; devs on this one. + (defalias 'setc 'setopt) + (defmacro setc (&rest args) + "Customize user options in a `setq'-like way." + (declare (debug setq)) + (unless (zerop (mod (length args) 2)) + (signal 'wrong-number-of-arguments `(evenp ,(length args)))) + (let (form defuns) + (while args + (let* ((var (pop args)) + (val (pop args))) + (when (memq (car-safe val) '(defun defmacro)) + (push val defuns) + (setq val `(function ,(cadr val)))) + (push `(customize-set-variable ',var ,val "Set by `setc'.") + form))) + `(progn ,@(append (nreverse defuns) (nreverse form)))))) + + +;;; Extra def- forms + +(defmacro defdir (name directory &optional docstring) + "Define a variable and a function NAME expanding to DIRECTORY. +DOCSTRING is applied to the variable; its default is DIRECTORY's +path." + (declare (indent 2) (doc-string 3)) + `(progn + (defvar ,name ,directory + ,(concat (or docstring (format "%s" directory)) "\n" + "Defined by `defdir'.")) + (defun ,name (file &optional mkdir) + ,(concat "Expand FILE relative to variable `" (symbol-name name) "'.\n" + "If MKDIR is non-nil, parent directories are created.\n" + "Defined by `defdir'.") + (let ((file-name (expand-file-name + (convert-standard-filename file) ,name))) + (when mkdir + (make-directory (file-name-directory file-name) :parents)) + file-name)))) + +(defmacro defkeys (maps &rest bindings) + "Define key BINDINGS in MAPS. +If MAPS is nil or t, bind to `current-global-map'. Otherwise, +bind each of BINDINGS to the map or list of maps provided. + +BINDINGS is a `setq'-style list of pairs of keys and definitions. +The key part of each binding can be a string, in which case it's +passed to `kbd', or a vector or anything else `define-key' +accepts in the KEY position. The definition part, likewise, can +be any form `define-key' accepts in that position, with this +addition: if the form is a `defun' form, it will be defined +before any keys are bound." + (declare (indent 1)) + (unless (cl-evenp (length bindings)) + (signal 'wrong-number-of-arguments `(evenp ,(length bindings)))) + `(progn + ,@(cl-loop + for map in (ensure-list maps) + for first-map-p = t then nil + append + (cl-loop + for (keys def) on bindings by #'cddr + for defp = (memq (car-safe def) '(defmap defun defmacro)) + if (and defp first-map-p) collect def into defuns + append + (cl-loop + for key in (ensure-list keys) + collect (list 'define-key + (if (memq map '(t nil)) + '(current-global-map) + (or (car-safe map) map)) + (if (stringp key) + `(kbd ,key) + key) + (if defp + (cl-case (car def) + ((defmap) (cadr def)) + ((defun defmacro) `#',(cadr def)) + (otherwise (error "Bad def type: %S" + (car def)))) + def))) + into keydefs + finally return + (let ((all (append defuns keydefs))) + (if-let ((after (plist-get (cdr-safe map) :after))) + `((eval-after ,after + ,@all)) + all)))))) + +(defmacro defmap (name docstring &rest bindings) + "Define a keymap named NAME, with BINDINGS." + (declare (indent 1) (doc-string 2)) + `(,(if (boundp name) 'setq 'defvar) ,name + ;;; ^ probably a terrible hack + (let ((map (make-sparse-keymap))) + (defkeys map ,@bindings) + map) + ,@(unless (boundp name) (list docstring)))) + +(defmacro defhook (hooks &rest body) + "Define a function to hook into HOOKS. +NAME and ARGS are passed to the generated `defun' form. +Each hook in HOOKS can be the name of a hook or a list of the form +(HOOK DEPTH LOCAL), where each argument is the same as in +`add-hook'." + (declare (indent 1)) + (let* ((name (or (plist-get body :name) + (intern (format "%s/h" + (mapconcat + (lambda (h) + (string-remove-suffix + "-hook" + (if (and (consp h) + (caddr h)) + (format "%s:local" (car h)) + (format "%s" (or (car-safe h) + h))))) + (ensure-list hooks) + "|"))))) + (args (or (plist-get body :args) nil)) + (doc (or (plist-get body :doc) nil)) + (forms ; (DEFUN . FUNCS) + (cl-loop for form in (delete2 body :name :args :doc) + if (eq (car form) 'function) + collect form into funcs + else collect form into defuns + finally return (cons defuns funcs))) + (defun-forms (car forms)) + (func-forms (cdr forms))) + `(progn + ,@(when defun-forms + `((defun ,name ,args ,@(when doc (list doc)) ,@defun-forms))) + ,@(cl-loop for hook in (ensure-list hooks) + for h = (or (car-safe hook) hook) + for ha = (cdr-safe hook) + if defun-forms + collect `(add-hook ',h #',name ,@ha) + append + (cl-loop for fn in func-forms + collect `(add-hook ',h ,fn ,@ha)))))) + +;; (autoload FUNCTION FILE &optional DOCSTRING INTERACTIVE TYPE) +(defmacro defautoload (file &rest fns) + "Autoload FNS from FILE. +Each of FNS can be an atom (function name) or a list of the +form (FUNCTION ARGS), where ARGS is a plist. ARGS's possible +keys are `:doc' (docstring), `:interactive', and `:type', which are +used as the optional arguments to `autoload'. + +You can also pass `:interactive' and `:type' as keyword arguments +just after FILE, and they'll serve as the default for the +autoloaded FNS." + (declare (indent 1)) + (let ((interactive (plist-get fns :interactive)) + (type (plist-get fns :type)) + (fns (delete2 fns :interactive :type))) + `(progn + ,@(cl-loop for fn in fns + for name = (or (car-safe fn) fn) + for args = (cdr-safe fn) + collect + `(autoload ',name ,(format "%s" file) + ,(plist-get args :doc) + ,(or (plist-get args :interactive) + interactive) + ,(or (plist-get args :type) + type)))))) + + +;;; Miscellaneous + +(defmacro with-message (message &rest body) + "Display MESSAGE then execute BODY. +If BODY executes without errors, display MESSAGE...done." + (declare (indent 1)) + (let ((msym (gensym)) + (esym (gensym))) + `(let ((,msym ,message)) + (condition-case ,esym + (progn (message "%s..." ,msym) + ,@body) + (:success (message "%s...done" ,msym)) + (t (signal (car ,esym) (cdr ,esym))))))) + +(defmacro o (&rest fns) + "Compose FNS into a new function for one argument." + (if (null fns) + `(lambda (&rest args) args) + `(lambda (&rest args) + (apply + #',(car fns) + (ensure-list (apply (o ,@(cdr fns)) args)))))) + +(defmacro with-region-or-buffer (&rest funcs) + "Advise FUNCS with `advise-region-or-buffer'." + `(progn + ,@(cl-loop for fn in funcs + collect + `(advice-add ',fn :before #'advise-region-or-buffer)))) + +(defmacro with-region-or-line (&rest funcs) + "Advise FUNCS with `advise-region-or-line'." + `(progn + ,@(cl-loop for fn in funcs + collect + `(advice-add ',fn :before #'advise-region-or-line)))) + +(defmacro with-region-or-to-eol (&rest funcs) + "Advise FUNCS with `advise-region-or-to-eol'." + `(progn + ,@(cl-loop for fn in funcs + collect + `(advice-add ',fn :before #'advise-region-or-to-eol)))) + +(defmacro define-tempo (tag doc &rest elements) + "Define a template and add its tag to MODE's abbrev-table. +TAG, DOC, and ELEMENTS are passed to `tempo-define-template', which see. +ABBREV, if given, is the abbrev string to use for template expansion +under MODE's abbrev-table. If ABBREV isn't given, TAG will be used." + (declare (indent 1)) + (let* ((template (gensym)) + (tag (cond ((stringp tag) tag) + ((symbolp tag) (symbol-name tag)) + (t (user-error "TAG must be a string or symbol: %S" tag)))) + (mode (or (plist-get elements :mode) nil)) + (abbrev (or (plist-get elements :abbrev) tag)) + (taglist (or (plist-get elements :taglist) nil)) + (table (let ((tname (and mode (derived-mode-abbrev-table-name mode)))) + (while (and tname (not (memq tname abbrev-table-name-list))) + (setq tname (and (get mode 'derived-mode-parent) + (derived-mode-abbrev-table-name + (get mode 'derived-mode-parent))))) + (or tname 'global-abbrev-table))) + (elements (delete2 elements :mode :abbrev :taglist))) + `(let ((,template (tempo-define-template ,tag + ',elements + ,(or abbrev tag) + ,doc + ,taglist))) + (define-abbrev ,table ,tag "" ,template :system t) + (put ,template 'no-self-insert t)))) + +(provide 'acdw-macs) +;;; acdw-macs.el ends here diff --git a/lisp/acdw.el b/lisp/acdw.el index a9ef893..30c4f44 100644 --- a/lisp/acdw.el +++ b/lisp/acdw.el @@ -1,272 +1,79 @@ -;;; acdw.el -- bits and bobs -*- lexical-binding: t; -*- -;; by C. Duckworth -(require 'cl-lib) -;; def.el is here -(require 'def) - -;;; Define both a directory and a function expanding to a file in that directory - -(defmacro +define-dir (name directory &optional docstring inhibit-mkdir) - "Define a variable and function NAME expanding to DIRECTORY. -DOCSTRING is applied to the variable. Ensure DIRECTORY exists in -the filesystem, unless INHIBIT-MKDIR is non-nil." - (declare (indent 2) - (doc-string 3)) - (unless inhibit-mkdir - (make-directory (eval directory) :parents)) - `(progn - (defvar ,name ,directory - ,(concat docstring (when docstring "\n") - "Defined by `/define-dir'.")) - (defun ,name (file &optional mkdir) - ,(concat "Expand FILE relative to variable `" (symbol-name name) "'.\n" - "If MKDIR is non-nil, the directory is created.\n" - "Defined by `/define-dir'.") - (let ((file-name (expand-file-name (convert-standard-filename file) - ,name))) - (when mkdir - (make-directory (file-name-directory file-name) :parents)) - file-name)))) - -;;; Evaluating things after other things - -(defun eval-after-init (fn) - "Evaluate FN after inititation, or now if Emacs is initialized. -FN is called with no arguments." - (if after-init-time - (funcall fn) - (add-hook 'after-init-hook fn))) - -(defmacro eval-after (features &rest body) - "Evaluate BODY, but only after loading FEATURES. -FEATURES can be an atom or a list; as an atom it works like -`with-eval-after-load'. The special feature `init' will evaluate -BODY after Emacs is finished initializing." - (declare (indent 1) - (debug (form def-body))) - (unless (listp features) - (setf features (list features))) - (if (null features) - (macroexp-progn body) - (let* ((this (car features)) - (rest (cdr features))) - (cond ((eq this 'init) - `(eval-after-init - (lambda () (eval-after ,rest ,@body)))) - (:else - `(with-eval-after-load ',this - (eval-after ,rest ,@body))))))) - -;;; Convenience functions - -(defun define-key* (maps &rest keydefs) - "Define KEYDEFS in MAPS. -Convenience wrapper around `define-key'." - (unless (zerop (mod (length keydefs) 2)) - (user-error "Wrong number of arguments: %S" (length keydefs))) - (dolist (map (if (or (atom maps) (eq (car maps) 'keymap)) - (list maps) - maps)) - (cl-loop for (key def) on keydefs by #'cddr - do (let ((key (if (stringp key) (kbd key) key))) - (define-key (if (symbolp map) - (symbol-value map) - map) - key def))))) - -(unless (fboundp 'ensure-list) - ;; Just in case we're using an old version of Emacs. - (defun ensure-list (object) - "Return OBJECT as a list. -If OBJECT is already a list, return OBJECT itself. If it's -not a list, return a one-element list containing OBJECT." - (if (listp object) - object - (list object)))) - -(defun add-to-list* (lists &rest things) - "Add THINGS to LISTS. -LISTS can be one list variable or a list. Each thing of THINGS -can be either a variable (the thing), or a list of the form -(ELEMENT &optional APPEND COMPARE-FN), which is passed to -`add-to-list'." - (declare (indent 1)) - (dolist (l (ensure-list lists)) - (dolist (thing things) - (apply #'add-to-list l (ensure-list thing))))) - -(defun add-hook* (hooks &rest functions) - "Add FUNCTIONS to HOOKS. -Each function in FUNCTIONS can be a singleton or a list of the -form (FUNCTION &optional DEPTH LOCAL)." - (declare (indent 1)) - (dolist (hook (ensure-list hooks)) - (dolist (fn functions) - (apply #'add-hook hook (ensure-list fn))))) - -(defun +concat (&rest strings) - "Concat STRINGS separated by SEPARATOR. -SEPARATOR is \"\\n\" unless the keyword argument `:separator' is -given, followed by the separator to use. Each item in STRINGS is -either a string or a list or strings, which is concatenated -without any separator." - (let (ret - ;; I don't know why a `cl-defun' with - ;; (&rest strings &key (separator "\n")) doesn't work - (separator (or (cl-loop for i from 0 upto (length strings) - if (eq (nth i strings) :separator) - return (nth (1+ i) strings)) - "\n"))) - (while strings - (let ((string (pop strings))) - (cond ((eq string :separator) (pop strings)) - ((listp string) (push (apply #'concat string) ret)) - ((stringp string) (push string ret))))) - (mapconcat #'identity (nreverse ret) separator))) - -(defun require* (&rest features) - "Require FEATURES in order. -Each feature of FEATURES can also be a list of the arguments to -pass to `require', which see." - (condition-case e - (dolist (feature features) - (apply #'require (ensure-list feature))) - (:success (mapcar (lambda (f) (car (ensure-list f))) features)) - (t (signal (car e) (cdr e))))) - -;;; Convenience macros - -(defmacro define-local-before-save-hook (mode-or-hook &rest body) - "Add a local `before-save-hook' to MODE-OR-HOOK." - (declare (indent 1)) - (let* ((name (format "%s" mode-or-hook)) - (external-name (intern (format "%s@before-save" name))) - (internal-name (intern (format "before-save@%s" name))) - (hook (if (string-suffix-p "-hook" name) - mode-or-hook - (intern (format "%s-hook" name))))) - `(progn - (defun ,internal-name () - ,@body) - (defun ,external-name () - (add-hook 'before-save-hook #',internal-name nil :local)) - (add-hook ',hook #',external-name)))) - -(defmacro setq-local-hook (hooks &rest args) - "Run `setq-local' on ARGS when running HOOKs." - ;; FIXME: this is pretty messy, i think... - ;; The settings should be stored in an alist so that they can be deduplicated - (declare (indent 1)) - `(progn - ,@(cl-loop for hook in (ensure-list hooks) - collect - (let ((fn (intern (format "%s-setq-local" hook)))) - (when (and (fboundp fn) - (functionp fn)) - (setf args (append (function-get fn 'setq-local-hook-settings) args))) - (unless (and (< 0 (length args)) - (zerop (mod (length args) 2))) - (user-error "Wrong number of arguments: %S" (length args))) - `(progn - (defun ,fn () - ,(format "Set local variables after `%s'." hook) - (setq-local ,@args)) - (function-put ',fn 'setq-local-hook-settings ',args) - (dolist (buf (buffer-list)) - (with-current-buffer buf - (when (derived-mode-p - ',(intern (replace-regexp-in-string - "-hook" "" (format "%s" hook)))) - (,fn)))) - (add-hook ',hook #',fn)))))) - -(defmacro with-message (message &rest body) - "Execute BODY, with MESSAGE. -If body executes without errors, MESSAGE...Done will be displayed." - (declare (indent 1)) - (let ((msg (gensym))) - `(let ((,msg ,message)) - (condition-case e - (progn (message "%s..." ,msg) - ,@body) - (:success (message "%s...done" ,msg)) - (t (signal (car e) (cdr e))))))) - -(defmacro either (&rest clauses) - "Return the first of CLAUSES that returns non-nil." - (let* ((this (gensym "either"))) - (unless (null clauses) - `(let* ((,this ,(car clauses))) - (if ,this ,this (either ,@(cdr clauses))))))) - -(defun mapc-buffers (fn &optional pred) - "Perform FN on buffers matching PRED. -If PRED is nil or absent, perform FN on all buffers. Both FN and -PRED are called within a `with-current-buffer' form and without -arguments." - (let ((pred (cond - ((listp pred) - (lambda () (apply #'derived-mode-p pred))) - ((functionp pred) pred) - ((null pred) (lambda () t)) - (:else (user-error "Bad predicate"))))) - (dolist (buf (buffer-list)) - (with-current-buffer buf - (when (funcall pred) - (funcall fn)))))) - -;; https://emacs.stackexchange.com/a/39324/37239 -;; XXX: This shit don't work rn -(defun ignore-invisible-overlays (fn) - "Execute FN, ignoring invisible overlays. -FN should return a point." - (let ((overlay nil) - (point nil)) - (setq point (and (funcall fn) (point))) - (setq overlay (car (overlays-at (point)))) - (while (and overlay (member 'invisible (overlay-properties overlay))) - (goto-char (overlay-end overlay)) - (setq point (and (funcall fn) (point))) - (setq overlay (car (overlays-at (point))))) - point)) - -;;; Extras -;; Trying to avoid a whole install of crux ... - -(defun kill-and-join-forward (&optional arg) - "Kill the line or, if at the end of a line, join with the next. -This command is `visual-line-mode'-aware. If ARG is provided, -it's passed on to kill a line, but not to delete indentation. -When joining, this command deletes whitespace." - (interactive "P") - (if (and (eolp) (not (bolp))) - (delete-indentation 1) - (funcall (if visual-line-mode #'kill-visual-line #'kill-line) arg))) - -(defun other-window|switch-buffer (arg) - "Call `other-window' or `switch-buffer' depending on windows. -When called with prefix ARG, unconditionally switch buffer." - (interactive "P") - (if (or arg (one-window-p)) - (switch-to-buffer (other-buffer) nil t) - (other-window 1))) - -;;; Set variables more better-er -;; Now this doesn't do `setf'-style stuff. - -(defmacro setc (&rest args) - "Customize user options using ARGS like `setq'." - (declare (debug setq)) - (unless (zerop (mod (length args) 2)) - (user-error "Dangling argument: %S" var)) - (let (form) - (while args - (push `(customize-set-variable - ',(pop args) - ,(pop args) - "Set by `setc'.") - form)) - `(progn ,@(nreverse form)))) +;;; acdw.el --- Basic emacs shit for acdw -*- lexical-binding: t -*- + +;;; Code: + +(require 'acdw-funs) ; Extra functions +(require 'acdw-macs) ; Extra macros + +(defdir etc/ (locate-user-emacs-file "etc") + "Directory for package configuration files. +See `no-littering' for examples.") + +(defdir var/ etc/ + "Directory for package data file. +See `no-littering' for examples.") + +(defdir cache/ (if-let ((xdg-cache (getenv "XDG_CACHE_HOME"))) + (expand-file-name "emacs/" xdg-cache) + etc/) + "Directory for cache files.") + +(setq native-compile-target-directory (cache/ "eln" t)) +(when (fboundp 'startup-redirect-eln-cache) + (startup-redirect-eln-cache (cache/ "eln" t))) + +(defdir sync/ (expand-file-name "/home/case/Sync") + "My Syncthing directory.") + +(defdir private/ (sync/ "emacs/private")) +(add-to-list 'load-path private/) + +(require 'acdw-defaults) ; Sane defaults +(require '_acdw) ; Private stuff +(require '+lisp) ; Lispy goodness + +(setc enable-recursive-minibuffers t + completions-detailed t + completion-ignore-case t + read-buffer-completion-ignore-case t + read-file-name-completion-ignore-case t + initial-buffer-choice #'+initial-buffer + initial-scratch-message + (format "%s\n\n" + (comment-lines + (shell-command-to-string "fortune") + ";; ")) + sentence-end-double-space nil + save-silently t) + +(defkeys t + "M-o" #'other-window|switch-buffer + "C-x 0" #'delete-window|bury-buffer + "C-M-;" #'+lisp-comment-or-uncomment-sexp + "M-SPC" #'+cycle-spacing + "C-x C-k" #'kill-this-buffer) + +(defkeys t + "M-u" #'universal-argument) + +(defkeys universal-argument-map + "M-u" #'universal-argument-more) + +(define-advice switch-to-buffer (:after (&rest _) normal-mode) + "Automatically determine the mode for created non-file buffers." + (when-let ((_ (and (eq major-mode 'fundamental-mode))) + (buffer-file-name (buffer-name))) + (normal-mode))) + +(define-advice canonically-space-region + (:around (orig &rest args) double-space-sentences) + (let ((sentence-end-double-space t)) + (apply orig args))) + +(with-region-or-buffer indent-region) + +(winner-mode) (provide 'acdw) + ;;; acdw.el ends here diff --git a/lisp/browse-url-transform.el b/lisp/browse-url-transform.el deleted file mode 100644 index c290a1f..0000000 --- a/lisp/browse-url-transform.el +++ /dev/null @@ -1,45 +0,0 @@ -;;; browse-url-transform --- transform URLs - -(defgroup browse-url-transform nil - "Transformations for urls passed to `browse-url'." - :group 'browse-url) - -(defcustom browse-url-transform-alist nil - "Transformation rules for URLs. -The keys are regexps matching URLs, and the values are how to -transform them. The replacements will use match capture data." - :type '(alist :key-type (string :tag "URL regexp match") - :value-type (string :tag "URL regexp transformation"))) - -(defun browse-url-transform-url (url) - "Transform URL before passing it to `browse-url'." - (cl-loop with url = (substring-no-properties - (if (consp url) (car url) url)) - for (regex . transformation) in browse-url-transform-alist - if (string-match regex url) - return (replace-match transformation nil nil url) - finally return url)) - -(defun browse-url-transform-advice (url &rest args) - "Advice to `browse-url' for URL transformations. -ARGS are passed on for further processing." - (apply #'list (and url (browse-url-transform-url url)) args)) - -(define-minor-mode browse-url-transform-mode - "Minor mode to transform a URL before passing it to `browse-url'. -This can be used to \"redirect\" URLs, for example from an -information silo to a more privacy-respecting one (e.g., -\"twitter.com\" -> \"nitter.com\"), by adding advice to `browse-url'. - -When using this mode, ensure that the transformed URL is also in -`browse-url-handlers', since that's what `browse-url' will see." - :lighter " Turl" - :keymap nil - :global t - (cond (browse-url-transform-mode - (advice-add 'browse-url :filter-args #'browse-url-transform-advice)) - (:else - (advice-remove 'browse-url #'browse-url-transform-advice)))) - -(provide 'browse-url-transform) -;;; browse-url-transform.el ends here diff --git a/lisp/dawn.el b/lisp/dawn.el deleted file mode 100644 index 30aab7c..0000000 --- a/lisp/dawn.el +++ /dev/null @@ -1,109 +0,0 @@ -;;; dawn.el --- Lightweight dawn/dusk task scheduling -*- lexical-binding: t; -*- - -;; Copyright (C) 2022 Case Duckworth - -;; Author: Case Duckworth -;; Maintainer: Case Duckworth -;; URL: https://codeberg.org/acdw/dusk.el -;; Version: 0.3.0 -;; Keywords: calendar, themes, convenience -;; Package-Requires: ((emacs "24.3")) - -;;; Commentary: - -;; There is also circadian.el, but it doesn't quite work for me. -;; This code comes mostly from https://gnu.xyz/auto_theme.html, but also -;; somewhere else (which I've forgotten) and my own brain :) - -;;; Code: - -(require 'calendar) -(require 'cl-lib) -(require 'solar) - -;;; Timers - -(defvar dawn--dawn-timer nil - "Timer for dawn-command.") - -(defvar dawn--dusk-timer nil - "Timer for dusk-command.") - -(defvar dawn--reset-timer nil - "Timer to reset dawn at midnight.") - -;;; Functions - -(defun dawn-encode-time (f) - "Encode fractional time F. -If F is nil, return nil." - (when f - (let ((hhmm (cl-floor f)) - (date (cdddr (decode-time)))) - (encode-time - (append (list 0 - (round (* 60 (cadr hhmm))) - (car hhmm)) - date))))) - -(defun dawn-midnight () - "Return the time of the /next/ midnight." - (let ((date (cdddr (decode-time)))) - (encode-time - (append (list 0 0 0 (1+ (car date))) (cdr date))))) - -(defun dawn-sunrise () - "Return the time of today's sunrise." - (dawn-encode-time (caar (solar-sunrise-sunset (calendar-current-date))))) - -(defun dawn-sunset () - "Return the time of today's sunset." - (dawn-encode-time (caadr (solar-sunrise-sunset (calendar-current-date))))) - -;;; Interface - -;;;###autoload -(defun dawn-schedule (dawn-command dusk-command) - "Run DAWN-COMMAND at sunrise, and DUSK-COMMAND at dusk. -Requires `calendar-longitude' and `calendar-latitude' to be set; -if they're not, it will prompt the user for them or error." - (when (or (null calendar-longitude) - (null calendar-latitude)) - (or (solar-setup) - (user-error "`dawn' won't work without setting %s!" - (cond ((and (null calendar-longitude) - (null calendar-latitude)) - "`calendar-longitude' and `calendar-latitude'") - ((null calendar-longitude) - "`calendar-longitude'") - ((null calendar-latitude) - "`calendar-latitude'"))))) - (let ((dawn (dawn-sunrise)) - (dusk (dawn-sunset))) - (cond - ((or (null dawn) (null dusk)) - ;; There is no sunrise or sunset, due to how close we are to the poles. - ;; In this case, we must figure out whether it's day or night. - (pcase (caddr (solar-sunrise-sunset (calendar-current-date))) - ("0:00" (funcall dusk-command)) ; 0 hours of daylight - ("24:00" (funcall dawn-command)) ; 24 hours of daylight - )) - ((time-less-p nil dawn) - ;; If it isn't dawn yet, it's still dark. Run DUSK-COMMAND and schedule - ;; DAWN-COMMAND and DUSK-COMMAND for later. - (funcall dusk-command) - (run-at-time dawn nil dawn-command) - (run-at-time dusk nil dusk-command)) - ((time-less-p nil dusk) - ;; If it isn't dusk yet, it's still light. Run DAWN-COMMAND and schedule - ;; DUSK-COMMAND. - (funcall dawn-command) - (run-at-time dusk nil dusk-command)) - (t ;; Otherwise, it's past dusk, so run DUSK-COMMAND. - (funcall dusk-command))) - ;; Schedule a reset at midnight, to re-calculate dawn/dusk times. - (run-at-time (dawn-midnight) nil - #'dawn-schedule dawn-command dusk-command))) - -(provide 'dawn) -;;; dawn.el ends here diff --git a/lisp/def.el b/lisp/def.el deleted file mode 100644 index 0bf91b2..0000000 --- a/lisp/def.el +++ /dev/null @@ -1,142 +0,0 @@ -;;; def.el --- defining macros -*- lexical-binding: t; -*- - -;;; Code: - -(require 'cl-lib) - -;;; Utility - -(defun def--assert-args (pred args &optional error-type &rest error-args) - "Assert that ARGS follows PRED. -If it doesn't, raise an error. ERROR-TYPE will be the type of -that error (defaults to `user-error'), and it and ERROR-ARGS are -passed in a list to `signal'." - (unless (funcall pred args) - (funcall #'signal - (or error-type 'user-error) - (or error-args - (list "Wrong arguments" args))))) - -(defmacro o (&rest fns) - "Compose FNS into a new function for one argument." - (if (null fns) - `(lambda (&rest args) args) - `(lambda (&rest args) - (apply - #',(car fns) - (ensure-list (apply (o ,@(cdr fns)) args)))))) - -;; TODO: I need to figure out where this function goes. -(defun def--delete2 (list &rest elems) - "Delete each element of ELEMS, and the next item, from LIST." - (let ((r nil)) - (while (consp list) - (if (member (car list) elems) - (setf list (cdr list)) - (setf r (cons (car list) r))) - (setf list (cdr list))) - (reverse r))) - -;;; Keybindings - -(defmacro defkeys (maps &rest bindings) - "Define key BINDINGS in MAPS. -If MAPS is nil or t, bind to `current-global-map'. Otherwise, -bind each of BINDINGS to the map or list of maps provided. - -BINDINGS is a `setq'-style list of pairs of keys and definitions. -The key part of each binding can be a string, in which case it's -passed to `kbd', or a vector or anything else `define-key' -accepts in the KEY position. The definition part, likewise, can -be any form `define-key' accepts in that position, with this -addition: if the form is a `defun' form, it will be defined -before any keys are bound." - (declare (indent 1)) - (def--assert-args (o cl-evenp length) bindings - 'wrong-number-of-arguments 'defkeys 'evenp (length bindings)) - `(progn - ,@(cl-loop - for map in (ensure-list maps) - for first-map-p = t then nil - append - (cl-loop - for (keys def) on bindings by #'cddr - for defp = (memq (car-safe def) '(defmap defun defmacro)) - if (and defp first-map-p) collect def into defuns - append - (cl-loop - for key in (ensure-list keys) - collect (list 'define-key - (if (memq map '(t nil)) - '(current-global-map) - (or (car-safe map) map)) - (if (stringp key) - `(kbd ,key) - key) - (if defp - (cl-case (car def) - ((defmap) (cadr def)) - ((defun defmacro) `#',(cadr def)) - (otherwise (error "Bad def type: %S" - (car def)))) - def))) - into keydefs - finally return - (let ((all (append defuns keydefs))) - (if-let ((after (plist-get (cdr-safe map) :after))) - `((eval-after ,after - ,@all)) - all)))))) - -(defmacro defmap (name docstring &rest bindings) - "Define a keymap named NAME, with BINDINGS." - (declare (indent 1) (doc-string 2)) - `(,(if (boundp name) 'setq 'defvar) ,name - ;;; ^ probably a terrible hack - (let ((map (make-sparse-keymap))) - (defkeys map ,@bindings) - map) - ,@(unless (boundp name) (list docstring)))) - -;;; Hooks - -(defmacro defhook (hooks &rest body) - "Define a function to hook into HOOKS. -NAME and ARGS are passed to the generated `defun' form. -Each hook in HOOKS can be the name of a hook or a list of the form -(HOOK DEPTH LOCAL), where each argument is the same as in -`add-hook'." - (declare (indent 1)) - (let* ((name (or (plist-get body :name) - (intern (format "%s/h" - (mapconcat - (lambda (h) - (string-remove-suffix - "-hook" (symbol-name (or (car-safe h) - h)))) - (ensure-list hooks) - "|"))))) - (args (or (plist-get body :args) nil)) - (doc (or (plist-get body :doc) nil)) - (forms ; (DEFUN . FUNCS) - (cl-loop for form in (def--delete2 body :name :args :doc) - if (eq (car form) 'function) - collect form into funcs - else collect form into defuns - finally return (cons defuns funcs))) - (defun-forms (car forms)) - (func-forms (cdr forms))) - `(progn - ,@(when defun-forms - `((defun ,name ,args ,@(when doc (list doc)) ,@defun-forms))) - ,@(cl-loop for hook in (ensure-list hooks) - for h = (or (car-safe hook) hook) - for ha = (cdr-safe hook) - if defun-forms - collect `(add-hook ',h #',name ,@ha) - append - (cl-loop for fn in func-forms - collect `(add-hook ',h ,fn ,@ha)))))) - -(provide 'def) -;;; def.el ends here diff --git a/lisp/graveyard.el b/lisp/graveyard.el new file mode 100644 index 0000000..89a776d --- /dev/null +++ b/lisp/graveyard.el @@ -0,0 +1,50 @@ +;;; graveyard.el --- stuff i'm not currently using right now + +;;; Commentary: + +;; I spent a long time configuring these packages! And they're misbehaving, +;; boo. So into the graveyard they go. + +;;; Code: + +(use-package emms + :ensure t + :init + (require 'emms-setup) + (autoload #'+emms-streams "+emms" nil t) + (defkeys t "C-c p s" #'+emms-streams) + (defhook (emms-playlist-mode-hook + emms-browser-mode-hook + emms-show-all-mode-hook) + #'hl-line-mode + #'show-paren-mode) + :config + (require '+emms) + (emms-all) + (emms-default-players) + (emms-browser-make-filter "all" #'ignore) + (emms-browser-make-filter "recent" + (lambda (track) + (< 30 (time-to-number-of-days + (time-subtract (current-time) + (emms-info-track-file-mtime + track)))))) + (emms-browser-set-filter (assoc "all" emms-browser-filters)) + (emms-history-load) + (emms-playing-time-mode -1) + :bind + (("C-c p p" . emms-pause) + ("C-c p b" . emms-browser) + ("C-c p l" . emms-playlist-mode-go)) + :custom + (emms-source-file-default-directory (expand-file-name "~/var/music/")) + (emms-source-playlist-default-format 'm3u) + (emms-playlist-mode-center-when-go t) + (emms-playlist-default-major-mode 'emms-playlist-mode) + (emms-player-mpv-update-metadata t) + (emms-browser-covers #'emms-browser-cache-thumbnail-async) + (emms-browser-thumbnail-small-size 64) + (emms-browser-thumbnail-medium-size 128) + (emms-streams-file (expand-file-name "streams.emms" + emms-source-file-default-directory)) + (emms-mode-line-mode-line-function nil)) diff --git a/lisp/init-org.el b/lisp/init-org.el new file mode 100644 index 0000000..d2d5e77 --- /dev/null +++ b/lisp/init-org.el @@ -0,0 +1,144 @@ +;;; init-org.el -*- lexical-binding: t; -*- + +(use-package org + :defer t + :custom + (org-adapt-indentation nil) + (org-auto-align-tags t) + (org-archive-mark-done t) + (org-fold-catch-invisible-edits 'show-and-error) + (org-clock-clocked-in-display 'mode-line) + (org-clock-string-limit 7) ; just the clock bit + + (org-clock-persist nil) + (org-confirm-babel-evaluate nil) + (org-cycle-separator-lines 0) + (org-directory (sync/ "org/" t)) + (org-fontify-done-headline t) + (org-fontify-quote-and-verse-blocks t) + (org-fontify-whole-heading-line t) + (org-hide-emphasis-markers t) + (org-html-coding-system 'utf-8-unix) + (org-image-actual-width (list (* (window-font-width) + (- fill-column 8)))) + (org-imenu-depth 3) + (org-indent-indentation-per-level 0) + (org-indent-mode-turns-on-hiding-stars nil) + (org-insert-heading-respect-content t) + (org-list-demote-modify-bullet '(("-" . "+") + ("+" . "-"))) + (org-log-done 'time) + (org-log-into-drawer t) + (org-num-skip-commented t) + (org-num-skip-unnumbered t) + (org-num-skip-footnotes t) + (org-outline-path-complete-in-steps nil) + (org-pretty-entities t) + (org-pretty-entities-include-sub-superscripts nil) + (org-refile-targets '((nil . (:maxlevel . 2)) + (org-agenda-files . (:maxlevel . 1)))) + (org-refile-use-outline-path 'file) + (org-special-ctrl-a/e t) + (org-special-ctrl-k t) + (org-src-fontify-natively t) + (org-src-tab-acts-natively t) + (org-src-window-setup 'current-window) + (org-startup-truncated nil) + (org-startup-with-inline-images t) + (org-tags-column 0) + (org-todo-keywords + '((sequence "TODO(t)" "WAIT(w@/!)" "ONGOING(o@)" + "|" "DONE(d!)" "ASSIGNED(a@/!)") + (sequence "|" "CANCELED(k@)") + (sequence "MEETING(m)"))) + (org-use-speed-commands t) + :config + (require '+org) + (defkeys org-mode-map + "C-M-k" #'kill-paragraph + "C-M-t" #'transpose-paragraphs + "RET" #'+org-return-dwim + "S-" #'+org-table-copy-down|+org-return-dwim + "C-c C-o" #'+org-open-at-point-dwim) + (setc org-ellipsis + (or (bound-and-true-p truncate-string-ellipsis) "…") + org-emphasis-alist + '(("*" org-bold) + ("/" org-italic) + ("_" org-underline) + ("=" org-verbatim) + ("~" org-code) + ("+" org-strikethrough))) + (defhook org-mode-hook + #'variable-pitch-mode + #'visual-fill-column-mode + #'turn-off-auto-fill + #'org-indent-mode + #'prettify-symbols-mode + #'abbrev-mode + (defhook ((before-save-hook nil :local)) + :name before-save@org-mode + (+org-hide-drawers-except-point) + (org-align-tags 'all)))) + +(use-package org-agenda + :custom + (org-agenda-skip-deadline-if-done t) + (org-agenda-skip-scheduled-if-done t) + (org-agenda-span 10) + (org-agenda-block-separator ?─) + (org-agenda-time-grid + '((daily today require-timed) + (800 1000 1200 1400 1600 1800 2000) + " ┄┄┄┄┄ " "┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄")) + (org-agenda-current-time-string + "← now ─────────────────────────────────────────────────") + (org-agenda-include-diary nil) ; I use the org-diary features + + (org-agenda-todo-ignore-deadlines 'near) + (org-agenda-todo-ignore-scheduled 'future) + (org-agenda-include-deadlines t) + (org-deadline-warning-days 0) + (org-agenda-show-future-repeats 'next) + (org-agenda-window-setup 'current-window) + (org-agenda-file-skip-regexp "sync-conflict") + :bind (("C-c a" . org-agenda)) + :config + (require '+org) + (advice-add 'org-agenda-files :filter-return #'org-agenda-files@skip-regexp) + (defhook org-agenda-mode-hook + (setq-local truncate-lines t) + #'hl-line-mode) + (defhook org-agenda-after-show-hook + #'org-narrow-to-subtree)) + +(use-package org-capture + :bind + (("C-c c" . org-capture))) + +(use-package ol ; org-link + :after org + :config + (require '+org) + (+org-link-define-type sms (number _)) + (+org-link-define-type tel (number _))) + +(use-package ox ; org-export + :defer t + :custom + (org-export-coding-system 'utf-8-unix) + (org-export-headline-levels 8) + (org-export-with-drawers nil) + (org-export-with-section-numbers nil) + (org-export-with-smart-quotes t) + (org-export-with-sub-superscripts t) + (org-export-with-toc nil) + :config + (require 'ox-md)) + +(use-package org-word-count + :load-path "~/src/emacs/org-word-count/" + :hook org-mode-hook) + +(provide 'init-org) +;;; init-org.el ends here diff --git a/lisp/org-word-count.el b/lisp/org-word-count.el deleted file mode 100644 index d6d2598..0000000 --- a/lisp/org-word-count.el +++ /dev/null @@ -1,297 +0,0 @@ -;;; org-word-count.el --- org-word-count in the modeline -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -(require 'org) -(require 'cl-lib) - -(defgroup org-word-count nil - "Extra fast word-counting in `org-mode'." - :group 'org) - -(defvar-local org-word-count-word-count nil - "Running total of words in this buffer.") - -(defvar-local org-word-count-string nil - "String for the modeline.") - -(defcustom org-word-count-format "%sw " - "Format for org word count in modeline." - :type 'string) - -(defcustom org-word-count-huge-string "huge" - "String to display with a huge buffer." - :type 'string) - -(defcustom org-word-count-update-after-funcs '(org-narrow-to-subtree - org-narrow-to-block - org-narrow-to-element - org-capture-narrow) - "Functions after which to update the word count." - :type '(repeat function)) - -(defcustom org-word-count-deletion-idle-timer 0.25 - "Length of time, in seconds, to wait before updating word-count." - :type 'number) - -(defcustom org-word-count-huge-change 5000 - "Number of characters that constitute a \"huge\" insertion." - :type 'number) - -(defcustom org-word-count-huge-buffer 10000 - "Number of words past which we're not going to try to count." - :type 'number) - -(defvar org-word-count-correction -5 - "Number to add to `org-word-count-word-count', for some reason? -`org-word-count-word-count' seems to consistently be off by 5. Thus -this correction. (At some point I should correct the underlying -code... probably).") - -(defvar-local org-word-count-update-timer nil) - -;;; Variables from org-wc - -(defun org-word-count-list-of-strings-p (arg) - (cl-every #'stringp arg)) - -(defun org-word-count--downcase-list-of-strings-set-default (var val) - (set-default var (mapcar #'downcase val))) - -(defcustom org-word-count-ignored-tags '("nowc" "noexport" "ARCHIVE") - "List of tags for which subtrees will be ignored in word counts" - :type '(repeat string) - :safe #'org-word-count-list-of-strings-p) - -(defcustom org-word-count-ignore-commented-trees t - "Ignore trees with COMMENT-prefix if non-nil." - :type 'boolean - :safe #'booleanp) - -(defcustom org-word-count-default-link-count 'description-or-path - "Default way of counting words in links. -This is applied to any link type not specified in any of -‘org-word-count-ignored-link-types’,‘org-word-count-one-word-link-types’, or -‘org-word-count-only-description-link-types’ " - :type '(choice - (const :tag "Count words in description or else path part of links" description-or-path) - (const :tag "Count words only in description part of links" description) - (const :tag "Count links as 0 words" ignore) - (const :tag "Count links as 1 word" oneword) - (const :tag "Count words only in path part of links" path)) - :safe 'symbolp) - -(defcustom org-word-count-ignored-link-types nil - "Link types which won't be counted as a word" - :type '(repeat string) - :safe #'org-word-count-list-of-strings-p) - -(defcustom org-word-count-one-word-link-types '("zotero") - "Link types which will be counted as one word" - :type '(repeat string) - :safe #'org-word-count-list-of-strings-p) - -(defcustom org-word-count-description-or-path-link-types '() - "Link types for which the description or the path should be counted" - :type '(repeat string) - :safe #'org-word-count-list-of-strings-p) - -(defcustom org-word-count-only-description-link-types '("note") - "Link types for which only the description should be counted" - :type '(repeat string) - :safe #'org-word-count-list-of-strings-p) - -(defcustom org-word-count-only-path-link-types '() - "Link types for which only the path should be counted" - :type '(repeat string) - :safe #'org-word-count-list-of-strings-p) - -(defcustom org-word-count-blocks-to-count '("quote" "verse") - "List of blocks which should be included in word count. - -Use lower case block names" - :type '(repeat string) - :safe #'org-word-count-list-of-strings-p - :set #'org-word-count--downcase-list-of-strings-set-default) - -(defun org-word-count-delayed-update (&rest _) - (if org-word-count-update-timer - (setq org-word-count-update-timer nil) - (setq org-word-count-update-timer - (run-with-idle-timer org-word-count-deletion-idle-timer nil - #'org-word-count-update)))) - -(defun org-word-count-force-update () - (interactive) - (message "Counting words...") - (when (timerp org-word-count-update-timer) - (cancel-timer org-word-count-update-timer)) - (org-word-count-update) - (message "Counting words...done")) - -(defun org-word-count-update (&rest _) ; Needs variadic parameters, since it's advice - (dlet ((org-word-count-counting t)) - (org-word-count-buffer) - (org-word-count-modeline) - (setq org-word-count-update-timer nil))) - -(defun org-word-count-changed (start end length) - (org-word-count-delayed-update)) - -(defun org-word-count-buffer () - "Count the words in the buffer." - (when (and (derived-mode-p 'org-mode) - (not (eq org-word-count-word-count 'huge))) - (setq org-word-count-word-count - (cond - ((> (count-words (point-min) (point-max)) - org-word-count-huge-buffer) - 'huge) - (t (org-word-count-aux (point-min) (point-max))))))) - -;;; From org-wc.el: -;; https://github.com/tesujimath/org-wc/ -(defun org-word-count-aux (beg end) - "Return the number of words between BEG and END." - (let ((wc 0) - subtreecount - (latex-macro-regexp "\\\\[A-Za-z]+\\(\\[[^]]*\\]\\|\\){\\([^}]*\\)}")) - (save-excursion - (goto-char beg) - ;; Handle the case where we start in a drawer - (when (org-at-drawer-p) - (org-end-of-meta-data t)) - (while (< (point) end) - (cond - ;; Handle headlines and subtrees - ((org-at-heading-p) - (cond - ;; Ignore commented and org-wc-ignored-tags trees - ((or (and org-word-count-ignore-commented-trees (org-in-commented-heading-p)) - (cl-intersection org-word-count-ignored-tags (org-get-tags) :test #'string=)) - (org-end-of-subtree t t)) - ;; Re-use count for subtrees already counted - ((setq subtreecount (get-text-property (point) :org-wc)) - (cl-incf wc subtreecount) - (org-end-of-subtree t t)) - ;; Skip counting words in headline - (t (org-word-count--goto-char (point-at-eol) end)))) - ;; Ignore most blocks. - ((when (save-excursion - (beginning-of-line 1) - (looking-at org-block-regexp)) - (if (member (downcase (match-string 1)) org-word-count-blocks-to-count) - (progn ;; go inside block and subtract count of end line - (org-word-count--goto-char (match-beginning 4) end) - (cl-decf wc)) - (org-word-count--goto-char (match-end 0) end)))) - ;; Ignore comments. - ((org-at-comment-p) - (org-word-count--goto-char (point-at-eol) end)) - ;; Ignore drawers. - ((org-at-drawer-p) - (org-end-of-meta-data t)) - ;; Ignore all other #+ lines - ((looking-at "#+") - (org-word-count--goto-char (point-at-eol) end)) - ;; Handle links - ((save-excursion - (when (< (1+ (point-min)) (point)) (backward-char 2)) - (looking-at org-link-bracket-re)) - (let* ((type (car (save-match-data (split-string (match-string 1) ":")))) - (pathstart (+ 1 (length type) (match-beginning 1)))) - (cl-case (cond ((member type org-word-count-ignored-link-types) 'ignore) - ((member type org-word-count-one-word-link-types) 'oneword) - ((member type org-word-count-only-description-link-types) - 'description) - ((member type org-word-count-only-path-link-types) 'path) - ((member type org-word-count-description-or-path-link-types) - 'description-or-path) - (t org-word-count-default-link-count)) - (ignore (org-word-count--goto-char (match-end 0) end)) - (oneword (org-word-count--goto-char (match-end 0) end) - (cl-incf wc)) - (description (if (match-beginning 2) - (goto-char (match-beginning 2)) - (org-word-count--goto-char - (match-end 0) end))) - (path (cl-incf wc (count-words-region pathstart - (match-end 1))) - (org-word-count--goto-char (match-end 0) end)) - (description-or-path - (if (match-beginning 2) - (goto-char (match-beginning 2)) - (cl-incf wc (count-words-region pathstart - (match-end 1))) - (org-word-count--goto-char (match-end 0) end))) - (t (user-error "Error in org-word-count link configuration"))))) - ;; Count latex macros as 1 word, ignoring their arguments. - ((save-excursion - (when (< (point-min) (point)) (backward-char)) - (looking-at latex-macro-regexp)) - (org-word-count--goto-char (match-end 0) end) - (cl-incf wc)) - (t - (and (re-search-forward "\\w+\\W*" end 'skip) - (cl-incf wc)))))) - wc)) - -(defun org-word-count--goto-char (char end) - "Moves point to CHAR and from there passes 0+ non-word characters. -Searchers to end as a maximum. - -This ensures that we are in an expected state (at the first word -character after some non-word characters) after moving beyond -headlines, links etc." - (goto-char char) - (re-search-forward "\\W*" end 'skip)) - -(defvar org-word-count-counting nil - "Are we currently counting?") - -(defun org-word-count-recount-widen (&rest _) - (when (and (not org-word-count-counting)) - (org-word-count-update))) - -(defun org-word-count-modeline () - (setq org-word-count-string - (cond - ((eq org-word-count-word-count 'huge) - org-word-count-huge-string) - (org-word-count-word-count - (format org-word-count-format - (max 0 (+ org-word-count-word-count - org-word-count-correction)))))) - (force-mode-line-update)) - -(define-minor-mode org-word-count-mode - "Count words in `org-mode' buffers in the mode-line." - :lighter "" - :keymap (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-c C-.") #'org-word-count-force-update) - map) - (cond (org-word-count-mode - (org-word-count-buffer) - (add-hook 'after-change-functions - #'org-word-count-delayed-update nil t) - (unless (member '(org-word-count-mode org-word-count-string) - mode-line-misc-info) - (add-to-list 'mode-line-misc-info - '(org-word-count-mode org-word-count-string) - nil - #'equal)) - (dolist (fn org-word-count-update-after-funcs) - (advice-add fn :after #'org-word-count-update))) - (:else - (remove-hook 'after-change-functions - #'org-word-count-delayed-update t) - (setf mode-line-misc-info - (delete '(org-word-count-mode org-word-count-string) - mode-line-misc-info)) - (dolist (fn org-word-count-update-after-funcs) - (advice-remove fn #'org-word-count-update))))) - -(provide 'org-word-count) -;;; org-word-count.el ends here diff --git a/lisp/pita.el b/lisp/pita.el deleted file mode 100644 index ed67c92..0000000 --- a/lisp/pita.el +++ /dev/null @@ -1,69 +0,0 @@ -;;; pita.el --- wrappers making emacs less of a PITA -*- lexical-binding: t -*- -;; 🥙 - -;;; utils - -(defun walk-tree-replace (tree find replace) - (let ((r nil)) - (dolist (form tree) - (push (cond ((eq find form) replace) - ((listp form) - (walk-tree-replace form find replace)) - (t form)) - r)) - (reverse r))) - -;;; crux advices -;; these should all go :before the function they're advising. - -(defun with-region-or-buffer (&rest _) - (interactive (if mark-active - (list (region-beginning) (region-end)) - (list (point-min) (point-max))))) - -(defun with-region-or-line (&rest _) - (interactive (if mark-active - (list (region-beginning) (region-end)) - (list (line-beginning-position) (line-end-position))))) - -(defun with-region-or-to-eol (&rest _) - (interactive (if mark-active - (list (region-beginning) (region-end)) - (list (point) (line-end-position))))) - -;;; wrappers - -(defmacro with-message (msg &rest body) - (declare (indent 1)) - (when (listp msg) - (setq msg (apply #'format (car msg) (cdr msg)))) - (when (string-match "[[:alnum:]]\\'" msg) - (setq msg (concat msg "..."))) - (let ((m (gensym)) - (r (gensym))) - `(let ((,m ,msg) - (,r nil)) - (condition-case e - (setq r (progn (message ,m) ,@body)) - (:success (message "%s done" ,m) r) - (t (signal (car e) (cdr e))))))) - -(defmacro with-pr (msg &rest body) - (declare (indent 1)) - (when (listp msg) - (setq msg (apply #'format (car msg) (cdr msg)))) - (when (string-match "[[:alnum:]]\\'" msg) - (setq msg (concat msg "..."))) - (let ((pr (gensym)) - (m (gensym))) - `(let* ((,m ,msg) - (,pr (unless (minibufferp) - (make-progress-reporter ,m)))) - ,@(or (and pr (walk-tree-replace body '@ `(progress-reporter-update ,pr))) - body) - (and ,pr (progress-reporter-done ,pr))))) - -;;; wrapper advice - -(provide 'pita) -;;; pita.el ends here diff --git a/lisp/private.el b/lisp/private.el deleted file mode 100644 index 4f6115e..0000000 --- a/lisp/private.el +++ /dev/null @@ -1,23 +0,0 @@ -;;; private.el -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -(require 'acdw) - -(defgroup private nil - "Private things are private. Shhhhh....") - -;; Private directory - -(+define-dir private/ (sync/ "emacs/private") - "Private secretive secrets inside.") -(add-to-list 'load-path private/) - -;; Load random private stuff - -(require '_acdw) - -(provide 'private) -;;; private.el ends here diff --git a/lisp/scule.el b/lisp/scule.el deleted file mode 100644 index 3ed58bb..0000000 --- a/lisp/scule.el +++ /dev/null @@ -1,61 +0,0 @@ -;;; scule.el --- -scule twiddling -*- lexical-binding: t; -*- - -;; Copyright (C) 2022 Case Duckworth - -;; Author: Case Duckworth -;; Keywords: convenience - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Commentary: - -;; DWIM functions for twiddling "scule", or text case (a fancy word for "upper -;; case" is "magiscule", for example, and "lower case" is "miniscule"). - -;;; Code: - -(require 'thingatpt) - -;;; Utility macro -;;;###autoload -(defmacro defscule (name &optional region-fn word-fn) - (let ((fn-name (intern (format "scule-%s" name))) - (region-fn (or region-fn (intern (format "%s-region" name)))) - (word-fn (or word-fn (intern (format "%s-word" name))))) - `(defun ,fn-name (arg) - ,(concat (capitalize (symbol-name name)) " words in the region if active, or word at point.\n" - "If the region is active, call `" (symbol-name region-fn) "'.\n" - "Otherwise, it calls `" (symbol-name word-fn) "' on the word at point and\n" - "the following ARG - 1 words.") - (interactive "*p") - (if (use-region-p) - (,region-fn (region-beginning) (region-end) (region-noncontiguous-p)) - (let ((word-bound (save-excursion - (skip-chars-forward "^[:word:]") - (bounds-of-thing-at-point 'word)))) - (when (and (car word-bound) (cdr word-bound)) - (,region-fn (car word-bound) (cdr word-bound)) - (goto-char (cdr word-bound)) - (,word-fn (1- arg)))))))) - -;;;###autoload -(progn (defscule upcase) - (autoload 'scule-upcase "scule" nil t) - (defscule downcase) - (autoload 'scule-downcase "scule" nil t) - (defscule capitalize) - (autoload 'scule-capitalize "scule" nil t)) - -(provide 'scule) -;;; scule.el ends here diff --git a/lisp/upload-junk.el b/lisp/upload-junk.el new file mode 100644 index 0000000..5a9da84 --- /dev/null +++ b/lisp/upload-junk.el @@ -0,0 +1,47 @@ +;;; upload-junk.el --- Upload junk -*- lexical-binding: t; -*- + +;;; Code: + +(require 'tramp) + +(defvar upload-junk-ssh-host "hetzner" + "SSH host to upload to.") + +(defvar upload-junk-ssh-root "/junk" + "SSH root folder to upload to.") + +(defvar upload-junk-web-host "https://junk.acdw.net" + "Web host to link uploads to.") + +(defun upload-junk-file-name (&optional file) + "Return the uploaded filename for FILE." + (let ((file (or file "_.txt"))) + (format "tmp_%s_%x%x.%s" + (file-name-nondirectory (file-name-sans-extension file)) + (time-convert (current-time) 'integer) + (random (* 8 8 8 8)) + (or (file-name-extension file) "txt")))) + +(defun upload-junk-region (start end) + "Upload region from START to END to my server." + (interactive "r") + (let* ((s (buffer-substring-no-properties start end)) + (f (upload-junk-file-name (buffer-file-name))) + (w (format "%s/%s" upload-junk-web-host f))) + (with-temp-buffer + (insert s) + (write-file (format "/sshx:%s:%s/%s" + upload-junk-ssh-host + upload-junk-ssh-root + f))) + (kill-new w) + w)) + +(defun upload-junk-region-or-buffer () + (interactive) + (if (region-active-p) + (upload-junk-region (region-beginning) (region-end)) + (upload-junk-region (point-min) (point-max)))) + +(provide 'upload-junk) +;;; upload-junk.el ends here diff --git a/lisp/yoke.el b/lisp/yoke.el index 8ca94fd..ec84f56 100644 --- a/lisp/yoke.el +++ b/lisp/yoke.el @@ -1,271 +1,360 @@ -;;; yoke.el --- make your editor work for YOU -*- lexical-binding: t; -*- -;; Copyright (C) 2022 C. Duckworth +;;; yoke.el --- Yoke configuration into your config -*- lexical-binding: t; -*- + +;; Copyright (C) 2022 Case Duckworth + +;; Author: Case Duckworth +;; Keywords: convenience +;; Package-Version: 0.61803398875 +;; Homepage: https://junk.acdw.net/yoke.el +;; Package-Requires: ((emacs "28.1")) + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . ;;; Commentary: -;; What's the most basic functionality of a package manager? In my view, all a -;; package manager should do is fetch packages from wherever they are, and -;; provide the system with a method of accessing those packages' functionality. -;; In Emacs, this means downloading packages from the Internet and adding their -;; directories to `load-path'. That's what `yoke' tries to do. -;; -;; In fact, that's /all/ `yoke' tries to do, on the package front. It doesn't -;; automatically fetch dependencies. It doesnt' do much else of anything -;; --- hell, it doesn't have to generate autoloads or build the dang source -;; files if you don't want it to. /I/ have it do those things because I like a -;; few creature comforts, but you can turn 'em off. -;; -;; Instead of focusing too much on installing packages, `yoke' works harder to -;; group---to "yoke together," if you will---related configurations together, à -;; la `use-package' or `setup'. I used both of those packages before and found -;; each somewhat lacking, and what I really wanted was a fancy `progn' that I -;; could put whatever I want inside. So that's basically what `yoke' is. It's -;; a configuration macro that automatically fetches packages from their repos -;; and tells Emacs where they are, then executes its body in a `cl-block' for -;; ... reasons. That's it. +;; THIS IS A WORK IN PROGRESS. DON'T USE IT. ;;; Code: (require 'cl-lib) +(require 'package-vc) -;;; Customization options +;;; User options (defgroup yoke nil "Customizations for `yoke'." - :group 'applications + :group 'convenience :prefix "yoke-") -(defcustom yoke-dir (locate-user-emacs-file "yoke") +(defcustom yoke-directory package-user-dir "Where to put yoked packages." :type 'file) -(defcustom yoke-get-default-fn #'yoke-get-git - "Default function to get packages with." - :type 'function) +(defcustom yoke-cache-directory (locate-user-emacs-file "yoke-cache" + "~/.yoke-cache") + "Where to put cached yoke files, like downloaded HTTP packages." + :type 'file) + +(defcustom yoke-debug-on-error nil + "Whether to throw up the debugger on a yoke error. +If nil, errors will be inserted in the `yoke-message-buffer'.") + +;;; Variables + +(defvar yoke-message-buffer " *yoke*" + "The buffer used for yoke messages.") + +(defvar yoke-selected-packages nil + "List of packages managed by `yoke'.") + +(defvar yoke-backends '(file http package) + "Backends handled by `yoke'.") + +;;; Main functionality + +(defmacro yoke (package &rest body) + "Yoke a package into your Emacs session. +PACKAGE is either a symbol, in which case `yoke' expands to +basically a named `progn' (good for grouping configuration), or a +list of the form (NAME . ARGS), where ARGS can be one of the +following: + +- nil: install NAME using `package'. +- a property list describing a package specification. Valid + key/value pairs include + + `:backend' (symbol) + A symbol of the yoke backend to use for installing the + package. See `yoke-backends' for allowed backends. + + `:url' (string) + The URL of the package's repository or source. + + `:lisp-dir' (string) + The repository-relative name of the directory to use for + loading lisp sources. If not given, it defaults to the + repo's root directory. -(defvar yoke-buffer "*yoke*" - "Buffer to use for yoke process output.") + Other pairs may be valid for a given backend; see that + backend's `yoke-install' function for more details. -(defvar yoke-dirs nil - "List of directories managed by `yoke'.") +BODY is executed in a `condition-case' so that errors won't keep +the rest of Emacs from initializing. BODY can also be prepended +by the following keyword arguments: -;;; GET YOKED + `:after' (FEATURE...) -(defmacro yoke (package - &rest body) - "Yoke PACKAGE to work with your Emacs. -Execute BODY afterward. + `:require' (FEATURE...) -\(fn (PACKAGE [REPO REPO-KEYWORDS]) [BODY-KEYWORDS] BODY...)" + `:depends' (PACKAGE-SPEC...) + + `:build' (ACTION...) + + `:unless' (PREDICATE) + + `:when' (PREDICATE) + +Other keywords are ignored. + +\(fn (PACKAGE [SPEC]) [BODY-ARGS] BODY...)" (declare (indent 1)) - (let* (;; State - (pkg (cond ((consp package) (car package)) - (:else package))) - (url (cond ((consp package) (cdr package)) - (:else nil))) - (pname (intern (format "yoke:%s" pkg))) - (dirvar '$yoke-dir) - ;; Keyword args --- TODO: Naming could probably be better. + (let* ((name (or (car-safe package) package)) + (backend (yoke--pget package :backend)) + ;; Body keyword arguments (after (plist-get body :after)) (depends (plist-get body :depends)) + (req (plist-get body :require)) + (buildp (plist-member body :build)) + (build (plist-get body :build)) (whenp (plist-member body :when)) + (when (if whenp (plist-get body :when) t)) (unlessp (plist-member body :unless)) - (when (cond (whenp (plist-get body :when)) - (:else t))) - (unless (cond (unlessp (plist-get body :unless)) - (:else nil))) - (autoload (cond ((plist-member body :autoload) - (plist-get body :autoload)) - (:else t))) - (pre (plist-get body :pre)) + (unless (if unlessp (plist-get body :unless) nil)) ;; Body - (body (cl-loop for (this next) on body by #'cddr - unless (keywordp this) - append (list this next) into ret - finally return (cond ((eq (car (last ret)) nil) - (butlast ret)) - (:else ret)))) - (r (gensym))) - `(let ((,r (cl-block ,pname -(condition-case err - (progn - ;; Pass `:when' or `:unless' clauses - ,@(cond - ((and whenp unlessp) - `((when (or (not ,when) ,unless) - (cl-return-from ,pname - (format "%s (abort) :when %S :unless %S" - ',pname ',when ',unless))))) - (whenp - `((unless ,when (cl-return-from ,pname - (format "%s (abort) :when %S" - ',pname ',when))))) - (unlessp - `((when ,unless (cl-return-from ,pname - (format "%s (abort) :unless %S" - ',pname ',unless)))))) - ;; Evaluate `:pre' forms - ,@pre - ;; Get prerequisite packages - ,@(cl-loop - for (pkg* . yoke-get-args) in depends - collect `(or - (let* ((pkg-spec (yoke-get ,@yoke-get-args - :dir ,(format "%s" pkg*))) - (dir (expand-file-name (or (plist-get (cdr pkg-spec) :load) - "") - (car pkg-spec)))) - (and dir - ,@(if autoload - `((yoke-generate-autoloads ',pkg* dir)) - '(t)) - (add-to-list 'yoke-dirs dir nil #'string=))) - (cl-return-from ,pname - (format "Error fetching prerequiste: %s" - ',pkg*)))) - ;; Download the package, generate autoloads - ,@(when url - `((let* ((pkg-spec (yoke-get ,@url :dir ,(format "%s" pkg))) - (,dirvar (expand-file-name (or (plist-get (cdr pkg-spec) :load) - "") - (car pkg-spec)))) - ,@(when autoload - `((yoke-generate-autoloads ',pkg ,dirvar))) - (add-to-list 'yoke-dirs ,dirvar nil #'string=)))) - ;; Evaluate the body, optionally after the features in `:after' - ,@(cond (after - `((yoke-eval-after ,after ,@body))) - (:else body))) - (:success ',package) - (t (message "%s: %s (%s)" ',pname (car err) (cdr err)) - nil))))) - (when (stringp ,r) (message "%S" ,r)) - ,r))) - -(defun yoke-get (url &rest args) - "\"Get\" URL and and put it in DIR, then add DIR to `load-path'. -URL can be a string or a list of the form (TYPE URL). The -download will be dispatched to the TYPE, or to -`yoke-get-default-fn' if only a string is given. -ARGS is a plist with the following possible keys: - -:dir DIRECTORY --- the directory to put the URL. -:load DIRECTORY --- the directory (relative to the download path) - to add to `load-path'. -:type TYPE --- one of `http', `git', or `file' --- how to - download URL." - (let* ((dir (plist-get args :dir)) - (load (plist-get args :load)) - (type (or (plist-get args :type))) - (path (cond - ((eq type 'http) (yoke-get-http url dir)) - ((or (eq type 'git) - (string-match-p (rx bos "git:") url)) - (yoke-get-git url dir)) - ((or (eq type 'file) - (string-match-p (rx bos (or "file:" "~" "/")) url)) - (yoke-get-file url dir)) - ((stringp url) - (funcall yoke-get-default-fn url dir)) - (:else (error "Uknown URL type: %S" url))))) - (cond - ((file-exists-p path) - (add-to-list 'load-path (expand-file-name (or load "") path)) - (cons path args)) - (:else (error "Directory \"%s\" doesn't exist." path) - nil)))) - -(defun yoke-get--guess-directory (path &optional dir) - "Guess directory from PATH and DIR, and return it. -If DIR is present and relative, resolve it relative to -`yoke-dir', or if it's absolute, leave it as-is. If DIR is -absent, return the final component of PATH resolved relative to -`yoke-dir'." - (expand-file-name (or dir (file-name-nondirectory path)) - yoke-dir)) - -(defun yoke-get-http (url &optional dir) - "Download URL to DIR and return its directory. -If DIR isn't given, it's guessed from the final component of the -URL's path and placed under `yoke-dir'." - (let* ((dir (yoke-get--guess-directory url dir)) - (basename (file-name-nondirectory url)) - ;; XXX: Is this the best idea?? PROBABLY NOT!!! Ideally I'd have - ;; a parameter (either dynamic var or passed in) that would give the - ;; name of the downloaded file. But that would take a bit of - ;; re-engineering, I think. So for now, it stays thus. - (filename (expand-file-name - (replace-regexp-in-string - (rx "-" (+ digit) ; major version - (+ (group "." (+ digit))) ; following version numbers - (group "." (+ (not space)))) ; extension - "\\2" - basename) - dir))) - (cond ((file-exists-p filename) - dir) - (:else - (message "Downloading %s..." url) - (with-current-buffer (let ((url-debug t)) - (url-retrieve-synchronously url)) - (condition-case e - (progn - (goto-char (point-min)) - (delete-region (point) (+ 1 (re-search-forward "^$"))) - (make-directory dir :parents) - (write-file filename 1) - (message "Downloading %s... Done" url)) - (:success dir) - (t (signal (car e) (cdr e))))))))) - -(defun yoke-get-git (repo &optional dir) - "Clone REPO to DIR and return its directory. -If DIR isn't given, it's guessed from the repo's name and put -under `yoke-dir'. Return the cloned directory's name on success, -or nil on failure." - (let ((dir (yoke-get--guess-directory repo dir))) - (cond ((file-exists-p dir) - dir) - (:else - (message "Cloning %s..." repo) - (pcase (call-process "git" nil (get-buffer-create yoke-buffer) nil - "clone" repo dir) - (0 (message "Cloning %s... Done" repo) - dir) - (_ (message "Cloning %s... Error! See buffer %s for output." - repo yoke-buffer) - nil)))))) - -(defun yoke-get-file (file &optional _dir) - "Add FILE's directory to `load-dir'. -_DIR is ignored." - (file-name-directory file)) - -(defun yoke-generate-autoloads (package dir) - "Generate autoloads for PACKAGE in DIR." - ;; Shamelessly stolen from `straight'. - (eval-and-compile (require 'autoload)) - (let ((generated-autoload-file - (expand-file-name (format "%s-autoloads.el" package) dir)) - (backup-inhibited t) - (version-control 'never) - (message-log-max nil) - (inhibit-message t)) - (unless (file-exists-p generated-autoload-file) - (let ((find-file-hook nil) - (write-file-functions nil) - (debug-on-error nil) - (left-margin 0)) - (if (fboundp 'make-directory-autoloads) - (make-directory-autoloads dir generated-autoload-file) - (and (fboundp 'update-directory-autoloads) - (update-directory-autoloads dir))))) - (when-let ((buf (find-buffer-visiting generated-autoload-file))) - (kill-buffer buf)) - (load generated-autoload-file :noerror :nomessage) - t)) - -;;; Evaluating forms after features + (body (let ((b body) r) + (while (consp b) + (if (keywordp (car b)) + (setf b (cdr b)) + (setf r (cons (car b) r))) + (setf b (cdr b))) + (reverse r))) + (esym (make-symbol "yoke-error"))) + ;; Body modifiers. These are applied in reverse order (that is, the last + ;; one will be on the outside). + ;; --- Require the current package + (when req + (setf body + (append (let (reqs) + (dolist (r (ensure-list req) reqs) + (let* ((feat (if (eq r t) name r)) + (+feat (intern (format "+%s" feat)))) + (push `(require ',feat) reqs) + (push `(require ',+feat nil :noerror) reqs))) + (reverse reqs)) + body))) + ;; --- Install the package + (when (consp package) + (push `(yoke-install ',(car package) ,@(cdr package)) + body)) + ;; --- Dependencies + (when depends + (setf body + (append (cl-loop for dep in (ensure-list depends) + collect `(or (yoke-install ',@(ensure-list dep)) + (error "Dependency (%s): %S" + ',dep ',package))) + body))) + ;; --- Load after + (when after + (setf body `((yoke--eval-after ,(cl-subst name t after) ,@body)))) + ;; --- Conditional expansion + (when (or whenp unlessp) + (setf body + (append (cond + ((and whenp unlessp) + `((when (or (not ,when) ,unless) + (signal 'yoke-predicate + '(:when ,when :unless ,unless))))) + (whenp + `((unless ,when (signal 'yoke-predicate + '(:when ,when))))) + (unlessp + `((when ,unless (signal 'yoke-predicate + '(:unless ,unless)))))) + body))) + ;; Expansion + `(condition-case ,esym + (cl-letf (((symbol-function 'package--save-selected-packages) + #'ignore)) + ;; Body + ,@body) + (:success + ,(unless (atom package) + `(setf (alist-get ',name yoke-selected-packages) + (list ,@(cdr-safe package)))) + ',package) + (t ,(if yoke-debug-on-error + `(signal (car ,esym) (cdr ,esym)) + `(message "(yoke) %s: %s" (car ,esym) (cdr ,esym))))))) + +;;; Installing packages + +(defun yoke-install (name &rest args) + "Install package NAME, with ARGS." + (let ((custom-file null-device) + (inhibit-message (and (not (plist-member args :update)) + (not debug-on-error))) + (messages-buffer-name yoke-message-buffer)) + (funcall + (intern + (format "yoke-install-%s" + (or (plist-get args :backend) + (yoke--guess-backend (plist-get args :url)) + 'package))) + name args)) + (yoke--clean-load-path) + ;; Don't return nil + t) + +(defun yoke-install-package (name args &optional tries) + "Install package NAME with ARGS using `package' machinery. +TRIES is an internal variable." + (let ((package-user-dir yoke-directory) + (url (plist-get args :url)) + (update (plist-get args :update)) + (dirname (expand-file-name (format "%s" name) + yoke-directory)) + (tries (or tries 0)) + load-dir autoloads-file-name) + (unless (file-exists-p dirname) + (setq dirname (or (car-safe (file-expand-wildcards + (concat dirname "*"))) + dirname))) + (setq load-dir + (expand-file-name (or (plist-get args :lisp-dir) "") dirname) + generated-autoload-file + (expand-file-name (format "%s-autoloads.el" name) load-dir)) + (prog1 + (condition-case error + (cond + ;; -- Commented on 2022-12-21 + ;; ((and (file-exists-p dirname) + ;; (not update)) + ;; (add-to-list 'load-path + ;; (expand-file-name + ;; (or (plist-get args :lisp-dir) "") + ;; dirname) + ;; nil #'equal) + ;; (require (intern (format "%s-autoloads" name)))) + ((and url update) + (package-vc-update (cadr (assoc name package-alist)))) + (update + (package-update name)) + (url + ;; I'm going to be honest here, this is extremely cursed. But I + ;; don't want to get asked about installing the packages, and when + ;; the user answers 'no', the function errors. So.. this. + (cl-letf (((symbol-function 'yes-or-no-p) #'ignore)) + (ignore-errors (package-vc-install (cons name args))))) + (:else + (package-install name))) + (file-error (if (> tries 1) + (error "(yoke) Can't install `%s'" name) + (package-refresh-contents) + (yoke-install-package name args (1+ tries))))) + (add-to-list 'load-path load-dir nil #'equal) + (loaddefs-generate load-dir generated-autoload-file) + ;; Do it again, if it doesn't actually /generate/ anything + (when (eq 'provide + (with-current-buffer (find-file-noselect generated-autoload-file) + (read (buffer-substring (point-min) (point-max))))) + (loaddefs-generate load-dir generated-autoload-file nil nil nil + :generate-full)) + (load generated-autoload-file :noerror) + (kill-buffer (get-file-buffer generated-autoload-file)) + (package-activate name)))) + +(defun yoke-install-http (name args) + "Install a package NAME using ARGS from an http source." + (let* ((url (plist-get args :url)) + (cached (expand-file-name (file-name-nondirectory url) + yoke-cache-directory)) + (update (plist-get args :update))) + (unless url + (error "No URL for HTTP download: %S" (cons name args))) + (when (or (not (file-exists-p cached)) + update) + (make-directory yoke-cache-directory :parents) + (message "Downloading `%s'..." url) + (let* ((url-debug t) + (buf (url-retrieve-synchronously url))) + (with-current-buffer buf + (goto-char (point-min)) + (delete-region (point) (1+ (re-search-forward "^$"))) + (write-file cached 1) + (message "Downloading `%s'...Done." url)))) + (package-install-file cached))) + +(defun yoke-install-file (name args) + "Install package NAME using ARGS from a file on-disk." + (let ((url (plist-get args :url)) + (update (plist-get args :update)) + (dirname (expand-file-name (format "%s" name) yoke-directory))) + (if (file-exists-p url) + ;; This takes care of updating too. + (package-install-file url) + (error "(yoke) No such file: `%s'" url)))) + +;;; Other package transactions + +(defun yoke--choose-package () + "Choose a package from `yoke-selected-packages'." + (assoc (intern (completing-read "Package: " yoke-selected-packages)) + yoke-selected-packages)) + +(defun yoke-update (name &rest args) + (interactive (yoke--choose-package)) + (save-window-excursion + (apply #'yoke-install name (append '(:update t) + args)))) + +(defun yoke-update-all () + (interactive) + (dolist (pkg yoke-selected-packages) + (apply #'yoke-update pkg))) + +;;; Emacs integration + +(defun yoke-imenu-insinuate () + "Insinuate `yoke' forms for `imenu'." + (require 'imenu) + (setf (alist-get "Yoke" imenu-generic-expression nil nil #'equal) + (list "(yoke[[:space:]]*(?\\([^\t\n )]*\\)" + 1)) + (with-eval-after-load 'consult-imenu + (setf (alist-get ?y (plist-get (alist-get 'emacs-lisp-mode + consult-imenu-config) + :types)) + '("Yoke")))) + +;;; Utility functions + +(defun yoke--pget (spec prop &optional default) + "Get PROP's value from SPEC, a yoke specification. +If KEY doesn't exist, return DEFAULT." + (let ((pl (or (and (plistp spec) spec) + (cdr-safe spec)))) + (if (plist-member pl prop) + (plist-get pl prop) + default))) + +(defun yoke--guess-backend (url) + "Guess the backend to use from URL. +If inconclusive, return nil." + (cond + ((or (string-prefix-p "file:" url t) + (string-prefix-p "~" url) + (string-prefix-p "/" url)) + 'file) + (:else nil))) + +(defun yoke--clean-load-path () + (when-let ((first (string-remove-suffix "/" (car load-path))) + (second (string-remove-suffix "/" (cadr load-path))) + (_ (equal first second))) + (setf load-path (cdr load-path)) + (setf (car load-path) second))) (defun yoke--eval-after-init (fn) "Evaluate FN after inititation, or now if Emacs is initialized. @@ -274,79 +363,30 @@ FN is called with no arguments." (funcall fn) (add-hook 'after-init-hook fn))) -(defmacro yoke-eval-after (features &rest body) - "Evaluate BODY, but only after loading FEATURES. -FEATURES can be an atom or a list; as an atom it works like -`with-eval-after-load'. The special feature `init' will evaluate -BODY after Emacs is finished initializing." - (declare (indent 1) - (debug (form def-body))) - (unless (listp features) - (setf features (list features))) - (if (null features) - (macroexp-progn body) - (let* ((this (car features)) - (rest (cdr features))) - (cond ((eq this 'init) - `(yoke--eval-after-init - (lambda () (yoke-eval-after ,rest ,@body)))) - (:else - `(with-eval-after-load ',this - (yoke-eval-after ,rest ,@body))))))) +(defmacro yoke--eval-after (prereqs &rest body) + "Evaluate body after PREREQS. +PREREQS can be a feature, a number, `:init', or a list of those. -;;; Integration +Features are used as arguments to `eval-after-load'. Numbers are +used as arguments to `run-with-idle-timer'. `:init' will ensure BODY +runs after Emacs's init time. -(defun yoke-imenu-insinuate () - "Insinuate `yoke' forms for `imenu'." - (require 'imenu) - (setf (alist-get "Yoke" imenu-generic-expression nil nil #'equal) - (list (rx (: "(yoke" (+ space) (? "(") - (group (+ (not (or "(" " " "\t" "\n")))) - (* any))) - 1))) - -;;; Package maintenance - -(defvar yoke--all "*all*" - "Value that `yoke--prompt-for-package' uses for all packages.") - -(defun yoke--choose-packages (prompt &optional onep) - "Choose from all of yoke's installed packages." - (funcall (if onep #'completing-read #'completing-read-multiple) - prompt - (cons yoke--all yoke-dirs) - nil :require-match nil nil - (unless onep yoke--all))) - -(defun yoke--choices (&optional selections) - "Either the SELECTIONS given, or all of `yoke-dirs'. -If `yoke--all' is part of SELECTIONS, or if it's not given, -return the full list of `yoke-dirs'." - (cond ((or (null selections) - (member yoke--all selections)) - yoke-dirs) - (:else selections))) - -(defun yoke-compile (&rest packages) - "Compile all elisp files in `yoke-dirs'." - (interactive (yoke--choose-packages "Compile packages: ")) - (dolist (dir (yoke--choices packages)) - (byte-recompile-directory dir 0))) - -(defun yoke-update-autoloads (&rest packages) - "Update the autoloads in PACKAGES' directories." - (interactive (yoke--choose-packages "Generate autoloads for packages: ")) - (dolist (dir (yoke--choices packages)) - (message "Generating autoloads for %s..." dir) - (yoke-generate-autoloads (file-name-nondirectory dir) dir) - (message "Generating autoloads for %s... Done" dir))) - -(defun yoke-remove (dir) - "Remove DIR from `yoke-dir'." - (interactive - (list (completing-read "Remove: " yoke-dirs - nil :require-match))) - (delete-directory dir :recursive :trash)) +When given a list of PREREQS, `eval-after' will nest each one +from left to right." + (declare (indent 1) (debug (form def-body))) + (setf prereqs (ensure-list prereqs)) + (if (null prereqs) + (macroexp-progn body) + (let* ((this (car prereqs)) + (form `((lambda () (yoke--eval-after ,(cdr prereqs) ,@body))))) + (cond + ((eq this :init) + (append '(yoke--eval-after-init) form)) + ((numberp this) + (append `(run-with-idle-timer ,this nil) form)) + ((symbolp this) + (append `(eval-after-load ',this) form)) + (:else (user-error "Eval-after: Bad prereq: %S" this)))))) (provide 'yoke) ;;; yoke.el ends here -- cgit 1.4.1-21-gabe81