extra/fuel/xref/xref.factor

   1 ! Copyright (C) 2009 Jose Antonio Ortega Ruiz.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3
   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 ;
   7
   8 IN: fuel.xref
   9
  10 <PRIVATE
  11
  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 ;
  15
  16 : get-loc ( object -- loc ) normalize-loc 2array ;
  17
  18 : word>xref ( word -- xref )
  19     [ name>> ] [ vocabulary>> ] [ where normalize-loc ] tri 4array ;
  20
  21 : vocab>xref ( vocab -- xref )
  22     dup dup >vocab-link where normalize-loc 4array ;
  23
  24 : sort-xrefs ( seq -- seq' )
  25     [ [ first ] dip first <=> ] sort ; inline
  26
  27 : format-xrefs ( seq -- seq' )
  28     [ word? ] filter [ word>xref ] map ; inline
  29
  30 : filter-prefix ( seq prefix -- seq )
  31     [ drop-prefix nip length 0 = ] curry filter prune ; inline
  32
  33 MEMO: (vocab-words) ( name -- seq )
  34     >vocab-link words [ name>> ] map ;
  35
  36 : current-words ( -- seq )
  37     use get [ keys ] map concat ; inline
  38
  39 : vocabs-words ( names -- seq )
  40     prune [ (vocab-words) ] map concat ; inline
  41
  42 PRIVATE>
  43
  44 : callers-xref ( word -- seq ) usage format-xrefs sort-xrefs ;
  45
  46 : callees-xref ( word -- seq ) uses format-xrefs sort-xrefs ;
  47
  48 : apropos-xref ( str -- seq ) words-matching format-xrefs ;
  49
  50 : vocab-xref ( vocab -- seq ) words format-xrefs ;
  51
  52 : word-location ( word -- loc ) where get-loc ;
  53
  54 : vocab-location ( vocab -- loc ) >vocab-link where get-loc ;
  55
  56 : vocab-uses-xref ( vocab -- seq ) vocab-uses [ vocab>xref ] map ;
  57
  58 : vocab-usage-xref ( vocab -- seq ) vocab-usage [ vocab>xref ] map ;
  59
  60 : doc-location ( word -- loc ) props>> "help-loc" swap at get-loc ;
  61
  62 : article-location ( name -- loc ) article loc>> get-loc ;
  63
  64 : get-vocabs ( -- seq ) all-vocabs-seq [ vocab-name ] map ;
  65
  66 : get-vocabs/prefix ( prefix -- seq ) get-vocabs swap filter-prefix ;
  67
  68 : get-vocabs-words/prefix ( prefix names/f -- seq )
  69     [ vocabs-words ] [ current-words ] if* natural-sort swap filter-prefix ;