Bwidget Source Code
Check-in [97c7fd38ff]
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:New procedure Widget::which (as in [namespace which]), that returns the fully qualified name for a widget option or widget variable. Ticket [a8705e5fd9]
Timelines: family | ancestors | descendants | both | bwidget
Files: files | file ages | folders
SHA1: 97c7fd38ff7728d17c9d428c9bd44dfe93d1a2da
User & Date: oehhar 2014-05-21 07:32:51
References
2014-05-21
07:34 Closed ticket [fa5d30b3b3]: Add Widget::which procedure plus 7 other changes artifact: 9d405992db user: oehhar
Context
2014-05-21
07:36
Remove unneeded upvar. Ticket [43f93e0a97] check-in: 6e550c5f21 user: oehhar tags: bwidget
07:32
New procedure Widget::which (as in [namespace which]), that returns the fully qualified name for a widget option or widget variable. Ticket [a8705e5fd9] check-in: 97c7fd38ff user: oehhar tags: bwidget
07:14
Don't double creation of temporary widget for default values retrieval. Use result of _get_tkwidget_options instead. Ticket [393b67ab19] check-in: 5a776453e1 user: oehhar tags: bwidget
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.

1
2
3
4
5
6
7
8





9
10
11
12
13
14
15
2014-05-21 Harald Oehlmann <[email protected]>

        widget.tcl: Don't invoke unqualified upvar in callers
        scope. Patch by Andreas Kupries. 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]






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
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]


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.

372
373
374
375
376
377
378

379
380
381
382
383
384
385
....
1481
1482
1483
1484
1485
1486
1487

1488






















































1489
1490
1491
1492
1493

1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
        # retreive default value for TkResource
        if { [string equal $type "TkResource"] } {
            set tkwidget [lindex $arg 0]
            set realopt  [lindex $arg 1]
            if { ![string length $realopt] } {
                set realopt $option
            }

            set ind [lsearch $tkoptions [list $realopt *]]
            set optdesc [lindex $tkoptions $ind];
            set tkoptions [_get_tkwidget_options $tkwidget]
            if { ![string length $value] } {
                # We initialize default value
                set value [lindex $optdesc end]
            }
................................................................................
	event generate $focus <<TraverseOut>>
    }
    focus $w

    event generate $w <<TraverseIn>>
}

























































# Widget::varForOption --
#
#	Retrieve a fully qualified variable name for the option specified.
#	If the option is not one for which a variable exists, throw an error 
#	(ie, those options that map directly to widget options).

#
# Arguments:
#	path	megawidget to get an option var for.
#	option	option to get a var for.
#
# Results:
#	varname	name of the variable, fully qualified, suitable for tracing.

proc Widget::varForOption {path option} {
    variable _class
    variable _optiontype

    set class $_class($path)
    upvar 0 ${class}::$path:opt pathopt

    if { ![info exists pathopt($option)] } {
	error "unable to find variable for option \"$option\""
    }
    set varname "::Widget::${class}::$path:opt($option)"
    return $varname
}

# Widget::getVariable --
#
#       Get a variable from within the namespace of the widget.
#
# Arguments:






>







 







>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>




|
>









|
<
<
<
<
<
<
<
<
<
<







372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
....
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560










1561
1562
1563
1564
1565
1566
1567
        # retreive default value for TkResource
        if { [string equal $type "TkResource"] } {
            set tkwidget [lindex $arg 0]
            set realopt  [lindex $arg 1]
            if { ![string length $realopt] } {
                set realopt $option
            }
            set tkoptions [_get_tkwidget_options $tkwidget]
            set ind [lsearch $tkoptions [list $realopt *]]
            set optdesc [lindex $tkoptions $ind];
            set tkoptions [_get_tkwidget_options $tkwidget]
            if { ![string length $value] } {
                # We initialize default value
                set value [lindex $optdesc end]
            }
................................................................................
	event generate $focus <<TraverseOut>>
    }
    focus $w

    event generate $w <<TraverseIn>>
}

# Widget::which --
#
#	Retrieve a fully qualified variable name for the specified option or
#	widget variable.
#
#	If the option is not one for which a variable exists, throw an error
#	(ie, those options that map directly to widget options).
#
#	For widget variables, return the fully qualified name even if the
#	variable had not been previously set, in order to allow adding variable
#	traces prior to their creation.
#
# Arguments:
#	path	megawidget to get an option var for.
#	type	either -option or -variable.
#	name    name of the option or widget variable.
#
# Results:
#	Fully qualified name of the variable for the option or the widget
#	variable.
#
proc Widget::which {path args} {
    switch -- [llength $args] {
	1 {
	    set type -option;
	    set name [lindex $args 0];
	}
	2 {
	    set type [lindex $args 0];
	    set name [lindex $args 1];
	}
	default {
	    return -code error "incorrect number of arguments";
	}
    }

    variable _class;
    set class $_class($path);

    switch -- $type {
	-option {
	    upvar 0 ${class}::$path:opt pathopt;

	    if { ![info exists pathopt($option)] } {
		error "unable to find variable for option \"$option\"";
	    }

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


# Widget::varForOption --
#
#	Retrieve a fully qualified variable name for the option specified.
#	If the option is not one for which a variable exists, throw an error 
#	(ie, those options that map directly to widget options) Superseded by
#       widget::which.
#
# Arguments:
#	path	megawidget to get an option var for.
#	option	option to get a var for.
#
# Results:
#	varname	name of the variable, fully qualified, suitable for tracing.

proc Widget::varForOption {path option} {
    return [::Widget::which $path -option $option];










}

# Widget::getVariable --
#
#       Get a variable from within the namespace of the widget.
#
# Arguments: