344 lines
8.8 KiB
Tcl
344 lines
8.8 KiB
Tcl
# -*-mode: tcl; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
|
|
#
|
|
# tixDemo --
|
|
#
|
|
# This is a demo program of all the available Tix widgets. If
|
|
# have installed Tix properly, you can execute this program
|
|
# by changing to this directory and executing
|
|
# the following in csh
|
|
#
|
|
# % env TIX_LIBRARY=../library tixwish tixwidgets.tcl
|
|
#
|
|
# Or this in sh
|
|
#
|
|
# $ TIX_LIBRARY=../library tixwish tixwidgets.tcl
|
|
#
|
|
#----------------------------------------------------------------------
|
|
#
|
|
# This file has not been properly documented. It is NOT intended
|
|
# to be used as an introductory demo program about Tix
|
|
# programming. For such demos, please see the files in the
|
|
# demos/samples directory or go to the "Samples" page in the
|
|
# "widget demo"
|
|
#
|
|
#
|
|
# Copyright (c) 1996, Expert Interface Technologies
|
|
#
|
|
# See the file "license.terms" for information on usage and redistribution
|
|
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
|
#
|
|
|
|
package require Tix
|
|
tix initstyle
|
|
|
|
tk appname "TixDemo#[pid]"
|
|
|
|
proc tixDemo:MkMainWindow {w} {
|
|
global demo auto_path demo_dir
|
|
|
|
# add this directory to the auto_path
|
|
lappend auto_path $demo_dir
|
|
tix addbitmapdir [file join $demo_dir bitmaps]
|
|
|
|
toplevel $w
|
|
wm title $w "Tix Widget Demonstration"
|
|
wm geometry $w 830x566+100+100
|
|
|
|
set demo(balloon) [tixBalloon .demos_balloon]
|
|
|
|
set menu [tixDemo:MkMainMenu $w]
|
|
set frame2 [tixDemo:MkMainNoteBook $w]
|
|
set frame3 [tixDemo:MkMainStatus $w]
|
|
|
|
$w configure -menu $menu
|
|
|
|
pack $frame3 -side bottom -fill x
|
|
pack $frame2 -side top -expand yes -fill both -padx 4 -pady 4
|
|
|
|
$demo(balloon) config -statusbar $demo(statusbar)
|
|
set demo(notebook) $frame2
|
|
}
|
|
|
|
proc tixDemo:MkMainMenu {top} {
|
|
global useBallons
|
|
|
|
set m [menu $top.menu -tearoff 0]
|
|
$m add cascade -label "File" -menu $m.file -underline 0
|
|
$m add cascade -label "Help" -menu $m.help -underline 0
|
|
|
|
menu $m.file -tearoff 0
|
|
$m.file add command -label "Open ... " -command tixDemo:FileOpen \
|
|
-underline 1 -accelerator "Ctrl+O"
|
|
$m.file add sep
|
|
$m.file add command -label "Exit " -command tixDemo:Exit \
|
|
-underline 1 -accelerator "Ctrl+X"
|
|
|
|
menu $m.help -tearoff 0
|
|
$m.help add checkbutton -under 0 -label "Balloon Help " \
|
|
-variable useBallons -onvalue 1 -offvalue 0
|
|
|
|
trace variable useBallons w tixDemo:BalloonHelp
|
|
|
|
set useBallons 1
|
|
|
|
return $m
|
|
}
|
|
|
|
# Create the main display area of the widget programm. This area should
|
|
# utilize the "tixNoteBook" widget once it is available. But now
|
|
# we use the cheap substitute "tixStackWindow"
|
|
#
|
|
proc tixDemo:MkMainNoteBook {top} {
|
|
global demo
|
|
set hasGL 0
|
|
|
|
option add *TixNoteBook.tagPadX 6
|
|
option add *TixNoteBook.tagPadY 4
|
|
option add *TixNoteBook.borderWidth 2
|
|
|
|
set w [tixNoteBook $top.f2 -ipadx 5 -ipady 5]
|
|
|
|
$w add wel -createcmd [list tixDemo:CreatePage tixDemo:MkWelcome $w wel] \
|
|
-label "Welcome" -under 0
|
|
$w add cho -createcmd [list tixDemo:CreatePage MkChoosers $w cho] \
|
|
-label "Choosers" -under 0
|
|
$w add scr -createcmd [list tixDemo:CreatePage MkScroll $w scr] \
|
|
-label "Scrolled Widgets" -under 0
|
|
# There currently is no MkManag.tcl that this expects ?!? - JH
|
|
# $w add mgr -createcmd [list tixDemo:CreatePage MkManager $w mgr] \
|
|
# -label "Manager Widgets" -under 0
|
|
$w add dir -createcmd [list tixDemo:CreatePage MkDirList $w dir] \
|
|
-label "Directory List" -under 0
|
|
$w add exp -createcmd [list tixDemo:CreatePage MkSample $w exp] \
|
|
-label "Run Sample Programs" -under 0
|
|
|
|
if {$hasGL} {
|
|
$w add glw -createcmd [list MkGL $w glw] -tag "GL Widgets"
|
|
}
|
|
|
|
return $w
|
|
}
|
|
|
|
proc tixDemo:CreatePage {command w name} {
|
|
tixBusy $w on
|
|
set code [catch {$command $w $name} err]
|
|
tixBusy $w off
|
|
return -code $code $err
|
|
}
|
|
|
|
proc tixDemo:MkMainStatus {top} {
|
|
global demo demo_dir
|
|
|
|
set w [frame $top.f3 -relief raised -bd 1]
|
|
set demo(statusbar) \
|
|
[label $w.status -relief sunken -bd 1]
|
|
|
|
tixForm $demo(statusbar) -padx 3 -pady 3 -left 0 -right %70
|
|
$w.status configure -text [file native $demo_dir]
|
|
return $w
|
|
}
|
|
|
|
proc tixDemo:Status {msg} {
|
|
global demo
|
|
|
|
$demo(statusbar) configure -text $msg
|
|
}
|
|
|
|
|
|
proc tixDemo:MkWelcome {nb page} {
|
|
set w [$nb subwidget $page]
|
|
|
|
set bar [tixDemo:MkWelcomeBar $w]
|
|
set text [tixDemo:MkWelcomeText $w]
|
|
|
|
pack $bar -side top -fill x -padx 2 -pady 2
|
|
pack $text -side top -fill both -expand yes
|
|
}
|
|
|
|
proc tixDemo:MkWelcomeBar {top} {
|
|
global demo
|
|
|
|
set w [frame $top.bar -bd 2 -relief groove]
|
|
|
|
# Create and configure comboBox 1
|
|
#
|
|
tixComboBox $w.cbx1 -command [list tixDemo:MainTextFont $top] \
|
|
-options {
|
|
entry.width 15
|
|
listbox.height 3
|
|
}
|
|
tixComboBox $w.cbx2 -command [list tixDemo:MainTextFont $top] \
|
|
-options {
|
|
entry.width 4
|
|
listbox.height 3
|
|
}
|
|
set demo(welfont) $w.cbx1
|
|
set demo(welsize) $w.cbx2
|
|
|
|
$w.cbx1 insert end "Courier"
|
|
$w.cbx1 insert end "Helvetica"
|
|
$w.cbx1 insert end "Lucida"
|
|
$w.cbx1 insert end "Times Roman"
|
|
|
|
$w.cbx2 insert end 8
|
|
$w.cbx2 insert end 10
|
|
$w.cbx2 insert end 12
|
|
$w.cbx2 insert end 14
|
|
$w.cbx2 insert end 18
|
|
|
|
$w.cbx1 pick 1
|
|
$w.cbx2 pick 3
|
|
|
|
# Pack the comboboxes together
|
|
#
|
|
pack $w.cbx1 $w.cbx2 -side left -padx 4 -pady 4
|
|
|
|
$demo(balloon) bind $w.cbx1\
|
|
-msg "Choose\na font" -statusmsg "Choose a font for this page"
|
|
$demo(balloon) bind $w.cbx2\
|
|
-msg "Point size" -statusmsg "Choose the font size for this page"
|
|
|
|
|
|
tixDoWhenIdle tixDemo:MainTextFont $top
|
|
return $w
|
|
}
|
|
|
|
proc tixDemo:MkWelcomeText {top} {
|
|
global demo tix_version
|
|
|
|
set w [tixScrolledWindow $top.f3 -scrollbar auto]
|
|
set win [$w subwidget window]
|
|
|
|
label $win.title -font [list times -18 bold] \
|
|
-bd 0 -width 30 -anchor n\
|
|
-text "Welcome to TIX version $tix_version"
|
|
|
|
message $win.msg -font [list helvetica -14 bold] \
|
|
-bd 0 -width 400 -anchor n\
|
|
-text "\
|
|
Tix $tix_version is a library of mega-widgets based on TK. This program \
|
|
demonstrates the widgets in the Tix widget. You can choose the pages \
|
|
in this window to look at the corresponding widgets. \
|
|
To quit this program, choose the \"File | Exit\" command."
|
|
|
|
|
|
pack $win.title -expand yes -fill both -padx 10 -pady 10
|
|
pack $win.msg -expand yes -fill both -padx 10 -pady 10
|
|
set demo(welmsg) $win.msg
|
|
return $w
|
|
}
|
|
|
|
proc tixDemo:MainTextFont {w args} {
|
|
global demo
|
|
|
|
if {![info exists demo(welmsg)]} {
|
|
return
|
|
}
|
|
|
|
set font [$demo(welfont) cget -value]
|
|
set point [$demo(welsize) cget -value]
|
|
|
|
case $font {
|
|
"Courier" {
|
|
set f courier
|
|
}
|
|
"Helvetica" {
|
|
set f helvetica
|
|
}
|
|
"Lucida" {
|
|
set f lucida
|
|
}
|
|
default {
|
|
set f times
|
|
}
|
|
}
|
|
|
|
set xfont [list $f -$point]
|
|
if [catch {$demo(welmsg) config -font $xfont} err] {
|
|
puts \a$err
|
|
}
|
|
}
|
|
|
|
proc tixDemo:FileOpen {} {
|
|
global demo demo_dir
|
|
set filedlg [tix filedialog tixExFileSelectDialog]
|
|
if {![info exists demo(filedialog)]} {
|
|
$filedlg subwidget fsbox config -pattern *.tcl
|
|
$filedlg subwidget fsbox config -directory [file join $demo_dir samples]
|
|
$filedlg config -command tixDemo:FileOpen:Doit
|
|
set demo(filedialog) $filedlg
|
|
}
|
|
$filedlg config -title "Open Tix Sample Programs"
|
|
wm transient $filedlg ""
|
|
wm deiconify $filedlg
|
|
after idle raise $filedlg
|
|
$filedlg popup
|
|
tixPushGrab $filedlg
|
|
}
|
|
|
|
proc tixDemo:FileOpen:Doit {filename} {
|
|
global demo
|
|
|
|
tixPopGrab
|
|
LoadFile $filename
|
|
$demo(filedialog) popdown
|
|
}
|
|
|
|
#----------------------------------------------------------------------
|
|
# Balloon Help
|
|
#----------------------------------------------------------------------
|
|
proc tixDemo:BalloonHelp {args} {
|
|
global demo useBallons
|
|
|
|
if {$useBallons} {
|
|
$demo(balloon) config -state "both"
|
|
} else {
|
|
$demo(balloon) config -state "none"
|
|
}
|
|
}
|
|
|
|
#----------------------------------------------------------------------
|
|
# Self-testing
|
|
#
|
|
# The following code are called by the Tix test suite. It opens
|
|
# every page in the demo program.
|
|
#----------------------------------------------------------------------
|
|
proc tixDemo:SelfTest {} {
|
|
global demo testConfig
|
|
|
|
if ![info exists testConfig] {
|
|
return
|
|
}
|
|
|
|
tixDemo:MkMainWindow .widget
|
|
|
|
update
|
|
foreach p [$demo(notebook) pages] {
|
|
$demo(notebook) raise $p
|
|
update
|
|
}
|
|
|
|
destroy .widget
|
|
}
|
|
|
|
proc tixDemo:Exit {} {
|
|
destroy .widget
|
|
}
|
|
|
|
#----------------------------------------------------------------------
|
|
# Start!
|
|
#----------------------------------------------------------------------
|
|
|
|
if {![info exists testConfig]} {
|
|
#
|
|
# If the testConfig variable exists, we are driven by the regression
|
|
# test. In that case, don't open the main window. The test program will
|
|
# call Widget:SelfTest
|
|
#
|
|
set kids [winfo children .]
|
|
wm withdraw .
|
|
set ::demo_dir [file normalize [file dirname [info script]]]
|
|
tixDemo:MkMainWindow .widget
|
|
wm transient .widget ""
|
|
if {[llength $kids] < 1} {bind .widget <Destroy> "exit"}
|
|
}
|