diff --git a/default-template.lisp b/default-template.lisp new file mode 100644 index 0000000..ce9819c --- /dev/null +++ b/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))) diff --git a/doc/index.html b/doc/index.html index e5b54ea..8b2d5b3 100644 --- a/doc/index.html +++ b/doc/index.html @@ -83,6 +83,7 @@
The project skeleton consists of the following files: +
The default project skeleton consists of the following files:
If provided, the boolean argument + to default-skeleton will determine whether the + default skeleton should be created.
+If provided, each file in template-directory is rewritten with HTML-TEMPLATE diff --git a/package.lisp b/package.lisp index 9244391..3004ffe 100644 --- a/package.lisp +++ b/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)) diff --git a/quickproject.asd b/quickproject.asd index 108f795..5e3fd92 100644 --- a/quickproject.asd +++ b/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"))) diff --git a/quickproject.lisp b/quickproject.lisp index 8025253..a684baf 100644 --- a/quickproject.lisp +++ b/quickproject.lisp @@ -19,77 +19,6 @@ (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 @@ -97,21 +26,31 @@ 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*