From 33c7ddb09e0eae0796686c64ffa022a181145cc1 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Wed, 4 Jan 2023 23:21:15 -0600 Subject: Restart ... again ... again --- basics.el | 376 +++++++++++++++++++ early-init.el | 86 +---- init.el | 933 +--------------------------------------------- lisp/+browse-url.el | 189 ---------- lisp/+cape.el | 25 -- lisp/+emms.el | 38 -- lisp/+flyspell-correct.el | 24 -- lisp/+hungry-delete.el | 53 --- lisp/+isearch.el | 24 -- lisp/+ispell.el | 97 ----- lisp/+link-hint.el | 144 ------- lisp/+lisp.el | 93 ----- lisp/+message.el | 26 -- lisp/+notmuch.el | 149 -------- lisp/+org-capture.el | 49 --- lisp/+org.el | 309 --------------- lisp/+paredit.el | 26 -- lisp/+titlecase.el | 34 -- lisp/acdw-defaults.el | 295 --------------- lisp/acdw-funs.el | 262 ------------- lisp/acdw-macs.el | 293 --------------- lisp/acdw.el | 79 ---- lisp/graveyard.el | 50 --- lisp/init-org.el | 144 ------- lisp/upload-junk.el | 47 --- lisp/yoke.el | 392 ------------------- 26 files changed, 398 insertions(+), 3839 deletions(-) create mode 100644 basics.el delete mode 100644 lisp/+browse-url.el delete mode 100644 lisp/+cape.el delete mode 100644 lisp/+emms.el delete mode 100644 lisp/+flyspell-correct.el delete mode 100644 lisp/+hungry-delete.el delete mode 100644 lisp/+isearch.el delete mode 100644 lisp/+ispell.el delete mode 100644 lisp/+link-hint.el delete mode 100644 lisp/+lisp.el delete mode 100644 lisp/+message.el delete mode 100644 lisp/+notmuch.el delete mode 100644 lisp/+org-capture.el delete mode 100644 lisp/+org.el delete mode 100644 lisp/+paredit.el delete mode 100644 lisp/+titlecase.el delete mode 100644 lisp/acdw-defaults.el delete mode 100644 lisp/acdw-funs.el delete mode 100644 lisp/acdw-macs.el delete mode 100644 lisp/acdw.el delete mode 100644 lisp/graveyard.el delete mode 100644 lisp/init-org.el delete mode 100644 lisp/upload-junk.el delete mode 100644 lisp/yoke.el diff --git a/basics.el b/basics.el new file mode 100644 index 0000000..06f5ece --- /dev/null +++ b/basics.el @@ -0,0 +1,376 @@ +;;; basics.el --- Super basic Emacs settings -*- lexical-binding: t -*- + +;;; Commentary: + +;; These are the settings that I literally cannot live without. Basic +;; settings, built-in packages, that kind of stuff. Everything else +;; goes in init.el. + +;;; Code: + +;;; Directories + +(defmacro defdir (name directory &optional docstring makedir) + "Define a variable and a function NAME expanding to DIRECTORY. +DOCSTRING is applied to the variable; its default is DIRECTORY's +path. If MAKEDIR is non-nil, the directory and its parents will +be created." + (declare (indent 2) (doc-string 3)) + `(progn + (defvar ,name (expand-file-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)) + ,(if makedir + `(make-directory ,directory :parents) + `(unless (file-exists-p ,directory) + (warn "Directory `%s' doesn't exist." ,directory))))) + +(defdir etc/ (locate-user-emacs-file "etc/") + "Where various Emacs files are placed." + :makedir) + +(defdir lisp/ (locate-user-emacs-file "lisp/") + "My bespoke elisp files." + :makedir) +(push lisp/ load-path) + +(defdir sync/ "~/Sync/" + "My Syncthing directory." + :makedir) + +(defdir private/ (sync/ "emacs/private/") + "Private files and stuff." + :makedir) +(push private/ load-path) + +(use-package no-littering + :ensure t :demand t + :preface + (setq-default no-littering-etc-directory etc/ + no-littering-var-directory etc/)) + +;;; Settings + +;; Async +(setq-default async-shell-command-buffer 'new-buffer + async-shell-command-display-buffer nil) + +;; Scrolling +(setq-default auto-hscroll-mode t + auto-window-vscroll nil + fast-but-imprecise-scrolling t + hscroll-margin 1 + hscroll-step 1 + scroll-conservatively 25 + scroll-margin 0 + scroll-preserve-screen-position 1 + scroll-step 1) +(scroll-bar-mode -1) +(horizontal-scroll-bar-mode -1) +(pixel-scroll-precision-mode) + +;; Cursor +(setq-default cursor-in-non-selected-windows 'hollow + cursor-type 'bar + blink-cursor-blinks 1 + blink-cursor-interval 0.25 + blink-cursor-delay 0.25) +(blink-cursor-mode) + +;; Mouse +(setq-default mouse-drag-copy-region t + mouse-wheel-progressive-speed nil + mouse-yank-at-point t) + +;; Dialogs +(unless (boundp 'use-short-answers) + (fset 'yes-or-no-p 'y-or-n-p)) + +(setq-default read-answer-short t + use-dialog-box nil + use-file-dialog nil + use-short-answers t) + +;; Minibuffer +(setq-default completion-ignore-case t + read-buffer-completion-ignore-case t + read-file-name-completion-ignore-case t + completions-detailed t + enable-recursive-minibuffers t + file-name-shadow-properties '(invisible t intangible t) + minibuffer-eldef-shorten-default t + minibuffer-prompt-properties '( read-only t + cursor-intangible t + face minibuffer-prompt)) +(file-name-shadow-mode) +(minibuffer-electric-default-mode) + +(require 'savehist) +(setq-default history-length 1024 + history-delete-duplicates t + ;; savehist-file (etc/ "savehist.el") + savehist-save-minibuffer-history t + savehist-autosave-interval 30) +(savehist-mode) + +;; Undo +(setq-default undo-limit (* 10 1024 1024)) + +;; Killing and yanking +(setq-default kill-do-not-save-duplicates t + kill-read-only-ok t + save-interprogram-paste-before-kill t + yank-pop-change-selection t) +(delete-selection-mode) + +;; Notifying the user +(setq-default echo-keystrokes 0.01 + ring-bell-function #'ignore) + +;; Point and mark +(setq-default set-mark-command-repeat-pop t) + +;; The system +(setq-default read-process-output-max (* 10 1024 1024)) + +;; Startup +(setq-default inhibit-startup-screen t + initial-buffer-choice t + initial-scratch-message nil) + +;; (menu-bar-mode -1) +(tool-bar-mode -1) +(tooltip-mode -1) + +;; Text editing +(setq-default fill-column 80 + sentence-end-double-space t + tab-width 8) +(global-so-long-mode) + +(setq-default 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) + +;; Encodings +(set-language-environment "UTF-8") +(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) +(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))) + +;; Abbrev +(setq-default abbrev-file-name (sync/ "abbrev.el") + save-abbrevs 'silently) + +;; Files +(setq-default auto-revert-verbose nil + global-auto-revert-non-file-buffers t + create-lockfiles nil + find-file-visit-truename t + mode-require-final-newline t + view-read-only t + save-silently t) +(global-auto-revert-mode) + +(setq-default auto-save-default nil + auto-save-interval 1 + auto-save-no-message t + auto-save-timeout 1 + auto-save-visited-interval 1) +(add-to-list 'auto-save-file-name-transforms + `(".*" ,(etc/ "auto-save/" t) t)) +(auto-save-visited-mode) + +(setq-default backup-by-copying t + version-control t + kept-new-versions 8 + kept-old-versions 8 + delete-old-versions t) + +(require 'recentf) +(setq-default ;; recentf-save-file (etc/ "recentf" t) + recentf-max-menu-items 500 + recentf-max-saved-items nil ; Save the whole list + recentf-auto-cleanup 'mode) +(add-to-list 'recentf-exclude etc/) +(add-to-list 'recentf-exclude "-autoloads.el\\'") +(add-hook 'buffer-list-update-hook #'recentf-track-opened-file) +(recentf-mode) + +(require 'saveplace) +(setq-default ;; save-place-file (etc/ "places.el") + save-place-forget-unreadable-files (eq system-type + 'gnu/linux)) +(save-place-mode) + +(require 'uniquify) +(setq uniquify-after-kill-buffer-p t + uniquify-buffer-name-style 'forward + uniquify-ignore-buffers-re "^\\*" + uniquify-separator path-separator) + +(setq-local vc-follow-symlinks t + vc-make-backup-files t) + +;; Native compilation +(setq-default native-comp-async-report-warnings-errors 'silent + native-comp-deferred-compilation t + native-compile-target-directory (etc/ "eln" t)) +(add-to-list 'native-comp-eln-load-path native-compile-target-directory) +(when (fboundp 'startup-redirect-eln-cache) + (startup-redirect-eln-cache native-compile-target-directory)) + +;; Custom file +(setq-default custom-file (sync/ "emacs/custom.el")) +(define-advice package--save-selected-packages (:around (orig &rest args) no-custom) + "Don't save `package-selected-packages' to `custom-file'." + (let ((custom-file null-device)) + (apply orig args))) + +;; Goto Address +(if (fboundp 'global-goto-address-mode) + (global-goto-address-mode) + (add-hook 'after-change-major-mode-hook #'goto-address-mode)) + +;; Winner +(winner-mode) + +;;; Keybindings + +(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 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 +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))) + +(global-set-key [remap eval-expression] #'pp-eval-expression) +(global-set-key (kbd "M-o") #'other-window|switch-buffer) +(global-set-key (kbd "C-x 0") #'delete-window|bury-buffer) +(global-set-key (kbd "M-SPC") #'+cycle-spacing) +(global-set-key (kbd "C-x C-k") #'kill-this-buffer) + +;;; Hooks + +(add-hook 'after-save-hook #'executable-make-buffer-file-executable-if-script-p) +(add-hook 'find-file-not-found-functions + (defun create-missing-directories () + "Automatically create missing directories." + (let ((target-dir (file-name-directory buffer-file-name))) + (unless (file-exists-p target-dir) + (make-directory target-dir :parents))))) +(add-hook 'find-file-hook + (defun vc-remote-off () + "Turn VC off when remote." + (when (file-remote-p (buffer-file-name)) + (setq-local vc-handled-backends nil)))) + +;;; Advice + +(define-advice switch-to-buffer (:after (&rest _) normal-mode) + "Automatically determine the mode for 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) + "Always double-space sentences canonically." + (let ((sentence-end-double-space t)) + (apply orig args))) + +;; With region or ... +(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))))) + +(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)))) + +(with-region-or-buffer indent-region) + +;;; Packages + +(use-package _acdw + :load-path private/) + +;;; basics.el ends here diff --git a/early-init.el b/early-init.el index b841ea5..3dd74e0 100644 --- a/early-init.el +++ b/early-init.el @@ -1,50 +1,14 @@ -;;; early-init.el --- Emacs early init -*- lexical-binding: t -*- +;;; early-init.el -*- lexical-binding: t -*- -;; by C. Duckworth +;; Bankruptcy: 9.4 -;; Bankruptcy: 9.3 - -;;; Debugging --- delete this when done bankrupting -(setf debug-on-error t +;; Debugging shit +(setq debug-on-error t use-package-verbose t) -;;; Speedy startup - -(defvar +emacs--startup-restore-alist nil - "Variables to restore after startup.") - -(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. -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))) - (set-default variable value))) - -(+set-during-startup 'gc-cons-threshold most-positive-fixnum) - -;;; Distraction-free startup - -(unless debug-on-error - (+set-during-startup 'inhibit-redisplay t) - (+set-during-startup 'inhibit-message t)) - -(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) +;; Frames +(setq default-frame-alist '((tool-bar-lines . 0) + ;; (menu-bar-lines . 0) (vertical-scroll-bars . nil) (horizontal-scroll-bars . nil)) frame-inhibit-implied-resize t @@ -54,42 +18,28 @@ Otherwise, save its original value and restore to that." indicate-empty-lines nil indicate-buffer-boundaries nil) -;;; Packages - +;; Packages (require 'package) - -(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)) - -(setf package-archive-priorities - '(("gnu-devel" . 2) - ("nongnu-devel" . 1) - ("melpa" . 0) - ("gnu" . 0) - ("nongnu" . 0))) - +(add-to-list 'package-archives + '("melpa" . "https://melpa.org/packages/") + :append) +(setq package-priorities '(("melpa" . 2) + ("nongnu" . 1) + ("gnu" . 0))) (package-initialize) - (unless package-archive-contents (package-refresh-contents)) -;; https://melpa.org/packages/archive-contents - -;;; Use-package - -(setf use-package-enable-imenu-support t +(setq use-package-enable-imenu-support t use-package-hook-name-suffix nil) (require 'use-package) - -(setf use-package-compute-statistics debug-on-error) +(setq use-package-compute-statistics debug-on-error) (use-package use-package-vc - :load-path "~/src/emacs/use-package-vc.el" + :load-path "~/src/emacs/use-package-vc.el/" :config (define-advice package-vc-install (:around (orig &rest args) wtf) + "Don't freak out about `package-archives' shit." (let ((package-archives nil)) (apply orig args)))) diff --git a/init.el b/init.el index 0ef669f..369641c 100644 --- a/init.el +++ b/init.el @@ -1,932 +1,7 @@ -;;; init.el --- a config of one's own -*- lexical-binding: t; -*- -;; by C. Duckworth -;; Bankruptcy: 9.3 +;;; init.el --- An Emacs of one's own -*- lexical-binding: t -*- -;;; Code: - -;;; My extras - -(push (expand-file-name (locate-user-emacs-file "lisp")) load-path) -(require 'acdw) ; Omnibus fun stuff - -;;; Remove when done bankrupting - -(defkeys t "C-x C-c" #'restart-emacs) - -;;; Basic defaults - -(use-package no-littering - :ensure t :demand t - :preface - (setq no-littering-etc-directory etc/ - no-littering-var-directory var/) - :custom - (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 :demand t - :custom - (resize-mini-windows 'grow-only) - (vertico-cycle t) - :config - (use-package vertico-directory - :after vertico - :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)) - -(use-package orderless - :ensure t :demand t - :config - (setc 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-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 :demand 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)) - -(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)) - -(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)) - -(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)) - -(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))) - -(use-package mlscroll - :ensure t :defer 1 - :preface - (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))) - :init - (when (daemonp) - (add-hook 'server-after-make-frame #'modus-themes-load@mlscroll)) - :config (modus-themes-load@mlscroll)) - -(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)) - -(use-package anzu - :ensure t - :bind - (("M-%" . anzu-query-replace-regexp) - ("C-M-%" . anzu-query-replace))) - -(use-package frowny - :load-path "~/src/emacs/frowny/" - :config - (global-frowny-mode)) - -(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)) +;; Bankruptcy: 9.4 -(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 - "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)) - -(use-package ediff - :custom - (ediff-keep-variants nil) - (ediff-split-window-function #'split-window-horizontally) - (ediff-window-setup-function #'ediff-setup-windows-plain)) - -;;; Lisps - -(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)) - -(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)) - -;;; 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) - :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))) +;;; Code: -(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) - (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 - :narrow ?j - :category buffer - :state ,#'consult--buffer-state - :items ,(lambda () - (mapcar #'buffer-name - (seq-filter (lambda (buf) - (with-current-buffer buf - (eq major-mode 'jabber-chat-mode))) - (buffer-list)))))) - (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))) +(load (locate-user-emacs-file "basics")) ; super basic stuff diff --git a/lisp/+browse-url.el b/lisp/+browse-url.el deleted file mode 100644 index b65b6f9..0000000 --- a/lisp/+browse-url.el +++ /dev/null @@ -1,189 +0,0 @@ -;;; +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 - &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 -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'. - -The resulting function is named NAME, which defaults to -`+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 ,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 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 - ,program - (append ,var (list url)))) - ,@(cond - (fallback `((funcall ,fallback url new-window))) - (: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 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. - (unless (plist-get status :error) - (let* ((obj (url-generic-parse-url url)) - (path (directory-file-name (car (url-path-and-query obj)))) - (file (eww-make-unique-file-name - (eww-decode-url-file-name (file-name-nondirectory path)) - dir))) - (goto-char (point-min)) - (re-search-forward "\r?\n\r?\n") - (let ((coding-system-for-write 'no-conversion)) - (write-region (point) (point-max) file)) - (message "Saved %s" file) - file))) - -;;; 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 deleted file mode 100644 index 37e88fe..0000000 --- a/lisp/+cape.el +++ /dev/null @@ -1,25 +0,0 @@ -;;; 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/+emms.el b/lisp/+emms.el deleted file mode 100644 index a43daea..0000000 --- a/lisp/+emms.el +++ /dev/null @@ -1,38 +0,0 @@ -;;; +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/+flyspell-correct.el b/lisp/+flyspell-correct.el deleted file mode 100644 index 9a33cc0..0000000 --- a/lisp/+flyspell-correct.el +++ /dev/null @@ -1,24 +0,0 @@ -;;; +flyspell-correct.el --- -*- lexical-binding: t; -*- - -;;; Code: - -(require 'flyspell-correct) - -(defun +flyspell-correct-buffer (&optional prefix) - "Run `flyspell-correct-wrapper' on all misspelled words in the buffer. -With PREFIX, prompt to change the current dictionary." - (interactive "P") - (flyspell-buffer) - (when prefix - (let ((current-prefix-arg nil)) - (call-interactively #'ispell-change-dictionary))) - (with-message "Checking spelling" - (flyspell-correct-move (point-min) :forward :rapid))) - -(defun +flyspell-correct-buffer-h (&rest _) - "Run `+flyspell-correct-buffer'. -This is suitable for placement in a hook." - (+flyspell-correct-buffer)) - -(provide '+flyspell-correct) -;;; +flyspell-correct.el ends here diff --git a/lisp/+hungry-delete.el b/lisp/+hungry-delete.el deleted file mode 100644 index 601aecf..0000000 --- a/lisp/+hungry-delete.el +++ /dev/null @@ -1,53 +0,0 @@ -;;; +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 deleted file mode 100644 index 3516ec4..0000000 --- a/lisp/+isearch.el +++ /dev/null @@ -1,24 +0,0 @@ -;;; +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/+ispell.el b/lisp/+ispell.el deleted file mode 100644 index 10c31b8..0000000 --- a/lisp/+ispell.el +++ /dev/null @@ -1,97 +0,0 @@ -;;; +ispell.el --- Customizations for `ispell' -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -(require 'cl-lib) -(require 'seq) - -;; Utility function TODO: move elsewhere -(defun +ispell-append-removing-duplicates (&rest lists) - "Append LISTS, removing duplicates from the result. -Any keyword arguments to `cl-remove-duplicates' should come -before the LISTS." - (let (cl-remove-duplicates-args) - (while (keywordp (car lists)) - (push (pop lists) cl-remove-duplicates-args) - (push (pop lists) cl-remove-duplicates-args)) - (apply #'cl-remove-duplicates (apply #'append lists) - (nreverse cl-remove-duplicates-args)))) - -;;; Ispell in .dir-locals - -;; Let Emacs know a list of strings is safe -(defun +ispell-safe-local-p (list) - (and (listp list) - (seq-every-p #'stringp list))) - -;; Can I instruct ispell to insert LocalWords in a different file? -;; https://emacs.stackexchange.com/q/31396/2264 - -;; How can I move all my file-local LocalWords to .dir-locals.el? -;; https://emacs.stackexchange.com/q/31419 - -;; Adapted from ispell.el:ispell-buffer-local-words -(defun +ispell-buffer-local-words-list () - (let (words) - (or ispell-buffer-local-name - (setf ispell-buffer-local-name (buffer-name))) - (save-excursion - (goto-char (point-min)) - (while (search-forward ispell-words-keyword nil t) - (let ((end (point-at-eol)) - (ispell-casechars (ispell-get-casechars)) - string) - (while (re-search-forward " *\\([^ ]+\\)" end t) - (setf string (match-string-no-properties 1)) - (if (and (< 1 (length string)) - (equal 0 (string-match ispell-casechars string))) - (push string words)))))) - words)) - -;;;###autoload -(defun +ispell-move-buffer-words-to-dir-locals (&optional arg) - "Move the current buffer-local words to .dir-locals.el. -This function prompts the user to save .dir-locals.el, unless -prefix ARG is non-nil; then it just saves them." - (interactive "P") - (unless (buffer-file-name) - (user-error "Buffer not attached to file")) - (hack-dir-local-variables) - (let ((print-level nil) - (print-length nil)) - (when-let ((new-words (cl-remove-if (lambda (el) (eq el '\.\.\.)) ; XXX: NO IDEA - ; where this came from - (+ispell-append-removing-duplicates - :test #'string= - ispell-buffer-session-localwords - (alist-get 'ispell-buffer-session-localwords - dir-local-variables-alist) - (alist-get 'ispell-buffer-session-localwords - file-local-variables-alist) - (+ispell-buffer-local-words-list))))) - (save-excursion - (add-dir-local-variable - major-mode - 'ispell-buffer-session-localwords - (setf ispell-buffer-session-localwords - new-words)) - (when (or arg - (y-or-n-p "Save .dir-locals.el?")) - (save-buffer)) - (bury-buffer)) - (or ispell-buffer-local-name - (setf ispell-buffer-local-name (buffer-name))) - (save-excursion - (goto-char (point-min)) - (while (search-forward ispell-words-keyword nil t) - (delete-region (point-at-bol) (1+ (point-at-eol)))))))) - -;;;###autoload -(defun +ispell-move-buffer-words-to-dir-locals-hook () - "Convenience function for binding to a hook." - (+ispell-move-buffer-words-to-dir-locals t)) - -(provide '+ispell) -;;; +ispell.el ends here diff --git a/lisp/+link-hint.el b/lisp/+link-hint.el deleted file mode 100644 index 926a266..0000000 --- a/lisp/+link-hint.el +++ /dev/null @@ -1,144 +0,0 @@ -;;; +link-hint.el -*- lexical-binding: t; -*- - -;;; Code: - -(require 'cl-lib) -(require 'link-hint) - -(defgroup +link-hint nil - "Extra customizations for `link-hint'." - :group 'link-hint) - -(defcustom +link-hint-open-secondary-types '(gnus-w3m-image-url - gnus-w3m-url - markdown-link - mu4e-attachment - mu4e-url - notmuch-hello - nov-link - org-link - shr-url - text-url - w3m-link - w3m-message-link) - "Link types to define `:open-secondary' for.") - -(defvar +link-hint-map (make-sparse-keymap) - "Keymap for `link-hint' functionality.") - -(cl-defmacro +link-hint-define-keyword (keyword handler docstring - &optional (types 'link-hint-types) - &rest rest - &key multiple &allow-other-keys) - "Set up a `link-hint' KEYWORD, with optional TYPES. -If TYPES is not present, use `link-hint-types'. - -KEYWORD defines the link-hint type. It will be used to create a -function for opening links of the form \"link-hint-openKEYWORD\". - -HANDLER is the function to open a link with. - -DOCSTRING is the macro's documentation. - -Keyword arguments are passed to `link-hint-define-type' prefixed -with the KEYWORD." - (declare (indent 2) - (doc-string 3)) - (let ((types (symbol-value types)) - (func-sym (intern (format "+link-hint-open%s" keyword))) - (mult-sym (intern (format "%s-multiple" keyword))) - (expr)) - ;; Define the type - (push `(dolist (type ',types) - (link-hint-define-type type - ,keyword ,handler - ,@(mapcar (lambda (el) - (if (eq el :multiple) - mult-sym - el)) - rest))) - expr) - ;; Define an opener - (push `(defun ,func-sym () - ,(format "%s\n\nDefined by `+link-hint-define'." docstring) - (interactive) - (avy-with link-hint-open-link - (link-hint--one ,keyword))) - expr) - ;; Handle `:multiple' - (when multiple - (push `(defun ,(intern (format "+link-hint-open-multiple%s" keyword)) () - ,(format "Open multiple links with `%s'.\n\nDefined by `+link-hint-define'." - func-sym) - (avy-with link-hint-open-multiple-links - (link-hint--multiple ,keyword))) - expr) - (push `(defun ,(intern (format "+link-hint-open-all%s" keyword)) () - ,(format "Open all visible links with `%s'.\n\nDefined by `+link-hint-define'." - func-sym) - (avy-with link-hint-open-all-links - (link-hint--all ,keyword))) - expr)) - ;; Return the built expression - `(progn ,@(nreverse expr)))) - -(+link-hint-define-keyword :secondary browse-url-secondary-browser-function - "Open a link in the secondary browser." - +link-hint-open-secondary-types - :multiple t) - -(defun +link-hint-open-secondary-setup (&optional types) - "Define the `:open-secondary' link-hint type for TYPES. -If TYPES is nil, define it for `+link-hint-open-secondary-types'." - (dolist (type (or types +link-hint-open-secondary-types)) - (link-hint-define-type type - :open-secondary browse-url-secondary-browser-function - :open-secondary-multiple t))) - -(defun +link-hint-open-secondary () - "Open a link in the secondary browser." - (interactive) - (avy-with link-hint-open-link - (link-hint--one :open-secondary))) - -(defun +link-hint-open-chrome-setup (&optional types) - "Define the `:open-chrome' link-hint type for TYPES. -If TYPES is nil, define it for `+link-hint-open-secondary-types'." - (dolist (type (or types +link-hint-open-secondary-types)) - (link-hint-define-type type - :open-chrome #'browse-url-chrome - :open-chrome-multiple t))) - -(defun +link-hint-open-chrome () - "Open a link with chrome." - (interactive) - (avy-with link-hint-open-link - (link-hint--one :open-chrome))) - -(defun +link-hint-open-link (prefix) - "Open a link. -Without a PREFIX, open using `browse-url-browser-function'; with -a PREFIX, use `browse-url-secondary-browser-function'." - (interactive "P") - (let ((current-prefix-arg nil)) - (avy-with link-hint-open-link - (link-hint--one (if prefix :open-secondary :open))))) - -(defun +link-hint-open-multiple-links (prefix) - "Open multiple links. -Without a PREFIX, open using `browse-url-browser-function'; with -a PREFIX, use `browse-url-secondary-browser-function'." - (interactive "P") - (avy-with link-hint-open-multiple-links - (link-hint--one (if prefix :open-secondary :open)))) - -(defun +link-hint-open-all-links (prefix) - "Open all visible links. -Without a PREFIX, open using `browse-url-browser-function'; with -a PREFIX, use `browse-url-secondary-browser-function'." - (interactive "P") - (avy-with link-hint-open-all-links - (link-hint--one (if prefix :open-secondary :open)))) - -(provide '+link-hint) -;;; +link-hint.el ends here diff --git a/lisp/+lisp.el b/lisp/+lisp.el deleted file mode 100644 index 22450f7..0000000 --- a/lisp/+lisp.el +++ /dev/null @@ -1,93 +0,0 @@ -;;; +lisp.el -*- lexical-binding: t -*- - -;;; Comment-or-uncomment-sexp -;; from https://endlessparentheses.com/a-comment-or-uncomment-sexp-command.html - -(defun +lisp-uncomment-sexp (&optional n) - "Uncomment N sexps around point." - (interactive "P") - (let* ((initial-point (point-marker)) - (inhibit-field-text-motion t) - (p) - (end (save-excursion - (when (elt (syntax-ppss) 4) - (re-search-backward comment-start-skip - (line-beginning-position) - t)) - (setq p (point-marker)) - (comment-forward (point-max)) - (point-marker))) - (beg (save-excursion - (forward-line 0) - (while (and (not (bobp)) - (= end (save-excursion - (comment-forward (point-max)) - (point)))) - (forward-line -1)) - (goto-char (line-end-position)) - (re-search-backward comment-start-skip - (line-beginning-position) - t) - (ignore-errors - (while (looking-at-p comment-start-skip) - (forward-char -1))) - (point-marker)))) - (unless (= beg end) - (uncomment-region beg end) - (goto-char p) - ;; Indentify the "top-level" sexp inside the comment. - (while (and (ignore-errors (backward-up-list) t) - (>= (point) beg)) - (skip-chars-backward (rx (syntax expression-prefix))) - (setq p (point-marker))) - ;; Re-comment everything before it. - (ignore-errors - (comment-region beg p)) - ;; And everything after it. - (goto-char p) - (forward-sexp (or n 1)) - (skip-chars-forward "\r\n[:blank:]") - (if (< (point) end) - (ignore-errors - (comment-region (point) end)) - ;; If this is a closing delimiter, pull it up. - (goto-char end) - (skip-chars-forward "\r\n[:blank:]") - (when (eq 5 (car (syntax-after (point)))) - (delete-indentation)))) - ;; Without a prefix, it's more useful to leave point where - ;; it was. - (unless n - (goto-char initial-point)))) - -(defun +lisp-comment-sexp--raw () - "Comment the sexp at point or ahead of point." - (pcase (or (bounds-of-thing-at-point 'sexp) - (save-excursion - (skip-chars-forward "\r\n[:blank:]") - (bounds-of-thing-at-point 'sexp))) - (`(,l . ,r) - (goto-char r) - (skip-chars-forward "\r\n[:blank:]") - (save-excursion - (comment-region l r)) - (skip-chars-forward "\r\n[:blank:]")))) - -(defun +lisp-comment-or-uncomment-sexp (&optional n) - "Comment the sexp at point and move past it. -If already inside (or before) a comment, uncomment instead. -With a prefix argument N, (un)comment that many sexps." - (interactive "P") - (if (or (elt (syntax-ppss) 4) - (< (save-excursion - (skip-chars-forward "\r\n[:blank:]") - (point)) - (save-excursion - (comment-forward 1) - (point)))) - (+lisp-uncomment-sexp n) - (dotimes (_ (or n 1)) - (+lisp-comment-sexp--raw)))) - -(provide '+lisp) -;;; +lisp.el ends here diff --git a/lisp/+message.el b/lisp/+message.el deleted file mode 100644 index b8bc234..0000000 --- a/lisp/+message.el +++ /dev/null @@ -1,26 +0,0 @@ -;;; +message.el --- Extra message-mode functions -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -;; Thanks to Alex Schroeder for this! -;; https://www.emacswiki.org/emacs/Change_Signature_Dynamically - -(defun +message-check-for-signature-change (&rest ignore) - "Check for a change in the To: or Cc: fields" - (when (and (message--in-tocc-p) - (not (buffer-narrowed-p))) - (save-excursion - (goto-char (point-max)) - (let ((end (point))) - (when (re-search-backward message-signature-separator nil t) - (delete-region (1- (match-beginning 0)) end))) - (message-insert-signature)))) - -(defun +message-signature-setup () - (make-local-variable 'after-change-functions) - (push '+message-check-for-signature-change after-change-functions)) - -(provide '+message) -;;; +message.el ends here diff --git a/lisp/+notmuch.el b/lisp/+notmuch.el deleted file mode 100644 index 5df6e5b..0000000 --- a/lisp/+notmuch.el +++ /dev/null @@ -1,149 +0,0 @@ -;;; +notmuch.el --- Notmuch extras -*- lexical-binding: t; -*- - -;;; Commentary: - -;; This is stuff that I suppose /could/ go in notmuch/init.el, but ... doesn't. - -;;; Code: - -(require 'cl-lib) -(require 'notmuch) - -(defvar +notmuch-send-dispatch-rules nil - "Alist of from addresses and variables to set when sending.") - -(defun +notmuch-query-concat (&rest queries) - "Concatenate notmuch queries." - (mapconcat #'identity queries " AND ")) - -(defun +send-mail-dispatch () - "Dispatch mail sender, depending on account." - (let ((from (message-fetch-field "from"))) - (dolist (vars (cl-loop for (addr . vars) in +notmuch-send-dispatch-rules - if (string-match-p addr from) return vars)) - (set (car vars) (cdr vars))))) - -(defun +notmuch-correct-tags (args) - (list (car args) (mapcar #'string-trim (cadr args)))) - -(defun +notmuch-goto (&optional prefix) - "Go straight to a `notmuch' search. -Without PREFIX argument, go to the first one in -`notmuch-saved-searches'; with a PREFIX argument, prompt the user -for which saved search to go to; with a double PREFIX -argument (\\[universal-argument] \\[universal-argument]), prompt -for search." - (interactive "P") - (pcase prefix - ('nil (notmuch-search (plist-get (car notmuch-saved-searches) :query))) - ('(4) (notmuch-search (plist-get (cl-find (completing-read "Saved Search: " - (mapcar (lambda (el) - (plist-get el :name)) - notmuch-saved-searches)) - notmuch-saved-searches - :key (lambda (el) (plist-get el :name)) - :test #'equal) - :query))) - (_ (notmuch-search)))) - -;; Don't add an initial input when completing addresses -(eval-after notmuch - (cond ((featurep 'el-patch) - (el-patch-feature notmuch) - (el-patch-defun notmuch-address-selection-function (prompt collection initial-input) - "Call (`completing-read' - PROMPT COLLECTION nil nil INITIAL-INPUT 'notmuch-address-history)" - (completing-read - prompt collection nil nil - (el-patch-swap initial-input - nil) - 'notmuch-address-history))) - (:else - (defun notmuch-address-selection-function (prompt collection initial-input) - "Call (`completing-read' - PROMPT COLLECTION nil nil INITIAL-INPUT '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." - :type '(repeat string)) - -(defun +notmuch-tree-mark-spam-then-next (&optional ham beg end) - "Mark the current message as spam and move to the next." - (interactive "P") - (+notmuch-tree-mark-spam ham) - (notmuch-tree-next-matching-message)) - -(defun +notmuch-tree-mark-spam (&optional ham) - "Mark the current message as spam. -That is, apply the tag changes in `+notmuch-spam-tags' to it. If -an optional prefix HAM argument is given, the message will be -marked as not-spam (\"ham\"), i.e., the tag changes in -`+notmuch-spam-tags' will be reversed." - (interactive "P") - (when +notmuch-spam-tags - (notmuch-tree-tag - (notmuch-tag-change-list +notmuch-spam-tags ham)))) - -(defun +notmuch-search-mark-spam (&optional ham beg end) - "Mark the current thread or region as spam. -This adds the tags in `+notmuch-spam-tags' to the message. With -an optional HAM prefix argument, mark the messages as -not-spam (\"ham\"). - -This function advances the next thread when finished." - (interactive (cons current-prefix-arg (notmuch-interactive-region))) - (when +notmuch-spam-tags - (notmuch-search-tag - (notmuch-tag-change-list +notmuch-spam-tags ham) beg end)) - (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 deleted file mode 100644 index 2f7bf6a..0000000 --- a/lisp/+org-capture.el +++ /dev/null @@ -1,49 +0,0 @@ -;;; +org-capture.el -*- lexical-binding: t; -*- - -;;; Code: - -(require 'cl-lib) -;; 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) - -;; 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 diff --git a/lisp/+org.el b/lisp/+org.el deleted file mode 100644 index a148bd8..0000000 --- a/lisp/+org.el +++ /dev/null @@ -1,309 +0,0 @@ -;;; +org.el -*- lexical-binding: t; -*- - -;;; 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. -TYPE should be an element type, like `item' or `paragraph'. -ELEMENT should be a list like that returned by `org-element-context'." - ;; MAYBE: Use `org-element-lineage'. - (when-let* ((parent (org-element-property :parent element))) - (or (eq type (car parent)) - (+org-element-descendant-of type parent)))) - -(defun +org-return-dwim (&optional prefix) - "A helpful replacement for `org-return'. -With PREFIX, call `org-return'." - (interactive "P") - ;; Auto-fill if enabled - (when auto-fill-function - (dolist (func (ensure-list auto-fill-function)) - (funcall func))) - (cond - (prefix ; Handle prefix - (pcase prefix - ('(4) (newline)) - ('(16) (newline 2)) - (_ (newline prefix)))) - ((and org-return-follows-link ; Open link - (eq 'link (car (org-element-context)))) - (org-open-at-point-global)) - ((org-at-heading-p) ; Open a line after a heading - (let ((heading-start (org-entry-beginning-position))) - (goto-char (org-entry-end-position)) - (cond ((and (org-at-heading-p) - (= heading-start (org-entry-beginning-position))) - ;; Entry ends on its heading, so add 2 newlines - (end-of-line) - (newline 2)) - (t - ;; Entry ends after its heading, so back up - (forward-line -1) - (end-of-line) - (when (org-at-heading-p) - (forward-line) - (newline) - (forward-line -1)) - (while (not (looking-back (rx (repeat 3 (seq (optional blank) "\n"))) - nil)) - (newline)) - (forward-line -1))))) - ((org-at-item-checkbox-p) ; Insert a new checkbox item - (end-of-line) - (org-insert-todo-heading nil)) - ((org-in-item-p) ; Insert a new list item - (let* ((context (org-element-context)) - (first-item-p (eq 'plain-list (car context))) - (itemp (eq 'item (car context))) - (emptyp (or - ;; This (regular) list item is empty - (eq (org-element-property :contents-begin context) - (org-element-property :contents-end context)) - ;; This (definition) list item is empty - (looking-at " *::"))) - (item-child-p (+org-element-descendant-of 'item context))) - (cond ((and itemp emptyp) - (delete-region (line-beginning-position) (line-end-position)) - (newline)) - ((or first-item-p - (and itemp (not emptyp)) - item-child-p) - (org-end-of-item) - (org-insert-item)) - (t - (delete-region (line-beginning-position) (line-end-position)) - (newline))))) - ((and (fboundp 'org-inlinetask-in-task-p) ; Don't insert a new heading with - (org-inlinetask-in-task-p)) ; inline tasks - (org-return)) - ((org-at-table-p) ; Insert a new org-table row - (cond ((save-excursion - (beginning-of-line) - (cl-loop with end = (line-end-position) - for cell = (org-element-table-cell-parser) - always (equal (org-element-property :contents-begin cell) - (org-element-property :contents-end cell)) - while (re-search-forward "|" end t))) - ;; Empty row: end the table - (delete-region (line-beginning-position) (line-end-position)) - (org-return)) - (t - ;; Non-empty row - (org-return)))) - (t ; Otherwise---just call `org-return'. - (org-return)))) - -(defun +org-table-copy-down|+org-return-dwim (&optional n) - "Call `org-table-copy-down' or `+org-return' depending on context." - (interactive "P") - (if (org-table-check-inside-data-field 'noerror) - (org-table-copy-down (or n 1)) - (+org-return-dwim n))) - - -;;; A ... different ... `org-open-at-point-dwim' -;; I honestly don't remember what the difference is between this and the -;; O.G. one is.. hopefully this one fixes annoying stupid problems. - -(defun +org-open-at-point-dwim (&optional arg) - "Open thing at point, or if there isn't something, list things." - (interactive "P") - (save-excursion - (let* ((this-char-type (org-element-type (org-element-context))) - (prev-char-type (ignore-errors - (save-excursion - (backward-char) - (org-element-type (org-element-context))))) - (types '(citation citation-reference clock comment comment-block - footnote-definition footnote-reference headline - inline-src-block inlinetask keyword link - node-property planning src-block timestamp)) - (type this-char-type)) - (when (and (memq this-char-type types) (memq prev-char-type types)) - (backward-char) - (setq type prev-char-type)) ; what the fuckckckckck - ;; Okay, so this ^ is pretty janky and doesn't /really/ work that well, - ;; especially on DEADLINE (and probably SCHEDULED) lines. However, since - ;; I really just want to open the list of URLs /most of the time/, I'm - ;; fixing it like this instead. - (unless (and (memq type types) - (ignore-errors (org-open-at-point arg) - t)) - (while (not - (progn - (org-back-to-heading) - (car (org-offer-links-in-entry (current-buffer) (point) 1)))) - (org-up-heading-all 1)) - (org-open-at-point arg))))) - -;;; Faces -;; see `org-emphasis-alist' - -(defface org-bold '((t (:weight bold))) - "Bold face in `org-mode' documents.") - -(defface org-italic '((t (:slant italic))) - "Italic face in `org-mode' documents.") - -(defface org-underline '((t (:underline t))) - "Underline face in `org-mode' documents.") - -(defface org-strikethrough '((t (:strike-through t))) - "Strike-through face for `org-mode' documents.") - -;;; 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)))))))) - -;;; 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/+paredit.el b/lisp/+paredit.el deleted file mode 100644 index ab176b8..0000000 --- a/lisp/+paredit.el +++ /dev/null @@ -1,26 +0,0 @@ -;;; +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/+titlecase.el b/lisp/+titlecase.el deleted file mode 100644 index 6defda7..0000000 --- a/lisp/+titlecase.el +++ /dev/null @@ -1,34 +0,0 @@ -;;; +titlecase.el --- Titlecase extras -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -(require 'titlecase) - -(defun +titlecase-sentence-style-dwim (&optional arg) - "Titlecase a sentence. -With prefix ARG, toggle the value of -`titlecase-downcase-sentences' before sentence-casing." - (interactive "P") - (let ((titlecase-downcase-sentences (if arg (not titlecase-downcase-sentences) - titlecase-downcase-sentences))) - (titlecase-dwim 'sentence))) - -(defun +titlecase-org-headings () - (interactive) - (save-excursion - (goto-char (point-min)) - ;; See also `org-map-tree'. I'm not using that function because I want to - ;; skip the first headline. A better solution would be to patch - ;; `titlecase-line' to ignore org-mode metadata (TODO cookies, tags, etc). - (let ((level (funcall outline-level)) - (org-special-ctrl-a/e t)) - (while (and (progn (outline-next-heading) - (> (funcall outline-level) level)) - (not (eobp))) - (titlecase-region (org-beginning-of-line) - (org-end-of-line)))))) - -(provide '+titlecase) -;;; +titlecase.el ends here diff --git a/lisp/acdw-defaults.el b/lisp/acdw-defaults.el deleted file mode 100644 index e4c9e14..0000000 --- a/lisp/acdw-defaults.el +++ /dev/null @@ -1,295 +0,0 @@ -;;; 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)) - -(deftheme use-package) -(enable-theme 'use-package) - -;;; Internal packages - -(when (require 'abbrev nil t) - (custom-theme-set-variables 'use-package - '(abbrev-file-name (sync/ "abbrev.el")) - '(save-abbrevs 'silently))) - -(when (require 'autorevert nil t) - (custom-theme-set-variables 'use-package - '(auto-revert-verbose nil) - '(global-auto-revert-non-file-buffers t)) - (global-auto-revert-mode +1)) - -(when (require 'comp nil t) - (custom-theme-set-variables 'use-package - '(native-comp-async-report-warnings-errors 'silent) - '(native-comp-deferred-compilation t))) - -(when (require 'custom nil t) - (custom-theme-set-variables 'use-package - '(custom-file (etc/ "custom.el")))) - -(when (require 'ediff nil t) - (custom-theme-set-variables 'use-package - '(ediff-window-setup-function #'ediff-setup-windows-plain))) - -(when (require 'eldoc nil t) - (custom-theme-set-variables 'use-package - '(eldoc-echo-area-use-multiline-p nil) - '(eldoc-idle-delay 0.1))) - -(when (require 'executable nil t) - (custom-theme-set-variables 'use-package - '(executable-prefix-env t))) - -(when (require 'files nil t) - (custom-theme-set-variables 'use-package - '(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-theme-set-variables 'use-package - '(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-theme-set-variables 'use-package - '(image-use-external-converter - (seq-some #'executable-find '("convert" "gm" "ffmpeg"))))) - -(when (require 'imenu nil t) - (custom-theme-set-variables 'use-package - '(imenu-auto-rescan t))) - -(when (require 'isearch nil t) - (custom-theme-set-variables 'use-package - '(regexp-search-ring-max default-ring-max) - '(search-ring-max default-ring-max))) - -(when (require 'minibuffer nil t) - (custom-theme-set-variables 'use-package - '(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-theme-set-variables 'use-package - '(mouse-drag-copy-region t) - '(mouse-wheel-progressive-speed nil) - '(mouse-yank-at-point t))) - -(when (require 'paren nil t) - (custom-theme-set-variables 'use-package - '(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-theme-set-variables 'use-package - '(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-theme-set-variables 'use-package - '(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-theme-set-variables 'use-package - '(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-theme-set-variables 'use-package - '(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-theme-set-variables 'use-package - '(vc-follow-symlinks t) - '(vc-make-backup-files t))) - -(when (require 'window nil t) - (custom-theme-set-variables 'use-package - '(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 deleted file mode 100644 index ed41a61..0000000 --- a/lisp/acdw-funs.el +++ /dev/null @@ -1,262 +0,0 @@ -;;; 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 deleted file mode 100644 index e2258fa..0000000 --- a/lisp/acdw-macs.el +++ /dev/null @@ -1,293 +0,0 @@ -;;; 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 deleted file mode 100644 index 30c4f44..0000000 --- a/lisp/acdw.el +++ /dev/null @@ -1,79 +0,0 @@ -;;; 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/graveyard.el b/lisp/graveyard.el deleted file mode 100644 index 89a776d..0000000 --- a/lisp/graveyard.el +++ /dev/null @@ -1,50 +0,0 @@ -;;; 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 deleted file mode 100644 index d2d5e77..0000000 --- a/lisp/init-org.el +++ /dev/null @@ -1,144 +0,0 @@ -;;; 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/upload-junk.el b/lisp/upload-junk.el deleted file mode 100644 index 5a9da84..0000000 --- a/lisp/upload-junk.el +++ /dev/null @@ -1,47 +0,0 @@ -;;; 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 deleted file mode 100644 index ec84f56..0000000 --- a/lisp/yoke.el +++ /dev/null @@ -1,392 +0,0 @@ -;;; 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: - -;; THIS IS A WORK IN PROGRESS. DON'T USE IT. - -;;; Code: - -(require 'cl-lib) -(require 'package-vc) - -;;; User options - -(defgroup yoke nil - "Customizations for `yoke'." - :group 'convenience - :prefix "yoke-") - -(defcustom yoke-directory package-user-dir - "Where to put yoked packages." - :type 'file) - -(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. - - Other pairs may be valid for a given backend; see that - backend's `yoke-install' function for more details. - -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: - - `:after' (FEATURE...) - - `:require' (FEATURE...) - - `:depends' (PACKAGE-SPEC...) - - `:build' (ACTION...) - - `:unless' (PREDICATE) - - `:when' (PREDICATE) - -Other keywords are ignored. - -\(fn (PACKAGE [SPEC]) [BODY-ARGS] BODY...)" - (declare (indent 1)) - (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)) - (unless (if unlessp (plist-get body :unless) nil)) - ;; Body - (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. -FN is called with no arguments." - (if after-init-time - (funcall fn) - (add-hook 'after-init-hook fn))) - -(defmacro yoke--eval-after (prereqs &rest body) - "Evaluate body after PREREQS. -PREREQS can be a feature, a number, `:init', or a list of those. - -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. - -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