Add scaffolding words for tags, summary and authors and hook these up to FUEL. Modified fuel-scaffold-vocab to prompt the user for tags, summary and whether to create help and test files immediately.

db4
Erik Charlebois 2010-02-21 03:34:08 -08:00
parent bb3665f37e
commit ffddca36b7
6 changed files with 159 additions and 15 deletions

View 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 } }

View 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 ;

View 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." } ;

View 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 ;
] { } make ;

View 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

View 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)))
(provide 'fuel-scaffold)
;;; fuel-scaffold.el ends here