;;; yoke.el --- make your editor work for YOU -*- lexical-binding: t; -*- ;; Copyright (C) 2022 C. Duckworth ;;; Commentary: ;; What's the most basic functionality of a package manager? In my view, all a ;; package manager should do is fetch packages from wherever they are, and ;; provide the system with a method of accessing those packages' functionality. ;; In Emacs, this means downloading packages from the Internet and adding their ;; directories to `load-path'. That's what `yoke' tries to do. ;; ;; In fact, that's /all/ `yoke' tries to do, on the package front. It doesn't ;; automatically fetch dependencies. It doesnt' do much else of anything ;; --- hell, it doesn't have to generate autoloads or build the dang source ;; files if you don't want it to. /I/ have it do those things because I like a ;; few creature comforts, but you can turn 'em off. ;; ;; Instead of focusing too much on installing packages, `yoke' works harder to ;; group---to "yoke together," if you will---related configurations together, à ;; la `use-package' or `setup'. I used both of those packages before and found ;; each somewhat lacking, and what I really wanted was a fancy `progn' that I ;; could put whatever I want inside. So that's basically what `yoke' is. It's ;; a configuration macro that automatically fetches packages from their repos ;; and tells Emacs where they are, then executes its body in a `cl-block' for ;; ... reasons. That's it. ;;; Code: (require 'cl-lib) ;;; Customization options (defgroup yoke nil "Customizations for `yoke'." :group 'applications :prefix "yoke-") (defcustom yoke-dir (locate-user-emacs-file "yoke") "Where to put yoked packages." :type 'file) (defcustom yoke-get-default-fn #'yoke-get-git "Default function to get packages with." :type 'function) (defvar yoke-buffer "*yoke*" "Buffer to use for yoke process output.") (defvar yoke-dirs nil "List of directories managed by `yoke'.") ;;; GET YOKED (defmacro yoke (package &rest body) "Yoke PACKAGE to work with your Emacs. Execute BODY afterward. \(fn (PACKAGE [REPO REPO-KEYWORDS]) [BODY-KEYWORDS] BODY...)" (declare (indent 1)) (let* (;; State (pkg (cond ((consp package) (car package)) (:else package))) (url (cond ((consp package) (cdr package)) (:else nil))) (pname (intern (format "yoke:%s" pkg))) (dirvar (gensym "yoke-dir-")) ;; Keyword args (after (plist-get body :after)) (depends (plist-get body :depends)) (whenp (plist-member body :when)) (unlessp (plist-member body :unless)) (when (cond (whenp (plist-get body :when)) (:else t))) (unless (cond (unlessp (plist-get body :unless)) (:else nil))) (autoload (cond ((plist-member body :autoload) (plist-get body :autoload)) (:else t))) ;; Body (body (cl-loop for (this next) on body by #'cddr unless (keywordp this) append (list this next) into ret finally return (cond ((eq (car (last ret)) nil) (butlast ret)) (:else ret))))) `(cl-block ,pname (condition-case err (progn ;; Pass `:when' or `:unless' clauses ,@(cond ((and whenp unlessp) `((when (or (not ,when) ,unless) (cl-return-from ,pname (format "%s (abort) :when %S :unless %S" ',pname ',when ',unless))))) (whenp `((unless ,when (cl-return-from ,pname (format "%s (abort) :when %S" ',pname ',when))))) (unlessp `((when ,unless (cl-return-from ,pname (format "%s (abort) :unless %S" ',pname ',unless)))))) ;; Get prerequisite packages ,@(cl-loop for (pkg* . yoke-get-args) in depends collect `(or (let ((dir (yoke-get ,@yoke-get-args :dir ,(format "%s" pkg*)))) (and dir ,@(if autoload `((yoke-generate-autoloads ',pkg* dir)) '(t)) (add-to-list 'yoke-dirs dir nil #'string=))) (cl-return-from ,pname (format "Error fetching prerequiste: %s" ',pkg*)))) ;; Download the package, generate autoloads ,@(when url `((let ((,dirvar (yoke-get ,@url :dir ,(format "%s" pkg)))) ,@(when autoload `((yoke-generate-autoloads ',pkg ,dirvar))) (add-to-list 'yoke-dirs ,dirvar nil #'string=)))) ;; Evaluate the body, optionally after the features in `:after' ,@(cond (after `((eval-after ,after ,@body))) (:else body))) (:success ',package) (t (message "%s: %s (%s)" ',pname (car err) (cdr err)) nil))))) (defun yoke-get (url &rest args) "\"Get\" URL and and put it in DIR, then add DIR to `load-path'. URL can be a string or a list of the form (TYPE URL). The download will be dispatched to the TYPE, or to `yoke-get-default-fn' if only a string is given. ARGS is a plist with the following possible keys: :dir DIRECTORY --- the directory to put the URL. :load DIRECTORY --- the directory (relative to the download path) to add to `load-path'. :type TYPE --- one of `http', `git', or `file' --- how to download URL." (let* ((dir (plist-get args :dir)) (load (plist-get args :load)) (type (plist-get args :type)) (path (cond ((eq type 'http) (yoke-get-http url dir)) ((or (eq type 'git) (string-match-p (rx bos "git:") url)) (yoke-get-git url dir)) ((or (eq type 'file) (string-match-p (rx bos (or "file:" "~" "/")) url)) (yoke-get-file url dir)) ((stringp url) (funcall yoke-get-default-fn url dir)) (:else (error "Uknown URL type: %S" url))))) (cond ((file-exists-p path) (add-to-list 'load-path (expand-file-name (or load "") path)) path) (:else (error "Directory \"%s\" doesn't exist." path) nil)))) (defun yoke-get--guess-directory (path &optional dir) "Guess directory from PATH and DIR, and return it. If DIR is present and relative, resolve it relative to `yoke-dir', or if it's absolute, leave it as-is. If DIR is absent, return the final component of PATH resolved relative to `yoke-dir'." (expand-file-name (or dir (file-name-nondirectory path)) yoke-dir)) (defun yoke-get-http (url &optional dir) "Download URL to DIR and return its directory. If DIR isn't given, it's guessed from the final component of the URL's path and placed under `yoke-dir'." (let* ((dir (yoke-get--guess-directory url dir)) (basename (file-name-nondirectory url)) (filename (expand-file-name basename dir))) (cond ((file-exists-p filename) dir) (:else (message "Downloading %s..." url) (with-current-buffer (let ((url-debug t)) (url-retrieve-synchronously url)) (condition-case e (progn (make-directory dir :parents) (write-file filename 1) (message "Downloading %s... Done" url)) (:success dir) (t (signal (car e) (cdr e))))))))) (defun yoke-get-git (repo &optional dir) "Clone REPO to DIR and return its directory. If DIR isn't given, it's guessed from the repo's name and put under `yoke-dir'. Return the cloned directory's name on success, or nil on failure." (let ((dir (yoke-get--guess-directory repo dir))) (cond ((file-exists-p dir) dir) (:else (message "Cloning %s..." repo) (pcase (call-process "git" nil (get-buffer-create yoke-buffer) nil "clone" repo dir) (0 (message "Cloning %s... Done" repo) dir) (_ (message "Cloning %s... Error! See buffer %s for output." repo yoke-buffer) nil)))))) (defun yoke-get-file (file &optional _dir) "Add FILE's directory to `load-dir'. _DIR is ignored." (file-name-directory file)) (defun yoke-generate-autoloads (package dir) "Generate autoloads for PACKAGE in DIR." ;; Shamelessly stolen from `straight'. (eval-and-compile (require 'autoload)) (let ((generated-autoload-file (expand-file-name (format "%s-autoloads.el" package) 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)) ;;; Evaluating forms after features (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 (features &rest body) "Evaluate BODY, but only after loading FEATURES. FEATURES can be an atom or a list; as an atom it works like `with-eval-after-load'. The special feature `init' will evaluate BODY after Emacs is finished initializing." (declare (indent 1) (debug (form def-body))) (unless (listp features) (setf features (list features))) (if (null features) (macroexp-progn body) (let* ((this (car features)) (rest (cdr features))) (cond ((eq this 'init) `(yoke--eval-after-init (lambda () (eval-after ,rest ,@body)))) (:else `(with-eval-after-load ',this (yoke-eval-after ,rest ,@body))))))) ;;; Integration (defun yoke-imenu-insinuate () "Insinuate `yoke' forms for `imenu'." (require 'imenu) (setf (alist-get "Yoke" imenu-generic-expression nil nil #'equal) (list (rx (: "(yoke" (+ space) (? "(") (group (+ (not (or "(" " " "\t" "\n")))) (+ space) (group (+ (not space))))) 1))) (defun yoke-compile () "Compile all elisp files in `yoke-dirs'." (interactive) (dolist (dir yoke-dirs) (byte-recompile-directory dir 0))) (defun yoke-remove (dir) (interactive (completing-read "Remove: " yoke-dirs nil :require-match)) (delete-file dir :trash)) (provide 'yoke) ;;; yoke.el ends here