python-2.5.2/win32/tcl/tix8.4/NoteBook.tcl
changeset 0 ae805ac0140d
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/python-2.5.2/win32/tcl/tix8.4/NoteBook.tcl	Fri Apr 03 17:19:34 2009 +0100
@@ -0,0 +1,247 @@
+# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
+#
+#	$Id: NoteBook.tcl,v 1.7 2004/03/28 02:44:57 hobbs Exp $
+#
+# NoteBook.tcl --
+#
+#	tixNoteBook: NoteBook type of window.
+#
+# Copyright (c) 1993-1999 Ioi Kim Lam.
+# Copyright (c) 2000-2001 Tix Project Group.
+# Copyright (c) 2004 ActiveState
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+tixWidgetClass tixNoteBook {
+    -classname TixNoteBook
+    -superclass tixVStack
+    -method {
+    }
+    -flag {
+    }
+    -configspec {
+	{-takefocus takeFocus TakeFocus 0 tixVerifyBoolean}
+    }
+    -default {
+	{.nbframe.tabPadX	8}
+	{.nbframe.tabPadY	5}
+	{.nbframe.borderWidth	2}
+	{*nbframe.relief	raised}
+    }
+}
+
+proc tixNoteBook:InitWidgetRec {w} {
+    upvar #0 $w data
+
+    tixChainMethod $w InitWidgetRec
+
+    set data(pad-x1) 0
+    set data(pad-x2) 0
+    set data(pad-y1) 20
+    set data(pad-y2) 0
+}
+
+proc tixNoteBook:ConstructWidget {w} {
+    upvar #0 $w data
+
+    tixChainMethod $w ConstructWidget
+
+    set data(w:top) [tixNoteBookFrame $w.nbframe -slave 1 -takefocus 1]
+    set data(w:nbframe) $data(w:top)
+
+    bind $data(w:top) <ButtonPress-1> [list tixNoteBook:MouseDown $w %x %y]
+    bind $data(w:top) <ButtonRelease-1> [list tixNoteBook:MouseUp $w %x %y]
+
+    bind $data(w:top) <B1-Motion> [list tixNoteBook:MouseDown $w %x %y]
+
+    bind $data(w:top) <Left>  [list tixNoteBook:FocusNext $w prev]
+    bind $data(w:top) <Right> [list tixNoteBook:FocusNext $w next]
+
+    bind $data(w:top) <Return> [list tixNoteBook:SetFocusByKey $w]
+    bind $data(w:top) <space>  [list tixNoteBook:SetFocusByKey $w]
+}
+
+#----------------------------------------------------------------------
+# Public methods
+#----------------------------------------------------------------------
+proc tixNoteBook:add {w child args} {
+    upvar #0 $w data
+
+    set ret [eval tixChainMethod $w add $child $args]
+
+    set new_args ""
+    foreach {flag value} $args {
+	if {$flag ne "-createcmd" && $flag ne "-raisecmd"} {
+	    lappend new_args $flag
+	    lappend new_args $value
+	}
+    }
+
+    eval [linsert $new_args 0 $data(w:top) add $child]
+
+    return $ret
+}
+
+proc tixNoteBook:raise {w child} {
+    upvar #0 $w data
+
+    tixChainMethod $w raise $child
+
+    if {[$data(w:top) pagecget $child -state] eq "normal"} {
+	$data(w:top) activate $child
+    }
+}
+
+proc tixNoteBook:delete {w child} {
+    upvar #0 $w data
+
+    tixChainMethod $w delete $child
+    $data(w:top) delete $child
+}
+
+#----------------------------------------------------------------------
+# Private methods
+#----------------------------------------------------------------------
+proc tixNoteBook:Resize {w} {
+    upvar #0 $w data
+
+    # We have to take care of the size of the tabs so that 
+    #
+    set rootReq [$data(w:top) geometryinfo]
+    set tW [lindex $rootReq 0]
+    set tH [lindex $rootReq 1]
+
+    set data(pad-x1) 2
+    set data(pad-x2) 2
+    set data(pad-y1) [expr {$tH + $data(-ipadx) + 1}]
+    set data(pad-y2) 2
+    set data(minW)   [expr {$tW}]
+    set data(minH)   [expr {$tH}]
+
+    # Now that we know data(pad-y1), we can chain the call
+    #
+    tixChainMethod $w Resize
+}
+
+proc tixNoteBook:MouseDown {w x y} {
+    upvar #0 $w data
+
+    focus $data(w:top)
+
+    set name [$data(w:top) identify $x $y]
+    $data(w:top) focus $name
+    set data(w:down) $name
+}
+
+proc tixNoteBook:MouseUp {w x y} {
+    upvar #0 $w data
+
+    #it could happen (using the tk/menu) that a MouseUp
+    #proceeds without a MouseDown event!!
+    if {![info exists data(w:down)] || ![info exists data(w:top)]} {
+	return
+    }
+
+    set name [$data(w:top) identify $x $y]
+
+    if {$name ne "" && $name eq $data(w:down)
+	&& [$data(w:top) pagecget $name -state] eq "normal"} {
+        $data(w:top) activate $name
+        tixCallMethod $w raise $name
+    } else {
+        $data(w:top) focus ""
+    }
+}
+
+
+#----------------------------------------------------------------------
+#
+# Section for keyboard bindings
+#
+#----------------------------------------------------------------------
+
+proc tixNoteBook:FocusNext {w dir} {
+    upvar #0 $w data
+
+    if {[$data(w:top) info focus] == ""} {
+	set name [$data(w:top) info active]
+	$data(w:top) focus $name
+
+	if {$name ne ""} {
+	    return
+	}
+    } else {
+	set name [$data(w:top) info focus$dir]
+ 	$data(w:top) focus $name
+   }
+}
+
+proc tixNoteBook:SetFocusByKey {w} {
+    upvar #0 $w data
+
+    set name [$data(w:top) info focus]
+
+    if {$name ne "" && [$data(w:top) pagecget $name -state] eq "normal"} {
+	tixCallMethod $w raise $name
+	$data(w:top) activate $name
+    }
+}
+
+#----------------------------------------------------------------------
+# Automatic bindings for alt keys
+#----------------------------------------------------------------------
+proc tixNoteBookFind {w char} {
+    set char [string tolower $char]
+
+    foreach child [winfo child $w] {
+	if {![winfo ismapped $w]} {
+	    continue
+	}
+	switch -exact -- [winfo class $child] {
+	    Toplevel    { continue }
+	    TixNoteBook {
+		set nbframe [$child subwidget nbframe]
+		foreach page [$nbframe info pages] {
+		    set char2 [string index [$nbframe pagecget $page -label] \
+				   [$nbframe pagecget $page -underline]]
+		    if {($char eq [string tolower $char2] || $char eq "")
+			&& [$nbframe pagecget $page -state] ne "disabled"} {
+			return [list $child $page]
+		    }
+		}
+	    }
+	}
+	# Well, this notebook doesn't match with the key, but maybe
+	# it contains a "subnotebook" that will match ..
+	set match [tixNoteBookFind $child $char]
+	if {$match ne ""} {
+	    return $match
+	}
+    }
+    return ""
+}
+
+proc tixTraverseToNoteBook {w char} {
+    if {$char eq ""} {
+	return 0
+    }
+    if {![winfo exists $w]} {
+	return 0
+    }
+    set list [tixNoteBookFind [winfo toplevel $w] $char]
+    if {$list ne ""} {
+	[lindex $list 0] raise [lindex $list 1]
+	return 1
+    }
+    return 0
+}
+
+#----------------------------------------------------------------------
+# Set default class bindings
+#----------------------------------------------------------------------
+
+bind all <Alt-KeyPress> "+tixTraverseToNoteBook %W %A"
+bind all <Meta-KeyPress> "+tixTraverseToNoteBook %W %A"
+