basis/tools/vocabs/browser/browser.factor

   1 ! Copyright (C) 2007, 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors kernel combinators vocabs vocabs.loader
   4 tools.vocabs io io.files io.styles help.markup help.stylesheet
   5 sequences assocs help.topics namespaces prettyprint words
   6 sorting definitions arrays summary sets generic ;
   7 IN: tools.vocabs.browser
   8
   9 : vocab-status-string ( vocab -- string )
  10     {
  11         { [ dup not ] [ drop "" ] }
  12         { [ dup vocab-main ] [ drop "[Runnable]" ] }
  13         [ drop "[Loaded]" ]
  14     } cond ;
  15
  16 : write-status ( vocab -- )
  17     vocab vocab-status-string write ;
  18
  19 : vocab. ( vocab -- )
  20     [
  21         dup [ write-status ] with-cell
  22         dup [ ($link) ] with-cell
  23         [ vocab-summary write ] with-cell
  24     ] with-row ;
  25
  26 : vocab-headings. ( -- )
  27     [
  28         [ "State" write ] with-cell
  29         [ "Vocabulary" write ] with-cell
  30         [ "Summary" write ] with-cell
  31     ] with-row ;
  32
  33 : root-heading. ( root -- )
  34     [ "Children from " prepend ] [ "Children" ] if*
  35     $heading ;
  36
  37 : vocabs. ( assoc -- )
  38     [
  39         [
  40             drop
  41         ] [
  42             swap root-heading.
  43             standard-table-style [
  44                 vocab-headings. [ vocab. ] each
  45             ] ($grid)
  46         ] if-empty
  47     ] assoc-each ;
  48
  49 : describe-summary ( vocab -- )
  50     vocab-summary [
  51         "Summary" $heading print-element
  52     ] when* ;
  53
  54 TUPLE: vocab-tag name ;
  55
  56 INSTANCE: vocab-tag topic
  57
  58 C: <vocab-tag> vocab-tag
  59
  60 : tags. ( seq -- ) [ <vocab-tag> ] map $links ;
  61
  62 : describe-tags ( vocab -- )
  63     vocab-tags f like [
  64         "Tags" $heading tags.
  65     ] when* ;
  66
  67 TUPLE: vocab-author name ;
  68
  69 INSTANCE: vocab-author topic
  70
  71 C: <vocab-author> vocab-author
  72
  73 : authors. ( seq -- ) [ <vocab-author> ] map $links ;
  74
  75 : describe-authors ( vocab -- )
  76     vocab-authors f like [
  77         "Authors" $heading authors.
  78     ] when* ;
  79
  80 : describe-help ( vocab -- )
  81     vocab-help [
  82         "Documentation" $heading ($link)
  83     ] when* ;
  84
  85 : describe-children ( vocab -- )
  86     vocab-name all-child-vocabs vocabs. ;
  87
  88 : describe-files ( vocab -- )
  89     vocab-files [ <pathname> ] map [
  90         "Files" $heading
  91         [
  92             snippet-style get [
  93                 code-style get [
  94                     stack.
  95                 ] with-nesting
  96             ] with-style
  97         ] ($block)
  98     ] when* ;
  99
 100 : describe-words ( vocab -- )
 101     words [
 102         "Words" $heading
 103         natural-sort $links
 104     ] unless-empty ;
 105
 106 : vocab-xref ( vocab quot -- vocabs )
 107     >r dup vocab-name swap words [ generic? not ] filter r> map
 108     [ [ word? ] filter [ vocabulary>> ] map ] gather natural-sort
 109     remove sift ; inline
 110
 111 : vocab-uses ( vocab -- vocabs ) [ uses ] vocab-xref ;
 112
 113 : vocab-usage ( vocab -- vocabs ) [ usage ] vocab-xref ;
 114
 115 : describe-uses ( vocab -- )
 116     vocab-uses [
 117         "Uses" $heading
 118         $vocab-links
 119     ] unless-empty ;
 120
 121 : describe-usage ( vocab -- )
 122     vocab-usage [
 123         "Used by" $heading
 124         $vocab-links
 125     ] unless-empty ;
 126
 127 : $describe-vocab ( element -- )
 128     first
 129     dup describe-children
 130     dup find-vocab-root [
 131         dup describe-summary
 132         dup describe-tags
 133         dup describe-authors
 134         dup describe-files
 135     ] when
 136     dup vocab [
 137         dup describe-help
 138         dup describe-words
 139         dup describe-uses
 140         dup describe-usage
 141     ] when drop ;
 142
 143 : keyed-vocabs ( str quot -- seq )
 144     all-vocabs [
 145         swap >r
 146         [ >r 2dup r> swap call member? ] filter
 147         r> swap
 148     ] assoc-map 2nip ; inline
 149
 150 : tagged ( tag -- assoc )
 151     [ vocab-tags ] keyed-vocabs ;
 152
 153 : authored ( author -- assoc )
 154     [ vocab-authors ] keyed-vocabs ;
 155
 156 : $tagged-vocabs ( element -- )
 157     first tagged vocabs. ;
 158
 159 : $authored-vocabs ( element -- )
 160     first authored vocabs. ;
 161
 162 : $tags ( element -- )
 163     drop "Tags" $heading all-tags tags. ;
 164
 165 : $authors ( element -- )
 166     drop "Authors" $heading all-authors authors. ;
 167
 168 INSTANCE: vocab topic
 169
 170 INSTANCE: vocab-link topic
 171
 172 M: vocab-spec article-title vocab-name " vocabulary" append ;
 173
 174 M: vocab-spec article-name vocab-name ;
 175
 176 M: vocab-spec article-content
 177     vocab-name \ $describe-vocab swap 2array ;
 178
 179 M: vocab-spec article-parent drop "vocab-index" ;
 180
 181 M: vocab-tag >link ;
 182
 183 M: vocab-tag article-title
 184     name>> "Vocabularies tagged ``" swap "''" 3append ;
 185
 186 M: vocab-tag article-name name>> ;
 187
 188 M: vocab-tag article-content
 189     \ $tagged-vocabs swap name>> 2array ;
 190
 191 M: vocab-tag article-parent drop "vocab-index" ;
 192
 193 M: vocab-tag summary article-title ;
 194
 195 M: vocab-author >link ;
 196
 197 M: vocab-author article-title
 198     name>> "Vocabularies by " prepend ;
 199
 200 M: vocab-author article-name name>> ;
 201
 202 M: vocab-author article-content
 203     \ $authored-vocabs swap name>> 2array ;
 204
 205 M: vocab-author article-parent drop "vocab-index" ;
 206
 207 M: vocab-author summary article-title ;