openmedialibrary_platform_w.../tcl/tix8.4.3/demos/MkSample.tcl

270 lines
6.6 KiB
Tcl

# -*-mode: tcl; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: MkSample.tcl,v 1.3 2001/12/09 05:34:59 idiscovery Exp $
#
# MkSample.tcl --
#
# This file implements the "Sample" 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.
#
#
#
set tix_demo_running 1
set samples_dir [file join $demo_dir samples]
set sample_filename {}
uplevel #0 source [list [file join $samples_dir AllSampl.tcl]]
proc MkSample {nb page} {
global tixOption
#----------------------------------------------------------------------
set w [$nb subwidget $page]
set pane [tixPanedWindow $w.pane -orient horizontal]
pack $pane -expand yes -fill both
set f1 [$pane add 1 -expand 1]
set f2 [$pane add 2 -expand 3]
$f1 config -relief flat
$f2 config -relief flat
# Left pane: the Tree:
#
set lab [label $f1.lab -text "Select a sample program:" -anchor w]
set tree [tixTree $f1.slb \
-options {
hlist.selectMode single
hlist.width 40
}]
$tree config \
-command "Sample:Action $w $tree run" \
-browsecmd "Sample:Action $w $tree browse"
pack $lab -side top -fill x -padx 5 -pady 5
pack $tree -side top -fill both -expand yes -padx 5
# Right pane: the Text
#
set labe [tixLabelEntry $f2.lab -label "Source:" -options {
label.anchor w
}]
$labe subwidget entry config -state disabled
set stext [tixScrolledText $f2.stext]
set f3 [frame $f2.f3]
set run [button $f3.run -text "Run ..." \
-command "Sample:Action $w $tree run"]
set view [button $f3.view -text "View Source in Browser ..." \
-command "Sample:Action $w $tree view"]
pack $run $view -side left -fill y -pady 2
pack $labe -side top -fill x -padx 7 -pady 2
pack $f3 -side bottom -fill x -padx 7
pack $stext -side top -fill both -expand yes -padx 7
#
# Set up the text subwidget
set text [$stext subwidget text]
bind $text <Up> "%W yview scroll -1 unit"
bind $text <Down> "%W yview scroll 1 unit"
bind $text <Left> "%W xview scroll -1 unit"
bind $text <Right> "%W xview scroll 1 unit"
bind $text <Tab> {focus [tk_focusNext %W]; break}
bindtags $text "$text Text [winfo toplevel $text] all"
$text config -bg [$tree subwidget hlist cget -bg] \
-state disabled -font $tixOption(fixed_font) -wrap none
$run config -state disabled
$view config -state disabled
global demo
set demo(w:run) $run
set demo(w:view) $view
set demo(w:tree) $tree
set demo(w:lab1) $labe
set demo(w:stext) $stext
set hlist [$tree subwidget hlist]
$hlist config -separator "." -width 30 -drawbranch 0 \
-wideselect false
set style [tixDisplayStyle imagetext -refwindow $hlist \
-fg $tixOption(fg) -padx 4]
set file [tix getimage textfile]
set folder [tix getimage openfold]
ForAllSamples root "" \
[list AddSampleToHList $tree $hlist $style $file $folder]
}
# AddSampleToHList --
#
# A callback from ForAllSamples. Add all the possible sample files
# into the Tree widget.
#
proc AddSampleToHList {tree hlist style file folder token type text dest} {
case $type {
d {
return [$hlist addchild $token -itemtype imagetext -style $style \
-image $folder -text $text]
}
done {
if {![tixStrEq $token ""]} {
$tree setmode $token close
$tree close $token
}
}
f {
return [$hlist addchild $token -itemtype imagetext \
-image $file -text $text -data [list $text $dest]]
}
}
}
proc Sample:Action {w slb action args} {
global samples demo_dir demo samples_dir
set hlist [$slb subwidget hlist]
set ent [$hlist info anchor]
if {$ent == ""} {
$demo(w:run) config -state disabled
$demo(w:view) config -state disabled
return
}
if {[$hlist info data $ent] == {}} {
# This is just a comment
$demo(w:run) config -state disabled
$demo(w:view) config -state disabled
return
} else {
$demo(w:run) config -state normal
$demo(w:view) config -state normal
}
set theSample [$hlist info data $ent]
set title [lindex $theSample 0]
set prog [lindex $theSample 1]
case $action {
"run" {
RunProg $title $prog
}
"view" {
LoadFile [file join $samples_dir $prog]
}
"browse" {
# Bring up a short description of the sample program
# in the scrolled text about
set text [$demo(w:stext) subwidget text]
uplevel #0 set sample_filename [list [file join $samples_dir $prog]]
tixWidgetDoWhenIdle ReadFileWhenIdle $text
$demo(w:lab1) subwidget entry config -state normal
$demo(w:lab1) subwidget entry delete 0 end
$demo(w:lab1) subwidget entry insert end [file join $samples_dir $prog]
$demo(w:lab1) subwidget entry xview end
$demo(w:lab1) subwidget entry config -state disabled
}
}
}
proc RunProg {title prog} {
global samples demo_dir demo samples_dir
set w .[lindex [split $prog .] 0]
set w [string tolower $w]
if [winfo exists $w] {
wm deiconify $w
raise $w
return
}
uplevel #0 source [list [file join $samples_dir $prog]]
toplevel $w
wm title $w $title
RunSample $w
}
proc LoadFile {filename} {
global tixOption
set tmp $filename
regsub -all . $filename _ tmp
set w [string tolower .$tmp]
if [winfo exists $w] {
wm deiconify $w
raise $w
return
}
toplevel $w
wm title $w "Source View: $filename"
button $w.b -text Close -command "destroy $w"
set t [tixScrolledText $w.text]
tixForm $w.b -left 0 -bottom -0 -padx 4 -pady 4
tixForm $w.text -left 0 -right -0 -top 0 -bottom $w.b
$t subwidget text config -highlightcolor [$t cget -bg] -bd 2 \
-bg [$t cget -bg] -font $tixOption(fixed_font)
if {$filename == {}} {
return
}
set text [$w.text subwidget text]
$text config -wrap none
ReadFile $text $filename
}
proc ReadFileWhenIdle {text} {
global sample_filename
if ![file isdir $sample_filename] {
ReadFile $text $sample_filename
}
}
proc ReadFile {text filename} {
set oldState [$text cget -state]
$text config -state normal
$text delete 0.0 end
set fd [open $filename {RDONLY}]
$text delete 1.0 end
while {![eof $fd]} {
$text insert end [gets $fd]\n
}
close $fd
$text see 1.0
$text config -state $oldState
}