diff --git a/cpkg.lisp b/cpkg.lisp
index 47fcddb..4daf142 100644
--- a/cpkg.lisp
+++ b/cpkg.lisp
@@ -19,6 +19,7 @@
#:basename
#:dirname
#:$git
+ #:link-submodules
#:repo-local-dir
#:run-program
#:sh
@@ -31,6 +32,8 @@
#:clean
#:clear
#:configure
+ #:define-system
+ #:find-repo
#:find-system
#:*index*
#:install
@@ -51,7 +54,11 @@
(defvar *systems* ())
-;; install
+;; repo
+
+(defun find-repo (repo)
+ (let ((repo:*repos* *repos*))
+ (repo:find-repo repo)))
(defun install (repo)
(let ((repo:*index* *index*))
@@ -63,50 +70,84 @@
'())
(defclass system ()
- ((name :accessor system-name
+ ((author :accessor system-author
+ :initarg :author
+ :type string)
+ (description :accessor system-description
+ :initarg :description
+ :type string)
+ (direct-dependencies :accessor system-direct-dependencies
+ :initarg :depends-on
+ :type list)
+ (dir :accessor system-dir
+ :initarg :dir
+ :type string)
+ (name :accessor system-name
:initarg :name
:initform (error "system name is missing")
:type symbol)
- (path :accessor system-path
- :initarg :path
- :type string)))
+ (sysdef :accessor system-definition-file
+ :initarg :sysdef
+ :type string)
+ (version :accessor system-version
+ :initarg :version
+ :type string)))
+
+(defgeneric build (system))
+(defgeneric clean (system))
+(defgeneric clear (system))
+(defgeneric configure (system))
+(defgeneric reset (system))
+(defgeneric system-dependencies (system))
+(defgeneric system-file (system file))
(defmethod print-object ((system system) stream)
(print-unreadable-object (system stream :type t :identity t)
- (with-slots (name path) system
- (format stream "~S ~S" name path))))
-
-(defgeneric system-file (system file))
+ (with-slots (name dir) system
+ (format stream "~S ~S" name dir))))
(defmethod system-file ((system system) (file string))
- (str (system-path system) "/" file))
-
-(defun system-dir (system)
- (system-file system ""))
+ (str (system-dir system) "/" file))
(defun remove-trailing-/ (string)
(declare (type string string))
(when (string-ends-with "/" string)
(subseq string 0 (1- (length string)))))
+(defun find-system-by-sysdef (sysdef)
+ (find sysdef *systems*
+ :key #'system-definition-file
+ :test #'string=))
+
(defun find-system (x)
(dolist (search-fun *system-definition-search-functions*)
- (let ((pathname (funcall search-fun x)))
- (when pathname
- (let* ((path (remove-trailing-/ (namestring pathname)))
- (system (or (find path *systems*
- :key #'system-path
- :test #'string=)
- (let* ((name (kw (basename path)))
- (system (make-instance 'system
- :name name
- :path path)))
- (push system *systems*)
- system))))
+ (let ((sysdef (funcall search-fun x)))
+ (when sysdef
+ (let* ((sysdef (namestring sysdef))
+ (system (or (find-system-by-sysdef sysdef)
+ (progn
+ (load sysdef)
+ (find-system-by-sysdef sysdef)))))
(when system
(return system)))))))
-(defgeneric build (x))
+(defmethod system-direct-dependencies (x)
+ (system-direct-dependencies (the system (find-system x))))
+
+(defmethod system-dependencies ((system system))
+ (let (deps)
+ (labels ((deep-first-search (s)
+ (let ((direct-deps (system-direct-dependencies s)))
+ (when direct-deps
+ (dolist (d direct-deps)
+ (unless (find d deps)
+ (push d deps)
+ (deep-first-search d)))))))
+ (deep-first-search system)
+ deps)))
+
+(defmethod system-dependencies (x)
+ (system-dependencies (the system (find-system x))))
;; file operations
@@ -148,8 +189,6 @@
;; clean
-(defgeneric clean (system))
-
(defmethod clean ((system system))
(let ((clean (system-file system ".cpkg/clean")))
(when (probe-file clean)
@@ -161,8 +200,6 @@
;; configure
-(defgeneric configure (system))
-
(defun system-autogen (system)
(dolist (filename '("autogen.sh"
"autogen"))
@@ -188,13 +225,15 @@
"set -e" #\Newline
"cd \"$0\"/../.." #\Newline)
(when autogen
- (unless (sh "cd " (sh-quote (translate-home (system-path system)))
+ (unless (sh "cd " (sh-quote (translate-home
+ (system-dir system)))
" && ./" autogen)
(error "autogen failed"))
(append-to-file log "./" autogen #\Newline))
(let ((configure (system-configure system)))
(when configure
- (or (sh "cd " (sh-quote (translate-home (system-path system)))
+ (or (sh "cd " (sh-quote (translate-home
+ (system-dir system)))
" && ./" configure)
(error "configure failed"))
(append-to-file log "./" configure #\Newline))
@@ -205,46 +244,39 @@
;; build
-(defmethod build (x)
- (build (find-system x)))
-
(defmethod build ((system system))
(let ((build-done (system-file system ".cpkg/build-done"))
(log (system-file system ".cpkg/log"))
(make (system-make system)))
(unless (probe-file build-done)
(configure system)
- (when (or (probe-file "Makefile")
- (probe-file "makefile"))
- (unless (sh make
- "-C"
- (sh-quote (translate-home (system-dir system))))
+ (when (or (probe-file (system-file system "Makefile"))
+ (probe-file (system-file system "makefile")))
+ (unless (sh make " "
+ "-C "
+ (sh-quote (translate-home
+ (system-dir system))))
(error "build failed"))
(append-to-file log make #\Newline)
(write-file build-done "")))))
-(defun repo-local-dir-sysdef (repo x)
- (declare (ignore x))
- (str (repo-local-dir repo) "/"))
-
-(defun sysdef-cpkg (x)
- (let ((repo:*index* *index*))
- (repo:sysdef x #'repo-local-dir-sysdef)))
+(defmethod build (x)
+ (build (the system (find-system x))))
;; clear : remove all files except .git and .cpkg
-(defgeneric clear (system))
-
(defmethod clear ((system system))
- (let ((system-dir-sh (sh-quote (translate-home (system-dir system)))))
+ (let ((system-dir-sh (sh-quote
+ (translate-home
+ (system-dir system)))))
(sh "find " system-dir-sh " -name '.git' -prune "
- "" "-or -name '.cpkg' -prune "
- "" "-or -type f -print0 "
+ "" "-or -name '.cpkg' -prune "
+ "" "-or -type f -print0 "
"| xargs -0 rm -f")
- (sh "rm " system-dir-sh "/.cpkg/*-done")
+ (sh "rm -f " system-dir-sh "/.cpkg/*-done")
(sh "find " system-dir-sh " -name '.git' -prune "
- "" "-or -name '.cpkg' -prune "
- "" "-or -type d -print0 "
+ "" "-or -name '.cpkg' -prune "
+ "" "-or -type d -print0 "
"| xargs -0 rmdir 2>/dev/null || true")))
(defmethod clear (x)
@@ -252,17 +284,24 @@
;; reset
-(defgeneric reset (system))
-
(defmethod reset ((system system))
(clear system)
- ($git "-C" (translate-home (system-dir system)) "reset" "--hard"))
+ (let ((system-dir (translate-home (system-dir system))))
+ ($git "-C" system-dir "reset" "--hard")
+ (link-submodules (system-name system))))
(defmethod reset (x)
(reset (the system (find-system x))))
;; start cpkg : load index and link with repo
+(defun repo-local-dir-sysdef (repo x)
+ (str (repo-local-dir repo) "/.cpkg/" (string-downcase x) ".sysdef.lisp"))
+
+(defun sysdef-cpkg (x)
+ (let ((repo:*index* *index*))
+ (repo:sysdef x #'repo-local-dir-sysdef)))
+
(defun boot (&optional (dir "~/cpkg"))
(let ((index-file (str dir "/repo-index.lisp")))
(when (probe-file index-file)
@@ -273,3 +312,27 @@
(symbol-value
(intern "*SYSTEM-DEFINITION-SEARCH-FUNCTIONS*"
:cpkg)))))))
+
+;; sysdef
+
+(defmacro define-system (name &key
+ author
+ depends-on
+ description
+ version)
+ (let ((sysdef (gensym "SYSDEF-"))
+ (system (gensym "SYSTEM-")))
+ `(let* ((,sysdef ,(namestring *load-pathname*))
+ (,system (make-instance 'system
+ :author ',author
+ :depends-on ',depends-on
+ :dir (dirname (dirname ,sysdef))
+ :description ',description
+ :name ',name
+ :sysdef ,sysdef
+ :version ',version)))
+ (setf *systems* (cons ,system
+ (delete ,sysdef
+ *systems*
+ :key #'system-definition-file
+ :test #'string=))))))