mirror of
https://github.com/janet-lang/janet
synced 2025-01-08 22:50:27 +00:00
More work on installation and moving files around.
Move all installed libraries into auxlib. Move all installed executable scripts into auxbin.
This commit is contained in:
Calvin Rose
parent
bea6dbbf3d
commit
3d76d988c3
6
Makefile
6
Makefile
@ -299,10 +299,8 @@ install: $(JANET_TARGET) $(PKG_CONFIG_PATH)/janet.pc
|
||||
cp $(JANET_STATIC_LIBRARY) $(LIBDIR)/libjanet.a
|
||||
ln -sf $(SONAME) $(LIBDIR)/libjanet.so
|
||||
ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(LIBDIR)/$(SONAME)
|
||||
cp tools/cook.janet $(JANET_PATH)
|
||||
cp tools/jpm $(BINDIR)/jpm
|
||||
cp tools/highlight.janet $(JANET_PATH)
|
||||
cp tools/bars.janet $(JANET_PATH)
|
||||
cp -rf auxlib/* $(JANET_PATH)
|
||||
cp -rf auxbin/* $(BINDIR)
|
||||
mkdir -p $(MANPATH)
|
||||
cp janet.1 $(MANPATH)
|
||||
-ldconfig $(LIBDIR)
|
||||
|
||||
@ -21,7 +21,7 @@ Keys are:
|
||||
--headerpath : The directory containing janet headers. Defaults to $JANET_HEADERPATH or module/*headerpath*
|
||||
--binpath : The directory to install binaries and scripts. Defaults to $JANET_BINPATH.
|
||||
--optimize : Optimization level for natives. Defaults to $OPTIMIZE or 2.
|
||||
--compiler : C compiler to use for natives. Defaults to $CC or cc.
|
||||
--compiler : C compiler to use for natives. Defaults to $COMPILER or cc.
|
||||
--linker : C linker to use for linking natives. Defaults to $LINKER or cc.
|
||||
--cflags : Extra compiler flags for native modules. Defaults to $CFLAGS if set.
|
||||
--lflags : Extra linker flags for native modules. Defaults to $LFLAGS if set.
|
||||
@ -118,16 +118,30 @@
|
||||
(def JANET_MODPATH (or (os/getenv "JANET_MODPATH") module/*syspath*))
|
||||
(def JANET_HEADERPATH (or (os/getenv "JANET_HEADERPATH") module/*headerpath*))
|
||||
(def JANET_BINPATH (or (os/getenv "JANET_BINPATH") (unless is-win "/usr/local/bin")))
|
||||
|
||||
|
||||
# Compilation settings
|
||||
(def OPTIMIZE (or (os/getenv "OPTIMIZE") 2))
|
||||
(def CC (or (os/getenv "CC") (if is-win "cl" "cc")))
|
||||
(def LD (or (os/getenv "LINKER") (if is-win "link" CC)))
|
||||
(def LDFLAGS (or (os/getenv "LFLAGS")
|
||||
(if is-win " /nologo"
|
||||
(string " -shared"
|
||||
(if is-mac " -undefined dynamic_lookup" "")))))
|
||||
(def CFLAGS (or (os/getenv "CFLAGS") (if is-win "" " -std=c99 -Wall -Wextra -fpic")))
|
||||
(def- OPTIMIZE (or (os/getenv "OPTIMIZE") 2))
|
||||
(def- COMPILER (or (os/getenv "COMPILER") (if is-win "cl" "cc")))
|
||||
(def- LINKER (or (os/getenv "LINKER") (if is-win "link" COMPILER)))
|
||||
(def- LFLAGS
|
||||
(if-let [lflags (os/getenv "LFLAGS")]
|
||||
(string/split " " lflags)
|
||||
(if is-win ["/nologo" "/DLL"]
|
||||
(if is-mac
|
||||
["-shared" "-undefined" "dynamic_lookup"]
|
||||
["-shared"]))))
|
||||
(def- CFLAGS
|
||||
(if-let [cflags (os/getenv "CFLAGS")]
|
||||
(string/split " " cflags)
|
||||
(if is-win
|
||||
["/nologo"]
|
||||
["-std=c99" "-Wall" "-Wextra" "-fpic"])))
|
||||
|
||||
# Some defaults
|
||||
(def default-cflags CFLAGS)
|
||||
(def default-lflags LFLAGS)
|
||||
(def default-cc COMPILER)
|
||||
(def default-ld LINKER)
|
||||
|
||||
(defn- opt
|
||||
"Get an option, allowing overrides via dynamic bindings AND some
|
||||
@ -145,9 +159,7 @@
|
||||
(defn shell
|
||||
"Do a shell command"
|
||||
[& args]
|
||||
(def cmd (string/join args))
|
||||
(print cmd)
|
||||
(def res (os/shell cmd))
|
||||
(def res (os/execute args :p))
|
||||
(unless (zero? res)
|
||||
(error (string "command exited with status " res))))
|
||||
|
||||
@ -164,7 +176,10 @@
|
||||
(defn copy
|
||||
"Copy a file or directory recursively from one location to another."
|
||||
[src dest]
|
||||
(shell (if is-win "xcopy " "cp -rf ") `"` src `" "` dest (if is-win `" /y /e` `"`)))
|
||||
(print "copying " src " to " dest "...")
|
||||
(if is-win
|
||||
(shell "xcopy" src dest "/y" "/e")
|
||||
(shell "cp" "-rf" src dest)))
|
||||
|
||||
#
|
||||
# C Compilation
|
||||
@ -223,41 +238,39 @@
|
||||
(defn- getcflags
|
||||
"Generate the c flags from the input options."
|
||||
[opts]
|
||||
(string (opt opts :cflags CFLAGS)
|
||||
(if is-win " /I\"" " \"-I")
|
||||
(opt opts :headerpath JANET_HEADERPATH)
|
||||
`"`
|
||||
(if is-win " /O\"" " \"-O")
|
||||
(opt opts :optimize OPTIMIZE)
|
||||
`"`))
|
||||
@[;(opt opts :cflags CFLAGS)
|
||||
(string (if is-win "/I" "-I") (opt opts :headerpath JANET_HEADERPATH))
|
||||
(string (if is-win "/O" "-O") (opt opts :optimize OPTIMIZE))])
|
||||
|
||||
(defn- compile-c
|
||||
"Compile a C file into an object file."
|
||||
[opts src dest]
|
||||
(def cc (opt opts :compiler CC))
|
||||
(def cc (opt opts :compiler COMPILER))
|
||||
(def cflags (getcflags opts))
|
||||
(def defines (interpose " " (make-defines (opt opts :defines {}))))
|
||||
(rule dest [src]
|
||||
(print "compiling " dest "...")
|
||||
(if is-win
|
||||
(shell cc " " ;defines " /nologo /c " cflags " /Fo\"" dest `" "` src `"`)
|
||||
(shell cc " -c '" src "' " ;defines " " cflags " -o '" dest `'`))))
|
||||
(shell cc ;defines "/c" ;cflags (string "/Fo" dest) src)
|
||||
(shell cc "-c" src ;defines ;cflags "-o" dest))))
|
||||
|
||||
(defn- link-c
|
||||
"Link a number of object files together."
|
||||
[opts target & objects]
|
||||
(def ld (opt opts :linker LD))
|
||||
(def ld (opt opts :linker LINKER))
|
||||
(def cflags (getcflags opts))
|
||||
(def lflags (opt opts :lflags LDFLAGS))
|
||||
(def olist (string/join objects `" "`))
|
||||
(def lflags (opt opts :lflags LFLAGS))
|
||||
(rule target objects
|
||||
(print "linking " target "...")
|
||||
(if is-win
|
||||
(shell ld " " lflags " /DLL /OUT:" target ` "` olist `" "` (opt opts :headerpath JANET_HEADERPATH) `"\\janet.lib`)
|
||||
(shell ld " " cflags ` -o "` target `" "` olist `" ` lflags))))
|
||||
(shell ld ;lflags (string "/OUT:" target) ;objects (string (opt opts :headerpath JANET_HEADERPATH) `\\janet.lib`))
|
||||
(shell ld ;cflags `-o` target ;objects ;lflags))))
|
||||
|
||||
(defn- create-buffer-c
|
||||
"Inline raw byte file as a c file."
|
||||
[source dest name]
|
||||
(rule dest [source]
|
||||
(print "creating embedded source " dest "...")
|
||||
(def f (file/open source :r))
|
||||
(if (not f) (error (string "file " f " not found")))
|
||||
(def out (file/open dest :w))
|
||||
@ -323,13 +336,30 @@
|
||||
(each s sources
|
||||
(install-rule s path)))
|
||||
|
||||
(defn declare-binscript
|
||||
"Declare a janet file to be installed as an executable script."
|
||||
(defn declare-bin
|
||||
"Declare a generic file to be installed as an executable."
|
||||
[&keys opts]
|
||||
(def main (opts :main))
|
||||
(def binpath (opt opts :binpath JANET_BINPATH))
|
||||
(install-rule main binpath))
|
||||
|
||||
(defn declare-binscript
|
||||
"Declare a janet file to be installed as an executable script. Creates
|
||||
a shim on windows."
|
||||
[&keys opts]
|
||||
(def main (opts :main))
|
||||
(def binpath (opt opts :binpath JANET_BINPATH))
|
||||
(install-rule main binpath)
|
||||
# Create a dud batch file when on windows.
|
||||
(when is-win
|
||||
(def name (last (string/split sep src)))
|
||||
(def bat (string "@echo off\r\njanet %~dp0\\" name "%*"))
|
||||
(def newname (string binpath sep name ".bat"))
|
||||
(add-body "install"
|
||||
(spit newname bat))
|
||||
(add-body "uninstall"
|
||||
(os/rm newname))))
|
||||
|
||||
(defn declare-archive
|
||||
"Build a janet archive. This is a file that bundles together many janet
|
||||
scripts into a janet image. This file can the be moved to any machine with
|
||||
@ -128,13 +128,15 @@ copy build\janet.c dist\janet.c
|
||||
copy janet.exe dist\janet.exe
|
||||
copy LICENSE dist\LICENSE
|
||||
copy README.md dist\README.md
|
||||
|
||||
copy janet.lib dist\janet.lib
|
||||
copy janet.exp dist\janet.exp
|
||||
copy src\include\janet.h dist\janet.h
|
||||
copy src\include\janetconf.h dist\janetconf.h
|
||||
copy tools\cook.janet dist\cook.janet
|
||||
copy tools\highlight.janet dist\highlight.janet
|
||||
copy tools\jpm dist\jpm
|
||||
|
||||
copy auxlib\cook.janet dist\cook.janet
|
||||
|
||||
copy auxbin\jpm dist\jpm
|
||||
copy tools\jpm.bat dist\jpm.bat
|
||||
exit /b 0
|
||||
|
||||
|
||||
@ -49,7 +49,7 @@ BrandingText "The Janet Programming Language"
|
||||
|
||||
# Need to set a language.
|
||||
!insertmacro MUI_LANGUAGE "English"
|
||||
|
||||
|
||||
function .onInit
|
||||
!insertmacro MULTIUSER_INIT
|
||||
functionEnd
|
||||
@ -58,28 +58,38 @@ section "Janet" BfWSection
|
||||
createDirectory "$INSTDIR\Library"
|
||||
createDirectory "$INSTDIR\C"
|
||||
createDirectory "$INSTDIR\bin"
|
||||
createDirectory "$INSTDIR\docs"
|
||||
setOutPath "$INSTDIR"
|
||||
|
||||
|
||||
# Bin files
|
||||
file /oname=bin\janet.exe dist\janet.exe
|
||||
file /oname=logo.ico assets\icon.ico
|
||||
|
||||
file /oname=Library\cook.janet dist\cook.janet
|
||||
|
||||
file /oname=bin\jpm.janet auxbin\jpm
|
||||
file /oname=bin\jpm.bat auxbin\jpm.bat
|
||||
|
||||
# Modules
|
||||
file /oname=Library\cook.janet auxlib\cook.janet
|
||||
|
||||
# C headers
|
||||
file /oname=C\janet.h dist\janet.h
|
||||
file /oname=C\janetconf.h dist\janetconf.h
|
||||
file /oname=C\janet.lib dist\janet.lib
|
||||
file /oname=C\janet.exp dist\janet.exp
|
||||
file /oname=C\janet.c dist\janet.c
|
||||
|
||||
file /oname=bin\jpm.janet dist\jpm
|
||||
file /oname=bin\jpm.bat dist\jpm.bat
|
||||
|
||||
|
||||
# Documentation
|
||||
file /oname=docs/docs.html dist/doc.html
|
||||
|
||||
# Other
|
||||
file README.md
|
||||
file LICENSE
|
||||
|
||||
# Uninstaller - See function un.onInit and section "uninstall" for configuration
|
||||
writeUninstaller "$INSTDIR\uninstall.exe"
|
||||
|
||||
|
||||
# Start Menu
|
||||
createShortCut "$SMPROGRAMS\Janet.lnk" "$INSTDIR\bin\janet.exe" "" "$INSTDIR\logo.ico"
|
||||
|
||||
|
||||
# HKLM (all users) vs HKCU (current user)
|
||||
WriteRegExpandStr HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment" JANET_PATH "$INSTDIR\Library"
|
||||
WriteRegExpandStr HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment" JANET_HEADERPATH "$INSTDIR\C"
|
||||
@ -90,11 +100,11 @@ section "Janet" BfWSection
|
||||
WriteRegExpandStr HKCU "Environment" JANET_BINPATH "$INSTDIR\bin"
|
||||
|
||||
SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=5000
|
||||
|
||||
|
||||
# Update path
|
||||
${EnvVarUpdate} $0 "PATH" "A" "HKCU" "$INSTDIR\bin" ; Append
|
||||
${EnvVarUpdate} $0 "PATH" "A" "HKLM" "$INSTDIR\bin" ; Append
|
||||
|
||||
${EnvVarUpdate} $0 "PATH" "A" "HKLM" "$INSTDIR\bin" ; Append
|
||||
|
||||
# Registry information for add/remove programs
|
||||
WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "DisplayName" "Janet"
|
||||
WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "UninstallString" "$INSTDIR\uninstall.exe"
|
||||
@ -114,24 +124,27 @@ section "Janet" BfWSection
|
||||
# Set the INSTALLSIZE constant (!defined at the top of this script) so Add/Remove Programs can accurately report the size
|
||||
WriteRegDWORD HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "EstimatedSize" 1000
|
||||
sectionEnd
|
||||
|
||||
|
||||
# Uninstaller
|
||||
|
||||
|
||||
function un.onInit
|
||||
!insertmacro MULTIUSER_UNINIT
|
||||
functionEnd
|
||||
|
||||
|
||||
section "uninstall"
|
||||
|
||||
|
||||
# Remove Start Menu launcher
|
||||
delete "$SMPROGRAMS\Janet.lnk"
|
||||
|
||||
|
||||
# Remove files
|
||||
delete "$INSTDIR\logo.ico"
|
||||
delete "$INSTDIR\README.md"
|
||||
delete "$INSTDIR\LICENSE"
|
||||
rmdir /r "$INSTDIR\Library"
|
||||
rmdir /r "$INSTDIR\bin"
|
||||
rmdir /r "$INSTDIR\C"
|
||||
|
||||
rmdir /r "$INSTDIR\docs"
|
||||
|
||||
# Remove env vars
|
||||
|
||||
DeleteRegValue HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment" JANET_PATH
|
||||
@ -144,14 +157,14 @@ section "uninstall"
|
||||
|
||||
# Unset PATH
|
||||
${un.EnvVarUpdate} $0 "PATH" "R" "HKCU" "$INSTDIR\bin" ; Remove
|
||||
${un.EnvVarUpdate} $0 "PATH" "R" "HKLM" "$INSTDIR\bin" ; Remove
|
||||
|
||||
${un.EnvVarUpdate} $0 "PATH" "R" "HKLM" "$INSTDIR\bin" ; Remove
|
||||
|
||||
# make sure windows knows about the change
|
||||
SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=5000
|
||||
|
||||
|
||||
# Always delete uninstaller as the last action
|
||||
delete "$INSTDIR\uninstall.exe"
|
||||
|
||||
|
||||
# Remove uninstaller information from the registry
|
||||
DeleteRegKey HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet"
|
||||
sectionEnd
|
||||
|
||||
@ -130,7 +130,6 @@ janet_mainclient = executable('janet', core_src, core_image, init_gen, mainclien
|
||||
include_directories : incdir,
|
||||
dependencies : [m_dep, dl_dep],
|
||||
install : true)
|
||||
janet_jpm = install_data('tools/jpm', install_dir : 'bin')
|
||||
|
||||
# Documentation
|
||||
docs = custom_target('docs',
|
||||
@ -173,8 +172,10 @@ run_target('repl', command : [janet_mainclient])
|
||||
install_man('janet.1')
|
||||
install_headers('src/include/janet.h', 'src/include/janetconf.h', subdir: 'janet')
|
||||
janet_libs = [
|
||||
'tools/bars.janet',
|
||||
'tools/cook.janet',
|
||||
'tools/highlight.janet'
|
||||
'auxlib/cook.janet'
|
||||
]
|
||||
janet_binscripts = [
|
||||
'auxbin/jpm'
|
||||
]
|
||||
install_data(sources : janet_libs, install_dir : janet_path)
|
||||
install_data(sources : janet_binscripts, install_dir : 'bin')
|
||||
|
||||
@ -1088,6 +1088,12 @@
|
||||
[f & args]
|
||||
(file/write stdout (buffer/format @"" f ;args)))
|
||||
|
||||
(defn pp
|
||||
"Pretty print to stdout."
|
||||
[x]
|
||||
(print (buffer/format @"" (dyn :pretty-format "%p") x)))
|
||||
|
||||
|
||||
###
|
||||
###
|
||||
### Pattern Matching
|
||||
@ -1406,11 +1412,6 @@
|
||||
(set current (macex1 current)))
|
||||
current)
|
||||
|
||||
(defn pp
|
||||
"Pretty print to stdout."
|
||||
[x]
|
||||
(print (buffer/format @"" (dyn :pretty-format "%p") x)))
|
||||
|
||||
###
|
||||
###
|
||||
### Evaluation and Compilation
|
||||
|
||||
@ -1,55 +0,0 @@
|
||||
# A flexible templater for janet. Compiles
|
||||
# templates to janet functions that produce buffers.
|
||||
|
||||
(defn template
|
||||
"Compile a template string into a function"
|
||||
[source]
|
||||
|
||||
# State for compilation machine
|
||||
(def p (parser/new))
|
||||
(def forms @[])
|
||||
|
||||
(defn parse-chunk
|
||||
"Parse a string and push produced values to forms."
|
||||
[chunk]
|
||||
(parser/consume p chunk)
|
||||
(while (parser/has-more p)
|
||||
(array/push forms (parser/produce p)))
|
||||
(if (= :error (parser/status p))
|
||||
(error (parser/error p))))
|
||||
|
||||
(defn code-chunk
|
||||
"Parse all the forms in str and return them
|
||||
in a tuple prefixed with 'do."
|
||||
[str]
|
||||
(parse-chunk str)
|
||||
true)
|
||||
|
||||
(defn string-chunk
|
||||
"Insert string chunk into parser"
|
||||
[str]
|
||||
(parser/insert p str)
|
||||
(parse-chunk "")
|
||||
true)
|
||||
|
||||
# Run peg
|
||||
(def grammar
|
||||
~{:code-chunk (* "{%" (drop (cmt '(any (if-not "%}" 1)) ,code-chunk)) "%}")
|
||||
:main-chunk (drop (cmt '(any (if-not "{%" 1)) ,string-chunk))
|
||||
:main (any (+ :code-chunk :main-chunk (error "")))})
|
||||
(def parts (peg/match grammar source))
|
||||
|
||||
# Check errors in template and parser
|
||||
(unless parts (error "invalid template syntax"))
|
||||
(parse-chunk "\n")
|
||||
(case (parser/status p)
|
||||
:pending (error (string "unfinished parser state " (parser/state p)))
|
||||
:error (error (parser/error p)))
|
||||
|
||||
# Make ast from forms
|
||||
(def ast ~(fn [&opt params] (default params @{}) (,buffer ,;forms)))
|
||||
|
||||
(def ctor (compile ast (fiber/getenv (fiber/current)) source))
|
||||
(if-not (function? ctor)
|
||||
(error (string "could not compile template")))
|
||||
(ctor))
|
||||
@ -1,198 +0,0 @@
|
||||
# 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"
|
||||
```
|
||||
<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>
|
||||
```)
|
||||
|
||||
(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\"><code>"
|
||||
(0 (peg/match html-grammar source))
|
||||
"</code></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))
|
||||
Loading…
Reference in New Issue
Block a user