]> gitweb.factorcode.org Git - factor.git/commitdiff
Add scaffolding words for tags, summary and authors and hook these up to FUEL. Modifi...
authorErik Charlebois <erikcharlebois@gmail.com>
Sun, 21 Feb 2010 11:34:08 +0000 (03:34 -0800)
committerErik Charlebois <erikcharlebois@gmail.com>
Sun, 21 Feb 2010 11:34:08 +0000 (03:34 -0800)
basis/tools/scaffold/scaffold-docs.factor
basis/tools/scaffold/scaffold.factor
basis/vocabs/files/files-docs.factor
basis/vocabs/files/files.factor
extra/fuel/fuel.factor
misc/fuel/fuel-scaffold.el

index f4200f8cb2e93fb3d4929c4bb573138a90010943..4476f5ec9fbefc90ad2636a257f102a5042e0f40 100644 (file)
@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax kernel strings words vocabs ;
+USING: help.markup help.syntax kernel strings words vocabs sequences ;
 IN: tools.scaffold
 
 HELP: developer-name
@@ -23,6 +23,30 @@ HELP: scaffold-undocumented
 
 { scaffold-help scaffold-undocumented } related-words
 
+HELP: scaffold-authors
+{ $values
+    { "vocab" "a vocabulary specifier" }
+}
+{ $description "Creates an authors.txt file using the value in " { $link developer-name } ". This word only works if no authors.txt file yet exists." } ;
+
+HELP: scaffold-summary
+{ $values
+    { "vocab" "a vocabulary specifier" } { "summary" string }
+}
+{ $description "Creates a summary.txt file with the given summary. This word only works if no summary.txt file yet exists." } ;
+
+HELP: scaffold-tags
+{ $values
+    { "vocab" "a vocabulary specifier" } { "tags" string }
+}
+{ $description "Creates a tags.txt file with the given tags. This word only works if no tags.txt file yet exists." } ;
+
+HELP: scaffold-tests
+{ $values
+    { "vocab" "a vocabulary specifier" }
+}
+{ $description "Takes an existing vocabulary and creates an empty tests file help for each word. This word only works if no tests file yet exists." } ;
+
 HELP: scaffold-vocab
 { $values
      { "vocab-root" "a vocabulary root string" } { "string" string } }
index 936d388b0126095ecfc58e72ec32cdfd4b997648..151d98a1346be75683da6ea19e3890293687ceb3 100644 (file)
@@ -63,6 +63,9 @@ M: bad-developer-name summary
 : vocab-root/vocab/suffix>path ( vocab-root vocab suffix -- path )
     [ vocab-root/vocab>path dup file-name append-path ] dip append ;
 
+: vocab/file>path ( vocab file -- path )
+    [ vocab>path ] dip append-path ;
+
 : vocab/suffix>path ( vocab suffix -- path )
     [ vocab>path dup file-name append-path ] dip append ;
 
@@ -104,16 +107,17 @@ M: bad-developer-name summary
         2drop
     ] if ;
 
-: scaffold-authors ( vocab-root vocab -- )
-    developer-name get [
-        "authors.txt" vocab-root/vocab/file>path scaffolding? [
-            developer-name get swap utf8 set-file-contents
+: scaffold-metadata ( vocab file contents -- )
+    [ ensure-vocab-exists ] 2dip
+    [
+        [ vocab/file>path ] dip swap scaffolding? [
+            utf8 set-file-contents
         ] [
-            drop
+            2drop
         ] if
     ] [
         2drop
-    ] if ;
+    ] if* ;
 
 : lookup-type ( string -- object/string ? )
     "new" ?head drop [ { [ CHAR: ' = ] [ digit? ] } 1|| ] trim-tail
@@ -258,12 +262,21 @@ PRIVATE>
 : scaffold-undocumented ( string -- )
     [ interesting-words. ] [ link-vocab ] bi ;
 
+: scaffold-authors ( vocab -- )
+    "authors.txt" developer-name get scaffold-metadata ;
+
+: scaffold-tags ( vocab tags -- )
+    [ "tags.txt" ] dip scaffold-metadata ;
+
+: scaffold-summary ( vocab summary -- )
+    [ "summary.txt" ] dip scaffold-metadata ;
+
 : scaffold-vocab ( vocab-root string -- )
     {
         [ scaffold-directory ]
         [ scaffold-main ]
-        [ scaffold-authors ]
         [ nip require ]
+        [ nip scaffold-authors ]
     } 2cleave ;
 
 : scaffold-core ( string -- ) "resource:core" swap scaffold-vocab ;
index e2c6a5f3733df762297da6f8b4395557560592cc..61a2e6870790ee64b8166d4794e2a1d0421daa7d 100644 (file)
@@ -1,6 +1,14 @@
 USING: help.markup help.syntax strings ;
 IN: vocabs.files
 
+HELP: vocab-tests-file
+{ $values { "vocab" "a vocabulary specifier" } { "path" "pathname string to test file" } }
+{ $description "Outputs a pathname where the unit test file is located." } ;
+
+HELP: vocab-tests-dir
+{ $values { "vocab" "a vocabulary specifier" } { "paths" "a sequence of pathname strings" } }
+{ $description "Outputs a sequence of pathnames for the tests in the test directory." } ;
+
 HELP: vocab-files
 { $values { "vocab" "a vocabulary specifier" } { "seq" "a sequence of pathname strings" } }
 { $description "Outputs a sequence of files comprising this vocabulary, or " { $link f } " if the vocabulary does not have a directory on disk." } ;
index c1d7dcfd59af54fe84c900e29d7be6e10e2f8d98..1c3e3731bda0d1e6bf5c1f8158af90f6ff520097 100644 (file)
@@ -4,8 +4,6 @@ USING: io.directories io.files io.pathnames kernel make
 sequences vocabs.loader ;
 IN: vocabs.files
 
-<PRIVATE
-
 : vocab-tests-file ( vocab -- path )
     dup "-tests.factor" vocab-dir+ vocab-append-path dup
     [ dup exists? [ drop f ] unless ] [ drop f ] if ;
@@ -18,8 +16,6 @@ IN: vocabs.files
         ] [ drop f ] if
     ] [ drop f ] if ;
 
-PRIVATE>
-
 : vocab-tests ( vocab -- tests )
     [
         [ vocab-tests-file [ , ] when* ]
@@ -31,4 +27,4 @@ PRIVATE>
         [ vocab-source-path [ , ] when* ]
         [ vocab-docs-path [ , ] when* ]
         [ vocab-tests % ] tri
-    ] { } make ;
\ No newline at end of file
+    ] { } make ;
index d64ef41f8c590003eab71e68bcfc273242463f5e..2934d5d43c7de3c3c578a866a604be65f572c764 100644 (file)
@@ -3,7 +3,8 @@
 
 USING: accessors assocs compiler.units continuations fuel.eval fuel.help
 fuel.remote fuel.xref help.topics io.pathnames kernel namespaces parser
-sequences tools.scaffold vocabs.loader vocabs.parser words ;
+sequences tools.scaffold vocabs.loader vocabs.parser words vocabs.files
+vocabs.metadata ;
 
 IN: fuel
 
@@ -145,6 +146,22 @@ PRIVATE>
     [ fuel-scaffold-name dup require dup scaffold-help ] with-scope
     vocab-docs-path absolute-path fuel-eval-set-result ;
 
+: fuel-scaffold-tests ( name devname -- )
+    [ fuel-scaffold-name dup require dup scaffold-tests ] with-scope
+    vocab-tests-file absolute-path fuel-eval-set-result ;
+
+: fuel-scaffold-authors ( name devname -- )
+    [ fuel-scaffold-name dup require dup scaffold-authors ] with-scope
+    [ vocab-authors-path ] keep swap vocab-append-path absolute-path fuel-eval-set-result ;
+
+: fuel-scaffold-tags ( name tags -- )
+    [ scaffold-tags ]
+    [ drop [ vocab-tags-path ] keep swap vocab-append-path absolute-path fuel-eval-set-result ] 2bi ;
+
+: fuel-scaffold-summary ( name summary -- )
+    [ scaffold-summary ]
+    [ drop [ vocab-summary-path ] keep swap vocab-append-path absolute-path fuel-eval-set-result ] 2bi ;
+
 : fuel-scaffold-get-root ( name -- ) find-vocab-root fuel-eval-set-result ;
 
 ! Remote connection
index 9b7d9861c715b4c2c33c418d752db4e726cac7d4..9e8e56475d39fbe7d814cc048cc0cd2f349111ea 100644 (file)
@@ -79,6 +79,25 @@ IN: %s
                       "fuel")))
     (fuel-eval--send/wait cmd)))
 
+(defsubst fuel-scaffold--create-tests (vocab)
+  (let ((cmd `(:fuel* (,vocab ,fuel-scaffold-developer-name fuel-scaffold-tests)
+                      "fuel")))
+    (fuel-eval--send/wait cmd)))
+
+(defsubst fuel-scaffold--create-authors (vocab)
+  (let ((cmd `(:fuel* (,vocab ,fuel-scaffold-developer-name fuel-scaffold-authors) "fuel")))
+    (fuel-eval--send/wait cmd)))
+
+(defsubst fuel-scaffold--create-tags (vocab tags)
+  (let ((cmd `(:fuel* (,vocab ,tags fuel-scaffold-tags) "fuel")))
+    (fuel-eval--send/wait cmd)))
+
+(defsubst fuel-scaffold--create-summary (vocab summary)
+  (let ((cmd `(:fuel* (,vocab ,summary fuel-scaffold-summary) "fuel")))
+    (fuel-eval--send/wait cmd)))
+
+(defsubst fuel-scaffold--creaet-
+
 (defun fuel-scaffold--help (parent)
   (when (and parent (fuel-scaffold--check-auto fuel-scaffold-help-autoinsert-p))
     (let* ((ret (fuel-scaffold--create-docs (fuel-scaffold--vocab parent)))
@@ -102,7 +121,8 @@ IN: %s
 
 (defun fuel-scaffold-vocab (&optional other-window name-hint root-hint)
   "Creates a directory in the given root for a new vocabulary and
-adds source, tests and authors.txt files.
+adds source and authors.txt files. Prompts the user for optional summary,
+tags, help, and test file creation.
 
 You can configure `fuel-scaffold-developer-name' (set by default to
 `user-full-name') for the name to be inserted in the generated files."
@@ -111,12 +131,24 @@ You can configure `fuel-scaffold-developer-name' (set by default to
          (root (completing-read "Vocab root: "
                                 (fuel-scaffold--vocab-roots)
                                 nil t (or root-hint "resource:")))
+         (summary (read-string "Vocab summary (empty for none): "))
+         (tags (read-string "Vocab tags (empty for none): "))
+         (help (y-or-n-p "Scaffold help? "))
+         (tests (y-or-n-p "Scaffold tests? "))
          (cmd `(:fuel* ((,root ,name ,fuel-scaffold-developer-name)
                         (fuel-scaffold-vocab)) "fuel"))
          (ret (fuel-eval--send/wait cmd))
          (file (fuel-eval--retort-result ret)))
     (unless file
       (error "Error creating vocab (%s)" (car (fuel-eval--retort-error ret))))
+    (when (not (equal "" summary))
+      (fuel-scaffold--create-summary name summary))
+    (when (not (equal "" tags))
+      (fuel-scaffold--create-tags name tags))
+    (when help
+         (fuel-scaffold--create-docs name))
+    (when tests
+         (fuel-scaffold--create-tests name))
     (if other-window (find-file-other-window file) (find-file file))
     (goto-char (point-max))
     name))
@@ -137,6 +169,60 @@ You can configure `fuel-scaffold-developer-name' (set by default to
           (error "Error creating help file" (car (fuel-eval--retort-error ret))))
         (find-file file)))
 
+(defun fuel-scaffold-tests (&optional arg)
+  "Creates, if it does not already exist, a tests file for the current vocabulary.
+
+With prefix argument, ask for the vocabulary name.
+You can configure `fuel-scaffold-developer-name' (set by default to
+`user-full-name') for the name to be inserted in the generated file."
+  (interactive "P")
+  (let* ((vocab (or (and (not arg) (fuel-syntax--current-vocab))
+                    (fuel-completion--read-vocab nil)))
+         (ret (fuel-scaffold--create-tests vocab))
+         (file (fuel-eval--retort-result ret)))
+        (unless file
+          (error "Error creating tests file" (car (fuel-eval--retort-error ret))))
+        (find-file file)))
+
+(defun fuel-scaffold-authors (&optional arg)
+  "Creates, if it does not already exist, an authors file for the current vocabulary.
+
+With prefix argument, ask for the vocabulary name.
+You can configure `fuel-scaffold-developer-name' (set by default to
+`user-full-name') for the name to be inserted in the generated file."
+  (interactive "P")
+  (let* ((vocab (or (and (not arg) (fuel-syntax--current-vocab))
+                    (fuel-completion--read-vocab nil)))
+         (ret (fuel-scaffold--create-authors vocab))
+         (file (fuel-eval--retort-result ret)))
+        (unless file
+          (error "Error creating authors file" (car (fuel-eval--retort-error ret))))
+        (find-file file)))
+
+(defun fuel-scaffold-tags (&optional arg)
+  "Creates, if it does not already exist, a tags file for the current vocabulary."
+  (interactive "P")
+  (let* ((vocab (or (and (not arg) (fuel-syntax--current-vocab))
+                    (fuel-completion--read-vocab nil)))
+         (tags (read-string "Tags: "))
+         (ret (fuel-scaffold--create-tags vocab tags))
+         (file (fuel-eval--retort-result ret)))
+        (unless file
+          (error "Error creating tags file" (car (fuel-eval--retort-error ret))))
+        (find-file file)))
+
+(defun fuel-scaffold-summary (&optional arg)
+  "Creates, if it does not already exist, a summary file for the current vocabulary."
+  (interactive "P")
+  (let* ((vocab (or (and (not arg ) (fuel-syntax--current-vocab))
+                    (fuel-completion--read-vocab nil)))
+         (summary (read-string "Summary: "))
+         (ret (fuel-scaffold--create-summary vocab summary))
+         (file (fuel-eval--retort-result ret)))
+        (unless file
+          (error "Error creating summary file" (car (fuel-eval--retort-error ret))))
+        (find-file file)))
+
 \f
 (provide 'fuel-scaffold)
 ;;; fuel-scaffold.el ends here