93 lines
3.5 KiB
Racket
93 lines
3.5 KiB
Racket
#lang s-exp framework/keybinding-lang
|
|
|
|
(require drracket/tool-lib)
|
|
|
|
(keybinding "c:c;c:e" (lambda (ed evt) (send-toplevel-form ed #f)))
|
|
(keybinding "c:c;c:r" (lambda (ed evt) (send-selection ed #f)))
|
|
(keybinding "c:c;m:e" (lambda (ed evt) (send-toplevel-form ed #t)))
|
|
(keybinding "c:c;m:r" (lambda (ed evt) (send-selection ed #t)))
|
|
|
|
(define/contract (send-toplevel-form defs shift-focus?)
|
|
(-> any/c boolean? any)
|
|
(when (is-a? defs drracket:unit:definitions-text<%>)
|
|
(define sp (send defs get-start-position))
|
|
(when (= sp (send defs get-end-position))
|
|
(cond
|
|
[(send defs find-up-sexp sp)
|
|
;; we are inside some top-level expression;
|
|
;; find the enclosing expression
|
|
(let loop ([pos sp])
|
|
(define next-up (send defs find-up-sexp pos))
|
|
(cond
|
|
[next-up (loop next-up)]
|
|
[else
|
|
(send-range-to-repl defs
|
|
pos
|
|
(send defs get-forward-sexp pos)
|
|
shift-focus?)]))]
|
|
[else
|
|
;; we are at the top-level
|
|
(define fw (send defs get-forward-sexp sp))
|
|
(define bw (send defs get-backward-sexp sp))
|
|
(cond
|
|
[(and (not fw) (not bw))
|
|
;; no expressions in the file, give up
|
|
(void)]
|
|
[(not fw)
|
|
;; no expression after the insertion point;
|
|
;; send the one before it
|
|
(send-range-to-repl defs
|
|
bw
|
|
(send defs get-forward-sexp bw)
|
|
shift-focus?)]
|
|
[else
|
|
;; send the expression after the insertion point
|
|
(send-range-to-repl defs
|
|
(send defs get-backward-sexp fw)
|
|
fw
|
|
shift-focus?)])]))))
|
|
|
|
(define/contract (send-selection defs shift-focus?)
|
|
(-> any/c boolean? any)
|
|
(when (is-a? defs drracket:unit:definitions-text<%>)
|
|
(send-range-to-repl defs
|
|
(send defs get-start-position)
|
|
(send defs get-end-position)
|
|
shift-focus?)))
|
|
|
|
(define/contract (send-range-to-repl defs start end shift-focus?)
|
|
(->i ([defs (is-a?/c drracket:unit:definitions-text<%>)]
|
|
[start exact-positive-integer?]
|
|
[end (start) (and/c exact-positive-integer? (>=/c start))]
|
|
[shift-focus? boolean?])
|
|
any)
|
|
(unless (= start end) ;; don't send empty regions
|
|
(define ints (send (send defs get-tab) get-ints))
|
|
(define frame (send (send defs get-tab) get-frame))
|
|
;; copy the expression over to the interactions window
|
|
(send defs move/copy-to-edit
|
|
ints start end
|
|
(send ints last-position)
|
|
#:try-to-move? #f)
|
|
|
|
;; erase any trailing whitespace
|
|
(let loop ()
|
|
(define last-pos (- (send ints last-position) 1))
|
|
(when (last-pos . > . 0)
|
|
(define last-char (send ints get-character last-pos))
|
|
(when (char-whitespace? last-char)
|
|
(send ints delete last-pos (+ last-pos 1))
|
|
(loop))))
|
|
|
|
;; put back a single newline
|
|
(send ints insert
|
|
"\n"
|
|
(send ints last-position)
|
|
(send ints last-position))
|
|
|
|
;; make sure the interactions is visible
|
|
;; and run the submitted expression
|
|
(send frame ensure-rep-shown ints)
|
|
(when shift-focus? (send (send ints get-canvas) focus))
|
|
(send ints do-submission)))
|