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.
271 lines
6.6 KiB
271 lines
6.6 KiB
# -*-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
|
|
}
|