basis/vocabs/prettyprint/prettyprint.factor

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays assocs colors colors.constants fry io
   4 io.styles kernel make math.order namespaces parser
   5 prettyprint.backend prettyprint.sections prettyprint.stylesheet
   6 sequences sets sorting vocabs vocabs.parser ;
   7 IN: vocabs.prettyprint
   8
   9 : pprint-vocab ( vocab -- )
  10     [ vocab-name ] [ vocab vocab-style ] bi styled-text ;
  11
  12 : pprint-in ( vocab -- )
  13     [ \ IN: pprint-word pprint-vocab ] with-pprint ;
  14
  15 <PRIVATE
  16
  17 : sort-vocabs ( seq -- seq' )
  18     [ vocab-name ] sort-with ;
  19
  20 : pprint-using ( seq -- )
  21     [ "syntax" vocab = not ] filter
  22     sort-vocabs [
  23         \ USING: pprint-word
  24         [ pprint-vocab ] each
  25         \ ; pprint-word
  26     ] with-pprint ;
  27
  28 GENERIC: pprint-qualified ( qualified -- )
  29
  30 M: qualified pprint-qualified ( qualified -- )
  31     [
  32         dup [ vocab>> vocab-name ] [ prefix>> ] bi = [
  33             \ QUALIFIED: pprint-word
  34             vocab>> pprint-vocab
  35         ] [
  36             \ QUALIFIED-WITH: pprint-word
  37             [ vocab>> pprint-vocab ] [ prefix>> text ] bi
  38         ] if
  39     ] with-pprint ;
  40
  41 M: from pprint-qualified ( from -- )
  42     [
  43         \ FROM: pprint-word
  44         [ vocab>> pprint-vocab "=>" text ]
  45         [ names>> [ text ] each ] bi
  46         \ ; pprint-word
  47     ] with-pprint ;
  48
  49 M: exclude pprint-qualified ( exclude -- )
  50     [
  51         \ EXCLUDE: pprint-word
  52         [ vocab>> pprint-vocab "=>" text ]
  53         [ names>> [ text ] each ] bi
  54         \ ; pprint-word
  55     ] with-pprint ;
  56
  57 M: rename pprint-qualified ( rename -- )
  58     [
  59         \ RENAME: pprint-word
  60         [ word>> text ]
  61         [ vocab>> text "=>" text ]
  62         [ words>> >alist first first text ]
  63         tri
  64     ] with-pprint ;
  65
  66 PRIVATE>
  67
  68 : (pprint-manifest ( manifest -- quots )
  69     [
  70         [ search-vocabs>> [ '[ _ pprint-using ] , ] unless-empty ]
  71         [ qualified-vocabs>> [ extra-words? not ] filter [ '[ _ pprint-qualified ] , ] each ]
  72         [ current-vocab>> [ '[ _ pprint-in ] , ] when* ]
  73         tri
  74     ] { } make ;
  75
  76 : pprint-manifest) ( quots -- )
  77     [ nl ] [ call( -- ) ] interleave ;
  78
  79 : pprint-manifest ( manifest -- )
  80     (pprint-manifest pprint-manifest) ;
  81
  82 [
  83     nl
  84     { { font-style bold } { font-name "sans-serif" } } [
  85         "Restarts were invoked adding vocabularies to the search path." print
  86         "To avoid doing this in the future, add the following forms" print
  87         "at the top of the source file:" print nl
  88     ] with-style
  89     { { page-color COLOR: FactorLightTan } }
  90     [ manifest get pprint-manifest ] with-nesting
  91     nl nl
  92 ] print-use-hook set-global