gpkg: Support parallel installations.

lisp/gpkg.el

@@ -25,20 +25,24 @@
 (defvar gpkg-removal '("^t$" "^tests?$" "-pkg.el$")
   "Files/directories in packages matching these patterns are deleted.")
 
+(defun gpkg-repository (name)
+  "Return repository path for package NAME."
+  (expand-file-name (concat name ".git") gpkg-root))
+
 (defun gpkg-git (name &rest args)
-  "Run git with the given command line arguments."
+  "Run git in NAME with the given command line arguments."
   (when name
-    (push (gpkg-root name) args)
+    (push (gpkg-repository name) args)
     (push "-C" args))
   (princ (format "%S\n" (cons 'git args)))
   (apply #'call-process "git" nil '(:file "/dev/stdout") nil args))
 
-(cl-defun gpkg-id (name &optional (ref "HEAD"))
-  "Return the commit ID for NAME at optional REF (HEAD)."
-  (with-temp-buffer
-    (call-process "git" nil t nil "-C" (gpkg-root name)
-                  "rev-parse" (format "%s^{commit}" ref))
-    (buffer-substring (point-min) (1- (point-max)))))
+(defun gpkg-clone (name url)
+  "Clone the repository for NAME if needed."
+  (let ((repository (gpkg-repository name)))
+    (unless (file-exists-p repository)
+      (gpkg-git nil "clone" url repository)
+      (gpkg-git name "gc"))))
 
 (defun gpkg-purge (dir removal)
   "Recursively delete everything under DIR matching REMOVAL list."
@@ -51,45 +55,72 @@
     (when (file-directory-p subdir)
       (gpkg-purge subdir removal))))
 
-(defun gpkg-root (name &rest subdirs)
+(defun gpkg-path (name &rest subdirs)
   "Return the installation root for NAME package."
-  (cl-loop with path = (expand-file-name name gpkg-root)
-           for dir in subdirs
+  (cl-loop with path = (expand-file-name emacs-version gpkg-root)
+           for dir in (cons name subdirs)
            do (setf path (expand-file-name dir path))
            finally return path))
 
+(defun gpkg-package-url (name)
+  "Return :removal value for package NAME."
+  (let ((package (assoc name gpkg-packages)))
+    (plist-get (cdr package) :url)))
+
+(defun gpkg-package-ref (name)
+  "Return :ref value for package NAME."
+  (let ((package (assoc name gpkg-packages)))
+    (plist-get (cdr package) :ref)))
+
+(defun gpkg-package-removal (name)
+  "Return :removal value for package NAME."
+  (let ((package (assoc name gpkg-packages)))
+    (plist-get (cdr package) :removal)))
+
+(defun gpkg-checkout (name)
+  "Checkout files for NAME."
+  (let ((default-directory (file-name-as-directory gpkg-root)))
+    (call-process-shell-command
+     (format
+      "git -C \"%s\" archive --format=tar --prefix=\"%s/%s/\" \"%s\" | tar xf -"
+      (shell-quote-argument (gpkg-repository name))
+      (shell-quote-argument emacs-version)
+      (shell-quote-argument name)
+      (shell-quote-argument (gpkg-package-ref name))))
+    (gpkg-purge (gpkg-path name)
+                (append (gpkg-package-removal name) gpkg-removal))))
+
+(defun gpkg-ref-to-commit (name ref)
+  "Return the commit for NAME at optional REF (HEAD)."
+  (with-temp-buffer
+    (when (zerop (call-process "git" nil t nil "-C" (gpkg-repository name)
+                               "rev-parse" (format "%s^{commit}" ref)))
+      (buffer-substring (point-min) (1- (point-max))))))
+
 (cl-defun gpkg-install (name url ref &key removal)
-  "Install package NAME from URL on commit REF."
-  (let ((root (gpkg-root name))
-        (fresh-clone nil))
-    (unless (file-exists-p root)
-      (gpkg-git nil "clone" url root)
-      (setf fresh-clone t)
-      (gpkg-git name "gc"))
-    (unless (and (not fresh-clone)
-                 (equal (gpkg-id name)
-                        (gpkg-id name ref)))
+  "Install package NAME from URL on commit REF, cloning if necessary."
+  (gpkg-clone name url)
+  (cl-pushnew `(,name :url ,url :ref ,ref :removal ,removal) gpkg-packages
+              :key #'car :test #'equal)
+  (unless (file-exists-p (gpkg-path name))
+    ;; Is REF available?
+    (unless (gpkg-ref-to-commit name ref)
       (gpkg-git name "fetch")
       (gpkg-git name "gc")
-      (gpkg-git name "clean" "-dfx")
-      (gpkg-git name "reset" "--hard" ref)
-      (gpkg-purge root (append removal gpkg-removal)))
-    (cl-pushnew `(,name :removal ,removal) gpkg-packages
-                :key #'car :test #'equal)
-    (cl-pushnew root load-path :test #'equal)))
+      (unless (gpkg-ref-to-commit name ref)
+        (user-error "Unknown ref in %s: %s" name ref)))
+    (gpkg-checkout name))
+  (cl-pushnew (gpkg-path name) load-path :test #'equal))
 
 (defun gpkg-compile ()
   "Byte-compile all installed packages."
-  (byte-recompile-directory gpkg-root 0))
+  (byte-recompile-directory (expand-file-name emacs-version gpkg-root) 0))
 
 (defun gpkg-clean ()
-  "Clear out all build files from each package."
-  (dolist (package gpkg-packages)
-    (let ((name (car package))
-          (removal (plist-get (cdr package) :removal)))
-      (gpkg-git name "clean" "-dfx")
-      (gpkg-git name "reset" "--hard")
-      (gpkg-purge (gpkg-root name) (append removal gpkg-removal)))))
+  "Remove all non-repository files for all versions of Emacs."
+  (dolist (file (directory-files gpkg-root t "[^.]"))
+    (when (and (file-directory-p file) (not (string-match-p "\\.git$" file)))
+      (delete-directory file t))))
 
 (defmacro gpkg-config (&rest packages)
   "Thread each list as arguments for `gpkg-install'."

packages.el

@@ -64,6 +64,9 @@
  ("pov-mode" "https://github.com/melmothx/pov-mode"
   "9fc1db3"))
 
+;; Magit annoyance workaround
+(setf magit-version (gpkg-package-ref "magit"))
+
 ;; Set up some extra load-path directories
-(add-to-list 'load-path (gpkg-root "evil" "lib"))
-(add-to-list 'load-path (gpkg-root "magit" "lisp"))
+(add-to-list 'load-path (gpkg-path "evil" "lib"))
+(add-to-list 'load-path (gpkg-path "magit" "lisp"))