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.
parent
bb3665f37e
commit
ffddca36b7
|
@ -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 } }
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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." } ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue