Minor changes to distrib system

borodust · Jan 26, 2017 · 65a002b · 65a002b
1 parent 48ea1ea
commit 65a002b
Show file tree

Hide file tree

Showing 5 changed files with 55 additions and 53 deletions.
diff --git a/README.md b/README.md
@@ -100,8 +100,10 @@ Required foreign libraries:
 
 ### [Quicklisp](http://quicklisp.org)
 ```lisp
+;; add cl-bodge distribution into quicklisp
 (ql-dist:install-dist "http://bodge.borodust.org/dist/bodge-systems.txt")
 
+;; load engine
 (ql:quickload :cl-bodge)
 ```
 

diff --git a/distribution/build.lisp b/distribution/build.lisp
@@ -3,28 +3,26 @@
 
 (declaim (special *distribution*))
 
-
-(labels ((%extract-name (sys-def)
-           (if (listp sys-def)
-               (ecase (first sys-def)
-                 (:version (second sys-def)))
-               sys-def))
-
-         (%list-dependencies (system)
-           (mapcar #'%extract-name (asdf:system-depends-on system)))
-
-         (%proper-path-p (sys-path)
-           (and sys-path
-                (> (length (trim-whitespaces (namestring sys-path))) 0)))
-
-         (%list-system-pathnames (system-designator)
-           (let* ((system (asdf:find-system system-designator))
-                  (sys-path (asdf:system-definition-pathname system)))
-             (append (when (%proper-path-p sys-path) (list sys-path))
-                     (loop for sys-name in (%list-dependencies system) append
-                          (%list-system-pathnames sys-name))))))
-
-  (defun list-system-pathnames (system-designator)
+(defun list-system-pathnames (system-designator)
+  (labels ((%extract-name (sys-def)
+             (if (listp sys-def)
+                 (ecase (first sys-def)
+                   (:version (second sys-def)))
+                 sys-def))
+
+           (%list-dependencies (system)
+             (mapcar #'%extract-name (asdf:system-depends-on system)))
+
+           (%proper-path-p (sys-path)
+             (and sys-path
+                  (> (length (trim-whitespaces (namestring sys-path))) 0)))
+
+           (%list-system-pathnames (system-designator)
+             (let* ((system (asdf:find-system system-designator))
+                    (sys-path (asdf:system-definition-pathname system)))
+               (append (when (%proper-path-p sys-path) (list sys-path))
+                       (loop for sys-name in (%list-dependencies system) append
+                            (%list-system-pathnames sys-name))))))
     (remove-duplicates (%list-system-pathnames system-designator) :test #'equal)))
 
 
@@ -102,7 +100,7 @@
   (let* ((*distribution* (with-open-file (file distribution-descriptor)
                            (let ((*package* (find-package :ge.dist)))
                              (loop for form = (read file)
-                                until (and (listp form) (eq (car form) 'define-distribution))
+                                until (and (listp form) (eq (car form) 'distribution))
                                 finally (return (eval (macroexpand form))))))))
     (let ((*load-verbose* nil)
           (*compile-verbose* nil)

diff --git a/distribution/distribution.lisp b/distribution/distribution.lisp
@@ -32,16 +32,18 @@
 (defmethod initialize-instance :after ((this distribution) &key build-directory
                                                              library-directory
                                                              assets
-                                                             engine-assets-directory)
+                                                             engine-assets-directory
+                                                             base-directory)
   (with-slots ((this-build-dir build-directory) (this-lib-dir library-directory)
                (this-assets assets) (this-engine-assets-dir engine-assets-directory)
                target-system name dist-directory)
       this
     (let* ((sys (find-system target-system))
-           (sys-path (component-pathname sys))
+           (base-path (fad:merge-pathnames-as-directory (component-pathname sys)
+                                                       base-directory))
            (dist-name (format nil "~(~a~)" name)))
       (setf this-build-dir (if (fad:pathname-relative-p build-directory)
-                               (fad:merge-pathnames-as-directory sys-path
+                               (fad:merge-pathnames-as-directory base-path
                                                                  (path build-directory))
                                (path build-directory))
             dist-directory (fad:merge-pathnames-as-directory this-build-dir
@@ -52,7 +54,7 @@
             this-engine-assets-dir (fad:merge-pathnames-as-directory
                                     dist-directory
                                     (path engine-assets-directory))
-            this-assets (expand-assets-path sys-path dist-directory assets)))))
+            this-assets (expand-assets-path base-path dist-directory assets)))))
 
 
 (defun parse-entry-function (entry-function)
@@ -63,17 +65,19 @@
      entry-function)))
 
 
-(defmacro define-distribution (name &key
-                                      target-system
-                                      (entry-function
-                                       (error ":entry-function must be specified"))
-                                      executable-name
-                                      (compressed-p t)
-                                      (build-directory #p"build/")
-                                      (library-directory #p"lib/")
-                                      (engine-assets-directory #p"assets/engine/")
-                                      assets
-                                      bundle)
+(defmacro distribution (name &body body
+                        &key target-system
+                          (entry-function
+                           (error ":entry-function must be specified"))
+                          (base-directory "./")
+                          executable-name
+                          (compressed-p t)
+                          (build-directory #p"build/")
+                          (library-directory #p"lib/")
+                          (engine-assets-directory #p"assets/engine/")
+                          assets
+                          bundle)
+  (declare (ignore body))
   (destructuring-bind (&key ((:name bundle-name) (format nil "~(~a~)" name))
                             ((:run-file bundle-run-file))
                             ((:compressed-p bundle-compressed-p) t))
@@ -83,6 +87,7 @@
 
     `(make-instance 'distribution
                     :name ,name
+                    :base-directory ,base-directory
                     :target-system ,(or target-system name)
                     :entry-function ,(parse-entry-function entry-function)
                     :executable-name ,(or executable-name (format nil "~(~a~).bin" name))

diff --git a/distribution/packages.lisp b/distribution/packages.lisp
@@ -4,5 +4,5 @@
 (defpackage :cl-bodge.distribution
   (:nicknames :ge.dist)
   (:use :cl :alexandria :asdf)
-  (:export define-distribution
+  (:export distribution
            make-distribution))
diff --git a/distribution/utils.lisp b/distribution/utils.lisp
@@ -66,20 +66,17 @@
     (sb-posix:chmod path (logior mode sb-posix:s-iexec))))
 
 
-(defun copy-path (src dst &optional observer)
-  (flet ((walker (path)
-           (let ((last-el (enough-namestring path src)))
-             (if (fad:directory-pathname-p path)
-                 (copy-path path (path dst last-el))
-                 (copy-path path (file dst last-el))))))
-    (ensure-directories-exist dst)
-    (if (fad:directory-pathname-p src)
-        (fad:walk-directory src #'walker :follow-symlinks nil)
-        (progn
-          (fad:copy-file src dst)
-          (copy-permissions src dst)
-          (when (functionp observer)
-            (funcall observer src dst))))))
+(defun copy-path (source destination &optional observer)
+  (labels ((%copy-path (src dst)
+             (ensure-directories-exist dst)
+             (fad:copy-file src dst)
+             (copy-permissions src dst)
+             (when (functionp observer)
+               (funcall observer src dst)))
+           (walker (path)
+             (let ((last-el (enough-namestring path source)))
+               (%copy-path path (file destination last-el)))))
+    (fad:walk-directory source #'walker :follow-symlinks nil)))
 
 
 (defun compress-directory (path &optional name)