Commit 7ec780ed6ce8fabd49668cc790054c59a62d206e

Thomas de Grivel 2022-12-09T17:46:30

sort definitions

diff --git a/repo.lisp b/repo.lisp
index 734b011..fc32c13 100644
--- a/repo.lisp
+++ b/repo.lisp
@@ -112,9 +112,8 @@
       (str (user-homedir-pathname) (subseq x 2))
       x))
 
-;;  shell commands
+;; shell commands
 
-;;  TODO: run-program for all lisp implementations
 #+sbcl
 (defun run-program (cmd &rest args)
   (format t "~&$ ~S~{ ~S~}~%" cmd args)
@@ -179,25 +178,35 @@
         (str "~/" (sh-quote (subseq x home)))
         (sh-quote x))))
 
-;;  property list functions
+;; property list functions
 
 (defun plist-merge (to add &rest more-lists)
   (cond
-    ((endp add) (if (endp more-lists)
-                    to
-                    (plist-merge to (first more-lists) (rest more-lists))))
-    ((endp (rest add)) (error "Incomplete property list"))
-    (t (setf (getf to (first add)) (first (rest add)))
-       (plist-merge to (rest (rest add))))))
+    ((endp add)
+     (if (endp more-lists)
+         to
+         (plist-merge to
+                      (first more-lists)
+                      (rest more-lists))))
+    ((endp (rest add))
+     (error "Incomplete property list"))
+    (t
+     (setf (getf to (first add))
+           (first (rest add)))
+     (plist-merge to (rest (rest add))))))
+
+;; classes
 
-;;  generic functions
-
-(defgeneric install (obj))
-(defgeneric update (obj))
-
-;;  repository base class
-
-(defvar *repos* ())
+(defclass index ()
+  ((write-date :initarg :write-date
+               :accessor index-write-date
+               :type rational)
+   (dir :initarg :dir
+        :reader index-dir
+        :type string)
+   (repos :initarg :repos
+          :accessor index-repos
+          :type list)))
 
 (defclass repo ()
   ((dir :initarg :dir
@@ -219,7 +228,25 @@
               :type string)
    (packages :initarg :packages
              :reader repo-packages
-             :type list)))
+             :type list)
+   (index :initarg :index
+          :reader repo-index
+          :type index)))
+
+(defclass git-repo (repo) ())
+
+(defclass github-repo (git-repo) ())
+
+(defclass kmx-repo (git-repo) ())
+
+;; generic functions
+
+(defgeneric install (obj))
+(defgeneric update (obj))
+
+;; repo
+
+(defvar *repos* ())
 
 (defgeneric repo-asd (repo &optional package))
 (defgeneric repo-dir/name (repo))
@@ -234,14 +261,6 @@
               (when (slot-boundp obj 'packages)
                 packages)))))
 
-(defmethod initialize-instance :after ((repo repo) &rest initargs)
-  (declare (ignore initargs))
-  (with-slots (dir name packages) repo
-    (setf (slot-value repo 'local-dir)
-          (format nil "~A/~A/~A" *repo-dir* dir name))
-    (unless (slot-boundp repo 'packages)
-      (setf packages (list name)))))
-
 (defmethod repo-asd ((repo repo) &optional
                                    (package (first (repo-packages repo))))
   (namestring
@@ -267,19 +286,17 @@
 (defun repo-by-uri (uri)
   (find uri *repos* :key #'repo-uri :test #'string=))
 
-;;  git command
+;; git
 
 (defvar *git*
-  #+unix (or (probe-file "/usr/bin/git")
-             (probe-file "/usr/local/bin/git")
-             (first-line (sh "which git"))))
+  (or (probe-file "/usr/bin/git")
+      (probe-file "/usr/local/bin/git")
+      (first-line (sh "which git"))))
 
 (defun $git (&rest args)
   (apply 'run-program *git* args))
 
-;;  git repository class
-
-(defclass git-repo (repo) ())
+;; git repo
 
 (defgeneric $git-checkout (repo))
 (defgeneric $git-clone (repo))
@@ -353,10 +370,7 @@
         (push repo *repos*)
         repo)))
 
-
-;; github repository class
-
-(defclass github-repo (git-repo) ())
+;; github repo
 
 (defmethod print-object ((obj github-repo) stream)
   (print-unreadable-object (obj stream :type t :identity t)
@@ -400,10 +414,7 @@
           (push repo *repos*)
           repo))))
 
-
-;; kmx repository class
-
-(defclass kmx-repo (git-repo) ())
+;; kmx repo
 
 (defmethod print-object ((obj kmx-repo) stream)
   (print-unreadable-object (obj stream :type t :identity t)
@@ -429,7 +440,7 @@
           (push repo *repos*)
           repo))))
 
-;;  repo uri handler
+;; repo uri handler
 
 (defparameter *repo-uri-handlers*
   '(github-repo-uri-handler
@@ -486,7 +497,7 @@
 (defmethod $git-pull ((uri string))
   ($git-pull (repo! uri)))
 
-;;  repos list
+;; repos list
 
 (defmethod install ((repos cons))
   (map nil 'install repos))
@@ -494,21 +505,10 @@
 (defmethod update ((repos cons))
   (map nil 'update repos))
 
-;;  index
+;; index
 
 (defvar *index*)
 
-(defclass index ()
-  ((write-date :initarg :write-date
-               :accessor index-write-date
-               :type rational)
-   (dir :initarg :dir
-        :reader index-dir
-        :type string)
-   (repos :initarg :repos
-          :accessor index-repos
-          :type list)))
-
 (defgeneric index-file (index))
 (defgeneric reload-index (index))
 (defgeneric maybe-reload-index (index))
@@ -558,7 +558,7 @@
           (*repos* (index-repos index)))
       (update *repos*))))
 
-;;  index uri handlers
+;; index uri handlers
 
 (defun index-file-p (x)
   (or (string= "repo-index.lisp" x)
@@ -586,6 +586,16 @@
 (defun index! (uri)
   (or (index uri) (error "failed to load index ~S" uri)))
 
+;; repo
+
+(defmethod initialize-instance :after ((repo repo) &rest initargs)
+  (declare (ignore initargs))
+  (with-slots (dir index name packages) repo
+    (setf (slot-value repo 'local-dir)
+          (format nil "~A/~A/~A" (index-dir index) dir name))
+    (unless (slot-boundp repo 'packages)
+      (setf packages (list name)))))
+
 ;;  install and update commands
 
 (defmethod install ((x string))