basis/xmode/highlight/highlight.factor

   1 ! Copyright (C) 2011 John Benediktsson
   2 ! See http://factorcode.org/license.txt for BSD license
   3
   4 USING: accessors assocs colors.hex io io.encodings.utf8 io.files
   5 io.pathnames io.streams.string io.styles kernel locals see
   6 sequences splitting strings vocabs vocabs.loader words
   7 xmode.catalog xmode.marker ;
   8
   9 IN: xmode.highlight
  10
  11 <PRIVATE
  12
  13 CONSTANT: STYLES H{
  14     { "NULL"     H{ { foreground HEXCOLOR: 000000 } } }
  15     { "COMMENT1" H{ { foreground HEXCOLOR: cc0000 } } }
  16     { "COMMENT2" H{ { foreground HEXCOLOR: ff8400 } } }
  17     { "COMMENT3" H{ { foreground HEXCOLOR: 6600cc } } }
  18     { "COMMENT4" H{ { foreground HEXCOLOR: cc6600 } } }
  19     { "DIGIT"    H{ { foreground HEXCOLOR: ff0000 } } }
  20     { "FUNCTION" H{ { foreground HEXCOLOR: 9966ff } } }
  21     { "INVALID"  H{ { background HEXCOLOR: ffffcc }
  22                     { foreground HEXCOLOR: ff0066 } } }
  23     { "KEYWORD1" H{ { foreground HEXCOLOR: 006699 }
  24                     { font-style bold } } }
  25     { "KEYWORD2" H{ { foreground HEXCOLOR: 009966 }
  26                     { font-style bold } } }
  27     { "KEYWORD3" H{ { foreground HEXCOLOR: 0099ff }
  28                     { font-style bold } } }
  29     { "KEYWORD4" H{ { foreground HEXCOLOR: 66ccff }
  30                     { font-style bold } } }
  31     { "LABEL"    H{ { foreground HEXCOLOR: 02b902 } } }
  32     { "LITERAL1" H{ { foreground HEXCOLOR: ff00cc } } }
  33     { "LITERAL2" H{ { foreground HEXCOLOR: cc00cc } } }
  34     { "LITERAL3" H{ { foreground HEXCOLOR: 9900cc } } }
  35     { "LITERAL4" H{ { foreground HEXCOLOR: 6600cc } } }
  36     { "MARKUP"   H{ { foreground HEXCOLOR: 0000ff } } }
  37     { "OPERATOR" H{ { foreground HEXCOLOR: 000000 }
  38                     { font-style bold } } }
  39 }
  40
  41 CONSTANT: BASE H{
  42     { font-name "monospace" }
  43 }
  44
  45 PRIVATE>
  46
  47 : highlight-tokens ( tokens -- )
  48     [
  49         [ str>> ] [ id>> ] bi
  50         [ name>> STYLES at BASE assoc-union ] [ BASE ] if*
  51         format
  52     ] each nl ;
  53
  54 : highlight-lines ( lines mode -- )
  55     [ f ] 2dip load-mode [
  56         tokenize-line highlight-tokens
  57     ] curry each drop ;
  58
  59 GENERIC: highlight. ( obj -- )
  60
  61 M:: string highlight. ( path -- )
  62     path utf8 file-lines [
  63         path over first find-mode highlight-lines
  64     ] unless-empty ;
  65
  66 M: pathname highlight.
  67     string>> highlight. ;
  68
  69 M: vocab highlight.
  70     vocab-source-path highlight. ;
  71
  72 M: word highlight.
  73     [ see ] with-string-writer string-lines
  74     "factor" highlight-lines ;