From 4cf60c3fea16b60eb18c9a7d8403b75c89aeffef Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Fri, 21 Oct 2022 21:37:30 -0500 Subject: blhe --- .gitignore | 1 + early-init.el | 11 +- init.el | 479 ++++++++++++++++++++++++++++++++++++++-------- lisp/+emacs.el | 18 +- lisp/+flyspell-correct.el | 4 +- lisp/+ispell.el | 97 ++++++++++ lisp/+org-capture.el | 12 +- lisp/+org.el | 167 ++++++++++++++++ lisp/+tempo.el | 44 +++++ lisp/+window.el | 130 +++++++++++++ lisp/acdw.el | 113 +++++++++-- lisp/pita.el | 64 +++++++ lisp/scule.el | 61 ++++++ lisp/yoke.el | 72 ++++--- 14 files changed, 1133 insertions(+), 140 deletions(-) create mode 100644 lisp/+ispell.el create mode 100644 lisp/+tempo.el create mode 100644 lisp/+window.el create mode 100644 lisp/pita.el create mode 100644 lisp/scule.el diff --git a/.gitignore b/.gitignore index b9b0a28..a61fa52 100644 --- a/.gitignore +++ b/.gitignore @@ -1,6 +1,7 @@ *~ .#* .* +*.elc .etc/ .org-id-locations auto-save-list/ diff --git a/early-init.el b/early-init.el index bc4ccdd..6f6a848 100644 --- a/early-init.el +++ b/early-init.el @@ -30,9 +30,9 @@ restore that." (+set-during-startup 'gc-cons-threshold most-positive-fixnum) (add-hook 'minibuffer-setup-hook (defun garbage-collect@minibuffer-enter () - (setq gc-cons-threshold most-positive-fixnum))) + (setf gc-cons-threshold most-positive-fixnum))) (add-hook 'minibuffer-exit-hook (defun garbage-collect@minibuffer-exit () - (setq gc-cons-threshold 800000))) + (setf gc-cons-threshold 800000))) ;; Don't prematurely re-display (unless debug-on-error @@ -45,7 +45,7 @@ restore that." ;;; Default frame settings -(setq default-frame-alist '((tool-bar-lines . 0) +(setf default-frame-alist '((tool-bar-lines . 0) (menu-bar-lines . 0) (vertical-scroll-bars) (horizontal-scroll-bars)) @@ -73,15 +73,16 @@ See `no-littering' for examples.") ;;; Packages -(setq package-enable-at-startup nil +(setf package-enable-at-startup nil package-quickstart nil) (require 'yoke) +(add-hook 'emacs-lisp-mode-hook #'yoke-imenu-insinuate) (yoke compat "https://git.sr.ht/~pkal/compat") (yoke no-littering "https://github.com/emacscollective/no-littering" - (setq no-littering-etc-directory .etc + (setf no-littering-etc-directory .etc no-littering-var-directory .etc custom-file (.etc "custom.el")) (require 'no-littering) diff --git a/init.el b/init.el index 3cbf3cc..101e220 100644 --- a/init.el +++ b/init.el @@ -10,57 +10,189 @@ ;; - Make good choices. (yoke +emacs (locate-user-emacs-file "lisp/") - (require '+emacs) + (require* '+emacs '+window) ;; Settings - (setq truncate-string-ellipsis "…" - ring-bell-function #'ignore - read-file-name-completion-ignore-case t) + (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)) + ;; "Safe" variables + (dolist (var+pred + '((browse-url-browser-function + ;; All types defined by custom are safe. + . (lambda (f) + ;; Whooooo boy + (memq f (mapcar (lambda (i) + (plist-get (cdr i) :value)) + (seq-filter + (lambda (i) + (eq (car i) 'function-item)) + (cdr (get 'browse-url-browser-function + 'custom-type))))))))) + (put (car var+pred) 'safe-local-variable (cdr var+pred))) ;; Keys - (define-keys (current-global-map) + (define-key* (current-global-map) "C-x C-k" #'kill-current-buffer "C-/" #'undo-only "C-?" #'undo-redo "C-x C-c" #'+save-buffers-quit "M-SPC" #'+cycle-spacing - "M-/" #'hippie-expand + ;; "M-/" #'hippie-expand ; `hippie-completing-read' "M-=" #'count-words "C-x C-b" #'ibuffer "C-x 4 n" #'clone-buffer "S-" #'mouse-set-mark "C-x 0" #'+delete-window-or-bury-buffer "M-j" nil - "" nil) + "" nil + "M-o" #'other-window|switch-buffer) + (define-key* text-mode-map + "C-M-k" #'kill-paragraph) ;; Hooks - (add-hook 'after-save-hook #'executable-make-buffer-file-executable-if-script-p) + (add-hook 'after-save-hook + #'executable-make-buffer-file-executable-if-script-p) (add-hook 'minibuffer-setup-hook #'cursor-intangible-mode) (add-hook 'find-file-not-found-functions #'+auto-create-missing-dirs) + (add-hook 'text-mode-hook #'abbrev-mode) + (add-hook 'find-file-hook #'+vc-off-when-remote) ;; Advice - (add-function :after after-focus-change-function #'+save-some-buffers-debounce) - (advice-add 'keyboard-escape-quit :around #'keyboard-escape-quit-keep-window-open) + (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)) "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) - (set-face-attribute 'variable-pitch nil :family "Comic Code" :height 100)) + (set-face-attribute 'bold nil :family "Comic Code" :weight 'bold) + (set-face-attribute 'variable-pitch nil :family "Comic Code") + ;; Modes + (winner-mode)) + +(yoke whitespace nil + (setf whitespace-line-column nil + whitespace-style '( face trailing + tabs tab-mark + indentation + space-after-tab space-before-tab)) + (defun +whitespace-mode-for-writable-buffers () + "Turn on `whitespace-mode' if the buffer is writable, off otherwise." + (whitespace-mode (if buffer-read-only -1 t))) + (add-hook* '(text-mode-hook + prog-mode-hook + read-only-mode-hook) + #'+whitespace-mode-for-writable-buffers) + (add-hook 'before-save-hook #'whitespace-cleanup) + (define-advice whitespace-cleanup (:around (fn &rest r) preserve-point) + (let ((col (current-column))) + (apply fn r) + (move-to-column col t) + (set-buffer-modified-p nil)))) + +(yoke elisp-mode nil + (setf eval-expression-print-length nil + eval-expression-print-level nil) + (define-key* '(emacs-lisp-mode-map lisp-interaction-mode-map) + "C-c C-c" #'eval-defun + "C-c C-k" (defun +elisp-eval-region-or-buffer () + (interactive) + (cond + ((region-active-p) + (eval-region (region-beginning) (region-end)) + (message "Region evaluated.")) + (t + (eval-buffer) + (message "Buffer %s evaluated." (buffer-name))))) + "C-c C-z" #'ielm) + (define-advice eval-region (:around (fn beg end &rest args) pulse) + (apply fn beg end args) + (pulse-momentary-highlight-region beg end))) (yoke isearch nil - (define-keys (current-global-map) + (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)) + (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 + ;; 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) + (setf context-menu-functions '(context-menu-ffap + context-menu-region + context-menu-undo + ;; context-menu-dictionary + )) + (context-menu-mode +1)) + (dolist (click '(;; Fix scrolling in the margin + wheel-down double-wheel-down triple-wheel-down + wheel-up double-wheel-up triple-wheel-up)) + (global-set-key (vector 'right-margin click) 'mwheel-scroll) + (global-set-key (vector 'left-margin click) 'mwheel-scroll))) + +(yoke dired nil + (require 'dired-x) + (setf dired-recursive-copies 'always + dired-recursive-deletes 'always + dired-create-destination-dirs 'always + dired-do-revert-buffer t + dired-hide-details-hide-symlink-targets nil + dired-isearch-filenames 'dwim + delete-by-moving-to-trash t + dired-auto-revert-buffer t + dired-listing-switches "-AlF" + ls-lisp-dirs-first t + dired-ls-F-marks-symlinks t + dired-clean-confirm-killing-deleted-buffers nil + dired-no-confirm '(byte-compile + load chgrp chmod chown + copy move hardlink symlink + shell touch) + dired-dwim-target t) + (setq-local-hook dired-mode-hook + truncate-lines t) + (define-key* (current-global-map) + "C-x C-j" #'dired-jump) + (eval-after dired + (define-key* dired-mode-map + "" #'dired-up-directory + "C-j" #'dired-up-directory)) + (add-hook* 'dired-mode-hook + #'dired-hide-details-mode + #'hl-line-mode)) + +(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 - (setq auth-sources `(default "secrets:passwords")) + (setf 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 + (setf register-preview-delay 0 register-preview-function #'consult-register-format xref-show-xrefs-function #'consult-xref tab-always-indent 'complete @@ -68,7 +200,7 @@ consult-narrow-key "<" consult--regexp-compiler #'consult--default-regexp-compiler) (advice-add #'register-preview :override #'consult-register-window) - (define-keys (current-global-map) + (define-key* (current-global-map) ;; C-c bindings (mode-specific-map) "C-c h" #'consult-history "C-c m" #'consult-mode-command @@ -111,89 +243,123 @@ ;; Isearch integration "M-s e" #'consult-isearch-history) (eval-after isearch-mode - (define-keys isearch-mode-map + (define-key* isearch-mode-map "M-e" #'consult-isearch-history "M-s e" #'consult-isearch-history "M-s l" #'consult-line "M-s L" #'consult-line-multi)) (eval-after org - (define-key org-mode-map (kbd "M-g o") #'consult-org-heading))) + (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"))) (yoke orderless "https://github.com/oantolin/orderless" (require 'orderless) - (setq completion-styles '(substring orderless basic) + (setf completion-styles '(substring orderless basic) completion-category-defaults nil - completion-category-overrides '((file (styles basic partial-completion))) + 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 + (setf resize-mini-windows 'grow-only vertico-count-format nil vertico-cycle t) (vertico-mode)) +(yoke embark "https://github.com/oantolin/embark" + (require 'embark) + (setf prefix-help-command #'embark-prefix-help-command + embar-keymap-prompter-key ";") + (define-key* (list (current-global-map) + 'minibuffer-local-map) + "C-." #'embark-act + "M-." #'embark-dwim + " B" #'embark-bindings) + (define-key* embark-file-map + "l" #'vlf) + (eval-after (embark consult) + (require 'embark-consult) + (add-hook 'embark-collect-mode-hook #'consult-preview-at-point-mode))) + (yoke marginalia "https://github.com/minad/marginalia/" (marginalia-mode)) +(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))) + (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))))))) + (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 + (define-key* puni-mode-map "C-)" #'puni-slurp-forward "C-(" #'puni-slurp-backward "C-}" #'puni-barf-forward - "C-{" #'puni-barf-backward)) + "C-{" #'puni-barf-backward + "M-(" (defun +puni-open-then-slurp-forward (&optional n) + (interactive "p") + (insert "()") + (backward-char) + (puni-slurp-forward n))) + (electric-pair-mode) + (add-hook* '(prog-mode-hook + ielm-mode-hook) + #'puni-mode)) (yoke hungry-delete "https://github.com/nflath/hungry-delete" (setq hungry-delete-chars-to-skip " \t" - hungry-delete-join-reluctantly nil) + hungry-delete-join-reluctantly nil) (eval-after hungry-delete (add-to-list* 'hungry-delete-except-modes - 'eshell-mode - 'nim-mode - 'python-mode)) + #'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 + hd-fn + fn) + arg)) + (define-key* 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)) + #'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))) + #'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)) + ;; Insinuate in a lot of modes + (defvar +capes '(cape-file cape-dabbrev)) + (defun +cape-insinuate (hook capf &optional capes) + "Insinuate CAPES into a HOOK along with CAPF function. +CAPES defaults to `+capes'. CAPF will be made un-exclusive." + (setq-local-hook hook + completion-at-point-functions + (apply #'list (cape-capf-properties capf :exclusive 'no) + (or capes +capes)))) + (+cape-insinuate 'emacs-lisp-mode-hook #'elisp-completion-at-point)) (yoke minions "https://github.com/tarsius/minions" (minions-mode)) @@ -204,10 +370,13 @@ (locate-user-emacs-file "yoke/transient/lisp")) (dash "https://github.com/magnars/dash.el") (with-editor "https://github.com/magit/with-editor" - (locate-user-emacs-file "yoke/with-editor/lisp"))) + (locate-user-emacs-file "yoke/with-editor/lisp"))) (autoload #'transient--with-suspended-override "transient") (autoload #'magit "magit" nil :interactive)) +(yoke git-modes "https://github.com/magit/git-modes" + (require 'git-modes)) + (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) @@ -219,7 +388,8 @@ (locate-user-emacs-file "yoke/org-contrib/lisp"))) ;; DON'T load system org (setq load-path - (cl-remove-if (lambda (path) (string-match-p "lisp/org\\'" path)) load-path)) + (cl-remove-if (lambda (path) (string-match-p "lisp/org\\'" path)) + load-path)) (setq org-adapt-indentation nil org-auto-align-tags t org-archive-mark-done t @@ -279,29 +449,24 @@ ("=" 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 - ;; )))))) (add-hook* 'org-mode-hook - #'variable-pitch-mode - #'visual-fill-column-mode - #'turn-off-auto-fill - #'org-indent-mode - #'prettify-symbols-mode - #'abbrev-mode) + #'variable-pitch-mode + #'visual-fill-column-mode + #'turn-off-auto-fill + #'org-indent-mode + #'prettify-symbols-mode + #'abbrev-mode) + (define-local-before-save-hook org-mode + (org-hide-drawer-all) + (org-align-tags 'all)) (eval-after org (require '+org) - (define-keys org-mode-map + (define-key* org-mode-map "C-M-k" #'kill-paragraph - "C-M-t" #'transpose-paragraphs) + "C-M-t" #'transpose-paragraphs + "RET" #'+org-return-dwim + "S-" #'+org-table-copy-down|+org-return + "C-c C-o" #'+org-open-at-point-dwim) (org-clock-persistence-insinuate))) (yoke org-agenda nil @@ -323,14 +488,23 @@ org-agenda-show-future-repeats 'next org-agenda-window-setup 'current-window) (setq-local-hook org-agenda-mode-hook - truncate-lines t) - (add-hook 'org-agenda-after-show-hook #'org-narrow-to-subtree)) + 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) - (require 'ox-md nil :noerror) + (require* '+ox '(ox-md nil t)) (+org-export-pre-hooks-insinuate)) (setq org-export-coding-system 'utf-8-unix org-export-headline-levels 8 @@ -340,6 +514,11 @@ 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")) @@ -347,27 +526,167 @@ (locate-user-emacs-file "yoke/bbdb/lisp")) (bbdb-vcard "https://github.com/tohojo/bbdb-vcard/")) (require 'bbdb) - (require 'private) - (require '_work) + (require* 'private 'work) (bbdb-initialize 'gnus 'message) (setq bbdb-complete-mail-allow-cycling t)) (yoke org-taskwise "https://codeberg.org/acdw/org-taskwise.el") (yoke titlecase "https://codeberg.org/acdw/titlecase.el" - (eval-after org (require 'titlecase)) + (eval-after org (require* 'titlecase '+titlecase)) (eval-after titlecase - (require '+titlecase) (add-to-list* 'titlecase-skip-words-regexps (rx word-boundary (+ (any upper digit)) word-boundary)))) (yoke flyspell-correct "https://github.com/duckwork/flyspell-correct" (eval-after flyspell - (require 'flyspell-correct) - (require '+flyspell-correct) - (define-keys flyspell-mode-map + (require* 'flyspell-correct + `(+flyspell-correct ,(locate-user-emacs-file "lisp/+flyspell-correct"))) + (define-key* flyspell-mode-map "C-;" #'flyspell-correct-wrapper "" #'+flyspell-correct-buffer)) (add-hook 'org-mode-hook #'flyspell-mode) (setq flyspell-correct--cr-key ";")) + +(yoke helpful "https://github.com/Wilfred/helpful" + :depends ((dash "https://github.com/magnars/dash.el") + (f "https://github.com/rejeep/f.el") + (s "https://github.com/magnars/s.el") + (elisp-refs "https://github.com/Wilfred/elisp-refs")) + (define-key* (current-global-map) + " f" #'helpful-callable + " v" #'helpful-variable + " k" #'helpful-key + " ." #'helpful-at-point + " o" #'helpful-symbol) + (unless (featurep 'info-look) + (run-with-idle-timer 1 nil (lambda () + (require 'info-look) + (let ((inhibit-message t)) + (info-lookup-setup-mode 'symbol + 'emacs-lisp-mode))))) + (setf (alist-get "\\*helpful" display-buffer-alist nil nil #'string=) + '((display-buffer-in-side-window) + (side . bottom) + (window-height . 20)))) + +(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 + (setf (alist-get "^\\*Dictionary\\*" display-buffer-alist nil nil #'string=) + '((display-buffer-in-side-window) + (side . bottom) + (window-height . 20)))) + +(yoke anzu "https://github.com/emacsorphanage/anzu" + (global-anzu-mode) + (define-key* (current-global-map) + [remap query-replace] #'anzu-query-replace-regexp + [remap query-replace-regexp] #'anzu-query-replace) + (define-key* isearch-mode-map + [remap isearch-query-replace] #'anzu-isearch-query-replace-regexp + [remap isearch-query-replace-regexp] #'anzu-isearch-query-replace) + (defun anzu-qr@window (fn &rest r) + "ADVICE to query-replace from the beginning of the window." + (let ((scroll-margin 0)) + (save-excursion + (goto-char (window-start)) + (apply fn r)))) + (advice-add 'anzu-query-replace-regexp :around #'anzu-qr@window) + (advice-add 'anzu-query-replace :around #'anzu-qr@window)) + +(yoke tempo nil + (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" + (setf 0x0-default-server 'ttm) + (eval-after embark + (define-key* embark-region-map + "U" #'0x0-dwim))) + +(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" + (require 'avy) + (setf avy-background t + (alist-get ?. avy-dispatch-alist) + (defun avy-action-embark (pt) + (unwind-protect + (save-excursion + (goto-char pt) + (embark-act)) + (select-window + (cdr (ring-ref avy-ring 0)))) + t)) + (define-key* (current-global-map) + "M-j" #'avy-goto-char-timer) + (define-key* isearch-mode-map + "M-j" #'avy-isearch)) + +(yoke frowny "https://codeberg.org/acdw/frowny.el" + (setf frowny-eyes (rx (any ":=") (opt "'") (? "-"))) + (global-frowny-mode)) + +(yoke isearch-mb "https://github.com/astoff/isearch-mb" + (eval-after (consult anzu) + (require 'isearch-mb) + (dolist (spec '((isearch-mb--with-buffer + ("M-e" . consult-isearch) + ("C-o" . loccur-isearch)) + (isearch-mb--after-exit + ("M-%" . anzu-isearch-query-replace) + ("M-s l" . consult-line)))) + (let ((isearch-mb-list (car spec)) + (isearch-mb-binds (cdr spec))) + (dolist (cell isearch-mb-binds) + (let ((key (car cell)) + (command (cdr cell))) + (when (fboundp command) + (add-to-list isearch-mb-list command) + (define-key isearch-mb-minibuffer-map (kbd key) command))))))) + (isearch-mb-mode)) + +(yoke keepassxc-shim "https://codeberg.org/acdw/keepassxc-shim.el" + (keepassxc-shim-activate)) + +(yoke keychain-environment "https://github.com/tarsius/keychain-environment" + :when (executable-find "keychain") + (keychain-refresh-environment)) + +(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)) diff --git a/lisp/+emacs.el b/lisp/+emacs.el index 6f40cf0..8817c19 100644 --- a/lisp/+emacs.el +++ b/lisp/+emacs.el @@ -229,7 +229,7 @@ Do this only if the buffer is not visiting a file." (< (- (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)))) + (setf +save-some-buffers-debounce-time (time-convert nil 'integer)))) ;;; Better-default functions ... @@ -304,6 +304,11 @@ ARG is passed to `backward-kill-word'." ;; (advice-add #'yank :after #'+yank@indent) ;; (advice-add #'yank-pop :after #'+yank@indent) +;; https://old.reddit.com/r/emacs/comments/y92y4b/tramp_users_slowness_got_you_down_check/it3a35r/ +(defun +vc-off-when-remote () + (when (file-remote-p (buffer-file-name)) + (setq-local vc-handled-backends nil))) + ;;; Extra functions @@ -317,7 +322,7 @@ It returns nil with remote files and those without attached files." (defun +goto-matching-paren (&optional arg) "Go to the matching paren, similar to vi's %." (interactive "p") - (or arg (setq arg 1)) + (or arg (setf arg 1)) (cond ;; Check for "outside of bracket" positions ((looking-at "[\[\(\{]") (forward-sexp arg)) @@ -338,6 +343,15 @@ If the current window is the only window, bury the buffer." ;;; Required libraries +(when (require 'abbrev nil :noerror) + (setq-default abbrev-file-name (sync/ "abbrev.el") + save-abbrevs 'silent)) + +(when (require 'autorevert nil :noerror) + (setq-default global-auto-revert-non-file-buffers t + auto-revert-verbose nil) + (global-auto-revert-mode +1)) + (when (require 'uniquify nil :noerror) (setq-default uniquify-buffer-name-style 'forward uniquify-separator path-separator diff --git a/lisp/+flyspell-correct.el b/lisp/+flyspell-correct.el index f4fc956..9a33cc0 100644 --- a/lisp/+flyspell-correct.el +++ b/lisp/+flyspell-correct.el @@ -12,8 +12,8 @@ With PREFIX, prompt to change the current dictionary." (when prefix (let ((current-prefix-arg nil)) (call-interactively #'ispell-change-dictionary))) - (+with-message "Checking spelling" - (flyspell-correct-move (point-min) :forward :rapid))) + (with-message "Checking spelling" + (flyspell-correct-move (point-min) :forward :rapid))) (defun +flyspell-correct-buffer-h (&rest _) "Run `+flyspell-correct-buffer'. diff --git a/lisp/+ispell.el b/lisp/+ispell.el new file mode 100644 index 0000000..10c31b8 --- /dev/null +++ b/lisp/+ispell.el @@ -0,0 +1,97 @@ +;;; +ispell.el --- Customizations for `ispell' -*- lexical-binding: t; -*- + +;;; Commentary: + +;;; Code: + +(require 'cl-lib) +(require 'seq) + +;; Utility function TODO: move elsewhere +(defun +ispell-append-removing-duplicates (&rest lists) + "Append LISTS, removing duplicates from the result. +Any keyword arguments to `cl-remove-duplicates' should come +before the LISTS." + (let (cl-remove-duplicates-args) + (while (keywordp (car lists)) + (push (pop lists) cl-remove-duplicates-args) + (push (pop lists) cl-remove-duplicates-args)) + (apply #'cl-remove-duplicates (apply #'append lists) + (nreverse cl-remove-duplicates-args)))) + +;;; Ispell in .dir-locals + +;; Let Emacs know a list of strings is safe +(defun +ispell-safe-local-p (list) + (and (listp list) + (seq-every-p #'stringp list))) + +;; Can I instruct ispell to insert LocalWords in a different file? +;; https://emacs.stackexchange.com/q/31396/2264 + +;; How can I move all my file-local LocalWords to .dir-locals.el? +;; https://emacs.stackexchange.com/q/31419 + +;; Adapted from ispell.el:ispell-buffer-local-words +(defun +ispell-buffer-local-words-list () + (let (words) + (or ispell-buffer-local-name + (setf ispell-buffer-local-name (buffer-name))) + (save-excursion + (goto-char (point-min)) + (while (search-forward ispell-words-keyword nil t) + (let ((end (point-at-eol)) + (ispell-casechars (ispell-get-casechars)) + string) + (while (re-search-forward " *\\([^ ]+\\)" end t) + (setf string (match-string-no-properties 1)) + (if (and (< 1 (length string)) + (equal 0 (string-match ispell-casechars string))) + (push string words)))))) + words)) + +;;;###autoload +(defun +ispell-move-buffer-words-to-dir-locals (&optional arg) + "Move the current buffer-local words to .dir-locals.el. +This function prompts the user to save .dir-locals.el, unless +prefix ARG is non-nil; then it just saves them." + (interactive "P") + (unless (buffer-file-name) + (user-error "Buffer not attached to file")) + (hack-dir-local-variables) + (let ((print-level nil) + (print-length nil)) + (when-let ((new-words (cl-remove-if (lambda (el) (eq el '\.\.\.)) ; XXX: NO IDEA + ; where this came from + (+ispell-append-removing-duplicates + :test #'string= + ispell-buffer-session-localwords + (alist-get 'ispell-buffer-session-localwords + dir-local-variables-alist) + (alist-get 'ispell-buffer-session-localwords + file-local-variables-alist) + (+ispell-buffer-local-words-list))))) + (save-excursion + (add-dir-local-variable + major-mode + 'ispell-buffer-session-localwords + (setf ispell-buffer-session-localwords + new-words)) + (when (or arg + (y-or-n-p "Save .dir-locals.el?")) + (save-buffer)) + (bury-buffer)) + (or ispell-buffer-local-name + (setf ispell-buffer-local-name (buffer-name))) + (save-excursion + (goto-char (point-min)) + (while (search-forward ispell-words-keyword nil t) + (delete-region (point-at-bol) (1+ (point-at-eol)))))))) + +;;;###autoload +(defun +ispell-move-buffer-words-to-dir-locals-hook () + "Convenience function for binding to a hook." + (+ispell-move-buffer-words-to-dir-locals t)) + +(provide '+ispell) +;;; +ispell.el ends here diff --git a/lisp/+org-capture.el b/lisp/+org-capture.el index 7ed4e00..06dfcfd 100644 --- a/lisp/+org-capture.el +++ b/lisp/+org-capture.el @@ -17,7 +17,7 @@ LIST defaults to `org-capture-templates'." ;; 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)) + (setf alist (or alist org-capture-templates)) (macroexp-let2 macroexp-copyable-p k key (gv-letplace (getter setter) alist (macroexp-let2 nil p `(assoc ,k ,getter 'equal) @@ -27,7 +27,7 @@ LIST defaults to `org-capture-templates'." (let ((set-exp `(if ,p (setcdr ,p ,v) ,(funcall setter - `(cons (setq ,p (cons ,k ,v)) + `(cons (setf ,p (cons ,k ,v)) ,getter))))) `(progn ,set-exp @@ -36,7 +36,7 @@ LIST defaults to `org-capture-templates'." (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)) + (setf list (or list 'org-capture-templates)) (set list (sort (symbol-value list) (lambda (a b) (string< (car a) (car b)))))) @@ -68,9 +68,9 @@ SORT-AFTER, when set to t, will call properly process the variable." ;; LIST defaults to `org-capture-templates' (declare (indent 2)) - (unless list (setq list 'org-capture-templates)) + (unless list (setf list 'org-capture-templates)) ;; Ensure VALUE is a list to cons properly - (unless (listp value) (setq value (list value))) + (unless (listp value) (setf value (list value))) (when (> (length key) 1) ;; Check for existence of groups. (let ((expected (cl-loop for i from 1 to (1- (length key)) @@ -87,7 +87,7 @@ properly process the variable." (defun +org-template--ensure-path (keys &optional list) "Ensure path of keys exists in `org-capture-templates'." - (unless list (setq list 'org-capture-templates)) + (unless list (setf list 'org-capture-templates)) (when (> (length key) 1) ;; Check for existence of groups. (let ((expected (cl-loop for i from 1 to (1- (length key)) diff --git a/lisp/+org.el b/lisp/+org.el index b17a1fa..70962d6 100644 --- a/lisp/+org.el +++ b/lisp/+org.el @@ -1,5 +1,106 @@ ;;; +org.el --- -*- lexical-binding: t -*- +;;; Org Return DWIM +;; [[https://github.com/alphapapa/unpackaged.el][unpackaged]] and [[http://kitchingroup.cheme.cmu.edu/blog/2017/04/09/A-better-return-in-org-mode/][kitchin]] + +(defun +org-element-descendant-of (type element) + "Return non-nil if ELEMENT is a descendant of TYPE. +TYPE should be an element type, like `item' or `paragraph'. +ELEMENT should be a list like that returned by `org-element-context'." + ;; MAYBE: Use `org-element-lineage'. + (when-let* ((parent (org-element-property :parent element))) + (or (eq type (car parent)) + (+org-element-descendant-of type parent)))) + +(defun +org-return-dwim (&optional prefix) + "A helpful replacement for `org-return'. +With PREFIX, call `org-return'." + (interactive "P") + ;; Auto-fill if enabled + (when auto-fill-function + (dolist (func (ensure-list auto-fill-function)) + (funcall func))) + (cond + (prefix ; Handle prefix + (pcase prefix + ('(4) (newline)) + ('(16) (newline 2)) + (_ (newline prefix)))) + ((and org-return-follows-link ; Open link + (eq 'link (car (org-element-context)))) + (org-open-at-point-global)) + ((org-at-heading-p) ; Open a line after a heading + (let ((heading-start (org-entry-beginning-position))) + (goto-char (org-entry-end-position)) + (cond ((and (org-at-heading-p) + (= heading-start (org-entry-beginning-position))) + ;; Entry ends on its heading, so add 2 newlines + (end-of-line) + (newline 2)) + (t + ;; Entry ends after its heading, so back up + (forward-line -1) + (end-of-line) + (when (org-at-heading-p) + (forward-line) + (newline) + (forward-line -1)) + (while (not (looking-back (rx (repeat 3 (seq (optional blank) "\n"))) + nil)) + (newline)) + (forward-line -1))))) + ((org-at-item-checkbox-p) ; Insert a new checkbox item + (end-of-line) + (org-insert-todo-heading nil)) + ((org-in-item-p) ; Insert a new list item + (let* ((context (org-element-context)) + (first-item-p (eq 'plain-list (car context))) + (itemp (eq 'item (car context))) + (emptyp (or + ;; This (regular) list item is empty + (eq (org-element-property :contents-begin context) + (org-element-property :contents-end context)) + ;; This (definition) list item is empty + (looking-at " *::"))) + (item-child-p (+org-element-descendant-of 'item context))) + (cond ((and itemp emptyp) + (delete-region (line-beginning-position) (line-end-position)) + (newline)) + ((or first-item-p + (and itemp (not emptyp)) + item-child-p) + (org-end-of-item) + (org-insert-item)) + (t + (delete-region (line-beginning-position) (line-end-position)) + (newline))))) + ((and (fboundp 'org-inlinetask-in-task-p) ; Don't insert a new heading with + (org-inlinetask-in-task-p)) ; inline tasks + (org-return)) + ((org-at-table-p) ; Insert a new org-table row + (cond ((save-excursion + (beginning-of-line) + (cl-loop with end = (line-end-position) + for cell = (org-element-table-cell-parser) + always (equal (org-element-property :contents-begin cell) + (org-element-property :contents-end cell)) + while (re-search-forward "|" end t))) + ;; Empty row: end the table + (delete-region (line-beginning-position) (line-end-position)) + (org-return)) + (t + ;; Non-empty row + (org-return)))) + (t ; Otherwise---just call `org-return'. + (org-return)))) + +(defun +org-table-copy-down|+org-return (&optional n) + "Call `org-table-copy-down' or `+org-return' depending on context." + (interactive "P") + (if (org-table-check-inside-data-field 'noerror) + (org-table-copy-down (or n 1)) + (+org-return-dwim n))) + ;;; Copy org trees as HTML ;; Thanks to Oleh Krehel, via [[https://emacs.stackexchange.com/questions/54292/copy-results-of-org-export-directly-to-clipboard][this StackExchange question]]. @@ -41,4 +142,70 @@ and POST-PROCESS are passed to `org-export-to-file'." ("—" "---")))) (replace-match replace nil nil))))) +;;; A ... different ... `org-open-at-point-dwim' +;; I honestly don't remember what the difference is between this and the +;; O.G. one is.. hopefully this one fixes annoying stupid problems. + +(defun +org-open-at-point-dwim (&optional arg) + "Open thing at point, or if there isn't something, list things." + (interactive "P") + (save-excursion + (let* ((this-char-type (org-element-type (org-element-context))) + (prev-char-type (ignore-errors + (save-excursion + (backward-char) + (org-element-type (org-element-context))))) + (types '(citation citation-reference clock comment comment-block + footnote-definition footnote-reference headline + inline-src-block inlinetask keyword link + node-property planning src-block timestamp)) + (type this-char-type)) + (when (and (memq this-char-type types) (memq prev-char-type types)) + (backward-char) + (setq type prev-char-type)) ; what the fuckckckckck + ;; Okay, so this ^ is pretty janky and doesn't /really/ work that well, + ;; especially on DEADLINE (and probably SCHEDULED) lines. However, since + ;; I really just want to open the list of URLs /most of the time/, I'm + ;; fixing it like this instead. + (unless (and (memq type types) + (ignore-errors (org-open-at-point arg) + t)) + (while (not + (progn + (org-back-to-heading) + (car (org-offer-links-in-entry (current-buffer) (point) 1)))) + (org-up-heading-all 1)) + (org-open-at-point arg))))) + +;;; Skip invisible shit when moving around +(defun +org-ignore-invisible (fn &rest r) + ":around ADVICE to ignore invisible text in `org-mode' buffers." + ;; TODO: generalize to all modes + (cond ((and (derived-mode-p #'org-mode) + (org-invisible-p)) + (while (org-invisible-p) + (forward-char)) + (apply fn r)) + (t (apply fn r)))) + +;;; Faces + +;;; Better org faces +;; see `org-emphasis-alist' + +(defface org-bold '((t (:weight bold))) + "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. + (provide '+org) diff --git a/lisp/+tempo.el b/lisp/+tempo.el new file mode 100644 index 0000000..2324665 --- /dev/null +++ b/lisp/+tempo.el @@ -0,0 +1,44 @@ +;;; +tempo.el --- easier tempo definition -*- lexical-binding: t -*- + +(require 'tempo) + +;; TODO: I need to figure out where this function goes. +(defun delete2 (list &rest elems) + "Delete each element of ELEMS, and the next item, from LIST." + (let ((r nil)) + (while (consp list) + (if (member (car list) elems) + (setf list (cdr list)) + (setf r (cons (car list) r))) + (setf list (cdr list))) + (reverse r))) + +(defmacro define-tempo (tag doc &rest elements) + "Define a template and add its tag to MODE's abbrev-table. +TAG, DOC, and ELEMENTS are passed to `tempo-define-template', which see. +ABBREV, if given, is the abbrev string to use for template expansion +under MODE's abbrev-table. If ABBREV isn't given, TAG will be used." + (declare (indent 1)) + (let* ((template (gensym)) + (tag (cond ((stringp tag) tag) + ((symbolp tag) (symbol-name tag)) + (t (user-error "TAG must be a string or symbol: %S" tag)))) + (mode (or (plist-get elements :mode) nil)) + (abbrev (or (plist-get elements :abbrev) tag)) + (taglist (or (plist-get elements :taglist) nil)) + (table (let ((tname (and mode (derived-mode-abbrev-table-name mode)))) + (while (and tname (not (memq tname abbrev-table-name-list))) + (setq tname (and (get mode 'derived-mode-parent) + (derived-mode-abbrev-table-name + (get mode 'derived-mode-parent))))) + (or tname 'global-abbrev-table))) + (elements (delete2 elements :mode :abbrev :taglist))) + `(let ((,template (tempo-define-template ,tag + ',elements + ,tag + ,doc + ,taglist))) + (define-abbrev ,table ,tag "" ,template :system t) + (put ,template 'no-self-insert t)))) + +(provide '+tempo) diff --git a/lisp/+window.el b/lisp/+window.el new file mode 100644 index 0000000..52b3712 --- /dev/null +++ b/lisp/+window.el @@ -0,0 +1,130 @@ +;;; +window.el --- Fixes for Emacs's window.el -*- lexical-binding: t; -*- + +;;; Commentary: + +;; Do I want to propose this change in the Emacs ML? + +;;; Code: + +(require 'window) + +;;; Split windows based on `window-total-width', not `window-width' +;; I have to just redefine these functions because the check is really deep in +;; there. + +(defun window-splittable-p (window &optional horizontal) + "Return non-nil if `split-window-sensibly' may split WINDOW. +Optional argument HORIZONTAL nil or omitted means check whether +`split-window-sensibly' may split WINDOW vertically. HORIZONTAL +non-nil means check whether WINDOW may be split horizontally. + +WINDOW may be split vertically when the following conditions +hold: +- `window-size-fixed' is either nil or equals `width' for the + buffer of WINDOW. +- `split-height-threshold' is an integer and WINDOW is at least as + high as `split-height-threshold'. +- When WINDOW is split evenly, the emanating windows are at least + `window-min-height' lines tall and can accommodate at least one + line plus - if WINDOW has one - a mode line. + +WINDOW may be split horizontally when the following conditions +hold: +- `window-size-fixed' is either nil or equals `height' for the + buffer of WINDOW. +- `split-width-threshold' is an integer and WINDOW is at least as + wide as `split-width-threshold'. +- When WINDOW is split evenly, the emanating windows are at least + `window-min-width' or two (whichever is larger) columns wide." + (when (and (window-live-p window) + (not (window-parameter window 'window-side))) + (with-current-buffer (window-buffer window) + (if horizontal + ;; A window can be split horizontally when its width is not + ;; fixed, it is at least `split-width-threshold' columns wide + ;; and at least twice as wide as `window-min-width' and 2 (the + ;; latter value is hardcoded). + (and (memq window-size-fixed '(nil height)) + ;; Testing `window-full-width-p' here hardly makes any + ;; sense nowadays. This can be done more intuitively by + ;; setting up `split-width-threshold' appropriately. + (numberp split-width-threshold) + (>= (window-total-width window) + (max split-width-threshold + (* 2 (max window-min-width 2))))) + ;; A window can be split vertically when its height is not + ;; fixed, it is at least `split-height-threshold' lines high, + ;; and it is at least twice as high as `window-min-height' and 2 + ;; if it has a mode line or 1. + (and (memq window-size-fixed '(nil width)) + (numberp split-height-threshold) + (>= (window-height window) + (max split-height-threshold + (* 2 (max window-min-height + (if mode-line-format 2 1)))))))))) + +(defun split-window-sensibly (&optional window) + "Split WINDOW in a way suitable for `display-buffer'. +WINDOW defaults to the currently selected window. +If `split-height-threshold' specifies an integer, WINDOW is at +least `split-height-threshold' lines tall and can be split +vertically, split WINDOW into two windows one above the other and +return the lower window. Otherwise, if `split-width-threshold' +specifies an integer, WINDOW is at least `split-width-threshold' +columns wide and can be split horizontally, split WINDOW into two +windows side by side and return the window on the right. If this +can't be done either and WINDOW is the only window on its frame, +try to split WINDOW vertically disregarding any value specified +by `split-height-threshold'. If that succeeds, return the lower +window. Return nil otherwise. + +By default `display-buffer' routines call this function to split +the largest or least recently used window. To change the default +customize the option `split-window-preferred-function'. + +You can enforce this function to not split WINDOW horizontally, +by setting (or binding) the variable `split-width-threshold' to +nil. If, in addition, you set `split-height-threshold' to zero, +chances increase that this function does split WINDOW vertically. + +In order to not split WINDOW vertically, set (or bind) the +variable `split-height-threshold' to nil. Additionally, you can +set `split-width-threshold' to zero to make a horizontal split +more likely to occur. + +Have a look at the function `window-splittable-p' if you want to +know how `split-window-sensibly' determines whether WINDOW can be +split." + (let ((window (or window (selected-window)))) + (or (and (window-splittable-p window) + ;; Split window vertically. + (with-selected-window window + (split-window-below))) + (and (window-splittable-p window t) + ;; Split window horizontally. + (with-selected-window window + (split-window-right))) + (and + ;; If WINDOW is the only usable window on its frame (it is + ;; the only one or, not being the only one, all the other + ;; ones are dedicated) and is not the minibuffer window, try + ;; to split it vertically disregarding the value of + ;; `split-height-threshold'. + (let ((frame (window-frame window))) + (or + (eq window (frame-root-window frame)) + (catch 'done + (walk-window-tree (lambda (w) + (unless (or (eq w window) + (window-dedicated-p w)) + (throw 'done nil))) + frame nil 'nomini) + t))) + (not (window-minibuffer-p window)) + (let ((split-height-threshold 0)) + (when (window-splittable-p window) + (with-selected-window window + (split-window-below)))))))) + +(provide '+window) +;;; +window.el ends here diff --git a/lisp/acdw.el b/lisp/acdw.el index 444f249..f039540 100644 --- a/lisp/acdw.el +++ b/lisp/acdw.el @@ -30,20 +30,20 @@ the filesystem, unless INHIBIT-MKDIR is non-nil." ;;; Convenience functions -(defun define-keys (maps &rest keydefs) +(defun define-key* (maps &rest keydefs) "Define KEYDEFS in MAPS. Convenience wrapper around `define-key'." (unless (zerop (mod (length keydefs) 2)) (user-error "Wrong number of arguments: %S" (length keydefs))) (dolist (map (if (or (atom maps) (eq (car maps) 'keymap)) - (list maps) - maps)) + (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))))) + do (let ((key (if (stringp key) (kbd key) key))) + (define-key (if (symbolp map) + (symbol-value map) + map) + key def))))) (unless (fboundp 'ensure-list) ;; Just in case we're using an old version of Emacs. @@ -57,10 +57,11 @@ not a list, return a one-element list containing 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 +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'." + (declare (indent 1)) (dolist (l (ensure-list lists)) (dolist (thing things) (apply #'add-to-list l (ensure-list thing))))) @@ -69,26 +70,73 @@ Each thing of THINGS can be either a variablel (the thing), or a list of the for "Add FUNCTIONS to HOOKS. Each function in FUNCTIONS can be a singleton or a list of the form (FUNCTION &optional DEPTH LOCAL)." + (declare (indent 1)) (dolist (hook (ensure-list hooks)) (dolist (fn functions) (apply #'add-hook hook (ensure-list fn))))) +(defun +concat (&rest strings) + "Concat STRINGS separated by SEPARATOR. +SEPARATOR is \"\\n\" unless the keyword argument `:separator' is +given, followed by the separator to use. Each item in STRINGS is +either a string or a list or strings, which is concatenated +without any separator." + (let (ret + ;; I don't know why a `cl-defun' with + ;; (&rest strings &key (separator "\n")) doesn't work + (separator (or (cl-loop for i from 0 upto (length strings) + if (eq (nth i strings) :separator) + return (nth (1+ i) strings)) + "\n"))) + (while strings + (let ((string (pop strings))) + (cond ((eq string :separator) (pop strings)) + ((listp string) (push (apply #'concat string) ret)) + ((stringp string) (push string ret))))) + (mapconcat #'identity (nreverse ret) separator))) + +(defun require* (&rest features) + "Require FEATURES in order. +Each feature of FEATURES can also be a list of the arguments to +pass to `require', which see." + (condition-case e + (dolist (feature features) + (apply #'require (ensure-list feature))) + (:success (mapcar (lambda (f) (car (ensure-list f))) features)) + (t (signal (car e) (cdr e))))) + ;;; Convenience macros +(defmacro define-local-before-save-hook (mode-or-hook &rest body) + "Add a local `before-save-hook' to MODE-OR-HOOK." + (declare (indent 1)) + (let* ((name (format "%s" mode-or-hook)) + (external-name (intern (format "%s@before-save" name))) + (internal-name (intern (format "before-save@%s" name))) + (hook (if (string-suffix-p "-hook" name) + mode-or-hook + (intern (format "%s-hook" name))))) + `(progn + (defun ,internal-name () + ,@body) + (defun ,external-name () + (add-hook 'before-save-hook #',internal-name nil :local)) + (add-hook ',hook #',external-name)))) + (defmacro setq-local-hook (hook &rest args) "Run `setq-local' on ARGS when running HOOK." (declare (indent 1)) (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))) + (functionp fn)) + (setf args (append (function-get fn 'setq-local-hook-settings) args))) (unless (and (< 0 (length args)) - (zerop (mod (length args) 2))) + (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)) + ,(format "Set local variables after `%s'." hook) + (setq-local ,@args)) (function-put ',fn 'setq-local-hook-settings ',args) (add-hook ',hook #',fn)))) @@ -103,3 +151,38 @@ If body executes without errors, MESSAGE...Done will be displayed." ,@body) (:success (message "%s...done" ,msg)) (t (signal (car e) (cdr e))))))) + +;; https://emacs.stackexchange.com/a/39324/37239 +;; XXX: This shit don't work rn +(defun ignore-invisible-overlays (fn) + "Execute FN, ignoring invisible overlays. +FN should return a point." + (let ((overlay nil) + (point nil)) + (setq point (and (funcall fn) (point))) + (setq overlay (car (overlays-at (point)))) + (while (and overlay (member 'invisible (overlay-properties overlay))) + (goto-char (overlay-end overlay)) + (setq point (and (funcall fn) (point))) + (setq overlay (car (overlays-at (point))))) + point)) + +;;; Extras +;; Trying to avoid a whole install of crux ... + +(defun kill-and-join-forward (&optional arg) + "Kill the line or, if at the end of a line, join with the next. +This command is `visual-line-mode'-aware. If ARG is provided, +it's passed on to kill a line, but not to delete indentation. +When joining, this command deletes whitespace." + (interactive "P") + (if (and (eolp) (not (bolp))) + (delete-indentation 1) + (funcall (if visual-line-mode #'kill-visual-line #'kill-line) arg))) + +(defun other-window|switch-buffer () + "Call `other-window' or `switch-buffer' depending on windows." + (interactive) + (if (one-window-p) + (switch-to-buffer nil) + (other-window 1))) diff --git a/lisp/pita.el b/lisp/pita.el new file mode 100644 index 0000000..92ebf1b --- /dev/null +++ b/lisp/pita.el @@ -0,0 +1,64 @@ +;;; pita.el --- wrappers making emacs less of a PITA -*- lexical-binding: t -*- +;; 🥙 + +(defmacro with-message (msg &rest body) + (declare (indent 1)) + (when (listp msg) + (setq msg (apply #'format (car msg) (cdr msg)))) + (when (string-match "[[:alnum:]]\\'" msg) + (setq msg (concat msg "..."))) + (let ((m (gensym)) + (r (gensym))) + `(let ((,m ,msg) + (,r nil)) + (condition-case e + (setq r (progn (message ,m) ,@body)) + (:success (message "%s done" ,m) r) + (t (signal (car e) (cdr e))))))) + +(defun walk-tree-replace (tree find replace) + (let ((r nil)) + (dolist (form tree) + (push (cond ((eq find form) replace) + ((listp form) + (walk-tree-replace form find replace)) + (t form)) + r)) + (reverse r))) + +(defmacro with-pr (msg &rest body) + (declare (indent 1)) + (when (listp msg) + (setq msg (apply #'format (car msg) (cdr msg)))) + (when (string-match "[[:alnum:]]\\'" msg) + (setq msg (concat msg "..."))) + (let ((pr (gensym)) + (m (gensym))) + `(let* ((,m ,msg) + (,pr (unless (minibufferp) + (make-progress-reporter ,m)))) + ,@(or (and pr (walk-tree-replace body '@ `(progress-reporter-update ,pr))) + body) + (and ,pr (progress-reporter-done ,pr))))) + + +;;; crux advices +;; these should all go :before the function they're advising. + +(defun with-region-or-buffer (&rest _) + (interactive (if mark-active + (list (region-beginning) (region-end)) + (list (point-min) (point-max))))) + +(defun with-region-or-line (&rest _) + (interactive (if mark-active + (list (region-beginning) (region-end)) + (list (line-beginning-position) (line-end-position))))) + +(defun with-region-or-to-eol (&rest _) + (interactive (if mark-active + (list (region-beginning) (region-end)) + (list (point) (line-end-position))))) + +(provide 'pita) +;;; pita.el ends here diff --git a/lisp/scule.el b/lisp/scule.el new file mode 100644 index 0000000..3ed58bb --- /dev/null +++ b/lisp/scule.el @@ -0,0 +1,61 @@ +;;; scule.el --- -scule twiddling -*- lexical-binding: t; -*- + +;; Copyright (C) 2022 Case Duckworth + +;; Author: Case Duckworth +;; Keywords: convenience + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; DWIM functions for twiddling "scule", or text case (a fancy word for "upper +;; case" is "magiscule", for example, and "lower case" is "miniscule"). + +;;; Code: + +(require 'thingatpt) + +;;; Utility macro +;;;###autoload +(defmacro defscule (name &optional region-fn word-fn) + (let ((fn-name (intern (format "scule-%s" name))) + (region-fn (or region-fn (intern (format "%s-region" name)))) + (word-fn (or word-fn (intern (format "%s-word" name))))) + `(defun ,fn-name (arg) + ,(concat (capitalize (symbol-name name)) " words in the region if active, or word at point.\n" + "If the region is active, call `" (symbol-name region-fn) "'.\n" + "Otherwise, it calls `" (symbol-name word-fn) "' on the word at point and\n" + "the following ARG - 1 words.") + (interactive "*p") + (if (use-region-p) + (,region-fn (region-beginning) (region-end) (region-noncontiguous-p)) + (let ((word-bound (save-excursion + (skip-chars-forward "^[:word:]") + (bounds-of-thing-at-point 'word)))) + (when (and (car word-bound) (cdr word-bound)) + (,region-fn (car word-bound) (cdr word-bound)) + (goto-char (cdr word-bound)) + (,word-fn (1- arg)))))))) + +;;;###autoload +(progn (defscule upcase) + (autoload 'scule-upcase "scule" nil t) + (defscule downcase) + (autoload 'scule-downcase "scule" nil t) + (defscule capitalize) + (autoload 'scule-capitalize "scule" nil t)) + +(provide 'scule) +;;; scule.el ends here diff --git a/lisp/yoke.el b/lisp/yoke.el index 4f40869..68b02c4 100644 --- a/lisp/yoke.el +++ b/lisp/yoke.el @@ -47,20 +47,20 @@ installed to `yoke-dir'." (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)) + (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)) @@ -83,13 +83,13 @@ Similar-ish to `plist-get', but works on non-proper plists." ,g)))) (defun delete2 (list &rest elems) - "Delete ELEM and the next item from LIST." + "Delete each element of ELEMS, 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))) + (setf list (cdr list)) + (setf r (cons (car list) r))) + (setf list (cdr list))) (reverse r))) (defun eval-after-init (fn) @@ -105,17 +105,17 @@ 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))) + (debug (form def-body))) (if (eq features 'init) `(eval-after-init (lambda () ,@body)) (unless (listp features) - (setq features (list features))) + (setf features (list features))) (if (null features) - (macroexp-progn body) + (macroexp-progn body) (let* ((this (car features)) - (rest (cdr features))) - `(with-eval-after-load ',this - (eval-after ,rest ,@body)))))) + (rest (cdr features))) + `(with-eval-after-load ',this + (eval-after ,rest ,@body)))))) (defun yoke-pkg-name (pkg) (intern (format "yoke:%s" pkg))) @@ -131,7 +131,7 @@ BODY after Emacs is finished initializing." (unless nil unlessp) ; :unless PREDICATE &allow-other-keys) "Yoke a PKG into your Emacs session." - (declare (indent defun)) + (declare (indent 2)) (let ((name (yoke-pkg-name pkg)) (body (delete2 body :depends :when :unless :after :load))) @@ -141,11 +141,11 @@ BODY after Emacs is finished initializing." (*yoke-repo* ,repo) (*yoke-dest* ,(when repo `(yoke-repo-dir ',pkg ,repo)))) ,@(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))))) + ((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))) @@ -157,3 +157,15 @@ BODY after Emacs is finished initializing." body)) (:success ',pkg) (t (message "%s: %s" ',name e)))))) + +;;; Extras + +(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))) + (+ space) + (group (+ (not space))))) + 1))) -- cgit 1.4.1-21-gabe81