home *** CD-ROM | disk | FTP | other *** search
/ Freelog Special Freeware 31 / FreelogHS31.iso / Texte / scribus / scribus-1.3.3.9-win32-install.exe / tcl / tix8.1 / VStack.tcl < prev    next >
Text File  |  2001-11-03  |  10KB  |  432 lines
  1. # -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
  2. #
  3. #    $Id: VStack.tcl,v 1.2.2.1 2001/11/03 07:26:10 idiscovery Exp $
  4. #
  5. # VStack.tcl --
  6. #
  7. #    Virtual base class, do not instantiate!  This is the core
  8. #    class for all NoteBook style widgets. Stack maintains a list
  9. #    of windows. It provides methods to create, delete windows as
  10. #    well as stepping through them.
  11. #
  12. # Copyright (c) 1993-1999 Ioi Kim Lam.
  13. # Copyright (c) 2000-2001 Tix Project Group.
  14. #
  15. # See the file "license.terms" for information on usage and redistribution
  16. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  17. #
  18. #
  19.  
  20.  
  21. tixWidgetClass tixVStack {
  22.     -virtual true
  23.     -classname TixVStack
  24.     -superclass tixPrimitive
  25.     -method {
  26.     add delete pageconfigure pagecget pages raise raised
  27.     }
  28.     -flag {
  29.     -dynamicgeometry -ipadx -ipady
  30.     }
  31.     -configspec {
  32.     {-dynamicgeometry dynamicGeometry DynamicGeometry 0 tixVerifyBoolean}
  33.     {-ipadx ipadX Pad 0}
  34.     {-ipady ipadY Pad 0}
  35.     }
  36. }
  37.  
  38. proc tixVStack:InitWidgetRec {w} {
  39.     upvar #0 $w data
  40.  
  41.     tixChainMethod $w InitWidgetRec
  42.  
  43.     set data(pad-x1) 0
  44.     set data(pad-x2) 0
  45.     set data(pad-y1) 0
  46.     set data(pad-y2) 0
  47.  
  48.     set data(windows)  ""
  49.     set data(nWindows) 0
  50.     set data(topchild) ""
  51.  
  52.     set data(minW)   1
  53.     set data(minH)   1
  54.  
  55.     set data(w:top)  $w
  56.     set data(counter) 0
  57.     set data(repack) 0
  58. }
  59.  
  60. proc tixVStack:SetBindings {w} {
  61.     upvar #0 $w data
  62.  
  63.     tixChainMethod $w SetBindings
  64.     tixCallMethod $w InitGeometryManager
  65. }
  66.  
  67. #----------------------------------------------------------------------
  68. # Public methods
  69. #----------------------------------------------------------------------
  70. proc tixVStack:add {w child args} {
  71.     upvar #0 $w data
  72.  
  73.     set validOptions {-createcmd -raisecmd}
  74.  
  75.     set opt(-createcmd)  ""
  76.     set opt(-raisecmd)   ""
  77.  
  78.     tixHandleOptions -nounknown opt $validOptions $args
  79.  
  80.     set data($child,raisecmd)  $opt(-raisecmd)
  81.     set data($child,createcmd) $opt(-createcmd)
  82.  
  83.     set data(w:$child) [tixCallMethod $w CreateChildFrame $child]
  84.  
  85.     lappend data(windows) $child
  86.     incr data(nWindows) 1
  87.  
  88.     return $data(w:$child) 
  89. }
  90.  
  91. proc tixVStack:delete {w child} {
  92.     upvar #0 $w data
  93.  
  94.     if {[info exists data($child,createcmd)]} {
  95.     if {[winfo exists $data(w:$child)]} {
  96.         bind $data(w:$child) <Destroy> {;}
  97.         destroy $data(w:$child)
  98.     }
  99.     catch {unset data($child,createcmd)}
  100.     catch {unset data($child,raisecmd)}
  101.     catch {unset data(w:$child)}
  102.  
  103.     set index [lsearch $data(windows) $child]
  104.     if {$index >= 0} {
  105.         set data(windows) [lreplace $data(windows) $index $index]
  106.         incr data(nWindows) -1
  107.     }
  108.  
  109.     if {![string comp $data(topchild) $child]} {
  110.         set data(topchild) ""
  111.         foreach page $data(windows) {
  112.         if {[string comp $page $child]} {
  113.             $w raise $page
  114.             set data(topchild) $page
  115.             break
  116.         }
  117.         }
  118.     }
  119.     } else {
  120.     error "page $child does not exist"
  121.     }
  122. }
  123.  
  124. proc tixVStack:pagecget {w child option} {
  125.     upvar #0 $w data
  126.  
  127.     if {![info exists data($child,createcmd)]} {
  128.     error "page \"$child\" does not exist in $w"
  129.     }
  130.  
  131.     case $option {
  132.     -createcmd {
  133.         return "$data($child,createcmd)"
  134.     }
  135.     -raisecmd {
  136.         return "$data($child,raisecmd)"
  137.     }
  138.     default {
  139.         if {$data(w:top) != $w} {
  140.         return [$data(w:top) pagecget $child $option]
  141.         } else {
  142.         error "unknown option \"$option\""
  143.         }
  144.     }
  145.     }
  146. }
  147.  
  148. proc tixVStack:pageconfigure {w child args} {
  149.     upvar #0 $w data
  150.  
  151.     if {![info exists data($child,createcmd)]} {
  152.     error "page \"$child\" does not exist in $w"
  153.     }
  154.  
  155.     set len [llength $args]
  156.  
  157.     if {$len == 0} {
  158.     set value [$data(w:top) pageconfigure $child]
  159.     lappend value [list -createcmd "" "" "" $data($child,createcmd)]
  160.     lappend value [list -raisecmd "" "" "" $data($child,raisecmd)]
  161.     return $value
  162.     }
  163.  
  164.     if {$len == 1} {
  165.     case [lindex $args 0] {
  166.         -createcmd {
  167.         return [list -createcmd "" "" "" $data($child,createcmd)]
  168.         }
  169.         -raisecmd {
  170.         return [list -raisecmd "" "" "" $data($child,raisecmd)]
  171.         }
  172.         default {
  173.         return [$data(w:top) pageconfigure $child [lindex $args 0]]
  174.         }
  175.     }
  176.     }
  177.  
  178.     # By default handle each of the options
  179.     #
  180.     set opt(-createcmd)  $data($child,createcmd)
  181.     set opt(-raisecmd)   $data($child,raisecmd)
  182.  
  183.     tixHandleOptions -nounknown opt {-createcmd -raisecmd} $args
  184.  
  185.     #
  186.     # the widget options
  187.     set new_args ""
  188.     tixForEach {flag value} $args {
  189.     if {$flag != "-createcmd" && $flag != "-raisecmd"} {
  190.         lappend new_args $flag
  191.         lappend new_args $value
  192.     }
  193.     }
  194.  
  195.     if {[llength $new_args] >= 2} {
  196.     eval $data(w:top) pageconfig $child $new_args
  197.     }
  198.  
  199.     #
  200.     # The add-on options
  201.     set data($child,raisecmd)  $opt(-raisecmd)
  202.     set data($child,createcmd) $opt(-createcmd)
  203.  
  204.     return ""
  205. }
  206.  
  207. proc tixVStack:pages {w} {
  208.     upvar #0 $w data
  209.  
  210.     return $data(windows)
  211. }
  212.  
  213. proc tixVStack:raise {w child} {
  214.     upvar #0 $w data
  215.  
  216.     if {![info exists data($child,createcmd)]} {
  217.     error "page $child does not exist"
  218.     }
  219.  
  220.     if {[info exists data($child,createcmd)] && $data($child,createcmd) !=""} {
  221.     uplevel #0 $data($child,createcmd)
  222.     set data($child,createcmd) ""
  223.     }
  224.  
  225.     tixCallMethod $w RaiseChildFrame $child
  226.  
  227.     set oldTopChild $data(topchild)
  228.     set data(topchild) $child
  229.  
  230.     if {[string comp $oldTopChild $child]} {
  231.     if {[string comp $child,raisecmd ""]} {
  232.          uplevel #0 $data($child,raisecmd)
  233.     }
  234.     }
  235. }
  236.  
  237. proc tixVStack:raised {w} {
  238.     upvar #0 $w data
  239.  
  240.     return $data(topchild)
  241. }
  242.  
  243. #----------------------------------------------------------------------
  244. # Virtual Methods
  245. #----------------------------------------------------------------------
  246. proc tixVStack:InitGeometryManager {w} {
  247.     upvar #0 $w data
  248.  
  249.     bind $w <Configure> "tixVStack:MasterGeomProc $w"
  250.     bind $data(w:top) <Destroy> "+tixVStack:DestroyTop $w"
  251.  
  252.     if {$data(repack) == 0} {
  253.     set data(repack) 1
  254.     tixWidgetDoWhenIdle tixCallMethod $w Resize
  255.     }
  256. }
  257.  
  258. proc tixVStack:CreateChildFrame {w child} {
  259.     upvar #0 $w data
  260.  
  261.     set f [frame $data(w:top).$child]
  262.  
  263.     tixManageGeometry $f "tixVStack:ClientGeomProc $w"
  264.     bind $f <Configure> "tixVStack:ClientGeomProc $w -configure $f"
  265.     bind $f <Destroy>   "$w delete $child"
  266.  
  267.     return $f
  268. }
  269.  
  270. proc tixVStack:RaiseChildFrame {w child} {
  271.     upvar #0 $w data
  272.  
  273.     # Hide the original visible window
  274.     if {[string comp $data(topchild) ""] &&
  275.     [string comp $data(topchild) $child]} {
  276.     tixUnmapWindow $data(w:$data(topchild))
  277.     }
  278.  
  279.     set myW [winfo width  $w]
  280.     set myH [winfo height $w]
  281.  
  282.     set cW [expr $myW - $data(pad-x1) - $data(pad-x2) - 2*$data(-ipadx)]
  283.     set cH [expr $myH - $data(pad-y1) - $data(pad-y2) - 2*$data(-ipady)]
  284.     set cX [expr $data(pad-x1) + $data(-ipadx)]
  285.     set cY [expr $data(pad-y1) + $data(-ipady)]
  286.  
  287.     if {$cW > 0 && $cH > 0} {
  288.     tixMoveResizeWindow $data(w:$child) $cX $cY $cW $cH
  289.     tixMapWindow $data(w:$child)
  290.     raise $data(w:$child)
  291.     }
  292. }
  293.  
  294.  
  295.  
  296. #----------------------------------------------------------------------
  297. #
  298. #        G E O M E T R Y   M A N A G E M E N T
  299. #
  300. #----------------------------------------------------------------------
  301. proc tixVStack:DestroyTop {w} {
  302.     catch {
  303.     destroy $w
  304.     }
  305. }
  306.  
  307. proc tixVStack:MasterGeomProc {w args} {
  308.     if {![winfo exists $w]} {
  309.     return
  310.     }
  311.  
  312.     upvar #0 $w data
  313.  
  314.     if {$data(repack) == 0} {
  315.     set data(repack) 1
  316.     tixWidgetDoWhenIdle tixCallMethod $w Resize
  317.     }
  318. }
  319.  
  320. proc tixVStack:ClientGeomProc {w flag client} {
  321.     if {![winfo exists $w]} {
  322.     return
  323.     }
  324.     upvar #0 $w data
  325.  
  326.     if {$data(repack) == 0} {
  327.     set data(repack) 1
  328.     tixWidgetDoWhenIdle tixCallMethod $w Resize
  329.     }
  330.  
  331.     if {$flag == "-lostslave"} {
  332.     error "Geometry Management Error: \
  333. Another geometry manager has taken control of $client.\
  334. This error is usually caused because a widget has been created\
  335. in the wrong frame: it should have been created inside $client instead\
  336. of $w"
  337.     }
  338. }
  339.  
  340. proc tixVStack:Resize {w} {
  341.     if {![winfo exists $w]} {
  342.     return
  343.     }
  344.  
  345.     upvar #0 $w data
  346.  
  347.     if {$data(nWindows) == 0} {
  348.     set data(repack) 0
  349.     return
  350.     }
  351.  
  352.     if {$data(-width) == 0 || $data(-height) == 0} {
  353.     if {!$data(-dynamicgeometry)} {
  354.         # Calculate my required width and height
  355.         #
  356.         set maxW 1
  357.         set maxH 1
  358.  
  359.         foreach child $data(windows) {
  360.         set cW [winfo reqwidth  $data(w:$child)]
  361.         set cH [winfo reqheight $data(w:$child)]
  362.  
  363.         if {$maxW < $cW} {
  364.             set maxW $cW
  365.         }
  366.         if {$maxH < $cH} {
  367.             set maxH $cH
  368.         }
  369.         }
  370.         set reqW $maxW
  371.         set reqH $maxH
  372.     } else {
  373.         if {[string comp $data(topchild) ""]} {
  374.         set reqW [winfo reqwidth  $data(w:$data(topchild))]
  375.         set reqH [winfo reqheight $data(w:$data(topchild))]
  376.         } else {
  377.         set reqW 1
  378.         set reqH 1
  379.         }
  380.     }
  381.  
  382.     incr reqW [expr $data(pad-x1) + $data(pad-x2) + 2*$data(-ipadx)]
  383.     incr reqH [expr $data(pad-y1) + $data(pad-y2) + 2*$data(-ipady)]
  384.  
  385.     if {$reqW < $data(minW)} {
  386.         set reqW $data(minW)
  387.     }
  388.     if {$reqH < $data(minH)} {
  389.         set reqH $data(minH)
  390.     }
  391.     }
  392.     # These take higher precedence
  393.     #
  394.     if {$data(-width)  != 0} {
  395.     set reqW $data(-width)
  396.     }
  397.     if {$data(-height) != 0} {
  398.     set reqH $data(-height)
  399.     }
  400.  
  401.     if {[winfo reqwidth $w] != $reqW || [winfo reqheight $w] != $reqH} {
  402.     if {![info exists data(counter)]} {
  403.         set data(counter) 0
  404.     }
  405.         if {$data(counter) < 50} {
  406.             incr data(counter)
  407.         tixGeometryRequest $w $reqW $reqH
  408.         tixWidgetDoWhenIdle tixCallMethod $w Resize
  409.         set data(repack) 1
  410.         return
  411.     }
  412.     }
  413.     set data(counter) 0
  414.  
  415.     if {[string comp $data(w:top) $w]} {
  416.     tixMoveResizeWindow $data(w:top) 0 0 [winfo width $w] [winfo height $w]
  417.     tixMapWindow $data(w:top)
  418.     }
  419.  
  420.     if {![string comp $data(topchild) ""]} {
  421.     set top [lindex $data(windows) 0]
  422.     } else {
  423.     set top $data(topchild)
  424.     }
  425.  
  426.     if {[string comp $top ""]} {
  427.     tixCallMethod $w raise $top
  428.     }
  429.  
  430.     set data(repack) 0
  431. }
  432.