suzanne.soy/gui
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

.

Browse Source 
original commit: 8029c5a84e3040987d09d64e39b9538b985a6d8e
This commit is contained in:
Matthew Flatt 2001-03-16 01:20:46 +00:00
parent 8b02872f55
commit 0347dc7ade
2 changed files with 111 additions and 94 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
collects/hierlist/hierlist-unit.ss
View File

@ -31,13 +31,16 @@
(class100 snip% (callback)
(inherit get-admin set-flags get-flags set-count set-snipclass get-style)
(rename [super-get-extent get-extent])
(private
(private-field
[size-calculated? #f]
[size 10]
[width-fraction 1/2]
[right-points #f]
[down-points #f]
[on? #f]
[click-callback callback]
[clicked? #f])
(private
[set-sizes
(lambda (dc)
(let* ([s (get-style)]
@ -58,12 +61,9 @@
(set! down-points
(list (make-object point% 0 (+ voffset offset))
(make-object point% sz (+ voffset offset))
(make-object point% (quotient sz 2) (+ width offset voffset)))))))])
(private
(make-object point% (quotient sz 2) (+ width offset voffset)))))))]
[get-width (lambda () (+ 2 size))]
[get-height (lambda () (+ 2 size))]
[click-callback callback]
[clicked? #f]
[update
(lambda ()
(send (get-admin) needs-update this 0 0 (get-width) (get-height)))])
@ -158,7 +158,7 @@
(define hierarchical-list-item%
(class100* object% (hierarchical-list-item<%>) (snp)
(private
(private-field
[snip snp]
[data #f])
(public
@ -182,7 +182,7 @@
(define hierarchical-list-compound-item%
(class100* hierarchical-list-item% (hierarchical-list-compound-item<%>) (snp)
(private [snip snp])
(private-field [snip snp])
(override
[get-editor (lambda () (send snip get-title-buffer))])
(public
@ -224,7 +224,7 @@
get-view-size)
(rename [super-auto-wrap auto-wrap]
[super-on-default-event on-default-event])
(private
(private-field
[top tp]
[top-select tp-select]
[item itm]
@ -285,13 +285,17 @@
;; Buffer for a compound list item (and the top-level list)
(define (make-hierarchical-list-text% super%)
(class100 super% (top top-select depth parent-snp)
(class100 super% (tp tp-select dpth parent-snp)
(inherit set-max-undo-history hide-caret erase
last-position insert delete line-start-position line-end-position
begin-edit-sequence end-edit-sequence get-style-list)
(private
(private-field
[top tp]
[top-select tp-select]
[depth dpth]
[parent-snip parent-snp]
[children null]
[children null])
(private
[make-whitespace (lambda () (make-object whitespace-snip%))]
[insert-item
(lambda (mixin snip% whitespace?)
@ -373,7 +377,7 @@
;; Snip for a single list item
(define hierarchical-item-snip%
(class100 editor-snip% (prnt top top-select depth mixin)
(private [parent prnt])
(private-field [parent prnt])
(public
[get-parent (lambda () parent)]
[get-item-text% (lambda () hierarchical-item-text%)]
@ -385,7 +389,7 @@
[reflow-item (lambda ()
(when (send item-buffer auto-wrap)
(send item-buffer auto-wrap #t)))])
(private
(private-field
[item (make-object (mixin hierarchical-list-item%) this)]
[item-buffer (make-object (get-item-text%) top top-select item this depth)])
(sequence
@ -393,8 +397,10 @@
;; Snip for a compound list item
(define hierarchical-list-snip%
(class100 editor-snip% (prnt top top-select depth mixin [title #f][content #f])
(private [parent prnt])
(class100 editor-snip% (prnt tp top-select depth mixin [title #f][content #f])
(private-field
[parent prnt]
[top tp])
(public
[get-parent (lambda () parent)]
[get-main-text% (lambda () (class100 text% args
@ -448,8 +454,9 @@
(when (send title-buffer auto-wrap)
(send title-buffer auto-wrap #t))
(send (send content-snip get-editor) reflow-items))])
(private-field
[open? #f])
(private
[open? #f]
[handle-open
(lambda (update-arrow?)
(unless open?
@ -481,7 +488,7 @@
(send main-buffer delete 2 5)
(send top on-item-closed (get-item))
(send main-buffer end-edit-sequence)))])
(private
(private-field
[was-empty? #f]
[was-non-empty? #f]
[item (make-object (mixin hierarchical-list-compound-item%) this)]
@ -668,9 +675,11 @@
[i (list-ref items l)])
(send i select #t)
(send i scroll-to)))))
(send top-buffer move-position dir #f 'page)))]
(send top-buffer move-position dir #f 'page)))])
(private-field
[selectable? #t]
[show-focus? #f]
[show-focus? #f])
(private
[do-select (lambda (item s)
(when selectable?
(unless (eq? item selected-item)
@ -678,8 +687,9 @@
(set! selected (if item s #f))
(set! selected-item item)
(when selected (send selected show-select #t))
(on-select item))))]
[top-buffer (make-object hierarchical-list-text% this do-select 0 #f)]
(on-select item))))])
(private-field
[top-buffer (make-object hierarchical-list-text% this (lambda (i s) (do-select i s)) 0 #f)]
[selected #f]
[selected-item #f])
(sequence

153
collects/mred/mred.ss
View File

@ -418,7 +418,7 @@
[super-drag-accept-files drag-accept-files]
[super-show show]
[super-enable enable])
(private
(private-field
[top-level #f]
[focus? #f]
[container this]
@ -464,7 +464,7 @@
[orig-enable
(lambda args (super-enable . args))])
(private
(private-field
[can-accept-drag? #f])
(public
@ -541,7 +541,7 @@
[super-enable enable]
[super-on-visible on-visible]
[super-on-active on-active])
(private
(private-field
; have we had any redraw requests while the window has been
; hidden?
[pending-redraws? #t]
@ -571,7 +571,7 @@
(lambda (b)
(set! enabled? (and b #t))
(super-enable b))])
(private
(private-field
[eventspace (if parent
(send parent get-eventspace)
(wx:current-eventspace))])
@ -977,7 +977,7 @@
get-parent get-client-size)
(rename [super-enable enable]
[super-set-size set-size])
(private [enabled? #t])
(private-field [enabled? #t])
(override
[enable
(lambda (b)
@ -1006,7 +1006,7 @@
[is-enabled?
(lambda () enabled?)])
(private
(private-field
; Store minimum size of item.
; This will never change after the item is created.
hard-min-width
@ -1043,7 +1043,7 @@
(check-range-integer '(method canvas<%> min-client-height) new-height)
(min-height (+ new-height (client-inset #t)))])])
(private [-mw 0]
(private-field [-mw 0]
[-mh 0]
[-xm x-margin-w]
[-ym y-margin-h]
@ -1164,7 +1164,7 @@
(define (make-glue% %)
(class100* % (wx/proxy<%>) (mr prxy . args)
(private [mred mr]
(private-field [mred mr]
[proxy prxy])
(public
[get-mred (lambda () mred)]
@ -1177,7 +1177,7 @@
(rename [super-on-size on-size]
[super-on-set-focus on-set-focus]
[super-on-kill-focus on-kill-focus])
(private
(private-field
[pre-wx->proxy (lambda (w k) ; MacOS: w may not be something the user knows
(if w
(if (is-a? w wx/proxy<%>)
@ -1246,7 +1246,7 @@
(define (make-container-glue% %)
(class100 % (mr prxy . args)
(inherit do-place-children do-get-graphical-min-size get-children-info)
(private [mred mr][proxy prxy])
(private-field [mred mr][proxy prxy])
(override
[get-graphical-min-size (lambda ()
(cond
@ -1294,7 +1294,7 @@
(class100 (make-window-glue% %) (mred proxy . args)
(inherit is-shown? get-mred queue-visible)
(rename [super-on-activate on-activate])
(private
(private-field
[act-date/seconds 0] [act-date/milliseconds 0] [act-on? #f])
(public
[on-exit (entry-point
@ -1390,7 +1390,7 @@
(make-top-level-window-glue%
(class100 (make-top-container% wx:frame% #f) args
(rename [super-set-menu-bar set-menu-bar])
(private
(private-field
[menu-bar #f]
[is-mdi-parent? #f])
(public
@ -1429,7 +1429,7 @@
(define wx-button% (make-window-glue%
(class100 (make-simple-control% wx:button%) (parent cb label x y w h style)
(inherit command)
(private [border? (memq 'border style)])
(private-field [border? (memq 'border style)])
(public [has-border? (lambda () border?)])
(override
[char-to (lambda ()
@ -1468,7 +1468,7 @@
stretchable-in-x stretchable-in-y set-min-height set-min-width
get-parent)
(override [gets-focus? (lambda () #f)])
(private
(private-field
; # pixels per unit of value.
[pixels-per-value 1])
(sequence
@ -1538,7 +1538,7 @@
[(which) (and (< -1 which (number))
(vector-ref enable-vector which))])])
(private [is-vertical? (memq 'vertical style)])
(private-field [is-vertical? (memq 'vertical style)])
(public
[vertical? (lambda () is-vertical?)]
[char-to-button (lambda (i)
@ -1549,7 +1549,7 @@
(sequence (super-init parent cb label x y w h choices major style))
(private [enable-vector (make-vector (number) #t)]))))
(private-field [enable-vector (make-vector (number) #t)]))))
(define wx-slider%
(make-window-glue%
@ -1559,7 +1559,7 @@
(parent func label value min-val max-val style)
(inherit set-min-width set-min-height stretchable-in-x stretchable-in-y
get-client-size get-width get-height get-parent)
(private
(private-field
; # pixels per possible setting.
[pixels-per-value 3])
; 3 is good because with horizontal sliders under Xt, with 1 or 2
@ -1586,7 +1586,7 @@
(define wx-canvas% (make-canvas-glue%
(class100 (make-control% wx:canvas% 0 0 #t #t) args
(private
(private-field
[tabable? #f])
(public
[on-tab-in (lambda () (send (wx->mred this) on-tab-in))]
@ -1609,7 +1609,7 @@
get-hard-minimum-size set-min-height)
(rename [super-set-editor set-editor]
[super-on-set-focus on-set-focus])
(private
(private-field
[fixed-height? #f]
[fixed-height-lines 0]
[orig-hard #f]
@ -1736,10 +1736,11 @@
[super-get-view-size get-view-size]
[super-copy-self-to copy-self-to]
[super-print print])
(private
(private-field
[canvases null]
[active-canvas #f]
[auto-set-wrap? #f]
[auto-set-wrap? #f])
(private
[max-view-size
(lambda ()
(let ([wb (box 0)]
@ -1873,7 +1874,7 @@
(define wx:windowless-panel%
(class100 object% (prnt x y w h style)
(private
(private-field
[pos-x 0] [pos-y 0] [width 1] [height 1]
[parent prnt])
(public
@ -1911,7 +1912,7 @@
(rename [super-set-focus set-focus])
(private
(private-field
; cache to prevent on-size from recomputing its result every
; time. when curr-width is #f, cache invalid.
curr-width
@ -1936,7 +1937,7 @@
(super-set-focus)
(send (car children) set-focus)))])
(private
(private-field
;; list of panel's contents.
[children null]
[curr-border const-default-border]
@ -2185,7 +2186,7 @@
(cadr curr-info)) ; child-info-y-min
(loop (cdr children-info)))))))])
(private
(private-field
[curr-spacing const-default-spacing])
(public
@ -2292,13 +2293,13 @@
(define (wx-make-linear-panel% wx-panel%)
(class100 wx-panel% args
(private
(private-field
[major-align-pos 'left]
[minor-align-pos 'center])
(inherit force-redraw border get-width get-height
get-graphical-min-size)
(private [curr-spacing const-default-spacing])
(private-field [curr-spacing const-default-spacing])
(override
[spacing
(case-lambda
@ -2541,9 +2542,9 @@
[super-after-delete after-delete]
[super-on-char on-char])
(inherit get-text last-position)
(private
(private-field
[return-cb ret-cb])
(private
(private-field
[block-callback 1]
[callback
(lambda (type)
@ -2604,7 +2605,7 @@
(class100 wx-horizontal-panel% (mred proxy parent fun label value style)
; Make text field first because we'll have to exit
; for keymap initializer
(private
(private-field
[func fun]
[without-callback #f]
[callback-ready #f]
@ -2657,7 +2658,7 @@
(sequence
(super-init #f proxy parent null)
(send (area-parent) add-child this))
(private
(private-field
[multi? (memq 'multiple style)]
[horiz? (eq? (send (send parent get-window) get-label-position) 'horizontal)]
[dy 0]
@ -2670,7 +2671,7 @@
(alignment 'left 'top)
(unless horiz? (send p alignment 'left 'top))
(unless multi? (stretchable-in-y #f)))
(private
(private-field
[l (and label
(make-object wx-message% #f proxy p label -1 -1 null))]
[c (make-object wx-text-editor-canvas% #f proxy this p
@ -2819,7 +2820,7 @@
(define area%
(class100* mred% (area<%>) (mk-wx get-wx-pan prnt)
(private [get-wx-panel get-wx-pan]
(private-field [get-wx-panel get-wx-pan]
[parent prnt])
(public
[get-parent (lambda () parent)]
@ -2829,7 +2830,7 @@
[stretchable-width (param get-wx-panel stretchable-in-x)]
[stretchable-height (param get-wx-panel stretchable-in-y)]
[get-graphical-min-size (entry-point (lambda () (send wx get-hard-minimum-size)))])
(private
(private-field
[wx (mk-wx)])
(sequence (super-init wx))))
@ -2841,7 +2842,7 @@
(define (make-subarea% %) ; % implements area<%>
(class100* % (subarea<%>) (mk-wx get-wx-pan parent)
(private [get-wx-panel get-wx-pan])
(private-field [get-wx-panel get-wx-pan])
(public
[horiz-margin (param get-wx-panel x-margin)]
[vert-margin (param get-wx-panel y-margin)])
@ -2861,7 +2862,7 @@
(define (make-container% %) ; % implements area<%>
(class100* % (area-container<%> internal-container<%>) (mk-wx get-wx-pan parent)
(private [get-wx-panel get-wx-pan])
(private-field [get-wx-panel get-wx-pan])
(public
[after-new-child (lambda (c) (void))]
[reflow-container (entry-point (lambda () (send (send (get-wx-panel) get-top-level) force-redraw)))]
@ -2931,7 +2932,7 @@
(define (make-window% top? %) ; % implements area<%>
(class100* % (window<%>) (mk-wx get-wx-panel lbl parent crsr)
(private [label lbl][cursor crsr])
(private-field [label lbl][cursor crsr])
(public
[popup-menu (entry-point
(lambda (m x y)
@ -3030,7 +3031,7 @@
[on-superwindow-enable (lambda (active?) (void))]
[refresh (entry-point (lambda () (send wx refresh)))])
(private
(private-field
[wx #f])
(sequence
(super-init (lambda () (set! wx (mk-wx)) wx) get-wx-panel parent))))
@ -3043,7 +3044,7 @@
(define (make-area-container-window% %) ; % implements window<%> (and area-container<%>)
(class100* % (area-container-window<%>) (mk-wx get-wx-pan label parent cursor)
(private [get-wx-panel get-wx-pan])
(private-field [get-wx-panel get-wx-pan])
(public
[get-control-font (entry-point (lambda () (send (get-wx-panel) get-control-font)))]
[set-control-font (entry-point (lambda (x) (send (get-wx-panel) set-control-font x)))]
@ -3130,7 +3131,7 @@
(and o (wx-object->proxy o)))))]
[on-message (lambda (m) (void))])
(private
(private-field
[wx #f]
[wx-panel #f]
[finish (entry-point
@ -3154,7 +3155,7 @@
(define basic-control%
(class100* (make-window% #f (make-subarea% area%)) (control<%>) (mk-wx lbl parent cursor)
(rename [super-set-label set-label])
(private [label lbl])
(private-field [label lbl])
(override
[get-label (lambda () label)]
[get-plain-label (lambda () (and (string? label) (wx:label->plain-label label)))]
@ -3167,7 +3168,7 @@
(set! label l))))])
(public
[command (lambda (e) (send wx command e))]) ; no entry/exit needed
(private
(private-field
[wx #f])
(sequence
(when (string? label)
@ -3198,7 +3199,7 @@
(unless (and pwx (send pwx get-mdi-parent))
(raise-mismatch-error (who->name cwho) "parent for 'mdi-child frame is not an 'mdi-parent frame: " parent))))))
(rename [super-on-subwindow-char on-subwindow-char])
(private
(private-field
[wx #f]
[status-line? #f])
(override
@ -3249,7 +3250,7 @@
(check-style cwho #f '(no-caption resize-border) style)
(check-container-ready cwho parent)))
(rename [super-on-subwindow-char on-subwindow-char])
(private [wx #f])
(private-field [wx #f])
(override
[on-subwindow-char (lambda (w event)
(super-on-subwindow-char w event)
@ -3326,7 +3327,7 @@
(check-callback cwho callback)
(check-style cwho #f null style)
(check-container-ready cwho parent)))
(private
(private-field
[wx #f])
(public
[get-value (entry-point (lambda () (send wx get-value)))]
@ -3343,7 +3344,7 @@
(define radio-box%
(class100 basic-control% (label chcs parent callback [style '(vertical)])
(private [choices chcs])
(private-field [choices chcs])
(sequence
(let ([cwho '(constructor radio-box)])
(check-string/false cwho label)
@ -3355,8 +3356,9 @@
(check-callback cwho callback)
(check-orientation cwho style)
(check-container-ready cwho parent)))
(private-field
[wx #f])
(private
[wx #f]
[check-button
(lambda (method n)
(check-non-negative-integer `(method radio-box% ,method) n)
@ -3401,7 +3403,7 @@
(define slider%
(class100 basic-control% (label minv maxv parent callback [value min-val] [style '(horizontal)])
(private [min-val minv][max-val maxv])
(private-field [min-val minv][max-val maxv])
(sequence
(let ([cwho '(constructor slider)])
(check-string/false cwho label)
@ -3412,7 +3414,7 @@
(check-slider-integer cwho value)
(check-style cwho '(vertical horizontal) '(plain) style)
(check-container-ready cwho parent)))
(private
(private-field
[wx #f])
(public
[get-value (entry-point (lambda () (send wx get-value)))]
@ -3444,7 +3446,7 @@
(check-gauge-integer cwho range)
(check-orientation cwho style)
(check-container-ready cwho parent)))
(private
(private-field
[wx #f])
(public
[get-value (entry-point (lambda () (send wx get-value)))]
@ -3499,8 +3501,9 @@
(raise-mismatch-error (who->name '(method list-control<%> set-string-selection))
"no item matching the given string: " s))))]
[find-string (entry-point (lambda (x) (-1=>false (send wx find-string x))))])
(private-field
[wx #f])
(private
[wx #f]
[check-item
(lambda (method n)
(check-non-negative-integer `(method list-control<%> ,method) n)
@ -3571,8 +3574,9 @@
(case-lambda
[(n) (check-item 'select n) (send wx select n #t)]
[(n on?) (check-item 'select n) (send wx select n on?)]))])
(private-field
[wx #f])
(private
[wx #f]
[check-item
(entry-point
(lambda (method n)
@ -3609,7 +3613,7 @@
(check-string cwho init-val)
(check-style cwho '(single multiple) '(hscroll) style)
(check-container-ready cwho parent)))
(private
(private-field
[wx #f])
(public
[get-editor (entry-point (lambda () (send wx get-editor)))]
@ -3653,7 +3657,7 @@
[warp-pointer (entry-point (lambda (x y) (send wx warp-pointer x y)))]
[get-dc (entry-point (lambda () (send wx get-dc)))])
(private
(private-field
[wx #f])
(sequence
(as-entry
@ -3728,7 +3732,7 @@
[set-scroll-range (entry-point (lambda (d v) (send wx set-scroll-range d v)))]
[get-scroll-page (entry-point (lambda (d) (send wx get-scroll-page d)))]
[set-scroll-page (entry-point (lambda (d v) (send wx set-scroll-page d v)))])
(private
(private-field
[wx #f])
(sequence
(super-init (lambda ()
@ -3755,7 +3759,7 @@
(check-style cwho #f '(hide-vscroll hide-hscroll no-vscroll no-hscroll) style)
(check-gauge-integer cwho scrolls-per-page)
(check-container-ready cwho parent)))
(private
(private-field
[force-focus? #f]
[scroll-to-last? #f]
[scroll-bottom? #f])
@ -3801,7 +3805,7 @@
(case-lambda
[(m) (send wx set-editor m)]
[(m upd?) (send wx set-editor m upd?)]))])
(private
(private-field
[wx #f])
(sequence
(super-init (lambda ()
@ -3829,7 +3833,7 @@
(define pane%
(class100 (make-subarea% (make-container% area%)) (parent)
(private [wx #f])
(private-field [wx #f])
(sequence
(let* ([who (cond ; yuck! - we do this to make h-p and v-p subclasses of p
[(is-a? this vertical-pane%) 'vertical-pane]
@ -3857,7 +3861,7 @@
(define panel%
(class100* (make-area-container-window% (make-window% #f (make-subarea% (make-container% area%)))) (subwindow<%>) (parent [style null])
(private [wx #f])
(private-field [wx #f])
(sequence
(let* ([who (cond ; yuck! - we do this to make h-p and v-p subclasses of p
[(is-a? this vertical-panel%) 'vertical-panel]
@ -3906,7 +3910,7 @@
(define wx-menu-item%
(class100* wx:menu-item% (wx<%>) (mr mn-dat)
(private
(private-field
[menu-data mn-dat]
[mred mr]
[keymap #f]
@ -3932,7 +3936,7 @@
(inherit delete)
(rename [super-append append]
[super-enable-top enable-top])
(private
(private-field
[mred mr]
[items null]
[disabled null]
@ -4007,7 +4011,7 @@
(define wx-menu%
(class100* wx:menu% (wx<%>) (mr popup-label popup-callback)
(private
(private-field
[mred mr]
[items null]
[keymap (make-object wx:keymap%)]
@ -4093,7 +4097,7 @@
(define separator-menu-item%
(class100* mred% (menu-item<%>) (prnt)
(sequence (menu-parent-only 'separator-menu-item prnt))
(private
(private-field
[parent prnt]
[wx #f]
[shown? #f]
@ -4124,7 +4128,7 @@
(define basic-labelled-menu-item%
(class100* mred% (labelled-menu-item<%>) (prnt lbl help-str wx-sub chkble? keymap set-wx)
(private
(private-field
[parent prnt]
[label lbl]
[help-string help-str]
@ -4135,7 +4139,8 @@
[plain-label (string->immutable-string (wx:label->plain-label label))]
[in-menu? (is-a? parent internal-menu<%>)]
[shown? #f]
[enabled? #t]
[enabled? #t])
(private
[do-enable (lambda (on?)
(when shown?
(if in-menu?
@ -4213,12 +4218,13 @@
[else c]))
(define basic-selectable-menu-item%
(class100* basic-labelled-menu-item% (selectable-menu-item<%>) (lbl checkable? menu cb shrtcut help-string set-wx)
(class100* basic-labelled-menu-item% (selectable-menu-item<%>) (lbl checkable? mnu cb shrtcut help-string set-wx)
(rename [super-restore restore] [super-set-label set-label]
[super-is-deleted? is-deleted?]
[super-is-enabled? is-enabled?]
[super-get-label get-label])
(private
(private-field
[menu mnu]
[callback cb]
[label lbl]
[shortcut shrtcut]
@ -4227,8 +4233,9 @@
[command (lambda (e)
(check-instance '(method selectable-menu-item<%> command) wx:control-event% 'control-event% #f e)
(void (callback this e)))])
(private-field
[x-prefix 'meta])
(private
[x-prefix 'meta]
[calc-labels (lambda (label)
(let* ([new-label (if shortcut
(string-append
@ -4315,7 +4322,7 @@
(class100 basic-selectable-menu-item% (label mnu callback [shortcut #f] [help-string #f])
(sequence
(check-shortcut-args 'checkable-menu-item label mnu callback shortcut help-string))
(private
(private-field
[menu mnu]
[wx #f])
(public
@ -4342,7 +4349,7 @@
(when (is-a? i labelled-menu-item<%>)
(send i on-demand)))
(send wx-menu get-items)))])
(private
(private-field
[wx-menu #f])
(sequence
(as-entry
@ -4366,7 +4373,7 @@
(when (is-a? i labelled-menu-item<%>)
(send i on-demand)))
(send wx get-items)))])
(private
(private-field
[wx #f])
(sequence
(check-string/false '(constructor popup-menu) title)
@ -4391,7 +4398,7 @@
(define menu-bar%
(class100* mred% (menu-item-container<%>) (prnt)
(sequence (barless-frame-parent prnt))
(private
(private-field
[parent prnt]
[wx #f]
[wx-parent #f]
@ -4504,7 +4511,7 @@
(class100 text% ()
(inherit insert last-position get-text erase change-style clear-undos)
(rename [super-on-char on-char])
(private [prompt-pos 0] [locked? #f])
(private-field [prompt-pos 0] [locked? #f])
(override
[can-insert? (lambda (start end) (and (>= start prompt-pos) (not locked?)))]
[can-delete? (lambda (start end) (and (>= start prompt-pos) (not locked?)))]