Fixed panedwindow binding bugs and added demos for it too.

5 files changed, 122 insertions, 8 deletions

diff --git a/library/demos/paned1.tcl b/library/demos/paned1.tcl
new file mode 100644
index 0000000..dbdd582
--- /dev/null
+++ b/library/demos/paned1.tcl
@@ -0,0 +1,34 @@
+# paned1.tcl --
+#
+# This demonstration script creates a toplevel window containing
+# a paned window that separates two windows horizontally.
+#
+# RCS: @(#) $Id: paned1.tcl,v 1.1 2002/02/22 14:07:01 dkf Exp $
+
+if {![info exists widgetDemo]} {
+    error "This script should be run from the \"widget\" demo."
+}
+
+set w .paned1
+catch {destroy $w}
+toplevel $w
+wm title $w "Horizontal Paned Window Demonstration"
+wm iconname $w "paned1"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 4i -justify left -text "The sash between the two coloured windows below can be used to divide the area between them.  Use the left mouse button to resize without redrawing by just moving the sash, and use the middle mouse button to resize opaquely (always redrawing the windows in each position.)"
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+panedwindow $w.pane
+pack $w.pane -side top -expand yes -fill both -pady 2 -padx 2m
+
+label $w.pane.left  -text "This is the\nleft side"  -bg yellow
+label $w.pane.right -text "This is the\nright side" -bg cyan
+
+$w.pane add $w.pane.left $w.pane.right
diff --git a/library/demos/paned2.tcl b/library/demos/paned2.tcl
new file mode 100644
index 0000000..95495e6
--- /dev/null
+++ b/library/demos/paned2.tcl
@@ -0,0 +1,76 @@
+# paned2.tcl --
+#
+# This demonstration script creates a toplevel window containing
+# a paned window that separates two windows vertically.
+#
+# RCS: @(#) $Id: paned2.tcl,v 1.1 2002/02/22 14:07:01 dkf Exp $
+
+if {![info exists widgetDemo]} {
+    error "This script should be run from the \"widget\" demo."
+}
+
+set w .paned2
+catch {destroy $w}
+toplevel $w
+wm title $w "Vertical Paned Window Demonstration"
+wm iconname $w "paned2"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 4i -justify left -text "The sash between the two scrolled windows below can be used to divide the area between them.  Use the left mouse button to resize without redrawing by just moving the sash, and use the middle mouse button to resize opaquely (always redrawing the windows in each position.)"
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+# Create the pane itself
+panedwindow $w.pane -orient vertical
+pack $w.pane -side top -expand yes -fill both -pady 2 -padx 2m
+
+# The top window is a listbox with scrollbar
+set paneList {
+    {List of Tk Widgets}
+    button
+    canvas
+    checkbutton
+    entry
+    frame
+    label
+    labelframe
+    listbox
+    menu
+    menubutton
+    message
+    panedwindow
+    radiobutton
+    scale
+    scrollbar
+    spinbox
+    text
+    toplevel
+}
+set f [frame $w.pane.top]
+listbox $f.list -listvariable paneList -yscrollcommand "$f.scr set"
+# Invert the first item to highlight it
+$f.list itemconfigure 0 \
+	-background [$f.list cget -fg] -foreground [$f.list cget -bg]
+scrollbar $f.scr -orient vertical -command "$f.list yview"
+pack $f.scr -side right -fill y
+pack $f.list -fill both -expand 1
+
+# The bottom window is a text widget with scrollbar
+set f [frame $w.pane.bottom]
+text $f.text -xscrollcommand "$f.xscr set" -yscrollcommand "$f.yscr set" \
+	-width 30 -wrap none
+scrollbar $f.xscr -orient horizontal -command "$f.text xview"
+scrollbar $f.yscr -orient vertical -command "$f.text yview"
+grid $f.text $f.yscr -sticky nsew
+grid $f.xscr         -sticky nsew
+grid columnconfigure $f 0 -weight 1
+grid rowconfigure    $f 0 -weight 1
+$f.text insert 1.0 "This is just a normal text widget"
+
+# Now add our contents to the paned window
+$w.pane add $w.pane.top $w.pane.bottom
diff --git a/library/demos/widget b/library/demos/widget
index 3b547b7..d8549c7 100644
--- a/library/demos/widget
+++ b/library/demos/widget
@@ -11,7 +11,7 @@ exec wish "$0" "$@"
 # ".tcl" files is this directory, which are sourced by this script
 # as needed.
 #
-# RCS: @(#) $Id: widget,v 1.6 2001/11/30 11:25:41 dkf Exp $
+# RCS: @(#) $Id: widget,v 1.7 2002/02/22 14:07:01 dkf Exp $
 
 eval destroy [winfo child .]
 wm title . "Widget Demonstration"
@@ -199,8 +199,12 @@ addDemoSection "Canvases" {
     cscroll	"A simple scrollable canvas"
 }
 addDemoSection "Scales" {
-    vscale	"Vertical scale"
     hscale	"Horizontal scale"
+    vscale	"Vertical scale"
+}
+addDemoSection "Paned Windows" {
+    paned1	"Horizontal paned window"
+    paned2	"Vertical paned window"
 }
 addDemoSection "Menus" {
     menu	"Menus and cascades (sub-menus)"
@@ -381,7 +385,7 @@ Copyright (c) 1996-1997 Sun Microsystems, Inc.
 
 Copyright (c) 1997-2000 Ajuba Solutions, Inc.
 
-Copyright (c) 2001 Donal K. Fellows"
+Copyright (c) 2001-2002 Donal K. Fellows"
 }
 
 # Local Variables:
diff --git a/library/panedwindow.tcl b/library/panedwindow.tcl
index a232f89..58218c1 100644
--- a/library/panedwindow.tcl
+++ b/library/panedwindow.tcl
@@ -3,7 +3,7 @@
 # This file defines the default bindings for Tk panedwindow widgets and
 # provides procedures that help in implementing those bindings.
 #
-# RCS: @(#) $Id: panedwindow.tcl,v 1.1 2002/02/22 02:41:17 hobbs Exp $
+# RCS: @(#) $Id: panedwindow.tcl,v 1.2 2002/02/22 14:07:01 dkf Exp $
 #
 
 bind PanedWindow <Button-1> { ::tk::panedwindow::MarkSash %W %x %y 1 }
@@ -71,7 +71,7 @@ proc ::tk::panedwindow::DragSash {w x y proxy} {
 # Results:
 #   Returns ...
 #
-proc ::tk::panedwindow::ReleaseSash {w proxy} {
+proc ::tk::panedwindow::ReleaseSash {w x y proxy} {
     if { [info exists ::tk::Priv(sash)] } {
 	if {$proxy} {
 	    foreach {x y} [$w proxy coord] break
diff --git a/library/tk.tcl b/library/tk.tcl
index 076bd35..e7379c1 100644
--- a/library/tk.tcl
+++ b/library/tk.tcl
@@ -3,7 +3,7 @@
 # Initialization script normally executed in the interpreter for each
 # Tk-based application.  Arranges class bindings for widgets.
 #
-# RCS: @(#) $Id: tk.tcl,v 1.34 2001/11/23 02:04:39 das Exp $
+# RCS: @(#) $Id: tk.tcl,v 1.35 2002/02/22 14:07:01 dkf Exp $
 #
 # Copyright (c) 1992-1994 The Regents of the University of California.
 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -357,12 +357,12 @@ switch $::tcl_platform(platform) {
 # Read in files that define all of the class bindings.
 # ----------------------------------------------------------------------
 
-if {[string compare $::tcl_platform(platform) "macintosh"] && \
-	[string compare {} $::tk_library]} {
+if {$::tcl_platform(platform) ne "macintosh" && $::tk_library ne ""} {
     source [file join $::tk_library button.tcl]
     source [file join $::tk_library entry.tcl]
     source [file join $::tk_library listbox.tcl]
     source [file join $::tk_library menu.tcl]
+    source [file join $::tk_library panedwindow.tcl]
     source [file join $::tk_library scale.tcl]
     source [file join $::tk_library scrlbar.tcl]
     source [file join $::tk_library spinbox.tcl]