From f6bb5ea5e79575971199896523de61310a5245a2 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Sun, 2 Nov 2008 04:30:03 +0000 Subject: [PATCH] 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 | 16 +++------------- collects/framework/main.ss | 16 ++++++++++++++++ collects/framework/private/editor.ss | 19 ++++++++++++++----- collects/framework/private/frame.ss | 8 ++++---- collects/framework/private/keymap.ss | 8 ++++++-- collects/framework/private/sig.ss | 4 +++- collects/framework/private/text.ss | 2 +- collects/scribblings/framework/editor.scrbl | 4 ++-- 8 files changed, 49 insertions(+), 28 deletions(-) diff --git a/collects/drscheme/private/rep.ss b/collects/drscheme/private/rep.ss index ede0a0a874..777472a8d6 100644 --- a/collects/drscheme/private/rep.ss +++ b/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))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; diff --git a/collects/framework/main.ss b/collects/framework/main.ss index c6a4febfcf..13817b08a7 100644 --- a/collects/framework/main.ss +++ b/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?) diff --git a/collects/framework/private/editor.ss b/collects/framework/private/editor.ss index 6265bc3557..70a0a0c48d 100644 --- a/collects/framework/private/editor.ss +++ b/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<%> diff --git a/collects/framework/private/frame.ss b/collects/framework/private/frame.ss index 1a68e649d0..da655a13c2 100644 --- a/collects/framework/private/frame.ss +++ b/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 diff --git a/collects/framework/private/keymap.ss b/collects/framework/private/keymap.ss index ca804ccc71..4c84f95c86 100644 --- a/collects/framework/private/keymap.ss +++ b/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) diff --git a/collects/framework/private/sig.ss b/collects/framework/private/sig.ss index d0c1521030..b96eef8d56 100644 --- a/collects/framework/private/sig.ss +++ b/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 diff --git a/collects/framework/private/text.ss b/collects/framework/private/text.ss index cb604244ff..cce4a88ec9 100644 --- a/collects/framework/private/text.ss +++ b/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) diff --git a/collects/scribblings/framework/editor.scrbl b/collects/scribblings/framework/editor.scrbl index c597d8bc37..7a29a05ada 100644 --- a/collects/scribblings/framework/editor.scrbl +++ b/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<%>)]{