core/tools/definitions.factor

   1 ! Copyright (C) 2006 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 IN: definitions
   4 USING: arrays errors generic hashtables io kernel math
   5 namespaces parser prettyprint prettyprint-internals sequences
   6 styles words help ;
   7
   8 : reload ( defspec -- )
   9     where first [ run-file ] when* ;
  10
  11 TUPLE: no-edit-hook ;
  12
  13 SYMBOL: edit-hook
  14
  15 : edit-location ( file line -- )
  16     >r ?resource-path r>
  17     edit-hook get [ call ] [ <no-edit-hook> throw ] if* ;
  18
  19 : edit-file ( file -- ) ?resource-path 0 edit-location ;
  20
  21 : edit ( defspec -- )
  22     where [
  23         first2 edit-location
  24     ] [
  25         "Not from a source file" throw
  26     ] if* ;
  27
  28 : write-vocab ( vocab -- )
  29     dup <vocab-link> presented associate styled-text ;
  30
  31 : in. ( word -- )
  32     word-vocabulary [
  33         H{ } clone <flow \ IN: pprint-word write-vocab block>
  34     ] when* ;
  35
  36 : comment. ( string -- )
  37     [ H{ { font-style italic } } styled-text ] when* ;
  38
  39 M: word synopsis*
  40     dup in.
  41     dup definer pprint-word
  42     dup pprint-word
  43     stack-effect [ effect>string comment. ] when* ;
  44
  45 M: method-spec synopsis*
  46     \ M: pprint-word [ pprint-word ] each ;
  47
  48 : synopsis ( defspec -- str )
  49     [ 0 margin set [ synopsis* ] with-pprint ] string-out ;
  50
  51 M: word summary synopsis ;
  52
  53 GENERIC: definition ( spec -- quot ? )
  54
  55 M: word definition drop f f ;
  56
  57 M: compound definition word-def t ;
  58
  59 M: generic definition "combination" word-prop t ;
  60
  61 M: method-spec definition first2 method method-def t ;
  62
  63 GENERIC: declarations. ( obj -- )
  64
  65 M: object declarations. drop ;
  66
  67 : declaration. ( word prop -- )
  68     tuck word-name word-prop [ pprint-word ] [ drop ] if ;
  69
  70 M: word declarations.
  71     {
  72         POSTPONE: parsing
  73         POSTPONE: inline
  74         POSTPONE: foldable
  75     } [ declaration. ] each-with ;
  76
  77 : pprint-; \ ; pprint-word ;
  78
  79 : (see) ( spec -- )
  80     [
  81         dup synopsis*
  82         dup definition [
  83             H{ } <defblock
  84             pprint-elements pprint-; declarations.
  85             block>
  86         ] [
  87             2drop
  88         ] if newline
  89     ] with-pprint ;
  90
  91 M: object see (see) ;
  92
  93 GENERIC: see-class* ( word -- )
  94
  95 M: union see-class*
  96     \ UNION: pprint-word
  97     dup pprint-word
  98     members pprint-elements pprint-; ;
  99
 100 M: predicate see-class*
 101     \ PREDICATE: pprint-word
 102     dup superclass pprint-word
 103     dup pprint-word
 104     H{ } <defblock
 105     "definition" word-prop pprint-elements
 106     pprint-; block> ;
 107
 108 M: tuple-class see-class*
 109     \ TUPLE: pprint-word
 110     dup pprint-word
 111     "slot-names" word-prop [ text ] each
 112     pprint-; ;
 113
 114 M: word see-class* drop ;
 115
 116 : see-class ( word -- )
 117     dup class? over builtin? not and [
 118         terpri [ see-class* ] with-pprint terpri
 119     ] [
 120         drop
 121     ] if ;
 122
 123 : see-subdefs ( word -- ) subdefs [ terpri see ] each ;
 124
 125 M: word see dup (see) dup see-class see-subdefs ;
 126
 127 M: link where link-name article article-loc ;
 128
 129 M: link synopsis*
 130     \ ARTICLE: pprint-word
 131     dup link-name pprint*
 132     article-title pprint* ;
 133
 134 M: link definition article-content t ;
 135
 136 M: link see (see) ;
 137
 138 PREDICATE: link word-link link-name word? ;
 139
 140 M: word-link where link-name "help-loc" word-prop ;
 141
 142 M: word-link synopsis*
 143     \ HELP: pprint-word
 144     link-name dup pprint-word
 145     stack-effect effect>string comment. ;
 146
 147 M: word-link definition
 148     link-name "help" word-prop t ;
 149
 150 M: link forget link-name remove-article ;
 151
 152 M: word-link forget f "help" set-word-prop ;