diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..e4e5f6c --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +*~ \ No newline at end of file diff --git a/default-template/README.md b/default-template/README.md new file mode 100644 index 0000000..97588dd --- /dev/null +++ b/default-template/README.md @@ -0,0 +1,12 @@ +# (#| TMPL_VAR name |#) +### _(#| TMPL_VAR author |#)_ + +This is a project to do ... something. + +## License + +(#| TMPL_VAR license |#) +(#| TMPL_IF copyright |#) + +(#| TMPL_VAR copyright |#) +(#| /TMPL_IF |#) diff --git a/default-template/application.lisp b/default-template/application.lisp new file mode 100644 index 0000000..564d244 --- /dev/null +++ b/default-template/application.lisp @@ -0,0 +1,5 @@ +;;;; (#| TMPL_VAR name |#).lisp(#| TMPL_IF copyright |#) +;; +;;;; (#| TMPL_VAR copyright |#)(#| /TMPL_IF |#) + +(in-package #:(#| TMPL_VAR name |#)) diff --git a/default-template/package.lisp b/default-template/package.lisp new file mode 100644 index 0000000..ae60d64 --- /dev/null +++ b/default-template/package.lisp @@ -0,0 +1,6 @@ +;;;; package.lisp(#| TMPL_IF copyright |#) +;; +;;;; (#| TMPL_VAR copyright |#)(#| /TMPL_IF |#) + +(defpackage #:(#| TMPL_VAR name |#) + (:use #:cl)) diff --git a/default-template/system.asd b/default-template/system.asd new file mode 100644 index 0000000..186db66 --- /dev/null +++ b/default-template/system.asd @@ -0,0 +1,13 @@ +;;;; (#| TMPL_VAR name |#).asd(#| TMPL_IF copyright |#) +;; +;;;; (#| TMPL_VAR copyright |#)(#| /TMPL_IF |#) + +(asdf:defsystem #:(#| TMPL_VAR name |#) + :description "Describe (#| TMPL_VAR name |#) here" + :author "(#| TMPL_VAR author |#)" + :license "(#| TMPL_VAR license |#)" + :version "0.0.1" + :serial t(#| TMPL_IF depends-on |#) + :depends-on (#| TMPL_VAR dependencies-string |#)(#| /TMPL_IF |#) + :components ((:file "package") + (:file "(#| TMPL_VAR name |#)"))) diff --git a/quickproject.lisp b/quickproject.lisp index fa19cb7..14c8cb7 100644 --- a/quickproject.lisp +++ b/quickproject.lisp @@ -6,9 +6,12 @@ (setf (documentation '*name* 'variable) "The name of the project currently being created.") -(defvar *template-directory* nil +(defvar *template-directory* (asdf/system:system-relative-pathname :quickproject "default-template") "A directory to use as a source of template files.") +(defvar *depends-on* nil + "Dependencies specified at project creation") + (defvar *author* "Your Name " "Set this variable to your contact information.") @@ -24,21 +27,6 @@ string designator and upcased." (make-symbol (string-upcase name))) -(defun write-system-form (name &key depends-on (stream *standard-output*)) - "Write an asdf defsystem form for NAME to STREAM." - (let ((*print-case* :downcase)) - (format stream "(asdf:defsystem ~S~%" (uninterned-symbolize name)) - (format stream " :description \"Describe ~A here\"~%" - name) - (format stream " :author ~S~%" *author*) - (format stream " :license ~S~%" *license*) - (when depends-on - (format stream " :depends-on (~{~S~^~%~15T~})~%" - (mapcar #'uninterned-symbolize depends-on))) - (format stream " :serial t~%") - (format stream " :components ((:file \"package\")~%") - (format stream " (:file ~S)))~%" (string-downcase name)))) - (defun pathname-project-name (pathname) "Return a project name based on PATHNAME by taking the last element in the pathname-directory list. E.g. returns \"awesome-project\" for @@ -57,39 +45,6 @@ not already exist." (defun current-year () (nth-value 5 (decode-universal-time (get-universal-time)))) -(defun file-comment-header (stream) - (format stream ";;;; ~A~%" (file-namestring stream)) - (when *include-copyright* - (format stream ";;;;~%") - (format stream ";;;; Copyright (c) ~D ~A~%" (current-year) *author*)) - (terpri stream)) - -(defun write-system-file (name file &key depends-on) - (with-new-file (stream (string-downcase file)) - (file-comment-header stream) - (write-system-form name - :depends-on depends-on - :stream stream) - (terpri stream))) - -(defun write-readme-file (name file) - (with-new-file (stream file) - (format stream "This is the stub ~A for the ~S project.~%" - (file-namestring file) - name))) - -(defun write-package-file (name file) - (with-new-file (stream file) - (file-comment-header stream) - (format stream "(defpackage ~S~%" (uninterned-symbolize name)) - (format stream " (:use #:cl))~%~%"))) - -(defun write-application-file (name file) - (with-new-file (stream (string-downcase file)) - (file-comment-header stream) - (format stream "(in-package ~S)~%~%" (uninterned-symbolize name)) - (format stream ";;; ~S goes here. Hacks and glory await!~%~%" name))) - (defvar *after-make-project-hooks* nil "A list of functions to call after MAKE-PROJECT is finished making a project. Each function is called with the same arguments passed to @@ -97,6 +52,20 @@ MAKE-PROJECT, except that NAME is canonicalized if necessary. *DEFAULT-PATHNAME-DEFAULTS* bound to the newly created project directory.") +(defun template-pathname->output-name (path) + (flet ((mk-path (name) + (make-pathname + :directory (pathname-directory path) + :name name + :type (pathname-type path)))) + (cond ((and (string= "asd" (pathname-type path)) + (string= "system" (pathname-name path))) + (mk-path *name*)) + ((and (string= "lisp" (pathname-type path)) + (string= "application" (pathname-name path))) + (mk-path *name*)) + (t path)))) + (defun rewrite-templates (template-directory target-directory parameters) "Treat every file in TEMPLATE-DIRECTORY as a template file; fill it out using PARAMETERS into a corresponding file in @@ -112,8 +81,9 @@ marker is the string \"\(#|\" and the template end marker is the string (flet ((rewrite-template (pathname) (let* ((relative-namestring (enough-namestring pathname template-directory)) - (target-pathname (merge-pathnames relative-namestring - target-directory))) + (target-pathname (template-pathname->output-name + (merge-pathnames relative-namestring + target-directory)))) (ensure-directories-exist target-pathname) (with-open-file (stream target-pathname @@ -128,7 +98,14 @@ marker is the string \"\(#|\" and the template end marker is the string "Return a plist of :NAME, :LICENSE, and :AUTHOR parameters." (list :name *name* :license *license* - :author *author*)) + :author *author* + :depends-on (mapcar + (lambda (sym) + (list :symbol sym :uninterned (format nil "#:~(~a~)" sym))) + *depends-on*) + :dependencies-string (format nil "(~{#:~(~a~)~^ ~})" *depends-on*) + :copyright (when *include-copyright* + (format nil "Copyright (c) ~D ~A~%" (current-year) *author*)))) (defvar *template-parameter-functions* (list 'default-template-parameters) "A list of functions that return plists for use when rewriting @@ -142,17 +119,17 @@ marker is the string \"\(#|\" and the template end marker is the string (mapcar 'funcall *template-parameter-functions*))) (defun make-project (pathname &key - depends-on template-parameters ((:template-directory *template-directory*) *template-directory*) + ((:depends-on *depends-on*) *depends-on*) ((:author *author*) *author*) ((:license *license*) *license*) (name (pathname-project-name pathname) name-provided-p) ((:include-copyright *include-copyright*) *include-copyright*)) "Create a project skeleton for NAME in PATHNAME. If DEPENDS-ON is provided, it is used as the asdf defsystem depends-on list." - (check-type depends-on list) + (check-type *depends-on* list) (when (pathname-name pathname) (warn "Coercing ~S to directory" pathname) @@ -164,15 +141,10 @@ it is used as the asdf defsystem depends-on list." (nametype (type) (relative (make-pathname :name name :type type)))) (ensure-directories-exist pathname) - (write-readme-file name (relative "README.txt")) - (write-system-file name (nametype "asd") :depends-on depends-on) - (write-package-file name (relative "package.lisp")) - (write-application-file name (nametype "lisp")) (let ((*default-pathname-defaults* (truename pathname)) (*name* name)) - (when *template-directory* - (rewrite-templates *template-directory* *default-pathname-defaults* - (template-parameters template-parameters))) + (rewrite-templates *template-directory* *default-pathname-defaults* + (template-parameters template-parameters)) (pushnew *default-pathname-defaults* asdf:*central-registry* :test 'equal) (dolist (hook *after-make-project-hooks*)