Bwidget Source Code
Check-in [3b6bda131c]
Not logged in
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:widget.tcl: Widget::define got new parameter -namespace, allowing megawidget namespace be different to class name. This allows lower case namespace names. Patch by Adrian Medrano Calvo. Ticket [023a631b20]
Timelines: family | ancestors | descendants | both | bwidget
Files: files | file ages | folders
SHA1: 3b6bda131cc2cdc44ba13da00b39e0e36d6f5334
User & Date: oehhar 2015-03-18 13:11:34
References
2015-10-07
06:42
widget.tcl: Make Widget::configure invoke the command on the configured namespace of the included subwidget, instead of in it subclass.

This case was missing in check-in [3b6bda131cc2cdc44ba13da00b39e0e36d6f5334]. check-in: e69f8fb3e7 user: adrianmedranocalvo tags: bwidget

2015-03-18
13:18 Closed ticket [023a631b20]: Lower-cased namespaces not supported plus 7 other changes artifact: 1140d9a2f5 user: oehhar
Context
2015-10-07
06:42
widget.tcl: Make Widget::configure invoke the command on the configured namespace of the included subwidget, instead of in it subclass.

This case was missing in check-in [3b6bda131cc2cdc44ba13da00b39e0e36d6f5334]. check-in: e69f8fb3e7 user: adrianmedranocalvo tags: bwidget

2015-03-18
13:11
widget.tcl: Widget::define got new parameter -namespace, allowing megawidget namespace be different to class name. This allows lower case namespace names. Patch by Adrian Medrano Calvo. Ticket [023a631b20] check-in: 3b6bda131c user: oehhar tags: bwidget
2014-09-10
14:32
BWidget 1.9.8 tagged check-in: 099dbd69bd user: oehhar tags: bwidget
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to BWman/Widget.html.

333
334
335
336
337
338
339



340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
    usually the first command executed in a new widget definition.
    </p>

<ul>
    <li><i>class</i> is the name of the new widget class.</li>
    <li><i>filename</i> is the name of the file (without extension) in the
    BWidget distribution that defines this class.</li>



</ul>

    <p>
    Each class defined after the filename is a class that this widget
    depends on.  The ::use command will be called for each of these
    classes after the new widget has been defined.
    </p>

    <p>
    This command does several things to setup the new class.  First, it
    creates an alias in the global namespace for the name of the class
    that points to the class's ::create subcommand.  Second, it defines
    a ::use subcommand for the class which other classes can use to load
    this class on the fly.  Lastly, it creates a default binding to the
    &lt;Destroy&gt; event for the class that calls Widget::destroy on
    the path.  This is the default setup for almost all widgets in the
    BWidget package.
    </p>

</DD></DL>

<DL><DT><A NAME="destroy">Widget::<B>destroy</B></A>
 <I>path</I>
</DT><DD>






>
>
>









|
|
|
|
|
|
|
|







333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
    usually the first command executed in a new widget definition.
    </p>

<ul>
    <li><i>class</i> is the name of the new widget class.</li>
    <li><i>filename</i> is the name of the file (without extension) in the
    BWidget distribution that defines this class.</li>
    <li><i>?-classonly?</i> If present, the class is not setup.</li>
    <li><i>?-namespace ns?</i> The namespace where the widget's procedures live
    in; defaults to the class name.</li>
</ul>

    <p>
    Each class defined after the filename is a class that this widget
    depends on.  The ::use command will be called for each of these
    classes after the new widget has been defined.
    </p>

    <p>
    If <i>-classonly</i> option is not given this command does several things to
    setup the new class.  First, it creates an alias in the global namespace for
    the name of the class that points to the class's ::create subcommand.
    Second, it defines a ::use subcommand for the class which other classes can
    use to load this class on the fly.  Lastly, it creates a default binding to
    the &lt;Destroy&gt; event for the class that calls Widget::destroy on the
    path.  This is the default setup for almost all widgets in the BWidget
    package.
    </p>

</DD></DL>

<DL><DT><A NAME="destroy">Widget::<B>destroy</B></A>
 <I>path</I>
</DT><DD>

Changes to ChangeLog.








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35






2014-09-10 Harald Oehlmann <[email protected]>

	**** BWidget 1.9.8 tagged ****

2014-09-05 Harald Oehlmann <[email protected]>

	widget.tcl: Widget::which errors when option not present.
	Ticket [397db23424]

2014-05-21 Harald Oehlmann <[email protected]>

        widget.tcl: Don't invoke unqualified upvar in callers
        scope. Patch by Adrian Medrano Calvo. Ticket [046fa04231]

        widget.tcl: Don't double creation of temporary widget for
        default values retrieval. Use result of _get_tkwidget_options
        instead. By Adrian Medrano Calvo. Ticket [393b67ab19]

        widget.tcl: New procedure Widget::which (as in [namespace which]),
        that returns the fully qualified name for a widget option or
        widget variable. By Adrian Medrano Calvo. Ticket [a8705e5fd9]

        widget.tcl: Remove unneeded upvar. By Adrian Medrano Calvo.
        Ticket [43f93e0a97]
        
        widget.tcl et al: remove apparently unused procedure
        Widget::syncoptions and all calls. By Adrian Medrano Calvo.
        Ticket [3c2b8eafc6]


2013-12-13 Harald Oehlmann <[email protected]>

	scrollframe.tcl: Make -constrainedwidth 1 and
	-constrainedheight 1 work together.
	Patch by Simon Bachmann. Ticket [2fa44401d5]
>
>
>
>
>
>
>











|
|

|
|
|

|
|
|

|
|
|
|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
2015-03-18 Harald Oehlmann <[email protected]>

	widget.tcl: Widget::define got new parameter -namespace,
	allowing megawidget namespace be different to
	class name. This allows lower case namespace names.
	Patch by Adrian Medrano Calvo. Ticket [023a631b20]

2014-09-10 Harald Oehlmann <[email protected]>

	**** BWidget 1.9.8 tagged ****

2014-09-05 Harald Oehlmann <[email protected]>

	widget.tcl: Widget::which errors when option not present.
	Ticket [397db23424]

2014-05-21 Harald Oehlmann <[email protected]>

	widget.tcl: Don't invoke unqualified upvar in callers
	scope. Patch by Adrian Medrano Calvo. Ticket [046fa04231]

	widget.tcl: Don't double creation of temporary widget for
	default values retrieval. Use result of _get_tkwidget_options
	instead. By Adrian Medrano Calvo. Ticket [393b67ab19]

	widget.tcl: New procedure Widget::which (as in [namespace which]),
	that returns the fully qualified name for a widget option or
	widget variable. By Adrian Medrano Calvo. Ticket [a8705e5fd9]

	widget.tcl: Remove unneeded upvar. By Adrian Medrano Calvo.
	Ticket [43f93e0a97]

	widget.tcl et al: remove apparently unused procedure
	Widget::syncoptions and all calls. By Adrian Medrano Calvo.
	Ticket [3c2b8eafc6]


2013-12-13 Harald Oehlmann <[email protected]>

	scrollframe.tcl: Make -constrainedwidth 1 and
	-constrainedheight 1 work together.
	Patch by Simon Bachmann. Ticket [2fa44401d5]

Changes to widget.tcl.

398
399
400
401
402
403
404


















405
406




















407
408

409
410
411
412
413
414
415




416



417
418
419
420










421
422
423
424
425






426
427
428
429
430
431
432
433
434
...
750
751
752
753
754
755
756
757






758

759
760
761
762
763
764
765
....
1516
1517
1518
1519
1520
1521
1522

1523
1524
1525
1526
1527
1528
1529
1530
....
1554
1555
1556
1557
1558
1559
1560

1561
1562
1563
1564
1565
1566
1567
1568
1569
	set exports($option) $optionDbName
        # for any other resource type, we keep original optdesc
        set classopt($option) [list $type $value $ro $arg]
    }
}




















proc Widget::define { class filename args } {
    variable ::BWidget::use




















    set use($class)      $args
    set use($class,file) $filename

    lappend use(classes) $class

    if {[set x [lsearch -exact $args "-classonly"]] > -1} {
	set args [lreplace $args $x $x]
    } else {
	interp alias {} ::${class} {} ${class}::create
	proc ::${class}::use {} {}








	bind $class <Destroy> [list Widget::destroy %W]
    }

    foreach class $args { ${class}::use }










}


proc Widget::create { class path {rename 1} } {
    if {$rename} { rename $path ::$path:cmd }






    proc ::$path { cmd args } \
    	[subst {return \[eval \[linsert \$args 0 ${class}::\$cmd [list $path]\]\]}]
    return $path
}


# ----------------------------------------------------------------------------
#  Command Widget::addmap
# ----------------------------------------------------------------------------
................................................................................
    }
    if {[info exists pathinit]} {
        unset pathinit
    }

    if {![string equal [info commands $path] ""]} { rename $path "" }

    ## Unset any variables used in this widget.






    foreach var [info vars ::${class}::$path:*] { unset $var }


    unset _class($path)
}


# ----------------------------------------------------------------------------
#  Command Widget::configure
................................................................................
	    if { ![info exists pathopt($name)] } {
		error "unable to find variable for option \"$name\"";
	    }

	    return ::Widget::${class}::${path}:opt(${name});
	}
	-variable {

	    return ${class}::${path}:${name};
	}
    }
}


# Widget::varForOption --
#
................................................................................
#       newVarName	The variable name to refer to in the calling proc.
#
# Results:
#	Creates a reference to newVarName in the calling proc.
proc Widget::getVariable { path varName {newVarName ""} } {
    variable _class
    set class $_class($path)

    if {![string length $newVarName]} { set newVarName $varName }
    uplevel 1 [list ::upvar \#0 ${class}::$path:$varName $newVarName]
}

# Widget::options --
#
#       Return a key-value list of options for a widget.  This can
#       be used to serialize the options of a widget and pass them
#       on to a new widget with the same options.






>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>


>


<
<
<
<
<
>
>
>
>

>
>
>



|
>
>
>
>
>
>
>
>
>
>





>
>
>
>
>
>

|







 







|
>
>
>
>
>
>
|
>







 







>
|







 







>

|







398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449





450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
...
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
....
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
....
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
	set exports($option) $optionDbName
        # for any other resource type, we keep original optdesc
        set classopt($option) [list $type $value $ro $arg]
    }
}


# ----------------------------------------------------------------------------
#  Command Widget::define
#  	Declares a new class and loads its dependencies.
#
# Arguments:
#	class		megawidget class
#	filename	file where the class resides
#	options    	The following options are supported:
#			-classonly	Prevents megawidget setup: creation of
#					megawidget alias, binding of the
#					<Destroy> event and stubbing of the
#					'use' procedure.
#			-namespace ns	Indicate the namespace where the
#					megawidget's procedures reside. Defaults
#					to ::${class}.
#	dependencies   	classes the class being defined depends on.
#
# ----------------------------------------------------------------------------
proc Widget::define { class filename args } {
    variable ::BWidget::use
    set classonly 0;
    set ns ::${class};
    for {set i 0; set n [llength $args]} {$i < $n} {incr i} {
	set option [lindex $args $i];
	switch -- $option {
	    -classonly {
		set classonly 1;
	    }
	    -namespace {
		incr i;
		set ns [lindex $args $i];
	    }
	    default {
		# stop processing options
		break;
	    }
	}
    }
    set args [lrange $args $i end]

    set use($class)      $args
    set use($class,file) $filename
    set use($class,namespace) $ns;
    lappend use(classes) $class






    # Make sure the class description namespace exists.
    namespace eval $class {}
    # Make sure the megawidget namespace exists.
    namespace eval $ns {}

    if {!$classonly} {
	interp alias {} ${ns} {} ${ns}::create
	proc ${ns}::use {} {}
	bind $class <Destroy> [list Widget::destroy %W]
    }

    foreach dep $args {
	if {![info exists use(${dep},namespace)]} {
	    # Lazy-loaded modules are not yet loaded (actually that seems to be
	    # the whole point of this 'use' mechanism.) so they have not configured
	    # a namespace. Use namespace=class convention. Note that the class MUST
	    # not be prefixed by ::.
	    ${dep}::use;
	} else {
	    $use(${dep},namespace)::use;
	}
    }
}


proc Widget::create { class path {rename 1} } {
    if {$rename} { rename $path ::$path:cmd }

    variable ::BWidget::use;
    set ns [expr {[info exists use(${class},namespace)]
		  ? $use(${class},namespace)
		  : $class}];

    proc ::$path { cmd args } \
	[subst {return \[eval \[linsert \$args 0 ${ns}::\$cmd [list $path]\]\]}]
    return $path
}


# ----------------------------------------------------------------------------
#  Command Widget::addmap
# ----------------------------------------------------------------------------
................................................................................
    }
    if {[info exists pathinit]} {
        unset pathinit
    }

    if {![string equal [info commands $path] ""]} { rename $path "" }

    # Unset any variables used in this widget.
    # Guard, as some internal classes (Bitmap, LabelEntry, ListBox::Item,
    # NoteBook::Page, PanedWindow::Pane, ScrollableFrame, ScrollableFrame,
    # ScrollableFrame, Tree::Node, Wizard::Branch, Wizard::Step, Wizard::Widget)
    # are declared but not defined.
    if {[info exists ::BWidget::use(${class},namespace)]} {
	set ns $::BWidget::use(${class},namespace);
	foreach var [info vars ${ns}::${path}:*] { unset $var }
    }

    unset _class($path)
}


# ----------------------------------------------------------------------------
#  Command Widget::configure
................................................................................
	    if { ![info exists pathopt($name)] } {
		error "unable to find variable for option \"$name\"";
	    }

	    return ::Widget::${class}::${path}:opt(${name});
	}
	-variable {
	    set ns $::BWidget::use(${class},namespace);
	    return ${ns}::${path}:${name};
	}
    }
}


# Widget::varForOption --
#
................................................................................
#       newVarName	The variable name to refer to in the calling proc.
#
# Results:
#	Creates a reference to newVarName in the calling proc.
proc Widget::getVariable { path varName {newVarName ""} } {
    variable _class
    set class $_class($path)
    set ns $::BWidget::use(${class},namespace);
    if {![string length $newVarName]} { set newVarName $varName }
    uplevel 1 [list ::upvar \#0 ${ns}::${path}:${varName} $newVarName]
}

# Widget::options --
#
#       Return a key-value list of options for a widget.  This can
#       be used to serialize the options of a widget and pass them
#       on to a new widget with the same options.