fix problems with user-defined keybindings and the example in the docs

as reported on the dev mailing list by António Menezes Leitao
This commit is contained in:
Robby Findler 2012-03-19 09:37:03 -05:00
parent 8392f20b8f
commit 9bc1684c9b
4 changed files with 96 additions and 45 deletions

View File

@ -350,15 +350,16 @@
;; add-keybindings-item : keybindings-item[path or planet spec] -> boolean
;; boolean indicates if the addition happened sucessfully
(define (add-keybindings-item item)
(with-handlers ([exn? (λ (x)
(message-box (string-constant drscheme)
(format (string-constant keybindings-error-installing-file)
(if (path? item)
(path->string item)
(format "~s" item))
(exn-message x))
#:dialog-mixin frame:focus-table-mixin)
#f)])
(with-handlers ([exn:fail?
(λ (x)
(message-box (string-constant drscheme)
(format (string-constant keybindings-error-installing-file)
(if (path? item)
(path->string item)
(format "~s" item))
(exn-message x))
#:dialog-mixin frame:focus-table-mixin)
#f)])
(keymap:add-user-keybindings-file item)
#t))

View File

@ -702,10 +702,6 @@
;; not going to be exiting yet.
(autosave:restore-autosave-files/gui)
;; install user's keybindings
(for-each drracket:frame:add-keybindings-item
(preferences:get 'drracket:user-defined-keybindings))
;; the initial window doesn't set the
;; unit object's state correctly, yet.
(define (make-basic)
@ -727,9 +723,12 @@
(loop (cdr files))
(cons (car files) (loop (cdr files))))])))
;; we queue a callback here to open the first frame
;; so that the modules that are being loaded by drracket
;; are all finished before we trigger the dynamic
;; Queue a callback here to open the first frame
;; and install the user's keybindings so that the modules
;; that are being loaded by drracket are all finished.
;; This makes sure that drracket exports
;; are all set up a) in case a user keybinding file uses
;; them, and b) before we trigger the dynamic
;; requires that can happen when the module language looks
;; at the #lang line (which can end up loading drracket itself
;; in a bad way leading to errors like this:
@ -739,6 +738,11 @@
(queue-callback
(λ ()
;; install user's keybindings
(for-each drracket:frame:add-keybindings-item
(preferences:get 'drracket:user-defined-keybindings))
;; NOTE: drscheme-normal.rkt sets current-command-line-arguments to
;; the list of files to open, after parsing out flags like -h
(let* ([files-to-open

View File

@ -10,18 +10,43 @@
(define/contract (send-toplevel-form defs shift-focus?)
(-> any/c boolean? any)
(when (is-a? defs drracket:unit:definitions-text<%>)
(when (= (send defs get-start-position)
(send defs get-end-position))
(let loop ([pos (send defs get-start-position)])
(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?)])))))
(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<%>)
@ -31,19 +56,21 @@
shift-focus?)))
(define/contract (send-range-to-repl defs start end shift-focus?)
(-> (is-a?/c drracket:unit:definitions-text<%>)
exact-positive-integer?
exact-positive-integer?
boolean?
any)
(unless (= start end)
(->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)
@ -51,11 +78,15 @@
(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)))

View File

@ -13,6 +13,15 @@ to DrRacket and then tries out the keystrokes.
(fire-up-drracket-and-run-tests
(λ ()
(define drs-frame (wait-for-drracket-frame))
(define defs (queue-callback/res (λ () (send drs-frame get-definitions-text))))
(define (get-repl-contents)
(queue-callback/res
(λ ()
(define ints (send drs-frame get-interactions-text))
(send ints get-text
(send ints paragraph-start-position 2)
(send ints last-position)))))
(use-get/put-dialog
(λ ()
(test:menu-select "Edit" "Keybindings" "Add User-defined Keybindings..."))
@ -25,7 +34,6 @@ to DrRacket and then tries out the keystrokes.
(insert-in-definitions drs-frame "(+ 1 (+ 2 3))")
(queue-callback/res
(λ ()
(define defs (send drs-frame get-definitions-text))
(send defs set-position (+ (send defs paragraph-start-position 1) 5))))
(test:keystroke #\c '(control))
(test:keystroke #\e '(control))
@ -34,14 +42,21 @@ to DrRacket and then tries out the keystrokes.
(test:keystroke #\c '(control))
(test:keystroke #\r '(control))
(wait-for-computation drs-frame)
(define got
(queue-callback/res
(λ ()
(define ints (send drs-frame get-interactions-text))
(send ints get-text
(send ints paragraph-start-position 2)
(send ints last-position)))))
(define got (get-repl-contents))
(unless (equal? got "> (+ 1 (+ 2 3))\n6\n> (+ 2 3)\n5\n> ")
(error 'incrementalkeybindings-test.rkt "failed-test; got ~s" got))))
(error 'incremental-keybindings-test.rkt "failed-test.1; got ~s" got))
;; test c:c;c:e when the insertion
;; point is at the end of the editor
(do-execute drs-frame)
(queue-callback/res (λ ()
(send (send defs get-canvas) focus)
(send defs set-position (send defs last-position) (send defs last-position))))
(test:keystroke #\c '(control))
(test:keystroke #\e '(control))
(wait-for-computation drs-frame)
(define got2 (get-repl-contents))
(unless (equal? got2 "6\n> (+ 1 (+ 2 3))\n6\n> ")
(error 'incremental-keybindings-test.rkt "failed-test.2; got ~s" got2))))