::namespace eval ::QW::GUI::WINEXPLO { # Nov 02 1999 PGQ put in and commented out the debugging puts (causes some pretty amazing disk grinding) # Oct 19 1999 PGQ cleaned up and reorganized # Apr 15 1999 RTH Added columns to right box with -configure options. # Apr 20 1999 RTH Appended grid, pack, & place slaves to right obox below -configure options # Nov 10 1999 RTH Converted tree display from text to canvas. # Jan 20 2000 RTH Added console window. # Mar 06 2000 Corrected display of config & slaves when items > info list # Jun 27,2001 RTH Huge re-write to split out the tree display as stand-alone 'widget' with proper signalling, options, etc. # # All tree behaviour is controlled by signals sent to ::ownerProc, which in turn calls ::treeCommand # # To Do: # # Nodes expand/contract as we move mouse over the buttons: # # Jury still out - I can complete the -autobuttons option, or the owner can impose that behaviour # by triggering off of button enter/leave events. I've tried this in ::proc ::ownerProc {win args} # and it works as you would expect. *POTENTIAL TROUBLE* - if we go for the owner-control option, # I've got to make sure expandall and contractall behave properly (something tells me I'm in # for a bit of trouble there.) # # ::treeCommand see - This expands the appropriate nodes, but there's no effort made to ensure the # requested node is actually visible ie: on the visible area of the canvas. Ask PGQ what to do. # # dynamic data - add signalling to get data as needed from owner instead of the giant static array # # prune out the parent class crap added for menu objects. # # Done: # # need a signal/-option from owner if canvas background color is changed. (We draw 'invisible' rectangles # all over the place and they won't be invisible if we don't keep their color in sync with the canvas.) # # signal owner with configure (rectangle) events # # ----------------------------------------------------------------------------------------------------------------------------------- # # The Tree Widget # --------------- # # "public" vs "private" procs # # - All public (to be called by owner) procs start with "::tree" # - All private procs start with ::_ # # Public procs # # ::treeInit win Must be called before ::treeShow # # ::treeShow win Display the tree # # ::treeRectangleRequest win Query tree on it's requested rectangle dimensions # # ::treeCommand win command pathList # # commands: # # expand expand branch node pathList # contract contract branch node pathList # expandall expand entire tree below pathlist # contractall contract entire tree below pathlist # see expand path from root to last item in pathList # # ::treeConfigure [-option [value]] [-option value -option value ...] # # Option Meaning Default # ------------------------------ ------------------------------------------------------ ------------------------- # -cursor 'normal' mouse pointer to use arrow # -cursorwait mouse pointer to use during redraw events wait # -canvaspath path Tk path of canvas client to display tree on *Required* # -canvasbackgroundcolor bg color of canvas. Used to draw 'invisible' rectangles automatically set when -canvaspath configured # -signaltoownercommand procName tcl command tree uses to signal it's owner with events *Required* # -activepath pathList path to make 'active' # -origin "# #" canvas coords to display tree root in the form "x y" "10 10" # -inactivelinecolor color -fill color of lines to inactive nodes black # -activelinecolor color -fill color of lines to the active node blue # -inactivelinethickness n -width (in pixels) of lines from root to inactive nodes 1 # -activelinethickness n -width (in pixels) of lines from root to the active node 2 # -inactivefont font -font for inactive node labels System 8 roman normal # -activefont font -font for the active node label System 8 roman bold # -inactivetextcolor color -fill color for inactive node labels (the text) black # -activetextcolor color -fill color for inactive node labels (the text) blue # -columnwidth n Y indent in pixels for each level 18 # -autobuttons 0 or 1 Nodes expand/contract as you move mouse *not implemented* # -dumpcallttackonerror 0 or 1 For debugging 0 # # Signals from the tree to signaltoownercommand: # # rectangle {topLeftX TopLeftY bottomRightX bottomRightY} # buttonPress node component button other # buttonRelease node component button other # doubleButtonPress node component button other # enter node component x y other # leave node component x y other # # components: # # label node's description text # icon the image associated with the node (closedimage, openinage, or nodeimage) # expandButton the 'expand' button icon # contractButton the 'contract' button icon # # 'other' is legacy junk (for menu widgets) that will eventually be dropped # # ::ownerProc # ############################################################################################################### # ------------------------------------------------------------------------------ # ::proc treeInit {win} { global hierInfo set var $hierInfo($win-data) upvar #0 $var data # # Initialization ::catch {unset ::controlArray}; ::array set ::controlArray {}; ::QW::GUI::WINEXPLO::_optionSet tracing 0; ::QW::GUI::WINEXPLO::_optionSet callDepth 0; ::QW::GUI::WINEXPLO::_traceIn; ::QW::GUI::WINEXPLO::_optionSet redrawAfterID ""; ::QW::GUI::WINEXPLO::_optionSet signalRectangleChangeAfterID ""; ::QW::GUI::WINEXPLO::_optionSet boot 1; ::QW::GUI::WINEXPLO::_optionSet linePadding 0; ::QW::GUI::WINEXPLO::_optionSet lineHeight 0; ::QW::GUI::WINEXPLO::_optionSet show 0; ::QW::GUI::WINEXPLO::_optionSet expandAll 0; ::QW::GUI::WINEXPLO::_optionSet kludgeRectangleWidth 4096; # GIANT UGLY KLUDGE ::QW::GUI::WINEXPLO::treeConfigure $win -dumpcallstackonerror 0; ::QW::GUI::WINEXPLO::treeConfigure $win -plusimage ""; ::QW::GUI::WINEXPLO::treeConfigure $win -minusimage ""; ::QW::GUI::WINEXPLO::treeConfigure $win -nodeimage ""; ::QW::GUI::WINEXPLO::treeConfigure $win -openimage ""; ::QW::GUI::WINEXPLO::treeConfigure $win -closedimage ""; ::QW::GUI::WINEXPLO::treeConfigure $win -canvaspath ""; ::QW::GUI::WINEXPLO::treeConfigure $win -cursor arrow; #nv2.38.0 (linux) #::QW::GUI::WINEXPLO::treeConfigure $win -cursorwait wait; ::QW::GUI::WINEXPLO::treeConfigure $win -cursorwait $::qw::platform_dependent_cursor(wait); # Boot-up Defaults ::QW::GUI::WINEXPLO::treeConfigure $win -autobuttons 0; ::QW::GUI::WINEXPLO::treeConfigure $win -signaltoownercommand ""; ::QW::GUI::WINEXPLO::treeConfigure $win -activepath ""; ::QW::GUI::WINEXPLO::treeConfigure $win -inactivelinecolor black; ::QW::GUI::WINEXPLO::treeConfigure $win -origin "10 10"; ::QW::GUI::WINEXPLO::treeConfigure $win -activelinecolor blue; ::QW::GUI::WINEXPLO::treeConfigure $win -inactivelinethickness 1; ::QW::GUI::WINEXPLO::treeConfigure $win -activelinethickness 2; ::switch -exact $::tcl_platform(platform) { windows {::set Font System;} macintosh {::set Font System;} unix {::set Font fixed;} default {::_error "Unknown platform \"$::tcl_platform(platform)\"";} } ::QW::GUI::WINEXPLO::treeConfigure $win -inactivefont "$Font 8 roman normal"; ::QW::GUI::WINEXPLO::treeConfigure $win -activefont "$Font 8 roman bold"; ::QW::GUI::WINEXPLO::treeConfigure $win -inactivetextcolor black; ::QW::GUI::WINEXPLO::treeConfigure $win -activetextcolor blue; ::QW::GUI::WINEXPLO::treeConfigure $win -activebackgroundcolor grey50; ::QW::GUI::WINEXPLO::treeConfigure $win -columnwidth 18; # ::QW::GUI::WINEXPLO::_optionSet boot 0; #:::QW::GUI::WINEXPLO::_traceOut; } ::proc treeCGet {win Option} { ::return [::_optionGet $Option]; } ::proc treeConfigure {win args} { ::QW::GUI::WINEXPLO::_traceIn; ::set NumArgs [::llength $args]; ::switch -- $NumArgs { 0 { ::set Result {}; ::foreach Option [::array names ::controlArray -*] { ::lappend Result [::list $Option [::QW::GUI::WINEXPLO::_optionGet $Option]]; } #::QW::GUI::WINEXPLO::_traceOut; ::return $Result; } 1 { #::QW::GUI::WINEXPLO::_traceOut; ::return [::QW::GUI::WINEXPLO::_optionGet [::lindex $args 0]]; } default { ::if {[::expr $NumArgs % 2]} {::_error "wrong # of args";::return;} ::foreach {Option Value} $args {::QW::GUI::WINEXPLO::_configureItem $win $Option $Value;} } } #:::QW::GUI::WINEXPLO::_traceOut; } ::proc treeShow {win} { ::QW::GUI::WINEXPLO::_traceIn; #puts [::_thisProcNameName] global hierInfo set var $hierInfo($win-data) upvar #0 $var data # ::if {![::QW::GUI::WINEXPLO::_allDisplayItemsSet]} {::_error "Option(s) not set: [::QW::GUI::WINEXPLO::_optionGet missingOptions]";} ::set RootWasExpanded 0; #nv2.38.0 (linux) #::QW::GUI::WINEXPLO::_cursorSet wait; ::QW::GUI::WINEXPLO::_cursorSet $::qw::platform_dependent_cursor(wait); if {[::QW::GUI::WINEXPLO::_optionGet show]&&$data(root-1-expandedState)} { ::QW::GUI::WINEXPLO::_nodeContract $win root-1;::set RootWasExpanded 1; } # Kill any existing items [::QW::GUI::WINEXPLO::_optionGet -canvaspath] delete all; # Create empty root rectangle ::set x1 [::QW::GUI::WINEXPLO::_optionGet originX]; ::set y1 [::QW::GUI::WINEXPLO::_optionGet originY]; ::set x2 [::QW::GUI::WINEXPLO::_optionGet kludgeRectangleWidth] ;# RTH - this needs work ::set y2 $y1; ::set rectangleOutlineColor [[::QW::GUI::WINEXPLO::_optionGet -canvaspath] cget -background]; [::QW::GUI::WINEXPLO::_optionGet -canvaspath] create rectangle $x1 $y1 $x2 $y2 -width 0 -outline $rectangleOutlineColor -tags {root lastChild}; ::QW::GUI::WINEXPLO::_optionSet show 1; # Must be before ::_nodeInsert or initial rectangle signal doesn't make it out to owner. ::QW::GUI::WINEXPLO::_nodeInsert $win "root"; #DEBUG# ::QW::GUI::WINEXPLO::_optionSet root-items [::llength [[::QW::GUI::WINEXPLO::_optionGet -canvaspath] find all]]; #DEBUG# ::if {$RootWasExpanded} {::QW::GUI::WINEXPLO::_nodeExpand $win root-1;} ::QW::GUI::WINEXPLO::_cursorSet normal; ::QW::GUI::WINEXPLO::_redrawCancel $win; #::QW::GUI::WINEXPLO::_traceOut; } ::proc treeCommand {win args} { ::set Command [::lindex $args 0]; ::set Node [::QW::GUI::WINEXPLO::_nodeFromPathList $win [::lindex $args 1]]; ::QW::GUI::WINEXPLO::_cursorSet wait; #[::_optionGet -canvaspath] configure -cursor [::_optionGet -cursorwait]; ::switch -- $Command { expand {::QW::GUI::WINEXPLO::_nodeExpand $win $Node;} contract {::QW::GUI::WINEXPLO::_nodeContract $win $Node;} expandall {::QW::GUI::WINEXPLO::_nodeExpandAll $win $Node;} contractall {::QW::GUI::WINEXPLO::_nodeContractAll $win $Node;} see {::QW::GUI::WINEXPLO::_seeNode $win $Node;} default {::QW::GUI::WINEXPLO::_error "Unknown tree command: \"$Command\"";} } #[::_optionGet -canvaspath] configure -cursor [::_optionGet -cursor]; ::QW::GUI::WINEXPLO::_cursorSet normal; } ::proc treeRectangleRequest {win} { global hierInfo set var $hierInfo($win-data) upvar #0 $var data # ::QW::GUI::WINEXPLO::_signalRectangleChangeCancel $win; ::set Rectangle [[::QW::GUI::WINEXPLO::_optionGet -canvaspath] bbox line label image]; ::set BottomRightX [::expr [::lindex $Rectangle 2]+[::QW::GUI::WINEXPLO::_optionGet originX]]; ::set BottomRightY [::expr [::lindex $Rectangle 3]+[::QW::GUI::WINEXPLO::_optionGet originY]]; ::set Rectangle [::lreplace $Rectangle 0 3 0 0 $BottomRightX $BottomRightY]; ::return $Rectangle; } ::proc treeDestructor {win} { #::QW::GUI::WINEXPLO::_traceIn; ::QW::GUI::WINEXPLO::_redrawCancel $win [::QW::GUI::WINEXPLO::_optionGet -canvaspath] delete all; ::catch [unset ::controlArray]; #::QW::GUI::WINEXPLO::_traceOut; } # ------------------------------------------------------------------------------ # Configuration options # ------------------------------------------------------------------------------ ::proc ::QW::GUI::WINEXPLO::_optionSet {Option Value} { #puts "::QW::GUI::WINEXPLO::_optionSet \"$Option\" \"$Value\"" ::set ::controlArray($Option) $Value; } ::proc _optionGet {Option} { #puts "::QW::GUI::WINEXPLO::_optionGet \"$Option\"" ::return $::controlArray($Option); } ::proc _configureItem {win OptionName NewValue} { #puts "::QW::GUI::WINEXPLO::_configureItem $win \"$OptionName\" \"$NewValue\"" ::if {[catch {::set OldValue [::QW::GUI::WINEXPLO::_optionGet $OptionName]} errInfo]} { ::if {![::QW::GUI::WINEXPLO::_optionGet boot]} {::_error "Unknown option: \"$OptionName\"";} ::set OldValue ""; } ::QW::GUI::WINEXPLO::_optionSet $OptionName $NewValue; ::QW::GUI::WINEXPLO::_sanityCheck $OptionName $OldValue $NewValue; ::switch -- $OptionName { -origin {::QW::GUI::WINEXPLO::_originSet $win $OldValue $NewValue;} -plusimage {::QW::GUI::WINEXPLO::_imageSet $win $OptionName plusImage $NewValue;} -minusimage {::QW::GUI::WINEXPLO::_imageSet $win $OptionName minusImage $NewValue;} -nodeimage {::QW::GUI::WINEXPLO::_imageSet $win $OptionName nodeImage $NewValue;} -openimage {::QW::GUI::WINEXPLO::_imageSet $win $OptionName openImage $NewValue;} -closedimage {::QW::GUI::WINEXPLO::_imageSet $win $OptionName closedImage $NewValue;} -inactivefont {::QW::GUI::WINEXPLO::_updateGeometry $win;} -activefont {::QW::GUI::WINEXPLO::_updateGeometry $win;} -inactivelinecolor {::QW::GUI::WINEXPLO::_activePathRefreshDisplay $win;} -activelinecolor {::QW::GUI::WINEXPLO::_activePathRefreshDisplay $win;} -inactivetextcolor {::QW::GUI::WINEXPLO::_activePathRefreshDisplay $win;} -activetextcolor {::QW::GUI::WINEXPLO::_activePathRefreshDisplay $win;} -inactivelinethickness {::QW::GUI::WINEXPLO::_activePathRefreshDisplay $win;} -activelinethickness {::QW::GUI::WINEXPLO::_activePathRefreshDisplay $win;} -activepath {::QW::GUI::WINEXPLO::_activePath $win $OldValue $NewValue;} -columnwidth {::QW::GUI::WINEXPLO::_redraw $win;} -autobuttons {puts "$OptionName not implemented yet.";} -canvasbackgroundcolor {::QW::GUI::WINEXPLO::_rectangleColorChange $win;} -dumpcallstackonerror {} -canvaspath {::if {$NewValue!=""} {::QW::GUI::WINEXPLO::_optionSet -canvasbackgroundcolor [$NewValue cget -background];}} -cursor {::if {[::QW::GUI::WINEXPLO::_optionGet -canvaspath]!=""} {[::QW::GUI::WINEXPLO::_optionGet -canvaspath] configure -cursor $NewValue;}} -cursorwait {::if {[::QW::GUI::WINEXPLO::_optionGet -canvaspath]!=""} {[::QW::GUI::WINEXPLO::_optionGet -canvaspath] configure -cursor $NewValue;}} } } ::proc _sanityCheck {OptionName OldValue NewValue} { ::switch -- $OptionName { -inactivelinethickness { ::if {$NewValue<1} {::QW::GUI::WINEXPLO::_optionSet $OptionName 1} } -activelinethickness { ::if {$NewValue<1} {::QW::GUI::WINEXPLO::_optionSet $OptionName 1} } -columnwidth { ::if {$NewValue<4} {::QW::GUI::WINEXPLO::_optionSet $OptionName 4} } } } ::proc _originSet {win OldValue NewValue} { ::if {[::llength $NewValue]!=2} {::_error "-origin: wrong # of args.";} ::if {[::llength $OldValue]!=2} {::set OldValue "0 0";} ::set DeltaX [::expr [::lindex $NewValue 0]-[::lindex $OldValue 0]]; ::set DeltaY [::expr [::lindex $NewValue 1]-[::lindex $OldValue 1]]; ::QW::GUI::WINEXPLO::_optionSet originX [::lindex $NewValue 0]; ::QW::GUI::WINEXPLO::_optionSet originY [::lindex $NewValue 1]; ::if {$DeltaX||$DeltaY} {::QW::GUI::WINEXPLO::_redraw $win;} } ::proc _rectangleColorChange {win} { global hierInfo; set var $hierInfo($win-data); upvar #0 $var data; # ::if {![::QW::GUI::WINEXPLO::_optionGet show]} {::return} [::QW::GUI::WINEXPLO::_optionGet -canvaspath] itemconfigure rectangle -outline [::QW::GUI::WINEXPLO::_optionGet -canvasbackgroundcolor]; } ::proc _fontSet {win FontOption NewFont} { ::QW::GUI::WINEXPLO::_updateGeometry $win; } ::proc _allDisplayItemsSet {} { ::set MissingOptionList {}; ::foreach Option {-plusimage -minusimage -nodeimage -openimage -closedimage -activefont -inactivefont -canvaspath -signaltoownercommand} { ::if {[::lsearch -exact [::array names ::controlArray] $Option]<0} { ::lappend MissingOptionList $Option; } else { ::if {[::QW::GUI::WINEXPLO::_optionGet $Option]==""} {::lappend MissingOptionList $Option;} } } ::QW::GUI::WINEXPLO::_optionSet missingOptions $MissingOptionList; ::return [::expr ![::llength [::QW::GUI::WINEXPLO::_optionGet missingOptions]]]; } ::proc _updateGeometry {win} { ::if {![::QW::GUI::WINEXPLO::_allDisplayItemsSet]} {::return;} ::set ActiveFont [::QW::GUI::WINEXPLO::_optionGet -activefont]; ::set InactiveFont [::QW::GUI::WINEXPLO::_optionGet -inactivefont]; set ActiveFontHeightPoints [::font metrics [::font actual $ActiveFont] -linespace]; set InactiveFontHeightPoints [::font metrics [::font actual $InactiveFont] -linespace]; set ActiveFontHeight [::winfo fpixels . [append ActiveFontHeightPoints p]] set InactiveFontHeight [::winfo fpixels . [append InactiveFontHeightPoints p]] set ActiveFontHeight [::expr round([::expr $ActiveFontHeight+.5])] set InactiveFontHeight [::expr round([::expr $InactiveFontHeight+.5])] ::QW::GUI::WINEXPLO::_optionSet fontHeight [::expr [::expr $ActiveFontHeight>$InactiveFontHeight?$ActiveFontHeight:$InactiveFontHeight]+[::QW::GUI::WINEXPLO::_optionGet linePadding]]; ::set NewLineHeight 0 ::set i [::QW::GUI::WINEXPLO::_maximumImageY];::if {$i>$NewLineHeight} {::set NewLineHeight $i;} ::set i [::QW::GUI::WINEXPLO::_optionGet fontHeight];::if {$i>$NewLineHeight} {::set NewLineHeight $i;} ::incr NewLineHeight [::QW::GUI::WINEXPLO::_optionGet linePadding]; ::if {$NewLineHeight!=[::QW::GUI::WINEXPLO::_optionGet lineHeight]} { ::QW::GUI::WINEXPLO::_optionSet lineHeight $NewLineHeight; ::QW::GUI::WINEXPLO::_optionSet lineCenter [::expr int([::expr $NewLineHeight*.5])]; # Fix up images ::foreach Image {plusImage minusImage nodeImage openImage closedImage} { ::set ImageHeight [::QW::GUI::WINEXPLO::_optionGet $Image-height]; ::set ImageWidth [::QW::GUI::WINEXPLO::_optionGet $Image-width]; ::if {$NewLineHeight<=$ImageHeight} { ::QW::GUI::WINEXPLO::_optionSet $Image-centerY [::expr int([::expr $ImageHeight*.5])]; } else { ::QW::GUI::WINEXPLO::_optionSet $Image-centerY [::expr int((($NewLineHeight-$ImageHeight)*.5)+[::expr $ImageHeight*.5])]; } } ::QW::GUI::WINEXPLO::_redraw $win; } else { ::QW::GUI::WINEXPLO::_activePathRefreshDisplay $win; } } ::proc _cursorSet {CursorType} { ::if {$CursorType=="normal"} {[::QW::GUI::WINEXPLO::_optionGet -canvaspath] configure -cursor [::QW::GUI::WINEXPLO::_optionGet -cursor];::return} #nv2.38.0 (linux) #::if {$CursorType=="wait"} {[::QW::GUI::WINEXPLO::_optionGet -canvaspath] configure -cursor [::QW::GUI::WINEXPLO::_optionGet -cursorwait];::return} ::if {$CursorType==$::qw::platform_dependent_cursor(wait)} {[::QW::GUI::WINEXPLO::_optionGet -canvaspath] configure -cursor [::QW::GUI::WINEXPLO::_optionGet -cursorwait];::return} ::QW::GUI::WINEXPLO::_assert "Unkown cursor type \"$CursorType\""; } ::proc _maximumImageX {} {::return [::QW::GUI::WINEXPLO::_maximumImageDimension width];} ::proc _maximumImageY {} {::return [::QW::GUI::WINEXPLO::_maximumImageDimension height];} ::proc _maximumImageDimension {axis} { ::set Result 0; ::foreach Image {-plusimage -minusimage -nodeimage -openimage -closedimage} { ::set Size [::image $axis [::QW::GUI::WINEXPLO::_optionGet $Image]]; ::if {$Size>$Result} {::set Result $Size;} } ::return $Result; } ::proc _signalRectangleChange {win} { ::if {![::QW::GUI::WINEXPLO::_optionGet show]} {::return} ::QW::GUI::WINEXPLO::_signalRectangleChangeCancel $win; ::QW::GUI::WINEXPLO::_optionSet signalRectangleChangeAfterID \ [::after idle [::list [::QW::GUI::WINEXPLO::_optionGet -signaltoownercommand] \ $win rectangle [::QW::GUI::WINEXPLO::treeRectangleRequest $win]]]; } ::proc _signalRectangleChangeCancel {win} { ::if {[::QW::GUI::WINEXPLO::_optionGet signalRectangleChangeAfterID]!=""} { ::after cancel [::QW::GUI::WINEXPLO::_optionGet signalRectangleChangeAfterID]; ::QW::GUI::WINEXPLO::_optionSet signalRectangleChangeAfterID ""; } } ::proc _redraw {win} { ::if {![::QW::GUI::WINEXPLO::_optionGet show]} {::return} ::QW::GUI::WINEXPLO::_redrawCancel $win; ::QW::GUI::WINEXPLO::_optionSet redrawAfterID [::after idle [::list ::QW::GUI::WINEXPLO::treeShow $win]] } ::proc _redrawCancel {win} { ::if {[::QW::GUI::WINEXPLO::_optionGet redrawAfterID]!=""} { ::after cancel [::QW::GUI::WINEXPLO::_optionGet redrawAfterID]; ::QW::GUI::WINEXPLO::_optionSet redrawAfterID ""; } } ::proc _imageSet {win OptionName Label Image} { #::QW::GUI::WINEXPLO::_traceIn; ::QW::GUI::WINEXPLO::_optionSet $OptionName $Image; ::QW::GUI::WINEXPLO::_optionSet $Label-image $Image ::if {$Image==""} {::return;} ::set Width [image width $Image] ::set Height [image height $Image] ::QW::GUI::WINEXPLO::_optionSet $Label-width $Width ::QW::GUI::WINEXPLO::_optionSet $Label-height $Height ::QW::GUI::WINEXPLO::_optionSet $Label-centerX [::expr int([::expr $Width*.5])] ::QW::GUI::WINEXPLO::_optionSet $Label-centerY [::expr int([::expr $Height*.5])]; ::QW::GUI::WINEXPLO::_updateGeometry $win; #::QW::GUI::WINEXPLO::_traceOut; } # ------------------------------------------------------------------------------ # 'utilities' # ------------------------------------------------------------------------------ ::proc _error {Src} { ::if {[::QW::GUI::WINEXPLO::_optionGet -dumpcallstackonerror]} { ::QW::GUI::WINEXPLO::_dumpCallStack;::error "$Src";::return;} ::error "[::lindex [::info level [::expr [::info level]-1]] 0]\n$Src"; } ::proc _assert {Src} { ::QW::GUI::WINEXPLO::_dumpCallStack; ::bell; ::error "* Assert *\n[::lindex [::info level [::expr [::info level]-1]] 0]\n$Src"; ::return; } ::proc _traceIn {} { ::if {![::QW::GUI::WINEXPLO::_optionGet tracing]} {::return;} ::puts "[::string repeat \t [::QW::GUI::WINEXPLO::_optionGet callDepth]][::info level [::expr [::info level]-1]] \{" ::QW::GUI::WINEXPLO::_optionSet callDepth [::expr [::QW::GUI::WINEXPLO::_optionGet callDepth]+1] } ::proc _traceOut {} { ::if {![::QW::GUI::WINEXPLO::_optionGet tracing]} {::return;} ::QW::GUI::WINEXPLO::_optionSet callDepth [::expr [::QW::GUI::WINEXPLO::_optionGet callDepth]-1] ::puts "[::string repeat \t [::QW::GUI::WINEXPLO::_optionGet callDepth]]\}\t[::info level [::expr [::info level]-1]]" } ::proc _thisProcNameName {} {::return [::lindex [::info level [::expr [::info level]-1]] 0]} ::proc _thisProcNameArgs {} {::return [::lrange [::info level [::expr [::info level]-1]] 1 end]} ::proc _thisProcNameInfo {} {::return [::info level [::expr [::info level]-1]]} ::proc _dumpCallStack {} {::for {::set i [::expr [::info level]-2]} {$i>=1} {::incr i -1} {puts "$i\t[::info level $i]"}} ::proc _nodeFromPathList {win args} { #puts "::_nodeFromPathList $args" if {[::string length [::lindex $args 0]]==0} {::return "";} if {[::llength $args]==1} {::return [::QW::GUI::WINEXPLO::_nodeFromPathList $win [::lindex $args 0] root]} set pathList [::lindex $args 0]; set node [::lindex $args 1]; # global hierInfo; set var $hierInfo($win-data); upvar #0 $var data; # ::set nodeChildren $data($node-children); ::set searchLabel [::lindex $pathList 0]; ::for {::set i 0;} {$i<[::llength $nodeChildren]} {::incr i;} { ::set node [::lindex $nodeChildren $i]; ::set nodeLabel $data($node-label); #::if {$nodeLabel==$searchLabel} {::break;} ::if {$nodeLabel eq $searchLabel} {::break;} } #::if {$nodeLabel!=$searchLabel} {::QW::GUI::WINEXPLO::_error "label \"$searchLabel\" not found."} ::if {$nodeLabel ne $searchLabel} {::QW::GUI::WINEXPLO::_error "label \"$searchLabel\" not found."} ::if {[::llength $pathList]>1} {::return [::QW::GUI::WINEXPLO::_nodeFromPathList $win [::lrange $pathList 1 end] $node];} ::return $node; } ::proc _pathListFromNode {win node} { #puts "::_pathListFromNode node: \"$node\"" global hierInfo; set var $hierInfo($win-data); upvar #0 $var data; # ::for {::set i 1;::set result "";} {$i<[::llength [::split $node -]]} {::incr i;} { ::lappend result $data([::join [::lrange [::split $node -] 0 $i] -]-label); } # Debug if {$node!=[::QW::GUI::WINEXPLO::_nodeFromPathList $win $result]} { ::_assert "\"$result\"!=\"[::QW::GUI::WINEXPLO::_nodeFromPathList $win $node]\"";} # ::return $result; } # ------------------------------------------------------------------------------ # signalling # ------------------------------------------------------------------------------ ::proc _signalOwner {win args} { #puts "::_signalOwner $win $args ([::llength $args] args)" # Before passing args up, we have to substitute the path list for the node ::eval "[::QW::GUI::WINEXPLO::_optionGet -signaltoownercommand] $win [::lindex $args 0] [::list [::QW::GUI::WINEXPLO::_pathListFromNode $win [::lindex $args 1]]] [::lrange $args 2 end]"; } # ------------------------------------------------------------------------------ # 'actions' # ------------------------------------------------------------------------------ ::proc _activePathRefreshDisplay {win} { ::if {![::QW::GUI::WINEXPLO::_optionGet show]} {::return;} ::QW::GUI::WINEXPLO::_activePath $win [::QW::GUI::WINEXPLO::_optionGet -activepath] [::QW::GUI::WINEXPLO::_optionGet -activepath]; } ::proc _activePath {win OldActivePath NewActivePath} { global hierInfo; set var $hierInfo($win-data); upvar #0 $var data; # ::set CanvasPath [::QW::GUI::WINEXPLO::_optionGet -canvaspath]; ::if {$CanvasPath==""} {::return;} # Set any 'active' lines back to inactive. # (This is too coarse, but OK for now.) ::foreach ItemId [$CanvasPath find withtag line] {$CanvasPath itemconfigure $ItemId -width [::QW::GUI::WINEXPLO::_optionGet -inactivelinethickness] -fill [::QW::GUI::WINEXPLO::_optionGet -inactivelinecolor];} ::foreach ItemId [$CanvasPath find withtag label] {$CanvasPath itemconfigure $ItemId -font [::QW::GUI::WINEXPLO::_optionGet -inactivefont] -fill [::QW::GUI::WINEXPLO::_optionGet -inactivetextcolor];} ::if {$NewActivePath==""} {::return;} set NewActiveNode [::QW::GUI::WINEXPLO::_nodeFromPathList $win $NewActivePath]; # Activate the node's label (font & color) $CanvasPath itemconfigure $NewActiveNode-label -font [::QW::GUI::WINEXPLO::_optionGet -activefont] -fill [::QW::GUI::WINEXPLO::_optionGet -activetextcolor]; # The lines ::QW::GUI::WINEXPLO::_activatePathToRoot $win $CanvasPath $NewActiveNode [::QW::GUI::WINEXPLO::_optionGet -activelinethickness] [::QW::GUI::WINEXPLO::_optionGet -activelinecolor]; } ::proc _activatePathToRoot {win CanvasPath Node LineThickness LineColor} { global hierInfo; set var $hierInfo($win-data); upvar #0 $var data; # ::set ParentNode [join [::lrange [split $Node -] 0 end-1] -]; ::if {$data($ParentNode-expandedState)||$Node=="root-1"} { # Activate my "left" and "up" lines $CanvasPath itemconfigure $Node-line4 -width $LineThickness -fill $LineColor; ::if {$Node!="root-1"} { $CanvasPath itemconfigure $Node-line1 -width $LineThickness -fill $LineColor; $CanvasPath itemconfigure $Node-line2 -width $LineThickness -fill $LineColor; } # Activate the lines of all siblings above me ::foreach Sibling $data($ParentNode-children) { ::if {$Sibling!=$Node} { $CanvasPath itemconfigure $Sibling-line0 -width $LineThickness -fill $LineColor; $CanvasPath itemconfigure $Sibling-line1 -width $LineThickness -fill $LineColor; $CanvasPath itemconfigure $Sibling-line3 -width $LineThickness -fill $LineColor; } else { ::break; } } } # Recurse through parents up to the root ::if {$Node!="root-1"} {::QW::GUI::WINEXPLO::_activatePathToRoot $win $CanvasPath $ParentNode $LineThickness $LineColor;} } ::proc _seeNode {win node} { global hierInfo; set var $hierInfo($win-data); upvar #0 $var data; # ::if {[::lsearch [array names data] $node-label]==-1} {::QW::GUI::WINEXPLO::_error "$node is invalid";::return;} ::set nodes [split $node -]; ::set depth [::llength $nodes]; ::for {set i 1} {$i<$depth} {incr i;} { ::set path [join [::lrange $nodes 0 $i] -]; ::if {[::lsearch [array names data] $path-children]==-1} {::QW::GUI::WINEXPLO::_error "$path is a leaf.";::return;} ::if {[::llength $data($path-children)]} { ::if {!$data($path-expandedState)} { ::set ItemId [[::QW::GUI::WINEXPLO::_optionGet -canvaspath] find withtag $path-button]; ::if {$ItemId==""} {::QW::GUI::WINEXPLO::_error "can't find $path button";::return;} ::QW::GUI::WINEXPLO::_nodeExpand $win $path; } else { ::QW::GUI::WINEXPLO::_error "$path is already expanded";::return; } } else { ::if {[::expr $i+1]<$depth} {::QW::GUI::WINEXPLO::_assert "Unknown error 2";::return} } } } ::proc _tagItemsInRectangle {win TopLeftX TopLeftY BottomRightX BottomRightY Tag} { # Replacement for Tk's "$win addtag tag enclosed x1 topLeftY bottomRightX bottomRightY" method # Their 'enclosed' means within the rectangle and not touching an edge. # We need items in the rectangle even if they touch an edge. ::if {![::string length TopLeftX]} {::QW::GUI::WINEXPLO::_assert "TopLeftX not specified.";} ::if {![::string length TopLeftY]} {::QW::GUI::WINEXPLO::_assert "TopLeftY not specified.";} ::if {![::string length BottomRightX]} {::QW::GUI::WINEXPLO::_assert "BottomRightX not specified.";} ::if {![::string length BottomRightY]} {::QW::GUI::WINEXPLO::_assert "BottomRightY not specified.";} [::QW::GUI::WINEXPLO::_optionGet -canvaspath] dtag $Tag; ::set TopLeftX [::expr int($TopLeftX)]; incr TopLeftX -1; ::set TopLeftY [::expr int($TopLeftY)]; incr TopLeftY -1; ::set BottomRightX [::expr int($BottomRightX)]; incr BottomRightX 1; ::set BottomRightY [::expr int($BottomRightY)]; incr BottomRightY 1; [::QW::GUI::WINEXPLO::_optionGet -canvaspath] addtag $Tag enclosed $TopLeftX $TopLeftY $BottomRightX $BottomRightY; } ::proc _nodeInsert {win node} { #::_traceIn; #puts "::_nodeInsert($win,$node)" global hierInfo set var $hierInfo($win-data) upvar #0 $var data # ::set indent "0"; ::set CanvasPath [::QW::GUI::WINEXPLO::_optionGet -canvaspath]; ::foreach digit [split $node "-"] {incr indent;} ::set activebg [option get $win activeColor Color]; ::set nodeChildren [::llength $data($node-children)]; ::set ExpandedList ""; ::if {$nodeChildren!=0} { # # Move all items below me down ::set DeltaY [::expr $nodeChildren*[::QW::GUI::WINEXPLO::_optionGet lineHeight]]; ::set MyRectangle [$CanvasPath coords [$CanvasPath find withtag $node]]; ::set RectCoords [$CanvasPath bbox all]; ::set RectX1 [::QW::GUI::WINEXPLO::_optionGet originX]; ::set RectY1 [::lindex $MyRectangle 3]; ::set RectX2 [::lindex $RectCoords 2]; ::set RectY2 [::lindex $RectCoords 3]; ::QW::GUI::WINEXPLO::_tagItemsInRectangle $win $RectX1 $RectY1 $RectX2 $RectY2 toBeMoved; $CanvasPath dtag $node toBeMoved; #(Remove my parent from the list) $CanvasPath dtag root toBeMoved; $CanvasPath move toBeMoved 0 $DeltaY; $CanvasPath dtag toBeMoved; # Resize rectangles from me back to root (and build "line list") ::set Rect $node; ::array set ::LineArray ""; ::while {1} { ::set RectCoords [$CanvasPath coords $Rect]; ::set RectX1 [::lindex $RectCoords 0]; ::set RectY1 [::lindex $RectCoords 1]; ::set RectX2 [::lindex $RectCoords 2]; ::set RectY2 [::expr [::lindex $RectCoords 3] + $DeltaY]; $CanvasPath coords $Rect $RectX1 $RectY1 $RectX2 $RectY2; # ::set RectTags [$CanvasPath gettags $Rect]; # #::if {[::lsearch $RectTags lastChild]>=0} { # ::set ::LineArray($Rect) 0; #} else { # ::set ::LineArray($Rect) 1; #} ::set ::LineArray($Rect) [::expr [::lsearch $RectTags lastChild]>=0?0:1]; # ::if {$Rect!="root"} { ::set Rect [string range $Rect 0 [::expr [string last - $Rect]-1]]; } else { break; } } $CanvasPath dtag toBeResized; # # Set x & y coordinates for child display ::set ChildY [::expr int([::lindex $MyRectangle 1])]; ::set lastItemWasBranch 0; ::set LastBranchId -1; # Display my children ::set Child 1; # SHOWMENUITEMS ::if {$data($node-label)!=""} { ::set parentClass [winfo class $data($node-label)]; } else { ::set parentClass ""; } #puts "About to display children of \"$data($node-label)\" which is a \"$parentClass\"" ::set InactiveLineColor [::QW::GUI::WINEXPLO::_optionGet -inactivelinecolor]; ::set InactiveLineThickness [::QW::GUI::WINEXPLO::_optionGet -inactivelinethickness]; ::foreach subnode $data($node-children) { ::set Expanded 0; ::set branchNode 0; ::if {$data($subnode-children)!=""} { ::set branchNode 1; ::if {$data($subnode-expandedState)} { ::lappend ExpandedList $subnode; ::set Expanded 1; } } ::if {$parentClass=="Menu"} { ::set menuParent $data($node-label); ::if {$branchNode} { ::set widgetName [winfo name $data($subnode-label)]; ::set childClass "Menu"; } else { ::set widgetName $data($subnode-label); ::set childClass "Menu"; ::if {![::winfo exists $widgetName]} { ::set widgetName [$menuParent entrycget $widgetName -label]; ::set childClass "MenuItem"; } } } else { ::set widgetName [winfo name $data($subnode-label)]; ::set childClass [winfo class $data($subnode-label)]; } ::set ChildX [::expr $indent*[::QW::GUI::WINEXPLO::_optionGet -columnwidth]+[::QW::GUI::WINEXPLO::_optionGet originX]]; ::set childCenterY [::expr $ChildY+[::QW::GUI::WINEXPLO::_optionGet lineCenter]]; # Draw the vertical lines to the left ::set Rect $subnode; ::set LineX [::expr $ChildX-[::QW::GUI::WINEXPLO::_optionGet -columnwidth]+[::QW::GUI::WINEXPLO::_optionGet plusImage-centerX]]; ::while {1} { ::if {$Rect!="root"} { ::set Parent [string range $Rect 0 [::expr [string last - $Rect]-1]]; } else { break; } ::if {$::LineArray($Parent)} { set ItemId [$CanvasPath create line $LineX $ChildY \ $LineX [::expr $ChildY+[::QW::GUI::WINEXPLO::_optionGet lineHeight]-1] \ $LineX [::expr $ChildY+[::QW::GUI::WINEXPLO::_optionGet lineHeight]-2] \ -arrow none -capstyle butt -width $InactiveLineThickness -fill $InactiveLineColor -tags line]; $CanvasPath addtag $Parent-line0 withtag $ItemId; } ::set Rect $Parent; ::incr LineX [::expr 0-[::QW::GUI::WINEXPLO::_optionGet -columnwidth]]; } # Draw connector lines ::if {$indent>1} { ::set LineX [::expr $ChildX+[::QW::GUI::WINEXPLO::_optionGet plusImage-centerX]]; ::set LineY [::QW::GUI::WINEXPLO::_optionGet lineCenter]; ::set ItemId1 [$CanvasPath create line \ $LineX $ChildY \ $LineX $childCenterY \ -arrow none -capstyle butt -width $InactiveLineThickness -fill $InactiveLineColor;] $CanvasPath addtag "line" withtag $ItemId1; $CanvasPath addtag "$subnode-line1" withtag $ItemId1; ::set ItemId2 [$CanvasPath create line \ $LineX $childCenterY \ [::expr $ChildX+[::QW::GUI::WINEXPLO::_optionGet plusImage-width]] $childCenterY \ -arrow none -capstyle butt -width $InactiveLineThickness -fill $InactiveLineColor;] $CanvasPath addtag "line" withtag $ItemId2; $CanvasPath addtag "$subnode-line2" withtag $ItemId2; ::if {$Child!=$nodeChildren} { ::set ItemId3 [$CanvasPath create line \ $LineX $childCenterY \ $LineX [::expr $ChildY+[::QW::GUI::WINEXPLO::_optionGet lineHeight]-0] \ -arrow none -capstyle butt -width $InactiveLineThickness -fill $InactiveLineColor;] $CanvasPath addtag "line" withtag $ItemId3; $CanvasPath addtag "$subnode-line3" withtag $ItemId3; } } # Draw [+] or [-] button ::if {$branchNode} { ::if {$Expanded} { ::set imageX [::expr [::QW::GUI::WINEXPLO::_optionGet minusImage-centerX]+$ChildX]; ::set imageY [::expr [::QW::GUI::WINEXPLO::_optionGet minusImage-centerY]+$ChildY]; ::set ItemId [$CanvasPath create image $imageX $imageY -image [::QW::GUI::WINEXPLO::_optionGet minusImage-image] -anchor center]; ::set Button "contractButton"; } else { ::set imageX [::expr [::QW::GUI::WINEXPLO::_optionGet plusImage-centerX]+$ChildX]; ::set imageY [::expr [::QW::GUI::WINEXPLO::_optionGet plusImage-centerY]+$ChildY]; ::set ItemId [$CanvasPath create image $imageX $imageY -image [::QW::GUI::WINEXPLO::_optionGet plusImage-image] -anchor center]; ::set Button "expandButton"; } # Tags $CanvasPath addtag "image" withtag $ItemId; $CanvasPath addtag "$subnode-button" withtag $ItemId; # Bindings $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win buttonPress $subnode $Button 1"; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win buttonPress $subnode $Button 2"; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win buttonPress $subnode $Button 3"; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win buttonRelease $subnode $Button 1"; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win buttonRelease $subnode $Button 2"; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win buttonRelease $subnode $Button 3"; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win doubleButtonPress $subnode $Button 1;break"; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win enter $subnode $Button %x %y $childClass"; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win leave $subnode $Button %x %y $childClass"; ::unset Button; } ::incr ChildX [::QW::GUI::WINEXPLO::_optionGet plusImage-width]; # Draw the little line after ::set ItemId [$CanvasPath create line $ChildX $childCenterY [::expr $ChildX +4] $childCenterY -arrow none -capstyle butt -width 1 -fill $InactiveLineColor]; # Tags $CanvasPath addtag "line" withtag $ItemId; $CanvasPath addtag "$subnode-line4" withtag $ItemId; # Bindings $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win buttonPress $subnode icon 1 $childClass"; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win buttonPress $subnode icon 2 $childClass"; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win buttonPress $subnode icon 3 $childClass"; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win buttonRelease $subnode icon 1 $childClass"; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win buttonRelease $subnode icon 2 $childClass"; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win buttonRelease $subnode icon 3 $childClass"; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win enter $subnode icon %x %y $childClass"; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win leave $subnode icon %x %y $childClass"; # ::incr ChildX 4 # Draw the icon ::if {$branchNode} { ::if {$Expanded} { ::set imageX [::expr [::QW::GUI::WINEXPLO::_optionGet openImage-centerX]+$ChildX]; ::set imageY [::expr [::QW::GUI::WINEXPLO::_optionGet openImage-centerY]+$ChildY]; ::set ItemId [$CanvasPath create image $imageX $imageY -image [::QW::GUI::WINEXPLO::_optionGet openImage-image]]; incr ChildX [::QW::GUI::WINEXPLO::_optionGet openImage-width]; } else { ::set imageX [::expr [::QW::GUI::WINEXPLO::_optionGet closedImage-centerX]+$ChildX]; ::set imageY [::expr [::QW::GUI::WINEXPLO::_optionGet closedImage-centerY]+$ChildY]; ::set ItemId [$CanvasPath create image $imageX $imageY -image [::QW::GUI::WINEXPLO::_optionGet closedImage-image]]; incr ChildX [::QW::GUI::WINEXPLO::_optionGet closedImage-width]; } } else { ::set imageX [::expr [::QW::GUI::WINEXPLO::_optionGet nodeImage-centerX]+$ChildX]; ::set imageY [::expr [::QW::GUI::WINEXPLO::_optionGet nodeImage-centerY]+$ChildY]; ::set ItemId [$CanvasPath create image $imageX $imageY -image [::QW::GUI::WINEXPLO::_optionGet nodeImage-image]]; incr ChildX [::QW::GUI::WINEXPLO::_optionGet nodeImage-width]; } incr ChildX 3 # Tags $CanvasPath addtag "$subnode-icon" withtag $ItemId; # Bindings $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win buttonPress $subnode icon 1 $childClass"; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win buttonPress $subnode icon 2 $childClass"; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win buttonPress $subnode icon 3 $childClass"; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win buttonRelease $subnode icon 1 $childClass"; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win buttonRelease $subnode icon 2 $childClass"; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win buttonRelease $subnode icon 3 $childClass"; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win enter $subnode icon %x %y $childClass"; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win leave $subnode icon %x %y $childClass"; # Display the label #::set ItemId [$CanvasPath create text $ChildX [::expr $ChildY+1] -text $widgetName -anchor nw -fill [::QW::GUI::WINEXPLO::_optionGet -inactivetextcolor]]; ::set ItemId [$CanvasPath create text $ChildX [::expr $ChildY+[::QW::GUI::WINEXPLO::_optionGet lineCenter]] -text $widgetName -anchor w -fill [::QW::GUI::WINEXPLO::_optionGet -inactivetextcolor]]; # Tags $CanvasPath addtag "label" withtag $ItemId; $CanvasPath addtag "$subnode-label" withtag $ItemId; # Bindings $CanvasPath itemconfigure $ItemId -font [::QW::GUI::WINEXPLO::_optionGet -inactivefont]; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win buttonPress $subnode label 1 $childClass"; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win buttonPress $subnode label 2 $childClass"; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win buttonPress $subnode label 3 $childClass"; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win buttonRelease $subnode label 1 $childClass"; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win buttonRelease $subnode label 2 $childClass"; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win buttonRelease $subnode label 3 $childClass"; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win enter $subnode label %x %y $childClass"; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win leave $subnode label %x %y $childClass"; # incr ChildX 3 # Create empty child rectangle ::if {$branchNode} { ::set x1 [::QW::GUI::WINEXPLO::_optionGet originX]; ::set y1 [::expr $ChildY+[::QW::GUI::WINEXPLO::_optionGet lineHeight]]; ::set x2 [::QW::GUI::WINEXPLO::_optionGet kludgeRectangleWidth];# RTH - this needs work; ::set y2 $y1; ::set rectangleOutlineColor [$CanvasPath cget -background]; ::set ItemId [$CanvasPath create rectangle $x1 $y1 $x2 $y2 -width 0 -outline $rectangleOutlineColor -tags "$subnode rectangle"]; $CanvasPath lower $ItemId; ::set LastBranchId $ItemId; ::set lastItemWasBranch 1; } else { ::set lastItemWasBranch 0; } # incr Child; incr ChildY [::QW::GUI::WINEXPLO::_optionGet lineHeight]; } # Tag last branch child rectangle as lastChild #::if {$LastBranchId>=0} { # ::if {$lastItemWasBranch} { # $CanvasPath addtag lastChild withtag $LastBranchId; # } #} ::if {$LastBranchId>=0&&$lastItemWasBranch} {$CanvasPath addtag lastChild withtag $LastBranchId;} } # Expand any children previously expanded ::foreach node $ExpandedList {::QW::GUI::WINEXPLO::_nodeInsert $win $node;} ::QW::GUI::WINEXPLO::_activePathRefreshDisplay $win; # ::if {![::QW::GUI::WINEXPLO::_optionGet expandAll]} {::QW::GUI::WINEXPLO::_signalRectangleChange $win;} #::QW::GUI::WINEXPLO::_traceOut; } ::proc _dumpItems {win} { ::foreach item [[::QW::GUI::WINEXPLO::_optionGet -canvaspath] find all] { ::puts "Item: $item ---------------------" ::puts " type: [[::QW::GUI::WINEXPLO::_optionGet -canvaspath] type $item]" ::puts " configure: [[::QW::GUI::WINEXPLO::_optionGet -canvaspath] itemconfigure $item]" ::puts " coords: [[::QW::GUI::WINEXPLO::_optionGet -canvaspath] coords $item]" } } ::proc _nodeExpand {win node} { #::QW::GUI::WINEXPLO::_traceIn; #puts "::_nodeExpand($win,$node)" global hierInfo ::set var $hierInfo($win-data) upvar #0 $var data # ::set CanvasPath [::QW::GUI::WINEXPLO::_optionGet -canvaspath]; ::if {$data($node-expandedState)!=0} {::QW::GUI::WINEXPLO::_error "Item already expanded";} ::set data($node-expandedState) 1; ::set ItemId [$CanvasPath find withtag $node-button]; ::if {[::llength $ItemId]<1} {::QW::GUI::WINEXPLO::_error "No item found with tag $node-button";} ::if {[::llength $ItemId]>1} {::QW::GUI::WINEXPLO::_error "Multiple items found with tag $node-button";} ::set image [$CanvasPath itemcget $ItemId -image]; ::if {$image!=[::QW::GUI::WINEXPLO::_optionGet plusImage-image]} {::QW::GUI::WINEXPLO::_error "Wrong image \"$image\" (should be \"[::QW::GUI::WINEXPLO::_optionGet plusImage-image]\")";} $CanvasPath itemconfigure $ItemId -image [::QW::GUI::WINEXPLO::_optionGet minusImage-image]; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win buttonPress $node contractButton 1"; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win buttonPress $node contractButton 2"; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win buttonPress $node contractButton 3"; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win buttonRelease $node contractButton 1"; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win buttonRelease $node contractButton 2"; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win buttonRelease $node contractButton 3"; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win doubleButtonPress $node contractButton 1;break"; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win enter $node contractButton %x %y"; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win leave $node contractButton %x %y"; # Change image from closed to open ::set ItemId [$CanvasPath find withtag $node-icon]; ::if {[::llength $ItemId]<1} {::QW::GUI::WINEXPLO::_error "No item found with tag \"$node-icon\"";} ::if {[::llength $ItemId]>1} {::QW::GUI::WINEXPLO::errorProc "Multiple items found with tag \"$node-icon\"";} $CanvasPath itemconfigure $ItemId -image [::QW::GUI::WINEXPLO::_optionGet openImage-image]; #puts "_nodeExpand: Node is \"$node\", path is \"[::QW::GUI::WINEXPLO::_pathListFromNode $win $node]\""; ::QW::GUI::WINEXPLO::_nodeInsert $win $node; #puts "::QW::GUI::WINEXPLO::_nodeExpand(return)"; #::QW::GUI::WINEXPLO::_traceOut; } ::proc _nodeExpandAll {win node} { global hierInfo ::set var $hierInfo($win-data) upvar #0 $var data # ::QW::GUI::WINEXPLO::_optionSet expandAll 1; ::if {!$data($node-expandedState)} {::QW::GUI::WINEXPLO::_nodeExpand $win $node;} ::foreach subnode $data($node-children) { ::if {[::llength $data($subnode-children)]} { ::QW::GUI::WINEXPLO::_nodeExpandAll $win $subnode; } } ::QW::GUI::WINEXPLO::_optionSet expandAll 0; ::QW::GUI::WINEXPLO::_signalRectangleChange $win; } # ------------------------------------------------------------------------------ ::proc _nodeContract {win node} { #::QW::GUI::WINEXPLO::_traceIn; #puts "::_nodeContract($win,$node)" global hierInfo ::set var $hierInfo($win-data) upvar #0 $var data # ::set CanvasPath [::QW::GUI::WINEXPLO::_optionGet -canvaspath]; ::if {$data($node-expandedState)==0} {::QW::GUI::WINEXPLO::errorProc "$node is not expanded.";} ::set data($node-expandedState) 0; ::set ItemId [$CanvasPath find withtag $node-button]; ::if {[::llength $ItemId]<1} {::QW::GUI::WINEXPLO::errorProc "No item found with tag \"$node-button\".";} ::if {[::llength $ItemId]>1} {::QW::GUI::WINEXPLO::errorProc "Multiple items found with tag \"$node-button\".";} ::set image [$CanvasPath itemcget $ItemId -image]; ::if {$image!=[::QW::GUI::WINEXPLO::_optionGet minusImage-image]} { ::QW::GUI::WINEXPLO::errorProc "Wrong image \"$image\" (should be \"[::QW::GUI::WINEXPLO::_optionGet minusImage-image]\")";} $CanvasPath itemconfigure $ItemId -image [::QW::GUI::WINEXPLO::_optionGet plusImage-image]; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win buttonPress $node expandButton 1"; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win buttonPress $node expandButton 2"; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win buttonPress $node expandButton 3"; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win buttonRelease $node expandButton 1"; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win buttonRelease $node expandButton 2"; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win buttonRelease $node expandButton 3"; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win doubleButtonPress $node expandButton 1;break"; $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win enter $node expandButton %x %y" $CanvasPath bind $ItemId "::QW::GUI::WINEXPLO::_signalOwner $win leave $node expandButton %x %y" # Change icon from open to closed ::set ItemId [$CanvasPath find withtag $node-icon]; if {[::llength $ItemId]<1} {::QW::GUI::WINEXPLO::errorProc "No item found with tag \"$node-icon\".";} if {[::llength $ItemId]>1} {::QW::GUI::WINEXPLO::errorProc "Multiple items found with tag \"$node-icon\".";} $CanvasPath itemconfigure $ItemId -image [::QW::GUI::WINEXPLO::_optionGet closedImage-image]; # Delete items in 'my' rectangle if {[::llength [$CanvasPath find withtag toBeDeleted]]!=0} {::QW::GUI::WINEXPLO::errorProc "\"toBeDeleted\" items!=0.";} ::set MyRectangle [$CanvasPath coords $node]; ############################################::set RectX1 [::QW::GUI::WINEXPLO::_optionGet originX] ::set RectX1 [::lindex $MyRectangle 0]; ::set RectY1 [::lindex $MyRectangle 1]; ::set RectX2 [::lindex $MyRectangle 2]; ::set RectY2 [::lindex $MyRectangle 3]; ::QW::GUI::WINEXPLO::_tagItemsInRectangle $win $RectX1 $RectY1 $RectX2 $RectY2 toBeDeleted; $CanvasPath dtag $node toBeDeleted; $CanvasPath delete toBeDeleted; # Move all items below my rectangle up if {[::llength [$CanvasPath find withtag toBeMoved]]!=0} {::QW::GUI::WINEXPLO::errorProc "\"toBeMoved\" items!=0.";} ::set DeltaY [::expr [::lindex $MyRectangle 1]-[::lindex $MyRectangle 3]]; ::set RectX1 [::QW::GUI::WINEXPLO::_optionGet originX]; ::set RectY1 [::lindex $MyRectangle 3]; ::QW::GUI::WINEXPLO::_tagItemsInRectangle $win $RectX1 $RectY1 65535 65535 toBeMoved; # KLUDGE ALERT! $CanvasPath move toBeMoved 0 $DeltaY; $CanvasPath dtag toBeMoved; # Resize rectangles from me back to root ::set Rect $node; ::while {1} { ::set RectCoords [$CanvasPath coords $Rect]; ::set RectX1 [::lindex $RectCoords 0]; ::set RectY1 [::lindex $RectCoords 1]; ::set RectX2 [::lindex $RectCoords 2]; ::set RectY2 [::expr [::lindex $RectCoords 3] + $DeltaY]; $CanvasPath coords $Rect $RectX1 $RectY1 $RectX2 $RectY2; if {$Rect!="root"} { ::set Rect [string range $Rect 0 [::expr [string last - $Rect]-1]]; } else { break; } } #DEBUG# ::if {$node=="root-1"} { ::set items [::llength [$CanvasPath find all]]; ::if {[::QW::GUI::WINEXPLO::_optionGet root-items]!=$items} { ::QW::GUI::WINEXPLO::_dumpItems $win; ::QW::GUI::WINEXPLO::_assert "Root contracted, canvas items= $items, should be [::QW::GUI::WINEXPLO::_optionGet root-items]."; } } ::QW::GUI::WINEXPLO::_signalRectangleChange $win; #DEBUG# #::QW::GUI::WINEXPLO::_traceOut; } ::proc _nodeContractAll {win node} { #puts "::_nodeContractAll($win,$node)" global hierInfo ::set var $hierInfo($win-data) upvar #0 $var data # ::foreach subnode $data($node-children) { ::if {[::llength $data($subnode-children)]} {::QW::GUI::WINEXPLO::_nodeContractAll $win $subnode;} } ::set data($node-expandedState) 0; #puts "::QW::GUI::WINEXPLO::_nodeContractAll(return)" } # # ------------------------------------------------------------------------------ # Recursively build hierarchical list representation of the parent tree # ------------------------------------------------------------------------------ # # SHOWMENUITEMS - new version of parentTreeCreate # Very weird. At the console, [.menuPath index end] returns 0 if .menupath has no items. # But, under s4.exe, [._gui_widget._gui_widget/menubranch._gui_widget_menu index end] returns "none". # "none" is some sort of magic index that isn't properly explained, so I don't know what's going on. # All I know is that we go into an infinite loop when we do this: # # for {set i 1} {$i <= [$child index end]} {incr i} { # puts "\tChild $i" # lappend children [$child index $i] # } # if {1} { ::proc parentTreeCreate {root} { #puts "(MENU)parentTreeCreate {$root} \{" set wlist "" foreach child [winfo children $root] { if {[::llength [winfo children $child]] } { set children [::QW::GUI::WINEXPLO::parentTreeCreate $child] } else { set children "" if {[winfo class $child]=="Menu"} { #puts "We hit a menu: $child" #puts "Menu index end: [$child index end]"; if {[$child index end]!=0&&[$child index end]!="none"} { for {set i 1} {$i <= [$child index end]} {incr i} { #puts "\tChild $i" lappend children $i # Use the "symbolic or numerical index" #lappend children [$child index $i] } } } } lappend wlist [::list $child $children] } #puts "\}\tparentTreeCreate {$root}" return $wlist } } else { proc parentTreeCreate {root} { puts "(OLD)parentTreeCreate {$root} \{" set wlist "" foreach child [winfo children $root] { if {[llength [winfo children $child]] } { set children [::QW::GUI::WINEXPLO::parentTreeCreate $child] } else { set children "" } lappend wlist [list $child $children] } puts "\}\tparentTreeCreate {$root}" return $wlist } } # ------------------------------------------------------------------------------ # Recursively build hierarchical list representation of the clipper tree if 0 { pathName find searchCommand ?arg arg ...? This command returns a list consisting of all the items that meet the constraints specified by searchCommand and args. SearchCommand and args have any of the forms accepted by the addtag command. The items are returned in stacking order, with the lowest item first. SearchSpec and args may take any of the following forms: all Selects all the items in the canvas. .c itemcget 3 -window } # ------------------------------------------------------------------------------ ::proc clipperTreeCreate {root} { set clippees "" if {[winfo class $root]=="Canvas"} { foreach canvasItem [$root find all] { lappend clippees [$root itemcget $canvasItem -window] } } else { foreach child [pack slaves $root] {lappend clippees $child} foreach child [place slaves $root] {lappend clippees $child} foreach child [grid slaves $root] {lappend clippees $child} } set wlist "" foreach child $clippees { set clippeesTemp "" if {[winfo class $child]=="Canvas"} { foreach canvasItem [$child find all] { lappend clippeesTemp [$child itemcget $canvasItem -window] } } else { if {[llength [pack slaves $child]] } {set clippeesTemp [pack slaves $child]} if {[llength [place slaves $child]] } {lappend clippeesTemp [place slaves $child]} if {[llength [grid slaves $child]] } {lappend clippeesTemp [grid slaves $child]} } if {[llength $clippeesTemp]} { set children [clipperTreeCreate $child] } else { set children "" } lappend wlist [list $child $children] } return $wlist } # ------------------------------------------------------------------------------ # Convert list to array # ------------------------------------------------------------------------------ ::proc hierlist_data {win info} { #puts "hierlist_data {win info} \{" global hierInfo # #puts "" #puts "Here comes the list:" #puts $info #puts "" # if {[info exists hierInfo($win-data)]} { set var $hierInfo($win-data) upvar #0 $var data unset data } else { set counter 0 while {1} { set var "hierData#[incr counter]" upvar #0 $var data if {![info exists data]} {break} } set hierInfo($win-data) $var } ::QW::GUI::WINEXPLO::hierlist_data_add $var root "" $info #puts "\}\thierlist_data {win info}" } ::proc hierlist_data_add {var node label info} { #puts "hierlist_data_add {var node label info} \{" upvar #0 $var data set data($node-label) $label set data($node-children) "" set num 0 foreach rec $info { set subnode "$node-[incr num]" lappend data($node-children) $subnode set sublabel [lindex $rec 0] set subinfo [lindex $rec 1] ::QW::GUI::WINEXPLO::hierlist_data_add $var $subnode $sublabel $subinfo } if {$num} { set data($node-expandedState) 0 } #puts "\}\thierlist_data_add {var node label info}" } # ------------------------------------------------------------------------------ # install some options in the widget options database # ------------------------------------------------------------------------------ #option add *Hierlist.activeColor gray widgetDefault option add *Hierlist.indent 15 widgetDefault #option add *Hierlist.hbox.background white widgetDefault option add *Hierlist.hbox.width 40 widgetDefault option add *Hierlist.hbox.height 10 widgetDefault option add *Hierlist.hbox.cursor "" widgetDefault #option add *Hierlist.obox.background white widgetDefault option add *Hierlist.obox.width 40 widgetDefault option add *Hierlist.obox.height 10 widgetDefault option add *Hierlist.obox.cursor "" widgetDefault # ------------------------------------------------------------------------------ # Create the browser # ------------------------------------------------------------------------------ ::proc hierlist_create {win} { #puts "hierlist_create {win} \{" catch [destroy $win] toplevel $win -class Hierlist wm geometry $win 800x400 bind $win "::QW::GUI::WINEXPLO::hierlist_destroy $win" # # the tree # frame $win.left scrollbar $win.left.hxscroll -command "$win.left.hbox xview" -orient horizontal scrollbar $win.left.hyscroll -command "$win.left.hbox yview" -orient vertical canvas $win.left.hbox -takefocus 0 \ -xscrollcommand "$win.left.hxscroll set" \ -yscrollcommand "$win.left.hyscroll set" \ -cursor arrow \ -background $::QW::GUI::WINEXPLO::leftBackground grid configure $win.left.hbox -row 0 -column 0 -sticky nesw grid configure $win.left.hxscroll -row 1 -column 0 -sticky news grid configure $win.left.hyscroll -row 0 -column 1 -sticky news grid rowconfigure $win.left 0 -weight 1 grid columnconfigure $win.left 0 -weight 1 # # the information display (text widget), and the vertical divider # frame $win.right scrollbar $win.right.oxscroll -command "$win.right.obox xview" -orient horizontal scrollbar $win.right.oyscroll -command "$win.right.obox yview" -orient vertical text $win.right.obox -wrap none -takefocus 0 \ -xscrollcommand "$win.right.oxscroll set" \ -yscrollcommand "$win.right.oyscroll set" \ -font $::QW::GUI::WINEXPLO::rightFont \ -cursor arrow \ -background $::QW::GUI::WINEXPLO::rightBackground \ -foreground $::QW::GUI::WINEXPLO::rightForeground frame $win.right.sizebar -cursor size_we -width 2 -background black grid configure $win.right.sizebar -row 0 -column 0 -sticky news grid configure $win.right.obox -row 0 -column 1 -sticky nesw grid configure $win.right.oxscroll -row 1 -column 1 -sticky news grid configure $win.right.oyscroll -row 0 -column 2 -sticky news grid rowconfigure $win.right 0 -weight 1 grid columnconfigure $win.right 1 -weight 1 # # place the tree and information display side by side, and set up for moving the divider left and right # place configure $win.left -relx 0.0 -rely 0.0 -relwidth 0.3 -relheight 1.0 place configure $win.right -relx 0.3 -rely 0.0 -relwidth 0.7 -relheight 1.0 bind $win.right.sizebar "::QW::GUI::WINEXPLO::hierlist_resize_start $win" bind $win.right.sizebar "::QW::GUI::WINEXPLO::hierlist_resize $win" # # Set tabs on tree window # set tabsize [option get $win indent Indent] set tabsize [winfo pixels $win $tabsize] set tabs "15" # # tree stops indenting (or breaks?) after 20 deep # for {set i 1} {$i < 20} {incr i} { lappend tabs [::expr $i*$tabsize+15] } # Set tabs on option window $win.right.obox configure -tabs [::expr [font measure [lindex [$win.right.obox configure -font] 4] "X"]*24] #puts "\}\thierlist_create {win}" return $win } # ------------------------------------------------------------------------------ # Destroy data associated with browser # ------------------------------------------------------------------------------ ::proc hierlist_destroy {win} { #::_traceIn; #puts "hierlist_destroy $win" global hierInfo if {[info exists hierInfo($win-data)]} { set var $hierInfo($win-data) upvar #0 $var data unset data unset hierInfo($win-data) ::QW::GUI::WINEXPLO::treeDestructor $win; } #::QW::GUI::WINEXPLO::_traceOut; } # ------------------------------------------------------------------------------ # ------------------------------------------------------------------------------ # move the vertical divider left and right # ------------------------------------------------------------------------------ ::proc hierlist_resize_start {win} { set ::QW::GUI::WINEXPLO::startx [winfo pointerx $win] } ::proc hierlist_resize {win} { set newx [winfo pointerx $win] set x [::expr $newx - $::QW::GUI::WINEXPLO::startx] if {abs($x) > 5} { ::array set PlaceInfo [place info $win.left]; set lpercent $PlaceInfo(-relwidth); set lwidth [winfo width $win.left] set pixelratio [::expr $lwidth / $lpercent] set change [::expr $x / $pixelratio] set lpercent [::expr $lpercent + $change] place configure $win.left -relwidth $lpercent place configure $win.right -relwidth [::expr 1-$lpercent] -relx $lpercent set ::QW::GUI::WINEXPLO::startx [winfo pointerx $win] update } } # ------------------------------------------------------------------------------ # fill out the right pane with the widget's info, geometry manager and geometry kids ### Bug: If total config and slaves > items in winfo list, display will probably fuck up. ### To fix, must count winfo items added, and append \n before extra items in right box. ### Fixed Mar 06,2000 RTH # ------------------------------------------------------------------------------ # SHOWMENUITEMS ::proc hierlist_display_options {win PathList class} { #puts "hierlist_display_options $win \"$PathList\" $class" global hierInfo # set Items1 0 set var $hierInfo($win-data) upvar #0 $var data # set child $data([::QW::GUI::WINEXPLO::_nodeFromPathList $win $PathList]-label); $win.right.obox delete 1.0 end if {$class!="MenuItem"} { $win.right.obox insert end "$child\n" $win.right.obox insert end "--------- tags ---------\n"; ::foreach Tag [bindtags $child] { $win.right.obox insert end "$Tag\n"; } $win.right.obox insert end "--------- winfo ---------\t\t---- configuration ----\n" foreach option {cells class colormapfull depth\ exists geometry height id ismapped manager name parent\ pointerx pointery pointerxy reqheight reqwidth rootx rooty\ screen screencells screendepth screenheight screenmmheight\ screenmmwidth screenvisual screenwidth server toplevel viewable\ visual visualid visualsavailable vrootheight vrootwidth vrootx\ vrooty width x y} { $win.right.obox insert end "$option\t [winfo $option $child]\n" } if {[winfo class $child]=="Toplevel"} { $win.right.obox insert end "----- wm -----\n" foreach option {aspect client colormapwindows command \ focusmodel frame geometry grid group iconbitmap \ iconmask iconname iconposition iconwindow maxsize minsize \ overrideredirect positionfrom protocol resizable sizefrom \ state title transient} { $win.right.obox insert end "$option\t [wm $option $child]\n" } } $win.right.obox insert end "\t" set i 6 set options [$child configure] foreach option $options { ::QW::GUI::WINEXPLO::hierlist_append_text $win.right.obox $i "\t [lindex $option 0]\t [lindex $option 4]" incr i } ::QW::GUI::WINEXPLO::hierlist_append_text $win.right.obox $i "\t--- Pack Slaves ---" incr i set slaves [pack slaves $child] foreach slave $slaves { ::QW::GUI::WINEXPLO::hierlist_append_text $win.right.obox $i "\t $slave" incr i } ::QW::GUI::WINEXPLO::hierlist_append_text $win.right.obox $i "\t--- Place Slaves ---" incr i set slaves [place slaves $child] foreach slave $slaves { ::QW::GUI::WINEXPLO::hierlist_append_text $win.right.obox $i "\t $slave" incr i } ::QW::GUI::WINEXPLO::hierlist_append_text $win.right.obox $i "\t--- Grid Slaves ---" incr i set slaves [grid slaves $child] foreach slave $slaves { ::QW::GUI::WINEXPLO::hierlist_append_text $win.right.obox $i "\t $slave" incr i } set manager [winfo manager $child] set info {} if {$manager=="pack"} {set info [pack info $child]} if {$manager=="place"} {set info [place info $child]} if {$manager=="grid"} {set info [grid info $child]} if {[llength $info]} { $win.right.obox insert $i.end "\t--- $manager info ---" incr i for {set j 0} {$j < [llength $info]} {incr j 2} { ::QW::GUI::WINEXPLO::hierlist_append_text $win.right.obox $i "\t[lindex $info $j]\t [lindex $info [::expr $j+1]]" incr i } } } else { #puts "PathList: \"$PathList\"" set parentMenu [::lindex $PathList end-1] #puts "parentMenu: \"$parentMenu\"" set child [lrange [split [::lindex $PathList end] .] end end] #puts "child: \"$child\"" set childItem [$parentMenu index $child] $win.right.obox insert end "Menu: $parentMenu Item: $child\n" $win.right.obox insert end "---- menu item configuration ----\n" foreach option [$parentMenu entryconfigure $childItem] { $win.right.obox insert end "[lindex $option 0]\t[lindex $option 4]\n" } } } ::proc hierlist_append_text {Win Line Text} { set WindowRows [lindex [split [$Win index end-1lines] .] 0] if {$WindowRows<$Line} {$Win insert end "\n\t"} $Win insert $Line.end $Text } # ------------------------------------------------------------------------------ # ------------------------------------------ # ------------------------------------------------------------------------------ if 0 { ::proc hierlist_display_clipperTree {win} { $win.left.hbox delete 1.0 end #::QW::GUI::WINEXPLO::hierlist_create $win #::QW::GUI::WINEXPLO::hierlist_data $win [clipperTreeCreate .] #::QW::GUI::WINEXPLO::hierlist_data $win "\{. \{[clipperTreeCreate "."]\}\}" # #::QW::GUI::WINEXPLO::hierlist_data $win "\{. \{[clipperTreeCreate ".winexplo"]\}\}" #::QW::GUI::WINEXPLO::hierlist_data $win "\{. \{[clipperTreeCreate "._nvwsScreen._desktop"]\}\}" ::QW::GUI::WINEXPLO::hierlist_data $win "\{. \{[clipperTreeCreate "._nvwsScreen._desktop"]\}\}" # #puts "+|+ The tree array is" #::foreach {name value} [::array get ::hierData#1] {puts "$name $value"} # $win.left.hbox mark set "root:start" 1.0 $win.left.hbox mark gravity "root:start" left ::QW::GUI::WINEXPLO::hierlist_insert $win "root" } } # ------------------------------------------------------------------------------ ::proc hierlist_display_clipperTree {win} { toplevel .fuckTk wm title .fuckTk "Enter the path of the root" entry .fuckTk.clipperRootEntry -textvariable ::QW::GUI::WINEXPLO::fuckTkClipperRoot pack .fuckTk.clipperRootEntry bind .fuckTk.clipperRootEntry "destroy .fuckTk;fuckTkDoIt $win" } ::proc fuckTkDoIt {win} { $win.left.hbox delete 1.0 end #::QW::GUI::WINEXPLO::hierlist_create $win #::QW::GUI::WINEXPLO::hierlist_data $win [clipperTreeCreate .] #::QW::GUI::WINEXPLO::hierlist_data $win "\{. \{[clipperTreeCreate "."]\}\}" # #::QW::GUI::WINEXPLO::hierlist_data $win "\{. \{[clipperTreeCreate ".winexplo"]\}\}" #::QW::GUI::WINEXPLO::hierlist_data $win "\{. \{[clipperTreeCreate "._nvwsScreen._desktop"]\}\}" ::QW::GUI::WINEXPLO::hierlist_data $win "\{. \{[clipperTreeCreate "$::QW::GUI::WINEXPLO::fuckTkClipperRoot"]\}\}" # #puts "+|+ The tree array is" #::foreach {name value} [::array get ::hierData#1] {puts "$name $value"} # $win.left.hbox mark set "root:start" 1.0 $win.left.hbox mark gravity "root:start" left ::QW::GUI::WINEXPLO::hierlist_insert $win "root" } # ------------------------------------------------------------ # include some cosmetics # ------------------------------------------------------------ # #source "d:/tk/fontpick.tcl" # #::proc menuLeftCreate {} { # menu .winexplo.menuLeft -font $leftFont -tearoff 0 # # menu .winexplo.menuLeft.file -font $leftFont -tearoff 0 # .winexplo.menuLeft add cascade -label "File" -menu .winexplo.menuLeft.file -underline 0 # #.winexplo.menuLeft.file add command -label "Clear" -underline 0 -command {wpListClear} # #.winexplo.menuLeft.file add command -label "Sort" -underline 0 -command {CRLF_sort} # .winexplo.menuLeft.file add separator # .winexplo.menuLeft.file add command -label "Exit" -underline 1 -command "destroy ." # # menu .winexplo.menuLeft.view -font $leftFont -tearoff 0 # .winexplo.menuLeft add cascade -label "View" -menu .winexplo.menuLeft.view -underline 0 # .winexplo.menuLeft.view add separator # .winexplo.menuLeft.view add command -label "Parent Tree" -underline 0 -command {hierlist_display_parentTree .winexplo} # .winexplo.menuLeft.view add command -label "Clipper Tree" -underline 0 -command {hierlist_display_clipperTree .winexplo} # # menu .winexplo.menuLeft.options -font $leftFont -tearoff 0 # .winexplo.menuLeft add cascade -label "Options" -menu .winexplo.menuLeft.options -underline 0 # .winexplo.menuLeft.options add command -label "Font..." -underline 0 -command {wpOptionsLeftFont} # # menu .winexplo.menuLeft.options.color -font $leftFont -tearoff 0 # .winexplo.menuLeft.options add cascade -label "Color" -underline 0 -menu .winexplo.menuLeft.options.color # .winexplo.menuLeft.options.color add command -label "Background..." -command {wpOptionsLeftColorBackground} # .winexplo.menuLeft.options.color add command -label "Foreground..." -command {wpOptionsLeftColorForeground} ##RTH - Console # .winexplo.menuLeft add command -label "Console" -underline 0 -command {display_console} #} ::proc menuLeftCreate {} { menu .winexplo.menuLeft -font $::QW::GUI::WINEXPLO::leftFont -tearoff 0 menu .winexplo.menuLeft.file -font $::QW::GUI::WINEXPLO::leftFont -tearoff 0 .winexplo.menuLeft add cascade -label "File" -menu .winexplo.menuLeft.file -underline 0 #.winexplo.menuLeft.file add command -label "Clear" -underline 0 -command {wpListClear} #.winexplo.menuLeft.file add command -label "Sort" -underline 0 -command {CRLF_sort} .winexplo.menuLeft.file add separator .winexplo.menuLeft.file add command -label "Exit" -underline 1 -command "destroy ." menu .winexplo.menuLeft.view -font $::QW::GUI::WINEXPLO::leftFont -tearoff 0 .winexplo.menuLeft add cascade -label "View" -menu .winexplo.menuLeft.view -underline 0 .winexplo.menuLeft.view add separator .winexplo.menuLeft.view add command -label "Parent Tree" -underline 0 -command {::QW::GUI::WINEXPLO::hierlist_display_parentTree .winexplo} .winexplo.menuLeft.view add command -label "Clipper Tree" -underline 0 -command {::QW::GUI::WINEXPLO::hierlist_display_clipperTree .winexplo} menu .winexplo.menuLeft.options -font $::QW::GUI::WINEXPLO::leftFont -tearoff 0 .winexplo.menuLeft add cascade -label "Options" -menu .winexplo.menuLeft.options -underline 0 .winexplo.menuLeft.options add command -label "Font..." -underline 0 -command {::QW::GUI::WINEXPLO::wpOptionsLeftFont} menu .winexplo.menuLeft.options.autobuttons -font $::QW::GUI::WINEXPLO::leftFont -tearoff 0 .winexplo.menuLeft.options add cascade -label "Auto Buttons" -underline 0 -menu .winexplo.menuLeft.options.autobuttons .winexplo.menuLeft.options.autobuttons add command -label "On" -underline 0 -command {::set ::QW::GUI::WINEXPLO::autoButtons 1} .winexplo.menuLeft.options.autobuttons add command -label "Off" -underline 1 -command {::set ::QW::GUI::WINEXPLO::autoButtons 0} menu .winexplo.menuLeft.options.color -font $::QW::GUI::WINEXPLO::leftFont -tearoff 0 .winexplo.menuLeft.options add cascade -label "Color" -underline 0 -menu .winexplo.menuLeft.options.color .winexplo.menuLeft.options.color add command -label "Background..." -command {::QW::GUI::WINEXPLO::wpOptionsLeftColorBackground} .winexplo.menuLeft.options.color add command -label "Foreground..." -command {::QW::GUI::WINEXPLO::wpOptionsLeftColorForeground} #RTH - Console .winexplo.menuLeft add command -label "Console" -underline 0 -command {::QW::GUI::WINEXPLO::display_console} } ::proc menuRightCreate {} { menu .winexplo.menuRight -font $::QW::GUI::WINEXPLO::rightFont -tearoff 0 menu .winexplo.menuRight.file -font $::QW::GUI::WINEXPLO::rightFont -tearoff 0 .winexplo.menuRight add cascade -label "File" -menu .winexplo.menuRight.file -underline 0 #.winexplo.menuRight.file add command -label "Clear" -underline 0 -command {::QW::GUI::WINEXPLO::wpListClear} #.winexplo.menuRight.file add command -label "Sort" -underline 0 -command {::QW::GUI::WINEXPLO::CRLF_sort} .winexplo.menuRight.file add separator .winexplo.menuRight.file add command -label "Exit" -underline 1 -command "destroy ." menu .winexplo.menuRight.options -font $::QW::GUI::WINEXPLO::rightFont -tearoff 0 .winexplo.menuRight add cascade -label "Options" -menu .winexplo.menuRight.options -underline 0 .winexplo.menuRight.options add command -label "Font..." -underline 0 -command {::QW::GUI::WINEXPLO::wpOptionsRightFont} menu .winexplo.menuRight.options.color -font $::QW::GUI::WINEXPLO::rightFont -tearoff 0 .winexplo.menuRight.options add cascade -label "Color" -underline 0 -menu .winexplo.menuRight.options.color .winexplo.menuRight.options.color add command -label "Background..." -command {::QW::GUI::WINEXPLO::wpOptionsRightColorBackground} .winexplo.menuRight.options.color add command -label "Foreground..." -command {::QW::GUI::WINEXPLO::wpOptionsRightColorForeground} } ::proc wpOptionsLeftFont {} { #//::QW::GUI::WINEXPLO::fontPicker left if {[catch [::QW::GUI::WINEXPLO::fontPicker "left"] errorMsg]} {bell; puts $errorMsg} } ::proc wpOptionsRightFont {} { #//::QW::GUI::WINEXPLO::fontPicker right if {[catch [::QW::GUI::WINEXPLO::fontPicker "right"] errorMsg]} {bell; puts $errorMsg} } ::proc fontChange {Widget} { if {$Widget == "left"} { destroy .winexplo.menuLeft set leftFont $::QW::GUI::WINEXPLO::textFont ::QW::GUI::WINEXPLO::menuLeftCreate .winexplo.left.hbox configure -font $::QW::GUI::WINEXPLO::leftFont } else { destroy .winexplo.menuRight set ::QW::GUI::WINEXPLO::rightFont $::QW::GUI::WINEXPLO::textFont ::QW::GUI::WINEXPLO::menuRightCreate .winexplo.right.obox configure -font $::QW::GUI::WINEXPLO::rightFont } } ::proc wpOptionsLeftColorBackground {} { set ::QW::GUI::WINEXPLO::leftBackground [tk_chooseColor] .winexplo.left.hbox configure -background $::QW::GUI::WINEXPLO::leftBackground } ::proc wpOptionsLeftColorForeground {} { #// canvas does not have a -foreground option #//set ::QW::GUI::WINEXPLO::leftForeground [tk_chooseColor] #//.winexplo.left.hbox configure -foreground $::QW::GUI::WINEXPLO::leftForeground } ::proc wpOptionsRightColorBackground {} { set ::QW::GUI::WINEXPLO::rightBackground [tk_chooseColor] .winexplo.right.obox configure -background $::QW::GUI::WINEXPLO::rightBackground } ::proc wpOptionsRightColorForeground {} { set ::QW::GUI::WINEXPLO::rightForeground [tk_chooseColor] .winexplo.right.obox configure -foreground $::QW::GUI::WINEXPLO::rightForeground } # ------------------------------------------------------------ # Console procedures # ------------------------------------------------------------ ::proc display_console {} { set i 0 while {1} { if {![winfo exists .console-$i]} { break } incr i } set win .console-$i toplevel $win catch [destroy $win] toplevel $win -class Hierlist # # Command frame(s) # frame $win.command frame $win.command.prompt frame $win.command.entry # label $win.command.prompt.label -text "Command" set entryWidget [entry $win.command.entry.command \ -xscrollcommand "$win.command.entry.xscroll set" \ -background $::QW::GUI::WINEXPLO::leftBackground \ -font $::QW::GUI::WINEXPLO::leftFont] # scrollbar $win.command.entry.xscroll -command "$win.command.entry.command xview" -orient horizontal pack $win.command.prompt.label -side top -padx 2 pack $win.command.prompt -side left pack $win.command.entry.command -fill x -side top -expand true pack $win.command.entry.xscroll -fill x -side top -expand true pack $win.command.entry -fill x -expand true pack $win.command -fill x # # Result display (text widget) # frame $win.result scrollbar $win.result.xscroll -command "$win.result.result xview" -orient horizontal scrollbar $win.result.yscroll -command "$win.result.result yview" -orient vertical set resultWidget [text $win.result.result -wrap none -takefocus 0 \ -xscrollcommand "$win.result.xscroll set" \ -yscrollcommand "$win.result.yscroll set" \ -font $::QW::GUI::WINEXPLO::rightFont \ -cursor arrow \ -background $::QW::GUI::WINEXPLO::rightBackground \ -foreground $::QW::GUI::WINEXPLO::rightForeground] # grid $resultWidget $win.result.yscroll -sticky news grid $win.result.xscroll -sticky ew grid rowconfigure $win.result 0 -weight 1 grid columnconfigure $win.result 0 -weight 1 pack $win.result -fill both -expand true # bind $win.command.entry.command "::QW::GUI::WINEXPLO::console_interp $entryWidget $resultWidget" bind $win.command.entry.command "::QW::GUI::WINEXPLO::console_getHistory $entryWidget 1" bind $win.command.entry.command "::QW::GUI::WINEXPLO::console_getHistory $entryWidget -1" # bind $win.command.entry.command "::QW::GUI::WINEXPLO::entryPaste $entryWidget" # bind $resultWidget "tk_textCut $resultWidget;break" bind $resultWidget "tk_textCopy $resultWidget;break" bind $resultWidget "tk_textPaste $resultWidget;break" # return $win } ::proc entryPaste {win} { catch {$win insert insert [selection get -displayof $win -selection CLIPBOARD]} if {[lindex [$win configure -state] 4] == "normal"} {focus $win} } ::proc console_getHistory {win increment} { set result "" if {[expr $::QW::GUI::WINEXPLO::commandListPointer+$increment]>[llength $::QW::GUI::WINEXPLO::commandList]||[expr $::QW::GUI::WINEXPLO::commandListPointer+$increment]<0} { return } incr ::QW::GUI::WINEXPLO::commandListPointer $increment set result [lindex $::QW::GUI::WINEXPLO::commandList [expr $::QW::GUI::WINEXPLO::commandListPointer -1]] $win delete 0 end $win insert 0 $result $win icursor end } ::proc console_getHistoryx {win increment} { set result "" if {$increment>0} { if {[expr $::QW::GUI::WINEXPLO::commandListPointer+$increment]<=[llength $::QW::GUI::WINEXPLO::commandList]} { incr ::QW::GUI::WINEXPLO::commandListPointer $increment set result [lindex $::QW::GUI::WINEXPLO::commandList [expr $::QW::GUI::WINEXPLO::commandListPointer -1]] } } else { if {[expr $::QW::GUI::WINEXPLO::commandListPointer+$increment]>=0} { incr ::QW::GUI::WINEXPLO::commandListPointer $increment set result [lindex $::QW::GUI::WINEXPLO::commandList [expr $::QW::GUI::WINEXPLO::commandListPointer -1]] } } if {$result!=""} { $win delete 0 end $win insert 0 $result $win icursor end } } ::proc console_interp {entryWidget resultWidget} { set command [$entryWidget get] if {$command!=""} { set ::QW::GUI::WINEXPLO::commandList [linsert $::QW::GUI::WINEXPLO::commandList 0 $command] $entryWidget delete 0 end $resultWidget configure -state normal $resultWidget insert end "% $command\n" if {[catch {set result [eval $command]} err_text]} { set result $err_text } $resultWidget insert end "$result\n" $resultWidget see end set ::QW::GUI::WINEXPLO::commandListPointer 0 } } # ------------------------------------------------------------------------------ # Run the window tree explorer # ------------------------------------------------------------------------------ ############################################################################################################### # This proc simulates the tree 'owner' who receives and dispatches signals to/from the tree. ::proc ownerProc {win args} { #puts "::ownerProc $win $args ([llength $args] args)" set Event [::lindex $args 0] switch -- $Event { buttonPress { set PathList [::lindex $args 1] set Component [::lindex $args 2] set Button [::lindex $args 3] set OtherInfo [::lindex $args 4] switch -- $Button { 1 { switch -- $Component { label { ::QW::GUI::WINEXPLO::treeConfigure $win -activepath $PathList; #::QW::GUI::WINEXPLO::hierlist_display_options $win [::lindex $PathList end] $OtherInfo; ::QW::GUI::WINEXPLO::hierlist_display_options $win $PathList $OtherInfo; } icon { ::QW::GUI::WINEXPLO::treeConfigure $win -activepath $PathList; #::QW::GUI::WINEXPLO::hierlist_display_options $win [::lindex $PathList end] $OtherInfo; ::QW::GUI::WINEXPLO::hierlist_display_options $win $PathList $OtherInfo; } expandButton {::QW::GUI::WINEXPLO::treeCommand $win expand $PathList} contractButton {::QW::GUI::WINEXPLO::treeCommand $win contract $PathList} default {::error "ERROR Owner buttonPress event, unknown component: \"$Component\""} } } 2 { } 3 { } default {::error "ERROR Owner buttonPress event, unknown button number: \"$Button\""} } } buttonRelease {;} doubleButtonPress { set PathList [::lindex $args 1] set Component [::lindex $args 2] set Button [::lindex $args 3] set OtherInfo [::lindex $args 4] switch -- $Button { 1 { switch -- $Component { label {;} icon {;} expandButton {::QW::GUI::WINEXPLO::treeCommand $win contractall $PathList} contractButton {::QW::GUI::WINEXPLO::treeCommand $win expandall $PathList} default {::error "ERROR Owner doubleButtonPress event, unknown component: \"$Component\""} } } 2 { } default {::error "ERROR Owner doubleButtonPress event, unknown button number: \"$Button\""} } } enter { set PathList [::lindex $args 1] set Component [::lindex $args 2] set EventX [::lindex $args 3] set EventY [::lindex $args 4] set OtherInfo [::lindex $args 5] switch -- $Component { label {;} icon {;} expandButton {::if {$::QW::GUI::WINEXPLO::autoButtons} {::QW::GUI::WINEXPLO::treeCommand $win expand $PathList;}} contractButton {::if {$::QW::GUI::WINEXPLO::autoButtons} {::QW::GUI::WINEXPLO::treeCommand $win contract $PathList;}} default {::error "ERROR Owner enter event, unknown component: \"$Component\""} } } leave { set PathList [::lindex $args 1] set EventX [::lindex $args 3] set EventY [::lindex $args 4] set OtherInfo [::lindex $args 5] } rectangle { set NewRectangle [::lindex $args 1] $win.left.hbox configure -scrollregion $NewRectangle } default {::error "ERROR Owner unknown event: \"$Event\""} } } ::proc winexplo {} { #puts "winexplo {}"; ::QW::GUI::WINEXPLO::hierlist_create .winexplo ::QW::GUI::WINEXPLO::hierlist_display_parentTree .winexplo ::QW::GUI::WINEXPLO::menuLeftCreate ::QW::GUI::WINEXPLO::menuRightCreate bind .winexplo.left.hbox { tk_popup .winexplo.menuLeft [expr %x + [winfo rootx .winexplo.left.hbox]] [expr %y + [winfo rooty .winexplo.left.hbox]] } bind .winexplo.right.obox { tk_popup .winexplo.menuRight [expr %x + [winfo rootx .winexplo.right.obox]] [expr %y + [winfo rooty .winexplo.right.obox]] } #puts "winexplo {} done"; } ::proc hierlist_display_parentTree {win} { #puts "hierlist_display_parentTree {win}" $win.left.hbox delete all ::QW::GUI::WINEXPLO::hierlist_data $win "\{. \{[parentTreeCreate "."]\}\}" # #puts "+|+ The tree array is" #::foreach {name value} [::array get ::hierData#1] {puts "$name $value"} # ::QW::GUI::WINEXPLO::treeInit $win; # ::QW::GUI::WINEXPLO::treeConfigure $win -signaltoownercommand ::QW::GUI::WINEXPLO::ownerProc ::QW::GUI::WINEXPLO::treeConfigure $win -canvaspath $win.left.hbox ::QW::GUI::WINEXPLO::treeConfigure $win -inactivefont {{MS Sans Serif} 8 roman normal} ::QW::GUI::WINEXPLO::treeConfigure $win -activefont {{MS Sans Serif} 8 roman bold} # if {$::useGifFIles} { ::QW::GUI::WINEXPLO::treeConfigure $win -plusimage "::plusBoxImage" ::QW::GUI::WINEXPLO::treeConfigure $win -minusimage "::minusBoxImage" ::QW::GUI::WINEXPLO::treeConfigure $win -nodeimage "::nodeImage" ::QW::GUI::WINEXPLO::treeConfigure $win -openimage "::openImage" ::QW::GUI::WINEXPLO::treeConfigure $win -closedimage "::closedImage" } else { ::QW::GUI::WINEXPLO::treeConfigure $win -plusimage "::plusBoxImage12x11" ::QW::GUI::WINEXPLO::treeConfigure $win -minusimage "::minusBoxImage12x11" ::QW::GUI::WINEXPLO::treeConfigure $win -nodeimage "::nodeImage16x16" ::QW::GUI::WINEXPLO::treeConfigure $win -openimage "::openImage16x16" ::QW::GUI::WINEXPLO::treeConfigure $win -closedimage "::closedImage16x16" } ::QW::GUI::WINEXPLO::treeShow $win; #puts "hierlist_display_parentTree {win} - done" } ::set ::tcl_precision 12; set ::useGifFIles 1 if {$::useGifFIles} { # plus box set Data "" append Data R0lGODdhDAALAPcAAAAAAIAAAACAAICAAAAAgIAAgACAgMDAwMDcwKbK8EAgAGAgAIAgAKAgAMAg append Data AOAgAABAACBAAEBAAGBAAIBAAKBAAMBAAOBAAABgACBgAEBgAGBgAIBgAKBgAMBgAOBgAACAACCA append Data AECAAGCAAICAAKCAAMCAAOCAAACgACCgAECgAGCgAICgAKCgAMCgAOCgAADAACDAAEDAAGDAAIDA append Data AKDAAMDAAODAAADgACDgAEDgAGDgAIDgAKDgAMDgAODgAAAAQCAAQEAAQGAAQIAAQKAAQMAAQOAA append Data QAAgQCAgQEAgQGAgQIAgQKAgQMAgQOAgQABAQCBAQEBAQGBAQIBAQKBAQMBAQOBAQABgQCBgQEBg append Data QGBgQIBgQKBgQMBgQOBgQACAQCCAQECAQGCAQICAQKCAQMCAQOCAQACgQCCgQECgQGCgQICgQKCg append Data QMCgQOCgQADAQCDAQEDAQGDAQIDAQKDAQMDAQODAQADgQCDgQEDgQGDgQIDgQKDgQMDgQODgQAAA append Data gCAAgEAAgGAAgIAAgKAAgMAAgOAAgAAggCAggEAggGAggIAggKAggMAggOAggABAgCBAgEBAgGBA append Data gIBAgKBAgMBAgOBAgABggCBggEBggGBggIBggKBggMBggOBggACAgCCAgECAgGCAgICAgKCAgMCA append Data gOCAgACggCCggECggGCggICggKCggMCggOCggADAgCDAgEDAgGDAgIDAgKDAgMDAgODAgADggCDg append Data gEDggGDggIDggKDggMDggODggAAAwCAAwEAAwGAAwIAAwKAAwMAAwOAAwAAgwCAgwEAgwGAgwIAg append Data wKAgwMAgwOAgwABAwCBAwEBAwGBAwIBAwKBAwMBAwOBAwABgwCBgwEBgwGBgwIBgwKBgwMBgwOBg append Data wACAwCCAwECAwGCAwICAwKCAwMCAwOCAwACgwCCgwECgwGCgwICgwKCgwMCgwOCgwADAwCDAwEDA append Data wGDAwIDAwKDAwP/78KCgpICAgP8AAAD/AP//AAAA//8A/wD//////yH5BAAAAAAALAAAAAAMAAsA append Data AAgsAAEIHEgQwD+D/xIqTGgQIcOFDSFKdHhw4sGCESlqrKhw48aOHBeCxFjwX0AAOw== image create photo ::plusBoxImage -data $Data # # minus box set Data "" append Data R0lGODdhDAALAPcAAAAAAIAAAACAAICAAAAAgIAAgACAgMDAwMDcwKbK8EAgAGAgAIAgAKAgAMAg append Data AOAgAABAACBAAEBAAGBAAIBAAKBAAMBAAOBAAABgACBgAEBgAGBgAIBgAKBgAMBgAOBgAACAACCA append Data AECAAGCAAICAAKCAAMCAAOCAAACgACCgAECgAGCgAICgAKCgAMCgAOCgAADAACDAAEDAAGDAAIDA append Data AKDAAMDAAODAAADgACDgAEDgAGDgAIDgAKDgAMDgAODgAAAAQCAAQEAAQGAAQIAAQKAAQMAAQOAA append Data QAAgQCAgQEAgQGAgQIAgQKAgQMAgQOAgQABAQCBAQEBAQGBAQIBAQKBAQMBAQOBAQABgQCBgQEBg append Data QGBgQIBgQKBgQMBgQOBgQACAQCCAQECAQGCAQICAQKCAQMCAQOCAQACgQCCgQECgQGCgQICgQKCg append Data QMCgQOCgQADAQCDAQEDAQGDAQIDAQKDAQMDAQODAQADgQCDgQEDgQGDgQIDgQKDgQMDgQODgQAAA append Data gCAAgEAAgGAAgIAAgKAAgMAAgOAAgAAggCAggEAggGAggIAggKAggMAggOAggABAgCBAgEBAgGBA append Data gIBAgKBAgMBAgOBAgABggCBggEBggGBggIBggKBggMBggOBggACAgCCAgECAgGCAgICAgKCAgMCA append Data gOCAgACggCCggECggGCggICggKCggMCggOCggADAgCDAgEDAgGDAgIDAgKDAgMDAgODAgADggCDg append Data gEDggGDggIDggKDggMDggODggAAAwCAAwEAAwGAAwIAAwKAAwMAAwOAAwAAgwCAgwEAgwGAgwIAg append Data wKAgwMAgwOAgwABAwCBAwEBAwGBAwIBAwKBAwMBAwOBAwABgwCBgwEBgwGBgwIBgwKBgwMBgwOBg append Data wACAwCCAwECAwGCAwICAwKCAwMCAwOCAwACgwCCgwECgwGCgwICgwKCgwMCgwOCgwADAwCDAwEDA append Data wGDAwIDAwKDAwP/78KCgpICAgP8AAAD/AP//AAAA//8A/wD//////yH5BAAAAAAALAAAAAAMAAsA append Data AAgsAAEIHEgQwD+D/xIqTGgQ4UKFDR8ujCiR4cGDBSM6lEixYkeOFytezFjwX0AAOw== image create photo ::minusBoxImage -data $Data # # closed folder set Data "" append Data R0lGODdhFAAQAMIAAP///wAAAP/7cYKCgrq2VQAAAAAAAAAAACwAAAAAFAAQAAADQQi63P7whTlj append Data C9cqDIQXACVm3+cEA4OVrEegateWb7qs81fHuQ7fst4O2HP9NgCCcslUHkOiaNS2GFivWKxmC0gA append Data ADs= image create photo ::closedImage -data $Data # # open folder set Data "" append Data R0lGODdhFAAQAMIAAP///wAAAP/7cbq2VYKCggAAAAAAAAAAACwAAAAAFAAQAAADQgi63P7whTlj append Data CyLnYBUWQxhS5AWKKBoQDDaScAm4w6fdGjeDNn6vHp7PB9z1hoKiEfljeY5D5SxGlQII2KxW2+kC append Data EgA7 image create photo ::openImage -data $Data # # document set Data "" append Data R0lGODdhFAAQAPcAAP///wAAALq2VYKCgtvb2wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA append Data AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA append Data AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA append Data AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA append Data AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA append Data AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA append Data AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA append Data AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA append Data AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA append Data AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA append Data AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA append Data AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA append Data AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA append Data AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAAAAAAALAAAAAAUABAA append Data AAhWAAEIHEiwoEGBARIqDHDQIEOCCRtCBDCgIgCGDyVmRMhRI0WLCzcWFAlxQEOGFVOCNHmQ5MAA append Data LB1+VGkS5kmNMUfOVHkx58STPl/iPBkyZNCBNJMWDAgAOw== image create photo ::nodeImage -data $Data # unset Data } else { image create bitmap ::minusBoxImage12x11 -data \ "#define _width 12 #define _height 11 static unsigned char bits[] = { 0xff, 0x07, 0x01, 0x04, 0x01, 0x04, 0x01, 0x04, 0x01, 0x04, 0xfd, 0x05, 0x01, 0x04, 0x01, 0x04, 0x01, 0x04, 0x01, 0x04, 0xff, 0x07};" \ -background white \ -foreground black image create bitmap ::plusBoxImage12x11 -data \ "#define _width 12 #define _height 11 static unsigned char bits[] = { 0xff, 0x07, 0x01, 0x04, 0x21, 0x04, 0x21, 0x04, 0x21, 0x04, 0xfd, 0x05, 0x21, 0x04, 0x21, 0x04, 0x21, 0x04, 0x01, 0x04, 0xff, 0x07,};" \ -background white \ -foreground black image create bitmap ::nodeImage16x16 -data \ "#define _width 16 #define _height 16 static char _bits[] = { 0x00, 0x00, 0x00, 0x00, 0xe0, 0x7f, 0x50, 0x40, 0x48, 0x40, 0x44, 0x40, 0x42, 0x40, 0x7e, 0x40, 0x02, 0x40, 0x02, 0x40, 0x02, 0x40, 0x02, 0x40, 0xfe, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};" -background white -foreground black image create bitmap ::openImage16x16 -data \ "#define _width 16 #define _height 16 static char _bits[] = { 0x00, 0x00, 0x00, 0x00, 0x3c, 0x00, 0x42, 0x00, 0x81, 0x3f, 0x01, 0x20, 0xf9, 0xff, 0x0d, 0xc0, 0x07, 0x40, 0x03, 0x60, 0x01, 0x20, 0x01, 0x30, 0xff, 0x1f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};" -background white -foreground black image create bitmap ::closedImage16x16 -data \ "#define _width 16 #define _height 16 static char _bits[] = { 0x00, 0x00, 0x00, 0x00, 0x78, 0x00, 0x84, 0x00, 0xfe, 0x7f, 0x02, 0x40, 0x02, 0x40, 0x02, 0x40, 0x02, 0x40, 0x02, 0x40, 0x02, 0x40, 0x02, 0x40, 0xfe, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};" -background white -foreground black } set ::QW::GUI::WINEXPLO::leftFont [font create -family "Arial" -size 12 -weight normal] set ::QW::GUI::WINEXPLO::rightFont [font create -family "Arial" -size 10 -weight normal] set ::QW::GUI::WINEXPLO::textFont [font create -family "Arial" -size 12 -weight normal] set ::QW::GUI::WINEXPLO::leftBackground "white" set ::QW::GUI::WINEXPLO::rightBackground "white" set ::QW::GUI::WINEXPLO::leftForeground "black" set ::QW::GUI::WINEXPLO::rightForeground "black" set ::QW::GUI::WINEXPLO::autoButtons 0 set ::QW::GUI::WINEXPLO::commandList {} set ::QW::GUI::WINEXPLO::commandListPointer 0 #//puts "winexplo loaded" #puts "Run the procedure winexplo (no arguments) to boot the window tree explorer" }