reorg, add toolbar

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

@ -1,10 +1,10 @@
#lang racket/base #lang racket/base
(require racket/provide racket/list racket/string racket/format racket/match racket/port (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)) (for-syntax racket/base racket/syntax br/syntax br/debug br/define))
(provide (all-from-out racket/base) (provide (all-from-out racket/base)
(all-from-out racket/list racket/string racket/format racket/match racket/port (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 (all-from-out racket/base racket/syntax br/syntax br/debug))
(for-syntax caller-stx with-shared-id)) ; from br/define (for-syntax caller-stx with-shared-id)) ; from br/define

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

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

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