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.

Reply via email to