From 547c8d98d3b6aa4f7608d4bb6094346f16dfdc1b Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Wed, 14 Jun 2000 05:08:14 +0000
Subject: [PATCH] ...

original commit: e3b8c4eb14bda5718c28fc1357d20c290c416697
---
 collects/framework/frame.ss      | 18 ++++++++++++++++--
 collects/framework/frameworks.ss |  2 ++
 collects/framework/keymap.ss     | 27 +++++++++++++++++++++++++++
 3 files changed, 45 insertions(+), 2 deletions(-)

diff --git a/collects/framework/frame.ss b/collects/framework/frame.ss
index d15ecb68..448871db 100644
--- a/collects/framework/frame.ss
+++ b/collects/framework/frame.ss
@@ -799,16 +799,30 @@
 		     (send to insert (send snip copy))
 		     (loop (send snip next)))))]
 	      
+	      [text-keymap/editor%
+	       (class text:keymap% args
+		 (rename [super-get-keymaps get-keymaps])
+		 (override
+		  [get-keymaps
+		   (lambda ()
+		     (if (preferences:get 'framework:menu-bindings)
+			 (append (list (keymap:get-editor))
+				 (super-get-keymaps))
+			 (append (super-get-keymaps)
+				 (list (keymap:get-editor)))))])
+		 (sequence
+		   (apply super-init args)))]
+		   
 
 	      [find-panel (make-object horizontal-panel% dialog)]
 	      [find-message (make-object message% "Find" find-panel)]
-	      [f-text (make-object text%)]
+	      [f-text (make-object text-keymap/editor%)]
 	      [find-canvas (make-object editor-canvas% find-panel f-text
 					'(hide-hscroll hide-vscroll))]
 
 	      [replace-panel (make-object horizontal-panel% dialog)]
 	      [replace-message (make-object message% "Replace" replace-panel)]
-	      [r-text (make-object text%)]
+	      [r-text (make-object text-keymap/editor%)]
 	      [replace-canvas (make-object editor-canvas% replace-panel r-text
 					   '(hide-hscroll hide-vscroll))]
 
diff --git a/collects/framework/frameworks.ss b/collects/framework/frameworks.ss
index 93467470..1c1ec32e 100644
--- a/collects/framework/frameworks.ss
+++ b/collects/framework/frameworks.ss
@@ -226,10 +226,12 @@
    setup-global
    setup-search
    setup-file
+   setup-editor
 
    get-global
    get-search
    get-file
+   get-editor
 
    call/text-keymap-initializer))
 
diff --git a/collects/framework/keymap.ss b/collects/framework/keymap.ss
index 1f196d61..de65e90f 100644
--- a/collects/framework/keymap.ss
+++ b/collects/framework/keymap.ss
@@ -1053,6 +1053,29 @@
 	  (map "c:x;c:w" "save-file-as")
 	  (map "c:x;c:f" "load-file")))))
   
+  (define (setup-editor kmap)
+    (let ([add/map
+	   (lambda (func op key)
+	     (send kmap add-function
+		   func
+		   (lambda (editor evt)
+		     (send editor do-edit-operation op)))
+	     (send kmap map-function
+		   (string-append
+		    (case (system-type)
+		      [(macos) "d:"]
+		      [(windows) "c:"]
+		      [(unix) "a:"]
+		      [else (error 'keymap.ss "unknown platform: ~s" (system-type))])
+		    key)
+		   func))])
+      (add/map "editor-undo" 'undo "z")
+      (add/map "editor-redo" 'redo "y")
+      (add/map "editor-cut" 'cut "x")
+      (add/map "editor-copy" 'copy "c")
+      (add/map "editor-paste" 'paste "v")
+      (add/map "editor-select-all" 'select-all "a")))
+
   (define (generic-setup keymap)
     (add-editor-keymap-functions keymap)
     (add-pasteboard-keymap-functions keymap)
@@ -1073,6 +1096,10 @@
   (setup-search search)
   (define (get-search) search)
 
+  (define editor (make-object aug-keymap%))
+  (setup-editor editor)
+  (define (get-editor) editor)
+
   (define (call/text-keymap-initializer thunk)
     (let ([ctki (current-text-keymap-initializer)])
       (parameterize ([current-text-keymap-initializer