home *** CD-ROM | disk | FTP | other *** search
- #!/bin/vtcl
- # ---------------------------------------------------------------------
- # Copyright 1994 by SCO, Inc.
- # Permission to use, copy, modify, distribute, and sell this software
- # and its documentation for any purpose is hereby granted without fee,
- # provided that the above copyright notice appear in all copies and that
- # both that copyright notice and this permission notice appear in
- # supporting documentation, and that the name of SCO not be used in
- # advertising or publicity pertaining to distribution of the software
- # without specific, written prior permission. SCO makes no
- # representations about the suitability of this software for any
- # purpose. It is provided "as is" without express or implied warranty.
- # ---------------------------------------------------------------------
-
- # Demo : Browser.tcl
- # Description : Demo Launcher
- # Comments : This demo lists and fires up other Visual Tcl demos
- # located in /lib/vtcl/examples.
- # Things to
- # Look for - reading in files via -filename option
- # - checking for file readability with "file" command.
- # - displaying error dialog
- # - exec'ing commands (in background)
- # - using catch for handling errors
- # - how to retrieve a dialog's built-in buttons (ok, cancel...)
- # -
-
- proc closeCB { cbs } {
- VtClose; exit
- }
-
- set currentFileName ""
-
- # This callback (associated with the list widget) will retrieve
- # the name of the filename from the list and call the procedure
- # to display the file's contents in the text widget.
-
- proc GetFileCB { cbs } {
- global currentFileName listW
- set dlog [keylget cbs dialog]
- set newFileName [keylget cbs selectedItemList]
-
- # This demo wants to keep at least one item highlighted all the time.
- # So, if user de-selects, we'll force it to be selected again.
- if {$newFileName == ""} {
- VtListSelectItem $listW -item $currentFileName
- return
- } else {
- set currentFileName $newFileName
- }
-
-
- DisplayFile $newFileName $dlog
- }
-
- # DisplayFile opens the filename for reading and updates the label at
- # the main dialog with the current filename and updates the text widget
- # with the contents of the file.
-
- proc DisplayFile {filename dialog} {
- global textW executePushB sourceLabel
-
- VtSetValues $sourceLabel \
- -label "Source for \"$filename\""
-
- if { [file readable $filename] } {
- VtSetValues $textW \
- -filename $filename
- VtSetSensitive $executePushB True
- VtSetFocus $executePushB
- } else {
- VtSetValues $textW \
- -value " < Unable to read your file > "
- }
- }
-
- # This procedure displays a little status about the program
- # that's getting exec'd. This provides an example of hiding
- # an existing widget (or form, in this case) since you know
- # it's likely to be used over and over. The very cool Vtcl
- # command "info" is used to check for the existence of the
- # variable containing the formdialog's name. It's a global
- # variable, so if it doesn't exist, you know that the form
- # hasn't been created yet. If it does exist, then you use
- # VtSetValues to update the label in it and call VtShow.
- #
- # This is _real_ useful if you have a complex dialog that
- # tends to take awhile to re-build before it gets displayed.
- #
- proc DisplayExecInfo {filename parent flag} {
- global infoD executePushB
- if {$flag == "On"} {
- VtLock
- if { ! [info exists infoD]} {
- set infoD [VtFormDialog $parent.infoD \
- -title "Browser Status" \
- -wmDecoration {TITLE BORDER} \
- -resizable True \
- ]
- set lbl [VtLabel $infoD.lbl \
- -label " Exec'ing ${filename}... " \
- -font medItalicFont \
- -rightSide FORM -bottomSide FORM \
- ]
- } else {
- VtSetValues $infoD.lbl -label "Exec'ing ${filename}..."
- }
- VtShow $infoD
- } else {
- VtHide $infoD
- VtUnLock
- VtSetFocus $executePushB
- }
- }
-
- # Fire up the currently displayed/selected script.
- #
- proc execCB { cbs } {
- global currentFileName
- set filename $currentFileName
- set parent [keylget cbs dialog]
- DisplayExecInfo $filename $parent On
- set returnCode [catch {exec vtcl $filename &} errorMsg ]
-
- # using the combination of ; and #, you can put a comment on
- # the same line as the command:
- #
- sleep 2 ; # seconds
- DisplayExecInfo $filename $parent Off
-
- if {$returnCode != 0} {
- set msg "Can't execute \"$filename\", error was:\n$errorMsg"
- set errD [VtErrorDialog $parent.errorBox \
- -ok \
- -message $msg \
- ]
- VtShow $errD
- }
-
- }
-
- #
- # Open connection with Visual Tcl display engine
- #
- set app [VtOpen browser]
-
- # Note that rather than get an "Ok" or "Apply" button, we're
- # going to re-label the button names.
- #
- set form [VtFormDialog $app.Top\
- -title "Demo: Visual Tcl Browser"\
- -applyLabel "Execute..." \
- -applyCallback execCB \
- -okLabel "Quit" \
- -okCallback closeCB \
- ]
-
- # Make the execute button insensitive; retrieve the widget name
- # of the main form's apply button.
- #
- set executePushB [VtGetValues $form -apply]
- VtSetSensitive $executePushB False
-
- set llabel [VtLabel $form.llabel\
- -topSide FORM \
- -leftSide FORM \
- -label "Vtcl Scripts" \
- ]
-
- # retrieve the list of files in the current directory
- set files [lsort [glob *.tcl]]
-
- set listW [VtList $form.listW \
- -selection SINGLE \
- -MOTIF_topOffset 2 \
- -bottomSide FORM \
- -itemList $files \
- -defaultCallback execCB \
- -callback GetFileCB \
- ]
-
- set sourceLabel [VtLabel $form.sourceLabel \
- -topSide FORM \
- -leftSide $listW \
- -rightSide FORM \
- -label "Source" \
- ]
-
- set textW [VtText $form.textW \
- -leftSide $listW \
- -rightSide FORM \
- -bottomSide FORM \
- -topSide $sourceLabel \
- -rows 20 \
- -columns 70 \
- -horizontalScrollBar TRUE \
- -verticalScrollBar TRUE \
- -readOnly \
- ]
-
- VtShow $form
- VtMainLoop
-