suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

modified key bindings to enable ()/[] toggling using c:c;c:[

Browse Source
This commit is contained in:
John Clements 2010-08-10 11:16:51 -04:00
parent a10cd9d14d
commit 0f0438479e
1 changed files with 46 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
collects/framework/private/scheme.rkt
View File

@ -10,7 +10,8 @@
"collapsed-snipclass-helpers.ss" "collapsed-snipclass-helpers.ss"
"sig.ss" "sig.ss"
"../gui-utils.ss" "../gui-utils.ss"
"../preferences.ss") "../preferences.ss"
scheme/match)
(import mred^ (import mred^
[prefix preferences: framework:preferences^] [prefix preferences: framework:preferences^]
@ -316,10 +317,10 @@
(define (short-sym->style-name sym) (define (short-sym->style-name sym)
(hash-ref sn-hash sym (hash-ref sn-hash sym
(λ () (λ ()
(let ([s (format "framework:syntax-color:scheme:~a" (let ([s (format "framework:syntax-color:scheme:~a"
(xlate-sym-style sym))]) (xlate-sym-style sym))])
(hash-set! sn-hash sym s) (hash-set! sn-hash sym s)
s)))) s))))
(define (add-coloring-preferences-panel) (define (add-coloring-preferences-panel)
(color-prefs:add-to-preferences-panel (color-prefs:add-to-preferences-panel
@ -373,7 +374,8 @@
introduce-let-ans introduce-let-ans
move-sexp-out move-sexp-out
kill-enclosing-parens)) kill-enclosing-parens
toggle-round-square-parens))
(define init-wordbreak-map (define init-wordbreak-map
(λ (map) (λ (map)
@ -1051,16 +1053,43 @@
(let ([begin-outer (find-up-sexp begin-inner)]) (let ([begin-outer (find-up-sexp begin-inner)])
(cond (cond
[begin-outer [begin-outer
(let ([end-outer (get-forward-sexp begin-outer)]) (let ([end-outer (get-forward-sexp begin-outer)])
(cond (cond
[(and end-outer (> (- end-outer begin-outer) 2)) [(and end-outer (> (- end-outer begin-outer) 2))
(delete (- end-outer 1) end-outer) (delete (- end-outer 1) end-outer)
(delete begin-outer (+ begin-outer 1)) (delete begin-outer (+ begin-outer 1))
(tabify-selection begin-outer (- end-outer 2))] (tabify-selection begin-outer (- end-outer 2))]
[else (bell)]))] [else (bell)]))]
[else (bell)])) [else (bell)]))
(end-edit-sequence)) (end-edit-sequence))
;; change the parens following the cursor from () to [] or vice versa
(define/public (toggle-round-square-parens start-pos)
(begin-edit-sequence)
(let* ([sexp-begin (skip-whitespace start-pos 'forward #f)]
[sexp-end (get-forward-sexp sexp-begin)])
(cond [(and sexp-end
(< (+ 1 sexp-begin) sexp-end))
;; positions known to exist: start-pos <= x < sexp-end
(match* ((get-character sexp-begin) (get-character (- sexp-end 1)))
[(#\( #\)) (replace-char-at-posn sexp-begin "[")
(replace-char-at-posn (- sexp-end 1) "]")]
[(#\[ #\]) (replace-char-at-posn sexp-begin "(")
(replace-char-at-posn (- sexp-end 1) ")")]
[(_ _) (bell)])]
[else (bell)]))
(end-edit-sequence))
;; replace-char-at-posn: natural-number string ->
;; replace the char at the given posn with the given string.
;;
;; this abstraction exists because the duplicated code in toggle-round-square-parens was
;; just a little too much for comfort
(define (replace-char-at-posn posn str)
;; insertions are performed before deletions in order to preserve the location of the cursor
(insert str (+ posn 1) (+ posn 1))
(delete posn (+ posn 1)))
(inherit get-fixed-style) (inherit get-fixed-style)
(define/public (mark-matching-parenthesis pos) (define/public (mark-matching-parenthesis pos)
(let ([open-parens (map car (scheme-paren:get-paren-pairs))] (let ([open-parens (map car (scheme-paren:get-paren-pairs))]
@ -1255,6 +1284,8 @@
(λ (e p) (send e move-sexp-out p))) (λ (e p) (send e move-sexp-out p)))
(add-pos-function "kill-enclosing-parens" (add-pos-function "kill-enclosing-parens"
(lambda (e p) (send e kill-enclosing-parens p))) (lambda (e p) (send e kill-enclosing-parens p)))
(add-pos-function "toggle-round-square-parens"
(lambda (e p) (send e toggle-round-square-parens p)))
(let ([add-edit-function (let ([add-edit-function
(λ (name call-method) (λ (name call-method)
@ -1381,7 +1412,8 @@
(send keymap map-function "c:c;c:b" "remove-parens-forward") (send keymap map-function "c:c;c:b" "remove-parens-forward")
(send keymap map-function "c:c;c:l" "introduce-let-ans") (send keymap map-function "c:c;c:l" "introduce-let-ans")
(send keymap map-function "c:c;c:o" "move-sexp-out") (send keymap map-function "c:c;c:o" "move-sexp-out")
(send keymap map-function "c:c;c:e" "kill-enclosing-parens"))) (send keymap map-function "c:c;c:e" "kill-enclosing-parens")
(send keymap map-function "c:c;c:[" "toggle-round-square-parens")))
(define keymap (make-object keymap:aug-keymap%)) (define keymap (make-object keymap:aug-keymap%))
(setup-keymap keymap) (setup-keymap keymap)