Subversion Repositories or1k

# 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 [tixNSubFolder $demo_dir samples]

set sample_filename {}

uplevel #0 source [list [tixNSubFolder $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 <1> "focus %W"

    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 #202060 -padx 4]

    uplevel #0 set TRANSPARENT_GIF_COLOR [$hlist cget -bg]

    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 [tixNSubFolder $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 [tixNSubFolder $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 [tixNSubFolder $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 [tixNSubFolder $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

}