Update domain name to kpe.io
[vcs-tree.git] / vcs-tree.asd
index 9022540226043ef2cf6276ef7e1492aa0469260f..f192bf7dc12c03e46da41c64874284fd24fdc8f1 100644 (file)
 ;;;; *************************************************************************
 
 (in-package cl-user)
-(defpackage vcs-tree-system (:use #:cl #:asdf))
+(defpackage vcs-tree-system
+  (:use #:cl #:asdf)
+  (:export save-executable))
 (in-package vcs-tree-system)
 
-(require 'sb-executable)
-
-;;; From asdf-install.asd
-(defclass exe-file (cl-source-file) ())
-(defmethod perform :after ((o compile-op) (c exe-file))
-  (sb-executable:make-executable
-   (make-pathname :name "vcs-tree"
-                 :type nil
-                 :defaults (component-pathname c))
-   (mapcar
-    #'(lambda (n)
-       (make-pathname :name n :type "fasl"
-                      :defaults (car (output-files o c))))
-    '("package" "kmrcl-excerpt" "getopt-excerpt" "main" "loader"))
-   :initial-function "RUN"))
-
-(defmethod perform ((o load-op) (c exe-file)) nil)
+(defun save-executable (&optional (fname "_vcs-tree"))
+  (setq cl:*print-pretty* nil)
+  (sb-ext:save-lisp-and-die
+   fname
+   :executable t
+   :toplevel (lambda ()
+               (handler-case
+                   (funcall (intern (symbol-name '#:main)
+                                    (find-package (symbol-name '#:vcs-tree)))
+                            (list* "vcs-tree" (cdr sb-ext:*posix-argv*)))
+                 (error (c)
+                   (format *error-output* "vcs-tree failed due to error:~%  ~A~%" c)
+                   (sb-ext:quit :unix-status 1)))
+               (sb-ext:quit :unix-status 0))))
 
 (defsystem vcs-tree
-  :version "0.1"
+  :version "0.3"
   :components ((:file "package")
-              (:exe-file "loader" :depends-on ("main"))
               (:file "kmrcl-excerpt" :depends-on ("package"))
               (:file "getopt-excerpt" :depends-on ("package"))
               (:file "main" :depends-on ("kmrcl-excerpt" "getopt-excerpt"))))
-              
-(defmethod perform :after ((o load-op) (c (eql (find-system :vcs-tree))))
-  (provide 'vcs-tree))
-
-(defmethod perform ((o test-op) (c (eql (find-system :vcs-tree))))
-  t)