From a729a61c0a1cad6e99dd6f56dfd35e8ff141521e Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Fri, 28 Oct 2022 19:43:12 -0500 Subject: total rewrite of `yoke' --- early-init.el | 14 +- init.el | 547 ++++++++++++++++++++++++++++++++++++++++------------------ lisp/yoke.el | 395 ++++++++++++++++++++++++++---------------- 3 files changed, 635 insertions(+), 321 deletions(-) diff --git a/early-init.el b/early-init.el index 6f6a848..c75d963 100644 --- a/early-init.el +++ b/early-init.el @@ -1,9 +1,7 @@ -;;; emacs early init -*- lexical-binding: t; -*- +;;; early-init.el --- Emacs early init -*- lexical-binding: t; -*- ;; by C. Duckworth ;; Bankruptcy: 9 -(provide 'early-init) - ;;; Speed up init ;; Restore things after init @@ -71,6 +69,9 @@ See `no-littering' for examples.") (+define-dir sync/ (expand-file-name "~/Sync") "My Syncthing directory.") +(+define-dir private/ (sync/ "emacs/private")) +(add-to-list 'load-path private/) + ;;; Packages (setf package-enable-at-startup nil @@ -79,9 +80,9 @@ See `no-littering' for examples.") (require 'yoke) (add-hook 'emacs-lisp-mode-hook #'yoke-imenu-insinuate) -(yoke compat "https://git.sr.ht/~pkal/compat") +(yoke (compat "https://git.sr.ht/~pkal/compat")) -(yoke no-littering "https://github.com/emacscollective/no-littering" +(yoke (no-littering "https://github.com/emacscollective/no-littering") (setf no-littering-etc-directory .etc no-littering-var-directory .etc custom-file (.etc "custom.el")) @@ -92,3 +93,6 @@ See `no-littering' for examples.") (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/"))))) + +(provide 'early-init) +;;; early-init.el ends here diff --git a/init.el b/init.el index 101e220..d3071e2 100644 --- a/init.el +++ b/init.el @@ -9,15 +9,22 @@ ;; - Be kind to yourself. ;; - Make good choices. -(yoke +emacs (locate-user-emacs-file "lisp/") - (require* '+emacs '+window) +(yoke +emacs + (require* '+emacs '+window '+lisp) ;; Settings (setf truncate-string-ellipsis "…" ring-bell-function #'ignore read-file-name-completion-ignore-case t comment-auto-fill-only-comments t password-cache t - password-cache-expiry (* 60 60)) + password-cache-expiry (* 60 60) + initial-buffer-choice (defun +initial-buffer-choose () + (cond + ((bound-and-true-p initial-buffer-chosen) + (other-buffer)) + (:else + (defvar initial-buffer-chosen t) + (get-buffer "*scratch*"))))) ;; "Safe" variables (dolist (var+pred '((browse-url-browser-function @@ -37,7 +44,17 @@ "C-x C-k" #'kill-current-buffer "C-/" #'undo-only "C-?" #'undo-redo - "C-x C-c" #'+save-buffers-quit + "C-x C-c" (defun delete-frame-or-quit (arg) + (interactive "P") + (cond (arg (delete-frame nil :force)) + ((= 1 (length (frame-list))) + (and (yes-or-no-p "Kill emacs? ") + (save-buffers-kill-emacs t))) + (:else (delete-frame)))) + "C-x r q" (defun really-quit-emacs (arg) + (interactive "P") + (cond (arg (save-buffers-kill-emacs t)) + (:else (save-buffers-kill-terminal t)))) "M-SPC" #'+cycle-spacing ;; "M-/" #'hippie-expand ; `hippie-completing-read' "M-=" #'count-words @@ -45,9 +62,13 @@ "C-x 4 n" #'clone-buffer "S-" #'mouse-set-mark "C-x 0" #'+delete-window-or-bury-buffer - "M-j" nil + ;; "M-j" nil ; `avy' "" nil - "M-o" #'other-window|switch-buffer) + "C-z" nil + "M-o" #'other-window|switch-buffer + "C-M-;" #'+lisp-comment-or-uncomment-sexp + "C-x 5 z" #'suspend-frame + "M-@" #'dictionary-search) (define-key* text-mode-map "C-M-k" #'kill-paragraph) ;; Hooks @@ -57,16 +78,14 @@ (add-hook 'find-file-not-found-functions #'+auto-create-missing-dirs) (add-hook 'text-mode-hook #'abbrev-mode) (add-hook 'find-file-hook #'+vc-off-when-remote) + (add-hook 'prog-mode-hook #'auto-fill-mode) ;; Advice (add-function :after after-focus-change-function #'+save-some-buffers-debounce) - (advice-add 'keyboard-escape-quit :around - #'keyboard-escape-quit-keep-window-open) - (define-advice keyboard-escape-quit (:around (fn &rest r)) + (define-advice keyboard-escape-quit (:around (fn &rest r) keep-window-open) "Don't close quits on `keyboard-escape-quit'." (let ((buffer-quit-function #'ignore)) (apply fn r))) - (advice-add 'indent-region :before #'with-region-or-buffer) ;; Themes (load-theme 'modus-operandi) (set-face-attribute 'default nil :family "Comic Code" :height 100) @@ -75,7 +94,48 @@ ;; Modes (winner-mode)) -(yoke whitespace nil +(yoke custom ; This is `cus-edit' but meh + (require '+custom) + (setf custom-file (private/ "custom.el")) + (add-to-list* '+custom-allowed-variables + 'safe-local-variable-values + 'warning-suppress-types + 'ispell-buffer-session-localwords) + (eval-after init + (+custom-load-some-customizations :noerror))) + +(yoke time + (setf display-time-mail-function + (defun +notmuch-new-mail-p () + (plist-get (cl-find "inbox+unread" + (ignore-errors + (notmuch-hello-query-counts notmuch-saved-searches)) + :key (lambda (l) (plist-get l :name)) + :test #'equal) + :count)) + display-time-use-mail-icon t + read-mail-command #'+notmuch-goto + display-time-24hr-format t + display-time-day-and-date t + display-time-default-load-average nil) + (display-time-mode)) + +(yoke pita + (require 'pita) + (advice-add 'indent-region :before #'with-region-or-buffer)) + +(yoke (undo-fu-session "https://codeberg.org/ideasman42/emacs-undo-fu-session") + (setf undo-fu-session-incompatible-files '("/COMMIT_EDITMSG\\'" + "/git-rebase-todo\\'") + undo-fu-session-directory (.etc "undo/" t) + undo-fu-session-compression (cond + ((executable-find "gzip") 'gz) + ((executable-find "bzip2") 'bz2) + ((executable-find "xz") 'xz) + (t nil))) + (global-undo-fu-session-mode)) + +(yoke whitespace (setf whitespace-line-column nil whitespace-style '( face trailing tabs tab-mark @@ -95,8 +155,8 @@ (move-to-column col t) (set-buffer-modified-p nil)))) -(yoke elisp-mode nil - (setf eval-expression-print-length nil +(yoke elisp-mode + (setf eval-expression-print-length nil ; remove ellipses from `eval-expression' eval-expression-print-level nil) (define-key* '(emacs-lisp-mode-map lisp-interaction-mode-map) "C-c C-c" #'eval-defun @@ -114,24 +174,24 @@ (apply fn beg end args) (pulse-momentary-highlight-region beg end))) -(yoke isearch nil +(yoke isearch (define-key* (current-global-map) "C-s" #'isearch-forward-regexp "C-r" #'isearch-backward-regexp "C-M-s" #'isearch-forward "C-M-r" #'isearch-backward)) -(yoke ispell nil - (eval-after ispell - (require '+ispell) - (add-hook 'before-save-hook #'+ispell-move-buffer-words-to-dir-locals-hook)) +(yoke ispell + (require* '+ispell 'ispell) + (add-hook 'before-save-hook + #'+ispell-move-buffer-words-to-dir-locals-hook) (setf ispell-program-name (or (executable-find "ispell") (executable-find "aspell"))) (put 'ispell-buffer-session-localwords 'safe-local-variable #'+ispell-safe-local-p)) -(yoke mouse nil +(yoke mouse ;; Brand new for Emacs 28: see https://ruzkuku.com/texts/emacs-mouse.html ;; Actually, look at this as well: https://www.emacswiki.org/emacs/Mouse3 (when (fboundp 'context-menu-mode) @@ -147,7 +207,7 @@ (global-set-key (vector 'right-margin click) 'mwheel-scroll) (global-set-key (vector 'left-margin click) 'mwheel-scroll))) -(yoke dired nil +(yoke dired (require 'dired-x) (setf dired-recursive-copies 'always dired-recursive-deletes 'always @@ -178,19 +238,19 @@ #'dired-hide-details-mode #'hl-line-mode)) -(yoke dired-hacks "https://github.com/Fuco1/dired-hacks" +(yoke (dired-hacks "https://github.com/Fuco1/dired-hacks") (define-key* dired-mode-map "TAB" #'dired-subtree-sycle "i" #'dired-subtree-toggle) (add-hook* 'dired-mode-hook #'dired-collapse-mode)) -(yoke auth-source nil +(yoke auth-source (setf auth-sources `(default "secrets:passwords")) (setq-local-hook authinfo-mode-hook truncate-lines t)) -(yoke consult "https://github.com/minad/consult" +(yoke (consult "https://github.com/minad/consult") (require 'consult) (setf register-preview-delay 0 register-preview-function #'consult-register-format @@ -201,9 +261,10 @@ consult--regexp-compiler #'consult--default-regexp-compiler) (advice-add #'register-preview :override #'consult-register-window) (define-key* (current-global-map) + ;; Etc + "C-x m" #'consult-mode-command ;; 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) @@ -250,12 +311,13 @@ "M-s L" #'consult-line-multi)) (eval-after org (define-key org-mode-map (kbd "M-g o") #'consult-org-heading)) - (setf (alist-get ?y (plist-get (alist-get 'emacs-lisp-mode - consult-imenu-config) - :types)) - '("Yoke"))) + (eval-after consult-imenu + (setf (alist-get ?y (plist-get (alist-get 'emacs-lisp-mode + consult-imenu-config) + :types)) + '("Yoke")))) -(yoke orderless "https://github.com/oantolin/orderless" +(yoke (orderless "https://github.com/oantolin/orderless") (require 'orderless) (setf completion-styles '(substring orderless basic) completion-category-defaults nil @@ -263,14 +325,14 @@ '((file (styles basic partial-completion))) orderless-component-separator #'orderless-escapable-split-on-space)) -(yoke vertico "https://github.com/minad/vertico" +(yoke (vertico "https://github.com/minad/vertico") (require 'vertico) (setf resize-mini-windows 'grow-only vertico-count-format nil vertico-cycle t) (vertico-mode)) -(yoke embark "https://github.com/oantolin/embark" +(yoke (embark "https://github.com/oantolin/embark") (require 'embark) (setf prefix-help-command #'embark-prefix-help-command embar-keymap-prompter-key ";") @@ -285,27 +347,31 @@ (require 'embark-consult) (add-hook 'embark-collect-mode-hook #'consult-preview-at-point-mode))) -(yoke marginalia "https://github.com/minad/marginalia/" +(yoke (marginalia "https://github.com/minad/marginalia/") (marginalia-mode)) -(yoke wgrep "https://github.com/mhayashi1120/Emacs-wgrep" +(yoke (wgrep "https://github.com/mhayashi1120/Emacs-wgrep") (require 'wgrep)) -(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" +;; (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))) +;; ;; (add-hook* 'scheme-mode-hook #'slime-mode) +;; (setf slime-completion-at-point-functions +;; (delq 'slime-c-p-c-completion-at-point +;; slime-completion-at-point-functions)))))) + +(yoke (puni "https://github.com/amaikinono/puni") (define-key* puni-mode-map "C-)" #'puni-slurp-forward "C-(" #'puni-slurp-backward @@ -318,10 +384,12 @@ (puni-slurp-forward n))) (electric-pair-mode) (add-hook* '(prog-mode-hook - ielm-mode-hook) + ielm-mode-hook + lisp-interaction-mode-hook + lisp-mode-hook scheme-mode-hook) #'puni-mode)) -(yoke hungry-delete "https://github.com/nflath/hungry-delete" +(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 @@ -349,7 +417,7 @@ arg))) (global-hungry-delete-mode)) -(yoke cape "https://github.com/minad/cape" +(yoke (cape "https://github.com/minad/cape") ;; Insinuate in a lot of modes (defvar +capes '(cape-file cape-dabbrev)) (defun +cape-insinuate (hook capf &optional capes) @@ -361,31 +429,33 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive." (or capes +capes)))) (+cape-insinuate 'emacs-lisp-mode-hook #'elisp-completion-at-point)) -(yoke minions "https://github.com/tarsius/minions" +(yoke (minions "https://github.com/tarsius/minions") (minions-mode)) -(yoke magit "https://github.com/magit/magit" - :load (locate-user-emacs-file "yoke/magit/lisp") +(yoke (magit "https://github.com/magit/magit" + :load "lisp") :depends ((transient "https://github.com/magit/transient" - (locate-user-emacs-file "yoke/transient/lisp")) + :load "lisp") (dash "https://github.com/magnars/dash.el") (with-editor "https://github.com/magit/with-editor" - (locate-user-emacs-file "yoke/with-editor/lisp"))) + :load "lisp")) (autoload #'transient--with-suspended-override "transient") - (autoload #'magit "magit" nil :interactive)) + (autoload #'magit "magit" nil :interactive) + (define-key* (current-global-map) + "C-x g" #'magit)) -(yoke git-modes "https://github.com/magit/git-modes" +(yoke (git-modes "https://github.com/magit/git-modes") (require 'git-modes)) -(yoke visual-fill-column "https://codeberg.org/joostkremers/visual-fill-column" +(yoke (visual-fill-column "https://codeberg.org/joostkremers/visual-fill-column") (setq visual-fill-column-center-text t) (add-hook* 'visual-fill-column-mode-hook #'visual-line-mode) (advice-add 'text-scale-adjust :after #'visual-fill-column-adjust)) -(yoke org "https://git.savannah.gnu.org/git/emacs/org-mode.git" - :load (locate-user-emacs-file "yoke/org/lisp/") +(yoke (org "https://git.savannah.gnu.org/git/emacs/org-mode.git" + :load "lisp") :depends ((org-contrib "https://git.sr.ht/~bzg/org-contrib" - (locate-user-emacs-file "yoke/org-contrib/lisp"))) + :load "lisp")) ;; DON'T load system org (setq load-path (cl-remove-if (lambda (path) (string-match-p "lisp/org\\'" path)) @@ -470,86 +540,106 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive." (org-clock-persistence-insinuate))) (yoke org-agenda nil - (setq org-agenda-skip-deadline-if-done t - org-agenda-skip-scheduled-if-done t - org-agenda-span 10 - org-agenda-block-separator ?─ - org-agenda-time-grid - '((daily today require-timed) - (800 1000 1200 1400 1600 1800 2000) - " ┄┄┄┄┄ " "┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄") - org-agenda-current-time-string - "← now ─────────────────────────────────────────────────" - org-agenda-include-diary nil ; I use the org-diary features - org-agenda-todo-ignore-deadlines 'near - org-agenda-todo-ignore-scheduled 'future - org-agenda-include-deadlines t - org-deadline-warning-days 0 - org-agenda-show-future-repeats 'next - org-agenda-window-setup 'current-window) - (setq-local-hook org-agenda-mode-hook - truncate-lines t - electric-pair-pairs (append electric-pair-pairs - (mapcar (lambda (e) - (let ((ch (string-to-char (car e)))) - (cons ch ch))) - org-emphasis-alist))) - (add-hook* 'org-agenda-mode-hook - #'hl-line-mode) - (add-hook 'org-agenda-after-show-hook #'org-narrow-to-subtree) - (define-key* (current-global-map) - "C-c c" #'org-capture - "C-c a" #'org-agenda)) - -(yoke ox nil ; org-export - (eval-after org (require 'ox)) - (eval-after ox - (require* '+ox '(ox-md nil t)) - (+org-export-pre-hooks-insinuate)) - (setq org-export-coding-system 'utf-8-unix - org-export-headline-levels 8 - org-export-with-drawers nil - org-export-with-section-numbers nil - org-export-with-smart-quotes t - org-export-with-sub-superscripts t - org-export-with-toc nil)) - -(yoke electric-cursor "https://codeberg.org/acdw/electric-cursor.el" + (setq 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) + (setq-local-hook org-agenda-mode-hook + truncate-lines t + electric-pair-pairs (append electric-pair-pairs + (mapcar (lambda (e) + (let ((ch (string-to-char (car e)))) + (cons ch ch))) + org-emphasis-alist))) + (add-hook* 'org-agenda-mode-hook + #'hl-line-mode) + (add-hook 'org-agenda-after-show-hook #'org-narrow-to-subtree) + (define-key* (current-global-map) + "C-c c" #'org-capture + "C-c a" #'org-agenda) + (eval-after org-capture + '+org-capture)) + +(yoke ox ; org-export + (eval-after org (require 'ox)) + (eval-after ox + (require* '+ox '(ox-md nil t)) + (+org-export-pre-hooks-insinuate)) + (setq org-export-coding-system 'utf-8-unix + org-export-headline-levels 8 + org-export-with-drawers nil + org-export-with-section-numbers nil + org-export-with-smart-quotes t + org-export-with-sub-superscripts t + org-export-with-toc nil)) + +(yoke (electric-cursor "https://codeberg.org/acdw/electric-cursor.el") (setq electric-cursor-alist '((overwrite-mode . hbar) (t . bar))) (electric-cursor-mode)) -(yoke _work (sync/ "emacs/private") - :depends ((+org-capture (locate-user-emacs-file "lisp")) - (private (locate-user-emacs-file "lisp")) - (bbdb "https://git.savannah.nongnu.org/git/bbdb.git" - (locate-user-emacs-file "yoke/bbdb/lisp")) +(yoke _work + :depends ((bbdb "https://git.savannah.nongnu.org/git/bbdb.git" + :load "lisp") (bbdb-vcard "https://github.com/tohojo/bbdb-vcard/")) - (require 'bbdb) - (require* 'private 'work) - (bbdb-initialize 'gnus 'message) - (setq bbdb-complete-mail-allow-cycling t)) + (setf bbdb-complete-mail-allow-cycling t) + (add-hook* '+custom-after-load-hook + (defun _work@after-custom () + (require* 'private '_work) + (require* 'bbdb 'bbdb-message) + (bbdb-initialize 'gnus 'message)))) -(yoke org-taskwise "https://codeberg.org/acdw/org-taskwise.el") +(yoke (org-taskwise "https://codeberg.org/acdw/org-taskwise.el")) -(yoke titlecase "https://codeberg.org/acdw/titlecase.el" - (eval-after org (require* 'titlecase '+titlecase)) - (eval-after titlecase - (add-to-list* 'titlecase-skip-words-regexps (rx word-boundary - (+ (any upper digit)) - word-boundary)))) +(yoke scule + (require 'scule) + (defvar scule-map (let ((map (make-sparse-keymap))) + (define-key map (kbd "M-u") #'scule-upcase) + (define-key map (kbd "M-l") #'scule-downcase) + (define-key map (kbd "M-c") #'scule-capitalize) + map) + "Keymap for scule twiddling.") + (define-key* (current-global-map) + "M-c" scule-map + "M-u" #'universal-argument) + (define-key universal-argument-map (kbd "M-u") #'universal-argument-more)) -(yoke flyspell-correct "https://github.com/duckwork/flyspell-correct" +(yoke (titlecase "https://codeberg.org/acdw/titlecase.el") + (eval-after titlecase + (add-to-list* 'titlecase-skip-words-regexps + (rx word-boundary + (+ (any upper digit)) + word-boundary))) + (eval-after scule + (define-key* scule-map + "M-t" #'titlecase-dwim))) + +(yoke (flyspell-correct "https://github.com/duckwork/flyspell-correct") (eval-after flyspell (require* 'flyspell-correct `(+flyspell-correct ,(locate-user-emacs-file "lisp/+flyspell-correct"))) (define-key* flyspell-mode-map "C-;" #'flyspell-correct-wrapper - "" #'+flyspell-correct-buffer)) + "" #'+flyspell-correct-buffer + "C-," nil + "C-." nil)) (add-hook 'org-mode-hook #'flyspell-mode) (setq flyspell-correct--cr-key ";")) -(yoke helpful "https://github.com/Wilfred/helpful" +(yoke (helpful "https://github.com/Wilfred/helpful") :depends ((dash "https://github.com/magnars/dash.el") (f "https://github.com/rejeep/f.el") (s "https://github.com/magnars/s.el") @@ -571,19 +661,28 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive." (side . bottom) (window-height . 20)))) -(yoke hippie-completing-read - "https://codeberg.org/acdw/hippie-completing-read.el" +(yoke (hippie-completing-read + "https://codeberg.org/acdw/hippie-completing-read.el") (define-key* (current-global-map) "M-/" #'hippie-completing-read)) -(yoke dictionary nil ; Comes with Emacs 29! - (setq dictionary-server "localhost") ; Needs local dictd +(yoke dictionary ; Comes with Emacs 29! + (setq dictionary-server (if (or (executable-find "dictd") + (file-exists-p "/usr/sbin/dictd")) ; oh debian + "localhost" + "dict.org")) (setf (alist-get "^\\*Dictionary\\*" display-buffer-alist nil nil #'string=) '((display-buffer-in-side-window) (side . bottom) - (window-height . 20)))) + (window-height . 20))) + (eval-after org + (define-key* org-mode-map + "M-@" #'dictionary-search)) + (eval-after embark + (define-key* embark-identifier-map + "@" #'dictionary-search))) -(yoke anzu "https://github.com/emacsorphanage/anzu" +(yoke (anzu "https://github.com/emacsorphanage/anzu") (global-anzu-mode) (define-key* (current-global-map) [remap query-replace] #'anzu-query-replace-regexp @@ -600,45 +699,20 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive." (advice-add 'anzu-query-replace-regexp :around #'anzu-qr@window) (advice-add 'anzu-query-replace :around #'anzu-qr@window)) -(yoke tempo nil +(yoke tempo (require '+tempo)) -;; (yoke tempel "https://github.com/minad/tempel" -;; ;; I would use `tempo' but it's clunkier .. :( -;; (define-key* (current-global-map) -;; "M-+" #'tempel-complete -;; "M-_" #'tempel-insert) -;; (defun tempel-capf-insinuate () -;; (setq-local completion-at-point-functions -;; (cons #'tempel-expand -;; completion-at-point-functions))) -;; (add-hook* '(prog-mode-hook -;; text-mode-hook) -;; #'tempel-capf-insinuate)) - -(yoke scule (locate-user-emacs-file "lisp") - (defvar scule-map (let ((map (make-sparse-keymap))) - (define-key map (kbd "M-u") #'scule-upcase) - (define-key map (kbd "M-l") #'scule-downcase) - (define-key map (kbd "M-c") #'scule-capitalize) - map) - "Keymap for scule twiddling.") - (define-key* (current-global-map) - "M-c" scule-map - "M-u" #'universal-argument) - (define-key universal-argument-map (kbd "M-u") #'universal-argument-more)) - -(yoke 0x0 "https://gitlab.com/willvaughn/emacs-0x0" +(yoke (0x0 "https://gitlab.com/willvaughn/emacs-0x0") (setf 0x0-default-server 'ttm) (eval-after embark (define-key* embark-region-map "U" #'0x0-dwim))) -(yoke filldent "https://codeberg.org/acdw/filldent.el" +(yoke (filldent "https://codeberg.org/acdw/filldent.el") (define-key* (current-global-map) "M-q" #'filldent-unfill-toggle)) -(yoke avy "https://github.com/abo-abo/avy" +(yoke (avy "https://github.com/abo-abo/avy") (require 'avy) (setf avy-background t (alist-get ?. avy-dispatch-alist) @@ -655,11 +729,11 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive." (define-key* isearch-mode-map "M-j" #'avy-isearch)) -(yoke frowny "https://codeberg.org/acdw/frowny.el" +(yoke (frowny "https://codeberg.org/acdw/frowny.el") (setf frowny-eyes (rx (any ":=") (opt "'") (? "-"))) (global-frowny-mode)) -(yoke isearch-mb "https://github.com/astoff/isearch-mb" +(yoke (isearch-mb "https://github.com/astoff/isearch-mb") (eval-after (consult anzu) (require 'isearch-mb) (dolist (spec '((isearch-mb--with-buffer @@ -678,15 +752,156 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive." (define-key isearch-mb-minibuffer-map (kbd key) command))))))) (isearch-mb-mode)) -(yoke keepassxc-shim "https://codeberg.org/acdw/keepassxc-shim.el" +(yoke (keepassxc-shim "https://codeberg.org/acdw/keepassxc-shim.el") (keepassxc-shim-activate)) -(yoke keychain-environment "https://github.com/tarsius/keychain-environment" +(yoke (keychain-environment "https://github.com/tarsius/keychain-environment") :when (executable-find "keychain") (keychain-refresh-environment)) -(yoke macrostep "https://github.com/joddie/macrostep" +(yoke (sophomore "https://codeberg.org/acdw/sophomore.el") + (sophomore-enable #'narrow-to-region) + (sophomore-disable #'view-hello-file + #'describe-gnu-project) + (sophomore-disable-with 'confirm #'save-buffers-kill-terminal)) + +(yoke (macrostep "https://github.com/joddie/macrostep") (eval-after elisp-mode (require 'macrostep)) (define-key* '(emacs-lisp-mode-map lisp-interaction-mode-map) "C-c e" #'macrostep-expand)) + +(yoke (embrace "https://github.com/cute-jumper/embrace.el") + :depends ((expand-region "https://github.com/magnars/expand-region.el")) + (define-key* (current-global-map) + "C-=" #'er/expand-region + "C-," #'embrace-commander) + (eval-after org + (define-key* org-mode-map + "C-=" #'er/expand-region + "C-," #'embrace-commander)) + (dolist (fnhook '((org-mode-hook embrace-org-mode-hook) + (ruby-mode-hook embrace-ruby-mode-hook) + (emacs-lisp-mode-hook embrace-emacs-lisp-mode-hook) + (latex-mode-hook embrace-LaTeX-mode-hook))) + (apply #'add-hook fnhook)) + (eval-after org + (defmacro org-insert-or-embrace (char) + "Define a function to insert CHAR, or `embrace' the region with it." + (let* ((fn-name (intern (format "org-insert-or-embrace-%s" char))) + (char (cond ((characterp char) char) + ((stringp char) (string-to-char char)) + (t (user-error "Bad format for char: %S" char))))) + `(defun ,fn-name (n) + ,(format "Insert N %ss, or surround the region with them." + (char-to-string char)) + (interactive "p") + (if (region-active-p) + (dotimes (_ n) + (embrace--add-internal (region-beginning) (region-end) ,char) + (forward-char 1)) + (self-insert-command n ,char))))) + (define-key* org-mode-map + "*" (org-insert-or-embrace "*") + "/" (org-insert-or-embrace "/") + "_" (org-insert-or-embrace "_") + "=" (org-insert-or-embrace "=") + "~" (org-insert-or-embrace "~") + "+" (org-insert-or-embrace "+")))) + +(yoke (notmuch "~/usr/share/emacs/site-lisp") + (eval-after bbdb + (require* 'notmuch '+notmuch '+message)) + (+define-dir notmuch/ (sync/ "emacs/notmuch") + "Notmuch configuration and data.") + (setf notmuch-init-file (notmuch/ "notmuch-init.el" t) + notmuch-address-save-filename (notmuch/ "addresses" t) + notmuch-address-use-company (featurep 'company) + notmuch-search-oldest-first nil + notmuch-archive-tags '("-inbox" "-unread") + notmuch-draft-tags '("+draft" "-inbox" "-unread")) + (define-key* (current-global-map) + "C-c m" #'notmuch-mua-new-mail + "C-c n" #'+notmuch-goto) + ;; Reading mail + (setf notmuch-show-indent-content nil) + (add-hook* '(notmuch-show-mode-hook + notmuch-message-mode-hook) + #'visual-fill-column-mode) + (eval-after notmuch + (define-key* notmuch-search-mode-map + "RET" #'notmuch-search-show-thread + "M-RET" #'notmuch-tree-from-search-thread + "!" #'+notmuch-search-mark-spam) + (define-key* notmuch-tree-mode-map + "!" #'+notmuch-search-mark-spam-then-next)) + ;; Writing mail + (setf message-kill-buffer-on-exit t + message-auto-save-directory nil) + ;; Sending mail + (setf send-mail-function #'sendmail-send-it + mail-specify-envelope-from t + message-sendmail-envelope-from 'header + message-envelope-from 'header) + ;; Extras + (eval-after notmuch + (require '+notmuch) + (load notmuch-init-file :noerror) + (add-hook 'message-setup-hook #'+message-signature-setup) + (add-hook 'message-send-hook #'+send-mail-dispatch) + (advice-add 'notmuch-tag :filter-args #'+notmuch-correct-tags) + (setf notmuch-saved-searches (list + (list :name "inbox+unread" + :query (+notmuch-query-concat + "tag:inbox" + "tag:unread" + "NOT tag:Spam") + :key "m" + :search-type 'tree) + (list :name "inbox" + :query (+notmuch-query-concat + "tag:inbox" + "NOT tag:Spam") + :key "i" + :search-type 'tree) + (list :name "lists+unread" + :query (+notmuch-query-concat + "tag:/List/" + "tag:unread") + :key "l" + :search-type 'tree) + (list :name "lists" + :query "tag:/List/" + :key "L" + :search-type 'tree) + (list :name "unread" + :query (+notmuch-query-concat + "tag:unread" + "NOT tag:Spam") + :key "u" + :search-type 'tree) + (list :name "flagged" + :query "tag:flagged" + :key "f" + :search-type 'tree) + (list :name "sent" + :query "tag:sent" + :key "t" + :search-type 'tree) + (list :name "drafts" + :query "tag:draft" + :key "d" + :search-type 'tree) + (list :name "all mail" + :query "*" + :key "a" + :search-type 'tree))))) + +(yoke (cider "https://github.com/clojure-emacs/cider") + :depends ((clojure-mode "http://github.com/clojure-emacs/clojure-mode") + (parseedn "https://github.com/clojure-emacs/parseedn/") + (parseclj "https://github.com/clojure-emacs/parseclj/") ; parseedn + (queue "https://elpa.gnu.org/packages/queue-0.2.el" :type 'http) + (spinner "https://github.com/Malabarba/spinner.el") + (sesman "https://github.com/vspinu/sesman")) + :when (executable-find "clojure")) diff --git a/lisp/yoke.el b/lisp/yoke.el index e7a6fe9..46d30d5 100644 --- a/lisp/yoke.el +++ b/lisp/yoke.el @@ -1,184 +1,279 @@ -;;; yoke.el --- yoke packages in to your editing system -*- lexical-binding: t; -*- -;; by C. Duckworth -(provide 'yoke) +;;; yoke.el --- make your editor work for YOU -*- lexical-binding: t; -*- +;; Copyright (C) 2022 C. Duckworth + +;;; Commentary: + +;; What's the most basic functionality of a package manager? In my view, all a +;; package manager should do is fetch packages from wherever they are, and +;; provide the system with a method of accessing those packages' functionality. +;; In Emacs, this means downloading packages from the Internet and adding their +;; directories to `load-path'. That's what `yoke' tries to do. +;; +;; In fact, that's /all/ `yoke' tries to do, on the package front. It doesn't +;; automatically fetch dependencies. It doesnt' do much else of anything +;; --- hell, it doesn't have to generate autoloads or build the dang source +;; files if you don't want it to. /I/ have it do those things because I like a +;; few creature comforts, but you can turn 'em off. +;; +;; Instead of focusing too much on installing packages, `yoke' works harder to +;; group---to "yoke together," if you will---related configurations together, à +;; la `use-package' or `setup'. I used both of those packages before and found +;; each somewhat lacking, and what I really wanted was a fancy `progn' that I +;; could put whatever I want inside. So that's basically what `yoke' is. It's +;; a configuration macro that automatically fetches packages from their repos +;; and tells Emacs where they are, then executes its body in a `cl-block' for +;; ... reasons. That's it. + +;;; Code: + (require 'cl-lib) +;;; Customization options + (defgroup yoke nil - "Customizations for yoke, a package manager thing." + "Customizations for `yoke'." :group 'applications :prefix "yoke-") (defcustom yoke-dir (locate-user-emacs-file "yoke") - "Where yoke packages live." + "Where to put yoked packages." :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 &optional load-path) - "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) - (when (or load-path dir) - (add-to-list 'load-path (expand-file-name (or 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." +(defcustom yoke-get-default-fn #'yoke-get-git + "Default function to get packages with." + :type 'function) + +(defvar yoke-buffer "*yoke*" + "Buffer to use for yoke process output.") + +;;; GET YOKED + +(defmacro yoke (package + &rest body) + "Yoke PACKAGE to work with your Emacs. +Execute BODY afterward. + +\(fn (PACKAGE [REPO REPO-KEYWORDS]) [BODY-KEYWORDS] BODY...)" (declare (indent 1)) - (let ((g (gensym))) - `(let ((,g ,test)) - (when ,g - ,@body - ,g)))) - -(defun delete2 (list &rest elems) - "Delete each element of ELEMS, and the next item, from LIST." - (let ((r nil)) - (while (consp list) - (if (member (car list) elems) - (setf list (cdr list)) - (setf r (cons (car list) r))) - (setf list (cdr list))) - (reverse r))) - -(defun eval-after-init (fn) + (let* (;; State + (pkg (cond ((consp package) (car package)) + (:else package))) + (url (cond ((consp package) (cdr package)) + (:else nil))) + (pname (intern (format "yoke:%s" pkg))) + (dirvar (gensym "yoke-dir-")) + ;; Keyword args + (after (plist-get body :after)) + (depends (plist-get body :depends)) + (whenp (plist-member body :when)) + (unlessp (plist-member body :unless)) + (when (cond (whenp (plist-get body :when)) + (:else t))) + (unless (cond (unlessp (plist-get body :unless)) + (:else nil))) + (autoload (cond ((plist-member body :autoload) + (plist-get body :autoload)) + (:else t))) + ;; Body + (body (cl-loop for (this next) on body by #'cddr + unless (keywordp this) + append (list this next) into ret + finally return (cond ((eq (car (last ret)) nil) + (butlast ret)) + (:else ret))))) + `(cl-block ,pname + (condition-case err + (progn + ;; Pass `:when' or `:unless' clauses + ,@(cond + ((and whenp unlessp) + `((when (or (not ,when) ,unless) + (cl-return-from ,pname + (format "%s (abort) :when %S :unless %S" + ',pname ',when ',unless))))) + (whenp + `((unless ,when (cl-return-from ,pname + (format "%s (abort) :when %S" + ',pname ',when))))) + (unlessp + `((when ,unless (cl-return-from ,pname + (format "%s (abort) :unless %S" + ',pname ',unless)))))) + ;; Get prerequisite packages + ,@(cl-loop + for (pkg* . yoke-get-args) in depends + collect `(or (let ((dir (yoke-get ,@yoke-get-args + :dir ,(format "%s" pkg*)))) + (and dir + ,@(if autoload + `((yoke-generate-autoloads ',pkg* dir)) + '(t)))) + (cl-return-from ,pname + (format "Error fetching prerequiste: %s" + ',pkg*)))) + ;; Download the package, generate autoloads + ,@(when url + `((let ((,dirvar (yoke-get ,@url :dir ,(format "%s" pkg)))) + ,@(when autoload + `((yoke-generate-autoloads ',pkg ,dirvar)))))) + ;; Evaluate the body, optionally after the features in `:after' + ,@(cond (after + `((eval-after ,after ,@body))) + (:else body))) + (:success ',package) + (t (message "%s: %s (%s)" ',pname (car err) (cdr err)) + nil))))) + +(defun yoke-get (url &rest args) + "\"Get\" URL and and put it in DIR, then add DIR to `load-path'. +URL can be a string or a list of the form (TYPE URL). The +download will be dispatched to the TYPE, or to +`yoke-get-default-fn' if only a string is given. +ARGS is a plist with the following possible keys: + +:dir DIRECTORY --- the directory to put the URL. +:load DIRECTORY --- the directory (relative to the download path) + to add to `load-path'. +:type TYPE --- one of `http', `git', or `file' --- how to + download URL." + (let* ((dir (plist-get args :dir)) + (load (plist-get args :load)) + (type (plist-get args :type)) + (path (cond + ((eq type 'http) (yoke-get-http url dir)) + ((or (eq type 'git) + (string-match-p (rx bos "git:") url)) + (yoke-get-git url dir)) + ((or (eq type 'file) + (string-match-p (rx bos (or "file:" "~" "/")) url)) + (yoke-get-file url dir)) + ((stringp url) + (funcall yoke-get-default-fn url dir)) + (:else (error "Uknown URL type: %S" url))))) + (cond + ((file-exists-p path) + (add-to-list 'load-path (expand-file-name (or load "") path)) + path) + (:else (error "Directory \"%s\" doesn't exist." path) + nil)))) + +(defun yoke-get--guess-directory (path &optional dir) + "Guess directory from PATH and DIR, and return it. +If DIR is present and relative, resolve it relative to +`yoke-dir', or if it's absolute, leave it as-is. If DIR is +absent, return the final component of PATH resolved relative to +`yoke-dir'." + (expand-file-name (or dir (file-name-nondirectory path)) + yoke-dir)) + +(defun yoke-get-http (url &optional dir) + "Download URL to DIR and return its directory. +If DIR isn't given, it's guessed from the final component of the +URL's path and placed under `yoke-dir'." + (let* ((dir (yoke-get--guess-directory url dir)) + (basename (file-name-nondirectory url)) + (filename (expand-file-name basename dir))) + (cond ((file-exists-p filename) + dir) + (:else + (message "Downloading %s..." url) + (with-current-buffer (let ((url-debug t)) + (url-retrieve-synchronously url)) + (condition-case e + (progn + (make-directory dir :parents) + (write-file filename 1) + (message "Downloading %s... Done" url)) + (:success dir) + (t (signal (car e) (cdr e))))))))) + +(defun yoke-get-git (repo &optional dir) + "Clone REPO to DIR and return its directory. +If DIR isn't given, it's guessed from the repo's name and put +under `yoke-dir'. Return the cloned directory's name on success, +or nil on failure." + (let ((dir (yoke-get--guess-directory repo dir))) + (cond ((file-exists-p dir) + dir) + (:else + (message "Cloning %s..." repo) + (pcase (call-process "git" nil (get-buffer-create yoke-buffer) nil + "clone" repo dir) + (0 (message "Cloning %s... Done" repo) + dir) + (_ (message "Cloning %s... Error! See buffer %s for output." + repo yoke-buffer) + nil)))))) + +(defun yoke-get-file (file &optional _dir) + "Add FILE's directory to `load-dir'. +_DIR is ignored." + (file-name-directory file)) + +(defun yoke-generate-autoloads (package dir) + "Generate autoloads for PACKAGE in DIR." + ;; Shamelessly stolen from `straight'. + (eval-and-compile (require 'autoload)) + (let ((generated-autoload-file + (expand-file-name (format "%s-autoloads.el" package) dir)) + (backup-inhibited t) + (version-control 'never) + (message-log-max nil) + (inhibit-message t)) + (unless (file-exists-p generated-autoload-file) + (let ((find-file-hook nil) + (write-file-functions nil) + (debug-on-error nil) + (left-margin 0)) + (if (fboundp 'make-directory-autoloads) + (make-directory-autoloads dir generated-autoload-file) + (and (fboundp 'update-directory-autoloads) + (update-directory-autoloads dir))))) + (when-let ((buf (find-buffer-visiting generated-autoload-file))) + (kill-buffer buf)) + (load generated-autoload-file :noerror :nomessage) + t)) + +;;; Evaluating forms after features + +(defun yoke--eval-after-init (fn) "Evaluate FN after inititation, or now if Emacs is initialized. FN is called with no arguments." (if after-init-time (funcall fn) (add-hook 'after-init-hook fn))) -(defmacro eval-after (features &rest body) +(defmacro yoke-eval-after (features &rest body) "Evaluate BODY, but only after loading FEATURES. FEATURES can be an atom or a list; as an atom it works like `with-eval-after-load'. The special feature `init' will evaluate BODY after Emacs is finished initializing." (declare (indent 1) (debug (form def-body))) - (if (eq features 'init) - `(eval-after-init (lambda () ,@body)) - (unless (listp features) - (setf 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)))))) - -(defun yoke-pkg-name (pkg) - (intern (format "yoke:%s" pkg))) - -(cl-defmacro yoke (pkg - &optional repo - &body body - &key - after ; :after (FEATURE...) - depends ; :depends ((PKG REPO)...) - load ; :load DIRECTORY - (when t whenp) ; :when PREDICATE - (unless nil unlessp) ; :unless PREDICATE - &allow-other-keys) - "Yoke a PKG into your Emacs session." - (declare (indent 2)) - (let ((name (yoke-pkg-name pkg)) - (body (delete2 body - :depends :when :unless :after :load))) - `(cl-block ,name - (condition-case e - (progn - ,@(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* load-path*) in depends - collect `(or (yoke-lasso ',pkg* ,repo* ,load-path*) - (cl-return-from ,name nil))) - ,@(cond - (repo `((yoke-lasso ',pkg ,repo ,load))) - (load `((add-to-list 'load-path ,load)))) - ,@(if after - `((eval-after ,after ,@body)) - body)) - (:success ',pkg) - (t (message "%s: %s" ',name e)))))) + (unless (listp features) + (setf features (list features))) + (if (null features) + (macroexp-progn body) + (let* ((this (car features)) + (rest (cdr features))) + (cond ((eq this 'init) + `(yoke--eval-after-init + (lambda () (eval-after ,rest ,@body)))) + (:else + `(with-eval-after-load ',this + (yoke-eval-after ,rest ,@body))))))) -;;; Extras +;;; Integration (defun yoke-imenu-insinuate () "Insinuate `yoke' forms for `imenu'." (require 'imenu) (setf (alist-get "Yoke" imenu-generic-expression nil nil #'equal) - (list (rx (: "(yoke" (+ space) - (group (+ (not space))) + (list (rx (: "(yoke" (+ space) (? "(") + (group (+ (not (or "(" " " "\t" "\n")))) (+ space) (group (+ (not space))))) 1))) -(defun yoke-remove (pkg) - "Remove package PKG from `yoke-dir'." - (interactive (list (completing-read "Package: " - (directory-files yoke-dir) - (lambda (f) - (not (or (string= f ".") - (string= f "..")))) - :require-match))) - (let ((dir (expand-file-name pkg yoke-dir))) - (move-file-to-trash dir) - (message "Package `%s' removed." pkg))) - (provide 'yoke) ;;; yoke.el ends here -- cgit 1.4.1-21-gabe81