diff --git a/.travis.yml b/.travis.yml index d0825f8..5ab703e 100644 --- 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 diff --git a/circle.yml b/circle.yml index 768fe52..7b71ce8 100644 --- 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 diff --git a/documents/Makefile.am b/documents/Makefile.am index 20a2503..a6eacb8 100644 --- 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) ) diff --git a/documents/html/ros-init.html b/documents/html/ros-init.html index f6c2bda..f5f590d 100644 --- a/documents/html/ros-init.html +++ b/documents/html/ros-init.html @@ -20,16 +20,20 @@

ros-init - Create a roswell script (optionally based on a template)

Synopsis

-

ros init [template] name

- - +

ros init NAME [TEMPLATE [ARGS...]]

-
template
-
Specify the name of a template. +
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".

+ +

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:

#!/bin/sh
 #|-*- mode:lisp -*-|#
@@ -48,7 +52,7 @@ exec ros -Q -- $0 "$@"
 
 
 
SEE ALSO

-
sbcl(1) ros(1)

+
sbcl(1) ros(1) ros-template(1)

 
_

 
 
diff --git a/documents/html/ros-template.html b/documents/html/ros-template.html
new file mode 100644
index 0000000..9a509ed
--- /dev/null
+++ b/documents/html/ros-template.html
@@ -0,0 +1,73 @@
+
+
+
+  
+  
+  
+  ros-template(1)
+  
+  
+  
+
+
+

+
ros-template(1)

+
    
+
  • Roswell Project Team
    • 
+

+

+
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:

+
+
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

+
+
Misc

+
Registered templates are stored in directory $ROSWELL_HOME/templates/ .

+
SEE ALSO

+
ros(1) ros-init(1) _

+
+
diff --git a/documents/man/ros-template.1 b/documents/man/ros-template.1
new file mode 100644
index 0000000..9788534
--- /dev/null
+++ 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.
diff --git a/documents/ros-init.md b/documents/ros-init.md
index b1dcb7e..daf9032 100644
--- 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".
+
 
 
 
-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
 
 
 # SEE ALSO
-_sbcl_(1) _ros_(1)
+_sbcl_(1) _ros_(1) _ros-template_(1)
 
diff --git a/documents/ros-template.md b/documents/ros-template.md
new file mode 100644
index 0000000..45a966a
--- /dev/null
+++ 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)
diff --git a/lisp/Makefile.am b/lisp/Makefile.am
index 55afd56..3e038c0 100644
--- 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
 
diff --git a/lisp/default b/lisp/default
new file mode 100755
index 0000000..2824fc2
--- /dev/null
+++ b/lisp/default
@@ -0,0 +1,13 @@
+#!/bin/sh
+#|-*- mode:lisp -*-|#
+#| 
+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)))
+
diff --git a/lisp/init.lisp b/lisp/init.lisp
index 37d45f0..1b806d3 100644
--- 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.
 
 |#
diff --git a/lisp/init.ros b/lisp/init.ros
index 02ffdf4..62a76ad 100644
--- 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)
diff --git a/lisp/match.lisp b/lisp/match.lisp
new file mode 100644
index 0000000..af4104f
--- /dev/null
+++ 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*)
diff --git a/lisp/setup.ros b/lisp/setup.ros
index 7ba5271..284257b 100644
--- 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*)
diff --git a/lisp/template.ros b/lisp/template.ros
new file mode 100755
index 0000000..d48cfc5
--- /dev/null
+++ 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:
diff --git a/scripts/completion-bash/ros b/scripts/completion-bash/ros
index eb57d93..396b553 100644
--- 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}) )
diff --git a/t/ros.lisp b/t/ros.lisp
index 9cd50e3..1e5666a 100644
--- 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))
diff --git a/t/test-template b/t/test-template
new file mode 100644
index 0000000..a6b2334
--- /dev/null
+++ b/t/test-template
@@ -0,0 +1,3 @@
+
+
+my name is AUTHOR