From aab5bfd074e57d06a79e39d7c7c4760e1f385a06 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Mon, 17 Oct 2022 21:41:28 -0500 Subject: Bankruptcy 9 --- .gitignore | 3 +- early-init.el | 129 +- eshell/aliases | 4 - init.el | 2900 +++---------------------------------- lisp/+Info.el | 84 -- lisp/+ace-window.el | 40 - lisp/+apheleia.el | 50 - lisp/+avy.el | 97 -- lisp/+bongo.el | 60 - lisp/+browse-url.el | 156 -- lisp/+burly.el | 63 - lisp/+casing.el | 82 -- lisp/+chicken.el | 34 - lisp/+circe.el | 285 ---- lisp/+compat.el | 64 - lisp/+compile.el | 20 - lisp/+consult.el | 47 - lisp/+crux.el | 58 - lisp/+cus-edit.el | 80 - lisp/+dired.el | 28 - lisp/+ecomplete.el | 45 - lisp/+elfeed.el | 185 --- lisp/+elisp.el | 18 - lisp/+emacs.el | 434 ------ lisp/+embark.el | 28 - lisp/+emms.el | 46 - lisp/+eshell.el | 126 -- lisp/+eww.el | 71 - lisp/+expand-region.el | 24 - lisp/+finger.el | 46 - lisp/+flyspell-correct.el | 24 - lisp/+god-mode.el | 17 - lisp/+hideshow.el | 44 - lisp/+init.el | 117 -- lisp/+ispell.el | 97 -- lisp/+jabber.el | 278 ---- lisp/+key.el | 106 -- lisp/+kmacro.el | 70 - lisp/+link-hint.el | 169 --- lisp/+lisp.el | 195 --- lisp/+message.el | 26 - lisp/+minibuffer.el | 14 - lisp/+modeline.el | 488 ------- lisp/+mwim.el | 42 - lisp/+notmuch.el | 97 -- lisp/+nyan-mode.el | 42 - lisp/+orderless.el | 60 - lisp/+org-attach.el | 29 - lisp/+org-capture.el | 164 --- lisp/+org-drawer-list.el | 47 - lisp/+org-wc.el | 112 -- lisp/+org.el | 816 ----------- lisp/+ox.el | 29 - lisp/+paredit.el | 26 - lisp/+pdf-tools.el | 38 - lisp/+pulse.el | 52 - lisp/+scratch.el | 77 - lisp/+setup.el | 216 --- lisp/+shr.el | 51 - lisp/+slack.el | 27 - lisp/+sly.el | 18 - lisp/+straight.el | 42 - lisp/+tab-bar.el | 394 ----- lisp/+titlecase.el | 30 - lisp/+util.el | 94 -- lisp/+vertico.el | 24 - lisp/+vterm.el | 19 - lisp/+window.el | 130 -- lisp/+xkcd.el | 16 - lisp/+ytdious.el | 21 - lisp/+zzz-to-char.el | 16 - lisp/acdw.el | 595 ++------ lisp/dawn.el | 74 - lisp/elephant.el | 58 - lisp/find-script.el | 36 - lisp/gdrive.el | 130 -- lisp/hide-cursor-mode.el | 116 -- lisp/long-s-mode.el | 67 - lisp/private.el | 23 - lisp/reading.el | 85 -- lisp/system.el | 179 --- lisp/user-save.el | 137 -- lisp/yoke.el | 125 ++ machines/bob.el | 69 - machines/gnu-linux.el | 5 - machines/larry.el | 13 - machines/windows-nt.el | 23 - readme.md | 8 - snippets/emacs-lisp-mode/+feature | 14 - snippets/fundamental-mode/gpl3 | 677 --------- snippets/org-mode/sc | 4 - snippets/scheme-mode/chicken | 8 - snippets/sh-mode/getopts | 10 - 93 files changed, 411 insertions(+), 11726 deletions(-) delete mode 100644 eshell/aliases delete mode 100644 lisp/+Info.el delete mode 100644 lisp/+ace-window.el delete mode 100644 lisp/+apheleia.el delete mode 100644 lisp/+avy.el delete mode 100644 lisp/+bongo.el delete mode 100644 lisp/+browse-url.el delete mode 100644 lisp/+burly.el delete mode 100644 lisp/+casing.el delete mode 100644 lisp/+chicken.el delete mode 100644 lisp/+circe.el delete mode 100644 lisp/+compat.el delete mode 100644 lisp/+compile.el delete mode 100644 lisp/+consult.el delete mode 100644 lisp/+crux.el delete mode 100644 lisp/+cus-edit.el delete mode 100644 lisp/+dired.el delete mode 100644 lisp/+ecomplete.el delete mode 100644 lisp/+elfeed.el delete mode 100644 lisp/+elisp.el delete mode 100644 lisp/+emacs.el delete mode 100644 lisp/+embark.el delete mode 100644 lisp/+emms.el delete mode 100644 lisp/+eshell.el delete mode 100644 lisp/+eww.el delete mode 100644 lisp/+expand-region.el delete mode 100644 lisp/+finger.el delete mode 100644 lisp/+flyspell-correct.el delete mode 100644 lisp/+god-mode.el delete mode 100644 lisp/+hideshow.el delete mode 100644 lisp/+init.el delete mode 100644 lisp/+ispell.el delete mode 100644 lisp/+jabber.el delete mode 100644 lisp/+key.el delete mode 100644 lisp/+kmacro.el delete mode 100644 lisp/+link-hint.el delete mode 100644 lisp/+lisp.el delete mode 100644 lisp/+message.el delete mode 100644 lisp/+minibuffer.el delete mode 100644 lisp/+modeline.el delete mode 100644 lisp/+mwim.el delete mode 100644 lisp/+notmuch.el delete mode 100644 lisp/+nyan-mode.el delete mode 100644 lisp/+orderless.el delete mode 100644 lisp/+org-attach.el delete mode 100644 lisp/+org-capture.el delete mode 100644 lisp/+org-drawer-list.el delete mode 100644 lisp/+org-wc.el delete mode 100644 lisp/+org.el delete mode 100644 lisp/+ox.el delete mode 100644 lisp/+paredit.el delete mode 100644 lisp/+pdf-tools.el delete mode 100644 lisp/+pulse.el delete mode 100644 lisp/+scratch.el delete mode 100644 lisp/+setup.el delete mode 100644 lisp/+shr.el delete mode 100644 lisp/+slack.el delete mode 100644 lisp/+sly.el delete mode 100644 lisp/+straight.el delete mode 100644 lisp/+tab-bar.el delete mode 100644 lisp/+titlecase.el delete mode 100644 lisp/+util.el delete mode 100644 lisp/+vertico.el delete mode 100644 lisp/+vterm.el delete mode 100644 lisp/+window.el delete mode 100644 lisp/+xkcd.el delete mode 100644 lisp/+ytdious.el delete mode 100644 lisp/+zzz-to-char.el delete mode 100644 lisp/dawn.el delete mode 100644 lisp/elephant.el delete mode 100644 lisp/find-script.el delete mode 100644 lisp/gdrive.el delete mode 100644 lisp/hide-cursor-mode.el delete mode 100644 lisp/long-s-mode.el delete mode 100644 lisp/private.el delete mode 100644 lisp/reading.el delete mode 100644 lisp/system.el delete mode 100644 lisp/user-save.el create mode 100644 lisp/yoke.el delete mode 100644 machines/bob.el delete mode 100644 machines/gnu-linux.el delete mode 100644 machines/larry.el delete mode 100644 machines/windows-nt.el delete mode 100644 readme.md delete mode 100644 snippets/emacs-lisp-mode/+feature delete mode 100644 snippets/fundamental-mode/gpl3 delete mode 100644 snippets/org-mode/sc delete mode 100644 snippets/scheme-mode/chicken delete mode 100644 snippets/sh-mode/getopts diff --git a/.gitignore b/.gitignore index bc45f59..f7f259c 100644 --- a/.gitignore +++ b/.gitignore @@ -19,7 +19,8 @@ var/ eshell/* !eshell/aliases url/ +spell-fu/ +yoke/ # put random stuff in here scratch.el -spell-fu/ diff --git a/early-init.el b/early-init.el index 615b417..173625f 100644 --- a/early-init.el +++ b/early-init.el @@ -1,25 +1,6 @@ -;;; early-init.el -*- lexical-binding: t; coding: utf-8-unix -*- - -;; Author: Case Duckworth -;; Created: Sometime during Covid-19, 2020 -;; Keywords: configuration -;; URL: https://tildegit.org/acdw/emacs - -;;; License: - -;; Everyone is permitted to do whatever they like with this software -;; without limitation. This software comes without any warranty -;; whatsoever, but with two pieces of advice: -;; - Be kind to yourself. -;; - Make good choices. - -;;; Commentary: - -;; Starting with Emacs 27.1, early-init.el is sourced before -;; package.el and any graphical frames. In this file, I set up frame -;; parameters and packaging infrastructure. - -;;; Code: +;;; emacs early init -*- lexical-binding: t; -*- +;; by C. Duckworth +(provide 'early-init) ;;; Speed up init @@ -60,19 +41,6 @@ restore that." (unless (eq debug-on-error 'startup) (+set-during-startup 'debug-on-error 'init)) -;;; Set up extra load paths and functionality - -(push (locate-user-emacs-file "lisp") load-path) -(require 'acdw) -(require '+compat) - -(+define-dir .etc (locate-user-emacs-file ".etc") - "Directory for all of Emacs's various files. -See `no-littering' for examples.") - -(+define-dir sync/ (expand-file-name "~/Sync") - "My Syncthing directory.") - ;;; Default frame settings (setq default-frame-alist '((tool-bar-lines . 0) @@ -89,76 +57,35 @@ See `no-littering' for examples.") ;; (bottom . right)) ) -;;; No littering! -;; We install `no-littering' package below, but we can set the variables now. +;;; Set up extra load paths and functionality -(setq no-littering-etc-directory .etc - no-littering-var-directory .etc - straight-base-dir .etc) +(push (locate-user-emacs-file "lisp") load-path) +(require 'acdw) -;; https://github.com/emacscollective/no-littering/wiki/Setting-gccemacs'-eln-cache +(+define-dir .etc (locate-user-emacs-file ".etc") + "Directory for all of Emacs's various files. +See `no-littering' for examples.") -(when (boundp 'comp-eln-load-path) - (setcar comp-eln-load-path (expand-file-name (.etc "eln-cache" t)))) +(+define-dir sync/ (expand-file-name "~/Sync") + "My Syncthing directory.") ;;; Packages (setq package-enable-at-startup nil - package-quickstart nil - straight-host-usernames '((github . "duckwork") - (gitlab . "acdw")) - straight-check-for-modifications '(check-on-save - find-when-checking)) - -;; Bootstrap straight.el -;; https://github.com/raxod502/straight.el - -(+with-message "Bootstrapping straight" - (defvar bootstrap-version) - (let ((bootstrap-file - (expand-file-name - "straight/repos/straight.el/bootstrap.el" - straight-base-dir)) - (bootstrap-version 5)) - (unless (file-exists-p bootstrap-file) - (with-current-buffer - (url-retrieve-synchronously - (concat "https://raw.githubusercontent.com/" - "raxod502/straight.el/develop/install.el") - 'silent 'inhibit-cookies) - (goto-char (point-max)) - (eval-print-last-sexp))) - (load bootstrap-file nil 'nomessage))) - -;; Early-loaded packages -- those that, for some reason or another, -;; need to be ensured to be loaded first. - -(require 'straight-x) - -(dolist (pkg '(el-patch - no-littering - setup - straight ; already installed, but what the hell - )) - (straight-use-package pkg) - (require pkg) - (require (intern (format "+%s" pkg)) nil :noerror)) - -;; Setup `setup' - -(add-to-list 'setup-modifier-list '+setup-wrap-to-demote-errors) -(unless (memq debug-on-error '(nil init)) - (define-advice setup (:around (fn head &rest args) +setup-report) - (+with-progress ((format "[Setup] %S..." head)) - (apply fn head args)))) - -;;; Appendix - -;; Get rid of a dumb alias. straight-ಠ_ಠ-mode really slows down all -;; minibuffer completion functions. Since it's a (rarely-used, even) -;; alias anyway, I just define it back to nil. By the way, the alias -;; is `straight-package-neutering-mode'. -(defalias 'straight-ಠ_ಠ-mode nil) - -(provide 'early-init) -;;; early-init.el ends here + package-quickstart nil) + +(require 'yoke) + +(yoke compat "https://git.sr.ht/~pkal/compat") + +(yoke no-littering "https://github.com/emacscollective/no-littering" + (require 'no-littering) + (setq no-littering-etc-directory .etc + no-littering-var-directory .etc + custom-file (.etc "custom.el")) + (when (boundp 'comp-eln-load-path) + (setcar comp-eln-load-path (expand-file-name (.etc "eln-cache" t)))) + (when (fboundp 'startup-redirect-eln-cache) + (startup-redirect-eln-cache + (convert-standard-filename + (.etc "eln-cache/"))))) diff --git a/eshell/aliases b/eshell/aliases deleted file mode 100644 index f47cb21..0000000 --- a/eshell/aliases +++ /dev/null @@ -1,4 +0,0 @@ -alias sudo eshell/sudo $* -alias ff find-file $1 -alias e find-file $1 -alias edit find-file $1 diff --git a/init.el b/init.el index bed69ee..d7a55d4 100644 --- a/init.el +++ b/init.el @@ -1,2744 +1,176 @@ -;;; init.el --- Emacs initiation file -*- lexical-binding: t -*- - -;; Author: Case Duckworth -;; Created: Sometime during Covid-19, 2020 -;; Keywords: configuration -;; URL: https://tildegit.org/acdw/emacs -;; Bankruptcy: 8 - -;;; License: - +;;; emacs init --- an init for emacs -*- lexical-binding: t; -*- +;; by C. Duckworth +;; URL: https://git.acdw.net/emacs +;; Bankruptcy: 9 +;; ;; Everyone is permitted to do whatever they like with this software ;; without limitation. This software comes without any warranty ;; whatsoever, but with two pieces of advice: ;; - Be kind to yourself. ;; - Make good choices. -;;; Commentary - -;; My init.el. There are many like it, but this one is mine. - -;; Ideas: -;; [[https://emacs.stackexchange.com/questions/17278/truncate-only-certain-lines-and-use-continuation-lines-elsewhere][Truncate org-mode headings]] -;; [[https://emacs.stackexchange.com/questions/7432/make-visual-line-mode-more-compatible-with-org-mode][another link that might be useful for truncating]] - -;;; Code: - -(let ((early-features `((early-init . ,(locate-user-emacs-file "early-init")) - acdw private +key))) - (dolist (feature early-features) - (require (or (car-safe feature) feature) (cdr-safe feature) :noerror))) - -(setup (:require +casing) - (:global "M-u" #'universal-argument) - (+casing-mode +1)) - -(setup (:require +emacs) - ;; +emacs.el contains super-basic defaults that are basically necessary for - ;; good functioning. In this block, I add extra things or more "experimental" - ;; ones that might not belong in a separate file. - (:also-load +lisp) - (:option truncate-string-ellipsis "…" - ring-bell-function 'ignore - read-file-name-completion-ignore-case t) - ;; Bindings - (:global "C-x C-k" #'kill-current-buffer - "C-M--" #'+goto-matching-paren - "C-c v" #'visible-mode - "C-M-;" #'+lisp-comment-or-uncomment-sexp - "C-x C-o" #'+switch-to-last-buffer - "C-x o" #'+switch-to-last-buffer - "C-x C-l" #'+open-paragraph ; original: downcase-region - "C-w" #'+kill-word-backward-or-region - "C-" #'+backward-kill-word - "C-x TAB" #'+indent-rigidly - "" #'flyspell-mode - "C-\\" nil ; original: toggle-input-method - "C-/" #'undo-only - "C-?" #'undo-redo) - ;; Disable bindings - (:global "M-j" nil - "" nil) - (:+leader "C-d e" #'toggle-debug-on-error - "C-d q" #'toggle-debug-on-quit) - ;; C-h deletes backward - see https://idiomdrottning.org/bad-emacs-defaults - (global-set-key (kbd "C-h") 'delete-backward-char) - (keyboard-translate ?\C-h ?\C-?) - ;; Faces - (dolist (face '(line-number - line-number-major-tick - line-number-minor-tick - line-number-current-line)) - (:face face '((t (:inherit fixed-pitch))))) - ;; Hooks - (add-hook 'prog-mode-hook #'turn-on-auto-fill) - (add-hook 'prog-mode-hook #'font-lock-todo-insinuate) - (add-hook 'text-mode-hook #'turn-on-auto-fill) ; XXX: do I want this ?? - (add-hook 'special-mode-hook #'turn-off-auto-fill) +(progn + ;; Settings + (setq truncate-string-ellipsis "…" + ring-bell-function #'ignore + read-file-name-completion-ignore-case t) + ;; Keys + (define-keys (current-global-map) + "C-x C-k" #'kill-current-buffer + "C-/" #'undo-only + "C-?" #'undo-redo + "M-j" nil + "" nil) ;; Advice - (advice-add #'completing-read-multiple :filter-args #'+crm-indicator) - ;; https://old.reddit.com/r/emacs/comments/rlli0u/whats_your_favorite_defadvice/hph14un/ (define-advice keyboard-escape-quit (:around (fn &rest r)) - "Don't close splits on `keyboard-escape-quit'." + "Don't close quits on `keyboard-escape-quit'." (let ((buffer-quit-function #'ignore)) - (apply fn r)))) - -(setup (:require +init) - (:local-hook user-save-before-save-hook #'+init-sort) - (+with-ensure-after-init - (:hook #'+init-add-setup-to-imenu))) - -(setup (:require +window)) - -(setup (:require auth-source) - (:option auth-sources (list 'default - "secrets:passwords" - (private/ "authinfo"))) - (:with-mode authinfo-mode - (:local-set truncate-lines t))) - -(setup (:require autoinsert) - ;; (auto-insert-mode +1) - ) - -(setup (:require cus-edit) - ;; I don't use Custom to actually /make/ any customizations, but it's handy to - ;; (A) see what options are available and (B) persist some changes across - ;; restarts, for example, `safe-local-variables'. - (:require +cus-edit) - (:option custom-file (private/ "custom.el") - custom-magic-show nil - custom-magic-show-button t - custom-raised-buttons nil - custom-unlispify-tag-names nil - custom-variable-default-form 'lisp) - (dolist (var '(safe-local-variable-values - warning-suppress-types)) - (add-to-list '+custom-variable-allowlist var)) - ;; Load customizations now, and after init (to capture other possible - ;; variables I want to load) XXX: this is dumb - (+with-ensure-after-init - (+custom-load-ignoring-most-customizations)) - (advice-add #'custom-buffer-create-internal :after #'+cus-edit-expand-widgets) - (:with-mode Custom-mode - (:local-set imenu-generic-expression +cus-edit-imenu-generic-expression))) - -(setup (:require find-script)) - -(setup (:require goto-addr) - (if (fboundp #'global-goto-address-mode) - (global-goto-address-mode) - (add-hook 'after-change-major-mode-hook #'goto-address-mode))) - -(setup (:require pulse) - (:also-load +pulse) - (:option pulse-flag nil - pulse-delay 0.5 - pulse-iterations 1) - (dolist (command '(+ace-window-or-switch-buffer - pop-mark pop-global-mark - Info-history-back Info-history-forward - )) - (add-to-list '+pulse-location-commands command)) - (+ensure-after-init #'+pulse-location-mode)) - -(setup (:require reading) - ;;(:hook-into view-mode) ; XXX doesn't go back - ) - -(setup (:require user-save) - (add-hook 'user-save-before-save-hook #'+clean-empty-lines) - (add-hook 'user-save-before-save-hook (defun user-save@save-some-buffers () - (save-some-buffers t t))) - (user-save-global-mode +1)) - -(setup (:require winner) - (winner-mode +1)) - -(setup +key - (+ensure-after-init #'+key-global-mode)) - -(setup _work - (with-eval-after-load 'bbdb - (require '_work))) - -(setup abbrev - (:option abbrev-file-name (sync/ "abbrev.el") - save-abbrevs 'silent) - (with-eval-after-load 'user-save - (:with-mode edit-abbrevs-mode - (:hook #'user-save-mode-disable))) - (:hook-into text-mode - circe-chat-mode)) - -(setup autorevert - (:option global-auto-revert-non-file-buffers t - auto-revert-verbose nil) - (global-auto-revert-mode +1)) - -(setup awk-mode - (:apheleia gawk '("gawk" "-f-" "-o-"))) - -(setup bookmark - (:option bookmark-save-flag 1 - bookmark-watch-bookmark-file 'silent - bookmark-set-fringe-mark nil)) - -(setup browse-url - (:require +browse-url) - (:option - browse-url-browser-function 'browse-url-default-browser - +browse-url-browser-function #'eww-browse-url - browse-url-generic-program (seq-some #'executable-find - '("firefox" - "chromium" - "chrome")) - browse-url-chrome-program (seq-some #'executable-find - '("chromium" - "chrome" - "google-chrome-stable")) - browse-url-generic-args (seq-some (lambda (e) - (when (equal (executable-find (car e)) - browse-url-generic-program) - (cdr e))) - '(("firefox" "--new-tab"))) - browse-url-secondary-browser-function (if (executable-find "firefox") - #'browse-url-firefox - #'browse-url-default-browser) - browse-url-new-window-flag nil - browse-url-firefox-arguments '("--new-tab") - browse-url-firefox-new-window-is-tab t) - (defvar +invidious-host - ;; TODO: Add variables for other transformations and what-not. - ;; ... or enable trying multiple servers - ;; "yewtu.be" - "youtube.com" - "Host for invidious instance.") - ;; Set up external browsing URLs. - (add-to-list '+custom-variable-allowlist - '+browse-url-secondary-browser-regexps) - (dolist (domain '("github.com" "gitlab.com" "google.com" - "imgur.com" "twitch.tv" - "pixelfed" "instagram.com" "bibliogram.art" - "reddit.com" "teddit.net" - "twitter.com" "nitter.net" "t.co" - "streamable.com" "spotify.com" - "hetzner.cloud" - "melpa.org")) - (add-to-list '+browse-url-secondary-browser-regexps - (replace-regexp-in-string "\\." "\\\\." domain))) - ;; Set up URL handlers. - (:option browse-url-handlers - (list - (cons (rx bos (or "gemini:" "gopher:")) #'elpher-browse-url-elpher) - (cons (rx ; images - "." (or "jpeg" "jpg" "png" "bmp" "webp") eos) - (lambda (&rest args) - (apply - (cond ((executable-find "mpv") #'+browse-image-with-mpv) - (t #'eww-browse-url)) - args))) - (cons (rx (or ;; videos - "youtube.com" "youtu.be" "invidious" "yewtu.be" - (seq "." (or "mp4" "gif" "mov" "MOV" "webm") eos) - ;; music - "soundcloud.com" "bandcamp.com" - (seq "." (or "ogg" "mp3" "opus" "m4a") eos))) - (lambda (&rest args) - (apply (if (executable-find "mpv") - #'+browse-url-with-mpv - browse-url-secondary-browser-function) - args))) - (cons (+browse-url-secondary-browser-regexps-combine) ; non-text websites - (lambda (&rest args) - (apply browse-url-secondary-browser-function args))) - (cons "xkcd\\.com" - (lambda (&rest args) - (apply (if (fboundp #'xkcd-get) - (progn (require '+xkcd) - #'+xkcd-get-from-url) - +browse-url-browser-function) - args))) - (cons "." ; everything else - (lambda (&rest args) - (apply +browse-url-browser-function args))))) - (with-eval-after-load 'chd - (add-to-list 'browse-url-handlers - (cons chd/url-regexps #'browse-url-chrome))) - ;; Transform URLs before passing to `browse-url' - (:option +browse-url-transformations `((,(rx (or "youtube.com" - "youtu.be")) - . ,+invidious-host) - ("twitter\\.com" . "nitter.net") - ("instagram\\.com" . "bibilogram.art") - (,(rx (or "reddit.com" - "old.reddit.com")) - . "teddit.net") - ("medium\\.com" . "scribe.rip") - ("www\\.npr\\.org" . "text.npr.org") - ;;TODO: Various paste sites - )) - (+browse-url-transform-url-global-mode +1)) - -(setup c-mode - (:with-hook c-mode-common-hook - (:hook #'indent-tabs-mode))) - -(setup calendar - (require '_location) - (:option diary-file (private/ "diary"))) - -(setup compile - (:require +compile) - (:+key "" #'+compile-dispatch) - (:option compilation-always-kill t - compilation-ask-about-save nil - compilation-scroll-output t)) - -(setup dired - (:require dired-x +dired) - (:straight dired+) - (:option 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) - (:local-set truncate-lines t) - (:bind "" #'dired-up-directory - "j" #'+dired-goto-file - "C-j" #'dired-up-directory) - (:hook #'dired-hide-details-mode - #'hl-line-mode - #'lin-mode - #'+dired-dim-git-ignores) - (+with-ensure-after-init ; Necessary because jabber loads later - (:+key "C-x C-j" #'dired-jump)) - (dolist (refresh-after-func '(dired-do-flagged-delete)) - (advice-add refresh-after-func :after #'revert-buffer)) - (with-eval-after-load 'frowny - (add-to-list 'frowny-inhibit-modes #'dired-mode))) - -(setup eldoc - (:hook-into elisp-mode - lisp-interaction-mode)) - -(setup elisp-mode - (:also-load +elisp) - (:option eval-expression-print-length nil - eval-expression-print-level nil) - (:with-mode emacs-lisp-mode - (:hook #'checkdoc-minor-mode)) - (:bind-into (emacs-lisp-mode-map lisp-interaction-mode-map) - "C-c C-c" #'eval-defun - "C-c C-k" #'+elisp-eval-region-or-buffer - "C-c C-z" #'ielm) - (advice-add #'eval-region :around #'+eval-region@pulse)) - -(setup eshell - (:also-load em-smart - em-tramp) - (:require +eshell - esh-module) - (+define-dir eshell/ (locate-user-emacs-file "eshell") - "Where to place Eshell-specific files.") - (:option eshell-aliases-file (eshell/ "aliases") - ;; What are these for??? - eshell-rc-script (eshell/ "profile") - eshell-login-script (eshell/ "login") - eshell-destroy-buffer-when-process-dies t - eshell-directory-name eshell/ - eshell-error-if-no-glob t - eshell-hist-ignore-dups t - eshell-kill-on-exit nil - eshell-prefer-lisp-functions t - eshell-prefer-lisp-variables t - eshell-review-quick-commands nil - eshell-save-history-on-exit t - eshell-scroll-to-bottom-on-input 'all - eshell-smart-space-goes-to-end t - eshell-where-to-jump 'begin - eshell-banner-message "" - eshell-prompt-regexp (rx bol (* (not (any ?# ?$ ?\n))) - " " (any ?# ?$) - (* " "))) - (:+leader "s" #'+eshell-here - "C-s" #'+eshell-here) - (:global "C-c C-z" #'+eshell-here) - (add-to-list 'eshell-modules-list 'eshell-tramp) - (with-eval-after-load 'mwim - (setf (alist-get 'eshell-mode mwim-beginning-of-line-function) - #'eshell-bol)) - (:hook #'eshell-smart-initialize) - (+eshell-eval-after-load - ;; Local modes - (dolist (mode '((hungry-delete-mode . -1))) - (funcall (car mode) (cdr mode))) - ;; Set local settings - (dolist (setting `((outline-regexp . ,eshell-prompt-regexp) - (page-delimiter . ,eshell-prompt-regexp) - (imenu-generic-expression "Prompt" - ,(concat eshell-prompt-regexp - "\\(.*\\)") - 1) - (truncate-lines . t) - (scroll-margin . 0))) - (set (make-local-variable (car setting)) (cdr setting))) - ;; Bind keys - (dolist (binding '(("C-d" . +eshell-quit-or-delete-char))) - (define-key eshell-mode-map - (kbd (car binding)) (cdr binding))) - ;; Environment variables - (dolist (environment '(("PAGER" . "cat"))) - (setenv (car environment) (cdr environment))))) - -(setup eww - (:also-load +eww) - (:option eww-search-prefix "https://duckduckgo.com/html?q=" - url-privacy-level '(email agent cookies lastloc) - eww-use-browse-url (rx bos (or "mailto:" - "gemini:" - "gopher:"))) - (add-hook 'eww-after-render-hook #'reading-mode) - (:hook #'+eww-bookmark-setup - #'+eww-track-readable-mode) - (:bind "b" #'bookmark-set - "B" #'bookmark-jump - "M-n" nil - "M-p" nil)) - -(setup hideshow - (:also-load +hideshow) - (:with-mode hs-minor-mode - (:hook-into prog-mode) - (:bind "C-" #'+hs-cycle - "C-S-" #'+hs-global-cycle - ;; but y tho - "C-S-" #'+hs-global-cycle))) - -(setup ibuffer - (:also-load ibuf-ext) - (:option ibuffer-expert t - ibuffer-show-empty-filter-groups nil - ibuffer-saved-filter-groups - '(("default" - ("Org" (mode . org-mode)) - ("emacs" (or (name . "^\\*scratch\\*$") - (name . "^\\*Messages\\*$") - (name . "^\\*Warnings\\*$") - (name . "^\\*straight-process\\*$") - (name . "^\\*Calendar\\*$"))) - ("customize" (mode . Custom-mode)) - ("emacs-config" (or (filename . ".emacs.d") - (mode . +init-mode))) - ("git" (or (name . "^\*magit") - (name . "^\magit"))) - ("help" (or (mode . help-mode) - (mode . Info-mode) - (mode . helpful-mode))) - ("chat" (or (mode . erc-mode) - (mode . circe-server-mode) - (mode . circe-channel-mode) - (mode . jabber-chat-mode) - (mode . jabber-browse-mode) - (mode . jabber-roster-mode))) - ("shell" (or (mode . eshell-mode) - (mode . shell-mode) - (mode . vterm-mode))) - ("web" (or (mode . elpher-mode) - (mode . eww-mode)))))) - (:hook (defun ibuffer@filter-to-default () - (ibuffer-auto-mode +1) - (ibuffer-switch-to-saved-filter-groups "default")))) - -(setup info - (:also-load +Info) - (dolist (dir (split-string (getenv "INFOPATH") ":" t)) - (add-to-list 'Info-additional-directory-list dir)) - (:with-mode Info-mode ; -_- - (:hook #'reading-mode) - (:local-set +modeline-buffer-position #'+Info-modeline-breadcrumbs - +modeline-position-function #'ignore) - (:bind "c" #'+Info-copy-current-node-name - "w" #'+Info-copy-current-node-name))) - -(setup ispell - (:also-load +ispell) - (:option ispell-program-name (or (executable-find "ispell") - (executable-find "aspell"))) - (put 'ispell-buffer-session-localwords - 'safe-local-variable #'+ispell-safe-local-p) - (add-hook 'user-save-before-save-hook #'+ispell-move-buffer-words-to-dir-locals-hook)) - -(setup kmacro - (:also-load +kmacro) - (with-eval-after-load '+kmacro - ;; (+kmacro-recording-indicator-mode +1) - (+kmacro-block-undo-mode +1))) - -(setup make-mode - (:hook (defun +make-remove-warnings () - (dolist (f '(makefile-warn-continuations - makefile-warn-suspicious-lines)) - (remove-hook 'write-file-functions f t))))) - -(setup midnight - (midnight-mode +1) - (add-hook 'midnight-hook #'recentf-cleanup)) - -(setup minibuffer - (:require +minibuffer) - (:with-map minibuffer-local-map - (:bind "M-/" #'+minibuffer-complete-history))) - -(setup mouse - ;; Brand new for Emacs 28: see https://ruzkuku.com/texts/emacs-mouse.html - ;; Actually, look at this as well: https://www.emacswiki.org/emacs/Mouse3 - (when (fboundp 'context-menu-mode) - (:option context-menu-functions - '(context-menu-ffap - context-menu-region - context-menu-undo - ;; context-menu-dictionary - )) - (context-menu-mode +1)) - (dolist (click '(;; Fix scrolling in the margin - wheel-down double-wheel-down triple-wheel-down - wheel-up double-wheel-up triple-wheel-up)) - (global-set-key (vector 'right-margin click) 'mwheel-scroll) - (global-set-key (vector 'left-margin click) 'mwheel-scroll))) - -(setup net-utils - (:needs "traceroute") - (:require +finger) ; fixes `finger' to use var below - (:option finger-X.500-host-regexps '(".") ; only send username - ) - (with-eval-after-load 'transient - (transient-define-prefix net-utils () - "Networking utilities" - ["Actions" - ("p" "Ping" ping) - ("i" "Ifconfig" ifconfig) - ("w" "Iwconfig" iwconfig) - ("n" "Netstat" netstat) - ("a" "Arp" arp) - ("r" "Route" route) - ("h" "Nslookup host" nslookup-host) - ("d" "Dig" dig) - ("s" "Smb Client" smbclient) - ("t" "Traceroute" traceroute)]) - (:+key "C-z M-n" #'net-utils))) - -(setup notmuch - (:load-from "~/usr/share/emacs/site-lisp/") - (:load-after bbdb) - (:also-load +notmuch +message) - (+define-dir notmuch/ (sync/ "emacs/notmuch") - "Notmuch configuration and data.") - (:option 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")) - ;; Reading mail - (:option notmuch-show-indent-content nil) - (add-hook 'notmuch-show-mode-hook #'visual-fill-column-mode) - (:with-mode notmuch-search-mode - (:bind "RET" #'notmuch-search-show-thread - "M-RET" #'notmuch-tree-from-search-thread - "!" #'+notmuch-search-mark-spam)) - (:with-mode notmuch-tree-mode - (:bind "!" #'+notmuch-tree-mark-spam-then-next)) - ;; Composing mail - (:option message-kill-buffer-on-exit t - message-auto-save-directory nil) - ;; Sending mail - (:option send-mail-function #'sendmail-send-it - mail-specify-envelope-from t - message-sendmail-envelope-from 'header - mail-envelope-from 'header) - ;; Extras and fixes - (with-eval-after-load 'notmuch - (load notmuch-init-file :noerror) - (add-hook 'message-setup-hook #'+message-signature-setup) - (add-hook 'message-send-hook #'+send-mail-dispatch) - (advice-add 'notmuch-tag :filter-args #'+notmuch-correct-tags) - (:option notmuch-saved-searches (list - (list :name "inbox+unread" - :query (+notmuch-query-concat - "tag:inbox" - "tag:unread" - "NOT tag:Spam") - :key "m" - :search-type 'tree) - (list :name "inbox" - :query (+notmuch-query-concat - "tag:inbox" - "NOT tag:Spam") - :key "i" - :search-type 'tree) - (list :name "lists+unread" - :query (+notmuch-query-concat - "tag:/List/" - "tag:unread") - :key "l" - :search-type 'tree) - (list :name "lists" - :query "tag:/List/" - :key "L" - :search-type 'tree) - (list :name "unread" - :query (+notmuch-query-concat - "tag:unread" - "NOT tag:Spam") - :key "u" - :search-type 'tree) - (list :name "flagged" - :query "tag:flagged" - :key "f" - :search-type 'tree) - (list :name "sent" - :query "tag:sent" - :key "t" - :search-type 'tree) - (list :name "drafts" - :query "tag:draft" - :key "d" - :search-type 'tree) - (list :name "all mail" - :query "*" - :key "a" - :search-type 'tree)))) - (:+leader "m" #'notmuch-mua-new-mail "C-m" #'notmuch-jump-search - "n" #'notmuch "C-n" #'notmuch) - ;; For `focus' - (put 'notmuch-message 'bounds-of-thing-at-point 'notmuch-show-message-extent)) - -(setup org - ;; Plain org with the `setup' form for sorting, but I install with straight. - (:straight (org - :type git :host nil - :repo "https://git.savannah.gnu.org/git/emacs/org-mode.git" - :local-repo "org" - :depth full - :pre-build (straight-recipes-org-elpa--build) - :build (:not autoloads) - :files (:defaults - "lisp/*.el" - ("etc/styles/" "etc/styles/*")))) - (:straight (org-contrib - :type git :host nil - :repo "https://git.sr.ht/~bzg/org-contrib")) - ;; DO NOT load system-installed org !!! - (setq load-path - (cl-remove-if (lambda (path) (string-match-p "lisp/org\\'" path)) load-path)) - (:also-load +org) - (with-eval-after-load '+org (+org-agenda-inhibit-hooks-mode +1)) - (:option org-adapt-indentation nil - org-auto-align-tags t - org-archive-mark-done t - org-fold-catch-invisible-edits 'show-and-error - org-clock-clocked-in-display 'mode-line - org-clock-frame-title-format (cons - '(t org-mode-line-string) - (cons " --- " frame-title-format)) - org-clock-string-limit 7 ; just the clock bit - ;; org-clock-string-limit 25 ; gives enough information - org-clock-persist nil - org-confirm-babel-evaluate nil - org-cycle-separator-lines 0 - org-directory (sync/ "org/" t) - org-ellipsis (or truncate-string-ellipsis "…") - org-fontify-done-headline t - org-fontify-quote-and-verse-blocks t - org-fontify-whole-heading-line t - org-hide-emphasis-markers t - org-html-coding-system 'utf-8-unix - org-image-actual-width (list (* (window-font-width) - (- fill-column 8))) - org-imenu-depth 3 - org-indent-indentation-per-level 0 - org-indent-mode-turns-on-hiding-stars nil - org-insert-heading-respect-content t - org-list-demote-modify-bullet '(("-" . "+") - ("+" . "-")) - org-log-done 'time - org-log-into-drawer t - org-num-skip-commented t - org-num-skip-unnumbered t - org-num-skip-footnotes t - org-outline-path-complete-in-steps nil - org-pretty-entities t - org-pretty-entities-include-sub-superscripts nil - org-refile-targets '((nil . (:maxlevel . 2)) - (org-agenda-files . (:maxlevel . 1))) - org-refile-use-outline-path 'file - org-special-ctrl-a/e t - org-special-ctrl-k t - org-src-fontify-natively t - org-src-tab-acts-natively t - org-src-window-setup 'current-window - org-startup-truncated nil - org-startup-with-inline-images t - org-tags-column -77 ;; (- (- fill-column 1 (length org-ellipsis))) - org-todo-keywords - '((sequence "TODO(t)" "WAIT(w@/!)" "ONGOING(o@)" - "|" "DONE(d!)" "ASSIGNED(a@/!)") - (sequence "|" "CANCELED(k@)") - (sequence "MEETING(m)")) - org-use-speed-commands t - org-emphasis-alist '(("*" org-bold) - ("/" org-italic) - ("_" org-underline) - ("=" org-verbatim) - ("~" org-code) - ("+" org-strikethrough))) - ;; (setq org-todo-keywords - ;; '((sequence - ;; "TODO(t)" - ;; "NEXT(n!)" ; next action - ;; "DONE(d)" ; done) - ;; (sequence - ;; "WAIT(w@)" ; waiting to be actionable again - ;; "HOLD(h@/!)" ; actinable, but will do later - ;; "IDEA(i)" ; maybe someday - ;; "KILL(k@/!)" ; cancelled, aborted or is no longer applicable - ;; )))) - (:bind "RET" #'+org-return-dwim - "" #'+org-table-copy-down - "M-RET" #'+org-meta-return - "C-c C-l" #'+org-insert-link-dwim - "C-c C-n" #'+org-next-heading-widen - "C-c C-p" #'+org-previous-heading-widen - "C-c C-o" #'+org-open-at-point-dwim - "`" #'+org-insert-tilde - "~" #'+org-insert-backtick - "C-c C-x l" #'org-toggle-link-display - "C-c C-x m" #'+org-toggle-view-emphasis - "C-c C-x r" #'+org-drawer-list-add-resource - "C-M-k" #'kill-paragraph - "C-M-t" #'transpose-paragraphs) - (:global [f8] #'org-clock-in - [f9] #'org-clock-out - "C-c l" #'org-store-link) - (+with-ensure-after-init - (:hook #'variable-pitch-mode - #'visual-fill-column-mode - #'turn-off-auto-fill - #'org-indent-mode ;; Needed for proper hanging indents in lists - #'prettify-symbols-mode - #'+org-wrap-on-hyphens)) - (:local-set prettify-symbols-alist '(("DEADLINE:" . ?→) - ("SCHEDULED:" . ?↷) - ("CLOSED:" . ?✓)) - ;; electric-pair-pairs - ;; (append electric-pair-pairs - ;; (mapcar (lambda (emph) - ;; (let ((ch (string-to-char (car emph)))) - ;; (cons ch ch))) - ;; org-emphasis-alist)) - ) - (:local-hook user-save-before-save-hook #'+org-before-save@prettify-buffer) - (advice-add #'org-delete-backward-char :override #'+org-delete-backward-char) - ;; (define-advice org-open-at-point (:around (fn &rest r) open-external) - ;; "Open links from org externally." - ;; (let ((browse-url-browser-function browse-url-secondary-browser-function)) - ;; (apply fn r))) - ;; (add-to-list '+custom-variable-allowlist 'org-agenda-files) - (with-eval-after-load 'org - (setf (alist-get "\\.x?html?\\'" org-file-apps nil nil #'equal) - #'+org-open-html) - (org-clock-persistence-insinuate) - (org-link-set-parameters "tel" :follow #'+org-tel-open) - (org-link-set-parameters "sms" :follow #'+org-sms-open) - (setf (alist-get "\\.x?html?\\'" org-file-apps nil nil #'equal) - #'+org-open-html) - (advice-add 'org-agenda :before - (defun +org-agenda-files-uniquify (&rest _) - (setq org-agenda-files - (seq-uniq org-agenda-files))))) - (:face 'org-done '((t (:inherit (modus-themes-subtle-green)))) - 'org-tag '((t (:inherit (secondary-selection)))) - 'org-todo '((t (:inherit (modus-themes-subtle-red))))) - ;; Extra keywords - (font-lock-add-keywords - 'org-mode - '(;; Fancy list bullets - ;; NOTE: these `progn' and `default's are necessary; otherwise Emacs - ;; complains about "Invalid face reference: t" in org-mode buffers, because - ;; `compose-region' returns t. - ("^[ \t]*\\([-]\\) " - (0 (progn (compose-region (match-beginning 1) (match-end 1) "–") 'fixed-pitch) - ;; 'fixed-pitch t - )) - ("^[ \t]*\\([+]\\) " - (0 (progn (compose-region (match-beginning 1) (match-end 1) "•") 'fixed-pitch) - ;; 'fixed-pitch t - )) - ("^[ \t]+\\([*]\\) " - (0 ;; (progn (compose-region (match-beginning 1) (match-end 1) "→") 'fixed-pitch) - 'fixed-pitch t)) - ;; Fancy numbered lists (well, monospaced) - ("^[ \t]*\\(\\(?:[0-9]+\\|[A-Za-z]\\)[.)]\\) " 0 'fixed-pitch t) - ;; Make leading org-heading stars fixed-pitch - ("^\*+ " 0 'fixed-pitch t) - )) - (with-eval-after-load 'form-feed - ;; Horizontal lines - (font-lock-add-keywords - 'org-mode - '(("^-----+" . form-feed--font-lock-face)))) - (put 'browse-url-browser-function 'safe-local-variable - (lambda (val) - (eq (function-get val 'browse-url-browser-kind :autoload) - 'external)))) - -(setup org-agenda - (:option 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) - (unless after-init-time - (:option org-agenda-files (list (sync/ "org/")))) - (dolist (var '(org-agenda-files - org-agenda-file-regexp - org-agenda-templates)) - (add-to-list '+custom-variable-allowlist var)) - (define-advice org-agenda-files (:filter-return (ret)) - "Remove SyncThing's sync-conflict files from the org agenda." - (seq-remove (lambda (f) (string-match-p "sync-conflict" f)) ret)) - (:+leader "a" #'org-agenda "C-a" #'org-agenda) - (:hook #'hl-line-mode) - (:local-set truncate-lines t) - (add-hook 'org-agenda-after-show-hook #'org-narrow-to-subtree)) - -(setup org-attach - (:also-load +org-attach) - (:option org-attach-method 'lns) - (with-eval-after-load '+org-attach - (+org-attach-fix-args-mode +1))) - -(setup org-capture - (:require +org-capture) - (:+leader "c" #'org-capture "C-c" #'org-capture) - (+org-capture-templates-setf "t" "Todo") - (+org-capture-templates-setf "tt" - `("Today!" entry (file "todo.org") - ,(concat "* TODO %^{Title}\n" - "DEADLINE: %t\n" - "\n%?"))) - (+org-capture-templates-setf "ts" - `("Someday..." entry (file "todo.org") - ,(concat "* TODO %^{Title}\n" - ":PROPERTIES:\n" - ":CREATED: [%<%F %T>]\n" - ":END:\n" - "\n%?"))) - (+org-capture-templates-setf "tm" - `("Media" entry (file "todo.org") - ,(concat "* TODO %^{TITLE}\n" - ":PROPERTIES:\n" - ":TITLE: %\\1\n" - ":AUTHOR: %^{AUTHOR}\n" - ":END:\n" - "\n%?"))) - (+org-capture-templates-setf "l" - `("Link" entry (file "links.org") - "* %(+org-insert-link-dwim) %^g\n\n")) - (+org-capture-templates-setf "w" "Work") - (+org-capture-templates-setf "j" - '("Journal entry" plain - (file+olp+datetree "journal.org") - "**** %U\n%i\n%?")) - ;; TODO: Prompt for identity file from ~/.ssh and try to guess the hostname - ;; from there. - (+org-capture-templates-setf "s" - `("SSH Config" plain (file "~/.ssh/config") - ,(concat "\n\nHost %^{Host}" - "\n Hostname %\\1" - "\n User %^{User|%(user-login-name)}" - "\n IdentityFile %(read-file-name \"IdentityFile: \" \"~/.ssh/\")" - "\n IdentitiesOnly yes" - "\n PubkeyAuthentication yes" - "\n Port %^{Port|22}") - )) - (+org-capture-templates-setf "r" - `("Radio station" plain (file "~/.config/radio/stations") - ,(concat "%^{URL} %^{Description} %^{Tags [space delimited]}") - :immediate-finish t)) - (+org-capture-sort)) - -(setup org-id - (:load-after org) - ;; https://helpdeskheadesk.net/2022-03-13/ - (:option org-id-method 'ts - org-attach-id-to-path-function-list '(org-attach-id-ts-folder-format - org-attach-id-uuid-folder-format))) - -(setup ox ; org-export - (:also-load +ox - ox-md) - (:option 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) - (with-eval-after-load 'ox - (+org-export-pre-hooks-insinuate))) - -(setup password-cache - (:option password-cache t - password-cache-expiry (* 60 60))) - -(setup prettify-symbols-mode - (:option prettify-symbols-unprettify-at-point t)) - -(setup prog - (:local-set comment-auto-fill-only-comments t) - (:hook #'prettify-symbols-mode)) - -(setup scheme - ;; I use CHICKEN - (:require +chicken) - (:with-mode scheme-mode - (:file-match (rx ".scm" eos))) - (setq scheme-mit-dialect nil - scheme-program-name (executable-find "csi") - scheme-default-implementation 'chicken) - ;; Scheme complete - (straight-use-package 'scheme-complete) - (autoload 'scheme-smart-complete "scheme-complete" nil t) - (with-eval-after-load 'scheme - (define-key scheme-mode-map (kbd "TAB") #'scheme-complete-or-indent)) - (autoload 'scheme-get-current-symbol-info "scheme-complete" nil t) - (:local-set eldoc-documentation-function #'scheme-get-current-symbol-info - lisp-indent-function #'scheme-smart-indent-function) - (:hook #'eldoc-mode)) - -(setup scratch - (:require +scratch) - (:option initial-major-mode #'lisp-interaction-mode - initial-scratch-message ";;; What good will you work in the world today?\n\n") - (:+leader "." #'+scratch-switch-to-scratch - "C-." #'+scratch-switch-to-scratch - "," #'+scratch-switch-to-text - "C-," #'+scratch-switch-to-text) - (+with-ensure-after-init - (+scratch-text-scratch)) - (add-hook 'kill-buffer-query-functions #'+scratch-immortal)) - -(setup sh - (:option sh-indentation tab-width) - (:hook #'indent-tabs-mode) - (:apheleia shfmt '("shfmt"))) - -(setup shell - (:option shell-command-prompt-show-cwd t) - (:local-set +modeline-position-function - (lambda () (string-replace (getenv "HOME") - "~" - default-directory))) - (:hook #'form-feed-mode)) - -(setup shr - (:also-load +shr) - (:option shr-width (- fill-column 5) ; pad out for wide letters - shr-use-fonts t) - (dolist (mode '(eww-mode - elfeed-show-mode)) - (add-hook (intern (format "%s-hook" mode)) #'+shr-heading-setup-imenu))) - -(setup tab-bar - (:require +tab-bar) - (:option tab-bar-tab-name-function '+tab-bar-basename - tab-bar-tab-name-truncated-max 20 - tab-bar-tab-name-ellipsis truncate-string-ellipsis - tab-bar-show t - tab-bar-close-button-show t - tab-bar-new-button-show t - +tab-bar-menu-bar-icon " ; " - tab-bar-close-button (propertize " × " - 'display t - 'close-tab nil) - tab-bar-new-button (propertize "+ " 'display t)) - ;; I need to set these here so that they take effect /before/ `display-time-mode' - (:option display-time-format "%H:%M" - display-time-mail-file :disable - display-time-load-average-threshold 50) - (:option tab-bar-format '(;;+tab-bar-format-menu-bar - tab-bar-format-history - tab-bar-format-tabs - tab-bar-separator - tab-bar-format-add-tab - +tab-bar-format-align-right - ;;+tab-bar-misc-info - +tab-bar-org-clock - +tab-bar-bongo - ;;+tab-bar-emms - +tab-bar-tracking-mode - +tab-bar-notmuch-count - +tab-bar-timer - +tab-bar-date - +tab-bar-space)) - (tab-bar-mode +1) - (display-time-mode +1)) - -(setup text-mode - (:bind "C-M-k" #'kill-paragraph)) - -(setup timer-list - (:bind "d" #'timer-list-cancel) - (:hook #'hl-line-mode - #'lin-mode)) - -(setup tramp - (el-patch-feature tramp) - (with-eval-after-load 'tramp - (el-patch-defun tramp-debug-buffer-command-completion-p (_symbol buffer) - "A predicate for Tramp interactive commands. - They are completed by \"M-x TAB\" only in Tramp debug buffers." - (with-current-buffer buffer - (el-patch-wrap 2 - (save-restriction - (widen) - (string-equal (buffer-substring 1 10) ";; Emacs:"))))))) - -(setup whitespace - (:option whitespace-line-column nil - whitespace-style '(face trailing tabs tab-mark)) - ;; I want trailing whitespace to be cleaned up, but I don't need to know about it. - (:face 'whitespace-trailing '((t :inherit nil))) - (:hook-into text-mode prog-mode)) - -(setup (:straight 0x0) - (:option 0x0-default-server 'ttm) - (with-eval-after-load 'embark - (define-key embark-region-map (kbd "U") #'0x0-dwim))) - -(setup (:straight ace-window) - (:require +ace-window) - (:option aw-keys '(?a ?s ?d ?f ?g ?h ?j ?k ?l) - aw-display-mode-overlay nil - aw-scope 'frame - aw-minibuffer-flag t) - (:+key "M-o" #'+ace-window-or-switch-buffer) - (:face 'aw-mode-line-face '((t (:foreground "red")))) - (+ace-window-display-mode +1)) - -(setup (:straight (actually-selected-window :host github - :repo "duckwork/actually-selected-window.el")) - (actually-selected-window-mode +1)) - -(setup (:straight adaptive-wrap) - (:with-mode adaptive-wrap-prefix-mode - (:hook-into visual-column-mode))) - -(setup (:straight affe - (or (executable-find "rg") - (and (executable-find "find") - (executable-find "grep")))) - (:load-after consult orderless vertico) - (setq affe-regexp-compiler (defun affe-orderless-regexp-compiler (input &rest _) - (setq input (orderless-pattern-compiler input)) - (cons input (lambda (str) (orderless--highlight input str))))) - (+with-eval-after-loads (affe) - (setq affe-regexp-compiler (defun affe-orderless-regexp-compiler (input &rest _) - (setq input (orderless-pattern-compiler input)) - (cons input (lambda (str) (orderless--highlight input str))))) - (:+key "M-s g" #'affe-grep - "M-s f" #'affe-find))) - -(setup (:straight alert) - (:option alert-default-style 'libnotify)) - -(setup (:straight anzu) - (:option anzu-cons-mode-line-p nil) - (:+key [remap query-replace] #'anzu-query-replace-regexp - [remap query-replace-regexp] #'anzu-query-replace-regexp) - (global-anzu-mode +1) - (:bind-into isearch - [remap isearch-query-replace] #'anzu-isearch-query-replace - [remap isearch-query-replace-regexp] #'anzu-isearch-query-replace-regexp)) - -(setup (:straight apheleia) - (:require apheleia +apheleia) - (+apheleia/user-save-global-mode +1) - (add-to-list 'apheleia-formatters `(fmt . ("fmt" - "-s" ; split long lines but don't refill - "-u" ; one space words, two space sentences - "-w" ; set width (fill-column) - ,(number-to-string (floor (* fill-column 1.1))) - "-g" ; goal width - ,(number-to-string fill-column))))) - -(setup (:straight avy) - (:require avy +avy) - (:option avy-background t - avy-lead-faces - '(avy-lead-face - avy-lead-face-1 avy-lead-face-1 avy-lead-face-1 - avy-lead-face-1 avy-lead-face-1 avy-lead-face-1)) - (:face 'avy-background-face - '((t (:foreground "#888888")))) - (:+key "M-j" #'avy-goto-char-timer) - (:bind-into isearch - "M-j" #'avy-isearch) - (setf (alist-get ?. avy-dispatch-alist) #'avy-action-embark) - ;; (+avy-buffer-face-mode +1) - ) - -(setup (:straight bbdb) - (:straight bbdb-vcard) - (add-hook '+custom-after-load-hook - (defun +bbdb-load () - (:require bbdb-autoloads - bbdb) - (bbdb-initialize 'gnus 'message) - (bbdb-insinuate-message) - (setq bbdb-complete-mail-allow-cycling t)))) - -(setup (:straight (bongo :type git - :flavor melpa - :files ("*.el" "*.texi" "images" "*.rb" "bongo-pkg.el" "*.info") - :pre-build ("makeinfo" "--no-split" "bongo.texi") - :host github - :repo "dbrock/bongo")) - (:also-load +bongo) - (:option bongo-default-directory "~/var/music" - bongo-custom-backend-matchers '((mpv . (("https:") . t))) - +bongo-radio-stations ; use `+bongo-radio' for these - `(;; Local radio - ("KLSU" - . "http://130.39.238.143:8010/stream.mp3") - ("WRKF: NPR for the Capital Region" - . ,(concat "https://playerservices.streamtheworld.com/api/" - "livestream-redirect/WRKFFM.mp3")) - ("WRKF HD-2" - . ,(concat "https://playerservices.streamtheworld.com/api/" - "livestream-redirect/WRKFHD2.mp3")) - ("WBRH: Jazz & More" - . "http://wbrh.streamguys1.com/wbrh-mp3") - ("KBRH Blues & Rhythm Hits" - . "http://wbrh.streamguys1.com/kbrh-mp3") - ;; Soma FM - ("Soma FM Synphaera" - . "https://somafm.com/synphaera256.pls") - ("SomaFM BAGel Radio" - . "https://somafm.com/bagel.pls") - ("SomaFM Boot Liquor" - . "https://somafm.com/bootliquor320.pls") - ("SomaFM Deep Space One" - . "https://somafm.com/deepspaceone.pls") - ("SomaFM Fluid" - . "https://somafm.com/fluid.pls") - ("SomaFM Underground 80s" - . "https://somafm.com/u80s256.pls") - ;; Tildeverse & Friends - ("tilderadio" - . "https://azuracast.tilderadio.org/radio/8000/radio.ogg") - ("vantaradio" - . "https://vantaa.black/radio") - ;; Other online radio - ("BadRadio: 24/7 PHONK" - . "https://s2.radio.co/s2b2b68744/listen") - ("Cafe - lainon.life" - . "https://lainon.life/radio/cafe.ogg.m3u") - ("Everything - lainon.life" - . "https://lainon.life/radio/everything.ogg.m3u") - ("Swing - lainon.life" - . "https://lainon.life/radio/swing.ogg.m3u") - ("Cyberia - lainon.life" - . "https://lainon.life/radio/cyberia.ogg.m3u") - ("Nightwave Plaza - Online Vaporwave Radio" - . "http://radio.plaza.one/opus"))) - (advice-add 'bongo-play :before #'+bongo-stop-all) - (with-eval-after-load 'notifications - (add-hook 'bongo-player-metadata-changed-hook #'+bongo-notify))) - -(setup (:straight brainfuck-mode)) - -(setup (:straight browse-kill-ring) - (:+key "C-M-y" #'browse-kill-ring) - (:option browse-kill-ring-highlight-current-entry t - browse-kill-ring-highlight-inserted-item 'pulse - browse-kill-ring-separator " ") - (:hook #'form-feed-mode)) - -(setup (:straight burly) - (:require burly +burly) - (:global "C-x C-c" #'+burly-save-then-close-frame-remembering)) - -(setup (:straight (cape :host github :repo "minad/cape")) - (let - ;; All available cape capfs listed here. Add them to the front since - ;; they're reversed with `add-to-list'. - ((append-fns '(cape-file - cape-dabbrev - cape-keyword)) - (remove-fns '(cap-abbrev - cape-ispell - cape-dict))) - (dolist (fn append-fns) - (add-to-list 'completion-at-point-functions fn :append)) - (dolist (fn remove-fns) - (setq completion-at-point-functions - (delete fn completion-at-point-functions))) - ;; Fix position of t - (when (memq t completion-at-point-functions) - (setq completion-at-point-functions - (append (delq t completion-at-point-functions) - '(t)))))) - -(setup (:straight circe) - (:require _circe - +circe) - ;; (:also-load circe-chanop) - ;; (+ensure-after-init (lambda () (defalias 'irc '+irc "Start IRC."))) - - ;; Formatting options - ;; (:option - ;; ;; Messages between users - ;; circe-format-action (format (format "%%%ds* {nick} {body}" - ;; (- +circe-left-margin 2)) - ;; " ") - ;; circe-format-say (format "{nick:%1$d.%1$ds} | {body}" - ;; (- +circe-left-margin 3)) - ;; circe-format-self-action circe-format-action - ;; circe-format-self-say (replace-regexp-in-string "|" ">" circe-format-say) - ;; circe-format-notice (format "-{nick:%1$d.%1$ds}---{body}" - ;; (- +circe-left-margin 4)) - ;; circe-format-message (format (format "%%%ds@ *{nick}* {body}" - ;; (- +circe-left-margin 2)) - ;; " ") - ;; circe-format-message-action (replace-regexp-in-string "@" "*" - ;; circe-format-message) - ;; circe-format-self-message (format (format "%%%ds> *{chattarget}* {body}" - ;; (- +circe-left-margin 2)) - ;; " ") - ;; ;; Meta messages - ;; circe-format-server-channel-creation-time (+circe-format-meta - ;; (concat "Channel {channel}" - ;; " created on {date}") t) - ;; circe-format-server-ctcp (+circe-format-meta - ;; (concat "CTCP PING request to {target} from" - ;; " {userhost}: {body}")) - ;; circe-format-server-ctcp-ping-reply (+circe-format-meta - ;; (concat - ;; "CTCP PING reply to {target} from" - ;; " {userhost}: {body}")) - ;; circe-format-server-part (+circe-format-meta "PART {channel}: {reason}") - ;; circe-format-server-quit (+circe-format-meta "QUIT: {reason}") - ;; circe-format-server-quit-channel (+circe-format-meta - ;; "QUIT {channel}: {reason}") - ;; circe-format-server-join (+circe-format-meta "JOIN: {userinfo}") - ;; circe-format-server-join-in-channel (+circe-format-meta - ;; "JOIN {channel}: {userinfo}") - ;; circe-format-server-lurker-activity (+circe-format-meta - ;; "(JOINED {joindelta} ago)") - ;; circe-format-server-message (+circe-format-meta "{body}" t) - ;; circe-fromat-server-mode-change (+circe-format-meta - ;; (concat "MODE: {target} {change}" - ;; " by {setter} ({userhost})") t) - ;; circe-format-server-netmerge (+circe-format-meta - ;; (concat "NETMERGE: {split} at {date}" - ;; " (/WL to see who's still missing)") t) - ;; circe-format-server-netsplit (+circe-format-meta - ;; (concat "NETSPLIT: {split}" - ;; " (/WL to see who left)") t) - ;; circe-format-server-nick-change (+circe-format-meta - ;; "NICK WAS {old-nick} ({userhost})" - ;; "new-nick") - ;; circe-format-server-nick-regain (+circe-format-meta - ;; "NICK REGAINED: {old-nick} ({userhost})" - ;; "new-nick") - ;; circe-format-server-notice (+circe-format-meta "-SERVER NOTICE- {body}" t) - ;; circe-format-server-topic-time (+circe-format-meta - ;; "TOPIC SET BY {setter} on {topic-date}") - ;; circe-format-server-topic-time-for-channel (+circe-format-meta - ;; (concat - ;; "TOPIC ({channel}) SET BY" - ;; " {setter} on {topic-date}")) - ;; circe-format-server-whois-idle (+circe-format-meta "IDLE FOR {idle-duration}" - ;; "whois-nick") - ;; circe-format-server-whois-idle-with-signon (+circe-format-meta - ;; (concat - ;; "IDLE FOR {idle-duration}" - ;; " (signon: {signon-date})") - ;; "whois-nick") - ;; circe-format-server-rejoin (+circe-format-meta - ;; (concat "REJOIN: {userinfo} " - ;; "after {departuredelta}")) - ;; circe-format-server-topic (+circe-format-meta "TOPIC: {new-topic}") - ;; circe-prompt-string (format (format "%%%ds> " - ;; (- +circe-left-margin 2)) - ;; " ")) - - ;; (:option +circe-server-buffer-action (lambda (buf) - ;; (message "Connected to %s" buf)) - ;; +circe-network-inhibit-autoconnect _circe-network-inhibit-autoconnect - ;; circe-network-options _circe-network-options - ;; circe-color-nicks-everywhere t - ;; circe-default-part-message "See You, Space Cowpokes . . ." - ;; circe-default-user user-real-login-name - ;; circe-reduce-lurker-spam t - ;; circe-server-auto-join-default-type :after-auth) - ;; (:bind "C-c C-p" #'circe-command-PART - ;; "C-c C-t" #'+circe-current-topic - ;; "C-l" #'lui-track-jump-to-indicator - ;; "C-" #'+circe-chat@set-prompt) - - ;; XXX: this doesn't quite work right. - ;; (advice-add #'circe-command-PART :after #'+circe-kill-buffer) - ;; (advice-add #'circe-command-QUIT :after #'+circe-quit@kill-buffer) - ;; (advice-add #'circe-command-GQUIT :after #'+circe-gquit@kill-buffer) - - ;; (:with-mode circe-chat-mode - ;; (:local-set lui-input-function #'+lui-filter - ;; +modeline-position-function #'ignore) - ;; (:hook #'enable-circe-color-nicks - ;; #'enable-circe-new-day-notifier - ;; #'+circe-chat@set-prompt - ;; ;; Filters - ;; ;;#'+circe-F/C-mode - ;; ;; For some reason `+circe-shorten-url-mode' won't work right out of - ;; ;; the gate. - ;; ;;(lambda () (run-at-time 0.25 nil #'+circe-shorten-url-mode)) - ;; ) - ;; (:bind "C-c C-s" #'circe-command-SLAP)) - - ;; (:with-mode lui-mode - ;; (:option lui-fill-column (+ fill-column +circe-left-margin) - ;; lui-fill-type nil - ;; lui-max-buffer-size (+bytes 10 :kb) - ;; lui-time-stamp-position 'right-margin - ;; lui-time-stamp-format "| %H:%M" - ;; lui-track-behavior 'before-switch-to-buffer - ;; lui-track-indicator 'bar - ;; lui-fill-remove-face-from-newline nil - ;; lui-formatting-list `((,(+lui-make-formatting-list-rx "*") - ;; 1 lui-strong-face) - ;; (,(+lui-make-formatting-list-rx "_") - ;; 1 lui-emphasis-face) - ;; (,(+lui-make-formatting-list-rx "/") - ;; 1 lui-emphasis-face)) - ;; lui-autopaste-function - ;; (defun +0x0-upload-string (string) - ;; "Upload a string using 0x0." - ;; (with-temp-buffer - ;; (insert string) - ;; (0x0-upload-text (0x0--choose-server))) - ;; (current-kill 0))) - ;; (add-to-list '+pulse-location-commands #'lui-track-jump-to-indicator) - ;; (:face 'lui-track-bar '((t ( :height 10 - ;; :underline ( :color foreground-color - ;; :style line - ;; :position line) - ;; :extend t :inhert (default))))) - ;; (:hook #'visual-line-mode - ;; #'enable-lui-track - ;; #'visual-fill-column-mode - ;; #'enable-lui-autopaste - ;; (defun turn-off-+nyan-mode () (+nyan-local-mode -1)) - ;; (defun turn-off-electric-pair-mode () (electric-pair-mode -1))) - ;; (:local-set fringes-outside-margins t - ;; right-margin-width (length lui-time-stamp-format) - ;; scroll-margin 0 - ;; scroll-step 1 - ;; word-wrap t - ;; wrap-prefix (+string-repeat +circe-left-margin " ") - ;; line-number-mode nil - ;; column-number-mode nil - ;; file-percentage-mode nil - ;; visual-fill-column-extra-text-width - ;; (cons +circe-left-margin 0))) - - (tracking-mode +1) - (:with-mode tracking-mode - (:option tracking-position 'before-modes) - (:bind "C-c C-SPC" (lambda () (interactive) - (if (and +tracking-hide-when-org-clocking - (fboundp 'org-clocking-p) - (org-clocking-p)) - (message "Bro, get back to work!") - (call-interactively #'tracking-next-buffer)))) - (add-to-list 'mode-line-misc-info - '(tracking-mode - tracking-mode-line-buffers))) - - ;; (with-eval-after-load 'topsy - ;; (:option (append topsy-mode-functions) - ;; '(circe-channel-mode . +circe-current-topic))) - - ;; (with-eval-after-load 'circe-color-nicks - ;; (add-hook 'modus-themes-after-load-theme-hook #'circe-nick-color-reset)) - ;; (add-hook 'kill-emacs-hook #'+circe-quit-all@kill-emacs) - ) - -(setup (:straight (clean-kill-ring :host github - :repo "NicholasBHubbard/clean-kill-ring.el")) - (:require) - (:option clean-kill-ring-prevent-duplicates t) - (clean-kill-ring-mode +1)) - -(setup (:straight clhs)) - -(setup (:straight consult) - (+with-ensure-after-init - (:require consult +consult)) - ;; from Consult wiki - (:option register-preview-delay 0 - register-preview-function #'consult-register-format - xref-show-xrefs-function #'consult-xref - xref-show-definitions-function #'consult-xref - tab-always-indent 'complete - completion-in-region-function #'consult-completion-in-region - ) - (:with-mode minibuffer-mode - (:local-set completion-in-region-function #'consult-completion-in-region)) + (apply fn r))) + ;; Themes + (load-theme 'modus-operandi)) + +(yoke auth-source nil + (setq auth-sources `(default "secrets:passwords")) + (setq-local-hook authinfo-mode-hook + truncate-lines t)) + +(yoke consult "https://github.com/minad/consult" + (require 'consult) + (setq register-preview-delay 0 + register-preview-function #'consult-register-format + xref-show-xrefs-function #'consult-xref + tab-always-indent 'complete + completion-in-region-function #'consult-completion-in-region + consult-narrow-key "<" + consult--regexp-compiler #'consult--orderless-regexp-compiler) (advice-add #'register-preview :override #'consult-register-window) - (dolist (binding '(;; C-c bindings (mode-specific-map) - ("C-c h" . consult-history) - ("C-c m" . consult-mode-command) - ("C-c b" . consult-bookmark) - ("C-c k" . consult-kmacro) - ;; C-x bindings (ctl-x-map) - ("C-x M-:" . consult-complex-command) - ("" . consult-buffer) - ("C-x b" . consult-buffer) - ("C-x 4 b" . consult-buffer-other-window) - ("C-x 5 b" . consult-buffer-other-frame) - ;; Custom M-# bindings for fast register access - ("M-#" . consult-register-load) - ("M-'" . consult-register-store) - ("C-M-#" . consult-register) - ;; Other custom bindings - ("M-y" . consult-yank-pop) - ;;(" a" . consult-apropos) - ;; M-g bindings (goto-map) - ("M-g e" . consult-compile-error) - ("M-g f" . consult-flymake) ; or consult-flycheck - ("M-g g" . consult-goto-line) - ("M-g M-g" . consult-goto-line) - ("M-g o" . consult-outline) ; or consult-org-heading - ("M-g m" . consult-mark) - ("M-g k" . consult-global-mark) - ("M-g i" . consult-imenu) - ("M-g M-i" . consult-imenu) - ("M-g I" . consult-imenu-multi) - ;; M-s bindings (search-map) - ("M-s f" . consult-find) - ("M-s F" . consult-locate) - ("M-s g" . consult-grep) - ("M-s G" . consult-git-grep) - ("M-s r" . consult-ripgrep) - ("M-s l" . consult-line) - ("M-s L" . consult-line-multi) - ("M-s m" . consult-multi-occur) - ("M-s k" . consult-keep-lines) - ("M-s u" . consult-focus-lines) - ;; Isearch integration - ("M-s e" . consult-isearch-history))) - (global-set-key (kbd (car binding)) (cdr binding))) - (with-eval-after-load 'isearch-mode - (dolist (binding '(("M-e" . consult-isearch-history) - ("M-s e" . consult-isearch-history) - ("M-s l" . consult-line) - ("M-s L" . consult-line-multi))) - (define-key isearch-mode-map (car binding) (cdr binding)))) - (:+menu "b" #'consult-buffer - "f" #'find-file) - (:bind-into org - "M-g o" #'consult-org-heading) - (advice-add 'consult-yank-pop :after #'+yank@indent) - (+with-eval-after-loads (consult +consult) - (:option consult-narrow-key "<" - consult-project-root-function '+consult-project-root) - (add-to-list 'consult-buffer-filter - (rx "*" (or "scratch" "text") "*")) - (consult-customize consult-theme - :preview-key '(:debounce 0.2 any)) - (consult-customize consult-ripgrep consult-git-grep consult-grep - consult-bookmark consult-recent-file consult-xref - consult--source-recent-file - consult--source-project-recent-file - consult--source-bookmark consult-buffer - :preview-key (kbd "M-,")) - (consult-history-to-modes ((minibuffer-local-map . nil) - (shell-mode-map . shell-mode-hook) - (term-mode-map . term-mode-hook) - (term-raw-map . term-mode-hook) - (comint-mode-map . comint-mode-hook) - (sly-mrepl-mode-map . sly-mrepl-hook))) - (with-eval-after-load 'orderless - (:option consult--regexp-compiler #'consult--orderless-regexp-compiler)))) - -(setup (:straight crux) - ;; yes it's silly I have an addon to this addon. - (:require crux +crux) - (:option crux-shell-func #'crux-eshell - crux-shell-buffer-name "eshell" - +crux-default-date-format "%F") - (:global "C-o" #'crux-smart-open-line - "C-x 4 t" #'crux-transpose-windows - "M-w" #'+crux-kill-ring-save - "C-k" #'+crux-kill-and-join-forward - "C-c d" #'+crux-insert-date-or-time) - (crux-with-region-or-buffer indent-region) - - (el-patch-feature crux) - (with-eval-after-load 'crux - (el-patch-defun crux-reopen-as-root () - "Find file as root if necessary. - - Meant to be used as `find-file-hook'. - See also `crux-reopen-as-root-mode'." - (unless (or - ;; This helps fix for `nov-mode', and possibly others. - (el-patch-add (null buffer-file-name)) - (tramp-tramp-file-p buffer-file-name) - (equal major-mode 'dired-mode) - (not (file-exists-p (file-name-directory buffer-file-name))) - (file-writable-p buffer-file-name) - (crux-file-owned-by-user-p buffer-file-name)) - (crux-find-alternate-file-as-root buffer-file-name)))) - (crux-reopen-as-root-mode +1)) - -(setup (:straight csv-mode)) - -(setup (:straight denote) - (:option denote-directory (expand-file-name "~/var/notes"))) - -(setup (:straight dictionary) - (:option dictionary-use-single-buffer t) - (autoload 'dictionary-search "dictionary" - "Ask for a word and search it in all dictionaries" t) - (:hook #'reading-mode)) - -(setup (:straight diff-hl) - (global-diff-hl-mode +1)) - -(setup (:straight dired-git-info) - (:bind-into dired - ")" #'dired-git-info-mode)) - -(setup (:straight dired-open) - (:load-after dired)) - -(setup (:straight dired-rsync) - (:load-after dired) - (:bind-into dired-mode - "r" #'dired-rsync)) - -(setup (:straight dired-subtree) - (:load-after dired) - (:bind-into dired - "TAB" #'dired-subtree-cycle - "i" #'dired-subtree-toggle)) - -(setup (:straight (discord :host github - :repo "davep/discord.el" - :fork (:repo "duckwork/discord.el")))) - -(setup (:straight dumb-jump) - (add-hook 'xref-backend-functions #'dumb-jump-xref-activate)) - -(setup (:straight ebuku - (executable-find "buku")) - (:option ebuku-display-on-startup 'recent - ebuku-recent-count 100)) - -(setup (:straight edit-server) - (:option edit-server-url-major-mode-alist `(("github\\.com" . ,(if (fboundp 'gfm-mode) - #'gfm-mode - #'markdown-mode)) - ("reddit\\.com" . markdown-mode) - ("notabug\\.org" . markdown-mode) - ("tildes\\.net" . markdown-mode))) - (+with-ensure-after-init - (edit-server-start))) - -(setup (:straight editorconfig) - (:with-mode conf-mode - (:file-match (rx ".editorconfig" eos))) - (with-eval-after-load 'editorconfig - (dolist (m '(emacs-lisp-mode - lisp-mode - scheme-mode)) - (add-to-list 'editorconfig-exclude-modes m))) - (editorconfig-mode +1)) - -(setup (:straight electric-cursor) - (:option electric-cursor-alist '((overwrite-mode . hbar) - (god-local-mode . box) - (t . bar))) - (electric-cursor-mode +1)) - -;; (setup (:straight elfeed) -;; (:require +elfeed) -;; (+define-dir elfeed/ (sync/ "emacs/elfeed/" t)) -;; (:option -;; elfeed-curl-program-name (executable-find "curl") -;; elfeed-use-curl elfeed-curl-program-name -;; elfeed-curl-extra-arguments '("--insecure") -;; elfeed-enclosure-default-dir (cl-loop for dir in '("~/var/download/" -;; "~/Downloads/") -;; if (file-exists-p dir) -;; return dir) -;; elfeed-search-filter "@10-days-ago +unread" -;; elfeed-search-trailing-width 24 -;; elfeed-search-title-min-width 24 -;; elfeed-search-title-max-width 78 -;; elfeed-search-remain-on-entry t -;; elfeed-show-unique-buffers t -;; elfeed-db-directory (elfeed/ "db/" t)) -;; (:+leader "f" #'elfeed "C-f" #'elfeed) -;; (advice-add #'elfeed-search-fetch :after #'beginning-of-buffer) -;; (:with-mode elfeed-search-mode -;; (:bind "&" #'+elfeed-search-browse-generic -;; "w" #'elfeed-search-yank -;; "y" nil -;; "a" #'+elfeed-show-mark-read-and-advance) -;; (:hook #'hl-line-mode) -;; ;; https://old.reddit.com/r/emacs/comments/rlli0u/whats_your_favorite_defadvice/hphfh4e/ -;; (advice-add #'elfeed-search-update--force :after #'elfeed-db-save) -;; (advice-add #'elfeed :before #'elfeed-db-load)) -;; (:with-mode elfeed-show-mode -;; (:bind "SPC" #'+elfeed-scroll-up-command -;; "S-SPC" #'+elfeed-scroll-down-command -;; "&" #'+elfeed-show-browse-generic -;; "RET" #'shr-browse-url -;; "w" #'elfeed-show-yank -;; "y" nil) -;; (:hook #'reading-mode) -;; (:option +elfeed--update-repeat (* 60 30) ; 1/2 hour -;; +elfeed--update-first-time 60)) -;; (+elfeed-update-async-mode +1) -;; (add-hook '+elfeed-update-proceed-hook (defun non-work-hours? () -;; "Return nil if during work hours, t otherwise." -;; (let* ((now (current-time)) -;; (now* (decode-time now)) -;; (work-start* (append '(0 0 8) (cdddr now*))) ; 8:00 AM -;; (work-end* (append '(0 0 18) (cdddr now*))) ; 6:00 PM -;; (work-start (encode-time work-start*)) -;; (work-end (encode-time work-end*))) -;; (or (time-less-p now work-start) -;; (time-less-p work-end now)))))) - -;; (setup (:straight elfeed-org) -;; (:also-load +org-capture) -;; (:option rmh-elfeed-org-files (list (elfeed/ "elfeed.org" t))) -;; (elfeed-org) -;; (+org-capture-templates-setf "f" -;; `("Feed" entry -;; (file+olp ,(car rmh-elfeed-org-files) "Feeds") -;; "* %? %^g"))) - -;; (setup (:straight (elfeed-tube :host github :repo "karthink/elfeed-tube") -;; (or (executable-find "youtube-dl") -;; (executable-find "yt-dlp"))) -;; (:straight (elfeed-tube-mpv :host github :repo "karthink/elfeed-tube")) -;; (:load-after elfeed) -;; (with-eval-after-load 'elfeed -;; (elfeed-tube-setup) -;; (:bind-into (elfeed-show-mode-map elfeed-search-mode-map) -;; "F" #'elfeed-tube-fetch -;; [remap save-buffer] #'elfeed-tube-save) -;; (:bind-into elfeed-show-mode-map -;; "C-c C-f" #'elfeed-tube-mpv-follow-mode -;; "C-c C-w" #'elfeed-tube-mpv-where))) - -(setup (:straight elpher) - (:bind "l" #'elpher-back)) - -(setup (:straight emacs-everywhere - (cl-loop for prog in '("xclip" "xdotool" "xprop" "xwininfo") - if (executable-find prog) - return prog - finally return nil))) - -(setup (:straight embark) - (:require embark - +embark) - (:option prefix-help-command 'embark-prefix-help-command - embark-keymap-prompter-key ";") - (:+key "C-." #'embark-act - "M-." #'embark-dwim - " B" #'embark-bindings) - (:with-map minibuffer-local-map - (:bind "C-." #'embark-act - "M-." #'embark-dwim)) - (:with-map embark-file-map - (:bind "l" #'vlf))) - -(setup (:straight embark-consult) - (:load-after consult embark) - (add-hook 'embark-collect-mode-hook #'consult-preview-at-point-mode)) - -(setup (:straight embrace) - (dolist (mode '(LaTeX-mode org-mode ruby-mode)) - (add-hook (intern (format "%s-hook" mode)) - (intern (format "embrace-%s-hook" mode)))) - (:face 'embrace-help-pair-face '((t ( :inverse-video nil - :inherit font-lock-keyword-face)))) - (:+key "C-," #'embrace-commander)) - -(setup (:straight (ement :host github - :repo "alphapapa/ement.el") - ;; `plz' is a requirement, but isn't on an elpa. - (setup (:straight (plz :host github - :repo "alphapapa/plz.el")) - t))) - -(setup (:straight epithet) - (dolist (hook '(Info-selection-hook - ;; eww-after-render-hook - help-mode-hook - occur-mode-hook)) - (add-hook hook #'epithet-rename-buffer)) - (if (boundp 'eww-auto-rename-buffer) ; Emacs 29 - (:option eww-auto-rename-buffer 'title) - (add-hook 'eww-after-render-hook #'epithet-rename-buffer))) - -(setup (:straight eros) - (:option eros-eval-result-prefix "; " - eros-overlays-use-font-lock nil) - (:hook-into emacs-lisp-mode - lisp-interaction-mode)) - -(setup (:straight eshell-bookmark) - (add-hook 'eshell-mode-hook #'eshell-bookmark-setup)) - -(setup (:straight eshell-syntax-highlighting) - (:hook-into eshell-mode)) - -(setup (:straight eshell-vterm - :quit) - (:load-after eshell) - (defalias 'eshell/v 'eshell-exec-visual) - (eshell-vterm-mode +1)) - -(setup (:straight exec-path-from-shell - (eq system-type 'gnu/linux)) - (require 'exec-path-from-shell) - (dolist (var '("SSH_AUTH_SOCK" - "SSH_AGENT_PID" - "GPG_AGENT_INFO" - "LANG" - "LC_CTYPE" - "XDG_CONFIG_HOME" - "XDG_CONFIG_DIRS" - "XDG_DATA_HOME" - "XDG_DATA_DIRS" - "XDG_CACHE_HOME")) - (add-to-list 'exec-path-from-shell-variables var)) - (exec-path-from-shell-initialize)) - -(setup (:straight expand-region) - (:require expand-region +expand-region) - (:option expand-region-fast-keys-enabled nil) - (:+key "C-=" #'er/expand-region - "C--" #'+er/contract-or-negative-argument)) - -(setup (:straight fennel-mode) - (with-eval-after-load 'apheleia - (when-let ((fnlfmt (executable-find "fnlfmt"))) - (setf (alist-get 'fnlfmt apheleia-formatters) (list fnlfmt 'filepath)) - (setf (alist-get 'fennel-mode apheleia-mode-alist) 'fnlfmt)))) - -(setup (:straight (filldent :host nil - :repo "https://codeberg.org/acdw/filldent.el")) - (:+key "M-q" #'filldent-unfill-toggle)) - -(setup (:straight (flymake-chicken - :host github - :repo "chicken-contrib/flymake-chicken")) - (add-hook 'scheme-mode-hook (defun +flymake-chicken-init () - (add-hook 'flymake-diagnostic-functions - #'flymake-chicken-backend - nil t)))) - -(setup (:straight (flymake-collection :host github - :repo "mohkale/flymake-collection")) - (+ensure-after-init #'flymake-collection-hook-setup)) - -(setup (:straight (flyspell-correct - :fork (:host github :repo "duckwork/flyspell-correct" - :branch "metadata-category"))) - (:load-after flyspell) - (:also-load +flyspell-correct) - (:option flyspell-correct--cr-key ";") - (:bind-into flyspell - "C-;" #'flyspell-correct-wrapper - "" #'+flyspell-correct-buffer)) - -(setup (:straight focus) - (:require) - (add-hook 'modus-themes-after-load-theme-hook - (defun focus-update@after-modus-load () - (modus-themes-with-colors - (:face 'focus-unfocused `((t ( :foreground ,fg-inactive - :background ,bg-inactive - :weight normal - :slant normal - :extend t))))))) - ;; XXX: This doesn't work, because notmuch overlays shit on the buffer - (setf (alist-get 'notmuch-show-mode focus-mode-to-thing) - 'notmuch-message) - (:hook-into notmuch-show-mode)) - -(setup (:straight (forge :host github :repo "magit/forge") - (eq system-type 'gnu/linux)) - (:quit) ; XXX: Somehow missing compat-26 - (add-to-list 'forge-alist - '("tildegit.org" "tildegit.org/api/v1" "tildegit.org" - forge-gitea-repository))) - -(setup (:straight form-feed) - ;; See also `page-break-lines', further down. - (:face 'form-feed-line '((t (:strike-through t)))) - (global-form-feed-mode +1)) - -(setup (:straight (frowny :host nil - :repo "https://codeberg.org/acdw/frowny.el")) - (:option frowny-eyes (rx (any ":=") (opt "'") (? "-"))) - (add-to-list 'frowny-inhibit-modes 'vterm-mode) - (global-frowny-mode +1)) - -;; (setup (:straight (geiser -;; :type git -;; :flavor melpa -;; :files ("elisp/*.el" "doc/*" "geiser-pkg.el") -;; :pre-build ("make" "-Cdoc" "geiser.info") -;; :host gitlab -;; :repo "emacs-geiser/geiser")) -;; (dolist (pkg '( geiser-chicken geiser-guile -;; macrostep-geiser -;; scheme-complete)) -;; (straight-use-package pkg)) -;; (:require +chicken) -;; (+chicken-indentation-insinuate) -;; (:with-mode scheme-mode -;; (:file-match (rx ".scm" eos))) -;; (setf (alist-get "\\.scm\\'" auto-insert-alist nil nil #'equal) -;; '(insert "#!/bin/sh\n#| -*- scheme -*-\nexec csi -s $0 \"$@\"\n|#\n")) -;; ;; (when-let ((scmfmt-exe (executable-find "scmfmt"))) -;; ;; (with-eval-after-load 'apheleia -;; ;; (setf (alist-get 'scmfmt apheleia-formatters) (list scmfmt-exe)) -;; ;; (setf (alist-get 'scheme-mode apheleia-mode-alist) 'scmfmt))) -;; ) - -(setup (:straight (ghelp :repo "https://github.com/casouri/ghelp")) - ;;; XXX: set this up! - (:require)) - -(setup (:straight (git-modes :host github :repo "magit/git-modes")) - (:require git-modes)) - -(setup (:straight god-mode - :quit "I could never get the hang of this.") - (setq god-mode-enable-function-key-translation nil) - (:require god-mode - +god-mode) - (:+key "C-M-g" #'god-mode-all) - (:with-mode god-local-mode - (:bind "i" #'+god-mode-insert - "a" nil))) - -(setup (:straight helpful) - (:+key " f" #'helpful-callable - " v" #'helpful-variable - " k" #'helpful-key - " ." #'helpful-at-point) - ;; Load faster on first invocation by pre-loading a slow function - ;; (see https://github.com/Wilfred/helpful/issues/236) - (run-with-idle-timer 1 nil (lambda () - (require 'info-look) - (info-lookup-setup-mode 'symbol 'emacs-lisp-mode)))) - -(setup (:straight (hippie-completing-read :host nil - :repo "https://codeberg.org/acdw/hippie-completing-read.el")) - (:+key "M-/" #'hippie-completing-read)) - -(setup (:straight hungry-delete) - (:option hungry-delete-chars-to-skip " \t" - hungry-delete-join-reluctantly nil) - (+with-ensure-after-init - (dolist (m '(eshell-mode - nim-mode - python-mode)) - (add-to-list 'hungry-delete-except-modes m))) - (:bind-into paredit - ;; I define these functions here because they really require both packages - ;; to make any sense. So, would I put them in `+hungry-delete' or - ;; `+paredit' ? There's no satisfactory answer. - [remap paredit-backward-delete] - (defun acdw/paredit-hungry-delete-backward (arg) - (interactive "P") - (if (looking-back "[ \t]" 1) - (hungry-delete-backward (or arg 1)) - (paredit-backward-delete arg))) - [remap paredit-forward-delete] - (defun acdw/paredit-hungry-delete-forward (arg) - (interactive "P") - (if (looking-at "[ \t]") - (hungry-delete-forward (or arg 1)) - (paredit-forward-delete arg)))) - (global-hungry-delete-mode +1)) - -(setup (:straight i3wm-config-mode - (executable-find "i3"))) - -(setup (:straight info+) - (:load-after info) - (:option Info-fontify-isolated-quote-flag nil - Info-breadcrumbs-in-mode-line-mode nil - Info-fontify-emphasis-flag nil - Info-fontify-quotations nil - Info-saved-history-file (.etc "info-history")) - (add-hook 'Info-mode-hook #'Info-variable-pitch-text-mode)) - -(setup (:straight isearch-mb) - ;; This complicatedness is an attempt to make it easier to add and - ;; subtract `isearch-mb' bindings using the suggestions in the - ;; project's README. - (:load-after consult anzu) - (:when-loaded - (dolist (spec '((isearch-mb--with-buffer - ("M-e" . consult-isearch) - ("C-o" . loccur-isearch)) - (isearch-mb--after-exit - ("M-%" . anzu-isearch-query-replace) - ("M-s l" . consult-line)))) - (let ((isearch-mb-list (car spec)) - (isearch-mb-binds (cdr spec))) - (dolist (cell isearch-mb-binds) - (let ((key (car cell)) - (command (cdr cell))) - (when (fboundp command) - (add-to-list isearch-mb-list command) - (define-key isearch-mb-minibuffer-map (kbd key) command))))))) - (isearch-mb-mode +1)) - -(setup (:straight (jabber :host nil - :repo "https://codeberg.org/emacs-jabber/emacs-jabber" - :files ("*.el" "*.texi" - ("jabber-fallback-lib" - "jabber-fallback-lib/hexrgb.el" - "jabber-fallback-lib/srv.el" - "jabber-fallback-lib/fsm.el") - "jabber-pkg.el") - :fork ( :host nil - :repo "https://codeberg.org/acdw/emacs-jabber"))) - (:require jabber +jabber) - ;; (:option +jabber-pre-prompt "~ ~ ~\n") - (add-to-list 'jabber-post-connect-hooks 'jabber-enable-carbons) - (:option jabber-account-list '(("acdw@hmm.st")) - jabber-groupchat-buffer-format "%n" - jabber-chat-buffer-format "%n" - jabber-muc-private-buffer-format "%n(%g)" - jabber-muc-header-line-format '("" jabber-muc-topic) - jabber-activity-show-p #'ignore - jabber-muc-decorate-presence-patterns - '(("\\( enters the room ([^)]+)\\| has left the chatroom\\)$") - ("." . jabber-muc-presence-dim)) - jabber-muc-colorize-foreign nil ; doesn't match my color theme - jabber-groupchat-prompt-format "[%t] %n> " - jabber-chat-local-prompt-format "[%t] %n> " - jabber-chat-foreign-prompt-format "[%t] %n> " - ;; jabber-chat-foreign-prompt-format - ;; (concat +jabber-pre-prompt - ;; "%n\n" - ;; (make-string +jabber-ws-prefix - ;; ?\ )) - ;; jabber-chat-local-prompt-format - ;; (concat +jabber-pre-prompt - ;; "%n\n" - ;; (make-string +jabber-ws-prefix - ;; ?\ )) - ;; jabber-groupchat-prompt-format - ;; (concat +jabber-pre-prompt - ;; "%n\n" - ;; (make-string +jabber-ws-prefix - ;; ?\ )) - jabber-auto-reconnect t) - (add-hook 'modus-themes-after-load-theme-hook - (defun jabber-chat@after-modus-themes-load () - (modus-themes-with-colors - (:face 'jabber-chat-prompt-foreign `((t (:foreground ,red))) - 'jabber-chat-prompt-local `((t (:foreground ,blue))) - 'jabber-chat-prompt-system `((t (:foreground ,green))))) - (setq jabber-muc-nick-value (pcase (frame--current-backround-mode (selected-frame)) - ('light 0.5) - ('dark 1.0))) - (+mapc-some-buffers #'+jabber-colors-update - (lambda () (derived-mode-p 'jabber-chat-mode - 'jabber-roster-mode - 'jabber-activity-mode - 'jabber-browse-mode))))) - (dolist (mode '(jabber-chat-mode - jabber-browse-mode - jabber-roster-mode - jabber-console-mode)) - (let ((hook (intern (format "%s-hook" mode)))) - (add-hook hook #'visual-fill-column-mode) - (add-hook hook (defun +electric-pair-disable-local-mode () (electric-pair-local-mode -1))) - ;; (add-hook hook (lambda () (setq-local wrap-prefix " "))) - )) - (with-eval-after-load 'tracking - (add-to-list 'tracking-ignored-buffers "discuss@conference.soprani.ca")) - (:with-mode jabber-chat-mode - (:local-set +modeline-position-function (lambda () - (cond - ((string-match-p "hmm@" (buffer-name)) - "🤔 "))) - file-percentage-mode nil - ;; wrap-prefix (make-string +jabber-ws-prefix ?\ ) - comment-start nil) - (:bind "C-c C-t" #'jabber-muc-set-topic)) - (:+leader "C-j" jabber-global-keymap) - (advice-add 'jabber-activity-add :after #'+jabber-tracking-add) - (advice-add 'jabber-activity-add-muc :after #'+jabber-tracking-add-muc) - ;;; Alerting hooks --- remove echo messages - (remove-hook 'jabber-alert-muc-hooks 'jabber-muc-echo) - (remove-hook 'jabber-alert-presence-hooks 'jabber-presence-echo)) - -(setup (:straight (keepassxc-shim :host nil - :repo "https://codeberg.org/acdw/keepassxc-shim.el")) - (keepassxc-shim-activate)) - -(setup (:straight keychain-environment - (executable-find "keychain")) - (keychain-refresh-environment)) - -(setup (:straight lacarte) - (:+key "" #'lacarte-execute-menu-command)) - -(setup (:straight (lin :host nil - :repo "https://git.sr.ht/~protesilaos/lin")) - (:require) - (lin-global-mode +1)) - -(setup (:straight link-hint) - (:require +link-hint) - (+link-hint-open-secondary-setup) - (+link-hint-open-chrome-setup) - (:option link-hint-avy-style 'at-full - link-hint-avy-all-windows t) - (:+key "M-l" +link-hint-map) - (:with-map +link-hint-map - (:bind "M-l" #'+link-hint-open-link "l" #'+link-hint-open-link - "M-o" #'+link-hint-open-secondary "o" #'+link-hint-open-secondary - "M-m" #'link-hint-open-multiple-links "m" #'link-hint-open-multiple-links - "M-w" #'link-hint-copy-link "w" #'link-hint-copy-link - "M-c" #'+link-hint-open-chrome "c" #'+link-hint-open-chrome))) - -(setup (:straight lua-mode) - (:file-match (rx ".lua" eos))) - -(setup (:straight (machine - :host nil - :repo "https://codeberg.org/acdw/machine.el")) - (+with-ensure-after-init ; So that they override anything here. - ;; Emoji fonts - (let ((ffl (font-family-list)) - (emoji-fonts '("Noto Color Emoji" - "Noto Emoji" - "Segoe UI Emoji" - "Apple Color Emoji" - "FreeSans" - "FreeMono" - "FreeSerif" - "Unifont" - "Symbola"))) - (dolist (font emoji-fonts) - (when (member font ffl) - (set-fontset-font t 'symbol (font-spec :family font) nil :append)))) - (machine-settings-load))) - -(setup (:straight macrostep) - (:require macrostep) - (dolist (m '(emacs-lisp-mode-map - lisp-interaction-mode-map)) - (define-key (symbol-value m) (kbd "C-c e") #'macrostep-expand))) - -(setup (:straight (magit :host github :repo "magit/magit" - :build (:not compile)) - (:straight (transient :host github :repo "magit/transient" - :build (:not compile)))) - (autoload 'transient--with-suspended-override "transient")) - -(setup (:straight marginalia) - (marginalia-mode +1)) - -(setup (:straight markdown-mode) - (:option markdown-hide-markup nil) - (:file-match (rx (or ".md" ".markdown" ".mdown") eos)) - (with-eval-after-load 'visual-fill-column - (:hook #'visual-fill-column-mode)) - (with-eval-after-load 'apheleia - (when-let ((mdfmt-exe (executable-find "markdownfmt"))) - (setf (alist-get 'markdownfmt apheleia-formatters) (list mdfmt-exe)) - (setf (alist-get 'markdown-mode apheleia-mode-alist) 'markdownfmt) - (setf (alist-get 'gfm-mode apheleia-mode-alist) 'markdownfmt)))) - -(setup (:straight (mastodon - :fork (:host nil :repo "https://codeberg.org/acdw/mastodon.el"))) - (:option mastodon-instance-url "https://tiny.tilde.website" - mastodon-active-user "acdw" - mastodon-client--token-file (.etc "mastodon.plstore") - mastodon-auth-source-file (seq-some (lambda (i) - (when (and (stringp i) - (file-exists-p i)) - i)) - auth-sources) - mastodon-tl--show-avatars t - mastodon-tl--enable-proportional-fonts nil) - (:hook #'mastodon-async-mode - #'variable-pitch-mode - #'hl-line-mode - #'lin-mode)) - -(setup (:straight minions) - (minions-mode +1)) - -(setup (:straight (mode-line-bell - :host github :repo "purcell/mode-line-bell" - :fork (:host github :repo "duckwork/mode-line-bell" - :branch "remap-face"))) - ;; This is still, annoyingly, not quite working right. - (:face 'mode-line-bell '((t (:inherit mode-line-highlight)))) - (:option mode-line-bell-flash-time 0.1) - (mode-line-bell-mode +1)) - -(setup (:straight (modus-themes - :host nil - :repo "https://git.sr.ht/~protesilaos/modus-themes")) - (require 'modus-themes (.etc "straight/build/modus-themes/modus-themes")) - (:option modus-themes-mixed-fonts t - modus-themes-bold-constructs t - modus-themes-italic-constructs t - modus-themes-headings '((1 monochrome bold overline) - (2 monochrome bold) - (3 monochrome italic) - (t monochrome))) - (dotimes (facen-1 8) - (let ((facen (1+ facen-1))) - (custom-set-faces - `(,(intern (format "org-level-%s" facen)) - ((t :inherit - (,(intern (format "modus-themes-heading-%s" facen)) - fixed-pitch)) - :now))))) - (:face 'modus-themes-tab-active '((t ( :bold nil))) - 'modus-themes-tab-inactive '((t ( :italic t)))) - - (define-advice modus-themes--current-theme (:around (fn &rest r)) - "Fix a \"nil is not a Modus theme\" error." - (or (apply fn r) - 'modus-operandi)) - - ;; This needs to be after the themes are loaded, I think. - (add-hook 'modus-themes-after-load-theme-hook - (defun +modus-themes-mostly-monochrome () - "Set up mdous-themes to be mostly monochrome." - ;; Major mode in the mode-line - (modus-themes-with-colors - (custom-set-faces - `(font-lock-builtin-face - ((,class :inherit modus-themes-bold - :foreground unspecified))) - `(font-lock-comment-face - ((,class :inherit default - :slant normal - :height 1.0 - :foreground ,fg-comment-yellow))) - `(font-lock-comment-delimiter-face - ((,class :inherit fixed-pitch - :foreground ,fg-comment-yellow))) - `(font-lock-constant-face - ((,class :inherit underline - :foreground unspecified))) - `(font-lock-doc-face - ((,class :inherit modus-themes-slant - :foreground ,fg-docstring))) - `(font-lock-function-name-face - ((,class :foreground unspecified - :slant italic))) - `(font-lock-keyword-face - ((,class :inherit modus-themes-bold - :foreground unspecified))) - `(font-lock-negation-char-face - ((,class :inherit modus-themes-bold - :foreground unspecified))) - `(font-lock-preprocessor-face - ((,class :foreground unspecified))) - `(font-lock-regexp-grouping-backslash - ((,class :foreground ,fg-escape-char-backslash))) - `(font-lock-regexp-grouping-construct - ((,class :foreground ,fg-escape-char-construct))) - `(font-lock-string-face - ((,class :foreground ,fg-special-warm))) - `(font-lock-type-face - ((,class :inherit modus-themes-bold - :foreground unspecified))) - `(font-lock-variable-name-face - ((,class :foreground unspecified))) - `(font-lock-warning-face - ((,class :inherit modus-themes-bold - :foreground ,red-nuanced-fg))) - `(font-lock-todo-face - ((,class :inherit font-lock-comment-face - :foreground ,fg-header - :background ,yellow-intense-bg))) - ;; `(mode-line - ;; ((,class :height 100))) - ;; `(mode-line-inactive - ;; ((,class :height 100))) - ;; `(tab-bar - ;; ((,class :height 100))) - )))) - - (require 'dawn) - (dawn-schedule #'modus-themes-load-operandi - #'modus-themes-load-vivendi)) - -(setup (:straight mwim) - (:require +mwim) - (:option +mwim-passthrough-modes '(comint-mode - eshell-mode - vterm-mode - crossword-mode - geiser-repl-mode)) - (:global "C-a" #'mwim-beginning - "C-e" #'mwim-end)) - -(setup (:straight native-complete) - (with-eval-after-load 'shell - (native-complete-setup-bash)) - (:with-hook shell-mode-hook - (:local-set completion-at-point-functions - (cons 'native-complete-at-point - completion-at-point-functions)))) - -(setup (:straight notmuch-bookmarks) - (:load-after notmuch) - (:when-loaded - (notmuch-bookmarks-mode +1))) - -(setup (:straight notmuch-labeler - :quit "Buggy") - (:load-after notmuch)) - -(setup (:straight (notmuch-tags - :repo "https://git.madhouse-project.org/algernon/notmuch-tags.el" - :fork (:repo "https://codeberg.org/acdw/notmuch-tags.el")))) - -(setup (:straight nov) - (:hook #'visual-fill-column-mode) - (:file-match (rx ".epub" eos))) - -(setup (:straight (nyan-mode - :fork (:repo "duckwork/nyan-mode"))) - (:require nyan-mode +nyan-mode) - (with-eval-after-load 'modus-themes - (add-hook 'modus-themes-after-load-theme-hook - (defun +nyan-modus-update-colors () - (modus-themes-with-colors - (set-face-attribute '+nyan-mode-line nil - :background bg-special-warm)))) - (+nyan-modus-update-colors)) - (+nyan-mode +1)) - -(setup (:straight ol-notmuch)) - -(setup (:straight orderless) - (:require +orderless) - (:option completion-styles '(substring orderless basic) - completion-category-defaults nil - completion-category-overrides - '((file (styles basic partial-completion)) - (command (styles +orderless-with-initialism)) - (variable (styles +orderless-with-initialism)) - (symbol (styles +orderless-with-initialism))) - orderless-component-separator #'orderless-escapable-split-on-space - orderless-style-dispatchers '(+orderless-dispatch))) - -(setup (:straight org-appear) - (:option org-appear-autoemphasis t - org-appear-autoentities t - org-appear-autokeywords t - org-appear-autolinks nil - org-appear-autosubmarkers t - org-appear-delay 0) - (:hook-into org-mode)) - -(setup (:straight org-download) - (:require) - (:option org-download-method 'attach - org-download-backend (cond ((executable-find "curl") 'curl) - ((executable-find "wget") 'wget) - (:else 'url-retrieve))) - (add-hook 'dired-mode-hook 'org-download-enable)) - -(setup (:straight (org-drawer-list - :host github - :repo "d12frosted/org-drawer-list")) - (:load-after org) - (:also-load +org-drawer-list)) - -(setup (:straight org-mime) - (:option org-mime-export-ascii 'utf-8) - (add-hook 'message-mode-hook - (defun org-mime-setup@message-mode () - (local-set-key (kbd "C-c M-o") 'org-mime-htmlize))) - (add-hook 'org-mode-hook - (defun org-mime-setup@org-mode () - (local-set-key (kbd "C-c M-o") 'org-mime-org-buffer-htmlize)))) - -(setup (:straight (org-taskwise - :host nil - :repo "https://codeberg.org/acdw/org-taskwise.el.git")) - (with-eval-after-load 'org - (require 'org-taskwise) - (define-key org-mode-map (kbd "C-x n t") #'org-taskwise-narrow-to-task))) - -(setup (:straight org-wc) - (:load-after org simple-modeline) - (:also-load +org-wc) - (add-hook 'org-mode-hook #'+org-wc-mode)) - -(setup (:straight orglink) - (:option orglink-activate-in-modes '(text-mode prog-mode)) - (global-orglink-mode +1) - (global-goto-address-mode -1)) - -(setup (:straight package-lint)) - -(setup (:straight package-lint-flymake) - (add-hook 'emacs-mode-hook #'package-lint-flymake-setup) - ;; Remove it from init.el files - (add-hook '+init-mode-hook #'flymake-mode-off)) - -(setup (:straight page-break-lines) - (:option page-break-lines-char ?—) - (:hook-into jabber-chat-mode)) - -(setup (:straight paredit) - (:also-load +paredit) - (:bind "DEL" #'paredit-backward-delete - "C-" #'+paredit-backward-kill-word - "C-w" (lambda (arg) (interactive "P") - (+kill-word-backward-or-region arg #'paredit-backward-kill-word)) - "M-s" nil) - (dolist (hook '(emacs-lisp-mode-hook - eval-expression-minibuffer-setup-hook - ielm-mode-hook - lisp-interaction-mode-hook - lisp-mode-hook - scheme-mode-hook - geiser-mode-hook - geiser-repl-mode-hook - fennel-mode-hook - fennel-repl-mode-hook)) - (add-hook hook #'enable-paredit-mode)) - (:also-load eldoc) - (eldoc-add-command #'paredit-backward-delete #'paredit-close-round)) - -(setup (:straight paren-face) - (:hook-into emacs-lisp-mode - ielm-mode sly-repl-mode - lisp-mode - lisp-interaction-mode - scheme-mode)) - -(setup (:straight pdf-tools - (or (executable-find "gcc") - (executable-find "g++"))) - (:also-load +pdf-tools) - (:with-mode pdf-view-mode - (:local-set +modeline-position-function #'+pdf-view-position) - (:file-match (rx ".pdf" eos))) - (pdf-tools-install :no-query)) - -(setup (:straight persistent-scratch) - (:require) - (:option persistent-scratch-save-file (sync/ "emacs/scratch") - persistent-scratch-backup-directory (sync/ "emacs/scratch.d/" t) - persistent-scratch-backup-file-name-format "%Y-%m-%dT%H:%M_%s") - (persistent-scratch-autosave-mode +1) - (+mapc-some-buffers (lambda () (persistent-scratch-mode +1)) - persistent-scratch-scratch-buffer-p-function)) - -(setup (:straight (plancat - :host nil - :repo "https://codeberg.org/acdw/plancat.el")) - (:option plancat-user "acdw")) - -(setup (:straight pocket-reader) - (:option pocket-reader-open-url-default-function #'browse-url) - (:+leader "p" #'pocket-reader - "C-p" #'pocket-reader) - (dolist (mode '((eww-mode-map . eww) - (w3m-mode-map . w3m) - (elfeed-search-mode-map . elfeed-search) - (elfeed-show-mode-map . elfeed-show))) - (with-eval-after-load (cdr mode) - (define-key (symbol-value (car mode)) "\"" #'pocket-reader-add-link)) - (with-eval-after-load '+link-hint - (+link-hint-pocket-add-setup) - (define-key +link-hint-map "M-\"" #'+link-hint-pocket-add) - (define-key +link-hint-map "\"" #'+link-hint-pocket-add)))) - -(setup (:straight rainbow-mode) - (:hook-into prog-mode)) - -(setup (:straight (shell-command+ - :host nil - :repo "https://git.sr.ht/~pkal/shell-command-plus")) - (:option shell-command-prompt "$ ") - (:bind-into dired - "M-!" 'shell-command+) - (:+key "M-!" #'shell-command+)) - -(setup (:straight sicp)) - -(setup (:straight (simple-modeline - :host github :repo "gexplorer/simple-modeline" - :fork (:host github :repo "duckwork/simple-modeline"))) - (:require +modeline) - (:option +modeline-modified-icon-alist '((ephemeral . "~") - (special . "*") - (readonly . "=") - (modified . "+") - (t . "-")) - +modeline-minions-icon "&" - +modeline-buffer-name-max-length 0.35) - ;; Segments - (:option simple-modeline-segments - `(( ; left - +modeline-ace-window-display - +modeline-modified - +modeline-buffer-name - +modeline-major-mode - (lambda () (+modeline-vc " : ")) - +modeline-nyan-on-focused - +modeline-anzu - ) - ( ; right - simple-modeline-segment-process - (lambda () - (unless +tab-bar-misc-info-mode - (+modeline-concat - '(+modeline-track - simple-modeline-segment-misc-info)))) - (lambda () (when (featurep 'dired-rsync) - dired-rsync-modeline-status)) - ,(+modeline-concat - '(+modeline-god-mode - +modeline-kmacro-indicator - +modeline-reading-mode - +modeline-narrowed - +modeline-text-scale - +modeline-input-method) - " ") - +modeline-position - +modeline-spacer - ))) - (simple-modeline-mode +1)) - -(setup (:straight slack) - (:also-load +slack) - (:option slack-prefer-current-team t - slack-buffer-emojify t - slack-thread-also-send-to-room nil - slack-typing-visibility 'buffer - slack-buffer-create-on-notify t - slack-enable-wysiwyg t - slack-file-dir (xdg-user-dir "DOWNLOAD") - slack-display-team-name nil) - (with-eval-after-load '+slack - (+slack-register-teams)) - (with-eval-after-load 'alert - ;; Don't notify for Slack messages - (alert-add-rule :category "slack" - :style 'ignore))) - -;; (setup (:straight sly -;; (defvar +lisp-bin (executable-find "sbcl"))) -;; (:also-load sly-autoloads -;; +sly) -;; (:option inferior-lisp-program +lisp-bin -;; sly-kill-without-query-p t -;; sly-command-switch-to-existing-lisp t) -;; (:with-mode lisp-mode -;; (:bind "C-c C-z" #'sly-mrepl)) -;; (:with-feature sly-mrepl -;; (dolist (key '("RET" "")) -;; (:bind key #'sly-mrepl-return-at-end)) -;; (:bind "C-c C-c" #'sly-mrepl-return))) - -(setup (:straight slime)) - -(setup (:straight smartscan) - (:with-map smartscan-map - (:bind "M-'" nil)) - (:hook-into prog-mode)) - -(setup (:straight (sophomore - :host nil - :repo "https://codeberg.org/acdw/sophomore.el")) - (sophomore-enable #'narrow-to-region) - (sophomore-disable ; These are mostly annoying commands - #'view-hello-file - #'describe-gnu-project - #'suspend-frame) - (sophomore-disable-with 'confirm - #'save-buffers-kill-terminal) - (sophomore-disable-with 'confirm-y - #'+save-buffers-quit) - (sophomore-mode +1)) - -(setup (:straight (spongebob-case - :host nil - :repo "https://codeberg.org/acdw/spongebob-case.el"))) - -(setup (:straight ssh-config-mode) - (:file-match (rx "/.ssh/config" eos) - (rx "/ssh" (? "d") "_config" eos)) - (:with-mode ssh-known-hosts-mode - (:file-match (rx "/knownhosts" eos))) - (:with-mode ssh-authorized-keys-mode - (:file-match (rx "/authorized_keys" (? "2") eos)))) - -;; (setup (:straight super-save) -;; (:option auto-save-default nil -;; super-save-auto-save-when-idle t -;; super-save-idle-duration 30 -;; super-save-exclude '(".gpg") -;; super-save-remote-files nil) -;; (auto-save-visited-mode -1) -;; (super-save-mode +1)) - -(setup (:straight systemd - (executable-find "systemd")) - (:option systemd-man-function 'woman)) - -(setup (:straight (titlecase - :host nil - :repo "https://codeberg.org/acdw/titlecase.el" - :files ("*"))) - (:require titlecase +titlecase) - (add-to-list 'titlecase-skip-words-regexps (rx word-boundary - (+ (any upper digit)) - word-boundary)) - (:with-map +casing-map - (:bind "t" #'titlecase-dwim - "M-t" #'titlecase-dwim - "s" #'+titlecase-sentence-style-dwim - "M-s" #'+titlecase-sentence-style-dwim))) - -(setup (:straight topsy) - (:hook-into ;;prog-mode - circe-chat-mode) - (:when-loaded - (:option - topsy-header-line-format - '(:eval - (list - (propertize " " - 'display - `((space - :align-to - ,(unless (bound-and-true-p visual-fill-column-mode) - 0)))) - (funcall topsy-fn)))))) - -(setup (:straight transpose-frame) - (defvar +transpose-frame-map - (let ((map (make-sparse-keymap))) - (dolist (bind '(("t" . transpose-frame) - ("v" . flip-frame) - ("h" . flop-frame) - ("r" . rotate-frame-clockwise) - ("R" . rotate-frame-anticlockwise))) - (define-key map (car bind) (cdr bind))) - map) - "Map for transposing frames.") - (define-key +key-mode-map (kbd "C-x 5 t") +transpose-frame-map)) - -(setup (:straight trashed) - (:+leader "t" #'trashed) - (:option trashed-action-confirmer #'y-or-n-p - trashed-use-header-line t - trashed-size-format 'human-readable)) - -(setup (:straight undo-fu) (:quit "Trying native undo functionality") - (:option undo-fu-allow-undo-in-region t) - (:global "C-/" #'undo-fu-only-undo - "C-?" #'undo-fu-only-redo)) - -(setup (:straight undo-fu-session) - (:option undo-fu-session-incompatible-files '("/COMMIT_EDITMSG\\'" - "/git-rebase-todo\\'") - undo-fu-session-directory (.etc "undo/" t) - undo-fu-session-compression (cond - ((executable-find "gzip") 'gz) - ((executable-find "bzip2") 'bz2) - ((executable-find "xz") 'xz) - (t nil))) - (global-undo-fu-session-mode +1)) - -(setup (:straight (undo-hl - :host github - :repo "casouri/undo-hl")) - (:require) - (:face 'undo-hl-delete '((t :strikethrough t)) - 'undo-hl-insert '((t :underline t))) - (:hook-into text-mode prog-mode)) - -(setup (:straight valign - :quit "Doesn't work with narrowed tables.") - (:option valign-fancy-bar t) - (:hook-into org-mode - markdown-mode)) - -(setup (:straight (vertico - :host github - :repo "minad/vertico" - :files ("*" "extensions/*" - (:exclude ".git")))) - (:require vertico +vertico) - (:option resize-mini-windows 'grow-only - vertico-count-format nil - vertico-cycle t) - (advice-add #'vertico-next :around #'+vertico-ding-wrap) - (when (boundp 'native-comp-deferred-compilation-deny-list) - (add-to-list 'native-comp-deferred-compilation-deny-list "vertico")) - (vertico-mode +1) - ;; Extensions - (:also-load vertico-directory - vertico-mouse - vertico-quick) - (vertico-mouse-mode +1) - (:with-map vertico-map - (:bind "RET" #'vertico-directory-enter - "DEL" #'vertico-directory-delete-char - "M-DEL" #'vertico-directory-delete-word - "TAB" #'+vertico-widen-or-complete - "M-j" #'vertico-quick-insert)) - (add-hook 'rfn-eshadow-update-overlay-hook #'vertico-directory-tidy)) - -(setup (:straight visual-fill-column) - (:option visual-fill-column-center-text t - (append reading-modes) '(visual-fill-column-mode . +1)) - (:hook #'visual-line-mode) - (:hook-into org-mode) - (advice-add #'text-scale-adjust :after #'visual-fill-column-adjust) - (:global [f12] #'visual-fill-column-mode)) - -(setup (:straight vlf) - (:require vlf-setup)) - -(setup (:straight vterm - (and module-file-suffix - (executable-find "cmake"))) - (:also-load +vterm) - (:option vterm-always-compile-module t - vterm-buffer-name-string "vterm: %s" - vterm-max-scrollback 100000 ; max allowed by vterm-module.h - ) - (advice-add 'counsel-yank-pop-action :around - #'+vterm-counsel-yank-pop-action)) - -(setup (:straight (vundo - :host github - :repo "casouri/vundo"))) - -(setup (:straight web-mode) - (:file-match (rx "." (or "htm" "html" "phtml" "tpl.php" - "asp" "gsp" "jsp" "ascx" "aspx" - "erb" "mustache" "djhtml") - eos)) - (with-eval-after-load 'apheleia - (setf (alist-get 'web-mode apheleia-mode-alist) - 'prettier))) - -(setup (:straight whitespace-cleanup-mode) - (:option whitespace-cleanup-mode-preserve-point t - whitespace-cleanup-mode-only-if-initially-clean nil) - (global-whitespace-cleanup-mode +1)) - -(setup (:straight wrap-region) - (:require wrap-region) - (wrap-region-add-wrappers - '(("*" "*" nil org-mode) - ("~" "~" nil org-mode) - ("/" "/" nil org-mode) - ("=" "=" nil org-mode) - ("+" "+" nil org-mode) - ("_" "_" nil org-mode) - ("$" "$" nil (org-mode latex-mode)))) - (:hook-into org-mode - latex-mode)) - -(setup (:straight xkcd) - (:also-load +xkcd) - (:hook #'visual-fill-column-mode)) - -(setup (:straight xr)) - -(setup (:straight yaml-mode) - (:file-match (rx "." (or "yml" "yaml") eos))) - -(setup (:straight yaoddmuse)) - -(setup (:straight yasnippet) - (:option yas-snippet-dirs (list - (expand-file-name "snippets" user-emacs-directory) - (sync/ "emacs/snippets" t))) - (yas-global-mode +1)) - -(setup (:straight (ytdious - :host github :repo "spiderbit/ytdious" - :fork (:host github :repo "duckwork/ytdious"))) - (:also-load +ytdious) - (:option ytdious-invidious-api-url (if +invidious-host - (concat "https://" +invidious-host) - "https://invidious.snopyta.org")) - (:bind "y" #'+ytdious-watch)) - -(setup (:straight zoom-frm) - (:+key "M-+" #'zoom-frm-in - "M-_" #'zoom-frm-out)) - -(setup (:straight zzz-to-char) - (:require +zzz-to-char) - (:option zzz-to-char-reach (+bytes 1 :kib)) - (:global "M-z" #'+zzz-to-char)) + (define-keys (current-global-map) + ;; C-c bindings (mode-specific-map) + "C-c h" #'consult-history + "C-c m" #'consult-mode-command + "C-c b" #'consult-bookmark + "C-c k" #'consult-kmacro + ;; C-x bindings (ctl-x-map) + "C-x M-:" #'consult-complex-command + "" #'consult-buffer + "C-x b" #'consult-buffer + "C-x 4 b" #'consult-buffer-other-window + "C-x 5 b" #'consult-buffer-other-frame + ;; Custom M-# bindings for fast register access + "M-#" #'consult-register-load + "M-'" #'consult-register-store + "C-M-#" #'consult-register + ;; Other custom bindings + "M-y" #'consult-yank-pop + ;;(" a" . consult-apropos) + ;; M-g bindings (goto-map) + "M-g e" #'consult-compile-error + "M-g f" #'consult-flymake ; or consult-flycheck + "M-g g" #'consult-goto-line + "M-g M-g" #'consult-goto-line + "M-g o" #'consult-outline ; or consult-org-heading + "M-g m" #'consult-mark + "M-g k" #'consult-global-mark + "M-g i" #'consult-imenu + "M-g M-i" #'consult-imenu + "M-g I" #'consult-imenu-multi + ;; M-s bindings (search-map) + "M-s f" #'consult-find + "M-s F" #'consult-locate + "M-s g" #'consult-grep + "M-s G" #'consult-git-grep + "M-s r" #'consult-ripgrep + "M-s l" #'consult-line + "M-s L" #'consult-line-multi + "M-s m" #'consult-multi-occur + "M-s k" #'consult-keep-lines + "M-s u" #'consult-focus-lines + ;; Isearch integration + "M-s e" #'consult-isearch-history) + (eval-after isearch-mode + (define-keys isearch-mode-map + "M-e" #'consult-isearch-history + "M-s e" #'consult-isearch-history + "M-s l" #'consult-line + "M-s L" #'consult-line-multi)) + (eval-after org + (define-key org-mode-map (kbd "M-g o") #'consult-org-heading))) + +(yoke orderless "https://github.com/oantolin/orderless" + (require 'orderless) + (setq completion-styles '(substring orderless basic) + completion-category-defaults nil + completion-category-overrides '((file (styles basic partial-completion))) + orderless-component-separator #'orderless-escapable-split-on-space)) + +(yoke vertico "https://github.com/minad/vertico" + (require 'vertico) + (setq resize-mini-windows 'grow-only + vertico-count-format nil + vertico-cycle t) + (vertico-mode)) + +(yoke marginalia "https://github.com/minad/marginalia/" + (marginalia-mode)) + +(yoke slime "https://github.com/slime/slime" + ;; r7rs-swank + (let ((r7rsloc (yoke-git "https://github.com/ecraven/r7rs-swank"))) + (cond + ((executable-find "chibi-scheme") + (defun chibi-scheme-start-swank (file encoding) + (format "%S\n\n" `(start-swank ,file))) + (setq slime-lisp-implementations + (cons `(chibi-scheme + ("chibi-scheme" ,(format "-A%s" r7rsloc) + "-m" "(chibi-swank)") + :init chibi-scheme-start-swank) + (bound-and-true-p slime-lisp-implementations))))))) + +(yoke puni "https://github.com/amaikinono/puni" + (puni-global-mode) + (electric-pair-mode) + (define-keys puni-mode-map + "C-)" #'puni-slurp-forward + "C-(" #'puni-slurp-backward + "C-}" #'puni-barf-forward + "C-{" #'puni-barf-backward)) + +(yoke hungry-delete "https://github.com/nflath/hungry-delete" + (setq hungry-delete-chars-to-skip " \t" + hungry-delete-join-reluctantly nil) + (eval-after hungry-delete + (add-to-list* 'hungry-delete-except-modes + 'eshell-mode + 'nim-mode + 'python-mode)) + (defun +hungry-delete-or (hd-fn fn arg) + (funcall (if (looking-back (format "[%s]" hungry-delete-chars-to-skip) arg) + hd-fn + fn) + arg)) + (define-keys puni-mode-map + [remap puni-backward-delete-char] + (defun puni@hungry-delete-backward (arg) + (interactive "p") + (+hungry-delete-or #'hungry-delete-backward + #'puni-backward-delete-char + arg)) + [remap puni-forward-delete-char] + (defun puni@hungry-delete-forward (arg) + (interactive "p") + (+hungry-delete-or #'hungry-delete-forward + #'puni-forward-delete-char + arg))) + (global-hungry-delete-mode)) + +(yoke cape "https://github.com/minad/cape" + (defun cape-insinuate () + (add-to-list* 'completion-at-point-functions + #'cape-dabbrev + #'cape-file)) + (add-hook* '(text-mode-hook prog-mode-hook) + #'cape-insinuate)) + +(yoke minions "https://github.com/tarsius/minions" + (minions-mode)) diff --git a/lisp/+Info.el b/lisp/+Info.el deleted file mode 100644 index 46bd5f8..0000000 --- a/lisp/+Info.el +++ /dev/null @@ -1,84 +0,0 @@ -;;; +Info.el -*- lexical-binding: t; -*- - -;;Copyright (C) 2022 Case Duckworth - -;;; Code: - -(require 'info) - -(defun +Info-copy-current-node-name (&optional arg) - "Put the name of the current Info invocation intothe kill ring. -This is the same as `Info-copy-current-node-name', but with the -arg reversed." - (interactive "P" Info-mode) - (Info-copy-current-node-name (unless arg 0))) - -(defun +Info-modeline-breadcrumbs () - (let ((nodes (Info-toc-nodes Info-current-file)) - (node Info-current-node) - (crumbs ()) - (depth Info-breadcrumbs-depth-internal) - (text "")) - ;; Get ancestors from the cached parent-children node info - (while (and (not (equal "Top" node)) (> depth 0)) - (setq node (nth 1 (assoc node nodes))) - (when node (push node crumbs)) - (setq depth (1- depth))) - ;; Add bottom node. - (setq crumbs (nconc crumbs (list Info-current-node))) - (when crumbs - ;; Add top node (and continuation if needed). - (setq crumbs (cons "Top" (if (member (pop crumbs) '(nil "Top")) - crumbs - (cons nil crumbs)))) - (dolist (node crumbs) - (let ((crumbs-map (make-sparse-keymap)) - (menu-map (make-sparse-keymap "Breadcrumbs in Mode Line"))) - (define-key crumbs-map [mode-line mouse-3] menu-map) - (when node - (define-key menu-map [Info-prev] - `(menu-item "Previous Node" Info-prev - :visible ,(Info-check-pointer "prev[ious]*") :help "Go to the previous node")) - (define-key menu-map [Info-next] - `(menu-item "Next Node" Info-next - :visible ,(Info-check-pointer "next") :help "Go to the next node")) - (define-key menu-map [separator] '("--")) - (define-key menu-map [Info-breadcrumbs-in-mode-line-mode] - `(menu-item "Toggle Breadcrumbs" Info-breadcrumbs-in-mode-line-mode - :help "Toggle displaying breadcrumbs in the Info mode-line" - :button (:toggle . Info-breadcrumbs-in-mode-line-mode))) - (define-key menu-map [Info-set-breadcrumbs-depth] - `(menu-item "Set Breadcrumbs Depth" Info-set-breadcrumbs-depth - :help "Set depth of breadcrumbs to show in the mode-line")) - (setq node (if (equal node Info-current-node) - (propertize - (replace-regexp-in-string "%" "%%" Info-current-node) - 'face 'mode-line-buffer-id - 'help-echo "mouse-1: Scroll back, mouse-2: Scroll forward, mouse-3: Menu" - 'mouse-face 'mode-line-highlight - 'local-map - (progn - (define-key crumbs-map [mode-line mouse-1] 'Info-mouse-scroll-down) - (define-key crumbs-map [mode-line mouse-2] 'Info-mouse-scroll-up) - crumbs-map)) - (propertize - node - 'local-map (progn (define-key crumbs-map [mode-line mouse-1] - `(lambda () (interactive) (Info-goto-node ,node))) - (define-key crumbs-map [mode-line mouse-2] - `(lambda () (interactive) (Info-goto-node ,node))) - crumbs-map) - 'mouse-face 'mode-line-highlight - 'help-echo "mouse-1, mouse-2: Go to this node; mouse-3: Menu"))))) - (let ((nodetext (if (not (equal node "Top")) - node - (concat (format "(%s)" (if (stringp Info-current-file) - (file-name-nondirectory Info-current-file) - ;; Some legacy code can still use a symbol. - Info-current-file)) - node)))) - (setq text (concat text (if (equal node "Top") "" " > ") (if node nodetext "..."))))) - text))) - -(provide '+Info) -;;; +Info.el ends here diff --git a/lisp/+ace-window.el b/lisp/+ace-window.el deleted file mode 100644 index 9e631a2..0000000 --- a/lisp/+ace-window.el +++ /dev/null @@ -1,40 +0,0 @@ -;;; +ace-window.el -*- lexical-binding: t; -*- - -;;; Code: - -(require 'ace-window) - -;;;###autoload -(define-minor-mode +ace-window-display-mode - "Minor mode for updating data for `+modeline-ace-window-display'." - ;; This is stolen from ace-window.el but with the mode-line stuff ripped out. - :global t - (if +ace-window-display-mode - (progn ; Enable - (aw-update) - (force-mode-line-update t) - (add-hook 'window-configuration-change-hook 'aw-update) - (add-hook 'after-make-frame-functions 'aw--after-make-frame t) - (advice-add 'aw--lead-overlay :override 'ignore)) - (progn ; Disable - (remove-hook 'window-configuration-change-hook 'aw-update) - (remove-hook 'after-make-frame-functions 'aw--after-make-frame) - (advice-remove 'aw--lead-overlay 'ignore)))) - -;; (defun +ace-window--mode-line-hint (path leaf) -;; (let ((wnd (cdr leaf))) -;; (with-selected-window wnd -;; ()))) - -;;;###autoload -(defun +ace-window-or-switch-buffer (arg) - "Call `ace-window' with ARG if more than one window is visible. -Switch to most recent buffer otherwise." - ;; cribbed from `crux-other-window-or-switch-buffer' - (interactive "p") - (if (one-window-p) - (switch-to-buffer nil) - (ace-window arg))) - -(provide '+ace-window) -;;; +ace-window.el ends here diff --git a/lisp/+apheleia.el b/lisp/+apheleia.el deleted file mode 100644 index 51cf145..0000000 --- a/lisp/+apheleia.el +++ /dev/null @@ -1,50 +0,0 @@ -;;; +apheleia.el -*- lexical-binding: t; -*- - -;;; Code: - -(require 'cl-lib) -(require 'el-patch) -(require 'user-save) - -;; https://github.com/raxod502/apheleia/pull/63#issue-1077529623 -(cl-defun +apheleia-indent-region (&key buffer scratch formatter callback &allow-other-keys) - (with-current-buffer scratch - (setq-local indent-line-function - (buffer-local-value 'indent-line-function buffer)) - (indent-region (point-min) - (point-max)) - (funcall callback))) - -;;; Why does the original function have to check for `apheleia-mode' ? -(el-patch-defun apheleia--format-after-save () - "Run code formatter for current buffer if any configured, then save." - (unless apheleia--format-after-save-in-progress - (when (el-patch-swap apheleia-mode - (or apheleia-mode - +apheleia/user-save-mode)) - (when-let ((formatters (apheleia--get-formatters))) - (apheleia-format-buffer - formatters - (lambda () - (with-demoted-errors "Apheleia: %s" - (when buffer-file-name - (let ((apheleia--format-after-save-in-progress t)) - (apheleia--save-buffer-silently))) - (run-hooks 'apheleia-post-format-hook)))))))) - - -(define-minor-mode +apheleia/user-save-mode - "Minor mode for reformatting code on `user-save'. -Customize with `apheleia-mode-alist' and `apheleia-formatters'." - :lighter " Apheleia/US" - (if +apheleia/user-save-mode - (add-hook 'user-save-after-save-hook #'apheleia--format-after-save nil 'local) - (remove-hook 'user-save-after-save-hook #'apheleia--format-after-save 'local))) - -(define-globalized-minor-mode +apheleia/user-save-global-mode - +apheleia/user-save-mode +apheleia/user-save-mode) - -(put '+apheleia/user-save-mode 'safe-local-variable #'booleanp) - -(provide '+apheleia) -;;; +apheleia.el ends here diff --git a/lisp/+avy.el b/lisp/+avy.el deleted file mode 100644 index b0837a3..0000000 --- a/lisp/+avy.el +++ /dev/null @@ -1,97 +0,0 @@ -;;; +avy.el -*- lexical-binding: t -*- - -;;; Commentary: - -;; https://karthinks.com/software/avy-can-do-anything/ - -;;; Code: - -(require 'avy) - -(defun avy-action-embark (pt) - (unwind-protect - (save-excursion - (goto-char pt) - (embark-act)) - (select-window - (cdr (ring-ref avy-ring 0)))) - t) - - -;;; Remove `buffer-face-mode' when avy is active. - -(defcustom +avy-buffer-face-functions '(avy-goto-char - avy-goto-char-in-line - avy-goto-char-2 - avy-goto-char-2-above - avy-goto-char-2-below - avy-goto-word-0 - avy-goto-whitespace-end - avy-goto-word-0-above - avy-goto-word-0-below - avy-goto-whitespace-end-above - avy-goto-whitespace-end-below - avy-goto-word-1 - avy-goto-word-1-above - avy-goto-word-1-below - avy-goto-symbol-1 - avy-goto-symbol-1-above - avy-goto-symbol-1-below - avy-goto-subword-0 - avy-goto-subword-1 - avy-goto-word-or-subword-1 - avy-goto-line - avy-goto-line-above - avy-goto-line-below - avy-goto-end-of-line - avy-goto-char-timer) - "Functions to disable `buffer-face-mode' during.") - -(defvar-local +avy-buffer-face-mode-face nil - "The state of `buffer-face-mode' before calling `avy-with'.") - -;;; XXX: Doesn't switch back if avy errors out or quits -(defun +avy@un-buffer-face (win) - "BEFORE advice on `avy-with' to disable `buffer-face-mode'." - (with-current-buffer (window-buffer win) - (when buffer-face-mode - (setq +avy-buffer-face-mode-face buffer-face-mode-face) - (buffer-face-mode -1)))) - -(defun +avy@re-buffer-face (win) - "AFTER advice on `avy-with' to re-enable `buffer-face-mode'." - (with-current-buffer (window-buffer win) - (when +avy-buffer-face-mode-face - (setq buffer-face-mode-face +avy-buffer-face-mode-face) - (buffer-face-mode +1))) - (let ((bounds (bounds-of-thing-at-point 'symbol))) - (when (and (car bounds) - (cdr bounds)) - (pulse-momentary-highlight-region (car bounds) (cdr bounds))))) - -(defun +avy@buffer-face (fn &rest r) - "AROUND advice for avy to dis/enable `buffer-face-mode'." - (if avy-all-windows - (walk-windows #'+avy@un-buffer-face nil (eq avy-all-windows 'all-frames))) - (condition-case e - (apply fn r) - ((quit error) (message "Avy: %S" e) nil) - (:sucess e)) - (if avy-all-windows - (walk-windows #'+avy@re-buffer-face nil (eq avy-all-windows 'all-frames)))) - -(define-minor-mode +avy-buffer-face-mode - "Turn off `buffer-face-mode' before doing Avy selections. -Restore the mode after the selection." - :lighter "" - :global t - (setq +avy-buffer-face-mode-face nil) - (cond - (+avy-buffer-face-mode - (dolist (fn +avy-buffer-face-functions) - (advice-add fn :around #'+avy@buffer-face))) - (t (dolist (fn +avy-buffer-face-functions) - (advice-remove fn #'+avy@buffer-face))))) - -(provide '+avy) -;;; avy.el ends here diff --git a/lisp/+bongo.el b/lisp/+bongo.el deleted file mode 100644 index da68024..0000000 --- a/lisp/+bongo.el +++ /dev/null @@ -1,60 +0,0 @@ -;;; +bongo.el --- customizations in bongo -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -(defgroup +bongo nil - "Extra customization for `bongo'." - :group 'bongo) - -(defun +bongo-notify () - (notifications-notify - :title "Now Playing" - :body (let ((bongo-field-separator " -")) - (substring-no-properties (bongo-formatted-infoset))) - :urgency 'low - :transient t)) - -(defun +bongo-stop-all () - "Ensure only one bongo playlist is playing at a time. -This is intended to be :before advice to `bongo-play'." - (mapc (lambda (b) - (with-current-buffer b - (when-let* ((modep (derived-mode-p - 'bongo-playlist-mode)) - (bongo-playlist-buffer b) - (playingp (bongo-playing-p))) - (bongo-stop)))) - (buffer-list))) - - -;;; Bongo Radio - -(defcustom +bongo-radio-stations nil - "Stations to play using `+bongo-radio'.") - -(defcustom +bongo-radio-buffer-name "*Bongo Radio*" - "Name of the buffer that holds all bongo radio stations." - :type 'string) - -(defun +bongo-radio () - (interactive) - (switch-to-buffer (or (get-buffer +bongo-radio-buffer-name) - (+bongo-radio-init)))) - -(defun +bongo-radio-init () - (interactive) - (let ((bongo-playlist-buffer (get-buffer-create +bongo-radio-buffer-name)) - (bongo-confirm-flush-playlist nil)) - (with-bongo-playlist-buffer - (bongo-playlist-mode) - (bongo-flush-playlist :delete-all) - (cl-loop for (name . url) in +bongo-radio-stations - do (bongo-insert-uri url name))) - (prog1 (switch-to-buffer bongo-playlist-buffer) - (goto-char (point-min))))) - -(provide '+bongo) -;;; +bongo.el ends here diff --git a/lisp/+browse-url.el b/lisp/+browse-url.el deleted file mode 100644 index fc479e4..0000000 --- a/lisp/+browse-url.el +++ /dev/null @@ -1,156 +0,0 @@ -;;; +browse-url.el -*- lexical-binding: t; -*- - -;;; Code: - -(require 'browse-url) -(require 'cl-lib) - -(defgroup +browse-url nil - "Group for my `browse-url' extras." - :group 'browse-url) - -;;; URL Handlers - -(defun +browse-url-set-handlers (&optional handlers) - "Set HANDLERS for `browse-url'. -Set `browse-url-handlers', if they exist; else -`browse-url-browser-function'. The reason for this switch is -that the latter is deprecated in Emacs 28+. - -If HANDLERS is absent or nil, recompute handlers. This can be -useful when changing the default browser." - (let ((h (if (boundp 'browse-url-handlers) - 'browse-url-handlers - 'browse-url-browser-function))) - (set-default h (or handlers (symbol-value h))))) - -(cl-defmacro +browse-url-make-external-viewer-handler - (viewer default-args &optional (prompt "URL: ") - &key - (custom-group '+browse-url) - (name (format "+browse-url-with-%s" viewer)) - (fallback #'browse-url-generic)) - "Create a `browse-url' handler function that calls VIEWER on the url. -Also create a `customize' setting in CUSTOM-GROUP for VIEWER's -arguments. DEFAULT-ARGS specifies the default arguments that -setting should have. PROMPT will be shown to user in the -function's `interactive' spec, as an argument to -`browse-url-interactive-arg'. The resulting function will be -named NAME, defaulting to \"+browse-url-with-VIEWER\", and the variable -\"NAME-args\". - -If FALLBACK is non-nil, it's a function to fallback on if the -`start-process' call fails in anyway." - (declare (indent 1)) - `(progn - (defcustom ,(intern (format "%s-args" name)) - ,default-args - ,(format "Arguments to pass to %s in `%s'." viewer name) - :type '(repeat :tag "Command-line argument" string) - :group ',custom-group) - (defun ,(intern name) (url &optional new-window) - ,(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 - (concat ,viewer " " url) nil - ,viewer - (append ,(intern (format "%s-args" name)) - (list url)))) - (funcall fallback url new-window)))))) - -;; Reference implementation: mpv -(+browse-url-make-external-viewer-handler "mpv" '("--cache-pause-wait=30" - "--cache-pause-initial=yes") - "Video URL: ") -;; And feh too -(+browse-url-make-external-viewer-handler "feh" '("--auto-zoom" - "--geometry" "800x600")) -;; And ... mpv, but for images -(+browse-url-make-external-viewer-handler "mpv" - '("--image-display-duration=inf") - "Image URL: " - :name "+browse-image-with-mpv") - -;;; Easily add extra domains to open in `browse-url-secondary-browser-function' -;; I like to open most websites in eww, but a lot of website on the modern web -;; just make that hard to do. Right now I have a list in `browse-url-handlers' -;; with domains in an (rx (or ...)) form, but that's not super easy to config. -;; With this custom setting, I'm making it a list that'll be way easier to -;; customize. - -(defcustom +browse-url-secondary-browser-regexps nil - "List of URL regexps to open with `browse-url-secondary-browser-function'." - :type '(repeat regexp)) - -;; Because `browse-url-browser-function', when set to an alist, must be of the -;; form (REGEXP . FUNCTION), I need to convert -;; `+browse-url-secondary-browser-regexps' into a regexp. - -(defun +browse-url-secondary-browser-regexps-combine () - "Combine `+browse-url-secondary-browser-regexps'. -This combines a list of regexps into one regexp." - (mapconcat #'identity +browse-url-secondary-browser-regexps "\\\|")) - -;;; URL Transformation Functions -;; There's a lot of bad websites out there. Luckily we can easily redirect -;; requests to more privacy-respecting, or just less javascript-ridden, sites -;; using some basic regex magic. Inspired by add-ons like -;; https://einaregilsson.com/redirector/. - -(defcustom +browse-url-transformations nil - "Transformation rules for various URLs. -This is an alist, the keys of which are regexen to match URLs -against, and the values are how to transform them. Match capture -data will be used in the transformations." - :type - '(alist :key-type (string :tag "URL regex match") - :value-type (string :tag "URL regex transformation")) - :group '+browse-url) - -(defun +browse-url-transform-advice (url &rest args) - "ADVICE to transform URL for later opening by `browse-url'. -ARGS are ignored here, but passed on for later processing." - ;; Basically, loop through `+browse-url-transformations' until finding a CAR - ;; that matches the URL. If one is found, transform it using `replace-match' - ;; with the CDR of that cell, or if one isn't, just pass the URL unchanged, - ;; along with the rest of the args, in a list to the original caller (probably - ;; `browse-url'.) - (apply 'list - (cl-loop with url = (substring-no-properties - (if (consp url) (car url) url)) - for (regex . transformation) in +browse-url-transformations - if (string-match regex url) - return (replace-match transformation nil nil url) - ;; else - finally return url) - args)) - -(define-minor-mode +browse-url-transform-url-mode - "Minor mode to transform a URL before passing it to `browse-url'. -This can be used to \"redirect\" URLs, for example from an -information silo to a more privacy-respecting one (e.g., -\"twitter.com\" -> \"nitter.com\"), by adding advice to `browse-url'. - -When using this mode, ensure that the transformed URL is also in -`browse-url-handlers', since that's what `browse-url' will see." - :lighter " Xurl" - :keymap nil - (if +browse-url-transform-url-mode - (advice-add 'browse-url :filter-args '+browse-url-transform-advice) - (advice-remove 'browse-url '+browse-url-transform-advice))) - -(define-global-minor-mode +browse-url-transform-url-global-mode - +browse-url-transform-url-mode +browse-url-transform-url-mode) - -(defun +browse-url-other-window (&rest args) - "Browse URL in the other window." - (let ((browsed (apply #'browse-url args))) - (when (bufferp browsed) - (switch-to-buffer-other-window browsed)))) - -(provide '+browse-url) -;;; +browse-url.el ends here diff --git a/lisp/+burly.el b/lisp/+burly.el deleted file mode 100644 index a32bc97..0000000 --- a/lisp/+burly.el +++ /dev/null @@ -1,63 +0,0 @@ -;;; +burly.el --- Bespoke burly add-ons -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -(require 'burly) - -(defgroup +burly nil - "Extra `burly' customizations." - :group 'burly - :prefix "+burly-") - -(defcustom +burly-windows-bookmark-name "pre-close-window-config" - "The name of the window config bookmark pre-frame deletion.") - -(defun +burly--get-name (arg) - "Get the name of a Burly bookmark to restore. -If ARG is passed, ask for the bookmark's name; otherwise, just -use `+burly-windows-bookmark-name'." - (if arg - (completing-read "Save Burly bookmark: " (burly-bookmark-names) - nil nil burly-bookmark-prefix) - +burly-windows-bookmark-name)) - -(defun +burly-recover-windows-bookmark (&optional arg frame) - "Recover the window configuration from a previous bookmark. -ARG is passed to `+burly--get-name', which see." - (interactive (list current-prefix-arg - (selected-frame))) - (with-selected-frame frame - (burly-open-bookmark (+burly--get-name arg)))) - -(defun +burly--recover-windows-on-new-frame (frame) - "Recover the current window configuration in a new frame. -This function removes itself from `after-make-frame-functions'." - ;; XXX: For some reason, *scratch* pops up. So I need to run this after a - ;; short delay, which sadly causes a flash of *scratch*. - (run-with-idle-timer 0.1 nil - (lambda (f) (+burly-recover-windows-bookmark nil f)) - frame) - (remove-hook 'after-make-frame-functions #'+burly--recover-windows-on-new-frame)) - -(defun +burly-save-then-close-frame (&optional arg) - "Save window configuration and close the frame. -ARG is passed to `+burly--get-name', which see." - (interactive "P") - (if (not (frame-parameter nil 'client)) - (when (yes-or-no-p "Sure you want to quit? ") - (save-buffers-kill-emacs)) - (save-some-buffers t) - (burly-bookmark-windows (+burly--get-name arg)) - (delete-frame nil :force))) - -(defun +burly-save-then-close-frame-remembering () - "Save window configurations and close the frame. -The next frame created will restore the window configuration." - (interactive) - (add-hook 'after-make-frame-functions #'+burly--recover-windows-on-new-frame 90) - (+burly-save-then-close-frame)) - -(provide '+burly) -;;; +burly.el ends here diff --git a/lisp/+casing.el b/lisp/+casing.el deleted file mode 100644 index c8e9e4d..0000000 --- a/lisp/+casing.el +++ /dev/null @@ -1,82 +0,0 @@ -;;; +casing.el --- Word-case-twiddling things -*- lexical-binding: t; -*- - -;;; Code: - -(require 'thingatpt) - -;;;###autoload -(defun +upcase-dwim (arg) - "Upcase words in the region, or upcase word at point. -If the region is active, this function calls `upcase-region'. -Otherwise, it calls `upcase-word' on the word at point (using -`thingatpt'), and the following ARG - 1 words." - (interactive "*p") - (if (use-region-p) - (upcase-region (region-beginning) (region-end) (region-noncontiguous-p)) - (let ((following (1- arg)) - (word-bound (save-excursion - (skip-chars-forward "^[:word:]") - (bounds-of-thing-at-point 'word)))) - (when (and (car word-bound) (cdr word-bound)) - (upcase-region (car word-bound) (cdr word-bound)) - (goto-char (cdr word-bound)) - (upcase-word following))))) - -;;;###autoload -(defun +downcase-dwim (arg) - "Downcase words in the region, or downcase word at point. -If the region is active, this function calls `downcase-region'. -Otherwise, it calls `downcase-word' on the word at point (using -`thingatpt'), and the following ARG - 1 words." - (interactive "*p") - (if (use-region-p) - (downcase-region (region-beginning) (region-end) (region-noncontiguous-p)) - (let ((following (1- arg)) - (word-bound (save-excursion - (skip-chars-forward "^[:word:]") - (bounds-of-thing-at-point 'word)))) - (when (and (car word-bound) (cdr word-bound)) - (downcase-region (car word-bound) (cdr word-bound)) - (goto-char (cdr word-bound)) - (downcase-word following))))) - -;;;###autoload -(defun +capitalize-dwim (arg) - "Capitalize words in the region, or capitalize word at point. -If the region is active, this function calls `capitalize-region'. -Otherwise, it calls `capitalize-word' on the word at point (using -`thingatpt'), and the following ARG - 1 words." - (interactive "*p") - (if (use-region-p) - (capitalize-region (region-beginning) (region-end) (region-noncontiguous-p)) - (let ((following (1- arg)) - (word-bound (save-excursion - (skip-chars-forward "^[:word:]") - (bounds-of-thing-at-point 'word)))) - (when (and (car word-bound) (cdr word-bound)) - (capitalize-region (car word-bound) (cdr word-bound)) - (goto-char (cdr word-bound)) - (capitalize-word following))))) - -;; Later on, I'll add repeat maps and stuff in here... - -(defvar +casing-map (let ((map (make-sparse-keymap))) - (define-key map "u" #'+upcase-dwim) - (define-key map (kbd "M-u") #'+upcase-dwim) - (define-key map "l" #'+downcase-dwim) - (define-key map (kbd "M-l") #'+downcase-dwim) - (define-key map "c" #'+capitalize-dwim) - (define-key map (kbd "M-c") #'+capitalize-dwim) - map) - "Keymap for case-related twiddling.") - -(define-minor-mode +casing-mode - "Enable easy case-twiddling commands." - :lighter " cC" - :global t - :keymap (let ((map (make-sparse-keymap))) - (define-key map (kbd "M-c") +casing-map) - map)) - -(provide '+casing) -;;; +casing.el ends here diff --git a/lisp/+chicken.el b/lisp/+chicken.el deleted file mode 100644 index 15713f8..0000000 --- a/lisp/+chicken.el +++ /dev/null @@ -1,34 +0,0 @@ -;;; +chicken.el --- Chicken Scheme additions -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -;; Reload [[https://wiki.call-cc.org/eggref/5/awful][awful]] with a keybinding - -(defun +chicken-awful-reload () - "Reload awful by visiting /reload." - (interactive) - (save-buffer) - (condition-case e - (url-retrieve-synchronously "http://localhost:8080/reload") - (file-error (progn - (message "Couldn't ping awful's server. Starting...") - (start-process "awful" (generate-new-buffer "*awful*") - "awful" "--development-mode" (buffer-file-name)))) - (t (message "Some awful error occurred!")))) - -(defun +chicken-indentation-insinuate () - "Insinuate indentation from -https://wiki.call-cc.org/emacs#tweaking-stock-scheme-mode-indentation." - (defun scheme-module-indent (state indent-point normal-indent) 0) - (put 'module 'scheme-indent-function 'scheme-module-indent) - (put 'and-let* 'scheme-indent-function 1) - (put 'parameterize 'scheme-indent-function 1) - (put 'handle-exceptions 'scheme-indent-function 1) - (put 'when 'scheme-indent-function 1) - (put 'unless 'scheme-indent-function 1) - (put 'match 'scheme-indent-function 1)) - -(provide '+chicken) -;;; +chicken.el ends here diff --git a/lisp/+circe.el b/lisp/+circe.el deleted file mode 100644 index 382f0ab..0000000 --- a/lisp/+circe.el +++ /dev/null @@ -1,285 +0,0 @@ -;;; +circe.el -*- lexical-binding: t; -*- - -;;; Code: - -(require '+util) -(require 'circe) - -(defgroup +circe nil - "Extra customizations for Circe." - :group 'circe) - -(defcustom +circe-left-margin 16 - "The size of the margin on the left." - :type 'integer) - -(defcustom +circe-network-inhibit-autoconnect nil - "Servers to inhibit autoconnecting from `circe-network-options'." - :type '(repeat string)) - -;;; Connecting to IRC - -;;;###autoload -(defun +irc () - "Connect to all IRC networks in `circe-network-options'." - (interactive) - (dolist (network (mapcar 'car circe-network-options)) - (unless (member network +circe-network-inhibit-autoconnect) - (+circe-maybe-connect network)))) - -(defun +circe-network-connected-p (network) - "Return t if connected to NETWORK, nil otherwise." - (catch 'return - (dolist (buffer (circe-server-buffers)) - (with-current-buffer buffer - (when (string= network circe-server-network) - (throw 'return t)))))) - -(defun +circe-maybe-connect (network) - "Connect to NETWORK, asking for confirmation to reconnect." - (interactive ("sNetwork: ")) - (when (or (not (+circe-network-connected-p network)) - (yes-or-no-p (format "Already connected to %s, reconnect? " - network))) - (circe network))) - -;;; Channel information - -(defvar-local +circe-current-topic "" - "Cached topic of the buffer's channel.") - -(defun +circe-current-topic (&optional message) - "Return the topic of the current channel. -When called with optional MESSAGE non-nil, or interactively, also -message the current topic." - (interactive "p") - (let ((topic - (or (save-excursion - (goto-char (point-max)) - (and (re-search-backward - (rx (group "*** " - (or "Topic" "topic" "TOPIC") - (* (not ":")) ": ") - (group (+ nonl))) - nil t) - (buffer-substring-no-properties - (match-beginning 2) (match-end 2)))) - +circe-current-topic))) - (setq +circe-current-topic topic) - (when message - (message "%s" topic)) - topic)) - -;;; Formatting messages - -(defun +circe-format-meta (string &optional no-nick) - "Return a format string for `lui-format' for metadata messages. -Include nick unless NO-NICK is non-nil. If NO-NICK is a string, -replace {nick} in the string with {NO-NICK}." - (cond - ((stringp no-nick) - (format "{%1$s:%2$d.%2$ds} *** %3$s" - no-nick (- +circe-left-margin 3) string)) - (no-nick - (format (format "%%%ds *** %s" (- +circe-left-margin 3) string) " ")) - (t - (format "{nick:%1$d.%1$ds} *** %s" (- +circe-left-margin 3) string)))) - -(defun +circe-format-meta* (string) - "Return a format string for `lui-format' for metadata messages, /without/ ") - -(defmacro +lui-make-formatting-list-rx (char) - "Make a formatting regex for CHAR delimiters. -For entry into `lui-formatting-list'." - `(rx (or bol whitespace) - (group ,char (+? (not (any whitespace ,char))) ,char) - (or eol whitespace))) - -;;; Hooks & Advice - -(defun +circe-chat@set-prompt () - "Set the prompt to the (shortened) buffer name." - (interactive) - (lui-set-prompt (propertize (+string-align (buffer-name) +circe-left-margin - :after " > " - :ellipsis "~" - :alignment 'right)))) - -(defun +circe-kill-buffer (&rest _) - "Kill a circe buffer without confirmation, and after a delay." - (let ((circe-channel-killed-confirmation) - (circe-server-killed-confirmation)) - (when (derived-mode-p 'lui-mode) ; don't spuriously kill - (ignore-errors - (kill-buffer))))) - -(defun +circe-quit@kill-buffer (&rest _) - "ADVICE: kill all buffers of a server after `circe-command-QUIT'." - (with-circe-server-buffer - (dolist (buf (circe-server-buffers)) - (with-current-buffer buf - (+circe-kill-buffer))) - (+circe-kill-buffer))) - -(defun +circe-gquit@kill-buffer (&rest _) - "ADVICE: kill all Circe buffers after `circe-command-GQUIT'." - (let ((circe-channel-killed-confirmation) - (circe-server-killed-confirmation)) - (dolist (buf (circe-server-buffers)) - (with-current-buffer buf - (+circe-quit@kill-buffer))))) - -(defun +circe-quit-all@kill-emacs () - "Quit all circe buffers when killing Emacs." - (ignore-errors - (advice-remove 'circe-command-GQUIT - 'circe-gquit@kill-buffer) - (circe-command-GQUIT "Quitting Emacs, bye!"))) - -;;; Patches - -(require 'el-patch) - -(el-patch-feature circe) -(defvar +circe-server-buffer-action 'pop-to-buffer-same-window - "What to do with `circe-server' buffers when created.") - -(el-patch-defun circe (network-or-server &rest server-options) - "Connect to IRC. - -Connect to the given network specified by NETWORK-OR-SERVER. - -When this function is called, it collects options from the -SERVER-OPTIONS argument, the user variable -`circe-network-options', and the defaults found in -`circe-network-defaults', in this order. - -If NETWORK-OR-SERVER is not found in any of these variables, the -argument is assumed to be the host name for the server, and all -relevant settings must be passed via SERVER-OPTIONS. - -All SERVER-OPTIONS are treated as variables by getting the string -\"circe-\" prepended to their name. This variable is then set -locally in the server buffer. - -See `circe-network-options' for a list of common options." - (interactive (circe--read-network-and-options)) - (let* ((options (circe--server-get-network-options network-or-server - server-options)) - (buffer (circe--server-generate-buffer options))) - (with-current-buffer buffer - (circe-server-mode) - (circe--server-set-variables options) - (circe-reconnect)) - (el-patch-swap (pop-to-buffer-same-window buffer) - (funcall +circe-server-buffer-action buffer)))) - -;;; Chat commands - -(defun circe-command-SLAP (nick) - "Slap NICK around a bit with a large trout." - (interactive (list (completing-read "Nick to slap: " - (circe-channel-nicks) - nil t nil))) - (circe-command-ME (format "slaps %s about a bit with a large trout" nick))) - -;;; Filtering functions --- XXX: These don't work right. -;; Set `lui-input-function' to `+lui-filter', then add the filters you want to -;; `circe-channel-mode-hook'. - -(defvar +lui-filters nil - "Stack of input functions to apply. -This is an alist with cells of the structure (TAG . FN), so we -can easily remove elements.") -(make-variable-buffer-local '+lui-filters) - -(defun +lui-filter (text &optional fn-alist) - (let ((fs (nreverse (purecopy (or fn-alist +lui-filters))))) - (while fs - (setq text (funcall (cdr (pop fs)) text))) - (circe--input text))) - -(defmacro +circe-define-filter (name docstring &rest body) - "Define a filter for circe-inputted text." - (declare (doc-string 2) - (indent 1)) - (let (plist) - (while (keywordp (car-safe body)) - (push (pop body) plist) - (push (pop body) plist)) - ;; Return value - `(define-minor-mode ,name - ,docstring - ,@(nreverse plist) - (when (derived-mode-p 'circe-chat-mode) - (if ,name - (push '(,name . (lambda (it) ,@body)) +lui-filters) - (setq +lui-filters - (assoc-delete-all ',name +lui-filters))))))) - -;; CAPPY HOUR! (Pure idiocy) - -(+circe-define-filter +circe-cappy-hour-mode - "ENABLE CAPPY HOUR IN CIRCE!" - :lighter " CAPPY HOUR" - (upcase it)) - -;; URL Shortener - -(+circe-define-filter +circe-shorten-url-mode - "Shorten long urls when chatting." - :lighter " c0x0" - (+circe-0x0-shorten-urls it)) - -(defvar +circe-0x0-max-length 20 - "Maximum length of URLs before using a shortener.") - -(defun +circe-0x0-shorten-urls (text) - "Find urls in TEXT and shorten them using `0x0'." - (require '0x0) - (require 'browse-url) - (let ((case-fold-search t)) - (replace-regexp-in-string - browse-url-button-regexp - (lambda (match) - (if (> (length match) +circe-0x0-max-length) - (+with-message (format "Shortening URL: %s" match) - (0x0-shorten-uri (0x0--choose-server) - (substring-no-properties match))) - match)) - text))) - -(defun +circe-shorten-urls-all () - "Turn on `+circe-shorten-url-mode' in all chat buffers." - (interactive) - (+mapc-some-buffers - (lambda () (+circe-shorten-url-mode +1)) - (lambda (buf) - (derived-mode-p 'circe-chat-mode)))) - -;; Temperature conversion - -(+circe-define-filter +circe-F/C-mode - "Convert degF to degF/degC for international chats." - :lighter " F/C" - (str-F/C it)) - -(defun fahrenheit-to-celsius (degf) - "Convert DEGF to Celsius." - (round (* (/ 5.0 9.0) (- degf 32)))) - -(defun celsius-to-fahrenheit (degc) - "Convert DEGC to Fahrenheit." - (round (+ 32 (* (/ 9.0 5.0) degc)))) - -(defun str-F/C (text) - (replace-regexp-in-string "[^.]\\([[:digit:]]+\\(?:\\.[[:digit:]]+\\)?[fF]\\)" - (lambda (match) - (format "%s/%dC" match - (fahrenheit-to-celsius - (string-to-number match)))) - text - nil 1)) - -(provide '+circe) -;;; +circe.el ends here diff --git a/lisp/+compat.el b/lisp/+compat.el deleted file mode 100644 index 286d5da..0000000 --- a/lisp/+compat.el +++ /dev/null @@ -1,64 +0,0 @@ -;;; +compat.el --- Thin backward-compatibility shim -*- lexical-binding: t; -*- - -;;; Commentary: - -;; I use different versionso of Emacs. Sometimes I have to copy-paste functions -;; from newer Emacs to make my customizations work. This is that file. - -;; This is probably ill-advised. - -;;; Code: - -;;; Load stuff in +compat/ subdirectory -(dolist (file (directory-files (locate-user-emacs-file "lisp/+compat") :full "\\.el\\'")) - (load file :noerror)) - -;;; Only define things if not already defined -(defmacro +compat-defun (name &rest args) - `(if (fboundp ',name) - (message "+compat: `%s' already bound." ',name) - (defun ,name ,@args))) - -(defmacro +compat-defmacro (name &rest args) - `(if (fboundp ',name) - (message "+compat: `%s' already bound." ',name) - (defmacro ,name ,@args))) - -;;; Single functions - -(+compat-defmacro dlet (binders &rest body) - "Like `let' but using dynamic scoping." - (declare (indent 1) (debug let)) - ;; (defvar FOO) only affects the current scope, but in order for - ;; this not to affect code after the main `let' we need to create a new scope, - ;; which is what the surrounding `let' is for. - ;; FIXME: (let () ...) currently doesn't actually create a new scope, - ;; which is why we use (let (_) ...). - `(let (_) - ,@(mapcar (lambda (binder) - `(defvar ,(if (consp binder) (car binder) binder))) - binders) - (let ,binders ,@body))) - -;; https://git.savannah.gnu.org/cgit/emacs.git/diff/?id=772b189143453745a8e014e21d4b6b78f855bba3 -(+compat-defun rename-visited-file (new-location) - "Rename the file visited by the current buffer to NEW-LOCATION. -This command also sets the visited file name. If the buffer -isn't visiting any file, that's all it does. - -Interactively, this prompts for NEW-LOCATION." - (interactive - (list (if buffer-file-name - (read-file-name "Rename visited file to: ") - (read-file-name "Set visited file name: " - default-directory - (expand-file-name - (file-name-nondirectory (buffer-name)) - default-directory))))) - (when (and buffer-file-name - (file-exists-p buffer-file-name)) - (rename-file buffer-file-name new-location)) - (set-visited-file-name new-location nil t)) - -(provide '+compat) -;;; +compat.el ends here diff --git a/lisp/+compile.el b/lisp/+compile.el deleted file mode 100644 index a69db7d..0000000 --- a/lisp/+compile.el +++ /dev/null @@ -1,20 +0,0 @@ -;;; +compile.el --- Extras for compile -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -(defcustom +compile-function nil - "Function to run to \"compile\" a buffer." - :type 'function - :local t - :risky nil) - -(defun +compile-dispatch (&optional arg) - "Run `+compile-function', if bound, or `compile'. -Any prefix ARG is passed to that function." - (interactive "P") - (call-interactively (or +compile-function #'compile))) - -(provide '+compile) -;;; +compile.el ends here diff --git a/lisp/+consult.el b/lisp/+consult.el deleted file mode 100644 index 21c2565..0000000 --- a/lisp/+consult.el +++ /dev/null @@ -1,47 +0,0 @@ -;;; +consult.el --- consult additions -*- lexical-binding: t -*- - -;;; Code: - -(defun +consult-project-root () - "Return either the current project, or the VC root, of current file." - (if (and (functionp 'project-current) - (project-current)) - (car (project-roots (project-current))) - (vc-root-dir))) - -;;; Cribbed functions -;; https://github.com/minad/consult/wiki - -(defun consult--orderless-regexp-compiler (input type &rest _) - (setq input (orderless-pattern-compiler input)) - (cons - (mapcar (lambda (r) (consult--convert-regexp r type)) input) - (lambda (str) (orderless--highlight input str)))) - -(defmacro consult-history-to-modes (map-hook-alist) - (let (defuns) - (dolist (map-hook map-hook-alist) - (let ((map-name (symbol-name (car map-hook))) - (key-defs `(progn (define-key - ,(car map-hook) - (kbd "M-r") - (function consult-history)) - (define-key ,(car map-hook) - (kbd "M-s") nil)))) - (push (if (cdr map-hook) - `(add-hook ',(cdr map-hook) - (defun - ,(intern (concat map-name - "@consult-history-bind")) - nil - ,(concat - "Bind `consult-history' to M-r in " - map-name ".\n" - "Defined by `consult-history-to-modes'.") - ,key-defs)) - key-defs) - defuns))) - `(progn ,@ (nreverse defuns)))) - -(provide '+consult) -;;; +consult.el ends here diff --git a/lisp/+crux.el b/lisp/+crux.el deleted file mode 100644 index c55a0b9..0000000 --- a/lisp/+crux.el +++ /dev/null @@ -1,58 +0,0 @@ -;;; +crux.el -*- lexical-binding: t; -*- - -;;; Code: - -(require 'crux) - -(defgroup +crux nil - "Extra crux customizations." - :group 'crux - :prefix "+crux-") - -(defun +crux-kill-ring-save (begin end arg) - "Copy region to the kill-ring, possibly indenting it first. -Copy from BEGIN to END using `kill-ring-save' if no argument was -passed, or with `crux-indent-rigidly-and-copy-to-clipboard' if -one was." - (interactive "r\nP") - (call-interactively (if arg - #'crux-indent-rigidly-and-copy-to-clipboard - #'kill-ring-save)) - (pulse-momentary-highlight-region begin end)) - -(defcustom +crux-default-date-format "%c" - "Default date format to use for `+crux-insert-date-or-time'. -Should be a format parsable by `format-time-string'." - :type 'string) - -(defcustom +crux-alternate-date-format "%FT%T%z" - "Alternate date format to use for `+crux-insert-date-or-time'. -Should be a format parsable by `format-time-string'." - :type 'string) - -(defun +crux-insert-date-or-time (arg) - "Insert current date or time. -Called without a prefix ARG, insert the time formatted by -`+crux-default-date-format'. When called with \\[universal-argument], -format the time with `+crux-alternate-date-format'. Otherwise, -prompt for the time format." - (interactive "*P") - (let ((time (current-time))) - (insert (cond - ((null arg) (format-time-string +crux-default-date-format time)) - ((eq (car-safe arg) 4) - (format-time-string +crux-alternate-date-format time)) - (t (format-time-string (read-string "Time Format: ") time)))))) - -(defun +crux-kill-and-join-forward (&optional arg) - "If at end of line, join with following; else (visual)-kill line. -In `visual-line-mode', runs command `kill-visual-line'; in other -modes, runs command `kill-line'. Passes ARG to command when -provided. Deletes whitespace at join." - (interactive "P") - (if (and (eolp) (not (bolp))) - (delete-indentation 1) - (funcall (if visual-line-mode #'kill-visual-line #'kill-line) arg))) - -(provide '+crux) -;;; +crux.el ends here diff --git a/lisp/+cus-edit.el b/lisp/+cus-edit.el deleted file mode 100644 index a67279c..0000000 --- a/lisp/+cus-edit.el +++ /dev/null @@ -1,80 +0,0 @@ -;;; +cus-edit.el -*- lexical-binding: t; -*- - -;;; Commentary: - -;; The naming convention for this library, called "cus-edit.el" on the -;; filesystem, is all over the damn place. Whatever. - -;;; Code: - -(require 'cl-lib) -(require 'seq) - -(defgroup +customize nil - "Extra customize customizations." - :prefix "+customize-" - :group 'customize) - -(defcustom +cus-edit-imenu-generic-expression ; thanks u/oantolin! - `(("Faces" ,(rx (seq bol - (or "Show" "Hide") " " - (group (zero-or-more nonl)) - " face: [sample]")) - 1) - ("Variables" ,(rx (seq bol - (or "Show Value" "Hide") " " - (group (zero-or-more - (not (any "\n:")))))) - 1)) - "Show faces and variables in `imenu' in a `customize' buffer." - :type 'sexp ; This is .. over-simplified. - ) - -(defcustom +custom-variable-allowlist nil - "Variables to allow changing while loading the Custom file.") - -(defcustom +custom-after-load-hook nil - "Functions to run after loading the custom file.") - -(defun +custom-load-ignoring-most-customizations (&optional - error - nomessage - nosuffix - must-suffix) - "Load `custom-file', ignoring most customizations. -Ignore all faces, and only load variables in -`+customize-variable-allowlist'. All the optional -variables---ERROR, NOMESSAGE, NOSUFFIX, MUST-SUFFIX---are -passed on to `load'. - -NOTE: ERROR is the opposite of its value in `load' -- meaning -that this function by default does /not/ error, but will if you -pass t to it." - (cl-letf (((symbol-function 'custom-set-faces) 'ignore) - ((symbol-function 'custom-set-variables) - (lambda (&rest args) - (apply #'custom-theme-set-variables 'user - (seq-filter (lambda (el) - (memq (car el) - +custom-variable-allowlist)) - args))))) - (load custom-file (not error) nomessage nosuffix must-suffix)) - (run-hooks '+custom-after-load-hook)) - -(defun +cus-edit-expand-widgets (&rest _) - "Expand descriptions in `Custom-mode' buffers." - (interactive) - ;; "More/Hide" widgets (thanks alphapapa!) - (widget-map-buttons (lambda (widget _) - (pcase (widget-get widget :off) - ("More" (widget-apply-action widget))) - nil)) - ;; "Show Value" widgets (the little triangles) - (widget-map-buttons (lambda (widget _) - (pcase (widget-get widget :off) - ("Show Value" - (widget-apply-action widget))) - nil))) - -(provide '+cus-edit) -;;; +cus-edit.el ends here diff --git a/lisp/+dired.el b/lisp/+dired.el deleted file mode 100644 index 2e42c19..0000000 --- a/lisp/+dired.el +++ /dev/null @@ -1,28 +0,0 @@ -;;; +dired.el -*- lexical-binding: t -*- - -;;; Code: - -(with-eval-after-load 'vertico - (defun +dired-goto-file (file) - "ADVICE for `dired-goto-file' to make RET call `vertico-exit'." - (interactive ; stolen from `dired-goto-file' - (prog1 - (list (dlet ((vertico-map (copy-keymap vertico-map))) - (define-key vertico-map (kbd "RET") #'vertico-exit) - (expand-file-name (read-file-name "Goto file: " - (dired-current-directory))))) - (push-mark))) - (dired-goto-file file))) - -;;; [[https://www.reddit.com/r/emacs/comments/u2lf9t/weekly_tips_tricks_c_thread/i4n9aoa/?context=3][Dim files in .gitignore]] - -(defun +dired-dim-git-ignores () - "Dim out .gitignore contents" - (require 'vc) - (when-let ((ignores (vc-default-ignore-completion-table 'git ".gitignore")) - (exts (make-local-variable 'completion-ignored-extensions))) - (dolist (item ignores) - (add-to-list exts item)))) - -(provide '+dired) -;;; +dired.el ends here diff --git a/lisp/+ecomplete.el b/lisp/+ecomplete.el deleted file mode 100644 index b1392cf..0000000 --- a/lisp/+ecomplete.el +++ /dev/null @@ -1,45 +0,0 @@ -;;; +ecomplete.el --- ecomplete extras -*- lexical-binding: t; -*- - -;;; Commentary: - -;; see [[https://github.com/oantolin/emacs-config/blob/master/my-lisp/ecomplete-extras.el][oantolin's config]] - -;;; Code: - -(require 'ecomplete) - -(defun +ecomplete--name+address (email) - "Return a pair of the name and address for an EMAIL." - (let (name) - (when (string-match "^\\(?:\\(.*\\) \\)?<\\(.*\\)>$" email) - (setq name (match-string 1 email) - email (match-string 2 email))) - (cons name email))) - -(defun +ecomplete-add-email (email) - "Add email address to ecomplete's database." - (interactive "sEmail address: ") - (pcase-let ((`(,name . ,email) (+ecomplete--name+address email))) - (unless name (setq name (read-string "Name: "))) - (ecomplete-add-item - 'mail email - (format (cond ((equal name "") "%s%s") - ((string-match-p "^\\(?:[A-Za-z0-9 ]*\\|\".*\"\\)$" name) - "%s <%s>") - (t "\"%s\" <%s>")) - name email)) - (ecomplete-save))) - -(defun +ecomplete-remove-email (email) - "Remove email address from ecomplete's database." - (interactive - (list (completing-read "Email address: " - (ecomplete-completion-table 'mail)))) - (when-let ((email (cdr (+ecomplete--name+address email))) - (entry (ecomplete-get-item 'mail email))) - (setf (cdr (assq 'mail ecomplete-database)) - (remove entry (cdr (assq 'mail ecomplete-database)))) - (ecomplete-save))) - -(provide '+ecomplete) -;;; +ecomplete.el ends here diff --git a/lisp/+elfeed.el b/lisp/+elfeed.el deleted file mode 100644 index c3e5301..0000000 --- a/lisp/+elfeed.el +++ /dev/null @@ -1,185 +0,0 @@ -;;; +elfeed.el -*- lexical-binding: t; -*- - -;;; Code: - -(require 'elfeed) - -;; https://karthinks.com/software/lazy-elfeed/ -(defun +elfeed-scroll-up-command (&optional arg) - "Scroll up or go to next feed item in Elfeed" - (interactive "^P") - (let ((scroll-error-top-bottom nil)) - (condition-case-unless-debug nil - (scroll-up-command arg) - (error (elfeed-show-next))))) - -(defun +elfeed-scroll-down-command (&optional arg) - "Scroll up or go to next feed item in Elfeed" - (interactive "^P") - (let ((scroll-error-top-bottom nil)) - (condition-case-unless-debug nil - (scroll-down-command arg) - (error (elfeed-show-prev))))) - -(defun +elfeed-search-browse-generic () - "Browse a url with `browse-url-generic-browser'." - (interactive) - (elfeed-search-browse-url t)) - -(defun +elfeed-show-browse-generic () - "Browse a url with `browse-url-generic-browser'." - (interactive) - (elfeed-show-visit t)) - -(defun +elfeed-show-mark-read-and-advance () - "Mark an item as read and advance to the next item. -If multiple items are selected, don't advance." - (interactive) - (call-interactively #'elfeed-search-untag-all-unread) - (unless (region-active-p) - (call-interactively #'next-line))) - -;;; Fetch feeds async -;; https://github.com/skeeto/elfeed/issues/367 - -(defun +elfeed--update-message () - (message "[Elfeed] Update in progress") - 'ignore) - -(defvar +elfeed--update-running-p nil "Whether an update is currently running.") -(defvar +elfeed--update-count 0 "How many times `+elfeed-update-command' has run.") -(defcustom +elfeed-update-niceness 15 - "How \"nice\" `+elfeed-update-command' should be." - :type 'integer - :group 'elfeed) - -(defcustom +elfeed-update-lockfile - (expand-file-name "+elfeed-update-lock" (temporary-file-directory)) - "The file to ") - -(defun +elfeed-update-command () - (interactive) - (unless (or +elfeed--update-running-p - (derived-mode-p 'elfeed-show-mode 'elfeed-search-mode)) - (let ((script (expand-file-name "/tmp/elfeed-update.el")) - (update-message-format "[Elfeed] Background update: %s")) - (setq +elfeed--update-running-p t) - (elfeed-db-save) - (advice-add 'elfeed :override #'+elfeed--update-message) - (ignore-errors (kill-buffer "*elfeed-search*")) - (ignore-errors (kill-buffer "*elfeed-log*")) - (elfeed-db-unload) - (make-directory (file-name-directory script) :parents) - (with-temp-buffer - (insert - (let ((print-level nil) - (print-length nil)) - (prin1-to-string ;; Print the following s-expression to a string - `(progn - ;; Set up the environment - (setq lexical-binding t) - (load (locate-user-emacs-file "early-init")) - (dolist (pkg '(elfeed elfeed-org)) - (straight-use-package pkg) - (require pkg)) - ;; Copy variables from current environment - (progn - ,@(cl-loop for copy-var in '(rmh-elfeed-org-files - elfeed-db-directory - elfeed-curl-program-name - elfeed-use-curl - elfeed-curl-extra-arguments - elfeed-enclosure-default-dir) - collect `(progn (message "%S = %S" ',copy-var ',(symbol-value copy-var)) - (setq ,copy-var ',(symbol-value copy-var))))) - ;; Define new variables for this environment - (progn - ,@(cl-loop for (new-var . new-val) in '((elfeed-curl-max-connections . 4)) - collect `(progn (message "%S = %S" ',new-var ',new-val) - (setq ,new-var ',new-val)))) - ;; Redefine `elfeed-log' to log everything - (defun elfeed-log (level fmt &rest objects) - (princ (format "[%s] [%s]: %s\n" - (format-time-string "%F %T") - level - (apply #'format fmt objects)))) - ;; Run elfeed - (elfeed-org) - (elfeed) - (elfeed-db-load) - (elfeed-update) - ;; Wait for `elfeed-update' to finish - (let ((q<5-count 0)) - (while (and (> (elfeed-queue-count-total) 0) - (< q<5-count 5)) - (sleep-for 5) - (message "Elfeed queue count total: %s" (elfeed-queue-count-total)) - (when (< (elfeed-queue-count-total) 5) - (cl-incf q<5-count)) - (accept-process-output))) - ;; Garbage collect and save the database - (elfeed-db-gc) - (elfeed-db-save) - (princ (format ,update-message-format "done.")))))) - (write-file script)) - (chmod script #o777) - (message update-message-format "start") - (set-process-sentinel (start-process-shell-command - "Elfeed" "*+elfeed-update-background*" - (format "nice -n %d %s %s" - +elfeed-update-niceness - "emacs -Q --script" - script)) - (lambda (proc stat) - (advice-remove 'elfeed #'+elfeed--update-message) - (setq +elfeed--update-running-p nil) - (unless (string= stat "killed") - (setq +elfeed--update-count (1+ +elfeed--update-count))) - (message update-message-format (string-trim stat))))))) - -(defvar +elfeed--update-timer nil "Timer for `elfeed-update-command'.") -(defvar +elfeed--update-first-time 6 "How long to wait for the first time.") -(defvar +elfeed--update-repeat (* 60 15) "How long between updates.") - -(defcustom +elfeed-update-proceed-hook nil - "Predicates to query before running `+elfeed-update-command'. -Each hook is passed no arguments." - :type 'hook) - -(defun +elfeed-update-command-wrapper () - "Run `+elfeed-update-command', but only sometimes. -If any of the predicates in `+elfeed-update-proceed-hook' return -nil, don't run `+elfeed-update-command'. If they all return -non-nil, proceed." - (when (run-hook-with-args-until-failure '+elfeed-update-proceed-hook) - (+elfeed-update-command))) - -(defun +elfeed--cancel-update-timer () - "Cancel `+elfeed--update-timer'." - (unless +elfeed--update-running-p - (ignore-errors (cancel-timer +elfeed--update-timer)) - (setq +elfeed--update-timer nil))) - -(defun +elfeed--reinstate-update-timer () - "Reinstate `+elfeed--update-timer'." - ;; First, unload the db - (setq +elfeed--update-timer - (run-at-time +elfeed--update-first-time - +elfeed--update-repeat - #'+elfeed-update-command-wrapper))) - -(define-minor-mode +elfeed-update-async-mode - "Minor mode to update elfeed async-style." - :global t - (if +elfeed-update-async-mode - (progn ; enable - (+elfeed--reinstate-update-timer) - (advice-add 'elfeed :before '+elfeed--cancel-update-timer) - (advice-add 'elfeed-search-quit-window :after '+elfeed--reinstate-update-timer)) - (progn ; disable - (advice-remove 'elfeed '+elfeed--cancel-update-timer) - (advice-remove 'elfeed-search-quit-window '+elfeed--reinstate-update-timer) - (+elfeed--cancel-update-timer)))) - -(provide '+elfeed) -;;; +elfeed.el ends here diff --git a/lisp/+elisp.el b/lisp/+elisp.el deleted file mode 100644 index 3eafbf3..0000000 --- a/lisp/+elisp.el +++ /dev/null @@ -1,18 +0,0 @@ -;;; +elisp.el -*- lexical-binding: t; -*- - -;;; Code: - -(defun +elisp-eval-region-or-buffer () - (interactive) - (if (region-active-p) - (eval-region (region-beginning) (region-end)) - (+eval-region@pulse (lambda (_ _) (eval-buffer)) (point-min) (point-max)))) - -;; Should I move this to `+pulse' ? -(defun +eval-region@pulse (advised beg end &rest args) - "ADVICE to pulse an eval'd region." - (apply advised beg end args) - (pulse-momentary-highlight-region beg end)) - -(provide '+elisp) -;;; +elisp.el ends here diff --git a/lisp/+emacs.el b/lisp/+emacs.el deleted file mode 100644 index 9158b62..0000000 --- a/lisp/+emacs.el +++ /dev/null @@ -1,434 +0,0 @@ -;;; +emacs.el --- measured defaults for Emacs -*- lexical-binding: t -*- - -;;; Commentary: - -;; I find myself copy-pasting a lot of "boilerplate" type code when -;; bankrupting my Emacs config and starting afresh. Instead of doing -;; that, I'm putting it here, where it'll be easier to include in my -;; config. - -;; Of course, some might say I could just ... stop bankrupting my -;; Emacs. But like, why would I want to? - -;; Other notable packages include -;; - https://git.sr.ht/~technomancy/better-defaults/ -;; - https://github.com/susam/emfy - -;;; Code: - -(require 'early-init (locate-user-emacs-file "early-init.el")) - -(defun +set-major-mode-from-buffer-name (&optional buf) - "Set the major mode for BUF from the buffer's name. -Do this only if the buffer is not visiting a file." - (unless buffer-file-name - (let ((buffer-file-name (buffer-name buf))) - (set-auto-mode)))) - - -;;; General settings - -(setq-default - apropos-do-all t - async-shell-command-buffer 'new-buffer - async-shell-command-display-buffer nil - auto-hscroll-mode 'current-line - auto-revert-verbose t - auto-save-default nil - auto-save-file-name-transforms `((".*" ,(.etc "auto-save/") ,(car (secure-hash-algorithms))) - (".*" ,(.etc "auto-save/") t)) - auto-save-interval 30 - auto-save-list-file-prefix (.etc "auto-save/.saves-" t) - auto-save-timeout 30 - auto-save-visited-interval 5 - auto-window-vscroll nil - backup-by-copying t - backup-directory-alist `((".*" . ,(.etc "backup/" t))) - blink-cursor-blinks 1 - comp-deferred-compilation nil - completion-category-defaults nil - completion-category-overrides '((file (styles . (partial-completion)))) - completion-ignore-case t - completion-styles '(substring partial-completion) - create-lockfiles nil - cursor-in-non-selected-windows 'hollow - cursor-type 'bar - custom-file (.etc "custom.el") - delete-old-versions t - echo-keystrokes 0.1 - ediff-window-setup-function 'ediff-setup-windows-plain - eldoc-echo-area-use-multiline-p nil - eldoc-idle-delay 0.1 - enable-recursive-minibuffers t - executable-prefix-env t - fast-but-imprecise-scrolling t - file-name-shadow-properties '(invisible t intangible t) - fill-column 80 - find-file-visit-truename t - frame-resize-pixelwise t - global-auto-revert-non-file-buffers t - global-mark-ring-max 100 - hscroll-margin 1 - hscroll-step 1 - imenu-auto-rescan t - image-use-external-converter (or (executable-find "convert") - (executable-find "gm") - (executable-find "ffmpeg")) - indent-tabs-mode nil - inhibit-startup-screen t - initial-buffer-choice t - kept-new-versions 6 - kept-old-versions 2 - kill-do-not-save-duplicates t - kill-read-only-ok t - kill-ring-max 500 - kmacro-ring-max 20 - load-prefer-newer noninteractive - major-mode '+set-major-mode-from-buffer-name - mark-ring-max 50 - minibuffer-eldef-shorten-default t - minibuffer-prompt-properties (list 'read-only t - 'cursor-intangible t - 'face 'minibuffer-prompt) - mode-require-final-newline 'visit-save - mouse-drag-copy-region t - mouse-wheel-progressive-speed nil - mouse-yank-at-point t - native-comp-async-report-warnings-errors 'silent - native-comp-deferred-compilation nil - read-answer-short t - read-buffer-completion-ignore-case t - ;; read-extended-command-predicate - ;; (when (fboundp - ;; 'command-completion-default-include-p) - ;; 'command-completion-default-include-p) - read-process-output-max (+bytes 1 :mib) ; We’re in the future man. Set that to at least a megabyte - recenter-positions '(top middle bottom) - regexp-search-ring-max 100 - regexp-search-ring-max 200 - save-interprogram-paste-before-kill t - save-some-buffers-default-predicate #'+save-some-buffers-p - scroll-conservatively 101 - scroll-down-aggressively 0.01 - scroll-margin 2 - scroll-preserve-screen-position 1 - scroll-step 1 - scroll-up-aggressively 0.01 - search-ring-max 200 - search-ring-max 200 - sentence-end-double-space t - set-mark-command-repeat-pop t - show-paren-delay 0 - show-paren-style 'parenthesis - show-paren-when-point-in-periphery t - show-paren-when-point-inside-paren t - ;;show-trailing-whitespace t - tab-bar-show 1 - tab-width 8 ; so alignment expecting the default looks right - tramp-backup-directory-alist backup-directory-alist - undo-limit 100000000 ; 10 MB - use-dialog-box nil - use-file-dialog nil - use-short-answers t - vc-follow-symlinks t - vc-make-backup-files t - version-control t - view-read-only t - visible-bell nil - window-resize-pixelwise t - x-select-enable-clipboard t - x-select-enable-primary t - yank-pop-change-selection t - ) - -;; Programming language offsets. -;; Set these after the initial block so I can use `tab-width' -(setq-default - c-basic-offset tab-width) - -;; Emacs 28 ships with an option, `use-short-answers', that makes this form -;; obsolete, but I still use 27 at work. -(when (version< emacs-version "28") - (fset 'yes-or-no-p 'y-or-n-p)) - - -;;; Encodings - -;; Allegedly, this is the only one you need... -(set-language-environment "UTF-8") -;; But I still set all of these, for fun. -(setq-default locale-coding-system 'utf-8-unix - coding-system-for-read 'utf-8-unix - coding-system-for-write 'utf-8-unix - buffer-file-coding-system 'utf-8-unix - default-process-coding-system '(utf-8-unix . utf-8-unix) - x-select-request-type '(UTF8_STRING - COMPOUND_TEXT - TEXT - STRING)) - -(set-charset-priority 'unicode) -(prefer-coding-system 'utf-8-unix) -(set-default-coding-systems 'utf-8-unix) -(set-terminal-coding-system 'utf-8-unix) -(set-keyboard-coding-system 'utf-8-unix) - -(pcase system-type - ((or 'ms-dos 'windows-nt) - (set-clipboard-coding-system 'utf-16-le) - (set-selection-coding-system 'utf-16-le)) - (_ - (set-selection-coding-system 'utf-8) - (set-clipboard-coding-system 'utf-8))) - - -;;; Modes - -(dolist (enable-mode '(global-auto-revert-mode - blink-cursor-mode - electric-pair-mode - show-paren-mode - global-so-long-mode - minibuffer-depth-indicate-mode - file-name-shadow-mode - minibuffer-electric-default-mode - delete-selection-mode - auto-save-visited-mode - ;; column-number-mode - )) - (when (fboundp enable-mode) - (funcall enable-mode +1))) - -(dolist (disable-mode '(tooltip-mode - tool-bar-mode - menu-bar-mode - scroll-bar-mode - horizontal-scroll-bar-mode)) - (when (fboundp disable-mode) - (funcall disable-mode -1))) - - -;;; Hooks - -(add-hook 'after-save-hook #'executable-make-buffer-file-executable-if-script-p) -(add-hook 'minibuffer-setup-hook #'cursor-intangible-mode) - -(defun +auto-create-missing-dirs () - "Automatically create missing directories when finding a file." - ;; https://emacsredux.com/blog/2022/06/12/auto-create-missing-directories/ - (let ((target-dir (file-name-directory buffer-file-name))) - (unless (file-exists-p target-dir) - (make-directory target-dir t)))) - -(add-hook 'find-file-not-found-functions #'+auto-create-missing-dirs) - -(defvar +save-some-buffers-debounce-time nil - "Last time `+save-some-buffers-debounce' was run.") - -(defcustom +save-some-buffers-debounce-timeout 5 - "Number of seconds to wait before saving buffers again.") - -(defun +save-some-buffers-debounce (&rest _) - "Run `save-some-buffers', but only if it's been a while." - (unless (and +save-some-buffers-debounce-time - (< (- (time-convert nil 'integer) +save-some-buffers-debounce-time) - +save-some-buffers-debounce-timeout)) - (save-some-buffers t) - (setq +save-some-buffers-debounce-time (time-convert nil 'integer)))) - -(add-function :after after-focus-change-function #'+save-some-buffers-debounce) - - -;;; Better-default functions ... - -(defun +cycle-spacing (&optional n preserve-nl-back mode) - "Negate N argument on `cycle-spacing'. -That is, with a positive N, deletes newlines as well, leaving -N -spaces. If N is negative, it will not delete newlines and leave -N spaces. See docstring of `cycle-spacing' for the meaning of -PRESERVE-NL-BACK and MODE." - (interactive "*p") - (cycle-spacing (- n) preserve-nl-back mode)) - -(defun +save-buffers-quit (&optional arg) - "Silently save each buffer, then kill the current connection. -If the current frame has no client, kill Emacs itself using -`save-buffers-kill-emacs' after confirming with the user. - -With prefix ARG, silently save all file-visiting buffers, then -kill without asking." - (interactive "P") - (save-some-buffers t) - (if (and (not (frame-parameter nil 'client)) - (and (not arg))) - (when (yes-or-no-p "Sure you want to quit? ") - (save-buffers-kill-emacs)) - (delete-frame nil :force))) - -(defun +kill-word-backward-or-region (&optional arg backward-kill-word-fn) - "Kill active region or ARG words backward. -BACKWARD-KILL-WORD-FN is the function to call to kill a word -backward. It defaults to `backward-kill-word'." - (interactive "P") - (call-interactively (if (region-active-p) - #'kill-region - (or backward-kill-word-fn #'backward-kill-word)))) - -(defun +backward-kill-word-wrapper (fn &optional arg) - "Kill backward using FN until the beginning of a word, smartly. -If point is on at the beginning of a line, kill the previous new -line. If the only thing before point on the current line is -whitespace, kill that whitespace. - -With argument ARG: if ARG is a number, just call FN -ARG times. Otherwise, just call FN." - ;; I want this to be a wrapper so that I can call other word-killing functions - ;; with it. It's *NOT* advice because those functions probably use - ;; `backward-kill-word' under the hood (looking at you, paredit), so advice - ;; will make things weird. - (if (null arg) - (cond - ((looking-back "^" 1) - (let ((delete-active-region nil)) - (delete-backward-char 1))) - ((looking-back "^[ ]*") - (delete-horizontal-space :backward-only)) - (t (call-interactively fn))) - (funcall fn (if (listp arg) 1 arg)))) - -(defun +backward-kill-word (&optional arg) - "Kill word backward using `backward-kill-word'. -ARG is passed to `backward-kill-word'." - (interactive "P") - (+backward-kill-word-wrapper #'backward-kill-word arg)) - -;;; ... and advice - -;; Indent the region after a yank. -(defun +yank@indent (&rest _) - "Indent the current region." - (indent-region (min (point) (mark)) (max (point) (mark)))) -(advice-add #'yank :after #'+yank@indent) -(advice-add #'yank-pop :after #'+yank@indent) - - -;;; Extra functions - -(defun +save-some-buffers-p () - "Predicate for `save-some-buffers-default-predicate'. -It returns nil with remote files and those without attached files." - (and (buffer-file-name) - (not (file-remote-p (buffer-file-name))))) - -;; https://www.wwwtech.de/articles/2013/may/emacs:-jump-to-matching-paren-beginning-of-block -(defun +goto-matching-paren (&optional arg) - "Go to the matching paren, similar to vi's %." - (interactive "p") - (or arg (setq arg 1)) - (cond - ;; Check for "outside of bracket" positions - ((looking-at "[\[\(\{]") (forward-sexp arg)) - ((looking-back "[\]\)\}]" 1) (backward-sexp arg)) - ;; Otherwise, move from inside the bracket - ((looking-at "[\]\)\}]") (forward-char) (backward-sexp arg)) - ((looking-back "[\[\(\{]" 1) (backward-char) (forward-sexp arg)) - (t (up-list arg t t)))) - -(defun +delete-window-or-bury-buffer () - "Delete the current window, or bury the current buffer. -If the current window is the only window, bury the buffer." - (interactive) - (condition-case e - (delete-window) - (t (bury-buffer)))) - - -;;; Bindings - -(global-set-key (kbd "C-x C-c") #'+save-buffers-quit) -(global-set-key (kbd "M-SPC") #'+cycle-spacing) -(global-set-key (kbd "M-/") #'hippie-expand) -(global-set-key (kbd "M-=") #'count-words) -(global-set-key (kbd "C-x C-b") #'ibuffer) -(global-set-key (kbd "C-s") #'isearch-forward-regexp) -(global-set-key (kbd "C-r") #'isearch-backward-regexp) -(global-set-key (kbd "C-M-s") #'isearch-forward) -(global-set-key (kbd "C-M-r") #'isearch-backward) -(global-set-key (kbd "C-x 4 n") #'clone-buffer) -;; https://christiantietze.de/posts/2022/07/shift-click-in-emacs-to-select/ -(global-set-key (kbd "S-") #'mouse-set-mark) -(global-set-key (kbd "C-x 0") #'+delete-window-or-bury-buffer) - - -;;; Required libraries - -(when (require 'uniquify nil :noerror) - (setq-default uniquify-buffer-name-style 'forward - uniquify-separator path-separator - uniquify-after-kill-buffer-p t - uniquify-ignore-buffers-re "^\\*")) - -(when (require 'goto-addr) - (if (fboundp 'global-goto-address-mode) - (global-goto-address-mode +1) - (add-hook 'after-change-major-mode-hook 'goto-address-mode))) - -(when (require 'recentf nil :noerror) - (setq-default recentf-save-file (.etc "recentf.el") - recentf-max-menu-items 100 - recentf-max-saved-items nil - recentf-auto-cleanup 'mode) - (add-to-list 'recentf-exclude .etc) - (recentf-mode +1)) - -(when (require 'savehist nil :noerror) - (setq-default history-length t - history-delete-duplicates t - history-autosave-interval 60 - savehist-file (.etc "savehist.el") - ;; Other variables --- don't truncate any of these. - ;; `add-to-history' uses the values of these variables unless - ;; they're nil, in which case it falls back to `history-length'. - kill-ring-max 100 - mark-ring-max 100 - global-mark-ring-max 100 - regexp-search-ring-max 100 - search-ring-max 100 - kmacro-ring-max 100 - eww-history-limit 100) - (dolist (var '(extended-command-history - global-mark-ring - mark-ring - kill-ring - kmacro-ring - regexp-search-ring - search-ring)) - (add-to-list 'savehist-additional-variables var)) - (savehist-mode +1)) - -(when (require 'saveplace nil :noerror) - (setq-default save-place-file (.etc "places.el") - save-place-forget-unreadable-files (eq system-type 'gnu/linux)) - (save-place-mode +1)) - -;; (when (require 'tramp) -;; ;; thanks Irreal! https://irreal.org/blog/?p=895 -;; (add-to-list 'tramp-default-proxies-alist -;; '(nil "\\`root\\'" "/ssh:%h:")) -;; (add-to-list 'tramp-default-proxies-alist -;; '((regexp-quote (system-name)) nil nil))) - - -;;; Newer features -;; These aren't in older version of Emacs, but they're so nice. - -(when (fboundp 'repeat-mode) - (setq-default repeat-exit-key "g" - repeat-exit-timeout 5) - (repeat-mode +1)) - -(when (fboundp 'pixel-scroll-precision-mode) - (pixel-scroll-precision-mode +1)) - -(provide '+emacs) -;;; +emacs.el ends here diff --git a/lisp/+embark.el b/lisp/+embark.el deleted file mode 100644 index e66d4b3..0000000 --- a/lisp/+embark.el +++ /dev/null @@ -1,28 +0,0 @@ -;;; +embark.el -*- lexical-binding: t; -*- - -;;; Commentary: - -;; https://github.com/oantolin/embark/wiki/Additional-Actions - -;;; Code: - -(require 'embark) - -(embark-define-keymap embark-straight-map - ("u" straight-visit-package-website) - ("r" straight-get-recipe) - ("i" straight-use-package) - ("c" straight-check-package) - ("F" straight-pull-package) - ("f" straight-fetch-package) - ("p" straight-push-package) - ("n" straight-normalize-package) - ("m" straight-merge-package)) - -(add-to-list 'embark-keymap-alist '(straight . embark-straight-map)) - -(with-eval-after-load 'marginalia - (add-to-list 'marginalia-prompt-categories '("recipe\\|package" . straight))) - -(provide '+embark) -;;; +embark.el ends here diff --git a/lisp/+emms.el b/lisp/+emms.el deleted file mode 100644 index 403cbff..0000000 --- a/lisp/+emms.el +++ /dev/null @@ -1,46 +0,0 @@ -;;; +emms.el --- EMMS customizations -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -(require 'emms-player-mpv) -(require 'el-patch) - -;; https://lists.gnu.org/archive/html/emms-help/2022-01/msg00006.html -(el-patch-feature emms-player-mpv) -(with-eval-after-load 'emms-player-mpv - (el-patch-defun emms-player-mpv-start (track) - (setq emms-player-mpv-stopped nil) - (emms-player-mpv-proc-playing nil) - (let - ((track-name (emms-track-get track 'name)) - (track-is-playlist (memq (emms-track-get track 'type) - '(streamlist playlist)))) - (if (emms-player-mpv-ipc-fifo-p) - (progn - ;; ipc-stop is to clear any buffered commands - (emms-player-mpv-ipc-stop) - (emms-player-mpv-proc-init (if track-is-playlist "--playlist" "--") - track-name) - (emms-player-started emms-player-mpv)) - (let* - ((play-cmd - `(batch - ((,(el-patch-swap - (if track-is-playlist 'loadlist 'loadfile) - 'loadfile) - ,track-name replace)) - ((set pause no)))) - (start-func - ;; Try running play-cmd and retry it on connection failure, e.g. if mpv died - (apply-partially 'emms-player-mpv-cmd play-cmd - (lambda (_mpv-data mpv-error) - (when (eq mpv-error 'connection-error) - (emms-player-mpv-cmd play-cmd)))))) - (if emms-player-mpv-ipc-stop-command - (setq emms-player-mpv-ipc-stop-command start-func) - (funcall start-func))))))) - -(provide '+emms) -;;; +emms.el ends here diff --git a/lisp/+eshell.el b/lisp/+eshell.el deleted file mode 100644 index b874141..0000000 --- a/lisp/+eshell.el +++ /dev/null @@ -1,126 +0,0 @@ -;;; +eshell.el -*- lexical-binding: t; -*- - -;;; Code: - -;; https://karthinks.com/software/jumping-directories-in-eshell/ -(defun eshell/z (&optional regexp) - "Navigate to a previously visited directory in eshell, or to -any directory proferred by `consult-dir'." - (let ((eshell-dirs (delete-dups - (mapcar 'abbreviate-file-name - (ring-elements eshell-last-dir-ring))))) - (cond - ((and (not regexp) (featurep 'consult-dir)) - (let* ((consult-dir--source-eshell `(:name "Eshell" - :narrow ?e - :category file - :face consult-file - :items ,eshell-dirs)) - (consult-dir-sources (cons consult-dir--source-eshell - consult-dir-sources))) - (eshell/cd (substring-no-properties - (consult-dir--pick "Switch directory: "))))) - (t (eshell/cd (if regexp (eshell-find-previous-directory regexp) - (completing-read "cd: " eshell-dirs))))))) - -;;; Start and quit - -;; from https://old.reddit.com/r/emacs/comments/1zkj2d/advanced_usage_of_eshell/ -(defun +eshell-here () - "Go to eshell and set current directory to current buffer's." - ;; consider: make a new eshell buffer when given a prefix argument. - (interactive) - (let ((dir (file-name-directory (or (buffer-file-name) - default-directory)))) - (eshell) - (eshell/pushd ".") - (cd dir) - (goto-char (point-max)) - (eshell-kill-input) - (eshell-send-input) - (setq-local scroll-margin 0) - (recenter 0))) - -(defun +eshell-quit-or-delete-char (arg) - "Delete the character to the right, or quit eshell on an empty line." - (interactive "p") - (if (and (eolp) (looking-back eshell-prompt-regexp)) - (progn (eshell-life-is-too-much) - (when (and (<= 1 (count-windows)) - ;; TODO: This is not what I want. What I really want is - ;; for an eshell-only frame (i.e., called from a - ;; keybind) to delete itself, but a regular Emacs frame - ;; with Eshell inside to stick around. I think I'll - ;; need to make a frame-local (?) variable for that to - ;; work. - (> (length (frame-list)) 2) - server-process) - (delete-frame))) - (delete-forward-char arg))) - -;;; Insert previous arguments -;; Record arguments - -(defvar eshell-arg-history nil) -(defvar eshell-arg-history-index nil) -(add-to-list 'savehist-additional-variables 'eshell-arg-history) - -(defun eshell-record-args (&rest _) - "Record unique arguments onto the front of `eshell-arg-history'." - (setq eshell-arg-history - (cl-loop with history = eshell-arg-history - for arg in (reverse eshell-last-arguments) - do (setq history (cons arg (remove arg history))) - finally return history))) - -(defun eshell-insert-prev-arg () - "Insert an argument from `eshell-arg-history' at point." - (interactive) - (if (eq last-command 'eshell-insert-prev-arg) - (progn - (let ((pos (point))) - (eshell-backward-argument 1) - (delete-region (point) pos)) - (if-let ((text (nth eshell-arg-history-index - eshell-arg-history))) - (progn - (insert text) - (cl-incf eshell-arg-history-index)) - (insert (cl-first eshell-arg-history)) - (setq eshell-arg-history-index 1))) - (insert (cl-first eshell-arg-history)) - (setq eshell-arg-history-index 1))) - -;;;###autoload -(define-minor-mode eshell-arg-hist-mode - "Minor mode to enable argument history, like bash/zsh with M-." - :lighter "$." - :keymap (let ((map (make-sparse-keymap))) - (define-key map (kbd "M-.") #'eshell-insert-prev-arg) - map) - (if eshell-arg-hist-mode - (add-hook 'eshell-post-command-hook #'eshell-record-args nil t) - (remove-hook 'eshell-post-command-hook #'eshell-record-args t))) - -;;;###autoload -(defmacro +eshell-eval-after-load (&rest forms) - "Execute FORMS after Eshell is loaded. -If Eshell is already loaded in the session, immediately execute -forms. - -I wrote this because Eshell doesn't properly do loading or -something, it's really annoying to work with." - (declare (indent 0)) - `(progn - (defun +eshell@setup () - "Setup the Eshell session." - ,@forms) - (when (featurep 'eshell) - `(dolist (buf (buffer-list)) - (with-current-buffer buf - (when (derived-mode-p 'eshell-mode) - (+eshell@setup))))) - (add-hook 'eshell-mode-hook #'+eshell@setup))) - -(provide '+eshell) -;;; +eshell.el ends here diff --git a/lisp/+eww.el b/lisp/+eww.el deleted file mode 100644 index 8d53571..0000000 --- a/lisp/+eww.el +++ /dev/null @@ -1,71 +0,0 @@ -;;; +eww.el -*- lexical-binding: t; -*- - -;;; Code: - -(require 'bookmark) -(require 'eww) - -;; Track whether the current page is readable - -(defvar-local +eww-readable-p nil - "Whether `eww-readable' has been toggled on the current buffer.") - -(defun +eww-mark-readable (&rest _) - "ADVICE to mark current eww buffer \"readable.\"" - (setq-local +eww-readable-p t)) - -(defun +eww-mark-unreadable (&rest _) - "ADVICE to mark current eww buffer \"unreadable.\"" - (setq-local +eww-readable-p nil)) - -(defvar +eww-readable-unreadable-after-functions '(eww-render - eww-reload - eww-back-url) - "Functions after which the page is rendered \"unreadable\".") - -;;;###autoload -(define-minor-mode +eww-track-readable-mode - "Track whether the current webpage has been rendered readable." - :lighter "" - (if +eww-track-readable-mode - (progn - (advice-add 'eww-readable :after #'+eww-mark-readable) - (dolist (func +eww-readable-unreadable-after-functions) - (advice-add func :after #'+eww-mark-unreadable))) - (dolist (func +eww-readable-unreadable-after-functions) - (advice-remove func #'+eww-mark-unreadable)) - (advice-remove 'eww-readable #'+eww-mark-readable))) - -;; Integrate bookmarks in eww - -(defun +eww-bookmark--make () - "Make eww bookmark record." - `((filename . ,(plist-get eww-data :url)) - (title . ,(plist-get eww-data :title)) - (time . ,(current-time-string)) - (handler . ,#'+eww-bookmark-handler) - (defaults . (,(concat - ;; url without the https and path - (replace-regexp-in-string - "/.*" "" - (replace-regexp-in-string - "\\`https?://" "" - (plist-get eww-data :url))) - " - " - ;; page title - (replace-regexp-in-string - "\\` +\\| +\\'" "" - (replace-regexp-in-string - "[\n\t\r ]+" " " - (plist-get eww-data :title)))))))) - -(defun +eww-bookmark-handler (bm) - "Handler for eww bookmarks." - (eww-browse-url (alist-get 'filename bm))) - -(defun +eww-bookmark-setup () - "Setup eww bookmark integration." - (setq-local bookmark-make-record-function #'+eww-bookmark--make)) - -(provide '+eww) -;;; +eww.el ends here diff --git a/lisp/+expand-region.el b/lisp/+expand-region.el deleted file mode 100644 index 8aac3ce..0000000 --- a/lisp/+expand-region.el +++ /dev/null @@ -1,24 +0,0 @@ -;;; +expand-region.el -*- lexical-binding: t; -*- - -;;; Commentary: - -;; - -;;; Code: - -;; Because of `wrap-region', I can't use `expand-region-fast-keys-enabled'. So -;; instead of that, I'm adding this to the binding to C--, but I also want to be -;; able to use the negative argument. So there's this. -(defun +er/contract-or-negative-argument (arg) - "Contract the region if the last command expanded it. -Otherwise, pass the ARG as a negative argument." - (interactive "p") - (cond ((memq last-command '(er/expand-region - er/contract-region - +er/contract-or-negative-argument)) - - (er/contract-region arg)) - (t (call-interactively #'negative-argument)))) - -(provide '+expand-region) -;;; +expand-region.el ends here diff --git a/lisp/+finger.el b/lisp/+finger.el deleted file mode 100644 index 1a878bc..0000000 --- a/lisp/+finger.el +++ /dev/null @@ -1,46 +0,0 @@ -;;; +finger.el --- Finger bugfix -*- lexical-binding: t; -*- - -;;; Commentary: - -;; `net-utils' defines `finger', which purportedly consults -;; `finger-X.500-host-regexps' to determine what hosts to only send a username -;; to. I've found that that is not the case, and so I've patched it. At some -;; point I'll submit this to Emacs itself. - -;;; Code: - -(require 'net-utils) ; this requires everything else I'll need. -(require 'seq) - -(defun finger (user host) - "Finger USER on HOST. -This command uses `finger-X.500-host-regexps' -and `network-connection-service-alist', which see." - ;; One of those great interactive statements that's actually - ;; longer than the function call! The idea is that if the user - ;; uses a string like "pbreton@cs.umb.edu", we won't ask for the - ;; host name. If we don't see an "@", we'll prompt for the host. - (interactive - (let* ((answer (read-from-minibuffer "Finger User: " - (net-utils-url-at-point))) - (index (string-match (regexp-quote "@") answer))) - (if index - (list (substring answer 0 index) - (substring answer (1+ index))) - (list answer - (read-from-minibuffer "At Host: " - (net-utils-machine-at-point)))))) - (let* ((user-and-host (concat user "@" host)) - (process-name (concat "Finger [" user-and-host "]")) - (regexps finger-X.500-host-regexps) - ) ;; found - (when (seq-some (lambda (r) (string-match-p r host)) regexps) - (setq user-and-host user)) - (run-network-program - process-name - host - (cdr (assoc 'finger network-connection-service-alist)) - user-and-host))) - -(provide '+finger) -;;; +finger.el ends here diff --git a/lisp/+flyspell-correct.el b/lisp/+flyspell-correct.el deleted file mode 100644 index 22f8c82..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/+god-mode.el b/lisp/+god-mode.el deleted file mode 100644 index f70e76b..0000000 --- a/lisp/+god-mode.el +++ /dev/null @@ -1,17 +0,0 @@ -;;; +god-mode.el -*- lexical-binding: t; -*- - -;;; Code: - -(defun +god-mode-insert () - "Leave `god-local-mode' at point." - (interactive) - (god-local-mode -1)) - -(defun +god-mode-append () - "Leave `god-local-mode' after point." - (interactive) - (forward-char 1) - (god-local-mode -1)) - -(provide '+god-mode) -;;; +god-mode.el ends here diff --git a/lisp/+hideshow.el b/lisp/+hideshow.el deleted file mode 100644 index e60efb8..0000000 --- a/lisp/+hideshow.el +++ /dev/null @@ -1,44 +0,0 @@ -;;; +hideshow.el -*- lexical-binding: t; -*- - -;;; Commentary: - -;; initiated by https://karthinks.com/software/simple-folding-with-hideshow/ - -;;; Code: - -(defun +hs-cycle (&optional level) - (interactive "p") - (let (message-log-max - (inhibit-message t)) - (if (= level 1) - (pcase last-command - ('+hs-cycle - (hs-hide-level 1) - (setq this-command 'hs-cycle-children)) - ('hs-cycle-children - ;; TODO: Fix this case. `hs-show-block' needs to be - ;; called twice to open all folds of the parent - ;; block. - (save-excursion (hs-show-block)) - (hs-show-block) - (setq this-command 'hs-cycle-subtree)) - ('hs-cycle-subtree - (hs-hide-block)) - (_ - (if (not (hs-already-hidden-p)) - (hs-hide-block) - (hs-hide-level 1) - (setq this-command 'hs-cycle-children)))) - (hs-hide-level level) - (setq this-command 'hs-hide-level)))) - -(defun +hs-global-cycle () - (interactive) - (pcase last-command - ('+hs-global-cycle - (save-excursion (hs-show-all)) - (setq this-command 'hs-global-show)) - (_ (hs-hide-all)))) - -(provide '+hideshow) -;;; +hideshow.el ends here diff --git a/lisp/+init.el b/lisp/+init.el deleted file mode 100644 index 903f2dc..0000000 --- a/lisp/+init.el +++ /dev/null @@ -1,117 +0,0 @@ -;;; +init.el --- extra init.el stuff -*- lexical-binding: t -*- - -;;; Commentary: - -;; Yes, I edit my init.el often enough I need to write a mode for it. The -;; sorting function is based on code from -;; https://github.com/alphapapa/unpackaged.el - -;;; Code: - -(require '+lisp) - -;;; Sort `setup' forms - -(defun +init--sexp-setup-p (sexp-str &optional head) - "Is SEXP-STR a `setup' form, optionally with a HEAD form?" - (let ((head (if (and head (symbolp head)) - (symbol-name head) - head))) - (and (string-match-p (rx (: bos (* whitespace) "(setup")) sexp-str) - (if head - (string-match-p (concat "\\`.*" head) sexp-str) - t)))) - -(defun +init-sort () - "Sort init.el. -Sort based on the following heuristic: `setup' forms (the -majority of my init.el) are sorted after everything else, and -within that group, forms with a HEAD of `:require' are sorted -first, and `:straight' HEADs are sorted last. All other forms -are sorted lexigraphically." - (interactive) - ;; I have to make my own "version" of `save-excursion', since the mark and - ;; point are lost (I think that's the problem) when sorting the buffer. - (let* ((current-point (point)) - (current-defun (beginning-of-defun)) - (defun-point (- current-point (point))) - (current-defun-re (buffer-substring-no-properties (line-beginning-position) - (line-end-position)))) - (widen) ; It makes no sense to `save-restriction' - (+lisp-sort-sexps - (point-min) (point-max) - ;; Key function - nil - ;; Sort function - (lambda (s1 s2) - (let ((s1 (cdr s1)) (s2 (cdr s2))) - (cond - ;; Sort everything /not/ `setup' /before/ `setup' - ((and (+init--sexp-setup-p s1) - (not (+init--sexp-setup-p s2))) - nil) - ((and (+init--sexp-setup-p s2) - (not (+init--sexp-setup-p s1))) - t) - ;; otherwise... - (t (let ((s1-straight (+init--sexp-setup-p s1 :straight)) - (s2-straight (+init--sexp-setup-p s2 :straight)) - (s1-require (+init--sexp-setup-p s1 :require)) - (s2-require (+init--sexp-setup-p s2 :require))) - (cond - ;; `:straight' setups have extra processing - ((and s1-straight s2-straight) - (let* ((r (rx (: ":straight" (? "-when") (* space) (? "(")))) - (s1 (replace-regexp-in-string r "" s1)) - (s2 (replace-regexp-in-string r "" s2))) - (string< s1 s2))) - ;; `:require' setups go first - ((and s1-require (not s2-require)) t) - ((and s2-require (not s1-require)) nil) - ;; `:straight' setups go last - ((and s1-straight (not s2-straight)) nil) - ((and s2-straight (not s1-straight)) t) - ;; otherwise, sort lexigraphically - (t (string< s1 s2))))))))) - ;; Return to original point relative to the defun we were in - (ignore-errors (goto-char (point-min)) - (re-search-forward current-defun-re) - (beginning-of-defun) - (goto-char (+ (point) defun-point))))) - -(defun +init-sort-then-save () - "Sort init.el, then save it." - (interactive) - (+init-sort) - (if (fboundp #'user-save-buffer) - (user-save-buffer) - (save-buffer))) - -;;; Add `setup' forms to `imenu-generic-expression' - -(defun +init-add-setup-to-imenu () - "Recognize `setup' forms in `imenu'." - ;; `imenu-generic-expression' automatically becomes buffer-local when set - (setf (alist-get "Setup" imenu-generic-expression nil nil #'equal) - (list - (rx (: "(setup" (+ space) - (group (? "(") (* nonl)))) - 1)) - (when (boundp 'consult-imenu-config) - (setf (alist-get ?s - (plist-get - (alist-get 'emacs-lisp-mode consult-imenu-config) - :types)) - '("Setup")))) - -;;; Major mode - -;;;###autoload -(define-derived-mode +init-mode emacs-lisp-mode "Init.el" - "`emacs-lisp-mode', but with a few specialized bits and bobs for init.el.") - -;;;###autoload -(add-to-list 'auto-mode-alist '("/init\\.el\\'" . +init-mode)) - -(provide '+init) -;;; +init.el ends here diff --git a/lisp/+ispell.el b/lisp/+ispell.el deleted file mode 100644 index fbfc0f0..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 - (setq 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) - (setq 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 - (setq 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 - (setq 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/+jabber.el b/lisp/+jabber.el deleted file mode 100644 index e018b0c..0000000 --- a/lisp/+jabber.el +++ /dev/null @@ -1,278 +0,0 @@ -;;; +jabber.el --- Customizations for jabber.el -*- lexical-binding: t; -*- - -;;; Commentary: - -;; Most changes I want to PR and contribute, but a few don't make sense to -;; contribute upstream, at least not now. - -;;; Code: - -(require 'jabber) -(require 'tracking) - -(defgroup +jabber nil - "Extra jabber.el customizations." - :group 'jabber) - -(defcustom +jabber-ws-prefix 0 - "Width to pad left side of chats." - :type 'string) - -(defcustom +jabber-pre-prompt " \n" - "String to put before the prompt." - :type 'string) - -(defvar +jabber-tracking-show-p #'jabber-activity-show-p-default - "Function that checks if the given JID should be shown in the mode line. -This does the same as `jabber-activity-show-p', but for the -`tracking-mode' mode-line.") - -(defun +jabber-tracking-add (from buffer text proposed-alert) - "ADVICE to add jabber buffers to `tracking-buffers'." - (when (funcall +jabber-tracking-show-p from) - (tracking-add-buffer buffer 'jabber-activity-face))) - -(defun +jabber-tracking-add-muc (nick group buffer text proposed-alert) - "ADVICE to add jabber MUC buffers to `tracking-buffers'." - (when (funcall +jabber-tracking-show-p group) - (tracking-add-buffer buffer 'jabber-activity-face))) - -;;; Hiding presence messages: -;; https://paste.sr.ht/~hdasch/f0ad09fbcd08e940a4fda71c2f40abc1c4efd45f - -;; Tame MUC presence notifications. - -;; This patch hides or applies a face to MUC presence notifications in -;; the MUC chat buffer. To control its behavior, customize -;; ’jabber-muc-decorate-presence-patterns’. By default it does nothing. - -;; ’jabber-muc-decorate-presence-patterns’ is a list of pairs consisting -;; of a regular expression and a either a face or ‘nil’. If a the -;; regular expression matches a presence notification, then either: - -;; - the specified face is applied to the notification message -;; - or if the second value of the pair is nil, the notification is -;; discarded - -;; If no regular expression in the list of pairs matches the notification -;; message, the message is displayed unchanged. - -;; For example, the customization: - -;; '(jabber-muc-decorate-presence-patterns -;; '(("\\( enters the room ([^)]+)\\| has left the chatroom\\)$") -;; ("." . jabber-muc-presence-dim))) - -;; hides participant enter/leave notifications. It also diminishes other -;; presence notification messages to make it easier to distinguish -;; between conversation and notifications. - -(defface jabber-muc-presence-dim - '((t (:foreground "dark grey" :weight light :slant italic))) - "face for diminished presence notifications.") - -(defcustom jabber-muc-decorate-presence-patterns nil - "List of regular expressions and face pairs. -When a presence notification matches a pattern, display it with -associated face. Ignore notification if face is ‘nil’." - :type '(repeat - :tag "Patterns" - (cons :format "%v" - (regexp :tag "Regexp") - (choice - (const :tag "Ignore" nil) - (face :tag "Face" :value jabber-muc-presence-dim)))) - :group 'jabber-alerts) - -(defun jabber-muc-maybe-decorate-presence (node) - "Filter presence notifications." - (cl-destructuring-bind (key msg &key time) node - (let* ((match (cl-find-if - (lambda (pair) - (string-match (car pair) msg)) - jabber-muc-decorate-presence-patterns)) - (face (cdr-safe match))) - (if match - (when face - (jabber-maybe-print-rare-time - (ewoc-enter-last - jabber-chat-ewoc - (list key - (propertize msg 'face face) - :time time)))) - (jabber-maybe-print-rare-time - (ewoc-enter-last jabber-chat-ewoc node)))))) - -(defun jabber-muc-process-presence (jc presence) - (let* ((from (jabber-xml-get-attribute presence 'from)) - (type (jabber-xml-get-attribute presence 'type)) - (x-muc (cl-find-if - (lambda (x) (equal (jabber-xml-get-attribute x 'xmlns) - "http://jabber.org/protocol/muc#user")) - (jabber-xml-get-children presence 'x))) - (group (jabber-jid-user from)) - (nickname (jabber-jid-resource from)) - (symbol (jabber-jid-symbol from)) - (our-nickname (gethash symbol jabber-pending-groupchats)) - (item (car (jabber-xml-get-children x-muc 'item))) - (actor (jabber-xml-get-attribute (car (jabber-xml-get-children item 'actor)) 'jid)) - (reason (car (jabber-xml-node-children (car (jabber-xml-get-children item 'reason))))) - (error-node (car (jabber-xml-get-children presence 'error))) - (status-codes (if error-node - (list (jabber-xml-get-attribute error-node 'code)) - (mapcar - (lambda (status-element) - (jabber-xml-get-attribute status-element 'code)) - (jabber-xml-get-children x-muc 'status))))) - ;; handle leaving a room - (cond - ((or (string= type "unavailable") (string= type "error")) - ;; error from room itself? or are we leaving? - (if (or (null nickname) - (member "110" status-codes) - (string= nickname our-nickname)) - ;; Assume that an error means that we were thrown out of the - ;; room... - (let* ((leavingp t) - (message (cond - ((string= type "error") - (cond - ;; ...except for certain cases. - ((or (member "406" status-codes) - (member "409" status-codes)) - (setq leavingp nil) - (concat "Nickname change not allowed" - (when error-node - (concat ": " (jabber-parse-error error-node))))) - (t - (concat "Error entering room" - (when error-node - (concat ": " (jabber-parse-error error-node))))))) - ((member "301" status-codes) - (concat "You have been banned" - (when actor (concat " by " actor)) - (when reason (concat " - '" reason "'")))) - ((member "307" status-codes) - (concat "You have been kicked" - (when actor (concat " by " actor)) - (when reason (concat " - '" reason "'")))) - (t - "You have left the chatroom")))) - (when leavingp - (jabber-muc-remove-groupchat group)) - ;; If there is no buffer for this groupchat, don't bother - ;; creating one just to tell that user left the room. - (let ((buffer (get-buffer (jabber-muc-get-buffer group)))) - (if buffer - (with-current-buffer buffer - (jabber-muc-maybe-decorate-presence - (list (if (string= type "error") - :muc-error - :muc-notice) - message - :time (current-time))))) - (message "%s: %s" (jabber-jid-displayname group) message)))) - ;; or someone else? - (let* ((plist (jabber-muc-participant-plist group nickname)) - (jid (plist-get plist 'jid)) - (name (concat nickname - (when jid - (concat " <" - (jabber-jid-user jid) - ">"))))) - (jabber-muc-remove-participant group nickname) - (with-current-buffer (jabber-muc-create-buffer jc group) - (jabber-muc-maybe-decorate-presence - (list :muc-notice - (cond - ((member "301" status-codes) - (concat name " has been banned" - (when actor (concat " by " actor)) - (when reason (concat " - '" reason "'")))) - ((member "307" status-codes) - (concat name " has been kicked" - (when actor (concat " by " actor)) - (when reason (concat " - '" reason "'")))) - ((member "303" status-codes) - (concat name " changes nickname to " - (jabber-xml-get-attribute item 'nick))) - (t - (concat name " has left the chatroom"))) - :time (current-time)))))) - (t - ;; someone is entering - - (when (or (member "110" status-codes) (string= nickname our-nickname)) - ;; This is us. We just succeeded in entering the room. - ;; - ;; The MUC server is supposed to send a 110 code whenever this - ;; is our presence ("self-presence"), but at least one - ;; (ejabberd's mod_irc) doesn't, so check the nickname as well. - ;; - ;; This check might give incorrect results if the server - ;; changed our nickname to avoid collision with an existing - ;; participant, but even in this case the window where we have - ;; incorrect information should be very small, as we should be - ;; getting our own 110+210 presence shortly. - (let ((whichgroup (assoc group *jabber-active-groupchats*))) - (if whichgroup - (setcdr whichgroup nickname) - (add-to-list '*jabber-active-groupchats* (cons group nickname)))) - ;; The server may have changed our nick. Record the new one. - (puthash symbol nickname jabber-pending-groupchats)) - - ;; Whoever enters, we create a buffer (if it didn't already - ;; exist), and print a notice. This is where autojoined MUC - ;; rooms have buffers created for them. We also remember some - ;; metadata. - (let ((old-plist (jabber-muc-participant-plist group nickname)) - (new-plist (jabber-muc-parse-affiliation x-muc))) - (jabber-muc-modify-participant group nickname new-plist) - (let ((report (jabber-muc-report-delta nickname old-plist new-plist - reason actor))) - (when report - (with-current-buffer (jabber-muc-create-buffer jc group) - (jabber-muc-maybe-decorate-presence - (list :muc-notice report - :time (current-time))) - ;; Did the server change our nick? - (when (member "210" status-codes) - (ewoc-enter-last - jabber-chat-ewoc - (list :muc-notice - (concat "Your nick was changed to " nickname " by the server") - :time (current-time)))) - ;; Was this room just created? If so, it's a locked - ;; room. Notify the user. - (when (member "201" status-codes) - (ewoc-enter-last - jabber-chat-ewoc - (list :muc-notice - (with-temp-buffer - (insert "This room was just created, and is locked to other participants.\n" - "To unlock it, ") - (insert-text-button - "configure the room" - 'action (apply-partially 'call-interactively 'jabber-muc-get-config)) - (insert " or ") - (insert-text-button - "accept the default configuration" - 'action (apply-partially 'call-interactively 'jabber-muc-instant-config)) - (insert ".") - (buffer-string)) - :time (current-time)))))))))))) - -(defun +jabber-colors-update (&optional buffer) - "Update jabber colors in BUFFER, defaulting to the current." - (with-current-buffer (or buffer (current-buffer)) - (when jabber-buffer-connection - (setq jabber-muc-participant-colors nil) - (cond (jabber-chatting-with - (jabber-chat-create-buffer jabber-buffer-connection - jabber-chatting-with)) - (jabber-group - (jabber-muc-create-buffer jabber-buffer-connection - jabber-group)))))) - -(provide '+jabber) -;;; +jabber.el ends here diff --git a/lisp/+key.el b/lisp/+key.el deleted file mode 100644 index a217dad..0000000 --- a/lisp/+key.el +++ /dev/null @@ -1,106 +0,0 @@ -;;; +key.el --- minor mode for keymaps -*- lexical-binding: t; -*- - -;;; Commentary: - -;; Much of the code here was cribbed from https://emacs.stackexchange.com/a/358, -;; which in turn was cribbed in part from -;; https://github.com/kaushalmodi/.emacs.d/blob/master/elisp/modi-mode.el, -;; https://github.com/jwiegley/use-package/blob/master/bind-key.el and -;; elsewhere. - -;; The basic idea is to have a minor-mode for my personal key customizations, -;; especially a "leader key" set up à la vim. In Emacs, I use `C-z' for this -;; leader key, because of its easy location and relative uselessness by default. - -;;; Code: - -(require 'easy-mmode) -(require 'setup nil t) - -;; I need to define this map before the proper mode map. -(defvar +key-leader-map (let ((map (make-sparse-keymap)) - (c-z (global-key-binding "\C-z"))) - ;;(define-key map "\C-z" c-z) - map) - "A leader keymap under the \"C-z\" bind.") - -;; http://xahlee.info/emacs/emacs/emacs_menu_app_keys.html and -(defvar +key-menu-map (let ((map (make-sparse-keymap))) - (define-key map (kbd "") - #'execute-extended-command) - map) - "Custom bindings behind the menu key.") - -(defvar +key-mode-map (let ((map (make-sparse-keymap))) - (define-key map "\C-z" +key-leader-map) - (define-key map (kbd "") +key-menu-map) - map) - "Keymap for `+key-mode'.") - -(defun turn-off-+key-mode () - "Turn off `+key-mode'." - (+key-mode -1)) - -;;;###autoload -(define-minor-mode +key-mode - "A minor mode with keybindings that will override every other mode." - :init-value t - :lighter " +" - (if +key-mode - (progn ; Enable - (add-to-list 'emulation-mode-map-alists - `((+key-mode . ,+key-mode-map))) - ;; Disable in minibuffer - (add-hook 'minibuffer-setup-hook #'turn-off-+key-mode) - ;; compat Linux-Windows - (define-key key-translation-map (kbd "") (kbd "")) - ;; curse you, thinkpad keyboard!!! - (define-key key-translation-map (kbd "") (kbd "")) - ) - ;; Disable - (setq emulation-mode-map-alists - (assoc-delete-all '+key-mode emulation-mode-map-alists - (lambda (a b) - (equal (car a) b)))) - (remove-hook 'minibuffer-setup-hook #'turn-off-+key-mode) - (define-key key-translation-map (kbd "") nil) - (define-key key-translation-map (kbd "") nil))) - -;;;###autoload -(defun +key-setup () - "Ensure `+key-mode' happens after init." - (if after-init-time - (+key-global-mode) - (add-hook 'after-init-hook #'+key-global-mode))) - -;;;###autoload -(define-globalized-minor-mode +key-global-mode +key-mode +key-mode) - -;; Extras for `setup' -(with-eval-after-load 'setup - (setup-define :+key - (lambda (key command) - `(define-key +key-mode-map ,key ,command)) - :documentation "Bind KEY to COMMAND in `+key-mode-map'." - :debug '(form sexp) - :ensure '(kbd nil) - :repeatable t) - - (setup-define :+leader - (lambda (key command) - `(define-key +key-leader-map ,key ,command)) - :documentation "Bind KEY to COMMAND in `+key-leader-map'." - :debug '(form sexp) - :ensure '(kbd nil) - :repeatable t) - - (setup-define :+menu - (lambda (key command) - `(define-key +key-menu-map ,key ,command)) - :documentation "Bind KEY to COMMAND in `+key-leader-map'." - :debug '(form sexp) - :ensure '(kbd nil) - :repeatable t)) - -(provide '+key) -;;; +key.el ends here diff --git a/lisp/+kmacro.el b/lisp/+kmacro.el deleted file mode 100644 index a3cde61..0000000 --- a/lisp/+kmacro.el +++ /dev/null @@ -1,70 +0,0 @@ -;;; +kmacro.el -*- lexical-binding: t; -*- - -;;; Commentary: - -;; Many of these come from this Reddit thread: -;; https://old.reddit.com/r/emacs/comments/rlli0u/whats_your_favorite_defadvice/ - -;;; Code: - -(require 'kmacro) - -;; Indicate when a kmacro is being recorded in the mode-line - -(defface +kmacro-modeline nil - "Face when kmacro is active") - -(set-face-attribute '+kmacro-modeline nil - :background "Firebrick" - :box '(:line-width -1 :color "salmon" - :style released-button)) - -(defun +kmacro-change-mode-line (&rest _) - "Remap the mode-line face when recording a kmacro." - - (add-to-list 'face-remapping-alist '(mode-line . +kmacro-modeline))) - -(defun +kmacro-restore-mode-line (&rest _) - "Restore the mode-line face after kmacro is done recording." - (setf face-remapping-alist - (assoc-delete-all 'mode-line face-remapping-alist))) - -(define-minor-mode +kmacro-recording-indicator-mode - "Change the mode-line's face when recording a kmacro." - :lighter "" - :global t - (if +kmacro-recording-indicator-mode - (progn - (advice-add #'kmacro-start-macro :before #'+kmacro-change-mode-line) - (advice-add #'kmacro-keyboard-quit :after #'+kmacro-restore-mode-line) - (advice-add #'kmacro-end-macro :after #'+kmacro-restore-mode-line)) - (+kmacro-restore-mode-line) - (advice-remove #'kmacro-start-macro #'+kmacro-change-mode-line) - (advice-remove #'kmacro-keyboard-quit #'+kmacro-restore-mode-line) - (advice-remove #'kmacro-end-macro #'+kmacro-restore-mode-line))) - -;; Undo keyboard macros in a single bound (like vi!) - -(defun +kmacro-block-undo (fn &rest args) - (let ((marker (prepare-change-group))) - (unwind-protect (apply fn args) - (undo-amalgamate-change-group marker)))) - -(define-minor-mode +kmacro-block-undo-mode - "Undo kmacros all at once (like vi)." - :global t - :lighter " KUndo" - (if +kmacro-block-undo-mode - (dolist (fn '(kmacro-call-macro - kmacro-exec-ring-item - dot-mode-execute - apply-macro-to-region-lines)) - (advice-add fn :around #'+kmacro-block-undo)) - (dolist (fn '(kmacro-call-macro - kmacro-exec-ring-item - dot-mode-execute - apply-macro-to-region-lines)) - (advice-remove fn #'+kmacro-block-undo)))) - -(provide '+kmacro) -;;; +kmacro.el ends here diff --git a/lisp/+link-hint.el b/lisp/+link-hint.el deleted file mode 100644 index 205e915..0000000 --- a/lisp/+link-hint.el +++ /dev/null @@ -1,169 +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))) - -;; (cl-defmacro +link-hint-add-type (keyword ) -;; "Define link-hint type KEYWORD to operate on TYPES. -;; If TYPES is nil or absent, define KEYWORD for all -;; `link-hint-types'." -;; (let (forms) -;; (dolist (type (or types link-hint-types)) -;; (push `(link-hint-define-type ,type ,keyword ,function) forms)) -;; (push `(defun ,(intern (format "+link-hint%s" ,keyword)) -;; )))) - -(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") - (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)))) - -;;; Pocket-reader.el integration - -(defun +link-hint-pocket-add-setup (&optional types) - "Define the `:pocket-add' link-hint type for TYPES. -If TYPES is nil, define it for `link-hint-types'." - (dolist (type (or types link-hint-types)) - (link-hint-define-type type - :pocket-add #'pocket-reader-generic-add-link - :pocket-add-multiple t))) - -(defun +link-hint-pocket-add () - "Add a link to the Pocket reader." - (interactive) - (avy-with link-hint-open-link - (link-hint--one :pocket-add))) - -(provide '+link-hint) -;;; +link-hint.el ends here diff --git a/lisp/+lisp.el b/lisp/+lisp.el deleted file mode 100644 index a78e40e..0000000 --- a/lisp/+lisp.el +++ /dev/null @@ -1,195 +0,0 @@ -;;; +lisp.el --- extra lisp functionality -*- lexical-binding: t -*- - -;;; Code: - -;;; Sort sexps in a region. -;; https://github.com/alphapapa/unpackaged.el - -(defun +lisp-skip-whitespace () - (while (looking-at (rx (1+ (or space "\n")))) - (goto-char (match-end 0)))) - -(defun +lisp-skip-both () - (while (cond ((or (nth 4 (syntax-ppss)) - (ignore-errors - (save-excursion - (forward-char 1) - (nth 4 (syntax-ppss))))) - (forward-line 1)) - ((looking-at (rx (1+ (or space "\n")))) - (goto-char (match-end 0)))))) - -(defun +lisp-sort-sexps (beg end &optional key-fn sort-fn) - "Sort sexps between BEG and END. -Comments stay with the code below. - -Optional argument KEY-FN will determine where in each sexp to -start sorting. e.g. (lambda (sexp) (symbol-name (car sexp))) - -Optional argument SORT-FN will determine how to sort two sexps' -strings. It's passed to `sort'. By default, it sorts the sexps -with `string<' starting with the key determined by KEY-FN." - (interactive "r") - (save-excursion - (save-restriction - (narrow-to-region beg end) - (goto-char beg) - (+lisp-skip-both) - (cl-destructuring-bind (sexps markers) - (cl-loop do (+lisp-skip-whitespace) - for start = (point-marker) - for sexp = (ignore-errors - (read (current-buffer))) - for end = (point-marker) - while sexp - ;; Collect the real string, then one used for sorting. - collect (cons (buffer-substring (marker-position start) - (marker-position end)) - (save-excursion - (goto-char (marker-position start)) - (+lisp-skip-both) - (if key-fn - (funcall key-fn sexp) - (buffer-substring - (point) - (marker-position end))))) - into sexps - collect (cons start end) - into markers - finally return (list sexps markers)) - (setq sexps (sort sexps (if sort-fn sort-fn - (lambda (a b) - (string< (cdr a) (cdr b)))))) - (cl-loop for (real . sort) in sexps - for (start . end) in markers - do (progn - (goto-char (marker-position start)) - (insert-before-markers real) - (delete-region (point) (marker-position end)))))))) - -;;; 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)))) - -;;; Sort `setq' constructs -;;https://emacs.stackexchange.com/questions/33039/ - -(defun +lisp-sort-setq () - (interactive) - (save-excursion - (save-restriction - (let ((sort-end (progn - (end-of-defun) - (backward-char) - (point-marker))) - (sort-beg (progn - (beginning-of-defun) - (or (re-search-forward "[ \\t]*(" (point-at-eol) t) - (point-at-eol)) - (forward-sexp) - (or (re-search-forward "\\<" (point-at-eol) t) - (point-at-eol)) - (point-marker)))) - (narrow-to-region (1- sort-beg) (1+ sort-end)) - (sort-subr nil #'+lisp-sort-setq-next-record - #'+lisp-sort-setq-end-record))))) - -(defun +lisp-sort-setq-next-record () - (condition-case nil - (progn - (forward-sexp 1) - (backward-sexp)) - ('scan-error (end-of-buffer)))) - -(defun +lisp-sort-setq-end-record () - (condition-case nil - (forward-sexp 2) - ('scan-error (end-of-buffer)))) - -(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/+minibuffer.el b/lisp/+minibuffer.el deleted file mode 100644 index 7aa57a5..0000000 --- a/lisp/+minibuffer.el +++ /dev/null @@ -1,14 +0,0 @@ -;;; +minibuffer.el -*- lexical-binding: t -*- - -;;; Code: - -;; https://www.manueluberti.eu//emacs/2021/12/10/shell-command/ -(defun +minibuffer-complete-history () - "Complete minibuffer history." - (interactive) - (completion-in-region (minibuffer--completion-prompt-end) (point-max) - (symbol-value minibuffer-history-variable) - nil)) - -(provide '+minibuffer) -;;; +minibuffer.el ends here diff --git a/lisp/+modeline.el b/lisp/+modeline.el deleted file mode 100644 index c6e8463..0000000 --- a/lisp/+modeline.el +++ /dev/null @@ -1,488 +0,0 @@ -;;; +modeline.el --- my modeline customizations -*- lexical-binding: t; -*- - -;;; Commentary: - -;; `+modeline.el' is kind of a dumping ground for various -;; modeline-related functions. I probably don't use everything in -;; here. Credit given where possible. - -;;; Code: - -(require '+util) -(require 'actually-selected-window) -(require 'simple-modeline) -(require 'minions) - -(defgroup +modeline nil - "Various customization options for my modeline things." - :prefix "+modeline-" - :group 'simple-modeline) - -(defcustom +modeline-default-spacer " " - "Default spacer to use for modeline elements. -All modeline elements take an optional argument, `spacer', which -will default to this string.") - -;;; Combinators - -(defun +modeline-concat (segments &optional separator) - "Concatenate multiple functional modeline SEGMENTS. -Each segment in SEGMENTS is a function returning a mode-line -construct. - -Segments are separated using SEPARATOR, which defaults to -`+modeline-default-spacer'. Only segments that evaluate to a -non-zero-length string will be separated, for a cleaner look. - -This function returns a lambda that should be `:eval'd or -`funcall'd in a mode-line context." - (let ((separator (or separator +modeline-default-spacer))) - (lambda () - (let (this-sep result) - (dolist (segment segments) - (let ((segstr (funcall segment this-sep))) - (when (and segstr - (not (equal segstr ""))) - (push segstr result) - (setq this-sep separator)))) - (apply #'concat - (nreverse result)))))) - -(defun +modeline-spacer (&optional n spacer &rest strings) - "Make an N-length SPACER, or prepend SPACER to STRINGS. -When called with no arguments, insert `+modeline-default-spacer'. -N will repeat SPACER N times, and defaults to 1. SPACER defaults -to `+modeline-default-spacer', but can be any string. STRINGS -should form a mode-line construct when `concat'ed." - (declare (indent 2)) - (let ((spacer (or spacer +modeline-default-spacer)) - (n (or n 1)) - (strings (cond((null strings) '("")) - ((equal strings '("")) nil) - ((atom strings) (list strings)) - (t strings))) - r) - (when strings (dotimes (_ n) (push spacer r))) - (apply #'concat (apply #'concat r) strings))) - -;;; Modeline segments - -(defun +modeline-sanitize-string (string) - "Sanitize a string for `format-mode-line'." - (when string - (string-replace "%" "%%" string))) - -(defcustom +modeline-buffer-name-max-length 0 - "Maximum length of `+modeline-buffer-name'. -If > 0 and < 1, use that portion of the window's width. If > 1, -use that many characters. If anything else, don't limit. If the -buffer name is longer than the max length, it will be shortened -and appended with `truncate-string-ellipsis'." - :type '(choice (const :tag "No maximum length" 0) - (natnum :tag "Number of characters") - (float :tag "Fraction of window's width"))) - -(defcustom +modeline-buffer-position nil - "What to put in the `+modeline-buffer-name' position." - :type 'function - :local t) - -(defun +modeline-buffer-name (&optional spacer) ; gonsie - "Display the buffer name." - (let ((bufname (string-trim (string-replace "%" "%%%%" (buffer-name))))) - (+modeline-spacer nil spacer - (if (and +modeline-buffer-position (fboundp +modeline-buffer-position)) - (funcall +modeline-buffer-position) - (propertize (cond - ((ignore-errors - (and - (> +modeline-buffer-name-max-length 0) - (< +modeline-buffer-name-max-length 1))) - (truncate-string-to-width bufname - (* (window-total-width) - +modeline-buffer-name-max-length) - nil nil t)) - ((ignore-errors - (> +modeline-buffer-name-max-length 1)) - (truncate-string-to-width bufname - +modeline-buffer-name-max-length - nil nil t)) - (t bufname)) - 'help-echo (or (buffer-file-name) - (buffer-name)) - 'mouse-face 'mode-line-highlight))))) - -(defcustom +modeline-minions-icon "&" - "The \"icon\" for `+modeline-minions' button." - :type 'string) - -(defun +modeline-minions (&optional spacer) - "Display a button for `minions-minor-modes-menu'." - (+modeline-spacer nil spacer - (propertize - +modeline-minions-icon - 'help-echo "Minor modes menu\nmouse-1: show menu." - 'local-map (purecopy (simple-modeline-make-mouse-map - 'mouse-1 - (lambda (event) - (interactive "e") - (with-selected-window - (posn-window (event-start event)) - (minions-minor-modes-menu))))) - 'mouse-face 'mode-line-highlight))) - -(defcustom +modeline-major-mode-faces '((text-mode . font-lock-string-face) - (prog-mode . font-lock-keyword-face) - (t . font-lock-warning-face)) - "Mode->face mapping for `+modeline-major-mode'. -If the current mode is derived from the car of a cell, the face -in the cdr will be applied to the major-mode in the mode line." - :type '(alist :key-type function - :value-type face)) - -(defface +modeline-major-mode-face nil - "Face for modeline major-mode.") - -(defun +modeline-major-mode (&optional spacer) - "Display the current `major-mode'." - (+modeline-spacer nil spacer - "(" - (propertize ;; (+string-truncate (format-mode-line mode-name) 16) - (format-mode-line mode-name) - 'face (when (actually-selected-window-p) - ;; XXX: This is probably really inefficient. I need to - ;; simply detect which mode it's in when I change major - ;; modes (`change-major-mode-hook') and change the face - ;; there, probably. - ;; (catch :done (dolist (cel +modeline-major-mode-faces) - ;; (when (derived-mode-p (car cel)) - ;; (throw :done (cdr cel)))) - ;; (alist-get t +modeline-major-mode-faces)) - '+modeline-major-mode-face) - 'keymap (let ((map (make-sparse-keymap))) - (bindings--define-key map [mode-line down-mouse-1] - `(menu-item "Menu Bar" ignore - :filter ,(lambda (_) (mouse-menu-major-mode-map)))) - (define-key map [mode-line mouse-2] 'describe-mode) - (bindings--define-key map [mode-line down-mouse-3] - `(menu-item "Minions" minions-minor-modes-menu)) - map) - 'help-echo (+concat (list (format-mode-line mode-name) " mode") - "mouse-1: show menu" - "mouse-2: describe mode" - "mouse-3: display minor modes") - 'mouse-face 'mode-line-highlight) - ")")) - -(defcustom +modeline-modified-icon-alist '((ephemeral . "*") - (readonly . "=") - (modified . "+") - (special . "~") - (t . "-")) - "\"Icons\" to display depending on buffer status in modeline. -The CAR of each field is one of `readonly', `modified', -`special', `ephemeral', or t, and the CDR is a string to display -in that mode. - -`readonly' is true if the buffer is read-only and visiting a file. -`modified' is true if the buffer is modified. -`special' is true if the buffer is a special-mode or derived buffer. -`ephemeral' is true if the buffer is not visiting a file. -t is the fall-back, shown when nothing else in the alist applies. - -The order of elements matters: whichever one matches first is applied." - :type '(alist :key-type symbol - :value-type string) - :options '("readonly" "modified" "special" "t")) - -(defcustom +modeline-modified-icon-special-modes '(special-mode) - "Modes to apply the `special-mode' icon to in the -`+modeline-modified'." - :type '(repeat function)) - -(defun +modeline-modified (&optional spacer) ; modified from `simple-modeline-status-modified' - "Display a color-coded \"icon\" indicator for the buffer's status." - (let* ((icon (catch :icon - (dolist (cell +modeline-modified-icon-alist) - (when (pcase (car cell) - ('ephemeral (not (buffer-file-name))) - ('readonly buffer-read-only) - ('modified (buffer-modified-p)) - ('special - (apply 'derived-mode-p - +modeline-modified-icon-special-modes)) - ('t t) - (_ nil)) - (throw :icon cell)))))) - (+modeline-spacer nil spacer - (propertize (or (cdr-safe icon) "") - 'help-echo (format "Buffer \"%s\" is %s." - (buffer-name) - (pcase (car-safe icon) - ('t "unmodified") - ('nil "unknown") - (_ (car-safe icon)))))))) - -(defun +modeline-narrowed (&optional spacer) - "Display an indication that the buffer is narrowed." - (when (buffer-narrowed-p) - (+modeline-spacer nil spacer - (propertize "N" - 'help-echo (format "%s\n%s" - "Buffer is narrowed." - "mouse-2: widen buffer.") - 'local-map (purecopy (simple-modeline-make-mouse-map - 'mouse-2 'mode-line-widen)) - 'face 'font-lock-doc-face - 'mouse-face 'mode-line-highlight)))) - -(defun +modeline-reading-mode (&optional spacer) - "Display an indication that the buffer is in `reading-mode'." - (when reading-mode - (+modeline-spacer nil spacer - (propertize - (concat "R" (when (bound-and-true-p +eww-readable-p) "w")) - 'help-echo (format "%s\n%s" - "Buffer is in reading-mode." - "mouse-2: disable reading-mode.") - 'local-map (purecopy - (simple-modeline-make-mouse-map - 'mouse-2 (lambda (ev) - (interactive "e") - (with-selected-window - (posn-window - (event-start ev)) - (reading-mode -1) - (force-mode-line-update))))) - 'face 'font-lock-doc-face - 'mouse-face 'mode-line-highlight)))) - -(define-minor-mode file-percentage-mode - "Toggle the percentage display in the mode line (File Percentage Mode)." - :init-value t :global t :group 'mode-line) - -(defun +modeline--percentage () - "Return point's progress through current file as a percentage." - (let ((tot (count-screen-lines (point-min) (point-max) :ignore-invisible))) - (floor (* 100 (/ (float (line-number-at-pos)) tot))))) - -(defun +modeline--buffer-contained-in-window-p () - "Whether the buffer is totally contained within its window." - (let ((window-min (save-excursion (move-to-window-line 0) (point))) - (window-max (save-excursion (move-to-window-line -1) (point)))) - (and (<= window-min (point-min)) - (>= window-max (point-max))))) - -(defun +modeline-file-percentage (&optional spacer) - "Display the position in the current file." - (when file-percentage-mode - ;; (let ((perc (+modeline--percentage))) - ;; (propertize (+modeline-spacer nil spacer - ;; (cond - ;; ((+modeline--buffer-contained-in-window-p) "All") - ;; ((= (line-number-at-pos) (line-number-at-pos (point-min))) "Top") - ;; ((= (line-number-at-pos) (line-number-at-pos (point-max))) "Bot") - ;; ;; Why the 10 %s? Not sure. `format' knocks them - ;; ;; down to 5, then `format-mode-line' kills all but - ;; ;; two. If I use only 8, the margin is much too - ;; ;; large. Something else is obviously going on, but - ;; ;; I'm at a loss as to what it could be. - ;; (t (format "%d%%%%%%%%%%" perc)))) - ;; ;; TODO: add scroll-up and scroll-down bindings. - ;; )) - (let ((perc (format-mode-line '(-2 "%p")))) - (+modeline-spacer nil spacer - "/" - (pcase perc - ("To" "Top") - ("Bo" "Bot") - ("Al" "All") - (_ (format ".%02d" (string-to-number perc)))))))) - -(defun +modeline-file-percentage-ascii-icon (&optional spacer) - (when file-percentage-mode - (+modeline-spacer nil spacer - (let ((perc (format-mode-line '(-2 "%p")))) - (pcase perc - ("To" "/\\") - ("Bo" "\\/") - ("Al" "[]") - (_ (let ((vec (vector "/|" "//" "||" "\\\\" "\\|" "\\|")) - (perc (string-to-number perc))) - (aref vec (floor (/ perc 17)))))))))) - -(defun +modeline-file-percentage-icon (&optional spacer) - "Display the position in the current file as an icon." - (when file-percentage-mode - (let ((perc (+modeline--percentage))) - (propertize (+modeline-spacer nil spacer - (cond - ((+modeline--buffer-contained-in-window-p) "111") - ((= perc 0) "000") - ((< perc 20) "001") - ((< perc 40) "010") - ((< perc 60) "011") - ((< perc 80) "100") - ((< perc 100) "101") - ((>= perc 100) "110"))) - 'help-echo (format "Point is %d%% through the buffer." - perc))))) - -(define-minor-mode region-indicator-mode - "Toggle the region indicator in the mode line." - :init-value t :global t :group 'mode-line) - -(defun +modeline-region (&optional spacer) - "Display an indicator if the region is active." - (when (and region-indicator-mode - (region-active-p)) - (+modeline-spacer nil spacer - (propertize (format "%d%s" - (apply '+ (mapcar (lambda (pos) - (- (cdr pos) - (car pos))) - (region-bounds))) - (if (and (< (point) (mark))) "-" "+")) - 'font-lock-face 'font-lock-variable-name-face)))) - -(defun +modeline-line (&optional spacer) - (when line-number-mode - (+modeline-spacer nil spacer - "%3l"))) - -(defun +modeline-column (&optional spacer) - (when column-number-mode - (+modeline-spacer nil spacer - "|" - (if column-number-indicator-zero-based "%2c" "%2C")))) - -(defcustom +modeline-position-function nil - "Function to use instead of `+modeline-position' in modeline." - :type '(choice (const :tag "Default" nil) - function) - :local t) - -(defun +modeline-position (&optional spacer) - "Display the current cursor position. -See `line-number-mode', `column-number-mode', and -`file-percentage-mode'. If `+modeline-position-function' is set -to a function in the current buffer, call that function instead." - (cond ((functionp +modeline-position-function) - (when-let* ((str (funcall +modeline-position-function))) - (+modeline-spacer nil spacer str))) - (t (funcall (+modeline-concat '(+modeline-region - +modeline-line - +modeline-column - +modeline-file-percentage) - ""))))) - -(defun +modeline-vc (&optional spacer) - "Display the version control branch of the current buffer in the modeline." - ;; from https://www.gonsie.com/blorg/modeline.html, from Doom - (when-let ((backend (vc-backend buffer-file-name))) - (+modeline-spacer nil spacer - (substring vc-mode (+ (if (eq backend 'Hg) 2 3) 2))))) - -(defun +modeline-track (&optional spacer) - "Display `tracking-mode' information." - (when tracking-mode - tracking-mode-line-buffers)) - -(defun +modeline-anzu (&optional spacer) - "Display `anzu--update-mode-line'." - (+modeline-spacer nil spacer - (anzu--update-mode-line))) - -(defun +modeline-text-scale (&optional spacer) - "Display text scaling level." - ;; adapted from https://github.com/seagle0128/doom-modeline - (when (and (boundp 'text-scale-mode-amount) - (/= text-scale-mode-amount 0)) - (+modeline-spacer nil spacer - (concat (if (> text-scale-mode-amount 0) "+" "-") - (number-to-string text-scale-mode-amount))))) - -(defun +modeline-ace-window-display (&optional spacer) - "Display `ace-window-display-mode' information in the modeline." - (when (and +ace-window-display-mode - ace-window-mode) - (+modeline-spacer nil spacer - (window-parameter (selected-window) 'ace-window-path)))) - -(defun +modeline-god-mode (&optional spacer) - "Display an icon when `god-mode' is active." - (when (and (boundp 'god-local-mode) god-local-mode) - (+modeline-spacer nil spacer - (propertize "Ω" - 'help-echo (concat "God mode is active." - "\nmouse-1: exit God mode.") - 'local-map (purecopy - (simple-modeline-make-mouse-map - 'mouse-1 (lambda (e) - (interactive "e") - (with-selected-window - (posn-window - (event-start e)) - (god-local-mode -1) - (force-mode-line-update))))) - 'mouse-face 'mode-line-highlight)))) - -(defun +modeline-input-method (&optional spacer) - "Display which input method is active." - (when current-input-method - (+modeline-spacer nil spacer - (propertize current-input-method-title - 'help-echo (format - (concat "Current input method: %s\n" - "mouse-1: Describe current input method\n" - "mouse-3: Toggle input method") - current-input-method) - 'local-map (purecopy - (let ((map (make-sparse-keymap))) - (define-key map [mode-line mouse-1] - (lambda (e) - (interactive "e") - (with-selected-window (posn-window (event-start e)) - (describe-current-input-method)))) - (define-key map [mode-line mouse-3] - (lambda (e) - (interactive "e") - (with-selected-window (posn-window (event-start e)) - (toggle-input-method nil :interactive)))) - map)) - 'mouse-face 'mode-line-highlight)))) - -(defface +modeline-kmacro-indicator '((t :foreground "Firebrick")) - "Face for the kmacro indicator in the modeline.") - -(defun +modeline-kmacro-indicator (&optional spacer) - "Display an indicator when recording a kmacro." - (when defining-kbd-macro - (+modeline-spacer nil spacer - (propertize "●" - 'face '+modeline-kmacro-indicator - 'help-echo (format (concat "Defining a macro\n" - "Current step: %d\n" - "mouse-1: Stop recording") - kmacro-counter) - 'local-map (purecopy (simple-modeline-make-mouse-map - 'mouse-1 (lambda (e) - (interactive "e") - (with-selected-window - (posn-window (event-start e)) - (kmacro-end-macro nil))))) - 'mouse-face 'mode-line-highlight)))) - -(defface +nyan-mode-line nil - "Face for nyan-cat in mode line.") - -(defun +modeline-nyan-on-focused (&optional spacer) - "Display the cat from `nyan-mode', but only on the focused window." - (require 'nyan-mode) - (when (and (or nyan-mode (bound-and-true-p +nyan-local-mode)) - (actually-selected-window-p)) - (+modeline-spacer nil spacer - (propertize (nyan-create) 'face '+nyan-mode-line)))) - -(provide '+modeline) -;;; +modeline.el ends here diff --git a/lisp/+mwim.el b/lisp/+mwim.el deleted file mode 100644 index 97a2b04..0000000 --- a/lisp/+mwim.el +++ /dev/null @@ -1,42 +0,0 @@ -;;; +mwim.el --- Extras -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -(require 'seq) - -(defgroup +mwim nil - "Extra `mwim' customizations." - :group 'mwim) - -(defcustom +mwim-passthrough-modes nil - "Modes to not move-where-I-mean." - :type '(repeat function)) - -(defun +mwim-beginning-maybe (&optional arg) - "Perform `mwim-beginning', maybe. -Will just do \\[beginning-of-line] in one of -`+mwim-passthrough-modes'." - (interactive) - (if (apply #'derived-mode-p +mwim-passthrough-modes) - (let ((this-mode-map (symbol-value (intern (format "%s-map" major-mode)))) - (key "C-a")) - (call-interactively (or (keymap-lookup this-mode-map key t t) - (keymap-lookup (current-global-map) key t t)))) - (call-interactively #'mwim-beginning))) - -(defun +mwim-end-maybe (&optional arg) - "Perform `mwim-beginning', maybe. -Will just do \\[end-of-line] in one of -`+mwim-passthrough-modes'." - (interactive) - (if (apply #'derived-mode-p +mwim-passthrough-modes) - (let ((this-mode-map (symbol-value (intern (format "%s-map" major-mode)))) - (key "C-e")) - (call-interactively (or (keymap-lookup this-mode-map key t t) - (keymap-lookup (current-global-map) key t t)))) - (call-interactively #'mwim-end))) - -(provide '+mwim) -;;; +mwim.el ends here diff --git a/lisp/+notmuch.el b/lisp/+notmuch.el deleted file mode 100644 index 9e79c5a..0000000 --- a/lisp/+notmuch.el +++ /dev/null @@ -1,97 +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 -(el-patch-feature notmuch) -(with-eval-after-load '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))) - -(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))) - -(provide '+notmuch) -;;; +notmuch.el ends here diff --git a/lisp/+nyan-mode.el b/lisp/+nyan-mode.el deleted file mode 100644 index 33ae9af..0000000 --- a/lisp/+nyan-mode.el +++ /dev/null @@ -1,42 +0,0 @@ -;;; +nyan-mode.el --- Extras for nyan-mode -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -;;; Update even without line number in the mode line. - -(defcustom +nyan-mode-update-functions - '( end-of-buffer beginning-of-buffer - next-line previous-line - org-next-visible-heading org-previous-visible-heading) - "Functions after which to force a mode-line update." - :type '(repeat function)) - -(defun +nyan-mode--fmlu (&rest _) - "Update the mode-line, advice-style." - (force-mode-line-update)) - -(defun +nyan-mode-advice (&rest _) - "Advise line-moving functions when in `nyan-mode'." - (dolist (fn +nyan-mode-update-functions) - (if nyan-mode - (advice-add fn :after #'+nyan-mode--fmlu) - (advice-remove fn #'+nyan-mode--fmlu)))) - -(defface +nyan-mode-line nil - "Face for the nyan-mode mode-line indicator.") - -(define-minor-mode +nyan-local-mode - "My very own `nyan-mode' that isn't global and doesn't update the mode-line." - :global nil - :group 'nyan - (dolist (fn +nyan-mode-update-functions) - (if +nyan-local-mode - (advice-add fn :after #'+nyan-mode--fmlu) - (advice-remove fn #'+nyan-mode--fmlu)))) - -(define-globalized-minor-mode +nyan-mode +nyan-local-mode +nyan-local-mode) - -(provide '+nyan-mode) -;;; +nyan-mode.el ends here diff --git a/lisp/+orderless.el b/lisp/+orderless.el deleted file mode 100644 index ac8c1b4..0000000 --- a/lisp/+orderless.el +++ /dev/null @@ -1,60 +0,0 @@ -;;; +orderless.el --- Mostly from minad -*- lexical-binding: t; -*- - -;;; Commentary: - -;; See https://github.com/minad/consult/wiki#minads-orderless-configuration - -;;; Code: - -(require 'orderless) - -;;; Dispataching - -(defvar +orderless-dispatch-alist '((?% . char-fold-to-regexp) - (?! . orderless-without-literal) - (?` . orderless-initialism) - (?= . orderless-literal) - (?~ . orderless-flex)) - "Charcters to dispatch styles on orderless segments.") - -(defun +orderless-dispatch (pattern index _total) - "Dispatch orderless segments of a search string. -Dispatchers are taken from `+orderless-dispatch-alist', and added -to the following defaults: - -- regexp$ :: matches REGEXP at the end of the pattern. -- .ext :: matches EXT (at end of pattern) - -Dispatch characters can be added at the beginning or ending of a -segment to make that segment match accordingly." - (cond - ;; Ensure that $ works with Consult commands, which add disambiguation - ;; suffixes - ((string-suffix-p "$" pattern) - (cons 'orderless-regexp - (concat (substring pattern 0 -1) "[\x100000-\x10FFFD]*$"))) - ;; File extensions - ((and - ;; Completing filename or eshell - (or minibuffer-completing-file-name - (derived-mode-p 'eshell-mode)) - ;; File extension - (string-match-p "\\`\\.." pattern)) - (cons 'orderless-regexp - (concat "\\." (substring pattern 1) "[\x100000-\x10FFFD]*$"))) - ;; Ignore single ! - ((string= "!" pattern) `(orderless-literal . "")) - ;; Prefix and suffix - ((if-let (x (assq (aref pattern 0) +orderless-dispatch-alist)) - (cons (cdr x) (substring pattern 1)) - (when-let (x (assq (aref pattern (1- (length pattern))) - +orderless-dispatch-alist)) - (cons (cdr x) (substring pattern 0 -1))))))) - -(orderless-define-completion-style +orderless-with-initialism - (orderless-matching-styles '(orderless-initialism - orderless-literal - orderless-regexp))) - -(provide '+orderless) -;;; +orderless.el ends here diff --git a/lisp/+org-attach.el b/lisp/+org-attach.el deleted file mode 100644 index 5e7cc7f..0000000 --- a/lisp/+org-attach.el +++ /dev/null @@ -1,29 +0,0 @@ -;;; +org-attach.el --- Fixes for org-attach -*- lexical-binding: t; -*- - -;;; Commentary: - -;; `org-attach-attach' doesn't fix the path name. Before I submit a bug, I'm -;; just fixing it by advising `org-attach-attach'. - -;;; Code: - -(defun +org-attach-attach-fix-args (args) - "ADVICE for `org-attach-attach' to normalize FILE first. -VISIT-DIR and METHOD are passed through unchanged. - -This should be applied as `:filter-args' advice." - (cons (expand-file-name (car args)) (cdr args))) - -(define-minor-mode +org-attach-fix-args-mode - "Fix the arguments passed to `org-attach-attach'. -This mode normalizes the filename passed to `org-attach-attach' -so that links can be properly made." - :lighter "" - :keymap nil - :global t ; I figure, what does this hurt? - (if +org-attach-fix-args-mode - (advice-add 'org-attach-attach :filter-args #'+org-attach-attach-fix-args) - (advice-remove 'org-attach-attach #'+org-attach-attach-fix-args))) - -(provide '+org-attach) -;;; +org-attach.el ends here diff --git a/lisp/+org-capture.el b/lisp/+org-capture.el deleted file mode 100644 index 7ed4e00..0000000 --- a/lisp/+org-capture.el +++ /dev/null @@ -1,164 +0,0 @@ -;;; +org-capture.el -*- lexical-binding: t; -*- - -;;; Code: - -(require 'cl-lib) -(require 'acdw) -;; We don't require `org-capture' here because I'll have to require this library -;; to init.el /before/ org-capture is fully needed. But I do need to declare -;; `org-capture-templates'. -(defvar org-capture-templates nil) - -(defun +org-capture--get (key &optional list) - "Find KEY in LIST, or return nil. -LIST defaults to `org-capture-templates'." - (alist-get key (or list org-capture-templates) nil nil #'equal)) - -;; Set it up as a generic value. Based on the one for `alist-get'. -(gv-define-expander +org-capture--get - (lambda (do key &optional alist) - (setq alist (or alist org-capture-templates)) - (macroexp-let2 macroexp-copyable-p k key - (gv-letplace (getter setter) alist - (macroexp-let2 nil p `(assoc ,k ,getter 'equal) - (funcall do `(cdr ,p) - (lambda (v) - (macroexp-let2 nil v v - (let ((set-exp - `(if ,p (setcdr ,p ,v) - ,(funcall setter - `(cons (setq ,p (cons ,k ,v)) - ,getter))))) - `(progn - ,set-exp - ,v)))))))))) - -(defun +org-capture-sort (&optional list) - "Sort LIST by string keys. -LIST is a symbol and defaults to `org-capture-templates'." - (setq list (or list 'org-capture-templates)) - (set list (sort (symbol-value list) (lambda (a b) - (string< (car a) (car b)))))) - -(defun +org-capture-sort-after-init (&optional list) - "Sort LIST with `+org-capture-sort' after Emacs init." - (+ensure-after-init #'+org-capture-sort)) - -;;;###autoload -(defun +org-capture-templates-setf (key value &optional list sort-after) - "Add KEY to LIST, using `setf'. -LIST is a symbol and defaults to `org-capture-templates' -- so -this function sets values on a list that's structured as such. - -Thus, KEY is a string key. If it's longer than one character, -this function will search LIST for each successive run of -characters before the final, ensuring sub-lists exist of the -form (CHARS DESCRIPTION). - -For example, if KEY is \"abc\", first a LIST item of the form (a -DESCRIPTION), if non-existant, will be added to the list (with a -default description), then an item of the -form (\"ab\" DESCRIPTION), before adding (KEY VALUE) to the LIST. - -VALUE is the template or group header required for -`org-capture-templates', which see. - -SORT-AFTER, when set to t, will call -`+org-capture-templates-sort' after setting, to ensure org can -properly process the variable." - ;; LIST defaults to `org-capture-templates' - (declare (indent 2)) - (unless list (setq list 'org-capture-templates)) - ;; Ensure VALUE is a list to cons properly - (unless (listp value) (setq value (list value))) - (when (> (length key) 1) - ;; Check for existence of groups. - (let ((expected (cl-loop for i from 1 to (1- (length key)) - collect (substring key 0 i) into keys - finally return keys))) - (cl-loop for ek in expected - if (not (+org-capture--get ek (symbol-value list))) do - (setf (+org-capture--get ek (symbol-value list)) - (list (format "(Group %s)" ek)))))) - (prog1 ;; Set KEY to VALUE - (setf (+org-capture--get key (symbol-value list)) value) - ;; Sort after, maybe - (when sort-after (+org-capture-sort list)))) - -(defun +org-template--ensure-path (keys &optional list) - "Ensure path of keys exists in `org-capture-templates'." - (unless list (setq list 'org-capture-templates)) - (when (> (length key) 1) - ;; Check for existence of groups. - (let ((expected (cl-loop for i from 1 to (1- (length key)) - collect (substring key 0 i) into keys - finally return keys))) - (cl-loop for ek in expected - if (not (+org-capture--get ek (symbol-value list))) do - (setf (+org-capture--get ek (symbol-value list)) - (list (format "(Group %s)" ek))))))) - -(defcustom +org-capture-default-type 'entry - "Default template for `org-capture-templates'." - :type '(choice (const :tag "Entry" entry) - (const :tag "Item" item) - (const :tag "Check Item" checkitem) - (const :tag "Table Line" table-line) - (const :tag "Plain Text" plain))) - -(defcustom +org-capture-default-target "" - "Default target for `org-capture-templates'." - ;; TODO: type - ) - -(defcustom +org-capture-default-template nil - "Default template for `org-capture-templates'." - ;; TODO: type - ) - -(defun +org-define-capture-templates-group (keys description) - "Add a group title to `org-capture-templates'." - (setf (+org-capture--get keys org-capture-templates) - (list description))) - -;; [[https://github.com/cadadr/configuration/blob/39813a771286e542af3aa333172858532c3bb257/emacs.d/gk/gk-org.el#L1573][from cadadr]] -(defun +org-define-capture-template (keys description &rest args) - "Define a capture template and necessary antecedents. -ARGS is a plist, which in addition to the additional options -`org-capture-templates' accepts, takes the following and places -them accordingly: :type, :target, and :template. Each of these -corresponds to the same field in `org-capture-templates's -docstring, which see. Likewise with KEYS and DESCRIPTION, which -are passed separately to the function. - -This function will also create all the necessary intermediate -capture keys needed for `org-capture'; that is, if KEYS is -\"wcp\", entries for \"w\" and \"wc\" will both be ensured in -`org-capture-templates'." - (declare (indent 2)) - ;; Check for existence of parent groups - (when (> (length keys) 1) - (let ((expected (cl-loop for i from 1 to (1- (length keys)) - collect (substring 0 i) into keys - finally return keys))) - (cl-loop - for ek in expected - if (not (+org-capture--get ek org-capture-templates)) - do (+org-define-capture-templates-group ek (format "(Group %s)" ek))))) - (if (null args) - ;; Add the title - (+org-define-capture-templates-group keys description) - ;; Add the capture template. - (setf (+org-capture--get keys org-capture-templates) - (append (list (or (plist-get args :type) - +org-capture-default-type) - (or ( plist-get args :target) - +org-capture-default-target) - (or (plist-get args :template) - +org-capture-default-template)) - (cl-loop for (key val) on args by #'cddr - unless (member key '(:type :target :template)) - append (list key val)))))) - -(provide '+org-capture) -;;; +org-capture.el ends here diff --git a/lisp/+org-drawer-list.el b/lisp/+org-drawer-list.el deleted file mode 100644 index 5066d4d..0000000 --- a/lisp/+org-drawer-list.el +++ /dev/null @@ -1,47 +0,0 @@ -;;; +org-drawer-list.el --- Add stuff to org drawers easy-style -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -(require 'org) -(require '+org) -(require 'ol) -(require 'org-drawer-list) - -(defcustom +org-drawer-list-resources-drawer "RESOURCES" - "Where to add links with `+org-drawer-list-add-resource'.") - -(defun +org-drawer-list-add-resource (url &optional title) - "Add URL to the resource drawer of the current tree. -The resource drawer is given by the variable -`+org-drawer-list-resources-drawer'. If optional TITLE is given, -format the list item as an Org link." - (interactive - (let* ((clipboard-url (if (string-match-p (rx (sequence bos - (or "http" - "gemini" - "gopher" - "tel" - "mailto"))) - (current-kill 0)) - (string-trim (current-kill 0)) - (read-string "Resource URL: "))) - (url-title (let ((clipboard-headings - (+org-insert--get-title-and-headings clipboard-url))) - (read-string "title (edit): " - (completing-read - "title: " clipboard-headings - nil nil nil nil (car clipboard-headings)))))) - (list clipboard-url url-title))) - (let (current-visible-mode visible-mode) - ;; XXX: This is not the "proper" way to fix the issue I was having --- I've - ;; isolated the bug to somewhere in `org-insert-item', but this fix works - ;; well enough™ for now. - (visible-mode +1) - (org-drawer-list-add +org-drawer-list-resources-drawer - (org-link-make-string url title)) - (visible-mode (if current-visible-mode +1 -1)))) - -(provide '+org-drawer-list) -;;; +org-drawer-list.el ends here diff --git a/lisp/+org-wc.el b/lisp/+org-wc.el deleted file mode 100644 index 89b2708..0000000 --- a/lisp/+org-wc.el +++ /dev/null @@ -1,112 +0,0 @@ -;;; +org-wc.el --- org-wc in the modeline -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -(require 'org-wc) -(require '+modeline) -(require 'cl-lib) - -(defgroup +org-wc nil - "Extra fast word-counting in `org-mode'" - :group 'org-wc - :group 'org) - -(defvar-local +org-wc-word-count nil - "Running total of words in this buffer.") - -(defcustom +org-wc-update-after-funcs '(org-narrow-to-subtree - org-narrow-to-block - org-narrow-to-element - org-capture-narrow) - "Functions after which to update the word count." - :type '(repeat function)) - -(defcustom +org-wc-deletion-idle-timer 0.25 - "Length of time, in seconds, to wait before updating word-count." - :type 'number) - -(defcustom +org-wc-huge-change 5000 - "Number of characters that constitute a \"huge\" insertion." - :type 'number) - -(defcustom +org-wc-huge-buffer 10000 - "Number of words past which we're not going to try to count." - :type 'number) - -(defvar +org-wc-correction -5 - "Number to add to `+org-wc-word-count', for some reason? -`+org-wc-word-count' seems to consistently be off by 5. Thus -this correction. (At some point I should correct the underlying -code... probably).") - -(defvar-local +org-wc-update-timer nil) - -(defun +org-wc-delayed-update (&rest _) - (if +org-wc-update-timer - (setq +org-wc-update-timer nil) - (setq +org-wc-update-timer - (run-with-idle-timer +org-wc-deletion-idle-timer nil #'+org-wc-update)))) - -(defun +org-wc-force-update () - (interactive) - (message "Counting words...") - (when (timerp +org-wc-update-timer) - (cancel-timer +org-wc-update-timer)) - (+org-wc-update) - (message "Counting words...done")) - -(defun +org-wc-update (&rest _) ; Needs variadic parameters, since it's advice - (dlet ((+org-wc-counting t)) - (+org-wc-buffer) - (force-mode-line-update) - (setq +org-wc-update-timer nil))) - -(defun +org-wc-changed (start end length) - (+org-wc-delayed-update)) - -(defun +org-wc-buffer () - "Count the words in the buffer." - (when (and (derived-mode-p 'org-mode) - (not (eq +org-wc-word-count 'huge))) - (setq +org-wc-word-count - (cond - ((> (count-words (point-min) (point-max)) - +org-wc-huge-buffer) - 'huge) - (t (org-word-count-aux (point-min) (point-max))))))) - -(defvar +org-wc-counting nil - "Are we currently counting?") - -(defun +org-wc-recount-widen (&rest _) - (when (and (not +org-wc-counting)) - (+org-wc-update))) - -(defun +org-wc-modeline () - (cond - ((eq +org-wc-word-count 'huge) "huge") - (+org-wc-word-count (format "%sw" (max 0 (+ +org-wc-word-count +org-wc-correction)))))) - -(define-minor-mode +org-wc-mode - "Count words in `org-mode' buffers in the mode-line." - :lighter "" - :keymap (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-c C-.") #'+org-wc-force-update) - map) - (if +org-wc-mode - (progn ; turn on - (+org-wc-buffer) - (add-hook 'after-change-functions #'+org-wc-delayed-update nil t) - (setq-local +modeline-position-function #'+org-wc-modeline) - (dolist (fn +org-wc-update-after-funcs) - (advice-add fn :after #'+org-wc-update))) - (progn ; turn off - (remove-hook 'after-change-functions #'+org-wc-delayed-update t) - (kill-local-variable '+modeline-position-function) - (dolist (fn +org-wc-update-after-funcs) - (advice-remove fn #'+org-wc-update))))) - -(provide '+org-wc) -;;; +org-wc.el ends here diff --git a/lisp/+org.el b/lisp/+org.el deleted file mode 100644 index dc0ce1b..0000000 --- a/lisp/+org.el +++ /dev/null @@ -1,816 +0,0 @@ -;;; +org.el -*- lexical-binding: t; -*- - -;;; Code: - -(require 'el-patch) -(require 'org) -(require 'org-element) -(require 'ox) - -;;; org-return-dwim - [[https://github.com/alphapapa/unpackaged.el][unpackaged]] and [[http://kitchingroup.cheme.cmu.edu/blog/2017/04/09/A-better-return-in-org-mode/][kitchin]] - -(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'. - -On headings, move point to position after entry content. In -lists, insert a new item or end the list, with checkbox if -appropriate. In tables, insert a new row or end the table." - (interactive "P") - ;; Auto-fill if enabled - (when auto-fill-function - (if (listp auto-fill-function) - (dolist (func auto-fill-function) - (funcall func)) - (funcall auto-fill-function))) - (if prefix - ;; Handle prefix args - (pcase prefix - ('(4) (newline)) - ('(16) (newline 2)) - ;; this is ... not ideal. but whatever. - (_ (newline prefix))) - (cond - ;; Act depending on context around point. - ((and org-return-follows-link - (eq 'link (car (org-element-context)))) - ;; Link: Open it. - (org-open-at-point-global)) - - ((org-at-heading-p) - ;; Heading: Move to position after entry content. - ;; NOTE: This is probably the most interesting feature of this function. - (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; add newline after - (end-of-line) - (insert "\n\n")) - (t - ;; Entry ends after its heading; back up - (forward-line -1) - (end-of-line) - (when (org-at-heading-p) - ;; At the same heading - (forward-line) - (insert "\n") - (forward-line -1)) - (while (not - (looking-back - (rx (repeat 3 (seq (optional blank) "\n"))) - nil)) - (insert "\n")) - (forward-line -1))))) - - ((org-at-item-checkbox-p) - ;; Checkbox: Insert new item with checkbox. - (org-insert-todo-heading nil)) - - ((org-in-item-p) - ;; Plain list - (let* ((context (org-element-context)) - (first-item-p (eq 'plain-list (car context))) - (itemp (eq 'item (car context))) - (emptyp (or - ;; Empty list item (regular) - (eq (org-element-property :contents-begin context) - (org-element-property :contents-end context)) - ;; Empty list item (definition) - ;; This seems to work, with minimal testing. -- 2022-02-17 - (looking-at " *::"))) - (item-child-p - (+org-element-descendant-of 'item context))) - ;; The original function from unpackaged just tested the (or ...) test - ;; in this cond, in an if. However, that doesn't auto-end nested - ;; lists. So I made this form a cond and added the (and...) test in - ;; the first position, which is clunky (the delete-region... stuff - ;; comes twice) and might not be needed. More testing, obviously, but - ;; for now, it works well enough. - (cond ((and itemp emptyp) - (delete-region (line-beginning-position) (line-end-position)) - (insert "\n")) - ((or first-item-p - (and itemp (not emptyp)) - item-child-p) - (org-insert-item)) - (t (delete-region (line-beginning-position) (line-end-position)) - (insert "\n"))))) - - ((when (fboundp 'org-inlinetask-in-task-p) - (org-inlinetask-in-task-p)) - ;; Inline task: Don't insert a new heading. - (org-return)) - - ((org-at-table-p) - (cond ((save-excursion - (beginning-of-line) - ;; See `org-table-next-field'. - (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: call `org-return'. - (org-return)))) - (t - ;; All other cases: call `org-return'. - (org-return))))) - -(defun +org-table-copy-down (n) - "Call `org-table-copy-down', or `org-return' outside of a table. -N is passed to the functions." - (interactive "p") - (if (org-table-check-inside-data-field 'noerror) - (org-table-copy-down n) - (+org-return-dwim n))) - -;;; org-fix-blank-lines - unpackaged.el - -(defun +org-fix-blank-lines (&optional prefix) - "Ensure blank lines around headings. -Optional PREFIX argument operates on the entire buffer. -Drawers are included with their headings." - (interactive "P") - (let ((org-element-use-cache nil)) - (org-map-entries (lambda () - (let ((beg (org-entry-beginning-position)) - (end (org-entry-end-position))) - (org-with-wide-buffer - ;; `org-map-entries' narrows the buffer, which - ;; prevents us from seeing newlines before the - ;; current heading, so we do this part widened. - (while (not (looking-back "\n\n" nil)) - ;; Insert blank lines before heading. - (insert "\n"))) - - ;; Insert blank lines before entry content - (forward-line) - (while (and (org-at-planning-p) - (< (point) (point-max))) - ;; Skip planning lines - (forward-line)) - (while (re-search-forward - org-drawer-regexp end t) - ;; Skip drawers. You might think that - ;; `org-at-drawer-p' would suffice, but for - ;; some reason it doesn't work correctly when - ;; operating on hidden text. This works, taken - ;; from `org-agenda-get-some-entry-text'. - (re-search-forward "^[ \t]*:END:.*\n?" end t) - (goto-char (match-end 0))) - (unless (or (= (point) (point-max)) - (org-at-heading-p) - (looking-at-p "\n")) - (insert "\n")))) - t - (if prefix - nil - 'tree)))) - -;;; org-count-words - -(defun +org-count-words-stupidly (start end &optional limit) - "Count words between START and END, ignoring a lot. - -Since this function is, for some reason, pricy, the optional -parameter LIMIT sets a word limit at which to stop counting. -Once the function hits that number, it'll return -LIMIT -instead of the true count." - (interactive (list nil nil)) - (cond ((not (called-interactively-p 'any)) - (let ((words 0) - (continue t)) - (save-excursion - (save-restriction - (narrow-to-region start end) - (goto-char (point-min)) - (while (and continue - (< (point) (point-max))) - (cond - ;; Ignore comments - ((or (org-at-comment-p) - (org-in-commented-heading-p)) - (forward-line)) - ;; Ignore headings - ((or (org-at-heading-p)) - (forward-line)) - ;; Ignore property and log drawers - ((or (looking-at org-drawer-regexp) - (looking-at org-clock-drawer-re)) - (search-forward ":END:" nil :noerror) - (forward-line)) - ;; Ignore DEADLINE and SCHEDULED keywords - ((or (looking-at org-deadline-regexp) - (looking-at org-scheduled-regexp) - (looking-at org-closed-time-regexp)) - (forward-line)) - ;; Ignore tables - ((org-at-table-p) (forward-line)) - ;; Ignore hyperlinks, but count the descriptions - ((looking-at org-link-bracket-re) - (when-let ((desc (match-string-no-properties 5))) - (save-match-data - (setq words (+ words - (length (remove "" - (org-split-string - desc "\\W"))))))) - (goto-char (match-end 0))) - ;; Ignore source blocks - ((org-in-src-block-p) (forward-line)) - ;; Ignore blank lines - ((looking-at "^$") - (forward-line)) - ;; Count everything else - (t - ;; ... unless it's in a few weird contexts - (let ((contexts (org-context))) - (cond ((or (assoc :todo-keyword contexts) - (assoc :priority contexts) - (assoc :keyword contexts) - (assoc :checkbox contexts)) - (forward-word-strictly)) - - (t (setq words (1+ words)) - (if (and limit - (> words limit)) - (setq words (- limit) - continue nil)) - (forward-word-strictly))))))))) - words)) - ((use-region-p) - (message "%d words in region" - (+org-count-words-stupidly (region-beginning) - (region-end)))) - (t - (message "%d words in buffer" - (+org-count-words-stupidly (point-min) - (point-max)))))) - -;;; org-insert-link-dwim - https://xenodium.com/emacs-dwim-do-what-i-mean/ - -(defun +org-insert--get-title-and-headings (url) - "Retrieve title and headings from URL. -Return as a list." - (with-current-buffer (url-retrieve-synchronously url) - (let ((dom (libxml-parse-html-region (point-min) (point-max)))) - (cl-remove-if - (lambda (i) (string= i "")) - (apply #'append (mapcar (lambda (tag) - (mapcar #'dom-text - (dom-by-tag dom tag))) - '(title h1 h2 h3 h4 h5 h6))))))) - -(defun +org-insert-link-dwim (&optional interactivep) - "Like `org-insert-link' but with personal dwim preferences." - (interactive '(t)) - (let* ((point-in-link (org-in-regexp org-link-any-re 1)) - (clipboard-url (when (string-match-p - (rx (sequence bos - (or "http" - "gemini" - "gopher" - "tel" - "mailto"))) - (current-kill 0)) - (current-kill 0))) - (region-content (when (region-active-p) - (buffer-substring-no-properties (region-beginning) - (region-end)))) - (org-link (when (and clipboard-url (not point-in-link)) - (org-link-make-string - (string-trim clipboard-url) - (or region-content - (let ((clipboard-headings - (+org-insert--get-title-and-headings clipboard-url))) - (read-string "title (edit): " - (completing-read - "title: " clipboard-headings - nil nil nil nil (car clipboard-headings))))))))) - (if interactivep - (cond ((and region-content clipboard-url (not point-in-link)) - (delete-region (region-beginning) (region-end)) - (insert org-link)) - ((and clipboard-url (not point-in-link)) - (insert org-link)) - (t - (call-interactively 'org-insert-link))) - org-link))) - -;;; Navigate headings with widening - -(defun +org-next-heading-widen (arg) - "Find the ARGth next org heading, widening if necessary." - (interactive "p") - (let ((current-point (point)) - (point-target (if (> arg 0) (point-max) (point-min)))) - (org-next-visible-heading arg) - (when (and (buffer-narrowed-p) - (= (point) point-target) - (or (and (> arg 0)) - (and (< arg 0) - (= (point) current-point)))) - (widen) - (org-next-visible-heading arg)))) - -(defun +org-previous-heading-widen (arg) - "Find the ARGth previous org heading, widening if necessary." - (interactive "p") - (+org-next-heading-widen (- arg))) - -;;; Hooks & Advice - -(defvar +org-before-save-prettify-buffer t - "Prettify org buffers before saving.") - -(put '+org-before-save-prettify-buffer 'safe-local-variable #'booleanp) - -(defun +org-before-save@prettify-buffer () - (when +org-before-save-prettify-buffer - (save-mark-and-excursion - (+org-unsmartify) - (+org-fix-blank-lines t) - (org-align-tags t) - (org-hide-drawer-all) - (when (buffer-narrowed-p) - (goto-char (point-min)) - (forward-line 1) - (org-narrow-to-subtree))))) - -(defun +org-delete-backward-char (N) - "Keep tables aligned while deleting N characters backward. -When deleting backwards, in tables this function will insert -whitespace in front of the next \"|\" separator, to keep the -table aligned. The table will still be marked for re-alignment -if the field did fill the entire column, because, in this case -the deletion might narrow the column." - (interactive "p") - (save-match-data - (org-check-before-invisible-edit 'delete-backward) - (if (and (= N 1) - (not overwrite-mode) - (not (org-region-active-p)) - (not (eq (char-before) ?|)) - (save-excursion (skip-chars-backward " \t") (not (bolp))) - (looking-at-p ".*?|") - (org-at-table-p)) - (progn (forward-char -1) (org-delete-char 1)) - (backward-delete-char-untabify N) - (org-fix-tags-on-the-fly)))) - -;;; Smarter {super,sub}scripts -;; https://old.reddit.com/r/emacs/comments/qzlzm0/what_are_your_top_key_bindings_rebindings_minor/hmwyhm3/ -;; I don't use this currently because I found out about -;; `org-pretty-entities-include-sub-superscripts', which really does exactly -;; what I wanted. - -(defface +org-script-markers '((t (:inherit shadow))) - "Face to be used for sub/superscripts markers i.e., ^, _, {, }.") - -;; Hiding the super and subscript markers is extremely annoying -;; since any remotely complex equation becomes a chore. And leaving -;; it not raised is jarring to the eye. So this fontifies the -;; buffer just like how auctex does -- use a muted colour to -;; highlight the markup and raise the script. -(defun +org-raise-scripts (limit) - "Differences from `org-raise-scripts' are: - -- It doesn't actually hide the markup used for super and subscript. -- It uses a custom face to highlight the markup: +org-script-markers. -- It doesn't require `org-pretty-entities' to be t." - (when (and org-pretty-entities-include-sub-superscripts - (re-search-forward - (if (eq org-use-sub-superscripts t) - org-match-substring-regexp - org-match-substring-with-braces-regexp) - limit t)) - (let* ((pos (point)) table-p comment-p - (mpos (match-beginning 3)) - (emph-p (get-text-property mpos 'org-emphasis)) - (link-p (get-text-property mpos 'mouse-face)) - (keyw-p (eq 'org-special-keyword (get-text-property mpos 'face)))) - (goto-char (point-at-bol)) - (setq table-p (looking-at-p org-table-dataline-regexp) - comment-p (looking-at-p "^[ \t]*#[ +]")) - (goto-char pos) - ;; Handle a_b^c - (when (member (char-after) '(?_ ?^)) (goto-char (1- pos))) - (unless (or comment-p emph-p link-p keyw-p) - (put-text-property (match-beginning 3) (match-end 0) - 'display - (if (equal (char-after (match-beginning 2)) ?^) - ;; (nth (if table-p 3 1) org-script-display) - (nth 3 org-script-display) - ;; (nth (if table-p 2 0) org-script-display) - (nth 2 org-script-display))) - (put-text-property (match-beginning 2) (match-end 2) - 'face '+org-script-markers) - (when (and (eq (char-after (match-beginning 3)) ?{) - (eq (char-before (match-end 3)) ?})) - (put-text-property (match-beginning 3) (1+ (match-beginning 3)) - 'face '+org-script-markers) - (put-text-property (1- (match-end 3)) (match-end 3) - 'face '+org-script-markers))) - t))) - -;; Extra link types - -(defun +org-tel-open (number _) - "Notify the user of what phone NUMBER to call." - (message "Call: %s" number)) - -(defun +org-sms-open (number _) - "Notify the user of what phone NUMBER to text." - (message "SMS: %s" number)) - -;; Make a horizontal rule! - -(defun +org-horizontal-rule () - "Make a horizontal rule after the current line." - (interactive nil org-mode) - (unless (eq (line-beginning-position) (line-end-position)) - (end-of-line) - (newline)) - (dotimes (_ fill-column) - (insert "-"))) - -;; Follow links, DWIM style - -(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))))) - -;;; Open local HTML files with `browse-url' - -(defun +org-open-html (file-path link-string) - "Open FILE-PATH with `browse-url'. -This function is intended to use with `org-file-apps'. See the - documentation of that function for a description of the two - arguments here, FILE-PATH and LINK-STRING." - (message "Opening %s (%s)..." file-path link-string) - (browse-url file-path)) - -(defun +org-insert-horizontal-rule (prefix) - "Insert a horizontal rule (-----) after the current line. -With PREFIX, insert before the current line." - (interactive "P") - (if prefix - (move-beginning-of-line nil) - (move-end-of-line nil) - (forward-line 1)) - (insert "-----\n")) - -;;; Make code snippets in org-mode easier to type -;; http://mbork.pl/2022-01-17_Making_code_snippets_in_Org-mode_easier_to_type - -(defun +org-insert-backtick () - "Insert a backtick using `org-self-insert-command'." - (interactive) - (setq last-command-event ?`) - (call-interactively #'org-self-insert-command)) - -(defvar-local +org-insert-tilde-language nil - "Default language name in the current Org file. -If nil, `org-insert-tilde' after 2 tildes inserts an \"example\" -block. If a string, it inserts a \"src\" block with the given -language name.") - -(defun +org-insert-tilde () - "Insert a tilde using `org-self-insert-command'." - (interactive) - (if (string= (buffer-substring-no-properties (- (point) 3) (point)) - "\n~~") - (progn (delete-char -2) - (if +org-insert-tilde-language - (insert (format "#+begin_src %s\n#+end_src" - +org-insert-tilde-language)) - (insert "#+begin_example\n#+end_example")) - (forward-line -1) - (if (string= +org-insert-tilde-language "") - (move-end-of-line nil) - ;;(org-edit-special) ; Useful really only with splits. - )) - (setq last-command-event ?~) - (call-interactively #'org-self-insert-command))) - -;;; Better org 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.") - -;; `org-verbatim' and `org-code' are apparently already things, so we skip them -;; here. - -;;; Copy org trees as HTML - -;; Thanks to Oleh Krehel, via [[https://emacs.stackexchange.com/questions/54292/copy-results-of-org-export-directly-to-clipboard][this StackExchange question]]. -(defun +org-export-clip-to-html - (&optional async subtreep visible-only body-only ext-plist post-process) - "Export region to HTML, and copy it to the clipboard. -Arguments ASYNC, SUBTREEP, VISIBLE-ONLY, BODY-ONLY, EXT-PLIST, -and POST-PROCESS are passed to `org-export-to-file'." - (interactive) ; XXX: hould this be interactive? - (message "Exporting Org to HTML...") - (let ((org-tmp-file "/tmp/org.html")) - (org-export-to-file 'html org-tmp-file - async subtreep visible-only body-only ext-plist post-process) - (start-process "xclip" "*xclip*" - "xclip" "-verbose" - "-i" org-tmp-file - "-t" "text/html" - "-selection" "clipboard")) - (message "Exporting Org to HTML...done.")) - -;; Specialized functions -(defun +org-export-clip-subtree-to-html () - "Export current subtree to HTML." - (interactive) - (+org-export-clip-to-html nil :subtree)) - -;;; Unsmartify quotes and dashes and stuff. -(defun +org-unsmartify () - "Replace \"smart\" punctuation with their \"dumb\" counterparts." - (interactive) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "[“”‘’–—]" nil t) - (let ((replace (pcase (match-string 0) - ((or "“" "”") "\"") - ((or "‘" "’") "'") - ("–" "--") - ("—" "---")))) - (replace-match replace nil nil))))) - -;;; go forward and backward in the tree, ~ cleanly ~ -;; https://stackoverflow.com/a/25201697/10756297 - -(defun +org-show-next-heading-tidily () - "Show next entry, keeping other entries closed." - (interactive) - (if (save-excursion (end-of-line) (outline-invisible-p)) - (progn (org-show-entry) (show-children)) - (outline-next-heading) - (unless (and (bolp) (org-on-heading-p)) - (org-up-heading-safe) - (hide-subtree) - (user-error "Boundary reached")) - (org-overview) - (org-reveal t) - (org-show-entry) - (recenter-top-bottom) - (show-children) - (recenter-top-bottom 1))) - -(defun +org-show-previous-heading-tidily () - "Show previous entry, keeping other entries closed." - (interactive) - (let ((pos (point))) - (outline-previous-heading) - (unless (and (< (point) pos) (bolp) (org-on-heading-p)) - (goto-char pos) - (hide-subtree) - (user-error "Boundary reached")) - (org-overview) - (org-reveal t) - (org-show-entry) - (recenter-top-bottom) - (show-children) - (recenter-top-bottom 1))) - -;;; Make `org-flag-region' (which folds subtrees) recognize -;; [[https://teddit.net/r/orgmode/comments/u3du0v/how_to_make_orgcycle_respect_and_always_show_the/][from u/yantar92]] - -;; (advice-add 'org-flag-region :around #'org-flag-region@unfold-page-breaks) -(defun org-flag-region@unfold-page-breaks (oldfun from to flag &optional spec) - "ADVICE to unfold all the page-break lines inside a folded region." - (funcall oldfun from to flag spec) - (when (and flag (not (eq 'visible spec))) - (org-with-point-at from - (while (re-search-forward "\n\u000c\n" to t) - (org-flag-region (match-beginning 0) (match-end 0) t 'visible))))) - -;;; Emacs 28+: wrap on hyphens -;; https://emacs.stackexchange.com/a/71342/37239 - -(defcustom +org-category-table (let ((table (copy-category-table))) - (modify-category-entry ?- ?| table) - table) - "Character category table for `org-mode'." - :type 'sexp) - -(defun +org-wrap-on-hyphens () - "Soft-wrap `org-mode' buffers on spaces and hyphens." - (set-category-table +org-category-table) - (setq-local word-wrap-by-category t)) - - -;;; Inhibit hooks on `org-agenda' -;; It's really annoying when I call `org-agenda' and five hundred Ispell -;; processes are created because I have `flyspell-mode' in the hook. This mode -;; inhibits those hooks when entering the agenda, but runs them when opening the -;; actual buffer. - -(defun +org-agenda-inhibit-hooks (fn &rest r) - "Advice to inhibit hooks when entering `org-agenda'." - (dlet ((org-mode-hook nil)) ; I'm not sure if `dlet' is strictly needed - (apply fn r))) - -(defvar-local +org-hook-has-run-p nil - "Whether `org-mode-hook' has run in the current buffer.") - -(defun +org-agenda-switch-run-hooks (&rest _) - "Advice to run `org-mode-hook' when entering org-mode. -This should only fire when switching to a buffer from `org-agenda'." - (unless +org-hook-has-run-p - (run-mode-hooks 'org-mode-hook) - (setq +org-hook-has-run-p t))) - -(define-minor-mode +org-agenda-inhibit-hooks-mode - "Inhibit `org-mode-hook' when opening `org-agenda'." - :lighter "" - :global t - (if +org-agenda-inhibit-hooks-mode - (progn ; Enable - (advice-add 'org-agenda :around #'+org-agenda-inhibit-hooks) - (advice-add 'org-agenda-switch-to :after #'+org-agenda-switch-run-hooks)) - (progn ; Disable - (advice-remove 'org-agenda #'+org-agenda-inhibit-hooks) - (advice-remove 'org-agenda-switch-to #'+org-agenda-switch-run-hooks)))) - - -;;; "Fix" `org-align-tags' - -(el-patch-defun org-align-tags (&optional all) - "Align tags in current entry. -When optional argument ALL is non-nil, align all tags in the -visible part of the buffer." - (let ((get-indent-column - (lambda () - (let ((offset (el-patch-swap - (if (bound-and-true-p org-indent-mode) - (* (1- org-indent-indentation-per-level) - (1- (org-current-level))) - 0) - 0))) - (+ org-tags-column - (if (> org-tags-column 0) (- offset) offset)))))) - (if (and (not all) (org-at-heading-p)) - (org--align-tags-here (funcall get-indent-column)) - (save-excursion - (if all - (progn - (goto-char (point-min)) - (while (re-search-forward org-tag-line-re nil t) - (org--align-tags-here (funcall get-indent-column)))) - (org-back-to-heading t) - (org--align-tags-here (funcall get-indent-column))))))) - -;;; Meta-return - -(defun +org-meta-return (&optional arg) - "Insert a new line, or wrap a region in a table. -See `org-meta-return', but `+org-return-dwim' does most of the -stuff I would want out of that function already. - -When called with a prefix ARG, will still unconditionally call -`org-insert-heading'." - (interactive "P") - (org-fold-check-before-invisible-edit 'insert) - (or (run-hook-with-args-until-success 'org-metareturn-hook) ; Allow customizations - (call-interactively (cond (arg #'org-insert-heading) - ((org-at-table-p) #'org-table-wrap-region) - (t #'org-return))))) - - -;;; move org archives to a dedicated file -;; (defun +org-archive-monthwise (archive-file) -;; (if (file-exists-p archive-file) -;; (with-current-buffer (find-file-noselect archive-file) -;; (let ((dir (file-name-directory (file-truename archive-file))) -;; (prog (make-progress-reporter (format "Archiving from %s..." archive-file))) -;; (keep-going t)) -;; (goto-char (point-min)) -;; (while keep-going -;; (when-let* ((time (or (org-entry-get (point) "ARCHIVE_TIME") -;; (org-get-deadline-time (point)))) -;; (parsed-time (and time -;; (org-parse-time-string time))) -;; (refile-target (format "%s%02d-%02d.org" -;; dir -;; (decoded-time-year parsed-time) -;; (decoded-time-month parsed-time))) -;; (title-str (format "#+title: Archive for %02d-%02d (%s)\n\n" -;; (decoded-time-year parsed-time) -;; (decoded-time-month parsed-time) -;; (file-truename archive-file)))) -;; (unless (file-exists-p refile-target) -;; (with-current-buffer (find-file-noselect refile-target) -;; (insert title-str) -;; (save-buffer))) -;; (org-refile nil nil (list "" -;; refile-target -;; nil -;; 0))) -;; (progress-reporter-update prog) -;; (org-next-visible-heading 1) -;; (when (>= (point) (point-max)) -;; (setq keep-going nil))))) -;; (message "Archive file %s does not exist!" archive-file))) - - -;;; +org-toggle-view-emphasis -;; I thought this function was already written somewhere... -(defun +org-toggle-view-emphasis () - "Toggle `org-hide-emphasis-markers' and redraw the buffer." - (interactive) - (setq-local org-hide-emphasis-markers (not org-hide-emphasis-markers)) - (font-lock-update)) - - -;;; el-patch - -(el-patch-defun org-format-outline-path (path &optional width prefix separator) - "Format the outline path PATH for display. -WIDTH is the maximum number of characters that is available. -PREFIX is a prefix to be included in the returned string, -such as the file name. -SEPARATOR is inserted between the different parts of the path, -the default is \"/\"." - (setq width (or width 79)) - (setq path (delq nil path)) - (unless (> width 0) - (user-error "Argument `width' must be positive")) - (setq separator (or separator "/")) - (let* ((org-odd-levels-only nil) - (fpath (concat - prefix (and prefix path separator) - (mapconcat - (lambda (s) (replace-regexp-in-string "[ \t]+\\'" "" s)) - (cl-loop for head in path - for n from 0 - collect (el-patch-swap - (org-add-props - head nil 'face - (nth (% n org-n-level-faces) org-level-faces)) - head)) - separator)))) - (when (> (length fpath) width) - (if (< width 7) - ;; It's unlikely that `width' will be this small, but don't - ;; waste characters by adding ".." if it is. - (setq fpath (substring fpath 0 width)) - (setf (substring fpath (- width 2)) ".."))) - fpath)) - - -(provide '+org) -;;; +org.el ends here diff --git a/lisp/+ox.el b/lisp/+ox.el deleted file mode 100644 index 8748a55..0000000 --- a/lisp/+ox.el +++ /dev/null @@ -1,29 +0,0 @@ -;;; +ox.el --- org-export helpers -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -(require 'ox) - -;;; Run hooks before doing any exporting at all - -(defcustom +org-export-pre-hook nil - "Functions to run /before/ `org-export-as' does anything. -These will run on the buffer about to be exported, NOT a copy." - :type 'hook) - -(defun +org-export-pre-run-hooks (&rest _) - "Run hooks in `+org-export-pre-hook'." - (run-hooks '+org-export-pre-hook)) - -(defun +org-export-pre-hooks-insinuate () - "Advise `org-export-as' to run `+org-export-pre-hook'." - (advice-add 'org-export-as :before #'+org-export-pre-run-hooks)) - -(defun +org-export-pre-hooks-remove () - "Remove pre-hook advice on `org-export-as'." - (advice-remove 'org-export-as #'+org-export-pre-run-hooks)) - -(provide '+ox) -;;; +ox.el ends here diff --git a/lisp/+paredit.el b/lisp/+paredit.el deleted file mode 100644 index 0c65328..0000000 --- a/lisp/+paredit.el +++ /dev/null @@ -1,26 +0,0 @@ -;;; +paredit.el --- bespoke paredit stuffs -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -(require '+emacs) ; `+backward-kill-word-wrapper' - -(defun +paredit--backward-kill-word (&optional n) - "Perform `paredit-backward-kill-word' N times." - (interactive "p") - (dotimes (_ (or n 1)) - (paredit-backward-kill-word))) - -(defun +paredit-backward-kill-word (&optional arg) - "Kill a word backward using `paredit-backward-kill-word'. -Wrapped in `+backward-kill-word-wrapper', which see. - -Prefix ARG means to just call `paredit-backward-kill-word'." - ;; Of course, `paredit-backward-kill-word' doesn't TAKE an argument ... :/// - ;; So I had to write the wrapper above. - (interactive) - (+backward-kill-word-wrapper #'+paredit--backward-kill-word arg)) - -(provide '+paredit) -;;; +paredit.el ends here diff --git a/lisp/+pdf-tools.el b/lisp/+pdf-tools.el deleted file mode 100644 index 9b15b27..0000000 --- a/lisp/+pdf-tools.el +++ /dev/null @@ -1,38 +0,0 @@ -;;; +pdf-tools.el --- Extras for the excellent pdf-tools' -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -;; XXX: The way I'm dispatching browsers here is /very/ down-and-dirty. It -;; needs to be much improved. - -(defun +pdf-view-open-all-pagelinks (&optional browse-url-func) - "Open all the links on this page of a PDF. -BROWSE-URL-FUNC overrides the default `browse-url'." - (interactive) - (let ((links (pdf-info-pagelinks (pdf-view-current-page))) - (browse-url-func (or browse-url-func #'browse-url)) - (seen)) - (dolist (link links) - (when-let* ((uri (alist-get 'uri link)) - (_ (not (member uri seen)))) - (push uri seen) - (funcall browse-url-func uri))))) - -(defun +pdf-view-open-links-in-chrome () - "Open all links on this PDF page in Chrome. -See also `+pdf-view-open-all-pagelinks'." - (interactive) - (+pdf-view-open-all-pagelinks #'browse-url-chrome)) - -(defun +pdf-view-position (&optional spacer) - "Return the page we're on for the modeline." - (when (derived-mode-p 'pdf-view-mode) - (format "%sp.%s/%s" - (or spacer (bound-and-true-p +modeline-default-spacer) " ") - (pdf-view-current-page) - (pdf-info-number-of-pages)))) - -(provide '+pdf-tools) -;;; +pdf-tools.el ends here diff --git a/lisp/+pulse.el b/lisp/+pulse.el deleted file mode 100644 index eefdd83..0000000 --- a/lisp/+pulse.el +++ /dev/null @@ -1,52 +0,0 @@ -;;; +pulse.el -*- lexical-binding: t; -*- - -;;; Code: - -(require 'pulse) - -(defgroup +pulse nil - "Extra customizations for `pulse'." - :group 'pulse - :prefix "+pulse-") - -(defcustom +pulse-location-commands '(scroll-up-command - scroll-down-command - recenter-top-bottom - other-window - switch-to-buffer - redraw-frame) - "Commands to pulse the current line after. -Good for finding location." - :type '(repeat function)) - -(defcustom +pulse-location-function '+pulse-line-current-window - "What function to call after `+pulse-location-commands'." - :type 'function) - -;; XXX: this doesn't work yet. I only want to pulse the line in the -;; active window, so when I have the same buffer viewed in multiple -;; windows I can still see where my cursor is. To see the issue, C-x -;; 2 then C-x o a few times. -(defun +pulse-line-current-window (&rest _) - "Pulse the current line, but only if this window is active." - (pulse-momentary-highlight-one-line - (window-point (selected-window)))) - -(defun +pulse--advice-remove (symbol where function &optional props) - "Remove advice SYMBOL from FUNCTION. -This uses the same args as `advice-add' for easy toggling. -WHERE and PROPS are discarded." - (ignore where props) - (advice-remove symbol function)) - -(define-minor-mode +pulse-location-mode - "After moving locations, pulse where we are." - :global t - :keymap nil - (dolist (command +pulse-location-commands) - (funcall - (if +pulse-location-mode 'advice-add '+pulse--advice-remove) - command :after +pulse-location-function))) - -(provide '+pulse) -;;; +pulse.el ends here diff --git a/lisp/+scratch.el b/lisp/+scratch.el deleted file mode 100644 index 7fc2bde..0000000 --- a/lisp/+scratch.el +++ /dev/null @@ -1,77 +0,0 @@ -;;; +scratch.el -*- lexical-binding: t; -*- - -;;; Code: - -;;(require 'scratch) - -(defun +scratch-immortal () - "Bury, don't kill \"*scratch*\" buffer. -For `kill-buffer-query-functions'." - (if (or (eq (current-buffer) (get-buffer "*scratch*")) - (eq (current-buffer) (get-buffer "*text*"))) - (progn (bury-buffer) - nil) - t)) - -(defun +scratch-buffer-setup () - "Add comment to `scratch' buffer and name it accordingly." - (let* ((mode (format "%s" major-mode)) - (string (concat "Scratch buffer for:" mode "\n\n"))) - (when scratch-buffer - (save-excursion - (insert string) - (goto-char (point-min)) - (comment-region (point-at-bol) (point-at-eol))) - (next-line 2)) - (rename-buffer (concat "*scratch<" mode ">*") t))) - -(defun +scratch-fortune () - (let* ((fmt (if (executable-find "fmt") - (format "| fmt -%d -s" (- fill-column 2)) - "")) - (s (string-trim - (if (executable-find "fortune") - (shell-command-to-string (concat "fortune -s" fmt)) - "ABANDON ALL HOPE YE WHO ENTER HERE")))) - (concat (replace-regexp-in-string "^" ";; " s) - "\n\n"))) - -;; [[https://old.reddit.com/r/emacs/comments/ui1q41/weekly_tips_tricks_c_thread/i7ef4xg/][u/bhrgunatha]] -(defun +scratch-text-scratch () - "Create a \"*text*\" scratch buffer in Text mode." - (with-current-buffer (get-buffer-create "*text*") - (text-mode))) - -(defcustom +scratch-buffers '("*text*" "*scratch*") - "Scratch buffers.") - -(defvar +scratch-last-non-scratch-buffer nil - "Last buffer that wasn't a scratch buffer.") - -(defun +scratch-toggle (buffer) - "Switch to BUFFER, or to the previous (non-scratch) buffer." - (if (or (null +scratch-last-non-scratch-buffer) - (not (member (buffer-name (current-buffer)) +scratch-buffers))) - ;; Switch to a scratch buffer - (progn - (setq +scratch-last-non-scratch-buffer (current-buffer)) - (switch-to-buffer buffer)) - ;; Switch away from scratch buffer ... - (if (equal (get-buffer-create buffer) (current-buffer)) - ;; to the original buffer - (switch-to-buffer +scratch-last-non-scratch-buffer) - ;; to another scratch - (switch-to-buffer buffer)))) - -(defun +scratch-switch-to-scratch () - "Switch to scratch buffer." - (interactive) - (+scratch-toggle "*scratch*")) - -(defun +scratch-switch-to-text () - "Switch to text buffer." - (interactive) - (+scratch-toggle "*text*")) - -(provide '+scratch) -;;; +scratch.el ends here diff --git a/lisp/+setup.el b/lisp/+setup.el deleted file mode 100644 index a08526a..0000000 --- a/lisp/+setup.el +++ /dev/null @@ -1,216 +0,0 @@ -;;; +setup.el -- my `setup' commands -*- lexical-binding: t -*- - -;; Author: Case Duckworth - -;; This file is NOT part of GNU Emacs. - -;;; License: -;; Everyone is permitted to do whatever with this software, without -;; limitation. This software comes without any warranty whatsoever, -;; but with two pieces of advice: -;; - Don't hurt yourself. -;; - Make good choices. - -;;; Commentary: - -;; `setup', by Philip Kaludercic, is a wonderful package that works -;; sort of like `use-package', but to my mind it's cleaner and easier -;; to extend. These are my additions to the local macros provided by -;; the package. - -;;; Code: - -(require 'el-patch) -(require 'setup) -(require 'straight) -(require 'cl-lib) - -(defun +setup-warn (message &rest args) - "Warn the user that something bad happened in `setup'." - (display-warning 'setup (format message args))) - -(defun +setup-wrap-to-demote-errors (body name) - "Wrap BODY in a `with-demoted-errors' block. -This behavior is prevented if `setup-attributes' contains the -symbol `without-error-demotion'. - -This function differs from `setup-wrap-to-demote-errors' in that -it includes the NAME of the setup form in the warning output." - (if (memq 'without-error-demotion setup-attributes) - body - `(with-demoted-errors ,(format "Error in setup form on line %d (%s): %%S" - (line-number-at-pos) - name) - ,body))) - - -;;; New forms - -(setup-define :quit - 'setup-quit - :documentation "Quit the current `setup' form. -Good for commenting.") - -(setup-define :face - (lambda (face spec) - `(custom-set-faces (list ,face ,spec 'now "Customized by `setup'."))) - :documentation "Customize FACE with SPEC using `custom-set-faces'." - :repeatable t) - -(setup-define :load-after - (lambda (&rest features) - (let ((body `(require ',(setup-get 'feature)))) - (dolist (feature (nreverse features)) - (setq body `(with-eval-after-load ',feature ,body))) - body)) - :documentation "Load the current feature after FEATURES.") - -(setup-define :load-from - (lambda (path) - `(let ((path* (expand-file-name ,path))) - (if (file-exists-p path*) - (add-to-list 'load-path path*) - ,(setup-quit)))) - :documentation "Add PATH to load path. -This macro can be used as NAME, and it will replace itself with -the nondirectory part of PATH. -If PATH does not exist, abort the evaluation." - :shorthand (lambda (args) - (intern - (file-name-nondirectory - (directory-file-name (cadr args)))))) - -(setup-define :needs - (lambda (executable) - `(unless (executable-find ,executable) - ,(setup-quit))) - :documentation "If EXECUTABLE is not in the path, stop here." - :repeatable 1) - - -;;; Package integrations - -;;; Straight.el - -(defun setup--straight-handle-arg (arg var) - (cond - ((and (boundp var) (symbol-value var)) t) - ((keywordp arg) (set var t)) - ((functionp arg) (set var nil) (funcall arg)) - ((listp arg) (set var nil) arg))) - -(with-eval-after-load 'straight - (setup-define :straight - (lambda (recipe &rest predicates) - (let* ((skp (make-symbol "straight-keyword-p")) - (straight-use-p - (cl-mapcar - (lambda (f) (setup--straight-handle-arg f skp)) - predicates)) - (form `(unless (and ,@straight-use-p - (condition-case e - (straight-use-package ',recipe) - (error - (+setup-warn ":straight error: %S" - ',recipe) - ,(setup-quit)) - (:success t))) - ,(setup-quit)))) - ;; Keyword arguments --- :quit is special and should short-circuit - (if (memq :quit predicates) - (setq form `,(setup-quit)) - ;; Otherwise, handle the rest of them ... - (when-let ((after (cadr (memq :after predicates)))) - (setq form `(with-eval-after-load ,(if (eq after t) - (setup-get 'feature) - after) - ,form)))) - ;; Finally ... - form)) - :documentation "Install RECIPE with `straight-use-package'. -If PREDICATES are given, only install RECIPE if all of them return non-nil. -The following keyword arguments are also recognized: -- :quit --- immediately stop evaluating. Good for commenting. -- :after FEATURE --- only install RECIPE after FEATURE is loaded. - If FEATURE is t, install RECIPE after the current feature." - :repeatable nil - :indent 1 - :shorthand (lambda (sexp) - (let ((recipe (cadr sexp))) - (or (car-safe recipe) recipe))))) - -;;; Apheleia - -(setup-define :apheleia - (lambda (name formatter &optional mode -pend) - (let* ((mode (or mode (setup-get 'mode))) - (current-formatters (and -pend - (alist-get mode apheleia-formatters)))) - `(with-eval-after-load 'apheleia - (setf (alist-get ',name apheleia-formatters) - ,formatter) - (setf (alist-get ',mode apheleia-mode-alist) - ',(pcase -pend - (:append (append (ensure-list current-formatters) - (list name))) - (:prepend (cons name (ensure-list current-formatters))) - ('nil name) - (_ (error "Improper `:apheleia' -PEND argument"))))))) - :documentation - "Register a formatter to `apheleia''s lists. -NAME is the name given to the formatter in `apheleia-formatters' -and `apheleia-mode-alist'. FORMATTER is the command paired with -NAME in `apheleia-formatters'. MODE is the mode or modes to add -NAME to in `apheleia-mode-alist'. If MODE is not given or nil, -use the setup form's MODE. Optional argument -PEND can be one of -`:append' or `:prepend', and if given will append or prepend the -given NAME to the current formatters for the MODE in -`apheleia-mode-alist', rather than replace them (the default). - -Example: -(setup - (:apheleia isort (\"isort\" \"--stdout\" \"-\") - python-mode)) -; => -(progn - (setf (alist-get 'isort apheleia-formatters) - '(\"isort\" \"--stdout\" \"-\")) - (setf (alist-get 'python-mode apheleia-mode-alist) - 'isort)) - -This form cannot be repeated, and it cannot be used as HEAD.") - - -;;; Redefines of `setup' forms - -(setup-define :bind-into - (lambda (feature-or-map &rest rest) - (cl-loop for f/m in (ensure-list feature-or-map) - collect (if (string-match-p "-map\\'" (symbol-name f/m)) - `(:with-map ,f/m (:bind ,@rest)) - `(:with-feature ,f/m (:bind ,@rest))) - into forms - finally return `(progn ,@forms))) - :documentation "Bind into keys into the map(s) of FEATURE-OR-MAP. -FEATURE-OR-MAP can be a feature or map name or a list of them. -The arguments REST are handled as by `:bind'." - :debug '(sexp &rest form sexp) - :indent 1) - -(setup-define :require - (lambda (&rest features) - (require 'cl-lib) - (if features - `(progn ,@(cl-loop for feature in features collect - `(unless (require ',feature nil t) - ,(setup-quit)))) - `(unless (require ',(setup-get 'feature) nil t) - ,(setup-quit)))) - :documentation "Try to require FEATURE, or stop evaluating body. -This macro can be used as NAME, and it will replace itself with -the first FEATURE." - :repeatable nil - :shorthand #'cadr) - -(provide '+setup) -;;; +setup.el ends here diff --git a/lisp/+shr.el b/lisp/+shr.el deleted file mode 100644 index af4bf5b..0000000 --- a/lisp/+shr.el +++ /dev/null @@ -1,51 +0,0 @@ -;;; +shr.el --- SHR extras -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -;;; [[https://github.com/oantolin/emacs-config/blob/master/my-lisp/shr-heading.el][shr-heading]], by oantolin - -(defun +shr-heading-next (&optional arg) - "Move forward by ARG headings (any h1-h4). -If ARG is negative move backwards, ARG defaults to 1." - (interactive "p") - (unless arg (setq arg 1)) - (catch 'return - (dotimes (_ (abs arg)) - (when (> arg 0) (end-of-line)) - (if-let ((match - (funcall (if (> arg 0) - #'text-property-search-forward - #'text-property-search-backward) - 'face '(shr-h1 shr-h2 shr-h3 shr-h4) - (lambda (tags face) - (cl-loop for x in (if (consp face) face (list face)) - thereis (memq x tags)))))) - (goto-char - (if (> arg 0) (prop-match-beginning match) (prop-match-end match))) - (throw 'return nil)) - (when (< arg 0) (beginning-of-line))) - (beginning-of-line) - (point))) - -(defun +shr-heading-previous (&optional arg) - "Move backward by ARG headings (any h1-h4). -If ARG is negative move forwards instead, ARG defaults to 1." - (interactive "p") - (+shr-heading-next (- (or arg 1)))) - -(defun +shr-heading--line-at-point () - "Return the current line." - (buffer-substring (line-beginning-position) (line-end-position))) - -(defun +shr-heading-setup-imenu () - "Setup imenu for h1-h4 headings in eww buffer. -Add this function to appropriate major mode hooks such as -`eww-mode-hook' or `elfeed-show-mode-hook'." - (setq-local - imenu-prev-index-position-function #'+shr-heading-previous - imenu-extract-index-name-function #'+shr-heading--line-at-point)) - -(provide '+shr) -;;; +shr.el ends here diff --git a/lisp/+slack.el b/lisp/+slack.el deleted file mode 100644 index cdf2747..0000000 --- a/lisp/+slack.el +++ /dev/null @@ -1,27 +0,0 @@ -;;; +slack.el --- Slack customizations and extras -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -(require 'slack) - -(defgroup +slack nil - "Extra slack customizations." - :group 'slack - :prefix "+slack-") - -(defcustom +slack-teams nil - "Teams to register using `slack-register-team'. -This is a list of plists that are passed directly to -`slack-register-team'." - ;;TODO: type - ) - -(defun +slack-register-teams () - "Register teams in `+slack-teams'." - (dolist (team +slack-teams) - (apply #'slack-register-team team))) - -(provide '+slack) -;;; +slack.el ends here diff --git a/lisp/+sly.el b/lisp/+sly.el deleted file mode 100644 index 8d8fd6a..0000000 --- a/lisp/+sly.el +++ /dev/null @@ -1,18 +0,0 @@ -;;; +sly.el --- Sly customizations -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -(require 'sly) - -(defun sly-mrepl-return-at-end () - (interactive) - (if (<= (point-max) (point)) - (sly-mrepl-return) - (if (bound-and-true-p paredit-mode) - (paredit-newline) - (electric-newline-and-maybe-indent)))) - -(provide '+sly) -;;; +sly.el ends here diff --git a/lisp/+straight.el b/lisp/+straight.el deleted file mode 100644 index cba6c96..0000000 --- a/lisp/+straight.el +++ /dev/null @@ -1,42 +0,0 @@ -;;; +straight.el --- Straight.el extras -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -(defun +straight-update-package (package &optional recursive) - "Update PACKAGE using straight. -This pulls, rebuilds, and loads the updated PACKAGE." - (interactive (list (straight--select-package "Update package" - #'straight--installed-p) - current-prefix-arg)) - (+with-message (format "Pulling package `%s'%s" package - (if recursive " and deps" "")) - (funcall (if recursive - #'straight-pull-package-and-deps - #'straight-pull-package) - package - :from-upstream)) - (+with-message (format "Rebuilding package `%s'%s" package - (if recursive " and deps" "")) - (straight-rebuild-package package recursive)) - (+with-message (format "Loading package `%s'%s" package - (if recursive " and deps" "")) - (ignore-errors (load-library (symbol-name package))) - (when recursive - (dolist (dep (straight--get-transitive-dependencies package)) - (ignore-errors (load-library (symbol-name package))))))) - -(defun +straight-update-all (from-upstream) - "Update all installed packages using straight. -This pulls and rebuilds all packages at once. It does not reload -all of them, for reasons that should be obvious. - -With a prefix argument, it also pulls the packages FROM-UPSTREAM." - (interactive "P") - (straight-pull-recipe-repositories) - (straight-pull-all from-upstream) - (straight-rebuild-all)) - -(provide '+straight) -;;; +straight.el ends here diff --git a/lisp/+tab-bar.el b/lisp/+tab-bar.el deleted file mode 100644 index 6c9debd..0000000 --- a/lisp/+tab-bar.el +++ /dev/null @@ -1,394 +0,0 @@ -;;; +tab-bar.el -*- lexical-binding: t; -*- - -;;; Commentary: - -;; Emacs 28 comes with an easy-to-use `tab-bar-format' option, but I still use -;; Emacs 27 on my Windows machine. Thus, the code in this file. - -;;; Code: - -(require 'acdw) -(require 'tab-bar) - -(defface +tab-bar-extra - '((t :inherit (tab-bar font-lock-comment-face))) - "Tab bar face for extra information, like the menu-bar and time." - :group 'basic-faces) - - -;; Common - -(defun +tab-bar-space (&optional n) - "Display a space N characters long, or 1." - `((space menu-item ,(+string-repeat (or n 1) " ") ignore))) - -(defun +tab-bar-misc-info () - "Display `mode-line-misc-info', formatted for the tab-bar." - `((misc-info menu-item ,(string-trim-right - (format-mode-line mode-line-misc-info)) - ignore))) - -(defcustom +tracking-hide-when-org-clocking nil - "Hide the `tracking-mode' information when clocked in." - :type 'boolean) - -(defun format-mode-line-unescaping (construct) - "Return a mode-line construct as a string, but unescape `%'s." - (format-mode-line - (cond ((listp construct) - (cl-loop for item in construct - collect (cond ((stringp item) - (string-replace "%" "%%" item)) - ((and (listp item) (eq :propertize (car item))) - (format-mode-line-unescaping item)) - (t item)))) - ((stringp construct) (string-replace "%" "%%" construct)) - (t construct)))) - -(defun +tab-bar-tracking-mode () - "Display `tracking-mode-line-buffers' in the tab-bar." - ;; TODO: write something to convert a mode-line construct to a tab-bar - ;; construct. - (when (and (bound-and-true-p tracking-mode) - (not (and +tracking-hide-when-org-clocking - (bound-and-true-p org-clock-current-task)))) - (cons (when (> (length tracking-mode-line-buffers) 0) - '(track-mode-line-separator menu-item " " ignore)) - (cl-loop for i from 0 below (length tracking-mode-line-buffers) - as item = (nth i tracking-mode-line-buffers) - collect (append (list (intern (format "tracking-mode-line-%s" i)) - 'menu-item - (string-trim (format-mode-line-unescaping item))) - (if-let ((keymap (plist-get item 'keymap))) - (list (alist-get 'down-mouse-1 (cdadr keymap))) - (list #'ignore)) - (when-let ((help (plist-get item 'help-echo))) - (list :help help))))))) - -(defun +tab-bar-timer () - "Display `+timer-string' in the tab-bar." - (when (> (length (bound-and-true-p +timer-string)) 0) - `((timer-string menu-item - ,(concat " " +timer-string) - (lambda (ev) - (interactive "e") - (cond ((not +timer-timer) nil) - ((equal +timer-string +timer-running-string) - (popup-menu - '("Running timer" - ["Cancel timer" +timer-cancel t]) - ev)) - (t (setq +timer-string "")))))))) - -(defun +tab-bar-date () - "Display `display-time-string' in the tab-bar." - (when display-time-mode - `((date-time-string menu-item - ,(substring-no-properties (concat " " (string-trim display-time-string))) - (lambda (ev) - (interactive "e") - (popup-menu - (append '("Timer") - (let (r) - (dolist (time '(3 5 10)) - (push (vector (format "Timer for %d minutes" time) - `(lambda () (interactive) - (+timer ,time)) - :active t) - r)) - (nreverse r)) - '(["Timer for ..." +timer t])) - ev)) - :help (discord-date-string))))) - -(defun +tab-bar-notmuch-count () - "Display a notmuch count in the tab-bar." - (when (and (executable-find "notmuch") - (featurep 'notmuch)) - (let* ((counts (ignore-errors (notmuch-hello-query-counts notmuch-saved-searches))) - (next (cl-find "inbox+unread" counts :key (lambda (l) (plist-get l :name)) :test 'equal)) - (next-count (plist-get next :count))) - (when (and next-count (> next-count 0)) - `((notmuch-count menu-item - ,(format " |%s|" next-count) - ignore - :help ,(format "%s mails requiring attention." next-count))))))) - -(defun +tab-bar-org-clock () - "Display `org-mode-line-string' in the tab-bar." - (when (and (fboundp 'org-clocking-p) - (org-clocking-p)) - ;; org-mode-line-string - `((org-clocking menu-item - ,org-mode-line-string - (lambda (ev) - (interactive "e") - (let ((menu (make-sparse-keymap - (or org-clock-current-task "Org-Clock")))) - (map-keymap (lambda (key binding) - (when (consp binding) - (define-key-after menu (vector key) - (copy-sequence binding)))) - (org-clock-menu)) - (message "%S" ev) - (popup-menu menu ev))) - :help ,(or (replace-regexp-in-string - (rx "[[" (group (* (not "]"))) - "][" (group (* (not "]"))) - "]]") - "\\2" - org-clock-current-task) - "Org-Clock"))))) - -(defcustom +tab-bar-emms-max-length 24 - "Maximum length of `+tab-bar-emms'." - :type 'number) - -(defun +tab-bar-emms () - "Display EMMS now playing information." - (when (and (bound-and-true-p emms-mode-line-mode) - emms-player-playing-p) - (let ((now-playing (+string-truncate (emms-mode-line-playlist-current) - (- +tab-bar-emms-max-length 2)))) - `(emms-now-playing menu-item - ,(concat "{" now-playing "}" " ") - emms-pause - ( :help ,(emms-mode-line-playlist-current)))))) - -(defun +tab-bar-bongo () - "Display Bongo now playing information." - (when-let ((modep (bound-and-true-p bongo-mode-line-indicator-mode)) - (buf (cl-some (lambda (b) - (with-current-buffer b - (when-let* ((modep (derived-mode-p 'bongo-playlist-mode)) - (bongo-playlist-buffer b) - (playingp (bongo-playing-p))) - b))) - (buffer-list)))) - `((bongo-now-playing menu-item - ,(concat "{" - (let ((bongo-field-separator "")) - (+string-truncate (replace-regexp-in-string - "\\(.*\\)\\(.*\\)\\(.*\\)" - "\\1: \\3" - (bongo-formatted-infoset)) - ;; This isn't right - (- (min 50 (/ (frame-width) 3 )) 2))) - "}") - (lambda () (interactive) - (let ((bongo-playlist-buffer - ;; XXX: I'm sure this is terribly inefficient - (cl-some (lambda (b) - (with-current-buffer b - (when-let* ((modep (derived-mode-p - 'bongo-playlist-mode)) - (bongo-playlist-buffer b) - (playingp (bongo-playing-p))) - b))) - (buffer-list)))) - (with-bongo-playlist-buffer - (bongo-pause/resume)))) - :help ,(funcall bongo-header-line-function))))) - -(defvar +tab-bar-show-original nil - "Original value of `tab-bar-show'.") - -(defun +tab-bar-basename () - "Generate the tab name from the basename of the buffer of the - selected window." - (let* ((tab-file-name (buffer-file-name (window-buffer - (minibuffer-selected-window))))) - (concat " " - (if tab-file-name - (file-name-nondirectory tab-file-name) - (+tab-bar-tab-name-truncated-left))))) - -;;; FIXME this doesn't work... -;; (defvar +tab-bar-tab-min-width 8 - ;; "Minimum width of a tab on the tab bar.") - -;; (defvar +tab-bar-tab-max-width 24 - ;; "Maximum width of a tab on the tab bar.") - -;; (defun +tab-bar-fluid-calculate-width () - ;; "Calculate the width of each tab in the tab-bar." - ;; (let* ((tab-bar-list (cdr (tab-bar-make-keymap-1))) - ;; (tab-bar-avail-width (frame-width)) - ;; (tab-bar-tab-count (length (tab-bar-tabs))) - ;; (tab-bar-close-button-char-width 1) - ;; (tab-bar-add-tab-button-char-width 1) - ;; (tab-bar-total-width - ;; (length (mapconcat - ;; (lambda (el) - ;; (when-let ((str (car-safe (cdr-safe (cdr-safe el))))) - ;; (substring-no-properties (eval str)))) - ;; tab-bar-list))) - ;; (tab-bar-total-tab-width - ;; (+ (* tab-bar-tab-count tab-bar-close-button-char-width) - ;; tab-bar-add-tab-button-char-width - ;; (length (mapconcat - ;; (lambda (el) - ;; (substring-no-properties (alist-get 'name el))) - ;; (tab-bar-tabs))))) - ;; (tab-bar-total-nontab-width (- tab-bar-total-width - ;; tab-bar-total-tab-width))) - ;; (min +tab-bar-tab-max-width - ;; (max +tab-bar-tab-min-width - ;; (/ (- tab-bar-avail-width - ;; tab-bar-total-tab-width - ;; tab-bar-total-nontab-width) - ;; tab-bar-tab-count))))) - -;; (defun +tab-bar-fluid-width () - ;; "Generate the tab name to fluidly fit in the given space." - ;; (let* ((tab-file-name (buffer-file-name (window-buffer - ;; (minibuffer-selected-window))))) - ;; (format (format " %%s%%%ds" (+tab-bar-fluid-calculate-width)) - ;; (if tab-file-name - ;; (file-name-nondirectory tab-file-name) - ;; (+tab-bar-tab-name-truncated-left)) - ;; " "))) - -(defun +tab-bar-tab-name-truncated-left () - "Generate the tab name from the buffer of the selected window. -This is just like `tab-bar-tab-name-truncated', but truncates the -name to the left." - (let* ((tab-name (buffer-name (window-buffer (minibuffer-selected-window)))) - (ellipsis (cond - (tab-bar-tab-name-ellipsis) - ((char-displayable-p ?…) "…") - ("..."))) - (l-ell (length ellipsis)) - (l-name (length tab-name))) - (if (< (length tab-name) tab-bar-tab-name-truncated-max) - tab-name - (propertize (concat - (when (> (+ l-name l-ell) tab-bar-tab-name-truncated-max) - ellipsis) - (truncate-string-to-width tab-name l-name - (max 0 (- l-name tab-bar-tab-name-truncated-max l-ell)))) - 'help-echo tab-name)))) - -(defun +tab-bar-format-align-right () - "Align the rest of tab bar items to the right, pixel-wise." - ;; XXX: ideally, wouldn't require `shr' here - (require 'shr) ; `shr-string-pixel-width' - (let* ((rest (cdr (memq '+tab-bar-format-align-right tab-bar-format))) - (rest (tab-bar-format-list rest)) - (rest (mapconcat (lambda (item) (nth 2 item)) rest "")) - (hpos (shr-string-pixel-width rest)) - (str (propertize " " 'display `(space :align-to (- right (,hpos)))))) - `((align-right menu-item ,str ignore)))) - - -;;; Menu bar -;; stole from https://github.com/emacs-mirror/emacs/blob/master/lisp/tab-bar.el - -(defun +tab-bar-menu-bar (event) - "Pop up the same menu as displayed by the menu bar. -Used by `tab-bar-format-menu-bar'." - (interactive "e") - (let ((menu (make-sparse-keymap (propertize "Menu Bar" 'hide t)))) - (run-hooks 'activate-menubar-hook 'menu-bar-update-hook) - (map-keymap (lambda (key binding) - (when (consp binding) - (define-key-after menu (vector key) - (copy-sequence binding)))) - (menu-bar-keymap)) - (popup-menu menu event))) - -(defcustom +tab-bar-menu-bar-icon " Emacs " - "The string to use for the tab-bar menu icon." - :type 'string) - -(defun +tab-bar-format-menu-bar () - "Produce the Menu button for the tab bar that shows the menu bar." - `((menu-bar menu-item (propertize +tab-bar-menu-bar-icon 'face '+tab-bar-extra) - +tab-bar-menu-bar :help "Menu Bar"))) - - -;;; Tab bar format tabs - -(require 'el-patch) -(el-patch-feature tab-bar) -(with-eval-after-load 'tab-bar - (el-patch-defun tab-bar--format-tab (tab i) - "Format TAB using its index I and return the result as a keymap." - (append - (el-patch-remove - `((,(intern (format "sep-%i" i)) menu-item ,(tab-bar-separator) ignore))) - (cond - ((eq (car tab) 'current-tab) - `((current-tab - menu-item - ,(funcall tab-bar-tab-name-format-function tab i) - ignore - :help "Current tab"))) - (t - `((,(intern (format "tab-%i" i)) - menu-item - ,(funcall tab-bar-tab-name-format-function tab i) - ,(alist-get 'binding tab) - :help "Click to visit tab")))) - (when (alist-get 'close-binding tab) - `((,(if (eq (car tab) 'current-tab) 'C-current-tab (intern (format "C-tab-%i" i))) - menu-item "" - ,(alist-get 'close-binding tab))))))) - - -;; Emacs 27 - -(defun +tab-bar-misc-info-27 (output &rest _) - "Display `mode-line-misc-info' in the `tab-bar' on Emacs 27. -This is :filter-return advice for `tab-bar-make-keymap-1'." - (let* ((reserve (length (format-mode-line mode-line-misc-info))) - (str (propertize " " - 'display `(space :align-to (- right (- 0 right-margin) - ,reserve))))) - (prog1 (append output - `((align-right menu-item ,str nil)) - (+tab-bar-misc-info))))) - - -;; Emacs 28 - -(defvar +tab-bar-format-original nil - "Original value of `tab-bar-format'.") - -(defun +tab-bar-misc-info-28 () - "Display `mode-line-misc-info', right-aligned, on Emacs 28." - (append (unless (memq 'tab-bar-format-align-right tab-bar-format) - '(tab-bar-format-align-right)) - '(+tab-bar-misc-info))) - - - -(define-minor-mode +tab-bar-misc-info-mode - "Show the `mode-line-misc-info' in the `tab-bar'." - :lighter "" - :global t - (if +tab-bar-misc-info-mode - (progn ; Enable - (setq +tab-bar-show-original tab-bar-show) - (cond - ((boundp 'tab-bar-format) ; Emacs 28 - (setq +tab-bar-format-original tab-bar-format) - (unless (memq '+tab-bar-misc-info tab-bar-format) - (setq tab-bar-format - (append tab-bar-format (+tab-bar-misc-info-28))))) - ((fboundp 'tab-bar-make-keymap-1) ; Emacs 27 - (advice-add 'tab-bar-make-keymap-1 :filter-return - '+tab-bar-misc-info-27))) - (setq tab-bar-show t)) - (progn ; Disable - (setq tab-bar-show +tab-bar-show-original) - (cond - ((boundp 'tab-bar-format) ; Emacs 28 - (setq tab-bar-format +tab-bar-format-original)) - ((fboundp 'tab-bar-make-keymap-1) ; Emacs 27 - (advice-remove 'tab-bar-make-keymap-1 '+tab-bar-misc-info-27)))))) - - - -(provide '+tab-bar) -;;; +tab-bar.el ends here diff --git a/lisp/+titlecase.el b/lisp/+titlecase.el deleted file mode 100644 index 655ebe1..0000000 --- a/lisp/+titlecase.el +++ /dev/null @@ -1,30 +0,0 @@ -;;; +titlecase.el --- Titlecase extras -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -(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))) - (while (and (progn (outline-next-heading) - (> (funcall outline-level) level)) - (not (eobp))) - (titlecase-line))))) - -(provide '+titlecase) -;;; +titlecase.el ends here diff --git a/lisp/+util.el b/lisp/+util.el deleted file mode 100644 index a87eae9..0000000 --- a/lisp/+util.el +++ /dev/null @@ -1,94 +0,0 @@ -;;; +util.el --- utility whatevers -*- lexical-binding: t -*- - -;;; Commentary: - -;; This file is going to be my version of like, subr.el -- lots of -;; random shit that all goes in here. - -;;; Code: - -(require 'cl-lib) - -(defgroup +util nil - "Utility whatevers." - :group 'convenience) - -;;; STRINGS - -(defcustom +string-default-alignment 'left - "Default alignment." - :type '(choice (const :tag "Left" 'left) - (const :tag "Right" 'right))) - -;; stolen from s.el -(defun +string-repeat (n s) - "Make a string of S repeated N times." - (declare (pure t) - (side-effect-free t)) - (let (ss) - (while (> n 0) - (setq ss (cons s ss) - n (1- n))) - (apply 'concat ss))) - -(defun +string-truncate (s length &optional ellipsis alignment) - "Return S, shortened to LENGTH including ELLIPSIS and aligned to ALIGNMENT. - -ELLIPSIS defaults to `truncate-string-ellipsis', or \"...\". - -ALIGNMENT defaults to `+string-default-alignment'." - (declare (pure t) - (side-effect-free t)) - (let ((ellipsis (or ellipsis truncate-string-ellipsis "...")) - (alignment (or alignment +string-default-alignment))) - (if (> (length s) length) - (format "%s%s" - (substring s 0 (- length (length ellipsis))) - ellipsis) - s))) - -(cl-defun +string-align (s len - &key - (before "") (after "") (fill " ") - (ellipsis (or truncate-string-ellipsis "...")) - (alignment +string-default-alignment)) - "Print S to fit in LEN characters. -Optional arguments BEFORE and AFTER specify strings to go on -either side of S. - -FILL is the string to fill extra space with (default \" \"). - -ELLIPSIS is the string to show when S is too long to fit (default -`truncate-string-ellipsis' or \"...\"). If nil, don't truncate -the string. - -ALIGNMENT can be one of these: -- nil: align to `+string-default-alignment' -- `left': align left -- `right': align right" - (let* ((s-length (length s)) - (before-length (length before)) - (after-length (length after)) - (max-length (- len (+ before-length after-length))) - (left-over (max 0 (- max-length s-length))) - (filler (+string-repeat left-over fill))) - (format "%s%s%s%s%s" - before - (if (eq alignment 'left) "" filler) - (if ellipsis (+string-truncate s max-length ellipsis alignment) s) - (if (eq alignment 'right) "" filler) - after))) - -;;; COMMANDS - -(defun +dos2unix (buffer) - "Replace \r\n with \n in BUFFER." - (interactive "*b") - (save-excursion - (with-current-buffer buffer - (goto-char (point-min)) - (while (search-forward (string ?\C-m ?\C-j) nil t) - (replace-match (string ?\C-j) nil t))))) - -(provide '+util) -;;; +util.el ends here diff --git a/lisp/+vertico.el b/lisp/+vertico.el deleted file mode 100644 index d4fb3a3..0000000 --- a/lisp/+vertico.el +++ /dev/null @@ -1,24 +0,0 @@ -;;; +vertico.el -*- lexical-binding: t; -*- - -;;; Code: - -;; https://old.reddit.com/r/emacs/comments/rbmfwk/weekly_tips_tricks_c_thread/hof7rz7/ -;; Add this advice to `vertico-next'. -;; Takes care of `vertico-previous' as well, since it calls `vertico-next'. -(defun +vertico-ding-wrap (origin &rest args) - "ADVICE to wrap `vertico-next': ding when wrapping." - (let ((beg-index vertico--index)) - (apply origin args) - (unless (eq 1 (abs (- beg-index vertico--index))) - (ding)))) - -(defun +vertico-widen-or-complete () - (interactive) - (if (or vertico-unobtrusive-mode - vertico-flat-mode) - (progn (vertico-unobtrusive-mode -1) - (vertico-flat-mode -1)) - (call-interactively #'vertico-insert))) - -(provide '+vertico) -;;; +vertico.el ends here diff --git a/lisp/+vterm.el b/lisp/+vterm.el deleted file mode 100644 index 06c0028..0000000 --- a/lisp/+vterm.el +++ /dev/null @@ -1,19 +0,0 @@ -;;; +vterm.el --- Vterm extras -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -(require 'vterm) - -(defun +vterm-counsel-yank-pop-action (orig-fun &rest args) - (if (equal major-mode 'vterm-mode) - (let ((inhibit-read-only t) - (yank-undo-function (lambda (_start _end) (vterm-undo)))) - (cl-letf (((symbol-function 'insert-for-yank) - (lambda (str) (vterm-send-string str t)))) - (apply orig-fun args))) - (apply orig-fun args))) - -(provide '+vterm) -;;; +vterm.el ends here diff --git a/lisp/+window.el b/lisp/+window.el deleted file mode 100644 index 52b3712..0000000 --- a/lisp/+window.el +++ /dev/null @@ -1,130 +0,0 @@ -;;; +window.el --- Fixes for Emacs's window.el -*- lexical-binding: t; -*- - -;;; Commentary: - -;; Do I want to propose this change in the Emacs ML? - -;;; Code: - -(require 'window) - -;;; Split windows based on `window-total-width', not `window-width' -;; I have to just redefine these functions because the check is really deep in -;; there. - -(defun window-splittable-p (window &optional horizontal) - "Return non-nil if `split-window-sensibly' may split WINDOW. -Optional argument HORIZONTAL nil or omitted means check whether -`split-window-sensibly' may split WINDOW vertically. HORIZONTAL -non-nil means check whether WINDOW may be split horizontally. - -WINDOW may be split vertically when the following conditions -hold: -- `window-size-fixed' is either nil or equals `width' for the - buffer of WINDOW. -- `split-height-threshold' is an integer and WINDOW is at least as - high as `split-height-threshold'. -- When WINDOW is split evenly, the emanating windows are at least - `window-min-height' lines tall and can accommodate at least one - line plus - if WINDOW has one - a mode line. - -WINDOW may be split horizontally when the following conditions -hold: -- `window-size-fixed' is either nil or equals `height' for the - buffer of WINDOW. -- `split-width-threshold' is an integer and WINDOW is at least as - wide as `split-width-threshold'. -- When WINDOW is split evenly, the emanating windows are at least - `window-min-width' or two (whichever is larger) columns wide." - (when (and (window-live-p window) - (not (window-parameter window 'window-side))) - (with-current-buffer (window-buffer window) - (if horizontal - ;; A window can be split horizontally when its width is not - ;; fixed, it is at least `split-width-threshold' columns wide - ;; and at least twice as wide as `window-min-width' and 2 (the - ;; latter value is hardcoded). - (and (memq window-size-fixed '(nil height)) - ;; Testing `window-full-width-p' here hardly makes any - ;; sense nowadays. This can be done more intuitively by - ;; setting up `split-width-threshold' appropriately. - (numberp split-width-threshold) - (>= (window-total-width window) - (max split-width-threshold - (* 2 (max window-min-width 2))))) - ;; A window can be split vertically when its height is not - ;; fixed, it is at least `split-height-threshold' lines high, - ;; and it is at least twice as high as `window-min-height' and 2 - ;; if it has a mode line or 1. - (and (memq window-size-fixed '(nil width)) - (numberp split-height-threshold) - (>= (window-height window) - (max split-height-threshold - (* 2 (max window-min-height - (if mode-line-format 2 1)))))))))) - -(defun split-window-sensibly (&optional window) - "Split WINDOW in a way suitable for `display-buffer'. -WINDOW defaults to the currently selected window. -If `split-height-threshold' specifies an integer, WINDOW is at -least `split-height-threshold' lines tall and can be split -vertically, split WINDOW into two windows one above the other and -return the lower window. Otherwise, if `split-width-threshold' -specifies an integer, WINDOW is at least `split-width-threshold' -columns wide and can be split horizontally, split WINDOW into two -windows side by side and return the window on the right. If this -can't be done either and WINDOW is the only window on its frame, -try to split WINDOW vertically disregarding any value specified -by `split-height-threshold'. If that succeeds, return the lower -window. Return nil otherwise. - -By default `display-buffer' routines call this function to split -the largest or least recently used window. To change the default -customize the option `split-window-preferred-function'. - -You can enforce this function to not split WINDOW horizontally, -by setting (or binding) the variable `split-width-threshold' to -nil. If, in addition, you set `split-height-threshold' to zero, -chances increase that this function does split WINDOW vertically. - -In order to not split WINDOW vertically, set (or bind) the -variable `split-height-threshold' to nil. Additionally, you can -set `split-width-threshold' to zero to make a horizontal split -more likely to occur. - -Have a look at the function `window-splittable-p' if you want to -know how `split-window-sensibly' determines whether WINDOW can be -split." - (let ((window (or window (selected-window)))) - (or (and (window-splittable-p window) - ;; Split window vertically. - (with-selected-window window - (split-window-below))) - (and (window-splittable-p window t) - ;; Split window horizontally. - (with-selected-window window - (split-window-right))) - (and - ;; If WINDOW is the only usable window on its frame (it is - ;; the only one or, not being the only one, all the other - ;; ones are dedicated) and is not the minibuffer window, try - ;; to split it vertically disregarding the value of - ;; `split-height-threshold'. - (let ((frame (window-frame window))) - (or - (eq window (frame-root-window frame)) - (catch 'done - (walk-window-tree (lambda (w) - (unless (or (eq w window) - (window-dedicated-p w)) - (throw 'done nil))) - frame nil 'nomini) - t))) - (not (window-minibuffer-p window)) - (let ((split-height-threshold 0)) - (when (window-splittable-p window) - (with-selected-window window - (split-window-below)))))))) - -(provide '+window) -;;; +window.el ends here diff --git a/lisp/+xkcd.el b/lisp/+xkcd.el deleted file mode 100644 index 6780b90..0000000 --- a/lisp/+xkcd.el +++ /dev/null @@ -1,16 +0,0 @@ -;;; +xkcd.el -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -(require 'xkcd) - -(defun +xkcd-get-from-url (url &rest _) - "Open XKCD from URL." - (if (string-match "xkcd\\.com/\\([0-9]+\\)" url) - (xkcd-get (string-to-number (match-string 1 url))) - (funcall +browse-url-browser-function url))) - -(provide '+xkcd) -;;; +xkcd.el ends here diff --git a/lisp/+ytdious.el b/lisp/+ytdious.el deleted file mode 100644 index 6124149..0000000 --- a/lisp/+ytdious.el +++ /dev/null @@ -1,21 +0,0 @@ -;;; +ytdious.el --- Ytdious customizations -*- lexical-binding: t; -*- - -;;; Commentary: - -;; https://github.com/spiderbit/ytdious - -;;; Code: - -(defun +ytdious-watch () - "Stream video at point in mpv." - (interactive) - (let* ((video (ytdious-get-current-video)) - (id (ytdious-video-id-fun video))) - (start-process "ytdious mpv" nil - "mpv" - (concat "https://www.youtube.com/watch?v=" id)) - "--ytdl-format=bestvideo[height<=?720]+bestaudio/best") - (message "Starting streaming...")) - -(provide '+ytdious) -;;; +ytdious.el ends here diff --git a/lisp/+zzz-to-char.el b/lisp/+zzz-to-char.el deleted file mode 100644 index b3f27f7..0000000 --- a/lisp/+zzz-to-char.el +++ /dev/null @@ -1,16 +0,0 @@ -;;; +zzz-to-char.el -*- lexical-binding: t; -*- - -;;; Commentary: - -;; - -;;; Code: - -(defun +zzz-to-char (prefix) - "Call `zzz-to-char' or `zzz-up-to-char' with PREFIX arg." - (interactive "P") - (call-interactively - (if prefix #'zzz-up-to-char #'zzz-to-char))) - -(provide '+zzz-to-char) -;;; +zzz-to-char.el ends here diff --git a/lisp/acdw.el b/lisp/acdw.el index 99ab733..1c6f826 100644 --- a/lisp/acdw.el +++ b/lisp/acdw.el @@ -1,28 +1,10 @@ -;;; acdw.el --- various meta-whatevers -*- lexical-binding: t -*- - -;;; Commentary: - -;; What's that saying about how the hardest things in computer science -;; are naming and off-by-one errors? Well, the naming one I know very -;; well. I've been trying to figure out a good way to prefix my -;; bespoke functions, other stuff I found online, and various emacs -;; lisp detritus for quite some time (I reckon at over a year, as of -;; 2021-11-02). Finally, I found the answer in the writings of Daniel -;; Mendler: I'll prefix everything with a `+' ! - -;; To that end, pretty much everything in lisp/ will have a filename -;; like "+org.el", except of course this file, and maybe a few -;; /actually original/ libraries I haven't had the wherewithal to -;; package out properly yet. - -;; Is it perfect? No. Is it fine? Yes. Here it is. - -;;; Code: +;;; acdw.el -- bits and bobs -*- lexical-binding: t; -*- +;; by C. Duckworth +(provide 'acdw) -(require 'diary-lib) -(require 'solar) ; for +sunrise-sunset +(require 'cl-lib) -;;; Define a directory and an expanding function +;;; Define both a directory and a function expanding to a file in that directory (defmacro +define-dir (name directory &optional docstring inhibit-mkdir) "Define a variable and function NAME expanding to DIRECTORY. @@ -46,488 +28,91 @@ the filesystem, unless INHIBIT-MKDIR is non-nil." (make-directory (file-name-directory file-name) :parents)) file-name)))) -(defun +suppress-messages (oldfn &rest args) ; from pkal - "Advice wrapper for suppressing `message'. -OLDFN is the wrapped function, that is passed the arguments -ARGS." - (let ((msg (current-message))) - (prog1 - (let ((inhibit-message t)) - (apply oldfn args)) - (when msg - (message "%s" msg))))) +;;; Convenience macros -(defun +ensure-after-init (function) - "Ensure FUNCTION runs after init, or now if already initialized. -If Emacs is already started, run FUNCTION. Otherwise, add it to -`after-init-hook'. FUNCTION is called with no arguments." +(defun eval-after-init (fn) + "Evaluate FN after inititation, or now if Emacs is initialized. +FN is called with no arguments." (if after-init-time - (funcall function) - (add-hook 'after-init-hook function))) - -(defmacro +with-ensure-after-init (&rest body) - "Ensure BODY forms run after init. -Convenience macro wrapper around `+ensure-after-init'." - (declare (indent 0) (debug (def-body))) - `(+ensure-after-init (lambda () ,@body))) - -(defun +remember-prefix-arg (p-arg P-arg) - "Display prefix ARG, in \"p\" and \"P\" `interactive' types. -I keep forgetting how they differ." - (interactive "p\nP") - (message "p: %S P: %S" p-arg P-arg)) - -(defmacro +defvar (var value &rest _) - "Quick way to `setq' a variable from a `defvar' form." - (declare (doc-string 3) (indent 2)) - `(setq ,var ,value)) - -(defmacro +with-message (message &rest body) - "Execute BODY, with MESSAGE. -If body executes without errors, MESSAGE...Done will be displayed." - (declare (indent 1)) - (let ((msg (gensym))) - `(let ((,msg ,message)) - (condition-case e - (progn (message "%s..." ,msg) - ,@body) - (:success (message "%s...done" ,msg)) - (t (signal (car e) (cdr e))))))) - -(defun +mapc-some-buffers (func &optional predicate-or-modes) - "Perform FUNC on all buffers satisfied by PREDICATE-OR-MODES. -By default, act on all buffers. - -Both PREDICATE-OR-MODES and FUNC are called with no arguments, -but within a `with-current-buffer' form on the currently-active -buffer. - -As a special case, if PREDICATE-OR-MODES is a list, it will be -interpreted as a list of major modes. In this case, FUNC will -only be called on buffers derived from one of the modes in -PREDICATE-OR-MODES." - (let ((pred (or predicate-or-modes t))) - (dolist (buf (buffer-list)) - (with-current-buffer buf - (when (cond ((functionp pred) - (funcall pred)) - ((listp pred) - (apply #'derived-mode-p pred)) - (t pred)) - (funcall func)))))) - -;; https://github.com/cstby/emacs.d/blob/main/init.el#L67 -(defun +clean-empty-lines (&optional begin end) - "Remove duplicate empty lines from BEGIN to END. -Called interactively, this function acts on the region, if -active, or else the entire buffer." - (interactive "*r") - (unless (region-active-p) - (setq begin (point-min) - end (save-excursion - (goto-char (point-max)) - (skip-chars-backward "\n[:space:]") - (point)))) - (save-excursion - (save-restriction - (narrow-to-region begin end) - (goto-char (point-min)) - (while (re-search-forward "\n\n\n+" nil :move) - (replace-match "\n\n")) - ;; Insert a newline at the end. - (goto-char (point-max)) - (unless (or (buffer-narrowed-p) - (= (line-beginning-position) (line-end-position))) - (insert "\n"))))) - -(defcustom +open-paragraph-ignore-modes '(special-mode lui-mode comint-mode) - "Modes in which `+open-paragraph' makes no sense." - :type '(repeat function)) - -(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") - ;; TODO: add `+open-paragraph-ignore-modes' - (unless (apply #'derived-mode-p +open-paragraph-ignore-modes) - ;; 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 +split-window-then (&optional where arg) - "Split the window into a new buffer. -With non-nil ARG (\\[universal-argument] interactively), don't -prompt for a buffer to switch to. This function will split the -window using `split-window-sensibly', or open the new window in -the direction specified by WHERE. WHERE is ignored when called -interactively; if you want specific splitting, use -`+split-window-right-then' or `+split-window-below-then'." - (interactive "i\nP") - ;; TODO: Canceling at the switching phase leaves the point in the other - ;; window. Ideally, the user would see this as one action, meaning a cancel - ;; would return to the original window. - (pcase where - ;; These directions are 'backward' to the OG Emacs split-window commands, - ;; because by default Emacs leaves the cursor in the original window. Most - ;; users probably expect a switch to the new window, at least I do. - ((or 'right :right) (split-window-right) (other-window 1)) - ((or 'left :left) (split-window-right)) - ((or 'below :below) (split-window-below) (other-window 1)) - ((or 'above :above) (split-window-below)) - ((pred null) - (or (split-window-sensibly) - (if (< (window-height) (window-width)) - (split-window-below) - (split-window-right))) - (other-window 1)) - (_ (user-error "Unknown WHERE paramater: %s" where))) - (unless arg - (condition-case nil - (call-interactively - (pcase (read-char "(B)uffer or (F)ile?") - (?b (if (fboundp #'consult-buffer) - #'consult-buffer - #'switch-to-buffer)) - (?f #'find-file) - (_ #'ignore))) - (quit (delete-window))))) - -(defun +split-window-right-then (&optional arg) - "Split window right, then prompt for a new buffer. -With optional ARG (\\[universal-argument]), just split." - (interactive "P") - (+split-window-then :right arg)) - -(defun +split-window-below-then (&optional arg) - "Split window below, then prompt for a new buffer. -With optional ARG (\\[universal-argument]), just split." - (interactive "P") - (+split-window-then :below arg)) - -(defun +bytes (number unit) - "Convert NUMBER UNITs to bytes. -UNIT can be one of :kb, :mb, :gb, :tb, :pb, :eb, :zb, :yb; :kib, :mib, :gib, -:tib, :pib, :eib, :zib, :yib." - (* number (pcase unit - ;; Base 10 units - (:kb 1000) - (:mb (* 1000 1000)) - (:gb (* 1000 1000 1000)) - (:tb (* 1000 1000 1000 1000)) - (:pb (* 1000 1000 1000 1000 1000)) - (:eb (* 1000 1000 1000 1000 1000 1000)) - (:zb (* 1000 1000 1000 1000 1000 1000 1000)) - (:yb (* 1000 1000 1000 1000 1000 1000 1000 1000)) - ;; Base 2 units - (:kib 1024) - (:mib (* 1024 1024)) - (:gib (* 1024 1024 1024)) - (:tib (* 1024 1024 1024 1024)) - (:pib (* 1024 1024 1024 1024 1024)) - (:eib (* 1024 1024 1024 1024 1024 1024)) - (:zib (* 1024 1024 1024 1024 1024 1024 1024)) - (:yib (* 1024 1024 1024 1024 1024 1024 1024 1024))))) - -;;; Font lock TODO keywords - -(defcustom font-lock-todo-keywords '("TODO" "XXX" "FIXME" "BUG") - "Keywords to highlight with `font-lock-todo-face'.") - -(defface font-lock-todo-face '((t :inherit font-lock-comment-face - :background "yellow")) - ;; TODO: XXX: FIXME: BUG: testing :) - "Face for TODO keywords.") - -(defun font-lock-todo-insinuate () - (let ((keyword-regexp - (rx bow (group (eval (let ((lst '(or))) - (dolist (kw font-lock-todo-keywords) - (push kw lst)) - (nreverse lst)))) - ":"))) - (font-lock-add-keywords - nil - `((,keyword-regexp 1 'font-lock-todo-face prepend))))) - -;; I don't use this much but I always forget the exact implementation, so this -;; is more to remember than anything else. -(defmacro setc (&rest vars-and-vals) - "Set VARS-AND-VALS by customizing them or using set-default. -Use like `setq'." - `(progn ,@(cl-loop for (var val) on vars-and-vals by #'cddr - if (null val) return (user-error "Not enough arguments") - collecting `(funcall (or (get ',var 'custom-get) - #'set-default) - ',var ',val) - into ret - finally return ret))) - -(defun +set-faces (specs) - "Set fonts to SPECS. -Specs is an alist: its cars are faces and its cdrs are the plist -passed to `set-face-attribute'. Note that the FRAME argument is -always nil; this function is mostly intended for use in init." - (dolist (spec specs) - (apply #'set-face-attribute (car spec) nil (cdr spec)))) - -(defcustom chat-functions '(+irc - jabber-connect-all - ;; slack-start - ) - "Functions to start when calling `chat'." - :type '(repeat function) - :group 'applications) - -(defun +string-repeat (n str) - "Repeat STR N times." - (let ((r "")) - (dotimes (_ n) - (setq r (concat r str))) - r)) - -;; (defun chat-disconnect () -;; "Disconnect from all chats." -;; (interactive) -;; (+with-progress "Quitting circe..." -;; (ignore-errors -;; (circe-command-GQUIT "peace love bread") -;; (cancel-timer (irc-connection-get conn :flood-timer)))) -;; (+with-progress "Quitting jabber..." -;; (ignore-errors -;; (jabber-disconnect))) -;; (when (boundp '+slack-teams) -;; (+with-progress "Quitting-slack..." -;; (dolist (team +slack-teams) -;; (ignore-errors -;; (slack-team-disconnect team))) -;; (ignore-errors (slack-ws-close)))) -;; (+with-progress "Killing buffers..." -;; (ignore-errors -;; (+mapc-some-buffers (lambda () "Remove the buffer from tracking and kill it unconditionally." -;; (let ((kill-buffer-query-functions nil)) -;; (tracking-remove-buffer (current-buffer)) -;; (kill-buffer))) -;; (lambda () "Return t if derived from the following modes." -;; (derived-mode-p 'lui-mode -;; 'jabber-chat-mode -;; 'jabber-roster-mode -;; 'jabber-browse-mode -;; 'slack-mode)))))) - -;; I can never remember all the damn chat things I run, so this just does all of em. -;; (defun chat (&optional arg) -;; "Initiate all chat functions. -;; With optional ARG, kill all chat-related buffers first." -;; (interactive "P") -;; (when arg (chat-disconnect)) -;; (dolist-with-progress-reporter (fn chat-functions) -;; "Connecting to chat..." -;; (call-interactively fn))) - -(defun +forward-paragraph (arg) - "Move forward ARG (simple) paragraphs. -A paragraph here is simply defined: it's a block of buffer that's -separated from others by two newlines." - (interactive "p") - (let ((direction (/ arg (abs arg)))) - (forward-line direction) - (while (not (or (bobp) - (eobp) - (= arg 0))) - (if (looking-at "^[ \f\t]*$") - (setq arg (- arg direction)) - (forward-line direction))))) - -(defun +backward-paragraph (arg) - "Move backward ARG (simple) paragraphs. -See `+forward-paragraph' for the behavior." - (interactive "p") - (+forward-paragraph (- arg))) - -(defun +concat (&rest strings) - "Concat STRINGS separated by SEPARATOR. -Each item in STRINGS is either a string or a list or strings, -which is concatenated without any separator. - -SEPARATOR defaults to the newline (\\n)." - (let (ret - ;; I don't know why a `cl-defun' with - ;; (&rest strings &key (separator "\n")) doesn't work - (separator (or (cl-loop for i from 0 upto (length strings) - if (eq (nth i strings) :separator) - return (nth (1+ i) strings)) - "\n"))) - (while strings - (let ((string (pop strings))) - (cond ((eq string :separator) (pop strings)) - ((listp string) (push (apply #'concat string) ret)) - ((stringp string) (push string ret))))) - (mapconcat #'identity (nreverse ret) separator))) - -(defun +file-string (file) - "Fetch the contents of FILE and return its string." - (with-current-buffer (find-file-noselect file) - (buffer-string))) - -(defmacro +with-progress (pr-args &rest body) - "Perform BODY wrapped in a progress reporter. -PR-ARGS is the list of arguments to pass to -`make-progress-reporter'; it can be a single string for the -message, as well. If you want to use a formatted string, wrap -the `format' call in a list." + (funcall fn) + (add-hook 'after-init-hook fn))) + +(defmacro eval-after (features &rest body) + "Evaluate BODY, but only after loading FEATURES. +FEATURES can be an atom or a list; as an atom it works like +`with-eval-after-load'. The special feature `init' will evaluate +BODY after Emacs is finished initializing." + (declare (indent 1) + (debug (form def-body))) + (if (eq features 'init) + `(eval-after-init (lambda () ,@body)) + (unless (listp features) + (setq features (list features))) + (if (null features) + (macroexp-progn body) + (let* ((this (car features)) + (rest (cdr features))) + `(with-eval-after-load ',this + (eval-after ,rest ,@body)))))) + +;;; Convenience functions + +(defun define-keys (maps &rest keydefs) + "Define KEYDEFS in MAPS. +Convenience wrapper around `define-key'." + (unless (zerop (mod (length keydefs) 2)) + (user-error "Wrong number of arguments: %S" (length keydefs))) + (dolist (map (if (or (atom maps) (eq (car maps) 'keymap)) + (list maps) + maps)) + (cl-loop for (key def) on keydefs by #'cddr + do (let ((key (if (stringp key) (kbd key) key))) + (define-key (if (symbolp map) + (symbol-value map) + map) + key def))))) + +(defmacro setq-local-hook (hook &rest args) + "Run `setq-local' on ARGS when running HOOK." (declare (indent 1)) - (let ((reporter (gensym)) - (pr-args (if (listp pr-args) pr-args (list pr-args)))) - `(let ((,reporter (make-progress-reporter ,@pr-args))) - (prog1 (progn ,@body) - (progress-reporter-done ,reporter))))) - -(defmacro +with-eval-after-loads (features &rest body) - "Execute BODY after all FEATURES are loaded." - (declare (indent 1) (debug (form def-body))) - (unless (listp features) - (setq features (list features))) - (if (null features) - (macroexp-progn body) - (let* ((this (car features)) - (rest (cdr features))) - `(with-eval-after-load ',this - (+with-eval-after-loads ,rest ,@body))))) - -(defun +scratch-buffer (&optional nomode) - "Create a new scratch buffer and switch to it. -If the region is active, paste its contents into the scratch -buffer. The scratch buffer inherits the mode of the current -buffer unless NOMODE is non-nil. When called interactively, -NOMODE will be set when called with \\[universal-argument]." - (interactive "P") - (let* ((mode major-mode) - (bufname (generate-new-buffer-name (format "*scratch (%s)*" mode))) - (paste (and (region-active-p) - (prog1 - (buffer-substring (mark t) (point)) - (deactivate-mark))))) - (when (and (not nomode) - (bound-and-true-p ess-dialect)) ; Not sure what `ess-dialect' is - (setq mode (intern-soft (concat ess-dialect "-mode")))) - ;; Set up buffer - (switch-to-buffer (get-buffer-create bufname)) - (when (and (not nomode) mode) - (ignore-errors (funcall mode))) - (insert (format "%s Scratch buffer for %s%s\n\n" - comment-start mode comment-end)) - (when paste (insert paste)) - (get-buffer bufname))) - -(defun +indent-rigidly (arg &optional interactive) - "Indent all lines in the region, or the current line. -This calls `indent-rigidly' and passes ARG to it." - (interactive "P\np") - (unless (region-active-p) - (push-mark) - (push-mark (line-beginning-position) nil t) - (goto-char (line-end-position))) - (call-interactively #'indent-rigidly)) - -(defun +sort-lines (reverse beg end) - "Sort lines in region, ignoring leading whitespace. -REVERSE non-nil means descending order; interactively, REVERSE is -the prefix argument, and BEG and END are the region. The -variable `sort-fold-case' determines whether case affects the -sort order." - (interactive "P\nr") - (save-excursion - (save-restriction - (narrow-to-region beg end) - (goto-char (point-min)) - (let ((inhibit-field-text-motion t)) - (sort-subr reverse - #'forward-line - #'end-of-line - #'beginning-of-line-text))))) - -(defun +crm-indicator (args) - "AROUND advice for `completing-read-multiple'." - ;; [[https://github.com/minad/vertico/blob/8ab2cddf3a1fb8799611b1d35118bf579aaf3154/README.org][from vertico's README]] - (cons (format "[CRM%s] %s" - (replace-regexp-in-string - "\\`\\[.*?]\\*\\|\\[.*?]\\*\\'" "" - crm-separator) - (car args)) - (cdr args))) - - -;;; Timers! -;; inspired by [[https://git.sr.ht/~protesilaos/tmr/tree/main/item/tmr.el][prot's tmr.el package]] - -(defvar +timer-string nil) -(defvar +timer-timer nil) - -(defcustom +timer-running-string "⏰" - "What to display when the timer is running." - :type 'string) -(defcustom +timer-done-string "❗" - "What to display when the timer is done." - :type 'string) - -(defun +timer (time) - "Set a timer for TIME." - (interactive (list (read-string "Set a timer for how long? "))) - (let ((secs (cond ((natnump time) (* time 60)) - ((and (stringp time) - (string-match-p "[0-9]\\'" time)) - (* (string-to-number time) 60)) - (t (let ((secs 0) - (time time)) - (save-match-data - (while (string-match "\\([0-9.]+\\)\\([hms]\\)" time) - (cl-incf secs - (* (string-to-number (match-string 1 time)) - (pcase (match-string 2 time) - ("h" 3600) - ("m" 60) - ("s" 1)))) - (setq time (substring time (match-end 0))))) - secs))))) - (message "Setting timer for \"%s\" (%S seconds)..." time secs) - (setq +timer-string +timer-running-string) - (setq +timer-timer (run-with-timer secs nil - (lambda () - (message "%S-second timer DONE!" secs) - (setq +timer-string +timer-done-string) - (let ((visible-bell t) - (ring-bell-function nil)) - (ding)) - (ding)))))) - -(defun +timer-cancel () - "Cancel the running timer." - (interactive) - (cond ((not +timer-timer) - (message "No timer found!")) - (t - (cancel-timer +timer-timer) - (message "Timer canceled."))) - (setq +timer-string nil)) - - - -(defun +switch-to-last-buffer () - "Switch to the last-used buffer in this window." - (interactive) - (switch-to-buffer nil)) - -(provide 'acdw) -;;; acdw.el ends here + (let ((fn (intern (format "%s-setq-local" hook)))) + (when (and (fboundp fn) + (functionp fn)) + (setq args (append (function-get fn 'setq-local-hook-settings) args))) + (unless (and (< 0 (length args)) + (zerop (mod (length args) 2))) + (user-error "Wrong number of arguments: %S" (length args))) + `(progn + (defun ,fn () + ,(format "Set local variables after `%s'." hook) + (setq-local ,@args)) + (function-put ',fn 'setq-local-hook-settings ',args) + (add-hook ',hook #',fn)))) + +(unless (fboundp 'ensure-list) + ;; Just in case we're using an old version of Emacs. + (defun ensure-list (object) + "Return OBJECT as a list. +If OBJECT is already a list, return OBJECT itself. If it's +not a list, return a one-element list containing OBJECT." + (if (listp object) + object + (list object)))) + +(defun add-to-list* (lists &rest things) + "Add THINGS to LISTS. +LISTS can be one list variable or a list. +Each thing of THINGS can be either a variablel (the thing), or a list of the form +(ELEMENT &optional APPEND COMPARE-FN), which is passed to +`add-to-list'." + (dolist (l (ensure-list lists)) + (dolist (thing things) + (apply #'add-to-list l (ensure-list thing))))) + +(defun add-hook* (hooks &rest functions) + "Add FUNCTIONS to HOOKS. +Each function in FUNCTIONS can be a singleton or a list of the +form (FUNCTION &optional DEPTH LOCAL)." + (dolist (hook (ensure-list hooks)) + (dolist (fn functions) + (apply #'add-hook hook (ensure-list fn))))) diff --git a/lisp/dawn.el b/lisp/dawn.el deleted file mode 100644 index a184a84..0000000 --- a/lisp/dawn.el +++ /dev/null @@ -1,74 +0,0 @@ -;;; dawn.el --- Do things at dawn (and dusk) -*- lexical-binding: t; -*- - -;;; Commentary: - -;; There is also circadian.el, but it doesn't quite work for me. -;; This code comes mostly from https://gnu.xyz/auto_theme.html, but also -;; somewhere else (which I've forgotten) and my own brain :) - -;;; Code: - -(require 'calendar) -(require 'cl-lib) -(require 'solar) - -(defvar dawn--dawn-timer nil - "Timer for dawn-command.") - -(defvar dawn--dusk-timer nil - "Timer for dusk-command.") - -(defvar dawn--reset-timer nil - "Timer to reset dawn at midnight.") - -(defun dawn-encode-time (f) - "Encode fractional time F." - (let ((hhmm (cl-floor f)) - (date (cdddr (decode-time)))) - (encode-time - (append (list 0 - (round (* 60 (cadr hhmm))) - (car hhmm) - ) - date)))) - -(defun dawn-midnight () - "Return the time of the /next/ midnight." - (let ((date (cdddr (decode-time)))) - (encode-time - (append (list 0 0 0 (1+ (car date))) (cdr date))))) - -(defun dawn-sunrise () - "Return the time of today's sunrise." - (dawn-encode-time (caar (solar-sunrise-sunset (calendar-current-date))))) - -(defun dawn-sunset () - "Return the time of today's sunset." - (dawn-encode-time (caadr (solar-sunrise-sunset (calendar-current-date))))) - -(defun dawn-schedule (dawn-command dusk-command) - "Run DAWN-COMMAND at sunrise, and DUSK-COMMAND at dusk. -RESET is an argument for internal use." - (let ((dawn (dawn-sunrise)) - (dusk (dawn-sunset))) - (cond - ((time-less-p nil dawn) - ;; If it isn't dawn yet, it's still dark. Run DUSK-COMMAND and schedule - ;; DAWN-COMMAND and DUSK-COMMAND for later. - (funcall dusk-command) - (run-at-time dawn nil dawn-command) - (run-at-time dusk nil dusk-command)) - ((time-less-p nil dusk) - ;; If it isn't dusk yet, it's still light. Run DAWN-COMMAND and schedule - ;; DUSK-COMMAND. - (funcall dawn-command) - (run-at-time dusk nil dusk-command)) - (t ;; Otherwise, it's past dusk, so run DUSK-COMMAND. - (funcall dusk-command))) - ;; Schedule a reset at midnight, to re-calculate dawn/dusk times. - ;(unless reset) - (run-at-time (dawn-midnight) nil - #'dawn-schedule dawn-command dusk-command))) - -(provide 'dawn) -;;; dawn.el ends here diff --git a/lisp/elephant.el b/lisp/elephant.el deleted file mode 100644 index 3cae17a..0000000 --- a/lisp/elephant.el +++ /dev/null @@ -1,58 +0,0 @@ -;;; elephant.el --- Remember variables and modes -*- lexical-binding: t; -*- - -;;; Code: - -(defmacro elephant-remember (alist) - "Setup a closure remembering symbols to apply with -`remember-reset'. The variables will be renamed using TEMPLATE. -ALIST contains cells of the form (SYMBOL . NEW-VALUE), where -SYMBOL is a variable or mode name, and its value is what to set -after `remember-set'." - (unless lexical-binding - (user-error "`elephant' requires lexical binding.")) - - (let* ((template (format "elephant--%s-%%s" (gensym))) - (reset-fn (intern (format template "reset")))) - (cl-destructuring-bind (let-list fn-set-list fn-reset-list) - (cl-loop - for (sym . val) in (if (symbolp alist) (symbol-value alist) alist) - as rem = (intern (format template sym)) - - collect (list rem sym) - into let-list - - collect (cond ((eq val 'enable) - `(,sym +1)) - ((eq val 'disable) - `(,sym -1)) - (t `(setq-local ,sym ,val))) - into fn-set-list - - collect (cond ((memq val '(enable disable)) - `(progn (,sym (if ,rem +1 -1)) - (fmakunbound ',rem))) - (t `(progn (setq-local ,sym ,rem) - (makunbound ',rem)))) - into fn-reset-list - - finally return (list let-list - fn-set-list - fn-reset-list)) - `(progn - (defvar-local ,reset-fn nil - "Function to recall values from `elephant-remember'.") - (let ,let-list - (setf (symbol-function ',reset-fn) - (lambda () - ,@fn-reset-list - (redraw-display) - (fmakunbound ',reset-fn)))) - ,@fn-set-list - ',reset-fn)))) - -(defun elephant-forget () - "Forget all symbols generated by `elephant-remember'." - ) - -(provide 'elephant) -;;; elephant.el ends here diff --git a/lisp/find-script.el b/lisp/find-script.el deleted file mode 100644 index 9e3633a..0000000 --- a/lisp/find-script.el +++ /dev/null @@ -1,36 +0,0 @@ -;;; find-script.el --- Find a script in $PATH -*- lexical-binding: t; -*- - -;;; Commentary: - -;; This package makes it easier to find a script to edit in $PATH. The initial -;; `rehash-exes' is slow, but it's stored in `*exes*' as a caching mechanism. -;; However, I'm sure it could be improved. - -;; In addition, `*exes*' currently contains /all/ executables in $PATH, which -;; ... maybe only the ones stored in some text format should be shown. - -;;; Code: - -(defvar *exes* nil - "All the exectuables in $PATH. -Run `rehash-exes' to refresh this variable.") - -(defun rehash-exes () - "List all the executables in $PATH. -Also sets `*exes*' parameter." - (setq *exes* - (cl-loop for dir in exec-path - append (file-expand-wildcards (concat dir "*")) - into exes - finally return exes))) - -;;;###autoload -(defun find-script (script) - "Find a file in $PATH." - (interactive - (list (let ((exes (or *exes* (rehash-exes)))) - (completing-read "Script> " exes nil t)))) - (find-file script)) - -(provide 'find-script) -;;; find-script.el ends here diff --git a/lisp/gdrive.el b/lisp/gdrive.el deleted file mode 100644 index 41a3660..0000000 --- a/lisp/gdrive.el +++ /dev/null @@ -1,130 +0,0 @@ -;;; gdrive.el --- Gdrive integration -*- lexical-binding: t; -*- - -;; Copyright (C) 2022 Case Duckworth - -;; Author: Case Duckworth -;; Keywords: convenience, data, docs - -;; 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: - -;; [[https://github.com/prasmussen/gdrive][gdrive]] is a Go program to interface with Google Drive. This library connects -;; that to Emacs. - -;;; Code: - -(require 'cl-lib) - -(defgroup gdrive nil - "Customizations for Emacs's gdrive module." - :group 'applications - :prefix "gdrive-") - -(defcustom gdrive-bin (executable-find "gdrive") - "Where gdrive binary is located." - :type 'string) - -(defcustom gdrive-buffer "*gdrive*" - "Default buffer for gdrive output." - :type 'string) - -;;; Global flags - -;;;; -c, --config -;;;;; Application path, default: /Users//.gdrive -(defcustom gdrive-config-dir nil - "Application path.") - -;;;; --refresh-token -;;;;; Oauth refresh token used to get access token (for advanced users) -(defcustom gdrive-refresh-token nil - "Oauth refresh token used to get access token. -(For advanced users).") - -;;;; --access-token -;;;;; Oauth access token, only recommended for short-lived requests because of -;;;;; short lifetime (for advanced users) -(defcustom gdrive-access-token nil - "Oauth access token. -Only recommended for short-lived requests because of short -lifetime (for advanced users).") - -;;;; --service-account -;;;;; Oauth service account filename, used for server to server communication -;;;;; without user interaction (file is relative to config dir) -(defcustom gdrive-service-account nil - "Oauth service account filename. -Used for server to server communication without user -interaction (file is relative to config dir).") - -(defun gdrive--global-arguments () - "Build global arguments for gdrive." - (append - (when gdrive-config-dir (list "--config" gdrive-config-dir)) - (when gdrive-refresh-token (list "--refresh-token" gdrive-refresh-token)) - (when gdrive-access-token (list "--access-token" gdrive-access-token)) - (when gdrive-service-account (list "--service-account" gdrive-service-account)))) - -;;; List files -;; gdrive [global] list [options] -;;;; -m, --max -;;;; Max files to list, default: 30 -;;;; -q, --query -;;;;; Default query: "trashed = false and 'me' in owners". See https://developers.google.com/drive/search-parameters -;;;; --order -;;;;; Sort order. See https://godoc.org/google.golang.org/api/drive/v3#FilesListCall.OrderBy -;;;; --name-width -;;;;; Width of name column, default: 40, minimum: 9, use 0 for full width -;; NOTE: gdrive-list will pass 0 for this argument. -;;;; --absolute Show absolute path to file (will only show path from first parent) -;;;; --no-header Dont print the header -;; NOTE: gdrive-list will always pass this argument. -;;;; --bytes Size in bytes -(cl-defun gdrive-list (&key max query order absolute no-header bytes) - "Run the \"gdrive list\" command. -MAX is the max files to list; it defaults to 30. QUERY is the -query to pass; the default is \"trashed = false and 'me' in -owners\"." - (gdrive--run (append (gdrive--global-arguments) - (list "list") - (when max (list "--max" max)) - (when query (list "--query" query)) - (when order (list "--order" order)) - (list "--name-width" "0") - (when absolute (list "--absolute")) - (when no-header (list "--no-header")) - (when bytes (list "--bytes"))))) - - -(defmacro gdrive-query) - - -(defun gdrive--build-command-name (command) - "INTERNAL: Build a string name for COMMAND." - (concat "gdrive-" (car command))) - -(defun gdrive--run (command &optional buffer) - "Run 'gdrive COMMAND', collecting results in BUFFER. -COMMAND, if not a list, will be made a list and appended to -`gdrive-bin'. -BUFFER defaults to `gdrive-buffer'." - (let ((command (if (listp command) command (list command))) - (buffer (or buffer gdrive-buffer))) - (make-process :name (gdrive--build-command-name command) - :buffer buffer - :command (cons gdrive-bin command)))) - -(provide 'gdrive) -;;; gdrive.el ends here diff --git a/lisp/hide-cursor-mode.el b/lisp/hide-cursor-mode.el deleted file mode 100644 index 6325d81..0000000 --- a/lisp/hide-cursor-mode.el +++ /dev/null @@ -1,116 +0,0 @@ -;;; hide-cursor-mode.el --- Hide the cursor and scroll-lock -*- lexical-binding: t; -*- - -;;; Commentary: - -;; From Karthik: https://karthinks.com/software/more-less-emacs/ - -;;; Code: - -(defvar-local hide-cursor--original nil) - -(progn - (progn :autoload-end - (defvar-local hide-cursor-mode nil "Non-nil if Hide-Cursor mode is enabled. -Use the command `hide-cursor-mode' to change this variable.")) - (defun hide-cursor-mode - (&optional arg) - "Hide or show the cursor. - -This is a minor mode. If called interactively, toggle the -`Hide-Cursor mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `hide-cursor-mode'. - -The mode's hook is called both when the mode is enabled and when -it is disabled. - -When the cursor is hidden `scroll-lock-mode' is enabled, so that -the buffer works like a pager." - (interactive - (list - (if current-prefix-arg - (prefix-numeric-value current-prefix-arg) - 'toggle))) - (let - ((last-message - (current-message))) - (setq hide-cursor-mode - (cond - ((eq arg 'toggle) - (not hide-cursor-mode)) - ((and - (numberp arg) - (< arg 1)) - nil) - (t t))) - (when - (boundp 'local-minor-modes) - (setq local-minor-modes - (delq 'hide-cursor-mode local-minor-modes)) - (when hide-cursor-mode - (push 'hide-cursor-mode local-minor-modes))) - (if hide-cursor-mode - (progn - (scroll-lock-mode 1) - (setq-local hide-cursor--original cursor-type) - (setq-local cursor-type nil)) - (scroll-lock-mode -1) - (setq-local cursor-type - (or hide-cursor--original t))) - (run-hooks 'hide-cursor-mode-hook - (if hide-cursor-mode 'hide-cursor-mode-on-hook 'hide-cursor-mode-off-hook)) - (if - (called-interactively-p 'any) - (progn nil - (unless - (and - (current-message) - (not - (equal last-message - (current-message)))) - (let - ((local " in current buffer")) - (message "Hide-Cursor mode %sabled%s" - (if hide-cursor-mode "en" "dis") - local)))))) - (force-mode-line-update) - hide-cursor-mode) - :autoload-end - (defvar hide-cursor-mode-hook nil) - (unless - (get 'hide-cursor-mode-hook 'variable-documentation) - (put 'hide-cursor-mode-hook 'variable-documentation "Hook run after entering or leaving `hide-cursor-mode'. -No problems result if this variable is not bound. -`add-hook' automatically binds it. (This is true for all hook variables.)")) - (put 'hide-cursor-mode-hook 'custom-type 'hook) - (put 'hide-cursor-mode-hook 'standard-value - (list nil)) - (defvar hide-cursor-mode-map - (let - ((m - (let - ((map - (make-sparse-keymap))) - (define-key map - [f7] - (function hide-cursor-mode)) - map))) - (cond - ((keymapp m) - m) - ((listp m) - (easy-mmode-define-keymap m)) - (t - (error "Invalid keymap %S" m)))) - "Keymap for `hide-cursor-mode'.") - (with-no-warnings - (add-minor-mode 'hide-cursor-mode '"H" hide-cursor-mode-map nil nil))) - -(provide 'hide-cursor-mode) -;;; hide-cursor-mode.el ends here diff --git a/lisp/long-s-mode.el b/lisp/long-s-mode.el deleted file mode 100644 index 784cb7d..0000000 --- a/lisp/long-s-mode.el +++ /dev/null @@ -1,67 +0,0 @@ -;;; long-s-mode.el --- Proper typography for Emacs -*- lexical-binding: t; -*- - -;;; Commentary: - -;; from Catie on #emacs - -;;; Code: - -(define-minor-mode long-s-mode - "Minor mode for inserting 'ſ' characters") - -(defconst +long-s+ ?ſ) -(defconst +short-s+ ?s) - -(defun long-s-p (char) - (char-equal char +long-s+)) - -(defun short-s-p (char) - (or (char-equal char +short-s+))) - -(defun s-char-p (char) - (or (long-s-p char) - (short-s-p char))) - -(defun alpha-char-p (char) - (memq (get-char-code-property char 'general-category) - '(Ll Lu Lo Lt Lm Mn Mc Me Nl))) - -(defun long-s-insert-short-s () - (interactive) - (if (long-s-p (preceding-char)) - (insert-char +short-s+) - (insert-char +long-s+))) - -(defun long-s-insert-space () - (interactive) - (if (long-s-p (preceding-char)) - (progn (delete-backward-char 1) - (insert-char +short-s+)) - (save-excursion - (while (not (alpha-char-p (preceding-char))) - (backward-char)) - (when (long-s-p (preceding-char)) - (delete-backward-char 1) - (insert-char +short-s+)))) - (insert-char ?\ )) - -(defvar long-s-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map (current-global-map)) - (define-key map (kbd "s") #'long-s-insert-short-s) - (define-key map (kbd "SPC") #'long-s-insert-space) - map)) - -(setq long-s-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "s") #'long-s-insert-short-s) - (define-key map (kbd "SPC") #'long-s-insert-space) - map)) - -(unless (seq-some #'(lambda (x) (eq (car x) 'long-s-mode)) - minor-mode-map-alist) - (push (cons 'long-s-mode long-s-mode-map) - minor-mode-map-alist)) - -(provide 'long-s-mode) -;;; long-s-mode.el ends here diff --git a/lisp/private.el b/lisp/private.el deleted file mode 100644 index 4f6115e..0000000 --- a/lisp/private.el +++ /dev/null @@ -1,23 +0,0 @@ -;;; private.el -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -(require 'acdw) - -(defgroup private nil - "Private things are private. Shhhhh....") - -;; Private directory - -(+define-dir private/ (sync/ "emacs/private") - "Private secretive secrets inside.") -(add-to-list 'load-path private/) - -;; Load random private stuff - -(require '_acdw) - -(provide 'private) -;;; private.el ends here diff --git a/lisp/reading.el b/lisp/reading.el deleted file mode 100644 index a0d22f4..0000000 --- a/lisp/reading.el +++ /dev/null @@ -1,85 +0,0 @@ -;;; reading.el --- minor mode for reading -*- lexical-binding: t; -*- - -;;; Code: - -(defgroup reading nil - "Group for Reading mode customizations." - :prefix "reading-" - :group 'convenience) - -(defcustom reading-vars '((indicate-empty-lines . nil) - (indicate-buffer-boundaries . nil)) - "Alist of variables to set in function `reading-mode'. -The car of each cell is the variable name, and the cdr is the -value to set it to." - :type '(alist :key-type variable - :value-type sexp)) - -(defcustom reading-modes '((display-fill-column-indicator-mode . -1) - (blink-cursor-mode . -1)) - "Alist of modes to set in function `reading-mode'. -The car of each cell is the function name, and the cdr is the -value to call it with." - :type '(alist :key-type function - :value-type sexp)) - -;;; Internal - -(defvar reading--remembered-template "reading--remembered-%s-value" - "The template passed to `format' for remembered modes and variables.") - -(defun reading--remember (things func) - "Apply FUNC to THINGS, remembering their previous value for later." - (declare (indent 1)) - (unless (listp things) - (setq things (list things))) - (dolist (thing things) - (set (make-local-variable - (intern (format reading--remembered-template thing))) - (and (boundp thing) - (symbol-value thing))) - (funcall func thing))) - -(defun reading--recall (things func) - "Recall previously remembered THINGS by applying FUNC to them. -FUNC should be a function with the signature (THING REMEMBERED-SETTING)." - (declare (indent 1)) - (unless (listp things) - (setq things (list things))) - (dolist (thing things) - (with-demoted-errors "reading--recall: %S" - (let ((value (symbol-value - (intern - (format reading--remembered-template thing))))) - (funcall func thing value))))) - -;;; Mode - -;;;###autoload -(defvar reading-mode-map (make-sparse-keymap) - "Keymap for `reading-mode'.") - -;;;###autoload -(define-minor-mode reading-mode - "A mode for reading." - :lighter " Read" - (if reading-mode - ;; turn on - (progn - (reading--remember (mapcar #'car reading-vars) - (lambda (var) - (set (make-local-variable var) - (cdr (assoc var reading-vars))))) - (reading--remember (mapcar #'car reading-modes) - (lambda (mode) - (funcall mode (cdr (assoc mode reading-modes)))))) - ;; turn off - (reading--recall (mapcar #'car reading-vars) - (lambda (var orig-val) - (set (make-local-variable var) orig-val))) - (reading--recall (mapcar #'car reading-modes) - (lambda (mode orig-setting) - (funcall mode (if orig-setting +1 -1)))))) - -(provide 'reading) -;;; reading.el ends here diff --git a/lisp/system.el b/lisp/system.el deleted file mode 100644 index 73cd80b..0000000 --- a/lisp/system.el +++ /dev/null @@ -1,179 +0,0 @@ -;;; system.el --- Load system-dependendant settings -*- lexical-binding: t; -*- - -;;; Commentary: - -;; When using Emacs on multiple computers, some variables and functions need -;; different definitions. This library is built to assist in working with -;; different system configurations for Emacs. - -;;; TODO: - -;; machine.el -;; machine-case to switch on machine -;; - -;;; Code: - -(require 'cl-lib) - -(defgroup system nil - "System-specific configurations." - :group 'emacs - :prefix "system-") - -;;; Settings - -(defcustom system-load-directory (locate-user-emacs-file "systems" - "~/.emacs-systems") - "The directory where system-specific configurations live." - :type 'file) - -;; These `defcustom's are best-guess defaults. - -(defcustom system-default-font (cond - ((memq system-type '(ms-dos windows-nt)) - "Consolas") - (t "monospace")) - "The font used for the `default' face. -Set this in your system files." - :type 'string) - -(defcustom system-default-height 100 - "The height used for the `default' face. -Set this in your system files." - :type 'number) - -(defcustom system-variable-pitch-font (cond - ((memq system-type '(ms-dos windows-nt)) - "Arial") - (t "sans-serif")) - "The font used for the `variable-pitch' face. -Set this in your system files." - :type 'string) - -(defcustom system-variable-pitch-height 1.0 - "The height used for the `variable-pitch' face. -A floating-point number is recommended, since that makes it -relative to the `default' face height. - -Set this in your system files." - :type 'number) - -(defcustom system-files-order '(:type :name :user) - "The order to load `system-files' in. -The elements of this list correspond to the keys in -`system-system'." - :type '(list (const :tag "System type" :type) - (const :tag "System name" :name) - (const :tag "Current user" :user))) - -;;; Variables - -(defvar system-system nil - "Plist of systems that Emacs is in. -The keys are as follows: - -- :name - `system-name' -- :type - `system-type' -- :user - `user-login-name' - -Each value is made safe to be a file name by passing through -`system--safe'. - -Do not edit this by hand. Instead, call `system-get-systems'.") - -(defvar system-files nil - "List of files to load for system-specific configuration. -Do not edit this by hand. Instead, call `system-get-system-files'.") - - -;;; Functions - -(defun system--warn (message &rest args) - "Display a system-file warning message. -This function is like `warn', except it uses a `system' type." - (display-warning 'system (apply #'format-message message args))) - -(defun system--safe (str) - "Make STR safe for a file name." - (let ((bad-char-regexp )) - (downcase (string-trim - (replace-regexp-in-string "[#%&{}\$!'\":@<>*?/ \r\n\t+`|=]+" - "-" str) - "-" "-")))) - -(defun system-get-systems () - "Determine the current system(s). -This system updates `system-system', which see." - ;; Add system-name - (setf (plist-get system-system :name) - (intern (system--safe (system-name)))) - ;; Add system-type - (setf (plist-get system-system :type) - (intern (system--safe (symbol-name system-type)))) - ;; Add current user - (setf (plist-get system-system :user) - ;; Use `user-real-login-name' in case Emacs gets called under su. - (intern (system--safe (user-real-login-name)))) - system-system) - -(defun system-get-files () - "Determine the current systems' load-files. -The system load-files should live in `system-load-directory', and -named using either the raw name given by the values of -`system-system', or that name prepended with the type, e.g., -\"name-bob.el\", for a system named \"bob\". - -The second form of file-name is to work around name collisions, -e.g. if a there's a user named \"bob\" and a system named -\"bob\". - -This function updates `system-files'." - ;; Get systems - (system-get-systems) - ;; Re-set `system-files' - (setq system-files nil) - - (let (ret) - (dolist (key (reverse system-files-order)) - (let* ((val (plist-get system-system key)) - (key-val (intern (system--safe (format "%s-%s" key val))))) - (push (list key-val val) ret))) - - ;; Update `system-files'. - (setq system-files ret))) - -;;;###autoload -(defun system-settings-load (&optional error nomessage) - "Load system settings from `system-files'. -Each list in `system-files' will be considered item-by-item; the -first found file in each will be loaded. - -ERROR determines how to deal with errors: if nil, warn the user -when no system-files can be found or when the system being used -cannot be determined. If t, these warnings are elevated to -errors. Any other value ignores the warnings completely. - -NOMESSAGE is passed directly to `load'." - (system-get-files) - (if system-files - (let (files-loaded) - (dolist (ss system-files) - (catch :done - (dolist (s ss) - (let ((fn (expand-file-name (format "%s" s) - system-load-directory))) - (when (load fn t nomessage) - (push fn files-loaded) - (throw :done nil)))))) - (unless files-loaded - (cond ((eq error t) (error "Error loading system-files.") - (null error) (system--warn "Couldn't load system-files.")))) - files-loaded) - (funcall (cond ((eq error t) #'error) - ((null error) #'system--warn) - (t #'ignore)) - "Couldn't determine the system being used."))) - -(provide 'system) -;;; system.el ends here diff --git a/lisp/user-save.el b/lisp/user-save.el deleted file mode 100644 index 674abac..0000000 --- a/lisp/user-save.el +++ /dev/null @@ -1,137 +0,0 @@ -;;; user-save.el --- Do things when explicitly saving files -*- lexical-binding: t; -*- - -;; Copyright (C) 2021--2022 Case Duckworth -;; URL: ... -;; Version: 0.1.0 -;; Package-Requires: ((emacs "24.3")) -;; Keywords: files - -;;; Commentary: - -;; Because `super-save-mode' automatically saves every time we move away from a -;; buffer, it tends to run a lot of `before-save-hook's that don't need to be -;; run that often. For that reason, I'm writing a mode where C-x C-s saves -;; /and/ runs all the "real" before-save-hooks, so that super-save won't -;; automatically do things like format the buffer all the time. - -;;; Code: - -(require 'cl-lib) - -(defgroup user-save nil - "Group for `user-save-mode' customizations." - :group 'files - :prefix "user-save-") - -(defcustom user-save-hook-into-kill-emacs nil - "Add a hook to perform `user-save' to `kill-emacs-hook'. -This option is only useful is `user-save-mode' is active when -Emacs is killed." - :type 'boolean) - -(defcustom user-save-inhibit-modes '(special-mode) - "List of modes to inhibit `user-save-mode' from activation in." - :type '(repeat symbol)) - -(defcustom user-save-inhibit-predicates '(user-save-non-file-buffer-p) - "List of predicates to inhibit `user-save-mode' from activation. -Each predicate will be called with no arguments, and if it -returns t, will inhibit `user-save-mode' from activating." - :type '(repeat function)) - -(defcustom user-save-before-save-hook nil - "Hook to run before the user, not Emacs, saves the buffer." - :type 'hook) - -(defcustom user-save-after-save-hook nil - "Hook to run after the user, not Emacs, saves the buffer." - :type 'hook) - -(defvar user-save-mode-map (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-x C-s") #'user-save-buffer) - (define-key map (kbd "C-x s") #'user-save-some-buffers) - map) - "Keymap for `user-save-mode'. -This map shadows the default map for `save-buffer'.") - -(defun user-save-run-hooks (which &rest _) - "Run the hooks in one of the user-save-hooks. -If WHICH is `'before', run `user-save-before-save-hook'; -if it's `after', run `user-save-after-save-hook'. -This does /not/ also save the buffer." - (with-demoted-errors "User-save-hook error: %S" - (run-hooks (intern (format "user-save-%s-save-hook" which))))) - -(defun user-save-non-file-buffer-p (&optional buffer-or-name) - "Return whether BUFFER-OR-NAME is a non-file buffer. -BUFFER-OR-NAME, if omitted, defaults to the current buffer." - (with-current-buffer (or buffer-or-name (current-buffer)) - (not (buffer-file-name)))) - -(defun user-save-buffer (&optional arg) - "Save current buffer in visited file if modified. -This function is precisely the same as `save-buffer', but with -one modification: it also runs functions in `user-save-hook'. -This means that if you have some functionality in Emacs to -automatically save buffers periodically, but have hooks you want -to automatically run when the buffer saves that are -computationally expensive or just aren't something you want to -run all the time, put them in `user-save-hook'. - -ARG is passed directly to `save-buffer'." - (interactive '(called-interactively)) - (message "User-Saving the buffer...") - (user-save-run-hooks 'before) - (save-buffer arg) - (user-save-run-hooks 'after) - (message "User-Saving the buffer...Done.")) - -(defun user-save-some-buffers (&optional pred) - "Save some buffers as though the user saved them. -This function does not ask the user about each buffer, but PRED -is used in almost the same way as `save-some-buffers': if it's -nil or t, it will save all file-visiting modified buffers; if -it's a zero-argument function, that will be called to determine -whether the buffer needs to be saved." - ;; This could maybe be much better. - (interactive "P") - (unless pred (setq pred save-some-buffers-default-predicate)) - (dolist (buf (buffer-list)) - (with-current-buffer buf - (when (and (buffer-modified-p) - (buffer-file-name) - (or (null pred) - (if (functionp pred) (funcall pred) pred))) - (user-save-buffer))))) - -;;;###autoload -(define-minor-mode user-save-mode - "Mode to enable an an extra user-save hook." - :lighter " US" - :keymap user-save-mode-map) - -;;;###autoload -(defun user-save-mode-disable () - "Turn off `user-save-mode' in the current buffer." - (user-save-mode -1)) - -;;;###autoload -(defun user-save-mode-in-some-buffers () - "Enable `user-save-mode', but only in some buffers. -The mode will not be enabled in buffers derived from modes in -`user-save-inhibit-modes', those for which -`user-save-inhibit-predicates' return t, or in the minibuffer." - (unless (or (minibufferp) - (cl-some #'derived-mode-p user-save-inhibit-modes) - (run-hook-with-args-until-failure 'user-save-inhibit-predicates)) - (user-save-mode +1))) - -;;;###autoload -(define-globalized-minor-mode user-save-global-mode user-save-mode user-save-mode-in-some-buffers - (if user-save-global-mode - (when user-save-hook-into-kill-emacs - (add-hook 'kill-emacs-hook #'user-save-some-buffers)) - (remove-hook 'kill-emacs-hook #'user-save-some-buffers))) - -(provide 'user-save) -;;; user-save.el ends here diff --git a/lisp/yoke.el b/lisp/yoke.el new file mode 100644 index 0000000..2673e5e --- /dev/null +++ b/lisp/yoke.el @@ -0,0 +1,125 @@ +;;; yoke.el --- yoke packages in to your editing system -*- lexical-binding: t; -*- +;; by C. Duckworth +(provide 'yoke) +(require 'cl-lib) + +(defgroup yoke nil + "Customizations for yoke, a package manager thing." + :group 'applications + :prefix "yoke-") + +(defcustom yoke-dir (locate-user-emacs-file "yoke") + "Where yoke packages live." + :type 'file) + +(defun yoke-repo-local-p (repo) + (string-match-p (rx bos (or "." "~" "/")) repo)) + +(defun yoke-repo-dir (pkg repo) + (if (yoke-repo-local-p repo) + (expand-file-name repo) + (expand-file-name (format "%s" pkg) yoke-dir))) + +(defun yoke-git (repo &optional dir) + "Git REPO from the internet and put it into `yoke-dir'. +If DIR is passed, clone there; otherwise just clone. Return the +directory created." + (let ((dir (or dir (yoke-repo-dir (file-name-nondirectory repo) repo)))) + (unless (or (yoke-repo-local-p repo) (file-exists-p dir)) + (message "Downloading %S..." repo) + (call-process "git" nil (get-buffer-create "*yoke*") nil + "clone" repo dir) + (message "Downloading %S... done" repo)) + dir)) + +(defun yoke-lasso (pkg repo) + "Add PKG to `load-path' so it can be used. +If PKG is not installed, install it from REPO. Packages will be +installed to `yoke-dir'." + (let* ((dir (yoke-repo-dir pkg repo))) + (yoke-git repo dir) + (cond + ((file-exists-p dir) + (add-to-list 'load-path dir) + ;; This bit is stolen from `straight'. + (eval-and-compile (require 'autoload)) + (let ((generated-autoload-file + (expand-file-name (format "%s-autoloads.el" pkg) dir)) + (backup-inhibited t) + (version-control 'never) + (message-log-max nil) + (inhibit-message t)) + (unless (file-exists-p generated-autoload-file) + (let ((find-file-hook nil) + (write-file-functions nil) + (debug-on-error nil) + (left-margin 0)) + (if (fboundp 'make-directory-autoloads) + (make-directory-autoloads dir generated-autoload-file) + (and (fboundp 'update-directory-autoloads) + (update-directory-autoloads dir))))) + (when-let ((buf (find-buffer-visiting generated-autoload-file))) + (kill-buffer buf)) + (load generated-autoload-file :noerror :nomessage))) + (t (user-error "Directory \"%s\" doesn't exist." dir))) + dir)) + +(defun yoke-get (key args) + "Get KEY's value from ARGS, or return nil. +Similar-ish to `plist-get', but works on non-proper plists." + (cond + ((null args) nil) + ((eq key (car args)) (cadr args)) + (t (yoke-get key (cdr args))))) + +(defmacro when1 (test &rest body) + "Like `when', but return the value of the test." + (declare (indent 1)) + (let ((g (gensym))) + `(let ((,g ,test)) + (when ,g + ,@body + ,g)))) + +(defun delete2 (list &rest elems) + "Delete ELEM and the next item from LIST." + (let ((r nil)) + (while (consp list) + (if (member (car list) elems) + (setq list (cdr list)) + (setq r (cons (car list) r))) + (setq list (cdr list))) + (reverse r))) + +(defun yoke-pkg-name (pkg) + (intern (format "yoke:%s" pkg))) + +(cl-defmacro yoke (pkg + &optional repo + &body body + &key + requires ; :requires ((PKG REPO)...) + dest ; :dest DESTINATION + (when t whenp) ; :when PREDICATE + (unless nil unlessp) ; :unless PREDICATE + &allow-other-keys) + "Yoke a PKG into your Emacs session." + (declare (indent defun)) + (let ((name (yoke-pkg-name pkg))) + `(cl-block ,name + (condition-case e + (let ((*yoke-name* ',name) + (*yoke-repo* ,repo) + (*yoke-dest* ,(when repo `(yoke-repo-dir ',pkg ,repo)))) + ,@(list (cond + ((and whenp unlessp) + `(when (or (not ,when) ,unless) + (cl-return-from ,name nil))) + (whenp `(unless ,when (cl-return-from ,name nil))) + (unlessp `(when ,unless (cl-return-from ,name nil))))) + ,@(cl-loop for (pkg repo) in requires + collect `(or (yoke-lasso ',pkg ,repo) + (cl-return-from ,name nil))) + ,@(when repo `((yoke-lasso ',pkg ,repo))) + ,@(delete2 body :requires :when :unless)) + (t (message "%s: %S" ',name e)))))) diff --git a/machines/bob.el b/machines/bob.el deleted file mode 100644 index a408e5c..0000000 --- a/machines/bob.el +++ /dev/null @@ -1,69 +0,0 @@ -;;; bob.el --- Customizations for "bob" -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -(require 'acdw) -(require 'machine) - -(defcustom +bob-face-plist - '( :dejavu ("DejaVu Sans Mono" "DejaVu Sans") - :iosevka ("Iosevka Comfy Wide" "Iosevka Comfy Duo") - :plex ("IBM Plex Mono" "IBM Plex Serif") - :go/djv ("Go Mono" "DejaVu Sans") - :tt (("TT2020Base" 120) "TT2020 Base Style E") ; no italic - :courier ("Courier Prime Code" "Courier Prime") - :gaegu (("Gaegu" 140) "Gaegu") ; no italic - :comic (("Comic Code" 100) "Comic Code") - :comic/fantasque (("Comic Code" 100) "Fantasque Sans Mono") - :terminus (("Terminus (TTF)" 120) "Terminus (TTF)") - :cmu (("CMU Typewriter Text" 160) "CMU Concrete") - :apl (("APL386 Unicode" 120) "Comic Code") - ) - "A plist of possible font combinations.") - -(defcustom +bob-face-pair :comic ;; (+bob-set-faces) - "The index of `+bob-face-pairs' to use.") - -(defun +bob-set-faces (&rest _) - (let* ((face-pair (plist-get +bob-face-plist +bob-face-pair)) - (base-face (if (stringp (car face-pair)) - (car face-pair) - (caar face-pair))) - (var-face (if (stringp (cadr face-pair)) - (cadr face-pair) - (caadr face-pair))) - (base-size (or (ignore-errors (cadar face-pair)) - 100)) - (var-size (or (ignore-errors (cadadr face-pair)) - 1.0)) - (italic-face nil) - ;; (bold-face nil) - (mono-face nil)) - (+set-faces - `((default - :family ,base-face - :height ,base-size - :weight regular) - (bold :family ,(or (bound-and-true-p bold-face) base-face) - :weight extra-bold) - (italic :family ,(or (bound-and-true-p italic-face) base-face) - :weight normal - :slant italic) - (fixed-pitch :family ,(or (bound-and-true-p mono-face) base-face) - :height 1.0) - (variable-pitch - :family ,(or var-face base-face) - :height ,var-size - ;; :weight medium - ) - ;; (org-italic - ;; :family ,(or var-face base-face) - ;; :slant italic) - )))) - -;; Other ideas: [[https://twitter.com/NPRougier/status/1488570192561160195][from Nic Rougier]] -(add-hook 'machine-after-load-theme-hook #'+bob-set-faces) - -;; bob.el ends here (+bob-set-faces) diff --git a/machines/gnu-linux.el b/machines/gnu-linux.el deleted file mode 100644 index 309ca34..0000000 --- a/machines/gnu-linux.el +++ /dev/null @@ -1,5 +0,0 @@ -;;; linux.el -*- lexical-binding: t; -*- - -(setq machine-default-height 105) - -;;; linux.el ends here diff --git a/machines/larry.el b/machines/larry.el deleted file mode 100644 index ba4edb2..0000000 --- a/machines/larry.el +++ /dev/null @@ -1,13 +0,0 @@ -;;; larry.el --- Customizations for "larry" -*- lexical-binding: t; -*- - -;;; Code: - -(require 'acdw) -(require 'machine) - -(add-function :after machine-after-load-theme - (defun +larry-set-faces (&rest _) - (+set-faces - `((default :family "DejaVu Sans Mono") - (fixed-pitch :family "DejaVu Sans Mono") - (variable-pitch :family "DejaVu Sans"))))) diff --git a/machines/windows-nt.el b/machines/windows-nt.el deleted file mode 100644 index a95754e..0000000 --- a/machines/windows-nt.el +++ /dev/null @@ -1,23 +0,0 @@ -;;; windows.el --- Windows settings! -*- lexical-binding: t; -*- - -;; Annoying gnu-tls bug; I "always" trust the certificate anyway, so let's be -;; insecure. -(setq network-security-level 'low - debug-on-error t) - -;; Fonts - -(setq machine-default-font "Cascadia Mono" - machine-default-height 90 - machine-variable-pitch-font "Carlito" - machine-variable-pitch-height 1.2) - -;; Add C:\Program Files\* and C:\Program Files (x86)\* to exec-path -(dolist (path (append (file-expand-wildcards "C:/Program Files/*") - (file-expand-wildcards "c:/Program Files (x86)/*") - ;; Others... - (save-match-data - (split-string (getenv "PATH") ";" t)))) - (add-to-list 'exec-path path :append)) - -;;; windows.el ends here diff --git a/readme.md b/readme.md deleted file mode 100644 index 6573e43..0000000 --- a/readme.md +++ /dev/null @@ -1,8 +0,0 @@ -# ~/.emacs - -This is my Emacs config. There are many like it, but this one is mine. - -## interesting bits - -Check out the `lisp/` folder, there's a bunch of cool stuff there. My -`early-init.el` is pretty static, but interesting stuff happens in `init.el`. diff --git a/snippets/emacs-lisp-mode/+feature b/snippets/emacs-lisp-mode/+feature deleted file mode 100644 index 1b8a721..0000000 --- a/snippets/emacs-lisp-mode/+feature +++ /dev/null @@ -1,14 +0,0 @@ -# -*- mode: snippet -*- -# name: +feature -# key: +f -# -- -;;; `(file-name-nondirectory (buffer-file-name))` --- ${1:Title} -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -$0 - -(provide '`(file-name-nondirectory (file-name-sans-extension (buffer-file-name)))`) -;;; `(file-name-nondirectory (buffer-file-name))` ends here \ No newline at end of file diff --git a/snippets/fundamental-mode/gpl3 b/snippets/fundamental-mode/gpl3 deleted file mode 100644 index 2e02b3d..0000000 --- a/snippets/fundamental-mode/gpl3 +++ /dev/null @@ -1,677 +0,0 @@ -# key: gpl3 -# name: gpl3 -# -- -GNU GENERAL PUBLIC LICENSE -Version 3, 29 June 2007 - -Copyright (C) ${1:`(format-time-string "%Y")`} ${2:`user-full-name`} <${3:`user-mail-address`}> -Everyone is permitted to copy and distribute verbatim copies -of this license document, but changing it is not allowed. - -Preamble - -The GNU General Public License is a free, copyleft license for -software and other kinds of works. - -The licenses for most software and other practical works are designed -to take away your freedom to share and change the works. By contrast, -the GNU General Public License is intended to guarantee your freedom to -share and change all versions of a program--to make sure it remains free -software for all its users. We, the Free Software Foundation, use the -GNU General Public License for most of our software; it applies also to -any other work released this way by its authors. You can apply it to -your programs, too. - -When we speak of free software, we are referring to freedom, not -price. Our General Public Licenses are designed to make sure that you -have the freedom to distribute copies of free software (and charge for -them if you wish), that you receive source code or can get it if you -want it, that you can change the software or use pieces of it in new -free programs, and that you know you can do these things. - -To protect your rights, we need to prevent others from denying you -these rights or asking you to surrender the rights. Therefore, you have -certain responsibilities if you distribute copies of the software, or if -you modify it: responsibilities to respect the freedom of others. - -For example, if you distribute copies of such a program, whether -gratis or for a fee, you must pass on to the recipients the same -freedoms that you received. You must make sure that they, too, receive -or can get the source code. And you must show them these terms so they -know their rights. - -Developers that use the GNU GPL protect your rights with two steps: -(1) assert copyright on the software, and (2) offer you this License -giving you legal permission to copy, distribute and/or modify it. - -For the developers' and authors' protection, the GPL clearly explains -that there is no warranty for this free software. For both users' and -authors' sake, the GPL requires that modified versions be marked as -changed, so that their problems will not be attributed erroneously to -authors of previous versions. - -Some devices are designed to deny users access to install or run -modified versions of the software inside them, although the manufacturer -can do so. This is fundamentally incompatible with the aim of -protecting users' freedom to change the software. The systematic -pattern of such abuse occurs in the area of products for individuals to -use, which is precisely where it is most unacceptable. Therefore, we -have designed this version of the GPL to prohibit the practice for those -products. If such problems arise substantially in other domains, we -stand ready to extend this provision to those domains in future versions -of the GPL, as needed to protect the freedom of users. - -Finally, every program is threatened constantly by software patents. -States should not allow patents to restrict development and use of -software on general-purpose computers, but in those that do, we wish to -avoid the special danger that patents applied to a free program could -make it effectively proprietary. To prevent this, the GPL assures that -patents cannot be used to render the program non-free. - -The precise terms and conditions for copying, distribution and -modification follow. - -TERMS AND CONDITIONS - -0. Definitions. - -"This License" refers to version 3 of the GNU General Public License. - -"Copyright" also means copyright-like laws that apply to other kinds of -works, such as semiconductor masks. - -"The Program" refers to any copyrightable work licensed under this -License. Each licensee is addressed as "you". "Licensees" and -"recipients" may be individuals or organizations. - -To "modify" a work means to copy from or adapt all or part of the work -in a fashion requiring copyright permission, other than the making of an -exact copy. The resulting work is called a "modified version" of the -earlier work or a work "based on" the earlier work. - -A "covered work" means either the unmodified Program or a work based -on the Program. - -To "propagate" a work means to do anything with it that, without -permission, would make you directly or secondarily liable for -infringement under applicable copyright law, except executing it on a -computer or modifying a private copy. Propagation includes copying, -distribution (with or without modification), making available to the -public, and in some countries other activities as well. - -To "convey" a work means any kind of propagation that enables other -parties to make or receive copies. Mere interaction with a user through -a computer network, with no transfer of a copy, is not conveying. - -An interactive user interface displays "Appropriate Legal Notices" -to the extent that it includes a convenient and prominently visible -feature that (1) displays an appropriate copyright notice, and (2) -tells the user that there is no warranty for the work (except to the -extent that warranties are provided), that licensees may convey the -work under this License, and how to view a copy of this License. If -the interface presents a list of user commands or options, such as a -menu, a prominent item in the list meets this criterion. - -1. Source Code. - -The "source code" for a work means the preferred form of the work -for making modifications to it. "Object code" means any non-source -form of a work. - -A "Standard Interface" means an interface that either is an official -standard defined by a recognized standards body, or, in the case of -interfaces specified for a particular programming language, one that -is widely used among developers working in that language. - -The "System Libraries" of an executable work include anything, other -than the work as a whole, that (a) is included in the normal form of -packaging a Major Component, but which is not part of that Major -Component, and (b) serves only to enable use of the work with that -Major Component, or to implement a Standard Interface for which an -implementation is available to the public in source code form. A -"Major Component", in this context, means a major essential component -(kernel, window system, and so on) of the specific operating system -(if any) on which the executable work runs, or a compiler used to -produce the work, or an object code interpreter used to run it. - -The "Corresponding Source" for a work in object code form means all -the source code needed to generate, install, and (for an executable -work) run the object code and to modify the work, including scripts to -control those activities. However, it does not include the work's -System Libraries, or general-purpose tools or generally available free -programs which are used unmodified in performing those activities but -which are not part of the work. For example, Corresponding Source -includes interface definition files associated with source files for -the work, and the source code for shared libraries and dynamically -linked subprograms that the work is specifically designed to require, -such as by intimate data communication or control flow between those -subprograms and other parts of the work. - -The Corresponding Source need not include anything that users -can regenerate automatically from other parts of the Corresponding -Source. - -The Corresponding Source for a work in source code form is that -same work. - -2. Basic Permissions. - -All rights granted under this License are granted for the term of -copyright on the Program, and are irrevocable provided the stated -conditions are met. This License explicitly affirms your unlimited -permission to run the unmodified Program. The output from running a -covered work is covered by this License only if the output, given its -content, constitutes a covered work. This License acknowledges your -rights of fair use or other equivalent, as provided by copyright law. - -You may make, run and propagate covered works that you do not -convey, without conditions so long as your license otherwise remains -in force. You may convey covered works to others for the sole purpose -of having them make modifications exclusively for you, or provide you -with facilities for running those works, provided that you comply with -the terms of this License in conveying all material for which you do -not control copyright. Those thus making or running the covered works -for you must do so exclusively on your behalf, under your direction -and control, on terms that prohibit them from making any copies of -your copyrighted material outside their relationship with you. - -Conveying under any other circumstances is permitted solely under -the conditions stated below. Sublicensing is not allowed; section 10 -makes it unnecessary. - -3. Protecting Users' Legal Rights From Anti-Circumvention Law. - -No covered work shall be deemed part of an effective technological -measure under any applicable law fulfilling obligations under article -11 of the WIPO copyright treaty adopted on 20 December 1996, or -similar laws prohibiting or restricting circumvention of such -measures. - -When you convey a covered work, you waive any legal power to forbid -circumvention of technological measures to the extent such circumvention -is effected by exercising rights under this License with respect to -the covered work, and you disclaim any intention to limit operation or -modification of the work as a means of enforcing, against the work's -users, your or third parties' legal rights to forbid circumvention of -technological measures. - -4. Conveying Verbatim Copies. - -You may convey verbatim copies of the Program's source code as you -receive it, in any medium, provided that you conspicuously and -appropriately publish on each copy an appropriate copyright notice; -keep intact all notices stating that this License and any -non-permissive terms added in accord with section 7 apply to the code; -keep intact all notices of the absence of any warranty; and give all -recipients a copy of this License along with the Program. - -You may charge any price or no price for each copy that you convey, -and you may offer support or warranty protection for a fee. - -5. Conveying Modified Source Versions. - -You may convey a work based on the Program, or the modifications to -produce it from the Program, in the form of source code under the -terms of section 4, provided that you also meet all of these conditions: - -a) The work must carry prominent notices stating that you modified -it, and giving a relevant date. - -b) The work must carry prominent notices stating that it is -released under this License and any conditions added under section -7. This requirement modifies the requirement in section 4 to -"keep intact all notices". - -c) You must license the entire work, as a whole, under this -License to anyone who comes into possession of a copy. This -License will therefore apply, along with any applicable section 7 -additional terms, to the whole of the work, and all its parts, -regardless of how they are packaged. This License gives no -permission to license the work in any other way, but it does not -invalidate such permission if you have separately received it. - -d) If the work has interactive user interfaces, each must display -Appropriate Legal Notices; however, if the Program has interactive -interfaces that do not display Appropriate Legal Notices, your -work need not make them do so. - -A compilation of a covered work with other separate and independent -works, which are not by their nature extensions of the covered work, -and which are not combined with it such as to form a larger program, -in or on a volume of a storage or distribution medium, is called an -"aggregate" if the compilation and its resulting copyright are not -used to limit the access or legal rights of the compilation's users -beyond what the individual works permit. Inclusion of a covered work -in an aggregate does not cause this License to apply to the other -parts of the aggregate. - -6. Conveying Non-Source Forms. - -You may convey a covered work in object code form under the terms -of sections 4 and 5, provided that you also convey the -machine-readable Corresponding Source under the terms of this License, -in one of these ways: - -a) Convey the object code in, or embodied in, a physical product -(including a physical distribution medium), accompanied by the -Corresponding Source fixed on a durable physical medium -customarily used for software interchange. - -b) Convey the object code in, or embodied in, a physical product -(including a physical distribution medium), accompanied by a -written offer, valid for at least three years and valid for as -long as you offer spare parts or customer support for that product -model, to give anyone who possesses the object code either (1) a -copy of the Corresponding Source for all the software in the -product that is covered by this License, on a durable physical -medium customarily used for software interchange, for a price no -more than your reasonable cost of physically performing this -conveying of source, or (2) access to copy the -Corresponding Source from a network server at no charge. - -c) Convey individual copies of the object code with a copy of the -written offer to provide the Corresponding Source. This -alternative is allowed only occasionally and noncommercially, and -only if you received the object code with such an offer, in accord -with subsection 6b. - -d) Convey the object code by offering access from a designated -place (gratis or for a charge), and offer equivalent access to the -Corresponding Source in the same way through the same place at no -further charge. You need not require recipients to copy the -Corresponding Source along with the object code. If the place to -copy the object code is a network server, the Corresponding Source -may be on a different server (operated by you or a third party) -that supports equivalent copying facilities, provided you maintain -clear directions next to the object code saying where to find the -Corresponding Source. Regardless of what server hosts the -Corresponding Source, you remain obligated to ensure that it is -available for as long as needed to satisfy these requirements. - -e) Convey the object code using peer-to-peer transmission, provided -you inform other peers where the object code and Corresponding -Source of the work are being offered to the general public at no -charge under subsection 6d. - -A separable portion of the object code, whose source code is excluded -from the Corresponding Source as a System Library, need not be -included in conveying the object code work. - -A "User Product" is either (1) a "consumer product", which means any -tangible personal property which is normally used for personal, family, -or household purposes, or (2) anything designed or sold for incorporation -into a dwelling. In determining whether a product is a consumer product, -doubtful cases shall be resolved in favor of coverage. For a particular -product received by a particular user, "normally used" refers to a -typical or common use of that class of product, regardless of the status -of the particular user or of the way in which the particular user -actually uses, or expects or is expected to use, the product. A product -is a consumer product regardless of whether the product has substantial -commercial, industrial or non-consumer uses, unless such uses represent -the only significant mode of use of the product. - -"Installation Information" for a User Product means any methods, -procedures, authorization keys, or other information required to install -and execute modified versions of a covered work in that User Product from -a modified version of its Corresponding Source. The information must -suffice to ensure that the continued functioning of the modified object -code is in no case prevented or interfered with solely because -modification has been made. - -If you convey an object code work under this section in, or with, or -specifically for use in, a User Product, and the conveying occurs as -part of a transaction in which the right of possession and use of the -User Product is transferred to the recipient in perpetuity or for a -fixed term (regardless of how the transaction is characterized), the -Corresponding Source conveyed under this section must be accompanied -by the Installation Information. But this requirement does not apply -if neither you nor any third party retains the ability to install -modified object code on the User Product (for example, the work has -been installed in ROM). - -The requirement to provide Installation Information does not include a -requirement to continue to provide support service, warranty, or updates -for a work that has been modified or installed by the recipient, or for -the User Product in which it has been modified or installed. Access to a -network may be denied when the modification itself materially and -adversely affects the operation of the network or violates the rules and -protocols for communication across the network. - -Corresponding Source conveyed, and Installation Information provided, -in accord with this section must be in a format that is publicly -documented (and with an implementation available to the public in -source code form), and must require no special password or key for -unpacking, reading or copying. - -7. Additional Terms. - -"Additional permissions" are terms that supplement the terms of this -License by making exceptions from one or more of its conditions. -Additional permissions that are applicable to the entire Program shall -be treated as though they were included in this License, to the extent -that they are valid under applicable law. If additional permissions -apply only to part of the Program, that part may be used separately -under those permissions, but the entire Program remains governed by -this License without regard to the additional permissions. - -When you convey a copy of a covered work, you may at your option -remove any additional permissions from that copy, or from any part of -it. (Additional permissions may be written to require their own -removal in certain cases when you modify the work.) You may place -additional permissions on material, added by you to a covered work, -for which you have or can give appropriate copyright permission. - -Notwithstanding any other provision of this License, for material you -add to a covered work, you may (if authorized by the copyright holders of -that material) supplement the terms of this License with terms: - -a) Disclaiming warranty or limiting liability differently from the -terms of sections 15 and 16 of this License; or - -b) Requiring preservation of specified reasonable legal notices or -author attributions in that material or in the Appropriate Legal -Notices displayed by works containing it; or - -c) Prohibiting misrepresentation of the origin of that material, or -requiring that modified versions of such material be marked in -reasonable ways as different from the original version; or - -d) Limiting the use for publicity purposes of names of licensors or -authors of the material; or - -e) Declining to grant rights under trademark law for use of some -trade names, trademarks, or service marks; or - -f) Requiring indemnification of licensors and authors of that -material by anyone who conveys the material (or modified versions of -it) with contractual assumptions of liability to the recipient, for -any liability that these contractual assumptions directly impose on -those licensors and authors. - -All other non-permissive additional terms are considered "further -restrictions" within the meaning of section 10. If the Program as you -received it, or any part of it, contains a notice stating that it is -governed by this License along with a term that is a further -restriction, you may remove that term. If a license document contains -a further restriction but permits relicensing or conveying under this -License, you may add to a covered work material governed by the terms -of that license document, provided that the further restriction does -not survive such relicensing or conveying. - -If you add terms to a covered work in accord with this section, you -must place, in the relevant source files, a statement of the -additional terms that apply to those files, or a notice indicating -where to find the applicable terms. - -Additional terms, permissive or non-permissive, may be stated in the -form of a separately written license, or stated as exceptions; -the above requirements apply either way. - -8. Termination. - -You may not propagate or modify a covered work except as expressly -provided under this License. Any attempt otherwise to propagate or -modify it is void, and will automatically terminate your rights under -this License (including any patent licenses granted under the third -paragraph of section 11). - -However, if you cease all violation of this License, then your -license from a particular copyright holder is reinstated (a) -provisionally, unless and until the copyright holder explicitly and -finally terminates your license, and (b) permanently, if the copyright -holder fails to notify you of the violation by some reasonable means -prior to 60 days after the cessation. - -Moreover, your license from a particular copyright holder is -reinstated permanently if the copyright holder notifies you of the -violation by some reasonable means, this is the first time you have -received notice of violation of this License (for any work) from that -copyright holder, and you cure the violation prior to 30 days after -your receipt of the notice. - -Termination of your rights under this section does not terminate the -licenses of parties who have received copies or rights from you under -this License. If your rights have been terminated and not permanently -reinstated, you do not qualify to receive new licenses for the same -material under section 10. - -9. Acceptance Not Required for Having Copies. - -You are not required to accept this License in order to receive or -run a copy of the Program. Ancillary propagation of a covered work -occurring solely as a consequence of using peer-to-peer transmission -to receive a copy likewise does not require acceptance. However, -nothing other than this License grants you permission to propagate or -modify any covered work. These actions infringe copyright if you do -not accept this License. Therefore, by modifying or propagating a -covered work, you indicate your acceptance of this License to do so. - -10. Automatic Licensing of Downstream Recipients. - -Each time you convey a covered work, the recipient automatically -receives a license from the original licensors, to run, modify and -propagate that work, subject to this License. You are not responsible -for enforcing compliance by third parties with this License. - -An "entity transaction" is a transaction transferring control of an -organization, or substantially all assets of one, or subdividing an -organization, or merging organizations. If propagation of a covered -work results from an entity transaction, each party to that -transaction who receives a copy of the work also receives whatever -licenses to the work the party's predecessor in interest had or could -give under the previous paragraph, plus a right to possession of the -Corresponding Source of the work from the predecessor in interest, if -the predecessor has it or can get it with reasonable efforts. - -You may not impose any further restrictions on the exercise of the -rights granted or affirmed under this License. For example, you may -not impose a license fee, royalty, or other charge for exercise of -rights granted under this License, and you may not initiate litigation -(including a cross-claim or counterclaim in a lawsuit) alleging that -any patent claim is infringed by making, using, selling, offering for -sale, or importing the Program or any portion of it. - -11. Patents. - -A "contributor" is a copyright holder who authorizes use under this -License of the Program or a work on which the Program is based. The -work thus licensed is called the contributor's "contributor version". - -A contributor's "essential patent claims" are all patent claims -owned or controlled by the contributor, whether already acquired or -hereafter acquired, that would be infringed by some manner, permitted -by this License, of making, using, or selling its contributor version, -but do not include claims that would be infringed only as a -consequence of further modification of the contributor version. For -purposes of this definition, "control" includes the right to grant -patent sublicenses in a manner consistent with the requirements of -this License. - -Each contributor grants you a non-exclusive, worldwide, royalty-free -patent license under the contributor's essential patent claims, to -make, use, sell, offer for sale, import and otherwise run, modify and -propagate the contents of its contributor version. - -In the following three paragraphs, a "patent license" is any express -agreement or commitment, however denominated, not to enforce a patent -(such as an express permission to practice a patent or covenant not to -sue for patent infringement). To "grant" such a patent license to a -party means to make such an agreement or commitment not to enforce a -patent against the party. - -If you convey a covered work, knowingly relying on a patent license, -and the Corresponding Source of the work is not available for anyone -to copy, free of charge and under the terms of this License, through a -publicly available network server or other readily accessible means, -then you must either (1) cause the Corresponding Source to be so -available, or (2) arrange to deprive yourself of the benefit of the -patent license for this particular work, or (3) arrange, in a manner -consistent with the requirements of this License, to extend the patent -license to downstream recipients. "Knowingly relying" means you have -actual knowledge that, but for the patent license, your conveying the -covered work in a country, or your recipient's use of the covered work -in a country, would infringe one or more identifiable patents in that -country that you have reason to believe are valid. - -If, pursuant to or in connection with a single transaction or -arrangement, you convey, or propagate by procuring conveyance of, a -covered work, and grant a patent license to some of the parties -receiving the covered work authorizing them to use, propagate, modify -or convey a specific copy of the covered work, then the patent license -you grant is automatically extended to all recipients of the covered -work and works based on it. - -A patent license is "discriminatory" if it does not include within -the scope of its coverage, prohibits the exercise of, or is -conditioned on the non-exercise of one or more of the rights that are -specifically granted under this License. You may not convey a covered -work if you are a party to an arrangement with a third party that is -in the business of distributing software, under which you make payment -to the third party based on the extent of your activity of conveying -the work, and under which the third party grants, to any of the -parties who would receive the covered work from you, a discriminatory -patent license (a) in connection with copies of the covered work -conveyed by you (or copies made from those copies), or (b) primarily -for and in connection with specific products or compilations that -contain the covered work, unless you entered into that arrangement, -or that patent license was granted, prior to 28 March 2007. - -Nothing in this License shall be construed as excluding or limiting -any implied license or other defenses to infringement that may -otherwise be available to you under applicable patent law. - -12. No Surrender of Others' Freedom. - -If conditions are imposed on you (whether by court order, agreement or -otherwise) that contradict the conditions of this License, they do not -excuse you from the conditions of this License. If you cannot convey a -covered work so as to satisfy simultaneously your obligations under this -License and any other pertinent obligations, then as a consequence you may -not convey it at all. For example, if you agree to terms that obligate you -to collect a royalty for further conveying from those to whom you convey -the Program, the only way you could satisfy both those terms and this -License would be to refrain entirely from conveying the Program. - -13. Use with the GNU Affero General Public License. - -Notwithstanding any other provision of this License, you have -permission to link or combine any covered work with a work licensed -under version 3 of the GNU Affero General Public License into a single -combined work, and to convey the resulting work. The terms of this -License will continue to apply to the part which is the covered work, -but the special requirements of the GNU Affero General Public License, -section 13, concerning interaction through a network will apply to the -combination as such. - -14. Revised Versions of this License. - -The Free Software Foundation may publish revised and/or new versions of -the GNU General Public License from time to time. Such new versions will -be similar in spirit to the present version, but may differ in detail to -address new problems or concerns. - -Each version is given a distinguishing version number. If the -Program specifies that a certain numbered version of the GNU General -Public License "or any later version" applies to it, you have the -option of following the terms and conditions either of that numbered -version or of any later version published by the Free Software -Foundation. If the Program does not specify a version number of the -GNU General Public License, you may choose any version ever published -by the Free Software Foundation. - -If the Program specifies that a proxy can decide which future -versions of the GNU General Public License can be used, that proxy's -public statement of acceptance of a version permanently authorizes you -to choose that version for the Program. - -Later license versions may give you additional or different -permissions. However, no additional obligations are imposed on any -author or copyright holder as a result of your choosing to follow a -later version. - -15. Disclaimer of Warranty. - -THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY -APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT -HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY -OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, -THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM -IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF -ALL NECESSARY SERVICING, REPAIR OR CORRECTION. - -16. Limitation of Liability. - -IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING -WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS -THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY -GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE -USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF -DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD -PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), -EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF -SUCH DAMAGES. - -17. Interpretation of Sections 15 and 16. - -If the disclaimer of warranty and limitation of liability provided -above cannot be given local legal effect according to their terms, -reviewing courts shall apply local law that most closely approximates -an absolute waiver of all civil liability in connection with the -Program, unless a warranty or assumption of liability accompanies a -copy of the Program in return for a fee. - -END OF TERMS AND CONDITIONS - -How to Apply These Terms to Your New Programs - -If you develop a new program, and you want it to be of the greatest -possible use to the public, the best way to achieve this is to make it -free software which everyone can redistribute and change under these terms. - -To do so, attach the following notices to the program. It is safest -to attach them to the start of each source file to most effectively -state the exclusion of warranty; and each file should have at least -the "copyright" line and a pointer to where the full notice is found. - -A fancy and fast mode-line inspired by minimalism design. -Copyright (C) 2018 Vincent Zhang - -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 . - -Also add information on how to contact you by electronic and paper mail. - -If the program does terminal interaction, make it output a short -notice like this when it starts in an interactive mode: - -doom-modeline Copyright (C) 2018 Vincent Zhang -This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. -This is free software, and you are welcome to redistribute it -under certain conditions; type `show c' for details. - -The hypothetical commands `show w' and `show c' should show the appropriate -parts of the General Public License. Of course, your program's commands -might be different; for a GUI interface, you would use an "about box". - -You should also get your employer (if you work as a programmer) or school, -if any, to sign a "copyright disclaimer" for the program, if necessary. -For more information on this, and how to apply and follow the GNU GPL, see -. - -The GNU General Public License does not permit incorporating your program -into proprietary programs. If your program is a subroutine library, you -may consider it more useful to permit linking proprietary applications with -the library. If this is what you want to do, use the GNU Lesser General -Public License instead of this License. But first, please read -. diff --git a/snippets/org-mode/sc b/snippets/org-mode/sc deleted file mode 100644 index f536dae..0000000 --- a/snippets/org-mode/sc +++ /dev/null @@ -1,4 +0,0 @@ -# key: sc -# name: sc -# -- -[sc name="${1: $(yas-choose-value '("total-recovery" "br-location-page" "_locationnameslisted" "organizations-helped" "other-results" "truck-accident-results" "car-wreck-results" "personal-injury-results" "number-locations" "experience" "employees" "mon-number" "mon-address" "lc-number" "lc-address" "ham-number" "ham-address" "zac-number" "zac-address" "liv-number" "liv-address" "asc-number" "asc-address" "shrev-number" "shrev-address" "alx-address" "alx-number" "laf-number" "laf-address" "toll-free" "br-number" "br-address" "gmia" "g-guarantee" "ds-number"))}"][/sc] $0 \ No newline at end of file diff --git a/snippets/scheme-mode/chicken b/snippets/scheme-mode/chicken deleted file mode 100644 index 19a98e1..0000000 --- a/snippets/scheme-mode/chicken +++ /dev/null @@ -1,8 +0,0 @@ -# -*- mode: snippet -*- -# name: chicken -# key: chicken -# -- -\#!/bin/sh -\#| -*- scheme -*- -exec csi -s $0 \"$@\" -|# diff --git a/snippets/sh-mode/getopts b/snippets/sh-mode/getopts deleted file mode 100644 index 8f6fc39..0000000 --- a/snippets/sh-mode/getopts +++ /dev/null @@ -1,10 +0,0 @@ -# -*- mode: snippet -*- -# name: getopts -# key: getopts -# -- -while getopts ${1:h} opt; do - case "$opt" in - $0 - esac -done -shift $(( OPTIND -1 )) \ No newline at end of file -- cgit 1.4.1-21-gabe81