path: root/lisp/yoke.el

;;; yoke.el --- make your editor work for YOU         -*- lexical-binding: t; -*-
;; Copyright (C) 2022 C. Duckworth <acdw@acdw.net>

;;; 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