diff options
Diffstat (limited to 'lisp/yoke.el')
-rw-r--r-- | lisp/yoke.el | 125 |
1 files changed, 125 insertions, 0 deletions
diff --git a/lisp/yoke.el b/lisp/yoke.el new file mode 100644 index 0000000..2673e5e --- /dev/null +++ b/lisp/yoke.el | |||
@@ -0,0 +1,125 @@ | |||
1 | ;;; yoke.el --- yoke packages in to your editing system -*- lexical-binding: t; -*- | ||
2 | ;; by C. Duckworth <acdw@acdw.net> | ||
3 | (provide 'yoke) | ||
4 | (require 'cl-lib) | ||
5 | |||
6 | (defgroup yoke nil | ||
7 | "Customizations for yoke, a package manager thing." | ||
8 | :group 'applications | ||
9 | :prefix "yoke-") | ||
10 | |||
11 | (defcustom yoke-dir (locate-user-emacs-file "yoke") | ||
12 | "Where yoke packages live." | ||
13 | :type 'file) | ||
14 | |||
15 | (defun yoke-repo-local-p (repo) | ||
16 | (string-match-p (rx bos (or "." "~" "/")) repo)) | ||
17 | |||
18 | (defun yoke-repo-dir (pkg repo) | ||
19 | (if (yoke-repo-local-p repo) | ||
20 | (expand-file-name repo) | ||
21 | (expand-file-name (format "%s" pkg) yoke-dir))) | ||
22 | |||
23 | (defun yoke-git (repo &optional dir) | ||
24 | "Git REPO from the internet and put it into `yoke-dir'. | ||
25 | If DIR is passed, clone there; otherwise just clone. Return the | ||
26 | directory created." | ||
27 | (let ((dir (or dir (yoke-repo-dir (file-name-nondirectory repo) repo)))) | ||
28 | (unless (or (yoke-repo-local-p repo) (file-exists-p dir)) | ||
29 | (message "Downloading %S..." repo) | ||
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) | ||
36 | "Add PKG to `load-path' so it can be used. | ||
37 | If PKG is not installed, install it from REPO. Packages will be | ||
38 | installed to `yoke-dir'." | ||
39 | (let* ((dir (yoke-repo-dir pkg repo))) | ||
40 | (yoke-git repo dir) | ||
41 | (cond | ||
42 | ((file-exists-p dir) | ||
43 | (add-to-list 'load-path dir) | ||
44 | ;; This bit is stolen from `straight'. | ||
45 | (eval-and-compile (require 'autoload)) | ||
46 | (let ((generated-autoload-file | ||
47 | (expand-file-name (format "%s-autoloads.el" pkg) dir)) | ||
48 | (backup-inhibited t) | ||
49 | (version-control 'never) | ||
50 | (message-log-max nil) | ||
51 | (inhibit-message t)) | ||
52 | (unless (file-exists-p generated-autoload-file) | ||
53 | (let ((find-file-hook nil) | ||
54 | (write-file-functions nil) | ||
55 | (debug-on-error nil) | ||
56 | (left-margin 0)) | ||
57 | (if (fboundp 'make-directory-autoloads) | ||
58 | (make-directory-autoloads dir generated-autoload-file) | ||
59 | (and (fboundp 'update-directory-autoloads) | ||
60 | (update-directory-autoloads dir))))) | ||
61 | (when-let ((buf (find-buffer-visiting generated-autoload-file))) | ||
62 | (kill-buffer buf)) | ||
63 | (load generated-autoload-file :noerror :nomessage))) | ||
64 | (t (user-error "Directory \"%s\" doesn't exist." dir))) | ||
65 | dir)) | ||
66 | |||
67 | (defun yoke-get (key args) | ||
68 | "Get KEY's value from ARGS, or return nil. | ||
69 | Similar-ish to `plist-get', but works on non-proper plists." | ||
70 | (cond | ||
71 | ((null args) nil) | ||
72 | ((eq key (car args)) (cadr args)) | ||
73 | (t (yoke-get key (cdr args))))) | ||
74 | |||
75 | (defmacro when1 (test &rest body) | ||
76 | "Like `when', but return the value of the test." | ||
77 | (declare (indent 1)) | ||
78 | (let ((g (gensym))) | ||
79 | `(let ((,g ,test)) | ||
80 | (when ,g | ||
81 | ,@body | ||
82 | ,g)))) | ||
83 | |||
84 | (defun delete2 (list &rest elems) | ||
85 | "Delete ELEM and the next item from LIST." | ||
86 | (let ((r nil)) | ||
87 | (while (consp list) | ||
88 | (if (member (car list) elems) | ||
89 | (setq list (cdr list)) | ||
90 | (setq r (cons (car list) r))) | ||
91 | (setq list (cdr list))) | ||
92 | (reverse r))) | ||
93 | |||
94 | (defun yoke-pkg-name (pkg) | ||
95 | (intern (format "yoke:%s" pkg))) | ||
96 | |||
97 | (cl-defmacro yoke (pkg | ||
98 | &optional repo | ||
99 | &body body | ||
100 | &key | ||
101 | requires ; :requires ((PKG REPO)...) | ||
102 | dest ; :dest DESTINATION | ||
103 | (when t whenp) ; :when PREDICATE | ||
104 | (unless nil unlessp) ; :unless PREDICATE | ||
105 | &allow-other-keys) | ||
106 | "Yoke a PKG into your Emacs session." | ||
107 | (declare (indent defun)) | ||
108 | (let ((name (yoke-pkg-name pkg))) | ||
109 | `(cl-block ,name | ||
110 | (condition-case e | ||
111 | (let ((*yoke-name* ',name) | ||
112 | (*yoke-repo* ,repo) | ||
113 | (*yoke-dest* ,(when repo `(yoke-repo-dir ',pkg ,repo)))) | ||
114 | ,@(list (cond | ||
115 | ((and whenp unlessp) | ||
116 | `(when (or (not ,when) ,unless) | ||
117 | (cl-return-from ,name nil))) | ||
118 | (whenp `(unless ,when (cl-return-from ,name nil))) | ||
119 | (unlessp `(when ,unless (cl-return-from ,name nil))))) | ||
120 | ,@(cl-loop for (pkg repo) in requires | ||
121 | collect `(or (yoke-lasso ',pkg ,repo) | ||
122 | (cl-return-from ,name nil))) | ||
123 | ,@(when repo `((yoke-lasso ',pkg ,repo))) | ||
124 | ,@(delete2 body :requires :when :unless)) | ||
125 | (t (message "%s: %S" ',name e)))))) | ||