#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"

# widget --
# This script demonstrates the various widgets provided by Tk,
# along with many of the features of the Tk toolkit.  This file
# only contains code to generate the main window for the
# application, which invokes individual demonstrations.  The
# code for the actual demonstrations is contained in separate
# ".tcl" files is this directory, which are sourced by this script
# as needed.
#
# RCS: @(#) $Id: widget,v 1.10 2003/05/19 14:44:04 dkf Exp $

eval destroy [winfo child .]
package require msgcat
::msgcat::mcload [file join $tk_library demos]
namespace import ::msgcat::mc
wm title . [mc "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 . [mc "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
# and a text widget that explains how to use the program, plus lists
# all of the demos as hypertext items.
#----------------------------------------------------------------

menu .menuBar -tearoff 0
# This is a tk-internal procedure to make i18n easier
::tk::AmpMenuArgs .menuBar add cascade -label [mc "&File"] -menu .menuBar.file
menu .menuBar.file -tearoff 0

# On the Mac use the specia .apple menu for the about item
if {[tk windowingsystem] eq "classic"} {
    .menuBar add cascade -menu .menuBar.apple
    menu .menuBar.apple -tearoff 0
    .menuBar.apple add command -label [mc "About..."] -command {aboutBox}
} else {
    ::tk::AmpMenuArgs .menuBar.file add command -label [mc "&About..."] \
	    -command {aboutBox} -accelerator [mc "<F1>"]
    .menuBar.file add sep
}

::tk::AmpMenuArgs .menuBar.file add command -label [mc "&Quit"] \
	-command {exit} -accelerator [mc "Meta-Q"]
. configure -menu .menuBar
bind . <F1>     {aboutBox}
bind . <Meta-q> {exit}

frame .statusBar
label .statusBar.lab -text "   " -relief sunken -bd 1 \
	-font $widgetFont(status) -anchor w
label .statusBar.foo -width 8 -relief sunken -bd 1 \
	-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

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 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

# Create a bunch of tags to use in the text widget, such as those for
# section titles and demo descriptions.  Also define the bindings for
# tags.

.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
# is right over them (but not when the cursor is to their left or right)
#
.t tag configure demospace -lmargin1 1c -lmargin2 1c


if {[winfo depth .] == 1} {
    .t tag configure demo -lmargin1 1c -lmargin2 1c \
	-underline 1
    .t tag configure visited -lmargin1 1c -lmargin2 1c \
	-underline 1
    .t tag configure hot -background black -foreground white
} else {
    .t tag configure demo -lmargin1 1c -lmargin2 1c \
	-foreground blue -underline 1
    .t tag configure visited -lmargin1 1c -lmargin2 1c \
	-foreground #303080 -underline 1
    .t tag configure hot -foreground red -underline 1
}
.t tag bind demo <ButtonRelease-1> {
    invoke [.t index {@%x,%y}]
}
set lastLine ""
.t tag bind demo <Enter> {
    set lastLine [.t index {@%x,%y linestart}]
    .t tag add hot "$lastLine +1 chars" "$lastLine lineend -1 chars"
    .t config -cursor hand2
    showStatus [.t index {@%x,%y}]
}
.t tag bind demo <Leave> {
    .t tag remove hot 1.0 end
    .t config -cursor xterm
    .statusBar.lab config -text ""
}
.t tag bind demo <Motion> {
    set newLine [.t index {@%x,%y linestart}]
    if {$newLine ne $lastLine} {
	.t tag remove hot 1.0 end
	set lastLine $newLine

	set tags [.t tag names {@%x,%y}]
	set i [lsearch -glob $tags demo-*]
	if {$i >= 0} {
	    .t tag add hot "$lastLine +1 chars" "$lastLine lineend -1 chars"
	}
    }
    showStatus [.t index {@%x,%y}]
}

# Create the text for the text widget.

# addFormattedText --
#
#	Add formatted text (but not hypertext) to the text widget after
#	first passing it through the message catalog to allow for
#	localization.  Lines starting with @@ are formatting directives
#	(begin newline, or change style) and all other lines are literal
#	strings to be inserted.  Blank lines are ignored.
#
proc addFormattedText {formattedText} {
    set style normal
    set isNL 1
    foreach line [split [mc $formattedText] \n] {
	set line [string trim $line]
	if {$line eq ""} {
	    continue
	}
	if {$line eq "@@newline"} {
	    .t insert end \n $style
	    set isNL 1
	    continue
	}
	if {[string match @@* $line]} {
	    set style [string range $line 1 end]
	    continue
	}
	if {!$isNL} {
	    .t insert end " " $style
	}
	set isNL 0
	.t insert end $line $style
    }
}

# addDemoSection --
#
#	Add a new section of demos with a title and a (stride-2) list of
#	demo files and their descriptions.  Titles and descriptions are
#	passed through the message catalog to allow for localization.
#
proc addDemoSection {title demos} {
    .t insert end "\n" {} [mc $title] title " \n " demospace
    set num 0
    foreach {name description} $demos {
	.t insert end "[incr num]. [mc $description]." [list demo demo-$name]
	.t insert end " \n " demospace
    }
}

addFormattedText {
    @@title
    Tk Widget Demonstrations
    @@newline
    @@normal
    @@newline

    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
    @@bold
    See Code
    @@normal
    button to see the Tcl/Tk code that created the demonstration.  If
    you wish, you can edit the code and click the
    @@bold
    Rerun Demo
    @@normal
    button in the code window to reinvoke the demonstration with the
    modified code.
    @@newline
}
addDemoSection "Labels, buttons, checkbuttons, and radiobuttons" {
    label	"Labels (text and bitmaps)"
    unicodeout	"Labels and UNICODE text"
    button	"Buttons"
    check	"Check-buttons (select any of a group)"
    radio	"Radio-buttons (select one of a group)"
    puzzle	"A 15-puzzle game made out of buttons"
    icon	"Iconic buttons that use bitmaps"
    image1	"Two labels displaying images"
    image2	"A simple user interface for viewing images"
    labelframe	"Labelled frames"
}
addDemoSection "Listboxes" {
    states	"The 50 states"
    colors	"Colors: change the color scheme for the application"
    sayings	"A collection of famous and infamous sayings"
}
addDemoSection "Entries and Spin-boxes" {
    entry1	"Entries without scrollbars"
    entry2	"Entries with scrollbars"
    entry3	"Validated entries and password fields"
    spin	"Spin-boxes"
    form	"Simple Rolodex-like form"
}
addDemoSection "Text" {
    text	"Basic editable text"
    style	"Text display styles"
    bind	"Hypertext (tag bindings)"
    twind	"A text widget with embedded windows"
    search	"A search tool built with a text widget"
}
addDemoSection "Canvases" {
    items	"The canvas item types"
    plot	"A simple 2-D plot"
    ctext	"Text items in canvases"
    arrow	"An editor for arrowheads on canvas lines"
    ruler	"A ruler with adjustable tab stops"
    floor	"A building floor plan"
    cscroll	"A simple scrollable canvas"
}
addDemoSection "Scales" {
    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)"
    menubu	"Menu-buttons"
}
addDemoSection "Common Dialogs" {
    msgbox	"Message boxes"
    filebox	"File selection dialog"
    clrpick	"Color picker"
}
addDemoSection "Miscellaneous" {
    bitmap	"The built-in bitmaps"
    dialog1	"A dialog box with a local grab"
    dialog2	"A dialog box with a global grab"
}

.t configure -state disabled
focus .s

# positionWindow --
# This procedure is invoked by most of the demos to position a
# new demo window.
#
# Arguments:
# w -		The name of the window to position.

proc positionWindow w {
    wm geometry $w +300+300
}

# showVars --
# Displays the values of one or more variables in a window, and
# updates the display whenever any of the variables changes.
#
# Arguments:
# w -		Name of new window to create for display.
# args -	Any number of names of variables.

proc showVars {w args} {
    global widgetFont
    catch {destroy $w}
    toplevel $w
    wm title $w [mc "Variable values"]
    label $w.title -text [mc "Variable values:"] -width 20 -anchor center \
	    -font $widgetFont(vars)
    pack $w.title -side top -fill x
    set len 1
    foreach i $args {
	if {[string length $i] > $len} {
	    set len [string length $i]
	}
    }
    foreach i $args {
	frame $w.$i
	label $w.$i.name -text "$i: " -width [expr $len + 2] -anchor w
	label $w.$i.value -textvar $i -anchor w
	pack $w.$i.name -side left
	pack $w.$i.value -side left -expand 1 -fill x
	pack $w.$i -side top -anchor w -fill x
    }
    button $w.ok -text [mc "OK"] -command [list destroy $w] -default active
    bind $w <Return> [list tkButtonInvoke $w.ok]
    bind $w <Escape> [list tkButtonInvoke $w.ok]
    pack $w.ok -side bottom -pady 2
}

# invoke --
# This procedure is called when the user clicks on a demo description.
# It is responsible for invoking the demonstration.
#
# Arguments:
# index -	The index of the character that the user clicked on.

proc invoke index {
    global tk_library
    set tags [.t tag names $index]
    set i [lsearch -glob $tags demo-*]
    if {$i < 0} {
	return
    }
    set cursor [.t cget -cursor]
    .t configure -cursor watch
    update
    set demo [string range [lindex $tags $i] 5 end]
    uplevel [list source [file join $tk_library demos $demo.tcl]]
    update
    .t configure -cursor $cursor

    .t tag add visited "$index linestart +1 chars" "$index lineend -1 chars"
}

# showStatus --
#
#	Show the name of the demo program in the status bar. This procedure
#	is called when the user moves the cursor over a demo description.
#
proc showStatus index {
    global tk_library
    set tags [.t tag names $index]
    set i [lsearch -glob $tags demo-*]
    set cursor [.t cget -cursor]
    if {$i < 0} {
	.statusBar.lab config -text " "
	set newcursor xterm
    } else {
	set demo [string range [lindex $tags $i] 5 end]
	.statusBar.lab config -text [mc "Run the \"%s\" sample program" $demo]
	set newcursor hand2
    }
    if {$cursor ne $newcursor} {
	.t config -cursor $newcursor
    }
}


# showCode --
# This procedure creates a toplevel window that displays the code for
# a demonstration and allows it to be edited and reinvoked.
#
# Arguments:
# w -		The name of the demonstration's window, which can be
#		used to derive the name of the file containing its code.

proc showCode w {
    global tk_library
    set file [string range $w 1 end].tcl
    if {![winfo exists .code]} {
	toplevel .code
	frame .code.buttons
	pack .code.buttons -side bottom -fill x
	button .code.buttons.dismiss -text [mc "Dismiss"] \
		-default active -command {destroy .code}
	button .code.buttons.rerun -text [mc "Rerun Demo"] -command {
	    eval [.code.text get 1.0 end]
	}
	pack .code.buttons.dismiss .code.buttons.rerun -side left \
		-expand 1 -pady 2
	frame .code.frame
	pack  .code.frame -expand yes -fill both -padx 1 -pady 1
	text .code.text -height 40 -wrap word \
		-xscrollcommand {.code.xscroll set} \
		-yscrollcommand {.code.yscroll set} \
		-setgrid 1 -highlightthickness 0 -pady 2 -padx 3
	scrollbar .code.xscroll -command {.code.text xview} \
		-highlightthickness 0 -orient horizontal
	scrollbar .code.yscroll -command {.code.text yview} \
		-highlightthickness 0 -orient vertical

	grid .code.text -in .code.frame -padx 1 -pady 1 \
	    -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news
	grid .code.yscroll -in .code.frame -padx 1 -pady 1 \
	    -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news
#	grid .code.xscroll -in .code.frame -padx 1 -pady 1 \
#	    -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
	grid rowconfig    .code.frame 0 -weight 1 -minsize 0
	grid columnconfig .code.frame 0 -weight 1 -minsize 0
    } else {
	wm deiconify .code
	raise .code
    }
    wm title .code [mc "Demo code: %s" [file join $tk_library demos $file]]
    wm iconname .code $file
    set id [open [file join $tk_library demos $file]]
    .code.text delete 1.0 end
    .code.text insert 1.0 [read $id]
    .code.text mark set insert 1.0
    close $id
}

# aboutBox --
#
#	Pops up a message box with an "about" message
#
proc aboutBox {} {
    tk_messageBox -icon info -type ok -title [mc "About Widget Demo"] \
	    -message "[mc {Tk widget demonstration application}]

[mc {Copyright (c) %s} {1996-1997 Sun Microsystems, Inc.}]
[mc {Copyright (c) %s} {1997-2000 Ajuba Solutions, Inc.}]
[mc {Copyright (c) %s} {2001-2003 Donal K. Fellows}]"
}

# Local Variables:
# mode: tcl
# End: