templates – add default-skeleton keyword

default-template.lisp

@@ -0,0 +1,72 @@
+(in-package #:quickproject)
+
+(defun default-template-parameters ()
+  "Return a plist of :NAME, :LICENSE, and :AUTHOR parameters."
+  (list :name *name*
+        :license *license*
+        :author *author*))
+
+(defun uninterned-symbolize (name)
+  "Return an uninterned symbol named after NAME, which is treated as a
+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))))
+
+(defmacro with-new-file ((stream file) &body body)
+  "Like WITH-OPEN-FILE, but specialized for output to a file that must
+not already exist."
+  `(with-open-file (,stream ,file
+                            :direction :output
+                            :if-exists :error)
+     (let ((*print-case* :downcase))
+       ,@body)))
+
+(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 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 file)
+    (file-comment-header stream)
+    (format stream "(in-package ~S)~%~%" (uninterned-symbolize name))
+    (format stream ";;; ~S goes here. Hacks and glory await!~%~%" name)))

doc/index.html

@@ -83,6 +83,7 @@ <h2>Contents</h2>
       <var>name</var>
       <var>template-directory</var>
       <var>template-parameters</var>
+      <var>default-skeleton</var>
     </span>
     <span class='result'>=> <var>project-name</var></span>
   </div>
@@ -95,7 +96,7 @@ <h2>Contents</h2>
       the <a href="http://l1sp.org/cl/pathname-directory">pathname-directory</a>
       of the pathname. For example, the last directory component
       of <tt>#p"src/lisp/myproject/"</tt> is "myproject".
-    <p>The project skeleton consists of the following files:
+    <p>The default project skeleton consists of the following files:
 
 <ul>
 <li> README.txt
@@ -116,6 +117,10 @@ <h2>Contents</h2>
       will determine whether copyright notices will be printed in the
       header of each file.
 
+    <p>If provided, the boolean argument
+      to <var>default-skeleton</var> will determine whether the
+      default skeleton should be created.</p>
+
     <p>If provided, each file in <var>template-directory</var> is
     rewritten
     with <a href="http://weitz.de/html-template/">HTML-TEMPLATE</a>

package.lisp

@@ -12,9 +12,7 @@
            #:default-template-parameters
            #:*template-parameter-functions*)
   (:shadowing-import-from #:html-template
-                          #:fill-and-print-template
-                          #:*template-start-marker*
-                          #:*template-end-marker*)
+                          #:fill-and-print-template)
   (:shadowing-import-from #:cl-fad
                           #:pathname-as-directory
                           #:walk-directory))

quickproject.asd

@@ -2,9 +2,10 @@
 
 (asdf:defsystem #:quickproject
   :description "Creates the skeleton of a new Common Lisp project"
-           :version "1.2.2"
+  :version "1.2.2"
   :depends-on (#:cl-fad
                #:html-template)
   :serial t
   :components ((:file "package")
+               (:file "default-template")
                (:file "quickproject")))

quickproject.lisp

@@ -19,99 +19,38 @@
 (defvar *include-copyright* nil         ; This gives default behavior.
   "Include a copyright notice at the top of files.")
 
-(defun uninterned-symbolize (name)
-  "Return an uninterned symbol named after NAME, which is treated as a
-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
-#p\"src/awesome-project/\"."
-  (first (last (pathname-directory pathname))))
-
-(defmacro with-new-file ((stream file) &body body)
-  "Like WITH-OPEN-FILE, but specialized for output to a file that must
-not already exist."
-  `(with-open-file (,stream ,file
-                            :direction :output
-                            :if-exists :error)
-     (let ((*print-case* :downcase))
-       ,@body)))
-
-(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 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 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
 MAKE-PROJECT, except that NAME is canonicalized if
 necessary. *DEFAULT-PATHNAME-DEFAULTS* bound to the newly created
 project directory.")
 
+(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
+#p\"src/awesome-project/\"."
+  (first (last (pathname-directory pathname))))
+
 (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
 TARGET-DIRECTORY. The rewriting uses HTML-TEMPLATE. The template start
 marker is the string \"\(#|\" and the template end marker is the string
 \"|#)\". Template vars are not modified or escaped when written."
-  (let ((*template-start-marker* "(#|")
-        (*template-end-marker* "|#)")
+  (let ((html-template:*template-start-marker* "(#|")
+        (html-template:*template-end-marker* "|#)")
         (html-template:*warn-on-creation* nil)
         (html-template:*string-modifier* 'identity))
     (setf template-directory (truename template-directory)
           target-directory (truename target-directory))
     (flet ((rewrite-template (pathname)
              (let* ((relative-namestring
-                     (enough-namestring pathname template-directory))
+                     (with-output-to-string (rewrite-name)
+                       (fill-and-print-template
+                        (enough-namestring pathname template-directory)
+                        parameters
+                        :stream rewrite-name)))
                     (target-pathname (merge-pathnames relative-namestring
                                                       target-directory)))
                (ensure-directories-exist target-pathname)
@@ -124,12 +63,6 @@ marker is the string \"\(#|\" and the template end marker is the string
                                           :stream stream)))))
       (walk-directory template-directory #'rewrite-template))))
 
-(defun default-template-parameters ()
-  "Return a plist of :NAME, :LICENSE, and :AUTHOR parameters."
-  (list :name *name*
-        :license *license*
-        :author *author*))
-
 (defvar *template-parameter-functions* (list 'default-template-parameters)
   "A list of functions that return plists for use when rewriting
   template files. The results of calling each function are appended
@@ -149,7 +82,8 @@ marker is the string \"\(#|\" and the template end marker is the string
                      ((:author *author*) *author*)
                      ((:license *license*) *license*)
                      (name (pathname-project-name pathname) name-provided-p)
-                     ((:include-copyright *include-copyright*) *include-copyright*))
+                     ((:include-copyright *include-copyright*) *include-copyright*)
+                     (default-skeleton t))
   "Create a project skeleton for NAME in PATHNAME. If DEPENDS-ON is provided,
 it is used as the asdf defsystem depends-on list."
   (when (pathname-name pathname)
@@ -163,10 +97,11 @@ 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"))
+    (when default-skeleton
+      (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*