You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
451 lines
13 KiB
451 lines
13 KiB
6 years ago
|
#!/bin/sh
|
||
|
|
# the next line restarts using wish \
|
||
|
|
exec wish "$0" "$@"
|
||
|
|
|
||
|
|
# widget --
|
||
|
|
#
|
||
|
|
# This script demonstrates the various widgets provided by Tix,
|
||
|
|
# along with many of the features of the Tix library. 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 in the samples/ subdirectory, which are sourced
|
||
|
|
# by this script as needed.
|
||
|
|
#
|
||
|
|
# Copyright (c) 1992-1994 The Regents of the University of California.
|
||
|
|
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
|
||
|
|
# Copyright (c) 1998-2000 Scriptics Corporation.
|
||
|
|
# Copyright (c) 2000-2001 Tix Project Group.
|
||
|
|
#
|
||
|
|
# See the file "license.terms" for information on usage and redistribution
|
||
|
|
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||
|
|
# $Id: widget,v 1.7 2008/03/17 22:58:51 hobbs Exp $
|
||
|
|
|
||
|
|
package require Tix
|
||
|
|
tix initstyle
|
||
|
|
eval destroy [winfo child .]
|
||
|
|
wm title . "Tix Widget Tour"
|
||
|
|
set tix_demo_running 1
|
||
|
|
set demo_dir [file dirname [info script]]
|
||
|
|
tix addbitmapdir [file join $demo_dir bitmaps]
|
||
|
|
|
||
|
|
# createMainWindow --
|
||
|
|
#
|
||
|
|
# Creates 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.
|
||
|
|
|
||
|
|
proc createMainWindow {} {
|
||
|
|
global tcl_platform old_cursor
|
||
|
|
|
||
|
|
switch $tcl_platform(platform) {
|
||
|
|
"windows" {
|
||
|
|
set font {Arial 12}
|
||
|
|
}
|
||
|
|
"unix" {
|
||
|
|
set font {Helvetica 12}
|
||
|
|
}
|
||
|
|
default {
|
||
|
|
set font {Helvetica 12}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
menu .menuBar -tearoff 0
|
||
|
|
.menuBar add cascade -menu .menuBar.file -label "File" -underline 0
|
||
|
|
menu .menuBar.file -tearoff 0
|
||
|
|
|
||
|
|
# On the Mac use the specia .apple menu for the about item
|
||
|
|
if {$tcl_platform(platform) eq "macintosh"} {
|
||
|
|
.menuBar add cascade -menu .menuBar.apple
|
||
|
|
menu .menuBar.apple -tearoff 0
|
||
|
|
.menuBar.apple add command -label "About ..." -command "aboutBox"
|
||
|
|
} else {
|
||
|
|
.menuBar.file add command -label "About ..." -command "aboutBox"
|
||
|
|
.menuBar.file add sep
|
||
|
|
}
|
||
|
|
|
||
|
|
.menuBar.file add command -label "Exit" -command "exit"
|
||
|
|
. configure -menu .menuBar
|
||
|
|
|
||
|
|
frame .statusBar
|
||
|
|
label .statusBar.lab -text " " -relief sunken -bd 1 \
|
||
|
|
-font -*-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* -anchor w
|
||
|
|
label .statusBar.foo -width 8 -relief sunken -bd 1 \
|
||
|
|
-font -*-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* -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 55 -height 30 \
|
||
|
|
-font $font \
|
||
|
|
-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
|
||
|
|
|
||
|
|
if {$tcl_platform(platform) eq "windows"} {
|
||
|
|
#
|
||
|
|
# Make the scrollbar look win32
|
||
|
|
#
|
||
|
|
|
||
|
|
.textFrame config -bd 2 -relief sunken
|
||
|
|
.t config -bd 0
|
||
|
|
pack .t -padx 0
|
||
|
|
}
|
||
|
|
|
||
|
|
set old_cursor [.t cget -cursor]
|
||
|
|
|
||
|
|
# 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 {Helvetica 18 bold} -justify center
|
||
|
|
.t tag configure header -font {Helvetica 14 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 -spacing1 1
|
||
|
|
.t tag configure codeicon -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}]
|
||
|
|
}
|
||
|
|
.t tag bind codeicon <ButtonRelease-1> {
|
||
|
|
showCode [.t index [list {@%x,%y} +2 chars]]
|
||
|
|
}
|
||
|
|
global lastLine
|
||
|
|
set lastLine ""
|
||
|
|
.t tag bind demo <Enter> {
|
||
|
|
set lastLine [.t index {@%x,%y linestart}]
|
||
|
|
.t tag add hot [list $lastLine +3 chars] \
|
||
|
|
[list $lastLine lineend -1 chars]
|
||
|
|
.t config -cursor hand2
|
||
|
|
showStatus run [.t index {@%x,%y}]
|
||
|
|
}
|
||
|
|
.t tag bind demo <Leave> {
|
||
|
|
.t tag remove hot 1.0 end
|
||
|
|
.t config -cursor $old_cursor
|
||
|
|
.statusBar.lab config -text ""
|
||
|
|
}
|
||
|
|
.t tag bind demo <Motion> {
|
||
|
|
set newLine [.t index {@%x,%y linestart}]
|
||
|
|
if {[string compare $newLine $lastLine] != 0} {
|
||
|
|
.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 [list $lastLine +3 chars] \
|
||
|
|
[list $lastLine lineend -1 chars]
|
||
|
|
}
|
||
|
|
}
|
||
|
|
showStatus run [.t index {@%x,%y}]
|
||
|
|
}
|
||
|
|
|
||
|
|
.t tag bind codeicon <Enter> {
|
||
|
|
.t config -cursor hand2
|
||
|
|
}
|
||
|
|
.t tag bind codeicon <Leave> {
|
||
|
|
.t config -cursor $old_cursor
|
||
|
|
}
|
||
|
|
.t tag bind codeicon <Motion> {
|
||
|
|
set tags [.t tag names [list {@%x,%y} +2 chars]]
|
||
|
|
set i [lsearch -glob $tags demo-*]
|
||
|
|
if {$i >= 0} {
|
||
|
|
showStatus code [.t index [list {@%x,%y} +2 chars]]
|
||
|
|
} else {
|
||
|
|
showStatus code ""
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# Create the text for the text widget.
|
||
|
|
|
||
|
|
.t insert end "Tix Widget Tour\n" title
|
||
|
|
addNewLine .t
|
||
|
|
addText .t {
|
||
|
|
This program demonstrates the features of the Tix
|
||
|
|
library. Click on one of the highlighted lines below to run
|
||
|
|
the sample program and click on the
|
||
|
|
}
|
||
|
|
addSpace .t
|
||
|
|
.t image create end -image [tix getimage code]
|
||
|
|
addSpace .t
|
||
|
|
addText .t {
|
||
|
|
icon to view its source code.
|
||
|
|
}
|
||
|
|
|
||
|
|
addNewLine .t
|
||
|
|
addNewLine .t
|
||
|
|
|
||
|
|
addHeader .t "Hierachical ListBox"
|
||
|
|
|
||
|
|
addDemo .t HList1.tcl "Simple HList"
|
||
|
|
addDemo .t ChkList.tcl "CheckList"
|
||
|
|
addDemo .t SHList.tcl "ScrolledHList (1)"
|
||
|
|
addDemo .t SHList2.tcl "ScrolledHList (2)"
|
||
|
|
addDemo .t Tree.tcl "Simple Tree"
|
||
|
|
|
||
|
|
# TODO
|
||
|
|
# addDemo .t "Dynamic Tree" DynTree.tcl
|
||
|
|
|
||
|
|
addHeader .t "Tabular ListBox"
|
||
|
|
|
||
|
|
addDemo .t STList1.tcl "ScrolledTList (1)"
|
||
|
|
addDemo .t STList2.tcl "ScrolledTList (2)"
|
||
|
|
addDemo .t STList3.tcl "TList File Viewer"
|
||
|
|
|
||
|
|
addHeader .t "Grid Widget"
|
||
|
|
|
||
|
|
addDemo .t SGrid0.tcl "Simple Grid"
|
||
|
|
addDemo .t SGrid1.tcl "ScrolledGrid"
|
||
|
|
addDemo .t EditGrid.tcl "Editable Grid"
|
||
|
|
|
||
|
|
addHeader .t "Manager Widgets"
|
||
|
|
|
||
|
|
addDemo .t ListNBK.tcl ListNoteBook
|
||
|
|
addDemo .t NoteBook.tcl NoteBook
|
||
|
|
addDemo .t PanedWin.tcl PanedWindow
|
||
|
|
|
||
|
|
addHeader .t "Scrolled Widgets"
|
||
|
|
|
||
|
|
addDemo .t SListBox.tcl ScrolledListBox
|
||
|
|
addDemo .t SText.tcl ScrolledText
|
||
|
|
addDemo .t SWindow.tcl ScrolledWindow
|
||
|
|
addDemo .t CObjView.tcl "Canvas Object View"
|
||
|
|
|
||
|
|
addHeader .t "Miscellaneous Widgets"
|
||
|
|
|
||
|
|
addDemo .t Balloon.tcl Balloon
|
||
|
|
addDemo .t BtnBox.tcl ButtonBox
|
||
|
|
addDemo .t ComboBox.tcl ComboBox
|
||
|
|
addDemo .t Control.tcl Control
|
||
|
|
addDemo .t LabEntry.tcl LabelEntry
|
||
|
|
addDemo .t LabFrame.tcl LabelFrame
|
||
|
|
addDemo .t Meter.tcl Meter
|
||
|
|
addDemo .t OptMenu.tcl OptionMenu
|
||
|
|
addDemo .t PopMenu.tcl PopupMenu
|
||
|
|
addDemo .t Select.tcl Select
|
||
|
|
addDemo .t StdBBox.tcl StdButtonBox
|
||
|
|
|
||
|
|
addHeader .t "Image Types"
|
||
|
|
|
||
|
|
addDemo .t CmpImg.tcl "Compound image in buttons"
|
||
|
|
addDemo .t CmpImg3.tcl "Compound image in icons"
|
||
|
|
#addDemo .t CmpImg2.tcl "Compound image in notebook"
|
||
|
|
#addDemo .t CmpImg4.tcl \
|
||
|
|
# "Create color tabs in notebook using compound image"
|
||
|
|
|
||
|
|
addDemo .t Xpm.tcl "XPM pixmap image in buttons"
|
||
|
|
addDemo .t Xpm1.tcl "XPM pixmap image in menu"
|
||
|
|
|
||
|
|
.t configure -state disabled
|
||
|
|
focus .s
|
||
|
|
|
||
|
|
#
|
||
|
|
# Because .t is disabled and not focused, we have to do the
|
||
|
|
# following hacks to make the scrolling work well
|
||
|
|
#
|
||
|
|
bind .s <MouseWheel> {
|
||
|
|
.t yview scroll [expr {- (%D / 120) * 2}] units
|
||
|
|
}
|
||
|
|
bind .s <Up> {
|
||
|
|
.t yview scroll -1 units
|
||
|
|
}
|
||
|
|
bind .s <Down> {
|
||
|
|
.t yview scroll 1 units
|
||
|
|
}
|
||
|
|
bind .s <Prior> {
|
||
|
|
.t yview scroll -1 page
|
||
|
|
}
|
||
|
|
bind .s <Next> {
|
||
|
|
.t yview scroll 1 page
|
||
|
|
}
|
||
|
|
bind .s <Home> {
|
||
|
|
.t yview 1.0
|
||
|
|
}
|
||
|
|
bind .s <End> {
|
||
|
|
.t yview end
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# 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 demo_dir
|
||
|
|
|
||
|
|
# Find out which sample to run
|
||
|
|
set tags [.t tag names $index]
|
||
|
|
set i [lsearch -glob $tags demo-*]
|
||
|
|
if {$i < 0} {
|
||
|
|
return
|
||
|
|
}
|
||
|
|
set demo [string range [lindex $tags $i] 5 end]
|
||
|
|
set title [string trim [.t get [list $index linestart +3 chars] \
|
||
|
|
[list $index lineend]]]
|
||
|
|
# Get the name of this sample
|
||
|
|
set w .[lindex [split $demo .] 0]
|
||
|
|
set w [string tolower $w]
|
||
|
|
|
||
|
|
if [winfo exists $w] {
|
||
|
|
wm deiconify $w
|
||
|
|
raise $w
|
||
|
|
return
|
||
|
|
}
|
||
|
|
|
||
|
|
# Load the sample if it's not running
|
||
|
|
set cursor [.t cget -cursor]
|
||
|
|
.t configure -cursor watch
|
||
|
|
update
|
||
|
|
uplevel #0 [list source [file join $demo_dir samples $demo]]
|
||
|
|
|
||
|
|
toplevel $w
|
||
|
|
wm title $w $title
|
||
|
|
RunSample $w
|
||
|
|
|
||
|
|
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 {which index} {
|
||
|
|
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]
|
||
|
|
if {"$which" == "run"} {
|
||
|
|
set text "Run the \"$demo\" sample program"
|
||
|
|
} else {
|
||
|
|
set text "Show code of the \"$demo\" sample program"
|
||
|
|
}
|
||
|
|
.statusBar.lab config -text $text
|
||
|
|
set newcursor hand2
|
||
|
|
}
|
||
|
|
if [string compare $cursor $newcursor] {
|
||
|
|
.t config -cursor $newcursor
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# showCode --
|
||
|
|
# This procedure is called when the user clicks on the "code" icon.
|
||
|
|
# It is responsible for displaying the code of the selected sample program.
|
||
|
|
#
|
||
|
|
# Arguments:
|
||
|
|
# index - The index of the character that the user clicked on.
|
||
|
|
|
||
|
|
proc showCode {index} {
|
||
|
|
global demo_dir
|
||
|
|
|
||
|
|
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]
|
||
|
|
|
||
|
|
# Create the .code window
|
||
|
|
if {![winfo exists .code]} {
|
||
|
|
toplevel .code
|
||
|
|
frame .code.f
|
||
|
|
tixScrolledText .code.st
|
||
|
|
button .code.close -text Close -width 6 -command "wm withdraw .code"
|
||
|
|
pack .code.f -side bottom -fill x
|
||
|
|
pack .code.st -side top -fill both -expand yes
|
||
|
|
pack .code.close -in .code.f -side right -padx 10 -pady 10
|
||
|
|
}
|
||
|
|
set text [.code.st subwidget text]
|
||
|
|
$text delete 1.0 end
|
||
|
|
set fd [open [file join $demo_dir samples $demo]]
|
||
|
|
set data [read $fd]
|
||
|
|
close $fd
|
||
|
|
$text insert end $data
|
||
|
|
|
||
|
|
wm deiconify .code
|
||
|
|
wm title .code [file nativename [file join $demo_dir samples $demo]]
|
||
|
|
update
|
||
|
|
.t configure -cursor $cursor
|
||
|
|
}
|
||
|
|
|
||
|
|
proc addText {t text} {
|
||
|
|
regsub -all \n+ $text " " text
|
||
|
|
regsub -all {[ ]+} $text " " text
|
||
|
|
$t insert end [string trim $text]
|
||
|
|
}
|
||
|
|
|
||
|
|
proc addHeader {t text} {
|
||
|
|
addNewLine $t
|
||
|
|
$t insert end [string trim $text] header
|
||
|
|
addNewLine $t
|
||
|
|
}
|
||
|
|
|
||
|
|
proc addNewLine {t} {
|
||
|
|
$t insert end "\n" {demospace}
|
||
|
|
}
|
||
|
|
|
||
|
|
proc addSpace {t} {
|
||
|
|
$t insert end " " {demospace}
|
||
|
|
}
|
||
|
|
|
||
|
|
proc addDemo {t name text} {
|
||
|
|
$t insert end " " demospace
|
||
|
|
$t image create end -image [tix getimage code]
|
||
|
|
$t tag add codeicon [list end -2 chars] [list end -1 chars]
|
||
|
|
$t insert end " " demospace
|
||
|
|
$t insert end $text [list demo demo-$name]
|
||
|
|
$t insert end " " demospace
|
||
|
|
addNewLine $t
|
||
|
|
}
|
||
|
|
|
||
|
|
# aboutBox --
|
||
|
|
#
|
||
|
|
# Pops up a message box with an "about" message
|
||
|
|
#
|
||
|
|
proc aboutBox {} {
|
||
|
|
tk_messageBox -icon info -type ok -title "About Widget Tour" -message \
|
||
|
|
"Tix widget tour\n\nCopyright (c) 2000-2001 Tix Project Group."
|
||
|
|
}
|
||
|
|
|
||
|
|
#
|
||
|
|
# Start the program
|
||
|
|
#
|
||
|
|
|
||
|
|
createMainWindow
|