4 ## Barebones requirements for creating and querying megawidgets
6 ## Copyright 1997 Jeffrey Hobbs, CADIX International
8 ## Initiated: 5 June 1997
11 ##------------------------------------------------------------------------
16 ## Implements and modifies megawidgets
19 ## widget <subcommand> ?<args>?
21 ## <classname> specifies a global array which is the name of a class and
22 ## contains options database information.
25 ## creates the widget class $classname based on the specifications
26 ## in the global array of the same name
29 ## returns the classes created with this command.
34 ## RETURNS: the widget class
37 ## The global variable WIDGET is used. The public procedure is
38 ## 'widget', with other private procedures beginning with 'widget'.
40 ##------------------------------------------------------------------------
42 ## For a well-commented example for creating a megawidget using this method,
43 ## see the ScrolledText example at the end of the file.
45 ## SHORT LIST OF IMPORTANT THINGS TO KNOW:
47 ## Specify the "type", "base", & "components" keys of the $CLASS global array
49 ## In the $w global array that is created for each instance of a megawidget,
50 ## the following keys are set by the "widget create $CLASS" procedure:
51 ## "base", "basecmd", "container", "class", any option specified in the
52 ## $CLASS array, each component will have a named key
54 ## The following public methods are created for you:
55 ## "cget", "configure", "destroy", & "subwidget"
56 ## You need to write the following:
57 ## "$CLASS:construct", "$CLASS:configure"
58 ## You may want the following that will be called when appropriate:
59 ## "$CLASS:init" (after initial configuration)
60 ## "$CLASS:destroy" (called first thing when widget is being destroyed)
62 ## All ${CLASS}_* commands are considered public methods. The megawidget
63 ## routine will match your options and methods on a unique substring basis.
68 package provide Widget 1.12
71 lappend WIDGET(containers) frame toplevel
72 proc widget { cmd args } {
74 cr* { return [uplevel widget_create $args] }
75 cl* { return [uplevel widget_classes $args] }
77 return -code error "unknown [lindex [info level 0] 0] subcommand\
78 \"$cmd\", must be one of: create, classes"
83 ;proc widget_classes {{pattern "*"}} {
86 foreach name [array names WIDGET C:$pattern] {
87 lappend classes [string range $name 2 end]
92 ;proc widget:eval {CLASS w subcmd args} {
94 if {[string match {} [set arg [info commands ${CLASS}_$subcmd]]]} {
95 set arg [info commands ${CLASS}_$subcmd*]
97 set num [llength $arg]
99 return [uplevel $arg [list $w] $args]
101 regsub -all "${CLASS}_" $arg {} arg
102 return -code error "ambiguous subcommand \"$subcmd\",\
103 could be one of: [join $arg {, }]"
104 } elseif {[catch {uplevel [list $data(basecmd) $subcmd] $args} err]} {
105 return -code error $err
111 ;proc widget_create:constructor {CLASS} {
112 upvar \#0 $CLASS class
115 lappend datacons [list class $CLASS]
117 if {[string compare $class(type) [lindex $class(base) 0]]} {
118 lappend datacons "base \$w.[list [lindex $class(base) 2]]" \
119 "basecmd $CLASS\$w.[list [lindex $class(base) 2]]"
120 set comps "[list $class(base)] $class(components)"
122 lappend datacons "base \$w" "basecmd $CLASS\$w" \
123 "[lindex $class(base) 1] \$w"
124 set comps $class(components)
126 foreach comp $comps {
127 switch [llength $comp] {
129 1 { set name [set type [set wid $comp]]; set opts {} }
131 set type [lindex $comp 0]
132 set name [set wid [lindex $comp 1]]
136 foreach {type name wid opts} $comp break
137 set opts [string trim $opts]
140 lappend datacons "[list $name] \$w.[list $wid]"
141 lappend basecons "$type \$data($name) $opts"
142 if {[string match toplevel $type]} {
143 lappend basecons "wm withdraw \$data($name)"
146 set datacons [join $datacons]
147 set basecons [join $basecons "\n "]
149 ## More of this proc could be configured ahead of time for increased
150 ## construction speed. It's delicate, so handle with extreme care.
151 ;proc $CLASS {w args} "
152 upvar \#0 \$w data $CLASS class
153 $class(type) \$w -class $CLASS
154 [expr [string match toplevel $class(type)]?{wm withdraw \$w\n}:{}]
155 ## Populate data array with user definable options
156 foreach o \[array names class -*\] {
157 if {\[string match -* \$class(\$o)\]} continue
158 set data(\$o) \[option get \$w \[lindex \$class(\$o) 0\] $CLASS\]
161 ## Populate the data array
162 array set data \[list $datacons\]
163 ## Create all the base and component widgets
166 ## Allow for an initialization proc to be eval'ed
167 ## The user must create one
168 if {\[catch {$CLASS:construct \$w} err\]} {
169 catch {${CLASS}_destroy \$w}
170 return -code error \"megawidget construction error: \$err\"
173 set base \$data(base)
174 if {\[string compare \$base \$w\]} {
175 ## If the base widget is not the container, then we want to rename
176 ## its widget commands and add the CLASS and container bind tables
177 ## to its bindtags in case certain bindings are made
179 rename \$base \$data(basecmd)
180 ## Interp alias is the optimal solution, but exposes
181 ## a bug in Tcl7/8 when renaming aliases
182 #interp alias {} \$base {} widget:eval $CLASS \$w
183 ;proc \$base args \"uplevel widget:eval $CLASS \[list \$w\] \\\$args\"
184 bindtags \$base \[linsert \[bindtags \$base\] 1\
185 [expr {[string match toplevel $class(type)]?{}:{$w}}] $CLASS\]
187 rename \$w \$data(basecmd)
189 ;proc \$w args \"uplevel widget:eval $CLASS \[list \$w\] \\\$args\"
190 #interp alias {} \$w {} widget:eval $CLASS \$w
192 ## Do the configuring here and eval the post initialization procedure
193 if {(\[string compare {} \$args\] && \
194 \[catch {uplevel 1 ${CLASS}_configure \$w \$args} err\]) || \
195 \[catch {$CLASS:init \$w} err\]} {
196 catch { ${CLASS}_destroy \$w }
197 return -code error \"megawidget initialization error: \$err\"
201 interp alias {} [string tolower $CLASS] {} $CLASS
203 ## These are provided so that errors due to lack of the command
204 ## existing don't arise. Since they are stubbed out here, the
205 ## user can't depend on 'unknown' or 'auto_load' to get this proc.
206 if {[string match {} [info commands $CLASS:construct]]} {
207 ;proc $CLASS:construct {w} {
208 # the user should rewrite this
209 # without the following error, a simple megawidget that was just
210 # a frame would be created by default
211 return -code error "user must write their own\
212 [lindex [info level 0] 0] function"
215 if {[string match {} [info commands $CLASS:init]]} {
216 ;proc $CLASS:init {w} {
217 # the user should rewrite this
222 ;proc widget_create {CLASS} {
223 if {![string match {[A-Z]*} $CLASS] || [string match { } $CLASS]} {
224 return -code error "invalid class name \"$CLASS\": it must begin\
225 with a capital letter and contain no spaces"
229 upvar \#0 $CLASS class
231 ## First check to see that their container type is valid
232 if {[info exists class(type)]} {
233 ## I'd like to include canvas and text, but they don't accept the
234 ## -class option yet, which would thus require some voodoo on the
235 ## part of the constructor to make it think it was the proper class
236 if {![regexp ^([join $WIDGET(containers) |])\$ $class(type)]} {
237 return -code error "invalid class container type \"$class(type)\",\
238 must be one of: [join $types {, }]"
241 ## Frame is the default container type
242 set class(type) frame
244 ## Then check to see that their base widget type is valid
245 ## We will create a default widget of the appropriate type just in
246 ## case they use the DEFAULT keyword as a default value in their
247 ## megawidget class definition
248 if {[info exists class(base)]} {
249 ## We check to see that we can create the base, that it returns
250 ## the same widget value we put in, and that it accepts cget.
251 if {[string match toplevel [lindex $class(base) 0]] && \
252 [string compare toplevel $class(type)]} {
253 return -code error "\"toplevel\" is not allowed as the base\
254 widget of a megawidget (perhaps you intended it to\
258 ## The container is the default base widget
259 set class(base) $class(type)
261 set types($class(type)) 0
262 switch [llength $class(base)] {
263 1 { set name [set type [set wid $class(base)]]; set opts {} }
265 set type [lindex $class(base) 0]
266 set name [set wid [lindex $class(base) 1]]
269 default { foreach {type name wid opts} $class(base) break }
271 set class(base) [list $type $name $wid $opts]
272 if {[regexp {(^[\.A-Z]|[ \.])} $wid]} {
273 return -code error "invalid $CLASS class base widget name \"$wid\":\
274 it cannot begin with a capital letter,\
275 or contain spaces or \".\""
277 set components(base) [set components($name) $type]
281 if {![info exists class(components)]} { set class(components) {} }
282 set comps $class(components)
283 set class(components) {}
284 ## Verify component widget list
285 foreach comp $comps {
286 ## We don't care if an opts item exists now
287 switch [llength $comp] {
289 1 { set name [set type [set wid $comp]] }
291 set type [lindex $comp 0]
292 set name [set wid [lindex $comp 1]]
294 default { foreach {type name wid} $comp break }
296 if {[info exists components($name)]} {
297 return -code error "component name \"$name\" occurs twice\
300 if {[info exists widgets($wid)]} {
301 return -code error "widget name \"$wid\" occurs twice\
304 if {[regexp {(^[\.A-Z]| |\.$)} $wid]} {
305 return -code error "invalid $CLASS class component widget\
306 name \"$wid\": it cannot begin with a capital letter,\
307 contain spaces or start or end with a \".\""
309 if {[string match *.* $wid] && \
310 ![info exists widgets([file root $wid])]} {
311 ## If the widget name contains a '.', then make sure we will
312 ## have created all the parents first. [file root $wid] is
313 ## a cheap trick to remove the last .child string from $wid
314 return -code error "no specified parent for $CLASS class\
315 component widget name \"$wid\""
317 lappend class(components) $comp
318 set components($name) $type
323 ## Go through the megawidget class definition, substituting for ALIAS
324 ## where necessary and setting up the options database for this $CLASS
325 foreach o [array names class -*] {
326 set name [lindex $class($o) 0]
327 switch -glob -- $name {
330 set len [llength $class($o)]
331 if {$len != 3 && $len != 5} {
332 return -code error "wrong \# args for ALIAS, must be:\
333 {ALIAS componenttype option\
334 ?databasename databaseclass?}"
336 foreach {name type opt dbname dbcname} $class($o) break
337 if {![info exists types($type)]} {
338 return -code error "cannot create alias \"$o\" to $CLASS\
339 component type \"$type\" option \"$opt\":\
340 component type does not exist"
341 } elseif {![info exists config($type)]} {
342 if {[string compare toplevel $type]} {
343 set w .__widget__$type
345 ## Make sure the component widget type exists,
346 ## returns the widget name,
347 ## and accepts configure as a subcommand
348 if {[catch {$type $w} result] || \
349 [string compare $result $w] || \
350 [catch {$w configure} config($type)]} {
351 ## Make sure we destroy it if it was a bad widget
353 ## Or rename it if it was a non-widget command
355 return -code error "invalid widget type \"$type\""
359 set config($type) [. configure]
362 set i [lsearch -glob $config($type) "$opt\[ \t\]*"]
364 return -code error "cannot create alias \"$o\" to $CLASS\
365 component type \"$type\" option \"$opt\":\
366 option does not exist"
369 foreach {opt dbname dbcname def} \
370 [lindex $config($type) $i] break
372 set def [lindex [lindex $config($type) $i] 3]
376 if {[string compare {} $class($o)]} {
377 foreach {dbname dbcname def} $class($o) break
379 set dbcname [set dbname [string range $o 1 end]]
384 set class($o) [list $dbname $dbcname $def]
385 option add *$CLASS.$dbname $def widgetDefault
387 ## Ensure that the class is set correctly
388 set class(class) $CLASS
390 ## This creates the basic constructor procedure for the class
391 ## Both $CLASS and [string tolower $CLASS] commands will be created
392 widget_create:constructor $CLASS
394 ## The user is not supposed to change this proc
395 set comps [lsort [array names components]]
396 ;proc ${CLASS}_subwidget {w widget} "
399 [join $comps { - }] { return \$data(\$widget) }
401 return -code error \"No \$data(class) subwidget \\\"\$widget\\\",\
402 must be one of: [join $comps {, }]\"
407 ## The [winfo class %W] will work in this Destroy, which is necessary
408 ## to determine if we are destroying the actual megawidget container.
409 ## The ${CLASS}_destroy must occur to remove excess state elements.
410 ## This will break in Tk4.1p1, but work with any other 4.1+ version.
411 bind $CLASS <Destroy> "
412 if {\[string compare {} \[widget classes \[winfo class %W\]\]\]} {
413 catch {\[winfo class %W\]_destroy %W}
417 ## The user is not supposed to change this proc
418 ## Instead they create a $CLASS:destroy proc
419 ## Some of this may be redundant, but at least it does the job
420 ;proc ${CLASS}_destroy {w} "
422 catch { $CLASS:destroy \$w }
423 catch { destroy \$data(base) }
424 catch { destroy \$w }
425 catch { rename \$data(basecmd) {} }
426 catch { rename \$data(base) {} }
427 catch { rename \$w {} }
431 if {[string match {} [info commands $CLASS:destroy]]} {
432 ## The user can optionally provide a special destroy handler
433 ;proc $CLASS:destroy {w args} {
438 ## The user is not supposed to change this proc
439 ;proc ${CLASS}_cget {w args} {
440 if {[llength $args] != 1} {
441 return -code error "wrong \# args: should be \"$w cget option\""
443 upvar \#0 $w data [winfo class $w] class
444 if {[info exists class($args)] && [string match -* $class($args)]} {
445 set args $class($args)
447 if {[string match {} [set arg [array names data $args]]]} {
448 set arg [array names data ${args}*]
450 set num [llength $arg]
454 return -code error "ambiguous option \"$args\",\
455 must be one of: [join $arg {, }]"
456 } elseif {[catch {$data(basecmd) cget $args} err]} {
457 return -code error $err
463 ## The user is not supposed to change this proc
464 ## Instead they create a $CLASS:configure proc
465 ;proc ${CLASS}_configure {w args} {
466 upvar \#0 $w data [winfo class $w] class
468 set num [llength $args]
470 if {[info exists class($args)] && \
471 [string match -* $class($args)]} {
472 set args $class($args)
474 if {[string match {} [set arg [array names data $args]]]} {
475 set arg [array names data ${args}*]
477 set num [llength $arg]
479 ## FIX one-elem config
480 return "[list $arg] $class($arg) [list $data($arg)]"
482 return -code error "ambiguous option \"$args\",\
483 must be one of: [join $arg {, }]"
484 } elseif {[catch {$data(basecmd) configure $args} err]} {
485 return -code error $err
490 ## Group the {key val} pairs to be distributed
492 set last [lindex $args end]
493 set args [lrange $args 0 [incr num -2]]
497 foreach {key val} $args {
498 if {[info exists class($key)] && \
499 [string match -* $class($key)]} {
502 if {[string match {} [set arg [array names data $key]]]} {
503 set arg [array names data $key*]
505 set len [llength $arg]
507 lappend widargs $arg $val
509 set ambarg [list $key $arg]
512 lappend cmdargs $key $val
515 if {[string compare {} $widargs]} {
516 uplevel $class(class):configure [list $w] $widargs
518 if {[string compare {} $cmdargs] && [catch \
519 {uplevel [list $data(basecmd)] configure $cmdargs} err]} {
520 return -code error $err
522 if {[info exists ambarg]} {
523 return -code error "ambiguous option \"[lindex $ambarg 0]\",\
524 must be one of: [join [lindex $ambarg 1] {, }]"
526 if {[info exists last]} {
527 return -code error "value for \"$last\" missing"
530 foreach opt [$data(basecmd) configure] {
531 set options([lindex $opt 0]) [lrange $opt 1 end]
533 foreach opt [array names class -*] {
534 if {[string match -* $class($opt)]} {
535 set options($opt) [string range $class($opt) 1 end]
537 set options($opt) "$class($opt) [list $data($opt)]"
540 foreach opt [lsort [array names options]] {
541 lappend config "$opt $options($opt)"
547 if {[string match {} [info commands $CLASS:configure]]} {
548 ## The user is intended to rewrite this one
549 ;proc $CLASS:configure {w args} {
550 foreach {key val} $args {
551 puts "$w: configure $key to [list $value]"
556 set WIDGET(C:$CLASS) {}
561 ########################################################################
562 ########################## EXAMPLES ####################################
563 ########################################################################
565 ########################################################################
566 ########################## ScrolledText ################################
567 ########################################################################
569 ##------------------------------------------------------------------------
574 ## Implements a ScrolledText mega-widget
577 ## scrolledtext <window pathname> <options>
580 ## (Any text widget option may be used in addition to these)
582 ## -autoscrollbar TCL_BOOLEAN DEFAULT: 1
583 ## Whether to have dynamic or static scrollbars.
585 ## RETURNS: the window pathname
587 ## BINDINGS (in addition to default widget bindings)
590 ## These are the subcmds that an instance of this megawidget recognizes.
591 ## Aside from those listed here, it accepts subcmds that are valid for
594 ## configure ?option? ?value option value ...?
596 ## Standard tk widget routines.
599 ## Returns the true widget path of the specified widget. Valid
600 ## widgets are text, xscrollbar, yscrollbar.
603 ## The megawidget creates a global array with the classname, and a
604 ## global array which is the name of each megawidget created. The latter
605 ## array is deleted when the megawidget is destroyed.
606 ## Public procs of $CLASSNAME and [string tolower $CLASSNAME] are used.
607 ## Other procs that begin with $CLASSNAME are private. For each widget,
608 ## commands named .$widgetname and $CLASSNAME$widgetname are created.
612 ## pack [scrolledtext .st -width 40 -height 10] -fill both -exp 1
614 ##------------------------------------------------------------------------
616 ## Create a global array with that is the name of the class: ScrolledText
617 ## Each widget created will also have a global array created by the
618 ## instantiation procedure that is the name of the widget (represented
619 ## as $w below). There three special key names in the $CLASS array:
622 ## the type of base container we want to use (frame or toplevel).
623 ## This would default to frame. This widget will be created for us
624 ## by the constructor function. The $w array will have a "container"
625 ## key that will point to the exact widget name.
628 ## the base widget type for this class. This key is optional and
629 ## represents what kind of widget will be the base for the class. This
630 ## way we know what default methods/options you'll have. If not
631 ## specified, it defaults to the container type.
632 ## To the global $w array, the key "basecmd" will be added by the widget
633 ## instantiation function to point to a new proc that will be the direct
634 ## accessor command for the base widget ("text" in the case of the
635 ## ScrolledText megawidget). The $w "base" key will be the valid widget
636 ## name (for passing to [winfo] and such), but "basecmd" will be the
637 ## valid direct accessor function
640 ## the component widgets of the megawidget. This is a list of tuples
641 ## (ie: {{listbox listbox} {scrollbar yscrollbar} {scrollbar xscrollbar}})
642 ## where each item is in the form {widgettype name}. These components
643 ## will be created before the $CLASS:construct proc is called and the $w
644 ## array will have keys with each name pointing to the appropriate
645 ## widget in it. Use these keys to access your subwidgets. It is from
646 ## this component list and the base and type about that the subwidget
647 ## method is created.
649 ## Aside from that, any $CLASS key that matches -* will be considered an
650 ## option that this megawidget handles. The value can either be a
651 ## 3-tuple list of the form {databaseName databaseClass defaultValue}, or
652 ## it can be one element matching -*, which means this key (say -bd) is
653 ## an alias for the option specified in the value (say -borderwidth)
654 ## which must be specified fully somewhere else in the class array.
656 ## If the value is a list beginning with "ALIAS", then the option is derived
657 ## from a component of the megawidget. The form of the value must be a list
658 ## with the elements:
659 ## {ALIAS componenttype option ?databasename databaseclass?}
660 ## An example of this would be inheriting a label components anchor:
661 ## {ALIAS label -anchor labelAnchor Anchor}
662 ## If the databasename is not specified, it determines the final options
663 ## database info from the component and uses the components default value.
664 ## Otherwise, just the components default value is used.
666 ## The $w array will be populated by the instantiation procedure with the
667 ## default values for all the specified $CLASS options.
669 array set ScrolledText {
671 base {text text text \
672 {-xscrollcommand [list $data(xscrollbar) set] \
673 -yscrollcommand [list $data(yscrollbar) set]}}
675 {scrollbar xscrollbar sx {-orient h -bd 1 -highlightthickness 1 \
676 -command [list $w xview]}}
677 {scrollbar yscrollbar sy {-orient v -bd 1 -highlightthickness 1 \
678 -command [list $w yview]}}
681 -autoscrollbar {autoScrollbar AutoScrollbar 1}
684 # Create this to make sure there are registered in auto_mkindex
685 # these must come before the [widget create ...]
686 proc ScrolledText args {}
687 proc scrolledtext args {}
688 widget create ScrolledText
690 ## Then we "create" the widget. This makes all the necessary default widget
691 ## routines. It creates the public accessor functions ($CLASSNAME and
692 ## [string tolower $CLASSNAME]) as well as the public cget, configure, destroy
693 ## and subwidget methods. The cget and configure commands work like the
694 ## regular Tk ones. The destroy method is superfluous, as megawidgets will
695 ## respond properly to [destroy $widget] (the Tk destroy command).
696 ## The subwidget method has the following form:
698 ## $widget subwidget name
699 ## name - the component widget name
700 ## Returns the widget patch to the component widget name.
701 ## Allows the user direct access to your subwidgets.
703 ## THE USER SHOULD PROVIDE AT LEAST THE FOLLOWING:
705 ## $CLASSNAME:construct {w} => return value ignored
706 ## w - the widget name, also the name of the global data array
707 ## This procedure is called by the public accessor (instantiation) proc
708 ## right after creating all component widgets and populating the global $w
709 ## array with all the default option values, the "base" key and the key
710 ## names for any other components. The user should then grid/pack all
711 ## subwidgets into $w. At this point, the initial configure has not
712 ## occured, so the widget options are all the default. If this proc
713 ## errors, so does the main creation routine, returning your error.
715 ## $CLASSNAME:configure {w args} => return ignored (should be empty)
716 ## w - the widget name, also the name of the global data array
717 ## args - a list of key/vals (already verified to exist)
718 ## The user should process the key/vals however they require If this
719 ## proc errors, so does the main creation routine, returning your error.
721 ## THE FOLLOWING IS OPTIONAL:
723 ## $CLASSNAME:init {w} => return value ignored
724 ## w - the widget name, also the name of the global data array
725 ## This procedure is called after the public configure routine and after
726 ## the "basecmd" key has been added to the $w array. Ideally, this proc
727 ## would be used to do any widget specific one-time initialization.
729 ## $CLASSNAME:destroy {w} => return ignored (should be empty)
730 ## w - the widget name, also the name of the global data array
731 ## A default destroy handler is provided that cleans up after the megawidget
732 ## (all state info), but if special cleanup stuff is needed, you would provide
733 ## it in this procedure. This is the first proc called in the default destroy
737 ;proc ScrolledText:construct {w} {
740 grid $data(text) $data(yscrollbar) -sticky news
741 grid $data(xscrollbar) -sticky ew
742 grid columnconfig $w 0 -weight 1
743 grid rowconfig $w 0 -weight 1
744 grid remove $data(yscrollbar) $data(xscrollbar)
745 bind $data(text) <Configure> [list ScrolledText:resize $w 1]
748 ;proc ScrolledText:configure {w args} {
750 set truth {^(1|yes|true|on)$}
751 foreach {key val} $args {
754 set data($key) [regexp -nocase $truth $val]
756 ScrolledText:resize $w 0
758 grid $data(xscrollbar)
759 grid $data(yscrollbar)
766 ;proc ScrolledText_xview {w args} {
768 if {[catch {uplevel $data(basecmd) xview $args} err]} {
769 return -code error $err
773 ;proc ScrolledText_yview {w args} {
775 if {[catch {uplevel $data(basecmd) yview $args} err]} {
776 return -code error $err
777 } elseif {![winfo ismapped $data(xscrollbar)] && \
778 [string compare {0 1} [$data(basecmd) xview]]} {
779 ## If the xscrollbar was unmapped, but is now needed, show it
780 grid $data(xscrollbar)
784 ;proc ScrolledText_insert {w args} {
786 set code [catch {uplevel $data(basecmd) insert $args} err]
787 if {[winfo ismapped $w]} { ScrolledText:resize $w 0 }
788 return -code $code $err
791 ;proc ScrolledText_delete {w args} {
793 set code [catch {uplevel $data(basecmd) delete $args} err]
794 if {[winfo ismapped $w]} { ScrolledText:resize $w 1 }
795 return -code $code $err
798 ;proc ScrolledText:resize {w d} {
800 ## Only when deleting should we consider removing the scrollbars
801 if {!$data(-autoscrollbar)} return
802 if {[string compare {0 1} [$data(basecmd) xview]]} {
803 grid $data(xscrollbar)
805 grid remove $data(xscrollbar)
807 if {[string compare {0 1} [$data(basecmd) yview]]} {
808 grid $data(yscrollbar)
810 grid remove $data(yscrollbar)