############################################################ # Procedures to manage stack geometry and to # # TKGGrid -- # Place an item (pathname) into the stack currently being constructed. # Stack (with grid) it onto the appropriate side, and configure it to # "expand" in the dimension of the stack's orientation unless we are # in (the top stack of) a screen-edge panel and "expand" is not an arg. proc TKGGrid {pathname args} { global TKG TKG_stackside upvar \#0 $TKG(currentpanel)-pparams(screenedge) edge set inscreenedge \ [expr ![string match $edge no] && \ [regexp {^\.[^.]*$} $TKG(stackprefix)]] if [In -nosep $args] { set sep 0 } else { set sep $TKG(sep) } set w $TKG(stackprefix) if {"$TKG_stackside(current)" == "top"} { set r [llength [grid slaves $w -column 0]] set slaves [grid slaves $w -column 0] grid $pathname -sticky nsew -in $w \ -column 0 -row $r \ -padx $sep -pady $sep if {!$inscreenedge || [In expand $args]} { grid rowconfigure $w $r -weight 1 } else { grid rowconfigure $w $r -weight 0 } } else { set c [llength [grid slaves $w -row 0]] set slaves [grid slaves $w -row 0] grid $pathname -sticky nsew -in $w \ -row 0 -column $c\ -padx $sep -pady $sep if {!$inscreenedge || [In expand $args]} { grid columnconfigure $w $c -weight 1 } else { grid columnconfigure $w $c -weight 0 } } } proc TKGRowCol {w} { grid rowconfigure $w 0 -weight 1 grid columnconfigure $w 0 -weight 1 } set TKG(switches,StartStack) { {orientation ""} {borderwidth ""} {color ""} {startpanel 0} {iconside ""} {title ""} {screenedge no} } proc StartStack args { global TKG TKG_stackside TKG_iconSide upvar \#0 stack$TKG(stackindex)-sparams Parent incr TKG(stackindex) set paramsvar stack$TKG(stackindex)-sparams upvar \#0 $paramsvar Stack set switches $TKG(switches,StartStack) TKGSetSwitchDefaults $paramsvar $switches TKGParseArgs $paramsvar $args $switches "" StartStack foreach v {borderwidth color iconside title} { if [Empty $Stack($v)] {set Stack($v) $Parent($v)} } if ![info exists Stack(orientation)] { if [string match $Parent(orientation) horizontal] { set Stack(orientation) vertical } else {set Stack(orientation) horizontal} } lappend TKG(pedigree) $TKG(stackindex) if $Stack(startpanel) { set TKG(stackprefix) .[string tolower $TKG(currentpanel)] if ![winfo exists $TKG(stackprefix)] { tkgtoplevel $TKG(stackprefix) -class Tkgoodstuff -relief raised\ -borderwidth $Stack(borderwidth) -background $Stack(color) \ -tile $TKG(paneltileimage) } wm withdraw $TKG(stackprefix) wm title $TKG(stackprefix) $Stack(title) } else { set TKG(stackprefix) $TKG(stackprefix).stack$TKG(stackindex) tkgframe $TKG(stackprefix) -relief ridge -borderwidth $Stack(borderwidth) \ -background $Stack(color) -tile $TKG(paneltileimage) } if { $Stack(orientation) == "vertical" } { set TKG_stackside($TKG(stackindex)) top grid columnconfigure $TKG(stackprefix) 0 -weight 1 } else { set TKG_stackside($TKG(stackindex)) left grid rowconfigure $TKG(stackprefix) 0 -weight 1 } set TKG_stackside(current) $TKG_stackside($TKG(stackindex)) set TKG_iconSide($TKG(stackindex)) $Stack(iconside) set TKG_iconSide(current) $Stack(iconside) } set TKG(switches,TKGStartPanel) { {borderwidth ""} {color ""} {title ""} {orientation ""} {iconside ""} {screenedge "no"} } proc TKGStartPanel {name args} { global TKG TKG_panels TKG_prevpanel upvar \#0 $name-pparams P upvar \#0 $TKG(currentpanel)-pparams Prev set switches $TKG(switches,TKGStartPanel) TKGSetSwitchDefaults $name-pparams $switches TKGParseArgs $name-pparams $args $switches {} TKGStartPanel set TKG_prevpanel($name) $TKG(currentpanel) set TKG(currentpanel) $name set TKG_panels(.[string tolower $name]) 1 if ![string match $P(screenedge) no] { if [In $P(screenedge) {left right}] { set P(orientation) vertical } else { set P(orientation) horizontal } } if {$P(orientation) == "horizontal"} { if [Empty $P(iconside)] { set P(iconside) left } } else { if [Empty $P(iconside)] { set P(iconside) top } } foreach v { orientation borderwidth color iconside title screenedge} { if [Empty $P($v)] {set P($v) $Prev($v)} lappend outargs -$v $P($v) } eval [concat StartStack -startpanel 1 $outargs] } proc TKGEndPanel {} { global TKG TKG_prevpanel set TKG(currentpanel) $TKG_prevpanel($TKG(currentpanel)) FinishStack 1 } proc TKGPanelDismiss {panel} { set w .[string tolower $panel] wm withdraw $w TKGDoHook TKGPanelDismiss_$w global TKGPanelDismiss_$w TKG_postedpanels TKGResetHook TKGPanelDismiss_$w catch {unset TKG_postedpanels($w)} } proc TKGPanelButtonInvoke {butname panelname} { global TKG TKG_postedpanels TKG_prevpanel set w .[string tolower $panelname] # if already posted, unpost if [info exists TKG_postedpanels($w)] { TKGPanelDismiss $panelname return } upvar \#0 $butname-params P set butpath $P(pathname) set panelw [winfo toplevel $butpath] set hook TKGPanelPost_$panelw TKGDoHook $hook TKGResetHook $hook TKGAddToHook $hook "TKGPanelDismiss $panelname" TKGAddToHook TKGPanelDismiss_$w "TKGResetHook $hook" if ![string match $panelw .main-panel] { TKGAddToHook TKGPanelDismiss_$panelw "TKGPanelDismiss $panelname" } regexp {([0-9]*)x([0-9]*)\+*(-*[0-9]*)\+*(-*[0-9]*)}\ [wm geometry $panelw] ww ww wh wx wy set vw [winfo vrootwidth .] set vh [winfo vrootheight .] set bx [winfo rootx $butpath] set by [winfo rooty $butpath] set rh [winfo reqheight $w] set rw [winfo reqwidth $w] upvar \#0 [string trimleft $panelw .]-pparams(orientation) O switch $O { vertical { if [string match -* $wx] { set x [expr -([string trimleft $wx -] + $ww)] } else { set x +[expr $wx + $ww] } set y +$by if {($y + $rh) > $vh} { set y +[expr $vh - $rh] } } horizontal { if [string match -* $wy] { set y [expr -([string trimleft $wy -] + $wh)] } else { set y +[expr $wy + $wh] } set x +$bx if {($x + $rw) > $vw} { set x +[expr $vw - $rw] } } } wm geometry $w $x$y wm deiconify $w raise .main-panel set TKG_postedpanels($w) 1 } proc TKGPanelPlace {name args} { global PutPanel$name upvar \#0 \ [string tolower [join $name ~]]-panel-pparams(screenedge) \ edge set w .[string tolower $name]-panel if [string match $edge no] { set geometry [set PutPanel${name}(geometry)] if ![Empty $geometry] { if [catch {wm geometry $w $geometry} err] { TKGError $err } } } else { switch $edge { left { wm minsize $w 0 [winfo vrootheight .] wm geometry $w +0+0 } right { wm minsize $w 0 [winfo vrootheight .] wm geometry $w -0+0 } top { wm minsize $w [winfo vrootwidth .] 0 wm geometry $w +0+0 } bottom { wm minsize $w [winfo vrootwidth .] 0 wm geometry $w +0-0 } } } bind $w "TKGPanelExpose $name" wm deiconify $w } proc TKGPanelExpose {name} { set lpanelname [string tolower $name]-panel set w .$lpanelname bind $w "" TKGDoHook TKG_postedhook-$lpanelname } proc FinishStack {{endpanel 0}} { global TKG TKG_stackside TKG_iconSide set childstack $TKG(stackprefix) set TKG(pedigree) [lreplace $TKG(pedigree) end end] set parentindex [lindex $TKG(pedigree) end ] set TKG(stackprefix) \ [join [lreplace [split $TKG(stackprefix) .] end end] .] if [Empty $TKG(stackprefix)] { #back to another panel set TKG(stackprefix) .[string tolower $TKG(currentpanel)] } set TKG_stackside(current) $TKG_stackside($parentindex) set TKG_iconSide(current) $TKG_iconSide($parentindex) if !$endpanel {TKGGrid $childstack -nosep; lower $childstack} } proc DoFill {} { global TKG set w .[string tolower $TKG(currentpanel)] set i 0 while {[winfo exists $w.fill$i]} {incr i} set pathname $w.fill$i tkgframe $pathname -cursor top_left_arrow -tile $TKG(paneltileimage) TKGGrid $pathname expand }