diff options
Diffstat (limited to 'lisp/yoke.el')
-rw-r--r-- | lisp/yoke.el | 664 |
1 files changed, 352 insertions, 312 deletions
diff --git a/lisp/yoke.el b/lisp/yoke.el index 8ca94fd..ec84f56 100644 --- a/lisp/yoke.el +++ b/lisp/yoke.el | |||
@@ -1,271 +1,360 @@ | |||
1 | ;;; yoke.el --- make your editor work for YOU -*- lexical-binding: t; -*- | 1 | ;;; yoke.el --- Yoke configuration into your config -*- lexical-binding: t; -*- |
2 | ;; Copyright (C) 2022 C. Duckworth <acdw@acdw.net> | 2 | |
3 | ;; Copyright (C) 2022 Case Duckworth | ||
4 | |||
5 | ;; Author: Case Duckworth <case@bob> | ||
6 | ;; Keywords: convenience | ||
7 | ;; Package-Version: 0.61803398875 | ||
8 | ;; Homepage: https://junk.acdw.net/yoke.el | ||
9 | ;; Package-Requires: ((emacs "28.1")) | ||
10 | |||
11 | ;; This program is free software; you can redistribute it and/or modify | ||
12 | ;; it under the terms of the GNU General Public License as published by | ||
13 | ;; the Free Software Foundation, either version 3 of the License, or | ||
14 | ;; (at your option) any later version. | ||
15 | |||
16 | ;; This program is distributed in the hope that it will be useful, | ||
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
19 | ;; GNU General Public License for more details. | ||
20 | |||
21 | ;; You should have received a copy of the GNU General Public License | ||
22 | ;; along with this program. If not, see <https://www.gnu.org/licenses/>. | ||
3 | 23 | ||
4 | ;;; Commentary: | 24 | ;;; Commentary: |
5 | 25 | ||
6 | ;; What's the most basic functionality of a package manager? In my view, all a | 26 | ;; THIS IS A WORK IN PROGRESS. DON'T USE IT. |
7 | ;; package manager should do is fetch packages from wherever they are, and | ||
8 | ;; provide the system with a method of accessing those packages' functionality. | ||
9 | ;; In Emacs, this means downloading packages from the Internet and adding their | ||
10 | ;; directories to `load-path'. That's what `yoke' tries to do. | ||
11 | ;; | ||
12 | ;; In fact, that's /all/ `yoke' tries to do, on the package front. It doesn't | ||
13 | ;; automatically fetch dependencies. It doesnt' do much else of anything | ||
14 | ;; --- hell, it doesn't have to generate autoloads or build the dang source | ||
15 | ;; files if you don't want it to. /I/ have it do those things because I like a | ||
16 | ;; few creature comforts, but you can turn 'em off. | ||
17 | ;; | ||
18 | ;; Instead of focusing too much on installing packages, `yoke' works harder to | ||
19 | ;; group---to "yoke together," if you will---related configurations together, à | ||
20 | ;; la `use-package' or `setup'. I used both of those packages before and found | ||
21 | ;; each somewhat lacking, and what I really wanted was a fancy `progn' that I | ||
22 | ;; could put whatever I want inside. So that's basically what `yoke' is. It's | ||
23 | ;; a configuration macro that automatically fetches packages from their repos | ||
24 | ;; and tells Emacs where they are, then executes its body in a `cl-block' for | ||
25 | ;; ... reasons. That's it. | ||
26 | 27 | ||
27 | ;;; Code: | 28 | ;;; Code: |
28 | 29 | ||
29 | (require 'cl-lib) | 30 | (require 'cl-lib) |
31 | (require 'package-vc) | ||
30 | 32 | ||
31 | ;;; Customization options | 33 | ;;; User options |
32 | 34 | ||
33 | (defgroup yoke nil | 35 | (defgroup yoke nil |
34 | "Customizations for `yoke'." | 36 | "Customizations for `yoke'." |
35 | :group 'applications | 37 | :group 'convenience |
36 | :prefix "yoke-") | 38 | :prefix "yoke-") |
37 | 39 | ||
38 | (defcustom yoke-dir (locate-user-emacs-file "yoke") | 40 | (defcustom yoke-directory package-user-dir |
39 | "Where to put yoked packages." | 41 | "Where to put yoked packages." |
40 | :type 'file) | 42 | :type 'file) |
41 | 43 | ||
42 | (defcustom yoke-get-default-fn #'yoke-get-git | 44 | (defcustom yoke-cache-directory (locate-user-emacs-file "yoke-cache" |
43 | "Default function to get packages with." | 45 | "~/.yoke-cache") |
44 | :type 'function) | 46 | "Where to put cached yoke files, like downloaded HTTP packages." |
47 | :type 'file) | ||
48 | |||
49 | (defcustom yoke-debug-on-error nil | ||
50 | "Whether to throw up the debugger on a yoke error. | ||
51 | If nil, errors will be inserted in the `yoke-message-buffer'.") | ||
52 | |||
53 | ;;; Variables | ||
54 | |||
55 | (defvar yoke-message-buffer " *yoke*" | ||
56 | "The buffer used for yoke messages.") | ||
57 | |||
58 | (defvar yoke-selected-packages nil | ||
59 | "List of packages managed by `yoke'.") | ||
60 | |||
61 | (defvar yoke-backends '(file http package) | ||
62 | "Backends handled by `yoke'.") | ||
63 | |||
64 | ;;; Main functionality | ||
65 | |||
66 | (defmacro yoke (package &rest body) | ||
67 | "Yoke a package into your Emacs session. | ||
68 | PACKAGE is either a symbol, in which case `yoke' expands to | ||
69 | basically a named `progn' (good for grouping configuration), or a | ||
70 | list of the form (NAME . ARGS), where ARGS can be one of the | ||
71 | following: | ||
72 | |||
73 | - nil: install NAME using `package'. | ||
74 | - a property list describing a package specification. Valid | ||
75 | key/value pairs include | ||
76 | |||
77 | `:backend' (symbol) | ||
78 | A symbol of the yoke backend to use for installing the | ||
79 | package. See `yoke-backends' for allowed backends. | ||
80 | |||
81 | `:url' (string) | ||
82 | The URL of the package's repository or source. | ||
83 | |||
84 | `:lisp-dir' (string) | ||
85 | The repository-relative name of the directory to use for | ||
86 | loading lisp sources. If not given, it defaults to the | ||
87 | repo's root directory. | ||
45 | 88 | ||
46 | (defvar yoke-buffer "*yoke*" | 89 | Other pairs may be valid for a given backend; see that |
47 | "Buffer to use for yoke process output.") | 90 | backend's `yoke-install' function for more details. |
48 | 91 | ||
49 | (defvar yoke-dirs nil | 92 | BODY is executed in a `condition-case' so that errors won't keep |
50 | "List of directories managed by `yoke'.") | 93 | the rest of Emacs from initializing. BODY can also be prepended |
94 | by the following keyword arguments: | ||
51 | 95 | ||
52 | ;;; GET YOKED | 96 | `:after' (FEATURE...) |
53 | 97 | ||
54 | (defmacro yoke (package | 98 | `:require' (FEATURE...) |
55 | &rest body) | ||
56 | "Yoke PACKAGE to work with your Emacs. | ||
57 | Execute BODY afterward. | ||
58 | 99 | ||
59 | \(fn (PACKAGE [REPO REPO-KEYWORDS]) [BODY-KEYWORDS] BODY...)" | 100 | `:depends' (PACKAGE-SPEC...) |
101 | |||
102 | `:build' (ACTION...) | ||
103 | |||
104 | `:unless' (PREDICATE) | ||
105 | |||
106 | `:when' (PREDICATE) | ||
107 | |||
108 | Other keywords are ignored. | ||
109 | |||
110 | \(fn (PACKAGE [SPEC]) [BODY-ARGS] BODY...)" | ||
60 | (declare (indent 1)) | 111 | (declare (indent 1)) |
61 | (let* (;; State | 112 | (let* ((name (or (car-safe package) package)) |
62 | (pkg (cond ((consp package) (car package)) | 113 | (backend (yoke--pget package :backend)) |
63 | (:else package))) | 114 | ;; Body keyword arguments |
64 | (url (cond ((consp package) (cdr package)) | ||
65 | (:else nil))) | ||
66 | (pname (intern (format "yoke:%s" pkg))) | ||
67 | (dirvar '$yoke-dir) | ||
68 | ;; Keyword args --- TODO: Naming could probably be better. | ||
69 | (after (plist-get body :after)) | 115 | (after (plist-get body :after)) |
70 | (depends (plist-get body :depends)) | 116 | (depends (plist-get body :depends)) |
117 | (req (plist-get body :require)) | ||
118 | (buildp (plist-member body :build)) | ||
119 | (build (plist-get body :build)) | ||
71 | (whenp (plist-member body :when)) | 120 | (whenp (plist-member body :when)) |
121 | (when (if whenp (plist-get body :when) t)) | ||
72 | (unlessp (plist-member body :unless)) | 122 | (unlessp (plist-member body :unless)) |
73 | (when (cond (whenp (plist-get body :when)) | 123 | (unless (if unlessp (plist-get body :unless) nil)) |
74 | (:else t))) | ||
75 | (unless (cond (unlessp (plist-get body :unless)) | ||
76 | (:else nil))) | ||
77 | (autoload (cond ((plist-member body :autoload) | ||
78 | (plist-get body :autoload)) | ||
79 | (:else t))) | ||
80 | (pre (plist-get body :pre)) | ||
81 | ;; Body | 124 | ;; Body |
82 | (body (cl-loop for (this next) on body by #'cddr | 125 | (body (let ((b body) r) |
83 | unless (keywordp this) | 126 | (while (consp b) |
84 | append (list this next) into ret | 127 | (if (keywordp (car b)) |
85 | finally return (cond ((eq (car (last ret)) nil) | 128 | (setf b (cdr b)) |
86 | (butlast ret)) | 129 | (setf r (cons (car b) r))) |
87 | (:else ret)))) | 130 | (setf b (cdr b))) |
88 | (r (gensym))) | 131 | (reverse r))) |
89 | `(let ((,r (cl-block ,pname | 132 | (esym (make-symbol "yoke-error"))) |
90 | (condition-case err | 133 | ;; Body modifiers. These are applied in reverse order (that is, the last |
91 | (progn | 134 | ;; one will be on the outside). |
92 | ;; Pass `:when' or `:unless' clauses | 135 | ;; --- Require the current package |
93 | ,@(cond | 136 | (when req |
94 | ((and whenp unlessp) | 137 | (setf body |
95 | `((when (or (not ,when) ,unless) | 138 | (append (let (reqs) |
96 | (cl-return-from ,pname | 139 | (dolist (r (ensure-list req) reqs) |
97 | (format "%s (abort) :when %S :unless %S" | 140 | (let* ((feat (if (eq r t) name r)) |
98 | ',pname ',when ',unless))))) | 141 | (+feat (intern (format "+%s" feat)))) |
99 | (whenp | 142 | (push `(require ',feat) reqs) |
100 | `((unless ,when (cl-return-from ,pname | 143 | (push `(require ',+feat nil :noerror) reqs))) |
101 | (format "%s (abort) :when %S" | 144 | (reverse reqs)) |
102 | ',pname ',when))))) | 145 | body))) |
103 | (unlessp | 146 | ;; --- Install the package |
104 | `((when ,unless (cl-return-from ,pname | 147 | (when (consp package) |
105 | (format "%s (abort) :unless %S" | 148 | (push `(yoke-install ',(car package) ,@(cdr package)) |
106 | ',pname ',unless)))))) | 149 | body)) |
107 | ;; Evaluate `:pre' forms | 150 | ;; --- Dependencies |
108 | ,@pre | 151 | (when depends |
109 | ;; Get prerequisite packages | 152 | (setf body |
110 | ,@(cl-loop | 153 | (append (cl-loop for dep in (ensure-list depends) |
111 | for (pkg* . yoke-get-args) in depends | 154 | collect `(or (yoke-install ',@(ensure-list dep)) |
112 | collect `(or | 155 | (error "Dependency (%s): %S" |
113 | (let* ((pkg-spec (yoke-get ,@yoke-get-args | 156 | ',dep ',package))) |
114 | :dir ,(format "%s" pkg*))) | 157 | body))) |
115 | (dir (expand-file-name (or (plist-get (cdr pkg-spec) :load) | 158 | ;; --- Load after |
116 | "") | 159 | (when after |
117 | (car pkg-spec)))) | 160 | (setf body `((yoke--eval-after ,(cl-subst name t after) ,@body)))) |
118 | (and dir | 161 | ;; --- Conditional expansion |
119 | ,@(if autoload | 162 | (when (or whenp unlessp) |
120 | `((yoke-generate-autoloads ',pkg* dir)) | 163 | (setf body |
121 | '(t)) | 164 | (append (cond |
122 | (add-to-list 'yoke-dirs dir nil #'string=))) | 165 | ((and whenp unlessp) |
123 | (cl-return-from ,pname | 166 | `((when (or (not ,when) ,unless) |
124 | (format "Error fetching prerequiste: %s" | 167 | (signal 'yoke-predicate |
125 | ',pkg*)))) | 168 | '(:when ,when :unless ,unless))))) |
126 | ;; Download the package, generate autoloads | 169 | (whenp |
127 | ,@(when url | 170 | `((unless ,when (signal 'yoke-predicate |
128 | `((let* ((pkg-spec (yoke-get ,@url :dir ,(format "%s" pkg))) | 171 | '(:when ,when))))) |
129 | (,dirvar (expand-file-name (or (plist-get (cdr pkg-spec) :load) | 172 | (unlessp |
130 | "") | 173 | `((when ,unless (signal 'yoke-predicate |
131 | (car pkg-spec)))) | 174 | '(:unless ,unless)))))) |
132 | ,@(when autoload | 175 | body))) |
133 | `((yoke-generate-autoloads ',pkg ,dirvar))) | 176 | ;; Expansion |
134 | (add-to-list 'yoke-dirs ,dirvar nil #'string=)))) | 177 | `(condition-case ,esym |
135 | ;; Evaluate the body, optionally after the features in `:after' | 178 | (cl-letf (((symbol-function 'package--save-selected-packages) |
136 | ,@(cond (after | 179 | #'ignore)) |
137 | `((yoke-eval-after ,after ,@body))) | 180 | ;; Body |
138 | (:else body))) | 181 | ,@body) |
139 | (:success ',package) | 182 | (:success |
140 | (t (message "%s: %s (%s)" ',pname (car err) (cdr err)) | 183 | ,(unless (atom package) |
141 | nil))))) | 184 | `(setf (alist-get ',name yoke-selected-packages) |
142 | (when (stringp ,r) (message "%S" ,r)) | 185 | (list ,@(cdr-safe package)))) |
143 | ,r))) | 186 | ',package) |
144 | 187 | (t ,(if yoke-debug-on-error | |
145 | (defun yoke-get (url &rest args) | 188 | `(signal (car ,esym) (cdr ,esym)) |
146 | "\"Get\" URL and and put it in DIR, then add DIR to `load-path'. | 189 | `(message "(yoke) %s: %s" (car ,esym) (cdr ,esym))))))) |
147 | URL can be a string or a list of the form (TYPE URL). The | 190 | |
148 | download will be dispatched to the TYPE, or to | 191 | ;;; Installing packages |
149 | `yoke-get-default-fn' if only a string is given. | 192 | |
150 | ARGS is a plist with the following possible keys: | 193 | (defun yoke-install (name &rest args) |
151 | 194 | "Install package NAME, with ARGS." | |
152 | :dir DIRECTORY --- the directory to put the URL. | 195 | (let ((custom-file null-device) |
153 | :load DIRECTORY --- the directory (relative to the download path) | 196 | (inhibit-message (and (not (plist-member args :update)) |
154 | to add to `load-path'. | 197 | (not debug-on-error))) |
155 | :type TYPE --- one of `http', `git', or `file' --- how to | 198 | (messages-buffer-name yoke-message-buffer)) |
156 | download URL." | 199 | (funcall |
157 | (let* ((dir (plist-get args :dir)) | 200 | (intern |
158 | (load (plist-get args :load)) | 201 | (format "yoke-install-%s" |
159 | (type (or (plist-get args :type))) | 202 | (or (plist-get args :backend) |
160 | (path (cond | 203 | (yoke--guess-backend (plist-get args :url)) |
161 | ((eq type 'http) (yoke-get-http url dir)) | 204 | 'package))) |
162 | ((or (eq type 'git) | 205 | name args)) |
163 | (string-match-p (rx bos "git:") url)) | 206 | (yoke--clean-load-path) |
164 | (yoke-get-git url dir)) | 207 | ;; Don't return nil |
165 | ((or (eq type 'file) | 208 | t) |
166 | (string-match-p (rx bos (or "file:" "~" "/")) url)) | 209 | |
167 | (yoke-get-file url dir)) | 210 | (defun yoke-install-package (name args &optional tries) |
168 | ((stringp url) | 211 | "Install package NAME with ARGS using `package' machinery. |
169 | (funcall yoke-get-default-fn url dir)) | 212 | TRIES is an internal variable." |
170 | (:else (error "Uknown URL type: %S" url))))) | 213 | (let ((package-user-dir yoke-directory) |
171 | (cond | 214 | (url (plist-get args :url)) |
172 | ((file-exists-p path) | 215 | (update (plist-get args :update)) |
173 | (add-to-list 'load-path (expand-file-name (or load "") path)) | 216 | (dirname (expand-file-name (format "%s" name) |
174 | (cons path args)) | 217 | yoke-directory)) |
175 | (:else (error "Directory \"%s\" doesn't exist." path) | 218 | (tries (or tries 0)) |
176 | nil)))) | 219 | load-dir autoloads-file-name) |
177 | 220 | (unless (file-exists-p dirname) | |
178 | (defun yoke-get--guess-directory (path &optional dir) | 221 | (setq dirname (or (car-safe (file-expand-wildcards |
179 | "Guess directory from PATH and DIR, and return it. | 222 | (concat dirname "*"))) |
180 | If DIR is present and relative, resolve it relative to | 223 | dirname))) |
181 | `yoke-dir', or if it's absolute, leave it as-is. If DIR is | 224 | (setq load-dir |
182 | absent, return the final component of PATH resolved relative to | 225 | (expand-file-name (or (plist-get args :lisp-dir) "") dirname) |
183 | `yoke-dir'." | 226 | generated-autoload-file |
184 | (expand-file-name (or dir (file-name-nondirectory path)) | 227 | (expand-file-name (format "%s-autoloads.el" name) load-dir)) |
185 | yoke-dir)) | 228 | (prog1 |
186 | 229 | (condition-case error | |
187 | (defun yoke-get-http (url &optional dir) | 230 | (cond |
188 | "Download URL to DIR and return its directory. | 231 | ;; -- Commented on 2022-12-21 |
189 | If DIR isn't given, it's guessed from the final component of the | 232 | ;; ((and (file-exists-p dirname) |
190 | URL's path and placed under `yoke-dir'." | 233 | ;; (not update)) |
191 | (let* ((dir (yoke-get--guess-directory url dir)) | 234 | ;; (add-to-list 'load-path |
192 | (basename (file-name-nondirectory url)) | 235 | ;; (expand-file-name |
193 | ;; XXX: Is this the best idea?? PROBABLY NOT!!! Ideally I'd have | 236 | ;; (or (plist-get args :lisp-dir) "") |
194 | ;; a parameter (either dynamic var or passed in) that would give the | 237 | ;; dirname) |
195 | ;; name of the downloaded file. But that would take a bit of | 238 | ;; nil #'equal) |
196 | ;; re-engineering, I think. So for now, it stays thus. | 239 | ;; (require (intern (format "%s-autoloads" name)))) |
197 | (filename (expand-file-name | 240 | ((and url update) |
198 | (replace-regexp-in-string | 241 | (package-vc-update (cadr (assoc name package-alist)))) |
199 | (rx "-" (+ digit) ; major version | 242 | (update |
200 | (+ (group "." (+ digit))) ; following version numbers | 243 | (package-update name)) |
201 | (group "." (+ (not space)))) ; extension | 244 | (url |
202 | "\\2" | 245 | ;; I'm going to be honest here, this is extremely cursed. But I |
203 | basename) | 246 | ;; don't want to get asked about installing the packages, and when |
204 | dir))) | 247 | ;; the user answers 'no', the function errors. So.. this. |
205 | (cond ((file-exists-p filename) | 248 | (cl-letf (((symbol-function 'yes-or-no-p) #'ignore)) |
206 | dir) | 249 | (ignore-errors (package-vc-install (cons name args))))) |
207 | (:else | 250 | (:else |
208 | (message "Downloading %s..." url) | 251 | (package-install name))) |
209 | (with-current-buffer (let ((url-debug t)) | 252 | (file-error (if (> tries 1) |
210 | (url-retrieve-synchronously url)) | 253 | (error "(yoke) Can't install `%s'" name) |
211 | (condition-case e | 254 | (package-refresh-contents) |
212 | (progn | 255 | (yoke-install-package name args (1+ tries))))) |
213 | (goto-char (point-min)) | 256 | (add-to-list 'load-path load-dir nil #'equal) |
214 | (delete-region (point) (+ 1 (re-search-forward "^$"))) | 257 | (loaddefs-generate load-dir generated-autoload-file) |
215 | (make-directory dir :parents) | 258 | ;; Do it again, if it doesn't actually /generate/ anything |
216 | (write-file filename 1) | 259 | (when (eq 'provide |
217 | (message "Downloading %s... Done" url)) | 260 | (with-current-buffer (find-file-noselect generated-autoload-file) |
218 | (:success dir) | 261 | (read (buffer-substring (point-min) (point-max))))) |
219 | (t (signal (car e) (cdr e))))))))) | 262 | (loaddefs-generate load-dir generated-autoload-file nil nil nil |
220 | 263 | :generate-full)) | |
221 | (defun yoke-get-git (repo &optional dir) | 264 | (load generated-autoload-file :noerror) |
222 | "Clone REPO to DIR and return its directory. | 265 | (kill-buffer (get-file-buffer generated-autoload-file)) |
223 | If DIR isn't given, it's guessed from the repo's name and put | 266 | (package-activate name)))) |
224 | under `yoke-dir'. Return the cloned directory's name on success, | 267 | |
225 | or nil on failure." | 268 | (defun yoke-install-http (name args) |
226 | (let ((dir (yoke-get--guess-directory repo dir))) | 269 | "Install a package NAME using ARGS from an http source." |
227 | (cond ((file-exists-p dir) | 270 | (let* ((url (plist-get args :url)) |
228 | dir) | 271 | (cached (expand-file-name (file-name-nondirectory url) |
229 | (:else | 272 | yoke-cache-directory)) |
230 | (message "Cloning %s..." repo) | 273 | (update (plist-get args :update))) |
231 | (pcase (call-process "git" nil (get-buffer-create yoke-buffer) nil | 274 | (unless url |
232 | "clone" repo dir) | 275 | (error "No URL for HTTP download: %S" (cons name args))) |
233 | (0 (message "Cloning %s... Done" repo) | 276 | (when (or (not (file-exists-p cached)) |
234 | dir) | 277 | update) |
235 | (_ (message "Cloning %s... Error! See buffer %s for output." | 278 | (make-directory yoke-cache-directory :parents) |
236 | repo yoke-buffer) | 279 | (message "Downloading `%s'..." url) |
237 | nil)))))) | 280 | (let* ((url-debug t) |
238 | 281 | (buf (url-retrieve-synchronously url))) | |
239 | (defun yoke-get-file (file &optional _dir) | 282 | (with-current-buffer buf |
240 | "Add FILE's directory to `load-dir'. | 283 | (goto-char (point-min)) |
241 | _DIR is ignored." | 284 | (delete-region (point) (1+ (re-search-forward "^$"))) |
242 | (file-name-directory file)) | 285 | (write-file cached 1) |
243 | 286 | (message "Downloading `%s'...Done." url)))) | |
244 | (defun yoke-generate-autoloads (package dir) | 287 | (package-install-file cached))) |
245 | "Generate autoloads for PACKAGE in DIR." | 288 | |
246 | ;; Shamelessly stolen from `straight'. | 289 | (defun yoke-install-file (name args) |
247 | (eval-and-compile (require 'autoload)) | 290 | "Install package NAME using ARGS from a file on-disk." |
248 | (let ((generated-autoload-file | 291 | (let ((url (plist-get args :url)) |
249 | (expand-file-name (format "%s-autoloads.el" package) dir)) | 292 | (update (plist-get args :update)) |
250 | (backup-inhibited t) | 293 | (dirname (expand-file-name (format "%s" name) yoke-directory))) |
251 | (version-control 'never) | 294 | (if (file-exists-p url) |
252 | (message-log-max nil) | 295 | ;; This takes care of updating too. |
253 | (inhibit-message t)) | 296 | (package-install-file url) |
254 | (unless (file-exists-p generated-autoload-file) | 297 | (error "(yoke) No such file: `%s'" url)))) |
255 | (let ((find-file-hook nil) | 298 | |
256 | (write-file-functions nil) | 299 | ;;; Other package transactions |
257 | (debug-on-error nil) | 300 | |
258 | (left-margin 0)) | 301 | (defun yoke--choose-package () |
259 | (if (fboundp 'make-directory-autoloads) | 302 | "Choose a package from `yoke-selected-packages'." |
260 | (make-directory-autoloads dir generated-autoload-file) | 303 | (assoc (intern (completing-read "Package: " yoke-selected-packages)) |
261 | (and (fboundp 'update-directory-autoloads) | 304 | yoke-selected-packages)) |
262 | (update-directory-autoloads dir))))) | 305 | |
263 | (when-let ((buf (find-buffer-visiting generated-autoload-file))) | 306 | (defun yoke-update (name &rest args) |
264 | (kill-buffer buf)) | 307 | (interactive (yoke--choose-package)) |
265 | (load generated-autoload-file :noerror :nomessage) | 308 | (save-window-excursion |
266 | t)) | 309 | (apply #'yoke-install name (append '(:update t) |
267 | 310 | args)))) | |
268 | ;;; Evaluating forms after features | 311 | |
312 | (defun yoke-update-all () | ||
313 | (interactive) | ||
314 | (dolist (pkg yoke-selected-packages) | ||
315 | (apply #'yoke-update pkg))) | ||
316 | |||
317 | ;;; Emacs integration | ||
318 | |||
319 | (defun yoke-imenu-insinuate () | ||
320 | "Insinuate `yoke' forms for `imenu'." | ||
321 | (require 'imenu) | ||
322 | (setf (alist-get "Yoke" imenu-generic-expression nil nil #'equal) | ||
323 | (list "(yoke[[:space:]]*(?\\([^\t\n )]*\\)" | ||
324 | 1)) | ||
325 | (with-eval-after-load 'consult-imenu | ||
326 | (setf (alist-get ?y (plist-get (alist-get 'emacs-lisp-mode | ||
327 | consult-imenu-config) | ||
328 | :types)) | ||
329 | '("Yoke")))) | ||
330 | |||
331 | ;;; Utility functions | ||
332 | |||
333 | (defun yoke--pget (spec prop &optional default) | ||
334 | "Get PROP's value from SPEC, a yoke specification. | ||
335 | If KEY doesn't exist, return DEFAULT." | ||
336 | (let ((pl (or (and (plistp spec) spec) | ||
337 | (cdr-safe spec)))) | ||
338 | (if (plist-member pl prop) | ||
339 | (plist-get pl prop) | ||
340 | default))) | ||
341 | |||
342 | (defun yoke--guess-backend (url) | ||
343 | "Guess the backend to use from URL. | ||
344 | If inconclusive, return nil." | ||
345 | (cond | ||
346 | ((or (string-prefix-p "file:" url t) | ||
347 | (string-prefix-p "~" url) | ||
348 | (string-prefix-p "/" url)) | ||
349 | 'file) | ||
350 | (:else nil))) | ||
351 | |||
352 | (defun yoke--clean-load-path () | ||
353 | (when-let ((first (string-remove-suffix "/" (car load-path))) | ||
354 | (second (string-remove-suffix "/" (cadr load-path))) | ||
355 | (_ (equal first second))) | ||
356 | (setf load-path (cdr load-path)) | ||
357 | (setf (car load-path) second))) | ||
269 | 358 | ||
270 | (defun yoke--eval-after-init (fn) | 359 | (defun yoke--eval-after-init (fn) |
271 | "Evaluate FN after inititation, or now if Emacs is initialized. | 360 | "Evaluate FN after inititation, or now if Emacs is initialized. |
@@ -274,79 +363,30 @@ FN is called with no arguments." | |||
274 | (funcall fn) | 363 | (funcall fn) |
275 | (add-hook 'after-init-hook fn))) | 364 | (add-hook 'after-init-hook fn))) |
276 | 365 | ||
277 | (defmacro yoke-eval-after (features &rest body) | 366 | (defmacro yoke--eval-after (prereqs &rest body) |
278 | "Evaluate BODY, but only after loading FEATURES. | 367 | "Evaluate body after PREREQS. |
279 | FEATURES can be an atom or a list; as an atom it works like | 368 | PREREQS can be a feature, a number, `:init', or a list of those. |
280 | `with-eval-after-load'. The special feature `init' will evaluate | ||
281 | BODY after Emacs is finished initializing." | ||
282 | (declare (indent 1) | ||
283 | (debug (form def-body))) | ||
284 | (unless (listp features) | ||
285 | (setf features (list features))) | ||
286 | (if (null features) | ||
287 | (macroexp-progn body) | ||
288 | (let* ((this (car features)) | ||
289 | (rest (cdr features))) | ||
290 | (cond ((eq this 'init) | ||
291 | `(yoke--eval-after-init | ||
292 | (lambda () (yoke-eval-after ,rest ,@body)))) | ||
293 | (:else | ||
294 | `(with-eval-after-load ',this | ||
295 | (yoke-eval-after ,rest ,@body))))))) | ||
296 | 369 | ||
297 | ;;; Integration | 370 | Features are used as arguments to `eval-after-load'. Numbers are |
371 | used as arguments to `run-with-idle-timer'. `:init' will ensure BODY | ||
372 | runs after Emacs's init time. | ||
298 | 373 | ||
299 | (defun yoke-imenu-insinuate () | 374 | When given a list of PREREQS, `eval-after' will nest each one |
300 | "Insinuate `yoke' forms for `imenu'." | 375 | from left to right." |
301 | (require 'imenu) | 376 | (declare (indent 1) (debug (form def-body))) |
302 | (setf (alist-get "Yoke" imenu-generic-expression nil nil #'equal) | 377 | (setf prereqs (ensure-list prereqs)) |
303 | (list (rx (: "(yoke" (+ space) (? "(") | 378 | (if (null prereqs) |
304 | (group (+ (not (or "(" " " "\t" "\n")))) | 379 | (macroexp-progn body) |
305 | (* any))) | 380 | (let* ((this (car prereqs)) |
306 | 1))) | 381 | (form `((lambda () (yoke--eval-after ,(cdr prereqs) ,@body))))) |
307 | 382 | (cond | |
308 | ;;; Package maintenance | 383 | ((eq this :init) |
309 | 384 | (append '(yoke--eval-after-init) form)) | |
310 | (defvar yoke--all "*all*" | 385 | ((numberp this) |
311 | "Value that `yoke--prompt-for-package' uses for all packages.") | 386 | (append `(run-with-idle-timer ,this nil) form)) |
312 | 387 | ((symbolp this) | |
313 | (defun yoke--choose-packages (prompt &optional onep) | 388 | (append `(eval-after-load ',this) form)) |
314 | "Choose from all of yoke's installed packages." | 389 | (:else (user-error "Eval-after: Bad prereq: %S" this)))))) |
315 | (funcall (if onep #'completing-read #'completing-read-multiple) | ||
316 | prompt | ||
317 | (cons yoke--all yoke-dirs) | ||
318 | nil :require-match nil nil | ||
319 | (unless onep yoke--all))) | ||
320 | |||
321 | (defun yoke--choices (&optional selections) | ||
322 | "Either the SELECTIONS given, or all of `yoke-dirs'. | ||
323 | If `yoke--all' is part of SELECTIONS, or if it's not given, | ||
324 | return the full list of `yoke-dirs'." | ||
325 | (cond ((or (null selections) | ||
326 | (member yoke--all selections)) | ||
327 | yoke-dirs) | ||
328 | (:else selections))) | ||
329 | |||
330 | (defun yoke-compile (&rest packages) | ||
331 | "Compile all elisp files in `yoke-dirs'." | ||
332 | (interactive (yoke--choose-packages "Compile packages: ")) | ||
333 | (dolist (dir (yoke--choices packages)) | ||
334 | (byte-recompile-directory dir 0))) | ||
335 | |||
336 | (defun yoke-update-autoloads (&rest packages) | ||
337 | "Update the autoloads in PACKAGES' directories." | ||
338 | (interactive (yoke--choose-packages "Generate autoloads for packages: ")) | ||
339 | (dolist (dir (yoke--choices packages)) | ||
340 | (message "Generating autoloads for %s..." dir) | ||
341 | (yoke-generate-autoloads (file-name-nondirectory dir) dir) | ||
342 | (message "Generating autoloads for %s... Done" dir))) | ||
343 | |||
344 | (defun yoke-remove (dir) | ||
345 | "Remove DIR from `yoke-dir'." | ||
346 | (interactive | ||
347 | (list (completing-read "Remove: " yoke-dirs | ||
348 | nil :require-match))) | ||
349 | (delete-directory dir :recursive :trash)) | ||
350 | 390 | ||
351 | (provide 'yoke) | 391 | (provide 'yoke) |
352 | ;;; yoke.el ends here | 392 | ;;; yoke.el ends here |