More widget demo improvements.

2 files changed, 50 insertions, 13 deletions

diff --git a/ChangeLog b/ChangeLog
index 0ee81df..618989c 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2001-11-30  Donal K. Fellows  <fellowsd@cs.man.ac.uk>
+
+	* library/demos/widget: Further overhauling; shrank fonts, made
+	better use of fonts, added an icon, fixed the About box.  Prompted
+	by Bug #487442 from Vincent Wartelle.
+
 2001-11-29  Donal K. Fellows  <fellowsd@cs.man.ac.uk>
 
 	* library/palette.tcl (tk_setPalette): Added heuristic to guess
diff --git a/library/demos/widget b/library/demos/widget
index 349667a..3b547b7 100644
--- a/library/demos/widget
+++ b/library/demos/widget
@@ -11,11 +11,30 @@ exec wish "$0" "$@"
 # ".tcl" files is this directory, which are sourced by this script
 # as needed.
 #
-# RCS: @(#) $Id: widget,v 1.5 2001/11/19 14:02:29 dkf Exp $
+# RCS: @(#) $Id: widget,v 1.6 2001/11/30 11:25:41 dkf Exp $
 
 eval destroy [winfo child .]
 wm title . "Widget Demonstration"
+if {$tcl_platform(platform) eq "unix"} {
+    # This won't work everywhere, but there's no other way in core Tk
+    # at the moment to display a coloured icon.
+    image create photo TclPowered \
+	    -file [file join $tk_library images logo64.gif]
+    wm iconwindow . [toplevel ._iconWindow]
+    pack [label ._iconWindow.i -image TclPowered]
+    wm iconname . "tkWidgetDemo"
+}
+
+array set widgetFont {
+    main   {Helvetica 12}
+    bold   {Helvetica 12 bold}
+    title  {Helvetica 18 bold}
+    status {Helvetica 10}
+    vars   {Helvetica 14}
+}
+
 set widgetDemo 1
+set font $widgetFont(main)
 
 #----------------------------------------------------------------
 # The code below create the main window, consisting of a menu bar
@@ -23,7 +42,6 @@ set widgetDemo 1
 # all of the demos as hypertext items.
 #----------------------------------------------------------------
 
-set font {Helvetica 14}
 menu .menuBar -tearoff 0
 .menuBar add cascade -menu .menuBar.file -label "File" -underline 0
 menu .menuBar.file -tearoff 0
@@ -46,9 +64,9 @@ bind . <F1> aboutBox
 
 frame .statusBar
 label .statusBar.lab -text "   " -relief sunken -bd 1 \
-    -font -*-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* -anchor w
+	-font $widgetFont(status) -anchor w
 label .statusBar.foo -width 8 -relief sunken -bd 1 \
-    -font -*-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* -anchor w
+	-font $widgetFont(status) -anchor w
 pack .statusBar.lab -side left -padx 2 -expand yes -fill both
 pack .statusBar.foo -side left -padx 2
 pack .statusBar -side bottom -fill x -pady 2
@@ -57,8 +75,9 @@ frame .textFrame
 scrollbar .s -orient vertical -command {.t yview} -highlightthickness 0 \
     -takefocus 1
 pack .s -in .textFrame -side right -fill y
-text .t -yscrollcommand {.s set} -wrap word -width 60 -height 30 -font $font \
-    -setgrid 1 -highlightthickness 0 -padx 4 -pady 2 -takefocus 0
+text .t -yscrollcommand {.s set}  -wrap word  -width 70  -height 30 \
+	-font $widgetFont(main)  -setgrid 1  -highlightthickness 0 \
+	-padx 4  -pady 2  -takefocus 0
 pack .t -in .textFrame -expand y -fill both -padx 1
 pack  .textFrame -expand yes -fill both
 
@@ -66,7 +85,8 @@ pack  .textFrame -expand yes -fill both
 # section titles and demo descriptions.  Also define the bindings for
 # tags.
 
-.t tag configure title -font {Helvetica 18 bold}
+.t tag configure title -font $widgetFont(title)
+.t tag configure bold  -font $widgetFont(bold)
 
 # We put some "space" characters to the left and right of each demo description
 # so that the descriptions are highlighted only when the mouse cursor
@@ -130,9 +150,15 @@ proc addDemoSection {title demos} {
 }
 
 .t insert end "Tk Widget Demonstrations\n" title
-.t insert end {
-This application provides a front end for several short scripts that demonstrate what you can do with Tk widgets.  Each of the numbered lines below describes a demonstration;  you can click on it to invoke the demonstration.  Once the demonstration window appears, you can click the "See Code" button to see the Tcl/Tk code that created the demonstration.  If you wish, you can edit the code and click the "Rerun Demo" button in the code window to reinvoke the demonstration with the modified code.
-}
+.t insert end "\nThis application provides a front end for several short\
+	scripts that demonstrate what you can do with Tk widgets.  Each of\
+	the numbered lines below describes a demonstration;  you can click\
+	on it to invoke the demonstration.  Once the demonstration window\
+	appears, you can click the " {} "See Code" bold " button to see the\
+	Tcl/Tk code that created the demonstration.  If you wish, you can\
+	edit the code and click the " {} "Rerun Demo" bold " button in the\
+	code window to reinvoke the demonstration with the modified code.\n"
+
 addDemoSection "Labels, buttons, checkbuttons, and radiobuttons" {
     label	"Labels (text and bitmaps)"
     button	"Buttons"
@@ -214,11 +240,12 @@ proc positionWindow w {
 # args -	Any number of names of variables.
 
 proc showVars {w args} {
+    global widgetFont
     catch {destroy $w}
     toplevel $w
     wm title $w "Variable values"
     label $w.title -text "Variable values:" -width 20 -anchor center \
-	    -font {Helvetica 18}
+	    -font $widgetFont(vars)
     pack $w.title -side top -fill x
     set len 1
     foreach i $args {
@@ -348,8 +375,12 @@ proc showCode w {
 #
 proc aboutBox {} {
     tk_messageBox -icon info -type ok -title "About Widget Demo" -message \
-"Tk widget demonstration\n\n\
-Copyright (c) 1996-1997 Sun Microsystems, Inc.\n
+"Tk widget demonstration
+
+Copyright (c) 1996-1997 Sun Microsystems, Inc.
+
+Copyright (c) 1997-2000 Ajuba Solutions, Inc.
+
 Copyright (c) 2001 Donal K. Fellows"
 }