DIY megawidgets
Jonathan Bromley
Tcl/Tk (yes, I know about BWidgets and so on, but partly for the
exercise and partly for portability reasons...)
I know I've seen, somewhere, in the past, a tutorial on how to
do this - but despite rummaging on the Wiki I can't find it,
although I've found several nice examples.
Any pointers would be welcome.
Anyhow, in the absence of a tutorial, I started this way -
the example megawidget is a custom progressbar, but that doesn't
matter...
1) User script says [progressbar .name], so I create
[frame -class Progressbar .name] so I can do class-wide
bindings.
2) I rename the widget proc .name, to hide it somewhere in ::tk.
3) I have a class-wide proc [Progressbar] hidden in ::tk
that, with suitable options and subcommands, can implement
everything I need to do to the megawidget.
3) I create a new proc .name that just calls [::tk::Progressbar]
with suitable arguments.
And that leads me to two questions for you all...
a) Seems like I have to do a horribly large amount of work to get
this really robust - dealing correctly with <Destroy>, managing
linked variables, making sure user-defined bindings don't mess
up the stuff I did. Nothing outrageously difficult, but a lot
of work. Does this match other people's experience? Or have
I missed some simple, elegant way of doing it?
b) My megawidget of course creates various children of the "base"
frame. Is there any way I can hide these child widgets,
so that users can't find out about them with [winfo children]
and mistakenly do inappropriate things to them?
TIA
--
Jonathan Bromley, Consultant
DOULOS - Developing Design Know-how
VHDL * Verilog * SystemC * Perl * Tcl/Tk * Verification * Project Services
Doulos Ltd. Church Hatch, 22 Market Place, Ringwood, Hampshire, BH24 1AW, UK
Tel: +44 (0)1425 471223 mail: jonathan...@doulos.com
Fax: +44 (0)1425 471573 Web: http://www.doulos.com
The contents of this message may contain personal views which
are not the views of Doulos Ltd., unless specifically stated.
lvi...@yahoo.com
According to Jonathan Bromley <jonathan...@doulos.com>:
:partly for portability reasons...)
Hmm? BWidgets has some portability issues? With what platform or
window manager?
:I know I've seen, somewhere, in the past, a tutorial on how to
:do this - but despite rummaging on the Wiki I can't find it,
:although I've found several nice examples.
:Any pointers would be welcome.
If someone has some tutorial information or pointers, the wiki is
publically available to add such info so that the next 'Jonathan' who
comes along can find it easier <smile>.
:Anyhow, in the absence of a tutorial, I started this way -
:a) Seems like I have to do a horribly large amount of work to get
: this really robust - dealing correctly with <Destroy>, managing
: linked variables, making sure user-defined bindings don't mess
: up the stuff I did. Nothing outrageously difficult, but a lot
: of work. Does this match other people's experience? Or have
: I missed some simple, elegant way of doing it?
To build robust megawidgets simply or elegantly would require a framework
designed for that purpose. To add such a framework to the Tk core has
been a request for quite a number of years. To date, such a framework
has not been integrated into Tk.
There are external megawidget frameworks available - Itk, Snit, Jeff
Hobbs megawidget, otcl, and others that will surely be mentioned .
--
<URL: http://wiki.tcl.tk/ > <URL: http://www.tcl.tk/ >
Even if explicitly stated to the contrary, nothing in this posting
should be construed as representing my employer's opinions.
<URL: mailto:lvi...@yahoo.com > <URL: http://www.purl.org/NET/lvirden/ >
Jonathan Bromley
news:bjprlq$3r9$3...@srv38.cas.org...
> Hmm? BWidgets has some portability issues? With what platform or
> window manager?
No, no, no! Simply that not everyone may have it installed.
Anyhow, the main motivation was to see whether I could do it -
I'm not trying to solve the world's problems, not yet anyways.
> To build robust megawidgets simply or elegantly would require a framework
> designed for that purpose. To add such a framework to the Tk core has
> been a request for quite a number of years. To date, such a framework
> has not been integrated into Tk.
>
> There are external megawidget frameworks available - Itk, Snit, Jeff
> Hobbs megawidget, otcl, and others that will surely be mentioned .
OK, I was aware of some but not all of these. Thanks.
Bryan Oakley
>
> 1) User script says [progressbar .name], so I create
> [frame -class Progressbar .name] so I can do class-wide
> bindings.
Make sure the proc is inside a namespace. Thus, the fully qualified
example would be "::progressbar::progressbar .name"
> 2) I rename the widget proc .name, to hide it somewhere in ::tk.
Don't hide it under ::tk; hide it under your own namespace (eg:
::progressbar).
> 3) I have a class-wide proc [Progressbar] hidden in ::tk
> that, with suitable options and subcommands, can implement
> everything I need to do to the megawidget.
> 3) I create a new proc .name that just calls [::tk::Progressbar]
> with suitable arguments.
Yes; the proc you create for the widget should just be a small stub that
calls the generic proc with it's own name as a parameter. I usually name
this generic proc "widgetProxy" (eg: ::progressbar::widgetProxy), but it
seems about once a year or so I change my mind about that.
When I create a widget instance, I create a namespace for that widget.
In that namespace are variables to contain various stuff such as config
options and widget paths. The code looks roughly like this (for
illustrative purposes only; I haven't run or tested this code).
proc ::mywidget::mywidget {path args} {
# establish namespace
namespace eval ::mywidget::$path {
variable config
variable widgets
}
# create the base frame. Once this exists you can
# access the option database to retrieve default
# values for options.
frame $path -class Mywidget \
-borderwidth $config(-borderwidth) \
-relief $config(-relief) \
....
# set default options. Ideally you'd use the option
# database to get these values but this is good enough
# for this example
array set config {
-option1 "default for option1"
-option2 "default for option2"
....
}
# for a polished widget you need to parse the args
# but for a quick'n' dirty solution you can do this
# to set the instance-specific config values. To be
# pedantic you need to make sure that if any options
# are bad the widget is not created.
array set config $args
# this creates all the subwidgets and bindings and
# so on.
::mywidget::create $path
# finally, do the rename and either create a proc or
# an alias to work in its place
rename $path ::mywidget::${w}::widget
interp alias {} ::$w {} ::mywidget::widgetProxy $w
return $path
}
With that established, my proxy command uses the magic of the 'variable'
command to make the config and widget arrays available locally:
proc ::mywidget::widgetProxy {w args} {
variable ::mywidget::${w}::config
variable ::mywidget::${w}::widgets
set command [lindex $args 0]
if {$command eq "cget"} {
set option [lindex $args 1]
if {[info exists config($option)]} {
return $config($option)
} else {
return -code error "unknown option \"$option\""
}
elseif {...
}
I usually have procs for each subcommand (cget, configure, etc) to keep
widgetProxy as lean as possible, so the above is just to show how the
variables work.
>
> And that leads me to two questions for you all...
> a) Seems like I have to do a horribly large amount of work to get
> this really robust - dealing correctly with <Destroy>, managing
> linked variables, making sure user-defined bindings don't mess
> up the stuff I did. Nothing outrageously difficult, but a lot
> of work. Does this match other people's experience? Or have
> I missed some simple, elegant way of doing it?
You are correct: it is a large amount of work to get it completely,
totally right. Focus management can be a real pain depending on what
type of subwidgets you have. You also have to worry about error
propagation. It's a good exercise though -- it helps you to really
understand how widgets work.
> b) My megawidget of course creates various children of the "base"
> frame. Is there any way I can hide these child widgets,
> so that users can't find out about them with [winfo children]
> and mistakenly do inappropriate things to them?
No. That's something that hopefully will someday be addressed by the
core. In practice I don't find this to be an issue.
Jonathan Bromley
news:1518b.84$Ow5...@newssvr24.news.prodigy.com...
> > 2) I rename the widget proc .name, to hide it somewhere in ::tk.
>
> Don't hide it under ::tk; hide it under your own namespace (eg:
> ::progressbar).
OK, that makes sense.
> When I create a widget instance, I create a namespace for that widget.
[... snip sensible stuff, cleaner than my efforts]
> # finally, do the rename and either create a proc or
> # an alias to work in its place
> rename $path ::mywidget::${w}::widget
> interp alias {} ::$w {} ::mywidget::widgetProxy $w
[...]
> With that established, my proxy command uses the magic of the 'variable'
> command to make the config and widget arrays available locally:
>
> proc ::mywidget::widgetProxy {w args} {
> variable ::mywidget::${w}::config
> variable ::mywidget::${w}::widgets
Cool. Memo to self: find out about [interp alias] soon.
> You are correct: it is a large amount of work to get it completely,
> totally right. Focus management can be a real pain depending on what
> type of subwidgets you have. You also have to worry about error
> propagation. It's a good exercise though -- it helps you to really
> understand how widgets work.
That was more or less the point. Thanks for the sanity check, and
the heads-up about focus.
Many thanks for the very helpful response. I need it - simple-minded
electronics engineers like me can't be expected to sort this kind of
thing out for themselves :-)
Bob Techentin
... a great narrative on creating a megawidget
That's a great summary and tutorial, Bryan. Have you thought about
wiki-fying it? Searching for 'megawidget' yields less than a dozen
pages, and "Creating a BWidget Widget" is very detailed and specific
to that package.
Bob
--
Bob Techentin techenti...@NOSPAMmayo.edu
Mayo Foundation (507) 538-5495
200 First St. SW FAX (507) 284-9171
Rochester MN, 55901 USA http://www.mayo.edu/sppdg/
David N. Welton
> "Bryan Oakley" <br...@bitmover.com> wrote
> ... a great narrative on creating a megawidget
>
> That's a great summary and tutorial, Bryan. Have you thought about
> wiki-fying it? Searching for 'megawidget' yields less than a dozen
> pages, and "Creating a BWidget Widget" is very detailed and specific
> to that package.
I was going to suggest this too. It would make a good article for the
wiki or elsewhere.
--
David N. Welton
Consulting: http://www.dedasys.com/
Personal: http://www.dedasys.com/davidw/
Free Software: http://www.dedasys.com/freesoftware/
Apache Tcl: http://tcl.apache.org/
Steve Lidie
> Jonathan Bromley wrote:
>>
>> 1) User script says [progressbar .name], so I create
>> [frame -class Progressbar .name] so I can do class-wide
>> bindings.
If your mega-widget is based, say, on a Canvas, does it make sense to
have the extra baggae of a Frame to carry about?
>
> Make sure the proc is inside a namespace. Thus, the fully qualified
> example would be "::progressbar::progressbar .name"
>
>> 2) I rename the widget proc .name, to hide it somewhere in ::tk.
>
> Don't hide it under ::tk; hide it under your own namespace (eg:
> ::progressbar).
Yes.
>
>
>> 3) I have a class-wide proc [Progressbar] hidden in ::tk
>> that, with suitable options and subcommands, can implement
>> everything I need to do to the megawidget.
>> 3) I create a new proc .name that just calls [::tk::Progressbar]
>> with suitable arguments.
>
> Yes; the proc you create for the widget should just be a small stub that
> calls the generic proc with it's own name as a parameter. I usually name
> this generic proc "widgetProxy" (eg: ::progressbar::widgetProxy), but it
> seems about once a year or so I change my mind about that.
Now is where the curently under consideration Tk Revitalization:
Mega-widget Framework (http://tcl.projectforum.com/tk/126) is
important - this work (it seems) should be part of the framwork
and done automatically on behalf of the author of the mega-widget.
>
> When I create a widget instance, I create a namespace for that widget.
> In that namespace are variables to contain various stuff such as config
> options and widget paths. The code looks roughly like this (for
> illustrative purposes only; I haven't run or tested this code).
>
> proc ::mywidget::mywidget {path args} {
>
> # establish namespace
> namespace eval ::mywidget::$path {
> variable config
All option configuration handing should be transparent and done by the
framework.
cget() and configure() should be part of the framework.
>
>
>>
>> And that leads me to two questions for you all...
>> a) Seems like I have to do a horribly large amount of work to get
>> this really robust - dealing correctly with <Destroy>, managing
>> linked variables, making sure user-defined bindings don't mess
>> up the stuff I did. Nothing outrageously difficult, but a lot
>> of work. Does this match other people's experience? Or have
>> I missed some simple, elegant way of doing it?
>
> You are correct: it is a large amount of work to get it completely,
> totally right. Focus management can be a real pain depending on what
> type of subwidgets you have. You also have to worry about error
> propagation. It's a good exercise though -- it helps you to really
> understand how widgets work.
>
>
>> b) My megawidget of course creates various children of the "base"
>> frame. Is there any way I can hide these child widgets,
>> so that users can't find out about them with [winfo children]
>> and mistakenly do inappropriate things to them?
>
> No. That's something that hopefully will someday be addressed by the
> core. In practice I don't find this to be an issue.
>
>
Again, there is discussion on this topic at the revitalization URL
given above. I have found there are times when it is proper to allow
access to subwidgets.
My intent here is ceratinly not to critique, but to get the
mega-widget discussion moving - I think it's very important and should
be part of core Tcl/Tk. Bryan, I know you are already involved, others
may not know about the project yet ...
Mark G. Saye
> Bryan Oakley <br...@bitmover.com> wrote:
>
>>Jonathan Bromley wrote:
>>
>>>1) User script says [progressbar .name], so I create
>>> [frame -class Progressbar .name] so I can do class-wide
>>> bindings.
>
>
> If your mega-widget is based, say, on a Canvas, does it make sense to
> have the extra baggae of a Frame to carry about?
Unfortunately, yes. Although you do have the extra baggage of a frame,
the ability to set the frame's class is very important. This enables
import of options (from the options database), and class bindings (and
probably a few other concepts I can't think of at the moment)
--
Mark G. Saye
markgsaye @ yahoo.com
ulis
> this really robust - dealing correctly with <Destroy>, managing
> linked variables, making sure user-defined bindings don't mess
> up the stuff I did. Nothing outrageously difficult, but a lot
> of work. Does this match other people's experience? Or have
> I missed some simple, elegant way of doing it?
From my experiment a megawidget is a 1,000 lines script.
(you can find my megawidgets here: http://perso.wanadoo.fr/maurice.ulis/tcl)
I also wrote minimal megawidgets with 150 lines (http://mini.net/tcl/9590)
> b) My megawidget of course creates various children of the "base"
> frame. Is there any way I can hide these child widgets,
> so that users can't find out about them with [winfo children]
> and mistakenly do inappropriate things to them?
Never find how.
ulis
Will Duquette
On Thu, 11 Sep 2003 16:07:25 GMT, Bryan Oakley <br...@bitmover.com>
wrote:
(A whole bunch of good stuff about creating megawidgets in pure Tcl)
Just for the record, Snit does this stuff for you--and it's a lot
simpler than BWidgets.
Will
Marco Maggi
Jonathan,
I don't have the experience of the other people that
already replied to you, but I have to disagree with the
mega-widget model that's been proposed. The interface:
instance subcommand -option value -option value ...
is good and fast if [instance] is the access door to C
language code, but, in my opinion, is not good for TCL
code.
I personally don't see why one should want the
cget/configure interface: the option database may be used to
configure the widget appearance, and other operations on the
widgets may be easily carried out by a procedure
invocation. Correct me if I'm wrong but: options propagation
to subwidgets is a nightmare if you do it from a top level
[configure]. The options database, instead, is really
clean.
My point of view is that if you look at the mega-widget as
a box that encloses sub-widgets, sooner or later you'll find
yourself in the need to make holes in the box to reach
what's inside. That's the feeling that some frameworks like
[Incr Tk] give to me.
A mega-widget is just another module like all the other
ones in an application. Why do you want to treat it
differently?
I'm going to show some code from my implementation of the
combobox/selectbox mega-widgets; I'm not including
everything.
I know that maybe I'm exaggerating once again...
The modules I'm not including are:
* the "task" package, it's just a collection of variables,
like an array;
* "base", common procedures to set/get options in the
options database, to add tags to widgets, etc.;
* "entry", "listbox", "button": provide procedures to
uniform the interface of widgets, for example there are
[content_get] and [content_set] procedures to get/set data
into the listbox and entry widgets.
* I have a separate file with the option's database
settings (a lot of them).
----------------------------------------
# This is the list selector module, the interface to both
# the combobox and the selectbox.
namespace eval UWP::listselector {
namespace export \[a-z]*
namespace eval task { namespace import ::UWP::task::* }
}
proc UWP::listselector::constructor { _list _selection } {
set token [task::constructor \
current_list \
current_selection \
selection_update_script \
list_update_script]
set current_list $_list
set current_selection $_selection
return $token
}
proc UWP::listselector::destructor { token } {
task::destructor $token
}
proc UWP::listselector::register_selection_update_script { token script } {
task::globset $token selection_update_script $script
}
proc UWP::listselector::register_list_update_script { token script } {
task::globset $token list_update_script $script
}
proc UWP::listselector::content_set { token _list } {
task::global $token current_list list_update_script
set current_list $_list
if { [string length $list_update_script] } {
namespace eval :: $list_update_script
}
}
proc UWP::listselector::content_get { token } {
return [task::globget $token current_list]
}
proc UWP::listselector::selection_set { token _selection } {
task::global $token current_selection selection_update_script
set current_selection $_selection
if { [string length $selection_update_script] } {
namespace eval :: $selection_update_script
}
}
proc UWP::listselector::selection_get { token } {
return [task::globget $token current_selection]
}
----------------------------------------
# This is a module that links together an entry and a
# listbox.
namespace eval UWP::entrylistbox {
namespace export \[a-z\]*
namespace eval tk { namespace import ::UWP::tk::* }
namespace eval base { namespace import ::UWP::base::* }
namespace eval entry { namespace import ::UWP::entry::* }
namespace eval listbox { namespace import ::UWP::listbox::* }
namespace eval listselector { namespace import ::UWP::listselector::* }
set ns [namespace current]
# Entry bindings.
set tag UWPTagEntryListbox_Entry
tk::bind $tag <<UWPSubmit>> +[namespace code "_event_entry_submit %W"]
tk::bind $tag <<UWPPrev>> +[namespace code "_event_entry_prev %W"]
tk::bind $tag <<UWPNext>> +[namespace code "_event_entry_next %W"]
tk::bind $tag <<UWPPrevMore>> +[namespace code "_event_entry_prevmore %W"]
tk::bind $tag <<UWPNextMore>> +[namespace code "_event_entry_nextmore %W"]
# Listbox bindings.
set tag UWPTagEntryListbox_Listbox
tk::bind $tag <<UWPSubmit>> \
+[namespace code "_event_listbox_submit %W"]
tk::bind $tag <<UWPSelection>> \
+[namespace code "_event_listbox_selection %W"]
tk::bind $tag <Map> +[namespace code "_event_listbox_map %W"]
tk::bind $tag <FocusIn> +[namespace code "_event_listbox_focusin %W"]
unset ns tag
}
proc UWP::entrylistbox::initialise { selector entry listbox } {
upvar ::UWP::data data
entry::content_set $entry [listselector::selection_get $selector]
listbox::content_set $listbox [listselector::content_get $selector]
listselector::register_list_update_script $selector \
[namespace code "_event_listupdated $entry $listbox $selector"]
set data($entry:entrylistbox_listbox) $listbox
set data($entry:entrylistbox_selector) $selector
set data($listbox:entrylistbox_entry) $entry
set data($listbox:entrylistbox_selector) $selector
base::tagadd $entry UWPTagEntryListbox_Entry
base::tagadd $listbox UWPTagEntryListbox_Listbox
}
proc UWP::entrylistbox::_event_listupdated { entry listbox selector } {
listbox::content_set $listbox [listselector::content_get $selector]
entry::content_set $entry [lindex $list 0]
return
}
proc UWP::entrylistbox::_event_entry_submit { entry } {
upvar ::UWP::data data
set content [entry::content_get $entry]
listbox::selection_set $data($entry:entrylistbox_listbox) $content
listselector::selection_set \
$data($entry:entrylistbox_selector) $content
}
proc UWP::entrylistbox::_event_entry_prev { entry } {
tk::event generate $::UWP::data($entry:entrylistbox_listbox) <<UWPPrev>>
}
proc UWP::entrylistbox::_event_entry_next { entry } {
tk::event generate $::UWP::data($entry:entrylistbox_listbox) <<UWPNext>>
}
proc UWP::entrylistbox::_event_entry_prevmore { entry } {
tk::event generate $::UWP::data($entry:entrylistbox_listbox) <<UWPPrevMore>>
}
proc UWP::entrylistbox::_event_entry_nextmore { entry } {
tk::event generate $::UWP::data($entry:entrylistbox_listbox) <<UWPNextMore>>
}
proc UWP::entrylistbox::_event_listbox_selection { listbox } {
set entry $::UWP::data($listbox:entrylistbox_entry)
entry::content_set $entry [listbox::selection_get $listbox]
entry::focus $entry
}
proc UWP::entrylistbox::_event_listbox_map { listbox } {
listbox::selection_set $listbox \
[entry::selection_get $::UWP::data($listbox:entrylistbox_entry)]
}
proc UWP::entrylistbox::_event_listbox_focusin { listbox } {
entry::focus $::UWP::data($listbox:entrylistbox_entry)
}
proc UWP::entrylistbox::_event_listbox_submit { listbox } {
listselector::selection_set $::UWP::data($listbox:entrylistbox_selector) \
[entry::content_get $::UWP::data($listbox:entrylistbox_entry)]
}
----------------------------------------
# This is the selectbox-specific code: a single procedure.
namespace eval UWP::selectbox {
namespace eval tk { namespace import ::UWP::tk::* }
namespace eval base { namespace import ::UWP::base::* }
namespace eval entry { namespace import ::UWP::entry::* }
namespace eval listbox { namespace import ::UWP::listbox::* }
namespace eval listselector { namespace import ::UWP::listselector::* }
namespace eval entrylistbox { namespace import ::UWP::entrylistbox::* }
}
proc UWP::selectbox::constructor { selector {master {}} } {
if { [string length $master] == 0 } {
set master [base::unique]
}
tk::frame $master -class Uwpselectbox
entry::constructor [set e $master.entry]
listbox::constructor [set l $master.listbox]
base::tagadd $e UWPTagSelectboxEntry
base::tagadd $l UWPTagSelectboxListbox
entrylistbox::initialise $selector $e $l
# Grid widgets.
tk::grid columnconfigure $master 0 -weight 1
tk::grid columnconfigure $master 1 -weight 0
tk::grid $e -row 0 -column 0 -sticky news -padx 0 -pady 2 -ipadx 0 -ipady 0
tk::grid $l -row 1 -column 0 -sticky news -padx 0 -pady 0 -ipadx 0 -ipady 0
set scrollbars [base::opget $master scrollbars]
set addit 0
switch $scrollbars {
both -
vertical { set addit 1 }
maybe {
set len [llength [listselector::content_get $selector]]
set height [$l cget -height]
set addit [expr {($len > $height)? 1 : 0}]
}
}
if { $addit } {
set v $master.vscroll
tk::scrollbar $v -orient vertical
tk::grid $v -sticky ns -row 1 -column 1
base::addvscroll $l $v
}
if { [lsearch { both horizontal } $scrollbars] >= 0 } {
set h $master.hscroll
tk::scrollbar $h -orient horizontal
tk::grid $h -sticky ew -row 2 -column 0
base::addhscroll $l $h
}
return $master
}
----------------------------------------
# This is the combobox-specific code.
namespace eval UWP::combobox {
namespace eval tk { namespace import ::UWP::tk::* }
namespace eval base { namespace import ::UWP::base::* }
namespace eval button { namespace import ::UWP::button::* }
namespace eval entry { namespace import ::UWP::entry::* }
namespace eval listbox { namespace import ::UWP::listbox::* }
namespace eval listselector { namespace import ::UWP::listselector::* }
namespace eval entrylistbox { namespace import ::UWP::entrylistbox::* }
set ns [namespace current]
tk::bind UWPTagCombobox <Visibility> "+${ns}::unpost %W"
set s "+${ns}::unpost \[winfo parent %W\]"
tk::bind UWPTagComboboxEntry <Return> $s
tk::bind UWPTagComboboxEntry <Double-ButtonRelease-1> $s
tk::bind UWPTagComboboxListbox <ButtonRelease-1> \
"+${ns}::unpost \[winfo parent \[winfo parent %W\]\]"
unset ns s
}
proc UWP::combobox::constructor { selector {master {}} } {
if { [string length $master] == 0 } {
set master [base::unique]
}
tk::frame $master -class Uwpcombobox
entry::constructor [set e $master.entry]
button::constructor $master.button \
-padx 0 -pady 0 -highlightthickness 0 -takefocus 0
tk::toplevel [set t $master.toplevel] \
-takefocus 0 -highlightthickness 0 -padx 0 -pady 0
listbox::constructor [set l $master.toplevel.listbox]
tk::wm withdraw $t
tk::wm focusmodel $t active
tk::wm group $t [tk::winfo toplevel $t]
tk::wm overrideredirect $t 1
tk::wm positionfrom $t program
tk::wm resizable $t 0 0
tk::wm sizefrom $t program
tk::wm transient $t
base::tagadd $master UWPTagCombobox
base::tagadd $e UWPTagComboboxEntry
base::tagadd $master.button UWPTagComboboxButton
base::tagadd $l UWPTagComboboxListbox
entrylistbox::initialise $selector $e $l
# Grid $masters.
tk::grid columnconfigure $master 0 -weight 1
tk::grid columnconfigure $master 1 -weight 0
tk::grid $e -row 0 -column 0 -sticky news
tk::grid $master.button -row 0 -column 1 -sticky news
tk::grid columnconfigure $t 0 -weight 1
tk::grid columnconfigure $t 1 -weight 0
tk::grid $l -sticky news -row 0 -column 0 -padx 0 -pady 0
set scrollbars [base::opget $master scrollbars]
if { [lsearch { both vertical maybe } $scrollbars] >= 0 } {
set v $t.vscroll
tk::scrollbar $v -orient vertical
tk::grid $v -sticky ns -row 0 -column 1
base::addvscroll $l $v
}
if { [lsearch { both horizontal } $scrollbars] >= 0 } {
set h $t.hscroll
tk::scrollbar $h -orient horizontal
tk::grid $h -sticky ew -row 1 -column 0
base::addhscroll $l $h
}
# Bindings.
$master.button configure \
-command [namespace code "_event_togglepost $master"]
return $master
}
proc UWP::combobox::_event_togglepost { master } {
if { [tk::winfo ismapped $master.toplevel] } {
unpost $master
} else {
post $master
}
}
proc UWP::combobox::post { master } {
if { [tk::winfo ismapped $master.toplevel] } {
return
}
set e $master.entry
set l $master.toplevel.listbox
set t $master.toplevel
set v $t.vscroll
# Compute the X and Y window geometry coordinates of the upper left
# corner of the popup window.
set x [tk::winfo rootx $e]
set y [expr {[tk::winfo rooty $master] + [tk::winfo reqheight $master]}]
# Acquire the "maxheight" option and configure its default value if
# required.
set maxheight [base::opget $master maxheight]
if { (! [string is integer -strict $maxheight]) || ($maxheight < 0) } {
set maxheight 10
}
# Configure the "listbox" widget height and manage the "scrollbar"
# widget presence if the "scrollbars" option is "maybe".
set size [llength [$l get 0 end]]
set scrollbars [base::opget $master scrollbars]
if { $size <= $maxheight } {
$l configure -height $size
catch {tk::grid remove $v}
} else {
$l configure -height $maxheight
if { [string equal $scrollbars maybe] } {
catch {tk::grid $v -row 0 -column 1 -sticky ns}
}
}
$l configure -width [$e cget -width]
tk::wm geometry $t [format "+%d+%d" $x $y]
tk::wm transient $t [tk::winfo toplevel $master]
tk::wm deiconify $t
tk::raise $t
return
}
proc UWP::combobox::unpost { master } {
tk::wm withdraw [set t $master.toplevel]
tk::wm transient $t
return
}
----------------------------------------
To use the code I do:
set lst { .... }
set token [UWP::listselector::constructor $lst {}]
set selectbox [UWP::selectbox::constructor $token \
.frame1.combo1]
$selectbox is just a frame. The user code talks to the
listselector module and never accesses the
selectbox/combobox procedures.
The only "destruction bindings" are of the type:
tk::bind $tag <Destroy> "array unset ::UWP::data %W:*"
and are located in the "entry" and "listbox" modules.
It's still alpha code and I've tested it only on Linux,
but it seems to work. I don't see how a mega-widget
framework with a single instance command and cget/configure
methods could make it simpler and more efficient.
Ciao.
--
"and there was trouble taking place..."
P.J. Harvey - "The Garden"
Jonathan Bromley
news:87k78fd...@bolt.moon...
>
> Jonathan,
>
> I don't have the experience of the other people that
> already replied to you, but I have to disagree with the
> mega-widget model that's been proposed.
[snip lots of interesting discussion and LOTS of code]
Marco,
many thanks for your input. I can't respond intelligently for
quite some time, because you've given me rather a lot to
look at and other priorities intervene. But I'm keeping
your stuff for later study, and I hope I can do you the
courtesy of a proper reply before too long. Thanks again.