# Copyright (C) Calvin Rose 2019 # # Takes in a janet string and colorizes for multiple # output formats. # Constants for checking if symbols should be # highlighted. (def- core-env (table/getproto *env*)) (def- specials {'fn true 'var true 'do true 'while true 'def true 'splice true 'set true 'break true 'unquote true 'quasiquote true 'quote true 'if true}) (defn check-number [text] (and (scan-number text) text)) (defn- make-grammar "Creates the grammar based on the paint function, which colorizes fragments of text." [paint] (defn <-c "Peg rule for capturing and coloring a rule." [color what] ~(/ (<- ,what) ,(partial paint color))) (defn color-symbol "Color a symbol only if it is a core library binding or special." [text] (def sym (symbol text)) (def should-color (or (specials sym) (core-env sym))) (paint (if should-color :coresym :symbol) text)) ~{:ws (set " \t\r\f\n\v\0") :readermac (set "';~,") :symchars (+ (range "09" "AZ" "az" "\x80\xFF") (set "!$%&*+-./:@^_|")) :token (some :symchars) :hex (range "09" "af" "AF") :escape (* "\\" (+ (set "ntrvzf0\"\\e") (* "x" :hex :hex) (error (constant "bad hex escape")))) :comment ,(<-c :comment ~(* "#" (any (if-not (+ "\n" -1) 1)))) :symbol (/ ':token ,color-symbol) :keyword ,(<-c :keyword ~(* ":" (any :symchars))) :constant ,(<-c :constant ~(+ "true" "false" "nil")) :bytes (* "\"" (any (+ :escape (if-not "\"" 1))) "\"") :string ,(<-c :string :bytes) :buffer ,(<-c :string ~(* "@" :bytes)) :long-bytes {:delim (some "`") :open (capture :delim :n) :close (cmt (* (not (> -1 "`")) (-> :n) ':delim) ,=) :main (drop (* :open (any (if-not :close 1)) :close))} :long-string ,(<-c :string :long-bytes) :long-buffer ,(<-c :string ~(* "@" :long-bytes)) :number (/ (cmt ':token ,check-number) ,(partial paint :number)) :raw-value (+ :comment :constant :number :keyword :string :buffer :long-string :long-buffer :parray :barray :ptuple :btuple :struct :dict :symbol) :value (* (? '(some (+ :ws :readermac))) :raw-value '(any :ws)) :root (any :value) :root2 (any (* :value :value)) :ptuple (* '"(" :root (+ '")" (error ""))) :btuple (* '"[" :root (+ '"]" (error ""))) :struct (* '"{" :root2 (+ '"}" (error ""))) :parray (* '"@" :ptuple) :barray (* '"@" :btuple) :dict (* '"@" :struct) :main (+ (% :root) (error ""))}) # Terminal syntax highlighting (def- terminal-colors {:number 32 :keyword 33 :string 35 :coresym 31 :constant 34 :comment 36}) (defn- terminal-paint "Paint colors for ansi terminals" [what str] (def code (get terminal-colors what)) (if code (string "\e[" code "m" str "\e[0m") str)) # HTML syntax highlighting (def- html-colors {:number "j-number" :keyword "j-keyword" :string "j-string" :coresym "j-coresym" :constant "j-constant" :comment "j-comment" :line "j-line"}) (def- escapes {38 "&" 60 "<" 62 ">" 34 """ 39 "'" 47 "/"}) (def html-style "Style tag to add to a page to highlight janet code" ``` ```) (defn html-escape "Escape special characters for HTML encoding." [str] (def buf @"") (loop [byte :in str] (if-let [rep (get escapes byte)] (buffer/push-string buf rep) (buffer/push-byte buf byte))) buf) (defn- html-paint "Paint colors for HTML" [what str] (def color (get html-colors what)) (def escaped (html-escape str)) (if color (string "" escaped "") escaped)) # Create Pegs (def- terminal-grammar (peg/compile (make-grammar terminal-paint))) (def- html-grammar (peg/compile (make-grammar html-paint))) # API (defn ansi "Highlight janet source code ANSI Termianl escape colors." [source] (0 (peg/match terminal-grammar source))) (defn html "Highlight janet source code and output HTML." [source] (string "
"
          (0 (peg/match html-grammar source))
          "
")) (defn html-file "Highlight a janet file and print out a highlighted HTML version of the file. Must provide a default title when creating the file." [in-path out-path title &] (default title in-path) (def f (file/open in-path :r)) (def source (file/read f :all)) (file/close f) (def markup (0 (peg/match html-grammar source))) (def out (file/open out-path :w)) (file/write out "" html-style "" title "" "
"
              markup
              "
") (file/close out)) (defn ansi-file "Highlight a janet file and print the highlighted output to stdout." [in-path] (def f (file/open in-path :r)) (def source (file/read f :all)) (file/close f) (def markup (0 (peg/match terminal-grammar source))) (print markup))