Hi,
I have implemted a patch to vtcl-1.10 to include some support for
itcl widgets and the graph widget from blt2.1. Note this is a first
cut by me and there are not claims that it will work. Also not that I
have not developed any pictures to put in the tool bar. I am useing
the TIX unknown, which is blank, and using the ballon help to deterime
which is which.
This is a list of difference between vt-1.10 and my patch. I do not
know how to generate a valid patch file (any help). Thanks to Kenneth
H. Cox for his tix implementation, this was used as a starting point.
---------------- attrbar.tcl -----------------------
46c46
< $widget config -justify $option
---
> $widget conf -justify $option
58c58
< $widget config -font [list $option $size $style]
---
> $widget conf -font [list $option $size $style]
61c61
< $widget config -font [list $base $option $style]
---
> $widget conf -font [list $base $option $style]
70c70
< $widget config -font [list $base $size $style]
---
> $widget conf -font [list $base $size $style]
79c79
< $vTcl(w,widget) config -relief $relief
---
> $vTcl(w,widget) conf -relief $relief
86c86
< $vTcl(w,widget) config -bd $border
---
> $vTcl(w,widget) conf -bd $border
93c93
< $vTcl(w,widget) config -anchor $anchor
---
> $vTcl(w,widget) conf -anchor $anchor
125c125
< set dbg [lindex [. config -bg] 3]
---
> set dbg [lindex [. conf -bg] 3]
137,138c137,138
< .vTcl.attr.010.lab41 config -bg $fg
< .vTcl.attr.010.lab42 config -bg $bg
---
> .vTcl.attr.010.lab41 conf -bg $fg
> .vTcl.attr.010.lab42 conf -bg $bg
---------------- command.tcl -----------------------
54c54
< $target config $option [string trim $r]
---
> $target conf $option [string trim $r]
---------------- compound.tcl -----------------------
224c224
< set opts [vTcl:get_opts [$target config]]
---
> set opts [vTcl:get_opts [$target conf]]
248,266c248,250
< set class [vTcl:get_class $target]
< if {[lsearch $vTcl(multclasses) $class] < 0 || \
< ![info exist vTcl($class,nosubwidget)]} {
< foreach i [vTcl:get_children $target] {
< # puts "IN KKKK"
< incr vTcl(cmp,index)
< append chld "[vTcl:gen_compound $i $name.0$vTcl(cmp,index)] "
< }
< } else {
< foreach i [vTcl:get_children $target] {
< set subindex [string last $target $i]
< set subwidget [string range $i [expr [string length $target]+1] end]
< # puts "trim '$subwidget' $i $target $subindex"
< if {[lsearch $vTcl($class,nosubwidget) $subwidget] < 0} {
< puts "IN nosub '$subwidget' $i $target"
< incr vTcl(cmp,index)
< append chld "[vTcl:gen_compound $i $name.0$vTcl(cmp,index)] "
< }
< }
---
> foreach i [vTcl:get_children $target] {
> incr vTcl(cmp,index)
> append chld "[vTcl:gen_compound $i $name.0$vTcl(cmp,index)] "
268,269d251
< # puts "CHILD $target $chld"
<
---------------- console.tcl -----------------------
72c72
< .vTcl.con.fra5.tex7 config -state normal
---
> .vTcl.con.fra5.tex7 conf -state normal
74c74
< .vTcl.con.fra5.tex7 config -state disabled
---
> .vTcl.con.fra5.tex7 conf -state disabled
---------------- dragsize.tcl -----------------------
29c29
< set target [vTcl:active_widget $target]
---
> vTcl:active_widget $target
160,161c160,167
< if {[lsearch $vTcl(NoXResizeClasses) $vTcl(w,class)] >= 0} {
< set vTcl(w,opt,-height) ""
---
> switch $vTcl(w,class) {
> Label -
> Entry -
> Message -
> Scrollbar -
> Scale {
> set vTcl(w,opt,-height) ""
> }
199,202c205,215
< if {[lsearch $vTcl(NoXResizeClasses) $vTcl(w,class)] >= 0} {
< $widget configure -width $newW
< } else {
< $widget configure -width $newW -height $newH
---
> switch $vTcl(w,class) {
> Label -
> Entry -
> Message -
> Scrollbar -
> Scale {
> $widget configure -width $newW
> }
> default {
> $widget configure -width $newW -height $newH
> }
---------------- dump.tcl -----------------------
174c174
< set result "$target config $vTcl(w,options)\n"
---
> set result "$target conf $vTcl(w,options)\n"
185c185
< set opt [$target config]
---
> set opt [$target conf]
340,342d339
< if {[regexp "($vTcl(top,ignore,post))\$" $target]} {
< return ""
< }
---------------- edit.tcl -----------------------
28d27
< # puts "COPY '$vTcl(w,widget)' $vTcl(buffer)"
47c46
< set parent [vTcl:select_widget $parent]
---
> vTcl:select_widget $parent
---------------- globals.tcl -----------------------
88d87
< set vTcl(top,ignore,post) ""
---------------- help.tcl -----------------------
78c78
< .vTcl.help.fra18.tex22 config -state disabled
---
> .vTcl.help.fra18.tex22 conf -state disabled
---------------- lib_core.tcl -----------------------
81d80
< lappend vTcl(NoXResizeClasses) Label Entry Message Scrollbar Scale
96c95
< $target config -menu $target.m
---
> $target conf -menu $target.m
334c333
< $target config -tearoff $vTcl(menu,$target,tear)
---
> $target conf -tearoff $vTcl(menu,$target,tear)
427c426
< $target config -menu $menu
---
> $target conf -menu $menu
---------------- lib_tix.tcl -----------------------
43c43
< tixPanedWindow tixOptionMenu tixControl
---
> tixPanedWindow tixOptionMenu
183d182
< set vTcl(tixControl,insert) "-label {LabelEntry:} -options
{label.anchor e}"
341d339
< set vTcl(TixControl,dump_opt) vTcl:dump:TixLabelEntry
358d355
< set vTcl(TixControl,dump_children) 0
368,372d364
<
< set vTcl(m,tixGeometry,list) ""
< set vTcl(m,tixGeometry,extlist) ""
< set vTcl(m,tixForm,list) ""
< set vTcl(m,tixForm,extlist) ""
535d526
< append output "$target subwidget entry configure -width [$target subwidget entry
cget -width]\n"
621c612
< set opt [$target config]
---
> set opt [$target conf]
---------------- propmgr.tcl -----------------------
70c70
< $f.l config -text "$name (-)"
---
> $f.l conf -text "$name (-)"
74c74
< $f.l config -text "$name (+)"
---
> $f.l conf -text "$name (+)"
267c267
< set config_cmd "$mgr config \$vTcl(w,widget) $i \$$variable"
---
> set config_cmd "$mgr conf \$vTcl(w,widget) $i \$$variable"
324c324
< "$config_cmd; ${base}.f config -bg \$$variable"
---
> "$config_cmd; ${base}.f conf -bg \$$variable"
---------------- tabpanel.tcl -----------------------
73c73
< $widget.l.$vTcl(tab,$widget,current) config -relief raised
---
> $widget.l.$vTcl(tab,$widget,current) conf -relief raised
76c76
< $widget.l.$name config -relief sunken
---
> $widget.l.$name conf -relief sunken
98c98
< $widget.c config -scrollregion "0 0 $fw $fh"
---
> $widget.c conf -scrollregion "0 0 $fw $fh"
---------------- widget.tcl -----------------------
57c57
< switch [lindex [$t2 config -orient] 4] {
---
> switch [lindex [$t2 conf -orient] 4] {
66,67c66,67
< $t1 config $scr_cmd "$t2 set"
< $t2 config -command "$t1 $v_cmd"
---
> $t1 conf $scr_cmd "$t2 set"
> $t2 conf -command "$t1 $v_cmd"
71,72c71,72
< $t1 config $scr_cmd "$t2 set"
< $t2 config -command "$t1 $v_cmd"
---
> $t1 conf $scr_cmd "$t2 set"
> $t2 conf -command "$t1 $v_cmd"
129d128
< # puts "vTcl:active_widget $target"
132,133c131
< set target [vTcl:select_widget $target]
< # puts "Select_Widget '$target'"
---
> vTcl:select_widget $target
151d148
< return $target
156,179c153
< # puts "select_widget $target"
< set tmp [winfo parent $target]
< if {$tmp != ""} {set class [vTcl:get_class $tmp] }
< while {$tmp != "" && [lsearch $vTcl(multclasses) $class] < 0} {
< set tmp [winfo parent $tmp]
< if {$tmp != ""} {set class [vTcl:get_class $tmp]}
< }
< if {$tmp != ""} {
< if {[info exist vTcl($class,nosubwidget)]} {
< set subindex [string last $tmp $target]
< set subwidget [string range $target [expr [string length $tmp]+1] end]
< # puts "SUBWIDGET '$subwidget' $tmp $target $subindex"
< #[string trimleft $target $tmp]
< if {[lsearch $vTcl($class,nosubwidget) $subwidget] >= 0} {
< set target $tmp
< }
< # Use these line to help in finding out the subwidgets selectagle
< if {[lsearch $vTcl($class,nosubwidget) $subwidget] < 0} {
< puts "Selected subsidget $subwidget"
< # puts "ALL [vTcl:list_widget_tree $tmp all]"
< }
< }
< }
< if {$target == $vTcl(w,widget)} {return $target}
---
> if {$target == $vTcl(w,widget)} {return}
186d159
< return $target
554c527
< $t config -text $vTcl(w,opt,-text)
---
> $t conf -text $vTcl(w,opt,-text)
567c540
< $t config -text $label
---
> $t conf -text $label
576c549
< $t config -textvar $label
---
> $t conf -textvar $label
604c577
< pack config $target -after $n
---
> pack conf $target -after $n
615c588
< pack config $target -before $n
---
> pack conf $target -before $n
---------------- NEW FILE lib_blt.tcl -----------------------
##############################################################################
#
# lib_blt.tcl - blt widget support library
#
# Copyright (C) 1996-1997 Stewart Allen
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
# Architecture by Stewart Allen
# Implementation by James Kramer usinge ideas from
# Kenneth H. Cox <[EMAIL PROTECTED]>
#
# Initializes this library
#
#if {[info exist blt_library] == 1} {
# global auto_path blt_library
# lappend auto_path $blt_library
# catch {
# import add blt
# }
#}
proc vTcl:widget:lib:lib_blt {args} {
global vTcl blt_library
#
# see if we're running bltWish. if not, return
#
if {[info exist blt_library] == 0} {
puts "IN NO BLT"
return
} else {
global auto_path blt_library
lappend auto_path $blt_library
catch {
import add blt
}
}
# setup required variables
vTcl:lib_blt:setup
# add items to toolbar
foreach i {
graph
} {
set img_file [file join $vTcl(VTCL_HOME) images icon_$i.gif]
if {![file exists $img_file]} {
set img_file [file join $vTcl(VTCL_HOME) images icon_tix_unknown.gif]
}
image create photo "ctl_$i" -file $img_file
vTcl:toolbar_add $i $i ctl_$i ""
}
# The Widget Browser needs images for all blt classes.
# The images need to be called, e.g. ctl_bltNoteBookFrame.
# Don't put these in the toolbar, because they are not commands,
# only classes.
}
proc vTcl:lib_blt:setup {} {
global vTcl
#
# additional attributes to set on insert
#
set vTcl(graph,insert) "-background white -plotrelief groove -foreground
black"
#
# add to procedure, var, bind regular expressions
#
if {"$vTcl(bind,ignore)" != ""} {
append vTcl(bind,ignore) "|tix"
} else {
append vTcl(bind,ignore) "tix"
}
append vTcl(proc,ignore) "|tix"
append vTcl(var,ignore) "|tix"
#
# add to valid class list
#
lappend vTcl(classes) \
Graph
#
# register additional options that might be on Blt widgets,
# and the option information that the Attribute Editor needs.
#
lappend vTcl(opt,list) \
-plotbackground \
-plotborderwidth \
-plotrelief \
-title
set vTcl(opt,-plotbackground) { {Plot BgColor} Colors color {} }
set vTcl(opt,-plotborderwidth) { {Plot Width} longname type {} }
set vTcl(opt,-plotrelief) { {Plot Relief} {} choice {flat
groove raised ridge sunken} }
set vTcl(opt,-title) { Title longname type {} }
#
# define dump procedures for widget types
#
set vTcl(Graph,dump_opt) vTcl:lib_blt:dump_widget_opt
#
# define whether or not do dump children of a class
#
set vTcl(Graph,dump_children) 0
}
#
# individual widget commands executed after insert
#
proc vTcl:widget:graph:inscmd {target} {
return ""
}
#
# per-widget-class dump procedures
#
# Utility proc. Ignore color options (-background, etc.) based on
# preference.
#
# returns:
# 1 means save the option
# 0 means don't save it
proc vTcl:lib_blt:save_option {opt} {
return 1
}
# Utility proc. Dump a blt widget.
# Differs from vTcl:dump_widget_opt in that it tries harder to avoid
# dumping options that shouldn't really be dumped, e.g. -fg,-bg,-font.
proc vTcl:lib_blt:dump_widget_opt {target basename} {
global vTcl
set result ""
set class [vTcl:get_class $target]
set result "$vTcl(tab)[vTcl:lower_first $class] $basename"
set opt [$target configure]
set keep_opt ""
foreach e $opt {
if [vTcl:lib_blt:save_option $e] {
lappend keep_opt $e
}
}
set p [vTcl:get_opts $keep_opt]
if {$p != ""} {
append result " \\\n[vTcl:clean_pairs $p]\n"
} else {
append result "\n"
}
append result [vTcl:dump_widget_bind $target $basename]
return $result
}
---------------- NEW FILE lib_itcl.tcl -----------------------
##############################################################################
#
# lib_itcl.tcl - itcl widget support library
#
# Copyright (C) 1996-1997 Stewart Allen
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
# Architecture by Stewart Allen
# Implementation by James Kramer usinge ideas from
# Kenneth H. Cox <[EMAIL PROTECTED]>
#
# Initializes this library
#
proc vTcl:widget:lib:lib_itcl {args} {
global vTcl
#
# see if we're running itclWish. if not, return
#
# setup required variables
vTcl:lib_itcl:setup
# add items to toolbar
foreach i {
entryfield spinint combobox
} {
set img_file [file join $vTcl(VTCL_HOME) images icon_$i.gif]
if {![file exists $img_file]} {
set img_file [file join $vTcl(VTCL_HOME) images icon_tix_unknown.gif]
}
image create photo "ctl_$i" -file $img_file
vTcl:toolbar_add $i $i ctl_$i ""
}
# The Widget Browser needs images for all itcl classes.
# The images need to be called, e.g. ctl_itclNoteBookFrame.
# Don't put these in the toolbar, because they are not commands,
# only classes.
}
proc vTcl:lib_itcl:setup {} {
global vTcl
#
# additional attributes to set on insert
#
set vTcl(scrolledlistbox,insert) "-labeltext {Label:} "
set vTcl(combobox,insert) "-labeltext {Label:} "
set vTcl(entryfield,insert) "-labeltext {Label:} "
set vTcl(spinint,insert) "-labeltext {Label:} -range {0 10} -step 1"
#
# add to procedure, var, bind regular expressions
#
# if {"$vTcl(bind,ignore)" != ""} {
# append vTcl(bind,ignore) "|tix"
# } else {
# append vTcl(bind,ignore) "tix"
# }
# append vTcl(proc,ignore) "|tix"
# append vTcl(var,ignore) "|tix"
append vTcl(top,ignore,post) ".*shell\\.lwchildsite\\.efchildsite\\.popup"
lappend vTcl(NoXResizeClasses) Combobox Spinint Entryfield
#
# add to valid class list
#
lappend vTcl(classes) \
Entryfield \
Spinint \
Combobox \
Scrolledlistbox
lappend vTcl(multclasses) \
Entryfield \
Spinint \
Combobox \
Scrolledlistbox
lappend vTcl(Combobox,nosubwidget) \
shell \
shell.label \
shell.lwchildsite \
shell.lwchildsite.entry \
shell.lwchildsite.efchildsite \
shell.lwchildsite.efchildsite.arrowBtn
lappend vTcl(Entryfield,nosubwidget) \
shell \
shell.label \
shell.lwchildsite \
shell.lwchildsite.entry
lappend vTcl(Spinint,nosubwidget) \
shell \
shell.label \
shell.lwchildsite \
shell.lwchildsite.entry \
shell.lwchildsite.efchildsite \
shell.lwchildsite.efchildsite.arrowFrame \
shell.lwchildsite.efchildsite.arrowFrame.uparrow \
shell.lwchildsite.efchildsite.arrowFrame.downarrow
#
# register additional options that might be on itcl widgets,
# and the option information that the Attribute Editor needs.
#
lappend vTcl(opt,list) \
-fixed \
-range \
-step \
-validate \
-labeltext \
-labelpos \
-labelfont \
-textfont \
-items \
-decrement \
-increment
# set vTcl(opt,-plotbackground) { {Plot BgColor} Colors color {} }
set vTcl(opt,-labelfont) { {Label Font} {} type {} }
set vTcl(opt,-textfont) { {Text Font} {} type {} }
set vTcl(opt,-labelpos) { {Label Pos} {} choice {n ne e se s
sw w nw center} }
set vTcl(opt,-fixed) { {Fixed} longname type {} }
set vTcl(opt,-validate) { {Validate Cmd} {} command {}}
set vTcl(opt,-decrement) { {Decrement Cmd} {} command {}}
set vTcl(opt,-increment) { {Increment Cmd} {} command {}}
set vTcl(opt,-labeltext) { Label longname type {} }
set vTcl(opt,-range) { Range longname type {} }
set vTcl(opt,-items) { Range longname type {} }
set vTcl(opt,-step) { Step longname type {} }
#
# define dump procedures for widget types
#
set vTcl(Entryfield,dump_opt) vTcl:lib_itcl:dump_widget_opt
set vTcl(Spinint,dump_opt) vTcl:lib_itcl:dump_widget_opt
set vTcl(Combobox,dump_opt) vTcl:lib_itcl:dump_widget_opt
set vTcl(Scrolledlistbox,dump_opt) vTcl:lib_itcl:dump_widget_opt
#
# define whether or not do dump children of a class
#
set vTcl(Entryfield,dump_children) 0
set vTcl(Spinint,dump_children) 0
set vTcl(Combobox,dump_children) 0
set vTcl(Scrolledlistbox,dump_children) 0
}
#
# individual widget commands executed after insert
#
proc vTcl:widget:graph:inscmd {target} {
return ""
}
#
# per-widget-class dump procedures
#
# Utility proc. Ignore color options (-background, etc.) based on
# preference.
#
# returns:
# 1 means save the option
# 0 means don't save it
proc vTcl:lib_itcl:save_option {opt} {
return 1
}
# Utility proc. Dump a itcl widget.
# Differs from vTcl:dump_widget_opt in that it tries harder to avoid
# dumping options that shouldn't really be dumped, e.g. -fg,-bg,-font.
proc vTcl:lib_itcl:dump_widget_opt {target basename} {
global vTcl
set result ""
set class [vTcl:get_class $target]
set result "$vTcl(tab)[vTcl:lower_first $class] $basename"
set opt [$target configure]
set keep_opt ""
foreach e $opt {
if [vTcl:lib_itcl:save_option $e] {
lappend keep_opt $e
}
}
set p [vTcl:get_opts $keep_opt]
if {$p != ""} {
append result " \\\n[vTcl:clean_pairs $p]\n"
} else {
append result "\n"
}
append result [vTcl:dump_widget_bind $target $basename]
return $result
}
