From aab5bfd074e57d06a79e39d7c7c4760e1f385a06 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Mon, 17 Oct 2022 21:41:28 -0500 Subject: Bankruptcy 9 --- lisp/+Info.el | 84 ----- lisp/+ace-window.el | 40 --- lisp/+apheleia.el | 50 --- lisp/+avy.el | 97 ------ lisp/+bongo.el | 60 ---- lisp/+browse-url.el | 156 --------- lisp/+burly.el | 63 ---- lisp/+casing.el | 82 ----- lisp/+chicken.el | 34 -- lisp/+circe.el | 285 ---------------- lisp/+compat.el | 64 ---- lisp/+compile.el | 20 -- lisp/+consult.el | 47 --- lisp/+crux.el | 58 ---- lisp/+cus-edit.el | 80 ----- lisp/+dired.el | 28 -- lisp/+ecomplete.el | 45 --- lisp/+elfeed.el | 185 ----------- lisp/+elisp.el | 18 - lisp/+emacs.el | 434 ------------------------ lisp/+embark.el | 28 -- lisp/+emms.el | 46 --- lisp/+eshell.el | 126 ------- lisp/+eww.el | 71 ---- lisp/+expand-region.el | 24 -- lisp/+finger.el | 46 --- lisp/+flyspell-correct.el | 24 -- lisp/+god-mode.el | 17 - lisp/+hideshow.el | 44 --- lisp/+init.el | 117 ------- lisp/+ispell.el | 97 ------ lisp/+jabber.el | 278 ---------------- lisp/+key.el | 106 ------ lisp/+kmacro.el | 70 ---- lisp/+link-hint.el | 169 ---------- lisp/+lisp.el | 195 ----------- lisp/+message.el | 26 -- lisp/+minibuffer.el | 14 - lisp/+modeline.el | 488 --------------------------- lisp/+mwim.el | 42 --- lisp/+notmuch.el | 97 ------ lisp/+nyan-mode.el | 42 --- lisp/+orderless.el | 60 ---- lisp/+org-attach.el | 29 -- lisp/+org-capture.el | 164 ---------- lisp/+org-drawer-list.el | 47 --- lisp/+org-wc.el | 112 ------- lisp/+org.el | 816 ---------------------------------------------- lisp/+ox.el | 29 -- lisp/+paredit.el | 26 -- lisp/+pdf-tools.el | 38 --- lisp/+pulse.el | 52 --- lisp/+scratch.el | 77 ----- lisp/+setup.el | 216 ------------ lisp/+shr.el | 51 --- lisp/+slack.el | 27 -- lisp/+sly.el | 18 - lisp/+straight.el | 42 --- lisp/+tab-bar.el | 394 ---------------------- lisp/+titlecase.el | 30 -- lisp/+util.el | 94 ------ lisp/+vertico.el | 24 -- lisp/+vterm.el | 19 -- lisp/+window.el | 130 -------- lisp/+xkcd.el | 16 - lisp/+ytdious.el | 21 -- lisp/+zzz-to-char.el | 16 - lisp/acdw.el | 595 +++++---------------------------- lisp/dawn.el | 74 ----- lisp/elephant.el | 58 ---- lisp/find-script.el | 36 -- lisp/gdrive.el | 130 -------- lisp/hide-cursor-mode.el | 116 ------- lisp/long-s-mode.el | 67 ---- lisp/private.el | 23 -- lisp/reading.el | 85 ----- lisp/system.el | 179 ---------- lisp/user-save.el | 137 -------- lisp/yoke.el | 125 +++++++ 79 files changed, 215 insertions(+), 8055 deletions(-) delete mode 100644 lisp/+Info.el delete mode 100644 lisp/+ace-window.el delete mode 100644 lisp/+apheleia.el delete mode 100644 lisp/+avy.el delete mode 100644 lisp/+bongo.el delete mode 100644 lisp/+browse-url.el delete mode 100644 lisp/+burly.el delete mode 100644 lisp/+casing.el delete mode 100644 lisp/+chicken.el delete mode 100644 lisp/+circe.el delete mode 100644 lisp/+compat.el delete mode 100644 lisp/+compile.el delete mode 100644 lisp/+consult.el delete mode 100644 lisp/+crux.el delete mode 100644 lisp/+cus-edit.el delete mode 100644 lisp/+dired.el delete mode 100644 lisp/+ecomplete.el delete mode 100644 lisp/+elfeed.el delete mode 100644 lisp/+elisp.el delete mode 100644 lisp/+emacs.el delete mode 100644 lisp/+embark.el delete mode 100644 lisp/+emms.el delete mode 100644 lisp/+eshell.el delete mode 100644 lisp/+eww.el delete mode 100644 lisp/+expand-region.el delete mode 100644 lisp/+finger.el delete mode 100644 lisp/+flyspell-correct.el delete mode 100644 lisp/+god-mode.el delete mode 100644 lisp/+hideshow.el delete mode 100644 lisp/+init.el delete mode 100644 lisp/+ispell.el delete mode 100644 lisp/+jabber.el delete mode 100644 lisp/+key.el delete mode 100644 lisp/+kmacro.el delete mode 100644 lisp/+link-hint.el delete mode 100644 lisp/+lisp.el delete mode 100644 lisp/+message.el delete mode 100644 lisp/+minibuffer.el delete mode 100644 lisp/+modeline.el delete mode 100644 lisp/+mwim.el delete mode 100644 lisp/+notmuch.el delete mode 100644 lisp/+nyan-mode.el delete mode 100644 lisp/+orderless.el delete mode 100644 lisp/+org-attach.el delete mode 100644 lisp/+org-capture.el delete mode 100644 lisp/+org-drawer-list.el delete mode 100644 lisp/+org-wc.el delete mode 100644 lisp/+org.el delete mode 100644 lisp/+ox.el delete mode 100644 lisp/+paredit.el delete mode 100644 lisp/+pdf-tools.el delete mode 100644 lisp/+pulse.el delete mode 100644 lisp/+scratch.el delete mode 100644 lisp/+setup.el delete mode 100644 lisp/+shr.el delete mode 100644 lisp/+slack.el delete mode 100644 lisp/+sly.el delete mode 100644 lisp/+straight.el delete mode 100644 lisp/+tab-bar.el delete mode 100644 lisp/+titlecase.el delete mode 100644 lisp/+util.el delete mode 100644 lisp/+vertico.el delete mode 100644 lisp/+vterm.el delete mode 100644 lisp/+window.el delete mode 100644 lisp/+xkcd.el delete mode 100644 lisp/+ytdious.el delete mode 100644 lisp/+zzz-to-char.el delete mode 100644 lisp/dawn.el delete mode 100644 lisp/elephant.el delete mode 100644 lisp/find-script.el delete mode 100644 lisp/gdrive.el delete mode 100644 lisp/hide-cursor-mode.el delete mode 100644 lisp/long-s-mode.el delete mode 100644 lisp/private.el delete mode 100644 lisp/reading.el delete mode 100644 lisp/system.el delete mode 100644 lisp/user-save.el create mode 100644 lisp/yoke.el (limited to 'lisp') diff --git a/lisp/+Info.el b/lisp/+Info.el deleted file mode 100644 index 46bd5f8..0000000 --- a/lisp/+Info.el +++ /dev/null @@ -1,84 +0,0 @@ -;;; +Info.el -*- lexical-binding: t; -*- - -;;Copyright (C) 2022 Case Duckworth - -;;; Code: - -(require 'info) - -(defun +Info-copy-current-node-name (&optional arg) - "Put the name of the current Info invocation intothe kill ring. -This is the same as `Info-copy-current-node-name', but with the -arg reversed." - (interactive "P" Info-mode) - (Info-copy-current-node-name (unless arg 0))) - -(defun +Info-modeline-breadcrumbs () - (let ((nodes (Info-toc-nodes Info-current-file)) - (node Info-current-node) - (crumbs ()) - (depth Info-breadcrumbs-depth-internal) - (text "")) - ;; Get ancestors from the cached parent-children node info - (while (and (not (equal "Top" node)) (> depth 0)) - (setq node (nth 1 (assoc node nodes))) - (when node (push node crumbs)) - (setq depth (1- depth))) - ;; Add bottom node. - (setq crumbs (nconc crumbs (list Info-current-node))) - (when crumbs - ;; Add top node (and continuation if needed). - (setq crumbs (cons "Top" (if (member (pop crumbs) '(nil "Top")) - crumbs - (cons nil crumbs)))) - (dolist (node crumbs) - (let ((crumbs-map (make-sparse-keymap)) - (menu-map (make-sparse-keymap "Breadcrumbs in Mode Line"))) - (define-key crumbs-map [mode-line mouse-3] menu-map) - (when node - (define-key menu-map [Info-prev] - `(menu-item "Previous Node" Info-prev - :visible ,(Info-check-pointer "prev[ious]*") :help "Go to the previous node")) - (define-key menu-map [Info-next] - `(menu-item "Next Node" Info-next - :visible ,(Info-check-pointer "next") :help "Go to the next node")) - (define-key menu-map [separator] '("--")) - (define-key menu-map [Info-breadcrumbs-in-mode-line-mode] - `(menu-item "Toggle Breadcrumbs" Info-breadcrumbs-in-mode-line-mode - :help "Toggle displaying breadcrumbs in the Info mode-line" - :button (:toggle . Info-breadcrumbs-in-mode-line-mode))) - (define-key menu-map [Info-set-breadcrumbs-depth] - `(menu-item "Set Breadcrumbs Depth" Info-set-breadcrumbs-depth - :help "Set depth of breadcrumbs to show in the mode-line")) - (setq node (if (equal node Info-current-node) - (propertize - (replace-regexp-in-string "%" "%%" Info-current-node) - 'face 'mode-line-buffer-id - 'help-echo "mouse-1: Scroll back, mouse-2: Scroll forward, mouse-3: Menu" - 'mouse-face 'mode-line-highlight - 'local-map - (progn - (define-key crumbs-map [mode-line mouse-1] 'Info-mouse-scroll-down) - (define-key crumbs-map [mode-line mouse-2] 'Info-mouse-scroll-up) - crumbs-map)) - (propertize - node - 'local-map (progn (define-key crumbs-map [mode-line mouse-1] - `(lambda () (interactive) (Info-goto-node ,node))) - (define-key crumbs-map [mode-line mouse-2] - `(lambda () (interactive) (Info-goto-node ,node))) - crumbs-map) - 'mouse-face 'mode-line-highlight - 'help-echo "mouse-1, mouse-2: Go to this node; mouse-3: Menu"))))) - (let ((nodetext (if (not (equal node "Top")) - node - (concat (format "(%s)" (if (stringp Info-current-file) - (file-name-nondirectory Info-current-file) - ;; Some legacy code can still use a symbol. - Info-current-file)) - node)))) - (setq text (concat text (if (equal node "Top") "" " > ") (if node nodetext "..."))))) - text))) - -(provide '+Info) -;;; +Info.el ends here diff --git a/lisp/+ace-window.el b/lisp/+ace-window.el deleted file mode 100644 index 9e631a2..0000000 --- a/lisp/+ace-window.el +++ /dev/null @@ -1,40 +0,0 @@ -;;; +ace-window.el -*- lexical-binding: t; -*- - -;;; Code: - -(require 'ace-window) - -;;;###autoload -(define-minor-mode +ace-window-display-mode - "Minor mode for updating data for `+modeline-ace-window-display'." - ;; This is stolen from ace-window.el but with the mode-line stuff ripped out. - :global t - (if +ace-window-display-mode - (progn ; Enable - (aw-update) - (force-mode-line-update t) - (add-hook 'window-configuration-change-hook 'aw-update) - (add-hook 'after-make-frame-functions 'aw--after-make-frame t) - (advice-add 'aw--lead-overlay :override 'ignore)) - (progn ; Disable - (remove-hook 'window-configuration-change-hook 'aw-update) - (remove-hook 'after-make-frame-functions 'aw--after-make-frame) - (advice-remove 'aw--lead-overlay 'ignore)))) - -;; (defun +ace-window--mode-line-hint (path leaf) -;; (let ((wnd (cdr leaf))) -;; (with-selected-window wnd -;; ()))) - -;;;###autoload -(defun +ace-window-or-switch-buffer (arg) - "Call `ace-window' with ARG if more than one window is visible. -Switch to most recent buffer otherwise." - ;; cribbed from `crux-other-window-or-switch-buffer' - (interactive "p") - (if (one-window-p) - (switch-to-buffer nil) - (ace-window arg))) - -(provide '+ace-window) -;;; +ace-window.el ends here diff --git a/lisp/+apheleia.el b/lisp/+apheleia.el deleted file mode 100644 index 51cf145..0000000 --- a/lisp/+apheleia.el +++ /dev/null @@ -1,50 +0,0 @@ -;;; +apheleia.el -*- lexical-binding: t; -*- - -;;; Code: - -(require 'cl-lib) -(require 'el-patch) -(require 'user-save) - -;; https://github.com/raxod502/apheleia/pull/63#issue-1077529623 -(cl-defun +apheleia-indent-region (&key buffer scratch formatter callback &allow-other-keys) - (with-current-buffer scratch - (setq-local indent-line-function - (buffer-local-value 'indent-line-function buffer)) - (indent-region (point-min) - (point-max)) - (funcall callback))) - -;;; Why does the original function have to check for `apheleia-mode' ? -(el-patch-defun apheleia--format-after-save () - "Run code formatter for current buffer if any configured, then save." - (unless apheleia--format-after-save-in-progress - (when (el-patch-swap apheleia-mode - (or apheleia-mode - +apheleia/user-save-mode)) - (when-let ((formatters (apheleia--get-formatters))) - (apheleia-format-buffer - formatters - (lambda () - (with-demoted-errors "Apheleia: %s" - (when buffer-file-name - (let ((apheleia--format-after-save-in-progress t)) - (apheleia--save-buffer-silently))) - (run-hooks 'apheleia-post-format-hook)))))))) - - -(define-minor-mode +apheleia/user-save-mode - "Minor mode for reformatting code on `user-save'. -Customize with `apheleia-mode-alist' and `apheleia-formatters'." - :lighter " Apheleia/US" - (if +apheleia/user-save-mode - (add-hook 'user-save-after-save-hook #'apheleia--format-after-save nil 'local) - (remove-hook 'user-save-after-save-hook #'apheleia--format-after-save 'local))) - -(define-globalized-minor-mode +apheleia/user-save-global-mode - +apheleia/user-save-mode +apheleia/user-save-mode) - -(put '+apheleia/user-save-mode 'safe-local-variable #'booleanp) - -(provide '+apheleia) -;;; +apheleia.el ends here diff --git a/lisp/+avy.el b/lisp/+avy.el deleted file mode 100644 index b0837a3..0000000 --- a/lisp/+avy.el +++ /dev/null @@ -1,97 +0,0 @@ -;;; +avy.el -*- lexical-binding: t -*- - -;;; Commentary: - -;; https://karthinks.com/software/avy-can-do-anything/ - -;;; Code: - -(require 'avy) - -(defun avy-action-embark (pt) - (unwind-protect - (save-excursion - (goto-char pt) - (embark-act)) - (select-window - (cdr (ring-ref avy-ring 0)))) - t) - - -;;; Remove `buffer-face-mode' when avy is active. - -(defcustom +avy-buffer-face-functions '(avy-goto-char - avy-goto-char-in-line - avy-goto-char-2 - avy-goto-char-2-above - avy-goto-char-2-below - avy-goto-word-0 - avy-goto-whitespace-end - avy-goto-word-0-above - avy-goto-word-0-below - avy-goto-whitespace-end-above - avy-goto-whitespace-end-below - avy-goto-word-1 - avy-goto-word-1-above - avy-goto-word-1-below - avy-goto-symbol-1 - avy-goto-symbol-1-above - avy-goto-symbol-1-below - avy-goto-subword-0 - avy-goto-subword-1 - avy-goto-word-or-subword-1 - avy-goto-line - avy-goto-line-above - avy-goto-line-below - avy-goto-end-of-line - avy-goto-char-timer) - "Functions to disable `buffer-face-mode' during.") - -(defvar-local +avy-buffer-face-mode-face nil - "The state of `buffer-face-mode' before calling `avy-with'.") - -;;; XXX: Doesn't switch back if avy errors out or quits -(defun +avy@un-buffer-face (win) - "BEFORE advice on `avy-with' to disable `buffer-face-mode'." - (with-current-buffer (window-buffer win) - (when buffer-face-mode - (setq +avy-buffer-face-mode-face buffer-face-mode-face) - (buffer-face-mode -1)))) - -(defun +avy@re-buffer-face (win) - "AFTER advice on `avy-with' to re-enable `buffer-face-mode'." - (with-current-buffer (window-buffer win) - (when +avy-buffer-face-mode-face - (setq buffer-face-mode-face +avy-buffer-face-mode-face) - (buffer-face-mode +1))) - (let ((bounds (bounds-of-thing-at-point 'symbol))) - (when (and (car bounds) - (cdr bounds)) - (pulse-momentary-highlight-region (car bounds) (cdr bounds))))) - -(defun +avy@buffer-face (fn &rest r) - "AROUND advice for avy to dis/enable `buffer-face-mode'." - (if avy-all-windows - (walk-windows #'+avy@un-buffer-face nil (eq avy-all-windows 'all-frames))) - (condition-case e - (apply fn r) - ((quit error) (message "Avy: %S" e) nil) - (:sucess e)) - (if avy-all-windows - (walk-windows #'+avy@re-buffer-face nil (eq avy-all-windows 'all-frames)))) - -(define-minor-mode +avy-buffer-face-mode - "Turn off `buffer-face-mode' before doing Avy selections. -Restore the mode after the selection." - :lighter "" - :global t - (setq +avy-buffer-face-mode-face nil) - (cond - (+avy-buffer-face-mode - (dolist (fn +avy-buffer-face-functions) - (advice-add fn :around #'+avy@buffer-face))) - (t (dolist (fn +avy-buffer-face-functions) - (advice-remove fn #'+avy@buffer-face))))) - -(provide '+avy) -;;; avy.el ends here diff --git a/lisp/+bongo.el b/lisp/+bongo.el deleted file mode 100644 index da68024..0000000 --- a/lisp/+bongo.el +++ /dev/null @@ -1,60 +0,0 @@ -;;; +bongo.el --- customizations in bongo -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -(defgroup +bongo nil - "Extra customization for `bongo'." - :group 'bongo) - -(defun +bongo-notify () - (notifications-notify - :title "Now Playing" - :body (let ((bongo-field-separator " -")) - (substring-no-properties (bongo-formatted-infoset))) - :urgency 'low - :transient t)) - -(defun +bongo-stop-all () - "Ensure only one bongo playlist is playing at a time. -This is intended to be :before advice to `bongo-play'." - (mapc (lambda (b) - (with-current-buffer b - (when-let* ((modep (derived-mode-p - 'bongo-playlist-mode)) - (bongo-playlist-buffer b) - (playingp (bongo-playing-p))) - (bongo-stop)))) - (buffer-list))) - - -;;; Bongo Radio - -(defcustom +bongo-radio-stations nil - "Stations to play using `+bongo-radio'.") - -(defcustom +bongo-radio-buffer-name "*Bongo Radio*" - "Name of the buffer that holds all bongo radio stations." - :type 'string) - -(defun +bongo-radio () - (interactive) - (switch-to-buffer (or (get-buffer +bongo-radio-buffer-name) - (+bongo-radio-init)))) - -(defun +bongo-radio-init () - (interactive) - (let ((bongo-playlist-buffer (get-buffer-create +bongo-radio-buffer-name)) - (bongo-confirm-flush-playlist nil)) - (with-bongo-playlist-buffer - (bongo-playlist-mode) - (bongo-flush-playlist :delete-all) - (cl-loop for (name . url) in +bongo-radio-stations - do (bongo-insert-uri url name))) - (prog1 (switch-to-buffer bongo-playlist-buffer) - (goto-char (point-min))))) - -(provide '+bongo) -;;; +bongo.el ends here diff --git a/lisp/+browse-url.el b/lisp/+browse-url.el deleted file mode 100644 index fc479e4..0000000 --- a/lisp/+browse-url.el +++ /dev/null @@ -1,156 +0,0 @@ -;;; +browse-url.el -*- lexical-binding: t; -*- - -;;; Code: - -(require 'browse-url) -(require 'cl-lib) - -(defgroup +browse-url nil - "Group for my `browse-url' extras." - :group 'browse-url) - -;;; URL Handlers - -(defun +browse-url-set-handlers (&optional handlers) - "Set HANDLERS for `browse-url'. -Set `browse-url-handlers', if they exist; else -`browse-url-browser-function'. The reason for this switch is -that the latter is deprecated in Emacs 28+. - -If HANDLERS is absent or nil, recompute handlers. This can be -useful when changing the default browser." - (let ((h (if (boundp 'browse-url-handlers) - 'browse-url-handlers - 'browse-url-browser-function))) - (set-default h (or handlers (symbol-value h))))) - -(cl-defmacro +browse-url-make-external-viewer-handler - (viewer default-args &optional (prompt "URL: ") - &key - (custom-group '+browse-url) - (name (format "+browse-url-with-%s" viewer)) - (fallback #'browse-url-generic)) - "Create a `browse-url' handler function that calls VIEWER on the url. -Also create a `customize' setting in CUSTOM-GROUP for VIEWER's -arguments. DEFAULT-ARGS specifies the default arguments that -setting should have. PROMPT will be shown to user in the -function's `interactive' spec, as an argument to -`browse-url-interactive-arg'. The resulting function will be -named NAME, defaulting to \"+browse-url-with-VIEWER\", and the variable -\"NAME-args\". - -If FALLBACK is non-nil, it's a function to fallback on if the -`start-process' call fails in anyway." - (declare (indent 1)) - `(progn - (defcustom ,(intern (format "%s-args" name)) - ,default-args - ,(format "Arguments to pass to %s in `%s'." viewer name) - :type '(repeat :tag "Command-line argument" string) - :group ',custom-group) - (defun ,(intern name) (url &optional new-window) - ,(format "Open URL in %s." viewer) - (interactive (browse-url-interactive-arg ,prompt)) - (let* ((url (browse-url-encode-url url)) - (process-environment (browse-url-process-environment))) - (message ,(format "Opening %%s in %s..." viewer) url) - (unless (ignore-errors - (apply #'start-process - (concat ,viewer " " url) nil - ,viewer - (append ,(intern (format "%s-args" name)) - (list url)))) - (funcall fallback url new-window)))))) - -;; Reference implementation: mpv -(+browse-url-make-external-viewer-handler "mpv" '("--cache-pause-wait=30" - "--cache-pause-initial=yes") - "Video URL: ") -;; And feh too -(+browse-url-make-external-viewer-handler "feh" '("--auto-zoom" - "--geometry" "800x600")) -;; And ... mpv, but for images -(+browse-url-make-external-viewer-handler "mpv" - '("--image-display-duration=inf") - "Image URL: " - :name "+browse-image-with-mpv") - -;;; Easily add extra domains to open in `browse-url-secondary-browser-function' -;; I like to open most websites in eww, but a lot of website on the modern web -;; just make that hard to do. Right now I have a list in `browse-url-handlers' -;; with domains in an (rx (or ...)) form, but that's not super easy to config. -;; With this custom setting, I'm making it a list that'll be way easier to -;; customize. - -(defcustom +browse-url-secondary-browser-regexps nil - "List of URL regexps to open with `browse-url-secondary-browser-function'." - :type '(repeat regexp)) - -;; Because `browse-url-browser-function', when set to an alist, must be of the -;; form (REGEXP . FUNCTION), I need to convert -;; `+browse-url-secondary-browser-regexps' into a regexp. - -(defun +browse-url-secondary-browser-regexps-combine () - "Combine `+browse-url-secondary-browser-regexps'. -This combines a list of regexps into one regexp." - (mapconcat #'identity +browse-url-secondary-browser-regexps "\\\|")) - -;;; URL Transformation Functions -;; There's a lot of bad websites out there. Luckily we can easily redirect -;; requests to more privacy-respecting, or just less javascript-ridden, sites -;; using some basic regex magic. Inspired by add-ons like -;; https://einaregilsson.com/redirector/. - -(defcustom +browse-url-transformations nil - "Transformation rules for various URLs. -This is an alist, the keys of which are regexen to match URLs -against, and the values are how to transform them. Match capture -data will be used in the transformations." - :type - '(alist :key-type (string :tag "URL regex match") - :value-type (string :tag "URL regex transformation")) - :group '+browse-url) - -(defun +browse-url-transform-advice (url &rest args) - "ADVICE to transform URL for later opening by `browse-url'. -ARGS are ignored here, but passed on for later processing." - ;; Basically, loop through `+browse-url-transformations' until finding a CAR - ;; that matches the URL. If one is found, transform it using `replace-match' - ;; with the CDR of that cell, or if one isn't, just pass the URL unchanged, - ;; along with the rest of the args, in a list to the original caller (probably - ;; `browse-url'.) - (apply 'list - (cl-loop with url = (substring-no-properties - (if (consp url) (car url) url)) - for (regex . transformation) in +browse-url-transformations - if (string-match regex url) - return (replace-match transformation nil nil url) - ;; else - finally return url) - args)) - -(define-minor-mode +browse-url-transform-url-mode - "Minor mode to transform a URL before passing it to `browse-url'. -This can be used to \"redirect\" URLs, for example from an -information silo to a more privacy-respecting one (e.g., -\"twitter.com\" -> \"nitter.com\"), by adding advice to `browse-url'. - -When using this mode, ensure that the transformed URL is also in -`browse-url-handlers', since that's what `browse-url' will see." - :lighter " Xurl" - :keymap nil - (if +browse-url-transform-url-mode - (advice-add 'browse-url :filter-args '+browse-url-transform-advice) - (advice-remove 'browse-url '+browse-url-transform-advice))) - -(define-global-minor-mode +browse-url-transform-url-global-mode - +browse-url-transform-url-mode +browse-url-transform-url-mode) - -(defun +browse-url-other-window (&rest args) - "Browse URL in the other window." - (let ((browsed (apply #'browse-url args))) - (when (bufferp browsed) - (switch-to-buffer-other-window browsed)))) - -(provide '+browse-url) -;;; +browse-url.el ends here diff --git a/lisp/+burly.el b/lisp/+burly.el deleted file mode 100644 index a32bc97..0000000 --- a/lisp/+burly.el +++ /dev/null @@ -1,63 +0,0 @@ -;;; +burly.el --- Bespoke burly add-ons -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -(require 'burly) - -(defgroup +burly nil - "Extra `burly' customizations." - :group 'burly - :prefix "+burly-") - -(defcustom +burly-windows-bookmark-name "pre-close-window-config" - "The name of the window config bookmark pre-frame deletion.") - -(defun +burly--get-name (arg) - "Get the name of a Burly bookmark to restore. -If ARG is passed, ask for the bookmark's name; otherwise, just -use `+burly-windows-bookmark-name'." - (if arg - (completing-read "Save Burly bookmark: " (burly-bookmark-names) - nil nil burly-bookmark-prefix) - +burly-windows-bookmark-name)) - -(defun +burly-recover-windows-bookmark (&optional arg frame) - "Recover the window configuration from a previous bookmark. -ARG is passed to `+burly--get-name', which see." - (interactive (list current-prefix-arg - (selected-frame))) - (with-selected-frame frame - (burly-open-bookmark (+burly--get-name arg)))) - -(defun +burly--recover-windows-on-new-frame (frame) - "Recover the current window configuration in a new frame. -This function removes itself from `after-make-frame-functions'." - ;; XXX: For some reason, *scratch* pops up. So I need to run this after a - ;; short delay, which sadly causes a flash of *scratch*. - (run-with-idle-timer 0.1 nil - (lambda (f) (+burly-recover-windows-bookmark nil f)) - frame) - (remove-hook 'after-make-frame-functions #'+burly--recover-windows-on-new-frame)) - -(defun +burly-save-then-close-frame (&optional arg) - "Save window configuration and close the frame. -ARG is passed to `+burly--get-name', which see." - (interactive "P") - (if (not (frame-parameter nil 'client)) - (when (yes-or-no-p "Sure you want to quit? ") - (save-buffers-kill-emacs)) - (save-some-buffers t) - (burly-bookmark-windows (+burly--get-name arg)) - (delete-frame nil :force))) - -(defun +burly-save-then-close-frame-remembering () - "Save window configurations and close the frame. -The next frame created will restore the window configuration." - (interactive) - (add-hook 'after-make-frame-functions #'+burly--recover-windows-on-new-frame 90) - (+burly-save-then-close-frame)) - -(provide '+burly) -;;; +burly.el ends here diff --git a/lisp/+casing.el b/lisp/+casing.el deleted file mode 100644 index c8e9e4d..0000000 --- a/lisp/+casing.el +++ /dev/null @@ -1,82 +0,0 @@ -;;; +casing.el --- Word-case-twiddling things -*- lexical-binding: t; -*- - -;;; Code: - -(require 'thingatpt) - -;;;###autoload -(defun +upcase-dwim (arg) - "Upcase words in the region, or upcase word at point. -If the region is active, this function calls `upcase-region'. -Otherwise, it calls `upcase-word' on the word at point (using -`thingatpt'), and the following ARG - 1 words." - (interactive "*p") - (if (use-region-p) - (upcase-region (region-beginning) (region-end) (region-noncontiguous-p)) - (let ((following (1- arg)) - (word-bound (save-excursion - (skip-chars-forward "^[:word:]") - (bounds-of-thing-at-point 'word)))) - (when (and (car word-bound) (cdr word-bound)) - (upcase-region (car word-bound) (cdr word-bound)) - (goto-char (cdr word-bound)) - (upcase-word following))))) - -;;;###autoload -(defun +downcase-dwim (arg) - "Downcase words in the region, or downcase word at point. -If the region is active, this function calls `downcase-region'. -Otherwise, it calls `downcase-word' on the word at point (using -`thingatpt'), and the following ARG - 1 words." - (interactive "*p") - (if (use-region-p) - (downcase-region (region-beginning) (region-end) (region-noncontiguous-p)) - (let ((following (1- arg)) - (word-bound (save-excursion - (skip-chars-forward "^[:word:]") - (bounds-of-thing-at-point 'word)))) - (when (and (car word-bound) (cdr word-bound)) - (downcase-region (car word-bound) (cdr word-bound)) - (goto-char (cdr word-bound)) - (downcase-word following))))) - -;;;###autoload -(defun +capitalize-dwim (arg) - "Capitalize words in the region, or capitalize word at point. -If the region is active, this function calls `capitalize-region'. -Otherwise, it calls `capitalize-word' on the word at point (using -`thingatpt'), and the following ARG - 1 words." - (interactive "*p") - (if (use-region-p) - (capitalize-region (region-beginning) (region-end) (region-noncontiguous-p)) - (let ((following (1- arg)) - (word-bound (save-excursion - (skip-chars-forward "^[:word:]") - (bounds-of-thing-at-point 'word)))) - (when (and (car word-bound) (cdr word-bound)) - (capitalize-region (car word-bound) (cdr word-bound)) - (goto-char (cdr word-bound)) - (capitalize-word following))))) - -;; Later on, I'll add repeat maps and stuff in here... - -(defvar +casing-map (let ((map (make-sparse-keymap))) - (define-key map "u" #'+upcase-dwim) - (define-key map (kbd "M-u") #'+upcase-dwim) - (define-key map "l" #'+downcase-dwim) - (define-key map (kbd "M-l") #'+downcase-dwim) - (define-key map "c" #'+capitalize-dwim) - (define-key map (kbd "M-c") #'+capitalize-dwim) - map) - "Keymap for case-related twiddling.") - -(define-minor-mode +casing-mode - "Enable easy case-twiddling commands." - :lighter " cC" - :global t - :keymap (let ((map (make-sparse-keymap))) - (define-key map (kbd "M-c") +casing-map) - map)) - -(provide '+casing) -;;; +casing.el ends here diff --git a/lisp/+chicken.el b/lisp/+chicken.el deleted file mode 100644 index 15713f8..0000000 --- a/lisp/+chicken.el +++ /dev/null @@ -1,34 +0,0 @@ -;;; +chicken.el --- Chicken Scheme additions -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -;; Reload [[https://wiki.call-cc.org/eggref/5/awful][awful]] with a keybinding - -(defun +chicken-awful-reload () - "Reload awful by visiting /reload." - (interactive) - (save-buffer) - (condition-case e - (url-retrieve-synchronously "http://localhost:8080/reload") - (file-error (progn - (message "Couldn't ping awful's server. Starting...") - (start-process "awful" (generate-new-buffer "*awful*") - "awful" "--development-mode" (buffer-file-name)))) - (t (message "Some awful error occurred!")))) - -(defun +chicken-indentation-insinuate () - "Insinuate indentation from -https://wiki.call-cc.org/emacs#tweaking-stock-scheme-mode-indentation." - (defun scheme-module-indent (state indent-point normal-indent) 0) - (put 'module 'scheme-indent-function 'scheme-module-indent) - (put 'and-let* 'scheme-indent-function 1) - (put 'parameterize 'scheme-indent-function 1) - (put 'handle-exceptions 'scheme-indent-function 1) - (put 'when 'scheme-indent-function 1) - (put 'unless 'scheme-indent-function 1) - (put 'match 'scheme-indent-function 1)) - -(provide '+chicken) -;;; +chicken.el ends here diff --git a/lisp/+circe.el b/lisp/+circe.el deleted file mode 100644 index 382f0ab..0000000 --- a/lisp/+circe.el +++ /dev/null @@ -1,285 +0,0 @@ -;;; +circe.el -*- lexical-binding: t; -*- - -;;; Code: - -(require '+util) -(require 'circe) - -(defgroup +circe nil - "Extra customizations for Circe." - :group 'circe) - -(defcustom +circe-left-margin 16 - "The size of the margin on the left." - :type 'integer) - -(defcustom +circe-network-inhibit-autoconnect nil - "Servers to inhibit autoconnecting from `circe-network-options'." - :type '(repeat string)) - -;;; Connecting to IRC - -;;;###autoload -(defun +irc () - "Connect to all IRC networks in `circe-network-options'." - (interactive) - (dolist (network (mapcar 'car circe-network-options)) - (unless (member network +circe-network-inhibit-autoconnect) - (+circe-maybe-connect network)))) - -(defun +circe-network-connected-p (network) - "Return t if connected to NETWORK, nil otherwise." - (catch 'return - (dolist (buffer (circe-server-buffers)) - (with-current-buffer buffer - (when (string= network circe-server-network) - (throw 'return t)))))) - -(defun +circe-maybe-connect (network) - "Connect to NETWORK, asking for confirmation to reconnect." - (interactive ("sNetwork: ")) - (when (or (not (+circe-network-connected-p network)) - (yes-or-no-p (format "Already connected to %s, reconnect? " - network))) - (circe network))) - -;;; Channel information - -(defvar-local +circe-current-topic "" - "Cached topic of the buffer's channel.") - -(defun +circe-current-topic (&optional message) - "Return the topic of the current channel. -When called with optional MESSAGE non-nil, or interactively, also -message the current topic." - (interactive "p") - (let ((topic - (or (save-excursion - (goto-char (point-max)) - (and (re-search-backward - (rx (group "*** " - (or "Topic" "topic" "TOPIC") - (* (not ":")) ": ") - (group (+ nonl))) - nil t) - (buffer-substring-no-properties - (match-beginning 2) (match-end 2)))) - +circe-current-topic))) - (setq +circe-current-topic topic) - (when message - (message "%s" topic)) - topic)) - -;;; Formatting messages - -(defun +circe-format-meta (string &optional no-nick) - "Return a format string for `lui-format' for metadata messages. -Include nick unless NO-NICK is non-nil. If NO-NICK is a string, -replace {nick} in the string with {NO-NICK}." - (cond - ((stringp no-nick) - (format "{%1$s:%2$d.%2$ds} *** %3$s" - no-nick (- +circe-left-margin 3) string)) - (no-nick - (format (format "%%%ds *** %s" (- +circe-left-margin 3) string) " ")) - (t - (format "{nick:%1$d.%1$ds} *** %s" (- +circe-left-margin 3) string)))) - -(defun +circe-format-meta* (string) - "Return a format string for `lui-format' for metadata messages, /without/ ") - -(defmacro +lui-make-formatting-list-rx (char) - "Make a formatting regex for CHAR delimiters. -For entry into `lui-formatting-list'." - `(rx (or bol whitespace) - (group ,char (+? (not (any whitespace ,char))) ,char) - (or eol whitespace))) - -;;; Hooks & Advice - -(defun +circe-chat@set-prompt () - "Set the prompt to the (shortened) buffer name." - (interactive) - (lui-set-prompt (propertize (+string-align (buffer-name) +circe-left-margin - :after " > " - :ellipsis "~" - :alignment 'right)))) - -(defun +circe-kill-buffer (&rest _) - "Kill a circe buffer without confirmation, and after a delay." - (let ((circe-channel-killed-confirmation) - (circe-server-killed-confirmation)) - (when (derived-mode-p 'lui-mode) ; don't spuriously kill - (ignore-errors - (kill-buffer))))) - -(defun +circe-quit@kill-buffer (&rest _) - "ADVICE: kill all buffers of a server after `circe-command-QUIT'." - (with-circe-server-buffer - (dolist (buf (circe-server-buffers)) - (with-current-buffer buf - (+circe-kill-buffer))) - (+circe-kill-buffer))) - -(defun +circe-gquit@kill-buffer (&rest _) - "ADVICE: kill all Circe buffers after `circe-command-GQUIT'." - (let ((circe-channel-killed-confirmation) - (circe-server-killed-confirmation)) - (dolist (buf (circe-server-buffers)) - (with-current-buffer buf - (+circe-quit@kill-buffer))))) - -(defun +circe-quit-all@kill-emacs () - "Quit all circe buffers when killing Emacs." - (ignore-errors - (advice-remove 'circe-command-GQUIT - 'circe-gquit@kill-buffer) - (circe-command-GQUIT "Quitting Emacs, bye!"))) - -;;; Patches - -(require 'el-patch) - -(el-patch-feature circe) -(defvar +circe-server-buffer-action 'pop-to-buffer-same-window - "What to do with `circe-server' buffers when created.") - -(el-patch-defun circe (network-or-server &rest server-options) - "Connect to IRC. - -Connect to the given network specified by NETWORK-OR-SERVER. - -When this function is called, it collects options from the -SERVER-OPTIONS argument, the user variable -`circe-network-options', and the defaults found in -`circe-network-defaults', in this order. - -If NETWORK-OR-SERVER is not found in any of these variables, the -argument is assumed to be the host name for the server, and all -relevant settings must be passed via SERVER-OPTIONS. - -All SERVER-OPTIONS are treated as variables by getting the string -\"circe-\" prepended to their name. This variable is then set -locally in the server buffer. - -See `circe-network-options' for a list of common options." - (interactive (circe--read-network-and-options)) - (let* ((options (circe--server-get-network-options network-or-server - server-options)) - (buffer (circe--server-generate-buffer options))) - (with-current-buffer buffer - (circe-server-mode) - (circe--server-set-variables options) - (circe-reconnect)) - (el-patch-swap (pop-to-buffer-same-window buffer) - (funcall +circe-server-buffer-action buffer)))) - -;;; Chat commands - -(defun circe-command-SLAP (nick) - "Slap NICK around a bit with a large trout." - (interactive (list (completing-read "Nick to slap: " - (circe-channel-nicks) - nil t nil))) - (circe-command-ME (format "slaps %s about a bit with a large trout" nick))) - -;;; Filtering functions --- XXX: These don't work right. -;; Set `lui-input-function' to `+lui-filter', then add the filters you want to -;; `circe-channel-mode-hook'. - -(defvar +lui-filters nil - "Stack of input functions to apply. -This is an alist with cells of the structure (TAG . FN), so we -can easily remove elements.") -(make-variable-buffer-local '+lui-filters) - -(defun +lui-filter (text &optional fn-alist) - (let ((fs (nreverse (purecopy (or fn-alist +lui-filters))))) - (while fs - (setq text (funcall (cdr (pop fs)) text))) - (circe--input text))) - -(defmacro +circe-define-filter (name docstring &rest body) - "Define a filter for circe-inputted text." - (declare (doc-string 2) - (indent 1)) - (let (plist) - (while (keywordp (car-safe body)) - (push (pop body) plist) - (push (pop body) plist)) - ;; Return value - `(define-minor-mode ,name - ,docstring - ,@(nreverse plist) - (when (derived-mode-p 'circe-chat-mode) - (if ,name - (push '(,name . (lambda (it) ,@body)) +lui-filters) - (setq +lui-filters - (assoc-delete-all ',name +lui-filters))))))) - -;; CAPPY HOUR! (Pure idiocy) - -(+circe-define-filter +circe-cappy-hour-mode - "ENABLE CAPPY HOUR IN CIRCE!" - :lighter " CAPPY HOUR" - (upcase it)) - -;; URL Shortener - -(+circe-define-filter +circe-shorten-url-mode - "Shorten long urls when chatting." - :lighter " c0x0" - (+circe-0x0-shorten-urls it)) - -(defvar +circe-0x0-max-length 20 - "Maximum length of URLs before using a shortener.") - -(defun +circe-0x0-shorten-urls (text) - "Find urls in TEXT and shorten them using `0x0'." - (require '0x0) - (require 'browse-url) - (let ((case-fold-search t)) - (replace-regexp-in-string - browse-url-button-regexp - (lambda (match) - (if (> (length match) +circe-0x0-max-length) - (+with-message (format "Shortening URL: %s" match) - (0x0-shorten-uri (0x0--choose-server) - (substring-no-properties match))) - match)) - text))) - -(defun +circe-shorten-urls-all () - "Turn on `+circe-shorten-url-mode' in all chat buffers." - (interactive) - (+mapc-some-buffers - (lambda () (+circe-shorten-url-mode +1)) - (lambda (buf) - (derived-mode-p 'circe-chat-mode)))) - -;; Temperature conversion - -(+circe-define-filter +circe-F/C-mode - "Convert degF to degF/degC for international chats." - :lighter " F/C" - (str-F/C it)) - -(defun fahrenheit-to-celsius (degf) - "Convert DEGF to Celsius." - (round (* (/ 5.0 9.0) (- degf 32)))) - -(defun celsius-to-fahrenheit (degc) - "Convert DEGC to Fahrenheit." - (round (+ 32 (* (/ 9.0 5.0) degc)))) - -(defun str-F/C (text) - (replace-regexp-in-string "[^.]\\([[:digit:]]+\\(?:\\.[[:digit:]]+\\)?[fF]\\)" - (lambda (match) - (format "%s/%dC" match - (fahrenheit-to-celsius - (string-to-number match)))) - text - nil 1)) - -(provide '+circe) -;;; +circe.el ends here diff --git a/lisp/+compat.el b/lisp/+compat.el deleted file mode 100644 index 286d5da..0000000 --- a/lisp/+compat.el +++ /dev/null @@ -1,64 +0,0 @@ -;;; +compat.el --- Thin backward-compatibility shim -*- lexical-binding: t; -*- - -;;; Commentary: - -;; I use different versionso of Emacs. Sometimes I have to copy-paste functions -;; from newer Emacs to make my customizations work. This is that file. - -;; This is probably ill-advised. - -;;; Code: - -;;; Load stuff in +compat/ subdirectory -(dolist (file (directory-files (locate-user-emacs-file "lisp/+compat") :full "\\.el\\'")) - (load file :noerror)) - -;;; Only define things if not already defined -(defmacro +compat-defun (name &rest args) - `(if (fboundp ',name) - (message "+compat: `%s' already bound." ',name) - (defun ,name ,@args))) - -(defmacro +compat-defmacro (name &rest args) - `(if (fboundp ',name) - (message "+compat: `%s' already bound." ',name) - (defmacro ,name ,@args))) - -;;; Single functions - -(+compat-defmacro dlet (binders &rest body) - "Like `let' but using dynamic scoping." - (declare (indent 1) (debug let)) - ;; (defvar FOO) only affects the current scope, but in order for - ;; this not to affect code after the main `let' we need to create a new scope, - ;; which is what the surrounding `let' is for. - ;; FIXME: (let () ...) currently doesn't actually create a new scope, - ;; which is why we use (let (_) ...). - `(let (_) - ,@(mapcar (lambda (binder) - `(defvar ,(if (consp binder) (car binder) binder))) - binders) - (let ,binders ,@body))) - -;; https://git.savannah.gnu.org/cgit/emacs.git/diff/?id=772b189143453745a8e014e21d4b6b78f855bba3 -(+compat-defun rename-visited-file (new-location) - "Rename the file visited by the current buffer to NEW-LOCATION. -This command also sets the visited file name. If the buffer -isn't visiting any file, that's all it does. - -Interactively, this prompts for NEW-LOCATION." - (interactive - (list (if buffer-file-name - (read-file-name "Rename visited file to: ") - (read-file-name "Set visited file name: " - default-directory - (expand-file-name - (file-name-nondirectory (buffer-name)) - default-directory))))) - (when (and buffer-file-name - (file-exists-p buffer-file-name)) - (rename-file buffer-file-name new-location)) - (set-visited-file-name new-location nil t)) - -(provide '+compat) -;;; +compat.el ends here diff --git a/lisp/+compile.el b/lisp/+compile.el deleted file mode 100644 index a69db7d..0000000 --- a/lisp/+compile.el +++ /dev/null @@ -1,20 +0,0 @@ -;;; +compile.el --- Extras for compile -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -(defcustom +compile-function nil - "Function to run to \"compile\" a buffer." - :type 'function - :local t - :risky nil) - -(defun +compile-dispatch (&optional arg) - "Run `+compile-function', if bound, or `compile'. -Any prefix ARG is passed to that function." - (interactive "P") - (call-interactively (or +compile-function #'compile))) - -(provide '+compile) -;;; +compile.el ends here diff --git a/lisp/+consult.el b/lisp/+consult.el deleted file mode 100644 index 21c2565..0000000 --- a/lisp/+consult.el +++ /dev/null @@ -1,47 +0,0 @@ -;;; +consult.el --- consult additions -*- lexical-binding: t -*- - -;;; Code: - -(defun +consult-project-root () - "Return either the current project, or the VC root, of current file." - (if (and (functionp 'project-current) - (project-current)) - (car (project-roots (project-current))) - (vc-root-dir))) - -;;; Cribbed functions -;; https://github.com/minad/consult/wiki - -(defun consult--orderless-regexp-compiler (input type &rest _) - (setq input (orderless-pattern-compiler input)) - (cons - (mapcar (lambda (r) (consult--convert-regexp r type)) input) - (lambda (str) (orderless--highlight input str)))) - -(defmacro consult-history-to-modes (map-hook-alist) - (let (defuns) - (dolist (map-hook map-hook-alist) - (let ((map-name (symbol-name (car map-hook))) - (key-defs `(progn (define-key - ,(car map-hook) - (kbd "M-r") - (function consult-history)) - (define-key ,(car map-hook) - (kbd "M-s") nil)))) - (push (if (cdr map-hook) - `(add-hook ',(cdr map-hook) - (defun - ,(intern (concat map-name - "@consult-history-bind")) - nil - ,(concat - "Bind `consult-history' to M-r in " - map-name ".\n" - "Defined by `consult-history-to-modes'.") - ,key-defs)) - key-defs) - defuns))) - `(progn ,@ (nreverse defuns)))) - -(provide '+consult) -;;; +consult.el ends here diff --git a/lisp/+crux.el b/lisp/+crux.el deleted file mode 100644 index c55a0b9..0000000 --- a/lisp/+crux.el +++ /dev/null @@ -1,58 +0,0 @@ -;;; +crux.el -*- lexical-binding: t; -*- - -;;; Code: - -(require 'crux) - -(defgroup +crux nil - "Extra crux customizations." - :group 'crux - :prefix "+crux-") - -(defun +crux-kill-ring-save (begin end arg) - "Copy region to the kill-ring, possibly indenting it first. -Copy from BEGIN to END using `kill-ring-save' if no argument was -passed, or with `crux-indent-rigidly-and-copy-to-clipboard' if -one was." - (interactive "r\nP") - (call-interactively (if arg - #'crux-indent-rigidly-and-copy-to-clipboard - #'kill-ring-save)) - (pulse-momentary-highlight-region begin end)) - -(defcustom +crux-default-date-format "%c" - "Default date format to use for `+crux-insert-date-or-time'. -Should be a format parsable by `format-time-string'." - :type 'string) - -(defcustom +crux-alternate-date-format "%FT%T%z" - "Alternate date format to use for `+crux-insert-date-or-time'. -Should be a format parsable by `format-time-string'." - :type 'string) - -(defun +crux-insert-date-or-time (arg) - "Insert current date or time. -Called without a prefix ARG, insert the time formatted by -`+crux-default-date-format'. When called with \\[universal-argument], -format the time with `+crux-alternate-date-format'. Otherwise, -prompt for the time format." - (interactive "*P") - (let ((time (current-time))) - (insert (cond - ((null arg) (format-time-string +crux-default-date-format time)) - ((eq (car-safe arg) 4) - (format-time-string +crux-alternate-date-format time)) - (t (format-time-string (read-string "Time Format: ") time)))))) - -(defun +crux-kill-and-join-forward (&optional arg) - "If at end of line, join with following; else (visual)-kill line. -In `visual-line-mode', runs command `kill-visual-line'; in other -modes, runs command `kill-line'. Passes ARG to command when -provided. Deletes whitespace at join." - (interactive "P") - (if (and (eolp) (not (bolp))) - (delete-indentation 1) - (funcall (if visual-line-mode #'kill-visual-line #'kill-line) arg))) - -(provide '+crux) -;;; +crux.el ends here diff --git a/lisp/+cus-edit.el b/lisp/+cus-edit.el deleted file mode 100644 index a67279c..0000000 --- a/lisp/+cus-edit.el +++ /dev/null @@ -1,80 +0,0 @@ -;;; +cus-edit.el -*- lexical-binding: t; -*- - -;;; Commentary: - -;; The naming convention for this library, called "cus-edit.el" on the -;; filesystem, is all over the damn place. Whatever. - -;;; Code: - -(require 'cl-lib) -(require 'seq) - -(defgroup +customize nil - "Extra customize customizations." - :prefix "+customize-" - :group 'customize) - -(defcustom +cus-edit-imenu-generic-expression ; thanks u/oantolin! - `(("Faces" ,(rx (seq bol - (or "Show" "Hide") " " - (group (zero-or-more nonl)) - " face: [sample]")) - 1) - ("Variables" ,(rx (seq bol - (or "Show Value" "Hide") " " - (group (zero-or-more - (not (any "\n:")))))) - 1)) - "Show faces and variables in `imenu' in a `customize' buffer." - :type 'sexp ; This is .. over-simplified. - ) - -(defcustom +custom-variable-allowlist nil - "Variables to allow changing while loading the Custom file.") - -(defcustom +custom-after-load-hook nil - "Functions to run after loading the custom file.") - -(defun +custom-load-ignoring-most-customizations (&optional - error - nomessage - nosuffix - must-suffix) - "Load `custom-file', ignoring most customizations. -Ignore all faces, and only load variables in -`+customize-variable-allowlist'. All the optional -variables---ERROR, NOMESSAGE, NOSUFFIX, MUST-SUFFIX---are -passed on to `load'. - -NOTE: ERROR is the opposite of its value in `load' -- meaning -that this function by default does /not/ error, but will if you -pass t to it." - (cl-letf (((symbol-function 'custom-set-faces) 'ignore) - ((symbol-function 'custom-set-variables) - (lambda (&rest args) - (apply #'custom-theme-set-variables 'user - (seq-filter (lambda (el) - (memq (car el) - +custom-variable-allowlist)) - args))))) - (load custom-file (not error) nomessage nosuffix must-suffix)) - (run-hooks '+custom-after-load-hook)) - -(defun +cus-edit-expand-widgets (&rest _) - "Expand descriptions in `Custom-mode' buffers." - (interactive) - ;; "More/Hide" widgets (thanks alphapapa!) - (widget-map-buttons (lambda (widget _) - (pcase (widget-get widget :off) - ("More" (widget-apply-action widget))) - nil)) - ;; "Show Value" widgets (the little triangles) - (widget-map-buttons (lambda (widget _) - (pcase (widget-get widget :off) - ("Show Value" - (widget-apply-action widget))) - nil))) - -(provide '+cus-edit) -;;; +cus-edit.el ends here diff --git a/lisp/+dired.el b/lisp/+dired.el deleted file mode 100644 index 2e42c19..0000000 --- a/lisp/+dired.el +++ /dev/null @@ -1,28 +0,0 @@ -;;; +dired.el -*- lexical-binding: t -*- - -;;; Code: - -(with-eval-after-load 'vertico - (defun +dired-goto-file (file) - "ADVICE for `dired-goto-file' to make RET call `vertico-exit'." - (interactive ; stolen from `dired-goto-file' - (prog1 - (list (dlet ((vertico-map (copy-keymap vertico-map))) - (define-key vertico-map (kbd "RET") #'vertico-exit) - (expand-file-name (read-file-name "Goto file: " - (dired-current-directory))))) - (push-mark))) - (dired-goto-file file))) - -;;; [[https://www.reddit.com/r/emacs/comments/u2lf9t/weekly_tips_tricks_c_thread/i4n9aoa/?context=3][Dim files in .gitignore]] - -(defun +dired-dim-git-ignores () - "Dim out .gitignore contents" - (require 'vc) - (when-let ((ignores (vc-default-ignore-completion-table 'git ".gitignore")) - (exts (make-local-variable 'completion-ignored-extensions))) - (dolist (item ignores) - (add-to-list exts item)))) - -(provide '+dired) -;;; +dired.el ends here diff --git a/lisp/+ecomplete.el b/lisp/+ecomplete.el deleted file mode 100644 index b1392cf..0000000 --- a/lisp/+ecomplete.el +++ /dev/null @@ -1,45 +0,0 @@ -;;; +ecomplete.el --- ecomplete extras -*- lexical-binding: t; -*- - -;;; Commentary: - -;; see [[https://github.com/oantolin/emacs-config/blob/master/my-lisp/ecomplete-extras.el][oantolin's config]] - -;;; Code: - -(require 'ecomplete) - -(defun +ecomplete--name+address (email) - "Return a pair of the name and address for an EMAIL." - (let (name) - (when (string-match "^\\(?:\\(.*\\) \\)?<\\(.*\\)>$" email) - (setq name (match-string 1 email) - email (match-string 2 email))) - (cons name email))) - -(defun +ecomplete-add-email (email) - "Add email address to ecomplete's database." - (interactive "sEmail address: ") - (pcase-let ((`(,name . ,email) (+ecomplete--name+address email))) - (unless name (setq name (read-string "Name: "))) - (ecomplete-add-item - 'mail email - (format (cond ((equal name "") "%s%s") - ((string-match-p "^\\(?:[A-Za-z0-9 ]*\\|\".*\"\\)$" name) - "%s <%s>") - (t "\"%s\" <%s>")) - name email)) - (ecomplete-save))) - -(defun +ecomplete-remove-email (email) - "Remove email address from ecomplete's database." - (interactive - (list (completing-read "Email address: " - (ecomplete-completion-table 'mail)))) - (when-let ((email (cdr (+ecomplete--name+address email))) - (entry (ecomplete-get-item 'mail email))) - (setf (cdr (assq 'mail ecomplete-database)) - (remove entry (cdr (assq 'mail ecomplete-database)))) - (ecomplete-save))) - -(provide '+ecomplete) -;;; +ecomplete.el ends here diff --git a/lisp/+elfeed.el b/lisp/+elfeed.el deleted file mode 100644 index c3e5301..0000000 --- a/lisp/+elfeed.el +++ /dev/null @@ -1,185 +0,0 @@ -;;; +elfeed.el -*- lexical-binding: t; -*- - -;;; Code: - -(require 'elfeed) - -;; https://karthinks.com/software/lazy-elfeed/ -(defun +elfeed-scroll-up-command (&optional arg) - "Scroll up or go to next feed item in Elfeed" - (interactive "^P") - (let ((scroll-error-top-bottom nil)) - (condition-case-unless-debug nil - (scroll-up-command arg) - (error (elfeed-show-next))))) - -(defun +elfeed-scroll-down-command (&optional arg) - "Scroll up or go to next feed item in Elfeed" - (interactive "^P") - (let ((scroll-error-top-bottom nil)) - (condition-case-unless-debug nil - (scroll-down-command arg) - (error (elfeed-show-prev))))) - -(defun +elfeed-search-browse-generic () - "Browse a url with `browse-url-generic-browser'." - (interactive) - (elfeed-search-browse-url t)) - -(defun +elfeed-show-browse-generic () - "Browse a url with `browse-url-generic-browser'." - (interactive) - (elfeed-show-visit t)) - -(defun +elfeed-show-mark-read-and-advance () - "Mark an item as read and advance to the next item. -If multiple items are selected, don't advance." - (interactive) - (call-interactively #'elfeed-search-untag-all-unread) - (unless (region-active-p) - (call-interactively #'next-line))) - -;;; Fetch feeds async -;; https://github.com/skeeto/elfeed/issues/367 - -(defun +elfeed--update-message () - (message "[Elfeed] Update in progress") - 'ignore) - -(defvar +elfeed--update-running-p nil "Whether an update is currently running.") -(defvar +elfeed--update-count 0 "How many times `+elfeed-update-command' has run.") -(defcustom +elfeed-update-niceness 15 - "How \"nice\" `+elfeed-update-command' should be." - :type 'integer - :group 'elfeed) - -(defcustom +elfeed-update-lockfile - (expand-file-name "+elfeed-update-lock" (temporary-file-directory)) - "The file to ") - -(defun +elfeed-update-command () - (interactive) - (unless (or +elfeed--update-running-p - (derived-mode-p 'elfeed-show-mode 'elfeed-search-mode)) - (let ((script (expand-file-name "/tmp/elfeed-update.el")) - (update-message-format "[Elfeed] Background update: %s")) - (setq +elfeed--update-running-p t) - (elfeed-db-save) - (advice-add 'elfeed :override #'+elfeed--update-message) - (ignore-errors (kill-buffer "*elfeed-search*")) - (ignore-errors (kill-buffer "*elfeed-log*")) - (elfeed-db-unload) - (make-directory (file-name-directory script) :parents) - (with-temp-buffer - (insert - (let ((print-level nil) - (print-length nil)) - (prin1-to-string ;; Print the following s-expression to a string - `(progn - ;; Set up the environment - (setq lexical-binding t) - (load (locate-user-emacs-file "early-init")) - (dolist (pkg '(elfeed elfeed-org)) - (straight-use-package pkg) - (require pkg)) - ;; Copy variables from current environment - (progn - ,@(cl-loop for copy-var in '(rmh-elfeed-org-files - elfeed-db-directory - elfeed-curl-program-name - elfeed-use-curl - elfeed-curl-extra-arguments - elfeed-enclosure-default-dir) - collect `(progn (message "%S = %S" ',copy-var ',(symbol-value copy-var)) - (setq ,copy-var ',(symbol-value copy-var))))) - ;; Define new variables for this environment - (progn - ,@(cl-loop for (new-var . new-val) in '((elfeed-curl-max-connections . 4)) - collect `(progn (message "%S = %S" ',new-var ',new-val) - (setq ,new-var ',new-val)))) - ;; Redefine `elfeed-log' to log everything - (defun elfeed-log (level fmt &rest objects) - (princ (format "[%s] [%s]: %s\n" - (format-time-string "%F %T") - level - (apply #'format fmt objects)))) - ;; Run elfeed - (elfeed-org) - (elfeed) - (elfeed-db-load) - (elfeed-update) - ;; Wait for `elfeed-update' to finish - (let ((q<5-count 0)) - (while (and (> (elfeed-queue-count-total) 0) - (< q<5-count 5)) - (sleep-for 5) - (message "Elfeed queue count total: %s" (elfeed-queue-count-total)) - (when (< (elfeed-queue-count-total) 5) - (cl-incf q<5-count)) - (accept-process-output))) - ;; Garbage collect and save the database - (elfeed-db-gc) - (elfeed-db-save) - (princ (format ,update-message-format "done.")))))) - (write-file script)) - (chmod script #o777) - (message update-message-format "start") - (set-process-sentinel (start-process-shell-command - "Elfeed" "*+elfeed-update-background*" - (format "nice -n %d %s %s" - +elfeed-update-niceness - "emacs -Q --script" - script)) - (lambda (proc stat) - (advice-remove 'elfeed #'+elfeed--update-message) - (setq +elfeed--update-running-p nil) - (unless (string= stat "killed") - (setq +elfeed--update-count (1+ +elfeed--update-count))) - (message update-message-format (string-trim stat))))))) - -(defvar +elfeed--update-timer nil "Timer for `elfeed-update-command'.") -(defvar +elfeed--update-first-time 6 "How long to wait for the first time.") -(defvar +elfeed--update-repeat (* 60 15) "How long between updates.") - -(defcustom +elfeed-update-proceed-hook nil - "Predicates to query before running `+elfeed-update-command'. -Each hook is passed no arguments." - :type 'hook) - -(defun +elfeed-update-command-wrapper () - "Run `+elfeed-update-command', but only sometimes. -If any of the predicates in `+elfeed-update-proceed-hook' return -nil, don't run `+elfeed-update-command'. If they all return -non-nil, proceed." - (when (run-hook-with-args-until-failure '+elfeed-update-proceed-hook) - (+elfeed-update-command))) - -(defun +elfeed--cancel-update-timer () - "Cancel `+elfeed--update-timer'." - (unless +elfeed--update-running-p - (ignore-errors (cancel-timer +elfeed--update-timer)) - (setq +elfeed--update-timer nil))) - -(defun +elfeed--reinstate-update-timer () - "Reinstate `+elfeed--update-timer'." - ;; First, unload the db - (setq +elfeed--update-timer - (run-at-time +elfeed--update-first-time - +elfeed--update-repeat - #'+elfeed-update-command-wrapper))) - -(define-minor-mode +elfeed-update-async-mode - "Minor mode to update elfeed async-style." - :global t - (if +elfeed-update-async-mode - (progn ; enable - (+elfeed--reinstate-update-timer) - (advice-add 'elfeed :before '+elfeed--cancel-update-timer) - (advice-add 'elfeed-search-quit-window :after '+elfeed--reinstate-update-timer)) - (progn ; disable - (advice-remove 'elfeed '+elfeed--cancel-update-timer) - (advice-remove 'elfeed-search-quit-window '+elfeed--reinstate-update-timer) - (+elfeed--cancel-update-timer)))) - -(provide '+elfeed) -;;; +elfeed.el ends here diff --git a/lisp/+elisp.el b/lisp/+elisp.el deleted file mode 100644 index 3eafbf3..0000000 --- a/lisp/+elisp.el +++ /dev/null @@ -1,18 +0,0 @@ -;;; +elisp.el -*- lexical-binding: t; -*- - -;;; Code: - -(defun +elisp-eval-region-or-buffer () - (interactive) - (if (region-active-p) - (eval-region (region-beginning) (region-end)) - (+eval-region@pulse (lambda (_ _) (eval-buffer)) (point-min) (point-max)))) - -;; Should I move this to `+pulse' ? -(defun +eval-region@pulse (advised beg end &rest args) - "ADVICE to pulse an eval'd region." - (apply advised beg end args) - (pulse-momentary-highlight-region beg end)) - -(provide '+elisp) -;;; +elisp.el ends here diff --git a/lisp/+emacs.el b/lisp/+emacs.el deleted file mode 100644 index 9158b62..0000000 --- a/lisp/+emacs.el +++ /dev/null @@ -1,434 +0,0 @@ -;;; +emacs.el --- measured defaults for Emacs -*- lexical-binding: t -*- - -;;; Commentary: - -;; I find myself copy-pasting a lot of "boilerplate" type code when -;; bankrupting my Emacs config and starting afresh. Instead of doing -;; that, I'm putting it here, where it'll be easier to include in my -;; config. - -;; Of course, some might say I could just ... stop bankrupting my -;; Emacs. But like, why would I want to? - -;; Other notable packages include -;; - https://git.sr.ht/~technomancy/better-defaults/ -;; - https://github.com/susam/emfy - -;;; Code: - -(require 'early-init (locate-user-emacs-file "early-init.el")) - -(defun +set-major-mode-from-buffer-name (&optional buf) - "Set the major mode for BUF from the buffer's name. -Do this only if the buffer is not visiting a file." - (unless buffer-file-name - (let ((buffer-file-name (buffer-name buf))) - (set-auto-mode)))) - - -;;; General settings - -(setq-default - apropos-do-all t - async-shell-command-buffer 'new-buffer - async-shell-command-display-buffer nil - auto-hscroll-mode 'current-line - auto-revert-verbose t - auto-save-default nil - auto-save-file-name-transforms `((".*" ,(.etc "auto-save/") ,(car (secure-hash-algorithms))) - (".*" ,(.etc "auto-save/") t)) - auto-save-interval 30 - auto-save-list-file-prefix (.etc "auto-save/.saves-" t) - auto-save-timeout 30 - auto-save-visited-interval 5 - auto-window-vscroll nil - backup-by-copying t - backup-directory-alist `((".*" . ,(.etc "backup/" t))) - blink-cursor-blinks 1 - comp-deferred-compilation nil - completion-category-defaults nil - completion-category-overrides '((file (styles . (partial-completion)))) - completion-ignore-case t - completion-styles '(substring partial-completion) - create-lockfiles nil - cursor-in-non-selected-windows 'hollow - cursor-type 'bar - custom-file (.etc "custom.el") - delete-old-versions t - echo-keystrokes 0.1 - ediff-window-setup-function 'ediff-setup-windows-plain - eldoc-echo-area-use-multiline-p nil - eldoc-idle-delay 0.1 - enable-recursive-minibuffers t - executable-prefix-env t - fast-but-imprecise-scrolling t - file-name-shadow-properties '(invisible t intangible t) - fill-column 80 - find-file-visit-truename t - frame-resize-pixelwise t - global-auto-revert-non-file-buffers t - global-mark-ring-max 100 - hscroll-margin 1 - hscroll-step 1 - imenu-auto-rescan t - image-use-external-converter (or (executable-find "convert") - (executable-find "gm") - (executable-find "ffmpeg")) - indent-tabs-mode nil - inhibit-startup-screen t - initial-buffer-choice t - kept-new-versions 6 - kept-old-versions 2 - kill-do-not-save-duplicates t - kill-read-only-ok t - kill-ring-max 500 - kmacro-ring-max 20 - load-prefer-newer noninteractive - major-mode '+set-major-mode-from-buffer-name - mark-ring-max 50 - minibuffer-eldef-shorten-default t - minibuffer-prompt-properties (list 'read-only t - 'cursor-intangible t - 'face 'minibuffer-prompt) - mode-require-final-newline 'visit-save - mouse-drag-copy-region t - mouse-wheel-progressive-speed nil - mouse-yank-at-point t - native-comp-async-report-warnings-errors 'silent - native-comp-deferred-compilation nil - read-answer-short t - read-buffer-completion-ignore-case t - ;; read-extended-command-predicate - ;; (when (fboundp - ;; 'command-completion-default-include-p) - ;; 'command-completion-default-include-p) - read-process-output-max (+bytes 1 :mib) ; We’re in the future man. Set that to at least a megabyte - recenter-positions '(top middle bottom) - regexp-search-ring-max 100 - regexp-search-ring-max 200 - save-interprogram-paste-before-kill t - save-some-buffers-default-predicate #'+save-some-buffers-p - scroll-conservatively 101 - scroll-down-aggressively 0.01 - scroll-margin 2 - scroll-preserve-screen-position 1 - scroll-step 1 - scroll-up-aggressively 0.01 - search-ring-max 200 - search-ring-max 200 - sentence-end-double-space t - set-mark-command-repeat-pop t - show-paren-delay 0 - show-paren-style 'parenthesis - show-paren-when-point-in-periphery t - show-paren-when-point-inside-paren t - ;;show-trailing-whitespace t - tab-bar-show 1 - tab-width 8 ; so alignment expecting the default looks right - tramp-backup-directory-alist backup-directory-alist - undo-limit 100000000 ; 10 MB - use-dialog-box nil - use-file-dialog nil - use-short-answers t - vc-follow-symlinks t - vc-make-backup-files t - version-control t - view-read-only t - visible-bell nil - window-resize-pixelwise t - x-select-enable-clipboard t - x-select-enable-primary t - yank-pop-change-selection t - ) - -;; Programming language offsets. -;; Set these after the initial block so I can use `tab-width' -(setq-default - c-basic-offset tab-width) - -;; Emacs 28 ships with an option, `use-short-answers', that makes this form -;; obsolete, but I still use 27 at work. -(when (version< emacs-version "28") - (fset 'yes-or-no-p 'y-or-n-p)) - - -;;; Encodings - -;; Allegedly, this is the only one you need... -(set-language-environment "UTF-8") -;; But I still set all of these, for fun. -(setq-default locale-coding-system 'utf-8-unix - coding-system-for-read 'utf-8-unix - coding-system-for-write 'utf-8-unix - buffer-file-coding-system 'utf-8-unix - default-process-coding-system '(utf-8-unix . utf-8-unix) - x-select-request-type '(UTF8_STRING - COMPOUND_TEXT - TEXT - STRING)) - -(set-charset-priority 'unicode) -(prefer-coding-system 'utf-8-unix) -(set-default-coding-systems 'utf-8-unix) -(set-terminal-coding-system 'utf-8-unix) -(set-keyboard-coding-system 'utf-8-unix) - -(pcase system-type - ((or 'ms-dos 'windows-nt) - (set-clipboard-coding-system 'utf-16-le) - (set-selection-coding-system 'utf-16-le)) - (_ - (set-selection-coding-system 'utf-8) - (set-clipboard-coding-system 'utf-8))) - - -;;; Modes - -(dolist (enable-mode '(global-auto-revert-mode - blink-cursor-mode - electric-pair-mode - show-paren-mode - global-so-long-mode - minibuffer-depth-indicate-mode - file-name-shadow-mode - minibuffer-electric-default-mode - delete-selection-mode - auto-save-visited-mode - ;; column-number-mode - )) - (when (fboundp enable-mode) - (funcall enable-mode +1))) - -(dolist (disable-mode '(tooltip-mode - tool-bar-mode - menu-bar-mode - scroll-bar-mode - horizontal-scroll-bar-mode)) - (when (fboundp disable-mode) - (funcall disable-mode -1))) - - -;;; Hooks - -(add-hook 'after-save-hook #'executable-make-buffer-file-executable-if-script-p) -(add-hook 'minibuffer-setup-hook #'cursor-intangible-mode) - -(defun +auto-create-missing-dirs () - "Automatically create missing directories when finding a file." - ;; https://emacsredux.com/blog/2022/06/12/auto-create-missing-directories/ - (let ((target-dir (file-name-directory buffer-file-name))) - (unless (file-exists-p target-dir) - (make-directory target-dir t)))) - -(add-hook 'find-file-not-found-functions #'+auto-create-missing-dirs) - -(defvar +save-some-buffers-debounce-time nil - "Last time `+save-some-buffers-debounce' was run.") - -(defcustom +save-some-buffers-debounce-timeout 5 - "Number of seconds to wait before saving buffers again.") - -(defun +save-some-buffers-debounce (&rest _) - "Run `save-some-buffers', but only if it's been a while." - (unless (and +save-some-buffers-debounce-time - (< (- (time-convert nil 'integer) +save-some-buffers-debounce-time) - +save-some-buffers-debounce-timeout)) - (save-some-buffers t) - (setq +save-some-buffers-debounce-time (time-convert nil 'integer)))) - -(add-function :after after-focus-change-function #'+save-some-buffers-debounce) - - -;;; Better-default functions ... - -(defun +cycle-spacing (&optional n preserve-nl-back mode) - "Negate N argument on `cycle-spacing'. -That is, with a positive N, deletes newlines as well, leaving -N -spaces. If N is negative, it will not delete newlines and leave -N spaces. See docstring of `cycle-spacing' for the meaning of -PRESERVE-NL-BACK and MODE." - (interactive "*p") - (cycle-spacing (- n) preserve-nl-back mode)) - -(defun +save-buffers-quit (&optional arg) - "Silently save each buffer, then kill the current connection. -If the current frame has no client, kill Emacs itself using -`save-buffers-kill-emacs' after confirming with the user. - -With prefix ARG, silently save all file-visiting buffers, then -kill without asking." - (interactive "P") - (save-some-buffers t) - (if (and (not (frame-parameter nil 'client)) - (and (not arg))) - (when (yes-or-no-p "Sure you want to quit? ") - (save-buffers-kill-emacs)) - (delete-frame nil :force))) - -(defun +kill-word-backward-or-region (&optional arg backward-kill-word-fn) - "Kill active region or ARG words backward. -BACKWARD-KILL-WORD-FN is the function to call to kill a word -backward. It defaults to `backward-kill-word'." - (interactive "P") - (call-interactively (if (region-active-p) - #'kill-region - (or backward-kill-word-fn #'backward-kill-word)))) - -(defun +backward-kill-word-wrapper (fn &optional arg) - "Kill backward using FN until the beginning of a word, smartly. -If point is on at the beginning of a line, kill the previous new -line. If the only thing before point on the current line is -whitespace, kill that whitespace. - -With argument ARG: if ARG is a number, just call FN -ARG times. Otherwise, just call FN." - ;; I want this to be a wrapper so that I can call other word-killing functions - ;; with it. It's *NOT* advice because those functions probably use - ;; `backward-kill-word' under the hood (looking at you, paredit), so advice - ;; will make things weird. - (if (null arg) - (cond - ((looking-back "^" 1) - (let ((delete-active-region nil)) - (delete-backward-char 1))) - ((looking-back "^[ ]*") - (delete-horizontal-space :backward-only)) - (t (call-interactively fn))) - (funcall fn (if (listp arg) 1 arg)))) - -(defun +backward-kill-word (&optional arg) - "Kill word backward using `backward-kill-word'. -ARG is passed to `backward-kill-word'." - (interactive "P") - (+backward-kill-word-wrapper #'backward-kill-word arg)) - -;;; ... and advice - -;; Indent the region after a yank. -(defun +yank@indent (&rest _) - "Indent the current region." - (indent-region (min (point) (mark)) (max (point) (mark)))) -(advice-add #'yank :after #'+yank@indent) -(advice-add #'yank-pop :after #'+yank@indent) - - -;;; Extra functions - -(defun +save-some-buffers-p () - "Predicate for `save-some-buffers-default-predicate'. -It returns nil with remote files and those without attached files." - (and (buffer-file-name) - (not (file-remote-p (buffer-file-name))))) - -;; https://www.wwwtech.de/articles/2013/may/emacs:-jump-to-matching-paren-beginning-of-block -(defun +goto-matching-paren (&optional arg) - "Go to the matching paren, similar to vi's %." - (interactive "p") - (or arg (setq arg 1)) - (cond - ;; Check for "outside of bracket" positions - ((looking-at "[\[\(\{]") (forward-sexp arg)) - ((looking-back "[\]\)\}]" 1) (backward-sexp arg)) - ;; Otherwise, move from inside the bracket - ((looking-at "[\]\)\}]") (forward-char) (backward-sexp arg)) - ((looking-back "[\[\(\{]" 1) (backward-char) (forward-sexp arg)) - (t (up-list arg t t)))) - -(defun +delete-window-or-bury-buffer () - "Delete the current window, or bury the current buffer. -If the current window is the only window, bury the buffer." - (interactive) - (condition-case e - (delete-window) - (t (bury-buffer)))) - - -;;; Bindings - -(global-set-key (kbd "C-x C-c") #'+save-buffers-quit) -(global-set-key (kbd "M-SPC") #'+cycle-spacing) -(global-set-key (kbd "M-/") #'hippie-expand) -(global-set-key (kbd "M-=") #'count-words) -(global-set-key (kbd "C-x C-b") #'ibuffer) -(global-set-key (kbd "C-s") #'isearch-forward-regexp) -(global-set-key (kbd "C-r") #'isearch-backward-regexp) -(global-set-key (kbd "C-M-s") #'isearch-forward) -(global-set-key (kbd "C-M-r") #'isearch-backward) -(global-set-key (kbd "C-x 4 n") #'clone-buffer) -;; https://christiantietze.de/posts/2022/07/shift-click-in-emacs-to-select/ -(global-set-key (kbd "S-") #'mouse-set-mark) -(global-set-key (kbd "C-x 0") #'+delete-window-or-bury-buffer) - - -;;; Required libraries - -(when (require 'uniquify nil :noerror) - (setq-default uniquify-buffer-name-style 'forward - uniquify-separator path-separator - uniquify-after-kill-buffer-p t - uniquify-ignore-buffers-re "^\\*")) - -(when (require 'goto-addr) - (if (fboundp 'global-goto-address-mode) - (global-goto-address-mode +1) - (add-hook 'after-change-major-mode-hook 'goto-address-mode))) - -(when (require 'recentf nil :noerror) - (setq-default recentf-save-file (.etc "recentf.el") - recentf-max-menu-items 100 - recentf-max-saved-items nil - recentf-auto-cleanup 'mode) - (add-to-list 'recentf-exclude .etc) - (recentf-mode +1)) - -(when (require 'savehist nil :noerror) - (setq-default history-length t - history-delete-duplicates t - history-autosave-interval 60 - savehist-file (.etc "savehist.el") - ;; Other variables --- don't truncate any of these. - ;; `add-to-history' uses the values of these variables unless - ;; they're nil, in which case it falls back to `history-length'. - kill-ring-max 100 - mark-ring-max 100 - global-mark-ring-max 100 - regexp-search-ring-max 100 - search-ring-max 100 - kmacro-ring-max 100 - eww-history-limit 100) - (dolist (var '(extended-command-history - global-mark-ring - mark-ring - kill-ring - kmacro-ring - regexp-search-ring - search-ring)) - (add-to-list 'savehist-additional-variables var)) - (savehist-mode +1)) - -(when (require 'saveplace nil :noerror) - (setq-default save-place-file (.etc "places.el") - save-place-forget-unreadable-files (eq system-type 'gnu/linux)) - (save-place-mode +1)) - -;; (when (require 'tramp) -;; ;; thanks Irreal! https://irreal.org/blog/?p=895 -;; (add-to-list 'tramp-default-proxies-alist -;; '(nil "\\`root\\'" "/ssh:%h:")) -;; (add-to-list 'tramp-default-proxies-alist -;; '((regexp-quote (system-name)) nil nil))) - - -;;; Newer features -;; These aren't in older version of Emacs, but they're so nice. - -(when (fboundp 'repeat-mode) - (setq-default repeat-exit-key "g" - repeat-exit-timeout 5) - (repeat-mode +1)) - -(when (fboundp 'pixel-scroll-precision-mode) - (pixel-scroll-precision-mode +1)) - -(provide '+emacs) -;;; +emacs.el ends here diff --git a/lisp/+embark.el b/lisp/+embark.el deleted file mode 100644 index e66d4b3..0000000 --- a/lisp/+embark.el +++ /dev/null @@ -1,28 +0,0 @@ -;;; +embark.el -*- lexical-binding: t; -*- - -;;; Commentary: - -;; https://github.com/oantolin/embark/wiki/Additional-Actions - -;;; Code: - -(require 'embark) - -(embark-define-keymap embark-straight-map - ("u" straight-visit-package-website) - ("r" straight-get-recipe) - ("i" straight-use-package) - ("c" straight-check-package) - ("F" straight-pull-package) - ("f" straight-fetch-package) - ("p" straight-push-package) - ("n" straight-normalize-package) - ("m" straight-merge-package)) - -(add-to-list 'embark-keymap-alist '(straight . embark-straight-map)) - -(with-eval-after-load 'marginalia - (add-to-list 'marginalia-prompt-categories '("recipe\\|package" . straight))) - -(provide '+embark) -;;; +embark.el ends here diff --git a/lisp/+emms.el b/lisp/+emms.el deleted file mode 100644 index 403cbff..0000000 --- a/lisp/+emms.el +++ /dev/null @@ -1,46 +0,0 @@ -;;; +emms.el --- EMMS customizations -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -(require 'emms-player-mpv) -(require 'el-patch) - -;; https://lists.gnu.org/archive/html/emms-help/2022-01/msg00006.html -(el-patch-feature emms-player-mpv) -(with-eval-after-load 'emms-player-mpv - (el-patch-defun emms-player-mpv-start (track) - (setq emms-player-mpv-stopped nil) - (emms-player-mpv-proc-playing nil) - (let - ((track-name (emms-track-get track 'name)) - (track-is-playlist (memq (emms-track-get track 'type) - '(streamlist playlist)))) - (if (emms-player-mpv-ipc-fifo-p) - (progn - ;; ipc-stop is to clear any buffered commands - (emms-player-mpv-ipc-stop) - (emms-player-mpv-proc-init (if track-is-playlist "--playlist" "--") - track-name) - (emms-player-started emms-player-mpv)) - (let* - ((play-cmd - `(batch - ((,(el-patch-swap - (if track-is-playlist 'loadlist 'loadfile) - 'loadfile) - ,track-name replace)) - ((set pause no)))) - (start-func - ;; Try running play-cmd and retry it on connection failure, e.g. if mpv died - (apply-partially 'emms-player-mpv-cmd play-cmd - (lambda (_mpv-data mpv-error) - (when (eq mpv-error 'connection-error) - (emms-player-mpv-cmd play-cmd)))))) - (if emms-player-mpv-ipc-stop-command - (setq emms-player-mpv-ipc-stop-command start-func) - (funcall start-func))))))) - -(provide '+emms) -;;; +emms.el ends here diff --git a/lisp/+eshell.el b/lisp/+eshell.el deleted file mode 100644 index b874141..0000000 --- a/lisp/+eshell.el +++ /dev/null @@ -1,126 +0,0 @@ -;;; +eshell.el -*- lexical-binding: t; -*- - -;;; Code: - -;; https://karthinks.com/software/jumping-directories-in-eshell/ -(defun eshell/z (&optional regexp) - "Navigate to a previously visited directory in eshell, or to -any directory proferred by `consult-dir'." - (let ((eshell-dirs (delete-dups - (mapcar 'abbreviate-file-name - (ring-elements eshell-last-dir-ring))))) - (cond - ((and (not regexp) (featurep 'consult-dir)) - (let* ((consult-dir--source-eshell `(:name "Eshell" - :narrow ?e - :category file - :face consult-file - :items ,eshell-dirs)) - (consult-dir-sources (cons consult-dir--source-eshell - consult-dir-sources))) - (eshell/cd (substring-no-properties - (consult-dir--pick "Switch directory: "))))) - (t (eshell/cd (if regexp (eshell-find-previous-directory regexp) - (completing-read "cd: " eshell-dirs))))))) - -;;; Start and quit - -;; from https://old.reddit.com/r/emacs/comments/1zkj2d/advanced_usage_of_eshell/ -(defun +eshell-here () - "Go to eshell and set current directory to current buffer's." - ;; consider: make a new eshell buffer when given a prefix argument. - (interactive) - (let ((dir (file-name-directory (or (buffer-file-name) - default-directory)))) - (eshell) - (eshell/pushd ".") - (cd dir) - (goto-char (point-max)) - (eshell-kill-input) - (eshell-send-input) - (setq-local scroll-margin 0) - (recenter 0))) - -(defun +eshell-quit-or-delete-char (arg) - "Delete the character to the right, or quit eshell on an empty line." - (interactive "p") - (if (and (eolp) (looking-back eshell-prompt-regexp)) - (progn (eshell-life-is-too-much) - (when (and (<= 1 (count-windows)) - ;; TODO: This is not what I want. What I really want is - ;; for an eshell-only frame (i.e., called from a - ;; keybind) to delete itself, but a regular Emacs frame - ;; with Eshell inside to stick around. I think I'll - ;; need to make a frame-local (?) variable for that to - ;; work. - (> (length (frame-list)) 2) - server-process) - (delete-frame))) - (delete-forward-char arg))) - -;;; Insert previous arguments -;; Record arguments - -(defvar eshell-arg-history nil) -(defvar eshell-arg-history-index nil) -(add-to-list 'savehist-additional-variables 'eshell-arg-history) - -(defun eshell-record-args (&rest _) - "Record unique arguments onto the front of `eshell-arg-history'." - (setq eshell-arg-history - (cl-loop with history = eshell-arg-history - for arg in (reverse eshell-last-arguments) - do (setq history (cons arg (remove arg history))) - finally return history))) - -(defun eshell-insert-prev-arg () - "Insert an argument from `eshell-arg-history' at point." - (interactive) - (if (eq last-command 'eshell-insert-prev-arg) - (progn - (let ((pos (point))) - (eshell-backward-argument 1) - (delete-region (point) pos)) - (if-let ((text (nth eshell-arg-history-index - eshell-arg-history))) - (progn - (insert text) - (cl-incf eshell-arg-history-index)) - (insert (cl-first eshell-arg-history)) - (setq eshell-arg-history-index 1))) - (insert (cl-first eshell-arg-history)) - (setq eshell-arg-history-index 1))) - -;;;###autoload -(define-minor-mode eshell-arg-hist-mode - "Minor mode to enable argument history, like bash/zsh with M-." - :lighter "$." - :keymap (let ((map (make-sparse-keymap))) - (define-key map (kbd "M-.") #'eshell-insert-prev-arg) - map) - (if eshell-arg-hist-mode - (add-hook 'eshell-post-command-hook #'eshell-record-args nil t) - (remove-hook 'eshell-post-command-hook #'eshell-record-args t))) - -;;;###autoload -(defmacro +eshell-eval-after-load (&rest forms) - "Execute FORMS after Eshell is loaded. -If Eshell is already loaded in the session, immediately execute -forms. - -I wrote this because Eshell doesn't properly do loading or -something, it's really annoying to work with." - (declare (indent 0)) - `(progn - (defun +eshell@setup () - "Setup the Eshell session." - ,@forms) - (when (featurep 'eshell) - `(dolist (buf (buffer-list)) - (with-current-buffer buf - (when (derived-mode-p 'eshell-mode) - (+eshell@setup))))) - (add-hook 'eshell-mode-hook #'+eshell@setup))) - -(provide '+eshell) -;;; +eshell.el ends here diff --git a/lisp/+eww.el b/lisp/+eww.el deleted file mode 100644 index 8d53571..0000000 --- a/lisp/+eww.el +++ /dev/null @@ -1,71 +0,0 @@ -;;; +eww.el -*- lexical-binding: t; -*- - -;;; Code: - -(require 'bookmark) -(require 'eww) - -;; Track whether the current page is readable - -(defvar-local +eww-readable-p nil - "Whether `eww-readable' has been toggled on the current buffer.") - -(defun +eww-mark-readable (&rest _) - "ADVICE to mark current eww buffer \"readable.\"" - (setq-local +eww-readable-p t)) - -(defun +eww-mark-unreadable (&rest _) - "ADVICE to mark current eww buffer \"unreadable.\"" - (setq-local +eww-readable-p nil)) - -(defvar +eww-readable-unreadable-after-functions '(eww-render - eww-reload - eww-back-url) - "Functions after which the page is rendered \"unreadable\".") - -;;;###autoload -(define-minor-mode +eww-track-readable-mode - "Track whether the current webpage has been rendered readable." - :lighter "" - (if +eww-track-readable-mode - (progn - (advice-add 'eww-readable :after #'+eww-mark-readable) - (dolist (func +eww-readable-unreadable-after-functions) - (advice-add func :after #'+eww-mark-unreadable))) - (dolist (func +eww-readable-unreadable-after-functions) - (advice-remove func #'+eww-mark-unreadable)) - (advice-remove 'eww-readable #'+eww-mark-readable))) - -;; Integrate bookmarks in eww - -(defun +eww-bookmark--make () - "Make eww bookmark record." - `((filename . ,(plist-get eww-data :url)) - (title . ,(plist-get eww-data :title)) - (time . ,(current-time-string)) - (handler . ,#'+eww-bookmark-handler) - (defaults . (,(concat - ;; url without the https and path - (replace-regexp-in-string - "/.*" "" - (replace-regexp-in-string - "\\`https?://" "" - (plist-get eww-data :url))) - " - " - ;; page title - (replace-regexp-in-string - "\\` +\\| +\\'" "" - (replace-regexp-in-string - "[\n\t\r ]+" " " - (plist-get eww-data :title)))))))) - -(defun +eww-bookmark-handler (bm) - "Handler for eww bookmarks." - (eww-browse-url (alist-get 'filename bm))) - -(defun +eww-bookmark-setup () - "Setup eww bookmark integration." - (setq-local bookmark-make-record-function #'+eww-bookmark--make)) - -(provide '+eww) -;;; +eww.el ends here diff --git a/lisp/+expand-region.el b/lisp/+expand-region.el deleted file mode 100644 index 8aac3ce..0000000 --- a/lisp/+expand-region.el +++ /dev/null @@ -1,24 +0,0 @@ -;;; +expand-region.el -*- lexical-binding: t; -*- - -;;; Commentary: - -;; - -;;; Code: - -;; Because of `wrap-region', I can't use `expand-region-fast-keys-enabled'. So -;; instead of that, I'm adding this to the binding to C--, but I also want to be -;; able to use the negative argument. So there's this. -(defun +er/contract-or-negative-argument (arg) - "Contract the region if the last command expanded it. -Otherwise, pass the ARG as a negative argument." - (interactive "p") - (cond ((memq last-command '(er/expand-region - er/contract-region - +er/contract-or-negative-argument)) - - (er/contract-region arg)) - (t (call-interactively #'negative-argument)))) - -(provide '+expand-region) -;;; +expand-region.el ends here diff --git a/lisp/+finger.el b/lisp/+finger.el deleted file mode 100644 index 1a878bc..0000000 --- a/lisp/+finger.el +++ /dev/null @@ -1,46 +0,0 @@ -;;; +finger.el --- Finger bugfix -*- lexical-binding: t; -*- - -;;; Commentary: - -;; `net-utils' defines `finger', which purportedly consults -;; `finger-X.500-host-regexps' to determine what hosts to only send a username -;; to. I've found that that is not the case, and so I've patched it. At some -;; point I'll submit this to Emacs itself. - -;;; Code: - -(require 'net-utils) ; this requires everything else I'll need. -(require 'seq) - -(defun finger (user host) - "Finger USER on HOST. -This command uses `finger-X.500-host-regexps' -and `network-connection-service-alist', which see." - ;; One of those great interactive statements that's actually - ;; longer than the function call! The idea is that if the user - ;; uses a string like "pbreton@cs.umb.edu", we won't ask for the - ;; host name. If we don't see an "@", we'll prompt for the host. - (interactive - (let* ((answer (read-from-minibuffer "Finger User: " - (net-utils-url-at-point))) - (index (string-match (regexp-quote "@") answer))) - (if index - (list (substring answer 0 index) - (substring answer (1+ index))) - (list answer - (read-from-minibuffer "At Host: " - (net-utils-machine-at-point)))))) - (let* ((user-and-host (concat user "@" host)) - (process-name (concat "Finger [" user-and-host "]")) - (regexps finger-X.500-host-regexps) - ) ;; found - (when (seq-some (lambda (r) (string-match-p r host)) regexps) - (setq user-and-host user)) - (run-network-program - process-name - host - (cdr (assoc 'finger network-connection-service-alist)) - user-and-host))) - -(provide '+finger) -;;; +finger.el ends here diff --git a/lisp/+flyspell-correct.el b/lisp/+flyspell-correct.el deleted file mode 100644 index 22f8c82..0000000 --- a/lisp/+flyspell-correct.el +++ /dev/null @@ -1,24 +0,0 @@ -;;; +flyspell-correct.el --- -*- lexical-binding: t; -*- - -;;; Code: - -(require 'flyspell-correct) - -(defun +flyspell-correct-buffer (&optional prefix) - "Run `flyspell-correct-wrapper' on all misspelled words in the buffer. -With PREFIX, prompt to change the current dictionary." - (interactive "P") - (flyspell-buffer) - (when prefix - (let ((current-prefix-arg nil)) - (call-interactively #'ispell-change-dictionary))) - (+with-message "Checking spelling" - (flyspell-correct-move (point-min) :forward :rapid))) - -(defun +flyspell-correct-buffer-h (&rest _) - "Run `+flyspell-correct-buffer'. -This is suitable for placement in a hook." - (+flyspell-correct-buffer)) - -(provide '+flyspell-correct) -;;; +flyspell-correct.el ends here diff --git a/lisp/+god-mode.el b/lisp/+god-mode.el deleted file mode 100644 index f70e76b..0000000 --- a/lisp/+god-mode.el +++ /dev/null @@ -1,17 +0,0 @@ -;;; +god-mode.el -*- lexical-binding: t; -*- - -;;; Code: - -(defun +god-mode-insert () - "Leave `god-local-mode' at point." - (interactive) - (god-local-mode -1)) - -(defun +god-mode-append () - "Leave `god-local-mode' after point." - (interactive) - (forward-char 1) - (god-local-mode -1)) - -(provide '+god-mode) -;;; +god-mode.el ends here diff --git a/lisp/+hideshow.el b/lisp/+hideshow.el deleted file mode 100644 index e60efb8..0000000 --- a/lisp/+hideshow.el +++ /dev/null @@ -1,44 +0,0 @@ -;;; +hideshow.el -*- lexical-binding: t; -*- - -;;; Commentary: - -;; initiated by https://karthinks.com/software/simple-folding-with-hideshow/ - -;;; Code: - -(defun +hs-cycle (&optional level) - (interactive "p") - (let (message-log-max - (inhibit-message t)) - (if (= level 1) - (pcase last-command - ('+hs-cycle - (hs-hide-level 1) - (setq this-command 'hs-cycle-children)) - ('hs-cycle-children - ;; TODO: Fix this case. `hs-show-block' needs to be - ;; called twice to open all folds of the parent - ;; block. - (save-excursion (hs-show-block)) - (hs-show-block) - (setq this-command 'hs-cycle-subtree)) - ('hs-cycle-subtree - (hs-hide-block)) - (_ - (if (not (hs-already-hidden-p)) - (hs-hide-block) - (hs-hide-level 1) - (setq this-command 'hs-cycle-children)))) - (hs-hide-level level) - (setq this-command 'hs-hide-level)))) - -(defun +hs-global-cycle () - (interactive) - (pcase last-command - ('+hs-global-cycle - (save-excursion (hs-show-all)) - (setq this-command 'hs-global-show)) - (_ (hs-hide-all)))) - -(provide '+hideshow) -;;; +hideshow.el ends here diff --git a/lisp/+init.el b/lisp/+init.el deleted file mode 100644 index 903f2dc..0000000 --- a/lisp/+init.el +++ /dev/null @@ -1,117 +0,0 @@ -;;; +init.el --- extra init.el stuff -*- lexical-binding: t -*- - -;;; Commentary: - -;; Yes, I edit my init.el often enough I need to write a mode for it. The -;; sorting function is based on code from -;; https://github.com/alphapapa/unpackaged.el - -;;; Code: - -(require '+lisp) - -;;; Sort `setup' forms - -(defun +init--sexp-setup-p (sexp-str &optional head) - "Is SEXP-STR a `setup' form, optionally with a HEAD form?" - (let ((head (if (and head (symbolp head)) - (symbol-name head) - head))) - (and (string-match-p (rx (: bos (* whitespace) "(setup")) sexp-str) - (if head - (string-match-p (concat "\\`.*" head) sexp-str) - t)))) - -(defun +init-sort () - "Sort init.el. -Sort based on the following heuristic: `setup' forms (the -majority of my init.el) are sorted after everything else, and -within that group, forms with a HEAD of `:require' are sorted -first, and `:straight' HEADs are sorted last. All other forms -are sorted lexigraphically." - (interactive) - ;; I have to make my own "version" of `save-excursion', since the mark and - ;; point are lost (I think that's the problem) when sorting the buffer. - (let* ((current-point (point)) - (current-defun (beginning-of-defun)) - (defun-point (- current-point (point))) - (current-defun-re (buffer-substring-no-properties (line-beginning-position) - (line-end-position)))) - (widen) ; It makes no sense to `save-restriction' - (+lisp-sort-sexps - (point-min) (point-max) - ;; Key function - nil - ;; Sort function - (lambda (s1 s2) - (let ((s1 (cdr s1)) (s2 (cdr s2))) - (cond - ;; Sort everything /not/ `setup' /before/ `setup' - ((and (+init--sexp-setup-p s1) - (not (+init--sexp-setup-p s2))) - nil) - ((and (+init--sexp-setup-p s2) - (not (+init--sexp-setup-p s1))) - t) - ;; otherwise... - (t (let ((s1-straight (+init--sexp-setup-p s1 :straight)) - (s2-straight (+init--sexp-setup-p s2 :straight)) - (s1-require (+init--sexp-setup-p s1 :require)) - (s2-require (+init--sexp-setup-p s2 :require))) - (cond - ;; `:straight' setups have extra processing - ((and s1-straight s2-straight) - (let* ((r (rx (: ":straight" (? "-when") (* space) (? "(")))) - (s1 (replace-regexp-in-string r "" s1)) - (s2 (replace-regexp-in-string r "" s2))) - (string< s1 s2))) - ;; `:require' setups go first - ((and s1-require (not s2-require)) t) - ((and s2-require (not s1-require)) nil) - ;; `:straight' setups go last - ((and s1-straight (not s2-straight)) nil) - ((and s2-straight (not s1-straight)) t) - ;; otherwise, sort lexigraphically - (t (string< s1 s2))))))))) - ;; Return to original point relative to the defun we were in - (ignore-errors (goto-char (point-min)) - (re-search-forward current-defun-re) - (beginning-of-defun) - (goto-char (+ (point) defun-point))))) - -(defun +init-sort-then-save () - "Sort init.el, then save it." - (interactive) - (+init-sort) - (if (fboundp #'user-save-buffer) - (user-save-buffer) - (save-buffer))) - -;;; Add `setup' forms to `imenu-generic-expression' - -(defun +init-add-setup-to-imenu () - "Recognize `setup' forms in `imenu'." - ;; `imenu-generic-expression' automatically becomes buffer-local when set - (setf (alist-get "Setup" imenu-generic-expression nil nil #'equal) - (list - (rx (: "(setup" (+ space) - (group (? "(") (* nonl)))) - 1)) - (when (boundp 'consult-imenu-config) - (setf (alist-get ?s - (plist-get - (alist-get 'emacs-lisp-mode consult-imenu-config) - :types)) - '("Setup")))) - -;;; Major mode - -;;;###autoload -(define-derived-mode +init-mode emacs-lisp-mode "Init.el" - "`emacs-lisp-mode', but with a few specialized bits and bobs for init.el.") - -;;;###autoload -(add-to-list 'auto-mode-alist '("/init\\.el\\'" . +init-mode)) - -(provide '+init) -;;; +init.el ends here diff --git a/lisp/+ispell.el b/lisp/+ispell.el deleted file mode 100644 index fbfc0f0..0000000 --- a/lisp/+ispell.el +++ /dev/null @@ -1,97 +0,0 @@ -;;; +ispell.el --- Customizations for `ispell' -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -(require 'cl-lib) -(require 'seq) - -;; Utility function TODO: move elsewhere -(defun +ispell-append-removing-duplicates (&rest lists) - "Append LISTS, removing duplicates from the result. -Any keyword arguments to `cl-remove-duplicates' should come -before the LISTS." - (let (cl-remove-duplicates-args) - (while (keywordp (car lists)) - (push (pop lists) cl-remove-duplicates-args) - (push (pop lists) cl-remove-duplicates-args)) - (apply #'cl-remove-duplicates (apply #'append lists) - (nreverse cl-remove-duplicates-args)))) - -;;; Ispell in .dir-locals - -;; Let Emacs know a list of strings is safe -(defun +ispell-safe-local-p (list) - (and (listp list) - (seq-every-p #'stringp list))) - -;; Can I instruct ispell to insert LocalWords in a different file? -;; https://emacs.stackexchange.com/q/31396/2264 - -;; How can I move all my file-local LocalWords to .dir-locals.el? -;; https://emacs.stackexchange.com/q/31419 - -;; Adapted from ispell.el:ispell-buffer-local-words -(defun +ispell-buffer-local-words-list () - (let (words) - (or ispell-buffer-local-name - (setq ispell-buffer-local-name (buffer-name))) - (save-excursion - (goto-char (point-min)) - (while (search-forward ispell-words-keyword nil t) - (let ((end (point-at-eol)) - (ispell-casechars (ispell-get-casechars)) - string) - (while (re-search-forward " *\\([^ ]+\\)" end t) - (setq string (match-string-no-properties 1)) - (if (and (< 1 (length string)) - (equal 0 (string-match ispell-casechars string))) - (push string words)))))) - words)) - -;;;###autoload -(defun +ispell-move-buffer-words-to-dir-locals (&optional arg) - "Move the current buffer-local words to .dir-locals.el. -This function prompts the user to save .dir-locals.el, unless -prefix ARG is non-nil; then it just saves them." - (interactive "P") - (unless (buffer-file-name) - (user-error "Buffer not attached to file")) - (hack-dir-local-variables) - (let ((print-level nil) - (print-length nil)) - (when-let ((new-words (cl-remove-if (lambda (el) (eq el '\.\.\.)) ; XXX: NO IDEA - ; where this came from - (+ispell-append-removing-duplicates - :test #'string= - ispell-buffer-session-localwords - (alist-get 'ispell-buffer-session-localwords - dir-local-variables-alist) - (alist-get 'ispell-buffer-session-localwords - file-local-variables-alist) - (+ispell-buffer-local-words-list))))) - (save-excursion - (add-dir-local-variable - major-mode - 'ispell-buffer-session-localwords - (setq ispell-buffer-session-localwords - new-words)) - (when (or arg - (y-or-n-p "Save .dir-locals.el?")) - (save-buffer)) - (bury-buffer)) - (or ispell-buffer-local-name - (setq ispell-buffer-local-name (buffer-name))) - (save-excursion - (goto-char (point-min)) - (while (search-forward ispell-words-keyword nil t) - (delete-region (point-at-bol) (1+ (point-at-eol)))))))) - -;;;###autoload -(defun +ispell-move-buffer-words-to-dir-locals-hook () - "Convenience function for binding to a hook." - (+ispell-move-buffer-words-to-dir-locals t)) - -(provide '+ispell) -;;; +ispell.el ends here diff --git a/lisp/+jabber.el b/lisp/+jabber.el deleted file mode 100644 index e018b0c..0000000 --- a/lisp/+jabber.el +++ /dev/null @@ -1,278 +0,0 @@ -;;; +jabber.el --- Customizations for jabber.el -*- lexical-binding: t; -*- - -;;; Commentary: - -;; Most changes I want to PR and contribute, but a few don't make sense to -;; contribute upstream, at least not now. - -;;; Code: - -(require 'jabber) -(require 'tracking) - -(defgroup +jabber nil - "Extra jabber.el customizations." - :group 'jabber) - -(defcustom +jabber-ws-prefix 0 - "Width to pad left side of chats." - :type 'string) - -(defcustom +jabber-pre-prompt " \n" - "String to put before the prompt." - :type 'string) - -(defvar +jabber-tracking-show-p #'jabber-activity-show-p-default - "Function that checks if the given JID should be shown in the mode line. -This does the same as `jabber-activity-show-p', but for the -`tracking-mode' mode-line.") - -(defun +jabber-tracking-add (from buffer text proposed-alert) - "ADVICE to add jabber buffers to `tracking-buffers'." - (when (funcall +jabber-tracking-show-p from) - (tracking-add-buffer buffer 'jabber-activity-face))) - -(defun +jabber-tracking-add-muc (nick group buffer text proposed-alert) - "ADVICE to add jabber MUC buffers to `tracking-buffers'." - (when (funcall +jabber-tracking-show-p group) - (tracking-add-buffer buffer 'jabber-activity-face))) - -;;; Hiding presence messages: -;; https://paste.sr.ht/~hdasch/f0ad09fbcd08e940a4fda71c2f40abc1c4efd45f - -;; Tame MUC presence notifications. - -;; This patch hides or applies a face to MUC presence notifications in -;; the MUC chat buffer. To control its behavior, customize -;; ’jabber-muc-decorate-presence-patterns’. By default it does nothing. - -;; ’jabber-muc-decorate-presence-patterns’ is a list of pairs consisting -;; of a regular expression and a either a face or ‘nil’. If a the -;; regular expression matches a presence notification, then either: - -;; - the specified face is applied to the notification message -;; - or if the second value of the pair is nil, the notification is -;; discarded - -;; If no regular expression in the list of pairs matches the notification -;; message, the message is displayed unchanged. - -;; For example, the customization: - -;; '(jabber-muc-decorate-presence-patterns -;; '(("\\( enters the room ([^)]+)\\| has left the chatroom\\)$") -;; ("." . jabber-muc-presence-dim))) - -;; hides participant enter/leave notifications. It also diminishes other -;; presence notification messages to make it easier to distinguish -;; between conversation and notifications. - -(defface jabber-muc-presence-dim - '((t (:foreground "dark grey" :weight light :slant italic))) - "face for diminished presence notifications.") - -(defcustom jabber-muc-decorate-presence-patterns nil - "List of regular expressions and face pairs. -When a presence notification matches a pattern, display it with -associated face. Ignore notification if face is ‘nil’." - :type '(repeat - :tag "Patterns" - (cons :format "%v" - (regexp :tag "Regexp") - (choice - (const :tag "Ignore" nil) - (face :tag "Face" :value jabber-muc-presence-dim)))) - :group 'jabber-alerts) - -(defun jabber-muc-maybe-decorate-presence (node) - "Filter presence notifications." - (cl-destructuring-bind (key msg &key time) node - (let* ((match (cl-find-if - (lambda (pair) - (string-match (car pair) msg)) - jabber-muc-decorate-presence-patterns)) - (face (cdr-safe match))) - (if match - (when face - (jabber-maybe-print-rare-time - (ewoc-enter-last - jabber-chat-ewoc - (list key - (propertize msg 'face face) - :time time)))) - (jabber-maybe-print-rare-time - (ewoc-enter-last jabber-chat-ewoc node)))))) - -(defun jabber-muc-process-presence (jc presence) - (let* ((from (jabber-xml-get-attribute presence 'from)) - (type (jabber-xml-get-attribute presence 'type)) - (x-muc (cl-find-if - (lambda (x) (equal (jabber-xml-get-attribute x 'xmlns) - "http://jabber.org/protocol/muc#user")) - (jabber-xml-get-children presence 'x))) - (group (jabber-jid-user from)) - (nickname (jabber-jid-resource from)) - (symbol (jabber-jid-symbol from)) - (our-nickname (gethash symbol jabber-pending-groupchats)) - (item (car (jabber-xml-get-children x-muc 'item))) - (actor (jabber-xml-get-attribute (car (jabber-xml-get-children item 'actor)) 'jid)) - (reason (car (jabber-xml-node-children (car (jabber-xml-get-children item 'reason))))) - (error-node (car (jabber-xml-get-children presence 'error))) - (status-codes (if error-node - (list (jabber-xml-get-attribute error-node 'code)) - (mapcar - (lambda (status-element) - (jabber-xml-get-attribute status-element 'code)) - (jabber-xml-get-children x-muc 'status))))) - ;; handle leaving a room - (cond - ((or (string= type "unavailable") (string= type "error")) - ;; error from room itself? or are we leaving? - (if (or (null nickname) - (member "110" status-codes) - (string= nickname our-nickname)) - ;; Assume that an error means that we were thrown out of the - ;; room... - (let* ((leavingp t) - (message (cond - ((string= type "error") - (cond - ;; ...except for certain cases. - ((or (member "406" status-codes) - (member "409" status-codes)) - (setq leavingp nil) - (concat "Nickname change not allowed" - (when error-node - (concat ": " (jabber-parse-error error-node))))) - (t - (concat "Error entering room" - (when error-node - (concat ": " (jabber-parse-error error-node))))))) - ((member "301" status-codes) - (concat "You have been banned" - (when actor (concat " by " actor)) - (when reason (concat " - '" reason "'")))) - ((member "307" status-codes) - (concat "You have been kicked" - (when actor (concat " by " actor)) - (when reason (concat " - '" reason "'")))) - (t - "You have left the chatroom")))) - (when leavingp - (jabber-muc-remove-groupchat group)) - ;; If there is no buffer for this groupchat, don't bother - ;; creating one just to tell that user left the room. - (let ((buffer (get-buffer (jabber-muc-get-buffer group)))) - (if buffer - (with-current-buffer buffer - (jabber-muc-maybe-decorate-presence - (list (if (string= type "error") - :muc-error - :muc-notice) - message - :time (current-time))))) - (message "%s: %s" (jabber-jid-displayname group) message)))) - ;; or someone else? - (let* ((plist (jabber-muc-participant-plist group nickname)) - (jid (plist-get plist 'jid)) - (name (concat nickname - (when jid - (concat " <" - (jabber-jid-user jid) - ">"))))) - (jabber-muc-remove-participant group nickname) - (with-current-buffer (jabber-muc-create-buffer jc group) - (jabber-muc-maybe-decorate-presence - (list :muc-notice - (cond - ((member "301" status-codes) - (concat name " has been banned" - (when actor (concat " by " actor)) - (when reason (concat " - '" reason "'")))) - ((member "307" status-codes) - (concat name " has been kicked" - (when actor (concat " by " actor)) - (when reason (concat " - '" reason "'")))) - ((member "303" status-codes) - (concat name " changes nickname to " - (jabber-xml-get-attribute item 'nick))) - (t - (concat name " has left the chatroom"))) - :time (current-time)))))) - (t - ;; someone is entering - - (when (or (member "110" status-codes) (string= nickname our-nickname)) - ;; This is us. We just succeeded in entering the room. - ;; - ;; The MUC server is supposed to send a 110 code whenever this - ;; is our presence ("self-presence"), but at least one - ;; (ejabberd's mod_irc) doesn't, so check the nickname as well. - ;; - ;; This check might give incorrect results if the server - ;; changed our nickname to avoid collision with an existing - ;; participant, but even in this case the window where we have - ;; incorrect information should be very small, as we should be - ;; getting our own 110+210 presence shortly. - (let ((whichgroup (assoc group *jabber-active-groupchats*))) - (if whichgroup - (setcdr whichgroup nickname) - (add-to-list '*jabber-active-groupchats* (cons group nickname)))) - ;; The server may have changed our nick. Record the new one. - (puthash symbol nickname jabber-pending-groupchats)) - - ;; Whoever enters, we create a buffer (if it didn't already - ;; exist), and print a notice. This is where autojoined MUC - ;; rooms have buffers created for them. We also remember some - ;; metadata. - (let ((old-plist (jabber-muc-participant-plist group nickname)) - (new-plist (jabber-muc-parse-affiliation x-muc))) - (jabber-muc-modify-participant group nickname new-plist) - (let ((report (jabber-muc-report-delta nickname old-plist new-plist - reason actor))) - (when report - (with-current-buffer (jabber-muc-create-buffer jc group) - (jabber-muc-maybe-decorate-presence - (list :muc-notice report - :time (current-time))) - ;; Did the server change our nick? - (when (member "210" status-codes) - (ewoc-enter-last - jabber-chat-ewoc - (list :muc-notice - (concat "Your nick was changed to " nickname " by the server") - :time (current-time)))) - ;; Was this room just created? If so, it's a locked - ;; room. Notify the user. - (when (member "201" status-codes) - (ewoc-enter-last - jabber-chat-ewoc - (list :muc-notice - (with-temp-buffer - (insert "This room was just created, and is locked to other participants.\n" - "To unlock it, ") - (insert-text-button - "configure the room" - 'action (apply-partially 'call-interactively 'jabber-muc-get-config)) - (insert " or ") - (insert-text-button - "accept the default configuration" - 'action (apply-partially 'call-interactively 'jabber-muc-instant-config)) - (insert ".") - (buffer-string)) - :time (current-time)))))))))))) - -(defun +jabber-colors-update (&optional buffer) - "Update jabber colors in BUFFER, defaulting to the current." - (with-current-buffer (or buffer (current-buffer)) - (when jabber-buffer-connection - (setq jabber-muc-participant-colors nil) - (cond (jabber-chatting-with - (jabber-chat-create-buffer jabber-buffer-connection - jabber-chatting-with)) - (jabber-group - (jabber-muc-create-buffer jabber-buffer-connection - jabber-group)))))) - -(provide '+jabber) -;;; +jabber.el ends here diff --git a/lisp/+key.el b/lisp/+key.el deleted file mode 100644 index a217dad..0000000 --- a/lisp/+key.el +++ /dev/null @@ -1,106 +0,0 @@ -;;; +key.el --- minor mode for keymaps -*- lexical-binding: t; -*- - -;;; Commentary: - -;; Much of the code here was cribbed from https://emacs.stackexchange.com/a/358, -;; which in turn was cribbed in part from -;; https://github.com/kaushalmodi/.emacs.d/blob/master/elisp/modi-mode.el, -;; https://github.com/jwiegley/use-package/blob/master/bind-key.el and -;; elsewhere. - -;; The basic idea is to have a minor-mode for my personal key customizations, -;; especially a "leader key" set up à la vim. In Emacs, I use `C-z' for this -;; leader key, because of its easy location and relative uselessness by default. - -;;; Code: - -(require 'easy-mmode) -(require 'setup nil t) - -;; I need to define this map before the proper mode map. -(defvar +key-leader-map (let ((map (make-sparse-keymap)) - (c-z (global-key-binding "\C-z"))) - ;;(define-key map "\C-z" c-z) - map) - "A leader keymap under the \"C-z\" bind.") - -;; http://xahlee.info/emacs/emacs/emacs_menu_app_keys.html and -(defvar +key-menu-map (let ((map (make-sparse-keymap))) - (define-key map (kbd "") - #'execute-extended-command) - map) - "Custom bindings behind the menu key.") - -(defvar +key-mode-map (let ((map (make-sparse-keymap))) - (define-key map "\C-z" +key-leader-map) - (define-key map (kbd "") +key-menu-map) - map) - "Keymap for `+key-mode'.") - -(defun turn-off-+key-mode () - "Turn off `+key-mode'." - (+key-mode -1)) - -;;;###autoload -(define-minor-mode +key-mode - "A minor mode with keybindings that will override every other mode." - :init-value t - :lighter " +" - (if +key-mode - (progn ; Enable - (add-to-list 'emulation-mode-map-alists - `((+key-mode . ,+key-mode-map))) - ;; Disable in minibuffer - (add-hook 'minibuffer-setup-hook #'turn-off-+key-mode) - ;; compat Linux-Windows - (define-key key-translation-map (kbd "") (kbd "")) - ;; curse you, thinkpad keyboard!!! - (define-key key-translation-map (kbd "") (kbd "")) - ) - ;; Disable - (setq emulation-mode-map-alists - (assoc-delete-all '+key-mode emulation-mode-map-alists - (lambda (a b) - (equal (car a) b)))) - (remove-hook 'minibuffer-setup-hook #'turn-off-+key-mode) - (define-key key-translation-map (kbd "") nil) - (define-key key-translation-map (kbd "") nil))) - -;;;###autoload -(defun +key-setup () - "Ensure `+key-mode' happens after init." - (if after-init-time - (+key-global-mode) - (add-hook 'after-init-hook #'+key-global-mode))) - -;;;###autoload -(define-globalized-minor-mode +key-global-mode +key-mode +key-mode) - -;; Extras for `setup' -(with-eval-after-load 'setup - (setup-define :+key - (lambda (key command) - `(define-key +key-mode-map ,key ,command)) - :documentation "Bind KEY to COMMAND in `+key-mode-map'." - :debug '(form sexp) - :ensure '(kbd nil) - :repeatable t) - - (setup-define :+leader - (lambda (key command) - `(define-key +key-leader-map ,key ,command)) - :documentation "Bind KEY to COMMAND in `+key-leader-map'." - :debug '(form sexp) - :ensure '(kbd nil) - :repeatable t) - - (setup-define :+menu - (lambda (key command) - `(define-key +key-menu-map ,key ,command)) - :documentation "Bind KEY to COMMAND in `+key-leader-map'." - :debug '(form sexp) - :ensure '(kbd nil) - :repeatable t)) - -(provide '+key) -;;; +key.el ends here diff --git a/lisp/+kmacro.el b/lisp/+kmacro.el deleted file mode 100644 index a3cde61..0000000 --- a/lisp/+kmacro.el +++ /dev/null @@ -1,70 +0,0 @@ -;;; +kmacro.el -*- lexical-binding: t; -*- - -;;; Commentary: - -;; Many of these come from this Reddit thread: -;; https://old.reddit.com/r/emacs/comments/rlli0u/whats_your_favorite_defadvice/ - -;;; Code: - -(require 'kmacro) - -;; Indicate when a kmacro is being recorded in the mode-line - -(defface +kmacro-modeline nil - "Face when kmacro is active") - -(set-face-attribute '+kmacro-modeline nil - :background "Firebrick" - :box '(:line-width -1 :color "salmon" - :style released-button)) - -(defun +kmacro-change-mode-line (&rest _) - "Remap the mode-line face when recording a kmacro." - - (add-to-list 'face-remapping-alist '(mode-line . +kmacro-modeline))) - -(defun +kmacro-restore-mode-line (&rest _) - "Restore the mode-line face after kmacro is done recording." - (setf face-remapping-alist - (assoc-delete-all 'mode-line face-remapping-alist))) - -(define-minor-mode +kmacro-recording-indicator-mode - "Change the mode-line's face when recording a kmacro." - :lighter "" - :global t - (if +kmacro-recording-indicator-mode - (progn - (advice-add #'kmacro-start-macro :before #'+kmacro-change-mode-line) - (advice-add #'kmacro-keyboard-quit :after #'+kmacro-restore-mode-line) - (advice-add #'kmacro-end-macro :after #'+kmacro-restore-mode-line)) - (+kmacro-restore-mode-line) - (advice-remove #'kmacro-start-macro #'+kmacro-change-mode-line) - (advice-remove #'kmacro-keyboard-quit #'+kmacro-restore-mode-line) - (advice-remove #'kmacro-end-macro #'+kmacro-restore-mode-line))) - -;; Undo keyboard macros in a single bound (like vi!) - -(defun +kmacro-block-undo (fn &rest args) - (let ((marker (prepare-change-group))) - (unwind-protect (apply fn args) - (undo-amalgamate-change-group marker)))) - -(define-minor-mode +kmacro-block-undo-mode - "Undo kmacros all at once (like vi)." - :global t - :lighter " KUndo" - (if +kmacro-block-undo-mode - (dolist (fn '(kmacro-call-macro - kmacro-exec-ring-item - dot-mode-execute - apply-macro-to-region-lines)) - (advice-add fn :around #'+kmacro-block-undo)) - (dolist (fn '(kmacro-call-macro - kmacro-exec-ring-item - dot-mode-execute - apply-macro-to-region-lines)) - (advice-remove fn #'+kmacro-block-undo)))) - -(provide '+kmacro) -;;; +kmacro.el ends here diff --git a/lisp/+link-hint.el b/lisp/+link-hint.el deleted file mode 100644 index 205e915..0000000 --- a/lisp/+link-hint.el +++ /dev/null @@ -1,169 +0,0 @@ -;;; +link-hint.el -*- lexical-binding: t; -*- - -;;; Code: - -(require 'cl-lib) -(require 'link-hint) - -(defgroup +link-hint nil - "Extra customizations for `link-hint'." - :group 'link-hint) - -(defcustom +link-hint-open-secondary-types '(gnus-w3m-image-url - gnus-w3m-url - markdown-link - mu4e-attachment - mu4e-url - notmuch-hello - nov-link - org-link - shr-url - text-url - w3m-link - w3m-message-link) - "Link types to define `:open-secondary' for.") - -(defvar +link-hint-map (make-sparse-keymap) - "Keymap for `link-hint' functionality.") - -(cl-defmacro +link-hint-define-keyword (keyword handler docstring - &optional (types 'link-hint-types) - &rest rest - &key multiple &allow-other-keys) - "Set up a `link-hint' KEYWORD, with optional TYPES. -If TYPES is not present, use `link-hint-types'. - -KEYWORD defines the link-hint type. It will be used to create a -function for opening links of the form \"link-hint-openKEYWORD\". - -HANDLER is the function to open a link with. - -DOCSTRING is the macro's documentation. - -Keyword arguments are passed to `link-hint-define-type' prefixed -with the KEYWORD." - (declare (indent 2) - (doc-string 3)) - (let ((types (symbol-value types)) - (func-sym (intern (format "+link-hint-open%s" keyword))) - (mult-sym (intern (format "%s-multiple" keyword))) - (expr)) - ;; Define the type - (push `(dolist (type ',types) - (link-hint-define-type type - ,keyword ,handler - ,@(mapcar (lambda (el) - (if (eq el :multiple) - mult-sym - el)) - rest))) - expr) - ;; Define an opener - (push `(defun ,func-sym () - ,(format "%s\n\nDefined by `+link-hint-define'." docstring) - (interactive) - (avy-with link-hint-open-link - (link-hint--one ,keyword))) - expr) - ;; Handle `:multiple' - (when multiple - (push `(defun ,(intern (format "+link-hint-open-multiple%s" keyword)) () - ,(format "Open multiple links with `%s'.\n\nDefined by `+link-hint-define'." - func-sym) - (avy-with link-hint-open-multiple-links - (link-hint--multiple ,keyword))) - expr) - (push `(defun ,(intern (format "+link-hint-open-all%s" keyword)) () - ,(format "Open all visible links with `%s'.\n\nDefined by `+link-hint-define'." - func-sym) - (avy-with link-hint-open-all-links - (link-hint--all ,keyword))) - expr)) - ;; Return the built expression - `(progn ,@(nreverse expr)))) - -(+link-hint-define-keyword :secondary browse-url-secondary-browser-function - "Open a link in the secondary browser." - +link-hint-open-secondary-types - :multiple t) - -(defun +link-hint-open-secondary-setup (&optional types) - "Define the `:open-secondary' link-hint type for TYPES. -If TYPES is nil, define it for `+link-hint-open-secondary-types'." - (dolist (type (or types +link-hint-open-secondary-types)) - (link-hint-define-type type - :open-secondary browse-url-secondary-browser-function - :open-secondary-multiple t))) - -(defun +link-hint-open-secondary () - "Open a link in the secondary browser." - (interactive) - (avy-with link-hint-open-link - (link-hint--one :open-secondary))) - -(defun +link-hint-open-chrome-setup (&optional types) - "Define the `:open-chrome' link-hint type for TYPES. -If TYPES is nil, define it for `+link-hint-open-secondary-types'." - (dolist (type (or types +link-hint-open-secondary-types)) - (link-hint-define-type type - :open-chrome #'browse-url-chrome - :open-chrome-multiple t))) - -(defun +link-hint-open-chrome () - "Open a link with chrome." - (interactive) - (avy-with link-hint-open-link - (link-hint--one :open-chrome))) - -;; (cl-defmacro +link-hint-add-type (keyword ) -;; "Define link-hint type KEYWORD to operate on TYPES. -;; If TYPES is nil or absent, define KEYWORD for all -;; `link-hint-types'." -;; (let (forms) -;; (dolist (type (or types link-hint-types)) -;; (push `(link-hint-define-type ,type ,keyword ,function) forms)) -;; (push `(defun ,(intern (format "+link-hint%s" ,keyword)) -;; )))) - -(defun +link-hint-open-link (prefix) - "Open a link. -Without a PREFIX, open using `browse-url-browser-function'; with -a PREFIX, use `browse-url-secondary-browser-function'." - (interactive "P") - (avy-with link-hint-open-link - (link-hint--one (if prefix :open-secondary :open)))) - -(defun +link-hint-open-multiple-links (prefix) - "Open multiple links. -Without a PREFIX, open using `browse-url-browser-function'; with -a PREFIX, use `browse-url-secondary-browser-function'." - (interactive "P") - (avy-with link-hint-open-multiple-links - (link-hint--one (if prefix :open-secondary :open)))) - -(defun +link-hint-open-all-links (prefix) - "Open all visible links. -Without a PREFIX, open using `browse-url-browser-function'; with -a PREFIX, use `browse-url-secondary-browser-function'." - (interactive "P") - (avy-with link-hint-open-all-links - (link-hint--one (if prefix :open-secondary :open)))) - -;;; Pocket-reader.el integration - -(defun +link-hint-pocket-add-setup (&optional types) - "Define the `:pocket-add' link-hint type for TYPES. -If TYPES is nil, define it for `link-hint-types'." - (dolist (type (or types link-hint-types)) - (link-hint-define-type type - :pocket-add #'pocket-reader-generic-add-link - :pocket-add-multiple t))) - -(defun +link-hint-pocket-add () - "Add a link to the Pocket reader." - (interactive) - (avy-with link-hint-open-link - (link-hint--one :pocket-add))) - -(provide '+link-hint) -;;; +link-hint.el ends here diff --git a/lisp/+lisp.el b/lisp/+lisp.el deleted file mode 100644 index a78e40e..0000000 --- a/lisp/+lisp.el +++ /dev/null @@ -1,195 +0,0 @@ -;;; +lisp.el --- extra lisp functionality -*- lexical-binding: t -*- - -;;; Code: - -;;; Sort sexps in a region. -;; https://github.com/alphapapa/unpackaged.el - -(defun +lisp-skip-whitespace () - (while (looking-at (rx (1+ (or space "\n")))) - (goto-char (match-end 0)))) - -(defun +lisp-skip-both () - (while (cond ((or (nth 4 (syntax-ppss)) - (ignore-errors - (save-excursion - (forward-char 1) - (nth 4 (syntax-ppss))))) - (forward-line 1)) - ((looking-at (rx (1+ (or space "\n")))) - (goto-char (match-end 0)))))) - -(defun +lisp-sort-sexps (beg end &optional key-fn sort-fn) - "Sort sexps between BEG and END. -Comments stay with the code below. - -Optional argument KEY-FN will determine where in each sexp to -start sorting. e.g. (lambda (sexp) (symbol-name (car sexp))) - -Optional argument SORT-FN will determine how to sort two sexps' -strings. It's passed to `sort'. By default, it sorts the sexps -with `string<' starting with the key determined by KEY-FN." - (interactive "r") - (save-excursion - (save-restriction - (narrow-to-region beg end) - (goto-char beg) - (+lisp-skip-both) - (cl-destructuring-bind (sexps markers) - (cl-loop do (+lisp-skip-whitespace) - for start = (point-marker) - for sexp = (ignore-errors - (read (current-buffer))) - for end = (point-marker) - while sexp - ;; Collect the real string, then one used for sorting. - collect (cons (buffer-substring (marker-position start) - (marker-position end)) - (save-excursion - (goto-char (marker-position start)) - (+lisp-skip-both) - (if key-fn - (funcall key-fn sexp) - (buffer-substring - (point) - (marker-position end))))) - into sexps - collect (cons start end) - into markers - finally return (list sexps markers)) - (setq sexps (sort sexps (if sort-fn sort-fn - (lambda (a b) - (string< (cdr a) (cdr b)))))) - (cl-loop for (real . sort) in sexps - for (start . end) in markers - do (progn - (goto-char (marker-position start)) - (insert-before-markers real) - (delete-region (point) (marker-position end)))))))) - -;;; Comment-or-uncomment-sexp -;; from https://endlessparentheses.com/a-comment-or-uncomment-sexp-command.html - -(defun +lisp-uncomment-sexp (&optional n) - "Uncomment N sexps around point." - (interactive "P") - (let* ((initial-point (point-marker)) - (inhibit-field-text-motion t) - (p) - (end (save-excursion - (when (elt (syntax-ppss) 4) - (re-search-backward comment-start-skip - (line-beginning-position) - t)) - (setq p (point-marker)) - (comment-forward (point-max)) - (point-marker))) - (beg (save-excursion - (forward-line 0) - (while (and (not (bobp)) - (= end (save-excursion - (comment-forward (point-max)) - (point)))) - (forward-line -1)) - (goto-char (line-end-position)) - (re-search-backward comment-start-skip - (line-beginning-position) - t) - (ignore-errors - (while (looking-at-p comment-start-skip) - (forward-char -1))) - (point-marker)))) - (unless (= beg end) - (uncomment-region beg end) - (goto-char p) - ;; Indentify the "top-level" sexp inside the comment. - (while (and (ignore-errors (backward-up-list) t) - (>= (point) beg)) - (skip-chars-backward (rx (syntax expression-prefix))) - (setq p (point-marker))) - ;; Re-comment everything before it. - (ignore-errors - (comment-region beg p)) - ;; And everything after it. - (goto-char p) - (forward-sexp (or n 1)) - (skip-chars-forward "\r\n[:blank:]") - (if (< (point) end) - (ignore-errors - (comment-region (point) end)) - ;; If this is a closing delimiter, pull it up. - (goto-char end) - (skip-chars-forward "\r\n[:blank:]") - (when (eq 5 (car (syntax-after (point)))) - (delete-indentation)))) - ;; Without a prefix, it's more useful to leave point where - ;; it was. - (unless n - (goto-char initial-point)))) - -(defun +lisp-comment-sexp--raw () - "Comment the sexp at point or ahead of point." - (pcase (or (bounds-of-thing-at-point 'sexp) - (save-excursion - (skip-chars-forward "\r\n[:blank:]") - (bounds-of-thing-at-point 'sexp))) - (`(,l . ,r) - (goto-char r) - (skip-chars-forward "\r\n[:blank:]") - (save-excursion - (comment-region l r)) - (skip-chars-forward "\r\n[:blank:]")))) - -(defun +lisp-comment-or-uncomment-sexp (&optional n) - "Comment the sexp at point and move past it. -If already inside (or before) a comment, uncomment instead. -With a prefix argument N, (un)comment that many sexps." - (interactive "P") - (if (or (elt (syntax-ppss) 4) - (< (save-excursion - (skip-chars-forward "\r\n[:blank:]") - (point)) - (save-excursion - (comment-forward 1) - (point)))) - (+lisp-uncomment-sexp n) - (dotimes (_ (or n 1)) - (+lisp-comment-sexp--raw)))) - -;;; Sort `setq' constructs -;;https://emacs.stackexchange.com/questions/33039/ - -(defun +lisp-sort-setq () - (interactive) - (save-excursion - (save-restriction - (let ((sort-end (progn - (end-of-defun) - (backward-char) - (point-marker))) - (sort-beg (progn - (beginning-of-defun) - (or (re-search-forward "[ \\t]*(" (point-at-eol) t) - (point-at-eol)) - (forward-sexp) - (or (re-search-forward "\\<" (point-at-eol) t) - (point-at-eol)) - (point-marker)))) - (narrow-to-region (1- sort-beg) (1+ sort-end)) - (sort-subr nil #'+lisp-sort-setq-next-record - #'+lisp-sort-setq-end-record))))) - -(defun +lisp-sort-setq-next-record () - (condition-case nil - (progn - (forward-sexp 1) - (backward-sexp)) - ('scan-error (end-of-buffer)))) - -(defun +lisp-sort-setq-end-record () - (condition-case nil - (forward-sexp 2) - ('scan-error (end-of-buffer)))) - -(provide '+lisp) -;;; +lisp.el ends here diff --git a/lisp/+message.el b/lisp/+message.el deleted file mode 100644 index b8bc234..0000000 --- a/lisp/+message.el +++ /dev/null @@ -1,26 +0,0 @@ -;;; +message.el --- Extra message-mode functions -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -;; Thanks to Alex Schroeder for this! -;; https://www.emacswiki.org/emacs/Change_Signature_Dynamically - -(defun +message-check-for-signature-change (&rest ignore) - "Check for a change in the To: or Cc: fields" - (when (and (message--in-tocc-p) - (not (buffer-narrowed-p))) - (save-excursion - (goto-char (point-max)) - (let ((end (point))) - (when (re-search-backward message-signature-separator nil t) - (delete-region (1- (match-beginning 0)) end))) - (message-insert-signature)))) - -(defun +message-signature-setup () - (make-local-variable 'after-change-functions) - (push '+message-check-for-signature-change after-change-functions)) - -(provide '+message) -;;; +message.el ends here diff --git a/lisp/+minibuffer.el b/lisp/+minibuffer.el deleted file mode 100644 index 7aa57a5..0000000 --- a/lisp/+minibuffer.el +++ /dev/null @@ -1,14 +0,0 @@ -;;; +minibuffer.el -*- lexical-binding: t -*- - -;;; Code: - -;; https://www.manueluberti.eu//emacs/2021/12/10/shell-command/ -(defun +minibuffer-complete-history () - "Complete minibuffer history." - (interactive) - (completion-in-region (minibuffer--completion-prompt-end) (point-max) - (symbol-value minibuffer-history-variable) - nil)) - -(provide '+minibuffer) -;;; +minibuffer.el ends here diff --git a/lisp/+modeline.el b/lisp/+modeline.el deleted file mode 100644 index c6e8463..0000000 --- a/lisp/+modeline.el +++ /dev/null @@ -1,488 +0,0 @@ -;;; +modeline.el --- my modeline customizations -*- lexical-binding: t; -*- - -;;; Commentary: - -;; `+modeline.el' is kind of a dumping ground for various -;; modeline-related functions. I probably don't use everything in -;; here. Credit given where possible. - -;;; Code: - -(require '+util) -(require 'actually-selected-window) -(require 'simple-modeline) -(require 'minions) - -(defgroup +modeline nil - "Various customization options for my modeline things." - :prefix "+modeline-" - :group 'simple-modeline) - -(defcustom +modeline-default-spacer " " - "Default spacer to use for modeline elements. -All modeline elements take an optional argument, `spacer', which -will default to this string.") - -;;; Combinators - -(defun +modeline-concat (segments &optional separator) - "Concatenate multiple functional modeline SEGMENTS. -Each segment in SEGMENTS is a function returning a mode-line -construct. - -Segments are separated using SEPARATOR, which defaults to -`+modeline-default-spacer'. Only segments that evaluate to a -non-zero-length string will be separated, for a cleaner look. - -This function returns a lambda that should be `:eval'd or -`funcall'd in a mode-line context." - (let ((separator (or separator +modeline-default-spacer))) - (lambda () - (let (this-sep result) - (dolist (segment segments) - (let ((segstr (funcall segment this-sep))) - (when (and segstr - (not (equal segstr ""))) - (push segstr result) - (setq this-sep separator)))) - (apply #'concat - (nreverse result)))))) - -(defun +modeline-spacer (&optional n spacer &rest strings) - "Make an N-length SPACER, or prepend SPACER to STRINGS. -When called with no arguments, insert `+modeline-default-spacer'. -N will repeat SPACER N times, and defaults to 1. SPACER defaults -to `+modeline-default-spacer', but can be any string. STRINGS -should form a mode-line construct when `concat'ed." - (declare (indent 2)) - (let ((spacer (or spacer +modeline-default-spacer)) - (n (or n 1)) - (strings (cond((null strings) '("")) - ((equal strings '("")) nil) - ((atom strings) (list strings)) - (t strings))) - r) - (when strings (dotimes (_ n) (push spacer r))) - (apply #'concat (apply #'concat r) strings))) - -;;; Modeline segments - -(defun +modeline-sanitize-string (string) - "Sanitize a string for `format-mode-line'." - (when string - (string-replace "%" "%%" string))) - -(defcustom +modeline-buffer-name-max-length 0 - "Maximum length of `+modeline-buffer-name'. -If > 0 and < 1, use that portion of the window's width. If > 1, -use that many characters. If anything else, don't limit. If the -buffer name is longer than the max length, it will be shortened -and appended with `truncate-string-ellipsis'." - :type '(choice (const :tag "No maximum length" 0) - (natnum :tag "Number of characters") - (float :tag "Fraction of window's width"))) - -(defcustom +modeline-buffer-position nil - "What to put in the `+modeline-buffer-name' position." - :type 'function - :local t) - -(defun +modeline-buffer-name (&optional spacer) ; gonsie - "Display the buffer name." - (let ((bufname (string-trim (string-replace "%" "%%%%" (buffer-name))))) - (+modeline-spacer nil spacer - (if (and +modeline-buffer-position (fboundp +modeline-buffer-position)) - (funcall +modeline-buffer-position) - (propertize (cond - ((ignore-errors - (and - (> +modeline-buffer-name-max-length 0) - (< +modeline-buffer-name-max-length 1))) - (truncate-string-to-width bufname - (* (window-total-width) - +modeline-buffer-name-max-length) - nil nil t)) - ((ignore-errors - (> +modeline-buffer-name-max-length 1)) - (truncate-string-to-width bufname - +modeline-buffer-name-max-length - nil nil t)) - (t bufname)) - 'help-echo (or (buffer-file-name) - (buffer-name)) - 'mouse-face 'mode-line-highlight))))) - -(defcustom +modeline-minions-icon "&" - "The \"icon\" for `+modeline-minions' button." - :type 'string) - -(defun +modeline-minions (&optional spacer) - "Display a button for `minions-minor-modes-menu'." - (+modeline-spacer nil spacer - (propertize - +modeline-minions-icon - 'help-echo "Minor modes menu\nmouse-1: show menu." - 'local-map (purecopy (simple-modeline-make-mouse-map - 'mouse-1 - (lambda (event) - (interactive "e") - (with-selected-window - (posn-window (event-start event)) - (minions-minor-modes-menu))))) - 'mouse-face 'mode-line-highlight))) - -(defcustom +modeline-major-mode-faces '((text-mode . font-lock-string-face) - (prog-mode . font-lock-keyword-face) - (t . font-lock-warning-face)) - "Mode->face mapping for `+modeline-major-mode'. -If the current mode is derived from the car of a cell, the face -in the cdr will be applied to the major-mode in the mode line." - :type '(alist :key-type function - :value-type face)) - -(defface +modeline-major-mode-face nil - "Face for modeline major-mode.") - -(defun +modeline-major-mode (&optional spacer) - "Display the current `major-mode'." - (+modeline-spacer nil spacer - "(" - (propertize ;; (+string-truncate (format-mode-line mode-name) 16) - (format-mode-line mode-name) - 'face (when (actually-selected-window-p) - ;; XXX: This is probably really inefficient. I need to - ;; simply detect which mode it's in when I change major - ;; modes (`change-major-mode-hook') and change the face - ;; there, probably. - ;; (catch :done (dolist (cel +modeline-major-mode-faces) - ;; (when (derived-mode-p (car cel)) - ;; (throw :done (cdr cel)))) - ;; (alist-get t +modeline-major-mode-faces)) - '+modeline-major-mode-face) - 'keymap (let ((map (make-sparse-keymap))) - (bindings--define-key map [mode-line down-mouse-1] - `(menu-item "Menu Bar" ignore - :filter ,(lambda (_) (mouse-menu-major-mode-map)))) - (define-key map [mode-line mouse-2] 'describe-mode) - (bindings--define-key map [mode-line down-mouse-3] - `(menu-item "Minions" minions-minor-modes-menu)) - map) - 'help-echo (+concat (list (format-mode-line mode-name) " mode") - "mouse-1: show menu" - "mouse-2: describe mode" - "mouse-3: display minor modes") - 'mouse-face 'mode-line-highlight) - ")")) - -(defcustom +modeline-modified-icon-alist '((ephemeral . "*") - (readonly . "=") - (modified . "+") - (special . "~") - (t . "-")) - "\"Icons\" to display depending on buffer status in modeline. -The CAR of each field is one of `readonly', `modified', -`special', `ephemeral', or t, and the CDR is a string to display -in that mode. - -`readonly' is true if the buffer is read-only and visiting a file. -`modified' is true if the buffer is modified. -`special' is true if the buffer is a special-mode or derived buffer. -`ephemeral' is true if the buffer is not visiting a file. -t is the fall-back, shown when nothing else in the alist applies. - -The order of elements matters: whichever one matches first is applied." - :type '(alist :key-type symbol - :value-type string) - :options '("readonly" "modified" "special" "t")) - -(defcustom +modeline-modified-icon-special-modes '(special-mode) - "Modes to apply the `special-mode' icon to in the -`+modeline-modified'." - :type '(repeat function)) - -(defun +modeline-modified (&optional spacer) ; modified from `simple-modeline-status-modified' - "Display a color-coded \"icon\" indicator for the buffer's status." - (let* ((icon (catch :icon - (dolist (cell +modeline-modified-icon-alist) - (when (pcase (car cell) - ('ephemeral (not (buffer-file-name))) - ('readonly buffer-read-only) - ('modified (buffer-modified-p)) - ('special - (apply 'derived-mode-p - +modeline-modified-icon-special-modes)) - ('t t) - (_ nil)) - (throw :icon cell)))))) - (+modeline-spacer nil spacer - (propertize (or (cdr-safe icon) "") - 'help-echo (format "Buffer \"%s\" is %s." - (buffer-name) - (pcase (car-safe icon) - ('t "unmodified") - ('nil "unknown") - (_ (car-safe icon)))))))) - -(defun +modeline-narrowed (&optional spacer) - "Display an indication that the buffer is narrowed." - (when (buffer-narrowed-p) - (+modeline-spacer nil spacer - (propertize "N" - 'help-echo (format "%s\n%s" - "Buffer is narrowed." - "mouse-2: widen buffer.") - 'local-map (purecopy (simple-modeline-make-mouse-map - 'mouse-2 'mode-line-widen)) - 'face 'font-lock-doc-face - 'mouse-face 'mode-line-highlight)))) - -(defun +modeline-reading-mode (&optional spacer) - "Display an indication that the buffer is in `reading-mode'." - (when reading-mode - (+modeline-spacer nil spacer - (propertize - (concat "R" (when (bound-and-true-p +eww-readable-p) "w")) - 'help-echo (format "%s\n%s" - "Buffer is in reading-mode." - "mouse-2: disable reading-mode.") - 'local-map (purecopy - (simple-modeline-make-mouse-map - 'mouse-2 (lambda (ev) - (interactive "e") - (with-selected-window - (posn-window - (event-start ev)) - (reading-mode -1) - (force-mode-line-update))))) - 'face 'font-lock-doc-face - 'mouse-face 'mode-line-highlight)))) - -(define-minor-mode file-percentage-mode - "Toggle the percentage display in the mode line (File Percentage Mode)." - :init-value t :global t :group 'mode-line) - -(defun +modeline--percentage () - "Return point's progress through current file as a percentage." - (let ((tot (count-screen-lines (point-min) (point-max) :ignore-invisible))) - (floor (* 100 (/ (float (line-number-at-pos)) tot))))) - -(defun +modeline--buffer-contained-in-window-p () - "Whether the buffer is totally contained within its window." - (let ((window-min (save-excursion (move-to-window-line 0) (point))) - (window-max (save-excursion (move-to-window-line -1) (point)))) - (and (<= window-min (point-min)) - (>= window-max (point-max))))) - -(defun +modeline-file-percentage (&optional spacer) - "Display the position in the current file." - (when file-percentage-mode - ;; (let ((perc (+modeline--percentage))) - ;; (propertize (+modeline-spacer nil spacer - ;; (cond - ;; ((+modeline--buffer-contained-in-window-p) "All") - ;; ((= (line-number-at-pos) (line-number-at-pos (point-min))) "Top") - ;; ((= (line-number-at-pos) (line-number-at-pos (point-max))) "Bot") - ;; ;; Why the 10 %s? Not sure. `format' knocks them - ;; ;; down to 5, then `format-mode-line' kills all but - ;; ;; two. If I use only 8, the margin is much too - ;; ;; large. Something else is obviously going on, but - ;; ;; I'm at a loss as to what it could be. - ;; (t (format "%d%%%%%%%%%%" perc)))) - ;; ;; TODO: add scroll-up and scroll-down bindings. - ;; )) - (let ((perc (format-mode-line '(-2 "%p")))) - (+modeline-spacer nil spacer - "/" - (pcase perc - ("To" "Top") - ("Bo" "Bot") - ("Al" "All") - (_ (format ".%02d" (string-to-number perc)))))))) - -(defun +modeline-file-percentage-ascii-icon (&optional spacer) - (when file-percentage-mode - (+modeline-spacer nil spacer - (let ((perc (format-mode-line '(-2 "%p")))) - (pcase perc - ("To" "/\\") - ("Bo" "\\/") - ("Al" "[]") - (_ (let ((vec (vector "/|" "//" "||" "\\\\" "\\|" "\\|")) - (perc (string-to-number perc))) - (aref vec (floor (/ perc 17)))))))))) - -(defun +modeline-file-percentage-icon (&optional spacer) - "Display the position in the current file as an icon." - (when file-percentage-mode - (let ((perc (+modeline--percentage))) - (propertize (+modeline-spacer nil spacer - (cond - ((+modeline--buffer-contained-in-window-p) "111") - ((= perc 0) "000") - ((< perc 20) "001") - ((< perc 40) "010") - ((< perc 60) "011") - ((< perc 80) "100") - ((< perc 100) "101") - ((>= perc 100) "110"))) - 'help-echo (format "Point is %d%% through the buffer." - perc))))) - -(define-minor-mode region-indicator-mode - "Toggle the region indicator in the mode line." - :init-value t :global t :group 'mode-line) - -(defun +modeline-region (&optional spacer) - "Display an indicator if the region is active." - (when (and region-indicator-mode - (region-active-p)) - (+modeline-spacer nil spacer - (propertize (format "%d%s" - (apply '+ (mapcar (lambda (pos) - (- (cdr pos) - (car pos))) - (region-bounds))) - (if (and (< (point) (mark))) "-" "+")) - 'font-lock-face 'font-lock-variable-name-face)))) - -(defun +modeline-line (&optional spacer) - (when line-number-mode - (+modeline-spacer nil spacer - "%3l"))) - -(defun +modeline-column (&optional spacer) - (when column-number-mode - (+modeline-spacer nil spacer - "|" - (if column-number-indicator-zero-based "%2c" "%2C")))) - -(defcustom +modeline-position-function nil - "Function to use instead of `+modeline-position' in modeline." - :type '(choice (const :tag "Default" nil) - function) - :local t) - -(defun +modeline-position (&optional spacer) - "Display the current cursor position. -See `line-number-mode', `column-number-mode', and -`file-percentage-mode'. If `+modeline-position-function' is set -to a function in the current buffer, call that function instead." - (cond ((functionp +modeline-position-function) - (when-let* ((str (funcall +modeline-position-function))) - (+modeline-spacer nil spacer str))) - (t (funcall (+modeline-concat '(+modeline-region - +modeline-line - +modeline-column - +modeline-file-percentage) - ""))))) - -(defun +modeline-vc (&optional spacer) - "Display the version control branch of the current buffer in the modeline." - ;; from https://www.gonsie.com/blorg/modeline.html, from Doom - (when-let ((backend (vc-backend buffer-file-name))) - (+modeline-spacer nil spacer - (substring vc-mode (+ (if (eq backend 'Hg) 2 3) 2))))) - -(defun +modeline-track (&optional spacer) - "Display `tracking-mode' information." - (when tracking-mode - tracking-mode-line-buffers)) - -(defun +modeline-anzu (&optional spacer) - "Display `anzu--update-mode-line'." - (+modeline-spacer nil spacer - (anzu--update-mode-line))) - -(defun +modeline-text-scale (&optional spacer) - "Display text scaling level." - ;; adapted from https://github.com/seagle0128/doom-modeline - (when (and (boundp 'text-scale-mode-amount) - (/= text-scale-mode-amount 0)) - (+modeline-spacer nil spacer - (concat (if (> text-scale-mode-amount 0) "+" "-") - (number-to-string text-scale-mode-amount))))) - -(defun +modeline-ace-window-display (&optional spacer) - "Display `ace-window-display-mode' information in the modeline." - (when (and +ace-window-display-mode - ace-window-mode) - (+modeline-spacer nil spacer - (window-parameter (selected-window) 'ace-window-path)))) - -(defun +modeline-god-mode (&optional spacer) - "Display an icon when `god-mode' is active." - (when (and (boundp 'god-local-mode) god-local-mode) - (+modeline-spacer nil spacer - (propertize "Ω" - 'help-echo (concat "God mode is active." - "\nmouse-1: exit God mode.") - 'local-map (purecopy - (simple-modeline-make-mouse-map - 'mouse-1 (lambda (e) - (interactive "e") - (with-selected-window - (posn-window - (event-start e)) - (god-local-mode -1) - (force-mode-line-update))))) - 'mouse-face 'mode-line-highlight)))) - -(defun +modeline-input-method (&optional spacer) - "Display which input method is active." - (when current-input-method - (+modeline-spacer nil spacer - (propertize current-input-method-title - 'help-echo (format - (concat "Current input method: %s\n" - "mouse-1: Describe current input method\n" - "mouse-3: Toggle input method") - current-input-method) - 'local-map (purecopy - (let ((map (make-sparse-keymap))) - (define-key map [mode-line mouse-1] - (lambda (e) - (interactive "e") - (with-selected-window (posn-window (event-start e)) - (describe-current-input-method)))) - (define-key map [mode-line mouse-3] - (lambda (e) - (interactive "e") - (with-selected-window (posn-window (event-start e)) - (toggle-input-method nil :interactive)))) - map)) - 'mouse-face 'mode-line-highlight)))) - -(defface +modeline-kmacro-indicator '((t :foreground "Firebrick")) - "Face for the kmacro indicator in the modeline.") - -(defun +modeline-kmacro-indicator (&optional spacer) - "Display an indicator when recording a kmacro." - (when defining-kbd-macro - (+modeline-spacer nil spacer - (propertize "●" - 'face '+modeline-kmacro-indicator - 'help-echo (format (concat "Defining a macro\n" - "Current step: %d\n" - "mouse-1: Stop recording") - kmacro-counter) - 'local-map (purecopy (simple-modeline-make-mouse-map - 'mouse-1 (lambda (e) - (interactive "e") - (with-selected-window - (posn-window (event-start e)) - (kmacro-end-macro nil))))) - 'mouse-face 'mode-line-highlight)))) - -(defface +nyan-mode-line nil - "Face for nyan-cat in mode line.") - -(defun +modeline-nyan-on-focused (&optional spacer) - "Display the cat from `nyan-mode', but only on the focused window." - (require 'nyan-mode) - (when (and (or nyan-mode (bound-and-true-p +nyan-local-mode)) - (actually-selected-window-p)) - (+modeline-spacer nil spacer - (propertize (nyan-create) 'face '+nyan-mode-line)))) - -(provide '+modeline) -;;; +modeline.el ends here diff --git a/lisp/+mwim.el b/lisp/+mwim.el deleted file mode 100644 index 97a2b04..0000000 --- a/lisp/+mwim.el +++ /dev/null @@ -1,42 +0,0 @@ -;;; +mwim.el --- Extras -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -(require 'seq) - -(defgroup +mwim nil - "Extra `mwim' customizations." - :group 'mwim) - -(defcustom +mwim-passthrough-modes nil - "Modes to not move-where-I-mean." - :type '(repeat function)) - -(defun +mwim-beginning-maybe (&optional arg) - "Perform `mwim-beginning', maybe. -Will just do \\[beginning-of-line] in one of -`+mwim-passthrough-modes'." - (interactive) - (if (apply #'derived-mode-p +mwim-passthrough-modes) - (let ((this-mode-map (symbol-value (intern (format "%s-map" major-mode)))) - (key "C-a")) - (call-interactively (or (keymap-lookup this-mode-map key t t) - (keymap-lookup (current-global-map) key t t)))) - (call-interactively #'mwim-beginning))) - -(defun +mwim-end-maybe (&optional arg) - "Perform `mwim-beginning', maybe. -Will just do \\[end-of-line] in one of -`+mwim-passthrough-modes'." - (interactive) - (if (apply #'derived-mode-p +mwim-passthrough-modes) - (let ((this-mode-map (symbol-value (intern (format "%s-map" major-mode)))) - (key "C-e")) - (call-interactively (or (keymap-lookup this-mode-map key t t) - (keymap-lookup (current-global-map) key t t)))) - (call-interactively #'mwim-end))) - -(provide '+mwim) -;;; +mwim.el ends here diff --git a/lisp/+notmuch.el b/lisp/+notmuch.el deleted file mode 100644 index 9e79c5a..0000000 --- a/lisp/+notmuch.el +++ /dev/null @@ -1,97 +0,0 @@ -;;; +notmuch.el --- Notmuch extras -*- lexical-binding: t; -*- - -;;; Commentary: - -;; This is stuff that I suppose /could/ go in notmuch/init.el, but ... doesn't. - -;;; Code: - -(require 'cl-lib) -(require 'notmuch) - -(defvar +notmuch-send-dispatch-rules nil - "Alist of from addresses and variables to set when sending.") - -(defun +notmuch-query-concat (&rest queries) - "Concatenate notmuch queries." - (mapconcat #'identity queries " AND ")) - -(defun +send-mail-dispatch () - "Dispatch mail sender, depending on account." - (let ((from (message-fetch-field "from"))) - (dolist (vars (cl-loop for (addr . vars) in +notmuch-send-dispatch-rules - if (string-match-p addr from) return vars)) - (set (car vars) (cdr vars))))) - -(defun +notmuch-correct-tags (args) - (list (car args) (mapcar #'string-trim (cadr args)))) - -(defun +notmuch-goto (&optional prefix) - "Go straight to a `notmuch' search. -Without PREFIX argument, go to the first one in -`notmuch-saved-searches'; with a PREFIX argument, prompt the user -for which saved search to go to; with a double PREFIX -argument (\\[universal-argument] \\[universal-argument]), prompt -for search." - (interactive "P") - (pcase prefix - ('nil (notmuch-search (plist-get (car notmuch-saved-searches) :query))) - ('(4) (notmuch-search (plist-get (cl-find (completing-read "Saved Search: " - (mapcar (lambda (el) - (plist-get el :name)) - notmuch-saved-searches)) - notmuch-saved-searches - :key (lambda (el) (plist-get el :name)) - :test #'equal) - :query))) - (_ (notmuch-search)))) - -;; Don't add an initial input when completing addresses -(el-patch-feature notmuch) -(with-eval-after-load 'notmuch - (el-patch-defun notmuch-address-selection-function (prompt collection initial-input) - "Call (`completing-read' - PROMPT COLLECTION nil nil INITIAL-INPUT 'notmuch-address-history)" - (completing-read - prompt collection nil nil - (el-patch-swap initial-input - nil) - 'notmuch-address-history))) - -(defcustom +notmuch-spam-tags '("+spam" "+Spam") - "A list of tag changes to apply when marking a thread as spam." - :type '(repeat string)) - -(defun +notmuch-tree-mark-spam-then-next (&optional ham beg end) - "Mark the current message as spam and move to the next." - (interactive "P") - (+notmuch-tree-mark-spam ham) - (notmuch-tree-next-matching-message)) - -(defun +notmuch-tree-mark-spam (&optional ham) - "Mark the current message as spam. -That is, apply the tag changes in `+notmuch-spam-tags' to it. If -an optional prefix HAM argument is given, the message will be -marked as not-spam (\"ham\"), i.e., the tag changes in -`+notmuch-spam-tags' will be reversed." - (interactive "P") - (when +notmuch-spam-tags - (notmuch-tree-tag - (notmuch-tag-change-list +notmuch-spam-tags ham)))) - -(defun +notmuch-search-mark-spam (&optional ham beg end) - "Mark the current thread or region as spam. -This adds the tags in `+notmuch-spam-tags' to the message. With -an optional HAM prefix argument, mark the messages as -not-spam (\"ham\"). - -This function advances the next thread when finished." - (interactive (cons current-prefix-arg (notmuch-interactive-region))) - (when +notmuch-spam-tags - (notmuch-search-tag - (notmuch-tag-change-list +notmuch-spam-tags ham) beg end)) - (when (eq beg end) - (notmuch-search-next-thread))) - -(provide '+notmuch) -;;; +notmuch.el ends here diff --git a/lisp/+nyan-mode.el b/lisp/+nyan-mode.el deleted file mode 100644 index 33ae9af..0000000 --- a/lisp/+nyan-mode.el +++ /dev/null @@ -1,42 +0,0 @@ -;;; +nyan-mode.el --- Extras for nyan-mode -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -;;; Update even without line number in the mode line. - -(defcustom +nyan-mode-update-functions - '( end-of-buffer beginning-of-buffer - next-line previous-line - org-next-visible-heading org-previous-visible-heading) - "Functions after which to force a mode-line update." - :type '(repeat function)) - -(defun +nyan-mode--fmlu (&rest _) - "Update the mode-line, advice-style." - (force-mode-line-update)) - -(defun +nyan-mode-advice (&rest _) - "Advise line-moving functions when in `nyan-mode'." - (dolist (fn +nyan-mode-update-functions) - (if nyan-mode - (advice-add fn :after #'+nyan-mode--fmlu) - (advice-remove fn #'+nyan-mode--fmlu)))) - -(defface +nyan-mode-line nil - "Face for the nyan-mode mode-line indicator.") - -(define-minor-mode +nyan-local-mode - "My very own `nyan-mode' that isn't global and doesn't update the mode-line." - :global nil - :group 'nyan - (dolist (fn +nyan-mode-update-functions) - (if +nyan-local-mode - (advice-add fn :after #'+nyan-mode--fmlu) - (advice-remove fn #'+nyan-mode--fmlu)))) - -(define-globalized-minor-mode +nyan-mode +nyan-local-mode +nyan-local-mode) - -(provide '+nyan-mode) -;;; +nyan-mode.el ends here diff --git a/lisp/+orderless.el b/lisp/+orderless.el deleted file mode 100644 index ac8c1b4..0000000 --- a/lisp/+orderless.el +++ /dev/null @@ -1,60 +0,0 @@ -;;; +orderless.el --- Mostly from minad -*- lexical-binding: t; -*- - -;;; Commentary: - -;; See https://github.com/minad/consult/wiki#minads-orderless-configuration - -;;; Code: - -(require 'orderless) - -;;; Dispataching - -(defvar +orderless-dispatch-alist '((?% . char-fold-to-regexp) - (?! . orderless-without-literal) - (?` . orderless-initialism) - (?= . orderless-literal) - (?~ . orderless-flex)) - "Charcters to dispatch styles on orderless segments.") - -(defun +orderless-dispatch (pattern index _total) - "Dispatch orderless segments of a search string. -Dispatchers are taken from `+orderless-dispatch-alist', and added -to the following defaults: - -- regexp$ :: matches REGEXP at the end of the pattern. -- .ext :: matches EXT (at end of pattern) - -Dispatch characters can be added at the beginning or ending of a -segment to make that segment match accordingly." - (cond - ;; Ensure that $ works with Consult commands, which add disambiguation - ;; suffixes - ((string-suffix-p "$" pattern) - (cons 'orderless-regexp - (concat (substring pattern 0 -1) "[\x100000-\x10FFFD]*$"))) - ;; File extensions - ((and - ;; Completing filename or eshell - (or minibuffer-completing-file-name - (derived-mode-p 'eshell-mode)) - ;; File extension - (string-match-p "\\`\\.." pattern)) - (cons 'orderless-regexp - (concat "\\." (substring pattern 1) "[\x100000-\x10FFFD]*$"))) - ;; Ignore single ! - ((string= "!" pattern) `(orderless-literal . "")) - ;; Prefix and suffix - ((if-let (x (assq (aref pattern 0) +orderless-dispatch-alist)) - (cons (cdr x) (substring pattern 1)) - (when-let (x (assq (aref pattern (1- (length pattern))) - +orderless-dispatch-alist)) - (cons (cdr x) (substring pattern 0 -1))))))) - -(orderless-define-completion-style +orderless-with-initialism - (orderless-matching-styles '(orderless-initialism - orderless-literal - orderless-regexp))) - -(provide '+orderless) -;;; +orderless.el ends here diff --git a/lisp/+org-attach.el b/lisp/+org-attach.el deleted file mode 100644 index 5e7cc7f..0000000 --- a/lisp/+org-attach.el +++ /dev/null @@ -1,29 +0,0 @@ -;;; +org-attach.el --- Fixes for org-attach -*- lexical-binding: t; -*- - -;;; Commentary: - -;; `org-attach-attach' doesn't fix the path name. Before I submit a bug, I'm -;; just fixing it by advising `org-attach-attach'. - -;;; Code: - -(defun +org-attach-attach-fix-args (args) - "ADVICE for `org-attach-attach' to normalize FILE first. -VISIT-DIR and METHOD are passed through unchanged. - -This should be applied as `:filter-args' advice." - (cons (expand-file-name (car args)) (cdr args))) - -(define-minor-mode +org-attach-fix-args-mode - "Fix the arguments passed to `org-attach-attach'. -This mode normalizes the filename passed to `org-attach-attach' -so that links can be properly made." - :lighter "" - :keymap nil - :global t ; I figure, what does this hurt? - (if +org-attach-fix-args-mode - (advice-add 'org-attach-attach :filter-args #'+org-attach-attach-fix-args) - (advice-remove 'org-attach-attach #'+org-attach-attach-fix-args))) - -(provide '+org-attach) -;;; +org-attach.el ends here diff --git a/lisp/+org-capture.el b/lisp/+org-capture.el deleted file mode 100644 index 7ed4e00..0000000 --- a/lisp/+org-capture.el +++ /dev/null @@ -1,164 +0,0 @@ -;;; +org-capture.el -*- lexical-binding: t; -*- - -;;; Code: - -(require 'cl-lib) -(require 'acdw) -;; We don't require `org-capture' here because I'll have to require this library -;; to init.el /before/ org-capture is fully needed. But I do need to declare -;; `org-capture-templates'. -(defvar org-capture-templates nil) - -(defun +org-capture--get (key &optional list) - "Find KEY in LIST, or return nil. -LIST defaults to `org-capture-templates'." - (alist-get key (or list org-capture-templates) nil nil #'equal)) - -;; Set it up as a generic value. Based on the one for `alist-get'. -(gv-define-expander +org-capture--get - (lambda (do key &optional alist) - (setq alist (or alist org-capture-templates)) - (macroexp-let2 macroexp-copyable-p k key - (gv-letplace (getter setter) alist - (macroexp-let2 nil p `(assoc ,k ,getter 'equal) - (funcall do `(cdr ,p) - (lambda (v) - (macroexp-let2 nil v v - (let ((set-exp - `(if ,p (setcdr ,p ,v) - ,(funcall setter - `(cons (setq ,p (cons ,k ,v)) - ,getter))))) - `(progn - ,set-exp - ,v)))))))))) - -(defun +org-capture-sort (&optional list) - "Sort LIST by string keys. -LIST is a symbol and defaults to `org-capture-templates'." - (setq list (or list 'org-capture-templates)) - (set list (sort (symbol-value list) (lambda (a b) - (string< (car a) (car b)))))) - -(defun +org-capture-sort-after-init (&optional list) - "Sort LIST with `+org-capture-sort' after Emacs init." - (+ensure-after-init #'+org-capture-sort)) - -;;;###autoload -(defun +org-capture-templates-setf (key value &optional list sort-after) - "Add KEY to LIST, using `setf'. -LIST is a symbol and defaults to `org-capture-templates' -- so -this function sets values on a list that's structured as such. - -Thus, KEY is a string key. If it's longer than one character, -this function will search LIST for each successive run of -characters before the final, ensuring sub-lists exist of the -form (CHARS DESCRIPTION). - -For example, if KEY is \"abc\", first a LIST item of the form (a -DESCRIPTION), if non-existant, will be added to the list (with a -default description), then an item of the -form (\"ab\" DESCRIPTION), before adding (KEY VALUE) to the LIST. - -VALUE is the template or group header required for -`org-capture-templates', which see. - -SORT-AFTER, when set to t, will call -`+org-capture-templates-sort' after setting, to ensure org can -properly process the variable." - ;; LIST defaults to `org-capture-templates' - (declare (indent 2)) - (unless list (setq list 'org-capture-templates)) - ;; Ensure VALUE is a list to cons properly - (unless (listp value) (setq value (list value))) - (when (> (length key) 1) - ;; Check for existence of groups. - (let ((expected (cl-loop for i from 1 to (1- (length key)) - collect (substring key 0 i) into keys - finally return keys))) - (cl-loop for ek in expected - if (not (+org-capture--get ek (symbol-value list))) do - (setf (+org-capture--get ek (symbol-value list)) - (list (format "(Group %s)" ek)))))) - (prog1 ;; Set KEY to VALUE - (setf (+org-capture--get key (symbol-value list)) value) - ;; Sort after, maybe - (when sort-after (+org-capture-sort list)))) - -(defun +org-template--ensure-path (keys &optional list) - "Ensure path of keys exists in `org-capture-templates'." - (unless list (setq list 'org-capture-templates)) - (when (> (length key) 1) - ;; Check for existence of groups. - (let ((expected (cl-loop for i from 1 to (1- (length key)) - collect (substring key 0 i) into keys - finally return keys))) - (cl-loop for ek in expected - if (not (+org-capture--get ek (symbol-value list))) do - (setf (+org-capture--get ek (symbol-value list)) - (list (format "(Group %s)" ek))))))) - -(defcustom +org-capture-default-type 'entry - "Default template for `org-capture-templates'." - :type '(choice (const :tag "Entry" entry) - (const :tag "Item" item) - (const :tag "Check Item" checkitem) - (const :tag "Table Line" table-line) - (const :tag "Plain Text" plain))) - -(defcustom +org-capture-default-target "" - "Default target for `org-capture-templates'." - ;; TODO: type - ) - -(defcustom +org-capture-default-template nil - "Default template for `org-capture-templates'." - ;; TODO: type - ) - -(defun +org-define-capture-templates-group (keys description) - "Add a group title to `org-capture-templates'." - (setf (+org-capture--get keys org-capture-templates) - (list description))) - -;; [[https://github.com/cadadr/configuration/blob/39813a771286e542af3aa333172858532c3bb257/emacs.d/gk/gk-org.el#L1573][from cadadr]] -(defun +org-define-capture-template (keys description &rest args) - "Define a capture template and necessary antecedents. -ARGS is a plist, which in addition to the additional options -`org-capture-templates' accepts, takes the following and places -them accordingly: :type, :target, and :template. Each of these -corresponds to the same field in `org-capture-templates's -docstring, which see. Likewise with KEYS and DESCRIPTION, which -are passed separately to the function. - -This function will also create all the necessary intermediate -capture keys needed for `org-capture'; that is, if KEYS is -\"wcp\", entries for \"w\" and \"wc\" will both be ensured in -`org-capture-templates'." - (declare (indent 2)) - ;; Check for existence of parent groups - (when (> (length keys) 1) - (let ((expected (cl-loop for i from 1 to (1- (length keys)) - collect (substring 0 i) into keys - finally return keys))) - (cl-loop - for ek in expected - if (not (+org-capture--get ek org-capture-templates)) - do (+org-define-capture-templates-group ek (format "(Group %s)" ek))))) - (if (null args) - ;; Add the title - (+org-define-capture-templates-group keys description) - ;; Add the capture template. - (setf (+org-capture--get keys org-capture-templates) - (append (list (or (plist-get args :type) - +org-capture-default-type) - (or ( plist-get args :target) - +org-capture-default-target) - (or (plist-get args :template) - +org-capture-default-template)) - (cl-loop for (key val) on args by #'cddr - unless (member key '(:type :target :template)) - append (list key val)))))) - -(provide '+org-capture) -;;; +org-capture.el ends here diff --git a/lisp/+org-drawer-list.el b/lisp/+org-drawer-list.el deleted file mode 100644 index 5066d4d..0000000 --- a/lisp/+org-drawer-list.el +++ /dev/null @@ -1,47 +0,0 @@ -;;; +org-drawer-list.el --- Add stuff to org drawers easy-style -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -(require 'org) -(require '+org) -(require 'ol) -(require 'org-drawer-list) - -(defcustom +org-drawer-list-resources-drawer "RESOURCES" - "Where to add links with `+org-drawer-list-add-resource'.") - -(defun +org-drawer-list-add-resource (url &optional title) - "Add URL to the resource drawer of the current tree. -The resource drawer is given by the variable -`+org-drawer-list-resources-drawer'. If optional TITLE is given, -format the list item as an Org link." - (interactive - (let* ((clipboard-url (if (string-match-p (rx (sequence bos - (or "http" - "gemini" - "gopher" - "tel" - "mailto"))) - (current-kill 0)) - (string-trim (current-kill 0)) - (read-string "Resource URL: "))) - (url-title (let ((clipboard-headings - (+org-insert--get-title-and-headings clipboard-url))) - (read-string "title (edit): " - (completing-read - "title: " clipboard-headings - nil nil nil nil (car clipboard-headings)))))) - (list clipboard-url url-title))) - (let (current-visible-mode visible-mode) - ;; XXX: This is not the "proper" way to fix the issue I was having --- I've - ;; isolated the bug to somewhere in `org-insert-item', but this fix works - ;; well enough™ for now. - (visible-mode +1) - (org-drawer-list-add +org-drawer-list-resources-drawer - (org-link-make-string url title)) - (visible-mode (if current-visible-mode +1 -1)))) - -(provide '+org-drawer-list) -;;; +org-drawer-list.el ends here diff --git a/lisp/+org-wc.el b/lisp/+org-wc.el deleted file mode 100644 index 89b2708..0000000 --- a/lisp/+org-wc.el +++ /dev/null @@ -1,112 +0,0 @@ -;;; +org-wc.el --- org-wc in the modeline -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -(require 'org-wc) -(require '+modeline) -(require 'cl-lib) - -(defgroup +org-wc nil - "Extra fast word-counting in `org-mode'" - :group 'org-wc - :group 'org) - -(defvar-local +org-wc-word-count nil - "Running total of words in this buffer.") - -(defcustom +org-wc-update-after-funcs '(org-narrow-to-subtree - org-narrow-to-block - org-narrow-to-element - org-capture-narrow) - "Functions after which to update the word count." - :type '(repeat function)) - -(defcustom +org-wc-deletion-idle-timer 0.25 - "Length of time, in seconds, to wait before updating word-count." - :type 'number) - -(defcustom +org-wc-huge-change 5000 - "Number of characters that constitute a \"huge\" insertion." - :type 'number) - -(defcustom +org-wc-huge-buffer 10000 - "Number of words past which we're not going to try to count." - :type 'number) - -(defvar +org-wc-correction -5 - "Number to add to `+org-wc-word-count', for some reason? -`+org-wc-word-count' seems to consistently be off by 5. Thus -this correction. (At some point I should correct the underlying -code... probably).") - -(defvar-local +org-wc-update-timer nil) - -(defun +org-wc-delayed-update (&rest _) - (if +org-wc-update-timer - (setq +org-wc-update-timer nil) - (setq +org-wc-update-timer - (run-with-idle-timer +org-wc-deletion-idle-timer nil #'+org-wc-update)))) - -(defun +org-wc-force-update () - (interactive) - (message "Counting words...") - (when (timerp +org-wc-update-timer) - (cancel-timer +org-wc-update-timer)) - (+org-wc-update) - (message "Counting words...done")) - -(defun +org-wc-update (&rest _) ; Needs variadic parameters, since it's advice - (dlet ((+org-wc-counting t)) - (+org-wc-buffer) - (force-mode-line-update) - (setq +org-wc-update-timer nil))) - -(defun +org-wc-changed (start end length) - (+org-wc-delayed-update)) - -(defun +org-wc-buffer () - "Count the words in the buffer." - (when (and (derived-mode-p 'org-mode) - (not (eq +org-wc-word-count 'huge))) - (setq +org-wc-word-count - (cond - ((> (count-words (point-min) (point-max)) - +org-wc-huge-buffer) - 'huge) - (t (org-word-count-aux (point-min) (point-max))))))) - -(defvar +org-wc-counting nil - "Are we currently counting?") - -(defun +org-wc-recount-widen (&rest _) - (when (and (not +org-wc-counting)) - (+org-wc-update))) - -(defun +org-wc-modeline () - (cond - ((eq +org-wc-word-count 'huge) "huge") - (+org-wc-word-count (format "%sw" (max 0 (+ +org-wc-word-count +org-wc-correction)))))) - -(define-minor-mode +org-wc-mode - "Count words in `org-mode' buffers in the mode-line." - :lighter "" - :keymap (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-c C-.") #'+org-wc-force-update) - map) - (if +org-wc-mode - (progn ; turn on - (+org-wc-buffer) - (add-hook 'after-change-functions #'+org-wc-delayed-update nil t) - (setq-local +modeline-position-function #'+org-wc-modeline) - (dolist (fn +org-wc-update-after-funcs) - (advice-add fn :after #'+org-wc-update))) - (progn ; turn off - (remove-hook 'after-change-functions #'+org-wc-delayed-update t) - (kill-local-variable '+modeline-position-function) - (dolist (fn +org-wc-update-after-funcs) - (advice-remove fn #'+org-wc-update))))) - -(provide '+org-wc) -;;; +org-wc.el ends here diff --git a/lisp/+org.el b/lisp/+org.el deleted file mode 100644 index dc0ce1b..0000000 --- a/lisp/+org.el +++ /dev/null @@ -1,816 +0,0 @@ -;;; +org.el -*- lexical-binding: t; -*- - -;;; Code: - -(require 'el-patch) -(require 'org) -(require 'org-element) -(require 'ox) - -;;; org-return-dwim - [[https://github.com/alphapapa/unpackaged.el][unpackaged]] and [[http://kitchingroup.cheme.cmu.edu/blog/2017/04/09/A-better-return-in-org-mode/][kitchin]] - -(defun +org-element-descendant-of (type element) - "Return non-nil if ELEMENT is a descendant of TYPE. -TYPE should be an element type, like `item' or `paragraph'. -ELEMENT should be a list like that returned by `org-element-context'." - ;; MAYBE: Use `org-element-lineage'. - (when-let* ((parent (org-element-property :parent element))) - (or (eq type (car parent)) - (+org-element-descendant-of type parent)))) - -(defun +org-return-dwim (&optional prefix) - "A helpful replacement for `org-return'. With PREFIX, call `org-return'. - -On headings, move point to position after entry content. In -lists, insert a new item or end the list, with checkbox if -appropriate. In tables, insert a new row or end the table." - (interactive "P") - ;; Auto-fill if enabled - (when auto-fill-function - (if (listp auto-fill-function) - (dolist (func auto-fill-function) - (funcall func)) - (funcall auto-fill-function))) - (if prefix - ;; Handle prefix args - (pcase prefix - ('(4) (newline)) - ('(16) (newline 2)) - ;; this is ... not ideal. but whatever. - (_ (newline prefix))) - (cond - ;; Act depending on context around point. - ((and org-return-follows-link - (eq 'link (car (org-element-context)))) - ;; Link: Open it. - (org-open-at-point-global)) - - ((org-at-heading-p) - ;; Heading: Move to position after entry content. - ;; NOTE: This is probably the most interesting feature of this function. - (let ((heading-start (org-entry-beginning-position))) - (goto-char (org-entry-end-position)) - (cond ((and (org-at-heading-p) - (= heading-start (org-entry-beginning-position))) - ;; Entry ends on its heading; add newline after - (end-of-line) - (insert "\n\n")) - (t - ;; Entry ends after its heading; back up - (forward-line -1) - (end-of-line) - (when (org-at-heading-p) - ;; At the same heading - (forward-line) - (insert "\n") - (forward-line -1)) - (while (not - (looking-back - (rx (repeat 3 (seq (optional blank) "\n"))) - nil)) - (insert "\n")) - (forward-line -1))))) - - ((org-at-item-checkbox-p) - ;; Checkbox: Insert new item with checkbox. - (org-insert-todo-heading nil)) - - ((org-in-item-p) - ;; Plain list - (let* ((context (org-element-context)) - (first-item-p (eq 'plain-list (car context))) - (itemp (eq 'item (car context))) - (emptyp (or - ;; Empty list item (regular) - (eq (org-element-property :contents-begin context) - (org-element-property :contents-end context)) - ;; Empty list item (definition) - ;; This seems to work, with minimal testing. -- 2022-02-17 - (looking-at " *::"))) - (item-child-p - (+org-element-descendant-of 'item context))) - ;; The original function from unpackaged just tested the (or ...) test - ;; in this cond, in an if. However, that doesn't auto-end nested - ;; lists. So I made this form a cond and added the (and...) test in - ;; the first position, which is clunky (the delete-region... stuff - ;; comes twice) and might not be needed. More testing, obviously, but - ;; for now, it works well enough. - (cond ((and itemp emptyp) - (delete-region (line-beginning-position) (line-end-position)) - (insert "\n")) - ((or first-item-p - (and itemp (not emptyp)) - item-child-p) - (org-insert-item)) - (t (delete-region (line-beginning-position) (line-end-position)) - (insert "\n"))))) - - ((when (fboundp 'org-inlinetask-in-task-p) - (org-inlinetask-in-task-p)) - ;; Inline task: Don't insert a new heading. - (org-return)) - - ((org-at-table-p) - (cond ((save-excursion - (beginning-of-line) - ;; See `org-table-next-field'. - (cl-loop with end = (line-end-position) - for cell = (org-element-table-cell-parser) - always (equal (org-element-property :contents-begin cell) - (org-element-property :contents-end cell)) - while (re-search-forward "|" end t))) - ;; Empty row: end the table. - (delete-region (line-beginning-position) (line-end-position)) - (org-return)) - (t - ;; Non-empty row: call `org-return'. - (org-return)))) - (t - ;; All other cases: call `org-return'. - (org-return))))) - -(defun +org-table-copy-down (n) - "Call `org-table-copy-down', or `org-return' outside of a table. -N is passed to the functions." - (interactive "p") - (if (org-table-check-inside-data-field 'noerror) - (org-table-copy-down n) - (+org-return-dwim n))) - -;;; org-fix-blank-lines - unpackaged.el - -(defun +org-fix-blank-lines (&optional prefix) - "Ensure blank lines around headings. -Optional PREFIX argument operates on the entire buffer. -Drawers are included with their headings." - (interactive "P") - (let ((org-element-use-cache nil)) - (org-map-entries (lambda () - (let ((beg (org-entry-beginning-position)) - (end (org-entry-end-position))) - (org-with-wide-buffer - ;; `org-map-entries' narrows the buffer, which - ;; prevents us from seeing newlines before the - ;; current heading, so we do this part widened. - (while (not (looking-back "\n\n" nil)) - ;; Insert blank lines before heading. - (insert "\n"))) - - ;; Insert blank lines before entry content - (forward-line) - (while (and (org-at-planning-p) - (< (point) (point-max))) - ;; Skip planning lines - (forward-line)) - (while (re-search-forward - org-drawer-regexp end t) - ;; Skip drawers. You might think that - ;; `org-at-drawer-p' would suffice, but for - ;; some reason it doesn't work correctly when - ;; operating on hidden text. This works, taken - ;; from `org-agenda-get-some-entry-text'. - (re-search-forward "^[ \t]*:END:.*\n?" end t) - (goto-char (match-end 0))) - (unless (or (= (point) (point-max)) - (org-at-heading-p) - (looking-at-p "\n")) - (insert "\n")))) - t - (if prefix - nil - 'tree)))) - -;;; org-count-words - -(defun +org-count-words-stupidly (start end &optional limit) - "Count words between START and END, ignoring a lot. - -Since this function is, for some reason, pricy, the optional -parameter LIMIT sets a word limit at which to stop counting. -Once the function hits that number, it'll return -LIMIT -instead of the true count." - (interactive (list nil nil)) - (cond ((not (called-interactively-p 'any)) - (let ((words 0) - (continue t)) - (save-excursion - (save-restriction - (narrow-to-region start end) - (goto-char (point-min)) - (while (and continue - (< (point) (point-max))) - (cond - ;; Ignore comments - ((or (org-at-comment-p) - (org-in-commented-heading-p)) - (forward-line)) - ;; Ignore headings - ((or (org-at-heading-p)) - (forward-line)) - ;; Ignore property and log drawers - ((or (looking-at org-drawer-regexp) - (looking-at org-clock-drawer-re)) - (search-forward ":END:" nil :noerror) - (forward-line)) - ;; Ignore DEADLINE and SCHEDULED keywords - ((or (looking-at org-deadline-regexp) - (looking-at org-scheduled-regexp) - (looking-at org-closed-time-regexp)) - (forward-line)) - ;; Ignore tables - ((org-at-table-p) (forward-line)) - ;; Ignore hyperlinks, but count the descriptions - ((looking-at org-link-bracket-re) - (when-let ((desc (match-string-no-properties 5))) - (save-match-data - (setq words (+ words - (length (remove "" - (org-split-string - desc "\\W"))))))) - (goto-char (match-end 0))) - ;; Ignore source blocks - ((org-in-src-block-p) (forward-line)) - ;; Ignore blank lines - ((looking-at "^$") - (forward-line)) - ;; Count everything else - (t - ;; ... unless it's in a few weird contexts - (let ((contexts (org-context))) - (cond ((or (assoc :todo-keyword contexts) - (assoc :priority contexts) - (assoc :keyword contexts) - (assoc :checkbox contexts)) - (forward-word-strictly)) - - (t (setq words (1+ words)) - (if (and limit - (> words limit)) - (setq words (- limit) - continue nil)) - (forward-word-strictly))))))))) - words)) - ((use-region-p) - (message "%d words in region" - (+org-count-words-stupidly (region-beginning) - (region-end)))) - (t - (message "%d words in buffer" - (+org-count-words-stupidly (point-min) - (point-max)))))) - -;;; org-insert-link-dwim - https://xenodium.com/emacs-dwim-do-what-i-mean/ - -(defun +org-insert--get-title-and-headings (url) - "Retrieve title and headings from URL. -Return as a list." - (with-current-buffer (url-retrieve-synchronously url) - (let ((dom (libxml-parse-html-region (point-min) (point-max)))) - (cl-remove-if - (lambda (i) (string= i "")) - (apply #'append (mapcar (lambda (tag) - (mapcar #'dom-text - (dom-by-tag dom tag))) - '(title h1 h2 h3 h4 h5 h6))))))) - -(defun +org-insert-link-dwim (&optional interactivep) - "Like `org-insert-link' but with personal dwim preferences." - (interactive '(t)) - (let* ((point-in-link (org-in-regexp org-link-any-re 1)) - (clipboard-url (when (string-match-p - (rx (sequence bos - (or "http" - "gemini" - "gopher" - "tel" - "mailto"))) - (current-kill 0)) - (current-kill 0))) - (region-content (when (region-active-p) - (buffer-substring-no-properties (region-beginning) - (region-end)))) - (org-link (when (and clipboard-url (not point-in-link)) - (org-link-make-string - (string-trim clipboard-url) - (or region-content - (let ((clipboard-headings - (+org-insert--get-title-and-headings clipboard-url))) - (read-string "title (edit): " - (completing-read - "title: " clipboard-headings - nil nil nil nil (car clipboard-headings))))))))) - (if interactivep - (cond ((and region-content clipboard-url (not point-in-link)) - (delete-region (region-beginning) (region-end)) - (insert org-link)) - ((and clipboard-url (not point-in-link)) - (insert org-link)) - (t - (call-interactively 'org-insert-link))) - org-link))) - -;;; Navigate headings with widening - -(defun +org-next-heading-widen (arg) - "Find the ARGth next org heading, widening if necessary." - (interactive "p") - (let ((current-point (point)) - (point-target (if (> arg 0) (point-max) (point-min)))) - (org-next-visible-heading arg) - (when (and (buffer-narrowed-p) - (= (point) point-target) - (or (and (> arg 0)) - (and (< arg 0) - (= (point) current-point)))) - (widen) - (org-next-visible-heading arg)))) - -(defun +org-previous-heading-widen (arg) - "Find the ARGth previous org heading, widening if necessary." - (interactive "p") - (+org-next-heading-widen (- arg))) - -;;; Hooks & Advice - -(defvar +org-before-save-prettify-buffer t - "Prettify org buffers before saving.") - -(put '+org-before-save-prettify-buffer 'safe-local-variable #'booleanp) - -(defun +org-before-save@prettify-buffer () - (when +org-before-save-prettify-buffer - (save-mark-and-excursion - (+org-unsmartify) - (+org-fix-blank-lines t) - (org-align-tags t) - (org-hide-drawer-all) - (when (buffer-narrowed-p) - (goto-char (point-min)) - (forward-line 1) - (org-narrow-to-subtree))))) - -(defun +org-delete-backward-char (N) - "Keep tables aligned while deleting N characters backward. -When deleting backwards, in tables this function will insert -whitespace in front of the next \"|\" separator, to keep the -table aligned. The table will still be marked for re-alignment -if the field did fill the entire column, because, in this case -the deletion might narrow the column." - (interactive "p") - (save-match-data - (org-check-before-invisible-edit 'delete-backward) - (if (and (= N 1) - (not overwrite-mode) - (not (org-region-active-p)) - (not (eq (char-before) ?|)) - (save-excursion (skip-chars-backward " \t") (not (bolp))) - (looking-at-p ".*?|") - (org-at-table-p)) - (progn (forward-char -1) (org-delete-char 1)) - (backward-delete-char-untabify N) - (org-fix-tags-on-the-fly)))) - -;;; Smarter {super,sub}scripts -;; https://old.reddit.com/r/emacs/comments/qzlzm0/what_are_your_top_key_bindings_rebindings_minor/hmwyhm3/ -;; I don't use this currently because I found out about -;; `org-pretty-entities-include-sub-superscripts', which really does exactly -;; what I wanted. - -(defface +org-script-markers '((t (:inherit shadow))) - "Face to be used for sub/superscripts markers i.e., ^, _, {, }.") - -;; Hiding the super and subscript markers is extremely annoying -;; since any remotely complex equation becomes a chore. And leaving -;; it not raised is jarring to the eye. So this fontifies the -;; buffer just like how auctex does -- use a muted colour to -;; highlight the markup and raise the script. -(defun +org-raise-scripts (limit) - "Differences from `org-raise-scripts' are: - -- It doesn't actually hide the markup used for super and subscript. -- It uses a custom face to highlight the markup: +org-script-markers. -- It doesn't require `org-pretty-entities' to be t." - (when (and org-pretty-entities-include-sub-superscripts - (re-search-forward - (if (eq org-use-sub-superscripts t) - org-match-substring-regexp - org-match-substring-with-braces-regexp) - limit t)) - (let* ((pos (point)) table-p comment-p - (mpos (match-beginning 3)) - (emph-p (get-text-property mpos 'org-emphasis)) - (link-p (get-text-property mpos 'mouse-face)) - (keyw-p (eq 'org-special-keyword (get-text-property mpos 'face)))) - (goto-char (point-at-bol)) - (setq table-p (looking-at-p org-table-dataline-regexp) - comment-p (looking-at-p "^[ \t]*#[ +]")) - (goto-char pos) - ;; Handle a_b^c - (when (member (char-after) '(?_ ?^)) (goto-char (1- pos))) - (unless (or comment-p emph-p link-p keyw-p) - (put-text-property (match-beginning 3) (match-end 0) - 'display - (if (equal (char-after (match-beginning 2)) ?^) - ;; (nth (if table-p 3 1) org-script-display) - (nth 3 org-script-display) - ;; (nth (if table-p 2 0) org-script-display) - (nth 2 org-script-display))) - (put-text-property (match-beginning 2) (match-end 2) - 'face '+org-script-markers) - (when (and (eq (char-after (match-beginning 3)) ?{) - (eq (char-before (match-end 3)) ?})) - (put-text-property (match-beginning 3) (1+ (match-beginning 3)) - 'face '+org-script-markers) - (put-text-property (1- (match-end 3)) (match-end 3) - 'face '+org-script-markers))) - t))) - -;; Extra link types - -(defun +org-tel-open (number _) - "Notify the user of what phone NUMBER to call." - (message "Call: %s" number)) - -(defun +org-sms-open (number _) - "Notify the user of what phone NUMBER to text." - (message "SMS: %s" number)) - -;; Make a horizontal rule! - -(defun +org-horizontal-rule () - "Make a horizontal rule after the current line." - (interactive nil org-mode) - (unless (eq (line-beginning-position) (line-end-position)) - (end-of-line) - (newline)) - (dotimes (_ fill-column) - (insert "-"))) - -;; Follow links, DWIM style - -(defun +org-open-at-point-dwim (&optional arg) - "Open thing at point, or if there isn't something, list things." - (interactive "P") - (save-excursion - (let* ((this-char-type (org-element-type (org-element-context))) - (prev-char-type (ignore-errors - (save-excursion - (backward-char) - (org-element-type (org-element-context))))) - (types '(citation citation-reference clock comment comment-block - footnote-definition footnote-reference headline - inline-src-block inlinetask keyword link - node-property planning src-block timestamp)) - (type this-char-type)) - (when (and (memq this-char-type types) (memq prev-char-type types)) - (backward-char) - (setq type prev-char-type)) ; what the fuckckckckck - ;; Okay, so this ^ is pretty janky and doesn't /really/ work that well, - ;; especially on DEADLINE (and probably SCHEDULED) lines. However, since - ;; I really just want to open the list of URLs /most of the time/, I'm - ;; fixing it like this instead. - (unless (and (memq type types) - (ignore-errors (org-open-at-point arg) - t)) - (while (not - (progn - (org-back-to-heading) - (car (org-offer-links-in-entry (current-buffer) (point) 1)))) - (org-up-heading-all 1)) - (org-open-at-point arg))))) - -;;; Open local HTML files with `browse-url' - -(defun +org-open-html (file-path link-string) - "Open FILE-PATH with `browse-url'. -This function is intended to use with `org-file-apps'. See the - documentation of that function for a description of the two - arguments here, FILE-PATH and LINK-STRING." - (message "Opening %s (%s)..." file-path link-string) - (browse-url file-path)) - -(defun +org-insert-horizontal-rule (prefix) - "Insert a horizontal rule (-----) after the current line. -With PREFIX, insert before the current line." - (interactive "P") - (if prefix - (move-beginning-of-line nil) - (move-end-of-line nil) - (forward-line 1)) - (insert "-----\n")) - -;;; Make code snippets in org-mode easier to type -;; http://mbork.pl/2022-01-17_Making_code_snippets_in_Org-mode_easier_to_type - -(defun +org-insert-backtick () - "Insert a backtick using `org-self-insert-command'." - (interactive) - (setq last-command-event ?`) - (call-interactively #'org-self-insert-command)) - -(defvar-local +org-insert-tilde-language nil - "Default language name in the current Org file. -If nil, `org-insert-tilde' after 2 tildes inserts an \"example\" -block. If a string, it inserts a \"src\" block with the given -language name.") - -(defun +org-insert-tilde () - "Insert a tilde using `org-self-insert-command'." - (interactive) - (if (string= (buffer-substring-no-properties (- (point) 3) (point)) - "\n~~") - (progn (delete-char -2) - (if +org-insert-tilde-language - (insert (format "#+begin_src %s\n#+end_src" - +org-insert-tilde-language)) - (insert "#+begin_example\n#+end_example")) - (forward-line -1) - (if (string= +org-insert-tilde-language "") - (move-end-of-line nil) - ;;(org-edit-special) ; Useful really only with splits. - )) - (setq last-command-event ?~) - (call-interactively #'org-self-insert-command))) - -;;; Better org faces -;; see `org-emphasis-alist' - -(defface org-bold '((t (:weight bold))) - "Bold face in `org-mode' documents.") - -(defface org-italic '((t (:slant italic))) - "Italic face in `org-mode' documents.") - -(defface org-underline '((t (:underline t))) - "Underline face in `org-mode' documents.") - -(defface org-strikethrough '((t (:strike-through t))) - "Strike-through face for `org-mode' documents.") - -;; `org-verbatim' and `org-code' are apparently already things, so we skip them -;; here. - -;;; Copy org trees as HTML - -;; Thanks to Oleh Krehel, via [[https://emacs.stackexchange.com/questions/54292/copy-results-of-org-export-directly-to-clipboard][this StackExchange question]]. -(defun +org-export-clip-to-html - (&optional async subtreep visible-only body-only ext-plist post-process) - "Export region to HTML, and copy it to the clipboard. -Arguments ASYNC, SUBTREEP, VISIBLE-ONLY, BODY-ONLY, EXT-PLIST, -and POST-PROCESS are passed to `org-export-to-file'." - (interactive) ; XXX: hould this be interactive? - (message "Exporting Org to HTML...") - (let ((org-tmp-file "/tmp/org.html")) - (org-export-to-file 'html org-tmp-file - async subtreep visible-only body-only ext-plist post-process) - (start-process "xclip" "*xclip*" - "xclip" "-verbose" - "-i" org-tmp-file - "-t" "text/html" - "-selection" "clipboard")) - (message "Exporting Org to HTML...done.")) - -;; Specialized functions -(defun +org-export-clip-subtree-to-html () - "Export current subtree to HTML." - (interactive) - (+org-export-clip-to-html nil :subtree)) - -;;; Unsmartify quotes and dashes and stuff. -(defun +org-unsmartify () - "Replace \"smart\" punctuation with their \"dumb\" counterparts." - (interactive) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "[“”‘’–—]" nil t) - (let ((replace (pcase (match-string 0) - ((or "“" "”") "\"") - ((or "‘" "’") "'") - ("–" "--") - ("—" "---")))) - (replace-match replace nil nil))))) - -;;; go forward and backward in the tree, ~ cleanly ~ -;; https://stackoverflow.com/a/25201697/10756297 - -(defun +org-show-next-heading-tidily () - "Show next entry, keeping other entries closed." - (interactive) - (if (save-excursion (end-of-line) (outline-invisible-p)) - (progn (org-show-entry) (show-children)) - (outline-next-heading) - (unless (and (bolp) (org-on-heading-p)) - (org-up-heading-safe) - (hide-subtree) - (user-error "Boundary reached")) - (org-overview) - (org-reveal t) - (org-show-entry) - (recenter-top-bottom) - (show-children) - (recenter-top-bottom 1))) - -(defun +org-show-previous-heading-tidily () - "Show previous entry, keeping other entries closed." - (interactive) - (let ((pos (point))) - (outline-previous-heading) - (unless (and (< (point) pos) (bolp) (org-on-heading-p)) - (goto-char pos) - (hide-subtree) - (user-error "Boundary reached")) - (org-overview) - (org-reveal t) - (org-show-entry) - (recenter-top-bottom) - (show-children) - (recenter-top-bottom 1))) - -;;; Make `org-flag-region' (which folds subtrees) recognize -;; [[https://teddit.net/r/orgmode/comments/u3du0v/how_to_make_orgcycle_respect_and_always_show_the/][from u/yantar92]] - -;; (advice-add 'org-flag-region :around #'org-flag-region@unfold-page-breaks) -(defun org-flag-region@unfold-page-breaks (oldfun from to flag &optional spec) - "ADVICE to unfold all the page-break lines inside a folded region." - (funcall oldfun from to flag spec) - (when (and flag (not (eq 'visible spec))) - (org-with-point-at from - (while (re-search-forward "\n\u000c\n" to t) - (org-flag-region (match-beginning 0) (match-end 0) t 'visible))))) - -;;; Emacs 28+: wrap on hyphens -;; https://emacs.stackexchange.com/a/71342/37239 - -(defcustom +org-category-table (let ((table (copy-category-table))) - (modify-category-entry ?- ?| table) - table) - "Character category table for `org-mode'." - :type 'sexp) - -(defun +org-wrap-on-hyphens () - "Soft-wrap `org-mode' buffers on spaces and hyphens." - (set-category-table +org-category-table) - (setq-local word-wrap-by-category t)) - - -;;; Inhibit hooks on `org-agenda' -;; It's really annoying when I call `org-agenda' and five hundred Ispell -;; processes are created because I have `flyspell-mode' in the hook. This mode -;; inhibits those hooks when entering the agenda, but runs them when opening the -;; actual buffer. - -(defun +org-agenda-inhibit-hooks (fn &rest r) - "Advice to inhibit hooks when entering `org-agenda'." - (dlet ((org-mode-hook nil)) ; I'm not sure if `dlet' is strictly needed - (apply fn r))) - -(defvar-local +org-hook-has-run-p nil - "Whether `org-mode-hook' has run in the current buffer.") - -(defun +org-agenda-switch-run-hooks (&rest _) - "Advice to run `org-mode-hook' when entering org-mode. -This should only fire when switching to a buffer from `org-agenda'." - (unless +org-hook-has-run-p - (run-mode-hooks 'org-mode-hook) - (setq +org-hook-has-run-p t))) - -(define-minor-mode +org-agenda-inhibit-hooks-mode - "Inhibit `org-mode-hook' when opening `org-agenda'." - :lighter "" - :global t - (if +org-agenda-inhibit-hooks-mode - (progn ; Enable - (advice-add 'org-agenda :around #'+org-agenda-inhibit-hooks) - (advice-add 'org-agenda-switch-to :after #'+org-agenda-switch-run-hooks)) - (progn ; Disable - (advice-remove 'org-agenda #'+org-agenda-inhibit-hooks) - (advice-remove 'org-agenda-switch-to #'+org-agenda-switch-run-hooks)))) - - -;;; "Fix" `org-align-tags' - -(el-patch-defun org-align-tags (&optional all) - "Align tags in current entry. -When optional argument ALL is non-nil, align all tags in the -visible part of the buffer." - (let ((get-indent-column - (lambda () - (let ((offset (el-patch-swap - (if (bound-and-true-p org-indent-mode) - (* (1- org-indent-indentation-per-level) - (1- (org-current-level))) - 0) - 0))) - (+ org-tags-column - (if (> org-tags-column 0) (- offset) offset)))))) - (if (and (not all) (org-at-heading-p)) - (org--align-tags-here (funcall get-indent-column)) - (save-excursion - (if all - (progn - (goto-char (point-min)) - (while (re-search-forward org-tag-line-re nil t) - (org--align-tags-here (funcall get-indent-column)))) - (org-back-to-heading t) - (org--align-tags-here (funcall get-indent-column))))))) - -;;; Meta-return - -(defun +org-meta-return (&optional arg) - "Insert a new line, or wrap a region in a table. -See `org-meta-return', but `+org-return-dwim' does most of the -stuff I would want out of that function already. - -When called with a prefix ARG, will still unconditionally call -`org-insert-heading'." - (interactive "P") - (org-fold-check-before-invisible-edit 'insert) - (or (run-hook-with-args-until-success 'org-metareturn-hook) ; Allow customizations - (call-interactively (cond (arg #'org-insert-heading) - ((org-at-table-p) #'org-table-wrap-region) - (t #'org-return))))) - - -;;; move org archives to a dedicated file -;; (defun +org-archive-monthwise (archive-file) -;; (if (file-exists-p archive-file) -;; (with-current-buffer (find-file-noselect archive-file) -;; (let ((dir (file-name-directory (file-truename archive-file))) -;; (prog (make-progress-reporter (format "Archiving from %s..." archive-file))) -;; (keep-going t)) -;; (goto-char (point-min)) -;; (while keep-going -;; (when-let* ((time (or (org-entry-get (point) "ARCHIVE_TIME") -;; (org-get-deadline-time (point)))) -;; (parsed-time (and time -;; (org-parse-time-string time))) -;; (refile-target (format "%s%02d-%02d.org" -;; dir -;; (decoded-time-year parsed-time) -;; (decoded-time-month parsed-time))) -;; (title-str (format "#+title: Archive for %02d-%02d (%s)\n\n" -;; (decoded-time-year parsed-time) -;; (decoded-time-month parsed-time) -;; (file-truename archive-file)))) -;; (unless (file-exists-p refile-target) -;; (with-current-buffer (find-file-noselect refile-target) -;; (insert title-str) -;; (save-buffer))) -;; (org-refile nil nil (list "" -;; refile-target -;; nil -;; 0))) -;; (progress-reporter-update prog) -;; (org-next-visible-heading 1) -;; (when (>= (point) (point-max)) -;; (setq keep-going nil))))) -;; (message "Archive file %s does not exist!" archive-file))) - - -;;; +org-toggle-view-emphasis -;; I thought this function was already written somewhere... -(defun +org-toggle-view-emphasis () - "Toggle `org-hide-emphasis-markers' and redraw the buffer." - (interactive) - (setq-local org-hide-emphasis-markers (not org-hide-emphasis-markers)) - (font-lock-update)) - - -;;; el-patch - -(el-patch-defun org-format-outline-path (path &optional width prefix separator) - "Format the outline path PATH for display. -WIDTH is the maximum number of characters that is available. -PREFIX is a prefix to be included in the returned string, -such as the file name. -SEPARATOR is inserted between the different parts of the path, -the default is \"/\"." - (setq width (or width 79)) - (setq path (delq nil path)) - (unless (> width 0) - (user-error "Argument `width' must be positive")) - (setq separator (or separator "/")) - (let* ((org-odd-levels-only nil) - (fpath (concat - prefix (and prefix path separator) - (mapconcat - (lambda (s) (replace-regexp-in-string "[ \t]+\\'" "" s)) - (cl-loop for head in path - for n from 0 - collect (el-patch-swap - (org-add-props - head nil 'face - (nth (% n org-n-level-faces) org-level-faces)) - head)) - separator)))) - (when (> (length fpath) width) - (if (< width 7) - ;; It's unlikely that `width' will be this small, but don't - ;; waste characters by adding ".." if it is. - (setq fpath (substring fpath 0 width)) - (setf (substring fpath (- width 2)) ".."))) - fpath)) - - -(provide '+org) -;;; +org.el ends here diff --git a/lisp/+ox.el b/lisp/+ox.el deleted file mode 100644 index 8748a55..0000000 --- a/lisp/+ox.el +++ /dev/null @@ -1,29 +0,0 @@ -;;; +ox.el --- org-export helpers -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -(require 'ox) - -;;; Run hooks before doing any exporting at all - -(defcustom +org-export-pre-hook nil - "Functions to run /before/ `org-export-as' does anything. -These will run on the buffer about to be exported, NOT a copy." - :type 'hook) - -(defun +org-export-pre-run-hooks (&rest _) - "Run hooks in `+org-export-pre-hook'." - (run-hooks '+org-export-pre-hook)) - -(defun +org-export-pre-hooks-insinuate () - "Advise `org-export-as' to run `+org-export-pre-hook'." - (advice-add 'org-export-as :before #'+org-export-pre-run-hooks)) - -(defun +org-export-pre-hooks-remove () - "Remove pre-hook advice on `org-export-as'." - (advice-remove 'org-export-as #'+org-export-pre-run-hooks)) - -(provide '+ox) -;;; +ox.el ends here diff --git a/lisp/+paredit.el b/lisp/+paredit.el deleted file mode 100644 index 0c65328..0000000 --- a/lisp/+paredit.el +++ /dev/null @@ -1,26 +0,0 @@ -;;; +paredit.el --- bespoke paredit stuffs -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -(require '+emacs) ; `+backward-kill-word-wrapper' - -(defun +paredit--backward-kill-word (&optional n) - "Perform `paredit-backward-kill-word' N times." - (interactive "p") - (dotimes (_ (or n 1)) - (paredit-backward-kill-word))) - -(defun +paredit-backward-kill-word (&optional arg) - "Kill a word backward using `paredit-backward-kill-word'. -Wrapped in `+backward-kill-word-wrapper', which see. - -Prefix ARG means to just call `paredit-backward-kill-word'." - ;; Of course, `paredit-backward-kill-word' doesn't TAKE an argument ... :/// - ;; So I had to write the wrapper above. - (interactive) - (+backward-kill-word-wrapper #'+paredit--backward-kill-word arg)) - -(provide '+paredit) -;;; +paredit.el ends here diff --git a/lisp/+pdf-tools.el b/lisp/+pdf-tools.el deleted file mode 100644 index 9b15b27..0000000 --- a/lisp/+pdf-tools.el +++ /dev/null @@ -1,38 +0,0 @@ -;;; +pdf-tools.el --- Extras for the excellent pdf-tools' -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -;; XXX: The way I'm dispatching browsers here is /very/ down-and-dirty. It -;; needs to be much improved. - -(defun +pdf-view-open-all-pagelinks (&optional browse-url-func) - "Open all the links on this page of a PDF. -BROWSE-URL-FUNC overrides the default `browse-url'." - (interactive) - (let ((links (pdf-info-pagelinks (pdf-view-current-page))) - (browse-url-func (or browse-url-func #'browse-url)) - (seen)) - (dolist (link links) - (when-let* ((uri (alist-get 'uri link)) - (_ (not (member uri seen)))) - (push uri seen) - (funcall browse-url-func uri))))) - -(defun +pdf-view-open-links-in-chrome () - "Open all links on this PDF page in Chrome. -See also `+pdf-view-open-all-pagelinks'." - (interactive) - (+pdf-view-open-all-pagelinks #'browse-url-chrome)) - -(defun +pdf-view-position (&optional spacer) - "Return the page we're on for the modeline." - (when (derived-mode-p 'pdf-view-mode) - (format "%sp.%s/%s" - (or spacer (bound-and-true-p +modeline-default-spacer) " ") - (pdf-view-current-page) - (pdf-info-number-of-pages)))) - -(provide '+pdf-tools) -;;; +pdf-tools.el ends here diff --git a/lisp/+pulse.el b/lisp/+pulse.el deleted file mode 100644 index eefdd83..0000000 --- a/lisp/+pulse.el +++ /dev/null @@ -1,52 +0,0 @@ -;;; +pulse.el -*- lexical-binding: t; -*- - -;;; Code: - -(require 'pulse) - -(defgroup +pulse nil - "Extra customizations for `pulse'." - :group 'pulse - :prefix "+pulse-") - -(defcustom +pulse-location-commands '(scroll-up-command - scroll-down-command - recenter-top-bottom - other-window - switch-to-buffer - redraw-frame) - "Commands to pulse the current line after. -Good for finding location." - :type '(repeat function)) - -(defcustom +pulse-location-function '+pulse-line-current-window - "What function to call after `+pulse-location-commands'." - :type 'function) - -;; XXX: this doesn't work yet. I only want to pulse the line in the -;; active window, so when I have the same buffer viewed in multiple -;; windows I can still see where my cursor is. To see the issue, C-x -;; 2 then C-x o a few times. -(defun +pulse-line-current-window (&rest _) - "Pulse the current line, but only if this window is active." - (pulse-momentary-highlight-one-line - (window-point (selected-window)))) - -(defun +pulse--advice-remove (symbol where function &optional props) - "Remove advice SYMBOL from FUNCTION. -This uses the same args as `advice-add' for easy toggling. -WHERE and PROPS are discarded." - (ignore where props) - (advice-remove symbol function)) - -(define-minor-mode +pulse-location-mode - "After moving locations, pulse where we are." - :global t - :keymap nil - (dolist (command +pulse-location-commands) - (funcall - (if +pulse-location-mode 'advice-add '+pulse--advice-remove) - command :after +pulse-location-function))) - -(provide '+pulse) -;;; +pulse.el ends here diff --git a/lisp/+scratch.el b/lisp/+scratch.el deleted file mode 100644 index 7fc2bde..0000000 --- a/lisp/+scratch.el +++ /dev/null @@ -1,77 +0,0 @@ -;;; +scratch.el -*- lexical-binding: t; -*- - -;;; Code: - -;;(require 'scratch) - -(defun +scratch-immortal () - "Bury, don't kill \"*scratch*\" buffer. -For `kill-buffer-query-functions'." - (if (or (eq (current-buffer) (get-buffer "*scratch*")) - (eq (current-buffer) (get-buffer "*text*"))) - (progn (bury-buffer) - nil) - t)) - -(defun +scratch-buffer-setup () - "Add comment to `scratch' buffer and name it accordingly." - (let* ((mode (format "%s" major-mode)) - (string (concat "Scratch buffer for:" mode "\n\n"))) - (when scratch-buffer - (save-excursion - (insert string) - (goto-char (point-min)) - (comment-region (point-at-bol) (point-at-eol))) - (next-line 2)) - (rename-buffer (concat "*scratch<" mode ">*") t))) - -(defun +scratch-fortune () - (let* ((fmt (if (executable-find "fmt") - (format "| fmt -%d -s" (- fill-column 2)) - "")) - (s (string-trim - (if (executable-find "fortune") - (shell-command-to-string (concat "fortune -s" fmt)) - "ABANDON ALL HOPE YE WHO ENTER HERE")))) - (concat (replace-regexp-in-string "^" ";; " s) - "\n\n"))) - -;; [[https://old.reddit.com/r/emacs/comments/ui1q41/weekly_tips_tricks_c_thread/i7ef4xg/][u/bhrgunatha]] -(defun +scratch-text-scratch () - "Create a \"*text*\" scratch buffer in Text mode." - (with-current-buffer (get-buffer-create "*text*") - (text-mode))) - -(defcustom +scratch-buffers '("*text*" "*scratch*") - "Scratch buffers.") - -(defvar +scratch-last-non-scratch-buffer nil - "Last buffer that wasn't a scratch buffer.") - -(defun +scratch-toggle (buffer) - "Switch to BUFFER, or to the previous (non-scratch) buffer." - (if (or (null +scratch-last-non-scratch-buffer) - (not (member (buffer-name (current-buffer)) +scratch-buffers))) - ;; Switch to a scratch buffer - (progn - (setq +scratch-last-non-scratch-buffer (current-buffer)) - (switch-to-buffer buffer)) - ;; Switch away from scratch buffer ... - (if (equal (get-buffer-create buffer) (current-buffer)) - ;; to the original buffer - (switch-to-buffer +scratch-last-non-scratch-buffer) - ;; to another scratch - (switch-to-buffer buffer)))) - -(defun +scratch-switch-to-scratch () - "Switch to scratch buffer." - (interactive) - (+scratch-toggle "*scratch*")) - -(defun +scratch-switch-to-text () - "Switch to text buffer." - (interactive) - (+scratch-toggle "*text*")) - -(provide '+scratch) -;;; +scratch.el ends here diff --git a/lisp/+setup.el b/lisp/+setup.el deleted file mode 100644 index a08526a..0000000 --- a/lisp/+setup.el +++ /dev/null @@ -1,216 +0,0 @@ -;;; +setup.el -- my `setup' commands -*- lexical-binding: t -*- - -;; Author: Case Duckworth - -;; This file is NOT part of GNU Emacs. - -;;; License: -;; Everyone is permitted to do whatever with this software, without -;; limitation. This software comes without any warranty whatsoever, -;; but with two pieces of advice: -;; - Don't hurt yourself. -;; - Make good choices. - -;;; Commentary: - -;; `setup', by Philip Kaludercic, is a wonderful package that works -;; sort of like `use-package', but to my mind it's cleaner and easier -;; to extend. These are my additions to the local macros provided by -;; the package. - -;;; Code: - -(require 'el-patch) -(require 'setup) -(require 'straight) -(require 'cl-lib) - -(defun +setup-warn (message &rest args) - "Warn the user that something bad happened in `setup'." - (display-warning 'setup (format message args))) - -(defun +setup-wrap-to-demote-errors (body name) - "Wrap BODY in a `with-demoted-errors' block. -This behavior is prevented if `setup-attributes' contains the -symbol `without-error-demotion'. - -This function differs from `setup-wrap-to-demote-errors' in that -it includes the NAME of the setup form in the warning output." - (if (memq 'without-error-demotion setup-attributes) - body - `(with-demoted-errors ,(format "Error in setup form on line %d (%s): %%S" - (line-number-at-pos) - name) - ,body))) - - -;;; New forms - -(setup-define :quit - 'setup-quit - :documentation "Quit the current `setup' form. -Good for commenting.") - -(setup-define :face - (lambda (face spec) - `(custom-set-faces (list ,face ,spec 'now "Customized by `setup'."))) - :documentation "Customize FACE with SPEC using `custom-set-faces'." - :repeatable t) - -(setup-define :load-after - (lambda (&rest features) - (let ((body `(require ',(setup-get 'feature)))) - (dolist (feature (nreverse features)) - (setq body `(with-eval-after-load ',feature ,body))) - body)) - :documentation "Load the current feature after FEATURES.") - -(setup-define :load-from - (lambda (path) - `(let ((path* (expand-file-name ,path))) - (if (file-exists-p path*) - (add-to-list 'load-path path*) - ,(setup-quit)))) - :documentation "Add PATH to load path. -This macro can be used as NAME, and it will replace itself with -the nondirectory part of PATH. -If PATH does not exist, abort the evaluation." - :shorthand (lambda (args) - (intern - (file-name-nondirectory - (directory-file-name (cadr args)))))) - -(setup-define :needs - (lambda (executable) - `(unless (executable-find ,executable) - ,(setup-quit))) - :documentation "If EXECUTABLE is not in the path, stop here." - :repeatable 1) - - -;;; Package integrations - -;;; Straight.el - -(defun setup--straight-handle-arg (arg var) - (cond - ((and (boundp var) (symbol-value var)) t) - ((keywordp arg) (set var t)) - ((functionp arg) (set var nil) (funcall arg)) - ((listp arg) (set var nil) arg))) - -(with-eval-after-load 'straight - (setup-define :straight - (lambda (recipe &rest predicates) - (let* ((skp (make-symbol "straight-keyword-p")) - (straight-use-p - (cl-mapcar - (lambda (f) (setup--straight-handle-arg f skp)) - predicates)) - (form `(unless (and ,@straight-use-p - (condition-case e - (straight-use-package ',recipe) - (error - (+setup-warn ":straight error: %S" - ',recipe) - ,(setup-quit)) - (:success t))) - ,(setup-quit)))) - ;; Keyword arguments --- :quit is special and should short-circuit - (if (memq :quit predicates) - (setq form `,(setup-quit)) - ;; Otherwise, handle the rest of them ... - (when-let ((after (cadr (memq :after predicates)))) - (setq form `(with-eval-after-load ,(if (eq after t) - (setup-get 'feature) - after) - ,form)))) - ;; Finally ... - form)) - :documentation "Install RECIPE with `straight-use-package'. -If PREDICATES are given, only install RECIPE if all of them return non-nil. -The following keyword arguments are also recognized: -- :quit --- immediately stop evaluating. Good for commenting. -- :after FEATURE --- only install RECIPE after FEATURE is loaded. - If FEATURE is t, install RECIPE after the current feature." - :repeatable nil - :indent 1 - :shorthand (lambda (sexp) - (let ((recipe (cadr sexp))) - (or (car-safe recipe) recipe))))) - -;;; Apheleia - -(setup-define :apheleia - (lambda (name formatter &optional mode -pend) - (let* ((mode (or mode (setup-get 'mode))) - (current-formatters (and -pend - (alist-get mode apheleia-formatters)))) - `(with-eval-after-load 'apheleia - (setf (alist-get ',name apheleia-formatters) - ,formatter) - (setf (alist-get ',mode apheleia-mode-alist) - ',(pcase -pend - (:append (append (ensure-list current-formatters) - (list name))) - (:prepend (cons name (ensure-list current-formatters))) - ('nil name) - (_ (error "Improper `:apheleia' -PEND argument"))))))) - :documentation - "Register a formatter to `apheleia''s lists. -NAME is the name given to the formatter in `apheleia-formatters' -and `apheleia-mode-alist'. FORMATTER is the command paired with -NAME in `apheleia-formatters'. MODE is the mode or modes to add -NAME to in `apheleia-mode-alist'. If MODE is not given or nil, -use the setup form's MODE. Optional argument -PEND can be one of -`:append' or `:prepend', and if given will append or prepend the -given NAME to the current formatters for the MODE in -`apheleia-mode-alist', rather than replace them (the default). - -Example: -(setup - (:apheleia isort (\"isort\" \"--stdout\" \"-\") - python-mode)) -; => -(progn - (setf (alist-get 'isort apheleia-formatters) - '(\"isort\" \"--stdout\" \"-\")) - (setf (alist-get 'python-mode apheleia-mode-alist) - 'isort)) - -This form cannot be repeated, and it cannot be used as HEAD.") - - -;;; Redefines of `setup' forms - -(setup-define :bind-into - (lambda (feature-or-map &rest rest) - (cl-loop for f/m in (ensure-list feature-or-map) - collect (if (string-match-p "-map\\'" (symbol-name f/m)) - `(:with-map ,f/m (:bind ,@rest)) - `(:with-feature ,f/m (:bind ,@rest))) - into forms - finally return `(progn ,@forms))) - :documentation "Bind into keys into the map(s) of FEATURE-OR-MAP. -FEATURE-OR-MAP can be a feature or map name or a list of them. -The arguments REST are handled as by `:bind'." - :debug '(sexp &rest form sexp) - :indent 1) - -(setup-define :require - (lambda (&rest features) - (require 'cl-lib) - (if features - `(progn ,@(cl-loop for feature in features collect - `(unless (require ',feature nil t) - ,(setup-quit)))) - `(unless (require ',(setup-get 'feature) nil t) - ,(setup-quit)))) - :documentation "Try to require FEATURE, or stop evaluating body. -This macro can be used as NAME, and it will replace itself with -the first FEATURE." - :repeatable nil - :shorthand #'cadr) - -(provide '+setup) -;;; +setup.el ends here diff --git a/lisp/+shr.el b/lisp/+shr.el deleted file mode 100644 index af4bf5b..0000000 --- a/lisp/+shr.el +++ /dev/null @@ -1,51 +0,0 @@ -;;; +shr.el --- SHR extras -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -;;; [[https://github.com/oantolin/emacs-config/blob/master/my-lisp/shr-heading.el][shr-heading]], by oantolin - -(defun +shr-heading-next (&optional arg) - "Move forward by ARG headings (any h1-h4). -If ARG is negative move backwards, ARG defaults to 1." - (interactive "p") - (unless arg (setq arg 1)) - (catch 'return - (dotimes (_ (abs arg)) - (when (> arg 0) (end-of-line)) - (if-let ((match - (funcall (if (> arg 0) - #'text-property-search-forward - #'text-property-search-backward) - 'face '(shr-h1 shr-h2 shr-h3 shr-h4) - (lambda (tags face) - (cl-loop for x in (if (consp face) face (list face)) - thereis (memq x tags)))))) - (goto-char - (if (> arg 0) (prop-match-beginning match) (prop-match-end match))) - (throw 'return nil)) - (when (< arg 0) (beginning-of-line))) - (beginning-of-line) - (point))) - -(defun +shr-heading-previous (&optional arg) - "Move backward by ARG headings (any h1-h4). -If ARG is negative move forwards instead, ARG defaults to 1." - (interactive "p") - (+shr-heading-next (- (or arg 1)))) - -(defun +shr-heading--line-at-point () - "Return the current line." - (buffer-substring (line-beginning-position) (line-end-position))) - -(defun +shr-heading-setup-imenu () - "Setup imenu for h1-h4 headings in eww buffer. -Add this function to appropriate major mode hooks such as -`eww-mode-hook' or `elfeed-show-mode-hook'." - (setq-local - imenu-prev-index-position-function #'+shr-heading-previous - imenu-extract-index-name-function #'+shr-heading--line-at-point)) - -(provide '+shr) -;;; +shr.el ends here diff --git a/lisp/+slack.el b/lisp/+slack.el deleted file mode 100644 index cdf2747..0000000 --- a/lisp/+slack.el +++ /dev/null @@ -1,27 +0,0 @@ -;;; +slack.el --- Slack customizations and extras -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -(require 'slack) - -(defgroup +slack nil - "Extra slack customizations." - :group 'slack - :prefix "+slack-") - -(defcustom +slack-teams nil - "Teams to register using `slack-register-team'. -This is a list of plists that are passed directly to -`slack-register-team'." - ;;TODO: type - ) - -(defun +slack-register-teams () - "Register teams in `+slack-teams'." - (dolist (team +slack-teams) - (apply #'slack-register-team team))) - -(provide '+slack) -;;; +slack.el ends here diff --git a/lisp/+sly.el b/lisp/+sly.el deleted file mode 100644 index 8d8fd6a..0000000 --- a/lisp/+sly.el +++ /dev/null @@ -1,18 +0,0 @@ -;;; +sly.el --- Sly customizations -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -(require 'sly) - -(defun sly-mrepl-return-at-end () - (interactive) - (if (<= (point-max) (point)) - (sly-mrepl-return) - (if (bound-and-true-p paredit-mode) - (paredit-newline) - (electric-newline-and-maybe-indent)))) - -(provide '+sly) -;;; +sly.el ends here diff --git a/lisp/+straight.el b/lisp/+straight.el deleted file mode 100644 index cba6c96..0000000 --- a/lisp/+straight.el +++ /dev/null @@ -1,42 +0,0 @@ -;;; +straight.el --- Straight.el extras -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -(defun +straight-update-package (package &optional recursive) - "Update PACKAGE using straight. -This pulls, rebuilds, and loads the updated PACKAGE." - (interactive (list (straight--select-package "Update package" - #'straight--installed-p) - current-prefix-arg)) - (+with-message (format "Pulling package `%s'%s" package - (if recursive " and deps" "")) - (funcall (if recursive - #'straight-pull-package-and-deps - #'straight-pull-package) - package - :from-upstream)) - (+with-message (format "Rebuilding package `%s'%s" package - (if recursive " and deps" "")) - (straight-rebuild-package package recursive)) - (+with-message (format "Loading package `%s'%s" package - (if recursive " and deps" "")) - (ignore-errors (load-library (symbol-name package))) - (when recursive - (dolist (dep (straight--get-transitive-dependencies package)) - (ignore-errors (load-library (symbol-name package))))))) - -(defun +straight-update-all (from-upstream) - "Update all installed packages using straight. -This pulls and rebuilds all packages at once. It does not reload -all of them, for reasons that should be obvious. - -With a prefix argument, it also pulls the packages FROM-UPSTREAM." - (interactive "P") - (straight-pull-recipe-repositories) - (straight-pull-all from-upstream) - (straight-rebuild-all)) - -(provide '+straight) -;;; +straight.el ends here diff --git a/lisp/+tab-bar.el b/lisp/+tab-bar.el deleted file mode 100644 index 6c9debd..0000000 --- a/lisp/+tab-bar.el +++ /dev/null @@ -1,394 +0,0 @@ -;;; +tab-bar.el -*- lexical-binding: t; -*- - -;;; Commentary: - -;; Emacs 28 comes with an easy-to-use `tab-bar-format' option, but I still use -;; Emacs 27 on my Windows machine. Thus, the code in this file. - -;;; Code: - -(require 'acdw) -(require 'tab-bar) - -(defface +tab-bar-extra - '((t :inherit (tab-bar font-lock-comment-face))) - "Tab bar face for extra information, like the menu-bar and time." - :group 'basic-faces) - - -;; Common - -(defun +tab-bar-space (&optional n) - "Display a space N characters long, or 1." - `((space menu-item ,(+string-repeat (or n 1) " ") ignore))) - -(defun +tab-bar-misc-info () - "Display `mode-line-misc-info', formatted for the tab-bar." - `((misc-info menu-item ,(string-trim-right - (format-mode-line mode-line-misc-info)) - ignore))) - -(defcustom +tracking-hide-when-org-clocking nil - "Hide the `tracking-mode' information when clocked in." - :type 'boolean) - -(defun format-mode-line-unescaping (construct) - "Return a mode-line construct as a string, but unescape `%'s." - (format-mode-line - (cond ((listp construct) - (cl-loop for item in construct - collect (cond ((stringp item) - (string-replace "%" "%%" item)) - ((and (listp item) (eq :propertize (car item))) - (format-mode-line-unescaping item)) - (t item)))) - ((stringp construct) (string-replace "%" "%%" construct)) - (t construct)))) - -(defun +tab-bar-tracking-mode () - "Display `tracking-mode-line-buffers' in the tab-bar." - ;; TODO: write something to convert a mode-line construct to a tab-bar - ;; construct. - (when (and (bound-and-true-p tracking-mode) - (not (and +tracking-hide-when-org-clocking - (bound-and-true-p org-clock-current-task)))) - (cons (when (> (length tracking-mode-line-buffers) 0) - '(track-mode-line-separator menu-item " " ignore)) - (cl-loop for i from 0 below (length tracking-mode-line-buffers) - as item = (nth i tracking-mode-line-buffers) - collect (append (list (intern (format "tracking-mode-line-%s" i)) - 'menu-item - (string-trim (format-mode-line-unescaping item))) - (if-let ((keymap (plist-get item 'keymap))) - (list (alist-get 'down-mouse-1 (cdadr keymap))) - (list #'ignore)) - (when-let ((help (plist-get item 'help-echo))) - (list :help help))))))) - -(defun +tab-bar-timer () - "Display `+timer-string' in the tab-bar." - (when (> (length (bound-and-true-p +timer-string)) 0) - `((timer-string menu-item - ,(concat " " +timer-string) - (lambda (ev) - (interactive "e") - (cond ((not +timer-timer) nil) - ((equal +timer-string +timer-running-string) - (popup-menu - '("Running timer" - ["Cancel timer" +timer-cancel t]) - ev)) - (t (setq +timer-string "")))))))) - -(defun +tab-bar-date () - "Display `display-time-string' in the tab-bar." - (when display-time-mode - `((date-time-string menu-item - ,(substring-no-properties (concat " " (string-trim display-time-string))) - (lambda (ev) - (interactive "e") - (popup-menu - (append '("Timer") - (let (r) - (dolist (time '(3 5 10)) - (push (vector (format "Timer for %d minutes" time) - `(lambda () (interactive) - (+timer ,time)) - :active t) - r)) - (nreverse r)) - '(["Timer for ..." +timer t])) - ev)) - :help (discord-date-string))))) - -(defun +tab-bar-notmuch-count () - "Display a notmuch count in the tab-bar." - (when (and (executable-find "notmuch") - (featurep 'notmuch)) - (let* ((counts (ignore-errors (notmuch-hello-query-counts notmuch-saved-searches))) - (next (cl-find "inbox+unread" counts :key (lambda (l) (plist-get l :name)) :test 'equal)) - (next-count (plist-get next :count))) - (when (and next-count (> next-count 0)) - `((notmuch-count menu-item - ,(format " |%s|" next-count) - ignore - :help ,(format "%s mails requiring attention." next-count))))))) - -(defun +tab-bar-org-clock () - "Display `org-mode-line-string' in the tab-bar." - (when (and (fboundp 'org-clocking-p) - (org-clocking-p)) - ;; org-mode-line-string - `((org-clocking menu-item - ,org-mode-line-string - (lambda (ev) - (interactive "e") - (let ((menu (make-sparse-keymap - (or org-clock-current-task "Org-Clock")))) - (map-keymap (lambda (key binding) - (when (consp binding) - (define-key-after menu (vector key) - (copy-sequence binding)))) - (org-clock-menu)) - (message "%S" ev) - (popup-menu menu ev))) - :help ,(or (replace-regexp-in-string - (rx "[[" (group (* (not "]"))) - "][" (group (* (not "]"))) - "]]") - "\\2" - org-clock-current-task) - "Org-Clock"))))) - -(defcustom +tab-bar-emms-max-length 24 - "Maximum length of `+tab-bar-emms'." - :type 'number) - -(defun +tab-bar-emms () - "Display EMMS now playing information." - (when (and (bound-and-true-p emms-mode-line-mode) - emms-player-playing-p) - (let ((now-playing (+string-truncate (emms-mode-line-playlist-current) - (- +tab-bar-emms-max-length 2)))) - `(emms-now-playing menu-item - ,(concat "{" now-playing "}" " ") - emms-pause - ( :help ,(emms-mode-line-playlist-current)))))) - -(defun +tab-bar-bongo () - "Display Bongo now playing information." - (when-let ((modep (bound-and-true-p bongo-mode-line-indicator-mode)) - (buf (cl-some (lambda (b) - (with-current-buffer b - (when-let* ((modep (derived-mode-p 'bongo-playlist-mode)) - (bongo-playlist-buffer b) - (playingp (bongo-playing-p))) - b))) - (buffer-list)))) - `((bongo-now-playing menu-item - ,(concat "{" - (let ((bongo-field-separator "")) - (+string-truncate (replace-regexp-in-string - "\\(.*\\)\\(.*\\)\\(.*\\)" - "\\1: \\3" - (bongo-formatted-infoset)) - ;; This isn't right - (- (min 50 (/ (frame-width) 3 )) 2))) - "}") - (lambda () (interactive) - (let ((bongo-playlist-buffer - ;; XXX: I'm sure this is terribly inefficient - (cl-some (lambda (b) - (with-current-buffer b - (when-let* ((modep (derived-mode-p - 'bongo-playlist-mode)) - (bongo-playlist-buffer b) - (playingp (bongo-playing-p))) - b))) - (buffer-list)))) - (with-bongo-playlist-buffer - (bongo-pause/resume)))) - :help ,(funcall bongo-header-line-function))))) - -(defvar +tab-bar-show-original nil - "Original value of `tab-bar-show'.") - -(defun +tab-bar-basename () - "Generate the tab name from the basename of the buffer of the - selected window." - (let* ((tab-file-name (buffer-file-name (window-buffer - (minibuffer-selected-window))))) - (concat " " - (if tab-file-name - (file-name-nondirectory tab-file-name) - (+tab-bar-tab-name-truncated-left))))) - -;;; FIXME this doesn't work... -;; (defvar +tab-bar-tab-min-width 8 - ;; "Minimum width of a tab on the tab bar.") - -;; (defvar +tab-bar-tab-max-width 24 - ;; "Maximum width of a tab on the tab bar.") - -;; (defun +tab-bar-fluid-calculate-width () - ;; "Calculate the width of each tab in the tab-bar." - ;; (let* ((tab-bar-list (cdr (tab-bar-make-keymap-1))) - ;; (tab-bar-avail-width (frame-width)) - ;; (tab-bar-tab-count (length (tab-bar-tabs))) - ;; (tab-bar-close-button-char-width 1) - ;; (tab-bar-add-tab-button-char-width 1) - ;; (tab-bar-total-width - ;; (length (mapconcat - ;; (lambda (el) - ;; (when-let ((str (car-safe (cdr-safe (cdr-safe el))))) - ;; (substring-no-properties (eval str)))) - ;; tab-bar-list))) - ;; (tab-bar-total-tab-width - ;; (+ (* tab-bar-tab-count tab-bar-close-button-char-width) - ;; tab-bar-add-tab-button-char-width - ;; (length (mapconcat - ;; (lambda (el) - ;; (substring-no-properties (alist-get 'name el))) - ;; (tab-bar-tabs))))) - ;; (tab-bar-total-nontab-width (- tab-bar-total-width - ;; tab-bar-total-tab-width))) - ;; (min +tab-bar-tab-max-width - ;; (max +tab-bar-tab-min-width - ;; (/ (- tab-bar-avail-width - ;; tab-bar-total-tab-width - ;; tab-bar-total-nontab-width) - ;; tab-bar-tab-count))))) - -;; (defun +tab-bar-fluid-width () - ;; "Generate the tab name to fluidly fit in the given space." - ;; (let* ((tab-file-name (buffer-file-name (window-buffer - ;; (minibuffer-selected-window))))) - ;; (format (format " %%s%%%ds" (+tab-bar-fluid-calculate-width)) - ;; (if tab-file-name - ;; (file-name-nondirectory tab-file-name) - ;; (+tab-bar-tab-name-truncated-left)) - ;; " "))) - -(defun +tab-bar-tab-name-truncated-left () - "Generate the tab name from the buffer of the selected window. -This is just like `tab-bar-tab-name-truncated', but truncates the -name to the left." - (let* ((tab-name (buffer-name (window-buffer (minibuffer-selected-window)))) - (ellipsis (cond - (tab-bar-tab-name-ellipsis) - ((char-displayable-p ?…) "…") - ("..."))) - (l-ell (length ellipsis)) - (l-name (length tab-name))) - (if (< (length tab-name) tab-bar-tab-name-truncated-max) - tab-name - (propertize (concat - (when (> (+ l-name l-ell) tab-bar-tab-name-truncated-max) - ellipsis) - (truncate-string-to-width tab-name l-name - (max 0 (- l-name tab-bar-tab-name-truncated-max l-ell)))) - 'help-echo tab-name)))) - -(defun +tab-bar-format-align-right () - "Align the rest of tab bar items to the right, pixel-wise." - ;; XXX: ideally, wouldn't require `shr' here - (require 'shr) ; `shr-string-pixel-width' - (let* ((rest (cdr (memq '+tab-bar-format-align-right tab-bar-format))) - (rest (tab-bar-format-list rest)) - (rest (mapconcat (lambda (item) (nth 2 item)) rest "")) - (hpos (shr-string-pixel-width rest)) - (str (propertize " " 'display `(space :align-to (- right (,hpos)))))) - `((align-right menu-item ,str ignore)))) - - -;;; Menu bar -;; stole from https://github.com/emacs-mirror/emacs/blob/master/lisp/tab-bar.el - -(defun +tab-bar-menu-bar (event) - "Pop up the same menu as displayed by the menu bar. -Used by `tab-bar-format-menu-bar'." - (interactive "e") - (let ((menu (make-sparse-keymap (propertize "Menu Bar" 'hide t)))) - (run-hooks 'activate-menubar-hook 'menu-bar-update-hook) - (map-keymap (lambda (key binding) - (when (consp binding) - (define-key-after menu (vector key) - (copy-sequence binding)))) - (menu-bar-keymap)) - (popup-menu menu event))) - -(defcustom +tab-bar-menu-bar-icon " Emacs " - "The string to use for the tab-bar menu icon." - :type 'string) - -(defun +tab-bar-format-menu-bar () - "Produce the Menu button for the tab bar that shows the menu bar." - `((menu-bar menu-item (propertize +tab-bar-menu-bar-icon 'face '+tab-bar-extra) - +tab-bar-menu-bar :help "Menu Bar"))) - - -;;; Tab bar format tabs - -(require 'el-patch) -(el-patch-feature tab-bar) -(with-eval-after-load 'tab-bar - (el-patch-defun tab-bar--format-tab (tab i) - "Format TAB using its index I and return the result as a keymap." - (append - (el-patch-remove - `((,(intern (format "sep-%i" i)) menu-item ,(tab-bar-separator) ignore))) - (cond - ((eq (car tab) 'current-tab) - `((current-tab - menu-item - ,(funcall tab-bar-tab-name-format-function tab i) - ignore - :help "Current tab"))) - (t - `((,(intern (format "tab-%i" i)) - menu-item - ,(funcall tab-bar-tab-name-format-function tab i) - ,(alist-get 'binding tab) - :help "Click to visit tab")))) - (when (alist-get 'close-binding tab) - `((,(if (eq (car tab) 'current-tab) 'C-current-tab (intern (format "C-tab-%i" i))) - menu-item "" - ,(alist-get 'close-binding tab))))))) - - -;; Emacs 27 - -(defun +tab-bar-misc-info-27 (output &rest _) - "Display `mode-line-misc-info' in the `tab-bar' on Emacs 27. -This is :filter-return advice for `tab-bar-make-keymap-1'." - (let* ((reserve (length (format-mode-line mode-line-misc-info))) - (str (propertize " " - 'display `(space :align-to (- right (- 0 right-margin) - ,reserve))))) - (prog1 (append output - `((align-right menu-item ,str nil)) - (+tab-bar-misc-info))))) - - -;; Emacs 28 - -(defvar +tab-bar-format-original nil - "Original value of `tab-bar-format'.") - -(defun +tab-bar-misc-info-28 () - "Display `mode-line-misc-info', right-aligned, on Emacs 28." - (append (unless (memq 'tab-bar-format-align-right tab-bar-format) - '(tab-bar-format-align-right)) - '(+tab-bar-misc-info))) - - - -(define-minor-mode +tab-bar-misc-info-mode - "Show the `mode-line-misc-info' in the `tab-bar'." - :lighter "" - :global t - (if +tab-bar-misc-info-mode - (progn ; Enable - (setq +tab-bar-show-original tab-bar-show) - (cond - ((boundp 'tab-bar-format) ; Emacs 28 - (setq +tab-bar-format-original tab-bar-format) - (unless (memq '+tab-bar-misc-info tab-bar-format) - (setq tab-bar-format - (append tab-bar-format (+tab-bar-misc-info-28))))) - ((fboundp 'tab-bar-make-keymap-1) ; Emacs 27 - (advice-add 'tab-bar-make-keymap-1 :filter-return - '+tab-bar-misc-info-27))) - (setq tab-bar-show t)) - (progn ; Disable - (setq tab-bar-show +tab-bar-show-original) - (cond - ((boundp 'tab-bar-format) ; Emacs 28 - (setq tab-bar-format +tab-bar-format-original)) - ((fboundp 'tab-bar-make-keymap-1) ; Emacs 27 - (advice-remove 'tab-bar-make-keymap-1 '+tab-bar-misc-info-27)))))) - - - -(provide '+tab-bar) -;;; +tab-bar.el ends here diff --git a/lisp/+titlecase.el b/lisp/+titlecase.el deleted file mode 100644 index 655ebe1..0000000 --- a/lisp/+titlecase.el +++ /dev/null @@ -1,30 +0,0 @@ -;;; +titlecase.el --- Titlecase extras -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -(defun +titlecase-sentence-style-dwim (&optional arg) - "Titlecase a sentence. -With prefix ARG, toggle the value of -`titlecase-downcase-sentences' before sentence-casing." - (interactive "P") - (let ((titlecase-downcase-sentences (if arg (not titlecase-downcase-sentences) - titlecase-downcase-sentences))) - (titlecase-dwim 'sentence))) - -(defun +titlecase-org-headings () - (interactive) - (save-excursion - (goto-char (point-min)) - ;; See also `org-map-tree'. I'm not using that function because I want to - ;; skip the first headline. A better solution would be to patch - ;; `titlecase-line' to ignore org-mode metadata (TODO cookies, tags, etc). - (let ((level (funcall outline-level))) - (while (and (progn (outline-next-heading) - (> (funcall outline-level) level)) - (not (eobp))) - (titlecase-line))))) - -(provide '+titlecase) -;;; +titlecase.el ends here diff --git a/lisp/+util.el b/lisp/+util.el deleted file mode 100644 index a87eae9..0000000 --- a/lisp/+util.el +++ /dev/null @@ -1,94 +0,0 @@ -;;; +util.el --- utility whatevers -*- lexical-binding: t -*- - -;;; Commentary: - -;; This file is going to be my version of like, subr.el -- lots of -;; random shit that all goes in here. - -;;; Code: - -(require 'cl-lib) - -(defgroup +util nil - "Utility whatevers." - :group 'convenience) - -;;; STRINGS - -(defcustom +string-default-alignment 'left - "Default alignment." - :type '(choice (const :tag "Left" 'left) - (const :tag "Right" 'right))) - -;; stolen from s.el -(defun +string-repeat (n s) - "Make a string of S repeated N times." - (declare (pure t) - (side-effect-free t)) - (let (ss) - (while (> n 0) - (setq ss (cons s ss) - n (1- n))) - (apply 'concat ss))) - -(defun +string-truncate (s length &optional ellipsis alignment) - "Return S, shortened to LENGTH including ELLIPSIS and aligned to ALIGNMENT. - -ELLIPSIS defaults to `truncate-string-ellipsis', or \"...\". - -ALIGNMENT defaults to `+string-default-alignment'." - (declare (pure t) - (side-effect-free t)) - (let ((ellipsis (or ellipsis truncate-string-ellipsis "...")) - (alignment (or alignment +string-default-alignment))) - (if (> (length s) length) - (format "%s%s" - (substring s 0 (- length (length ellipsis))) - ellipsis) - s))) - -(cl-defun +string-align (s len - &key - (before "") (after "") (fill " ") - (ellipsis (or truncate-string-ellipsis "...")) - (alignment +string-default-alignment)) - "Print S to fit in LEN characters. -Optional arguments BEFORE and AFTER specify strings to go on -either side of S. - -FILL is the string to fill extra space with (default \" \"). - -ELLIPSIS is the string to show when S is too long to fit (default -`truncate-string-ellipsis' or \"...\"). If nil, don't truncate -the string. - -ALIGNMENT can be one of these: -- nil: align to `+string-default-alignment' -- `left': align left -- `right': align right" - (let* ((s-length (length s)) - (before-length (length before)) - (after-length (length after)) - (max-length (- len (+ before-length after-length))) - (left-over (max 0 (- max-length s-length))) - (filler (+string-repeat left-over fill))) - (format "%s%s%s%s%s" - before - (if (eq alignment 'left) "" filler) - (if ellipsis (+string-truncate s max-length ellipsis alignment) s) - (if (eq alignment 'right) "" filler) - after))) - -;;; COMMANDS - -(defun +dos2unix (buffer) - "Replace \r\n with \n in BUFFER." - (interactive "*b") - (save-excursion - (with-current-buffer buffer - (goto-char (point-min)) - (while (search-forward (string ?\C-m ?\C-j) nil t) - (replace-match (string ?\C-j) nil t))))) - -(provide '+util) -;;; +util.el ends here diff --git a/lisp/+vertico.el b/lisp/+vertico.el deleted file mode 100644 index d4fb3a3..0000000 --- a/lisp/+vertico.el +++ /dev/null @@ -1,24 +0,0 @@ -;;; +vertico.el -*- lexical-binding: t; -*- - -;;; Code: - -;; https://old.reddit.com/r/emacs/comments/rbmfwk/weekly_tips_tricks_c_thread/hof7rz7/ -;; Add this advice to `vertico-next'. -;; Takes care of `vertico-previous' as well, since it calls `vertico-next'. -(defun +vertico-ding-wrap (origin &rest args) - "ADVICE to wrap `vertico-next': ding when wrapping." - (let ((beg-index vertico--index)) - (apply origin args) - (unless (eq 1 (abs (- beg-index vertico--index))) - (ding)))) - -(defun +vertico-widen-or-complete () - (interactive) - (if (or vertico-unobtrusive-mode - vertico-flat-mode) - (progn (vertico-unobtrusive-mode -1) - (vertico-flat-mode -1)) - (call-interactively #'vertico-insert))) - -(provide '+vertico) -;;; +vertico.el ends here diff --git a/lisp/+vterm.el b/lisp/+vterm.el deleted file mode 100644 index 06c0028..0000000 --- a/lisp/+vterm.el +++ /dev/null @@ -1,19 +0,0 @@ -;;; +vterm.el --- Vterm extras -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -(require 'vterm) - -(defun +vterm-counsel-yank-pop-action (orig-fun &rest args) - (if (equal major-mode 'vterm-mode) - (let ((inhibit-read-only t) - (yank-undo-function (lambda (_start _end) (vterm-undo)))) - (cl-letf (((symbol-function 'insert-for-yank) - (lambda (str) (vterm-send-string str t)))) - (apply orig-fun args))) - (apply orig-fun args))) - -(provide '+vterm) -;;; +vterm.el ends here diff --git a/lisp/+window.el b/lisp/+window.el deleted file mode 100644 index 52b3712..0000000 --- a/lisp/+window.el +++ /dev/null @@ -1,130 +0,0 @@ -;;; +window.el --- Fixes for Emacs's window.el -*- lexical-binding: t; -*- - -;;; Commentary: - -;; Do I want to propose this change in the Emacs ML? - -;;; Code: - -(require 'window) - -;;; Split windows based on `window-total-width', not `window-width' -;; I have to just redefine these functions because the check is really deep in -;; there. - -(defun window-splittable-p (window &optional horizontal) - "Return non-nil if `split-window-sensibly' may split WINDOW. -Optional argument HORIZONTAL nil or omitted means check whether -`split-window-sensibly' may split WINDOW vertically. HORIZONTAL -non-nil means check whether WINDOW may be split horizontally. - -WINDOW may be split vertically when the following conditions -hold: -- `window-size-fixed' is either nil or equals `width' for the - buffer of WINDOW. -- `split-height-threshold' is an integer and WINDOW is at least as - high as `split-height-threshold'. -- When WINDOW is split evenly, the emanating windows are at least - `window-min-height' lines tall and can accommodate at least one - line plus - if WINDOW has one - a mode line. - -WINDOW may be split horizontally when the following conditions -hold: -- `window-size-fixed' is either nil or equals `height' for the - buffer of WINDOW. -- `split-width-threshold' is an integer and WINDOW is at least as - wide as `split-width-threshold'. -- When WINDOW is split evenly, the emanating windows are at least - `window-min-width' or two (whichever is larger) columns wide." - (when (and (window-live-p window) - (not (window-parameter window 'window-side))) - (with-current-buffer (window-buffer window) - (if horizontal - ;; A window can be split horizontally when its width is not - ;; fixed, it is at least `split-width-threshold' columns wide - ;; and at least twice as wide as `window-min-width' and 2 (the - ;; latter value is hardcoded). - (and (memq window-size-fixed '(nil height)) - ;; Testing `window-full-width-p' here hardly makes any - ;; sense nowadays. This can be done more intuitively by - ;; setting up `split-width-threshold' appropriately. - (numberp split-width-threshold) - (>= (window-total-width window) - (max split-width-threshold - (* 2 (max window-min-width 2))))) - ;; A window can be split vertically when its height is not - ;; fixed, it is at least `split-height-threshold' lines high, - ;; and it is at least twice as high as `window-min-height' and 2 - ;; if it has a mode line or 1. - (and (memq window-size-fixed '(nil width)) - (numberp split-height-threshold) - (>= (window-height window) - (max split-height-threshold - (* 2 (max window-min-height - (if mode-line-format 2 1)))))))))) - -(defun split-window-sensibly (&optional window) - "Split WINDOW in a way suitable for `display-buffer'. -WINDOW defaults to the currently selected window. -If `split-height-threshold' specifies an integer, WINDOW is at -least `split-height-threshold' lines tall and can be split -vertically, split WINDOW into two windows one above the other and -return the lower window. Otherwise, if `split-width-threshold' -specifies an integer, WINDOW is at least `split-width-threshold' -columns wide and can be split horizontally, split WINDOW into two -windows side by side and return the window on the right. If this -can't be done either and WINDOW is the only window on its frame, -try to split WINDOW vertically disregarding any value specified -by `split-height-threshold'. If that succeeds, return the lower -window. Return nil otherwise. - -By default `display-buffer' routines call this function to split -the largest or least recently used window. To change the default -customize the option `split-window-preferred-function'. - -You can enforce this function to not split WINDOW horizontally, -by setting (or binding) the variable `split-width-threshold' to -nil. If, in addition, you set `split-height-threshold' to zero, -chances increase that this function does split WINDOW vertically. - -In order to not split WINDOW vertically, set (or bind) the -variable `split-height-threshold' to nil. Additionally, you can -set `split-width-threshold' to zero to make a horizontal split -more likely to occur. - -Have a look at the function `window-splittable-p' if you want to -know how `split-window-sensibly' determines whether WINDOW can be -split." - (let ((window (or window (selected-window)))) - (or (and (window-splittable-p window) - ;; Split window vertically. - (with-selected-window window - (split-window-below))) - (and (window-splittable-p window t) - ;; Split window horizontally. - (with-selected-window window - (split-window-right))) - (and - ;; If WINDOW is the only usable window on its frame (it is - ;; the only one or, not being the only one, all the other - ;; ones are dedicated) and is not the minibuffer window, try - ;; to split it vertically disregarding the value of - ;; `split-height-threshold'. - (let ((frame (window-frame window))) - (or - (eq window (frame-root-window frame)) - (catch 'done - (walk-window-tree (lambda (w) - (unless (or (eq w window) - (window-dedicated-p w)) - (throw 'done nil))) - frame nil 'nomini) - t))) - (not (window-minibuffer-p window)) - (let ((split-height-threshold 0)) - (when (window-splittable-p window) - (with-selected-window window - (split-window-below)))))))) - -(provide '+window) -;;; +window.el ends here diff --git a/lisp/+xkcd.el b/lisp/+xkcd.el deleted file mode 100644 index 6780b90..0000000 --- a/lisp/+xkcd.el +++ /dev/null @@ -1,16 +0,0 @@ -;;; +xkcd.el -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -(require 'xkcd) - -(defun +xkcd-get-from-url (url &rest _) - "Open XKCD from URL." - (if (string-match "xkcd\\.com/\\([0-9]+\\)" url) - (xkcd-get (string-to-number (match-string 1 url))) - (funcall +browse-url-browser-function url))) - -(provide '+xkcd) -;;; +xkcd.el ends here diff --git a/lisp/+ytdious.el b/lisp/+ytdious.el deleted file mode 100644 index 6124149..0000000 --- a/lisp/+ytdious.el +++ /dev/null @@ -1,21 +0,0 @@ -;;; +ytdious.el --- Ytdious customizations -*- lexical-binding: t; -*- - -;;; Commentary: - -;; https://github.com/spiderbit/ytdious - -;;; Code: - -(defun +ytdious-watch () - "Stream video at point in mpv." - (interactive) - (let* ((video (ytdious-get-current-video)) - (id (ytdious-video-id-fun video))) - (start-process "ytdious mpv" nil - "mpv" - (concat "https://www.youtube.com/watch?v=" id)) - "--ytdl-format=bestvideo[height<=?720]+bestaudio/best") - (message "Starting streaming...")) - -(provide '+ytdious) -;;; +ytdious.el ends here diff --git a/lisp/+zzz-to-char.el b/lisp/+zzz-to-char.el deleted file mode 100644 index b3f27f7..0000000 --- a/lisp/+zzz-to-char.el +++ /dev/null @@ -1,16 +0,0 @@ -;;; +zzz-to-char.el -*- lexical-binding: t; -*- - -;;; Commentary: - -;; - -;;; Code: - -(defun +zzz-to-char (prefix) - "Call `zzz-to-char' or `zzz-up-to-char' with PREFIX arg." - (interactive "P") - (call-interactively - (if prefix #'zzz-up-to-char #'zzz-to-char))) - -(provide '+zzz-to-char) -;;; +zzz-to-char.el ends here diff --git a/lisp/acdw.el b/lisp/acdw.el index 99ab733..1c6f826 100644 --- a/lisp/acdw.el +++ b/lisp/acdw.el @@ -1,28 +1,10 @@ -;;; acdw.el --- various meta-whatevers -*- lexical-binding: t -*- - -;;; Commentary: - -;; What's that saying about how the hardest things in computer science -;; are naming and off-by-one errors? Well, the naming one I know very -;; well. I've been trying to figure out a good way to prefix my -;; bespoke functions, other stuff I found online, and various emacs -;; lisp detritus for quite some time (I reckon at over a year, as of -;; 2021-11-02). Finally, I found the answer in the writings of Daniel -;; Mendler: I'll prefix everything with a `+' ! - -;; To that end, pretty much everything in lisp/ will have a filename -;; like "+org.el", except of course this file, and maybe a few -;; /actually original/ libraries I haven't had the wherewithal to -;; package out properly yet. - -;; Is it perfect? No. Is it fine? Yes. Here it is. - -;;; Code: +;;; acdw.el -- bits and bobs -*- lexical-binding: t; -*- +;; by C. Duckworth +(provide 'acdw) -(require 'diary-lib) -(require 'solar) ; for +sunrise-sunset +(require 'cl-lib) -;;; Define a directory and an expanding function +;;; Define both a directory and a function expanding to a file in that directory (defmacro +define-dir (name directory &optional docstring inhibit-mkdir) "Define a variable and function NAME expanding to DIRECTORY. @@ -46,488 +28,91 @@ the filesystem, unless INHIBIT-MKDIR is non-nil." (make-directory (file-name-directory file-name) :parents)) file-name)))) -(defun +suppress-messages (oldfn &rest args) ; from pkal - "Advice wrapper for suppressing `message'. -OLDFN is the wrapped function, that is passed the arguments -ARGS." - (let ((msg (current-message))) - (prog1 - (let ((inhibit-message t)) - (apply oldfn args)) - (when msg - (message "%s" msg))))) +;;; Convenience macros -(defun +ensure-after-init (function) - "Ensure FUNCTION runs after init, or now if already initialized. -If Emacs is already started, run FUNCTION. Otherwise, add it to -`after-init-hook'. FUNCTION is called with no arguments." +(defun eval-after-init (fn) + "Evaluate FN after inititation, or now if Emacs is initialized. +FN is called with no arguments." (if after-init-time - (funcall function) - (add-hook 'after-init-hook function))) - -(defmacro +with-ensure-after-init (&rest body) - "Ensure BODY forms run after init. -Convenience macro wrapper around `+ensure-after-init'." - (declare (indent 0) (debug (def-body))) - `(+ensure-after-init (lambda () ,@body))) - -(defun +remember-prefix-arg (p-arg P-arg) - "Display prefix ARG, in \"p\" and \"P\" `interactive' types. -I keep forgetting how they differ." - (interactive "p\nP") - (message "p: %S P: %S" p-arg P-arg)) - -(defmacro +defvar (var value &rest _) - "Quick way to `setq' a variable from a `defvar' form." - (declare (doc-string 3) (indent 2)) - `(setq ,var ,value)) - -(defmacro +with-message (message &rest body) - "Execute BODY, with MESSAGE. -If body executes without errors, MESSAGE...Done will be displayed." - (declare (indent 1)) - (let ((msg (gensym))) - `(let ((,msg ,message)) - (condition-case e - (progn (message "%s..." ,msg) - ,@body) - (:success (message "%s...done" ,msg)) - (t (signal (car e) (cdr e))))))) - -(defun +mapc-some-buffers (func &optional predicate-or-modes) - "Perform FUNC on all buffers satisfied by PREDICATE-OR-MODES. -By default, act on all buffers. - -Both PREDICATE-OR-MODES and FUNC are called with no arguments, -but within a `with-current-buffer' form on the currently-active -buffer. - -As a special case, if PREDICATE-OR-MODES is a list, it will be -interpreted as a list of major modes. In this case, FUNC will -only be called on buffers derived from one of the modes in -PREDICATE-OR-MODES." - (let ((pred (or predicate-or-modes t))) - (dolist (buf (buffer-list)) - (with-current-buffer buf - (when (cond ((functionp pred) - (funcall pred)) - ((listp pred) - (apply #'derived-mode-p pred)) - (t pred)) - (funcall func)))))) - -;; https://github.com/cstby/emacs.d/blob/main/init.el#L67 -(defun +clean-empty-lines (&optional begin end) - "Remove duplicate empty lines from BEGIN to END. -Called interactively, this function acts on the region, if -active, or else the entire buffer." - (interactive "*r") - (unless (region-active-p) - (setq begin (point-min) - end (save-excursion - (goto-char (point-max)) - (skip-chars-backward "\n[:space:]") - (point)))) - (save-excursion - (save-restriction - (narrow-to-region begin end) - (goto-char (point-min)) - (while (re-search-forward "\n\n\n+" nil :move) - (replace-match "\n\n")) - ;; Insert a newline at the end. - (goto-char (point-max)) - (unless (or (buffer-narrowed-p) - (= (line-beginning-position) (line-end-position))) - (insert "\n"))))) - -(defcustom +open-paragraph-ignore-modes '(special-mode lui-mode comint-mode) - "Modes in which `+open-paragraph' makes no sense." - :type '(repeat function)) - -(defun +open-paragraph (&optional arg) - "Open a paragraph after paragraph at point. -A paragraph is defined as continguous non-empty lines of text -surrounded by empty lines, so opening a paragraph means to make -three blank lines, then place the point on the second one. - -Called with prefix ARG, open a paragraph before point." - ;; TODO: Take an integer as ARG, allowing for skipping paragraphs up and down. - (interactive "*P") - ;; TODO: add `+open-paragraph-ignore-modes' - (unless (apply #'derived-mode-p +open-paragraph-ignore-modes) - ;; Go to next blank line. This /isn't/ `end-of-paragraph-text' because - ;; that's weird with org, and I'm guessing other modes too. - (unless (looking-at "^$") (forward-line (if arg -1 +1))) - (while (and (not (looking-at "^$")) - (= 0 (forward-line (if arg -1 +1))))) - (newline) - (when arg (newline) (forward-line -2)) - (delete-blank-lines) - (newline 2) - (previous-line))) - -(defun +split-window-then (&optional where arg) - "Split the window into a new buffer. -With non-nil ARG (\\[universal-argument] interactively), don't -prompt for a buffer to switch to. This function will split the -window using `split-window-sensibly', or open the new window in -the direction specified by WHERE. WHERE is ignored when called -interactively; if you want specific splitting, use -`+split-window-right-then' or `+split-window-below-then'." - (interactive "i\nP") - ;; TODO: Canceling at the switching phase leaves the point in the other - ;; window. Ideally, the user would see this as one action, meaning a cancel - ;; would return to the original window. - (pcase where - ;; These directions are 'backward' to the OG Emacs split-window commands, - ;; because by default Emacs leaves the cursor in the original window. Most - ;; users probably expect a switch to the new window, at least I do. - ((or 'right :right) (split-window-right) (other-window 1)) - ((or 'left :left) (split-window-right)) - ((or 'below :below) (split-window-below) (other-window 1)) - ((or 'above :above) (split-window-below)) - ((pred null) - (or (split-window-sensibly) - (if (< (window-height) (window-width)) - (split-window-below) - (split-window-right))) - (other-window 1)) - (_ (user-error "Unknown WHERE paramater: %s" where))) - (unless arg - (condition-case nil - (call-interactively - (pcase (read-char "(B)uffer or (F)ile?") - (?b (if (fboundp #'consult-buffer) - #'consult-buffer - #'switch-to-buffer)) - (?f #'find-file) - (_ #'ignore))) - (quit (delete-window))))) - -(defun +split-window-right-then (&optional arg) - "Split window right, then prompt for a new buffer. -With optional ARG (\\[universal-argument]), just split." - (interactive "P") - (+split-window-then :right arg)) - -(defun +split-window-below-then (&optional arg) - "Split window below, then prompt for a new buffer. -With optional ARG (\\[universal-argument]), just split." - (interactive "P") - (+split-window-then :below arg)) - -(defun +bytes (number unit) - "Convert NUMBER UNITs to bytes. -UNIT can be one of :kb, :mb, :gb, :tb, :pb, :eb, :zb, :yb; :kib, :mib, :gib, -:tib, :pib, :eib, :zib, :yib." - (* number (pcase unit - ;; Base 10 units - (:kb 1000) - (:mb (* 1000 1000)) - (:gb (* 1000 1000 1000)) - (:tb (* 1000 1000 1000 1000)) - (:pb (* 1000 1000 1000 1000 1000)) - (:eb (* 1000 1000 1000 1000 1000 1000)) - (:zb (* 1000 1000 1000 1000 1000 1000 1000)) - (:yb (* 1000 1000 1000 1000 1000 1000 1000 1000)) - ;; Base 2 units - (:kib 1024) - (:mib (* 1024 1024)) - (:gib (* 1024 1024 1024)) - (:tib (* 1024 1024 1024 1024)) - (:pib (* 1024 1024 1024 1024 1024)) - (:eib (* 1024 1024 1024 1024 1024 1024)) - (:zib (* 1024 1024 1024 1024 1024 1024 1024)) - (:yib (* 1024 1024 1024 1024 1024 1024 1024 1024))))) - -;;; Font lock TODO keywords - -(defcustom font-lock-todo-keywords '("TODO" "XXX" "FIXME" "BUG") - "Keywords to highlight with `font-lock-todo-face'.") - -(defface font-lock-todo-face '((t :inherit font-lock-comment-face - :background "yellow")) - ;; TODO: XXX: FIXME: BUG: testing :) - "Face for TODO keywords.") - -(defun font-lock-todo-insinuate () - (let ((keyword-regexp - (rx bow (group (eval (let ((lst '(or))) - (dolist (kw font-lock-todo-keywords) - (push kw lst)) - (nreverse lst)))) - ":"))) - (font-lock-add-keywords - nil - `((,keyword-regexp 1 'font-lock-todo-face prepend))))) - -;; I don't use this much but I always forget the exact implementation, so this -;; is more to remember than anything else. -(defmacro setc (&rest vars-and-vals) - "Set VARS-AND-VALS by customizing them or using set-default. -Use like `setq'." - `(progn ,@(cl-loop for (var val) on vars-and-vals by #'cddr - if (null val) return (user-error "Not enough arguments") - collecting `(funcall (or (get ',var 'custom-get) - #'set-default) - ',var ',val) - into ret - finally return ret))) - -(defun +set-faces (specs) - "Set fonts to SPECS. -Specs is an alist: its cars are faces and its cdrs are the plist -passed to `set-face-attribute'. Note that the FRAME argument is -always nil; this function is mostly intended for use in init." - (dolist (spec specs) - (apply #'set-face-attribute (car spec) nil (cdr spec)))) - -(defcustom chat-functions '(+irc - jabber-connect-all - ;; slack-start - ) - "Functions to start when calling `chat'." - :type '(repeat function) - :group 'applications) - -(defun +string-repeat (n str) - "Repeat STR N times." - (let ((r "")) - (dotimes (_ n) - (setq r (concat r str))) - r)) - -;; (defun chat-disconnect () -;; "Disconnect from all chats." -;; (interactive) -;; (+with-progress "Quitting circe..." -;; (ignore-errors -;; (circe-command-GQUIT "peace love bread") -;; (cancel-timer (irc-connection-get conn :flood-timer)))) -;; (+with-progress "Quitting jabber..." -;; (ignore-errors -;; (jabber-disconnect))) -;; (when (boundp '+slack-teams) -;; (+with-progress "Quitting-slack..." -;; (dolist (team +slack-teams) -;; (ignore-errors -;; (slack-team-disconnect team))) -;; (ignore-errors (slack-ws-close)))) -;; (+with-progress "Killing buffers..." -;; (ignore-errors -;; (+mapc-some-buffers (lambda () "Remove the buffer from tracking and kill it unconditionally." -;; (let ((kill-buffer-query-functions nil)) -;; (tracking-remove-buffer (current-buffer)) -;; (kill-buffer))) -;; (lambda () "Return t if derived from the following modes." -;; (derived-mode-p 'lui-mode -;; 'jabber-chat-mode -;; 'jabber-roster-mode -;; 'jabber-browse-mode -;; 'slack-mode)))))) - -;; I can never remember all the damn chat things I run, so this just does all of em. -;; (defun chat (&optional arg) -;; "Initiate all chat functions. -;; With optional ARG, kill all chat-related buffers first." -;; (interactive "P") -;; (when arg (chat-disconnect)) -;; (dolist-with-progress-reporter (fn chat-functions) -;; "Connecting to chat..." -;; (call-interactively fn))) - -(defun +forward-paragraph (arg) - "Move forward ARG (simple) paragraphs. -A paragraph here is simply defined: it's a block of buffer that's -separated from others by two newlines." - (interactive "p") - (let ((direction (/ arg (abs arg)))) - (forward-line direction) - (while (not (or (bobp) - (eobp) - (= arg 0))) - (if (looking-at "^[ \f\t]*$") - (setq arg (- arg direction)) - (forward-line direction))))) - -(defun +backward-paragraph (arg) - "Move backward ARG (simple) paragraphs. -See `+forward-paragraph' for the behavior." - (interactive "p") - (+forward-paragraph (- arg))) - -(defun +concat (&rest strings) - "Concat STRINGS separated by SEPARATOR. -Each item in STRINGS is either a string or a list or strings, -which is concatenated without any separator. - -SEPARATOR defaults to the newline (\\n)." - (let (ret - ;; I don't know why a `cl-defun' with - ;; (&rest strings &key (separator "\n")) doesn't work - (separator (or (cl-loop for i from 0 upto (length strings) - if (eq (nth i strings) :separator) - return (nth (1+ i) strings)) - "\n"))) - (while strings - (let ((string (pop strings))) - (cond ((eq string :separator) (pop strings)) - ((listp string) (push (apply #'concat string) ret)) - ((stringp string) (push string ret))))) - (mapconcat #'identity (nreverse ret) separator))) - -(defun +file-string (file) - "Fetch the contents of FILE and return its string." - (with-current-buffer (find-file-noselect file) - (buffer-string))) - -(defmacro +with-progress (pr-args &rest body) - "Perform BODY wrapped in a progress reporter. -PR-ARGS is the list of arguments to pass to -`make-progress-reporter'; it can be a single string for the -message, as well. If you want to use a formatted string, wrap -the `format' call in a list." + (funcall fn) + (add-hook 'after-init-hook fn))) + +(defmacro eval-after (features &rest body) + "Evaluate BODY, but only after loading FEATURES. +FEATURES can be an atom or a list; as an atom it works like +`with-eval-after-load'. The special feature `init' will evaluate +BODY after Emacs is finished initializing." + (declare (indent 1) + (debug (form def-body))) + (if (eq features 'init) + `(eval-after-init (lambda () ,@body)) + (unless (listp features) + (setq features (list features))) + (if (null features) + (macroexp-progn body) + (let* ((this (car features)) + (rest (cdr features))) + `(with-eval-after-load ',this + (eval-after ,rest ,@body)))))) + +;;; Convenience functions + +(defun define-keys (maps &rest keydefs) + "Define KEYDEFS in MAPS. +Convenience wrapper around `define-key'." + (unless (zerop (mod (length keydefs) 2)) + (user-error "Wrong number of arguments: %S" (length keydefs))) + (dolist (map (if (or (atom maps) (eq (car maps) 'keymap)) + (list maps) + maps)) + (cl-loop for (key def) on keydefs by #'cddr + do (let ((key (if (stringp key) (kbd key) key))) + (define-key (if (symbolp map) + (symbol-value map) + map) + key def))))) + +(defmacro setq-local-hook (hook &rest args) + "Run `setq-local' on ARGS when running HOOK." (declare (indent 1)) - (let ((reporter (gensym)) - (pr-args (if (listp pr-args) pr-args (list pr-args)))) - `(let ((,reporter (make-progress-reporter ,@pr-args))) - (prog1 (progn ,@body) - (progress-reporter-done ,reporter))))) - -(defmacro +with-eval-after-loads (features &rest body) - "Execute BODY after all FEATURES are loaded." - (declare (indent 1) (debug (form def-body))) - (unless (listp features) - (setq features (list features))) - (if (null features) - (macroexp-progn body) - (let* ((this (car features)) - (rest (cdr features))) - `(with-eval-after-load ',this - (+with-eval-after-loads ,rest ,@body))))) - -(defun +scratch-buffer (&optional nomode) - "Create a new scratch buffer and switch to it. -If the region is active, paste its contents into the scratch -buffer. The scratch buffer inherits the mode of the current -buffer unless NOMODE is non-nil. When called interactively, -NOMODE will be set when called with \\[universal-argument]." - (interactive "P") - (let* ((mode major-mode) - (bufname (generate-new-buffer-name (format "*scratch (%s)*" mode))) - (paste (and (region-active-p) - (prog1 - (buffer-substring (mark t) (point)) - (deactivate-mark))))) - (when (and (not nomode) - (bound-and-true-p ess-dialect)) ; Not sure what `ess-dialect' is - (setq mode (intern-soft (concat ess-dialect "-mode")))) - ;; Set up buffer - (switch-to-buffer (get-buffer-create bufname)) - (when (and (not nomode) mode) - (ignore-errors (funcall mode))) - (insert (format "%s Scratch buffer for %s%s\n\n" - comment-start mode comment-end)) - (when paste (insert paste)) - (get-buffer bufname))) - -(defun +indent-rigidly (arg &optional interactive) - "Indent all lines in the region, or the current line. -This calls `indent-rigidly' and passes ARG to it." - (interactive "P\np") - (unless (region-active-p) - (push-mark) - (push-mark (line-beginning-position) nil t) - (goto-char (line-end-position))) - (call-interactively #'indent-rigidly)) - -(defun +sort-lines (reverse beg end) - "Sort lines in region, ignoring leading whitespace. -REVERSE non-nil means descending order; interactively, REVERSE is -the prefix argument, and BEG and END are the region. The -variable `sort-fold-case' determines whether case affects the -sort order." - (interactive "P\nr") - (save-excursion - (save-restriction - (narrow-to-region beg end) - (goto-char (point-min)) - (let ((inhibit-field-text-motion t)) - (sort-subr reverse - #'forward-line - #'end-of-line - #'beginning-of-line-text))))) - -(defun +crm-indicator (args) - "AROUND advice for `completing-read-multiple'." - ;; [[https://github.com/minad/vertico/blob/8ab2cddf3a1fb8799611b1d35118bf579aaf3154/README.org][from vertico's README]] - (cons (format "[CRM%s] %s" - (replace-regexp-in-string - "\\`\\[.*?]\\*\\|\\[.*?]\\*\\'" "" - crm-separator) - (car args)) - (cdr args))) - - -;;; Timers! -;; inspired by [[https://git.sr.ht/~protesilaos/tmr/tree/main/item/tmr.el][prot's tmr.el package]] - -(defvar +timer-string nil) -(defvar +timer-timer nil) - -(defcustom +timer-running-string "⏰" - "What to display when the timer is running." - :type 'string) -(defcustom +timer-done-string "❗" - "What to display when the timer is done." - :type 'string) - -(defun +timer (time) - "Set a timer for TIME." - (interactive (list (read-string "Set a timer for how long? "))) - (let ((secs (cond ((natnump time) (* time 60)) - ((and (stringp time) - (string-match-p "[0-9]\\'" time)) - (* (string-to-number time) 60)) - (t (let ((secs 0) - (time time)) - (save-match-data - (while (string-match "\\([0-9.]+\\)\\([hms]\\)" time) - (cl-incf secs - (* (string-to-number (match-string 1 time)) - (pcase (match-string 2 time) - ("h" 3600) - ("m" 60) - ("s" 1)))) - (setq time (substring time (match-end 0))))) - secs))))) - (message "Setting timer for \"%s\" (%S seconds)..." time secs) - (setq +timer-string +timer-running-string) - (setq +timer-timer (run-with-timer secs nil - (lambda () - (message "%S-second timer DONE!" secs) - (setq +timer-string +timer-done-string) - (let ((visible-bell t) - (ring-bell-function nil)) - (ding)) - (ding)))))) - -(defun +timer-cancel () - "Cancel the running timer." - (interactive) - (cond ((not +timer-timer) - (message "No timer found!")) - (t - (cancel-timer +timer-timer) - (message "Timer canceled."))) - (setq +timer-string nil)) - - - -(defun +switch-to-last-buffer () - "Switch to the last-used buffer in this window." - (interactive) - (switch-to-buffer nil)) - -(provide 'acdw) -;;; acdw.el ends here + (let ((fn (intern (format "%s-setq-local" hook)))) + (when (and (fboundp fn) + (functionp fn)) + (setq args (append (function-get fn 'setq-local-hook-settings) args))) + (unless (and (< 0 (length args)) + (zerop (mod (length args) 2))) + (user-error "Wrong number of arguments: %S" (length args))) + `(progn + (defun ,fn () + ,(format "Set local variables after `%s'." hook) + (setq-local ,@args)) + (function-put ',fn 'setq-local-hook-settings ',args) + (add-hook ',hook #',fn)))) + +(unless (fboundp 'ensure-list) + ;; Just in case we're using an old version of Emacs. + (defun ensure-list (object) + "Return OBJECT as a list. +If OBJECT is already a list, return OBJECT itself. If it's +not a list, return a one-element list containing OBJECT." + (if (listp object) + object + (list object)))) + +(defun add-to-list* (lists &rest things) + "Add THINGS to LISTS. +LISTS can be one list variable or a list. +Each thing of THINGS can be either a variablel (the thing), or a list of the form +(ELEMENT &optional APPEND COMPARE-FN), which is passed to +`add-to-list'." + (dolist (l (ensure-list lists)) + (dolist (thing things) + (apply #'add-to-list l (ensure-list thing))))) + +(defun add-hook* (hooks &rest functions) + "Add FUNCTIONS to HOOKS. +Each function in FUNCTIONS can be a singleton or a list of the +form (FUNCTION &optional DEPTH LOCAL)." + (dolist (hook (ensure-list hooks)) + (dolist (fn functions) + (apply #'add-hook hook (ensure-list fn))))) diff --git a/lisp/dawn.el b/lisp/dawn.el deleted file mode 100644 index a184a84..0000000 --- a/lisp/dawn.el +++ /dev/null @@ -1,74 +0,0 @@ -;;; dawn.el --- Do things at dawn (and dusk) -*- lexical-binding: t; -*- - -;;; Commentary: - -;; There is also circadian.el, but it doesn't quite work for me. -;; This code comes mostly from https://gnu.xyz/auto_theme.html, but also -;; somewhere else (which I've forgotten) and my own brain :) - -;;; Code: - -(require 'calendar) -(require 'cl-lib) -(require 'solar) - -(defvar dawn--dawn-timer nil - "Timer for dawn-command.") - -(defvar dawn--dusk-timer nil - "Timer for dusk-command.") - -(defvar dawn--reset-timer nil - "Timer to reset dawn at midnight.") - -(defun dawn-encode-time (f) - "Encode fractional time F." - (let ((hhmm (cl-floor f)) - (date (cdddr (decode-time)))) - (encode-time - (append (list 0 - (round (* 60 (cadr hhmm))) - (car hhmm) - ) - date)))) - -(defun dawn-midnight () - "Return the time of the /next/ midnight." - (let ((date (cdddr (decode-time)))) - (encode-time - (append (list 0 0 0 (1+ (car date))) (cdr date))))) - -(defun dawn-sunrise () - "Return the time of today's sunrise." - (dawn-encode-time (caar (solar-sunrise-sunset (calendar-current-date))))) - -(defun dawn-sunset () - "Return the time of today's sunset." - (dawn-encode-time (caadr (solar-sunrise-sunset (calendar-current-date))))) - -(defun dawn-schedule (dawn-command dusk-command) - "Run DAWN-COMMAND at sunrise, and DUSK-COMMAND at dusk. -RESET is an argument for internal use." - (let ((dawn (dawn-sunrise)) - (dusk (dawn-sunset))) - (cond - ((time-less-p nil dawn) - ;; If it isn't dawn yet, it's still dark. Run DUSK-COMMAND and schedule - ;; DAWN-COMMAND and DUSK-COMMAND for later. - (funcall dusk-command) - (run-at-time dawn nil dawn-command) - (run-at-time dusk nil dusk-command)) - ((time-less-p nil dusk) - ;; If it isn't dusk yet, it's still light. Run DAWN-COMMAND and schedule - ;; DUSK-COMMAND. - (funcall dawn-command) - (run-at-time dusk nil dusk-command)) - (t ;; Otherwise, it's past dusk, so run DUSK-COMMAND. - (funcall dusk-command))) - ;; Schedule a reset at midnight, to re-calculate dawn/dusk times. - ;(unless reset) - (run-at-time (dawn-midnight) nil - #'dawn-schedule dawn-command dusk-command))) - -(provide 'dawn) -;;; dawn.el ends here diff --git a/lisp/elephant.el b/lisp/elephant.el deleted file mode 100644 index 3cae17a..0000000 --- a/lisp/elephant.el +++ /dev/null @@ -1,58 +0,0 @@ -;;; elephant.el --- Remember variables and modes -*- lexical-binding: t; -*- - -;;; Code: - -(defmacro elephant-remember (alist) - "Setup a closure remembering symbols to apply with -`remember-reset'. The variables will be renamed using TEMPLATE. -ALIST contains cells of the form (SYMBOL . NEW-VALUE), where -SYMBOL is a variable or mode name, and its value is what to set -after `remember-set'." - (unless lexical-binding - (user-error "`elephant' requires lexical binding.")) - - (let* ((template (format "elephant--%s-%%s" (gensym))) - (reset-fn (intern (format template "reset")))) - (cl-destructuring-bind (let-list fn-set-list fn-reset-list) - (cl-loop - for (sym . val) in (if (symbolp alist) (symbol-value alist) alist) - as rem = (intern (format template sym)) - - collect (list rem sym) - into let-list - - collect (cond ((eq val 'enable) - `(,sym +1)) - ((eq val 'disable) - `(,sym -1)) - (t `(setq-local ,sym ,val))) - into fn-set-list - - collect (cond ((memq val '(enable disable)) - `(progn (,sym (if ,rem +1 -1)) - (fmakunbound ',rem))) - (t `(progn (setq-local ,sym ,rem) - (makunbound ',rem)))) - into fn-reset-list - - finally return (list let-list - fn-set-list - fn-reset-list)) - `(progn - (defvar-local ,reset-fn nil - "Function to recall values from `elephant-remember'.") - (let ,let-list - (setf (symbol-function ',reset-fn) - (lambda () - ,@fn-reset-list - (redraw-display) - (fmakunbound ',reset-fn)))) - ,@fn-set-list - ',reset-fn)))) - -(defun elephant-forget () - "Forget all symbols generated by `elephant-remember'." - ) - -(provide 'elephant) -;;; elephant.el ends here diff --git a/lisp/find-script.el b/lisp/find-script.el deleted file mode 100644 index 9e3633a..0000000 --- a/lisp/find-script.el +++ /dev/null @@ -1,36 +0,0 @@ -;;; find-script.el --- Find a script in $PATH -*- lexical-binding: t; -*- - -;;; Commentary: - -;; This package makes it easier to find a script to edit in $PATH. The initial -;; `rehash-exes' is slow, but it's stored in `*exes*' as a caching mechanism. -;; However, I'm sure it could be improved. - -;; In addition, `*exes*' currently contains /all/ executables in $PATH, which -;; ... maybe only the ones stored in some text format should be shown. - -;;; Code: - -(defvar *exes* nil - "All the exectuables in $PATH. -Run `rehash-exes' to refresh this variable.") - -(defun rehash-exes () - "List all the executables in $PATH. -Also sets `*exes*' parameter." - (setq *exes* - (cl-loop for dir in exec-path - append (file-expand-wildcards (concat dir "*")) - into exes - finally return exes))) - -;;;###autoload -(defun find-script (script) - "Find a file in $PATH." - (interactive - (list (let ((exes (or *exes* (rehash-exes)))) - (completing-read "Script> " exes nil t)))) - (find-file script)) - -(provide 'find-script) -;;; find-script.el ends here diff --git a/lisp/gdrive.el b/lisp/gdrive.el deleted file mode 100644 index 41a3660..0000000 --- a/lisp/gdrive.el +++ /dev/null @@ -1,130 +0,0 @@ -;;; gdrive.el --- Gdrive integration -*- lexical-binding: t; -*- - -;; Copyright (C) 2022 Case Duckworth - -;; Author: Case Duckworth -;; Keywords: convenience, data, docs - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Commentary: - -;; [[https://github.com/prasmussen/gdrive][gdrive]] is a Go program to interface with Google Drive. This library connects -;; that to Emacs. - -;;; Code: - -(require 'cl-lib) - -(defgroup gdrive nil - "Customizations for Emacs's gdrive module." - :group 'applications - :prefix "gdrive-") - -(defcustom gdrive-bin (executable-find "gdrive") - "Where gdrive binary is located." - :type 'string) - -(defcustom gdrive-buffer "*gdrive*" - "Default buffer for gdrive output." - :type 'string) - -;;; Global flags - -;;;; -c, --config -;;;;; Application path, default: /Users//.gdrive -(defcustom gdrive-config-dir nil - "Application path.") - -;;;; --refresh-token -;;;;; Oauth refresh token used to get access token (for advanced users) -(defcustom gdrive-refresh-token nil - "Oauth refresh token used to get access token. -(For advanced users).") - -;;;; --access-token -;;;;; Oauth access token, only recommended for short-lived requests because of -;;;;; short lifetime (for advanced users) -(defcustom gdrive-access-token nil - "Oauth access token. -Only recommended for short-lived requests because of short -lifetime (for advanced users).") - -;;;; --service-account -;;;;; Oauth service account filename, used for server to server communication -;;;;; without user interaction (file is relative to config dir) -(defcustom gdrive-service-account nil - "Oauth service account filename. -Used for server to server communication without user -interaction (file is relative to config dir).") - -(defun gdrive--global-arguments () - "Build global arguments for gdrive." - (append - (when gdrive-config-dir (list "--config" gdrive-config-dir)) - (when gdrive-refresh-token (list "--refresh-token" gdrive-refresh-token)) - (when gdrive-access-token (list "--access-token" gdrive-access-token)) - (when gdrive-service-account (list "--service-account" gdrive-service-account)))) - -;;; List files -;; gdrive [global] list [options] -;;;; -m, --max -;;;; Max files to list, default: 30 -;;;; -q, --query -;;;;; Default query: "trashed = false and 'me' in owners". See https://developers.google.com/drive/search-parameters -;;;; --order -;;;;; Sort order. See https://godoc.org/google.golang.org/api/drive/v3#FilesListCall.OrderBy -;;;; --name-width -;;;;; Width of name column, default: 40, minimum: 9, use 0 for full width -;; NOTE: gdrive-list will pass 0 for this argument. -;;;; --absolute Show absolute path to file (will only show path from first parent) -;;;; --no-header Dont print the header -;; NOTE: gdrive-list will always pass this argument. -;;;; --bytes Size in bytes -(cl-defun gdrive-list (&key max query order absolute no-header bytes) - "Run the \"gdrive list\" command. -MAX is the max files to list; it defaults to 30. QUERY is the -query to pass; the default is \"trashed = false and 'me' in -owners\"." - (gdrive--run (append (gdrive--global-arguments) - (list "list") - (when max (list "--max" max)) - (when query (list "--query" query)) - (when order (list "--order" order)) - (list "--name-width" "0") - (when absolute (list "--absolute")) - (when no-header (list "--no-header")) - (when bytes (list "--bytes"))))) - - -(defmacro gdrive-query) - - -(defun gdrive--build-command-name (command) - "INTERNAL: Build a string name for COMMAND." - (concat "gdrive-" (car command))) - -(defun gdrive--run (command &optional buffer) - "Run 'gdrive COMMAND', collecting results in BUFFER. -COMMAND, if not a list, will be made a list and appended to -`gdrive-bin'. -BUFFER defaults to `gdrive-buffer'." - (let ((command (if (listp command) command (list command))) - (buffer (or buffer gdrive-buffer))) - (make-process :name (gdrive--build-command-name command) - :buffer buffer - :command (cons gdrive-bin command)))) - -(provide 'gdrive) -;;; gdrive.el ends here diff --git a/lisp/hide-cursor-mode.el b/lisp/hide-cursor-mode.el deleted file mode 100644 index 6325d81..0000000 --- a/lisp/hide-cursor-mode.el +++ /dev/null @@ -1,116 +0,0 @@ -;;; hide-cursor-mode.el --- Hide the cursor and scroll-lock -*- lexical-binding: t; -*- - -;;; Commentary: - -;; From Karthik: https://karthinks.com/software/more-less-emacs/ - -;;; Code: - -(defvar-local hide-cursor--original nil) - -(progn - (progn :autoload-end - (defvar-local hide-cursor-mode nil "Non-nil if Hide-Cursor mode is enabled. -Use the command `hide-cursor-mode' to change this variable.")) - (defun hide-cursor-mode - (&optional arg) - "Hide or show the cursor. - -This is a minor mode. If called interactively, toggle the -`Hide-Cursor mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `hide-cursor-mode'. - -The mode's hook is called both when the mode is enabled and when -it is disabled. - -When the cursor is hidden `scroll-lock-mode' is enabled, so that -the buffer works like a pager." - (interactive - (list - (if current-prefix-arg - (prefix-numeric-value current-prefix-arg) - 'toggle))) - (let - ((last-message - (current-message))) - (setq hide-cursor-mode - (cond - ((eq arg 'toggle) - (not hide-cursor-mode)) - ((and - (numberp arg) - (< arg 1)) - nil) - (t t))) - (when - (boundp 'local-minor-modes) - (setq local-minor-modes - (delq 'hide-cursor-mode local-minor-modes)) - (when hide-cursor-mode - (push 'hide-cursor-mode local-minor-modes))) - (if hide-cursor-mode - (progn - (scroll-lock-mode 1) - (setq-local hide-cursor--original cursor-type) - (setq-local cursor-type nil)) - (scroll-lock-mode -1) - (setq-local cursor-type - (or hide-cursor--original t))) - (run-hooks 'hide-cursor-mode-hook - (if hide-cursor-mode 'hide-cursor-mode-on-hook 'hide-cursor-mode-off-hook)) - (if - (called-interactively-p 'any) - (progn nil - (unless - (and - (current-message) - (not - (equal last-message - (current-message)))) - (let - ((local " in current buffer")) - (message "Hide-Cursor mode %sabled%s" - (if hide-cursor-mode "en" "dis") - local)))))) - (force-mode-line-update) - hide-cursor-mode) - :autoload-end - (defvar hide-cursor-mode-hook nil) - (unless - (get 'hide-cursor-mode-hook 'variable-documentation) - (put 'hide-cursor-mode-hook 'variable-documentation "Hook run after entering or leaving `hide-cursor-mode'. -No problems result if this variable is not bound. -`add-hook' automatically binds it. (This is true for all hook variables.)")) - (put 'hide-cursor-mode-hook 'custom-type 'hook) - (put 'hide-cursor-mode-hook 'standard-value - (list nil)) - (defvar hide-cursor-mode-map - (let - ((m - (let - ((map - (make-sparse-keymap))) - (define-key map - [f7] - (function hide-cursor-mode)) - map))) - (cond - ((keymapp m) - m) - ((listp m) - (easy-mmode-define-keymap m)) - (t - (error "Invalid keymap %S" m)))) - "Keymap for `hide-cursor-mode'.") - (with-no-warnings - (add-minor-mode 'hide-cursor-mode '"H" hide-cursor-mode-map nil nil))) - -(provide 'hide-cursor-mode) -;;; hide-cursor-mode.el ends here diff --git a/lisp/long-s-mode.el b/lisp/long-s-mode.el deleted file mode 100644 index 784cb7d..0000000 --- a/lisp/long-s-mode.el +++ /dev/null @@ -1,67 +0,0 @@ -;;; long-s-mode.el --- Proper typography for Emacs -*- lexical-binding: t; -*- - -;;; Commentary: - -;; from Catie on #emacs - -;;; Code: - -(define-minor-mode long-s-mode - "Minor mode for inserting 'ſ' characters") - -(defconst +long-s+ ?ſ) -(defconst +short-s+ ?s) - -(defun long-s-p (char) - (char-equal char +long-s+)) - -(defun short-s-p (char) - (or (char-equal char +short-s+))) - -(defun s-char-p (char) - (or (long-s-p char) - (short-s-p char))) - -(defun alpha-char-p (char) - (memq (get-char-code-property char 'general-category) - '(Ll Lu Lo Lt Lm Mn Mc Me Nl))) - -(defun long-s-insert-short-s () - (interactive) - (if (long-s-p (preceding-char)) - (insert-char +short-s+) - (insert-char +long-s+))) - -(defun long-s-insert-space () - (interactive) - (if (long-s-p (preceding-char)) - (progn (delete-backward-char 1) - (insert-char +short-s+)) - (save-excursion - (while (not (alpha-char-p (preceding-char))) - (backward-char)) - (when (long-s-p (preceding-char)) - (delete-backward-char 1) - (insert-char +short-s+)))) - (insert-char ?\ )) - -(defvar long-s-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map (current-global-map)) - (define-key map (kbd "s") #'long-s-insert-short-s) - (define-key map (kbd "SPC") #'long-s-insert-space) - map)) - -(setq long-s-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "s") #'long-s-insert-short-s) - (define-key map (kbd "SPC") #'long-s-insert-space) - map)) - -(unless (seq-some #'(lambda (x) (eq (car x) 'long-s-mode)) - minor-mode-map-alist) - (push (cons 'long-s-mode long-s-mode-map) - minor-mode-map-alist)) - -(provide 'long-s-mode) -;;; long-s-mode.el ends here diff --git a/lisp/private.el b/lisp/private.el deleted file mode 100644 index 4f6115e..0000000 --- a/lisp/private.el +++ /dev/null @@ -1,23 +0,0 @@ -;;; private.el -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -(require 'acdw) - -(defgroup private nil - "Private things are private. Shhhhh....") - -;; Private directory - -(+define-dir private/ (sync/ "emacs/private") - "Private secretive secrets inside.") -(add-to-list 'load-path private/) - -;; Load random private stuff - -(require '_acdw) - -(provide 'private) -;;; private.el ends here diff --git a/lisp/reading.el b/lisp/reading.el deleted file mode 100644 index a0d22f4..0000000 --- a/lisp/reading.el +++ /dev/null @@ -1,85 +0,0 @@ -;;; reading.el --- minor mode for reading -*- lexical-binding: t; -*- - -;;; Code: - -(defgroup reading nil - "Group for Reading mode customizations." - :prefix "reading-" - :group 'convenience) - -(defcustom reading-vars '((indicate-empty-lines . nil) - (indicate-buffer-boundaries . nil)) - "Alist of variables to set in function `reading-mode'. -The car of each cell is the variable name, and the cdr is the -value to set it to." - :type '(alist :key-type variable - :value-type sexp)) - -(defcustom reading-modes '((display-fill-column-indicator-mode . -1) - (blink-cursor-mode . -1)) - "Alist of modes to set in function `reading-mode'. -The car of each cell is the function name, and the cdr is the -value to call it with." - :type '(alist :key-type function - :value-type sexp)) - -;;; Internal - -(defvar reading--remembered-template "reading--remembered-%s-value" - "The template passed to `format' for remembered modes and variables.") - -(defun reading--remember (things func) - "Apply FUNC to THINGS, remembering their previous value for later." - (declare (indent 1)) - (unless (listp things) - (setq things (list things))) - (dolist (thing things) - (set (make-local-variable - (intern (format reading--remembered-template thing))) - (and (boundp thing) - (symbol-value thing))) - (funcall func thing))) - -(defun reading--recall (things func) - "Recall previously remembered THINGS by applying FUNC to them. -FUNC should be a function with the signature (THING REMEMBERED-SETTING)." - (declare (indent 1)) - (unless (listp things) - (setq things (list things))) - (dolist (thing things) - (with-demoted-errors "reading--recall: %S" - (let ((value (symbol-value - (intern - (format reading--remembered-template thing))))) - (funcall func thing value))))) - -;;; Mode - -;;;###autoload -(defvar reading-mode-map (make-sparse-keymap) - "Keymap for `reading-mode'.") - -;;;###autoload -(define-minor-mode reading-mode - "A mode for reading." - :lighter " Read" - (if reading-mode - ;; turn on - (progn - (reading--remember (mapcar #'car reading-vars) - (lambda (var) - (set (make-local-variable var) - (cdr (assoc var reading-vars))))) - (reading--remember (mapcar #'car reading-modes) - (lambda (mode) - (funcall mode (cdr (assoc mode reading-modes)))))) - ;; turn off - (reading--recall (mapcar #'car reading-vars) - (lambda (var orig-val) - (set (make-local-variable var) orig-val))) - (reading--recall (mapcar #'car reading-modes) - (lambda (mode orig-setting) - (funcall mode (if orig-setting +1 -1)))))) - -(provide 'reading) -;;; reading.el ends here diff --git a/lisp/system.el b/lisp/system.el deleted file mode 100644 index 73cd80b..0000000 --- a/lisp/system.el +++ /dev/null @@ -1,179 +0,0 @@ -;;; system.el --- Load system-dependendant settings -*- lexical-binding: t; -*- - -;;; Commentary: - -;; When using Emacs on multiple computers, some variables and functions need -;; different definitions. This library is built to assist in working with -;; different system configurations for Emacs. - -;;; TODO: - -;; machine.el -;; machine-case to switch on machine -;; - -;;; Code: - -(require 'cl-lib) - -(defgroup system nil - "System-specific configurations." - :group 'emacs - :prefix "system-") - -;;; Settings - -(defcustom system-load-directory (locate-user-emacs-file "systems" - "~/.emacs-systems") - "The directory where system-specific configurations live." - :type 'file) - -;; These `defcustom's are best-guess defaults. - -(defcustom system-default-font (cond - ((memq system-type '(ms-dos windows-nt)) - "Consolas") - (t "monospace")) - "The font used for the `default' face. -Set this in your system files." - :type 'string) - -(defcustom system-default-height 100 - "The height used for the `default' face. -Set this in your system files." - :type 'number) - -(defcustom system-variable-pitch-font (cond - ((memq system-type '(ms-dos windows-nt)) - "Arial") - (t "sans-serif")) - "The font used for the `variable-pitch' face. -Set this in your system files." - :type 'string) - -(defcustom system-variable-pitch-height 1.0 - "The height used for the `variable-pitch' face. -A floating-point number is recommended, since that makes it -relative to the `default' face height. - -Set this in your system files." - :type 'number) - -(defcustom system-files-order '(:type :name :user) - "The order to load `system-files' in. -The elements of this list correspond to the keys in -`system-system'." - :type '(list (const :tag "System type" :type) - (const :tag "System name" :name) - (const :tag "Current user" :user))) - -;;; Variables - -(defvar system-system nil - "Plist of systems that Emacs is in. -The keys are as follows: - -- :name - `system-name' -- :type - `system-type' -- :user - `user-login-name' - -Each value is made safe to be a file name by passing through -`system--safe'. - -Do not edit this by hand. Instead, call `system-get-systems'.") - -(defvar system-files nil - "List of files to load for system-specific configuration. -Do not edit this by hand. Instead, call `system-get-system-files'.") - - -;;; Functions - -(defun system--warn (message &rest args) - "Display a system-file warning message. -This function is like `warn', except it uses a `system' type." - (display-warning 'system (apply #'format-message message args))) - -(defun system--safe (str) - "Make STR safe for a file name." - (let ((bad-char-regexp )) - (downcase (string-trim - (replace-regexp-in-string "[#%&{}\$!'\":@<>*?/ \r\n\t+`|=]+" - "-" str) - "-" "-")))) - -(defun system-get-systems () - "Determine the current system(s). -This system updates `system-system', which see." - ;; Add system-name - (setf (plist-get system-system :name) - (intern (system--safe (system-name)))) - ;; Add system-type - (setf (plist-get system-system :type) - (intern (system--safe (symbol-name system-type)))) - ;; Add current user - (setf (plist-get system-system :user) - ;; Use `user-real-login-name' in case Emacs gets called under su. - (intern (system--safe (user-real-login-name)))) - system-system) - -(defun system-get-files () - "Determine the current systems' load-files. -The system load-files should live in `system-load-directory', and -named using either the raw name given by the values of -`system-system', or that name prepended with the type, e.g., -\"name-bob.el\", for a system named \"bob\". - -The second form of file-name is to work around name collisions, -e.g. if a there's a user named \"bob\" and a system named -\"bob\". - -This function updates `system-files'." - ;; Get systems - (system-get-systems) - ;; Re-set `system-files' - (setq system-files nil) - - (let (ret) - (dolist (key (reverse system-files-order)) - (let* ((val (plist-get system-system key)) - (key-val (intern (system--safe (format "%s-%s" key val))))) - (push (list key-val val) ret))) - - ;; Update `system-files'. - (setq system-files ret))) - -;;;###autoload -(defun system-settings-load (&optional error nomessage) - "Load system settings from `system-files'. -Each list in `system-files' will be considered item-by-item; the -first found file in each will be loaded. - -ERROR determines how to deal with errors: if nil, warn the user -when no system-files can be found or when the system being used -cannot be determined. If t, these warnings are elevated to -errors. Any other value ignores the warnings completely. - -NOMESSAGE is passed directly to `load'." - (system-get-files) - (if system-files - (let (files-loaded) - (dolist (ss system-files) - (catch :done - (dolist (s ss) - (let ((fn (expand-file-name (format "%s" s) - system-load-directory))) - (when (load fn t nomessage) - (push fn files-loaded) - (throw :done nil)))))) - (unless files-loaded - (cond ((eq error t) (error "Error loading system-files.") - (null error) (system--warn "Couldn't load system-files.")))) - files-loaded) - (funcall (cond ((eq error t) #'error) - ((null error) #'system--warn) - (t #'ignore)) - "Couldn't determine the system being used."))) - -(provide 'system) -;;; system.el ends here diff --git a/lisp/user-save.el b/lisp/user-save.el deleted file mode 100644 index 674abac..0000000 --- a/lisp/user-save.el +++ /dev/null @@ -1,137 +0,0 @@ -;;; user-save.el --- Do things when explicitly saving files -*- lexical-binding: t; -*- - -;; Copyright (C) 2021--2022 Case Duckworth -;; URL: ... -;; Version: 0.1.0 -;; Package-Requires: ((emacs "24.3")) -;; Keywords: files - -;;; Commentary: - -;; Because `super-save-mode' automatically saves every time we move away from a -;; buffer, it tends to run a lot of `before-save-hook's that don't need to be -;; run that often. For that reason, I'm writing a mode where C-x C-s saves -;; /and/ runs all the "real" before-save-hooks, so that super-save won't -;; automatically do things like format the buffer all the time. - -;;; Code: - -(require 'cl-lib) - -(defgroup user-save nil - "Group for `user-save-mode' customizations." - :group 'files - :prefix "user-save-") - -(defcustom user-save-hook-into-kill-emacs nil - "Add a hook to perform `user-save' to `kill-emacs-hook'. -This option is only useful is `user-save-mode' is active when -Emacs is killed." - :type 'boolean) - -(defcustom user-save-inhibit-modes '(special-mode) - "List of modes to inhibit `user-save-mode' from activation in." - :type '(repeat symbol)) - -(defcustom user-save-inhibit-predicates '(user-save-non-file-buffer-p) - "List of predicates to inhibit `user-save-mode' from activation. -Each predicate will be called with no arguments, and if it -returns t, will inhibit `user-save-mode' from activating." - :type '(repeat function)) - -(defcustom user-save-before-save-hook nil - "Hook to run before the user, not Emacs, saves the buffer." - :type 'hook) - -(defcustom user-save-after-save-hook nil - "Hook to run after the user, not Emacs, saves the buffer." - :type 'hook) - -(defvar user-save-mode-map (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-x C-s") #'user-save-buffer) - (define-key map (kbd "C-x s") #'user-save-some-buffers) - map) - "Keymap for `user-save-mode'. -This map shadows the default map for `save-buffer'.") - -(defun user-save-run-hooks (which &rest _) - "Run the hooks in one of the user-save-hooks. -If WHICH is `'before', run `user-save-before-save-hook'; -if it's `after', run `user-save-after-save-hook'. -This does /not/ also save the buffer." - (with-demoted-errors "User-save-hook error: %S" - (run-hooks (intern (format "user-save-%s-save-hook" which))))) - -(defun user-save-non-file-buffer-p (&optional buffer-or-name) - "Return whether BUFFER-OR-NAME is a non-file buffer. -BUFFER-OR-NAME, if omitted, defaults to the current buffer." - (with-current-buffer (or buffer-or-name (current-buffer)) - (not (buffer-file-name)))) - -(defun user-save-buffer (&optional arg) - "Save current buffer in visited file if modified. -This function is precisely the same as `save-buffer', but with -one modification: it also runs functions in `user-save-hook'. -This means that if you have some functionality in Emacs to -automatically save buffers periodically, but have hooks you want -to automatically run when the buffer saves that are -computationally expensive or just aren't something you want to -run all the time, put them in `user-save-hook'. - -ARG is passed directly to `save-buffer'." - (interactive '(called-interactively)) - (message "User-Saving the buffer...") - (user-save-run-hooks 'before) - (save-buffer arg) - (user-save-run-hooks 'after) - (message "User-Saving the buffer...Done.")) - -(defun user-save-some-buffers (&optional pred) - "Save some buffers as though the user saved them. -This function does not ask the user about each buffer, but PRED -is used in almost the same way as `save-some-buffers': if it's -nil or t, it will save all file-visiting modified buffers; if -it's a zero-argument function, that will be called to determine -whether the buffer needs to be saved." - ;; This could maybe be much better. - (interactive "P") - (unless pred (setq pred save-some-buffers-default-predicate)) - (dolist (buf (buffer-list)) - (with-current-buffer buf - (when (and (buffer-modified-p) - (buffer-file-name) - (or (null pred) - (if (functionp pred) (funcall pred) pred))) - (user-save-buffer))))) - -;;;###autoload -(define-minor-mode user-save-mode - "Mode to enable an an extra user-save hook." - :lighter " US" - :keymap user-save-mode-map) - -;;;###autoload -(defun user-save-mode-disable () - "Turn off `user-save-mode' in the current buffer." - (user-save-mode -1)) - -;;;###autoload -(defun user-save-mode-in-some-buffers () - "Enable `user-save-mode', but only in some buffers. -The mode will not be enabled in buffers derived from modes in -`user-save-inhibit-modes', those for which -`user-save-inhibit-predicates' return t, or in the minibuffer." - (unless (or (minibufferp) - (cl-some #'derived-mode-p user-save-inhibit-modes) - (run-hook-with-args-until-failure 'user-save-inhibit-predicates)) - (user-save-mode +1))) - -;;;###autoload -(define-globalized-minor-mode user-save-global-mode user-save-mode user-save-mode-in-some-buffers - (if user-save-global-mode - (when user-save-hook-into-kill-emacs - (add-hook 'kill-emacs-hook #'user-save-some-buffers)) - (remove-hook 'kill-emacs-hook #'user-save-some-buffers))) - -(provide 'user-save) -;;; user-save.el ends here diff --git a/lisp/yoke.el b/lisp/yoke.el new file mode 100644 index 0000000..2673e5e --- /dev/null +++ b/lisp/yoke.el @@ -0,0 +1,125 @@ +;;; yoke.el --- yoke packages in to your editing system -*- lexical-binding: t; -*- +;; by C. Duckworth +(provide 'yoke) +(require 'cl-lib) + +(defgroup yoke nil + "Customizations for yoke, a package manager thing." + :group 'applications + :prefix "yoke-") + +(defcustom yoke-dir (locate-user-emacs-file "yoke") + "Where yoke packages live." + :type 'file) + +(defun yoke-repo-local-p (repo) + (string-match-p (rx bos (or "." "~" "/")) repo)) + +(defun yoke-repo-dir (pkg repo) + (if (yoke-repo-local-p repo) + (expand-file-name repo) + (expand-file-name (format "%s" pkg) yoke-dir))) + +(defun yoke-git (repo &optional dir) + "Git REPO from the internet and put it into `yoke-dir'. +If DIR is passed, clone there; otherwise just clone. Return the +directory created." + (let ((dir (or dir (yoke-repo-dir (file-name-nondirectory repo) repo)))) + (unless (or (yoke-repo-local-p repo) (file-exists-p dir)) + (message "Downloading %S..." repo) + (call-process "git" nil (get-buffer-create "*yoke*") nil + "clone" repo dir) + (message "Downloading %S... done" repo)) + dir)) + +(defun yoke-lasso (pkg repo) + "Add PKG to `load-path' so it can be used. +If PKG is not installed, install it from REPO. Packages will be +installed to `yoke-dir'." + (let* ((dir (yoke-repo-dir pkg repo))) + (yoke-git repo dir) + (cond + ((file-exists-p dir) + (add-to-list 'load-path dir) + ;; This bit is stolen from `straight'. + (eval-and-compile (require 'autoload)) + (let ((generated-autoload-file + (expand-file-name (format "%s-autoloads.el" pkg) dir)) + (backup-inhibited t) + (version-control 'never) + (message-log-max nil) + (inhibit-message t)) + (unless (file-exists-p generated-autoload-file) + (let ((find-file-hook nil) + (write-file-functions nil) + (debug-on-error nil) + (left-margin 0)) + (if (fboundp 'make-directory-autoloads) + (make-directory-autoloads dir generated-autoload-file) + (and (fboundp 'update-directory-autoloads) + (update-directory-autoloads dir))))) + (when-let ((buf (find-buffer-visiting generated-autoload-file))) + (kill-buffer buf)) + (load generated-autoload-file :noerror :nomessage))) + (t (user-error "Directory \"%s\" doesn't exist." dir))) + dir)) + +(defun yoke-get (key args) + "Get KEY's value from ARGS, or return nil. +Similar-ish to `plist-get', but works on non-proper plists." + (cond + ((null args) nil) + ((eq key (car args)) (cadr args)) + (t (yoke-get key (cdr args))))) + +(defmacro when1 (test &rest body) + "Like `when', but return the value of the test." + (declare (indent 1)) + (let ((g (gensym))) + `(let ((,g ,test)) + (when ,g + ,@body + ,g)))) + +(defun delete2 (list &rest elems) + "Delete ELEM and the next item from LIST." + (let ((r nil)) + (while (consp list) + (if (member (car list) elems) + (setq list (cdr list)) + (setq r (cons (car list) r))) + (setq list (cdr list))) + (reverse r))) + +(defun yoke-pkg-name (pkg) + (intern (format "yoke:%s" pkg))) + +(cl-defmacro yoke (pkg + &optional repo + &body body + &key + requires ; :requires ((PKG REPO)...) + dest ; :dest DESTINATION + (when t whenp) ; :when PREDICATE + (unless nil unlessp) ; :unless PREDICATE + &allow-other-keys) + "Yoke a PKG into your Emacs session." + (declare (indent defun)) + (let ((name (yoke-pkg-name pkg))) + `(cl-block ,name + (condition-case e + (let ((*yoke-name* ',name) + (*yoke-repo* ,repo) + (*yoke-dest* ,(when repo `(yoke-repo-dir ',pkg ,repo)))) + ,@(list (cond + ((and whenp unlessp) + `(when (or (not ,when) ,unless) + (cl-return-from ,name nil))) + (whenp `(unless ,when (cl-return-from ,name nil))) + (unlessp `(when ,unless (cl-return-from ,name nil))))) + ,@(cl-loop for (pkg repo) in requires + collect `(or (yoke-lasso ',pkg ,repo) + (cl-return-from ,name nil))) + ,@(when repo `((yoke-lasso ',pkg ,repo))) + ,@(delete2 body :requires :when :unless)) + (t (message "%s: %S" ',name e)))))) -- cgit 1.4.1-21-gabe81