From 08dbf9be69a9c87f27ef0f23ebeff2d4049d945e Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Sun, 9 Jan 2011 16:22:28 -0600
Subject: [PATCH] setup hooks so that the behavior of the home / c:a keybinings
 delegates to a method to find where to go 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

original commit: d2cb96bcb39d93f6dac92906bed9885828663798
---
 collects/framework/private/keymap.rkt       | 33 ++++++++++++++++++---
 collects/framework/private/scheme.rkt       | 22 +++++++++++++-
 collects/framework/private/text.rkt         |  8 +++--
 collects/scribblings/framework/scheme.scrbl |  5 ++++
 collects/scribblings/framework/text.scrbl   |  7 +++++
 5 files changed, 68 insertions(+), 7 deletions(-)

diff --git a/collects/framework/private/keymap.rkt b/collects/framework/private/keymap.rkt
index 905f311a..ab94d1bd 100644
--- a/collects/framework/private/keymap.rkt
+++ b/collects/framework/private/keymap.rkt
@@ -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%))
diff --git a/collects/framework/private/scheme.rkt b/collects/framework/private/scheme.rkt
index e9da20f0..54bd2403 100644
--- a/collects/framework/private/scheme.rkt
+++ b/collects/framework/private/scheme.rkt
@@ -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
       )
diff --git a/collects/framework/private/text.rkt b/collects/framework/private/text.rkt
index ef6b892c..f3b48f1a 100644
--- a/collects/framework/private/text.rkt
+++ b/collects/framework/private/text.rkt
@@ -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%))
diff --git a/collects/scribblings/framework/scheme.scrbl b/collects/scribblings/framework/scheme.scrbl
index 8684d2fd..270af5a7 100644
--- a/collects/scribblings/framework/scheme.scrbl
+++ b/collects/scribblings/framework/scheme.scrbl
@@ -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
diff --git a/collects/scribblings/framework/text.scrbl b/collects/scribblings/framework/text.scrbl
index 74c739d8..7aa92bce 100644
--- a/collects/scribblings/framework/text.scrbl
+++ b/collects/scribblings/framework/text.scrbl
@@ -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<%>)]{