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

setup hooks so that the behavior of the home / c:a keybinings delegates to a method to find where to go

Browse Source 
then, use that to change how it works for the scheme mode (and also another variation for the REPL to
cope with the prompt)

I spent a while trying to make this work at the keymap% level (ie putting different keybindings for "home"
and "c:a" into different keymaps) but this just turned out to be far too confusing and fragile, so went
with this alternative (one keybinding, but that delegates to an overridable method)

closes PR 11446
This commit is contained in:
Robby Findler 2011-01-09 16:22:28 -06:00
parent ad47d346ba
commit d2cb96bcb3
6 changed files with 97 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
collects/drracket/private/rep.rkt
View File

@ -335,26 +335,6 @@ TODO
(define setup-scheme-interaction-mode-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"
(λ (text event)
(send text copy-prev-previous-expr)))
@ -362,11 +342,6 @@ TODO
(λ (text event)
(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 "n" "put-next-sexp")
(send keymap map-function "c:up" "put-previous-sexp")
@ -1832,6 +1807,35 @@ TODO
(and (not (null? canvases))
(car canvases)))))
(inherit paragraph-end-position)
(define/override (get-start-of-line pos)
(define para (position-paragraph pos))
(define para-start (paragraph-start-position para))
(define para-end (paragraph-end-position para))
(define after-prompt-start
(let* ([prompt (get-prompt)]
[para-start-text (get-text para-start (+ para-start (string-length prompt)))])
(cond
[(equal? prompt para-start-text)
(+ para-start (string-length prompt))]
[else
para-start])))
(define first-non-whitespace
(let loop ([i after-prompt-start])
(cond
[(= i para-end) #f]
[(char-whitespace? (get-character i))
(loop (+ i 1))]
[else i])))
(define new-pos
(cond
[(not first-non-whitespace) after-prompt-start]
[(< pos after-prompt-start) after-prompt-start]
[(= pos after-prompt-start) first-non-whitespace]
[(<= pos first-non-whitespace) after-prompt-start]
[else first-non-whitespace]))
new-pos)
(super-new)
(auto-wrap #t)
(set-styles-sticky #f)

33
collects/framework/private/keymap.rkt
View File

@ -14,7 +14,8 @@
[prefix finder: framework:finder^]
[prefix handler: framework:handler^]
[prefix frame: framework:frame^]
[prefix editor: framework:editor^])
[prefix editor: framework:editor^]
[prefix text: framework:text^])
(export (rename framework:keymap^
[-get-file get-file]))
(init-depend mred^)
@ -1013,7 +1014,28 @@
(send text end-edit-sequence))))))))]
[greek-letters "αβγδεζηθι κλμνξοπρςστυφχψω"]
[Greek-letters "ΑΒΓΔΕΖΗΘΙ ΚΛΜΝΞΟΠΡ ΣΤΥΦΧΨΩ"]) ;; don't have a capital ς, just comes out as \u03A2 (or junk)
[Greek-letters "ΑΒΓΔΕΖΗΘΙ ΚΛΜΝΞΟΠΡ ΣΤΥΦΧΨΩ"]
;; don't have a capital ς, just comes out as \u03A2 (or junk)
[find-beginning-of-line
(λ (txt)
(cond
[(is-a? txt text:basic<%>)
(send txt get-start-of-line (send txt get-start-position))]
[(is-a? txt text%)
(send txt line-start-position (send txt position-line (send txt get-start-position)))]
[else #f]))]
[beginning-of-line
(λ (txt event)
(define pos (find-beginning-of-line txt))
(when pos
(send txt set-position pos pos)))]
[select-to-beginning-of-line
(λ (txt event)
(define pos (find-beginning-of-line txt))
(when pos
(send txt set-position pos (send txt get-end-position))))])
(λ (kmap)
(let* ([map (λ (key func)
@ -1103,6 +1125,9 @@
(add "mouse-popup-menu" mouse-popup-menu)
(add "make-read-only" make-read-only)
(add "beginning-of-line" beginning-of-line)
(add "selec-to-beginning-of-line" select-to-beginning-of-line)
; Map keys to functions
@ -1442,13 +1467,13 @@
(define global (make-object aug-keymap%))
(define global-main (make-object aug-keymap%))
(send global chain-to-keymap global-main #f)
(setup-global global-main)
(generic-setup global-main)
(setup-global global-main)
(define (get-global) global)
(define file (make-object aug-keymap%))
(setup-file file)
(generic-setup file)
(setup-file file)
(define (-get-file) file)
(define search (make-object aug-keymap%))

22
collects/framework/private/scheme.rkt
View File

@ -1171,6 +1171,26 @@
[else
(insert-paren this)]))
(define/override (get-start-of-line pos)
(define para (position-paragraph pos))
(define para-start (paragraph-start-position para))
(define para-end (paragraph-end-position para))
(define first-non-whitespace
(let loop ([i para-start])
(cond
[(= i para-end) #f]
[(char-whitespace? (get-character i))
(loop (+ i 1))]
[else i])))
(define new-pos
(cond
[(not first-non-whitespace) para-start]
[(= pos para-start) first-non-whitespace]
[(<= pos first-non-whitespace) para-start]
[else first-non-whitespace]))
new-pos)
(super-new)))
(define -text-mode<%>
@ -1409,7 +1429,7 @@
(map-meta "c:space" "select-forward-sexp")
(map-meta "c:t" "transpose-sexp")
;(map-meta "c:m" "mark-matching-parenthesis")
; this keybinding doesn't interact with the paren colorer
)

8
collects/framework/private/text.rkt
View File

@ -73,7 +73,8 @@
move/copy-to-edit
initial-autowrap-bitmap
get-port-name
port-name-matches?))
port-name-matches?
get-start-of-line))
(define basic-mixin
(mixin (editor:basic<%> (class->interface text%)) (basic<%>)
@ -533,9 +534,13 @@
""
parent)))
(define/public (get-start-of-line pos)
(line-start-position (position-line pos)))
(super-new)
(set-autowrap-bitmap (initial-autowrap-bitmap))))
(define (hash-cons! h k v) (hash-set! h k (cons v (hash-ref h k '()))))
(define first-line<%>
@ -3974,7 +3979,6 @@ designates the character that triggers autocompletion
(super-new)
(setup-padding)))
(define basic% (basic-mixin (editor:basic-mixin text%)))
(define hide-caret/selection% (hide-caret/selection-mixin basic%))
(define nbsp->space% (nbsp->space-mixin basic%))

5
collects/scribblings/framework/scheme.scrbl
View File

@ -234,6 +234,11 @@
as the prefix for auto-completion.
}
@defmethod[#:mode override (get-start-of-line [pos exact-nonnegative-integer?]) exact-nonnegative-integer?]{
Returns the first non-whitespace character in the paragraph containing @racket[pos],
unless the position is already there, in which case it returns the first position of the paragraph.
}
}
@definterface[scheme:text-mode<%> ()]{
The result of

7
collects/scribblings/framework/text.scrbl
View File

@ -141,6 +141,13 @@
The number is updated in @xmethod[text% after-insert] and
@xmethod[text% after-delete].
}
@defmethod[(get-start-of-line [pos exact-nonnegative-integer?]) exact-nonnegative-integer?]{
This method is used by @racket[keymap:setup-global] to implement
a keybinding for the @racket["home"] key and for @racket["c:a"].
Its default implementation is @racket[(#,(method text% line-start-position) (#,(method text% position-line) pos))].
}
}
@defmixin[text:basic-mixin (editor:basic<%> text%) (text:basic<%>)]{