From 3574ae0192bdcea06361651f7616a64eb11856d9 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Fri, 4 Mar 2011 09:32:01 -0600
Subject: [PATCH] use the new extend-position functionality to adjust the
 shift-based key bindings implemented in the framework   closes PR 11768  
 closes PR 11806

original commit: e6633d2af11d44117cf3b5226cb3d6f9bed60427
---
 collects/framework/private/keymap.rkt | 14 +++++++++++---
 collects/framework/private/scheme.rkt | 27 +++++++++++++++++----------
 2 files changed, 28 insertions(+), 13 deletions(-)

diff --git a/collects/framework/private/keymap.rkt b/collects/framework/private/keymap.rkt
index 54fca114..d5980a8f 100644
--- a/collects/framework/private/keymap.rkt
+++ b/collects/framework/private/keymap.rkt
@@ -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) 
diff --git a/collects/framework/private/scheme.rkt b/collects/framework/private/scheme.rkt
index 6bf517c1..1c43aeae 100644
--- a/collects/framework/private/scheme.rkt
+++ b/collects/framework/private/scheme.rkt
@@ -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)
-                      (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)
-              (bell))
-          #t)))
+      (define start-pos (get-start-position))
+      (define end-pos (get-end-position))
+      (define new-pos
+        (if forward?
+            (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)
     (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))]