arcadia 0.1.1 → 0.1.2

data/tcl/BWidget-1.8.0/progressbar.tcl

@@ -0,0 +1,208 @@
+# ----------------------------------------------------------------------------
+#  progressbar.tcl
+#  This file is part of Unifix BWidget Toolkit
+# ----------------------------------------------------------------------------
+#  Index of commands:
+#     - ProgressBar::create
+#     - ProgressBar::configure
+#     - ProgressBar::cget
+#     - ProgressBar::_destroy
+#     - ProgressBar::_modify
+# ----------------------------------------------------------------------------
+
+namespace eval ProgressBar {
+    Widget::define ProgressBar progressbar
+
+    Widget::declare ProgressBar {
+        {-type        Enum       normal     0
+                      {normal incremental infinite nonincremental_infinite}}
+        {-maximum     Int        100        0 "%d > 0"}
+        {-background  TkResource ""         0 frame}
+        {-foreground  TkResource "blue"     0 label}
+        {-borderwidth TkResource 2          0 frame}
+        {-troughcolor TkResource ""         0 scrollbar}
+        {-relief      TkResource sunken     0 label}
+        {-orient      Enum       horizontal 1 {horizontal vertical}}
+        {-variable    String     ""         0}
+        {-idle        Boolean    0          0}
+        {-width       TkResource 100        0 frame}
+        {-height      TkResource 4m         0 frame}
+        {-bg          Synonym    -background}
+        {-fg          Synonym    -foreground}
+        {-bd          Synonym    -borderwidth}
+    }
+
+    Widget::addmap ProgressBar "" :cmd {-background {} -width {} -height {}}
+    Widget::addmap ProgressBar "" .bar {
+	-troughcolor -background -borderwidth {} -relief {}
+    }
+
+    variable _widget
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command ProgressBar::create
+# ----------------------------------------------------------------------------
+proc ProgressBar::create { path args } {
+    variable _widget
+
+    array set maps [list ProgressBar {} :cmd {} .bar {}]
+    array set maps [Widget::parseArgs ProgressBar $args]
+    eval frame $path $maps(:cmd) -class ProgressBar -bd 0 \
+	    -highlightthickness 0 -relief flat
+    Widget::initFromODB ProgressBar $path $maps(ProgressBar)
+
+    set c  [eval [list canvas $path.bar] $maps(.bar) -highlightthickness 0]
+    set fg [Widget::cget $path -foreground]
+    if { [string equal [Widget::cget $path -orient] "horizontal"] } {
+        $path.bar create rectangle -1 0 0 0 -fill $fg -outline $fg -tags rect
+    } else {
+        $path.bar create rectangle 0 1 0 0 -fill $fg -outline $fg -tags rect
+    }
+
+    set _widget($path,val) 0
+    set _widget($path,dir) 1
+    set _widget($path,var) [Widget::cget $path -variable]
+    if {$_widget($path,var) != ""} {
+        GlobalVar::tracevar variable $_widget($path,var) w \
+		[list ProgressBar::_modify $path]
+        set _widget($path,afterid) \
+	    [after idle [list ProgressBar::_modify $path]]
+    }
+
+    bind $path.bar <Destroy>   [list ProgressBar::_destroy $path]
+    bind $path.bar <Configure> [list ProgressBar::_modify $path]
+
+    return [Widget::create ProgressBar $path]
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command ProgressBar::configure
+# ----------------------------------------------------------------------------
+proc ProgressBar::configure { path args } {
+    variable _widget
+
+    set res [Widget::configure $path $args]
+
+    if { [Widget::hasChangedX $path -variable] } {
+	set newv [Widget::cget $path -variable]
+        if { $_widget($path,var) != "" } {
+            GlobalVar::tracevar vdelete $_widget($path,var) w \
+		    [list ProgressBar::_modify $path]
+        }
+        if { $newv != "" } {
+            set _widget($path,var) $newv
+            GlobalVar::tracevar variable $newv w \
+		    [list ProgressBar::_modify $path]
+	    if {![info exists _widget($path,afterid)]} {
+		set _widget($path,afterid) \
+		    [after idle [list ProgressBar::_modify $path]]
+	    }
+        } else {
+            set _widget($path,var) ""
+        }
+    }
+
+    foreach {cbd cor cma} [Widget::hasChangedX $path -borderwidth \
+	    -orient -maximum] break
+
+    if { $cbd || $cor || $cma } {
+	if {![info exists _widget($path,afterid)]} {
+	    set _widget($path,afterid) \
+		[after idle [list ProgressBar::_modify $path]]
+	}
+    }
+    if { [Widget::hasChangedX $path -foreground] } {
+	set fg [Widget::cget $path -foreground]
+        $path.bar itemconfigure rect -fill $fg -outline $fg
+    }
+    return $res
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command ProgressBar::cget
+# ----------------------------------------------------------------------------
+proc ProgressBar::cget { path option } {
+    return [Widget::cget $path $option]
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command ProgressBar::_modify
+# ----------------------------------------------------------------------------
+proc ProgressBar::_modify { path args } {
+    variable _widget
+
+    catch {unset _widget($path,afterid)}
+    if { ![GlobalVar::exists $_widget($path,var)] ||
+	 [set val [GlobalVar::getvar $_widget($path,var)]] < 0 } {
+        catch {place forget $path.bar}
+    } else {
+	place $path.bar -relx 0 -rely 0 -relwidth 1 -relheight 1
+	set type [Widget::getoption $path -type]
+	if { $val != 0 && $type != "normal" && \
+		$type != "nonincremental_infinite"} {
+	    set val [expr {$val+$_widget($path,val)}]
+	}
+	set _widget($path,val) $val
+	set max [Widget::getoption $path -maximum]
+	set bd  [expr {2*[$path.bar cget -bd]}]
+	set w   [winfo width  $path.bar]
+	set h   [winfo height $path.bar]
+	if {$type == "infinite" || $type == "nonincremental_infinite"} {
+	    # JDC: New infinite behaviour
+	    set tval [expr {$val % $max}]
+	    if { $tval < ($max / 2.0) } {
+		set x0 [expr {double($tval) / double($max) * 1.5}]
+	    } else {
+		set x0 [expr {(1.0-(double($tval) / double($max))) * 1.5}]
+	    }
+	    set x1 [expr {$x0 + 0.25}]
+	    # convert coords to ints to prevent triggering canvas refresh
+	    # bug related to fractional coords
+	    if {[Widget::getoption $path -orient] == "horizontal"} {
+		$path.bar coords rect [expr {int($x0*$w)}] 0 \
+		    [expr {int($x1*$w)}] $h
+	    } else {
+		$path.bar coords rect 0 [expr {int($h-$x0*$h)}] $w \
+		    [expr {int($x1*$h)}]
+	    }
+	} else {
+	    if { $val > $max } {set val $max}
+	    if {[Widget::getoption $path -orient] == "horizontal"} {
+		$path.bar coords rect -1 0 [expr {int(double($val)*$w/$max)}] $h
+	    } else {
+		$path.bar coords rect 0 [expr {$h+1}] $w \
+		    [expr {int($h*(1.0 - double($val)/$max))}]
+	    }
+	}
+    }
+    if {![Widget::cget $path -idle]} {
+	update idletasks
+    }
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command ProgressBar::_destroy
+# ----------------------------------------------------------------------------
+proc ProgressBar::_destroy { path } {
+    variable _widget
+
+    if {[info exists _widget($path,afterid)]} {
+	after cancel $_widget($path,afterid)
+	unset _widget($path,afterid)
+    }
+    if {[info exists _widget($path,var)]} {
+	if {$_widget($path,var) != ""} {
+	    GlobalVar::tracevar vdelete $_widget($path,var) w \
+		[list ProgressBar::_modify $path]
+	}
+	unset _widget($path,var)
+    }
+    unset _widget($path,dir)
+    Widget::destroy $path
+}

data/tcl/BWidget-1.8.0/progressdlg.tcl

@@ -0,0 +1,87 @@
+# ----------------------------------------------------------------------------
+#  progressdlg.tcl
+#  This file is part of Unifix BWidget Toolkit
+# ----------------------------------------------------------------------------
+#  Index of commands:
+#     - ProgressDlg::create
+# ----------------------------------------------------------------------------
+
+namespace eval ProgressDlg {
+    Widget::define ProgressDlg progressdlg Dialog ProgressBar
+
+    Widget::bwinclude ProgressDlg Dialog :cmd \
+        remove {
+            -modal -image -bitmap -side -anchor -cancel -default
+            -homogeneous -padx -pady -spacing
+        }
+
+    Widget::bwinclude ProgressDlg ProgressBar .frame.pb \
+        remove {-orient -width -height}
+
+    Widget::declare ProgressDlg {
+        {-width        TkResource 25 0 label}
+        {-height       TkResource 2  0 label}
+        {-textvariable TkResource "" 0 label}
+        {-font         TkResource "" 0 label}
+        {-stop         String "" 0}
+        {-command      String "" 0}
+    }
+
+    Widget::addmap ProgressDlg :cmd .frame.msg \
+        {-width {} -height {} -textvariable {} -font {} -background {}}
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command ProgressDlg::create
+# ----------------------------------------------------------------------------
+proc ProgressDlg::create { path args } {
+    array set maps [list ProgressDlg {} :cmd {} .frame.msg {} .frame.pb {}]
+    array set maps [Widget::parseArgs ProgressDlg $args]
+
+    eval [list Dialog::create] $path $maps(:cmd) \
+	[list -image [Bitmap::get hourglass] \
+	     -modal none -side bottom -anchor e -class ProgressDlg]
+
+    Widget::initFromODB ProgressDlg "$path#ProgressDlg" $maps(ProgressDlg)
+
+    wm protocol $path WM_DELETE_WINDOW {;}
+
+    set frame [Dialog::getframe $path]
+    bind $frame <Destroy> [list Widget::destroy $path\#ProgressDlg]
+    $frame configure -cursor watch
+
+    eval [list label $frame.msg] $maps(.frame.msg) \
+	-relief flat -borderwidth 0 \
+	    -highlightthickness 0 -anchor w -justify left
+    pack $frame.msg -side top -pady 3m -anchor nw -fill x -expand yes
+
+    eval [list ProgressBar::create] $frame.pb $maps(.frame.pb) -width 100
+    pack $frame.pb -side bottom -anchor w -fill x -expand yes
+
+    set stop [Widget::cget "$path#ProgressDlg" -stop]
+    set cmd  [Widget::cget "$path#ProgressDlg" -command]
+    if { $stop != "" && $cmd != "" } {
+        Dialog::add $path -text $stop -name $stop -command $cmd
+    }
+    Dialog::draw $path
+    BWidget::grab local $path
+
+    return [Widget::create ProgressDlg $path 0]
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command ProgressDlg::configure
+# ----------------------------------------------------------------------------
+proc ProgressDlg::configure { path args } {
+    return [Widget::configure "$path#ProgressDlg" $args]
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command ProgressDlg::cget
+# ----------------------------------------------------------------------------
+proc ProgressDlg::cget { path option } {
+    return [Widget::cget "$path#ProgressDlg" $option]
+}

data/tcl/BWidget-1.8.0/scrollframe.tcl

@@ -0,0 +1,226 @@
+# ----------------------------------------------------------------------------
+#  scrollframe.tcl
+#  This file is part of Unifix BWidget Toolkit
+#  $Id: scrollframe.tcl,v 1.7 2005/07/28 00:40:42 hobbs Exp $
+# ----------------------------------------------------------------------------
+#  Index of commands:
+#     - ScrollableFrame::create
+#     - ScrollableFrame::configure
+#     - ScrollableFrame::cget
+#     - ScrollableFrame::getframe
+#     - ScrollableFrame::see
+#     - ScrollableFrame::xview
+#     - ScrollableFrame::yview
+#     - ScrollableFrame::_resize
+# ----------------------------------------------------------------------------
+
+namespace eval ScrollableFrame {
+    Widget::define ScrollableFrame scrollframe
+
+    Widget::declare ScrollableFrame {
+        {-background        TkResource "" 0 frame}
+        {-width             Int        0  0 {}}
+        {-height            Int        0  0 {}}
+        {-areawidth         Int        0  0 {}}
+        {-areaheight        Int        0  0 {}}
+        {-constrainedwidth  Boolean    0 0}
+        {-constrainedheight Boolean    0 0}
+        {-xscrollcommand    TkResource "" 0 canvas}
+        {-yscrollcommand    TkResource "" 0 canvas}
+        {-xscrollincrement  TkResource "" 0 canvas}
+        {-yscrollincrement  TkResource "" 0 canvas}
+        {-bg                Synonym    -background}
+    }
+
+    Widget::addmap ScrollableFrame "" :cmd {
+        -background {} -width {} -height {} 
+        -xscrollcommand {} -yscrollcommand {}
+        -xscrollincrement {} -yscrollincrement {}
+    }
+    Widget::addmap ScrollableFrame "" .frame {-background {}}
+
+    variable _widget
+
+    bind BwScrollableFrame <Configure> [list ScrollableFrame::_resize %W]
+    bind BwScrollableFrame <Destroy>   [list Widget::destroy %W]
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command ScrollableFrame::create
+# ----------------------------------------------------------------------------
+proc ScrollableFrame::create { path args } {
+    Widget::init ScrollableFrame $path $args
+
+    set canvas [eval [list canvas $path] [Widget::subcget $path :cmd] \
+                    -highlightthickness 0 -borderwidth 0 -relief flat]
+
+    if {[Widget::theme]} {
+	set frame [eval [list ttk::frame $path.frame] \
+		       [Widget::subcget $path .frame]]
+    } else {
+	set frame [eval [list frame $path.frame] \
+		       [Widget::subcget $path .frame] \
+		       -highlightthickness 0 -borderwidth 0 -relief flat]
+    }
+
+    $canvas create window 0 0 -anchor nw -window $frame -tags win \
+        -width  [Widget::cget $path -areawidth] \
+        -height [Widget::cget $path -areaheight]
+
+    bind $frame <Configure> \
+	    [list ScrollableFrame::_frameConfigure $canvas $frame %w %h]
+    bindtags $path [list $path BwScrollableFrame [winfo toplevel $path] all]
+
+    return [Widget::create ScrollableFrame $path]
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command ScrollableFrame::configure
+# ----------------------------------------------------------------------------
+proc ScrollableFrame::configure { path args } {
+    set res [Widget::configure $path $args]
+    set upd 0
+
+    set modcw [Widget::hasChanged $path -constrainedwidth cw]
+    set modw  [Widget::hasChanged $path -areawidth w]
+    if { $modcw || (!$cw && $modw) } {
+        if { $cw } {
+            set w [winfo width $path]
+        }
+        set upd 1
+    }
+
+    set modch [Widget::hasChanged $path -constrainedheight ch]
+    set modh  [Widget::hasChanged $path -areaheight h]
+    if { $modch || (!$ch && $modh) } {
+        if { $ch } {
+            set h [winfo height $path]
+        }
+        set upd 1
+    }
+
+    if { $upd } {
+        $path:cmd itemconfigure win -width $w -height $h
+    }
+    return $res
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command ScrollableFrame::cget
+# ----------------------------------------------------------------------------
+proc ScrollableFrame::cget { path option } {
+    return [Widget::cget $path $option]
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command ScrollableFrame::getframe
+# ----------------------------------------------------------------------------
+proc ScrollableFrame::getframe { path } {
+    return $path.frame
+}
+
+# ----------------------------------------------------------------------------
+#  Command ScrollableFrame::see
+# ----------------------------------------------------------------------------
+proc ScrollableFrame::see { path widget {vert top} {horz left} {xOffset 0} {yOffset 0}} {
+    set x0  [winfo x $widget]
+    set y0  [winfo y $widget]
+    set x1  [expr {$x0+[winfo width  $widget]}]
+    set y1  [expr {$y0+[winfo height $widget]}]
+    set xb0 [$path:cmd canvasx 0]
+    set yb0 [$path:cmd canvasy 0]
+    set xb1 [$path:cmd canvasx [winfo width  $path]]
+    set yb1 [$path:cmd canvasy [winfo height $path]]
+    set dx  0
+    set dy  0
+    
+    if { [string equal $horz "left"] } {
+	if { $x1 > $xb1 } {
+	    set dx [expr {$x1-$xb1}]
+	}
+	if { $x0 < $xb0+$dx } {
+	    set dx [expr {$x0-$xb0}]
+	}
+    } elseif { [string equal $horz "right"] } {
+	if { $x0 < $xb0 } {
+	    set dx [expr {$x0-$xb0}]
+	}
+	if { $x1 > $xb1+$dx } {
+	    set dx [expr {$x1-$xb1}]
+	}
+    }
+
+    if { [string equal $vert "top"] } {
+	if { $y1 > $yb1 } {
+	    set dy [expr {$y1-$yb1}]
+	}
+	if { $y0 < $yb0+$dy } {
+	    set dy [expr {$y0-$yb0}]
+	}
+    } elseif { [string equal $vert "bottom"] } {
+	if { $y0 < $yb0 } {
+	    set dy [expr {$y0-$yb0}]
+	}
+	if { $y1 > $yb1+$dy } {
+	    set dy [expr {$y1-$yb1}]
+	}
+    }
+
+    if {($dx + $xOffset) != 0} {
+	set x [expr {($xb0+$dx+$xOffset)/[winfo width $path.frame]}]
+	$path:cmd xview moveto $x
+    }
+    if {($dy + $yOffset) != 0} {
+	set y [expr {($yb0+$dy+$yOffset)/[winfo height $path.frame]}]
+	$path:cmd yview moveto $y
+    }
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command ScrollableFrame::xview
+# ----------------------------------------------------------------------------
+proc ScrollableFrame::xview { path args } {
+    return [eval [list $path:cmd xview] $args]
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command ScrollableFrame::yview
+# ----------------------------------------------------------------------------
+proc ScrollableFrame::yview { path args } {
+    return [eval [list $path:cmd yview] $args]
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command ScrollableFrame::_resize
+# ----------------------------------------------------------------------------
+proc ScrollableFrame::_resize { path } {
+    if { [Widget::getoption $path -constrainedwidth] } {
+        $path:cmd itemconfigure win -width [winfo width $path]
+    }
+    if { [Widget::getoption $path -constrainedheight] } {
+        $path:cmd itemconfigure win -height [winfo height $path]
+    }
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command ScrollableFrame::_frameConfigure
+# ----------------------------------------------------------------------------
+proc ScrollableFrame::_frameConfigure {canvas frame width height} {
+    # This ensures that we don't get funny scrollability in the frame
+    # when it is smaller than the canvas space
+    if {[winfo height $frame] < [winfo height $canvas]} {
+	set height [winfo height $canvas]
+    }
+    if {[winfo width $frame] < [winfo width $canvas]} {
+	set width [winfo width $canvas]
+    }
+    $canvas:cmd configure -scrollregion [list 0 0 $width $height]
+}