From d00d12d18c27c376aa19601f1fe7eb9d49841b3b Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Sun, 11 Jan 2009 22:29:11 +0100 Subject: [PATCH 1/5] FUEL: fuel-scaffold-vocab: go to the right source file for subvocabs. --- extra/fuel/fuel.factor | 5 ++--- misc/fuel/README | 1 + 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/extra/fuel/fuel.factor b/extra/fuel/fuel.factor index 587537adcf..238c9e11c8 100644 --- a/extra/fuel/fuel.factor +++ b/extra/fuel/fuel.factor @@ -371,9 +371,8 @@ MEMO: (fuel-get-vocabs/tag) ( tag -- element ) ! 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 diff --git a/misc/fuel/README b/misc/fuel/README index 2f3417a6b5..3563215089 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. From 960b67f6c9d37c6ba328463817a1bab51cd60920 Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Mon, 12 Jan 2009 00:52:31 +0100 Subject: [PATCH 2/5] FUEL: Subvocabularies factored out from fuel. --- extra/fuel/eval/authors.txt | 1 + extra/fuel/eval/eval-tests.factor | 4 + extra/fuel/eval/eval.factor | 75 ++++++ extra/fuel/fuel.factor | 329 +++++--------------------- extra/fuel/help/authors.txt | 1 + extra/fuel/help/help-tests.factor | 4 + extra/fuel/help/help.factor | 108 +++++++++ extra/fuel/pprint/authors.txt | 1 + extra/fuel/pprint/pprint-tests.factor | 4 + extra/fuel/pprint/pprint.factor | 63 +++++ misc/fuel/fuel-connection.el | 2 +- misc/fuel/fuel-listener.el | 2 +- misc/fuel/fuel-markup.el | 2 +- 13 files changed, 321 insertions(+), 275 deletions(-) create mode 100644 extra/fuel/eval/authors.txt create mode 100644 extra/fuel/eval/eval-tests.factor create mode 100644 extra/fuel/eval/eval.factor create mode 100644 extra/fuel/help/authors.txt create mode 100644 extra/fuel/help/help-tests.factor create mode 100644 extra/fuel/help/help.factor create mode 100644 extra/fuel/pprint/authors.txt create mode 100644 extra/fuel/pprint/pprint-tests.factor create mode 100644 extra/fuel/pprint/pprint.factor 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 238c9e11c8..155e5280e8 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 + + : 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 + [ 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 +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 +vocab-link summary fuel-eval-set-result ; inline - MEMO: (fuel-vocab-words) ( name -- seq ) >vocab-link words [ name>> ] map ; @@ -237,137 +126,39 @@ 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 -- ) @@ -378,9 +169,3 @@ MEMO: (fuel-get-vocabs/tag) ( tag -- element ) 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 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 + +> ] 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 -- ) + + + +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/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-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)))) From 977c4d6b6a5fa5545394440b855e98fb55e39d98 Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Mon, 12 Jan 2009 02:10:13 +0100 Subject: [PATCH 3/5] FUEL: New command: fuel-refactor-extract-vocab. --- extra/fuel/fuel.factor | 2 ++ misc/fuel/fuel-mode.el | 1 + misc/fuel/fuel-refactor.el | 40 ++++++++++++++++++++++++++++++++++++++ misc/fuel/fuel-scaffold.el | 11 ++++++----- 4 files changed, 49 insertions(+), 5 deletions(-) diff --git a/extra/fuel/fuel.factor b/extra/fuel/fuel.factor index 155e5280e8..a399ab2776 100644 --- a/extra/fuel/fuel.factor +++ b/extra/fuel/fuel.factor @@ -169,3 +169,5 @@ MEMO: fuel-get-article-title ( name -- ) developer-name set dup require dup scaffold-help vocab-docs-path (normalize-path) fuel-eval-set-result ; + +: fuel-scaffold-get-root ( name -- ) find-vocab-root fuel-eval-set-result ; \ No newline at end of file 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 From 28029404c3986214dbafc865e09ce2176d6057db Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Mon, 12 Jan 2009 02:12:30 +0100 Subject: [PATCH 4/5] FUEL: README updated. --- misc/fuel/README | 1 + 1 file changed, 1 insertion(+) diff --git a/misc/fuel/README b/misc/fuel/README index 3563215089..678bd25365 100644 --- a/misc/fuel/README +++ b/misc/fuel/README @@ -98,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: From 871a2bb7450d57f963e391d9916a7ce5302ca5df Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Mon, 12 Jan 2009 02:34:39 +0100 Subject: [PATCH 5/5] FUEL: Fix usings update when no newline at eof. --- misc/fuel/fuel-base.el | 2 +- misc/fuel/fuel-debug-uses.el | 8 ++++++-- 2 files changed, 7 insertions(+), 3 deletions(-) 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 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 @@ -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))