1 ! Copyright (C) 2009 Jose Antonio Ortega Ruiz.
2 ! See http://factorcode.org/license.txt for BSD license.
4 USING: accessors arrays assocs definitions help.topics io.pathnames
5 kernel math math.order memoize namespaces sequences sets sorting
6 tools.crossref tools.vocabs vocabs vocabs.parser words ;
12 : normalize-loc ( seq -- path line )
13 [ dup length 0 > [ first (normalize-path) ] [ drop f ] if ]
14 [ dup length 1 > [ second ] [ drop 1 ] if ] bi ;
16 : get-loc ( object -- loc ) normalize-loc 2array ;
18 : word>xref ( word -- xref )
19 [ name>> ] [ vocabulary>> ] [ where normalize-loc ] tri 4array ;
21 : vocab>xref ( vocab -- xref )
22 dup dup >vocab-link where normalize-loc 4array ;
24 : sort-xrefs ( seq -- seq' )
25 [ [ first ] dip first <=> ] sort ; inline
27 : format-xrefs ( seq -- seq' )
28 [ word? ] filter [ word>xref ] map ; inline
30 : filter-prefix ( seq prefix -- seq )
31 [ drop-prefix nip length 0 = ] curry filter prune ; inline
33 MEMO: (vocab-words) ( name -- seq )
34 >vocab-link words [ name>> ] map ;
36 : current-words ( -- seq )
37 use get [ keys ] map concat ; inline
39 : vocabs-words ( names -- seq )
40 prune [ (vocab-words) ] map concat ; inline
44 : callers-xref ( word -- seq ) usage format-xrefs sort-xrefs ;
46 : callees-xref ( word -- seq ) uses format-xrefs sort-xrefs ;
48 : apropos-xref ( str -- seq ) words-matching format-xrefs ;
50 : vocab-xref ( vocab -- seq ) words format-xrefs ;
52 : word-location ( word -- loc ) where get-loc ;
54 : vocab-location ( vocab -- loc ) >vocab-link where get-loc ;
56 : vocab-uses-xref ( vocab -- seq ) vocab-uses [ vocab>xref ] map ;
58 : vocab-usage-xref ( vocab -- seq ) vocab-usage [ vocab>xref ] map ;
60 : doc-location ( word -- loc ) props>> "help-loc" swap at get-loc ;
62 : article-location ( name -- loc ) article loc>> get-loc ;
64 : get-vocabs ( -- seq ) all-vocabs-seq [ vocab-name ] map ;
66 : get-vocabs/prefix ( prefix -- seq ) get-vocabs swap filter-prefix ;
68 : get-vocabs-words/prefix ( prefix names/f -- seq )
69 [ vocabs-words ] [ current-words ] if* natural-sort swap filter-prefix ;