From 8c7871fec56b6c464bd06ba114225d7971c4699a Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Tue, 15 Nov 2022 19:51:52 -0600 Subject: meh --- lisp/yoke.el | 88 +++++++++++++++++++++++++++++++++++++++++++++++------------- 1 file changed, 70 insertions(+), 18 deletions(-) (limited to 'lisp/yoke.el') diff --git a/lisp/yoke.el b/lisp/yoke.el index 1e1bc60..f9c4d49 100644 --- a/lisp/yoke.el +++ b/lisp/yoke.el @@ -64,8 +64,8 @@ Execute BODY afterward. (url (cond ((consp package) (cdr package)) (:else nil))) (pname (intern (format "yoke:%s" pkg))) - (dirvar (gensym "yoke-dir-")) - ;; Keyword args + (dirvar '$yoke-dir) + ;; Keyword args --- TODO: Naming could probably be better. (after (plist-get body :after)) (depends (plist-get body :depends)) (whenp (plist-member body :when)) @@ -77,6 +77,7 @@ Execute BODY afterward. (autoload (cond ((plist-member body :autoload) (plist-get body :autoload)) (:else t))) + (pre (plist-get body :pre)) ;; Body (body (cl-loop for (this next) on body by #'cddr unless (keywordp this) @@ -102,12 +103,17 @@ Execute BODY afterward. `((when ,unless (cl-return-from ,pname (format "%s (abort) :unless %S" ',pname ',unless)))))) + ;; Evaluate `:pre' forms + ,@pre ;; 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*)))) + (let* ((pkg-spec (yoke-get ,@yoke-get-args + :dir ,(format "%s" pkg*))) + (dir (expand-file-name (or (plist-get (cdr pkg-spec) :load) + "") + (car pkg-spec)))) (and dir ,@(if autoload `((yoke-generate-autoloads ',pkg* dir)) @@ -118,13 +124,16 @@ Execute BODY afterward. ',pkg*)))) ;; Download the package, generate autoloads ,@(when url - `((let ((,dirvar (yoke-get ,@url :dir ,(format "%s" pkg)))) + `((let* ((pkg-spec (yoke-get ,@url :dir ,(format "%s" pkg))) + (,dirvar (expand-file-name (or (plist-get (cdr pkg-spec) :load) + "") + (car pkg-spec)))) ,@(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))) + `((yoke-eval-after ,after ,@body))) (:else body))) (:success ',package) (t (message "%s: %s (%s)" ',pname (car err) (cdr err)) @@ -144,7 +153,7 @@ ARGS is a plist with the following possible keys: download URL." (let* ((dir (plist-get args :dir)) (load (plist-get args :load)) - (type (plist-get args :type)) + (type (or (plist-get args :type))) (path (cond ((eq type 'http) (yoke-get-http url dir)) ((or (eq type 'git) @@ -159,7 +168,7 @@ ARGS is a plist with the following possible keys: (cond ((file-exists-p path) (add-to-list 'load-path (expand-file-name (or load "") path)) - path) + (cons path args)) (:else (error "Directory \"%s\" doesn't exist." path) nil)))) @@ -178,7 +187,18 @@ 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))) + ;; XXX: Is this the best idea?? PROBABLY NOT!!! Ideally I'd have + ;; a parameter (either dynamic var or passed in) that would give the + ;; name of the downloaded file. But that would take a bit of + ;; re-engineering, I think. So for now, it stays thus. + (filename (expand-file-name + (replace-regexp-in-string + (rx "-" (+ digit) ; major version + (+ (group "." (+ digit))) ; following version numbers + (group "." (+ (not space)))) ; extension + "\\2" + basename) + dir))) (cond ((file-exists-p filename) dir) (:else @@ -187,6 +207,8 @@ URL's path and placed under `yoke-dir'." (url-retrieve-synchronously url)) (condition-case e (progn + (goto-char (point-min)) + (delete-region (point) (+ 1 (re-search-forward "^$"))) (make-directory dir :parents) (write-file filename 1) (message "Downloading %s... Done" url)) @@ -264,7 +286,7 @@ BODY after Emacs is finished initializing." (rest (cdr features))) (cond ((eq this 'init) `(yoke--eval-after-init - (lambda () (eval-after ,rest ,@body)))) + (lambda () (yoke-eval-after ,rest ,@body)))) (:else `(with-eval-after-load ',this (yoke-eval-after ,rest ,@body))))))) @@ -277,21 +299,51 @@ BODY after Emacs is finished initializing." (setf (alist-get "Yoke" imenu-generic-expression nil nil #'equal) (list (rx (: "(yoke" (+ space) (? "(") (group (+ (not (or "(" " " "\t" "\n")))) - (+ space) - (group (+ (not space))))) + (* any))) 1))) -(defun yoke-compile () +;;; Package maintenance + +(defvar yoke--all "*all*" + "Value that `yoke--prompt-for-package' uses for all packages.") + +(defun yoke--choose-packages (prompt &optional onep) + "Choose from all of yoke's installed packages." + (funcall (if onep #'completing-read #'completing-read-multiple) + prompt + (cons yoke--all yoke-dirs) + nil :require-match nil nil + (unless onep yoke--all))) + +(defun yoke--choices (&optional selections) + "Either the SELECTIONS given, or all of `yoke-dirs'. +If `yoke--all' is part of SELECTIONS, or if it's not given, +return the full list of `yoke-dirs'." + (cond ((or (null selections) + (member yoke--all selections)) + yoke-dirs) + (:else selections))) + +(defun yoke-compile (&rest packages) "Compile all elisp files in `yoke-dirs'." - (interactive) - (dolist (dir yoke-dirs) + (interactive (yoke--choose-packages "Compile packages: ")) + (dolist (dir (yoke--choices packages)) (byte-recompile-directory dir 0))) +(defun yoke-update-autoloads (&rest packages) + "Update the autoloads in PACKAGES' directories." + (interactive (yoke--choose-packages "Generate autoloads for packages: ")) + (dolist (dir (yoke--choices packages)) + (message "Generating autoloads for %s..." dir) + (yoke-generate-autoloads (file-name-nondirectory dir) dir) + (message "Generating autoloads for %s... Done" dir))) + (defun yoke-remove (dir) + "Remove DIR from `yoke-dir'." (interactive - (completing-read "Remove: " yoke-dirs - nil :require-match)) - (delete-file dir :trash)) + (list (completing-read "Remove: " yoke-dirs + nil :require-match))) + (delete-directory dir :recursive :trash)) (provide 'yoke) ;;; yoke.el ends here -- cgit 1.4.1-21-gabe81