Pratt 1.5.6

data/pkgs/tile-0.8.2/library/progress.tcl

@@ -0,0 +1,51 @@
+#
+# progress.tcl,v 1.5 2006/01/16 15:34:09 jenglish Exp
+#
+# Tile widget set: progress bar utilities.
+#
+
+namespace eval ttk::progressbar {
+    variable Timers	;# Map: widget name -> after ID
+}
+
+# Autoincrement --
+#	Periodic callback procedure for autoincrement mode
+#
+proc ttk::progressbar::Autoincrement {pb steptime stepsize} {
+    variable Timers
+
+    if {![winfo exists $pb]} {
+    	# widget has been destroyed -- cancel timer
+	unset -nocomplain Timers($pb)
+	return
+    }
+
+    $pb step $stepsize
+
+    set Timers($pb) [after $steptime \
+    	[list ttk::progressbar::Autoincrement $pb $steptime $stepsize] ]
+}
+
+# ttk::progressbar::start --
+#	Start autoincrement mode.  Invoked by [$pb start] widget code.
+#
+proc ttk::progressbar::start {pb {steptime 50} {stepsize 1}} {
+    variable Timers
+    if {![info exists Timers($pb)]} {
+	Autoincrement $pb $steptime $stepsize
+    }
+}
+
+# ttk::progressbar::stop --
+#	Cancel autoincrement mode. Invoked by [$pb stop] widget code.
+#
+proc ttk::progressbar::stop {pb} {
+    variable Timers
+    if {[info exists Timers($pb)]} {
+	after cancel $Timers($pb)
+	unset Timers($pb)
+    }
+    $pb configure -value 0
+}
+
+

data/pkgs/tile-0.8.2/library/scale.tcl

@@ -0,0 +1,54 @@
+# scale.tcl - Copyright (C) 2004 Pat Thoyts <patthoyts@users.sourceforge.net>
+#
+# Bindings for the TScale widget
+#
+# scale.tcl,v 1.11 2006/11/05 18:40:48 jenglish Exp
+
+namespace eval ttk::scale {
+    variable State
+    array set State  {
+	dragging 0
+    }
+}
+
+bind TScale <ButtonPress-1>   { ttk::scale::Press %W %x %y }
+bind TScale <B1-Motion>       { ttk::scale::Drag %W %x %y }
+bind TScale <ButtonRelease-1> { ttk::scale::Release %W %x %y }
+
+proc ttk::scale::Press {w x y} {
+    variable State
+    set State(dragging) 0
+
+    switch -glob -- [$w identify $x $y] {
+	*track -
+        *trough {
+	    if {[$w get $x $y] <= [$w get]} {
+		ttk::Repeatedly Increment $w -1
+	    } else {
+		ttk::Repeatedly Increment $w 1
+	    }
+        }
+        *slider {
+            set State(dragging) 1
+            set State(initial) [$w get]
+        }
+    }
+}
+
+proc ttk::scale::Drag {w x y} {
+    variable State
+    if {$State(dragging)} {
+	$w set [$w get $x $y]
+    }
+}
+
+proc ttk::scale::Release {w x y} {
+    variable State
+    set State(dragging) 0
+    ttk::CancelRepeat
+}
+
+proc ttk::scale::Increment {w delta} {
+    if {![winfo exists $w]} return
+    $w set [expr {[$w get] + $delta}]
+}

data/pkgs/tile-0.8.2/library/scrollbar.tcl

@@ -0,0 +1,125 @@
+#
+# scrollbar.tcl,v 1.19 2007/12/12 16:53:10 jenglish Exp
+#
+# Bindings for TScrollbar widget
+#
+
+# Still don't have a working ttk::scrollbar under OSX -
+# Swap in a [tk::scrollbar] on that platform,
+# unless user specifies -class or -style.
+#
+if {[tk windowingsystem] eq "aqua"} {
+    rename ::ttk::scrollbar ::ttk::_scrollbar_
+    proc ttk::scrollbar {w args} {
+	set constructor ::scrollbar
+	foreach {option _} $args {
+	    if {$option eq "-class" || $option eq "-style"} {
+		set constructor ::ttk::_scrollbar_
+		break
+	    }
+	}
+	return [eval [linsert $args 0 $constructor $w]]
+    }
+}
+
+namespace eval ttk::scrollbar {
+    variable State
+    # State(xPress)	--
+    # State(yPress)	-- initial position of mouse at start of drag.
+    # State(first)	-- value of -first at start of drag.
+}
+
+bind TScrollbar <ButtonPress-1> 	{ ttk::scrollbar::Press %W %x %y }
+bind TScrollbar <B1-Motion>		{ ttk::scrollbar::Drag %W %x %y }
+bind TScrollbar <ButtonRelease-1>	{ ttk::scrollbar::Release %W %x %y }
+
+bind TScrollbar <ButtonPress-2> 	{ ttk::scrollbar::Jump %W %x %y }
+bind TScrollbar <B2-Motion>		{ ttk::scrollbar::Drag %W %x %y }
+bind TScrollbar <ButtonRelease-2>	{ ttk::scrollbar::Release %W %x %y }
+
+proc ttk::scrollbar::Scroll {w n units} {
+    set cmd [$w cget -command]
+    if {$cmd ne ""} {
+	uplevel #0 $cmd scroll $n $units
+    }
+}
+
+proc ttk::scrollbar::Moveto {w fraction} {
+    set cmd [$w cget -command]
+    if {$cmd ne ""} {
+	uplevel #0 $cmd moveto $fraction
+    }
+}
+
+proc ttk::scrollbar::Press {w x y} {
+    variable State
+
+    set State(xPress) $x
+    set State(yPress) $y
+
+    switch -glob -- [$w identify $x $y] {
+    	*uparrow -
+	*leftarrow {
+	    ttk::Repeatedly Scroll $w -1 units
+	}
+	*downarrow -
+	*rightarrow {
+	    ttk::Repeatedly Scroll $w  1 units
+	}
+	*thumb {
+	    set State(first) [lindex [$w get] 0]
+	}
+	*trough {
+	    set f [$w fraction $x $y]
+	    if {$f < [lindex [$w get] 0]} {
+		# Clicked in upper/left trough
+		ttk::Repeatedly Scroll $w -1 pages
+	    } elseif {$f > [lindex [$w get] 1]} {
+		# Clicked in lower/right trough
+		ttk::Repeatedly Scroll $w 1 pages
+	    } else {
+		# Clicked on thumb (???)
+		set State(first) [lindex [$w get] 0]
+	    }
+	}
+    }
+}
+
+proc ttk::scrollbar::Drag {w x y} {
+    variable State
+    if {![info exists State(first)]} {
+    	# Initial buttonpress was not on the thumb, 
+	# or something screwy has happened.  In either case, ignore:
+	return;
+    }
+    set xDelta [expr {$x - $State(xPress)}]
+    set yDelta [expr {$y - $State(yPress)}]
+    Moveto $w [expr {$State(first) + [$w delta $xDelta $yDelta]}]
+}
+
+proc ttk::scrollbar::Release {w x y} {
+    variable State
+    unset -nocomplain State(xPress) State(yPress) State(first)
+    ttk::CancelRepeat
+}
+
+# scrollbar::Jump -- ButtonPress-2 binding for scrollbars.
+# 	Behaves exactly like scrollbar::Press, except that
+#	clicking in the trough jumps to the the selected position.
+#
+proc ttk::scrollbar::Jump {w x y} {
+    variable State
+
+    switch -glob -- [$w identify $x $y] {
+	*thumb -
+	*trough {
+	    set State(first) [$w fraction $x $y]
+	    Moveto $w $State(first)
+	    set State(xPress) $x
+	    set State(yPress) $y
+	}
+	default {
+	    Press $w $x $y
+	}
+    }
+}

data/pkgs/tile-0.8.2/library/sizegrip.tcl

@@ -0,0 +1,77 @@
+#
+# sizegrip.tcl,v 1.3 2006/11/05 18:40:48 jenglish Exp
+#
+# Tile widget set -- sizegrip widget bindings.
+#
+# Dragging a sizegrip widget resizes the containing toplevel.
+#
+# NOTE: the sizegrip widget must be in the lower right hand corner.
+#
+
+option add *TSizegrip.cursor $::ttk::Cursors(seresize)
+
+namespace eval ttk::sizegrip {
+    variable State
+    array set State {
+	pressed 	0
+	pressX 		0
+	pressY 		0
+	width 		0
+	height 		0
+	widthInc	1
+	heightInc	1
+	toplevel 	{}
+    }
+}
+
+bind TSizegrip <ButtonPress-1> 		{ ttk::sizegrip::Press	%W %X %Y }
+bind TSizegrip <B1-Motion> 		{ ttk::sizegrip::Drag 	%W %X %Y }
+bind TSizegrip <ButtonRelease-1> 	{ ttk::sizegrip::Release %W %X %Y }
+
+proc ttk::sizegrip::Press {W X Y} {
+    variable State
+
+    set top [winfo toplevel $W]
+
+    # Sanity-checks:
+    #	If a negative X or Y position was specified for [wm geometry],
+    #   just bail out -- there's no way to handle this cleanly.
+    #
+    if {[scan [wm geometry $top] "%dx%d+%d+%d" width height _x _y] != 4} {
+	return;
+    }
+
+    # Account for gridded geometry:
+    #
+    set grid [wm grid $top]
+    if {[llength $grid]} {
+	set State(widthInc) [lindex $grid 2]
+	set State(heightInc) [lindex $grid 3]
+    } else {
+	set State(widthInc) [set State(heightInc) 1]
+    }
+
+    set State(toplevel) $top
+    set State(pressX) $X
+    set State(pressY) $Y
+    set State(width)  $width
+    set State(height) $height
+    set State(pressed) 1
+}
+
+proc ttk::sizegrip::Drag {W X Y} {
+    variable State
+    if {!$State(pressed)} { return }
+    set w [expr {$State(width)  + ($X - $State(pressX))/$State(widthInc)}]
+    set h [expr {$State(height) + ($Y - $State(pressY))/$State(heightInc)}]
+    if {$w <= 0} { set w 1 }
+    if {$h <= 0} { set h 1 }
+    wm geometry $State(toplevel) ${w}x${h}
+}
+
+proc ttk::sizegrip::Release {W X Y} {
+    variable State
+    set State(pressed) 0
+}
+
+#*EOF*

data/pkgs/tile-0.8.2/library/tile.tcl

@@ -0,0 +1,211 @@
+#
+# tile.tcl,v 1.104 2006/12/13 17:05:25 jenglish Exp
+#
+# Tile widget set initialization script.
+#
+
+namespace eval tile {}		;# Old namespace, being phased out
+namespace eval ttk {}		;# New official namespace
+
+### Source library scripts.
+#
+
+namespace eval tile {
+    if {![info exists library]} {
+	variable library [file dirname [info script]]
+    }
+}
+
+source [file join $tile::library keynav.tcl]
+source [file join $tile::library fonts.tcl]
+source [file join $tile::library cursors.tcl]
+source [file join $tile::library icons.tcl]
+source [file join $tile::library utils.tcl]
+
+### Deprecated aliases.
+#
+
+## ttk::deprecated $old $new --
+#	Define $old command as a deprecated alias for $new command
+#	$old and $new must be fully namespace-qualified.
+#
+proc ttk::deprecated {old new} {
+    interp alias {} $old {} ttk::do'deprecate $old $new
+}
+## do'deprecate --
+#	Implementation procedure for deprecated commands --
+#	issue a warning (once), then re-alias old to new.
+#
+proc ttk::do'deprecate {old new args} {
+    deprecated'warning $old $new
+    interp alias {} $old {} $new
+    uplevel 1 [linsert $args 0 $new]
+}
+
+## deprecated'warning --
+#	Gripe about use of deprecated commands. 
+#
+proc ttk::deprecated'warning {old new} {
+    puts stderr "$old deprecated -- use $new instead"
+}
+
+### Backward compatibility:
+#
+
+## 0.7.X compatibility: renamed in 0.8.0 
+#
+ttk::deprecated ::ttk::paned		::ttk::panedwindow
+ttk::deprecated ::tile::availableThemes	::ttk::themes
+ttk::deprecated ::tile::setTheme	::ttk::setTheme
+#Not yet: ttk::deprecated ::style	::ttk::style
+interp alias {} ::style {} ::ttk::style
+
+ttk::deprecated ::tile::defineImage	::ttk::defineImage
+ttk::deprecated ::tile::stockIcon	::ttk::stockIcon
+
+ttk::deprecated ::tile::CopyBindings	::ttk::copyBindings
+
+### Exported routines:
+#
+namespace eval ttk {
+
+    namespace export style
+
+    # All widget constructor commands are exported:
+    variable widgets {
+	button checkbutton radiobutton menubutton label entry
+	frame labelframe scrollbar
+	notebook progressbar combobox separator 
+	panedwindow treeview sizegrip
+	scale
+    }
+
+    variable wc
+    foreach wc $widgets  {
+	namespace export $wc
+    }
+}
+
+### ttk::ThemeChanged --
+#	Called from [style theme use].
+#	Sends a <<ThemeChanged>> virtual event to all widgets.
+#
+proc ttk::ThemeChanged {} {
+    set Q .
+    while {[llength $Q]} {
+	set QN [list]
+	foreach w $Q {
+	    event generate $w <<ThemeChanged>>
+	    foreach child [winfo children $w] {
+		lappend QN $child
+	    }
+	}
+	set Q $QN
+    }
+}
+
+### Public API.
+#
+
+## ttk::themes --
+#	Return list of themes registered in the package database.
+#
+proc ttk::themes {} {
+    set themes [list]
+
+    foreach pkg [lsearch -inline -all -glob [package names] ttk::theme::*] {
+	lappend themes [lindex [split $pkg :] end]
+    }
+
+    return $themes
+}
+
+## ttk::setTheme $theme --
+#	Set the current theme to $theme, loading it if necessary.
+#
+proc ttk::setTheme {theme} {
+    variable currentTheme
+    if {[lsearch [style theme names] $theme] < 0} {
+	package require ttk::theme::$theme
+    }
+    style theme use $theme
+    set currentTheme $theme
+}
+
+### Load widget bindings.
+#
+source [file join $tile::library button.tcl]
+source [file join $tile::library menubutton.tcl]
+source [file join $tile::library scrollbar.tcl]
+source [file join $tile::library scale.tcl]
+source [file join $tile::library progress.tcl]
+source [file join $tile::library notebook.tcl]
+source [file join $tile::library paned.tcl]
+source [file join $tile::library entry.tcl]
+source [file join $tile::library combobox.tcl]	;# dependency: entry.tcl
+source [file join $tile::library treeview.tcl]
+source [file join $tile::library sizegrip.tcl]
+source [file join $tile::library dialog.tcl]
+
+## Label and Labelframe bindings:
+#  (not enough to justify their own file...)
+#
+bind TLabelframe <<Invoke>>	{ ttk::traverseTo [tk_focusNext %W] }
+bind TLabel <<Invoke>>		{ ttk::traverseTo [tk_focusNext %W] }
+
+### Load settings for built-in themes:
+#
+proc ttk::LoadThemes {} {
+    variable ::tile::library
+
+    # "default" always present:
+    uplevel #0 [list source [file join $library defaults.tcl]] 
+
+    set builtinThemes [style theme names]
+    foreach {theme script} {
+	classic 	classicTheme.tcl
+	alt 		altTheme.tcl
+	clam 		clamTheme.tcl
+	winnative	winTheme.tcl
+	xpnative	xpTheme.tcl
+	aqua 		aquaTheme.tcl
+    } {
+	if {[lsearch -exact $builtinThemes $theme] >= 0} {
+	    uplevel #0 [list source [file join $library $script]]
+	}
+    }
+}
+
+ttk::LoadThemes; rename ::ttk::LoadThemes {}
+
+### Select platform-specific default theme:
+#
+# Notes: 
+#	+ On OSX, aqua theme is the default
+#	+ On Windows, xpnative takes precedence over winnative if available.
+#	+ On X11, users can use the X resource database to
+#	  specify a preferred theme (*TkTheme: themeName);
+#	  otherwise "default" is used.
+#
+
+proc ttk::DefaultTheme {} {
+    set preferred [list aqua xpnative winnative]
+
+    set userTheme [option get . tkTheme TkTheme]
+    if {$userTheme != {} && ![catch {
+	uplevel #0 [list package require ttk::theme::$userTheme]
+    }]} {
+	return $userTheme
+    }
+
+    foreach theme $preferred {
+	if {[package provide ttk::theme::$theme] != ""} {
+	    return $theme
+	}
+    }
+    return "default"
+}
+
+ttk::setTheme [ttk::DefaultTheme] ; rename ttk::DefaultTheme {}
+
+#*EOF*