Subversion Repositories or1k_old

#!/bin/sh

# the next line restarts using tixwish \

exec tixwish "$0" "$@"

# widget --

#

#       This is a demo program of all the available Tix widgets. If

#       have installed Tix properly, you can execute this program

#       directly:

#

#               % widget

#

#       Otherwise try the following in csh

#

#               % env TIX_LIBRARY=../library tixwish widget

#

#       Or this in sh

#

#               $ TIX_LIBRARY=../library tixwish widget

#

#

#

#----------------------------------------------------------------------

#

#

#       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 MkMainWindow {w} {

    global demo auto_path demo_dir

    if ![info exists demo_dir] {

        # Initialize the auto_path and the bitmap directory. The demo_dir

        # variable would be already set by the test program, if we are

        # running in the self test more

        #

        set script [info script]

        if {$script != {}} {

            set demo_dir [file dirname $script]

        } else {

            set demo_dir [pwd]

        }

        set demo_dir [tixFSAbsPath $demo_dir]

    }

    lappend auto_path $demo_dir

    tix addbitmapdir [tixFSJoin $demo_dir bitmaps]

    toplevel $w

    wm title $w "Tix Widget Demonstration"

    wm geometry $w 830x566+100+100

    set demo(balloon) [tixBalloon .demos_balloon]

    set frame1 [MkMainMenu     $w]

    set frame2 [MkMainNoteBook $w]

    set frame3 [MkMainStatus   $w]

    pack $frame1 -side top    -fill x

    pack $frame3 -side bottom -fill x

    pack $frame2 -side top    -expand yes -fill both -padx 4 -pady 4

    $demo(balloon) config -statusbar $demo(statusbar)

    set demo(notebook) $frame2

}

proc MkMainMenu {top} {

    global demo usebal

    set w [frame $top.f1 -bd 2 -relief raised]

    menubutton $w.file -menu $w.file.m -text File -underline 0 \

        -takefocus 0

    menubutton $w.help -menu $w.help.m -text Help -underline 0 \

        -takefocus 0

    menu $w.file.m

    $w.file.m add command -label "Open ... " -command FileOpen -underline 1 \

        -accelerator "Ctrl+O"

    $w.file.m add sep

    $w.file.m add command -label "Exit     " -command exit -underline 1 \

        -accelerator "Ctrl+X"

    menu $w.help.m

    $w.help.m add checkbutton -under 0  -label "Balloon Help " \

        -variable usebal -onvalue 1 -offvalue 0

    tixForm $w.file

    tixForm $w.help -right -0

    trace variable usebal w BalloonHelp

    set usebal 1

    # Accelerator bindings

    bind all  "exit"

    bind all  "FileOpen"

    return $w

}

# Create the main display area of the widget programm. This area should

# utilize the "tixNoteBook" widget once it is available. But now

# we use the cheap substitute "tixStackWindow"

#

proc MkMainNoteBook {top} {

    global demo

    set hasGL 0

    option add *TixNoteBook.tagPadX 6

    option add *TixNoteBook.tagPadY 4

    option add *TixNoteBook.borderWidth 2

    option add *TixNoteBook.font\

        -*-helvetica-bold-o-normal-*-14-*-*-*-*-*-*-*

    set w [tixNoteBook $top.f2 -ipadx 5 -ipady 5]

    $w add wel -createcmd "CreatePage MkWelcome  $w wel" \

        -label "Welcome" \

        -under 0

    $w add cho -createcmd "CreatePage MkChoosers $w cho" \

        -label "Choosers" \

        -under 0

    $w add scr -createcmd "CreatePage MkScroll   $w scr" \

        -label "Scrolled Widgets" \

        -under 0

    $w add mgr -createcmd "CreatePage MkManager  $w mgr" \

        -label "Manager Widgets" \

        -under 0

    $w add dir -createcmd "CreatePage MkDirList  $w dir" \

        -label "Directory List" \

        -under 0

    $w add exp -createcmd "CreatePage MkSample   $w exp" \

        -label "Run Sample Programs" \

        -under 0

    if {$hasGL} {

        $w add glw -createcmd "MkGL $w glw" -tag "GL Widgets"

    }

    return $w

}

proc CreatePage {command w name} {

    tixBusy $w on

    set id [after 10000 tixBusy $w off]

    $command $w $name

    after cancel $id

    after 0 tixBusy $w off

}

proc MkMainStatus {top} {

    global demo

    set w [frame $top.f3 -relief raised -bd 1]

    set demo(statusbar) \

        [label $w.status -font -*-helvetica-medium-r-normal-*-14-*-*-*-*-*-*-*\

         -relief sunken -bd 1]

    tixForm $demo(statusbar) -padx 3 -pady 3 -left 0 -right %70

    return $w

}

proc MkWelcome {nb page} {

    set w [$nb subwidget $page]

    set bar  [MkWelcomeBar  $w]

    set text [MkWelcomeText $w]

    pack $bar  -side top -fill x -padx 2 -pady 2

    pack $text -side top -fill both -expand yes

}

proc MkWelcomeBar {top} {

    global demo

    set w [frame $top.bar -bd 2 -relief groove]

    # Create and configure comboBox 1

    #

    tixComboBox $w.cbx1 -command "MainTextFont $top" \

        -options {

            entry.width    15

            listbox.height 3

        }

    tixComboBox $w.cbx2 -command "MainTextFont $top" \

        -options {

            entry.width 4

            listbox.height 3

        }

    set demo(welfont) $w.cbx1

    set demo(welsize) $w.cbx2

    $w.cbx1 insert end "Courier"

    $w.cbx1 insert end "Helvetica"

    $w.cbx1 insert end "Lucida"

    $w.cbx1 insert end "Times Roman"

    $w.cbx2 insert end 8

    $w.cbx2 insert end 10

    $w.cbx2 insert end 12

    $w.cbx2 insert end 14

    $w.cbx2 insert end 18

    $w.cbx1 pick 1

    $w.cbx2 pick 3

    # Pack the comboboxes together

    #

    pack $w.cbx1 $w.cbx2 -side left -padx 4 -pady 4

    $demo(balloon) bind $w.cbx1\

        -msg "Choose\na font" -statusmsg "Choose a font for this page"

    $demo(balloon) bind $w.cbx2\

        -msg "Point size" -statusmsg "Choose the font size for this page"

    tixDoWhenIdle MainTextFont $top

    return $w

}

proc MkWelcomeText {top} {

    global demo tix_version

    set w [tixScrolledWindow $top.f3 -scrollbar auto]

    set win [$w subwidget window]

    label $win.title -font -*-times-bold-r-normal-*-18-*-*-*-*-*-*-*\

        -bd 0 -width 30 -anchor n\

        -text "Welcome to TIX version $tix_version"

    message $win.msg -font -*-helvetica-bold-r-normal-*-14-*-*-*-*-*-*-*\

        -bd 0 -width 400 -anchor n\

        -text "\

Tix $tix_version is a library of mega-widgets based on TK. This program \

demonstrates the widgets in the Tix widget. You can choose the pages \

in this window to look at the corresponding widgets. \

To quit this program, choose the \"File | Exit\" command."

    pack $win.title -expand yes -fill both -padx 10 -pady 10

    pack $win.msg -expand yes -fill both -padx 10 -pady 10

    set demo(welmsg) $win.msg

    return $w

}

proc MainTextFont {w args} {

    global demo

    if {![info exists demo(welmsg)]} {

        return

    }

    set font  [$demo(welfont) cget -value]

    set point [$demo(welsize) cget -value]

    case $font {

        "Courier" {

            set f courier

        }

        "Helvetica" {

            set f helvetica

        }

        "Lucida" {

            set f lucida

        }

        default {

            set f times

        }

    }

    set xfont [format "-*-%s-bold-r-normal-*-%s-*-*-*-*-*-*-*" $f $point]

    if [catch {$demo(welmsg) config -font $xfont} err] {

        puts \a$err

    }

}

proc FileOpen {} {

    global demo demo_dir

    set filedlg [tix filedialog tixExFileSelectDialog]

    if {![info exists demo(filedialog)]} {

        $filedlg subwidget fsbox config -pattern *.tcl

        $filedlg subwidget fsbox config -directory $demo_dir/samples

        $filedlg config -command FileOpen:Doit

        set demo(filedialog) $filedlg

    }

    $filedlg config -title "Open Tix Sample Programs"

    $filedlg popup

    tixPushGrab $filedlg

}

proc FileOpen:Doit {filename} {

    global demo

    LoadFile $filename

    tixPopGrab

    $demo(filedialog) popdown

}

#----------------------------------------------------------------------

# Balloon Help

#----------------------------------------------------------------------

proc BalloonHelp {args} {

    global demo usebal

    if {$usebal} {

        $demo(balloon) config -state "both"

    } else {

        $demo(balloon) config -state "none"

    }

}

#----------------------------------------------------------------------

# Self-testing

#

#       The following code are called by the Tix test suite. It opens

#       every page in the demo program.

#----------------------------------------------------------------------

proc Widget:SelfTest {} {

    global demo testConfig

    if ![info exists testConfig] {

        return

    }

    MkMainWindow .widget

    update

    foreach p [$demo(notebook) pages] {

        $demo(notebook) raise $p

        update

    }

    destroy .widget

}

#----------------------------------------------------------------------

# Start!

#----------------------------------------------------------------------

if ![info exists testConfig] {

    #

    # If the testConfig variable exists, we are driven by the regression

    # test. In that case, don't open the main window. The test program will

    # call Widget:SelfTest

    #

    wm withdraw .

    MkMainWindow .widget

    bind .widget  "exit"

}