zdoc:widget.tcl

widget.tcl

widget.tcl
This file is part of Unifix BWidget Toolkit
$Id: widget.tcl,v 1.21 2002/10/14 20:54:52 hobbs 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::_get_tkwidget_options
- Widget::_test_tkresource
- Widget::_test_bwresource
- Widget::_test_synonym
- Widget::_test_string
- Widget::_test_flag
- Widget::_test_enum
- Widget::_test_int
- Widget::_test_boolean
Each megawidget gets a namespace of the same name inside the Widget namespace
Each of these has an array opt, which contains information about the
megawidget options. It maps megawidget options to a list with this format:
{optionType defaultValue isReadonly {additionalOptionalInfo}}
Option types and their additional optional info are:
TkResource {genericTkWidget genericTkWidgetOptionName}
BwResource {nothing}
Enum {list of enumeration values}
Int {Boundary information}
Boolean {nothing}
String {nothing}
Flag {string of valid flag characters}
Synonym {nothing}
Color {nothing}

Next, each namespace has an array map, which maps class options to their
component widget options:
map(-foreground) => {.e -foreground .f -foreground}

Each has an array ${path}:opt, which contains the value of each megawidget
option for a particular instance $path of the megawidget, and an array
${path}:mod, which stores the "changed" status of configuration options.

Widget
Comments	Steps for creating a bwidget megawidget: 1. parse args to extract subwidget spec 2. Create frame with appropriate class and command line options 3. Get initialization options from optionDB, using frame 4. create subwidgets Uses newer string operations
Arguments
Used by
Uses
namespace eval Widget { variable _optiontype variable _class variable _tk_widget array set _optiontype { TkResource Widget::_test_tkresource BwResource Widget::_test_bwresource Enum Widget::_test_enum Int Widget::_test_int Boolean Widget::_test_boolean String Widget::_test_string Flag Widget::_test_flag Synonym Widget::_test_synonym Color Widget::_test_color } proc use {} {} }

Widget::_configure_option
Comments	Command Widget::_configure_option
Arguments	option altopt
Used by
Uses
proc Widget::_configure_option { option altopt } { variable _optiondb variable _optionclass if { [info exists _optiondb($option)] } { set optdb $_optiondb($option) } else { set optdb [string range $option 1 end] } if { [info exists _optionclass($option)] } { set optclass $_optionclass($option) } elseif { [string length $altopt] } { if { [info exists _optionclass($altopt)] } { set optclass $_optionclass($altopt) } else { set optclass [string range $altopt 1 end] } } else { set optclass [string range $option 1 end] } return [list $optdb $optclass] }

Widget::_get_configure
Comments	Command Widget::_get_configure returns the configuration list of options (as tk widget do - [$w configure ?option?])
Arguments	path options
Used by
Uses
proc Widget::_get_configure { path options } { variable _class set class $_class($path) upvar 0 ${class}::opt classopt upvar 0 ${class}::map classmap upvar 0 ${class}::$path:opt pathopt upvar 0 ${class}::$path:mod pathmod set len [llength $options] if { !$len } { set result {} foreach option [lsort [array names classopt]] { set optdesc $classopt($option) set type [lindex $optdesc 0] if { ![string compare $type "Synonym"] } { set syn $option set option [lindex $optdesc 1] set optdesc $classopt($option) set type [lindex $optdesc 0] } else { set syn "" } if { ![string compare $type "TkResource"] } { set alt [lindex [lindex $optdesc 3] 1] } else { set alt "" } set res [_configure_option $option $alt] if { $syn == "" } { lappend result [concat $option $res [list [lindex $optdesc 1]] [list [cget $path $option]]] } else { lappend result [list $syn [lindex $res 0]] } } return $result } elseif { $len == 1 } { set option [lindex $options 0] if { ![info exists classopt($option)] } { return -code error "unknown option \"$option\"" } set optdesc $classopt($option) set type [lindex $optdesc 0] if { ![string compare $type "Synonym"] } { set option [lindex $optdesc 1] set optdesc $classopt($option) set type [lindex $optdesc 0] } if { ![string compare $type "TkResource"] } { set alt [lindex [lindex $optdesc 3] 1] } else { set alt "" } set res [_configure_option $option $alt] return [concat $option $res [list [lindex $optdesc 1]] [list [cget $path $option]]] } }

Widget::_get_tkwidget_options
Comments	Command Widget::_get_tkwidget_options
Arguments	tkwidget
Used by	Widget::parseArgs
Uses
proc Widget::_get_tkwidget_options { tkwidget } { variable _tk_widget variable _optiondb variable _optionclass set widget ".#BWidget#$tkwidget" if { ![winfo exists $widget] \|\| ![info exists _tk_widget($tkwidget)] } { set widget [$tkwidget $widget] # JDC: Withdraw toplevels, otherwise visible if {[string equal $tkwidget "toplevel"]} { wm withdraw $widget } set config [$widget configure] foreach optlist $config { set opt [lindex $optlist 0] if { [llength $optlist] == 2 } { set refsyn [lindex $optlist 1] # search for class set idx [lsearch $config [list * $refsyn ]] if { $idx == -1 } { if { [string index $refsyn 0] == "-" } { # search for option (tk8.1b1 bug) set idx [lsearch $config [list $refsyn ]] } else { # last resort set idx [lsearch $config [list -[string tolower $refsyn] *]] } if { $idx == -1 } { # fed up with "can't read classopt()" return -code error "can't find option of synonym $opt" } } set syn [lindex [lindex $config $idx] 0] # JDC: used 4 (was 3) to get def from optiondb set def [lindex [lindex $config $idx] 4] lappend _tk_widget($tkwidget) [list $opt $syn $def] } else { # JDC: used 4 (was 3) to get def from optiondb set def [lindex $optlist 4] lappend _tk_widget($tkwidget) [list $opt $def] set _optiondb($opt) [lindex $optlist 1] set _optionclass($opt) [lindex $optlist 2] } } } return $_tk_widget($tkwidget) }

Widget::_get_window
Comments	Command Widget::_get_window returns the window corresponding to widget path
Arguments	class path
Used by
Uses
`proc Widget::_get_window { class path } { set idx [string last "#" $path] if { $idx != -1 && ![string compare [string range $path [expr {$idx+1}] end] $class] } { return [string range $path 0 [expr {$idx-1}]] } else { return $path } }`

Widget::_test_boolean
Comments	Command Widget::_test_boolean
Arguments	option value arg
Used by
Uses
`proc Widget::_test_boolean { option value arg } { if { ![string is boolean -strict $value] } { return -code error "bad $option value \"$value\": must be boolean" } # Get the canonical form of the boolean value (1 for true, 0 for false) return [string is true $value] }`

Widget::_test_bwresource
Comments	Command Widget::_test_bwresource
Arguments	option value arg
Used by
Uses
`proc Widget::_test_bwresource { option value arg } { return -code error "bad option type BwResource in widget" }`

Widget::_test_color
Comments	Command Widget::_test_color
Arguments	option value arg
Used by
Uses
`proc Widget::_test_color { option value arg } { if {[catch {winfo rgb . $value} color]} { return -code error "bad $option value \"$value\": must be a colorname \ or #RRGGBB triplet" } return $value }`

Widget::_test_enum
Comments	Command Widget::_test_enum
Arguments	option value arg
Used by
Uses
proc Widget::_test_enum { option value arg } { if { [lsearch $arg $value] == -1 } { set last [lindex $arg end] set sub [lreplace $arg end end] if { [llength $sub] } { set str "[join $sub ", "] or $last" } else { set str $last } return -code error "bad [string range $option 1 end] value \"$value\": must be $str" } return $value }

Widget::_test_flag
Comments	Command Widget::_test_flag
Arguments	option value arg
Used by
Uses
proc Widget::_test_flag { option value arg } { set len [string length $value] set res "" for {set i 0} {$i < $len} {incr i} { set c [string index $value $i] if { [string first $c $arg] == -1 } { return -code error "bad [string range $option 1 end] value \"$value\": characters must be in \"$arg\"" } if { [string first $c $res] == -1 } { append res $c } } return $res }

Widget::_test_int
Comments	Command Widget::_test_int
Arguments	option value arg
Used by
Uses
`proc Widget::_test_int { option value arg } { if { ![string is int -strict $value] \|\| \ ([string length $arg] && \ ![expr [string map [list %d $value] $arg]]) } { return -code error "bad $option value\ \"$value\": must be integer ($arg)" } return $value }`

Widget::_test_string
Comments	Command Widget::_test_string
Arguments	option value arg
Used by
Uses
`proc Widget::_test_string { option value arg } { set value }`

Widget::_test_synonym
Comments	Command Widget::_test_synonym
Arguments	option value arg
Used by
Uses
`proc Widget::_test_synonym { option value arg } { return -code error "bad option type Synonym in widget" }`

Widget::_test_tkresource
Comments	Command Widget::_test_tkresource
Arguments	option value arg
Used by
Uses
`proc Widget::_test_tkresource { option value arg } { # set tkwidget [lindex $arg 0] # set realopt [lindex $arg 1] foreach {tkwidget realopt} $arg break set path ".#BWidget#$tkwidget" set old [$path cget $realopt] $path configure $realopt $value set res [$path cget $realopt] $path configure $realopt $old return $res }`

Widget::addmap
Comments	Command Widget::addmap
Arguments	class subclass subpath options
Used by
Uses
proc Widget::addmap { class subclass subpath options } { upvar 0 ${class}::opt classopt upvar 0 ${class}::optionExports exports upvar 0 ${class}::optionClass optionClass upvar 0 ${class}::map classmap upvar 0 ${class}::map$subpath submap foreach {option realopt} $options { if { ![string length $realopt] } { set realopt $option } set val [lindex $classopt($option) 1] set optDb ".[lindex [_configure_option $realopt ""] 0]" if { ![string equal $subpath ":cmd"] } { set optDb "$subpath$optDb" } option add *${class}${optDb} $val widgetDefault lappend exports($option) $optDb # Store the forward and backward mappings for this # option <-> realoption pair lappend classmap($option) $subpath $subclass $realopt set submap($realopt) $option } }

Widget::bwinclude
Comments	Command Widget::bwinclude Includes BWidget resources to BWidget widget. class class name of the BWidget subclass BWidget class to include subpath subpath to configure args additionnal args for included options
Arguments	class subclass subpath args
Used by
Uses
proc Widget::bwinclude { class subclass subpath args } { foreach {cmd lopt} $args { # cmd can be # include options to include lopt = {opt ...} # remove options to remove lopt = {opt ...} # rename options to rename lopt = {opt newopt ...} # prefix options to prefix lopt = {prefix opt opt ...} # initialize set default value for options lopt = {opt value ...} # readonly set readonly flag for options lopt = {opt flag ...} switch -- $cmd { remove { foreach option $lopt { set remove($option) 1 } } include { foreach option $lopt { set include($option) 1 } } prefix { set prefix [lindex $lopt 0] foreach option [lrange $lopt 1 end] { set rename($option) "-$prefix[string range $option 1 end]" } } rename - readonly - initialize { array set $cmd $lopt } default { return -code error "invalid argument \"$cmd\"" } } } namespace eval $class {} upvar 0 ${class}::opt classopt upvar 0 ${class}::map classmap upvar 0 ${class}::map$subpath submap upvar 0 ${class}::optionExports exports upvar 0 ${subclass}::opt subclassopt upvar 0 ${subclass}::optionExports subexports # create resources informations from BWidget resources foreach {option optdesc} [array get subclassopt] { set subOption $option if { (![info exists include] \|\| [info exists include($option)]) && ![info exists remove($option)] } { set type [lindex $optdesc 0] if { ![string compare $type "Synonym"] } { # option is a synonym set syn [lindex $optdesc 1] if { ![info exists remove($syn)] } { if { [info exists rename($syn)] } { set classopt($option) [list Synonym $rename($syn)] } else { set classopt($option) [list Synonym $syn] } } } else { if { [info exists rename($option)] } { set realopt $option set option $rename($option) } else { set realopt $option } if { [info exists initialize($option)] } { set value $initialize($option) } else { set value [lindex $optdesc 1] } if { [info exists readonly($option)] } { set ro $readonly($option) } else { set ro [lindex $optdesc 2] } set classopt($option) \ [list $type $value $ro [lindex $optdesc 3]] # Add an option database entry for this option foreach optionDbName $subexports($subOption) { if { ![string equal $subpath ":cmd"] } { set optionDbName "$subpath$optionDbName" } # Only add the option db entry if we are overriding the # normal widget default if { [info exists initialize($option)] } { option add *${class}$optionDbName $value \ widgetDefault } lappend exports($option) "$optionDbName" } # Store the forward and backward mappings for this # option <-> realoption pair lappend classmap($option) $subpath $subclass $realopt set submap($realopt) $option } } } }

Widget::cget
Comments	Command Widget::cget
Arguments	path option
Used by	ButtonBox::cget NoteBook::_draw_arrows SpinBox::cget Button::cget MainFrame::create NoteBook::_getoption SelectFont::cget MainFrame::cget Tree::create PagesManager::add ScrollView::cget ComboBox::create Button::configure LabelEntry::cget Entry::cget BWLabel::_over_cmd Button::_leave PasswdDlg::create Dialog::draw BWLabel::setfocus ScrollView::create ProgressDlg::cget ProgressBar::_modify LabelFrame::cget SelectColor::dialog Button::_enter NoteBook::_draw_area NoteBook::_realize ProgressBar::cget ScrollableFrame::cget ProgressBar::configure BWLabel::create NoteBook::itemcget ProgressBar::create ComboBox::_focus_out NoteBook::_compute_width ProgressDlg::create BWLabel::_drop_cmd ComboBox::configure Widget::getoption TitleFrame::cget ArrowButton::create ScrolledWindow::create ComboBox::_create_popup NoteBook::_highlight ScrolledWindow::cget Separator::create BWLabel::cget NoteBook::_draw_page NoteBook::cget ComboBox::_focus_in Tree::cget PanedWindow::create ListBox::cget PanedWindow::cget DynamicHelp::sethelp ListBox::create ScrollableFrame::create Widget::hasChanged Tree::find Separator::cget Dialog::create Entry::create ComboBox::_mapliste Tree::itemcget Dialog::cget PagesManager::_realize NoteBook::_itemconfigure PagesManager::cget ArrowButton::cget ComboBox::cget NoteBook::insert MessageDlg::create Tree::_keynav NoteBook::create PasswdDlg::cget ListBox::itemcget Entry::configure NoteBook::_select ScrolledWindow::configure BWLabel::_init_drag_cmd
Uses
proc Widget::cget { path option } { if { ![info exists ::Widget::_class($path)] } { return -code error "unknown widget $path" } set class $::Widget::_class($path) if { ![info exists ${class}::opt($option)] } { return -code error "unknown option \"$option\"" } set optdesc [set ${class}::opt($option)] set type [lindex $optdesc 0] if { ![string compare $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) }

Widget::configure
Comments	Command Widget::configure
Arguments	path options
Used by	Button::create ScrollView::configure Dialog::configure Separator::configure ProgressBar::configure ListBox::configure PagesManager::configure MainFrame::configure Tree::configure NoteBook::configure ListBox::itemconfigure NoteBook::_itemconfigure ScrollableFrame::configure Tree::itemconfigure ArrowButton::configure LabelEntry::configure Entry::configure Button::configure TitleFrame::configure DynamicHelp::configure ButtonBox::configure ComboBox::configure LabelFrame::configure PasswdDlg::configure ProgressDlg::configure Widget::setoption SelectFont::configure ScrolledWindow::configure BWLabel::configure PanedWindow::configure SpinBox::configure
Uses
proc Widget::configure { path options } { set len [llength $options] if { $len <= 1 } { return [_get_configure $path $options] } elseif { $len % 2 == 1 } { return -code error "incorrect number of arguments" } variable _class variable _optiontype set class $_class($path) upvar 0 ${class}::opt classopt upvar 0 ${class}::map classmap upvar 0 ${class}::$path:opt pathopt upvar 0 ${class}::$path:mod pathmod set window [_get_window $class $path] foreach {option value} $options { if { ![info exists classopt($option)] } { return -code error "unknown option \"$option\"" } set optdesc $classopt($option) set type [lindex $optdesc 0] if { ![string compare $type "Synonym"] } { set option [lindex $optdesc 1] set optdesc $classopt($option) set type [lindex $optdesc 0] } if { ![lindex $optdesc 2] } { set newval [$_optiontype($type) $option $value [lindex $optdesc 3]] if { [info exists classmap($option)] } { set window [_get_window $class $window] foreach {subpath subclass realopt} $classmap($option) { if { [string length $subclass] } { set curval [${subclass}::cget $window$subpath $realopt] ${subclass}::configure $window$subpath $realopt $newval } else { set curval [$window$subpath cget $realopt] $window$subpath configure $realopt $newval } } } else { set curval $pathopt($option) set pathopt($option) $newval } set pathmod($option) [expr {![string equal $newval $curval]}] } } return {} }

Widget::copyinit
Comments	Bastien Chevreux (bach@mwgdna.com) copyinit performs basically the same job as init, but it uses a existing template to initialize its values. So, first a perferct copy from the template is made just to be altered by any existing options afterwards. But this still saves time as the first initialization parsing block is skipped. As additional bonus, items that differ in just a few options can be initialized faster by leaving out the options that are equal. This function is currently used only by ListBox::multipleinsert, but other calls should follow :) Command Widget::copyinit
Arguments	class templatepath path options
Used by	ListBox::multipleinsert
Uses
proc Widget::copyinit { class templatepath path options } { upvar 0 ${class}::opt classopt \ ${class}::$path:opt pathopt \ ${class}::$path:mod pathmod \ ${class}::$path:init pathinit \ ${class}::$templatepath:opt templatepathopt \ ${class}::$templatepath:mod templatepathmod \ ${class}::$templatepath:init templatepathinit if { [info exists pathopt] } { unset pathopt } if { [info exists pathmod] } { unset pathmod } # We use the template widget for option db copying, but it has to exist! array set pathmod [array get templatepathmod] array set pathopt [array get templatepathopt] array set pathinit [array get templatepathinit] set Widget::_class($path) $class foreach {option value} $options { if { ![info exists classopt($option)] } { unset pathopt unset pathmod return -code error "unknown option \"$option\"" } set optdesc $classopt($option) set type [lindex $optdesc 0] if { ![string compare $type "Synonym"] } { set option [lindex $optdesc 1] set optdesc $classopt($option) set type [lindex $optdesc 0] } set pathopt($option) [$Widget::_optiontype($type) $option $value [lindex $optdesc 3]] set pathinit($option) $pathopt($option) } }

Widget::declare
Comments	Command Widget::declare Declares new options to BWidget class.
Arguments	class optlist
Used by	DragSite::include DynamicHelp::include DropSite::include
Uses
proc Widget::declare { class optlist } { variable _optiontype namespace eval $class {} upvar 0 ${class}::opt classopt upvar 0 ${class}::optionExports exports upvar 0 ${class}::optionClass optionClass foreach optdesc $optlist { set option [lindex $optdesc 0] set optdesc [lrange $optdesc 1 end] set type [lindex $optdesc 0] if { ![info exists _optiontype($type)] } { # invalid resource type return -code error "invalid option type \"$type\"" } if { ![string compare $type "Synonym"] } { # test existence of synonym option set syn [lindex $optdesc 1] if { ![info exists classopt($syn)] } { return -code error "unknow option \"$syn\" for Synonym \"$option\"" } set classopt($option) [list Synonym $syn] continue } # all other resource may have default value, readonly flag and # optional arg depending on type set value [lindex $optdesc 1] set ro [lindex $optdesc 2] set arg [lindex $optdesc 3] if { ![string compare $type "BwResource"] } { # We don't keep BwResource. We simplify to type of sub BWidget set subclass [lindex $arg 0] set realopt [lindex $arg 1] if { ![string length $realopt] } { set realopt $option } upvar 0 ${subclass}::opt subclassopt if { ![info exists subclassopt($realopt)] } { return -code error "unknow option \"$realopt\"" } set suboptdesc $subclassopt($realopt) if { $value == "" } { # We initialize default value set value [lindex $suboptdesc 1] } set type [lindex $suboptdesc 0] set ro [lindex $suboptdesc 2] set arg [lindex $suboptdesc 3] set optionDbName ".[lindex [_configure_option $option ""] 0]" option add ${class}${optionDbName} $value widgetDefault set exports($option) $optionDbName set classopt($option) [list $type $value $ro $arg] continue } # retreive default value for TkResource if { ![string compare $type "TkResource"] } { set tkwidget [lindex $arg 0] set foo [$tkwidget ".ericFoo##"] set realopt [lindex $arg 1] if { ![string length $realopt] } { set realopt $option } set tkoptions [_get_tkwidget_options $tkwidget] if { ![string length $value] } { # We initialize default value set ind [lsearch $tkoptions [list $realopt ]] set value [lindex [lindex $tkoptions $ind] end] } set optionDbName ".[lindex [_configure_option $option ""] 0]" option add ${class}${optionDbName} $value widgetDefault 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] } }

Widget::destroy
Comments	Command Widget::destroy
Arguments	path
Used by	ScrollView::_destroy DropSite::register Separator::create SpinBox::_destroy TitleFrame::create ScrolledWindow::_destroy NoteBook::_destroy SelectColor::menu MainFrame::_destroy ButtonBox::_destroy PanedWindow::_destroy Tree::_subdelete SelectFont::_draw BWLabel::create MessageDlg::create Dialog::_destroy ArrowButton::_destroy Tree::_destroy PagesManager::_destroy ProgressBar::_destroy DragSite::register Entry::_destroy ListBox::delete SelectFont::_destroy ListBox::_destroy
Uses
`proc Widget::destroy { path } { variable _class set class $_class($path) upvar 0 ${class}::$path:opt pathopt upvar 0 ${class}::$path:mod pathmod upvar 0 ${class}::$path:init pathinit if {[info exists pathopt]} { unset pathopt } if {[info exists pathmod]} { unset pathmod } if {[info exists pathinit]} { unset pathinit } }`

Widget::focusNext
Comments	Command Widget::focusNext Same as tk_focusNext, but call Widget::focusOK
Arguments	w
Used by
Uses
proc Widget::focusNext { w } { set cur $w while 1 { # Descend to just before the first child of the current widget. set parent $cur set children [winfo children $cur] set i -1 # Look for the next sibling that isn't a top-level. while 1 { incr i if {$i < [llength $children]} { set cur [lindex $children $i] if {[winfo toplevel $cur] == $cur} { continue } else { break } } # No more siblings, so go to the current widget's parent. # If it's a top-level, break out of the loop, otherwise # look for its next sibling. set cur $parent if {[winfo toplevel $cur] == $cur} { break } set parent [winfo parent $parent] set children [winfo children $parent] set i [lsearch -exact $children $cur] } if {($cur == $w) \|\| [focusOK $cur]} { return $cur } } }

Widget::focusOK
Comments	Command Widget::focusOK Same as tk_focusOK, but handles -editable option and whole tags list.
Arguments	w
Used by	BWLabel::setfocus
Uses
proc Widget::focusOK { w } { set code [catch {$w cget -takefocus} value] if { $code == 1 } { return 0 } if {($code == 0) && ($value != "")} { if {$value == 0} { return 0 } elseif {$value == 1} { return [winfo viewable $w] } else { set value [uplevel \#0 $value $w] if {$value != ""} { return $value } } } if {![winfo viewable $w]} { return 0 } set code [catch {$w cget -state} value] if {($code == 0) && ($value == "disabled")} { return 0 } set code [catch {$w cget -editable} value] if {($code == 0) && !$value} { return 0 } set top [winfo toplevel $w] foreach tags [bindtags $w] { if { [string compare $tags $top] && [string compare $tags "all"] && [regexp Key [bind $tags]] } { return 1 } } return 0 }

Widget::focusPrev
Comments	Command Widget::focusPrev Same as tk_focusPrev, but call Widget::focusOK
Arguments	w
Used by
Uses
proc Widget::focusPrev { w } { set cur $w while 1 { # Collect information about the current window's position # among its siblings. Also, if the window is a top-level, # then reposition to just after the last child of the window. if {[winfo toplevel $cur] == $cur} { set parent $cur set children [winfo children $cur] set i [llength $children] } else { set parent [winfo parent $cur] set children [winfo children $parent] set i [lsearch -exact $children $cur] } # Go to the previous sibling, then descend to its last descendant # (highest in stacking order. While doing this, ignore top-levels # and their descendants. When we run out of descendants, go up # one level to the parent. while {$i > 0} { incr i -1 set cur [lindex $children $i] if {[winfo toplevel $cur] == $cur} { continue } set parent $cur set children [winfo children $parent] set i [llength $children] } set cur $parent if {($cur == $w) \|\| [focusOK $cur]} { return $cur } } }

Widget::getMegawidgetOption
Comments	Widget::getMegawidgetOption -- Bypass the superfluous checks in cget and just directly peer at the widget's data space. This is much more fragile than cget, so it should only be used with great care, in places where speed is critical. Arguments: path widget to lookup options for. option option to retrieve. Results: value option value.
Arguments	path option
Used by	DropSite::register ArrowButton::create Button::_release ComboBox::getvalue Tree::visiblenodes ComboBox::_mapliste Button::_repeat SpinBox::_modify_value ComboBox::setvalue Button::invoke Dialog::draw Button::create Entry::invoke Entry::create DragSite::register Tree::insert SpinBox::getvalue ComboBox::_select ComboBox::_modify_value Entry::configure SpinBox::setvalue Button::_press SpinBox::_test_options
Uses
`proc Widget::getMegawidgetOption {path option} { set class $::Widget::_class($path) upvar 0 ${class}::${path}:opt pathopt set pathopt($option) }`

Widget::getoption
Comments	Command Widget::getoption
Arguments	path option
Used by	ListBox::_init_drag_cmd ListBox::_redraw_selection ArrowButton::_enter Tree::__call_selectcmd ListBox::_redraw_listbox Tree::_keynav Tree::see Tree::line ScrollView::_resize MainFrame::create Entry::_init_drag_cmd ButtonBox::add ButtonBox::create ListBox::edit PanedWindow::_end_move_sash SelectFont::configure ListBox::see ListBox::_over_cmd SelectFont::_getfont Tree::closetree PanedWindow::_apply_weights TitleFrame::_place Tree::opentree ArrowButton::_press Dialog::create ListBox::_redraw_idle ScrollableFrame::_resize ArrowButton::_release Tree::find ListBox::_resize Tree::_cross_event Tree::_init_drag_cmd Tree::_draw_tree Tree::_over_cmd LabelFrame::create ListBox::_redraw_items ScrollView::configure ListBox::_drop_cmd ButtonBox::index Entry::_end_drag_cmd DynamicHelp::_show_help ArrowButton::_leave BWLabel::_init_drag_cmd Dialog::draw PanedWindow::_beg_move_sash SelectFont::_update ListBox::_getoption Tree::_draw_subnodes Entry::_over_cmd Tree::_update_nodes ListBox::find Tree::_drop_cmd ArrowButton::_repeat Tree::_recexpand PanedWindow::add SelectFont::create ArrowButton::_redraw_relief Tree::_draw_node Tree::reorder Tree::selection Tree::_redraw_idle ListBox::create ScrollView::_destroy Tree::_update_scrollregion ScrollView::_set_view Entry::_drop_cmd MainFrame::addtoolbar Tree::move ProgressBar::_modify ArrowButton::_redraw MainFrame::_create_entries MainFrame::_create_menubar Tree::edit TitleFrame::create ArrowButton::invoke ListBox::itemconfigure Tree::_redraw_tree ListBox::_draw_item ArrowButton::_redraw_state Tree::_subdelete MainFrame::addindicator BWLabel::_over_cmd Tree::_redraw_selection SelectFont::_draw
Uses	Widget::cget
`proc Widget::getoption { path option } { # set class $::Widget::_class($path) # upvar 0 ${class}::$path:opt pathopt # return $pathopt($option) return [Widget::cget $path $option] }`

Widget::hasChanged
Comments	Command Widget::hasChanged
Arguments	path option pvalue
Used by	ScrolledWindow::configure ScrollView::configure MainFrame::configure ScrollableFrame::configure PanedWindow::configure Tree::itemconfigure ButtonBox::configure Dialog::configure DropSite::setdrop Tree::configure Separator::configure NoteBook::configure ArrowButton::configure ListBox::itemconfigure ListBox::configure DragSite::setdrag NoteBook::_itemconfigure BWLabel::configure TitleFrame::configure DynamicHelp::configure SelectFont::configure
Uses	Widget::cget
`proc Widget::hasChanged { path option pvalue } { upvar $pvalue value set class $::Widget::_class($path) upvar 0 ${class}::$path:mod pathmod set value [Widget::cget $path $option] set result $pathmod($option) set pathmod($option) 0 return $result }`

Widget::hasChangedX
Comments
Arguments	path option args
Used by	DynamicHelp::sethelp Button::configure SpinBox::configure ComboBox::configure Entry::configure ProgressBar::configure
Uses
`proc Widget::hasChangedX { path option args } { set class $::Widget::_class($path) upvar 0 ${class}::$path:mod pathmod set result $pathmod($option) set pathmod($option) 0 foreach option $args { lappend result $pathmod($option) set pathmod($option) 0 } set result }`

Widget::init
Comments	Command Widget::init
Arguments	class path options
Used by	ListBox::multipleinsert PanedWindow::create ListBox::insert LabelFrame::create ListBox::create ScrollableFrame::create SelectFont::create DropSite::register NoteBook::insert NoteBook::create TitleFrame::create ButtonBox::create MainFrame::create Tree::insert Tree::create DragSite::register ScrollView::create PagesManager::create SelectColor::dialog ScrolledWindow::create SelectColor::menu PanedWindow::add
Uses
proc Widget::init { class path options } { upvar 0 ${class}::opt classopt upvar 0 ${class}::$path:opt pathopt upvar 0 ${class}::$path:mod pathmod upvar 0 ${class}::map classmap upvar 0 ${class}::$path:init pathinit if { [info exists pathopt] } { unset pathopt } if { [info exists pathmod] } { unset pathmod } # We prefer to use the actual widget for option db queries, but if it # doesn't exist yet, do the next best thing: create a widget of the # same class and use that. set fpath $path set rdbclass [string map [list :: ""] $class] if { ![winfo exists $path] } { set fpath ".#BWidgetClass#$class" if { ![winfo exists $fpath] } { frame $fpath -class $rdbclass } } foreach {option optdesc} [array get classopt] { set pathmod($option) 0 if { [info exists classmap($option)] } { continue } set type [lindex $optdesc 0] if { ![string compare $type "Synonym"] } { continue } if { ![string compare $type "TkResource"] } { set alt [lindex [lindex $optdesc 3] 1] } else { set alt "" } set optdb [lindex [_configure_option $option $alt] 0] set def [option get $fpath $optdb $rdbclass] if { [string length $def] } { set pathopt($option) $def } else { set pathopt($option) [lindex $optdesc 1] } } set Widget::_class($path) $class foreach {option value} $options { if { ![info exists classopt($option)] } { unset pathopt unset pathmod return -code error "unknown option \"$option\"" } set optdesc $classopt($option) set type [lindex $optdesc 0] if { ![string compare $type "Synonym"] } { set option [lindex $optdesc 1] set optdesc $classopt($option) set type [lindex $optdesc 0] } set pathopt($option) [$Widget::_optiontype($type) $option $value [lindex $optdesc 3]] set pathinit($option) $pathopt($option) } }

Widget::initFromODB
Comments	Widget::initFromODB -- Initialize a megawidgets options with information from the option database and from the command-line arguments given. Arguments: class class of the widget. path path of the widget -- should already exist. options command-line arguments. Results: None.
Arguments	class path options
Used by	BWLabel::create ProgressBar::create Button::create PasswdDlg::create ComboBox::create LabelEntry::create Entry::create Dialog::create Separator::create ProgressDlg::create SpinBox::create MessageDlg::create ArrowButton::create
Uses
proc Widget::initFromODB {class path options} { upvar 0 ${class}::$path:opt pathopt upvar 0 ${class}::$path:mod pathmod upvar 0 ${class}::map classmap if { [info exists pathopt] } { unset pathopt } if { [info exists pathmod] } { unset pathmod } # We prefer to use the actual widget for option db queries, but if it # doesn't exist yet, do the next best thing: create a widget of the # same class and use that. set fpath [_get_window $class $path] set rdbclass [string map [list :: ""] $class] if { ![winfo exists $path] } { set fpath ".#BWidgetClass#$class" if { ![winfo exists $fpath] } { frame $fpath -class $rdbclass } } foreach {option optdesc} [array get ${class}::opt] { set pathmod($option) 0 if { [info exists classmap($option)] } { continue } set type [lindex $optdesc 0] if { ![string compare $type "Synonym"] } { continue } if { ![string compare $type "TkResource"] } { set alt [lindex [lindex $optdesc 3] 1] } else { set alt "" } set optdb [lindex [_configure_option $option $alt] 0] set def [option get $fpath $optdb $rdbclass] if { [string length $def] } { set pathopt($option) $def } else { set pathopt($option) [lindex $optdesc 1] } } set Widget::_class($path) $class array set pathopt $options }

Widget::parseArgs
Comments	Widget::parseArgs -- Given a widget class and a command-line spec, cannonize and validate the given options, and return a keyed list consisting of the component widget and its masked portion of the command-line spec, and one extra entry consisting of the portion corresponding to the megawidget itself. Arguments: class widget class to parse for. options command-line spec Results: result keyed list of portions of the megawidget and that segment of the command line in which that portion is interested.
Arguments	class options
Used by	Button::create ProgressBar::create LabelEntry::create Entry::create MessageDlg::create PasswdDlg::create SpinBox::create Separator::create ProgressDlg::create Dialog::create BWLabel::create ComboBox::create ArrowButton::create
Uses	Widget::_get_tkwidget_options
proc Widget::parseArgs {class options} { upvar 0 ${class}::opt classopt upvar 0 ${class}::map classmap foreach {option val} $options { if { ![info exists classopt($option)] } { error "unknown option \"$option\"" } set optdesc $classopt($option) set type [lindex $optdesc 0] if { ![string compare $type "Synonym"] } { set option [lindex $optdesc 1] set optdesc $classopt($option) set type [lindex $optdesc 0] } if { ![string compare $type "TkResource"] } { # Make sure that the widget used for this TkResource exists Widget::_get_tkwidget_options [lindex [lindex $optdesc 3] 0] } set val [$Widget::_optiontype($type) $option $val [lindex $optdesc 3]] if { [info exists classmap($option)] } { foreach {subpath subclass realopt} $classmap($option) { lappend maps($subpath) $realopt $val } } else { lappend maps($class) $option $val } } return [array get maps] }

Widget::setMegawidgetOption
Comments	Widget::setMegawidgetOption -- Bypass the superfluous checks in cget and just directly poke at the widget's data space. This is much more fragile than configure, so it should only be used with great care, in places where speed is critical. Arguments: path widget to lookup options for. option option to retrieve. value option value. Results: value option value.
Arguments	path option value
Used by	SpinBox::_test_options
Uses
`proc Widget::setMegawidgetOption {path option value} { set class $::Widget::_class($path) upvar 0 ${class}::${path}:opt pathopt set pathopt($option) $value }`

Widget::setoption
Comments	Command Widget::setoption
Arguments	path option value
Used by	ButtonBox::configure SelectFont::_update Tree::_recexpand
Uses	Widget::configure
`proc Widget::setoption { path option value } { # variable _class # set class $_class($path) # upvar 0 ${class}::$path:opt pathopt # set pathopt($option) $value Widget::configure $path [list $option $value] }`

Widget::subcget
Comments	Command Widget::subcget
Arguments	path subwidget
Used by	Tree::create ScrollableFrame::create ScrolledWindow::create MainFrame::create ListBox::create NoteBook::create LabelFrame::create PagesManager::create ButtonBox::create ScrollView::create TitleFrame::create
Uses
`proc Widget::subcget { path subwidget } { set class $::Widget::_class($path) upvar 0 ${class}::$path:opt pathopt upvar 0 ${class}::map$subwidget submap upvar 0 ${class}::$path:init pathinit set result {} foreach realopt [array names submap] { if { [info exists pathinit($submap($realopt))] } { lappend result $realopt $pathopt($submap($realopt)) } } return $result }`

Widget::syncoptions
Comments	Command Widget::syncoptions
Arguments	class subclass subpath options
Used by
Uses
`proc Widget::syncoptions { class subclass subpath options } { upvar 0 ${class}::sync classync foreach {option realopt} $options { if { ![string length $realopt] } { set realopt $option } set classync($option) [list $subpath $subclass $realopt] } }`

Widget::tkinclude
Comments	Command Widget::tkinclude Includes tk widget resources to BWidget widget. class class name of the BWidget tkwidget tk widget to include subpath subpath to configure args additionnal args for included options
Arguments	class tkwidget subpath args
Used by
Uses
proc Widget::tkinclude { class tkwidget subpath args } { foreach {cmd lopt} $args { # cmd can be # include options to include lopt = {opt ...} # remove options to remove lopt = {opt ...} # rename options to rename lopt = {opt newopt ...} # prefix options to prefix lopt = {pref opt opt ..} # initialize set default value for options lopt = {opt value ...} # readonly set readonly flag for options lopt = {opt flag ...} switch -- $cmd { remove { foreach option $lopt { set remove($option) 1 } } include { foreach option $lopt { set include($option) 1 } } prefix { set prefix [lindex $lopt 0] foreach option [lrange $lopt 1 end] { set rename($option) "-$prefix[string range $option 1 end]" } } rename - readonly - initialize { array set $cmd $lopt } default { return -code error "invalid argument \"$cmd\"" } } } namespace eval $class {} upvar 0 ${class}::opt classopt upvar 0 ${class}::map classmap upvar 0 ${class}::map$subpath submap upvar 0 ${class}::optionExports exports set foo [$tkwidget ".ericFoo###"] # create resources informations from tk widget resources foreach optdesc [_get_tkwidget_options $tkwidget] { set option [lindex $optdesc 0] if { (![info exists include] \|\| [info exists include($option)]) && ![info exists remove($option)] } { if { [llength $optdesc] == 3 } { # option is a synonym set syn [lindex $optdesc 1] if { ![info exists remove($syn)] } { # original option is not removed if { [info exists rename($syn)] } { set classopt($option) [list Synonym $rename($syn)] } else { set classopt($option) [list Synonym $syn] } } } else { if { [info exists rename($option)] } { set realopt $option set option $rename($option) } else { set realopt $option } if { [info exists initialize($option)] } { set value $initialize($option) } else { set value [lindex $optdesc 1] } if { [info exists readonly($option)] } { set ro $readonly($option) } else { set ro 0 } set classopt($option) \ [list TkResource $value $ro [list $tkwidget $realopt]] # Add an option database entry for this option set optionDbName ".[lindex [_configure_option $option ""] 0]" if { ![string equal $subpath ":cmd"] } { set optionDbName "$subpath$optionDbName" } option add *${class}$optionDbName $value widgetDefault lappend exports($option) "$optionDbName" # Store the forward and backward mappings for this # option <-> realoption pair lappend classmap($option) $subpath "" $realopt set submap($realopt) $option } } } ::destroy $foo }

Widget::varForOption
Comments	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.
Arguments	path option
Used by	ComboBox::_create_popup
Uses
`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 }`

generated by zdoc.tcl on 2003-03-06 00:21:55