diff --git a/collects/framework/private/keymap.rkt b/collects/framework/private/keymap.rkt index d6db3db426..62b6a4a812 100644 --- a/collects/framework/private/keymap.rkt +++ b/collects/framework/private/keymap.rkt @@ -10,6 +10,7 @@ (only-in srfi/13 string-prefix? string-prefix-length) "sig.rkt") + (import mred^ [prefix finder: framework:finder^] [prefix handler: framework:handler^] @@ -19,7 +20,12 @@ (export (rename framework:keymap^ [-get-file get-file])) (init-depend mred^) - + +;; if I put this in main.rkt with the others, it doesn't happen +;; early enough... ? JBC, 2011-07-12 +(preferences:set-default 'framework:automatic-parens #f boolean?) + + (define user-keybindings-files (make-hash)) (define (add-user-keybindings-file spec) @@ -1093,6 +1099,15 @@ (add "insert-\"\"-pair" (make-insert-brace-pair "\"" "\"")) (add "insert-||-pair" (make-insert-brace-pair "|" "|")) (add "insert-lambda-template" insert-lambda-template) + ;; HACK: in order to allow disabling of insert-pair bindings, + ;; I'm adding functions that simply insert the corresponding + ;; character. I bet there's a much cleaner way to do this; + ;; there may be existing functions that insert single characters, + ;; or a way to "pop" bindings off of a keybindings. + (add "insert (" (lambda (txt evt) (send txt insert #\())) + (add "insert {" (lambda (txt evt) (send txt insert #\{))) + (add "insert \"" (lambda (txt evt) (send txt insert #\"))) + (add "toggle-anchor" toggle-anchor) (add "center-view-on-line" center-view-on-line) @@ -1340,6 +1355,25 @@ (map "c:f6" "shift-focus") (map "a:tab" "shift-focus") (map "a:s:tab" "shift-focus-backwards") + + (let () + (define (add-automatic-paren-bindings) + (map "~c:s:(" "insert-()-pair") + (map "~c:s:{" "insert-{}-pair") + (map "~c:s:\"" "insert-\"\"-pair")) + (define (remove-automatic-paren-bindings) + ;; how the heck is this going to work? we want to "pop" these bindings off... + ;; this is a crude approximation: + (map "~c:s:(" "insert (") + (map "~c:s:{" "insert {") + (map "~c:s:\"" "insert \"")) + (when (preferences:get 'framework:automatic-parens) + (add-automatic-paren-bindings)) + (preferences:add-callback + 'framework:automatic-parens + (lambda (id new-val) + (cond [new-val (add-automatic-paren-bindings)] + [else (remove-automatic-paren-bindings)])))) )))) (define setup-search diff --git a/collects/framework/private/preferences.rkt b/collects/framework/private/preferences.rkt index c8077342ea..a048185d86 100644 --- a/collects/framework/private/preferences.rkt +++ b/collects/framework/private/preferences.rkt @@ -497,6 +497,10 @@ the state transitions / contracts are: 'framework:overwrite-mode-keybindings (string-constant enable-overwrite-mode-keybindings) values values) + (make-check editor-panel + 'framework:automatic-parens + (string-constant enable-automatic-parens) + values values) (editor-panel-procs editor-panel))))]) (add-editor-checkbox-panel))) diff --git a/collects/framework/private/scheme.rkt b/collects/framework/private/scheme.rkt index a5ad3f8286..ea12c50de7 100644 --- a/collects/framework/private/scheme.rkt +++ b/collects/framework/private/scheme.rkt @@ -34,6 +34,8 @@ (init-depend mred^ framework:keymap^ framework:color^ framework:mode^ framework:text^ framework:editor^) + + (define (scheme-paren:get-paren-pairs) '(("(" . ")") ("[" . "]") @@ -575,7 +577,7 @@ (let* ([text (get-text contains id-end)]) (or (get-keyword-type text tabify-prefs) 'other)))))] - [procedure-indent + [procedure-indent (λ () (case (get-proc) [(begin define) 1] diff --git a/collects/string-constants/private/english-string-constants.rkt b/collects/string-constants/private/english-string-constants.rkt index 7695f33239..cc6d97c24e 100644 --- a/collects/string-constants/private/english-string-constants.rkt +++ b/collects/string-constants/private/english-string-constants.rkt @@ -722,6 +722,8 @@ please adhere to these guidelines: (overwrite-mode "Overwrite Mode") (enable-overwrite-mode-keybindings "Enable overwrite mode keybindings") + (enable-automatic-parens "Enable automatic parentheses") ; should "and square brackets and quotes" appear here? + (preferences-info "Configure your preferences") (preferences-menu-item "Preferences...")