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

svn: r2396

Browse Source
This commit is contained in:
Robby Findler 2006-03-08 22:13:17 +00:00
parent 04836be213
commit c2c31213d2
1 changed files with 87 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
collects/framework/private/scheme.ss
View File

@ -339,7 +339,10 @@
transpose-sexp transpose-sexp
mark-matching-parenthesis mark-matching-parenthesis
get-tab-size get-tab-size
set-tab-size)) set-tab-size
introduce-let-ans
move-sexp-out))
(define init-wordbreak-map (define init-wordbreak-map
(λ (map) (λ (map)
@ -400,7 +403,7 @@
(inherit get-styles-fixed) (inherit get-styles-fixed)
(inherit has-focus? find-snip split-snip) (inherit has-focus? find-snip split-snip)
(public get-limit balance-parens tabify-on-return? tabify tabify-selection (public get-limit balance-parens tabify-on-return? tabify
tabify-all insert-return calc-last-para tabify-all insert-return calc-last-para
box-comment-out-selection comment-out-selection uncomment-selection box-comment-out-selection comment-out-selection uncomment-selection
get-forward-sexp remove-sexp forward-sexp flash-forward-sexp get-backward-sexp get-forward-sexp remove-sexp forward-sexp flash-forward-sexp get-backward-sexp
@ -557,7 +560,7 @@
(loop next-to-last next-to-last-para) (loop next-to-last next-to-last-para)
(do-indent (visual-offset last)))))]))))) (do-indent (visual-offset last)))))])))))
(define tabify-selection (define/public tabify-selection
(opt-lambda ([start-pos (get-start-position)] (opt-lambda ([start-pos (get-start-position)]
[end-pos (get-end-position)]) [end-pos (get-end-position)])
(let ([first-para (position-paragraph start-pos)] (let ([first-para (position-paragraph start-pos)]
@ -873,16 +876,36 @@
(set-position new-start new-end) (set-position new-start new-end)
(bell)) (bell))
#t))) #t)))
(public select-forward-sexp select-backward-sexp select-up-sexp select-down-sexp (public select-forward-sexp select-backward-sexp select-up-sexp select-down-sexp)
transpose-sexp mark-matching-parenthesis)
[define select-forward-sexp (λ () (select-text (λ (x) (get-forward-sexp x)) #t))] [define select-forward-sexp (λ () (select-text (λ (x) (get-forward-sexp x)) #t))]
[define select-backward-sexp (λ () (select-text (λ (x) (get-backward-sexp x)) #f))] [define select-backward-sexp (λ () (select-text (λ (x) (get-backward-sexp x)) #f))]
[define select-up-sexp (λ () (select-text (λ (x) (find-up-sexp x)) #f))] [define select-up-sexp (λ () (select-text (λ (x) (find-up-sexp x)) #f))]
[define select-down-sexp (λ () (select-text (λ (x) (find-down-sexp x)) #t))] [define select-down-sexp (λ () (select-text (λ (x) (find-down-sexp x)) #t))]
(define/public (introduce-let-ans pos)
(begin-edit-sequence)
(let ([before-text "(let ([ans "]
[after-text "])\n"]
[after-text2 "\nans)"]
[end-l (get-forward-sexp pos)])
(insert after-text2 end-l end-l)
(insert after-text end-l end-l)
(insert before-text pos pos)
(let ([blank-line-pos (+ end-l (string-length after-text) (string-length before-text))])
(set-position blank-line-pos blank-line-pos))
(tabify-selection
(- pos (string-length before-text))
(+ end-l
(string-length before-text)
(string-length after-text)
(string-length after-text2))))
(end-edit-sequence))
(define/public (move-sexp-out pos)
(void))
(inherit get-fixed-style) (inherit get-fixed-style)
(define (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))]
[close-parens (map cdr (scheme-paren:get-paren-pairs))]) [close-parens (map cdr (scheme-paren:get-paren-pairs))])
(when (member (string (get-character pos)) open-parens) (when (member (string (get-character pos)) open-parens)
@ -901,8 +924,7 @@
(change-style matching-parenthesis-style pos (+ pos 1)) (change-style matching-parenthesis-style pos (+ pos 1))
(change-style matching-parenthesis-style (- end 1) end)]))))))) (change-style matching-parenthesis-style (- end 1) end)])))))))
[define transpose-sexp (define/public (transpose-sexp pos)
(λ (pos)
(let ([start-1 (get-backward-sexp pos)]) (let ([start-1 (get-backward-sexp pos)])
(if (not start-1) (if (not start-1)
(bell) (bell)
@ -924,7 +946,7 @@
(insert text-1 start-2 end-2) (insert text-1 start-2 end-2)
(insert text-2 start-1 end-1) (insert text-2 start-1 end-1)
(set-position end-2) (set-position end-2)
(end-edit-sequence)))))))))))] (end-edit-sequence)))))))))))
[define tab-size 8] [define tab-size 8]
(public get-tab-size set-tab-size) (public get-tab-size set-tab-size)
[define get-tab-size (λ () tab-size)] [define get-tab-size (λ () tab-size)]
@ -1020,9 +1042,7 @@
; ; ; ;
; ; ; ;
;; ;;; ;; ;;;
(define setup-keymap (define (setup-keymap keymap)
(λ (keymap)
(let ([add-pos-function (let ([add-pos-function
(λ (name call-method) (λ (name call-method)
(send keymap add-function name (send keymap add-function name
@ -1040,7 +1060,11 @@
(add-pos-function "remove-parens-forward" (λ (e p) (send e remove-parens-forward p))) (add-pos-function "remove-parens-forward" (λ (e p) (send e remove-parens-forward p)))
(add-pos-function "transpose-sexp" (λ (e p) (send e transpose-sexp p))) (add-pos-function "transpose-sexp" (λ (e p) (send e transpose-sexp p)))
(add-pos-function "mark-matching-parenthesis" (add-pos-function "mark-matching-parenthesis"
(λ (e p) (send e mark-matching-parenthesis p)))) (λ (e p) (send e mark-matching-parenthesis p)))
(add-pos-function "introduce-let-ans"
(λ (e p) (send e introduce-let-ans p)))
(add-pos-function "move-sexp-out"
(λ (e p) (send e move-sexp-out p)))
(let ([add-edit-function (let ([add-edit-function
(λ (name call-method) (λ (name call-method)
@ -1145,7 +1169,9 @@
;(map-meta "c:m" "mark-matching-parenthesis") ;(map-meta "c:m" "mark-matching-parenthesis")
; this keybinding doesn't interact with the paren colorer ; this keybinding doesn't interact with the paren colorer
) )
(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:o" "move-sexp-out")))
(define keymap (make-object keymap:aug-keymap%)) (define keymap (make-object keymap:aug-keymap%))
(setup-keymap keymap) (setup-keymap keymap)