suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

added half-assed prompt-avoiding control-a keybinding

Browse Source 
svn: r12089
This commit is contained in:
Robby Findler 2008-10-21 23:02:37 +00:00
parent 505cc65181
commit 567ef6d95c
2 changed files with 47 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
collects/drscheme/private/language.ss
View File

@ -1086,12 +1086,31 @@
(λ () (λ ()
(with-handlers ([(λ (x) #t) (with-handlers ([(λ (x) #t)
(λ (x) (λ (x)
(display (exn-message x)) (parameterize ([current-error-port original-output-port])
(newline))]) ((error-display-handler)
(if (exn? x)
(exn-message x)
(format "~s" x))
x))
(printf "~a\n" (if (exn? x)
(exn-message x)
(format "~s" x))))])
(when module-spec (when module-spec
(if use-copy? (if use-copy?
(namespace-require/copy module-spec) (namespace-require/copy module-spec)
(namespace-require/constant module-spec))) (let ([t (current-thread)])
(thread
(λ ()
(let loop ([i 5])
(unless (zero? i)
(printf "sleeping ... ~a\n" i)
(sleep 1)
(loop (- i 1))))
(printf "breaking...\n")
(break-thread t)
(printf "broke\n")))
(break-enabled #t)
(namespace-require/constant module-spec))))
(when transformer-module-spec (when transformer-module-spec
(namespace-require `(for-syntax ,transformer-module-spec))))))) (namespace-require `(for-syntax ,transformer-module-spec)))))))

25
collects/drscheme/private/rep.ss
View File

@ -323,6 +323,26 @@ TODO
(define setup-scheme-interaction-mode-keymap (define setup-scheme-interaction-mode-keymap
(λ (keymap) (λ (keymap)
(define (beginning-of-line text select?)
(let* ([para (send text position-line (send text get-start-position))]
[para-start (send text line-start-position para)]
[prompt (send text get-prompt)]
[para-start-text (send text get-text para-start (+ para-start (string-length prompt)))]
[new-start
(cond
[(equal? prompt para-start-text)
(+ para-start (string-length prompt))]
[else
para-start])])
(if select?
(send text set-position new-start (send text get-end-position))
(send text set-position new-start new-start))))
(send keymap add-function "beginning-of-line/prompt"
(λ (text event) (beginning-of-line text #f)))
(send keymap add-function "select-to-beginning-of-line/prompt"
(λ (text event) (beginning-of-line text #t)))
(send keymap add-function "put-previous-sexp" (send keymap add-function "put-previous-sexp"
(λ (text event) (λ (text event)
(send text copy-prev-previous-expr))) (send text copy-prev-previous-expr)))
@ -330,6 +350,11 @@ TODO
(λ (text event) (λ (text event)
(send text copy-next-previous-expr))) (send text copy-next-previous-expr)))
(send keymap map-function "c:a" "beginning-of-line/prompt")
(send keymap map-function "s:c:a" "select-to-beginning-of-line/prompt")
(send keymap map-function "home" "beginning-of-line/prompt")
(send keymap map-function "s:home" "select-to-beginning-of-line/prompt")
(keymap:send-map-function-meta keymap "p" "put-previous-sexp") (keymap:send-map-function-meta keymap "p" "put-previous-sexp")
(keymap:send-map-function-meta keymap "n" "put-next-sexp") (keymap:send-map-function-meta keymap "n" "put-next-sexp")
(send keymap map-function "c:up" "put-previous-sexp") (send keymap map-function "c:up" "put-previous-sexp")