1 ! Copyright (C) 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays assocs colors fry io
4 io.styles kernel literals make math.order namespaces parser
5 prettyprint.backend prettyprint.sections prettyprint.stylesheet
6 sequences sets sorting ui.gadgets.theme vocabs vocabs.parser ;
7 FROM: io.styles => inset ;
10 : pprint-vocab ( vocab -- )
11 [ vocab-name ] [ lookup-vocab vocab-style ] bi styled-text ;
13 : pprint-in ( vocab -- )
14 [ \ IN: pprint-word pprint-vocab ] with-pprint ;
18 : sort-vocabs ( seq -- seq' )
19 [ vocab-name ] sort-with ;
21 : pprint-using ( seq -- )
22 "syntax" lookup-vocab '[ _ = ] reject
29 GENERIC: pprint-qualified ( qualified -- )
31 M: qualified pprint-qualified ( qualified -- )
33 dup [ vocab>> vocab-name ] [ prefix>> ] bi = [
34 \ QUALIFIED: pprint-word
37 \ QUALIFIED-WITH: pprint-word
38 [ vocab>> pprint-vocab ] [ prefix>> text ] bi
42 M: from pprint-qualified ( from -- )
45 [ vocab>> pprint-vocab "=>" text ]
46 [ names>> [ text ] each ] bi
50 M: exclude pprint-qualified ( exclude -- )
52 \ EXCLUDE: pprint-word
53 [ vocab>> pprint-vocab "=>" text ]
54 [ names>> [ text ] each ] bi
58 M: rename pprint-qualified ( rename -- )
62 [ vocab>> text "=>" text ]
63 [ words>> >alist first first text ]
67 : filter-interesting ( seq -- seq' )
68 [ [ vocab? ] [ extra-words? ] bi or ] reject ;
72 : (pprint-manifest ( manifest -- quots )
74 [ search-vocabs>> [ '[ _ pprint-using ] , ] unless-empty ]
75 [ qualified-vocabs>> filter-interesting [ '[ _ pprint-qualified ] , ] each ]
76 [ current-vocab>> [ '[ _ pprint-in ] , ] when* ]
80 : pprint-manifest) ( quots -- )
81 [ nl ] [ call( -- ) ] interleave ;
83 : pprint-manifest ( manifest -- )
84 (pprint-manifest pprint-manifest) ;
88 { { font-style bold } { font-name "sans-serif" } } [
89 "Restarts were invoked adding vocabularies to the search path." print
90 "To avoid doing this in the future, add the following forms" print
91 "at the top of the source file:" print nl
94 { page-color $ vocab-background-color }
95 { border-color $ vocab-border-color }
97 } [ manifest get pprint-manifest ] with-nesting
99 ] print-use-hook set-global