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 / SWidget.tcl < prev    next >
Text File  |  2001-11-03  |  10KB  |  466 lines
  1. # -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
  2. #
  3. #    $Id: SWidget.tcl,v 1.2.2.1 2001/11/03 07:23:17 idiscovery Exp $
  4. #
  5. # SWidget.tcl --
  6. #
  7. #     tixScrolledWidget: virtual base class. Do not instantiate
  8. #    This is the core class for all scrolled widgets.
  9. #
  10. # Copyright (c) 1993-1999 Ioi Kim Lam.
  11. # Copyright (c) 2000-2001 Tix Project Group.
  12. #
  13. # See the file "license.terms" for information on usage and redistribution
  14. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  15. #
  16.  
  17.  
  18. tixWidgetClass tixScrolledWidget {
  19.     -virtual true
  20.     -classname TixScrolledWidget
  21.     -superclass tixPrimitive
  22.     -method {
  23.     }
  24.     -flag {
  25.     -scrollbar -scrollbarspace
  26.     }
  27.     -configspec {
  28.     {-scrollbar scrollbar Scrollbar both}
  29.     {-scrollbarspace scrollbarSpace ScrollbarSpace {both}}
  30.         {-sizebox sizeBox SizeBox 0}
  31.     }
  32. }
  33.  
  34. proc tixScrolledWidget:InitWidgetRec {w} {
  35.     upvar #0 $w data
  36.  
  37.     tixChainMethod $w InitWidgetRec
  38.  
  39.     set data(x,first)   0
  40.     set data(x,last)    0
  41.  
  42.     set data(y,first)   0
  43.     set data(y,last)    0
  44.  
  45.     set data(lastSpec) ""
  46.     set data(lastMW)   ""
  47.     set data(lastMH)   ""
  48.     set data(lastScbW) ""
  49.     set data(lastScbH) ""
  50.  
  51.     set data(repack)    0
  52.     set data(counter)   0
  53.  
  54.     set data(vsbPadY)   0
  55.     set data(hsbPadX)   0
  56. }
  57.  
  58. proc tixScrolledWidget:SetBindings {w} {
  59.     upvar #0 $w data
  60.  
  61.     tixChainMethod $w SetBindings
  62.  
  63.     tixManageGeometry $data(pw:client) "tixScrolledWidget:ClientGeomProc $w"
  64.     bind $data(pw:client) <Configure> \
  65.     [list tixScrolledWidget:ClientGeomProc $w "" $data(pw:client)]
  66.  
  67.     tixManageGeometry $data(w:hsb) "tixScrolledWidget:ClientGeomProc $w"
  68.     bind $data(w:hsb) <Configure> \
  69.     [list tixScrolledWidget:ClientGeomProc $w "" $data(w:hsb)]
  70.  
  71.     tixManageGeometry $data(w:vsb) "tixScrolledWidget:ClientGeomProc $w"
  72.     bind $data(w:vsb) <Configure> \
  73.     [list tixScrolledWidget:ClientGeomProc $w "" $data(w:vsb)]
  74.  
  75.     bind $w <Configure> "tixScrolledWidget:MasterGeomProc $w"
  76.  
  77.     tixWidgetDoWhenIdle tixScrolledWidget:Repack $w
  78.     set data(repack) 1
  79. }
  80.  
  81. proc tixScrolledWidget:config-scrollbar {w value} {
  82.     upvar #0 $w data
  83.     global tcl_platform
  84.  
  85.     if {[lindex $value 0] == "auto"} {
  86.     foreach xspec [lrange $value 1 end] {
  87.         case $xspec {
  88.         {+x -x +y -y} {}
  89.         default {
  90.             error "bad -scrollbar value \"$value\""
  91.         }
  92.         }
  93.     }
  94.     } else {
  95.     case $value in {
  96.         {none x y both} {}
  97.         default {
  98.         error "bad -scrollbar value \"$value\""
  99.         }
  100.     }
  101.     }
  102.  
  103.     if {$data(-sizebox) && $tcl_platform(platform) == "windows"} {
  104.         set data(-scrollbar) both
  105.     }
  106.  
  107.     if {$data(repack) == 0} {
  108.     set data(repack) 1
  109.     tixWidgetDoWhenIdle tixScrolledWidget:Repack $w
  110.     }
  111. }    
  112.  
  113. proc tixScrolledWidget:config-scrollbarspace {w value} {
  114.     upvar #0 $w data
  115.   
  116.     if {$data(repack) == 0} {
  117.     set data(repack) 1
  118.     tixWidgetDoWhenIdle tixScrolledWidget:Repack $w
  119.     }
  120. }    
  121.  
  122. proc tixScrolledWidget:config-sizebox {w value} {
  123.   error "unimplemented"
  124. }
  125.  
  126.  
  127. #----------------------------------------------------------------------
  128. #
  129. #         Scrollbar calculations
  130. #
  131. #----------------------------------------------------------------------
  132. proc tixScrolledWidget:ClientGeomProc {w type client} {
  133.     upvar #0 $w data
  134.  
  135.     if {$data(repack) == 0} {
  136.     set data(repack) 1
  137.     tixWidgetDoWhenIdle tixScrolledWidget:Repack $w
  138.     }
  139. }
  140.  
  141. proc tixScrolledWidget:MasterGeomProc {w} {
  142.     upvar #0 $w data
  143.  
  144.     if {$data(repack) == 0} {
  145.     set data(repack) 1
  146.     tixWidgetDoWhenIdle tixScrolledWidget:Repack $w
  147.     }
  148. }
  149.  
  150. proc tixScrolledWidget:Configure {w} {
  151.     if {![winfo exists $w]} {
  152.     return
  153.     }
  154.  
  155.     upvar #0 $w data
  156.  
  157.     if {$data(repack) == 0} {
  158.     set data(repack) 1
  159.     tixWidgetDoWhenIdle tixScrolledWidget:Repack $w
  160.     }
  161. }
  162.  
  163. proc tixScrolledWidget:ScrollCmd {w scrollbar axis first last} {
  164.     upvar #0 $w data
  165.  
  166.     $scrollbar set $first $last
  167. }
  168.  
  169. # Show or hide the scrollbars as required.
  170. #
  171. # spec: 00 = need none
  172. # spec: 01 = need y
  173. # spec: 10 = need x
  174. # spec: 11 = need xy
  175. #
  176. proc tixScrolledWidget:Repack {w} {
  177.     tixCallMethod $w RepackHook
  178. }
  179.  
  180. proc tixScrolledWidget:RepackHook {w} {
  181.     upvar #0 $w data
  182.     global tcl_platform
  183.  
  184.     if {![winfo exists $w]} {
  185.     # This was generated by the <Destroy> event
  186.     #
  187.     return
  188.     }
  189.  
  190.     set client $data(pw:client)
  191.  
  192.     # Calculate the size of the master
  193.     #
  194.     set mreqw [winfo reqwidth  $w]
  195.     set mreqh [winfo reqheight $w]
  196.     set creqw [winfo reqwidth  $client]
  197.     set creqh [winfo reqheight $client]
  198.  
  199.     set scbW [winfo reqwidth  $w.vsb]
  200.     set scbH [winfo reqheight $w.hsb]
  201.  
  202.     case $data(-scrollbarspace) {
  203.     "x" {
  204.         incr creqh $scbH
  205.     }
  206.     "y" {
  207.         incr creqw $scbW
  208.     }
  209.     "both" {
  210.         incr creqw $scbW
  211.         incr creqh $scbH
  212.     }
  213.     }
  214.  
  215.     if {$data(-width) != 0} {
  216.     set creqw $data(-width)
  217.     }
  218.     if {$data(-height) != 0} {
  219.     set creqh $data(-height)
  220.     }
  221.  
  222.     if {$mreqw != $creqw || $mreqh != $creqh } {
  223.     if {![info exists data(counter)]} {
  224.         set data(counter) 0
  225.     }
  226.     if {$data(counter) < 50} {
  227.         incr data(counter)
  228.         tixGeometryRequest $w $creqw $creqh
  229.         tixWidgetDoWhenIdle tixScrolledWidget:Repack $w
  230.         set data(repack) 1
  231.         return
  232.     }
  233.     }
  234.  
  235.     set data(counter) 0
  236.     set mw [winfo width  $w]
  237.     set mh [winfo height $w]
  238.  
  239.     set cw [expr $mw - $scbW]
  240.     set ch [expr $mh - $scbH]
  241.  
  242.     set scbx [expr $mw - $scbW]
  243.     set scby [expr $mh - $scbH]
  244.  
  245.     # Check the validity of the sizes: if window was not mapped then
  246.     # sizes will be below 1x1
  247.     if {$cw < 1} {
  248.     set cw 1
  249.     }
  250.     if {$ch < 1} {
  251.     set ch 1
  252.     }
  253.     if {$scbx < 1} {
  254.     set scbx 1
  255.     }
  256.     if {$scby < 1} {
  257.     set scby 1
  258.     }
  259.  
  260.     if {[lindex $data(-scrollbar) 0] == "auto"} {
  261.     # Find out how we are going to pack the scrollbars
  262.     #
  263.     set spec [tixScrolledWidget:CheckScrollbars $w $scbW $scbH]
  264.  
  265.     foreach xspec [lrange $data(-scrollbar) 1 end] {
  266.         case $xspec {
  267.         +x {
  268.             set spec [expr $spec | 10]
  269.         }
  270.         -x {
  271.             set spec [expr $spec & 01]
  272.         }
  273.         +y {
  274.             set spec [expr $spec | 01]
  275.         }
  276.         -y {
  277.             set spec [expr $spec & 10]
  278.         }
  279.         }
  280.     }
  281.     if {$spec == 0} {
  282.         set spec 00
  283.     }
  284.     if {$spec == 1} {
  285.         set spec 01
  286.     }
  287.     } else {
  288.     case $data(-scrollbar) in {
  289.         none {
  290.         set spec 00
  291.         }
  292.         x {
  293.         set spec 10
  294.         }
  295.         y {
  296.         set spec 01
  297.         }
  298.         both {
  299.         set spec 11
  300.         }
  301.     }
  302.     }
  303.  
  304.  
  305.     if {$data(lastSpec)==$spec && $data(lastMW)==$mw && $data(lastMH)==$mh} {
  306.     if {$data(lastScbW) == $scbW && $data(lastScbH) == $scbH} {
  307.         tixCallMethod $w PlaceWindow
  308.         set data(repack) 0
  309.         return
  310.     }
  311.     }
  312.  
  313.     set vsbH [expr $mh - $data(vsbPadY)]
  314.     set hsbW [expr $mw - $data(hsbPadX)]
  315.  
  316.     if {$vsbH < 1} {
  317.     set vsbH 1
  318.     }
  319.     if {$hsbW < 1} {
  320.     set hsbW 1
  321.     }
  322.  
  323.     case $spec in {
  324.     "00" {
  325.         tixMoveResizeWindow $client 0 0 $mw $mh
  326.  
  327.         tixMapWindow $client
  328.             tixUnmapWindow $data(w:hsb)
  329.         tixUnmapWindow $data(w:vsb)
  330.     }
  331.     "01" {
  332.         tixMoveResizeWindow $client 0 0 $cw $mh
  333.         tixMoveResizeWindow $data(w:vsb) $scbx $data(vsbPadY) $scbW $vsbH
  334.  
  335.         tixMapWindow $client
  336.         tixUnmapWindow $data(w:hsb)
  337.         tixMapWindow $data(w:vsb)
  338.     }
  339.     "10" {
  340.         tixMoveResizeWindow $client 0 0 $mw $ch
  341.         tixMoveResizeWindow $data(w:hsb) $data(hsbPadX) $scby $hsbW $scbH 
  342.  
  343.         tixMapWindow $client
  344.         tixMapWindow $data(w:hsb)
  345.         tixUnmapWindow $data(w:vsb)
  346.     }
  347.     "11" {
  348.         set vsbH [expr $ch - $data(vsbPadY)]
  349.         set hsbW [expr $cw - $data(hsbPadX)]
  350.         if {$vsbH < 1} {
  351.         set vsbH 1
  352.         }
  353.         if {$hsbW < 1} {
  354.         set hsbW 1
  355.         }
  356.  
  357.         tixMoveResizeWindow $client 0 0 $cw $ch
  358.         tixMoveResizeWindow $data(w:vsb) $scbx $data(vsbPadY) $scbW $vsbH
  359.         tixMoveResizeWindow $data(w:hsb) $data(hsbPadX) $scby $hsbW $scbH 
  360.         if {$data(-sizebox) && $tcl_platform(platform) == "windows"} {
  361.             tixMoveResizeWindow $data(w:sizebox) $scbx $scby $scbW $scbH
  362.         }
  363.  
  364.         tixMapWindow $client
  365.         tixMapWindow $data(w:hsb)
  366.         tixMapWindow $data(w:vsb)
  367.         if {$data(-sizebox) && $tcl_platform(platform) == "windows"} {
  368.             tixMapWindow $data(w:sizebox)
  369.         }
  370.     }
  371.     }
  372.  
  373.     set data(lastSpec) $spec
  374.     set data(lastMW)   $mw
  375.     set data(lastMH)   $mh
  376.     set data(lastScbW) $scbW
  377.     set data(lastScbH) $scbH
  378.  
  379.     tixCallMethod $w PlaceWindow
  380.     set data(repack) 0
  381. }
  382.  
  383. proc tixScrolledWidget:PlaceWindow {w} {
  384.     # virtual base function
  385. }
  386.  
  387. #
  388. # Helper function
  389. #
  390. proc tixScrolledWidget:NeedScrollbar {w axis} {
  391.     upvar #0 $w data
  392.  
  393.     if {$data($axis,first) > 0.0} {
  394.     return 1
  395.     }
  396.  
  397.     if {$data($axis,last) < 1.0} {
  398.     return 1
  399.     }
  400.     
  401.     return 0
  402. }
  403.  
  404. # Return whether H and V needs scrollbars in a list of two booleans
  405. #
  406. #
  407. proc tixScrolledWidget:CheckScrollbars {w scbW scbH} {
  408.     upvar #0 $w data
  409.  
  410.     set mW [winfo width  $w]
  411.     set mH [winfo height $w]
  412.  
  413.     set info [tixCallMethod $w GeometryInfo $mW $mH]
  414.  
  415.     if {$info != ""} {
  416.     set xSpec [lindex $info 0]
  417.     set ySpec [lindex $info 1]
  418.  
  419.     set data(x,first)   [lindex $xSpec 0]
  420.     set data(x,last)    [lindex $xSpec 1]
  421.  
  422.     set data(y,first)   [lindex $ySpec 0]
  423.     set data(y,last)    [lindex $ySpec 1]
  424.     }
  425.  
  426.     set needX [tixScrolledWidget:NeedScrollbar $w x]
  427.     set needY [tixScrolledWidget:NeedScrollbar $w y]
  428.  
  429.     if {[winfo ismapped $w]==0} {
  430.     return "$needX$needY"
  431.     }
  432.  
  433.     if {$needX && $needY} {
  434.     return 11
  435.     }
  436.  
  437.     if {$needX == 0 && $needY == 0} {
  438.     return 00
  439.     }
  440.  
  441.     if {$needX} {
  442.     set mH [expr $mH - $scbH]
  443.     }
  444.     if {$needY} {
  445.     set mW [expr $mW - $scbW]
  446.     }
  447.  
  448.     set info [tixCallMethod $w GeometryInfo $mW $mH]
  449.     if {$info != ""} {
  450.     set xSpec [lindex $info 0]
  451.     set ySpec [lindex $info 1]
  452.  
  453.     set data(x,first)   [lindex $xSpec 0]
  454.     set data(x,last)    [lindex $xSpec 1]
  455.  
  456.     set data(y,first)   [lindex $ySpec 0]
  457.     set data(y,last)    [lindex $ySpec 1]
  458.     }
  459.  
  460.     set needX [tixScrolledWidget:NeedScrollbar $w x]
  461.     set needY [tixScrolledWidget:NeedScrollbar $w y]
  462.  
  463.     return "$needX$needY"
  464. }
  465.  
  466.