[racket-dev] [plt] Push #23591: master branch updated
I made small changes to the prose, starting from a typo.
Hope it's okay -- Matthias
On Sep 23, 2011, at 5:37 PM, robby at racket-lang.org wrote:
> robby has updated `master' from ed6d3f3a6a to abda257295.
> http://git.racket-lang.org/plt/ed6d3f3a6a..abda257295
>
> =====[ 2 Commits ]======================================================
>
> Directory summary:
> 66.4% collects/drracket/private/syncheck/
> 8.0% collects/drracket/private/
> 18.7% collects/scribblings/drracket/
> 5.4% collects/tests/drracket/
>
> ~~~~~~~~~~
>
> a553cd7 Robby Findler <robby at racket-lang.org> 2011-09-22 17:38
> :
> | be more agressive about setting the current directory during check syntax
> | also, minor Rackety
> :
> M collects/drracket/private/syncheck/gui.rkt | 337 +++++++++---------
> M collects/drracket/private/syncheck/traversals.rkt | 6 +-
>
> ~~~~~~~~~~
>
> abda257 Robby Findler <robby at racket-lang.org> 2011-09-23 16:36
> :
> | moved the 'send to repl' keystrokes to the manual (and added a test
> | suite to make sure the example code in the manual doesn't get stale)
> :
> M collects/drracket/private/rep.rkt | 7 ---
> M collects/drracket/private/unit.rkt | 39 ----------------
> M collects/framework/test.rkt | 9 ++--
> M collects/scribblings/drracket/common.rkt | 8 ++-
> A collects/scribblings/drracket/incremental-keybindings.rkt
> M collects/scribblings/drracket/keybindings.scrbl | 49 +++++++++++++------
> A collects/tests/drracket/incremental-keybindings-test.rkt
>
> =====[ Overall Diff ]===================================================
>
> collects/drracket/private/rep.rkt
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
> --- OLD/collects/drracket/private/rep.rkt
> +++ NEW/collects/drracket/private/rep.rkt
> @@ -281,13 +281,6 @@ TODO
> (send drs-bindings-keymap map-function "c:x;0" "collapse")
> (send drs-bindings-keymap map-function "c:x;2" "split")
>
> - (send drs-bindings-keymap map-function "esc;c:x" "send-toplevel-form-to-repl")
> - (send drs-bindings-keymap map-function "m:c:x" "send-toplevel-form-to-repl")
> - (send drs-bindings-keymap map-function "c:c;c:e" "send-toplevel-form-to-repl")
> - (send drs-bindings-keymap map-function "c:c;c:r" "send-selection-to-repl")
> - (send drs-bindings-keymap map-function "c:c;m:e" "send-toplevel-form-to-repl-and-go")
> - (send drs-bindings-keymap map-function "c:c;m:r" "send-selection-to-repl-and-go")
> -
> (send drs-bindings-keymap map-function "c:c;c:z" "move-to-interactions")
>
> (for ([i (in-range 1 10)])
>
> collects/drracket/private/syncheck/gui.rkt
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
> --- OLD/collects/drracket/private/syncheck/gui.rkt
> +++ NEW/collects/drracket/private/syncheck/gui.rkt
> @@ -1640,180 +1640,177 @@ If the namespace does not, they are colored the unbound color.
> (inherit open-status-line close-status-line update-status-line ensure-rep-hidden)
> ;; syncheck:button-callback : (case-> (-> void) ((union #f syntax) -> void)
> ;; this is the only function that has any code running on the user's thread
> - (define/public syncheck:button-callback
> - (case-lambda
> - [() (syncheck:button-callback #f)]
> - [(jump-to-id) (syncheck:button-callback jump-to-id (preferences:get 'drracket:syncheck-mode))]
> - [(jump-to-id mode)
> - (when (send check-syntax-button is-enabled?)
> - (open-status-line 'drracket:check-syntax:status)
> - (update-status-line 'drracket:check-syntax:status status-init)
> - (ensure-rep-hidden)
> - (define definitions-text (get-definitions-text))
> - (define interactions-text (get-interactions-text))
> - (define drs-eventspace (current-eventspace))
> - (define the-tab (get-current-tab))
> - (define-values (old-break-thread old-custodian) (send the-tab get-breakables))
> -
> - ;; set by the init-proc
> - (define expanded-expression void)
> - (define expansion-completed void)
> - (define user-custodian #f)
> -
> - (define normal-termination? #f)
> -
> - (define show-error-report/tab
> - (λ () ; =drs=
> - (send the-tab turn-on-error-report)
> - (send (send the-tab get-error-report-text) scroll-to-position 0)
> - (when (eq? (get-current-tab) the-tab)
> - (show-error-report))))
> - (define cleanup
> - (λ () ; =drs=
> - (send the-tab set-breakables old-break-thread old-custodian)
> - (send the-tab enable-evaluation)
> - (set-syncheck-running-mode #f)
> - (close-status-line 'drracket:check-syntax:status)
> -
> - ;; do this with some lag ... not great, but should be okay.
> - (let ([err-port (send (send the-tab get-error-report-text) get-err-port)])
> - (thread
> + (define/public (syncheck:button-callback [jump-to-id #f]
> + [mode (preferences:get 'drracket:syncheck-mode)])
> + (when (send check-syntax-button is-enabled?)
> + (open-status-line 'drracket:check-syntax:status)
> + (update-status-line 'drracket:check-syntax:status status-init)
> + (ensure-rep-hidden)
> + (define definitions-text (get-definitions-text))
> + (define interactions-text (get-interactions-text))
> + (define drs-eventspace (current-eventspace))
> + (define the-tab (get-current-tab))
> + (define-values (old-break-thread old-custodian) (send the-tab get-breakables))
> +
> + ;; set by the init-proc
> + (define expanded-expression void)
> + (define expansion-completed void)
> + (define user-custodian #f)
> +
> + (define normal-termination? #f)
> +
> + (define show-error-report/tab
> + (λ () ; =drs=
> + (send the-tab turn-on-error-report)
> + (send (send the-tab get-error-report-text) scroll-to-position 0)
> + (when (eq? (get-current-tab) the-tab)
> + (show-error-report))))
> + (define cleanup
> + (λ () ; =drs=
> + (send the-tab set-breakables old-break-thread old-custodian)
> + (send the-tab enable-evaluation)
> + (set-syncheck-running-mode #f)
> + (close-status-line 'drracket:check-syntax:status)
> +
> + ;; do this with some lag ... not great, but should be okay.
> + (let ([err-port (send (send the-tab get-error-report-text) get-err-port)])
> + (thread
> + (λ ()
> + (flush-output err-port)
> + (queue-callback
> (λ ()
> - (flush-output err-port)
> - (queue-callback
> - (λ ()
> - (unless (= 0 (send (send the-tab get-error-report-text) last-position))
> - (show-error-report/tab)))))))))
> - (define kill-termination
> - (λ ()
> - (unless normal-termination?
> - (parameterize ([current-eventspace drs-eventspace])
> - (queue-callback
> - (λ ()
> - (send the-tab syncheck:clear-highlighting)
> - (cleanup)
> - (custodian-shutdown-all user-custodian)))))))
> - (define error-display-semaphore (make-semaphore 0))
> - (define uncaught-exception-raised
> - (λ () ;; =user=
> - (set! normal-termination? #t)
> + (unless (= 0 (send (send the-tab get-error-report-text) last-position))
> + (show-error-report/tab)))))))))
> + (define kill-termination
> + (λ ()
> + (unless normal-termination?
> + (parameterize ([current-eventspace drs-eventspace])
> + (queue-callback
> + (λ ()
> + (send the-tab syncheck:clear-highlighting)
> + (cleanup)
> + (custodian-shutdown-all user-custodian)))))))
> + (define error-display-semaphore (make-semaphore 0))
> + (define uncaught-exception-raised
> + (λ () ;; =user=
> + (set! normal-termination? #t)
> + (parameterize ([current-eventspace drs-eventspace])
> + (queue-callback
> + (λ () ;; =drs=
> + (yield error-display-semaphore) ;; let error display go first
> + (send the-tab syncheck:clear-highlighting)
> + (cleanup)
> + (custodian-shutdown-all user-custodian))))))
> + (define error-port (send (send the-tab get-error-report-text) get-err-port))
> + (define output-port (send (send the-tab get-error-report-text) get-out-port))
> + (define init-proc
> + (λ () ; =user=
> + (send the-tab set-breakables (current-thread) (current-custodian))
> + (set-directory definitions-text)
> + (current-error-port error-port)
> + (current-output-port output-port)
> + (error-display-handler
> + (λ (msg exn) ;; =user=
> (parameterize ([current-eventspace drs-eventspace])
> (queue-callback
> - (λ () ;; =drs=
> - (yield error-display-semaphore) ;; let error display go first
> - (send the-tab syncheck:clear-highlighting)
> - (cleanup)
> - (custodian-shutdown-all user-custodian))))))
> - (define error-port (send (send the-tab get-error-report-text) get-err-port))
> - (define output-port (send (send the-tab get-error-report-text) get-out-port))
> - (define init-proc
> - (λ () ; =user=
> - (send the-tab set-breakables (current-thread) (current-custodian))
> - (set-directory definitions-text)
> - (current-error-port error-port)
> - (current-output-port output-port)
> - (error-display-handler
> - (λ (msg exn) ;; =user=
> - (parameterize ([current-eventspace drs-eventspace])
> - (queue-callback
> - (λ () ;; =drs=
> -
> - ;; this has to come first or else the positioning
> - ;; computations in the highlight-errors/exn method
> - ;; will be wrong by the size of the error report box
> - (show-error-report/tab)
> -
> - ;; a call like this one also happens in
> - ;; drracket:debug:error-display-handler/stacktrace
> - ;; but that call won't happen here, because
> - ;; the rep is not in the current-rep parameter
> - (send interactions-text highlight-errors/exn exn))))
> -
> - (drracket:debug:error-display-handler/stacktrace
> - msg
> - exn
> - '()
> - #:definitions-text definitions-text)
> -
> - (semaphore-post error-display-semaphore)))
> + (λ () ;; =drs=
> +
> + ;; this has to come first or else the positioning
> + ;; computations in the highlight-errors/exn method
> + ;; will be wrong by the size of the error report box
> + (show-error-report/tab)
> +
> + ;; a call like this one also happens in
> + ;; drracket:debug:error-display-handler/stacktrace
> + ;; but that call won't happen here, because
> + ;; the rep is not in the current-rep parameter
> + (send interactions-text highlight-errors/exn exn))))
>
> - (error-print-source-location #f) ; need to build code to render error first
> - (uncaught-exception-handler
> - (let ([oh (uncaught-exception-handler)])
> - (λ (exn)
> - (uncaught-exception-raised)
> - (oh exn))))
> - (update-status-line 'drracket:check-syntax:status status-expanding-expression)
> - (set!-values (expanded-expression expansion-completed)
> - (make-traversal (current-namespace)
> - (current-directory))) ;; set by set-directory above
> - (set! user-custodian (current-custodian))))
> -
> - (set-syncheck-running-mode 'button)
> - (send the-tab disable-evaluation) ;; this locks the editor, so must be outside.
> - (define definitions-text-copy
> - (new (class text:basic%
> - ;; overriding get-port-name like this ensures
> - ;; that the resulting syntax objects are connected
> - ;; to the actual definitions-text, not this copy
> - (define/override (get-port-name)
> - (send definitions-text get-port-name))
> - (super-new))))
> - (define settings (send definitions-text get-next-settings))
> - (define module-language?
> - (is-a? (drracket:language-configuration:language-settings-language settings)
> - drracket:module-language:module-language<%>))
> - (send definitions-text-copy set-style-list (send definitions-text get-style-list)) ;; speeds up the copy
> - (send definitions-text copy-self-to definitions-text-copy)
> - (with-lock/edit-sequence
> - definitions-text-copy
> - (λ ()
> - (send the-tab clear-annotations)
> - (send the-tab reset-offer-kill)
> - (send (send the-tab get-defs) syncheck:init-arrows)
> - (drracket:eval:expand-program
> - #:gui-modules? #f
> - (drracket:language:make-text/pos definitions-text-copy 0 (send definitions-text-copy last-position))
> - settings
> - (not module-language?)
> - init-proc
> - kill-termination
> - (λ (sexp loop) ; =user=
> - (cond
> - [(eof-object? sexp)
> - (set! normal-termination? #t)
> - (parameterize ([current-eventspace drs-eventspace])
> - (queue-callback
> - (λ () ; =drs=
> - (with-lock/edit-sequence
> - definitions-text
> - (λ ()
> - (parameterize ([current-annotations definitions-text])
> - (expansion-completed))
> - (send (send (get-current-tab) get-defs) set-syncheck-mode mode)
> - (update-menu-status (get-current-tab))
> - (send definitions-text syncheck:sort-bindings-table)))
> - (cleanup)
> - (custodian-shutdown-all user-custodian))))]
> - [else
> - (open-status-line 'drracket:check-syntax:status)
> - (unless module-language?
> - (update-status-line 'drracket:check-syntax:status status-eval-compile-time)
> - (eval-compile-time-part-of-top-level sexp))
> - (parameterize ([current-eventspace drs-eventspace])
> - (queue-callback
> - (λ () ; =drs=
> - (with-lock/edit-sequence
> - definitions-text
> - (λ ()
> - (open-status-line 'drracket:check-syntax:status)
> - (update-status-line 'drracket:check-syntax:status status-coloring-program)
> - (parameterize ([current-annotations definitions-text])
> - (expanded-expression sexp (if jump-to-id (make-visit-id jump-to-id) void)))
> - (close-status-line 'drracket:check-syntax:status))))))
> - (update-status-line 'drracket:check-syntax:status status-expanding-expression)
> - (close-status-line 'drracket:check-syntax:status)
> - (loop)]))))))]))
> + (drracket:debug:error-display-handler/stacktrace
> + msg
> + exn
> + '()
> + #:definitions-text definitions-text)
> +
> + (semaphore-post error-display-semaphore)))
> +
> + (error-print-source-location #f) ; need to build code to render error first
> + (uncaught-exception-handler
> + (let ([oh (uncaught-exception-handler)])
> + (λ (exn)
> + (uncaught-exception-raised)
> + (oh exn))))
> + (update-status-line 'drracket:check-syntax:status status-expanding-expression)
> + (set!-values (expanded-expression expansion-completed)
> + (make-traversal (current-namespace)
> + (current-directory))) ;; set by set-directory above
> + (set! user-custodian (current-custodian))))
> +
> + (set-syncheck-running-mode 'button)
> + (send the-tab disable-evaluation) ;; this locks the editor, so must be outside.
> + (define definitions-text-copy
> + (new (class text:basic%
> + ;; overriding get-port-name like this ensures
> + ;; that the resulting syntax objects are connected
> + ;; to the actual definitions-text, not this copy
> + (define/override (get-port-name)
> + (send definitions-text get-port-name))
> + (super-new))))
> + (define settings (send definitions-text get-next-settings))
> + (define module-language?
> + (is-a? (drracket:language-configuration:language-settings-language settings)
> + drracket:module-language:module-language<%>))
> + (send definitions-text-copy set-style-list (send definitions-text get-style-list)) ;; speeds up the copy
> + (send definitions-text copy-self-to definitions-text-copy)
> + (with-lock/edit-sequence
> + definitions-text-copy
> + (λ ()
> + (send the-tab clear-annotations)
> + (send the-tab reset-offer-kill)
> + (send (send the-tab get-defs) syncheck:init-arrows)
> + (drracket:eval:expand-program
> + #:gui-modules? #f
> + (drracket:language:make-text/pos definitions-text-copy 0 (send definitions-text-copy last-position))
> + settings
> + (not module-language?)
> + init-proc
> + kill-termination
> + (λ (sexp loop) ; =user=
> + (cond
> + [(eof-object? sexp)
> + (set! normal-termination? #t)
> + (parameterize ([current-eventspace drs-eventspace])
> + (queue-callback
> + (λ () ; =drs=
> + (with-lock/edit-sequence
> + definitions-text
> + (λ ()
> + (parameterize ([current-annotations definitions-text])
> + (expansion-completed))
> + (send (send (get-current-tab) get-defs) set-syncheck-mode mode)
> + (update-menu-status (get-current-tab))
> + (send definitions-text syncheck:sort-bindings-table)))
> + (cleanup)
> + (custodian-shutdown-all user-custodian))))]
> + [else
> + (open-status-line 'drracket:check-syntax:status)
> + (unless module-language?
> + (update-status-line 'drracket:check-syntax:status status-eval-compile-time)
> + (eval-compile-time-part-of-top-level sexp))
> + (parameterize ([current-eventspace drs-eventspace])
> + (queue-callback
> + (λ () ; =drs=
> + (with-lock/edit-sequence
> + definitions-text
> + (λ ()
> + (open-status-line 'drracket:check-syntax:status)
> + (update-status-line 'drracket:check-syntax:status status-coloring-program)
> + (parameterize ([current-annotations definitions-text])
> + (expanded-expression sexp (if jump-to-id (make-visit-id jump-to-id) void)))
> + (close-status-line 'drracket:check-syntax:status))))))
> + (update-status-line 'drracket:check-syntax:status status-expanding-expression)
> + (close-status-line 'drracket:check-syntax:status)
> + (loop)])))))))
>
> (define (make-visit-id jump-to-id)
> (λ (vars)
>
> collects/drracket/private/syncheck/traversals.rkt
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
> --- OLD/collects/drracket/private/syncheck/traversals.rkt
> +++ NEW/collects/drracket/private/syncheck/traversals.rkt
> @@ -54,7 +54,8 @@
> [tl-module-lang-requires (make-hash)]
> [expanded-expression
> (λ (sexp [visit-id void])
> - (parameterize ([current-load-relative-directory user-directory])
> + (parameterize ([current-directory (or user-directory (current-directory))]
> + [current-load-relative-directory user-directory])
> (let ([is-module? (syntax-case sexp (module)
> [(module . rest) #t]
> [else #f])])
> @@ -107,7 +108,8 @@
> tl-phase-to-requires)]))))]
> [expansion-completed
> (λ ()
> - (parameterize ([current-load-relative-directory user-directory])
> + (parameterize ([current-directory (or user-directory (current-directory))]
> + [current-load-relative-directory user-directory])
> (annotate-variables user-namespace
> user-directory
> tl-phase-to-binders
>
> collects/drracket/private/unit.rkt
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
> --- OLD/collects/drracket/private/unit.rkt
> +++ NEW/collects/drracket/private/unit.rkt
> @@ -4013,48 +4013,9 @@ module browser threading seems wrong.
> (send ed set-position (- (srcloc-position srcloc) 1))
> (send ed set-caret-owner #f 'global))
>
> -
> - (define/public (send-toplevel-form-to-repl shift-focus?)
> - (define defs (get-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 pos
> - (send defs get-forward-sexp pos)
> - shift-focus?)]))))
> - (define/public (send-selection-to-repl shift-focus?)
> - (define defs (get-definitions-text))
> - (send-range-to-repl (send defs get-start-position) (send defs get-end-position) shift-focus?))
> (define/public (move-to-interactions)
> (ensure-rep-shown (get-interactions-text))
> (send (get-interactions-canvas) focus))
> -
> - (define/private (send-range-to-repl start end shift-focus?)
> - (unless (= start end)
> - (define defs (get-definitions-text))
> - (define ints (get-interactions-text))
> - (send defs move/copy-to-edit ints start end (send ints last-position) #:try-to-move? #f)
> -
> -
> - ;; clear out the whitespace after the copied down thing
> - (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))))
> -
> - ;; insert a newline
> - (send ints insert "\n" (send ints last-position) (send ints last-position))
> -
> - (ensure-rep-shown ints)
> - (when shift-focus? (send (get-interactions-canvas) focus))
> - (send ints do-submission)))
>
>
> ;
>
> collects/framework/test.rkt
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~
> --- OLD/collects/framework/test.rkt
> +++ NEW/collects/framework/test.rkt
> @@ -950,16 +950,15 @@
>
> If conflicting modifiers are provided, the ones later in the list are used.})
>
> - (proc-doc/names
> + (proc-doc
> test:menu-select
> - (string? string? . -> . void?)
> - (menu item)
> - @{Selects the menu-item named @racket[item] in the menu named @racket[menu].
> + (->i ([menu string?]) () #:rest [items (listof string?)] [res void?])
> + @{Selects the menu-item named by the @racket[item]s in the menu named @racket[menu].
>
> @italic{Note:}
> The string for the menu item does not include its keyboard equivalent.
> For example, to select ``New'' from the ``File'' menu,
> - use ``New'', not ``New Ctrl+m n''.})
> + use ``New'', not ``New Ctrl+N''.})
>
> (proc-doc/names
> test:mouse-click
>
> collects/scribblings/drracket/common.rkt
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
> --- OLD/collects/scribblings/drracket/common.rkt
> +++ NEW/collects/scribblings/drracket/common.rkt
> @@ -1,12 +1,14 @@
> -#lang scheme/base
> +#lang racket/base
>
> (require scribble/manual
> - (for-label scheme))
> + (for-label racket
> + racket/gui/base))
>
> (provide HtDP
> drlang
> (all-from-out scribble/manual)
> - (for-label (all-from-out scheme)))
> + (for-label (all-from-out racket
> + racket/gui/base)))
>
> (define HtDP
> (italic "How to Design Programs"))
>
> collects/scribblings/drracket/incremental-keybindings.rkt
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
> --- /dev/null
> +++ NEW/collects/scribblings/drracket/incremental-keybindings.rkt
> @@ -0,0 +1,61 @@
> +#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<%>)
> + (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/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?)
> + (-> (is-a?/c drracket:unit:definitions-text<%>)
> + exact-positive-integer?
> + exact-positive-integer?
> + boolean?
> + any)
> + (unless (= start end)
> + (define ints (send (send defs get-tab) get-ints))
> + (define frame (send (send defs get-tab) get-frame))
> + (send defs move/copy-to-edit
> + ints start end
> + (send ints last-position)
> + #:try-to-move? #f)
> +
> + (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))))
> + (send ints insert
> + "\n"
> + (send ints last-position)
> + (send ints last-position))
> +
> + (send frame ensure-rep-shown ints)
> + (when shift-focus? (send (send ints get-canvas) focus))
> + (send ints do-submission)))
>
> collects/scribblings/drracket/keybindings.scrbl
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
> --- OLD/collects/scribblings/drracket/keybindings.scrbl
> +++ NEW/collects/scribblings/drracket/keybindings.scrbl
> @@ -1,7 +1,9 @@
> #lang scribble/doc
> @(require "common.rkt"
> - scribble/struct scribble/bnf racket/list mrlib/tex-table
> - (for-label racket/gui/base))
> + scribble/struct scribble/bnf
> + racket/list racket/runtime-path racket/port
> + mrlib/tex-table
> + (for-label drracket/tool-lib))
>
> @(define (keybinding key . desc)
> (let* ([keys (if (string? key) (list key) key)]
> @@ -91,8 +93,6 @@ inspired by Emacs.
> @keybinding["A-C-down"]{move down into an embedded editor}
>
> @keybinding["C-C C-Z"]{move the cursor to the interactions window}
> - at keybinding["C-F6"]{move the cursor from the definitions
> -window to the interactions window (or the search window, if it is open).}
> ]
>
> @section{Editing Operations}
> @@ -156,18 +156,6 @@ window to the interactions window (or the search window, if it is open).}
>
> @itemize[
> @keybinding["F5"]{Run}
> - at keybinding["M-C-x"]{Copy the top-level form surrounding the insertion point to the interactions window
> - and submit it for evaluation}
> - at keybinding["C-c C-e"]{Copy the top-level form surrounding the insertion point to the interactions window
> - and submit it for evaluation}
> - at keybinding["C-c M-e"]{Copy the top-level form surrounding the insertion point to the interactions window,
> - submit it for evaluation, and move the focus to the interations window}
> - at keybinding["C-c C-r"]{Copy the selection to the interactions window
> - and submit it for evaluation}
> - at keybinding["C-c C-r"]{Copy the selection to the interactions window
> - and submit it for evaluation}
> - at keybinding["C-c M-r"]{Copy the selection to the interactions window,
> - submit it for evaluation, and move the focus to the interactions window}
> ]
>
>
> @@ -244,3 +232,32 @@ s-exp framework/keybinding-lang
> Note that DrRacket does not reload this file automatically when you
> make a change, so you'll need to restart DrRacket to see changes to
> the file.
> +
> + at section{Sending Program Fragments to the REPL}
> +
> + at index['("Emacs keybindings")]Users comfortable with Emacs and the conventional Lisp/Scheme-style
> +of interaction with an ``inferior process'' commonly request
> +keybindings in DrRacket that send program fragments to be evaluated
> +at the prompt. This style of interaction is fraught with difficulty,
> +especially for beginners, and so DrRacket, by default, does not support
> +it. Instead, clicking DrRacket's ``Run'' button starts with a clean slate
> +and sends the entire contents of the definitions window, ensuring that
> +the state in the REPL matches what you would expect by reading
> +the source code of the program.
> +
> +That said, it is difficult for some people to switch to this new mode and,
> +in some cases (for example when most of the interesting state is not
> +in the program but in an external database or in the filesystem), using
> +the contentional keystrokes may make sense.
> +
> +So, the remainder of this section is an example keybindings file that
> +adds the ability to send expressions piecemeal to the interactions
> +window. It also demonstrates how to pull together a bunch of pieces
> +of DrRacket's implementation and its libraries to implement keystrokes.
> +
> +@(define-runtime-path incremental-keybindings.rkt "incremental-keybindings.rkt")
> +@(let ([sp (open-output-string)])
> + (call-with-input-file incremental-keybindings.rkt
> + (λ (port)
> + (copy-port port sp)))
> + (codeblock (get-output-string sp)))
>
> collects/tests/drracket/incremental-keybindings-test.rkt
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
> --- /dev/null
> +++ NEW/collects/tests/drracket/incremental-keybindings-test.rkt
> @@ -0,0 +1,47 @@
> +#lang racket/base
> +#|
> +
> +Adds the incremental-keybindings.rkt file (also shown in the docs)
> +to DrRacket and then tries out the keystrokes.
> +
> +|#
> +
> +(require "private/drracket-test-util.rkt"
> + framework/test
> + racket/class)
> +
> +(fire-up-drscheme-and-run-tests
> + (λ ()
> + (define drs-frame (wait-for-drscheme-frame))
> + (use-get/put-dialog
> + (λ ()
> + (test:menu-select "Edit" "Keybindings" "Add User-defined Keybindings..."))
> + (collection-file-path "incremental-keybindings.rkt"
> + "scribblings"
> + "drracket"))
> + (insert-in-definitions drs-frame "#lang racket/base\n")
> + (do-execute drs-frame)
> +
> + (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))
> + (wait-for-computation drs-frame)
> + (test:keystroke 'right '(alt shift))
> + (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)))))
> +
> + (unless (equal? got "> (+ 1 (+ 2 3))\n6\n> (+ 2 3)\n5\n> ")
> + (error 'incrementalkeybindings-test.rkt "failed-test; got ~s" got))))
> +
![[logo]](/logo.png){kind=logo}