(module text mzscheme
  (require (lib "mred.ss" "mred")
           (lib "class.ss")
           (lib "etc.ss"))

  (define read-only-text%
    (class text%
      (init (line-spacing 1.0) (tab-stops null) (auto-wrap #f))
      (inherit delete insert hide-caret)
      (define programmatic-context? (make-parameter #f))
      (define/augment (can-insert? s l) (programmatic-context?))
      (define/augment (can-delete? s l) (programmatic-context?))
      (define/public delete/programmatic
        (opt-lambda (start [end 'back] [scroll-ok? #t])
          (parameterize ([programmatic-context? #t])
            (delete start end scroll-ok?))))
      (define/public insert/programmatic
        (opt-lambda (str start [end 'same] [scroll-ok? #t])
          (parameterize ([programmatic-context? #t])
            (insert str start end scroll-ok?))))
      ;(define/override (caret-hidden?) #t)
      (super-new (line-spacing line-spacing)
                 (tab-stops tab-stops)
                 (auto-wrap auto-wrap))
      ;(hide-caret #t)
      ))

  (provide read-only-text%))