start basic colorer

dev-srcloc
Matthew Butterick 8 years ago
parent 726bca2542
commit bfd3690eca

@ -0,0 +1,48 @@
#lang br
(require brag/support syntax-color/racket-lexer racket/contract
basic-demo/tokenizer sugar/coerce)
;(values lexeme 'parenthesis '|(| (pos lexeme-start) (pos lexeme-end))
(define (color-basic ip)
(define postok ((tokenize ip)))
(define tok-or-str (position-token-token postok))
(define type (if (string? tok-or-str)
'string
(token-struct-type tok-or-str)))
(define val (if (string? tok-or-str)
tok-or-str
(->string (or (token-struct-val tok-or-str) ""))))
(values val
(caseq type
[(WHITE) 'white-space]
[(COMMENT) 'comment]
[(NUMBER) 'constant]
[(STRING) 'string]
[else 'no-color])
#f
(position-offset (position-token-start-pos postok))
(position-offset (position-token-end-pos postok))))
(provide
(contract-out
[color-basic
(input-port? . -> . (values
(or/c string? eof-object?)
symbol?
(or/c symbol? #f)
(or/c exact-positive-integer? #f)
(or/c exact-positive-integer? #f)))]))
(module+ main
(define p (open-input-string #<<HERE
10 rem foo
20 rem foo
30 let x = 42
HERE
))
(color-basic p)
(color-basic p)
(color-basic p))

@ -1,7 +1,7 @@
#lang br/quicklang
(require "parser.rkt" "tokenizer.rkt")
(module+ reader (provide read-syntax))
(module+ reader (provide read-syntax get-info))
(define (read-syntax path port)
(define-values (line col pos) (port-next-location port))
@ -11,4 +11,16 @@
(define parse-tree (parse path (tokenize port+newline)))
(strip-bindings
#`(module basic-mod basic-demo/expander
#,parse-tree)))
#,parse-tree)))
(define (get-info port mod line col pos)
(define (handle-query key default)
(case key
[(color-lexer)
(dynamic-require 'basic-demo/colorer 'color-basic)]
#;[(drracket:indentation)
(dynamic-require 'basic-demo/indenter 'indent-jsonic)]
#;[(drracket:toolbar-buttons)
(dynamic-require 'basic-demo/buttons 'button-list)]
[else default]))
handle-query)

@ -13,10 +13,10 @@
(define (next-token)
(define get-token
(lexer-src-pos
[(eof) eof]
[whitespace (next-token)]
[(from/to "/*" "*/") (next-token)]
[(:: positive-number (:+ whitespace) (from/to (uc+lc "rem") "\n")) (next-token)]
[(eof) (token 'EOF)]
[whitespace (token 'WHITE lexeme #:skip? #t)]
[(from/to "/*" "*/") (token 'COMMENT lexeme #:skip? #t)]
[(:: positive-number (:+ whitespace) (from/to (uc+lc "rem") "\n")) (token 'COMMENT lexeme #:skip? #t)]
[(:or (uc+lc "print" "for" "to" "step" "if"
"goto" "input" "let" "next"
"return" "clear" "list" "run"

Loading…
Cancel
Save