Bwidget Source Code
Check-in [478ff3af32]
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:various changes related to ttk added
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 478ff3af327beaccb13e94bdc4c7110f6f436ecb
User & Date: oberdorfer 2009-09-06 20:45:43
Context
2009-09-06
20:51
BWidget::set_themedefaults "initialize" added check-in: 224a40daaa user: oberdorfer tags: trunk
20:45
various changes related to ttk added check-in: 478ff3af32 user: oberdorfer tags: trunk
2009-09-05
21:01
theme and tile related utility functions check-in: 050cf9198d user: oberdorfer tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to widget.tcl.

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
...
390
391
392
393
394
395
396






397
398
399
400
401
402
403
...
867
868
869
870
871
872
873














874
875
876
877
878
879
880
881
....
1598
1599
1600
1601
1602
1603
1604
1605




1606
1607
1608
1609
1610

























# ----------------------------------------------------------------------------
#  widget.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: widget.tcl,v 1.35 2009/07/02 16:22:18 oehhar Exp $
# ----------------------------------------------------------------------------
#  Index of commands:
#     - Widget::tkinclude
#     - Widget::bwinclude
#     - Widget::declare
#     - Widget::addmap
#     - Widget::init
................................................................................
#     - Widget::destroy
#     - Widget::setoption
#     - Widget::configure
#     - Widget::cget
#     - Widget::subcget
#     - Widget::hasChanged
#     - Widget::options


#     - Widget::_get_tkwidget_options
#     - Widget::_test_tkresource
#     - Widget::_test_bwresource
#     - Widget::_test_synonym
#     - Widget::_test_string
#     - Widget::_test_flag
#     - Widget::_test_enum
................................................................................
	    set exports($option) $optionDbName
            set classopt($option) [list TkResource $value $ro \
		    [list $tkwidget $realopt]]
	    set optionClass($option) [lindex [$foo configure $realopt] 1]
	    ::destroy $foo
            continue
        }







	set optionDbName ".[lindex [_configure_option $option ""] 0]"
	option add *${class}${optionDbName} $value widgetDefault
	set exports($option) $optionDbName
        # for any other resource type, we keep original optdesc
        set classopt($option) [list $type $value $ro $arg]
    }
................................................................................
    if {[string equal $type "Synonym"]} {
        set option [lindex $optdesc 1]
    }

    if { [info exists ${class}::map($option)] } {
	foreach {subpath subclass realopt} [set ${class}::map($option)] {break}
	set path "[_get_window $class $path]$subpath"














	return [$path cget $realopt]
    }
    upvar 0 ${class}::$path:opt pathopt
    set pathopt($option)
}


# ----------------------------------------------------------------------------
................................................................................
    if {[llength [info level 0]] == 2} {
	# set theme-ability
	if {[catch {package require Tk 8.5a6}]
	    && [catch {package require tile 0.6}]
	    && [catch {package require tile 1}]} {
	    return -code error "BWidget's theming requires tile 0.6+"
	} else {
	    catch {style default BWSlim.Toolbutton -padding 0}




	}
	set _theme [string is true -strict $bool]
    }
    return $_theme
}



























|







 







>
>







 







>
>
>
>
>
>







 







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







 







|
>
>
>
>





>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
...
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
...
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
....
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
# ----------------------------------------------------------------------------
#  widget.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: widget.tcl,v 1.36 2009/09/06 20:45:43 oberdorfer Exp $
# ----------------------------------------------------------------------------
#  Index of commands:
#     - Widget::tkinclude
#     - Widget::bwinclude
#     - Widget::declare
#     - Widget::addmap
#     - Widget::init
................................................................................
#     - Widget::destroy
#     - Widget::setoption
#     - Widget::configure
#     - Widget::cget
#     - Widget::subcget
#     - Widget::hasChanged
#     - Widget::options
#     - Widget::getArgument
#     - Widget::getallwidgets
#     - Widget::_get_tkwidget_options
#     - Widget::_test_tkresource
#     - Widget::_test_bwresource
#     - Widget::_test_synonym
#     - Widget::_test_string
#     - Widget::_test_flag
#     - Widget::_test_enum
................................................................................
	    set exports($option) $optionDbName
            set classopt($option) [list TkResource $value $ro \
		    [list $tkwidget $realopt]]
	    set optionClass($option) [lindex [$foo configure $realopt] 1]
	    ::destroy $foo
            continue
        }

        if {[string equal $type "Color"]} {
            if {[info exists ::BWidget::colors($value)]} {
                set value $::BWidget::colors($value)
            }
        }

	set optionDbName ".[lindex [_configure_option $option ""] 0]"
	option add *${class}${optionDbName} $value widgetDefault
	set exports($option) $optionDbName
        # for any other resource type, we keep original optdesc
        set classopt($option) [list $type $value $ro $arg]
    }
................................................................................
    if {[string equal $type "Synonym"]} {
        set option [lindex $optdesc 1]
    }

    if { [info exists ${class}::map($option)] } {
	foreach {subpath subclass realopt} [set ${class}::map($option)] {break}
	set path "[_get_window $class $path]$subpath"
	
	set optval ""
        if { [BWidget::using ttk] } {
	    # ttk
            foreach {opt val} [::ttk::style configure .] {
              if {$realopt eq $opt} {
                set optval $val
		break
	      }
	    }
        }
	# if ttk option doesn't exists, take tk option instead
	if { [string length $optval] != 0 } {
                 return $optval
	} else { return [$path cget $realopt] } 
    }
    upvar 0 ${class}::$path:opt pathopt
    set pathopt($option)
}


# ----------------------------------------------------------------------------
................................................................................
    if {[llength [info level 0]] == 2} {
	# set theme-ability
	if {[catch {package require Tk 8.5a6}]
	    && [catch {package require tile 0.6}]
	    && [catch {package require tile 1}]} {
	    return -code error "BWidget's theming requires tile 0.6+"
	} else {
	    catch {
	      ttk::style configure BWSlimCB.Toolbutton -relief flat -bd 2
              ttk::style map BWSlimCB.Toolbutton \
	                 -relief [list {selected !disabled} sunken]
	    }
	}
	set _theme [string is true -strict $bool]
    }
    return $_theme
}

#------------------------------------------------------------------------------
# remove {keystr value} sub list from args
# arg contains the associated value of keystr, or an empty string
# while loop ensures to remove all matches of keystr 
#------------------------------------------------------------------------------
proc Widget::getArgument {args keystr arg} {
  upvar $arg cvalue
  set cvalue ""
  while {[set i [lsearch -exact $args $keystr]] >= 0} {
     set j [expr $i + 1]
     set cvalue [lindex $args $j]
     set args [lreplace $args $i $j]
  }
  return $args
}


proc Widget::getallwidgets {{w .}} {
    set rlist [list $w]
    foreach c [winfo children $w] {
        set rlist [concat $rlist [getallwidgets $c]]
    }
    return $rlist
}