diff --git a/collects/drracket/private/frame.rkt b/collects/drracket/private/frame.rkt index 925b911dfe..804b029068 100644 --- a/collects/drracket/private/frame.rkt +++ b/collects/drracket/private/frame.rkt @@ -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)) diff --git a/collects/drracket/private/main.rkt b/collects/drracket/private/main.rkt index cc979bcd97..16b18c0be8 100644 --- a/collects/drracket/private/main.rkt +++ b/collects/drracket/private/main.rkt @@ -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 diff --git a/collects/scribblings/drracket/incremental-keybindings.rkt b/collects/scribblings/drracket/incremental-keybindings.rkt index 215aa19bf7..db0636d064 100644 --- a/collects/scribblings/drracket/incremental-keybindings.rkt +++ b/collects/scribblings/drracket/incremental-keybindings.rkt @@ -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))) diff --git a/collects/tests/drracket/incremental-keybindings-test.rkt b/collects/tests/drracket/incremental-keybindings-test.rkt index c414060b5b..01d0f7806f 100644 --- a/collects/tests/drracket/incremental-keybindings-test.rkt +++ b/collects/tests/drracket/incremental-keybindings-test.rkt @@ -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))))