From 33c7ddb09e0eae0796686c64ffa022a181145cc1 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Wed, 4 Jan 2023 23:21:15 -0600 Subject: Restart ... again ... again --- lisp/+browse-url.el | 189 ---------------------- lisp/+cape.el | 25 --- lisp/+emms.el | 38 ----- lisp/+flyspell-correct.el | 24 --- lisp/+hungry-delete.el | 53 ------- lisp/+isearch.el | 24 --- lisp/+ispell.el | 97 ------------ lisp/+link-hint.el | 144 ----------------- lisp/+lisp.el | 93 ----------- lisp/+message.el | 26 --- lisp/+notmuch.el | 149 ------------------ lisp/+org-capture.el | 49 ------ lisp/+org.el | 309 ------------------------------------ lisp/+paredit.el | 26 --- lisp/+titlecase.el | 34 ---- lisp/acdw-defaults.el | 295 ---------------------------------- lisp/acdw-funs.el | 262 ------------------------------- lisp/acdw-macs.el | 293 ---------------------------------- lisp/acdw.el | 79 ---------- lisp/graveyard.el | 50 ------ lisp/init-org.el | 144 ----------------- lisp/upload-junk.el | 47 ------ lisp/yoke.el | 392 ---------------------------------------------- 23 files changed, 2842 deletions(-) delete mode 100644 lisp/+browse-url.el delete mode 100644 lisp/+cape.el delete mode 100644 lisp/+emms.el delete mode 100644 lisp/+flyspell-correct.el delete mode 100644 lisp/+hungry-delete.el delete mode 100644 lisp/+isearch.el delete mode 100644 lisp/+ispell.el delete mode 100644 lisp/+link-hint.el delete mode 100644 lisp/+lisp.el delete mode 100644 lisp/+message.el delete mode 100644 lisp/+notmuch.el delete mode 100644 lisp/+org-capture.el delete mode 100644 lisp/+org.el delete mode 100644 lisp/+paredit.el delete mode 100644 lisp/+titlecase.el delete mode 100644 lisp/acdw-defaults.el delete mode 100644 lisp/acdw-funs.el delete mode 100644 lisp/acdw-macs.el delete mode 100644 lisp/acdw.el delete mode 100644 lisp/graveyard.el delete mode 100644 lisp/init-org.el delete mode 100644 lisp/upload-junk.el delete mode 100644 lisp/yoke.el (limited to 'lisp') diff --git a/lisp/+browse-url.el b/lisp/+browse-url.el deleted file mode 100644 index b65b6f9..0000000 --- a/lisp/+browse-url.el +++ /dev/null @@ -1,189 +0,0 @@ -;;; +browse-url.el -*- lexical-binding: t; -*- - -(require 'browse-url) -(require 'cl-lib) -(require 'seq) -(require 'url-util) - -(defgroup +browse-url nil - "My `browse-url' extras." - :group 'browse-url) - -;;; External URL handlers - -(cl-defmacro +browse-url-make-external-viewer-handler - (viewer - &key - args - (prompt "URL: ") - (program (executable-find (format "%s" viewer))) - (name (intern (format "+browse-url-with-%s" viewer))) - doc - (var (intern (format "%s-args" name))) - vardoc - (custom-group '+browse-url) - (fallback '(function browse-url-generic))) - "Create a `browse-url' handler function calling PROGRAM on the URL. -This macro also creates a `customize' setting in CUSTOM-GROUP for -PROGRAM's command-line arguments. ARGS specifies the -default arguments for this user option. - -PROGRAM defaults to the result of calling `executable-find' on VIEWER. - -PROMPT is shown to the user in the function's `interactive' spec, as an argument -to `browse-url-interactive-arg'. - -The resulting function is named NAME, which defaults to -`+browse-url-with-VIEWER'. The custom variable is named VAR, which defaults -to `NAME-args'. If DOC or VARDOC are provided, they'll be the documentation of -the function and variable respectively; otherwise a basic default doc-string is -used. - -If FALLBACK is non-nil (the default is `browse-url-generic'), the -generated function will call FALLBACK if unable to start PROGRAM -for some reason." - (declare (indent 1)) - `(progn - (defcustom ,var ,args - ,(or vardoc (format "Arguments to pass to %s in `%s'." - viewer name)) - :type '(repeat :tag "Command-line argument" string) - :group ',custom-group) - (defun ,name (url &optional new-window) - ,(or doc (format "Open URL in %s." viewer)) - (interactive (browse-url-interactive-arg ,prompt)) - (let* ((url (browse-url-encode-url url)) - (process-environment (browse-url-process-environment))) - (message ,(format "Opening %%s in %s..." viewer) url) - (unless (ignore-errors (apply #'start-process - (format "%s %s" ',viewer url) - nil - ,program - (append ,var (list url)))) - ,@(cond - (fallback `((funcall ,fallback url new-window))) - (:else `((message "Can't find viewer: %s" ,viewer) - nil)))))))) - -;; Some default handlers - -(+browse-url-make-external-viewer-handler mpv - :args '("--cache-pause-wait=15" - "--cache-pause-initial=yes") - :prompt "Video URL: ") - -(+browse-url-make-external-viewer-handler mpv-image - :program (executable-find "mpv") - :args '("--image-display-duration=inf") - :prompt "Image URL: ") - -;;; Downloading - -(defcustom +browse-url-download-open t - "Whether to open downloaded files after downloading." - :type 'boolean) - -(defun +browse-url-download (url &rest _) - "Download URL to `eww-download-directory'." - (interactive "sDownload URL: ") - (let ((dir eww-download-directory)) - (when (functionp dir) (setq dir (funcall dir))) - (make-directory dir :parents) - (url-retrieve url - (lambda (s u d) - (let ((file (+browse-url-download-callback s u d))) - (when +browse-url-download-open - (browse-url-xdg-open file)))) - (list url dir)))) - -(defun +browse-url-download-callback (status url dir) - ;; A slight change to `eww-download-callback' that returns the downloaded - ;; filename. - (unless (plist-get status :error) - (let* ((obj (url-generic-parse-url url)) - (path (directory-file-name (car (url-path-and-query obj)))) - (file (eww-make-unique-file-name - (eww-decode-url-file-name (file-name-nondirectory path)) - dir))) - (goto-char (point-min)) - (re-search-forward "\r?\n\r?\n") - (let ((coding-system-for-write 'no-conversion)) - (write-region (point) (point-max) file)) - (message "Saved %s" file) - file))) - -;;; URL matcher generators - -(defun +browse-url-matches (&rest regexps) - "Return a lambda that will determine if a url matches REGEXPS. -Each regexp will be tested in turn. The first one that matches -is returned by the lambda. - -This is a good function to use in key positions in `browse-url-handlers'." - `(lambda (url &optional new-window) - (cl-loop for regexp in ',regexps - if (string-match-p regexp url) - return regexp))) - -;;; External domains -;; Some domains just don't open well in `eww'. The following function and user -;; option define an easy way to automatically open those. - -(defcustom +browse-url-external-domains nil - "Domains to open in `browse-url-secondary-browser-function'. -This is just a list of strings. They'll be regexp-escaped and -passed to `+browse-url-external-url-p', which is a good function -to put in `browse-url-handlers'. - -If an item in this list is a list itself, it should contain one string, a valid -regexp that will not be regexp-quoted when matching against a url." - :type '(repeat (choice - (list :tag "Regexp" regexp) - (string :tag "Literal string")))) - -(defun +browse-url-external-url-p (url) - "Return t if URL is a member of `+browse-url-external-domains'. -This function only tests URL's domain." - (let ((host (url-host (url-generic-parse-url url)))) - (cl-loop for domain in +browse-url-external-domains - if (string-match-p (if (stringp domain) - (regexp-quote domain) - (car domain)) - host) - return t))) - -;;; Switch to an external browser from an Emacs browser - -(defmacro +browse-url-switch-external-browser (mode url-fetcher-form) - "Create a function for MODE to open an external browser. -URL-FETCHER-FORM will be used to get the URL of the current visited page." - (declare (indent 1)) - `(defun ,(intern (format "+browse-url-external-from-%s" mode)) - (&optional url) - "Browse URL with `browse-url-secondary-browser-function'. -This will close the current buffer." - (interactive nil ,mode) - (condition-case e - (funcall browse-url-secondary-browser-function - (or url ,url-fetcher-form)) - (:success (when (null url) (quit-window))) ; Interactive use - (t (signal (car e) (cdr e)))))) - -;;; Mark `browse-url-browser-function' as safe - -(defcustom +browse-url-other-safe-browser-functions nil - "Other safe browser functions." - :type '(repeat function)) - -(defun +browse-url-browser-function-safe-p (f) - "Return t if F is a safe browser function." - (memq f (append +browse-url-other-safe-browser-functions - (mapcar (lambda (i) - (plist-get (cdr i) :value)) - (seq-filter (lambda (i) - (eq (car i) 'function-item)) - (cdr (get 'browse-url-browser-function - 'custom-type))))))) - -(provide '+browse-url) -;;; +browse-url.el ends here diff --git a/lisp/+cape.el b/lisp/+cape.el deleted file mode 100644 index 37e88fe..0000000 --- a/lisp/+cape.el +++ /dev/null @@ -1,25 +0,0 @@ -;;; cape.el -*- lexical-binding: t; -*- - -;;; Code: - -(require 'cape) - -(defmacro +cape-insinuate (hook capes &rest capfs) - "Insinuate CAPES for a mode. -Add a function to HOOK that will add CAPES to the local -`completion-at-point-functions' for that mode's buffer. If CAPFS -are given, mark them all as non-exclusive." - (let ((fn (intern (format "+cape-insinuate@%s" hook)))) - `(prog1 - ,@(when capes - `((defun ,fn () - ,@(cl-loop for cape in capes - collect `(add-hook 'completion-at-point-functions - #',cape 90 :local))) - (add-hook ',hook #',fn))) - ,@(cl-loop for capf in capfs - collect `(advice-add ',capf :around - #'cape-wrap-nonexclusive))))) - -(provide '+cape) -;;; +cape.el ends here diff --git a/lisp/+emms.el b/lisp/+emms.el deleted file mode 100644 index a43daea..0000000 --- a/lisp/+emms.el +++ /dev/null @@ -1,38 +0,0 @@ -;;; +emms.el -*- lexical-binding: t; -*- - -(defun +emms-streams (&optional file) - "Better interface for `emms-streams'. -If FILE is non-nil, use it. Otherwise use `emms-streams-file'. -If `emms-streams-file' is nil or this function is called with -\\[universal-argument], prompt the user." - (interactive - (list (cond - ((or emms-streams-file - (not current-prefix-arg)) - emms-streams-file) - (:else (read-file-name "Stream file: " - emms-source-file-default-directory))))) - (when (and (not (file-exists-p emms-streams-file)) - (y-or-n-p "Emms' bulit-in streams file hasn't been installed yet. Install it now?")) - (emms-streams-install)) - (let ((buf (get-buffer emms-streams-buffer-name))) - (when (not buf) - (with-current-buffer (get-buffer-create emms-streams-buffer-name) - (setq buf (current-buffer)) - (emms-playlist-mode) - (setq emms-playlist-buffer-p t) - (emms-playlist-set-playlist-buffer (current-buffer)) - (with-current-buffer (find-file-noselect emms-streams-file) - (cond - ((emms-source-playlist-native-p) - (emms-add-native-playlist emms-streams-file)) - ((emms-source-playlist-m3u-p) - (emms-add-m3u-playlist emms-streams-file)) - ((emms-source-playlist-pls-p) - (emms-add-pls-playlist emms-streams-file)) - (:else (error "Streams file `%s' isn't in a known format." - emms-streams-file)))))) - (switch-to-buffer buf))) - -(provide '+emms) -;;; +emms.el ends here diff --git a/lisp/+flyspell-correct.el b/lisp/+flyspell-correct.el deleted file mode 100644 index 9a33cc0..0000000 --- a/lisp/+flyspell-correct.el +++ /dev/null @@ -1,24 +0,0 @@ -;;; +flyspell-correct.el --- -*- lexical-binding: t; -*- - -;;; Code: - -(require 'flyspell-correct) - -(defun +flyspell-correct-buffer (&optional prefix) - "Run `flyspell-correct-wrapper' on all misspelled words in the buffer. -With PREFIX, prompt to change the current dictionary." - (interactive "P") - (flyspell-buffer) - (when prefix - (let ((current-prefix-arg nil)) - (call-interactively #'ispell-change-dictionary))) - (with-message "Checking spelling" - (flyspell-correct-move (point-min) :forward :rapid))) - -(defun +flyspell-correct-buffer-h (&rest _) - "Run `+flyspell-correct-buffer'. -This is suitable for placement in a hook." - (+flyspell-correct-buffer)) - -(provide '+flyspell-correct) -;;; +flyspell-correct.el ends here diff --git a/lisp/+hungry-delete.el b/lisp/+hungry-delete.el deleted file mode 100644 index 601aecf..0000000 --- a/lisp/+hungry-delete.el +++ /dev/null @@ -1,53 +0,0 @@ -;;; +hungry-delete.el -*- lexical-binding: t; -*- - -;; Copyright (C) 2022 Case Duckworth - -;;; Code: - -(require 'hungry-delete) - -(defmacro +hungry-delete-define-alternative (func hd-func &optional direction) - "Define a `hungry-delete' alternative for FUNC. -If the adjacent characters in DIRECTION are one of -`hungry-delete-chars-to-skip', call HD-FUNC. Otherwise, call -FUNC. - -If DIRECTION is a positive integer or `forward', look forward. -If it's negative or `backward', look backward. If it's absent, -this macro will try to guess based on the names of FUNC and -HD-FUNC. - -This macro creates a function taking a prefix argument that's -passed to both of FUNC and HD-FUNC." - (let ((name (intern (format "%s|%s" func hd-func))) - (lookfn (cond - ((or (and (string-match-p "forward" (symbol-name func)) - (string-match-p "forward" (symbol-name hd-func)) - (not direction)) - (and (integerp direction) - (< 0 direction)) - (eq direction 'forward)) - 'looking-at) - ((or (and (string-match-p "backward" (symbol-name func)) - (string-match-p "backward" (symbol-name hd-func)) - (not direction)) - (and (integerp direction) - (> 0 direction)) - (eq direction 'backward)) - 'looking-back) - (:else (error "Bad direction: %S" direction)))) - (arg (gensym))) - `(defun ,name (,arg) - ,(concat (format "Do `%s' or `%s', depending on whitespace.\n" - func hd-func) - (format "Pass prefix argument %s to the underlying functions.\n" - (upcase (symbol-name arg))) - "This function was defined by `define-hungry-delete-alternative'.") - (interactive "*p") ; This is brittle - (if (,lookfn (format "[%s]" hungry-delete-chars-to-skip)) - (,hd-func (or ,arg 1)) - (,func ,arg))))) - -(provide '+hungry-delete) -;;; +hungry-delete.el ends here - diff --git a/lisp/+isearch.el b/lisp/+isearch.el deleted file mode 100644 index 3516ec4..0000000 --- a/lisp/+isearch.el +++ /dev/null @@ -1,24 +0,0 @@ -;;; +isearch.el --- iseach (and query-replace) extensions -*- lexical-binding: t; -*- - -;;; From https://github.com/astoff/isearch-mb/wiki - -(defun +isearch-cancel@add-search-to-history () - "Add search string to history also when canceling. -This should be used as `:before' advice on `isearch-cancel'." - (unless (string-equal "" isearch-string) - (isearch-update-ring isearch-string isearch-regexp))) - -(defun +perform-replace-dont-exit-on-anykey (orig &rest args) - "Don't exit replace for anykey that's not in `query-replace-map'. -This should be used as `:around' advice for `perform-replace'." - (save-window-excursion - (cl-letf* ((lookup-key-orig - (symbol-function 'lookup-key)) - ((symbol-function 'lookup-key) - (lambda (map key &optional accept-default) - (or (apply lookup-key-orig map key accept-default) - (when (eq map query-replace-map) 'help))))) - (apply orig args)))) - -(provide '+isearch) -;;; +isearch.el ends here diff --git a/lisp/+ispell.el b/lisp/+ispell.el deleted file mode 100644 index 10c31b8..0000000 --- a/lisp/+ispell.el +++ /dev/null @@ -1,97 +0,0 @@ -;;; +ispell.el --- Customizations for `ispell' -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -(require 'cl-lib) -(require 'seq) - -;; Utility function TODO: move elsewhere -(defun +ispell-append-removing-duplicates (&rest lists) - "Append LISTS, removing duplicates from the result. -Any keyword arguments to `cl-remove-duplicates' should come -before the LISTS." - (let (cl-remove-duplicates-args) - (while (keywordp (car lists)) - (push (pop lists) cl-remove-duplicates-args) - (push (pop lists) cl-remove-duplicates-args)) - (apply #'cl-remove-duplicates (apply #'append lists) - (nreverse cl-remove-duplicates-args)))) - -;;; Ispell in .dir-locals - -;; Let Emacs know a list of strings is safe -(defun +ispell-safe-local-p (list) - (and (listp list) - (seq-every-p #'stringp list))) - -;; Can I instruct ispell to insert LocalWords in a different file? -;; https://emacs.stackexchange.com/q/31396/2264 - -;; How can I move all my file-local LocalWords to .dir-locals.el? -;; https://emacs.stackexchange.com/q/31419 - -;; Adapted from ispell.el:ispell-buffer-local-words -(defun +ispell-buffer-local-words-list () - (let (words) - (or ispell-buffer-local-name - (setf ispell-buffer-local-name (buffer-name))) - (save-excursion - (goto-char (point-min)) - (while (search-forward ispell-words-keyword nil t) - (let ((end (point-at-eol)) - (ispell-casechars (ispell-get-casechars)) - string) - (while (re-search-forward " *\\([^ ]+\\)" end t) - (setf string (match-string-no-properties 1)) - (if (and (< 1 (length string)) - (equal 0 (string-match ispell-casechars string))) - (push string words)))))) - words)) - -;;;###autoload -(defun +ispell-move-buffer-words-to-dir-locals (&optional arg) - "Move the current buffer-local words to .dir-locals.el. -This function prompts the user to save .dir-locals.el, unless -prefix ARG is non-nil; then it just saves them." - (interactive "P") - (unless (buffer-file-name) - (user-error "Buffer not attached to file")) - (hack-dir-local-variables) - (let ((print-level nil) - (print-length nil)) - (when-let ((new-words (cl-remove-if (lambda (el) (eq el '\.\.\.)) ; XXX: NO IDEA - ; where this came from - (+ispell-append-removing-duplicates - :test #'string= - ispell-buffer-session-localwords - (alist-get 'ispell-buffer-session-localwords - dir-local-variables-alist) - (alist-get 'ispell-buffer-session-localwords - file-local-variables-alist) - (+ispell-buffer-local-words-list))))) - (save-excursion - (add-dir-local-variable - major-mode - 'ispell-buffer-session-localwords - (setf ispell-buffer-session-localwords - new-words)) - (when (or arg - (y-or-n-p "Save .dir-locals.el?")) - (save-buffer)) - (bury-buffer)) - (or ispell-buffer-local-name - (setf ispell-buffer-local-name (buffer-name))) - (save-excursion - (goto-char (point-min)) - (while (search-forward ispell-words-keyword nil t) - (delete-region (point-at-bol) (1+ (point-at-eol)))))))) - -;;;###autoload -(defun +ispell-move-buffer-words-to-dir-locals-hook () - "Convenience function for binding to a hook." - (+ispell-move-buffer-words-to-dir-locals t)) - -(provide '+ispell) -;;; +ispell.el ends here diff --git a/lisp/+link-hint.el b/lisp/+link-hint.el deleted file mode 100644 index 926a266..0000000 --- a/lisp/+link-hint.el +++ /dev/null @@ -1,144 +0,0 @@ -;;; +link-hint.el -*- lexical-binding: t; -*- - -;;; Code: - -(require 'cl-lib) -(require 'link-hint) - -(defgroup +link-hint nil - "Extra customizations for `link-hint'." - :group 'link-hint) - -(defcustom +link-hint-open-secondary-types '(gnus-w3m-image-url - gnus-w3m-url - markdown-link - mu4e-attachment - mu4e-url - notmuch-hello - nov-link - org-link - shr-url - text-url - w3m-link - w3m-message-link) - "Link types to define `:open-secondary' for.") - -(defvar +link-hint-map (make-sparse-keymap) - "Keymap for `link-hint' functionality.") - -(cl-defmacro +link-hint-define-keyword (keyword handler docstring - &optional (types 'link-hint-types) - &rest rest - &key multiple &allow-other-keys) - "Set up a `link-hint' KEYWORD, with optional TYPES. -If TYPES is not present, use `link-hint-types'. - -KEYWORD defines the link-hint type. It will be used to create a -function for opening links of the form \"link-hint-openKEYWORD\". - -HANDLER is the function to open a link with. - -DOCSTRING is the macro's documentation. - -Keyword arguments are passed to `link-hint-define-type' prefixed -with the KEYWORD." - (declare (indent 2) - (doc-string 3)) - (let ((types (symbol-value types)) - (func-sym (intern (format "+link-hint-open%s" keyword))) - (mult-sym (intern (format "%s-multiple" keyword))) - (expr)) - ;; Define the type - (push `(dolist (type ',types) - (link-hint-define-type type - ,keyword ,handler - ,@(mapcar (lambda (el) - (if (eq el :multiple) - mult-sym - el)) - rest))) - expr) - ;; Define an opener - (push `(defun ,func-sym () - ,(format "%s\n\nDefined by `+link-hint-define'." docstring) - (interactive) - (avy-with link-hint-open-link - (link-hint--one ,keyword))) - expr) - ;; Handle `:multiple' - (when multiple - (push `(defun ,(intern (format "+link-hint-open-multiple%s" keyword)) () - ,(format "Open multiple links with `%s'.\n\nDefined by `+link-hint-define'." - func-sym) - (avy-with link-hint-open-multiple-links - (link-hint--multiple ,keyword))) - expr) - (push `(defun ,(intern (format "+link-hint-open-all%s" keyword)) () - ,(format "Open all visible links with `%s'.\n\nDefined by `+link-hint-define'." - func-sym) - (avy-with link-hint-open-all-links - (link-hint--all ,keyword))) - expr)) - ;; Return the built expression - `(progn ,@(nreverse expr)))) - -(+link-hint-define-keyword :secondary browse-url-secondary-browser-function - "Open a link in the secondary browser." - +link-hint-open-secondary-types - :multiple t) - -(defun +link-hint-open-secondary-setup (&optional types) - "Define the `:open-secondary' link-hint type for TYPES. -If TYPES is nil, define it for `+link-hint-open-secondary-types'." - (dolist (type (or types +link-hint-open-secondary-types)) - (link-hint-define-type type - :open-secondary browse-url-secondary-browser-function - :open-secondary-multiple t))) - -(defun +link-hint-open-secondary () - "Open a link in the secondary browser." - (interactive) - (avy-with link-hint-open-link - (link-hint--one :open-secondary))) - -(defun +link-hint-open-chrome-setup (&optional types) - "Define the `:open-chrome' link-hint type for TYPES. -If TYPES is nil, define it for `+link-hint-open-secondary-types'." - (dolist (type (or types +link-hint-open-secondary-types)) - (link-hint-define-type type - :open-chrome #'browse-url-chrome - :open-chrome-multiple t))) - -(defun +link-hint-open-chrome () - "Open a link with chrome." - (interactive) - (avy-with link-hint-open-link - (link-hint--one :open-chrome))) - -(defun +link-hint-open-link (prefix) - "Open a link. -Without a PREFIX, open using `browse-url-browser-function'; with -a PREFIX, use `browse-url-secondary-browser-function'." - (interactive "P") - (let ((current-prefix-arg nil)) - (avy-with link-hint-open-link - (link-hint--one (if prefix :open-secondary :open))))) - -(defun +link-hint-open-multiple-links (prefix) - "Open multiple links. -Without a PREFIX, open using `browse-url-browser-function'; with -a PREFIX, use `browse-url-secondary-browser-function'." - (interactive "P") - (avy-with link-hint-open-multiple-links - (link-hint--one (if prefix :open-secondary :open)))) - -(defun +link-hint-open-all-links (prefix) - "Open all visible links. -Without a PREFIX, open using `browse-url-browser-function'; with -a PREFIX, use `browse-url-secondary-browser-function'." - (interactive "P") - (avy-with link-hint-open-all-links - (link-hint--one (if prefix :open-secondary :open)))) - -(provide '+link-hint) -;;; +link-hint.el ends here diff --git a/lisp/+lisp.el b/lisp/+lisp.el deleted file mode 100644 index 22450f7..0000000 --- a/lisp/+lisp.el +++ /dev/null @@ -1,93 +0,0 @@ -;;; +lisp.el -*- lexical-binding: t -*- - -;;; Comment-or-uncomment-sexp -;; from https://endlessparentheses.com/a-comment-or-uncomment-sexp-command.html - -(defun +lisp-uncomment-sexp (&optional n) - "Uncomment N sexps around point." - (interactive "P") - (let* ((initial-point (point-marker)) - (inhibit-field-text-motion t) - (p) - (end (save-excursion - (when (elt (syntax-ppss) 4) - (re-search-backward comment-start-skip - (line-beginning-position) - t)) - (setq p (point-marker)) - (comment-forward (point-max)) - (point-marker))) - (beg (save-excursion - (forward-line 0) - (while (and (not (bobp)) - (= end (save-excursion - (comment-forward (point-max)) - (point)))) - (forward-line -1)) - (goto-char (line-end-position)) - (re-search-backward comment-start-skip - (line-beginning-position) - t) - (ignore-errors - (while (looking-at-p comment-start-skip) - (forward-char -1))) - (point-marker)))) - (unless (= beg end) - (uncomment-region beg end) - (goto-char p) - ;; Indentify the "top-level" sexp inside the comment. - (while (and (ignore-errors (backward-up-list) t) - (>= (point) beg)) - (skip-chars-backward (rx (syntax expression-prefix))) - (setq p (point-marker))) - ;; Re-comment everything before it. - (ignore-errors - (comment-region beg p)) - ;; And everything after it. - (goto-char p) - (forward-sexp (or n 1)) - (skip-chars-forward "\r\n[:blank:]") - (if (< (point) end) - (ignore-errors - (comment-region (point) end)) - ;; If this is a closing delimiter, pull it up. - (goto-char end) - (skip-chars-forward "\r\n[:blank:]") - (when (eq 5 (car (syntax-after (point)))) - (delete-indentation)))) - ;; Without a prefix, it's more useful to leave point where - ;; it was. - (unless n - (goto-char initial-point)))) - -(defun +lisp-comment-sexp--raw () - "Comment the sexp at point or ahead of point." - (pcase (or (bounds-of-thing-at-point 'sexp) - (save-excursion - (skip-chars-forward "\r\n[:blank:]") - (bounds-of-thing-at-point 'sexp))) - (`(,l . ,r) - (goto-char r) - (skip-chars-forward "\r\n[:blank:]") - (save-excursion - (comment-region l r)) - (skip-chars-forward "\r\n[:blank:]")))) - -(defun +lisp-comment-or-uncomment-sexp (&optional n) - "Comment the sexp at point and move past it. -If already inside (or before) a comment, uncomment instead. -With a prefix argument N, (un)comment that many sexps." - (interactive "P") - (if (or (elt (syntax-ppss) 4) - (< (save-excursion - (skip-chars-forward "\r\n[:blank:]") - (point)) - (save-excursion - (comment-forward 1) - (point)))) - (+lisp-uncomment-sexp n) - (dotimes (_ (or n 1)) - (+lisp-comment-sexp--raw)))) - -(provide '+lisp) -;;; +lisp.el ends here diff --git a/lisp/+message.el b/lisp/+message.el deleted file mode 100644 index b8bc234..0000000 --- a/lisp/+message.el +++ /dev/null @@ -1,26 +0,0 @@ -;;; +message.el --- Extra message-mode functions -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -;; Thanks to Alex Schroeder for this! -;; https://www.emacswiki.org/emacs/Change_Signature_Dynamically - -(defun +message-check-for-signature-change (&rest ignore) - "Check for a change in the To: or Cc: fields" - (when (and (message--in-tocc-p) - (not (buffer-narrowed-p))) - (save-excursion - (goto-char (point-max)) - (let ((end (point))) - (when (re-search-backward message-signature-separator nil t) - (delete-region (1- (match-beginning 0)) end))) - (message-insert-signature)))) - -(defun +message-signature-setup () - (make-local-variable 'after-change-functions) - (push '+message-check-for-signature-change after-change-functions)) - -(provide '+message) -;;; +message.el ends here diff --git a/lisp/+notmuch.el b/lisp/+notmuch.el deleted file mode 100644 index 5df6e5b..0000000 --- a/lisp/+notmuch.el +++ /dev/null @@ -1,149 +0,0 @@ -;;; +notmuch.el --- Notmuch extras -*- lexical-binding: t; -*- - -;;; Commentary: - -;; This is stuff that I suppose /could/ go in notmuch/init.el, but ... doesn't. - -;;; Code: - -(require 'cl-lib) -(require 'notmuch) - -(defvar +notmuch-send-dispatch-rules nil - "Alist of from addresses and variables to set when sending.") - -(defun +notmuch-query-concat (&rest queries) - "Concatenate notmuch queries." - (mapconcat #'identity queries " AND ")) - -(defun +send-mail-dispatch () - "Dispatch mail sender, depending on account." - (let ((from (message-fetch-field "from"))) - (dolist (vars (cl-loop for (addr . vars) in +notmuch-send-dispatch-rules - if (string-match-p addr from) return vars)) - (set (car vars) (cdr vars))))) - -(defun +notmuch-correct-tags (args) - (list (car args) (mapcar #'string-trim (cadr args)))) - -(defun +notmuch-goto (&optional prefix) - "Go straight to a `notmuch' search. -Without PREFIX argument, go to the first one in -`notmuch-saved-searches'; with a PREFIX argument, prompt the user -for which saved search to go to; with a double PREFIX -argument (\\[universal-argument] \\[universal-argument]), prompt -for search." - (interactive "P") - (pcase prefix - ('nil (notmuch-search (plist-get (car notmuch-saved-searches) :query))) - ('(4) (notmuch-search (plist-get (cl-find (completing-read "Saved Search: " - (mapcar (lambda (el) - (plist-get el :name)) - notmuch-saved-searches)) - notmuch-saved-searches - :key (lambda (el) (plist-get el :name)) - :test #'equal) - :query))) - (_ (notmuch-search)))) - -;; Don't add an initial input when completing addresses -(eval-after notmuch - (cond ((featurep 'el-patch) - (el-patch-feature notmuch) - (el-patch-defun notmuch-address-selection-function (prompt collection initial-input) - "Call (`completing-read' - PROMPT COLLECTION nil nil INITIAL-INPUT 'notmuch-address-history)" - (completing-read - prompt collection nil nil - (el-patch-swap initial-input - nil) - 'notmuch-address-history))) - (:else - (defun notmuch-address-selection-function (prompt collection initial-input) - "Call (`completing-read' - PROMPT COLLECTION nil nil INITIAL-INPUT 'notmuch-address-history)" - (completing-read - prompt collection nil nil nil - 'notmuch-address-history))))) - -(defcustom +notmuch-spam-tags '("+spam" "+Spam") - "A list of tag changes to apply when marking a thread as spam." - :type '(repeat string)) - -(defun +notmuch-tree-mark-spam-then-next (&optional ham beg end) - "Mark the current message as spam and move to the next." - (interactive "P") - (+notmuch-tree-mark-spam ham) - (notmuch-tree-next-matching-message)) - -(defun +notmuch-tree-mark-spam (&optional ham) - "Mark the current message as spam. -That is, apply the tag changes in `+notmuch-spam-tags' to it. If -an optional prefix HAM argument is given, the message will be -marked as not-spam (\"ham\"), i.e., the tag changes in -`+notmuch-spam-tags' will be reversed." - (interactive "P") - (when +notmuch-spam-tags - (notmuch-tree-tag - (notmuch-tag-change-list +notmuch-spam-tags ham)))) - -(defun +notmuch-search-mark-spam (&optional ham beg end) - "Mark the current thread or region as spam. -This adds the tags in `+notmuch-spam-tags' to the message. With -an optional HAM prefix argument, mark the messages as -not-spam (\"ham\"). - -This function advances the next thread when finished." - (interactive (cons current-prefix-arg (notmuch-interactive-region))) - (when +notmuch-spam-tags - (notmuch-search-tag - (notmuch-tag-change-list +notmuch-spam-tags ham) beg end)) - (when (eq beg end) - (notmuch-search-next-thread))) - -(defun +notmuch-tree-beginning (&optional arg) - "Move point to beginning of message or tree, depending on ARG." - (interactive "P") - (cond - ((and (window-live-p notmuch-tree-message-window) - (not arg)) - (with-selected-window notmuch-tree-message-window - (beginning-of-buffer))) - (:else (beginning-of-buffer)))) - -(defun +notmuch-tree-end (&optional arg) - "Move point to end of message or tree, depending on ARG." - (interactive "P") - (cond - ((and (window-live-p notmuch-tree-message-window) - (not arg)) - (with-selected-window notmuch-tree-message-window - (end-of-buffer))) - (:else (end-of-buffer)))) - -(defun +notmuch-make-saved-search (name key search-type &rest queries) - "Wrapper to ease `notmuch-saved-searches' defining. -NAME, KEY, and SEARCH-TYPE are paired with the corresponding keywords in -`notmuch-saved-searches', which see. QUERIES are all concatenated together with -AND. If QUERIES is prepended with more keyword arguments, those are added to -the saved search as well." - (declare (indent 3)) - (let (extra-keywords) - (while (keywordp (car queries)) - (push (cadr queries) extra-keywords) - (push (car queries) extra-keywords) - (setf queries (cddr queries))) - (add-to-list 'notmuch-saved-searches - (append - (list :name name - :key key - :search-type search-type - :query (apply #'+notmuch-query-concat queries)) - (reverse extra-keywords)) - :append - (lambda (a b) - (equal (plist-get a :name) - (plist-get b :name)))))) - -(provide '+notmuch) -;;; +notmuch.el ends here diff --git a/lisp/+org-capture.el b/lisp/+org-capture.el deleted file mode 100644 index 2f7bf6a..0000000 --- a/lisp/+org-capture.el +++ /dev/null @@ -1,49 +0,0 @@ -;;; +org-capture.el -*- lexical-binding: t; -*- - -;;; Code: - -(require 'cl-lib) -;; Don't /require/ `org-capture', since that'll pull in all of `org' and that'll -;; take a minute. Just let the compiler know that this variable exists. -(defvar org-capture-templates nil) - -;; https://github.com/cadadr/configuration/blob/39813a771286e542af3aa333172858532c3bb257/emacs.d/gk/gk-org.el#L1573 -(defun +org-capture-template-define (description &rest args) - "Define a capture template. -Creates a list and adds it to `org-capture-templates', if it's -not already there. ARGS is a plist, which in addition to the -additional options `org-capture-templates' accepts (which see), -takes the following and puts them in the right spot: `:keys', -`:description', `:type', `:target', and `:template'." - (declare (indent 1)) - (let* ((keys (plist-get args :keys)) - (type (plist-get args :type)) - (target (plist-get args :target)) - (template (plist-get args :template)) - (template-value (append - (list description) - (when (or type target template) - (list (or type 'entry) target template)) - (cl-loop for i from 0 below (length args) by 2 - unless (member (nth i args) - '(:keys :description :type - :target :template)) - append (list (nth i args) - (plist-get args (nth i - args))))))) - ;; The only way I know how to do this properly (add a value to the end of - ;; the list, if it exists; otherwise update it) is to do this weird if-setf - ;; dance. - (if (seq-find (lambda (el) (equal (car el) keys)) - org-capture-templates) - (setf (alist-get keys org-capture-templates nil nil #'equal) - template-value) - (setf org-capture-templates - (append org-capture-templates - (list (cons keys template-value))))) - ;; Regardless of what we do, return the new value of - ;; `org-capture-templates'. - org-capture-templates)) - -(provide '+org-capture) -;;; +org-capture.el diff --git a/lisp/+org.el b/lisp/+org.el deleted file mode 100644 index a148bd8..0000000 --- a/lisp/+org.el +++ /dev/null @@ -1,309 +0,0 @@ -;;; +org.el -*- lexical-binding: t; -*- - -;;; Code: - -(require 'cl-lib) -(require 'seq) - -;;; Org-return DWIM -;; https://github.com/alphapapa/unpackaged.el, -;; http://kitchingroup.cheme.cmu.edu/blog/2017/04/09/A-better-return-in-org-mode/ - -(defun +org-element-descendant-of (type element) - "Return non-nil if ELEMENT is a descendant of TYPE. -TYPE should be an element type, like `item' or `paragraph'. -ELEMENT should be a list like that returned by `org-element-context'." - ;; MAYBE: Use `org-element-lineage'. - (when-let* ((parent (org-element-property :parent element))) - (or (eq type (car parent)) - (+org-element-descendant-of type parent)))) - -(defun +org-return-dwim (&optional prefix) - "A helpful replacement for `org-return'. -With PREFIX, call `org-return'." - (interactive "P") - ;; Auto-fill if enabled - (when auto-fill-function - (dolist (func (ensure-list auto-fill-function)) - (funcall func))) - (cond - (prefix ; Handle prefix - (pcase prefix - ('(4) (newline)) - ('(16) (newline 2)) - (_ (newline prefix)))) - ((and org-return-follows-link ; Open link - (eq 'link (car (org-element-context)))) - (org-open-at-point-global)) - ((org-at-heading-p) ; Open a line after a heading - (let ((heading-start (org-entry-beginning-position))) - (goto-char (org-entry-end-position)) - (cond ((and (org-at-heading-p) - (= heading-start (org-entry-beginning-position))) - ;; Entry ends on its heading, so add 2 newlines - (end-of-line) - (newline 2)) - (t - ;; Entry ends after its heading, so back up - (forward-line -1) - (end-of-line) - (when (org-at-heading-p) - (forward-line) - (newline) - (forward-line -1)) - (while (not (looking-back (rx (repeat 3 (seq (optional blank) "\n"))) - nil)) - (newline)) - (forward-line -1))))) - ((org-at-item-checkbox-p) ; Insert a new checkbox item - (end-of-line) - (org-insert-todo-heading nil)) - ((org-in-item-p) ; Insert a new list item - (let* ((context (org-element-context)) - (first-item-p (eq 'plain-list (car context))) - (itemp (eq 'item (car context))) - (emptyp (or - ;; This (regular) list item is empty - (eq (org-element-property :contents-begin context) - (org-element-property :contents-end context)) - ;; This (definition) list item is empty - (looking-at " *::"))) - (item-child-p (+org-element-descendant-of 'item context))) - (cond ((and itemp emptyp) - (delete-region (line-beginning-position) (line-end-position)) - (newline)) - ((or first-item-p - (and itemp (not emptyp)) - item-child-p) - (org-end-of-item) - (org-insert-item)) - (t - (delete-region (line-beginning-position) (line-end-position)) - (newline))))) - ((and (fboundp 'org-inlinetask-in-task-p) ; Don't insert a new heading with - (org-inlinetask-in-task-p)) ; inline tasks - (org-return)) - ((org-at-table-p) ; Insert a new org-table row - (cond ((save-excursion - (beginning-of-line) - (cl-loop with end = (line-end-position) - for cell = (org-element-table-cell-parser) - always (equal (org-element-property :contents-begin cell) - (org-element-property :contents-end cell)) - while (re-search-forward "|" end t))) - ;; Empty row: end the table - (delete-region (line-beginning-position) (line-end-position)) - (org-return)) - (t - ;; Non-empty row - (org-return)))) - (t ; Otherwise---just call `org-return'. - (org-return)))) - -(defun +org-table-copy-down|+org-return-dwim (&optional n) - "Call `org-table-copy-down' or `+org-return' depending on context." - (interactive "P") - (if (org-table-check-inside-data-field 'noerror) - (org-table-copy-down (or n 1)) - (+org-return-dwim n))) - - -;;; A ... different ... `org-open-at-point-dwim' -;; I honestly don't remember what the difference is between this and the -;; O.G. one is.. hopefully this one fixes annoying stupid problems. - -(defun +org-open-at-point-dwim (&optional arg) - "Open thing at point, or if there isn't something, list things." - (interactive "P") - (save-excursion - (let* ((this-char-type (org-element-type (org-element-context))) - (prev-char-type (ignore-errors - (save-excursion - (backward-char) - (org-element-type (org-element-context))))) - (types '(citation citation-reference clock comment comment-block - footnote-definition footnote-reference headline - inline-src-block inlinetask keyword link - node-property planning src-block timestamp)) - (type this-char-type)) - (when (and (memq this-char-type types) (memq prev-char-type types)) - (backward-char) - (setq type prev-char-type)) ; what the fuckckckckck - ;; Okay, so this ^ is pretty janky and doesn't /really/ work that well, - ;; especially on DEADLINE (and probably SCHEDULED) lines. However, since - ;; I really just want to open the list of URLs /most of the time/, I'm - ;; fixing it like this instead. - (unless (and (memq type types) - (ignore-errors (org-open-at-point arg) - t)) - (while (not - (progn - (org-back-to-heading) - (car (org-offer-links-in-entry (current-buffer) (point) 1)))) - (org-up-heading-all 1)) - (org-open-at-point arg))))) - -;;; Faces -;; see `org-emphasis-alist' - -(defface org-bold '((t (:weight bold))) - "Bold face in `org-mode' documents.") - -(defface org-italic '((t (:slant italic))) - "Italic face in `org-mode' documents.") - -(defface org-underline '((t (:underline t))) - "Underline face in `org-mode' documents.") - -(defface org-strikethrough '((t (:strike-through t))) - "Strike-through face for `org-mode' documents.") - -;;; Unsmartify - -(defun +org-unsmartify () - "Replace \"smart\" punctuation with their \"dumb\" counterparts." - (interactive) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "[“”‘’–—]" nil t) - (let ((replace (pcase (match-string 0) - ((or "“" "”") "\"") - ((or "‘" "’") "'") - ("–" "--") - ("—" "---")))) - (replace-match replace nil nil))))) - -;;; Copy org trees as HTML -;; Thanks to Oleh Krehel: -;; https://emacs.stackexchange.com/questions/54292/copy-results-of-org-export-directly-to-clipboard - -(defun +org-export-clip-to-html - (&optional async subtreep visible-only body-only ext-plist post-process) - "Export region to HTML, and copy it to the clipboard. -Arguments ASYNC, SUBTREEP, VISIBLE-ONLY, BODY-ONLY, EXT-PLIST, -and POST-PROCESS are passed to `org-export-to-file'." - (interactive) ; XXX: hould this be interactive? - (message "Exporting Org to HTML...") - (let ((org-tmp-file "/tmp/org.html")) - (org-export-to-file 'html org-tmp-file - async subtreep visible-only body-only ext-plist post-process) - ;; XXX: figure out which clipboard to use, or use something in Emacs - (start-process "xclip" "*xclip*" - "xclip" "-verbose" - "-i" org-tmp-file - "-t" "text/html" - "-selection" "clipboard")) - (message "Exporting Org to HTML...done.")) - -;; Specialized functions -(defun +org-export-clip-subtree-to-html () - "Export current subtree to HTML." - (interactive) - (+org-export-clip-to-html nil :subtree)) - -;;; Hide drawers on save, except the currently-expanded one - -(defun +org-hide-drawers-except-point () - "Hide all drawers except for the one point is in." - ;; Most of this bit is taken from `org-fold--hide-drawers'. - (let ((pt (point)) - (begin (point-min)) - (end (point-max))) - (save-excursion - (goto-char begin) - (while (and (< (point) end) - (re-search-forward org-drawer-regexp end t)) - (if (org-fold-folded-p nil 'drawer) - (goto-char (org-fold-next-folding-state-change 'drawer nil end)) - (let* ((drawer (org-element-at-point)) - (type (org-element-type drawer)) - (el-begin (org-element-property :begin drawer)) - (el-end (org-element-property :end drawer))) - (when (memq type '(drawer property-drawer)) - (org-fold-hide-drawer-toggle - (if (< el-begin pt el-end) 'off 'on) - nil drawer) - (goto-char el-end)))))))) - -;;; Define `ol' link types - -(defmacro +org-link-define-type (type args &rest body) - "Define an org link TYPE. -A function named `+org-link-TYPE-open' will be created, with ARGS -as its arguments and BODY as its body. BODY can be blank, in -which case the user will be messaged (This is a good do-nothing -effect for exporting link types)." - (declare (indent 2) - (doc-string 3) - (debug (sexp sexp def-body))) - (let ((fn (intern (format "+org-link-%s-open" type))) - (body (or body `((message ,(format "%S: %%S" type) - ,(car args))))) - (type-string (format "%S" type))) - `(prog1 - (defun ,fn ,args ,@body) - (org-link-set-parameters ,type-string :follow #',fn)))) - -;;; Skip some files in `org-agenda' - -(defcustom org-agenda-file-skip-regexp nil - "Files matching this regexp are removed from `org-agenda-files'." - :group 'org-agenda) - -(defun org-agenda-files@skip-regexp (files) - "`:filter-return' advice to filter files in `org-agenda-file-skip-regexp'." - (when org-agenda-file-skip-regexp - (setq files - (seq-remove (lambda (file) - (string-match-p - org-agenda-file-skip-regexp file)) - files))) - files) - -;;; Prompt for stuff - -(defun +org-prompt-for-property (property &optional clipboardp insert list) - "Prompt for PROPERTY and return a properly-formatted string. -Pre-fill the input with clipboard contents if they match CLIPBOARDP. If -CLIPBOARDP is nil or missing, don't pre-fill. - -If INSERT is non-nil, insert the property into the property -drawer of the current org tree. - -If LIST is non-nil, return the result as a list instead of a string." - (let* ((kill (current-kill 0)) - (value (read-string (concat property ": ") - (when (and clipboardp - (or (eq clipboardp t) - (funcall clipboardp kill))) - kill)))) - (when insert - (org-set-property property value)) - (if list - (list property value) - (format ":%s: %s" property value)))) - -(defun +org-prompt-tags (&optional prompt global) - (let* ((buffer (org-capture-get :buffer)) - (file (buffer-file-name (or (buffer-base-buffer buffer) buffer))) - (org-last-tags-completion-table - (org-global-tags-completion-table - (if global (org-agenda-files) (list file)))) - (org-add-colon-after-tag-completion t) - (ins (mapconcat - #'identity - (let ((crm-separator "[ \t]*:[ \t]*")) - (completing-read-multiple - (or prompt "Tags: ") - org-last-tags-completion-table nil nil nil - 'org-tags-history)) - ":"))) - (when (org-string-nw-p ins) - (prog1 (concat - (unless (eq (char-before) ?:) ":") - ins - (unless (eq (char-after) ?:) ":")) - (when (org-at-heading-p) (org-align-tags)))))) - -(provide '+org) -;;; +org.el ends here diff --git a/lisp/+paredit.el b/lisp/+paredit.el deleted file mode 100644 index ab176b8..0000000 --- a/lisp/+paredit.el +++ /dev/null @@ -1,26 +0,0 @@ -;;; +paredit.el -*- lexical-binding: t -*- - -;;; Fixing unquote-splicing behaviour with Paredit -;; https://www.n16f.net/blog/fixing-unquote-splicing-behaviour-with-paredit/ - -(require 'paredit) -(require 'seq) - -(defcustom +paredit-no-space-prefixes '(",@") - "Prefix strings to not insert a space after in `paredit'." - :group 'paredit - :type '(repeat string)) - -(defun +paredit-space-for-delimiter (endp delimiter) - (let ((point (point))) - (or endp - (seq-every-p - (lambda (prefix) - (and (> point (length prefix)) - (let ((start (- point (length prefix))) - (end point)) - (not (string= (buffer-substring start end) prefix))))) - +paredit-no-space-prefixes)))) - -(provide '+paredit) -;;; +paredit.el ends here diff --git a/lisp/+titlecase.el b/lisp/+titlecase.el deleted file mode 100644 index 6defda7..0000000 --- a/lisp/+titlecase.el +++ /dev/null @@ -1,34 +0,0 @@ -;;; +titlecase.el --- Titlecase extras -*- lexical-binding: t; -*- - -;;; Commentary: - -;;; Code: - -(require 'titlecase) - -(defun +titlecase-sentence-style-dwim (&optional arg) - "Titlecase a sentence. -With prefix ARG, toggle the value of -`titlecase-downcase-sentences' before sentence-casing." - (interactive "P") - (let ((titlecase-downcase-sentences (if arg (not titlecase-downcase-sentences) - titlecase-downcase-sentences))) - (titlecase-dwim 'sentence))) - -(defun +titlecase-org-headings () - (interactive) - (save-excursion - (goto-char (point-min)) - ;; See also `org-map-tree'. I'm not using that function because I want to - ;; skip the first headline. A better solution would be to patch - ;; `titlecase-line' to ignore org-mode metadata (TODO cookies, tags, etc). - (let ((level (funcall outline-level)) - (org-special-ctrl-a/e t)) - (while (and (progn (outline-next-heading) - (> (funcall outline-level) level)) - (not (eobp))) - (titlecase-region (org-beginning-of-line) - (org-end-of-line)))))) - -(provide '+titlecase) -;;; +titlecase.el ends here diff --git a/lisp/acdw-defaults.el b/lisp/acdw-defaults.el deleted file mode 100644 index e4c9e14..0000000 --- a/lisp/acdw-defaults.el +++ /dev/null @@ -1,295 +0,0 @@ -;;; acdw-defaults.el --- measured defaults for Emacs -*- lexical-binding: t -*- -;; by C. Duckworth - -;;; Commentary: - -;; I find myself copy-pasting a lot of "boilerplate" type code when -;; bankrupting my Emacs config and starting afresh. Instead of doing -;; that, I'm putting it here, where it'll be easier to include in my -;; config. - -;; Of course, some might say I could just ... stop bankrupting my -;; Emacs. But like, why would I want to? - -;;; Code: - -(require 'seq) - -(defvar default-ring-max 256 - "Default maximum for ring variables.") - -(unless (boundp 'use-short-answers) - (fset 'yes-or-no-p 'y-or-n-p)) - -(setc async-shell-command-buffer 'new-buffer - async-shell-command-display-buffer nil - auto-hscroll-mode t - auto-window-vscroll nil - cursor-in-non-selected-windows 'hollow - cursor-type 'bar - echo-keystrokes 0.01 - fast-but-imprecise-scrolling t - fill-column 80 - global-mark-ring-max default-ring-max - hscroll-margin 1 - hscroll-step 1 - inhibit-startup-screen t - initial-buffer-choice t - kill-do-not-save-duplicates t - kill-read-only-ok t - kill-ring-max default-ring-max - kmacro-ring-max default-ring-max - mark-ring-max default-ring-max - read-answer-short t - read-process-output-max (* 10 1024 1024) - ring-bell-function #'ignore - save-interprogram-paste-before-kill t - scroll-conservatively 25 - scroll-margin 0 - scroll-preserve-screen-position 1 - scroll-step 1 - sentence-end-double-space t - set-mark-command-repeat-pop t - tab-width 8 - undo-limit (* 10 1024 1024) - use-dialog-box nil - use-file-dialog nil - use-short-answers t - window-resize-pixelwise t - yank-pop-change-selection t) - -;;; Encodings - -;; Allegedly, this is the only one you need... -(set-language-environment "UTF-8") -;; But I still set all of these, for fun. -(setq-default buffer-file-coding-system 'utf-8-unix - coding-system-for-read 'utf-8-unix - coding-system-for-write 'utf-8-unix - default-process-coding-system '(utf-8-unix . utf-8-unix) - locale-coding-system 'utf-8-unix - x-select-request-type '(UTF8_STRING - COMPOUND_TEXT - TEXT - STRING)) - -(set-charset-priority 'unicode) -(prefer-coding-system 'utf-8-unix) -(set-default-coding-systems 'utf-8-unix) -(set-terminal-coding-system 'utf-8-unix) -(set-keyboard-coding-system 'utf-8-unix) - -(pcase system-type - ((or 'ms-dos 'windows-nt) - (set-clipboard-coding-system 'utf-16-le) - (set-selection-coding-system 'utf-16-le)) - (_ - (set-selection-coding-system 'utf-8) - (set-clipboard-coding-system 'utf-8))) - -;;; Modes - -(dolist (enable-mode '(;; Enable these modes on startup - delete-selection-mode - global-so-long-mode - )) - (funcall enable-mode +1)) - -(dolist (disable-mode '(;; Disable these modes on startup - horizontal-scroll-bar-mode - menu-bar-mode - scroll-bar-mode - tool-bar-mode - tooltip-mode - )) - (funcall disable-mode -1)) - -(deftheme use-package) -(enable-theme 'use-package) - -;;; Internal packages - -(when (require 'abbrev nil t) - (custom-theme-set-variables 'use-package - '(abbrev-file-name (sync/ "abbrev.el")) - '(save-abbrevs 'silently))) - -(when (require 'autorevert nil t) - (custom-theme-set-variables 'use-package - '(auto-revert-verbose nil) - '(global-auto-revert-non-file-buffers t)) - (global-auto-revert-mode +1)) - -(when (require 'comp nil t) - (custom-theme-set-variables 'use-package - '(native-comp-async-report-warnings-errors 'silent) - '(native-comp-deferred-compilation t))) - -(when (require 'custom nil t) - (custom-theme-set-variables 'use-package - '(custom-file (etc/ "custom.el")))) - -(when (require 'ediff nil t) - (custom-theme-set-variables 'use-package - '(ediff-window-setup-function #'ediff-setup-windows-plain))) - -(when (require 'eldoc nil t) - (custom-theme-set-variables 'use-package - '(eldoc-echo-area-use-multiline-p nil) - '(eldoc-idle-delay 0.1))) - -(when (require 'executable nil t) - (custom-theme-set-variables 'use-package - '(executable-prefix-env t))) - -(when (require 'files nil t) - (custom-theme-set-variables 'use-package - '(auto-save-default nil) - '(auto-save-interval 1) - '(auto-save-no-message t) - '(auto-save-timeout 1) - '(auto-save-visited-interval 1) - '(backup-by-copying t) - '(create-lockfiles nil) - '(delete-old-versions t) - '(find-file-visit-truename t) - '(kept-new-versions 8) - '(kept-old-versions 8) - '(mode-require-final-newline t) - '(version-control t) - '(view-read-only t)) - (dolist (h/f - '((after-save-hook . executable-make-buffer-file-executable-if-script-p) - (find-file-not-found-functions . create-missing-directories) - (find-file-hook . +vc-off@remote))) - (add-hook (car h/f) (cdr h/f))) - (auto-save-visited-mode)) - -(when (require 'frame nil t) - (custom-theme-set-variables 'use-package - '(blink-cursor-blinks 1) - '(blink-cursor-interval 0.25) - '(blink-cursor-delay 0.25)) - (blink-cursor-mode)) - -(when (require 'goto-addr nil t) - (if (fboundp 'global-goto-address-mode) - (global-goto-address-mode +1) - (add-hook 'after-change-major-mode-hook 'goto-address-mode))) - -(when (require 'ibuffer nil t) - (global-set-key (kbd "C-x C-b") #'ibuffer) - (add-hook 'ibuffer-mode-hook #'hl-line-mode)) - -(when (require 'image nil t) - (custom-theme-set-variables 'use-package - '(image-use-external-converter - (seq-some #'executable-find '("convert" "gm" "ffmpeg"))))) - -(when (require 'imenu nil t) - (custom-theme-set-variables 'use-package - '(imenu-auto-rescan t))) - -(when (require 'isearch nil t) - (custom-theme-set-variables 'use-package - '(regexp-search-ring-max default-ring-max) - '(search-ring-max default-ring-max))) - -(when (require 'minibuffer nil t) - (custom-theme-set-variables 'use-package - '(completion-category-defaults nil) - '(completion-category-overrides '((file (styles partial-completion)))) - '(completion-ignore-case t) - '(completion-styles '(substring partial-completion)) - '(enable-recursive-minibuffers t) - '(file-name-shadow-properties '(invisible t intangible t)) - '(minibuffer-eldef-shorten-default t) - '(minibuffer-prompt-properties '( read-only t - cursor-intangible t - face minibuffer-prompt)) - '(read-buffer-completion-ignore-case t)) - (file-name-shadow-mode) - (minibuffer-electric-default-mode)) - -(when (require 'mouse nil t) - (custom-theme-set-variables 'use-package - '(mouse-drag-copy-region t) - '(mouse-wheel-progressive-speed nil) - '(mouse-yank-at-point t))) - -(when (require 'paren nil t) - (custom-theme-set-variables 'use-package - '(show-paren-delay 0.01) - '(show-paren-style 'parenthesis) - '(show-paren-when-point-in-periphery t) - '(show-paren-when-point-inside-paren t)) - (show-paren-mode) - (electric-pair-mode)) - -(when (require 'recentf nil t) - (custom-theme-set-variables 'use-package - '(recentf-save-file (var/ "recentf.el")) - '(recentf-max-menu-items default-ring-max) - '(recentf-max-saved-items nil) - '(recentf-auto-cleanup 'mode)) - (add-to-list 'recentf-exclude etc/) - (add-to-list 'recentf-exclude var/) - (add-to-list 'recentf-exclude cache/) - (add-to-list 'recentf-exclude "-autoloads.el\\'") - (recentf-mode +1)) - -(when (require 'savehist nil t) - (custom-theme-set-variables 'use-package - '(history-length 1024) - '(history-delete-duplicates t) - '(savehist-file (var/ "savehist.el")) - '(savehist-save-minibuffer-history t) - '(savehist-autosave-interval 30) - ;; Other variables --- don't truncate any of these. - ;; `add-to-history' uses the values of these variables unless - ;; they're nil, in which case it falls back to `history-length'. - '(kill-ring-max default-ring-max) - '(mark-ring-max default-ring-max) - '(global-mark-ring-max default-ring-max) - '(regexp-search-ring-max default-ring-max) - '(search-ring-max default-ring-max) - '(kmacro-ring-max default-ring-max) - '(eww-history-limit default-ring-max)) - (dolist (var '(global-mark-ring - mark-ring - kill-ring - kmacro-ring - regexp-search-ring - search-ring)) - (add-to-list 'savehist-additional-variables var)) - (savehist-mode +1)) - -(when (require 'saveplace nil t) - (custom-theme-set-variables 'use-package - '(save-place-file (var/ "places.el")) - '(save-place-forget-unreadable-files (eq system-type 'gnu/linux))) - (save-place-mode 1)) - -(when (require 'uniquify nil t) - (custom-theme-set-variables 'use-package - '(uniquify-after-kill-buffer-p t) - '(uniquify-buffer-name-style 'forward) - '(uniquify-ignore-buffers-re "^\\*") - '(uniquify-separator path-separator))) - -(when (require 'vc nil t) - (custom-theme-set-variables 'use-package - '(vc-follow-symlinks t) - '(vc-make-backup-files t))) - -(when (require 'window nil t) - (custom-theme-set-variables 'use-package - '(recenter-positions '(top 2 middle bottom)))) - -;;; New features - -(when (fboundp 'pixel-scroll-precision-mode) - (pixel-scroll-precision-mode)) - -(provide 'acdw-defaults) -;;; acdw-defaults.el ends here diff --git a/lisp/acdw-funs.el b/lisp/acdw-funs.el deleted file mode 100644 index ed41a61..0000000 --- a/lisp/acdw-funs.el +++ /dev/null @@ -1,262 +0,0 @@ -;;; acdw-funs.el --- extra functions -*- lexical-binding: t -*- - - -;;; Cribs from CRUX --- Advice -;; https://github.com/bbatsov/crux - -;; All of these should go `:before' the function they're advising -(defun advise-region-or-buffer (&rest _) - "`:before' advice to work on the active region or whole buffer. -See also `with-region-or-buffer'." - (interactive (if mark-active - (list (region-beginning) (region-end)) - (list (point-min) (point-max))))) - -(defun advise-region-or-line (&rest _) - "`:before' advice to work on the active region or whole line. -See also `with-region-or-line'." - (interactive (if mark-active - (list (region-beginning) (region-end)) - (list (line-beginning-position) (line-end-position))))) - -(defun advise-region-or-to-eol (&rest _) - "`:before' advice to work on the active region or to end of line. -See also `with-region-or-to-eol'." - (INTERACTIVE (if mark-active - (list (region-beginning) (region-end)) - (list (point) (line-end-position))))) - - -;;; Other functions and whatnot - -(defun delete2 (list &rest elems) - "Delete each element of ELEMS, and the next item, from LIST." - (let ((r nil)) - (while (consp list) - (if (member (car list) elems) - (setf list (cdr list)) - (setf r (cons (car list) r))) - (setf list (cdr list))) - (reverse r))) - -(unless (fboundp 'ensure-list) - (defun ensure-list (object) - "Return OBJECT as a list. -If OBJECT is already a list, return OBJECT itself. If it's -not a list, return a one-element list containing OBJECT." - (if (listp object) - object - (list object)))) - -(defun +require (&rest features) - "Require FEATURES, plus my extras. -Each feature can be an atom (the feature name) or a list of the form -(FEATURE &optional FILENAME NOERROR), which is passed directly to -`require'. My extras are in lisp/ and named +FEATURE, so this -function will `require' them too---but not error if they don't -exist." - (dolist (feat features) - (apply #'require (ensure-list feat)) - (require (intern (format "+%s" feat)) nil :noerror))) - -;;; Improvements to default functions - -(defun +save-buffers-kill-terminal (arg) - "Delete the current frame, or quit Emacs. -This function is my customization of `save-buffers-kill-terminal'." - (interactive "P") - (cond (arg (delete-frame nil :force)) - ((= 1 (length (frame-list))) - (and (yes-or-no-p "Kill emacs? ") - (save-buffers-kill-emacs t))) - (:else (delete-frame)))) - -(defun really-quit-emacs (arg) - "Really, actually quit Emacs." - (interactive "P") - (cond (arg (save-buffers-kill-emacs t)) - (:else (save-buffers-kill-terminal t)))) - -(defun +cycle-spacing (&optional n) - ;; `cycle-spacing' is wildly different in 29.1 over 28. - "Negate N argument on `cycle-spacing'. -That is, with a positive N, deletes newlines as well, leaving -N -spaces. If N is negative, it will not delete newlines and leave -N spaces." - (interactive "*p") - (cycle-spacing (- n))) - -(defun delete-window|bury-buffer () - "Delete the current window, or bury the current buffer. -If the current window is the only window, bury the buffer." - (interactive) - (condition-case e - (delete-window) - (t (bury-buffer)))) - -(defun other-window|switch-buffer (arg) - "Call `other-window' or `switch-buffer' depending on windows. -When called with prefix ARG, unconditionally switch buffer." - (interactive "P") - (if (or arg (one-window-p)) - (switch-to-buffer (other-buffer) nil t) - (other-window 1))) - -(defun open-paragraph (&optional arg) - "Open a paragraph after paragraph at point. -A paragraph is defined as continguous non-empty lines of text -surrounded by empty lines, so opening a paragraph means to make -three blank lines, then place the point on the second one. - -Called with prefix ARG, open a paragraph before point." - ;; TODO: Take an integer as ARG, allowing for skipping paragraphs up and down. - (interactive "*P") - ;; Go to next blank line. This /isn't/ `end-of-paragraph-text' because - ;; that's weird with org, and I'm guessing other modes too. - (unless (looking-at "^$") (forward-line (if arg -1 +1))) - (while (and (not (looking-at "^$")) - (= 0 (forward-line (if arg -1 +1))))) - (newline) - (when arg (newline) (forward-line -2)) - (delete-blank-lines) - (newline 2) - (previous-line)) - -(defun +initial-buffer () - (if (equal (get-buffer "*Messages*") - (other-buffer)) - (get-buffer "*scratch*") - (other-buffer))) - -(defun open-paragraph (&optional arg) - "Open a paragraph after paragraph at point. -A paragraph is defined as continguous non-empty lines of text -surrounded by empty lines, so opening a paragraph means to make -three blank lines, then place the point on the second one. - -Called with prefix ARG, open a paragraph before point." - ;; TODO: Take an integer as ARG, allowing for skipping paragraphs up and down. - (interactive "*P") - ;; Go to next blank line. This /isn't/ `end-of-paragraph-text' because - ;; that's weird with org, and I'm guessing other modes too. - (unless (looking-at "^$") (forward-line (if arg -1 +1))) - (while (and (not (looking-at "^$")) - (= 0 (forward-line (if arg -1 +1))))) - (newline) - (when arg (newline) (forward-line -2)) - (delete-blank-lines) - (newline 2) - (previous-line)) - -(defun create-missing-directories () - "Automatically create missing directories when finding a file." - ;; https://emacsredux.com/blog/2022/06/12/auto-create-missing-directories/ - (let ((target-dir (file-name-directory buffer-file-name))) - (unless (file-exists-p target-dir) - (make-directory target-dir t)))) - -(defun +vc-off@remote () - (when (file-remote-p (buffer-file-name)) - (setq-local vc-handled-backends nil))) - -(defun +auto-save-some-buffers (&rest _) - "Quietly run `save-some-buffers'." - (let ((inhibit-message t)) - (with-temp-message "" - (save-some-buffers t)))) - -(defun comment-lines (str &optional comment-char) - "Comment each line of STR. -Returns the new, commented, string. - -If COMMENT-CHAR is missing or nil, use `comment-start'." - (mapconcat (lambda (ln) - (concat (or comment-char comment-start) - ln)) - (string-lines str) - "\n")) - -(defun clamp (value min max) - "Clamp VALUE between MIN and MAX." - (min max (max min value))) - -(define-minor-mode truncate-lines-local-mode - "Truncate lines locally in a buffer." - :lighter " ..." - :group 'display - (setq-local truncate-lines truncate-lines-local-mode)) - -(defun mapc-buffers (func &optional predicate) - "Map FUNC over buffers matching PREDICATE. -Both FUNC and PREDICATE will be executed with no arguments and in -the context of each buffer. - -If PREDICATE is nil or not given, map FUNC over all buffers." - (cl-loop for buf being the buffers - do (with-current-buffer buf - (when (and predicate - (funcall predicate)) - (funcall func))))) - -(defun mapc-buffers-modes (func &rest modes) - "Map FUNC over buffers derived from MODES. -FUNC will be executed with no arguments and in the context of -each buffer." - (mapc-buffers func - (lambda () - (apply #'derived-mode-p modes)))) - -(defun ++concat (func strings) - "Concat STRINGS processed by FUNC. -Each of STRINGS can be a bare string or a list. Strings are -passed through as-is, but lists are passed to FUNC first as -arguments. Finally, all the resulting strings are `mapconcat'-ed -together. - -As a special case, if `:separator' is the first of STRINGS, the -string following will be used as a separator. Otherwise, a -newline will be used." - (let (separator) - (when (eq (car strings) :separator) - (setq separator (cadr strings) - strings (cddr strings))) - (mapconcat (lambda (s) - (cond - ((listp s) (apply func s)) - ((stringp s) s) - (t (user-error "Bad argument: %S" s)))) - strings - (or separator "\n")))) - -(defun nconcat (&rest strings) - "Concat STRINGS separated by SEPARATOR. -If `:separator' is the first of STRINGS, the next string will be used to -separate the rest of STRINGS." - (++concat #'concat strings)) - -(defun format-concat (&rest strings) - "Concatenate formatted STRINGS. -Each of STRINGS can be a bare string or a list. Bare strings are passed as-is -to `mapconcat' for concatenation and separation. Lists, however, are passed to -`format' first. - -If `:separator' is the first of STRINGS, the next string will be -used as a separator." - (++concat #'format strings)) - -(defun choose-executable (&rest programs) - "Return the first of PROGRAMS that exists in the system's $PATH." - (seq-some #'executable-find programs)) - -;;; Update packages more better-er - -(defun +package-update-all () - "Update all packages and vc packages." - (interactive) - (package-update-all) - ;; WTF! - (let ((package-archives-nil)) - (package-vc-update-all))) - -(provide 'acdw-funs) -;;; acdw-funs.el ends here diff --git a/lisp/acdw-macs.el b/lisp/acdw-macs.el deleted file mode 100644 index e2258fa..0000000 --- a/lisp/acdw-macs.el +++ /dev/null @@ -1,293 +0,0 @@ -;;; acdw-macs.el --- extra macros -*- lexical-binding: t; -*- - -(eval-when-compile - (require 'cl-lib) - (require 'tempo) - (declare-function derived-mode-abbrev-table-name "tempo")) - -;;; Extra functionality for `eval-after-load' - -(defun eval-after-init (thunk) - "Evaluate THUNK after Emacs initiation, or now if already initialized." - (if after-init-time - (funcall thunk) - (add-hook 'after-init-hook thunk))) - -(defmacro eval-after (prereqs &rest body) - "Evaluate body after PREREQS. -PREREQS can be a feature, a number, `t', or a list of those. - -Features are used as arguments to `eval-after-load'. Numbers are -used as arguments to `run-with-idle-timer'. `t' will ensure BODY -runs after Emacs's init time. - -When given a list of PREREQS, `eval-after' will nest each one -from left to right." - (declare (indent 1) (debug (form def-body))) - (setf prereqs (ensure-list prereqs)) - (if (null prereqs) - (macroexp-progn body) - (let* ((this (car prereqs)) - (form `((lambda () (eval-after ,(cdr prereqs) ,@body))))) - (cond - ((eq this :init) - (append '(eval-after-init) form)) - ((numberp this) - (append `(run-with-idle-timer ,this nil) form)) - ((symbolp this) - (append `(eval-after-load ',this) form)) - (:else (user-error "Eval-after: Bad prereq: %S" this)))))) - - -;;; Easier customization of options -;; At some point it might be nice to include more forms in the VAR slots, like -;; `setup's `:option' macro. - -(if (fboundp 'setopt) - ;; Emacs 29 introduces `setopt', which does basically the same thing as the - ;; macro below. Not exactly the same, of course---it uses `setopt--set' - ;; instead of `customize-set-variable'---but I'm going to trust the Emacs - ;; devs on this one. - (defalias 'setc 'setopt) - (defmacro setc (&rest args) - "Customize user options in a `setq'-like way." - (declare (debug setq)) - (unless (zerop (mod (length args) 2)) - (signal 'wrong-number-of-arguments `(evenp ,(length args)))) - (let (form defuns) - (while args - (let* ((var (pop args)) - (val (pop args))) - (when (memq (car-safe val) '(defun defmacro)) - (push val defuns) - (setq val `(function ,(cadr val)))) - (push `(customize-set-variable ',var ,val "Set by `setc'.") - form))) - `(progn ,@(append (nreverse defuns) (nreverse form)))))) - - -;;; Extra def- forms - -(defmacro defdir (name directory &optional docstring) - "Define a variable and a function NAME expanding to DIRECTORY. -DOCSTRING is applied to the variable; its default is DIRECTORY's -path." - (declare (indent 2) (doc-string 3)) - `(progn - (defvar ,name ,directory - ,(concat (or docstring (format "%s" directory)) "\n" - "Defined by `defdir'.")) - (defun ,name (file &optional mkdir) - ,(concat "Expand FILE relative to variable `" (symbol-name name) "'.\n" - "If MKDIR is non-nil, parent directories are created.\n" - "Defined by `defdir'.") - (let ((file-name (expand-file-name - (convert-standard-filename file) ,name))) - (when mkdir - (make-directory (file-name-directory file-name) :parents)) - file-name)))) - -(defmacro defkeys (maps &rest bindings) - "Define key BINDINGS in MAPS. -If MAPS is nil or t, bind to `current-global-map'. Otherwise, -bind each of BINDINGS to the map or list of maps provided. - -BINDINGS is a `setq'-style list of pairs of keys and definitions. -The key part of each binding can be a string, in which case it's -passed to `kbd', or a vector or anything else `define-key' -accepts in the KEY position. The definition part, likewise, can -be any form `define-key' accepts in that position, with this -addition: if the form is a `defun' form, it will be defined -before any keys are bound." - (declare (indent 1)) - (unless (cl-evenp (length bindings)) - (signal 'wrong-number-of-arguments `(evenp ,(length bindings)))) - `(progn - ,@(cl-loop - for map in (ensure-list maps) - for first-map-p = t then nil - append - (cl-loop - for (keys def) on bindings by #'cddr - for defp = (memq (car-safe def) '(defmap defun defmacro)) - if (and defp first-map-p) collect def into defuns - append - (cl-loop - for key in (ensure-list keys) - collect (list 'define-key - (if (memq map '(t nil)) - '(current-global-map) - (or (car-safe map) map)) - (if (stringp key) - `(kbd ,key) - key) - (if defp - (cl-case (car def) - ((defmap) (cadr def)) - ((defun defmacro) `#',(cadr def)) - (otherwise (error "Bad def type: %S" - (car def)))) - def))) - into keydefs - finally return - (let ((all (append defuns keydefs))) - (if-let ((after (plist-get (cdr-safe map) :after))) - `((eval-after ,after - ,@all)) - all)))))) - -(defmacro defmap (name docstring &rest bindings) - "Define a keymap named NAME, with BINDINGS." - (declare (indent 1) (doc-string 2)) - `(,(if (boundp name) 'setq 'defvar) ,name - ;;; ^ probably a terrible hack - (let ((map (make-sparse-keymap))) - (defkeys map ,@bindings) - map) - ,@(unless (boundp name) (list docstring)))) - -(defmacro defhook (hooks &rest body) - "Define a function to hook into HOOKS. -NAME and ARGS are passed to the generated `defun' form. -Each hook in HOOKS can be the name of a hook or a list of the form -(HOOK DEPTH LOCAL), where each argument is the same as in -`add-hook'." - (declare (indent 1)) - (let* ((name (or (plist-get body :name) - (intern (format "%s/h" - (mapconcat - (lambda (h) - (string-remove-suffix - "-hook" - (if (and (consp h) - (caddr h)) - (format "%s:local" (car h)) - (format "%s" (or (car-safe h) - h))))) - (ensure-list hooks) - "|"))))) - (args (or (plist-get body :args) nil)) - (doc (or (plist-get body :doc) nil)) - (forms ; (DEFUN . FUNCS) - (cl-loop for form in (delete2 body :name :args :doc) - if (eq (car form) 'function) - collect form into funcs - else collect form into defuns - finally return (cons defuns funcs))) - (defun-forms (car forms)) - (func-forms (cdr forms))) - `(progn - ,@(when defun-forms - `((defun ,name ,args ,@(when doc (list doc)) ,@defun-forms))) - ,@(cl-loop for hook in (ensure-list hooks) - for h = (or (car-safe hook) hook) - for ha = (cdr-safe hook) - if defun-forms - collect `(add-hook ',h #',name ,@ha) - append - (cl-loop for fn in func-forms - collect `(add-hook ',h ,fn ,@ha)))))) - -;; (autoload FUNCTION FILE &optional DOCSTRING INTERACTIVE TYPE) -(defmacro defautoload (file &rest fns) - "Autoload FNS from FILE. -Each of FNS can be an atom (function name) or a list of the -form (FUNCTION ARGS), where ARGS is a plist. ARGS's possible -keys are `:doc' (docstring), `:interactive', and `:type', which are -used as the optional arguments to `autoload'. - -You can also pass `:interactive' and `:type' as keyword arguments -just after FILE, and they'll serve as the default for the -autoloaded FNS." - (declare (indent 1)) - (let ((interactive (plist-get fns :interactive)) - (type (plist-get fns :type)) - (fns (delete2 fns :interactive :type))) - `(progn - ,@(cl-loop for fn in fns - for name = (or (car-safe fn) fn) - for args = (cdr-safe fn) - collect - `(autoload ',name ,(format "%s" file) - ,(plist-get args :doc) - ,(or (plist-get args :interactive) - interactive) - ,(or (plist-get args :type) - type)))))) - - -;;; Miscellaneous - -(defmacro with-message (message &rest body) - "Display MESSAGE then execute BODY. -If BODY executes without errors, display MESSAGE...done." - (declare (indent 1)) - (let ((msym (gensym)) - (esym (gensym))) - `(let ((,msym ,message)) - (condition-case ,esym - (progn (message "%s..." ,msym) - ,@body) - (:success (message "%s...done" ,msym)) - (t (signal (car ,esym) (cdr ,esym))))))) - -(defmacro o (&rest fns) - "Compose FNS into a new function for one argument." - (if (null fns) - `(lambda (&rest args) args) - `(lambda (&rest args) - (apply - #',(car fns) - (ensure-list (apply (o ,@(cdr fns)) args)))))) - -(defmacro with-region-or-buffer (&rest funcs) - "Advise FUNCS with `advise-region-or-buffer'." - `(progn - ,@(cl-loop for fn in funcs - collect - `(advice-add ',fn :before #'advise-region-or-buffer)))) - -(defmacro with-region-or-line (&rest funcs) - "Advise FUNCS with `advise-region-or-line'." - `(progn - ,@(cl-loop for fn in funcs - collect - `(advice-add ',fn :before #'advise-region-or-line)))) - -(defmacro with-region-or-to-eol (&rest funcs) - "Advise FUNCS with `advise-region-or-to-eol'." - `(progn - ,@(cl-loop for fn in funcs - collect - `(advice-add ',fn :before #'advise-region-or-to-eol)))) - -(defmacro define-tempo (tag doc &rest elements) - "Define a template and add its tag to MODE's abbrev-table. -TAG, DOC, and ELEMENTS are passed to `tempo-define-template', which see. -ABBREV, if given, is the abbrev string to use for template expansion -under MODE's abbrev-table. If ABBREV isn't given, TAG will be used." - (declare (indent 1)) - (let* ((template (gensym)) - (tag (cond ((stringp tag) tag) - ((symbolp tag) (symbol-name tag)) - (t (user-error "TAG must be a string or symbol: %S" tag)))) - (mode (or (plist-get elements :mode) nil)) - (abbrev (or (plist-get elements :abbrev) tag)) - (taglist (or (plist-get elements :taglist) nil)) - (table (let ((tname (and mode (derived-mode-abbrev-table-name mode)))) - (while (and tname (not (memq tname abbrev-table-name-list))) - (setq tname (and (get mode 'derived-mode-parent) - (derived-mode-abbrev-table-name - (get mode 'derived-mode-parent))))) - (or tname 'global-abbrev-table))) - (elements (delete2 elements :mode :abbrev :taglist))) - `(let ((,template (tempo-define-template ,tag - ',elements - ,(or abbrev tag) - ,doc - ,taglist))) - (define-abbrev ,table ,tag "" ,template :system t) - (put ,template 'no-self-insert t)))) - -(provide 'acdw-macs) -;;; acdw-macs.el ends here diff --git a/lisp/acdw.el b/lisp/acdw.el deleted file mode 100644 index 30c4f44..0000000 --- a/lisp/acdw.el +++ /dev/null @@ -1,79 +0,0 @@ -;;; acdw.el --- Basic emacs shit for acdw -*- lexical-binding: t -*- - -;;; Code: - -(require 'acdw-funs) ; Extra functions -(require 'acdw-macs) ; Extra macros - -(defdir etc/ (locate-user-emacs-file "etc") - "Directory for package configuration files. -See `no-littering' for examples.") - -(defdir var/ etc/ - "Directory for package data file. -See `no-littering' for examples.") - -(defdir cache/ (if-let ((xdg-cache (getenv "XDG_CACHE_HOME"))) - (expand-file-name "emacs/" xdg-cache) - etc/) - "Directory for cache files.") - -(setq native-compile-target-directory (cache/ "eln" t)) -(when (fboundp 'startup-redirect-eln-cache) - (startup-redirect-eln-cache (cache/ "eln" t))) - -(defdir sync/ (expand-file-name "/home/case/Sync") - "My Syncthing directory.") - -(defdir private/ (sync/ "emacs/private")) -(add-to-list 'load-path private/) - -(require 'acdw-defaults) ; Sane defaults -(require '_acdw) ; Private stuff -(require '+lisp) ; Lispy goodness - -(setc enable-recursive-minibuffers t - completions-detailed t - completion-ignore-case t - read-buffer-completion-ignore-case t - read-file-name-completion-ignore-case t - initial-buffer-choice #'+initial-buffer - initial-scratch-message - (format "%s\n\n" - (comment-lines - (shell-command-to-string "fortune") - ";; ")) - sentence-end-double-space nil - save-silently t) - -(defkeys t - "M-o" #'other-window|switch-buffer - "C-x 0" #'delete-window|bury-buffer - "C-M-;" #'+lisp-comment-or-uncomment-sexp - "M-SPC" #'+cycle-spacing - "C-x C-k" #'kill-this-buffer) - -(defkeys t - "M-u" #'universal-argument) - -(defkeys universal-argument-map - "M-u" #'universal-argument-more) - -(define-advice switch-to-buffer (:after (&rest _) normal-mode) - "Automatically determine the mode for created non-file buffers." - (when-let ((_ (and (eq major-mode 'fundamental-mode))) - (buffer-file-name (buffer-name))) - (normal-mode))) - -(define-advice canonically-space-region - (:around (orig &rest args) double-space-sentences) - (let ((sentence-end-double-space t)) - (apply orig args))) - -(with-region-or-buffer indent-region) - -(winner-mode) - -(provide 'acdw) - -;;; acdw.el ends here diff --git a/lisp/graveyard.el b/lisp/graveyard.el deleted file mode 100644 index 89a776d..0000000 --- a/lisp/graveyard.el +++ /dev/null @@ -1,50 +0,0 @@ -;;; graveyard.el --- stuff i'm not currently using right now - -;;; Commentary: - -;; I spent a long time configuring these packages! And they're misbehaving, -;; boo. So into the graveyard they go. - -;;; Code: - -(use-package emms - :ensure t - :init - (require 'emms-setup) - (autoload #'+emms-streams "+emms" nil t) - (defkeys t "C-c p s" #'+emms-streams) - (defhook (emms-playlist-mode-hook - emms-browser-mode-hook - emms-show-all-mode-hook) - #'hl-line-mode - #'show-paren-mode) - :config - (require '+emms) - (emms-all) - (emms-default-players) - (emms-browser-make-filter "all" #'ignore) - (emms-browser-make-filter "recent" - (lambda (track) - (< 30 (time-to-number-of-days - (time-subtract (current-time) - (emms-info-track-file-mtime - track)))))) - (emms-browser-set-filter (assoc "all" emms-browser-filters)) - (emms-history-load) - (emms-playing-time-mode -1) - :bind - (("C-c p p" . emms-pause) - ("C-c p b" . emms-browser) - ("C-c p l" . emms-playlist-mode-go)) - :custom - (emms-source-file-default-directory (expand-file-name "~/var/music/")) - (emms-source-playlist-default-format 'm3u) - (emms-playlist-mode-center-when-go t) - (emms-playlist-default-major-mode 'emms-playlist-mode) - (emms-player-mpv-update-metadata t) - (emms-browser-covers #'emms-browser-cache-thumbnail-async) - (emms-browser-thumbnail-small-size 64) - (emms-browser-thumbnail-medium-size 128) - (emms-streams-file (expand-file-name "streams.emms" - emms-source-file-default-directory)) - (emms-mode-line-mode-line-function nil)) diff --git a/lisp/init-org.el b/lisp/init-org.el deleted file mode 100644 index d2d5e77..0000000 --- a/lisp/init-org.el +++ /dev/null @@ -1,144 +0,0 @@ -;;; init-org.el -*- lexical-binding: t; -*- - -(use-package org - :defer t - :custom - (org-adapt-indentation nil) - (org-auto-align-tags t) - (org-archive-mark-done t) - (org-fold-catch-invisible-edits 'show-and-error) - (org-clock-clocked-in-display 'mode-line) - (org-clock-string-limit 7) ; just the clock bit - - (org-clock-persist nil) - (org-confirm-babel-evaluate nil) - (org-cycle-separator-lines 0) - (org-directory (sync/ "org/" t)) - (org-fontify-done-headline t) - (org-fontify-quote-and-verse-blocks t) - (org-fontify-whole-heading-line t) - (org-hide-emphasis-markers t) - (org-html-coding-system 'utf-8-unix) - (org-image-actual-width (list (* (window-font-width) - (- fill-column 8)))) - (org-imenu-depth 3) - (org-indent-indentation-per-level 0) - (org-indent-mode-turns-on-hiding-stars nil) - (org-insert-heading-respect-content t) - (org-list-demote-modify-bullet '(("-" . "+") - ("+" . "-"))) - (org-log-done 'time) - (org-log-into-drawer t) - (org-num-skip-commented t) - (org-num-skip-unnumbered t) - (org-num-skip-footnotes t) - (org-outline-path-complete-in-steps nil) - (org-pretty-entities t) - (org-pretty-entities-include-sub-superscripts nil) - (org-refile-targets '((nil . (:maxlevel . 2)) - (org-agenda-files . (:maxlevel . 1)))) - (org-refile-use-outline-path 'file) - (org-special-ctrl-a/e t) - (org-special-ctrl-k t) - (org-src-fontify-natively t) - (org-src-tab-acts-natively t) - (org-src-window-setup 'current-window) - (org-startup-truncated nil) - (org-startup-with-inline-images t) - (org-tags-column 0) - (org-todo-keywords - '((sequence "TODO(t)" "WAIT(w@/!)" "ONGOING(o@)" - "|" "DONE(d!)" "ASSIGNED(a@/!)") - (sequence "|" "CANCELED(k@)") - (sequence "MEETING(m)"))) - (org-use-speed-commands t) - :config - (require '+org) - (defkeys org-mode-map - "C-M-k" #'kill-paragraph - "C-M-t" #'transpose-paragraphs - "RET" #'+org-return-dwim - "S-" #'+org-table-copy-down|+org-return-dwim - "C-c C-o" #'+org-open-at-point-dwim) - (setc org-ellipsis - (or (bound-and-true-p truncate-string-ellipsis) "…") - org-emphasis-alist - '(("*" org-bold) - ("/" org-italic) - ("_" org-underline) - ("=" org-verbatim) - ("~" org-code) - ("+" org-strikethrough))) - (defhook org-mode-hook - #'variable-pitch-mode - #'visual-fill-column-mode - #'turn-off-auto-fill - #'org-indent-mode - #'prettify-symbols-mode - #'abbrev-mode - (defhook ((before-save-hook nil :local)) - :name before-save@org-mode - (+org-hide-drawers-except-point) - (org-align-tags 'all)))) - -(use-package org-agenda - :custom - (org-agenda-skip-deadline-if-done t) - (org-agenda-skip-scheduled-if-done t) - (org-agenda-span 10) - (org-agenda-block-separator ?─) - (org-agenda-time-grid - '((daily today require-timed) - (800 1000 1200 1400 1600 1800 2000) - " ┄┄┄┄┄ " "┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄")) - (org-agenda-current-time-string - "← now ─────────────────────────────────────────────────") - (org-agenda-include-diary nil) ; I use the org-diary features - - (org-agenda-todo-ignore-deadlines 'near) - (org-agenda-todo-ignore-scheduled 'future) - (org-agenda-include-deadlines t) - (org-deadline-warning-days 0) - (org-agenda-show-future-repeats 'next) - (org-agenda-window-setup 'current-window) - (org-agenda-file-skip-regexp "sync-conflict") - :bind (("C-c a" . org-agenda)) - :config - (require '+org) - (advice-add 'org-agenda-files :filter-return #'org-agenda-files@skip-regexp) - (defhook org-agenda-mode-hook - (setq-local truncate-lines t) - #'hl-line-mode) - (defhook org-agenda-after-show-hook - #'org-narrow-to-subtree)) - -(use-package org-capture - :bind - (("C-c c" . org-capture))) - -(use-package ol ; org-link - :after org - :config - (require '+org) - (+org-link-define-type sms (number _)) - (+org-link-define-type tel (number _))) - -(use-package ox ; org-export - :defer t - :custom - (org-export-coding-system 'utf-8-unix) - (org-export-headline-levels 8) - (org-export-with-drawers nil) - (org-export-with-section-numbers nil) - (org-export-with-smart-quotes t) - (org-export-with-sub-superscripts t) - (org-export-with-toc nil) - :config - (require 'ox-md)) - -(use-package org-word-count - :load-path "~/src/emacs/org-word-count/" - :hook org-mode-hook) - -(provide 'init-org) -;;; init-org.el ends here diff --git a/lisp/upload-junk.el b/lisp/upload-junk.el deleted file mode 100644 index 5a9da84..0000000 --- a/lisp/upload-junk.el +++ /dev/null @@ -1,47 +0,0 @@ -;;; upload-junk.el --- Upload junk -*- lexical-binding: t; -*- - -;;; Code: - -(require 'tramp) - -(defvar upload-junk-ssh-host "hetzner" - "SSH host to upload to.") - -(defvar upload-junk-ssh-root "/junk" - "SSH root folder to upload to.") - -(defvar upload-junk-web-host "https://junk.acdw.net" - "Web host to link uploads to.") - -(defun upload-junk-file-name (&optional file) - "Return the uploaded filename for FILE." - (let ((file (or file "_.txt"))) - (format "tmp_%s_%x%x.%s" - (file-name-nondirectory (file-name-sans-extension file)) - (time-convert (current-time) 'integer) - (random (* 8 8 8 8)) - (or (file-name-extension file) "txt")))) - -(defun upload-junk-region (start end) - "Upload region from START to END to my server." - (interactive "r") - (let* ((s (buffer-substring-no-properties start end)) - (f (upload-junk-file-name (buffer-file-name))) - (w (format "%s/%s" upload-junk-web-host f))) - (with-temp-buffer - (insert s) - (write-file (format "/sshx:%s:%s/%s" - upload-junk-ssh-host - upload-junk-ssh-root - f))) - (kill-new w) - w)) - -(defun upload-junk-region-or-buffer () - (interactive) - (if (region-active-p) - (upload-junk-region (region-beginning) (region-end)) - (upload-junk-region (point-min) (point-max)))) - -(provide 'upload-junk) -;;; upload-junk.el ends here diff --git a/lisp/yoke.el b/lisp/yoke.el deleted file mode 100644 index ec84f56..0000000 --- a/lisp/yoke.el +++ /dev/null @@ -1,392 +0,0 @@ -;;; yoke.el --- Yoke configuration into your config -*- lexical-binding: t; -*- - -;; Copyright (C) 2022 Case Duckworth - -;; Author: Case Duckworth -;; Keywords: convenience -;; Package-Version: 0.61803398875 -;; Homepage: https://junk.acdw.net/yoke.el -;; Package-Requires: ((emacs "28.1")) - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Commentary: - -;; THIS IS A WORK IN PROGRESS. DON'T USE IT. - -;;; Code: - -(require 'cl-lib) -(require 'package-vc) - -;;; User options - -(defgroup yoke nil - "Customizations for `yoke'." - :group 'convenience - :prefix "yoke-") - -(defcustom yoke-directory package-user-dir - "Where to put yoked packages." - :type 'file) - -(defcustom yoke-cache-directory (locate-user-emacs-file "yoke-cache" - "~/.yoke-cache") - "Where to put cached yoke files, like downloaded HTTP packages." - :type 'file) - -(defcustom yoke-debug-on-error nil - "Whether to throw up the debugger on a yoke error. -If nil, errors will be inserted in the `yoke-message-buffer'.") - -;;; Variables - -(defvar yoke-message-buffer " *yoke*" - "The buffer used for yoke messages.") - -(defvar yoke-selected-packages nil - "List of packages managed by `yoke'.") - -(defvar yoke-backends '(file http package) - "Backends handled by `yoke'.") - -;;; Main functionality - -(defmacro yoke (package &rest body) - "Yoke a package into your Emacs session. -PACKAGE is either a symbol, in which case `yoke' expands to -basically a named `progn' (good for grouping configuration), or a -list of the form (NAME . ARGS), where ARGS can be one of the -following: - -- nil: install NAME using `package'. -- a property list describing a package specification. Valid - key/value pairs include - - `:backend' (symbol) - A symbol of the yoke backend to use for installing the - package. See `yoke-backends' for allowed backends. - - `:url' (string) - The URL of the package's repository or source. - - `:lisp-dir' (string) - The repository-relative name of the directory to use for - loading lisp sources. If not given, it defaults to the - repo's root directory. - - Other pairs may be valid for a given backend; see that - backend's `yoke-install' function for more details. - -BODY is executed in a `condition-case' so that errors won't keep -the rest of Emacs from initializing. BODY can also be prepended -by the following keyword arguments: - - `:after' (FEATURE...) - - `:require' (FEATURE...) - - `:depends' (PACKAGE-SPEC...) - - `:build' (ACTION...) - - `:unless' (PREDICATE) - - `:when' (PREDICATE) - -Other keywords are ignored. - -\(fn (PACKAGE [SPEC]) [BODY-ARGS] BODY...)" - (declare (indent 1)) - (let* ((name (or (car-safe package) package)) - (backend (yoke--pget package :backend)) - ;; Body keyword arguments - (after (plist-get body :after)) - (depends (plist-get body :depends)) - (req (plist-get body :require)) - (buildp (plist-member body :build)) - (build (plist-get body :build)) - (whenp (plist-member body :when)) - (when (if whenp (plist-get body :when) t)) - (unlessp (plist-member body :unless)) - (unless (if unlessp (plist-get body :unless) nil)) - ;; Body - (body (let ((b body) r) - (while (consp b) - (if (keywordp (car b)) - (setf b (cdr b)) - (setf r (cons (car b) r))) - (setf b (cdr b))) - (reverse r))) - (esym (make-symbol "yoke-error"))) - ;; Body modifiers. These are applied in reverse order (that is, the last - ;; one will be on the outside). - ;; --- Require the current package - (when req - (setf body - (append (let (reqs) - (dolist (r (ensure-list req) reqs) - (let* ((feat (if (eq r t) name r)) - (+feat (intern (format "+%s" feat)))) - (push `(require ',feat) reqs) - (push `(require ',+feat nil :noerror) reqs))) - (reverse reqs)) - body))) - ;; --- Install the package - (when (consp package) - (push `(yoke-install ',(car package) ,@(cdr package)) - body)) - ;; --- Dependencies - (when depends - (setf body - (append (cl-loop for dep in (ensure-list depends) - collect `(or (yoke-install ',@(ensure-list dep)) - (error "Dependency (%s): %S" - ',dep ',package))) - body))) - ;; --- Load after - (when after - (setf body `((yoke--eval-after ,(cl-subst name t after) ,@body)))) - ;; --- Conditional expansion - (when (or whenp unlessp) - (setf body - (append (cond - ((and whenp unlessp) - `((when (or (not ,when) ,unless) - (signal 'yoke-predicate - '(:when ,when :unless ,unless))))) - (whenp - `((unless ,when (signal 'yoke-predicate - '(:when ,when))))) - (unlessp - `((when ,unless (signal 'yoke-predicate - '(:unless ,unless)))))) - body))) - ;; Expansion - `(condition-case ,esym - (cl-letf (((symbol-function 'package--save-selected-packages) - #'ignore)) - ;; Body - ,@body) - (:success - ,(unless (atom package) - `(setf (alist-get ',name yoke-selected-packages) - (list ,@(cdr-safe package)))) - ',package) - (t ,(if yoke-debug-on-error - `(signal (car ,esym) (cdr ,esym)) - `(message "(yoke) %s: %s" (car ,esym) (cdr ,esym))))))) - -;;; Installing packages - -(defun yoke-install (name &rest args) - "Install package NAME, with ARGS." - (let ((custom-file null-device) - (inhibit-message (and (not (plist-member args :update)) - (not debug-on-error))) - (messages-buffer-name yoke-message-buffer)) - (funcall - (intern - (format "yoke-install-%s" - (or (plist-get args :backend) - (yoke--guess-backend (plist-get args :url)) - 'package))) - name args)) - (yoke--clean-load-path) - ;; Don't return nil - t) - -(defun yoke-install-package (name args &optional tries) - "Install package NAME with ARGS using `package' machinery. -TRIES is an internal variable." - (let ((package-user-dir yoke-directory) - (url (plist-get args :url)) - (update (plist-get args :update)) - (dirname (expand-file-name (format "%s" name) - yoke-directory)) - (tries (or tries 0)) - load-dir autoloads-file-name) - (unless (file-exists-p dirname) - (setq dirname (or (car-safe (file-expand-wildcards - (concat dirname "*"))) - dirname))) - (setq load-dir - (expand-file-name (or (plist-get args :lisp-dir) "") dirname) - generated-autoload-file - (expand-file-name (format "%s-autoloads.el" name) load-dir)) - (prog1 - (condition-case error - (cond - ;; -- Commented on 2022-12-21 - ;; ((and (file-exists-p dirname) - ;; (not update)) - ;; (add-to-list 'load-path - ;; (expand-file-name - ;; (or (plist-get args :lisp-dir) "") - ;; dirname) - ;; nil #'equal) - ;; (require (intern (format "%s-autoloads" name)))) - ((and url update) - (package-vc-update (cadr (assoc name package-alist)))) - (update - (package-update name)) - (url - ;; I'm going to be honest here, this is extremely cursed. But I - ;; don't want to get asked about installing the packages, and when - ;; the user answers 'no', the function errors. So.. this. - (cl-letf (((symbol-function 'yes-or-no-p) #'ignore)) - (ignore-errors (package-vc-install (cons name args))))) - (:else - (package-install name))) - (file-error (if (> tries 1) - (error "(yoke) Can't install `%s'" name) - (package-refresh-contents) - (yoke-install-package name args (1+ tries))))) - (add-to-list 'load-path load-dir nil #'equal) - (loaddefs-generate load-dir generated-autoload-file) - ;; Do it again, if it doesn't actually /generate/ anything - (when (eq 'provide - (with-current-buffer (find-file-noselect generated-autoload-file) - (read (buffer-substring (point-min) (point-max))))) - (loaddefs-generate load-dir generated-autoload-file nil nil nil - :generate-full)) - (load generated-autoload-file :noerror) - (kill-buffer (get-file-buffer generated-autoload-file)) - (package-activate name)))) - -(defun yoke-install-http (name args) - "Install a package NAME using ARGS from an http source." - (let* ((url (plist-get args :url)) - (cached (expand-file-name (file-name-nondirectory url) - yoke-cache-directory)) - (update (plist-get args :update))) - (unless url - (error "No URL for HTTP download: %S" (cons name args))) - (when (or (not (file-exists-p cached)) - update) - (make-directory yoke-cache-directory :parents) - (message "Downloading `%s'..." url) - (let* ((url-debug t) - (buf (url-retrieve-synchronously url))) - (with-current-buffer buf - (goto-char (point-min)) - (delete-region (point) (1+ (re-search-forward "^$"))) - (write-file cached 1) - (message "Downloading `%s'...Done." url)))) - (package-install-file cached))) - -(defun yoke-install-file (name args) - "Install package NAME using ARGS from a file on-disk." - (let ((url (plist-get args :url)) - (update (plist-get args :update)) - (dirname (expand-file-name (format "%s" name) yoke-directory))) - (if (file-exists-p url) - ;; This takes care of updating too. - (package-install-file url) - (error "(yoke) No such file: `%s'" url)))) - -;;; Other package transactions - -(defun yoke--choose-package () - "Choose a package from `yoke-selected-packages'." - (assoc (intern (completing-read "Package: " yoke-selected-packages)) - yoke-selected-packages)) - -(defun yoke-update (name &rest args) - (interactive (yoke--choose-package)) - (save-window-excursion - (apply #'yoke-install name (append '(:update t) - args)))) - -(defun yoke-update-all () - (interactive) - (dolist (pkg yoke-selected-packages) - (apply #'yoke-update pkg))) - -;;; Emacs integration - -(defun yoke-imenu-insinuate () - "Insinuate `yoke' forms for `imenu'." - (require 'imenu) - (setf (alist-get "Yoke" imenu-generic-expression nil nil #'equal) - (list "(yoke[[:space:]]*(?\\([^\t\n )]*\\)" - 1)) - (with-eval-after-load 'consult-imenu - (setf (alist-get ?y (plist-get (alist-get 'emacs-lisp-mode - consult-imenu-config) - :types)) - '("Yoke")))) - -;;; Utility functions - -(defun yoke--pget (spec prop &optional default) - "Get PROP's value from SPEC, a yoke specification. -If KEY doesn't exist, return DEFAULT." - (let ((pl (or (and (plistp spec) spec) - (cdr-safe spec)))) - (if (plist-member pl prop) - (plist-get pl prop) - default))) - -(defun yoke--guess-backend (url) - "Guess the backend to use from URL. -If inconclusive, return nil." - (cond - ((or (string-prefix-p "file:" url t) - (string-prefix-p "~" url) - (string-prefix-p "/" url)) - 'file) - (:else nil))) - -(defun yoke--clean-load-path () - (when-let ((first (string-remove-suffix "/" (car load-path))) - (second (string-remove-suffix "/" (cadr load-path))) - (_ (equal first second))) - (setf load-path (cdr load-path)) - (setf (car load-path) second))) - -(defun yoke--eval-after-init (fn) - "Evaluate FN after inititation, or now if Emacs is initialized. -FN is called with no arguments." - (if after-init-time - (funcall fn) - (add-hook 'after-init-hook fn))) - -(defmacro yoke--eval-after (prereqs &rest body) - "Evaluate body after PREREQS. -PREREQS can be a feature, a number, `:init', or a list of those. - -Features are used as arguments to `eval-after-load'. Numbers are -used as arguments to `run-with-idle-timer'. `:init' will ensure BODY -runs after Emacs's init time. - -When given a list of PREREQS, `eval-after' will nest each one -from left to right." - (declare (indent 1) (debug (form def-body))) - (setf prereqs (ensure-list prereqs)) - (if (null prereqs) - (macroexp-progn body) - (let* ((this (car prereqs)) - (form `((lambda () (yoke--eval-after ,(cdr prereqs) ,@body))))) - (cond - ((eq this :init) - (append '(yoke--eval-after-init) form)) - ((numberp this) - (append `(run-with-idle-timer ,this nil) form)) - ((symbolp this) - (append `(eval-after-load ',this) form)) - (:else (user-error "Eval-after: Bad prereq: %S" this)))))) - -(provide 'yoke) -;;; yoke.el ends here -- cgit 1.4.1-21-gabe81