├── .cvsignore ├── ChangeLog ├── Makefile.in ├── README.md ├── README.txt ├── aclocal.m4 ├── benchmarks ├── cps.tcl ├── methcall.tcl └── objinst.tcl ├── config.h.in ├── configure ├── configure.in ├── doc ├── Class.3 ├── Method.3 ├── OOInitStubs.3 ├── class.n ├── copy.n ├── define.n ├── my.n ├── next.n ├── object.n ├── ooInfo.n └── self.n ├── generic ├── pkgoo.c ├── tclOO.c ├── tclOO.decls ├── tclOO.h ├── tclOOBasic.c ├── tclOOCall.c ├── tclOODecls.h ├── tclOODefineCmds.c ├── tclOOInfo.c ├── tclOOInt.h ├── tclOOIntDecls.h ├── tclOOMethod.c ├── tclOOStubInit.c └── tclOOStubLib.c ├── license.terms ├── tclconfig ├── ChangeLog ├── README.txt ├── install-sh └── tcl.m4 ├── tclooConfig.sh.in ├── tests ├── all.tcl ├── load.test ├── oo.test └── ooNext2.test └── win └── TclOO.rc /.cvsignore: -------------------------------------------------------------------------------- 1 | *.dll 2 | *.so 3 | *.lib 4 | *.a 5 | *.obj 6 | *.o 7 | *.kit 8 | Makefile 9 | autom4te.cache 10 | config.* 11 | pkgIndex.tcl 12 | .settings 13 | .project 14 | .cdtproject 15 | tclooConfig.sh 16 | *.dylib 17 | .cproject 18 | .DS_Store 19 | -------------------------------------------------------------------------------- /Makefile.in: -------------------------------------------------------------------------------- 1 | # 2 | # @configure_input@ 3 | # 4 | 5 | #======================================================================== 6 | # All these assignments are substituted by configure 7 | #======================================================================== 8 | 9 | PKG_SOURCES = @PKG_SOURCES@ 10 | PKG_OBJECTS = @PKG_OBJECTS@ 11 | 12 | PKG_STUB_SOURCES = @PKG_STUB_SOURCES@ 13 | PKG_STUB_OBJECTS = @PKG_STUB_OBJECTS@ 14 | 15 | PKG_TEST_SOURCES = @PKG_TEST_SOURCES@ 16 | PKG_TEST_OBJECTS = @PKG_TEST_OBJECTS@ 17 | 18 | PKG_TCL_SOURCES = @PKG_TCL_SOURCES@ 19 | 20 | PKG_HEADERS = @PKG_HEADERS@ 21 | PKG_PRIVATE_HEADERS=@PKG_PRIVATE_HEADERS@ 22 | 23 | PKG_LIB_FILE = @PKG_LIB_FILE@ 24 | PKG_TEST_LIB_FILE = @PKG_TEST_LIB_FILE@ 25 | PKG_STUB_LIB_FILE = @PKG_STUB_LIB_FILE@ 26 | 27 | SHELL = @SHELL@ 28 | 29 | srcdir = @srcdir@ 30 | prefix = @prefix@ 31 | exec_prefix = @exec_prefix@ 32 | 33 | bindir = @bindir@ 34 | libdir = @libdir@ 35 | includedir = @includedir@ 36 | datarootdir = @datarootdir@ 37 | datadir = @datadir@ 38 | mandir = @mandir@ 39 | 40 | DESTDIR = 41 | 42 | INSTALL_OPTIONS = 43 | INSTALL = $(SHELL) $(srcdir)/tclconfig/install-sh -c ${INSTALL_OPTIONS} 44 | INSTALL_DATA_DIR = ${INSTALL} -d -m 755 45 | INSTALL_PROGRAM = ${INSTALL} -m 555 46 | INSTALL_DATA = ${INSTALL} -m 444 47 | INSTALL_SCRIPT = ${INSTALL_PROGRAM} 48 | INSTALL_LIBRARY = ${INSTALL_DATA} 49 | 50 | PACKAGE_NAME = @PACKAGE_NAME@ 51 | PACKAGE_VERSION = @PACKAGE_VERSION@ 52 | CC = @CC@ 53 | CFLAGS_DEFAULT = @CFLAGS_DEFAULT@ 54 | CFLAGS_WARNING = @CFLAGS_WARNING@ 55 | 56 | CLEANFILES=@CLEANFILES@ 57 | EXEEXT=@EXEEXT@ 58 | LDFLAGS_DEFAULT=@LDFLAGS_DEFAULT@ 59 | MAKE_LIB=@MAKE_LIB@ 60 | MAKE_SHARED_LIB=@MAKE_SHARED_LIB@ 61 | MAKE_STATIC_LIB=@MAKE_STATIC_LIB@ 62 | MAKE_STUB_LIB=@MAKE_STUB_LIB@ 63 | MAKE_TEST_LIB=@MAKE_TEST_LIB@ 64 | OBJEXT=@OBJEXT@ 65 | RANLIB=@RANLIB@ 66 | RANLIB_STUB=@RANLIB_STUB@ 67 | SHLIB_CFLAGS=@SHLIB_CFLAGS@ 68 | SHLIB_LD=@SHLIB_LD@ 69 | SHLIB_LD_LIBS=@SHLIB_LD_LIBS@ 70 | STLIB_LD=@STLIB_LD@ 71 | TCL_SRC_DIR=@TCL_SRC_DIR@ 72 | TCL_BIN_DIR=@TCL_BIN_DIR@ 73 | # Not actually used, but can help when tracing errors 74 | #TCL_LIBS=@TCL_LIBS@ 75 | #MT=@MT@ 76 | TCLSH_PROG=@TCLSH_PROG@ 77 | INCLUDES=@PKG_INCLUDES@ @TCL_INCLUDES@ 78 | PKG_CFLAGS=@PKG_CFLAGS@ 79 | DEFS=@DEFS@ $(PKG_CFLAGS) 80 | CPPFLAGS=@CPPFLAGS@ 81 | LIBS=@PKG_LIBS@ @LIBS@ @MATH_LIBS@ 82 | PKG_TEST_LIBS=${PKG_STUB_LIB_FILE} 83 | AR=@AR@ 84 | CFLAGS=@CFLAGS@ 85 | CYGPATH=@CYGPATH@ 86 | SDX=@SDX@ 87 | #RC=@RC@ 88 | #RCFLAGS=@RES_DEFS@ 89 | #RES=@RES_SUFFIX@ 90 | #ADD_MANIFEST=@ADD_MANIFEST@ 91 | 92 | EXTRA_PATH = $(top_builddir):$(TCL_BIN_DIR) 93 | PKG_ENV = TCL_LIBRARY=`@CYGPATH@ $(TCL_SRC_DIR)/library` \ 94 | @LD_LIBRARY_PATH_VAR@="$(EXTRA_PATH):$(@LD_LIBRARY_PATH_VAR@)" \ 95 | PATH="$(EXTRA_PATH):$(PATH)" \ 96 | TCLLIBPATH="$(top_builddir)" 97 | TCLSH_PROG = @TCLSH_PROG@ 98 | TCLSH = $(PKG_ENV) $(TCLSH_PROG) 99 | 100 | #======================================================================== 101 | # None of these assignments are substituted by configure 102 | #======================================================================== 103 | 104 | SRC_DIR=$(srcdir) 105 | BINARIES=$(PKG_LIB_FILE) $(PKG_STUB_LIB_FILE) $(PKG_TEST_LIB_FILE) 106 | PKG_DIR=$(PACKAGE_NAME)$(PACKAGE_VERSION) 107 | PKG_KIT_ROOT=$(PKG_DIR)-$(PLATFORM) 108 | PKG_KIT=$(PKG_KIT_ROOT).kit 109 | pkglibdir=$(libdir)/$(PKG_DIR) 110 | top_builddir=. 111 | TCL_VERSION_REQ=8.5b1 112 | GDB=gdb 113 | VALGRIND=valgrind 114 | CONFIG_CLEAN_FILES="Makefile tclooConfig.sh" 115 | COMPILE=$(CC) $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS) 116 | VPATH=$(SRC_DIR)/generic:$(SRC_DIR)/unix:$(SRC_DIR)/win:$(SRC_DIR)/macosx:$(SRC_DIR) 117 | TESTFLAGS= 118 | KIT_PKG_ROOT=$(PKG_KIT_ROOT).vfs/lib/$(PACKAGE_NAME) 119 | ITERATIONS=1000 120 | TCL_TOOLS_DIR=$(TCL_SRC_DIR)/tools 121 | 122 | #======================================================================== 123 | # This is something that is found by executing a Tcl script 124 | #======================================================================== 125 | 126 | PLATFORM:=$(shell echo 'package require platform;puts [platform::generic]' | $(TCLSH)) 127 | 128 | #======================================================================== 129 | # Master rules 130 | #======================================================================== 131 | 132 | all: package libraries 133 | package: $(PKG_LIB_FILE) pkgIndex.tcl 134 | testpackage: $(PKG_TEST_LIB_FILE) 135 | libraries: $(PKG_STUB_LIB_FILE) 136 | install: all install-package install-libraries install-headers install-doc 137 | kit: sdx_valid $(PKG_KIT) 138 | 139 | #======================================================================== 140 | # Basic installation rules 141 | #======================================================================== 142 | 143 | install-package: package 144 | @mkdir -p $(DESTDIR)$(pkglibdir) 145 | $(INSTALL_PROGRAM) $(PKG_LIB_FILE) $(DESTDIR)$(pkglibdir)/$(PKG_LIB_FILE) 146 | $(INSTALL_DATA) pkgIndex.tcl $(DESTDIR)$(pkglibdir)/pkgIndex.tcl 147 | $(INSTALL_DATA) tclooConfig.sh $(DESTDIR)$(pkglibdir)/tclooConfig.sh 148 | # for p in $(SRC_DIR)/library/*.tcl ; do \ 149 | # destp=`basename $$p`; \ 150 | # echo " Install $$destp $(DESTDIR)$(pkglibdir)/$$destp"; \ 151 | # $(INSTALL_DATA) $$p $(DESTDIR)$(pkglibdir)/$$destp; \ 152 | # done 153 | install-headers: 154 | @echo "Installing header files in $(DESTDIR)$(includedir)" 155 | @mkdir -p $(DESTDIR)$(includedir) 156 | @list='$(PKG_HEADERS)'; for p in $$list; do \ 157 | echo "Installing $(SRC_DIR)/$$p" ; \ 158 | destp=`basename $$p`; \ 159 | $(INSTALL_DATA) $(SRC_DIR)/$$p $(DESTDIR)$(includedir)/$$destp ; \ 160 | done; 161 | install-private-headers: 162 | @echo "Installing private header files in $(DESTDIR)$(includedir)" 163 | @mkdir -p $(DESTDIR)$(includedir) 164 | @list='$(PKG_PRIVATE_HEADERS)'; for p in $$list; do \ 165 | echo "Installing $(SRC_DIR)/$$p" ; \ 166 | destp=`basename $$p`; \ 167 | $(INSTALL_DATA) $(SRC_DIR)/$$p $(DESTDIR)$(includedir)/$$destp ; \ 168 | done; 169 | install-libraries: libraries 170 | @echo "Installing $(PKG_STUB_LIB_FILE) in $(DESTDIR)$(pkglibdir)" 171 | @mkdir -p $(DESTDIR)$(pkglibdir) 172 | $(INSTALL_DATA) $(PKG_STUB_LIB_FILE) $(DESTDIR)$(pkglibdir) 173 | 174 | #======================================================================== 175 | # Install documentation. Unix manpages should go in the $(mandir) directory. 176 | #======================================================================== 177 | 178 | install-doc: doc 179 | @echo "Installing documentation in $(DESTDIR)$(mandir)" 180 | @mkdir -p $(DESTDIR)$(mandir)/mann 181 | @list='$(SRC_DIR)/doc/*.n'; for i in $$list; do \ 182 | echo "Installing $$i"; \ 183 | rm -f $(DESTDIR)$(mandir)/mann/`basename $$i`; \ 184 | $(INSTALL_DATA) $$i $(DESTDIR)$(mandir)/mann ; \ 185 | done 186 | @mkdir -p $(DESTDIR)$(mandir)/man3 187 | @list='$(SRC_DIR)/doc/*.3'; for i in $$list; do \ 188 | echo "Installing $$i"; \ 189 | rm -f $(DESTDIR)$(mandir)/man3/`basename $$i`; \ 190 | $(INSTALL_DATA) $$i $(DESTDIR)$(mandir)/man3 ; \ 191 | done 192 | 193 | # A do-nothing target at the moment 194 | doc: 195 | 196 | #======================================================================== 197 | # Run the test suite or benchmarks for the package, or just start a shell 198 | # primed to load the package. 199 | #======================================================================== 200 | 201 | test: package testpackage libraries 202 | @echo $(TCLSH_PROG) $(SRC_DIR)/tests/all.tcl $(TESTLOAD) $(TESTFLAGS) 203 | @$(TCLSH) `$(CYGPATH) $(SRC_DIR)/tests/all.tcl` $(TESTLOAD) $(TESTFLAGS) 204 | 205 | benchmarks: package libraries 206 | @echo Benchmark Iterations = $(ITERATIONS) 207 | @list='$(SRC_DIR)/benchmarks/*.tcl'; for i in $$list; do \ 208 | echo "Benchmarking $$i"; \ 209 | time $(TCLSH) `$(CYGPATH) $$i` $(ITERATIONS); \ 210 | done 211 | 212 | shell: package libraries 213 | @echo $(TCLSH_PROG) $(SCRIPT) 214 | @$(TCLSH) $(SCRIPT) 215 | 216 | valgrind: package libraries 217 | @echo $(VALGRIND) $(TCLSH_PROG) $(SCRIPT) 218 | @$(PKG_ENV) $(VALGRIND) $(TCLSH_PROG) $(SCRIPT) 219 | 220 | valgrindtest: package libraries 221 | @echo $(VALGRIND) $(TCLSH_PROG) $(SRC_DIR)/tests/all.tcl $(TESTLOAD) $(TESTFLAGS) 222 | @$(PKG_ENV) $(VALGRIND) $(TCLSH_PROG) `$(CYGPATH) $(SRC_DIR)/tests/all.tcl` $(TESTLOAD) $(TESTFLAGS) -singleproc 1 223 | 224 | valgrindshell: binaries libraries 225 | $(PKG_ENV) valgrind $(VALGRINDARGS) $(TCLSH_PROG) $(SCRIPT) 226 | 227 | #======================================================================== 228 | # These rules say how to run tclsh in a hostile Windows environment, while 229 | # still working on Unix. 230 | #======================================================================== 231 | 232 | gdb.run: 233 | @echo "catch {puts \"target exec [file attributes [file normalize [info nameofexecutable]] -shortname]\";exit};puts \"target exec [file normalize [info nameofexecutable]]\"" | $(TCLSH) > $@ 234 | @echo "set env TCL_LIBRARY=$(TCL_SRC_DIR)/library" >> $@ 235 | @echo "set env LD_LIBRARY_PATH=$(EXTRA_PATH):$(LD_LIBRARY_PATH)" >> $@ 236 | @echo "set env TCLLIBPATH=$(top_builddir)" >> $@ 237 | @sh -c 'test x$${OSTYPE} = xmsys && echo "set new-console off" >> $@' || true 238 | 239 | gdb: package libraries gdb.run 240 | @echo gdb $(TCLSH_PROG) $(ARGS) 241 | @gdb --command=gdb.run $(ARGS) 242 | @rm gdb.run 243 | gdbtest: package libraries gdb.run 244 | @echo "set args `$(CYGPATH) $(SRC_DIR)/tests/all.tcl` $(TESTLOAD) $(TESTFLAGS) -singleproc 1" >>gdb.run 245 | @echo gdb $(TCLSH_PROG) $(MANGLED) 246 | @gdb --command=gdb.run 247 | @rm gdb.run 248 | 249 | #======================================================================== 250 | # The rules for actually doing the build of the package. 251 | #======================================================================== 252 | 253 | $(PKG_LIB_FILE): $(PKG_OBJECTS) 254 | -rm -f $(PKG_LIB_FILE) 255 | ${MAKE_LIB} 256 | $(RANLIB) $(PKG_LIB_FILE) 257 | $(PKG_STUB_LIB_FILE): $(PKG_STUB_OBJECTS) 258 | -rm -f $(PKG_STUB_LIB_FILE) 259 | ${MAKE_STUB_LIB} 260 | $(RANLIB_STUB) $(PKG_STUB_LIB_FILE) 261 | $(PKG_TEST_LIB_FILE): $(PKG_STUB_LIB_FILE) 262 | $(MAKE) PKG_TEST_LIB_FILE=dummy PKG_LIB_FILE=$(PKG_TEST_LIB_FILE) \ 263 | PKG_OBJECTS="$(PKG_TEST_OBJECTS)" \ 264 | LIBS="$(PKG_TEST_LIBS)" \ 265 | CFLAGS="${SHLIB_CFLAGS} -DUSE_TCL_STUBS -DUSE_TCLOO_STUBS" \ 266 | $(PKG_TEST_LIB_FILE) 267 | .c.@OBJEXT@: 268 | $(COMPILE) -c `$(CYGPATH) $<` -o $@ 269 | .rc.$(RES): 270 | $(RC) $@ $(RCFLAGS) "$<" 271 | pkgIndex.tcl: Makefile 272 | -@echo Creating pkgIndex.tcl 273 | @( \ 274 | echo 'if {[catch {package require Tcl $(TCL_VERSION_REQ)}]} return'; \ 275 | echo 'package ifneeded $(PACKAGE_NAME) $(PACKAGE_VERSION) \ 276 | [list load [file join $$dir $(PKG_LIB_FILE)] $(PACKAGE_NAME)]' \ 277 | ) > pkgIndex.tcl 278 | Makefile: $(SRC_DIR)/Makefile.in $(top_builddir)/config.status 279 | cd $(top_builddir) \ 280 | && CONFIG_FILES=$@ CONFIG_HEADERS= $(SHELL) ./config.status 281 | 282 | #======================================================================== 283 | # How to rebuild the package's stub table. 284 | #======================================================================== 285 | 286 | genstubs: $(TCL_TOOLS_DIR)/genStubs.tcl $(SRC_DIR)/generic/tclOO.decls 287 | @echo $(TCLSH_PROG) $(TCL_TOOLS_DIR)/genStubs.tcl $(SRC_DIR)/generic $(SRC_DIR)/generic/tclOO.decls 288 | @$(TCLSH) `$(CYGPATH) $(TCL_TOOLS_DIR)/genStubs.tcl` `$(CYGPATH) $(SRC_DIR)/generic` `$(CYGPATH) $(SRC_DIR)/generic/tclOO.decls` 289 | 290 | #======================================================================== 291 | # Build a starkit - this is experimental! 292 | #======================================================================== 293 | 294 | sdx_valid: 295 | @test "$(SDX)" != "none" || ( echo "Cannot build kit; no sdx!"; false ) 296 | $(PKG_KIT): $(PKG_LIB_FILE) 297 | -@mkdir -p $(KIT_PKG_ROOT)/$(PLATFORM) 298 | cp $(PKG_LIB_FILE) $(KIT_PKG_ROOT)/$(PLATFORM) 299 | -@echo Creating $(KIT_PKG_ROOT)/pkgIndex.tcl 300 | @( \ 301 | echo 'if {[catch {package require Tcl $(TCL_VERSION_REQ)}]} return'; \ 302 | echo 'package ifneeded $(PACKAGE_NAME) $(PACKAGE_VERSION)' \ 303 | '[list load [file join $$dir $(PLATFORM) $(PKG_LIB_FILE)] $(PACKAGE_NAME)]' \ 304 | ) > $(KIT_PKG_ROOT)/pkgIndex.tcl 305 | $(SDX) wrap $(PKG_KIT) 306 | -@rm -rf $(PKG_KIT_ROOT).vfs $(PKG_KIT_ROOT).bat 307 | 308 | #======================================================================== 309 | # How to clean up after a build. 310 | #======================================================================== 311 | 312 | clean: 313 | -test -z "$(BINARIES)" || rm -f $(BINARIES) 314 | -rm -f *.$(OBJEXT) core *.core 315 | -test -z "$(CLEANFILES)" || rm -f $(CLEANFILES) 316 | distclean: clean 317 | -rm -f *.tab.c 318 | -rm -f $(CONFIG_CLEAN_FILES) 319 | -rm -f config.cache config.log config.status 320 | 321 | #======================================================================== 322 | # Distribution creation (FROM sampleextension) 323 | # You may need to tweak this target to make it work correctly. 324 | #======================================================================== 325 | 326 | #COMPRESS = tar cvf $(PKG_DIR).tar $(PKG_DIR); compress $(PKG_DIR).tar 327 | COMPRESS = tar zcvf $(PKG_DIR).tar.gz $(PKG_DIR) 328 | DIST_ROOT = /tmp/dist 329 | DIST_DIR = $(DIST_ROOT)/$(PKG_DIR) 330 | 331 | dist-clean: 332 | rm -rf $(DIST_DIR) $(DIST_ROOT)/$(PKG_DIR).tar.* 333 | 334 | dist: dist-clean 335 | mkdir -p $(DIST_DIR) 336 | cp -p $(srcdir)/ChangeLog $(srcdir)/README* $(srcdir)/license* \ 337 | $(srcdir)/aclocal.m4 $(srcdir)/configure $(srcdir)/*.in \ 338 | $(DIST_DIR)/ 339 | chmod 664 $(DIST_DIR)/Makefile.in $(DIST_DIR)/aclocal.m4 340 | chmod 775 $(DIST_DIR)/configure $(DIST_DIR)/configure.in 341 | 342 | for i in $(srcdir)/*.[ch]; do \ 343 | if [ -f $$i ]; then \ 344 | cp -p $$i $(DIST_DIR)/ ; \ 345 | fi; \ 346 | done; 347 | 348 | mkdir $(DIST_DIR)/tclconfig 349 | cp $(srcdir)/tclconfig/install-sh $(srcdir)/tclconfig/tcl.m4 \ 350 | $(DIST_DIR)/tclconfig/ 351 | chmod 664 $(DIST_DIR)/tclconfig/tcl.m4 352 | chmod +x $(DIST_DIR)/tclconfig/install-sh 353 | 354 | list='demos generic library mac tests unix win'; \ 355 | for p in $$list; do \ 356 | if test -d $(srcdir)/$$p ; then \ 357 | mkdir $(DIST_DIR)/$$p; \ 358 | cp -p $(srcdir)/$$p/*.* $(DIST_DIR)/$$p/; \ 359 | fi; \ 360 | done 361 | mkdir $(DIST_DIR)/doc 362 | for p in $(srcdir)/doc/*.?; do \ 363 | soelim -I $(srcdir)/doc $$p >$(DIST_DIR)/doc/`basename $$p`; \ 364 | done 365 | 366 | (cd $(DIST_ROOT); $(COMPRESS);) 367 | 368 | #======================================================================== 369 | # Magic declarations to make. 370 | #======================================================================== 371 | 372 | .SUFFIXES: .c .$(OBJEXT) .rc .$(RES) 373 | .PHONY: all package clean depend distclean doc install libraries test kit 374 | .PHONY: sdx_valid doc dist dist-clean benchmarks shell genstubs gdb gdbtest 375 | .PHONY: valgrind valgrindtest testpackage 376 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Release of TclOO Version 1.0.4 2 | ============================== 3 | 4 | This officially corresponds to the version of TclOO that is included with Tcl 5 | 8.6.5, except for features (notably coroutine support and bytecode compilation 6 | of some commands) that require the 8.6 runtime. 7 | 8 | TclOO: An Object System for Tcl 9 | =============================== 10 | 11 | TclOO is an object system for Tcl that has been designed to provide high 12 | performance while still allowing as much flexibility as possible, and to be a 13 | core for other object systems. It supports a single-rooted class-based object 14 | system where classes are themselves subclassable objects, with multiple 15 | inheritance, mixins, procedure-like and forwarded methods, filter methods, 16 | dynamic reconfiguration, etc. 17 | 18 | It does not come with a large class library, and it does not force its use 19 | upon user scripts. Some of the packages in Tcllib use TclOO, but these may be 20 | dependent on other Tcl 8.6 features. 21 | 22 | The heritage of TclOO can be traced back to a number of other object systems, 23 | notably including XOTcl, incr Tcl, and Snit. It also draws on experience with 24 | object systems in other languages like C++, Java and Ruby (despite being 25 | somewhat different from each of them). 26 | 27 | Changes in TclOO 1.0.4 28 | ---------------------- 29 | * TIP #436 was implemented, which makes `info 30 | object isa` not produce errors when presented with non-objects. 31 | 32 | * Various bugs in class destruction were addressed. 33 | 34 | For a full description of all changes, see: 35 | 36 | * 37 | 38 | Note that there were no meaningful changes in 1.0.3. 39 | 40 | Building 41 | -------- 42 | 43 | TclOO 1.0.4 uses the TEA3 build system. These instructions are known to work 44 | on Linux, OSX and Windows (with msys installed). 45 | 46 | 1. Make sure you have a source distribution of Tcl 8.5 somewhere; you will 47 | need it to build TclOO. (Note that this functionality is incorporated 48 | directly into Tcl 8.6; you do not need this package with that version.) 49 | 50 | 2. Run the configure shell script in this directory. You may well want to 51 | use the `--with-tcl` option to tell the script where to find Tcl's build 52 | descriptor. Using the `--prefix` option to specify where to install the 53 | built version is also often useful. 54 | 55 | 3. Run '`make`'. 56 | 57 | 4. Run '`make test`'. There should be no test failures, but some memory stress 58 | tests are not run under normal conditions as they require a special build 59 | of Tcl. 60 | 61 | 5. Run '`make install`'. You might need to get elevated privileges to do this 62 | (e.g. by using '`sudo`') to install in a shared area. 63 | 64 | Support 65 | ------- 66 | 67 | Please file bug reports, feature requests and patches on core.tcl.tk under the 68 | Tcl package. To ensure attention from the 69 | relevant maintainer, please use "35. TclOO Package" for the Category field. 70 | Remember, it is better to file a bug report twice than not at all! 71 | 72 | Basic Usage of TclOO 73 | ==================== 74 | 75 | Adding up values with TclOO: 76 | 77 | oo::class create summation { 78 | variable v 79 | constructor {} { 80 | set v 0 81 | } 82 | method add x { 83 | incr v $x 84 | } 85 | method value {} { 86 | return $v 87 | } 88 | destructor { 89 | puts "Ended with value $v" 90 | } 91 | } 92 | set sum [summation new] 93 | puts "Start with [$sum value]" 94 | for {set i 1} {$i <= 10} {incr i} { 95 | puts "Add $i to get [$sum add $i]" 96 | } 97 | summation destroy 98 | 99 | Toasting bread with events and TclOO: 100 | 101 | oo::class create Toaster { 102 | variable toasting time 103 | constructor {toastingTime} { 104 | set time $toastingTime 105 | set toasting "" 106 | } 107 | method toast {breadProduct} { 108 | if {$toasting ne ""} { 109 | error "already toasting something" 110 | } 111 | set toasting [after $time [namespace code [list \ 112 | my Toasted $breadProduct]]] 113 | puts "toasting $breadProduct for you" 114 | } 115 | method Toasted {breadProduct} { 116 | puts "toasted the $breadProduct" 117 | set toasting "" 118 | } 119 | destructor { 120 | after cancel $toasting 121 | } 122 | } 123 | 124 | Toaster create quickToaster 30000 ; # 30 seconds only 125 | quickToaster toast crumpet 126 | 127 | after 40000 {set done ok} 128 | vwait done ; # Run the event loop 129 | 130 | quickToaster destroy ; # Delete the object 131 | 132 | Compatibility Warnings 133 | ====================== 134 | Names of classes, methods or variables that begin with a hyphen can now cause 135 | issues with some definitions (i.e., they are reserved to slotted operations). 136 | The fix is to precede the name with a "`--`" argument in the problem definition; 137 | see the `oo::define` documentation for the affected definitions. 138 | 139 | Method names that are proper multi-element lists are reserved for future 140 | functionality. 141 | -------------------------------------------------------------------------------- /README.txt: -------------------------------------------------------------------------------- 1 | Object Oriented Programming Package for Tcl (TclOO) Version 1.0.4 2 | 3 | Copyright 2005-2014 Donal K. Fellows 4 | 5 | License 6 | ======= 7 | 8 | See the file "license.terms" for the license under which this software is 9 | made available. This file must have been part of the distribution under 10 | which you received this file. 11 | 12 | Building 13 | ======== 14 | 15 | TclOO 1.0.4 uses the TEA3 build system. These instructions are known to work 16 | on Linux, OSX and Windows (with msys installed). 17 | 18 | 1) Make sure you have a source distribution of Tcl 8.5 somewhere; you will 19 | need it to build TclOO. (Note that this functionality is incorporated 20 | directly into Tcl 8.6; you do not need this package with that version.) 21 | 22 | 2) Run the configure shell script in this directory. You may well want to 23 | use the --with-tcl option to tell the script where to find Tcl's build 24 | descriptor. Using the --prefix option to specify where to install the 25 | built version is also often useful. 26 | 27 | 3) Run 'make'. 28 | 29 | 4) Run 'make test'. There should be no test failures, but some memory stress 30 | tests are not run under normal conditions as they require a special build 31 | of Tcl. 32 | 33 | 5) Run 'make install'. You might need to get elevated privileges to do this 34 | (e.g. by using 'sudo') to install in a shared area. 35 | 36 | Support 37 | ======= 38 | 39 | Please file bug reports, feature requests and patches on core.tcl.tk under the 40 | Tcl package. To ensure attention from the 41 | relevant maintainer, please use "35. TclOO Package" for the Category field. 42 | Remember, it is better to file a bug report twice than not at all! 43 | 44 | Simple Example 45 | ============== 46 | 47 | oo::class create summation { 48 | variable v 49 | constructor {} { 50 | set v 0 51 | } 52 | method add x { 53 | incr v $x 54 | } 55 | method value {} { 56 | return $v 57 | } 58 | destructor { 59 | puts "Ended with value $v" 60 | } 61 | } 62 | set sum [summation new] 63 | puts "Start with [$sum value]" 64 | for {set i 1} {$i <= 10} {incr i} { 65 | puts "Add $i to get [$sum add $i]" 66 | } 67 | summation destroy 68 | 69 | Significant Changes from 1.0.2 Release 70 | ==================================== 71 | * TIP #436 was implemented, which makes `info 72 | object isa` not produce errors when presented with non-objects. 73 | * Various bugs in class destruction were addressed. 74 | 75 | For a full description of all changes, see: 76 | http://core.tcl.tk/tcloo/timeline?from=release-1.0.2&to=release-1.0.4 77 | 78 | Note that there were no meaningful changes in 1.0.3. 79 | 80 | Compatibility Warnings 81 | ====================== 82 | Names of classes, methods or variables that begin with a hyphen can now cause 83 | issues with some definitions (i.e., they are reserved to slotted operations). 84 | The fix is to precede the name with a "--" argument in the problem definition; 85 | see the [oo::define] documentation for the affected definitions. 86 | 87 | Method names that are proper multi-element lists are reserved for future 88 | functionality. 89 | -------------------------------------------------------------------------------- /aclocal.m4: -------------------------------------------------------------------------------- 1 | dnl: aclocal.m4 -- 2 | dnl: 3 | dnl: Macros used for controlling output of autoconf. Some are general 4 | dnl: library macros, others are things that are probably eventually going 5 | dnl: to end up in TEA. All have the prefix of TEAX (TEA eXtension). 6 | dnl: 7 | dnl: Copyright (c) 2007-2008 by Donal K. Fellows 8 | dnl: 9 | dnl: See the file "license.terms" for information on usage and redistribution 10 | dnl: of this file, and for a DISCLAIMER OF ALL WARRANTIES. 11 | 12 | AC_PREREQ(2.50) 13 | builtin(include, tclconfig/tcl.m4) 14 | 15 | dnl Helper macros 16 | AC_DEFUN([TEAX_LAPPEND], [$1="[$]{$1} $2"]) 17 | AC_DEFUN([TEAX_FOREACH], [for $1 in $2; do $3; done]) 18 | AC_DEFUN([TEAX_IFEQ], [AS_IF([test "x$1" = "x$2"], [$3])]) 19 | AC_DEFUN([TEAX_IFNEQ], [AS_IF([test "x$1" != "x$2"], [$3])]) 20 | AC_DEFUN([TEAX_SWITCH], [case "$1" in TEAX_SWITCH_Cases(m4_shift($@)) esac]) 21 | AC_DEFUN([TEAX_SWITCH_Cases], [m4_if([$#],0,,[$#],1,,[TEAX_SWITCH_OneCase([$1],[$2])TEAX_SWITCH_Cases(m4_shift(m4_shift($@)))])]) 22 | AC_DEFUN([TEAX_SWITCH_OneCase],[ $1) $2;;]) 23 | AC_DEFUN([CygPath],[`${CYGPATH} $1`]) 24 | 25 | dnl Interesting macros 26 | AC_DEFUN([TEAX_INCLUDE_DIR], [ 27 | TEAX_LAPPEND(TeaXIncludeDirs, $1) 28 | TEA_ADD_INCLUDES([-I\"]CygPath($1)[\"])]) 29 | AC_DEFUN([TEAX_SUBST_RESOURCE], [ 30 | AC_REQUIRE([TEA_CONFIG_CFLAGS])dnl 31 | TEAX_IFEQ($TEA_PLATFORM, windows, [ 32 | AC_CHECK_PROGS(RC_, 'windres -o' 'rc -nologo -fo', none) 33 | TEAX_SWITCH($RC_, 34 | windres*, [ 35 | rcdef_inc="--include " 36 | rcdef_start="--define " 37 | rcdef_q='\"' 38 | AC_SUBST(RES_SUFFIX, [res.o]) 39 | TEAX_LAPPEND(PKG_OBJECTS, ${PACKAGE_NAME}.res.o)], 40 | rc*, [ 41 | dnl rcdef_inc="-i " 42 | dnl rcdef_start="-d " 43 | dnl rcdef_q='"' 44 | dnl AC_SUBST(RES_SUFFIX, [res]) 45 | dnl TEAX_LAPPEND(PKG_OBJECTS, ${PACKAGE_NAME}.res) 46 | AC_MSG_WARN([resource compiler problems; skipping...]) 47 | RC_=: ], 48 | *, [ 49 | AC_MSG_WARN([could not find resource compiler]) 50 | RC_=: ])]) 51 | # This next line is because of the brokenness of TEA... 52 | AC_SUBST(RC, $RC_) 53 | TEAX_FOREACH(i, $TeaXIncludeDirs, [ 54 | TEAX_LAPPEND(RES_DEFS, ${rcdef_inc}\"CygPath($i)\")]) 55 | TEAX_FOREACH(i, $1, [ 56 | TEAX_LAPPEND(RES_DEFS, ${rcdef_start}$i='${rcdef_q}\$($i)${rcdef_q}')]) 57 | AC_SUBST(RES_DEFS)]) 58 | AC_DEFUN([TEAX_ADD_PRIVATE_HEADERS], [ 59 | TEAX_FOREACH(i, $@, [ 60 | # check for existence, be strict because it should be present! 61 | AS_IF([test ! -f "${srcdir}/$i"], [ 62 | AC_MSG_ERROR([could not find header file '${srcdir}/$i'])]) 63 | TEAX_LAPPEND(PKG_PRIVATE_HEADERS, $i)]) 64 | AC_SUBST(PKG_PRIVATE_HEADERS)]) 65 | dnl Extra magic to make things work with Vista and VC 66 | AC_DEFUN([TEAX_VC_MANIFEST], [ 67 | CC_OUT="-o [\$]@" 68 | AC_SUBST(CC_OUT) 69 | AS_IF([test ${TEA_PLATFORM} = windows \ 70 | -a "$GCC" != yes \ 71 | -a "${SHARED_BUILD}" = 1], [ 72 | # This refers to "Manifest Tool" not "Magnetic Tape utility" 73 | AC_CHECK_PROGS(MT, "mt -nologo", none) 74 | TEAX_IFNEQ($MT, none, [ 75 | CC_OUT="-Fo[\$]@" 76 | ADD_MANIFEST="${MT} -manifest [\$]@.manifest -outputresource:[\$]@\;2" 77 | AC_SUBST(ADD_MANIFEST) 78 | TEAX_LAPPEND(CLEANFILES, ${PKG_LIB_FILE}.manifest)])])]) 79 | AC_DEFUN([TEAX_SDX], [ 80 | AC_ARG_WITH([sdx], [AS_HELP_STRING([--with-sdx], 81 | [where to find the Starkit Developer Extensions (default: search path)])], [:], 82 | [with_sdx=search]) 83 | TEAX_SWITCH($with_sdx, 84 | no, [ 85 | AC_MSG_NOTICE([configured without sdx; building starkits will fail]) 86 | AC_MSG_NOTICE([building as a normal library still supported])], 87 | search, [ 88 | AC_PATH_PROG([SDX], [sdx], [none]) 89 | TEAX_IFEQ($SDX, none, [ 90 | AC_PATH_PROG(SDX_KIT, sdx.kit, none) 91 | TEAX_IFNEQ($SDX_KIT, none, [ 92 | # We assume that sdx.kit is on the path, and that the 93 | # default tclsh is activetcl 94 | SDX="tclsh '${SDX_KIT}'"])]) 95 | TEAX_IFEQ($SDX, none, [ 96 | AC_MSG_WARN([cannot find sdx; building starkits will fail]) 97 | AC_MSG_NOTICE([building as a normal library still supported])])], 98 | *, [ 99 | AC_PATH_PROG(SDX, $with_sdx, none) 100 | TEAX_IFEQ($SDX, none, [ 101 | AC_MSG_WARN([cannot find $with_sdx; building starkits may fail]) 102 | AC_MSG_NOTICE([building as a normal library still supported])])])]) 103 | dnl TODO: Adapt this for OSX Frameworks... 104 | dnl This next bit is a bit ugly, but it makes things for tclooConfig.sh... 105 | AC_DEFUN([TEAX_CONFIG_INCLUDE_LINE], [ 106 | eval "$1=\"-I[]CygPath($2)\"" 107 | AC_SUBST($1)]) 108 | AC_DEFUN([TEAX_CONFIG_LINK_LINE], [ 109 | AS_IF([test ${TCL_LIB_VERSIONS_OK} = nodots], [ 110 | eval "$1=\"-L[]CygPath($2) -l$3${TCL_TRIM_DOTS}\"" 111 | ], [ 112 | eval "$1=\"-L[]CygPath($2) -l$3${PACKAGE_VERSION}\"" 113 | ]) 114 | AC_SUBST($1)]) 115 | 116 | dnl Local Variables: 117 | dnl mode: autoconf 118 | dnl End: 119 | -------------------------------------------------------------------------------- /benchmarks/cps.tcl: -------------------------------------------------------------------------------- 1 | set auto_path "[list [pwd]] $auto_path" 2 | package require TclOO 3 | puts "cps benchmark using TclOO [package provide TclOO]" 4 | # See http://wiki.tcl.tk/18152 for table of comparison 5 | 6 | # ---------------------------------------------------------------------- 7 | # cps -- 8 | # A wrapper round [time] to make it better for performance analysis of 9 | # very fast code. It works by tuning the number of iterations used until 10 | # the run-time of the code is around a second. 11 | # 12 | proc cps {script} { 13 | # Eat the script compilation costs 14 | uplevel 1 [list time $script] 15 | 16 | # Have a guess at how many iterations to run for around a second 17 | set s [uplevel 1 [list time $script 5]] 18 | set iters [expr {round(1.1/([lindex $s 0]/1e6))}] 19 | if {$iters < 50} { 20 | puts "WARNING: number of iterations low" 21 | } 22 | 23 | # The main timing run 24 | while 1 { 25 | set s [uplevel 1 [list time $script $iters]] 26 | # Only use the run if it was for at least a second, otherwise increase 27 | # the number of iterations and try again. 28 | if {[lindex $s 0]*$iters >= 1e6} { 29 | break 30 | } 31 | incr iters $iters 32 | } 33 | 34 | # Produce the results 35 | set cps [expr {round(1/([lindex $s 0]/1e6))}] 36 | puts "$cps calls per second of: [string trim $script]" 37 | } 38 | 39 | # ---------------------------------------------------------------------- 40 | #namespace path oo 41 | oo::class create base { 42 | variable x 43 | constructor {} { 44 | set x 1 45 | } 46 | method emptyMethod {} { } 47 | method stateful {} { 48 | set x [expr {!$x}] 49 | } 50 | method stateless {} { 51 | set local 1 52 | expr {!$local} 53 | } 54 | } 55 | 56 | oo::class create subCls { 57 | superclass base 58 | variable y 59 | constructor {} { 60 | next 61 | set y 0 62 | } 63 | method stateful {} { 64 | incr y 65 | next 66 | } 67 | method stateless {} { 68 | expr {![next]} 69 | } 70 | } 71 | 72 | # This code provides a baseline speed so that we can see how well Tcl itself 73 | # is performing independently of TclOO... 74 | set ::baselinex 1 75 | proc baselineProc {} { 76 | global baselinex 77 | set baselinex [expr {!$baselinex}] 78 | } 79 | # ---------------------------------------------------------------------- 80 | puts "Baseline..." 81 | cps {baselineProc } 82 | puts "Method invokation microbenchmark" 83 | base create baseObj 84 | cps {baseObj stateless} 85 | cps {baseObj stateful} 86 | cps {baseObj emptyMethod} 87 | base create base2 88 | cps {baseObj stateless;base2 stateless} 89 | base2 destroy 90 | baseObj destroy 91 | 92 | puts "Object creation/deletion microbenchmarks" 93 | cps {[base new] destroy} 94 | cps {[base create obj] destroy} 95 | cps {[base create ::obj] destroy} 96 | 97 | puts "Combined microbenchmark" 98 | cps {base create ::obj;obj stateless;obj destroy} 99 | 100 | puts "Method inherited invokation microbenchmark" 101 | subCls create subObj 102 | cps {subObj stateless} 103 | cps {subObj stateful} 104 | cps {subObj emptyMethod} 105 | subObj destroy 106 | 107 | puts "Object inherited creation/deletion microbenchmark" 108 | cps {[subCls new] destroy} 109 | cps {[subCls create obj] destroy} 110 | cps {[subCls create ::obj] destroy} 111 | 112 | puts "Combined inherited microbenchmark" 113 | cps {subCls create ::obj;obj stateless;obj destroy} 114 | 115 | base destroy 116 | -------------------------------------------------------------------------------- /benchmarks/methcall.tcl: -------------------------------------------------------------------------------- 1 | package require TclOO 2 | 3 | oo::class create Toggle { 4 | constructor initState { 5 | variable state $initState 6 | } 7 | method value {} { 8 | variable state 9 | return $state 10 | } 11 | method activate {} { 12 | variable state 13 | set state [expr {!$state}] 14 | return [self] 15 | } 16 | } 17 | oo::class create NthToggle { 18 | superclass Toggle 19 | constructor {initState maxCounter} { 20 | next $initState 21 | variable countMax $maxCounter counter 0 22 | } 23 | method activate {} { 24 | variable counter 25 | variable countMax 26 | if {[incr counter] >= $countMax} { 27 | next 28 | set counter 0 29 | } 30 | return [self] 31 | } 32 | } 33 | 34 | proc main {n args} { 35 | incr n 0 ;# sanity check 36 | 37 | set val 1 38 | Toggle create toggle $val 39 | for {set i 0} {$i < $n} {incr i} { 40 | set val [[toggle activate] value] 41 | } 42 | puts [lindex {false true} $val] 43 | 44 | set val 1 45 | NthToggle create ntoggle 1 3 46 | for {set i 0} {$i < $n} {incr i} { 47 | set val [[ntoggle activate] value] 48 | } 49 | puts [lindex {false true} $val] 50 | } 51 | 52 | main {*}$argv 53 | -------------------------------------------------------------------------------- /benchmarks/objinst.tcl: -------------------------------------------------------------------------------- 1 | package require TclOO 2 | 3 | oo::class create Toggle { 4 | constructor initState { 5 | variable state $initState 6 | } 7 | method value {} { 8 | variable state 9 | return $state 10 | } 11 | method activate {} { 12 | variable state 13 | set state [expr {!$state}] 14 | return [self] 15 | } 16 | } 17 | oo::class create NthToggle { 18 | superclass Toggle 19 | constructor {initState maxCounter} { 20 | next $initState 21 | variable countMax $maxCounter counter 0 22 | } 23 | method activate {} { 24 | variable counter 25 | variable countMax 26 | if {[incr counter] >= $countMax} { 27 | next 28 | set counter 0 29 | } 30 | return [self] 31 | } 32 | } 33 | 34 | proc main {n args} { 35 | incr n 0 ;# sanity check 36 | 37 | Toggle create toggle1 1 38 | for {set i 0} {$i < 5} {incr i} { 39 | toggle1 activate 40 | puts [lindex {false true} [toggle1 value]] 41 | } 42 | for {set i 0} {$i < $n} {incr i} { 43 | [Toggle new 1] destroy 44 | } 45 | 46 | puts "" 47 | 48 | NthToggle create ntoggle1 1 3 49 | for {set i 0} {$i < 8} {incr i} { 50 | ntoggle1 activate 51 | puts [lindex {false true} [ntoggle1 value]] 52 | } 53 | for {set i 0} {$i < $n} {incr i} { 54 | [NthToggle new 1 3] destroy 55 | } 56 | } 57 | 58 | main {*}$argv 59 | -------------------------------------------------------------------------------- /config.h.in: -------------------------------------------------------------------------------- 1 | /* config.h.in. Generated from configure.in by autoheader. */ 2 | 3 | /* Define if building universal (internal helper macro) */ 4 | #undef AC_APPLE_UNIVERSAL_BUILD 5 | 6 | /* Do we have the intptr_t type? */ 7 | #undef HAVE_INTPTR_T 8 | 9 | /* Define to 1 if you have the header file. */ 10 | #undef HAVE_INTTYPES_H 11 | 12 | /* Do we have ? */ 13 | #undef HAVE_LIMITS_H 14 | 15 | /* Define to 1 if you have the `lseek64' function. */ 16 | #undef HAVE_LSEEK64 17 | 18 | /* Define to 1 if you have the header file. */ 19 | #undef HAVE_MEMORY_H 20 | 21 | /* Do we have ? */ 22 | #undef HAVE_NET_ERRNO_H 23 | 24 | /* Define to 1 if you have the `open64' function. */ 25 | #undef HAVE_OPEN64 26 | 27 | /* Define to 1 if you have the header file. */ 28 | #undef HAVE_STDINT_H 29 | 30 | /* Define to 1 if you have the header file. */ 31 | #undef HAVE_STDLIB_H 32 | 33 | /* Define to 1 if you have the header file. */ 34 | #undef HAVE_STRINGS_H 35 | 36 | /* Define to 1 if you have the header file. */ 37 | #undef HAVE_STRING_H 38 | 39 | /* Is 'struct dirent64' in ? */ 40 | #undef HAVE_STRUCT_DIRENT64 41 | 42 | /* Is 'struct stat64' in ? */ 43 | #undef HAVE_STRUCT_STAT64 44 | 45 | /* Define to 1 if you have the header file. */ 46 | #undef HAVE_SYS_PARAM_H 47 | 48 | /* Define to 1 if you have the header file. */ 49 | #undef HAVE_SYS_STAT_H 50 | 51 | /* Define to 1 if you have the header file. */ 52 | #undef HAVE_SYS_TYPES_H 53 | 54 | /* Is off64_t in ? */ 55 | #undef HAVE_TYPE_OFF64_T 56 | 57 | /* Define to 1 if you have the header file. */ 58 | #undef HAVE_UNISTD_H 59 | 60 | /* No Compiler support for module scope symbols */ 61 | #undef MODULE_SCOPE 62 | 63 | /* Do we have ? */ 64 | #undef NO_DIRENT_H 65 | 66 | /* Do we have ? */ 67 | #undef NO_DLFCN_H 68 | 69 | /* Do we have ? */ 70 | #undef NO_ERRNO_H 71 | 72 | /* Do we have ? */ 73 | #undef NO_FLOAT_H 74 | 75 | /* Do we have ? */ 76 | #undef NO_LIMITS_H 77 | 78 | /* Do we have ? */ 79 | #undef NO_STDLIB_H 80 | 81 | /* Do we have ? */ 82 | #undef NO_STRING_H 83 | 84 | /* Do we have ? */ 85 | #undef NO_SYS_WAIT_H 86 | 87 | /* Do we have ? */ 88 | #undef NO_VALUES_H 89 | 90 | /* No visibility hidden passed to zlib? */ 91 | #undef NO_VIZ 92 | 93 | /* Define to the address where bug reports for this package should be sent. */ 94 | #undef PACKAGE_BUGREPORT 95 | 96 | /* Define to the full name of this package. */ 97 | #undef PACKAGE_NAME 98 | 99 | /* Define to the full name and version of this package. */ 100 | #undef PACKAGE_STRING 101 | 102 | /* Define to the one symbol short name of this package. */ 103 | #undef PACKAGE_TARNAME 104 | 105 | /* Define to the home page for this package. */ 106 | #undef PACKAGE_URL 107 | 108 | /* Define to the version of this package. */ 109 | #undef PACKAGE_VERSION 110 | 111 | /* Is this a static build? */ 112 | #undef STATIC_BUILD 113 | 114 | /* Define to 1 if you have the ANSI C header files. */ 115 | #undef STDC_HEADERS 116 | 117 | /* Is memory debugging enabled? */ 118 | #undef TCL_MEM_DEBUG 119 | 120 | /* Are we building with threads enabled? */ 121 | #undef TCL_THREADS 122 | 123 | /* Are wide integers to be implemented with C 'long's? */ 124 | #undef TCL_WIDE_INT_IS_LONG 125 | 126 | /* What type should be used to define wide integers? */ 127 | #undef TCL_WIDE_INT_TYPE 128 | 129 | /* UNDER_CE version */ 130 | #undef UNDER_CE 131 | 132 | /* Should always be 1 */ 133 | #undef USE_TCL_STUBS 134 | 135 | /* Do we want to use the threaded memory allocator? */ 136 | #undef USE_THREAD_ALLOC 137 | 138 | /* Define WORDS_BIGENDIAN to 1 if your processor stores words with the most 139 | significant byte first (like Motorola and SPARC, unlike Intel). */ 140 | #if defined AC_APPLE_UNIVERSAL_BUILD 141 | # if defined __BIG_ENDIAN__ 142 | # define WORDS_BIGENDIAN 1 143 | # endif 144 | #else 145 | # ifndef WORDS_BIGENDIAN 146 | # undef WORDS_BIGENDIAN 147 | # endif 148 | #endif 149 | 150 | /* Add the _ISOC99_SOURCE flag when building */ 151 | #undef _ISOC99_SOURCE 152 | 153 | /* Add the _LARGEFILE64_SOURCE flag when building */ 154 | #undef _LARGEFILE64_SOURCE 155 | 156 | /* Add the _LARGEFILE_SOURCE64 flag when building */ 157 | #undef _LARGEFILE_SOURCE64 158 | 159 | /* # needed in sys/socket.h Should OS/390 do the right thing with sockets? */ 160 | #undef _OE_SOCKETS 161 | 162 | /* Do we really want to follow the standard? Yes we do! */ 163 | #undef _POSIX_PTHREAD_SEMANTICS 164 | 165 | /* Do we want the reentrant OS API? */ 166 | #undef _REENTRANT 167 | 168 | /* Do we want the thread-safe OS API? */ 169 | #undef _THREAD_SAFE 170 | 171 | /* _WIN32_WCE version */ 172 | #undef _WIN32_WCE 173 | 174 | /* Do we want to use the XOPEN network library? */ 175 | #undef _XOPEN_SOURCE_EXTENDED 176 | 177 | /* Define to `__inline__' or `__inline' if that's what the C compiler 178 | calls it, or to nothing if 'inline' is not supported under any name. */ 179 | #ifndef __cplusplus 180 | #undef inline 181 | #endif 182 | 183 | /* Signed integer type wide enough to hold a pointer. */ 184 | #undef intptr_t 185 | -------------------------------------------------------------------------------- /configure.in: -------------------------------------------------------------------------------- 1 | dnl# 2 | dnl# When changing the version number, you *must* change the following: 3 | dnl# generic/tclOO.h, tests/oo.test, tests/ooNext2.test 4 | dnl# 5 | dnl# You should also change the following: 6 | dnl# README.txt, README.md, win/TclOO.rc 7 | dnl# 8 | AC_INIT([TclOO],[1.0.4]) 9 | AC_CONFIG_AUX_DIR(tclconfig) 10 | AC_CONFIG_HEADERS(config.h) 11 | 12 | TEA_INIT([3.9]) 13 | TEA_PATH_TCLCONFIG 14 | TEA_LOAD_TCLCONFIG 15 | TEA_PREFIX 16 | TEA_SETUP_COMPILER 17 | AC_C_INLINE 18 | TEA_ADD_SOURCES([ 19 | tclOO.c tclOOBasic.c tclOOCall.c tclOODefineCmds.c tclOOInfo.c 20 | tclOOMethod.c tclOOStubInit.c]) 21 | TEA_ADD_STUB_SOURCES([tclOOStubLib.c]) 22 | TEA_ADD_HEADERS([generic/tclOO.h generic/tclOODecls.h]) 23 | TEAX_ADD_PRIVATE_HEADERS([generic/tclOOInt.h generic/tclOOIntDecls.h]) 24 | TEAX_INCLUDE_DIR([.]) 25 | TEAX_INCLUDE_DIR([${srcdir}/generic]) 26 | AC_SUBST(PKG_TEST_SOURCES, [pkgoo.c]) 27 | PKG_TEST_OBJECTS=`echo ${PKG_TEST_SOURCES} | sed -e "s/\.c/.${OBJEXT}/"` 28 | AC_SUBST(PKG_TEST_OBJECTS) 29 | AC_SUBST(PKG_TEST_LIB_FILE, [pkgoo.c]) 30 | TEA_PRIVATE_TCL_HEADERS 31 | TEA_ENABLE_THREADS 32 | TEA_ENABLE_SHARED 33 | TEA_CONFIG_CFLAGS 34 | dnl TEAX_SUBST_RESOURCE(PACKAGE_NAME PKG_LIB_FILE PACKAGE_VERSION) 35 | TEA_ENABLE_SYMBOLS 36 | AC_CHECK_TYPE([intptr_t], [ 37 | AC_DEFINE([HAVE_INTPTR_T], 1, [Do we have the intptr_t type?])], [ 38 | AC_CACHE_CHECK([for pointer-size signed integer type], tcl_cv_intptr_t, [ 39 | for tcl_cv_intptr_t in "int" "long" "long long" none; do 40 | if test "$tcl_cv_intptr_t" != none; then 41 | AC_COMPILE_IFELSE([AC_LANG_BOOL_COMPILE_TRY([AC_INCLUDES_DEFAULT], 42 | [[sizeof (void *) <= sizeof ($tcl_cv_intptr_t)]])], 43 | [tcl_ok=yes], [tcl_ok=no]) 44 | test "$tcl_ok" = yes && break; fi 45 | done]) 46 | if test "$tcl_cv_intptr_t" != none; then 47 | AC_DEFINE_UNQUOTED([intptr_t], [$tcl_cv_intptr_t], [Signed integer 48 | type wide enough to hold a pointer.]) 49 | fi 50 | ]) 51 | 52 | TEA_MAKE_LIB 53 | AC_SUBST(PKG_TEST_LIB_FILE, pkgoo${SHLIB_SUFFIX}) 54 | dnl TEAX_VC_MANIFEST 55 | 56 | TEAX_LAPPEND(CLEANFILES, pkgIndex.tcl) 57 | AC_SUBST(CLEANFILES) 58 | AC_DEFINE(USE_TCL_STUBS,[1],[Should always be 1]) 59 | 60 | TEA_PROG_TCLSH 61 | CONFIGURE_OUTPUTS="Makefile tclooConfig.sh config.cache config.log config.status" 62 | AC_SUBST(CONFIGURE_OUTPUTS) 63 | 64 | TEAX_SDX 65 | 66 | TEAX_CONFIG_INCLUDE_LINE(TCLOO_INCLUDE_SPEC, [${includedir}]) 67 | TEAX_CONFIG_INCLUDE_LINE(TCLOO_PRIVATE_INCLUDE_SPEC, [${includedir}]) 68 | TEAX_CONFIG_LINK_LINE(TCLOO_LIB_SPEC, 69 | [${libdir}/${PACKAGE_NAME}${PACKAGE_VERSION}], [${PACKAGE_NAME}]) 70 | TEAX_CONFIG_LINK_LINE(TCLOO_STUB_LIB_SPEC, 71 | [${libdir}/${PACKAGE_NAME}${PACKAGE_VERSION}], [${PACKAGE_NAME}stub]) 72 | 73 | AC_CONFIG_FILES(Makefile tclooConfig.sh) 74 | AC_OUTPUT 75 | -------------------------------------------------------------------------------- /doc/Class.3: -------------------------------------------------------------------------------- 1 | '\" 2 | '\" Copyright (c) 2007-2008 Donal K. Fellows 3 | '\" 4 | '\" See the file "license.terms" for information on usage and redistribution 5 | '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. 6 | '\" 7 | .TH Tcl_Class 3 0.1 TclOO "TclOO Library Functions" 8 | .so man.macros 9 | .BS 10 | '\" Note: do not modify the .SH NAME line immediately below! 11 | .SH NAME 12 | Tcl_ClassGetMetadata, Tcl_ClassSetMetadata, Tcl_CopyObjectInstance, Tcl_GetClassAsObject, Tcl_GetObjectAsClass, Tcl_GetObjectCommand, Tcl_GetObjectNamespace, Tcl_NewObjectInstance, Tcl_ObjectDeleted, Tcl_ObjectGetMetadata, Tcl_ObjectGetMethodNameMapper, Tcl_ObjectSetMetadata, Tcl_ObjectSetMethodNameMapper \- manipulate objects and classes 13 | .SH SYNOPSIS 14 | .nf 15 | \fB#include \fR 16 | .sp 17 | Tcl_Object 18 | \fBTcl_GetObjectFromObj\fR(\fIinterp, objPtr\fR) 19 | .sp 20 | Tcl_Object 21 | \fBTcl_GetClassAsObject\fR(\fIclass\fR) 22 | .sp 23 | Tcl_Class 24 | \fBTcl_GetObjectAsClass\fR(\fIobject\fR) 25 | .sp 26 | Tcl_Command 27 | \fBTcl_GetObjectCommand\fR(\fIobject\fR) 28 | .sp 29 | Tcl_Obj * 30 | \fBTcl_GetObjectName\fR(\fIinterp, object\fR) 31 | .sp 32 | Tcl_Namespace * 33 | \fBTcl_GetObjectNamespace\fR(\fIobject\fR) 34 | .sp 35 | Tcl_Object 36 | \fBTcl_NewObjectInstance\fR(\fIinterp, class, name, nsName, objc, objv, skip\fR) 37 | .sp 38 | Tcl_Object 39 | \fBTcl_CopyObjectInstance\fR(\fIinterp, object, name, nsName\fR) 40 | .sp 41 | int 42 | \fBTcl_ObjectDeleted\fR(\fIobject\fR) 43 | .sp 44 | ClientData 45 | \fBTcl_ObjectGetMetadata\fR(\fIobject, metaTypePtr\fR) 46 | .sp 47 | \fBTcl_ObjectSetMetadata\fR(\fIobject, metaTypePtr, metadata\fR) 48 | .sp 49 | ClientData 50 | \fBTcl_ClassGetMetadata\fR(\fIclass, metaTypePtr\fR) 51 | .sp 52 | \fBTcl_ClassSetMetadata\fR(\fIclass, metaTypePtr, metadata\fR) 53 | .sp 54 | Tcl_ObjectMapMethodNameProc 55 | \fBTcl_ObjectGetMethodNameMapper\fR(\fIobject\fR) 56 | .sp 57 | \fBTcl_ObjectSetMethodNameMapper\fR(\fIobject\fR, \fImethodNameMapper\fR) 58 | .SH ARGUMENTS 59 | .AS ClientData metadata in/out 60 | .AP Tcl_Interp *interp in/out 61 | Interpreter providing the context for looking up or creating an object, and 62 | into whose result error messages will be written on failure. 63 | .AP Tcl_Obj *objPtr in 64 | The name of the object to look up. 65 | .AP Tcl_Object object in 66 | Reference to the object to operate upon. 67 | .AP Tcl_Class class in 68 | Reference to the class to operate upon. 69 | .AP "const char" *name in 70 | The name of the object to create, or NULL if a new unused name is to be 71 | automatically selected. 72 | .AP "const char" *nsName in 73 | The name of the namespace to create for the object's private use, or NULL if a 74 | new unused name is to be automatically selected. The namespace must not 75 | already exist. 76 | .AP int objc in 77 | The number of elements in the \fIobjv\fR array. 78 | .AP "Tcl_Obj *const" *objv in 79 | The arguments to the command to create the instance of the class. 80 | .AP int skip in 81 | The number of arguments at the start of the argument array, \fIobjv\fR, that 82 | are not arguments to any constructors. 83 | .AP Tcl_ObjectMetadataType *metaTypePtr in 84 | The type of \fImetadata\fR being set with \fBTcl_ClassSetMetadata\fR or 85 | retrieved with \fBTcl_ClassGetMetadata\fR. 86 | .AP ClientData metadata in 87 | An item of metadata to attach to the class, or NULL to remove the metadata 88 | associated with a particular \fImetaTypePtr\fR. 89 | .AP "Tcl_ObjectMapMethodNameProc" "methodNameMapper" in 90 | A pointer to a function to call to adjust the mapping of objects and method 91 | names to implementations, or NULL when no such mapping is required. 92 | .BE 93 | .SH DESCRIPTION 94 | .PP 95 | Objects are typed entities that have a set of operations ("methods") 96 | associated with them. Classes are objects that can manufacture objects. Each 97 | class can be viewed as an object itself; the object view can be retrieved 98 | using \fBTcl_GetClassAsObject\fR which always returns the object when applied 99 | to a non-destroyed class, and an object can be viewed as a class with the aid 100 | of the \fBTcl_GetObjectAsClass\fR (which either returns the class, or NULL if 101 | the object is not a class). An object may be looked up using the 102 | \fBTcl_GetObjectFromObj\fR function, which either returns an object or NULL 103 | (with an error message in the interpreter result) if the object cannot be 104 | found. The correct way to look up a class by name is to look up the object 105 | with that name, and then to use \fBTcl_GetObjectAsClass\fR. 106 | .PP 107 | Every object has its own command and namespace associated with it. The command 108 | may be retrieved using the \fBTcl_GetObjectCommand\fR function, the name of 109 | the object (and hence the name of the command) with \fBTcl_GetObjectName\fR, 110 | and the namespace may be retrieved using the \fBTcl_GetObjectNamespace\fR 111 | function. Note that the Tcl_Obj reference returned by \fBTcl_GetObjectName\fR 112 | is a shared reference. 113 | .PP 114 | Instances of classes are created using \fBTcl_NewObjectInstance\fR, which 115 | creates an object from any class (and which is internally called by both 116 | the \fBcreate\fR and \fBnew\fR methods of the \fBoo::class\fR class). It takes 117 | parameters that optionally give the name of the object and namespace to 118 | create, and which describe the arguments to pass to the class's constructor 119 | (if any). The result of the function will be either a reference to the newly 120 | created object, or NULL if the creation failed (when an error message will be 121 | left in the interpreter result). In addition, objects may be copied by using 122 | \fBTcl_CopyObjectInstance\fR which creates a copy of an object without running 123 | any constructors. 124 | .SH "OBJECT AND CLASS METADATA" 125 | .PP 126 | Every object and every class may have arbitrary amounts of metadata attached 127 | to it, which the object or class attaches no meaning to beyond what is 128 | described in a Tcl_ObjectMetadataType structure instance. Metadata to be 129 | attached is described by the the type of the metadata (given in the 130 | \fImetaTypePtr\fR argument) and an arbitrary pointer (the \fImetadata\fR 131 | argument) that are given to \fBTcl_ObjectSetMetadata\fR and 132 | \fBTcl_ClassSetMetadata\fR, and a particular piece of metadata can be 133 | retrieved given its type using \fBTcl_ObjectGetMetadata\fR and 134 | \fBTcl_ClassGetMetadata\fR. If the \fImetadata\fR parameter to either 135 | \fBTcl_ObjectSetMetadata\fR or \fBTcl_ClassSetMetadata\fR is NULL, the 136 | metadata is removed if it was attached, and the results of 137 | \fBTcl_ObjectGetMetadata\fR and \fBTcl_ClassGetMetadata\fR are NULL if the 138 | given type of metadata was not attached. It is not an error to request or 139 | remove a piece of metadata that was not attached. 140 | .SS "TCL_OBJECTMETADATATYPE STRUCTURE" 141 | .PP 142 | The contents of the Tcl_ObjectMetadataType structure are as follows: 143 | .PP 144 | .CS 145 | typedef const struct { 146 | int \fIversion\fR; 147 | const char *\fIname\fR; 148 | Tcl_ObjectMetadataDeleteProc \fIdeleteProc\fR; 149 | Tcl_CloneProc \fIcloneProc\fR; 150 | } \fBTcl_ObjectMetadataType\fR; 151 | .CE 152 | .PP 153 | The \fIversion\fR field allows for future expansion of the structure, and 154 | should always be declared equal to TCL_OO_METADATA_VERSION_CURRENT. The 155 | \fIname\fR field provides a human-readable name for the type, and is reserved 156 | for debugging. 157 | .PP 158 | The \fIdeleteProc\fR field gives a function of type 159 | Tcl_ObjectMetadataDeleteProc that is used to delete a particular piece of 160 | metadata, and is called when the attached metadata is replaced or removed; the 161 | field must not be NULL. 162 | .PP 163 | The \fIcloneProc\fR field gives a function that is used to copy a piece of 164 | metadata (used when a copy of an object is created using 165 | \fBTcl_CopyObjectInstance\fR); if NULL, the metadata will be just directly 166 | copied. 167 | .SS "TCL_OBJECTMETADATADELETEPROC FUNCTION SIGNATURE" 168 | .PP 169 | Functions matching this signature are used to delete metadata associated with 170 | a class or object. 171 | .PP 172 | .CS 173 | typedef void (*\fBTcl_ObjectMetadataDeleteProc\fR) ( 174 | ClientData \fImetadata\fR); 175 | .CE 176 | .PP 177 | The \fImetadata\fR argument gives the address of the metadata to be 178 | deleted. 179 | .SS "TCL_CLONEPROC FUNCTION SIGNATURE" 180 | .PP 181 | Functions matching this signature are used to create copies of metadata 182 | associated with a class or object. 183 | .PP 184 | .CS 185 | typedef int (*\fBTcl_CloneProc\fR) ( 186 | Tcl_Interp *\fIinterp\fR, 187 | ClientData \fIsrcMetadata\fR, 188 | ClientData *\fIdstMetadataPtr\fR); 189 | .CE 190 | .PP 191 | The \fIinterp\fR argument gives a place to write an error message when the 192 | attempt to clone the object is to fail, in which case the clone procedure must 193 | also return TCL_ERROR; it should return TCL_OK otherwise. 194 | The \fIsrcMetadata\fR argument gives the address of the metadata to be cloned, 195 | and the cloned metadata should be written into the variable pointed to by 196 | \fIdstMetadataPtr\fR; a NULL should be written if the metadata is to not be 197 | cloned but the overall object copy operation is still to succeed. 198 | .SH "OBJECT METHOD NAME MAPPING" 199 | It is possible to control, on a per-object basis, what methods are invoked 200 | when a particular method is invoked. Normally this is done by looking up the 201 | method name in the object and then in the class hierarchy, but fine control of 202 | exactly what the value used to perform the look up is afforded through the 203 | ability to set a method name mapper callback via 204 | \fBTcl_ObjectSetMethodNameMapper\fR (and its introspection counterpart, 205 | \fBTcl_ObjectGetMethodNameMapper\fR, which returns the current mapper). The 206 | current mapper (if any) is invoked immediately before looking up what chain of 207 | method implementations is to be used. 208 | .SS "TCL_OBJECTMAPMETHODNAMEPROC FUNCTION SIGNATURE" 209 | The \fITcl_ObjectMapMethodNameProc\fR callback is defined as follows: 210 | .PP 211 | .CS 212 | typedef int (*\fBTcl_ObjectMapMethodNameProc\fR)( 213 | Tcl_Interp *\fIinterp\fR, 214 | Tcl_Object \fIobject\fR, 215 | Tcl_Class *\fIstartClsPtr\fR, 216 | Tcl_Obj *\fImethodNameObj\fR); 217 | .CE 218 | .PP 219 | The \fIinterp\fR parameter (and the integer result) follow normal Tcl result 220 | rules for error reporting. The \fIobject\fR parameter says which object is 221 | being processed. The \fIstartClsPtr\fR parameter points to a variable that 222 | contains the first class to provide a definition in the method chain to 223 | process, or NULL if the whole chain is to be processed (the argument itself is 224 | never NULL); this variable may be updated by the callback. The 225 | \fImethodNameObj\fR parameter gives an unshared object containing the name of 226 | the method being invoked, as provided by the user; this object may be updated 227 | by the callback. 228 | .SH "SEE ALSO" 229 | Method(3), oo::class(n), oo::copy(n), oo::define(n), oo::object(n) 230 | .SH KEYWORDS 231 | class, constructor, object 232 | 233 | .\" Local variables: 234 | .\" mode: nroff 235 | .\" fill-column: 78 236 | .\" End: 237 | -------------------------------------------------------------------------------- /doc/Method.3: -------------------------------------------------------------------------------- 1 | '\" 2 | '\" Copyright (c) 2007-2008 Donal K. Fellows 3 | '\" 4 | '\" See the file "license.terms" for information on usage and redistribution 5 | '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. 6 | '\" 7 | .TH Tcl_Method 3 0.1 TclOO "TclOO Library Functions" 8 | .so man.macros 9 | .BS 10 | '\" Note: do not modify the .SH NAME line immediately below! 11 | .SH NAME 12 | Tcl_ClassSetConstructor, Tcl_ClassSetDestructor, Tcl_MethodDeclarerClass, Tcl_MethodDeclarerObject, Tcl_MethodIsPublic, Tcl_MethodIsType, Tcl_MethodName, Tcl_NewInstanceMethod, Tcl_NewMethod, Tcl_ObjectContextIsFiltering, Tcl_ObjectContextMethod, Tcl_ObjectContextObject, Tcl_ObjectContextSkippedArgs \- manipulate methods and method-call contexts 13 | .SH SYNOPSIS 14 | .nf 15 | \fB#include \fR 16 | .sp 17 | Tcl_Method 18 | \fBTcl_NewMethod\fR(\fIinterp, class, nameObj, isPublic, 19 | methodTypePtr, clientData\fR) 20 | .sp 21 | Tcl_Method 22 | \fBTcl_NewInstanceMethod\fR(\fIinterp, object, nameObj, isPublic, 23 | methodTypePtr, clientData\fR) 24 | .sp 25 | \fBTcl_ClassSetConstructor\fR(\fIinterp, class, method\fR) 26 | .sp 27 | \fBTcl_ClassSetDestructor\fR(\fIinterp, class, method\fR) 28 | .sp 29 | Tcl_Class 30 | \fBTcl_MethodDeclarerClass\fR(\fImethod\fR) 31 | .sp 32 | Tcl_Object 33 | \fBTcl_MethodDeclarerObject\fR(\fImethod\fR) 34 | .sp 35 | Tcl_Obj * 36 | \fBTcl_MethodName\fR(\fImethod\fR) 37 | .sp 38 | int 39 | \fBTcl_MethodIsPublic\fR(\fImethod\fR) 40 | .sp 41 | int 42 | \fBTcl_MethodIsType\fR(\fImethod, methodTypePtr, clientDataPtr\fR) 43 | .sp 44 | int 45 | \fBTcl_ObjectContextInvokeNext\fR(\fIinterp, context, objc, objv, skip\fR) 46 | .sp 47 | int 48 | \fBTcl_ObjectContextIsFiltering\fR(\fIcontext\fR) 49 | .sp 50 | Tcl_Method 51 | \fBTcl_ObjectContextMethod\fR(\fIcontext\fR) 52 | .sp 53 | Tcl_Object 54 | \fBTcl_ObjectContextObject\fR(\fIcontext\fR) 55 | .sp 56 | int 57 | \fBTcl_ObjectContextSkippedArgs\fR(\fIcontext\fR) 58 | .SH ARGUMENTS 59 | .AS ClientData clientData in 60 | .AP Tcl_Interp *interp in/out 61 | The interpreter holding the object or class to create or update a method in. 62 | .AP Tcl_Object object in 63 | The object to create the method in. 64 | .AP Tcl_Class class in 65 | The class to create the method in. 66 | .AP Tcl_Obj *nameObj in 67 | The name of the method to create. Should not be NULL unless creating 68 | constructors or destructors. 69 | .AP int isPublic in 70 | A flag saying what the visibility of the method is. The only supported public 71 | values of this flag are 0 for a non-exported method, and 1 for an exported 72 | method. 73 | .AP Tcl_MethodType *methodTypePtr in 74 | A description of the type of the method to create, or the type of method to 75 | compare against. 76 | .AP ClientData clientData in 77 | A piece of data that is passed to the implementation of the method without 78 | interpretation. 79 | .AP ClientData *clientDataPtr out 80 | A pointer to a variable in which to write the \fIclientData\fR value supplied 81 | when the method was created. If NULL, the \fIclientData\fR value will not be 82 | retrieved. 83 | .AP Tcl_Method method in 84 | A reference to a method to query. 85 | .AP Tcl_ObjectContext context in 86 | A reference to a method-call context. Note that client code \fImust not\fR 87 | retain a reference to a context. 88 | .AP int objc in 89 | The number of arguments to pass to the method implementation. 90 | .AP "Tcl_Obj *const" *objv in 91 | An array of arguments to pass to the method implementation. 92 | .AP int skip in 93 | The number of arguments passed to the method implementation that do not 94 | represent "real" arguments. 95 | .BE 96 | .SH DESCRIPTION 97 | .PP 98 | A method is an operation carried out on an object that is associated with the 99 | object. Every method must be attached to either an object or a class; methods 100 | attached to a class are associated with all instances (direct and indirect) of 101 | that class. 102 | .PP 103 | Given a method, the entity that declared it can be found using 104 | \fBTcl_MethodDeclarerClass\fR which returns the class that the method is 105 | attached to (or NULL if the method is not attached to any class) and 106 | \fBTcl_MethodDeclarerObject\fR which returns the object that the method is 107 | attached to (or NULL if the method is not attached to an object). The name of 108 | the method can be retrieved with \fBTcl_MethodName\fR and whether the method 109 | is exported is retrieved with \fBTcl_MethodIsPublic\fR. The type of the method 110 | can also be introspected upon to a limited degree; the function 111 | \fBTcl_MethodIsType\fR returns whether a method is of a particular type, 112 | assigning the per-method \fIclientData\fR to the variable pointed to by 113 | \fIclientDataPtr\fR if (that is non-NULL) if the type is matched. 114 | .SS "METHOD CREATION" 115 | .PP 116 | Methods are created by \fBTcl_NewMethod\fR and \fBTcl_NewInstanceMethod\fR, 117 | which 118 | create a method attached to a class or an object respectively. In both cases, 119 | the \fInameObj\fR argument gives the name of the method to create, the 120 | \fIisPublic\fR argument states whether the method should be exported 121 | initially, the \fImethodTypePtr\fR argument describes the implementation of 122 | the method (see the \fBMETHOD TYPES\fR section below) and the \fIclientData\fR 123 | argument gives some implementation-specific data that is passed on to the 124 | implementation of the method when it is called. 125 | .PP 126 | When the \fInameObj\fR argument to \fBTcl_NewMethod\fR is NULL, an 127 | unnamed method is created, which is used for constructors and destructors. 128 | Constructors should be installed into their class using the 129 | \fBTcl_ClassSetConstructor\fR function, and destructors (which must not 130 | require any arguments) should be installed into their class using the 131 | \fBTcl_ClassSetDestructor\fR function. Unnamed methods should not be used for 132 | any other purpose, and named methods should not be used as either constructors 133 | or destructors. Also note that a NULL \fImethodTypePtr\fR is used to provide 134 | internal signaling, and should not be used in client code. 135 | .SS "METHOD CALL CONTEXTS" 136 | .PP 137 | When a method is called, a method-call context reference is passed in as one 138 | of the arguments to the implementation function. This context can be inspected 139 | to provide information about the caller, but should not be retained beyond the 140 | moment when the method call terminates. 141 | .PP 142 | The method that is being called can be retrieved from the context by using 143 | \fBTcl_ObjectContextMethod\fR, and the object that caused the method to be 144 | invoked can be retrieved with \fBTcl_ObjectContextObject\fR. The number of 145 | arguments that are to be skipped (e.g. the object name and method name in a 146 | normal method call) is read with \fBTcl_ObjectContextSkippedArgs\fR, and the 147 | context can also report whether it is working as a filter for another method 148 | through \fBTcl_ObjectContextIsFiltering\fR. 149 | .PP 150 | During the execution of a method, the method implementation may choose to 151 | invoke the stages of the method call chain that come after the current method 152 | implementation. This (the core of the \fBnext\fR command) is done using 153 | \fBTcl_ObjectContextInvokeNext\fR. Note that this function does not manipulate 154 | the call-frame stack, unlike the \fBnext\fR command; if the method 155 | implementation has pushed one or more extra frames on the stack as part of its 156 | implementation, it is also responsible for temporarily popping those frames 157 | from the stack while the \fBTcl_ObjectContextInvokeNext\fR function is 158 | executing. Note also that the method-call context is \fInever\fR deleted 159 | during the execution of this function. 160 | .SH "METHOD TYPES" 161 | .PP 162 | The types of methods are described by a pointer to a Tcl_MethodType structure, 163 | which is defined as: 164 | .PP 165 | .CS 166 | typedef const struct { 167 | int \fIversion\fR; 168 | const char *\fIname\fR; 169 | Tcl_MethodCallProc \fIcallProc\fR; 170 | Tcl_MethodDeleteProc \fIdeleteProc\fR; 171 | Tcl_CloneProc \fIcloneProc\fR; 172 | } \fBTcl_MethodType\fR; 173 | .CE 174 | .PP 175 | The \fIversion\fR field allows for future expansion of the structure, and 176 | should always be declared equal to TCL_OO_METHOD_VERSION_CURRENT. The 177 | \fIname\fR field provides a human-readable name for the type, and is the value 178 | that is exposed via the \fBinfo class methodtype\fR and 179 | \fBinfo object methodtype\fR Tcl commands. 180 | .PP 181 | The \fIcallProc\fR field gives a function that is called when the method is 182 | invoked; it must never be NULL. 183 | .PP 184 | The \fIdeleteProc\fR field gives a function that is used to delete a 185 | particular method, and is called when the method is replaced or removed; if 186 | the field is NULL, it is assumed that the method's \fIclientData\fR needs no 187 | special action to delete. 188 | .PP 189 | The \fIcloneProc\fR field is either a function that is used to copy a method's 190 | \fIclientData\fR (as part of \fBTcl_CopyObjectInstance\fR) or NULL to indicate 191 | that the \fIclientData\fR can just be copied directly. 192 | .SS "TCL_METHODCALLPROC FUNCTION SIGNATURE" 193 | .PP 194 | Functions matching this signature are called when the method is invoked. 195 | .PP 196 | .CS 197 | typedef int (*\fBTcl_MethodCallProc\fR) ( 198 | ClientData \fIclientData\fR, 199 | Tcl_Interp *\fIinterp\fR, 200 | Tcl_ObjectContext \fIobjectContext\fR, 201 | int \fIobjc\fR, 202 | Tcl_Obj *const *\fIobjv\fR); 203 | .CE 204 | .PP 205 | The \fIclientData\fR argument to a Tcl_MethodCallProc is the value that was 206 | given when the method was created, the \fIinterp\fR is a place in which to 207 | execute scripts and access variables as well as being where to put the result 208 | of the method, and the \fIobjc\fR and \fIobjv\fR fields give the parameter 209 | objects to the method. The calling context of the method can be discovered 210 | through the \fIobjectContext\fR argument, and the return value from a 211 | Tcl_MethodCallProc is any Tcl return code (e.g. TCL_OK, TCL_ERROR). 212 | .SS "TCL_METHODDELETEPROC FUNCTION SIGNATURE" 213 | .PP 214 | Functions matching this signature are used when a method is deleted, whether 215 | through a new method being created or because the object or class is deleted. 216 | .PP 217 | .CS 218 | typedef void (*\fBTcl_MethodDeleteProc\fR) ( 219 | ClientData \fIclientData\fR); 220 | .CE 221 | .PP 222 | The \fIclientData\fR argument to a Tcl_MethodDeleteProc will be the same as 223 | the value passed to the \fIclientData\fR argument to \fBTcl_NewMethod\fR or 224 | \fBTcl_NewInstanceMethod\fR when the method was created. 225 | .SS "TCL_CLONEPROC FUNCTION SIGNATURE" 226 | .PP 227 | Functions matching this signature are used to copy a method when the object or 228 | class is copied using \fBTcl_CopyObjectInstance\fR (or \fBoo::copy\fR). 229 | .PP 230 | .CS 231 | typedef int (*\fBTcl_CloneProc\fR) ( 232 | Tcl_Interp *\fIinterp\fR, 233 | ClientData \fIoldClientData\fR, 234 | ClientData *\fInewClientDataPtr\fR); 235 | .CE 236 | .PP 237 | The \fIinterp\fR argument gives a place to write an error message when the 238 | attempt to clone the object is to fail, in which case the clone procedure must 239 | also return TCL_ERROR; it should return TCL_OK otherwise. 240 | The \fIoldClientData\fR field to a Tcl_CloneProc gives the value from the 241 | method being copied from, and the \fInewClientDataPtr\fR field will point to 242 | a variable in which to write the value for the method being copied to. 243 | .SH "SEE ALSO" 244 | Class(3), oo::class(n), oo::define(n), oo::object(n) 245 | .SH KEYWORDS 246 | constructor, method, object 247 | 248 | .\" Local variables: 249 | .\" mode: nroff 250 | .\" fill-column: 78 251 | .\" End: 252 | -------------------------------------------------------------------------------- /doc/OOInitStubs.3: -------------------------------------------------------------------------------- 1 | '\" 2 | '\" Copyright (c) 2012 Donal K. Fellows 3 | '\" 4 | '\" See the file "license.terms" for information on usage and redistribution 5 | '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. 6 | '\" 7 | .TH Tcl_OOInitStubs 3 1.0 TclOO "TclOO Library Functions" 8 | .so man.macros 9 | .BS 10 | '\" Note: do not modify the .SH NAME line immediately below! 11 | .SH NAME 12 | Tcl_OOInitStubs \- initialize library access to TclOO functionality 13 | .SH SYNOPSIS 14 | .nf 15 | \fB#include \fR 16 | .sp 17 | const char * 18 | \fBTcl_OOInitStubs\fR(\fIinterp\fR) 19 | .fi 20 | .SH ARGUMENTS 21 | .AS Tcl_Interp *interp in 22 | .AP Tcl_Interp *interp in 23 | The Tcl interpreter that the TclOO library is integrated with and whose C 24 | interface is going to be used. 25 | .BE 26 | .SH DESCRIPTION 27 | .PP 28 | When an extension library is going to use the C interface exposed by TclOO, it 29 | should use \fBTcl_OOInitStubs\fR to initialize its access to that interface 30 | from within its \fI*\fB_Init\fR (or \fI*\fB_SafeInit\fR) function, passing in 31 | the \fIinterp\fR that was passed into that routine as context. If the result 32 | of calling \fBTcl_OOInitStubs\fR is NULL, the initialization failed and an 33 | error message will have been left in the interpreter's result. Otherwise, the 34 | initialization succeeded and the TclOO API may thereafter be used. 35 | .PP 36 | When using this function, either the C #define symbol \fBUSE_TCLOO_STUBS\fR 37 | should be defined and your library code linked against the TclOO stub library, 38 | or that #define symbol should \fInot\fR be defined and your library code 39 | linked against the TclOO main library directly. The supplied configuration 40 | pre-supposes the former configuration, which is the only recommended 41 | configuration that will preserve forward compatibility with Tcl 8.6. It is 42 | \fIstrongly recommended\fR that Tcl also be linked in stubbed mode if TclOO 43 | is. 44 | .SH KEYWORDS 45 | stubs 46 | 47 | .\" Local variables: 48 | .\" mode: nroff 49 | .\" fill-column: 78 50 | .\" End: 51 | -------------------------------------------------------------------------------- /doc/class.n: -------------------------------------------------------------------------------- 1 | '\" 2 | '\" Copyright (c) 2007-2008 Donal K. Fellows 3 | '\" 4 | '\" See the file "license.terms" for information on usage and redistribution 5 | '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. 6 | '\" 7 | .TH class n 0.1 TclOO "TclOO Commands" 8 | .so man.macros 9 | .BS 10 | '\" Note: do not modify the .SH NAME line immediately below! 11 | .SH NAME 12 | oo::class \- class of all classes 13 | .SH SYNOPSIS 14 | .nf 15 | package require TclOO 16 | 17 | \fBoo::class\fI method \fR?\fIarg ...\fR? 18 | .fi 19 | .SH "CLASS HIERARCHY" 20 | .nf 21 | \fBoo::object\fR 22 | \(-> \fBoo::class\fR 23 | .fi 24 | .BE 25 | .SH DESCRIPTION 26 | .PP 27 | Classes are objects that can manufacture other objects according to a pattern 28 | stored in the factory object (the class). An instance of the class is created 29 | by calling one of the class's factory methods, typically either \fBcreate\fR 30 | if an explicit name is being given, or \fBnew\fR if an arbitrary unique name 31 | is to be automatically selected. 32 | .PP 33 | The \fBoo::class\fR class is the class of all classes; every class is an 34 | instance of this class, which is consequently an instance of itself. This 35 | class is a subclass of \fBoo::object\fR, so every class is also an object. 36 | Additional metaclasses (i.e., classes of classes) can be defined if necessary 37 | by subclassing \fBoo::class\fR. Note that the \fBoo::class\fR object hides the 38 | \fBnew\fR method on itself, so new classes should always be made using the 39 | \fBcreate\fR method. 40 | .SS CONSTRUCTOR 41 | The constructor of the \fBoo::class\fR class takes an optional argument which, 42 | if present, is sent to the \fBoo::define\fR command (along with the name of 43 | the newly-created class) to allow the class to be conveniently configured at 44 | creation time. 45 | .SS DESTRUCTOR 46 | The \fBoo::class\fR class does not define an explicit destructor. However, 47 | when a class is destroyed, all its subclasses and instances are also 48 | destroyed, along with all objects that it has been mixed into. 49 | .SS "EXPORTED METHODS" 50 | .TP 51 | \fIcls \fBcreate \fIname \fR?\fIarg ...\fR? 52 | . 53 | This creates a new instance of the class \fIcls\fR called \fIname\fR (which is 54 | resolved within the calling context's namespace if not fully qualified), 55 | passing the arguments, \fIarg ...\fR, to the constructor, and (if that returns 56 | a successful result) returning the fully qualified name of the created object 57 | (the result of the constructor is ignored). If the constructor fails (i.e., 58 | returns a non-OK result) then the object is destroyed and the error message is 59 | the result of this method call. 60 | .TP 61 | \fIcls \fBnew \fR?\fIarg ...\fR? 62 | . 63 | This creates a new instance of the class \fIcls\fR with a new unique name, 64 | passing the arguments, \fIarg ...\fR, to the constructor, and (if that returns 65 | a successful result) returning the fully qualified name of the created object 66 | (the result of the constructor is ignored). If the constructor fails (i.e., 67 | returns a non-OK result) then the object is destroyed and the error message is 68 | the result of this method call. 69 | .RS 70 | .PP 71 | Note that this method is not exported by the \fBoo::class\fR object itself, so 72 | classes should not be created using this method. 73 | .RE 74 | .SS "NON-EXPORTED METHODS" 75 | The \fBoo::class\fR class supports the following non-exported methods: 76 | .TP 77 | \fIcls \fBcreateWithNamespace\fI name nsName\fR ?\fIarg ...\fR? 78 | . 79 | This creates a new instance of the class \fIcls\fR called \fIname\fR (which is 80 | resolved within the calling context's namespace if not fully qualified), 81 | passing the arguments, \fIarg ...\fR, to the constructor, and (if that returns 82 | a successful result) returning the fully qualified name of the created object 83 | (the result of the constructor is ignored). The name of the instance's 84 | internal namespace will be \fInsName\fR unless that namespace already exists 85 | (when an arbitrary name will be chosen instead). If the constructor fails 86 | (i.e., returns a non-OK result) then the object is destroyed and the error 87 | message is the result of this method call. 88 | .SH EXAMPLES 89 | This example defines a simple class hierarchy and creates a new instance of 90 | it. It then invokes a method of the object before destroying the hierarchy and 91 | showing that the destruction is transitive. 92 | .CS 93 | \fBoo::class create\fR fruit { 94 | method eat {} { 95 | puts "yummy!" 96 | } 97 | } 98 | \fBoo::class create\fR banana { 99 | superclass fruit 100 | constructor {} { 101 | my variable peeled 102 | set peeled 0 103 | } 104 | method peel {} { 105 | my variable peeled 106 | set peeled 1 107 | puts "skin now off" 108 | } 109 | method edible? {} { 110 | my variable peeled 111 | return $peeled 112 | } 113 | method eat {} { 114 | if {![my edible?]} { 115 | my peel 116 | } 117 | next 118 | } 119 | } 120 | set b [banana \fBnew\fR] 121 | $b eat \fI\(-> prints "skin now off" and "yummy!"\fR 122 | fruit destroy 123 | $b eat \fI\(-> error "unknown command"\fR 124 | .CE 125 | .SH "SEE ALSO" 126 | oo::define(n), oo::object(n) 127 | .SH KEYWORDS 128 | class, metaclass, object 129 | 130 | .\" Local variables: 131 | .\" mode: nroff 132 | .\" fill-column: 78 133 | .\" End: 134 | -------------------------------------------------------------------------------- /doc/copy.n: -------------------------------------------------------------------------------- 1 | '\" 2 | '\" Copyright (c) 2007-2008 Donal K. Fellows 3 | '\" 4 | '\" See the file "license.terms" for information on usage and redistribution 5 | '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. 6 | '\" 7 | .TH copy n 0.1 TclOO "TclOO Commands" 8 | .so man.macros 9 | .BS 10 | '\" Note: do not modify the .SH NAME line immediately below! 11 | .SH NAME 12 | oo::copy \- create copies of objects and classes 13 | .SH SYNOPSIS 14 | .nf 15 | package require TclOO 16 | 17 | \fBoo::copy\fI sourceObject \fR?\fItargetObject\fR? 18 | .fi 19 | .BE 20 | 21 | .SH DESCRIPTION 22 | The \fBoo::copy\fR command creates a copy of an object or class. It takes the 23 | name of the object or class to be copied, \fIsourceObject\fR, and optionally 24 | the name of the object or class to create, \fItargetObject\fR, which will be 25 | resolved relative to the current namespace if not an absolute qualified name. 26 | If \fItargetObject\fR is omitted, a new name is chosen. The copied object will 27 | be of the same class as the source object, and will have all its per-object 28 | methods copied. If it is a class, it will also have all the class methods in 29 | the class copied, but it will not have any of its instances copied. 30 | .PP 31 | After the \fItargetObject\fR has been created and all definitions of its 32 | configuration (e.g., methods, filters, mixins) copied, the \fB\fR 33 | method of \fItargetObject\fR will be invoked, to allow for the customization 34 | of the created object. The only argument given will be \fIsourceObject\fR. The 35 | default implementation of this method (in \fBoo::object\fR) just copies the 36 | procedures and variables in the namespace of \fIsourceObject\fR to the 37 | namespace of \fItargetObject\fR. If this method call does not return a result 38 | that is successful (i.e., an error or other kind of exception) then the 39 | \fItargetObject\fR will be deleted and an error returned. 40 | .PP 41 | The result of this command will be the fully-qualified name of the new object 42 | or class. 43 | .SH EXAMPLES 44 | This example creates an object, copies it, modifies the source object, and 45 | then demonstrates that the copied object is indeed a copy. 46 | .PP 47 | .CS 48 | oo::object create src 49 | oo::objdefine src method msg {} {puts foo} 50 | \fBoo::copy\fR src dst 51 | oo::objdefine src method msg {} {puts bar} 52 | src msg \fI\(-> prints "bar"\fR 53 | dst msg \fI\(-> prints "foo"\fR 54 | .CE 55 | .SH "SEE ALSO" 56 | oo::class(n), oo::define(n), oo::object(n) 57 | .SH KEYWORDS 58 | clone, copy, duplication, object 59 | 60 | .\" Local variables: 61 | .\" mode: nroff 62 | .\" fill-column: 78 63 | .\" End: 64 | -------------------------------------------------------------------------------- /doc/define.n: -------------------------------------------------------------------------------- 1 | '\" 2 | '\" Copyright (c) 2007-2008 Donal K. Fellows 3 | '\" 4 | '\" See the file "license.terms" for information on usage and redistribution 5 | '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. 6 | '\" 7 | .TH define n 0.3 TclOO "TclOO Commands" 8 | .so man.macros 9 | .BS 10 | '\" Note: do not modify the .SH NAME line immediately below! 11 | .SH NAME 12 | oo::define, oo::objdefine \- define and configure classes and objects 13 | .SH SYNOPSIS 14 | .nf 15 | package require TclOO 16 | 17 | \fBoo::define\fI class defScript\fR 18 | \fBoo::define\fI class subcommand arg\fR ?\fIarg ...\fR? 19 | \fBoo::objdefine\fI object defScript\fR 20 | \fBoo::objdefine\fI object subcommand arg\fR ?\fIarg ...\fR? 21 | .fi 22 | .BE 23 | 24 | .SH DESCRIPTION 25 | The \fBoo::define\fR command is used to control the configuration of classes, 26 | and the \fBoo::objdefine\fR command is used to control the configuration of 27 | objects (including classes as instance objects), with the configuration being 28 | applied to the entity named in the \fIclass\fR or the \fIobject\fR argument. 29 | Configuring a class also updates the 30 | configuration of all subclasses of the class and all objects that are 31 | instances of that class or which mix it in (as modified by any per-instance 32 | configuration). The way in which the configuration is done is controlled by 33 | either the \fIdefScript\fR argument or by the \fIsubcommand\fR and following 34 | \fIarg\fR arguments; when the second is present, it is exactly as if all the 35 | arguments from \fIsubcommand\fR onwards are made into a list and that list is 36 | used as the \fIdefScript\fR argument. 37 | .SS "CONFIGURING CLASSES" 38 | .PP 39 | The following commands are supported in the \fIdefScript\fR for 40 | \fBoo::define\fR, each of which may also be used in the \fIsubcommand\fR form: 41 | .TP 42 | \fBconstructor\fI argList bodyScript\fR 43 | . 44 | This creates or updates the constructor for a class. The formal arguments to 45 | the constructor (defined using the same format as for the Tcl \fBproc\fR 46 | command) will be \fIargList\fR, and the body of the constructor will be 47 | \fIbodyScript\fR. When the body of the constructor is evaluated, the current 48 | namespace of the constructor will be a namespace that is unique to the object 49 | being constructed. Within the constructor, the \fBnext\fR command should be 50 | used to call the superclasses' constructors. If \fIbodyScript\fR is the empty 51 | string, the constructor will be deleted. 52 | .TP 53 | \fBdeletemethod\fI name\fR ?\fIname ...\fR 54 | . 55 | This deletes each of the methods called \fIname\fR from a class. The methods 56 | must have previously existed in that class. Does not affect the superclasses 57 | of the class, nor does it affect the subclasses or instances of the class 58 | (except when they have a call chain through the class being modified). 59 | .TP 60 | \fBdestructor\fI bodyScript\fR 61 | . 62 | This creates or updates the destructor for a class. Destructors take no 63 | arguments, and the body of the destructor will be \fIbodyScript\fR. The 64 | destructor is called when objects of the class are deleted, and when called 65 | will have the object's unique namespace as the current namespace. Destructors 66 | should use the \fBnext\fR command to call the superclasses' destructors. Note 67 | that destructors are not called in all situations (e.g. if the interpreter is 68 | destroyed). If \fIbodyScript\fR is the empty string, the destructor will be 69 | deleted. 70 | .RS 71 | Note that errors during the evaluation of a destructor \fIare not returned\fR 72 | to the code that causes the destruction of an object. Instead, they are passed 73 | to the currently-defined \fBbgerror\fR handler. 74 | .RE 75 | .TP 76 | \fBexport\fI name \fR?\fIname ...\fR? 77 | . 78 | This arranges for each of the named methods, \fIname\fR, to be exported 79 | (i.e. usable outside an instance through the instance object's command) by the 80 | class being defined. Note that the methods themselves may be actually defined 81 | by a superclass; subclass exports override superclass visibility, and may in 82 | turn be overridden by instances. 83 | .TP 84 | \fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR? 85 | .VS 86 | This slot (see \fBSLOTTED DEFINITIONS\fR below) 87 | .VE 88 | sets or updates the list of method names that are used to guard whether 89 | method call to instances of the class may be called and what the method's 90 | results are. Each \fImethodName\fR names a single filtering method (which may 91 | be exposed or not exposed); it is not an error for a non-existent method to be 92 | named since they may be defined by subclasses. 93 | .VS 94 | By default, this slot works by appending. 95 | .VE 96 | .TP 97 | \fBforward\fI name cmdName \fR?\fIarg ...\fR? 98 | . 99 | This creates or updates a forwarded method called \fIname\fR. The method is 100 | defined be forwarded to the command called \fIcmdName\fR, with additional 101 | arguments, \fIarg\fR etc., added before those arguments specified by the 102 | caller of the method. The \fIcmdName\fR will always be resolved using the 103 | rules of the invoking objects' namespaces, i.e., when \fIcmdName\fR is not 104 | fully-qualified, the command will be searched for in each object's namespace, 105 | using the instances' namespace's path, or by looking in the global namespace. 106 | The method will be exported if \fIname\fR starts with a lower-case letter, and 107 | non-exported otherwise. 108 | .TP 109 | \fBmethod\fI name argList bodyScript\fR 110 | . 111 | This creates or updates a method that is implemented as a procedure-like 112 | script. The name of the method is \fIname\fR, the formal arguments to the 113 | method (defined using the same format as for the Tcl \fBproc\fR command) will 114 | be \fIargList\fR, and the body of the method will be \fIbodyScript\fR. When 115 | the body of the method is evaluated, the current namespace of the method will 116 | be a namespace that is unique to the current object. The method will be 117 | exported if \fIname\fR starts with a lower-case letter, and non-exported 118 | otherwise; this behavior can be overridden via \fBexport\fR and 119 | \fBunexport\fR. 120 | .TP 121 | \fBmixin\fR ?\fI\-slotOperation\fR? ?\fIclassName ...\fR? 122 | .VS 123 | This slot (see \fBSLOTTED DEFINITIONS\fR below) 124 | .VE 125 | sets or updates the list of additional classes that are to be mixed into 126 | all the instances of the class being defined. Each \fIclassName\fR argument 127 | names a single class that is to be mixed in. 128 | .VS 129 | By default, this slot works by replacement. 130 | .VE 131 | .TP 132 | \fBrenamemethod\fI fromName toName\fR 133 | . 134 | This renames the method called \fIfromName\fR in a class to \fItoName\fR. The 135 | method must have previously existed in the class, and \fItoName\fR must not 136 | previously refer to a method in that class. Does not affect the superclasses 137 | of the class, nor does it affect the subclasses or instances of the class 138 | (except when they have a call chain through the class being modified). Does 139 | not change the export status of the method; if it was exported before, it will 140 | be afterwards. 141 | .TP 142 | \fBself\fI subcommand arg ...\fR 143 | .TP 144 | \fBself\fI script\fR 145 | . 146 | This command is equivalent to calling \fBoo::objdefine\fR on the class being 147 | defined (see \fBCONFIGURING OBJECTS\fR below for a description of the 148 | supported values of \fIsubcommand\fR). It follows the same general pattern of 149 | argument handling as the \fBoo::define\fR and \fBoo::objdefine\fR commands, 150 | and 151 | .QW "\fBoo::define \fIcls \fBself \fIsubcommand ...\fR" 152 | operates identically to 153 | .QW "\fBoo::objdefine \fIcls subcommand ...\fR" . 154 | .TP 155 | \fBsuperclass\fR ?\fI\-slotOperation\fR? ?\fIclassName ...\fR? 156 | .VS 157 | This slot (see \fBSLOTTED DEFINITIONS\fR below) 158 | .VE 159 | allows the alteration of the superclasses of the class being defined. 160 | Each \fIclassName\fR argument names one class that is to be a superclass of 161 | the defined class. Note that objects must not be changed from being classes to 162 | being non-classes or vice-versa, that an empty parent class is equivalent to 163 | \fBoo::object\fR, and that the parent classes of \fBoo::object\fR and 164 | \fBoo::class\fR may not be modified. 165 | .VS 166 | By default, this slot works by replacement. 167 | .VE 168 | .TP 169 | \fBunexport\fI name \fR?\fIname ...\fR? 170 | . 171 | This arranges for each of the named methods, \fIname\fR, to be not exported 172 | (i.e. not usable outside the instance through the instance object's command, 173 | but instead just through the \fBmy\fR command visible in each object's 174 | context) by the class being defined. Note that the methods themselves may be 175 | actually defined by a superclass; subclass unexports override superclass 176 | visibility, and may be overridden by instance unexports. 177 | .TP 178 | \fBvariable\fR ?\fI\-slotOperation\fR? ?\fIname ...\fR? 179 | .VS 180 | This slot (see \fBSLOTTED DEFINITIONS\fR below) arranges for each of the named 181 | variables to be automatically made 182 | available in the methods, constructor and destructor declared by the class 183 | being defined. Each variable name must not have any namespace 184 | separators and must not look like an array access. All variables will be 185 | actually present in the instance object on which the method is executed. Note 186 | that the variable lists declared by a superclass or subclass are completely 187 | disjoint, as are variable lists declared by instances; the list of variable 188 | names is just for methods (and constructors and destructors) declared by this 189 | class. By default, this slot works by appending. 190 | .VE 191 | .SS "CONFIGURING OBJECTS" 192 | .PP 193 | The following commands are supported in the \fIdefScript\fR for 194 | \fBoo::objdefine\fR, each of which may also be used in the \fIsubcommand\fR 195 | form: 196 | .TP 197 | \fBclass\fI className\fR 198 | . 199 | This allows the class of an object to be changed after creation. Note that the 200 | class's constructors are not called when this is done, and so the object may 201 | well be in an inconsistent state unless additional configuration work is done. 202 | .TP 203 | \fBdeletemethod\fI name\fR ?\fIname ...\fR 204 | . 205 | This deletes each of the methods called \fIname\fR from an object. The methods 206 | must have previously existed in that object. Does not affect the classes that 207 | the object is an instance of. 208 | .TP 209 | \fBexport\fI name \fR?\fIname ...\fR? 210 | . 211 | This arranges for each of the named methods, \fIname\fR, to be exported 212 | (i.e. usable outside the object through the object's command) by the object 213 | being defined. Note that the methods themselves may be actually defined by a 214 | class or superclass; object exports override class visibility. 215 | .TP 216 | \fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR? 217 | .VS 218 | This slot (see \fBSLOTTED DEFINITIONS\fR below) 219 | .VE 220 | sets or updates the list of method names that are used to guard whether a 221 | method call to the object may be called and what the method's results are. 222 | Each \fImethodName\fR names a single filtering method (which may be exposed or 223 | not exposed); it is not an error for a non-existent method to be named. Note 224 | that the actual list of filters also depends on the filters set upon any 225 | classes that the object is an instance of. 226 | .VS 227 | By default, this slot works by appending. 228 | .VE 229 | .TP 230 | \fBforward\fI name cmdName \fR?\fIarg ...\fR? 231 | . 232 | This creates or updates a forwarded object method called \fIname\fR. The 233 | method is defined be forwarded to the command called \fIcmdName\fR, with 234 | additional arguments, \fIarg\fR etc., added before those arguments specified 235 | by the caller of the method. Forwarded methods should be deleted using the 236 | \fBmethod\fR subcommand. The method will be exported if \fIname\fR starts with 237 | a lower-case letter, and non-exported otherwise. 238 | .TP 239 | \fBmethod\fI name argList bodyScript\fR 240 | . 241 | This creates, updates or deletes an object method. The name of the method is 242 | \fIname\fR, the formal arguments to the method (defined using the same format 243 | as for the Tcl \fBproc\fR command) will be \fIargList\fR, and the body of the 244 | method will be \fIbodyScript\fR. When the body of the method is evaluated, the 245 | current namespace of the method will be a namespace that is unique to the 246 | object. The method will be exported if \fIname\fR starts with a lower-case 247 | letter, and non-exported otherwise. 248 | .TP 249 | \fBmixin\fR ?\fI\-slotOperation\fR? ?\fIclassName ...\fR? 250 | .VS 251 | This slot (see \fBSLOTTED DEFINITIONS\fR below) 252 | .VE 253 | sets or updates a per-object list of additional classes that are to be 254 | mixed into the object. Each argument, \fIclassName\fR, names a single class 255 | that is to be mixed in. 256 | .VS 257 | By default, this slot works by replacement. 258 | .VE 259 | .TP 260 | \fBrenamemethod\fI fromName toName\fR 261 | . 262 | This renames the method called \fIfromName\fR in an object to \fItoName\fR. 263 | The method must have previously existed in the object, and \fItoName\fR must 264 | not previously refer to a method in that object. Does not affect the classes 265 | that the object is an instance of. Does not change the export status of the 266 | method; if it was exported before, it will be afterwards. 267 | .TP 268 | \fBunexport\fI name \fR?\fIname ...\fR? 269 | . 270 | This arranges for each of the named methods, \fIname\fR, to be not exported 271 | (i.e. not usable outside the object through the object's command, but instead 272 | just through the \fBmy\fR command visible in the object's context) by the 273 | object being defined. Note that the methods themselves may be actually defined 274 | by a class; instance unexports override class visibility. 275 | .TP 276 | \fBvariable\fR ?\fI\-slotOperation\fR? ?\fIname ...\fR? 277 | .VS 278 | This slot (see \fBSLOTTED DEFINITIONS\fR below) arranges for each of the named 279 | variables to be automatically made available in the methods declared by the 280 | object being defined. Each variable name must not have any namespace 281 | separators and must not look like an array access. All variables will be 282 | actually present in the object on which the method is executed. Note that the 283 | variable lists declared by the classes and mixins of which the object is an 284 | instance are completely disjoint; the list of variable names is just for 285 | methods declared by this object. By default, this slot works by appending. 286 | .SH "SLOTTED DEFINITIONS" 287 | Some of the configurable definitions of a class or object are \fIslotted 288 | definitions\fR. This means that the configuration is implemented by a slot 289 | object, that is an instance of the class \fBoo::Slot\fR, which manages a list 290 | of values (class names, variable names, etc.) that comprises the contents of 291 | the slot. The class defines three operations (as methods) that may be done on 292 | the slot: 293 | .VE 294 | .TP 295 | \fIslot\fR \fB\-append\fR ?\fImember ...\fR? 296 | .VS 297 | This appends the given \fImember\fR elements to the slot definition. 298 | .VE 299 | .TP 300 | \fIslot\fR \fB\-clear\fR 301 | .VS 302 | This sets the slot definition to the empty list. 303 | .VE 304 | .TP 305 | \fIslot\fR \fB\-set\fR ?\fImember ...\fR? 306 | .VS 307 | This replaces the slot definition with the given \fImember\fR elements. 308 | .PP 309 | A consequence of this is that any use of a slot's default operation where the 310 | first member argument begins with a hyphen will be an error. One of the above 311 | operations should be used explicitly in those circumstances. 312 | .SS "SLOT IMPLEMENTATION" 313 | Internally, slot objects also define a method \fB\-\-default\-operation\fR 314 | which is forwarded to the default operation of the slot (thus, for the class 315 | .QW \fBvariable\fR 316 | slot, this is forwarded to 317 | .QW "\fBmy \-append\fR" ), 318 | and these methods which provide the implementation interface: 319 | .VE 320 | .TP 321 | \fIslot\fR \fBGet\fR 322 | .VS 323 | Returns a list that is the current contents of the slot. This method must 324 | always be called from a stack frame created by a call to \fBoo::define\fR or 325 | \fBoo::objdefine\fR. 326 | .VE 327 | .TP 328 | \fIslot\fR \fBSet \fIelementList\fR 329 | .VS 330 | Sets the contents of the slot to the list \fIelementList\fR and returns the 331 | empty string. This method must always be called from a stack frame created by 332 | a call to \fBoo::define\fR or \fBoo::objdefine\fR. 333 | .PP 334 | The implementation of these methods is slot-dependent (and responsible for 335 | accessing the correct part of the class or object definition). Slots also have 336 | an unknown method handler to tie all these pieces together, and they hide 337 | their \fBdestroy\fR method so that it is not invoked inadvertently. It is 338 | \fIrecommended\fR that any user changes to the slot mechanism be restricted to 339 | defining new operations whose names start with a hyphen. 340 | .VE 341 | .SH EXAMPLES 342 | This example demonstrates how to use both forms of the \fBoo::define\fR and 343 | \fBoo::objdefine\fR commands (they work in the same way), as well as 344 | illustrating four of the subcommands of them. 345 | .PP 346 | .CS 347 | oo::class create c 348 | c create o 349 | \fBoo::define\fR c \fBmethod\fR foo {} { 350 | puts "world" 351 | } 352 | \fBoo::objdefine\fR o { 353 | \fBmethod\fR bar {} { 354 | my Foo "hello " 355 | my foo 356 | } 357 | \fBforward\fR Foo ::puts -nonewline 358 | \fBunexport\fR foo 359 | } 360 | o bar \fI\(-> prints "hello world"\fR 361 | o foo \fI\(-> error "unknown method foo"\fR 362 | o Foo Bar \fI\(-> error "unknown method Foo"\fR 363 | \fBoo::objdefine\fR o \fBrenamemethod\fR bar lollipop 364 | o lollipop \fI\(-> prints "hello world"\fR 365 | .CE 366 | .PP 367 | This example shows how additional classes can be mixed into an object. It also 368 | shows how \fBmixin\fR is a slot that supports appending: 369 | .PP 370 | .CS 371 | oo::object create inst 372 | inst m1 \fI\(-> error "unknown method m1"\fR 373 | inst m2 \fI\(-> error "unknown method m2"\fR 374 | 375 | oo::class create A { 376 | \fBmethod\fR m1 {} { 377 | puts "red brick" 378 | } 379 | } 380 | \fBoo::objdefine\fR inst { 381 | \fBmixin\fR A 382 | } 383 | inst m1 \fI\(-> prints "red brick"\fR 384 | inst m2 \fI\(-> error "unknown method m2"\fR 385 | 386 | oo::class create B { 387 | \fBmethod\fR m2 {} { 388 | puts "blue brick" 389 | } 390 | } 391 | \fBoo::objdefine\fR inst { 392 | \fBmixin -append\fR B 393 | } 394 | inst m1 \fI\(-> prints "red brick"\fR 395 | inst m2 \fI\(-> prints "blue brick"\fR 396 | .CE 397 | .SH "SEE ALSO" 398 | next(n), oo::class(n), oo::object(n) 399 | .SH KEYWORDS 400 | class, definition, method, object, slot 401 | .\" Local variables: 402 | .\" mode: nroff 403 | .\" fill-column: 78 404 | .\" End: 405 | -------------------------------------------------------------------------------- /doc/my.n: -------------------------------------------------------------------------------- 1 | '\" 2 | '\" Copyright (c) 2007-2008 Donal K. Fellows 3 | '\" 4 | '\" See the file "license.terms" for information on usage and redistribution 5 | '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. 6 | '\" 7 | .TH my n 0.1 TclOO "TclOO Commands" 8 | .so man.macros 9 | .BS 10 | '\" Note: do not modify the .SH NAME line immediately below! 11 | .SH NAME 12 | my \- invoke any method of current object 13 | .SH SYNOPSIS 14 | .nf 15 | package require TclOO 16 | 17 | \fBmy\fI methodName\fR ?\fIarg ...\fR? 18 | .fi 19 | .BE 20 | 21 | .SH DESCRIPTION 22 | The \fBmy\fR command is used to allow methods of objects to invoke any method 23 | of the object (or its class). In particular, the set of valid values for 24 | \fImethodName\fR is the set of all methods supported by an object and its 25 | superclasses, including those that are not exported. The object upon which the 26 | method is invoked is always the one that is the current context of the method 27 | (i.e. the object that is returned by \fBself object\fR) from which the 28 | \fBmy\fR command is invoked. 29 | .PP 30 | Each object has its own \fBmy\fR command, contained in its unique namespace. 31 | .SH EXAMPLES 32 | This example shows basic use of \fBmy\fR to use the \fBvariables\fR method of 33 | the \fBoo::object\fR class, which is not publically visible by default: 34 | .CS 35 | oo::class create c { 36 | method count {} { 37 | \fBmy\fR variable counter 38 | puts [incr counter] 39 | } 40 | } 41 | c create o 42 | o count \fI\(-> prints "1"\fR 43 | o count \fI\(-> prints "2"\fR 44 | o count \fI\(-> prints "3"\fR 45 | .CE 46 | .SH "SEE ALSO" 47 | next(n), oo::object(n), self(n) 48 | .SH KEYWORDS 49 | method, method visibility, object, private method, public method 50 | 51 | .\" Local variables: 52 | .\" mode: nroff 53 | .\" fill-column: 78 54 | .\" End: 55 | -------------------------------------------------------------------------------- /doc/next.n: -------------------------------------------------------------------------------- 1 | '\" 2 | '\" Copyright (c) 2007-2011 Donal K. Fellows 3 | '\" 4 | '\" See the file "license.terms" for information on usage and redistribution 5 | '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. 6 | '\" 7 | .TH next n 0.1 TclOO "TclOO Commands" 8 | .so man.macros 9 | .BS 10 | '\" Note: do not modify the .SH NAME line immediately below! 11 | .SH NAME 12 | next, nextto \- invoke superclass method implementations 13 | .SH SYNOPSIS 14 | .nf 15 | package require TclOO 16 | 17 | \fBnext\fR ?\fIarg ...\fR? 18 | \fBnextto\fI class\fR ?\fIarg ...\fR? 19 | .fi 20 | .BE 21 | 22 | .SH DESCRIPTION 23 | .PP 24 | The \fBnext\fR command is used to call implementations of a method by a class, 25 | superclass or mixin that are overridden by the current method. It can only be 26 | used from within a method. It is also used within filters to indicate the 27 | point where a filter calls the actual implementation (the filter may decide to 28 | not go along the chain, and may process the results of going along the chain 29 | of methods as it chooses). The result of the \fBnext\fR command is the result 30 | of the next method in the method chain; if there are no further methods in the 31 | method chain, the result of \fBnext\fR will be an error. The arguments, 32 | \fIarg\fR, to \fBnext\fR are the arguments to pass to the next method in the 33 | chain. 34 | .PP 35 | .VS 36 | The \fBnextto\fR command is the same as the \fBnext\fR command, except that it 37 | takes an additional \fIclass\fR argument that identifies a class whose 38 | implementation of the current method chain (see \fBinfo object call\fR) should 39 | be used; the method implementation selected will be the one provided by the 40 | given class, and it must refer to an existing non-filter invocation that lies 41 | further along the chain than the current implementation. 42 | .VE 43 | .SH "THE METHOD CHAIN" 44 | .PP 45 | When a method of an object is invoked, things happen in several stages: 46 | .IP [1] 47 | The structure of the object, its class, superclasses, filters, and mixins, are 48 | examined to build a \fImethod chain\fR, which contains a list of method 49 | implementations to invoke. 50 | .IP [2] 51 | The first method implementation on the chain is invoked. 52 | .IP [3] 53 | If that method implementation invokes the \fBnext\fR command, the next method 54 | implementation is invoked (with its arguments being those that were passed to 55 | \fBnext\fR). 56 | .IP [4] 57 | The result from the overall method call is the result from the outermost 58 | method implementation; inner method implementations return their results 59 | through \fBnext\fR. 60 | .IP [5] 61 | The method chain is cached for future use. 62 | .SS "METHOD SEARCH ORDER" 63 | .PP 64 | When constructing the method chain, method implementations are searched for in 65 | the following order: 66 | .IP [1] 67 | In the classes mixed into the object, in class traversal order. The list of 68 | mixins is checked in natural order. 69 | .IP [2] 70 | In the classes mixed into the classes of the object, with sources of mixing in 71 | being searched in class traversal order. Within each class, the list of mixins 72 | is processed in natural order. 73 | .IP [3] 74 | In the object itself. 75 | .IP [4] 76 | In the object's class. 77 | .IP [5] 78 | In the superclasses of the class, following each superclass in a depth-first 79 | fashion in the natural order of the superclass list. 80 | .PP 81 | Any particular method implementation always comes as \fIlate\fR in the 82 | resulting list of implementations as possible; this means that if some class, 83 | A, is both mixed into a class, B, and is also a superclass of B, the instances 84 | of B will always treat A as a superclass from the perspective of inheritance. 85 | This is true even when the multiple inheritance is processed indirectly. 86 | .SS FILTERS 87 | .PP 88 | When an object has a list of filter names set upon it, or is an instance of a 89 | class (or has mixed in a class) that has a list of filter names set upon it, 90 | before every invokation of any method the filters are processed. Filter 91 | implementations are found in class traversal order, as are the lists of filter 92 | names (each of which is traversed in natural list order). Explicitly invoking 93 | a method used as a filter will cause that method to be invoked twice, once as 94 | a filter and once as a normal method. 95 | .PP 96 | Each filter should decide for itself whether to permit the execution to go 97 | forward to the proper implementation of the method (which it does by invoking 98 | the \fBnext\fR command as filters are inserted into the front of the method 99 | call chain) and is responsible for returning the result of \fBnext\fR. 100 | .PP 101 | Filters are invoked when processing an invokation of the \fBunknown\fR 102 | method because of a failure to locate a method implementation, but \fInot\fR 103 | when invoking either constructors or destructors. (Note however that the 104 | \fBdestroy\fR method is a conventional method, and filters are invoked as 105 | normal when it is called.) 106 | .SH EXAMPLES 107 | .PP 108 | This example demonstrates how to use the \fBnext\fR command to call the 109 | (super)class's implementation of a method. The script: 110 | .CS 111 | oo::class create theSuperclass { 112 | method example {args} { 113 | puts "in the superclass, args = $args" 114 | } 115 | } 116 | oo::class create theSubclass { 117 | superclass theSuperclass 118 | method example {args} { 119 | puts "before chaining from subclass, args = $args" 120 | \fBnext\fR a {*}$args b 121 | \fBnext\fR pureSynthesis 122 | puts "after chaining from subclass" 123 | } 124 | } 125 | theSubclass create obj 126 | oo::objdefine obj method example args { 127 | puts "per-object method, args = $args" 128 | \fBnext\fR x {*}$args y 129 | \fBnext\fR 130 | } 131 | obj example 1 2 3 132 | .CE 133 | prints the following: 134 | .CS 135 | per-object method, args = 1 2 3 136 | before chaining from subclass, args = x 1 2 3 y 137 | in the superclass, args = a x 1 2 3 y b 138 | in the superclass, args = pureSynthesis 139 | after chaining from subclass 140 | before chaining from subclass, args = 141 | in the superclass, args = a b 142 | in the superclassm args = pureSynthesis 143 | after chaining from subclass 144 | .CE 145 | .PP 146 | This example demonstrates how to build a simple cache class that applies 147 | memoization to all the method calls of the objects it is mixed into, and shows 148 | how it can make a difference to computation times: 149 | .PP 150 | .CS 151 | oo::class create cache { 152 | filter Memoize 153 | method Memoize args { 154 | \fI# Do not filter the core method implementations\fR 155 | if {[lindex [self target] 0] eq "::oo::object"} { 156 | return [\fBnext\fR {*}$args] 157 | } 158 | 159 | \fI# Check if the value is already in the cache\fR 160 | my variable ValueCache 161 | set key [self target],$args 162 | if {[info exist ValueCache($key)]} { 163 | return $ValueCache($key) 164 | } 165 | 166 | \fI# Compute value, insert into cache, and return it\fR 167 | return [set ValueCache($key) [\fBnext\fR {*}$args]] 168 | } 169 | method flushCache {} { 170 | my variable ValueCache 171 | unset ValueCache 172 | \fI# Skip the cacheing\fR 173 | return -level 2 "" 174 | } 175 | } 176 | 177 | oo::object create demo 178 | oo::objdefine demo { 179 | mixin cache 180 | method compute {a b c} { 181 | after 3000 \fI;# Simulate deep thought\fR 182 | return [expr {$a + $b * $c}] 183 | } 184 | method compute2 {a b c} { 185 | after 3000 \fI;# Simulate deep thought\fR 186 | return [expr {$a * $b + $c}] 187 | } 188 | } 189 | 190 | puts [demo compute 1 2 3] \fI\(-> prints "7" after delay\fR 191 | puts [demo compute2 4 5 6] \fI\(-> prints "26" after delay\fR 192 | puts [demo compute 1 2 3] \fI\(-> prints "7" instantly\fR 193 | puts [demo compute2 4 5 6] \fI\(-> prints "26" instantly\fR 194 | puts [demo compute 4 5 6] \fI\(-> prints "34" after delay\fR 195 | puts [demo compute 4 5 6] \fI\(-> prints "34" instantly\fR 196 | puts [demo compute 1 2 3] \fI\(-> prints "7" instantly\fR 197 | demo flushCache 198 | puts [demo compute 1 2 3] \fI\(-> prints "7" after delay\fR 199 | .CE 200 | .SH "SEE ALSO" 201 | oo::class(n), oo::define(n), oo::object(n), self(n) 202 | .SH KEYWORDS 203 | call, method, method chain 204 | 205 | .\" Local variables: 206 | .\" mode: nroff 207 | .\" fill-column: 78 208 | .\" End: 209 | -------------------------------------------------------------------------------- /doc/object.n: -------------------------------------------------------------------------------- 1 | '\" 2 | '\" Copyright (c) 2007-2008 Donal K. Fellows 3 | '\" 4 | '\" See the file "license.terms" for information on usage and redistribution 5 | '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. 6 | '\" 7 | .TH object n 0.1 TclOO "TclOO Commands" 8 | .so man.macros 9 | .BS 10 | '\" Note: do not modify the .SH NAME line immediately below! 11 | .SH NAME 12 | oo::object \- root class of the class hierarchy 13 | .SH SYNOPSIS 14 | .nf 15 | package require TclOO 16 | 17 | \fBoo::object\fI method \fR?\fIarg ...\fR? 18 | .fi 19 | .SH "CLASS HIERARCHY" 20 | .nf 21 | \fBoo::object\fR 22 | .fi 23 | .BE 24 | .SH DESCRIPTION 25 | .PP 26 | The \fBoo::object\fR class is the root class of the object hierarchy; every 27 | object is an instance of this class. Since classes are themselves objects, 28 | they are instances of this class too. Objects are always referred to by their 29 | name, and may be \fBrename\fRd while maintaining their identity. 30 | .PP 31 | Instances of objects may be made with either the \fBcreate\fR or \fBnew\fR 32 | methods of the \fBoo::object\fR object itself, or by invoking those methods on 33 | any of the subclass objects; see \fBoo::class\fR for more details. The 34 | configuration of individual objects (i.e., instance-specific methods, mixed-in 35 | classes, etc.) may be controlled with the \fBoo::objdefine\fR command. 36 | .PP 37 | Each object has a unique namespace associated with it, the instance namespace. 38 | This namespace holds all the instance variables of the object, and will be the 39 | current namespace whenever a method of the object is invoked (including a 40 | method of the class of the object). When the object is destroyed, its instance 41 | namespace is deleted. The instance namespace contains the object's \fBmy\fR 42 | command, which may be used to invoke non-exported methods of the object or to 43 | create a reference to the object for the purpose of invokation which persists 44 | across renamings of the object. 45 | .SS CONSTRUCTOR 46 | The \fBoo::object\fR class does not define an explicit constructor. 47 | .SS DESTRUCTOR 48 | The \fBoo::object\fR class does not define an explicit destructor. 49 | .SS "EXPORTED METHODS" 50 | The \fBoo::object\fR class supports the following exported methods: 51 | .TP 52 | \fIobj \fBdestroy\fR 53 | . 54 | This method destroys the object, \fIobj\fR, that it is invoked upon, invoking 55 | any destructors on the object's class in the process. It is equivalent to 56 | using \fBrename\fR to delete the object command. The result of this method is 57 | always the empty string. 58 | .SS "NON-EXPORTED METHODS" 59 | The \fBoo::object\fR class supports the following non-exported methods: 60 | .TP 61 | \fIobj \fBeval\fR ?\fIarg ...\fR? 62 | . 63 | This method concatenates the arguments, \fIarg\fR, as if with \fBconcat\fR, 64 | and then evaluates the resulting script in the namespace that is uniquely 65 | associated with \fIobj\fR, returning the result of the evaluation. 66 | .TP 67 | \fIobj \fBunknown ?\fImethodName\fR? ?\fIarg ...\fR? 68 | . 69 | This method is called when an attempt to invoke the method \fImethodName\fR on 70 | object \fIobj\fR fails. The arguments that the user supplied to the method are 71 | given as \fIarg\fR argments. 72 | .VS 73 | If \fImethodName\fR is absent, the object was invoked with no method name at 74 | all (or any other arguments). 75 | .VE 76 | The default implementation (i.e., the one defined by the \fBoo::object\fR 77 | class) generates a suitable error, detailing what methods the object supports 78 | given whether the object was invoked by its public name or through the 79 | \fBmy\fR command. 80 | .TP 81 | \fIobj \fBvariable \fR?\fIvarName ...\fR? 82 | . 83 | This method arranges for each variable called \fIvarName\fR to be linked from 84 | the object \fIobj\fR's unique namespace into the caller's context. Thus, if it 85 | is invoked from inside a procedure then the namespace variable in the object 86 | is linked to the local variable in the procedure. Each \fIvarName\fR argument 87 | must not have any namespace separators in it. The result is the empty string. 88 | .TP 89 | \fIobj \fBvarname \fIvarName\fR 90 | . 91 | This method returns the globally qualified name of the variable \fIvarName\fR 92 | in the unique namespace for the object \fIobj\fR. 93 | .TP 94 | \fIobj \fB \fIsourceObjectName\fR 95 | . 96 | This method is used by the \fBoo::object\fR command to copy the state of one 97 | object to another. It is responsible for copying the procedures and variables 98 | of the namespace of the source object (\fIsourceObjectName\fR) to the current 99 | object. It does not copy any other types of commands or any traces on the 100 | variables; that can be added if desired by overriding this method in a 101 | subclass. 102 | .SH EXAMPLES 103 | This example demonstrates basic use of an object. 104 | .CS 105 | set obj [\fBoo::object\fR new] 106 | $obj foo \fI\(-> error "unknown method foo"\fR 107 | oo::objdefine $obj method foo {} { 108 | my \fBvariable\fR count 109 | puts "bar[incr count]" 110 | } 111 | $obj foo \fI\(-> prints "bar1"\fR 112 | $obj foo \fI\(-> prints "bar2"\fR 113 | $obj variable count \fI\(-> error "unknown method variable"\fR 114 | $obj \fBdestroy\fR 115 | $obj foo \fI\(-> error "unknown command obj"\fR 116 | .CE 117 | .SH "SEE ALSO" 118 | my(n), oo::class(n) 119 | .SH KEYWORDS 120 | base class, class, object, root class 121 | 122 | .\" Local variables: 123 | .\" mode: nroff 124 | .\" fill-column: 78 125 | .\" End: 126 | -------------------------------------------------------------------------------- /doc/ooInfo.n: -------------------------------------------------------------------------------- 1 | '\" 2 | '\" Copyright (c) 2007-2011 Donal K. Fellows 3 | '\" 4 | '\" See the file "license.terms" for information on usage and redistribution 5 | '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. 6 | '\" 7 | .TH ooInfo n 0.1 TclOO "TclOO Commands" 8 | .so man.macros 9 | .BS 10 | '\" Note: do not modify the .SH NAME line immediately below! 11 | .SH NAME 12 | info class, info object \- introspection for classes and objects 13 | .SH SYNOPSIS 14 | .nf 15 | package require TclOO 16 | 17 | \fBinfo object\fI subcommand object\fR ?\fIarg ...\fR 18 | \fBinfo class\fI subcommand class\fR ?\fIarg ...\fR 19 | .fi 20 | .BE 21 | 22 | .SH DESCRIPTION 23 | .PP 24 | The commands \fBinfo object\fR and \fBinfo class\fR are ensemble 25 | commands that provide introspection capabilities to the object system, with 26 | the \fIsubcommand\fR argument designating which aspect is to be inspectected 27 | and the \fIobject\fR or \fIclass\fR argument naming the object or class to be 28 | inspected. 29 | .SS "OBJECT INTROSPECTION" 30 | .PP 31 | The following \fIsubcommand\fR values are supported by \fBinfo object\fR: 32 | .TP 33 | \fBinfo object call\fI object method\fR 34 | .VS 35 | Returns a description of the method implementations that are used to provide 36 | \fIobject\fR's implementation of \fImethod\fR. This consists of a list of 37 | lists of four elements, where each sublist consists of a word that describes 38 | the general type of method implementation (being one of \fBmethod\fR for an 39 | ordinary method, \fBfilter\fR for an applied filter, and \fBunknown\fR for a 40 | method that is invoked as part of unknown method handling), a word giving the 41 | name of the particular method invoked (which is always the same as 42 | \fImethod\fR for the \fBmethod\fR type, and 43 | .QW \fBunknown\fR 44 | for the \fBunknown\fR type), a word giving what defined the method (the fully 45 | qualified name of the class, or the literal string \fBobject\fR if the method 46 | implementation is on an instance), and a word describing the type of method 47 | implementation (see \fBinfo object methodtype\fR). 48 | .RS 49 | .PP 50 | Note that there is no inspection of whether the method implementations 51 | actually use \fBnext\fR to transfer control along the call chain. 52 | .RE 53 | .VE 54 | .TP 55 | \fBinfo object class\fI object\fR ?\fIclassName\fR? 56 | . 57 | If \fIclassName\fR is unspecified, this subcommand returns class of the 58 | \fIobject\fR object. If \fIclassName\fR is present, this subcommand returns a 59 | boolean value indicating whether the \fIobject\fR is of that class. 60 | .TP 61 | \fBinfo object definition\fI object method\fR 62 | . 63 | This subcommand returns a description of the definition of the method named 64 | \fImethod\fR of object \fIobject\fR. The defintion is described as a two 65 | element list; the first element is the list of arguments to the method in a 66 | form suitable for passing to another call to \fBproc\fR or a method defintion, 67 | and the second element is the body of the method. 68 | .TP 69 | \fBinfo object filters\fI object\fR 70 | . 71 | This subcommand returns the list of filter methods set on the object. 72 | .TP 73 | \fBinfo object forward\fI object method\fR 74 | . 75 | This subcommand returns the argument list for the method forwarding called 76 | \fImethod\fR that is set on the object called \fIobject\fR. 77 | .TP 78 | \fBinfo object isa\fI category object\fR ?\fIarg\fR? 79 | . 80 | This subcommand tests whether an object belongs to a particular category, 81 | returning a boolean value that indicates whether the \fIobject\fR argument 82 | meets the criteria for the category. The supported categories are: 83 | .RS 84 | .TP 85 | \fBinfo object isa class\fI object\fR 86 | . 87 | This returns whether \fIobject\fR is a class (i.e. an instance of 88 | \fBoo::class\fR or one of its subclasses). 89 | .TP 90 | \fBinfo object isa metaclass\fI object\fR 91 | . 92 | This returns whether \fIobject\fR is a class that can manufacture classes 93 | (i.e. is \fBoo::class\fR or a subclass of it). 94 | .TP 95 | \fBinfo object isa mixin\fI object class\fR 96 | . 97 | This returns whether \fIclass\fR is directly mixed into \fIobject\fR. 98 | .TP 99 | \fBinfo object isa object\fI object\fR 100 | . 101 | This returns whether \fIobject\fR really is an object. 102 | .TP 103 | \fBinfo object isa typeof\fI object class\fR 104 | . 105 | This returns whether \fIclass\fR is the type of \fIobject\fR (i.e. whether 106 | \fIobject\fR is an instance of \fIclass\fR or one of its subclasses, whether 107 | direct or indirect). 108 | .RE 109 | .TP 110 | \fBinfo object methods\fI object\fR ?\fIoption...\fR? 111 | . 112 | This subcommand returns a list of all public (i.e. exported) methods of the 113 | object called \fIobject\fR. Any of the following \fIoption\fRs may be 114 | specified, controlling exactly which method names are returned: 115 | .RS 116 | .TP 117 | \fB\-all\fR 118 | . 119 | If the \fB\-all\fR flag is given, the list of methods will include those 120 | methods defined not just by the object, but also by the object's class and 121 | mixins, plus the superclasses of those classes. 122 | .TP 123 | \fB\-private\fR 124 | . 125 | If the \fB\-private\fR flag is given, the list of methods will also include 126 | the private (i.e. non-exported) methods of the object (and classes, if 127 | \fB\-all\fR is also given). 128 | .RE 129 | .TP 130 | \fBinfo object methodtype\fI object method\fR 131 | . 132 | This subcommand returns a description of the type of implementation used for 133 | the method named \fImethod\fR of object \fIobject\fR. When the result is 134 | \fBmethod\fR, further information can be discovered with \fBinfo object 135 | definition\fR, and when the result is \fBforward\fR, further information can 136 | be discovered with \fBinfo object forward\fR. 137 | .TP 138 | \fBinfo object mixins\fI object\fR 139 | . 140 | This subcommand returns a list of all classes that have been mixed into the 141 | object named \fIobject\fR. 142 | .TP 143 | \fBinfo object namespace\fI object\fR 144 | .VS 145 | This subcommand returns the name of the internal namespace of the object named 146 | \fIobject\fR. 147 | .VE 148 | .TP 149 | \fBinfo object variables\fI object\fR 150 | .VS 151 | This subcommand returns a list of all variables that have been declared for 152 | the object named \fIobject\fR (i.e. that are automatically present in the 153 | object's methods). 154 | .VE 155 | .TP 156 | \fBinfo object vars\fI object\fR ?\fIpattern\fR? 157 | . 158 | This subcommand returns a list of all variables in the private namespace of 159 | the object named \fIobject\fR. If the optional \fIpattern\fR argument is 160 | given, it is a filter (in the syntax of a \fBstring match\fR glob pattern) 161 | that constrains the list of variables returned. 162 | .SS "CLASS INTROSPECTION" 163 | .PP 164 | The following \fIsubcommand\fR values are supported by \fBinfo class\fR: 165 | .TP 166 | \fBinfo class call\fI class method\fR 167 | .VS 168 | Returns a description of the method implementations that are used to provide a 169 | stereotypical instance of \fIclass\fR's implementation of \fImethod\fR 170 | (stereotypical instances being objects instantiated by a class without having 171 | any object-specific definitions added). This consists of a list of lists of 172 | four elements, where each sublist consists of a word that describes the 173 | general type of method implementation (being one of \fBmethod\fR for an 174 | ordinary method, \fBfilter\fR for an applied filter, and \fBunknown\fR for a 175 | method that is invoked as part of unknown method handling), a word giving the 176 | name of the particular method invoked (which is always the same as 177 | \fImethod\fR for the \fBmethod\fR type, and 178 | .QW \fBunknown\fR 179 | for the \fBunknown\fR type), a word giving the fully qualified name of the 180 | class that defined the method, and a word describing the type of method 181 | implementation (see \fBinfo class methodtype\fR). 182 | .RS 183 | .PP 184 | Note that there is no inspection of whether the method implementations 185 | actually use \fBnext\fR to transfer control along the call chain. 186 | .RE 187 | .VE 188 | .TP 189 | \fBinfo class constructor\fI class\fR 190 | . 191 | This subcommand returns a description of the definition of the constructor of 192 | class \fIclass\fR. The defintion is described as a two element list; the first 193 | element is the list of arguments to the constructor in a form suitable for 194 | passing to another call to \fBproc\fR or a method defintion, and the second 195 | element is the body of the constructor. If no constructor is present, this 196 | returns the empty list. 197 | .TP 198 | \fBinfo class definition\fI class method\fR 199 | . 200 | This subcommand returns a description of the definition of the method named 201 | \fImethod\fR of class \fIclass\fR. The defintion is described as a two element 202 | list; the first element is the list of arguments to the method in a form 203 | suitable for passing to another call to \fBproc\fR or a method defintion, and 204 | the second element is the body of the method. 205 | .TP 206 | \fBinfo class destructor\fI class\fR 207 | . 208 | This subcommand returns the body of the destructor of class \fIclass\fR. If no 209 | destructor is present, this returns the empty string. 210 | .TP 211 | \fBinfo class filters\fI class\fR 212 | . 213 | This subcommand returns the list of filter methods set on the class. 214 | .TP 215 | \fBinfo class forward\fI class method\fR 216 | . 217 | This subcommand returns the argument list for the method forwarding called 218 | \fImethod\fR that is set on the class called \fIclass\fR. 219 | .TP 220 | \fBinfo class instances\fI class\fR ?\fIpattern\fR? 221 | . 222 | This subcommand returns a list of instances of class \fIclass\fR. If the 223 | optional \fIpattern\fR argument is present, it constrains the list of returned 224 | instances to those that match it according to the rules of \fBstring match\fR. 225 | .TP 226 | \fBinfo class methods\fI class\fR ?\fIoptions...\fR? 227 | . 228 | This subcommand returns a list of all public (i.e. exported) methods of the 229 | class called \fIclass\fR. Any of the following \fIoption\fRs may be 230 | specified, controlling exactly which method names are returned: 231 | .RS 232 | .TP 233 | \fB\-all\fR 234 | . 235 | If the \fB\-all\fR flag is given, the list of methods will include those 236 | methods defined not just by the class, but also by the class's superclasses 237 | and mixins. 238 | .TP 239 | \fB\-private\fR 240 | . 241 | If the \fB\-private\fR flag is given, the list of methods will also include 242 | the private (i.e. non-exported) methods of the class (and superclasses and 243 | mixins, if \fB\-all\fR is also given). 244 | .RE 245 | .TP 246 | \fBinfo class methodtype\fI class method\fR 247 | . 248 | This subcommand returns a description of the type of implementation used for 249 | the method named \fImethod\fR of class \fIclass\fR. When the result is 250 | \fBmethod\fR, further information can be discovered with \fBinfo class 251 | definition\fR, and when the result is \fBforward\fR, further information can 252 | be discovered with \fBinfo class forward\fR. 253 | .TP 254 | \fBinfo class mixins\fI class\fR 255 | . 256 | This subcommand returns a list of all classes that have been mixed into the 257 | class named \fIclass\fR. 258 | .TP 259 | \fBinfo class subclasses\fI class\fR ?\fIpattern\fR? 260 | . 261 | This subcommand returns a list of direct subclasses of class \fIclass\fR. If 262 | the optional \fIpattern\fR argument is present, it constrains the list of 263 | returned classes to those that match it according to the rules of \fBstring 264 | match\fR. 265 | .TP 266 | \fBinfo class superclasses\fI class\fR 267 | . 268 | This subcommand returns a list of direct superclasses of class \fIclass\fR in 269 | inheritance precedence order. 270 | .TP 271 | \fBinfo class variables\fI class\fR 272 | .VS 273 | This subcommand returns a list of all variables that have been declared for 274 | the class named \Iclass\fR (i.e. that are automatically present in the 275 | class's methods, constructor and destructor). 276 | .VE 277 | .SH "FUTURE CHANGES" 278 | Note that these commands are likely to be renamed in the future. 279 | .SH EXAMPLES 280 | .PP 281 | Every object necessarily knows what its class is; this information is 282 | trivially extractable through introspection: 283 | .PP 284 | .CS 285 | oo::class create c 286 | c create o 287 | puts [\fBinfo object class\fR o] 288 | \fI\(-> prints "::c"\fR 289 | puts [\fBinfo object class\fR c] 290 | \fI\(-> prints "::oo::class"\fR 291 | .CE 292 | .PP 293 | The introspection capabilities can be used to discover what class implements a 294 | method and get how it is defined. This procedure illustrates how: 295 | .PP 296 | .CS 297 | proc getDef {obj method} { 298 | foreach inf [\fBinfo object call\fR $obj $method] { 299 | lassign $inf calltype name locus methodtype 300 | # Assume no forwards or filters, and hence no $calltype 301 | # or $methodtype checks... 302 | if {$locus eq "object"} { 303 | return [\fBinfo object definition\fR $obj $name] 304 | } else { 305 | return [\fBinfo class definition\fR $locus $name] 306 | } 307 | } 308 | error "no definition for $method" 309 | } 310 | .CE 311 | .PP 312 | This is an alternate way of implementing the definition lookup is by manually 313 | scanning the list of methods up the inheritance tree. This code assumes that 314 | only single inheritance is in use, and that there is no complex use of 315 | mixed-in classes: 316 | .PP 317 | .CS 318 | proc getDef {obj method} { 319 | if {$method in [\fBinfo object methods\fR $obj]} { 320 | # Assume no forwards 321 | return [\fBinfo object definition\fR $obj $method] 322 | } 323 | set cls [\fBinfo object class\fR $obj] 324 | while {$method ni [\fBinfo class methods\fR $cls]} { 325 | # Assume the simple case 326 | set cls [lindex [\fBinfo class superclass\fR $cls] 0] 327 | if {$cls eq {}} { 328 | error "no definition for $method" 329 | } 330 | } 331 | # Assume no forwards 332 | return [\fBinfo class definition\fR $cls $method] 333 | } 334 | .CE 335 | .SH "SEE ALSO" 336 | oo::class(n), oo::define(n), oo::object(n), self(n) 337 | .SH KEYWORDS 338 | introspection, object 339 | 340 | .\" Local variables: 341 | .\" mode: nroff 342 | .\" fill-column: 78 343 | .\" End: 344 | -------------------------------------------------------------------------------- /doc/self.n: -------------------------------------------------------------------------------- 1 | '\" 2 | '\" Copyright (c) 2007-2011 Donal K. Fellows 3 | '\" 4 | '\" See the file "license.terms" for information on usage and redistribution 5 | '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. 6 | '\" 7 | .TH self n 0.1 TclOO "TclOO Commands" 8 | .so man.macros 9 | .BS 10 | '\" Note: do not modify the .SH NAME line immediately below! 11 | .SH NAME 12 | self \- method call internal introspection 13 | .SH SYNOPSIS 14 | .nf 15 | package require TclOO 16 | 17 | \fBself\fR ?\fIsubcommand\fR? 18 | .fi 19 | .BE 20 | 21 | .SH DESCRIPTION 22 | The \fBself\fR command, which should only be used from within the context of a 23 | call to a method (i.e. inside a method, constructor or destructor body) is 24 | used to allow the method to discover information about how it was called. It 25 | takes an argument, \fIsubcommand\fR, that tells it what sort of information is 26 | actually desired; if omitted the result will be the same as if \fBself 27 | object\fR was invoked. The supported subcommands are: 28 | .TP 29 | \fBself call\fR 30 | .VS 31 | This returns a two-element list describing the method implementations used to 32 | implement the current call chain. The first element is the same as would be 33 | reported by \fBinfo object call\fR for the current method (except that this 34 | also reports useful values from within constructors and destructors), and the 35 | second element is an index into the first element's list that indicates which 36 | actual implementation is currently executing (the first implementation to 37 | execute is always at index 0). 38 | .VE 39 | .TP 40 | \fBself caller\fR 41 | . 42 | When the method was invoked from inside another object method, this subcommand 43 | returns a three element list describing the containing object and method. The 44 | first element describes the declaring object or class of the method, the 45 | second element is the name of the object on which the containing method was 46 | invoked, and the third element is the name of the method (with the strings 47 | \fB\fR and \fB\fR indicating constructors and 48 | destructors respectively). 49 | .TP 50 | \fBself class\fR 51 | . 52 | This returns the name of the class that the current method was defined within. 53 | Note that this will change as the chain of method implementations is traversed 54 | with \fBnext\fR, and that if the method was defined on an object then this 55 | will fail. 56 | .RS 57 | .PP 58 | If you want the class of the current object, you need to use this other 59 | construct: 60 | .PP 61 | .CS 62 | info object class [\fBself object\fR] 63 | .CE 64 | .RE 65 | .TP 66 | \fBself filter\fR 67 | . 68 | When invoked inside a filter, this subcommand returns a three element list 69 | describing the filter. The first element gives the name of the object or class 70 | that declared the filter (note that this may be different from the object or 71 | class that provided the implementation of the filter), the second element is 72 | either \fBobject\fR or \fBclass\fR depending on whether the declaring entity 73 | was an object or class, and the third element is the name of the filter. 74 | .TP 75 | \fBself method\fR 76 | . 77 | This returns the name of the current method (with the strings 78 | \fB\fR and \fB\fR indicating constructors and 79 | destructors respectively). 80 | .TP 81 | \fBself namespace\fR 82 | . 83 | This returns the name of the unique namespace of the object that the method 84 | was invoked upon. 85 | .TP 86 | \fBself next\fR 87 | . 88 | When invoked from a method that is not at the end of a call chain (i.e. where 89 | the \fBnext\fR command will invoke an actual method implementation), this 90 | subcommand returns a two element list describing the next element in the 91 | method call chain; the first element is the name of the class or object that 92 | declares the next part of the call chain, and the second element is the name 93 | of the method (with the strings \fB\fR and \fB\fR 94 | indicating constructors and destructors respectively). If invoked from a 95 | method that is at the end of a call chain, this subcommand returns the emtpy 96 | string. 97 | .TP 98 | \fBself object\fR 99 | . 100 | This returns the name of the object that the method was invoked upon. 101 | .TP 102 | \fBself target\fR 103 | . 104 | When invoked inside a filter implementation, this subcommand returns a two 105 | element list describing the method being filtered. The first element will be 106 | the name of the declarer of the method, and the second element will be the 107 | actual name of the method. 108 | .SH EXAMPLES 109 | .PP 110 | This example shows basic use of \fBself\fR to provide information about the 111 | current object: 112 | .PP 113 | .CS 114 | oo::class create c { 115 | method foo {} { 116 | puts "this is the [\fBself\fR] object" 117 | } 118 | } 119 | c create a 120 | c create b 121 | a foo \fI\(-> prints "this is the ::a object"\fR 122 | b foo \fI\(-> prints "this is the ::b object"\fR 123 | .CE 124 | .PP 125 | This demonstrates what a method call chain looks like, and how traversing 126 | along it changes the index into it: 127 | .PP 128 | .CS 129 | oo::class create c { 130 | method x {} { 131 | puts "Cls: [\fBself call\fR]" 132 | } 133 | } 134 | c create a 135 | oo::objdefine a { 136 | method x {} { 137 | puts "Obj: [\fBself call\fR]" 138 | next 139 | puts "Obj: [\fBself call\fR]" 140 | } 141 | } 142 | a x \fI\(-> Obj: {{method x object method} {method x ::c method}} 0\fR 143 | \fI\(-> Cls: {{method x object method} {method x ::c method}} 1\fR 144 | \fI\(-> Obj: {{method x object method} {method x ::c method}} 0\fR 145 | .CE 146 | .SH "SEE ALSO" 147 | info(n), next(n) 148 | .SH KEYWORDS 149 | call, introspection, object 150 | 151 | .\" Local variables: 152 | .\" mode: nroff 153 | .\" fill-column: 78 154 | .\" End: 155 | -------------------------------------------------------------------------------- /generic/pkgoo.c: -------------------------------------------------------------------------------- 1 | /* 2 | * pkgooa.c -- 3 | * 4 | * This file contains a simple Tcl package "pkgooa" that is intended for 5 | * testing the Tcl dynamic loading facilities. 6 | * 7 | * Copyright (c) 1995 Sun Microsystems, Inc. 8 | * 9 | * See the file "license.terms" for information on usage and redistribution of 10 | * this file, and for a DISCLAIMER OF ALL WARRANTIES. 11 | */ 12 | 13 | #undef STATIC_BUILD 14 | #include "tclOO.h" 15 | #include 16 | 17 | /* 18 | * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the 19 | * Pkgoo_Init declaration is in the source file itself, which is only 20 | * accessed when we are building a library. 21 | */ 22 | 23 | #undef TCL_STORAGE_CLASS 24 | #define TCL_STORAGE_CLASS DLLEXPORT 25 | 26 | /* 27 | * Prototypes for procedures defined later in this file: 28 | */ 29 | 30 | static int Pkgoo_StubsOKObjCmd(ClientData clientData, 31 | Tcl_Interp *interp, int objc, 32 | Tcl_Obj *const objv[]); 33 | 34 | /* 35 | *---------------------------------------------------------------------- 36 | * 37 | * Pkgoo_StubsOKObjCmd -- 38 | * 39 | * This procedure is invoked to process the "pkgoo_stubsok" Tcl command. 40 | * It gives 1 if stubs are used correctly, 0 if stubs are not OK. 41 | * 42 | * Results: 43 | * A standard Tcl result. 44 | * 45 | * Side effects: 46 | * See the user documentation. 47 | * 48 | *---------------------------------------------------------------------- 49 | */ 50 | 51 | static int 52 | Pkgoo_StubsOKObjCmd( 53 | ClientData dummy, /* Not used. */ 54 | Tcl_Interp *interp, /* Current interpreter. */ 55 | int objc, /* Number of arguments. */ 56 | Tcl_Obj *const objv[]) /* Argument objects. */ 57 | { 58 | if (objc != 1) { 59 | Tcl_WrongNumArgs(interp, 1, objv, ""); 60 | return TCL_ERROR; 61 | } 62 | Tcl_SetObjResult(interp, Tcl_NewIntObj( 63 | Tcl_CopyObjectInstance == tclOOStubsPtr->tcl_CopyObjectInstance)); 64 | return TCL_OK; 65 | } 66 | 67 | /* 68 | *---------------------------------------------------------------------- 69 | * 70 | * Pkgoo_Init -- 71 | * 72 | * This is a package initialization procedure, which is called by Tcl 73 | * when this package is to be added to an interpreter. 74 | * 75 | * Results: 76 | * None. 77 | * 78 | * Side effects: 79 | * None. 80 | * 81 | *---------------------------------------------------------------------- 82 | */ 83 | 84 | static Tcl_Object 85 | copyObjectInstance( 86 | Tcl_Interp *interp, 87 | Tcl_Object source, 88 | const char *name, 89 | const char *nameSpace) 90 | { 91 | Tcl_Object result; 92 | 93 | result = Tcl_CopyObjectInstance(interp, source, name, nameSpace); 94 | if (result == NULL) { 95 | Tcl_AppendResult(interp, "ERROR: copy failed."); 96 | } 97 | return result; 98 | } 99 | 100 | static TclOOStubs stubsCopy = { 101 | TCL_STUB_MAGIC, 102 | NULL, 103 | copyObjectInstance 104 | /* more entries here, but those are not needed for this test-case. */ 105 | }; 106 | 107 | EXTERN int 108 | Pkgoo_Init( 109 | Tcl_Interp *interp) /* Interpreter in which the package is to be 110 | * made available. */ 111 | { 112 | int code; 113 | 114 | if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { 115 | return TCL_ERROR; 116 | } 117 | 118 | if (Tcl_OOInitStubs(interp) == NULL) { 119 | return TCL_ERROR; 120 | } 121 | 122 | /* 123 | * Test case for Bug [f51efe99a7]. 124 | * 125 | * Let tclOOStubsPtr point to an alternate stub table (with only a single 126 | * function, that's enough for this test). This way, the function 127 | * "pkgoo_stubsok" can check whether the TclOO function calls really use 128 | * the stub table, or only pretend to. 129 | * 130 | * On platforms without backlinking (Windows, Cygwin, AIX), this code 131 | * doesn't even compile without using stubs, but on UNIX ELF systems, the 132 | * problem is less visible. 133 | */ 134 | 135 | tclOOStubsPtr = &stubsCopy; 136 | 137 | code = Tcl_PkgProvide(interp, "Pkgoo", "1.0"); 138 | if (code != TCL_OK) { 139 | return code; 140 | } 141 | Tcl_CreateObjCommand(interp, "pkgoo_stubsok", Pkgoo_StubsOKObjCmd, NULL, 142 | NULL); 143 | return TCL_OK; 144 | } 145 | 146 | /* 147 | * Local Variables: 148 | * mode: c 149 | * c-basic-offset: 4 150 | * fill-column: 78 151 | * End: 152 | */ 153 | -------------------------------------------------------------------------------- /generic/tclOO.decls: -------------------------------------------------------------------------------- 1 | # -*- tcl -*- 2 | 3 | library tclOO 4 | 5 | ###################################################################### 6 | # Public API, exposed for general users of TclOO. 7 | # 8 | 9 | interface tclOO 10 | hooks tclOOInt 11 | 12 | declare 0 generic { 13 | Tcl_Object Tcl_CopyObjectInstance(Tcl_Interp *interp, 14 | Tcl_Object sourceObject, const char *targetName, 15 | const char *targetNamespaceName) 16 | } 17 | declare 1 generic { 18 | Tcl_Object Tcl_GetClassAsObject(Tcl_Class clazz) 19 | } 20 | declare 2 generic { 21 | Tcl_Class Tcl_GetObjectAsClass(Tcl_Object object) 22 | } 23 | declare 3 generic { 24 | Tcl_Command Tcl_GetObjectCommand(Tcl_Object object) 25 | } 26 | declare 4 generic { 27 | Tcl_Object Tcl_GetObjectFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr) 28 | } 29 | declare 5 generic { 30 | Tcl_Namespace *Tcl_GetObjectNamespace(Tcl_Object object) 31 | } 32 | declare 6 generic { 33 | Tcl_Class Tcl_MethodDeclarerClass(Tcl_Method method) 34 | } 35 | declare 7 generic { 36 | Tcl_Object Tcl_MethodDeclarerObject(Tcl_Method method) 37 | } 38 | declare 8 generic { 39 | int Tcl_MethodIsPublic(Tcl_Method method) 40 | } 41 | declare 9 generic { 42 | int Tcl_MethodIsType(Tcl_Method method, const Tcl_MethodType *typePtr, 43 | ClientData *clientDataPtr) 44 | } 45 | declare 10 generic { 46 | Tcl_Obj *Tcl_MethodName(Tcl_Method method) 47 | } 48 | declare 11 generic { 49 | Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp, Tcl_Object object, 50 | Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr, 51 | ClientData clientData) 52 | } 53 | declare 12 generic { 54 | Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls, 55 | Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr, 56 | ClientData clientData) 57 | } 58 | declare 13 generic { 59 | Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp, Tcl_Class cls, 60 | const char *nameStr, const char *nsNameStr, int objc, 61 | Tcl_Obj *const *objv, int skip) 62 | } 63 | declare 14 generic { 64 | int Tcl_ObjectDeleted(Tcl_Object object) 65 | } 66 | declare 15 generic { 67 | int Tcl_ObjectContextIsFiltering(Tcl_ObjectContext context) 68 | } 69 | declare 16 generic { 70 | Tcl_Method Tcl_ObjectContextMethod(Tcl_ObjectContext context) 71 | } 72 | declare 17 generic { 73 | Tcl_Object Tcl_ObjectContextObject(Tcl_ObjectContext context) 74 | } 75 | declare 18 generic { 76 | int Tcl_ObjectContextSkippedArgs(Tcl_ObjectContext context) 77 | } 78 | declare 19 generic { 79 | ClientData Tcl_ClassGetMetadata(Tcl_Class clazz, 80 | const Tcl_ObjectMetadataType *typePtr) 81 | } 82 | declare 20 generic { 83 | void Tcl_ClassSetMetadata(Tcl_Class clazz, 84 | const Tcl_ObjectMetadataType *typePtr, ClientData metadata) 85 | } 86 | declare 21 generic { 87 | ClientData Tcl_ObjectGetMetadata(Tcl_Object object, 88 | const Tcl_ObjectMetadataType *typePtr) 89 | } 90 | declare 22 generic { 91 | void Tcl_ObjectSetMetadata(Tcl_Object object, 92 | const Tcl_ObjectMetadataType *typePtr, ClientData metadata) 93 | } 94 | declare 23 generic { 95 | int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp, 96 | Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv, 97 | int skip) 98 | } 99 | declare 24 generic { 100 | Tcl_ObjectMapMethodNameProc *Tcl_ObjectGetMethodNameMapper( 101 | Tcl_Object object) 102 | } 103 | declare 25 generic { 104 | void Tcl_ObjectSetMethodNameMapper(Tcl_Object object, 105 | Tcl_ObjectMapMethodNameProc *mapMethodNameProc) 106 | } 107 | declare 26 generic { 108 | void Tcl_ClassSetConstructor(Tcl_Interp *interp, Tcl_Class clazz, 109 | Tcl_Method method) 110 | } 111 | declare 27 generic { 112 | void Tcl_ClassSetDestructor(Tcl_Interp *interp, Tcl_Class clazz, 113 | Tcl_Method method) 114 | } 115 | declare 28 generic { 116 | Tcl_Obj *Tcl_GetObjectName(Tcl_Interp *interp, Tcl_Object object) 117 | } 118 | 119 | ###################################################################### 120 | # Private API, exposed to support advanced OO systems that plug in on top of 121 | # TclOO; not intended for general use and does not have any commitment to 122 | # long-term support. 123 | # 124 | 125 | interface tclOOInt 126 | declare 0 generic { 127 | Tcl_Object TclOOGetDefineCmdContext(Tcl_Interp *interp) 128 | } 129 | declare 1 generic { 130 | Tcl_Method TclOOMakeProcInstanceMethod(Tcl_Interp *interp, Object *oPtr, 131 | int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, 132 | const Tcl_MethodType *typePtr, ClientData clientData, 133 | Proc **procPtrPtr) 134 | } 135 | declare 2 generic { 136 | Tcl_Method TclOOMakeProcMethod(Tcl_Interp *interp, Class *clsPtr, 137 | int flags, Tcl_Obj *nameObj, const char *namePtr, 138 | Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, 139 | ClientData clientData, Proc **procPtrPtr) 140 | } 141 | declare 3 generic { 142 | Method *TclOONewProcInstanceMethod(Tcl_Interp *interp, Object *oPtr, 143 | int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, 144 | ProcedureMethod **pmPtrPtr) 145 | } 146 | declare 4 generic { 147 | Method *TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr, 148 | int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, 149 | ProcedureMethod **pmPtrPtr) 150 | } 151 | declare 5 generic { 152 | int TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp, int objc, 153 | Tcl_Obj *const *objv, int publicOnly, Class *startCls) 154 | } 155 | declare 6 generic { 156 | int TclOOIsReachable(Class *targetPtr, Class *startPtr) 157 | } 158 | declare 7 generic { 159 | Method *TclOONewForwardMethod(Tcl_Interp *interp, Class *clsPtr, 160 | int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj) 161 | } 162 | declare 8 generic { 163 | Method *TclOONewForwardInstanceMethod(Tcl_Interp *interp, Object *oPtr, 164 | int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj) 165 | } 166 | declare 9 generic { 167 | Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp, 168 | Tcl_Object oPtr, TclOO_PreCallProc *preCallPtr, 169 | TclOO_PostCallProc *postCallPtr, ProcErrorProc errProc, 170 | ClientData clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, 171 | Tcl_Obj *bodyObj, int flags, void **internalTokenPtr) 172 | } 173 | declare 10 generic { 174 | Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp, Tcl_Class clsPtr, 175 | TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, 176 | ProcErrorProc errProc, ClientData clientData, Tcl_Obj *nameObj, 177 | Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, 178 | void **internalTokenPtr) 179 | } 180 | declare 11 generic { 181 | int TclOOInvokeObject(Tcl_Interp *interp, Tcl_Object object, 182 | Tcl_Class startCls, int publicPrivate, int objc, 183 | Tcl_Obj *const *objv) 184 | } 185 | declare 12 generic { 186 | void TclOOObjectSetFilters(Object *oPtr, int numFilters, 187 | Tcl_Obj *const *filters) 188 | } 189 | declare 13 generic { 190 | void TclOOClassSetFilters(Tcl_Interp *interp, Class *classPtr, 191 | int numFilters, Tcl_Obj *const *filters) 192 | } 193 | declare 14 generic { 194 | void TclOOObjectSetMixins(Object *oPtr, int numMixins, 195 | Class *const *mixins) 196 | } 197 | declare 15 generic { 198 | void TclOOClassSetMixins(Tcl_Interp *interp, Class *classPtr, 199 | int numMixins, Class *const *mixins) 200 | } 201 | -------------------------------------------------------------------------------- /generic/tclOO.h: -------------------------------------------------------------------------------- 1 | /* 2 | * tclOO.h -- 3 | * 4 | * This file contains the public API definitions and some of the function 5 | * declarations for the object-system (NB: not Tcl_Obj, but ::oo). 6 | * 7 | * Copyright (c) 2006-2010 by Donal K. Fellows 8 | * 9 | * See the file "license.terms" for information on usage and redistribution of 10 | * this file, and for a DISCLAIMER OF ALL WARRANTIES. 11 | */ 12 | 13 | #ifndef TCLOO_H_INCLUDED 14 | #define TCLOO_H_INCLUDED 15 | 16 | /* 17 | * Must match version at top of ../configure.in 18 | */ 19 | 20 | #define TCLOO_VERSION "1.0.4" 21 | #define TCLOO_PATCHLEVEL TCLOO_VERSION 22 | 23 | #include "tcl.h" 24 | 25 | /* 26 | * For C++ compilers, use extern "C" 27 | */ 28 | 29 | #ifdef __cplusplus 30 | extern "C" { 31 | #endif 32 | 33 | #undef TCL_STORAGE_CLASS 34 | #ifdef BUILD_TclOO /* Match PACKAGE_NAME case sensitive */ 35 | # define TCL_STORAGE_CLASS DLLEXPORT 36 | # define TCLOOAPI DLLEXPORT 37 | # undef USE_TCLOO_STUBS 38 | #else 39 | # define TCLOOAPI DLLIMPORT 40 | # ifdef USE_TCLOO_STUBS 41 | # undef USE_TCLOO_STUBS 42 | # define USE_TCLOO_STUBS 43 | # define TCL_STORAGE_CLASS 44 | # else 45 | # define TCL_STORAGE_CLASS DLLIMPORT 46 | # endif 47 | #endif /*BUILD_TclOO*/ 48 | 49 | extern const char *TclOOInitializeStubs( 50 | Tcl_Interp *, const char *version); 51 | #define Tcl_OOInitStubs(interp) \ 52 | TclOOInitializeStubs((interp), TCLOO_PATCHLEVEL) 53 | #if !(defined(USE_TCLOO_STUBS) || defined(USE_TCL_STUBS)) 54 | #define TclOOInitializeStubs(interp, version) (TCLOO_PATCHLEVEL) 55 | #endif /*USE_TCLOO_STUBS || USE_TCL_STUBS*/ 56 | 57 | /* 58 | * These are opaque types. 59 | */ 60 | 61 | typedef struct Tcl_Class_ *Tcl_Class; 62 | typedef struct Tcl_Method_ *Tcl_Method; 63 | typedef struct Tcl_Object_ *Tcl_Object; 64 | typedef struct Tcl_ObjectContext_ *Tcl_ObjectContext; 65 | 66 | /* 67 | * Public datatypes for callbacks and structures used in the TIP#257 (OO) 68 | * implementation. These are used to implement custom types of method calls 69 | * and to allow the attachment of arbitrary data to objects and classes. 70 | */ 71 | 72 | typedef int (Tcl_MethodCallProc)(ClientData clientData, Tcl_Interp *interp, 73 | Tcl_ObjectContext objectContext, int objc, Tcl_Obj *const *objv); 74 | typedef void (Tcl_MethodDeleteProc)(ClientData clientData); 75 | typedef int (Tcl_CloneProc)(Tcl_Interp *interp, ClientData oldClientData, 76 | ClientData *newClientData); 77 | typedef void (Tcl_ObjectMetadataDeleteProc)(ClientData clientData); 78 | typedef int (Tcl_ObjectMapMethodNameProc)(Tcl_Interp *interp, 79 | Tcl_Object object, Tcl_Class *startClsPtr, Tcl_Obj *methodNameObj); 80 | 81 | /* 82 | * The type of a method implementation. This describes how to call the method 83 | * implementation, how to delete it (when the object or class is deleted) and 84 | * how to create a clone of it (when the object or class is copied). 85 | */ 86 | 87 | typedef struct { 88 | int version; /* Structure version field. Always to be equal 89 | * to TCL_OO_METHOD_VERSION_CURRENT in 90 | * declarations. */ 91 | const char *name; /* Name of this type of method, mostly for 92 | * debugging purposes. */ 93 | Tcl_MethodCallProc *callProc; 94 | /* How to invoke this method. */ 95 | Tcl_MethodDeleteProc *deleteProc; 96 | /* How to delete this method's type-specific 97 | * data, or NULL if the type-specific data 98 | * does not need deleting. */ 99 | Tcl_CloneProc *cloneProc; /* How to copy this method's type-specific 100 | * data, or NULL if the type-specific data can 101 | * be copied directly. */ 102 | } Tcl_MethodType; 103 | 104 | /* 105 | * The correct value for the version field of the Tcl_MethodType structure. 106 | * This allows new versions of the structure to be introduced without breaking 107 | * binary compatability. 108 | */ 109 | 110 | #define TCL_OO_METHOD_VERSION_CURRENT 1 111 | 112 | /* 113 | * The type of some object (or class) metadata. This describes how to delete 114 | * the metadata (when the object or class is deleted) and how to create a 115 | * clone of it (when the object or class is copied). 116 | */ 117 | 118 | typedef struct { 119 | int version; /* Structure version field. Always to be equal 120 | * to TCL_OO_METADATA_VERSION_CURRENT in 121 | * declarations. */ 122 | const char *name; 123 | Tcl_ObjectMetadataDeleteProc *deleteProc; 124 | /* How to delete the metadata. This must not 125 | * be NULL. */ 126 | Tcl_CloneProc *cloneProc; /* How to copy the metadata, or NULL if the 127 | * type-specific data can be copied 128 | * directly. */ 129 | } Tcl_ObjectMetadataType; 130 | 131 | /* 132 | * The correct value for the version field of the Tcl_ObjectMetadataType 133 | * structure. This allows new versions of the structure to be introduced 134 | * without breaking binary compatability. 135 | */ 136 | 137 | #define TCL_OO_METADATA_VERSION_CURRENT 1 138 | 139 | /* 140 | * Include all the public API, generated from tclOO.decls. 141 | */ 142 | 143 | #include "tclOODecls.h" 144 | 145 | #ifdef __cplusplus 146 | } 147 | #endif 148 | #endif /*!TCLOO_H_INCLUDED*/ 149 | 150 | /* 151 | * Local Variables: 152 | * mode: c 153 | * c-basic-offset: 4 154 | * fill-column: 78 155 | * End: 156 | */ 157 | -------------------------------------------------------------------------------- /generic/tclOODecls.h: -------------------------------------------------------------------------------- 1 | /* 2 | * This file is (mostly) automatically generated from tclOO.decls. 3 | */ 4 | 5 | /* !BEGIN!: Do not edit below this line. */ 6 | 7 | #ifdef __cplusplus 8 | extern "C" { 9 | #endif 10 | 11 | /* 12 | * Exported function declarations: 13 | */ 14 | 15 | /* 0 */ 16 | EXTERN Tcl_Object Tcl_CopyObjectInstance(Tcl_Interp *interp, 17 | Tcl_Object sourceObject, 18 | const char *targetName, 19 | const char *targetNamespaceName); 20 | /* 1 */ 21 | EXTERN Tcl_Object Tcl_GetClassAsObject(Tcl_Class clazz); 22 | /* 2 */ 23 | EXTERN Tcl_Class Tcl_GetObjectAsClass(Tcl_Object object); 24 | /* 3 */ 25 | EXTERN Tcl_Command Tcl_GetObjectCommand(Tcl_Object object); 26 | /* 4 */ 27 | EXTERN Tcl_Object Tcl_GetObjectFromObj(Tcl_Interp *interp, 28 | Tcl_Obj *objPtr); 29 | /* 5 */ 30 | EXTERN Tcl_Namespace * Tcl_GetObjectNamespace(Tcl_Object object); 31 | /* 6 */ 32 | EXTERN Tcl_Class Tcl_MethodDeclarerClass(Tcl_Method method); 33 | /* 7 */ 34 | EXTERN Tcl_Object Tcl_MethodDeclarerObject(Tcl_Method method); 35 | /* 8 */ 36 | EXTERN int Tcl_MethodIsPublic(Tcl_Method method); 37 | /* 9 */ 38 | EXTERN int Tcl_MethodIsType(Tcl_Method method, 39 | const Tcl_MethodType *typePtr, 40 | ClientData *clientDataPtr); 41 | /* 10 */ 42 | EXTERN Tcl_Obj * Tcl_MethodName(Tcl_Method method); 43 | /* 11 */ 44 | EXTERN Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp, 45 | Tcl_Object object, Tcl_Obj *nameObj, 46 | int isPublic, const Tcl_MethodType *typePtr, 47 | ClientData clientData); 48 | /* 12 */ 49 | EXTERN Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls, 50 | Tcl_Obj *nameObj, int isPublic, 51 | const Tcl_MethodType *typePtr, 52 | ClientData clientData); 53 | /* 13 */ 54 | EXTERN Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp, 55 | Tcl_Class cls, const char *nameStr, 56 | const char *nsNameStr, int objc, 57 | Tcl_Obj *const *objv, int skip); 58 | /* 14 */ 59 | EXTERN int Tcl_ObjectDeleted(Tcl_Object object); 60 | /* 15 */ 61 | EXTERN int Tcl_ObjectContextIsFiltering( 62 | Tcl_ObjectContext context); 63 | /* 16 */ 64 | EXTERN Tcl_Method Tcl_ObjectContextMethod(Tcl_ObjectContext context); 65 | /* 17 */ 66 | EXTERN Tcl_Object Tcl_ObjectContextObject(Tcl_ObjectContext context); 67 | /* 18 */ 68 | EXTERN int Tcl_ObjectContextSkippedArgs( 69 | Tcl_ObjectContext context); 70 | /* 19 */ 71 | EXTERN ClientData Tcl_ClassGetMetadata(Tcl_Class clazz, 72 | const Tcl_ObjectMetadataType *typePtr); 73 | /* 20 */ 74 | EXTERN void Tcl_ClassSetMetadata(Tcl_Class clazz, 75 | const Tcl_ObjectMetadataType *typePtr, 76 | ClientData metadata); 77 | /* 21 */ 78 | EXTERN ClientData Tcl_ObjectGetMetadata(Tcl_Object object, 79 | const Tcl_ObjectMetadataType *typePtr); 80 | /* 22 */ 81 | EXTERN void Tcl_ObjectSetMetadata(Tcl_Object object, 82 | const Tcl_ObjectMetadataType *typePtr, 83 | ClientData metadata); 84 | /* 23 */ 85 | EXTERN int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp, 86 | Tcl_ObjectContext context, int objc, 87 | Tcl_Obj *const *objv, int skip); 88 | /* 24 */ 89 | EXTERN Tcl_ObjectMapMethodNameProc * Tcl_ObjectGetMethodNameMapper( 90 | Tcl_Object object); 91 | /* 25 */ 92 | EXTERN void Tcl_ObjectSetMethodNameMapper(Tcl_Object object, 93 | Tcl_ObjectMapMethodNameProc *mapMethodNameProc); 94 | /* 26 */ 95 | EXTERN void Tcl_ClassSetConstructor(Tcl_Interp *interp, 96 | Tcl_Class clazz, Tcl_Method method); 97 | /* 27 */ 98 | EXTERN void Tcl_ClassSetDestructor(Tcl_Interp *interp, 99 | Tcl_Class clazz, Tcl_Method method); 100 | /* 28 */ 101 | EXTERN Tcl_Obj * Tcl_GetObjectName(Tcl_Interp *interp, 102 | Tcl_Object object); 103 | 104 | typedef struct { 105 | const struct TclOOIntStubs *tclOOIntStubs; 106 | } TclOOStubHooks; 107 | 108 | typedef struct TclOOStubs { 109 | int magic; 110 | const TclOOStubHooks *hooks; 111 | 112 | Tcl_Object (*tcl_CopyObjectInstance) (Tcl_Interp *interp, Tcl_Object sourceObject, const char *targetName, const char *targetNamespaceName); /* 0 */ 113 | Tcl_Object (*tcl_GetClassAsObject) (Tcl_Class clazz); /* 1 */ 114 | Tcl_Class (*tcl_GetObjectAsClass) (Tcl_Object object); /* 2 */ 115 | Tcl_Command (*tcl_GetObjectCommand) (Tcl_Object object); /* 3 */ 116 | Tcl_Object (*tcl_GetObjectFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 4 */ 117 | Tcl_Namespace * (*tcl_GetObjectNamespace) (Tcl_Object object); /* 5 */ 118 | Tcl_Class (*tcl_MethodDeclarerClass) (Tcl_Method method); /* 6 */ 119 | Tcl_Object (*tcl_MethodDeclarerObject) (Tcl_Method method); /* 7 */ 120 | int (*tcl_MethodIsPublic) (Tcl_Method method); /* 8 */ 121 | int (*tcl_MethodIsType) (Tcl_Method method, const Tcl_MethodType *typePtr, ClientData *clientDataPtr); /* 9 */ 122 | Tcl_Obj * (*tcl_MethodName) (Tcl_Method method); /* 10 */ 123 | Tcl_Method (*tcl_NewInstanceMethod) (Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr, ClientData clientData); /* 11 */ 124 | Tcl_Method (*tcl_NewMethod) (Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr, ClientData clientData); /* 12 */ 125 | Tcl_Object (*tcl_NewObjectInstance) (Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, const char *nsNameStr, int objc, Tcl_Obj *const *objv, int skip); /* 13 */ 126 | int (*tcl_ObjectDeleted) (Tcl_Object object); /* 14 */ 127 | int (*tcl_ObjectContextIsFiltering) (Tcl_ObjectContext context); /* 15 */ 128 | Tcl_Method (*tcl_ObjectContextMethod) (Tcl_ObjectContext context); /* 16 */ 129 | Tcl_Object (*tcl_ObjectContextObject) (Tcl_ObjectContext context); /* 17 */ 130 | int (*tcl_ObjectContextSkippedArgs) (Tcl_ObjectContext context); /* 18 */ 131 | ClientData (*tcl_ClassGetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr); /* 19 */ 132 | void (*tcl_ClassSetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr, ClientData metadata); /* 20 */ 133 | ClientData (*tcl_ObjectGetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr); /* 21 */ 134 | void (*tcl_ObjectSetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr, ClientData metadata); /* 22 */ 135 | int (*tcl_ObjectContextInvokeNext) (Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv, int skip); /* 23 */ 136 | Tcl_ObjectMapMethodNameProc * (*tcl_ObjectGetMethodNameMapper) (Tcl_Object object); /* 24 */ 137 | void (*tcl_ObjectSetMethodNameMapper) (Tcl_Object object, Tcl_ObjectMapMethodNameProc *mapMethodNameProc); /* 25 */ 138 | void (*tcl_ClassSetConstructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 26 */ 139 | void (*tcl_ClassSetDestructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 27 */ 140 | Tcl_Obj * (*tcl_GetObjectName) (Tcl_Interp *interp, Tcl_Object object); /* 28 */ 141 | } TclOOStubs; 142 | 143 | extern const TclOOStubs *tclOOStubsPtr; 144 | 145 | #ifdef __cplusplus 146 | } 147 | #endif 148 | 149 | #if defined(USE_TCLOO_STUBS) 150 | 151 | /* 152 | * Inline function declarations: 153 | */ 154 | 155 | #define Tcl_CopyObjectInstance \ 156 | (tclOOStubsPtr->tcl_CopyObjectInstance) /* 0 */ 157 | #define Tcl_GetClassAsObject \ 158 | (tclOOStubsPtr->tcl_GetClassAsObject) /* 1 */ 159 | #define Tcl_GetObjectAsClass \ 160 | (tclOOStubsPtr->tcl_GetObjectAsClass) /* 2 */ 161 | #define Tcl_GetObjectCommand \ 162 | (tclOOStubsPtr->tcl_GetObjectCommand) /* 3 */ 163 | #define Tcl_GetObjectFromObj \ 164 | (tclOOStubsPtr->tcl_GetObjectFromObj) /* 4 */ 165 | #define Tcl_GetObjectNamespace \ 166 | (tclOOStubsPtr->tcl_GetObjectNamespace) /* 5 */ 167 | #define Tcl_MethodDeclarerClass \ 168 | (tclOOStubsPtr->tcl_MethodDeclarerClass) /* 6 */ 169 | #define Tcl_MethodDeclarerObject \ 170 | (tclOOStubsPtr->tcl_MethodDeclarerObject) /* 7 */ 171 | #define Tcl_MethodIsPublic \ 172 | (tclOOStubsPtr->tcl_MethodIsPublic) /* 8 */ 173 | #define Tcl_MethodIsType \ 174 | (tclOOStubsPtr->tcl_MethodIsType) /* 9 */ 175 | #define Tcl_MethodName \ 176 | (tclOOStubsPtr->tcl_MethodName) /* 10 */ 177 | #define Tcl_NewInstanceMethod \ 178 | (tclOOStubsPtr->tcl_NewInstanceMethod) /* 11 */ 179 | #define Tcl_NewMethod \ 180 | (tclOOStubsPtr->tcl_NewMethod) /* 12 */ 181 | #define Tcl_NewObjectInstance \ 182 | (tclOOStubsPtr->tcl_NewObjectInstance) /* 13 */ 183 | #define Tcl_ObjectDeleted \ 184 | (tclOOStubsPtr->tcl_ObjectDeleted) /* 14 */ 185 | #define Tcl_ObjectContextIsFiltering \ 186 | (tclOOStubsPtr->tcl_ObjectContextIsFiltering) /* 15 */ 187 | #define Tcl_ObjectContextMethod \ 188 | (tclOOStubsPtr->tcl_ObjectContextMethod) /* 16 */ 189 | #define Tcl_ObjectContextObject \ 190 | (tclOOStubsPtr->tcl_ObjectContextObject) /* 17 */ 191 | #define Tcl_ObjectContextSkippedArgs \ 192 | (tclOOStubsPtr->tcl_ObjectContextSkippedArgs) /* 18 */ 193 | #define Tcl_ClassGetMetadata \ 194 | (tclOOStubsPtr->tcl_ClassGetMetadata) /* 19 */ 195 | #define Tcl_ClassSetMetadata \ 196 | (tclOOStubsPtr->tcl_ClassSetMetadata) /* 20 */ 197 | #define Tcl_ObjectGetMetadata \ 198 | (tclOOStubsPtr->tcl_ObjectGetMetadata) /* 21 */ 199 | #define Tcl_ObjectSetMetadata \ 200 | (tclOOStubsPtr->tcl_ObjectSetMetadata) /* 22 */ 201 | #define Tcl_ObjectContextInvokeNext \ 202 | (tclOOStubsPtr->tcl_ObjectContextInvokeNext) /* 23 */ 203 | #define Tcl_ObjectGetMethodNameMapper \ 204 | (tclOOStubsPtr->tcl_ObjectGetMethodNameMapper) /* 24 */ 205 | #define Tcl_ObjectSetMethodNameMapper \ 206 | (tclOOStubsPtr->tcl_ObjectSetMethodNameMapper) /* 25 */ 207 | #define Tcl_ClassSetConstructor \ 208 | (tclOOStubsPtr->tcl_ClassSetConstructor) /* 26 */ 209 | #define Tcl_ClassSetDestructor \ 210 | (tclOOStubsPtr->tcl_ClassSetDestructor) /* 27 */ 211 | #define Tcl_GetObjectName \ 212 | (tclOOStubsPtr->tcl_GetObjectName) /* 28 */ 213 | 214 | #endif /* defined(USE_TCLOO_STUBS) */ 215 | 216 | /* !END!: Do not edit above this line. */ 217 | -------------------------------------------------------------------------------- /generic/tclOOIntDecls.h: -------------------------------------------------------------------------------- 1 | /* 2 | * This file is (mostly) automatically generated from tclOO.decls. 3 | */ 4 | 5 | /* !BEGIN!: Do not edit below this line. */ 6 | 7 | #ifdef __cplusplus 8 | extern "C" { 9 | #endif 10 | 11 | /* 12 | * Exported function declarations: 13 | */ 14 | 15 | /* 0 */ 16 | EXTERN Tcl_Object TclOOGetDefineCmdContext(Tcl_Interp *interp); 17 | /* 1 */ 18 | EXTERN Tcl_Method TclOOMakeProcInstanceMethod(Tcl_Interp *interp, 19 | Object *oPtr, int flags, Tcl_Obj *nameObj, 20 | Tcl_Obj *argsObj, Tcl_Obj *bodyObj, 21 | const Tcl_MethodType *typePtr, 22 | ClientData clientData, Proc **procPtrPtr); 23 | /* 2 */ 24 | EXTERN Tcl_Method TclOOMakeProcMethod(Tcl_Interp *interp, 25 | Class *clsPtr, int flags, Tcl_Obj *nameObj, 26 | const char *namePtr, Tcl_Obj *argsObj, 27 | Tcl_Obj *bodyObj, 28 | const Tcl_MethodType *typePtr, 29 | ClientData clientData, Proc **procPtrPtr); 30 | /* 3 */ 31 | EXTERN Method * TclOONewProcInstanceMethod(Tcl_Interp *interp, 32 | Object *oPtr, int flags, Tcl_Obj *nameObj, 33 | Tcl_Obj *argsObj, Tcl_Obj *bodyObj, 34 | ProcedureMethod **pmPtrPtr); 35 | /* 4 */ 36 | EXTERN Method * TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr, 37 | int flags, Tcl_Obj *nameObj, 38 | Tcl_Obj *argsObj, Tcl_Obj *bodyObj, 39 | ProcedureMethod **pmPtrPtr); 40 | /* 5 */ 41 | EXTERN int TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp, 42 | int objc, Tcl_Obj *const *objv, 43 | int publicOnly, Class *startCls); 44 | /* 6 */ 45 | EXTERN int TclOOIsReachable(Class *targetPtr, Class *startPtr); 46 | /* 7 */ 47 | EXTERN Method * TclOONewForwardMethod(Tcl_Interp *interp, 48 | Class *clsPtr, int isPublic, 49 | Tcl_Obj *nameObj, Tcl_Obj *prefixObj); 50 | /* 8 */ 51 | EXTERN Method * TclOONewForwardInstanceMethod(Tcl_Interp *interp, 52 | Object *oPtr, int isPublic, Tcl_Obj *nameObj, 53 | Tcl_Obj *prefixObj); 54 | /* 9 */ 55 | EXTERN Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp, 56 | Tcl_Object oPtr, 57 | TclOO_PreCallProc *preCallPtr, 58 | TclOO_PostCallProc *postCallPtr, 59 | ProcErrorProc errProc, ClientData clientData, 60 | Tcl_Obj *nameObj, Tcl_Obj *argsObj, 61 | Tcl_Obj *bodyObj, int flags, 62 | void **internalTokenPtr); 63 | /* 10 */ 64 | EXTERN Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp, 65 | Tcl_Class clsPtr, 66 | TclOO_PreCallProc *preCallPtr, 67 | TclOO_PostCallProc *postCallPtr, 68 | ProcErrorProc errProc, ClientData clientData, 69 | Tcl_Obj *nameObj, Tcl_Obj *argsObj, 70 | Tcl_Obj *bodyObj, int flags, 71 | void **internalTokenPtr); 72 | /* 11 */ 73 | EXTERN int TclOOInvokeObject(Tcl_Interp *interp, 74 | Tcl_Object object, Tcl_Class startCls, 75 | int publicPrivate, int objc, 76 | Tcl_Obj *const *objv); 77 | /* 12 */ 78 | EXTERN void TclOOObjectSetFilters(Object *oPtr, int numFilters, 79 | Tcl_Obj *const *filters); 80 | /* 13 */ 81 | EXTERN void TclOOClassSetFilters(Tcl_Interp *interp, 82 | Class *classPtr, int numFilters, 83 | Tcl_Obj *const *filters); 84 | /* 14 */ 85 | EXTERN void TclOOObjectSetMixins(Object *oPtr, int numMixins, 86 | Class *const *mixins); 87 | /* 15 */ 88 | EXTERN void TclOOClassSetMixins(Tcl_Interp *interp, 89 | Class *classPtr, int numMixins, 90 | Class *const *mixins); 91 | 92 | typedef struct TclOOIntStubs { 93 | int magic; 94 | void *hooks; 95 | 96 | Tcl_Object (*tclOOGetDefineCmdContext) (Tcl_Interp *interp); /* 0 */ 97 | Tcl_Method (*tclOOMakeProcInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, ClientData clientData, Proc **procPtrPtr); /* 1 */ 98 | Tcl_Method (*tclOOMakeProcMethod) (Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, const char *namePtr, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, ClientData clientData, Proc **procPtrPtr); /* 2 */ 99 | Method * (*tclOONewProcInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 3 */ 100 | Method * (*tclOONewProcMethod) (Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 4 */ 101 | int (*tclOOObjectCmdCore) (Object *oPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv, int publicOnly, Class *startCls); /* 5 */ 102 | int (*tclOOIsReachable) (Class *targetPtr, Class *startPtr); /* 6 */ 103 | Method * (*tclOONewForwardMethod) (Tcl_Interp *interp, Class *clsPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 7 */ 104 | Method * (*tclOONewForwardInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 8 */ 105 | Tcl_Method (*tclOONewProcInstanceMethodEx) (Tcl_Interp *interp, Tcl_Object oPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc errProc, ClientData clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 9 */ 106 | Tcl_Method (*tclOONewProcMethodEx) (Tcl_Interp *interp, Tcl_Class clsPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc errProc, ClientData clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 10 */ 107 | int (*tclOOInvokeObject) (Tcl_Interp *interp, Tcl_Object object, Tcl_Class startCls, int publicPrivate, int objc, Tcl_Obj *const *objv); /* 11 */ 108 | void (*tclOOObjectSetFilters) (Object *oPtr, int numFilters, Tcl_Obj *const *filters); /* 12 */ 109 | void (*tclOOClassSetFilters) (Tcl_Interp *interp, Class *classPtr, int numFilters, Tcl_Obj *const *filters); /* 13 */ 110 | void (*tclOOObjectSetMixins) (Object *oPtr, int numMixins, Class *const *mixins); /* 14 */ 111 | void (*tclOOClassSetMixins) (Tcl_Interp *interp, Class *classPtr, int numMixins, Class *const *mixins); /* 15 */ 112 | } TclOOIntStubs; 113 | 114 | extern const TclOOIntStubs *tclOOIntStubsPtr; 115 | 116 | #ifdef __cplusplus 117 | } 118 | #endif 119 | 120 | #if defined(USE_TCLOO_STUBS) 121 | 122 | /* 123 | * Inline function declarations: 124 | */ 125 | 126 | #define TclOOGetDefineCmdContext \ 127 | (tclOOIntStubsPtr->tclOOGetDefineCmdContext) /* 0 */ 128 | #define TclOOMakeProcInstanceMethod \ 129 | (tclOOIntStubsPtr->tclOOMakeProcInstanceMethod) /* 1 */ 130 | #define TclOOMakeProcMethod \ 131 | (tclOOIntStubsPtr->tclOOMakeProcMethod) /* 2 */ 132 | #define TclOONewProcInstanceMethod \ 133 | (tclOOIntStubsPtr->tclOONewProcInstanceMethod) /* 3 */ 134 | #define TclOONewProcMethod \ 135 | (tclOOIntStubsPtr->tclOONewProcMethod) /* 4 */ 136 | #define TclOOObjectCmdCore \ 137 | (tclOOIntStubsPtr->tclOOObjectCmdCore) /* 5 */ 138 | #define TclOOIsReachable \ 139 | (tclOOIntStubsPtr->tclOOIsReachable) /* 6 */ 140 | #define TclOONewForwardMethod \ 141 | (tclOOIntStubsPtr->tclOONewForwardMethod) /* 7 */ 142 | #define TclOONewForwardInstanceMethod \ 143 | (tclOOIntStubsPtr->tclOONewForwardInstanceMethod) /* 8 */ 144 | #define TclOONewProcInstanceMethodEx \ 145 | (tclOOIntStubsPtr->tclOONewProcInstanceMethodEx) /* 9 */ 146 | #define TclOONewProcMethodEx \ 147 | (tclOOIntStubsPtr->tclOONewProcMethodEx) /* 10 */ 148 | #define TclOOInvokeObject \ 149 | (tclOOIntStubsPtr->tclOOInvokeObject) /* 11 */ 150 | #define TclOOObjectSetFilters \ 151 | (tclOOIntStubsPtr->tclOOObjectSetFilters) /* 12 */ 152 | #define TclOOClassSetFilters \ 153 | (tclOOIntStubsPtr->tclOOClassSetFilters) /* 13 */ 154 | #define TclOOObjectSetMixins \ 155 | (tclOOIntStubsPtr->tclOOObjectSetMixins) /* 14 */ 156 | #define TclOOClassSetMixins \ 157 | (tclOOIntStubsPtr->tclOOClassSetMixins) /* 15 */ 158 | 159 | #endif /* defined(USE_TCLOO_STUBS) */ 160 | 161 | /* !END!: Do not edit above this line. */ 162 | -------------------------------------------------------------------------------- /generic/tclOOStubInit.c: -------------------------------------------------------------------------------- 1 | /* 2 | * This file is (mostly) automatically generated from tclOO.decls. 3 | * It is compiled and linked in with the tclOO package proper. 4 | */ 5 | 6 | #ifdef HAVE_CONFIG_H 7 | #include "config.h" 8 | #endif 9 | #include "tclOO.h" 10 | #include "tclOOInt.h" 11 | 12 | /* !BEGIN!: Do not edit below this line. */ 13 | 14 | static const TclOOIntStubs tclOOIntStubs = { 15 | TCL_STUB_MAGIC, 16 | 0, 17 | TclOOGetDefineCmdContext, /* 0 */ 18 | TclOOMakeProcInstanceMethod, /* 1 */ 19 | TclOOMakeProcMethod, /* 2 */ 20 | TclOONewProcInstanceMethod, /* 3 */ 21 | TclOONewProcMethod, /* 4 */ 22 | TclOOObjectCmdCore, /* 5 */ 23 | TclOOIsReachable, /* 6 */ 24 | TclOONewForwardMethod, /* 7 */ 25 | TclOONewForwardInstanceMethod, /* 8 */ 26 | TclOONewProcInstanceMethodEx, /* 9 */ 27 | TclOONewProcMethodEx, /* 10 */ 28 | TclOOInvokeObject, /* 11 */ 29 | TclOOObjectSetFilters, /* 12 */ 30 | TclOOClassSetFilters, /* 13 */ 31 | TclOOObjectSetMixins, /* 14 */ 32 | TclOOClassSetMixins, /* 15 */ 33 | }; 34 | 35 | static const TclOOStubHooks tclOOStubHooks = { 36 | &tclOOIntStubs 37 | }; 38 | 39 | const TclOOStubs tclOOStubs = { 40 | TCL_STUB_MAGIC, 41 | &tclOOStubHooks, 42 | Tcl_CopyObjectInstance, /* 0 */ 43 | Tcl_GetClassAsObject, /* 1 */ 44 | Tcl_GetObjectAsClass, /* 2 */ 45 | Tcl_GetObjectCommand, /* 3 */ 46 | Tcl_GetObjectFromObj, /* 4 */ 47 | Tcl_GetObjectNamespace, /* 5 */ 48 | Tcl_MethodDeclarerClass, /* 6 */ 49 | Tcl_MethodDeclarerObject, /* 7 */ 50 | Tcl_MethodIsPublic, /* 8 */ 51 | Tcl_MethodIsType, /* 9 */ 52 | Tcl_MethodName, /* 10 */ 53 | Tcl_NewInstanceMethod, /* 11 */ 54 | Tcl_NewMethod, /* 12 */ 55 | Tcl_NewObjectInstance, /* 13 */ 56 | Tcl_ObjectDeleted, /* 14 */ 57 | Tcl_ObjectContextIsFiltering, /* 15 */ 58 | Tcl_ObjectContextMethod, /* 16 */ 59 | Tcl_ObjectContextObject, /* 17 */ 60 | Tcl_ObjectContextSkippedArgs, /* 18 */ 61 | Tcl_ClassGetMetadata, /* 19 */ 62 | Tcl_ClassSetMetadata, /* 20 */ 63 | Tcl_ObjectGetMetadata, /* 21 */ 64 | Tcl_ObjectSetMetadata, /* 22 */ 65 | Tcl_ObjectContextInvokeNext, /* 23 */ 66 | Tcl_ObjectGetMethodNameMapper, /* 24 */ 67 | Tcl_ObjectSetMethodNameMapper, /* 25 */ 68 | Tcl_ClassSetConstructor, /* 26 */ 69 | Tcl_ClassSetDestructor, /* 27 */ 70 | Tcl_GetObjectName, /* 28 */ 71 | }; 72 | 73 | /* !END!: Do not edit above this line. */ 74 | 75 | /* 76 | * Module-scope pointers to the main static stubs tables, used for package 77 | * initialization via Tcl_PkgProvideEx(). 78 | */ 79 | 80 | MODULE_SCOPE const TclOOStubs * const tclOOConstStubsPtr; 81 | const TclOOStubs * const tclOOConstStubsPtr = &tclOOStubs; 82 | -------------------------------------------------------------------------------- /generic/tclOOStubLib.c: -------------------------------------------------------------------------------- 1 | /* 2 | * ORIGINAL SOURCE: tk/generic/tkStubLib.c, version 1.9 2004/03/17 3 | */ 4 | 5 | #ifdef HAVE_CONFIG_H 6 | #include "config.h" 7 | #endif 8 | 9 | /* 10 | * Need to ensure that this file is built without any external references. 11 | */ 12 | 13 | #undef USE_TCL_STUBS 14 | #undef USE_TCLOO_STUBS 15 | #define USE_TCL_STUBS 1 16 | #define USE_TCLOO_STUBS 1 17 | 18 | #include "tcl.h" 19 | #include "tclOO.h" 20 | #include "tclOOInt.h" 21 | 22 | MODULE_SCOPE const TclOOStubs *tclOOStubsPtr; 23 | MODULE_SCOPE const TclOOIntStubs *tclOOIntStubsPtr; 24 | 25 | const TclOOStubs *tclOOStubsPtr = NULL; 26 | const TclOOIntStubs *tclOOIntStubsPtr = NULL; 27 | 28 | /* 29 | *---------------------------------------------------------------------- 30 | * 31 | * support functions -- 32 | * These ensure that this file has no dependence on the version of the C 33 | * library that was used during the build (an issue on Windows). 34 | * 35 | *---------------------------------------------------------------------- 36 | */ 37 | 38 | static inline int 39 | isDigit( 40 | const int c) 41 | { 42 | return (c >= '0' && c <= '9'); /* Assume ASCII */ 43 | } 44 | 45 | static inline const char * 46 | RequireExactVersion( 47 | Tcl_Interp *interp, 48 | const char *packageName, 49 | const char *desiredVersion, 50 | const char *actualVersion) 51 | { 52 | const char *p = desiredVersion; 53 | int count = 0; 54 | 55 | while (*p) { 56 | count += !isDigit(*p++); 57 | } 58 | if (count == 1) { 59 | const char *q = actualVersion; 60 | 61 | p = desiredVersion; 62 | while (*p && (*p == *q)) { 63 | p++; q++; 64 | } 65 | if (*p) { 66 | /* Construct error message */ 67 | Tcl_PkgRequireEx(interp, packageName, desiredVersion, 1, NULL); 68 | return NULL; 69 | } 70 | } else { 71 | actualVersion = Tcl_PkgRequireEx(interp, packageName, desiredVersion, 72 | 1, NULL); 73 | if (actualVersion == NULL) { 74 | return NULL; 75 | } 76 | } 77 | return actualVersion; 78 | } 79 | 80 | /* 81 | *---------------------------------------------------------------------- 82 | * 83 | * TclOOInitializeStubs -- 84 | * Load the tclOO package, initialize stub table pointer. Do not call 85 | * this function directly, use Tcl_OOInitStubs() macro instead. 86 | * 87 | * Results: 88 | * The actual version of the package that satisfies the request, or NULL 89 | * to indicate that an error occurred. 90 | * 91 | * Side effects: 92 | * Sets the stub table pointer. 93 | * 94 | *---------------------------------------------------------------------- 95 | */ 96 | 97 | #undef TclOOInitializeStubs 98 | 99 | MODULE_SCOPE const char * 100 | TclOOInitializeStubs( 101 | Tcl_Interp *interp, 102 | const char *version) 103 | { 104 | const TclOOStubs **stubsPtrPtr = &tclOOStubsPtr; 105 | const char *gotVer = Tcl_PkgRequireEx(interp, "TclOO", version, 0, 106 | (ClientData *) stubsPtrPtr); 107 | 108 | if (gotVer == NULL) { 109 | return NULL; 110 | } 111 | 112 | /* Cargo-culted logic alert! */ 113 | if (tclOOStubsPtr == NULL) { 114 | Tcl_ResetResult(interp); 115 | Tcl_AppendResult(interp, "Error loading TclOO package; ", 116 | "package not present or incomplete", NULL); 117 | return NULL; 118 | } 119 | 120 | tclOOIntStubsPtr = tclOOStubsPtr->hooks->tclOOIntStubs; 121 | return gotVer; 122 | } 123 | 124 | /* 125 | * Local Variables: 126 | * mode: c 127 | * c-basic-offset: 4 128 | * fill-column: 78 129 | * End: 130 | */ 131 | -------------------------------------------------------------------------------- /license.terms: -------------------------------------------------------------------------------- 1 | This software is copyrighted by Donal K. Fellows, and other parties. The 2 | following terms apply to all files associated with the software unless 3 | explicitly disclaimed in individual files. 4 | 5 | The authors hereby grant permission to use, copy, modify, distribute, and 6 | license this software and its documentation for any purpose, provided that 7 | existing copyright notices are retained in all copies and that this notice is 8 | included verbatim in any distributions. No written agreement, license, or 9 | royalty fee is required for any of the authorized uses. Modifications to this 10 | software may be copyrighted by their authors and need not follow the licensing 11 | terms described here, provided that the new terms are clearly indicated on the 12 | first page of each file where they apply. 13 | 14 | IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY FOR 15 | DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF 16 | THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY DERIVATIVES THEREOF, EVEN 17 | IF THE AUTHORS HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 18 | 19 | THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, INCLUDING, 20 | BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A 21 | PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS 22 | IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE 23 | MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. 24 | 25 | GOVERNMENT USE: If you are acquiring this software on behalf of the 26 | U.S. government, the Government shall have only "Restricted Rights" in the 27 | software and related documentation as defined in the Federal Acquisition 28 | Regulations (FARs) in Clause 52.227.19 (c) (2). If you are acquiring the 29 | software on behalf of the Department of Defense, the software shall be 30 | classified as "Commercial Computer Software" and the Government shall have 31 | only "Restricted Rights" as defined in Clause 252.227-7013 (c) (1) of DFARs. 32 | Notwithstanding the foregoing, the authors grant the U.S. Government and 33 | others acting in its behalf permission to use and distribute the software in 34 | accordance with the terms specified in this license. 35 | -------------------------------------------------------------------------------- /tclconfig/README.txt: -------------------------------------------------------------------------------- 1 | These files comprise the basic building blocks for a Tcl Extension 2 | Architecture (TEA) extension. For more information on TEA see: 3 | 4 | http://www.tcl.tk/doc/tea/ 5 | 6 | This package is part of the Tcl project at SourceForge, and latest 7 | sources should be available there: 8 | 9 | http://tcl.sourceforge.net/ 10 | 11 | This package is a freely available open source package. You can do 12 | virtually anything you like with it, such as modifying it, redistributing 13 | it, and selling it either in whole or in part. 14 | 15 | CONTENTS 16 | ======== 17 | The following is a short description of the files you will find in 18 | the sample extension. 19 | 20 | README.txt This file 21 | 22 | install-sh Program used for copying binaries and script files 23 | to their install locations. 24 | 25 | tcl.m4 Collection of Tcl autoconf macros. Included by a package's 26 | aclocal.m4 to define TEA_* macros. 27 | -------------------------------------------------------------------------------- /tclconfig/install-sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # install - install a program, script, or datafile 3 | 4 | scriptversion=2010-02-06.18; # UTC 5 | 6 | # This originates from X11R5 (mit/util/scripts/install.sh), which was 7 | # later released in X11R6 (xc/config/util/install.sh) with the 8 | # following copyright and license. 9 | # 10 | # Copyright (C) 1994 X Consortium 11 | # 12 | # Permission is hereby granted, free of charge, to any person obtaining a copy 13 | # of this software and associated documentation files (the "Software"), to 14 | # deal in the Software without restriction, including without limitation the 15 | # rights to use, copy, modify, merge, publish, distribute, sublicense, and/or 16 | # sell copies of the Software, and to permit persons to whom the Software is 17 | # furnished to do so, subject to the following conditions: 18 | # 19 | # The above copyright notice and this permission notice shall be included in 20 | # all copies or substantial portions of the Software. 21 | # 22 | # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 23 | # IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 24 | # FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 25 | # X CONSORTIUM BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN 26 | # AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNEC- 27 | # TION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 28 | # 29 | # Except as contained in this notice, the name of the X Consortium shall not 30 | # be used in advertising or otherwise to promote the sale, use or other deal- 31 | # ings in this Software without prior written authorization from the X Consor- 32 | # tium. 33 | # 34 | # 35 | # FSF changes to this file are in the public domain. 36 | # 37 | # Calling this script install-sh is preferred over install.sh, to prevent 38 | # `make' implicit rules from creating a file called install from it 39 | # when there is no Makefile. 40 | # 41 | # This script is compatible with the BSD install script, but was written 42 | # from scratch. 43 | 44 | nl=' 45 | ' 46 | IFS=" "" $nl" 47 | 48 | # set DOITPROG to echo to test this script 49 | 50 | # Don't use :- since 4.3BSD and earlier shells don't like it. 51 | doit=${DOITPROG-} 52 | if test -z "$doit"; then 53 | doit_exec=exec 54 | else 55 | doit_exec=$doit 56 | fi 57 | 58 | # Put in absolute file names if you don't have them in your path; 59 | # or use environment vars. 60 | 61 | chgrpprog=${CHGRPPROG-chgrp} 62 | chmodprog=${CHMODPROG-chmod} 63 | chownprog=${CHOWNPROG-chown} 64 | cmpprog=${CMPPROG-cmp} 65 | cpprog=${CPPROG-cp} 66 | mkdirprog=${MKDIRPROG-mkdir} 67 | mvprog=${MVPROG-mv} 68 | rmprog=${RMPROG-rm} 69 | stripprog=${STRIPPROG-strip} 70 | 71 | posix_glob='?' 72 | initialize_posix_glob=' 73 | test "$posix_glob" != "?" || { 74 | if (set -f) 2>/dev/null; then 75 | posix_glob= 76 | else 77 | posix_glob=: 78 | fi 79 | } 80 | ' 81 | 82 | posix_mkdir= 83 | 84 | # Desired mode of installed file. 85 | mode=0755 86 | 87 | chgrpcmd= 88 | chmodcmd=$chmodprog 89 | chowncmd= 90 | mvcmd=$mvprog 91 | rmcmd="$rmprog -f" 92 | stripcmd= 93 | 94 | src= 95 | dst= 96 | dir_arg= 97 | dst_arg= 98 | 99 | copy_on_change=false 100 | no_target_directory= 101 | 102 | usage="\ 103 | Usage: $0 [OPTION]... [-T] SRCFILE DSTFILE 104 | or: $0 [OPTION]... SRCFILES... DIRECTORY 105 | or: $0 [OPTION]... -t DIRECTORY SRCFILES... 106 | or: $0 [OPTION]... -d DIRECTORIES... 107 | 108 | In the 1st form, copy SRCFILE to DSTFILE. 109 | In the 2nd and 3rd, copy all SRCFILES to DIRECTORY. 110 | In the 4th, create DIRECTORIES. 111 | 112 | Options: 113 | --help display this help and exit. 114 | --version display version info and exit. 115 | 116 | -c (ignored) 117 | -C install only if different (preserve the last data modification time) 118 | -d create directories instead of installing files. 119 | -g GROUP $chgrpprog installed files to GROUP. 120 | -m MODE $chmodprog installed files to MODE. 121 | -o USER $chownprog installed files to USER. 122 | -s $stripprog installed files. 123 | -t DIRECTORY install into DIRECTORY. 124 | -T report an error if DSTFILE is a directory. 125 | 126 | Environment variables override the default commands: 127 | CHGRPPROG CHMODPROG CHOWNPROG CMPPROG CPPROG MKDIRPROG MVPROG 128 | RMPROG STRIPPROG 129 | " 130 | 131 | while test $# -ne 0; do 132 | case $1 in 133 | -c) ;; 134 | 135 | -C) copy_on_change=true;; 136 | 137 | -d) dir_arg=true;; 138 | 139 | -g) chgrpcmd="$chgrpprog $2" 140 | shift;; 141 | 142 | --help) echo "$usage"; exit $?;; 143 | 144 | -m) mode=$2 145 | case $mode in 146 | *' '* | *' '* | *' 147 | '* | *'*'* | *'?'* | *'['*) 148 | echo "$0: invalid mode: $mode" >&2 149 | exit 1;; 150 | esac 151 | shift;; 152 | 153 | -o) chowncmd="$chownprog $2" 154 | shift;; 155 | 156 | -s) stripcmd=$stripprog;; 157 | 158 | -t) dst_arg=$2 159 | shift;; 160 | 161 | -T) no_target_directory=true;; 162 | 163 | --version) echo "$0 $scriptversion"; exit $?;; 164 | 165 | --) shift 166 | break;; 167 | 168 | -*) echo "$0: invalid option: $1" >&2 169 | exit 1;; 170 | 171 | *) break;; 172 | esac 173 | shift 174 | done 175 | 176 | if test $# -ne 0 && test -z "$dir_arg$dst_arg"; then 177 | # When -d is used, all remaining arguments are directories to create. 178 | # When -t is used, the destination is already specified. 179 | # Otherwise, the last argument is the destination. Remove it from $@. 180 | for arg 181 | do 182 | if test -n "$dst_arg"; then 183 | # $@ is not empty: it contains at least $arg. 184 | set fnord "$@" "$dst_arg" 185 | shift # fnord 186 | fi 187 | shift # arg 188 | dst_arg=$arg 189 | done 190 | fi 191 | 192 | if test $# -eq 0; then 193 | if test -z "$dir_arg"; then 194 | echo "$0: no input file specified." >&2 195 | exit 1 196 | fi 197 | # It's OK to call `install-sh -d' without argument. 198 | # This can happen when creating conditional directories. 199 | exit 0 200 | fi 201 | 202 | if test -z "$dir_arg"; then 203 | do_exit='(exit $ret); exit $ret' 204 | trap "ret=129; $do_exit" 1 205 | trap "ret=130; $do_exit" 2 206 | trap "ret=141; $do_exit" 13 207 | trap "ret=143; $do_exit" 15 208 | 209 | # Set umask so as not to create temps with too-generous modes. 210 | # However, 'strip' requires both read and write access to temps. 211 | case $mode in 212 | # Optimize common cases. 213 | *644) cp_umask=133;; 214 | *755) cp_umask=22;; 215 | 216 | *[0-7]) 217 | if test -z "$stripcmd"; then 218 | u_plus_rw= 219 | else 220 | u_plus_rw='% 200' 221 | fi 222 | cp_umask=`expr '(' 777 - $mode % 1000 ')' $u_plus_rw`;; 223 | *) 224 | if test -z "$stripcmd"; then 225 | u_plus_rw= 226 | else 227 | u_plus_rw=,u+rw 228 | fi 229 | cp_umask=$mode$u_plus_rw;; 230 | esac 231 | fi 232 | 233 | for src 234 | do 235 | # Protect names starting with `-'. 236 | case $src in 237 | -*) src=./$src;; 238 | esac 239 | 240 | if test -n "$dir_arg"; then 241 | dst=$src 242 | dstdir=$dst 243 | test -d "$dstdir" 244 | dstdir_status=$? 245 | else 246 | 247 | # Waiting for this to be detected by the "$cpprog $src $dsttmp" command 248 | # might cause directories to be created, which would be especially bad 249 | # if $src (and thus $dsttmp) contains '*'. 250 | if test ! -f "$src" && test ! -d "$src"; then 251 | echo "$0: $src does not exist." >&2 252 | exit 1 253 | fi 254 | 255 | if test -z "$dst_arg"; then 256 | echo "$0: no destination specified." >&2 257 | exit 1 258 | fi 259 | 260 | dst=$dst_arg 261 | # Protect names starting with `-'. 262 | case $dst in 263 | -*) dst=./$dst;; 264 | esac 265 | 266 | # If destination is a directory, append the input filename; won't work 267 | # if double slashes aren't ignored. 268 | if test -d "$dst"; then 269 | if test -n "$no_target_directory"; then 270 | echo "$0: $dst_arg: Is a directory" >&2 271 | exit 1 272 | fi 273 | dstdir=$dst 274 | dst=$dstdir/`basename "$src"` 275 | dstdir_status=0 276 | else 277 | # Prefer dirname, but fall back on a substitute if dirname fails. 278 | dstdir=` 279 | (dirname "$dst") 2>/dev/null || 280 | expr X"$dst" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ 281 | X"$dst" : 'X\(//\)[^/]' \| \ 282 | X"$dst" : 'X\(//\)$' \| \ 283 | X"$dst" : 'X\(/\)' \| . 2>/dev/null || 284 | echo X"$dst" | 285 | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ 286 | s//\1/ 287 | q 288 | } 289 | /^X\(\/\/\)[^/].*/{ 290 | s//\1/ 291 | q 292 | } 293 | /^X\(\/\/\)$/{ 294 | s//\1/ 295 | q 296 | } 297 | /^X\(\/\).*/{ 298 | s//\1/ 299 | q 300 | } 301 | s/.*/./; q' 302 | ` 303 | 304 | test -d "$dstdir" 305 | dstdir_status=$? 306 | fi 307 | fi 308 | 309 | obsolete_mkdir_used=false 310 | 311 | if test $dstdir_status != 0; then 312 | case $posix_mkdir in 313 | '') 314 | # Create intermediate dirs using mode 755 as modified by the umask. 315 | # This is like FreeBSD 'install' as of 1997-10-28. 316 | umask=`umask` 317 | case $stripcmd.$umask in 318 | # Optimize common cases. 319 | *[2367][2367]) mkdir_umask=$umask;; 320 | .*0[02][02] | .[02][02] | .[02]) mkdir_umask=22;; 321 | 322 | *[0-7]) 323 | mkdir_umask=`expr $umask + 22 \ 324 | - $umask % 100 % 40 + $umask % 20 \ 325 | - $umask % 10 % 4 + $umask % 2 326 | `;; 327 | *) mkdir_umask=$umask,go-w;; 328 | esac 329 | 330 | # With -d, create the new directory with the user-specified mode. 331 | # Otherwise, rely on $mkdir_umask. 332 | if test -n "$dir_arg"; then 333 | mkdir_mode=-m$mode 334 | else 335 | mkdir_mode= 336 | fi 337 | 338 | posix_mkdir=false 339 | case $umask in 340 | *[123567][0-7][0-7]) 341 | # POSIX mkdir -p sets u+wx bits regardless of umask, which 342 | # is incompatible with FreeBSD 'install' when (umask & 300) != 0. 343 | ;; 344 | *) 345 | tmpdir=${TMPDIR-/tmp}/ins$RANDOM-$$ 346 | trap 'ret=$?; rmdir "$tmpdir/d" "$tmpdir" 2>/dev/null; exit $ret' 0 347 | 348 | if (umask $mkdir_umask && 349 | exec $mkdirprog $mkdir_mode -p -- "$tmpdir/d") >/dev/null 2>&1 350 | then 351 | if test -z "$dir_arg" || { 352 | # Check for POSIX incompatibilities with -m. 353 | # HP-UX 11.23 and IRIX 6.5 mkdir -m -p sets group- or 354 | # other-writeable bit of parent directory when it shouldn't. 355 | # FreeBSD 6.1 mkdir -m -p sets mode of existing directory. 356 | ls_ld_tmpdir=`ls -ld "$tmpdir"` 357 | case $ls_ld_tmpdir in 358 | d????-?r-*) different_mode=700;; 359 | d????-?--*) different_mode=755;; 360 | *) false;; 361 | esac && 362 | $mkdirprog -m$different_mode -p -- "$tmpdir" && { 363 | ls_ld_tmpdir_1=`ls -ld "$tmpdir"` 364 | test "$ls_ld_tmpdir" = "$ls_ld_tmpdir_1" 365 | } 366 | } 367 | then posix_mkdir=: 368 | fi 369 | rmdir "$tmpdir/d" "$tmpdir" 370 | else 371 | # Remove any dirs left behind by ancient mkdir implementations. 372 | rmdir ./$mkdir_mode ./-p ./-- 2>/dev/null 373 | fi 374 | trap '' 0;; 375 | esac;; 376 | esac 377 | 378 | if 379 | $posix_mkdir && ( 380 | umask $mkdir_umask && 381 | $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir" 382 | ) 383 | then : 384 | else 385 | 386 | # The umask is ridiculous, or mkdir does not conform to POSIX, 387 | # or it failed possibly due to a race condition. Create the 388 | # directory the slow way, step by step, checking for races as we go. 389 | 390 | case $dstdir in 391 | /*) prefix='/';; 392 | -*) prefix='./';; 393 | *) prefix='';; 394 | esac 395 | 396 | eval "$initialize_posix_glob" 397 | 398 | oIFS=$IFS 399 | IFS=/ 400 | $posix_glob set -f 401 | set fnord $dstdir 402 | shift 403 | $posix_glob set +f 404 | IFS=$oIFS 405 | 406 | prefixes= 407 | 408 | for d 409 | do 410 | test -z "$d" && continue 411 | 412 | prefix=$prefix$d 413 | if test -d "$prefix"; then 414 | prefixes= 415 | else 416 | if $posix_mkdir; then 417 | (umask=$mkdir_umask && 418 | $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir") && break 419 | # Don't fail if two instances are running concurrently. 420 | test -d "$prefix" || exit 1 421 | else 422 | case $prefix in 423 | *\'*) qprefix=`echo "$prefix" | sed "s/'/'\\\\\\\\''/g"`;; 424 | *) qprefix=$prefix;; 425 | esac 426 | prefixes="$prefixes '$qprefix'" 427 | fi 428 | fi 429 | prefix=$prefix/ 430 | done 431 | 432 | if test -n "$prefixes"; then 433 | # Don't fail if two instances are running concurrently. 434 | (umask $mkdir_umask && 435 | eval "\$doit_exec \$mkdirprog $prefixes") || 436 | test -d "$dstdir" || exit 1 437 | obsolete_mkdir_used=true 438 | fi 439 | fi 440 | fi 441 | 442 | if test -n "$dir_arg"; then 443 | { test -z "$chowncmd" || $doit $chowncmd "$dst"; } && 444 | { test -z "$chgrpcmd" || $doit $chgrpcmd "$dst"; } && 445 | { test "$obsolete_mkdir_used$chowncmd$chgrpcmd" = false || 446 | test -z "$chmodcmd" || $doit $chmodcmd $mode "$dst"; } || exit 1 447 | else 448 | 449 | # Make a couple of temp file names in the proper directory. 450 | dsttmp=$dstdir/_inst.$$_ 451 | rmtmp=$dstdir/_rm.$$_ 452 | 453 | # Trap to clean up those temp files at exit. 454 | trap 'ret=$?; rm -f "$dsttmp" "$rmtmp" && exit $ret' 0 455 | 456 | # Copy the file name to the temp name. 457 | (umask $cp_umask && $doit_exec $cpprog "$src" "$dsttmp") && 458 | 459 | # and set any options; do chmod last to preserve setuid bits. 460 | # 461 | # If any of these fail, we abort the whole thing. If we want to 462 | # ignore errors from any of these, just make sure not to ignore 463 | # errors from the above "$doit $cpprog $src $dsttmp" command. 464 | # 465 | { test -z "$chowncmd" || $doit $chowncmd "$dsttmp"; } && 466 | { test -z "$chgrpcmd" || $doit $chgrpcmd "$dsttmp"; } && 467 | { test -z "$stripcmd" || $doit $stripcmd "$dsttmp"; } && 468 | { test -z "$chmodcmd" || $doit $chmodcmd $mode "$dsttmp"; } && 469 | 470 | # If -C, don't bother to copy if it wouldn't change the file. 471 | if $copy_on_change && 472 | old=`LC_ALL=C ls -dlL "$dst" 2>/dev/null` && 473 | new=`LC_ALL=C ls -dlL "$dsttmp" 2>/dev/null` && 474 | 475 | eval "$initialize_posix_glob" && 476 | $posix_glob set -f && 477 | set X $old && old=:$2:$4:$5:$6 && 478 | set X $new && new=:$2:$4:$5:$6 && 479 | $posix_glob set +f && 480 | 481 | test "$old" = "$new" && 482 | $cmpprog "$dst" "$dsttmp" >/dev/null 2>&1 483 | then 484 | rm -f "$dsttmp" 485 | else 486 | # Rename the file to the real destination. 487 | $doit $mvcmd -f "$dsttmp" "$dst" 2>/dev/null || 488 | 489 | # The rename failed, perhaps because mv can't rename something else 490 | # to itself, or perhaps because mv is so ancient that it does not 491 | # support -f. 492 | { 493 | # Now remove or move aside any old file at destination location. 494 | # We try this two ways since rm can't unlink itself on some 495 | # systems and the destination file might be busy for other 496 | # reasons. In this case, the final cleanup might fail but the new 497 | # file should still install successfully. 498 | { 499 | test ! -f "$dst" || 500 | $doit $rmcmd -f "$dst" 2>/dev/null || 501 | { $doit $mvcmd -f "$dst" "$rmtmp" 2>/dev/null && 502 | { $doit $rmcmd -f "$rmtmp" 2>/dev/null; :; } 503 | } || 504 | { echo "$0: cannot unlink or rename $dst" >&2 505 | (exit 1); exit 1 506 | } 507 | } && 508 | 509 | # Now rename the file to the real destination. 510 | $doit $mvcmd "$dsttmp" "$dst" 511 | } 512 | fi || exit 1 513 | 514 | trap '' 0 515 | fi 516 | done 517 | 518 | # Local variables: 519 | # eval: (add-hook 'write-file-hooks 'time-stamp) 520 | # time-stamp-start: "scriptversion=" 521 | # time-stamp-format: "%:y-%02m-%02d.%02H" 522 | # time-stamp-time-zone: "UTC" 523 | # time-stamp-end: "; # UTC" 524 | # End: 525 | -------------------------------------------------------------------------------- /tclooConfig.sh.in: -------------------------------------------------------------------------------- 1 | # tclooConfig.sh -- 2 | # 3 | # This shell script (for sh) is generated automatically by TclOO's configure 4 | # script. It will create shell variables for most of the configuration options 5 | # discovered by the configure script. This script is intended to be included 6 | # by the configure scripts for TclOO extensions so that they don't have to 7 | # figure this all out for themselves. 8 | # 9 | # The information in this file is specific to a single platform. 10 | # 11 | # RCS: @(#) $Id: tclooConfig.sh.in,v 1.4 2007/10/03 12:40:05 dkf Exp $ 12 | 13 | TCLOO_LIB_SPEC="@TCLOO_LIB_SPEC@" 14 | TCLOO_STUB_LIB_SPEC="@TCLOO_STUB_LIB_SPEC@" 15 | TCLOO_INCLUDE_SPEC="@TCLOO_INCLUDE_SPEC@" 16 | TCLOO_PRIVATE_INCLUDE_SPEC="@TCLOO_PRIVATE_INCLUDE_SPEC@" 17 | TCLOO_CFLAGS=-DUSE_TCLOO_STUBS 18 | TCLOO_VERSION=@PACKAGE_VERSION@ 19 | -------------------------------------------------------------------------------- /tests/all.tcl: -------------------------------------------------------------------------------- 1 | # all.tcl -- 2 | # 3 | # This file contains a top-level script to run all of the Tcl tests. Execute 4 | # it by invoking "source all.test" when running tcltest in this directory. 5 | # 6 | # Copyright (c) 1998-1999 by Scriptics Corporation. 7 | # Copyright (c) 2000 by Ajuba Solutions 8 | # 9 | # See the file "license.terms" for information on usage and redistribution of 10 | # this file, and for a DISCLAIMER OF ALL WARRANTIES. 11 | # 12 | 13 | package require Tcl 8.5 14 | package require tcltest 2.2 15 | namespace import tcltest::* 16 | configure {*}$argv -testdir [file dir [info script]] 17 | runAllTests 18 | -------------------------------------------------------------------------------- /tests/load.test: -------------------------------------------------------------------------------- 1 | # This file contains a collection of tests for Tcl's built-in object system. 2 | # Sourcing this file into Tcl runs the tests and generates output for errors. 3 | # No output means no errors were found. 4 | # 5 | # Copyright (c) 2013 Jan Nijtmans 6 | # Copyright (c) 2014 Donal K. Fellows 7 | # 8 | # See the file "license.terms" for information on usage and redistribution of 9 | # this file, and for a DISCLAIMER OF ALL WARRANTIES. 10 | # 11 | 12 | if {"::tcltest" ni [namespace children]} { 13 | package require tcltest 2 14 | namespace import -force ::tcltest::* 15 | } 16 | set dll pkgoo[info sharedlibextension] 17 | testConstraint pkgooRequired [file readable $dll] 18 | testConstraint pkgooLoaded [expr {!([string first $dll [info loaded]] + 1)}] 19 | 20 | test load-11.1 {Load TclOO extension using Stubs (Bug [f51efe99a7])} \ 21 | [list pkgooRequired pkgooLoaded] { 22 | load ./pkgoo[info sharedlibextension] 23 | list [pkgoo_stubsok] [lsort [info commands pkgoo_*]] 24 | } {1 pkgoo_stubsok} 25 | 26 | cleanupTests 27 | return 28 | 29 | # Local Variables: 30 | # mode: tcl 31 | # End: 32 | -------------------------------------------------------------------------------- /tests/ooNext2.test: -------------------------------------------------------------------------------- 1 | # This file contains a collection of tests for Tcl's built-in object system. 2 | # Sourcing this file into Tcl runs the tests and generates output for errors. 3 | # No output means no errors were found. 4 | # 5 | # Copyright (c) 2010-2011 Donal K. Fellows 6 | # 7 | # See the file "license.terms" for information on usage and redistribution of 8 | # this file, and for a DISCLAIMER OF ALL WARRANTIES. 9 | # 10 | 11 | package require TclOO 1.0.4 ;# Should match value in configure.in 12 | if {"::tcltest" ni [namespace children]} { 13 | package require tcltest 2 14 | namespace import -force ::tcltest::* 15 | } 16 | 17 | testConstraint memory [llength [info commands memory]] 18 | if {[testConstraint memory]} { 19 | proc getbytes {} { 20 | set lines [split [memory info] \n] 21 | return [lindex $lines 3 3] 22 | } 23 | proc leaktest {script {iterations 3}} { 24 | set end [getbytes] 25 | for {set i 0} {$i < $iterations} {incr i} { 26 | uplevel 1 $script 27 | set tmp $end 28 | set end [getbytes] 29 | } 30 | return [expr {$end - $tmp}] 31 | } 32 | } 33 | 34 | test oo-nextto-1.1 {basic nextto functionality} -setup { 35 | oo::class create root 36 | } -body { 37 | oo::class create A { 38 | superclass root 39 | method x args { 40 | lappend ::result ==A== $args 41 | } 42 | } 43 | oo::class create B { 44 | superclass A 45 | method x args { 46 | lappend ::result ==B== $args 47 | nextto A B -> A {*}$args 48 | } 49 | } 50 | oo::class create C { 51 | superclass A 52 | method x args { 53 | lappend ::result ==C== $args 54 | nextto A C -> A {*}$args 55 | } 56 | } 57 | oo::class create D { 58 | superclass B C 59 | method x args { 60 | lappend ::result ==D== $args 61 | next foo 62 | nextto C bar 63 | } 64 | } 65 | set ::result {} 66 | [D new] x 67 | return $::result 68 | } -cleanup { 69 | root destroy 70 | } -result {==D== {} ==B== foo ==A== {B -> A foo} ==C== bar ==A== {C -> A bar}} 71 | test oo-nextto-1.2 {basic nextto functionality} -setup { 72 | oo::class create root 73 | } -body { 74 | oo::class create A { 75 | superclass root 76 | method x args { 77 | lappend ::result ==A== $args 78 | } 79 | } 80 | oo::class create B { 81 | superclass A 82 | method x args { 83 | lappend ::result ==B== $args 84 | nextto A B -> A {*}$args 85 | } 86 | } 87 | oo::class create C { 88 | superclass A 89 | method x args { 90 | lappend ::result ==C== $args 91 | nextto A C -> A {*}$args 92 | } 93 | } 94 | oo::class create D { 95 | superclass B C 96 | method x args { 97 | lappend ::result ==D== $args 98 | nextto B foo {*}$args 99 | nextto C bar {*}$args 100 | } 101 | } 102 | set ::result {} 103 | [D new] x 123 104 | return $::result 105 | } -cleanup { 106 | root destroy 107 | } -result {==D== 123 ==B== {foo 123} ==A== {B -> A foo 123} ==C== {bar 123} ==A== {C -> A bar 123}} 108 | test oo-nextto-1.3 {basic nextto functionality: constructors} -setup { 109 | oo::class create root 110 | } -body { 111 | oo::class create A { 112 | superclass root 113 | variable result 114 | constructor {a c} { 115 | lappend result ==A== a=$a,c=$c 116 | } 117 | } 118 | oo::class create B { 119 | superclass root 120 | variable result 121 | constructor {b} { 122 | lappend result ==B== b=$b 123 | } 124 | } 125 | oo::class create C { 126 | superclass A B 127 | variable result 128 | constructor {p q r} { 129 | lappend result ==C== p=$p,q=$q,r=$r 130 | # Route arguments to superclasses, in non-trival pattern 131 | nextto B $q 132 | nextto A $p $r 133 | } 134 | method result {} {return $result} 135 | } 136 | [C new x y z] result 137 | } -cleanup { 138 | root destroy 139 | } -result {==C== p=x,q=y,r=z ==B== b=y ==A== a=x,c=z} 140 | test oo-nextto-1.4 {basic nextto functionality: destructors} -setup { 141 | oo::class create root {destructor return} 142 | } -body { 143 | oo::class create A { 144 | superclass root 145 | destructor { 146 | lappend ::result ==A== 147 | next 148 | } 149 | } 150 | oo::class create B { 151 | superclass root 152 | destructor { 153 | lappend ::result ==B== 154 | next 155 | } 156 | } 157 | oo::class create C { 158 | superclass A B 159 | destructor { 160 | lappend ::result ==C== 161 | lappend ::result | 162 | nextto B 163 | lappend ::result | 164 | nextto A 165 | lappend ::result | 166 | next 167 | } 168 | } 169 | set ::result "" 170 | [C new] destroy 171 | return $::result 172 | } -cleanup { 173 | root destroy 174 | } -result {==C== | ==B== | ==A== ==B== | ==A== ==B==} 175 | 176 | test oo-nextto-2.1 {errors in nextto} -setup { 177 | oo::class create root 178 | } -body { 179 | oo::class create A { 180 | superclass root 181 | method x y {error $y} 182 | } 183 | oo::class create B { 184 | superclass A 185 | method x y {nextto A $y} 186 | } 187 | [B new] x boom 188 | } -cleanup { 189 | root destroy 190 | } -result boom -returnCodes error 191 | test oo-nextto-2.2 {errors in nextto} -setup { 192 | oo::class create root 193 | } -body { 194 | oo::class create A { 195 | superclass root 196 | method x y {error $y} 197 | } 198 | oo::class create B { 199 | superclass root 200 | method x y {nextto A $y} 201 | } 202 | [B new] x boom 203 | } -returnCodes error -cleanup { 204 | root destroy 205 | } -result {method has no non-filter implementation by "A"} 206 | test oo-nextto-2.3 {errors in nextto} -setup { 207 | oo::class create root 208 | } -body { 209 | oo::class create A { 210 | superclass root 211 | method x y {nextto $y} 212 | } 213 | oo::class create B { 214 | superclass A 215 | method x y {nextto A $y} 216 | } 217 | [B new] x B 218 | } -returnCodes error -cleanup { 219 | root destroy 220 | } -result {method implementation by "B" not reachable from here} 221 | test oo-nextto-2.4 {errors in nextto} -setup { 222 | oo::class create root 223 | } -body { 224 | oo::class create A { 225 | superclass root 226 | method x y {nextto $y} 227 | } 228 | oo::class create B { 229 | superclass A 230 | method x y {nextto} 231 | } 232 | [B new] x B 233 | } -returnCodes error -cleanup { 234 | root destroy 235 | } -result {wrong # args: should be "nextto class ?arg...?"} 236 | test oo-nextto-2.5 {errors in nextto} -setup { 237 | oo::class create root 238 | } -body { 239 | oo::class create A { 240 | superclass root 241 | method x y {nextto $y} 242 | } 243 | oo::class create B { 244 | superclass A 245 | method x y {nextto $y $y $y} 246 | } 247 | [B new] x A 248 | } -cleanup { 249 | root destroy 250 | } -result {wrong # args: should be "nextto A y"} -returnCodes error 251 | test oo-nextto-2.6 {errors in nextto} -setup { 252 | oo::class create root 253 | } -body { 254 | oo::class create A { 255 | superclass root 256 | method x y {nextto $y} 257 | } 258 | oo::class create B { 259 | superclass A 260 | method x y {nextto $y $y $y} 261 | } 262 | [B new] x [root create notAClass] 263 | } -cleanup { 264 | root destroy 265 | } -result {"::notAClass" is not a class} -returnCodes error 266 | test oo-nextto-2.7 {errors in nextto} -setup { 267 | oo::class create root 268 | } -body { 269 | oo::class create A { 270 | superclass root 271 | method x y {nextto $y} 272 | } 273 | oo::class create B { 274 | superclass A 275 | filter Y 276 | method Y args {next {*}$args} 277 | } 278 | oo::class create C { 279 | superclass B 280 | method x y {nextto $y $y $y} 281 | } 282 | [C new] x B 283 | } -returnCodes error -cleanup { 284 | root destroy 285 | } -result {method has no non-filter implementation by "B"} 286 | 287 | test oo-call-1.1 {object call introspection} -setup { 288 | oo::class create root 289 | } -body { 290 | oo::class create ::A { 291 | superclass root 292 | method x {} {} 293 | } 294 | A create y 295 | info object call y x 296 | } -cleanup { 297 | root destroy 298 | } -result {{method x ::A method}} 299 | test oo-call-1.2 {object call introspection} -setup { 300 | oo::class create root 301 | } -body { 302 | oo::class create ::A { 303 | superclass root 304 | method x {} {} 305 | } 306 | oo::class create ::B { 307 | superclass A 308 | method x {} {} 309 | } 310 | B create y 311 | info object call y x 312 | } -cleanup { 313 | root destroy 314 | } -result {{method x ::B method} {method x ::A method}} 315 | test oo-call-1.3 {object call introspection} -setup { 316 | oo::class create root 317 | } -body { 318 | oo::class create ::A { 319 | superclass root 320 | method x {} {} 321 | } 322 | A create y 323 | oo::objdefine y method x {} {} 324 | info object call y x 325 | } -cleanup { 326 | root destroy 327 | } -result {{method x object method} {method x ::A method}} 328 | test oo-call-1.4 {object object call introspection - unknown} -setup { 329 | oo::class create root 330 | } -body { 331 | oo::class create ::A { 332 | superclass root 333 | method x {} {} 334 | } 335 | A create y 336 | info object call y z 337 | } -cleanup { 338 | root destroy 339 | } -result {{unknown unknown ::oo::object {core method: "unknown"}}} 340 | test oo-call-1.5 {object call introspection - filters} -setup { 341 | oo::class create root 342 | } -body { 343 | oo::class create ::A { 344 | superclass root 345 | method x {} {} 346 | method y {} {} 347 | filter y 348 | } 349 | A create y 350 | info object call y x 351 | } -cleanup { 352 | root destroy 353 | } -result {{filter y ::A method} {method x ::A method}} 354 | test oo-call-1.6 {object call introspection - filters} -setup { 355 | oo::class create root 356 | } -body { 357 | oo::class create ::A { 358 | superclass root 359 | method x {} {} 360 | method y {} {} 361 | filter y 362 | } 363 | oo::class create ::B { 364 | superclass A 365 | method x {} {} 366 | } 367 | B create y 368 | info object call y x 369 | } -cleanup { 370 | root destroy 371 | } -result {{filter y ::A method} {method x ::B method} {method x ::A method}} 372 | test oo-call-1.7 {object call introspection - filters} -setup { 373 | oo::class create root 374 | } -body { 375 | oo::class create ::A { 376 | superclass root 377 | method x {} {} 378 | method y {} {} 379 | filter y 380 | } 381 | oo::class create ::B { 382 | superclass A 383 | method x {} {} 384 | method y {} {} 385 | } 386 | B create y 387 | info object call y x 388 | } -cleanup { 389 | root destroy 390 | } -result {{filter y ::B method} {filter y ::A method} {method x ::B method} {method x ::A method}} 391 | test oo-call-1.8 {object call introspection - filters} -setup { 392 | oo::class create root 393 | } -body { 394 | oo::class create ::A { 395 | superclass root 396 | method x {} {} 397 | method y {} {} 398 | filter y 399 | } 400 | oo::class create ::B { 401 | superclass A 402 | method x {} {} 403 | method y {} {} 404 | method z {} {} 405 | filter z 406 | } 407 | B create y 408 | info object call y x 409 | } -cleanup { 410 | root destroy 411 | } -result {{filter z ::B method} {filter y ::B method} {filter y ::A method} {method x ::B method} {method x ::A method}} 412 | test oo-call-1.9 {object call introspection - filters} -setup { 413 | oo::class create root 414 | } -body { 415 | oo::class create ::A { 416 | superclass root 417 | method x {} {} 418 | method y {} {} 419 | filter y 420 | } 421 | oo::class create ::B { 422 | superclass A 423 | method x {} {} 424 | method y {} {} 425 | method z {} {} 426 | filter z 427 | } 428 | B create y 429 | info object call y y 430 | } -cleanup { 431 | root destroy 432 | } -result {{filter z ::B method} {filter y ::B method} {filter y ::A method} {method y ::B method} {method y ::A method}} 433 | test oo-call-1.10 {object call introspection - filters + unknown} -setup { 434 | oo::class create root 435 | } -body { 436 | oo::class create ::A { 437 | superclass root 438 | method y {} {} 439 | filter y 440 | } 441 | oo::class create ::B { 442 | superclass A 443 | method y {} {} 444 | method unknown {} {} 445 | } 446 | B create y 447 | info object call y x 448 | } -cleanup { 449 | root destroy 450 | } -result {{filter y ::B method} {filter y ::A method} {unknown unknown ::B method} {unknown unknown ::oo::object {core method: "unknown"}}} 451 | test oo-call-1.11 {object call introspection - filters + unknown} -setup { 452 | oo::class create root 453 | } -body { 454 | oo::class create ::A { 455 | superclass root 456 | method y {} {} 457 | filter y 458 | } 459 | A create y 460 | oo::objdefine y method unknown {} {} 461 | info object call y x 462 | } -cleanup { 463 | root destroy 464 | } -result {{filter y ::A method} {unknown unknown object method} {unknown unknown ::oo::object {core method: "unknown"}}} 465 | test oo-call-1.12 {object call introspection - filters + unknown} -setup { 466 | oo::class create root 467 | } -body { 468 | oo::class create ::A { 469 | superclass root 470 | method y {} {} 471 | } 472 | A create y 473 | oo::objdefine y { 474 | method unknown {} {} 475 | filter y 476 | } 477 | info object call y x 478 | } -cleanup { 479 | root destroy 480 | } -result {{filter y ::A method} {unknown unknown object method} {unknown unknown ::oo::object {core method: "unknown"}}} 481 | test oo-call-1.13 {object call introspection - filters + unknown} -setup { 482 | oo::class create root 483 | } -body { 484 | oo::class create ::A { 485 | superclass root 486 | method y {} {} 487 | } 488 | A create y 489 | oo::objdefine y { 490 | method unknown {} {} 491 | method x {} {} 492 | filter y 493 | } 494 | info object call y x 495 | } -cleanup { 496 | root destroy 497 | } -result {{filter y ::A method} {method x object method}} 498 | test oo-call-1.14 {object call introspection - errors} -body { 499 | info object call 500 | } -returnCodes error -result {wrong # args: should be "info object call objName methodName"} 501 | test oo-call-1.15 {object call introspection - errors} -body { 502 | info object call a 503 | } -returnCodes error -result {wrong # args: should be "info object call objName methodName"} 504 | test oo-call-1.16 {object call introspection - errors} -body { 505 | info object call a b c 506 | } -returnCodes error -result {wrong # args: should be "info object call objName methodName"} 507 | test oo-call-1.17 {object call introspection - errors} -body { 508 | info object call notanobject x 509 | } -returnCodes error -result {notanobject does not refer to an object} 510 | test oo-call-1.18 {object call introspection - memory leaks} -body { 511 | leaktest { 512 | info object call oo::object destroy 513 | } 514 | } -constraints memory -result 0 515 | test oo-call-1.19 {object call introspection - memory leaks} -setup { 516 | oo::class create leaktester { method foo {} {dummy} } 517 | } -body { 518 | leaktest { 519 | set lt [leaktester new] 520 | oo::objdefine $lt method foobar {} {dummy} 521 | list [info object call $lt destroy] \ 522 | [info object call $lt foo] \ 523 | [info object call $lt bar] \ 524 | [info object call $lt foobar] \ 525 | [$lt destroy] 526 | } 527 | } -cleanup { 528 | leaktester destroy 529 | } -constraints memory -result 0 530 | 531 | test oo-call-2.1 {class call introspection} -setup { 532 | oo::class create root 533 | } -body { 534 | oo::class create ::A { 535 | superclass root 536 | method x {} {} 537 | } 538 | info class call A x 539 | } -cleanup { 540 | root destroy 541 | } -result {{method x ::A method}} 542 | test oo-call-2.2 {class call introspection} -setup { 543 | oo::class create root 544 | } -body { 545 | oo::class create ::A { 546 | superclass root 547 | method x {} {} 548 | } 549 | oo::class create ::B { 550 | superclass A 551 | method x {} {} 552 | } 553 | list [info class call A x] [info class call B x] 554 | } -cleanup { 555 | root destroy 556 | } -result {{{method x ::A method}} {{method x ::B method} {method x ::A method}}} 557 | test oo-call-2.3 {class call introspection} -setup { 558 | oo::class create root 559 | } -body { 560 | oo::class create ::A { 561 | superclass root 562 | method x {} {} 563 | } 564 | oo::class create ::B { 565 | superclass A 566 | method x {} {} 567 | } 568 | oo::class create ::C { 569 | superclass A 570 | method x {} {} 571 | } 572 | oo::class create ::D { 573 | superclass C B 574 | method x {} {} 575 | } 576 | info class call D x 577 | } -cleanup { 578 | root destroy 579 | } -result {{method x ::D method} {method x ::C method} {method x ::B method} {method x ::A method}} 580 | test oo-call-2.4 {class call introspection - mixin} -setup { 581 | oo::class create root 582 | } -body { 583 | oo::class create ::A { 584 | superclass root 585 | method x {} {} 586 | } 587 | oo::class create ::B { 588 | superclass A 589 | method x {} {} 590 | } 591 | oo::class create ::C { 592 | superclass A 593 | method x {} {} 594 | } 595 | oo::class create ::D { 596 | superclass C 597 | mixin B 598 | method x {} {} 599 | } 600 | info class call D x 601 | } -cleanup { 602 | root destroy 603 | } -result {{method x ::B method} {method x ::D method} {method x ::C method} {method x ::A method}} 604 | test oo-call-2.5 {class call introspection - mixin + filter} -setup { 605 | oo::class create root 606 | } -body { 607 | oo::class create ::A { 608 | superclass root 609 | method x {} {} 610 | } 611 | oo::class create ::B { 612 | superclass A 613 | method x {} {} 614 | method y {} {} 615 | filter y 616 | } 617 | oo::class create ::C { 618 | superclass A 619 | method x {} {} 620 | method y {} {} 621 | } 622 | oo::class create ::D { 623 | superclass C 624 | mixin B 625 | method x {} {} 626 | } 627 | info class call D x 628 | } -cleanup { 629 | root destroy 630 | } -result {{filter y ::B method} {filter y ::C method} {method x ::B method} {method x ::D method} {method x ::C method} {method x ::A method}} 631 | test oo-call-2.6 {class call introspection - mixin + filter + unknown} -setup { 632 | oo::class create root 633 | } -body { 634 | oo::class create ::A { 635 | superclass root 636 | method x {} {} 637 | method unknown {} {} 638 | } 639 | oo::class create ::B { 640 | superclass A 641 | method x {} {} 642 | method y {} {} 643 | filter y 644 | } 645 | oo::class create ::C { 646 | superclass A 647 | method x {} {} 648 | method y {} {} 649 | } 650 | oo::class create ::D { 651 | superclass C 652 | mixin B 653 | method x {} {} 654 | method unknown {} {} 655 | } 656 | info class call D z 657 | } -cleanup { 658 | root destroy 659 | } -result {{filter y ::B method} {filter y ::C method} {unknown unknown ::D method} {unknown unknown ::A method} {unknown unknown ::oo::object {core method: "unknown"}}} 660 | test oo-call-2.7 {class call introspection - mixin + filter + unknown} -setup { 661 | oo::class create root 662 | } -body { 663 | oo::class create ::A { 664 | superclass root 665 | method x {} {} 666 | } 667 | oo::class create ::B { 668 | superclass A 669 | method x {} {} 670 | filter x 671 | } 672 | info class call B x 673 | } -cleanup { 674 | root destroy 675 | } -result {{filter x ::B method} {filter x ::A method} {method x ::B method} {method x ::A method}} 676 | test oo-call-2.8 {class call introspection - errors} -body { 677 | info class call 678 | } -returnCodes error -result {wrong # args: should be "info class call className methodName"} 679 | test oo-call-2.9 {class call introspection - errors} -body { 680 | info class call a 681 | } -returnCodes error -result {wrong # args: should be "info class call className methodName"} 682 | test oo-call-2.10 {class call introspection - errors} -body { 683 | info class call a b c 684 | } -returnCodes error -result {wrong # args: should be "info class call className methodName"} 685 | test oo-call-2.11 {class call introspection - errors} -body { 686 | info class call notaclass x 687 | } -returnCodes error -result {notaclass does not refer to an object} 688 | test oo-call-2.11 {class call introspection - errors} -setup { 689 | oo::class create root 690 | } -body { 691 | root create notaclass 692 | info class call notaclass x 693 | } -returnCodes error -cleanup { 694 | root destroy 695 | } -result {"notaclass" is not a class} 696 | test oo-call-2.13 {class call introspection - memory leaks} -body { 697 | leaktest { 698 | info class call oo::class destroy 699 | } 700 | } -constraints memory -result 0 701 | test oo-call-2.14 {class call introspection - memory leaks} -body { 702 | leaktest { 703 | oo::class create leaktester { method foo {} {dummy} } 704 | [leaktester new] destroy 705 | list [info class call leaktester destroy] \ 706 | [info class call leaktester foo] \ 707 | [info class call leaktester bar] \ 708 | [leaktester destroy] 709 | } 710 | } -constraints memory -result 0 711 | 712 | test oo-call-3.1 {current call introspection} -setup { 713 | oo::class create root 714 | } -body { 715 | oo::class create A { 716 | superclass root 717 | method x {} {lappend ::result [self call]} 718 | } 719 | oo::class create B { 720 | superclass A 721 | method x {} {lappend ::result [self call];next} 722 | } 723 | B create y 724 | oo::objdefine y method x {} {lappend ::result [self call];next} 725 | set ::result {} 726 | y x 727 | } -cleanup { 728 | root destroy 729 | } -result {{{{method x object method} {method x ::B method} {method x ::A method}} 0} {{{method x object method} {method x ::B method} {method x ::A method}} 1} {{{method x object method} {method x ::B method} {method x ::A method}} 2}} 730 | test oo-call-3.2 {current call introspection} -setup { 731 | oo::class create root 732 | } -constraints memory -body { 733 | oo::class create A { 734 | superclass root 735 | method x {} {self call} 736 | } 737 | oo::class create B { 738 | superclass A 739 | method x {} {self call;next} 740 | } 741 | B create y 742 | oo::objdefine y method x {} {self call;next} 743 | leaktest { 744 | y x 745 | } 746 | } -cleanup { 747 | root destroy 748 | } -result 0 749 | test oo-call-3.3 {current call introspection: in constructors} -setup { 750 | oo::class create root 751 | } -body { 752 | oo::class create A { 753 | superclass root 754 | constructor {} {lappend ::result [self call]} 755 | } 756 | oo::class create B { 757 | superclass A 758 | constructor {} {lappend ::result [self call]; next} 759 | } 760 | set ::result {} 761 | [B new] destroy 762 | return $::result 763 | } -cleanup { 764 | root destroy 765 | } -result {{{{method ::B method} {method ::A method}} 0} {{{method ::B method} {method ::A method}} 1}} 766 | test oo-call-3.4 {current call introspection: in destructors} -setup { 767 | oo::class create root 768 | } -body { 769 | oo::class create A { 770 | superclass root 771 | destructor {lappend ::result [self call]} 772 | } 773 | oo::class create B { 774 | superclass A 775 | destructor {lappend ::result [self call]; next} 776 | } 777 | set ::result {} 778 | [B new] destroy 779 | return $::result 780 | } -cleanup { 781 | root destroy 782 | } -result {{{{method ::B method} {method ::A method}} 0} {{{method ::B method} {method ::A method}} 1}} 783 | 784 | cleanupTests 785 | return 786 | 787 | # Local Variables: 788 | # mode: tcl 789 | # End: 790 | -------------------------------------------------------------------------------- /win/TclOO.rc: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | #define ALPHA 0 4 | #define BETA 1 5 | #define RELEASE 2 6 | 7 | LANGUAGE 0x9, 0x2 8 | VS_VERSION_INFO VERSIONINFO 9 | FILEVERSION 1,0,RELEASE,4 10 | PRODUCTVERSION 1,0,RELEASE,4 11 | FILEFLAGSMASK 0x3fL 12 | #ifdef DEBUG 13 | FILEFLAGS VS_FF_DEBUG 14 | #else 15 | FILEFLAGS 0x0L 16 | #endif 17 | FILEOS VOS__WINDOWS32 18 | FILETYPE VFT_DLL 19 | FILESUBTYPE 0x0L 20 | BEGIN 21 | BLOCK "StringFileInfo" 22 | BEGIN 23 | BLOCK "080904b0" // LANG_ENGLISH/SUBLANG_ENGLISH_UK, Unicode CP 24 | BEGIN 25 | VALUE "FileDescription", PACKAGE_NAME " Tcl Extension" 26 | VALUE "OriginalFilename", PKG_LIB_FILE 27 | VALUE "InternalName", PACKAGE_NAME 28 | VALUE "Author", "Donal K. Fellows" 29 | VALUE "CompanyName", "Tcl Core Team" 30 | VALUE "FileVersion", PACKAGE_VERSION 31 | VALUE "LegalCopyright", "Copyright \251 2005-2014 by Donal K. Fellows" 32 | VALUE "ProductName", "Object Orientation Extension Package for Tcl" 33 | VALUE "ProductVersion", PACKAGE_VERSION 34 | END 35 | END 36 | BLOCK "VarFileInfo" 37 | BEGIN 38 | VALUE "Translation", 0x809, 1200 39 | END 40 | END 41 | 42 | // Local Variables: 43 | // mode: c++ 44 | // End: 45 | --------------------------------------------------------------------------------