From 2aba362d414537deb619ee17cd6636df3e9f957f Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Tue, 27 May 2003 21:15:50 +0000 Subject: [PATCH] .. original commit: fad35fb25674de2d7ecfa8d5132f02c564b8e82a --- collects/framework/framework.ss | 4 +- collects/framework/private/editor.ss | 24 ++++++++ collects/framework/private/pasteboard.ss | 3 +- collects/framework/private/scheme.ss | 73 ++++++++++-------------- collects/framework/private/sig.ss | 7 ++- collects/framework/private/text.ss | 3 +- 6 files changed, 65 insertions(+), 49 deletions(-) diff --git a/collects/framework/framework.ss b/collects/framework/framework.ss index 9320f342..32435558 100644 --- a/collects/framework/framework.ss +++ b/collects/framework/framework.ss @@ -1265,10 +1265,10 @@ () "Returns a keymap with binding suitable for Scheme.") - (scheme:get-style-list + (editor:get-standard-style-list (-> (is-a?/c style-list%)) () - "Returns a style list that is used for all Scheme buffers.") + "Returns a style list that is used for all instances of \\iscmintf{editor:standard-style-list}.") (scheme:get-wordbreak-map (-> (is-a?/c editor-wordbreak-map%)) diff --git a/collects/framework/private/editor.ss b/collects/framework/private/editor.ss index e4f12301..51179734 100644 --- a/collects/framework/private/editor.ss +++ b/collects/framework/private/editor.ss @@ -311,6 +311,30 @@ (super-instantiate ()))) + (define standard-style-list (make-object style-list%)) + (define (get-standard-style-list) standard-style-list) + (define delta + (let ([delta (make-object style-delta% 'change-normal)]) + (send delta set-delta 'change-family 'modern) + delta)) + (let ([style (send standard-style-list find-named-style "Standard")]) + (if style + (send style set-delta delta) + (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)))) + + (define standard-style-list<%> + (interface (editor<%>) + )) + + (define standard-style-list-mixin + (mixin (editor<%>) (standard-style-list<%>) + (super-instantiate ()) + (inherit set-style-list) + (set-style-list standard-style-list))) + (define -keymap<%> (interface (basic<%>) get-keymaps)) (define keymap-mixin (mixin (basic<%>) (-keymap<%>) diff --git a/collects/framework/private/pasteboard.ss b/collects/framework/private/pasteboard.ss index 90b30255..a5a5dd66 100644 --- a/collects/framework/private/pasteboard.ss +++ b/collects/framework/private/pasteboard.ss @@ -16,7 +16,8 @@ (rename [-keymap% keymap%]) (define basic% (editor:basic-mixin pasteboard%)) - (define -keymap% (editor:keymap-mixin basic%)) + (define standard-style-list% (editor:standard-style-list-mixin basic%)) + (define -keymap% (editor:keymap-mixin standard-style-list%)) (define file% (editor:file-mixin -keymap%)) (define backup-autosave% (editor:backup-autosave-mixin file%)) (define info% (editor:info-mixin backup-autosave%))))) diff --git a/collects/framework/private/scheme.ss b/collects/framework/private/scheme.ss index da9d64df..0af641ad 100644 --- a/collects/framework/private/scheme.ss +++ b/collects/framework/private/scheme.ss @@ -303,25 +303,12 @@ (define (get-wordbreak-map) wordbreak-map) (init-wordbreak-map wordbreak-map) - (define style-list (make-object style-list%)) - (define (get-style-list) style-list) - (define delta - (let ([delta (make-object style-delta% 'change-normal)]) - (send delta set-delta 'change-family 'modern) - delta)) - (let ([style (send style-list find-named-style "Standard")]) - (if style - (send style set-delta delta) - (send style-list new-named-style "Standard" - (send style-list find-or-create-style - (send style-list find-named-style "Basic") - delta)))) - (define (get-match-color) (preferences:get 'framework:paren-match-color)) (define mismatch-color (make-object color% "PINK")) (define matching-parenthesis-style - (let ([matching-parenthesis-delta (make-object style-delta% 'change-bold)]) + (let ([matching-parenthesis-delta (make-object style-delta% 'change-bold)] + [style-list (editor:get-standard-style-list)]) (send matching-parenthesis-delta set-delta-foreground "forest green") (send style-list new-named-style "Matching Parenthesis Style" (send style-list find-or-create-style @@ -340,6 +327,7 @@ get-keymap get-text get-start-position + get-style-list get-end-position flash-on highlight-range @@ -1051,7 +1039,7 @@ (cond [(and (eq? matching-parenthesis-style start-style) (eq? matching-parenthesis-style end-style)) - (let ([standard-style (send style-list find-named-style "Standard")]) + (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))] [else @@ -1114,66 +1102,65 @@ (define text-mode-mixin (mixin (mode:text<%>) (-text-mode<%>) - - (inherit get-styles-fixed) - (rename [super-on-focus on-focus] - [super-after-change-style after-change-style] - [super-after-edit-sequence after-edit-sequence] - [super-after-insert after-insert] - [super-after-delete after-delete] - [super-after-set-size-constraint after-set-size-constraint] - [super-after-set-position after-set-position]) - (inherit has-focus? find-snip split-snip) - (override on-focus after-change-style after-edit-sequence - after-insert after-delete - after-set-size-constraint after-set-position) - (define (on-focus text on?) + (rename [super-on-focus on-focus]) + (define/override (on-focus text on?) (super-on-focus text on?) (send text highlight-parens (not on?))) - (define (after-change-style text start len) + + (rename [super-after-change-style after-change-style]) + (define/override (after-change-style text start len) (unless (send text local-edit-sequence?) (unless (send text get-styles-fixed) (when (send text has-focus?) (send text highlight-parens)))) (super-after-change-style text start len)) - (define (after-edit-sequence text) + + (rename [super-after-edit-sequence after-edit-sequence]) + (define/override (after-edit-sequence text) (super-after-edit-sequence text) (unless (send text local-edit-sequence?) (when (send text has-focus?) (send text highlight-parens)))) - (define (after-insert text start size) + + (rename [super-after-insert after-insert]) + (define/override (after-insert text start size) (unless (send text local-edit-sequence?) (when (send text has-focus?) (send text highlight-parens))) (super-after-insert text start size)) - (define (after-delete text start size) + + (rename [super-after-delete after-delete]) + (define/override (after-delete text start size) (unless (send text local-edit-sequence?) (when (send text has-focus?) (send text highlight-parens)))) - (define (after-set-size-constraint text) + + (rename [super-after-set-size-constraint after-set-size-constraint]) + (define/override (after-set-size-constraint text) (unless (send text local-edit-sequence?) (when (send text has-focus?) (send text highlight-parens))) (super-after-set-size-constraint text)) - (define (after-set-position text) + + (rename [super-after-set-position after-set-position]) + (define/override (after-set-position text) (unless (send text local-edit-sequence?) (when (send text has-focus?) (send text highlight-parens))) (super-after-set-position text)) - (rename [super-on-disable on-disable]) - (define/override (on-disable text) + (rename [super-on-disable-delegate on-disable-delegate]) + (define/override (on-disable-delegate text) (send text highlight-parens #t) - (super-on-disable text)) + (super-on-disable-delegate text)) - (rename [super-on-enable on-enable]) - (define/override (on-enable text) - (super-on-enable text) + (rename [super-on-enable-delegate on-enable-delegate]) + (define/override (on-enable-delegate text) + (super-on-enable-delegate text) (send text highlight-parens #t) (send text set-load-overwrites-styles #f) (send text set-wordbreak-map wordbreak-map) (send text set-tabs null (send text get-tab-size) #f) - (send text set-style-list style-list) (send text set-styles-fixed #t)) (super-instantiate ()))) diff --git a/collects/framework/private/sig.ss b/collects/framework/private/sig.ss index e50f1013..3257430a 100644 --- a/collects/framework/private/sig.ss +++ b/collects/framework/private/sig.ss @@ -248,25 +248,28 @@ (define-signature framework:editor-class^ (basic<%> + standard-style-list<%> keymap<%> autowrap<%> info<%> file<%> backup-autosave<%> basic-mixin + standard-style-list-mixin keymap-mixin autowrap-mixin info-mixin file-mixin backup-autosave-mixin)) (define-signature framework:editor-fun^ - ()) + (get-standard-style-list)) (define-signature framework:editor^ ((open framework:editor-class^) (open framework:editor-fun^))) (define-signature framework:pasteboard-class^ (basic% + standard-style-list% keymap% file% backup-autosave% @@ -293,6 +296,7 @@ 1-pixel-string-snip% 1-pixel-tab-snip% delegate% + standard-style-list% keymap% return% autowrap% @@ -496,7 +500,6 @@ (define-signature framework:scheme-fun^ (get-wordbreak-map init-wordbreak-map - get-style-list get-keymap setup-keymap add-preferences-panel)) diff --git a/collects/framework/private/text.ss b/collects/framework/private/text.ss index 25da6284..c1a6158d 100644 --- a/collects/framework/private/text.ss +++ b/collects/framework/private/text.ss @@ -828,7 +828,8 @@ (define hide-caret/selection% (hide-caret/selection-mixin basic%)) (define nbsp->space% (nbsp->space-mixin basic%)) (define delegate% (delegate-mixin basic%)) - (define -keymap% (editor:keymap-mixin basic%)) + (define standard-style-list% (editor:standard-style-list-mixin basic%)) + (define -keymap% (editor:keymap-mixin standard-style-list%)) (define return% (return-mixin -keymap%)) (define autowrap% (editor:autowrap-mixin -keymap%)) (define file% (editor:file-mixin autowrap%))