arcadia 0.1.1 → 0.1.2

data/tcl/BWidget-1.8.0/scrollview.tcl

@@ -0,0 +1,254 @@
+# ------------------------------------------------------------------------------
+#  scrollview.tcl
+#  This file is part of Unifix BWidget Toolkit
+#  $Id: scrollview.tcl,v 1.7 2003/11/05 18:04:29 hobbs Exp $
+# ------------------------------------------------------------------------------
+#  Index of commands:
+#     - ScrolledWindow::create
+#     - ScrolledWindow::configure
+#     - ScrolledWindow::cget
+#     - ScrolledWindow::_set_hscroll
+#     - ScrolledWindow::_set_vscroll
+#     - ScrolledWindow::_update_scroll
+#     - ScrolledWindow::_set_view
+#     - ScrolledWindow::_resize
+# ------------------------------------------------------------------------------
+
+namespace eval ScrollView {
+    Widget::define ScrollView scrollview
+
+    Widget::tkinclude ScrollView canvas :cmd \
+	    include {-relief -borderwidth -background -width -height -cursor} \
+	    initialize {-relief flat -borderwidth 0 -width 30 -height 30 \
+		-cursor crosshair}
+
+    Widget::declare ScrollView {
+        {-width       TkResource 30        0 canvas}
+        {-height      TkResource 30        0 canvas}
+        {-background  TkResource ""        0 canvas}
+        {-foreground  String     black     0}
+        {-fill        String     ""        0}
+        {-relief      TkResource flat      0 canvas}
+        {-borderwidth TkResource 0         0 canvas}
+        {-cursor      TkResource crosshair 0 canvas}
+        {-window      String     ""        0}
+        {-fg          Synonym    -foreground}
+        {-bg          Synonym    -background}
+        {-bd          Synonym    -borderwidth}
+    }
+
+    bind BwScrollView <B1-Motion>   [list ScrollView::_set_view %W motion %x %y]
+    bind BwScrollView <ButtonPress-1> [list ScrollView::_set_view %W set %x %y]
+    bind BwScrollView <Configure>     [list ScrollView::_resize %W]
+    bind BwScrollView <Destroy>       [list ScrollView::_destroy %W]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ScrollView::create
+# ------------------------------------------------------------------------------
+proc ScrollView::create { path args } {
+    Widget::init ScrollView $path $args
+    eval [list canvas $path] [Widget::subcget $path :cmd] -highlightthickness 0
+
+    Widget::create ScrollView $path
+
+    Widget::getVariable $path _widget
+
+    set w               [Widget::cget $path -window]
+    set _widget(bd)     [Widget::cget $path -borderwidth]
+    set _widget(width)  [Widget::cget $path -width]
+    set _widget(height) [Widget::cget $path -height]
+
+    if {[winfo exists $w]} {
+        set _widget(oldxscroll) [$w cget -xscrollcommand]
+        set _widget(oldyscroll) [$w cget -yscrollcommand]
+        $w configure \
+            -xscrollcommand [list ScrollView::_set_hscroll $path] \
+            -yscrollcommand [list ScrollView::_set_vscroll $path]
+    }
+    $path:cmd create rectangle -2 -2 -2 -2 \
+        -fill    [Widget::cget $path -fill]       \
+        -outline [Widget::cget $path -foreground] \
+        -tags    view
+
+    bindtags $path [list $path BwScrollView [winfo toplevel $path] all]
+
+    return $path
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ScrollView::configure
+# ------------------------------------------------------------------------------
+proc ScrollView::configure { path args } {
+    Widget::getVariable $path _widget
+
+    set oldw [Widget::getoption $path -window] 
+    set res  [Widget::configure $path $args]
+
+    if { [Widget::hasChanged $path -window w] } {
+        if { [winfo exists $oldw] } {
+            $oldw configure \
+                -xscrollcommand $_widget(oldxscroll) \
+                -yscrollcommand $_widget(oldyscroll)
+        }
+        if { [winfo exists $w] } {
+            set _widget(oldxscroll) [$w cget -xscrollcommand]
+            set _widget(oldyscroll) [$w cget -yscrollcommand]
+            $w configure \
+                -xscrollcommand [list ScrollView::_set_hscroll $path] \
+                -yscrollcommand [list ScrollView::_set_vscroll $path]
+        } else {
+            $path:cmd coords view -2 -2 -2 -2
+            set _widget(oldxscroll) {}
+            set _widget(oldyscroll) {}
+        }
+    }
+
+    if { [Widget::hasChanged $path -fill fill] |
+         [Widget::hasChanged $path -foreground fg] } {
+        $path:cmd itemconfigure view \
+            -fill    $fill \
+            -outline $fg
+    }
+
+    return $res
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ScrollView::cget
+# ------------------------------------------------------------------------------
+proc ScrollView::cget { path option } {
+    return [Widget::cget $path $option]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ScrollView::_set_hscroll
+# ------------------------------------------------------------------------------
+proc ScrollView::_set_hscroll { path vmin vmax } {
+    Widget::getVariable $path _widget
+
+    set c  [$path:cmd coords view]
+    set x0 [expr {$vmin*$_widget(width)+$_widget(bd)}]
+    set x1 [expr {$vmax*$_widget(width)+$_widget(bd)-1}]
+    $path:cmd coords view $x0 [lindex $c 1] $x1 [lindex $c 3]
+    if { $_widget(oldxscroll) != "" } {
+        uplevel \#0 $_widget(oldxscroll) $vmin $vmax
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ScrollView::_set_vscroll
+# ------------------------------------------------------------------------------
+proc ScrollView::_set_vscroll { path vmin vmax } {
+    Widget::getVariable $path _widget
+
+    set c  [$path:cmd coords view]
+    set y0 [expr {$vmin*$_widget(height)+$_widget(bd)}]
+    set y1 [expr {$vmax*$_widget(height)+$_widget(bd)-1}]
+    $path:cmd coords view [lindex $c 0] $y0 [lindex $c 2] $y1
+    if { $_widget(oldyscroll) != "" } {
+        uplevel \#0 $_widget(oldyscroll) $vmin $vmax
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ScrollView::_update_scroll
+# ------------------------------------------------------------------------------
+proc ScrollView::_update_scroll { path callscroll hminmax vminmax } {
+    Widget::getVariable $path _widget
+
+    set c    [$path:cmd coords view]
+    set hmin [lindex $hminmax 0]
+    set hmax [lindex $hminmax 1]
+    set vmin [lindex $vminmax 0]
+    set vmax [lindex $vminmax 1]
+    set x0   [expr {$hmin*$_widget(width)+$_widget(bd)}]
+    set x1   [expr {$hmax*$_widget(width)+$_widget(bd)-1}]
+    set y0   [expr {$vmin*$_widget(height)+$_widget(bd)}]
+    set y1   [expr {$vmax*$_widget(height)+$_widget(bd)-1}]
+    $path:cmd coords view $x0 $y0 $x1 $y1
+    if { $callscroll } {
+        if { $_widget(oldxscroll) != "" } {
+            uplevel \#0 $_widget(oldxscroll) $hmin $hmax
+        }
+        if { $_widget(oldyscroll) != "" } {
+            uplevel \#0 $_widget(oldyscroll) $vmin $vmax
+        }
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ScrollView::_set_view
+# ------------------------------------------------------------------------------
+proc ScrollView::_set_view { path cmd x y } {
+    Widget::getVariable $path _widget
+
+    set w [Widget::getoption $path -window]
+    if {[winfo exists $w]} {
+        if {[string equal $cmd "set"]} {
+            set c  [$path:cmd coords view]
+            set x0 [lindex $c 0]
+            set y0 [lindex $c 1]
+            set x1 [lindex $c 2]
+            set y1 [lindex $c 3]
+            if {$x >= $x0 && $x <= $x1 &&
+                $y >= $y0 && $y <= $y1} {
+                set _widget(dx) [expr {$x-$x0}]
+                set _widget(dy) [expr {$y-$y0}]
+                return
+            } else {
+                set x0 [expr {$x-($x1-$x0)/2}]
+                set y0 [expr {$y-($y1-$y0)/2}]
+                set _widget(dx) [expr {$x-$x0}]
+                set _widget(dy) [expr {$y-$y0}]
+                set vh [expr {double($x0-$_widget(bd))/$_widget(width)}]
+                set vv [expr {double($y0-$_widget(bd))/$_widget(height)}]
+            }
+        } elseif {[string equal $cmd "motion"]} {
+            set vh [expr {double($x-$_widget(dx)-$_widget(bd))/$_widget(width)}]
+            set vv [expr {double($y-$_widget(dy)-$_widget(bd))/$_widget(height)}]
+        }
+        $w xview moveto $vh
+        $w yview moveto $vv
+        _update_scroll $path 1 [$w xview] [$w yview]
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ScrollView::_resize
+# ------------------------------------------------------------------------------
+proc ScrollView::_resize { path } {
+    Widget::getVariable $path _widget
+
+    set _widget(bd)     [Widget::getoption $path -borderwidth]
+    set _widget(width)  [expr {[winfo width  $path]-2*$_widget(bd)}]
+    set _widget(height) [expr {[winfo height $path]-2*$_widget(bd)}]
+    set w [Widget::getoption $path -window]
+    if { [winfo exists $w] } {
+        _update_scroll $path 0 [$w xview] [$w yview]
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ScrollView::_destroy
+# ------------------------------------------------------------------------------
+proc ScrollView::_destroy { path } {
+    Widget::getVariable $path _widget
+
+    set w [Widget::getoption $path -window] 
+    if { [winfo exists $w] } {
+        $w configure \
+            -xscrollcommand $_widget(oldxscroll) \
+            -yscrollcommand $_widget(oldyscroll)
+    }
+    Widget::destroy $path
+}

data/tcl/BWidget-1.8.0/scrollw.tcl

@@ -0,0 +1,280 @@
+# -----------------------------------------------------------------------------
+#  scrollw.tcl
+#  This file is part of Unifix BWidget Toolkit
+#  $Id: scrollw.tcl,v 1.12 2006/08/21 20:54:14 dev_null42a Exp $
+# -----------------------------------------------------------------------------
+#  Index of commands:
+#     - ScrolledWindow::create
+#     - ScrolledWindow::getframe
+#     - ScrolledWindow::setwidget
+#     - ScrolledWindow::configure
+#     - ScrolledWindow::cget
+#     - ScrolledWindow::_set_hframe
+#     - ScrolledWindow::_set_vscroll
+#     - ScrolledWindow::_setData
+#     - ScrolledWindow::_setSBSize
+#     - ScrolledWindow::_realize
+# -----------------------------------------------------------------------------
+
+namespace eval ScrolledWindow {
+    Widget::define ScrolledWindow scrollw
+
+    Widget::declare ScrolledWindow {
+	{-background  TkResource ""   0 button}
+	{-scrollbar   Enum	 both 0 {none both vertical horizontal}}
+	{-auto	      Enum	 both 0 {none both vertical horizontal}}
+	{-sides	      Enum	 se   0 {ne en nw wn se es sw ws}}
+	{-size	      Int	 0    1 "%d >= 0"}
+	{-ipad	      Int	 1    1 "%d >= 0"}
+	{-managed     Boolean	 1    1}
+	{-relief      TkResource flat 0 frame}
+	{-borderwidth TkResource 0    0 frame}
+	{-bg	      Synonym	 -background}
+	{-bd	      Synonym	 -borderwidth}
+    }
+
+    Widget::addmap ScrolledWindow "" :cmd {-relief {} -borderwidth {}}
+}
+
+
+# -----------------------------------------------------------------------------
+#  Command ScrolledWindow::create
+# -----------------------------------------------------------------------------
+proc ScrolledWindow::create { path args } {
+    Widget::init ScrolledWindow $path $args
+
+    Widget::getVariable $path data
+
+    set bg     [Widget::cget $path -background]
+    set sbsize [Widget::cget $path -size]
+    set sw     [eval [list frame $path \
+			  -relief flat -borderwidth 0 -background $bg \
+			  -highlightthickness 0 -takefocus 0] \
+		    [Widget::subcget $path :cmd]]
+
+    scrollbar $path.hscroll \
+	    -highlightthickness 0 -takefocus 0 \
+	    -orient	 horiz	\
+	    -relief	 sunken	\
+	    -bg	 $bg
+    scrollbar $path.vscroll \
+	    -highlightthickness 0 -takefocus 0 \
+	    -orient	 vert	\
+	    -relief	 sunken	\
+	    -bg	 $bg
+
+    set data(realized) 0
+
+    _setData $path \
+	    [Widget::cget $path -scrollbar] \
+	    [Widget::cget $path -auto] \
+	    [Widget::cget $path -sides]
+
+    if {[Widget::cget $path -managed]} {
+	set data(hsb,packed) $data(hsb,present)
+	set data(vsb,packed) $data(vsb,present)
+    } else {
+	set data(hsb,packed) 0
+	set data(vsb,packed) 0
+    }
+    if {$sbsize} {
+	$path.vscroll configure -width $sbsize
+	$path.hscroll configure -width $sbsize
+    } else {
+	set sbsize [$path.vscroll cget -width]
+    }
+    set data(ipad) [Widget::cget $path -ipad]
+
+    if {$data(hsb,packed)} {
+	grid $path.hscroll -column 1 -row $data(hsb,row) \
+		-sticky ew -ipady $data(ipad)
+    }
+    if {$data(vsb,packed)} {
+	grid $path.vscroll -column $data(vsb,column) -row 1 \
+		-sticky ns -ipadx $data(ipad)
+    }
+
+    grid columnconfigure $path 1 -weight 1
+    grid rowconfigure	 $path 1 -weight 1
+
+    bind $path <Configure> [list ScrolledWindow::_realize $path]
+    bind $path <Destroy>   [list ScrolledWindow::_destroy $path]
+
+    return [Widget::create ScrolledWindow $path]
+}
+
+
+# -----------------------------------------------------------------------------
+#  Command ScrolledWindow::getframe
+# -----------------------------------------------------------------------------
+proc ScrolledWindow::getframe { path } {
+    return $path
+}
+
+
+# -----------------------------------------------------------------------------
+#  Command ScrolledWindow::setwidget
+# -----------------------------------------------------------------------------
+proc ScrolledWindow::setwidget { path widget } {
+    Widget::getVariable $path data
+
+    if {[info exists data(widget)] && [winfo exists $data(widget)]
+	&& ![string equal $data(widget) $widget]} {
+	grid remove $data(widget)
+	$data(widget) configure -xscrollcommand "" -yscrollcommand ""
+    }
+    set data(widget) $widget
+    grid $widget -in $path -row 1 -column 1 -sticky news
+
+    $path.hscroll configure -command [list $widget xview]
+    $path.vscroll configure -command [list $widget yview]
+    $widget configure \
+	    -xscrollcommand [list ScrolledWindow::_set_hscroll $path] \
+	    -yscrollcommand [list ScrolledWindow::_set_vscroll $path]
+}
+
+
+# -----------------------------------------------------------------------------
+#  Command ScrolledWindow::configure
+# -----------------------------------------------------------------------------
+proc ScrolledWindow::configure { path args } {
+    Widget::getVariable $path data
+
+    set res [Widget::configure $path $args]
+    if { [Widget::hasChanged $path -background bg] } {
+	$path configure -background $bg
+	catch {$path.hscroll configure -background $bg}
+	catch {$path.vscroll configure -background $bg}
+    }
+
+    if {[Widget::hasChanged $path -scrollbar scrollbar] | \
+	    [Widget::hasChanged $path -auto	 auto]	| \
+	    [Widget::hasChanged $path -sides	 sides]} {
+	_setData $path $scrollbar $auto $sides
+	foreach {vmin vmax} [$path.hscroll get] { break }
+	set data(hsb,packed) [expr {$data(hsb,present) && \
+		(!$data(hsb,auto) || ($vmin != 0 || $vmax != 1))}]
+	foreach {vmin vmax} [$path.vscroll get] { break }
+	set data(vsb,packed) [expr {$data(vsb,present) && \
+		(!$data(vsb,auto) || ($vmin != 0 || $vmax != 1))}]
+
+	set data(ipad) [Widget::cget $path -ipad]
+
+	if {$data(hsb,packed)} {
+	    grid $path.hscroll -column 1 -row $data(hsb,row) \
+		-sticky ew -ipady $data(ipad)
+	} else {
+	    if {![info exists data(hlock)]} {
+		set data(hsb,packed) 0
+		grid remove $path.hscroll
+	    }
+	}
+	if {$data(vsb,packed)} {
+	    grid $path.vscroll -column $data(vsb,column) -row 1 \
+		-sticky ns -ipadx $data(ipad)
+	} else {
+	    if {![info exists data(hlock)]} {
+		set data(vsb,packed) 0
+		grid remove $path.vscroll
+	    }
+	}
+    }
+    return $res
+}
+
+
+# -----------------------------------------------------------------------------
+#  Command ScrolledWindow::cget
+# -----------------------------------------------------------------------------
+proc ScrolledWindow::cget { path option } {
+    return [Widget::cget $path $option]
+}
+
+
+# -----------------------------------------------------------------------------
+#  Command ScrolledWindow::_set_hscroll
+# -----------------------------------------------------------------------------
+proc ScrolledWindow::_set_hscroll { path vmin vmax } {
+    Widget::getVariable $path data
+
+    if {$data(realized) && $data(hsb,present)} {
+	if {$data(hsb,auto)} {
+	    if {$data(hsb,packed) && $vmin == 0 && $vmax == 1} {
+		if {![info exists data(hlock)]} {
+		    set data(hsb,packed) 0
+		    grid remove $path.hscroll
+		}
+	    } elseif {!$data(hsb,packed) && ($vmin != 0 || $vmax != 1)} {
+		set data(hsb,packed) 1
+		grid $path.hscroll -column 1 -row $data(hsb,row) \
+			-sticky ew -ipady $data(ipad)
+		set data(hlock) 1
+		update idletasks
+		unset data(hlock)
+	    }
+	}
+	$path.hscroll set $vmin $vmax
+    }
+}
+
+
+# -----------------------------------------------------------------------------
+#  Command ScrolledWindow::_set_vscroll
+# -----------------------------------------------------------------------------
+proc ScrolledWindow::_set_vscroll { path vmin vmax } {
+    Widget::getVariable $path data
+
+    if {$data(realized) && $data(vsb,present)} {
+	if {$data(vsb,auto)} {
+	    if {$data(vsb,packed) && $vmin == 0 && $vmax == 1} {
+		if {![info exists data(vlock)]} {
+		    set data(vsb,packed) 0
+		    grid remove $path.vscroll
+		}
+	    } elseif {!$data(vsb,packed) && ($vmin != 0 || $vmax != 1) } {
+		set data(vsb,packed) 1
+		grid $path.vscroll -column $data(vsb,column) -row 1 \
+			-sticky ns -ipadx $data(ipad)
+		set data(vlock) 1
+		update idletasks
+		unset data(vlock)
+	    }
+	}
+	$path.vscroll set $vmin $vmax
+    }
+}
+
+
+proc ScrolledWindow::_setData {path scrollbar auto sides} {
+    Widget::getVariable $path data
+
+    set sb    [lsearch {none horizontal vertical both} $scrollbar]
+    set auto  [lsearch {none horizontal vertical both} $auto]
+
+    set data(hsb,present)  [expr {($sb & 1) != 0}]
+    set data(hsb,auto)	   [expr {($auto & 1) != 0}]
+    set data(hsb,row)	   [expr {[string match *n* $sides] ? 0 : 2}]
+
+    set data(vsb,present)  [expr {($sb & 2) != 0}]
+    set data(vsb,auto)	   [expr {($auto & 2) != 0}]
+    set data(vsb,column)   [expr {[string match *w* $sides] ? 0 : 2}]
+}
+
+
+# -----------------------------------------------------------------------------
+#  Command ScrolledWindow::_realize
+# -----------------------------------------------------------------------------
+proc ScrolledWindow::_realize { path } {
+    Widget::getVariable $path data
+
+    bind $path <Configure> {}
+    set data(realized) 1
+}
+
+
+# -----------------------------------------------------------------------------
+#  Command ScrolledWindow::_destroy
+# -----------------------------------------------------------------------------
+proc ScrolledWindow::_destroy { path } {
+    Widget::destroy $path
+}