changed around the keymap setup again; now should be in same order as it was before my earlier changed, except the user-specified keybindings should be first

svn: r12214

collects/drscheme/private/rep.ss

@@ -312,7 +312,7 @@ TODO
   (define drs-bindings-keymap-mixin
     (mixin (editor:keymap<%>) (editor:keymap<%>)
       (define/override (get-keymaps)
-        (append (super get-keymaps) (list drs-bindings-keymap)))
+        (editor:add-after-user-keymap drs-bindings-keymap (super get-keymaps)))
       (super-instantiate ())))
   
   ;; Max length of output queue (user's thread blocks if the
@@ -848,18 +848,8 @@ TODO
         (inner (void) after-delete x y))
       
       (define/override (get-keymaps)
-        (let loop ([old-maps (super get-keymaps)])
-          (cond
-            [(null? old-maps) 
-             (list scheme-interaction-mode-keymap)]
-            [else
-             (cond
-               [(eq? (car old-maps) (keymap:get-global))
-                (list* (car old-maps)
-                       scheme-interaction-mode-keymap
-                       (cdr old-maps))]
-               [else
-                (cons (car old-maps) (loop (cdr old-maps)))])])))
+        (editor:add-after-user-keymap scheme-interaction-mode-keymap
+                                      (super get-keymaps)))
       
       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
       ;;;                                            ;;;

collects/framework/main.ss

@@ -987,6 +987,13 @@
   (-> (is-a?/c keymap%))
   ()
   @{This returns a keymap for handling file operations.})
+
+ (proc-doc/names
+  keymap:get-user
+  (-> (is-a?/c keymap%))
+  ()
+  @{This returns a keymap that contains all of the keybindings in the keymaps loaded via @scheme[keymap:add-user-keybindings-file]})
+
  
  (proc-doc/names
   keymap:get-global
@@ -1383,6 +1390,15 @@
   @{Returns a style list that is used for all instances of
             @scheme[editor:standard-style-list%].})
  
+ (proc-doc/names
+  editor:add-after-user-keymap
+  (-> (is-a?/c keymap%) (listof (is-a?/c keymap%)) (listof (is-a?/c keymap%)))
+  (keymap keymaps)
+  @{Returns a list that contains all of the keymaps in @scheme[keymaps], in the
+    same relative order, but also with @scheme[keymap], where @scheme[keymap]
+    is now the first keymap after @scheme[keymap:get-user] (if that keymap is
+    in the list.)})
+ 
  (proc-doc/names
   color-model:rgb->xyz
   (number? number? number? . -> . color-model:xyz?)

collects/framework/private/editor.ss

@@ -428,17 +428,26 @@
   (define -keymap<%> (interface (basic<%>) get-keymaps))
   (define keymap-mixin
     (mixin (basic<%>) (-keymap<%>)
-      [define/public get-keymaps
-        (λ ()
-          (list (keymap:get-global)))]
+      (define/public (get-keymaps)
+        (list (keymap:get-user) (keymap:get-global)))
       (inherit set-keymap)
       
-      (super-instantiate ())
+      (super-new)
       (let ([keymap (make-object keymap:aug-keymap%)])
         (set-keymap keymap)
         (for-each (λ (k) (send keymap chain-to-keymap k #f))
                   (get-keymaps)))))
   
+  (define (add-after-user-keymap km kms)
+    (let loop ([kms kms])
+      (cond
+        [(null? kms) (list km)]
+        [else
+         (let ([f (car kms)])
+           (if (eq? f (keymap:get-user))
+               (list* f km (cdr kms))
+               (cons f (loop (cdr kms)))))])))
+  
   (define autowrap<%> (interface (basic<%>)))
   (define autowrap-mixin
     (mixin (basic<%>) (autowrap<%>)
@@ -505,7 +514,7 @@
       (define/public (get-can-close-parent) #f)
       
       (define/override (get-keymaps)
-        (append (super get-keymaps) (list (keymap:get-file))))
+        (add-after-user-keymap (keymap:get-file) (super get-keymaps)))
       (super-new)))
   
   (define backup-autosave<%>

collects/framework/private/frame.ss

@@ -1691,7 +1691,7 @@
                                   (loop (send snip next)))]
                            [else (cons snip (loop (send snip next)))]))))
     (define/override (get-keymaps)
-      (append (super get-keymaps) (list search/replace-keymap)))
+      (editor:add-after-user-keymap search/replace-keymap (super get-keymaps)))
     (super-new)
     (inherit set-styles-fixed)
     (set-styles-fixed #t)
@@ -1889,7 +1889,7 @@
     (inherit set-styles-fixed)
     (super-new [pref-sym 'framework:replace-string])
     (define/override (get-keymaps)
-      (append (super get-keymaps) (list search/replace-keymap)))
+      (editor:add-after-user-keymap search/replace-keymap (super get-keymaps)))
     (set-styles-fixed #t)))
 
 (define search/replace-keymap (new keymap%))
@@ -1952,6 +1952,7 @@
         (set! red? r?)
         (refresh)))
     (define/override (on-paint)
+      (super on-paint)
       (when red?
         (let ([dc (get-dc)])
           (let-values ([(cw ch) (get-client-size)])
@@ -1961,8 +1962,7 @@
               (send dc set-brush "pink" 'solid)
               (send dc draw-rectangle 0 0 cw ch)
               (send dc set-pen pen)
-              (send dc set-brush brush)))))
-      (super on-paint))
+              (send dc set-brush brush))))))
     (super-new)))
 
 (define-local-member-name 

collects/framework/private/keymap.ss

@@ -27,7 +27,8 @@
      (λ ()
        (let* ([path (spec->path spec)]
               [sexp (and (file-exists? path)
-                         (call-with-input-file path read))])
+                         (parameterize ([read-accept-reader #t])
+                           (call-with-input-file path read)))])
          (match sexp
            [`(module ,name ,(or `(lib "keybinding-lang.ss" "framework")
                                 `(lib "framework/keybinding-lang.ss")
@@ -35,7 +36,7 @@
                ,@(x ...)) 
             (let ([km (dynamic-require spec '#%keymap)])
               (hash-set! user-keybindings-files spec km)
-              (send global chain-to-keymap km #t))]
+              (send user-keymap chain-to-keymap km #t))]
            [else (error 'add-user-keybindings-file 
                         (string-constant user-defined-keybinding-malformed-file)
                         (path->string path))])))))
@@ -1403,6 +1404,9 @@
     (add-pasteboard-keymap-functions keymap)
     (add-text-keymap-functions keymap))
   
+  (define user-keymap (make-object aug-keymap%))
+  (define (get-user) user-keymap)
+  
   (define global (make-object aug-keymap%))
   (define global-main (make-object aug-keymap%))
   (send global chain-to-keymap global-main #f)

collects/framework/private/sig.ss

@@ -145,7 +145,8 @@
      set-standard-style-list-pref-callbacks
      set-standard-style-list-delta
      set-default-font-color
-     get-default-color-style-name))
+     get-default-color-style-name
+     add-after-user-keymap))
   
   (define-signature pasteboard-class^
     (basic%
@@ -351,6 +352,7 @@
      setup-file
      setup-editor
      
+     get-user
      get-global
      get-search
      get-file

collects/framework/private/text.ss

@@ -928,7 +928,7 @@ WARNING: printf is rebound in the body of the unit to always
              find-string)
     
     (define/override (get-keymaps)
-      (append (super get-keymaps) (list (keymap:get-search))))
+      (editor:add-after-user-keymap (keymap:get-search) (super get-keymaps)))
     
     (define searching-str #f)
     (define case-sensitive? #f)

collects/scribblings/framework/editor.scrbl

@@ -278,9 +278,9 @@
     should return the same list of keymaps each time it is
     called.
 
+    See also @scheme[editor:add-after-user-keymap].
 
-    Defaultly returns @scheme[(list
-    @scheme[keymap:get-global])]
+    Defaultly returns @scheme[(list (keymap:get-user) (keymap:get-global))]
   }
 }
 @defmixin[editor:keymap-mixin (editor:basic<%>) (editor:keymap<%>)]{