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 find-or-create-style
(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)))))
(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)
(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)
(list (string-append "m:" key)
(string-append "ESC;" key)))
(let ([defaults
(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
(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-down-sexp (lambda () (select-text (lambda (x) (find-down-sexp x)) #t))]
(inherit get-fixed-style)
(define (mark-matching-parenthesis pos)
(let ([open-parens (map car (scheme-paren:get-paren-pairs))]
[close-parens (map cdr (scheme-paren:get-paren-pairs))])
@ -888,9 +889,9 @@
(cond
[(and (eq? matching-parenthesis-style start-style)
(eq? matching-parenthesis-style end-style))
(let ([standard-style (send (get-style-list) find-named-style "Standard")])
(change-style standard-style pos (+ pos 1))
(change-style standard-style (- end 1) end))]
(let ([fixed-style (get-fixed-style)])
(change-style fixed-style pos (+ pos 1))
(change-style fixed-style (- end 1) end))]
[else
(change-style matching-parenthesis-style pos (+ pos 1))
(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/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)
(when styles-fixed?
(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)
(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
(mixin (basic<%> editor:standard-style-list<%>) (foreground-color<%>)
(inherit begin-edit-sequence end-edit-sequence change-style)
(define/override (get-fixed-style)
(send (editor:get-standard-style-list) find-named-style (editor:get-default-color-style-name)))
(inherit begin-edit-sequence end-edit-sequence change-style get-style-list)
(define/override (get-fixed-style)
(send (editor:get-standard-style-list)
find-named-style
(editor:get-default-color-style-name)))
(super-new)))
(define hide-caret/selection<%> (interface (basic<%>)))