Pratt 1.5.6

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

@@ -0,0 +1,382 @@
+# treeview.tcl,v 1.22 2006/12/18 15:05:59 jenglish Exp
+#
+# ttk::treeview widget bindings and utilities.
+#
+
+namespace eval ttk::treeview {
+    variable State
+
+    # Enter/Leave/Motion
+    #
+    set State(activeWidget) 	{}
+    set State(activeHeading) 	{}
+
+    # Press/drag/release:
+    #
+    set State(pressMode) 	none
+    set State(pressX)		0
+
+    # For pressMode == "resize"
+    set State(resizeColumn)	#0
+
+    # For pressmode == "heading"
+    set State(heading)  	{}
+
+    # Provide [lassign] if not already present
+    # (@@@ TODO: check if this is still needed after horrible-identify purge)
+    #
+    if {![llength [info commands lassign]]} {
+	proc lassign {vals args} {
+	    uplevel 1 [list foreach $args $vals break]
+	}
+    }
+}
+
+### Widget bindings.
+#
+
+bind Treeview	<Motion> 		{ ttk::treeview::Motion %W %x %y }
+bind Treeview	<B1-Leave>		{ #nothing }
+bind Treeview	<Leave>			{ ttk::treeview::ActivateHeading {} {}}
+bind Treeview	<ButtonPress-1> 	{ ttk::treeview::Press %W %x %y }
+bind Treeview	<Double-ButtonPress-1> 	{ ttk::treeview::DoubleClick %W %x %y }
+bind Treeview	<ButtonRelease-1> 	{ ttk::treeview::Release %W %x %y }
+bind Treeview	<B1-Motion> 		{ ttk::treeview::Drag %W %x %y }
+bind Treeview 	<KeyPress-Up>    	{ ttk::treeview::Keynav %W up }
+bind Treeview 	<KeyPress-Down>  	{ ttk::treeview::Keynav %W down }
+bind Treeview 	<KeyPress-Right> 	{ ttk::treeview::Keynav %W right }
+bind Treeview 	<KeyPress-Left>  	{ ttk::treeview::Keynav %W left }
+bind Treeview	<KeyPress-Prior>	{ %W yview scroll -1 pages }
+bind Treeview	<KeyPress-Next> 	{ %W yview scroll  1 pages }
+bind Treeview	<KeyPress-Return>	{ ttk::treeview::ToggleFocus %W }
+bind Treeview	<KeyPress-space>	{ ttk::treeview::ToggleFocus %W }
+
+bind Treeview	<Shift-ButtonPress-1> \
+		{ ttk::treeview::Select %W %x %y extend }
+bind Treeview	<Control-ButtonPress-1> \
+		{ ttk::treeview::Select %W %x %y toggle }
+
+# Standard mousewheel bindings:
+#
+bind Treeview <MouseWheel> { %W yview scroll [expr {- (%D / 120) * 4}] units }
+if {[string equal "x11" [tk windowingsystem]]} {
+    bind Treeview <ButtonPress-4>	{ %W yview scroll -5 units }
+    bind Treeview <ButtonPress-5>	{ %W yview scroll 5 units }
+}
+
+### Binding procedures.
+#
+
+## Keynav -- Keyboard navigation
+#
+# @@@ TODO: verify/rewrite up and down code.
+#
+proc ttk::treeview::Keynav {w dir} {
+    set focus [$w focus]
+    if {$focus eq ""} { return }
+
+    switch -- $dir {
+	up {
+	    if {[set up [$w prev $focus]] eq ""} {
+	        set focus [$w parent $focus]
+	    } else {
+		while {[$w item $up -open] && [llength [$w children $up]]} {
+		    set up [lindex [$w children $up] end]
+		}
+		set focus $up
+	    }
+	}
+	down {
+	    if {[$w item $focus -open] && [llength [$w children $focus]]} {
+	        set focus [lindex [$w children $focus] 0]
+	    } else {
+		set up $focus
+		while {$up ne "" && [set down [$w next $up]] eq ""} {
+		    set up [$w parent $up]
+		}
+		set focus $down
+	    }
+	}
+	left {
+	    if {[$w item $focus -open] && [llength [$w children $focus]]} {
+	    	CloseItem $w $focus
+	    } else {
+	    	set focus [$w parent $focus]
+	    }
+	}
+	right {
+	    OpenItem $w $focus
+	}
+    }
+
+    if {$focus != {}} {
+	SelectOp $w $focus choose
+    }
+}
+
+## Motion -- pointer motion binding.
+#	Sets cursor, active element ...
+#
+proc ttk::treeview::Motion {w x y} {
+    variable ::ttk::Cursors
+    variable State
+
+    set cursor {}
+    set activeHeading {}
+
+    lassign [$w identify $x $y] what where detail
+    switch -- $what {
+	separator { set cursor $Cursors(hresize) }
+	heading { set activeHeading $where }
+    }
+
+    if {[$w cget -cursor] ne $cursor} {
+	$w configure -cursor $cursor
+    }
+    ActivateHeading $w $activeHeading
+}
+
+## ActivateHeading -- track active heading element
+#
+proc ttk::treeview::ActivateHeading {w heading} {
+    variable State
+
+    if {$w != $State(activeWidget) || $heading != $State(activeHeading)} {
+	if {$State(activeHeading) != {}} {
+	    $State(activeWidget) heading $State(activeHeading) state !active
+	}
+	if {$heading != {}} {
+	    $w heading $heading state active
+	}
+	set State(activeHeading) $heading
+	set State(activeWidget) $w
+    }
+}
+
+## Select $w $x $y $selectop
+#	Binding procedure for selection operations.
+#	See "Selection modes", below.
+#
+proc ttk::treeview::Select {w x y op} {
+    if {[set item [$w identify row $x $y]] ne "" } {
+	SelectOp $w $item $op
+    }
+}
+
+## DoubleClick -- Double-ButtonPress-1 binding.  
+#
+proc ttk::treeview::DoubleClick {w x y} {
+    if {[set row [$w identify row $x $y]] ne ""} {
+	Toggle $w $row
+    } else {
+	Press $w $x $y ;# perform single-click action
+    }
+}
+
+## Press -- ButtonPress binding.
+#
+proc ttk::treeview::Press {w x y} {
+    lassign [$w identify $x $y] what where detail
+    focus $w	;# or: ClickToFocus?
+
+    switch -- $what {
+	nothing { }
+	heading { heading.press $w $where }
+	separator { resize.press $w $x $where }
+	cell -
+	row  -
+	item { SelectOp $w $where choose }
+    }
+    if {$what eq "item" && [string match *indicator $detail]} {
+    	Toggle $w $where
+    }
+}
+
+## Drag -- B1-Motion binding
+#
+proc ttk::treeview::Drag {w x y} {
+    variable State
+    switch $State(pressMode) {
+	resize	{ resize.drag $w $x }
+	heading	{ heading.drag $w $x $y }
+    }
+}
+
+proc ttk::treeview::Release {w x y} {
+    variable State
+    switch $State(pressMode) {
+	resize	{ resize.release $w $x }
+	heading	{ heading.release $w }
+    }
+    set State(pressMode) none
+    Motion $w $x $y
+}
+
+### Interactive column resizing.
+#
+proc ttk::treeview::resize.press {w x column} {
+    variable State
+    set State(pressMode) "resize"
+    set State(resizeColumn) $column
+}
+
+proc ttk::treeview::resize.drag {w x} {
+    variable State
+    $w drag $State(resizeColumn) $x
+}
+
+proc ttk::treeview::resize.release {w x} {
+    # no-op
+}
+
+### Heading activation.
+#
+
+proc ttk::treeview::heading.press {w column} {
+    variable State
+    set State(pressMode) "heading"
+    set State(heading) $column
+    $w heading $column state pressed
+}
+
+proc ttk::treeview::heading.drag {w x y} {
+    variable State
+    lassign [$w identify $x $y] what where detail
+    if {$what eq "heading" && $where eq $State(heading)} {
+    	$w heading $State(heading) state pressed
+    } else {
+    	$w heading $State(heading) state !pressed
+    }
+}
+
+proc ttk::treeview::heading.release {w} {
+    variable State
+    if {[lsearch -exact [$w heading $State(heading) state] pressed] >= 0} {
+	after idle [$w heading $State(heading) -command]
+    }
+    $w heading $State(heading) state !pressed
+}
+
+### Selection modes.
+#
+
+## SelectOp $w $item [ choose | extend | toggle ] --
+#	Dispatch to appropriate selection operation 
+#	depending on current value of -selectmode.
+#
+proc ttk::treeview::SelectOp {w item op} {
+    select.$op.[$w cget -selectmode] $w $item
+}
+
+## -selectmode none:
+#
+proc ttk::treeview::select.choose.none {w item} { $w focus $item }
+proc ttk::treeview::select.toggle.none {w item} { $w focus $item }
+proc ttk::treeview::select.extend.none {w item} { $w focus $item }
+
+## -selectmode browse:
+#
+proc ttk::treeview::select.choose.browse {w item} { BrowseTo $w $item }
+proc ttk::treeview::select.toggle.browse {w item} { BrowseTo $w $item }
+proc ttk::treeview::select.extend.browse {w item} { BrowseTo $w $item }
+
+## -selectmode multiple:
+#
+proc ttk::treeview::select.choose.extended {w item} { 
+    BrowseTo $w $item
+}
+proc ttk::treeview::select.toggle.extended {w item} { 
+    $w selection toggle $item
+}
+proc ttk::treeview::select.extend.extended {w item} {
+    if {[set anchor [$w focus]] ne ""} {
+	$w selection set [between $w $anchor $item]
+    } else {
+    	BrowseTo $item
+    }
+}
+
+### Tree structure utilities.
+#
+
+## between $tv $item1 $item2 --
+#	Returns a list of all items between $item1 and $item2,
+#	in preorder traversal order.  $item1 and $item2 may be
+#	in either order.
+#
+# NOTES: 
+#	This routine is O(N) in the size of the tree.
+#	There's probably a way to do this that's O(N) in the number
+#	of items returned, but I'm not clever enough to figure it out.
+#
+proc ttk::treeview::between {tv item1 item2} {
+    variable between [list]
+    variable selectingBetween 0
+    ScanBetween $tv $item1 $item2 {}
+    return $between
+}
+
+## ScanBetween --
+#	Recursive worker routine for ttk::treeview::between
+#
+proc ttk::treeview::ScanBetween {tv item1 item2 item} {
+    variable between
+    variable selectingBetween
+
+    if {$item eq $item1 || $item eq $item2} {
+    	lappend between $item
+	set selectingBetween [expr {!$selectingBetween}]
+    } elseif {$selectingBetween} {
+    	lappend between $item
+    }
+    foreach child [$tv children $item] {
+	ScanBetween $tv $item1 $item2 $child
+    }
+}
+
+### User interaction utilities.
+#
+
+## OpenItem, CloseItem -- Set the open state of an item, generate event
+#
+
+proc ttk::treeview::OpenItem {w item} {
+    $w focus $item
+    event generate $w <<TreeviewOpen>>
+    $w item $item -open true
+}
+
+proc ttk::treeview::CloseItem {w item} {
+    $w item $item -open false
+    $w focus $item
+    event generate $w <<TreeviewClose>>
+}
+
+## Toggle -- toggle opened/closed state of item
+#
+proc ttk::treeview::Toggle {w item} {
+    if {[$w item $item -open]} {
+	CloseItem $w $item
+    } else {
+	OpenItem $w $item
+    }
+}
+
+## ToggleFocus -- toggle opened/closed state of focus item
+#
+proc ttk::treeview::ToggleFocus {w} {
+    set item [$w focus]
+    if {$item ne ""} {
+    	Toggle $w $item
+    }
+}
+
+## BrowseTo -- navigate to specified item; set focus and selection
+#
+proc ttk::treeview::BrowseTo {w item} {
+    $w see $item
+    $w focus $item
+    $w selection set [list $item]
+}
+
+#*EOF*

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

@@ -0,0 +1,254 @@
+#
+# utils.tcl,v 1.10 2007/10/22 03:21:25 jenglish Exp
+#
+# Utilities for widget implementations.
+#
+
+### Focus management.
+#
+
+## ttk::takefocus --
+#	This is the default value of the "-takefocus" option
+#	for widgets that participate in keyboard navigation.
+#
+# See also: tk::FocusOK
+#
+proc ttk::takefocus {w} {
+    expr {[$w instate !disabled] && [winfo viewable $w]}
+}
+
+## ttk::traverseTo $w --
+# 	Set the keyboard focus to the specified window.
+#
+proc ttk::traverseTo {w} {
+    set focus [focus]
+    if {$focus ne ""} {
+	event generate $focus <<TraverseOut>>
+    }
+    focus $w
+    event generate $w <<TraverseIn>>
+}
+
+## ttk::clickToFocus $w --
+#	Utility routine, used in <ButtonPress-1> bindings --
+#	Assign keyboard focus to the specified widget if -takefocus is enabled.
+#
+proc ttk::clickToFocus {w} {
+    if {[ttk::takesFocus $w]} { focus $w }
+}
+
+## ttk::takesFocus w --
+#	Test if the widget can take keyboard focus:
+#
+#	+ widget is viewable, AND:
+#	- if -takefocus is missing or empty, return 0, OR
+#	- if -takefocus is 0 or 1, return that value, OR
+#	- append the widget name to -takefocus and evaluate it
+#	  as a script.
+#
+# See also: tk::FocusOK
+#
+# Note: This routine doesn't implement the same fallback heuristics 
+#	as tk::FocusOK.
+#
+proc ttk::takesFocus {w} {
+
+    if {![winfo viewable $w]} { return 0 }
+
+    if {![catch {$w cget -takefocus} takefocus]} {
+	switch -- $takefocus {
+	    0  -
+	    1  { return $takefocus }
+	    "" { return 0 }
+	    default {
+		set value [uplevel #0 $takefocus [list $w]]
+		return [expr {$value eq 1}]
+	    }
+	}
+    }
+
+    return 0
+}
+
+## ttk::focusFirst $w --
+#	Return the first descendant of $w, in preorder traversal order,
+#	that can take keyboard focus, "" if none do.
+#
+# See also: tk_focusNext
+#
+
+proc ttk::focusFirst {w} {
+    if {[ttk::takesFocus $w]} { 
+	return $w 
+    }
+    foreach child [winfo children $w] {
+	if {[set c [ttk::focusFirst $child]] ne ""} {
+	    return $c
+	}
+    }
+    return ""
+}
+
+### Grabs.
+#
+# Rules:
+#	Each call to [grabWindow $w] or [globalGrab $w] must be
+#	matched with a call to [releaseGrab $w] in LIFO order.
+#
+#	Do not call [grabWindow $w] for a window that currently
+#	appears on the grab stack.
+#
+#	See #1239190 and #1411983 for more discussion.
+#
+namespace eval ttk {
+    variable Grab 		;# map: window name -> grab token
+
+    # grab token details:
+    #	Two-element list containing:
+    #	1) a script to evaluate to restore the previous grab (if any);
+    #	2) a script to evaluate to restore the focus (if any)
+}
+
+## SaveGrab --
+#	Record current grab and focus windows.
+#
+proc ttk::SaveGrab {w} {
+    variable Grab
+
+    if {[info exists Grab($w)]} {
+	# $w is already on the grab stack.
+	# This should not happen, but bail out in case it does anyway:
+	#
+	return
+    }
+
+    set restoreGrab [set restoreFocus ""]
+
+    set grabbed [grab current $w]
+    if {[winfo exists $grabbed]} {
+    	switch [grab status $grabbed] {
+	    global { set restoreGrab [list grab -global $grabbed] }
+	    local  { set restoreGrab [list grab $grabbed] }
+	    none   { ;# grab window is really in a different interp }
+	}
+    }
+
+    set focus [focus]
+    if {$focus ne ""} {
+    	set restoreFocus [list focus -force $focus]
+    }
+
+    set Grab($w) [list $restoreGrab $restoreFocus]
+}
+
+## RestoreGrab --
+#	Restore previous grab and focus windows.
+#	If called more than once without an intervening [SaveGrab $w],
+#	does nothing.
+#
+proc ttk::RestoreGrab {w} {
+    variable Grab
+
+    if {![info exists Grab($w)]} {	# Ignore
+	return;
+    }
+
+    # The previous grab/focus window may have been destroyed,
+    # unmapped, or some other abnormal condition; ignore any errors.
+    #
+    foreach script $Grab($w) {
+	catch $script
+    }
+
+    unset Grab($w)
+}
+
+## ttk::grabWindow $w --
+#	Records the current focus and grab windows, sets an application-modal
+#	grab on window $w.
+#
+proc ttk::grabWindow {w} {
+    SaveGrab $w
+    grab $w
+}
+
+## ttk::globalGrab $w --
+#	Same as grabWindow, but sets a global grab on $w.
+#
+proc ttk::globalGrab {w} {
+    SaveGrab $w
+    grab -global $w
+}
+
+## ttk::releaseGrab --
+#	Release the grab previously set by [ttk::grabWindow]
+#	or [ttk::globalGrab].
+#
+proc ttk::releaseGrab {w} {
+    grab release $w
+    RestoreGrab $w
+}
+
+### Auto-repeat.
+#
+# NOTE: repeating widgets do not have -repeatdelay
+# or -repeatinterval resources as in standard Tk;
+# instead a single set of settings is applied application-wide.
+# (TODO: make this user-configurable)
+#
+# (@@@ Windows seems to use something like 500/50 milliseconds
+#  @@@ for -repeatdelay/-repeatinterval)
+#
+
+namespace eval ttk {
+    variable Repeat
+    array set Repeat {
+	delay		300
+	interval	100
+	timer		{}
+	script		{}
+    }
+}
+
+## ttk::Repeatedly --
+#	Begin auto-repeat.
+#
+proc ttk::Repeatedly {args} {
+    variable Repeat
+    after cancel $Repeat(timer)
+    set script [uplevel 1 [list namespace code $args]]
+    set Repeat(script) $script
+    uplevel #0 $script
+    set Repeat(timer) [after $Repeat(delay) ttk::Repeat]
+}
+
+## Repeat --
+#	Continue auto-repeat
+#
+proc ttk::Repeat {} {
+    variable Repeat
+    uplevel #0 $Repeat(script)
+    set Repeat(timer) [after $Repeat(interval) ttk::Repeat]
+}
+
+## ttk::CancelRepeat --
+#	Halt auto-repeat.
+#
+proc ttk::CancelRepeat {} {
+    variable Repeat
+    after cancel $Repeat(timer)
+}
+
+### Miscellaneous.
+#
+
+## ttk::copyBindings $from $to --
+#	Utility routine; copies bindings from one bindtag onto another.
+#
+proc ttk::copyBindings {from to} {
+    foreach event [bind $from] {
+	bind $to $event [bind $from $event]
+    }
+}
+
+#*EOF*