home *** CD-ROM | disk | FTP | other *** search
/ PCNET 2006 September - Disc 1 / PCNET_CD_2006_09.iso / linux / puppy-barebones-2.01r2.iso / pup_201.sfs / usr / lib / bwidget / panedw.tcl < prev    next >
Encoding:
Text File  |  2003-08-12  |  11.1 KB  |  326 lines
  1. # ------------------------------------------------------------------------------
  2. #  panedw.tcl
  3. #  This file is part of Unifix BWidget Toolkit
  4. # ------------------------------------------------------------------------------
  5. #  Index of commands:
  6. #     - PanedWindow::create
  7. #     - PanedWindow::configure
  8. #     - PanedWindow::cget
  9. #     - PanedWindow::add
  10. #     - PanedWindow::getframe
  11. #     - PanedWindow::_destroy
  12. #     - PanedWindow::_beg_move_sash
  13. #     - PanedWindow::_move_sash
  14. #     - PanedWindow::_end_move_sash
  15. #     - PanedWindow::_realize
  16. # ------------------------------------------------------------------------------
  17.  
  18. namespace eval PanedWindow {
  19.     namespace eval Pane {
  20.         Widget::declare PanedWindow::Pane {
  21.             {-minsize Int 0 0 "%d >= 0"}
  22.             {-weight  Int 1 0 "%d >= 0"}
  23.         }
  24.     }
  25.  
  26.     Widget::declare PanedWindow {
  27.         {-side       Enum       top 1 {top left bottom right}}
  28.         {-width      Int        10  1 "%d >=6"}
  29.         {-pad        Int        4   1 "%d >= 0"}
  30.         {-background TkResource ""  0 frame}
  31.         {-bg         Synonym    -background}
  32.     }
  33.  
  34.     variable _panedw
  35.  
  36.     proc ::PanedWindow { path args } { return [eval PanedWindow::create $path $args] }
  37.     proc use {} {}
  38. }
  39.  
  40.  
  41.  
  42. # ------------------------------------------------------------------------------
  43. #  Command PanedWindow::create
  44. # ------------------------------------------------------------------------------
  45. proc PanedWindow::create { path args } {
  46.     variable _panedw
  47.  
  48.     Widget::init PanedWindow $path $args
  49.  
  50.     frame $path -background [Widget::cget $path -background] -class PanedWindow
  51.     set _panedw($path,nbpanes) 0
  52.  
  53.     bind $path <Configure> "PanedWindow::_realize $path %w %h"
  54.     bind $path <Destroy>   "PanedWindow::_destroy $path"
  55.  
  56.     rename $path ::$path:cmd
  57.     proc ::$path { cmd args } "return \[eval PanedWindow::\$cmd $path \$args\]"
  58.  
  59.     return $path
  60. }
  61.  
  62.  
  63. # ------------------------------------------------------------------------------
  64. #  Command PanedWindow::configure
  65. # ------------------------------------------------------------------------------
  66. proc PanedWindow::configure { path args } {
  67.     variable _panedw
  68.  
  69.     set res [Widget::configure $path $args]
  70.  
  71.     if { [Widget::hasChanged $path -background bg] && $_panedw($path,nbpanes) > 0 } {
  72.         $path:cmd configure -background $bg
  73.         $path.f0 configure -background $bg
  74.         for {set i 1} {$i < $_panedw($path,nbpanes)} {incr i} {
  75.             set frame $path.sash$i
  76.             $frame configure -background $bg
  77.             $frame.sep configure -background $bg
  78.             $frame.but configure -background $bg
  79.             $path.f$i configure -background $bg
  80.             $path.f$i.frame configure -background $bg
  81.         }
  82.     }
  83.     return $res
  84. }
  85.  
  86.  
  87. # ------------------------------------------------------------------------------
  88. #  Command PanedWindow::cget
  89. # ------------------------------------------------------------------------------
  90. proc PanedWindow::cget { path option } {
  91.     return [Widget::cget $path $option]
  92. }
  93.  
  94.  
  95. # ------------------------------------------------------------------------------
  96. #  Command PanedWindow::add
  97. # ------------------------------------------------------------------------------
  98. proc PanedWindow::add { path args } {
  99.     variable _panedw
  100.  
  101.     set num $_panedw($path,nbpanes)
  102.     Widget::init PanedWindow::Pane $path.f$num $args
  103.     set bg [Widget::getoption $path -background]
  104.  
  105.     set wbut  [Widget::getoption $path -width]
  106.     set pad   [Widget::getoption $path -pad]
  107.     set width [expr {$wbut+2*$pad}]
  108.     set side  [Widget::getoption $path -side]
  109.     if { $num > 0 } {
  110.         set frame [frame $path.sash$num -relief flat -bd 0 \
  111.         -highlightthickness 0 -width $width -height $width -bg $bg]
  112.         set sep   [frame $frame.sep -bd 5 -relief raised \
  113.         -highlightthickness 0 -bg $bg]
  114.         set but   [frame $frame.but -bd 1 -relief raised \
  115.         -highlightthickness 0 -bg $bg -width $wbut -height $wbut]
  116.     set placeButton 1
  117.     set sepsize     2
  118.     if { $::tcl_platform(platform) != "windows" } {
  119.         set activator $but
  120.     } else {
  121.         set activator $sep
  122.         set sepsize 4
  123.         $sep configure -bd 3
  124.         set placeButton 0
  125.     }
  126.         if { ![string compare $side "top"] || \
  127.         ![string compare $side "bottom"] } {
  128.             place $sep -relx 0.5 -y 0 -width $sepsize -relheight 1.0 -anchor n
  129.         if { $placeButton } {
  130.         if { ![string compare $side "top"] } {
  131.             place $but -relx 0.5 -y [expr {6+$wbut/2}] -anchor c
  132.         } else {
  133.             place $but -relx 0.5 -rely 1.0 -y [expr {-6-$wbut/2}] \
  134.                 -anchor c
  135.         }
  136.         }
  137.             $activator configure -cursor sb_h_double_arrow 
  138.             grid $frame -column [expr {2*$num-1}] -row 0 -sticky ns
  139.             grid columnconfigure $path [expr {2*$num-1}] -weight 0
  140.         } else {
  141.             place $sep -x 0 -rely 0.5 -height $sepsize -relwidth 1.0 -anchor w
  142.         if { $placeButton } {
  143.         if { ![string compare $side "left"] } {
  144.             place $but -rely 0.5 -x [expr {6+$wbut/2}] -anchor c
  145.         } else {
  146.             place $but -rely 0.5 -relx 1.0 -x [expr {-6-$wbut/2}] \
  147.                 -anchor c
  148.         }
  149.         }
  150.             $activator configure -cursor sb_v_double_arrow 
  151.             grid $frame -row [expr {2*$num-1}] -column 0 -sticky ew
  152.             grid rowconfigure $path [expr {2*$num-1}] -weight 0
  153.         }
  154.         bind $activator <ButtonPress-1> \
  155.         "PanedWindow::_beg_move_sash $path $num %X %Y"
  156.     } else {
  157.         if { ![string compare $side "top"] || \
  158.         ![string compare $side "bottom"] } {
  159.             grid rowconfigure $path 0 -weight 1
  160.         } else {
  161.             grid columnconfigure $path 0 -weight 1
  162.         }
  163.     }
  164.  
  165.     set pane [frame $path.f$num -bd 0 -relief flat \
  166.         -highlightthickness 0 -bg $bg]
  167.     set user [frame $path.f$num.frame  -bd 0 -relief flat \
  168.         -highlightthickness 0 -bg $bg]
  169.     if { ![string compare $side "top"] || ![string compare $side "bottom"] } {
  170.         grid $pane -column [expr {2*$num}] -row 0 -sticky nsew
  171.         grid columnconfigure $path [expr {2*$num}] \
  172.             -weight  [Widget::getoption $path.f$num -weight]
  173.     } else {
  174.         grid $pane -row [expr {2*$num}] -column 0 -sticky nsew
  175.         grid rowconfigure $path [expr {2*$num}] \
  176.             -weight  [Widget::getoption $path.f$num -weight]
  177.     }
  178.     pack $user -fill both -expand yes
  179.     incr _panedw($path,nbpanes)
  180.  
  181.     return $user
  182. }
  183.  
  184.  
  185. # ------------------------------------------------------------------------------
  186. #  Command PanedWindow::getframe
  187. # ------------------------------------------------------------------------------
  188. proc PanedWindow::getframe { path index } {
  189.     if { [winfo exists $path.f$index.frame] } {
  190.         return $path.f$index.frame
  191.     }
  192. }
  193.  
  194.  
  195. # ------------------------------------------------------------------------------
  196. #  Command PanedWindow::_destroy
  197. # ------------------------------------------------------------------------------
  198. proc PanedWindow::_destroy { path } {
  199.     variable _panedw
  200.  
  201.     for {set i 0} {$i < $_panedw($path,nbpanes)} {incr i} {
  202.         Widget::destroy $path.f$i
  203.     }
  204.     unset _panedw($path,nbpanes)
  205.     Widget::destroy $path
  206.     rename $path {}
  207. }
  208.     
  209.  
  210. # ------------------------------------------------------------------------------
  211. #  Command PanedWindow::_beg_move_sash
  212. # ------------------------------------------------------------------------------
  213. proc PanedWindow::_beg_move_sash { path num x y } {
  214.     variable _panedw
  215.  
  216.     set fprev $path.f[expr {$num-1}]
  217.     set fnext $path.f$num
  218.     set wsash [expr {[Widget::getoption $path -width] + 2*[Widget::getoption $path -pad]}]
  219.  
  220.     $path.sash$num.but configure -relief sunken
  221.     set top  [toplevel $path.sash -borderwidth 1 -relief raised]
  222.  
  223.     set minszg [Widget::getoption $fprev -minsize]
  224.     set minszd [Widget::getoption $fnext -minsize]
  225.     set side   [Widget::getoption $path -side]
  226.  
  227.     if { ![string compare $side "top"] || ![string compare $side "bottom"] } {
  228.         $top configure -cursor sb_h_double_arrow
  229.         set h    [winfo height $path]
  230.         set yr   [winfo rooty $path.sash$num]
  231.         set xmin [expr {$wsash/2+[winfo rootx $fprev]+$minszg}]
  232.         set xmax [expr {-$wsash/2-1+[winfo rootx $fnext]+[winfo width $fnext]-$minszd}]
  233.         wm overrideredirect $top 1
  234.         wm geom $top "2x${h}+$x+$yr"
  235.  
  236.         update idletasks
  237.         grab set $top
  238.         bind $top <ButtonRelease-1> "PanedWindow::_end_move_sash $path $top $num $xmin $xmax %X rootx width"
  239.         bind $top <Motion>          "PanedWindow::_move_sash $top $xmin $xmax %X +%%d+$yr"
  240.         _move_sash $top $xmin $xmax $x "+%d+$yr"
  241.     } else {
  242.         $top configure -cursor sb_v_double_arrow
  243.         set w    [winfo width $path]
  244.         set xr   [winfo rootx $path.sash$num]
  245.         set ymin [expr {$wsash/2+[winfo rooty $fprev]+$minszg}]
  246.         set ymax [expr {-$wsash/2-1+[winfo rooty $fnext]+[winfo height $fnext]-$minszd}]
  247.         wm overrideredirect $top 1
  248.         wm geom $top "${w}x2+$xr+$y"
  249.  
  250.         update idletasks
  251.         grab set $top
  252.         bind $top <ButtonRelease-1> "PanedWindow::_end_move_sash $path $top $num $ymin $ymax %Y rooty height"
  253.         bind $top <Motion>          "PanedWindow::_move_sash $top $ymin $ymax %Y +$xr+%%d"
  254.         _move_sash $top $ymin $ymax $y "+$xr+%d"
  255.     }
  256. }
  257.  
  258.  
  259. # ------------------------------------------------------------------------------
  260. #  Command PanedWindow::_move_sash
  261. # ------------------------------------------------------------------------------
  262. proc PanedWindow::_move_sash { top min max v form } {
  263.  
  264.     if { $v < $min } {
  265.     set v $min
  266.     } elseif { $v > $max } {
  267.     set v $max
  268.     }
  269.     wm geom $top [format $form $v]
  270. }
  271.  
  272.  
  273. # ------------------------------------------------------------------------------
  274. #  Command PanedWindow::_end_move_sash
  275. # ------------------------------------------------------------------------------
  276. proc PanedWindow::_end_move_sash { path top num min max v rootv size } {
  277.     variable _panedw
  278.  
  279.     destroy $top
  280.     if { $v < $min } {
  281.     set v $min
  282.     } elseif { $v > $max } {
  283.     set v $max
  284.     }
  285.     set fprev $path.f[expr {$num-1}]
  286.     set fnext $path.f$num
  287.  
  288.     $path.sash$num.but configure -relief raised
  289.  
  290.     set wsash [expr {[Widget::getoption $path -width] + 2*[Widget::getoption $path -pad]}]
  291.     set dv    [expr {$v-[winfo $rootv $path.sash$num]-$wsash/2}]
  292.     set w1    [winfo $size $fprev]
  293.     set w2    [winfo $size $fnext]
  294.  
  295.     for {set i 0} {$i < $_panedw($path,nbpanes)} {incr i} {
  296.         if { $i == $num-1} {
  297.             $fprev configure -$size [expr {[winfo $size $fprev]+$dv}]
  298.         } elseif { $i == $num } {
  299.             $fnext configure -$size [expr {[winfo $size $fnext]-$dv}]
  300.         } else {
  301.             $path.f$i configure -$size [winfo $size $path.f$i]
  302.         }
  303.     }
  304. }
  305.  
  306.  
  307. # ------------------------------------------------------------------------------
  308. #  Command PanedWindow::_realize
  309. # ------------------------------------------------------------------------------
  310. proc PanedWindow::_realize { path width height } {
  311.     variable _panedw
  312.  
  313.     set x    0
  314.     set y    0
  315.     set hc   [winfo reqheight $path]
  316.     set hmax 0
  317.     for {set i 0} {$i < $_panedw($path,nbpanes)} {incr i} {
  318.         $path.f$i configure \
  319.             -width  [winfo reqwidth  $path.f$i.frame] \
  320.             -height [winfo reqheight $path.f$i.frame]
  321.         place $path.f$i.frame -x 0 -y 0 -relwidth 1 -relheight 1
  322.     }
  323.  
  324.     bind $path <Configure> {}
  325. }
  326.