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
(λ (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
[(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%)
(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]))]
[beginning-of-line
(λ (txt event)
@ -1035,7 +1043,7 @@
(λ (txt event)
(define pos (find-beginning-of-line txt))
(when pos
(send txt set-position pos (send txt get-end-position))))])
(send txt extend-position pos)))])
(λ (kmap)
(let* ([map (λ (key func)

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

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