#!/bin/sh # the next line restarts using wish \ exec wish "$0" "$@" # widget -- # # This script demonstrates the various widgets provided by Tix, # along with many of the features of the Tix library. This file # only contains code to generate the main window for the # application, which invokes individual demonstrations. The # code for the actual demonstrations is contained in separate # ".tcl" files in the samples/ subdirectory, which are sourced # by this script as needed. # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-2000 Scriptics Corporation. # Copyright (c) 2000-2001 Tix Project Group. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # $Id: widget,v 1.7 2008/03/17 22:58:51 hobbs Exp $ package require Tix tix initstyle eval destroy [winfo child .] wm title . "Tix Widget Tour" set tix_demo_running 1 set demo_dir [file dirname [info script]] tix addbitmapdir [file join $demo_dir bitmaps] # createMainWindow -- # # Creates the main window, consisting of a menu bar and a text # widget that explains how to use the program, plus lists all of # the demos as hypertext items. proc createMainWindow {} { global tcl_platform old_cursor switch $tcl_platform(platform) { "windows" { set font {Arial 12} } "unix" { set font {Helvetica 12} } default { set font {Helvetica 12} } } menu .menuBar -tearoff 0 .menuBar add cascade -menu .menuBar.file -label "File" -underline 0 menu .menuBar.file -tearoff 0 # On the Mac use the specia .apple menu for the about item if {$tcl_platform(platform) eq "macintosh"} { .menuBar add cascade -menu .menuBar.apple menu .menuBar.apple -tearoff 0 .menuBar.apple add command -label "About ..." -command "aboutBox" } else { .menuBar.file add command -label "About ..." -command "aboutBox" .menuBar.file add sep } .menuBar.file add command -label "Exit" -command "exit" . configure -menu .menuBar frame .statusBar label .statusBar.lab -text " " -relief sunken -bd 1 \ -font -*-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* -anchor w label .statusBar.foo -width 8 -relief sunken -bd 1 \ -font -*-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* -anchor w pack .statusBar.lab -side left -padx 2 -expand yes -fill both pack .statusBar.foo -side left -padx 2 pack .statusBar -side bottom -fill x -pady 2 frame .textFrame scrollbar .s -orient vertical -command {.t yview} -highlightthickness 0 \ -takefocus 1 pack .s -in .textFrame -side right -fill y text .t -yscrollcommand {.s set} -wrap word -width 55 -height 30 \ -font $font \ -setgrid 1 -highlightthickness 0 -padx 4 -pady 2 -takefocus 0 pack .t -in .textFrame -expand y -fill both -padx 1 pack .textFrame -expand yes -fill both if {$tcl_platform(platform) eq "windows"} { # # Make the scrollbar look win32 # .textFrame config -bd 2 -relief sunken .t config -bd 0 pack .t -padx 0 } set old_cursor [.t cget -cursor] # Create a bunch of tags to use in the text widget, such as those for # section titles and demo descriptions. Also define the bindings for # tags. .t tag configure title -font {Helvetica 18 bold} -justify center .t tag configure header -font {Helvetica 14 bold} # We put some "space" characters to the left and right of each # demo description so that the descriptions are highlighted only # when the mouse cursor is right over them (but not when the # cursor is to their left or right) # .t tag configure demospace -lmargin1 1c -lmargin2 1c -spacing1 1 .t tag configure codeicon -lmargin1 1c -lmargin2 1c if {[winfo depth .] == 1} { .t tag configure demo -lmargin1 1c -lmargin2 1c \ -underline 1 .t tag configure visited -lmargin1 1c -lmargin2 1c \ -underline 1 .t tag configure hot -background black -foreground white } else { .t tag configure demo -lmargin1 1c -lmargin2 1c \ -foreground blue -underline 1 .t tag configure visited -lmargin1 1c -lmargin2 1c \ -foreground #303080 -underline 1 .t tag configure hot -foreground red -underline 1 } .t tag bind demo { invoke [.t index {@%x,%y}] } .t tag bind codeicon { showCode [.t index [list {@%x,%y} +2 chars]] } global lastLine set lastLine "" .t tag bind demo { set lastLine [.t index {@%x,%y linestart}] .t tag add hot [list $lastLine +3 chars] \ [list $lastLine lineend -1 chars] .t config -cursor hand2 showStatus run [.t index {@%x,%y}] } .t tag bind demo { .t tag remove hot 1.0 end .t config -cursor $old_cursor .statusBar.lab config -text "" } .t tag bind demo { set newLine [.t index {@%x,%y linestart}] if {[string compare $newLine $lastLine] != 0} { .t tag remove hot 1.0 end set lastLine $newLine set tags [.t tag names {@%x,%y}] set i [lsearch -glob $tags demo-*] if {$i >= 0} { .t tag add hot [list $lastLine +3 chars] \ [list $lastLine lineend -1 chars] } } showStatus run [.t index {@%x,%y}] } .t tag bind codeicon { .t config -cursor hand2 } .t tag bind codeicon { .t config -cursor $old_cursor } .t tag bind codeicon { set tags [.t tag names [list {@%x,%y} +2 chars]] set i [lsearch -glob $tags demo-*] if {$i >= 0} { showStatus code [.t index [list {@%x,%y} +2 chars]] } else { showStatus code "" } } # Create the text for the text widget. .t insert end "Tix Widget Tour\n" title addNewLine .t addText .t { This program demonstrates the features of the Tix library. Click on one of the highlighted lines below to run the sample program and click on the } addSpace .t .t image create end -image [tix getimage code] addSpace .t addText .t { icon to view its source code. } addNewLine .t addNewLine .t addHeader .t "Hierachical ListBox" addDemo .t HList1.tcl "Simple HList" addDemo .t ChkList.tcl "CheckList" addDemo .t SHList.tcl "ScrolledHList (1)" addDemo .t SHList2.tcl "ScrolledHList (2)" addDemo .t Tree.tcl "Simple Tree" # TODO # addDemo .t "Dynamic Tree" DynTree.tcl addHeader .t "Tabular ListBox" addDemo .t STList1.tcl "ScrolledTList (1)" addDemo .t STList2.tcl "ScrolledTList (2)" addDemo .t STList3.tcl "TList File Viewer" addHeader .t "Grid Widget" addDemo .t SGrid0.tcl "Simple Grid" addDemo .t SGrid1.tcl "ScrolledGrid" addDemo .t EditGrid.tcl "Editable Grid" addHeader .t "Manager Widgets" addDemo .t ListNBK.tcl ListNoteBook addDemo .t NoteBook.tcl NoteBook addDemo .t PanedWin.tcl PanedWindow addHeader .t "Scrolled Widgets" addDemo .t SListBox.tcl ScrolledListBox addDemo .t SText.tcl ScrolledText addDemo .t SWindow.tcl ScrolledWindow addDemo .t CObjView.tcl "Canvas Object View" addHeader .t "Miscellaneous Widgets" addDemo .t Balloon.tcl Balloon addDemo .t BtnBox.tcl ButtonBox addDemo .t ComboBox.tcl ComboBox addDemo .t Control.tcl Control addDemo .t LabEntry.tcl LabelEntry addDemo .t LabFrame.tcl LabelFrame addDemo .t Meter.tcl Meter addDemo .t OptMenu.tcl OptionMenu addDemo .t PopMenu.tcl PopupMenu addDemo .t Select.tcl Select addDemo .t StdBBox.tcl StdButtonBox addHeader .t "Image Types" addDemo .t CmpImg.tcl "Compound image in buttons" addDemo .t CmpImg3.tcl "Compound image in icons" #addDemo .t CmpImg2.tcl "Compound image in notebook" #addDemo .t CmpImg4.tcl \ # "Create color tabs in notebook using compound image" addDemo .t Xpm.tcl "XPM pixmap image in buttons" addDemo .t Xpm1.tcl "XPM pixmap image in menu" .t configure -state disabled focus .s # # Because .t is disabled and not focused, we have to do the # following hacks to make the scrolling work well # bind .s { .t yview scroll [expr {- (%D / 120) * 2}] units } bind .s { .t yview scroll -1 units } bind .s { .t yview scroll 1 units } bind .s { .t yview scroll -1 page } bind .s { .t yview scroll 1 page } bind .s { .t yview 1.0 } bind .s { .t yview end } } # invoke -- # This procedure is called when the user clicks on a demo description. # It is responsible for invoking the demonstration. # # Arguments: # index - The index of the character that the user clicked on. proc invoke {index} { global demo_dir # Find out which sample to run set tags [.t tag names $index] set i [lsearch -glob $tags demo-*] if {$i < 0} { return } set demo [string range [lindex $tags $i] 5 end] set title [string trim [.t get [list $index linestart +3 chars] \ [list $index lineend]]] # Get the name of this sample set w .[lindex [split $demo .] 0] set w [string tolower $w] if [winfo exists $w] { wm deiconify $w raise $w return } # Load the sample if it's not running set cursor [.t cget -cursor] .t configure -cursor watch update uplevel #0 [list source [file join $demo_dir samples $demo]] toplevel $w wm title $w $title RunSample $w update .t configure -cursor $cursor .t tag add visited "$index linestart +1 chars" "$index lineend -1 chars" } # showStatus -- # # Show the name of the demo program in the status bar. This procedure # is called when the user moves the cursor over a demo description. # proc showStatus {which index} { set tags [.t tag names $index] set i [lsearch -glob $tags demo-*] set cursor [.t cget -cursor] if {$i < 0} { .statusBar.lab config -text " " set newcursor xterm } else { set demo [string range [lindex $tags $i] 5 end] if {"$which" == "run"} { set text "Run the \"$demo\" sample program" } else { set text "Show code of the \"$demo\" sample program" } .statusBar.lab config -text $text set newcursor hand2 } if [string compare $cursor $newcursor] { .t config -cursor $newcursor } } # showCode -- # This procedure is called when the user clicks on the "code" icon. # It is responsible for displaying the code of the selected sample program. # # Arguments: # index - The index of the character that the user clicked on. proc showCode {index} { global demo_dir set tags [.t tag names $index] set i [lsearch -glob $tags demo-*] if {$i < 0} { return } set cursor [.t cget -cursor] .t configure -cursor watch update set demo [string range [lindex $tags $i] 5 end] # Create the .code window if {![winfo exists .code]} { toplevel .code frame .code.f tixScrolledText .code.st button .code.close -text Close -width 6 -command "wm withdraw .code" pack .code.f -side bottom -fill x pack .code.st -side top -fill both -expand yes pack .code.close -in .code.f -side right -padx 10 -pady 10 } set text [.code.st subwidget text] $text delete 1.0 end set fd [open [file join $demo_dir samples $demo]] set data [read $fd] close $fd $text insert end $data wm deiconify .code wm title .code [file nativename [file join $demo_dir samples $demo]] update .t configure -cursor $cursor } proc addText {t text} { regsub -all \n+ $text " " text regsub -all {[ ]+} $text " " text $t insert end [string trim $text] } proc addHeader {t text} { addNewLine $t $t insert end [string trim $text] header addNewLine $t } proc addNewLine {t} { $t insert end "\n" {demospace} } proc addSpace {t} { $t insert end " " {demospace} } proc addDemo {t name text} { $t insert end " " demospace $t image create end -image [tix getimage code] $t tag add codeicon [list end -2 chars] [list end -1 chars] $t insert end " " demospace $t insert end $text [list demo demo-$name] $t insert end " " demospace addNewLine $t } # aboutBox -- # # Pops up a message box with an "about" message # proc aboutBox {} { tk_messageBox -icon info -type ok -title "About Widget Tour" -message \ "Tix widget tour\n\nCopyright (c) 2000-2001 Tix Project Group." } # # Start the program # createMainWindow