openmedialibrary_platform_w.../tcl/tix8.4.3/demos/MkChoose.tcl

280 lines
8.7 KiB
Tcl

# -*-mode: tcl; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: MkChoose.tcl,v 1.4 2004/03/28 02:44:56 hobbs Exp $
#
# MkChoose.tcl --
#
# This file implements the "Choosers" page in the widget demo
#
# 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.
#
proc MkChoosers {nb page} {
set w [$nb subwidget $page]
set name [tixOptionName $w]
option add *$name*TixLabelFrame*label.padX 4
tixLabelFrame $w.til -label "Chooser Widgets"
tixLabelFrame $w.cbx -label "tixComboBox"
tixLabelFrame $w.ctl -label "tixControl"
tixLabelFrame $w.sel -label "tixSelect"
tixLabelFrame $w.opt -label "tixOptionMenu"
tixLabelFrame $w.fil -label "tixFileEntry"
tixLabelFrame $w.fbx -label "tixFileSelectBox"
tixLabelFrame $w.tbr -label "Tool Bar"
MkTitle [$w.til subwidget frame]
MkCombo [$w.cbx subwidget frame]
MkControl [$w.ctl subwidget frame]
MkSelect [$w.sel subwidget frame]
MkOptMenu [$w.opt subwidget frame]
MkFileBox [$w.fbx subwidget frame]
MkFileEnt [$w.fil subwidget frame]
MkToolBar [$w.tbr subwidget frame]
#
# First column: comBox and selector
tixForm $w.cbx -top 0 -left 0 -right %33
tixForm $w.sel -left 0 -right &$w.cbx -top $w.cbx
tixForm $w.opt -left 0 -right &$w.cbx -top $w.sel -bottom -1
#
# Second column: title .. etc
tixForm $w.til -left $w.cbx -right %66 -top 0
tixForm $w.ctl -left $w.cbx -right &$w.til -top $w.til
tixForm $w.fil -left $w.cbx -right &$w.til -top $w.ctl
tixForm $w.tbr -left $w.cbx -right &$w.til -top $w.fil -bottom -1
#
# Third column: file selection
tixForm $w.fbx -left %66 -right -1 -top 0
}
#----------------------------------------------------------------------
# ComboBox
#----------------------------------------------------------------------
proc MkCombo {w} {
set name [tixOptionName $w]
option add *$name*TixComboBox*label.width 10
option add *$name*TixComboBox*label.anchor e
option add *$name*TixComboBox*entry.width 14
tixComboBox $w.static -label "Static" \
-editable false
tixComboBox $w.editable -label "Editable" \
-editable true
tixComboBox $w.history -label "History" \
-editable true -history true -anchor e
$w.static insert end January
$w.static insert end February
$w.static insert end March
$w.static insert end April
$w.static insert end May
$w.static insert end June
$w.static insert end July
$w.static insert end August
$w.static insert end September
$w.static insert end October
$w.static insert end November
$w.static insert end December
$w.editable insert end "America"
$w.editable insert end "Britain"
$w.editable insert end "China"
$w.editable insert end "Denmark"
$w.editable insert end "Egypt"
$w.history insert end "/usr/bin/mail"
$w.history insert end "/etc/profile"
$w.history insert end "/home/d/doe/Mail/letter"
pack $w.static $w.editable $w.history -side top -padx 5 -pady 3
}
#----------------------------------------------------------------------
# The Control widgets
#----------------------------------------------------------------------
set states {Alabama "New York" Pennsylvania Washington}
proc stCmd {w by value} {
global states
set index [lsearch $states $value]
set len [llength $states]
set index [expr {$index + $by}]
if {$index < 0} {
set index [expr {$len -1}]
}
if {$index >= $len} {
set index 0
}
return [lindex $states $index]
}
proc stValidate {w value} {
global states
if {[lsearch $states $value] == -1} {
return [lindex $states 0]
} else {
return $value
}
}
proc MkControl {w} {
set name [tixOptionName $w]
option add *$name*TixControl*label.width 10
option add *$name*TixControl*label.anchor e
option add *$name*TixControl*entry.width 13
tixControl $w.simple -label Numbers
tixControl $w.spintext -label States \
-incrcmd [list stCmd $w.spintext 1] \
-decrcmd [list stCmd $w.spintext -1] \
-validatecmd [list stValidate .d] \
-value "Alabama"
pack $w.simple $w.spintext -side top -padx 5 -pady 3
}
#----------------------------------------------------------------------
# The Select Widgets
#----------------------------------------------------------------------
proc MkSelect {w} {
set name [tixOptionName $w]
option add *$name*TixSelect*label.anchor c
option add *$name*TixSelect*orientation vertical
option add *$name*TixSelect*labelSide top
tixSelect $w.sel1 -label "Mere Mortals" -allowzero true -radio true
tixSelect $w.sel2 -label "Geeks" -allowzero true -radio false
$w.sel1 add eat -text Eat
$w.sel1 add work -text Work
$w.sel1 add play -text Play
$w.sel1 add party -text Party
$w.sel1 add sleep -text Sleep
$w.sel2 add eat -text Eat
$w.sel2 add prog1 -text Program
$w.sel2 add prog2 -text Program
$w.sel2 add prog3 -text Program
$w.sel2 add sleep -text Sleep
pack $w.sel1 $w.sel2 -side left -padx 5 -pady 3 -fill x
}
#----------------------------------------------------------------------
# The OptMenu Widget
#----------------------------------------------------------------------
proc MkOptMenu {w} {
set name [tixOptionName $w]
option add *$name*TixOptionMenu*label.anchor e
tixOptionMenu $w.menu -label "File Format : " \
-options {
menubutton.width 15
}
$w.menu add command text -label "Plain Text"
$w.menu add command post -label "PostScript"
$w.menu add command format -label "Formatted Text"
$w.menu add command html -label "HTML"
$w.menu add separator sep
$w.menu add command tex -label "LaTeX"
$w.menu add command rtf -label "Rich Text Format"
pack $w.menu -padx 5 -pady 3 -fill x
}
#----------------------------------------------------------------------
# FileEntry
#----------------------------------------------------------------------
proc MkFileEnt {w} {
set name [tixOptionName $w]
message $w.msg \
-relief flat -width 240 -anchor n\
-text {Press the "open file" icon button and a\
TixFileSelectDialog will popup.}
tixFileEntry $w.ent -label "Select a file : "
pack $w.msg -side top -expand yes -fill both -padx 3 -pady 3
pack $w.ent -side top -fill x -padx 3 -pady 3
}
proc MkFileBox {w} {
set name [tixOptionName $w]
message $w.msg \
-relief flat -width 240 -anchor n\
-text {The TixFileSelectBox is Motif-style file selection\
box with various enhancements. For example, you can adjust the\
size of the two listboxes and your past selections are recorded.}
tixFileSelectBox $w.box
pack $w.msg -side top -expand yes -fill both -padx 3 -pady 3
pack $w.box -side top -fill x -padx 3 -pady 3
}
#----------------------------------------------------------------------
# Tool Bar
#----------------------------------------------------------------------
proc MkToolBar {w} {
set name [tixOptionName $w]
option add $name*TixSelect*frame.borderWidth 1
message $w.msg -relief flat -width 240 -anchor n\
-text {The Select widget is also good for arranging buttons\
in a tool bar.}
frame $w.bar -bd 2 -relief raised
tixSelect $w.font -allowzero true -radio false -label {}
tixSelect $w.para -allowzero false -radio true -label {}
$w.font add bold -bitmap [tix getbitmap bold]
$w.font add italic -bitmap [tix getbitmap italic]
$w.font add underline -bitmap [tix getbitmap underlin]
$w.font add capital -bitmap [tix getbitmap capital]
$w.para add left -bitmap [tix getbitmap leftj]
$w.para add right -bitmap [tix getbitmap rightj]
$w.para add center -bitmap [tix getbitmap centerj]
$w.para add justify -bitmap [tix getbitmap justify]
pack $w.msg -side top -expand yes -fill both -padx 3 -pady 3
pack $w.bar -side top -fill x -padx 3 -pady 3
pack $w.para $w.font -in $w.bar -side left -padx 4 -pady 3
}
#----------------------------------------------------------------------
# Title
#----------------------------------------------------------------------
proc MkTitle {w} {
set name [tixOptionName $w]
option add $name*TixSelect*frame.borderWidth 1
message $w.msg \
-relief flat -width 240 -anchor n\
-text {There are many types of "choose" widgets that allow\
the user to input different type of information.}
pack $w.msg -side top -expand yes -fill both -padx 3 -pady 3
}