Update: this solution does work. I just found the reason why it did not work before.
(define digivice (new frame% [width 800] [height 600] [label "Standard Style"])) (define card (make-object text%)) (define darc (new editor-canvas% [parent digivice] [editor card] [style '(no-border auto-hscroll auto-vscroll)])) (define font (make-font #:face "Microsoft Himalaya" #:size 16)) (define color (make-object color% "ForestGreen")) (change-default-style! card #:font font #:color color) ;;; this can be put in the class body, or do it in editor-canvas%, it's up to you. (send card insert "works as expected") (send card insert (make-object string-snip% "it's a bug of text%, snip's style is not (convert)ed, also affects the following inputs") (send digivice show #true) (send digivice center 'both) On Fri, Jan 27, 2017 at 12:48 AM, WarGrey Gyoudmon Ju <juzhenli...@gmail.com > wrote: > I have these two helpers (typed racket makes it a little verbose). > > (define change-style : (->* ((Instance Style<%>)) > (#:font (Option (Instance Font%)) > #:color (Option (Instance Color%)) > #:background-color (Option (Instance Color%))) > (Instance Style<%>)) > (lambda [style #:font [font #false] #:color [color #false] > #:background-color [bgcolor #false]] > (send style set-delta > (let* ([style (make-object style-delta%)] > [style (if (false? color) style (send style > set-delta-foreground color))] > [style (if (false? bgcolor) style (send style > set-delta-background bgcolor))]) > (cond [(false? font) style] > [else (send* style > (set-face (send font get-face)) > (set-family (send font get-family))) > (send+ style > (set-delta 'change-style (send font > get-style)) > (set-delta 'change-weight (send font > get-weight)) > (set-delta 'change-smoothing (send font > get-smoothing)) > (set-delta 'change-underline (send font > get-underlined)) > (set-delta 'change-size (min (exact-round > (send font get-size)) 255)))]))) > style)) > > (define change-default-style! : (->* ((U (Instance Editor<%>) (Instance > Style-List%))) > (#:font (Option (Instance Font%)) > #:color (Option (Instance Color%)) > #:background-color (Option > (Instance Color%))) > (Instance Style<%>)) > (lambda [src #:font [font #false] #:color [color #false] > #:background-color [bgcolor #false]] > (define-values (style-list style-name) > (cond [(text%? src) (values (send src get-style-list) (send src > default-style-name))] > [(pasteboard%? src) (values (send src get-style-list) (send > src default-style-name))] > [else (values (if (style-list%? src) src (make-object > style-list%)) "Standard")])) > (change-style #:font font #:color color #:background-color bgcolor > (or (send style-list find-named-style style-name) > (send style-list new-named-style style-name (send > style-list basic-style)))))) > > ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; > ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; > ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; > > This line is put in the class body of new instance of Editor<%> (not > editor-canvas%): > > (change-default-style! this #:font font ...) > > The idea is attaching a style-delta% object to the standard style, then > the altered style becomes > the top-level one so that it will never be `undo`ed by accident. > > The awkward thing here is, I cannot make it work in a simple example, > however it works fine in my real world application. > > > On Thu, Jan 26, 2017 at 7:00 PM, Erich Rast <er...@snafu.de> wrote: > >> Hi, >> >> I have an editor-canvas% subclass and want to set the default style, >> but adding it with name "Standard" to the-style-list doesn't work. Do >> I have to replace the style list of the canvas with a new one? Or does >> the default style of an editor-canvas% have to be called differently? >> "Basic"? >> >> Without the right default style set-line-count also doesn't work as >> desired. It sets the wrong size for lines with smaller fonts that are >> added, so I assume this method is based on the default style. But which >> style is exactly the default style "Basic" or "Standard", and how do I >> change it? >> >> best, >> >> Erich >> >> ----- >> >> ; Example (sorry, not runnable, because it uses my own preference and >> ; what I call 'metastyle' impementation) >> ; layout-init does not really change the style, which >> ; is why I use set-style for every snip. But then set-line-count >> ; doesn't work as desired. >> >> (define console% >> (class editor-canvas% >> (inherit scroll-with-bottom-base allow-scroll-to-last) >> >> (define text #f) >> (define console-style #f) >> (define sema (make-semaphore 1)) >> >> (define (layout-init) >> (define style (send the-style-list >> find-named-style "Basic")) >> (set! console-style (send the-style-list >> find-or-create-style >> style >> (metastyle->style >> (pref:console-style)))) >> (send the-style-list new-named-style "Standard" console-style) >> (set! text >> (new text% >> [auto-wrap #t] >> [line-spacing 0])) >> (send this set-editor text) >> (scroll-with-bottom-base #t) >> (allow-scroll-to-last #t) >> (send this set-line-count 2)) >> >> (define (synced-add-line msg) >> (send text begin-edit-sequence) >> (send text set-position (send text last-position)) >> (define snip (make-object string-snip% msg)) >> (send snip set-style console-style) >> (send text insert #\newline) >> (send text insert snip) >> (send text end-edit-sequence) >> (send text scroll-to-position (send text last-position)) >> (semaphore-post sema)) >> >> (define/public (add-line msg) >> (call-with-semaphore >> sema >> (lambda () >> (synced-add-line msg)))) >> >> (define/public (show-message msg delay) >> (if (> delay 0) >> (call-once/delayed >> (lambda () >> (queue-callback >> (lambda () >> (send this add-line msg)))) >> delay) >> (add-line msg))) >> >> (super-new >> [style '(auto-vscroll auto-hscroll no-border no-focus transparent)] >> [wheel-step 1] >> [scrolls-per-page 10] >> [stretchable-height #f]) >> (layout-init))) >> >> >> -- >> You received this message because you are subscribed to the Google Groups >> "Racket Users" group. >> To unsubscribe from this group and stop receiving emails from it, send an >> email to racket-users+unsubscr...@googlegroups.com. >> For more options, visit https://groups.google.com/d/optout. >> > > -- You received this message because you are subscribed to the Google Groups "Racket Users" group. To unsubscribe from this group and stop receiving emails from it, send an email to racket-users+unsubscr...@googlegroups.com. For more options, visit https://groups.google.com/d/optout.
