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

38
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^]
@ -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)
@ -1061,6 +1063,33 @@
[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)