#!/bin/sh
|
#!/bin/sh
|
# ----------------------------------------------------------------------
|
# ----------------------------------------------------------------------
|
# PROGRAM: demo program for [incr Widgets]
|
# PROGRAM: demo program for [incr Widgets]
|
# ----------------------------------------------------------------------
|
# ----------------------------------------------------------------------
|
# Michael J. McLennan
|
# Michael J. McLennan
|
# Bell Labs Innovations for Lucent Technologies
|
# Bell Labs Innovations for Lucent Technologies
|
# mmclennan@lucent.com
|
# mmclennan@lucent.com
|
# http://www.tcltk.com/itcl/
|
# http://www.tcltk.com/itcl/
|
# ======================================================================
|
# ======================================================================
|
# Copyright (c) 1993-1998 Lucent Technologies, Inc.
|
# Copyright (c) 1993-1998 Lucent Technologies, Inc.
|
# ======================================================================
|
# ======================================================================
|
#\
|
#\
|
exec itkwish3.0 "$0"
|
exec itkwish3.0 "$0"
|
|
|
package require Iwidgets 3.0
|
package require Iwidgets 3.0
|
|
|
# everything else is executed by itkwish...
|
# everything else is executed by itkwish...
|
# ----------------------------------------------------------------------
|
# ----------------------------------------------------------------------
|
option add *Scrolledtext.textBackground white startupFile
|
option add *Scrolledtext.textBackground white startupFile
|
option add *Scrolledlistbox.textBackground white startupFile
|
option add *Scrolledlistbox.textBackground white startupFile
|
option add *Scrolledhtml.textBackground white startupFile
|
option add *Scrolledhtml.textBackground white startupFile
|
option add *Scrolledhtml.padX 10 startupFile
|
option add *Scrolledhtml.padX 10 startupFile
|
option add *boxColor blue startupFile
|
option add *boxColor blue startupFile
|
option add *boxTextColor white startupFile
|
option add *boxTextColor white startupFile
|
|
|
# ----------------------------------------------------------------------
|
# ----------------------------------------------------------------------
|
# USAGE: iw_demo_file
|
# USAGE: iw_demo_file
|
#
|
#
|
# Returns the proper demo file name for a demo called .
|
# Returns the proper demo file name for a demo called .
|
# ----------------------------------------------------------------------
|
# ----------------------------------------------------------------------
|
proc iw_demo_file {name} {
|
proc iw_demo_file {name} {
|
global iwidgets::library
|
global iwidgets::library
|
return [file join $library demos $name]
|
return [file join $library demos $name]
|
}
|
}
|
|
|
# ----------------------------------------------------------------------
|
# ----------------------------------------------------------------------
|
# USAGE: iw_demo_manpage
|
# USAGE: iw_demo_manpage
|
#
|
#
|
# Returns the proper man page file for a demo called .
|
# Returns the proper man page file for a demo called .
|
# ----------------------------------------------------------------------
|
# ----------------------------------------------------------------------
|
proc iw_demo_manpage {name} {
|
proc iw_demo_manpage {name} {
|
global iwidgets::library
|
global iwidgets::library
|
return [file join $library demos html $name.n.html]
|
return [file join $library demos html $name.n.html]
|
}
|
}
|
|
|
# ----------------------------------------------------------------------
|
# ----------------------------------------------------------------------
|
# USAGE: iw_load_demo
|
# USAGE: iw_load_demo
|
#
|
#
|
# Loads a demo program with the given . Demos can be written
|
# Loads a demo program with the given . Demos can be written
|
# as if they will pop up in the main application window, but they will
|
# as if they will pop up in the main application window, but they will
|
# pop up inside the tab notebook instead.
|
# pop up inside the tab notebook instead.
|
# ----------------------------------------------------------------------
|
# ----------------------------------------------------------------------
|
proc iw_load_demo {name} {
|
proc iw_load_demo {name} {
|
global widgets
|
global widgets
|
|
|
catch {eval destroy [winfo children $widgets(info-example)]}
|
catch {eval destroy [winfo children $widgets(info-example)]}
|
iw_lock on
|
iw_lock on
|
iw_status "Loading..."
|
iw_status "Loading..."
|
|
|
set win [frame $widgets(info-example).inner]
|
set win [frame $widgets(info-example).inner]
|
pack $win -expand yes
|
pack $win -expand yes
|
|
|
set loadcmd {
|
set loadcmd {
|
set fid [open [iw_demo_file $name] r]
|
set fid [open [iw_demo_file $name] r]
|
set code [read $fid]
|
set code [read $fid]
|
close $fid
|
close $fid
|
}
|
}
|
if {[catch $loadcmd result] == 0} {
|
if {[catch $loadcmd result] == 0} {
|
regsub -all "(\"|\{|\\\[| |\n|^)((\\.\[A-Za-z0-9\]+)+)" \
|
regsub -all "(\"|\{|\\\[| |\n|^)((\\.\[A-Za-z0-9\]+)+)" \
|
$code "\\1$win\\2" code
|
$code "\\1$win\\2" code
|
regsub -all "(\"|\{|\\\[| |\n|^)(\\. )" \
|
regsub -all "(\"|\{|\\\[| |\n|^)(\\. )" \
|
$code "\\1$win " code
|
$code "\\1$win " code
|
if {[catch {uplevel #0 $code} result] == 0} {
|
if {[catch {uplevel #0 $code} result] == 0} {
|
$widgets(info-code) clear
|
$widgets(info-code) clear
|
$widgets(info-code) import [iw_demo_file $name]
|
$widgets(info-code) import [iw_demo_file $name]
|
iw_draw_hier $name
|
iw_draw_hier $name
|
iw_load_manpage $name
|
iw_load_manpage $name
|
iw_lock off
|
iw_lock off
|
iw_status ""
|
iw_status ""
|
return
|
return
|
}
|
}
|
}
|
}
|
catch {eval destroy [winfo children $win]}
|
catch {eval destroy [winfo children $win]}
|
label $win.err -background white -wraplength 4i \
|
label $win.err -background white -wraplength 4i \
|
-text "Can't load demo:\n$result"
|
-text "Can't load demo:\n$result"
|
pack $win.err -expand yes
|
pack $win.err -expand yes
|
iw_lock off
|
iw_lock off
|
iw_status ""
|
iw_status ""
|
}
|
}
|
|
|
# overload a few critical functions that might be used by demo programs...
|
# overload a few critical functions that might be used by demo programs...
|
rename exit tcl_exit
|
rename exit tcl_exit
|
proc exit {{status 0}} {
|
proc exit {{status 0}} {
|
# do nothing
|
# do nothing
|
}
|
}
|
|
|
rename puts tcl_puts
|
rename puts tcl_puts
|
proc puts {args} {
|
proc puts {args} {
|
global widgets
|
global widgets
|
if {[llength $args] == 1} {
|
if {[llength $args] == 1} {
|
iw_status [lindex $args 0]
|
iw_status [lindex $args 0]
|
} else {
|
} else {
|
eval tcl_puts $args
|
eval tcl_puts $args
|
}
|
}
|
}
|
}
|
|
|
# ----------------------------------------------------------------------
|
# ----------------------------------------------------------------------
|
# USAGE: iw_load_manpage
|
# USAGE: iw_load_manpage
|
#
|
#
|
# Loads the man page for the current demo. Man pages are not
|
# Loads the man page for the current demo. Man pages are not
|
# automatically loaded unless the man page viewer is visible.
|
# automatically loaded unless the man page viewer is visible.
|
# This procedure checks to see if the viewer is visible, and loads
|
# This procedure checks to see if the viewer is visible, and loads
|
# the man page if needed.
|
# the man page if needed.
|
# ----------------------------------------------------------------------
|
# ----------------------------------------------------------------------
|
set iwManPage ""
|
set iwManPage ""
|
proc iw_load_manpage {{name ""}} {
|
proc iw_load_manpage {{name ""}} {
|
global widgets iwManPage
|
global widgets iwManPage
|
|
|
if {[winfo ismapped $widgets(info-manpage)]} {
|
if {[winfo ismapped $widgets(info-manpage)]} {
|
if {$name == ""} {
|
if {$name == ""} {
|
set name [$widgets(list) getcurselection]
|
set name [$widgets(list) getcurselection]
|
}
|
}
|
if {$name != $iwManPage} {
|
if {$name != $iwManPage} {
|
iw_lock on
|
iw_lock on
|
iw_status "Loading man page..."
|
iw_status "Loading man page..."
|
$widgets(info-manpage) import [iw_demo_manpage $name]
|
$widgets(info-manpage) import [iw_demo_manpage $name]
|
iw_lock off
|
iw_lock off
|
iw_status ""
|
iw_status ""
|
}
|
}
|
set iwManPage $name
|
set iwManPage $name
|
}
|
}
|
}
|
}
|
|
|
# ----------------------------------------------------------------------
|
# ----------------------------------------------------------------------
|
# USAGE: iw_manpage_progress
|
# USAGE: iw_manpage_progress
|
#
|
#
|
# Handles the progress meter whenever an HTML man page is rendered.
|
# Handles the progress meter whenever an HTML man page is rendered.
|
# If the progress meter is not showing, it is put up, and the current
|
# If the progress meter is not showing, it is put up, and the current
|
# state is updated. If the meter is at 100%, it is taken down.
|
# state is updated. If the meter is at 100%, it is taken down.
|
# ----------------------------------------------------------------------
|
# ----------------------------------------------------------------------
|
proc iw_manpage_progress {n max} {
|
proc iw_manpage_progress {n max} {
|
global widgets
|
global widgets
|
|
|
if {$n == $max} {
|
if {$n == $max} {
|
place forget $widgets(info-manpage-feedback)
|
place forget $widgets(info-manpage-feedback)
|
} else {
|
} else {
|
if {![winfo ismapped $widgets(info-manpage-feedback)]} {
|
if {![winfo ismapped $widgets(info-manpage-feedback)]} {
|
$widgets(info-manpage-feedback) configure -steps $max
|
$widgets(info-manpage-feedback) configure -steps $max
|
$widgets(info-manpage-feedback) reset
|
$widgets(info-manpage-feedback) reset
|
place $widgets(info-manpage-feedback) -relx 0.5 -rely 0.5 -anchor c
|
place $widgets(info-manpage-feedback) -relx 0.5 -rely 0.5 -anchor c
|
update
|
update
|
}
|
}
|
$widgets(info-manpage-feedback) step
|
$widgets(info-manpage-feedback) step
|
}
|
}
|
}
|
}
|
|
|
# ----------------------------------------------------------------------
|
# ----------------------------------------------------------------------
|
# USAGE: iw_status
|
# USAGE: iw_status
|
#
|
#
|
# Displays a status near the top of the window.
|
# Displays a status near the top of the window.
|
# ----------------------------------------------------------------------
|
# ----------------------------------------------------------------------
|
proc iw_status {message} {
|
proc iw_status {message} {
|
global widgets
|
global widgets
|
$widgets(status) configure -text $message
|
$widgets(status) configure -text $message
|
update
|
update
|
}
|
}
|
|
|
# ----------------------------------------------------------------------
|
# ----------------------------------------------------------------------
|
# USAGE: iw_lock
|
# USAGE: iw_lock
|
#
|
#
|
# Locks or unlocks the main window. Sets a grab on the main menu,
|
# Locks or unlocks the main window. Sets a grab on the main menu,
|
# so that all events are sent to it.
|
# so that all events are sent to it.
|
# ----------------------------------------------------------------------
|
# ----------------------------------------------------------------------
|
proc iw_lock {state} {
|
proc iw_lock {state} {
|
global widgets
|
global widgets
|
if {$state} {
|
if {$state} {
|
grab set $widgets(mainMenu)
|
grab set $widgets(mainMenu)
|
. configure -cursor watch
|
. configure -cursor watch
|
} else {
|
} else {
|
grab release $widgets(mainMenu)
|
grab release $widgets(mainMenu)
|
. configure -cursor ""
|
. configure -cursor ""
|
}
|
}
|
}
|
}
|
|
|
# ----------------------------------------------------------------------
|
# ----------------------------------------------------------------------
|
# USAGE: iw_draw_hier
|
# USAGE: iw_draw_hier
|
#
|
#
|
# Queries the hierarchy for a particular class in demo and
|
# Queries the hierarchy for a particular class in demo and
|
# draws a class diagram into a display window. Usually invoked when
|
# draws a class diagram into a display window. Usually invoked when
|
# a demo is loaded to display the class hierarchy for the associated
|
# a demo is loaded to display the class hierarchy for the associated
|
# widget.
|
# widget.
|
# ----------------------------------------------------------------------
|
# ----------------------------------------------------------------------
|
proc iw_draw_hier {name} {
|
proc iw_draw_hier {name} {
|
global widgets
|
global widgets
|
set canv $widgets(info-hier)
|
set canv $widgets(info-hier)
|
$canv delete all
|
$canv delete all
|
|
|
set class [string toupper [string index $name 0]][string tolower [string range $name 1 end]]
|
set class [string toupper [string index $name 0]][string tolower [string range $name 1 end]]
|
|
|
if {[catch {namespace eval $class {info inherit}}] == 0} {
|
if {[catch {namespace eval $class {info inherit}}] == 0} {
|
iw_draw_level $canv $class
|
iw_draw_level $canv $class
|
set bbox [$canv bbox all]
|
set bbox [$canv bbox all]
|
$canv move all [lindex $bbox 0] [lindex $bbox 1]
|
$canv move all [lindex $bbox 0] [lindex $bbox 1]
|
update idletasks
|
update idletasks
|
$canv xview moveto 0
|
$canv xview moveto 0
|
$canv yview moveto 0
|
$canv yview moveto 0
|
}
|
}
|
}
|
}
|
|
|
# ----------------------------------------------------------------------
|
# ----------------------------------------------------------------------
|
# USAGE: iw_draw_level
|
# USAGE: iw_draw_level
|
#
|
#
|
# Draws one level of the hierarchy for .
|
# Draws one level of the hierarchy for .
|
# ----------------------------------------------------------------------
|
# ----------------------------------------------------------------------
|
proc iw_draw_level {canv class} {
|
proc iw_draw_level {canv class} {
|
set org [iw_draw_box $canv $class]
|
set org [iw_draw_box $canv $class]
|
set top $org
|
set top $org
|
|
|
set offset 0
|
set offset 0
|
foreach base [namespace eval $class {info inherit}] {
|
foreach base [namespace eval $class {info inherit}] {
|
$canv lower [$canv create line $offset $org \
|
$canv lower [$canv create line $offset $org \
|
$offset [expr $top-10] \
|
$offset [expr $top-10] \
|
-40 [expr $top-10] \
|
-40 [expr $top-10] \
|
-24 [expr $top-10] \
|
-24 [expr $top-10] \
|
-20 [expr $top-16] \
|
-20 [expr $top-16] \
|
-16 [expr $top-10] \
|
-16 [expr $top-10] \
|
-20 [expr $top-16] \
|
-20 [expr $top-16] \
|
-20 [expr $top-26]]
|
-20 [expr $top-26]]
|
$canv move all 20 [expr -($top-26+$org)]
|
$canv move all 20 [expr -($top-26+$org)]
|
set del [iw_draw_level $canv $base]
|
set del [iw_draw_level $canv $base]
|
$canv move all -20 [expr $top-26+$org]
|
$canv move all -20 [expr $top-26+$org]
|
set top [expr $top+$del-30+$org]
|
set top [expr $top+$del-30+$org]
|
incr offset 4
|
incr offset 4
|
}
|
}
|
return $top
|
return $top
|
}
|
}
|
|
|
# ----------------------------------------------------------------------
|
# ----------------------------------------------------------------------
|
# USAGE: iw_draw_box
|
# USAGE: iw_draw_box
|
#
|
#
|
# Draws one box for a class hierarchy onto a canvas window.
|
# Draws one box for a class hierarchy onto a canvas window.
|
# ----------------------------------------------------------------------
|
# ----------------------------------------------------------------------
|
proc iw_draw_box {canv class} {
|
proc iw_draw_box {canv class} {
|
set bg [option get $canv boxColor BoxColor]
|
set bg [option get $canv boxColor BoxColor]
|
set textbg [option get $canv boxTextColor BoxTextColor]
|
set textbg [option get $canv boxTextColor BoxTextColor]
|
|
|
set cname [string trimleft $class :]
|
set cname [string trimleft $class :]
|
$canv create text 0 0 -anchor center -text $cname \
|
$canv create text 0 0 -anchor center -text $cname \
|
-fill $textbg -tags $class
|
-fill $textbg -tags $class
|
|
|
set bbox [$canv bbox $class]
|
set bbox [$canv bbox $class]
|
set x0 [expr [lindex $bbox 0]-4]
|
set x0 [expr [lindex $bbox 0]-4]
|
set y0 [expr [lindex $bbox 1]-4]
|
set y0 [expr [lindex $bbox 1]-4]
|
set x1 [expr [lindex $bbox 2]+4]
|
set x1 [expr [lindex $bbox 2]+4]
|
set y1 [expr [lindex $bbox 3]+4]
|
set y1 [expr [lindex $bbox 3]+4]
|
|
|
$canv create rectangle $x0 $y0 $x1 $y1 \
|
$canv create rectangle $x0 $y0 $x1 $y1 \
|
-outline black -fill $bg
|
-outline black -fill $bg
|
|
|
$canv raise $class
|
$canv raise $class
|
|
|
return $y0
|
return $y0
|
}
|
}
|
|
|
# ----------------------------------------------------------------------
|
# ----------------------------------------------------------------------
|
wm title . {[incr Widgets] Demo}
|
wm title . {[incr Widgets] Demo}
|
wm geometry . 620x440
|
wm geometry . 620x440
|
|
|
frame .mbar -borderwidth 2 -relief raised
|
frame .mbar -borderwidth 2 -relief raised
|
pack .mbar -fill x
|
pack .mbar -fill x
|
set widgets(mainMenu) [menubutton .mbar.main -text "Main" -menu .mbar.main.m]
|
set widgets(mainMenu) [menubutton .mbar.main -text "Main" -menu .mbar.main.m]
|
pack .mbar.main -side left
|
pack .mbar.main -side left
|
|
|
menu .mbar.main.m
|
menu .mbar.main.m
|
.mbar.main.m add command -label "About..." -command {.about activate}
|
.mbar.main.m add command -label "About..." -command {.about activate}
|
.mbar.main.m add separator
|
.mbar.main.m add separator
|
.mbar.main.m add command -label "Quit" -command tcl_exit
|
.mbar.main.m add command -label "Quit" -command tcl_exit
|
|
|
iwidgets::panedwindow .pw -orient vertical
|
iwidgets::panedwindow .pw -orient vertical
|
pack .pw -expand yes -fill both
|
pack .pw -expand yes -fill both
|
|
|
.pw add "widgets"
|
.pw add "widgets"
|
set pane [.pw childsite "widgets"]
|
set pane [.pw childsite "widgets"]
|
set widgets(list) $pane.wlist
|
set widgets(list) $pane.wlist
|
|
|
iwidgets::scrolledlistbox $widgets(list) -labeltext "Select a widget:" \
|
iwidgets::scrolledlistbox $widgets(list) -labeltext "Select a widget:" \
|
-selectioncommand {iw_load_demo [$widgets(list) getcurselection]} \
|
-selectioncommand {iw_load_demo [$widgets(list) getcurselection]} \
|
-labelpos nw -vscrollmode dynamic -hscrollmode none \
|
-labelpos nw -vscrollmode dynamic -hscrollmode none \
|
-exportselection no
|
-exportselection no
|
pack $widgets(list) -expand yes -fill both -padx 8
|
pack $widgets(list) -expand yes -fill both -padx 8
|
|
|
.pw add "info"
|
.pw add "info"
|
set pane [.pw childsite "info"]
|
set pane [.pw childsite "info"]
|
set widgets(info) $pane.info
|
set widgets(info) $pane.info
|
|
|
set widgets(status) [label $pane.status]
|
set widgets(status) [label $pane.status]
|
pack $pane.status -anchor w
|
pack $pane.status -anchor w
|
|
|
iwidgets::tabnotebook $widgets(info) -tabpos s
|
iwidgets::tabnotebook $widgets(info) -tabpos s
|
pack $widgets(info) -expand yes -fill both
|
pack $widgets(info) -expand yes -fill both
|
|
|
set widgets(info-example) [$widgets(info) add -label "Example"]
|
set widgets(info-example) [$widgets(info) add -label "Example"]
|
$widgets(info-example) configure -background white
|
$widgets(info-example) configure -background white
|
|
|
set win [$widgets(info) add -label "Example Code"]
|
set win [$widgets(info) add -label "Example Code"]
|
set widgets(info-code) [iwidgets::scrolledtext $win.code \
|
set widgets(info-code) [iwidgets::scrolledtext $win.code \
|
-wrap none -vscrollmode dynamic -hscrollmode none]
|
-wrap none -vscrollmode dynamic -hscrollmode none]
|
pack $widgets(info-code) -expand yes -fill both -padx 4 -pady 4
|
pack $widgets(info-code) -expand yes -fill both -padx 4 -pady 4
|
|
|
set win [$widgets(info) add -label "Inheritance"]
|
set win [$widgets(info) add -label "Inheritance"]
|
set widgets(info-hier) [iwidgets::scrolledcanvas $win.canv -textbackground white \
|
set widgets(info-hier) [iwidgets::scrolledcanvas $win.canv -textbackground white \
|
-vscrollmode dynamic -hscrollmode dynamic]
|
-vscrollmode dynamic -hscrollmode dynamic]
|
pack $widgets(info-hier) -expand yes -fill both -padx 4 -pady 4
|
pack $widgets(info-hier) -expand yes -fill both -padx 4 -pady 4
|
|
|
set win [$widgets(info) add -label "Man Page"]
|
set win [$widgets(info) add -label "Man Page"]
|
set widgets(info-manpage) [iwidgets::scrolledhtml $win.html \
|
set widgets(info-manpage) [iwidgets::scrolledhtml $win.html \
|
-wrap word -vscrollmode dynamic -hscrollmode none \
|
-wrap word -vscrollmode dynamic -hscrollmode none \
|
-feedback "iw_manpage_progress" \
|
-feedback "iw_manpage_progress" \
|
-linkcommand "$win.html import -link"]
|
-linkcommand "$win.html import -link"]
|
pack $widgets(info-manpage) -expand yes -fill both -padx 4 -pady 4
|
pack $widgets(info-manpage) -expand yes -fill both -padx 4 -pady 4
|
|
|
set widgets(info-manpage-feedback) [iwidgets::feedback $win.html.fb \
|
set widgets(info-manpage-feedback) [iwidgets::feedback $win.html.fb \
|
-borderwidth 2 -relief raised]
|
-borderwidth 2 -relief raised]
|
|
|
bind $widgets(info-manpage)
|
bind $widgets(info-manpage)
|
|
|
.pw fraction 25 75
|
.pw fraction 25 75
|
$widgets(info) select "Example"
|
$widgets(info) select "Example"
|
|
|
# ----------------------------------------------------------------------
|
# ----------------------------------------------------------------------
|
# "About" window
|
# "About" window
|
# ----------------------------------------------------------------------
|
# ----------------------------------------------------------------------
|
iwidgets::dialog .about -title {About: [incr Widgets] Demo} -modality none
|
iwidgets::dialog .about -title {About: [incr Widgets] Demo} -modality none
|
.about hide "Apply"
|
.about hide "Apply"
|
.about hide "Help"
|
.about hide "Help"
|
.about hide "Cancel"
|
.about hide "Cancel"
|
.about buttonconfigure "OK" -command ".about deactivate"
|
.about buttonconfigure "OK" -command ".about deactivate"
|
.about default "OK"
|
.about default "OK"
|
|
|
set win [.about childsite]
|
set win [.about childsite]
|
label $win.title -text {[incr Widgets]}
|
label $win.title -text {[incr Widgets]}
|
pack $win.title
|
pack $win.title
|
catch {$win.title configure -font -*-helvetica-bold-o-normal-*-*-180-*}
|
catch {$win.title configure -font -*-helvetica-bold-o-normal-*-*-180-*}
|
|
|
set file [file join ${iwidgets::library} demos iwidgets.gif]
|
set file [file join ${iwidgets::library} demos iwidgets.gif]
|
label $win.icon -image [image create photo -file $file]
|
label $win.icon -image [image create photo -file $file]
|
pack $win.icon -side left
|
pack $win.icon -side left
|
|
|
label $win.by -text "Contributed By"
|
label $win.by -text "Contributed By"
|
pack $win.by
|
pack $win.by
|
catch {$win.by configure -font -*-helvetica-medium-r-normal-*-*-100-*}
|
catch {$win.by configure -font -*-helvetica-medium-r-normal-*-*-100-*}
|
|
|
label $win.authors -text "Mark L. Ulferts
|
label $win.authors -text "Mark L. Ulferts
|
Sue Yockey
|
Sue Yockey
|
John Sigler
|
John Sigler
|
Bill Scott
|
Bill Scott
|
Alfredo Jahn
|
Alfredo Jahn
|
Tako Schotanus
|
Tako Schotanus
|
Kris Raney"
|
Kris Raney"
|
pack $win.authors
|
pack $win.authors
|
catch {$win.authors configure -font -*-helvetica-medium-o-normal-*-*-120-*}
|
catch {$win.authors configure -font -*-helvetica-medium-o-normal-*-*-120-*}
|
|
|
# ----------------------------------------------------------------------
|
# ----------------------------------------------------------------------
|
# Load up a list of demos...
|
# Load up a list of demos...
|
# ----------------------------------------------------------------------
|
# ----------------------------------------------------------------------
|
foreach file [lsort [glob [file join ${iwidgets::library} demos *]]] {
|
foreach file [lsort [glob [file join ${iwidgets::library} demos *]]] {
|
set name [file tail $file]
|
set name [file tail $file]
|
if {![file isdirectory $file] && ![string match *.* $name]} {
|
if {![file isdirectory $file] && ![string match *.* $name]} {
|
$widgets(list) insert end $name
|
$widgets(list) insert end $name
|
}
|
}
|
}
|
}
|
$widgets(list) selection set 0
|
$widgets(list) selection set 0
|
uplevel #0 [$widgets(list) cget -selectioncommand]
|
uplevel #0 [$widgets(list) cget -selectioncommand]
|
|
|