arcadia 0.1.1 → 0.1.2

data/tcl/BWidget-1.8.0/pagesmgr.tcl

@@ -0,0 +1,294 @@
+# ------------------------------------------------------------------------------
+#  pagesmgr.tcl
+#  This file is part of Unifix BWidget Toolkit
+#  $Id: pagesmgr.tcl,v 1.6 2003/10/20 21:23:52 damonc Exp $
+# ------------------------------------------------------------------------------
+#  Index of commands:
+#     - PagesManager::create
+#     - PagesManager::configure
+#     - PagesManager::cget
+#     - PagesManager::compute_size
+#     - PagesManager::add
+#     - PagesManager::delete
+#     - PagesManager::raise
+#     - PagesManager::page
+#     - PagesManager::pages
+#     - PagesManager::getframe
+#     - PagesManager::_test_page
+#     - PagesManager::_select
+#     - PagesManager::_redraw
+#     - PagesManager::_draw_area
+#     - PagesManager::_realize
+# ------------------------------------------------------------------------------
+package require Tcl 8.1.1
+
+namespace eval PagesManager {
+    Widget::define PagesManager pagesmgr
+
+    Widget::declare PagesManager {
+        {-background TkResource "" 0 frame}
+        {-cursor     TkResource "" 0 frame}
+        {-width      Int        0  0 "%d >= 0"}
+        {-height     Int        0  0 "%d >= 0"}
+    }
+
+    Widget::addmap PagesManager "" :cmd { -width {} -height {} -cursor {} }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command PagesManager::create
+# ------------------------------------------------------------------------------
+proc PagesManager::create { path args } {
+    variable $path
+    upvar 0  $path data
+
+    Widget::init PagesManager $path $args
+
+    set data(select)   ""
+    set data(pages)    {}
+    set data(cpt)      0
+    set data(realized) 0
+
+    # --- creation du canvas -----------------------------------------------------------------
+    eval canvas $path -relief flat -bd 0 -highlightthickness 0 \
+	    [Widget::subcget $path :cmd]
+
+    bind $path <Configure> [list PagesManager::_realize $path]
+    bind $path <Destroy>   [list PagesManager::_destroy $path]
+
+    return [Widget::create PagesManager $path]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command PagesManager::configure
+# ------------------------------------------------------------------------------
+proc PagesManager::configure { path args } {
+    return [Widget::configure $path $args]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command PagesManager::cget
+# ------------------------------------------------------------------------------
+proc PagesManager::cget { path option } {
+    return [Widget::cget $path $option]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command PagesManager::compute_size
+# ------------------------------------------------------------------------------
+proc PagesManager::compute_size { path } {
+    variable $path
+    upvar 0  $path data
+
+    set wmax 0
+    set hmax 0
+    update idletasks
+    foreach page $data(pages) {
+        set w    [winfo reqwidth  $path.f$page]
+        set h    [winfo reqheight $path.f$page]
+        set wmax [expr {$w>$wmax ? $w : $wmax}]
+        set hmax [expr {$h>$hmax ? $h : $hmax}]
+    }
+    configure $path -width $wmax -height $hmax
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command PagesManager::add
+# ------------------------------------------------------------------------------
+proc PagesManager::add { path page } {
+    variable $path
+    upvar 0  $path data
+
+    if { [lsearch -exact $data(pages) $page] != -1 } {
+        return -code error "page \"$page\" already exists"
+    }
+
+    lappend data(pages) $page
+
+    frame $path.f$page -relief flat \
+	    -background [Widget::cget $path -background] -borderwidth 0
+
+    return $path.f$page
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command PagesManager::delete
+# ------------------------------------------------------------------------------
+proc PagesManager::delete { path page } {
+    variable $path
+    upvar 0  $path data
+
+    set pos [_test_page $path $page]
+    set data(pages) [lreplace $data(pages) $pos $pos]
+    if { $data(select) == $page } {
+        set data(select) ""
+    }
+    destroy $path.f$page
+    _redraw $path
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command PagesManager::raise
+# ------------------------------------------------------------------------------
+proc PagesManager::raise { path {page ""} } {
+    variable $path
+    upvar 0  $path data
+
+    if { $page != "" } {
+        _test_page $path $page
+        _select $path $page
+    }
+    return $data(select)
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command PagesManager::page - deprecated, use pages
+# ------------------------------------------------------------------------------
+proc PagesManager::page { path first {last ""} } {
+    variable $path
+    upvar 0  $path data
+
+    if { $last == "" } {
+        return [lindex $data(pages) $first]
+    } else {
+        return [lrange $data(pages) $first $last]
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command PagesManager::pages
+# ------------------------------------------------------------------------------
+proc PagesManager::pages { path {first ""} {last ""} } {
+    variable $path
+    upvar 0  $path data
+
+    if { ![string length $first] } {
+	return $data(pages)
+    }
+
+    if { ![string length $last] } {
+        return [lindex $data(pages) $first]
+    } else {
+        return [lrange $data(pages) $first $last]
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command PagesManager::getframe
+# ------------------------------------------------------------------------------
+proc PagesManager::getframe { path page } {
+    return $path.f$page
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command PagesManager::_test_page
+# ------------------------------------------------------------------------------
+proc PagesManager::_test_page { path page } {
+    variable $path
+    upvar 0  $path data
+
+    if { [set pos [lsearch $data(pages) $page]] == -1 } {
+        return -code error "page \"$page\" does not exists"
+    }
+    return $pos
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command PagesManager::_select
+# ------------------------------------------------------------------------------
+proc PagesManager::_select { path page } {
+    variable $path
+    upvar 0  $path data
+
+    set oldsel $data(select)
+    if { $page != $oldsel } {
+        set data(select) $page
+        _draw_area $path
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command PagesManager::_redraw
+# ------------------------------------------------------------------------------
+proc PagesManager::_redraw { path } {
+    variable $path
+    upvar 0  $path data
+
+    if { !$data(realized) } {
+        return
+    }
+    _draw_area $path
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command PagesManager::_draw_area
+# ------------------------------------------------------------------------------
+proc PagesManager::_draw_area { path } {
+    variable $path
+    upvar 0  $path data
+
+    set w   [winfo width  $path]
+    set h   [winfo height $path]
+    set sel $data(select)
+    if { $sel != "" } {
+        if { [llength [$path:cmd find withtag "window"]] } {
+            $path:cmd coords "window" 0 0
+            $path:cmd itemconfigure "window"    \
+                -width  $w        \
+                -height $h    \
+                -window $path.f$sel
+        } else {
+            $path:cmd create window 0 0 \
+                -width  $w          \
+                -height $h       \
+                -anchor nw                      \
+                -tags   "window"                \
+                -window $path.f$sel
+        }
+    } else {
+        $path:cmd delete "window"
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command PagesManager::_realize
+# ------------------------------------------------------------------------------
+proc PagesManager::_realize { path } {
+    variable $path
+    upvar 0  $path data
+
+    if { [set width  [Widget::cget $path -width]]  == 0 ||
+         [set height [Widget::cget $path -height]] == 0 } {
+        compute_size $path
+    }
+
+    set data(realized) 1
+    _draw_area $path
+    bind $path <Configure> [list PagesManager::_draw_area $path]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command PagesManager::_destroy
+# ------------------------------------------------------------------------------
+proc PagesManager::_destroy { path } {
+    variable $path
+    upvar 0  $path data
+    Widget::destroy $path
+    unset data
+}

data/tcl/BWidget-1.8.0/panedw.tcl

@@ -0,0 +1,381 @@
+# ----------------------------------------------------------------------------
+#  panedw.tcl
+#  This file is part of Unifix BWidget Toolkit
+# ----------------------------------------------------------------------------
+#  Index of commands:
+#     - PanedWindow::create
+#     - PanedWindow::configure
+#     - PanedWindow::cget
+#     - PanedWindow::add
+#     - PanedWindow::getframe
+#     - PanedWindow::_apply_weights
+#     - PanedWindow::_destroy
+#     - PanedWindow::_beg_move_sash
+#     - PanedWindow::_move_sash
+#     - PanedWindow::_end_move_sash
+#     - PanedWindow::_realize
+# ----------------------------------------------------------------------------
+
+# JDC: added option to choose behavior of weights
+#    -weights extra : only apply weights to extra space (as current (>= 1.3.1) with grid command)
+#    -weights available : apply weights to total available space (as before (<1.3.1) with place command)
+
+namespace eval PanedWindow {
+    Widget::define PanedWindow panedw
+
+    namespace eval Pane {
+        Widget::declare PanedWindow::Pane {
+            {-minsize Int 0 0 "%d >= 0"}
+            {-weight  Int 1 0 "%d >= 0"}
+        }
+    }
+
+    Widget::declare PanedWindow {
+        {-side       Enum       top   1 {top left bottom right}}
+        {-width      Int        10    1 "%d >=3"}
+        {-pad        Int        4     1 "%d >= 0"}
+        {-background TkResource ""    0 frame}
+        {-bg         Synonym    -background}
+        {-activator  Enum       ""    1 {line button}}
+	{-weights    Enum       extra 1 {extra available}}
+    }
+
+    variable _panedw
+}
+
+
+
+# ----------------------------------------------------------------------------
+#  Command PanedWindow::create
+# ----------------------------------------------------------------------------
+proc PanedWindow::create { path args } {
+    variable _panedw
+
+    Widget::init PanedWindow $path $args
+
+    frame $path -background [Widget::cget $path -background] -class PanedWindow
+    set _panedw($path,nbpanes) 0
+    set _panedw($path,weights) ""
+    set _panedw($path,configuredone) 0
+
+    bind $path <Configure> [list PanedWindow::_realize $path %w %h]
+    bind $path <Destroy>   [list PanedWindow::_destroy $path]
+
+    return [Widget::create PanedWindow $path]
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command PanedWindow::configure
+# ----------------------------------------------------------------------------
+proc PanedWindow::configure { path args } {
+    variable _panedw
+
+    set res [Widget::configure $path $args]
+
+    if { [Widget::hasChanged $path -background bg] && $_panedw($path,nbpanes) > 0 } {
+        $path:cmd configure -background $bg
+        $path.f0 configure -background $bg
+        for {set i 1} {$i < $_panedw($path,nbpanes)} {incr i} {
+            set frame $path.sash$i
+            $frame configure -background $bg
+            $frame.sep configure -background $bg
+            $frame.but configure -background $bg
+            $path.f$i configure -background $bg
+            $path.f$i.frame configure -background $bg
+        }
+    }
+    return $res
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command PanedWindow::cget
+# ----------------------------------------------------------------------------
+proc PanedWindow::cget { path option } {
+    return [Widget::cget $path $option]
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command PanedWindow::add
+# ----------------------------------------------------------------------------
+proc PanedWindow::add { path args } {
+    variable _panedw
+
+    set num $_panedw($path,nbpanes)
+    Widget::init PanedWindow::Pane $path.f$num $args
+    set bg [Widget::getoption $path -background]
+
+    set wbut   [Widget::getoption $path -width]
+    set pad    [Widget::getoption $path -pad]
+    set width  [expr {$wbut+2*$pad}]
+    set side   [Widget::getoption $path -side]
+    set weight [Widget::getoption $path.f$num -weight]
+    lappend _panedw($path,weights) $weight
+
+    if { $num > 0 } {
+        set frame [frame $path.sash$num -relief flat -bd 0 \
+		-highlightthickness 0 -width $width -height $width -bg $bg]
+        set sep   [frame $frame.sep -bd 5 -relief raised \
+		-highlightthickness 0 -bg $bg]
+        set but   [frame $frame.but -bd 1 -relief raised \
+		-highlightthickness 0 -bg $bg -width $wbut -height $wbut]
+	set placeButton 1
+	set sepsize     2
+
+	set activator [Widget::getoption $path -activator]
+	if {$activator == ""} {
+	    if { $::tcl_platform(platform) != "windows" } {
+		set activator button
+	    } else {
+		set activator line
+	    }
+	}
+	if {$activator == "button"} {
+	    set activator $but
+	} else {
+	    set activator $sep
+	    set sepsize 4
+	    $sep configure -bd 3
+	    set placeButton 0
+	}
+        if {[string equal $side "top"] || [string equal $side "bottom"]} {
+            place $sep -relx 0.5 -y 0 -width $sepsize -relheight 1.0 -anchor n
+	    if { $placeButton } {
+		if {[string equal $side "top"]} {
+		    place $but -relx 0.5 -y [expr {6+$wbut/2}] -anchor c
+		} else {
+		    place $but -relx 0.5 -rely 1.0 -y [expr {-6-$wbut/2}] \
+			    -anchor c
+		}
+	    }
+            $activator configure -cursor sb_h_double_arrow 
+            grid $frame -column [expr {2*$num-1}] -row 0 -sticky ns
+            grid columnconfigure $path [expr {2*$num-1}] -weight 0
+        } else {
+            place $sep -x 0 -rely 0.5 -height $sepsize -relwidth 1.0 -anchor w
+	    if { $placeButton } {
+		if {[string equal $side "left"]} {
+		    place $but -rely 0.5 -x [expr {6+$wbut/2}] -anchor c
+		} else {
+		    place $but -rely 0.5 -relx 1.0 -x [expr {-6-$wbut/2}] \
+			    -anchor c
+		}
+	    }
+            $activator configure -cursor sb_v_double_arrow 
+            grid $frame -row [expr {2*$num-1}] -column 0 -sticky ew
+            grid rowconfigure $path [expr {2*$num-1}] -weight 0
+        }
+        bind $activator <ButtonPress-1> \
+	    [list PanedWindow::_beg_move_sash $path $num %X %Y]
+    } else {
+        if { [string equal $side "top"] || \
+		[string equal $side "bottom"] } {
+            grid rowconfigure $path 0 -weight 1
+        } else {
+            grid columnconfigure $path 0 -weight 1
+        }
+    }
+
+    set pane [frame $path.f$num -bd 0 -relief flat \
+	    -highlightthickness 0 -bg $bg]
+    set user [frame $path.f$num.frame  -bd 0 -relief flat \
+	    -highlightthickness 0 -bg $bg]
+    if { [string equal $side "top"] || [string equal $side "bottom"] } {
+        grid $pane -column [expr {2*$num}] -row 0 -sticky nsew
+        grid columnconfigure $path [expr {2*$num}] -weight $weight
+    } else {
+        grid $pane -row [expr {2*$num}] -column 0 -sticky nsew
+        grid rowconfigure $path [expr {2*$num}] -weight $weight
+    }
+    pack $user -fill both -expand yes
+    incr _panedw($path,nbpanes)
+    if {$_panedw($path,configuredone)} {
+	_realize $path [winfo width $path] [winfo height $path]
+    }
+
+    return $user
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command PanedWindow::getframe
+# ----------------------------------------------------------------------------
+proc PanedWindow::getframe { path index } {
+    if { [winfo exists $path.f$index.frame] } {
+        return $path.f$index.frame
+    }
+}
+    
+
+# ----------------------------------------------------------------------------
+#  Command PanedWindow::_beg_move_sash
+# ----------------------------------------------------------------------------
+proc PanedWindow::_beg_move_sash { path num x y } {
+    variable _panedw
+
+    set fprev $path.f[expr {$num-1}]
+    set fnext $path.f$num
+    set wsash [expr {[Widget::getoption $path -width] + 2*[Widget::getoption $path -pad]}]
+
+    $path.sash$num.but configure -relief sunken
+    set top  [toplevel $path.sash -borderwidth 1 -relief raised]
+
+    set minszg [Widget::getoption $fprev -minsize]
+    set minszd [Widget::getoption $fnext -minsize]
+    set side   [Widget::getoption $path -side]
+
+    if { [string equal $side "top"] || [string equal $side "bottom"] } {
+        $top configure -cursor sb_h_double_arrow
+        set h    [winfo height $path]
+        set yr   [winfo rooty $path.sash$num]
+        set xmin [expr {$wsash/2+[winfo rootx $fprev]+$minszg}]
+        set xmax [expr {-$wsash/2-1+[winfo rootx $fnext]+[winfo width $fnext]-$minszd}]
+        wm overrideredirect $top 1
+        wm geom $top "2x${h}+$x+$yr"
+
+        update idletasks
+        grab set $top
+        bind $top <ButtonRelease-1> [list PanedWindow::_end_move_sash $path $top $num $xmin $xmax %X rootx width]
+        bind $top <Motion>          [list PanedWindow::_move_sash $top $xmin $xmax %X +%%d+$yr]
+        _move_sash $top $xmin $xmax $x "+%d+$yr"
+    } else {
+        $top configure -cursor sb_v_double_arrow
+        set w    [winfo width $path]
+        set xr   [winfo rootx $path.sash$num]
+        set ymin [expr {$wsash/2+[winfo rooty $fprev]+$minszg}]
+        set ymax [expr {-$wsash/2-1+[winfo rooty $fnext]+[winfo height $fnext]-$minszd}]
+        wm overrideredirect $top 1
+        wm geom $top "${w}x2+$xr+$y"
+
+        update idletasks
+        grab set $top
+        bind $top <ButtonRelease-1> [list PanedWindow::_end_move_sash \
+		$path $top $num $ymin $ymax %Y rooty height]
+        bind $top <Motion>          [list PanedWindow::_move_sash \
+		$top $ymin $ymax %Y +$xr+%%d]
+        _move_sash $top $ymin $ymax $y "+$xr+%d"
+    }
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command PanedWindow::_move_sash
+# ----------------------------------------------------------------------------
+proc PanedWindow::_move_sash { top min max v form } {
+
+    if { $v < $min } {
+	set v $min
+    } elseif { $v > $max } {
+	set v $max
+    }
+    wm geom $top [format $form $v]
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command PanedWindow::_end_move_sash
+# ----------------------------------------------------------------------------
+proc PanedWindow::_end_move_sash { path top num min max v rootv size } {
+    variable _panedw
+
+    destroy $top
+    if { $v < $min } {
+	set v $min
+    } elseif { $v > $max } {
+	set v $max
+    }
+    set fprev $path.f[expr {$num-1}]
+    set fnext $path.f$num
+
+    $path.sash$num.but configure -relief raised
+
+    set wsash [expr {[Widget::getoption $path -width] + 2*[Widget::getoption $path -pad]}]
+    set dv    [expr {$v-[winfo $rootv $path.sash$num]-$wsash/2}]
+    set w1    [winfo $size $fprev]
+    set w2    [winfo $size $fnext]
+
+    for {set i 0} {$i < $_panedw($path,nbpanes)} {incr i} {
+        if { $i == $num-1} {
+            $fprev configure -$size [expr {[winfo $size $fprev]+$dv}]
+        } elseif { $i == $num } {
+            $fnext configure -$size [expr {[winfo $size $fnext]-$dv}]
+        } else {
+            $path.f$i configure -$size [winfo $size $path.f$i]
+        }
+    }
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command PanedWindow::_realize
+# ----------------------------------------------------------------------------
+proc PanedWindow::_realize { path width height } {
+    variable _panedw
+
+    set x    0
+    set y    0
+    set hc   [winfo reqheight $path]
+    set hmax 0
+    for {set i 0} {$i < $_panedw($path,nbpanes)} {incr i} {
+        $path.f$i configure \
+            -width  [winfo reqwidth  $path.f$i.frame] \
+            -height [winfo reqheight $path.f$i.frame]
+        place $path.f$i.frame -x 0 -y 0 -relwidth 1 -relheight 1
+    }
+
+    bind $path <Configure> {}
+
+    _apply_weights $path
+    set _panedw($path,configuredone) 1
+    return
+}
+
+# ----------------------------------------------------------------------------
+#  Command PanedWindow::_apply_weights
+# ----------------------------------------------------------------------------
+proc PanedWindow::_apply_weights { path } {
+    variable _panedw
+
+    set weights [Widget::getoption $path -weights]
+    if {[string equal $weights "extra"]} {
+	return
+    }
+
+    set side   [Widget::getoption $path -side]
+    if {[string equal $side "top"] || [string equal $side "bottom"] } {
+	set size width
+    } else {
+	set size height
+    }
+    set wsash [expr {[Widget::getoption $path -width] + 2*[Widget::getoption $path -pad]}]
+    set rs [winfo $size $path]
+    set s [expr {$rs - ($_panedw($path,nbpanes) - 1) * $wsash}]
+    
+    set tw 0.0
+    foreach w $_panedw($path,weights) { 
+	set tw [expr {$tw + $w}]
+    }
+
+    for {set i 0} {$i < $_panedw($path,nbpanes)} {incr i} {
+	set rw [lindex $_panedw($path,weights) $i]
+	set ps [expr {int($rw / $tw * $s)}]
+	$path.f$i configure -$size $ps
+    }    
+    return
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command PanedWindow::_destroy
+# ----------------------------------------------------------------------------
+proc PanedWindow::_destroy { path } {
+    variable _panedw
+
+    for {set i 0} {$i < $_panedw($path,nbpanes)} {incr i} {
+        Widget::destroy $path.f$i
+    }
+    unset _panedw($path,nbpanes)
+    Widget::destroy $path
+}