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

.

Browse Source 
original commit: 15358e2a435792df8af70d7cfd72009ca9e613dc
This commit is contained in:
Robby Findler 2004-10-12 16:55:46 +00:00
parent 0463fcac0e
commit b6d3c63636
4 changed files with 29 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
collects/framework/private/editor.ss
View File

@ -304,15 +304,16 @@
(send standard-style-list new-named-style "Standard" (send standard-style-list new-named-style "Standard"
(send standard-style-list find-or-create-style (send standard-style-list find-or-create-style
(send standard-style-list find-named-style "Basic") (send standard-style-list find-named-style "Basic")
delta))))
(let ([style (send standard-style-list find-named-style default-color-style-name)])
(if style
(send style set-delta delta)
(send standard-style-list new-named-style default-color-style-name
(send standard-style-list find-or-create-style
(send standard-style-list find-named-style "Standard")
delta))))) delta)))))
(let ([delta (make-object style-delta%)]
[style (send standard-style-list find-named-style default-color-style-name)])
(if style
(send style set-delta delta)
(send standard-style-list new-named-style default-color-style-name
(send standard-style-list find-or-create-style
(send standard-style-list find-named-style "Standard")
delta))))
(define (set-default-font-color color) (define (set-default-font-color color)
(let* ([scheme-standard (send standard-style-list find-named-style default-color-style-name)] (let* ([scheme-standard (send standard-style-list find-named-style default-color-style-name)]

9
collects/framework/private/keymap.ss
View File

@ -218,8 +218,13 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (make-meta-prefix-list key) (define (make-meta-prefix-list key)
(list (string-append "m:" key) (let ([defaults
(string-append "ESC;" key))) (list (string-append "m:" key)
(string-append "ESC;" key))])
(if (eq? (system-type) 'macosx)
(cons (string-append "a:" key)
defaults)
defaults)))
(define send-map-function-meta (define send-map-function-meta
(lambda (keymap key func) (lambda (keymap key func)

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

@ -876,6 +876,7 @@
[define select-up-sexp (lambda () (select-text (lambda (x) (find-up-sexp x)) #f))] [define select-up-sexp (lambda () (select-text (lambda (x) (find-up-sexp x)) #f))]
[define select-down-sexp (lambda () (select-text (lambda (x) (find-down-sexp x)) #t))] [define select-down-sexp (lambda () (select-text (lambda (x) (find-down-sexp x)) #t))]
(inherit get-fixed-style)
(define (mark-matching-parenthesis pos) (define (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))])
@ -888,9 +889,9 @@
(cond (cond
[(and (eq? matching-parenthesis-style start-style) [(and (eq? matching-parenthesis-style start-style)
(eq? matching-parenthesis-style end-style)) (eq? matching-parenthesis-style end-style))
(let ([standard-style (send (get-style-list) find-named-style "Standard")]) (let ([fixed-style (get-fixed-style)])
(change-style standard-style pos (+ pos 1)) (change-style fixed-style pos (+ pos 1))
(change-style standard-style (- end 1) end))] (change-style fixed-style (- end 1) end))]
[else [else
(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)])))))))

16
collects/framework/private/text.ss
View File

@ -327,13 +327,13 @@ WARNING: printf is rebound in the body of the unit to always
(define (set-styles-fixed b) (set! styles-fixed? b)) (define (set-styles-fixed b) (set! styles-fixed? b))
(define/augment (on-insert start len) (define/augment (on-insert start len)
(inner (void) on-insert start len) (begin-edit-sequence)
(begin-edit-sequence)) (inner (void) on-insert start len))
(define/augment (after-insert start len) (define/augment (after-insert start len)
(when styles-fixed? (when styles-fixed?
(change-style (get-fixed-style) start (+ start len) #f)) (change-style (get-fixed-style) start (+ start len) #f))
(end-edit-sequence) (inner (void) after-insert start len)
(inner (void) after-insert start len)) (end-edit-sequence))
(public move/copy-to-edit) (public move/copy-to-edit)
(define (move/copy-to-edit dest-edit start end dest-position) (define (move/copy-to-edit dest-edit start end dest-position)
@ -367,9 +367,11 @@ WARNING: printf is rebound in the body of the unit to always
(define foreground-color-mixin (define foreground-color-mixin
(mixin (basic<%> editor:standard-style-list<%>) (foreground-color<%>) (mixin (basic<%> editor:standard-style-list<%>) (foreground-color<%>)
(inherit begin-edit-sequence end-edit-sequence change-style) (inherit begin-edit-sequence end-edit-sequence change-style get-style-list)
(define/override (get-fixed-style) (define/override (get-fixed-style)
(send (editor:get-standard-style-list) find-named-style (editor:get-default-color-style-name))) (send (editor:get-standard-style-list)
find-named-style
(editor:get-default-color-style-name)))
(super-new))) (super-new)))
(define hide-caret/selection<%> (interface (basic<%>))) (define hide-caret/selection<%> (interface (basic<%>)))