diff --git a/basis/tools/scaffold/scaffold-docs.factor b/basis/tools/scaffold/scaffold-docs.factor index f4200f8cb2..4476f5ec9f 100644 --- a/basis/tools/scaffold/scaffold-docs.factor +++ b/basis/tools/scaffold/scaffold-docs.factor @@ -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 } } diff --git a/basis/tools/scaffold/scaffold.factor b/basis/tools/scaffold/scaffold.factor index 936d388b01..151d98a134 100644 --- a/basis/tools/scaffold/scaffold.factor +++ b/basis/tools/scaffold/scaffold.factor @@ -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 ; diff --git a/basis/vocabs/files/files-docs.factor b/basis/vocabs/files/files-docs.factor index e2c6a5f373..61a2e68707 100644 --- a/basis/vocabs/files/files-docs.factor +++ b/basis/vocabs/files/files-docs.factor @@ -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." } ; diff --git a/basis/vocabs/files/files.factor b/basis/vocabs/files/files.factor index c1d7dcfd59..1c3e3731bd 100644 --- a/basis/vocabs/files/files.factor +++ b/basis/vocabs/files/files.factor @@ -4,8 +4,6 @@ USING: io.directories io.files io.pathnames kernel make sequences vocabs.loader ; IN: vocabs.files - - : 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 ; diff --git a/extra/fuel/fuel.factor b/extra/fuel/fuel.factor index d64ef41f8c..2934d5d43c 100644 --- a/extra/fuel/fuel.factor +++ b/extra/fuel/fuel.factor @@ -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 diff --git a/misc/fuel/fuel-scaffold.el b/misc/fuel/fuel-scaffold.el index 9b7d9861c7..9e8e56475d 100644 --- a/misc/fuel/fuel-scaffold.el +++ b/misc/fuel/fuel-scaffold.el @@ -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