mirror of
https://github.com/janet-lang/janet
synced 2024-11-16 05:34:48 +00:00
95f2bbe0a0
janet source code and output html or terminal escaped code. Also made re entrant calls into the vm provide better error messages.
211 lines
5.6 KiB
Plaintext
211 lines
5.6 KiB
Plaintext
# 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
|
|
'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 and some
|
|
wraping constants."
|
|
[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\0")
|
|
:readermac (set "';~,")
|
|
:symchars (+ (range "09" "AZ" "az" "\x80\xFF") (set "$%&*+-./:<=>?@^_|"))
|
|
:token (some :symchars)
|
|
:hex (range "09" "af" "AF")
|
|
:escape (* "\\" (+ (set "ntr0\"\\e")
|
|
(* "h" :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"
|
|
```
|
|
<style type="text/css">
|
|
.j-main { color: white; background: #111; font-size: 1.4em; }
|
|
.j-number { color: #89dc76; }
|
|
.j-keyword { color: #ffd866; }
|
|
.j-string { color: #ab90f2; }
|
|
.j-coresym { color: #ff6188; }
|
|
.j-constant { color: #fc9867; }
|
|
.j-comment { color: darkgray; }
|
|
.j-line { color: gray; }
|
|
</style>
|
|
```)
|
|
|
|
(def- html-boiler-prefix
|
|
```<!DOCTYPE html>
|
|
<html>
|
|
<head>
|
|
<meta charset="UTF-8">
|
|
<title>title</title>
|
|
</head>
|
|
<body>
|
|
|
|
</body>
|
|
</html>
|
|
```)
|
|
|
|
(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 "<span class=\"" color "\">" escaped "</span>")
|
|
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 "<pre class=\"j-main\">"
|
|
(0 (peg/match html-grammar source))
|
|
"</pre>"))
|
|
|
|
(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
|
|
"<!doctype html><html><head><meta charset=\"UTF-8\">"
|
|
html-style
|
|
"<title>"
|
|
title
|
|
"</title></head>"
|
|
"<body class=\"j-main\"><pre>"
|
|
markup
|
|
"</pre></body></html>")
|
|
(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))
|