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

*** empty log message ***

Browse Source 
original commit: bfc30a6a6e4df253723a4e44836427da6897ea4e
This commit is contained in:
Scott Owens 2003-12-14 22:02:03 +00:00
parent d8d7528981
commit 40eb0859c3
2 changed files with 35 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
collects/framework/private/color.ss
View File

@ -42,7 +42,7 @@
backward-containing-sexp
forward-match
balanced?
in-single-line-comment?))
insert-close-paren))
(define text-mixin
(mixin (text:basic<%>) (-text<%>)
@ -645,6 +645,36 @@
(eq? 'comment (send tokens get-root-data)))
(define (get-close-paren pos closers)
(cond
((null? closers) #f)
(else
(let* ((c (car closers))
(l (string-length c)))
(insert c)
(let ((m (backward-match (+ l pos) start-pos)))
(cond
((and m (send parens is-open-pos? m))
(delete pos (+ l pos))
c)
(else
(delete pos (+ l pos))
(get-close-paren pos (cdr closers)))))))))
(inherit insert delete flash-on)
(define/public (insert-close-paren pos char flash? fixup?)
(let ((closer
(begin
(begin-edit-sequence #f #f)
(get-close-paren pos (if fixup? (map symbol->string (map cadr pairs)) null)))))
(end-edit-sequence)
(let ((insert-str (if closer closer (string char))))
(insert insert-str)
(when flash?
(let ((pos (backward-match (+ (string-length insert-str) pos) 0)))
(when (and pos (send parens is-open-pos? pos))
(flash-on pos (+ 1 pos))))))))
;; ------------------------- Callbacks to Override ----------------------
(rename (super-lock lock))

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

@ -382,7 +382,7 @@
backward-containing-sexp
forward-match
skip-whitespace
in-single-line-comment?)
insert-close-paren)
(inherit get-styles-fixed)
@ -421,49 +421,10 @@
remove-parens-forward)
(define (get-limit pos) 0)
(define (balance-parens key-event)
(letrec ([char (send key-event get-key-code)] ;; must be a character. See above.
[here (get-start-position)]
[limit (get-limit here)]
[paren-match? (preferences:get 'framework:paren-match)]
[fixup-parens? (preferences:get 'framework:fixup-parens)]
[find-match
(lambda (pos)
(let loop ([parens (scheme-paren:get-paren-pairs)])
(cond
[(null? parens) #f]
[else (let* ([paren (car parens)]
[left (car paren)]
[right (cdr paren)])
(if (string=? left (get-text pos (+ pos (string-length left))))
right
(loop (cdr parens))))])))])
(cond
[(in-single-line-comment? here)
(insert char)]
[(and (not (= 0 here))
(char=? (string-ref (get-text (- here 1) here) 0) #\\))
(insert char)]
[(or paren-match? fixup-parens?)
(let* ([end-pos (backward-containing-sexp here limit)])
(cond
[end-pos
(let* ([left-paren-pos (find-enclosing-paren end-pos)]
[match (and left-paren-pos
(find-match left-paren-pos))])
(cond
[match
(insert (if fixup-parens? match char))
(when paren-match?
(flash-on
left-paren-pos
(+ left-paren-pos (string-length match))))]
[else
(insert char)]))]
[else (insert char)]))]
[else (insert char)])
#t))
(insert-close-paren (get-start-position) (send key-event get-key-code)
(preferences:get 'framework:paren-match)
(preferences:get 'framework:fixup-parens)))
(define (tabify-on-return?) #t)
(define tabify