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

fixed bug in c:c;c:l, PR 7944

Browse Source 
svn: r2398
This commit is contained in:
Robby Findler 2006-03-09 00:29:55 +00:00
parent 4a78a1d1ee
commit 9ddd7d429b
1 changed files with 24 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -883,27 +883,30 @@
[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) (define/public (introduce-let-ans pos)
(begin-edit-sequence) (dynamic-wind
(let ([before-text "(let ([ans "] (λ () (begin-edit-sequence))
[after-text "])\n"] (λ ()
[after-text2 "(printf \"~s\\n\" ans)\nans)"] (let ([before-text "(let ([ans "]
[end-l (get-forward-sexp pos)]) [after-text "])\n"]
(cond [after-text2 "(printf \"~s\\n\" ans)\nans)"]
[end-l [end-l (get-forward-sexp pos)])
(insert after-text2 end-l end-l) (cond
(insert after-text end-l end-l) [end-l
(insert before-text pos pos) (insert after-text2 end-l end-l)
(let ([blank-line-pos (+ end-l (string-length after-text) (string-length before-text))]) (insert after-text end-l end-l)
(set-position blank-line-pos blank-line-pos)) (insert before-text pos pos)
(tabify-selection (let ([blank-line-pos (+ end-l (string-length after-text) (string-length before-text))])
(- pos (string-length before-text)) (set-position blank-line-pos blank-line-pos))
(+ end-l (tabify-selection
(string-length before-text) pos
(string-length after-text) (+ end-l
(string-length after-text2)))] (string-length before-text)
[else (string-length after-text)
(bell)])) (string-length after-text2)))]
(end-edit-sequence)) [else
(bell)])))
(λ ()
(end-edit-sequence))))
(define/public (move-sexp-out begin-inner) (define/public (move-sexp-out begin-inner)
(begin-edit-sequence) (begin-edit-sequence)