Compare commits
| Author | SHA1 | Date | |
|---|---|---|---|
 Christopher Sean Morrison
|
cba34bcddc | ||
|
jan.nijtmans
|
328a1bbaa1 | ||
|
jan.nijtmans
|
ea62778405 | ||
|
jan.nijtmans
|
9228f3049c | ||
|
jan.nijtmans
|
1a472acb9a |
@@ -1,12 +0,0 @@
|
||||
*.a
|
||||
*.bmp
|
||||
*.dll
|
||||
*.exe
|
||||
*.gif
|
||||
*.gz
|
||||
*.jpg
|
||||
*.lib
|
||||
*.pdf
|
||||
*.png
|
||||
*.xlsx
|
||||
*.zip
|
||||
@@ -1,18 +0,0 @@
|
||||
compat/zlib/contrib/dotzlib/DotZLib/UnitTests.cs
|
||||
compat/zlib/contrib/vstudio/readme.txt
|
||||
compat/zlib/contrib/vstudio/*/zlib.rc
|
||||
compat/zlib/contrib/vstudio/*/*.sln
|
||||
compat/zlib/win32/*.txt
|
||||
compat/zlib/win64/*.txt
|
||||
libtommath/*.dsp
|
||||
libtommath/*.sln
|
||||
libtommath/*.vcproj
|
||||
tools/tcl.wse.in
|
||||
win/buildall.vc.bat
|
||||
win/coffbase.txt
|
||||
win/makefile.vc
|
||||
win/rules.vc
|
||||
win/rules-ext.vc
|
||||
win/targets.vc
|
||||
win/tcl.dsp
|
||||
win/tcl.dsw
|
||||
@@ -1,7 +0,0 @@
|
||||
tools/tcl.wse.in
|
||||
win/buildall.vc.bat
|
||||
win/coffbase.txt
|
||||
win/makefile.vc
|
||||
win/rules.vc
|
||||
win/tcl.dsp
|
||||
win/tcl.dsw
|
||||
@@ -1,29 +0,0 @@
|
||||
*.a
|
||||
*.dll
|
||||
*.dylib
|
||||
*.dylib.E
|
||||
*.exe
|
||||
*.exp
|
||||
*.la
|
||||
*.lib
|
||||
*.lo
|
||||
*.o
|
||||
*.obj
|
||||
*.pdb
|
||||
*.res
|
||||
*.sl
|
||||
*.so
|
||||
Makefile
|
||||
autom4te.cache
|
||||
config.cache
|
||||
config.log
|
||||
config.status
|
||||
itkConfig.sh
|
||||
pkgIndex.tcl
|
||||
versions.vc
|
||||
version.vc
|
||||
libitk.vfs
|
||||
libitk_*.zip
|
||||
html
|
||||
win/nmakehlp.out
|
||||
win/nmhlp-out.txt
|
||||
@@ -1,40 +0,0 @@
|
||||
# Set the default behavior, in case people don't have core.autocrlf set.
|
||||
* eol=lf
|
||||
* text=auto
|
||||
|
||||
# Explicitly declare text files you want to always be normalized and converted
|
||||
# to native line endings on checkout.
|
||||
*.3 text
|
||||
*.c text
|
||||
*.css text
|
||||
*.enc text
|
||||
*.h text
|
||||
*.htm text
|
||||
*.html text
|
||||
*.java text
|
||||
*.js text
|
||||
*.json text
|
||||
*.n text
|
||||
*.svg text
|
||||
*.ts text
|
||||
*.tcl text
|
||||
*.test text
|
||||
|
||||
# Declare files that will always have CRLF line endings on checkout.
|
||||
*.bat eol=crlf
|
||||
*.sln eol=crlf
|
||||
*.vc eol=crlf
|
||||
|
||||
# Denote all files that are truly binary and should not be modified.
|
||||
*.a binary
|
||||
*.bmp binary
|
||||
*.dll binary
|
||||
*.exe binary
|
||||
*.gif binary
|
||||
*.gz binary
|
||||
*.jpg binary
|
||||
*.lib binary
|
||||
*.pdf binary
|
||||
*.png binary
|
||||
*.xlsx binary
|
||||
*.zip binary
|
||||
-33
@@ -1,33 +0,0 @@
|
||||
*.a
|
||||
*.bundle
|
||||
*.dll
|
||||
*.dylib
|
||||
*.dylib.E
|
||||
*.exe
|
||||
*.exp
|
||||
*.lib
|
||||
*.o
|
||||
*.obj
|
||||
*.pdb
|
||||
*.res
|
||||
*.sl
|
||||
*.so
|
||||
.fslckout
|
||||
Makefile
|
||||
autom4te.cache
|
||||
config.cache
|
||||
config.log
|
||||
config.status
|
||||
config.status.lineno
|
||||
html
|
||||
manifest.uuid
|
||||
_FOSSIL_
|
||||
itkConfig.sh
|
||||
pkgIndex.tcl
|
||||
versions.vc
|
||||
version.vc
|
||||
libitk.vfs
|
||||
libitk_*.zip
|
||||
html
|
||||
win/nmakehlp.out
|
||||
win/nmhlp-out.txt
|
||||
+5
-6
@@ -64,7 +64,7 @@ PKG_LIB_FILE8 = @PKG_LIB_FILE8@
|
||||
PKG_LIB_FILE9 = @PKG_LIB_FILE9@
|
||||
PKG_STUB_LIB_FILE = @PKG_STUB_LIB_FILE@
|
||||
|
||||
lib_BINARIES = $(PKG_LIB_FILE) $(PKG_STUB_LIB_FILE)
|
||||
lib_BINARIES = $(PKG_LIB_FILE)
|
||||
BINARIES = $(lib_BINARIES)
|
||||
|
||||
SHELL = @SHELL@
|
||||
@@ -171,7 +171,7 @@ CLEANFILES = @CLEANFILES@
|
||||
CPPFLAGS = @CPPFLAGS@
|
||||
LIBS = @PKG_LIBS@ @LIBS@
|
||||
AR = @AR@
|
||||
CFLAGS = @CFLAGS@
|
||||
CFLAGS = @CFLAGS@ -DTCL_NO_DEPRECATED
|
||||
COMPILE = $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
|
||||
|
||||
GDB = gdb
|
||||
@@ -220,7 +220,6 @@ install-binaries: binaries install-lib-binaries install-bin-binaries
|
||||
|
||||
#========================================================================
|
||||
# This rule installs platform-independent files, such as header files.
|
||||
# The list=...; for p in $$list handles the empty list case x-platform.
|
||||
#========================================================================
|
||||
|
||||
install-libraries: libraries
|
||||
@@ -304,14 +303,14 @@ $(PKG_STUB_LIB_FILE): $(PKG_STUB_OBJECTS)
|
||||
# you will have to modify the paths to reflect this:
|
||||
#
|
||||
# sample.$(OBJEXT): $(srcdir)/generic/sample.c
|
||||
# $(COMPILE) -c `@CYGPATH@ $(srcdir)/generic/sample.c` -o $@
|
||||
# $(COMPILE) -c `@CYGPATH@ $(srcdir)/generic/sample.c` -o $@
|
||||
#
|
||||
# Setting the VPATH variable to a list of paths will cause the makefile
|
||||
# to look into these paths when resolving .c to .obj dependencies.
|
||||
# As necessary, add $(srcdir):$(srcdir)/compat:....
|
||||
#========================================================================
|
||||
|
||||
VPATH = $(srcdir):$(srcdir)/generic:$(srcdir)/unix:$(srcdir)/win:$(srcdir)/macosx
|
||||
VPATH = $(srcdir)/unix:$(srcdir)/generic:$(srcdir)/win
|
||||
|
||||
.c.@OBJEXT@:
|
||||
$(COMPILE) -c `@CYGPATH@ $<` -I. -o $@
|
||||
@@ -421,7 +420,7 @@ install-lib-binaries: binaries
|
||||
lib=`basename $$p|sed -e 's/.[^.]*$$//'`.lib; \
|
||||
if test -f $$lib; then \
|
||||
echo " $(INSTALL_DATA) $$lib $(DESTDIR)$(pkglibdir)/$$lib"; \
|
||||
$(INSTALL_DATA) $$lib "$(DESTDIR)$(pkglibdir)/$$lib"; \
|
||||
$(INSTALL_DATA) $$lib "$(DESTDIR)$(pkglibdir)/$$lib"; \
|
||||
fi; \
|
||||
fi; \
|
||||
fi; \
|
||||
|
||||
+16
-16
@@ -19,7 +19,7 @@ dnl to configure the system for the local environment.
|
||||
# so that we create the export library with the dll.
|
||||
#-----------------------------------------------------------------------
|
||||
|
||||
AC_INIT([itk],[4.2.7])
|
||||
AC_INIT([itk], [4.2.3])
|
||||
|
||||
#--------------------------------------------------------------------
|
||||
# Call TEA_INIT as the first TEA_ macro to set up initial vars.
|
||||
@@ -102,25 +102,25 @@ TEA_SETUP_COMPILER
|
||||
#-----------------------------------------------------------------------
|
||||
|
||||
TEA_ADD_SOURCES([
|
||||
itkArchBase.c
|
||||
itkArchetype.c
|
||||
itkBase.c
|
||||
itkCmd.c
|
||||
itkHelpers.c
|
||||
itkOption.c
|
||||
itkUtil.c
|
||||
itkStubInit.c
|
||||
])
|
||||
itkArchBase.c
|
||||
itkArchetype.c
|
||||
itkBase.c
|
||||
itkCmd.c
|
||||
itkHelpers.c
|
||||
itkOption.c
|
||||
itkUtil.c
|
||||
itkStubInit.c
|
||||
])
|
||||
TEA_ADD_HEADERS([generic/itk.h generic/itkInt.h])
|
||||
TEA_ADD_INCLUDES([${ITCL_INCLUDES} -I\"`${CYGPATH} ${srcdir}/generic`\"])
|
||||
TEA_ADD_LIBS([])
|
||||
TEA_ADD_CFLAGS([])
|
||||
TEA_ADD_STUB_SOURCES([itkStubLib.c])
|
||||
#TEA_ADD_STUB_SOURCES([itkStubLib.c])
|
||||
TEA_ADD_TCL_SOURCES([library/Archetype.itk
|
||||
library/Toplevel.itk
|
||||
library/Widget.itk
|
||||
library/itk.tcl
|
||||
library/tclIndex])
|
||||
library/Toplevel.itk
|
||||
library/Widget.itk
|
||||
library/itk.tcl
|
||||
library/tclIndex])
|
||||
|
||||
#--------------------------------------------------------------------
|
||||
# __CHANGE__
|
||||
@@ -259,4 +259,4 @@ AC_CONFIG_FILES([itkConfig.sh])
|
||||
# specified with AC_CONFIG_FILES.
|
||||
#--------------------------------------------------------------------
|
||||
|
||||
AC_OUTPUT
|
||||
AC_OUTPUT()
|
||||
|
||||
+45
-45
@@ -53,26 +53,26 @@ proc file_load {} {
|
||||
|
||||
.files buttonconfigure OK -text "Load"
|
||||
if {[.files activate]} {
|
||||
set fname [.files get]
|
||||
set cmd {
|
||||
set fid [open $fname r]
|
||||
set text [read $fid]
|
||||
close $fid
|
||||
}
|
||||
if {[catch $cmd err] != 0} {
|
||||
.notice configure -bitmap error \
|
||||
-text "Cannot load file \"$fname\":\n$err"
|
||||
.notice activate
|
||||
return
|
||||
}
|
||||
set fname [.files get]
|
||||
set cmd {
|
||||
set fid [open $fname r]
|
||||
set text [read $fid]
|
||||
close $fid
|
||||
}
|
||||
if {[catch $cmd err] != 0} {
|
||||
.notice configure -bitmap error \
|
||||
-text "Cannot load file \"$fname\":\n$err"
|
||||
.notice activate
|
||||
return
|
||||
}
|
||||
|
||||
set pane [$PaneMenu get]
|
||||
set win [.edit childsite $pane]
|
||||
clear_text $win
|
||||
$win.text insert end $text
|
||||
$win.text configure -labeltext "file: $fname"
|
||||
set pane [$PaneMenu get]
|
||||
set win [.edit childsite $pane]
|
||||
clear_text $win
|
||||
$win.text insert end $text
|
||||
$win.text configure -labeltext "file: $fname"
|
||||
|
||||
set FileName($win) $fname
|
||||
set FileName($win) $fname
|
||||
}
|
||||
}
|
||||
|
||||
@@ -89,12 +89,12 @@ proc file_save_as {} {
|
||||
|
||||
.files buttonconfigure OK -text "Save"
|
||||
if {[.files activate]} {
|
||||
set pane [$PaneMenu get]
|
||||
set win [.edit childsite $pane]
|
||||
set pane [$PaneMenu get]
|
||||
set win [.edit childsite $pane]
|
||||
|
||||
set FileName($win) [.files get]
|
||||
set FileName($win) [.files get]
|
||||
|
||||
file_save $win
|
||||
file_save $win
|
||||
}
|
||||
}
|
||||
|
||||
@@ -108,16 +108,16 @@ proc file_save {win} {
|
||||
global FileName FileChanged
|
||||
|
||||
set cmd {
|
||||
set fid [open $FileName($win) w]
|
||||
puts $fid [$win.text get 1.0 end]
|
||||
close $fid
|
||||
set FileChanged($win) 0
|
||||
$win.text configure -labeltext "file: $FileName($win)"
|
||||
set fid [open $FileName($win) w]
|
||||
puts $fid [$win.text get 1.0 end]
|
||||
close $fid
|
||||
set FileChanged($win) 0
|
||||
$win.text configure -labeltext "file: $FileName($win)"
|
||||
}
|
||||
if {[catch $cmd err] != 0} {
|
||||
.notice configure -bitmap error \
|
||||
-text "Cannot save file \"$FileName($win)\":\n$err"
|
||||
.notice activate
|
||||
.notice configure -bitmap error \
|
||||
-text "Cannot save file \"$FileName($win)\":\n$err"
|
||||
.notice activate
|
||||
}
|
||||
}
|
||||
|
||||
@@ -132,22 +132,22 @@ proc clear_text {{areas ""}} {
|
||||
global FileName FileChanged FileWindows
|
||||
|
||||
if {$areas == ""} {
|
||||
for {set i 0} {$i < $FileWindows} {incr i} {
|
||||
set pane "area #[expr $i+1]"
|
||||
lappend areas [.edit childsite $pane]
|
||||
}
|
||||
for {set i 0} {$i < $FileWindows} {incr i} {
|
||||
set pane "area #[expr $i+1]"
|
||||
lappend areas [.edit childsite $pane]
|
||||
}
|
||||
}
|
||||
|
||||
foreach win $areas {
|
||||
if {$FileChanged($win)} {
|
||||
set fname [file tail $FileName($win)]
|
||||
.confirm configure -text "File \"$fname\" has changed.\nSave changes?"
|
||||
if {[.confirm activate]} {
|
||||
file_save $win
|
||||
}
|
||||
}
|
||||
$win.text delete 1.0 end
|
||||
set FileChanged($win) 0
|
||||
if {$FileChanged($win)} {
|
||||
set fname [file tail $FileName($win)]
|
||||
.confirm configure -text "File \"$fname\" has changed.\nSave changes?"
|
||||
if {[.confirm activate]} {
|
||||
file_save $win
|
||||
}
|
||||
}
|
||||
$win.text delete 1.0 end
|
||||
set FileChanged($win) 0
|
||||
}
|
||||
}
|
||||
|
||||
@@ -169,11 +169,11 @@ proc split_view {} {
|
||||
set FileChanged($win) 0
|
||||
|
||||
iwidgets::scrolledtext $win.text -wrap none -labeltext "file: $FileName($win)" \
|
||||
-hscrollmode none -vscrollmode dynamic -visibleitems 1x1
|
||||
-hscrollmode none -vscrollmode dynamic -visibleitems 1x1
|
||||
pack $win.text -expand yes -fill both
|
||||
|
||||
bind [$win.text component text] <KeyPress> "
|
||||
set FileChanged($win) 1
|
||||
set FileChanged($win) 1
|
||||
"
|
||||
}
|
||||
|
||||
|
||||
+1
-1
@@ -48,7 +48,7 @@ inherits from \fBArchetype\fR, but adds a Tk toplevel which acts
|
||||
as the "hull".
|
||||
.PP
|
||||
\fIEach derived class must invoke the \fBitk_initialize\fP method
|
||||
within its constructor, so that all options are properly
|
||||
within its constructor\fR, so that all options are properly
|
||||
integrated and initialized in the composite list.
|
||||
|
||||
|
||||
|
||||
+2
-2
@@ -28,9 +28,9 @@ or from a compiled-in value otherwise.
|
||||
.sp
|
||||
When \fB[incr\ Tk]\fR is added to an interpreter, it executes
|
||||
the script "\fCinit.itk\fR" in this directory. This script,
|
||||
in turn, looks for other script files with the name "\fCinit.\fR\fIxxx\fR".
|
||||
in turn, looks for other script files with the name "\fCinit.\fIxxx\fR".
|
||||
Mega-widget libraries will be automatically initialized if they
|
||||
install a script named "\fCinit.\fR\fIxxx\fR" in this directory,
|
||||
install a script named "\fCinit.\fIxxx\fR" in this directory,
|
||||
where "\fIxxx\fR" is the name of the mega-widget library.
|
||||
For example, the \fB[incr\ Widgets]\fR library installs
|
||||
the script "\fCinit.iwidgets\fR" in this directory.
|
||||
|
||||
+27
-27
@@ -13,42 +13,42 @@ class Info {
|
||||
inherit itk::Toplevel
|
||||
|
||||
constructor {args} {
|
||||
itk_component add dismiss {
|
||||
button $itk_interior.dismiss -text "Dismiss" \
|
||||
-command "destroy $itk_component(hull)"
|
||||
}
|
||||
pack $itk_component(dismiss) -side bottom -pady 4
|
||||
itk_component add dismiss {
|
||||
button $itk_interior.dismiss -text "Dismiss" \
|
||||
-command "destroy $itk_component(hull)"
|
||||
}
|
||||
pack $itk_component(dismiss) -side bottom -pady 4
|
||||
|
||||
itk_component add separator {
|
||||
frame $itk_interior.sep -height 2 -borderwidth 1 -relief sunken
|
||||
}
|
||||
pack $itk_component(separator) -side bottom -fill x -padx 4
|
||||
itk_component add separator {
|
||||
frame $itk_interior.sep -height 2 -borderwidth 1 -relief sunken
|
||||
}
|
||||
pack $itk_component(separator) -side bottom -fill x -padx 4
|
||||
|
||||
itk_component add icon {
|
||||
label $itk_interior.icon -bitmap info
|
||||
}
|
||||
pack $itk_component(icon) -side left -padx 8 -pady 8
|
||||
itk_component add icon {
|
||||
label $itk_interior.icon -bitmap info
|
||||
}
|
||||
pack $itk_component(icon) -side left -padx 8 -pady 8
|
||||
|
||||
itk_component add infoFrame {
|
||||
frame $itk_interior.info
|
||||
}
|
||||
pack $itk_component(infoFrame) -side left -expand yes \
|
||||
-fill both -padx 4 -pady 4
|
||||
itk_component add infoFrame {
|
||||
frame $itk_interior.info
|
||||
}
|
||||
pack $itk_component(infoFrame) -side left -expand yes \
|
||||
-fill both -padx 4 -pady 4
|
||||
|
||||
set itk_interior $itk_component(infoFrame)
|
||||
set itk_interior $itk_component(infoFrame)
|
||||
|
||||
eval itk_initialize $args
|
||||
eval itk_initialize $args
|
||||
|
||||
after idle [code $this centerOnScreen]
|
||||
after idle [code $this centerOnScreen]
|
||||
}
|
||||
|
||||
protected method centerOnScreen {} {
|
||||
update idletasks
|
||||
set wd [winfo reqwidth $itk_component(hull)]
|
||||
set ht [winfo reqheight $itk_component(hull)]
|
||||
set x [expr ([winfo screenwidth $itk_component(hull)]-$wd)/2]
|
||||
set y [expr ([winfo screenheight $itk_component(hull)]-$ht)/2]
|
||||
wm geometry $itk_component(hull) +$x+$y
|
||||
update idletasks
|
||||
set wd [winfo reqwidth $itk_component(hull)]
|
||||
set ht [winfo reqheight $itk_component(hull)]
|
||||
set x [expr ([winfo screenwidth $itk_component(hull)]-$wd)/2]
|
||||
set y [expr ([winfo screenheight $itk_component(hull)]-$ht)/2]
|
||||
wm geometry $itk_component(hull) +$x+$y
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
+13
-13
@@ -13,23 +13,23 @@ class MessageInfo {
|
||||
inherit Info
|
||||
|
||||
constructor {args} {
|
||||
itk_component add message {
|
||||
label $itk_interior.mesg -width 20
|
||||
} {
|
||||
usual
|
||||
rename -text -message message Text
|
||||
}
|
||||
pack $itk_component(message) -expand yes -fill both
|
||||
bind $itk_component(message) <Configure> [code $this resize]
|
||||
itk_component add message {
|
||||
label $itk_interior.mesg -width 20
|
||||
} {
|
||||
usual
|
||||
rename -text -message message Text
|
||||
}
|
||||
pack $itk_component(message) -expand yes -fill both
|
||||
bind $itk_component(message) <Configure> [code $this resize]
|
||||
|
||||
eval itk_initialize $args
|
||||
eval itk_initialize $args
|
||||
}
|
||||
|
||||
private method resize {} {
|
||||
set w [winfo width $itk_component(message)]
|
||||
if {$w > 1} {
|
||||
$itk_component(message) configure -wraplength $w
|
||||
}
|
||||
set w [winfo width $itk_component(message)]
|
||||
if {$w > 1} {
|
||||
$itk_component(message) configure -wraplength $w
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
+54
-54
@@ -18,36 +18,36 @@ class TextDisplay {
|
||||
inherit itk::Widget
|
||||
|
||||
constructor {args} {
|
||||
itk_option add hull.width hull.height
|
||||
itk_option add hull.width hull.height
|
||||
|
||||
itk_component add text {
|
||||
text $itk_interior.info -state disabled -width 1 -height 1 \
|
||||
-yscrollcommand [code $itk_interior.sbar set]
|
||||
} {
|
||||
usual
|
||||
keep -wrap -tabs
|
||||
rename -background -textbackground textBackground Background
|
||||
}
|
||||
pack $itk_component(text) -side left -expand yes -fill both
|
||||
itk_component add text {
|
||||
text $itk_interior.info -state disabled -width 1 -height 1 \
|
||||
-yscrollcommand [code $itk_interior.sbar set]
|
||||
} {
|
||||
usual
|
||||
keep -wrap -tabs
|
||||
rename -background -textbackground textBackground Background
|
||||
}
|
||||
pack $itk_component(text) -side left -expand yes -fill both
|
||||
|
||||
itk_component add scrollbar {
|
||||
scrollbar $itk_interior.sbar \
|
||||
-command [code $itk_interior.info yview]
|
||||
}
|
||||
pack $itk_component(scrollbar) -side right -fill y
|
||||
itk_component add scrollbar {
|
||||
scrollbar $itk_interior.sbar \
|
||||
-command [code $itk_interior.info yview]
|
||||
}
|
||||
pack $itk_component(scrollbar) -side right -fill y
|
||||
|
||||
eval itk_initialize $args
|
||||
eval itk_initialize $args
|
||||
|
||||
pack propagate $itk_component(hull) 0
|
||||
pack propagate $itk_component(hull) 0
|
||||
|
||||
fixScrollbar
|
||||
bind $itk_component(text) <Configure> [code $this fixScrollbar]
|
||||
fixScrollbar
|
||||
bind $itk_component(text) <Configure> [code $this fixScrollbar]
|
||||
|
||||
$itk_component(text) tag configure bold \
|
||||
-font -*-courier-bold-r-normal--*-120-*
|
||||
$itk_component(text) tag configure bold \
|
||||
-font -*-courier-bold-r-normal--*-120-*
|
||||
|
||||
$itk_component(text) tag configure italic \
|
||||
-font -*-courier-medium-o-normal--*-120-*
|
||||
$itk_component(text) tag configure italic \
|
||||
-font -*-courier-medium-o-normal--*-120-*
|
||||
}
|
||||
|
||||
public method display {info}
|
||||
@@ -55,14 +55,14 @@ class TextDisplay {
|
||||
public method substitute {word newword}
|
||||
|
||||
itk_option define -scrollbar scrollbar Scrollbar "on" {
|
||||
switch -- $itk_option(-scrollbar) {
|
||||
on - off - auto {
|
||||
fixScrollbar
|
||||
}
|
||||
default {
|
||||
error "bad value \"$itk_option(-scollbar)\""
|
||||
}
|
||||
}
|
||||
switch -- $itk_option(-scrollbar) {
|
||||
on - off - auto {
|
||||
fixScrollbar
|
||||
}
|
||||
default {
|
||||
error "bad value \"$itk_option(-scollbar)\""
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
protected method fixScrollbar {}
|
||||
@@ -89,13 +89,13 @@ body TextDisplay::substitute {word newword} {
|
||||
|
||||
set index 1.0
|
||||
while {1} {
|
||||
set index [$itk_component(text) search -count len $word $index]
|
||||
if {$index != ""} {
|
||||
$itk_component(text) delete $index "$index + $len chars"
|
||||
$itk_component(text) insert $index $newword
|
||||
} else {
|
||||
break
|
||||
}
|
||||
set index [$itk_component(text) search -count len $word $index]
|
||||
if {$index != ""} {
|
||||
$itk_component(text) delete $index "$index + $len chars"
|
||||
$itk_component(text) insert $index $newword
|
||||
} else {
|
||||
break
|
||||
}
|
||||
}
|
||||
$itk_component(text) configure -state disabled
|
||||
fixScrollbar
|
||||
@@ -103,25 +103,25 @@ body TextDisplay::substitute {word newword} {
|
||||
|
||||
body TextDisplay::fixScrollbar {} {
|
||||
switch $itk_option(-scrollbar) {
|
||||
on { set sbstate 1 }
|
||||
off { set sbstate 0 }
|
||||
on { set sbstate 1 }
|
||||
off { set sbstate 0 }
|
||||
|
||||
auto {
|
||||
if {[$itk_component(text) bbox 1.0] == "" ||
|
||||
[$itk_component(text) bbox end-1char] == ""} {
|
||||
set sbstate 1
|
||||
} else {
|
||||
set sbstate 0
|
||||
}
|
||||
}
|
||||
auto {
|
||||
if {[$itk_component(text) bbox 1.0] == "" ||
|
||||
[$itk_component(text) bbox end-1char] == ""} {
|
||||
set sbstate 1
|
||||
} else {
|
||||
set sbstate 0
|
||||
}
|
||||
}
|
||||
}
|
||||
if {$sbstate != $sbvisible} {
|
||||
if {$sbstate} {
|
||||
pack $itk_component(scrollbar) -side right -fill y
|
||||
} else {
|
||||
pack forget $itk_component(scrollbar)
|
||||
}
|
||||
set sbvisible $sbstate
|
||||
if {$sbstate} {
|
||||
pack $itk_component(scrollbar) -side right -fill y
|
||||
} else {
|
||||
pack forget $itk_component(scrollbar)
|
||||
}
|
||||
set sbvisible $sbstate
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
+11
-11
@@ -13,24 +13,24 @@ class TextInfo {
|
||||
inherit Info
|
||||
|
||||
constructor {args} {
|
||||
itk_component add textArea {
|
||||
TextDisplay $itk_interior.txt -scrollbar auto
|
||||
} {
|
||||
usual
|
||||
keep -wrap -tabs
|
||||
rename -font -textfont textFont Font
|
||||
}
|
||||
pack $itk_component(textArea) -expand yes -fill both
|
||||
itk_component add textArea {
|
||||
TextDisplay $itk_interior.txt -scrollbar auto
|
||||
} {
|
||||
usual
|
||||
keep -wrap -tabs
|
||||
rename -font -textfont textFont Font
|
||||
}
|
||||
pack $itk_component(textArea) -expand yes -fill both
|
||||
|
||||
eval itk_initialize $args
|
||||
eval itk_initialize $args
|
||||
}
|
||||
|
||||
public method display {args} {
|
||||
eval $itk_component(textArea) display $args
|
||||
eval $itk_component(textArea) display $args
|
||||
}
|
||||
|
||||
public method append {args} {
|
||||
eval $itk_component(textArea) append $args
|
||||
eval $itk_component(textArea) append $args
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
+6
-6
@@ -31,14 +31,14 @@ bind .file <KeyPress-Return> {show_file [.file get]}
|
||||
|
||||
proc show_file {file} {
|
||||
set cmd {
|
||||
set fid [open $file r]
|
||||
set info [read $fid]
|
||||
close $fid
|
||||
set fid [open $file r]
|
||||
set info [read $fid]
|
||||
close $fid
|
||||
}
|
||||
if {[catch $cmd] == 0} {
|
||||
set win [TextInfo .#auto -wrap none]
|
||||
$win display $info
|
||||
set win [TextInfo .#auto -wrap none]
|
||||
$win display $info
|
||||
} else {
|
||||
MessageInfo .#auto -message "Cannot read file:\n$file"
|
||||
MessageInfo .#auto -message "Cannot read file:\n$file"
|
||||
}
|
||||
}
|
||||
|
||||
+26
-26
@@ -26,10 +26,10 @@ scspec ITKAPI
|
||||
#
|
||||
|
||||
declare 0 {
|
||||
int Itk_Init(Tcl_Interp *interp)
|
||||
int Itk_Init (Tcl_Interp *interp)
|
||||
}
|
||||
declare 1 {
|
||||
int Itk_SafeInit(Tcl_Interp *interp)
|
||||
int Itk_SafeInit (Tcl_Interp *interp)
|
||||
}
|
||||
|
||||
|
||||
@@ -38,7 +38,7 @@ declare 1 {
|
||||
#
|
||||
|
||||
declare 13 {
|
||||
int Itk_ArchetypeInit(Tcl_Interp *interp)
|
||||
int Itk_ArchetypeInit (Tcl_Interp* interp)
|
||||
}
|
||||
|
||||
|
||||
@@ -55,12 +55,12 @@ interface itkInt
|
||||
#
|
||||
|
||||
declare 2 {
|
||||
int Itk_ConfigBodyCmd(void *cdata, Tcl_Interp *interp,
|
||||
int objc, Tcl_Obj *const objv[])
|
||||
int Itk_ConfigBodyCmd (ClientData cdata, Tcl_Interp *interp, \
|
||||
int objc, Tcl_Obj *const objv[])
|
||||
}
|
||||
declare 3 {
|
||||
int Itk_UsualCmd(void *cdata, Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const objv[])
|
||||
int Itk_UsualCmd (ClientData cdata, Tcl_Interp *interp, int objc, \
|
||||
Tcl_Obj *const objv[])
|
||||
}
|
||||
|
||||
#
|
||||
@@ -68,37 +68,37 @@ declare 3 {
|
||||
#
|
||||
|
||||
declare 4 {
|
||||
int Itk_ClassOptionDefineCmd(void *cdata, Tcl_Interp *interp,
|
||||
int objc, Tcl_Obj *const objv[])
|
||||
int Itk_ClassOptionDefineCmd (ClientData cdata, Tcl_Interp *interp, \
|
||||
int objc, Tcl_Obj *const objv[])
|
||||
}
|
||||
declare 5 {
|
||||
int Itk_ClassOptionIllegalCmd(void *cdata, Tcl_Interp *interp, \
|
||||
int objc, Tcl_Obj *const objv[])
|
||||
int Itk_ClassOptionIllegalCmd (ClientData cdata, Tcl_Interp *interp, \
|
||||
int objc, Tcl_Obj *const objv[])
|
||||
}
|
||||
declare 6 {
|
||||
int Itk_ConfigClassOption(Tcl_Interp *interp, ItclObject *contextObj, \
|
||||
void *cdata, const char *newVal)
|
||||
int Itk_ConfigClassOption (Tcl_Interp *interp, ItclObject *contextObj, \
|
||||
ClientData cdata, const char* newVal)
|
||||
}
|
||||
declare 7 {
|
||||
ItkClassOptTable* Itk_CreateClassOptTable(Tcl_Interp *interp, \
|
||||
ItclClass *cdefn)
|
||||
ItkClassOptTable* Itk_CreateClassOptTable( Tcl_Interp *interp, \
|
||||
ItclClass *cdefn)
|
||||
}
|
||||
declare 8 {
|
||||
ItkClassOptTable* Itk_FindClassOptTable(ItclClass *cdefn)
|
||||
ItkClassOptTable* Itk_FindClassOptTable (ItclClass *cdefn)
|
||||
}
|
||||
#declare 9 {
|
||||
# void Itk_DeleteClassOptTable(Tcl_Interp *interp, ItclClass *cdefn)
|
||||
# void Itk_DeleteClassOptTable (Tcl_Interp *interp, ItclClass *cdefn)
|
||||
#}
|
||||
declare 10 {
|
||||
int Itk_CreateClassOption(Tcl_Interp *interp, ItclClass *cdefn,
|
||||
const char *switchName, const char *resName, const char *resClass, const char *defVal,
|
||||
const char *config, ItkClassOption **optPtr)
|
||||
int Itk_CreateClassOption (Tcl_Interp *interp, ItclClass *cdefn, \
|
||||
char *switchName, char *resName, char *resClass, char *defVal, \
|
||||
char *config, ItkClassOption **optPtr)
|
||||
}
|
||||
declare 11 {
|
||||
ItkClassOption* Itk_FindClassOption(ItclClass *cdefn, const char *switchName)
|
||||
ItkClassOption* Itk_FindClassOption (ItclClass *cdefn, const char *switchName)
|
||||
}
|
||||
declare 12 {
|
||||
void Itk_DelClassOption(ItkClassOption *opt)
|
||||
void Itk_DelClassOption (ItkClassOption *opt)
|
||||
}
|
||||
|
||||
#
|
||||
@@ -106,16 +106,16 @@ declare 12 {
|
||||
#
|
||||
|
||||
declare 14 {
|
||||
void Itk_OptListInit(ItkOptList *olist, Tcl_HashTable *options)
|
||||
void Itk_OptListInit (ItkOptList* olist, Tcl_HashTable *options)
|
||||
}
|
||||
declare 15 {
|
||||
void Itk_OptListFree(ItkOptList *olist)
|
||||
void Itk_OptListFree (ItkOptList* olist)
|
||||
}
|
||||
declare 16 {
|
||||
void Itk_OptListAdd(ItkOptList *olist, Tcl_HashEntry *entry)
|
||||
void Itk_OptListAdd (ItkOptList* olist, Tcl_HashEntry *entry)
|
||||
}
|
||||
declare 17 {
|
||||
void Itk_OptListRemove(ItkOptList *olist, Tcl_HashEntry *entry)
|
||||
void Itk_OptListRemove (ItkOptList* olist, Tcl_HashEntry *entry)
|
||||
}
|
||||
|
||||
|
||||
|
||||
+13
-2
@@ -54,13 +54,24 @@
|
||||
# define ITKAPI DLLIMPORT
|
||||
#endif
|
||||
|
||||
#ifndef TCL_ALPHA_RELEASE
|
||||
# define TCL_ALPHA_RELEASE 0
|
||||
#endif
|
||||
#ifndef TCL_BETA_RELEASE
|
||||
# define TCL_BETA_RELEASE 1
|
||||
#endif
|
||||
#ifndef TCL_FINAL_RELEASE
|
||||
# define TCL_FINAL_RELEASE 2
|
||||
#endif
|
||||
|
||||
|
||||
#define ITK_MAJOR_VERSION 4
|
||||
#define ITK_MINOR_VERSION 2
|
||||
#define ITK_RELEASE_LEVEL TCL_FINAL_RELEASE
|
||||
#define ITK_RELEASE_SERIAL 7
|
||||
#define ITK_RELEASE_SERIAL 3
|
||||
|
||||
#define ITK_VERSION "4.2"
|
||||
#define ITK_PATCH_LEVEL "4.2.7"
|
||||
#define ITK_PATCH_LEVEL "4.2.3"
|
||||
|
||||
|
||||
/*
|
||||
|
||||
+897
-888
File diff suppressed because it is too large
Load Diff
+459
-410
File diff suppressed because it is too large
Load Diff
+71
-71
@@ -53,45 +53,45 @@ static int Initialize (Tcl_Interp *interp);
|
||||
static char initScript[] = "\n\
|
||||
namespace eval ::itk {\n\
|
||||
proc _find_init {} {\n\
|
||||
global env tcl_library\n\
|
||||
variable library\n\
|
||||
variable patchLevel\n\
|
||||
rename _find_init {}\n\
|
||||
if {[info exists library]} {\n\
|
||||
lappend dirs $library\n\
|
||||
} else {\n\
|
||||
set dirs {}\n\
|
||||
if {[info exists env(ITK_LIBRARY)]} {\n\
|
||||
lappend dirs $env(ITK_LIBRARY)\n\
|
||||
}\n\
|
||||
lappend dirs [file join [file dirname $tcl_library] itk$patchLevel]\n\
|
||||
set bindir [file dirname [info nameofexecutable]]\n\
|
||||
lappend dirs [file join $bindir .. lib itk$patchLevel]\n\
|
||||
lappend dirs [file join $bindir .. library]\n\
|
||||
lappend dirs [file join $bindir .. .. library]\n\
|
||||
lappend dirs [file join $bindir .. .. itk library]\n\
|
||||
# On MacOSX, check the directories in the tcl_pkgPath\n\
|
||||
if {[string equal $::tcl_platform(platform) \"unix\"] && \
|
||||
[string equal $::tcl_platform(os) \"Darwin\"]} {\n\
|
||||
foreach d $::tcl_pkgPath {\n\
|
||||
lappend dirs [file join $d itk$patchLevel]\n\
|
||||
}\n\
|
||||
}\n\
|
||||
}\n\
|
||||
foreach i $dirs {\n\
|
||||
set library $i\n\
|
||||
set itkfile [file join $i itk.tcl]\n\
|
||||
if {![catch {uplevel #0 [list source $itkfile]} msg]} {\n\
|
||||
return\n\
|
||||
}\n\
|
||||
}\n\
|
||||
set msg \"Can't find a usable itk.tcl in the following directories:\n\"\n\
|
||||
append msg \" $dirs\n\"\n\
|
||||
append msg \"This probably means that Itcl/Itk weren't installed properly.\n\"\n\
|
||||
append msg \"If you know where the Itk library directory was installed,\n\"\n\
|
||||
append msg \"you can set the environment variable ITK_LIBRARY to point\n\"\n\
|
||||
append msg \"to the library directory.\n\"\n\
|
||||
error $msg\n\
|
||||
global env tcl_library\n\
|
||||
variable library\n\
|
||||
variable patchLevel\n\
|
||||
rename _find_init {}\n\
|
||||
if {[info exists library]} {\n\
|
||||
lappend dirs $library\n\
|
||||
} else {\n\
|
||||
set dirs {}\n\
|
||||
if {[info exists env(ITK_LIBRARY)]} {\n\
|
||||
lappend dirs $env(ITK_LIBRARY)\n\
|
||||
}\n\
|
||||
lappend dirs [file join [file dirname $tcl_library] itk$patchLevel]\n\
|
||||
set bindir [file dirname [info nameofexecutable]]\n\
|
||||
lappend dirs [file join $bindir .. lib itk$patchLevel]\n\
|
||||
lappend dirs [file join $bindir .. library]\n\
|
||||
lappend dirs [file join $bindir .. .. library]\n\
|
||||
lappend dirs [file join $bindir .. .. itk library]\n\
|
||||
# On MacOSX, check the directories in the tcl_pkgPath\n\
|
||||
if {[string equal $::tcl_platform(platform) \"unix\"] && \
|
||||
[string equal $::tcl_platform(os) \"Darwin\"]} {\n\
|
||||
foreach d $::tcl_pkgPath {\n\
|
||||
lappend dirs [file join $d itk$patchLevel]\n\
|
||||
}\n\
|
||||
}\n\
|
||||
}\n\
|
||||
foreach i $dirs {\n\
|
||||
set library $i\n\
|
||||
set itkfile [file join $i itk.tcl]\n\
|
||||
if {![catch {uplevel #0 [list source $itkfile]} msg]} {\n\
|
||||
return\n\
|
||||
}\n\
|
||||
}\n\
|
||||
set msg \"Can't find a usable itk.tcl in the following directories:\n\"\n\
|
||||
append msg \" $dirs\n\"\n\
|
||||
append msg \"This probably means that Itcl/Itk weren't installed properly.\n\"\n\
|
||||
append msg \"If you know where the Itk library directory was installed,\n\"\n\
|
||||
append msg \"you can set the environment variable ITK_LIBRARY to point\n\"\n\
|
||||
append msg \"to the library directory.\n\"\n\
|
||||
error $msg\n\
|
||||
}\n\
|
||||
_find_init\n\
|
||||
}";
|
||||
@@ -120,13 +120,13 @@ Initialize(
|
||||
Tcl_Interp *interp) /* interpreter to be updated */
|
||||
{
|
||||
Tcl_Namespace *itkNs, *parserNs;
|
||||
void *parserInfo;
|
||||
ClientData parserInfo;
|
||||
Tcl_CmdInfo info;
|
||||
|
||||
if (Tcl_InitStubs(interp, "8.6-", 0) == NULL) {
|
||||
if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (Tk_InitStubs(interp, "8.6-", 0) == NULL) {
|
||||
if (Tk_InitStubs(interp, TK_VERSION, 0) == NULL) {
|
||||
return TCL_ERROR;
|
||||
};
|
||||
if (Itcl_InitStubs(interp, "4.1", 0) == NULL) {
|
||||
@@ -137,47 +137,47 @@ Initialize(
|
||||
* Add the "itk_option" ensemble to the itcl class definition parser.
|
||||
*/
|
||||
parserNs = Tcl_FindNamespace(interp, "::itcl::parser",
|
||||
(Tcl_Namespace*)NULL, /* flags */ 0);
|
||||
(Tcl_Namespace*)NULL, /* flags */ 0);
|
||||
|
||||
if (!parserNs) {
|
||||
Tcl_AppendResult(interp,
|
||||
"cannot initialize [incr Tk]: [incr Tcl] has not been installed\n",
|
||||
"Make sure that Itcl_Init() is called before Itk_Init()",
|
||||
(char*)NULL);
|
||||
return TCL_ERROR;
|
||||
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
||||
"cannot initialize [incr Tk]: [incr Tcl] has not been installed\n",
|
||||
"Make sure that Itcl_Init() is called before Itk_Init()",
|
||||
(char*)NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
parserInfo = parserNs->clientData;
|
||||
|
||||
if (Itcl_CreateEnsemble(interp, "::itcl::parser::itk_option") != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (Itcl_AddEnsemblePart(interp, "::itcl::parser::itk_option",
|
||||
"define", "-switch resourceName resourceClass init ?config?",
|
||||
Itk_ClassOptionDefineCmd,
|
||||
parserInfo, Itcl_ReleaseData) != TCL_OK) {
|
||||
"define", "-switch resourceName resourceClass init ?config?",
|
||||
Itk_ClassOptionDefineCmd,
|
||||
parserInfo, Itcl_ReleaseData) != TCL_OK) {
|
||||
|
||||
return TCL_ERROR;
|
||||
return TCL_ERROR;
|
||||
}
|
||||
Itcl_PreserveData(parserInfo);
|
||||
|
||||
if (Itcl_AddEnsemblePart(interp, "::itcl::parser::itk_option",
|
||||
"add", "name ?name name...?",
|
||||
Itk_ClassOptionIllegalCmd,
|
||||
(void *)NULL, (Tcl_CmdDeleteProc*)NULL) != TCL_OK ||
|
||||
"add", "name ?name name...?",
|
||||
Itk_ClassOptionIllegalCmd,
|
||||
(ClientData)NULL, (Tcl_CmdDeleteProc*)NULL) != TCL_OK ||
|
||||
|
||||
Itcl_AddEnsemblePart(interp, "::itcl::parser::itk_option",
|
||||
"remove", "name ?name name...?",
|
||||
Itk_ClassOptionIllegalCmd,
|
||||
(void *)NULL, (Tcl_CmdDeleteProc*)NULL) != TCL_OK) {
|
||||
Itcl_AddEnsemblePart(interp, "::itcl::parser::itk_option",
|
||||
"remove", "name ?name name...?",
|
||||
Itk_ClassOptionIllegalCmd,
|
||||
(ClientData)NULL, (Tcl_CmdDeleteProc*)NULL) != TCL_OK) {
|
||||
|
||||
return TCL_ERROR;
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* Install [incr Tk] facilities if not already installed.
|
||||
*/
|
||||
itkNs = Tcl_FindNamespace(interp, "::itk", (Tcl_Namespace*)NULL,
|
||||
/* flags */ 0);
|
||||
/* flags */ 0);
|
||||
|
||||
if (itkNs == NULL) {
|
||||
/*
|
||||
@@ -186,19 +186,19 @@ Initialize(
|
||||
* such as "namespace import itk::*"
|
||||
*/
|
||||
itkNs = Tcl_CreateNamespace(interp, "::itk",
|
||||
(void *)NULL, (Tcl_NamespaceDeleteProc*)NULL);
|
||||
(ClientData)NULL, (Tcl_NamespaceDeleteProc*)NULL);
|
||||
}
|
||||
|
||||
if (!itkNs ||
|
||||
Tcl_Export(interp, itkNs, "*", /* resetListFirst */ 1) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
Tcl_Export(interp, itkNs, "*", /* resetListFirst */ 1) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* Setup things for itk::Archetype base class.
|
||||
*/
|
||||
if (Itk_ArchetypeInit(interp) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -206,11 +206,11 @@ Initialize(
|
||||
* options.
|
||||
*/
|
||||
Tcl_CreateObjCommand(interp, "::itcl::configbody", Itk_ConfigBodyCmd,
|
||||
(void *)NULL, (Tcl_CmdDeleteProc*)NULL);
|
||||
(ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);
|
||||
|
||||
Tcl_SetVar(interp, "::itk::version", ITK_VERSION, TCL_NAMESPACE_ONLY);
|
||||
Tcl_SetVar(interp, "::itk::patchLevel", ITK_PATCH_LEVEL,
|
||||
TCL_NAMESPACE_ONLY);
|
||||
TCL_NAMESPACE_ONLY);
|
||||
|
||||
/*
|
||||
* Signal that the package has been loaded and provide the Itk Stubs table
|
||||
@@ -274,9 +274,9 @@ Initialize(
|
||||
#endif
|
||||
), NULL);
|
||||
}
|
||||
Tcl_PkgProvideEx(interp, "Itk", ITK_PATCH_LEVEL, (void *) &itkStubs);
|
||||
Tcl_PkgProvideEx(interp, "Itk", ITK_PATCH_LEVEL, (ClientData) &itkStubs);
|
||||
return Tcl_PkgProvideEx(interp, "itk", ITK_PATCH_LEVEL,
|
||||
(void *) &itkStubs);
|
||||
(ClientData) &itkStubs);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -323,7 +323,7 @@ Itk_SafeInit(
|
||||
Tcl_Interp *interp) /* interpreter to be updated */
|
||||
{
|
||||
if (Initialize(interp) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
return TCL_ERROR;
|
||||
}
|
||||
return Tcl_EvalEx(interp, safeInitScript, -1, 0);
|
||||
}
|
||||
|
||||
+29
-28
@@ -45,9 +45,10 @@
|
||||
* Returns TCL_OK/TCL_ERROR to indicate success/failure.
|
||||
* ------------------------------------------------------------------------
|
||||
*/
|
||||
/* ARGSUSED */
|
||||
int
|
||||
Itk_ConfigBodyCmd(
|
||||
void *dummy, /* unused */
|
||||
ClientData dummy, /* unused */
|
||||
Tcl_Interp *interp, /* current interpreter */
|
||||
int objc, /* number of arguments */
|
||||
Tcl_Obj *const objv[]) /* argument objects */
|
||||
@@ -65,8 +66,8 @@ Itk_ConfigBodyCmd(
|
||||
Tcl_DString buffer;
|
||||
|
||||
if (objc != 3) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "class::option body");
|
||||
return TCL_ERROR;
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "class::option body");
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -78,17 +79,17 @@ Itk_ConfigBodyCmd(
|
||||
Itcl_ParseNamespPath(token, &buffer, &head, &tail);
|
||||
|
||||
if (!head || *head == '\0') {
|
||||
Tcl_AppendResult(interp,
|
||||
"missing class specifier for body declaration \"", token, "\"",
|
||||
(char*)NULL);
|
||||
result = TCL_ERROR;
|
||||
goto configBodyCmdDone;
|
||||
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
||||
"missing class specifier for body declaration \"", token, "\"",
|
||||
(char*)NULL);
|
||||
result = TCL_ERROR;
|
||||
goto configBodyCmdDone;
|
||||
}
|
||||
|
||||
iclsPtr = Itcl_FindClass(interp, head, /* autoload */ 1);
|
||||
if (iclsPtr == NULL) {
|
||||
result = TCL_ERROR;
|
||||
goto configBodyCmdDone;
|
||||
result = TCL_ERROR;
|
||||
goto configBodyCmdDone;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -101,23 +102,23 @@ Itk_ConfigBodyCmd(
|
||||
opt = NULL;
|
||||
|
||||
if (optTable) {
|
||||
Tcl_DString optName;
|
||||
Tcl_DString optName;
|
||||
|
||||
Tcl_DStringInit(&optName);
|
||||
Tcl_DStringAppend(&optName, "-", -1);
|
||||
Tcl_DStringAppend(&optName, tail, -1);
|
||||
entry = Tcl_FindHashEntry(&optTable->options,
|
||||
Tcl_DStringValue(&optName));
|
||||
Tcl_DStringInit(&optName);
|
||||
Tcl_DStringAppend(&optName, "-", -1);
|
||||
Tcl_DStringAppend(&optName, tail, -1);
|
||||
entry = Tcl_FindHashEntry(&optTable->options,
|
||||
Tcl_DStringValue(&optName));
|
||||
|
||||
if (entry) {
|
||||
opt = (ItkClassOption*)Tcl_GetHashValue(entry);
|
||||
}
|
||||
Tcl_DStringFree(&optName);
|
||||
if (entry) {
|
||||
opt = (ItkClassOption*)Tcl_GetHashValue(entry);
|
||||
}
|
||||
Tcl_DStringFree(&optName);
|
||||
}
|
||||
|
||||
if (opt == NULL) {
|
||||
result = Itcl_ConfigBodyCmd(dummy, interp, objc, objv);
|
||||
goto configBodyCmdDone;
|
||||
result = Itcl_ConfigBodyCmd(dummy, interp, objc, objv);
|
||||
goto configBodyCmdDone;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -126,19 +127,19 @@ Itk_ConfigBodyCmd(
|
||||
token = Tcl_GetString(objv[2]);
|
||||
|
||||
if (Itcl_CreateMemberCode(interp, iclsPtr, (char*)NULL, token,
|
||||
&mcode) != TCL_OK) {
|
||||
&mcode) != TCL_OK) {
|
||||
|
||||
result = TCL_ERROR;
|
||||
goto configBodyCmdDone;
|
||||
result = TCL_ERROR;
|
||||
goto configBodyCmdDone;
|
||||
}
|
||||
|
||||
Itcl_PreserveData((void *)mcode);
|
||||
Itcl_PreserveData((ClientData)mcode);
|
||||
#ifdef NOTDEF
|
||||
Itcl_EventuallyFree((void *)mcode, (Tcl_FreeProc *)Itcl_DeleteMemberCode);
|
||||
Itcl_EventuallyFree((ClientData)mcode, (Tcl_FreeProc *)Itcl_DeleteMemberCode);
|
||||
#endif
|
||||
|
||||
if (opt->codePtr) {
|
||||
Itcl_ReleaseData((void *)opt->codePtr);
|
||||
Itcl_ReleaseData((ClientData)opt->codePtr);
|
||||
}
|
||||
opt->codePtr = mcode;
|
||||
|
||||
|
||||
+2
-2
@@ -28,7 +28,7 @@ ITKAPI int Itk_SafeInit(Tcl_Interp *interp);
|
||||
/* Slot 11 is reserved */
|
||||
/* Slot 12 is reserved */
|
||||
/* 13 */
|
||||
ITKAPI int Itk_ArchetypeInit(Tcl_Interp *interp);
|
||||
ITKAPI int Itk_ArchetypeInit(Tcl_Interp*interp);
|
||||
|
||||
typedef struct {
|
||||
const struct ItkIntStubs *itkIntStubs;
|
||||
@@ -53,7 +53,7 @@ typedef struct ItkStubs {
|
||||
void (*reserved10)(void);
|
||||
void (*reserved11)(void);
|
||||
void (*reserved12)(void);
|
||||
int (*itk_ArchetypeInit) (Tcl_Interp *interp); /* 13 */
|
||||
int (*itk_ArchetypeInit) (Tcl_Interp*interp); /* 13 */
|
||||
} ItkStubs;
|
||||
|
||||
extern const ItkStubs *itkStubsPtr;
|
||||
|
||||
+31
-31
@@ -50,11 +50,11 @@ Itk_ArchOptConfigError(
|
||||
Tcl_AppendToObj(objPtr, "\"", -1);
|
||||
|
||||
if (info->itclObj && info->itclObj->accessCmd) {
|
||||
Tcl_AppendToObj(objPtr, " for widget \"", -1);
|
||||
Tcl_GetCommandFullName(interp, info->itclObj->accessCmd, objPtr);
|
||||
Tcl_AppendToObj(objPtr, "\")", -1);
|
||||
Tcl_AppendToObj(objPtr, " for widget \"", -1);
|
||||
Tcl_GetCommandFullName(interp, info->itclObj->accessCmd, objPtr);
|
||||
Tcl_AppendToObj(objPtr, "\")", -1);
|
||||
}
|
||||
Tcl_AddErrorInfo(interp, Tcl_GetString(objPtr));
|
||||
Tcl_AddErrorInfo(interp, Tcl_GetStringFromObj(objPtr, (int*)NULL));
|
||||
Tcl_DecrRefCount(objPtr);
|
||||
}
|
||||
|
||||
@@ -76,15 +76,15 @@ Itk_ArchOptAccessError(
|
||||
{
|
||||
Tcl_ResetResult(interp);
|
||||
|
||||
Tcl_AppendResult(interp,
|
||||
"internal error: cannot access itk_option(", archOpt->switchName, ")",
|
||||
(char*)NULL);
|
||||
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
||||
"internal error: cannot access itk_option(", archOpt->switchName, ")",
|
||||
(char*)NULL);
|
||||
|
||||
if (info->itclObj->accessCmd) {
|
||||
Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
|
||||
Tcl_AppendToObj(resultPtr, " in widget \"", -1);
|
||||
Tcl_GetCommandFullName(interp, info->itclObj->accessCmd, resultPtr);
|
||||
Tcl_AppendToObj(resultPtr, "\"", -1);
|
||||
Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
|
||||
Tcl_AppendToObj(resultPtr, " in widget \"", -1);
|
||||
Tcl_GetCommandFullName(interp, info->itclObj->accessCmd, resultPtr);
|
||||
Tcl_AppendToObj(resultPtr, "\"", -1);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -115,17 +115,17 @@ Itk_GetArchInfo(
|
||||
entry = Tcl_FindHashEntry(objsWithArchInfo, (char*)contextObj);
|
||||
|
||||
if (!entry) {
|
||||
Tcl_AppendResult(interp,
|
||||
"internal error: no Archetype information for widget",
|
||||
(char*)NULL);
|
||||
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
||||
"internal error: no Archetype information for widget",
|
||||
(char*)NULL);
|
||||
|
||||
if (contextObj->accessCmd) {
|
||||
Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
|
||||
Tcl_AppendToObj(resultPtr, " \"", -1);
|
||||
Tcl_GetCommandFullName(interp, contextObj->accessCmd, resultPtr);
|
||||
Tcl_AppendToObj(resultPtr, "\"", -1);
|
||||
}
|
||||
return TCL_ERROR;
|
||||
if (contextObj->accessCmd) {
|
||||
Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
|
||||
Tcl_AppendToObj(resultPtr, " \"", -1);
|
||||
Tcl_GetCommandFullName(interp, contextObj->accessCmd, resultPtr);
|
||||
Tcl_AppendToObj(resultPtr, "\"", -1);
|
||||
}
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -155,13 +155,13 @@ ItkGetObjsWithArchInfo(
|
||||
* If the registration table does not yet exist, then create it.
|
||||
*/
|
||||
objTable = (Tcl_HashTable*)Tcl_GetAssocData(interp,
|
||||
"itk_objsWithArchInfo", (Tcl_InterpDeleteProc**)NULL);
|
||||
"itk_objsWithArchInfo", (Tcl_InterpDeleteProc**)NULL);
|
||||
|
||||
if (!objTable) {
|
||||
objTable = (Tcl_HashTable*)Tcl_Alloc(sizeof(Tcl_HashTable));
|
||||
Tcl_InitHashTable(objTable, TCL_ONE_WORD_KEYS);
|
||||
Tcl_SetAssocData(interp, "itk_objsWithArchInfo",
|
||||
ItkFreeObjsWithArchInfo, (void *)objTable);
|
||||
objTable = (Tcl_HashTable*)ckalloc(sizeof(Tcl_HashTable));
|
||||
Tcl_InitHashTable(objTable, TCL_ONE_WORD_KEYS);
|
||||
Tcl_SetAssocData(interp, "itk_objsWithArchInfo",
|
||||
ItkFreeObjsWithArchInfo, (ClientData)objTable);
|
||||
}
|
||||
return objTable;
|
||||
}
|
||||
@@ -176,8 +176,8 @@ ItkGetObjsWithArchInfo(
|
||||
*/
|
||||
void
|
||||
ItkFreeObjsWithArchInfo(
|
||||
void *clientData, /* associated data */
|
||||
TCL_UNUSED(Tcl_Interp *)) /* interpreter being freed */
|
||||
ClientData clientData, /* associated data */
|
||||
Tcl_Interp *interp) /* interpreter being freed */
|
||||
{
|
||||
Tcl_HashTable *tablePtr = (Tcl_HashTable*)clientData;
|
||||
Tcl_HashSearch place;
|
||||
@@ -185,11 +185,11 @@ ItkFreeObjsWithArchInfo(
|
||||
|
||||
entry = Tcl_FirstHashEntry(tablePtr, &place);
|
||||
while (entry) {
|
||||
Itk_DelArchInfo( Tcl_GetHashValue(entry) );
|
||||
entry = Tcl_NextHashEntry(&place);
|
||||
Itk_DelArchInfo( Tcl_GetHashValue(entry) );
|
||||
entry = Tcl_NextHashEntry(&place);
|
||||
}
|
||||
|
||||
Tcl_DeleteHashTable(tablePtr);
|
||||
Tcl_Free(tablePtr);
|
||||
ckfree((char*)tablePtr);
|
||||
}
|
||||
|
||||
|
||||
+46
-58
@@ -23,18 +23,6 @@
|
||||
#include <itclInt.h>
|
||||
#include "itk.h"
|
||||
|
||||
#if (TCL_MAJOR_VERSION == 8)
|
||||
#undef Tcl_Free
|
||||
#undef Tcl_Realloc
|
||||
#if defined(USE_TCL_STUBS)
|
||||
# define Tcl_Free(p) tclStubsPtr->tcl_Free((char *)(p))
|
||||
# define Tcl_Realloc(p,m) tclStubsPtr->tcl_Realloc((char *)(p),(m))
|
||||
#else
|
||||
# define Tcl_Free(p) Tcl_Free((char *)(p))
|
||||
# define Tcl_Realloc(p,m) Tcl_Realloc((char *)(p),(m))
|
||||
#endif
|
||||
#endif
|
||||
|
||||
/*
|
||||
* List of options in alphabetical order:
|
||||
*/
|
||||
@@ -93,10 +81,10 @@ typedef struct ArchComponent {
|
||||
Tcl_Command accessCmd; /* access command for component widget */
|
||||
Tk_Window tkwin; /* Tk window for this component widget */
|
||||
char *pathName; /* Tk path name for this component widget.
|
||||
We can't use the tkwin pointer after
|
||||
the window has been destroyed so we
|
||||
need to save a copy for use in
|
||||
Itk_ArchCompDeleteCmd() */
|
||||
We can't use the tkwin pointer after
|
||||
the window has been destroyed so we
|
||||
need to save a copy for use in
|
||||
Itk_ArchCompDeleteCmd() */
|
||||
} ArchComponent;
|
||||
|
||||
/*
|
||||
@@ -120,15 +108,15 @@ typedef struct ArchOption {
|
||||
* Various parts of a composite option in an Archetype mega-widget:
|
||||
*/
|
||||
typedef int (Itk_ConfigOptionPartProc) (Tcl_Interp *interp,
|
||||
ItclObject *contextObj, void *cdata, const char* newVal);
|
||||
ItclObject *contextObj, ClientData cdata, const char* newVal);
|
||||
|
||||
typedef struct ArchOptionPart {
|
||||
void *clientData; /* data associated with this part */
|
||||
ClientData clientData; /* data associated with this part */
|
||||
Itk_ConfigOptionPartProc *configProc; /* update when new vals arrive */
|
||||
Tcl_CmdDeleteProc *deleteProc; /* clean up after clientData */
|
||||
|
||||
void *from; /* token that indicates who
|
||||
* contributed this option part */
|
||||
ClientData from; /* token that indicates who
|
||||
* contributed this option part */
|
||||
} ArchOptionPart;
|
||||
|
||||
|
||||
@@ -138,12 +126,12 @@ typedef struct ArchOptionPart {
|
||||
*/
|
||||
typedef struct ArchMergeInfo {
|
||||
Tcl_HashTable usualCode; /* usual option handling code for the
|
||||
* various widget classes */
|
||||
* various widget classes */
|
||||
|
||||
ArchInfo *archInfo; /* internal option info for mega-widget */
|
||||
ArchComponent *archComp; /* component being merged into mega-widget */
|
||||
Tcl_HashTable *optionTable; /* table of valid configuration options
|
||||
* for component being merged */
|
||||
* for component being merged */
|
||||
} ArchMergeInfo;
|
||||
|
||||
/*
|
||||
@@ -169,64 +157,64 @@ typedef struct ConfigCmdline {
|
||||
Tcl_Obj *objv[4]; /* objects representing "configure" command */
|
||||
} ConfigCmdline;
|
||||
|
||||
MODULE_SCOPE int Itk_ArchInitOptsCmd (void *cdata,
|
||||
MODULE_SCOPE int Itk_ArchInitOptsCmd (ClientData cdata,
|
||||
Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
|
||||
MODULE_SCOPE int Itk_ArchDeleteOptsCmd (void *cdata,
|
||||
MODULE_SCOPE int Itk_ArchDeleteOptsCmd (ClientData cdata,
|
||||
Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
|
||||
MODULE_SCOPE int Itk_ArchComponentCmd (void *cdata,
|
||||
MODULE_SCOPE int Itk_ArchComponentCmd (ClientData cdata,
|
||||
Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
|
||||
MODULE_SCOPE int Itk_ArchInitCmd (void *cdata,
|
||||
MODULE_SCOPE int Itk_ArchInitCmd (ClientData cdata,
|
||||
Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
|
||||
MODULE_SCOPE int Itk_ArchOptionCmd (void *cdata,
|
||||
MODULE_SCOPE int Itk_ArchOptionCmd (ClientData cdata,
|
||||
Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
|
||||
MODULE_SCOPE int Itk_ArchCompAccessCmd (void *cdata,
|
||||
MODULE_SCOPE int Itk_ArchCompAccessCmd (ClientData cdata,
|
||||
Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
|
||||
MODULE_SCOPE int Itk_ArchConfigureCmd (void *cdata,
|
||||
MODULE_SCOPE int Itk_ArchConfigureCmd (ClientData cdata,
|
||||
Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
|
||||
MODULE_SCOPE int Itk_ArchCgetCmd (void *cdata,
|
||||
MODULE_SCOPE int Itk_ArchCgetCmd (ClientData cdata,
|
||||
Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
|
||||
|
||||
MODULE_SCOPE int Itk_ArchCompAddCmd(void *cdata,
|
||||
Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[]);
|
||||
MODULE_SCOPE int Itk_ArchCompDeleteCmd(void *cdata,
|
||||
Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[]);
|
||||
MODULE_SCOPE int Itk_ArchConfigOption(Tcl_Interp *interp,
|
||||
MODULE_SCOPE int Itk_ArchCompAddCmd (ClientData cdata,
|
||||
Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
|
||||
MODULE_SCOPE int Itk_ArchCompDeleteCmd (ClientData cdata,
|
||||
Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
|
||||
MODULE_SCOPE int Itk_ArchConfigOption (Tcl_Interp *interp,
|
||||
ArchInfo *info, char *name, char *value);
|
||||
MODULE_SCOPE int Itk_ArchOptionAddCmd(void *cdata,
|
||||
Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[]);
|
||||
MODULE_SCOPE int Itk_ArchOptionRemoveCmd(void *cdata,
|
||||
Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[]);
|
||||
MODULE_SCOPE int Itk_PropagatePublicVar(Tcl_Interp *interp,
|
||||
ItclObject *contextObj, void *cdata, const char *newval);
|
||||
MODULE_SCOPE int Itk_GetArchInfo(Tcl_Interp *interp,
|
||||
MODULE_SCOPE int Itk_ArchOptionAddCmd (ClientData cdata,
|
||||
Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
|
||||
MODULE_SCOPE int Itk_ArchOptionRemoveCmd (ClientData cdata,
|
||||
Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
|
||||
MODULE_SCOPE int Itk_PropagatePublicVar (Tcl_Interp *interp,
|
||||
ItclObject *contextObj, ClientData cdata, const char *newval);
|
||||
MODULE_SCOPE int Itk_GetArchInfo (Tcl_Interp *interp,
|
||||
ItclObject* contextObj, ArchInfo **infoPtr);
|
||||
MODULE_SCOPE void Itk_ArchOptConfigError(Tcl_Interp *interp,
|
||||
MODULE_SCOPE void Itk_ArchOptConfigError (Tcl_Interp *interp,
|
||||
ArchInfo *info, ArchOption *archOpt);
|
||||
MODULE_SCOPE void Itk_ArchOptAccessError(Tcl_Interp *interp,
|
||||
MODULE_SCOPE void Itk_ArchOptAccessError (Tcl_Interp *interp,
|
||||
ArchInfo *info, ArchOption *archOpt);
|
||||
MODULE_SCOPE ArchOptionPart* Itk_CreateOptionPart(
|
||||
Tcl_Interp *interp, void *cdata, Itk_ConfigOptionPartProc* cproc,
|
||||
Tcl_CmdDeleteProc *dproc, void *from);
|
||||
MODULE_SCOPE int Itk_AddOptionPart(Tcl_Interp *interp,
|
||||
MODULE_SCOPE ArchOptionPart* Itk_CreateOptionPart (
|
||||
Tcl_Interp *interp, ClientData cdata, Itk_ConfigOptionPartProc* cproc,
|
||||
Tcl_CmdDeleteProc *dproc, ClientData from);
|
||||
MODULE_SCOPE int Itk_AddOptionPart (Tcl_Interp *interp,
|
||||
ArchInfo *info, char *switchName, char *resName, char *resClass,
|
||||
const char *defVal, char *currVal, ArchOptionPart *optPart,
|
||||
ArchOption **raOpt);
|
||||
MODULE_SCOPE ArchOptionPart* Itk_FindArchOptionPart(
|
||||
ArchInfo *info, char *switchName, void *from);
|
||||
MODULE_SCOPE void Itk_DelOptionPart(ArchOptionPart *optPart);
|
||||
MODULE_SCOPE void Itk_DelArchInfo(void *cdata);
|
||||
MODULE_SCOPE ArchOptionPart* Itk_FindArchOptionPart (
|
||||
ArchInfo *info, char *switchName, ClientData from);
|
||||
MODULE_SCOPE void Itk_DelOptionPart (ArchOptionPart *optPart);
|
||||
MODULE_SCOPE void Itk_DelArchInfo (ClientData cdata);
|
||||
MODULE_SCOPE Tcl_HashTable* ItkGetObjsWithArchInfo
|
||||
(Tcl_Interp *interp);
|
||||
MODULE_SCOPE void ItkFreeObjsWithArchInfo(void *cdata,
|
||||
MODULE_SCOPE void ItkFreeObjsWithArchInfo (ClientData cdata,
|
||||
Tcl_Interp *interp);
|
||||
MODULE_SCOPE void Itk_DelMergeInfo(void *cdata);
|
||||
MODULE_SCOPE int Itk_ArchOptKeepCmd(void *cdata,
|
||||
MODULE_SCOPE void Itk_DelMergeInfo (void* cdata);
|
||||
MODULE_SCOPE int Itk_ArchOptKeepCmd (ClientData cdata,
|
||||
Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
|
||||
MODULE_SCOPE int Itk_ArchOptIgnoreCmd(void *cdata,
|
||||
MODULE_SCOPE int Itk_ArchOptIgnoreCmd (ClientData cdata,
|
||||
Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
|
||||
MODULE_SCOPE int Itk_ArchOptRenameCmd(void *cdata,
|
||||
MODULE_SCOPE int Itk_ArchOptRenameCmd (ClientData cdata,
|
||||
Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
|
||||
MODULE_SCOPE int Itk_ArchOptUsualCmd(void *cdata,
|
||||
MODULE_SCOPE int Itk_ArchOptUsualCmd (ClientData cdata,
|
||||
Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
|
||||
|
||||
|
||||
|
||||
+25
-25
@@ -15,23 +15,24 @@ extern "C" {
|
||||
/* Slot 0 is reserved */
|
||||
/* Slot 1 is reserved */
|
||||
/* 2 */
|
||||
ITKAPI int Itk_ConfigBodyCmd(void *cdata, Tcl_Interp *interp,
|
||||
int objc, Tcl_Obj *const objv[]);
|
||||
ITKAPI int Itk_ConfigBodyCmd(ClientData cdata,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const objv[]);
|
||||
/* 3 */
|
||||
ITKAPI int Itk_UsualCmd(void *cdata, Tcl_Interp *interp,
|
||||
ITKAPI int Itk_UsualCmd(ClientData cdata, Tcl_Interp *interp,
|
||||
int objc, Tcl_Obj *const objv[]);
|
||||
/* 4 */
|
||||
ITKAPI int Itk_ClassOptionDefineCmd(void *cdata,
|
||||
ITKAPI int Itk_ClassOptionDefineCmd(ClientData cdata,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const objv[]);
|
||||
/* 5 */
|
||||
ITKAPI int Itk_ClassOptionIllegalCmd(void *cdata,
|
||||
ITKAPI int Itk_ClassOptionIllegalCmd(ClientData cdata,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const objv[]);
|
||||
/* 6 */
|
||||
ITKAPI int Itk_ConfigClassOption(Tcl_Interp *interp,
|
||||
ItclObject *contextObj, void *cdata,
|
||||
const char *newVal);
|
||||
ItclObject *contextObj, ClientData cdata,
|
||||
const char*newVal);
|
||||
/* 7 */
|
||||
ITKAPI ItkClassOptTable* Itk_CreateClassOptTable(Tcl_Interp *interp,
|
||||
ItclClass *cdefn);
|
||||
@@ -40,10 +41,9 @@ ITKAPI ItkClassOptTable* Itk_FindClassOptTable(ItclClass *cdefn);
|
||||
/* Slot 9 is reserved */
|
||||
/* 10 */
|
||||
ITKAPI int Itk_CreateClassOption(Tcl_Interp *interp,
|
||||
ItclClass *cdefn, const char *switchName,
|
||||
const char *resName, const char *resClass,
|
||||
const char *defVal, const char *config,
|
||||
ItkClassOption **optPtr);
|
||||
ItclClass *cdefn, char *switchName,
|
||||
char *resName, char *resClass, char *defVal,
|
||||
char *config, ItkClassOption **optPtr);
|
||||
/* 11 */
|
||||
ITKAPI ItkClassOption* Itk_FindClassOption(ItclClass *cdefn,
|
||||
const char *switchName);
|
||||
@@ -51,15 +51,15 @@ ITKAPI ItkClassOption* Itk_FindClassOption(ItclClass *cdefn,
|
||||
ITKAPI void Itk_DelClassOption(ItkClassOption *opt);
|
||||
/* Slot 13 is reserved */
|
||||
/* 14 */
|
||||
ITKAPI void Itk_OptListInit(ItkOptList *olist,
|
||||
ITKAPI void Itk_OptListInit(ItkOptList*olist,
|
||||
Tcl_HashTable *options);
|
||||
/* 15 */
|
||||
ITKAPI void Itk_OptListFree(ItkOptList *olist);
|
||||
ITKAPI void Itk_OptListFree(ItkOptList*olist);
|
||||
/* 16 */
|
||||
ITKAPI void Itk_OptListAdd(ItkOptList *olist,
|
||||
ITKAPI void Itk_OptListAdd(ItkOptList*olist,
|
||||
Tcl_HashEntry *entry);
|
||||
/* 17 */
|
||||
ITKAPI void Itk_OptListRemove(ItkOptList *olist,
|
||||
ITKAPI void Itk_OptListRemove(ItkOptList*olist,
|
||||
Tcl_HashEntry *entry);
|
||||
|
||||
typedef struct ItkIntStubs {
|
||||
@@ -70,22 +70,22 @@ typedef struct ItkIntStubs {
|
||||
|
||||
void (*reserved0)(void);
|
||||
void (*reserved1)(void);
|
||||
int (*itk_ConfigBodyCmd) (void *cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 2 */
|
||||
int (*itk_UsualCmd) (void *cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 3 */
|
||||
int (*itk_ClassOptionDefineCmd) (void *cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 4 */
|
||||
int (*itk_ClassOptionIllegalCmd) (void *cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 5 */
|
||||
int (*itk_ConfigClassOption) (Tcl_Interp *interp, ItclObject *contextObj, void *cdata, const char *newVal); /* 6 */
|
||||
int (*itk_ConfigBodyCmd) (ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 2 */
|
||||
int (*itk_UsualCmd) (ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 3 */
|
||||
int (*itk_ClassOptionDefineCmd) (ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 4 */
|
||||
int (*itk_ClassOptionIllegalCmd) (ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 5 */
|
||||
int (*itk_ConfigClassOption) (Tcl_Interp *interp, ItclObject *contextObj, ClientData cdata, const char*newVal); /* 6 */
|
||||
ItkClassOptTable* (*itk_CreateClassOptTable) (Tcl_Interp *interp, ItclClass *cdefn); /* 7 */
|
||||
ItkClassOptTable* (*itk_FindClassOptTable) (ItclClass *cdefn); /* 8 */
|
||||
void (*reserved9)(void);
|
||||
int (*itk_CreateClassOption) (Tcl_Interp *interp, ItclClass *cdefn, const char *switchName, const char *resName, const char *resClass, const char *defVal, const char *config, ItkClassOption **optPtr); /* 10 */
|
||||
int (*itk_CreateClassOption) (Tcl_Interp *interp, ItclClass *cdefn, char *switchName, char *resName, char *resClass, char *defVal, char *config, ItkClassOption **optPtr); /* 10 */
|
||||
ItkClassOption* (*itk_FindClassOption) (ItclClass *cdefn, const char *switchName); /* 11 */
|
||||
void (*itk_DelClassOption) (ItkClassOption *opt); /* 12 */
|
||||
void (*reserved13)(void);
|
||||
void (*itk_OptListInit) (ItkOptList *olist, Tcl_HashTable *options); /* 14 */
|
||||
void (*itk_OptListFree) (ItkOptList *olist); /* 15 */
|
||||
void (*itk_OptListAdd) (ItkOptList *olist, Tcl_HashEntry *entry); /* 16 */
|
||||
void (*itk_OptListRemove) (ItkOptList *olist, Tcl_HashEntry *entry); /* 17 */
|
||||
void (*itk_OptListInit) (ItkOptList*olist, Tcl_HashTable *options); /* 14 */
|
||||
void (*itk_OptListFree) (ItkOptList*olist); /* 15 */
|
||||
void (*itk_OptListAdd) (ItkOptList*olist, Tcl_HashEntry *entry); /* 16 */
|
||||
void (*itk_OptListRemove) (ItkOptList*olist, Tcl_HashEntry *entry); /* 17 */
|
||||
} ItkIntStubs;
|
||||
|
||||
extern const ItkIntStubs *itkIntStubsPtr;
|
||||
|
||||
+130
-126
@@ -26,11 +26,11 @@
|
||||
/*
|
||||
* FORWARD DECLARATIONS
|
||||
*/
|
||||
static char* ItkTraceClassDestroy (void *cdata,
|
||||
static char* ItkTraceClassDestroy (ClientData cdata,
|
||||
Tcl_Interp *interp, const char *name1, const char *name2, int flags);
|
||||
static Tcl_HashTable* ItkGetClassesWithOptInfo (
|
||||
Tcl_Interp *interp);
|
||||
static void ItkFreeClassesWithOptInfo (void *cdata,
|
||||
static void ItkFreeClassesWithOptInfo (ClientData cdata,
|
||||
Tcl_Interp *interp);
|
||||
|
||||
|
||||
@@ -53,9 +53,10 @@ static void ItkFreeClassesWithOptInfo (void *cdata,
|
||||
* Returns TCL_OK/TCL_ERROR to indicate success/failure.
|
||||
* ------------------------------------------------------------------------
|
||||
*/
|
||||
/* ARGSUSED */
|
||||
int
|
||||
Itk_ClassOptionDefineCmd(
|
||||
void *clientData, /* class parser info */
|
||||
ClientData clientData, /* class parser info */
|
||||
Tcl_Interp *interp, /* current interpreter */
|
||||
int objc, /* number of arguments */
|
||||
Tcl_Obj *const objv[]) /* argument objects */
|
||||
@@ -64,11 +65,11 @@ Itk_ClassOptionDefineCmd(
|
||||
ItclClass *iclsPtr = (ItclClass*)Itcl_PeekStack(&info->clsStack);
|
||||
|
||||
int newEntry;
|
||||
const char *switchName;
|
||||
const char *resName;
|
||||
const char *resClass;
|
||||
const char *init;
|
||||
const char *config;
|
||||
char *switchName;
|
||||
char *resName;
|
||||
char *resClass;
|
||||
char *init;
|
||||
char *config;
|
||||
ItkClassOptTable *optTable;
|
||||
Tcl_HashEntry *entry;
|
||||
ItkClassOption *opt;
|
||||
@@ -79,46 +80,46 @@ Itk_ClassOptionDefineCmd(
|
||||
* name must start with a '-'.
|
||||
*/
|
||||
if (objc < 5 || objc > 6) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv,
|
||||
"-switch resourceName resourceClass init ?config?");
|
||||
return TCL_ERROR;
|
||||
Tcl_WrongNumArgs(interp, 1, objv,
|
||||
"-switch resourceName resourceClass init ?config?");
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
switchName = Tcl_GetString(objv[1]);
|
||||
if (*switchName != '-') {
|
||||
Tcl_AppendResult(interp,
|
||||
"bad option name \"", switchName, "\": should be -",
|
||||
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
||||
"bad option name \"", switchName, "\": should be -",
|
||||
switchName, (char*)NULL);
|
||||
return TCL_ERROR;
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (strstr(switchName, ".")) {
|
||||
Tcl_AppendResult(interp,
|
||||
"bad option name \"", switchName,
|
||||
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
||||
"bad option name \"", switchName,
|
||||
"\": illegal character \".\"", (char*)NULL);
|
||||
return TCL_ERROR;
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
resName = Tcl_GetString(objv[2]);
|
||||
if (!islower((int)*resName)) {
|
||||
Tcl_AppendResult(interp,
|
||||
"bad resource name \"", resName,
|
||||
"\": should start with a lower case letter",
|
||||
(char*)NULL);
|
||||
return TCL_ERROR;
|
||||
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
||||
"bad resource name \"", resName,
|
||||
"\": should start with a lower case letter",
|
||||
(char*)NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
resClass = Tcl_GetString(objv[3]);
|
||||
if (!isupper((int)*resClass)) {
|
||||
Tcl_AppendResult(interp,
|
||||
"bad resource class \"", resClass,
|
||||
"\": should start with an upper case letter",
|
||||
(char*)NULL);
|
||||
return TCL_ERROR;
|
||||
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
||||
"bad resource class \"", resClass,
|
||||
"\": should start with an upper case letter",
|
||||
(char*)NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
if (iclsPtr == NULL) {
|
||||
Tcl_AppendResult(interp, "can only handle options on class level",
|
||||
NULL);
|
||||
Tcl_AppendResult(interp, "can only handle options on class level",
|
||||
NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
/*
|
||||
@@ -133,11 +134,11 @@ Itk_ClassOptionDefineCmd(
|
||||
entry = Tcl_CreateHashEntry(&optTable->options, switchName, &newEntry);
|
||||
|
||||
if (!newEntry) {
|
||||
Tcl_AppendResult(interp,
|
||||
"option \"", switchName, "\" already defined in class \"",
|
||||
Tcl_GetString(iclsPtr->fullNamePtr), "\"",
|
||||
(char*)NULL);
|
||||
return TCL_ERROR;
|
||||
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
||||
"option \"", switchName, "\" already defined in class \"",
|
||||
Tcl_GetString(iclsPtr->fullNamePtr), "\"",
|
||||
(char*)NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -147,17 +148,17 @@ Itk_ClassOptionDefineCmd(
|
||||
init = Tcl_GetString(objv[4]);
|
||||
|
||||
if (objc == 6) {
|
||||
config = Tcl_GetString(objv[5]);
|
||||
config = Tcl_GetString(objv[5]);
|
||||
} else {
|
||||
config = NULL;
|
||||
config = NULL;
|
||||
}
|
||||
|
||||
if (Itk_CreateClassOption(interp, iclsPtr, switchName, resName, resClass,
|
||||
init, config, &opt) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
init, config, &opt) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
Tcl_SetHashValue(entry, (void *)opt);
|
||||
Tcl_SetHashValue(entry, (ClientData)opt);
|
||||
Itk_OptListAdd(&optTable->order, entry);
|
||||
return TCL_OK;
|
||||
}
|
||||
@@ -173,19 +174,20 @@ Itk_ClassOptionDefineCmd(
|
||||
* been created. Returns TCL_ERROR along with an error message.
|
||||
* ------------------------------------------------------------------------
|
||||
*/
|
||||
/* ARGSUSED */
|
||||
int
|
||||
Itk_ClassOptionIllegalCmd(
|
||||
TCL_UNUSED(void *), /* class parser info */
|
||||
ClientData clientData, /* class parser info */
|
||||
Tcl_Interp *interp, /* current interpreter */
|
||||
TCL_UNUSED(int), /* number of arguments */
|
||||
int objc, /* number of arguments */
|
||||
Tcl_Obj *const objv[]) /* argument objects */
|
||||
{
|
||||
char *op = Tcl_GetString(objv[0]);
|
||||
|
||||
Tcl_AppendResult(interp,
|
||||
"can only ", op, " options for a specific widget\n",
|
||||
"(move this command into the constructor)",
|
||||
(char*)NULL);
|
||||
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
|
||||
"can only ", op, " options for a specific widget\n",
|
||||
"(move this command into the constructor)",
|
||||
(char*)NULL);
|
||||
|
||||
return TCL_ERROR;
|
||||
}
|
||||
@@ -204,12 +206,13 @@ Itk_ClassOptionIllegalCmd(
|
||||
* message in the interpreter) if anything goes wrong.
|
||||
* ------------------------------------------------------------------------
|
||||
*/
|
||||
/* ARGSUSED */
|
||||
int
|
||||
Itk_ConfigClassOption(
|
||||
Tcl_Interp *interp, /* interpreter managing the class */
|
||||
ItclObject *contextObj, /* object being configured */
|
||||
void *cdata, /* class option */
|
||||
TCL_UNUSED(const char *)) /* new value for this option */
|
||||
ClientData cdata, /* class option */
|
||||
const char *newval) /* new value for this option */
|
||||
{
|
||||
ItkClassOption *opt = (ItkClassOption*)cdata;
|
||||
int result = TCL_OK;
|
||||
@@ -226,7 +229,7 @@ Itk_ConfigClassOption(
|
||||
Itcl_PushCallFrame(interp, &frame, opt->iclsPtr->nsPtr, 1);
|
||||
Itcl_SetContext(interp, contextObj);
|
||||
|
||||
result = Tcl_EvalObjEx(interp, mcode->bodyPtr, 0);
|
||||
result = Tcl_EvalObjEx(interp, mcode->bodyPtr, 0);
|
||||
|
||||
Itcl_UnsetContext(interp);
|
||||
Itcl_PopCallFrame(interp);
|
||||
@@ -241,8 +244,8 @@ Itk_ConfigClassOption(
|
||||
* code here looked like:
|
||||
*
|
||||
|
||||
result = Itcl_EvalMemberCode(interp, (ItclMemberFunc*)NULL,
|
||||
opt->member, contextObj, 0, (Tcl_Obj**)NULL);
|
||||
result = Itcl_EvalMemberCode(interp, (ItclMemberFunc*)NULL,
|
||||
opt->member, contextObj, 0, (Tcl_Obj**)NULL);
|
||||
|
||||
*
|
||||
* In Itcl 4, Itcl methods have become (a particular variant)
|
||||
@@ -263,7 +266,7 @@ Itk_ConfigClassOption(
|
||||
* for (result == TCL_RETURN) here. This is essentially a
|
||||
* reproduction of the Tcl internal routine TclUpdateReturnInfo()
|
||||
* but without the benefit of internals access.
|
||||
*/
|
||||
*/
|
||||
|
||||
if (result == TCL_RETURN) {
|
||||
Tcl_Obj *opts = Tcl_GetReturnOptions(interp, TCL_RETURN);
|
||||
@@ -326,23 +329,23 @@ Itk_CreateClassOptTable(
|
||||
|
||||
entry = Tcl_CreateHashEntry(itkClasses, (char*)iclsPtr, &newEntry);
|
||||
if (newEntry) {
|
||||
optTable = (ItkClassOptTable*)Tcl_Alloc(sizeof(ItkClassOptTable));
|
||||
Tcl_InitHashTable(&optTable->options, TCL_STRING_KEYS);
|
||||
Itk_OptListInit(&optTable->order, &optTable->options);
|
||||
optTable = (ItkClassOptTable*)ckalloc(sizeof(ItkClassOptTable));
|
||||
Tcl_InitHashTable(&optTable->options, TCL_STRING_KEYS);
|
||||
Itk_OptListInit(&optTable->order, &optTable->options);
|
||||
|
||||
Tcl_SetHashValue(entry, (void *)optTable);
|
||||
Tcl_SetHashValue(entry, (ClientData)optTable);
|
||||
|
||||
result = Itcl_PushCallFrame(interp, &frame,
|
||||
iclsPtr->nsPtr, /* isProcCallFrame */ 0);
|
||||
result = Itcl_PushCallFrame(interp, &frame,
|
||||
iclsPtr->nsPtr, /* isProcCallFrame */ 0);
|
||||
|
||||
if (result == TCL_OK) {
|
||||
Tcl_TraceVar(interp, "_itk_option_data",
|
||||
(TCL_TRACE_UNSETS | TCL_NAMESPACE_ONLY),
|
||||
ItkTraceClassDestroy, (void *)iclsPtr);
|
||||
Itcl_PopCallFrame(interp);
|
||||
}
|
||||
if (result == TCL_OK) {
|
||||
Tcl_TraceVar(interp, "_itk_option_data",
|
||||
(TCL_TRACE_UNSETS | TCL_NAMESPACE_ONLY),
|
||||
ItkTraceClassDestroy, (ClientData)iclsPtr);
|
||||
Itcl_PopCallFrame(interp);
|
||||
}
|
||||
} else {
|
||||
optTable = (ItkClassOptTable*)Tcl_GetHashValue(entry);
|
||||
optTable = (ItkClassOptTable*)Tcl_GetHashValue(entry);
|
||||
}
|
||||
return optTable;
|
||||
}
|
||||
@@ -375,7 +378,7 @@ Itk_FindClassOptTable(
|
||||
itkClasses = ItkGetClassesWithOptInfo(iclsPtr->interp);
|
||||
entry = Tcl_FindHashEntry(itkClasses, (char*)iclsPtr);
|
||||
if (entry) {
|
||||
return (ItkClassOptTable*)Tcl_GetHashValue(entry);
|
||||
return (ItkClassOptTable*)Tcl_GetHashValue(entry);
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
@@ -395,13 +398,14 @@ Itk_FindClassOptTable(
|
||||
* error that is encountered.
|
||||
* ------------------------------------------------------------------------
|
||||
*/
|
||||
/* ARGSUSED */
|
||||
static char*
|
||||
ItkTraceClassDestroy(
|
||||
void *cdata, /* class definition data */
|
||||
ClientData cdata, /* class definition data */
|
||||
Tcl_Interp *interp, /* interpreter managing the class */
|
||||
TCL_UNUSED(const char *), /* name of variable involved in trace */
|
||||
TCL_UNUSED(const char *), /* name of array element within variable */
|
||||
TCL_UNUSED(int)) /* flags describing trace */
|
||||
const char *name1, /* name of variable involved in trace */
|
||||
const char *name2, /* name of array element within variable */
|
||||
int flags) /* flags describing trace */
|
||||
{
|
||||
ItclClass *iclsPtr = (ItclClass*)cdata;
|
||||
|
||||
@@ -419,18 +423,18 @@ ItkTraceClassDestroy(
|
||||
itkClasses = ItkGetClassesWithOptInfo(interp);
|
||||
entry = Tcl_FindHashEntry(itkClasses, (char*)iclsPtr);
|
||||
if (entry) {
|
||||
optTable = (ItkClassOptTable*)Tcl_GetHashValue(entry);
|
||||
Tcl_DeleteHashEntry(entry);
|
||||
optTable = (ItkClassOptTable*)Tcl_GetHashValue(entry);
|
||||
Tcl_DeleteHashEntry(entry);
|
||||
|
||||
entry = Tcl_FirstHashEntry(&optTable->options, &place);
|
||||
while (entry) {
|
||||
opt = (ItkClassOption*)Tcl_GetHashValue(entry);
|
||||
Itk_DelClassOption(opt);
|
||||
entry = Tcl_NextHashEntry(&place);
|
||||
}
|
||||
Tcl_DeleteHashTable(&optTable->options);
|
||||
Itk_OptListFree(&optTable->order);
|
||||
Tcl_Free(optTable);
|
||||
entry = Tcl_FirstHashEntry(&optTable->options, &place);
|
||||
while (entry) {
|
||||
opt = (ItkClassOption*)Tcl_GetHashValue(entry);
|
||||
Itk_DelClassOption(opt);
|
||||
entry = Tcl_NextHashEntry(&place);
|
||||
}
|
||||
Tcl_DeleteHashTable(&optTable->options);
|
||||
Itk_OptListFree(&optTable->order);
|
||||
ckfree((char*)optTable);
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
@@ -454,11 +458,11 @@ int
|
||||
Itk_CreateClassOption(
|
||||
Tcl_Interp *interp, /* interpreter managing the class */
|
||||
ItclClass *iclsPtr, /* class containing this option */
|
||||
const char *switchName, /* name of command-line switch */
|
||||
const char *resName, /* resource name in X11 database */
|
||||
const char *resClass, /* resource class name in X11 database */
|
||||
const char *defVal, /* last-resort default value */
|
||||
const char *config, /* configuration code */
|
||||
char *switchName, /* name of command-line switch */
|
||||
char *resName, /* resource name in X11 database */
|
||||
char *resClass, /* resource class name in X11 database */
|
||||
char *defVal, /* last-resort default value */
|
||||
char *config, /* configuration code */
|
||||
ItkClassOption **optPtr) /* returns: option record */
|
||||
{
|
||||
ItkClassOption *opt;
|
||||
@@ -469,23 +473,23 @@ Itk_CreateClassOption(
|
||||
* an implementation for it.
|
||||
*/
|
||||
if (config) {
|
||||
if (Itcl_CreateMemberCode(interp, iclsPtr, (char*)NULL, config,
|
||||
&mcode) != TCL_OK) {
|
||||
if (Itcl_CreateMemberCode(interp, iclsPtr, (char*)NULL, config,
|
||||
&mcode) != TCL_OK) {
|
||||
|
||||
return TCL_ERROR;
|
||||
}
|
||||
Itcl_PreserveData((void *)mcode);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
Itcl_PreserveData((ClientData)mcode);
|
||||
#ifdef NOTDEF
|
||||
Itcl_EventuallyFree((void *)mcode, (Tcl_FreeProc *)Itcl_DeleteMemberCode);
|
||||
Itcl_EventuallyFree((ClientData)mcode, (Tcl_FreeProc *)Itcl_DeleteMemberCode);
|
||||
#endif
|
||||
} else {
|
||||
mcode = NULL;
|
||||
mcode = NULL;
|
||||
}
|
||||
|
||||
/*
|
||||
* Create the record to represent this option.
|
||||
*/
|
||||
opt = (ItkClassOption*)Tcl_Alloc(sizeof(ItkClassOption));
|
||||
opt = (ItkClassOption*)ckalloc(sizeof(ItkClassOption));
|
||||
memset(opt, 0, sizeof(ItkClassOption));
|
||||
opt->iclsPtr = iclsPtr;
|
||||
opt->flags = 0;
|
||||
@@ -498,13 +502,13 @@ Itk_CreateClassOption(
|
||||
Tcl_IncrRefCount(opt->fullNamePtr);
|
||||
opt->codePtr = mcode;
|
||||
|
||||
opt->resName = (char*)Tcl_Alloc((strlen(resName)+1));
|
||||
opt->resName = (char*)ckalloc((unsigned)(strlen(resName)+1));
|
||||
strcpy(opt->resName, resName);
|
||||
|
||||
opt->resClass = (char*)Tcl_Alloc((strlen(resClass)+1));
|
||||
opt->resClass = (char*)ckalloc((unsigned)(strlen(resClass)+1));
|
||||
strcpy(opt->resClass, resClass);
|
||||
|
||||
opt->init = (char*)Tcl_Alloc((strlen(defVal)+1));
|
||||
opt->init = (char*)ckalloc((unsigned)(strlen(defVal)+1));
|
||||
strcpy(opt->init, defVal);
|
||||
|
||||
*optPtr = opt;
|
||||
@@ -541,9 +545,9 @@ Itk_FindClassOption(
|
||||
*/
|
||||
Tcl_DStringInit(&buffer);
|
||||
if (*switchName != '-') {
|
||||
Tcl_DStringAppend(&buffer, "-", -1);
|
||||
Tcl_DStringAppend(&buffer, switchName, -1);
|
||||
switchName = Tcl_DStringValue(&buffer);
|
||||
Tcl_DStringAppend(&buffer, "-", -1);
|
||||
Tcl_DStringAppend(&buffer, switchName, -1);
|
||||
switchName = Tcl_DStringValue(&buffer);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -552,10 +556,10 @@ Itk_FindClassOption(
|
||||
*/
|
||||
optTable = Itk_FindClassOptTable(iclsPtr);
|
||||
if (optTable) {
|
||||
entry = Tcl_FindHashEntry(&optTable->options, switchName);
|
||||
if (entry) {
|
||||
opt = (ItkClassOption*)Tcl_GetHashValue(entry);
|
||||
}
|
||||
entry = Tcl_FindHashEntry(&optTable->options, switchName);
|
||||
if (entry) {
|
||||
opt = (ItkClassOption*)Tcl_GetHashValue(entry);
|
||||
}
|
||||
}
|
||||
Tcl_DStringFree(&buffer);
|
||||
return opt;
|
||||
@@ -576,11 +580,11 @@ Itk_DelClassOption(
|
||||
#ifdef NOTDEF
|
||||
Itcl_DeleteMember(opt->member);
|
||||
#endif
|
||||
Tcl_Free(opt->resName);
|
||||
Tcl_Free(opt->resClass);
|
||||
Tcl_Free(opt->init);
|
||||
ckfree(opt->resName);
|
||||
ckfree(opt->resClass);
|
||||
ckfree(opt->init);
|
||||
|
||||
Tcl_Free(opt);
|
||||
ckfree((char*)opt);
|
||||
}
|
||||
|
||||
|
||||
@@ -603,13 +607,13 @@ ItkGetClassesWithOptInfo(
|
||||
* If the registration table does not yet exist, then create it.
|
||||
*/
|
||||
classesTable = (Tcl_HashTable*)Tcl_GetAssocData(interp,
|
||||
"itk_classesWithOptInfo", (Tcl_InterpDeleteProc**)NULL);
|
||||
"itk_classesWithOptInfo", (Tcl_InterpDeleteProc**)NULL);
|
||||
|
||||
if (!classesTable) {
|
||||
classesTable = (Tcl_HashTable*)Tcl_Alloc(sizeof(Tcl_HashTable));
|
||||
Tcl_InitHashTable(classesTable, TCL_ONE_WORD_KEYS);
|
||||
Tcl_SetAssocData(interp, "itk_classesWithOptInfo",
|
||||
ItkFreeClassesWithOptInfo, (void *)classesTable);
|
||||
classesTable = (Tcl_HashTable*)ckalloc(sizeof(Tcl_HashTable));
|
||||
Tcl_InitHashTable(classesTable, TCL_ONE_WORD_KEYS);
|
||||
Tcl_SetAssocData(interp, "itk_classesWithOptInfo",
|
||||
ItkFreeClassesWithOptInfo, (ClientData)classesTable);
|
||||
}
|
||||
return classesTable;
|
||||
}
|
||||
@@ -624,8 +628,8 @@ ItkGetClassesWithOptInfo(
|
||||
*/
|
||||
static void
|
||||
ItkFreeClassesWithOptInfo(
|
||||
void *clientData, /* associated data */
|
||||
TCL_UNUSED(Tcl_Interp *)) /* interpreter being freed */
|
||||
ClientData clientData, /* associated data */
|
||||
Tcl_Interp *interp) /* interpreter being freed */
|
||||
{
|
||||
Tcl_HashTable *tablePtr = (Tcl_HashTable*)clientData;
|
||||
Tcl_HashSearch place;
|
||||
@@ -637,21 +641,21 @@ ItkFreeClassesWithOptInfo(
|
||||
|
||||
entry = Tcl_FirstHashEntry(tablePtr, &place);
|
||||
while (entry) {
|
||||
optTable = (ItkClassOptTable*)Tcl_GetHashValue(entry);
|
||||
optTable = (ItkClassOptTable*)Tcl_GetHashValue(entry);
|
||||
|
||||
entry2 = Tcl_FirstHashEntry(&optTable->options, &place2);
|
||||
while (entry2) {
|
||||
opt = (ItkClassOption*)Tcl_GetHashValue(entry2);
|
||||
Itk_DelClassOption(opt);
|
||||
entry2 = Tcl_NextHashEntry(&place2);
|
||||
}
|
||||
Tcl_DeleteHashTable(&optTable->options);
|
||||
Itk_OptListFree(&optTable->order);
|
||||
Tcl_Free(optTable);
|
||||
entry2 = Tcl_FirstHashEntry(&optTable->options, &place2);
|
||||
while (entry2) {
|
||||
opt = (ItkClassOption*)Tcl_GetHashValue(entry2);
|
||||
Itk_DelClassOption(opt);
|
||||
entry2 = Tcl_NextHashEntry(&place2);
|
||||
}
|
||||
Tcl_DeleteHashTable(&optTable->options);
|
||||
Itk_OptListFree(&optTable->order);
|
||||
ckfree((char*)optTable);
|
||||
|
||||
entry = Tcl_NextHashEntry(&place);
|
||||
entry = Tcl_NextHashEntry(&place);
|
||||
}
|
||||
|
||||
Tcl_DeleteHashTable(tablePtr);
|
||||
Tcl_Free(tablePtr);
|
||||
ckfree((char*)tablePtr);
|
||||
}
|
||||
|
||||
@@ -59,7 +59,7 @@ Itk_InitStubs (
|
||||
const char *actualVersion;
|
||||
|
||||
actualVersion = Tcl_PkgRequireEx(interp, "itk", (const char *)version,
|
||||
exact, &itkStubsPtr);
|
||||
exact, (ClientData *) &itkStubsPtr);
|
||||
if (actualVersion == NULL) {
|
||||
itkStubsPtr = NULL;
|
||||
return NULL;
|
||||
|
||||
+62
-62
@@ -40,8 +40,8 @@ Itk_OptListInit(
|
||||
olist->options = options;
|
||||
olist->len = 0;
|
||||
olist->max = 10;
|
||||
olist->list = (Tcl_HashEntry**)Tcl_Alloc(
|
||||
((size_t)olist->max*sizeof(Tcl_HashEntry*))
|
||||
olist->list = (Tcl_HashEntry**)ckalloc(
|
||||
(unsigned)(olist->max*sizeof(Tcl_HashEntry*))
|
||||
);
|
||||
}
|
||||
|
||||
@@ -59,7 +59,7 @@ void
|
||||
Itk_OptListFree(
|
||||
ItkOptList *olist) /* list to be freed */
|
||||
{
|
||||
Tcl_Free(olist->list);
|
||||
ckfree((char*)olist->list);
|
||||
olist->len = olist->max = 0;
|
||||
}
|
||||
|
||||
@@ -83,23 +83,23 @@ Itk_OptListAdd(
|
||||
int last;
|
||||
int cmp;
|
||||
int pos;
|
||||
size_t size;
|
||||
int size;
|
||||
Tcl_HashEntry** newOrder;
|
||||
const char *swname;
|
||||
const char *optname;
|
||||
char *swname;
|
||||
char *optname;
|
||||
|
||||
/*
|
||||
* Make sure that the option list is big enough. Resize
|
||||
* if needed.
|
||||
*/
|
||||
if (olist->len >= olist->max) {
|
||||
size = (size_t)olist->max*sizeof(Tcl_HashEntry*);
|
||||
newOrder = (Tcl_HashEntry**)Tcl_Alloc(2*size);
|
||||
memcpy((void*)newOrder, (void*)olist->list, size);
|
||||
Tcl_Free(olist->list);
|
||||
size = olist->max*sizeof(Tcl_HashEntry*);
|
||||
newOrder = (Tcl_HashEntry**)ckalloc((unsigned)2*size);
|
||||
memcpy((void*)newOrder, (void*)olist->list, (size_t)size);
|
||||
ckfree((char*)olist->list);
|
||||
|
||||
olist->list = newOrder;
|
||||
olist->max *= 2;
|
||||
olist->list = newOrder;
|
||||
olist->max *= 2;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -107,42 +107,42 @@ Itk_OptListAdd(
|
||||
*/
|
||||
first = 0;
|
||||
last = olist->len-1;
|
||||
swname = ((const char *)Tcl_GetHashKey(olist->options, entry)) + 1;
|
||||
swname = ((char *)Tcl_GetHashKey(olist->options, entry)) + 1;
|
||||
|
||||
while (last >= first) {
|
||||
pos = (first+last)/2;
|
||||
optname = ((const char *)Tcl_GetHashKey(olist->options,
|
||||
pos = (first+last)/2;
|
||||
optname = ((char *)Tcl_GetHashKey(olist->options,
|
||||
olist->list[pos])) + 1;
|
||||
if (*swname == *optname) {
|
||||
cmp = strcmp(swname, optname);
|
||||
if (cmp == 0) {
|
||||
break; /* found it! */
|
||||
}
|
||||
}
|
||||
else if (*swname < *optname) {
|
||||
cmp = -1;
|
||||
}
|
||||
else {
|
||||
cmp = 1;
|
||||
}
|
||||
if (*swname == *optname) {
|
||||
cmp = strcmp(swname, optname);
|
||||
if (cmp == 0) {
|
||||
break; /* found it! */
|
||||
}
|
||||
}
|
||||
else if (*swname < *optname) {
|
||||
cmp = -1;
|
||||
}
|
||||
else {
|
||||
cmp = 1;
|
||||
}
|
||||
|
||||
if (cmp > 0)
|
||||
first = pos+1;
|
||||
else
|
||||
last = pos-1;
|
||||
if (cmp > 0)
|
||||
first = pos+1;
|
||||
else
|
||||
last = pos-1;
|
||||
}
|
||||
|
||||
/*
|
||||
* If a matching entry was not found, then insert one.
|
||||
*/
|
||||
if (last < first) {
|
||||
pos = first;
|
||||
pos = first;
|
||||
|
||||
for (i=olist->len; i > pos; i--) {
|
||||
olist->list[i] = olist->list[i-1];
|
||||
}
|
||||
olist->list[pos] = entry;
|
||||
olist->len++;
|
||||
for (i=olist->len; i > pos; i--) {
|
||||
olist->list[i] = olist->list[i-1];
|
||||
}
|
||||
olist->list[pos] = entry;
|
||||
olist->len++;
|
||||
}
|
||||
}
|
||||
|
||||
@@ -168,43 +168,43 @@ Itk_OptListRemove(
|
||||
int first;
|
||||
int last;
|
||||
int cmp;
|
||||
const char *swname;
|
||||
const char *optname;
|
||||
char *swname;
|
||||
char *optname;
|
||||
|
||||
first = 0;
|
||||
last = olist->len-1;
|
||||
swname = ((const char *)Tcl_GetHashKey(olist->options, entry)) + 1;
|
||||
swname = ((char *)Tcl_GetHashKey(olist->options, entry)) + 1;
|
||||
|
||||
while (last >= first) {
|
||||
pos = (first+last)/2;
|
||||
optname = ((const char *)Tcl_GetHashKey(olist->options,
|
||||
pos = (first+last)/2;
|
||||
optname = ((char *)Tcl_GetHashKey(olist->options,
|
||||
olist->list[pos])) + 1;
|
||||
if (*swname == *optname) {
|
||||
cmp = strcmp(swname, optname);
|
||||
if (cmp == 0) {
|
||||
break; /* found it! */
|
||||
}
|
||||
}
|
||||
else if (*swname < *optname) {
|
||||
cmp = -1;
|
||||
}
|
||||
else {
|
||||
cmp = 1;
|
||||
}
|
||||
if (*swname == *optname) {
|
||||
cmp = strcmp(swname, optname);
|
||||
if (cmp == 0) {
|
||||
break; /* found it! */
|
||||
}
|
||||
}
|
||||
else if (*swname < *optname) {
|
||||
cmp = -1;
|
||||
}
|
||||
else {
|
||||
cmp = 1;
|
||||
}
|
||||
|
||||
if (cmp > 0)
|
||||
first = pos+1;
|
||||
else
|
||||
last = pos-1;
|
||||
if (cmp > 0)
|
||||
first = pos+1;
|
||||
else
|
||||
last = pos-1;
|
||||
}
|
||||
|
||||
/*
|
||||
* If a matching entry was found, then remove it.
|
||||
*/
|
||||
if (last >= first) {
|
||||
olist->len--;
|
||||
for (i=pos; i < olist->len; i++) {
|
||||
olist->list[i] = olist->list[i+1];
|
||||
}
|
||||
olist->len--;
|
||||
for (i=pos; i < olist->len; i++) {
|
||||
olist->list[i] = olist->list[i+1];
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@@ -54,12 +54,12 @@
|
||||
itcl::class itk::Archetype {
|
||||
|
||||
constructor {args} {
|
||||
::itcl::builtin::Archetype init
|
||||
eval itk_initialize $args
|
||||
::itcl::builtin::Archetype init
|
||||
eval itk_initialize $args
|
||||
}
|
||||
|
||||
destructor {
|
||||
::itcl::builtin::Archetype delete
|
||||
::itcl::builtin::Archetype delete
|
||||
}
|
||||
|
||||
method cget {option} @Archetype-cget
|
||||
|
||||
+33
-33
@@ -33,49 +33,49 @@ itcl::class itk::Toplevel {
|
||||
inherit itk::Archetype
|
||||
|
||||
constructor {args} {
|
||||
#
|
||||
# Create a toplevel window with the same name as this object
|
||||
#
|
||||
set itk_hull [namespace tail $this]
|
||||
set itk_interior $itk_hull
|
||||
#
|
||||
# Create a toplevel window with the same name as this object
|
||||
#
|
||||
set itk_hull [namespace tail $this]
|
||||
set itk_interior $itk_hull
|
||||
|
||||
itk_component add hull {
|
||||
toplevel $itk_hull -class [namespace tail [info class]]
|
||||
} {
|
||||
keep -menu -background -cursor -takefocus
|
||||
}
|
||||
bind itk-delete-$itk_hull <Destroy> [list itcl::delete object $this]
|
||||
itk_component add hull {
|
||||
toplevel $itk_hull -class [namespace tail [info class]]
|
||||
} {
|
||||
keep -menu -background -cursor -takefocus
|
||||
}
|
||||
bind itk-delete-$itk_hull <Destroy> [list itcl::delete object $this]
|
||||
|
||||
set tags [bindtags $itk_hull]
|
||||
bindtags $itk_hull [linsert $tags 0 itk-delete-$itk_hull]
|
||||
set tags [bindtags $itk_hull]
|
||||
bindtags $itk_hull [linsert $tags 0 itk-delete-$itk_hull]
|
||||
|
||||
eval itk_initialize $args
|
||||
eval itk_initialize $args
|
||||
}
|
||||
|
||||
destructor {
|
||||
if {[winfo exists $itk_hull]} {
|
||||
set tags [bindtags $itk_hull]
|
||||
set i [lsearch $tags itk-delete-$itk_hull]
|
||||
if {$i >= 0} {
|
||||
bindtags $itk_hull [lreplace $tags $i $i]
|
||||
}
|
||||
destroy $itk_hull
|
||||
}
|
||||
itk_component delete hull
|
||||
if {[winfo exists $itk_hull]} {
|
||||
set tags [bindtags $itk_hull]
|
||||
set i [lsearch $tags itk-delete-$itk_hull]
|
||||
if {$i >= 0} {
|
||||
bindtags $itk_hull [lreplace $tags $i $i]
|
||||
}
|
||||
destroy $itk_hull
|
||||
}
|
||||
itk_component delete hull
|
||||
|
||||
set components [component]
|
||||
foreach component $components {
|
||||
set path($component) [component $component]
|
||||
}
|
||||
foreach component $components {
|
||||
if {[winfo exists $path($component)]} {
|
||||
destroy $path($component)
|
||||
}
|
||||
}
|
||||
set components [component]
|
||||
foreach component $components {
|
||||
set path($component) [component $component]
|
||||
}
|
||||
foreach component $components {
|
||||
if {[winfo exists $path($component)]} {
|
||||
destroy $path($component)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
itk_option define -title title Title "" {
|
||||
wm title $itk_hull $itk_option(-title)
|
||||
wm title $itk_hull $itk_option(-title)
|
||||
}
|
||||
|
||||
private variable itk_hull ""
|
||||
|
||||
+32
-32
@@ -34,45 +34,45 @@ itcl::class itk::Widget {
|
||||
# CONSTRUCTOR
|
||||
# ------------------------------------------------------------------
|
||||
constructor {args} {
|
||||
#
|
||||
# Create a window with the same name as this object
|
||||
#
|
||||
set itk_hull [namespace tail $this]
|
||||
set itk_interior $itk_hull
|
||||
#
|
||||
# Create a window with the same name as this object
|
||||
#
|
||||
set itk_hull [namespace tail $this]
|
||||
set itk_interior $itk_hull
|
||||
|
||||
itk_component add hull {
|
||||
frame $itk_hull -class [namespace tail [info class]]
|
||||
} {
|
||||
keep -background -cursor
|
||||
}
|
||||
bind itk-delete-$itk_hull <Destroy> [list itcl::delete object $this]
|
||||
itk_component add hull {
|
||||
frame $itk_hull -class [namespace tail [info class]]
|
||||
} {
|
||||
keep -background -cursor
|
||||
}
|
||||
bind itk-delete-$itk_hull <Destroy> [list itcl::delete object $this]
|
||||
|
||||
set tags [bindtags $itk_hull]
|
||||
bindtags $itk_hull [linsert $tags 0 itk-delete-$itk_hull]
|
||||
set tags [bindtags $itk_hull]
|
||||
bindtags $itk_hull [linsert $tags 0 itk-delete-$itk_hull]
|
||||
|
||||
eval itk_initialize $args
|
||||
eval itk_initialize $args
|
||||
}
|
||||
|
||||
destructor {
|
||||
if {[winfo exists $itk_hull]} {
|
||||
set tags [bindtags $itk_hull]
|
||||
set i [lsearch $tags itk-delete-$itk_hull]
|
||||
if {$i >= 0} {
|
||||
bindtags $itk_hull [lreplace $tags $i $i]
|
||||
}
|
||||
destroy $itk_hull
|
||||
}
|
||||
itk_component delete hull
|
||||
if {[winfo exists $itk_hull]} {
|
||||
set tags [bindtags $itk_hull]
|
||||
set i [lsearch $tags itk-delete-$itk_hull]
|
||||
if {$i >= 0} {
|
||||
bindtags $itk_hull [lreplace $tags $i $i]
|
||||
}
|
||||
destroy $itk_hull
|
||||
}
|
||||
itk_component delete hull
|
||||
|
||||
set components [component]
|
||||
foreach component $components {
|
||||
set path($component) [component $component]
|
||||
}
|
||||
foreach component $components {
|
||||
if {[winfo exists $path($component)]} {
|
||||
destroy $path($component)
|
||||
}
|
||||
}
|
||||
set components [component]
|
||||
foreach component $components {
|
||||
set path($component) [component $component]
|
||||
}
|
||||
foreach component $components {
|
||||
if {[winfo exists $path($component)]} {
|
||||
destroy $path($component)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
private variable itk_hull ""
|
||||
|
||||
+2
-2
@@ -14,7 +14,7 @@
|
||||
# See the file "license.terms" for information on usage and
|
||||
# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
|
||||
package require -exact Itk 4.2.7
|
||||
package require -exact Itk 4.2.3
|
||||
#
|
||||
# Provide transparent access to all [incr Tk] commands
|
||||
#
|
||||
@@ -36,7 +36,7 @@ proc ::itk::remove_destroy_hook {widget} {
|
||||
set tags [bindtags $widget]
|
||||
set i [lsearch $tags "itk-destroy-$widget"]
|
||||
if {$i >= 0} {
|
||||
bindtags $widget [lreplace $tags $i $i]
|
||||
bindtags $widget [lreplace $tags $i $i]
|
||||
}
|
||||
bind itk-destroy-$widget <Destroy> {}
|
||||
}
|
||||
|
||||
+1
-2
@@ -12,5 +12,4 @@ if {[package vsatisfies [package provide Tcl] 9.0-]} {
|
||||
[list load [file join $dir @PKG_LIB_FILE8@] Itk]
|
||||
}
|
||||
|
||||
package ifneeded Itk @PACKAGE_VERSION@ \
|
||||
[list package require -exact itk @PACKAGE_VERSION@]
|
||||
package ifneeded Itk @PACKAGE_VERSION@ [list package require -exact itk @PACKAGE_VERSION@]
|
||||
|
||||
+2
-2
@@ -44,8 +44,8 @@ test interp-1.3 {errors are okay when slave interp is deleted} {
|
||||
load "" Tk slave
|
||||
load "" Itk slave
|
||||
slave eval {
|
||||
label .l
|
||||
bind .l <Destroy> {error "dying!"}
|
||||
label .l
|
||||
bind .l <Destroy> {error "dying!"}
|
||||
}
|
||||
interp delete slave
|
||||
} {}
|
||||
|
||||
+83
-83
@@ -22,59 +22,59 @@ namespace import -force ::tcltest::*
|
||||
# ----------------------------------------------------------------------
|
||||
test option-1.1 {create a widget for the following tests} {
|
||||
itcl::class TestOptComp {
|
||||
inherit itk::Widget
|
||||
constructor {args} {
|
||||
itk_component add test1 {
|
||||
label $itk_interior.t1
|
||||
} {
|
||||
keep -background -foreground -cursor
|
||||
keep -text
|
||||
}
|
||||
pack $itk_component(test1) -side left -padx 2
|
||||
eval itk_initialize $args
|
||||
}
|
||||
private variable status ""
|
||||
public method action {info} {
|
||||
lappend status $info
|
||||
}
|
||||
public method do {cmd} {
|
||||
eval $cmd
|
||||
}
|
||||
itk_option define -status status Status {} {
|
||||
lappend status $itk_option(-status)
|
||||
}
|
||||
inherit itk::Widget
|
||||
constructor {args} {
|
||||
itk_component add test1 {
|
||||
label $itk_interior.t1
|
||||
} {
|
||||
keep -background -foreground -cursor
|
||||
keep -text
|
||||
}
|
||||
pack $itk_component(test1) -side left -padx 2
|
||||
eval itk_initialize $args
|
||||
}
|
||||
private variable status ""
|
||||
public method action {info} {
|
||||
lappend status $info
|
||||
}
|
||||
public method do {cmd} {
|
||||
eval $cmd
|
||||
}
|
||||
itk_option define -status status Status {} {
|
||||
lappend status $itk_option(-status)
|
||||
}
|
||||
}
|
||||
|
||||
itcl::class TestOptWidget {
|
||||
inherit itk::Widget
|
||||
constructor {args} {
|
||||
itk_component add test1 {
|
||||
label $itk_interior.t1
|
||||
} {
|
||||
keep -background -foreground -cursor
|
||||
keep -text
|
||||
}
|
||||
pack $itk_component(test1) -side left -padx 2
|
||||
eval itk_initialize $args
|
||||
}
|
||||
public method do {cmd} {
|
||||
eval $cmd
|
||||
}
|
||||
inherit itk::Widget
|
||||
constructor {args} {
|
||||
itk_component add test1 {
|
||||
label $itk_interior.t1
|
||||
} {
|
||||
keep -background -foreground -cursor
|
||||
keep -text
|
||||
}
|
||||
pack $itk_component(test1) -side left -padx 2
|
||||
eval itk_initialize $args
|
||||
}
|
||||
public method do {cmd} {
|
||||
eval $cmd
|
||||
}
|
||||
}
|
||||
TestOptWidget .#auto
|
||||
} {.testOptWidget0}
|
||||
|
||||
test option-1.2 {"keep" can be called more than once} {
|
||||
.testOptWidget0 do {
|
||||
itk_component add k0 {
|
||||
TestOptComp $itk_interior.k0 -status "create"
|
||||
} {
|
||||
keep -background -foreground -cursor
|
||||
keep -background -foreground -cursor
|
||||
keep -status
|
||||
keep -status
|
||||
}
|
||||
pack $itk_component(k0)
|
||||
itk_component add k0 {
|
||||
TestOptComp $itk_interior.k0 -status "create"
|
||||
} {
|
||||
keep -background -foreground -cursor
|
||||
keep -background -foreground -cursor
|
||||
keep -status
|
||||
keep -status
|
||||
}
|
||||
pack $itk_component(k0)
|
||||
}
|
||||
.testOptWidget0 configure -status "foo"
|
||||
.testOptWidget0 component k0 do {set status}
|
||||
@@ -82,13 +82,13 @@ test option-1.2 {"keep" can be called more than once} {
|
||||
|
||||
test option-1.3 {"rename" can be called more than once} {
|
||||
.testOptWidget0 do {
|
||||
itk_component add k1 {
|
||||
TestOptComp $itk_interior.k1 -status "create"
|
||||
} {
|
||||
rename -status -test test Test
|
||||
rename -status -test test Test
|
||||
}
|
||||
pack $itk_component(k1)
|
||||
itk_component add k1 {
|
||||
TestOptComp $itk_interior.k1 -status "create"
|
||||
} {
|
||||
rename -status -test test Test
|
||||
rename -status -test test Test
|
||||
}
|
||||
pack $itk_component(k1)
|
||||
}
|
||||
.testOptWidget0 configure -test "bar"
|
||||
.testOptWidget0 component k1 do {set status}
|
||||
@@ -96,14 +96,14 @@ test option-1.3 {"rename" can be called more than once} {
|
||||
|
||||
test option-1.4 {"ignore" overrides keep and rename} {
|
||||
.testOptWidget0 do {
|
||||
itk_component add k2 {
|
||||
TestOptComp $itk_interior.k2 -status "create"
|
||||
} {
|
||||
keep -status
|
||||
rename -status -test test Test
|
||||
ignore -status
|
||||
}
|
||||
pack $itk_component(k2)
|
||||
itk_component add k2 {
|
||||
TestOptComp $itk_interior.k2 -status "create"
|
||||
} {
|
||||
keep -status
|
||||
rename -status -test test Test
|
||||
ignore -status
|
||||
}
|
||||
pack $itk_component(k2)
|
||||
}
|
||||
.testOptWidget0 configure -status k2 -test k2
|
||||
.testOptWidget0 component k2 do {set status}
|
||||
@@ -130,48 +130,48 @@ test option-2.4 {query back unknown "usual" code} {
|
||||
|
||||
test option-2.5 {add a component using "usual" code} {
|
||||
.testUsual do {
|
||||
itk_component add u0 {
|
||||
label $itk_interior.u0 -text "Usual Test #0"
|
||||
} {
|
||||
usual TestOptComp-test
|
||||
}
|
||||
pack $itk_component(u0)
|
||||
itk_component add u0 {
|
||||
label $itk_interior.u0 -text "Usual Test #0"
|
||||
} {
|
||||
usual TestOptComp-test
|
||||
}
|
||||
pack $itk_component(u0)
|
||||
}
|
||||
.testUsual configure -foreground green -cursor gumby
|
||||
|
||||
list [.testUsual component u0 cget -foreground] \
|
||||
[.testUsual component u0 cget -cursor]
|
||||
[.testUsual component u0 cget -cursor]
|
||||
} {green gumby}
|
||||
|
||||
test option-2.6 {override "usual" options} {
|
||||
.testUsual do {
|
||||
itk_component add u1 {
|
||||
label $itk_interior.u1 -text "Usual Test #1"
|
||||
} {
|
||||
usual TestOptComp-test
|
||||
ignore -cursor
|
||||
keep -background
|
||||
}
|
||||
pack $itk_component(u1)
|
||||
itk_component add u1 {
|
||||
label $itk_interior.u1 -text "Usual Test #1"
|
||||
} {
|
||||
usual TestOptComp-test
|
||||
ignore -cursor
|
||||
keep -background
|
||||
}
|
||||
pack $itk_component(u1)
|
||||
}
|
||||
.testUsual configure -foreground red -background white -cursor dot
|
||||
|
||||
list [.testUsual component u1 cget -foreground] \
|
||||
[.testUsual component u1 cget -background] \
|
||||
[.testUsual component u1 cget -cursor]
|
||||
[.testUsual component u1 cget -background] \
|
||||
[.testUsual component u1 cget -cursor]
|
||||
} {red white gumby}
|
||||
|
||||
set unique 0
|
||||
foreach widget {button canvas checkbutton entry frame label listbox
|
||||
menu menubutton message radiobutton scale scrollbar
|
||||
text toplevel} {
|
||||
menu menubutton message radiobutton scale scrollbar
|
||||
text toplevel} {
|
||||
set name "c[incr unique]"
|
||||
test option-2.7.$name {verify "usual" options for all Tk widgets} {
|
||||
.testUsual do [format {
|
||||
itk_component add %s {
|
||||
%s $itk_interior.%s
|
||||
}
|
||||
} $name $widget $name]
|
||||
.testUsual do [format {
|
||||
itk_component add %s {
|
||||
%s $itk_interior.%s
|
||||
}
|
||||
} $name $widget $name]
|
||||
} $name
|
||||
}
|
||||
|
||||
|
||||
+31
-31
@@ -22,13 +22,13 @@ namespace import -force ::tcltest::*
|
||||
# ----------------------------------------------------------------------
|
||||
test privacy-1.1 {define simple mega-widget class} {
|
||||
itcl::class TestPrivacy {
|
||||
inherit itk::Widget
|
||||
constructor {args} {
|
||||
eval itk_initialize $args
|
||||
}
|
||||
method do {args} {
|
||||
return [eval $args]
|
||||
}
|
||||
inherit itk::Widget
|
||||
constructor {args} {
|
||||
eval itk_initialize $args
|
||||
}
|
||||
method do {args} {
|
||||
return [eval $args]
|
||||
}
|
||||
}
|
||||
set testobj [TestPrivacy .#auto]
|
||||
pack $testobj
|
||||
@@ -36,58 +36,58 @@ test privacy-1.1 {define simple mega-widget class} {
|
||||
|
||||
test privacy-1.2 {"itk_component add" requires certain arguments} {
|
||||
list [catch {$testobj do itk_component add foo} msg] $msg \
|
||||
[catch {$testobj do itk_component add foo bar baz qux} msg] $msg
|
||||
[catch {$testobj do itk_component add foo bar baz qux} msg] $msg
|
||||
} {1 {wrong # args: should be "itk_component add ?-protected? ?-private? ?--? name createCmds ?optionCmds?"} 1 {wrong # args: should be "add ?-protected? ?-private? ?--? name createCmds ?optionCmds?}}
|
||||
|
||||
test privacy-1.3 {"itk_component add" rejects invalid options} {
|
||||
list [catch {
|
||||
$testobj do itk_component add -foo bar baz qux
|
||||
} msg] $msg \
|
||||
[catch {
|
||||
$testobj do itk_component add -- -foo {label $itk_interior.l}
|
||||
} msg] $msg
|
||||
$testobj do itk_component add -foo bar baz qux
|
||||
} msg] $msg \
|
||||
[catch {
|
||||
$testobj do itk_component add -- -foo {label $itk_interior.l}
|
||||
} msg] $msg
|
||||
} {1 {bad option "-foo": should be -private, -protected or --} 0 -foo}
|
||||
|
||||
test privacy-1.4 {"itk_component add" recognizes privacy options} {
|
||||
list [catch {
|
||||
$testobj do itk_component add -protected x {label $itk_interior.x}
|
||||
} msg] $msg \
|
||||
[catch {
|
||||
$testobj do itk_component add -private y {label $itk_interior.y}
|
||||
} msg] $msg
|
||||
$testobj do itk_component add -protected x {label $itk_interior.x}
|
||||
} msg] $msg \
|
||||
[catch {
|
||||
$testobj do itk_component add -private y {label $itk_interior.y}
|
||||
} msg] $msg
|
||||
} {0 x 0 y}
|
||||
|
||||
test privacy-1.5 {protected/private components are hidden} {
|
||||
list [lsort [$testobj component]] \
|
||||
[lsort [$testobj do component]]
|
||||
[lsort [$testobj do component]]
|
||||
} {{-foo hull} {-foo hull x y}}
|
||||
|
||||
test privacy-1.6 {define a derived class and add protected/private comps} {
|
||||
itcl::class TestMorePrivacy {
|
||||
inherit TestPrivacy
|
||||
constructor {args} {
|
||||
eval itk_initialize $args
|
||||
}
|
||||
method do {args} {
|
||||
return [eval $args]
|
||||
}
|
||||
inherit TestPrivacy
|
||||
constructor {args} {
|
||||
eval itk_initialize $args
|
||||
}
|
||||
method do {args} {
|
||||
return [eval $args]
|
||||
}
|
||||
}
|
||||
set testobj2 [TestMorePrivacy .#auto]
|
||||
$testobj2 TestPrivacy::do itk_component add -private x {
|
||||
label $itk_interior.x
|
||||
label $itk_interior.x
|
||||
}
|
||||
$testobj2 TestPrivacy::do itk_component add -protected y {
|
||||
label $itk_interior.y
|
||||
label $itk_interior.y
|
||||
}
|
||||
$testobj2 TestPrivacy::do itk_component add z {
|
||||
label $itk_interior.z
|
||||
label $itk_interior.z
|
||||
}
|
||||
} {z}
|
||||
|
||||
test privacy-1.7 {components are visible depending on namespace context} {
|
||||
list [lsort [$testobj2 component]] \
|
||||
[lsort [$testobj2 do component]] \
|
||||
[lsort [$testobj2 TestPrivacy::do component]]
|
||||
[lsort [$testobj2 do component]] \
|
||||
[lsort [$testobj2 TestPrivacy::do component]]
|
||||
} {{hull z} {hull y z} {hull x y z}}
|
||||
|
||||
# ----------------------------------------------------------------------
|
||||
|
||||
+18
-18
@@ -22,17 +22,17 @@ namespace import -force ::tcltest::*
|
||||
# ----------------------------------------------------------------------
|
||||
test public-1.1 {define base class and simple mega-widget class} {
|
||||
itcl::class test_public_base {
|
||||
public variable null
|
||||
public variable background "not used"
|
||||
public variable message
|
||||
public variable null
|
||||
public variable background "not used"
|
||||
public variable message
|
||||
}
|
||||
itcl::configbody test_public_base::message {
|
||||
global ::test_public_status
|
||||
lappend test_public_status "message: $message"
|
||||
global ::test_public_status
|
||||
lappend test_public_status "message: $message"
|
||||
}
|
||||
itcl::configbody test_public_base::background {
|
||||
global ::test_public_status
|
||||
lappend test_public_status "background: $background"
|
||||
global ::test_public_status
|
||||
lappend test_public_status "background: $background"
|
||||
}
|
||||
option add *TestPublic.background red
|
||||
option add *TestPublic.foreground white
|
||||
@@ -40,18 +40,18 @@ test public-1.1 {define base class and simple mega-widget class} {
|
||||
option add *TestPublic.message "Hello, World!"
|
||||
|
||||
itcl::class TestPublic {
|
||||
inherit itk::Widget test_public_base
|
||||
constructor {args} {
|
||||
itk_component add mesg {
|
||||
label $itk_interior.mesg
|
||||
} {
|
||||
keep -background -foreground -cursor
|
||||
rename -text -message message Message
|
||||
}
|
||||
pack $itk_component(mesg) -side left -padx 2
|
||||
inherit itk::Widget test_public_base
|
||||
constructor {args} {
|
||||
itk_component add mesg {
|
||||
label $itk_interior.mesg
|
||||
} {
|
||||
keep -background -foreground -cursor
|
||||
rename -text -message message Message
|
||||
}
|
||||
pack $itk_component(mesg) -side left -padx 2
|
||||
|
||||
eval itk_initialize $args
|
||||
}
|
||||
eval itk_initialize $args
|
||||
}
|
||||
}
|
||||
set testobj [TestPublic .#auto]
|
||||
pack $testobj
|
||||
|
||||
+60
-60
@@ -29,25 +29,25 @@ test toplevel-1.1 {define a toplevel mega-widget class} {
|
||||
option add *TestToplevel.text ""
|
||||
|
||||
itcl::class TestToplevel {
|
||||
inherit itk::Toplevel
|
||||
constructor {args} {
|
||||
itk_component add test1 {
|
||||
label $itk_interior.t1
|
||||
} {
|
||||
keep -background -foreground -cursor
|
||||
keep -text
|
||||
}
|
||||
pack $itk_component(test1) -side left -padx 2
|
||||
eval itk_initialize $args
|
||||
}
|
||||
public method do {cmd} {
|
||||
eval $cmd
|
||||
}
|
||||
inherit itk::Toplevel
|
||||
constructor {args} {
|
||||
itk_component add test1 {
|
||||
label $itk_interior.t1
|
||||
} {
|
||||
keep -background -foreground -cursor
|
||||
keep -text
|
||||
}
|
||||
pack $itk_component(test1) -side left -padx 2
|
||||
eval itk_initialize $args
|
||||
}
|
||||
public method do {cmd} {
|
||||
eval $cmd
|
||||
}
|
||||
|
||||
private variable status ""
|
||||
itk_option define -background background Background {} {
|
||||
lappend status "background: $itk_option(-background)"
|
||||
}
|
||||
private variable status ""
|
||||
itk_option define -background background Background {} {
|
||||
lappend status "background: $itk_option(-background)"
|
||||
}
|
||||
}
|
||||
TestToplevel .#auto
|
||||
} {.testToplevel0}
|
||||
@@ -63,8 +63,8 @@ test toplevel-1.3 {check the list components} {
|
||||
test toplevel-1.4 {check the propagation of configuration options} {
|
||||
.testToplevel0 configure -background red
|
||||
list [.testToplevel0 component hull cget -background] \
|
||||
[.testToplevel0 component test1 cget -background] \
|
||||
[.testToplevel0 do {set status}]
|
||||
[.testToplevel0 component test1 cget -background] \
|
||||
[.testToplevel0 do {set status}]
|
||||
} {red red {{background: linen} {background: red}}}
|
||||
|
||||
test toplevel-1.5 {mega-widgets show up on the object list} {
|
||||
@@ -77,7 +77,7 @@ test toplevel-1.6 {when a mega-widget is destroyed, its object is deleted} {
|
||||
} {}
|
||||
|
||||
test toplevel-1.7 {when an mega-widget object is deleted, its window and any
|
||||
components are destroyed } {
|
||||
components are destroyed } {
|
||||
TestToplevel .delme
|
||||
set label [.delme component test1]
|
||||
itcl::delete object .delme
|
||||
@@ -85,25 +85,25 @@ test toplevel-1.7 {when an mega-widget object is deleted, its window and any
|
||||
} {0 0}
|
||||
|
||||
test toplevel-1.8 {when a mega-widget object is deleted, its window and any
|
||||
components are destroyed (even if in another window) } {
|
||||
components are destroyed (even if in another window) } {
|
||||
catch {destroy .t1}
|
||||
catch {destroy .t2}
|
||||
catch {rename .t2 {}}
|
||||
catch {itcl::delete class ButtonTop}
|
||||
|
||||
itcl::class ButtonTop {
|
||||
inherit itk::Toplevel
|
||||
inherit itk::Toplevel
|
||||
|
||||
constructor {args} {
|
||||
eval itk_initialize $args
|
||||
constructor {args} {
|
||||
eval itk_initialize $args
|
||||
|
||||
itk_component add button {
|
||||
button $itk_option(-container).b -text Button
|
||||
} {}
|
||||
pack $itk_component(button)
|
||||
}
|
||||
itk_component add button {
|
||||
button $itk_option(-container).b -text Button
|
||||
} {}
|
||||
pack $itk_component(button)
|
||||
}
|
||||
|
||||
itk_option define -container container Container {}
|
||||
itk_option define -container container Container {}
|
||||
}
|
||||
|
||||
toplevel .t1
|
||||
@@ -117,25 +117,25 @@ test toplevel-1.8 {when a mega-widget object is deleted, its window and any
|
||||
} {.t1.b 0}
|
||||
|
||||
test toplevel-1.9 {when a window that contains a megawidget component
|
||||
is destroyed, the component is removed from the megawidget} {
|
||||
is destroyed, the component is removed from the megawidget} {
|
||||
catch {destroy .t1}
|
||||
catch {destroy .t2}
|
||||
catch {rename .t2 {}}
|
||||
catch {itcl::delete class ButtonTop}
|
||||
|
||||
itcl::class ButtonTop {
|
||||
inherit itk::Toplevel
|
||||
inherit itk::Toplevel
|
||||
|
||||
constructor {args} {
|
||||
eval itk_initialize $args
|
||||
constructor {args} {
|
||||
eval itk_initialize $args
|
||||
|
||||
itk_component add button {
|
||||
button $itk_option(-container).b -text Button
|
||||
} {}
|
||||
pack $itk_component(button)
|
||||
}
|
||||
itk_component add button {
|
||||
button $itk_option(-container).b -text Button
|
||||
} {}
|
||||
pack $itk_component(button)
|
||||
}
|
||||
|
||||
itk_option define -container container Container {}
|
||||
itk_option define -container container Container {}
|
||||
}
|
||||
|
||||
toplevel .t1
|
||||
@@ -149,36 +149,36 @@ test toplevel-1.9 {when a window that contains a megawidget component
|
||||
} {{button hull} hull}
|
||||
|
||||
test toplevel-1.10 {when destroying a component that is inside another
|
||||
window protect against that case where one component destroy
|
||||
actually destroys other contained components} {
|
||||
window protect against that case where one component destroy
|
||||
actually destroys other contained components} {
|
||||
catch {destroy .t1}
|
||||
catch {destroy .t2}
|
||||
catch {rename .t2 {}}
|
||||
catch {itcl::delete class ButtonTop}
|
||||
|
||||
itcl::class ButtonTop {
|
||||
inherit itk::Toplevel
|
||||
inherit itk::Toplevel
|
||||
|
||||
constructor {args} {
|
||||
eval itk_initialize $args
|
||||
constructor {args} {
|
||||
eval itk_initialize $args
|
||||
|
||||
# Note, the component names matter here since
|
||||
# [.t2 component] returns names in hash order.
|
||||
# We need to delete cframe first since it
|
||||
# is the parent of cbutton.
|
||||
# Note, the component names matter here since
|
||||
# [.t2 component] returns names in hash order.
|
||||
# We need to delete cframe first since it
|
||||
# is the parent of cbutton.
|
||||
|
||||
itk_component add cframe {
|
||||
button $itk_option(-container).cframe
|
||||
} {}
|
||||
pack $itk_component(cframe)
|
||||
itk_component add cframe {
|
||||
button $itk_option(-container).cframe
|
||||
} {}
|
||||
pack $itk_component(cframe)
|
||||
|
||||
itk_component add cbutton {
|
||||
button $itk_component(cframe).b -text Button
|
||||
} {}
|
||||
pack $itk_component(cbutton)
|
||||
}
|
||||
itk_component add cbutton {
|
||||
button $itk_component(cframe).b -text Button
|
||||
} {}
|
||||
pack $itk_component(cbutton)
|
||||
}
|
||||
|
||||
itk_option define -container container Container {}
|
||||
itk_option define -container container Container {}
|
||||
}
|
||||
|
||||
toplevel .t1
|
||||
|
||||
+95
-95
@@ -31,39 +31,39 @@ test widget-1.1 {define a simple mega-widget class} {
|
||||
option add *TestWidget.text ""
|
||||
|
||||
itcl::class TestWidget {
|
||||
inherit itk::Widget
|
||||
constructor {args} {
|
||||
itk_component add test1 {
|
||||
label $itk_interior.t1
|
||||
} {
|
||||
keep -background -foreground -cursor
|
||||
keep -text
|
||||
}
|
||||
pack $itk_component(test1) -side left -padx 2
|
||||
inherit itk::Widget
|
||||
constructor {args} {
|
||||
itk_component add test1 {
|
||||
label $itk_interior.t1
|
||||
} {
|
||||
keep -background -foreground -cursor
|
||||
keep -text
|
||||
}
|
||||
pack $itk_component(test1) -side left -padx 2
|
||||
|
||||
itk_component add test2 {
|
||||
button $itk_interior.t2 -text "Push Me"
|
||||
} {
|
||||
keep -foreground -cursor -borderwidth -command
|
||||
rename -background -normal normal Background
|
||||
rename -activebackground -highlight highlight Foreground
|
||||
}
|
||||
pack $itk_component(test2) -side right -fill x -pady 2
|
||||
itk_component add test2 {
|
||||
button $itk_interior.t2 -text "Push Me"
|
||||
} {
|
||||
keep -foreground -cursor -borderwidth -command
|
||||
rename -background -normal normal Background
|
||||
rename -activebackground -highlight highlight Foreground
|
||||
}
|
||||
pack $itk_component(test2) -side right -fill x -pady 2
|
||||
|
||||
eval itk_initialize $args
|
||||
}
|
||||
private variable status ""
|
||||
public method action {info} {
|
||||
lappend status $info
|
||||
}
|
||||
eval itk_initialize $args
|
||||
}
|
||||
private variable status ""
|
||||
public method action {info} {
|
||||
lappend status $info
|
||||
}
|
||||
|
||||
public method do {cmd} {
|
||||
eval $cmd
|
||||
}
|
||||
public method do {cmd} {
|
||||
eval $cmd
|
||||
}
|
||||
|
||||
itk_option define -status status Status {} {
|
||||
lappend status $itk_option(-status)
|
||||
}
|
||||
itk_option define -status status Status {} {
|
||||
lappend status $itk_option(-status)
|
||||
}
|
||||
}
|
||||
TestWidget .#auto
|
||||
} {.testWidget0}
|
||||
@@ -91,7 +91,7 @@ foreach test {
|
||||
set result [lindex $test 1]
|
||||
|
||||
test widget-1.3.[incr unique] {check individual configuration options} {
|
||||
.testWidget0 configure $opt
|
||||
.testWidget0 configure $opt
|
||||
} $result
|
||||
}
|
||||
|
||||
@@ -112,9 +112,9 @@ foreach test {
|
||||
set value [lindex $test 1]
|
||||
|
||||
test widget-1.4.[incr unique] {set individual configuration options} {
|
||||
list [.testWidget0 configure $opt $value] \
|
||||
[.testWidget0 cget $opt] \
|
||||
[.testWidget0 do "set itk_option($opt)"]
|
||||
list [.testWidget0 configure $opt $value] \
|
||||
[.testWidget0 cget $opt] \
|
||||
[.testWidget0 do "set itk_option($opt)"]
|
||||
} [list "" $value $value]
|
||||
}
|
||||
|
||||
@@ -132,26 +132,26 @@ foreach test {
|
||||
set win [lindex $test 1]
|
||||
|
||||
test widget-1.6 {check the window for each component} {
|
||||
list [.testWidget0 component $name] \
|
||||
[.testWidget0 do "set itk_component($name)"]
|
||||
list [.testWidget0 component $name] \
|
||||
[.testWidget0 do "set itk_component($name)"]
|
||||
} [list $win $win]
|
||||
}
|
||||
|
||||
test widget-1.7 {check the propagation of configuration options} {
|
||||
list [.testWidget0 component hull cget -cursor] \
|
||||
[.testWidget0 component test1 cget -cursor] \
|
||||
[.testWidget0 component test2 cget -cursor]
|
||||
[.testWidget0 component test1 cget -cursor] \
|
||||
[.testWidget0 component test2 cget -cursor]
|
||||
} {trek trek trek}
|
||||
|
||||
test widget-1.8 {check the propagation of configuration options} {
|
||||
list [.testWidget0 component hull cget -background] \
|
||||
[.testWidget0 component test1 cget -background] \
|
||||
[.testWidget0 component test2 cget -background]
|
||||
[.testWidget0 component test1 cget -background] \
|
||||
[.testWidget0 component test2 cget -background]
|
||||
} {red red MistyRose2}
|
||||
|
||||
test widget-1.9 {check the propagation of configuration options} {
|
||||
list [.testWidget0 component test1 cget -text] \
|
||||
[.testWidget0 component test2 cget -text]
|
||||
[.testWidget0 component test2 cget -text]
|
||||
} {Label: {Push Me}}
|
||||
|
||||
test widget-1.10 {check the invocation of "config" code} {
|
||||
@@ -173,17 +173,17 @@ test widget-1.11b {execute some code created by "code" command} {
|
||||
|
||||
test widget-1.12a {components can be added on the fly} {
|
||||
.testWidget0 do {
|
||||
itk_component add test3 {
|
||||
label $itk_interior.t3 -text "Temporary"
|
||||
} {
|
||||
keep -background -foreground -cursor
|
||||
}
|
||||
itk_component add test3 {
|
||||
label $itk_interior.t3 -text "Temporary"
|
||||
} {
|
||||
keep -background -foreground -cursor
|
||||
}
|
||||
}
|
||||
} {test3}
|
||||
|
||||
test widget-1.12b {components can be added on the fly} {
|
||||
.testWidget0 do {
|
||||
pack $itk_component(test3) -fill x
|
||||
pack $itk_component(test3) -fill x
|
||||
}
|
||||
} {}
|
||||
|
||||
@@ -193,8 +193,8 @@ test widget-1.13 {new components show up on the component list} {
|
||||
|
||||
test widget-1.14 {new components are initialized properly} {
|
||||
list [.testWidget0 component test3 cget -background] \
|
||||
[.testWidget0 component test3 cget -foreground] \
|
||||
[.testWidget0 component test3 cget -cursor]
|
||||
[.testWidget0 component test3 cget -foreground] \
|
||||
[.testWidget0 component test3 cget -cursor]
|
||||
} {red IndianRed trek}
|
||||
|
||||
test widget-1.15 {components can be deleted like ordinary widgets} {
|
||||
@@ -245,42 +245,42 @@ test widget-1.24 {recreate another test widget} {
|
||||
|
||||
test widget-1.25 {when an internal component is destroyed, it is removed from the list of components, and any dead options disappear} {
|
||||
list [lsort [.testWidget component]] \
|
||||
[.testWidget configure] \
|
||||
[.testWidget configure] \
|
||||
[catch {destroy [.testWidget component test1]}] \
|
||||
[.testWidget component] \
|
||||
[.testWidget do {return [lsort [array names itk_component]]}] \
|
||||
[.testWidget configure]
|
||||
[.testWidget component] \
|
||||
[.testWidget do {return [lsort [array names itk_component]]}] \
|
||||
[.testWidget configure]
|
||||
} {{hull test1 test2} {{-background background Background linen linen} {-borderwidth borderWidth BorderWidth 2 2} {-clientdata clientData ClientData {} {}} {-command command Command {} {}} {-cursor cursor Cursor {} {}} {-foreground foreground Foreground navy navy} {-highlight highlight Foreground white white} {-normal normal Background ivory ivory} {-status status Status {} {}} {-text text Text {} {}}} 0 {hull test2} {hull test2} {{-background background Background linen linen} {-borderwidth borderWidth BorderWidth 2 2} {-clientdata clientData ClientData {} {}} {-command command Command {} {}} {-cursor cursor Cursor {} {}} {-foreground foreground Foreground navy navy} {-highlight highlight Foreground white white} {-normal normal Background ivory ivory} {-status status Status {} {}}}}
|
||||
|
||||
test widget-1.26 {when an internal component is deleted (but not destroyed) it is disconnected from the option list and its binding tags are updated} {
|
||||
set comp [.testWidget component test2]
|
||||
list [bindtags $comp] \
|
||||
[bind itk-destroy-$comp <Destroy>] \
|
||||
[bind itk-destroy-$comp <Destroy>] \
|
||||
[catch {.testWidget do {itk_component delete test2}}] \
|
||||
[bindtags $comp] \
|
||||
[bind itk-destroy-$comp <Destroy>] \
|
||||
[.testWidget configure]
|
||||
[bindtags $comp] \
|
||||
[bind itk-destroy-$comp <Destroy>] \
|
||||
[.testWidget configure]
|
||||
} {{itk-destroy-.testWidget.t2 .testWidget.t2 Button . all} {namespace inscope ::TestWidget {::.testWidget itk_component delete test2}} 0 {.testWidget.t2 Button . all} {} {{-background background Background linen linen} {-clientdata clientData ClientData {} {}} {-cursor cursor Cursor {} {}} {-status status Status {} {}}}}
|
||||
|
||||
test widget-1.27 {when a mega-widget object is deleted, its window and any
|
||||
components are destroyed (even if in another window) } {
|
||||
components are destroyed (even if in another window) } {
|
||||
catch {destroy .t1}
|
||||
catch {rename .t1.bw {}}
|
||||
catch {itcl::delete class ButtonWidget}
|
||||
|
||||
itcl::class ButtonWidget {
|
||||
inherit itk::Widget
|
||||
inherit itk::Widget
|
||||
|
||||
constructor {args} {
|
||||
eval itk_initialize $args
|
||||
constructor {args} {
|
||||
eval itk_initialize $args
|
||||
|
||||
itk_component add button {
|
||||
button $itk_option(-container).b -text Button
|
||||
} {}
|
||||
pack $itk_component(button)
|
||||
}
|
||||
itk_component add button {
|
||||
button $itk_option(-container).b -text Button
|
||||
} {}
|
||||
pack $itk_component(button)
|
||||
}
|
||||
|
||||
itk_option define -container container Container {}
|
||||
itk_option define -container container Container {}
|
||||
}
|
||||
|
||||
toplevel .t1
|
||||
@@ -299,24 +299,24 @@ test widget-1.27 {when a mega-widget object is deleted, its window and any
|
||||
} {.t1.f.b 0}
|
||||
|
||||
test widget-1.28 {when a window that contains a megawidget component
|
||||
is destroyed, the component is removed from the megawidget} {
|
||||
is destroyed, the component is removed from the megawidget} {
|
||||
catch {destroy .t1}
|
||||
catch {rename .t1.bw {}}
|
||||
catch {itcl::delete class ButtonWidget}
|
||||
|
||||
itcl::class ButtonWidget {
|
||||
inherit itk::Widget
|
||||
inherit itk::Widget
|
||||
|
||||
constructor {args} {
|
||||
eval itk_initialize $args
|
||||
constructor {args} {
|
||||
eval itk_initialize $args
|
||||
|
||||
itk_component add button {
|
||||
button $itk_option(-container).b -text Button
|
||||
} {}
|
||||
pack $itk_component(button)
|
||||
}
|
||||
itk_component add button {
|
||||
button $itk_option(-container).b -text Button
|
||||
} {}
|
||||
pack $itk_component(button)
|
||||
}
|
||||
|
||||
itk_option define -container container Container {}
|
||||
itk_option define -container container Container {}
|
||||
}
|
||||
|
||||
toplevel .t1
|
||||
@@ -336,35 +336,35 @@ test widget-1.28 {when a window that contains a megawidget component
|
||||
} {{button hull} hull}
|
||||
|
||||
test widget-1.29 {when destroying a component that is inside another
|
||||
window protect against that case where one component destroy
|
||||
actually destroys other contained components} {
|
||||
window protect against that case where one component destroy
|
||||
actually destroys other contained components} {
|
||||
catch {destroy .t1}
|
||||
catch {rename .t1.bw {}}
|
||||
catch {itcl::delete class ButtonWidget}
|
||||
|
||||
itcl::class ButtonWidget {
|
||||
inherit itk::Widget
|
||||
inherit itk::Widget
|
||||
|
||||
constructor {args} {
|
||||
eval itk_initialize $args
|
||||
constructor {args} {
|
||||
eval itk_initialize $args
|
||||
|
||||
# Note, the component names matter here since
|
||||
# [.t2 component] returns names in hash order.
|
||||
# We need to delete cframe first since it
|
||||
# is the parent of cbutton.
|
||||
# Note, the component names matter here since
|
||||
# [.t2 component] returns names in hash order.
|
||||
# We need to delete cframe first since it
|
||||
# is the parent of cbutton.
|
||||
|
||||
itk_component add cframe {
|
||||
button $itk_option(-container).cframe
|
||||
} {}
|
||||
pack $itk_component(cframe)
|
||||
itk_component add cframe {
|
||||
button $itk_option(-container).cframe
|
||||
} {}
|
||||
pack $itk_component(cframe)
|
||||
|
||||
itk_component add cbutton {
|
||||
button $itk_component(cframe).b -text Button
|
||||
} {}
|
||||
pack $itk_component(cbutton)
|
||||
}
|
||||
itk_component add cbutton {
|
||||
button $itk_component(cframe).b -text Button
|
||||
} {}
|
||||
pack $itk_component(cbutton)
|
||||
}
|
||||
|
||||
itk_option define -container container Container {}
|
||||
itk_option define -container container Container {}
|
||||
}
|
||||
|
||||
toplevel .t1
|
||||
|
||||
+452
-163
@@ -1,163 +1,452 @@
|
||||
#------------------------------------------------------------- -*- makefile -*-
|
||||
#
|
||||
# Makefile for [Incr Tk] interface
|
||||
#
|
||||
# Basic build, test and install
|
||||
# nmake /f makefile.vc INSTALLDIR=c:\path\to\installdir
|
||||
# nmake /f makefile.vc INSTALLDIR=c:\path\to\installdir test
|
||||
# nmake /f makefile.vc INSTALLDIR=c:\path\to\installdir install
|
||||
#
|
||||
# For other build options (debug, static etc.),
|
||||
# See TIP 477 (https://core.tcl-lang.org/tips/doc/main/tip/477.md) for
|
||||
# detailed documentation.
|
||||
#
|
||||
# See the file "license.terms" for information on usage and redistribution
|
||||
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
#
|
||||
#------------------------------------------------------------------------------
|
||||
|
||||
PROJECT = itk
|
||||
# Tcl 8.6 etc. compile with /DUNICODE. ITK pre-nmake reform compiled
|
||||
# without -DUNICODE. Keep that behaviour for now.
|
||||
USE_WIDECHAR_API = 0
|
||||
NEED_TK = 1
|
||||
|
||||
PRJ_DEFINES = $(PRJ_DEFINES) -Dinline=__inline
|
||||
PRJ_DEFINES = $(PRJ_DEFINES)
|
||||
PRJ_DEFINES = $(PRJ_DEFINES) -I$(TMP_DIR)
|
||||
|
||||
!include "rules-ext.vc"
|
||||
|
||||
# nmakehelp -V <file> <tag> will search the file for tag, skips until a
|
||||
# number and returns all character until a character not in [0-9.ab]
|
||||
# is read.
|
||||
!if [echo REM = This file is generated from Makefile.vc > versions.vc]
|
||||
!endif
|
||||
!if [echo TCL_VERSION_REQ = \>> versions.vc] \
|
||||
&& [nmakehlp -V ..\configure.ac TCL_VERSION_REQ >> versions.vc]
|
||||
!endif
|
||||
!include "versions.vc"
|
||||
|
||||
PRJ_OBJS = \
|
||||
$(TMP_DIR)\itkArchBase.obj \
|
||||
$(TMP_DIR)\itkArchetype.obj \
|
||||
$(TMP_DIR)\itkBase.obj \
|
||||
$(TMP_DIR)\itkCmd.obj \
|
||||
$(TMP_DIR)\itkHelpers.obj \
|
||||
$(TMP_DIR)\itkOption.obj \
|
||||
$(TMP_DIR)\itkUtil.obj \
|
||||
$(TMP_DIR)\itkStubInit.obj
|
||||
|
||||
|
||||
# Uncomment the following line if you want to build and install stubs
|
||||
PRJ_STUBOBJS = $(TMP_DIR)\itkStubLib.obj
|
||||
|
||||
PRJ_HEADERS = \
|
||||
$(GENERICDIR)\itkInt.h \
|
||||
$(GENERICDIR)\itk.h
|
||||
|
||||
# Locate ITCL headers and libraries.
|
||||
# In principle, we don't need the ITCL source directory, and an installed
|
||||
# ITCL should suffice. But that needs additional machinery not implemented
|
||||
# yet.
|
||||
!if [echo ITCL_DIR = \> nmakehlp.out] \
|
||||
|| [nmakehlp -L generic\itcl.h >> nmakehlp.out]
|
||||
!error Could not locate ITCL source directory.
|
||||
!endif
|
||||
# Locate TK headers and libraries.
|
||||
# In principle, we don't need the TK source directory, and an installed
|
||||
# TK should suffice. But that needs additional machinery not implemented
|
||||
# yet.
|
||||
!if [echo TK_DIR = \> nmakehlp.out] \
|
||||
|| [nmakehlp -L generic\tk.h >> nmakehlp.out]
|
||||
!error Could not locate TK source directory.
|
||||
!endif
|
||||
!include nmakehlp.out
|
||||
|
||||
# Get the ITCL version from its configure.ac
|
||||
!if [echo ITCL_DOTVERSION = \> versions.vc] \
|
||||
&& [nmakehlp -V "$(ITCL_DIR)\configure.ac" itcl >> versions.vc]
|
||||
!error Could not retrieve ITCL version.
|
||||
!endif
|
||||
# Get the TK version from its configure.ac
|
||||
!if [echo TK_DOTVERSION = \> versions.vc] \
|
||||
&& [nmakehlp -V "$(TK_DIR)\configure.ac" tk >> versions.vc]
|
||||
!error Could not retrieve TK version.
|
||||
!endif
|
||||
!include versions.vc
|
||||
|
||||
ITCL_VERSION = $(ITCL_DOTVERSION:.=)
|
||||
ITCL_GENERIC_DIR = $(ITCL_DIR)\generic
|
||||
!if $(TCL_MAJOR_VERSION) == 8 || "$(TCL_BUILD_FOR)" == "8"
|
||||
ITCLSTUBLIBNAME = itclstub$(ITCL_VERSION).lib
|
||||
ITCL_LIB_FILE = itcl$(ITCL_VERSION).dll
|
||||
!else
|
||||
ITCLSTUBLIBNAME = itclstub.lib
|
||||
ITCL_LIB_FILE = tcl9itcl$(ITCL_VERSION).dll
|
||||
!endif
|
||||
ITCLSTUBLIB = $(ITCL_DIR)\win\$(BUILDDIRTOP)\$(ITCLSTUBLIBNAME)
|
||||
ITCL_BIN_DIR = $(ITCL_DIR)/win/$(BUILDDIRTOP)
|
||||
|
||||
TK_VERSION = $(TK_DOTVERSION:.=)
|
||||
TK_GENERIC_DIR = $(TK_DIR)\generic
|
||||
TK_XLIB_DIR = $(TK_DIR)\xlib
|
||||
!if $(TCL_MAJOR_VERSION) == 8 || "$(TCL_BUILD_FOR)" == "8"
|
||||
TKSTUBLIBNAME = tkstub$(TK_VERSION).lib
|
||||
!else
|
||||
TKSTUBLIBNAME = tkstub.lib
|
||||
!endif
|
||||
TKSTUBLIB = $(TK_DIR)\win\$(BUILDDIRTOP)\$(TKSTUBLIBNAME)
|
||||
TK_BIN_DIR = $(TK_DIR)/win/$(BUILDDIRTOP)
|
||||
|
||||
PRJ_INCLUDES = -I"$(ITCL_GENERIC_DIR)" -I"$(TK_GENERIC_DIR)" -I"$(TK_XLIB_DIR)"
|
||||
|
||||
!if !$(STATIC_BUILD)
|
||||
PRJ_LIBS = $(ITCLSTUBLIB) $(TKSTUBLIB)
|
||||
!endif
|
||||
|
||||
# Disable standard test target because we have a custom one
|
||||
DISABLE_TARGET_test = 1
|
||||
!include "$(_RULESDIR)\targets.vc"
|
||||
|
||||
# Additional default actions for install
|
||||
install: default-install-docs-n
|
||||
|
||||
# The TIP 477 generation of pkgIndex.tcl from pkgIndex.tcl.in does not include
|
||||
# all replacements below so define our own target.
|
||||
pkgindex: $(OUT_DIR)\pkgIndex.tcl
|
||||
$(OUT_DIR)\pkgIndex.tcl: $(ROOT)\pkgIndex.tcl.in
|
||||
@nmakehlp -s << $** > $@
|
||||
@PACKAGE_NAME@ $(PROJECT)
|
||||
@PACKAGE_VERSION@ $(DOTVERSION)
|
||||
@TCL_VERSION_REQ@ $(TCL_VERSION_REQ)
|
||||
@PKG_LIB_FILE@ $(PRJLIBNAME)
|
||||
@PKG_LIB_FILE8@ $(PRJLIBNAME8)
|
||||
@PKG_LIB_FILE9@ $(PRJLIBNAME9)
|
||||
<<
|
||||
|
||||
$(ROOT)\manifest.uuid:
|
||||
copy $(WIN_DIR)\gitmanifest.in $(ROOT)\manifest.uuid
|
||||
git rev-parse HEAD >>$(ROOT)\manifest.uuid
|
||||
|
||||
$(TMP_DIR)\itkUuid.h: $(ROOT)\manifest.uuid
|
||||
copy $(WIN_DIR)\itkUuid.h.in+$(ROOT)\manifest.uuid $(TMP_DIR)\itkUuid.h
|
||||
|
||||
test: setup $(PROJECT)
|
||||
@echo testing itk
|
||||
@set ITK_LIBRARY=$(LIBDIR:\=/)
|
||||
@$(CPY) $(LIBDIR)\*.tcl $(OUT_DIR)
|
||||
!if $(TKINSTALL)
|
||||
@set PATH=$(_TKDIR)\bin;$(PATH)
|
||||
$(DEBUGGER) $(WISH) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS)
|
||||
!else
|
||||
@set PATH=$(_TKDIR)\win\$(BUILDDIRTOP);$(PATH)
|
||||
$(DEBUGGER) $(WISH) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) \
|
||||
-load "package ifneeded itk $(DOTVERSION) \
|
||||
{source {$(LIBDIR:\=/)/itk.tcl};load {$(PRJLIB:\=/)} [string totitle $(PROJECT)]};\
|
||||
package ifneeded itcl $(ITCL_DOTVERSION) \
|
||||
{source {$(ITCL_BIN_DIR:\=/)/itcl.tcl};load {$(ITCL_BIN_DIR:\=/)/$(ITCL_LIB_FILE)} Itcl}"
|
||||
!endif
|
||||
|
||||
|
||||
# Explicit dependency rules
|
||||
$(GENERICDIR)\itkBase.c : $(TMP_DIR)\itkUuid.h
|
||||
#------------------------------------------------------------------------------
|
||||
# Visual C++ 6.0+ makefile for [Incr Tk]
|
||||
#
|
||||
# See the file "license.terms" for information on usage and redistribution
|
||||
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
#
|
||||
# Copyright (c) 1993-1998 Lucent Technologies, Inc.
|
||||
#------------------------------------------------------------------------------
|
||||
# To build (after setting up Visual C++ command line environment),
|
||||
# nmake -f makefile.vc TCLDIR=path_to_tcl_sources TKDIR=path_to_tk_sources
|
||||
# To install
|
||||
# nmake -f makefile.vc TCLDIR=path_to_tcl_sources TKDIR=path_to_tk_sources INSTALLDIR=path_to_install_dir install
|
||||
|
||||
!if !exist("makefile.vc")
|
||||
MSG = ^
|
||||
You must run this makefile only from the directory it is in.^
|
||||
Please `cd` to its location first.
|
||||
!error $(MSG)
|
||||
!endif
|
||||
|
||||
PROJECT = itk
|
||||
PROJECT_REQUIRES_TK = 1
|
||||
ITCLDIR = ..\..\itcl
|
||||
!include "$(ITCLDIR)\win\rules.vc"
|
||||
|
||||
!if $(TCLINSTALL)
|
||||
!message *** Warning: [Incr Tk] requires the source distribution of Tcl to build from,
|
||||
!message *** at this time, sorry. Please set the TCLDIR and TKDIR macros to point
|
||||
!message *** to the sources.
|
||||
!endif
|
||||
|
||||
!if [echo REM = This file is generated from makefile.vc > versions.vc]
|
||||
!endif
|
||||
!if [echo ITCL_MAJOR_VERSION = \>> versions.vc] \
|
||||
&& [nmakehlp -V $(ITCLDIR)\generic\itcl.h ITCL_MAJOR_VERSION >> versions.vc]
|
||||
!endif
|
||||
!if [echo ITCL_MINOR_VERSION = \>> versions.vc] \
|
||||
&& [nmakehlp -V $(ITCLDIR)\generic\itcl.h ITCL_MINOR_VERSION >> versions.vc]
|
||||
!endif
|
||||
!if [echo ITCL_PATCH_LEVEL = \>> versions.vc] \
|
||||
&& [nmakehlp -V $(ITCLDIR)\generic\itcl.h ITCL_PATCH_LEVEL >> versions.vc]
|
||||
!endif
|
||||
!if [echo ITK_MAJOR_VERSION = \>> versions.vc] \
|
||||
&& [nmakehlp -V ..\generic\itk.h ITK_MAJOR_VERSION >> versions.vc]
|
||||
!endif
|
||||
!if [echo ITK_MINOR_VERSION = \>> versions.vc] \
|
||||
&& [nmakehlp -V ..\generic\itk.h ITK_MINOR_VERSION >> versions.vc]
|
||||
!endif
|
||||
!if [echo ITK_PATCH_LEVEL = \>> versions.vc] \
|
||||
&& [nmakehlp -V ..\generic\itk.h ITK_PATCH_LEVEL >> versions.vc]
|
||||
!endif
|
||||
!include "versions.vc"
|
||||
ITCL_VERSION = $(ITCL_MAJOR_VERSION)$(ITCL_MINOR_VERSION)
|
||||
ITK_VERSION = $(ITK_MAJOR_VERSION)$(ITK_MINOR_VERSION)
|
||||
DOTVERSION = $(ITK_PATCH_LEVEL)
|
||||
|
||||
BINROOT = .
|
||||
ROOT = ..
|
||||
STUBPREFIX = $(PROJECT)stub
|
||||
|
||||
PKGINDEX = "$(TMP_DIR)\pkgIndex.tcl"
|
||||
|
||||
ITCLLIBNAME = itcl$(ITCL_VERSION)$(SUFX).$(EXT)
|
||||
ITCLLIB = "$(ITCLDIR)\win\$(OUT_DIR)\$(ITCLLIBNAME)"
|
||||
ITKIMPLIB = "$(OUT_DIR)\$(PROJECT)$(ITK_VERSION)$(SUFX).lib"
|
||||
ITKSTUBLIBNAME = $(STUBPREFIX)$(ITK_VERSION).lib
|
||||
ITKSTUBLIB = "$(OUT_DIR)\$(ITKSTUBLIBNAME)"
|
||||
|
||||
ITKLIBNAME = $(PROJECT)$(ITK_VERSION)$(SUFX).$(EXT)
|
||||
ITCLIMPLIBNAME = itcl$(ITCL_VERSION)$(SUFX).$(EXT)
|
||||
ITKLIB = "$(OUT_DIR)\$(ITKLIBNAME)"
|
||||
ITCLIMPLIB = "$(ITCLDIR)\win\$(BUILDDIRTOP)\$(ITCLIMPLIBNAME)"
|
||||
|
||||
|
||||
TKSTUBLIB = $(TKDIR)\win\$(BUILDDIRTOP)\tkstub$(TCL_VERSION).lib
|
||||
TKIMPLIB = $(TKDIR)\win\$(BUILDDIRTOP)\tk$(TCL_VERSION)$(DBGX).lib
|
||||
WISH = $(TKDIR)\win\$(BUILDDIRTOP)\wish$(TCL_VERSION)$(DBGX).exe
|
||||
TCL_LIBRARY = $(TCLDIR)\library
|
||||
TK_LIBRARY = $(TKDIR)\library
|
||||
ITCL_LIBRARY = $(ITCLDIR:\=/)/library
|
||||
ITK_LIBRARY = $(ROOT)/library
|
||||
|
||||
ITCLSTUBLIBNAME = itclstub$(ITCL_VERSION).lib
|
||||
ITCLSTUBLIB = $(ITCLDIR)\win\$(BUILDDIRTOP)\$(ITCLSTUBLIBNAME)
|
||||
|
||||
BIN_INSTALL_DIR = $(_INSTALLDIR)\..\bin
|
||||
DOC_INSTALL_DIR = $(_INSTALLDIR)\..\doc
|
||||
LIB_INSTALL_DIR = $(_INSTALLDIR)
|
||||
SCRIPT_INSTALL_DIR = $(_INSTALLDIR)\$(PROJECT)$(DOTVERSION)
|
||||
INCLUDE_INSTALL_DIR = $(_INSTALLDIR)\..\include
|
||||
|
||||
ITKOBJS = \
|
||||
$(TMP_DIR)\itkArchBase.obj \
|
||||
$(TMP_DIR)\itkArchetype.obj \
|
||||
$(TMP_DIR)\itkBase.obj \
|
||||
$(TMP_DIR)\itkCmd.obj \
|
||||
$(TMP_DIR)\itkHelpers.obj \
|
||||
$(TMP_DIR)\itkOption.obj \
|
||||
$(TMP_DIR)\itkUtil.obj \
|
||||
!if !$(STATIC_BUILD)
|
||||
$(TMP_DIR)\dllEntryPoint.obj \
|
||||
$(TMP_DIR)\itk.res \
|
||||
!endif
|
||||
$(TMP_DIR)\itkStubInit.obj
|
||||
|
||||
ITKSTUBOBJS = \
|
||||
$(TMP_DIR)\itkStubLib.obj
|
||||
|
||||
GENERICDIR = $(ROOT)\generic
|
||||
DOCDIR = $(ROOT)\doc
|
||||
WINDIR = $(ROOT)\win
|
||||
RCDIR = $(ROOT)\win\rc
|
||||
TOOLSDIR = ..\..\tools
|
||||
|
||||
#---------------------------------------------------------------------
|
||||
# Link flags
|
||||
#---------------------------------------------------------------------
|
||||
|
||||
!if $(DEBUG)
|
||||
ldebug = -debug:full -debugtype:cv
|
||||
!else
|
||||
ldebug = -release -opt:ref -opt:icf,3
|
||||
!endif
|
||||
|
||||
# declarations common to all linker options
|
||||
lflags = -nologo -machine:$(MACHINE) $(ldebug)
|
||||
|
||||
!if $(PROFILE)
|
||||
lflags = $(lflags) -profile
|
||||
!endif
|
||||
|
||||
!if $(ALIGN98_HACK) && !$(STATIC_BUILD)
|
||||
# align sections for PE size savings.
|
||||
lflags = $(lflags) -opt:nowin98
|
||||
!else if !$(ALIGN98_HACK) && $(STATIC_BUILD)
|
||||
# align sections for speed in loading by choosing the virtual page size.
|
||||
lflags = $(lflags) -align:4096
|
||||
!endif
|
||||
|
||||
!if $(LOIMPACT)
|
||||
lflags = $(lflags) -ws:aggressive
|
||||
!endif
|
||||
|
||||
ITK_LFLAGS = $(lflags) -subsystem:windows -dll
|
||||
ITK_LLIBS = $(TCLSTUBLIB) $(TKSTUBLIB) $(ITCLSTUBLIB)
|
||||
|
||||
!if exist("$(TCLDIR)\win\coffbase.txt")
|
||||
ITK_DLLBASE = -base:@$(TCLDIR)\win\coffbase.txt,itk
|
||||
!else
|
||||
ITK_DLLBASE =
|
||||
!endif
|
||||
|
||||
baselibs =
|
||||
# Avoid 'unresolved external symbol __security_cookie' errors.
|
||||
# c.f. http://support.microsoft.com/?id=894573
|
||||
!if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64"
|
||||
!if $(VCVERSION) > 1399 && $(VCVERSION) < 1500
|
||||
baselibs = $(baselibs) bufferoverflowU.lib
|
||||
!endif
|
||||
!endif
|
||||
|
||||
#---------------------------------------------------------------------
|
||||
# Compile flags
|
||||
#---------------------------------------------------------------------
|
||||
|
||||
!if !$(DEBUG)
|
||||
!if $(OPTIMIZING)
|
||||
### This cranks the optimization level to maximize speed
|
||||
cdebug = -O2 $(OPTIMIZATIONS)
|
||||
!else
|
||||
cdebug =
|
||||
!endif
|
||||
!if $(SYMBOLS)
|
||||
cdebug = $(cdebug) -Zi
|
||||
!endif
|
||||
!else if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64"
|
||||
### Warnings are too many, can't support warnings into errors.
|
||||
cdebug = -Zi -Od $(DEBUGFLAGS)
|
||||
!else
|
||||
cdebug = -Zi -WX $(DEBUGFLAGS)
|
||||
!endif
|
||||
|
||||
### Declarations common to all compiler options
|
||||
cwarn = $(WARNINGS) -D _CRT_SECURE_NO_DEPRECATE -D _CRT_NONSTDC_NO_DEPRECATE
|
||||
cflags = -nologo -c $(COMPILERFLAGS) $(cwarn) -Fp$(TMP_DIR)^\
|
||||
|
||||
!if $(MSVCRT)
|
||||
!if $(DEBUG) && !$(UNCHECKED)
|
||||
crt = -MDd
|
||||
!else
|
||||
crt = -MD
|
||||
!endif
|
||||
!else
|
||||
!if $(DEBUG) && !$(UNCHECKED)
|
||||
crt = -MTd
|
||||
!else
|
||||
crt = -MT
|
||||
!endif
|
||||
!endif
|
||||
|
||||
!if $(TCLINSTALL)
|
||||
TCL_INCLUDES = -I"$(TCLDIR)\include"
|
||||
TK_INCLUDES =
|
||||
!else
|
||||
TCL_INCLUDES = -I"$(TCLDIR)\generic" -I"$(TCLDIR)\win"
|
||||
TK_INCLUDES = -I"$(TKDIR)\generic" -I"$(TKDIR)\xlib"
|
||||
!endif
|
||||
|
||||
ITK_INCLUDES = -I$(WINDIR) -I$(GENERICDIR)
|
||||
ITCL_INCLUDES = -I"$(ITCLDIR)\generic"
|
||||
ITK_DEFINES = -DBUILD_itk -DTCL_THREADS=1
|
||||
ITK_EXE_CFLAGS = $(cdebug) $(cflags) $(crt) $(ITCL_INCLUDES) $(ITK_INCLUDES) \
|
||||
$(TCL_INCLUDES) $(TK_INCLUDES) $(ITK_DEFINES)
|
||||
|
||||
### By convention, static builds do not use Stubs. This is just a practice,
|
||||
### not a technical limitation.
|
||||
!if $(STATIC_BUILD)
|
||||
ITK_CFLAGS = $(ITK_EXE_CFLAGS) -DSTATIC_BUILD $(OPTDEFINES)
|
||||
!else
|
||||
ITK_CFLAGS = $(ITK_EXE_CFLAGS) -DUSE_TCL_STUBS -DUSE_TK_STUBS -DUSE_ITCL_STUBS $(OPTDEFINES)
|
||||
!endif
|
||||
|
||||
#---------------------------------------------------------------------
|
||||
# Project specific targets
|
||||
#---------------------------------------------------------------------
|
||||
|
||||
all : setup $(ITKLIB) $(ITKSTUBLIB)
|
||||
release : setup $(ITKLIB) $(ITKSTUBLIB)
|
||||
install : install-binaries install-docs
|
||||
|
||||
(ROOT)\manifest.uuid:
|
||||
copy $(WIN_DIR)\gitmanifest.in $(ROOT)\manifest.uuid
|
||||
git rev-parse HEAD >>$(ROOT)\manifest.uuid
|
||||
|
||||
$(TMP_DIR)\itkUuid.h: $(ROOT)\manifest.uuid
|
||||
copy $(WIN_DIR)\itclUuid.h.in+$(ROOT)\manifest.uuid $(TMP_DIR)\itkUuid.h
|
||||
|
||||
(TMP_DIR)\itkBase.obj: $(TMP_DIR)\itkUuid.h
|
||||
|
||||
pkgindex: $(OUT_DIR)\pkgIndex.tcl
|
||||
$(OUT_DIR)\pkgIndex.tcl:
|
||||
@$(COPY) << "$(OUT_DIR)\pkgIndex.tcl"
|
||||
# -*- tcl -*-
|
||||
# Tcl package index file, version 1.1
|
||||
#
|
||||
|
||||
if {![package vsatisfies [package provide Tcl] 8.6-]} {return}
|
||||
|
||||
if {[package vsatisfies [package provide Tcl] 9.0-]} {
|
||||
package ifneeded itk $(DOTVERSION) \
|
||||
[list load [file join $$dir tcl9itk$(VERSION).dll] Itk]
|
||||
} else {
|
||||
package ifneeded itcl $(DOTVERSION) \
|
||||
[list load [file join $$dir itk$(VERSION).dll] Itk]
|
||||
}
|
||||
package ifneeded Itk $(DOTVERSION) [list package require -exact itk $(DOTVERSION)]
|
||||
<<
|
||||
|
||||
|
||||
!if $(STATIC_BUILD)
|
||||
test :
|
||||
@echo test target not supported for a static library.
|
||||
!else
|
||||
test : setup $(ITKLIB) $(ITKSTUBLIB)
|
||||
set TCL_LIBRARY=$(TCL_LIBRARY)
|
||||
set TK_LIBRARY=$(TK_LIBRARY)
|
||||
set ITCL_LIBRARY=$(ITCL_LIBRARY)
|
||||
set ITK_LIBRARY=$(ITK_LIBRARY)
|
||||
$(TCLSH) ..\tests\all.tcl $(TESTFLAGS) -loadfile <<
|
||||
load [file normalize $(ITCLLIB:\=/)] Itcl
|
||||
load [file normalize $(ITKLIB:\=/)] Itk
|
||||
<<
|
||||
!endif
|
||||
|
||||
setup :
|
||||
@if not exist $(TMP_DIR)\nul mkdir $(TMP_DIR)
|
||||
@if not exist $(OUT_DIR)\nul mkdir $(OUT_DIR)
|
||||
|
||||
$(ITKLIB): $(ITKOBJS)
|
||||
!if $(STATIC_BUILD)
|
||||
$(lib32) -nologo -machine:$(MACHINE) -out:$@ @<<
|
||||
!else
|
||||
$(link32) $(ITK_LFLAGS) $(ITK_DLLBASE) -out:$@ $(ITK_LLIBS) $(baselibs) @<<
|
||||
!endif
|
||||
$(ITKOBJS)
|
||||
<<
|
||||
|
||||
|
||||
$(ITKSTUBLIB) : $(ITKSTUBOBJS)
|
||||
$(lib32) -nologo -out:$@ $(ITKSTUBOBJS)
|
||||
|
||||
install-binaries:
|
||||
if not exist "$(_INSTALLDIR)" mkdir "$(_INSTALLDIR)"
|
||||
if not exist "$(BIN_INSTALL_DIR)" mkdir "$(BIN_INSTALL_DIR)"
|
||||
if not exist "$(LIB_INSTALL_DIR)" mkdir "$(LIB_INSTALL_DIR)"
|
||||
if not exist "$(SCRIPT_INSTALL_DIR)" mkdir "$(SCRIPT_INSTALL_DIR)"
|
||||
if not exist "$(INCLUDE_INSTALL_DIR)" mkdir "$(INCLUDE_INSTALL_DIR)"
|
||||
copy $(ITKLIB) "$(SCRIPT_INSTALL_DIR)"
|
||||
!if $(ITKSTUBLIB) != ""
|
||||
copy $(ITKSTUBLIB) "$(LIB_INSTALL_DIR)"
|
||||
!endif
|
||||
copy $(ROOT)\generic\itk.h "$(INCLUDE_INSTALL_DIR)"
|
||||
copy $(ROOT)\generic\itkDecls.h "$(INCLUDE_INSTALL_DIR)"
|
||||
copy $(ROOT)\library\*.* "$(SCRIPT_INSTALL_DIR)"
|
||||
|
||||
|
||||
#---------------------------------------------------------------------
|
||||
# Regenerate the stubs files.
|
||||
#---------------------------------------------------------------------
|
||||
|
||||
!if !$(TCLINSTALL)
|
||||
# Only from the sources of Tcl does genStubs.tcl exist.
|
||||
genstubs:
|
||||
$(TCLSH) $(TOOLSDIR)\genStubs.tcl $(GENERICDIR) \
|
||||
$(GENERICDIR)\itk.decls
|
||||
!else
|
||||
genstubs:
|
||||
@echo ERROR: Can't rebuild stubs tables without the Tcl source distribution
|
||||
!endif
|
||||
|
||||
#---------------------------------------------------------------------
|
||||
# Special case object file targets
|
||||
#---------------------------------------------------------------------
|
||||
|
||||
# The following object is part of the stub library and should not
|
||||
# be built as DLL objects but none of the symbols should be exported
|
||||
|
||||
$(TMP_DIR)\itkStubLib.obj : $(GENERICDIR)\itkStubLib.c
|
||||
$(cc32) -DSTATIC_BUILD $(ITK_EXE_CFLAGS) -Zl -Fo$@ $?
|
||||
|
||||
#---------------------------------------------------------------------
|
||||
# Inference rules.
|
||||
#---------------------------------------------------------------------
|
||||
|
||||
{$(WINDIR)}.c{$(TMP_DIR)}.obj ::
|
||||
$(cc32) $(ITK_CFLAGS) -Fo$(TMP_DIR)\ @<<
|
||||
$<
|
||||
<<
|
||||
|
||||
{$(GENERICDIR)}.c{$(TMP_DIR)}.obj ::
|
||||
$(cc32) $(ITK_CFLAGS) -Fo$(TMP_DIR)\ @<<
|
||||
$<
|
||||
<<
|
||||
|
||||
{$(RCDIR)}.rc{$(TMP_DIR)}.res :
|
||||
$(rc32) -fo $@ -DDEBUG=$(DEBUG) $(ITK_INCLUDES) $(TCL_INCLUDES) $(ITCL_INCLUDES) $(ITK_DEFINES) $<
|
||||
|
||||
#---------------------------------------------------------------------
|
||||
# Generate the windows help files.
|
||||
#---------------------------------------------------------------------
|
||||
|
||||
HLPBASE = $(PROJECT)$(ITK_VERSION)
|
||||
HELPFILE = $(OUT_DIR)\$(HLPBASE).hlp
|
||||
HELPCNT = $(OUT_DIR)\$(HLPBASE).cnt
|
||||
DOCTMP_DIR = $(OUT_DIR)\$(PROJECT)_docs
|
||||
HELPRTF = $(DOCTMP_DIR)\$(PROJECT).rtf
|
||||
MAN2HELP = $(DOCTMP_DIR)\man2help.tcl
|
||||
MAN2HELP2 = $(DOCTMP_DIR)\man2help2.tcl
|
||||
INDEX = $(DOCTMP_DIR)\index.tcl
|
||||
BMP = $(DOCTMP_DIR)\toaster.bmp
|
||||
BMP_NOPATH = toaster.bmp
|
||||
MAN2TCL = $(DOCTMP_DIR)\man2tcl.exe
|
||||
|
||||
winhelp: docsetup $(HELPFILE)
|
||||
|
||||
docsetup:
|
||||
@if not exist $(DOCTMP_DIR)\nul mkdir $(DOCTMP_DIR)
|
||||
|
||||
$(MAN2HELP) $(MAN2HELP2) $(INDEX): $(TCLTOOLSDIR)\$$(@F)
|
||||
copy $(TCLTOOLSDIR)\$(@F) $(@D)
|
||||
|
||||
$(BMP):
|
||||
copy $(WINDIR)\$(@F) $(@D)
|
||||
|
||||
$(HELPFILE): $(HELPRTF) $(BMP)
|
||||
cd $(DOCTMP_DIR)
|
||||
start /wait hcrtf.exe -x <<$(PROJECT).hpj
|
||||
[OPTIONS]
|
||||
COMPRESS=12 Hall Zeck
|
||||
LCID=0x409 0x0 0x0 ; English (United States)
|
||||
TITLE=[Incr Tk] Reference Manual
|
||||
BMROOT=.
|
||||
CNT=$(@B).cnt
|
||||
HLP=$(@B).hlp
|
||||
|
||||
[FILES]
|
||||
$(PROJECT).rtf
|
||||
|
||||
[WINDOWS]
|
||||
main="[Incr Tk] Reference Manual",,27648,(r15263976),(r65280)
|
||||
|
||||
[CONFIG]
|
||||
BrowseButtons()
|
||||
CreateButton(1, "Web", ExecFile("http://www.tcl.tk"))
|
||||
CreateButton(2, "SF", ExecFile("http://sf.net/projects/incrtcl"))
|
||||
CreateButton(3, "Wiki", ExecFile("http://wiki.tcl.tk"))
|
||||
CreateButton(4, "FAQ", ExecFile("http://www.purl.org/NET/Tcl-FAQ/"))
|
||||
<<
|
||||
cd $(MAKEDIR)
|
||||
copy "$(DOCTMP_DIR)\$(@B).hlp" "$(OUT_DIR)"
|
||||
copy "$(DOCTMP_DIR)\$(@B).cnt" "$(OUT_DIR)"
|
||||
|
||||
$(MAN2TCL): $(TCLTOOLSDIR)\$$(@B).c
|
||||
$(cc32) -nologo -G4 -ML -O2 -Fo$(@D)\ $(TCLTOOLSDIR)\$(@B).c $(baselibs) -link -out:$@
|
||||
|
||||
$(HELPRTF): $(MAN2TCL) $(MAN2HELP) $(MAN2HELP2) $(INDEX)
|
||||
$(TCLSH) $(MAN2HELP) -bitmap $(BMP_NOPATH) $(PROJECT) $(ITK_VERSION) $(DOCDIR:\=/)
|
||||
|
||||
install-docs:
|
||||
!if exist($(HELPFILE))
|
||||
@xcopy /i /y "$(HELPFILE)" "$(DOC_INSTALL_DIR)\"
|
||||
@xcopy /i /y "$(HELPCNT)" "$(DOC_INSTALL_DIR)\"
|
||||
$(TCLSH) <<
|
||||
puts "Installing $(PROJECT)'s helpfile contents into Tcl's ..."
|
||||
set f [open {$(DOC_INSTALL_DIR:\=/)/tcl$(TCL_VERSION).cnt} r]
|
||||
while {![eof $$f]} {
|
||||
if {[regexp {:Include $(PROJECT)([0-9]{2}).cnt} [gets $$f] dummy ver]} {
|
||||
if {$$ver == $(ITK_VERSION)} {
|
||||
puts "Already installed."
|
||||
exit
|
||||
} else {
|
||||
# do something here logical to remove (or replace) it.
|
||||
puts "$$ver != $(ITK_VERSION), unfinished code path, die, die!"
|
||||
exit 1
|
||||
}
|
||||
}
|
||||
}
|
||||
close $$f
|
||||
set f [open {$(DOC_INSTALL_DIR:\=/)/tcl$(TCL_VERSION).cnt} a]
|
||||
puts $$f {:Include $(HLPBASE).cnt}
|
||||
close $$f
|
||||
<<
|
||||
start /wait winhlp32 -g $(DOC_INSTALL_DIR)\tcl$(TCL_VERSION).hlp
|
||||
!endif
|
||||
|
||||
#---------------------------------------------------------------------
|
||||
# Clean up
|
||||
#---------------------------------------------------------------------
|
||||
|
||||
tidy :
|
||||
-del $(TMP_DIR)\*.pch
|
||||
-del $(TMP_DIR)\*.obj
|
||||
-del $(TMP_DIR)\*.res
|
||||
|
||||
clean : tidy
|
||||
-del $(OUT_DIR)\*.exp
|
||||
-del $(OUT_DIR)\*.lib
|
||||
-del $(OUT_DIR)\*.dll
|
||||
|
||||
hose : clean
|
||||
-rmdir $(OUT_DIR)
|
||||
-rmdir $(TMP_DIR)
|
||||
|
||||
+40
-54
@@ -4,8 +4,8 @@
|
||||
*
|
||||
* This is used to fix limitations within nmake and the environment.
|
||||
*
|
||||
* Copyright (c) 2002 David Gravereaux.
|
||||
* Copyright (c) 2006 Pat Thoyts
|
||||
* Copyright (c) 2002 by David Gravereaux.
|
||||
* Copyright (c) 2006 by Pat Thoyts
|
||||
*
|
||||
* See the file "license.terms" for information on usage and redistribution of
|
||||
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
@@ -19,18 +19,10 @@
|
||||
#pragma comment (lib, "kernel32.lib")
|
||||
#endif
|
||||
#include <stdio.h>
|
||||
|
||||
/*
|
||||
* This library is required for x64 builds with _some_ versions of MSVC
|
||||
*/
|
||||
#if defined(_M_IA64) || defined(_M_AMD64)
|
||||
#if _MSC_VER >= 1400 && _MSC_VER < 1500
|
||||
#pragma comment(lib, "bufferoverflowU")
|
||||
#endif
|
||||
#endif
|
||||
#include <math.h>
|
||||
|
||||
/* ISO hack for dumb VC++ */
|
||||
#if defined(_WIN32) && defined(_MSC_VER) && _MSC_VER < 1900
|
||||
#ifdef _MSC_VER
|
||||
#define snprintf _snprintf
|
||||
#endif
|
||||
|
||||
@@ -90,7 +82,7 @@ main(
|
||||
case 'c':
|
||||
if (argc != 3) {
|
||||
chars = snprintf(msg, sizeof(msg) - 1,
|
||||
"usage: %s -c <compiler option>\n"
|
||||
"usage: %s -c <compiler option>\n"
|
||||
"Tests for whether cl.exe supports an option\n"
|
||||
"exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]);
|
||||
WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
|
||||
@@ -101,7 +93,7 @@ main(
|
||||
case 'l':
|
||||
if (argc < 3) {
|
||||
chars = snprintf(msg, sizeof(msg) - 1,
|
||||
"usage: %s -l <linker option> ?<mandatory option> ...?\n"
|
||||
"usage: %s -l <linker option> ?<mandatory option> ...?\n"
|
||||
"Tests for whether link.exe supports an option\n"
|
||||
"exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]);
|
||||
WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
|
||||
@@ -206,25 +198,25 @@ CheckForCompilerFeature(
|
||||
|
||||
hProcess = GetCurrentProcess();
|
||||
|
||||
memset(&pi, 0, sizeof(PROCESS_INFORMATION));
|
||||
memset(&si, 0, sizeof(STARTUPINFO));
|
||||
ZeroMemory(&pi, sizeof(PROCESS_INFORMATION));
|
||||
ZeroMemory(&si, sizeof(STARTUPINFO));
|
||||
si.cb = sizeof(STARTUPINFO);
|
||||
si.dwFlags = STARTF_USESTDHANDLES;
|
||||
si.hStdInput = INVALID_HANDLE_VALUE;
|
||||
|
||||
memset(&sa, 0, sizeof(SECURITY_ATTRIBUTES));
|
||||
ZeroMemory(&sa, sizeof(SECURITY_ATTRIBUTES));
|
||||
sa.nLength = sizeof(SECURITY_ATTRIBUTES);
|
||||
sa.lpSecurityDescriptor = NULL;
|
||||
sa.bInheritHandle = FALSE;
|
||||
|
||||
/*
|
||||
* Create a non-inheritable pipe.
|
||||
* Create a non-inheritible pipe.
|
||||
*/
|
||||
|
||||
CreatePipe(&Out.pipe, &h, &sa, 0);
|
||||
|
||||
/*
|
||||
* Dupe the write side, make it inheritable, and close the original.
|
||||
* Dupe the write side, make it inheritible, and close the original.
|
||||
*/
|
||||
|
||||
DuplicateHandle(hProcess, h, hProcess, &si.hStdOutput, 0, TRUE,
|
||||
@@ -318,11 +310,11 @@ CheckForCompilerFeature(
|
||||
*/
|
||||
|
||||
return !(strstr(Out.buffer, "D4002") != NULL
|
||||
|| strstr(Err.buffer, "D4002") != NULL
|
||||
|| strstr(Out.buffer, "D9002") != NULL
|
||||
|| strstr(Err.buffer, "D9002") != NULL
|
||||
|| strstr(Out.buffer, "D2021") != NULL
|
||||
|| strstr(Err.buffer, "D2021") != NULL);
|
||||
|| strstr(Err.buffer, "D4002") != NULL
|
||||
|| strstr(Out.buffer, "D9002") != NULL
|
||||
|| strstr(Err.buffer, "D9002") != NULL
|
||||
|| strstr(Out.buffer, "D2021") != NULL
|
||||
|| strstr(Err.buffer, "D2021") != NULL);
|
||||
}
|
||||
|
||||
static int
|
||||
@@ -342,13 +334,13 @@ CheckForLinkerFeature(
|
||||
|
||||
hProcess = GetCurrentProcess();
|
||||
|
||||
memset(&pi, 0, sizeof(PROCESS_INFORMATION));
|
||||
memset(&si, 0, sizeof(STARTUPINFO));
|
||||
ZeroMemory(&pi, sizeof(PROCESS_INFORMATION));
|
||||
ZeroMemory(&si, sizeof(STARTUPINFO));
|
||||
si.cb = sizeof(STARTUPINFO);
|
||||
si.dwFlags = STARTF_USESTDHANDLES;
|
||||
si.hStdInput = INVALID_HANDLE_VALUE;
|
||||
|
||||
memset(&sa, 0, sizeof(SECURITY_ATTRIBUTES));
|
||||
ZeroMemory(&sa, sizeof(SECURITY_ATTRIBUTES));
|
||||
sa.nLength = sizeof(SECURITY_ATTRIBUTES);
|
||||
sa.lpSecurityDescriptor = NULL;
|
||||
sa.bInheritHandle = TRUE;
|
||||
@@ -360,7 +352,7 @@ CheckForLinkerFeature(
|
||||
CreatePipe(&Out.pipe, &h, &sa, 0);
|
||||
|
||||
/*
|
||||
* Dupe the write side, make it inheritable, and close the original.
|
||||
* Dupe the write side, make it inheritible, and close the original.
|
||||
*/
|
||||
|
||||
DuplicateHandle(hProcess, h, hProcess, &si.hStdOutput, 0, TRUE,
|
||||
@@ -493,9 +485,9 @@ IsIn(
|
||||
|
||||
/*
|
||||
* GetVersionFromFile --
|
||||
* Looks for a match string in a file and then returns the version
|
||||
* following the match where a version is anything acceptable to
|
||||
* package provide or package ifneeded.
|
||||
* Looks for a match string in a file and then returns the version
|
||||
* following the match where a version is anything acceptable to
|
||||
* package provide or package ifneeded.
|
||||
*/
|
||||
|
||||
static const char *
|
||||
@@ -592,7 +584,7 @@ list_free(list_item_t **listPtrPtr)
|
||||
* SubstituteFile --
|
||||
* As windows doesn't provide anything useful like sed and it's unreliable
|
||||
* to use the tclsh you are building against (consider x-platform builds -
|
||||
* e.g. compiling AMD64 target from IX86) we provide a simple substitution
|
||||
* eg compiling AMD64 target from IX86) we provide a simple substitution
|
||||
* option here to handle autoconf style substitutions.
|
||||
* The substitution file is whitespace and line delimited. The file should
|
||||
* consist of lines matching the regular expression:
|
||||
@@ -600,9 +592,9 @@ list_free(list_item_t **listPtrPtr)
|
||||
*
|
||||
* Usage is something like:
|
||||
* nmakehlp -S << $** > $@
|
||||
* @PACKAGE_NAME@ $(PACKAGE_NAME)
|
||||
* @PACKAGE_VERSION@ $(PACKAGE_VERSION)
|
||||
* <<
|
||||
* @PACKAGE_NAME@ $(PACKAGE_NAME)
|
||||
* @PACKAGE_VERSION@ $(PACKAGE_VERSION)
|
||||
* <<
|
||||
*/
|
||||
|
||||
static int
|
||||
@@ -618,7 +610,7 @@ SubstituteFile(
|
||||
if (fp != NULL) {
|
||||
|
||||
/*
|
||||
* Build a list of substitutions from the first filename
|
||||
* Build a list of substutitions from the first filename
|
||||
*/
|
||||
|
||||
sp = fopen(substitutions, "rt");
|
||||
@@ -726,13 +718,11 @@ static int LocateDependencyHelper(const char *dir, const char *keypath)
|
||||
int keylen, ret;
|
||||
WIN32_FIND_DATA finfo;
|
||||
|
||||
if (dir == NULL || keypath == NULL) {
|
||||
if (dir == NULL || keypath == NULL)
|
||||
return 2; /* Have no real error reporting mechanism into nmake */
|
||||
}
|
||||
dirlen = strlen(dir);
|
||||
if (dirlen > sizeof(path) - 3) {
|
||||
if ((dirlen + 3) > sizeof(path))
|
||||
return 2;
|
||||
}
|
||||
strncpy(path, dir, dirlen);
|
||||
strncpy(path+dirlen, "\\*", 3); /* Including terminating \0 */
|
||||
keylen = strlen(keypath);
|
||||
@@ -747,9 +737,8 @@ static int LocateDependencyHelper(const char *dir, const char *keypath)
|
||||
#else
|
||||
hSearch = FindFirstFile(path, &finfo);
|
||||
#endif
|
||||
if (hSearch == INVALID_HANDLE_VALUE) {
|
||||
if (hSearch == INVALID_HANDLE_VALUE)
|
||||
return 1; /* Not found */
|
||||
}
|
||||
|
||||
/* Loop through all subdirs checking if the keypath is under there */
|
||||
ret = 1; /* Assume not found */
|
||||
@@ -759,13 +748,11 @@ static int LocateDependencyHelper(const char *dir, const char *keypath)
|
||||
* We need to check it is a directory despite the
|
||||
* FindExSearchLimitToDirectories in the above call. See SDK docs
|
||||
*/
|
||||
if ((finfo.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) == 0) {
|
||||
if ((finfo.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) == 0)
|
||||
continue;
|
||||
}
|
||||
sublen = strlen(finfo.cFileName);
|
||||
if ((dirlen+1+sublen+1+keylen+1) > sizeof(path)) {
|
||||
if ((dirlen+1+sublen+1+keylen+1) > sizeof(path))
|
||||
continue; /* Path does not fit, assume not matched */
|
||||
}
|
||||
strncpy(path+dirlen+1, finfo.cFileName, sublen);
|
||||
path[dirlen+1+sublen] = '\\';
|
||||
strncpy(path+dirlen+1+sublen+1, keypath, keylen+1);
|
||||
@@ -785,13 +772,13 @@ static int LocateDependencyHelper(const char *dir, const char *keypath)
|
||||
* LocateDependency --
|
||||
*
|
||||
* Locates a dependency for a package.
|
||||
* keypath - a relative path within the package directory
|
||||
* that is used to confirm it is the correct directory.
|
||||
* keypath - a relative path within the package directory
|
||||
* that is used to confirm it is the correct directory.
|
||||
* The search path for the package directory is currently only
|
||||
* the parent and grandparent of the current working directory.
|
||||
* If found, the command prints
|
||||
* name_DIRPATH=<full path of located directory>
|
||||
* and returns 0. If not found, does not print anything and returns 1.
|
||||
* the parent and grandparent of the current working directory.
|
||||
* If found, the command prints
|
||||
* name_DIRPATH=<full path of located directory>
|
||||
* and returns 0. If not found, does not print anything and returns 1.
|
||||
*/
|
||||
static int LocateDependency(const char *keypath)
|
||||
{
|
||||
@@ -801,9 +788,8 @@ static int LocateDependency(const char *keypath)
|
||||
|
||||
for (i = 0; i < (sizeof(paths)/sizeof(paths[0])); ++i) {
|
||||
ret = LocateDependencyHelper(paths[i], keypath);
|
||||
if (ret == 0) {
|
||||
if (ret == 0)
|
||||
return ret;
|
||||
}
|
||||
}
|
||||
return ret;
|
||||
}
|
||||
|
||||
@@ -1,141 +0,0 @@
|
||||
# This file should only be included in makefiles for Tcl extensions,
|
||||
# NOT in the makefile for Tcl itself.
|
||||
|
||||
!ifndef _RULES_EXT_VC
|
||||
|
||||
# We need to run from the directory the parent makefile is located in.
|
||||
# nmake does not tell us what makefile was used to invoke it so parent
|
||||
# makefile has to set the MAKEFILEVC macro or we just make a guess and
|
||||
# warn if we think that is not the case.
|
||||
!if "$(MAKEFILEVC)" == ""
|
||||
|
||||
!if exist("$(PROJECT).vc")
|
||||
MAKEFILEVC = $(PROJECT).vc
|
||||
!elseif exist("makefile.vc")
|
||||
MAKEFILEVC = makefile.vc
|
||||
!endif
|
||||
!endif # "$(MAKEFILEVC)" == ""
|
||||
|
||||
!if !exist("$(MAKEFILEVC)")
|
||||
MSG = ^
|
||||
You must run nmake from the directory containing the project makefile.^
|
||||
If you are doing that and getting this message, set the MAKEFILEVC^
|
||||
macro to the name of the project makefile.
|
||||
!message WARNING: $(MSG)
|
||||
!endif
|
||||
|
||||
!if "$(PROJECT)" == "tcl"
|
||||
!error The rules-ext.vc file is not intended for Tcl itself.
|
||||
!endif
|
||||
|
||||
# We extract version numbers using the nmakehlp program. For now use
|
||||
# the local copy of nmakehlp. Once we locate Tcl, we will use that
|
||||
# one if it is newer.
|
||||
!if [$(CC) -nologo -DNDEBUG "nmakehlp.c" -link -subsystem:console > nul]
|
||||
!endif
|
||||
|
||||
# We need a nmakehlp that will run on the host machine as part of the build.
|
||||
# if TCLSH_NATIVE is set for cross compilation, we'll try to find an associated
|
||||
# nmakehlp.exe that runs on the build architecture.
|
||||
!ifdef TCLSH_NATIVE
|
||||
!ifndef NMAKEHLP_NATIVE
|
||||
!if [$(TCLSH_NATIVE) $(TCLDIR)\win\find_nmakehlp.tcl $(TCLSH_NATIVE) > find_nmakehlp.out]
|
||||
!error TCLSH_NATIVE is set, but unable to find associated nmakehlp.exe nearby.
|
||||
!else
|
||||
!include find_nmakehlp.out
|
||||
!endif
|
||||
!endif
|
||||
!endif
|
||||
|
||||
!ifndef NMAKEHLP_NATIVE
|
||||
NMAKEHLP_NATIVE=nmakehlp
|
||||
!endif
|
||||
|
||||
# First locate the Tcl directory that we are working with.
|
||||
!if "$(TCLDIR)" != ""
|
||||
|
||||
_RULESDIR = $(TCLDIR:/=\)
|
||||
|
||||
!else
|
||||
|
||||
# If an installation path is specified, that is also the Tcl directory.
|
||||
# Also Tk never builds against an installed Tcl, it needs Tcl sources
|
||||
!if defined(INSTALLDIR) && "$(PROJECT)" != "tk"
|
||||
_RULESDIR=$(INSTALLDIR:/=\)
|
||||
!else
|
||||
# Locate Tcl sources
|
||||
!if [echo _RULESDIR = \> nmakehlp.out] \
|
||||
|| [$(NMAKEHLP_NATIVE) -L generic\tcl.h >> nmakehlp.out]
|
||||
_RULESDIR = ..\..\tcl
|
||||
!else
|
||||
!include nmakehlp.out
|
||||
!endif
|
||||
|
||||
!endif # defined(INSTALLDIR)....
|
||||
|
||||
!endif # ifndef TCLDIR
|
||||
|
||||
# Now look for the targets.vc file under the Tcl root. Note we check this
|
||||
# file and not rules.vc because the latter also exists on older systems.
|
||||
!if exist("$(_RULESDIR)\lib\nmake\targets.vc") # Building against installed Tcl
|
||||
_RULESDIR = $(_RULESDIR)\lib\nmake
|
||||
!elseif exist("$(_RULESDIR)\win\targets.vc") # Building against Tcl sources
|
||||
_RULESDIR = $(_RULESDIR)\win
|
||||
!else
|
||||
# If we have not located Tcl's targets file, most likely we are compiling
|
||||
# against an older version of Tcl and so must use our own support files.
|
||||
_RULESDIR = .
|
||||
!endif
|
||||
|
||||
!if "$(_RULESDIR)" != "."
|
||||
# Potentially using Tcl's support files. If this extension has its own
|
||||
# nmake support files, need to compare the versions and pick newer.
|
||||
|
||||
!if exist("rules.vc") # The extension has its own copy
|
||||
|
||||
!if [echo TCL_RULES_MAJOR = \> versions.vc] \
|
||||
&& [$(NMAKEHLP_NATIVE) -V "$(_RULESDIR)\rules.vc" RULES_VERSION_MAJOR >> versions.vc]
|
||||
!endif
|
||||
!if [echo TCL_RULES_MINOR = \>> versions.vc] \
|
||||
&& [$(NMAKEHLP_NATIVE) -V "$(_RULESDIR)\rules.vc" RULES_VERSION_MINOR >> versions.vc]
|
||||
!endif
|
||||
|
||||
!if [echo OUR_RULES_MAJOR = \>> versions.vc] \
|
||||
&& [$(NMAKEHLP_NATIVE) -V "rules.vc" RULES_VERSION_MAJOR >> versions.vc]
|
||||
!endif
|
||||
!if [echo OUR_RULES_MINOR = \>> versions.vc] \
|
||||
&& [$(NMAKEHLP_NATIVE) -V "rules.vc" RULES_VERSION_MINOR >> versions.vc]
|
||||
!endif
|
||||
!include versions.vc
|
||||
# We have a newer version of the support files, use them
|
||||
!if ($(TCL_RULES_MAJOR) != $(OUR_RULES_MAJOR)) || ($(TCL_RULES_MINOR) < $(OUR_RULES_MINOR))
|
||||
_RULESDIR = .
|
||||
!endif
|
||||
|
||||
!endif # if exist("rules.vc")
|
||||
|
||||
!endif # if $(_RULESDIR) != "."
|
||||
|
||||
# Let rules.vc know what copy of nmakehlp.c to use.
|
||||
NMAKEHLPC = $(_RULESDIR)\nmakehlp.c
|
||||
|
||||
# Get rid of our internal defines before calling rules.vc
|
||||
!undef TCL_RULES_MAJOR
|
||||
!undef TCL_RULES_MINOR
|
||||
!undef OUR_RULES_MAJOR
|
||||
!undef OUR_RULES_MINOR
|
||||
|
||||
!if exist("$(_RULESDIR)\rules.vc")
|
||||
!include "$(_RULESDIR)\rules.vc"
|
||||
!ifndef VERBOSE
|
||||
# Backward compatibility
|
||||
VERBOSE=1
|
||||
!endif
|
||||
!if $(VERBOSE)
|
||||
!message *** Using $(_RULESDIR)\rules.vc
|
||||
!endif
|
||||
!else
|
||||
!error *** Could not locate rules.vc in $(_RULESDIR)
|
||||
!endif
|
||||
|
||||
!endif # _RULES_EXT_VC
|
||||
-1960
File diff suppressed because it is too large
Load Diff
Binary file not shown.
Reference in New Issue
Block a user