Revert "Revert "Merge pull request #139 from roswell/templates""

This reverts commit 84d011bb88.
2026-09-10 07:16:17 -04:00 · 2016-04-18 21:16:49 +09:00 · 2016-04-18 21:16:49 +09:00 · b018ab1b5f
parent be65a65502
commit b018ab1b5f
18 changed files with 864 additions and 53 deletions
--- a/.travis.yml
+++ b/.travis.yml
@ -1,21 +1,5 @@
 language: c
 sudo: false
-
-matrix:
-  include:
-    - sudo: required
-      os: linux
-      env: METHOD=cross XCC=i686-w64-mingw32-gcc HOST="--host=i686-w64-mingw32" PREFIX="--prefix=/usr/i686-w64-mingw32"
-    - sudo: required
-      os: linux
-      env: METHOD=debian
-    - sudo: required
-      os: linux
-      env: METHOD=documents
-    - sudo: required
-      os: linux
-      env: METHOD=valgrind XCFLAGS="-g -O0"
-
 env:
  global:
    - PATH=~/.roswell/bin:~/.linuxbrew/bin:$PATH
@ -38,6 +22,23 @@ os:
  - osx
  - linux

+matrix:
+  allow_failures:
+    - env: METHOD=brew
+  include:
+    - sudo: required
+      os: linux
+      env: METHOD=cross XCC=i686-w64-mingw32-gcc HOST="--host=i686-w64-mingw32" PREFIX="--prefix=/usr/i686-w64-mingw32"
+    - sudo: required
+      os: linux
+      env: METHOD=debian
+    - sudo: required
+      os: linux
+      env: METHOD=documents
+    - sudo: required
+      os: linux
+      env: METHOD=valgrind XCFLAGS="-g -O0"
+
 #branches:
 #  except:
 #      - /^v[0-9]/
@ -74,7 +75,7 @@ install:

 script:
  - if [ "$METHOD" = "documents" ]; then rm documents/man/* documents/html/*; fi
-  - if [ "$METHOD" = "documents" ]; then sh bootstrap;./configure --enable-manual-generation --enable-html-generation;make clean;make;sudo make install; fi
+  - if [ "$METHOD" = "documents" ]; then sh bootstrap;./configure --enable-manual-generation --enable-html-generation;make;sudo make install; fi
  - if [ "$METHOD" = "brew" ]; then brew install roswell --HEAD; fi
  - if [ "$METHOD" = "ci" ]; then sh ./scripts/install-for-ci.sh; fi
  - if [ "$METHOD" = "cross" ] || [ "$METHOD" = "valgrind" ] || ([ x$TRAVIS_TAG != x ] && [ $METHOD = debian ]); then
@ -84,7 +85,7 @@ script:
  - if [ "$METHOD" = "brew" ] || [ "$METHOD" = "ci" ]; then ros version=t run; fi
  - if [ "$METHOD" = "brew" ] || [ "$METHOD" = "ci" ]; then ros config; fi
  - if [ "$METHOD" = "brew" ] || [ "$METHOD" = "ci" ]; then ros install prove; fi
-  - if [ "$METHOD" = "brew" ] || [ "$METHOD" = "ci" ]; then run-prove roswell-test.asd; fi
+  - if [ "$METHOD" = "brew" ] || [ "$METHOD" = "ci" ]; then run-prove roswell-test.asd 2>&1 ; fi
  - if [ "$METHOD" = "ci" ]; then ros -q run && [`ros -q run 2>&1` == ""]; fi
  - if [ "$METHOD" = "ci" ] && [ "$LISP" = "sbcl-bin" ]; then [`ros -e "(ros:ignore-shebang)" -e '(loop for x in (directory "src/lisp/*.ros") do (load x))' 2>&1` == ""]; fi
  - if [ x$TRAVIS_TAG != x ] && [ $METHOD = debian ]; then ros install prove;ros ./scripts/debian.ros; fi
--- a/circle.yml
+++ b/circle.yml
@ -5,6 +5,10 @@ dependencies:
      - sudo apt-get update
      - sudo apt-get -qq install pandoc ruby-sass

+
+machine:
+  environment:
+    PATH: ~/.roswell/bin:~/.linuxbrew/bin:$PATH
 test:
  post:
    - sh bootstrap
@ -14,6 +18,8 @@ test:
    - ros version
    - ros -v setup
    - ros install
+    - ros install prove
+    - run-prove roswell-test.asd
    - ros install sbcl
    - ros -v run -- --version
    - ros install ccl-bin
--- a/documents/Makefile.am
+++ b/documents/Makefile.am
@ -5,7 +5,7 @@
 # http://pandoc.org/README.html#using-variables-in-templates
 # https://github.com/jgm/pandoc-templates/blob/master/default.man

-MDS = ros.md ros-dump.md ros-init.md ros-install.md ros-list.md ros-setup.md ros-config.md ros-delete.md ros-emacs.md ros-run.md ros-use.md ros-wait.md ros-asdf.md
+MDS = ros.md ros-dump.md ros-init.md ros-install.md ros-list.md ros-setup.md ros-config.md ros-delete.md ros-emacs.md ros-run.md ros-use.md ros-wait.md ros-asdf.md ros-template.md
 # separated by semicolons
 PANDOC_AUTHORS="Roswell Project Team"

@ -25,7 +25,7 @@ CLEANFILES = $(HTMLS)
 endif

 if HTML_GENERATE
-HTMLS = $(MDS:%.md=html/%.html) html/ros.css
+HTMLS = $(MDS:%.md=html/%.html)
 html/%.html: %.md
 	which pandoc
 # awk hack --- check every underlined words for its corresponding md file, replacing it to an appropriate markdown link to html file if it exist (e.g. _ros-use_ -> check ros-use.md -> [ros-use](ros-use.html) )
--- a/documents/html/ros-init.html
+++ b/documents/html/ros-init.html
@ -20,16 +20,20 @@
 </header>
 <p>ros-init - Create a roswell script (optionally based on a template)</p>
 <h1 id="synopsis">Synopsis</h1>
-<p><strong>ros init [template]</strong> name</p>
-<!-- # subcommands -->
-
+<p><strong>ros init NAME [TEMPLATE [ARGS...]]</strong></p>
 <dl>
-<dt>template</dt>
-<dd>Specify the name of a template.
+<dt>TEMPLATE</dt>
+<dd><p>Specifies the name of a template, defaulted to <em>default</em> template. However, if <em>TEMPLATE</em> is not specified and <em>FILENAME</em> matches one of the templates being stored, then it automatically uses the template. To suppress this behavior, you should explicitly specify <em>TEMPLATE</em> as <em>default</em>.</p>
+<p>Thus you are warned when you use this command from a shell script. In order to achieve a consistent and desired behavior, it is adviced that they should always explicitly specify the template name.</p>
+</dd>
+<dt>NAME</dt>
+<dd><p>Specify the output filename, or &quot;-&quot; to indicate <em>stdout</em>. When <em>TEMPLATE</em> is <em>default</em>, it automatically appends a file type &quot;.ros&quot;.</p>
 </dd>
 </dl>
+<!-- # subcommands -->
+
 <h1 id="description">Description</h1>
-<p>Initialises [name].ros.</p>
+<p>Initialises a roswell file based on a template. User-specified templates can be added by <em><a href="ros-template.html">ros-template</a></em>(1).</p>
 <p>The default template is something like:</p>
 <pre><code>#!/bin/sh
 #|-*- mode:lisp -*-|#
@ -48,7 +52,7 @@ exec ros -Q -- $0 &quot;$@&quot;
 <!-- # Environmental Variables -->

 <h1 id="see-also">SEE ALSO</h1>
-<p><em>sbcl</em>(1) <em><a href="ros.html">ros</a></em>(1)</p>
+<p><em>sbcl</em>(1) <em><a href="ros.html">ros</a></em>(1) <em><a href="ros-template.html">ros-template</a></em>(1)</p>
 <p>_</p>
 </body>
 </html>
--- a/documents/html/ros-template.html
+++ b/documents/html/ros-template.html
@ -0,0 +1,73 @@
+<!DOCTYPE html>
+<html>
+<head>
+  <meta charset="utf-8">
+  <meta name="generator" content="pandoc">
+  <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=yes">
+  <title>ros-template(1)</title>
+  <style type="text/css">code{white-space: pre;}</style>
+  <link rel="stylesheet" href="../ros.css">
+  <!--[if lt IE 9]>
+    <script src="//cdnjs.cloudflare.com/ajax/libs/html5shiv/3.7.3/html5shiv-printshiv.min.js"></script>
+  <![endif]-->
+</head>
+<body>
+<header>
+<h1 class="title">ros-template(1)</h1>
+<ul>
+<li class="author">Roswell Project Team</li>
+</ul>
+</header>
+<h1 id="synopsis">Synopsis</h1>
+<p><strong>ros template</strong> [add|rm|list|show] [OPTIONS] [TEMPLATE [ARGS...]]</p>
+<p>Register, manage and remove the templates.</p>
+<p>The format of ARGS is same as the lambda list except the following translation:</p>
+<ul>
+<li>&amp;key, &amp;optional, &amp;rest corresponds to --key, --optional, --rest, respectively.</li>
+<li>Abbreviation as -k, -o, -r are available.</li>
+<li>Each argument is separated by --, instead of being surrounded by parentheses.</li>
+<li>Optional and keyword arguments can have a default value. When no defauilt value is specified, it implies an empty string.</li>
+</ul>
+<h1 id="examples">Examples</h1>
+<p>The following example shows how to register a template file (an asdf system definition) named <em>tmpl.asd</em>, then instantiate the template with some arguments.</p>
+<pre><code>$ cat tmpl.asd
+(asdf:defsystem NAME :author &quot;AUTHOR&quot; :depends-on DEP :short-description &quot;library by AUTHOR.&quot;)
+$ ros template add tmpl.asd NAME AUTHOR --optional DEP &quot;(:alexandria)&quot;
+$ ros init result.asd tmpl.asd bob-utilities Bob
+Successfully generated: result.asd
+$ cat result.asd:
+(asdf:defsystem bob-utilities :author &quot;Bob&quot; :depends-on (:alexandria) :short-description &quot;library by Bob.&quot;)</code></pre>
+<p>Notice the arguments are READ. Thus you may use &quot;#.&quot; readmacro in order to evaluate the arguments when the template is instantiated. For example,</p>
+<pre><code>$ echo $USER
+Bob
+$ ros init result.asd tmpl.asd bob-utilities &#39;#.(uiop:getenv &quot;USER&quot;)&#39;
+$ cat result.asd:
+(asdf:defsystem bob-utilities :author &quot;Bob&quot; :depends-on (:alexandria) :short-description &quot;library by Bob.&quot;)</code></pre>
+<p>The results are PRINCed, so the results are not escaped with &quot;&quot;. If you want the results to be escaped, it should be done in the template (as in &quot;AUTHOR&quot;).</p>
+<h1 id="subcommands">Subcommands</h1>
+<dl>
+<dt>add</dt>
+<dd><p>Registers a file <em>TEMPLATE</em>.</p>
+</dd>
+<dt>list</dt>
+<dd><p>Shows the list of the registered templates.</p>
+</dd>
+<dt>show</dt>
+<dd><p>Describes the contents of <em>TEMPLATE</em> which is already registered.</p>
+</dd>
+<dt>rm</dt>
+<dd><p>Ensures that a template <em>TEMPLATE</em> is removed.</p>
+</dd>
+</dl>
+<h1 id="options-for-ros-template-add">Options for <em>ros template add</em></h1>
+<ul>
+<li>-f,--force : Overwrites the existing template with the same name without asking</li>
+<li>-r,--recursive : register the directory recursively. TEMPLATE should be a directory in order to make this option meaningful.</li>
+<li>--name NAME : register the template with a given name, not the original filename.</li>
+</ul>
+<h1 id="misc">Misc</h1>
+<p>Registered templates are stored in directory $ROSWELL_HOME/templates/ .</p>
+<h1 id="see-also">SEE ALSO</h1>
+<p><em><a href="ros.html">ros</a></em>(1) <em><a href="ros-init.html">ros-init</a></em>(1) _</p>
+</body>
+</html>
--- a/documents/man/ros-template.1
+++ b/documents/man/ros-template.1
@ -0,0 +1,96 @@
+.TH "ros-template" "1" "" "" ""
+.nh \" Turn off hyphenation by default.
+.SH Synopsis
+.PP
+\f[B]ros template\f[] [add|rm|list|show] [OPTIONS] [TEMPLATE [ARGS...]]
+.PP
+Register, manage and remove the templates.
+.PP
+The format of ARGS is same as the lambda list except the following
+translation:
+.IP \[bu] 2
+&key, &optional, &rest corresponds to --key, --optional, --rest,
+respectively.
+.IP \[bu] 2
+Abbreviation as -k, -o, -r are available.
+.IP \[bu] 2
+Each argument is separated by --, instead of being surrounded by
+parentheses.
+.IP \[bu] 2
+Optional and keyword arguments can have a default value.
+When no defauilt value is specified, it implies an empty string.
+.SH Examples
+.PP
+The following example shows how to register a template file (an asdf
+system definition) named \f[I]tmpl.asd\f[], then instantiate the
+template with some arguments.
+.IP
+.nf
+\f[C]
+$\ cat\ tmpl.asd
+(asdf:defsystem\ NAME\ :author\ "AUTHOR"\ :depends-on\ DEP\ :short-description\ "library\ by\ AUTHOR.")
+$\ ros\ template\ add\ tmpl.asd\ NAME\ AUTHOR\ --optional\ DEP\ "(:alexandria)"
+$\ ros\ init\ result.asd\ tmpl.asd\ bob-utilities\ Bob
+Successfully\ generated:\ result.asd
+$\ cat\ result.asd:
+(asdf:defsystem\ bob-utilities\ :author\ "Bob"\ :depends-on\ (:alexandria)\ :short-description\ "library\ by\ Bob.")
+\f[]
+.fi
+.PP
+Notice the arguments are READ.
+Thus you may use "#." readmacro in order to evaluate the arguments when
+the template is instantiated.
+For example,
+.IP
+.nf
+\f[C]
+$\ echo\ $USER
+Bob
+$\ ros\ init\ result.asd\ tmpl.asd\ bob-utilities\ \[aq]#.(uiop:getenv\ "USER")\[aq]
+$\ cat\ result.asd:
+(asdf:defsystem\ bob-utilities\ :author\ "Bob"\ :depends-on\ (:alexandria)\ :short-description\ "library\ by\ Bob.")
+\f[]
+.fi
+.PP
+The results are PRINCed, so the results are not escaped with "".
+If you want the results to be escaped, it should be done in the template
+(as in "AUTHOR").
+.SH Subcommands
+.TP
+.B add
+Registers a file \f[I]TEMPLATE\f[].
+.RS
+.RE
+.TP
+.B list
+Shows the list of the registered templates.
+.RS
+.RE
+.TP
+.B show
+Describes the contents of \f[I]TEMPLATE\f[] which is already registered.
+.RS
+.RE
+.TP
+.B rm
+Ensures that a template \f[I]TEMPLATE\f[] is removed.
+.RS
+.RE
+.SH Options for \f[I]ros template add\f[]
+.IP \[bu] 2
+-f,--force : Overwrites the existing template with the same name without
+asking
+.IP \[bu] 2
+-r,--recursive : register the directory recursively.
+TEMPLATE should be a directory in order to make this option meaningful.
+.IP \[bu] 2
+--name NAME : register the template with a given name, not the original
+filename.
+.SH Misc
+.PP
+Registered templates are stored in directory $ROSWELL_HOME/templates/ .
+.SH SEE ALSO
+.PP
+\f[I]ros\f[](1) \f[I]ros-init\f[](1)
+.SH AUTHORS
+Roswell Project Team.
--- a/documents/ros-init.md
+++ b/documents/ros-init.md
@ -2,17 +2,30 @@ ros-init - Create a roswell script (optionally based on a template)

 # Synopsis

-**ros init [template]** name
+**ros init NAME [TEMPLATE [ARGS...]]** 
+
+TEMPLATE
+
+  : Specifies the name of a template, defaulted to *default*
+    template. However, if *TEMPLATE* is not specified and *FILENAME*
+    matches one of the templates being stored, then it automatically uses
+    the template. To suppress this behavior, you should explicitly
+    specify *TEMPLATE* as *default*.
+
+    Thus you are warned when you use this command from a shell script. In
+    order to achieve a consistent and desired behavior, it is adviced that
+    they should always explicitly specify the template name.
+
+NAME
+
+  : Specify the output filename, or "-" to indicate *stdout*. When *TEMPLATE* is *default*, it automatically appends a file type ".ros".
+

 <!-- # subcommands -->

-template
-
-  : Specify the name of a template.
-
 # Description

-Initialises [name].ros.
+Initialises a roswell file based on a template. User-specified templates can be added by _ros-template_(1).

 The default template is something like:

@ -37,5 +50,5 @@ This is basically a shell script which immediately invokes Roswell by exec (see
 <!-- # Environmental Variables -->

 # SEE ALSO
-_sbcl_(1) _ros_(1)
+_sbcl_(1) _ros_(1) _ros-template_(1)

--- a/documents/ros-template.md
+++ b/documents/ros-template.md
@ -0,0 +1,71 @@
+
+# Synopsis
+
+**ros template** [add|rm|list|show] [OPTIONS] [TEMPLATE [ARGS...]]
+
+Register, manage and remove the templates.
+
+The format of ARGS is same as the lambda list except the following translation:
+
+* &key, &optional, &rest corresponds to --key, --optional, --rest, respectively.
+* Abbreviation as -k, -o, -r are available.
+* Each argument is separated by --, instead of being surrounded by parentheses.
+* Optional and keyword arguments can have a default value. When no defauilt
+  value is specified, it implies an empty string.
+
+# Examples
+
+The following example shows how to register a template file (an asdf system definition) named *tmpl.asd*, then instantiate the template with some arguments.
+
+```
+$ cat tmpl.asd
+(asdf:defsystem NAME :author "AUTHOR" :depends-on DEP :short-description "library by AUTHOR.")
+$ ros template add tmpl.asd NAME AUTHOR --optional DEP "(:alexandria)"
+$ ros init result.asd tmpl.asd bob-utilities Bob
+Successfully generated: result.asd
+$ cat result.asd:
+(asdf:defsystem bob-utilities :author "Bob" :depends-on (:alexandria) :short-description "library by Bob.")
+```
+
+Notice the arguments are READ. Thus you may use "#." readmacro in order to evaluate the
+arguments when the template is instantiated. For example,
+
+```
+$ echo $USER
+Bob
+$ ros init result.asd tmpl.asd bob-utilities '#.(uiop:getenv "USER")'
+$ cat result.asd:
+(asdf:defsystem bob-utilities :author "Bob" :depends-on (:alexandria) :short-description "library by Bob.")
+```
+
+The results are PRINCed, so the results are not escaped with "".
+If you want the results to be escaped, it should be done in the template (as in "AUTHOR").
+
+# Subcommands
+
+add
+  : Registers a file *TEMPLATE*.
+
+list
+  : Shows the list of the registered templates.
+
+show
+  : Describes the contents of *TEMPLATE* which is already registered.
+
+rm
+  : Ensures that a template *TEMPLATE* is removed.
+
+# Options for *ros template add*
+
+* -f,--force : Overwrites the existing template with the same name without asking
+* -r,--recursive : register the directory recursively. TEMPLATE should be a directory in order to make this option meaningful.
+* --name NAME : register the template with a given name, not the original filename.
+
+
+# Misc
+
+Registered templates are stored in directory $ROSWELL_HOME/templates/ .
+
+# SEE ALSO
+_ros_(1)
+_ros-init_(1)
--- a/lisp/Makefile.am
+++ b/lisp/Makefile.am
@ -1,3 +1,3 @@
 roslispdir = $(datadir)/common-lisp/source/$(PACKAGE)
-roslisp_DATA = $(wildcard *.lisp) $(wildcard *.ros) $(wildcard *.asd)
+roslisp_DATA = $(wildcard *.lisp) $(wildcard *.ros) $(wildcard *.asd) default

--- a/lisp/default
+++ b/lisp/default
@ -0,0 +1,13 @@
+#!/bin/sh
+#|-*- mode:lisp -*-|#
+#| <Put a one-line description here>
+exec ros -Q -- $0 "$@"
+|#
+;;; vim: set ft=lisp lisp:
+;; created DATETIME
+(defpackage :ros.script.NAME.DATETIME
+  (:use :cl))
+(in-package :ros.script.NAME.DATETIME)
+(defun main (&rest argv)
+  (declare (ignorable argv)))
+
--- a/lisp/init.lisp
+++ b/lisp/init.lisp
@ -3,15 +3,15 @@

 The entry of all roswell commands.
 The true internal entry invoked by the C binary is ros:run.
-(to see how this function is invoked, consult ros.c, cmd-run-sbcl.c etc.)
+ (to see how this function is invoked, consult ros.c, cmd-run-sbcl.c etc.)
 All roswell commands are dispatched from this function via the symbol lookup.

 For example, -sp SP or --system-package SP will cause the roswell C binary
 to invoke #'system-package.

 This file also contains many functions which can be otherwise delegated to
-UIOP, such as run-command, quit, getenv. This is because UIOP may not be
-available in order implementations. Similarly, older implementations do not
+UIOP, such as run-program, quit, getenv. This is because UIOP may not be
+available in older implementations. Similarly, older implementations do not
 have the latest asdf, and this file has a workaround for this.

 |#
--- a/lisp/init.ros
+++ b/lisp/init.ros
@ -1,20 +1,180 @@
 #!/bin/sh
 #|-*- mode:lisp -*-|#
-#|Create new ros script
+#|Creates a new ros script, optionally based on a template.
 exec ros +Q -m roswell -L sbcl-bin -- $0 "$@"
 |#

 #-ros.util
 (ros:include "util")
-
-(when (cl:find-package :ros.sub.init)
-  (push :ros.sub.init *features*))
+#-ros.match
+(ros:include "match")

 (defpackage :ros.sub.init
-  (:use :cl :ros))
+  (:use :cl :ros.util :ros.match)
+  (:export
+   #:*filename*))

 (in-package :ros.sub.init)

+(defun usage ()
+  (format *error-output* "Usage: ros init FILENAME [TEMPLATE [ARGS...]]")
+  (format *error-output* "
+TEMPLATE is defaulted to \"default\".
+When TEMPLATE is missing and FILENAME matches the name of some template, it overrides the default.
+When FILENAME is \"-\", it renders the output to stdout. 
+")
+  (ros:quit 1))
+
+(defvar *filename*)
+(defun main (main cmd &optional filename (template (when filename (find-template-or-lose filename))) &rest argv)
+  (assert (equal main "main"))
+  (assert (equal cmd "init"))
+  (match filename
+    (nil
+     (usage))
+    ("-"
+     (let ((*filename* "STDOUT"))
+       (render *standard-output* template
+               (mapcar #'read-and-reprint-string argv))))
+    (_
+     (let* ((filename (pathname filename))
+            (*filename* (if (not (pathname-type filename))
+                            (make-pathname :type "ros" :defaults filename)
+                            filename)))
+       (with-open-file (s *filename* :direction :output :if-exists :supersede :if-does-not-exist :create)
+         (render s template
+                 (mapcar #'read-and-reprint-string argv)))
+       (format t "Instantiated a template ~a into ~a~%" template *filename*)))))
+
+(defun read-and-reprint-string (string)
+  (princ-to-string (read-from-string string)))
+
+(defvar *template-dir* (merge-pathnames "templates/" (homedir)))
+(ensure-directories-exist *template-dir*)
+
+(defun find-template-or-lose (filename)
+  "try to find a tempalte with a given filename, return \"default\" when failed"
+  (let ((path (merge-pathnames filename *template-dir*)))
+    (if (probe-file path)
+        filename
+        "default")))
+
+(defun slurp (stream)
+  "http://www.ymeme.com/slurping-a-file-common-lisp-83.html"
+  (let ((seq (make-array (file-length stream)
+                         :element-type 'character
+                         :fill-pointer t)))
+    (setf (fill-pointer seq) (read-sequence seq stream))
+    seq))
+
+(defun read-file (path)
+  (with-open-file (s path :if-does-not-exist :error)
+    (loop for o = (read s nil '+eof+)
+          until (eq o '+eof+)
+          collect o)))
+
+(defun render (s template argv)
+  (handler-case
+      (let ((abs (merge-pathnames template *template-dir*)))
+        (bind-arguments s (first (read-file abs)) argv))
+    (file-error ()
+      (format t "Template file ~a does not exist" template))))
+
+(defun bind-arguments (s metadata argv0)
+  (let ((argv (copy-list argv0)))
+    (ematch metadata
+      ((list :arguments (list required optional keywords rest) :source src)
+       (let (binding)
+         (dolist (var required)
+           (push (cons var
+                       (or (pop argv)
+                           (progn
+                             (format *error-output*
+                                     "Insufficient number of arguments in ~a for ~a: ~
+                                      ~a needed, ~a present~%"
+                                     argv0 required (length required) (length argv0))
+                             (ros:quit 1))))
+                 binding))
+         (dolist (opt optional)
+           (ematch opt
+             ((list* var default _)
+              (push (cons var (or (pop argv) (read-and-reprint-string default)))
+                    binding))))
+         (dolist (key keywords)
+           (ematch key
+             ((list* var default _)
+              (push (cons var (string-getf argv (shell-keyword var)
+                                            (read-and-reprint-string default)))
+                    binding)
+              (string-remf argv (shell-keyword var)))))
+         (when rest
+           (push (cons rest argv) binding))
+         (princ (render-variables (reverse binding) src) s))))))
+
+(defun shell-keyword (var)
+  (format nil "--~(~a~)" var))
+
+(defun string-getf (place indicator &optional default)
+  (match place
+    ((list* key value rest)
+     (if (string-equal key indicator)
+         value
+         (string-getf rest indicator default)))
+    (nil
+     default)))
+
+(defun string-remf (place indicator)
+  (match place
+    ((list* key value rest)
+     (if (string-equal key indicator)
+         (string-remf rest indicator)
+         (list* key value
+                (string-remf rest indicator))))
+    (nil nil)))
+
+(defun render-variables (bindings src)
+  ;; FIXME: list-based implementation, does not scale to larger files
+  (let ((src (coerce src 'list)))
+    (dolist (binding bindings (coerce src 'string))
+      (ematch binding
+        ((cons var val)
+         ;; FIXME: irregular behavior might occur when one variable name is
+         ;; included as a part of the other variable, e.g. var1=FOO and
+         ;; var2=FOOBAR.
+         ;; 
+         ;; Similarly, further undefined behavior might exists when the
+         ;; result of replacement contains other variables, e.g., var1=FOO is
+         ;; replaced with a string BAR, and var2=BAR.
+         (setf src (render-variable var val src)))))))
+
+(defun render-variable (var val src)
+  "search for a matching substring from the beginning, and replacing the elements, backtracking as needed."
+  (loop for sub on src
+        while (nthcdr (length var) sub)
+        for pos = (search var sub :end2 (length var))
+        do
+     (when pos
+       (assert (= pos 0))
+       (cond
+         ((< (length var) (length val))
+          (dotimes (i (- (length val) (length var)))
+            ;; (a b c d) -> (a a b c d)
+            (push (car sub) (cdr sub))))
+         ((> (length var) (length val))
+          (dotimes (i (- (length var) (length val)))
+            ;; (a b c d) -> (b b c d)
+            (setf (car sub) (cadr sub))
+            ;; (b [b] c d) -> (b c d)
+            ;; [b] is removed, so the first cons cell does not change
+            (pop (cdr sub)))))
+       (replace sub val)))
+  src)
+
+
+
+
+
+#+nil
 (defun main (subcmd cmd &optional name &rest r)
  (declare (ignore cmd))
  (if (and (equal subcmd "main") name)
--- a/lisp/match.lisp
+++ b/lisp/match.lisp
@ -0,0 +1,119 @@
+
+(ql:quickload :alexandria :silent t)
+
+(defpackage :ros.match
+  (:use :cl :alexandria)
+  (:shadow :once-only)
+  (:export #:match
+           #:ematch
+           #:lambda-match
+           #:lambda-ematch))
+
+(in-package :ros.match)
+
+;; from alexandria, but adds `ignorable'
+(defmacro once-only (specs &body forms)
+  (let ((gensyms (make-gensym-list (length specs) "ONCE-ONLY"))
+        (names-and-forms (mapcar (lambda (spec)
+                                   (etypecase spec
+                                     (list
+                                      (destructuring-bind (name form) spec
+                                        (cons name form)))
+                                     (symbol
+                                      (cons spec spec))))
+                                 specs)))
+    ;; bind in user-macro
+    `(let ,(mapcar (lambda (g n) (list g `(gensym ,(string (car n)))))
+                   gensyms names-and-forms)
+       ;; bind in final expansion
+       `(let (,,@(mapcar (lambda (g n)
+                           ``(,,g ,,(cdr n)))
+                   gensyms names-and-forms))
+          (declare (ignorable ,,@gensyms))
+          ;; bind in user-macro
+          ,(let ,(mapcar (lambda (n g) (list (car n) g))
+                         names-and-forms gensyms)
+             ,@forms)))))
+
+(defvar *what*)
+(defvar *bindings*)
+(defvar *env*)
+(defmacro match (*what* &body clauses &environment *env*)
+  (once-only (*what*)
+    (parse-patterns clauses)))
+
+(defmacro ematch (what &body clauses)
+  (once-only (what)
+    `(match ,what
+       ,@clauses
+       (_ (error "level0 match error! ~S does not match ~S" ,what ',clauses)))))
+
+(defmacro lambda-match (&body clauses)
+  (with-gensyms (arg)
+    `(lambda (,arg)
+       (match ,arg
+         ,@clauses))))
+
+(defmacro lambda-ematch (&body clauses)
+  (with-gensyms (arg)
+    `(lambda (,arg)
+       (ematch ,arg
+         ,@clauses))))
+
+(defun parse-patterns (clauses)
+  (if (null clauses)
+      nil
+      (destructuring-bind ((pattern &rest body) . rest) clauses
+        (multiple-value-bind (condition bindings)
+            (let ((*bindings* nil))
+              (values (make-pattern-predicate pattern)
+                      *bindings*))
+          `(if ,condition
+               (let* ,(reverse bindings)
+                 (declare (ignorable ,@(mapcar #'first bindings)))
+                 ,@body)
+               ,(parse-patterns rest))))))
+
+
+
+(defun make-pattern-predicate (pattern)
+  (if (atom pattern)
+      (cond
+        ((constantp pattern *env*) `(equal ,*what* ,pattern))
+        ((symbolp pattern)
+         (unless (string= "_" (symbol-name pattern))
+           (push `(,pattern ,*what*) *bindings*))
+         t)
+        (t (error "what is this? ~a" pattern)))
+      (destructuring-bind (name . args) pattern
+        (ecase name
+          (quote `(equal ,*what* ',@args))
+          (cons
+           (destructuring-bind (car cdr) args
+             `(and (consp ,*what*)
+                   ,(let* ((what `(car ,*what*))
+                           (*what* what))
+                      (once-only (*what*)
+                        (push `(,*what* ,what) *bindings*)
+                        (make-pattern-predicate car)))
+                   ,(let* ((what `(cdr ,*what*))
+                           (*what* what))
+                      (once-only (*what*)
+                        (push `(,*what* ,what) *bindings*)
+                        (make-pattern-predicate cdr))))))
+          (list
+           (if args
+               (destructuring-bind (car . cdr) args
+                 (make-pattern-predicate
+                  (if cdr
+                      `(cons ,car (list ,@cdr))
+                      `(cons ,car nil))))
+               `(null ,*what*)))
+          (list*
+           (destructuring-bind (car . cdr) args
+             (make-pattern-predicate
+              (if cdr
+                  `(cons ,car (list* ,@cdr))
+                  car))))))))
+
+(push :ros.match *features*)
--- a/lisp/setup.ros
+++ b/lisp/setup.ros
@ -39,6 +39,13 @@ exec ros -Q -L sbcl-bin -- $0 "$@"
                                   :collect "--load"
                                   :collect (format nil "~A" i))
 			   " dump output -f roswell")
+                   t nil)
+      (ros:roswell `("template" "add" "-f"
+                                ,(namestring (make-pathname :name "default"
+                                                            :type nil
+                                                            :defaults *load-pathname*))
+                                "--optional" "NAME" "'#.(pathname-name (merge-pathnames ros.sub.init:*filename*))'"
+                                "--" "DATETIME" "'#.(get-universal-time)'")
                   t nil))))

 (push :ros.sub.setup *features*)
--- a/lisp/template.ros
+++ b/lisp/template.ros
@ -0,0 +1,209 @@
+#!/bin/sh
+#|-*- mode:lisp -*-|#
+#| Register a file as a template.
+exec ros -Q -m roswell -L sbcl-bin -- $0 "$@"
+|#
+
+#|
+
+ros [options] template add [OPTIONS] TEMPLATE ARGS...
+
+* each argument is separated by --, instead of being surrounded by parentheses.
+* &key, &optional, &rest corresponds to --key, --optional, --rest, respectively.
+* Abbreviation as -k, -o, -r are available.
+
+|#
+
+#-ros.match
+(ros:include "match")
+#-ros.util
+(ros:include "util")
+
+(defpackage :ros.script.template
+  (:use :cl :ros.util :ros.match :alexandria))
+
+(in-package :ros.script.template)
+
+(defun usage ()
+  (format *error-output* "Usage: ros [options] template [SUBCOMMAND] [[OPTIONS] TEMPLATE ARGS...]~%")
+  (format *error-output* "subcommands:~%")
+  (finish-output *error-output*) (finish-output)
+  (format t "~&~{~(~a~)~%~}" '(add rm show list)) ;; this also serves as the bash completion candidates
+  (ros:quit 1))
+
+(defun main (&rest argv)
+  (match argv
+    ((list* _ _ "list" _)
+     (list-templates))
+    ((list _ _ "add")
+     (list-templates :files))
+    ((list _ _ "show")
+     (list-templates :templates))
+    ((list _ _ "rm")
+     (list-templates :templates))
+    ((list* _ _ "add" argv)
+     (add-template argv))
+    ((list* _ _ "rm" argv)
+     (rm-template argv))
+    ((list* _ _ "show" argv)
+     (show-template argv))
+    (_
+     (usage))))
+
+(defvar *template-dir* (merge-pathnames "templates/" (homedir)))
+(ensure-directories-exist *template-dir*)
+;;; ros template add
+
+(defun slurp (stream)
+  "http://www.ymeme.com/slurping-a-file-common-lisp-83.html"
+  (let ((seq (make-array (file-length stream)
+                         :element-type 'character
+                         :fill-pointer t)))
+    (setf (fill-pointer seq) (read-sequence seq stream))
+    seq))
+
+(defun read-file-to-string (path)
+  (with-input-from-file (s path)
+    (slurp s)))
+
+(defun read-file (path)
+  (with-input-from-file (s path)
+    (loop for o = (read s nil '+eof+)
+          until (eq o '+eof+)
+          collect o)))
+
+(defvar *if-exists* :error)
+(defvar *name* nil)
+(defun add-template (args)
+  (match args
+    ((list* "-f" rest)           (let ((*if-exists* :overwrite)) (add-template rest)))
+    ((list* "--force" rest)      (let ((*if-exists* :overwrite)) (add-template rest)))
+    ((list* "--r" rest)          (error "not implemented yet") #+nil (add-template-recursive rest))
+    ((list* "--recursive" rest)  (error "not implemented yet") #+nil (add-template-recursive rest))
+    ((list* "--name" *name* rest) (add-template rest))
+    ((list* template args)
+     (assert (probe-file template))
+     (with-open-file (s (make-pathname :directory (pathname-directory *template-dir*)
+                                       :defaults (or *name* template))
+                        :direction :output
+                        :if-does-not-exist :create
+                        :if-exists *if-exists*)
+       (write (list :arguments (parse-args args)
+                    :source (read-file-to-string template))
+              :stream s)))))
+
+(defvar *required*)
+(defvar *optional*)
+(defvar *rest*)
+(defvar *keywords*)
+
+(defun parse-args (args)
+  (let (*required* *optional* *rest* *keywords*)
+    (parse-required args)
+    (list *required* *optional* *rest* *keywords*)))
+
+(defun parse-required (args)
+  (ematch args
+    ((list* "--" _)            (error "unexpected use of --"))
+    ((list* "--key" rest)      (parse-keywords rest))
+    ((list* "-k" rest)         (parse-keywords rest))
+    ((list* "--optional" rest) (parse-optional rest))
+    ((list* "-o" rest)         (parse-optional rest))
+    ((list* "--rest" rest)     (parse-rest rest))
+    ((list* "-r" rest)         (parse-rest rest))
+    ((list* name rest)         (push name *required*) (parse-required rest))
+    (nil                       )))
+
+(defun parse-optional (args)
+  (symbol-macrolet ((p1 (push (list name "") *optional*))
+                    (p2 (push (list name default) *optional*)))
+    (ematch args
+      ((list* "--" _) (error "unexpected use of --"))
+      ((list* name "--key" rest)  p1 (parse-keywords rest))
+      ((list* name "-k" rest)     p1 (parse-keywords rest))
+      ((list* name "--rest" rest) p1 (parse-rest rest))
+      ((list* name "-r" rest)     p1 (parse-rest rest))
+      ((list* name "--" rest)     p1 (parse-optional rest))
+      ((list  name)               p1)
+      ((list* name default "--key" rest)  p2 (parse-keywords rest))
+      ((list* name default "-k" rest)     p2 (parse-keywords rest))
+      ((list* name default "--rest" rest) p2 (parse-rest rest))
+      ((list* name default "-r" rest)     p2 (parse-rest rest))
+      ((list* name default "--" rest)     p2 (parse-optional rest))
+      ((list  name default)     p2))))
+
+(defun parse-keywords (args)
+  (symbol-macrolet ((p1 (push (list name "") *keywords*))
+                    (p2 (push (list name default) *keywords*)))
+    (ematch args
+      ((list* "--" _) (error "unexpected use of --"))
+      ((list* name "--rest" rest) p1 (parse-rest rest))
+      ((list* name "-r" rest)     p1 (parse-rest rest))
+      ((list* name "--" rest)     p1 (parse-keywords rest))
+      ((list  name)               p1)
+      ((list* name default "--rest" rest) p2 (parse-rest rest))
+      ((list* name default "-r" rest)     p2 (parse-rest rest))
+      ((list* name default "--" rest)     p2 (parse-keywords rest))
+      ((list  name default)     p2))))
+
+(defun parse-rest (args)
+  (ematch args
+    ((list* "--" _) (error "unexpected use of --"))
+    ((list* _ rest) (error ">2 arguments after rest arguments"))
+    ((list  name) (setf name *rest*))))
+
+;;; ros template rm
+
+(defun rm-template (argv)
+  (let ((argv (mapcar #'pathname argv)))
+    (assert (every (lambda (path) (null (pathname-directory path))) argv)
+            nil "do not specify a template file in a subdirectory of a directory template")
+    (dolist (path argv)
+      (let ((path (merge-pathnames path *template-dir*)))
+        (when (probe-file path)
+          (format t "; deleting a template ~a~%" path)
+          (delete-file path))))))
+
+(defun show-template (argv)
+  (dolist (path (mapcar #'pathname argv))
+    (handler-case
+        (let ((abs (merge-pathnames path *template-dir*)))
+          (ematch (first (read-file abs))
+           ((list :arguments (list required optional keywords rest) :source src)
+            (format t "~&; Template -- ~a ~{~a ~}~
+                           ~@[&optional ~{~a ~}~] ~
+                           ~@[&key ~{~a ~}~] ~
+                           ~@[&rest ~{~a ~}~]~%"
+                    path required optional keywords rest)
+            (format t "~&; Absolute path -- ~a~%" abs)
+            (format t   "; Template Body~%")
+            (format t "; ====== starts from this line =====~%~a~%"  src)
+            (format t "; ======       ends here       =====~%"))))
+      (file-error ()
+        (format t "Template file ~a does not exist" path)))))
+
+(defun list-templates (&optional completion-style)
+  (flet ((output () 
+           (format t "~{~a~%~}"
+                   (sort (remove "default"
+                                 (mapcar #'enough-namestring
+                                         (directory (make-pathname :name :wild :type :wild)))
+                                 :test #'string=)
+                         #'string<))))
+    (match completion-style
+      (nil
+       ;; normal output as a "ros template list" subcommand
+       (let ((*default-pathname-defaults*  *template-dir*))
+         (output)))
+      (:files
+       ;; list files as the candidates
+       (format *error-output* "error: Missing arguments. Candidates:~%")
+       (finish-output *error-output*)
+       (output))
+      (:templates
+       (format *error-output* "error: Missing arguments. Candidates:~%")
+       (finish-output *error-output*)
+       (let ((*default-pathname-defaults*  *template-dir*))
+         (output))))))
+
+;;; vim: set ft=lisp lisp:
--- a/scripts/completion-bash/ros
+++ b/scripts/completion-bash/ros
@ -42,7 +42,7 @@ _ros()
                --print --write --final --rc --no-rc --quicklisp --no-quicklisp --verbose
                --quiet --test"
    opts_short="-w -m -L -l -S -p -sp -e -q -r -E -i -ip -iw -F -R +R -Q +Q -v"
-    subcommands="install config setup version help run wait use list init emacs dump delete build"
+    subcommands="install config setup version help run wait use list init emacs dump delete build template"
    subcommands_caserule=$(echo $subcommands | sed 's/ /|/g')

    for ((i=1; i < COMP_CWORD; i++)); do
@ -79,7 +79,7 @@ _ros()
                    # complete filenames
                    COMPREPLY=( $(compgen -f -G '*.ros' -- ${cur} ))
                    ;;
-                config|dump|install|delete|list|installed|versions|use)
+                config|dump|install|delete|list|installed|versions|use|template)
                    if [ -z $cur ]
                    then
                        COMPREPLY=( $(compgen -W "$($COMP_LINE 2> /dev/null)" -- ${cur}) )
--- a/t/ros.lisp
+++ b/t/ros.lisp
@ -6,17 +6,26 @@
  (:shadowing-import-from :ros :run))
 (in-package :roswell-test)

-(ql:quickload :uiop)
+(ql:quickload :uiop :silent t)

 (defun ! (r &optional expected)
  (if expected
-      (is (string-trim #.(format nil " ~%")
-                       (uiop:run-program r :output :string))
+      (is (print (string-trim #(#\Space #\Tab #\Newline #\Return #\linefeed)
+                              (with-output-to-string (s)
+                                (uiop:run-program r
+                                                  :output (make-broadcast-stream s *standard-output*)
+                                                  :error-output *error-output*))))
          expected r)
      (ok (ignore-errors
-            (or (uiop:run-program r) t))
+            (or (uiop:run-program r :error-output *error-output*
+                                  :output *standard-output*)
+                t))
          r)))

+(defun !e (r)
+  (is-error (uiop:run-program r :output *standard-output* :error-output *error-output*)
+            'error (format nil "~a expected to fail" r)))
+
 (defun !-tree (tree)
  (labels ((rec (current stack)
             (mapcar (lambda (child)
@ -26,8 +35,12 @@
                     (cdr current))))
    (rec tree nil)))

+(defun ensure-delete-file (file)
+  (when (probe-file file) (delete-file file)))
+
 (plan nil)

+
 (ok (getenv "USER") "(getenv \"USER\")")
 (ok (not (getenv "NON_EXITS_ENV")) "(getenv \"NON_EXITS_ENV\") return nil if key not exist")
 #-(or allegro abcl);;pass when sbcl ccl clisp
@ -90,11 +103,34 @@
   "asdf"
   "fmt"
   ;;"build"
-   ("init" "" "testinit" "testinit2.ros")))
-
+   ("init" "testinit" "testinit2.ros")))
 (ok (probe-file "testinit.ros"))
-(when (probe-file "testinit.ros") (delete-file "testinit.ros"))
+(ensure-delete-file "testinit.ros")
 (ok (probe-file "testinit2.ros"))
-(when (probe-file "testinit2.ros") (delete-file "testinit2.ros"))
+(ensure-delete-file "testinit2.ros")
+
+(!e "ros init")
+
+(ok (probe-file "t/test-template"))
+(! "ros template rm test-template")
+(! "ros template list" "")
+
+(! "ros template add t/test-template AUTHOR")
+(!e "ros template add t/test-template AUTHOR") ;; overwrite error
+(! "ros template add -f t/test-template AUTHOR") ;; force overwrite
+(! "ros template list"
+   "test-template")
+(! "ros template show test-template")
+(! "ros init - test-template BOB" "my name is BOB")
+(! "ros template rm test-template")
+(! "ros template list" "")
+
+(! "ros template add t/test-template --optional AUTHOR '\"Alice\"'")
+(! "ros template list" "test-template")
+(! "ros template show test-template")
+(! "ros init - test-template BOB" "my name is BOB")
+(! "ros init - test-template" "my name is Alice")
+(! "ros template rm test-template")
+(! "ros template list" "")

 (ros:quit (if (finalize) 0 1))
--- a/t/test-template
+++ b/t/test-template
@ -0,0 +1,3 @@
+
+
+my name is AUTHOR