env

Makefile.am

@@ -39,6 +39,7 @@ LISPS = helper.el \
 	\
 	delete.ros \
 	delete-dump.lisp delete-git.lisp delete-asdf.lisp \
+	delete-env.lisp \
 	\
 	dump.ros \
 	util-dump.lisp \
@@ -49,7 +50,7 @@ LISPS = helper.el \
 	help-install.lisp help-options.lisp help-run.lisp \
 	\
 	init.ros \
-	init-default.lisp \
+	init-default.lisp init-env.lisp \
 	\
 	install.ros \
 	util-install.lisp util-install-quicklisp.lisp \
@@ -65,14 +66,14 @@ LISPS = helper.el \
 	\
 	list.ros \
 	list-dump.lisp list-git.lisp list-installed.lisp list-versions.lisp \
-	list-asdf.lisp \
+	list-asdf.lisp list-env.lisp \
 	\
 	template.ros \
 	util-template.lisp \
 	\
 	use.ros \
 	util-use.lisp \
-	use-asdf.lisp \
+	use-asdf.lisp use-env.lisp \
 	\
 	which.ros
 roslisp_DATA = $(LISPS:%=lisp/%)

lisp/delete-env.lisp

@@ -0,0 +1,15 @@
+(defpackage :roswell.delete.env
+  (:use :cl :roswell.util))
+(in-package :roswell.delete.env)
+
+(defun env (&rest argv)
+  (if (rest argv)
+      (dolist (x (rest argv) (roswell:quit 0))
+        (let ((* (probe-file (merge-pathnames (format nil "env/~A/config" x)
+                                              (roswell:opt "homedir")))))
+          (when *
+            (format t "delete ~S~%" x)
+            (uiop/filesystem:delete-directory-tree
+             (make-pathname :defaults * :name nil) :validate t))))
+      `(,(roswell:opt "wargv0") "help" ,(format nil "delete-env"))))
+

lisp/init-env.lisp

@@ -0,0 +1,36 @@
+(defpackage :roswell.init.env
+  (:use :cl :roswell.util))
+(in-package :roswell.init.env)
+
+(defun install-quicklisp (&optional path
+                            (from (merge-pathnames "lisp/quicklisp/" (homedir))))
+  (dolist (relative '("" "quicklisp/" "local-init/"))
+    (dolist (file (uiop:directory-files (merge-pathnames "*.*" (merge-pathnames relative from))))
+      (uiop:copy-file file (make-pathname
+                            :defaults (ensure-directories-exist (merge-pathnames relative path))
+                            :name (pathname-name file)
+                            :type (pathname-type file))))))
+
+(defun env (name &rest params)
+  (setf name (first params))
+  (let* ((path (if name
+                   (merge-pathnames (format nil "env/~A/config" name)
+                                    (opt "homedir"))
+                   (error "name is not specified")))
+         (lisp (ros:opt "default.lisp"))
+         (ver (ros:opt (format nil "~A.version" lisp))))
+    (unless
+        (with-open-file (out (ensure-directories-exist path)
+                             :direction :output
+                             :if-exists nil
+                             :if-does-not-exist :create)
+          (when out
+            (format out "default.lisp	0	~A~%" lisp)
+            (format out "~A.version	0	~A~%" lisp ver)
+            (when name
+              (format out "quicklisp	0	~A~%" name)
+              (install-quicklisp (merge-pathnames "lisp/quicklisp/" (make-pathname :defaults path :name nil))))
+            (format t "~&Successfully generated: ~A~%" path)
+            t))
+      (format *error-output* "~&File already exists: ~A~%" path)
+      (roswell:quit 1))))

lisp/list-env.lisp

@@ -0,0 +1,13 @@
+(defpackage :roswell.list.env
+  (:use :cl)
+  (:export :env :env-list))
+(in-package :roswell.list.env)
+
+(defun env-list ()
+  (mapcar (lambda (i) (first (last (pathname-directory i))))
+          (directory (merge-pathnames "env/*/config" (roswell:opt "homedir")))))
+
+(defun env (&rest r)
+  (cond ((null r)
+         (dolist (i (env-list))
+           (format t "~A~A~%" (if (equal (roswell:opt "roswellenv") i) :* " ") i)))))

lisp/use-env.lisp

@@ -0,0 +1,20 @@
+(ros:include '("list-env" "util-config") "use-env")
+(defpackage :roswell.use.env
+  (:use :cl :roswell.util.config))
+(in-package :roswell.use.env)
+
+(defun env (impl version &rest r)
+  (declare (ignore impl version))
+  (let ((conf (load-config ".roswellenv")))
+    (cond
+      ((null r)
+       (roswell.list.env:env)
+       t)
+      ((member (first r) '("no" "-") :test 'equal)
+       (setf conf (unconfig conf "roswellenv"))
+       (save-config ".roswellenv" conf)
+       t)
+      ((find (first r) (roswell.list.env:env-list) :test 'equal)
+       (setf conf (config conf "roswellenv" (first r)))
+       (save-config ".roswellenv" conf))
+      (t (error "env ~A not exists." (first r))))))