tools.vocabs absorbs some words from tools.browser and vocabs.loader

db4
Slava Pestov 2008-03-12 19:55:06 -05:00
parent e8c2ad6fa6
commit 8399336648
24 changed files with 531 additions and 509 deletions

View File

@ -23,9 +23,6 @@ $nl
"Application vocabularies can define a main entry point, giving the user a convenient way to run the application:"
{ $subsection POSTPONE: MAIN: }
{ $subsection run }
"Reloading source files changed on disk:"
{ $subsection refresh }
{ $subsection refresh-all }
{ $see-also "vocabularies" "parser-files" "source-files" } ;
ABOUT: "vocabs.loader"
@ -80,7 +77,7 @@ HELP: reload
HELP: require
{ $values { "vocab" "a vocabulary specifier" } }
{ $description "Loads a vocabulary if it has not already been loaded." }
{ $notes "To unconditionally reload a vocabulary, use " { $link reload } ". To reload changed source files, use " { $link refresh } " or " { $link refresh-all } "." } ;
{ $notes "To unconditionally reload a vocabulary, use " { $link reload } ". To reload changed source files only, use the words in " { $link "tools.vocabs" } "." } ;
HELP: run
{ $values { "vocab" "a vocabulary specifier" } }
@ -93,12 +90,3 @@ HELP: vocab-source-path
HELP: vocab-docs-path
{ $values { "vocab" "a vocabulary specifier" } { "path/f" "a pathname string or " { $link f } } }
{ $description "Outputs a pathname where the documentation for " { $snippet "vocab" } " might be found. Outputs " { $link f } " if the vocabulary does not have a directory on disk." } ;
HELP: refresh
{ $values { "prefix" string } }
{ $description "Reloads source files and documentation belonging to loaded vocabularies whose names are prefixed by " { $snippet "prefix" } " which have been modified on disk." } ;
HELP: refresh-all
{ $description "Reloads source files and documentation for all loaded vocabularies which have been modified on disk." } ;
{ refresh refresh-all } related-words

View File

@ -119,68 +119,7 @@ SYMBOL: load-help?
"To define one, refer to \\ MAIN: help" print
] ?if ;
: modified ( seq quot -- seq )
[ dup ] swap compose { } map>assoc
[ nip ] assoc-subset
[ nip source-modified? ] assoc-subset keys ; inline
: modified-sources ( vocabs -- seq )
[ vocab-source-path ] modified ;
: modified-docs ( vocabs -- seq )
[ vocab-docs-path ] modified ;
: update-roots ( vocabs -- )
[ dup find-vocab-root swap vocab set-vocab-root ] each ;
: to-refresh ( prefix -- modified-sources modified-docs )
child-vocabs
dup update-roots
dup modified-sources swap modified-docs ;
: vocab-heading. ( vocab -- )
nl
"==== " write
dup vocab-name swap vocab write-object ":" print
nl ;
: load-error. ( triple -- )
dup first vocab-heading.
dup second print-error
drop ;
: load-failures. ( failures -- )
[ load-error. nl ] each ;
SYMBOL: blacklist
SYMBOL: failures
: require-all ( vocabs -- failures )
[
V{ } clone blacklist set
V{ } clone failures set
[
[ require ]
[ swap vocab-name failures get set-at ]
recover
] each
failures get
] with-compiler-errors ;
: do-refresh ( modified-sources modified-docs -- )
2dup
[ f swap set-vocab-docs-loaded? ] each
[ f swap set-vocab-source-loaded? ] each
append prune require-all load-failures. ;
: refresh ( prefix -- ) to-refresh do-refresh ;
SYMBOL: sources-changed?
[ t sources-changed? set-global ] "vocabs.loader" add-init-hook
: refresh-all ( -- )
"" refresh f sources-changed? set-global ;
GENERIC: (load-vocab) ( name -- vocab )

View File

@ -1,6 +1,6 @@
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel vocabs vocabs.loader tools.time tools.browser
USING: kernel vocabs vocabs.loader tools.time tools.vocabs
arrays assocs io.styles io help.markup prettyprint sequences
continuations debugger ;
IN: benchmark

View File

@ -11,5 +11,6 @@ USING: vocabs.loader sequences ;
"tools.test"
"tools.time"
"tools.threads"
"tools.vocabs"
"editors"
} [ require ] each

View File

@ -1,7 +1,7 @@
! Copyright (C) 2005, 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: parser kernel namespaces sequences definitions io.files
inspector continuations tuples tools.crossref tools.browser
inspector continuations tuples tools.crossref tools.vocabs
io prettyprint source-files assocs vocabs vocabs.loader ;
IN: editors

View File

@ -196,6 +196,7 @@ ARTICLE: "io" "Input and output"
{ $subsection "io.timeouts" } ;
ARTICLE: "tools" "Developer tools"
{ $subsection "tools.vocabs" }
"Exploratory tools:"
{ $subsection "editor" }
{ $subsection "tools.crossref" }

2
extra/help/lint/lint.factor Normal file → Executable file
View File

@ -1,7 +1,7 @@
! Copyright (C) 2006, 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: sequences parser kernel help help.markup help.topics
words strings classes tools.browser namespaces io
words strings classes tools.vocabs namespaces io
io.streams.string prettyprint definitions arrays vectors
combinators splitting debugger hashtables sorting effects vocabs
vocabs.loader assocs editors continuations classes.predicate

4
extra/help/topics/topics.factor Normal file → Executable file
View File

@ -7,6 +7,10 @@ IN: help.topics
TUPLE: link name ;
MIXIN: topic
INSTANCE: link topic
INSTANCE: word topic
GENERIC: >link ( obj -- obj )
M: link >link ;
M: vocab-spec >link ;

View File

@ -4,4 +4,4 @@ combinators namespaces system vocabs.loader sequences ;
"io.unix." os append require
"vocabs.monitor" require
"tools.vocabs.monitor" require

View File

@ -14,4 +14,4 @@ USE: io.backend
T{ windows-nt-io } set-io-backend
"vocabs.monitor" require
"tools.vocabs.monitor" require

View File

@ -1,4 +0,0 @@
IN: tools.browser.tests
USING: tools.browser tools.test help.markup ;
[ ] [ { $describe-vocab "scratchpad" } print-content ] unit-test

View File

@ -1,364 +0,0 @@
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: namespaces splitting sequences io.files kernel assocs
words vocabs vocabs.loader definitions parser continuations
inspector debugger io io.styles hashtables
sorting prettyprint source-files arrays combinators strings
system math.parser help.markup help.topics help.syntax
help.stylesheet memoize io.encodings.utf8 ;
IN: tools.browser
MEMO: (vocab-file-contents) ( path -- lines )
?resource-path dup exists?
[ utf8 file-lines ] [ drop f ] if ;
: vocab-file-contents ( vocab name -- seq )
vocab-path+ dup [ (vocab-file-contents) ] when ;
: set-vocab-file-contents ( seq vocab name -- )
dupd vocab-path+ [
?resource-path utf8 set-file-lines
] [
"The " swap vocab-name
" vocabulary was not loaded from the file system"
3append throw
] ?if ;
: vocab-summary-path ( vocab -- string )
vocab-dir "summary.txt" path+ ;
: vocab-summary ( vocab -- summary )
dup dup vocab-summary-path vocab-file-contents
dup empty? [
drop vocab-name " vocabulary" append
] [
nip first
] if ;
M: vocab summary
[
dup vocab-summary %
" (" %
vocab-words assoc-size #
" words)" %
] "" make ;
M: vocab-link summary vocab-summary ;
: set-vocab-summary ( string vocab -- )
>r 1array r>
dup vocab-summary-path
set-vocab-file-contents ;
: vocab-tags-path ( vocab -- string )
vocab-dir "tags.txt" path+ ;
: vocab-tags ( vocab -- tags )
dup vocab-tags-path vocab-file-contents ;
: set-vocab-tags ( tags vocab -- )
dup vocab-tags-path set-vocab-file-contents ;
: add-vocab-tags ( tags vocab -- )
[ vocab-tags append prune ] keep set-vocab-tags ;
: vocab-authors-path ( vocab -- string )
vocab-dir "authors.txt" path+ ;
: vocab-authors ( vocab -- authors )
dup vocab-authors-path vocab-file-contents ;
: set-vocab-authors ( authors vocab -- )
dup vocab-authors-path set-vocab-file-contents ;
: subdirs ( dir -- dirs )
directory [ second ] subset keys natural-sort ;
: (all-child-vocabs) ( root name -- vocabs )
[ vocab-dir path+ ?resource-path subdirs ] keep
dup empty? [
drop
] [
swap [ "." swap 3append ] with map
] if ;
: vocabs-in-dir ( root name -- )
dupd (all-child-vocabs) [
2dup vocab-dir? [ 2dup swap >vocab-link , ] when
vocabs-in-dir
] with each ;
: all-vocabs ( -- assoc )
vocab-roots get [
dup [ "" vocabs-in-dir ] { } make
] { } map>assoc ;
MEMO: all-vocabs-seq ( -- seq )
all-vocabs values concat ;
: dangerous? ( name -- ? )
#! Hack
{
{ [ "cpu." ?head ] [ t ] }
{ [ "io.unix" ?head ] [ t ] }
{ [ "io.windows" ?head ] [ t ] }
{ [ "ui.x11" ?head ] [ t ] }
{ [ "ui.windows" ?head ] [ t ] }
{ [ "ui.cocoa" ?head ] [ t ] }
{ [ "cocoa" ?head ] [ t ] }
{ [ "core-foundation" ?head ] [ t ] }
{ [ "vocabs.loader.test" ?head ] [ t ] }
{ [ "editors." ?head ] [ t ] }
{ [ ".windows" ?tail ] [ t ] }
{ [ ".unix" ?tail ] [ t ] }
{ [ "unix." ?head ] [ t ] }
{ [ ".linux" ?tail ] [ t ] }
{ [ ".bsd" ?tail ] [ t ] }
{ [ ".macosx" ?tail ] [ t ] }
{ [ "windows." ?head ] [ t ] }
{ [ "cocoa" ?head ] [ t ] }
{ [ ".test" ?tail ] [ t ] }
{ [ "raptor" ?head ] [ t ] }
{ [ dup "tools.deploy.app" = ] [ t ] }
{ [ t ] [ f ] }
} cond nip ;
: filter-dangerous ( seq -- seq' )
[ vocab-name dangerous? not ] subset ;
: try-everything ( -- failures )
all-vocabs-seq
filter-dangerous
require-all ;
: load-everything ( -- )
try-everything load-failures. ;
: unrooted-child-vocabs ( prefix -- seq )
dup empty? [ CHAR: . add ] unless
vocabs
[ vocab-root not ] subset
[
vocab-name swap ?head CHAR: . rot member? not and
] with subset
[ vocab ] map ;
: all-child-vocabs ( prefix -- assoc )
vocab-roots get [
over dupd dupd (all-child-vocabs)
swap [ >vocab-link ] curry map
] { } map>assoc
f rot unrooted-child-vocabs 2array add ;
: load-children ( prefix -- )
all-child-vocabs values concat
filter-dangerous
require-all
load-failures. ;
: vocab-status-string ( vocab -- string )
{
{ [ dup not ] [ drop "" ] }
{ [ dup vocab-main ] [ drop "[Runnable]" ] }
{ [ t ] [ drop "[Loaded]" ] }
} cond ;
: write-status ( vocab -- )
vocab vocab-status-string write ;
: vocab. ( vocab -- )
[
dup [ write-status ] with-cell
dup [ ($link) ] with-cell
[ vocab-summary write ] with-cell
] with-row ;
: vocab-headings. ( -- )
[
[ "State" write ] with-cell
[ "Vocabulary" write ] with-cell
[ "Summary" write ] with-cell
] with-row ;
: root-heading. ( root -- )
[ "Children from " swap append ] [ "Children" ] if*
$heading ;
: vocabs. ( assoc -- )
[
dup empty? [
2drop
] [
swap root-heading.
standard-table-style [
vocab-headings. [ vocab. ] each
] ($grid)
] if
] assoc-each ;
: describe-summary ( vocab -- )
vocab-summary [
"Summary" $heading print-element
] when* ;
TUPLE: vocab-tag name ;
C: <vocab-tag> vocab-tag
: tags. ( seq -- ) [ <vocab-tag> ] map $links ;
: describe-tags ( vocab -- )
vocab-tags f like [
"Tags" $heading tags.
] when* ;
TUPLE: vocab-author name ;
C: <vocab-author> vocab-author
: authors. ( seq -- ) [ <vocab-author> ] map $links ;
: describe-authors ( vocab -- )
vocab-authors f like [
"Authors" $heading authors.
] when* ;
: describe-help ( vocab -- )
vocab-help [
"Documentation" $heading nl ($link)
] when* ;
: describe-children ( vocab -- )
vocab-name all-child-vocabs vocabs. ;
: describe-files ( vocab -- )
vocab-files [ <pathname> ] map [
"Files" $heading
[
snippet-style get [
code-style get [
stack.
] with-nesting
] with-style
] ($block)
] when* ;
: describe-words ( vocab -- )
words dup empty? [
"Words" $heading
dup natural-sort $links
] unless drop ;
: map>set ( seq quot -- )
map concat prune natural-sort ; inline
: vocab-xref ( vocab quot -- vocabs )
>r dup vocab-name swap words r> map
[ [ word? ] subset [ word-vocabulary ] map ] map>set
remove [ ] subset [ vocab ] map ; inline
: vocab-uses ( vocab -- vocabs ) [ uses ] vocab-xref ;
: vocab-usage ( vocab -- vocabs ) [ usage ] vocab-xref ;
: describe-uses ( vocab -- )
vocab-uses dup empty? [
"Uses" $heading
dup $links
] unless drop ;
: describe-usage ( vocab -- )
vocab-usage dup empty? [
"Used by" $heading
dup $links
] unless drop ;
: $describe-vocab ( element -- )
first
dup describe-children
dup vocab-root over vocab-dir? [
dup describe-summary
dup describe-tags
dup describe-authors
dup describe-files
] when
dup vocab [
dup describe-help
dup describe-words
dup describe-uses
dup describe-usage
] when drop ;
: keyed-vocabs ( str quot -- seq )
all-vocabs [
swap >r
[ >r 2dup r> swap call member? ] subset
r> swap
] assoc-map 2nip ; inline
: tagged ( tag -- assoc )
[ vocab-tags ] keyed-vocabs ;
: authored ( author -- assoc )
[ vocab-authors ] keyed-vocabs ;
: $tagged-vocabs ( element -- )
first tagged vocabs. ;
MEMO: all-tags ( -- seq )
all-vocabs-seq [ vocab-tags ] map>set ;
: $authored-vocabs ( element -- )
first authored vocabs. ;
MEMO: all-authors ( -- seq )
all-vocabs-seq [ vocab-authors ] map>set ;
: $tags ( element -- )
drop "Tags" $heading all-tags tags. ;
: $authors ( element -- )
drop "Authors" $heading all-authors authors. ;
M: vocab-spec article-title vocab-name " vocabulary" append ;
M: vocab-spec article-name vocab-name ;
M: vocab-spec article-content
vocab-name \ $describe-vocab swap 2array ;
M: vocab-spec article-parent drop "vocab-index" ;
M: vocab-tag >link ;
M: vocab-tag article-title
vocab-tag-name "Vocabularies tagged ``" swap "''" 3append ;
M: vocab-tag article-name vocab-tag-name ;
M: vocab-tag article-content
\ $tagged-vocabs swap vocab-tag-name 2array ;
M: vocab-tag article-parent drop "vocab-index" ;
M: vocab-tag summary article-title ;
M: vocab-author >link ;
M: vocab-author article-title
vocab-author-name "Vocabularies by " swap append ;
M: vocab-author article-name vocab-author-name ;
M: vocab-author article-content
\ $authored-vocabs swap vocab-author-name 2array ;
M: vocab-author article-parent drop "vocab-index" ;
M: vocab-author summary article-title ;
: reset-cache ( -- )
\ (vocab-file-contents) reset-memoized
\ all-vocabs-seq reset-memoized
\ all-authors reset-memoized
\ all-tags reset-memoized ;

View File

@ -0,0 +1,7 @@
USING: help.markup help.syntax io strings ;
IN: tools.vocabs.browser
ARTICLE: "vocab-index" "Vocabulary index"
{ $tags }
{ $authors }
{ $describe-vocab "" } ;

View File

@ -0,0 +1,4 @@
IN: tools.vocabs.browser.tests
USING: tools.vocabs.browser tools.test help.markup ;
[ ] [ { $describe-vocab "scratchpad" } print-content ] unit-test

View File

@ -0,0 +1,207 @@
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel combinators vocabs vocabs.loader tools.vocabs io
io.files io.styles help.markup help.stylesheet sequences assocs
help.topics namespaces prettyprint words sorting definitions
arrays inspector ;
IN: tools.vocabs.browser
: vocab-status-string ( vocab -- string )
{
{ [ dup not ] [ drop "" ] }
{ [ dup vocab-main ] [ drop "[Runnable]" ] }
{ [ t ] [ drop "[Loaded]" ] }
} cond ;
: write-status ( vocab -- )
vocab vocab-status-string write ;
: vocab. ( vocab -- )
[
dup [ write-status ] with-cell
dup [ ($link) ] with-cell
[ vocab-summary write ] with-cell
] with-row ;
: vocab-headings. ( -- )
[
[ "State" write ] with-cell
[ "Vocabulary" write ] with-cell
[ "Summary" write ] with-cell
] with-row ;
: root-heading. ( root -- )
[ "Children from " swap append ] [ "Children" ] if*
$heading ;
: vocabs. ( assoc -- )
[
dup empty? [
2drop
] [
swap root-heading.
standard-table-style [
vocab-headings. [ vocab. ] each
] ($grid)
] if
] assoc-each ;
: describe-summary ( vocab -- )
vocab-summary [
"Summary" $heading print-element
] when* ;
TUPLE: vocab-tag name ;
INSTANCE: vocab-tag topic
C: <vocab-tag> vocab-tag
: tags. ( seq -- ) [ <vocab-tag> ] map $links ;
: describe-tags ( vocab -- )
vocab-tags f like [
"Tags" $heading tags.
] when* ;
TUPLE: vocab-author name ;
INSTANCE: vocab-author topic
C: <vocab-author> vocab-author
: authors. ( seq -- ) [ <vocab-author> ] map $links ;
: describe-authors ( vocab -- )
vocab-authors f like [
"Authors" $heading authors.
] when* ;
: describe-help ( vocab -- )
vocab-help [
"Documentation" $heading nl ($link)
] when* ;
: describe-children ( vocab -- )
vocab-name all-child-vocabs vocabs. ;
: describe-files ( vocab -- )
vocab-files [ <pathname> ] map [
"Files" $heading
[
snippet-style get [
code-style get [
stack.
] with-nesting
] with-style
] ($block)
] when* ;
: describe-words ( vocab -- )
words dup empty? [
"Words" $heading
dup natural-sort $links
] unless drop ;
: vocab-xref ( vocab quot -- vocabs )
>r dup vocab-name swap words r> map
[ [ word? ] subset [ word-vocabulary ] map ] map>set
remove [ ] subset [ vocab ] map ; inline
: vocab-uses ( vocab -- vocabs ) [ uses ] vocab-xref ;
: vocab-usage ( vocab -- vocabs ) [ usage ] vocab-xref ;
: describe-uses ( vocab -- )
vocab-uses dup empty? [
"Uses" $heading
dup $links
] unless drop ;
: describe-usage ( vocab -- )
vocab-usage dup empty? [
"Used by" $heading
dup $links
] unless drop ;
: $describe-vocab ( element -- )
first
dup describe-children
dup vocab-root over vocab-dir? [
dup describe-summary
dup describe-tags
dup describe-authors
dup describe-files
] when
dup vocab [
dup describe-help
dup describe-words
dup describe-uses
dup describe-usage
] when drop ;
: keyed-vocabs ( str quot -- seq )
all-vocabs [
swap >r
[ >r 2dup r> swap call member? ] subset
r> swap
] assoc-map 2nip ; inline
: tagged ( tag -- assoc )
[ vocab-tags ] keyed-vocabs ;
: authored ( author -- assoc )
[ vocab-authors ] keyed-vocabs ;
: $tagged-vocabs ( element -- )
first tagged vocabs. ;
: $authored-vocabs ( element -- )
first authored vocabs. ;
: $tags ( element -- )
drop "Tags" $heading all-tags tags. ;
: $authors ( element -- )
drop "Authors" $heading all-authors authors. ;
INSTANCE: vocab topic
INSTANCE: vocab-link topic
M: vocab-spec article-title vocab-name " vocabulary" append ;
M: vocab-spec article-name vocab-name ;
M: vocab-spec article-content
vocab-name \ $describe-vocab swap 2array ;
M: vocab-spec article-parent drop "vocab-index" ;
M: vocab-tag >link ;
M: vocab-tag article-title
vocab-tag-name "Vocabularies tagged ``" swap "''" 3append ;
M: vocab-tag article-name vocab-tag-name ;
M: vocab-tag article-content
\ $tagged-vocabs swap vocab-tag-name 2array ;
M: vocab-tag article-parent drop "vocab-index" ;
M: vocab-tag summary article-title ;
M: vocab-author >link ;
M: vocab-author article-title
vocab-author-name "Vocabularies by " swap append ;
M: vocab-author article-name vocab-author-name ;
M: vocab-author article-content
\ $authored-vocabs swap vocab-author-name 2array ;
M: vocab-author article-parent drop "vocab-index" ;
M: vocab-author summary article-title ;

View File

@ -1,8 +1,8 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: threads io.files io.monitors init kernel
tools.browser namespaces continuations vocabs.loader ;
IN: vocabs.monitor
vocabs.loader tools.vocabs namespaces continuations ;
IN: tools.vocabs.monitor
! Use file system change monitoring to flush the tags/authors
! cache
@ -21,4 +21,4 @@ SYMBOL: vocab-monitor
[ monitor-thread t ] "Vocabulary monitor" spawn-server drop
] ignore-errors ;
[ start-monitor-thread ] "vocabs.monitor" add-init-hook
[ start-monitor-thread ] "tools.vocabs.monitor" add-init-hook

View File

@ -1,52 +1,63 @@
USING: help.markup help.syntax io strings ;
IN: tools.browser
ARTICLE: "vocab-index" "Vocabulary index"
{ $tags }
{ $authors }
{ $describe-vocab "" } ;
ARTICLE: "tools.browser" "Vocabulary browser"
"Getting and setting vocabulary meta-data:"
{ $subsection vocab-file-contents }
{ $subsection set-vocab-file-contents }
{ $subsection vocab-summary }
{ $subsection set-vocab-summary }
{ $subsection vocab-tags }
{ $subsection set-vocab-tags }
{ $subsection add-vocab-tags }
"Global meta-data:"
{ $subsection all-vocabs }
{ $subsection all-vocabs-seq }
{ $subsection all-tags }
{ $subsection all-authors }
"Because loading the above data is expensive, it is cached. The cache is flushed by the " { $vocab-link "vocabs.monitor" } " vocabulary. It can also be flushed manually when file system change monitors are not available:"
{ $subsection reset-cache } ;
HELP: vocab-file-contents
{ $values { "vocab" "a vocabulary specifier" } { "name" string } { "seq" "a sequence of lines, or " { $link f } } }
{ $description "Outputs the contents of the file named " { $snippet "name" } " from the vocabulary's directory, or " { $link f } " if the file does not exist." } ;
HELP: set-vocab-file-contents
{ $values { "seq" "a sequence of lines" } { "vocab" "a vocabulary specifier" } { "name" string } }
{ $description "Stores a sequence of lines to the file named " { $snippet "name" } " from the vocabulary's directory." } ;
HELP: vocab-summary
{ $values { "vocab" "a vocabulary specifier" } { "summary" "a string or " { $link f } } }
{ $description "Outputs a one-line string description of the vocabulary's intended purpose from the " { $snippet "summary.txt" } " file in the vocabulary's directory. Outputs " { $link f } " if the file does not exist." } ;
HELP: set-vocab-summary
{ $values { "string" "a string or " { $link f } } { "vocab" "a vocabulary specifier" } }
{ $description "Stores a one-line string description of the vocabulary to the " { $snippet "summary.txt" } " file in the vocabulary's directory." } ;
HELP: vocab-tags
{ $values { "vocab" "a vocabulary specifier" } { "tags" "a sequence of strings" } }
{ $description "Outputs a list of short tags classifying the vocabulary from the " { $snippet "tags.txt" } " file in the vocabulary's directory. Outputs " { $link f } " if the file does not exist." } ;
HELP: set-vocab-tags
{ $values { "tags" "a sequence of strings" } { "vocab" "a vocabulary specifier" } }
{ $description "Stores a list of short tags classifying the vocabulary to the " { $snippet "tags.txt" } " file in the vocabulary's directory." } ;
HELP: all-vocabs
{ $values { "assoc" "an association list mapping vocabulary roots to sequences of vocabulary specifiers" } }
{ $description "Outputs an association list of all vocabularies which have been loaded or are available for loading." } ;
USING: help.markup help.syntax strings ;
IN: tools.vocabs
ARTICLE: "tools.vocabs" "Vocabulary tools"
"Reloading source files changed on disk:"
{ $subsection refresh }
{ $subsection refresh-all }
"Vocabulary summaries:"
{ $subsection vocab-summary }
{ $subsection set-vocab-summary }
"Vocabulary tags:"
{ $subsection vocab-tags }
{ $subsection set-vocab-tags }
{ $subsection add-vocab-tags }
"Getting and setting vocabulary meta-data:"
{ $subsection vocab-file-contents }
{ $subsection set-vocab-file-contents }
"Global meta-data:"
{ $subsection all-vocabs }
{ $subsection all-vocabs-seq }
{ $subsection all-tags }
{ $subsection all-authors }
"Because loading the above data is expensive, it is cached. The cache is flushed by the " { $vocab-link "tools.vocabs.monitor" } " vocabulary. It can also be flushed manually when file system change monitors are not available:"
{ $subsection reset-cache } ;
ABOUT: "tools.vocabs"
HELP: refresh
{ $values { "prefix" string } }
{ $description "Reloads source files and documentation belonging to loaded vocabularies whose names are prefixed by " { $snippet "prefix" } " which have been modified on disk." } ;
HELP: refresh-all
{ $description "Reloads source files and documentation for all loaded vocabularies which have been modified on disk." } ;
{ refresh refresh-all } related-words
HELP: vocab-file-contents
{ $values { "vocab" "a vocabulary specifier" } { "name" string } { "seq" "a sequence of lines, or " { $link f } } }
{ $description "Outputs the contents of the file named " { $snippet "name" } " from the vocabulary's directory, or " { $link f } " if the file does not exist." } ;
HELP: set-vocab-file-contents
{ $values { "seq" "a sequence of lines" } { "vocab" "a vocabulary specifier" } { "name" string } }
{ $description "Stores a sequence of lines to the file named " { $snippet "name" } " from the vocabulary's directory." } ;
HELP: vocab-summary
{ $values { "vocab" "a vocabulary specifier" } { "summary" "a string or " { $link f } } }
{ $description "Outputs a one-line string description of the vocabulary's intended purpose from the " { $snippet "summary.txt" } " file in the vocabulary's directory. Outputs " { $link f } " if the file does not exist." } ;
HELP: set-vocab-summary
{ $values { "string" "a string or " { $link f } } { "vocab" "a vocabulary specifier" } }
{ $description "Stores a one-line string description of the vocabulary to the " { $snippet "summary.txt" } " file in the vocabulary's directory." } ;
HELP: vocab-tags
{ $values { "vocab" "a vocabulary specifier" } { "tags" "a sequence of strings" } }
{ $description "Outputs a list of short tags classifying the vocabulary from the " { $snippet "tags.txt" } " file in the vocabulary's directory. Outputs " { $link f } " if the file does not exist." } ;
HELP: set-vocab-tags
{ $values { "tags" "a sequence of strings" } { "vocab" "a vocabulary specifier" } }
{ $description "Stores a list of short tags classifying the vocabulary to the " { $snippet "tags.txt" } " file in the vocabulary's directory." } ;
HELP: all-vocabs
{ $values { "assoc" "an association list mapping vocabulary roots to sequences of vocabulary specifiers" } }
{ $description "Outputs an association list of all vocabularies which have been loaded or are available for loading." } ;

232
extra/tools/vocabs/vocabs.factor Executable file
View File

@ -0,0 +1,232 @@
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: io.files kernel io.encodings.utf8 vocabs.loader vocabs
sequences namespaces math.parser arrays hashtables assocs
memoize inspector sorting splitting combinators source-files
io debugger continuations compiler.errors init ;
IN: tools.vocabs
: modified ( seq quot -- seq )
[ dup ] swap compose { } map>assoc
[ nip ] assoc-subset
[ nip source-modified? ] assoc-subset keys ; inline
: modified-sources ( vocabs -- seq )
[ vocab-source-path ] modified ;
: modified-docs ( vocabs -- seq )
[ vocab-docs-path ] modified ;
: update-roots ( vocabs -- )
[ dup find-vocab-root swap vocab set-vocab-root ] each ;
: to-refresh ( prefix -- modified-sources modified-docs )
child-vocabs
dup update-roots
dup modified-sources swap modified-docs ;
: vocab-heading. ( vocab -- )
nl
"==== " write
dup vocab-name swap vocab write-object ":" print
nl ;
: load-error. ( triple -- )
dup first vocab-heading.
dup second print-error
drop ;
: load-failures. ( failures -- )
[ load-error. nl ] each ;
SYMBOL: failures
: require-all ( vocabs -- failures )
[
V{ } clone blacklist set
V{ } clone failures set
[
[ require ]
[ swap vocab-name failures get set-at ]
recover
] each
failures get
] with-compiler-errors ;
: do-refresh ( modified-sources modified-docs -- )
2dup
[ f swap set-vocab-docs-loaded? ] each
[ f swap set-vocab-source-loaded? ] each
append prune require-all load-failures. ;
: refresh ( prefix -- ) to-refresh do-refresh ;
SYMBOL: sources-changed?
[ t sources-changed? set-global ] "tools.vocabs" add-init-hook
: refresh-all ( -- )
"" refresh f sources-changed? set-global ;
MEMO: (vocab-file-contents) ( path -- lines )
?resource-path dup exists?
[ utf8 file-lines ] [ drop f ] if ;
: vocab-file-contents ( vocab name -- seq )
vocab-path+ dup [ (vocab-file-contents) ] when ;
: set-vocab-file-contents ( seq vocab name -- )
dupd vocab-path+ [
?resource-path utf8 set-file-lines
] [
"The " swap vocab-name
" vocabulary was not loaded from the file system"
3append throw
] ?if ;
: vocab-summary-path ( vocab -- string )
vocab-dir "summary.txt" path+ ;
: vocab-summary ( vocab -- summary )
dup dup vocab-summary-path vocab-file-contents
dup empty? [
drop vocab-name " vocabulary" append
] [
nip first
] if ;
M: vocab summary
[
dup vocab-summary %
" (" %
vocab-words assoc-size #
" words)" %
] "" make ;
M: vocab-link summary vocab-summary ;
: set-vocab-summary ( string vocab -- )
>r 1array r>
dup vocab-summary-path
set-vocab-file-contents ;
: vocab-tags-path ( vocab -- string )
vocab-dir "tags.txt" path+ ;
: vocab-tags ( vocab -- tags )
dup vocab-tags-path vocab-file-contents ;
: set-vocab-tags ( tags vocab -- )
dup vocab-tags-path set-vocab-file-contents ;
: add-vocab-tags ( tags vocab -- )
[ vocab-tags append prune ] keep set-vocab-tags ;
: vocab-authors-path ( vocab -- string )
vocab-dir "authors.txt" path+ ;
: vocab-authors ( vocab -- authors )
dup vocab-authors-path vocab-file-contents ;
: set-vocab-authors ( authors vocab -- )
dup vocab-authors-path set-vocab-file-contents ;
: subdirs ( dir -- dirs )
directory [ second ] subset keys natural-sort ;
: (all-child-vocabs) ( root name -- vocabs )
[ vocab-dir path+ ?resource-path subdirs ] keep
dup empty? [
drop
] [
swap [ "." swap 3append ] with map
] if ;
: vocabs-in-dir ( root name -- )
dupd (all-child-vocabs) [
2dup vocab-dir? [ 2dup swap >vocab-link , ] when
vocabs-in-dir
] with each ;
: all-vocabs ( -- assoc )
vocab-roots get [
dup [ "" vocabs-in-dir ] { } make
] { } map>assoc ;
MEMO: all-vocabs-seq ( -- seq )
all-vocabs values concat ;
: dangerous? ( name -- ? )
#! Hack
{
{ [ "cpu." ?head ] [ t ] }
{ [ "io.unix" ?head ] [ t ] }
{ [ "io.windows" ?head ] [ t ] }
{ [ "ui.x11" ?head ] [ t ] }
{ [ "ui.windows" ?head ] [ t ] }
{ [ "ui.cocoa" ?head ] [ t ] }
{ [ "cocoa" ?head ] [ t ] }
{ [ "core-foundation" ?head ] [ t ] }
{ [ "vocabs.loader.test" ?head ] [ t ] }
{ [ "editors." ?head ] [ t ] }
{ [ ".windows" ?tail ] [ t ] }
{ [ ".unix" ?tail ] [ t ] }
{ [ "unix." ?head ] [ t ] }
{ [ ".linux" ?tail ] [ t ] }
{ [ ".bsd" ?tail ] [ t ] }
{ [ ".macosx" ?tail ] [ t ] }
{ [ "windows." ?head ] [ t ] }
{ [ "cocoa" ?head ] [ t ] }
{ [ ".test" ?tail ] [ t ] }
{ [ "raptor" ?head ] [ t ] }
{ [ dup "tools.deploy.app" = ] [ t ] }
{ [ t ] [ f ] }
} cond nip ;
: filter-dangerous ( seq -- seq' )
[ vocab-name dangerous? not ] subset ;
: try-everything ( -- failures )
all-vocabs-seq
filter-dangerous
require-all ;
: load-everything ( -- )
try-everything load-failures. ;
: unrooted-child-vocabs ( prefix -- seq )
dup empty? [ CHAR: . add ] unless
vocabs
[ vocab-root not ] subset
[
vocab-name swap ?head CHAR: . rot member? not and
] with subset
[ vocab ] map ;
: all-child-vocabs ( prefix -- assoc )
vocab-roots get [
over dupd dupd (all-child-vocabs)
swap [ >vocab-link ] curry map
] { } map>assoc
f rot unrooted-child-vocabs 2array add ;
: load-children ( prefix -- )
all-child-vocabs values concat
filter-dangerous
require-all
load-failures. ;
: map>set ( seq quot -- )
map concat prune natural-sort ; inline
MEMO: all-tags ( -- seq )
all-vocabs-seq [ vocab-tags ] map>set ;
MEMO: all-authors ( -- seq )
all-vocabs-seq [ vocab-authors ] map>set ;
: reset-cache ( -- )
\ (vocab-file-contents) reset-memoized
\ all-vocabs-seq reset-memoized
\ all-authors reset-memoized
\ all-tags reset-memoized ;

View File

@ -8,7 +8,7 @@ namespaces parser prettyprint quotations tools.annotations
editors tools.profiler tools.test tools.time tools.walker
ui.commands ui.gadgets.editors ui.gestures ui.operations
ui.tools.deploy vocabs vocabs.loader words sequences
tools.browser classes compiler.units ;
tools.vocabs classes compiler.units ;
IN: ui.tools.operations
V{ } clone operations set-global
@ -84,11 +84,7 @@ UNION: definition word method-spec link vocab vocab-link ;
{ +secondary+ t }
} define-operation
[
class
{ link word vocab vocab-link vocab-tag vocab-author }
memq?
] \ com-follow H{
[ topic? ] \ com-follow H{
{ +keyboard+ T{ key-down f { C+ } "H" } }
{ +primary+ t }
} define-operation

View File

@ -7,7 +7,7 @@ source-files definitions strings tools.completion tools.crossref
tuples ui.commands ui.gadgets ui.gadgets.editors
ui.gadgets.lists ui.gadgets.scrollers ui.gadgets.tracks
ui.gestures ui.operations vocabs words vocabs.loader
tools.browser unicode.case calendar ui ;
tools.vocabs unicode.case calendar ui ;
IN: ui.tools.search
TUPLE: live-search field list ;