diff --git a/extra/fuel/eval/authors.txt b/extra/fuel/eval/authors.txt
new file mode 100644
index 0000000000..48f802a3cd
--- /dev/null
+++ b/extra/fuel/eval/authors.txt
@@ -0,0 +1 @@
+Jose Antonio Ortega Ruiz
\ No newline at end of file
diff --git a/extra/fuel/eval/eval-tests.factor b/extra/fuel/eval/eval-tests.factor
new file mode 100644
index 0000000000..845e912762
--- /dev/null
+++ b/extra/fuel/eval/eval-tests.factor
@@ -0,0 +1,4 @@
+! Copyright (C) 2009 Jose Antonio Ortega Ruiz.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test fuel.eval ;
+IN: fuel.eval.tests
diff --git a/extra/fuel/eval/eval.factor b/extra/fuel/eval/eval.factor
new file mode 100644
index 0000000000..c3b1a8a3f2
--- /dev/null
+++ b/extra/fuel/eval/eval.factor
@@ -0,0 +1,75 @@
+! Copyright (C) 2009 Jose Antonio Ortega Ruiz.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays compiler.units continuations debugger
+fuel.pprint io io.streams.string kernel namespaces parser sequences
+vectors vocabs.parser ;
+
+IN: fuel.eval
+
+TUPLE: fuel-status in use restarts ;
+
+SYMBOL: fuel-status-stack
+V{ } clone fuel-status-stack set-global
+
+SYMBOL: fuel-eval-result
+f fuel-eval-result set-global
+
+SYMBOL: fuel-eval-output
+f fuel-eval-result set-global
+
+SYMBOL: fuel-eval-res-flag
+t fuel-eval-res-flag set-global
+
+: fuel-eval-restartable? ( -- ? )
+ fuel-eval-res-flag get-global ; inline
+
+: fuel-push-status ( -- )
+ in get use get clone restarts get-global clone
+ fuel-status boa
+ fuel-status-stack get push ;
+
+: fuel-pop-restarts ( restarts -- )
+ fuel-eval-restartable? [ drop ] [ clone restarts set-global ] if ; inline
+
+: fuel-pop-status ( -- )
+ fuel-status-stack get empty? [
+ fuel-status-stack get pop
+ [ in>> in set ]
+ [ use>> clone use set ]
+ [ restarts>> fuel-pop-restarts ] tri
+ ] unless ;
+
+: fuel-forget-error ( -- ) f error set-global ; inline
+: fuel-forget-result ( -- ) f fuel-eval-result set-global ; inline
+: fuel-forget-output ( -- ) f fuel-eval-output set-global ; inline
+: fuel-forget-status ( -- )
+ fuel-forget-error fuel-forget-result fuel-forget-output ; inline
+
+: fuel-send-retort ( -- )
+ error get fuel-eval-result get-global fuel-eval-output get-global
+ 3array fuel-pprint flush nl "<~FUEL~>" write nl flush ;
+
+: (fuel-begin-eval) ( -- )
+ fuel-push-status fuel-forget-status ; inline
+
+: (fuel-end-eval) ( output -- )
+ fuel-eval-output set-global fuel-send-retort fuel-pop-status ; inline
+
+: (fuel-eval) ( lines -- )
+ [ [ parse-lines ] with-compilation-unit call ] curry
+ [ print-error ] recover ; inline
+
+: (fuel-eval-each) ( lines -- )
+ [ 1vector (fuel-eval) ] each ; inline
+
+: (fuel-eval-usings) ( usings -- )
+ [ "USING: " prepend " ;" append ] map
+ (fuel-eval-each) fuel-forget-error fuel-forget-output ;
+
+: (fuel-eval-in) ( in -- )
+ [ dup "IN: " prepend 1vector (fuel-eval) in set ] when* ; inline
+
+: (fuel-eval-in-context) ( lines in usings -- )
+ (fuel-begin-eval)
+ [ (fuel-eval-usings) (fuel-eval-in) (fuel-eval) ] with-string-writer
+ (fuel-end-eval) ;
diff --git a/extra/fuel/fuel.factor b/extra/fuel/fuel.factor
index 587537adcf..a399ab2776 100644
--- a/extra/fuel/fuel.factor
+++ b/extra/fuel/fuel.factor
@@ -1,34 +1,14 @@
! Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs classes.tuple combinators
-compiler.units continuations debugger definitions help help.crossref
-help.markup help.topics io io.pathnames io.streams.string kernel lexer
-make math math.order memoize namespaces parser prettyprint quotations
-sequences sets sorting source-files strings summary tools.crossref
-tools.scaffold tools.vocabs tools.vocabs.browser vectors vocabs
-vocabs.loader vocabs.parser words ;
+USING: accessors arrays assocs compiler.units definitions fuel.eval
+fuel.help help.markup help.topics io.pathnames kernel math math.order
+memoize namespaces parser sequences sets sorting tools.crossref
+tools.scaffold tools.vocabs vocabs vocabs.loader vocabs.parser words ;
IN: fuel
-! Evaluation status:
-
-TUPLE: fuel-status in use restarts ;
-
-SYMBOL: fuel-status-stack
-V{ } clone fuel-status-stack set-global
-
-SYMBOL: fuel-eval-result
-f fuel-eval-result set-global
-
-SYMBOL: fuel-eval-output
-f fuel-eval-result set-global
-
-SYMBOL: fuel-eval-res-flag
-t fuel-eval-res-flag set-global
-
-: fuel-eval-restartable? ( -- ? )
- fuel-eval-res-flag get-global ; inline
+! Evaluation
: fuel-eval-restartable ( -- )
t fuel-eval-res-flag set-global ; inline
@@ -36,156 +16,64 @@ t fuel-eval-res-flag set-global
: fuel-eval-non-restartable ( -- )
f fuel-eval-res-flag set-global ; inline
-: fuel-push-status ( -- )
- in get use get clone restarts get-global clone
- fuel-status boa
- fuel-status-stack get push ;
-
-: fuel-pop-restarts ( restarts -- )
- fuel-eval-restartable? [ drop ] [ clone restarts set-global ] if ; inline
-
-: fuel-pop-status ( -- )
- fuel-status-stack get empty? [
- fuel-status-stack get pop
- [ in>> in set ]
- [ use>> clone use set ]
- [ restarts>> fuel-pop-restarts ] tri
- ] unless ;
-
-! Lispy pretty printing
-
-GENERIC: fuel-pprint ( obj -- )
-
-M: object fuel-pprint pprint ; inline
-
-: fuel-maybe-scape ( ch -- seq )
- dup "\\\"?#()[]'`" member? [ CHAR: \ swap 2array ] [ 1array ] if ;
-
-M: word fuel-pprint
- name>> V{ } clone [ fuel-maybe-scape append ] reduce >string write ;
-
-M: f fuel-pprint drop "nil" write ; inline
-
-M: integer fuel-pprint pprint ; inline
-
-M: string fuel-pprint pprint ; inline
-
-: fuel-pprint-sequence ( seq open close -- )
- [ write ] dip swap [ " " write ] [ fuel-pprint ] interleave write ; inline
-
-M: sequence fuel-pprint "(" ")" fuel-pprint-sequence ; inline
-
-M: quotation fuel-pprint "[" "]" fuel-pprint-sequence ; inline
-
-M: tuple fuel-pprint tuple>array fuel-pprint ; inline
-
-M: continuation fuel-pprint drop ":continuation" write ; inline
-
-M: restart fuel-pprint name>> fuel-pprint ; inline
-
-SYMBOL: :restarts
-
-: fuel-restarts ( obj -- seq )
- compute-restarts :restarts prefix ; inline
-
-M: condition fuel-pprint
- [ error>> ] [ fuel-restarts ] bi 2array condition prefix fuel-pprint ;
-
-M: lexer-error fuel-pprint
- {
- [ line>> ]
- [ column>> ]
- [ line-text>> ]
- [ fuel-restarts ]
- } cleave 4array lexer-error prefix fuel-pprint ;
-
-M: source-file-error fuel-pprint
- [ file>> ] [ error>> ] bi 2array source-file-error prefix
- fuel-pprint ;
-
-M: source-file fuel-pprint path>> fuel-pprint ;
-
-! Evaluation vocabulary
+: fuel-eval-in-context ( lines in usings -- )
+ (fuel-eval-in-context) ;
: fuel-eval-set-result ( obj -- )
clone fuel-eval-result set-global ; inline
-: fuel-retort ( -- )
- error get fuel-eval-result get-global fuel-eval-output get-global
- 3array fuel-pprint flush nl "<~FUEL~>" write nl flush ;
-
-: fuel-forget-error ( -- ) f error set-global ; inline
-: fuel-forget-result ( -- ) f fuel-eval-result set-global ; inline
-: fuel-forget-output ( -- ) f fuel-eval-output set-global ; inline
-: fuel-forget-status ( -- )
- fuel-forget-error fuel-forget-result fuel-forget-output ; inline
-
-: (fuel-begin-eval) ( -- )
- fuel-push-status fuel-forget-status ; inline
-
-: (fuel-end-eval) ( output -- )
- fuel-eval-output set-global fuel-retort fuel-pop-status ; inline
-
-: (fuel-eval) ( lines -- )
- [ [ parse-lines ] with-compilation-unit call ] curry
- [ print-error ] recover ; inline
-
-: (fuel-eval-each) ( lines -- )
- [ 1vector (fuel-eval) ] each ; inline
-
-: (fuel-eval-usings) ( usings -- )
- [ "USING: " prepend " ;" append ] map
- (fuel-eval-each) fuel-forget-error fuel-forget-output ;
-
-: (fuel-eval-in) ( in -- )
- [ dup "IN: " prepend 1vector (fuel-eval) in set ] when* ; inline
-
-: fuel-eval-in-context ( lines in usings -- )
- (fuel-begin-eval)
- [ (fuel-eval-usings) (fuel-eval-in) (fuel-eval) ] with-string-writer
- (fuel-end-eval) ;
+: fuel-retort ( -- ) fuel-send-retort ; inline
! Loading files
+<PRIVATE
+
SYMBOL: :uses
: fuel-set-use-hook ( -- )
[ amended-use get clone :uses prefix fuel-eval-set-result ]
print-use-hook set ;
+: (fuel-get-uses) ( lines -- )
+ [ parse-fresh drop ] curry with-compilation-unit ; inline
+
+PRIVATE>
+
: fuel-run-file ( path -- )
[ fuel-set-use-hook run-file ] curry with-scope ; inline
: fuel-with-autouse ( ... quot: ( ... -- ... ) -- ... )
[ auto-use? on fuel-set-use-hook call ] curry with-scope ; inline
-: (fuel-get-uses) ( lines -- )
- [ parse-fresh drop ] curry with-compilation-unit ; inline
-
: fuel-get-uses ( lines -- )
[ (fuel-get-uses) ] curry fuel-with-autouse ;
! Edit locations
+<PRIVATE
+
: fuel-normalize-loc ( seq -- path line )
[ dup length 0 > [ first (normalize-path) ] [ drop f ] if ]
[ dup length 1 > [ second ] [ drop 1 ] if ] bi ;
-: fuel-get-edit-location ( word -- )
- where fuel-normalize-loc 2array fuel-eval-set-result ; inline
+: fuel-get-loc ( object -- )
+ fuel-normalize-loc 2array fuel-eval-set-result ;
+
+PRIVATE>
+
+: fuel-get-edit-location ( word -- ) where fuel-get-loc ; inline
: fuel-get-vocab-location ( vocab -- )
>vocab-link fuel-get-edit-location ; inline
-: fuel-get-doc-location ( word -- )
- props>> "help-loc" swap at
- fuel-normalize-loc 2array fuel-eval-set-result ;
+: fuel-get-doc-location ( word -- ) props>> "help-loc" swap at fuel-get-loc ;
-: fuel-get-article-location ( name -- )
- article loc>> fuel-normalize-loc 2array fuel-eval-set-result ;
+: fuel-get-article-location ( name -- ) article loc>> fuel-get-loc ;
! Cross-references
+<PRIVATE
+
: fuel-word>xref ( word -- xref )
[ name>> ] [ vocabulary>> ] [ where fuel-normalize-loc ] tri 4array ;
@@ -195,6 +83,11 @@ SYMBOL: :uses
: fuel-format-xrefs ( seq -- seq' )
[ word? ] filter [ fuel-word>xref ] map ; inline
+: (fuel-index) ( seq -- seq )
+ [ [ >link name>> ] [ article-title ] bi 2array \ $subsection prefix ] map ;
+
+PRIVATE>
+
: fuel-callers-xref ( word -- )
usage fuel-format-xrefs fuel-sort-xrefs fuel-eval-set-result ; inline
@@ -207,23 +100,19 @@ SYMBOL: :uses
: fuel-vocab-xref ( vocab -- )
words fuel-format-xrefs fuel-eval-set-result ; inline
+: fuel-index ( quot: ( -- seq ) -- )
+ call (fuel-index) fuel-eval-set-result ; inline
+
! Completion support
+<PRIVATE
+
: fuel-filter-prefix ( seq prefix -- seq )
[ drop-prefix nip length 0 = ] curry filter prune ; inline
: (fuel-get-vocabs) ( -- seq )
all-vocabs-seq [ vocab-name ] map ; inline
-: fuel-get-vocabs ( -- )
- (fuel-get-vocabs) fuel-eval-set-result ; inline
-
-: fuel-get-vocabs/prefix ( prefix -- )
- (fuel-get-vocabs) swap fuel-filter-prefix fuel-eval-set-result ; inline
-
-: fuel-vocab-summary ( name -- )
- >vocab-link summary fuel-eval-set-result ; inline
-
MEMO: (fuel-vocab-words) ( name -- seq )
>vocab-link words [ name>> ] map ;
@@ -237,151 +126,48 @@ MEMO: (fuel-vocab-words) ( name -- seq )
[ fuel-vocabs-words ] [ fuel-current-words ] if* natural-sort
swap fuel-filter-prefix ;
+PRIVATE>
+
+: fuel-get-vocabs ( -- )
+ (fuel-get-vocabs) fuel-eval-set-result ;
+
+: fuel-get-vocabs/prefix ( prefix -- )
+ (fuel-get-vocabs) swap fuel-filter-prefix fuel-eval-set-result ;
+
: fuel-get-words ( prefix names -- )
- (fuel-get-words) fuel-eval-set-result ; inline
+ (fuel-get-words) fuel-eval-set-result ;
! Help support
-MEMO: fuel-articles-seq ( -- seq )
- articles get values ;
+: fuel-get-article ( name -- ) article fuel-eval-set-result ;
-: fuel-find-articles ( title -- seq )
- [ [ article-title ] dip = ] curry fuel-articles-seq swap filter ;
+MEMO: fuel-get-article-title ( name -- )
+ articles get at [ article-title ] [ f ] if* fuel-eval-set-result ;
-MEMO: fuel-find-article ( title -- article/f )
- fuel-find-articles dup empty? [ drop f ] [ first ] if ;
+: fuel-word-help ( name -- ) (fuel-word-help) fuel-eval-set-result ;
-MEMO: fuel-article-title ( name -- title/f )
- articles get at [ article-title ] [ f ] if* ;
+: fuel-word-see ( name -- ) (fuel-word-see) fuel-eval-set-result ;
-: fuel-get-article ( name -- )
- article fuel-eval-set-result ;
+: fuel-vocab-help ( name -- ) (fuel-vocab-help) fuel-eval-set-result ;
-: fuel-value-str ( word -- str )
- [ pprint-short ] with-string-writer ; inline
-
-: fuel-definition-str ( word -- str )
- [ see ] with-string-writer ; inline
-
-: fuel-methods-str ( word -- str )
- methods dup empty? not [
- [ [ see nl ] each ] with-string-writer
- ] [ drop f ] if ; inline
-
-: fuel-related-words ( word -- seq )
- dup "related" word-prop remove ; inline
-
-: fuel-parent-topics ( word -- seq )
- help-path [ dup article-title swap 2array ] map ; inline
-
-: (fuel-word-help) ( word -- element )
- \ article swap dup article-title swap
- [
- {
- [ fuel-parent-topics [ \ $doc-path prefix , ] unless-empty ]
- [ \ $vocabulary swap vocabulary>> 2array , ]
- [ word-help % ]
- [ fuel-related-words [ \ $related swap 2array , ] unless-empty ]
- [ get-global [ \ $value swap fuel-value-str 2array , ] when* ]
- [ \ $definition swap fuel-definition-str 2array , ]
- [ fuel-methods-str [ \ $methods swap 2array , ] when* ]
- } cleave
- ] { } make 3array ;
-
-MEMO: fuel-find-word ( name -- word/f )
- [ [ name>> ] dip = ] curry all-words swap filter
- dup empty? not [ first ] [ drop f ] if ;
-
-: fuel-word-help ( name -- )
- fuel-find-word [ [ auto-use? on (fuel-word-help) ] with-scope ] [ f ] if*
- fuel-eval-set-result ; inline
-
-: (fuel-word-see) ( word -- elem )
- [ name>> \ article swap ]
- [ [ see ] with-string-writer \ $code swap 2array ] bi 3array ; inline
-
-: fuel-word-see ( name -- )
- fuel-find-word [ [ auto-use? on (fuel-word-see) ] with-scope ] [ f ] if*
- fuel-eval-set-result ; inline
-
-: fuel-vocab-help-row ( vocab -- element )
- [ vocab-status-string ] [ vocab-name ] [ summary ] tri 3array ;
-
-: fuel-vocab-help-root-heading ( root -- element )
- [ "Children from " prepend ] [ "Other children" ] if* \ $heading swap 2array ;
-
-SYMBOL: vocab-list
-
-: fuel-vocab-help-table ( vocabs -- element )
- [ fuel-vocab-help-row ] map vocab-list prefix ;
-
-: fuel-vocab-list ( assoc -- seq )
- [
- [ drop f ] [
- [ fuel-vocab-help-root-heading ]
- [ fuel-vocab-help-table ] bi*
- [ 2array ] [ drop f ] if*
- ] if-empty
- ] { } assoc>map [ ] filter ;
-
-: fuel-vocab-children-help ( name -- element )
- all-child-vocabs fuel-vocab-list ; inline
-
-: fuel-vocab-describe-words ( name -- element )
- [ describe-words ] with-string-writer \ describe-words swap 2array ; inline
-
-: (fuel-vocab-help) ( name -- element )
- dup require \ article swap dup >vocab-link
- [
- {
- [ vocab-authors [ \ $authors prefix , ] when* ]
- [ vocab-tags [ \ $tags prefix , ] when* ]
- [ summary [ { $heading "Summary" } swap 2array , ] when* ]
- [ drop \ $nl , ]
- [ vocab-help [ article content>> % ] when* ]
- [ name>> fuel-vocab-describe-words , ]
- [ name>> fuel-vocab-children-help % ]
- } cleave
- ] { } make 3array ;
-
-: fuel-vocab-help ( name -- )
- dup empty? [ fuel-vocab-children-help ] [ (fuel-vocab-help) ] if
- fuel-eval-set-result ; inline
-
-: (fuel-index) ( seq -- seq )
- [ [ >link name>> ] [ article-title ] bi 2array \ $subsection prefix ] map ;
-
-: fuel-index ( quot: ( -- seq ) -- )
- call (fuel-index) fuel-eval-set-result ; inline
-
-MEMO: (fuel-get-vocabs/author) ( author -- element )
- [ "Vocabularies by " prepend \ $heading swap 2array ]
- [ authored fuel-vocab-list ] bi 2array ;
-
-: fuel-get-vocabs/author ( author -- )
- (fuel-get-vocabs/author) fuel-eval-set-result ;
-
-MEMO: (fuel-get-vocabs/tag) ( tag -- element )
- [ "Vocabularies tagged " prepend \ $heading swap 2array ]
- [ tagged fuel-vocab-list ] bi 2array ;
+: fuel-vocab-summary ( name -- )
+ (fuel-vocab-summary) fuel-eval-set-result ;
: fuel-get-vocabs/tag ( tag -- )
(fuel-get-vocabs/tag) fuel-eval-set-result ;
+: fuel-get-vocabs/author ( author -- )
+ (fuel-get-vocabs/author) fuel-eval-set-result ;
+
! Scaffold support
: fuel-scaffold-vocab ( root name devname -- )
- developer-name set
- [ scaffold-vocab ] 2keep [ (normalize-path) ] dip dup
- append-path append-path ".factor" append fuel-eval-set-result ;
+ developer-name set dup [ scaffold-vocab ] dip
+ dup require vocab-source-path (normalize-path) fuel-eval-set-result ;
: fuel-scaffold-help ( name devname -- )
developer-name set
dup require dup scaffold-help vocab-docs-path
(normalize-path) fuel-eval-set-result ;
-! -run=fuel support
-
-: fuel-startup ( -- ) "listener" run-file ; inline
-
-MAIN: fuel-startup
+: fuel-scaffold-get-root ( name -- ) find-vocab-root fuel-eval-set-result ;
\ No newline at end of file
diff --git a/extra/fuel/help/authors.txt b/extra/fuel/help/authors.txt
new file mode 100644
index 0000000000..48f802a3cd
--- /dev/null
+++ b/extra/fuel/help/authors.txt
@@ -0,0 +1 @@
+Jose Antonio Ortega Ruiz
\ No newline at end of file
diff --git a/extra/fuel/help/help-tests.factor b/extra/fuel/help/help-tests.factor
new file mode 100644
index 0000000000..3c6ca6f8b5
--- /dev/null
+++ b/extra/fuel/help/help-tests.factor
@@ -0,0 +1,4 @@
+! Copyright (C) 2009 Jose Antonio Ortega Ruiz.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test fuel.help ;
+IN: fuel.help.tests
diff --git a/extra/fuel/help/help.factor b/extra/fuel/help/help.factor
new file mode 100644
index 0000000000..537e92ddd8
--- /dev/null
+++ b/extra/fuel/help/help.factor
@@ -0,0 +1,108 @@
+! Copyright (C) 2009 Jose Antonio Ortega Ruiz.
+! See http://factorcode.org/license.txt for BSD license.
+
+USING: accessors arrays assocs combinators help help.crossref
+help.markup help.topics io io.streams.string kernel make memoize
+namespaces parser prettyprint sequences summary tools.vocabs
+tools.vocabs.browser vocabs vocabs.loader words ;
+
+IN: fuel.help
+
+<PRIVATE
+
+MEMO: fuel-find-word ( name -- word/f )
+ [ [ name>> ] dip = ] curry all-words swap filter
+ dup empty? not [ first ] [ drop f ] if ;
+
+: fuel-value-str ( word -- str )
+ [ pprint-short ] with-string-writer ; inline
+
+: fuel-definition-str ( word -- str )
+ [ see ] with-string-writer ; inline
+
+: fuel-methods-str ( word -- str )
+ methods dup empty? not [
+ [ [ see nl ] each ] with-string-writer
+ ] [ drop f ] if ; inline
+
+: fuel-related-words ( word -- seq )
+ dup "related" word-prop remove ; inline
+
+: fuel-parent-topics ( word -- seq )
+ help-path [ dup article-title swap 2array ] map ; inline
+
+: (fuel-word-element) ( word -- element )
+ \ article swap dup article-title swap
+ [
+ {
+ [ fuel-parent-topics [ \ $doc-path prefix , ] unless-empty ]
+ [ \ $vocabulary swap vocabulary>> 2array , ]
+ [ word-help % ]
+ [ fuel-related-words [ \ $related swap 2array , ] unless-empty ]
+ [ get-global [ \ $value swap fuel-value-str 2array , ] when* ]
+ [ \ $definition swap fuel-definition-str 2array , ]
+ [ fuel-methods-str [ \ $methods swap 2array , ] when* ]
+ } cleave
+ ] { } make 3array ;
+
+: fuel-vocab-help-row ( vocab -- element )
+ [ vocab-status-string ] [ vocab-name ] [ summary ] tri 3array ;
+
+: fuel-vocab-help-root-heading ( root -- element )
+ [ "Children from " prepend ] [ "Other children" ] if* \ $heading swap 2array ;
+
+SYMBOL: vocab-list
+
+: fuel-vocab-help-table ( vocabs -- element )
+ [ fuel-vocab-help-row ] map vocab-list prefix ;
+
+: fuel-vocab-list ( assoc -- seq )
+ [
+ [ drop f ] [
+ [ fuel-vocab-help-root-heading ]
+ [ fuel-vocab-help-table ] bi*
+ [ 2array ] [ drop f ] if*
+ ] if-empty
+ ] { } assoc>map [ ] filter ;
+
+: fuel-vocab-children-help ( name -- element )
+ all-child-vocabs fuel-vocab-list ; inline
+
+: fuel-vocab-describe-words ( name -- element )
+ [ describe-words ] with-string-writer \ describe-words swap 2array ; inline
+
+: (fuel-vocab-element) ( name -- element )
+ dup require \ article swap dup >vocab-link
+ [
+ {
+ [ vocab-authors [ \ $authors prefix , ] when* ]
+ [ vocab-tags [ \ $tags prefix , ] when* ]
+ [ summary [ { $heading "Summary" } swap 2array , ] when* ]
+ [ drop \ $nl , ]
+ [ vocab-help [ article content>> % ] when* ]
+ [ name>> fuel-vocab-describe-words , ]
+ [ name>> fuel-vocab-children-help % ]
+ } cleave
+ ] { } make 3array ;
+
+PRIVATE>
+
+: (fuel-word-help) ( object -- object )
+ fuel-find-word [ [ auto-use? on (fuel-word-element) ] with-scope ] [ f ] if* ;
+
+: (fuel-word-see) ( word -- elem )
+ [ name>> \ article swap ]
+ [ [ see ] with-string-writer \ $code swap 2array ] bi 3array ; inline
+
+: (fuel-vocab-summary) ( name -- str ) >vocab-link summary ; inline
+
+: (fuel-vocab-help) ( name -- str )
+ dup empty? [ fuel-vocab-children-help ] [ (fuel-vocab-element) ] if ;
+
+MEMO: (fuel-get-vocabs/author) ( author -- element )
+ [ "Vocabularies by " prepend \ $heading swap 2array ]
+ [ authored fuel-vocab-list ] bi 2array ;
+
+MEMO: (fuel-get-vocabs/tag) ( tag -- element )
+ [ "Vocabularies tagged " prepend \ $heading swap 2array ]
+ [ tagged fuel-vocab-list ] bi 2array ;
diff --git a/extra/fuel/pprint/authors.txt b/extra/fuel/pprint/authors.txt
new file mode 100644
index 0000000000..48f802a3cd
--- /dev/null
+++ b/extra/fuel/pprint/authors.txt
@@ -0,0 +1 @@
+Jose Antonio Ortega Ruiz
\ No newline at end of file
diff --git a/extra/fuel/pprint/pprint-tests.factor b/extra/fuel/pprint/pprint-tests.factor
new file mode 100644
index 0000000000..a9868eacbe
--- /dev/null
+++ b/extra/fuel/pprint/pprint-tests.factor
@@ -0,0 +1,4 @@
+! Copyright (C) 2009 Jose Antonio Ortega Ruiz.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test fuel.pprint ;
+IN: fuel.pprint.tests
diff --git a/extra/fuel/pprint/pprint.factor b/extra/fuel/pprint/pprint.factor
new file mode 100644
index 0000000000..25f3aec14d
--- /dev/null
+++ b/extra/fuel/pprint/pprint.factor
@@ -0,0 +1,63 @@
+! Copyright (C) 2009 Jose Antonio Ortega Ruiz.
+! See http://factorcode.org/license.txt for BSD license.
+
+USING: accessors arrays classes.tuple combinators continuations io
+kernel lexer math prettyprint quotations sequences source-files
+strings words ;
+
+IN: fuel.pprint
+
+GENERIC: fuel-pprint ( obj -- )
+
+<PRIVATE
+
+: fuel-maybe-scape ( ch -- seq )
+ dup "\\\"?#()[]'`" member? [ CHAR: \ swap 2array ] [ 1array ] if ;
+
+SYMBOL: :restarts
+
+: fuel-restarts ( obj -- seq )
+ compute-restarts :restarts prefix ; inline
+
+: fuel-pprint-sequence ( seq open close -- )
+ [ write ] dip swap [ " " write ] [ fuel-pprint ] interleave write ; inline
+
+PRIVATE>
+
+M: object fuel-pprint pprint ; inline
+
+M: word fuel-pprint
+ name>> V{ } clone [ fuel-maybe-scape append ] reduce >string write ;
+
+M: f fuel-pprint drop "nil" write ; inline
+
+M: integer fuel-pprint pprint ; inline
+
+M: string fuel-pprint pprint ; inline
+
+M: sequence fuel-pprint "(" ")" fuel-pprint-sequence ; inline
+
+M: quotation fuel-pprint "[" "]" fuel-pprint-sequence ; inline
+
+M: tuple fuel-pprint tuple>array fuel-pprint ; inline
+
+M: continuation fuel-pprint drop ":continuation" write ; inline
+
+M: restart fuel-pprint name>> fuel-pprint ; inline
+
+M: condition fuel-pprint
+ [ error>> ] [ fuel-restarts ] bi 2array condition prefix fuel-pprint ;
+
+M: lexer-error fuel-pprint
+ {
+ [ line>> ]
+ [ column>> ]
+ [ line-text>> ]
+ [ fuel-restarts ]
+ } cleave 4array lexer-error prefix fuel-pprint ;
+
+M: source-file-error fuel-pprint
+ [ file>> ] [ error>> ] bi 2array source-file-error prefix
+ fuel-pprint ;
+
+M: source-file fuel-pprint path>> fuel-pprint ;
diff --git a/misc/fuel/README b/misc/fuel/README
index 2f3417a6b5..678bd25365 100644
--- a/misc/fuel/README
+++ b/misc/fuel/README
@@ -32,6 +32,7 @@ beast.
(require 'factor-mode)
* Basic usage
+*** Running the listener
If you're using the default factor binary and images locations inside
the Factor's source tree, that should be enough to start using FUEL.
@@ -97,6 +98,7 @@ beast.
- C-cC-xs : extract innermost sexp (up to point) as a separate word
- C-cC-xr : extract region as a separate word
+ - C-cC-xv : extract region as a separate vocabulary
*** In the listener:
diff --git a/misc/fuel/fuel-base.el b/misc/fuel/fuel-base.el
index f168cdf9b8..5e8364e3a7 100644
--- a/misc/fuel/fuel-base.el
+++ b/misc/fuel/fuel-base.el
@@ -1,6 +1,6 @@
;;; fuel-base.el --- Basic FUEL support code
-;; Copyright (C) 2008 Jose Antonio Ortega Ruiz
+;; Copyright (C) 2008 Jose Antonio Ortega Ruiz
;; See http://factorcode.org/license.txt for BSD license.
;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
diff --git a/misc/fuel/fuel-connection.el b/misc/fuel/fuel-connection.el
index f9cc1fb0f3..14c4d0b36f 100644
--- a/misc/fuel/fuel-connection.el
+++ b/misc/fuel/fuel-connection.el
@@ -160,7 +160,7 @@
(fuel-con--send-string/wait buffer
fuel-con--init-stanza
'fuel-con--establish-connection-cont
- 20000)
+ 60000)
conn))
(defun fuel-con--establish-connection-cont (ignore)
diff --git a/misc/fuel/fuel-debug-uses.el b/misc/fuel/fuel-debug-uses.el
index 7b90093c21..d37cf7b58d 100644
--- a/misc/fuel/fuel-debug-uses.el
+++ b/misc/fuel/fuel-debug-uses.el
@@ -1,6 +1,6 @@
;;; fuel-debug-uses.el -- retrieving USING: stanzas
-;; Copyright (C) 2008 Jose Antonio Ortega Ruiz
+;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz
;; See http://factorcode.org/license.txt for BSD license.
;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
@@ -32,6 +32,9 @@
;;; Utility functions:
+(defsubst fuel-debug--chomp (s)
+ (replace-regexp-in-string "[\n\r\f]" "" s))
+
(defun fuel-debug--file-lines (file)
(when (file-readable-p file)
(with-current-buffer (find-file-noselect file)
@@ -40,7 +43,8 @@
(let ((lines) (in-usings))
(while (not (eobp))
(when (looking-at "^USING: ") (setq in-usings t))
- (let ((line (substring-no-properties (thing-at-point 'line) 0 -1)))
+ (let ((line (fuel-debug--chomp
+ (substring-no-properties (thing-at-point 'line)))))
(when in-usings (setq line (concat "! " line)))
(push line lines))
(when (and in-usings (looking-at ".*\\_<;\\_>")) (setq in-usings nil))
diff --git a/misc/fuel/fuel-listener.el b/misc/fuel/fuel-listener.el
index c6835ede6b..3ad1b77978 100644
--- a/misc/fuel/fuel-listener.el
+++ b/misc/fuel/fuel-listener.el
@@ -73,7 +73,7 @@ buffer."
(error "Could not run factor: %s is not executable" factor))
(unless (file-readable-p image)
(error "Could not run factor: image file %s not readable" image))
- (message "Starting FUEL listener ...")
+ (message "Starting FUEL listener (this may take a while) ...")
(pop-to-buffer (fuel-listener--buffer))
(make-comint-in-buffer "fuel listener" (current-buffer) factor nil
"-run=listener" (format "-i=%s" image))
diff --git a/misc/fuel/fuel-markup.el b/misc/fuel/fuel-markup.el
index 9e5e1c8af2..696e4ff080 100644
--- a/misc/fuel/fuel-markup.el
+++ b/misc/fuel/fuel-markup.el
@@ -71,7 +71,7 @@
(defun fuel-markup--article-title (name)
(fuel-eval--retort-result
- (fuel-eval--send/wait `(:fuel* ((,name fuel-article-title :get)) "fuel"))))
+ (fuel-eval--send/wait `(:fuel* ((,name fuel-get-article-title)) "fuel"))))
(defun fuel-markup--link-at-point ()
(let ((button (condition-case nil (forward-button 0) (error nil))))
diff --git a/misc/fuel/fuel-mode.el b/misc/fuel/fuel-mode.el
index f448e67d57..ed0104d1cb 100644
--- a/misc/fuel/fuel-mode.el
+++ b/misc/fuel/fuel-mode.el
@@ -196,6 +196,7 @@ interacting with a factor listener is at your disposal.
(fuel-mode--key ?x ?s 'fuel-refactor-extract-sexp)
(fuel-mode--key ?x ?r 'fuel-refactor-extract-region)
+(fuel-mode--key ?x ?v 'fuel-refactor-extract-vocab)
(fuel-mode--key ?d ?> 'fuel-show-callees)
(fuel-mode--key ?d ?< 'fuel-show-callers)
diff --git a/misc/fuel/fuel-refactor.el b/misc/fuel/fuel-refactor.el
index 4bb83c06c8..38367b4cd8 100644
--- a/misc/fuel/fuel-refactor.el
+++ b/misc/fuel/fuel-refactor.el
@@ -13,6 +13,7 @@
;;; Code:
+(require 'fuel-scaffold)
(require 'fuel-stack)
(require 'fuel-syntax)
(require 'fuel-base)
@@ -70,7 +71,46 @@ word."
(if (looking-at-p ";") (point)
(fuel-syntax--end-of-symbol-pos))))
+
+;;; Extract vocab:
+(defun fuel-refactor--insert-using (vocab)
+ (save-excursion
+ (goto-char (point-min))
+ (let ((usings (sort (cons vocab (fuel-syntax--usings)) 'string<)))
+ (fuel-debug--replace-usings (buffer-file-name) usings))))
+
+(defun fuel-refactor--vocab-root (vocab)
+ (let ((cmd `(:fuel* (,vocab fuel-scaffold-get-root) "fuel")))
+ (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
+
+(defun fuel-refactor--extract-vocab (begin end)
+ (when (< begin end)
+ (let* ((str (buffer-substring begin end))
+ (buffer (current-buffer))
+ (vocab (fuel-syntax--current-vocab))
+ (vocab-hint (and vocab (format "%s." vocab)))
+ (root-hint (fuel-refactor--vocab-root vocab))
+ (vocab (fuel-scaffold-vocab t vocab-hint root-hint)))
+ (with-current-buffer buffer
+ (delete-region begin end)
+ (fuel-refactor--insert-using vocab))
+ (newline)
+ (insert str)
+ (newline)
+ (save-buffer)
+ (fuel-update-usings))))
+
+(defun fuel-refactor-extract-vocab (begin end)
+ "Creates a new vocab with the words in current region.
+The region is extended to the closest definition boundaries."
+ (interactive "r")
+ (fuel-refactor--extract-vocab (save-excursion (goto-char begin)
+ (mark-defun)
+ (point))
+ (save-excursion (goto-char end)
+ (mark-defun)
+ (mark))))
(provide 'fuel-refactor)
;;; fuel-refactor.el ends here
diff --git a/misc/fuel/fuel-scaffold.el b/misc/fuel/fuel-scaffold.el
index 8026371def..05d825593c 100644
--- a/misc/fuel/fuel-scaffold.el
+++ b/misc/fuel/fuel-scaffold.el
@@ -41,25 +41,26 @@
;;; User interface:
-(defun fuel-scaffold-vocab ()
+(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.
You can configure `fuel-scaffold-developer-name' (set by default to
`user-full-name') for the name to be inserted in the generated files."
(interactive)
- (let* ((name (read-string "Vocab name: "))
+ (let* ((name (read-string "Vocab name: " name-hint))
(root (completing-read "Vocab root: "
(fuel-scaffold--vocab-roots)
- nil t "resource:"))
+ nil t (or root-hint "resource:")))
(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))))
- (find-file file)
- (goto-char (point-max))))
+ (if other-window (find-file-other-window file) (find-file file))
+ (goto-char (point-max))
+ name))
(defun fuel-scaffold-help (&optional arg)
"Creates, if it does not already exist, a help file with