reorg, add toolbar

dev-srcloc
Matthew Butterick 8 years ago
parent d656b4cf7a
commit 6b30895974

@ -1,10 +1,10 @@
#lang racket/base
(require racket/provide racket/list racket/string racket/format racket/match racket/port
br/define br/syntax br/datum br/debug br/cond racket/function
br/define br/syntax br/datum br/debug br/cond racket/class
(for-syntax racket/base racket/syntax br/syntax br/debug br/define))
(provide (all-from-out racket/base)
(all-from-out racket/list racket/string racket/format racket/match racket/port
br/syntax br/datum br/debug br/cond racket/function br/define)
br/syntax br/datum br/debug br/cond racket/class br/define)
(for-syntax (all-from-out racket/base racket/syntax br/syntax br/debug))
(for-syntax caller-stx with-shared-id)) ; from br/define

@ -1,10 +1,9 @@
#lang br
(require parser-tools/lex
syntax-color/racket-lexer
(prefix-in : parser-tools/lex-sre))
parser-tools/lex-sre)
(provide drracket-lexer)
(provide color-lexer)
(define in-racket-expr? #f)
@ -16,8 +15,8 @@
(check-true (at-racket-boundary? (open-input-string "$@foo")))
(check-false (at-racket-boundary? (open-input-string "foo$@"))))
(define (drracket-lexer input-port)
(define this-lexer
(define (color-lexer input-port)
(define jsonic-lexer
(lexer
[(eof) (values lexeme 'eof #f #f #f)]
["@$" (begin
@ -26,10 +25,10 @@
["$@" (begin
(set! in-racket-expr? #f)
(values lexeme 'parenthesis '|)| (position-offset start-pos) (position-offset end-pos)))]
[(:seq "//" (:* (char-complement #\newline)))
[(seq "//" (* (char-complement #\newline)))
(values lexeme 'comment #f (position-offset start-pos) (position-offset end-pos))]
[any-char
(values lexeme 'string #f (position-offset start-pos) (position-offset end-pos))]))
(if (and in-racket-expr? (not (at-racket-boundary? input-port)))
(racket-lexer input-port)
(this-lexer input-port)))
(jsonic-lexer input-port)))

@ -1,29 +1,29 @@
#lang br
(require racket/class describe)
(provide drracket-indenter)
(provide indenter)
(define open-braces #f)
(define indent-width 2)
(define (drracket-indenter txt start-pos)
(define fresh-indent? (zero? start-pos))
(when fresh-indent? (set! open-braces 0))
(define (indenter drr-editor start-pos)
(when (zero? start-pos) (set! open-braces 0))
(define first-pos-in-this-line
(for*/first ([pos (in-naturals start-pos)]
[c (in-value (send txt get-character pos))]
[c (in-value (send drr-editor get-character pos))]
#:when (not (char-blank? c)))
pos))
(define last-pos-in-this-line
(send txt find-newline 'forward first-pos-in-this-line))
(send drr-editor find-newline 'forward first-pos-in-this-line))
(set! open-braces
(+ open-braces
(for/sum ([pos (in-range first-pos-in-this-line last-pos-in-this-line)])
(case (send txt get-character pos)
(case (send drr-editor get-character pos)
[(#\{) 1]
[(#\}) -1]
[else 0]))))
(define first-char
(send drr-editor get-character first-pos-in-this-line))
(and (positive? open-braces)
(* indent-width
(if ((send txt get-character first-pos-in-this-line) . char=? . #\{)
(if (first-char . char=? . #\{)
(sub1 open-braces)
open-braces))))

@ -36,10 +36,11 @@ Demonstrate:
(λ (key default)
(case key
[(color-lexer)
(dynamic-require 'br/demo/jsonic/drracket-lexer 'drracket-lexer (λ () #f))]
(dynamic-require 'br/demo/jsonic/color-lexer 'color-lexer (λ () #f))]
[(drracket:indentation)
(dynamic-require 'br/demo/jsonic/drracket-indenter 'drracket-indenter (λ () #f))
#;(really-dynamic-require 'scribble/private/indentation 'determine-spaces)]
(dynamic-require 'br/demo/jsonic/indenter 'indenter (λ () #f))]
[(drracket:toolbar-buttons)
(dynamic-require 'br/demo/jsonic/toolbar 'buttons (λ () #f))]
[else default])))
(define (test-tokenize str)

@ -0,0 +1,17 @@
#lang br
(require racket/draw)
(provide buttons)
(define buttons
(list (let ([label "Insert expression"]
[bitmap (make-object bitmap% 16 16)]
[callback (λ (drr-frame)
(define drr-editor (send drr-frame get-definitions-text))
(send drr-editor begin-edit-sequence)
(send drr-editor insert "@$ $@")
(send drr-editor end-edit-sequence)
(define pos (send drr-editor get-end-position))
(send drr-editor set-position (- pos 3))
)]
[number 98])
(list label bitmap callback number))))
Loading…
Cancel
Save