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

use the new extend-position functionality to adjust the shift-based key bindings implemented in the framework

Browse Source 
closes PR 11768
  closes PR 11806

original commit: e6633d2af11d44117cf3b5226cb3d6f9bed60427
This commit is contained in:
Robby Findler 2011-03-04 09:32:01 -06:00
parent 0f24a8666e
commit 3574ae0192
2 changed files with 28 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1020,11 +1020,19 @@
[find-beginning-of-line [find-beginning-of-line
(λ (txt) (λ (txt)
(define pos-to-start-with
(cond
[(= (send txt get-extend-start-position)
(send txt get-start-position))
(send txt get-end-position)]
[else
(send txt get-start-position)]))
(cond (cond
[(is-a? txt text:basic<%>) [(is-a? txt text:basic<%>)
(send txt get-start-of-line (send txt get-start-position))] (send txt get-start-of-line pos-to-start-with)]
[(is-a? txt text%) [(is-a? txt text%)
(send txt line-start-position (send txt position-line (send txt get-start-position)))] (send txt line-start-position (send txt position-line pos-to-start-with))]
[else #f]))] [else #f]))]
[beginning-of-line [beginning-of-line
(λ (txt event) (λ (txt event)
@ -1035,7 +1043,7 @@
(λ (txt event) (λ (txt event)
(define pos (find-beginning-of-line txt)) (define pos (find-beginning-of-line txt))
(when pos (when pos
(send txt set-position pos (send txt get-end-position))))]) (send txt extend-position pos)))])
(λ (kmap) (λ (kmap)
(let* ([map (λ (key func) (let* ([map (λ (key func)

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

@ -413,7 +413,10 @@
end-edit-sequence end-edit-sequence
local-edit-sequence? local-edit-sequence?
find-string find-string
extend-position
get-character get-character
get-extend-end-position
get-extend-start-position
get-keymap get-keymap
get-text get-text
get-start-position get-start-position
@ -1018,16 +1021,20 @@
#t))] #t))]
(define/private (select-text f forward?) (define/private (select-text f forward?)
(let* ([start-pos (get-start-position)] (define start-pos (get-start-position))
[end-pos (get-end-position)]) (define end-pos (get-end-position))
(let-values ([(new-start new-end) (define new-pos
(if forward? (if forward?
(values start-pos (f end-pos)) (if (= (get-extend-start-position) start-pos)
(values (f start-pos) end-pos))]) (f end-pos)
(if (and new-start new-end) (f start-pos))
(set-position new-start new-end) (if (= (get-extend-end-position) end-pos)
(bell)) (f start-pos)
#t))) (f end-pos))))
(if new-pos
(extend-position new-pos)
(bell))
#t)
(public select-forward-sexp select-backward-sexp select-up-sexp select-down-sexp) (public select-forward-sexp select-backward-sexp select-up-sexp select-down-sexp)
[define select-forward-sexp (λ () (select-text (λ (x) (get-forward-sexp x)) #t))] [define select-forward-sexp (λ () (select-text (λ (x) (get-forward-sexp x)) #t))]
[define select-backward-sexp (λ () (select-text (λ (x) (get-backward-sexp x)) #f))] [define select-backward-sexp (λ () (select-text (λ (x) (get-backward-sexp x)) #f))]