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"
"sig.ss"
"../gui-utils.ss"
"../preferences.ss")
"../preferences.ss"
scheme/match)
(import mred^
[prefix preferences: framework:preferences^]
@ -316,10 +317,10 @@
(define (short-sym->style-name sym)
(hash-ref sn-hash sym
(λ ()
(let ([s (format "framework:syntax-color:scheme:~a"
(xlate-sym-style sym))])
(hash-set! sn-hash sym s)
s))))
(let ([s (format "framework:syntax-color:scheme:~a"
(xlate-sym-style sym))])
(hash-set! sn-hash sym s)
s))))
(define (add-coloring-preferences-panel)
(color-prefs:add-to-preferences-panel
@ -373,7 +374,8 @@
introduce-let-ans
move-sexp-out
kill-enclosing-parens))
kill-enclosing-parens
toggle-round-square-parens))
(define init-wordbreak-map
(λ (map)
@ -1051,16 +1053,43 @@
(let ([begin-outer (find-up-sexp begin-inner)])
(cond
[begin-outer
(let ([end-outer (get-forward-sexp begin-outer)])
(cond
[(and end-outer (> (- end-outer begin-outer) 2))
(delete (- end-outer 1) end-outer)
(delete begin-outer (+ begin-outer 1))
(tabify-selection begin-outer (- end-outer 2))]
[else (bell)]))]
(let ([end-outer (get-forward-sexp begin-outer)])
(cond
[(and end-outer (> (- end-outer begin-outer) 2))
(delete (- end-outer 1) end-outer)
(delete begin-outer (+ begin-outer 1))
(tabify-selection begin-outer (- end-outer 2))]
[else (bell)]))]
[else (bell)]))
(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)
(define/public (mark-matching-parenthesis pos)
(let ([open-parens (map car (scheme-paren:get-paren-pairs))]
@ -1255,6 +1284,8 @@
(λ (e p) (send e move-sexp-out p)))
(add-pos-function "kill-enclosing-parens"
(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
(λ (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:l" "introduce-let-ans")
(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%))
(setup-keymap keymap)