about summary refs log tree commit diff stats
path: root/lisp
diff options
context:
space:
mode:
authorCase Duckworth2022-10-28 19:43:12 -0500
committerCase Duckworth2022-10-28 19:43:12 -0500
commita729a61c0a1cad6e99dd6f56dfd35e8ff141521e (patch)
tree59c0fb4ae752455e381d41eebeb08effbff4c679 /lisp
parentuhhhhh (diff)
downloademacs-a729a61c0a1cad6e99dd6f56dfd35e8ff141521e.tar.gz
emacs-a729a61c0a1cad6e99dd6f56dfd35e8ff141521e.zip
total rewrite of `yoke'
Diffstat (limited to 'lisp')
-rw-r--r--lisp/yoke.el395
1 files changed, 245 insertions, 150 deletions
diff --git a/lisp/yoke.el b/lisp/yoke.el index e7a6fe9..46d30d5 100644 --- a/lisp/yoke.el +++ b/lisp/yoke.el
@@ -1,184 +1,279 @@
1;;; yoke.el --- yoke packages in to your editing system -*- lexical-binding: t; -*- 1;;; yoke.el --- make your editor work for YOU -*- lexical-binding: t; -*-
2;; by C. Duckworth <acdw@acdw.net> 2;; Copyright (C) 2022 C. Duckworth <acdw@acdw.net>
3(provide 'yoke) 3
4;;; Commentary:
5
6;; What's the most basic functionality of a package manager? In my view, all a
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;;; Code:
28
4(require 'cl-lib) 29(require 'cl-lib)
5 30
31;;; Customization options
32
6(defgroup yoke nil 33(defgroup yoke nil
7 "Customizations for yoke, a package manager thing." 34 "Customizations for `yoke'."
8 :group 'applications 35 :group 'applications
9 :prefix "yoke-") 36 :prefix "yoke-")
10 37
11(defcustom yoke-dir (locate-user-emacs-file "yoke") 38(defcustom yoke-dir (locate-user-emacs-file "yoke")
12 "Where yoke packages live." 39 "Where to put yoked packages."
13 :type 'file) 40 :type 'file)
14 41
15(defun yoke-repo-local-p (repo) 42(defcustom yoke-get-default-fn #'yoke-get-git
16 (string-match-p (rx bos (or "." "~" "/")) repo)) 43 "Default function to get packages with."
17 44 :type 'function)
18(defun yoke-repo-dir (pkg repo) 45
19 (if (yoke-repo-local-p repo) 46(defvar yoke-buffer "*yoke*"
20 (expand-file-name repo) 47 "Buffer to use for yoke process output.")
21 (expand-file-name (format "%s" pkg) yoke-dir))) 48
22 49;;; GET YOKED
23(defun yoke-git (repo &optional dir) 50
24 "Git REPO from the internet and put it into `yoke-dir'. 51(defmacro yoke (package
25If DIR is passed, clone there; otherwise just clone. Return the 52 &rest body)
26directory created." 53 "Yoke PACKAGE to work with your Emacs.
27 (let ((dir (or dir (yoke-repo-dir (file-name-nondirectory repo) repo)))) 54Execute BODY afterward.
28 (unless (or (yoke-repo-local-p repo) (file-exists-p dir)) 55
29 (message "Downloading %S..." repo) 56\(fn (PACKAGE [REPO REPO-KEYWORDS]) [BODY-KEYWORDS] BODY...)"
30 (call-process "git" nil (get-buffer-create "*yoke*") nil
31 "clone" repo dir)
32 (message "Downloading %S... done" repo))
33 dir))
34
35(defun yoke-lasso (pkg repo &optional load-path)
36 "Add PKG to `load-path' so it can be used.
37If PKG is not installed, install it from REPO. Packages will be
38installed to `yoke-dir'."
39 (let* ((dir (yoke-repo-dir pkg repo)))
40 (yoke-git repo dir)
41 (cond
42 ((file-exists-p dir)
43 (when (or load-path dir)
44 (add-to-list 'load-path (expand-file-name (or load-path dir))))
45 ;; This bit is stolen from `straight'.
46 (eval-and-compile (require 'autoload))
47 (let ((generated-autoload-file
48 (expand-file-name (format "%s-autoloads.el" pkg) dir))
49 (backup-inhibited t)
50 (version-control 'never)
51 (message-log-max nil)
52 (inhibit-message t))
53 (unless (file-exists-p generated-autoload-file)
54 (let ((find-file-hook nil)
55 (write-file-functions nil)
56 (debug-on-error nil)
57 (left-margin 0))
58 (if (fboundp 'make-directory-autoloads)
59 (make-directory-autoloads dir generated-autoload-file)
60 (and (fboundp 'update-directory-autoloads)
61 (update-directory-autoloads dir)))))
62 (when-let ((buf (find-buffer-visiting generated-autoload-file)))
63 (kill-buffer buf))
64 (load generated-autoload-file :noerror :nomessage)))
65 (t (user-error "Directory \"%s\" doesn't exist." dir)))
66 dir))
67
68(defun yoke-get (key args)
69 "Get KEY's value from ARGS, or return nil.
70Similar-ish to `plist-get', but works on non-proper plists."
71 (cond
72 ((null args) nil)
73 ((eq key (car args)) (cadr args))
74 (t (yoke-get key (cdr args)))))
75
76(defmacro when1 (test &rest body)
77 "Like `when', but return the value of the test."
78 (declare (indent 1)) 57 (declare (indent 1))
79 (let ((g (gensym))) 58 (let* (;; State
80 `(let ((,g ,test)) 59 (pkg (cond ((consp package) (car package))
81 (when ,g 60 (:else package)))
82 ,@body 61 (url (cond ((consp package) (cdr package))
83 ,g)))) 62 (:else nil)))
84 63 (pname (intern (format "yoke:%s" pkg)))
85(defun delete2 (list &rest elems) 64 (dirvar (gensym "yoke-dir-"))
86 "Delete each element of ELEMS, and the next item, from LIST." 65 ;; Keyword args
87 (let ((r nil)) 66 (after (plist-get body :after))
88 (while (consp list) 67 (depends (plist-get body :depends))
89 (if (member (car list) elems) 68 (whenp (plist-member body :when))
90 (setf list (cdr list)) 69 (unlessp (plist-member body :unless))
91 (setf r (cons (car list) r))) 70 (when (cond (whenp (plist-get body :when))
92 (setf list (cdr list))) 71 (:else t)))
93 (reverse r))) 72 (unless (cond (unlessp (plist-get body :unless))
94 73 (:else nil)))
95(defun eval-after-init (fn) 74 (autoload (cond ((plist-member body :autoload)
75 (plist-get body :autoload))
76 (:else t)))
77 ;; Body
78 (body (cl-loop for (this next) on body by #'cddr
79 unless (keywordp this)
80 append (list this next) into ret
81 finally return (cond ((eq (car (last ret)) nil)
82 (butlast ret))
83 (:else ret)))))
84 `(cl-block ,pname
85 (condition-case err
86 (progn
87 ;; Pass `:when' or `:unless' clauses
88 ,@(cond
89 ((and whenp unlessp)
90 `((when (or (not ,when) ,unless)
91 (cl-return-from ,pname
92 (format "%s (abort) :when %S :unless %S"
93 ',pname ',when ',unless)))))
94 (whenp
95 `((unless ,when (cl-return-from ,pname
96 (format "%s (abort) :when %S"
97 ',pname ',when)))))
98 (unlessp
99 `((when ,unless (cl-return-from ,pname
100 (format "%s (abort) :unless %S"
101 ',pname ',unless))))))
102 ;; Get prerequisite packages
103 ,@(cl-loop
104 for (pkg* . yoke-get-args) in depends
105 collect `(or (let ((dir (yoke-get ,@yoke-get-args
106 :dir ,(format "%s" pkg*))))
107 (and dir
108 ,@(if autoload
109 `((yoke-generate-autoloads ',pkg* dir))
110 '(t))))
111 (cl-return-from ,pname
112 (format "Error fetching prerequiste: %s"
113 ',pkg*))))
114 ;; Download the package, generate autoloads
115 ,@(when url
116 `((let ((,dirvar (yoke-get ,@url :dir ,(format "%s" pkg))))
117 ,@(when autoload
118 `((yoke-generate-autoloads ',pkg ,dirvar))))))
119 ;; Evaluate the body, optionally after the features in `:after'
120 ,@(cond (after
121 `((eval-after ,after ,@body)))
122 (:else body)))
123 (:success ',package)
124 (t (message "%s: %s (%s)" ',pname (car err) (cdr err))
125 nil)))))
126
127(defun yoke-get (url &rest args)
128 "\"Get\" URL and and put it in DIR, then add DIR to `load-path'.
129URL can be a string or a list of the form (TYPE URL). The
130download will be dispatched to the TYPE, or to
131`yoke-get-default-fn' if only a string is given.
132ARGS is a plist with the following possible keys:
133
134:dir DIRECTORY --- the directory to put the URL.
135:load DIRECTORY --- the directory (relative to the download path)
136 to add to `load-path'.
137:type TYPE --- one of `http', `git', or `file' --- how to
138 download URL."
139 (let* ((dir (plist-get args :dir))
140 (load (plist-get args :load))
141 (type (plist-get args :type))
142 (path (cond
143 ((eq type 'http) (yoke-get-http url dir))
144 ((or (eq type 'git)
145 (string-match-p (rx bos "git:") url))
146 (yoke-get-git url dir))
147 ((or (eq type 'file)
148 (string-match-p (rx bos (or "file:" "~" "/")) url))
149 (yoke-get-file url dir))
150 ((stringp url)
151 (funcall yoke-get-default-fn url dir))
152 (:else (error "Uknown URL type: %S" url)))))
153 (cond
154 ((file-exists-p path)
155 (add-to-list 'load-path (expand-file-name (or load "") path))
156 path)
157 (:else (error "Directory \"%s\" doesn't exist." path)
158 nil))))
159
160(defun yoke-get--guess-directory (path &optional dir)
161 "Guess directory from PATH and DIR, and return it.
162If DIR is present and relative, resolve it relative to
163`yoke-dir', or if it's absolute, leave it as-is. If DIR is
164absent, return the final component of PATH resolved relative to
165`yoke-dir'."
166 (expand-file-name (or dir (file-name-nondirectory path))
167 yoke-dir))
168
169(defun yoke-get-http (url &optional dir)
170 "Download URL to DIR and return its directory.
171If DIR isn't given, it's guessed from the final component of the
172URL's path and placed under `yoke-dir'."
173 (let* ((dir (yoke-get--guess-directory url dir))
174 (basename (file-name-nondirectory url))
175 (filename (expand-file-name basename dir)))
176 (cond ((file-exists-p filename)
177 dir)
178 (:else
179 (message "Downloading %s..." url)
180 (with-current-buffer (let ((url-debug t))
181 (url-retrieve-synchronously url))
182 (condition-case e
183 (progn
184 (make-directory dir :parents)
185 (write-file filename 1)
186 (message "Downloading %s... Done" url))
187 (:success dir)
188 (t (signal (car e) (cdr e)))))))))
189
190(defun yoke-get-git (repo &optional dir)
191 "Clone REPO to DIR and return its directory.
192If DIR isn't given, it's guessed from the repo's name and put
193under `yoke-dir'. Return the cloned directory's name on success,
194or nil on failure."
195 (let ((dir (yoke-get--guess-directory repo dir)))
196 (cond ((file-exists-p dir)
197 dir)
198 (:else
199 (message "Cloning %s..." repo)
200 (pcase (call-process "git" nil (get-buffer-create yoke-buffer) nil
201 "clone" repo dir)
202 (0 (message "Cloning %s... Done" repo)
203 dir)
204 (_ (message "Cloning %s... Error! See buffer %s for output."
205 repo yoke-buffer)
206 nil))))))
207
208(defun yoke-get-file (file &optional _dir)
209 "Add FILE's directory to `load-dir'.
210_DIR is ignored."
211 (file-name-directory file))
212
213(defun yoke-generate-autoloads (package dir)
214 "Generate autoloads for PACKAGE in DIR."
215 ;; Shamelessly stolen from `straight'.
216 (eval-and-compile (require 'autoload))
217 (let ((generated-autoload-file
218 (expand-file-name (format "%s-autoloads.el" package) dir))
219 (backup-inhibited t)
220 (version-control 'never)
221 (message-log-max nil)
222 (inhibit-message t))
223 (unless (file-exists-p generated-autoload-file)
224 (let ((find-file-hook nil)
225 (write-file-functions nil)
226 (debug-on-error nil)
227 (left-margin 0))
228 (if (fboundp 'make-directory-autoloads)
229 (make-directory-autoloads dir generated-autoload-file)
230 (and (fboundp 'update-directory-autoloads)
231 (update-directory-autoloads dir)))))
232 (when-let ((buf (find-buffer-visiting generated-autoload-file)))
233 (kill-buffer buf))
234 (load generated-autoload-file :noerror :nomessage)
235 t))
236
237;;; Evaluating forms after features
238
239(defun yoke--eval-after-init (fn)
96 "Evaluate FN after inititation, or now if Emacs is initialized. 240 "Evaluate FN after inititation, or now if Emacs is initialized.
97FN is called with no arguments." 241FN is called with no arguments."
98 (if after-init-time 242 (if after-init-time
99 (funcall fn) 243 (funcall fn)
100 (add-hook 'after-init-hook fn))) 244 (add-hook 'after-init-hook fn)))
101 245
102(defmacro eval-after (features &rest body) 246(defmacro yoke-eval-after (features &rest body)
103 "Evaluate BODY, but only after loading FEATURES. 247 "Evaluate BODY, but only after loading FEATURES.
104FEATURES can be an atom or a list; as an atom it works like 248FEATURES can be an atom or a list; as an atom it works like
105`with-eval-after-load'. The special feature `init' will evaluate 249`with-eval-after-load'. The special feature `init' will evaluate
106BODY after Emacs is finished initializing." 250BODY after Emacs is finished initializing."
107 (declare (indent 1) 251 (declare (indent 1)
108 (debug (form def-body))) 252 (debug (form def-body)))
109 (if (eq features 'init) 253 (unless (listp features)
110 `(eval-after-init (lambda () ,@body)) 254 (setf features (list features)))
111 (unless (listp features) 255 (if (null features)
112 (setf features (list features))) 256 (macroexp-progn body)
113 (if (null features) 257 (let* ((this (car features))
114 (macroexp-progn body) 258 (rest (cdr features)))
115 (let* ((this (car features)) 259 (cond ((eq this 'init)
116 (rest (cdr features))) 260 `(yoke--eval-after-init
117 `(with-eval-after-load ',this 261 (lambda () (eval-after ,rest ,@body))))
118 (eval-after ,rest ,@body)))))) 262 (:else
119 263 `(with-eval-after-load ',this
120(defun yoke-pkg-name (pkg) 264 (yoke-eval-after ,rest ,@body)))))))
121 (intern (format "yoke:%s" pkg)))
122
123(cl-defmacro yoke (pkg
124 &optional repo
125 &body body
126 &key
127 after ; :after (FEATURE...)
128 depends ; :depends ((PKG REPO)...)
129 load ; :load DIRECTORY
130 (when t whenp) ; :when PREDICATE
131 (unless nil unlessp) ; :unless PREDICATE
132 &allow-other-keys)
133 "Yoke a PKG into your Emacs session."
134 (declare (indent 2))
135 (let ((name (yoke-pkg-name pkg))
136 (body (delete2 body
137 :depends :when :unless :after :load)))
138 `(cl-block ,name
139 (condition-case e
140 (progn
141 ,@(cond
142 ((and whenp unlessp)
143 `((when (or (not ,when) ,unless)
144 (cl-return-from ,name nil))))
145 (whenp `((unless ,when (cl-return-from ,name nil))))
146 (unlessp `((when ,unless (cl-return-from ,name nil)))))
147 ,@(cl-loop for (pkg* repo* load-path*) in depends
148 collect `(or (yoke-lasso ',pkg* ,repo* ,load-path*)
149 (cl-return-from ,name nil)))
150 ,@(cond
151 (repo `((yoke-lasso ',pkg ,repo ,load)))
152 (load `((add-to-list 'load-path ,load))))
153 ,@(if after
154 `((eval-after ,after ,@body))
155 body))
156 (:success ',pkg)
157 (t (message "%s: %s" ',name e))))))
158 265
159;;; Extras 266;;; Integration
160 267
161(defun yoke-imenu-insinuate () 268(defun yoke-imenu-insinuate ()
162 "Insinuate `yoke' forms for `imenu'." 269 "Insinuate `yoke' forms for `imenu'."
163 (require 'imenu) 270 (require 'imenu)
164 (setf (alist-get "Yoke" imenu-generic-expression nil nil #'equal) 271 (setf (alist-get "Yoke" imenu-generic-expression nil nil #'equal)
165 (list (rx (: "(yoke" (+ space) 272 (list (rx (: "(yoke" (+ space) (? "(")
166 (group (+ (not space))) 273 (group (+ (not (or "(" " " "\t" "\n"))))
167 (+ space) 274 (+ space)
168 (group (+ (not space))))) 275 (group (+ (not space)))))
169 1))) 276 1)))
170 277
171(defun yoke-remove (pkg)
172 "Remove package PKG from `yoke-dir'."
173 (interactive (list (completing-read "Package: "
174 (directory-files yoke-dir)
175 (lambda (f)
176 (not (or (string= f ".")
177 (string= f ".."))))
178 :require-match)))
179 (let ((dir (expand-file-name pkg yoke-dir)))
180 (move-file-to-trash dir)
181 (message "Package `%s' removed." pkg)))
182
183(provide 'yoke) 278(provide 'yoke)
184;;; yoke.el ends here 279;;; yoke.el ends here