extra/fuel/xref/xref.factor

   1 ! Copyright (C) 2009 Jose Antonio Ortega Ruiz.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3
   4 USING: accessors arrays assocs definitions help.topics
   5 io.pathnames kernel memoize namespaces sequences sets sorting
   6 tools.completion tools.crossref vocabs vocabs.hierarchy
   7 vocabs.parser words ;
   8
   9 IN: fuel.xref
  10
  11 <PRIVATE
  12
  13 : normalize-loc ( pair/f -- path line )
  14     [ first2 [ absolute-path ] dip ] [ f f ] if* ;
  15
  16 : get-loc ( pair/f -- 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 : format-xrefs ( seq -- seq' )
  25     [ word? ] filter [ word>xref ] map ;
  26
  27 : group-xrefs ( xrefs -- xrefs' )
  28     sort [ second ] collect-by
  29     ! Change key from 'name' to { name path }
  30     [ [ [ third ] map-find drop 2array ] keep ] assoc-map
  31     >alist sort ;
  32
  33 : filter-prefix ( seq prefix -- seq )
  34     [ drop-prefix nip empty? ] curry filter members ;
  35
  36 MEMO: (vocab-words) ( name -- seq )
  37     >vocab-link vocab-words [ name>> ] map ;
  38
  39 : current-words ( -- seq )
  40     manifest get
  41     [ search-vocabs>> ] [ qualified-vocabs>> ] bi [ [ words>> ] map ] bi@
  42     append H{ } [ assoc-union ] reduce keys ;
  43
  44 : vocabs-words ( names -- seq )
  45     members [ (vocab-words) ] map concat ;
  46
  47 PRIVATE>
  48
  49 : callers-xref ( word -- seq ) usage format-xrefs group-xrefs ;
  50
  51 : callees-xref ( word -- seq ) uses format-xrefs group-xrefs ;
  52
  53 : apropos-xref ( str -- seq ) words-matching keys format-xrefs group-xrefs ;
  54
  55 : vocab-xref ( vocab -- seq )
  56     dup ".private" append [ vocab-words ] bi@ append
  57     format-xrefs group-xrefs ;
  58
  59 : word-location ( word -- loc ) where get-loc ;
  60
  61 : vocab-location ( vocab -- loc ) >vocab-link where get-loc ;
  62
  63 : vocab-uses-xref ( vocab -- seq ) vocab-uses [ vocab>xref ] map ;
  64
  65 : vocab-usage-xref ( vocab -- seq ) vocab-usage [ vocab>xref ] map ;
  66
  67 : doc-location ( word -- loc ) props>> "help-loc" of get-loc ;
  68
  69 : article-location ( name -- loc ) lookup-article loc>> get-loc ;
  70
  71 : get-vocabs/prefix ( prefix -- seq ) all-disk-vocab-names swap filter-prefix ;
  72
  73 : get-vocabs-words/prefix ( prefix names/f -- seq )
  74     [ vocabs-words ] [ current-words ] if* sort swap filter-prefix ;