start lspack

README.md

@@ -1,3 +0,0 @@
-# lspack
-
-Common Lisp project initialization

README.org

@@ -0,0 +1,3 @@
+* lspack
+
+Lisp Starter Pack

lspack.asd

@@ -0,0 +1,8 @@
+(asdf:defsystem "lspack"
+  :author "Emre Akan"
+  :description "Quickstart Common Lisp projects"
+  :license "GPL-3.0"
+  :version "0.0.1"
+  :pathname "src/"
+  :components ((:file "package")
+               (:file "starter")))

src/package.lisp

@@ -0,0 +1,2 @@
+(defpackage :lspack
+  (:use :cl))

src/starter.lisp

@@ -0,0 +1,109 @@
+(in-package :lspack)
+
+(defparameter *default-author* "")
+(defparameter *default-license* "")
+(defparameter *default-pathname* "")
+(defparameter *default-version* "0.0.0")
+
+(defclass <project> ()
+  ((root :initarg :project-root
+         :accessor project-root
+         :type pathname)
+   (name :initarg :project-name
+         :accessor project-name
+         :initform ""
+         :type string)
+   (author :initarg :project-author
+           :accessor project-author
+           :initform *default-author*
+           :type string)
+   (description :initarg :project-description
+                :accessor project-description
+                :initform ""
+                :type string)
+   (license :initarg :project-license
+            :accessor project-license
+            :initform *default-license*
+            :type string)
+   (version :initarg :project-version
+            :accessor project-version
+            :initform *default-version*
+            :type string)
+   (pathname :initarg :project-pathname
+             :accessor project-pathname
+             :initform *default-pathname*
+             :type string)))
+
+(defparameter *test-project*
+  (make-instance '<project>
+                 :project-root #P"/tmp/tempo/"
+                 :project-name "my-project"
+                 :project-author "name"
+                 :project-description "a project"
+                 :project-pathname ""))
+
+(defmethod project-defsystem-write ((project <project>) stream)
+  (with-slots (name author description license version pathname)
+      project
+    (fresh-line stream)
+    (write-char #\( stream)
+    (format stream "asdf:defsystem ~S" name)
+    (format stream "~&  :author ~S" author)
+    (format stream "~&  :description ~S" description)
+    (format stream "~&  :license ~S" license)
+    (format stream "~&  :version ~S" version)
+    (unless (null pathname)
+      (format stream "~&  :pathname ~S" pathname))
+    (format stream "~&  :components ((:file \"package\"))")
+    (write-char #\) stream)
+    (terpri stream)))
+
+(defmethod project-defsystem-pathname ((project <project>))
+  (uiop:merge-pathnames* (uiop:make-pathname* :name (project-name project)
+                                              :type "asd")
+                         (project-root project)))
+
+(defmethod project-defsystem-create ((project <project>))
+  (let ((path (project-defsystem-pathname project)))
+    (with-open-file (out path :direction :output
+                              :if-exists :supersede
+                              :if-does-not-exist :create)
+      (project-defsystem-write project out))
+    (format *error-output* "~&Created ~S" path)))
+
+(defmethod project-ensure-root ((project <project>))
+  (with-slots (root) project
+    (ensure-directories-exist (uiop:physicalize-pathname root))
+    (format *error-output* "~&Starting project at ~S" root)))
+
+(defmethod project-source-pathname ((project <project>))
+  (uiop:merge-pathnames* (uiop:ensure-directory-pathname (project-pathname project))
+                         (project-root project)))
+
+(defmethod project-ensure-source-directory ((project <project>))
+  (with-slots (pathname) project
+    (let ((src (project-source-pathname project)))
+      (format *error-output* "~&Source directory: ~S" src)
+      (unless (string= pathname "")
+        (ensure-directories-exist (uiop:physicalize-pathname src))
+        (format *error-output* " created.")))))
+
+(defmethod project-create-package ((project <project>))
+  (with-slots (root name pathname) project
+    (let ((path (uiop:merge-pathnames* (uiop:make-pathname* :name "package"
+                                                            :type "lisp")
+                                       (project-source-pathname project))))
+      (with-open-file (out path :direction :output
+                                :if-exists :supersede
+                                :if-does-not-exist :create)
+        (format out "(defpackage :~a~%  (:use :cl))~%" name))
+      (format *error-output* "~&Created ~S" path))))
+
+(defmethod project-start ((project <project>))
+  (project-ensure-root project)
+  (project-defsystem-create project)
+  (project-ensure-source-directory project)
+  (project-create-package project))
+
+;; (defun start (name &key (author "") (description "") (license ""))
+;;   "Intended to be called interactively by the user at the repl")