1 files changed, 125 insertions, 0 deletions

@@ -0,0 +1,125 @@
+;;; yoke.el --- yoke packages in to your editing system  -*- lexical-binding: t; -*-
+;; by C. Duckworth <acdw@acdw.net>
+(provide 'yoke)
+(require 'cl-lib)
+
+(defgroup yoke nil
+  "Customizations for yoke, a package manager thing."
+  :group 'applications
+  :prefix "yoke-")
+
+(defcustom yoke-dir (locate-user-emacs-file "yoke")
+  "Where yoke packages live."
+  :type 'file)
+
+(defun yoke-repo-local-p (repo)
+  (string-match-p (rx bos (or "." "~" "/")) repo))
+
+(defun yoke-repo-dir (pkg repo)
+  (if (yoke-repo-local-p repo)
+      (expand-file-name repo)
+    (expand-file-name (format "%s" pkg) yoke-dir)))
+
+(defun yoke-git (repo &optional dir)
+  "Git REPO from the internet and put it into `yoke-dir'.
+If DIR is passed, clone there; otherwise just clone.  Return the
+directory created."
+  (let ((dir (or dir (yoke-repo-dir (file-name-nondirectory repo) repo))))
+    (unless (or (yoke-repo-local-p repo) (file-exists-p dir))
+      (message "Downloading %S..." repo)
+      (call-process "git" nil (get-buffer-create "*yoke*") nil
+                    "clone" repo dir)
+      (message "Downloading %S... done" repo))
+    dir))
+
+(defun yoke-lasso (pkg repo)
+  "Add PKG to `load-path' so it can be used.
+If PKG is not installed, install it from REPO.  Packages will be
+installed to `yoke-dir'."
+  (let* ((dir (yoke-repo-dir pkg repo)))
+    (yoke-git repo dir)
+    (cond
+     ((file-exists-p dir)
+      (add-to-list 'load-path dir)
+      ;; This bit is stolen from `straight'.
+      (eval-and-compile (require 'autoload))
+      (let ((generated-autoload-file
+             (expand-file-name (format "%s-autoloads.el" pkg) dir))
+            (backup-inhibited t)
+            (version-control 'never)
+            (message-log-max nil)
+            (inhibit-message t))
+        (unless (file-exists-p generated-autoload-file)
+          (let ((find-file-hook nil)
+                (write-file-functions nil)
+                (debug-on-error nil)
+                (left-margin 0))
+            (if (fboundp 'make-directory-autoloads)
+                (make-directory-autoloads dir generated-autoload-file)
+              (and (fboundp 'update-directory-autoloads)
+                   (update-directory-autoloads dir)))))
+        (when-let ((buf (find-buffer-visiting generated-autoload-file)))
+          (kill-buffer buf))
+        (load generated-autoload-file :noerror :nomessage)))
+     (t (user-error "Directory \"%s\" doesn't exist." dir)))
+    dir))
+
+(defun yoke-get (key args)
+  "Get KEY's value from ARGS, or return nil.
+Similar-ish to `plist-get', but works on non-proper plists."
+  (cond
+   ((null args) nil)
+   ((eq key (car args)) (cadr args))
+   (t (yoke-get key (cdr args)))))
+
+(defmacro when1 (test &rest body)
+  "Like `when', but return the value of the test."
+  (declare (indent 1))
+  (let ((g (gensym)))
+    `(let ((,g ,test))
+       (when ,g
+         ,@body
+         ,g))))
+
+(defun delete2 (list &rest elems)
+  "Delete ELEM and the next item from LIST."
+  (let ((r nil))
+    (while (consp list)
+      (if (member (car list) elems)
+          (setq list (cdr list))
+        (setq r (cons (car list) r)))
+      (setq list (cdr list)))
+    (reverse r)))
+
+(defun yoke-pkg-name (pkg)
+  (intern (format "yoke:%s" pkg)))
+
+(cl-defmacro yoke (pkg
+                   &optional repo
+                   &body body
+                   &key
+                   requires             ; :requires ((PKG REPO)...)
+                   dest                 ; :dest DESTINATION
+                   (when t whenp)       ; :when PREDICATE
+                   (unless nil unlessp) ; :unless PREDICATE
+                   &allow-other-keys)
+  "Yoke a PKG into your Emacs session."
+  (declare (indent defun))
+  (let ((name (yoke-pkg-name pkg)))
+    `(cl-block ,name
+       (condition-case e
+           (let ((*yoke-name* ',name)
+                 (*yoke-repo* ,repo)
+                 (*yoke-dest* ,(when repo `(yoke-repo-dir ',pkg ,repo))))
+             ,@(list (cond
+                      ((and whenp unlessp)
+                       `(when (or (not ,when) ,unless)
+                          (cl-return-from ,name nil)))
+                      (whenp `(unless ,when (cl-return-from ,name nil)))
+                      (unlessp `(when ,unless (cl-return-from ,name nil)))))
+             ,@(cl-loop for (pkg repo) in requires
+                        collect `(or (yoke-lasso ',pkg ,repo)
+                                     (cl-return-from ,name nil)))
+             ,@(when repo `((yoke-lasso ',pkg ,repo)))
+             ,@(delete2 body :requires :when :unless))
+             (t (message "%s: %S" ',name e))))))