From a90c8f8abe14d1ebbbea23c5d7f8173cfe4dd335 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Sat, 27 Aug 2016 13:01:16 +0200 Subject: [PATCH 1/8] Separate default template code from the main file. --- default-template.lisp | 72 +++++++++++++++++++++++++++++++++++++++++++ quickproject.asd | 1 + quickproject.lisp | 71 ------------------------------------------ 3 files changed, 73 insertions(+), 71 deletions(-) create mode 100644 default-template.lisp diff --git a/default-template.lisp b/default-template.lisp new file mode 100644 index 0000000..1d7c2d5 --- /dev/null +++ b/default-template.lisp @@ -0,0 +1,72 @@ +(in-package #:quickproject) + +(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))) diff --git a/quickproject.asd b/quickproject.asd index 108f795..f23a451 100644 --- a/quickproject.asd +++ b/quickproject.asd @@ -7,4 +7,5 @@ #:html-template) :serial t :components ((:file "package") + (:file "default-template") (:file "quickproject"))) diff --git a/quickproject.lisp b/quickproject.lisp index 8025253..6b143ba 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 From 2486f707b46827a284fda0a855abc1ed695fd248 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Sat, 27 Aug 2016 13:03:17 +0200 Subject: [PATCH 2/8] cosmetic: indent version --- quickproject.asd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/quickproject.asd b/quickproject.asd index f23a451..5e3fd92 100644 --- a/quickproject.asd +++ b/quickproject.asd @@ -2,7 +2,7 @@ (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 From 5a84b1528d2ce6390a59b18997eda165deb70489 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Sat, 27 Aug 2016 13:04:40 +0200 Subject: [PATCH 3/8] Move PATHNAME-PROJECT-NAME to quicklisp.lisp --- default-template.lisp | 6 ------ quickproject.lisp | 6 ++++++ 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/default-template.lisp b/default-template.lisp index 1d7c2d5..e0b1109 100644 --- a/default-template.lisp +++ b/default-template.lisp @@ -20,12 +20,6 @@ string designator and upcased." (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." diff --git a/quickproject.lisp b/quickproject.lisp index 6b143ba..ffbe0a2 100644 --- a/quickproject.lisp +++ b/quickproject.lisp @@ -26,6 +26,12 @@ 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 From 55716c2b7920e90f078ccba567b2d370ebd62ff0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Sat, 27 Aug 2016 13:06:44 +0200 Subject: [PATCH 4/8] Move DEFAULT-TEMPLATE-PARAMETERS to default-template.lisp --- default-template.lisp | 6 ++++++ quickproject.lisp | 6 ------ 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/default-template.lisp b/default-template.lisp index e0b1109..ce9819c 100644 --- a/default-template.lisp +++ b/default-template.lisp @@ -1,5 +1,11 @@ (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." diff --git a/quickproject.lisp b/quickproject.lisp index ffbe0a2..49f212f 100644 --- a/quickproject.lisp +++ b/quickproject.lisp @@ -59,12 +59,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 From 76ac615e0de2bdbaf39805ca787beab876e6c45d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Sat, 27 Aug 2016 13:20:45 +0200 Subject: [PATCH 5/8] make-project: conditionalize default-skeleton Don't create the default skeleton, if the `default-skeleton` keyword is NIL (by default to preserve a backward compatibility it is T). --- quickproject.lisp | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/quickproject.lisp b/quickproject.lisp index 49f212f..ff70266 100644 --- a/quickproject.lisp +++ b/quickproject.lisp @@ -78,7 +78,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) @@ -92,10 +93,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* From 49e2ad876e2667e6d30a122679946e23d535c00e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Sat, 27 Aug 2016 13:26:20 +0200 Subject: [PATCH 6/8] documentation: add new keyword parameter description If default-skeleton set to NIL causes skipping the creation of default skeleton files. --- doc/index.html | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) 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 @@

Contents

name template-directory template-parameters + default-skeleton => project-name @@ -95,7 +96,7 @@

Contents

the pathname-directory of the pathname. For example, the last directory component of #p"src/lisp/myproject/" is "myproject". -

The project skeleton consists of the following files: +

The default project skeleton consists of the following files:

  • README.txt @@ -116,6 +117,10 @@

    Contents

    will determine whether copyright notices will be printed in the header of each file. +

    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 From 156047e2cc1883e6f8676ab2ff3b84fa779ba447 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Sat, 27 Aug 2016 19:16:23 +0200 Subject: [PATCH 7/8] cosmetic: be specific with template markers Other two variables have a full qualifier and start/end marker aren't used more than one time. --- package.lisp | 4 +--- quickproject.lisp | 4 ++-- 2 files changed, 3 insertions(+), 5 deletions(-) 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.lisp b/quickproject.lisp index ff70266..157d419 100644 --- a/quickproject.lisp +++ b/quickproject.lisp @@ -38,8 +38,8 @@ 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) From 2ca92fde1bae62c49a517ae80b4967b8a4cddfc2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Sat, 27 Aug 2016 19:18:42 +0200 Subject: [PATCH 8/8] rewrite-template: allow rewriting a file name This is necessary to be able to create templates with files named as a system, for instance quux.asd . Quicklisp could have problems with system.asd containing quux system. --- quickproject.lisp | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/quickproject.lisp b/quickproject.lisp index 157d419..a684baf 100644 --- a/quickproject.lisp +++ b/quickproject.lisp @@ -46,7 +46,11 @@ marker is the string \"\(#|\" and the template end marker is the string 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)