From c7f336bff3aaafe03961d4fce493c748995ff3e3 Mon Sep 17 00:00:00 2001 From: William Joye Date: Wed, 2 Jan 2019 15:10:12 -0500 Subject: Squashed 'tclxml/' content from commit df5cf32f git-subtree-dir: tclxml git-subtree-split: df5cf32f0b8d28409a362ee4511a912ee3e9263e --- ANNOUNCE | 21 + ChangeLog | 667 ++ LICENSE | 35 + Makefile.in | 459 ++ README.html | 280 + README.md | 356 + aclocal.m4 | 9 + configure | 10114 +++++++++++++++++++++++++ configure.ac | 293 + docObj.c | 1832 +++++ include/tcldom-libxml2/nodeObj.h | 28 + include/tcldom-libxml2/tcldom-libxml2.h | 266 + include/tcldom/tcldom.h | 293 + include/tclxml-libxml2/docObj.h | 60 + include/tclxml-libxml2/tclxml-libxml2.h | 100 + include/tclxml-libxml2/tclxml-libxml2Decls.h | 163 + include/tclxml/tclxml.h.in | 299 + include/tclxml/tclxmlDecls.h | 361 + include/tclxslt/tclxslt.h | 98 + macosx/Info-expat__Upgraded_.plist | 28 + macosx/Info-tclxml__Upgraded_.plist | 28 + macosx/Info-tclxml_libxml2__Upgraded_.plist | 28 + macosx/Tclxml-Info.plist | 20 + macosx/Tclxml.xcodeproj/project.pbxproj | 675 ++ macosx/Tclxml.xcodeproj/steve.mode1 | 1332 ++++ macosx/Tclxml.xcodeproj/steve.mode1v3 | 1376 ++++ macosx/Tclxml.xcodeproj/steve.pbxuser | 215 + nodeObj.c | 58 + pkgIndex.tcl.in | 165 + tclconfig/ChangeLog | 1003 +++ tclconfig/README.txt | 26 + tclconfig/install-sh | 528 ++ tclconfig/tcl.m4 | 4176 ++++++++++ tcldom-libxml2.c | 7178 ++++++++++++++++++ tcldom-libxml2.tcl | 37 + tcldom-tcl/dom.tcl | 4291 +++++++++++ tcldom-tcl/dommap.tcl | 108 + tcldom-tcl/xmlswitch.tcl | 520 ++ tcldom.c | 333 + tclxml-libxml2.c | 982 +++ tclxml-tcl/sgml-8.0.tcl | 143 + tclxml-tcl/sgml-8.1.tcl | 143 + tclxml-tcl/sgmlparser.tcl | 2814 +++++++ tclxml-tcl/tclparser-8.0.tcl | 359 + tclxml-tcl/tclparser-8.1.tcl | 614 ++ tclxml-tcl/xml-8.0.tcl | 92 + tclxml-tcl/xml-8.1.tcl | 135 + tclxml-tcl/xml__tcl.tcl | 272 + tclxml-tcl/xmldep.tcl | 179 + tclxml-tcl/xpath.tcl | 362 + tclxml.c | 3708 +++++++++ tclxml.decls | 187 + tclxmlConfig.sh.in | 45 + tclxmlDecls.h | 361 + tclxmlStubInit.c | 60 + tclxmlStubLib.c | 71 + tclxslt-libxslt.c | 1872 +++++ tclxslt-libxslt.tcl | 30 + tclxslt/process.tcl | 312 + tclxslt/resources.tcl | 388 + tclxslt/tclxslt.tcl | 30 + tclxslt/utilities.tcl | 144 + tclxslt/xsltcache.tcl | 379 + tools/genStubs.tcl | 894 +++ win/build.data | 28 + win/makefile.vc | 564 ++ win/mkPkgIndex.tcl | 31 + win/nmakehlp.c | 297 + win/rules.vc | 376 + 69 files changed, 53731 insertions(+) create mode 100644 ANNOUNCE create mode 100755 ChangeLog create mode 100644 LICENSE create mode 100644 Makefile.in create mode 100644 README.html create mode 100644 README.md create mode 100644 aclocal.m4 create mode 100755 configure create mode 100644 configure.ac create mode 100644 docObj.c create mode 100644 include/tcldom-libxml2/nodeObj.h create mode 100644 include/tcldom-libxml2/tcldom-libxml2.h create mode 100644 include/tcldom/tcldom.h create mode 100644 include/tclxml-libxml2/docObj.h create mode 100644 include/tclxml-libxml2/tclxml-libxml2.h create mode 100644 include/tclxml-libxml2/tclxml-libxml2Decls.h create mode 100755 include/tclxml/tclxml.h.in create mode 100644 include/tclxml/tclxmlDecls.h create mode 100644 include/tclxslt/tclxslt.h create mode 100644 macosx/Info-expat__Upgraded_.plist create mode 100644 macosx/Info-tclxml__Upgraded_.plist create mode 100644 macosx/Info-tclxml_libxml2__Upgraded_.plist create mode 100644 macosx/Tclxml-Info.plist create mode 100644 macosx/Tclxml.xcodeproj/project.pbxproj create mode 100644 macosx/Tclxml.xcodeproj/steve.mode1 create mode 100644 macosx/Tclxml.xcodeproj/steve.mode1v3 create mode 100644 macosx/Tclxml.xcodeproj/steve.pbxuser create mode 100644 nodeObj.c create mode 100644 pkgIndex.tcl.in create mode 100644 tclconfig/ChangeLog create mode 100644 tclconfig/README.txt create mode 100755 tclconfig/install-sh create mode 100644 tclconfig/tcl.m4 create mode 100644 tcldom-libxml2.c create mode 100644 tcldom-libxml2.tcl create mode 100644 tcldom-tcl/dom.tcl create mode 100644 tcldom-tcl/dommap.tcl create mode 100644 tcldom-tcl/xmlswitch.tcl create mode 100644 tcldom.c create mode 100755 tclxml-libxml2.c create mode 100755 tclxml-tcl/sgml-8.0.tcl create mode 100755 tclxml-tcl/sgml-8.1.tcl create mode 100755 tclxml-tcl/sgmlparser.tcl create mode 100755 tclxml-tcl/tclparser-8.0.tcl create mode 100755 tclxml-tcl/tclparser-8.1.tcl create mode 100755 tclxml-tcl/xml-8.0.tcl create mode 100755 tclxml-tcl/xml-8.1.tcl create mode 100644 tclxml-tcl/xml__tcl.tcl create mode 100644 tclxml-tcl/xmldep.tcl create mode 100644 tclxml-tcl/xpath.tcl create mode 100755 tclxml.c create mode 100644 tclxml.decls create mode 100755 tclxmlConfig.sh.in create mode 100644 tclxmlDecls.h create mode 100644 tclxmlStubInit.c create mode 100644 tclxmlStubLib.c create mode 100644 tclxslt-libxslt.c create mode 100644 tclxslt-libxslt.tcl create mode 100644 tclxslt/process.tcl create mode 100644 tclxslt/resources.tcl create mode 100644 tclxslt/tclxslt.tcl create mode 100644 tclxslt/utilities.tcl create mode 100644 tclxslt/xsltcache.tcl create mode 100644 tools/genStubs.tcl create mode 100755 win/build.data create mode 100644 win/makefile.vc create mode 100644 win/mkPkgIndex.tcl create mode 100644 win/nmakehlp.c create mode 100644 win/rules.vc diff --git a/ANNOUNCE b/ANNOUNCE new file mode 100644 index 0000000..52d6437 --- /dev/null +++ b/ANNOUNCE @@ -0,0 +1,21 @@ +TclXML version 3.2 is now available. + +TclXML is a package that provides XML parsing for the Tcl scripting language. +It has two implementations of XML parsers: one written purely in Tcl +and a wrapper for the Gnome libxml2 C library. + +The TclXML package now incorporates the TclDOM and TclXSLT packages. +TclDOM and TclXSLT were previously distributed as separate packages. +The three packages may still be used as if they were standalone. + +Sources, and binaries for Mac OS X and MS Windows, are available now. + +These packages may be downloaded from the TclXML website: + + http://tclxml.sourceforge.net/ + +Enjoy, +Steve Ball +Explain +http://www.explain.com.au/ + diff --git a/ChangeLog b/ChangeLog new file mode 100755 index 0000000..8a52501 --- /dev/null +++ b/ChangeLog @@ -0,0 +1,667 @@ +2008-12-04 Steve Ball + * doc/html.xsl, doc/*.xml: Upgrade to DocBook v5.0. Eliminate + dependency on DocBook XSL stylesheets. + +2008-12-02 Steve Ball + * configure.in, Makefie.in: fix build problems on Linux. + +2008-11-26 Steve Ball + * Makefile.in, tests/*: reorganised tests subdir and merged + tests from all three packages. + +2008-11-20 Steve Ball + * tclxml-tcl/sgmlparser.tcl, tclxml-tcl/tclparser-8.1.tcl: + Surround switch labels in braces (bug fix #812051). + +2008-07-01 Steve Ball + * Merged TclDOM and TclXSLT packages into a single TclXML + package. Reorganised directory structure. Statically link + libxml2 and libxslt libraries to the TclXML shared library. + +2005-12-28 Steve Ball + * Applied patches for TEA build. Patches courtesy Daniel Steffen (steffen@ics.mq.edu.au). + +============== Released version 3.1 04/11/2005 ============== + +2005-11-04 Steve Ball + * libxml2/tcllibxml2.c: Cleaned-up memory leaks, bug #1251711 and patch #1112132. + +2005-05-13 Steve Ball + * libxml2/tcllibxml2.c: Added call to end element handler when element is empty. + +2005-04-20 Steve Ball + * tclxml.c, libxml2/tcllibxml2.c, doc/tclxml.xml: changed interpretation of TCL_CONTINUE return code for external entity command + +2005-03-02 Steve Ball + * libxml2/tcllibxml2.c (TclXMLlibxml2ExternalEntityLoader): externalentitycommand is evaluated and returns xmlParserInputPtr + +2004-10-24 Steve Ball + * win/makefile.vc: Use DLL on Windows + +2004-09-24 Steve Ball + * libxml2/docObj.c (TclXML_libxml2_CreateObjFromDoc): Added Tcl_IncrRefCount (bug fix #1032660, David Welton). + +2004-09-15 Steve Ball + * doc/tclxml.xml: Fixed docn bug (missing xml::parserclass info default) + +2004-09-03 Steve Ball + * win/makefile.vc: Changed link options for zlib-1.2.1. + +2004-08-30 Steve Ball + * libxml2/tcllibxml2.c (Parse): Added support for "-defaultexpandinternalentities" and "-nowhitespace" options. + * tclxml.c: Fixed bug in setting -defaultexpandinternalentities option. + +2004-08-13 Steve Ball + * configure.in: Bumped version to 3.1 + * libxml2/docObj.c: added check for intialization to SetErrorNodeFunc function. + +============== Released version 3.0 11/07/2004 ============== + +2004-07-11 Steve Ball + * libxml2/configure.in: Modified configure help message to match proper usage. + Changed usr/... to /usr/... + * win/makefile.vc: Fixed bug in install target + +============== Released version 3.0b2 26/02/2004 ============== + +2004-02-20 Steve Ball + * libxml2/docObj.c: Fixed bug in error object management. + * tclxml.c: Fixed bug in continue return code handling. + +2004-02-02 Steve Ball + * libxml2/tcllibxml2.c: xmlTextReader interface now uses structured error reporting. + +2004-01-28 Steve Ball + * tclxml.c: Added "-encoding" option. If not utf-8 document text is treated as a byte array (ie. binary data). + * libxml2/tcllibxml2.c: Use xmlTextReader interface. Added "-retainpath", "-retainpathns" options. + +2003-12-17 Steve Ball + * doc/README.xml: Updated Windows build instructions. + * win/makefile.vc: Fixed building with libxml2-2.6.3 binary distro. + +============== Released version 3.0b1 15/12/2003 ============== + +2003-12-15 Steve Ball + * doc/tclxml.xml: Added description of structured error messages. + +2003-12-09 Steve Ball + * LICENSE: Bug #838361: Clarified permission for copying and distribution. + * various: Removed license terms and inserted pointer to LICENSE file. + +2003-12-06 Steve Ball + * tclexpat.c: Patch for bug #846987 + * doc/README.txt: Update for v3.0b1 release + +2003-12-03 Steve Ball + * Makefile.in, libxml2/Makefile.in: Fix TEA build system + +2003-11-03 Steve Ball + * libxml2/docObj.c, libxml2/tcllibxml2.c: Upgraded to SAX2 interfaces. Use structured error reporting. + +2003-09-10 Steve Ball + * win/makefile.vc: Added for building on Windows using MS VS C++ 6.0. + * Various changes for building on Windows. + * libxml2/tcllibxml2.c: Include and remove explicit declaration of libxml2 variable. + +2003-08-24 Steve Ball + * tclexpat.c: Applied patch for bug #714316, fixes attribute list declaration handler. + +2003-08-22 Steve Ball + * Makefile.in: Fixed tests. + * library/sgmlparser.tcl, tclparser-8.1.tcl: Fixed bug #676399 - resolving external entities. + * doc/nroff.xsl: Fixed buggy nroff output, bug #693590. + +2003-08-21 Steve Ball + * library/sgmlparser.tcl: Fixed escaping bug when parsing comments, + check for "xml" anywhere in PI target. + Fixed bug #583947 by removing comments in DTD. + * library/tclparser-*.tcl, sgmlparser.tcl: Added -baseuri option. -baseurl is deprecated. + * tclxml.c: Fix bug parsing args for creating slave entity. + +2003-08-19 Steve Ball + * libxml2/tcllibxml2.c: Fix TEA setup for Linux build. + +2003-08-12 Steve Ball + * tclexpat.c: Updated Configure routine. + * expat/configure.in, expat/Makefile.in: Update for v3.0. + * libxml2/tcllibxml2.h: Fix header file configuration. + * libxml2/configure.in, libxml2/Makefile.in, libxml2/docObj.h: Fix include dir. + +2003-08-07 Steve Ball + * tclxml.c: Added -baseuri option as a synonym for -baseurl. + * libxml2/tcllibxml2.c: Set ::xml::libxml2::libxml2version variable + to the version of libxml2 being used. + +2003-08-04 Steve Ball + * tclxml.c, libxml2/tcllibxml2.c: Fixed instance configuration. + +2003-08-03 Steve Ball + * tests/*: Completed upgrade, test all parser classes. + +2003-07-28 Steve Ball + * tclxml.c: Flush PCDATA when parse terminates. + * libxml2/tcllibxml2.c, docObj.c: Bug fixes. + * tests/*: Upgrade to tcltest v2.2 infrastructure. + +2003-06-29 Steve Ball + * libxml2/docObj.c: Improve C API for use with TclDOM/libxml2 + +2003-06-19 Steve Ball + * tclxml.c, tclexpat.c, libxml2/tcllibxml2.c: Change access to + global/static data to make the extension thread-oblivious. + +2003-06-05 Steve Ball + * libxml2/docObj.c: Initialise hash table. + * libxml2/tcllibxml2.c: Call docObj init routine, + fleshed out callbacks to generic layer. + +2003-05-28 Steve Ball + * libxml2/*: Added libxml2 wrapper. + * Updated v3_0 branch for version 3.0. + +2003-04-04 Andreas Kupries + + * expat/configure: Regenerated. + * tclconfig/tcl.m4: Updated to newest tcl.m4, again. Added + fallback for exec_prefix. + +2003-04-03 Andreas Kupries + + * expat/configure: Regenerated. + * tclconfig/tcl.m4: Updated to the newest version. + +============== Released version 2.6 05/03/2003 ============== + +2003-03-05 Steve Ball + * win/build.data: Version number is taken from installation data. + +2003-03-03 Steve Ball + * install.tcl: removed debugging commands. + +2003-02-07 Steve Ball + * Prepare v2.6 release. + +2003-02-22 Steve Ball + * doc/README.xml: converted README to XML format. Added XSL + stylesheet to create text format file. + +============== Released version 2.5 10/12/2002 ============== + +2002-12-10 Steve Ball + * library/sgmlparser.tcl: Patch for -final option + (ted@ags.ga.erq.sri.com) + +2002-12-06 Steve Ball + * Update for v2.5 release. + * library/sgmlparser.tcl (ParseEvent:ElementOpen): + fixed '>' in attribute value in an empty element, + bug #620034. + +2002-11-01 Andreas Kupries + + * Makefile.in: Removed code of target 'install-doc'. We have no + manpages (.n files), and so the code removes everything in the + mann directory in the installaltion area. + +============== Released version 2.4 31/10/2002 ============== + +2002-10-31 Steve Ball + + * README: Updated installation instructions. + +============== Released version 2.4rc1 29/10/2002 ============== + +2002-10-29 Steve Ball + * install.tcl: Remove '-' from install directory, + fixed UpdateTemplateCopy so that unspecified TEA variables + don't prevent other variables from being substituted. + * configure, library/pkgIndex.tcl.macosx: removed: generated files + or no longer required. + * library/tclparser-8.1.tcl (xml::tclparser::reset): Check if the + parser has been properly initialised. Call create if it hasn't. + +2002-10-28 Andreas Kupries + + * expat/xmlwf/readfilemap.c: Added prototypes missing on windows, + and cast to ensure comparison of compatible types. Required for + Windows debug builds as these use -WX, making warnings into + errors. + +2002-10-25 Andreas Kupries + + * tclxml.c (TclXMLResetParser): Added cast, removed unused variable 'i'. + + * tclxmlStubLib.c (TclXML_InitStubs): Provide un-const'ed version of + 'version' to Tcl_PkgRequireEx to supress warnings. + +2002-10-15 Jeff Hobbs + + * tclconfig/tcl.m4: + * expat/configure: + * expat/configure.in: + * configure: + * configure.in: move the CFLAGS definition into TEA_ENABLE_SHARED + and make it pick up the env CFLAGS at configure time. + +2002-10-15 Andreas Kupries + + * expat/configure.in: + * configure.in: Changed to propagate an initial CFLAGS value to + the final definition. A TEA condition (SHARED_BUILD == 1) + squashed it, causing it the build system to loose the + +DAportable we specify for the AS PA-RISC2.2 build host. This is + a problem for _all_ TEA and TEA 2 based configure files. + +2002-10-15 Steve Ball + + * *.in: Updated version numbers for v2.4. + +2002-10-02 Andreas Kupries + + * Makefile.in ($($(PACKAGE)stub_LIB_FILE)): Corrected explicit + usage of AR. + +2002-09-27 Andreas Kupries + + * expat/configure.in: + * expat/Makefile.in: Added code to pick up the tclxml + configuration and stub library. + + * TclxmlConfig.sh.in: New file. + * configure.in: Added code to generate a config.sh file. This will + be used by the expat module to pick up the tclxml stub library. + +2002-09-26 Andreas Kupries + + * expat/Makefile.in (Tclexpat_SOURCES): Corrected typo. It is + xmltok.c, not .o. D'oh. + + * tclexpat.c (Tclexpat_Init): Added commands to initialize + classinfo->reset and ->resetCmd. Without this trying to create + an expat-based parser will segfault as the generic layer will + jump through uninitialized pointers. Incomplete realization of + the new option -resetcommand. + +2002-09-25 Andreas Kupries + + * expat/Makefile.in: + * expat/configure.in: + * expat/aclocal.m4: Rewritten to use TEA 2 as base of the build + system. This configure/makefile copiles the expat low-level + stuff and the tcl binding in one go, into one library. The + package index is separate from the generic xml layer. + + * Makefile.in: + * configure.in: + * library/pkgIndex.tcl.in: Rewritten to use TEA 2 as base of build + system. Refactoring, taking out generation of tclexpat stuff, + this will go into its own configure/Makefile in the expat + directory => Less of a mess for configuring and compiling the + two packages. + * tools: + * tclconfig: New directories. See above. + * tclxml.h: Removed duplicate of TCL_EXTERN stuff. + +2002-09-19 Steve Ball + + * tclxml.c (TclXMLParserClassCmd): Added -resetcommand to parserclass command. + +2002-09-13 Andreas Kupries + + * Makefile.in ($(TCLXML_LIB_FILE)_OBJECTS): Added stub objects to + link list for main library. Without we get unsatisfied symbols + when trying to load the library. + (tclxmlStubInit.$(OBJEXT)): + (tclxmlStubLib.$(OBJEXT)): Added targets to compile the stub sources. + +2002-09-12 Andreas Kupries + + * configure.in (MINOR_VERSION): Bumped to 3. Full version now + 2.3. Additional changes to make compilation on AIX more robust. + + * Makefile.in: See above, AIX. + +============== Released version 2.3 13/09/2002 ============== + +2002-09-13 Steve Ball + * tclxml.c, tclxml.h, Makefile.in, tclxmlDecls.h, tclxml.decls, tclxmlStubInit.c, tclxmlStubLib.c: Applied patches to improve building from Andreas Kupries and patches from David Gravereaux for stubs. + +2002-09-09 Steve Ball + + * library/sgmlparser.tcl (sgml::tokenise): Patch from bug #596959. + +============== Released version 2.3rc2 07/09/2002 ============== + +2002-09-06 Steve Ball + + * tests/parser.test, library/sgmlparser.tcl, library/tclparser-8.1.tcl: Fixed bug #579264 by implementing -ignorewhitespace option. + * Added check for illegal Unicode characters in PCDATA. + +2002-09-04 Steve Ball + + * library/tclparser-8.1.tcl (xml::tclparser::reset): Added reset function. + + * library/xml__tcl.tcl (xml::ParserCmd): Invoke reset command, rather than just deleting and creating a parser. + +2002-08-30 Steve Ball + + * tclexpat.c: Fixed crash in element decl handler. + +2002-08-28 Steve Ball + + * library/xml-8.1.tcl, library/xml-8.0.tcl: Added definition of XML Namespace URI + +2002-06-28 Mats Bengtsson + + * library/sgmlparser.tcl: fixes for -final 0 bug #413341. + corrected list structure of all -errorcommand callbacks bug #467785. + catch & -code in -elmentendcallback bug #521740. + checks for state(line) instead for state to handle inits for + -final 0 correctly + * library/tclparser-8.1.tcl: fixes for -final 0 bug #413341. + changed xml::tclparse::configure and calls it in xml::tclparse::parse + +2002-06-19 Steve Ball + + * library/xml__tcl.tcl (xml::ParserCmd): free method removes command in caller's namespace. Bug #510418. + +2002-06-17 Steve Ball + + * library/sgmlparser.tcl (sgml::DeProtect1): Applied patch #521642. + +2002-06-14 Steve Ball + + * library/xpath.tcl (xpath::ParseExpr): Fixed bug #568354 - abbreviated node-type test in predicate. + +2002-06-11 Steve Ball + + * library/tclparser-8.1.tcl (xml::tclparser::ParseAttrs): Fixed bug in character entity dereferencing. Bug #546295. + + * library/sgmlparser.tcl (sgml::parseEvent): Applied patch for bug #566452 to fix PIs + +2002-05-27 Andreas Kupries + + * library/sgmlparser.tcl (sgml::Entity): Fixed code defining + 'entities' if not defined, using code in parseEvent] as + template. + + * library/tclparser-8.1.tcl + (xml::tclparser::NormalizeAttValue:DeRef): Fixed the errors in + the calls to [string range] (first two branches of the switch). + + * install.tcl (line 306): args needs no default value of empty. Is + empty as per definition of 'args' when used as last argument. + +2002-05-20 Steve Ball + * install.data, library/sgmlparser.tcl: Fixed bug 513985. + Replaced 'package require tcllib' with 'package require uri'. + * library/sgmlparser.tcl: Fixed bug 495427 (applied suggested patch). + * LICENSE: Added + +2002-02-19 Andreas Kupries + + * Makefile.in (install-lib-binaries): Changed INSTALL_DATA to + INSTALL_PROGRAM to prevent the copy operation from removing the + executable flag for libraries on platforms which do need + it. Like HPUX. + + * tclxml.c (TclXMLCreateParserCmd): Fixed SF TclXML Bug + 513909. The code now handles multiple occurences of "-parser + class" and also takes care to hide them when it comes to the + general configuration during creation. + +2002-02-06 Andreas Kupries + + * tclxml.c (TclXMLConfigureParserInstance): Copied code from + "TclXMLInstanceConfigure" providing the clientdata/instance name + to the parser to configure. This fixes bug 514045. + + * configure: + * configure.in: + * tclxml.m4: Applied patch 508718 to allow building of expat on + Windows. + + * tclxml.h: + * tclexpat.c: + * tclxml.c: Updated to TIP 27 (CONST'ness of string tables for + Tcl_GetIndexFromObj). + +2002-01-27 Steve Ball + + * library/xpath.tcl + Fixed bug in expression parsing. + Reported by Gerard LEDOUBLET. + +2001-11-13 Steve Ball + + * library/sgmlparser.tcl, tests/pcdata.test: + Fixed bug #468029 report by Kenneth Cox. + +2001-11-09 Steve Ball + + * library/sgmlparser.tcl, library/tclparser-8.1.tcl, tests/attribute.test: + Added handling of entity references within an attribute value. + +2001-09-05 Andreas Kupries + + * Makefile.in (GENERIC_SCRIPTS): Added xpath.tcl to the list of + scripts to install. Fixes [458864]. + +2001-08-28 Andreas Kupries + + * tclxml.c (TclXMLInstanceDeleteCmd): Applied the patch fixing SF + Item [456321]. This removes a double free of xmlinfo and also + avoids to access the structure after it was freed. + + * tclxml.c (TclXMLInstanceConfigure): Added a 'Tcl_ResetResult' + before the loop processing the option. This forces the interp + result into a known, unshared state. This also adds Pat Thoyts's + changes to 'instanceConfigureSwitches' declaring some new + '-*command' options and additional argument checks for + 'entityparser'. SF Patch [454204]. + +2001-08-10 Peter Farmer + + * Makefile.in ($(GENERIC_SCRIPTS)): Fixed bugs in earlier + code removed by Andreas and put it back. + +.2001-08-02 Steve Ball + --- Released TclXML 2.1theta --- + +2001-07-31 Andreas Kupries + + * Makefile.in ($(GENERIC_SCRIPTS)): Removed creation of + soft-link. When using a builddirectory below the toplevel + directory the created link is circular and the following cp + operations fails [SF 446485]. + +2001-07-30 Steve Ball + * library/sgmlparser.tcl + Fixed bug #434304: whitespace not accepted in XML Declaration. + Side-effect is to improve WF checking. + * library/sgmlparser.tcl + Fixed bug #431353: entity references plus Tcl specials + +2001-02-26 Peter Farmer + * library/tclparser-8.?.tcl + Added missing arg to pass -final thru to document instance parser + +2001-02-12 Steve Ball + * library/sgmlparser.tcl + * tests/cdata.test, tests/pi.test, tests/decls.test, + * tests/entity.test, tests/doctype.test + Fixed bug #131878: XML test documents not well-formed. + Fixing the tests revealed bugs in the parser. + +2001-02-09 Steve Ball + * library/sgmlparser.tcl, tests/cdata.test + * library/xmldep.tcl + Fixed bug #130127: backslashes in CDATA sections. + Added xmldep package (dependency discovery) + +2001-02-06 Peter Farmer + * install.tcl, install.data, win/build.data, win/install.bat + * library/pkgIndex.tcl.in, library/xml__tcl.tcl, tests/* + _Many_ significant improvements in the installer. Can now + install windows build as well as Unices. Now uses TEA + config files & .in templates, if the build has them, to extract + installation info. Test suite now more portable to new/alternate + versions and can test tcl only parser with other parsers present. + +2001-01-19 Steve Ball + * library/xpath.tcl + Fixed bug in parsing @ abbreviation + +2001-01-17 Steve Ball + --- Released TclXML v2.0theta --- + +2001-01-17 Steve Ball + * install.tcl, install.data + Generalised PF's pure-Tcl installer. It now reads the + installation data from an external file (script). + +2001-01-10 Steve Ball + * library/sgmlparser.tcl, tests/decls.test, tests/entity.test + Fixed bugs in external entity parsing and test suite. + +2000-12-10 Steve Ball + * library/xml-8.1.tcl + Added QName, allWsp + +2000-12-01 Steve Ball + * library/xpath.tcl + Support for parsing and constructing XPath location paths. + Partial initial implementation. + +2000-08-14 Steve Ball + * doc/tclxml.xml, doc/html.xsl, doc/nroff.xsl + Updated doco and added XSL stylesheets to produce + HTML and NROFF output. + +2000-08-01 Steve Ball + * library/sgmlparser.tcl + Added support for XML Namespaces + +2000-07-24 Steve Ball + * library/tclparser-8.1.tcl + Fixed double backslashes in attribute values + +2000-06-15 Steve Ball + * tclxml.*, tclxerces.cpp, tclexpat.c, + library/tclparser-8.1.tcl + Fixed automatic selection of default parser. + Fixed registration and running of Tcl-based + parser classes. + +2000-06-10 Steve Ball + * library/sgmlparser.tcl, tests/*.test + Removed -entityparser option. Minor fixes to test scripts. + +2000-06-01 Steve Ball + * doc/tclxml.xml + Completed documenting xml::parser command. + +2000-05-18 Steve Ball + * tclxml.c, tclxerces.cpp, README, doc/tclxml.xml + Added -validate configuration option. TclXerces sets the + parser object to validate when performing parsing. + Don't have a test, yet. Also updated README and + started documentation (in DocBook). + +2000-04-22 Steve Ball + * library/sgmlparser.tcl, library/tclparser-8.1.tcl, + tests/decls.test + Added support for external entities. + +2000-04-16 Steve Ball + * library/sgmlparser.tcl, library/tclparser-8.1.tcl, + tests/decls.test + Added markup declaration support. Partial implementation. + Also supporting entity substitution. + +2000-04-05 Steve Ball + * Makefile.in, configure.in, library/* + Fixed Tcl-only package setup and installation. + Added Tcl-only parser class framework. + Changed Tcl parser implementation to use new parser class + framework. + +2000-02-10 Steve Ball + + * tclXerces.cpp, tclXercesHandlers.cpp, tclXercesHandlers.hpp. + Added these files. They implement the "xerces" parser class, + providing a wrapper for the Xerces-C (XML4C) XML parser. + +2000-01-23 Steve Ball + + * tclxml.c, tclxml.h: Added these files. These are the entry points + for the tclxml package. They provide a generic front-end for + specific parser class implementations. + + * tclexpat.c: This has been stripped down and is now a back-end + parser class implementation. + +1999-12-27 Steve Ball + + * tclexpat.c: Changed class creation command to xml::parser. + Propagate error code from application callback, + patch from Marshall Rose. Load xml package on initialisation. + Assign unique parser instance command if none given. + + * library/*.tcl, pkgIndex.tcl.in, Makefile.in: + Merged TclXML Tcl scripts into this package. + + * configure.in: Updated to version 2.0 + +1999-12-12 Steve Ball + + * tclexpat.c: Accumulate PCDATA in a string object for a single + call to -characterdatacommand callback, instead of a call for + each line of data. + + * tclexpat.c: Added -ignorewhitespace option. + +1999-09-14 Eric Melski + + * tclexpat.c: In TclExpatAttlistDeclHandler, added a test on attributes + to verify that it doesn't point to nothing (ie, a null attlist decl). This + addresses bug 2831. + +1999-09-14 Eric Melski + + * tclexpat.c: Added support for several new callbacks: + attlistdecl, elementdecl, {start|end}doctypedecl. Fixed support + for external entity parsing by adding a subcommand (entityparser) + to the "instance" command, which allows creation of an external entity + parser. Some minor fixes like removing unused variables. Added a + "free" command to the instance command, which allows user + initiated freeing of the parser (required for external entity + parsing to function properly). + Fixed a compiler warning about const char * and assigning it to a + char *. + +1999-08-24 Scott Stanton + + * tclexpat.c: Changed to avoid generating errors on non-standalone + documents when no handler is defined. + +1999-08-20 Scott Stanton + + * tclexpat.c: Various lint. Changed to automatically export + public symbols. + + * configure.in: Bumped version number to 1.1 + + * Makefile.in: Various changes to support Windows builds. + +1999-08-17 Scott Stanton + + * tclexpat.c: added TCL_STORAGE_CLASS macros to automatically + export the _Init symbol. + +1999-08-11 Scott Stanton + + * tclexpat.c: Changed to use Tcl stubs. Fixed various + bugs. Eliminated conditional code for old pre-release versions of + 8.1. + diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..eb6729c --- /dev/null +++ b/LICENSE @@ -0,0 +1,35 @@ +Copyright (c) 2005 Explain +http://www.explain.com.au/ + +Explain makes this software available free of charge for any purpose. +This software may be copied, and distributed, with or without +modifications; but this notice must be included on any copy. + +The software was developed for research purposes only and Explain does not +warrant that it is error free or fit for any purpose. Explain disclaims any +liability for all claims, expenses, losses, damages and costs any user may +incur as a result of using, copying or modifying this software. + +Copyright (c) 1998-2004 Zveno Pty Ltd +http://www.zveno.com/ + +Zveno makes this software available free of charge for any purpose. +This software may be copied, and distributed, with or without +modifications; but this notice must be included on any copy. + +The software was developed for research purposes only and Zveno does not +warrant that it is error free or fit for any purpose. Zveno disclaims any +liability for all claims, expenses, losses, damages and costs any user may +incur as a result of using, copying or modifying this software. + +Copyright (c) 1997 ANU and CSIRO on behalf of the +participants in the CRC for Advanced Computational Systems ('ACSys'). + +ACSys makes this software and all associated data and documentation +('Software') available free of charge for any purpose. You may make copies +of the Software but you must include all of this notice on any copy. + +The Software was developed for research purposes and ACSys does not warrant +that it is error free or fit for any purpose. ACSys disclaims any +liability for all claims, expenses, losses, damages and costs any user may +incur as a result of using, copying or modifying the Software. diff --git a/Makefile.in b/Makefile.in new file mode 100644 index 0000000..adb2125 --- /dev/null +++ b/Makefile.in @@ -0,0 +1,459 @@ +# Makefile.in -- +# +# This file is a Makefile for Sample TEA Extension. If it has the name +# "Makefile.in" then it is a template for a Makefile; to generate the +# actual Makefile, run "./configure", which is a configuration script +# generated by the "autoconf" program (constructs like "@foo@" will get +# replaced in the actual Makefile. +# +# Copyright (c) 1999 Scriptics Corporation. +# Copyright (c) 2002-2005 ActiveState Corporation. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. + +#======================================================================== +# Add additional lines to handle any additional AC_SUBST cases that +# have been added in a customized configure script. +#======================================================================== + +#SAMPLE_NEW_VAR = @SAMPLE_NEW_VAR@ + +#======================================================================== +# Nothing of the variables below this line should need to be changed. +# Please check the TARGETS section below to make sure the make targets +# are correct. +#======================================================================== + +#======================================================================== +# The names of the source files is defined in the configure script. +# The object files are used for linking into the final library. +# This will be used when a dist target is added to the Makefile. +# It is not important to specify the directory, as long as it is the +# $(srcdir) or in the generic, win or unix subdirectory. +#======================================================================== + +PKG_SOURCES = @PKG_SOURCES@ +PKG_OBJECTS = @PKG_OBJECTS@ + +PKG_STUB_SOURCES = @PKG_STUB_SOURCES@ +PKG_STUB_OBJECTS = @PKG_STUB_OBJECTS@ + +#======================================================================== +# PKG_TCL_SOURCES identifies Tcl runtime files that are associated with +# this package that need to be installed, if any. +#======================================================================== + +PKG_TCL_SOURCES = @PKG_TCL_SOURCES@ + +#======================================================================== +# This is a list of public header files to be installed, if any. +#======================================================================== + +PKG_HEADERS = @PKG_HEADERS@ + +#======================================================================== +# "PKG_LIB_FILE" refers to the library (dynamic or static as per +# configuration options) composed of the named objects. +#======================================================================== + +PKG_LIB_FILE = @PKG_LIB_FILE@ +PKG_STUB_LIB_FILE = @PKG_STUB_LIB_FILE@ + +lib_BINARIES = $(PKG_LIB_FILE) +BINARIES = $(lib_BINARIES) + +SHELL = @SHELL@ + +srcdir = @srcdir@ +prefix = @prefix@ +exec_prefix = @exec_prefix@ + +bindir = @bindir@ +libdir = @libdir@ +includedir = @includedir@ +datarootdir = @datarootdir@ +datadir = @datadir@ +mandir = @mandir@ + +DESTDIR = + +PKG_DIR = $(PACKAGE_NAME)$(PACKAGE_VERSION) +pkgdatadir = $(datadir)/$(PKG_DIR) +pkglibdir = $(libdir)/$(PKG_DIR) +pkgincludedir = $(includedir)/$(PKG_DIR) + +top_builddir = @abs_top_builddir@ + +INSTALL_OPTIONS = +INSTALL = @INSTALL@ $(INSTALL_OPTIONS) +INSTALL_DATA_DIR = ${INSTALL} -d -m 755 +INSTALL_DATA = @INSTALL_DATA@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ +INSTALL_SCRIPT = @INSTALL_SCRIPT@ +INSTALL_LIBRARY = ${INSTALL_DATA} + +PACKAGE_NAME = @PACKAGE_NAME@ +PACKAGE_VERSION = @PACKAGE_VERSION@ +CC = @CC@ +CFLAGS_DEFAULT = @CFLAGS_DEFAULT@ +CFLAGS_WARNING = @CFLAGS_WARNING@ +EXEEXT = @EXEEXT@ +LDFLAGS_DEFAULT = @LDFLAGS_DEFAULT@ +MAKE_LIB = @MAKE_LIB@ +MAKE_SHARED_LIB = @MAKE_SHARED_LIB@ +MAKE_STATIC_LIB = @MAKE_STATIC_LIB@ +MAKE_STUB_LIB = @MAKE_STUB_LIB@ +OBJEXT = @OBJEXT@ +RANLIB = @RANLIB@ +RANLIB_STUB = @RANLIB_STUB@ +SHLIB_CFLAGS = @SHLIB_CFLAGS@ +SHLIB_LD = @SHLIB_LD@ +SHLIB_LD_LIBS = @SHLIB_LD_LIBS@ +STLIB_LD = @STLIB_LD@ +#TCL_DEFS = @TCL_DEFS@ +TCL_BIN_DIR = @TCL_BIN_DIR@ +TCL_SRC_DIR = @TCL_SRC_DIR@ +#TK_BIN_DIR = @TK_BIN_DIR@ +#TK_SRC_DIR = @TK_SRC_DIR@ + +# Not used, but retained for reference of what libs Tcl required +#TCL_LIBS = @TCL_LIBS@ + +#======================================================================== +# TCLLIBPATH seeds the auto_path in Tcl's init.tcl so we can test our +# package without installing. The other environment variables allow us +# to test against an uninstalled Tcl. Add special env vars that you +# require for testing here (like TCLX_LIBRARY). +#======================================================================== + +EXTRA_PATH = $(top_builddir):$(TCL_BIN_DIR) +#EXTRA_PATH = $(top_builddir):$(TCL_BIN_DIR):$(TK_BIN_DIR) +TCLLIBPATH = $(top_builddir) +TCLSH_ENV = TCL_LIBRARY=`@CYGPATH@ $(TCL_SRC_DIR)/library` +PKG_ENV = @LD_LIBRARY_PATH_VAR@="$(EXTRA_PATH):$(@LD_LIBRARY_PATH_VAR@)" \ + PATH="$(EXTRA_PATH):$(PATH)" \ + TCLLIBPATH="$(TCLLIBPATH)" + +TCLSH_PROG = @TCLSH_PROG@ +TCLSH = $(TCLSH_ENV) $(PKG_ENV) $(TCLSH_PROG) + +#WISH_ENV = TK_LIBRARY=`@CYGPATH@ $(TK_SRC_DIR)/library` +#WISH_PROG = @WISH_PROG@ +#WISH = $(TCLSH_ENV) $(WISH_ENV) $(PKG_ENV) $(WISH_PROG) + +SHARED_BUILD = @SHARED_BUILD@ + +INCLUDES = @PKG_INCLUDES@ @TCL_INCLUDES@ +#INCLUDES = @PKG_INCLUDES@ @TCL_INCLUDES@ @TK_INCLUDES@ @TK_XINCLUDES@ + +PKG_CFLAGS = @PKG_CFLAGS@ + +# TCL_DEFS is not strictly need here, but if you remove it, then you +# must make sure that configure.ac checks for the necessary components +# that your library may use. TCL_DEFS can actually be a problem if +# you do not compile with a similar machine setup as the Tcl core was +# compiled with. +#DEFS = $(TCL_DEFS) @DEFS@ $(PKG_CFLAGS) +DEFS = @DEFS@ $(PKG_CFLAGS) + +# Move pkgIndex.tcl to 'BINARIES' var if it is generated in the Makefile +CONFIG_CLEAN_FILES = Makefile pkgIndex.tcl +CLEANFILES = @CLEANFILES@ + +CPPFLAGS = @CPPFLAGS@ +LIBS = @PKG_LIBS@ @LIBS@ +AR = @AR@ +CFLAGS = @CFLAGS@ +COMPILE = $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) \ + $(CFLAGS_DEFAULT) $(CFLAGS_WARNING) $(SHLIB_CFLAGS) $(CFLAGS) + +GDB = gdb +VALGRIND = valgrind +VALGRINDARGS = --tool=memcheck --num-callers=8 --leak-resolution=high \ + --leak-check=yes --show-reachable=yes -v + +.SUFFIXES: .c .$(OBJEXT) + +#======================================================================== +# Start of user-definable TARGETS section +#======================================================================== + +#======================================================================== +# TEA TARGETS. Please note that the "libraries:" target refers to platform +# independent files, and the "binaries:" target includes executable programs and +# platform-dependent libraries. Modify these targets so that they install +# the various pieces of your package. The make and install rules +# for the BINARIES that you specified above have already been done. +#======================================================================== + +all: binaries libraries #doc + +#======================================================================== +# The binaries target builds executable programs, Windows .dll's, unix +# shared/static libraries, and any other platform-dependent files. +# The list of targets to build for "binaries:" is specified at the top +# of the Makefile, in the "BINARIES" variable. +#======================================================================== + +binaries: $(BINARIES) + +libraries: + +#======================================================================== +# Your doc target should differentiate from doc builds (by the developer) +# and doc installs (see install-doc), which just install the docs on the +# end user machine when building from source. +#======================================================================== + +doc: + @echo "If you have documentation to create, place the commands to" + @echo "build the docs in the 'doc:' target. For example:" + @echo " xml2nroff sample.xml > sample.n" + @echo " xml2html sample.xml > sample.html" + +install: all install-binaries install-libraries #install-doc + +install-binaries: binaries install-lib-binaries install-bin-binaries + +#======================================================================== +# This rule installs platform-independent files, such as header files. +# The list=...; for p in $$list handles the empty list case x-platform. +#======================================================================== + +install-libraries: libraries + @$(INSTALL_DATA_DIR) $(DESTDIR)$(includedir) + @echo "Installing header files in $(DESTDIR)$(includedir)" + @list='$(PKG_HEADERS)'; for i in $$list; do \ + echo "Installing $(srcdir)/$$i" ; \ + $(INSTALL_DATA) $(srcdir)/$$i $(DESTDIR)$(includedir) ; \ + done; + +#======================================================================== +# Install documentation. Unix manpages should go in the $(mandir) +# directory. +#======================================================================== + +install-doc: doc + @$(INSTALL_DATA_DIR) $(DESTDIR)$(mandir)/mann + @echo "Installing documentation in $(DESTDIR)$(mandir)" + @list='$(srcdir)/doc/*.n'; for i in $$list; do \ + echo "Installing $$i"; \ + $(INSTALL_DATA) $$i $(DESTDIR)$(mandir)/mann ; \ + done + +test: binaries libraries + $(TCLSH) `@CYGPATH@ $(srcdir)/tests/all.tcl` $(TESTFLAGS) \ + -load "package ifneeded $(PACKAGE_NAME) $(PACKAGE_VERSION) \ + [list load `@CYGPATH@ $(PKG_LIB_FILE)` $(PACKAGE_NAME)]" + +shell: binaries libraries + @$(TCLSH) $(SCRIPT) + +gdb: + $(TCLSH_ENV) $(PKG_ENV) $(GDB) $(TCLSH_PROG) $(SCRIPT) + +gdb-test: binaries libraries + $(TCLSH_ENV) $(PKG_ENV) $(GDB) \ + --args $(TCLSH_PROG) `@CYGPATH@ $(srcdir)/tests/all.tcl` \ + $(TESTFLAGS) -singleproc 1 \ + -load "package ifneeded $(PACKAGE_NAME) $(PACKAGE_VERSION) \ + [list load `@CYGPATH@ $(PKG_LIB_FILE)` $(PACKAGE_NAME)]" + +valgrind: binaries libraries + $(TCLSH_ENV) $(PKG_ENV) $(VALGRIND) $(VALGRINDARGS) $(TCLSH_PROG) \ + `@CYGPATH@ $(srcdir)/tests/all.tcl` $(TESTFLAGS) + +valgrindshell: binaries libraries + $(TCLSH_ENV) $(PKG_ENV) $(VALGRIND) $(VALGRINDARGS) $(TCLSH_PROG) $(SCRIPT) + +depend: + +#======================================================================== +# $(PKG_LIB_FILE) should be listed as part of the BINARIES variable +# mentioned above. That will ensure that this target is built when you +# run "make binaries". +# +# The $(PKG_OBJECTS) objects are created and linked into the final +# library. In most cases these object files will correspond to the +# source files above. +#======================================================================== + +$(PKG_LIB_FILE): $(PKG_OBJECTS) + -rm -f $(PKG_LIB_FILE) + ${MAKE_LIB} + $(RANLIB) $(PKG_LIB_FILE) + +$(PKG_STUB_LIB_FILE): $(PKG_STUB_OBJECTS) + -rm -f $(PKG_STUB_LIB_FILE) + ${MAKE_STUB_LIB} + $(RANLIB_STUB) $(PKG_STUB_LIB_FILE) + +#======================================================================== +# We need to enumerate the list of .c to .o lines here. +# +# In the following lines, $(srcdir) refers to the toplevel directory +# containing your extension. If your sources are in a subdirectory, +# you will have to modify the paths to reflect this: +# +# sample.$(OBJEXT): $(srcdir)/generic/sample.c +# $(COMPILE) -c `@CYGPATH@ $(srcdir)/generic/sample.c` -o $@ +# +# Setting the VPATH variable to a list of paths will cause the makefile +# to look into these paths when resolving .c to .obj dependencies. +# As necessary, add $(srcdir):$(srcdir)/compat:.... +#======================================================================== + +VPATH = $(srcdir):$(srcdir)/generic:$(srcdir)/unix:$(srcdir)/win:$(srcdir)/macosx + +.c.@OBJEXT@: + $(COMPILE) -c `@CYGPATH@ $<` -o $@ + +#======================================================================== +# Distribution creation +# You may need to tweak this target to make it work correctly. +#======================================================================== + +#COMPRESS = tar cvf $(PKG_DIR).tar $(PKG_DIR); compress $(PKG_DIR).tar +COMPRESS = tar zcvf $(PKG_DIR).tar.gz $(PKG_DIR) +DIST_ROOT = /tmp/dist +DIST_DIR = $(DIST_ROOT)/$(PKG_DIR) + +DIST_INSTALL_DATA = CPPROG='cp -p' $(INSTALL) -m 644 +DIST_INSTALL_SCRIPT = CPPROG='cp -p' $(INSTALL) -m 755 + +dist-clean: + rm -rf $(DIST_DIR) $(DIST_ROOT)/$(PKG_DIR).tar.* + +dist: dist-clean + $(INSTALL_DATA_DIR) $(DIST_DIR) + + # TEA files + $(DIST_INSTALL_DATA) $(srcdir)/Makefile.in \ + $(srcdir)/aclocal.m4 $(srcdir)/configure.ac \ + $(DIST_DIR)/ + $(DIST_INSTALL_SCRIPT) $(srcdir)/configure $(DIST_DIR)/ + + $(INSTALL_DATA_DIR) $(DIST_DIR)/tclconfig + $(DIST_INSTALL_DATA) $(srcdir)/tclconfig/README.txt \ + $(srcdir)/tclconfig/tcl.m4 $(srcdir)/tclconfig/install-sh \ + $(DIST_DIR)/tclconfig/ + + # Extension files + $(DIST_INSTALL_DATA) \ + $(srcdir)/ChangeLog \ + $(srcdir)/README.sha \ + $(srcdir)/license.terms \ + $(srcdir)/README \ + $(srcdir)/pkgIndex.tcl.in \ + $(DIST_DIR)/ + + list='demos doc generic library mac tests unix win'; \ + for p in $$list; do \ + if test -d $(srcdir)/$$p ; then \ + $(INSTALL_DATA_DIR) $(DIST_DIR)/$$p; \ + $(DIST_INSTALL_DATA) $(srcdir)/$$p/* $(DIST_DIR)/$$p/; \ + fi; \ + done + + (cd $(DIST_ROOT); $(COMPRESS);) + +#======================================================================== +# End of user-definable section +#======================================================================== + +#======================================================================== +# Don't modify the file to clean here. Instead, set the "CLEANFILES" +# variable in configure.ac +#======================================================================== + +clean: + -test -z "$(BINARIES)" || rm -f $(BINARIES) + -rm -f *.$(OBJEXT) core *.core + -test -z "$(CLEANFILES)" || rm -f $(CLEANFILES) + +distclean: clean + -rm -f *.tab.c + -rm -f $(CONFIG_CLEAN_FILES) + -rm -f config.cache config.log config.status + +#======================================================================== +# Install binary object libraries. On Windows this includes both .dll and +# .lib files. Because the .lib files are not explicitly listed anywhere, +# we need to deduce their existence from the .dll file of the same name. +# Library files go into the lib directory. +# In addition, this will generate the pkgIndex.tcl +# file in the install location (assuming it can find a usable tclsh shell) +# +# You should not have to modify this target. +#======================================================================== + +install-lib-binaries: binaries + @$(INSTALL_DATA_DIR) $(DESTDIR)$(pkglibdir) + @list='$(lib_BINARIES)'; for p in $$list; do \ + if test -f $$p; then \ + echo " $(INSTALL_LIBRARY) $$p $(DESTDIR)$(pkglibdir)/$$p"; \ + $(INSTALL_LIBRARY) $$p $(DESTDIR)$(pkglibdir)/$$p; \ + ext=`echo $$p|sed -e "s/.*\.//"`; \ + if test "x$$ext" = "xdll"; then \ + lib=`basename $$p|sed -e 's/.[^.]*$$//'`.lib; \ + if test -f $$lib; then \ + echo " $(INSTALL_DATA) $$lib $(DESTDIR)$(pkglibdir)/$$lib"; \ + $(INSTALL_DATA) $$lib $(DESTDIR)$(pkglibdir)/$$lib; \ + fi; \ + fi; \ + fi; \ + done + @list='$(PKG_TCL_SOURCES)'; for p in $$list; do \ + if test -f $(srcdir)/$$p; then \ + destp=`basename $$p`; \ + echo " Install $$destp $(DESTDIR)$(pkglibdir)/$$destp"; \ + $(INSTALL_DATA) $(srcdir)/$$p $(DESTDIR)$(pkglibdir)/$$destp; \ + fi; \ + done + @if test "x$(SHARED_BUILD)" = "x1"; then \ + echo " Install pkgIndex.tcl $(DESTDIR)$(pkglibdir)"; \ + $(INSTALL_DATA) pkgIndex.tcl $(DESTDIR)$(pkglibdir); \ + fi + $(INSTALL_DATA) tclxmlConfig.sh $(DESTDIR)$(libdir) + +#======================================================================== +# Install binary executables (e.g. .exe files and dependent .dll files) +# This is for files that must go in the bin directory (located next to +# wish and tclsh), like dependent .dll files on Windows. +# +# You should not have to modify this target, except to define bin_BINARIES +# above if necessary. +#======================================================================== + +install-bin-binaries: binaries + @$(INSTALL_DATA_DIR) $(DESTDIR)$(bindir) + @list='$(bin_BINARIES)'; for p in $$list; do \ + if test -f $$p; then \ + echo " $(INSTALL_PROGRAM) $$p $(DESTDIR)$(bindir)/$$p"; \ + $(INSTALL_PROGRAM) $$p $(DESTDIR)$(bindir)/$$p; \ + fi; \ + done + +Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status + cd $(top_builddir) \ + && CONFIG_FILES=$@ CONFIG_HEADERS= $(SHELL) ./config.status + +uninstall-binaries: + list='$(lib_BINARIES)'; for p in $$list; do \ + rm -f $(DESTDIR)$(pkglibdir)/$$p; \ + done + list='$(PKG_TCL_SOURCES)'; for p in $$list; do \ + p=`basename $$p`; \ + rm -f $(DESTDIR)$(pkglibdir)/$$p; \ + done + list='$(bin_BINARIES)'; for p in $$list; do \ + rm -f $(DESTDIR)$(bindir)/$$p; \ + done + +.PHONY: all binaries clean depend distclean doc install libraries test +.PHONY: gdb gdb-test valgrind valgrindshell + +# Tell versions [3.59,3.63) of GNU make to not export all variables. +# Otherwise a system limit (for SysV at least) may be exceeded. +.NOEXPORT: diff --git a/README.html b/README.html new file mode 100644 index 0000000..a745a13 --- /dev/null +++ b/README.html @@ -0,0 +1,280 @@ + + + +XML Support For Tcl + + +
+

XML Support For Tcl

+

TclXML, TclDOM and TclXSLT

+

Contents

+ +

TclXML, TclDOM and TclXSLT

+

This package provides XML parsers, DOM scripting and XSL Transformations for Tcl. In previous distributions, these features were supplied as separate packages. Now they have been combined into a single package to make installation easier.

+

Contact Steve Ball for information about this release.

+
+

+TclXML

+

TclXML provides a streaming parser for XML documents. This is the lowest-level interface for processing XML documents in Tcl. The package has a generic front-end interface with plugin parser implementations. A number of parser implementations or wrappers are provided:

+
    +

  • Gnome libxml2 library. This package is known as TclXML/libxml2.

    • +

  • A generic Tcl implementation (which does not require compilation). This package is known as TclXML/tcl.

    • +
+

Both of these implementations may be installed at the same time. See the manual page for more information.

+
+
+

+TclDOM

+

TclDOM provides a tree view for XML documents. This is usually the best interface for scripting XML documents using Tcl. The package has two implementations:

+
    +

  • Gnome libxml2 library. This package is known as TclDOM/libxml2.

    • +

  • A generic Tcl implementation (which does not require compilation). This package is known as TclDOM/tcl.

    • +
+

Only one of these will be installed.

+

See the manual page for more information.

+
+
+

+TclXSLT

+

TclXSLT provides a method to invoke XSL Transformations upon XML documents. This package is a wrapper for the libxslt library.

+

See the manual page for more information.

+
+
+

+Installation

+
+

+Dependencies

+
+Tcllib
+

http://www.tcl.tk/software/tcllib/

+

In order for the Tcl-only parser to resolve external entities, the tcllib package must be installed.

+

Be sure to get a version which includes the uri package. Version 1.11 or better is recommended.

+ +

The latest CVS snapshot may be found at the SourceForge project page.

+
+libxml2
+

libxml2 is required for the compiled version of the TclXML/libxml2 package. libiconv may also be required.

+

The source code for libxml2 and libiconv is not supplied with this package. Download libxml2 from xmlsoft.org separately. libiconv may also be required; download from a GNU mirror site.

+

Version 2.7.2 (or better) is recommended.

+
+
+
+
+

+Pure-Tcl Installation

+

no compilation required

+

Run the configure script and invoke the command:

+
make install
+

If the pure-Tcl parser is good enough for you, then read no further.

+
+
+

+Compiled Installation

+
+
+Unix/Linux
+

You must have Tcl/Tk version 8.2 or better installed on your system. Tcl/Tk 8.3 or better is recommended.

+
    +

  1. Make sure you have Tcllib 1.11 (or better) installed. Tcllib is still required, even for the compiled parser.

    2. +

  2. If you wish to use TclXML/libxml2, make sure libxml2-2.7.2 (or better) is installed.

    3. +

  3. Unpack the TclXML distribution and cd into the tclxml-3.2 directory.

    4. +
  4. +

    Run the configure script, with the --prefix and --enable-threads switches (the latter only if Tcl has been built with threads enabled). Use the --with-xml2-config switch to specify the location of the libxml2 configuration script, xml2Conf.sh. Similarly, use the --with-xslt-config if necessary.

    +

    TclXML/libxml2 may be configured to statically link the libxml2 and libxslt libraries to the libtclxml.so shared library. This is advantageous when using TclXML/libxml2 in a StarKit. To statically link the libraries use the --with-xml-static switch.

    +

    For example, on my system I have Tcl 8.5 installed in /usr/local/tcl8.5 and libxm2 installed in /usr/local/gnome. I also need to statically link the libraries. Therefore I would use the command:

    +
    ./configure --prefix=/usr/local/tcl8.5 --enable-threads --with-xml2-config=/usr/local/gnome/bin/xml2Conf.sh --with-xml-static=1
    +
    5. +
  5. make
    6. +
  6. Don't test the package using make test until all of the packages are installed (it is a current deficiency of the build system that the package cannot be tested before installation - we hope to fix this soon!).
    7. +
  7. +
    make install
    +

    You may need to do this as root, depending on your installation.

    +
    8. +
  8. make test
    9. +
  9. make doc
    10. +
  10. make install-doc
    11. +
+
+
+
+Windows (MSYS/MINGW)
+
[Advice: ActiveTcl includes binaries for TclXML.]
+

You must have Tcl/Tk version 8.2 or better installed on your system. Tcl/Tk 8.5.5 or better is recommended.

+

Before starting, download the binaries for libxml2 (or build them from source). xmlsoft has a link to the MS Windows binary distribution.

+

If you have a TEA build environment setup, just use the normal configure/make/make install pattern.

+
+
+
+Windows (NMAKE/VC++ 6.0)
+
TclXML/libxml2 is built with MSYS/MINGW, see above, so this build system is untested.
+

Alternatively, the win subdirectory contains a makefile.vc file for Visual Studio C++ v6.0. In a Command Prompt window set up your environment so that nmake is on the path (by running VCVARS32.BAT), then type the following:

+
nmake -f makefile.vc TCLDIR=C:\Path\To\Tcl INSTALLDIR=C:\Path\To\Tcl LIBZDIR=C:\Path\To\libz LIBICONVDIR=C:\Path\To\libiconv LIBXML2DIR=C:\Path\To\libxml2 LIBXSLTDIR=C:\Path\To\libxslt
+

As an example, on my system I have Tcl installed in C:\Tcl and the libxml2 and libxslt binaries unpacked in the directory C:\gnome. Accordingly, I would use the following command line:

+
nmake -f makefile.vc TCLDIR=C:\Tcl INSTALLDIR=C:\Tcl LIBZDIR=C:\gnome\zlib-1.1.4.win32 LIBICONVDIR=C:\gnome\libiconv-1.9.1.win32 LIBXML2DIR=C:\gnome\libxml2-2.7.2.win32 LIBXSLTDIR=C:\gnome\libxslt-1.1.24.win32
+

Install the package by appending 'install' to the command line used above, for example:

+
nmake -f makefile.vc TCLDIR=C:\Path\To\Tcl INSTALLDIR=C:\Path\To\Tcl LIBZDIR=C:\Path\To\libz LIBICONVDIR=C:\Path\To\libiconv LIBXML2DIR=C:\Path\To\libxml2 LIBXSLTDIR=C:\Path\To\libxslt install
+
+
+
+Macintosh OS X
+
Binary distributions of libxml2, libxslt and TclXML as frameworks are provided by Explain.
+

There are two ways to build TclXML under Mac OS X:

+
    +

  1. The usual Unix way, see above.

    2. +

  2. As an embedded Framework using Xcode.

    3. +
+

The macosx directory contains the Xcode files for building under OS X (Leopard/Panther). TclXML/libxml2 has been tested on OS X 10.5 (or is that X.5?).

+

Start-up the project. Make sure that the references to the libxml2 and Tcl external frameworks are correct. Select the 'Make' target and build. This builds everything. The result is two Mac OS X Frameworks; a "normal" and an "embedded". The embedded framework will be in the embedded subdirectory of the Build Products directory. Copy tclxml.framework to any of the usual places for frameworks (~/Library/Frameworks, /Library/Frameworks, etc).

+

For earlier version of OS X using Project Builder, you will have to retrieve a previous version of the Project Builder files from the CVS repository.

+
+
+
+
+

+Usage

+

See the website for links to tutorials and the reference manual.

+

In the meantime, here's a quick tutorial:

+
+

+Parsing XML, Streaming

+

This is the lowest-level access to an XML document; use SAX-like events to stream through the document. The simple program below counts the number of characters in the content of an XML document.

+
+package require xml 3.2
+
+set parser [xml::parser]
+$parser configure -elementstartcommand EStart \
+    -characterdatacommand PCData
+
+proc EStart {tag attlist args} {
+    array set attr $attlist
+    puts "Element \"$tag\" started with [array size attr] attributes"
+}
+
+proc PCData text {
+    incr ::count [string length $text]
+}
+
+set count 0
+$parser parse [read stdin]
+
+puts "The document contains $count characters"
+exit 0
+
+
+
+

+Parsing XML with DOM

+

This is the next level up in accessing an XML document; use the Document Object Model (DOM) to view the XML document as a tree. The simple program below counts the number of characters in the content of an XML document.

+
+package require xml 3.2
+
+set doc [dom::parse [read stdin]]
+set count 0
+foreach textNode [dom::selectNode $doc //text()] {
+    incr count [string length [$textNode cget -nodeValue]]
+}
+
+puts "The document contains $count characters"
+
+
+
+

+Transforming XML with XSLT

+

This is the highest level in processing an XML document; use a XSL stylesheet to transform a XML document. The simple program below reads two XML documents, compiles one into a XSL stylesheet and performs the transformation.

+
+package require xml 3.2
+
+set chan [open "count.xsl"]
+set styleDoc [dom::parse [read $chan]]
+close $chan
+set sourceDoc [dom::parse [read stdin]]
+
+set style [xslt::compile $styleDoc]
+set resultDoc [$style transform $sourceDoc]
+
+puts [dom::serialize $resultDoc]
+
+

The XSL stylesheet count.xsl, which counts the number of characters in the source document, looks like this:

+
+<xsl:stylesheet version='1.0'
+  xmlns:xsl='http://www.w3.org/1999/XSL/Transform'>
+
+  <xsl:template match='/'>
+    <xsl:text>The document contains </xsl:text>
+    <xsl:call-template name='add'>
+      <xsl:with-param name='nodes' select='//text()'/>
+    </xsl:call-template>
+    <xsl:text> characters.
+</xsl:text>
+  </xsl:template>
+
+  <xsl:template name='add'>
+    <xsl:param name='sum' select='0'/>
+    <xsl:param name='nodes' select='/..'/>
+
+    <xsl:choose>
+      <xsl:when test='not($nodes)'>
+        <xsl:value-of select='$sum'/>
+      </xsl:when>
+      <xsl:otherwise>
+        <xsl:call-template name='add'>
+          <xsl:with-param name='sum'
+            select='$sum + string-length($nodes[1])'/>
+          <xsl:with-param name='nodes'
+            select='$nodes[position() != 1]'/>
+        </xsl:call-template>
+      </xsl:otherwise>
+    </xsl:choose>
+  </xsl:template>
+</xsl:stylesheet>
+
+
+
+
+

+XPath

+

In addition to XML parsing packages, TclXML also provides a package for parsing XPath location paths. The XPath package only parsing the path's syntax, it does interpret the path. See TclDOM for a package that will interpret XPath location paths.

+
This package is in its infancy, and does not support the full range of XPath features. Only a very limited subset of location paths are supported, of the form "/simple/example[2]". Paths within predicates will definitely fail.
+

To use the XPath package:

+
+package require xpath
+
+

To parse a location path:

+
+xpath::split {/simple/example}
+
+

This returns a Tcl list, each element of which is a three element sublist: {axis node-test {?predicate ...?}}.

+
+
+ + diff --git a/README.md b/README.md new file mode 100644 index 0000000..7419da1 --- /dev/null +++ b/README.md @@ -0,0 +1,356 @@ +### TclXML, TclDOM and TclXSLT + +Contents +-------- + +- [TclXML](#id18498) +- [TclDOM](#id18546) +- [TclXSLT](#id18594) +- [Installation](#id18619) + - [Dependencies](#id18633) + - [Pure-Tcl Installation](#id18747) + - [Compiled Installation](#id18776) + - [Unix/Linux](#id18786) + - [Windows (MSYS/MINGW)](#id18948) + - [Windows (NMAKE/VC++ 6.0)](#id18987) + - [Macintosh OS X](#id19109) +- [Usage](#id19193) + - [Parsing XML, Streaming](#id19216) + - [Parsing XML with DOM](#id19244) + - [Transforming XML with XSLT](#id19268) +- [XPath](#id19306) + +### TclXML, TclDOM and TclXSLT + +This package provides XML parsers, DOM scripting and XSL Transformations +for [Tcl](http://www.tcl.tk). In previous distributions, these features +were supplied as separate packages. Now they have been combined into a +single package to make installation easier. + +Contact [Steve Ball](mailto:Steve.Ball@explain.com.au) for information +about this release. + +### TclXML + +TclXML provides a streaming parser for XML documents. This is the +lowest-level interface for processing XML documents in Tcl. The package +has a generic front-end interface with plugin parser implementations. A +number of parser implementations or wrappers are provided: + +- Gnome libxml2 library. This package is known as TclXML/libxml2. + +- A generic Tcl implementation (which does not require compilation). + This package is known as TclXML/tcl. + +Both of these implementations may be installed at the same time. See +[the manual page](doc/tclxml.html) for more information. + +### TclDOM + +TclDOM provides a tree view for XML documents. This is usually the best +interface for scripting XML documents using Tcl. The package has two +implementations: + +- Gnome libxml2 library. This package is known as TclDOM/libxml2. + +- A generic Tcl implementation (which does not require compilation). + This package is known as TclDOM/tcl. + +Only one of these will be installed. + +See [the manual page](doc/tcldom.html) for more information. + +### TclXSLT + +TclXSLT provides a method to invoke XSL Transformations upon XML +documents. This package is a wrapper for the libxslt library. + +See [the manual page](doc/tclxslt.html) for more information. + +### Installation + +#### Dependencies + +Tcllib + +[http://www.tcl.tk/software/tcllib/](http://www.tcl.tk/software/tcllib/) + +In order for the Tcl-only parser to resolve external entities, the +tcllib package must be installed. + +Be sure to get a version which includes the `uri` package. Version 1.11 +or better is recommended. + +- [GZip'd tarball](ftp://prdownloads.sf.net/tcllib/tcllib-1.11.tar.gz) + +- [ZIP file](ftp://prdownloads.sf.net/tcllib/tcllib-1.11.zip) + +The latest CVS snapshot may be found at [the SourceForge project +page](http://sourceforge.net/projects/tcllib). + +libxml2 + +libxml2 is required for the compiled version of the TclXML/libxml2 +package. libiconv may also be required. + +The source code for libxml2 and libiconv is *not* supplied with this +package. Download libxml2 from [xmlsoft.org](http://xmlsoft.org/) +separately. libiconv may also be required; download from a GNU mirror +site. + +Version 2.7.2 (or better) is recommended. + +#### Pure-Tcl Installation + +### no compilation required + +Run the configure script and invoke the command: + + make install + +If the pure-Tcl parser is good enough for you, then read no further. + +#### Compiled Installation + +##### Unix/Linux + +You must have Tcl/Tk version 8.2 or better installed on your system. +Tcl/Tk 8.3 or better is recommended. + +1. Make sure you have Tcllib 1.11 (or better) installed. Tcllib is + still required, even for the compiled parser. + +2. If you wish to use TclXML/libxml2, make sure libxml2-2.7.2 (or + better) is installed. + +3. Unpack the TclXML distribution and **cd** into the `tclxml-3.2` + directory. + +4. Run the `configure` script, with the --prefix and --enable-threads + switches (the latter only if Tcl has been built with threads + enabled). Use the --with-xml2-config switch to specify the location + of the libxml2 configuration script, `xml2Conf.sh`. Similarly, use + the --with-xslt-config if necessary. + + TclXML/libxml2 may be configured to statically link the libxml2 and + libxslt libraries to the libtclxml.so shared library. This is + advantageous when using TclXML/libxml2 in a StarKit. To statically + link the libraries use the --with-xml-static switch. + + For example, on my system I have Tcl 8.5 installed in + `/usr/local/tcl8.5` and libxm2 installed in `/usr/local/gnome`. I + also need to statically link the libraries. Therefore I would use + the command: + + ./configure --prefix=/usr/local/tcl8.5 --enable-threads --with-xml2-config=/usr/local/gnome/bin/xml2Conf.sh --with-xml-static=1 + +5. make + +6. Don't test the package using make test until all of the packages are + installed (it is a current deficiency of the build system that the + package cannot be tested before installation - we hope to fix this + soon!). +7. make install + + You may need to do this as root, depending on your installation. + +8. make test + +9. make doc + +10. make install-doc + +##### Windows (MSYS/MINGW) + +[Advice: ActiveTcl includes binaries for TclXML.] + +You must have Tcl/Tk version 8.2 or better installed on your system. +Tcl/Tk 8.5.5 or better is recommended. + +Before starting, download the binaries for libxml2 (or build them from +source). [xmlsoft](http://xmlsoft.org/) has a link to the MS Windows +binary distribution. + +If you have a TEA build environment setup, just use the normal +configure/make/make install pattern. + +##### Windows (NMAKE/VC++ 6.0) + +TclXML/libxml2 is built with MSYS/MINGW, see above, so this build system +is untested. + +Alternatively, the `win` subdirectory contains a `makefile.vc` file for +Visual Studio C++ v6.0. In a Command Prompt window set up your +environment so that `nmake` is on the path (by running `VCVARS32.BAT`), +then type the following: + + nmake -f makefile.vc TCLDIR=C:\Path\To\Tcl INSTALLDIR=C:\Path\To\Tcl LIBZDIR=C:\Path\To\libz LIBICONVDIR=C:\Path\To\libiconv LIBXML2DIR=C:\Path\To\libxml2 LIBXSLTDIR=C:\Path\To\libxslt + +As an example, on my system I have Tcl installed in `C:\Tcl` and the +libxml2 and libxslt binaries unpacked in the directory `C:\gnome`. +Accordingly, I would use the following command line: + + nmake -f makefile.vc TCLDIR=C:\Tcl INSTALLDIR=C:\Tcl LIBZDIR=C:\gnome\zlib-1.1.4.win32 LIBICONVDIR=C:\gnome\libiconv-1.9.1.win32 LIBXML2DIR=C:\gnome\libxml2-2.7.2.win32 LIBXSLTDIR=C:\gnome\libxslt-1.1.24.win32 + +Install the package by appending 'install' to the command line used +above, for example: + + nmake -f makefile.vc TCLDIR=C:\Path\To\Tcl INSTALLDIR=C:\Path\To\Tcl LIBZDIR=C:\Path\To\libz LIBICONVDIR=C:\Path\To\libiconv LIBXML2DIR=C:\Path\To\libxml2 LIBXSLTDIR=C:\Path\To\libxslt install + +##### Macintosh OS X + +Binary distributions of libxml2, libxslt and TclXML as frameworks are +provided by [Explain](http://www.explain.com.au/oss/). + +There are two ways to build TclXML under Mac OS X: + +1. The usual Unix way, see above. + +2. As an embedded Framework using Xcode. + +The `macosx` directory contains the Xcode files for building under OS X +(Leopard/Panther). TclXML/libxml2 has been tested on OS X 10.5 (or is +that X.5?). + +Start-up the project. Make sure that the references to the libxml2 and +Tcl external frameworks are correct. Select the 'Make' target and build. +This builds everything. The result is two Mac OS X Frameworks; a +"normal" and an "embedded". The embedded framework will be in the +`embedded` subdirectory of the Build Products directory. Copy +`tclxml.framework` to any of the usual places for frameworks +(`~/Library/Frameworks`, `/Library/Frameworks`, etc). + +For earlier version of OS X using Project Builder, you will have to +retrieve a previous version of the Project Builder files from the CVS +repository. + +### Usage + +See [the website](http://tclxml.sourceforge.net/) for links to tutorials +and the reference manual. + +In the meantime, here's a quick tutorial: + +#### Parsing XML, Streaming + +This is the lowest-level access to an XML document; use SAX-like events +to stream through the document. The simple program below counts the +number of characters in the content of an XML document. + + package require xml 3.2 + + set parser [xml::parser] + $parser configure -elementstartcommand EStart \ + -characterdatacommand PCData + + proc EStart {tag attlist args} { + array set attr $attlist + puts "Element \"$tag\" started with [array size attr] attributes" + } + + proc PCData text { + incr ::count [string length $text] + } + + set count 0 + $parser parse [read stdin] + + puts "The document contains $count characters" + exit 0 + +#### Parsing XML with DOM + +This is the next level up in accessing an XML document; use the Document +Object Model (DOM) to view the XML document as a tree. The simple +program below counts the number of characters in the content of an XML +document. + + package require xml 3.2 + + set doc [dom::parse [read stdin]] + set count 0 + foreach textNode [dom::selectNode $doc //text()] { + incr count [string length [$textNode cget -nodeValue]] + } + + puts "The document contains $count characters" + + +#### Transforming XML with XSLT + +This is the highest level in processing an XML document; use a XSL +stylesheet to transform a XML document. The simple program below reads +two XML documents, compiles one into a XSL stylesheet and performs the +transformation. + + package require xml 3.2 + + set chan [open "count.xsl"] + set styleDoc [dom::parse [read $chan]] + close $chan + set sourceDoc [dom::parse [read stdin]] + + set style [xslt::compile $styleDoc] + set resultDoc [$style transform $sourceDoc] + + puts [dom::serialize $resultDoc] + + +The XSL stylesheet `count.xsl`, which counts the number of characters in +the source document, looks like this: + + + + + The document contains + + + + characters. + + + + + + + + + + + + + + + + + + + + + +### XPath + +In addition to XML parsing packages, TclXML also provides a package for +parsing XPath location paths. The XPath package only parsing the path's +syntax, it does interpret the path. See +[TclDOM](http://tclxml.sourceforge.net/tcldom.html) for a package that +will interpret XPath location paths. + +This package is in its infancy, and does not support the full range of +XPath features. Only a very limited subset of location paths are +supported, of the form "/simple/example[2]". Paths within predicates +will definitely fail. + +To use the XPath package: + + package require xpath + +To parse a location path: + + xpath::split {/simple/example} + +This returns a Tcl list, each element of which is a three element +sublist: {axis node-test {?predicate ...?}}. diff --git a/aclocal.m4 b/aclocal.m4 new file mode 100644 index 0000000..0b05739 --- /dev/null +++ b/aclocal.m4 @@ -0,0 +1,9 @@ +# +# Include the TEA standard macro set +# + +builtin(include,tclconfig/tcl.m4) + +# +# Add here whatever m4 macros you want to define for your package +# diff --git a/configure b/configure new file mode 100755 index 0000000..3b29d57 --- /dev/null +++ b/configure @@ -0,0 +1,10114 @@ +#! /bin/sh +# Guess values for system-dependent variables and create Makefiles. +# Generated by GNU Autoconf 2.69 for tclxml 3.2. +# +# +# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc. +# +# +# This configure script is free software; the Free Software Foundation +# gives unlimited permission to copy, distribute and modify it. +## -------------------- ## +## M4sh Initialization. ## +## -------------------- ## + +# Be more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi + + +as_nl=' +' +export as_nl +# Printing a long string crashes Solaris 7 /usr/bin/printf. +as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo +# Prefer a ksh shell builtin over an external printf program on Solaris, +# but without wasting forks for bash or zsh. +if test -z "$BASH_VERSION$ZSH_VERSION" \ + && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='print -r --' + as_echo_n='print -rn --' +elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='printf %s\n' + as_echo_n='printf %s' +else + if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then + as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' + as_echo_n='/usr/ucb/echo -n' + else + as_echo_body='eval expr "X$1" : "X\\(.*\\)"' + as_echo_n_body='eval + arg=$1; + case $arg in #( + *"$as_nl"*) + expr "X$arg" : "X\\(.*\\)$as_nl"; + arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; + esac; + expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" + ' + export as_echo_n_body + as_echo_n='sh -c $as_echo_n_body as_echo' + fi + export as_echo_body + as_echo='sh -c $as_echo_body as_echo' +fi + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } +fi + + +# IFS +# We need space, tab and new line, in precisely that order. Quoting is +# there to prevent editors from complaining about space-tab. +# (If _AS_PATH_WALK were called with IFS unset, it would disable word +# splitting by setting IFS to empty value.) +IFS=" "" $as_nl" + +# Find who we are. Look in the path if we contain no directory separator. +as_myself= +case $0 in #(( + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break + done +IFS=$as_save_IFS + + ;; +esac +# We did not find ourselves, most probably we were run as `sh COMMAND' +# in which case we are not to be found in the path. +if test "x$as_myself" = x; then + as_myself=$0 +fi +if test ! -f "$as_myself"; then + $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + exit 1 +fi + +# Unset variables that we do not need and which cause bugs (e.g. in +# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" +# suppresses any "Segmentation fault" message there. '((' could +# trigger a bug in pdksh 5.2.14. +for as_var in BASH_ENV ENV MAIL MAILPATH +do eval test x\${$as_var+set} = xset \ + && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : +done +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE + +# CDPATH. +(unset CDPATH) >/dev/null 2>&1 && unset CDPATH + +# Use a proper internal environment variable to ensure we don't fall + # into an infinite loop, continuously re-executing ourselves. + if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then + _as_can_reexec=no; export _as_can_reexec; + # We cannot yet assume a decent shell, so we have to provide a +# neutralization value for shells without unset; and this also +# works around shells that cannot unset nonexistent variables. +# Preserve -v and -x to the replacement shell. +BASH_ENV=/dev/null +ENV=/dev/null +(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV +case $- in # (((( + *v*x* | *x*v* ) as_opts=-vx ;; + *v* ) as_opts=-v ;; + *x* ) as_opts=-x ;; + * ) as_opts= ;; +esac +exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} +# Admittedly, this is quite paranoid, since all the known shells bail +# out after a failed `exec'. +$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2 +as_fn_exit 255 + fi + # We don't want this to propagate to other subprocesses. + { _as_can_reexec=; unset _as_can_reexec;} +if test "x$CONFIG_SHELL" = x; then + as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which + # is contrary to our usage. Disable this feature. + alias -g '\${1+\"\$@\"}'='\"\$@\"' + setopt NO_GLOB_SUBST +else + case \`(set -o) 2>/dev/null\` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi +" + as_required="as_fn_return () { (exit \$1); } +as_fn_success () { as_fn_return 0; } +as_fn_failure () { as_fn_return 1; } +as_fn_ret_success () { return 0; } +as_fn_ret_failure () { return 1; } + +exitcode=0 +as_fn_success || { exitcode=1; echo as_fn_success failed.; } +as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; } +as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; } +as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; } +if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then : + +else + exitcode=1; echo positional parameters were not saved. +fi +test x\$exitcode = x0 || exit 1 +test -x / || exit 1" + as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO + as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO + eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" && + test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1 +test \$(( 1 + 1 )) = 2 || exit 1" + if (eval "$as_required") 2>/dev/null; then : + as_have_required=yes +else + as_have_required=no +fi + if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then : + +else + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +as_found=false +for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + as_found=: + case $as_dir in #( + /*) + for as_base in sh bash ksh sh5; do + # Try only shells that exist, to save several forks. + as_shell=$as_dir/$as_base + if { test -f "$as_shell" || test -f "$as_shell.exe"; } && + { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then : + CONFIG_SHELL=$as_shell as_have_required=yes + if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then : + break 2 +fi +fi + done;; + esac + as_found=false +done +$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } && + { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then : + CONFIG_SHELL=$SHELL as_have_required=yes +fi; } +IFS=$as_save_IFS + + + if test "x$CONFIG_SHELL" != x; then : + export CONFIG_SHELL + # We cannot yet assume a decent shell, so we have to provide a +# neutralization value for shells without unset; and this also +# works around shells that cannot unset nonexistent variables. +# Preserve -v and -x to the replacement shell. +BASH_ENV=/dev/null +ENV=/dev/null +(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV +case $- in # (((( + *v*x* | *x*v* ) as_opts=-vx ;; + *v* ) as_opts=-v ;; + *x* ) as_opts=-x ;; + * ) as_opts= ;; +esac +exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} +# Admittedly, this is quite paranoid, since all the known shells bail +# out after a failed `exec'. +$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2 +exit 255 +fi + + if test x$as_have_required = xno; then : + $as_echo "$0: This script requires a shell more modern than all" + $as_echo "$0: the shells that I found on your system." + if test x${ZSH_VERSION+set} = xset ; then + $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should" + $as_echo "$0: be upgraded to zsh 4.3.4 or later." + else + $as_echo "$0: Please tell bug-autoconf@gnu.org about your system, +$0: including any error possibly output before this +$0: message. Then install a modern shell, or manually run +$0: the script under such a shell if you do have one." + fi + exit 1 +fi +fi +fi +SHELL=${CONFIG_SHELL-/bin/sh} +export SHELL +# Unset more variables known to interfere with behavior of common tools. +CLICOLOR_FORCE= GREP_OPTIONS= +unset CLICOLOR_FORCE GREP_OPTIONS + +## --------------------- ## +## M4sh Shell Functions. ## +## --------------------- ## +# as_fn_unset VAR +# --------------- +# Portably unset VAR. +as_fn_unset () +{ + { eval $1=; unset $1;} +} +as_unset=as_fn_unset + +# as_fn_set_status STATUS +# ----------------------- +# Set $? to STATUS, without forking. +as_fn_set_status () +{ + return $1 +} # as_fn_set_status + +# as_fn_exit STATUS +# ----------------- +# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. +as_fn_exit () +{ + set +e + as_fn_set_status $1 + exit $1 +} # as_fn_exit + +# as_fn_mkdir_p +# ------------- +# Create "$as_dir" as a directory, including parents if necessary. +as_fn_mkdir_p () +{ + + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || eval $as_mkdir_p || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( + *) as_qdir=$as_dir;; + esac + as_dirs="'$as_qdir' $as_dirs" + as_dir=`$as_dirname -- "$as_dir" || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + test -d "$as_dir" && break + done + test -z "$as_dirs" || eval "mkdir $as_dirs" + } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" + + +} # as_fn_mkdir_p + +# as_fn_executable_p FILE +# ----------------------- +# Test if FILE is an executable regular file. +as_fn_executable_p () +{ + test -f "$1" && test -x "$1" +} # as_fn_executable_p +# as_fn_append VAR VALUE +# ---------------------- +# Append the text in VALUE to the end of the definition contained in VAR. Take +# advantage of any shell optimizations that allow amortized linear growth over +# repeated appends, instead of the typical quadratic growth present in naive +# implementations. +if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : + eval 'as_fn_append () + { + eval $1+=\$2 + }' +else + as_fn_append () + { + eval $1=\$$1\$2 + } +fi # as_fn_append + +# as_fn_arith ARG... +# ------------------ +# Perform arithmetic evaluation on the ARGs, and store the result in the +# global $as_val. Take advantage of shells that can avoid forks. The arguments +# must be portable across $(()) and expr. +if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : + eval 'as_fn_arith () + { + as_val=$(( $* )) + }' +else + as_fn_arith () + { + as_val=`expr "$@" || test $? -eq 1` + } +fi # as_fn_arith + + +# as_fn_error STATUS ERROR [LINENO LOG_FD] +# ---------------------------------------- +# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are +# provided, also output the error to LOG_FD, referencing LINENO. Then exit the +# script with STATUS, using 1 if that was 0. +as_fn_error () +{ + as_status=$1; test $as_status -eq 0 && as_status=1 + if test "$4"; then + as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 + fi + $as_echo "$as_me: error: $2" >&2 + as_fn_exit $as_status +} # as_fn_error + +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then + as_expr=expr +else + as_expr=false +fi + +if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +as_me=`$as_basename -- "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + + + as_lineno_1=$LINENO as_lineno_1a=$LINENO + as_lineno_2=$LINENO as_lineno_2a=$LINENO + eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" && + test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || { + # Blame Lee E. McMahon (1931-1989) for sed's syntax. :-) + sed -n ' + p + /[$]LINENO/= + ' <$as_myself | + sed ' + s/[$]LINENO.*/&-/ + t lineno + b + :lineno + N + :loop + s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ + t loop + s/-\n.*// + ' >$as_me.lineno && + chmod +x "$as_me.lineno" || + { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; } + + # If we had to re-execute with $CONFIG_SHELL, we're ensured to have + # already done that, so ensure we don't try to do so again and fall + # in an infinite loop. This has already happened in practice. + _as_can_reexec=no; export _as_can_reexec + # Don't try to exec as it changes $[0], causing all sort of problems + # (the dirname of $[0] is not the place where we might find the + # original and so on. Autoconf is especially sensitive to this). + . "./$as_me.lineno" + # Exit status is that of the last command. + exit +} + +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in #((((( +-n*) + case `echo 'xy\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + xy) ECHO_C='\c';; + *) echo `echo ksh88 bug on AIX 6.1` > /dev/null + ECHO_T=' ';; + esac;; +*) + ECHO_N='-n';; +esac + +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file +else + rm -f conf$$.dir + mkdir conf$$.dir 2>/dev/null +fi +if (echo >conf$$.file) 2>/dev/null; then + if ln -s conf$$.file conf$$ 2>/dev/null; then + as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -pR'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -pR' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else + as_ln_s='cp -pR' + fi +else + as_ln_s='cp -pR' +fi +rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + +if mkdir -p . 2>/dev/null; then + as_mkdir_p='mkdir -p "$as_dir"' +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + +as_test_x='test -x' +as_executable_p=as_fn_executable_p + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + + +test -n "$DJDIR" || exec 7<&0 &1 + +# Name of the host. +# hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status, +# so uname gets run too. +ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` + +# +# Initializations. +# +ac_default_prefix=/usr/local +ac_clean_files= +ac_config_libobj_dir=. +LIBOBJS= +cross_compiling=no +subdirs= +MFLAGS= +MAKEFLAGS= + +# Identity of this package. +PACKAGE_NAME='tclxml' +PACKAGE_TARNAME='tclxml' +PACKAGE_VERSION='3.2' +PACKAGE_STRING='tclxml 3.2' +PACKAGE_BUGREPORT='' +PACKAGE_URL='' + +# Factoring default headers for most tests. +ac_includes_default="\ +#include +#ifdef HAVE_SYS_TYPES_H +# include +#endif +#ifdef HAVE_SYS_STAT_H +# include +#endif +#ifdef STDC_HEADERS +# include +# include +#else +# ifdef HAVE_STDLIB_H +# include +# endif +#endif +#ifdef HAVE_STRING_H +# if !defined STDC_HEADERS && defined HAVE_MEMORY_H +# include +# endif +# include +#endif +#ifdef HAVE_STRINGS_H +# include +#endif +#ifdef HAVE_INTTYPES_H +# include +#endif +#ifdef HAVE_STDINT_H +# include +#endif +#ifdef HAVE_UNISTD_H +# include +#endif" + +ac_subst_vars='LTLIBOBJS +LIBOBJS +PATCHLEVEL +MINOR_VERSION +MAJOR_VERSION +tclxml_STUB_LIB_PATH +tclxml_BUILD_STUB_LIB_PATH +tclxml_STUB_LIB_SPEC +tclxml_BUILD_STUB_LIB_SPEC +tclxml_LIB_SPEC +tclxml_BUILD_LIB_SPEC +XSLT_LIBS +XSLT_CFLAGS +XML2_LIBS +XML2_CFLAGS +TCLSH_PROG +PRACTCL_NAME_LIBRARY +PRACTCL_VC_MANIFEST_EMBED_EXE +PRACTCL_VC_MANIFEST_EMBED_DLL +PRACTCL_STUB_LIB +PRACTCL_STATIC_LIB +PRACTCL_SHARED_LIB +PRACTCL_TOOLSET +PRACTCL_CFLAGS +VC_MANIFEST_EMBED_EXE +VC_MANIFEST_EMBED_DLL +RANLIB_STUB +MAKE_STUB_LIB +MAKE_STATIC_LIB +MAKE_SHARED_LIB +MAKE_LIB +TCL_DBGX +LDFLAGS_DEFAULT +CFLAGS_DEFAULT +LD_LIBRARY_PATH_VAR +SHLIB_CFLAGS +SHLIB_LD_LIBS +SHLIB_SUFFIX +SHLIB_LD +STLIB_LD +CFLAGS_WARNING +CFLAGS_OPTIMIZE +CFLAGS_DEBUG +RC +CELIB_DIR +AR +STUBS_BUILD +SHARED_BUILD +TCL_THREADS +TCL_INCLUDES +PKG_OBJECTS +PKG_SOURCES +MATH_LIBS +EGREP +GREP +RANLIB +SET_MAKE +INSTALL_LIBRARY +INSTALL_SCRIPT +INSTALL_PROGRAM +INSTALL_DATA +INSTALL_DATA_DIR +INSTALL +CPP +TCL_SHLIB_LD_LIBS +TCL_LD_FLAGS +TCL_EXTRA_CFLAGS +TCL_DEFS +TCL_LIBS +CLEANFILES +OBJEXT +ac_ct_CC +CPPFLAGS +LDFLAGS +CFLAGS +CC +TCL_STUB_LIB_SPEC +TCL_STUB_LIB_FLAG +TCL_STUB_LIB_FILE +TCL_LIB_SPEC +TCL_LIB_FLAG +TCL_LIB_FILE +TCL_SRC_DIR +TCL_BIN_DIR +TCL_PATCH_LEVEL +TCL_VERSION +PKG_CFLAGS +PKG_LIBS +PKG_INCLUDES +PKG_HEADERS +PKG_TCL_SOURCES +PKG_STUB_OBJECTS +PKG_STUB_SOURCES +PKG_STUB_LIB_FILE +PKG_LIB_FILE +EXEEXT +CYGPATH +TEA_TK_EXTENSION +target_alias +host_alias +build_alias +LIBS +ECHO_T +ECHO_N +ECHO_C +DEFS +mandir +localedir +libdir +psdir +pdfdir +dvidir +htmldir +infodir +docdir +oldincludedir +includedir +localstatedir +sharedstatedir +sysconfdir +datadir +datarootdir +libexecdir +sbindir +bindir +program_transform_name +prefix +exec_prefix +PACKAGE_URL +PACKAGE_BUGREPORT +PACKAGE_STRING +PACKAGE_VERSION +PACKAGE_TARNAME +PACKAGE_NAME +PATH_SEPARATOR +SHELL' +ac_subst_files='' +ac_user_opts=' +enable_option_checking +with_tcl +with_tclinclude +enable_threads +enable_shared +enable_stubs +enable_64bit +enable_64bit_vis +enable_rpath +enable_wince +with_celib +enable_symbols +with_tclsh +with_xml2_config +with_xslt_config +with_xml_static +' + ac_precious_vars='build_alias +host_alias +target_alias +CC +CFLAGS +LDFLAGS +LIBS +CPPFLAGS +CPP' + + +# Initialize some variables set by options. +ac_init_help= +ac_init_version=false +ac_unrecognized_opts= +ac_unrecognized_sep= +# The variables have the same names as the options, with +# dashes changed to underlines. +cache_file=/dev/null +exec_prefix=NONE +no_create= +no_recursion= +prefix=NONE +program_prefix=NONE +program_suffix=NONE +program_transform_name=s,x,x, +silent= +site= +srcdir= +verbose= +x_includes=NONE +x_libraries=NONE + +# Installation directory options. +# These are left unexpanded so users can "make install exec_prefix=/foo" +# and all the variables that are supposed to be based on exec_prefix +# by default will actually change. +# Use braces instead of parens because sh, perl, etc. also accept them. +# (The list follows the same order as the GNU Coding Standards.) +bindir='${exec_prefix}/bin' +sbindir='${exec_prefix}/sbin' +libexecdir='${exec_prefix}/libexec' +datarootdir='${prefix}/share' +datadir='${datarootdir}' +sysconfdir='${prefix}/etc' +sharedstatedir='${prefix}/com' +localstatedir='${prefix}/var' +includedir='${prefix}/include' +oldincludedir='/usr/include' +docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' +infodir='${datarootdir}/info' +htmldir='${docdir}' +dvidir='${docdir}' +pdfdir='${docdir}' +psdir='${docdir}' +libdir='${exec_prefix}/lib' +localedir='${datarootdir}/locale' +mandir='${datarootdir}/man' + +ac_prev= +ac_dashdash= +for ac_option +do + # If the previous option needs an argument, assign it. + if test -n "$ac_prev"; then + eval $ac_prev=\$ac_option + ac_prev= + continue + fi + + case $ac_option in + *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; + *=) ac_optarg= ;; + *) ac_optarg=yes ;; + esac + + # Accept the important Cygnus configure options, so we can diagnose typos. + + case $ac_dashdash$ac_option in + --) + ac_dashdash=yes ;; + + -bindir | --bindir | --bindi | --bind | --bin | --bi) + ac_prev=bindir ;; + -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) + bindir=$ac_optarg ;; + + -build | --build | --buil | --bui | --bu) + ac_prev=build_alias ;; + -build=* | --build=* | --buil=* | --bui=* | --bu=*) + build_alias=$ac_optarg ;; + + -cache-file | --cache-file | --cache-fil | --cache-fi \ + | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) + ac_prev=cache_file ;; + -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ + | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) + cache_file=$ac_optarg ;; + + --config-cache | -C) + cache_file=config.cache ;; + + -datadir | --datadir | --datadi | --datad) + ac_prev=datadir ;; + -datadir=* | --datadir=* | --datadi=* | --datad=*) + datadir=$ac_optarg ;; + + -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \ + | --dataroo | --dataro | --datar) + ac_prev=datarootdir ;; + -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \ + | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) + datarootdir=$ac_optarg ;; + + -disable-* | --disable-*) + ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid feature name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"enable_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval enable_$ac_useropt=no ;; + + -docdir | --docdir | --docdi | --doc | --do) + ac_prev=docdir ;; + -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*) + docdir=$ac_optarg ;; + + -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv) + ac_prev=dvidir ;; + -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) + dvidir=$ac_optarg ;; + + -enable-* | --enable-*) + ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid feature name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"enable_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval enable_$ac_useropt=\$ac_optarg ;; + + -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ + | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ + | --exec | --exe | --ex) + ac_prev=exec_prefix ;; + -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ + | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ + | --exec=* | --exe=* | --ex=*) + exec_prefix=$ac_optarg ;; + + -gas | --gas | --ga | --g) + # Obsolete; use --with-gas. + with_gas=yes ;; + + -help | --help | --hel | --he | -h) + ac_init_help=long ;; + -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) + ac_init_help=recursive ;; + -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) + ac_init_help=short ;; + + -host | --host | --hos | --ho) + ac_prev=host_alias ;; + -host=* | --host=* | --hos=* | --ho=*) + host_alias=$ac_optarg ;; + + -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht) + ac_prev=htmldir ;; + -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \ + | --ht=*) + htmldir=$ac_optarg ;; + + -includedir | --includedir | --includedi | --included | --include \ + | --includ | --inclu | --incl | --inc) + ac_prev=includedir ;; + -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ + | --includ=* | --inclu=* | --incl=* | --inc=*) + includedir=$ac_optarg ;; + + -infodir | --infodir | --infodi | --infod | --info | --inf) + ac_prev=infodir ;; + -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) + infodir=$ac_optarg ;; + + -libdir | --libdir | --libdi | --libd) + ac_prev=libdir ;; + -libdir=* | --libdir=* | --libdi=* | --libd=*) + libdir=$ac_optarg ;; + + -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ + | --libexe | --libex | --libe) + ac_prev=libexecdir ;; + -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ + | --libexe=* | --libex=* | --libe=*) + libexecdir=$ac_optarg ;; + + -localedir | --localedir | --localedi | --localed | --locale) + ac_prev=localedir ;; + -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*) + localedir=$ac_optarg ;; + + -localstatedir | --localstatedir | --localstatedi | --localstated \ + | --localstate | --localstat | --localsta | --localst | --locals) + ac_prev=localstatedir ;; + -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ + | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*) + localstatedir=$ac_optarg ;; + + -mandir | --mandir | --mandi | --mand | --man | --ma | --m) + ac_prev=mandir ;; + -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) + mandir=$ac_optarg ;; + + -nfp | --nfp | --nf) + # Obsolete; use --without-fp. + with_fp=no ;; + + -no-create | --no-create | --no-creat | --no-crea | --no-cre \ + | --no-cr | --no-c | -n) + no_create=yes ;; + + -no-recursion | --no-recursion | --no-recursio | --no-recursi \ + | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) + no_recursion=yes ;; + + -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ + | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ + | --oldin | --oldi | --old | --ol | --o) + ac_prev=oldincludedir ;; + -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ + | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ + | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) + oldincludedir=$ac_optarg ;; + + -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) + ac_prev=prefix ;; + -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) + prefix=$ac_optarg ;; + + -program-prefix | --program-prefix | --program-prefi | --program-pref \ + | --program-pre | --program-pr | --program-p) + ac_prev=program_prefix ;; + -program-prefix=* | --program-prefix=* | --program-prefi=* \ + | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) + program_prefix=$ac_optarg ;; + + -program-suffix | --program-suffix | --program-suffi | --program-suff \ + | --program-suf | --program-su | --program-s) + ac_prev=program_suffix ;; + -program-suffix=* | --program-suffix=* | --program-suffi=* \ + | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) + program_suffix=$ac_optarg ;; + + -program-transform-name | --program-transform-name \ + | --program-transform-nam | --program-transform-na \ + | --program-transform-n | --program-transform- \ + | --program-transform | --program-transfor \ + | --program-transfo | --program-transf \ + | --program-trans | --program-tran \ + | --progr-tra | --program-tr | --program-t) + ac_prev=program_transform_name ;; + -program-transform-name=* | --program-transform-name=* \ + | --program-transform-nam=* | --program-transform-na=* \ + | --program-transform-n=* | --program-transform-=* \ + | --program-transform=* | --program-transfor=* \ + | --program-transfo=* | --program-transf=* \ + | --program-trans=* | --program-tran=* \ + | --progr-tra=* | --program-tr=* | --program-t=*) + program_transform_name=$ac_optarg ;; + + -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd) + ac_prev=pdfdir ;; + -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*) + pdfdir=$ac_optarg ;; + + -psdir | --psdir | --psdi | --psd | --ps) + ac_prev=psdir ;; + -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) + psdir=$ac_optarg ;; + + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + silent=yes ;; + + -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) + ac_prev=sbindir ;; + -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ + | --sbi=* | --sb=*) + sbindir=$ac_optarg ;; + + -sharedstatedir | --sharedstatedir | --sharedstatedi \ + | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ + | --sharedst | --shareds | --shared | --share | --shar \ + | --sha | --sh) + ac_prev=sharedstatedir ;; + -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ + | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ + | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ + | --sha=* | --sh=*) + sharedstatedir=$ac_optarg ;; + + -site | --site | --sit) + ac_prev=site ;; + -site=* | --site=* | --sit=*) + site=$ac_optarg ;; + + -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) + ac_prev=srcdir ;; + -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) + srcdir=$ac_optarg ;; + + -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ + | --syscon | --sysco | --sysc | --sys | --sy) + ac_prev=sysconfdir ;; + -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ + | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) + sysconfdir=$ac_optarg ;; + + -target | --target | --targe | --targ | --tar | --ta | --t) + ac_prev=target_alias ;; + -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) + target_alias=$ac_optarg ;; + + -v | -verbose | --verbose | --verbos | --verbo | --verb) + verbose=yes ;; + + -version | --version | --versio | --versi | --vers | -V) + ac_init_version=: ;; + + -with-* | --with-*) + ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid package name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"with_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval with_$ac_useropt=\$ac_optarg ;; + + -without-* | --without-*) + ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid package name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"with_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval with_$ac_useropt=no ;; + + --x) + # Obsolete; use --with-x. + with_x=yes ;; + + -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ + | --x-incl | --x-inc | --x-in | --x-i) + ac_prev=x_includes ;; + -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ + | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) + x_includes=$ac_optarg ;; + + -x-libraries | --x-libraries | --x-librarie | --x-librari \ + | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) + ac_prev=x_libraries ;; + -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ + | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) + x_libraries=$ac_optarg ;; + + -*) as_fn_error $? "unrecognized option: \`$ac_option' +Try \`$0 --help' for more information" + ;; + + *=*) + ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` + # Reject names that are not valid shell variable names. + case $ac_envvar in #( + '' | [0-9]* | *[!_$as_cr_alnum]* ) + as_fn_error $? "invalid variable name: \`$ac_envvar'" ;; + esac + eval $ac_envvar=\$ac_optarg + export $ac_envvar ;; + + *) + # FIXME: should be removed in autoconf 3.0. + $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2 + expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && + $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2 + : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}" + ;; + + esac +done + +if test -n "$ac_prev"; then + ac_option=--`echo $ac_prev | sed 's/_/-/g'` + as_fn_error $? "missing argument to $ac_option" +fi + +if test -n "$ac_unrecognized_opts"; then + case $enable_option_checking in + no) ;; + fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;; + *) $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;; + esac +fi + +# Check all directory arguments for consistency. +for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ + datadir sysconfdir sharedstatedir localstatedir includedir \ + oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ + libdir localedir mandir +do + eval ac_val=\$$ac_var + # Remove trailing slashes. + case $ac_val in + */ ) + ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'` + eval $ac_var=\$ac_val;; + esac + # Be sure to have absolute directory names. + case $ac_val in + [\\/$]* | ?:[\\/]* ) continue;; + NONE | '' ) case $ac_var in *prefix ) continue;; esac;; + esac + as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val" +done + +# There might be people who depend on the old broken behavior: `$host' +# used to hold the argument of --host etc. +# FIXME: To remove some day. +build=$build_alias +host=$host_alias +target=$target_alias + +# FIXME: To remove some day. +if test "x$host_alias" != x; then + if test "x$build_alias" = x; then + cross_compiling=maybe + elif test "x$build_alias" != "x$host_alias"; then + cross_compiling=yes + fi +fi + +ac_tool_prefix= +test -n "$host_alias" && ac_tool_prefix=$host_alias- + +test "$silent" = yes && exec 6>/dev/null + + +ac_pwd=`pwd` && test -n "$ac_pwd" && +ac_ls_di=`ls -di .` && +ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || + as_fn_error $? "working directory cannot be determined" +test "X$ac_ls_di" = "X$ac_pwd_ls_di" || + as_fn_error $? "pwd does not report name of working directory" + + +# Find the source files, if location was not specified. +if test -z "$srcdir"; then + ac_srcdir_defaulted=yes + # Try the directory containing this script, then the parent directory. + ac_confdir=`$as_dirname -- "$as_myself" || +$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_myself" : 'X\(//\)[^/]' \| \ + X"$as_myself" : 'X\(//\)$' \| \ + X"$as_myself" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_myself" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + srcdir=$ac_confdir + if test ! -r "$srcdir/$ac_unique_file"; then + srcdir=.. + fi +else + ac_srcdir_defaulted=no +fi +if test ! -r "$srcdir/$ac_unique_file"; then + test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." + as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir" +fi +ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" +ac_abs_confdir=`( + cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg" + pwd)` +# When building in place, set srcdir=. +if test "$ac_abs_confdir" = "$ac_pwd"; then + srcdir=. +fi +# Remove unnecessary trailing slashes from srcdir. +# Double slashes in file names in object file debugging info +# mess up M-x gdb in Emacs. +case $srcdir in +*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;; +esac +for ac_var in $ac_precious_vars; do + eval ac_env_${ac_var}_set=\${${ac_var}+set} + eval ac_env_${ac_var}_value=\$${ac_var} + eval ac_cv_env_${ac_var}_set=\${${ac_var}+set} + eval ac_cv_env_${ac_var}_value=\$${ac_var} +done + +# +# Report the --help message. +# +if test "$ac_init_help" = "long"; then + # Omit some internal or obsolete options to make the list less imposing. + # This message is too long to be a string in the A/UX 3.1 sh. + cat <<_ACEOF +\`configure' configures tclxml 3.2 to adapt to many kinds of systems. + +Usage: $0 [OPTION]... [VAR=VALUE]... + +To assign environment variables (e.g., CC, CFLAGS...), specify them as +VAR=VALUE. See below for descriptions of some of the useful variables. + +Defaults for the options are specified in brackets. + +Configuration: + -h, --help display this help and exit + --help=short display options specific to this package + --help=recursive display the short help of all the included packages + -V, --version display version information and exit + -q, --quiet, --silent do not print \`checking ...' messages + --cache-file=FILE cache test results in FILE [disabled] + -C, --config-cache alias for \`--cache-file=config.cache' + -n, --no-create do not create output files + --srcdir=DIR find the sources in DIR [configure dir or \`..'] + +Installation directories: + --prefix=PREFIX install architecture-independent files in PREFIX + [$ac_default_prefix] + --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX + [PREFIX] + +By default, \`make install' will install all the files in +\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify +an installation prefix other than \`$ac_default_prefix' using \`--prefix', +for instance \`--prefix=\$HOME'. + +For better control, use the options below. + +Fine tuning of the installation directories: + --bindir=DIR user executables [EPREFIX/bin] + --sbindir=DIR system admin executables [EPREFIX/sbin] + --libexecdir=DIR program executables [EPREFIX/libexec] + --sysconfdir=DIR read-only single-machine data [PREFIX/etc] + --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] + --localstatedir=DIR modifiable single-machine data [PREFIX/var] + --libdir=DIR object code libraries [EPREFIX/lib] + --includedir=DIR C header files [PREFIX/include] + --oldincludedir=DIR C header files for non-gcc [/usr/include] + --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] + --datadir=DIR read-only architecture-independent data [DATAROOTDIR] + --infodir=DIR info documentation [DATAROOTDIR/info] + --localedir=DIR locale-dependent data [DATAROOTDIR/locale] + --mandir=DIR man documentation [DATAROOTDIR/man] + --docdir=DIR documentation root [DATAROOTDIR/doc/tclxml] + --htmldir=DIR html documentation [DOCDIR] + --dvidir=DIR dvi documentation [DOCDIR] + --pdfdir=DIR pdf documentation [DOCDIR] + --psdir=DIR ps documentation [DOCDIR] +_ACEOF + + cat <<\_ACEOF +_ACEOF +fi + +if test -n "$ac_init_help"; then + case $ac_init_help in + short | recursive ) echo "Configuration of tclxml 3.2:";; + esac + cat <<\_ACEOF + +Optional Features: + --disable-option-checking ignore unrecognized --enable/--with options + --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) + --enable-FEATURE[=ARG] include FEATURE [ARG=yes] + --enable-threads build with threads + --enable-shared build and link with shared libraries (default: on) + --enable-stubs build and link with stub libraries. Always true for + shared builds (default: on) + --enable-64bit enable 64bit support (default: off) + --enable-64bit-vis enable 64bit Sparc VIS support (default: off) + --disable-rpath disable rpath support (default: on) + --enable-wince enable Win/CE support (where applicable) + --enable-symbols build with debugging symbols (default: off) + +Optional Packages: + --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] + --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) + --with-tcl directory containing tcl configuration + (tclConfig.sh) + --with-tclinclude directory containing the public Tcl header files + --with-celib=DIR use Windows/CE support library from DIR + --with-tclsh Specify a local tcl shell to use for dynamic code + --with-xml2-config the xml2-config configuration script + --with-xslt-config the xslt-config configuration script + --with-xml-static statically link the XML libraries + +Some influential environment variables: + CC C compiler command + CFLAGS C compiler flags + LDFLAGS linker flags, e.g. -L if you have libraries in a + nonstandard directory + LIBS libraries to pass to the linker, e.g. -l + CPPFLAGS (Objective) C/C++ preprocessor flags, e.g. -I if + you have headers in a nonstandard directory + CPP C preprocessor + +Use these variables to override the choices made by `configure' or to help +it to find libraries and programs with nonstandard names/locations. + +Report bugs to the package provider. +_ACEOF +ac_status=$? +fi + +if test "$ac_init_help" = "recursive"; then + # If there are subdirs, report their specific --help. + for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue + test -d "$ac_dir" || + { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } || + continue + ac_builddir=. + +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` + case $ac_top_builddir_sub in + "") ac_top_builddir_sub=. ac_top_build_prefix= ;; + *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; + esac ;; +esac +ac_abs_top_builddir=$ac_pwd +ac_abs_builddir=$ac_pwd$ac_dir_suffix +# for backward compatibility: +ac_top_builddir=$ac_top_build_prefix + +case $srcdir in + .) # We are building in place. + ac_srcdir=. + ac_top_srcdir=$ac_top_builddir_sub + ac_abs_top_srcdir=$ac_pwd ;; + [\\/]* | ?:[\\/]* ) # Absolute name. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir + ac_abs_top_srcdir=$srcdir ;; + *) # Relative name. + ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_build_prefix$srcdir + ac_abs_top_srcdir=$ac_pwd/$srcdir ;; +esac +ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix + + cd "$ac_dir" || { ac_status=$?; continue; } + # Check for guested configure. + if test -f "$ac_srcdir/configure.gnu"; then + echo && + $SHELL "$ac_srcdir/configure.gnu" --help=recursive + elif test -f "$ac_srcdir/configure"; then + echo && + $SHELL "$ac_srcdir/configure" --help=recursive + else + $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 + fi || ac_status=$? + cd "$ac_pwd" || { ac_status=$?; break; } + done +fi + +test -n "$ac_init_help" && exit $ac_status +if $ac_init_version; then + cat <<\_ACEOF +tclxml configure 3.2 +generated by GNU Autoconf 2.69 + +Copyright (C) 2012 Free Software Foundation, Inc. +This configure script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it. +_ACEOF + exit +fi + +## ------------------------ ## +## Autoconf initialization. ## +## ------------------------ ## + +# ac_fn_c_try_compile LINENO +# -------------------------- +# Try to compile conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_compile () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext + if { { ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compile") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_compile + +# ac_fn_c_try_cpp LINENO +# ---------------------- +# Try to preprocess conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_cpp () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if { { ac_try="$ac_cpp conftest.$ac_ext" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_cpp conftest.$ac_ext") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } > conftest.i && { + test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || + test ! -s conftest.err + }; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_cpp + +# ac_fn_c_try_run LINENO +# ---------------------- +# Try to link conftest.$ac_ext, and return whether this succeeded. Assumes +# that executables *can* be run. +ac_fn_c_try_run () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { ac_try='./conftest$ac_exeext' + { { case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; }; then : + ac_retval=0 +else + $as_echo "$as_me: program exited with status $ac_status" >&5 + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=$ac_status +fi + rm -rf conftest.dSYM conftest_ipa8_conftest.oo + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_run + +# ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES +# ------------------------------------------------------- +# Tests whether HEADER exists and can be compiled using the include files in +# INCLUDES, setting the cache variable VAR accordingly. +ac_fn_c_check_header_compile () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +#include <$2> +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + eval "$3=yes" +else + eval "$3=no" +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_header_compile + +# ac_fn_c_try_link LINENO +# ----------------------- +# Try to link conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_link () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext conftest$ac_exeext + if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + test -x conftest$ac_exeext + }; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information + # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would + # interfere with the next link command; also delete a directory that is + # left behind by Apple's compiler. We do this before executing the actions. + rm -rf conftest.dSYM conftest_ipa8_conftest.oo + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_link + +# ac_fn_c_check_func LINENO FUNC VAR +# ---------------------------------- +# Tests whether FUNC exists, setting the cache variable VAR accordingly +ac_fn_c_check_func () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +/* Define $2 to an innocuous variant, in case declares $2. + For example, HP-UX 11i declares gettimeofday. */ +#define $2 innocuous_$2 + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char $2 (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include +#else +# include +#endif + +#undef $2 + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char $2 (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined __stub_$2 || defined __stub___$2 +choke me +#endif + +int +main () +{ +return $2 (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$3=yes" +else + eval "$3=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_func + +# ac_fn_c_check_header_mongrel LINENO HEADER VAR INCLUDES +# ------------------------------------------------------- +# Tests whether HEADER exists, giving a warning if it cannot be compiled using +# the include files in INCLUDES and setting the cache variable VAR +# accordingly. +ac_fn_c_check_header_mongrel () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if eval \${$3+:} false; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +else + # Is the header compilable? +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 usability" >&5 +$as_echo_n "checking $2 usability... " >&6; } +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +#include <$2> +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_header_compiler=yes +else + ac_header_compiler=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_compiler" >&5 +$as_echo "$ac_header_compiler" >&6; } + +# Is the header present? +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 presence" >&5 +$as_echo_n "checking $2 presence... " >&6; } +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <$2> +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + ac_header_preproc=yes +else + ac_header_preproc=no +fi +rm -f conftest.err conftest.i conftest.$ac_ext +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_preproc" >&5 +$as_echo "$ac_header_preproc" >&6; } + +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in #(( + yes:no: ) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&5 +$as_echo "$as_me: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5 +$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;} + ;; + no:yes:* ) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: present but cannot be compiled" >&5 +$as_echo "$as_me: WARNING: $2: present but cannot be compiled" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: check for missing prerequisite headers?" >&5 +$as_echo "$as_me: WARNING: $2: check for missing prerequisite headers?" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: see the Autoconf documentation" >&5 +$as_echo "$as_me: WARNING: $2: see the Autoconf documentation" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: section \"Present But Cannot Be Compiled\"" >&5 +$as_echo "$as_me: WARNING: $2: section \"Present But Cannot Be Compiled\"" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5 +$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;} + ;; +esac + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + eval "$3=\$ac_header_compiler" +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_header_mongrel +cat >config.log <<_ACEOF +This file contains any messages produced by compilers while +running configure, to aid debugging if configure makes a mistake. + +It was created by tclxml $as_me 3.2, which was +generated by GNU Autoconf 2.69. Invocation command line was + + $ $0 $@ + +_ACEOF +exec 5>>config.log +{ +cat <<_ASUNAME +## --------- ## +## Platform. ## +## --------- ## + +hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` +uname -m = `(uname -m) 2>/dev/null || echo unknown` +uname -r = `(uname -r) 2>/dev/null || echo unknown` +uname -s = `(uname -s) 2>/dev/null || echo unknown` +uname -v = `(uname -v) 2>/dev/null || echo unknown` + +/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` +/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` + +/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` +/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` +/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` +/usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown` +/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` +/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` +/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` + +_ASUNAME + +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + $as_echo "PATH: $as_dir" + done +IFS=$as_save_IFS + +} >&5 + +cat >&5 <<_ACEOF + + +## ----------- ## +## Core tests. ## +## ----------- ## + +_ACEOF + + +# Keep a trace of the command line. +# Strip out --no-create and --no-recursion so they do not pile up. +# Strip out --silent because we don't want to record it for future runs. +# Also quote any args containing shell meta-characters. +# Make two passes to allow for proper duplicate-argument suppression. +ac_configure_args= +ac_configure_args0= +ac_configure_args1= +ac_must_keep_next=false +for ac_pass in 1 2 +do + for ac_arg + do + case $ac_arg in + -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + continue ;; + *\'*) + ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; + esac + case $ac_pass in + 1) as_fn_append ac_configure_args0 " '$ac_arg'" ;; + 2) + as_fn_append ac_configure_args1 " '$ac_arg'" + if test $ac_must_keep_next = true; then + ac_must_keep_next=false # Got value, back to normal. + else + case $ac_arg in + *=* | --config-cache | -C | -disable-* | --disable-* \ + | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ + | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ + | -with-* | --with-* | -without-* | --without-* | --x) + case "$ac_configure_args0 " in + "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; + esac + ;; + -* ) ac_must_keep_next=true ;; + esac + fi + as_fn_append ac_configure_args " '$ac_arg'" + ;; + esac + done +done +{ ac_configure_args0=; unset ac_configure_args0;} +{ ac_configure_args1=; unset ac_configure_args1;} + +# When interrupted or exit'd, cleanup temporary files, and complete +# config.log. We remove comments because anyway the quotes in there +# would cause problems or look ugly. +# WARNING: Use '\'' to represent an apostrophe within the trap. +# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. +trap 'exit_status=$? + # Save into config.log some information that might help in debugging. + { + echo + + $as_echo "## ---------------- ## +## Cache variables. ## +## ---------------- ##" + echo + # The following way of writing the cache mishandles newlines in values, +( + for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do + eval ac_val=\$$ac_var + case $ac_val in #( + *${as_nl}*) + case $ac_var in #( + *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 +$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( + *) { eval $ac_var=; unset $ac_var;} ;; + esac ;; + esac + done + (set) 2>&1 | + case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #( + *${as_nl}ac_space=\ *) + sed -n \ + "s/'\''/'\''\\\\'\'''\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p" + ;; #( + *) + sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" + ;; + esac | + sort +) + echo + + $as_echo "## ----------------- ## +## Output variables. ## +## ----------------- ##" + echo + for ac_var in $ac_subst_vars + do + eval ac_val=\$$ac_var + case $ac_val in + *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + esac + $as_echo "$ac_var='\''$ac_val'\''" + done | sort + echo + + if test -n "$ac_subst_files"; then + $as_echo "## ------------------- ## +## File substitutions. ## +## ------------------- ##" + echo + for ac_var in $ac_subst_files + do + eval ac_val=\$$ac_var + case $ac_val in + *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + esac + $as_echo "$ac_var='\''$ac_val'\''" + done | sort + echo + fi + + if test -s confdefs.h; then + $as_echo "## ----------- ## +## confdefs.h. ## +## ----------- ##" + echo + cat confdefs.h + echo + fi + test "$ac_signal" != 0 && + $as_echo "$as_me: caught signal $ac_signal" + $as_echo "$as_me: exit $exit_status" + } >&5 + rm -f core *.core core.conftest.* && + rm -f -r conftest* confdefs* conf$$* $ac_clean_files && + exit $exit_status +' 0 +for ac_signal in 1 2 13 15; do + trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal +done +ac_signal=0 + +# confdefs.h avoids OS command line length limits that DEFS can exceed. +rm -f -r conftest* confdefs.h + +$as_echo "/* confdefs.h */" > confdefs.h + +# Predefined preprocessor variables. + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_NAME "$PACKAGE_NAME" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_TARNAME "$PACKAGE_TARNAME" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_VERSION "$PACKAGE_VERSION" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_STRING "$PACKAGE_STRING" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_URL "$PACKAGE_URL" +_ACEOF + + +# Let the site file select an alternate cache file if it wants to. +# Prefer an explicitly selected file to automatically selected ones. +ac_site_file1=NONE +ac_site_file2=NONE +if test -n "$CONFIG_SITE"; then + # We do not want a PATH search for config.site. + case $CONFIG_SITE in #(( + -*) ac_site_file1=./$CONFIG_SITE;; + */*) ac_site_file1=$CONFIG_SITE;; + *) ac_site_file1=./$CONFIG_SITE;; + esac +elif test "x$prefix" != xNONE; then + ac_site_file1=$prefix/share/config.site + ac_site_file2=$prefix/etc/config.site +else + ac_site_file1=$ac_default_prefix/share/config.site + ac_site_file2=$ac_default_prefix/etc/config.site +fi +for ac_site_file in "$ac_site_file1" "$ac_site_file2" +do + test "x$ac_site_file" = xNONE && continue + if test /dev/null != "$ac_site_file" && test -r "$ac_site_file"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5 +$as_echo "$as_me: loading site script $ac_site_file" >&6;} + sed 's/^/| /' "$ac_site_file" >&5 + . "$ac_site_file" \ + || { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "failed to load site script $ac_site_file +See \`config.log' for more details" "$LINENO" 5; } + fi +done + +if test -r "$cache_file"; then + # Some versions of bash will fail to source /dev/null (special files + # actually), so we avoid doing that. DJGPP emulates it as a regular file. + if test /dev/null != "$cache_file" && test -f "$cache_file"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5 +$as_echo "$as_me: loading cache $cache_file" >&6;} + case $cache_file in + [\\/]* | ?:[\\/]* ) . "$cache_file";; + *) . "./$cache_file";; + esac + fi +else + { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5 +$as_echo "$as_me: creating cache $cache_file" >&6;} + >$cache_file +fi + +# Check that the precious variables saved in the cache have kept the same +# value. +ac_cache_corrupted=false +for ac_var in $ac_precious_vars; do + eval ac_old_set=\$ac_cv_env_${ac_var}_set + eval ac_new_set=\$ac_env_${ac_var}_set + eval ac_old_val=\$ac_cv_env_${ac_var}_value + eval ac_new_val=\$ac_env_${ac_var}_value + case $ac_old_set,$ac_new_set in + set,) + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 +$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,set) + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5 +$as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,);; + *) + if test "x$ac_old_val" != "x$ac_new_val"; then + # differences in whitespace do not lead to failure. + ac_old_val_w=`echo x $ac_old_val` + ac_new_val_w=`echo x $ac_new_val` + if test "$ac_old_val_w" != "$ac_new_val_w"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5 +$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} + ac_cache_corrupted=: + else + { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5 +$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;} + eval $ac_var=\$ac_old_val + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: former value: \`$ac_old_val'" >&5 +$as_echo "$as_me: former value: \`$ac_old_val'" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: current value: \`$ac_new_val'" >&5 +$as_echo "$as_me: current value: \`$ac_new_val'" >&2;} + fi;; + esac + # Pass precious variables to config.status. + if test "$ac_new_set" = set; then + case $ac_new_val in + *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; + *) ac_arg=$ac_var=$ac_new_val ;; + esac + case " $ac_configure_args " in + *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. + *) as_fn_append ac_configure_args " '$ac_arg'" ;; + esac + fi +done +if $ac_cache_corrupted; then + { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5 +$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;} + as_fn_error $? "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5 +fi +## -------------------- ## +## Main body of script. ## +## -------------------- ## + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + + +#-------------------------------------------------------------------- +# Call TEA_INIT as the first TEA_ macro to set up initial vars. +# This will define a ${TEA_PLATFORM} variable == "unix" or "windows" +# as well as PKG_LIB_FILE and PKG_STUB_LIB_FILE. +#-------------------------------------------------------------------- + + + # TEA extensions pass this us the version of TEA they think they + # are compatible with. + TEA_VERSION="3.10" + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for correct TEA configuration" >&5 +$as_echo_n "checking for correct TEA configuration... " >&6; } + if test x"${PACKAGE_NAME}" = x ; then + as_fn_error $? " +The PACKAGE_NAME variable must be defined by your TEA configure.ac" "$LINENO" 5 + fi + if test x"3.10" = x ; then + as_fn_error $? " +TEA version not specified." "$LINENO" 5 + elif test "3.10" != "${TEA_VERSION}" ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: warning: requested TEA version \"3.10\", have \"${TEA_VERSION}\"" >&5 +$as_echo "warning: requested TEA version \"3.10\", have \"${TEA_VERSION}\"" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: ok (TEA ${TEA_VERSION})" >&5 +$as_echo "ok (TEA ${TEA_VERSION})" >&6; } + fi + + # If the user did not set CFLAGS, set it now to keep macros + # like AC_PROG_CC and AC_TRY_COMPILE from adding "-g -O2". + if test "${CFLAGS+set}" != "set" ; then + CFLAGS="" + fi + TEA_TK_EXTENSION=0 + + case "`uname -s`" in + *win32*|*WIN32*|*MINGW32_*) + # Extract the first word of "cygpath", so it can be a program name with args. +set dummy cygpath; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CYGPATH+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CYGPATH"; then + ac_cv_prog_CYGPATH="$CYGPATH" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CYGPATH="cygpath -m" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + test -z "$ac_cv_prog_CYGPATH" && ac_cv_prog_CYGPATH="echo" +fi +fi +CYGPATH=$ac_cv_prog_CYGPATH +if test -n "$CYGPATH"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CYGPATH" >&5 +$as_echo "$CYGPATH" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + EXEEXT=".exe" + TEA_PLATFORM="windows" + ;; + *CYGWIN_*) + EXEEXT=".exe" + # CYGPATH and TEA_PLATFORM are determined later in LOAD_TCLCONFIG + ;; + *) + CYGPATH=echo + # Maybe we are cross-compiling.... + case ${host_alias} in + *mingw32*) + EXEEXT=".exe" + TEA_PLATFORM="windows" + ;; + *) + EXEEXT="" + TEA_PLATFORM="unix" + ;; + esac + ;; + esac + + # Check if exec_prefix is set. If not use fall back to prefix. + # Note when adjusted, so that TEA_PREFIX can correct for this. + # This is needed for recursive configures, since autoconf propagates + # $prefix, but not $exec_prefix (doh!). + if test x$exec_prefix = xNONE ; then + exec_prefix_default=yes + exec_prefix=$prefix + fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: configuring ${PACKAGE_NAME} ${PACKAGE_VERSION}" >&5 +$as_echo "$as_me: configuring ${PACKAGE_NAME} ${PACKAGE_VERSION}" >&6;} + + + + + # This package name must be replaced statically for AC_SUBST to work + + # Substitute STUB_LIB_FILE in case package creates a stub library too. + + + # We AC_SUBST these here to ensure they are subst'ed, + # in case the user doesn't call TEA_ADD_... + + + + + + + + + +ac_aux_dir= +for ac_dir in tclconfig "$srcdir"/tclconfig; do + if test -f "$ac_dir/install-sh"; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/install-sh -c" + break + elif test -f "$ac_dir/install.sh"; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/install.sh -c" + break + elif test -f "$ac_dir/shtool"; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/shtool install -c" + break + fi +done +if test -z "$ac_aux_dir"; then + as_fn_error $? "cannot find install-sh, install.sh, or shtool in tclconfig \"$srcdir\"/tclconfig" "$LINENO" 5 +fi + +# These three variables are undocumented and unsupported, +# and are intended to be withdrawn in a future Autoconf release. +# They can cause serious problems if a builder's source tree is in a directory +# whose full name contains unusual characters. +ac_config_guess="$SHELL $ac_aux_dir/config.guess" # Please don't use this var. +ac_config_sub="$SHELL $ac_aux_dir/config.sub" # Please don't use this var. +ac_configure="$SHELL $ac_aux_dir/configure" # Please don't use this var. + + + +#-------------------------------------------------------------------- +# Load the tclConfig.sh file +#-------------------------------------------------------------------- + + + + # + # Ok, lets find the tcl configuration + # First, look for one uninstalled. + # the alternative search directory is invoked by --with-tcl + # + + if test x"${no_tcl}" = x ; then + # we reset no_tcl in case something fails here + no_tcl=true + +# Check whether --with-tcl was given. +if test "${with_tcl+set}" = set; then : + withval=$with_tcl; with_tclconfig="${withval}" +fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Tcl configuration" >&5 +$as_echo_n "checking for Tcl configuration... " >&6; } + if ${ac_cv_c_tclconfig+:} false; then : + $as_echo_n "(cached) " >&6 +else + + + # First check to see if --with-tcl was specified. + if test x"${with_tclconfig}" != x ; then + case "${with_tclconfig}" in + */tclConfig.sh ) + if test -f "${with_tclconfig}"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: --with-tcl argument should refer to directory containing tclConfig.sh, not to tclConfig.sh itself" >&5 +$as_echo "$as_me: WARNING: --with-tcl argument should refer to directory containing tclConfig.sh, not to tclConfig.sh itself" >&2;} + with_tclconfig="`echo "${with_tclconfig}" | sed 's!/tclConfig\.sh$!!'`" + fi ;; + esac + if test -f "${with_tclconfig}/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd "${with_tclconfig}"; pwd)`" + else + as_fn_error $? "${with_tclconfig} directory doesn't contain tclConfig.sh" "$LINENO" 5 + fi + fi + + # then check for a private Tcl installation + if test x"${ac_cv_c_tclconfig}" = x ; then + for i in \ + ../tcl \ + `ls -dr ../tcl[8-9].[0-9].[0-9]* 2>/dev/null` \ + `ls -dr ../tcl[8-9].[0-9] 2>/dev/null` \ + `ls -dr ../tcl[8-9].[0-9]* 2>/dev/null` \ + ../../tcl \ + `ls -dr ../../tcl[8-9].[0-9].[0-9]* 2>/dev/null` \ + `ls -dr ../../tcl[8-9].[0-9] 2>/dev/null` \ + `ls -dr ../../tcl[8-9].[0-9]* 2>/dev/null` \ + ../../../tcl \ + `ls -dr ../../../tcl[8-9].[0-9].[0-9]* 2>/dev/null` \ + `ls -dr ../../../tcl[8-9].[0-9] 2>/dev/null` \ + `ls -dr ../../../tcl[8-9].[0-9]* 2>/dev/null` ; do + if test "${TEA_PLATFORM}" = "windows" \ + -a -f "$i/win/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd $i/win; pwd)`" + break + fi + if test -f "$i/unix/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd $i/unix; pwd)`" + break + fi + done + fi + + # on Darwin, check in Framework installation locations + if test "`uname -s`" = "Darwin" -a x"${ac_cv_c_tclconfig}" = x ; then + for i in `ls -d ~/Library/Frameworks 2>/dev/null` \ + `ls -d /Library/Frameworks 2>/dev/null` \ + `ls -d /Network/Library/Frameworks 2>/dev/null` \ + `ls -d /System/Library/Frameworks 2>/dev/null` \ + ; do + if test -f "$i/Tcl.framework/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd $i/Tcl.framework; pwd)`" + break + fi + done + fi + + # TEA specific: on Windows, check in common installation locations + if test "${TEA_PLATFORM}" = "windows" \ + -a x"${ac_cv_c_tclconfig}" = x ; then + for i in `ls -d C:/Tcl/lib 2>/dev/null` \ + `ls -d C:/Progra~1/Tcl/lib 2>/dev/null` \ + ; do + if test -f "$i/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd $i; pwd)`" + break + fi + done + fi + + # check in a few common install locations + if test x"${ac_cv_c_tclconfig}" = x ; then + for i in `ls -d ${libdir} 2>/dev/null` \ + `ls -d ${exec_prefix}/lib 2>/dev/null` \ + `ls -d ${prefix}/lib 2>/dev/null` \ + `ls -d /usr/contrib/lib 2>/dev/null` \ + `ls -d /usr/local/lib 2>/dev/null` \ + `ls -d /usr/pkg/lib 2>/dev/null` \ + `ls -d /usr/lib 2>/dev/null` \ + `ls -d /usr/lib64 2>/dev/null` \ + `ls -d /usr/lib/tcl8.6 2>/dev/null` \ + `ls -d /usr/lib/tcl8.5 2>/dev/null` \ + ; do + if test -f "$i/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd $i; pwd)`" + break + fi + done + fi + + # check in a few other private locations + if test x"${ac_cv_c_tclconfig}" = x ; then + for i in \ + ${srcdir}/../tcl \ + `ls -dr ${srcdir}/../tcl[8-9].[0-9].[0-9]* 2>/dev/null` \ + `ls -dr ${srcdir}/../tcl[8-9].[0-9] 2>/dev/null` \ + `ls -dr ${srcdir}/../tcl[8-9].[0-9]* 2>/dev/null` ; do + if test "${TEA_PLATFORM}" = "windows" \ + -a -f "$i/win/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd $i/win; pwd)`" + break + fi + if test -f "$i/unix/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd $i/unix; pwd)`" + break + fi + done + fi + +fi + + + if test x"${ac_cv_c_tclconfig}" = x ; then + TCL_BIN_DIR="# no Tcl configs found" + as_fn_error $? "Can't find Tcl configuration definitions. Use --with-tcl to specify a directory containing tclConfig.sh" "$LINENO" 5 + else + no_tcl= + TCL_BIN_DIR="${ac_cv_c_tclconfig}" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: found ${TCL_BIN_DIR}/tclConfig.sh" >&5 +$as_echo "found ${TCL_BIN_DIR}/tclConfig.sh" >&6; } + fi + fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. +set dummy ${ac_tool_prefix}gcc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="${ac_tool_prefix}gcc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_CC"; then + ac_ct_CC=$CC + # Extract the first word of "gcc", so it can be a program name with args. +set dummy gcc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="gcc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +$as_echo "$ac_ct_CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +else + CC="$ac_cv_prog_CC" +fi + +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. +set dummy ${ac_tool_prefix}cc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="${ac_tool_prefix}cc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + fi +fi +if test -z "$CC"; then + # Extract the first word of "cc", so it can be a program name with args. +set dummy cc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else + ac_prog_rejected=no +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then + ac_prog_rejected=yes + continue + fi + ac_cv_prog_CC="cc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +if test $ac_prog_rejected = yes; then + # We found a bogon in the path, so make sure we never use it. + set dummy $ac_cv_prog_CC + shift + if test $# != 0; then + # We chose a different compiler from the bogus one. + # However, it has the same basename, so the bogon will be chosen + # first if we set CC to just the basename; use the full file name. + shift + ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@" + fi +fi +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + for ac_prog in cl.exe + do + # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. +set dummy $ac_tool_prefix$ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="$ac_tool_prefix$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$CC" && break + done +fi +if test -z "$CC"; then + ac_ct_CC=$CC + for ac_prog in cl.exe +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +$as_echo "$ac_ct_CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$ac_ct_CC" && break +done + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +fi + +fi + + +test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "no acceptable C compiler found in \$PATH +See \`config.log' for more details" "$LINENO" 5; } + +# Provide some information about the compiler. +$as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5 +set X $ac_compile +ac_compiler=$2 +for ac_option in --version -v -V -qversion; do + { { ac_try="$ac_compiler $ac_option >&5" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compiler $ac_option >&5") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + sed '10a\ +... rest of stderr output deleted ... + 10q' conftest.err >conftest.er1 + cat conftest.er1 >&5 + fi + rm -f conftest.er1 conftest.err + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } +done + +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +ac_clean_files_save=$ac_clean_files +ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out" +# Try to create an executable without -o first, disregard a.out. +# It will help us diagnose broken compilers, and finding out an intuition +# of exeext. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5 +$as_echo_n "checking whether the C compiler works... " >&6; } +ac_link_default=`$as_echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` + +# The possible output files: +ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*" + +ac_rmfiles= +for ac_file in $ac_files +do + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; + * ) ac_rmfiles="$ac_rmfiles $ac_file";; + esac +done +rm -f $ac_rmfiles + +if { { ac_try="$ac_link_default" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link_default") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then : + # Autoconf-2.13 could set the ac_cv_exeext variable to `no'. +# So ignore a value of `no', otherwise this would lead to `EXEEXT = no' +# in a Makefile. We should not override ac_cv_exeext if it was cached, +# so that the user can short-circuit this test for compilers unknown to +# Autoconf. +for ac_file in $ac_files '' +do + test -f "$ac_file" || continue + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) + ;; + [ab].out ) + # We found the default executable, but exeext='' is most + # certainly right. + break;; + *.* ) + if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no; + then :; else + ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` + fi + # We set ac_cv_exeext here because the later test for it is not + # safe: cross compilers may not add the suffix if given an `-o' + # argument, so we may need to know it at that point already. + # Even if this section looks crufty: it has the advantage of + # actually working. + break;; + * ) + break;; + esac +done +test "$ac_cv_exeext" = no && ac_cv_exeext= + +else + ac_file='' +fi +if test -z "$ac_file"; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +$as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error 77 "C compiler cannot create executables +See \`config.log' for more details" "$LINENO" 5; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5 +$as_echo_n "checking for C compiler default output file name... " >&6; } +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5 +$as_echo "$ac_file" >&6; } +ac_exeext=$ac_cv_exeext + +rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out +ac_clean_files=$ac_clean_files_save +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5 +$as_echo_n "checking for suffix of executables... " >&6; } +if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then : + # If both `conftest.exe' and `conftest' are `present' (well, observable) +# catch `conftest.exe'. For instance with Cygwin, `ls conftest' will +# work properly (i.e., refer to `conftest.exe'), while it won't with +# `rm'. +for ac_file in conftest.exe conftest conftest.*; do + test -f "$ac_file" || continue + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; + *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` + break;; + * ) break;; + esac +done +else + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot compute suffix of executables: cannot compile and link +See \`config.log' for more details" "$LINENO" 5; } +fi +rm -f conftest conftest$ac_cv_exeext +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5 +$as_echo "$ac_cv_exeext" >&6; } + +rm -f conftest.$ac_ext +EXEEXT=$ac_cv_exeext +ac_exeext=$EXEEXT +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +int +main () +{ +FILE *f = fopen ("conftest.out", "w"); + return ferror (f) || fclose (f) != 0; + + ; + return 0; +} +_ACEOF +ac_clean_files="$ac_clean_files conftest.out" +# Check that the compiler produces executables we can run. If not, either +# the compiler is broken, or we cross compile. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5 +$as_echo_n "checking whether we are cross compiling... " >&6; } +if test "$cross_compiling" != yes; then + { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + if { ac_try='./conftest$ac_cv_exeext' + { { case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; }; then + cross_compiling=no + else + if test "$cross_compiling" = maybe; then + cross_compiling=yes + else + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run C compiled programs. +If you meant to cross compile, use \`--host'. +See \`config.log' for more details" "$LINENO" 5; } + fi + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5 +$as_echo "$cross_compiling" >&6; } + +rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out +ac_clean_files=$ac_clean_files_save +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5 +$as_echo_n "checking for suffix of object files... " >&6; } +if ${ac_cv_objext+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +rm -f conftest.o conftest.obj +if { { ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compile") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then : + for ac_file in conftest.o conftest.obj conftest.*; do + test -f "$ac_file" || continue; + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;; + *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` + break;; + esac +done +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot compute suffix of object files: cannot compile +See \`config.log' for more details" "$LINENO" 5; } +fi +rm -f conftest.$ac_cv_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5 +$as_echo "$ac_cv_objext" >&6; } +OBJEXT=$ac_cv_objext +ac_objext=$OBJEXT +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5 +$as_echo_n "checking whether we are using the GNU C compiler... " >&6; } +if ${ac_cv_c_compiler_gnu+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ +#ifndef __GNUC__ + choke me +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_compiler_gnu=yes +else + ac_compiler_gnu=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +ac_cv_c_compiler_gnu=$ac_compiler_gnu + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5 +$as_echo "$ac_cv_c_compiler_gnu" >&6; } +if test $ac_compiler_gnu = yes; then + GCC=yes +else + GCC= +fi +ac_test_CFLAGS=${CFLAGS+set} +ac_save_CFLAGS=$CFLAGS +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5 +$as_echo_n "checking whether $CC accepts -g... " >&6; } +if ${ac_cv_prog_cc_g+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_save_c_werror_flag=$ac_c_werror_flag + ac_c_werror_flag=yes + ac_cv_prog_cc_g=no + CFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_g=yes +else + CFLAGS="" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + +else + ac_c_werror_flag=$ac_save_c_werror_flag + CFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_g=yes +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + ac_c_werror_flag=$ac_save_c_werror_flag +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5 +$as_echo "$ac_cv_prog_cc_g" >&6; } +if test "$ac_test_CFLAGS" = set; then + CFLAGS=$ac_save_CFLAGS +elif test $ac_cv_prog_cc_g = yes; then + if test "$GCC" = yes; then + CFLAGS="-g -O2" + else + CFLAGS="-g" + fi +else + if test "$GCC" = yes; then + CFLAGS="-O2" + else + CFLAGS= + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5 +$as_echo_n "checking for $CC option to accept ISO C89... " >&6; } +if ${ac_cv_prog_cc_c89+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_cv_prog_cc_c89=no +ac_save_CC=$CC +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +#include +struct stat; +/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ +struct buf { int x; }; +FILE * (*rcsopen) (struct buf *, struct stat *, int); +static char *e (p, i) + char **p; + int i; +{ + return p[i]; +} +static char *f (char * (*g) (char **, int), char **p, ...) +{ + char *s; + va_list v; + va_start (v,p); + s = g (p, va_arg (v,int)); + va_end (v); + return s; +} + +/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has + function prototypes and stuff, but not '\xHH' hex character constants. + These don't provoke an error unfortunately, instead are silently treated + as 'x'. The following induces an error, until -std is added to get + proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an + array size at least. It's necessary to write '\x00'==0 to get something + that's true only with -std. */ +int osf4_cc_array ['\x00' == 0 ? 1 : -1]; + +/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters + inside strings and character constants. */ +#define FOO(x) 'x' +int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1]; + +int test (int i, double x); +struct s1 {int (*f) (int a);}; +struct s2 {int (*f) (double a);}; +int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); +int argc; +char **argv; +int +main () +{ +return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; + ; + return 0; +} +_ACEOF +for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \ + -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" +do + CC="$ac_save_CC $ac_arg" + if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_c89=$ac_arg +fi +rm -f core conftest.err conftest.$ac_objext + test "x$ac_cv_prog_cc_c89" != "xno" && break +done +rm -f conftest.$ac_ext +CC=$ac_save_CC + +fi +# AC_CACHE_VAL +case "x$ac_cv_prog_cc_c89" in + x) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +$as_echo "none needed" >&6; } ;; + xno) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +$as_echo "unsupported" >&6; } ;; + *) + CC="$CC $ac_cv_prog_cc_c89" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 +$as_echo "$ac_cv_prog_cc_c89" >&6; } ;; +esac +if test "x$ac_cv_prog_cc_c89" != xno; then : + +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for existence of ${TCL_BIN_DIR}/tclConfig.sh" >&5 +$as_echo_n "checking for existence of ${TCL_BIN_DIR}/tclConfig.sh... " >&6; } + + if test -f "${TCL_BIN_DIR}/tclConfig.sh" ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: loading" >&5 +$as_echo "loading" >&6; } + . "${TCL_BIN_DIR}/tclConfig.sh" + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: could not find ${TCL_BIN_DIR}/tclConfig.sh" >&5 +$as_echo "could not find ${TCL_BIN_DIR}/tclConfig.sh" >&6; } + fi + + # eval is required to do the TCL_DBGX substitution + eval "TCL_LIB_FILE=\"${TCL_LIB_FILE}\"" + eval "TCL_STUB_LIB_FILE=\"${TCL_STUB_LIB_FILE}\"" + + # If the TCL_BIN_DIR is the build directory (not the install directory), + # then set the common variable name to the value of the build variables. + # For example, the variable TCL_LIB_SPEC will be set to the value + # of TCL_BUILD_LIB_SPEC. An extension should make use of TCL_LIB_SPEC + # instead of TCL_BUILD_LIB_SPEC since it will work with both an + # installed and uninstalled version of Tcl. + if test -f "${TCL_BIN_DIR}/Makefile" ; then + TCL_LIB_SPEC="${TCL_BUILD_LIB_SPEC}" + TCL_STUB_LIB_SPEC="${TCL_BUILD_STUB_LIB_SPEC}" + TCL_STUB_LIB_PATH="${TCL_BUILD_STUB_LIB_PATH}" + elif test "`uname -s`" = "Darwin"; then + # If Tcl was built as a framework, attempt to use the libraries + # from the framework at the given location so that linking works + # against Tcl.framework installed in an arbitrary location. + case ${TCL_DEFS} in + *TCL_FRAMEWORK*) + if test -f "${TCL_BIN_DIR}/${TCL_LIB_FILE}"; then + for i in "`cd "${TCL_BIN_DIR}"; pwd`" \ + "`cd "${TCL_BIN_DIR}"/../..; pwd`"; do + if test "`basename "$i"`" = "${TCL_LIB_FILE}.framework"; then + TCL_LIB_SPEC="-F`dirname "$i" | sed -e 's/ /\\\\ /g'` -framework ${TCL_LIB_FILE}" + break + fi + done + fi + if test -f "${TCL_BIN_DIR}/${TCL_STUB_LIB_FILE}"; then + TCL_STUB_LIB_SPEC="-L`echo "${TCL_BIN_DIR}" | sed -e 's/ /\\\\ /g'` ${TCL_STUB_LIB_FLAG}" + TCL_STUB_LIB_PATH="${TCL_BIN_DIR}/${TCL_STUB_LIB_FILE}" + fi + ;; + esac + fi + + # eval is required to do the TCL_DBGX substitution + eval "TCL_LIB_FLAG=\"${TCL_LIB_FLAG}\"" + eval "TCL_LIB_SPEC=\"${TCL_LIB_SPEC}\"" + eval "TCL_STUB_LIB_FLAG=\"${TCL_STUB_LIB_FLAG}\"" + eval "TCL_STUB_LIB_SPEC=\"${TCL_STUB_LIB_SPEC}\"" + + + + + + + + + + + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking platform" >&5 +$as_echo_n "checking platform... " >&6; } + hold_cc=$CC; CC="$TCL_CC" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + #ifdef _WIN32 + #error win32 + #endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + + TEA_PLATFORM="unix" + CYGPATH=echo + +else + + TEA_PLATFORM="windows" + # Extract the first word of "cygpath", so it can be a program name with args. +set dummy cygpath; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CYGPATH+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CYGPATH"; then + ac_cv_prog_CYGPATH="$CYGPATH" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CYGPATH="cygpath -m" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + test -z "$ac_cv_prog_CYGPATH" && ac_cv_prog_CYGPATH="echo" +fi +fi +CYGPATH=$ac_cv_prog_CYGPATH +if test -n "$CYGPATH"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CYGPATH" >&5 +$as_echo "$CYGPATH" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + CC=$hold_cc + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $TEA_PLATFORM" >&5 +$as_echo "$TEA_PLATFORM" >&6; } + + # The BUILD_$pkg is to define the correct extern storage class + # handling when making this package + +cat >>confdefs.h <<_ACEOF +#define BUILD_${PACKAGE_NAME} /**/ +_ACEOF + + # Do this here as we have fully defined TEA_PLATFORM now + if test "${TEA_PLATFORM}" = "windows" ; then + EXEEXT=".exe" + CLEANFILES="$CLEANFILES *.lib *.dll *.pdb *.exp" + fi + + # TEA specific: + + + + + + + + +#-------------------------------------------------------------------- +# Load the tkConfig.sh file if necessary (Tk extension) +#-------------------------------------------------------------------- + +#TEA_PATH_TKCONFIG +#TEA_LOAD_TKCONFIG + +#----------------------------------------------------------------------- +# Handle the --prefix=... option by defaulting to what Tcl gave. +# Must be called after TEA_LOAD_TCLCONFIG and before TEA_SETUP_COMPILER. +#----------------------------------------------------------------------- + + + if test "${prefix}" = "NONE"; then + prefix_default=yes + if test x"${TCL_PREFIX}" != x; then + { $as_echo "$as_me:${as_lineno-$LINENO}: --prefix defaulting to TCL_PREFIX ${TCL_PREFIX}" >&5 +$as_echo "$as_me: --prefix defaulting to TCL_PREFIX ${TCL_PREFIX}" >&6;} + prefix=${TCL_PREFIX} + else + { $as_echo "$as_me:${as_lineno-$LINENO}: --prefix defaulting to /usr/local" >&5 +$as_echo "$as_me: --prefix defaulting to /usr/local" >&6;} + prefix=/usr/local + fi + fi + if test "${exec_prefix}" = "NONE" -a x"${prefix_default}" = x"yes" \ + -o x"${exec_prefix_default}" = x"yes" ; then + if test x"${TCL_EXEC_PREFIX}" != x; then + { $as_echo "$as_me:${as_lineno-$LINENO}: --exec-prefix defaulting to TCL_EXEC_PREFIX ${TCL_EXEC_PREFIX}" >&5 +$as_echo "$as_me: --exec-prefix defaulting to TCL_EXEC_PREFIX ${TCL_EXEC_PREFIX}" >&6;} + exec_prefix=${TCL_EXEC_PREFIX} + else + { $as_echo "$as_me:${as_lineno-$LINENO}: --exec-prefix defaulting to ${prefix}" >&5 +$as_echo "$as_me: --exec-prefix defaulting to ${prefix}" >&6;} + exec_prefix=$prefix + fi + fi + + +#----------------------------------------------------------------------- +# Standard compiler checks. +# This sets up CC by using the CC env var, or looks for gcc otherwise. +# This also calls AC_PROG_CC and a few others to create the basic setup +# necessary to compile executables. +#----------------------------------------------------------------------- + + + # Don't put any macros that use the compiler (e.g. AC_TRY_COMPILE) + # in this macro, they need to go into TEA_SETUP_COMPILER instead. + + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. +set dummy ${ac_tool_prefix}gcc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="${ac_tool_prefix}gcc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_CC"; then + ac_ct_CC=$CC + # Extract the first word of "gcc", so it can be a program name with args. +set dummy gcc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="gcc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +$as_echo "$ac_ct_CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +else + CC="$ac_cv_prog_CC" +fi + +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. +set dummy ${ac_tool_prefix}cc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="${ac_tool_prefix}cc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + fi +fi +if test -z "$CC"; then + # Extract the first word of "cc", so it can be a program name with args. +set dummy cc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else + ac_prog_rejected=no +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then + ac_prog_rejected=yes + continue + fi + ac_cv_prog_CC="cc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +if test $ac_prog_rejected = yes; then + # We found a bogon in the path, so make sure we never use it. + set dummy $ac_cv_prog_CC + shift + if test $# != 0; then + # We chose a different compiler from the bogus one. + # However, it has the same basename, so the bogon will be chosen + # first if we set CC to just the basename; use the full file name. + shift + ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@" + fi +fi +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + for ac_prog in cl.exe + do + # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. +set dummy $ac_tool_prefix$ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="$ac_tool_prefix$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$CC" && break + done +fi +if test -z "$CC"; then + ac_ct_CC=$CC + for ac_prog in cl.exe +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +$as_echo "$ac_ct_CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$ac_ct_CC" && break +done + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +fi + +fi + + +test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "no acceptable C compiler found in \$PATH +See \`config.log' for more details" "$LINENO" 5; } + +# Provide some information about the compiler. +$as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5 +set X $ac_compile +ac_compiler=$2 +for ac_option in --version -v -V -qversion; do + { { ac_try="$ac_compiler $ac_option >&5" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compiler $ac_option >&5") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + sed '10a\ +... rest of stderr output deleted ... + 10q' conftest.err >conftest.er1 + cat conftest.er1 >&5 + fi + rm -f conftest.er1 conftest.err + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } +done + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5 +$as_echo_n "checking whether we are using the GNU C compiler... " >&6; } +if ${ac_cv_c_compiler_gnu+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ +#ifndef __GNUC__ + choke me +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_compiler_gnu=yes +else + ac_compiler_gnu=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +ac_cv_c_compiler_gnu=$ac_compiler_gnu + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5 +$as_echo "$ac_cv_c_compiler_gnu" >&6; } +if test $ac_compiler_gnu = yes; then + GCC=yes +else + GCC= +fi +ac_test_CFLAGS=${CFLAGS+set} +ac_save_CFLAGS=$CFLAGS +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5 +$as_echo_n "checking whether $CC accepts -g... " >&6; } +if ${ac_cv_prog_cc_g+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_save_c_werror_flag=$ac_c_werror_flag + ac_c_werror_flag=yes + ac_cv_prog_cc_g=no + CFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_g=yes +else + CFLAGS="" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + +else + ac_c_werror_flag=$ac_save_c_werror_flag + CFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_g=yes +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + ac_c_werror_flag=$ac_save_c_werror_flag +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5 +$as_echo "$ac_cv_prog_cc_g" >&6; } +if test "$ac_test_CFLAGS" = set; then + CFLAGS=$ac_save_CFLAGS +elif test $ac_cv_prog_cc_g = yes; then + if test "$GCC" = yes; then + CFLAGS="-g -O2" + else + CFLAGS="-g" + fi +else + if test "$GCC" = yes; then + CFLAGS="-O2" + else + CFLAGS= + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5 +$as_echo_n "checking for $CC option to accept ISO C89... " >&6; } +if ${ac_cv_prog_cc_c89+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_cv_prog_cc_c89=no +ac_save_CC=$CC +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +#include +struct stat; +/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ +struct buf { int x; }; +FILE * (*rcsopen) (struct buf *, struct stat *, int); +static char *e (p, i) + char **p; + int i; +{ + return p[i]; +} +static char *f (char * (*g) (char **, int), char **p, ...) +{ + char *s; + va_list v; + va_start (v,p); + s = g (p, va_arg (v,int)); + va_end (v); + return s; +} + +/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has + function prototypes and stuff, but not '\xHH' hex character constants. + These don't provoke an error unfortunately, instead are silently treated + as 'x'. The following induces an error, until -std is added to get + proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an + array size at least. It's necessary to write '\x00'==0 to get something + that's true only with -std. */ +int osf4_cc_array ['\x00' == 0 ? 1 : -1]; + +/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters + inside strings and character constants. */ +#define FOO(x) 'x' +int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1]; + +int test (int i, double x); +struct s1 {int (*f) (int a);}; +struct s2 {int (*f) (double a);}; +int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); +int argc; +char **argv; +int +main () +{ +return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; + ; + return 0; +} +_ACEOF +for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \ + -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" +do + CC="$ac_save_CC $ac_arg" + if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_c89=$ac_arg +fi +rm -f core conftest.err conftest.$ac_objext + test "x$ac_cv_prog_cc_c89" != "xno" && break +done +rm -f conftest.$ac_ext +CC=$ac_save_CC + +fi +# AC_CACHE_VAL +case "x$ac_cv_prog_cc_c89" in + x) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +$as_echo "none needed" >&6; } ;; + xno) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +$as_echo "unsupported" >&6; } ;; + *) + CC="$CC $ac_cv_prog_cc_c89" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 +$as_echo "$ac_cv_prog_cc_c89" >&6; } ;; +esac +if test "x$ac_cv_prog_cc_c89" != xno; then : + +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5 +$as_echo_n "checking how to run the C preprocessor... " >&6; } +# On Suns, sometimes $CPP names a directory. +if test -n "$CPP" && test -d "$CPP"; then + CPP= +fi +if test -z "$CPP"; then + if ${ac_cv_prog_CPP+:} false; then : + $as_echo_n "(cached) " >&6 +else + # Double quotes because CPP needs to be expanded + for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp" + do + ac_preproc_ok=false +for ac_c_preproc_warn_flag in '' yes +do + # Use a header file that comes with gcc, so configuring glibc + # with a fresh cross-compiler works. + # Prefer to if __STDC__ is defined, since + # exists even on freestanding compilers. + # On the NeXT, cc -E runs the code through the compiler's parser, + # not just through cpp. "Syntax error" is here to catch this case. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifdef __STDC__ +# include +#else +# include +#endif + Syntax error +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + +else + # Broken: fails on valid input. +continue +fi +rm -f conftest.err conftest.i conftest.$ac_ext + + # OK, works on sane cases. Now check whether nonexistent headers + # can be detected and how. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + # Broken: success on invalid input. +continue +else + # Passes both tests. +ac_preproc_ok=: +break +fi +rm -f conftest.err conftest.i conftest.$ac_ext + +done +# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +rm -f conftest.i conftest.err conftest.$ac_ext +if $ac_preproc_ok; then : + break +fi + + done + ac_cv_prog_CPP=$CPP + +fi + CPP=$ac_cv_prog_CPP +else + ac_cv_prog_CPP=$CPP +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5 +$as_echo "$CPP" >&6; } +ac_preproc_ok=false +for ac_c_preproc_warn_flag in '' yes +do + # Use a header file that comes with gcc, so configuring glibc + # with a fresh cross-compiler works. + # Prefer to if __STDC__ is defined, since + # exists even on freestanding compilers. + # On the NeXT, cc -E runs the code through the compiler's parser, + # not just through cpp. "Syntax error" is here to catch this case. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifdef __STDC__ +# include +#else +# include +#endif + Syntax error +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + +else + # Broken: fails on valid input. +continue +fi +rm -f conftest.err conftest.i conftest.$ac_ext + + # OK, works on sane cases. Now check whether nonexistent headers + # can be detected and how. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + # Broken: success on invalid input. +continue +else + # Passes both tests. +ac_preproc_ok=: +break +fi +rm -f conftest.err conftest.i conftest.$ac_ext + +done +# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +rm -f conftest.i conftest.err conftest.$ac_ext +if $ac_preproc_ok; then : + +else + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "C preprocessor \"$CPP\" fails sanity check +See \`config.log' for more details" "$LINENO" 5; } +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + + INSTALL='$(SHELL) $(srcdir)/tclconfig/install-sh -c' + INSTALL_DATA_DIR='${INSTALL} -d -m 755' + INSTALL_DATA='${INSTALL} -m 644' + INSTALL_PROGRAM='${INSTALL}' + INSTALL_SCRIPT='${INSTALL}' + INSTALL_LIBRARY='${INSTALL_DATA}' + + + + + + + + + #-------------------------------------------------------------------- + # Checks to see if the make program sets the $MAKE variable. + #-------------------------------------------------------------------- + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ${MAKE-make} sets \$(MAKE)" >&5 +$as_echo_n "checking whether ${MAKE-make} sets \$(MAKE)... " >&6; } +set x ${MAKE-make} +ac_make=`$as_echo "$2" | sed 's/+/p/g; s/[^a-zA-Z0-9_]/_/g'` +if eval \${ac_cv_prog_make_${ac_make}_set+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat >conftest.make <<\_ACEOF +SHELL = /bin/sh +all: + @echo '@@@%%%=$(MAKE)=@@@%%%' +_ACEOF +# GNU make sometimes prints "make[1]: Entering ...", which would confuse us. +case `${MAKE-make} -f conftest.make 2>/dev/null` in + *@@@%%%=?*=@@@%%%*) + eval ac_cv_prog_make_${ac_make}_set=yes;; + *) + eval ac_cv_prog_make_${ac_make}_set=no;; +esac +rm -f conftest.make +fi +if eval test \$ac_cv_prog_make_${ac_make}_set = yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + SET_MAKE= +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + SET_MAKE="MAKE=${MAKE-make}" +fi + + + #-------------------------------------------------------------------- + # Find ranlib + #-------------------------------------------------------------------- + + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args. +set dummy ${ac_tool_prefix}ranlib; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_RANLIB+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$RANLIB"; then + ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +RANLIB=$ac_cv_prog_RANLIB +if test -n "$RANLIB"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RANLIB" >&5 +$as_echo "$RANLIB" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_RANLIB"; then + ac_ct_RANLIB=$RANLIB + # Extract the first word of "ranlib", so it can be a program name with args. +set dummy ranlib; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_RANLIB+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_RANLIB"; then + ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_RANLIB="ranlib" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB +if test -n "$ac_ct_RANLIB"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RANLIB" >&5 +$as_echo "$ac_ct_RANLIB" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_RANLIB" = x; then + RANLIB="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + RANLIB=$ac_ct_RANLIB + fi +else + RANLIB="$ac_cv_prog_RANLIB" +fi + + + #-------------------------------------------------------------------- + # Determines the correct binary file extension (.o, .obj, .exe etc.) + #-------------------------------------------------------------------- + + + + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5 +$as_echo_n "checking for grep that handles long lines and -e... " >&6; } +if ${ac_cv_path_GREP+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -z "$GREP"; then + ac_path_GREP_found=false + # Loop through the user's path and test for each of PROGNAME-LIST + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in grep ggrep; do + for ac_exec_ext in '' $ac_executable_extensions; do + ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext" + as_fn_executable_p "$ac_path_GREP" || continue +# Check for GNU ac_path_GREP and select it if it is found. + # Check for GNU $ac_path_GREP +case `"$ac_path_GREP" --version 2>&1` in +*GNU*) + ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;; +*) + ac_count=0 + $as_echo_n 0123456789 >"conftest.in" + while : + do + cat "conftest.in" "conftest.in" >"conftest.tmp" + mv "conftest.tmp" "conftest.in" + cp "conftest.in" "conftest.nl" + $as_echo 'GREP' >> "conftest.nl" + "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break + diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break + as_fn_arith $ac_count + 1 && ac_count=$as_val + if test $ac_count -gt ${ac_path_GREP_max-0}; then + # Best one so far, save it but keep looking for a better one + ac_cv_path_GREP="$ac_path_GREP" + ac_path_GREP_max=$ac_count + fi + # 10*(2^10) chars as input seems more than enough + test $ac_count -gt 10 && break + done + rm -f conftest.in conftest.tmp conftest.nl conftest.out;; +esac + + $ac_path_GREP_found && break 3 + done + done + done +IFS=$as_save_IFS + if test -z "$ac_cv_path_GREP"; then + as_fn_error $? "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 + fi +else + ac_cv_path_GREP=$GREP +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_GREP" >&5 +$as_echo "$ac_cv_path_GREP" >&6; } + GREP="$ac_cv_path_GREP" + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5 +$as_echo_n "checking for egrep... " >&6; } +if ${ac_cv_path_EGREP+:} false; then : + $as_echo_n "(cached) " >&6 +else + if echo a | $GREP -E '(a|b)' >/dev/null 2>&1 + then ac_cv_path_EGREP="$GREP -E" + else + if test -z "$EGREP"; then + ac_path_EGREP_found=false + # Loop through the user's path and test for each of PROGNAME-LIST + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in egrep; do + for ac_exec_ext in '' $ac_executable_extensions; do + ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext" + as_fn_executable_p "$ac_path_EGREP" || continue +# Check for GNU ac_path_EGREP and select it if it is found. + # Check for GNU $ac_path_EGREP +case `"$ac_path_EGREP" --version 2>&1` in +*GNU*) + ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;; +*) + ac_count=0 + $as_echo_n 0123456789 >"conftest.in" + while : + do + cat "conftest.in" "conftest.in" >"conftest.tmp" + mv "conftest.tmp" "conftest.in" + cp "conftest.in" "conftest.nl" + $as_echo 'EGREP' >> "conftest.nl" + "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break + diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break + as_fn_arith $ac_count + 1 && ac_count=$as_val + if test $ac_count -gt ${ac_path_EGREP_max-0}; then + # Best one so far, save it but keep looking for a better one + ac_cv_path_EGREP="$ac_path_EGREP" + ac_path_EGREP_max=$ac_count + fi + # 10*(2^10) chars as input seems more than enough + test $ac_count -gt 10 && break + done + rm -f conftest.in conftest.tmp conftest.nl conftest.out;; +esac + + $ac_path_EGREP_found && break 3 + done + done + done +IFS=$as_save_IFS + if test -z "$ac_cv_path_EGREP"; then + as_fn_error $? "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 + fi +else + ac_cv_path_EGREP=$EGREP +fi + + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5 +$as_echo "$ac_cv_path_EGREP" >&6; } + EGREP="$ac_cv_path_EGREP" + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5 +$as_echo_n "checking for ANSI C header files... " >&6; } +if ${ac_cv_header_stdc+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +#include +#include +#include + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_header_stdc=yes +else + ac_cv_header_stdc=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + +if test $ac_cv_header_stdc = yes; then + # SunOS 4.x string.h does not declare mem*, contrary to ANSI. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "memchr" >/dev/null 2>&1; then : + +else + ac_cv_header_stdc=no +fi +rm -f conftest* + +fi + +if test $ac_cv_header_stdc = yes; then + # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "free" >/dev/null 2>&1; then : + +else + ac_cv_header_stdc=no +fi +rm -f conftest* + +fi + +if test $ac_cv_header_stdc = yes; then + # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. + if test "$cross_compiling" = yes; then : + : +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +#include +#if ((' ' & 0x0FF) == 0x020) +# define ISLOWER(c) ('a' <= (c) && (c) <= 'z') +# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) +#else +# define ISLOWER(c) \ + (('a' <= (c) && (c) <= 'i') \ + || ('j' <= (c) && (c) <= 'r') \ + || ('s' <= (c) && (c) <= 'z')) +# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c)) +#endif + +#define XOR(e, f) (((e) && !(f)) || (!(e) && (f))) +int +main () +{ + int i; + for (i = 0; i < 256; i++) + if (XOR (islower (i), ISLOWER (i)) + || toupper (i) != TOUPPER (i)) + return 2; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + +else + ac_cv_header_stdc=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdc" >&5 +$as_echo "$ac_cv_header_stdc" >&6; } +if test $ac_cv_header_stdc = yes; then + +$as_echo "#define STDC_HEADERS 1" >>confdefs.h + +fi + +# On IRIX 5.3, sys/types and inttypes.h are conflicting. +for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \ + inttypes.h stdint.h unistd.h +do : + as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` +ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default +" +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF + +fi + +done + + + + # Any macros that use the compiler (e.g. AC_TRY_COMPILE) have to go here. + + + #------------------------------------------------------------------------ + # If we're using GCC, see if the compiler understands -pipe. If so, use it. + # It makes compiling go faster. (This is only a performance feature.) + #------------------------------------------------------------------------ + + if test -z "$no_pipe" -a -n "$GCC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if the compiler understands -pipe" >&5 +$as_echo_n "checking if the compiler understands -pipe... " >&6; } +if ${tcl_cv_cc_pipe+:} false; then : + $as_echo_n "(cached) " >&6 +else + + hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -pipe" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_cc_pipe=yes +else + tcl_cv_cc_pipe=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + CFLAGS=$hold_cflags +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_pipe" >&5 +$as_echo "$tcl_cv_cc_pipe" >&6; } + if test $tcl_cv_cc_pipe = yes; then + CFLAGS="$CFLAGS -pipe" + fi + fi + + #-------------------------------------------------------------------- + # Common compiler flag setup + #-------------------------------------------------------------------- + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether byte ordering is bigendian" >&5 +$as_echo_n "checking whether byte ordering is bigendian... " >&6; } +if ${ac_cv_c_bigendian+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_cv_c_bigendian=unknown + # See if we're dealing with a universal compiler. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifndef __APPLE_CC__ + not a universal capable compiler + #endif + typedef int dummy; + +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + + # Check for potential -arch flags. It is not universal unless + # there are at least two -arch flags with different values. + ac_arch= + ac_prev= + for ac_word in $CC $CFLAGS $CPPFLAGS $LDFLAGS; do + if test -n "$ac_prev"; then + case $ac_word in + i?86 | x86_64 | ppc | ppc64) + if test -z "$ac_arch" || test "$ac_arch" = "$ac_word"; then + ac_arch=$ac_word + else + ac_cv_c_bigendian=universal + break + fi + ;; + esac + ac_prev= + elif test "x$ac_word" = "x-arch"; then + ac_prev=arch + fi + done +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + if test $ac_cv_c_bigendian = unknown; then + # See if sys/param.h defines the BYTE_ORDER macro. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + #include + +int +main () +{ +#if ! (defined BYTE_ORDER && defined BIG_ENDIAN \ + && defined LITTLE_ENDIAN && BYTE_ORDER && BIG_ENDIAN \ + && LITTLE_ENDIAN) + bogus endian macros + #endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + # It does; now see whether it defined to BIG_ENDIAN or not. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + #include + +int +main () +{ +#if BYTE_ORDER != BIG_ENDIAN + not big endian + #endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_c_bigendian=yes +else + ac_cv_c_bigendian=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + fi + if test $ac_cv_c_bigendian = unknown; then + # See if defines _LITTLE_ENDIAN or _BIG_ENDIAN (e.g., Solaris). + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + +int +main () +{ +#if ! (defined _LITTLE_ENDIAN || defined _BIG_ENDIAN) + bogus endian macros + #endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + # It does; now see whether it defined to _BIG_ENDIAN or not. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + +int +main () +{ +#ifndef _BIG_ENDIAN + not big endian + #endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_c_bigendian=yes +else + ac_cv_c_bigendian=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + fi + if test $ac_cv_c_bigendian = unknown; then + # Compile a test program. + if test "$cross_compiling" = yes; then : + # Try to guess by grepping values from an object file. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +short int ascii_mm[] = + { 0x4249, 0x4765, 0x6E44, 0x6961, 0x6E53, 0x7953, 0 }; + short int ascii_ii[] = + { 0x694C, 0x5454, 0x656C, 0x6E45, 0x6944, 0x6E61, 0 }; + int use_ascii (int i) { + return ascii_mm[i] + ascii_ii[i]; + } + short int ebcdic_ii[] = + { 0x89D3, 0xE3E3, 0x8593, 0x95C5, 0x89C4, 0x9581, 0 }; + short int ebcdic_mm[] = + { 0xC2C9, 0xC785, 0x95C4, 0x8981, 0x95E2, 0xA8E2, 0 }; + int use_ebcdic (int i) { + return ebcdic_mm[i] + ebcdic_ii[i]; + } + extern int foo; + +int +main () +{ +return use_ascii (foo) == use_ebcdic (foo); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + if grep BIGenDianSyS conftest.$ac_objext >/dev/null; then + ac_cv_c_bigendian=yes + fi + if grep LiTTleEnDian conftest.$ac_objext >/dev/null ; then + if test "$ac_cv_c_bigendian" = unknown; then + ac_cv_c_bigendian=no + else + # finding both strings is unlikely to happen, but who knows? + ac_cv_c_bigendian=unknown + fi + fi +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$ac_includes_default +int +main () +{ + + /* Are we little or big endian? From Harbison&Steele. */ + union + { + long int l; + char c[sizeof (long int)]; + } u; + u.l = 1; + return u.c[sizeof (long int) - 1] == 1; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + ac_cv_c_bigendian=no +else + ac_cv_c_bigendian=yes +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_bigendian" >&5 +$as_echo "$ac_cv_c_bigendian" >&6; } + case $ac_cv_c_bigendian in #( + yes) + $as_echo "#define WORDS_BIGENDIAN 1" >>confdefs.h +;; #( + no) + ;; #( + universal) + +$as_echo "#define AC_APPLE_UNIVERSAL_BUILD 1" >>confdefs.h + + ;; #( + *) + as_fn_error $? "unknown endianness + presetting ac_cv_c_bigendian=no (or yes) will help" "$LINENO" 5 ;; + esac + + if test "${TEA_PLATFORM}" = "unix" ; then + + #-------------------------------------------------------------------- + # On a few very rare systems, all of the libm.a stuff is + # already in libc.a. Set compiler flags accordingly. + # Also, Linux requires the "ieee" library for math to work + # right (and it must appear before "-lm"). + #-------------------------------------------------------------------- + + ac_fn_c_check_func "$LINENO" "sin" "ac_cv_func_sin" +if test "x$ac_cv_func_sin" = xyes; then : + MATH_LIBS="" +else + MATH_LIBS="-lm" +fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -lieee" >&5 +$as_echo_n "checking for main in -lieee... " >&6; } +if ${ac_cv_lib_ieee_main+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lieee $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + +int +main () +{ +return main (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_ieee_main=yes +else + ac_cv_lib_ieee_main=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_ieee_main" >&5 +$as_echo "$ac_cv_lib_ieee_main" >&6; } +if test "x$ac_cv_lib_ieee_main" = xyes; then : + MATH_LIBS="-lieee $MATH_LIBS" +fi + + + #-------------------------------------------------------------------- + # Interactive UNIX requires -linet instead of -lsocket, plus it + # needs net/errno.h to define the socket-related error codes. + #-------------------------------------------------------------------- + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -linet" >&5 +$as_echo_n "checking for main in -linet... " >&6; } +if ${ac_cv_lib_inet_main+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-linet $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + +int +main () +{ +return main (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_inet_main=yes +else + ac_cv_lib_inet_main=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_inet_main" >&5 +$as_echo "$ac_cv_lib_inet_main" >&6; } +if test "x$ac_cv_lib_inet_main" = xyes; then : + LIBS="$LIBS -linet" +fi + + ac_fn_c_check_header_mongrel "$LINENO" "net/errno.h" "ac_cv_header_net_errno_h" "$ac_includes_default" +if test "x$ac_cv_header_net_errno_h" = xyes; then : + + +$as_echo "#define HAVE_NET_ERRNO_H 1" >>confdefs.h + +fi + + + + #-------------------------------------------------------------------- + # Check for the existence of the -lsocket and -lnsl libraries. + # The order here is important, so that they end up in the right + # order in the command line generated by make. Here are some + # special considerations: + # 1. Use "connect" and "accept" to check for -lsocket, and + # "gethostbyname" to check for -lnsl. + # 2. Use each function name only once: can't redo a check because + # autoconf caches the results of the last check and won't redo it. + # 3. Use -lnsl and -lsocket only if they supply procedures that + # aren't already present in the normal libraries. This is because + # IRIX 5.2 has libraries, but they aren't needed and they're + # bogus: they goof up name resolution if used. + # 4. On some SVR4 systems, can't use -lsocket without -lnsl too. + # To get around this problem, check for both libraries together + # if -lsocket doesn't work by itself. + #-------------------------------------------------------------------- + + tcl_checkBoth=0 + ac_fn_c_check_func "$LINENO" "connect" "ac_cv_func_connect" +if test "x$ac_cv_func_connect" = xyes; then : + tcl_checkSocket=0 +else + tcl_checkSocket=1 +fi + + if test "$tcl_checkSocket" = 1; then + ac_fn_c_check_func "$LINENO" "setsockopt" "ac_cv_func_setsockopt" +if test "x$ac_cv_func_setsockopt" = xyes; then : + +else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for setsockopt in -lsocket" >&5 +$as_echo_n "checking for setsockopt in -lsocket... " >&6; } +if ${ac_cv_lib_socket_setsockopt+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lsocket $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char setsockopt (); +int +main () +{ +return setsockopt (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_socket_setsockopt=yes +else + ac_cv_lib_socket_setsockopt=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_socket_setsockopt" >&5 +$as_echo "$ac_cv_lib_socket_setsockopt" >&6; } +if test "x$ac_cv_lib_socket_setsockopt" = xyes; then : + LIBS="$LIBS -lsocket" +else + tcl_checkBoth=1 +fi + +fi + + fi + if test "$tcl_checkBoth" = 1; then + tk_oldLibs=$LIBS + LIBS="$LIBS -lsocket -lnsl" + ac_fn_c_check_func "$LINENO" "accept" "ac_cv_func_accept" +if test "x$ac_cv_func_accept" = xyes; then : + tcl_checkNsl=0 +else + LIBS=$tk_oldLibs +fi + + fi + ac_fn_c_check_func "$LINENO" "gethostbyname" "ac_cv_func_gethostbyname" +if test "x$ac_cv_func_gethostbyname" = xyes; then : + +else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gethostbyname in -lnsl" >&5 +$as_echo_n "checking for gethostbyname in -lnsl... " >&6; } +if ${ac_cv_lib_nsl_gethostbyname+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lnsl $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char gethostbyname (); +int +main () +{ +return gethostbyname (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_nsl_gethostbyname=yes +else + ac_cv_lib_nsl_gethostbyname=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_nsl_gethostbyname" >&5 +$as_echo "$ac_cv_lib_nsl_gethostbyname" >&6; } +if test "x$ac_cv_lib_nsl_gethostbyname" = xyes; then : + LIBS="$LIBS -lnsl" +fi + +fi + + + # TEA specific: Don't perform the eval of the libraries here because + # DL_LIBS won't be set until we call TEA_CONFIG_CFLAGS + + TCL_LIBS='${DL_LIBS} ${LIBS} ${MATH_LIBS}' + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking dirent.h" >&5 +$as_echo_n "checking dirent.h... " >&6; } +if ${tcl_cv_dirent_h+:} false; then : + $as_echo_n "(cached) " >&6 +else + + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +#include +int +main () +{ + +#ifndef _POSIX_SOURCE +# ifdef __Lynx__ + /* + * Generate compilation error to make the test fail: Lynx headers + * are only valid if really in the POSIX environment. + */ + + missing_procedure(); +# endif +#endif +DIR *d; +struct dirent *entryPtr; +char *p; +d = opendir("foobar"); +entryPtr = readdir(d); +p = entryPtr->d_name; +closedir(d); + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + tcl_cv_dirent_h=yes +else + tcl_cv_dirent_h=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_dirent_h" >&5 +$as_echo "$tcl_cv_dirent_h" >&6; } + + if test $tcl_cv_dirent_h = no; then + +$as_echo "#define NO_DIRENT_H 1" >>confdefs.h + + fi + + # TEA specific: + ac_fn_c_check_header_mongrel "$LINENO" "errno.h" "ac_cv_header_errno_h" "$ac_includes_default" +if test "x$ac_cv_header_errno_h" = xyes; then : + +else + +$as_echo "#define NO_ERRNO_H 1" >>confdefs.h + +fi + + + ac_fn_c_check_header_mongrel "$LINENO" "float.h" "ac_cv_header_float_h" "$ac_includes_default" +if test "x$ac_cv_header_float_h" = xyes; then : + +else + +$as_echo "#define NO_FLOAT_H 1" >>confdefs.h + +fi + + + ac_fn_c_check_header_mongrel "$LINENO" "values.h" "ac_cv_header_values_h" "$ac_includes_default" +if test "x$ac_cv_header_values_h" = xyes; then : + +else + +$as_echo "#define NO_VALUES_H 1" >>confdefs.h + +fi + + + ac_fn_c_check_header_mongrel "$LINENO" "limits.h" "ac_cv_header_limits_h" "$ac_includes_default" +if test "x$ac_cv_header_limits_h" = xyes; then : + +$as_echo "#define HAVE_LIMITS_H 1" >>confdefs.h + +else + +$as_echo "#define NO_LIMITS_H 1" >>confdefs.h + +fi + + + ac_fn_c_check_header_mongrel "$LINENO" "stdlib.h" "ac_cv_header_stdlib_h" "$ac_includes_default" +if test "x$ac_cv_header_stdlib_h" = xyes; then : + tcl_ok=1 +else + tcl_ok=0 +fi + + + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "strtol" >/dev/null 2>&1; then : + +else + tcl_ok=0 +fi +rm -f conftest* + + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "strtoul" >/dev/null 2>&1; then : + +else + tcl_ok=0 +fi +rm -f conftest* + + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "strtod" >/dev/null 2>&1; then : + +else + tcl_ok=0 +fi +rm -f conftest* + + if test $tcl_ok = 0; then + +$as_echo "#define NO_STDLIB_H 1" >>confdefs.h + + fi + ac_fn_c_check_header_mongrel "$LINENO" "string.h" "ac_cv_header_string_h" "$ac_includes_default" +if test "x$ac_cv_header_string_h" = xyes; then : + tcl_ok=1 +else + tcl_ok=0 +fi + + + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "strstr" >/dev/null 2>&1; then : + +else + tcl_ok=0 +fi +rm -f conftest* + + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "strerror" >/dev/null 2>&1; then : + +else + tcl_ok=0 +fi +rm -f conftest* + + + # See also memmove check below for a place where NO_STRING_H can be + # set and why. + + if test $tcl_ok = 0; then + +$as_echo "#define NO_STRING_H 1" >>confdefs.h + + fi + + ac_fn_c_check_header_mongrel "$LINENO" "sys/wait.h" "ac_cv_header_sys_wait_h" "$ac_includes_default" +if test "x$ac_cv_header_sys_wait_h" = xyes; then : + +else + +$as_echo "#define NO_SYS_WAIT_H 1" >>confdefs.h + +fi + + + ac_fn_c_check_header_mongrel "$LINENO" "dlfcn.h" "ac_cv_header_dlfcn_h" "$ac_includes_default" +if test "x$ac_cv_header_dlfcn_h" = xyes; then : + +else + +$as_echo "#define NO_DLFCN_H 1" >>confdefs.h + +fi + + + + # OS/390 lacks sys/param.h (and doesn't need it, by chance). + for ac_header in sys/param.h +do : + ac_fn_c_check_header_mongrel "$LINENO" "sys/param.h" "ac_cv_header_sys_param_h" "$ac_includes_default" +if test "x$ac_cv_header_sys_param_h" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_SYS_PARAM_H 1 +_ACEOF + +fi + +done + + + # Let the user call this, because if it triggers, they will + # need a compat/strtod.c that is correct. Users can also + # use Tcl_GetDouble(FromObj) instead. + #TEA_BUGGY_STRTOD + fi + + +#----------------------------------------------------------------------- +# __CHANGE__ +# Specify the C source files to compile in TEA_ADD_SOURCES, +# public headers that need to be installed in TEA_ADD_HEADERS, +# stub library C source files to compile in TEA_ADD_STUB_SOURCES, +# and runtime Tcl library files in TEA_ADD_TCL_SOURCES. +# This defines PKG(_STUB)_SOURCES, PKG(_STUB)_OBJECTS, PKG_HEADERS +# and PKG_TCL_SOURCES. +#----------------------------------------------------------------------- + + + vars="tclxml.c docObj.c tclxml-libxml2.c nodeObj.c tcldom-libxml2.c tclxslt-libxslt.c" + for i in $vars; do + case $i in + \$*) + # allow $-var names + PKG_SOURCES="$PKG_SOURCES $i" + PKG_OBJECTS="$PKG_OBJECTS $i" + ;; + *) + # check for existence - allows for generic/win/unix VPATH + # To add more dirs here (like 'src'), you have to update VPATH + # in Makefile.in as well + if test ! -f "${srcdir}/$i" -a ! -f "${srcdir}/generic/$i" \ + -a ! -f "${srcdir}/win/$i" -a ! -f "${srcdir}/unix/$i" \ + -a ! -f "${srcdir}/macosx/$i" \ + ; then + as_fn_error $? "could not find source file '$i'" "$LINENO" 5 + fi + PKG_SOURCES="$PKG_SOURCES $i" + # this assumes it is in a VPATH dir + i=`basename $i` + # handle user calling this before or after TEA_SETUP_COMPILER + if test x"${OBJEXT}" != x ; then + j="`echo $i | sed -e 's/\.[^.]*$//'`.${OBJEXT}" + else + j="`echo $i | sed -e 's/\.[^.]*$//'`.\${OBJEXT}" + fi + PKG_OBJECTS="$PKG_OBJECTS $j" + ;; + esac + done + + + + + vars="include/tclxml-libxml2/docObj.h include/tclxml-libxml2/tclxml-libxml2.h include/tcldom/tcldom.h include/tcldom-libxml2/tcldom-libxml2.h include/tclxslt/tclxslt.h" + for i in $vars; do + # check for existence, be strict because it is installed + if test ! -f "${srcdir}/$i" ; then + as_fn_error $? "could not find header file '${srcdir}/$i'" "$LINENO" 5 + fi + PKG_HEADERS="$PKG_HEADERS $i" + done + + + + vars="-I./include" + for i in $vars; do + PKG_INCLUDES="$PKG_INCLUDES $i" + done + + + + vars="" + for i in $vars; do + if test "${TEA_PLATFORM}" = "windows" -a "$GCC" = "yes" ; then + case $i in + *.lib) + # Convert foo.lib to -lfoo for GCC + i=-l`echo "$i" | sed -e 's/\.[^.]*$//' -e 's/\.lib.*//'` + ;; + esac + fi + PKG_LIBS="$PKG_LIBS $i" + done + + + + PKG_CFLAGS="$PKG_CFLAGS " + + + + vars="tclxmlStubInit.c tclxmlStubLib.c" + for i in $vars; do + # check for existence - allows for generic/win/unix VPATH + if test ! -f "${srcdir}/$i" -a ! -f "${srcdir}/generic/$i" \ + -a ! -f "${srcdir}/win/$i" -a ! -f "${srcdir}/unix/$i" \ + -a ! -f "${srcdir}/macosx/$i" \ + ; then + as_fn_error $? "could not find stub source file '$i'" "$LINENO" 5 + fi + PKG_STUB_SOURCES="$PKG_STUB_SOURCES $i" + # this assumes it is in a VPATH dir + i=`basename $i` + # handle user calling this before or after TEA_SETUP_COMPILER + if test x"${OBJEXT}" != x ; then + j="`echo $i | sed -e 's/\.[^.]*$//'`.${OBJEXT}" + else + j="`echo $i | sed -e 's/\.[^.]*$//'`.\${OBJEXT}" + fi + PKG_STUB_OBJECTS="$PKG_STUB_OBJECTS $j" + done + + + + + vars="tclxml-tcl/xml__tcl.tcl tclxml-tcl/sgml-8.0.tcl tclxml-tcl/sgml-8.1.tcl tclxml-tcl/xml-8.0.tcl tclxml-tcl/xml-8.1.tcl tclxml-tcl/sgmlparser.tcl tclxml-tcl/tclparser-8.0.tcl tclxml-tcl/tclparser-8.1.tcl tclxml-tcl/xmldep.tcl tclxml-tcl/xpath.tcl tcldom-libxml2.tcl tcldom-tcl/xmlswitch.tcl tclxslt/process.tcl tclxslt/resources.tcl tclxslt/utilities.tcl tclxslt/xsltcache.tcl tclxslt-libxslt.tcl" + for i in $vars; do + # check for existence, be strict because it is installed + if test ! -f "${srcdir}/$i" ; then + as_fn_error $? "could not find tcl source file '${srcdir}/$i'" "$LINENO" 5 + fi + PKG_TCL_SOURCES="$PKG_TCL_SOURCES $i" + done + + + +#-------------------------------------------------------------------- +# __CHANGE__ +# +# You can add more files to clean if your extension creates any extra +# files by extending CLEANFILES. +# Add pkgIndex.tcl if it is generated in the Makefile instead of ./configure +# and change Makefile.in to move it from CONFIG_CLEAN_FILES to BINARIES var. +# +# A few miscellaneous platform-specific items: +# TEA_ADD_* any platform specific compiler/build info here. +#-------------------------------------------------------------------- + +#CLEANFILES="$CLEANFILES pkgIndex.tcl" +CLEANFILES="$CLEANFILES include/tclxml/tclxml.h" +if test "${TEA_PLATFORM}" = "windows" ; then + # Ensure no empty if clauses + : + #TEA_ADD_SOURCES([win/winFile.c]) + #TEA_ADD_INCLUDES([-I\"$(${CYGPATH} ${srcdir}/win)\"]) +else + # Ensure no empty else clauses + : + #TEA_ADD_SOURCES([unix/unixFile.c]) + #TEA_ADD_LIBS([-lsuperfly]) +fi + +#-------------------------------------------------------------------- +# __CHANGE__ +# Choose which headers you need. Extension authors should try very +# hard to only rely on the Tcl public header files. Internal headers +# contain private data structures and are subject to change without +# notice. +# This MUST be called after TEA_LOAD_TCLCONFIG / TEA_LOAD_TKCONFIG +#-------------------------------------------------------------------- + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Tcl public headers" >&5 +$as_echo_n "checking for Tcl public headers... " >&6; } + + +# Check whether --with-tclinclude was given. +if test "${with_tclinclude+set}" = set; then : + withval=$with_tclinclude; with_tclinclude=${withval} +fi + + + if ${ac_cv_c_tclh+:} false; then : + $as_echo_n "(cached) " >&6 +else + + # Use the value from --with-tclinclude, if it was given + + if test x"${with_tclinclude}" != x ; then + if test -f "${with_tclinclude}/tcl.h" ; then + ac_cv_c_tclh=${with_tclinclude} + else + as_fn_error $? "${with_tclinclude} directory does not contain tcl.h" "$LINENO" 5 + fi + else + list="" + if test "`uname -s`" = "Darwin"; then + # If Tcl was built as a framework, attempt to use + # the framework's Headers directory + case ${TCL_DEFS} in + *TCL_FRAMEWORK*) + list="`ls -d ${TCL_BIN_DIR}/Headers 2>/dev/null`" + ;; + esac + fi + + # Look in the source dir only if Tcl is not installed, + # and in that situation, look there before installed locations. + if test -f "${TCL_BIN_DIR}/Makefile" ; then + list="$list `ls -d ${TCL_SRC_DIR}/generic 2>/dev/null`" + fi + + # Check order: pkg --prefix location, Tcl's --prefix location, + # relative to directory of tclConfig.sh. + + eval "temp_includedir=${includedir}" + list="$list \ + `ls -d ${temp_includedir} 2>/dev/null` \ + `ls -d ${TCL_PREFIX}/include 2>/dev/null` \ + `ls -d ${TCL_BIN_DIR}/../include 2>/dev/null`" + if test "${TEA_PLATFORM}" != "windows" -o "$GCC" = "yes"; then + list="$list /usr/local/include /usr/include" + if test x"${TCL_INCLUDE_SPEC}" != x ; then + d=`echo "${TCL_INCLUDE_SPEC}" | sed -e 's/^-I//'` + list="$list `ls -d ${d} 2>/dev/null`" + fi + fi + for i in $list ; do + if test -f "$i/tcl.h" ; then + ac_cv_c_tclh=$i + break + fi + done + fi + +fi + + + # Print a message based on how we determined the include path + + if test x"${ac_cv_c_tclh}" = x ; then + as_fn_error $? "tcl.h not found. Please specify its location with --with-tclinclude" "$LINENO" 5 + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: ${ac_cv_c_tclh}" >&5 +$as_echo "${ac_cv_c_tclh}" >&6; } + fi + + # Convert to a native path and substitute into the output files. + + INCLUDE_DIR_NATIVE=`${CYGPATH} ${ac_cv_c_tclh}` + + TCL_INCLUDES=-I\"${INCLUDE_DIR_NATIVE}\" + + + +#TEA_PRIVATE_TCL_HEADERS + +#TEA_PUBLIC_TK_HEADERS +#TEA_PRIVATE_TK_HEADERS +#TEA_PATH_X + +#-------------------------------------------------------------------- +# Check whether --enable-threads or --disable-threads was given. +# This auto-enables if Tcl was compiled threaded. +#-------------------------------------------------------------------- + + + # Check whether --enable-threads was given. +if test "${enable_threads+set}" = set; then : + enableval=$enable_threads; tcl_ok=$enableval +else + tcl_ok=yes +fi + + + if test "${enable_threads+set}" = set; then + enableval="$enable_threads" + tcl_ok=$enableval + else + tcl_ok=yes + fi + + if test "$tcl_ok" = "yes" -o "${TCL_THREADS}" = 1; then + TCL_THREADS=1 + + if test "${TEA_PLATFORM}" != "windows" ; then + # We are always OK on Windows, so check what this platform wants: + + # USE_THREAD_ALLOC tells us to try the special thread-based + # allocator that significantly reduces lock contention + +$as_echo "#define USE_THREAD_ALLOC 1" >>confdefs.h + + +$as_echo "#define _REENTRANT 1" >>confdefs.h + + if test "`uname -s`" = "SunOS" ; then + +$as_echo "#define _POSIX_PTHREAD_SEMANTICS 1" >>confdefs.h + + fi + +$as_echo "#define _THREAD_SAFE 1" >>confdefs.h + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pthread_mutex_init in -lpthread" >&5 +$as_echo_n "checking for pthread_mutex_init in -lpthread... " >&6; } +if ${ac_cv_lib_pthread_pthread_mutex_init+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lpthread $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char pthread_mutex_init (); +int +main () +{ +return pthread_mutex_init (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_pthread_pthread_mutex_init=yes +else + ac_cv_lib_pthread_pthread_mutex_init=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pthread_pthread_mutex_init" >&5 +$as_echo "$ac_cv_lib_pthread_pthread_mutex_init" >&6; } +if test "x$ac_cv_lib_pthread_pthread_mutex_init" = xyes; then : + tcl_ok=yes +else + tcl_ok=no +fi + + if test "$tcl_ok" = "no"; then + # Check a little harder for __pthread_mutex_init in the same + # library, as some systems hide it there until pthread.h is + # defined. We could alternatively do an AC_TRY_COMPILE with + # pthread.h, but that will work with libpthread really doesn't + # exist, like AIX 4.2. [Bug: 4359] + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for __pthread_mutex_init in -lpthread" >&5 +$as_echo_n "checking for __pthread_mutex_init in -lpthread... " >&6; } +if ${ac_cv_lib_pthread___pthread_mutex_init+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lpthread $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char __pthread_mutex_init (); +int +main () +{ +return __pthread_mutex_init (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_pthread___pthread_mutex_init=yes +else + ac_cv_lib_pthread___pthread_mutex_init=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pthread___pthread_mutex_init" >&5 +$as_echo "$ac_cv_lib_pthread___pthread_mutex_init" >&6; } +if test "x$ac_cv_lib_pthread___pthread_mutex_init" = xyes; then : + tcl_ok=yes +else + tcl_ok=no +fi + + fi + + if test "$tcl_ok" = "yes"; then + # The space is needed + THREADS_LIBS=" -lpthread" + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pthread_mutex_init in -lpthreads" >&5 +$as_echo_n "checking for pthread_mutex_init in -lpthreads... " >&6; } +if ${ac_cv_lib_pthreads_pthread_mutex_init+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lpthreads $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char pthread_mutex_init (); +int +main () +{ +return pthread_mutex_init (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_pthreads_pthread_mutex_init=yes +else + ac_cv_lib_pthreads_pthread_mutex_init=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pthreads_pthread_mutex_init" >&5 +$as_echo "$ac_cv_lib_pthreads_pthread_mutex_init" >&6; } +if test "x$ac_cv_lib_pthreads_pthread_mutex_init" = xyes; then : + tcl_ok=yes +else + tcl_ok=no +fi + + if test "$tcl_ok" = "yes"; then + # The space is needed + THREADS_LIBS=" -lpthreads" + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pthread_mutex_init in -lc" >&5 +$as_echo_n "checking for pthread_mutex_init in -lc... " >&6; } +if ${ac_cv_lib_c_pthread_mutex_init+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lc $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char pthread_mutex_init (); +int +main () +{ +return pthread_mutex_init (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_c_pthread_mutex_init=yes +else + ac_cv_lib_c_pthread_mutex_init=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_pthread_mutex_init" >&5 +$as_echo "$ac_cv_lib_c_pthread_mutex_init" >&6; } +if test "x$ac_cv_lib_c_pthread_mutex_init" = xyes; then : + tcl_ok=yes +else + tcl_ok=no +fi + + if test "$tcl_ok" = "no"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pthread_mutex_init in -lc_r" >&5 +$as_echo_n "checking for pthread_mutex_init in -lc_r... " >&6; } +if ${ac_cv_lib_c_r_pthread_mutex_init+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lc_r $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char pthread_mutex_init (); +int +main () +{ +return pthread_mutex_init (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_c_r_pthread_mutex_init=yes +else + ac_cv_lib_c_r_pthread_mutex_init=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_r_pthread_mutex_init" >&5 +$as_echo "$ac_cv_lib_c_r_pthread_mutex_init" >&6; } +if test "x$ac_cv_lib_c_r_pthread_mutex_init" = xyes; then : + tcl_ok=yes +else + tcl_ok=no +fi + + if test "$tcl_ok" = "yes"; then + # The space is needed + THREADS_LIBS=" -pthread" + else + TCL_THREADS=0 + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Do not know how to find pthread lib on your system - thread support disabled" >&5 +$as_echo "$as_me: WARNING: Do not know how to find pthread lib on your system - thread support disabled" >&2;} + fi + fi + fi + fi + fi + else + TCL_THREADS=0 + fi + # Do checking message here to not mess up interleaved configure output + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for building with threads" >&5 +$as_echo_n "checking for building with threads... " >&6; } + if test "${TCL_THREADS}" = 1; then + +$as_echo "#define TCL_THREADS 1" >>confdefs.h + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes (default)" >&5 +$as_echo "yes (default)" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + fi + # TCL_THREADS sanity checking. See if our request for building with + # threads is the same as the way Tcl was built. If not, warn the user. + case ${TCL_DEFS} in + *THREADS=1*) + if test "${TCL_THREADS}" = "0"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: + Building ${PACKAGE_NAME} without threads enabled, but building against Tcl + that IS thread-enabled. It is recommended to use --enable-threads." >&5 +$as_echo "$as_me: WARNING: + Building ${PACKAGE_NAME} without threads enabled, but building against Tcl + that IS thread-enabled. It is recommended to use --enable-threads." >&2;} + fi + ;; + *) + if test "${TCL_THREADS}" = "1"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: + --enable-threads requested, but building against a Tcl that is NOT + thread-enabled. This is an OK configuration that will also run in + a thread-enabled core." >&5 +$as_echo "$as_me: WARNING: + --enable-threads requested, but building against a Tcl that is NOT + thread-enabled. This is an OK configuration that will also run in + a thread-enabled core." >&2;} + fi + ;; + esac + + + +#-------------------------------------------------------------------- +# The statement below defines a collection of symbols related to +# building as a shared library instead of a static library. +#-------------------------------------------------------------------- + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking how to build libraries" >&5 +$as_echo_n "checking how to build libraries... " >&6; } + # Check whether --enable-shared was given. +if test "${enable_shared+set}" = set; then : + enableval=$enable_shared; shared_ok=$enableval +else + shared_ok=yes +fi + + + if test "${enable_shared+set}" = set; then + enableval="$enable_shared" + shared_ok=$enableval + else + shared_ok=yes + fi + + # Check whether --enable-stubs was given. +if test "${enable_stubs+set}" = set; then : + enableval=$enable_stubs; stubs_ok=$enableval +else + stubs_ok=yes +fi + + + if test "${enable_stubs+set}" = set; then + enableval="$enable_stubs" + stubs_ok=$enableval + else + stubs_ok=yes + fi + + # Stubs are always enabled for shared builds + if test "$shared_ok" = "yes" ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: shared" >&5 +$as_echo "shared" >&6; } + SHARED_BUILD=1 + STUBS_BUILD=1 + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: static" >&5 +$as_echo "static" >&6; } + SHARED_BUILD=0 + +$as_echo "#define STATIC_BUILD 1" >>confdefs.h + + if test "$stubs_ok" = "yes" ; then + STUBS_BUILD=1 + else + STUBS_BUILD=0 + fi + fi + if test "${STUBS_BUILD}" = "1" ; then + +$as_echo "#define USE_TCL_STUBS 1" >>confdefs.h + + +$as_echo "#define USE_TCLOO_STUBS 1" >>confdefs.h + + if test "${TEA_WINDOWINGSYSTEM}" != ""; then + +$as_echo "#define USE_TK_STUBS 1" >>confdefs.h + + fi + fi + + + + + +#-------------------------------------------------------------------- +# This macro figures out what flags to use with the compiler/linker +# when building shared/static debug/optimized objects. This information +# can be taken from the tclConfig.sh file, but this figures it all out. +#-------------------------------------------------------------------- + +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args. +set dummy ${ac_tool_prefix}ranlib; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_RANLIB+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$RANLIB"; then + ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +RANLIB=$ac_cv_prog_RANLIB +if test -n "$RANLIB"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RANLIB" >&5 +$as_echo "$RANLIB" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_RANLIB"; then + ac_ct_RANLIB=$RANLIB + # Extract the first word of "ranlib", so it can be a program name with args. +set dummy ranlib; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_RANLIB+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_RANLIB"; then + ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_RANLIB="ranlib" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB +if test -n "$ac_ct_RANLIB"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RANLIB" >&5 +$as_echo "$ac_ct_RANLIB" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_RANLIB" = x; then + RANLIB=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + RANLIB=$ac_ct_RANLIB + fi +else + RANLIB="$ac_cv_prog_RANLIB" +fi + + + + + # Step 0.a: Enable 64 bit support? + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if 64bit support is requested" >&5 +$as_echo_n "checking if 64bit support is requested... " >&6; } + # Check whether --enable-64bit was given. +if test "${enable_64bit+set}" = set; then : + enableval=$enable_64bit; do64bit=$enableval +else + do64bit=no +fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $do64bit" >&5 +$as_echo "$do64bit" >&6; } + + # Step 0.b: Enable Solaris 64 bit VIS support? + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if 64bit Sparc VIS support is requested" >&5 +$as_echo_n "checking if 64bit Sparc VIS support is requested... " >&6; } + # Check whether --enable-64bit-vis was given. +if test "${enable_64bit_vis+set}" = set; then : + enableval=$enable_64bit_vis; do64bitVIS=$enableval +else + do64bitVIS=no +fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $do64bitVIS" >&5 +$as_echo "$do64bitVIS" >&6; } + # Force 64bit on with VIS + if test "$do64bitVIS" = "yes"; then : + do64bit=yes +fi + + # Step 0.c: Check if visibility support is available. Do this here so + # that platform specific alternatives can be used below if this fails. + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if compiler supports visibility \"hidden\"" >&5 +$as_echo_n "checking if compiler supports visibility \"hidden\"... " >&6; } +if ${tcl_cv_cc_visibility_hidden+:} false; then : + $as_echo_n "(cached) " >&6 +else + + hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + extern __attribute__((__visibility__("hidden"))) void f(void); + void f(void) {} +int +main () +{ +f(); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + tcl_cv_cc_visibility_hidden=yes +else + tcl_cv_cc_visibility_hidden=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + CFLAGS=$hold_cflags +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_visibility_hidden" >&5 +$as_echo "$tcl_cv_cc_visibility_hidden" >&6; } + if test $tcl_cv_cc_visibility_hidden = yes; then : + + +$as_echo "#define MODULE_SCOPE extern __attribute__((__visibility__(\"hidden\")))" >>confdefs.h + + +$as_echo "#define HAVE_HIDDEN 1" >>confdefs.h + + +fi + + # Step 0.d: Disable -rpath support? + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if rpath support is requested" >&5 +$as_echo_n "checking if rpath support is requested... " >&6; } + # Check whether --enable-rpath was given. +if test "${enable_rpath+set}" = set; then : + enableval=$enable_rpath; doRpath=$enableval +else + doRpath=yes +fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $doRpath" >&5 +$as_echo "$doRpath" >&6; } + + # TEA specific: Cross-compiling options for Windows/CE builds? + + if test "${TEA_PLATFORM}" = windows; then : + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if Windows/CE build is requested" >&5 +$as_echo_n "checking if Windows/CE build is requested... " >&6; } + # Check whether --enable-wince was given. +if test "${enable_wince+set}" = set; then : + enableval=$enable_wince; doWince=$enableval +else + doWince=no +fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $doWince" >&5 +$as_echo "$doWince" >&6; } + +fi + + # Set the variable "system" to hold the name and version number + # for the system. + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking system version" >&5 +$as_echo_n "checking system version... " >&6; } +if ${tcl_cv_sys_version+:} false; then : + $as_echo_n "(cached) " >&6 +else + + # TEA specific: + if test "${TEA_PLATFORM}" = "windows" ; then + tcl_cv_sys_version=windows + else + tcl_cv_sys_version=`uname -s`-`uname -r` + if test "$?" -ne 0 ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: can't find uname command" >&5 +$as_echo "$as_me: WARNING: can't find uname command" >&2;} + tcl_cv_sys_version=unknown + else + if test "`uname -s`" = "AIX" ; then + tcl_cv_sys_version=AIX-`uname -v`.`uname -r` + fi + fi + fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_sys_version" >&5 +$as_echo "$tcl_cv_sys_version" >&6; } + system=$tcl_cv_sys_version + + + # Require ranlib early so we can override it in special cases below. + + + + # Set configuration options based on system name and version. + # This is similar to Tcl's unix/tcl.m4 except that we've added a + # "windows" case and removed some core-only vars. + + do64bit_ok=no + # default to '{$LIBS}' and set to "" on per-platform necessary basis + SHLIB_LD_LIBS='${LIBS}' + # When ld needs options to work in 64-bit mode, put them in + # LDFLAGS_ARCH so they eventually end up in LDFLAGS even if [load] + # is disabled by the user. [Bug 1016796] + LDFLAGS_ARCH="" + UNSHARED_LIB_SUFFIX="" + # TEA specific: use PACKAGE_VERSION instead of VERSION + TCL_TRIM_DOTS='`echo ${PACKAGE_VERSION} | tr -d .`' + ECHO_VERSION='`echo ${PACKAGE_VERSION}`' + TCL_LIB_VERSIONS_OK=ok + CFLAGS_DEBUG=-g + if test "$GCC" = yes; then : + + CFLAGS_OPTIMIZE=-O2 + CFLAGS_WARNING="-Wall" + +else + + CFLAGS_OPTIMIZE=-O + CFLAGS_WARNING="" + +fi + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}ar", so it can be a program name with args. +set dummy ${ac_tool_prefix}ar; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_AR+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$AR"; then + ac_cv_prog_AR="$AR" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_AR="${ac_tool_prefix}ar" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +AR=$ac_cv_prog_AR +if test -n "$AR"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $AR" >&5 +$as_echo "$AR" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_AR"; then + ac_ct_AR=$AR + # Extract the first word of "ar", so it can be a program name with args. +set dummy ar; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_AR+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_AR"; then + ac_cv_prog_ac_ct_AR="$ac_ct_AR" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_AR="ar" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_AR=$ac_cv_prog_ac_ct_AR +if test -n "$ac_ct_AR"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_AR" >&5 +$as_echo "$ac_ct_AR" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_AR" = x; then + AR="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + AR=$ac_ct_AR + fi +else + AR="$ac_cv_prog_AR" +fi + + STLIB_LD='${AR} cr' + LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH" + if test "x$SHLIB_VERSION" = x; then : + SHLIB_VERSION="" +else + SHLIB_VERSION=".$SHLIB_VERSION" +fi + case $system in + # TEA specific: + windows) + # This is a 2-stage check to make sure we have the 64-bit SDK + # We have to know where the SDK is installed. + # This magic is based on MS Platform SDK for Win2003 SP1 - hobbs + # MACHINE is IX86 for LINK, but this is used by the manifest, + # which requires x86|amd64|ia64. + MACHINE="X86" + if test "$do64bit" != "no" ; then + if test "x${MSSDK}x" = "xx" ; then + MSSDK="C:/Progra~1/Microsoft Platform SDK" + fi + MSSDK=`echo "$MSSDK" | sed -e 's!\\\!/!g'` + PATH64="" + case "$do64bit" in + amd64|x64|yes) + MACHINE="AMD64" ; # default to AMD64 64-bit build + PATH64="${MSSDK}/Bin/Win64/x86/AMD64" + ;; + ia64) + MACHINE="IA64" + PATH64="${MSSDK}/Bin/Win64" + ;; + esac + if test "$GCC" != "yes" -a ! -d "${PATH64}" ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Could not find 64-bit $MACHINE SDK to enable 64bit mode" >&5 +$as_echo "$as_me: WARNING: Could not find 64-bit $MACHINE SDK to enable 64bit mode" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Ensure latest Platform SDK is installed" >&5 +$as_echo "$as_me: WARNING: Ensure latest Platform SDK is installed" >&2;} + do64bit="no" + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: Using 64-bit $MACHINE mode" >&5 +$as_echo " Using 64-bit $MACHINE mode" >&6; } + do64bit_ok="yes" + fi + fi + + if test "$doWince" != "no" ; then + if test "$do64bit" != "no" ; then + as_fn_error $? "Windows/CE and 64-bit builds incompatible" "$LINENO" 5 + fi + if test "$GCC" = "yes" ; then + as_fn_error $? "Windows/CE and GCC builds incompatible" "$LINENO" 5 + fi + + # First, look for one uninstalled. + # the alternative search directory is invoked by --with-celib + + if test x"${no_celib}" = x ; then + # we reset no_celib in case something fails here + no_celib=true + +# Check whether --with-celib was given. +if test "${with_celib+set}" = set; then : + withval=$with_celib; with_celibconfig=${withval} +fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Windows/CE celib directory" >&5 +$as_echo_n "checking for Windows/CE celib directory... " >&6; } + if ${ac_cv_c_celibconfig+:} false; then : + $as_echo_n "(cached) " >&6 +else + + # First check to see if --with-celibconfig was specified. + if test x"${with_celibconfig}" != x ; then + if test -d "${with_celibconfig}/inc" ; then + ac_cv_c_celibconfig=`(cd ${with_celibconfig}; pwd)` + else + as_fn_error $? "${with_celibconfig} directory doesn't contain inc directory" "$LINENO" 5 + fi + fi + + # then check for a celib library + if test x"${ac_cv_c_celibconfig}" = x ; then + for i in \ + ../celib-palm-3.0 \ + ../celib \ + ../../celib-palm-3.0 \ + ../../celib \ + `ls -dr ../celib-*3.[0-9]* 2>/dev/null` \ + ${srcdir}/../celib-palm-3.0 \ + ${srcdir}/../celib \ + `ls -dr ${srcdir}/../celib-*3.[0-9]* 2>/dev/null` \ + ; do + if test -d "$i/inc" ; then + ac_cv_c_celibconfig=`(cd $i; pwd)` + break + fi + done + fi + +fi + + if test x"${ac_cv_c_celibconfig}" = x ; then + as_fn_error $? "Cannot find celib support library directory" "$LINENO" 5 + else + no_celib= + CELIB_DIR=${ac_cv_c_celibconfig} + CELIB_DIR=`echo "$CELIB_DIR" | sed -e 's!\\\!/!g'` + { $as_echo "$as_me:${as_lineno-$LINENO}: result: found $CELIB_DIR" >&5 +$as_echo "found $CELIB_DIR" >&6; } + fi + fi + + # Set defaults for common evc4/PPC2003 setup + # Currently Tcl requires 300+, possibly 420+ for sockets + CEVERSION=420; # could be 211 300 301 400 420 ... + TARGETCPU=ARMV4; # could be ARMV4 ARM MIPS SH3 X86 ... + ARCH=ARM; # could be ARM MIPS X86EM ... + PLATFORM="Pocket PC 2003"; # or "Pocket PC 2002" + if test "$doWince" != "yes"; then + # If !yes then the user specified something + # Reset ARCH to allow user to skip specifying it + ARCH= + eval `echo $doWince | awk -F, '{ \ + if (length($1)) { printf "CEVERSION=\"%s\"\n", $1; \ + if ($1 < 400) { printf "PLATFORM=\"Pocket PC 2002\"\n" } }; \ + if (length($2)) { printf "TARGETCPU=\"%s\"\n", toupper($2) }; \ + if (length($3)) { printf "ARCH=\"%s\"\n", toupper($3) }; \ + if (length($4)) { printf "PLATFORM=\"%s\"\n", $4 }; \ + }'` + if test "x${ARCH}" = "x" ; then + ARCH=$TARGETCPU; + fi + fi + OSVERSION=WCE$CEVERSION; + if test "x${WCEROOT}" = "x" ; then + WCEROOT="C:/Program Files/Microsoft eMbedded C++ 4.0" + if test ! -d "${WCEROOT}" ; then + WCEROOT="C:/Program Files/Microsoft eMbedded Tools" + fi + fi + if test "x${SDKROOT}" = "x" ; then + SDKROOT="C:/Program Files/Windows CE Tools" + if test ! -d "${SDKROOT}" ; then + SDKROOT="C:/Windows CE Tools" + fi + fi + WCEROOT=`echo "$WCEROOT" | sed -e 's!\\\!/!g'` + SDKROOT=`echo "$SDKROOT" | sed -e 's!\\\!/!g'` + if test ! -d "${SDKROOT}/${OSVERSION}/${PLATFORM}/Lib/${TARGETCPU}" \ + -o ! -d "${WCEROOT}/EVC/${OSVERSION}/bin"; then + as_fn_error $? "could not find PocketPC SDK or target compiler to enable WinCE mode $CEVERSION,$TARGETCPU,$ARCH,$PLATFORM" "$LINENO" 5 + doWince="no" + else + # We could PATH_NOSPACE these, but that's not important, + # as long as we quote them when used. + CEINCLUDE="${SDKROOT}/${OSVERSION}/${PLATFORM}/include" + if test -d "${CEINCLUDE}/${TARGETCPU}" ; then + CEINCLUDE="${CEINCLUDE}/${TARGETCPU}" + fi + CELIBPATH="${SDKROOT}/${OSVERSION}/${PLATFORM}/Lib/${TARGETCPU}" + fi + fi + + if test "$GCC" != "yes" ; then + if test "${SHARED_BUILD}" = "0" ; then + runtime=-MT + else + runtime=-MD + fi + case "x`echo \${VisualStudioVersion}`" in + x1[4-9]*) + lflags="${lflags} -nodefaultlib:libucrt.lib" + + vars="ucrt.lib" + for i in $vars; do + if test "${TEA_PLATFORM}" = "windows" -a "$GCC" = "yes" ; then + case $i in + *.lib) + # Convert foo.lib to -lfoo for GCC + i=-l`echo "$i" | sed -e 's/\.[^.]*$//' -e 's/\.lib.*//'` + ;; + esac + fi + PKG_LIBS="$PKG_LIBS $i" + done + + + ;; + *) + ;; + esac + + if test "$do64bit" != "no" ; then + # All this magic is necessary for the Win64 SDK RC1 - hobbs + CC="\"${PATH64}/cl.exe\"" + CFLAGS="${CFLAGS} -I\"${MSSDK}/Include\" -I\"${MSSDK}/Include/crt\" -I\"${MSSDK}/Include/crt/sys\"" + RC="\"${MSSDK}/bin/rc.exe\"" + lflags="${lflags} -nologo -MACHINE:${MACHINE} -LIBPATH:\"${MSSDK}/Lib/${MACHINE}\"" + LINKBIN="\"${PATH64}/link.exe\"" + CFLAGS_DEBUG="-nologo -Zi -Od -W3 ${runtime}d" + CFLAGS_OPTIMIZE="-nologo -O2 -W2 ${runtime}" + # Avoid 'unresolved external symbol __security_cookie' + # errors, c.f. http://support.microsoft.com/?id=894573 + + vars="bufferoverflowU.lib" + for i in $vars; do + if test "${TEA_PLATFORM}" = "windows" -a "$GCC" = "yes" ; then + case $i in + *.lib) + # Convert foo.lib to -lfoo for GCC + i=-l`echo "$i" | sed -e 's/\.[^.]*$//' -e 's/\.lib.*//'` + ;; + esac + fi + PKG_LIBS="$PKG_LIBS $i" + done + + + elif test "$doWince" != "no" ; then + CEBINROOT="${WCEROOT}/EVC/${OSVERSION}/bin" + if test "${TARGETCPU}" = "X86"; then + CC="\"${CEBINROOT}/cl.exe\"" + else + CC="\"${CEBINROOT}/cl${ARCH}.exe\"" + fi + CFLAGS="$CFLAGS -I\"${CELIB_DIR}/inc\" -I\"${CEINCLUDE}\"" + RC="\"${WCEROOT}/Common/EVC/bin/rc.exe\"" + arch=`echo ${ARCH} | awk '{print tolower($0)}'` + defs="${ARCH} _${ARCH}_ ${arch} PALM_SIZE _MT _WINDOWS" + if test "${SHARED_BUILD}" = "1" ; then + # Static CE builds require static celib as well + defs="${defs} _DLL" + fi + for i in $defs ; do + +cat >>confdefs.h <<_ACEOF +#define $i 1 +_ACEOF + + done + +cat >>confdefs.h <<_ACEOF +#define _WIN32_WCE $CEVERSION +_ACEOF + + +cat >>confdefs.h <<_ACEOF +#define UNDER_CE $CEVERSION +_ACEOF + + CFLAGS_DEBUG="-nologo -Zi -Od" + CFLAGS_OPTIMIZE="-nologo -Ox" + lversion=`echo ${CEVERSION} | sed -e 's/\(.\)\(..\)/\1\.\2/'` + lflags="${lflags} -MACHINE:${ARCH} -LIBPATH:\"${CELIBPATH}\" -subsystem:windowsce,${lversion} -nologo" + LINKBIN="\"${CEBINROOT}/link.exe\"" + + else + RC="rc" + lflags="${lflags} -nologo" + LINKBIN="link" + CFLAGS_DEBUG="-nologo -Z7 -Od -W3 -WX ${runtime}d" + CFLAGS_OPTIMIZE="-nologo -O2 -W2 ${runtime}" + fi + fi + + if test "$GCC" = "yes"; then + # mingw gcc mode + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}windres", so it can be a program name with args. +set dummy ${ac_tool_prefix}windres; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_RC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$RC"; then + ac_cv_prog_RC="$RC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_RC="${ac_tool_prefix}windres" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +RC=$ac_cv_prog_RC +if test -n "$RC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RC" >&5 +$as_echo "$RC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_RC"; then + ac_ct_RC=$RC + # Extract the first word of "windres", so it can be a program name with args. +set dummy windres; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_RC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_RC"; then + ac_cv_prog_ac_ct_RC="$ac_ct_RC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_RC="windres" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_RC=$ac_cv_prog_ac_ct_RC +if test -n "$ac_ct_RC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RC" >&5 +$as_echo "$ac_ct_RC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_RC" = x; then + RC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + RC=$ac_ct_RC + fi +else + RC="$ac_cv_prog_RC" +fi + + CFLAGS_DEBUG="-g" + CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer" + SHLIB_LD='${CC} -shared' + UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a' + PRACTCL_UNSHARED_LIB_SUFFIX='.a' + + LDFLAGS_CONSOLE="-wl,--subsystem,console ${lflags}" + LDFLAGS_WINDOW="-wl,--subsystem,windows ${lflags}" + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for cross-compile version of gcc" >&5 +$as_echo_n "checking for cross-compile version of gcc... " >&6; } +if ${ac_cv_cross+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #ifdef _WIN32 + #error cross-compiler + #endif + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_cross=yes +else + ac_cv_cross=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_cross" >&5 +$as_echo "$ac_cv_cross" >&6; } + if test "$ac_cv_cross" = "yes"; then + case "$do64bit" in + amd64|x64|yes) + CC="x86_64-w64-mingw32-gcc" + LD="x86_64-w64-mingw32-ld" + AR="x86_64-w64-mingw32-ar" + RANLIB="x86_64-w64-mingw32-ranlib" + RC="x86_64-w64-mingw32-windres" + ;; + *) + CC="i686-w64-mingw32-gcc" + LD="i686-w64-mingw32-ld" + AR="i686-w64-mingw32-ar" + RANLIB="i686-w64-mingw32-ranlib" + RC="i686-w64-mingw32-windres" + ;; + esac + fi + + else + SHLIB_LD="${LINKBIN} -dll ${lflags}" + # link -lib only works when -lib is the first arg + STLIB_LD="${LINKBIN} -lib ${lflags}" + UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.lib' + PATHTYPE=-w + # For information on what debugtype is most useful, see: + # http://msdn.microsoft.com/library/en-us/dnvc60/html/gendepdebug.asp + # and also + # http://msdn2.microsoft.com/en-us/library/y0zzbyt4%28VS.80%29.aspx + # This essentially turns it all on. + LDFLAGS_DEBUG="-debug -debugtype:cv" + LDFLAGS_OPTIMIZE="-release" + if test "$doWince" != "no" ; then + LDFLAGS_CONSOLE="-link ${lflags}" + LDFLAGS_WINDOW=${LDFLAGS_CONSOLE} + else + LDFLAGS_CONSOLE="-link -subsystem:console ${lflags}" + LDFLAGS_WINDOW="-link -subsystem:windows ${lflags}" + fi + fi + + SHLIB_SUFFIX=".dll" + SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.dll' + + TCL_LIB_VERSIONS_OK=nodots + ;; + AIX-*) + if test "${TCL_THREADS}" = "1" -a "$GCC" != "yes"; then : + + # AIX requires the _r compiler when gcc isn't being used + case "${CC}" in + *_r|*_r\ *) + # ok ... + ;; + *) + # Make sure only first arg gets _r + CC=`echo "$CC" | sed -e 's/^\([^ ]*\)/\1_r/'` + ;; + esac + { $as_echo "$as_me:${as_lineno-$LINENO}: result: Using $CC for compiling with threads" >&5 +$as_echo "Using $CC for compiling with threads" >&6; } + +fi + LIBS="$LIBS -lc" + SHLIB_CFLAGS="" + SHLIB_SUFFIX=".so" + + LD_LIBRARY_PATH_VAR="LIBPATH" + + # Check to enable 64-bit flags for compiler/linker + if test "$do64bit" = yes; then : + + if test "$GCC" = yes; then : + + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported with GCC on $system" >&5 +$as_echo "$as_me: WARNING: 64bit mode not supported with GCC on $system" >&2;} + +else + + do64bit_ok=yes + CFLAGS="$CFLAGS -q64" + LDFLAGS_ARCH="-q64" + RANLIB="${RANLIB} -X64" + AR="${AR} -X64" + SHLIB_LD_FLAGS="-b64" + +fi + +fi + + if test "`uname -m`" = ia64; then : + + # AIX-5 uses ELF style dynamic libraries on IA-64, but not PPC + SHLIB_LD="/usr/ccs/bin/ld -G -z text" + if test "$GCC" = yes; then : + + CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' + +else + + CC_SEARCH_FLAGS='-R${LIB_RUNTIME_DIR}' + +fi + LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}' + +else + + if test "$GCC" = yes; then : + + SHLIB_LD='${CC} -shared -Wl,-bexpall' + +else + + SHLIB_LD="/bin/ld -bhalt:4 -bM:SRE -bexpall -H512 -T512 -bnoentry" + LDFLAGS="$LDFLAGS -brtl" + +fi + SHLIB_LD="${SHLIB_LD} ${SHLIB_LD_FLAGS}" + CC_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}' + LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} + +fi + ;; + BeOS*) + SHLIB_CFLAGS="-fPIC" + SHLIB_LD='${CC} -nostart' + SHLIB_SUFFIX=".so" + + #----------------------------------------------------------- + # Check for inet_ntoa in -lbind, for BeOS (which also needs + # -lsocket, even if the network functions are in -lnet which + # is always linked to, for compatibility. + #----------------------------------------------------------- + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for inet_ntoa in -lbind" >&5 +$as_echo_n "checking for inet_ntoa in -lbind... " >&6; } +if ${ac_cv_lib_bind_inet_ntoa+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lbind $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char inet_ntoa (); +int +main () +{ +return inet_ntoa (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_bind_inet_ntoa=yes +else + ac_cv_lib_bind_inet_ntoa=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bind_inet_ntoa" >&5 +$as_echo "$ac_cv_lib_bind_inet_ntoa" >&6; } +if test "x$ac_cv_lib_bind_inet_ntoa" = xyes; then : + LIBS="$LIBS -lbind -lsocket" +fi + + ;; + BSD/OS-4.*) + SHLIB_CFLAGS="-export-dynamic -fPIC" + SHLIB_LD='${CC} -shared' + SHLIB_SUFFIX=".so" + LDFLAGS="$LDFLAGS -export-dynamic" + CC_SEARCH_FLAGS="" + LD_SEARCH_FLAGS="" + ;; + CYGWIN_*) + SHLIB_CFLAGS="" + SHLIB_LD='${CC} -shared' + SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,--out-implib,\$@.a" + SHLIB_SUFFIX=".dll" + EXEEXT=".exe" + do64bit_ok=yes + CC_SEARCH_FLAGS="" + LD_SEARCH_FLAGS="" + ;; + Haiku*) + LDFLAGS="$LDFLAGS -Wl,--export-dynamic" + SHLIB_CFLAGS="-fPIC" + SHLIB_SUFFIX=".so" + SHLIB_LD='${CC} -shared ${CFLAGS} ${LDFLAGS}' + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for inet_ntoa in -lnetwork" >&5 +$as_echo_n "checking for inet_ntoa in -lnetwork... " >&6; } +if ${ac_cv_lib_network_inet_ntoa+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lnetwork $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char inet_ntoa (); +int +main () +{ +return inet_ntoa (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_network_inet_ntoa=yes +else + ac_cv_lib_network_inet_ntoa=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_network_inet_ntoa" >&5 +$as_echo "$ac_cv_lib_network_inet_ntoa" >&6; } +if test "x$ac_cv_lib_network_inet_ntoa" = xyes; then : + LIBS="$LIBS -lnetwork" +fi + + ;; + HP-UX-*.11.*) + # Use updated header definitions where possible + +$as_echo "#define _XOPEN_SOURCE_EXTENDED 1" >>confdefs.h + + # TEA specific: Needed by Tcl, but not most extensions + #AC_DEFINE(_XOPEN_SOURCE, 1, [Do we want to use the XOPEN network library?]) + #LIBS="$LIBS -lxnet" # Use the XOPEN network library + + if test "`uname -m`" = ia64; then : + + SHLIB_SUFFIX=".so" + # Use newer C++ library for C++ extensions + #if test "$GCC" != "yes" ; then + # CPPFLAGS="-AA" + #fi + +else + + SHLIB_SUFFIX=".sl" + +fi + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for shl_load in -ldld" >&5 +$as_echo_n "checking for shl_load in -ldld... " >&6; } +if ${ac_cv_lib_dld_shl_load+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-ldld $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char shl_load (); +int +main () +{ +return shl_load (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_dld_shl_load=yes +else + ac_cv_lib_dld_shl_load=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dld_shl_load" >&5 +$as_echo "$ac_cv_lib_dld_shl_load" >&6; } +if test "x$ac_cv_lib_dld_shl_load" = xyes; then : + tcl_ok=yes +else + tcl_ok=no +fi + + if test "$tcl_ok" = yes; then : + + LDFLAGS="$LDFLAGS -Wl,-E" + CC_SEARCH_FLAGS='-Wl,+s,+b,${LIB_RUNTIME_DIR}:.' + LD_SEARCH_FLAGS='+s +b ${LIB_RUNTIME_DIR}:.' + LD_LIBRARY_PATH_VAR="SHLIB_PATH" + +fi + if test "$GCC" = yes; then : + + SHLIB_LD='${CC} -shared' + LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} + +else + + CFLAGS="$CFLAGS -z" + # Users may want PA-RISC 1.1/2.0 portable code - needs HP cc + #CFLAGS="$CFLAGS +DAportable" + SHLIB_CFLAGS="+z" + SHLIB_LD="ld -b" + +fi + + # Check to enable 64-bit flags for compiler/linker + if test "$do64bit" = "yes"; then : + + if test "$GCC" = yes; then : + + case `${CC} -dumpmachine` in + hppa64*) + # 64-bit gcc in use. Fix flags for GNU ld. + do64bit_ok=yes + SHLIB_LD='${CC} -shared' + if test $doRpath = yes; then : + + CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' +fi + LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} + ;; + *) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported with GCC on $system" >&5 +$as_echo "$as_me: WARNING: 64bit mode not supported with GCC on $system" >&2;} + ;; + esac + +else + + do64bit_ok=yes + CFLAGS="$CFLAGS +DD64" + LDFLAGS_ARCH="+DD64" + +fi + +fi ;; + IRIX-6.*) + SHLIB_CFLAGS="" + SHLIB_LD="ld -n32 -shared -rdata_shared" + SHLIB_SUFFIX=".so" + if test $doRpath = yes; then : + + CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' + LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}' +fi + if test "$GCC" = yes; then : + + CFLAGS="$CFLAGS -mabi=n32" + LDFLAGS="$LDFLAGS -mabi=n32" + +else + + case $system in + IRIX-6.3) + # Use to build 6.2 compatible binaries on 6.3. + CFLAGS="$CFLAGS -n32 -D_OLD_TERMIOS" + ;; + *) + CFLAGS="$CFLAGS -n32" + ;; + esac + LDFLAGS="$LDFLAGS -n32" + +fi + ;; + IRIX64-6.*) + SHLIB_CFLAGS="" + SHLIB_LD="ld -n32 -shared -rdata_shared" + SHLIB_SUFFIX=".so" + if test $doRpath = yes; then : + + CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' + LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}' +fi + + # Check to enable 64-bit flags for compiler/linker + + if test "$do64bit" = yes; then : + + if test "$GCC" = yes; then : + + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported by gcc" >&5 +$as_echo "$as_me: WARNING: 64bit mode not supported by gcc" >&2;} + +else + + do64bit_ok=yes + SHLIB_LD="ld -64 -shared -rdata_shared" + CFLAGS="$CFLAGS -64" + LDFLAGS_ARCH="-64" + +fi + +fi + ;; + Linux*|GNU*|NetBSD-Debian) + SHLIB_CFLAGS="-fPIC" + SHLIB_SUFFIX=".so" + + # TEA specific: + CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer" + + # TEA specific: use LDFLAGS_DEFAULT instead of LDFLAGS + SHLIB_LD='${CC} -shared ${CFLAGS} ${LDFLAGS_DEFAULT}' + LDFLAGS="$LDFLAGS -Wl,--export-dynamic" + if test $doRpath = yes; then : + + CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' +fi + LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} + if test "`uname -m`" = "alpha"; then : + CFLAGS="$CFLAGS -mieee" +fi + if test $do64bit = yes; then : + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if compiler accepts -m64 flag" >&5 +$as_echo_n "checking if compiler accepts -m64 flag... " >&6; } +if ${tcl_cv_cc_m64+:} false; then : + $as_echo_n "(cached) " >&6 +else + + hold_cflags=$CFLAGS + CFLAGS="$CFLAGS -m64" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + tcl_cv_cc_m64=yes +else + tcl_cv_cc_m64=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + CFLAGS=$hold_cflags +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_m64" >&5 +$as_echo "$tcl_cv_cc_m64" >&6; } + if test $tcl_cv_cc_m64 = yes; then : + + CFLAGS="$CFLAGS -m64" + do64bit_ok=yes + +fi + +fi + + # The combo of gcc + glibc has a bug related to inlining of + # functions like strtod(). The -fno-builtin flag should address + # this problem but it does not work. The -fno-inline flag is kind + # of overkill but it works. Disable inlining only when one of the + # files in compat/*.c is being linked in. + + if test x"${USE_COMPAT}" != x; then : + CFLAGS="$CFLAGS -fno-inline" +fi + ;; + Lynx*) + SHLIB_CFLAGS="-fPIC" + SHLIB_SUFFIX=".so" + CFLAGS_OPTIMIZE=-02 + SHLIB_LD='${CC} -shared' + LD_FLAGS="-Wl,--export-dynamic" + if test $doRpath = yes; then : + + CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' + LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' +fi + ;; + OpenBSD-*) + arch=`arch -s` + case "$arch" in + vax) + SHLIB_SUFFIX="" + SHARED_LIB_SUFFIX="" + LDFLAGS="" + ;; + *) + case "$arch" in + alpha|sparc64) + SHLIB_CFLAGS="-fPIC" + ;; + *) + SHLIB_CFLAGS="-fpic" + ;; + esac + SHLIB_LD='${CC} -shared ${SHLIB_CFLAGS}' + SHLIB_SUFFIX=".so" + if test $doRpath = yes; then : + + CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' +fi + LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} + SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so${SHLIB_VERSION}' + LDFLAGS="-Wl,-export-dynamic" + ;; + esac + case "$arch" in + vax) + CFLAGS_OPTIMIZE="-O1" + ;; + *) + CFLAGS_OPTIMIZE="-O2" + ;; + esac + if test "${TCL_THREADS}" = "1"; then : + + # On OpenBSD: Compile with -pthread + # Don't link with -lpthread + LIBS=`echo $LIBS | sed s/-lpthread//` + CFLAGS="$CFLAGS -pthread" + +fi + # OpenBSD doesn't do version numbers with dots. + UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a' + TCL_LIB_VERSIONS_OK=nodots + ;; + NetBSD-*) + # NetBSD has ELF and can use 'cc -shared' to build shared libs + SHLIB_CFLAGS="-fPIC" + SHLIB_LD='${CC} -shared ${SHLIB_CFLAGS}' + SHLIB_SUFFIX=".so" + LDFLAGS="$LDFLAGS -export-dynamic" + if test $doRpath = yes; then : + + CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' +fi + LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} + if test "${TCL_THREADS}" = "1"; then : + + # The -pthread needs to go in the CFLAGS, not LIBS + LIBS=`echo $LIBS | sed s/-pthread//` + CFLAGS="$CFLAGS -pthread" + LDFLAGS="$LDFLAGS -pthread" + +fi + ;; + FreeBSD-*) + # This configuration from FreeBSD Ports. + SHLIB_CFLAGS="-fPIC" + SHLIB_LD="${CC} -shared" + SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,-soname,\$@" + SHLIB_SUFFIX=".so" + LDFLAGS="" + if test $doRpath = yes; then : + + CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' + LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' +fi + if test "${TCL_THREADS}" = "1"; then : + + # The -pthread needs to go in the LDFLAGS, not LIBS + LIBS=`echo $LIBS | sed s/-pthread//` + CFLAGS="$CFLAGS $PTHREAD_CFLAGS" + LDFLAGS="$LDFLAGS $PTHREAD_LIBS" +fi + case $system in + FreeBSD-3.*) + # Version numbers are dot-stripped by system policy. + TCL_TRIM_DOTS=`echo ${PACKAGE_VERSION} | tr -d .` + UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a' + SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.so.1' + TCL_LIB_VERSIONS_OK=nodots + ;; + esac + ;; + Darwin-*) + CFLAGS_OPTIMIZE="-Os" + SHLIB_CFLAGS="-fno-common" + # To avoid discrepancies between what headers configure sees during + # preprocessing tests and compiling tests, move any -isysroot and + # -mmacosx-version-min flags from CFLAGS to CPPFLAGS: + CPPFLAGS="${CPPFLAGS} `echo " ${CFLAGS}" | \ + awk 'BEGIN {FS=" +-";ORS=" "}; {for (i=2;i<=NF;i++) \ + if ($i~/^(isysroot|mmacosx-version-min)/) print "-"$i}'`" + CFLAGS="`echo " ${CFLAGS}" | \ + awk 'BEGIN {FS=" +-";ORS=" "}; {for (i=2;i<=NF;i++) \ + if (!($i~/^(isysroot|mmacosx-version-min)/)) print "-"$i}'`" + if test $do64bit = yes; then : + + case `arch` in + ppc) + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if compiler accepts -arch ppc64 flag" >&5 +$as_echo_n "checking if compiler accepts -arch ppc64 flag... " >&6; } +if ${tcl_cv_cc_arch_ppc64+:} false; then : + $as_echo_n "(cached) " >&6 +else + + hold_cflags=$CFLAGS + CFLAGS="$CFLAGS -arch ppc64 -mpowerpc64 -mcpu=G5" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + tcl_cv_cc_arch_ppc64=yes +else + tcl_cv_cc_arch_ppc64=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + CFLAGS=$hold_cflags +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_arch_ppc64" >&5 +$as_echo "$tcl_cv_cc_arch_ppc64" >&6; } + if test $tcl_cv_cc_arch_ppc64 = yes; then : + + CFLAGS="$CFLAGS -arch ppc64 -mpowerpc64 -mcpu=G5" + do64bit_ok=yes + +fi;; + i386) + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if compiler accepts -arch x86_64 flag" >&5 +$as_echo_n "checking if compiler accepts -arch x86_64 flag... " >&6; } +if ${tcl_cv_cc_arch_x86_64+:} false; then : + $as_echo_n "(cached) " >&6 +else + + hold_cflags=$CFLAGS + CFLAGS="$CFLAGS -arch x86_64" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + tcl_cv_cc_arch_x86_64=yes +else + tcl_cv_cc_arch_x86_64=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + CFLAGS=$hold_cflags +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_arch_x86_64" >&5 +$as_echo "$tcl_cv_cc_arch_x86_64" >&6; } + if test $tcl_cv_cc_arch_x86_64 = yes; then : + + CFLAGS="$CFLAGS -arch x86_64" + do64bit_ok=yes + +fi;; + *) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Don't know how enable 64-bit on architecture \`arch\`" >&5 +$as_echo "$as_me: WARNING: Don't know how enable 64-bit on architecture \`arch\`" >&2;};; + esac + +else + + # Check for combined 32-bit and 64-bit fat build + if echo "$CFLAGS " |grep -E -q -- '-arch (ppc64|x86_64) ' \ + && echo "$CFLAGS " |grep -E -q -- '-arch (ppc|i386) '; then : + + fat_32_64=yes +fi + +fi + # TEA specific: use LDFLAGS_DEFAULT instead of LDFLAGS + SHLIB_LD='${CC} -dynamiclib ${CFLAGS} ${LDFLAGS_DEFAULT}' + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if ld accepts -single_module flag" >&5 +$as_echo_n "checking if ld accepts -single_module flag... " >&6; } +if ${tcl_cv_ld_single_module+:} false; then : + $as_echo_n "(cached) " >&6 +else + + hold_ldflags=$LDFLAGS + LDFLAGS="$LDFLAGS -dynamiclib -Wl,-single_module" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ +int i; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + tcl_cv_ld_single_module=yes +else + tcl_cv_ld_single_module=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LDFLAGS=$hold_ldflags +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_ld_single_module" >&5 +$as_echo "$tcl_cv_ld_single_module" >&6; } + if test $tcl_cv_ld_single_module = yes; then : + + SHLIB_LD="${SHLIB_LD} -Wl,-single_module" + +fi + # TEA specific: link shlib with current and compatibility version flags + vers=`echo ${PACKAGE_VERSION} | sed -e 's/^\([0-9]\{1,5\}\)\(\(\.[0-9]\{1,3\}\)\{0,2\}\).*$/\1\2/p' -e d` + SHLIB_LD="${SHLIB_LD} -current_version ${vers:-0} -compatibility_version ${vers:-0}" + SHLIB_SUFFIX=".dylib" + # Don't use -prebind when building for Mac OS X 10.4 or later only: + if test "`echo "${MACOSX_DEPLOYMENT_TARGET}" | awk -F '10\\.' '{print int($2)}'`" -lt 4 -a \ + "`echo "${CPPFLAGS}" | awk -F '-mmacosx-version-min=10\\.' '{print int($2)}'`" -lt 4; then : + + LDFLAGS="$LDFLAGS -prebind" +fi + LDFLAGS="$LDFLAGS -headerpad_max_install_names" + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if ld accepts -search_paths_first flag" >&5 +$as_echo_n "checking if ld accepts -search_paths_first flag... " >&6; } +if ${tcl_cv_ld_search_paths_first+:} false; then : + $as_echo_n "(cached) " >&6 +else + + hold_ldflags=$LDFLAGS + LDFLAGS="$LDFLAGS -Wl,-search_paths_first" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ +int i; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + tcl_cv_ld_search_paths_first=yes +else + tcl_cv_ld_search_paths_first=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LDFLAGS=$hold_ldflags +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_ld_search_paths_first" >&5 +$as_echo "$tcl_cv_ld_search_paths_first" >&6; } + if test $tcl_cv_ld_search_paths_first = yes; then : + + LDFLAGS="$LDFLAGS -Wl,-search_paths_first" + +fi + if test "$tcl_cv_cc_visibility_hidden" != yes; then : + + +$as_echo "#define MODULE_SCOPE __private_extern__" >>confdefs.h + + tcl_cv_cc_visibility_hidden=yes + +fi + CC_SEARCH_FLAGS="" + LD_SEARCH_FLAGS="" + LD_LIBRARY_PATH_VAR="DYLD_LIBRARY_PATH" + # TEA specific: for combined 32 & 64 bit fat builds of Tk + # extensions, verify that 64-bit build is possible. + if test "$fat_32_64" = yes && test -n "${TK_BIN_DIR}"; then : + + if test "${TEA_WINDOWINGSYSTEM}" = x11; then : + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for 64-bit X11" >&5 +$as_echo_n "checking for 64-bit X11... " >&6; } +if ${tcl_cv_lib_x11_64+:} false; then : + $as_echo_n "(cached) " >&6 +else + + for v in CFLAGS CPPFLAGS LDFLAGS; do + eval 'hold_'$v'="$'$v'";'$v'="`echo "$'$v' "|sed -e "s/-arch ppc / /g" -e "s/-arch i386 / /g"`"' + done + CPPFLAGS="$CPPFLAGS -I/usr/X11R6/include" + LDFLAGS="$LDFLAGS -L/usr/X11R6/lib -lX11" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +int +main () +{ +XrmInitialize(); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + tcl_cv_lib_x11_64=yes +else + tcl_cv_lib_x11_64=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + for v in CFLAGS CPPFLAGS LDFLAGS; do + eval $v'="$hold_'$v'"' + done +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_lib_x11_64" >&5 +$as_echo "$tcl_cv_lib_x11_64" >&6; } + +fi + if test "${TEA_WINDOWINGSYSTEM}" = aqua; then : + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for 64-bit Tk" >&5 +$as_echo_n "checking for 64-bit Tk... " >&6; } +if ${tcl_cv_lib_tk_64+:} false; then : + $as_echo_n "(cached) " >&6 +else + + for v in CFLAGS CPPFLAGS LDFLAGS; do + eval 'hold_'$v'="$'$v'";'$v'="`echo "$'$v' "|sed -e "s/-arch ppc / /g" -e "s/-arch i386 / /g"`"' + done + CPPFLAGS="$CPPFLAGS -DUSE_TCL_STUBS=1 -DUSE_TK_STUBS=1 ${TCL_INCLUDES} ${TK_INCLUDES}" + LDFLAGS="$LDFLAGS ${TCL_STUB_LIB_SPEC} ${TK_STUB_LIB_SPEC}" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +int +main () +{ +Tk_InitStubs(NULL, "", 0); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + tcl_cv_lib_tk_64=yes +else + tcl_cv_lib_tk_64=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + for v in CFLAGS CPPFLAGS LDFLAGS; do + eval $v'="$hold_'$v'"' + done +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_lib_tk_64" >&5 +$as_echo "$tcl_cv_lib_tk_64" >&6; } + +fi + # remove 64-bit arch flags from CFLAGS et al. if configuration + # does not support 64-bit. + if test "$tcl_cv_lib_tk_64" = no -o "$tcl_cv_lib_x11_64" = no; then : + + { $as_echo "$as_me:${as_lineno-$LINENO}: Removing 64-bit architectures from compiler & linker flags" >&5 +$as_echo "$as_me: Removing 64-bit architectures from compiler & linker flags" >&6;} + for v in CFLAGS CPPFLAGS LDFLAGS; do + eval $v'="`echo "$'$v' "|sed -e "s/-arch ppc64 / /g" -e "s/-arch x86_64 / /g"`"' + done +fi + +fi + ;; + OS/390-*) + CFLAGS_OPTIMIZE="" # Optimizer is buggy + +$as_echo "#define _OE_SOCKETS 1" >>confdefs.h + + ;; + OSF1-V*) + # Digital OSF/1 + SHLIB_CFLAGS="" + if test "$SHARED_BUILD" = 1; then : + + SHLIB_LD='ld -shared -expect_unresolved "*"' + +else + + SHLIB_LD='ld -non_shared -expect_unresolved "*"' + +fi + SHLIB_SUFFIX=".so" + if test $doRpath = yes; then : + + CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' + LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}' +fi + if test "$GCC" = yes; then : + CFLAGS="$CFLAGS -mieee" +else + + CFLAGS="$CFLAGS -DHAVE_TZSET -std1 -ieee" +fi + # see pthread_intro(3) for pthread support on osf1, k.furukawa + if test "${TCL_THREADS}" = 1; then : + + CFLAGS="$CFLAGS -DHAVE_PTHREAD_ATTR_SETSTACKSIZE" + CFLAGS="$CFLAGS -DTCL_THREAD_STACK_MIN=PTHREAD_STACK_MIN*64" + LIBS=`echo $LIBS | sed s/-lpthreads//` + if test "$GCC" = yes; then : + + LIBS="$LIBS -lpthread -lmach -lexc" + +else + + CFLAGS="$CFLAGS -pthread" + LDFLAGS="$LDFLAGS -pthread" + +fi + +fi + ;; + QNX-6*) + # QNX RTP + # This may work for all QNX, but it was only reported for v6. + SHLIB_CFLAGS="-fPIC" + SHLIB_LD="ld -Bshareable -x" + SHLIB_LD_LIBS="" + SHLIB_SUFFIX=".so" + CC_SEARCH_FLAGS="" + LD_SEARCH_FLAGS="" + ;; + SCO_SV-3.2*) + if test "$GCC" = yes; then : + + SHLIB_CFLAGS="-fPIC -melf" + LDFLAGS="$LDFLAGS -melf -Wl,-Bexport" + +else + + SHLIB_CFLAGS="-Kpic -belf" + LDFLAGS="$LDFLAGS -belf -Wl,-Bexport" + +fi + SHLIB_LD="ld -G" + SHLIB_LD_LIBS="" + SHLIB_SUFFIX=".so" + CC_SEARCH_FLAGS="" + LD_SEARCH_FLAGS="" + ;; + SunOS-5.[0-6]) + # Careful to not let 5.10+ fall into this case + + # Note: If _REENTRANT isn't defined, then Solaris + # won't define thread-safe library routines. + + +$as_echo "#define _REENTRANT 1" >>confdefs.h + + +$as_echo "#define _POSIX_PTHREAD_SEMANTICS 1" >>confdefs.h + + + SHLIB_CFLAGS="-KPIC" + SHLIB_SUFFIX=".so" + if test "$GCC" = yes; then : + + SHLIB_LD='${CC} -shared' + CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' + LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} + +else + + SHLIB_LD="/usr/ccs/bin/ld -G -z text" + CC_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}' + LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} + +fi + ;; + SunOS-5*) + # Note: If _REENTRANT isn't defined, then Solaris + # won't define thread-safe library routines. + + +$as_echo "#define _REENTRANT 1" >>confdefs.h + + +$as_echo "#define _POSIX_PTHREAD_SEMANTICS 1" >>confdefs.h + + + SHLIB_CFLAGS="-KPIC" + + # Check to enable 64-bit flags for compiler/linker + if test "$do64bit" = yes; then : + + arch=`isainfo` + if test "$arch" = "sparcv9 sparc"; then : + + if test "$GCC" = yes; then : + + if test "`${CC} -dumpversion | awk -F. '{print $1}'`" -lt 3; then : + + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported with GCC < 3.2 on $system" >&5 +$as_echo "$as_me: WARNING: 64bit mode not supported with GCC < 3.2 on $system" >&2;} + +else + + do64bit_ok=yes + CFLAGS="$CFLAGS -m64 -mcpu=v9" + LDFLAGS="$LDFLAGS -m64 -mcpu=v9" + SHLIB_CFLAGS="-fPIC" + +fi + +else + + do64bit_ok=yes + if test "$do64bitVIS" = yes; then : + + CFLAGS="$CFLAGS -xarch=v9a" + LDFLAGS_ARCH="-xarch=v9a" + +else + + CFLAGS="$CFLAGS -xarch=v9" + LDFLAGS_ARCH="-xarch=v9" + +fi + # Solaris 64 uses this as well + #LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH_64" + +fi + +else + if test "$arch" = "amd64 i386"; then : + + if test "$GCC" = yes; then : + + case $system in + SunOS-5.1[1-9]*|SunOS-5.[2-9][0-9]*) + do64bit_ok=yes + CFLAGS="$CFLAGS -m64" + LDFLAGS="$LDFLAGS -m64";; + *) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported with GCC on $system" >&5 +$as_echo "$as_me: WARNING: 64bit mode not supported with GCC on $system" >&2;};; + esac + +else + + do64bit_ok=yes + case $system in + SunOS-5.1[1-9]*|SunOS-5.[2-9][0-9]*) + CFLAGS="$CFLAGS -m64" + LDFLAGS="$LDFLAGS -m64";; + *) + CFLAGS="$CFLAGS -xarch=amd64" + LDFLAGS="$LDFLAGS -xarch=amd64";; + esac + +fi + +else + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported for $arch" >&5 +$as_echo "$as_me: WARNING: 64bit mode not supported for $arch" >&2;} +fi +fi + +fi + + SHLIB_SUFFIX=".so" + if test "$GCC" = yes; then : + + SHLIB_LD='${CC} -shared' + CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' + LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} + if test "$do64bit_ok" = yes; then : + + if test "$arch" = "sparcv9 sparc"; then : + + # We need to specify -static-libgcc or we need to + # add the path to the sparv9 libgcc. + # JH: static-libgcc is necessary for core Tcl, but may + # not be necessary for extensions. + SHLIB_LD="$SHLIB_LD -m64 -mcpu=v9 -static-libgcc" + # for finding sparcv9 libgcc, get the regular libgcc + # path, remove so name and append 'sparcv9' + #v9gcclibdir="`gcc -print-file-name=libgcc_s.so` | ..." + #CC_SEARCH_FLAGS="${CC_SEARCH_FLAGS},-R,$v9gcclibdir" + +else + if test "$arch" = "amd64 i386"; then : + + # JH: static-libgcc is necessary for core Tcl, but may + # not be necessary for extensions. + SHLIB_LD="$SHLIB_LD -m64 -static-libgcc" + +fi +fi + +fi + +else + + case $system in + SunOS-5.[1-9][0-9]*) + # TEA specific: use LDFLAGS_DEFAULT instead of LDFLAGS + SHLIB_LD='${CC} -G -z text ${LDFLAGS_DEFAULT}';; + *) + SHLIB_LD='/usr/ccs/bin/ld -G -z text';; + esac + CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' + LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}' + +fi + ;; + UNIX_SV* | UnixWare-5*) + SHLIB_CFLAGS="-KPIC" + SHLIB_LD='${CC} -G' + SHLIB_LD_LIBS="" + SHLIB_SUFFIX=".so" + # Some UNIX_SV* systems (unixware 1.1.2 for example) have linkers + # that don't grok the -Bexport option. Test that it does. + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ld accepts -Bexport flag" >&5 +$as_echo_n "checking for ld accepts -Bexport flag... " >&6; } +if ${tcl_cv_ld_Bexport+:} false; then : + $as_echo_n "(cached) " >&6 +else + + hold_ldflags=$LDFLAGS + LDFLAGS="$LDFLAGS -Wl,-Bexport" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ +int i; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + tcl_cv_ld_Bexport=yes +else + tcl_cv_ld_Bexport=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LDFLAGS=$hold_ldflags +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_ld_Bexport" >&5 +$as_echo "$tcl_cv_ld_Bexport" >&6; } + if test $tcl_cv_ld_Bexport = yes; then : + + LDFLAGS="$LDFLAGS -Wl,-Bexport" + +fi + CC_SEARCH_FLAGS="" + LD_SEARCH_FLAGS="" + ;; + esac + + if test "$do64bit" = yes -a "$do64bit_ok" = no; then : + + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 64bit support being disabled -- don't know magic for this platform" >&5 +$as_echo "$as_me: WARNING: 64bit support being disabled -- don't know magic for this platform" >&2;} + +fi + + + + # Add in the arch flags late to ensure it wasn't removed. + # Not necessary in TEA, but this is aligned with core + LDFLAGS="$LDFLAGS $LDFLAGS_ARCH" + + # If we're running gcc, then change the C flags for compiling shared + # libraries to the right flags for gcc, instead of those for the + # standard manufacturer compiler. + + if test "$GCC" = yes; then : + + case $system in + AIX-*) ;; + BSD/OS*) ;; + CYGWIN_*|MINGW32_*) ;; + IRIX*) ;; + NetBSD-*|FreeBSD-*|OpenBSD-*) ;; + Darwin-*) ;; + SCO_SV-3.2*) ;; + windows) ;; + *) SHLIB_CFLAGS="-fPIC" ;; + esac +fi + + if test "$tcl_cv_cc_visibility_hidden" != yes; then : + + +$as_echo "#define MODULE_SCOPE extern" >>confdefs.h + + +fi + + if test "$SHARED_LIB_SUFFIX" = ""; then : + + # TEA specific: use PACKAGE_VERSION instead of VERSION + SHARED_LIB_SUFFIX='${PACKAGE_VERSION}${SHLIB_SUFFIX}' + +fi + if test "$UNSHARED_LIB_SUFFIX" = ""; then : + + # TEA specific: use PACKAGE_VERSION instead of VERSION + UNSHARED_LIB_SUFFIX='${PACKAGE_VERSION}.a' + +fi + + if test "${GCC}" = "yes" -a ${SHLIB_SUFFIX} = ".dll"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for SEH support in compiler" >&5 +$as_echo_n "checking for SEH support in compiler... " >&6; } +if ${tcl_cv_seh+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test "$cross_compiling" = yes; then : + tcl_cv_seh=no +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#define WIN32_LEAN_AND_MEAN +#include +#undef WIN32_LEAN_AND_MEAN + + int main(int argc, char** argv) { + int a, b = 0; + __try { + a = 666 / b; + } + __except (EXCEPTION_EXECUTE_HANDLER) { + return 0; + } + return 1; + } + +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + tcl_cv_seh=yes +else + tcl_cv_seh=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_seh" >&5 +$as_echo "$tcl_cv_seh" >&6; } + if test "$tcl_cv_seh" = "no" ; then + +$as_echo "#define HAVE_NO_SEH 1" >>confdefs.h + + fi + + # + # Check to see if the excpt.h include file provided contains the + # definition for EXCEPTION_DISPOSITION; if not, which is the case + # with Cygwin's version as of 2002-04-10, define it to be int, + # sufficient for getting the current code to work. + # + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for EXCEPTION_DISPOSITION support in include files" >&5 +$as_echo_n "checking for EXCEPTION_DISPOSITION support in include files... " >&6; } +if ${tcl_cv_eh_disposition+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +# define WIN32_LEAN_AND_MEAN +# include +# undef WIN32_LEAN_AND_MEAN + +int +main () +{ + + EXCEPTION_DISPOSITION x; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_eh_disposition=yes +else + tcl_cv_eh_disposition=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_eh_disposition" >&5 +$as_echo "$tcl_cv_eh_disposition" >&6; } + if test "$tcl_cv_eh_disposition" = "no" ; then + +$as_echo "#define EXCEPTION_DISPOSITION int" >>confdefs.h + + fi + + # Check to see if winnt.h defines CHAR, SHORT, and LONG + # even if VOID has already been #defined. The win32api + # used by mingw and cygwin is known to do this. + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for winnt.h that ignores VOID define" >&5 +$as_echo_n "checking for winnt.h that ignores VOID define... " >&6; } +if ${tcl_cv_winnt_ignore_void+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#define VOID void +#define WIN32_LEAN_AND_MEAN +#include +#undef WIN32_LEAN_AND_MEAN + +int +main () +{ + + CHAR c; + SHORT s; + LONG l; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_winnt_ignore_void=yes +else + tcl_cv_winnt_ignore_void=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_winnt_ignore_void" >&5 +$as_echo "$tcl_cv_winnt_ignore_void" >&6; } + if test "$tcl_cv_winnt_ignore_void" = "yes" ; then + +$as_echo "#define HAVE_WINNT_IGNORE_VOID 1" >>confdefs.h + + fi + fi + + # See if the compiler supports casting to a union type. + # This is used to stop gcc from printing a compiler + # warning when initializing a union member. + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for cast to union support" >&5 +$as_echo_n "checking for cast to union support... " >&6; } +if ${tcl_cv_cast_to_union+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + union foo { int i; double d; }; + union foo f = (union foo) (int) 0; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_cast_to_union=yes +else + tcl_cv_cast_to_union=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cast_to_union" >&5 +$as_echo "$tcl_cv_cast_to_union" >&6; } + if test "$tcl_cv_cast_to_union" = "yes"; then + +$as_echo "#define HAVE_CAST_TO_UNION 1" >>confdefs.h + + fi + + + + + + + + + + + + + + + # These must be called after we do the basic CFLAGS checks and + # verify any possible 64-bit or similar switches are necessary + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for required early compiler flags" >&5 +$as_echo_n "checking for required early compiler flags... " >&6; } + tcl_flags="" + + if ${tcl_cv_flag__isoc99_source+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +int +main () +{ +char *p = (char *)strtoll; char *q = (char *)strtoull; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_flag__isoc99_source=no +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#define _ISOC99_SOURCE 1 +#include +int +main () +{ +char *p = (char *)strtoll; char *q = (char *)strtoull; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_flag__isoc99_source=yes +else + tcl_cv_flag__isoc99_source=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi + + if test "x${tcl_cv_flag__isoc99_source}" = "xyes" ; then + +$as_echo "#define _ISOC99_SOURCE 1" >>confdefs.h + + tcl_flags="$tcl_flags _ISOC99_SOURCE" + fi + + + if ${tcl_cv_flag__largefile64_source+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +int +main () +{ +struct stat64 buf; int i = stat64("/", &buf); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_flag__largefile64_source=no +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#define _LARGEFILE64_SOURCE 1 +#include +int +main () +{ +struct stat64 buf; int i = stat64("/", &buf); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_flag__largefile64_source=yes +else + tcl_cv_flag__largefile64_source=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi + + if test "x${tcl_cv_flag__largefile64_source}" = "xyes" ; then + +$as_echo "#define _LARGEFILE64_SOURCE 1" >>confdefs.h + + tcl_flags="$tcl_flags _LARGEFILE64_SOURCE" + fi + + + if ${tcl_cv_flag__largefile_source64+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +int +main () +{ +char *p = (char *)open64; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_flag__largefile_source64=no +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#define _LARGEFILE_SOURCE64 1 +#include +int +main () +{ +char *p = (char *)open64; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_flag__largefile_source64=yes +else + tcl_cv_flag__largefile_source64=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi + + if test "x${tcl_cv_flag__largefile_source64}" = "xyes" ; then + +$as_echo "#define _LARGEFILE_SOURCE64 1" >>confdefs.h + + tcl_flags="$tcl_flags _LARGEFILE_SOURCE64" + fi + + if test "x${tcl_flags}" = "x" ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: none" >&5 +$as_echo "none" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: ${tcl_flags}" >&5 +$as_echo "${tcl_flags}" >&6; } + fi + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for 64-bit integer type" >&5 +$as_echo_n "checking for 64-bit integer type... " >&6; } + if ${tcl_cv_type_64bit+:} false; then : + $as_echo_n "(cached) " >&6 +else + + tcl_cv_type_64bit=none + # See if the compiler knows natively about __int64 + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ +__int64 value = (__int64) 0; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + tcl_type_64bit=__int64 +else + tcl_type_64bit="long long" +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + # See if we should use long anyway Note that we substitute in the + # type that is our current guess for a 64-bit type inside this check + # program, so it should be modified only carefully... + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ +switch (0) { + case 1: case (sizeof(${tcl_type_64bit})==sizeof(long)): ; + } + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_type_64bit=${tcl_type_64bit} +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi + + if test "${tcl_cv_type_64bit}" = none ; then + +$as_echo "#define TCL_WIDE_INT_IS_LONG 1" >>confdefs.h + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: using long" >&5 +$as_echo "using long" >&6; } + elif test "${tcl_cv_type_64bit}" = "__int64" \ + -a "${TEA_PLATFORM}" = "windows" ; then + # TEA specific: We actually want to use the default tcl.h checks in + # this case to handle both TCL_WIDE_INT_TYPE and TCL_LL_MODIFIER* + { $as_echo "$as_me:${as_lineno-$LINENO}: result: using Tcl header defaults" >&5 +$as_echo "using Tcl header defaults" >&6; } + else + +cat >>confdefs.h <<_ACEOF +#define TCL_WIDE_INT_TYPE ${tcl_cv_type_64bit} +_ACEOF + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: ${tcl_cv_type_64bit}" >&5 +$as_echo "${tcl_cv_type_64bit}" >&6; } + + # Now check for auxiliary declarations + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for struct dirent64" >&5 +$as_echo_n "checking for struct dirent64... " >&6; } +if ${tcl_cv_struct_dirent64+:} false; then : + $as_echo_n "(cached) " >&6 +else + + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +#include +int +main () +{ +struct dirent64 p; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_struct_dirent64=yes +else + tcl_cv_struct_dirent64=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_struct_dirent64" >&5 +$as_echo "$tcl_cv_struct_dirent64" >&6; } + if test "x${tcl_cv_struct_dirent64}" = "xyes" ; then + +$as_echo "#define HAVE_STRUCT_DIRENT64 1" >>confdefs.h + + fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for struct stat64" >&5 +$as_echo_n "checking for struct stat64... " >&6; } +if ${tcl_cv_struct_stat64+:} false; then : + $as_echo_n "(cached) " >&6 +else + + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +int +main () +{ +struct stat64 p; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_struct_stat64=yes +else + tcl_cv_struct_stat64=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_struct_stat64" >&5 +$as_echo "$tcl_cv_struct_stat64" >&6; } + if test "x${tcl_cv_struct_stat64}" = "xyes" ; then + +$as_echo "#define HAVE_STRUCT_STAT64 1" >>confdefs.h + + fi + + for ac_func in open64 lseek64 +do : + as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` +ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" +if eval test \"x\$"$as_ac_var"\" = x"yes"; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for off64_t" >&5 +$as_echo_n "checking for off64_t... " >&6; } + if ${tcl_cv_type_off64_t+:} false; then : + $as_echo_n "(cached) " >&6 +else + + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +int +main () +{ +off64_t offset; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + tcl_cv_type_off64_t=yes +else + tcl_cv_type_off64_t=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi + + if test "x${tcl_cv_type_off64_t}" = "xyes" && \ + test "x${ac_cv_func_lseek64}" = "xyes" && \ + test "x${ac_cv_func_open64}" = "xyes" ; then + +$as_echo "#define HAVE_TYPE_OFF64_T 1" >>confdefs.h + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + fi + fi + + + +#-------------------------------------------------------------------- +# Set the default compiler switches based on the --enable-symbols option. +#-------------------------------------------------------------------- + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for build with symbols" >&5 +$as_echo_n "checking for build with symbols... " >&6; } + # Check whether --enable-symbols was given. +if test "${enable_symbols+set}" = set; then : + enableval=$enable_symbols; tcl_ok=$enableval +else + tcl_ok=no +fi + + DBGX="" + if test "$tcl_ok" = "no"; then + CFLAGS_DEFAULT="${CFLAGS_OPTIMIZE} -DNDEBUG" + LDFLAGS_DEFAULT="${LDFLAGS_OPTIMIZE}" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + else + CFLAGS_DEFAULT="${CFLAGS_DEBUG}" + LDFLAGS_DEFAULT="${LDFLAGS_DEBUG}" + if test "$tcl_ok" = "yes"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes (standard debugging)" >&5 +$as_echo "yes (standard debugging)" >&6; } + fi + fi + # TEA specific: + if test "${TEA_PLATFORM}" != "windows" ; then + LDFLAGS_DEFAULT="${LDFLAGS}" + fi + + + + + if test "$tcl_ok" = "mem" -o "$tcl_ok" = "all"; then + +$as_echo "#define TCL_MEM_DEBUG 1" >>confdefs.h + + fi + + if test "$tcl_ok" != "yes" -a "$tcl_ok" != "no"; then + if test "$tcl_ok" = "all"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: enabled symbols mem debugging" >&5 +$as_echo "enabled symbols mem debugging" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: enabled $tcl_ok debugging" >&5 +$as_echo "enabled $tcl_ok debugging" >&6; } + fi + fi + + +#-------------------------------------------------------------------- +# This macro generates a line to use when building a library. It +# depends on values set by the TEA_ENABLE_SHARED, TEA_ENABLE_SYMBOLS, +# and TEA_LOAD_TCLCONFIG macros above. +#-------------------------------------------------------------------- + + + PRACTCL_TOOLSET="gcc" + PRACTCL_VC_MANIFEST_EMBED_DLL=: + PRACTCL_VC_MANIFEST_EMBED_EXE=: + if test "${TEA_PLATFORM}" = "windows" -a "$GCC" != "yes"; then + PRACTCL_TOOLSET="msvc" + PRACTCL_STATIC_LIB="%STLIB_LD% -out:%OUTFILE% %LIBRARY_OBJECTS%" + PRACTCL_SHARED_LIB="%SHLIB_LD% %SHLIB_LD_LIBS% %LDFLAGS_DEFAULT% -out:%OUTFILE% %LIBRARY_OBJECTS%" + MAKE_STATIC_LIB="\${STLIB_LD} -out:\$@ \$(PKG_OBJECTS)" + MAKE_SHARED_LIB="\${SHLIB_LD} \${SHLIB_LD_LIBS} \${LDFLAGS_DEFAULT} -out:\$@ \$(PKG_OBJECTS)" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#if defined(_MSC_VER) && _MSC_VER >= 1400 +print("manifest needed") +#endif + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "manifest needed" >/dev/null 2>&1; then : + + # Could do a CHECK_PROG for mt, but should always be with MSVC8+ + PRACTCL_VC_MANIFEST_EMBED_DLL="mt.exe -nologo -manifest %OUTFILE%.manifest -outputresource:%OUTFILE%\;2" + PRACTCL_VC_MANIFEST_EMBED_EXE="mt.exe -nologo -manifest %OUTFILE%.manifest -outputresource:%OUTFILE%\;1" + VC_MANIFEST_EMBED_DLL="if test -f \$@.manifest ; then mt.exe -nologo -manifest \$@.manifest -outputresource:\$@\;2 ; fi" + VC_MANIFEST_EMBED_EXE="if test -f \$@.manifest ; then mt.exe -nologo -manifest \$@.manifest -outputresource:\$@\;1 ; fi" + MAKE_SHARED_LIB="${MAKE_SHARED_LIB} ; ${VC_MANIFEST_EMBED_DLL}" + + CLEANFILES="$CLEANFILES *.manifest" + + +fi +rm -f conftest* + + PRACTCL_STUB_LIB="%STLIB_LD% -nodefaultlib -out:%OUTFILE% %LIBRARY_OBJECTS%" + MAKE_STUB_LIB="\${STLIB_LD} -nodefaultlib -out:\$@ \$(PKG_STUB_OBJECTS)" + else + MAKE_STATIC_LIB="\${STLIB_LD} \$@ \$(PKG_OBJECTS)" + MAKE_SHARED_LIB="\${SHLIB_LD} -o \$@ \$(PKG_OBJECTS) \${SHLIB_LD_LIBS}" + MAKE_STUB_LIB="\${STLIB_LD} \$@ \$(PKG_STUB_OBJECTS)" + + PRACTCL_STATIC_LIB="%STLIB_LD% %OUTFILE% %LIBRARY_OBJECTS%" + PRACTCL_SHARED_LIB="%SHLIB_LD% -o %OUTFILE% %LIBRARY_OBJECTS% %SHLIB_LD_LIBS%" + PRACTCL_STUB_LIB="%STLIB_LD% %OUTFILE% %LIBRARY_OBJECTS%" + fi + + if test "${SHARED_BUILD}" = "1" ; then + MAKE_LIB="${MAKE_SHARED_LIB} " + else + MAKE_LIB="${MAKE_STATIC_LIB} " + fi + + #-------------------------------------------------------------------- + # Shared libraries and static libraries have different names. + # Use the double eval to make sure any variables in the suffix is + # substituted. (@@@ Might not be necessary anymore) + #-------------------------------------------------------------------- + if test "${TEA_PLATFORM}" = "windows" ; then + PRACTCL_NAME_LIBRARY="%LIBRARY_PREFIX%%LIBRARY_NAME%%LIBRARY_VERSION_NODOTS%" + if test "${SHARED_BUILD}" = "1" ; then + # We force the unresolved linking of symbols that are really in + # the private libraries of Tcl and Tk. + if test x"${TK_BIN_DIR}" != x ; then + SHLIB_LD_LIBS="${SHLIB_LD_LIBS} \"`${CYGPATH} ${TK_BIN_DIR}/${TK_STUB_LIB_FILE}`\"" + fi + SHLIB_LD_LIBS="${SHLIB_LD_LIBS} \"`${CYGPATH} ${TCL_BIN_DIR}/${TCL_STUB_LIB_FILE}`\"" + if test "$GCC" = "yes"; then + SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -static-libgcc" + fi + eval eval "PKG_LIB_FILE=${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}${SHARED_LIB_SUFFIX}" + else + eval eval "PKG_LIB_FILE=${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}${UNSHARED_LIB_SUFFIX}" + if test "$GCC" = "yes"; then + PKG_LIB_FILE=lib${PKG_LIB_FILE} + fi + fi + # Some packages build their own stubs libraries + eval eval "PKG_STUB_LIB_FILE=${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}stub${UNSHARED_LIB_SUFFIX}" + if test "$GCC" = "yes"; then + PKG_STUB_LIB_FILE=lib${PKG_STUB_LIB_FILE} + fi + # These aren't needed on Windows (either MSVC or gcc) + RANLIB=: + RANLIB_STUB=: + else + PRACTCL_NAME_LIBRARY="lib%LIBRARY_PREFIX%%LIBRARY_NAME%%LIBRARY_VERSION%" + RANLIB_STUB="${RANLIB}" + if test "${SHARED_BUILD}" = "1" ; then + SHLIB_LD_LIBS="${SHLIB_LD_LIBS} ${TCL_STUB_LIB_SPEC}" + if test x"${TK_BIN_DIR}" != x ; then + SHLIB_LD_LIBS="${SHLIB_LD_LIBS} ${TK_STUB_LIB_SPEC}" + fi + eval eval "PKG_LIB_FILE=lib${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}${SHARED_LIB_SUFFIX}" + RANLIB=: + else + eval eval "PKG_LIB_FILE=lib${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}${UNSHARED_LIB_SUFFIX}" + fi + # Some packages build their own stubs libraries + eval eval "PKG_STUB_LIB_FILE=lib${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}stub${UNSHARED_LIB_SUFFIX}" + fi + + # Store the raw CFLAGS before we add the trimmings + PRACTCL_CFLAGS=${CFLAGS} + # These are escaped so that only CFLAGS is picked up at configure time. + # The other values will be substituted at make time. + CFLAGS="${CFLAGS} \${CFLAGS_DEFAULT} \${CFLAGS_WARNING}" + if test "${SHARED_BUILD}" = "1" ; then + CFLAGS="${CFLAGS} \${SHLIB_CFLAGS}" + fi + + + + + + + + + + + + + + + + + + +#-------------------------------------------------------------------- +# Determine the name of the tclsh and/or wish executables in the +# Tcl and Tk build directories or the location they were installed +# into. These paths are used to support running test cases only, +# the Makefile should not be making use of these paths to generate +# a pkgIndex.tcl file or anything else at extension build time. +#-------------------------------------------------------------------- + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for tclsh" >&5 +$as_echo_n "checking for tclsh... " >&6; } + + +# Check whether --with-tclsh was given. +if test "${with_tclsh+set}" = set; then : + withval=$with_tclsh; with_tclsh=${withval} +fi + + # Use the value from --with-tclsh, if it was given + TCLSH_PROG=0 + if test x"${with_tclsh}" != x ; then + if test -f "${with_tclsh}" ; then + TCLSH_PROG=${with_tclsh} + else + if test -f "${with_tclsh}/tcl8.6" ; then + TCLSH_PROG="${with_tclsh}/tcl8.6" + else + if test -f "${with_tclsh}/tclsh86.exe" ; then + TCLSH_PROG="${with_tclsh}/tclsh86.exe" + else + as_fn_error $? "${with_tclsh} does not point to a valid Tcl executable" "$LINENO" 5 + fi + fi + fi + else + if test -f "${TCL_BIN_DIR}/Makefile" ; then + # tclConfig.sh is in Tcl build directory + if test "${TEA_PLATFORM}" = "windows"; then + if test -f "${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}${EXEEXT}" ; then + TCLSH_PROG="${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}${EXEEXT}" + elif test -f "${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}s${EXEEXT}" ; then + TCLSH_PROG="${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}s${EXEEXT}" + elif test -f "${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}t${EXEEXT}" ; then + TCLSH_PROG="${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}t${EXEEXT}" + elif test -f "${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}st${EXEEXT}" ; then + TCLSH_PROG="${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}st${EXEEXT}" + fi + else + TCLSH_PROG="${TCL_BIN_DIR}/tclsh" + fi + else + # tclConfig.sh is in install location + if test "${TEA_PLATFORM}" = "windows"; then + TCLSH_PROG="tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}${EXEEXT}" + else + TCLSH_PROG="tclsh${TCL_MAJOR_VERSION}.${TCL_MINOR_VERSION}${TCL_DBGX}" + fi + list="`ls -d ${TCL_BIN_DIR}/../bin 2>/dev/null` \ + `ls -d ${TCL_BIN_DIR}/.. 2>/dev/null` \ + `ls -d ${TCL_PREFIX}/bin 2>/dev/null`" + for i in $list ; do + if test -f "$i/${TCLSH_PROG}" ; then + REAL_TCL_BIN_DIR="`cd "$i"; pwd`/" + break + fi + done + TCLSH_PROG="${REAL_TCL_BIN_DIR}${TCLSH_PROG}" + fi + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: result: ${TCLSH_PROG}" >&5 +$as_echo "${TCLSH_PROG}" >&6; } + + +#TEA_PROG_WISH + +#-------------------------------------------------------------------- +# Load libxml2 configuration +#-------------------------------------------------------------------- + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for xml2-config script" >&5 +$as_echo_n "checking for xml2-config script... " >&6; } + + +# Check whether --with-xml2-config was given. +if test "${with_xml2_config+set}" = set; then : + withval=$with_xml2_config; with_xml2_config=${withval} +fi + + +LIBXML2_CONFIG= +if test "x${with_xml2_config}" = "x" ; then + for c in \ + /Library/Frameworks/libxml.framework/Resources/Scripts/xml2-config \ + ${prefix}/bin/xml2-config \ + /usr/bin/xml2-config \ + /usr/local/bin/xml2-config + do + if test -x "$c" ; then + LIBXML2_CONFIG="$c" + break + fi + done +else + LIBXML2_CONFIG="${with_xml2_config}" +fi +if test "x$LIBXML2_CONFIG" = "x" ; then + as_fn_error $? "unable to find xml2-config" "$LINENO" 5 +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: ${LIBXML2_CONFIG}" >&5 +$as_echo "${LIBXML2_CONFIG}" >&6; } + XML2_CFLAGS=`${LIBXML2_CONFIG} --cflags` + XML2_LIBS="`${LIBXML2_CONFIG} --libs`" +fi + + + + +#-------------------------------------------------------------------- +# Load libxslt configuration +#-------------------------------------------------------------------- + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for xslt-config script" >&5 +$as_echo_n "checking for xslt-config script... " >&6; } + + +# Check whether --with-xslt-config was given. +if test "${with_xslt_config+set}" = set; then : + withval=$with_xslt_config; with_xslt_config=${withval} +fi + + +LIBXSLT_CONFIG= +if test "x${with_xslt_config}" = "x" ; then + if test "x${with_xml2_config}" = "x" ; then + : + else + if test -x "`dirname ${with_xml2_config}`/xslt-config" ; then + LIBXSLT_CONFIG="`dirname ${with_xml2_config}`/xslt-config" + fi + fi +else + LIBXSLT_CONFIG="${with_xslt_config}" +fi +if test "x${LIBXSLT_CONFIG}" = "x" ; then + for c in \ + /Library/Frameworks/libxslt.framework/Resources/Scripts/xslt-config \ + ${prefix}/bin/xslt-config \ + /usr/bin/xslt-config \ + /usr/local/bin/xslt-config + do + if test -x "$c" ; then + LIBXSLT_CONFIG="$c" + break + fi + done +fi +if test "x$LIBXSLT_CONFIG" = "x" ; then + as_fn_error $? "unable to find xslt-config script" "$LINENO" 5 +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: ${LIBXSLT_CONFIG}" >&5 +$as_echo "${LIBXSLT_CONFIG}" >&6; } + XSLT_CFLAGS=`${LIBXSLT_CONFIG} --cflags` + XSLT_LIBS="`${LIBXSLT_CONFIG} --libs` -lexslt" +fi + + + + +#-------------------------------------------------------------------- +# See if we want to statically link the libxml2 and libxslt +# libraries. This is desirable for Tclkit. +#-------------------------------------------------------------------- + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for static linking of XML/XSLT libraries" >&5 +$as_echo_n "checking for static linking of XML/XSLT libraries... " >&6; } + +# Check whether --with-xml-static was given. +if test "${with_xml_static+set}" = set; then : + withval=$with_xml_static; with_xml_static=${withval} +fi + + +if test "x${with_xml_static}" = "x" ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: use dynamic linking" >&5 +$as_echo "use dynamic linking" >&6; } +else + + PKG_CFLAGS="$PKG_CFLAGS -DLIBXML_STATIC -DLIBXSLT_STATIC" + + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: use static linking" >&5 +$as_echo "use static linking" >&6; } +fi + +#-------------------------------------------------------------------- +# These are for tclxmlConfig.sh +#-------------------------------------------------------------------- + + + #-------------------------------------------------------------------- + # These are for tclxmlConfig.sh + #-------------------------------------------------------------------- + + # pkglibdir must be a fully qualified path and (not ${exec_prefix}/lib) + eval pkglibdir="${libdir}/tclxml${PACKAGE_VERSION}" + if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then + eval tclxml_LIB_FLAG="-ltclxml${PACKAGE_VERSION}${DBGX}" + eval tclxml_STUB_LIB_FLAG="-ltclxmlstub${PACKAGE_VERSION}${DBGX}" + else + eval tclxml_LIB_FLAG="-ltclxml`echo ${PACKAGE_VERSION} | tr -d .`${DBGX}" + eval tclxml_STUB_LIB_FLAG="-ltclxmlstub`echo ${PACKAGE_VERSION} | tr -d .`${DBGX}" + fi + tclxml_BUILD_LIB_SPEC="-L`$CYGPATH $(pwd)` ${tclxml_LIB_FLAG}" + tclxml_LIB_SPEC="-L`$CYGPATH ${pkglibdir}` ${tclxml_LIB_FLAG}" + tclxml_BUILD_STUB_LIB_SPEC="-L`$CYGPATH $(pwd)` ${tclxml_STUB_LIB_FLAG}" + tclxml_STUB_LIB_SPEC="-L`$CYGPATH ${pkglibdir}` ${tclxml_STUB_LIB_FLAG}" + tclxml_BUILD_STUB_LIB_PATH="`$CYGPATH $(pwd)`/${PKG_STUB_LIB_FILE}" + tclxml_STUB_LIB_PATH="`$CYGPATH ${pkglibdir}`/${PKG_STUB_LIB_FILE}" + + + + + + + + + + + + + +#-------------------------------------------------------------------- +# Finally, substitute all of the various values into the Makefile. +# You may alternatively have a special pkgIndex.tcl.in or other files +# which require substituting th AC variables in. Include these here. +#-------------------------------------------------------------------- + +ac_config_files="$ac_config_files Makefile pkgIndex.tcl include/tclxml/tclxml.h tclxmlConfig.sh" + +cat >confcache <<\_ACEOF +# This file is a shell script that caches the results of configure +# tests run on this system so they can be shared between configure +# scripts and configure runs, see configure's option --config-cache. +# It is not useful on other systems. If it contains results you don't +# want to keep, you may remove or edit it. +# +# config.status only pays attention to the cache file if you give it +# the --recheck option to rerun configure. +# +# `ac_cv_env_foo' variables (set or unset) will be overridden when +# loading this file, other *unset* `ac_cv_foo' will be assigned the +# following values. + +_ACEOF + +# The following way of writing the cache mishandles newlines in values, +# but we know of no workaround that is simple, portable, and efficient. +# So, we kill variables containing newlines. +# Ultrix sh set writes to stderr and can't be redirected directly, +# and sets the high bit in the cache file unless we assign to the vars. +( + for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do + eval ac_val=\$$ac_var + case $ac_val in #( + *${as_nl}*) + case $ac_var in #( + *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 +$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( + *) { eval $ac_var=; unset $ac_var;} ;; + esac ;; + esac + done + + (set) 2>&1 | + case $as_nl`(ac_space=' '; set) 2>&1` in #( + *${as_nl}ac_space=\ *) + # `set' does not quote correctly, so add quotes: double-quote + # substitution turns \\\\ into \\, and sed turns \\ into \. + sed -n \ + "s/'/'\\\\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" + ;; #( + *) + # `set' quotes correctly as required by POSIX, so do not add quotes. + sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" + ;; + esac | + sort +) | + sed ' + /^ac_cv_env_/b end + t clear + :clear + s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ + t end + s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ + :end' >>confcache +if diff "$cache_file" confcache >/dev/null 2>&1; then :; else + if test -w "$cache_file"; then + if test "x$cache_file" != "x/dev/null"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5 +$as_echo "$as_me: updating cache $cache_file" >&6;} + if test ! -f "$cache_file" || test -h "$cache_file"; then + cat confcache >"$cache_file" + else + case $cache_file in #( + */* | ?:*) + mv -f confcache "$cache_file"$$ && + mv -f "$cache_file"$$ "$cache_file" ;; #( + *) + mv -f confcache "$cache_file" ;; + esac + fi + fi + else + { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5 +$as_echo "$as_me: not updating unwritable cache $cache_file" >&6;} + fi +fi +rm -f confcache + +test "x$prefix" = xNONE && prefix=$ac_default_prefix +# Let make expand exec_prefix. +test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' + +# Transform confdefs.h into DEFS. +# Protect against shell expansion while executing Makefile rules. +# Protect against Makefile macro expansion. +# +# If the first sed substitution is executed (which looks for macros that +# take arguments), then branch to the quote section. Otherwise, +# look for a macro that doesn't take arguments. +ac_script=' +:mline +/\\$/{ + N + s,\\\n,, + b mline +} +t clear +:clear +s/^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\)/-D\1=\2/g +t quote +s/^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\)/-D\1=\2/g +t quote +b any +:quote +s/[ `~#$^&*(){}\\|;'\''"<>?]/\\&/g +s/\[/\\&/g +s/\]/\\&/g +s/\$/$$/g +H +:any +${ + g + s/^\n// + s/\n/ /g + p +} +' +DEFS=`sed -n "$ac_script" confdefs.h` + + +ac_libobjs= +ac_ltlibobjs= +U= +for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue + # 1. Remove the extension, and $U if already installed. + ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' + ac_i=`$as_echo "$ac_i" | sed "$ac_script"` + # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR + # will be set to the directory where LIBOBJS objects are built. + as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext" + as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo' +done +LIBOBJS=$ac_libobjs + +LTLIBOBJS=$ac_ltlibobjs + + + +CFLAGS="${CFLAGS} ${CPPFLAGS}"; CPPFLAGS="" + +: "${CONFIG_STATUS=./config.status}" +ac_write_fail=0 +ac_clean_files_save=$ac_clean_files +ac_clean_files="$ac_clean_files $CONFIG_STATUS" +{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5 +$as_echo "$as_me: creating $CONFIG_STATUS" >&6;} +as_write_fail=0 +cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1 +#! $SHELL +# Generated by $as_me. +# Run this file to recreate the current configuration. +# Compiler output produced by configure, useful for debugging +# configure, is in config.log if it exists. + +debug=false +ac_cs_recheck=false +ac_cs_silent=false + +SHELL=\${CONFIG_SHELL-$SHELL} +export SHELL +_ASEOF +cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1 +## -------------------- ## +## M4sh Initialization. ## +## -------------------- ## + +# Be more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi + + +as_nl=' +' +export as_nl +# Printing a long string crashes Solaris 7 /usr/bin/printf. +as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo +# Prefer a ksh shell builtin over an external printf program on Solaris, +# but without wasting forks for bash or zsh. +if test -z "$BASH_VERSION$ZSH_VERSION" \ + && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='print -r --' + as_echo_n='print -rn --' +elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='printf %s\n' + as_echo_n='printf %s' +else + if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then + as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' + as_echo_n='/usr/ucb/echo -n' + else + as_echo_body='eval expr "X$1" : "X\\(.*\\)"' + as_echo_n_body='eval + arg=$1; + case $arg in #( + *"$as_nl"*) + expr "X$arg" : "X\\(.*\\)$as_nl"; + arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; + esac; + expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" + ' + export as_echo_n_body + as_echo_n='sh -c $as_echo_n_body as_echo' + fi + export as_echo_body + as_echo='sh -c $as_echo_body as_echo' +fi + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } +fi + + +# IFS +# We need space, tab and new line, in precisely that order. Quoting is +# there to prevent editors from complaining about space-tab. +# (If _AS_PATH_WALK were called with IFS unset, it would disable word +# splitting by setting IFS to empty value.) +IFS=" "" $as_nl" + +# Find who we are. Look in the path if we contain no directory separator. +as_myself= +case $0 in #(( + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break + done +IFS=$as_save_IFS + + ;; +esac +# We did not find ourselves, most probably we were run as `sh COMMAND' +# in which case we are not to be found in the path. +if test "x$as_myself" = x; then + as_myself=$0 +fi +if test ! -f "$as_myself"; then + $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + exit 1 +fi + +# Unset variables that we do not need and which cause bugs (e.g. in +# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" +# suppresses any "Segmentation fault" message there. '((' could +# trigger a bug in pdksh 5.2.14. +for as_var in BASH_ENV ENV MAIL MAILPATH +do eval test x\${$as_var+set} = xset \ + && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : +done +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE + +# CDPATH. +(unset CDPATH) >/dev/null 2>&1 && unset CDPATH + + +# as_fn_error STATUS ERROR [LINENO LOG_FD] +# ---------------------------------------- +# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are +# provided, also output the error to LOG_FD, referencing LINENO. Then exit the +# script with STATUS, using 1 if that was 0. +as_fn_error () +{ + as_status=$1; test $as_status -eq 0 && as_status=1 + if test "$4"; then + as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 + fi + $as_echo "$as_me: error: $2" >&2 + as_fn_exit $as_status +} # as_fn_error + + +# as_fn_set_status STATUS +# ----------------------- +# Set $? to STATUS, without forking. +as_fn_set_status () +{ + return $1 +} # as_fn_set_status + +# as_fn_exit STATUS +# ----------------- +# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. +as_fn_exit () +{ + set +e + as_fn_set_status $1 + exit $1 +} # as_fn_exit + +# as_fn_unset VAR +# --------------- +# Portably unset VAR. +as_fn_unset () +{ + { eval $1=; unset $1;} +} +as_unset=as_fn_unset +# as_fn_append VAR VALUE +# ---------------------- +# Append the text in VALUE to the end of the definition contained in VAR. Take +# advantage of any shell optimizations that allow amortized linear growth over +# repeated appends, instead of the typical quadratic growth present in naive +# implementations. +if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : + eval 'as_fn_append () + { + eval $1+=\$2 + }' +else + as_fn_append () + { + eval $1=\$$1\$2 + } +fi # as_fn_append + +# as_fn_arith ARG... +# ------------------ +# Perform arithmetic evaluation on the ARGs, and store the result in the +# global $as_val. Take advantage of shells that can avoid forks. The arguments +# must be portable across $(()) and expr. +if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : + eval 'as_fn_arith () + { + as_val=$(( $* )) + }' +else + as_fn_arith () + { + as_val=`expr "$@" || test $? -eq 1` + } +fi # as_fn_arith + + +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then + as_expr=expr +else + as_expr=false +fi + +if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +as_me=`$as_basename -- "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in #((((( +-n*) + case `echo 'xy\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + xy) ECHO_C='\c';; + *) echo `echo ksh88 bug on AIX 6.1` > /dev/null + ECHO_T=' ';; + esac;; +*) + ECHO_N='-n';; +esac + +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file +else + rm -f conf$$.dir + mkdir conf$$.dir 2>/dev/null +fi +if (echo >conf$$.file) 2>/dev/null; then + if ln -s conf$$.file conf$$ 2>/dev/null; then + as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -pR'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -pR' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else + as_ln_s='cp -pR' + fi +else + as_ln_s='cp -pR' +fi +rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + + +# as_fn_mkdir_p +# ------------- +# Create "$as_dir" as a directory, including parents if necessary. +as_fn_mkdir_p () +{ + + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || eval $as_mkdir_p || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( + *) as_qdir=$as_dir;; + esac + as_dirs="'$as_qdir' $as_dirs" + as_dir=`$as_dirname -- "$as_dir" || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + test -d "$as_dir" && break + done + test -z "$as_dirs" || eval "mkdir $as_dirs" + } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" + + +} # as_fn_mkdir_p +if mkdir -p . 2>/dev/null; then + as_mkdir_p='mkdir -p "$as_dir"' +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + + +# as_fn_executable_p FILE +# ----------------------- +# Test if FILE is an executable regular file. +as_fn_executable_p () +{ + test -f "$1" && test -x "$1" +} # as_fn_executable_p +as_test_x='test -x' +as_executable_p=as_fn_executable_p + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + + +exec 6>&1 +## ----------------------------------- ## +## Main body of $CONFIG_STATUS script. ## +## ----------------------------------- ## +_ASEOF +test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1 + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# Save the log message, to keep $0 and so on meaningful, and to +# report actual input values of CONFIG_FILES etc. instead of their +# values after options handling. +ac_log=" +This file was extended by tclxml $as_me 3.2, which was +generated by GNU Autoconf 2.69. Invocation command line was + + CONFIG_FILES = $CONFIG_FILES + CONFIG_HEADERS = $CONFIG_HEADERS + CONFIG_LINKS = $CONFIG_LINKS + CONFIG_COMMANDS = $CONFIG_COMMANDS + $ $0 $@ + +on `(hostname || uname -n) 2>/dev/null | sed 1q` +" + +_ACEOF + +case $ac_config_files in *" +"*) set x $ac_config_files; shift; ac_config_files=$*;; +esac + + + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +# Files that config.status was made for. +config_files="$ac_config_files" + +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +ac_cs_usage="\ +\`$as_me' instantiates files and other configuration actions +from templates according to the current configuration. Unless the files +and actions are specified as TAGs, all are instantiated by default. + +Usage: $0 [OPTION]... [TAG]... + + -h, --help print this help, then exit + -V, --version print version number and configuration settings, then exit + --config print configuration, then exit + -q, --quiet, --silent + do not print progress messages + -d, --debug don't remove temporary files + --recheck update $as_me by reconfiguring in the same conditions + --file=FILE[:TEMPLATE] + instantiate the configuration file FILE + +Configuration files: +$config_files + +Report bugs to the package provider." + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" +ac_cs_version="\\ +tclxml config.status 3.2 +configured by $0, generated by GNU Autoconf 2.69, + with options \\"\$ac_cs_config\\" + +Copyright (C) 2012 Free Software Foundation, Inc. +This config.status script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it." + +ac_pwd='$ac_pwd' +srcdir='$srcdir' +test -n "\$AWK" || AWK=awk +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# The default lists apply if the user does not specify any file. +ac_need_defaults=: +while test $# != 0 +do + case $1 in + --*=?*) + ac_option=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` + ac_shift=: + ;; + --*=) + ac_option=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg= + ac_shift=: + ;; + *) + ac_option=$1 + ac_optarg=$2 + ac_shift=shift + ;; + esac + + case $ac_option in + # Handling of the options. + -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) + ac_cs_recheck=: ;; + --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) + $as_echo "$ac_cs_version"; exit ;; + --config | --confi | --conf | --con | --co | --c ) + $as_echo "$ac_cs_config"; exit ;; + --debug | --debu | --deb | --de | --d | -d ) + debug=: ;; + --file | --fil | --fi | --f ) + $ac_shift + case $ac_optarg in + *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; + '') as_fn_error $? "missing file argument" ;; + esac + as_fn_append CONFIG_FILES " '$ac_optarg'" + ac_need_defaults=false;; + --he | --h | --help | --hel | -h ) + $as_echo "$ac_cs_usage"; exit ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil | --si | --s) + ac_cs_silent=: ;; + + # This is an error. + -*) as_fn_error $? "unrecognized option: \`$1' +Try \`$0 --help' for more information." ;; + + *) as_fn_append ac_config_targets " $1" + ac_need_defaults=false ;; + + esac + shift +done + +ac_configure_extra_args= + +if $ac_cs_silent; then + exec 6>/dev/null + ac_configure_extra_args="$ac_configure_extra_args --silent" +fi + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +if \$ac_cs_recheck; then + set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion + shift + \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6 + CONFIG_SHELL='$SHELL' + export CONFIG_SHELL + exec "\$@" +fi + +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +exec 5>>config.log +{ + echo + sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX +## Running $as_me. ## +_ASBOX + $as_echo "$ac_log" +} >&5 + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 + +# Handling of arguments. +for ac_config_target in $ac_config_targets +do + case $ac_config_target in + "Makefile") CONFIG_FILES="$CONFIG_FILES Makefile" ;; + "pkgIndex.tcl") CONFIG_FILES="$CONFIG_FILES pkgIndex.tcl" ;; + "include/tclxml/tclxml.h") CONFIG_FILES="$CONFIG_FILES include/tclxml/tclxml.h" ;; + "tclxmlConfig.sh") CONFIG_FILES="$CONFIG_FILES tclxmlConfig.sh" ;; + + *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;; + esac +done + + +# If the user did not use the arguments to specify the items to instantiate, +# then the envvar interface is used. Set only those that are not. +# We use the long form for the default assignment because of an extremely +# bizarre bug on SunOS 4.1.3. +if $ac_need_defaults; then + test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files +fi + +# Have a temporary directory for convenience. Make it in the build tree +# simply because there is no reason against having it here, and in addition, +# creating and moving files from /tmp can sometimes cause problems. +# Hook for its removal unless debugging. +# Note that there is a small window in which the directory will not be cleaned: +# after its creation but before its name has been assigned to `$tmp'. +$debug || +{ + tmp= ac_tmp= + trap 'exit_status=$? + : "${ac_tmp:=$tmp}" + { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status +' 0 + trap 'as_fn_exit 1' 1 2 13 15 +} +# Create a (secure) tmp directory for tmp files. + +{ + tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && + test -d "$tmp" +} || +{ + tmp=./conf$$-$RANDOM + (umask 077 && mkdir "$tmp") +} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5 +ac_tmp=$tmp + +# Set up the scripts for CONFIG_FILES section. +# No need to generate them if there are no CONFIG_FILES. +# This happens for instance with `./config.status config.h'. +if test -n "$CONFIG_FILES"; then + + +ac_cr=`echo X | tr X '\015'` +# On cygwin, bash can eat \r inside `` if the user requested igncr. +# But we know of no other shell where ac_cr would be empty at this +# point, so we can use a bashism as a fallback. +if test "x$ac_cr" = x; then + eval ac_cr=\$\'\\r\' +fi +ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' /dev/null` +if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then + ac_cs_awk_cr='\\r' +else + ac_cs_awk_cr=$ac_cr +fi + +echo 'BEGIN {' >"$ac_tmp/subs1.awk" && +_ACEOF + + +{ + echo "cat >conf$$subs.awk <<_ACEOF" && + echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' && + echo "_ACEOF" +} >conf$$subs.sh || + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 +ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'` +ac_delim='%!_!# ' +for ac_last_try in false false false false false :; do + . ./conf$$subs.sh || + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 + + ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X` + if test $ac_delim_n = $ac_delim_num; then + break + elif $ac_last_try; then + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 + else + ac_delim="$ac_delim!$ac_delim _$ac_delim!! " + fi +done +rm -f conf$$subs.sh + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK && +_ACEOF +sed -n ' +h +s/^/S["/; s/!.*/"]=/ +p +g +s/^[^!]*!// +:repl +t repl +s/'"$ac_delim"'$// +t delim +:nl +h +s/\(.\{148\}\)..*/\1/ +t more1 +s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/ +p +n +b repl +:more1 +s/["\\]/\\&/g; s/^/"/; s/$/"\\/ +p +g +s/.\{148\}// +t nl +:delim +h +s/\(.\{148\}\)..*/\1/ +t more2 +s/["\\]/\\&/g; s/^/"/; s/$/"/ +p +b +:more2 +s/["\\]/\\&/g; s/^/"/; s/$/"\\/ +p +g +s/.\{148\}// +t delim +' >$CONFIG_STATUS || ac_write_fail=1 +rm -f conf$$subs.awk +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +_ACAWK +cat >>"\$ac_tmp/subs1.awk" <<_ACAWK && + for (key in S) S_is_set[key] = 1 + FS = "" + +} +{ + line = $ 0 + nfields = split(line, field, "@") + substed = 0 + len = length(field[1]) + for (i = 2; i < nfields; i++) { + key = field[i] + keylen = length(key) + if (S_is_set[key]) { + value = S[key] + line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3) + len += length(value) + length(field[++i]) + substed = 1 + } else + len += 1 + keylen + } + + print line +} + +_ACAWK +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then + sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g" +else + cat +fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \ + || as_fn_error $? "could not setup config files machinery" "$LINENO" 5 +_ACEOF + +# VPATH may cause trouble with some makes, so we remove sole $(srcdir), +# ${srcdir} and @srcdir@ entries from VPATH if srcdir is ".", strip leading and +# trailing colons and then remove the whole line if VPATH becomes empty +# (actually we leave an empty line to preserve line numbers). +if test "x$srcdir" = x.; then + ac_vpsub='/^[ ]*VPATH[ ]*=[ ]*/{ +h +s/// +s/^/:/ +s/[ ]*$/:/ +s/:\$(srcdir):/:/g +s/:\${srcdir}:/:/g +s/:@srcdir@:/:/g +s/^:*// +s/:*$// +x +s/\(=[ ]*\).*/\1/ +G +s/\n// +s/^[^=]*=[ ]*$// +}' +fi + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +fi # test -n "$CONFIG_FILES" + + +eval set X " :F $CONFIG_FILES " +shift +for ac_tag +do + case $ac_tag in + :[FHLC]) ac_mode=$ac_tag; continue;; + esac + case $ac_mode$ac_tag in + :[FHL]*:*);; + :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;; + :[FH]-) ac_tag=-:-;; + :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; + esac + ac_save_IFS=$IFS + IFS=: + set x $ac_tag + IFS=$ac_save_IFS + shift + ac_file=$1 + shift + + case $ac_mode in + :L) ac_source=$1;; + :[FH]) + ac_file_inputs= + for ac_f + do + case $ac_f in + -) ac_f="$ac_tmp/stdin";; + *) # Look for the file first in the build tree, then in the source tree + # (if the path is not absolute). The absolute path cannot be DOS-style, + # because $ac_f cannot contain `:'. + test -f "$ac_f" || + case $ac_f in + [\\/$]*) false;; + *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; + esac || + as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;; + esac + case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac + as_fn_append ac_file_inputs " '$ac_f'" + done + + # Let's still pretend it is `configure' which instantiates (i.e., don't + # use $as_me), people would be surprised to read: + # /* config.h. Generated by config.status. */ + configure_input='Generated from '` + $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g' + `' by configure.' + if test x"$ac_file" != x-; then + configure_input="$ac_file. $configure_input" + { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5 +$as_echo "$as_me: creating $ac_file" >&6;} + fi + # Neutralize special characters interpreted by sed in replacement strings. + case $configure_input in #( + *\&* | *\|* | *\\* ) + ac_sed_conf_input=`$as_echo "$configure_input" | + sed 's/[\\\\&|]/\\\\&/g'`;; #( + *) ac_sed_conf_input=$configure_input;; + esac + + case $ac_tag in + *:-:* | *:-) cat >"$ac_tmp/stdin" \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; + esac + ;; + esac + + ac_dir=`$as_dirname -- "$ac_file" || +$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$ac_file" : 'X\(//\)[^/]' \| \ + X"$ac_file" : 'X\(//\)$' \| \ + X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$ac_file" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + as_dir="$ac_dir"; as_fn_mkdir_p + ac_builddir=. + +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` + case $ac_top_builddir_sub in + "") ac_top_builddir_sub=. ac_top_build_prefix= ;; + *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; + esac ;; +esac +ac_abs_top_builddir=$ac_pwd +ac_abs_builddir=$ac_pwd$ac_dir_suffix +# for backward compatibility: +ac_top_builddir=$ac_top_build_prefix + +case $srcdir in + .) # We are building in place. + ac_srcdir=. + ac_top_srcdir=$ac_top_builddir_sub + ac_abs_top_srcdir=$ac_pwd ;; + [\\/]* | ?:[\\/]* ) # Absolute name. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir + ac_abs_top_srcdir=$srcdir ;; + *) # Relative name. + ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_build_prefix$srcdir + ac_abs_top_srcdir=$ac_pwd/$srcdir ;; +esac +ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix + + + case $ac_mode in + :F) + # + # CONFIG_FILE + # + +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# If the template does not know about datarootdir, expand it. +# FIXME: This hack should be removed a few years after 2.60. +ac_datarootdir_hack=; ac_datarootdir_seen= +ac_sed_dataroot=' +/datarootdir/ { + p + q +} +/@datadir@/p +/@docdir@/p +/@infodir@/p +/@localedir@/p +/@mandir@/p' +case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in +*datarootdir*) ac_datarootdir_seen=yes;; +*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 +$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 + ac_datarootdir_hack=' + s&@datadir@&$datadir&g + s&@docdir@&$docdir&g + s&@infodir@&$infodir&g + s&@localedir@&$localedir&g + s&@mandir@&$mandir&g + s&\\\${datarootdir}&$datarootdir&g' ;; +esac +_ACEOF + +# Neutralize VPATH when `$srcdir' = `.'. +# Shell code in configure.ac might set extrasub. +# FIXME: do we really want to maintain this feature? +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +ac_sed_extra="$ac_vpsub +$extrasub +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +:t +/@[a-zA-Z_][a-zA-Z_0-9]*@/!b +s|@configure_input@|$ac_sed_conf_input|;t t +s&@top_builddir@&$ac_top_builddir_sub&;t t +s&@top_build_prefix@&$ac_top_build_prefix&;t t +s&@srcdir@&$ac_srcdir&;t t +s&@abs_srcdir@&$ac_abs_srcdir&;t t +s&@top_srcdir@&$ac_top_srcdir&;t t +s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t +s&@builddir@&$ac_builddir&;t t +s&@abs_builddir@&$ac_abs_builddir&;t t +s&@abs_top_builddir@&$ac_abs_top_builddir&;t t +$ac_datarootdir_hack +" +eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \ + >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + +test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && + { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } && + { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \ + "$ac_tmp/out"`; test -z "$ac_out"; } && + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined" >&5 +$as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined" >&2;} + + rm -f "$ac_tmp/stdin" + case $ac_file in + -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";; + *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";; + esac \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + ;; + + + + esac + +done # for ac_tag + + +as_fn_exit 0 +_ACEOF +ac_clean_files=$ac_clean_files_save + +test $ac_write_fail = 0 || + as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5 + + +# configure is writing to config.log, and then calls config.status. +# config.status does its own redirection, appending to config.log. +# Unfortunately, on DOS this fails, as config.log is still kept open +# by configure, so config.status won't be able to write to it; its +# output is simply discarded. So we exec the FD to /dev/null, +# effectively closing config.log, so it can be properly (re)opened and +# appended to by config.status. When coming back to configure, we +# need to make the FD available again. +if test "$no_create" != yes; then + ac_cs_success=: + ac_config_status_args= + test "$silent" = yes && + ac_config_status_args="$ac_config_status_args --quiet" + exec 5>/dev/null + $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false + exec 5>>config.log + # Use ||, not &&, to avoid exiting from the if with $? = 1, which + # would make configure fail if this is the last instruction. + $ac_cs_success || as_fn_exit 1 +fi +if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5 +$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} +fi + + diff --git a/configure.ac b/configure.ac new file mode 100644 index 0000000..6fb413e --- /dev/null +++ b/configure.ac @@ -0,0 +1,293 @@ +#!/bin/bash -norc +dnl This file is an input file used by the GNU "autoconf" program to +dnl generate the file "configure", which is run during Tcl installation +dnl to configure the system for the local environment. + +#----------------------------------------------------------------------- +# Sample configure.ac for Tcl Extensions. The only places you should +# need to modify this file are marked by the string __CHANGE__ +#----------------------------------------------------------------------- + +#----------------------------------------------------------------------- +# __CHANGE__ +# Set your package name and version numbers here. +# +# This initializes the environment with PACKAGE_NAME and PACKAGE_VERSION +# set as provided. These will also be added as -D defs in your Makefile +# so you can encode the package version directly into the source files. +# This will also define a special symbol for Windows (BUILD_ +# so that we create the export library with the dll. +#----------------------------------------------------------------------- + +AC_INIT([tclxml], [3.2]) + +#-------------------------------------------------------------------- +# Call TEA_INIT as the first TEA_ macro to set up initial vars. +# This will define a ${TEA_PLATFORM} variable == "unix" or "windows" +# as well as PKG_LIB_FILE and PKG_STUB_LIB_FILE. +#-------------------------------------------------------------------- + +TEA_INIT() + +AC_CONFIG_AUX_DIR(tclconfig) + +#-------------------------------------------------------------------- +# Load the tclConfig.sh file +#-------------------------------------------------------------------- + +TEA_PATH_TCLCONFIG +TEA_LOAD_TCLCONFIG + +#-------------------------------------------------------------------- +# Load the tkConfig.sh file if necessary (Tk extension) +#-------------------------------------------------------------------- + +#TEA_PATH_TKCONFIG +#TEA_LOAD_TKCONFIG + +#----------------------------------------------------------------------- +# Handle the --prefix=... option by defaulting to what Tcl gave. +# Must be called after TEA_LOAD_TCLCONFIG and before TEA_SETUP_COMPILER. +#----------------------------------------------------------------------- + +TEA_PREFIX + +#----------------------------------------------------------------------- +# Standard compiler checks. +# This sets up CC by using the CC env var, or looks for gcc otherwise. +# This also calls AC_PROG_CC and a few others to create the basic setup +# necessary to compile executables. +#----------------------------------------------------------------------- + +TEA_SETUP_COMPILER + +#----------------------------------------------------------------------- +# __CHANGE__ +# Specify the C source files to compile in TEA_ADD_SOURCES, +# public headers that need to be installed in TEA_ADD_HEADERS, +# stub library C source files to compile in TEA_ADD_STUB_SOURCES, +# and runtime Tcl library files in TEA_ADD_TCL_SOURCES. +# This defines PKG(_STUB)_SOURCES, PKG(_STUB)_OBJECTS, PKG_HEADERS +# and PKG_TCL_SOURCES. +#----------------------------------------------------------------------- + +TEA_ADD_SOURCES([tclxml.c docObj.c tclxml-libxml2.c nodeObj.c tcldom-libxml2.c tclxslt-libxslt.c]) +TEA_ADD_HEADERS([include/tclxml-libxml2/docObj.h include/tclxml-libxml2/tclxml-libxml2.h include/tcldom/tcldom.h include/tcldom-libxml2/tcldom-libxml2.h include/tclxslt/tclxslt.h]) +TEA_ADD_INCLUDES([-I./include]) +TEA_ADD_LIBS([]) +TEA_ADD_CFLAGS([]) +TEA_ADD_STUB_SOURCES([tclxmlStubInit.c tclxmlStubLib.c]) +TEA_ADD_TCL_SOURCES([tclxml-tcl/xml__tcl.tcl tclxml-tcl/sgml-8.0.tcl tclxml-tcl/sgml-8.1.tcl tclxml-tcl/xml-8.0.tcl tclxml-tcl/xml-8.1.tcl tclxml-tcl/sgmlparser.tcl tclxml-tcl/tclparser-8.0.tcl tclxml-tcl/tclparser-8.1.tcl tclxml-tcl/xmldep.tcl tclxml-tcl/xpath.tcl tcldom-libxml2.tcl tcldom-tcl/xmlswitch.tcl tclxslt/process.tcl tclxslt/resources.tcl tclxslt/utilities.tcl tclxslt/xsltcache.tcl tclxslt-libxslt.tcl]) + +#-------------------------------------------------------------------- +# __CHANGE__ +# +# You can add more files to clean if your extension creates any extra +# files by extending CLEANFILES. +# Add pkgIndex.tcl if it is generated in the Makefile instead of ./configure +# and change Makefile.in to move it from CONFIG_CLEAN_FILES to BINARIES var. +# +# A few miscellaneous platform-specific items: +# TEA_ADD_* any platform specific compiler/build info here. +#-------------------------------------------------------------------- + +#CLEANFILES="$CLEANFILES pkgIndex.tcl" +if test "${TEA_PLATFORM}" = "windows" ; then + # Ensure no empty if clauses + : + #TEA_ADD_SOURCES([win/winFile.c]) + #TEA_ADD_INCLUDES([-I\"$(${CYGPATH} ${srcdir}/win)\"]) +else + # Ensure no empty else clauses + : + #TEA_ADD_SOURCES([unix/unixFile.c]) + #TEA_ADD_LIBS([-lsuperfly]) +fi + +#-------------------------------------------------------------------- +# __CHANGE__ +# Choose which headers you need. Extension authors should try very +# hard to only rely on the Tcl public header files. Internal headers +# contain private data structures and are subject to change without +# notice. +# This MUST be called after TEA_LOAD_TCLCONFIG / TEA_LOAD_TKCONFIG +#-------------------------------------------------------------------- + +TEA_PUBLIC_TCL_HEADERS +#TEA_PRIVATE_TCL_HEADERS + +#TEA_PUBLIC_TK_HEADERS +#TEA_PRIVATE_TK_HEADERS +#TEA_PATH_X + +#-------------------------------------------------------------------- +# Check whether --enable-threads or --disable-threads was given. +# This auto-enables if Tcl was compiled threaded. +#-------------------------------------------------------------------- + +TEA_ENABLE_THREADS + +#-------------------------------------------------------------------- +# The statement below defines a collection of symbols related to +# building as a shared library instead of a static library. +#-------------------------------------------------------------------- + +TEA_ENABLE_SHARED + +#-------------------------------------------------------------------- +# This macro figures out what flags to use with the compiler/linker +# when building shared/static debug/optimized objects. This information +# can be taken from the tclConfig.sh file, but this figures it all out. +#-------------------------------------------------------------------- + +TEA_CONFIG_CFLAGS + +#-------------------------------------------------------------------- +# Set the default compiler switches based on the --enable-symbols option. +#-------------------------------------------------------------------- + +TEA_ENABLE_SYMBOLS + +#-------------------------------------------------------------------- +# This macro generates a line to use when building a library. It +# depends on values set by the TEA_ENABLE_SHARED, TEA_ENABLE_SYMBOLS, +# and TEA_LOAD_TCLCONFIG macros above. +#-------------------------------------------------------------------- + +TEA_MAKE_LIB + +#-------------------------------------------------------------------- +# Determine the name of the tclsh and/or wish executables in the +# Tcl and Tk build directories or the location they were installed +# into. These paths are used to support running test cases only, +# the Makefile should not be making use of these paths to generate +# a pkgIndex.tcl file or anything else at extension build time. +#-------------------------------------------------------------------- + +TEA_PROG_TCLSH +#TEA_PROG_WISH + +#-------------------------------------------------------------------- +# Load libxml2 configuration +#-------------------------------------------------------------------- + +AC_MSG_CHECKING([for xml2-config script]) + +AC_ARG_WITH(xml2-config, + [ --with-xml2-config the xml2-config configuration script], + with_xml2_config=${withval}) + +LIBXML2_CONFIG= +if test "x${with_xml2_config}" = "x" ; then + for c in \ + /Library/Frameworks/libxml.framework/Resources/Scripts/xml2-config \ + ${prefix}/bin/xml2-config \ + /usr/bin/xml2-config \ + /usr/local/bin/xml2-config + do + if test -x "$c" ; then + LIBXML2_CONFIG="$c" + break + fi + done +else + LIBXML2_CONFIG="${with_xml2_config}" +fi +if test "x$LIBXML2_CONFIG" = "x" ; then + AC_MSG_ERROR([unable to find xml2-config]) +else + AC_MSG_RESULT([${LIBXML2_CONFIG}]) + XML2_CFLAGS=`${LIBXML2_CONFIG} --cflags` + XML2_LIBS="`${LIBXML2_CONFIG} --libs`" +fi + +AC_SUBST(XML2_CFLAGS) +AC_SUBST(XML2_LIBS) + +#-------------------------------------------------------------------- +# Load libxslt configuration +#-------------------------------------------------------------------- + +AC_MSG_CHECKING([for xslt-config script]) + +AC_ARG_WITH(xslt-config, + [ --with-xslt-config the xslt-config configuration script], + with_xslt_config=${withval}) + +LIBXSLT_CONFIG= +if test "x${with_xslt_config}" = "x" ; then + if test "x${with_xml2_config}" = "x" ; then + : + else + if test -x "`dirname ${with_xml2_config}`/xslt-config" ; then + LIBXSLT_CONFIG="`dirname ${with_xml2_config}`/xslt-config" + fi + fi +else + LIBXSLT_CONFIG="${with_xslt_config}" +fi +if test "x${LIBXSLT_CONFIG}" = "x" ; then + for c in \ + /Library/Frameworks/libxslt.framework/Resources/Scripts/xslt-config \ + ${prefix}/bin/xslt-config \ + /usr/bin/xslt-config \ + /usr/local/bin/xslt-config + do + if test -x "$c" ; then + LIBXSLT_CONFIG="$c" + break + fi + done +fi +if test "x$LIBXSLT_CONFIG" = "x" ; then + AC_MSG_ERROR([unable to find xslt-config script]) +else + AC_MSG_RESULT([${LIBXSLT_CONFIG}]) + XSLT_CFLAGS=`${LIBXSLT_CONFIG} --cflags` + XSLT_LIBS="`${LIBXSLT_CONFIG} --libs` -lexslt" +fi + +AC_SUBST(XSLT_CFLAGS) +AC_SUBST(XSLT_LIBS) + +#-------------------------------------------------------------------- +# See if we want to statically link the libxml2 and libxslt +# libraries. This is desirable for Tclkit. +#-------------------------------------------------------------------- + +AC_MSG_CHECKING([for static linking of XML/XSLT libraries]) +AC_ARG_WITH(xml-static, + AC_HELP_STRING([--with-xml-static], + [statically link the XML libraries]), + with_xml_static=${withval}) + +if test "x${with_xml_static}" = "x" ; then + AC_MSG_RESULT([use dynamic linking]) +else + TEA_ADD_CFLAGS([-DLIBXML_STATIC -DLIBXSLT_STATIC]) + AC_MSG_RESULT([use static linking]) +fi + +#-------------------------------------------------------------------- +# Setup a *Config.sh.in configuration file. +#-------------------------------------------------------------------- + +TEA_EXPORT_CONFIG([tclxml]) +#AC_SUBST(SAMPLE_VAR) + +#-------------------------------------------------------------------- +# Specify files to substitute AC variables in. You may alternatively +# have a special pkgIndex.tcl.in or other files which require +# substituting the AC variables in. Include these here. +#-------------------------------------------------------------------- + +AC_CONFIG_FILES([Makefile pkgIndex.tcl]) +AC_CONFIG_FILES([tclxmlConfig.sh]) +AC_CONFIG_FILES([include/tclxml/tclxml.h]) + +#-------------------------------------------------------------------- +# Finally, substitute all of the various values into the files +# specified with AC_CONFIG_FILES. +#-------------------------------------------------------------------- + +AC_OUTPUT() diff --git a/docObj.c b/docObj.c new file mode 100644 index 0000000..b91ab1f --- /dev/null +++ b/docObj.c @@ -0,0 +1,1832 @@ +/* docObj.c -- + * + * This module manages libxml2 xmlDocPtr Tcl objects. + * + * Copyright (c) 2005 by Explain. + * http://www.explain.com.au/ + * Copyright (c) 2003-2004 Zveno Pty Ltd + * http://www.zveno.com/ + * + * See the file "LICENSE" for information on usage and + * redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * $Id: docObj.c,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $ + */ + +#include +#include +#include + +#define TCL_DOES_STUBS \ + (TCL_MAJOR_VERSION > 8 || TCL_MAJOR_VERSION == 8 && (TCL_MINOR_VERSION > 1 || \ + (TCL_MINOR_VERSION == 1 && TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE))) + +#undef TCL_STORAGE_CLASS +#define TCL_STORAGE_CLASS DLLEXPORT + +/* + * Basic list for tracking Tcl_Obj's for a document. + */ + +typedef struct ObjList { + Tcl_Obj *objPtr; + struct ObjList *next; +} ObjList; + +/* + * Prototypes for procedures defined later in this file: + */ + +static void DestroyTclDoc _ANSI_ARGS_((TclXML_libxml2_Document *tDocPtr)); + +Tcl_FreeInternalRepProc TclXMLlibxml2_DocFree; +Tcl_DupInternalRepProc TclXMLlibxml2_DocDup; +Tcl_UpdateStringProc TclXMLlibxml2_DocUpdate; +Tcl_SetFromAnyProc TclXMLlibxml2_DocSetFromAny; + +Tcl_ObjType TclXMLlibxml2_DocObjType = { + "libxml2-doc", + TclXMLlibxml2_DocFree, + TclXMLlibxml2_DocDup, + TclXMLlibxml2_DocUpdate, + TclXMLlibxml2_DocSetFromAny +}; + +typedef struct ThreadSpecificData { + int initialized; + + /* + * Hash table for mapping string rep to doc structure. + */ + + Tcl_HashTable *documents; + int docCntr; + + /* + * Hash table for tracking doc objects. + */ + + Tcl_HashTable *docByPtr; + + /* + * Structured error handling + */ + + TclXML_ErrorInfo *errorInfoPtr; + +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; + +/* + * libxml2 is mostly thread-safe, but just-in-case use a mutex to control access. + */ + +TCL_DECLARE_MUTEX(libxml2) + +/* + *---------------------------------------------------------------------------- + * + * TclXML_libxml2_InitDocObj -- + * + * Initialise this module. + * + * Results: + * Returns success code + * + * Side effects: + * Memory may be allocated + * + *---------------------------------------------------------------------------- + */ + +int +TclXML_libxml2_InitDocObj(interp) + Tcl_Interp *interp; +{ + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + tsdPtr->initialized = 1; + tsdPtr->documents = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable)); + Tcl_InitHashTable(tsdPtr->documents, TCL_STRING_KEYS); + tsdPtr->docByPtr = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable)); + Tcl_InitHashTable(tsdPtr->docByPtr, TCL_ONE_WORD_KEYS); + + tsdPtr->docCntr = 0; + + /* + * Setup an error handler that stores structured error info + */ + + tsdPtr->errorInfoPtr = (TclXML_ErrorInfo *) Tcl_Alloc(sizeof(TclXML_ErrorInfo)); + tsdPtr->errorInfoPtr->interp = interp; + tsdPtr->errorInfoPtr->listPtr = NULL; + tsdPtr->errorInfoPtr->nodeHandlerProc = NULL; + xmlSetStructuredErrorFunc((void *) tsdPtr->errorInfoPtr, TclXML_libxml2_ErrorHandler); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXML_libxml2_NewDocObj -- + * + * Creates a new xmlDocPtr and wraps it in a Tcl_Obj. + * + * Results: + * Returns a *TclObj + * + * Side effects: + * Objects allocated. + * + *---------------------------------------------------------------------------- + */ + +Tcl_Obj * +TclXML_libxml2_NewDocObj(interp) + Tcl_Interp *interp; +{ + xmlDocPtr new; + + Tcl_MutexLock(&libxml2); + new = xmlNewDoc((const xmlChar *) "1.0"); + Tcl_MutexUnlock(&libxml2); + if (!new) { + Tcl_SetResult(interp, "unable to create document", NULL); + return NULL; + } + + return TclXML_libxml2_CreateObjFromDoc(new); +} + +/* + *---------------------------------------------------------------------------- + * + * TclXML_libxml2_CreateObjFromDoc -- + * + * Create a Tcl_Obj to wrap a xmlDocPtr. + * + * Results: + * Returns Tcl_Obj*. + * + * Side effects: + * Allocates object. + * + *---------------------------------------------------------------------------- + */ + +Tcl_Obj * +TclXML_libxml2_CreateObjFromDoc (docPtr) + xmlDocPtr docPtr; +{ + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + TclXML_libxml2_Document *tDocPtr; + Tcl_HashEntry *entryPtr; + Tcl_Obj *objPtr; + ObjList *listPtr; + + /* + * This xmlDocPtr may already have been wrapped by a Tcl object. + * If so, return an already existing wrapper. + * If not, create a new wrapper. + */ + + entryPtr = Tcl_FindHashEntry(tsdPtr->docByPtr, (ClientData) docPtr); + if (entryPtr) { + tDocPtr = (TclXML_libxml2_Document *) Tcl_GetHashValue(entryPtr); + + if (tDocPtr->objs) { + /* The first object is sufficient */ + listPtr = (ObjList *) tDocPtr->objs; + objPtr = listPtr->objPtr; + } else { + /* Create a new Tcl_Obj to refer to existing structure */ + objPtr = Tcl_NewObj(); + + listPtr = (ObjList *) Tcl_Alloc(sizeof(ObjList)); + listPtr->objPtr = objPtr; + listPtr->next = NULL; + tDocPtr->objs = (void *) listPtr; + + objPtr->length = strlen(tDocPtr->token); + objPtr->bytes = Tcl_Alloc(objPtr->length + 1); + strcpy(objPtr->bytes, tDocPtr->token); + objPtr->internalRep.twoPtrValue.ptr1 = (void *) tDocPtr; + objPtr->internalRep.twoPtrValue.ptr2 = NULL; + objPtr->typePtr = &TclXMLlibxml2_DocObjType; + } + + } else { + int new; + + objPtr = Tcl_NewObj(); + + tDocPtr = (TclXML_libxml2_Document *) Tcl_Alloc(sizeof(TclXML_libxml2_Document)); + tDocPtr->docPtr = docPtr; + tDocPtr->token = Tcl_Alloc(20); + sprintf(tDocPtr->token, "doc%d", tsdPtr->docCntr++); + tDocPtr->keep = TCLXML_LIBXML2_DOCUMENT_IMPLICIT; + tDocPtr->dom = NULL; + tDocPtr->domfree = NULL; + tDocPtr->apphook = NULL; + tDocPtr->appfree = NULL; + + listPtr = (ObjList *) Tcl_Alloc(sizeof(ObjList)); + listPtr->objPtr = objPtr; + listPtr->next = NULL; + tDocPtr->objs = (void *) listPtr; + + entryPtr = Tcl_CreateHashEntry(tsdPtr->documents, tDocPtr->token, &new); + Tcl_SetHashValue(entryPtr, (ClientData) tDocPtr); + entryPtr = Tcl_CreateHashEntry(tsdPtr->docByPtr, (ClientData) docPtr, &new); + Tcl_SetHashValue(entryPtr, (ClientData) tDocPtr); + + objPtr->length = strlen(tDocPtr->token); + objPtr->bytes = Tcl_Alloc(objPtr->length + 1); + strcpy(objPtr->bytes, tDocPtr->token); + objPtr->internalRep.twoPtrValue.ptr1 = (void *) tDocPtr; + objPtr->internalRep.twoPtrValue.ptr2 = NULL; + objPtr->typePtr = &TclXMLlibxml2_DocObjType; + } + + /* Bug fix #1032660. David Welton. */ + Tcl_IncrRefCount(objPtr); + + return objPtr; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXML_libxml2_GetDocFromObj -- + * + * Retrieve the xmlDocPtr from a Tcl object. + * + * Results: + * Returns success code. + * + * Side effects: + * May set internal rep of object. + * + *---------------------------------------------------------------------------- + */ + +int +TclXML_libxml2_GetDocFromObj (interp, objPtr, docPtr) + Tcl_Interp *interp; + Tcl_Obj *objPtr; + xmlDocPtr *docPtr; +{ + TclXML_libxml2_Document *tDocPtr; + + if (TclXML_libxml2_GetTclDocFromObj(interp, objPtr, &tDocPtr) != TCL_OK) { + return TCL_ERROR; + } + + *docPtr = tDocPtr->docPtr; + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXML_libxml2_GetTclDocFromNode -- + * + * Retrieve a pointer to the TclXML Doc structure from a xmlNodePtr. + * + * Results: + * Returns success code. + * + * Side effects: + * Sets pointer + * + *---------------------------------------------------------------------------- + */ + +int +TclXML_libxml2_GetTclDocFromNode (interp, nodePtr, tDocPtrPtr) + Tcl_Interp *interp; + xmlNodePtr nodePtr; + TclXML_libxml2_Document **tDocPtrPtr; +{ + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + Tcl_HashEntry *entryPtr; + + entryPtr = Tcl_FindHashEntry(tsdPtr->docByPtr, (ClientData) nodePtr->doc); + if (!entryPtr) { + *tDocPtrPtr = NULL; + Tcl_SetResult(interp, "document not known", NULL); + return TCL_ERROR; + } + + *tDocPtrPtr = (TclXML_libxml2_Document *) Tcl_GetHashValue(entryPtr); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXML_libxml2_GetTclDocFromObj -- + * + * Retrieve the TclXML_libxml2_Document from a Tcl object. + * + * Results: + * Returns success code. + * + * Side effects: + * May set internal rep of object. + * + *---------------------------------------------------------------------------- + */ + +int +TclXML_libxml2_GetTclDocFromObj (interp, objPtr, tDocPtr) + Tcl_Interp *interp; + Tcl_Obj *objPtr; + TclXML_libxml2_Document **tDocPtr; +{ + if (objPtr->typePtr == &TclXMLlibxml2_DocObjType) { + *tDocPtr = (TclXML_libxml2_Document *) objPtr->internalRep.twoPtrValue.ptr1; + } else if (TclXMLlibxml2_DocSetFromAny(interp, objPtr) == TCL_OK) { + *tDocPtr = (TclXML_libxml2_Document *) objPtr->internalRep.twoPtrValue.ptr1; + } else { + return TCL_ERROR; + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXML_libxml2_DestroyDocument -- + * + * Manage destruction of a document. + * The trick here is to make sure that all Tcl_Obj's + * that reference this document have their internal rep + * invalidated. + * + * Results: + * None. + * + * Side effects: + * Memory deallocated, object internal reps changed. + * + *---------------------------------------------------------------------------- + */ + +void +TclXML_libxml2_DestroyDocument (tDocPtr) + TclXML_libxml2_Document *tDocPtr; +{ + ObjList *listPtr = (ObjList *) tDocPtr->objs; + ObjList *next; + + /* + * Invalidate the internal representation of all Tcl_Obj's + * that refer to this document. + */ + while (listPtr) { + next = listPtr->next; + TclXMLlibxml2_DocFree(listPtr->objPtr); + listPtr = next; + } + + if (tDocPtr->keep == TCLXML_LIBXML2_DOCUMENT_KEEP) { + DestroyTclDoc(tDocPtr); + } +} + +/* + *---------------------------------------------------------------------------- + * + * TclXML_libxml2_DocKeep -- + * + * Changes how the document's destruction is handled. + * + * Results: + * None. + * + * Side effects: + * Changes document configuration. + * + *---------------------------------------------------------------------------- + */ + +void +TclXML_libxml2_DocKeep(objPtr, keep) + Tcl_Obj *objPtr; + TclXML_libxml2_DocumentHandling keep; +{ + TclXML_libxml2_Document *tDocPtr; + + if (TclXML_libxml2_GetTclDocFromObj(NULL, objPtr, &tDocPtr) != TCL_OK) { + return; + } + + tDocPtr->keep = keep; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXMLlibxml2_DocSetFromAny -- + * + * Finds the xmlDocPtr wrapper for a Tcl object. + * + * Results: + * Returns success code. + * + * Side effects: + * Changes the Tcl_Obj's internal rep. + * + *---------------------------------------------------------------------------- + */ + +int +TclXMLlibxml2_DocSetFromAny(interp, objPtr) + Tcl_Interp *interp; + Tcl_Obj *objPtr; +{ + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + Tcl_HashEntry *entryPtr; + TclXML_libxml2_Document *tDocPtr; + ObjList *listPtr; + + entryPtr = Tcl_FindHashEntry(tsdPtr->documents, Tcl_GetStringFromObj(objPtr, NULL)); + + if (entryPtr) { + + if (objPtr->typePtr != NULL && objPtr->typePtr->freeIntRepProc != NULL) { + objPtr->typePtr->freeIntRepProc(objPtr); + } + + objPtr->internalRep.twoPtrValue.ptr1 = Tcl_GetHashValue(entryPtr); + objPtr->typePtr = &TclXMLlibxml2_DocObjType; + + tDocPtr = (TclXML_libxml2_Document *) objPtr->internalRep.twoPtrValue.ptr1; + + /* + * Add this object to the Tcl_Obj list. + * NB. There should be no duplicates. + */ + listPtr = (ObjList *) tDocPtr->objs; + if (listPtr == NULL) { + listPtr = (ObjList *) Tcl_Alloc(sizeof(ObjList)); + listPtr->objPtr = objPtr; + listPtr->next = NULL; + tDocPtr->objs = listPtr; + } else { + ObjList *newPtr; + + newPtr = (ObjList *) Tcl_Alloc(sizeof(ObjList)); + newPtr->objPtr = objPtr; + newPtr->next = listPtr; + tDocPtr->objs = (void *) newPtr; + } + /* SANITY CHECK NEEDED: no duplicates in the list */ + + } else { + + if (interp) { + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "token \"", Tcl_GetStringFromObj(objPtr, NULL), "\" is not a libxml2 document", NULL); + } + + return TCL_ERROR; + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXMLlibxml2_DocUpdate -- + * + * Finds the token for a xmlDocPtr wrapper. + * + * Results: + * None. + * + * Side effects: + * Changes the Tcl_Obj's string rep. + * + *---------------------------------------------------------------------------- + */ + +void +TclXMLlibxml2_DocUpdate(objPtr) + Tcl_Obj *objPtr; +{ + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + Tcl_HashEntry *entryPtr; + + entryPtr = Tcl_FindHashEntry(tsdPtr->docByPtr, objPtr->internalRep.twoPtrValue.ptr1); + Tcl_InvalidateStringRep(objPtr); + if (entryPtr != NULL) { + TclXML_libxml2_Document *tDocPtr = (TclXML_libxml2_Document *) Tcl_GetHashValue(entryPtr); + objPtr->length = strlen(tDocPtr->token); + objPtr->bytes = Tcl_Alloc(objPtr->length + 1); + strcpy(objPtr->bytes, tDocPtr->token); + } +} + +/* + *---------------------------------------------------------------------------- + * + * TclXMLlibxml2_DocDup -- + * + * Duplicates the Tcl wrapper. + * NB. This does *not* copy the document itself - it simply creates + * another reference to the same document. + * + * Results: + * None. + * + * Side effects: + * Changes the target Tcl_Obj. + * + *---------------------------------------------------------------------------- + */ + +void +TclXMLlibxml2_DocDup(srcPtr, dstPtr) + Tcl_Obj *srcPtr; + Tcl_Obj *dstPtr; +{ + TclXML_libxml2_Document *tDocPtr; + ObjList *listPtr; + + if (dstPtr->typePtr != NULL && dstPtr->typePtr->freeIntRepProc != NULL) { + dstPtr->typePtr->freeIntRepProc(dstPtr); + } + + tDocPtr = (TclXML_libxml2_Document *) srcPtr->internalRep.twoPtrValue.ptr1; + listPtr = (ObjList *) Tcl_Alloc(sizeof(ObjList)); + listPtr->objPtr = dstPtr; + listPtr->next = ((ObjList *) tDocPtr->objs)->next; + tDocPtr->objs = listPtr; + + Tcl_InvalidateStringRep(dstPtr); + + dstPtr->internalRep.twoPtrValue.ptr1 = srcPtr->internalRep.twoPtrValue.ptr1; + dstPtr->internalRep.twoPtrValue.ptr2 = NULL; + dstPtr->typePtr = srcPtr->typePtr; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXMLlibxml2_DocFree -- + * + * Removes a Tcl wrapper to a libxml2 document. + * + * Results: + * None. + * + * Side effects: + * May free the document. + * + *---------------------------------------------------------------------------- + */ + +void +TclXMLlibxml2_DocFree(objPtr) + Tcl_Obj *objPtr; +{ + TclXML_libxml2_Document *tDocPtr = (TclXML_libxml2_Document *) objPtr->internalRep.twoPtrValue.ptr1; + ObjList *listPtr = tDocPtr->objs; + ObjList *prevPtr = NULL; + + while (listPtr) { + if (listPtr->objPtr == objPtr) { + break; + } + prevPtr = listPtr; + listPtr = listPtr->next; + } + + if (listPtr == NULL) { + /* internal error */ + } else if (prevPtr == NULL) { + tDocPtr->objs = listPtr->next; + } else { + prevPtr->next = listPtr->next; + } + Tcl_Free((char *) listPtr); + + if (tDocPtr->objs == NULL && tDocPtr->keep == TCLXML_LIBXML2_DOCUMENT_IMPLICIT) { + DestroyTclDoc(tDocPtr); + } + + objPtr->internalRep.twoPtrValue.ptr1 = NULL; + objPtr->internalRep.twoPtrValue.ptr2 = NULL; + objPtr->typePtr = NULL; +} + +/* + *---------------------------------------------------------------------------- + * + * DestroyTclDoc -- + * + * Destroy the Tcl wrapper for a document. + * + * Results: + * None. + * + * Side effects: + * Free memory. + * + *---------------------------------------------------------------------------- + */ + +void +DestroyTclDoc(tDocPtr) + TclXML_libxml2_Document *tDocPtr; +{ + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + Tcl_HashEntry *entryPtr; + + if (tDocPtr->domfree) { + (tDocPtr->domfree)(tDocPtr->dom); + } + if (tDocPtr->appfree) { + (tDocPtr->appfree)(tDocPtr->dom); + } + + entryPtr = Tcl_FindHashEntry(tsdPtr->documents, tDocPtr->token); + if (entryPtr) { + Tcl_DeleteHashEntry(entryPtr); + } else { + /* Internal error */ + } + + entryPtr = Tcl_FindHashEntry(tsdPtr->docByPtr, (ClientData) tDocPtr->docPtr); + if (entryPtr) { + Tcl_DeleteHashEntry(entryPtr); + } else { + /* Internal error */ + } + + Tcl_MutexLock(&libxml2); + xmlFreeDoc(tDocPtr->docPtr); + Tcl_MutexUnlock(&libxml2); + + Tcl_Free(tDocPtr->token); + Tcl_Free((char *) tDocPtr); +} + +/* + *---------------------------------------------------------------------------- + * + * TclXML_libxml2_ErrorHandler -- + * + * Handler for structured error reports + * + * Results: + * None. + * + * Side effects: + * Creates a Tcl_Obj to store the error information. + * + *---------------------------------------------------------------------------- + */ + +static Tcl_Obj * +ErrorDomainToString(domain) + int domain; +{ + switch ((xmlErrorDomain) domain) { + case XML_FROM_NONE: + return Tcl_NewStringObj("none", -1); + case XML_FROM_PARSER: + return Tcl_NewStringObj("parser", -1); + case XML_FROM_TREE: + return Tcl_NewStringObj("tree", -1); + case XML_FROM_NAMESPACE: + return Tcl_NewStringObj("namespace", -1); + case XML_FROM_DTD: + return Tcl_NewStringObj("dtd-validation", -1); + case XML_FROM_HTML: + return Tcl_NewStringObj("html-parser", -1); + case XML_FROM_MEMORY: + return Tcl_NewStringObj("memory", -1); + case XML_FROM_OUTPUT: + return Tcl_NewStringObj("output", -1); + case XML_FROM_IO: + return Tcl_NewStringObj("io", -1); + case XML_FROM_FTP: + return Tcl_NewStringObj("ftp", -1); + case XML_FROM_HTTP: + return Tcl_NewStringObj("http", -1); + case XML_FROM_XINCLUDE: + return Tcl_NewStringObj("XInclude", -1); + case XML_FROM_XPOINTER: + return Tcl_NewStringObj("XPointer", -1); + case XML_FROM_REGEXP: + return Tcl_NewStringObj("regexp", -1); + case XML_FROM_DATATYPE: + return Tcl_NewStringObj("schemas-datatype", -1); + case XML_FROM_SCHEMASP: + return Tcl_NewStringObj("schemas-parser", -1); + case XML_FROM_SCHEMASV: + return Tcl_NewStringObj("schemas-validation", -1); + case XML_FROM_RELAXNGP: + return Tcl_NewStringObj("relaxng-parser", -1); + case XML_FROM_RELAXNGV: + return Tcl_NewStringObj("relaxng-validation", -1); + case XML_FROM_CATALOG: + return Tcl_NewStringObj("catalog", -1); + case XML_FROM_C14N: + return Tcl_NewStringObj("canonicalization", -1); + case XML_FROM_XSLT: + return Tcl_NewStringObj("xslt", -1); + default: + return Tcl_NewObj(); + } +} + +static Tcl_Obj * +ErrorLevelToString(level) + xmlErrorLevel level; +{ + switch (level) { + case XML_ERR_WARNING: + return Tcl_NewStringObj("warning", -1); + case XML_ERR_ERROR: + return Tcl_NewStringObj("error", -1); + case XML_ERR_FATAL: + return Tcl_NewStringObj("fatal", -1); + case XML_ERR_NONE: + default: + return Tcl_NewStringObj("none", -1); + } +} + +static Tcl_Obj * +ErrorCodeToString(code) + int code; +{ + switch ((xmlParserErrors) code) { + case XML_ERR_OK: + return Tcl_NewObj(); + case XML_ERR_INTERNAL_ERROR: + return Tcl_NewStringObj("internal-error", -1); + case XML_ERR_NO_MEMORY: + return Tcl_NewStringObj("no-memory", -1); + case XML_ERR_DOCUMENT_START: + return Tcl_NewStringObj("document-start", -1); + case XML_ERR_DOCUMENT_EMPTY: + return Tcl_NewStringObj("document-empty", -1); + case XML_ERR_DOCUMENT_END: + return Tcl_NewStringObj("document-end", -1); + case XML_ERR_INVALID_HEX_CHARREF: + return Tcl_NewStringObj("invalid-hex-character-reference", -1); + case XML_ERR_INVALID_DEC_CHARREF: + return Tcl_NewStringObj("invalid-decimal-character-reference", -1); + case XML_ERR_INVALID_CHARREF: + return Tcl_NewStringObj("invalid-character-reference", -1); + case XML_ERR_INVALID_CHAR: + return Tcl_NewStringObj("invalid-character", -1); + case XML_ERR_CHARREF_AT_EOF: + return Tcl_NewStringObj("character-reference-at-eof", -1); + case XML_ERR_CHARREF_IN_PROLOG: + return Tcl_NewStringObj("character-reference-in-prolog", -1); + case XML_ERR_CHARREF_IN_EPILOG: + return Tcl_NewStringObj("character-reference-in-epilog", -1); + case XML_ERR_CHARREF_IN_DTD: + return Tcl_NewStringObj("character-reference-in-dtd", -1); + case XML_ERR_ENTITYREF_AT_EOF: + return Tcl_NewStringObj("entity-reference-at-eof", -1); + case XML_ERR_ENTITYREF_IN_PROLOG: + return Tcl_NewStringObj("entity-reference-in-prolog", -1); + case XML_ERR_ENTITYREF_IN_EPILOG: + return Tcl_NewStringObj("entity-reference-in-epilog", -1); + case XML_ERR_ENTITYREF_IN_DTD: + return Tcl_NewStringObj("entity-reference-in-dtd", -1); + case XML_ERR_PEREF_AT_EOF: + return Tcl_NewStringObj("parameter-entity-reference-at-eof", -1); + case XML_ERR_PEREF_IN_PROLOG: + return Tcl_NewStringObj("parameter-entity-reference-in-prolog", -1); + case XML_ERR_PEREF_IN_EPILOG: + return Tcl_NewStringObj("parameter-entity-reference-in-epilog", -1); + case XML_ERR_PEREF_IN_INT_SUBSET: + return Tcl_NewStringObj("parameter-entity-reference-in-internal-subset", -1); + case XML_ERR_ENTITYREF_NO_NAME: + return Tcl_NewStringObj("entity-reference-no-name", -1); + case XML_ERR_ENTITYREF_SEMICOL_MISSING: + return Tcl_NewStringObj("entity-reference-semicolon-missing", -1); + case XML_ERR_PEREF_NO_NAME: + return Tcl_NewStringObj("parameter-entity-reference-no-name", -1); + case XML_ERR_PEREF_SEMICOL_MISSING: + return Tcl_NewStringObj("parameter-entity-reference-semicolon-missing", -1); + case XML_ERR_UNDECLARED_ENTITY: + return Tcl_NewStringObj("undeclared-entity", -1); + case XML_WAR_UNDECLARED_ENTITY: + return Tcl_NewStringObj("undeclared-entity", -1); + case XML_ERR_UNPARSED_ENTITY: + return Tcl_NewStringObj("unparsed-entity", -1); + case XML_ERR_ENTITY_IS_EXTERNAL: + return Tcl_NewStringObj("entity-is-external", -1); + case XML_ERR_ENTITY_IS_PARAMETER: + return Tcl_NewStringObj("entity-is-parameter", -1); + case XML_ERR_UNKNOWN_ENCODING: + return Tcl_NewStringObj("unknown-encoding", -1); + case XML_ERR_UNSUPPORTED_ENCODING: + return Tcl_NewStringObj("unsupported-encoding", -1); + case XML_ERR_STRING_NOT_STARTED: + return Tcl_NewStringObj("string-not-started", -1); + case XML_ERR_STRING_NOT_CLOSED: + return Tcl_NewStringObj("string-not-closed", -1); + case XML_ERR_NS_DECL_ERROR: + return Tcl_NewStringObj("namespace-declaration-error", -1); + case XML_ERR_ENTITY_NOT_STARTED: + return Tcl_NewStringObj("entity-not-started", -1); + case XML_ERR_ENTITY_NOT_FINISHED: + return Tcl_NewStringObj("entity-not-finished", -1); + case XML_ERR_LT_IN_ATTRIBUTE: + return Tcl_NewStringObj("less-than-character-in-attribute", -1); + case XML_ERR_ATTRIBUTE_NOT_STARTED: + return Tcl_NewStringObj("attribute-not-started", -1); + case XML_ERR_ATTRIBUTE_NOT_FINISHED: + return Tcl_NewStringObj("attribute-not-finished", -1); + case XML_ERR_ATTRIBUTE_WITHOUT_VALUE: + return Tcl_NewStringObj("attribute-without-value", -1); + case XML_ERR_ATTRIBUTE_REDEFINED: + return Tcl_NewStringObj("attribute-redefined", -1); + case XML_ERR_LITERAL_NOT_STARTED: + return Tcl_NewStringObj("literal-not-started", -1); + case XML_ERR_LITERAL_NOT_FINISHED: + return Tcl_NewStringObj("literal-not-finished", -1); + case XML_ERR_COMMENT_NOT_FINISHED: + return Tcl_NewStringObj("comment-not-finished", -1); + case XML_ERR_PI_NOT_STARTED: + return Tcl_NewStringObj("processing-instruction-not-started", -1); + case XML_ERR_PI_NOT_FINISHED: + return Tcl_NewStringObj("processing-instruction-not-finished", -1); + case XML_ERR_NOTATION_NOT_STARTED: + return Tcl_NewStringObj("notation-not-started", -1); + case XML_ERR_NOTATION_NOT_FINISHED: + return Tcl_NewStringObj("notation-not-finished", -1); + case XML_ERR_ATTLIST_NOT_STARTED: + return Tcl_NewStringObj("attribute-list-not-started", -1); + case XML_ERR_ATTLIST_NOT_FINISHED: + return Tcl_NewStringObj("attribute-list-not-finished", -1); + case XML_ERR_MIXED_NOT_STARTED: + return Tcl_NewStringObj("mixed-content-not-started", -1); + case XML_ERR_MIXED_NOT_FINISHED: + return Tcl_NewStringObj("mixed-content-not-finished", -1); + case XML_ERR_ELEMCONTENT_NOT_STARTED: + return Tcl_NewStringObj("element-content-not-started", -1); + case XML_ERR_ELEMCONTENT_NOT_FINISHED: + return Tcl_NewStringObj("element-content-not-finished", -1); + case XML_ERR_XMLDECL_NOT_STARTED: + return Tcl_NewStringObj("xml-declaration-not-started", -1); + case XML_ERR_XMLDECL_NOT_FINISHED: + return Tcl_NewStringObj("xml-declaration-not-finished", -1); + case XML_ERR_CONDSEC_NOT_STARTED: + return Tcl_NewStringObj("conditional-section-not-started", -1); + case XML_ERR_CONDSEC_NOT_FINISHED: + return Tcl_NewStringObj("conditional-section-not-finished", -1); + case XML_ERR_EXT_SUBSET_NOT_FINISHED: + return Tcl_NewStringObj("external-dtd-subset-not-finished", -1); + case XML_ERR_DOCTYPE_NOT_FINISHED: + return Tcl_NewStringObj("document-type-declaration-not-finished", -1); + case XML_ERR_MISPLACED_CDATA_END: + return Tcl_NewStringObj("misplaced-cdata-section-end", -1); + case XML_ERR_CDATA_NOT_FINISHED: + return Tcl_NewStringObj("cdata-section-not-finished", -1); + case XML_ERR_RESERVED_XML_NAME: + return Tcl_NewStringObj("reserved-xml-name", -1); + case XML_ERR_SPACE_REQUIRED: + return Tcl_NewStringObj("space-required", -1); + case XML_ERR_SEPARATOR_REQUIRED: + return Tcl_NewStringObj("separator-required", -1); + case XML_ERR_NMTOKEN_REQUIRED: + return Tcl_NewStringObj("NMTOKEN-required", -1); + case XML_ERR_NAME_REQUIRED: + return Tcl_NewStringObj("NAME-required", -1); + case XML_ERR_PCDATA_REQUIRED: + return Tcl_NewStringObj("PCDATA-required", -1); + case XML_ERR_URI_REQUIRED: + return Tcl_NewStringObj("URI-required", -1); + case XML_ERR_PUBID_REQUIRED: + return Tcl_NewStringObj("public-identifier-required", -1); + case XML_ERR_LT_REQUIRED: + return Tcl_NewStringObj("less-than-character-required", -1); + case XML_ERR_GT_REQUIRED: + return Tcl_NewStringObj("greater-than-character-required", -1); + case XML_ERR_LTSLASH_REQUIRED: + return Tcl_NewStringObj("less-than-and-slash-characters-required", -1); + case XML_ERR_EQUAL_REQUIRED: + return Tcl_NewStringObj("equal-character-required", -1); + case XML_ERR_TAG_NAME_MISMATCH: + return Tcl_NewStringObj("tag-name-mismatch", -1); + case XML_ERR_TAG_NOT_FINISHED: + return Tcl_NewStringObj("tag-not-finished", -1); + case XML_ERR_STANDALONE_VALUE: + return Tcl_NewStringObj("standalone-value", -1); + case XML_ERR_ENCODING_NAME: + return Tcl_NewStringObj("encoding-name", -1); + case XML_ERR_HYPHEN_IN_COMMENT: + return Tcl_NewStringObj("hyphen-in-comment", -1); + case XML_ERR_INVALID_ENCODING: + return Tcl_NewStringObj("invalid-encoding", -1); + case XML_ERR_EXT_ENTITY_STANDALONE: + return Tcl_NewStringObj("external-entity-standalone", -1); + case XML_ERR_CONDSEC_INVALID: + return Tcl_NewStringObj("conditional-section-invalid", -1); + case XML_ERR_VALUE_REQUIRED: + return Tcl_NewStringObj("value-required", -1); + case XML_ERR_NOT_WELL_BALANCED: + return Tcl_NewStringObj("not-well-balanced", -1); + case XML_ERR_EXTRA_CONTENT: + return Tcl_NewStringObj("extra-content", -1); + case XML_ERR_ENTITY_CHAR_ERROR: + return Tcl_NewStringObj("entity-character-error", -1); + case XML_ERR_ENTITY_PE_INTERNAL: + return Tcl_NewStringObj("parameter-entity-internal-error", -1); + case XML_ERR_ENTITY_LOOP: + return Tcl_NewStringObj("entity-loop", -1); + case XML_ERR_ENTITY_BOUNDARY: + return Tcl_NewStringObj("entity-boundary", -1); + case XML_ERR_INVALID_URI: + return Tcl_NewStringObj("invalid-URI", -1); + case XML_ERR_URI_FRAGMENT: + return Tcl_NewStringObj("URI-fragment", -1); + case XML_WAR_CATALOG_PI: + return Tcl_NewStringObj("catalog-processing-instruction", -1); + case XML_ERR_NO_DTD: + return Tcl_NewStringObj("no-document-type-definition", -1); + case XML_ERR_CONDSEC_INVALID_KEYWORD: + return Tcl_NewStringObj("conditional-section-invalid-keyword", -1); + case XML_ERR_VERSION_MISSING: + return Tcl_NewStringObj("version-missing", -1); + case XML_WAR_UNKNOWN_VERSION: + return Tcl_NewStringObj("unknown-version", -1); + case XML_WAR_LANG_VALUE: + return Tcl_NewStringObj("lang-value", -1); + case XML_WAR_NS_URI: + return Tcl_NewStringObj("namespace-uri", -1); + case XML_WAR_NS_URI_RELATIVE: + return Tcl_NewStringObj("namespace-uri-relative", -1); + case XML_NS_ERR_XML_NAMESPACE: + return Tcl_NewStringObj("xml-namespace", -1); + case XML_NS_ERR_UNDEFINED_NAMESPACE: + return Tcl_NewStringObj("undefined-namespace", -1); + case XML_NS_ERR_QNAME: + return Tcl_NewStringObj("qualified-name", -1); + case XML_NS_ERR_ATTRIBUTE_REDEFINED: + return Tcl_NewStringObj("attribute-redefined", -1); + case XML_DTD_ATTRIBUTE_DEFAULT: + return Tcl_NewStringObj("attribute-default", -1); + case XML_DTD_ATTRIBUTE_REDEFINED: + return Tcl_NewStringObj("attribute-redefined", -1); + case XML_DTD_ATTRIBUTE_VALUE: + return Tcl_NewStringObj("attribute-value", -1); + case XML_DTD_CONTENT_ERROR: + return Tcl_NewStringObj("content-error", -1); + case XML_DTD_CONTENT_MODEL: + return Tcl_NewStringObj("content-model", -1); + case XML_DTD_CONTENT_NOT_DETERMINIST: + return Tcl_NewStringObj("content-model-not-deterministic", -1); + case XML_DTD_DIFFERENT_PREFIX: + return Tcl_NewStringObj("different-prefix", -1); + case XML_DTD_ELEM_DEFAULT_NAMESPACE: + return Tcl_NewStringObj("element-default-namespace", -1); + case XML_DTD_ELEM_NAMESPACE: + return Tcl_NewStringObj("element-namespace", -1); + case XML_DTD_ELEM_REDEFINED: + return Tcl_NewStringObj("element-type-redefined", -1); + case XML_DTD_EMPTY_NOTATION: + return Tcl_NewStringObj("empty-notation", -1); + case XML_DTD_ENTITY_TYPE: + return Tcl_NewStringObj("entity-type", -1); + case XML_DTD_ID_FIXED: + return Tcl_NewStringObj("ID-fixed", -1); + case XML_DTD_ID_REDEFINED: + return Tcl_NewStringObj("ID-redefined", -1); + case XML_DTD_ID_SUBSET: + return Tcl_NewStringObj("ID-subset", -1); + case XML_DTD_INVALID_CHILD: + return Tcl_NewStringObj("invalid-child", -1); + case XML_DTD_INVALID_DEFAULT: + return Tcl_NewStringObj("invalid-default", -1); + case XML_DTD_LOAD_ERROR: + return Tcl_NewStringObj("load-error", -1); + case XML_DTD_MISSING_ATTRIBUTE: + return Tcl_NewStringObj("missing-attribute", -1); + case XML_DTD_MIXED_CORRUPT: + return Tcl_NewStringObj("mixed-content-corrupt", -1); + case XML_DTD_MULTIPLE_ID: + return Tcl_NewStringObj("multiple-ID", -1); + case XML_DTD_NO_DOC: + return Tcl_NewStringObj("no-document", -1); + case XML_DTD_NO_DTD: + return Tcl_NewStringObj("no-document-type-definition", -1); + case XML_DTD_NO_ELEM_NAME: + return Tcl_NewStringObj("no-element-name", -1); + case XML_DTD_NO_PREFIX: + return Tcl_NewStringObj("no-prefix", -1); + case XML_DTD_NO_ROOT: + return Tcl_NewStringObj("no-root", -1); + case XML_DTD_NOTATION_REDEFINED: + return Tcl_NewStringObj("notation-redefined", -1); + case XML_DTD_NOTATION_VALUE: + return Tcl_NewStringObj("notation-value", -1); + case XML_DTD_NOT_EMPTY: + return Tcl_NewStringObj("not-empty", -1); + case XML_DTD_NOT_PCDATA: + return Tcl_NewStringObj("not-PCDATA", -1); + case XML_DTD_NOT_STANDALONE: + return Tcl_NewStringObj("not-standalone", -1); + case XML_DTD_ROOT_NAME: + return Tcl_NewStringObj("root-name", -1); + case XML_DTD_STANDALONE_WHITE_SPACE: + return Tcl_NewStringObj("standalone-white-space", -1); + case XML_DTD_UNKNOWN_ATTRIBUTE: + return Tcl_NewStringObj("unknown-attribute", -1); + case XML_DTD_UNKNOWN_ELEM: + return Tcl_NewStringObj("unknown-element-type", -1); + case XML_DTD_UNKNOWN_ENTITY: + return Tcl_NewStringObj("unknown-entity", -1); + case XML_DTD_UNKNOWN_ID: + return Tcl_NewStringObj("unknown-ID", -1); + case XML_DTD_UNKNOWN_NOTATION: + return Tcl_NewStringObj("unknown-notation", -1); + case XML_HTML_STRUCURE_ERROR: + return Tcl_NewStringObj("structure-error", -1); + case XML_HTML_UNKNOWN_TAG: + return Tcl_NewStringObj("unknown-tag", -1); + case XML_RNGP_ANYNAME_ATTR_ANCESTOR: + return Tcl_NewStringObj("anyname-attribute-ancestor", -1); + case XML_RNGP_ATTR_CONFLICT: + return Tcl_NewStringObj("attribute-conflict", -1); + case XML_RNGP_ATTRIBUTE_CHILDREN: + return Tcl_NewStringObj("attribute-children", -1); + case XML_RNGP_ATTRIBUTE_CONTENT: + return Tcl_NewStringObj("attribute-content", -1); + case XML_RNGP_ATTRIBUTE_EMPTY: + return Tcl_NewStringObj("attribute-empty", -1); + case XML_RNGP_ATTRIBUTE_NOOP: + return Tcl_NewStringObj("attribute-noop", -1); + case XML_RNGP_CHOICE_CONTENT: + return Tcl_NewStringObj("choice-content", -1); + case XML_RNGP_CREATE_FAILURE: + return Tcl_NewStringObj("create-failure", -1); + case XML_RNGP_DATA_CONTENT: + return Tcl_NewStringObj("data-content", -1); + case XML_RNGP_DEF_CHOICE_AND_INTERLEAVE: + return Tcl_NewStringObj("def-choice-and-interleave", -1); + case XML_RNGP_DEFINE_CREATE_FAILED: + return Tcl_NewStringObj("define-create-failed", -1); + case XML_RNGP_DEFINE_EMPTY: + return Tcl_NewStringObj("define-empty", -1); + case XML_RNGP_DEFINE_MISSING: + return Tcl_NewStringObj("define-missing", -1); + case XML_RNGP_DEFINE_NAME_MISSING: + return Tcl_NewStringObj("define-name-missing", -1); + case XML_RNGP_ELEM_CONTENT_EMPTY: + return Tcl_NewStringObj("elem-content-empty", -1); + case XML_RNGP_ELEM_CONTENT_ERROR: + return Tcl_NewStringObj("elem-content-error", -1); + case XML_RNGP_ELEMENT_EMPTY: + return Tcl_NewStringObj("element-empty", -1); + case XML_RNGP_ELEMENT_CONTENT: + return Tcl_NewStringObj("element-content", -1); + case XML_RNGP_ELEMENT_NAME: + return Tcl_NewStringObj("element-name", -1); + case XML_RNGP_ELEMENT_NO_CONTENT: + return Tcl_NewStringObj("element-no-content", -1); + case XML_RNGP_ELEM_TEXT_CONFLICT: + return Tcl_NewStringObj("element-text-conflict", -1); + case XML_RNGP_EMPTY: + return Tcl_NewStringObj("empty", -1); + case XML_RNGP_EMPTY_CONSTRUCT: + return Tcl_NewStringObj("empty-construct", -1); + case XML_RNGP_EMPTY_CONTENT: + return Tcl_NewStringObj("empty-content", -1); + case XML_RNGP_EMPTY_NOT_EMPTY: + return Tcl_NewStringObj("empty-not-empty", -1); + case XML_RNGP_ERROR_TYPE_LIB: + return Tcl_NewStringObj("error-type-library", -1); + case XML_RNGP_EXCEPT_EMPTY: + return Tcl_NewStringObj("except-empty", -1); + case XML_RNGP_EXCEPT_MISSING: + return Tcl_NewStringObj("except-missing", -1); + case XML_RNGP_EXCEPT_MULTIPLE: + return Tcl_NewStringObj("except-multiple", -1); + case XML_RNGP_EXCEPT_NO_CONTENT: + return Tcl_NewStringObj("except-no-content", -1); + case XML_RNGP_EXTERNALREF_EMTPY: + return Tcl_NewStringObj("external-reference-empty", -1); + case XML_RNGP_EXTERNAL_REF_FAILURE: + return Tcl_NewStringObj("external-reference-failure", -1); + case XML_RNGP_EXTERNALREF_RECURSE: + return Tcl_NewStringObj("external-reference-recursive", -1); + case XML_RNGP_FORBIDDEN_ATTRIBUTE: + return Tcl_NewStringObj("forbidden-attribute", -1); + case XML_RNGP_FOREIGN_ELEMENT: + return Tcl_NewStringObj("foreign-element", -1); + case XML_RNGP_GRAMMAR_CONTENT: + return Tcl_NewStringObj("grammar-content", -1); + case XML_RNGP_GRAMMAR_EMPTY: + return Tcl_NewStringObj("grammar-empty", -1); + case XML_RNGP_GRAMMAR_MISSING: + return Tcl_NewStringObj("grammar-missing", -1); + case XML_RNGP_GRAMMAR_NO_START: + return Tcl_NewStringObj("grammar-no-start", -1); + case XML_RNGP_GROUP_ATTR_CONFLICT: + return Tcl_NewStringObj("group-attribute-conflict-", -1); + case XML_RNGP_HREF_ERROR: + return Tcl_NewStringObj("href-error", -1); + case XML_RNGP_INCLUDE_EMPTY: + return Tcl_NewStringObj("include-empty", -1); + case XML_RNGP_INCLUDE_FAILURE: + return Tcl_NewStringObj("include-failure", -1); + case XML_RNGP_INCLUDE_RECURSE: + return Tcl_NewStringObj("include-recurse", -1); + case XML_RNGP_INTERLEAVE_ADD: + return Tcl_NewStringObj("interleave-add", -1); + case XML_RNGP_INTERLEAVE_CREATE_FAILED: + return Tcl_NewStringObj("interleave-create-failed", -1); + case XML_RNGP_INTERLEAVE_EMPTY: + return Tcl_NewStringObj("interleave-empty", -1); + case XML_RNGP_INTERLEAVE_NO_CONTENT: + return Tcl_NewStringObj("interleave-no-content", -1); + case XML_RNGP_INVALID_DEFINE_NAME: + return Tcl_NewStringObj("invalid-define-name", -1); + case XML_RNGP_INVALID_URI: + return Tcl_NewStringObj("invalid-URI", -1); + case XML_RNGP_INVALID_VALUE: + return Tcl_NewStringObj("invalid-value", -1); + case XML_RNGP_MISSING_HREF: + return Tcl_NewStringObj("missing-href", -1); + case XML_RNGP_NAME_MISSING: + return Tcl_NewStringObj("NAME-missing", -1); + case XML_RNGP_NEED_COMBINE: + return Tcl_NewStringObj("need-combine", -1); + case XML_RNGP_NOTALLOWED_NOT_EMPTY: + return Tcl_NewStringObj("notallowed-not-empty", -1); + case XML_RNGP_NSNAME_ATTR_ANCESTOR: + return Tcl_NewStringObj("nsname-attr-ancestor", -1); + case XML_RNGP_NSNAME_NO_NS: + return Tcl_NewStringObj("nsname-no-namespace", -1); + case XML_RNGP_PARAM_FORBIDDEN: + return Tcl_NewStringObj("param-forbidden", -1); + case XML_RNGP_PARAM_NAME_MISSING: + return Tcl_NewStringObj("param-name-missing", -1); + case XML_RNGP_PARENTREF_CREATE_FAILED: + return Tcl_NewStringObj("parentref-create-failed", -1); + case XML_RNGP_PARENTREF_NAME_INVALID: + return Tcl_NewStringObj("parentref-name-invalid", -1); + case XML_RNGP_PARENTREF_NO_NAME: + return Tcl_NewStringObj("parentref-no-name", -1); + case XML_RNGP_PARENTREF_NO_PARENT: + return Tcl_NewStringObj("parentref-no-parent", -1); + case XML_RNGP_PARENTREF_NOT_EMPTY: + return Tcl_NewStringObj("parentref-not-empty", -1); + case XML_RNGP_PARSE_ERROR: + return Tcl_NewStringObj("parse-error", -1); + case XML_RNGP_PAT_ANYNAME_EXCEPT_ANYNAME: + return Tcl_NewStringObj("pat-anyname-except-anyname", -1); + case XML_RNGP_PAT_ATTR_ATTR: + return Tcl_NewStringObj("par-attr-attr", -1); + case XML_RNGP_PAT_ATTR_ELEM: + return Tcl_NewStringObj("pat-attr-elem", -1); + case XML_RNGP_PAT_DATA_EXCEPT_ATTR: + return Tcl_NewStringObj("pat-data-except-attr", -1); + case XML_RNGP_PAT_DATA_EXCEPT_ELEM: + return Tcl_NewStringObj("pat-data-except-elem", -1); + case XML_RNGP_PAT_DATA_EXCEPT_EMPTY: + return Tcl_NewStringObj("pat-data-except-empty", -1); + case XML_RNGP_PAT_DATA_EXCEPT_GROUP: + return Tcl_NewStringObj("pat-data-except-group", -1); + case XML_RNGP_PAT_DATA_EXCEPT_INTERLEAVE: + return Tcl_NewStringObj("pat-data-except-interleave", -1); + case XML_RNGP_PAT_DATA_EXCEPT_LIST: + return Tcl_NewStringObj("pat-data-except-list", -1); + case XML_RNGP_PAT_DATA_EXCEPT_ONEMORE: + return Tcl_NewStringObj("pat-data-except-onemore", -1); + case XML_RNGP_PAT_DATA_EXCEPT_REF: + return Tcl_NewStringObj("pat-data-except-ref", -1); + case XML_RNGP_PAT_DATA_EXCEPT_TEXT: + return Tcl_NewStringObj("pat-data-except-text", -1); + case XML_RNGP_PAT_LIST_ATTR: + return Tcl_NewStringObj("pat-list-attr", -1); + case XML_RNGP_PAT_LIST_ELEM: + return Tcl_NewStringObj("pat-list-elem", -1); + case XML_RNGP_PAT_LIST_INTERLEAVE: + return Tcl_NewStringObj("pat-list-interleave", -1); + case XML_RNGP_PAT_LIST_LIST: + return Tcl_NewStringObj("pat-list-list", -1); + case XML_RNGP_PAT_LIST_REF: + return Tcl_NewStringObj("pat-list-ref", -1); + case XML_RNGP_PAT_LIST_TEXT: + return Tcl_NewStringObj("pat-list-text", -1); + case XML_RNGP_PAT_NSNAME_EXCEPT_ANYNAME: + return Tcl_NewStringObj("pat-nsname-except-anyname", -1); + case XML_RNGP_PAT_NSNAME_EXCEPT_NSNAME: + return Tcl_NewStringObj("pat-nsname-except-nsname", -1); + case XML_RNGP_PAT_ONEMORE_GROUP_ATTR: + return Tcl_NewStringObj("pat-onemore-group-attr", -1); + case XML_RNGP_PAT_ONEMORE_INTERLEAVE_ATTR: + return Tcl_NewStringObj("pat-onemore-interleave-attr", -1); + case XML_RNGP_PAT_START_ATTR: + return Tcl_NewStringObj("pat-start-attr", -1); + case XML_RNGP_PAT_START_DATA: + return Tcl_NewStringObj("pat-start-data", -1); + case XML_RNGP_PAT_START_EMPTY: + return Tcl_NewStringObj("pat-start-empty", -1); + case XML_RNGP_PAT_START_GROUP: + return Tcl_NewStringObj("pat-start-group", -1); + case XML_RNGP_PAT_START_INTERLEAVE: + return Tcl_NewStringObj("pat-start-interleave", -1); + case XML_RNGP_PAT_START_LIST: + return Tcl_NewStringObj("pat-start-list", -1); + case XML_RNGP_PAT_START_ONEMORE: + return Tcl_NewStringObj("pat-start-onemore", -1); + case XML_RNGP_PAT_START_TEXT: + return Tcl_NewStringObj("pat-start-text", -1); + case XML_RNGP_PAT_START_VALUE: + return Tcl_NewStringObj("pat-start-value", -1); + case XML_RNGP_PREFIX_UNDEFINED: + return Tcl_NewStringObj("prefix-undefined", -1); + case XML_RNGP_REF_CREATE_FAILED: + return Tcl_NewStringObj("ref-create-failed", -1); + case XML_RNGP_REF_CYCLE: + return Tcl_NewStringObj("ref-cycle", -1); + case XML_RNGP_REF_NAME_INVALID: + return Tcl_NewStringObj("ref-name-invalid", -1); + case XML_RNGP_REF_NO_DEF: + return Tcl_NewStringObj("ref-no-def", -1); + case XML_RNGP_REF_NO_NAME: + return Tcl_NewStringObj("ref-no-name", -1); + case XML_RNGP_REF_NOT_EMPTY: + return Tcl_NewStringObj("ref-not-empty", -1); + case XML_RNGP_START_CHOICE_AND_INTERLEAVE: + return Tcl_NewStringObj("start-choice-and-interleave", -1); + case XML_RNGP_START_CONTENT: + return Tcl_NewStringObj("start-content", -1); + case XML_RNGP_START_EMPTY: + return Tcl_NewStringObj("start-empty", -1); + case XML_RNGP_START_MISSING: + return Tcl_NewStringObj("start-missing", -1); + case XML_RNGP_TEXT_EXPECTED: + return Tcl_NewStringObj("text-expected", -1); + case XML_RNGP_TEXT_HAS_CHILD: + return Tcl_NewStringObj("text-has-child", -1); + case XML_RNGP_TYPE_MISSING: + return Tcl_NewStringObj("type-missing", -1); + case XML_RNGP_TYPE_NOT_FOUND: + return Tcl_NewStringObj("type-not-found", -1); + case XML_RNGP_UNKNOWN_ATTRIBUTE: + return Tcl_NewStringObj("unknown-attribute", -1); + case XML_RNGP_UNKNOWN_COMBINE: + return Tcl_NewStringObj("unknown-combine", -1); + case XML_RNGP_UNKNOWN_CONSTRUCT: + return Tcl_NewStringObj("unknown-construct", -1); + case XML_RNGP_UNKNOWN_TYPE_LIB: + return Tcl_NewStringObj("unknown-type-lib", -1); + case XML_RNGP_URI_FRAGMENT: + return Tcl_NewStringObj("URI-fragment", -1); + case XML_RNGP_URI_NOT_ABSOLUTE: + return Tcl_NewStringObj("URI-not-absolute", -1); + case XML_RNGP_VALUE_EMPTY: + return Tcl_NewStringObj("value-empty", -1); + case XML_RNGP_VALUE_NO_CONTENT: + return Tcl_NewStringObj("value-no-content", -1); + case XML_RNGP_XMLNS_NAME: + return Tcl_NewStringObj("xmlns-name", -1); + case XML_RNGP_XML_NS: + return Tcl_NewStringObj("xml-ns", -1); + case XML_XPATH_EXPRESSION_OK: + return Tcl_NewStringObj("expression-ok", -1); + case XML_XPATH_NUMBER_ERROR: + return Tcl_NewStringObj("number-error", -1); + case XML_XPATH_UNFINISHED_LITERAL_ERROR: + return Tcl_NewStringObj("unfinished-literal", -1); + case XML_XPATH_START_LITERAL_ERROR: + return Tcl_NewStringObj("start-literal", -1); + case XML_XPATH_VARIABLE_REF_ERROR: + return Tcl_NewStringObj("variable-reference", -1); + case XML_XPATH_UNDEF_VARIABLE_ERROR: + return Tcl_NewStringObj("undefined-variable", -1); + case XML_XPATH_INVALID_PREDICATE_ERROR: + return Tcl_NewStringObj("invalid-predicate", -1); + case XML_XPATH_EXPR_ERROR: + return Tcl_NewStringObj("expression-error", -1); + case XML_XPATH_UNCLOSED_ERROR: + return Tcl_NewStringObj("unclosed", -1); + case XML_XPATH_UNKNOWN_FUNC_ERROR: + return Tcl_NewStringObj("unknown-function", -1); + case XML_XPATH_INVALID_OPERAND: + return Tcl_NewStringObj("invalid-operand", -1); + case XML_XPATH_INVALID_TYPE: + return Tcl_NewStringObj("invalid-type", -1); + case XML_XPATH_INVALID_ARITY: + return Tcl_NewStringObj("invalid-arity", -1); + case XML_XPATH_INVALID_CTXT_SIZE: + return Tcl_NewStringObj("invalid-context-size", -1); + case XML_XPATH_INVALID_CTXT_POSITION: + return Tcl_NewStringObj("invalid-context-position", -1); + case XML_XPATH_MEMORY_ERROR: + return Tcl_NewStringObj("memory-error", -1); + case XML_XPTR_SYNTAX_ERROR: + return Tcl_NewStringObj("syntax-error", -1); + case XML_XPTR_RESOURCE_ERROR: + return Tcl_NewStringObj("resource-error", -1); + case XML_XPTR_SUB_RESOURCE_ERROR: + return Tcl_NewStringObj("sub-resource-error", -1); + case XML_XPATH_UNDEF_PREFIX_ERROR: + return Tcl_NewStringObj("undefined-prefix", -1); + case XML_XPATH_ENCODING_ERROR: + return Tcl_NewStringObj("encoding-error", -1); + case XML_XPATH_INVALID_CHAR_ERROR: + return Tcl_NewStringObj("invalid-character", -1); + case XML_TREE_INVALID_HEX: + return Tcl_NewStringObj("invalid-hex", -1); + case XML_TREE_INVALID_DEC: + return Tcl_NewStringObj("invalid-decimal", -1); + case XML_TREE_UNTERMINATED_ENTITY: + return Tcl_NewStringObj("unterminated-entity", -1); + case XML_SAVE_NOT_UTF8: + return Tcl_NewStringObj("not-utf8", -1); + case XML_SAVE_CHAR_INVALID: + return Tcl_NewStringObj("invalid-character", -1); + case XML_SAVE_NO_DOCTYPE: + return Tcl_NewStringObj("no-document-type-declaration", -1); + case XML_SAVE_UNKNOWN_ENCODING: + return Tcl_NewStringObj("unknown-encoding", -1); + case XML_REGEXP_COMPILE_ERROR: + return Tcl_NewStringObj("compile-error", -1); + case XML_IO_UNKNOWN: + return Tcl_NewStringObj("unknown", -1); + case XML_IO_EACCES: + return Tcl_NewStringObj("eacces", -1); + case XML_IO_EAGAIN: + return Tcl_NewStringObj("eagain", -1); + case XML_IO_EBADF: + return Tcl_NewStringObj("ebadf", -1); + case XML_IO_EBADMSG: + return Tcl_NewStringObj("ebadmsg", -1); + case XML_IO_EBUSY: + return Tcl_NewStringObj("ebusy", -1); + case XML_IO_ECANCELED: + return Tcl_NewStringObj("ecanceled", -1); + case XML_IO_ECHILD: + return Tcl_NewStringObj("echild", -1); + case XML_IO_EDEADLK: + return Tcl_NewStringObj("edeadlk", -1); + case XML_IO_EDOM: + return Tcl_NewStringObj("edom", -1); + case XML_IO_EEXIST: + return Tcl_NewStringObj("eexist", -1); + case XML_IO_EINPROGRESS: + return Tcl_NewStringObj("einprogress", -1); + case XML_IO_EINTR: + return Tcl_NewStringObj("eintr", -1); + case XML_IO_EINVAL: + return Tcl_NewStringObj("einval", -1); + case XML_IO_EIO: + return Tcl_NewStringObj("eio", -1); + case XML_IO_EISDIR: + return Tcl_NewStringObj("eisdir", -1); + case XML_IO_EMFILE: + return Tcl_NewStringObj("emfile", -1); + case XML_IO_EMLINK: + return Tcl_NewStringObj("emlink", -1); + case XML_IO_EMSGSIZE: + return Tcl_NewStringObj("emsgsize", -1); + case XML_IO_ENAMETOOLONG: + return Tcl_NewStringObj("enametoolong", -1); + case XML_IO_ENFILE: + return Tcl_NewStringObj("enfile", -1); + case XML_IO_ENODEV: + return Tcl_NewStringObj("enodev", -1); + case XML_IO_ENOENT: + return Tcl_NewStringObj("enoent", -1); + case XML_IO_ENOEXEC: + return Tcl_NewStringObj("enoexec", -1); + case XML_IO_ENOLCK: + return Tcl_NewStringObj("enolck", -1); + case XML_IO_ENOMEM: + return Tcl_NewStringObj("enomem", -1); + case XML_IO_ENOSPC: + return Tcl_NewStringObj("enospc", -1); + case XML_IO_ENOSYS: + return Tcl_NewStringObj("enosys", -1); + case XML_IO_ENOTDIR: + return Tcl_NewStringObj("enotdir", -1); + case XML_IO_ENOTEMPTY: + return Tcl_NewStringObj("enotempty", -1); + case XML_IO_ENOTSUP: + return Tcl_NewStringObj("enotsup", -1); + case XML_IO_ENOTTY: + return Tcl_NewStringObj("enotty", -1); + case XML_IO_ENXIO: + return Tcl_NewStringObj("enxio", -1); + case XML_IO_EPERM: + return Tcl_NewStringObj("eperm", -1); + case XML_IO_EPIPE: + return Tcl_NewStringObj("epipe", -1); + case XML_IO_ERANGE: + return Tcl_NewStringObj("erange", -1); + case XML_IO_EROFS: + return Tcl_NewStringObj("erofs", -1); + case XML_IO_ESPIPE: + return Tcl_NewStringObj("espipe", -1); + case XML_IO_ESRCH: + return Tcl_NewStringObj("esrch", -1); + case XML_IO_ETIMEDOUT: + return Tcl_NewStringObj("etimedout", -1); + case XML_IO_EXDEV: + return Tcl_NewStringObj("exdev", -1); + case XML_IO_NETWORK_ATTEMPT: + return Tcl_NewStringObj("network-attempt", -1); + case XML_IO_ENCODER: + return Tcl_NewStringObj("encoder", -1); + case XML_IO_FLUSH: + return Tcl_NewStringObj("flush", -1); + case XML_IO_WRITE: + return Tcl_NewStringObj("write", -1); + case XML_IO_NO_INPUT: + return Tcl_NewStringObj("no-input", -1); + case XML_IO_BUFFER_FULL: + return Tcl_NewStringObj("buffer-full", -1); + case XML_IO_LOAD_ERROR: + return Tcl_NewStringObj("load-error", -1); + case XML_IO_ENOTSOCK: + return Tcl_NewStringObj("enotsock", -1); + case XML_IO_EISCONN: + return Tcl_NewStringObj("eisconn", -1); + case XML_IO_ECONNREFUSED: + return Tcl_NewStringObj("econnrefused", -1); + case XML_IO_ENETUNREACH: + return Tcl_NewStringObj("enetunreach", -1); + case XML_IO_EADDRINUSE: + return Tcl_NewStringObj("eaddrinuse", -1); + case XML_IO_EALREADY: + return Tcl_NewStringObj("ealready", -1); + case XML_IO_EAFNOSUPPORT: + return Tcl_NewStringObj("eafnosupport", -1); + case XML_XINCLUDE_RECURSION: + return Tcl_NewStringObj("recursion", -1); + case XML_XINCLUDE_PARSE_VALUE: + return Tcl_NewStringObj("parse-value", -1); + case XML_XINCLUDE_ENTITY_DEF_MISMATCH: + return Tcl_NewStringObj("entity-def-mismatch", -1); + case XML_XINCLUDE_NO_HREF: + return Tcl_NewStringObj("no-href", -1); + case XML_XINCLUDE_NO_FALLBACK: + return Tcl_NewStringObj("no-fallback", -1); + case XML_XINCLUDE_HREF_URI: + return Tcl_NewStringObj("href-URI", -1); + case XML_XINCLUDE_TEXT_FRAGMENT: + return Tcl_NewStringObj("text-fragment", -1); + case XML_XINCLUDE_TEXT_DOCUMENT: + return Tcl_NewStringObj("text-document", -1); + case XML_XINCLUDE_INVALID_CHAR: + return Tcl_NewStringObj("invalid-character", -1); + case XML_XINCLUDE_BUILD_FAILED: + return Tcl_NewStringObj("build-failed", -1); + case XML_XINCLUDE_UNKNOWN_ENCODING: + return Tcl_NewStringObj("unknown-encoding", -1); + case XML_XINCLUDE_MULTIPLE_ROOT: + return Tcl_NewStringObj("multiple-root", -1); + case XML_XINCLUDE_XPTR_FAILED: + return Tcl_NewStringObj("XPointer-failed", -1); + case XML_XINCLUDE_XPTR_RESULT: + return Tcl_NewStringObj("XPointer-result", -1); + case XML_XINCLUDE_INCLUDE_IN_INCLUDE: + return Tcl_NewStringObj("include-in-include", -1); + case XML_XINCLUDE_FALLBACKS_IN_INCLUDE: + return Tcl_NewStringObj("fallbacks-in-include", -1); + case XML_XINCLUDE_FALLBACK_NOT_IN_INCLUDE: + return Tcl_NewStringObj("fallback-not-in-include", -1); + case XML_CATALOG_MISSING_ATTR: + return Tcl_NewStringObj("missing-attribute", -1); + case XML_CATALOG_ENTRY_BROKEN: + return Tcl_NewStringObj("entry-broken", -1); + case XML_CATALOG_PREFER_VALUE: + return Tcl_NewStringObj("prefer-value", -1); + case XML_CATALOG_NOT_CATALOG: + return Tcl_NewStringObj("not-catalog", -1); + case XML_CATALOG_RECURSION: + return Tcl_NewStringObj("recursion", -1); + case XML_SCHEMAP_PREFIX_UNDEFINED: + return Tcl_NewStringObj("prefix-undefined", -1); + case XML_SCHEMAP_ATTRFORMDEFAULT_VALUE: + return Tcl_NewStringObj("attribute-form-default-value", -1); + case XML_SCHEMAP_ATTRGRP_NONAME_NOREF: + return Tcl_NewStringObj("attribute-group-noname-noref", -1); + case XML_SCHEMAP_ATTR_NONAME_NOREF: + return Tcl_NewStringObj("attribute-noname-noref", -1); + case XML_SCHEMAP_COMPLEXTYPE_NONAME_NOREF: + return Tcl_NewStringObj("complexType-noname-noref", -1); + case XML_SCHEMAP_ELEMFORMDEFAULT_VALUE: + return Tcl_NewStringObj("element-form-default-value", -1); + case XML_SCHEMAP_ELEM_NONAME_NOREF: + return Tcl_NewStringObj("element-noname-noref", -1); + case XML_SCHEMAP_EXTENSION_NO_BASE: + return Tcl_NewStringObj("extension-no-base", -1); + case XML_SCHEMAP_FACET_NO_VALUE: + return Tcl_NewStringObj("facet-no-value", -1); + case XML_SCHEMAP_FAILED_BUILD_IMPORT: + return Tcl_NewStringObj("failed-build-import", -1); + case XML_SCHEMAP_GROUP_NONAME_NOREF: + return Tcl_NewStringObj("group-noname-noref", -1); + case XML_SCHEMAP_IMPORT_NAMESPACE_NOT_URI: + return Tcl_NewStringObj("import-namespace-not-URI", -1); + case XML_SCHEMAP_IMPORT_REDEFINE_NSNAME: + return Tcl_NewStringObj("import-redefine-nsname", -1); + case XML_SCHEMAP_IMPORT_SCHEMA_NOT_URI: + return Tcl_NewStringObj("import-schema-not-URI", -1); + case XML_SCHEMAP_INVALID_BOOLEAN: + return Tcl_NewStringObj("invalid-boolean", -1); + case XML_SCHEMAP_INVALID_ENUM: + return Tcl_NewStringObj("invalid-enumeration", -1); + case XML_SCHEMAP_INVALID_FACET: + return Tcl_NewStringObj("invalid-facet", -1); + case XML_SCHEMAP_INVALID_FACET_VALUE: + return Tcl_NewStringObj("invalid-facet-value", -1); + case XML_SCHEMAP_INVALID_MAXOCCURS: + return Tcl_NewStringObj("invalid-maxOccurs", -1); + case XML_SCHEMAP_INVALID_MINOCCURS: + return Tcl_NewStringObj("invalid-minOccurs", -1); + case XML_SCHEMAP_INVALID_REF_AND_SUBTYPE: + return Tcl_NewStringObj("invalid-ref-and-subtype", -1); + case XML_SCHEMAP_INVALID_WHITE_SPACE: + return Tcl_NewStringObj("invalid-white-space", -1); + case XML_SCHEMAP_NOATTR_NOREF: + return Tcl_NewStringObj("noattr-noref", -1); + case XML_SCHEMAP_NOTATION_NO_NAME: + return Tcl_NewStringObj("notation-no-name", -1); + case XML_SCHEMAP_NOTYPE_NOREF: + return Tcl_NewStringObj("notype-noref", -1); + case XML_SCHEMAP_REF_AND_SUBTYPE: + return Tcl_NewStringObj("ref-and-subtype", -1); + case XML_SCHEMAP_RESTRICTION_NONAME_NOREF: + return Tcl_NewStringObj("restriction-noname-noref", -1); + case XML_SCHEMAP_SIMPLETYPE_NONAME: + return Tcl_NewStringObj("simpleType-noname", -1); + case XML_SCHEMAP_TYPE_AND_SUBTYPE: + return Tcl_NewStringObj("type-and-subtype", -1); + case XML_SCHEMAP_UNKNOWN_ALL_CHILD: + return Tcl_NewStringObj("unknown-all-child", -1); + case XML_SCHEMAP_UNKNOWN_ANYATTRIBUTE_CHILD: + return Tcl_NewStringObj("unknown-anyattribute-child", -1); + case XML_SCHEMAP_UNKNOWN_ATTR_CHILD: + return Tcl_NewStringObj("unknown-attribute-child", -1); + case XML_SCHEMAP_UNKNOWN_ATTRGRP_CHILD: + return Tcl_NewStringObj("unknown-attributeGroup-child", -1); + case XML_SCHEMAP_UNKNOWN_ATTRIBUTE_GROUP: + return Tcl_NewStringObj("unknown-attributeGroup", -1); + case XML_SCHEMAP_UNKNOWN_BASE_TYPE: + return Tcl_NewStringObj("unknown-base-type", -1); + case XML_SCHEMAP_UNKNOWN_CHOICE_CHILD: + return Tcl_NewStringObj("unknown-choice-child", -1); + case XML_SCHEMAP_UNKNOWN_COMPLEXCONTENT_CHILD: + return Tcl_NewStringObj("unknown-complexContent-child", -1); + case XML_SCHEMAP_UNKNOWN_COMPLEXTYPE_CHILD: + return Tcl_NewStringObj("unknown-complexType-child", -1); + case XML_SCHEMAP_UNKNOWN_ELEM_CHILD: + return Tcl_NewStringObj("unknown-element-child", -1); + case XML_SCHEMAP_UNKNOWN_EXTENSION_CHILD: + return Tcl_NewStringObj("unknown-extension-child", -1); + case XML_SCHEMAP_UNKNOWN_FACET_CHILD: + return Tcl_NewStringObj("unknown-facet-child", -1); + case XML_SCHEMAP_UNKNOWN_FACET_TYPE: + return Tcl_NewStringObj("unknown-facet-type", -1); + case XML_SCHEMAP_UNKNOWN_GROUP_CHILD: + return Tcl_NewStringObj("unknown-group-child", -1); + case XML_SCHEMAP_UNKNOWN_IMPORT_CHILD: + return Tcl_NewStringObj("unknown-import-child", -1); + case XML_SCHEMAP_UNKNOWN_LIST_CHILD: + return Tcl_NewStringObj("unknown-list-child", -1); + case XML_SCHEMAP_UNKNOWN_NOTATION_CHILD: + return Tcl_NewStringObj("unknown-notation-child", -1); + case XML_SCHEMAP_UNKNOWN_PROCESSCONTENT_CHILD: + return Tcl_NewStringObj("unknown-processContent-child", -1); + case XML_SCHEMAP_UNKNOWN_REF: + return Tcl_NewStringObj("unknown-ref", -1); + case XML_SCHEMAP_UNKNOWN_RESTRICTION_CHILD: + return Tcl_NewStringObj("unknown-restriction-child", -1); + case XML_SCHEMAP_UNKNOWN_SCHEMAS_CHILD: + return Tcl_NewStringObj("unknown-schemas-child", -1); + case XML_SCHEMAP_UNKNOWN_SEQUENCE_CHILD: + return Tcl_NewStringObj("unknown-sequence-child", -1); + case XML_SCHEMAP_UNKNOWN_SIMPLETYPE_CHILD: + return Tcl_NewStringObj("unknown-simpleType-child", -1); + case XML_SCHEMAP_UNKNOWN_TYPE: + return Tcl_NewStringObj("unknown-type", -1); + case XML_SCHEMAP_UNKNOWN_UNION_CHILD: + return Tcl_NewStringObj("unknown-union-child", -1); + case XML_SCHEMAP_ELEM_DEFAULT_FIXED: + return Tcl_NewStringObj("element-default-fixed", -1); + case XML_SCHEMAP_REGEXP_INVALID: + return Tcl_NewStringObj("regexp-invalid", -1); + case XML_SCHEMAP_FAILED_LOAD: + return Tcl_NewStringObj("failed-load", -1); + case XML_SCHEMAP_NOTHING_TO_PARSE: + return Tcl_NewStringObj("nothing-to-parse", -1); + case XML_SCHEMAP_NOROOT: + return Tcl_NewStringObj("no-root", -1); + case XML_SCHEMAP_REDEFINED_GROUP: + return Tcl_NewStringObj("redefined-group", -1); + case XML_SCHEMAP_REDEFINED_TYPE: + return Tcl_NewStringObj("redefined-type", -1); + case XML_SCHEMAP_REDEFINED_ELEMENT: + return Tcl_NewStringObj("redefined-element", -1); + case XML_SCHEMAP_REDEFINED_ATTRGROUP: + return Tcl_NewStringObj("redefined-attributeGroup", -1); + case XML_SCHEMAP_REDEFINED_ATTR: + return Tcl_NewStringObj("redefined-attribute", -1); + case XML_SCHEMAP_REDEFINED_NOTATION: + return Tcl_NewStringObj("redefined-notation", -1); + case XML_SCHEMAP_FAILED_PARSE: + return Tcl_NewStringObj("failed-parse", -1); + case XML_SCHEMAV_NOROOT: + return Tcl_NewStringObj("no-root", -1); + case XML_SCHEMAV_UNDECLAREDELEM: + return Tcl_NewStringObj("undeclared-element", -1); + case XML_SCHEMAV_NOTTOPLEVEL: + return Tcl_NewStringObj("not-toplevel", -1); + case XML_SCHEMAV_MISSING: + return Tcl_NewStringObj("missing", -1); + case XML_SCHEMAV_WRONGELEM: + return Tcl_NewStringObj("wrong-element", -1); + case XML_SCHEMAV_NOTYPE: + return Tcl_NewStringObj("no-type", -1); + case XML_SCHEMAV_NOROLLBACK: + return Tcl_NewStringObj("no-rollback", -1); + case XML_SCHEMAV_ISABSTRACT: + return Tcl_NewStringObj("is-abstract", -1); + case XML_SCHEMAV_NOTEMPTY: + return Tcl_NewStringObj("not-empty", -1); + case XML_SCHEMAV_ELEMCONT: + return Tcl_NewStringObj("element-content", -1); + case XML_SCHEMAV_HAVEDEFAULT: + return Tcl_NewStringObj("have-default", -1); + case XML_SCHEMAV_NOTNILLABLE: + return Tcl_NewStringObj("not-nillable", -1); + case XML_SCHEMAV_EXTRACONTENT: + return Tcl_NewStringObj("extra-content", -1); + case XML_SCHEMAV_INVALIDATTR: + return Tcl_NewStringObj("invalid-attribute", -1); + case XML_SCHEMAV_INVALIDELEM: + return Tcl_NewStringObj("invalid-element", -1); + case XML_SCHEMAV_NOTDETERMINIST: + return Tcl_NewStringObj("not-deterministic", -1); + case XML_SCHEMAV_CONSTRUCT: + return Tcl_NewStringObj("construct", -1); + case XML_SCHEMAV_INTERNAL: + return Tcl_NewStringObj("internal", -1); + case XML_SCHEMAV_NOTSIMPLE: + return Tcl_NewStringObj("not-simple", -1); + case XML_SCHEMAV_ATTRUNKNOWN: + return Tcl_NewStringObj("attribute-unknown", -1); + case XML_SCHEMAV_ATTRINVALID: + return Tcl_NewStringObj("attribute-invalid", -1); + case XML_SCHEMAV_VALUE: + return Tcl_NewStringObj("value", -1); + case XML_SCHEMAV_FACET: + return Tcl_NewStringObj("facet", -1); + case XML_XPTR_UNKNOWN_SCHEME: + return Tcl_NewStringObj("unknown-scheme", -1); + case XML_XPTR_CHILDSEQ_START: + return Tcl_NewStringObj("child-sequence-start", -1); + case XML_XPTR_EVAL_FAILED: + return Tcl_NewStringObj("eval-failed", -1); + case XML_XPTR_EXTRA_OBJECTS: + return Tcl_NewStringObj("extra-objects", -1); + case XML_C14N_CREATE_CTXT: + return Tcl_NewStringObj("create-context", -1); + case XML_C14N_REQUIRES_UTF8: + return Tcl_NewStringObj("requires-utf-8", -1); + case XML_C14N_CREATE_STACK: + return Tcl_NewStringObj("create-stack", -1); + case XML_C14N_INVALID_NODE: + return Tcl_NewStringObj("invalid-node", -1); + case XML_FTP_PASV_ANSWER: + return Tcl_NewStringObj("pasv-answer", -1); + case XML_FTP_EPSV_ANSWER: + return Tcl_NewStringObj("epsv-answer", -1); + case XML_FTP_ACCNT: + return Tcl_NewStringObj("account", -1); + case XML_HTTP_URL_SYNTAX: + return Tcl_NewStringObj("URL-syntax", -1); + case XML_HTTP_USE_IP: + return Tcl_NewStringObj("use-IP", -1); + case XML_HTTP_UNKNOWN_HOST: + return Tcl_NewStringObj("unknown-host", -1); + default: + return Tcl_NewIntObj(code); + } +} + +void +TclXML_libxml2_ErrorHandler (ctx, error) + void *ctx; /* ignore - depends on context */ + xmlErrorPtr error; +{ + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + Tcl_Obj *objPtr; + + if (tsdPtr->errorInfoPtr->listPtr == NULL) { + tsdPtr->errorInfoPtr->listPtr = Tcl_NewObj(); + Tcl_IncrRefCount(tsdPtr->errorInfoPtr->listPtr); + } + + objPtr = Tcl_NewListObj(0, NULL); + + Tcl_ListObjAppendElement(tsdPtr->errorInfoPtr->interp, objPtr, + ErrorDomainToString(error->domain)); + Tcl_ListObjAppendElement(tsdPtr->errorInfoPtr->interp, objPtr, + ErrorLevelToString(error->level)); + Tcl_ListObjAppendElement(tsdPtr->errorInfoPtr->interp, objPtr, + ErrorCodeToString(error->code)); + + if (error->node == NULL) { + Tcl_ListObjAppendElement(tsdPtr->errorInfoPtr->interp, objPtr, Tcl_NewObj()); + } else if (((xmlDocPtr) error->node)->type == XML_DOCUMENT_NODE) { + Tcl_ListObjAppendElement(tsdPtr->errorInfoPtr->interp, objPtr, + TclXML_libxml2_CreateObjFromDoc((xmlDocPtr) error->node)); + } else if (tsdPtr->errorInfoPtr->nodeHandlerProc != NULL) { + Tcl_Obj *nodeObjPtr; + + nodeObjPtr = (tsdPtr->errorInfoPtr->nodeHandlerProc)(tsdPtr->errorInfoPtr->interp, (ClientData) error->node); + if (nodeObjPtr != NULL) { + Tcl_ListObjAppendElement(tsdPtr->errorInfoPtr->interp, objPtr, nodeObjPtr); + } else { + Tcl_ListObjAppendElement(tsdPtr->errorInfoPtr->interp, objPtr, Tcl_NewObj()); + } + } else { + Tcl_ListObjAppendElement(tsdPtr->errorInfoPtr->interp, objPtr, Tcl_NewObj()); + } + + Tcl_ListObjAppendElement(tsdPtr->errorInfoPtr->interp, objPtr, + Tcl_NewIntObj(error->line)); + Tcl_ListObjAppendElement(tsdPtr->errorInfoPtr->interp, objPtr, + Tcl_NewStringObj(error->message, -1)); + + Tcl_ListObjAppendElement(tsdPtr->errorInfoPtr->interp, objPtr, + Tcl_NewIntObj(error->int1)); + Tcl_ListObjAppendElement(tsdPtr->errorInfoPtr->interp, objPtr, + Tcl_NewIntObj(error->int2)); + if (error->str1) { + Tcl_ListObjAppendElement(tsdPtr->errorInfoPtr->interp, objPtr, + Tcl_NewStringObj(error->str1, -1)); + } + if (error->str2) { + Tcl_ListObjAppendElement(tsdPtr->errorInfoPtr->interp, objPtr, + Tcl_NewStringObj(error->str2, -1)); + } + if (error->str3) { + Tcl_ListObjAppendElement(tsdPtr->errorInfoPtr->interp, objPtr, + Tcl_NewStringObj(error->str3, -1)); + } + + Tcl_ListObjAppendElement(tsdPtr->errorInfoPtr->interp, tsdPtr->errorInfoPtr->listPtr, objPtr); +} + +void +TclXML_libxml2_ResetError(interp) + Tcl_Interp *interp; +{ + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + if (tsdPtr->errorInfoPtr->listPtr != NULL) { + Tcl_DecrRefCount(tsdPtr->errorInfoPtr->listPtr); + tsdPtr->errorInfoPtr->listPtr = NULL; + } +} + +Tcl_Obj * +TclXML_libxml2_GetErrorObj(interp) + Tcl_Interp *interp; +{ + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + return tsdPtr->errorInfoPtr->listPtr; +} + +void +TclXML_libxml2_SetErrorNodeFunc(interp, proc) + Tcl_Interp *interp; + TclXML_ErrorNodeHandlerProc *proc; +{ + ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + if (!tsdPtr->initialized) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("internal error: docObj data not initialized", -1)); + Tcl_BackgroundError(interp); + return; + } + + tsdPtr->errorInfoPtr->nodeHandlerProc = proc; +} + diff --git a/include/tcldom-libxml2/nodeObj.h b/include/tcldom-libxml2/nodeObj.h new file mode 100644 index 0000000..37a7bcc --- /dev/null +++ b/include/tcldom-libxml2/nodeObj.h @@ -0,0 +1,28 @@ +/* nodeObj.h -- + * + * This module manages libxml2 xmlNodePtr and event node Tcl objects. + * + * Copyright (c) 2003 Zveno Pty Ltd + * http://www.zveno.com/ + * + * See the file "LICENSE" for information on usage and + * redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * $Id: nodeObj.h,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $ + */ + +#ifndef TCLDOM_LIBXML2_NODEOBJ_H +#define TCLDOM_LIBXML2_NODEOBJ_H + +#include "tcl.h" +#include +#include "tcldom-libxml2.h" + +#define TCLDOM_LIBXML2_NODE_NODE 0 +#define TCLDOM_LIBXML2_NODE_EVENT 1 + +typedef void (TclDOM_libxml2Node_FreeHookProc) _ANSI_ARGS_((ClientData clientData)); + +int TclDOM_libxml2_NodeObjInit _ANSI_ARGS_((Tcl_Interp *interp)); + +#endif /* TCLDOM_LIBXML2_NODEOBJ_H */ diff --git a/include/tcldom-libxml2/tcldom-libxml2.h b/include/tcldom-libxml2/tcldom-libxml2.h new file mode 100644 index 0000000..98fd3c8 --- /dev/null +++ b/include/tcldom-libxml2/tcldom-libxml2.h @@ -0,0 +1,266 @@ + +/* tcldom-libxml2.h -- + * + * libxml2 wrapper for TclDOM. + * + * Copyright (c) 2005-2008 Explain + * http://www.explain.com.au/ + * Copyright (c) 2002-2003 Zveno Pty Ltd + * http://www.zveno.com/ + * + * See the file "LICENSE" for information on usage and + * redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * $Id: tcldom-libxml2.h,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $ + */ + +#ifndef __TCLDOM_LIBXML2_H__ +#define __TCLDOM_LIBXML2_H__ + +#include +#include +#include +#include +#include +#include + +/* + * For C++ compilers, use extern "C" + */ + +#ifdef __cplusplus +extern "C" { +#endif + +/* + * These macros are used to control whether functions are being declared for + * import or export in Windows, + * They map to no-op declarations on non-Windows systems. + * Assumes that tcl.h defines DLLEXPORT & DLLIMPORT correctly. + * The default build on windows is for a DLL, which causes the DLLIMPORT + * and DLLEXPORT macros to be nonempty. To build a static library, the + * macro STATIC_BUILD should be defined before the inclusion of tcl.h + * + * If a function is being declared while it is being built + * to be included in a shared library, then it should have the DLLEXPORT + * storage class. If is being declared for use by a module that is going to + * link against the shared library, then it should have the DLLIMPORT storage + * class. If the symbol is beind declared for a static build or for use from a + * stub library, then the storage class should be empty. + * + * The convention is that a macro called BUILD_xxxx, where xxxx is the + * name of a library we are building, is set on the compile line for sources + * that are to be placed in the library. When this macro is set, the + * storage class will be set to DLLEXPORT. At the end of the header file, the + * storage class will be reset to DLLIMPORt. + */ + +#undef TCL_STORAGE_CLASS +#ifdef BUILD_Tcldom_libxml2 +# define TCL_STORAGE_CLASS DLLEXPORT +#else +# ifdef USE_TCL_STUBS +# define TCL_STORAGE_CLASS +# else +# define TCL_STORAGE_CLASS DLLIMPORT +# endif +#endif + +/* + * The following function is required to be defined in all stubs aware + * extensions of TclDOM. The function is actually implemented in the stub + * library, not the main Tcldom library, although there is a trivial + * implementation in the main library in case an extension is statically + * linked into an application. + */ + +EXTERN CONST char * Tcldom_libxml2_InitStubs _ANSI_ARGS_((Tcl_Interp *interp, + CONST char *version, int exact)); + +#ifndef USE_TCLDOMXML_STUBS + +/* + * When not using stubs, make it a macro. + */ + +#define Tcldom_libxml2_InitStubs(interp, version, exact) \ + Tcl_PkgRequire(interp, "dom::generic", version, exact) + +#endif + +/* + * DOM-specific data structure to hook onto documents. + */ + +typedef struct TclDOM_libxml2_Document { + Tcl_Interp *interp; + TclXML_libxml2_Document *tDocPtr; /* Pointer back to main document structure */ + Tcl_Obj *objPtr; /* An object to hold onto for this document */ + Tcl_Command cmd; /* Tcl command for this document */ + + Tcl_HashTable *nodes; + int nodeCntr; + + /* + * Validation support + */ + + xmlSchemaPtr schema; /* XML Schemas */ + /* xmlRelaxNGPtr relaxng; */ + + /* + * Event support. + * + * These tables are indexed by xmlNodePtr. + */ + + Tcl_HashTable *captureListeners; + Tcl_HashTable *bubbleListeners; + + /* + * Optimisation: boolean flag to indicate whether an + * event listener is registered for an event type. + * If no event listeners are registered then there is + * no point in propagating the event. + */ + + int listening[TCLDOM_NUM_EVENT_TYPES]; + +} TclDOM_libxml2_Document; + +/* + * Node management + */ + +/* + * "nodes" are overloaded: they can be either a libxml2 xmlNodePtr or + * an event, which is defined by this module. + */ + +typedef struct _TclDOM_libxml2_Node TclDOM_libxml2_Node; + +#define TCLDOM_LIBXML2_NODE_NODE 0 +#define TCLDOM_LIBXML2_NODE_EVENT 1 + +/* + * Data structure to support Events + */ + +typedef struct TclDOM_libxml2_Event { + TclDOM_libxml2_Node *tNodePtr; /* Generic node structure for this event */ + TclDOM_libxml2_Document *ownerDocument; /* Toplevel Document for this event */ + + enum TclDOM_EventTypes type; /* Enumerate rep of event type */ + Tcl_Obj *typeObjPtr; /* For user defined event type */ + + int stopPropagation; + int preventDefault; + int dispatched; + + Tcl_Obj *altKey; + Tcl_Obj *attrName; + Tcl_Obj *attrChange; + Tcl_Obj *bubbles; + Tcl_Obj *button; + Tcl_Obj *cancelable; + Tcl_Obj *clientX; + Tcl_Obj *clientY; + Tcl_Obj *ctrlKey; + Tcl_Obj *currentNode; + Tcl_Obj *detail; + Tcl_Obj *eventPhase; + Tcl_Obj *metaKey; + Tcl_Obj *newValue; + Tcl_Obj *prevValue; + Tcl_Obj *relatedNode; + Tcl_Obj *screenX; + Tcl_Obj *screenY; + Tcl_Obj *shiftKey; + Tcl_Obj *target; + Tcl_Obj *timeStamp; + Tcl_Obj *view; +} TclDOM_libxml2_Event; + +typedef void (TclDOM_libxml2_Node_FreeHookProc) _ANSI_ARGS_((ClientData clientData)); + +struct _TclDOM_libxml2_Node { + union { + xmlNodePtr nodePtr; + TclDOM_libxml2_Event *eventPtr; + } ptr; + + int type; /* Distinguish between libxml2 nodes and events */ + + char *token; /* string rep of this node */ + Tcl_Command cmd; /* Tcl command that access this structure */ + + void *objs; /* Opaque object for tracking Tcl_Obj's that refer to this node */ + + ClientData apphook; /* Application hook - not used by TclXML or TclDOM */ + TclDOM_libxml2_Node_FreeHookProc *appfree; +}; + +/* + * Public API + */ + +Tcl_Obj * TclDOM_libxml2_CreateObjFromDoc _ANSI_ARGS_((Tcl_Interp *interp, xmlDocPtr docPtr)); +Tcl_Obj * TclDOM_libxml2_CreateObjFromNode _ANSI_ARGS_((Tcl_Interp *interp, xmlNodePtr nodePtr)); +int TclDOM_libxml2_GetNodeFromObj _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr, xmlNodePtr *nodePtrPtr)); +int TclDOM_libxml2_GetTclNodeFromObj _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr, TclDOM_libxml2_Node **tNodePtrPtr)); +int TclDOM_libxml2_GetEventFromObj _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr, TclDOM_libxml2_Event **eventPtrPtr)); +int TclDOM_libxml2_GetTclEventFromObj _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr, TclDOM_libxml2_Node **tNodePtrPtr)); + +int TclDOM_PostMutationEvent _ANSI_ARGS_((Tcl_Interp *interp, + TclXML_libxml2_Document *tDocPtr, + Tcl_Obj *nodeObjPtr, + enum TclDOM_EventTypes type, + Tcl_Obj *typeObjPtr, + Tcl_Obj *bubblesPtr, + Tcl_Obj *cancelablePtr, + Tcl_Obj *relatedNodePtr, + Tcl_Obj *prevValuePtr, + Tcl_Obj *newValuePtr, + Tcl_Obj *attrNamePtr, + Tcl_Obj *attrChangePtr)); +int TclDOM_AddEventListener _ANSI_ARGS_((Tcl_Interp *interp, + TclXML_libxml2_Document *tDocPtr, + void *tokenPtr, /* xmlNodePtr or xmlDocPtr */ + enum TclDOM_EventTypes type, + Tcl_Obj *typeObjPtr, + Tcl_Obj *listenerPtr, + int capturer)); +Tcl_Obj * TclDOM_GetEventListener _ANSI_ARGS_((Tcl_Interp *interp, + TclXML_libxml2_Document *tDocPtr, + void *tokenPtr, + enum TclDOM_EventTypes type, + Tcl_Obj *typeObjPtr, + int capturer)); +int TclDOM_RemoveEventListener _ANSI_ARGS_((Tcl_Interp *interp, + TclXML_libxml2_Document *tDocPtr, + void *tokenPtr, + enum TclDOM_EventTypes type, + Tcl_Obj *typeObjPtr, + Tcl_Obj *listenerPtr, + int capturer)); +int TclDOM_DispatchEvent _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Obj *nodeObjPtr, + Tcl_Obj *eventObjPtr, + TclDOM_libxml2_Event *eventPtr)); + +/* + * Accessor functions => Stubs + */ + +/* +#include + +#undef TCL_STORAGE_CLASS +#define TCL_STORAGE_CLASS DLLIMPORT +*/ + +#ifdef __cplusplus +} +#endif + +#endif /* TCLDOM_LIBXML2_H__ */ diff --git a/include/tcldom/tcldom.h b/include/tcldom/tcldom.h new file mode 100644 index 0000000..08a016b --- /dev/null +++ b/include/tcldom/tcldom.h @@ -0,0 +1,293 @@ +/* tcldom.h -- + * + * Generic layer of TclDOM API. + * + * Copyright (c) 2006-2008 Explain + * http://www.explain.com.au/ + * Copyright (c) 2002-2004 Zveno Pty Ltd + * http://www.zveno.com/ + * + * Zveno Pty Ltd makes this software and associated documentation + * available free of charge for any purpose. You may make copies + * of the software but you must include all of this notice on any copy. + * + * Zveno Pty Ltd does not warrant that this software is error free + * or fit for any purpose. Zveno Pty Ltd disclaims any liability for + * all claims, expenses, losses, damages and costs any user may incur + * as a result of using, copying or modifying the software. + * + * $Id: tcldom.h,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $ + */ + +#ifndef __TCLDOM_H__ +#define __TCLDOM_H__ + +#include + +/* + * For C++ compilers, use extern "C" + */ + +#ifdef __cplusplus +extern "C" { +#endif + +/* + + * These macros are used to control whether functions are being declared for + * import or export in Windows, + * They map to no-op declarations on non-Windows systems. + * Assumes that tcl.h defines DLLEXPORT & DLLIMPORT correctly. + * The default build on windows is for a DLL, which causes the DLLIMPORT + * and DLLEXPORT macros to be nonempty. To build a static library, the + * macro STATIC_BUILD should be defined before the inclusion of tcl.h + * + * If a function is being declared while it is being built + * to be included in a shared library, then it should have the DLLEXPORT + * storage class. If is being declared for use by a module that is going to + * link against the shared library, then it should have the DLLIMPORT storage + * class. If the symbol is beind declared for a static build or for use from a + * stub library, then the storage class should be empty. + * + * The convention is that a macro called BUILD_xxxx, where xxxx is the + * name of a library we are building, is set on the compile line for sources + * that are to be placed in the library. When this macro is set, the + * storage class will be set to DLLEXPORT. At the end of the header file, the + * storage class will be reset to DLLIMPORt. + */ + +#undef TCL_STORAGE_CLASS +#ifdef BUILD_tcldom +# define TCL_STORAGE_CLASS DLLEXPORT +#else +# ifdef USE_TCL_STUBS +# define TCL_STORAGE_CLASS +# else +# define TCL_STORAGE_CLASS DLLIMPORT +# endif +#endif + +/* + * The main purpose of this module is to provide common switch tables + * for command methods and options. + */ + +enum TclDOM_DOMImplementationCommandMethods { + TCLDOM_IMPL_HASFEATURE, + TCLDOM_IMPL_CREATEDOCUMENT, + TCLDOM_IMPL_CREATE, + TCLDOM_IMPL_CREATEDOCUMENTTYPE, + TCLDOM_IMPL_CREATENODE, + TCLDOM_IMPL_DESTROY, + TCLDOM_IMPL_ISNODE, + TCLDOM_IMPL_PARSE, + TCLDOM_IMPL_SELECTNODE, + TCLDOM_IMPL_SERIALIZE, + TCLDOM_IMPL_TRIM +}; +enum TclDOM_DocumentCommandMethods { + TCLDOM_DOCUMENT_CGET, + TCLDOM_DOCUMENT_CONFIGURE, + TCLDOM_DOCUMENT_CREATEELEMENT, + TCLDOM_DOCUMENT_CREATEDOCUMENTFRAGMENT, + TCLDOM_DOCUMENT_CREATETEXTNODE, + TCLDOM_DOCUMENT_CREATECOMMENT, + TCLDOM_DOCUMENT_CREATECDATASECTION, + TCLDOM_DOCUMENT_CREATEPI, + TCLDOM_DOCUMENT_CREATEATTRIBUTE, + TCLDOM_DOCUMENT_CREATEENTITY, + TCLDOM_DOCUMENT_CREATEENTITYREFERENCE, + TCLDOM_DOCUMENT_CREATEDOCTYPEDECL, + TCLDOM_DOCUMENT_IMPORTNODE, + TCLDOM_DOCUMENT_CREATEELEMENTNS, + TCLDOM_DOCUMENT_CREATEATTRIBUTENS, + TCLDOM_DOCUMENT_GETELEMENTSBYTAGNAMENS, + TCLDOM_DOCUMENT_GETELEMENTSBYID, + TCLDOM_DOCUMENT_CREATEEVENT, + TCLDOM_DOCUMENT_GETELEMENTSBYTAGNAME, + TCLDOM_DOCUMENT_DTD, + TCLDOM_DOCUMENT_SCHEMA +}; +enum TclDOM_DocumentCommandOptions { + TCLDOM_DOCUMENT_DOCTYPE, + TCLDOM_DOCUMENT_IMPLEMENTATION, + TCLDOM_DOCUMENT_DOCELEMENT +}; +enum TclDOM_DocumentDTDSubmethods { + TCLDOM_DOCUMENT_DTD_VALIDATE +}; +enum TclDOM_DocumentSchemaSubmethods { + TCLDOM_DOCUMENT_SCHEMA_COMPILE, + TCLDOM_DOCUMENT_SCHEMA_VALIDATE +}; +enum TclDOM_DocumentRelaxNGSubmethods { + TCLDOM_DOCUMENT_RELAXNG_COMPILE, + TCLDOM_DOCUMENT_RELAXNG_VALIDATE +}; +enum TclDOM_NodeCommandMethods { + TCLDOM_NODE_CGET, + TCLDOM_NODE_CONFIGURE, + TCLDOM_NODE_INSERTBEFORE, + TCLDOM_NODE_REPLACECHILD, + TCLDOM_NODE_REMOVECHILD, + TCLDOM_NODE_APPENDCHILD, + TCLDOM_NODE_HASCHILDNODES, + TCLDOM_NODE_CLONENODE, + TCLDOM_NODE_CHILDREN, + TCLDOM_NODE_PARENT, + TCLDOM_NODE_PATH, + TCLDOM_NODE_CREATENODE, + TCLDOM_NODE_SELECTNODE, + TCLDOM_NODE_STRINGVALUE, + TCLDOM_NODE_ADDEVENTLISTENER, + TCLDOM_NODE_REMOVEEVENTLISTENER, + TCLDOM_NODE_DISPATCHEVENT, + TCLDOM_NODE_ISSAMENODE +}; +enum TclDOM_NodeCommandOptions { + TCLDOM_NODE_NODETYPE, + TCLDOM_NODE_PARENTNODE, + TCLDOM_NODE_CHILDNODES, + TCLDOM_NODE_FIRSTCHILD, + TCLDOM_NODE_LASTCHILD, + TCLDOM_NODE_PREVIOUSSIBLING, + TCLDOM_NODE_NEXTSIBLING, + TCLDOM_NODE_ATTRIBUTES, + TCLDOM_NODE_NAMESPACEURI, + TCLDOM_NODE_PREFIX, + TCLDOM_NODE_LOCALNAME, + TCLDOM_NODE_NODEVALUE, + TCLDOM_NODE_CDATASECTION, + TCLDOM_NODE_NODENAME, + TCLDOM_NODE_OWNERDOCUMENT +}; +enum TclDOM_NodeCommandAddEventListenerOptions { + TCLDOM_NODE_ADDEVENTLISTENER_USECAPTURE +}; +enum TclDOM_ElementCommandMethods { + TCLDOM_ELEMENT_CGET, + TCLDOM_ELEMENT_CONFIGURE, + TCLDOM_ELEMENT_GETATTRIBUTE, + TCLDOM_ELEMENT_SETATTRIBUTE, + TCLDOM_ELEMENT_REMOVEATTRIBUTE, + TCLDOM_ELEMENT_GETATTRIBUTENS, + TCLDOM_ELEMENT_SETATTRIBUTENS, + TCLDOM_ELEMENT_REMOVEATTRIBUTENS, + TCLDOM_ELEMENT_GETATTRIBUTENODE, + TCLDOM_ELEMENT_SETATTRIBUTENODE, + TCLDOM_ELEMENT_REMOVEATTRIBUTENODE, + TCLDOM_ELEMENT_GETATTRIBUTENODENS, + TCLDOM_ELEMENT_SETATTRIBUTENODENS, + TCLDOM_ELEMENT_REMOVEATTRIBUTENODENS, + TCLDOM_ELEMENT_GETELEMENTSBYTAGNAME, + TCLDOM_ELEMENT_NORMALIZE +}; +enum TclDOM_ElementCommandOptions { + TCLDOM_ELEMENT_TAGNAME, + TCLDOM_ELEMENT_EMPTY +}; +enum TclDOM_EventCommandMethods { + TCLDOM_EVENT_CGET, + TCLDOM_EVENT_CONFIGURE, + TCLDOM_EVENT_STOPPROPAGATION, + TCLDOM_EVENT_PREVENTDEFAULT, + TCLDOM_EVENT_INITEVENT, + TCLDOM_EVENT_INITUIEVENT, + TCLDOM_EVENT_INITMOUSEEVENT, + TCLDOM_EVENT_INITMUTATIONEVENT, + TCLDOM_EVENT_POSTUIEVENT, + TCLDOM_EVENT_POSTMOUSEEVENT, + TCLDOM_EVENT_POSTMUTATIONEVENT +}; +enum TclDOM_EventCommandOptions { + TCLDOM_EVENT_ALTKEY, + TCLDOM_EVENT_ATTRNAME, + TCLDOM_EVENT_ATTRCHANGE, + TCLDOM_EVENT_BUBBLES, + TCLDOM_EVENT_BUTTON, + TCLDOM_EVENT_CANCELABLE, + TCLDOM_EVENT_CLIENTX, + TCLDOM_EVENT_CLIENTY, + TCLDOM_EVENT_CTRLKEY, + TCLDOM_EVENT_CURRENTNODE, + TCLDOM_EVENT_DETAIL, + TCLDOM_EVENT_EVENTPHASE, + TCLDOM_EVENT_METAKEY, + TCLDOM_EVENT_NEWVALUE, + TCLDOM_EVENT_PREVVALUE, + TCLDOM_EVENT_RELATEDNODE, + TCLDOM_EVENT_SCREENX, + TCLDOM_EVENT_SCREENY, + TCLDOM_EVENT_SHIFTKEY, + TCLDOM_EVENT_TARGET, + TCLDOM_EVENT_TIMESTAMP, + TCLDOM_EVENT_TYPE, + TCLDOM_EVENT_VIEW +}; + /* + * NB. TCLDOM_EVENT_USERDEFINED does not have an entry in the string table. + */ +enum TclDOM_EventTypes { + TCLDOM_EVENT_DOMFOCUSIN, + TCLDOM_EVENT_DOMFOCUSOUT, + TCLDOM_EVENT_DOMACTIVATE, + TCLDOM_EVENT_CLICK, + TCLDOM_EVENT_MOUSEDOWN, + TCLDOM_EVENT_MOUSEUP, + TCLDOM_EVENT_MOUSEOVER, + TCLDOM_EVENT_MOUSEMOVE, + TCLDOM_EVENT_MOUSEOUT, + TCLDOM_EVENT_DOMSUBTREEMODIFIED, + TCLDOM_EVENT_DOMNODEINSERTED, + TCLDOM_EVENT_DOMNODEREMOVED, + TCLDOM_EVENT_DOMNODEINSERTEDINTODOCUMENT, + TCLDOM_EVENT_DOMNODEREMOVEDFROMDOCUMENT, + TCLDOM_EVENT_DOMATTRMODIFIED, + TCLDOM_EVENT_DOMCHARACTERDATAMODIFIED, + TCLDOM_EVENT_USERDEFINED +}; +enum TclDOM_ParseCommandOptions { + TCLDOM_PARSE_BASEURI, + TCLDOM_PARSE_EXTERNALENTITYCOMMAND +}; +enum TclDOM_SerializeCommandOptions { + TCLDOM_SERIALIZE_INDENT, + TCLDOM_SERIALIZE_METHOD, + TCLDOM_SERIALIZE_ENCODING, + TCLDOM_SERIALIZE_OMIT_XML_DECLARATION +}; +enum TclDOM_SerializeMethods { + TCLDOM_SERIALIZE_METHOD_XML, + TCLDOM_SERIALIZE_METHOD_HTML, + TCLDOM_SERIALIZE_METHOD_TEXT +}; +enum TclDOM_SelectNodeOptions { + TCLDOM_SELECTNODE_OPTION_NAMESPACES +}; + +/* + * DOM Level 2 Event support + */ + +#define TCLDOM_NUM_EVENT_TYPES 17 + +/* + * The following function is required to be defined in all stubs aware + * extensions of TclDOM. The function is actually implemented in the stub + * library, not the main Tcldom library, although there is a trivial + * implementation in the main library in case an extension is statically + * linked into an application. + */ + +#ifndef USE_TCLDOM_STUBS + +#undef TCL_STORAGE_CLASS +#define TCL_STORAGE_CLASS DLLIMPORT + +#endif + +#ifdef __cplusplus +} +#endif + +#endif /* __TCLDOM_H__ */ diff --git a/include/tclxml-libxml2/docObj.h b/include/tclxml-libxml2/docObj.h new file mode 100644 index 0000000..aaffb2e --- /dev/null +++ b/include/tclxml-libxml2/docObj.h @@ -0,0 +1,60 @@ +/* docObj.h -- + * + * This module manages libxml2 xmlDocPtr Tcl objects. + * + * Copyright (c) 2003 Zveno Pty Ltd + * http://www.zveno.com/ + * + * Zveno Pty Ltd makes this software and associated documentation + * available free of charge for any purpose. You may make copies + * of the software but you must include all of this notice on any copy. + * + * Zveno Pty Ltd does not warrant that this software is error free + * or fit for any purpose. Zveno Pty Ltd disclaims any liability for + * all claims, expenses, losses, damages and costs any user may incur + * as a result of using, copying or modifying the software. + * + * $Id: docObj.h,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $ + */ + +#ifndef TCLXML_LIBXML2_DOCOBJ_H +#define TCLXML_LIBXML2_DOCOBJ_H + +#ifdef TCLXML_BUILD_AS_FRAMEWORK +#include +#else +#include +#endif /* TCLXML_BUILD_AS_FRAMEWORK */ +#include + +typedef void (TclXML_libxml2Doc_FreeHookProc) _ANSI_ARGS_((ClientData clientData)); + +/* + * Values that define how documents are handled: + * KEEP means that documents must be explicitly destroyed, + * IMPLICIT means that documents will be destroyed when there are no longer + * any references to it. + */ + +typedef enum TclXML_libxml2_DocumentHandling { + TCLXML_LIBXML2_DOCUMENT_KEEP, + TCLXML_LIBXML2_DOCUMENT_IMPLICIT +} TclXML_libxml2_DocumentHandling; + +typedef struct TclXML_libxml2_Document { + xmlDocPtr docPtr; + + char *token; /* string rep of this document */ + + TclXML_libxml2_DocumentHandling keep; + /* how to handle document destruction */ + + void *objs; /* List of Tcl_Obj's that reference this document */ + + ClientData dom; /* Hook for TclDOM data */ + TclXML_libxml2Doc_FreeHookProc *domfree; + ClientData apphook; /* Application hook - not used by TclXML or TclDOM */ + TclXML_libxml2Doc_FreeHookProc *appfree; +} TclXML_libxml2_Document; + +#endif /* TCLXML_LIBXML2_DOCOBJ_H */ diff --git a/include/tclxml-libxml2/tclxml-libxml2.h b/include/tclxml-libxml2/tclxml-libxml2.h new file mode 100644 index 0000000..22050f4 --- /dev/null +++ b/include/tclxml-libxml2/tclxml-libxml2.h @@ -0,0 +1,100 @@ +/* tcllibxml2.h -- + * + * This module provides an interface to libxml2. + * + * Copyright (c) 2005 Explain + * http://www.explain.com.au/ + * Copyright (c) 2003 Zveno Pty Ltd + * http://www.zveno.com/ + * + * See the file "LICENSE" for information on usage and + * redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * $Id: tclxml-libxml2.h,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $ + */ + +#ifndef TCLXML_LIBXML2_H +#define TCLXML_LIBXML2_H + +#include +#include +#include "docObj.h" + +/* + * For C++ compilers, use extern "C" + */ + +#ifdef __cplusplus +extern "C" { +#endif + +/* + * These macros are used to control whether functions are being declared for + * import or export in Windows, + * They map to no-op declarations on non-Windows systems. + * Assumes that tcl.h defines DLLEXPORT & DLLIMPORT correctly. + * The default build on windows is for a DLL, which causes the DLLIMPORT + * and DLLEXPORT macros to be nonempty. To build a static library, the + * macro STATIC_BUILD should be defined before the inclusion of tcl.h + * + * If a function is being declared while it is being built + * to be included in a shared library, then it should have the DLLEXPORT + * storage class. If is being declared for use by a module that is going to + * link against the shared library, then it should have the DLLIMPORT storage + * class. If the symbol is beind declared for a static build or for use from a + * stub library, then the storage class should be empty. + * + * The convention is that a macro called BUILD_xxxx, where xxxx is the + * name of a library we are building, is set on the compile line for sources + * that are to be placed in the library. When this macro is set, the + * storage class will be set to DLLEXPORT. At the end of the header file, the + * storage class will be reset to DLLIMPORt. + */ + +#undef TCL_STORAGE_CLASS +#ifdef BUILD_TclXML_libxml2 +# define TCL_STORAGE_CLASS DLLEXPORT +#else +# ifdef USE_TCL_STUBS +# define TCL_STORAGE_CLASS +# else +# define TCL_STORAGE_CLASS DLLIMPORT +# endif +#endif + +/* + * The following function is required to be defined in all stubs aware + * extensions of TclXML/libxml2. The function is actually implemented in the stub + * library, not the main TclXML/libxml2 library, although there is a trivial + * implementation in the main library in case an extension is statically + * linked into an application. + */ + +EXTERN CONST char * TclXML_libxml2_InitStubs _ANSI_ARGS_((Tcl_Interp *interp, + CONST char *version, int exact)); + +#ifndef USE_TCLXML_LIBXML2_STUBS + +/* + * When not using stubs, make it a macro. + */ + +#define TclXML_libxml2_InitStubs(interp, version, exact) \ + Tcl_PkgRequire(interp, "xml::libxml2", version, exact) + +#endif + +/* + * Accessor functions => Stubs + */ + +#include + +#undef TCL_STORAGE_CLASS +#define TCL_STORAGE_CLASS DLLIMPORT + +#ifdef __cplusplus +} +#endif + +#endif /* TCLXML_LIBXML2_H */ diff --git a/include/tclxml-libxml2/tclxml-libxml2Decls.h b/include/tclxml-libxml2/tclxml-libxml2Decls.h new file mode 100644 index 0000000..187b159 --- /dev/null +++ b/include/tclxml-libxml2/tclxml-libxml2Decls.h @@ -0,0 +1,163 @@ +/* + * tclxml-libxml2Decls.h -- + * + * Declarations of functions in the platform independent public TCLXML/libxml2 API. + * + */ + +#ifndef _TCLXMLLIBXML2DECLS +#define _TCLXMLLIBXML2DECLS + +/* + * WARNING: The contents of this file is automatically generated by the + * genStubs.tcl script. Any modifications to the function declarations + * below should be made in the tcllibxml2.decls script. + */ + +#include "docObj.h" +#include + +/* !BEGIN!: Do not edit below this line. */ + +/* + * Exported function declarations: + */ + +/* 0 */ +EXTERN int Tclxml_libxml2_Init _ANSI_ARGS_((Tcl_Interp * interp)); +/* Slot 1 is reserved */ +/* 2 */ +EXTERN int TclXML_libxml2_InitDocObj _ANSI_ARGS_(( + Tcl_Interp * interp)); +/* 3 */ +EXTERN Tcl_Obj * TclXML_libxml2_NewDocObj _ANSI_ARGS_(( + Tcl_Interp * interp)); +/* 4 */ +EXTERN Tcl_Obj * TclXML_libxml2_CreateObjFromDoc _ANSI_ARGS_(( + xmlDocPtr docPtr)); +/* 5 */ +EXTERN int TclXML_libxml2_GetDocFromObj _ANSI_ARGS_(( + Tcl_Interp * interp, Tcl_Obj * objPtr, + xmlDocPtr * docPtr)); +/* 6 */ +EXTERN int TclXML_libxml2_GetTclDocFromObj _ANSI_ARGS_(( + Tcl_Interp * interp, Tcl_Obj * objPtr, + TclXML_libxml2_Document ** tDocPtrPtr)); +/* 7 */ +EXTERN int TclXML_libxml2_GetTclDocFromNode _ANSI_ARGS_(( + Tcl_Interp * interp, xmlNodePtr nodePtr, + TclXML_libxml2_Document ** tDocPtrPtr)); +/* 8 */ +EXTERN void TclXML_libxml2_DestroyDocument _ANSI_ARGS_(( + TclXML_libxml2_Document * tDocPtr)); +/* 9 */ +EXTERN void TclXML_libxml2_DocKeep _ANSI_ARGS_((Tcl_Obj * objPtr, + TclXML_libxml2_DocumentHandling keep)); +/* 10 */ +EXTERN void TclXML_libxml2_ErrorHandler _ANSI_ARGS_((void * ctx, + xmlErrorPtr error)); +/* 11 */ +EXTERN void TclXML_libxml2_ResetError _ANSI_ARGS_(( + Tcl_Interp * interp)); +/* 12 */ +EXTERN Tcl_Obj * TclXML_libxml2_GetErrorObj _ANSI_ARGS_(( + Tcl_Interp * interp)); +/* 13 */ +EXTERN void TclXML_libxml2_SetErrorNodeFunc _ANSI_ARGS_(( + Tcl_Interp * interp, + TclXML_ErrorNodeHandlerProc * proc)); + +typedef struct Tclxml_libxml2Stubs { + int magic; + struct Tclxml_libxml2StubHooks *hooks; + + int (*tclxml_libxml2_Init) _ANSI_ARGS_((Tcl_Interp * interp)); /* 0 */ + void *reserved1; + int (*tclXML_libxml2_InitDocObj) _ANSI_ARGS_((Tcl_Interp * interp)); /* 2 */ + Tcl_Obj * (*tclXML_libxml2_NewDocObj) _ANSI_ARGS_((Tcl_Interp * interp)); /* 3 */ + Tcl_Obj * (*tclXML_libxml2_CreateObjFromDoc) _ANSI_ARGS_((xmlDocPtr docPtr)); /* 4 */ + int (*tclXML_libxml2_GetDocFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, xmlDocPtr * docPtr)); /* 5 */ + int (*tclXML_libxml2_GetTclDocFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, TclXML_libxml2_Document ** tDocPtrPtr)); /* 6 */ + int (*tclXML_libxml2_GetTclDocFromNode) _ANSI_ARGS_((Tcl_Interp * interp, xmlNodePtr nodePtr, TclXML_libxml2_Document ** tDocPtrPtr)); /* 7 */ + void (*tclXML_libxml2_DestroyDocument) _ANSI_ARGS_((TclXML_libxml2_Document * tDocPtr)); /* 8 */ + void (*tclXML_libxml2_DocKeep) _ANSI_ARGS_((Tcl_Obj * objPtr, TclXML_libxml2_DocumentHandling keep)); /* 9 */ + void (*tclXML_libxml2_ErrorHandler) _ANSI_ARGS_((void * ctx, xmlErrorPtr error)); /* 10 */ + void (*tclXML_libxml2_ResetError) _ANSI_ARGS_((Tcl_Interp * interp)); /* 11 */ + Tcl_Obj * (*tclXML_libxml2_GetErrorObj) _ANSI_ARGS_((Tcl_Interp * interp)); /* 12 */ + void (*tclXML_libxml2_SetErrorNodeFunc) _ANSI_ARGS_((Tcl_Interp * interp, TclXML_ErrorNodeHandlerProc * proc)); /* 13 */ +} Tclxml_libxml2Stubs; + +#ifdef __cplusplus +extern "C" { +#endif +extern Tclxml_libxml2Stubs *tclxml_libxml2StubsPtr; +#ifdef __cplusplus +} +#endif + +#if defined(USE_TCLXML_LIBXML2_STUBS) && !defined(USE_TCLXML_LIBXML2_STUB_PROCS) + +/* + * Inline function declarations: + */ + +#ifndef Tclxml_libxml2_Init +#define Tclxml_libxml2_Init \ + (tclxml_libxml2StubsPtr->tclxml_libxml2_Init) /* 0 */ +#endif +/* Slot 1 is reserved */ +#ifndef TclXML_libxml2_InitDocObj +#define TclXML_libxml2_InitDocObj \ + (tclxml_libxml2StubsPtr->tclXML_libxml2_InitDocObj) /* 2 */ +#endif +#ifndef TclXML_libxml2_NewDocObj +#define TclXML_libxml2_NewDocObj \ + (tclxml_libxml2StubsPtr->tclXML_libxml2_NewDocObj) /* 3 */ +#endif +#ifndef TclXML_libxml2_CreateObjFromDoc +#define TclXML_libxml2_CreateObjFromDoc \ + (tclxml_libxml2StubsPtr->tclXML_libxml2_CreateObjFromDoc) /* 4 */ +#endif +#ifndef TclXML_libxml2_GetDocFromObj +#define TclXML_libxml2_GetDocFromObj \ + (tclxml_libxml2StubsPtr->tclXML_libxml2_GetDocFromObj) /* 5 */ +#endif +#ifndef TclXML_libxml2_GetTclDocFromObj +#define TclXML_libxml2_GetTclDocFromObj \ + (tclxml_libxml2StubsPtr->tclXML_libxml2_GetTclDocFromObj) /* 6 */ +#endif +#ifndef TclXML_libxml2_GetTclDocFromNode +#define TclXML_libxml2_GetTclDocFromNode \ + (tclxml_libxml2StubsPtr->tclXML_libxml2_GetTclDocFromNode) /* 7 */ +#endif +#ifndef TclXML_libxml2_DestroyDocument +#define TclXML_libxml2_DestroyDocument \ + (tclxml_libxml2StubsPtr->tclXML_libxml2_DestroyDocument) /* 8 */ +#endif +#ifndef TclXML_libxml2_DocKeep +#define TclXML_libxml2_DocKeep \ + (tclxml_libxml2StubsPtr->tclXML_libxml2_DocKeep) /* 9 */ +#endif +#ifndef TclXML_libxml2_ErrorHandler +#define TclXML_libxml2_ErrorHandler \ + (tclxml_libxml2StubsPtr->tclXML_libxml2_ErrorHandler) /* 10 */ +#endif +#ifndef TclXML_libxml2_ResetError +#define TclXML_libxml2_ResetError \ + (tclxml_libxml2StubsPtr->tclXML_libxml2_ResetError) /* 11 */ +#endif +#ifndef TclXML_libxml2_GetErrorObj +#define TclXML_libxml2_GetErrorObj \ + (tclxml_libxml2StubsPtr->tclXML_libxml2_GetErrorObj) /* 12 */ +#endif +#ifndef TclXML_libxml2_SetErrorNodeFunc +#define TclXML_libxml2_SetErrorNodeFunc \ + (tclxml_libxml2StubsPtr->tclXML_libxml2_SetErrorNodeFunc) /* 13 */ +#endif + +#endif /* defined(USE_TCLXML_LIBXML2_STUBS) && !defined(USE_TCLXML_LIBXML2_STUB_PROCS) */ + +/* !END!: Do not edit above this line. */ + +#endif /* _TCLXMLLLIBXML2DECLS */ + diff --git a/include/tclxml/tclxml.h.in b/include/tclxml/tclxml.h.in new file mode 100755 index 0000000..c809fdc --- /dev/null +++ b/include/tclxml/tclxml.h.in @@ -0,0 +1,299 @@ +/* + * tclxml.h -- + * + * Generic interface to XML parsers. + * + * Copyright (c) 2005-2007 by Explain. + * Copyright (c) 1999-2004 Steve Ball, Zveno Pty Ltd + * + * See the file "LICENSE" for information on usage and + * redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * $Id: tclxml.h.in,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $ + * + */ + +#ifndef __TCLXML_H__ +#define __TCLXML_H__ + +#ifdef TCLXML_BUILD_AS_FRAMEWORK +#include +#else +#include +#endif /* TCLXML_BUILD_AS_FRAMEWORK */ + +#define TCLXML_VERSION "@PACKAGE_VERSION@" + +/* + * Used to block the rest of this header file from resource compilers so + * we can just get the version info. + */ +#ifndef RC_INVOKED + +/* TIP 27 update. If CONST84 is not defined we are compiling against a + * core before 8.4 and have to disable some CONST'ness. + */ + +#ifndef CONST84 +# define CONST84 +#endif + +/* + * Fix the Borland bug that's in the EXTERN macro from tcl.h. + */ +#ifndef TCL_EXTERN +# undef DLLIMPORT +# undef DLLEXPORT +# if defined(STATIC_BUILD) +# define DLLIMPORT +# define DLLEXPORT +# elif (defined(__WIN32__) && (defined(_MSC_VER) || (__BORLANDC__ >= 0x0550) || (defined(__GNUC__) && defined(__declspec)))) || (defined(MAC_TCL) && FUNCTION_DECLSPEC) +# define DLLIMPORT __declspec(dllimport) +# define DLLEXPORT __declspec(dllexport) +# elif defined(__BORLANDC__) +# define OLDBORLAND 1 +# define DLLIMPORT __import +# define DLLEXPORT __export +# else +# define DLLIMPORT +# define DLLEXPORT +# endif + /* Avoid name mangling from C++ compilers. */ +# ifdef __cplusplus +# define TCL_EXTRNC extern "C" +# else +# define TCL_EXTRNC extern +# endif + /* Pre-5.5 Borland requires the attributes be placed after the */ + /* return type. */ +# ifdef OLDBORLAND +# define TCL_EXTERN(RTYPE) TCL_EXTRNC RTYPE TCL_STORAGE_CLASS +# else +# define TCL_EXTERN(RTYPE) TCL_EXTRNC TCL_STORAGE_CLASS RTYPE +# endif +#endif + + + +/* + * These macros are used to control whether functions are being declared for + * import or export in Windows, + * They map to no-op declarations on non-Windows systems. + * Assumes that tcl.h defines DLLEXPORT & DLLIMPORT correctly. + * The default build on windows is for a DLL, which causes the DLLIMPORT + * and DLLEXPORT macros to be nonempty. To build a static library, the + * macro STATIC_BUILD should be defined before the inclusion of tcl.h + * + * If a function is being declared while it is being built + * to be included in a shared library, then it should have the DLLEXPORT + * storage class. If is being declared for use by a module that is going to + * link against the shared library, then it should have the DLLIMPORT storage + * class. If the symbol is beind declared for a static build or for use from a + * stub library, then the storage class should be empty. + * + * The convention is that a macro called BUILD_xxxx, where xxxx is the + * name of a library we are building, is set on the compile line for sources + * that are to be placed in the library. When this macro is set, the + * storage class will be set to DLLEXPORT. At the end of the header file, the + * storage class will be reset to DLLIMPORt. + */ + +#undef TCL_STORAGE_CLASS +#ifdef BUILD_Tclxml +# define TCL_STORAGE_CLASS DLLEXPORT +#else +# ifdef USE_TCLXML_STUBS +# define TCL_STORAGE_CLASS +# else +# define TCL_STORAGE_CLASS DLLIMPORT +# endif +#endif + + +/* + * C API for TclXML generic layer + * + * C callback functions to application code and their registration functions. + * These all mimic the Tcl callbacks. + */ + +typedef int (TclXML_ElementStartProc) _ANSI_ARGS_((Tcl_Interp *interp, ClientData clientData, Tcl_Obj *namePtr, Tcl_Obj *nsuri, Tcl_Obj *attListPtr, Tcl_Obj *nsDeclsPtr)); +typedef int (TclXML_ElementEndProc) _ANSI_ARGS_((Tcl_Interp *interp, ClientData clientData, Tcl_Obj *namePtr)); +typedef int (TclXML_CharacterDataProc) _ANSI_ARGS_((Tcl_Interp *interp, ClientData clientData, Tcl_Obj *dataPtr)); +typedef int (TclXML_PIProc) _ANSI_ARGS_((Tcl_Interp *interp, ClientData clientData, Tcl_Obj *targetPtr, Tcl_Obj *dataPtr)); +typedef int (TclXML_DefaultProc) _ANSI_ARGS_((Tcl_Interp *interp, ClientData clientData, Tcl_Obj *dataPtr)); +typedef int (TclXML_UnparsedProc) _ANSI_ARGS_((Tcl_Interp *interp, ClientData clientData, Tcl_Obj *entityPtr, Tcl_Obj *basePtr, Tcl_Obj *systemIdPtr, Tcl_Obj *publicIdPtr, Tcl_Obj *notationNamePtr)); +typedef int (TclXML_NotationDeclProc) _ANSI_ARGS_((Tcl_Interp *interp, ClientData clientData, Tcl_Obj *namePtr, Tcl_Obj *basePtr, Tcl_Obj *systemIdPtr, Tcl_Obj *publicIdPtr)); +typedef int (TclXML_EntityProc) _ANSI_ARGS_((Tcl_Interp *interp, ClientData clientData, Tcl_Obj *namePtr, Tcl_Obj *basePtr, Tcl_Obj *systemIdPtr, Tcl_Obj *publicIdPtr)); +typedef int (TclXML_UnknownEncodingProc) _ANSI_ARGS_((Tcl_Interp *interp, ClientData clientData, Tcl_Obj *dataPtr, void *info)); +typedef int (TclXML_CommentProc) _ANSI_ARGS_((Tcl_Interp *interp, ClientData clientData, Tcl_Obj *dataPtr)); +typedef int (TclXML_NotStandaloneProc) _ANSI_ARGS_((Tcl_Interp *interp, ClientData clientData)); +typedef int (TclXML_ElementDeclProc) _ANSI_ARGS_((Tcl_Interp *interp, ClientData clientData, Tcl_Obj *namePtr, Tcl_Obj *contentspecPtr)); +typedef int (TclXML_AttlistDeclProc) _ANSI_ARGS_((Tcl_Interp *interp, ClientData clientData, Tcl_Obj *elementnamePtr, Tcl_Obj *attrdefnsPtr)); +typedef int (TclXML_StartDoctypeDeclProc) _ANSI_ARGS_((Tcl_Interp *interp, ClientData clientData, Tcl_Obj *namePtr)); +typedef int (TclXML_EndDoctypeDeclProc) _ANSI_ARGS_((Tcl_Interp *interp, ClientData clientData)); + +/* + * The structure below is used to refer to a parser object. + */ + +typedef struct TclXML_Info { + Tcl_Interp *interp; /* Interpreter for this instance */ + Tcl_Obj *name; /* name of this instance */ + + Tcl_Obj *base; /* base URI for document entity */ + + Tcl_Obj *encoding; /* character encoding */ + + void *parserClass; /* Parser-specific functions + * Actually of type TclXML_ParserClassInfo + */ + ClientData clientData; /* Parser-specific data structure */ + + int final; /* input data complete? */ + int validate; /* Validate document? */ + + int status; /* application status */ + Tcl_Obj *result; /* application return result */ + + int continueCount; /* reference count for continue */ + Tcl_Obj *context; /* reference to the context pointer */ + + Tcl_Obj *cdata; /* Accumulates character data */ + int nowhitespace; /* Whether to ignore white space */ + int reportempty; /* Whether to report empty elements */ + int expandinternalentities; /* Whether to expand internal entities */ + int paramentities; /* Whether to include parameter entities */ + + Tcl_Obj *elementstartcommand; /* Script for element start */ + TclXML_ElementStartProc *elementstart; /* Callback for element start */ + ClientData elementstartdata; + Tcl_Obj *elementendcommand; /* Script for element end */ + TclXML_ElementEndProc *elementend; /* Callback for element end */ + ClientData elementenddata; + Tcl_Obj *datacommand; /* Script for character data */ + TclXML_CharacterDataProc *cdatacb; /* Callback for character data */ + ClientData cdatacbdata; + Tcl_Obj *picommand; /* Script for processing instruction */ + TclXML_PIProc *pi; /* Callback for processing instruction */ + ClientData pidata; + Tcl_Obj *defaultcommand; /* Script for default data */ + TclXML_DefaultProc *defaultcb; /* Callback for default data */ + ClientData defaultdata; + Tcl_Obj *unparsedcommand; /* Script for unparsed entity declaration */ + TclXML_UnparsedProc *unparsed; /* Callback for unparsed entity declaraion */ + ClientData unparseddata; + Tcl_Obj *notationcommand; /* Script for notation declaration */ + TclXML_NotationDeclProc *notation; /* Callback for notation declaraion */ + ClientData notationdata; + Tcl_Obj *entitycommand; /* Script for external entity */ + TclXML_EntityProc *entity; /* Callback for external entity */ + ClientData entitydata; + Tcl_Obj *unknownencodingcommand; /* Script for unknown encoding */ + TclXML_UnknownEncodingProc *unknownencoding; /* Callback for unknown encoding */ + ClientData unknownencodingdata; + /* Following added by ericm@scriptics */ + Tcl_Obj *commentCommand; /* Script for comments */ + TclXML_CommentProc *comment; /* Callback for comments */ + ClientData commentdata; + Tcl_Obj *notStandaloneCommand; /* Script for "not standalone" docs */ + TclXML_NotStandaloneProc *notStandalone; /* Callback for "not standalone" docs */ + ClientData notstandalonedata; + + Tcl_Obj *elementDeclCommand; /* Script for + +#ifdef USE_TCLXML_STUBS +TCL_EXTRNC CONST char * + TclXML_InitStubs _ANSI_ARGS_((Tcl_Interp *interp, CONST char *version, int exact)); +#endif + +#undef TCL_STORAGE_CLASS +#define TCL_STORAGE_CLASS DLLIMPORT + +#endif /* RC_INVOKED */ +#endif /* __TCLXML_H__ */ diff --git a/include/tclxml/tclxmlDecls.h b/include/tclxml/tclxmlDecls.h new file mode 100644 index 0000000..9576479 --- /dev/null +++ b/include/tclxml/tclxmlDecls.h @@ -0,0 +1,361 @@ +/* + * tclxmlDecls.h -- + * + * Declarations of functions in the platform independent public TCLXML API. + * + */ + +#ifndef _TCLXMLDECLS +#define _TCLXMLDECLS + +/* + * WARNING: The contents of this file is automatically generated by the + * genStubs.tcl script. Any modifications to the function declarations + * below should be made in the tclxml.decls script. + */ + +/* !BEGIN!: Do not edit below this line. */ + +/* + * Exported function declarations: + */ + +/* 0 */ +EXTERN int Tclxml_Init _ANSI_ARGS_((Tcl_Interp * interp)); +/* 1 */ +EXTERN int Tclxml_SafeInit _ANSI_ARGS_((Tcl_Interp * interp)); +/* 2 */ +EXTERN int TclXML_RegisterXMLParser _ANSI_ARGS_(( + Tcl_Interp * interp, + TclXML_ParserClassInfo * parser)); +/* 3 */ +EXTERN int TclXML_RegisterElementStartProc _ANSI_ARGS_(( + Tcl_Interp * interp, TclXML_Info * parser, + ClientData clientData, + TclXML_ElementStartProc * callback)); +/* 4 */ +EXTERN int TclXML_RegisterElementEndProc _ANSI_ARGS_(( + Tcl_Interp * interp, TclXML_Info * parser, + ClientData clientData, + TclXML_ElementEndProc * callback)); +/* 5 */ +EXTERN int TclXML_RegisterCharacterDataProc _ANSI_ARGS_(( + Tcl_Interp * interp, TclXML_Info * parser, + ClientData clientData, + TclXML_CharacterDataProc * callback)); +/* 6 */ +EXTERN int TclXML_RegisterPIProc _ANSI_ARGS_(( + Tcl_Interp * interp, TclXML_Info * parser, + ClientData clientData, + TclXML_PIProc * callback)); +/* 7 */ +EXTERN int TclXML_RegisterDefaultProc _ANSI_ARGS_(( + Tcl_Interp * interp, TclXML_Info * parser, + ClientData clientData, + TclXML_DefaultProc * callback)); +/* 8 */ +EXTERN int TclXML_RegisterUnparsedProc _ANSI_ARGS_(( + Tcl_Interp * interp, TclXML_Info * parser, + ClientData clientData, + TclXML_UnparsedProc * callback)); +/* 9 */ +EXTERN int TclXML_RegisterNotationDeclProc _ANSI_ARGS_(( + Tcl_Interp * interp, TclXML_Info * parser, + ClientData clientData, + TclXML_NotationDeclProc * callback)); +/* 10 */ +EXTERN int TclXML_RegisterEntityProc _ANSI_ARGS_(( + Tcl_Interp * interp, TclXML_Info * parser, + ClientData clientData, + TclXML_EntityProc * callback)); +/* 11 */ +EXTERN int TclXML_RegisterUnknownEncodingProc _ANSI_ARGS_(( + Tcl_Interp * interp, TclXML_Info * parser, + ClientData clientData, + TclXML_UnknownEncodingProc * callback)); +/* 12 */ +EXTERN int TclXML_RegisterCommentProc _ANSI_ARGS_(( + Tcl_Interp * interp, TclXML_Info * parser, + ClientData clientData, + TclXML_CommentProc * callback)); +/* 13 */ +EXTERN int TclXML_RegisterNotStandaloneProc _ANSI_ARGS_(( + Tcl_Interp * interp, TclXML_Info * parser, + ClientData clientData, + TclXML_NotStandaloneProc * callback)); +/* 14 */ +EXTERN int TclXML_RegisterElementDeclProc _ANSI_ARGS_(( + Tcl_Interp * interp, TclXML_Info * parser, + ClientData clientData, + TclXML_ElementDeclProc * callback)); +/* 15 */ +EXTERN int TclXML_RegisterAttListDeclProc _ANSI_ARGS_(( + Tcl_Interp * interp, TclXML_Info * parser, + ClientData clientData, + TclXML_AttlistDeclProc * callback)); +/* 16 */ +EXTERN int TclXML_RegisterStartDoctypeDeclProc _ANSI_ARGS_(( + Tcl_Interp * interp, TclXML_Info * parser, + ClientData clientData, + TclXML_StartDoctypeDeclProc * callback)); +/* 17 */ +EXTERN int TclXML_RegisterEndDoctypeDeclProc _ANSI_ARGS_(( + Tcl_Interp * interp, TclXML_Info * parser, + ClientData clientData, + TclXML_EndDoctypeDeclProc * callback)); +/* 18 */ +EXTERN void TclXML_ElementStartHandler _ANSI_ARGS_(( + void * userdata, Tcl_Obj * name, + Tcl_Obj * nsuri, Tcl_Obj * atts, + Tcl_Obj * nsDeclsObj)); +/* 19 */ +EXTERN void TclXML_ElementEndHandler _ANSI_ARGS_(( + void * userData, Tcl_Obj * name)); +/* 20 */ +EXTERN void TclXML_CharacterDataHandler _ANSI_ARGS_(( + void * userData, Tcl_Obj * s)); +/* 21 */ +EXTERN void TclXML_ProcessingInstructionHandler _ANSI_ARGS_(( + void * userData, Tcl_Obj * target, + Tcl_Obj * data)); +/* 22 */ +EXTERN int TclXML_ExternalEntityRefHandler _ANSI_ARGS_(( + ClientData clientData, + Tcl_Obj * openEntityNames, Tcl_Obj * base, + Tcl_Obj * systemId, Tcl_Obj * publicId)); +/* 23 */ +EXTERN void TclXML_DefaultHandler _ANSI_ARGS_((void * userData, + Tcl_Obj * s)); +/* 24 */ +EXTERN void TclXML_UnparsedDeclHandler _ANSI_ARGS_(( + void * userData, Tcl_Obj * entityname, + Tcl_Obj * base, Tcl_Obj * systemId, + Tcl_Obj * publicId, Tcl_Obj * notationName)); +/* 25 */ +EXTERN void TclXML_NotationDeclHandler _ANSI_ARGS_(( + void * userData, Tcl_Obj * notationName, + Tcl_Obj * base, Tcl_Obj * systemId, + Tcl_Obj * publicId)); +/* 26 */ +EXTERN int TclXML_UnknownEncodingHandler _ANSI_ARGS_(( + void * encodingHandlerData, Tcl_Obj * name, + void * info)); +/* 27 */ +EXTERN void TclXML_CommentHandler _ANSI_ARGS_((void * userData, + Tcl_Obj * data)); +/* 28 */ +EXTERN int TclXML_NotStandaloneHandler _ANSI_ARGS_(( + void * userData)); +/* Slot 29 is reserved */ +/* Slot 30 is reserved */ +/* 31 */ +EXTERN void TclXML_ElementDeclHandler _ANSI_ARGS_(( + void * userData, Tcl_Obj * name, + Tcl_Obj * contentspec)); +/* 32 */ +EXTERN void TclXML_AttlistDeclHandler _ANSI_ARGS_(( + void * userData, Tcl_Obj * name, + Tcl_Obj * attributes)); +/* 33 */ +EXTERN void TclXML_StartDoctypeDeclHandler _ANSI_ARGS_(( + void * userData, Tcl_Obj * name)); +/* 34 */ +EXTERN void TclXML_EndDoctypeDeclHandler _ANSI_ARGS_(( + void * userData)); + +typedef struct TclxmlStubs { + int magic; + struct TclxmlStubHooks *hooks; + + int (*tclxml_Init) _ANSI_ARGS_((Tcl_Interp * interp)); /* 0 */ + int (*tclxml_SafeInit) _ANSI_ARGS_((Tcl_Interp * interp)); /* 1 */ + int (*tclXML_RegisterXMLParser) _ANSI_ARGS_((Tcl_Interp * interp, TclXML_ParserClassInfo * parser)); /* 2 */ + int (*tclXML_RegisterElementStartProc) _ANSI_ARGS_((Tcl_Interp * interp, TclXML_Info * parser, ClientData clientData, TclXML_ElementStartProc * callback)); /* 3 */ + int (*tclXML_RegisterElementEndProc) _ANSI_ARGS_((Tcl_Interp * interp, TclXML_Info * parser, ClientData clientData, TclXML_ElementEndProc * callback)); /* 4 */ + int (*tclXML_RegisterCharacterDataProc) _ANSI_ARGS_((Tcl_Interp * interp, TclXML_Info * parser, ClientData clientData, TclXML_CharacterDataProc * callback)); /* 5 */ + int (*tclXML_RegisterPIProc) _ANSI_ARGS_((Tcl_Interp * interp, TclXML_Info * parser, ClientData clientData, TclXML_PIProc * callback)); /* 6 */ + int (*tclXML_RegisterDefaultProc) _ANSI_ARGS_((Tcl_Interp * interp, TclXML_Info * parser, ClientData clientData, TclXML_DefaultProc * callback)); /* 7 */ + int (*tclXML_RegisterUnparsedProc) _ANSI_ARGS_((Tcl_Interp * interp, TclXML_Info * parser, ClientData clientData, TclXML_UnparsedProc * callback)); /* 8 */ + int (*tclXML_RegisterNotationDeclProc) _ANSI_ARGS_((Tcl_Interp * interp, TclXML_Info * parser, ClientData clientData, TclXML_NotationDeclProc * callback)); /* 9 */ + int (*tclXML_RegisterEntityProc) _ANSI_ARGS_((Tcl_Interp * interp, TclXML_Info * parser, ClientData clientData, TclXML_EntityProc * callback)); /* 10 */ + int (*tclXML_RegisterUnknownEncodingProc) _ANSI_ARGS_((Tcl_Interp * interp, TclXML_Info * parser, ClientData clientData, TclXML_UnknownEncodingProc * callback)); /* 11 */ + int (*tclXML_RegisterCommentProc) _ANSI_ARGS_((Tcl_Interp * interp, TclXML_Info * parser, ClientData clientData, TclXML_CommentProc * callback)); /* 12 */ + int (*tclXML_RegisterNotStandaloneProc) _ANSI_ARGS_((Tcl_Interp * interp, TclXML_Info * parser, ClientData clientData, TclXML_NotStandaloneProc * callback)); /* 13 */ + int (*tclXML_RegisterElementDeclProc) _ANSI_ARGS_((Tcl_Interp * interp, TclXML_Info * parser, ClientData clientData, TclXML_ElementDeclProc * callback)); /* 14 */ + int (*tclXML_RegisterAttListDeclProc) _ANSI_ARGS_((Tcl_Interp * interp, TclXML_Info * parser, ClientData clientData, TclXML_AttlistDeclProc * callback)); /* 15 */ + int (*tclXML_RegisterStartDoctypeDeclProc) _ANSI_ARGS_((Tcl_Interp * interp, TclXML_Info * parser, ClientData clientData, TclXML_StartDoctypeDeclProc * callback)); /* 16 */ + int (*tclXML_RegisterEndDoctypeDeclProc) _ANSI_ARGS_((Tcl_Interp * interp, TclXML_Info * parser, ClientData clientData, TclXML_EndDoctypeDeclProc * callback)); /* 17 */ + void (*tclXML_ElementStartHandler) _ANSI_ARGS_((void * userdata, Tcl_Obj * name, Tcl_Obj * nsuri, Tcl_Obj * atts, Tcl_Obj * nsDeclsObj)); /* 18 */ + void (*tclXML_ElementEndHandler) _ANSI_ARGS_((void * userData, Tcl_Obj * name)); /* 19 */ + void (*tclXML_CharacterDataHandler) _ANSI_ARGS_((void * userData, Tcl_Obj * s)); /* 20 */ + void (*tclXML_ProcessingInstructionHandler) _ANSI_ARGS_((void * userData, Tcl_Obj * target, Tcl_Obj * data)); /* 21 */ + int (*tclXML_ExternalEntityRefHandler) _ANSI_ARGS_((ClientData clientData, Tcl_Obj * openEntityNames, Tcl_Obj * base, Tcl_Obj * systemId, Tcl_Obj * publicId)); /* 22 */ + void (*tclXML_DefaultHandler) _ANSI_ARGS_((void * userData, Tcl_Obj * s)); /* 23 */ + void (*tclXML_UnparsedDeclHandler) _ANSI_ARGS_((void * userData, Tcl_Obj * entityname, Tcl_Obj * base, Tcl_Obj * systemId, Tcl_Obj * publicId, Tcl_Obj * notationName)); /* 24 */ + void (*tclXML_NotationDeclHandler) _ANSI_ARGS_((void * userData, Tcl_Obj * notationName, Tcl_Obj * base, Tcl_Obj * systemId, Tcl_Obj * publicId)); /* 25 */ + int (*tclXML_UnknownEncodingHandler) _ANSI_ARGS_((void * encodingHandlerData, Tcl_Obj * name, void * info)); /* 26 */ + void (*tclXML_CommentHandler) _ANSI_ARGS_((void * userData, Tcl_Obj * data)); /* 27 */ + int (*tclXML_NotStandaloneHandler) _ANSI_ARGS_((void * userData)); /* 28 */ + void *reserved29; + void *reserved30; + void (*tclXML_ElementDeclHandler) _ANSI_ARGS_((void * userData, Tcl_Obj * name, Tcl_Obj * contentspec)); /* 31 */ + void (*tclXML_AttlistDeclHandler) _ANSI_ARGS_((void * userData, Tcl_Obj * name, Tcl_Obj * attributes)); /* 32 */ + void (*tclXML_StartDoctypeDeclHandler) _ANSI_ARGS_((void * userData, Tcl_Obj * name)); /* 33 */ + void (*tclXML_EndDoctypeDeclHandler) _ANSI_ARGS_((void * userData)); /* 34 */ +} TclxmlStubs; + +#ifdef __cplusplus +extern "C" { +#endif +extern TclxmlStubs *tclxmlStubsPtr; +#ifdef __cplusplus +} +#endif + +#if defined(USE_TCLXML_STUBS) && !defined(USE_TCLXML_STUB_PROCS) + +/* + * Inline function declarations: + */ + +#ifndef Tclxml_Init +#define Tclxml_Init \ + (tclxmlStubsPtr->tclxml_Init) /* 0 */ +#endif +#ifndef Tclxml_SafeInit +#define Tclxml_SafeInit \ + (tclxmlStubsPtr->tclxml_SafeInit) /* 1 */ +#endif +#ifndef TclXML_RegisterXMLParser +#define TclXML_RegisterXMLParser \ + (tclxmlStubsPtr->tclXML_RegisterXMLParser) /* 2 */ +#endif +#ifndef TclXML_RegisterElementStartProc +#define TclXML_RegisterElementStartProc \ + (tclxmlStubsPtr->tclXML_RegisterElementStartProc) /* 3 */ +#endif +#ifndef TclXML_RegisterElementEndProc +#define TclXML_RegisterElementEndProc \ + (tclxmlStubsPtr->tclXML_RegisterElementEndProc) /* 4 */ +#endif +#ifndef TclXML_RegisterCharacterDataProc +#define TclXML_RegisterCharacterDataProc \ + (tclxmlStubsPtr->tclXML_RegisterCharacterDataProc) /* 5 */ +#endif +#ifndef TclXML_RegisterPIProc +#define TclXML_RegisterPIProc \ + (tclxmlStubsPtr->tclXML_RegisterPIProc) /* 6 */ +#endif +#ifndef TclXML_RegisterDefaultProc +#define TclXML_RegisterDefaultProc \ + (tclxmlStubsPtr->tclXML_RegisterDefaultProc) /* 7 */ +#endif +#ifndef TclXML_RegisterUnparsedProc +#define TclXML_RegisterUnparsedProc \ + (tclxmlStubsPtr->tclXML_RegisterUnparsedProc) /* 8 */ +#endif +#ifndef TclXML_RegisterNotationDeclProc +#define TclXML_RegisterNotationDeclProc \ + (tclxmlStubsPtr->tclXML_RegisterNotationDeclProc) /* 9 */ +#endif +#ifndef TclXML_RegisterEntityProc +#define TclXML_RegisterEntityProc \ + (tclxmlStubsPtr->tclXML_RegisterEntityProc) /* 10 */ +#endif +#ifndef TclXML_RegisterUnknownEncodingProc +#define TclXML_RegisterUnknownEncodingProc \ + (tclxmlStubsPtr->tclXML_RegisterUnknownEncodingProc) /* 11 */ +#endif +#ifndef TclXML_RegisterCommentProc +#define TclXML_RegisterCommentProc \ + (tclxmlStubsPtr->tclXML_RegisterCommentProc) /* 12 */ +#endif +#ifndef TclXML_RegisterNotStandaloneProc +#define TclXML_RegisterNotStandaloneProc \ + (tclxmlStubsPtr->tclXML_RegisterNotStandaloneProc) /* 13 */ +#endif +#ifndef TclXML_RegisterElementDeclProc +#define TclXML_RegisterElementDeclProc \ + (tclxmlStubsPtr->tclXML_RegisterElementDeclProc) /* 14 */ +#endif +#ifndef TclXML_RegisterAttListDeclProc +#define TclXML_RegisterAttListDeclProc \ + (tclxmlStubsPtr->tclXML_RegisterAttListDeclProc) /* 15 */ +#endif +#ifndef TclXML_RegisterStartDoctypeDeclProc +#define TclXML_RegisterStartDoctypeDeclProc \ + (tclxmlStubsPtr->tclXML_RegisterStartDoctypeDeclProc) /* 16 */ +#endif +#ifndef TclXML_RegisterEndDoctypeDeclProc +#define TclXML_RegisterEndDoctypeDeclProc \ + (tclxmlStubsPtr->tclXML_RegisterEndDoctypeDeclProc) /* 17 */ +#endif +#ifndef TclXML_ElementStartHandler +#define TclXML_ElementStartHandler \ + (tclxmlStubsPtr->tclXML_ElementStartHandler) /* 18 */ +#endif +#ifndef TclXML_ElementEndHandler +#define TclXML_ElementEndHandler \ + (tclxmlStubsPtr->tclXML_ElementEndHandler) /* 19 */ +#endif +#ifndef TclXML_CharacterDataHandler +#define TclXML_CharacterDataHandler \ + (tclxmlStubsPtr->tclXML_CharacterDataHandler) /* 20 */ +#endif +#ifndef TclXML_ProcessingInstructionHandler +#define TclXML_ProcessingInstructionHandler \ + (tclxmlStubsPtr->tclXML_ProcessingInstructionHandler) /* 21 */ +#endif +#ifndef TclXML_ExternalEntityRefHandler +#define TclXML_ExternalEntityRefHandler \ + (tclxmlStubsPtr->tclXML_ExternalEntityRefHandler) /* 22 */ +#endif +#ifndef TclXML_DefaultHandler +#define TclXML_DefaultHandler \ + (tclxmlStubsPtr->tclXML_DefaultHandler) /* 23 */ +#endif +#ifndef TclXML_UnparsedDeclHandler +#define TclXML_UnparsedDeclHandler \ + (tclxmlStubsPtr->tclXML_UnparsedDeclHandler) /* 24 */ +#endif +#ifndef TclXML_NotationDeclHandler +#define TclXML_NotationDeclHandler \ + (tclxmlStubsPtr->tclXML_NotationDeclHandler) /* 25 */ +#endif +#ifndef TclXML_UnknownEncodingHandler +#define TclXML_UnknownEncodingHandler \ + (tclxmlStubsPtr->tclXML_UnknownEncodingHandler) /* 26 */ +#endif +#ifndef TclXML_CommentHandler +#define TclXML_CommentHandler \ + (tclxmlStubsPtr->tclXML_CommentHandler) /* 27 */ +#endif +#ifndef TclXML_NotStandaloneHandler +#define TclXML_NotStandaloneHandler \ + (tclxmlStubsPtr->tclXML_NotStandaloneHandler) /* 28 */ +#endif +/* Slot 29 is reserved */ +/* Slot 30 is reserved */ +#ifndef TclXML_ElementDeclHandler +#define TclXML_ElementDeclHandler \ + (tclxmlStubsPtr->tclXML_ElementDeclHandler) /* 31 */ +#endif +#ifndef TclXML_AttlistDeclHandler +#define TclXML_AttlistDeclHandler \ + (tclxmlStubsPtr->tclXML_AttlistDeclHandler) /* 32 */ +#endif +#ifndef TclXML_StartDoctypeDeclHandler +#define TclXML_StartDoctypeDeclHandler \ + (tclxmlStubsPtr->tclXML_StartDoctypeDeclHandler) /* 33 */ +#endif +#ifndef TclXML_EndDoctypeDeclHandler +#define TclXML_EndDoctypeDeclHandler \ + (tclxmlStubsPtr->tclXML_EndDoctypeDeclHandler) /* 34 */ +#endif + +#endif /* defined(USE_TCLXML_STUBS) && !defined(USE_TCLXML_STUB_PROCS) */ + +/* !END!: Do not edit above this line. */ + +#endif /* _TCLXMLDECLS */ + diff --git a/include/tclxslt/tclxslt.h b/include/tclxslt/tclxslt.h new file mode 100644 index 0000000..428b375 --- /dev/null +++ b/include/tclxslt/tclxslt.h @@ -0,0 +1,98 @@ +/* tclxslt.h -- + * + * Public interfaces to TclXSLT package. + * + * Copyright (c) 2005-2007 Explain + * http://www.explain.com.au/ + * Copyright (c) 2001-2004 Zveno Pty Ltd + * http://www.zveno.com/ + * + * See the file "LICENSE" for information on usage and + * redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * $Id: tclxslt.h,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $ + */ + +#ifndef __TCLXSLT_H__ +#define __TCLXSLT_H__ + +#ifdef TCLXML_BUILD_AS_FRAMEWORK +#include +#else +#include +#endif /* TCLXML_BUILD_AS_FRAMEWORK */ + +#include +#include +#include +#include +#include +#include +#include +#include +#include + +/* + * For C++ compilers, use extern "C" + */ + +#ifdef __cplusplus +extern "C" { +#endif + +/* + * These macros are used to control whether functions are being declared for + * import or export in Windows, + * They map to no-op declarations on non-Windows systems. + * Assumes that tcl.h defines DLLEXPORT & DLLIMPORT correctly. + * The default build on windows is for a DLL, which causes the DLLIMPORT + * and DLLEXPORT macros to be nonempty. To build a static library, the + * macro STATIC_BUILD should be defined before the inclusion of tcl.h + * + * If a function is being declared while it is being built + * to be included in a shared library, then it should have the DLLEXPORT + * storage class. If is being declared for use by a module that is going to + * link against the shared library, then it should have the DLLIMPORT storage + * class. If the symbol is beind declared for a static build or for use from a + * stub library, then the storage class should be empty. + * + * The convention is that a macro called BUILD_xxxx, where xxxx is the + * name of a library we are building, is set on the compile line for sources + * that are to be placed in the library. When this macro is set, the + * storage class will be set to DLLEXPORT. At the end of the header file, the + * storage class will be reset to DLLIMPORt. + */ + +#undef TCL_STORAGE_CLASS +#ifdef BUILD_Tclxslt +# define TCL_STORAGE_CLASS DLLEXPORT +#else +# ifdef USE_TCL_STUBS +# define TCL_STORAGE_CLASS +# else +# define TCL_STORAGE_CLASS DLLIMPORT +# endif +#endif + +/* + * Declarations for externally visible functions. + */ + +EXTERN int Tclxslt_libxslt_Init _ANSI_ARGS_((Tcl_Interp *interp)); +EXTERN int Tclxslt_libxslt_SafeInit _ANSI_ARGS_((Tcl_Interp *interp)); + +/* + * Class creation command for XSLT compiled stylesheet objects. + */ + +EXTERN Tcl_ObjCmdProc TclXSLTCompileStylesheet; + + +#undef TCL_STORAGE_CLASS +#define TCL_STORAGE_CLASS DLLIMPORT + +#ifdef __cplusplus +} +#endif + +#endif /* __TCLXSLT_H__ */ diff --git a/macosx/Info-expat__Upgraded_.plist b/macosx/Info-expat__Upgraded_.plist new file mode 100644 index 0000000..9386ade --- /dev/null +++ b/macosx/Info-expat__Upgraded_.plist @@ -0,0 +1,28 @@ + + + + + CFBundleDevelopmentRegion + English + CFBundleExecutable + + CFBundleGetInfoString + TclXML/expat v3.0 + CFBundleIconFile + + CFBundleIdentifier + com.zveno.tclxml.expat + CFBundleInfoDictionaryVersion + 6.0 + CFBundleName + TclXML expat + CFBundlePackageType + FMWK + CFBundleShortVersionString + 3.0 + CFBundleSignature + ???? + CFBundleVersion + 3.0 + + diff --git a/macosx/Info-tclxml__Upgraded_.plist b/macosx/Info-tclxml__Upgraded_.plist new file mode 100644 index 0000000..7dd63da --- /dev/null +++ b/macosx/Info-tclxml__Upgraded_.plist @@ -0,0 +1,28 @@ + + + + + CFBundleDevelopmentRegion + English + CFBundleExecutable + + CFBundleGetInfoString + TclXML v3.0 + CFBundleIconFile + + CFBundleIdentifier + com.zveno.tclxml + CFBundleInfoDictionaryVersion + 6.0 + CFBundleName + TclXML + CFBundlePackageType + FMWK + CFBundleShortVersionString + 3.0 + CFBundleSignature + ???? + CFBundleVersion + 3.1 + + diff --git a/macosx/Info-tclxml_libxml2__Upgraded_.plist b/macosx/Info-tclxml_libxml2__Upgraded_.plist new file mode 100644 index 0000000..13c2c80 --- /dev/null +++ b/macosx/Info-tclxml_libxml2__Upgraded_.plist @@ -0,0 +1,28 @@ + + + + + CFBundleDevelopmentRegion + English + CFBundleExecutable + tclxml-libxml2 + CFBundleGetInfoString + TclXML/libxml2 v3.0 + CFBundleIconFile + + CFBundleIdentifier + com.zveno.tclxml.libxml2 + CFBundleInfoDictionaryVersion + 6.0 + CFBundleName + TclXML libxml2 + CFBundlePackageType + FMWK + CFBundleShortVersionString + v3.0 + CFBundleSignature + ???? + CFBundleVersion + 3.0 + + diff --git a/macosx/Tclxml-Info.plist b/macosx/Tclxml-Info.plist new file mode 100644 index 0000000..936aec4 --- /dev/null +++ b/macosx/Tclxml-Info.plist @@ -0,0 +1,20 @@ + + + + + CFBundleDevelopmentRegion + English + CFBundleExecutable + ${EXECUTABLE_NAME} + CFBundleIdentifier + net.sourceforge.tclxml + CFBundleInfoDictionaryVersion + 6.0 + CFBundlePackageType + FMWK + CFBundleSignature + ???? + CFBundleVersion + ${PACKAGE_VERSION} + + diff --git a/macosx/Tclxml.xcodeproj/project.pbxproj b/macosx/Tclxml.xcodeproj/project.pbxproj new file mode 100644 index 0000000..05a5efe --- /dev/null +++ b/macosx/Tclxml.xcodeproj/project.pbxproj @@ -0,0 +1,675 @@ +// !$*UTF8*$! +{ + archiveVersion = 1; + classes = { + }; + objectVersion = 42; + objects = { + +/* Begin PBXAggregateTarget section */ + AA68C6640C90EA8700D12438 /* configure */ = { + isa = PBXAggregateTarget; + buildConfigurationList = AA68C6670C90EAB000D12438 /* Build configuration list for PBXAggregateTarget "configure" */; + buildPhases = ( + AA68C6630C90EA8700D12438 /* ShellScript */, + ); + dependencies = ( + ); + name = configure; + productName = configure; + }; +/* End PBXAggregateTarget section */ + +/* Begin PBXBuildFile section */ + AA13408D0CACF8FA006C8E84 /* pkgIndex.tcl in Resources */ = {isa = PBXBuildFile; fileRef = AA13408C0CACF8FA006C8E84 /* pkgIndex.tcl */; }; + AA1340B30CB49786006C8E84 /* tclxslt.tcl in Resources */ = {isa = PBXBuildFile; fileRef = AA1340B20CB49786006C8E84 /* tclxslt.tcl */; }; + AA68C5CA0C90302900D12438 /* libxml.framework in Frameworks */ = {isa = PBXBuildFile; fileRef = AA68C5C90C90302900D12438 /* libxml.framework */; }; + AA68C5CD0C90304400D12438 /* libxslt.framework in Frameworks */ = {isa = PBXBuildFile; fileRef = AA68C5CC0C90304400D12438 /* libxslt.framework */; }; + AA68C5D00C90305E00D12438 /* libexslt.framework in Frameworks */ = {isa = PBXBuildFile; fileRef = AA68C5CF0C90305E00D12438 /* libexslt.framework */; }; + AA68C5D30C9031C400D12438 /* tclxml.c in Sources */ = {isa = PBXBuildFile; fileRef = AA68C5D20C9031C400D12438 /* tclxml.c */; }; + AA68C5D50C9031EA00D12438 /* tclxml.h in Headers */ = {isa = PBXBuildFile; fileRef = AA68C5D40C9031EA00D12438 /* tclxml.h */; settings = {ATTRIBUTES = (Public, ); }; }; + AA68C5E60C9032E400D12438 /* sgml-8.0.tcl in Resources */ = {isa = PBXBuildFile; fileRef = AA68C5DC0C9032E400D12438 /* sgml-8.0.tcl */; }; + AA68C5E70C9032E400D12438 /* sgml-8.1.tcl in Resources */ = {isa = PBXBuildFile; fileRef = AA68C5DD0C9032E400D12438 /* sgml-8.1.tcl */; }; + AA68C5E80C9032E400D12438 /* sgmlparser.tcl in Resources */ = {isa = PBXBuildFile; fileRef = AA68C5DE0C9032E400D12438 /* sgmlparser.tcl */; }; + AA68C5E90C9032E400D12438 /* tclparser-8.0.tcl in Resources */ = {isa = PBXBuildFile; fileRef = AA68C5DF0C9032E400D12438 /* tclparser-8.0.tcl */; }; + AA68C5EA0C9032E400D12438 /* tclparser-8.1.tcl in Resources */ = {isa = PBXBuildFile; fileRef = AA68C5E00C9032E400D12438 /* tclparser-8.1.tcl */; }; + AA68C5EB0C9032E400D12438 /* xml__tcl.tcl in Resources */ = {isa = PBXBuildFile; fileRef = AA68C5E10C9032E400D12438 /* xml__tcl.tcl */; }; + AA68C5EC0C9032E400D12438 /* xml-8.0.tcl in Resources */ = {isa = PBXBuildFile; fileRef = AA68C5E20C9032E400D12438 /* xml-8.0.tcl */; }; + AA68C5ED0C9032E400D12438 /* xml-8.1.tcl in Resources */ = {isa = PBXBuildFile; fileRef = AA68C5E30C9032E400D12438 /* xml-8.1.tcl */; }; + AA68C5EE0C9032E400D12438 /* xmldep.tcl in Resources */ = {isa = PBXBuildFile; fileRef = AA68C5E40C9032E400D12438 /* xmldep.tcl */; }; + AA68C5EF0C9032E400D12438 /* xpath.tcl in Resources */ = {isa = PBXBuildFile; fileRef = AA68C5E50C9032E400D12438 /* xpath.tcl */; }; + AA68C5F10C90331D00D12438 /* tclxml-libxml2.c in Sources */ = {isa = PBXBuildFile; fileRef = AA68C5F00C90331D00D12438 /* tclxml-libxml2.c */; }; + AA68C5F30C90332A00D12438 /* docObj.c in Sources */ = {isa = PBXBuildFile; fileRef = AA68C5F20C90332A00D12438 /* docObj.c */; }; + AA68C5F50C90333E00D12438 /* docObj.h in Headers */ = {isa = PBXBuildFile; fileRef = AA68C5F40C90333E00D12438 /* docObj.h */; settings = {ATTRIBUTES = (Public, ); }; }; + AA68C5F70C90334D00D12438 /* tclxml-libxml2.h in Headers */ = {isa = PBXBuildFile; fileRef = AA68C5F60C90334D00D12438 /* tclxml-libxml2.h */; settings = {ATTRIBUTES = (Public, ); }; }; + AA68C5F90C90336200D12438 /* tcldom.h in Headers */ = {isa = PBXBuildFile; fileRef = AA68C5F80C90336200D12438 /* tcldom.h */; settings = {ATTRIBUTES = (Public, ); }; }; + AA68C5FB0C90337C00D12438 /* tcldom-libxml2.c in Sources */ = {isa = PBXBuildFile; fileRef = AA68C5FA0C90337C00D12438 /* tcldom-libxml2.c */; }; + AA68C5FD0C90338B00D12438 /* nodeObj.c in Sources */ = {isa = PBXBuildFile; fileRef = AA68C5FC0C90338B00D12438 /* nodeObj.c */; }; + AA68C6000C90339C00D12438 /* nodeObj.h in Headers */ = {isa = PBXBuildFile; fileRef = AA68C5FE0C90339C00D12438 /* nodeObj.h */; settings = {ATTRIBUTES = (Public, ); }; }; + AA68C6010C90339C00D12438 /* tcldom-libxml2.h in Headers */ = {isa = PBXBuildFile; fileRef = AA68C5FF0C90339C00D12438 /* tcldom-libxml2.h */; settings = {ATTRIBUTES = (Public, ); }; }; + AA68C6030C9033AC00D12438 /* tcldom-libxml2.tcl in Resources */ = {isa = PBXBuildFile; fileRef = AA68C6020C9033AC00D12438 /* tcldom-libxml2.tcl */; }; + AA68C6050C9033C900D12438 /* tclxslt.h in Headers */ = {isa = PBXBuildFile; fileRef = AA68C6040C9033C900D12438 /* tclxslt.h */; settings = {ATTRIBUTES = (Public, ); }; }; + AA68C6070C9033E300D12438 /* tclxslt-libxslt.c in Sources */ = {isa = PBXBuildFile; fileRef = AA68C6060C9033E300D12438 /* tclxslt-libxslt.c */; }; + AA68C6090C9033F300D12438 /* tclxslt-libxslt.tcl in Resources */ = {isa = PBXBuildFile; fileRef = AA68C6080C9033F300D12438 /* tclxslt-libxslt.tcl */; }; + AA68C60E0C90340D00D12438 /* process.tcl in Resources */ = {isa = PBXBuildFile; fileRef = AA68C60A0C90340D00D12438 /* process.tcl */; }; + AA68C60F0C90340D00D12438 /* resources.tcl in Resources */ = {isa = PBXBuildFile; fileRef = AA68C60B0C90340D00D12438 /* resources.tcl */; }; + AA68C6100C90340D00D12438 /* utilities.tcl in Resources */ = {isa = PBXBuildFile; fileRef = AA68C60C0C90340D00D12438 /* utilities.tcl */; }; + AA68C6110C90340D00D12438 /* xsltcache.tcl in Resources */ = {isa = PBXBuildFile; fileRef = AA68C60D0C90340D00D12438 /* xsltcache.tcl */; }; + AA68C6F60C91035400D12438 /* Tclxml-Info.plist in Resources */ = {isa = PBXBuildFile; fileRef = AA68C6F50C91035400D12438 /* Tclxml-Info.plist */; }; + AAE9DF4E0DBFE1EB00A29434 /* Tcl.framework in Frameworks */ = {isa = PBXBuildFile; fileRef = AAE9DF4D0DBFE1EB00A29434 /* Tcl.framework */; }; +/* End PBXBuildFile section */ + +/* Begin PBXContainerItemProxy section */ + AA68C6650C90EA9200D12438 /* PBXContainerItemProxy */ = { + isa = PBXContainerItemProxy; + containerPortal = 0867D690FE84028FC02AAC07 /* Project object */; + proxyType = 1; + remoteGlobalIDString = AA68C6640C90EA8700D12438; + remoteInfo = configure; + }; +/* End PBXContainerItemProxy section */ + +/* Begin PBXFileReference section */ + 8DC2EF5B0486A6940098B216 /* Tclxml.framework */ = {isa = PBXFileReference; explicitFileType = wrapper.framework; includeInIndex = 0; path = Tclxml.framework; sourceTree = BUILT_PRODUCTS_DIR; }; + AA13408C0CACF8FA006C8E84 /* pkgIndex.tcl */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = text; name = pkgIndex.tcl; path = ../pkgIndex.tcl; sourceTree = SOURCE_ROOT; }; + AA1340B20CB49786006C8E84 /* tclxslt.tcl */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = text; name = tclxslt.tcl; path = ../tclxslt/tclxslt.tcl; sourceTree = SOURCE_ROOT; }; + AA68C5C90C90302900D12438 /* libxml.framework */ = {isa = PBXFileReference; lastKnownFileType = wrapper.framework; name = libxml.framework; path = ../Release/libxml.framework; sourceTree = BUILT_PRODUCTS_DIR; }; + AA68C5CC0C90304400D12438 /* libxslt.framework */ = {isa = PBXFileReference; lastKnownFileType = wrapper.framework; name = libxslt.framework; path = ../Release/libxslt.framework; sourceTree = BUILT_PRODUCTS_DIR; }; + AA68C5CF0C90305E00D12438 /* libexslt.framework */ = {isa = PBXFileReference; lastKnownFileType = wrapper.framework; name = libexslt.framework; path = ../Release/libexslt.framework; sourceTree = BUILT_PRODUCTS_DIR; }; + AA68C5D20C9031C400D12438 /* tclxml.c */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.c; name = tclxml.c; path = ../tclxml.c; sourceTree = SOURCE_ROOT; }; + AA68C5D40C9031EA00D12438 /* tclxml.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; name = tclxml.h; path = ../include/tclxml/tclxml.h; sourceTree = SOURCE_ROOT; }; + AA68C5DC0C9032E400D12438 /* sgml-8.0.tcl */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = text; name = "sgml-8.0.tcl"; path = "../tclxml-tcl/sgml-8.0.tcl"; sourceTree = SOURCE_ROOT; }; + AA68C5DD0C9032E400D12438 /* sgml-8.1.tcl */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = text; name = "sgml-8.1.tcl"; path = "../tclxml-tcl/sgml-8.1.tcl"; sourceTree = SOURCE_ROOT; }; + AA68C5DE0C9032E400D12438 /* sgmlparser.tcl */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = text; name = sgmlparser.tcl; path = "../tclxml-tcl/sgmlparser.tcl"; sourceTree = SOURCE_ROOT; }; + AA68C5DF0C9032E400D12438 /* tclparser-8.0.tcl */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = text; name = "tclparser-8.0.tcl"; path = "../tclxml-tcl/tclparser-8.0.tcl"; sourceTree = SOURCE_ROOT; }; + AA68C5E00C9032E400D12438 /* tclparser-8.1.tcl */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = text; name = "tclparser-8.1.tcl"; path = "../tclxml-tcl/tclparser-8.1.tcl"; sourceTree = SOURCE_ROOT; }; + AA68C5E10C9032E400D12438 /* xml__tcl.tcl */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = text; name = xml__tcl.tcl; path = "../tclxml-tcl/xml__tcl.tcl"; sourceTree = SOURCE_ROOT; }; + AA68C5E20C9032E400D12438 /* xml-8.0.tcl */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = text; name = "xml-8.0.tcl"; path = "../tclxml-tcl/xml-8.0.tcl"; sourceTree = SOURCE_ROOT; }; + AA68C5E30C9032E400D12438 /* xml-8.1.tcl */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = text; name = "xml-8.1.tcl"; path = "../tclxml-tcl/xml-8.1.tcl"; sourceTree = SOURCE_ROOT; }; + AA68C5E40C9032E400D12438 /* xmldep.tcl */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = text; name = xmldep.tcl; path = "../tclxml-tcl/xmldep.tcl"; sourceTree = SOURCE_ROOT; }; + AA68C5E50C9032E400D12438 /* xpath.tcl */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = text; name = xpath.tcl; path = "../tclxml-tcl/xpath.tcl"; sourceTree = SOURCE_ROOT; }; + AA68C5F00C90331D00D12438 /* tclxml-libxml2.c */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.c; name = "tclxml-libxml2.c"; path = "../tclxml-libxml2.c"; sourceTree = SOURCE_ROOT; }; + AA68C5F20C90332A00D12438 /* docObj.c */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.c; name = docObj.c; path = ../docObj.c; sourceTree = SOURCE_ROOT; }; + AA68C5F40C90333E00D12438 /* docObj.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; name = docObj.h; path = "../include/tclxml-libxml2/docObj.h"; sourceTree = SOURCE_ROOT; }; + AA68C5F60C90334D00D12438 /* tclxml-libxml2.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; name = "tclxml-libxml2.h"; path = "../include/tclxml-libxml2/tclxml-libxml2.h"; sourceTree = SOURCE_ROOT; }; + AA68C5F80C90336200D12438 /* tcldom.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; name = tcldom.h; path = ../include/tcldom/tcldom.h; sourceTree = SOURCE_ROOT; }; + AA68C5FA0C90337C00D12438 /* tcldom-libxml2.c */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.c; name = "tcldom-libxml2.c"; path = "../tcldom-libxml2.c"; sourceTree = SOURCE_ROOT; }; + AA68C5FC0C90338B00D12438 /* nodeObj.c */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.c; name = nodeObj.c; path = ../nodeObj.c; sourceTree = SOURCE_ROOT; }; + AA68C5FE0C90339C00D12438 /* nodeObj.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; name = nodeObj.h; path = "../include/tcldom-libxml2/nodeObj.h"; sourceTree = SOURCE_ROOT; }; + AA68C5FF0C90339C00D12438 /* tcldom-libxml2.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; name = "tcldom-libxml2.h"; path = "../include/tcldom-libxml2/tcldom-libxml2.h"; sourceTree = SOURCE_ROOT; }; + AA68C6020C9033AC00D12438 /* tcldom-libxml2.tcl */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = text; name = "tcldom-libxml2.tcl"; path = "../tcldom-libxml2.tcl"; sourceTree = SOURCE_ROOT; }; + AA68C6040C9033C900D12438 /* tclxslt.h */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.h; name = tclxslt.h; path = ../include/tclxslt/tclxslt.h; sourceTree = SOURCE_ROOT; }; + AA68C6060C9033E300D12438 /* tclxslt-libxslt.c */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = sourcecode.c.c; name = "tclxslt-libxslt.c"; path = "../tclxslt-libxslt.c"; sourceTree = SOURCE_ROOT; }; + AA68C6080C9033F300D12438 /* tclxslt-libxslt.tcl */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = text; name = "tclxslt-libxslt.tcl"; path = "../tclxslt-libxslt.tcl"; sourceTree = SOURCE_ROOT; }; + AA68C60A0C90340D00D12438 /* process.tcl */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = text; name = process.tcl; path = ../tclxslt/process.tcl; sourceTree = SOURCE_ROOT; }; + AA68C60B0C90340D00D12438 /* resources.tcl */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = text; name = resources.tcl; path = ../tclxslt/resources.tcl; sourceTree = SOURCE_ROOT; }; + AA68C60C0C90340D00D12438 /* utilities.tcl */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = text; name = utilities.tcl; path = ../tclxslt/utilities.tcl; sourceTree = SOURCE_ROOT; }; + AA68C60D0C90340D00D12438 /* xsltcache.tcl */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = text; name = xsltcache.tcl; path = ../tclxslt/xsltcache.tcl; sourceTree = SOURCE_ROOT; }; + AA68C6F50C91035400D12438 /* Tclxml-Info.plist */ = {isa = PBXFileReference; fileEncoding = 30; lastKnownFileType = text.xml; path = "Tclxml-Info.plist"; sourceTree = SOURCE_ROOT; }; + AAE9DF4D0DBFE1EB00A29434 /* Tcl.framework */ = {isa = PBXFileReference; lastKnownFileType = wrapper.framework; name = Tcl.framework; path = ../../../Library/Frameworks/Tcl.framework; sourceTree = SOURCE_ROOT; }; +/* End PBXFileReference section */ + +/* Begin PBXFrameworksBuildPhase section */ + 8DC2EF560486A6940098B216 /* Frameworks */ = { + isa = PBXFrameworksBuildPhase; + buildActionMask = 2147483647; + files = ( + AA68C5CA0C90302900D12438 /* libxml.framework in Frameworks */, + AA68C5CD0C90304400D12438 /* libxslt.framework in Frameworks */, + AA68C5D00C90305E00D12438 /* libexslt.framework in Frameworks */, + AAE9DF4E0DBFE1EB00A29434 /* Tcl.framework in Frameworks */, + ); + runOnlyForDeploymentPostprocessing = 0; + }; +/* End PBXFrameworksBuildPhase section */ + +/* Begin PBXGroup section */ + 034768DFFF38A50411DB9C8B /* Products */ = { + isa = PBXGroup; + children = ( + AA68C6F50C91035400D12438 /* Tclxml-Info.plist */, + 8DC2EF5B0486A6940098B216 /* Tclxml.framework */, + ); + name = Products; + sourceTree = ""; + }; + 0867D691FE84028FC02AAC07 /* Tclxml */ = { + isa = PBXGroup; + children = ( + AA68C57F0C902A1700D12438 /* TclXML */, + AA68C58B0C902A4800D12438 /* TclXML-tcl */, + AA68C5880C902A3C00D12438 /* TclXML-libxml2 */, + AA68C5820C902A2000D12438 /* TclDOM */, + AA68C58E0C902A5500D12438 /* TclDOM-libxml2 */, + AA68C5850C902A2700D12438 /* TclXSLT */, + AA68C5920C902A6C00D12438 /* TclXSLT-libxslt */, + 0867D69AFE84028FC02AAC07 /* External Frameworks and Libraries */, + 034768DFFF38A50411DB9C8B /* Products */, + ); + name = Tclxml; + sourceTree = ""; + }; + 0867D69AFE84028FC02AAC07 /* External Frameworks and Libraries */ = { + isa = PBXGroup; + children = ( + 1058C7B0FEA5585E11CA2CBB /* Linked Frameworks */, + ); + name = "External Frameworks and Libraries"; + sourceTree = ""; + }; + 1058C7B0FEA5585E11CA2CBB /* Linked Frameworks */ = { + isa = PBXGroup; + children = ( + AAE9DF4D0DBFE1EB00A29434 /* Tcl.framework */, + AA68C5CF0C90305E00D12438 /* libexslt.framework */, + AA68C5CC0C90304400D12438 /* libxslt.framework */, + AA68C5C90C90302900D12438 /* libxml.framework */, + ); + name = "Linked Frameworks"; + sourceTree = ""; + }; + AA68C57F0C902A1700D12438 /* TclXML */ = { + isa = PBXGroup; + children = ( + AA68C5950C902D0A00D12438 /* Sources */, + AA68C5980C902D1300D12438 /* Headers */, + AA68C59B0C902D2D00D12438 /* Scripts */, + ); + name = TclXML; + sourceTree = ""; + }; + AA68C5820C902A2000D12438 /* TclDOM */ = { + isa = PBXGroup; + children = ( + AA68C5B00C902F0200D12438 /* Headers */, + AA68C5AD0C902EF800D12438 /* Scripts */, + ); + name = TclDOM; + sourceTree = ""; + }; + AA68C5850C902A2700D12438 /* TclXSLT */ = { + isa = PBXGroup; + children = ( + AA68C5BF0C902F3600D12438 /* Headers */, + AA68C5BC0C902F2D00D12438 /* Scripts */, + ); + name = TclXSLT; + sourceTree = ""; + }; + AA68C5880C902A3C00D12438 /* TclXML-libxml2 */ = { + isa = PBXGroup; + children = ( + AA68C5A70C902D8C00D12438 /* Sources */, + AA68C5A40C902D8400D12438 /* Headers */, + AA68C5A10C902D7D00D12438 /* Scripts */, + ); + name = "TclXML-libxml2"; + sourceTree = ""; + }; + AA68C58B0C902A4800D12438 /* TclXML-tcl */ = { + isa = PBXGroup; + children = ( + AA68C59E0C902D3800D12438 /* Scripts */, + ); + name = "TclXML-tcl"; + sourceTree = ""; + }; + AA68C58E0C902A5500D12438 /* TclDOM-libxml2 */ = { + isa = PBXGroup; + children = ( + AA68C5B90C902F1D00D12438 /* Sources */, + AA68C5B60C902F1500D12438 /* Headers */, + AA68C5B30C902F0E00D12438 /* Scripts */, + ); + name = "TclDOM-libxml2"; + sourceTree = ""; + }; + AA68C5920C902A6C00D12438 /* TclXSLT-libxslt */ = { + isa = PBXGroup; + children = ( + AA68C5C80C902F5400D12438 /* Sources */, + AA68C5C50C902F4900D12438 /* Headers */, + AA68C5C20C902F4100D12438 /* Scripts */, + ); + name = "TclXSLT-libxslt"; + sourceTree = ""; + }; + AA68C5950C902D0A00D12438 /* Sources */ = { + isa = PBXGroup; + children = ( + AA68C5D20C9031C400D12438 /* tclxml.c */, + ); + name = Sources; + sourceTree = ""; + }; + AA68C5980C902D1300D12438 /* Headers */ = { + isa = PBXGroup; + children = ( + AA68C5D40C9031EA00D12438 /* tclxml.h */, + ); + name = Headers; + sourceTree = ""; + }; + AA68C59B0C902D2D00D12438 /* Scripts */ = { + isa = PBXGroup; + children = ( + AA13408C0CACF8FA006C8E84 /* pkgIndex.tcl */, + ); + name = Scripts; + sourceTree = ""; + }; + AA68C59E0C902D3800D12438 /* Scripts */ = { + isa = PBXGroup; + children = ( + AA68C5DC0C9032E400D12438 /* sgml-8.0.tcl */, + AA68C5DD0C9032E400D12438 /* sgml-8.1.tcl */, + AA68C5DE0C9032E400D12438 /* sgmlparser.tcl */, + AA68C5DF0C9032E400D12438 /* tclparser-8.0.tcl */, + AA68C5E00C9032E400D12438 /* tclparser-8.1.tcl */, + AA68C5E10C9032E400D12438 /* xml__tcl.tcl */, + AA68C5E20C9032E400D12438 /* xml-8.0.tcl */, + AA68C5E30C9032E400D12438 /* xml-8.1.tcl */, + AA68C5E40C9032E400D12438 /* xmldep.tcl */, + AA68C5E50C9032E400D12438 /* xpath.tcl */, + ); + name = Scripts; + sourceTree = ""; + }; + AA68C5A10C902D7D00D12438 /* Scripts */ = { + isa = PBXGroup; + children = ( + ); + name = Scripts; + sourceTree = ""; + }; + AA68C5A40C902D8400D12438 /* Headers */ = { + isa = PBXGroup; + children = ( + AA68C5F60C90334D00D12438 /* tclxml-libxml2.h */, + AA68C5F40C90333E00D12438 /* docObj.h */, + ); + name = Headers; + sourceTree = ""; + }; + AA68C5A70C902D8C00D12438 /* Sources */ = { + isa = PBXGroup; + children = ( + AA68C5F20C90332A00D12438 /* docObj.c */, + AA68C5F00C90331D00D12438 /* tclxml-libxml2.c */, + ); + name = Sources; + sourceTree = ""; + }; + AA68C5AD0C902EF800D12438 /* Scripts */ = { + isa = PBXGroup; + children = ( + ); + name = Scripts; + sourceTree = ""; + }; + AA68C5B00C902F0200D12438 /* Headers */ = { + isa = PBXGroup; + children = ( + AA68C5F80C90336200D12438 /* tcldom.h */, + ); + name = Headers; + sourceTree = ""; + }; + AA68C5B30C902F0E00D12438 /* Scripts */ = { + isa = PBXGroup; + children = ( + AA68C6020C9033AC00D12438 /* tcldom-libxml2.tcl */, + ); + name = Scripts; + sourceTree = ""; + }; + AA68C5B60C902F1500D12438 /* Headers */ = { + isa = PBXGroup; + children = ( + AA68C5FE0C90339C00D12438 /* nodeObj.h */, + AA68C5FF0C90339C00D12438 /* tcldom-libxml2.h */, + ); + name = Headers; + sourceTree = ""; + }; + AA68C5B90C902F1D00D12438 /* Sources */ = { + isa = PBXGroup; + children = ( + AA68C5FC0C90338B00D12438 /* nodeObj.c */, + AA68C5FA0C90337C00D12438 /* tcldom-libxml2.c */, + ); + name = Sources; + sourceTree = ""; + }; + AA68C5BC0C902F2D00D12438 /* Scripts */ = { + isa = PBXGroup; + children = ( + AA1340B20CB49786006C8E84 /* tclxslt.tcl */, + AA68C60A0C90340D00D12438 /* process.tcl */, + AA68C60B0C90340D00D12438 /* resources.tcl */, + AA68C60C0C90340D00D12438 /* utilities.tcl */, + AA68C60D0C90340D00D12438 /* xsltcache.tcl */, + ); + name = Scripts; + sourceTree = ""; + }; + AA68C5BF0C902F3600D12438 /* Headers */ = { + isa = PBXGroup; + children = ( + AA68C6040C9033C900D12438 /* tclxslt.h */, + ); + name = Headers; + sourceTree = ""; + }; + AA68C5C20C902F4100D12438 /* Scripts */ = { + isa = PBXGroup; + children = ( + AA68C6080C9033F300D12438 /* tclxslt-libxslt.tcl */, + ); + name = Scripts; + sourceTree = ""; + }; + AA68C5C50C902F4900D12438 /* Headers */ = { + isa = PBXGroup; + children = ( + ); + name = Headers; + sourceTree = ""; + }; + AA68C5C80C902F5400D12438 /* Sources */ = { + isa = PBXGroup; + children = ( + AA68C6060C9033E300D12438 /* tclxslt-libxslt.c */, + ); + name = Sources; + sourceTree = ""; + }; +/* End PBXGroup section */ + +/* Begin PBXHeadersBuildPhase section */ + 8DC2EF500486A6940098B216 /* Headers */ = { + isa = PBXHeadersBuildPhase; + buildActionMask = 2147483647; + files = ( + AA68C5D50C9031EA00D12438 /* tclxml.h in Headers */, + AA68C5F50C90333E00D12438 /* docObj.h in Headers */, + AA68C5F70C90334D00D12438 /* tclxml-libxml2.h in Headers */, + AA68C5F90C90336200D12438 /* tcldom.h in Headers */, + AA68C6000C90339C00D12438 /* nodeObj.h in Headers */, + AA68C6010C90339C00D12438 /* tcldom-libxml2.h in Headers */, + AA68C6050C9033C900D12438 /* tclxslt.h in Headers */, + ); + runOnlyForDeploymentPostprocessing = 0; + }; +/* End PBXHeadersBuildPhase section */ + +/* Begin PBXNativeTarget section */ + 8DC2EF4F0486A6940098B216 /* Tclxml */ = { + isa = PBXNativeTarget; + buildConfigurationList = 1DEB91AD08733DA50010E9CD /* Build configuration list for PBXNativeTarget "Tclxml" */; + buildPhases = ( + 8DC2EF500486A6940098B216 /* Headers */, + 8DC2EF520486A6940098B216 /* Resources */, + 8DC2EF540486A6940098B216 /* Sources */, + 8DC2EF560486A6940098B216 /* Frameworks */, + AA1340960CAE527B006C8E84 /* ShellScript */, + ); + buildRules = ( + ); + dependencies = ( + AA68C6660C90EA9200D12438 /* PBXTargetDependency */, + ); + name = Tclxml; + productInstallPath = "$(HOME)/Library/Frameworks"; + productName = Tclxml; + productReference = 8DC2EF5B0486A6940098B216 /* Tclxml.framework */; + productType = "com.apple.product-type.framework"; + }; +/* End PBXNativeTarget section */ + +/* Begin PBXProject section */ + 0867D690FE84028FC02AAC07 /* Project object */ = { + isa = PBXProject; + buildConfigurationList = 1DEB91B108733DA50010E9CD /* Build configuration list for PBXProject "Tclxml" */; + compatibilityVersion = "Xcode 2.4"; + hasScannedForEncodings = 1; + mainGroup = 0867D691FE84028FC02AAC07 /* Tclxml */; + productRefGroup = 034768DFFF38A50411DB9C8B /* Products */; + projectDirPath = ""; + projectRoot = ""; + targets = ( + AA68C6640C90EA8700D12438 /* configure */, + 8DC2EF4F0486A6940098B216 /* Tclxml */, + ); + }; +/* End PBXProject section */ + +/* Begin PBXResourcesBuildPhase section */ + 8DC2EF520486A6940098B216 /* Resources */ = { + isa = PBXResourcesBuildPhase; + buildActionMask = 2147483647; + files = ( + AA68C5E60C9032E400D12438 /* sgml-8.0.tcl in Resources */, + AA68C5E70C9032E400D12438 /* sgml-8.1.tcl in Resources */, + AA68C5E80C9032E400D12438 /* sgmlparser.tcl in Resources */, + AA68C5E90C9032E400D12438 /* tclparser-8.0.tcl in Resources */, + AA68C5EA0C9032E400D12438 /* tclparser-8.1.tcl in Resources */, + AA68C5EB0C9032E400D12438 /* xml__tcl.tcl in Resources */, + AA68C5EC0C9032E400D12438 /* xml-8.0.tcl in Resources */, + AA68C5ED0C9032E400D12438 /* xml-8.1.tcl in Resources */, + AA68C5EE0C9032E400D12438 /* xmldep.tcl in Resources */, + AA68C5EF0C9032E400D12438 /* xpath.tcl in Resources */, + AA68C6030C9033AC00D12438 /* tcldom-libxml2.tcl in Resources */, + AA68C6090C9033F300D12438 /* tclxslt-libxslt.tcl in Resources */, + AA68C60E0C90340D00D12438 /* process.tcl in Resources */, + AA68C60F0C90340D00D12438 /* resources.tcl in Resources */, + AA68C6100C90340D00D12438 /* utilities.tcl in Resources */, + AA68C6110C90340D00D12438 /* xsltcache.tcl in Resources */, + AA68C6F60C91035400D12438 /* Tclxml-Info.plist in Resources */, + AA13408D0CACF8FA006C8E84 /* pkgIndex.tcl in Resources */, + AA1340B30CB49786006C8E84 /* tclxslt.tcl in Resources */, + ); + runOnlyForDeploymentPostprocessing = 0; + }; +/* End PBXResourcesBuildPhase section */ + +/* Begin PBXShellScriptBuildPhase section */ + AA1340960CAE527B006C8E84 /* ShellScript */ = { + isa = PBXShellScriptBuildPhase; + buildActionMask = 2147483647; + files = ( + ); + inputPaths = ( + ); + outputPaths = ( + ); + runOnlyForDeploymentPostprocessing = 0; + shellPath = /bin/sh; + shellScript = "mkdir -p ${TARGET_BUILD_DIR}/${CONTENTS_FOLDER_PATH}/Resources/Scripts\nmv ${TARGET_BUILD_DIR}/${CONTENTS_FOLDER_PATH}/Resources/*.tcl ${TARGET_BUILD_DIR}/${CONTENTS_FOLDER_PATH}/Resources/Scripts\n"; + }; + AA68C6630C90EA8700D12438 /* ShellScript */ = { + isa = PBXShellScriptBuildPhase; + buildActionMask = 2147483647; + files = ( + ); + inputPaths = ( + ); + outputPaths = ( + ); + runOnlyForDeploymentPostprocessing = 0; + shellPath = /bin/sh; + shellScript = "cd ${SRCROOT}/..; ./configure --with-xml2-config=${BUILD_DIR}/libxml.framework/Resources/Scripts/xml2-config --with-xslt-config=${BUILD_DIR}/libxslt.framework/Resources/Scripts/xslt-config --enable-framework"; + }; +/* End PBXShellScriptBuildPhase section */ + +/* Begin PBXSourcesBuildPhase section */ + 8DC2EF540486A6940098B216 /* Sources */ = { + isa = PBXSourcesBuildPhase; + buildActionMask = 2147483647; + files = ( + AA68C5D30C9031C400D12438 /* tclxml.c in Sources */, + AA68C5F10C90331D00D12438 /* tclxml-libxml2.c in Sources */, + AA68C5F30C90332A00D12438 /* docObj.c in Sources */, + AA68C5FB0C90337C00D12438 /* tcldom-libxml2.c in Sources */, + AA68C5FD0C90338B00D12438 /* nodeObj.c in Sources */, + AA68C6070C9033E300D12438 /* tclxslt-libxslt.c in Sources */, + ); + runOnlyForDeploymentPostprocessing = 0; + }; +/* End PBXSourcesBuildPhase section */ + +/* Begin PBXTargetDependency section */ + AA68C6660C90EA9200D12438 /* PBXTargetDependency */ = { + isa = PBXTargetDependency; + target = AA68C6640C90EA8700D12438 /* configure */; + targetProxy = AA68C6650C90EA9200D12438 /* PBXContainerItemProxy */; + }; +/* End PBXTargetDependency section */ + +/* Begin XCBuildConfiguration section */ + 1DEB91AE08733DA50010E9CD /* Debug */ = { + isa = XCBuildConfiguration; + buildSettings = { + COPY_PHASE_STRIP = NO; + DEPLOYMENT_POSTPROCESSING = YES; + DYLIB_COMPATIBILITY_VERSION = 1; + DYLIB_CURRENT_VERSION = 1; + FRAMEWORK_SEARCH_PATHS = ( + "$(inherited)", + "$(FRAMEWORK_SEARCH_PATHS_QUOTED_FOR_TARGET_1)", + ); + FRAMEWORK_SEARCH_PATHS_QUOTED_FOR_TARGET_1 = "\"$(SRCROOT)/../../../Library/Frameworks\""; + FRAMEWORK_VERSION = 3.2; + GCC_DYNAMIC_NO_PIC = NO; + GCC_ENABLE_FIX_AND_CONTINUE = YES; + GCC_MODEL_TUNING = G5; + GCC_OPTIMIZATION_LEVEL = 0; + GCC_PRECOMPILE_PREFIX_HEADER = NO; + GCC_PREFIX_HEADER = ""; + HEADER_SEARCH_PATHS = "$(SRCROOT)/../include"; + INFOPLIST_FILE = "Tclxml-Info.plist"; + INSTALL_PATH = "$(LOCAL_LIBRARY_DIR)/Frameworks"; + LIBXML2_VERSION = 2.6.30; + LIBXSLT_VERSION = 1.1.22; + PACKAGE_VERSION = 3.2; + PRECOMPS_INCLUDE_HEADERS_FROM_BUILT_PRODUCTS_DIR = NO; + PRODUCT_NAME = Tclxml; + WRAPPER_EXTENSION = framework; + ZERO_LINK = YES; + }; + name = Debug; + }; + 1DEB91AF08733DA50010E9CD /* Release */ = { + isa = XCBuildConfiguration; + buildSettings = { + ARCHS = i386; + DEPLOYMENT_POSTPROCESSING = YES; + DYLIB_COMPATIBILITY_VERSION = 1; + DYLIB_CURRENT_VERSION = 1; + FRAMEWORK_SEARCH_PATHS = ( + "$(inherited)", + "$(FRAMEWORK_SEARCH_PATHS_QUOTED_FOR_TARGET_1)", + ); + FRAMEWORK_SEARCH_PATHS_QUOTED_FOR_TARGET_1 = "\"$(SRCROOT)/../../../Library/Frameworks\""; + FRAMEWORK_VERSION = 3.2; + GCC_GENERATE_DEBUGGING_SYMBOLS = NO; + GCC_MODEL_TUNING = G5; + GCC_PRECOMPILE_PREFIX_HEADER = NO; + GCC_PREFIX_HEADER = ""; + HEADER_SEARCH_PATHS = "$(SRCROOT)/../include"; + INFOPLIST_FILE = "Tclxml-Info.plist"; + INSTALL_PATH = "$(LOCAL_LIBRARY_DIR)/Frameworks"; + LIBXML2_VERSION = 2.6.30; + LIBXSLT_VERSION = 1.1.22; + PACKAGE_VERSION = 3.2; + PRECOMPS_INCLUDE_HEADERS_FROM_BUILT_PRODUCTS_DIR = NO; + PRODUCT_NAME = Tclxml; + WRAPPER_EXTENSION = framework; + }; + name = Release; + }; + 1DEB91B208733DA50010E9CD /* Debug */ = { + isa = XCBuildConfiguration; + buildSettings = { + ARCHS = ( + ppc, + i386, + ); + FRAMEWORK_VERSION = 3.2; + GCC_WARN_ABOUT_RETURN_TYPE = YES; + GCC_WARN_UNUSED_VARIABLE = YES; + PREBINDING = NO; + SDKROOT = /Developer/SDKs/MacOSX10.4u.sdk; + }; + name = Debug; + }; + 1DEB91B308733DA50010E9CD /* Release */ = { + isa = XCBuildConfiguration; + buildSettings = { + ARCHS = i386; + DEPLOYMENT_POSTPROCESSING = YES; + FRAMEWORK_VERSION = 3.2; + GCC_WARN_ABOUT_RETURN_TYPE = YES; + GCC_WARN_UNUSED_VARIABLE = YES; + INSTALL_PATH = "$(LOCAL_LIBRARY_DIR)/Frameworks"; + PREBINDING = NO; + SDKROOT = /Developer/SDKs/MacOSX10.4u.sdk; + }; + name = Release; + }; + AA68C6680C90EAB000D12438 /* Debug */ = { + isa = XCBuildConfiguration; + buildSettings = { + COPY_PHASE_STRIP = NO; + GCC_DYNAMIC_NO_PIC = NO; + GCC_GENERATE_DEBUGGING_SYMBOLS = YES; + GCC_OPTIMIZATION_LEVEL = 0; + PRODUCT_NAME = configure; + }; + name = Debug; + }; + AA68C6690C90EAB000D12438 /* Release */ = { + isa = XCBuildConfiguration; + buildSettings = { + COPY_PHASE_STRIP = YES; + GCC_ENABLE_FIX_AND_CONTINUE = NO; + GCC_GENERATE_DEBUGGING_SYMBOLS = NO; + PRODUCT_NAME = configure; + ZERO_LINK = NO; + }; + name = Release; + }; +/* End XCBuildConfiguration section */ + +/* Begin XCConfigurationList section */ + 1DEB91AD08733DA50010E9CD /* Build configuration list for PBXNativeTarget "Tclxml" */ = { + isa = XCConfigurationList; + buildConfigurations = ( + 1DEB91AE08733DA50010E9CD /* Debug */, + 1DEB91AF08733DA50010E9CD /* Release */, + ); + defaultConfigurationIsVisible = 0; + defaultConfigurationName = Release; + }; + 1DEB91B108733DA50010E9CD /* Build configuration list for PBXProject "Tclxml" */ = { + isa = XCConfigurationList; + buildConfigurations = ( + 1DEB91B208733DA50010E9CD /* Debug */, + 1DEB91B308733DA50010E9CD /* Release */, + ); + defaultConfigurationIsVisible = 0; + defaultConfigurationName = Release; + }; + AA68C6670C90EAB000D12438 /* Build configuration list for PBXAggregateTarget "configure" */ = { + isa = XCConfigurationList; + buildConfigurations = ( + AA68C6680C90EAB000D12438 /* Debug */, + AA68C6690C90EAB000D12438 /* Release */, + ); + defaultConfigurationIsVisible = 0; + defaultConfigurationName = Release; + }; +/* End XCConfigurationList section */ + }; + rootObject = 0867D690FE84028FC02AAC07 /* Project object */; +} diff --git a/macosx/Tclxml.xcodeproj/steve.mode1 b/macosx/Tclxml.xcodeproj/steve.mode1 new file mode 100644 index 0000000..379535a --- /dev/null +++ b/macosx/Tclxml.xcodeproj/steve.mode1 @@ -0,0 +1,1332 @@ + + + + + ActivePerspectiveName + Project + AllowedModules + + + BundleLoadPath + + MaxInstances + n + Module + PBXSmartGroupTreeModule + Name + Groups and Files Outline View + + + BundleLoadPath + + MaxInstances + n + Module + PBXNavigatorGroup + Name + Editor + + + BundleLoadPath + + MaxInstances + n + Module + XCTaskListModule + Name + Task List + + + BundleLoadPath + + MaxInstances + n + Module + XCDetailModule + Name + File and Smart Group Detail Viewer + + + BundleLoadPath + + MaxInstances + 1 + Module + PBXBuildResultsModule + Name + Detailed Build Results Viewer + + + BundleLoadPath + + MaxInstances + 1 + Module + PBXProjectFindModule + Name + Project Batch Find Tool + + + BundleLoadPath + + MaxInstances + n + Module + PBXRunSessionModule + Name + Run Log + + + BundleLoadPath + + MaxInstances + n + Module + PBXBookmarksModule + Name + Bookmarks Tool + + + BundleLoadPath + + MaxInstances + n + Module + PBXClassBrowserModule + Name + Class Browser + + + BundleLoadPath + + MaxInstances + n + Module + PBXCVSModule + Name + Source Code Control Tool + + + BundleLoadPath + + MaxInstances + n + Module + PBXDebugBreakpointsModule + Name + Debug Breakpoints Tool + + + BundleLoadPath + + MaxInstances + n + Module + XCDockableInspector + Name + Inspector + + + BundleLoadPath + + MaxInstances + n + Module + PBXOpenQuicklyModule + Name + Open Quickly Tool + + + BundleLoadPath + + MaxInstances + 1 + Module + PBXDebugSessionModule + Name + Debugger + + + BundleLoadPath + + MaxInstances + 1 + Module + PBXDebugCLIModule + Name + Debug Console + + + Description + DefaultDescriptionKey + DockingSystemVisible + + Extension + mode1 + FavBarConfig + + PBXProjectModuleGUID + AA68C5AA0C902DA500D12438 + XCBarModuleItemNames + + XCBarModuleItems + + + FirstTimeWindowDisplayed + + Identifier + com.apple.perspectives.project.mode1 + MajorVersion + 31 + MinorVersion + 1 + Name + Default + Notifications + + OpenEditors + + PerspectiveWidths + + -1 + -1 + + Perspectives + + + ChosenToolbarItems + + active-target-popup + action + NSToolbarFlexibleSpaceItem + buildOrClean + build-and-runOrDebug + com.apple.ide.PBXToolbarStopButton + get-info + toggle-editor + NSToolbarFlexibleSpaceItem + com.apple.pbx.toolbar.searchfield + + ControllerClassBaseName + + IconName + WindowOfProjectWithEditor + Identifier + perspective.project + IsVertical + + Layout + + + BecomeActive + + ContentConfiguration + + PBXBottomSmartGroupGIDs + + 1C37FBAC04509CD000000102 + 1C37FAAC04509CD000000102 + 1C08E77C0454961000C914BD + 1C37FABC05509CD000000102 + 1C37FABC05539CD112110102 + E2644B35053B69B200211256 + 1C37FABC04509CD000100104 + 1CC0EA4004350EF90044410B + 1CC0EA4004350EF90041110B + + PBXProjectModuleGUID + 1CE0B1FE06471DED0097A5F4 + PBXProjectModuleLabel + Files + PBXProjectStructureProvided + yes + PBXSmartGroupTreeModuleColumnData + + PBXSmartGroupTreeModuleColumnWidthsKey + + 212 + + PBXSmartGroupTreeModuleColumnsKey_v4 + + MainColumn + + + PBXSmartGroupTreeModuleOutlineStateKey_v7 + + PBXSmartGroupTreeModuleOutlineStateExpansionKey + + 0867D691FE84028FC02AAC07 + 1C37FBAC04509CD000000102 + AAF4A0890CBA19EA00B05FEF + 1C37FABC05509CD000000102 + + PBXSmartGroupTreeModuleOutlineStateSelectionKey + + + 18 + 12 + 10 + + + PBXSmartGroupTreeModuleOutlineStateVisibleRectKey + {{0, 0}, {212, 697}} + + PBXTopSmartGroupGIDs + + XCIncludePerspectivesSwitch + + XCSharingToken + com.apple.Xcode.GFSharingToken + + GeometryConfiguration + + Frame + {{0, 0}, {229, 715}} + GroupTreeTableConfiguration + + MainColumn + 212 + + RubberWindowFrame + 1 66 771 756 0 0 1440 878 + + Module + PBXSmartGroupTreeModule + Proportion + 229pt + + + Dock + + + ContentConfiguration + + PBXProjectModuleGUID + 1CE0B20306471E060097A5F4 + PBXProjectModuleLabel + MyNewFile14.java + PBXSplitModuleInNavigatorKey + + Split0 + + PBXProjectModuleGUID + 1CE0B20406471E060097A5F4 + PBXProjectModuleLabel + MyNewFile14.java + + SplitCount + 1 + + StatusBarVisibility + + + GeometryConfiguration + + Frame + {{0, 0}, {537, 0}} + RubberWindowFrame + 1 66 771 756 0 0 1440 878 + + Module + PBXNavigatorGroup + Proportion + 0pt + + + ContentConfiguration + + PBXProjectModuleGUID + 1CE0B20506471E060097A5F4 + PBXProjectModuleLabel + Detail + + GeometryConfiguration + + Frame + {{0, 5}, {537, 710}} + RubberWindowFrame + 1 66 771 756 0 0 1440 878 + + Module + XCDetailModule + Proportion + 710pt + + + Proportion + 537pt + + + Name + Project + ServiceClasses + + XCModuleDock + PBXSmartGroupTreeModule + XCModuleDock + PBXNavigatorGroup + XCDetailModule + + TableOfContents + + AAF4A08A0CBA1A0600B05FEF + 1CE0B1FE06471DED0097A5F4 + AAF4A08B0CBA1A0600B05FEF + 1CE0B20306471E060097A5F4 + 1CE0B20506471E060097A5F4 + + ToolbarConfiguration + xcode.toolbar.config.default + + + ControllerClassBaseName + + IconName + WindowOfProject + Identifier + perspective.morph + IsVertical + 0 + Layout + + + BecomeActive + 1 + ContentConfiguration + + PBXBottomSmartGroupGIDs + + 1C37FBAC04509CD000000102 + 1C37FAAC04509CD000000102 + 1C08E77C0454961000C914BD + 1C37FABC05509CD000000102 + 1C37FABC05539CD112110102 + E2644B35053B69B200211256 + 1C37FABC04509CD000100104 + 1CC0EA4004350EF90044410B + 1CC0EA4004350EF90041110B + + PBXProjectModuleGUID + 11E0B1FE06471DED0097A5F4 + PBXProjectModuleLabel + Files + PBXProjectStructureProvided + yes + PBXSmartGroupTreeModuleColumnData + + PBXSmartGroupTreeModuleColumnWidthsKey + + 186 + + PBXSmartGroupTreeModuleColumnsKey_v4 + + MainColumn + + + PBXSmartGroupTreeModuleOutlineStateKey_v7 + + PBXSmartGroupTreeModuleOutlineStateExpansionKey + + 29B97314FDCFA39411CA2CEA + 1C37FABC05509CD000000102 + + PBXSmartGroupTreeModuleOutlineStateSelectionKey + + + 0 + + + PBXSmartGroupTreeModuleOutlineStateVisibleRectKey + {{0, 0}, {186, 337}} + + PBXTopSmartGroupGIDs + + XCIncludePerspectivesSwitch + 1 + XCSharingToken + com.apple.Xcode.GFSharingToken + + GeometryConfiguration + + Frame + {{0, 0}, {203, 355}} + GroupTreeTableConfiguration + + MainColumn + 186 + + RubberWindowFrame + 373 269 690 397 0 0 1440 878 + + Module + PBXSmartGroupTreeModule + Proportion + 100% + + + Name + Morph + PreferredWidth + 300 + ServiceClasses + + XCModuleDock + PBXSmartGroupTreeModule + + TableOfContents + + 11E0B1FE06471DED0097A5F4 + + ToolbarConfiguration + xcode.toolbar.config.default.short + + + PerspectivesBarVisible + + ShelfIsVisible + + SourceDescription + file at '/System/Library/PrivateFrameworks/DevToolsInterface.framework/Versions/A/Resources/XCPerspectivesSpecificationMode1.xcperspec' + StatusbarIsVisible + + TimeStamp + 0.0 + ToolbarDisplayMode + 1 + ToolbarIsVisible + + ToolbarSizeMode + 1 + Type + Perspectives + UpdateMessage + The Default Workspace in this version of Xcode now includes support to hide and show the detail view (what has been referred to as the "Metro-Morph" feature). You must discard your current Default Workspace settings and update to the latest Default Workspace in order to gain this feature. Do you wish to update to the latest Workspace defaults for project '%@'? + WindowJustification + 5 + WindowOrderList + + /Users/steve/Projects/tclxml-3.2/macosx/Tclxml.xcodeproj + AA68C7030C9103FD00D12438 + + WindowString + 1 66 771 756 0 0 1440 878 + WindowTools + + + FirstTimeWindowDisplayed + + Identifier + windowTool.build + IsVertical + + Layout + + + Dock + + + ContentConfiguration + + PBXProjectModuleGUID + 1CD0528F0623707200166675 + PBXProjectModuleLabel + + StatusBarVisibility + + + GeometryConfiguration + + Frame + {{0, 0}, {586, 0}} + RubberWindowFrame + 697 202 586 676 0 0 1440 878 + + Module + PBXNavigatorGroup + Proportion + 0pt + + + BecomeActive + + ContentConfiguration + + PBXBuildLogShowsTranscriptDefaultKey + {{0, 102}, {586, 528}} + PBXProjectModuleGUID + XCMainBuildResultsModuleGUID + PBXProjectModuleLabel + Build + XCBuildResultsTrigger_Collapse + 1021 + XCBuildResultsTrigger_Open + 1011 + + GeometryConfiguration + + Frame + {{0, 5}, {586, 630}} + RubberWindowFrame + 697 202 586 676 0 0 1440 878 + + Module + PBXBuildResultsModule + Proportion + 630pt + + + Proportion + 635pt + + + Name + Build Results + ServiceClasses + + PBXBuildResultsModule + + StatusbarIsVisible + + TableOfContents + + AA68C7030C9103FD00D12438 + AAF4A08E0CBA1A8B00B05FEF + 1CD0528F0623707200166675 + XCMainBuildResultsModuleGUID + + ToolbarConfiguration + xcode.toolbar.config.build + WindowString + 697 202 586 676 0 0 1440 878 + WindowToolGUID + AA68C7030C9103FD00D12438 + WindowToolIsVisible + + + + Identifier + windowTool.debugger + Layout + + + Dock + + + ContentConfiguration + + Debugger + + HorizontalSplitView + + _collapsingFrameDimension + 0.0 + _indexOfCollapsedView + 0 + _percentageOfCollapsedView + 0.0 + isCollapsed + yes + sizes + + {{0, 0}, {317, 164}} + {{317, 0}, {377, 164}} + + + VerticalSplitView + + _collapsingFrameDimension + 0.0 + _indexOfCollapsedView + 0 + _percentageOfCollapsedView + 0.0 + isCollapsed + yes + sizes + + {{0, 0}, {694, 164}} + {{0, 164}, {694, 216}} + + + + LauncherConfigVersion + 8 + PBXProjectModuleGUID + 1C162984064C10D400B95A72 + PBXProjectModuleLabel + Debug - GLUTExamples (Underwater) + + GeometryConfiguration + + DebugConsoleDrawerSize + {100, 120} + DebugConsoleVisible + None + DebugConsoleWindowFrame + {{200, 200}, {500, 300}} + DebugSTDIOWindowFrame + {{200, 200}, {500, 300}} + Frame + {{0, 0}, {694, 380}} + RubberWindowFrame + 321 238 694 422 0 0 1440 878 + + Module + PBXDebugSessionModule + Proportion + 100% + + + Proportion + 100% + + + Name + Debugger + ServiceClasses + + PBXDebugSessionModule + + StatusbarIsVisible + 1 + TableOfContents + + 1CD10A99069EF8BA00B06720 + 1C0AD2AB069F1E9B00FABCE6 + 1C162984064C10D400B95A72 + 1C0AD2AC069F1E9B00FABCE6 + + ToolbarConfiguration + xcode.toolbar.config.debug + WindowString + 321 238 694 422 0 0 1440 878 + WindowToolGUID + 1CD10A99069EF8BA00B06720 + WindowToolIsVisible + 0 + + + Identifier + windowTool.find + Layout + + + Dock + + + Dock + + + ContentConfiguration + + PBXProjectModuleGUID + 1CDD528C0622207200134675 + PBXProjectModuleLabel + <No Editor> + PBXSplitModuleInNavigatorKey + + Split0 + + PBXProjectModuleGUID + 1CD0528D0623707200166675 + + SplitCount + 1 + + StatusBarVisibility + 1 + + GeometryConfiguration + + Frame + {{0, 0}, {781, 167}} + RubberWindowFrame + 62 385 781 470 0 0 1440 878 + + Module + PBXNavigatorGroup + Proportion + 781pt + + + Proportion + 50% + + + BecomeActive + 1 + ContentConfiguration + + PBXProjectModuleGUID + 1CD0528E0623707200166675 + PBXProjectModuleLabel + Project Find + + GeometryConfiguration + + Frame + {{8, 0}, {773, 254}} + RubberWindowFrame + 62 385 781 470 0 0 1440 878 + + Module + PBXProjectFindModule + Proportion + 50% + + + Proportion + 428pt + + + Name + Project Find + ServiceClasses + + PBXProjectFindModule + + StatusbarIsVisible + 1 + TableOfContents + + 1C530D57069F1CE1000CFCEE + 1C530D58069F1CE1000CFCEE + 1C530D59069F1CE1000CFCEE + 1CDD528C0622207200134675 + 1C530D5A069F1CE1000CFCEE + 1CE0B1FE06471DED0097A5F4 + 1CD0528E0623707200166675 + + WindowString + 62 385 781 470 0 0 1440 878 + WindowToolGUID + 1C530D57069F1CE1000CFCEE + WindowToolIsVisible + 0 + + + Identifier + MENUSEPARATOR + + + Identifier + windowTool.debuggerConsole + Layout + + + Dock + + + BecomeActive + 1 + ContentConfiguration + + PBXProjectModuleGUID + 1C78EAAC065D492600B07095 + PBXProjectModuleLabel + Debugger Console + + GeometryConfiguration + + Frame + {{0, 0}, {440, 358}} + RubberWindowFrame + 650 41 440 400 0 0 1280 1002 + + Module + PBXDebugCLIModule + Proportion + 358pt + + + Proportion + 358pt + + + Name + Debugger Console + ServiceClasses + + PBXDebugCLIModule + + StatusbarIsVisible + 1 + TableOfContents + + 1C78EAAD065D492600B07095 + 1C78EAAE065D492600B07095 + 1C78EAAC065D492600B07095 + + WindowString + 650 41 440 400 0 0 1280 1002 + + + Identifier + windowTool.run + Layout + + + Dock + + + ContentConfiguration + + LauncherConfigVersion + 3 + PBXProjectModuleGUID + 1CD0528B0623707200166675 + PBXProjectModuleLabel + Run + Runner + + HorizontalSplitView + + _collapsingFrameDimension + 0.0 + _indexOfCollapsedView + 0 + _percentageOfCollapsedView + 0.0 + isCollapsed + yes + sizes + + {{0, 0}, {493, 167}} + {{0, 176}, {493, 267}} + + + VerticalSplitView + + _collapsingFrameDimension + 0.0 + _indexOfCollapsedView + 0 + _percentageOfCollapsedView + 0.0 + isCollapsed + yes + sizes + + {{0, 0}, {405, 443}} + {{414, 0}, {514, 443}} + + + + + GeometryConfiguration + + Frame + {{0, 0}, {460, 159}} + RubberWindowFrame + 316 696 459 200 0 0 1280 1002 + + Module + PBXRunSessionModule + Proportion + 159pt + + + Proportion + 159pt + + + Name + Run Log + ServiceClasses + + PBXRunSessionModule + + StatusbarIsVisible + 1 + TableOfContents + + 1C0AD2B3069F1EA900FABCE6 + 1C0AD2B4069F1EA900FABCE6 + 1CD0528B0623707200166675 + 1C0AD2B5069F1EA900FABCE6 + + ToolbarConfiguration + xcode.toolbar.config.run + WindowString + 316 696 459 200 0 0 1280 1002 + WindowToolGUID + 1C0AD2B3069F1EA900FABCE6 + WindowToolIsVisible + 0 + + + Identifier + windowTool.scm + Layout + + + Dock + + + ContentConfiguration + + PBXProjectModuleGUID + 1C78EAB2065D492600B07095 + PBXProjectModuleLabel + <No Editor> + PBXSplitModuleInNavigatorKey + + Split0 + + PBXProjectModuleGUID + 1C78EAB3065D492600B07095 + + SplitCount + 1 + + StatusBarVisibility + 1 + + GeometryConfiguration + + Frame + {{0, 0}, {452, 0}} + RubberWindowFrame + 743 379 452 308 0 0 1280 1002 + + Module + PBXNavigatorGroup + Proportion + 0pt + + + BecomeActive + 1 + ContentConfiguration + + PBXProjectModuleGUID + 1CD052920623707200166675 + PBXProjectModuleLabel + SCM + + GeometryConfiguration + + ConsoleFrame + {{0, 259}, {452, 0}} + Frame + {{0, 7}, {452, 259}} + RubberWindowFrame + 743 379 452 308 0 0 1280 1002 + TableConfiguration + + Status + 30 + FileName + 199 + Path + 197.09500122070312 + + TableFrame + {{0, 0}, {452, 250}} + + Module + PBXCVSModule + Proportion + 262pt + + + Proportion + 266pt + + + Name + SCM + ServiceClasses + + PBXCVSModule + + StatusbarIsVisible + 1 + TableOfContents + + 1C78EAB4065D492600B07095 + 1C78EAB5065D492600B07095 + 1C78EAB2065D492600B07095 + 1CD052920623707200166675 + + ToolbarConfiguration + xcode.toolbar.config.scm + WindowString + 743 379 452 308 0 0 1280 1002 + + + Identifier + windowTool.breakpoints + IsVertical + 0 + Layout + + + Dock + + + BecomeActive + 1 + ContentConfiguration + + PBXBottomSmartGroupGIDs + + 1C77FABC04509CD000000102 + + PBXProjectModuleGUID + 1CE0B1FE06471DED0097A5F4 + PBXProjectModuleLabel + Files + PBXProjectStructureProvided + no + PBXSmartGroupTreeModuleColumnData + + PBXSmartGroupTreeModuleColumnWidthsKey + + 168 + + PBXSmartGroupTreeModuleColumnsKey_v4 + + MainColumn + + + PBXSmartGroupTreeModuleOutlineStateKey_v7 + + PBXSmartGroupTreeModuleOutlineStateExpansionKey + + 1C77FABC04509CD000000102 + + PBXSmartGroupTreeModuleOutlineStateSelectionKey + + + 0 + + + PBXSmartGroupTreeModuleOutlineStateVisibleRectKey + {{0, 0}, {168, 350}} + + PBXTopSmartGroupGIDs + + XCIncludePerspectivesSwitch + 0 + + GeometryConfiguration + + Frame + {{0, 0}, {185, 368}} + GroupTreeTableConfiguration + + MainColumn + 168 + + RubberWindowFrame + 315 424 744 409 0 0 1440 878 + + Module + PBXSmartGroupTreeModule + Proportion + 185pt + + + ContentConfiguration + + PBXProjectModuleGUID + 1CA1AED706398EBD00589147 + PBXProjectModuleLabel + Detail + + GeometryConfiguration + + Frame + {{190, 0}, {554, 368}} + RubberWindowFrame + 315 424 744 409 0 0 1440 878 + + Module + XCDetailModule + Proportion + 554pt + + + Proportion + 368pt + + + MajorVersion + 2 + MinorVersion + 0 + Name + Breakpoints + ServiceClasses + + PBXSmartGroupTreeModule + XCDetailModule + + StatusbarIsVisible + 1 + TableOfContents + + 1CDDB66807F98D9800BB5817 + 1CDDB66907F98D9800BB5817 + 1CE0B1FE06471DED0097A5F4 + 1CA1AED706398EBD00589147 + + ToolbarConfiguration + xcode.toolbar.config.breakpoints + WindowString + 315 424 744 409 0 0 1440 878 + WindowToolGUID + 1CDDB66807F98D9800BB5817 + WindowToolIsVisible + 1 + + + Identifier + windowTool.debugAnimator + Layout + + + Dock + + + Module + PBXNavigatorGroup + Proportion + 100% + + + Proportion + 100% + + + Name + Debug Visualizer + ServiceClasses + + PBXNavigatorGroup + + StatusbarIsVisible + 1 + ToolbarConfiguration + xcode.toolbar.config.debugAnimator + WindowString + 100 100 700 500 0 0 1280 1002 + + + Identifier + windowTool.bookmarks + Layout + + + Dock + + + Module + PBXBookmarksModule + Proportion + 100% + + + Proportion + 100% + + + Name + Bookmarks + ServiceClasses + + PBXBookmarksModule + + StatusbarIsVisible + 0 + WindowString + 538 42 401 187 0 0 1280 1002 + + + Identifier + windowTool.classBrowser + Layout + + + Dock + + + BecomeActive + 1 + ContentConfiguration + + OptionsSetName + Hierarchy, all classes + PBXProjectModuleGUID + 1CA6456E063B45B4001379D8 + PBXProjectModuleLabel + Class Browser - NSObject + + GeometryConfiguration + + ClassesFrame + {{0, 0}, {374, 96}} + ClassesTreeTableConfiguration + + PBXClassNameColumnIdentifier + 208 + PBXClassBookColumnIdentifier + 22 + + Frame + {{0, 0}, {630, 331}} + MembersFrame + {{0, 105}, {374, 395}} + MembersTreeTableConfiguration + + PBXMemberTypeIconColumnIdentifier + 22 + PBXMemberNameColumnIdentifier + 216 + PBXMemberTypeColumnIdentifier + 97 + PBXMemberBookColumnIdentifier + 22 + + PBXModuleWindowStatusBarHidden2 + 1 + RubberWindowFrame + 385 179 630 352 0 0 1440 878 + + Module + PBXClassBrowserModule + Proportion + 332pt + + + Proportion + 332pt + + + Name + Class Browser + ServiceClasses + + PBXClassBrowserModule + + StatusbarIsVisible + 0 + TableOfContents + + 1C0AD2AF069F1E9B00FABCE6 + 1C0AD2B0069F1E9B00FABCE6 + 1CA6456E063B45B4001379D8 + + ToolbarConfiguration + xcode.toolbar.config.classbrowser + WindowString + 385 179 630 352 0 0 1440 878 + WindowToolGUID + 1C0AD2AF069F1E9B00FABCE6 + WindowToolIsVisible + 0 + + + + diff --git a/macosx/Tclxml.xcodeproj/steve.mode1v3 b/macosx/Tclxml.xcodeproj/steve.mode1v3 new file mode 100644 index 0000000..1961331 --- /dev/null +++ b/macosx/Tclxml.xcodeproj/steve.mode1v3 @@ -0,0 +1,1376 @@ + + + + + ActivePerspectiveName + Project + AllowedModules + + + BundleLoadPath + + MaxInstances + n + Module + PBXSmartGroupTreeModule + Name + Groups and Files Outline View + + + BundleLoadPath + + MaxInstances + n + Module + PBXNavigatorGroup + Name + Editor + + + BundleLoadPath + + MaxInstances + n + Module + XCTaskListModule + Name + Task List + + + BundleLoadPath + + MaxInstances + n + Module + XCDetailModule + Name + File and Smart Group Detail Viewer + + + BundleLoadPath + + MaxInstances + 1 + Module + PBXBuildResultsModule + Name + Detailed Build Results Viewer + + + BundleLoadPath + + MaxInstances + 1 + Module + PBXProjectFindModule + Name + Project Batch Find Tool + + + BundleLoadPath + + MaxInstances + n + Module + XCProjectFormatConflictsModule + Name + Project Format Conflicts List + + + BundleLoadPath + + MaxInstances + n + Module + PBXBookmarksModule + Name + Bookmarks Tool + + + BundleLoadPath + + MaxInstances + n + Module + PBXClassBrowserModule + Name + Class Browser + + + BundleLoadPath + + MaxInstances + n + Module + PBXCVSModule + Name + Source Code Control Tool + + + BundleLoadPath + + MaxInstances + n + Module + PBXDebugBreakpointsModule + Name + Debug Breakpoints Tool + + + BundleLoadPath + + MaxInstances + n + Module + XCDockableInspector + Name + Inspector + + + BundleLoadPath + + MaxInstances + n + Module + PBXOpenQuicklyModule + Name + Open Quickly Tool + + + BundleLoadPath + + MaxInstances + 1 + Module + PBXDebugSessionModule + Name + Debugger + + + BundleLoadPath + + MaxInstances + 1 + Module + PBXDebugCLIModule + Name + Debug Console + + + BundleLoadPath + + MaxInstances + n + Module + XCSnapshotModule + Name + Snapshots Tool + + + Description + DefaultDescriptionKey + DockingSystemVisible + + Extension + mode1v3 + FavBarConfig + + PBXProjectModuleGUID + AA3A6C2E0DBBE97E0042AA78 + XCBarModuleItemNames + + XCBarModuleItems + + + FirstTimeWindowDisplayed + + Identifier + com.apple.perspectives.project.mode1v3 + MajorVersion + 33 + MinorVersion + 0 + Name + Default + Notifications + + OpenEditors + + PerspectiveWidths + + -1 + -1 + + Perspectives + + + ChosenToolbarItems + + active-target-popup + active-buildstyle-popup + action + NSToolbarFlexibleSpaceItem + buildOrClean + build-and-goOrGo + com.apple.ide.PBXToolbarStopButton + get-info + toggle-editor + NSToolbarFlexibleSpaceItem + com.apple.pbx.toolbar.searchfield + + ControllerClassBaseName + + IconName + WindowOfProjectWithEditor + Identifier + perspective.project + IsVertical + + Layout + + + BecomeActive + + ContentConfiguration + + PBXBottomSmartGroupGIDs + + 1C37FBAC04509CD000000102 + 1C37FAAC04509CD000000102 + 1C08E77C0454961000C914BD + 1C37FABC05509CD000000102 + 1C37FABC05539CD112110102 + E2644B35053B69B200211256 + 1C37FABC04509CD000100104 + 1CC0EA4004350EF90044410B + 1CC0EA4004350EF90041110B + + PBXProjectModuleGUID + 1CE0B1FE06471DED0097A5F4 + PBXProjectModuleLabel + Files + PBXProjectStructureProvided + yes + PBXSmartGroupTreeModuleColumnData + + PBXSmartGroupTreeModuleColumnWidthsKey + + 212 + + PBXSmartGroupTreeModuleColumnsKey_v4 + + MainColumn + + + PBXSmartGroupTreeModuleOutlineStateKey_v7 + + PBXSmartGroupTreeModuleOutlineStateExpansionKey + + 0867D691FE84028FC02AAC07 + 1C37FBAC04509CD000000102 + AAE7C6180EDA71940093ECDD + 1C37FABC05509CD000000102 + + PBXSmartGroupTreeModuleOutlineStateSelectionKey + + + 12 + 11 + 10 + + + PBXSmartGroupTreeModuleOutlineStateVisibleRectKey + {{0, 0}, {212, 697}} + + PBXTopSmartGroupGIDs + + XCIncludePerspectivesSwitch + + XCSharingToken + com.apple.Xcode.GFSharingToken + + GeometryConfiguration + + Frame + {{0, 0}, {229, 715}} + GroupTreeTableConfiguration + + MainColumn + 212 + + RubberWindowFrame + 2 122 771 756 0 0 1440 878 + + Module + PBXSmartGroupTreeModule + Proportion + 229pt + + + Dock + + + ContentConfiguration + + PBXProjectModuleGUID + 1CE0B20306471E060097A5F4 + PBXProjectModuleLabel + MyNewFile14.java + PBXSplitModuleInNavigatorKey + + Split0 + + PBXProjectModuleGUID + 1CE0B20406471E060097A5F4 + PBXProjectModuleLabel + MyNewFile14.java + + SplitCount + 1 + + StatusBarVisibility + + + GeometryConfiguration + + Frame + {{0, 0}, {537, 0}} + RubberWindowFrame + 2 122 771 756 0 0 1440 878 + + Module + PBXNavigatorGroup + Proportion + 0pt + + + ContentConfiguration + + PBXProjectModuleGUID + 1CE0B20506471E060097A5F4 + PBXProjectModuleLabel + Detail + + GeometryConfiguration + + Frame + {{0, 5}, {537, 710}} + RubberWindowFrame + 2 122 771 756 0 0 1440 878 + + Module + XCDetailModule + Proportion + 710pt + + + Proportion + 537pt + + + Name + Project + ServiceClasses + + XCModuleDock + PBXSmartGroupTreeModule + XCModuleDock + PBXNavigatorGroup + XCDetailModule + + TableOfContents + + AAE7C6190EDA71940093ECDD + 1CE0B1FE06471DED0097A5F4 + AAE7C61A0EDA71940093ECDD + 1CE0B20306471E060097A5F4 + 1CE0B20506471E060097A5F4 + + ToolbarConfiguration + xcode.toolbar.config.defaultV3 + + + ControllerClassBaseName + + IconName + WindowOfProject + Identifier + perspective.morph + IsVertical + + Layout + + + BecomeActive + 1 + ContentConfiguration + + PBXBottomSmartGroupGIDs + + 1C37FBAC04509CD000000102 + 1C37FAAC04509CD000000102 + 1C08E77C0454961000C914BD + 1C37FABC05509CD000000102 + 1C37FABC05539CD112110102 + E2644B35053B69B200211256 + 1C37FABC04509CD000100104 + 1CC0EA4004350EF90044410B + 1CC0EA4004350EF90041110B + + PBXProjectModuleGUID + 11E0B1FE06471DED0097A5F4 + PBXProjectModuleLabel + Files + PBXProjectStructureProvided + yes + PBXSmartGroupTreeModuleColumnData + + PBXSmartGroupTreeModuleColumnWidthsKey + + 186 + + PBXSmartGroupTreeModuleColumnsKey_v4 + + MainColumn + + + PBXSmartGroupTreeModuleOutlineStateKey_v7 + + PBXSmartGroupTreeModuleOutlineStateExpansionKey + + 29B97314FDCFA39411CA2CEA + 1C37FABC05509CD000000102 + + PBXSmartGroupTreeModuleOutlineStateSelectionKey + + + 0 + + + PBXSmartGroupTreeModuleOutlineStateVisibleRectKey + {{0, 0}, {186, 337}} + + PBXTopSmartGroupGIDs + + XCIncludePerspectivesSwitch + 1 + XCSharingToken + com.apple.Xcode.GFSharingToken + + GeometryConfiguration + + Frame + {{0, 0}, {203, 355}} + GroupTreeTableConfiguration + + MainColumn + 186 + + RubberWindowFrame + 373 269 690 397 0 0 1440 878 + + Module + PBXSmartGroupTreeModule + Proportion + 100% + + + Name + Morph + PreferredWidth + 300 + ServiceClasses + + XCModuleDock + PBXSmartGroupTreeModule + + TableOfContents + + 11E0B1FE06471DED0097A5F4 + + ToolbarConfiguration + xcode.toolbar.config.default.shortV3 + + + PerspectivesBarVisible + + ShelfIsVisible + + StatusbarIsVisible + + TimeStamp + 0.0 + ToolbarDisplayMode + 1 + ToolbarIsVisible + + ToolbarSizeMode + 1 + Type + Perspectives + UpdateMessage + The Default Workspace in this version of Xcode now includes support to hide and show the detail view (what has been referred to as the "Metro-Morph" feature). You must discard your current Default Workspace settings and update to the latest Default Workspace in order to gain this feature. Do you wish to update to the latest Workspace defaults for project '%@'? + WindowJustification + 5 + WindowOrderList + + AAE9E0620DC0626100A29434 + /Users/steve/Projects/tclxml-3.2/macosx/Tclxml.xcodeproj + + WindowString + 2 122 771 756 0 0 1440 878 + WindowToolsV3 + + + FirstTimeWindowDisplayed + + Identifier + windowTool.build + IsVertical + + Layout + + + Dock + + + ContentConfiguration + + PBXProjectModuleGUID + 1CD0528F0623707200166675 + PBXProjectModuleLabel + + StatusBarVisibility + + + GeometryConfiguration + + Frame + {{0, 0}, {622, 0}} + RubberWindowFrame + 681 139 622 739 0 0 1440 878 + + Module + PBXNavigatorGroup + Proportion + 0pt + + + BecomeActive + + ContentConfiguration + + PBXBuildLogShowsTranscriptDefaultKey + {{0, 127}, {622, 566}} + PBXProjectModuleGUID + XCMainBuildResultsModuleGUID + PBXProjectModuleLabel + Build + XCBuildResultsTrigger_Collapse + 1021 + XCBuildResultsTrigger_Open + 1011 + + GeometryConfiguration + + Frame + {{0, 5}, {622, 693}} + RubberWindowFrame + 681 139 622 739 0 0 1440 878 + + Module + PBXBuildResultsModule + Proportion + 693pt + + + Proportion + 698pt + + + Name + Build Results + ServiceClasses + + PBXBuildResultsModule + + StatusbarIsVisible + + TableOfContents + + AAE9E0620DC0626100A29434 + AAE7C61F0EDA727D0093ECDD + 1CD0528F0623707200166675 + XCMainBuildResultsModuleGUID + + ToolbarConfiguration + xcode.toolbar.config.buildV3 + WindowString + 681 139 622 739 0 0 1440 878 + WindowToolGUID + AAE9E0620DC0626100A29434 + WindowToolIsVisible + + + + FirstTimeWindowDisplayed + + Identifier + windowTool.debugger + Layout + + + Dock + + + ContentConfiguration + + Debugger + + HorizontalSplitView + + _collapsingFrameDimension + 0.0 + _indexOfCollapsedView + 0 + _percentageOfCollapsedView + 0.0 + isCollapsed + yes + sizes + + {{0, 0}, {317, 164}} + {{317, 0}, {377, 164}} + + + VerticalSplitView + + _collapsingFrameDimension + 0.0 + _indexOfCollapsedView + 0 + _percentageOfCollapsedView + 0.0 + isCollapsed + yes + sizes + + {{0, 0}, {694, 164}} + {{0, 164}, {694, 216}} + + + + LauncherConfigVersion + 8 + PBXProjectModuleGUID + 1C162984064C10D400B95A72 + PBXProjectModuleLabel + Debug - GLUTExamples (Underwater) + + GeometryConfiguration + + DebugConsoleDrawerSize + {100, 120} + DebugConsoleVisible + None + DebugConsoleWindowFrame + {{200, 200}, {500, 300}} + DebugSTDIOWindowFrame + {{200, 200}, {500, 300}} + Frame + {{0, 0}, {694, 380}} + RubberWindowFrame + 321 238 694 422 0 0 1440 878 + + Module + PBXDebugSessionModule + Proportion + 100% + + + Proportion + 100% + + + Name + Debugger + ServiceClasses + + PBXDebugSessionModule + + StatusbarIsVisible + + TableOfContents + + 1CD10A99069EF8BA00B06720 + 1C0AD2AB069F1E9B00FABCE6 + 1C162984064C10D400B95A72 + 1C0AD2AC069F1E9B00FABCE6 + + ToolbarConfiguration + xcode.toolbar.config.debugV3 + WindowString + 321 238 694 422 0 0 1440 878 + WindowToolGUID + 1CD10A99069EF8BA00B06720 + WindowToolIsVisible + + + + FirstTimeWindowDisplayed + + Identifier + windowTool.find + Layout + + + Dock + + + Dock + + + ContentConfiguration + + PBXProjectModuleGUID + 1CDD528C0622207200134675 + PBXProjectModuleLabel + <No Editor> + PBXSplitModuleInNavigatorKey + + Split0 + + PBXProjectModuleGUID + 1CD0528D0623707200166675 + + SplitCount + 1 + + StatusBarVisibility + 1 + + GeometryConfiguration + + Frame + {{0, 0}, {781, 167}} + RubberWindowFrame + 62 385 781 470 0 0 1440 878 + + Module + PBXNavigatorGroup + Proportion + 781pt + + + Proportion + 50% + + + BecomeActive + 1 + ContentConfiguration + + PBXProjectModuleGUID + 1CD0528E0623707200166675 + PBXProjectModuleLabel + Project Find + + GeometryConfiguration + + Frame + {{8, 0}, {773, 254}} + RubberWindowFrame + 62 385 781 470 0 0 1440 878 + + Module + PBXProjectFindModule + Proportion + 50% + + + Proportion + 428pt + + + Name + Project Find + ServiceClasses + + PBXProjectFindModule + + StatusbarIsVisible + + TableOfContents + + 1C530D57069F1CE1000CFCEE + 1C530D58069F1CE1000CFCEE + 1C530D59069F1CE1000CFCEE + 1CDD528C0622207200134675 + 1C530D5A069F1CE1000CFCEE + 1CE0B1FE06471DED0097A5F4 + 1CD0528E0623707200166675 + + WindowString + 62 385 781 470 0 0 1440 878 + WindowToolGUID + 1C530D57069F1CE1000CFCEE + WindowToolIsVisible + + + + FirstTimeWindowDisplayed + + Identifier + MENUSEPARATOR + + + FirstTimeWindowDisplayed + + Identifier + windowTool.debuggerConsole + Layout + + + Dock + + + BecomeActive + 1 + ContentConfiguration + + PBXProjectModuleGUID + 1C78EAAC065D492600B07095 + PBXProjectModuleLabel + Debugger Console + + GeometryConfiguration + + Frame + {{0, 0}, {440, 358}} + RubberWindowFrame + 650 41 440 400 0 0 1280 1002 + + Module + PBXDebugCLIModule + Proportion + 358pt + + + Proportion + 358pt + + + Name + Debugger Console + ServiceClasses + + PBXDebugCLIModule + + StatusbarIsVisible + + TableOfContents + + 1C78EAAD065D492600B07095 + 1C78EAAE065D492600B07095 + 1C78EAAC065D492600B07095 + + ToolbarConfiguration + xcode.toolbar.config.consoleV3 + WindowString + 650 41 440 400 0 0 1280 1002 + WindowToolGUID + 1C78EAAD065D492600B07095 + WindowToolIsVisible + + + + Identifier + windowTool.snapshots + Layout + + + Dock + + + Module + XCSnapshotModule + Proportion + 100% + + + Proportion + 100% + + + Name + Snapshots + ServiceClasses + + XCSnapshotModule + + StatusbarIsVisible + Yes + ToolbarConfiguration + xcode.toolbar.config.snapshots + WindowString + 315 824 300 550 0 0 1440 878 + WindowToolIsVisible + Yes + + + FirstTimeWindowDisplayed + + Identifier + windowTool.scm + Layout + + + Dock + + + ContentConfiguration + + PBXProjectModuleGUID + 1C78EAB2065D492600B07095 + PBXProjectModuleLabel + <No Editor> + PBXSplitModuleInNavigatorKey + + Split0 + + PBXProjectModuleGUID + 1C78EAB3065D492600B07095 + + SplitCount + 1 + + StatusBarVisibility + 1 + + GeometryConfiguration + + Frame + {{0, 0}, {452, 0}} + RubberWindowFrame + 743 379 452 308 0 0 1280 1002 + + Module + PBXNavigatorGroup + Proportion + 0pt + + + BecomeActive + 1 + ContentConfiguration + + PBXProjectModuleGUID + 1CD052920623707200166675 + PBXProjectModuleLabel + SCM + + GeometryConfiguration + + ConsoleFrame + {{0, 259}, {452, 0}} + Frame + {{0, 7}, {452, 259}} + RubberWindowFrame + 743 379 452 308 0 0 1280 1002 + TableConfiguration + + Status + 30 + FileName + 199 + Path + 197.09500122070312 + + TableFrame + {{0, 0}, {452, 250}} + + Module + PBXCVSModule + Proportion + 262pt + + + Proportion + 266pt + + + Name + SCM + ServiceClasses + + PBXCVSModule + + StatusbarIsVisible + + TableOfContents + + 1C78EAB4065D492600B07095 + 1C78EAB5065D492600B07095 + 1C78EAB2065D492600B07095 + 1CD052920623707200166675 + + ToolbarConfiguration + xcode.toolbar.config.scm + WindowString + 743 379 452 308 0 0 1280 1002 + + + FirstTimeWindowDisplayed + + Identifier + windowTool.breakpoints + IsVertical + + Layout + + + Dock + + + BecomeActive + 1 + ContentConfiguration + + PBXBottomSmartGroupGIDs + + 1C77FABC04509CD000000102 + + PBXProjectModuleGUID + 1CE0B1FE06471DED0097A5F4 + PBXProjectModuleLabel + Files + PBXProjectStructureProvided + no + PBXSmartGroupTreeModuleColumnData + + PBXSmartGroupTreeModuleColumnWidthsKey + + 168 + + PBXSmartGroupTreeModuleColumnsKey_v4 + + MainColumn + + + PBXSmartGroupTreeModuleOutlineStateKey_v7 + + PBXSmartGroupTreeModuleOutlineStateExpansionKey + + 1C77FABC04509CD000000102 + + PBXSmartGroupTreeModuleOutlineStateSelectionKey + + + 0 + + + PBXSmartGroupTreeModuleOutlineStateVisibleRectKey + {{0, 0}, {168, 350}} + + PBXTopSmartGroupGIDs + + XCIncludePerspectivesSwitch + 0 + + GeometryConfiguration + + Frame + {{0, 0}, {185, 368}} + GroupTreeTableConfiguration + + MainColumn + 168 + + RubberWindowFrame + 315 424 744 409 0 0 1440 878 + + Module + PBXSmartGroupTreeModule + Proportion + 185pt + + + ContentConfiguration + + PBXProjectModuleGUID + 1CA1AED706398EBD00589147 + PBXProjectModuleLabel + Detail + + GeometryConfiguration + + Frame + {{190, 0}, {554, 368}} + RubberWindowFrame + 315 424 744 409 0 0 1440 878 + + Module + XCDetailModule + Proportion + 554pt + + + Proportion + 368pt + + + MajorVersion + 3 + MinorVersion + 0 + Name + Breakpoints + ServiceClasses + + PBXSmartGroupTreeModule + XCDetailModule + + StatusbarIsVisible + + TableOfContents + + 1CDDB66807F98D9800BB5817 + 1CDDB66907F98D9800BB5817 + 1CE0B1FE06471DED0097A5F4 + 1CA1AED706398EBD00589147 + + ToolbarConfiguration + xcode.toolbar.config.breakpointsV3 + WindowString + 315 424 744 409 0 0 1440 878 + WindowToolGUID + 1CDDB66807F98D9800BB5817 + WindowToolIsVisible + + + + FirstTimeWindowDisplayed + + Identifier + windowTool.debugAnimator + Layout + + + Dock + + + Module + PBXNavigatorGroup + Proportion + 100% + + + Proportion + 100% + + + Name + Debug Visualizer + ServiceClasses + + PBXNavigatorGroup + + StatusbarIsVisible + + ToolbarConfiguration + xcode.toolbar.config.debugAnimatorV3 + WindowString + 100 100 700 500 0 0 1280 1002 + + + FirstTimeWindowDisplayed + + Identifier + windowTool.bookmarks + Layout + + + Dock + + + Module + PBXBookmarksModule + Proportion + 100% + + + Proportion + 100% + + + Name + Bookmarks + ServiceClasses + + PBXBookmarksModule + + StatusbarIsVisible + + WindowString + 538 42 401 187 0 0 1280 1002 + + + Identifier + windowTool.projectFormatConflicts + Layout + + + Dock + + + Module + XCProjectFormatConflictsModule + Proportion + 100% + + + Proportion + 100% + + + Name + Project Format Conflicts + ServiceClasses + + XCProjectFormatConflictsModule + + StatusbarIsVisible + + WindowContentMinSize + 450 300 + WindowString + 50 850 472 307 0 0 1440 877 + + + FirstTimeWindowDisplayed + + Identifier + windowTool.classBrowser + Layout + + + Dock + + + BecomeActive + 1 + ContentConfiguration + + OptionsSetName + Hierarchy, all classes + PBXProjectModuleGUID + 1CA6456E063B45B4001379D8 + PBXProjectModuleLabel + Class Browser - NSObject + + GeometryConfiguration + + ClassesFrame + {{0, 0}, {374, 96}} + ClassesTreeTableConfiguration + + PBXClassNameColumnIdentifier + 208 + PBXClassBookColumnIdentifier + 22 + + Frame + {{0, 0}, {630, 331}} + MembersFrame + {{0, 105}, {374, 395}} + MembersTreeTableConfiguration + + PBXMemberTypeIconColumnIdentifier + 22 + PBXMemberNameColumnIdentifier + 216 + PBXMemberTypeColumnIdentifier + 97 + PBXMemberBookColumnIdentifier + 22 + + PBXModuleWindowStatusBarHidden2 + 1 + RubberWindowFrame + 385 179 630 352 0 0 1440 878 + + Module + PBXClassBrowserModule + Proportion + 332pt + + + Proportion + 332pt + + + Name + Class Browser + ServiceClasses + + PBXClassBrowserModule + + StatusbarIsVisible + + TableOfContents + + 1C0AD2AF069F1E9B00FABCE6 + 1C0AD2B0069F1E9B00FABCE6 + 1CA6456E063B45B4001379D8 + + ToolbarConfiguration + xcode.toolbar.config.classbrowser + WindowString + 385 179 630 352 0 0 1440 878 + WindowToolGUID + 1C0AD2AF069F1E9B00FABCE6 + WindowToolIsVisible + + + + Identifier + windowTool.refactoring + IncludeInToolsMenu + + Layout + + + Dock + + + BecomeActive + + GeometryConfiguration + + Frame + {0, 0}, {500, 335} + RubberWindowFrame + {0, 0}, {500, 335} + + Module + XCRefactoringModule + Proportion + 100% + + + Proportion + 100% + + + Name + Refactoring + ServiceClasses + + XCRefactoringModule + + WindowString + 200 200 500 356 0 0 1920 1200 + + + + diff --git a/macosx/Tclxml.xcodeproj/steve.pbxuser b/macosx/Tclxml.xcodeproj/steve.pbxuser new file mode 100644 index 0000000..e76dbc3 --- /dev/null +++ b/macosx/Tclxml.xcodeproj/steve.pbxuser @@ -0,0 +1,215 @@ +// !$*UTF8*$! +{ + 0867D690FE84028FC02AAC07 /* Project object */ = { + activeArchitecture = i386; + activeBuildConfigurationName = Release; + activeTarget = 8DC2EF4F0486A6940098B216 /* Tclxml */; + addToTargets = ( + 8DC2EF4F0486A6940098B216 /* Tclxml */, + ); + codeSenseManager = AA68C5710C8FA6C900D12438 /* Code sense */; + perUserDictionary = { + PBXConfiguration.PBXFileTableDataSource3.PBXExecutablesDataSource = { + PBXFileTableDataSourceColumnSortingDirectionKey = "-1"; + PBXFileTableDataSourceColumnSortingKey = PBXExecutablesDataSource_NameID; + PBXFileTableDataSourceColumnWidthsKey = ( + 22, + 300, + 259.5835, + ); + PBXFileTableDataSourceColumnsKey = ( + PBXExecutablesDataSource_ActiveFlagID, + PBXExecutablesDataSource_NameID, + PBXExecutablesDataSource_CommentsID, + ); + }; + PBXConfiguration.PBXFileTableDataSource3.PBXFileTableDataSource = { + PBXFileTableDataSourceColumnSortingDirectionKey = "-1"; + PBXFileTableDataSourceColumnSortingKey = PBXFileDataSource_Filename_ColumnID; + PBXFileTableDataSourceColumnWidthsKey = ( + 20, + 298, + 20, + 48, + 43, + 43, + 20, + ); + PBXFileTableDataSourceColumnsKey = ( + PBXFileDataSource_FiletypeID, + PBXFileDataSource_Filename_ColumnID, + PBXFileDataSource_Built_ColumnID, + PBXFileDataSource_ObjectSize_ColumnID, + PBXFileDataSource_Errors_ColumnID, + PBXFileDataSource_Warnings_ColumnID, + PBXFileDataSource_Target_ColumnID, + ); + }; + PBXConfiguration.PBXFileTableDataSource3.PBXSymbolsDataSource = { + PBXFileTableDataSourceColumnSortingDirectionKey = "-1"; + PBXFileTableDataSourceColumnSortingKey = PBXSymbolsDataSource_SymbolNameID; + PBXFileTableDataSourceColumnWidthsKey = ( + 16, + 200, + 50, + 238, + ); + PBXFileTableDataSourceColumnsKey = ( + PBXSymbolsDataSource_SymbolTypeIconID, + PBXSymbolsDataSource_SymbolNameID, + PBXSymbolsDataSource_SymbolTypeID, + PBXSymbolsDataSource_ReferenceNameID, + ); + }; + PBXConfiguration.PBXTargetDataSource.PBXTargetDataSource = { + PBXFileTableDataSourceColumnSortingDirectionKey = "-1"; + PBXFileTableDataSourceColumnSortingKey = PBXFileDataSource_Filename_ColumnID; + PBXFileTableDataSourceColumnWidthsKey = ( + 20, + 258, + 60, + 20, + 48, + 43, + 43, + ); + PBXFileTableDataSourceColumnsKey = ( + PBXFileDataSource_FiletypeID, + PBXFileDataSource_Filename_ColumnID, + PBXTargetDataSource_PrimaryAttribute, + PBXFileDataSource_Built_ColumnID, + PBXFileDataSource_ObjectSize_ColumnID, + PBXFileDataSource_Errors_ColumnID, + PBXFileDataSource_Warnings_ColumnID, + ); + }; + PBXPerProjectTemplateStateSaveDate = 249196867; + PBXWorkspaceStateSaveDate = 249196867; + }; + sourceControlManager = AA68C5700C8FA6C900D12438 /* Source Control */; + userBuildSettings = { + }; + }; + 8DC2EF4F0486A6940098B216 /* Tclxml */ = { + activeExec = 0; + }; + AA68C5700C8FA6C900D12438 /* Source Control */ = { + isa = PBXSourceControlManager; + fallbackIsa = XCSourceControlManager; + isSCMEnabled = 0; + scmConfiguration = { + }; + scmType = ""; + }; + AA68C5710C8FA6C900D12438 /* Code sense */ = { + isa = PBXCodeSenseManager; + indexTemplatePath = ""; + }; + AA68C5D20C9031C400D12438 /* tclxml.c */ = { + uiCtxt = { + sepNavIntBoundsRect = "{{0, 0}, {848, 51870}}"; + sepNavSelRange = "{8172, 0}"; + sepNavVisRect = "{{0, 3464}, {738, 647}}"; + sepNavWindowFrame = "{{67, 8}, {777, 776}}"; + }; + }; + AA68C5E20C9032E400D12438 /* xml-8.0.tcl */ = { + uiCtxt = { + sepNavIntBoundsRect = "{{0, 0}, {738, 1302}}"; + sepNavSelRange = "{0, 0}"; + sepNavVisRect = "{{0, 0}, {738, 647}}"; + sepNavWindowFrame = "{{-1356, 180}, {777, 776}}"; + }; + }; + AA68C5E30C9032E400D12438 /* xml-8.1.tcl */ = { + uiCtxt = { + sepNavIntBoundsRect = "{{0, 0}, {738, 1904}}"; + sepNavSelRange = "{0, 0}"; + sepNavVisRect = "{{0, 0}, {738, 647}}"; + sepNavWindowFrame = "{{126, 102}, {777, 776}}"; + }; + }; + AA68C5F00C90331D00D12438 /* tclxml-libxml2.c */ = { + uiCtxt = { + sepNavIntBoundsRect = "{{0, 0}, {788, 13762}}"; + sepNavSelRange = "{18, 0}"; + sepNavVisRect = "{{0, 0}, {738, 647}}"; + sepNavWindowFrame = "{{10, 32}, {777, 776}}"; + }; + }; + AA68C5F20C90332A00D12438 /* docObj.c */ = { + uiCtxt = { + sepNavIntBoundsRect = "{{0, 0}, {738, 25662}}"; + sepNavSelRange = "{6609, 0}"; + sepNavVisRect = "{{0, 3240}, {738, 647}}"; + sepNavWindowFrame = "{{28, 28}, {777, 776}}"; + }; + }; + AA68C5F60C90334D00D12438 /* tclxml-libxml2.h */ = { + uiCtxt = { + sepNavIntBoundsRect = "{{0, 0}, {738, 1414}}"; + sepNavSelRange = "{2529, 0}"; + sepNavVisRect = "{{0, 767}, {738, 647}}"; + sepNavWindowFrame = "{{471, 30}, {777, 776}}"; + }; + }; + AA68C5F80C90336200D12438 /* tcldom.h */ = { + uiCtxt = { + sepNavIntBoundsRect = "{{0, 0}, {738, 4116}}"; + sepNavSelRange = "{0, 0}"; + sepNavVisRect = "{{0, 0}, {738, 647}}"; + sepNavWindowFrame = "{{66, 61}, {777, 776}}"; + }; + }; + AA68C5FA0C90337C00D12438 /* tcldom-libxml2.c */ = { + uiCtxt = { + sepNavIntBoundsRect = "{{0, 0}, {1664, 100394}}"; + sepNavSelRange = "{182528, 7}"; + sepNavVisRect = "{{0, 96312}, {738, 647}}"; + sepNavWindowFrame = "{{40, 30}, {777, 776}}"; + }; + }; + AA68C5FC0C90338B00D12438 /* nodeObj.c */ = { + uiCtxt = { + sepNavIntBoundsRect = "{{0, 0}, {738, 826}}"; + sepNavSelRange = "{0, 0}"; + sepNavVisRect = "{{0, 0}, {738, 647}}"; + sepNavWindowFrame = "{{35, 11}, {777, 776}}"; + }; + }; + AA68C5FF0C90339C00D12438 /* tcldom-libxml2.h */ = { + uiCtxt = { + sepNavIntBoundsRect = "{{0, 0}, {738, 3164}}"; + sepNavSelRange = "{5523, 0}"; + sepNavVisRect = "{{0, 2419}, {738, 647}}"; + sepNavWindowFrame = "{{501, 4}, {777, 776}}"; + }; + }; + AA68C6020C9033AC00D12438 /* tcldom-libxml2.tcl */ = { + uiCtxt = { + sepNavIntBoundsRect = "{{0, 0}, {738, 647}}"; + sepNavSelRange = "{137, 0}"; + sepNavVisRect = "{{0, 0}, {738, 647}}"; + sepNavWindowFrame = "{{-1310, 138}, {777, 776}}"; + }; + }; + AA68C6060C9033E300D12438 /* tclxslt-libxslt.c */ = { + uiCtxt = { + sepNavIntBoundsRect = "{{0, 0}, {1274, 26222}}"; + sepNavSelRange = "{28375, 7}"; + sepNavVisRect = "{{0, 13978}, {738, 647}}"; + sepNavWindowFrame = "{{54, 33}, {777, 776}}"; + }; + }; + AA68C6640C90EA8700D12438 /* configure */ = { + activeExec = 0; + }; + AA68C6F50C91035400D12438 /* Tclxml-Info.plist */ = { + uiCtxt = { + sepNavIntBoundsRect = "{{0, 0}, {738, 647}}"; + sepNavSelRange = "{555, 0}"; + sepNavVisRect = "{{0, 0}, {738, 647}}"; + sepNavWindowFrame = "{{-1425, 243}, {777, 776}}"; + }; + }; +} diff --git a/nodeObj.c b/nodeObj.c new file mode 100644 index 0000000..10f1420 --- /dev/null +++ b/nodeObj.c @@ -0,0 +1,58 @@ +/* nodeObj.c -- + * + * This module manages libxml2 xmlNodePtr Tcl objects. + * + * Copyright (c) 2007 Explain + * http://www.explain.com.au/ + * Copyright (c) 2003 Zveno Pty Ltd + * http://www.zveno.com/ + * + * See the file "LICENSE" for information on usage and + * redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * $Id: nodeObj.c,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $ + */ + +#include + +#define TCL_DOES_STUBS \ + (TCL_MAJOR_VERSION > 8 || TCL_MAJOR_VERSION == 8 && (TCL_MINOR_VERSION > 1 || \ + (TCL_MINOR_VERSION == 1 && TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE))) + +#undef TCL_STORAGE_CLASS +#define TCL_STORAGE_CLASS DLLEXPORT + +extern Tcl_ObjType NodeObjType; + +/* + * For debugging + */ + +extern Tcl_Channel stderrChan; +extern char dbgbuf[200]; + + +/* + *---------------------------------------------------------------------------- + * + * TclDOM_libxml2_NodeObjInit -- + * + * Initialise node obj module. + * + * Results: + * None. + * + * Side effects: + * Registers new object type. + * + *---------------------------------------------------------------------------- + */ + +int +TclDOM_libxml2_NodeObjInit(interp) + Tcl_Interp *interp; +{ + Tcl_RegisterObjType(&NodeObjType); + + return TCL_OK; +} diff --git a/pkgIndex.tcl.in b/pkgIndex.tcl.in new file mode 100644 index 0000000..5378477 --- /dev/null +++ b/pkgIndex.tcl.in @@ -0,0 +1,165 @@ +# TclXML combo package index file - handcrafted +# +# $Id: pkgIndex.tcl.in,v 1.13 2003/12/03 20:06:34 balls Exp $ + +namespace eval ::xml { + variable _init 0 +} +namespace eval ::xml::libxml2 { + variable _init 0 +} +namespace eval ::dom { + variable _init 0 +} +namespace eval ::dom::libxml2 { + variable _init 0 +} +namespace eval ::xslt { + variable _init 0 +} + +# From http://wiki.tcl.tk/9427 +proc ::xml::_platform {} { + global tcl_platform + + set plat [lindex $tcl_platform(os) 0] + set mach $tcl_platform(machine) + switch -glob -- $mach { + sun4* { + set mach sparc + } + intel - + i*86* { + set mach x86 + } + {Power Macintosh} { + set mach ppc + } + } + return "$plat-$mach" +} + +proc ::xml::_loadlib {dir package version} { + global tcl_platform + + set lib $package[info sharedlibextension] + return [file join $dir [_platform] $lib] +} + +namespace eval ::xml { + variable pkginit + + if {![info exists pkginit]} { + set pkginit 0 + } + + # Try to locate the binary library: + # 1) Using TEA conventions + # 2) Using StarKit conventions + # 3) Using platform-specific conventions + + proc pkgload {dir {binary 0} {cmd {}}} { + variable pkginit + + if {$pkginit} {return {}} + + namespace eval :: [format { + package require xmldefs @PACKAGE_VERSION@ + package require xml::tcl @PACKAGE_VERSION@ + # TEA style + if {[catch {load [file join [list %s] @PKG_LIB_FILE@] Tclxml}]} { + # StarKit style + if {[catch {load [::xml::_loadlib [list %s] Tclxml @PACKAGE_VERSION@]}]} { + # Mac OS X frameworks are different + if {[catch {load [file join [list %s] .. .. Tclxml] Tclxml}]} { + # Unable to load binary implmentation, + # just use pure-Tcl implmentation instead + if {$binary} { + return -code error "unable to load shared library" + } + } else { + set ::xml::libxml2::_init 1 + set ::dom::libxml2::_init 1 + set ::xslt::_init 1 + source [file join [list %s] tcldom-libxml2.tcl] + source [file join [list %s] tclxslt-libxslt.tcl] + } + } else { + set ::xml::libxml2::_init 1 + set ::dom::libxml2::_init 1 + set ::xslt::_init 1 + source [file join [list %s] tcldom-libxml2.tcl] + source [file join [list %s] tclxslt-libxslt.tcl] + } + } else { + set ::xml::libxml2::_init 1 + set ::dom::libxml2::_init 1 + set ::xslt::_init 1 + source [file join [list %s] tcldom-libxml2.tcl] + source [file join [list %s] tclxslt-libxslt.tcl] + } + package require xml::tclparser @PACKAGE_VERSION@ + package provide tclparser @PACKAGE_VERSION@ + package provide xml::libxml2 @PACKAGE_VERSION@ + package provide xml @PACKAGE_VERSION@ + package provide dom @PACKAGE_VERSION@ + package provide dom::libxml2 @PACKAGE_VERSION@ + package provide xslt @PACKAGE_VERSION@ + package provide xslt::libxslt @PACKAGE_VERSION@ + + set pkginit 1 + } $dir $dir $dir $dir $dir $dir $dir $dir $dir $dir] + + eval $cmd + } +} + +package ifneeded xml::tcl @PACKAGE_VERSION@ [list source [file join $dir xml__tcl.tcl]] +package ifneeded sgmlparser 1.1 [list source [file join $dir sgmlparser.tcl]] +package ifneeded xpath 1.0 [list source [file join $dir xpath.tcl]] +package ifneeded xmldep 1.0 [list source [file join $dir xmldep.tcl]] + +# Requesting a specific package means we want it to be the default parser class. + +package ifneeded xml::libxml2 @PACKAGE_VERSION@ [list ::xml::pkgload $dir 1 {::xml::parser default libxml2}] + +# tclparser works with either xml::c or xml::tcl +package ifneeded tclparser @PACKAGE_VERSION@ [list ::xml::pkgload $dir 0 { + ::xml::parser default tclparser + package provide tclparser @PACKAGE_VERSION@ +}] + +# use tcl only (mainly for testing) +package ifneeded puretclparser @PACKAGE_VERSION@ " + package require xml::tcl @PACKAGE_VERSION@ + package require xmldefs + package require xml::tclparser @PACKAGE_VERSION@ + package provide puretclparser @PACKAGE_VERSION@ +" + +# Requesting the generic package leaves the choice of default parser automatic + +package ifneeded xml @PACKAGE_VERSION@ [list ::xml::pkgload $dir 0] +package ifneeded dom @PACKAGE_VERSION@ [list ::xml::pkgload $dir 0] +package ifneeded dom::libxml2 @PACKAGE_VERSION@ [list ::xml::pkgload $dir 1] +package ifneeded xslt @PACKAGE_VERSION@ [list ::xml::pkgload $dir 1] +package ifneeded xslt::libxslt @PACKAGE_VERSION@ [list ::xml::pkgload $dir 1] + +package ifneeded xmlswitch @PACKAGE_VERSION@ [list source [file join $dir xmlswitch.tcl]] + +package ifneeded xslt::cache @PACKAGE_VERSION@ [list source [file join $dir xsltcache.tcl]] +package ifneeded xslt::utilities 1.2 [list source [file join $dir utilities.tcl]] +package ifneeded xslt::process 1.1 [list source [file join $dir process.tcl]] +package ifneeded xslt::resources 1.3 [list source [file join $dir resources.tcl]] + +if {[info tclversion] <= 8.0} { + package ifneeded sgml 1.9 [list source [file join $dir sgml-8.0.tcl]] + package ifneeded xmldefs @PACKAGE_VERSION@ [list source [file join $dir xml-8.0.tcl]] + package ifneeded xml::tclparser @PACKAGE_VERSION@ [list source [file join $dir tclparser-8.0.tcl]] +} else { + package ifneeded sgml 1.9 [list source [file join $dir sgml-8.1.tcl]] + package ifneeded xmldefs @PACKAGE_VERSION@ [list source [file join $dir xml-8.1.tcl]] + package ifneeded xml::tclparser @PACKAGE_VERSION@ [list source [file join $dir tclparser-8.1.tcl]] +} + + diff --git a/tclconfig/ChangeLog b/tclconfig/ChangeLog new file mode 100644 index 0000000..9504def --- /dev/null +++ b/tclconfig/ChangeLog @@ -0,0 +1,1003 @@ +2016-03-11 Sean Woods + *tcl.m4 Fixed the search for Tcl and Wish shells under MinGW. Static builds and threaded builds + get an "s" or "t" added to the name. + +2015-08-28 Jan Nijtmans + + * tcl.m4: Rfe [00189c4afc]: Allow semi-static UCRT build on + Windows with VC 14.0 + +2013-10-08 Jan Nijtmans + + * tcl.m4: Bug [172223e008]: Wrong filename in + --disable-shared compile on MinGW + +2013-10-04 Jan Nijtmans + + * tcl.m4: stub library is no longer linked with msvcrt??.dll. + +2013-10-01 Jan Nijtmans + + * tcl.m4: Workaround for MinGW bug #2065: "gcc --shared" links + with libgcc_s_dw2-1.dll when using 64-bit division in C + +2013-07-04 Jan Nijtmans + + * tcl.m4: Bug [3324676]: AC_PROG_INSTALL incompat, + Bug [3606445]: Unneeded -DHAVE_NO_SEH=1 when not building on Windows + +2013-07-02 Jan Nijtmans + + * tcl.m4: Bug [32afa6e256]: dirent64 check is incorrect in tcl.m4 + (thanks to Brian Griffin) + +2013-06-20 Jan Nijtmans + + * tcl.m4: Use X11/Xlib.h for checking where X11 can be found + in stead of X11/XIntrinsic.h. Suggested by Pietro Cerutti. + +2013-06-04 Jan Nijtmans + + * tcl.m4: Eliminate NO_VIZ macro as current + zlib uses HAVE_HIDDEN in stead. One more last-moment + fix for FreeBSD by Pietro Cerutti + +2013-05-19 Jan Nijtmans + + * tcl.m4: Fix for FreeBSD, and remove support for old + FreeBSD versions. Patch by Pietro Cerutti + +2013-03-12 Jan Nijtmans + + * tcl.m4: Patch by Andrew Shadura, providing better support for + * three architectures they have in Debian. + +2012-08-07 Stuart Cassoff + + * tcl.m4: Added "-DNDEBUG" to CFLAGS_DEFAULT + when building with --disable-symbols. + +2012-08-07 Stuart Cassoff + + * tcl.m4: [Bug 3555058]: Checkin [30736d63f0] broke + CFLAGS_DEFAULT, LDFLAGS_DEFAULT + +2012-08-07 Stuart Cassoff + + * tcl.m4: [Bug 3511806]: Checkin [30736d63f0] broke CFLAGS + +2012-08-07 Jan Nijtmans + + * tcl.m4: [Bug 3511806]: Checkin [30736d63f0] broke CFLAGS + +2012-07-25 Jan Nijtmans + + * tcl.m4: My previous commit (2012-04-03) broke the ActiveTcl + build for AMD64, because of the quotes in "C://AMD64/cl.exe". + It turns out that the AC_TRY_COMPILE macro cannot handle that. + +2012-07-22 Stuart Cassoff + + * tcl.m4: Tidy: consistency, spelling, phrasing, whitespace. + No functional change. + +2012-04-03 Jan Nijtmans + + * tcl.m4: [Bug 3511806] Compiler checks too early + This change allows to build the cygwin and mingw32 ports of + Tcl/Tk extensions to build out-of-the-box using a native or + cross-compiler, e.g. on Cygwin, Linux or Darwin. + +2011-04-02 Jan Nijtmans + + * install-sh: Fix issue with library stripping in install-sh + (backported from kevin_walzer's patch from Tcl 8.6 trunk) + +2011-04-05 Andreas Kupries + + * tcl.m4: Applied patch by Jeff Lawson. Nicer error message when + tclConfig.sh was not found. + +2010-12-15 Stuart Cassoff + + * install-sh: Upgrade to newer install-sh and use it. + * tcl.m4: + +2010-12-14 Stuart Cassoff + + * tcl.m4: Better building on OpenBSD. + +2010-12-14 Jan Nijtmans + + * tcl.m4: when using gcc, don't try to determine Win64 SDK + +2010-12-12 Jan Nijtmans + + * tcl.m4: Determine correctly a cross-compiler-windres + +2010-11-23 Jan Nijtmans + + * tcl.m4: add some cross-compile support, borrowed from Tcl 8.6 + +2010-09-16 Jeff Hobbs + + * tcl.m4: correct HP-UX LDFLAGS (only used when building big shell) + +2010-09-14 Jeff Hobbs + + * tcl.m4: add extra if check for .manifest file generation + Add notice about package name and version being built. + +2010-09-09 Jan Nijtmans + + * tcl.m4: [FREQ #3058486] TEA_LOAD_CONFIG doesn't set all BUILD_ vars + Slightly related: defining BUILD_$1 on all platforms - not only win - + allows the -fvisibility feature to be used in extensions as well, at + least if you compile against tcl >= 8.5. + +2010-08-26 Jeff Hobbs + + * tcl.m4: ensure safe quoting for autoheader usage + +2010-08-19 Jeff Hobbs + + * tcl.m4: add TEA_ADD_CLEANFILES macro to make adding cleanfiles + easier, and add *.exp to CLEANFILES Windows default. + (TEA_MAKE_LIB): Enhanced to check for MSVC that requires manifests + and auto-embed it into proj DLL via MAKE_SHARED_LIB. Also define + VC_MANIFEST_EMBED_DLL and VC_MANIFEST_EMBED_EXE that do the same + magic in case it is needed for extended TEA projects. + +2010-08-16 Jeff Hobbs + + *** Bump to TEA_VERSION 3.9 *** + If upgrading from TEA_VERSION 3.8, copy over tcl.m4, change + TEA_INIT to use 3.9 and reconfigure (ac-2.59+). + BUILD_${PACKAGE_NAME} will be auto-defined on Windows for + correct setting of TCL_STORAGE_CLASS. + TEA_LOAD_CONFIG users should remove the SHLIB_LD_LIBS setting done + in configure.in (LIBS will be automagically populated by + TEA_LOAD_CONFIG). + TEA_EXPORT_CONFIG has been added for ${pkg}Config.sh creators + SHLIB_LD_FLAGS was deprecated a while ago, remove it if it is + still in your Makefile.in. + + * tcl.m4: add /usr/lib64 to set of auto-search dirs. [Bug 1230554] + Auto-define BUILD_$PACKAGE_NAME so users don't need to. This + needs to correspond with $pkg.h define magic for TCL_STORAGE_CLASS. + Auto-define CLEANFILES. Users can expand it. + (SHLIB_LD_LIBS): define to '${LIBS}' default and change it only if + necessary. Platforms not using this may simply not work or have + very funky linkers. + (TEA_LOAD_CONFIG): When loading config for another extension, + auto-add stub libraries found with TEA_ADD_LIBS. Eases + configure.in for modules like itk and img::*. + (TEA_EXPORT_CONFIG): Add standardized function for exporting a + ${pkg}Config.sh. See use by img::* and itcl. + +2010-08-12 Jeff Hobbs + + *** Bump to TEA_VERSION 3.8 *** + If upgrading from TEA_VERSION 3.7, copy over tcl.m4, change + TEA_INIT to use 3.8 and reconfigure (ac-2.59+). + No other changes should be necessary. + + * tcl.m4: remove more vestigial bits from removed platforms. + Add back SCO_SV-3.2*. + Remove use of DL_LIBS and DL_OBJS and related baggage - these are + only needed by the core to support 'load'. + Allow for macosx in TEA_ADD_SOURCES. + Correct check for found_xincludes=no in TEA_PATH_UNIX_X. + +2010-08-11 Jeff Hobbs + + * tcl.m4: remove the following old platform configurations: + UNIX_SV*|UnixWare-5*, SunOS-4.*, SINIX*5.4*, SCO_SV-3.2*, + OSF1-1.*, NEXTSTEP-*, NetBSD-1.*|FreeBSD-[[1-2]].*, MP-RAS-*, + IRIX-5.*, HP-UX-*.08.*|HP-UX-*.09.*|HP-UX-*.10.*, dgux*, + BSD/OS-2.1*|BSD/OS-3* + (AIX): drop AIX-pre4 support and use of ldAix, use -bexpall/-brtl + +2010-07-05 Jan Nijtmans + + * tcl.m4: [Patch #1055668] removal of exported internals from + tclInt.h (EXTERN macro) + +2010-04-14 Jan Nijtmans + + * tcl.m4 - Backport a lot of quoting fixes from tcl8.6/unix/tcl.m4 + - Fix determination of CYGPATH for CYGWIN + With those fixes, itcl and tdbc compile fine with CYGWIN + +2010-04-06 Jan Nijtmans + + * install-sh [Bug 2982540] configure and install* script files + should always have LF + +2010-02-19 Stuart Cassoff + + * tcl.m4: Correct compiler/linker flags for threaded builds on + OpenBSD. + +2010-01-19 Jan Nijtmans + + * tcl.m4: Detect CYGWIN variant: win32 or unix + +2010-01-03 Donal K. Fellows + + * unix/tcl.m4 (TEA_CONFIG_CFLAGS): [Tcl Bug 1636685]: Use the + configuration for modern FreeBSD suggested by the FreeBSD porter. + +2009-10-22 Jan Nijtmans + + * tcl.m4: [Tcl Patch #2883533] tcl.m4 support for Haiku OS + +2009-04-27 Jeff Hobbs + + * tcl.m4 (TEA_CONFIG_CFLAGS): harden the check to add _r to CC on + AIX with threads. + +2009-04-10 Daniel Steffen + + * tcl.m4 (Darwin): check for 64-bit TkAqua. + +2009-03-26 Jan Nijtmans + + * tclconfig/tcl.m4: Adapt LDFLAGS and LD_SEARCH_FLAGS + together with SHLIB_LD definition to unbreak building on HPUX. + +2009-03-20 Andreas Kupries + + * tclconfig/tcl.m4: Changed SHLIB_LD definition to unbreak + building on HPUX. + +2009-03-16 Joe English + + * tcl.m4(TEA_PUBLIC_TK_HEADERS): Look at ${TK_INCLUDE_SPEC} + (found in tkConfig.sh) when trying to guess where tk.h might be + [Patch 1960628]. + +2009-03-11 Joe English + + * tcl.m4: Allow ${SHLIB_SUFFIX} to be overridden at + configure-time [Patch 1960628]. Also fix some comment typos, + and an uninitialized variable bug-waiting-to-happen. + +2008-12-21 Jan Nijtmans + + * tcl.m4: [Bug 2073255] Tcl_GetString(NULL) doesn't crash on HP-UX + (this bug report was for Tcl, but holds for TEA as well.) + +2008-12-20 Daniel Steffen + + * tcl.m4: sync with tdbc tcl.m4 changes + (SunOS-5.11): Sun cc SHLIB_LD: use LDFLAGS_DEFAULT instead of LDFLAGS + +2008-12-02 Jeff Hobbs + + *** Bump to TEA_VERSION 3.7 *** + + * tcl.m4: in private header check, check for Port.h instead + of Int.h to ensure all private headers are available. + +2008-11-04 Daniel Steffen + + * tcl.m4 (Darwin): sync TEA_PRIVATE_TK_HEADERS handling of + Tk.framework PrivateHeaders with TEA_PRIVATE_TCL_HEADERS. + +2008-11-04 Jeff Hobbs + + * tcl.m4 (TEA_PATH_TCLCONFIG, TEA_PATH_TKCONFIG): exit with error + when tclConfig.sh cannot be found. [Bug #1997760] + (TEA_PRIVATE_TCL_HEADERS, TEA_PRIVATE_TK_HEADERS): allow for + finding the headers installed in the public areas, e.g. a result of + make install-private-headers. [Bug #1631922] + +2008-08-12 Daniel Steffen + + * tcl.m4 (Darwin): link shlib with current and compatiblity version + flags; look for libX11.dylib when searching for X11 libraries. + +2008-06-12 Daniel Steffen + + * tcl.m4 (SunOS-5.11): fix 64bit amd64 support with gcc & Sun cc. + +2008-03-27 Daniel Steffen + + * tcl.m4 (SunOS-5.1x): fix 64bit support for Sun cc. [Bug 1921166] + +2008-02-01 Donal K. Fellows + + * tcl.m4 (TEA_CONFIG_CFLAGS): Updated to work at least in part with + more modern VC versions. Currently just made the linker flags more + flexible; more work may be needed. + +2007-10-26 Daniel Steffen + + * tcl.m4 (Darwin): add support for 64-bit X11. + +2007-10-23 Jeff Hobbs + + *** Tagged tea-3-branch to start TEA 4 development on HEAD *** + +2007-09-17 Joe English + + * tcl.m4: use '${CC} -shared' instead of 'ld -Bshareable' + to build shared libraries on current NetBSDs [Bug 1749251]. + +2007-09-15 Daniel Steffen + + * tcl.m4: replace all direct references to compiler by ${CC} to + enable CC overriding at configure & make time. + (SunOS-5.1x): replace direct use of '/usr/ccs/bin/ld' in SHLIB_LD by + 'cc' compiler driver. + +2007-08-08 Jeff Hobbs + + * tcl.m4: check Ttk dir for Tk private headers (8.5). + Add some comments to other bits. + +2007-06-25 Jeff Hobbs + + * tcl.m4 (TEA_PROG_TCLSH, TEA_PROG_WISH): move where / is added. + +2007-06-13 Jeff Hobbs + + * tcl.m4: fix --with-tkinclude alignment. [Bug 1506111] + +2007-06-06 Daniel Steffen + + * tcl.m4 (Darwin): fix 64bit arch removal in fat 32&64bit builds. + +2007-05-18 Donal K. Fellows + + * tcl.m4: Added quoting so that paths with spaces cause fewer + problems. + +2007-03-07 Daniel Steffen + + * tcl.m4 (Darwin): s/CFLAGS/CPPFLAGS/ in -mmacosx-version-min check. + +2007-02-15 Jeff Hobbs + + * tcl.m4: correct private header check to search in generic subdir + +2007-02-09 Jeff Hobbs + + *** Bump to TEA_VERSION 3.6 *** + + * tcl.m4: correct -d to -f + (TEA_CONFIG_CFLAGS): SHLIB_SUFFIX is .so on HP ia64 [Bug 1615058] + +2007-02-08 Jeff Hobbs + + * tcl.m4 (TEA_PRIVATE_TCL_HEADERS, TEA_PRIVATE_TK_HEADERS): check + that the dirs actually have private headers. [Bug 1631922] + +2007-02-04 Daniel Steffen + + * tcl.m4: add caching to -pipe check. + +2007-01-25 Daniel Steffen + + * tcl.m4: integrate CPPFLAGS into CFLAGS as late as possible and + move (rather than duplicate) -isysroot flags from CFLAGS to CPPFLAGS to + avoid errors about multiple -isysroot flags from some older gcc builds. + +2006-01-19 Daniel Steffen + + * tcl.m4: ensure CPPFLAGS env var is used when set. [Bug 1586861] + (Darwin): add -isysroot and -mmacosx-version-min flags to CPPFLAGS when + present in CFLAGS to avoid discrepancies between what headers configure + sees during preprocessing tests and compiling tests. + +2006-12-19 Daniel Steffen + + * tcl.m4 (Darwin): --enable-64bit: verify linking with 64bit -arch flag + succeeds before enabling 64bit build. + +2006-12-16 Daniel Steffen + + * tcl.m4 (Linux): fix previous change to use makefile variable + LDFLAGS_DEFAULT instead of LDFLAGS in SHLIB_LD, to ensure linker + flags in sampleextension Makefile are picked up. + +2006-11-26 Daniel Steffen + + * tcl.m4 (Linux): --enable-64bit support. [Patch 1597389], [Bug 1230558] + +2006-08-18 Daniel Steffen + + * tcl.m4 (Darwin): add support for --enable-64bit on x86_64, for + universal builds including x86_64 and for use of -mmacosx-version-min + instead of MACOSX_DEPLOYMENT_TARGET. For Tk extensions, remove 64-bit + arch flags from CFLAGS like in the Tk configure, as neither TkAqua nor + TkX11 can be built for 64-bit at present. + +2006-03-28 Jeff Hobbs + + * tcl.m4: []-quote AC_DEFUN functions. + (TEA_PATH_TKCONFIG): Fixed Windows-specific check for tkConfig.sh. + (TEA_MAKE_LIB): Prepend 'lib' for Windows-gcc configs. + +2006-03-07 Joe English + + * tcl.m4: Set SHLIB_LD_FLAGS='${LIBS}' on NetBSD, + as per the other *BSD variants [Bug 1334613]. + +2006-01-25 Jeff Hobbs + + *** Bump to TEA version 3.5 *** + + * tcl.m4: keep LD_SEARCH_FLAGS and CC_SEARCH_FLAGS synchronous + with core tcl.m4 meaning. + +2006-01-24 Daniel Steffen + + * tcl.m4 (Darwin): use makefile variable LDFLAGS_DEFAULT instead of + LDFLAGS in SHLIB_LD, to ensure linker flags in sampleextension Makefile + are picked up. [Bug 1403343] + +2006-01-23 Jeff Hobbs + + * tcl.m4: add C:/Tcl/lib and C:/Progra~1/Tcl/lib dirs to check for + *Config.sh on Windows. [Bug 1407544] + +2006-01-23 Daniel Steffen + + * tcl.m4 (Darwin): for Tk extensions, remove -arch ppc64 from CFLAGS + like in the Tk configure, as neither TkAqua nor TkX11 can be built for + 64bit at present (no 64bit GUI libraries). + +2006-01-22 Jeff Hobbs + + * tcl.m4: restore system=windows on Windows. + Remove error if 'ar' isn't found (it may not be on Windows). + Do not add -lxnet or define _XOPEN_SOURCE on HP-UX by default. + Ensure the C|LDFLAGS_DEFAULT gets the fully sub'd value at + configure time. + +2006-01-10 Daniel Steffen + + * tcl.m4: add caching, use AC_CACHE_CHECK instead of AC_CACHE_VAL + where possible, consistent message quoting, sync relevant + tcl/unix/tcl.m4 HEAD changes and gratuitous formatting differences + (notably sunc removal of support for for ancient BSD's, IRIX 4, + RISCos and Ultrix by kennykb), Darwin improvements to + TEA_LOAD_*CONFIG to make linking work against Tcl/Tk frameworks + installed in arbitrary location, change TEA_PROG_* search order + (look in *_BIN_DIR parents before *_PREFIX). + +2006-01-05 Jeff Hobbs + + * tcl.m4: add dkf's system config refactor + +2006-01-04 Jeff Hobbs + + * tcl.m4: remove extraneous ' that causes bash 3.1 to choke + +2005-12-19 Joe English + + * tcl.m4 (TEA_PATH_TCLCONFIG &c): Look for tclConfig.sh &c + in ${libdir}, where they are installed by default [Patch #1377407]. + +2005-12-05 Don Porter + + * tcl.m4 (TEA_PUBLIC_*_HEADERS): Better support for finding + header files for uninstalled Tcl and Tk. + +2005-12-02 Jeff Hobbs + + * tcl.m4: correctly bump TEA_VERSION var to 3.4 + +2005-12-01 Daniel Steffen + + * unix/tcl.m4 (Darwin): fixed error when MACOSX_DEPLOYMENT_TARGET unset + +2005-11-29 Jeff Hobbs + + * tcl.m4: *** Bump to TEA version 3.4 *** + Add Windows x64 build support. + Remove TEA_PATH_NOSPACE and handle the problem with ""s where + necessary - the macro relied on TCLSH_PROG which didn't work for + cross-compiles. + +2005-11-27 Daniel Steffen + + * tcl.m4 (Darwin): add 64bit support, add CFLAGS to SHLIB_LD to + support passing -isysroot in env(CFLAGS) to configure (flag can't + be present twice, so can't be in both CFLAGS and LDFLAGS during + configure), don't use -prebind when deploying on 10.4. + (TEA_ENABLE_LANGINFO, TEA_TIME_HANDLER): add/fix caching. + +2005-10-30 Daniel Steffen + + * tcl.m4: fixed two tests for TEA_WINDOWINGSYSTEM = "aqua" that + should have been for `uname -s` = "Darwin" instead; added some + missing quoting. + (TEA_PROG_TCLSH, TEA_PROG_WISH): fix incorrect assumption that + install location of tclConfig.sh/tkConfig.sh allows to determine + the tclsh/wish install dir via ../bin. Indeed tcl/tk can be + configured with arbitrary --libdir and --bindir (independent of + prefix) and such a configuration is in fact standard with Darwin + framework builds. At least now also check ${TCL_PREFIX}/bin + resp. ${TK_PREFIX}/bin for presence of tclsh resp. wish (if tcl/tk + have been configured with arbitrary --bindir, this will still not + find them, for a general solution *Config.sh would need to contain + the values of bindir/libdir/includedir passed to configure). + +2005-10-07 Jeff Hobbs + + * tcl.m4: Fix Solaris 5.10 check and Solaris AMD64 64-bit builds. + +2005-10-04 Jeff Hobbs + + * tcl.m4 (TEA_PRIVATE_TCL_HEADERS): add / to finish sed macro + (TEA_ENABLE_THREADS): don't check for pthread_attr_setstacksize func + +2005-09-13 Jeff Hobbs + + * tcl.m4: *** Update to TEA version 3.3 *** + define TEA_WINDOWINGSYSTEM in TEA_LOAD_TKCONFIG. + Make --enable-threads the default (users can --disable-threads). + Improve AIX ${CC}_r fix to better check existing ${CC} value. + Do the appropriate evals to not require the *TOP_DIR_NATIVE vars + be set for extensions that use private headers. + Make aqua check for Xlib compat headers the same as win32. + +2005-07-26 Mo DeJong + + * tcl.m4 (TEA_PROG_TCLSH, TEA_BUILD_TCLSH, + TEA_PROG_WISH, TEA_BUILD_WISH): Remove + TEA_BUILD_TCLSH and TEA_BUILD_WISH because + of complaints that it broke the build when + only an installed version of Tcl was available + at extension build time. The TEA_PROG_TCLSH and + TEA_PROG_WISH macros will no longer search the + path at all. The build tclsh or installed + tclsh shell will now be found by TEA_PROG_TCLSH. + +2005-07-24 Mo DeJong + + * tcl.m4 (TEA_PROG_TCLSH, TEA_BUILD_TCLSH, + TEA_PROG_WISH, TEA_BUILD_WISH): + Split confused search for tclsh on PATH and + build and install locations into two macros. + TEA_PROG_TCLSH and TEA_PROG_WISH search the + system PATH for an installed tclsh or wish. + The TEA_BUILD_TCLSH and TEA_BUILD_WISH + macros determine the name of tclsh or + wish in the Tcl or Tk build directory even + if tclsh or wish has not yet been built. + [Tcl bug 1160114] + [Tcl patch 1244153] + +2005-06-23 Daniel Steffen + + * tcl.m4 (TEA_PRIVATE_TK_HEADERS): add ${TK_SRC_DIR}/macosx to + TK_INCLUDES when building against TkAqua. + + * tcl.m4 (TEA_PATH_X): fixed missing comma in AC_DEFINE + + * tcl.m4: changes to better support framework builds of Tcl and Tk out + of the box: search framework install locations for *Config.sh, and if in + presence of a framework build, use the framework's Headers and + PrivateHeaders directories for public and private includes. [FR 947735] + +2005-06-18 Daniel Steffen + + * tcl.m4 (Darwin): add -headerpad_max_install_names to LDFLAGS to + ensure we can always relocate binaries with install_name_tool. + +2005-06-04 Daniel Steffen + + * tcl.m4 (TEA_PATH_X): for TEA_WINDOWINGSYSTEM == aqua, check if xlib + compat headers are available in tkheaders location, otherwise add xlib + sourcedir to TK_XINCLUDES. + +2005-04-25 Daniel Steffen + + * tcl.m4: added AC_DEFINE* descriptions (from core tcl.m4) to allow + use with autoheader. + (Darwin): added configure checks for recently added linker flags + -single_module and -search_paths_first to allow building with older + tools (and on Mac OS X 10.1), use -single_module in SHLIB_LD. + (TEA_MISSING_POSIX_HEADERS): added caching of dirent.h check. + (TEA_BUGGY_STRTOD): added caching (sync with core tcl.m4). + +2005-03-24 Jeff Hobbs + + * tcl.m4 (TEA_TCL_64BIT_FLAGS): use Tcl header defaults for wide + int type only on Windows when __int64 is detected as valid. + +2005-03-24 Don Porter + + * README.txt: Update reference to "SC_* macros" to "TEA_* macros". + * tcl.m4: Incorporated recent improvements in SC_PATH_TCLCONFIG + and SC_PATH_TKCONFIG into TEA_PATH_TCLCONFIG and TEA_PATH_TKCONFIG. + Corrected search path in TEA_PATH_CONFIG and added + AC_SUBST($1_BIN_DIR) to TEA_LOAD_CONFIG so that packages that load + the configuration of another package can know where they loaded + it from. + +2005-03-18 Jeff Hobbs + + * tcl.m4 (TEA_CONFIG_CFLAGS): correct 2005-03-17 change to have + variant LD_SEARCH_FLAGS for gcc and cc builds. + + * tcl.m4 (TEA_PROG_TCLSH, TEA_PROG_WISH): correct x-compile check. + +2005-03-17 Jeff Hobbs + + * tcl.m4: Correct gcc build and HP-UX-11. + +2005-02-08 Jeff Hobbs + + * tcl.m4 (TEA_ADD_LIBS): don't touch lib args starting with -. + (TEA_CONFIG_CFLAGS): only define _DLL for CE in shared build. + (TEA_MAKE_LIB): set RANLIB* to : on Windows (it's not needed). + +2005-02-01 Jeff Hobbs + + * tcl.m4: redo of 2005-01-27 changes to correctly handle paths + with spaces. Win/CE and Win/64 builds now require a prebuilt + tclsh to handle conversion to short pathnames. This is done in + the new TEA_PATH_NOSPACE macro. For Win/CE|64, make CC just the + compiler and move the necessary includes to CFLAGS. + (TEA_CONFIG_CFLAGS): Add Solaris 64-bit gcc build support. + (TEA_PROG_TCLSH, TEA_PROG_WISH): Allow TCLSH_PROG and WISH_PROG to + be set in the env and prevent resetting. + (TEA_ADD_LIBS): On Windows using GCC (mingw), convert foo.lib + args to -lfoo, for use with mingw. + *** POTENTIAL INCOMPATABILITY *** + (TEA_CONFIG_CFLAGS): Fix AIX gcc builds to work out-of-box. + Bumped TEA to 3.2. + +2005-01-27 Jeff Hobbs + + * tcl.m4: remove cygpath calls to support msys. + Update base CE build assumption to "420,ARMV4,ARM,Pocket PC 2003". + Make STLIB_LD use $LINKBIN -lib. + +2005-01-25 Daniel Steffen + + * tcl.m4 (Darwin): fixed bug with static build linking to dynamic + library in /usr/lib etc instead of linking to static library earlier + in search path. [Tcl Bug 956908] + Removed obsolete references to Rhapsody. + +2004-12-29 Jeff Hobbs + + * tcl.m4: Updates for VC7 compatibility, fixing CFLAGS and LDFLAGS + options, using better default -O levels. [Bug 1092952, 1091967] + +2004-12-29 Joe English + + * tcl.m4: Do not use ${DBGX} suffix when building + shared libraries [patch #1081595, TIP #34] + +2004-09-07 Jeff Hobbs + + * tcl.m4 (TEA_CONFIG_CFLAGS): support eVC4 Win/CE builds + +2004-08-10 Jeff Hobbs + + * tcl.m4 (TEA_INIT, TEA_PREFIX): update handling of exec_prefix to + work around subdir configures since autoconf only propagates the + prefix (not exec_prefix). + +2004-07-23 Daniel Steffen + + * tcl.m4 (TEA_CONFIG_CFLAGS): Darwin section: brought inline with + Tcl 8.5 HEAD config, removed core specific & obsolete settings. + +2004-07-22 Jeff Hobbs + + * tcl.m4 (TEA_PATH_X): check in TK_DEFS for MAC_OSX_TK to see if + we are compiling on Aqua. Add TEA_WINDOWINGSYSTEM var that + reflects 'tk windowingsystem' value. + +2004-07-16 Jeff Hobbs + + * tcl.m4 (TEA_ENABLE_THREADS): force a threaded build when + building against a threaded core. + (CFLAGS_WARNING): Remove -Wconversion for gcc builds + (TEA_CONFIG_CFLAGS): Reorder configure.in for better 64-bit build + configuration, replacing EXTRA_CFLAGS with CFLAGS. [Bug #874058] + Update to latest Tcl 8.5 head config settings. + Call this TEA version 3.1. + +2004-04-29 Jeff Hobbs + + * tcl.m4 (TEA_TCL_64BIT_FLAGS): replace AC_TRY_RUN test with + AC_TRY_COMPILE for the long vs. long long check. (kenny) + +2004-04-26 Jeff Hobbs + + * tcl.m4 (TEA_TCL_64BIT_FLAGS): update against core tcl.m4 to + define TCL_WIDE_INT_IS_LONG if 'using long'. + +2004-03-19 Jeff Hobbs + + * tcl.m4: correct Windows builds getting LDFLAGS info in MAKE_LIB + +2004-02-11 Jeff Hobbs + + * tcl.m4: correct TCL_INCLUDES for private headers on Windows - it + doesn't need the eval. + +2004-02-10 Jeff Hobbs + + * tcl.m4: don't require TK_INCLUDES and TCL_INCLUDES to have the + DIR_NATIVE vars defined when using private headers on unix. + Allow $... to TEA_ADD_SOURCES for constructs like + TEA_ADD_SOURCES([\$(WIN_OBJECTS)]), that allow the developer to + place more in the Makefile.in. + tkUnixPort.h checks for HAVE_LIMITS_H, so do both HAVE and + CHECK on limits.h + +2003-12-10 Jeff Hobbs + + * Makefile.in: added TEA_ADD_LIBS, TEA_ADD_INCLUDES and + * configure: TEA_ADD_CFLAGS to configurable parameters with + * configure.in: PKG_* equivs in the Makefile. This allows the + * tclconfig/tcl.m4: user to worry less about actual magic VAR names. + Corrected Makefile.in to note that TEA_ADD_TCL_SOURCES requires + exact file names. + +2003-12-09 Jeff Hobbs + + * tcl.m4: updated OpenBSD support based on [Patch #775246] (cassoff) + +2003-12-05 Jeff Hobbs + + * configure: + * configure.in: + * Makefile.in (VPATH): readd $(srcdir) to front of VPATH as the + first part of VPATH can get chopped off. + Change .c.$(OBJEXT) rule to .c.@OBJEXT@ to support more makes. + * tclconfig/tcl.m4: add TEA_ADD_STUB_SOURCES to support libstub + generation and TEA_ADD_TCL_SOURCES to replace RUNTIME_SOURCES as + the way the user specifies library files. + +2003-12-03 Jeff Hobbs + + * configure: Update of TEA spec to (hopefully) simplify + * configure.in: some aspects of TEA by making use of more + * Makefile.in: AC 2.5x features. Use PACKAGE_NAME (instead + * generic/tclsample.c: of PACKAGE) and PACKAGE_VERSION (instead of + * tclconfig/tcl.m4: VERSION) arguments to AC_INIT as the TEA + package name and version. + Provide a version argument to TEA_INIT - starting with 3.0. + Drop all use of interior shell substs that older makefiles didn't + like. Use PKG_* naming convention instead. + Move specification of source files and public headers into + configure.in with TEA_ADD_SOURCES and TEA_ADD_HEADERS. These will + be munged during ./configure into the right obj file names (no + $(SOURCES:.c=.obj) needed). + There is almost nothing that should be touched in Makefile.in now + for the developer. May want to add a TEA_ADD_TCL_SOURCES for the + RUNTIME_SOURCES that remains. + Use SHLID_LD_FLAGS (instead of SHLID_LDFLAGS) as Tcl does. + Only specify the user requested LDFLAGS/CFLAGS in the Makefile, + don't mention the _OPTIMIZE/_DEBUG variants. + +2003-10-15 Jeff Hobbs + + * tcl.m4: create a TEA_SETUP_COMPILER_CC the precedes the + TEA_SETUP_COMPILER macro. They are split so the check for CC + occurs before any use of CC. Also add AC_PROG_CPP to the compiler + checks. + +2003-10-06 Jeff Hobbs + + * tcl.m4: Updated for autoconf 2.5x prereq. + Where TCL_WIDE_INT_TYPE would be __int64, defer to the code checks + in tcl.h, which also handles TCL_LL_MODIFIER* properly. + +2003-04-22 Jeff Hobbs + + * tcl.m4: correct default setting of ARCH for WinCE builds. + Correct \ escaping for CE sed macros. + +2003-04-10 Jeff Hobbs + + * tcl.m4: replace $(syscal) construct with older `syscall` for + systems where sh != bash. + +2003-04-09 Jeff Hobbs + + * tcl.m4 (TEA_WITH_CELIB): add --enable-wince and --with-celib + options for Windows/CE compilation support. Requires the + Microsoft eMbedded SDK and Keuchel's celib emulation layer. + +2003-02-18 Jeff Hobbs + + * tcl.m4 (TEA_ENABLE_THREADS): Make sure -lpthread gets passed on + the link line when checking for the pthread_attr_setstacksize + symbol. (dejong) + + * tcl.m4 (TEA_SETUP_COMPILER): added default calls to + TEA_TCL_EARLY_FLAGS, TEA_TCL_64BIT_FLAGS, + TEA_MISSING_POSIX_HEADERS and TEA_BUGGY_STRTOD. + +2003-02-14 Jeff Hobbs + + * tcl.m4: correct HP-UX ia64 --enable-64bit build flags + +2003-01-29 Jeff Hobbs + + * tcl.m4: check $prefix/lib as well as $exec_prefix/lib when + looking for tcl|tkConfig.sh, as this check is done before we would + set exec_prefix when the user does not define it. + +2003-01-21 Mo DeJong + + * tcl.m4 (TEA_CONFIG_CFLAGS): Fix build support + for mingw, the previous implementation would + use VC++ when compiling with mingw gcc. Don't + pass -fPIC since gcc always compiles pic code + under win32. Change some hard coded cases + of gcc to ${CC}. + +2002-10-15 Jeff Hobbs + + * tcl.m4: move the CFLAGS definition from TEA_ENABLE_SHARED to + TEA_MAKE_LIB because setting too early confuses other AC_* macros. + Correct the HP-11 SHLIB_LD_LIBS setting. + + * tcl.m4: add the CFLAGS definition into TEA_ENABLE_SHARED and + make it pick up the env CFLAGS at configure time. + +2002-10-09 Jeff Hobbs + + * tcl.m4: add --enable-symbols=mem option to enable TCL_MEM_DEBUG. + Improved AIX 64-bit build support, allow it on AIX-4 as well. + Enable 64-bit HP-11 compilation with gcc. + Enable 64-bit IRIX64-6 cc build support. + Correct FreeBSD thread library linkage. + Add OSF1 static build support. + Improve SunOS-5 shared build SHLIB_LD macro. + +2002-07-20 Zoran Vasiljevic + + * tcl.m4: Added MINGW32 to list of systems checked for Windows build. + Also, fixes some indentation issues with "--with-XXX" options. + +2002-04-23 Jeff Hobbs + + * tcl.m4 (TEA_ENABLE_THREADS): added USE_THREAD_ALLOC define to + use new threaded allocatory by default on Unix for Tcl 8.4. + (TEA_CONFIG_CFLAGS): corrected LD_SEARCH_FLAGS for FreeBSD-3+. + +2002-04-22 Jeff Hobbs + + * tcl.m4 (TEA_SETUP_COMPILER): removed call to AC_CYGWIN so that + we can use autoconf 2.5x as well as 2.13. This prevents us from + being able to warn against the use of cygwin gcc at configure + time, but allows autoconf 2.5x, which is what is shipped with most + newer systems. + +2002-04-11 Jeff Hobbs + + * tcl.m4: Enabled COFF as well as CV style debug info with + --enable-symbols to allow Dr. Watson users to see function info. + More info on debugging levels can be obtained at: + http://msdn.microsoft.com/library/en-us/dnvc60/html/gendepdebug.asp + +2002-04-03 Jeff Hobbs + + * tcl.m4: change all SC_* macros to TEA_*. The SC_ was for + Scriptics, which is no more. TEA represents a better, independent + prefix that won't need changing. + Added preliminary mingw gcc support. [Patch #538772] + Added TEA_PREFIX macro that handles defaulting the prefix and + exec_prefix vars to those used by Tcl if none were specified. + Added TEA_SETUP_COMPILER macro that encompasses the AC_PROG_CC + check and several other basic AC_PROG checks needed for making + executables. This greatly simplifies user's configure.in files. + Collapsed AIX-5 defines into AIX-* with extra checks for doing the + ELF stuff on AIX-5-ia64. + Updated TEA_ENABLE_THREADS to take an optional arg to allow + switching it on by default (for Thread) and add sanity checking to + warn the user if configuring threads incompatibly. + +2002-03-29 Jeff Hobbs + + * tcl.m4: made sure that SHLIB_LDFLAGS was set to LDFLAGS_DEFAULT. + Removed --enable-64bit support for AIX-4 because it wasn't correct. + Added -MT or -MD Windows linker switches to properly support + symbols-enabled builds. + +2002-03-28 Jeff Hobbs + + * tcl.m4: called AC_MSG_ERROR when SC_TEA_INIT wasn't called first + instead of calling it as that inlines it each time in shell code. + Changed Windows CFLAGS_OPTIMIZE to use -O2 instead of -Oti. + Noted TCL_LIB_VERSIONS_OK=nodots for Windows builds. + A few changes to support itcl (and perhaps others): + Added support for making your own stub libraries to SC_MAKE_LIB. + New SC_PATH_CONFIG and SC_LOAD_CONFIG that take a package name arg + and find that ${pkg}Config.sh file. itk uses this for itcl. + +2002-03-27 Jeff Hobbs + + * tcl.m4: made SC_LOAD_TKCONFIG recognize when working with a Tk + build dir setup. + Added EXTRA_CFLAGS and SHLIB_LD_LIBS substs to SC_CONFIG_CFLAGS. + Added XLIBSW onto LIBS when it is defined. + Remove TCL_LIBS from MAKE_LIB and correctly use SHLIB_LD_LIBS + instead to not rely as much on tclConfig.sh cached info. + Add TK_BIN_DIR to paths to find wish in SC_PROG_WISH. + These move towards making TEA much more independent of *Config.sh. + +2002-03-19 Jeff Hobbs + + * tcl.m4: corrected forgotten (UN)SHARED_LIB_SUFFIX and + SHLIB_SUFFIX defines for Win. + (SC_PATH_X): made this only do the check on unix platforms. + +2002-03-12 Jeff Hobbs + + * README.txt: updated to reflect fewer files + +2002-03-06 Jeff Hobbs + + * config.guess (removed): + * config.sub (removed): removed unnecessary files + + * installFile.tcl (removed): + * mkinstalldirs (removed): these aren't really necessary for + making TEA work + + * tcl.m4 (SC_PUBLIC_TCL_HEADERS, SC_PUBLIC_TK_HEADERS): don't + check /usr(/local)/include for includes on Windows when not using + gcc + +2002-03-05 Jeff Hobbs + + * tcl.m4: added warnings on Windows, removed RELPATH define and + added TCL_LIBS to MAKE_LIB macro. + + This import represents 2.0.0, or a new start at attempting to + make TEA much easier for C extension developers. + + **** moved from tclpro project to core tcl project, **** + **** renamed to 'tclconfig' **** + +2001-03-15 Karl Lehenbauer + + * installFile.tcl: Added updating of the modification time of + the target file whether we overwrote it or decided that it + hadn't changed. This was necessary for us to be able to + determine whether or not a module install touched the file. + +2001-03-08 Karl Lehenbauer + + * installFile.tcl: Added support for converting new-style (1.1+) + Cygnus drive paths to Tcl-style. + +2001-01-15 + + * tcl.m4: Added FreeBSD clause. + +2001-01-03 + + * tcl.m4: Fixed typo in SC_LIB_SPEC where it is checking + for exec-prefix. + +2000-12-01 + + * tcl.m4: Concatenated most of the Ajuba acsite.m4 file + so we don't need to modify the autoconf installation. + * config.guess: + * config.sub: + * installFile.tcl: + Added files from the itcl config subdirectory, + which should go away. + +2000-7-29 + + * Fixed the use of TCL_SRC_DIR and TK_SRC_DIR within + TCL_PRIVATE_INCLUDES and TK_PRIVATE_INCLUDES to match their recent + change from $(srcdir) to $(srcdir)/.. diff --git a/tclconfig/README.txt b/tclconfig/README.txt new file mode 100644 index 0000000..59b5a3e --- /dev/null +++ b/tclconfig/README.txt @@ -0,0 +1,26 @@ +These files comprise the basic building blocks for a Tcl Extension +Architecture (TEA) extension. For more information on TEA see: + + http://www.tcl.tk/doc/tea/ + +This package is part of the Tcl project at SourceForge, and latest +sources should be available there: + + http://tcl.sourceforge.net/ + +This package is a freely available open source package. You can do +virtually anything you like with it, such as modifying it, redistributing +it, and selling it either in whole or in part. + +CONTENTS +======== +The following is a short description of the files you will find in +the sample extension. + +README.txt This file + +install-sh Program used for copying binaries and script files + to their install locations. + +tcl.m4 Collection of Tcl autoconf macros. Included by a package's + aclocal.m4 to define TEA_* macros. diff --git a/tclconfig/install-sh b/tclconfig/install-sh new file mode 100755 index 0000000..7c34c3f --- /dev/null +++ b/tclconfig/install-sh @@ -0,0 +1,528 @@ +#!/bin/sh +# install - install a program, script, or datafile + +scriptversion=2011-04-20.01; # UTC + +# This originates from X11R5 (mit/util/scripts/install.sh), which was +# later released in X11R6 (xc/config/util/install.sh) with the +# following copyright and license. +# +# Copyright (C) 1994 X Consortium +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to +# deal in the Software without restriction, including without limitation the +# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or +# sell copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# X CONSORTIUM BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN +# AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNEC- +# TION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +# +# Except as contained in this notice, the name of the X Consortium shall not +# be used in advertising or otherwise to promote the sale, use or other deal- +# ings in this Software without prior written authorization from the X Consor- +# tium. +# +# +# FSF changes to this file are in the public domain. +# +# Calling this script install-sh is preferred over install.sh, to prevent +# `make' implicit rules from creating a file called install from it +# when there is no Makefile. +# +# This script is compatible with the BSD install script, but was written +# from scratch. + +nl=' +' +IFS=" "" $nl" + +# set DOITPROG to echo to test this script + +# Don't use :- since 4.3BSD and earlier shells don't like it. +doit=${DOITPROG-} +if test -z "$doit"; then + doit_exec=exec +else + doit_exec=$doit +fi + +# Put in absolute file names if you don't have them in your path; +# or use environment vars. + +chgrpprog=${CHGRPPROG-chgrp} +chmodprog=${CHMODPROG-chmod} +chownprog=${CHOWNPROG-chown} +cmpprog=${CMPPROG-cmp} +cpprog=${CPPROG-cp} +mkdirprog=${MKDIRPROG-mkdir} +mvprog=${MVPROG-mv} +rmprog=${RMPROG-rm} +stripprog=${STRIPPROG-strip} + +posix_glob='?' +initialize_posix_glob=' + test "$posix_glob" != "?" || { + if (set -f) 2>/dev/null; then + posix_glob= + else + posix_glob=: + fi + } +' + +posix_mkdir= + +# Desired mode of installed file. +mode=0755 + +chgrpcmd= +chmodcmd=$chmodprog +chowncmd= +mvcmd=$mvprog +rmcmd="$rmprog -f" +stripcmd= + +src= +dst= +dir_arg= +dst_arg= + +copy_on_change=false +no_target_directory= + +usage="\ +Usage: $0 [OPTION]... [-T] SRCFILE DSTFILE + or: $0 [OPTION]... SRCFILES... DIRECTORY + or: $0 [OPTION]... -t DIRECTORY SRCFILES... + or: $0 [OPTION]... -d DIRECTORIES... + +In the 1st form, copy SRCFILE to DSTFILE. +In the 2nd and 3rd, copy all SRCFILES to DIRECTORY. +In the 4th, create DIRECTORIES. + +Options: + --help display this help and exit. + --version display version info and exit. + + -c (ignored) + -C install only if different (preserve the last data modification time) + -d create directories instead of installing files. + -g GROUP $chgrpprog installed files to GROUP. + -m MODE $chmodprog installed files to MODE. + -o USER $chownprog installed files to USER. + -s $stripprog installed files. + -S $stripprog installed files. + -t DIRECTORY install into DIRECTORY. + -T report an error if DSTFILE is a directory. + +Environment variables override the default commands: + CHGRPPROG CHMODPROG CHOWNPROG CMPPROG CPPROG MKDIRPROG MVPROG + RMPROG STRIPPROG +" + +while test $# -ne 0; do + case $1 in + -c) ;; + + -C) copy_on_change=true;; + + -d) dir_arg=true;; + + -g) chgrpcmd="$chgrpprog $2" + shift;; + + --help) echo "$usage"; exit $?;; + + -m) mode=$2 + case $mode in + *' '* | *' '* | *' +'* | *'*'* | *'?'* | *'['*) + echo "$0: invalid mode: $mode" >&2 + exit 1;; + esac + shift;; + + -o) chowncmd="$chownprog $2" + shift;; + + -s) stripcmd=$stripprog;; + + -S) stripcmd="$stripprog $2" + shift;; + + -t) dst_arg=$2 + shift;; + + -T) no_target_directory=true;; + + --version) echo "$0 $scriptversion"; exit $?;; + + --) shift + break;; + + -*) echo "$0: invalid option: $1" >&2 + exit 1;; + + *) break;; + esac + shift +done + +if test $# -ne 0 && test -z "$dir_arg$dst_arg"; then + # When -d is used, all remaining arguments are directories to create. + # When -t is used, the destination is already specified. + # Otherwise, the last argument is the destination. Remove it from $@. + for arg + do + if test -n "$dst_arg"; then + # $@ is not empty: it contains at least $arg. + set fnord "$@" "$dst_arg" + shift # fnord + fi + shift # arg + dst_arg=$arg + done +fi + +if test $# -eq 0; then + if test -z "$dir_arg"; then + echo "$0: no input file specified." >&2 + exit 1 + fi + # It's OK to call `install-sh -d' without argument. + # This can happen when creating conditional directories. + exit 0 +fi + +if test -z "$dir_arg"; then + do_exit='(exit $ret); exit $ret' + trap "ret=129; $do_exit" 1 + trap "ret=130; $do_exit" 2 + trap "ret=141; $do_exit" 13 + trap "ret=143; $do_exit" 15 + + # Set umask so as not to create temps with too-generous modes. + # However, 'strip' requires both read and write access to temps. + case $mode in + # Optimize common cases. + *644) cp_umask=133;; + *755) cp_umask=22;; + + *[0-7]) + if test -z "$stripcmd"; then + u_plus_rw= + else + u_plus_rw='% 200' + fi + cp_umask=`expr '(' 777 - $mode % 1000 ')' $u_plus_rw`;; + *) + if test -z "$stripcmd"; then + u_plus_rw= + else + u_plus_rw=,u+rw + fi + cp_umask=$mode$u_plus_rw;; + esac +fi + +for src +do + # Protect names starting with `-'. + case $src in + -*) src=./$src;; + esac + + if test -n "$dir_arg"; then + dst=$src + dstdir=$dst + test -d "$dstdir" + dstdir_status=$? + else + + # Waiting for this to be detected by the "$cpprog $src $dsttmp" command + # might cause directories to be created, which would be especially bad + # if $src (and thus $dsttmp) contains '*'. + if test ! -f "$src" && test ! -d "$src"; then + echo "$0: $src does not exist." >&2 + exit 1 + fi + + if test -z "$dst_arg"; then + echo "$0: no destination specified." >&2 + exit 1 + fi + + dst=$dst_arg + # Protect names starting with `-'. + case $dst in + -*) dst=./$dst;; + esac + + # If destination is a directory, append the input filename; won't work + # if double slashes aren't ignored. + if test -d "$dst"; then + if test -n "$no_target_directory"; then + echo "$0: $dst_arg: Is a directory" >&2 + exit 1 + fi + dstdir=$dst + dst=$dstdir/`basename "$src"` + dstdir_status=0 + else + # Prefer dirname, but fall back on a substitute if dirname fails. + dstdir=` + (dirname "$dst") 2>/dev/null || + expr X"$dst" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$dst" : 'X\(//\)[^/]' \| \ + X"$dst" : 'X\(//\)$' \| \ + X"$dst" : 'X\(/\)' \| . 2>/dev/null || + echo X"$dst" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q' + ` + + test -d "$dstdir" + dstdir_status=$? + fi + fi + + obsolete_mkdir_used=false + + if test $dstdir_status != 0; then + case $posix_mkdir in + '') + # Create intermediate dirs using mode 755 as modified by the umask. + # This is like FreeBSD 'install' as of 1997-10-28. + umask=`umask` + case $stripcmd.$umask in + # Optimize common cases. + *[2367][2367]) mkdir_umask=$umask;; + .*0[02][02] | .[02][02] | .[02]) mkdir_umask=22;; + + *[0-7]) + mkdir_umask=`expr $umask + 22 \ + - $umask % 100 % 40 + $umask % 20 \ + - $umask % 10 % 4 + $umask % 2 + `;; + *) mkdir_umask=$umask,go-w;; + esac + + # With -d, create the new directory with the user-specified mode. + # Otherwise, rely on $mkdir_umask. + if test -n "$dir_arg"; then + mkdir_mode=-m$mode + else + mkdir_mode= + fi + + posix_mkdir=false + case $umask in + *[123567][0-7][0-7]) + # POSIX mkdir -p sets u+wx bits regardless of umask, which + # is incompatible with FreeBSD 'install' when (umask & 300) != 0. + ;; + *) + tmpdir=${TMPDIR-/tmp}/ins$RANDOM-$$ + trap 'ret=$?; rmdir "$tmpdir/d" "$tmpdir" 2>/dev/null; exit $ret' 0 + + if (umask $mkdir_umask && + exec $mkdirprog $mkdir_mode -p -- "$tmpdir/d") >/dev/null 2>&1 + then + if test -z "$dir_arg" || { + # Check for POSIX incompatibilities with -m. + # HP-UX 11.23 and IRIX 6.5 mkdir -m -p sets group- or + # other-writeable bit of parent directory when it shouldn't. + # FreeBSD 6.1 mkdir -m -p sets mode of existing directory. + ls_ld_tmpdir=`ls -ld "$tmpdir"` + case $ls_ld_tmpdir in + d????-?r-*) different_mode=700;; + d????-?--*) different_mode=755;; + *) false;; + esac && + $mkdirprog -m$different_mode -p -- "$tmpdir" && { + ls_ld_tmpdir_1=`ls -ld "$tmpdir"` + test "$ls_ld_tmpdir" = "$ls_ld_tmpdir_1" + } + } + then posix_mkdir=: + fi + rmdir "$tmpdir/d" "$tmpdir" + else + # Remove any dirs left behind by ancient mkdir implementations. + rmdir ./$mkdir_mode ./-p ./-- 2>/dev/null + fi + trap '' 0;; + esac;; + esac + + if + $posix_mkdir && ( + umask $mkdir_umask && + $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir" + ) + then : + else + + # The umask is ridiculous, or mkdir does not conform to POSIX, + # or it failed possibly due to a race condition. Create the + # directory the slow way, step by step, checking for races as we go. + + case $dstdir in + /*) prefix='/';; + -*) prefix='./';; + *) prefix='';; + esac + + eval "$initialize_posix_glob" + + oIFS=$IFS + IFS=/ + $posix_glob set -f + set fnord $dstdir + shift + $posix_glob set +f + IFS=$oIFS + + prefixes= + + for d + do + test -z "$d" && continue + + prefix=$prefix$d + if test -d "$prefix"; then + prefixes= + else + if $posix_mkdir; then + (umask=$mkdir_umask && + $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir") && break + # Don't fail if two instances are running concurrently. + test -d "$prefix" || exit 1 + else + case $prefix in + *\'*) qprefix=`echo "$prefix" | sed "s/'/'\\\\\\\\''/g"`;; + *) qprefix=$prefix;; + esac + prefixes="$prefixes '$qprefix'" + fi + fi + prefix=$prefix/ + done + + if test -n "$prefixes"; then + # Don't fail if two instances are running concurrently. + (umask $mkdir_umask && + eval "\$doit_exec \$mkdirprog $prefixes") || + test -d "$dstdir" || exit 1 + obsolete_mkdir_used=true + fi + fi + fi + + if test -n "$dir_arg"; then + { test -z "$chowncmd" || $doit $chowncmd "$dst"; } && + { test -z "$chgrpcmd" || $doit $chgrpcmd "$dst"; } && + { test "$obsolete_mkdir_used$chowncmd$chgrpcmd" = false || + test -z "$chmodcmd" || $doit $chmodcmd $mode "$dst"; } || exit 1 + else + + # Make a couple of temp file names in the proper directory. + dsttmp=$dstdir/_inst.$$_ + rmtmp=$dstdir/_rm.$$_ + + # Trap to clean up those temp files at exit. + trap 'ret=$?; rm -f "$dsttmp" "$rmtmp" && exit $ret' 0 + + # Copy the file name to the temp name. + (umask $cp_umask && $doit_exec $cpprog "$src" "$dsttmp") && + + # and set any options; do chmod last to preserve setuid bits. + # + # If any of these fail, we abort the whole thing. If we want to + # ignore errors from any of these, just make sure not to ignore + # errors from the above "$doit $cpprog $src $dsttmp" command. + # + { test -z "$chowncmd" || $doit $chowncmd "$dsttmp"; } && + { test -z "$chgrpcmd" || $doit $chgrpcmd "$dsttmp"; } && + { test -z "$stripcmd" || $doit $stripcmd "$dsttmp"; } && + { test -z "$chmodcmd" || $doit $chmodcmd $mode "$dsttmp"; } && + + # If -C, don't bother to copy if it wouldn't change the file. + if $copy_on_change && + old=`LC_ALL=C ls -dlL "$dst" 2>/dev/null` && + new=`LC_ALL=C ls -dlL "$dsttmp" 2>/dev/null` && + + eval "$initialize_posix_glob" && + $posix_glob set -f && + set X $old && old=:$2:$4:$5:$6 && + set X $new && new=:$2:$4:$5:$6 && + $posix_glob set +f && + + test "$old" = "$new" && + $cmpprog "$dst" "$dsttmp" >/dev/null 2>&1 + then + rm -f "$dsttmp" + else + # Rename the file to the real destination. + $doit $mvcmd -f "$dsttmp" "$dst" 2>/dev/null || + + # The rename failed, perhaps because mv can't rename something else + # to itself, or perhaps because mv is so ancient that it does not + # support -f. + { + # Now remove or move aside any old file at destination location. + # We try this two ways since rm can't unlink itself on some + # systems and the destination file might be busy for other + # reasons. In this case, the final cleanup might fail but the new + # file should still install successfully. + { + test ! -f "$dst" || + $doit $rmcmd -f "$dst" 2>/dev/null || + { $doit $mvcmd -f "$dst" "$rmtmp" 2>/dev/null && + { $doit $rmcmd -f "$rmtmp" 2>/dev/null; :; } + } || + { echo "$0: cannot unlink or rename $dst" >&2 + (exit 1); exit 1 + } + } && + + # Now rename the file to the real destination. + $doit $mvcmd "$dsttmp" "$dst" + } + fi || exit 1 + + trap '' 0 + fi +done + +# Local variables: +# eval: (add-hook 'write-file-hooks 'time-stamp) +# time-stamp-start: "scriptversion=" +# time-stamp-format: "%:y-%02m-%02d.%02H" +# time-stamp-time-zone: "UTC" +# time-stamp-end: "; # UTC" +# End: diff --git a/tclconfig/tcl.m4 b/tclconfig/tcl.m4 new file mode 100644 index 0000000..655be25 --- /dev/null +++ b/tclconfig/tcl.m4 @@ -0,0 +1,4176 @@ +# tcl.m4 -- +# +# This file provides a set of autoconf macros to help TEA-enable +# a Tcl extension. +# +# Copyright (c) 1999-2000 Ajuba Solutions. +# Copyright (c) 2002-2005 ActiveState Corporation. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. + +AC_PREREQ(2.57) + +# Possible values for key variables defined: +# +# TEA_WINDOWINGSYSTEM - win32 aqua x11 (mirrors 'tk windowingsystem') +# TEA_PLATFORM - windows unix +# TEA_TK_EXTENSION - True if this is a Tk extension +# + +#------------------------------------------------------------------------ +# TEA_PATH_TCLCONFIG -- +# +# Locate the tclConfig.sh file and perform a sanity check on +# the Tcl compile flags +# +# Arguments: +# none +# +# Results: +# +# Adds the following arguments to configure: +# --with-tcl=... +# +# Defines the following vars: +# TCL_BIN_DIR Full path to the directory containing +# the tclConfig.sh file +#------------------------------------------------------------------------ + +AC_DEFUN([TEA_PATH_TCLCONFIG], [ + dnl TEA specific: Make sure we are initialized + AC_REQUIRE([TEA_INIT]) + # + # Ok, lets find the tcl configuration + # First, look for one uninstalled. + # the alternative search directory is invoked by --with-tcl + # + + if test x"${no_tcl}" = x ; then + # we reset no_tcl in case something fails here + no_tcl=true + AC_ARG_WITH(tcl, + AC_HELP_STRING([--with-tcl], + [directory containing tcl configuration (tclConfig.sh)]), + with_tclconfig="${withval}") + AC_MSG_CHECKING([for Tcl configuration]) + AC_CACHE_VAL(ac_cv_c_tclconfig,[ + + # First check to see if --with-tcl was specified. + if test x"${with_tclconfig}" != x ; then + case "${with_tclconfig}" in + */tclConfig.sh ) + if test -f "${with_tclconfig}"; then + AC_MSG_WARN([--with-tcl argument should refer to directory containing tclConfig.sh, not to tclConfig.sh itself]) + with_tclconfig="`echo "${with_tclconfig}" | sed 's!/tclConfig\.sh$!!'`" + fi ;; + esac + if test -f "${with_tclconfig}/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd "${with_tclconfig}"; pwd)`" + else + AC_MSG_ERROR([${with_tclconfig} directory doesn't contain tclConfig.sh]) + fi + fi + + # then check for a private Tcl installation + if test x"${ac_cv_c_tclconfig}" = x ; then + for i in \ + ../tcl \ + `ls -dr ../tcl[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ + `ls -dr ../tcl[[8-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../tcl[[8-9]].[[0-9]]* 2>/dev/null` \ + ../../tcl \ + `ls -dr ../../tcl[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ + `ls -dr ../../tcl[[8-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../../tcl[[8-9]].[[0-9]]* 2>/dev/null` \ + ../../../tcl \ + `ls -dr ../../../tcl[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ + `ls -dr ../../../tcl[[8-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../../../tcl[[8-9]].[[0-9]]* 2>/dev/null` ; do + if test "${TEA_PLATFORM}" = "windows" \ + -a -f "$i/win/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd $i/win; pwd)`" + break + fi + if test -f "$i/unix/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd $i/unix; pwd)`" + break + fi + done + fi + + # on Darwin, check in Framework installation locations + if test "`uname -s`" = "Darwin" -a x"${ac_cv_c_tclconfig}" = x ; then + for i in `ls -d ~/Library/Frameworks 2>/dev/null` \ + `ls -d /Library/Frameworks 2>/dev/null` \ + `ls -d /Network/Library/Frameworks 2>/dev/null` \ + `ls -d /System/Library/Frameworks 2>/dev/null` \ + `ls -d /Applications/Xcode.app/Contents/Developer/Platforms/MacOSX.platform/Developer/SDKs/MacOSX.sdk/Library/Frameworks/Tcl.framework 2>/dev/null` \ + `ls -d /Applications/Xcode.app/Contents/Developer/Platforms/MacOSX.platform/Developer/SDKs/MacOSX.sdk/Network/Library/Frameworks/Tcl.framework 2>/dev/null` \ + `ls -d /Applications/Xcode.app/Contents/Developer/Platforms/MacOSX.platform/Developer/SDKs/MacOSX.sdk/System/Library/Frameworks/Tcl.framework 2>/dev/null` \ + ; do + if test -f "$i/Tcl.framework/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd $i/Tcl.framework; pwd)`" + break + fi + done + fi + + # TEA specific: on Windows, check in common installation locations + if test "${TEA_PLATFORM}" = "windows" \ + -a x"${ac_cv_c_tclconfig}" = x ; then + for i in `ls -d C:/Tcl/lib 2>/dev/null` \ + `ls -d C:/Progra~1/Tcl/lib 2>/dev/null` \ + ; do + if test -f "$i/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd $i; pwd)`" + break + fi + done + fi + + # check in a few common install locations + if test x"${ac_cv_c_tclconfig}" = x ; then + for i in `ls -d ${libdir} 2>/dev/null` \ + `ls -d ${exec_prefix}/lib 2>/dev/null` \ + `ls -d ${prefix}/lib 2>/dev/null` \ + `ls -d /usr/local/lib 2>/dev/null` \ + `ls -d /usr/contrib/lib 2>/dev/null` \ + `ls -d /usr/pkg/lib 2>/dev/null` \ + `ls -d /usr/lib 2>/dev/null` \ + `ls -d /usr/lib64 2>/dev/null` \ + `ls -d /usr/lib/tcl8.6 2>/dev/null` \ + `ls -d /usr/lib/tcl8.5 2>/dev/null` \ + `ls -d /usr/local/lib/tcl8.6 2>/dev/null` \ + `ls -d /usr/local/lib/tcl8.5 2>/dev/null` \ + `ls -d /usr/local/lib/tcl/tcl8.6 2>/dev/null` \ + `ls -d /usr/local/lib/tcl/tcl8.5 2>/dev/null` \ + ; do + if test -f "$i/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd $i; pwd)`" + break + fi + done + fi + + # check in a few other private locations + if test x"${ac_cv_c_tclconfig}" = x ; then + for i in \ + ${srcdir}/../tcl \ + `ls -dr ${srcdir}/../tcl[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ + `ls -dr ${srcdir}/../tcl[[8-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ${srcdir}/../tcl[[8-9]].[[0-9]]* 2>/dev/null` ; do + if test "${TEA_PLATFORM}" = "windows" \ + -a -f "$i/win/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd $i/win; pwd)`" + break + fi + if test -f "$i/unix/tclConfig.sh" ; then + ac_cv_c_tclconfig="`(cd $i/unix; pwd)`" + break + fi + done + fi + ]) + + if test x"${ac_cv_c_tclconfig}" = x ; then + TCL_BIN_DIR="# no Tcl configs found" + AC_MSG_ERROR([Can't find Tcl configuration definitions. Use --with-tcl to specify a directory containing tclConfig.sh]) + else + no_tcl= + TCL_BIN_DIR="${ac_cv_c_tclconfig}" + AC_MSG_RESULT([found ${TCL_BIN_DIR}/tclConfig.sh]) + fi + fi +]) + +#------------------------------------------------------------------------ +# TEA_PATH_TKCONFIG -- +# +# Locate the tkConfig.sh file +# +# Arguments: +# none +# +# Results: +# +# Adds the following arguments to configure: +# --with-tk=... +# +# Defines the following vars: +# TK_BIN_DIR Full path to the directory containing +# the tkConfig.sh file +#------------------------------------------------------------------------ + +AC_DEFUN([TEA_PATH_TKCONFIG], [ + # + # Ok, lets find the tk configuration + # First, look for one uninstalled. + # the alternative search directory is invoked by --with-tk + # + + if test x"${no_tk}" = x ; then + # we reset no_tk in case something fails here + no_tk=true + AC_ARG_WITH(tk, + AC_HELP_STRING([--with-tk], + [directory containing tk configuration (tkConfig.sh)]), + with_tkconfig="${withval}") + AC_MSG_CHECKING([for Tk configuration]) + AC_CACHE_VAL(ac_cv_c_tkconfig,[ + + # First check to see if --with-tkconfig was specified. + if test x"${with_tkconfig}" != x ; then + case "${with_tkconfig}" in + */tkConfig.sh ) + if test -f "${with_tkconfig}"; then + AC_MSG_WARN([--with-tk argument should refer to directory containing tkConfig.sh, not to tkConfig.sh itself]) + with_tkconfig="`echo "${with_tkconfig}" | sed 's!/tkConfig\.sh$!!'`" + fi ;; + esac + if test -f "${with_tkconfig}/tkConfig.sh" ; then + ac_cv_c_tkconfig="`(cd "${with_tkconfig}"; pwd)`" + else + AC_MSG_ERROR([${with_tkconfig} directory doesn't contain tkConfig.sh]) + fi + fi + + # then check for a private Tk library + if test x"${ac_cv_c_tkconfig}" = x ; then + for i in \ + ../tk \ + `ls -dr ../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ + `ls -dr ../tk[[8-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../tk[[8-9]].[[0-9]]* 2>/dev/null` \ + ../../tk \ + `ls -dr ../../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ + `ls -dr ../../tk[[8-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../../tk[[8-9]].[[0-9]]* 2>/dev/null` \ + ../../../tk \ + `ls -dr ../../../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ + `ls -dr ../../../tk[[8-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../../../tk[[8-9]].[[0-9]]* 2>/dev/null` ; do + if test "${TEA_PLATFORM}" = "windows" \ + -a -f "$i/win/tkConfig.sh" ; then + ac_cv_c_tkconfig="`(cd $i/win; pwd)`" + break + fi + if test -f "$i/unix/tkConfig.sh" ; then + ac_cv_c_tkconfig="`(cd $i/unix; pwd)`" + break + fi + done + fi + + # on Darwin, check in Framework installation locations + if test "`uname -s`" = "Darwin" -a x"${ac_cv_c_tkconfig}" = x ; then + for i in `ls -d ~/Library/Frameworks 2>/dev/null` \ + `ls -d /Library/Frameworks 2>/dev/null` \ + `ls -d /Network/Library/Frameworks 2>/dev/null` \ + `ls -d /System/Library/Frameworks 2>/dev/null` \ + `ls -d /Applications/Xcode.app/Contents/Developer/Platforms/MacOSX.platform/Developer/SDKs/MacOSX.sdk/Library/Frameworks/Tcl.framework 2>/dev/null` \ + `ls -d /Applications/Xcode.app/Contents/Developer/Platforms/MacOSX.platform/Developer/SDKs/MacOSX.sdk/Network/Library/Frameworks/Tcl.framework 2>/dev/null` \ + `ls -d /Applications/Xcode.app/Contents/Developer/Platforms/MacOSX.platform/Developer/SDKs/MacOSX.sdk/System/Library/Frameworks/Tcl.framework 2>/dev/null` \ + ; do + if test -f "$i/Tk.framework/tkConfig.sh" ; then + ac_cv_c_tkconfig="`(cd $i/Tk.framework; pwd)`" + break + fi + done + fi + + # check in a few common install locations + if test x"${ac_cv_c_tkconfig}" = x ; then + for i in `ls -d ${libdir} 2>/dev/null` \ + `ls -d ${exec_prefix}/lib 2>/dev/null` \ + `ls -d ${prefix}/lib 2>/dev/null` \ + `ls -d /usr/local/lib 2>/dev/null` \ + `ls -d /usr/contrib/lib 2>/dev/null` \ + `ls -d /usr/pkg/lib 2>/dev/null` \ + `ls -d /usr/lib 2>/dev/null` \ + `ls -d /usr/lib64 2>/dev/null` \ + `ls -d /usr/lib/tk8.6 2>/dev/null` \ + `ls -d /usr/lib/tk8.5 2>/dev/null` \ + `ls -d /usr/local/lib/tk8.6 2>/dev/null` \ + `ls -d /usr/local/lib/tk8.5 2>/dev/null` \ + `ls -d /usr/local/lib/tcl/tk8.6 2>/dev/null` \ + `ls -d /usr/local/lib/tcl/tk8.5 2>/dev/null` \ + ; do + if test -f "$i/tkConfig.sh" ; then + ac_cv_c_tkconfig="`(cd $i; pwd)`" + break + fi + done + fi + + # TEA specific: on Windows, check in common installation locations + if test "${TEA_PLATFORM}" = "windows" \ + -a x"${ac_cv_c_tkconfig}" = x ; then + for i in `ls -d C:/Tcl/lib 2>/dev/null` \ + `ls -d C:/Progra~1/Tcl/lib 2>/dev/null` \ + ; do + if test -f "$i/tkConfig.sh" ; then + ac_cv_c_tkconfig="`(cd $i; pwd)`" + break + fi + done + fi + + # check in a few other private locations + if test x"${ac_cv_c_tkconfig}" = x ; then + for i in \ + ${srcdir}/../tk \ + `ls -dr ${srcdir}/../tk[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \ + `ls -dr ${srcdir}/../tk[[8-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ${srcdir}/../tk[[8-9]].[[0-9]]* 2>/dev/null` ; do + if test "${TEA_PLATFORM}" = "windows" \ + -a -f "$i/win/tkConfig.sh" ; then + ac_cv_c_tkconfig="`(cd $i/win; pwd)`" + break + fi + if test -f "$i/unix/tkConfig.sh" ; then + ac_cv_c_tkconfig="`(cd $i/unix; pwd)`" + break + fi + done + fi + ]) + + if test x"${ac_cv_c_tkconfig}" = x ; then + TK_BIN_DIR="# no Tk configs found" + AC_MSG_ERROR([Can't find Tk configuration definitions. Use --with-tk to specify a directory containing tkConfig.sh]) + else + no_tk= + TK_BIN_DIR="${ac_cv_c_tkconfig}" + AC_MSG_RESULT([found ${TK_BIN_DIR}/tkConfig.sh]) + fi + fi +]) + +#------------------------------------------------------------------------ +# TEA_LOAD_TCLCONFIG -- +# +# Load the tclConfig.sh file +# +# Arguments: +# +# Requires the following vars to be set: +# TCL_BIN_DIR +# +# Results: +# +# Substitutes the following vars: +# TCL_BIN_DIR +# TCL_SRC_DIR +# TCL_LIB_FILE +# TCL_ZIP_FILE +# TCL_ZIPFS_SUPPORT +#------------------------------------------------------------------------ + +AC_DEFUN([TEA_LOAD_TCLCONFIG], [ + AC_MSG_CHECKING([for existence of ${TCL_BIN_DIR}/tclConfig.sh]) + + if test -f "${TCL_BIN_DIR}/tclConfig.sh" ; then + AC_MSG_RESULT([loading]) + . "${TCL_BIN_DIR}/tclConfig.sh" + else + AC_MSG_RESULT([could not find ${TCL_BIN_DIR}/tclConfig.sh]) + fi + + # eval is required to do the TCL_DBGX substitution + eval "TCL_LIB_FILE=\"${TCL_LIB_FILE}\"" + eval "TCL_STUB_LIB_FILE=\"${TCL_STUB_LIB_FILE}\"" + + # If the TCL_BIN_DIR is the build directory (not the install directory), + # then set the common variable name to the value of the build variables. + # For example, the variable TCL_LIB_SPEC will be set to the value + # of TCL_BUILD_LIB_SPEC. An extension should make use of TCL_LIB_SPEC + # instead of TCL_BUILD_LIB_SPEC since it will work with both an + # installed and uninstalled version of Tcl. + if test -f "${TCL_BIN_DIR}/Makefile" ; then + TCL_LIB_SPEC="${TCL_BUILD_LIB_SPEC}" + TCL_STUB_LIB_SPEC="${TCL_BUILD_STUB_LIB_SPEC}" + TCL_STUB_LIB_PATH="${TCL_BUILD_STUB_LIB_PATH}" + elif test "`uname -s`" = "Darwin"; then + # If Tcl was built as a framework, attempt to use the libraries + # from the framework at the given location so that linking works + # against Tcl.framework installed in an arbitrary location. + case ${TCL_DEFS} in + *TCL_FRAMEWORK*) + if test -f "${TCL_BIN_DIR}/${TCL_LIB_FILE}"; then + for i in "`cd "${TCL_BIN_DIR}"; pwd`" \ + "`cd "${TCL_BIN_DIR}"/../..; pwd`"; do + if test "`basename "$i"`" = "${TCL_LIB_FILE}.framework"; then + TCL_LIB_SPEC="-F`dirname "$i" | sed -e 's/ /\\\\ /g'` -framework ${TCL_LIB_FILE}" + break + fi + done + fi + if test -f "${TCL_BIN_DIR}/${TCL_STUB_LIB_FILE}"; then + TCL_STUB_LIB_SPEC="-L`echo "${TCL_BIN_DIR}" | sed -e 's/ /\\\\ /g'` ${TCL_STUB_LIB_FLAG}" + TCL_STUB_LIB_PATH="${TCL_BIN_DIR}/${TCL_STUB_LIB_FILE}" + fi + ;; + esac + fi + + # eval is required to do the TCL_DBGX substitution + eval "TCL_LIB_FLAG=\"${TCL_LIB_FLAG}\"" + eval "TCL_LIB_SPEC=\"${TCL_LIB_SPEC}\"" + eval "TCL_STUB_LIB_FLAG=\"${TCL_STUB_LIB_FLAG}\"" + eval "TCL_STUB_LIB_SPEC=\"${TCL_STUB_LIB_SPEC}\"" + + AC_SUBST(TCL_VERSION) + AC_SUBST(TCL_PATCH_LEVEL) + AC_SUBST(TCL_BIN_DIR) + AC_SUBST(TCL_SRC_DIR) + + AC_SUBST(TCL_LIB_FILE) + AC_SUBST(TCL_LIB_FLAG) + AC_SUBST(TCL_LIB_SPEC) + + AC_SUBST(TCL_STUB_LIB_FILE) + AC_SUBST(TCL_STUB_LIB_FLAG) + AC_SUBST(TCL_STUB_LIB_SPEC) + + AC_MSG_CHECKING([platform]) + hold_cc=$CC; CC="$TCL_CC" + AC_TRY_COMPILE(,[ + #ifdef _WIN32 + #error win32 + #endif + ], [ + TEA_PLATFORM="unix" + CYGPATH=echo + ], [ + TEA_PLATFORM="windows" + AC_CHECK_PROG(CYGPATH, cygpath, cygpath -m, echo) ] + ) + CC=$hold_cc + AC_MSG_RESULT($TEA_PLATFORM) + + # The BUILD_$pkg is to define the correct extern storage class + # handling when making this package + AC_DEFINE_UNQUOTED(BUILD_${PACKAGE_NAME}, [], + [Building extension source?]) + # Do this here as we have fully defined TEA_PLATFORM now + if test "${TEA_PLATFORM}" = "windows" ; then + EXEEXT=".exe" + CLEANFILES="$CLEANFILES *.lib *.dll *.pdb *.exp" + fi + + # TEA specific: + AC_SUBST(CLEANFILES) + AC_SUBST(TCL_LIBS) + AC_SUBST(TCL_DEFS) + AC_SUBST(TCL_EXTRA_CFLAGS) + AC_SUBST(TCL_LD_FLAGS) + AC_SUBST(TCL_SHLIB_LD_LIBS) +]) + +#------------------------------------------------------------------------ +# TEA_LOAD_TKCONFIG -- +# +# Load the tkConfig.sh file +# +# Arguments: +# +# Requires the following vars to be set: +# TK_BIN_DIR +# +# Results: +# +# Sets the following vars that should be in tkConfig.sh: +# TK_BIN_DIR +#------------------------------------------------------------------------ + +AC_DEFUN([TEA_LOAD_TKCONFIG], [ + AC_MSG_CHECKING([for existence of ${TK_BIN_DIR}/tkConfig.sh]) + + if test -f "${TK_BIN_DIR}/tkConfig.sh" ; then + AC_MSG_RESULT([loading]) + . "${TK_BIN_DIR}/tkConfig.sh" + else + AC_MSG_RESULT([could not find ${TK_BIN_DIR}/tkConfig.sh]) + fi + + # eval is required to do the TK_DBGX substitution + eval "TK_LIB_FILE=\"${TK_LIB_FILE}\"" + eval "TK_STUB_LIB_FILE=\"${TK_STUB_LIB_FILE}\"" + + # If the TK_BIN_DIR is the build directory (not the install directory), + # then set the common variable name to the value of the build variables. + # For example, the variable TK_LIB_SPEC will be set to the value + # of TK_BUILD_LIB_SPEC. An extension should make use of TK_LIB_SPEC + # instead of TK_BUILD_LIB_SPEC since it will work with both an + # installed and uninstalled version of Tcl. + if test -f "${TK_BIN_DIR}/Makefile" ; then + TK_LIB_SPEC="${TK_BUILD_LIB_SPEC}" + TK_STUB_LIB_SPEC="${TK_BUILD_STUB_LIB_SPEC}" + TK_STUB_LIB_PATH="${TK_BUILD_STUB_LIB_PATH}" + elif test "`uname -s`" = "Darwin"; then + # If Tk was built as a framework, attempt to use the libraries + # from the framework at the given location so that linking works + # against Tk.framework installed in an arbitrary location. + case ${TK_DEFS} in + *TK_FRAMEWORK*) + if test -f "${TK_BIN_DIR}/${TK_LIB_FILE}"; then + for i in "`cd "${TK_BIN_DIR}"; pwd`" \ + "`cd "${TK_BIN_DIR}"/../..; pwd`"; do + if test "`basename "$i"`" = "${TK_LIB_FILE}.framework"; then + TK_LIB_SPEC="-F`dirname "$i" | sed -e 's/ /\\\\ /g'` -framework ${TK_LIB_FILE}" + break + fi + done + fi + if test -f "${TK_BIN_DIR}/${TK_STUB_LIB_FILE}"; then + TK_STUB_LIB_SPEC="-L` echo "${TK_BIN_DIR}" | sed -e 's/ /\\\\ /g'` ${TK_STUB_LIB_FLAG}" + TK_STUB_LIB_PATH="${TK_BIN_DIR}/${TK_STUB_LIB_FILE}" + fi + ;; + esac + fi + + # eval is required to do the TK_DBGX substitution + eval "TK_LIB_FLAG=\"${TK_LIB_FLAG}\"" + eval "TK_LIB_SPEC=\"${TK_LIB_SPEC}\"" + eval "TK_STUB_LIB_FLAG=\"${TK_STUB_LIB_FLAG}\"" + eval "TK_STUB_LIB_SPEC=\"${TK_STUB_LIB_SPEC}\"" + + # TEA specific: Ensure windowingsystem is defined + if test "${TEA_PLATFORM}" = "unix" ; then + case ${TK_DEFS} in + *MAC_OSX_TK*) + AC_DEFINE(MAC_OSX_TK, 1, [Are we building against Mac OS X TkAqua?]) + TEA_WINDOWINGSYSTEM="aqua" + ;; + *) + TEA_WINDOWINGSYSTEM="x11" + ;; + esac + elif test "${TEA_PLATFORM}" = "windows" ; then + TEA_WINDOWINGSYSTEM="win32" + fi + + AC_SUBST(TK_VERSION) + AC_SUBST(TK_BIN_DIR) + AC_SUBST(TK_SRC_DIR) + + AC_SUBST(TK_LIB_FILE) + AC_SUBST(TK_LIB_FLAG) + AC_SUBST(TK_LIB_SPEC) + + AC_SUBST(TK_STUB_LIB_FILE) + AC_SUBST(TK_STUB_LIB_FLAG) + AC_SUBST(TK_STUB_LIB_SPEC) + + # TEA specific: + AC_SUBST(TK_LIBS) + AC_SUBST(TK_XINCLUDES) +]) + +#------------------------------------------------------------------------ +# TEA_PROG_TCLSH +# Determine the fully qualified path name of the tclsh executable +# in the Tcl build directory or the tclsh installed in a bin +# directory. This macro will correctly determine the name +# of the tclsh executable even if tclsh has not yet been +# built in the build directory. The tclsh found is always +# associated with a tclConfig.sh file. This tclsh should be used +# only for running extension test cases. It should never be +# or generation of files (like pkgIndex.tcl) at build time. +# +# Arguments: +# none +# +# Results: +# Substitutes the following vars: +# TCLSH_PROG +#------------------------------------------------------------------------ + +AC_DEFUN([TEA_PROG_TCLSH], [ + AC_MSG_CHECKING([for tclsh]) + if test -f "${TCL_BIN_DIR}/Makefile" ; then + # tclConfig.sh is in Tcl build directory + if test "${TEA_PLATFORM}" = "windows"; then + if test -f "${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}${EXEEXT}" ; then + TCLSH_PROG="${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}${EXEEXT}" + elif test -f "${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}s${EXEEXT}" ; then + TCLSH_PROG="${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}s${EXEEXT}" + elif test -f "${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}t${EXEEXT}" ; then + TCLSH_PROG="${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}t${EXEEXT}" + elif test -f "${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}st${EXEEXT}" ; then + TCLSH_PROG="${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}st${EXEEXT}" + fi + else + TCLSH_PROG="${TCL_BIN_DIR}/tclsh" + fi + else + # tclConfig.sh is in install location + if test "${TEA_PLATFORM}" = "windows"; then + TCLSH_PROG="tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}${EXEEXT}" + else + TCLSH_PROG="tclsh${TCL_MAJOR_VERSION}.${TCL_MINOR_VERSION}${TCL_DBGX}" + fi + list="`ls -d ${TCL_BIN_DIR}/../bin 2>/dev/null` \ + `ls -d ${TCL_BIN_DIR}/.. 2>/dev/null` \ + `ls -d ${TCL_PREFIX}/bin 2>/dev/null`" + for i in $list ; do + if test -f "$i/${TCLSH_PROG}" ; then + REAL_TCL_BIN_DIR="`cd "$i"; pwd`/" + break + fi + done + TCLSH_PROG="${REAL_TCL_BIN_DIR}${TCLSH_PROG}" + fi + AC_MSG_RESULT([${TCLSH_PROG}]) + AC_SUBST(TCLSH_PROG) +]) + +#------------------------------------------------------------------------ +# TEA_PROG_WISH +# Determine the fully qualified path name of the wish executable +# in the Tk build directory or the wish installed in a bin +# directory. This macro will correctly determine the name +# of the wish executable even if wish has not yet been +# built in the build directory. The wish found is always +# associated with a tkConfig.sh file. This wish should be used +# only for running extension test cases. It should never be +# or generation of files (like pkgIndex.tcl) at build time. +# +# Arguments: +# none +# +# Results: +# Substitutes the following vars: +# WISH_PROG +#------------------------------------------------------------------------ + +AC_DEFUN([TEA_PROG_WISH], [ + AC_MSG_CHECKING([for wish]) + if test -f "${TK_BIN_DIR}/Makefile" ; then + # tkConfig.sh is in Tk build directory + if test "${TEA_PLATFORM}" = "windows"; then + if test -f "${TK_BIN_DIR}/wish${TK_MAJOR_VERSION}${TK_MINOR_VERSION}${TK_DBGX}${EXEEXT}" ; then + WISH_PROG="${TK_BIN_DIR}/wish${TK_MAJOR_VERSION}${TK_MINOR_VERSION}${TK_DBGX}${EXEEXT}" + elif test -f "${TK_BIN_DIR}/wish${TK_MAJOR_VERSION}${TK_MINOR_VERSION}${TK_DBGX}s${EXEEXT}" ; then + WISH_PROG="${TK_BIN_DIR}/wish${TK_MAJOR_VERSION}${TK_MINOR_VERSION}${TK_DBGX}$s{EXEEXT}" + elif test -f "${TK_BIN_DIR}/wish${TK_MAJOR_VERSION}${TK_MINOR_VERSION}${TK_DBGX}t${EXEEXT}" ; then + WISH_PROG="${TK_BIN_DIR}/wish${TK_MAJOR_VERSION}${TK_MINOR_VERSION}${TK_DBGX}t${EXEEXT}" + elif test -f "${TK_BIN_DIR}/wish${TK_MAJOR_VERSION}${TK_MINOR_VERSION}${TK_DBGX}st${EXEEXT}" ; then + WISH_PROG="${TK_BIN_DIR}/wish${TK_MAJOR_VERSION}${TK_MINOR_VERSION}${TK_DBGX}st${EXEEXT}" + fi + else + WISH_PROG="${TK_BIN_DIR}/wish" + fi + else + # tkConfig.sh is in install location + if test "${TEA_PLATFORM}" = "windows"; then + WISH_PROG="wish${TK_MAJOR_VERSION}${TK_MINOR_VERSION}${TK_DBGX}${EXEEXT}" + else + WISH_PROG="wish${TK_MAJOR_VERSION}.${TK_MINOR_VERSION}${TK_DBGX}" + fi + list="`ls -d ${TK_BIN_DIR}/../bin 2>/dev/null` \ + `ls -d ${TK_BIN_DIR}/.. 2>/dev/null` \ + `ls -d ${TK_PREFIX}/bin 2>/dev/null`" + for i in $list ; do + if test -f "$i/${WISH_PROG}" ; then + REAL_TK_BIN_DIR="`cd "$i"; pwd`/" + break + fi + done + WISH_PROG="${REAL_TK_BIN_DIR}${WISH_PROG}" + fi + AC_MSG_RESULT([${WISH_PROG}]) + AC_SUBST(WISH_PROG) +]) + +#------------------------------------------------------------------------ +# TEA_ENABLE_SHARED -- +# +# Allows the building of shared libraries +# +# Arguments: +# none +# +# Results: +# +# Adds the following arguments to configure: +# --enable-shared=yes|no +# --enable-stubs=yes|no +# +# Defines the following vars: +# STATIC_BUILD Used for building import/export libraries +# on Windows. +# +# Sets the following vars: +# SHARED_BUILD Value of 1 or 0 +# STUBS_BUILD Value if 1 or 0 +# USE_TCL_STUBS Value true: if SHARED_BUILD or --enable-stubs +# USE_TCLOO_STUBS Value true: if SHARED_BUILD or --enable-stubs +# USE_TK_STUBS Value true: if SHARED_BUILD or --enable-stubs +# AND TEA_WINDOWING_SYSTEM != "" +#------------------------------------------------------------------------ +AC_DEFUN([TEA_ENABLE_SHARED], [ + AC_MSG_CHECKING([how to build libraries]) + AC_ARG_ENABLE(shared, + AC_HELP_STRING([--enable-shared], + [build and link with shared libraries (default: on)]), + [shared_ok=$enableval], [shared_ok=yes]) + + if test "${enable_shared+set}" = set; then + enableval="$enable_shared" + shared_ok=$enableval + else + shared_ok=yes + fi + + AC_ARG_ENABLE(stubs, + AC_HELP_STRING([--enable-stubs], + [build and link with stub libraries. Always true for shared builds (default: on)]), + [stubs_ok=$enableval], [stubs_ok=yes]) + + if test "${enable_stubs+set}" = set; then + enableval="$enable_stubs" + stubs_ok=$enableval + else + stubs_ok=yes + fi + + # Stubs are always enabled for shared builds + if test "$shared_ok" = "yes" ; then + AC_MSG_RESULT([shared]) + SHARED_BUILD=1 + STUBS_BUILD=1 + else + AC_MSG_RESULT([static]) + SHARED_BUILD=0 + AC_DEFINE(STATIC_BUILD, 1, [This a static build]) + if test "$stubs_ok" = "yes" ; then + STUBS_BUILD=1 + else + STUBS_BUILD=0 + fi + fi + if test "${STUBS_BUILD}" = "1" ; then + AC_DEFINE(USE_TCL_STUBS, 1, [Use Tcl stubs]) + AC_DEFINE(USE_TCLOO_STUBS, 1, [Use TclOO stubs]) + if test "${TEA_WINDOWINGSYSTEM}" != ""; then + AC_DEFINE(USE_TK_STUBS, 1, [Use Tk stubs]) + fi + fi + + AC_SUBST(SHARED_BUILD) + AC_SUBST(STUBS_BUILD) +]) + +#------------------------------------------------------------------------ +# TEA_ENABLE_THREADS -- +# +# Specify if thread support should be enabled. If "yes" is specified +# as an arg (optional), threads are enabled by default, "no" means +# threads are disabled. "yes" is the default. +# +# TCL_THREADS is checked so that if you are compiling an extension +# against a threaded core, your extension must be compiled threaded +# as well. +# +# Note that it is legal to have a thread enabled extension run in a +# threaded or non-threaded Tcl core, but a non-threaded extension may +# only run in a non-threaded Tcl core. +# +# Arguments: +# none +# +# Results: +# +# Adds the following arguments to configure: +# --enable-threads +# +# Sets the following vars: +# THREADS_LIBS Thread library(s) +# +# Defines the following vars: +# TCL_THREADS +# _REENTRANT +# _THREAD_SAFE +#------------------------------------------------------------------------ + +AC_DEFUN([TEA_ENABLE_THREADS], [ + AC_ARG_ENABLE(threads, + AC_HELP_STRING([--enable-threads], + [build with threads (default: on)]), + [tcl_ok=$enableval], [tcl_ok=yes]) + + if test "${enable_threads+set}" = set; then + enableval="$enable_threads" + tcl_ok=$enableval + else + tcl_ok=yes + fi + + if test "$tcl_ok" = "yes" -o "${TCL_THREADS}" = 1; then + TCL_THREADS=1 + + if test "${TEA_PLATFORM}" != "windows" ; then + # We are always OK on Windows, so check what this platform wants: + + # USE_THREAD_ALLOC tells us to try the special thread-based + # allocator that significantly reduces lock contention + AC_DEFINE(USE_THREAD_ALLOC, 1, + [Do we want to use the threaded memory allocator?]) + AC_DEFINE(_REENTRANT, 1, [Do we want the reentrant OS API?]) + if test "`uname -s`" = "SunOS" ; then + AC_DEFINE(_POSIX_PTHREAD_SEMANTICS, 1, + [Do we really want to follow the standard? Yes we do!]) + fi + AC_DEFINE(_THREAD_SAFE, 1, [Do we want the thread-safe OS API?]) + AC_CHECK_LIB(pthread,pthread_mutex_init,tcl_ok=yes,tcl_ok=no) + if test "$tcl_ok" = "no"; then + # Check a little harder for __pthread_mutex_init in the same + # library, as some systems hide it there until pthread.h is + # defined. We could alternatively do an AC_TRY_COMPILE with + # pthread.h, but that will work with libpthread really doesn't + # exist, like AIX 4.2. [Bug: 4359] + AC_CHECK_LIB(pthread, __pthread_mutex_init, + tcl_ok=yes, tcl_ok=no) + fi + + if test "$tcl_ok" = "yes"; then + # The space is needed + THREADS_LIBS=" -lpthread" + else + AC_CHECK_LIB(pthreads, pthread_mutex_init, + tcl_ok=yes, tcl_ok=no) + if test "$tcl_ok" = "yes"; then + # The space is needed + THREADS_LIBS=" -lpthreads" + else + AC_CHECK_LIB(c, pthread_mutex_init, + tcl_ok=yes, tcl_ok=no) + if test "$tcl_ok" = "no"; then + AC_CHECK_LIB(c_r, pthread_mutex_init, + tcl_ok=yes, tcl_ok=no) + if test "$tcl_ok" = "yes"; then + # The space is needed + THREADS_LIBS=" -pthread" + else + TCL_THREADS=0 + AC_MSG_WARN([Do not know how to find pthread lib on your system - thread support disabled]) + fi + fi + fi + fi + fi + else + TCL_THREADS=0 + fi + # Do checking message here to not mess up interleaved configure output + AC_MSG_CHECKING([for building with threads]) + if test "${TCL_THREADS}" = 1; then + AC_DEFINE(TCL_THREADS, 1, [Are we building with threads enabled?]) + AC_MSG_RESULT([yes (default)]) + else + AC_MSG_RESULT([no]) + fi + # TCL_THREADS sanity checking. See if our request for building with + # threads is the same as the way Tcl was built. If not, warn the user. + case ${TCL_DEFS} in + *THREADS=1*) + if test "${TCL_THREADS}" = "0"; then + AC_MSG_WARN([ + Building ${PACKAGE_NAME} without threads enabled, but building against Tcl + that IS thread-enabled. It is recommended to use --enable-threads.]) + fi + ;; + esac + AC_SUBST(TCL_THREADS) +]) + +#------------------------------------------------------------------------ +# TEA_ENABLE_SYMBOLS -- +# +# Specify if debugging symbols should be used. +# Memory (TCL_MEM_DEBUG) debugging can also be enabled. +# +# Arguments: +# none +# +# TEA varies from core Tcl in that C|LDFLAGS_DEFAULT receives +# the value of C|LDFLAGS_OPTIMIZE|DEBUG already substituted. +# Requires the following vars to be set in the Makefile: +# CFLAGS_DEFAULT +# LDFLAGS_DEFAULT +# +# Results: +# +# Adds the following arguments to configure: +# --enable-symbols +# +# Defines the following vars: +# CFLAGS_DEFAULT Sets to $(CFLAGS_DEBUG) if true +# Sets to "$(CFLAGS_OPTIMIZE) -DNDEBUG" if false +# LDFLAGS_DEFAULT Sets to $(LDFLAGS_DEBUG) if true +# Sets to $(LDFLAGS_OPTIMIZE) if false +# DBGX Formerly used as debug library extension; +# always blank now. +#------------------------------------------------------------------------ + +AC_DEFUN([TEA_ENABLE_SYMBOLS], [ + dnl TEA specific: Make sure we are initialized + AC_REQUIRE([TEA_CONFIG_CFLAGS]) + AC_MSG_CHECKING([for build with symbols]) + AC_ARG_ENABLE(symbols, + AC_HELP_STRING([--enable-symbols], + [build with debugging symbols (default: off)]), + [tcl_ok=$enableval], [tcl_ok=no]) + DBGX="" + if test "$tcl_ok" = "no"; then + CFLAGS_DEFAULT="${CFLAGS_OPTIMIZE} -DNDEBUG" + LDFLAGS_DEFAULT="${LDFLAGS_OPTIMIZE}" + AC_MSG_RESULT([no]) + else + CFLAGS_DEFAULT="${CFLAGS_DEBUG}" + LDFLAGS_DEFAULT="${LDFLAGS_DEBUG}" + if test "$tcl_ok" = "yes"; then + AC_MSG_RESULT([yes (standard debugging)]) + fi + fi + # TEA specific: + if test "${TEA_PLATFORM}" != "windows" ; then + LDFLAGS_DEFAULT="${LDFLAGS}" + fi + AC_SUBST(CFLAGS_DEFAULT) + AC_SUBST(LDFLAGS_DEFAULT) + AC_SUBST(TCL_DBGX) + + if test "$tcl_ok" = "mem" -o "$tcl_ok" = "all"; then + AC_DEFINE(TCL_MEM_DEBUG, 1, [Is memory debugging enabled?]) + fi + + if test "$tcl_ok" != "yes" -a "$tcl_ok" != "no"; then + if test "$tcl_ok" = "all"; then + AC_MSG_RESULT([enabled symbols mem debugging]) + else + AC_MSG_RESULT([enabled $tcl_ok debugging]) + fi + fi +]) + +#------------------------------------------------------------------------ +# TEA_ENABLE_LANGINFO -- +# +# Allows use of modern nl_langinfo check for better l10n. +# This is only relevant for Unix. +# +# Arguments: +# none +# +# Results: +# +# Adds the following arguments to configure: +# --enable-langinfo=yes|no (default is yes) +# +# Defines the following vars: +# HAVE_LANGINFO Triggers use of nl_langinfo if defined. +#------------------------------------------------------------------------ + +AC_DEFUN([TEA_ENABLE_LANGINFO], [ + AC_ARG_ENABLE(langinfo, + AC_HELP_STRING([--enable-langinfo], + [use nl_langinfo if possible to determine encoding at startup, otherwise use old heuristic (default: on)]), + [langinfo_ok=$enableval], [langinfo_ok=yes]) + + HAVE_LANGINFO=0 + if test "$langinfo_ok" = "yes"; then + AC_CHECK_HEADER(langinfo.h,[langinfo_ok=yes],[langinfo_ok=no]) + fi + AC_MSG_CHECKING([whether to use nl_langinfo]) + if test "$langinfo_ok" = "yes"; then + AC_CACHE_VAL(tcl_cv_langinfo_h, [ + AC_TRY_COMPILE([#include ], [nl_langinfo(CODESET);], + [tcl_cv_langinfo_h=yes],[tcl_cv_langinfo_h=no])]) + AC_MSG_RESULT([$tcl_cv_langinfo_h]) + if test $tcl_cv_langinfo_h = yes; then + AC_DEFINE(HAVE_LANGINFO, 1, [Do we have nl_langinfo()?]) + fi + else + AC_MSG_RESULT([$langinfo_ok]) + fi +]) + +#-------------------------------------------------------------------- +# TEA_CONFIG_SYSTEM +# +# Determine what the system is (some things cannot be easily checked +# on a feature-driven basis, alas). This can usually be done via the +# "uname" command. +# +# Arguments: +# none +# +# Results: +# Defines the following var: +# +# system - System/platform/version identification code. +#-------------------------------------------------------------------- + +AC_DEFUN([TEA_CONFIG_SYSTEM], [ + AC_CACHE_CHECK([system version], tcl_cv_sys_version, [ + # TEA specific: + if test "${TEA_PLATFORM}" = "windows" ; then + tcl_cv_sys_version=windows + else + tcl_cv_sys_version=`uname -s`-`uname -r` + if test "$?" -ne 0 ; then + AC_MSG_WARN([can't find uname command]) + tcl_cv_sys_version=unknown + else + if test "`uname -s`" = "AIX" ; then + tcl_cv_sys_version=AIX-`uname -v`.`uname -r` + fi + fi + fi + ]) + system=$tcl_cv_sys_version +]) + +#-------------------------------------------------------------------- +# TEA_CONFIG_CFLAGS +# +# Try to determine the proper flags to pass to the compiler +# for building shared libraries and other such nonsense. +# +# Arguments: +# none +# +# Results: +# +# Defines and substitutes the following vars: +# +# DL_OBJS, DL_LIBS - removed for TEA, only needed by core. +# LDFLAGS - Flags to pass to the compiler when linking object +# files into an executable application binary such +# as tclsh. +# LD_SEARCH_FLAGS-Flags to pass to ld, such as "-R /usr/local/tcl/lib", +# that tell the run-time dynamic linker where to look +# for shared libraries such as libtcl.so. Depends on +# the variable LIB_RUNTIME_DIR in the Makefile. Could +# be the same as CC_SEARCH_FLAGS if ${CC} is used to link. +# CC_SEARCH_FLAGS-Flags to pass to ${CC}, such as "-Wl,-rpath,/usr/local/tcl/lib", +# that tell the run-time dynamic linker where to look +# for shared libraries such as libtcl.so. Depends on +# the variable LIB_RUNTIME_DIR in the Makefile. +# SHLIB_CFLAGS - Flags to pass to cc when compiling the components +# of a shared library (may request position-independent +# code, among other things). +# SHLIB_LD - Base command to use for combining object files +# into a shared library. +# SHLIB_LD_LIBS - Dependent libraries for the linker to scan when +# creating shared libraries. This symbol typically +# goes at the end of the "ld" commands that build +# shared libraries. The value of the symbol defaults to +# "${LIBS}" if all of the dependent libraries should +# be specified when creating a shared library. If +# dependent libraries should not be specified (as on +# SunOS 4.x, where they cause the link to fail, or in +# general if Tcl and Tk aren't themselves shared +# libraries), then this symbol has an empty string +# as its value. +# SHLIB_SUFFIX - Suffix to use for the names of dynamically loadable +# extensions. An empty string means we don't know how +# to use shared libraries on this platform. +# LIB_SUFFIX - Specifies everything that comes after the "libfoo" +# in a static or shared library name, using the $PACKAGE_VERSION variable +# to put the version in the right place. This is used +# by platforms that need non-standard library names. +# Examples: ${PACKAGE_VERSION}.so.1.1 on NetBSD, since it needs +# to have a version after the .so, and ${PACKAGE_VERSION}.a +# on AIX, since a shared library needs to have +# a .a extension whereas shared objects for loadable +# extensions have a .so extension. Defaults to +# ${PACKAGE_VERSION}${SHLIB_SUFFIX}. +# CFLAGS_DEBUG - +# Flags used when running the compiler in debug mode +# CFLAGS_OPTIMIZE - +# Flags used when running the compiler in optimize mode +# CFLAGS - Additional CFLAGS added as necessary (usually 64-bit) +#-------------------------------------------------------------------- + +AC_DEFUN([TEA_CONFIG_CFLAGS], [ + dnl TEA specific: Make sure we are initialized + AC_REQUIRE([TEA_INIT]) + + # Step 0.a: Enable 64 bit support? + + AC_MSG_CHECKING([if 64bit support is requested]) + AC_ARG_ENABLE(64bit, + AC_HELP_STRING([--enable-64bit], + [enable 64bit support (default: off)]), + [do64bit=$enableval], [do64bit=no]) + AC_MSG_RESULT([$do64bit]) + + # Step 0.b: Enable Solaris 64 bit VIS support? + + AC_MSG_CHECKING([if 64bit Sparc VIS support is requested]) + AC_ARG_ENABLE(64bit-vis, + AC_HELP_STRING([--enable-64bit-vis], + [enable 64bit Sparc VIS support (default: off)]), + [do64bitVIS=$enableval], [do64bitVIS=no]) + AC_MSG_RESULT([$do64bitVIS]) + # Force 64bit on with VIS + AS_IF([test "$do64bitVIS" = "yes"], [do64bit=yes]) + + # Step 0.c: Check if visibility support is available. Do this here so + # that platform specific alternatives can be used below if this fails. + + AC_CACHE_CHECK([if compiler supports visibility "hidden"], + tcl_cv_cc_visibility_hidden, [ + hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror" + AC_TRY_LINK([ + extern __attribute__((__visibility__("hidden"))) void f(void); + void f(void) {}], [f();], tcl_cv_cc_visibility_hidden=yes, + tcl_cv_cc_visibility_hidden=no) + CFLAGS=$hold_cflags]) + AS_IF([test $tcl_cv_cc_visibility_hidden = yes], [ + AC_DEFINE(MODULE_SCOPE, + [extern __attribute__((__visibility__("hidden")))], + [Compiler support for module scope symbols]) + AC_DEFINE(HAVE_HIDDEN, [1], [Compiler support for module scope symbols]) + ]) + + # Step 0.d: Disable -rpath support? + + AC_MSG_CHECKING([if rpath support is requested]) + AC_ARG_ENABLE(rpath, + AC_HELP_STRING([--disable-rpath], + [disable rpath support (default: on)]), + [doRpath=$enableval], [doRpath=yes]) + AC_MSG_RESULT([$doRpath]) + + # TEA specific: Cross-compiling options for Windows/CE builds? + + AS_IF([test "${TEA_PLATFORM}" = windows], [ + AC_MSG_CHECKING([if Windows/CE build is requested]) + AC_ARG_ENABLE(wince, + AC_HELP_STRING([--enable-wince], + [enable Win/CE support (where applicable)]), + [doWince=$enableval], [doWince=no]) + AC_MSG_RESULT([$doWince]) + ]) + + # Set the variable "system" to hold the name and version number + # for the system. + + TEA_CONFIG_SYSTEM + + # Require ranlib early so we can override it in special cases below. + + AC_REQUIRE([AC_PROG_RANLIB]) + + # Set configuration options based on system name and version. + # This is similar to Tcl's unix/tcl.m4 except that we've added a + # "windows" case and removed some core-only vars. + + do64bit_ok=no + # default to '{$LIBS}' and set to "" on per-platform necessary basis + SHLIB_LD_LIBS='${LIBS}' + # When ld needs options to work in 64-bit mode, put them in + # LDFLAGS_ARCH so they eventually end up in LDFLAGS even if [load] + # is disabled by the user. [Bug 1016796] + LDFLAGS_ARCH="" + UNSHARED_LIB_SUFFIX="" + # TEA specific: use PACKAGE_VERSION instead of VERSION + TCL_TRIM_DOTS='`echo ${PACKAGE_VERSION} | tr -d .`' + ECHO_VERSION='`echo ${PACKAGE_VERSION}`' + TCL_LIB_VERSIONS_OK=ok + CFLAGS_DEBUG=-g + AS_IF([test "$GCC" = yes], [ + CFLAGS_OPTIMIZE=-O2 + CFLAGS_WARNING="-Wall" + ], [ + CFLAGS_OPTIMIZE=-O + CFLAGS_WARNING="" + ]) + AC_CHECK_TOOL(AR, ar) + STLIB_LD='${AR} cr' + LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH" + AS_IF([test "x$SHLIB_VERSION" = x],[SHLIB_VERSION=""],[SHLIB_VERSION=".$SHLIB_VERSION"]) + case $system in + # TEA specific: + windows) + # This is a 2-stage check to make sure we have the 64-bit SDK + # We have to know where the SDK is installed. + # This magic is based on MS Platform SDK for Win2003 SP1 - hobbs + # MACHINE is IX86 for LINK, but this is used by the manifest, + # which requires x86|amd64|ia64. + MACHINE="X86" + if test "$do64bit" != "no" ; then + if test "x${MSSDK}x" = "xx" ; then + MSSDK="C:/Progra~1/Microsoft Platform SDK" + fi + MSSDK=`echo "$MSSDK" | sed -e 's!\\\!/!g'` + PATH64="" + case "$do64bit" in + amd64|x64|yes) + MACHINE="AMD64" ; # default to AMD64 64-bit build + PATH64="${MSSDK}/Bin/Win64/x86/AMD64" + ;; + ia64) + MACHINE="IA64" + PATH64="${MSSDK}/Bin/Win64" + ;; + esac + if test "$GCC" != "yes" -a ! -d "${PATH64}" ; then + AC_MSG_WARN([Could not find 64-bit $MACHINE SDK to enable 64bit mode]) + AC_MSG_WARN([Ensure latest Platform SDK is installed]) + do64bit="no" + else + AC_MSG_RESULT([ Using 64-bit $MACHINE mode]) + do64bit_ok="yes" + fi + fi + + if test "$doWince" != "no" ; then + if test "$do64bit" != "no" ; then + AC_MSG_ERROR([Windows/CE and 64-bit builds incompatible]) + fi + if test "$GCC" = "yes" ; then + AC_MSG_ERROR([Windows/CE and GCC builds incompatible]) + fi + TEA_PATH_CELIB + # Set defaults for common evc4/PPC2003 setup + # Currently Tcl requires 300+, possibly 420+ for sockets + CEVERSION=420; # could be 211 300 301 400 420 ... + TARGETCPU=ARMV4; # could be ARMV4 ARM MIPS SH3 X86 ... + ARCH=ARM; # could be ARM MIPS X86EM ... + PLATFORM="Pocket PC 2003"; # or "Pocket PC 2002" + if test "$doWince" != "yes"; then + # If !yes then the user specified something + # Reset ARCH to allow user to skip specifying it + ARCH= + eval `echo $doWince | awk -F, '{ \ + if (length([$]1)) { printf "CEVERSION=\"%s\"\n", [$]1; \ + if ([$]1 < 400) { printf "PLATFORM=\"Pocket PC 2002\"\n" } }; \ + if (length([$]2)) { printf "TARGETCPU=\"%s\"\n", toupper([$]2) }; \ + if (length([$]3)) { printf "ARCH=\"%s\"\n", toupper([$]3) }; \ + if (length([$]4)) { printf "PLATFORM=\"%s\"\n", [$]4 }; \ + }'` + if test "x${ARCH}" = "x" ; then + ARCH=$TARGETCPU; + fi + fi + OSVERSION=WCE$CEVERSION; + if test "x${WCEROOT}" = "x" ; then + WCEROOT="C:/Program Files/Microsoft eMbedded C++ 4.0" + if test ! -d "${WCEROOT}" ; then + WCEROOT="C:/Program Files/Microsoft eMbedded Tools" + fi + fi + if test "x${SDKROOT}" = "x" ; then + SDKROOT="C:/Program Files/Windows CE Tools" + if test ! -d "${SDKROOT}" ; then + SDKROOT="C:/Windows CE Tools" + fi + fi + WCEROOT=`echo "$WCEROOT" | sed -e 's!\\\!/!g'` + SDKROOT=`echo "$SDKROOT" | sed -e 's!\\\!/!g'` + if test ! -d "${SDKROOT}/${OSVERSION}/${PLATFORM}/Lib/${TARGETCPU}" \ + -o ! -d "${WCEROOT}/EVC/${OSVERSION}/bin"; then + AC_MSG_ERROR([could not find PocketPC SDK or target compiler to enable WinCE mode [$CEVERSION,$TARGETCPU,$ARCH,$PLATFORM]]) + doWince="no" + else + # We could PATH_NOSPACE these, but that's not important, + # as long as we quote them when used. + CEINCLUDE="${SDKROOT}/${OSVERSION}/${PLATFORM}/include" + if test -d "${CEINCLUDE}/${TARGETCPU}" ; then + CEINCLUDE="${CEINCLUDE}/${TARGETCPU}" + fi + CELIBPATH="${SDKROOT}/${OSVERSION}/${PLATFORM}/Lib/${TARGETCPU}" + fi + fi + + if test "$GCC" != "yes" ; then + if test "${SHARED_BUILD}" = "0" ; then + runtime=-MT + else + runtime=-MD + fi + case "x`echo \${VisualStudioVersion}`" in + x1[[4-9]]*) + lflags="${lflags} -nodefaultlib:libucrt.lib" + TEA_ADD_LIBS([ucrt.lib]) + ;; + *) + ;; + esac + + if test "$do64bit" != "no" ; then + # All this magic is necessary for the Win64 SDK RC1 - hobbs + CC="\"${PATH64}/cl.exe\"" + CFLAGS="${CFLAGS} -I\"${MSSDK}/Include\" -I\"${MSSDK}/Include/crt\" -I\"${MSSDK}/Include/crt/sys\"" + RC="\"${MSSDK}/bin/rc.exe\"" + lflags="${lflags} -nologo -MACHINE:${MACHINE} -LIBPATH:\"${MSSDK}/Lib/${MACHINE}\"" + LINKBIN="\"${PATH64}/link.exe\"" + CFLAGS_DEBUG="-nologo -Zi -Od -W3 ${runtime}d" + CFLAGS_OPTIMIZE="-nologo -O2 -W2 ${runtime}" + # Avoid 'unresolved external symbol __security_cookie' + # errors, c.f. http://support.microsoft.com/?id=894573 + TEA_ADD_LIBS([bufferoverflowU.lib]) + elif test "$doWince" != "no" ; then + CEBINROOT="${WCEROOT}/EVC/${OSVERSION}/bin" + if test "${TARGETCPU}" = "X86"; then + CC="\"${CEBINROOT}/cl.exe\"" + else + CC="\"${CEBINROOT}/cl${ARCH}.exe\"" + fi + CFLAGS="$CFLAGS -I\"${CELIB_DIR}/inc\" -I\"${CEINCLUDE}\"" + RC="\"${WCEROOT}/Common/EVC/bin/rc.exe\"" + arch=`echo ${ARCH} | awk '{print tolower([$]0)}'` + defs="${ARCH} _${ARCH}_ ${arch} PALM_SIZE _MT _WINDOWS" + if test "${SHARED_BUILD}" = "1" ; then + # Static CE builds require static celib as well + defs="${defs} _DLL" + fi + for i in $defs ; do + AC_DEFINE_UNQUOTED($i, 1, [WinCE def ]$i) + done + AC_DEFINE_UNQUOTED(_WIN32_WCE, $CEVERSION, [_WIN32_WCE version]) + AC_DEFINE_UNQUOTED(UNDER_CE, $CEVERSION, [UNDER_CE version]) + CFLAGS_DEBUG="-nologo -Zi -Od" + CFLAGS_OPTIMIZE="-nologo -Ox" + lversion=`echo ${CEVERSION} | sed -e 's/\(.\)\(..\)/\1\.\2/'` + lflags="${lflags} -MACHINE:${ARCH} -LIBPATH:\"${CELIBPATH}\" -subsystem:windowsce,${lversion} -nologo" + LINKBIN="\"${CEBINROOT}/link.exe\"" + AC_SUBST(CELIB_DIR) + else + RC="rc" + lflags="${lflags} -nologo" + LINKBIN="link" + CFLAGS_DEBUG="-nologo -Z7 -Od -W3 -WX ${runtime}d" + CFLAGS_OPTIMIZE="-nologo -O2 -W2 ${runtime}" + fi + fi + + if test "$GCC" = "yes"; then + # mingw gcc mode + AC_CHECK_TOOL(RC, windres) + CFLAGS_DEBUG="-g" + CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer" + SHLIB_LD='${CC} -shared' + UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a' + LDFLAGS_CONSOLE="-wl,--subsystem,console ${lflags}" + LDFLAGS_WINDOW="-wl,--subsystem,windows ${lflags}" + + AC_CACHE_CHECK(for cross-compile version of gcc, + ac_cv_cross, + AC_TRY_COMPILE([ + #ifdef _WIN32 + #error cross-compiler + #endif + ], [], + ac_cv_cross=yes, + ac_cv_cross=no) + ) + if test "$ac_cv_cross" = "yes"; then + case "$do64bit" in + amd64|x64|yes) + CC="x86_64-w64-mingw32-gcc" + LD="x86_64-w64-mingw32-ld" + AR="x86_64-w64-mingw32-ar" + RANLIB="x86_64-w64-mingw32-ranlib" + RC="x86_64-w64-mingw32-windres" + ;; + *) + CC="i686-w64-mingw32-gcc" + LD="i686-w64-mingw32-ld" + AR="i686-w64-mingw32-ar" + RANLIB="i686-w64-mingw32-ranlib" + RC="i686-w64-mingw32-windres" + ;; + esac + fi + + else + SHLIB_LD="${LINKBIN} -dll ${lflags}" + # link -lib only works when -lib is the first arg + STLIB_LD="${LINKBIN} -lib ${lflags}" + UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.lib' + PATHTYPE=-w + # For information on what debugtype is most useful, see: + # http://msdn.microsoft.com/library/en-us/dnvc60/html/gendepdebug.asp + # and also + # http://msdn2.microsoft.com/en-us/library/y0zzbyt4%28VS.80%29.aspx + # This essentially turns it all on. + LDFLAGS_DEBUG="-debug -debugtype:cv" + LDFLAGS_OPTIMIZE="-release" + if test "$doWince" != "no" ; then + LDFLAGS_CONSOLE="-link ${lflags}" + LDFLAGS_WINDOW=${LDFLAGS_CONSOLE} + else + LDFLAGS_CONSOLE="-link -subsystem:console ${lflags}" + LDFLAGS_WINDOW="-link -subsystem:windows ${lflags}" + fi + fi + + SHLIB_SUFFIX=".dll" + SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.dll' + + TCL_LIB_VERSIONS_OK=nodots + ;; + AIX-*) + AS_IF([test "${TCL_THREADS}" = "1" -a "$GCC" != "yes"], [ + # AIX requires the _r compiler when gcc isn't being used + case "${CC}" in + *_r|*_r\ *) + # ok ... + ;; + *) + # Make sure only first arg gets _r + CC=`echo "$CC" | sed -e 's/^\([[^ ]]*\)/\1_r/'` + ;; + esac + AC_MSG_RESULT([Using $CC for compiling with threads]) + ]) + LIBS="$LIBS -lc" + SHLIB_CFLAGS="" + SHLIB_SUFFIX=".so" + + LD_LIBRARY_PATH_VAR="LIBPATH" + + # Check to enable 64-bit flags for compiler/linker + AS_IF([test "$do64bit" = yes], [ + AS_IF([test "$GCC" = yes], [ + AC_MSG_WARN([64bit mode not supported with GCC on $system]) + ], [ + do64bit_ok=yes + CFLAGS="$CFLAGS -q64" + LDFLAGS_ARCH="-q64" + RANLIB="${RANLIB} -X64" + AR="${AR} -X64" + SHLIB_LD_FLAGS="-b64" + ]) + ]) + + AS_IF([test "`uname -m`" = ia64], [ + # AIX-5 uses ELF style dynamic libraries on IA-64, but not PPC + SHLIB_LD="/usr/ccs/bin/ld -G -z text" + AS_IF([test "$GCC" = yes], [ + CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' + ], [ + CC_SEARCH_FLAGS='-R${LIB_RUNTIME_DIR}' + ]) + LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}' + ], [ + AS_IF([test "$GCC" = yes], [ + SHLIB_LD='${CC} -shared -Wl,-bexpall' + ], [ + SHLIB_LD="/bin/ld -bhalt:4 -bM:SRE -bexpall -H512 -T512 -bnoentry" + LDFLAGS="$LDFLAGS -brtl" + ]) + SHLIB_LD="${SHLIB_LD} ${SHLIB_LD_FLAGS}" + CC_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}' + LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} + ]) + ;; + BeOS*) + SHLIB_CFLAGS="-fPIC" + SHLIB_LD='${CC} -nostart' + SHLIB_SUFFIX=".so" + + #----------------------------------------------------------- + # Check for inet_ntoa in -lbind, for BeOS (which also needs + # -lsocket, even if the network functions are in -lnet which + # is always linked to, for compatibility. + #----------------------------------------------------------- + AC_CHECK_LIB(bind, inet_ntoa, [LIBS="$LIBS -lbind -lsocket"]) + ;; + BSD/OS-4.*) + SHLIB_CFLAGS="-export-dynamic -fPIC" + SHLIB_LD='${CC} -shared' + SHLIB_SUFFIX=".so" + LDFLAGS="$LDFLAGS -export-dynamic" + CC_SEARCH_FLAGS="" + LD_SEARCH_FLAGS="" + ;; + CYGWIN_*) + SHLIB_CFLAGS="" + SHLIB_LD='${CC} -shared' + SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,--out-implib,\$[@].a" + SHLIB_SUFFIX=".dll" + EXEEXT=".exe" + do64bit_ok=yes + CC_SEARCH_FLAGS="" + LD_SEARCH_FLAGS="" + ;; + Haiku*) + LDFLAGS="$LDFLAGS -Wl,--export-dynamic" + SHLIB_CFLAGS="-fPIC" + SHLIB_SUFFIX=".so" + SHLIB_LD='${CC} ${CFLAGS} ${LDFLAGS} -shared' + AC_CHECK_LIB(network, inet_ntoa, [LIBS="$LIBS -lnetwork"]) + ;; + HP-UX-*.11.*) + # Use updated header definitions where possible + AC_DEFINE(_XOPEN_SOURCE_EXTENDED, 1, [Do we want to use the XOPEN network library?]) + # TEA specific: Needed by Tcl, but not most extensions + #AC_DEFINE(_XOPEN_SOURCE, 1, [Do we want to use the XOPEN network library?]) + #LIBS="$LIBS -lxnet" # Use the XOPEN network library + + AS_IF([test "`uname -m`" = ia64], [ + SHLIB_SUFFIX=".so" + # Use newer C++ library for C++ extensions + #if test "$GCC" != "yes" ; then + # CPPFLAGS="-AA" + #fi + ], [ + SHLIB_SUFFIX=".sl" + ]) + AC_CHECK_LIB(dld, shl_load, tcl_ok=yes, tcl_ok=no) + AS_IF([test "$tcl_ok" = yes], [ + LDFLAGS="$LDFLAGS -Wl,-E" + CC_SEARCH_FLAGS='-Wl,+s,+b,${LIB_RUNTIME_DIR}:.' + LD_SEARCH_FLAGS='+s +b ${LIB_RUNTIME_DIR}:.' + LD_LIBRARY_PATH_VAR="SHLIB_PATH" + ]) + AS_IF([test "$GCC" = yes], [ + SHLIB_LD='${CC} -shared' + LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} + ], [ + CFLAGS="$CFLAGS -z" + # Users may want PA-RISC 1.1/2.0 portable code - needs HP cc + #CFLAGS="$CFLAGS +DAportable" + SHLIB_CFLAGS="+z" + SHLIB_LD="ld -b" + ]) + + # Check to enable 64-bit flags for compiler/linker + AS_IF([test "$do64bit" = "yes"], [ + AS_IF([test "$GCC" = yes], [ + case `${CC} -dumpmachine` in + hppa64*) + # 64-bit gcc in use. Fix flags for GNU ld. + do64bit_ok=yes + SHLIB_LD='${CC} -shared' + AS_IF([test $doRpath = yes], [ + CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}']) + LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} + ;; + *) + AC_MSG_WARN([64bit mode not supported with GCC on $system]) + ;; + esac + ], [ + do64bit_ok=yes + CFLAGS="$CFLAGS +DD64" + LDFLAGS_ARCH="+DD64" + ]) + ]) ;; + IRIX-6.*) + SHLIB_CFLAGS="" + SHLIB_LD="ld -n32 -shared -rdata_shared" + SHLIB_SUFFIX=".so" + AS_IF([test $doRpath = yes], [ + CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' + LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}']) + AS_IF([test "$GCC" = yes], [ + CFLAGS="$CFLAGS -mabi=n32" + LDFLAGS="$LDFLAGS -mabi=n32" + ], [ + case $system in + IRIX-6.3) + # Use to build 6.2 compatible binaries on 6.3. + CFLAGS="$CFLAGS -n32 -D_OLD_TERMIOS" + ;; + *) + CFLAGS="$CFLAGS -n32" + ;; + esac + LDFLAGS="$LDFLAGS -n32" + ]) + ;; + IRIX64-6.*) + SHLIB_CFLAGS="" + SHLIB_LD="ld -n32 -shared -rdata_shared" + SHLIB_SUFFIX=".so" + AS_IF([test $doRpath = yes], [ + CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' + LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}']) + + # Check to enable 64-bit flags for compiler/linker + + AS_IF([test "$do64bit" = yes], [ + AS_IF([test "$GCC" = yes], [ + AC_MSG_WARN([64bit mode not supported by gcc]) + ], [ + do64bit_ok=yes + SHLIB_LD="ld -64 -shared -rdata_shared" + CFLAGS="$CFLAGS -64" + LDFLAGS_ARCH="-64" + ]) + ]) + ;; + Linux*|GNU*|NetBSD-Debian) + SHLIB_CFLAGS="-fPIC" + SHLIB_SUFFIX=".so" + + # TEA specific: + CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer" + + # TEA specific: use LDFLAGS_DEFAULT instead of LDFLAGS + SHLIB_LD='${CC} ${CFLAGS} ${LDFLAGS_DEFAULT} -shared' + LDFLAGS="$LDFLAGS -Wl,--export-dynamic" + AS_IF([test $doRpath = yes], [ + CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}']) + LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} + AS_IF([test "`uname -m`" = "alpha"], [CFLAGS="$CFLAGS -mieee"]) + AS_IF([test $do64bit = yes], [ + AC_CACHE_CHECK([if compiler accepts -m64 flag], tcl_cv_cc_m64, [ + hold_cflags=$CFLAGS + CFLAGS="$CFLAGS -m64" + AC_TRY_LINK(,, tcl_cv_cc_m64=yes, tcl_cv_cc_m64=no) + CFLAGS=$hold_cflags]) + AS_IF([test $tcl_cv_cc_m64 = yes], [ + CFLAGS="$CFLAGS -m64" + do64bit_ok=yes + ]) + ]) + + # The combo of gcc + glibc has a bug related to inlining of + # functions like strtod(). The -fno-builtin flag should address + # this problem but it does not work. The -fno-inline flag is kind + # of overkill but it works. Disable inlining only when one of the + # files in compat/*.c is being linked in. + + AS_IF([test x"${USE_COMPAT}" != x],[CFLAGS="$CFLAGS -fno-inline"]) + ;; + Lynx*) + SHLIB_CFLAGS="-fPIC" + SHLIB_SUFFIX=".so" + CFLAGS_OPTIMIZE=-02 + SHLIB_LD='${CC} -shared' + LD_FLAGS="-Wl,--export-dynamic" + AS_IF([test $doRpath = yes], [ + CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' + LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}']) + ;; + OpenBSD-*) + arch=`arch -s` + case "$arch" in + alpha|sparc64) + SHLIB_CFLAGS="-fPIC" + ;; + *) + SHLIB_CFLAGS="-fpic" + ;; + esac + SHLIB_LD='${CC} ${SHLIB_CFLAGS} -shared' + SHLIB_SUFFIX=".so" + AS_IF([test $doRpath = yes], [ + CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}']) + LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} + SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so${SHLIB_VERSION}' + LDFLAGS="-Wl,-export-dynamic" + CFLAGS_OPTIMIZE="-O2" + AS_IF([test "${TCL_THREADS}" = "1"], [ + # On OpenBSD: Compile with -pthread + # Don't link with -lpthread + LIBS=`echo $LIBS | sed s/-lpthread//` + CFLAGS="$CFLAGS -pthread" + ]) + # OpenBSD doesn't do version numbers with dots. + UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a' + TCL_LIB_VERSIONS_OK=nodots + ;; + NetBSD-*) + # NetBSD has ELF and can use 'cc -shared' to build shared libs + SHLIB_CFLAGS="-fPIC" + SHLIB_LD='${CC} ${SHLIB_CFLAGS} -shared' + SHLIB_SUFFIX=".so" + LDFLAGS="$LDFLAGS -export-dynamic" + AS_IF([test $doRpath = yes], [ + CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}']) + LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} + AS_IF([test "${TCL_THREADS}" = "1"], [ + # The -pthread needs to go in the CFLAGS, not LIBS + LIBS=`echo $LIBS | sed s/-pthread//` + CFLAGS="$CFLAGS -pthread" + LDFLAGS="$LDFLAGS -pthread" + ]) + ;; + DragonFly-*|FreeBSD-*) + # This configuration from FreeBSD Ports. + SHLIB_CFLAGS="-fPIC" + SHLIB_LD="${CC} -shared" + SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,-soname,\$[@]" + SHLIB_SUFFIX=".so" + LDFLAGS="" + AS_IF([test $doRpath = yes], [ + CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' + LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}']) + AS_IF([test "${TCL_THREADS}" = "1"], [ + # The -pthread needs to go in the LDFLAGS, not LIBS + LIBS=`echo $LIBS | sed s/-pthread//` + CFLAGS="$CFLAGS $PTHREAD_CFLAGS" + LDFLAGS="$LDFLAGS $PTHREAD_LIBS"]) + case $system in + FreeBSD-3.*) + # Version numbers are dot-stripped by system policy. + TCL_TRIM_DOTS=`echo ${PACKAGE_VERSION} | tr -d .` + UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a' + SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.so.1' + TCL_LIB_VERSIONS_OK=nodots + ;; + esac + ;; + Darwin-*) + CFLAGS_OPTIMIZE="-Os" + SHLIB_CFLAGS="-fno-common" + # To avoid discrepancies between what headers configure sees during + # preprocessing tests and compiling tests, move any -isysroot and + # -mmacosx-version-min flags from CFLAGS to CPPFLAGS: + CPPFLAGS="${CPPFLAGS} `echo " ${CFLAGS}" | \ + awk 'BEGIN {FS=" +-";ORS=" "}; {for (i=2;i<=NF;i++) \ + if ([$]i~/^(isysroot|mmacosx-version-min)/) print "-"[$]i}'`" + CFLAGS="`echo " ${CFLAGS}" | \ + awk 'BEGIN {FS=" +-";ORS=" "}; {for (i=2;i<=NF;i++) \ + if (!([$]i~/^(isysroot|mmacosx-version-min)/)) print "-"[$]i}'`" + AS_IF([test $do64bit = yes], [ + case `arch` in + ppc) + AC_CACHE_CHECK([if compiler accepts -arch ppc64 flag], + tcl_cv_cc_arch_ppc64, [ + hold_cflags=$CFLAGS + CFLAGS="$CFLAGS -arch ppc64 -mpowerpc64 -mcpu=G5" + AC_TRY_LINK(,, tcl_cv_cc_arch_ppc64=yes, + tcl_cv_cc_arch_ppc64=no) + CFLAGS=$hold_cflags]) + AS_IF([test $tcl_cv_cc_arch_ppc64 = yes], [ + CFLAGS="$CFLAGS -arch ppc64 -mpowerpc64 -mcpu=G5" + do64bit_ok=yes + ]);; + i386) + AC_CACHE_CHECK([if compiler accepts -arch x86_64 flag], + tcl_cv_cc_arch_x86_64, [ + hold_cflags=$CFLAGS + CFLAGS="$CFLAGS -arch x86_64" + AC_TRY_LINK(,, tcl_cv_cc_arch_x86_64=yes, + tcl_cv_cc_arch_x86_64=no) + CFLAGS=$hold_cflags]) + AS_IF([test $tcl_cv_cc_arch_x86_64 = yes], [ + CFLAGS="$CFLAGS -arch x86_64" + do64bit_ok=yes + ]);; + *) + AC_MSG_WARN([Don't know how enable 64-bit on architecture `arch`]);; + esac + ], [ + # Check for combined 32-bit and 64-bit fat build + AS_IF([echo "$CFLAGS " |grep -E -q -- '-arch (ppc64|x86_64) ' \ + && echo "$CFLAGS " |grep -E -q -- '-arch (ppc|i386) '], [ + fat_32_64=yes]) + ]) + # TEA specific: use LDFLAGS_DEFAULT instead of LDFLAGS + SHLIB_LD='${CC} -dynamiclib ${CFLAGS} ${LDFLAGS_DEFAULT}' + AC_CACHE_CHECK([if ld accepts -single_module flag], tcl_cv_ld_single_module, [ + hold_ldflags=$LDFLAGS + LDFLAGS="$LDFLAGS -dynamiclib -Wl,-single_module" + AC_TRY_LINK(, [int i;], tcl_cv_ld_single_module=yes, tcl_cv_ld_single_module=no) + LDFLAGS=$hold_ldflags]) + AS_IF([test $tcl_cv_ld_single_module = yes], [ + SHLIB_LD="${SHLIB_LD} -Wl,-single_module" + ]) + # TEA specific: link shlib with current and compatibility version flags + vers=`echo ${PACKAGE_VERSION} | sed -e 's/^\([[0-9]]\{1,5\}\)\(\(\.[[0-9]]\{1,3\}\)\{0,2\}\).*$/\1\2/p' -e d` + SHLIB_LD="${SHLIB_LD} -current_version ${vers:-0} -compatibility_version ${vers:-0}" + SHLIB_SUFFIX=".dylib" + # Don't use -prebind when building for Mac OS X 10.4 or later only: + AS_IF([test "`echo "${MACOSX_DEPLOYMENT_TARGET}" | awk -F '10\\.' '{print int([$]2)}'`" -lt 4 -a \ + "`echo "${CPPFLAGS}" | awk -F '-mmacosx-version-min=10\\.' '{print int([$]2)}'`" -lt 4], [ + LDFLAGS="$LDFLAGS -prebind"]) + LDFLAGS="$LDFLAGS -headerpad_max_install_names" + AC_CACHE_CHECK([if ld accepts -search_paths_first flag], + tcl_cv_ld_search_paths_first, [ + hold_ldflags=$LDFLAGS + LDFLAGS="$LDFLAGS -Wl,-search_paths_first" + AC_TRY_LINK(, [int i;], tcl_cv_ld_search_paths_first=yes, + tcl_cv_ld_search_paths_first=no) + LDFLAGS=$hold_ldflags]) + AS_IF([test $tcl_cv_ld_search_paths_first = yes], [ + LDFLAGS="$LDFLAGS -Wl,-search_paths_first" + ]) + AS_IF([test "$tcl_cv_cc_visibility_hidden" != yes], [ + AC_DEFINE(MODULE_SCOPE, [__private_extern__], + [Compiler support for module scope symbols]) + tcl_cv_cc_visibility_hidden=yes + ]) + CC_SEARCH_FLAGS="" + LD_SEARCH_FLAGS="" + LD_LIBRARY_PATH_VAR="DYLD_LIBRARY_PATH" + # TEA specific: for combined 32 & 64 bit fat builds of Tk + # extensions, verify that 64-bit build is possible. + AS_IF([test "$fat_32_64" = yes && test -n "${TK_BIN_DIR}"], [ + AS_IF([test "${TEA_WINDOWINGSYSTEM}" = x11], [ + AC_CACHE_CHECK([for 64-bit X11], tcl_cv_lib_x11_64, [ + for v in CFLAGS CPPFLAGS LDFLAGS; do + eval 'hold_'$v'="$'$v'";'$v'="`echo "$'$v' "|sed -e "s/-arch ppc / /g" -e "s/-arch i386 / /g"`"' + done + CPPFLAGS="$CPPFLAGS -I/usr/X11R6/include" + LDFLAGS="$LDFLAGS -L/usr/X11R6/lib -lX11" + AC_TRY_LINK([#include ], [XrmInitialize();], + tcl_cv_lib_x11_64=yes, tcl_cv_lib_x11_64=no) + for v in CFLAGS CPPFLAGS LDFLAGS; do + eval $v'="$hold_'$v'"' + done]) + ]) + AS_IF([test "${TEA_WINDOWINGSYSTEM}" = aqua], [ + AC_CACHE_CHECK([for 64-bit Tk], tcl_cv_lib_tk_64, [ + for v in CFLAGS CPPFLAGS LDFLAGS; do + eval 'hold_'$v'="$'$v'";'$v'="`echo "$'$v' "|sed -e "s/-arch ppc / /g" -e "s/-arch i386 / /g"`"' + done + CPPFLAGS="$CPPFLAGS -DUSE_TCL_STUBS=1 -DUSE_TK_STUBS=1 ${TCL_INCLUDES} ${TK_INCLUDES}" + LDFLAGS="$LDFLAGS ${TCL_STUB_LIB_SPEC} ${TK_STUB_LIB_SPEC}" + AC_TRY_LINK([#include ], [Tk_InitStubs(NULL, "", 0);], + tcl_cv_lib_tk_64=yes, tcl_cv_lib_tk_64=no) + for v in CFLAGS CPPFLAGS LDFLAGS; do + eval $v'="$hold_'$v'"' + done]) + ]) + # remove 64-bit arch flags from CFLAGS et al. if configuration + # does not support 64-bit. + AS_IF([test "$tcl_cv_lib_tk_64" = no -o "$tcl_cv_lib_x11_64" = no], [ + AC_MSG_NOTICE([Removing 64-bit architectures from compiler & linker flags]) + for v in CFLAGS CPPFLAGS LDFLAGS; do + eval $v'="`echo "$'$v' "|sed -e "s/-arch ppc64 / /g" -e "s/-arch x86_64 / /g"`"' + done]) + ]) + ;; + OS/390-*) + CFLAGS_OPTIMIZE="" # Optimizer is buggy + AC_DEFINE(_OE_SOCKETS, 1, # needed in sys/socket.h + [Should OS/390 do the right thing with sockets?]) + ;; + OSF1-V*) + # Digital OSF/1 + SHLIB_CFLAGS="" + AS_IF([test "$SHARED_BUILD" = 1], [ + SHLIB_LD='ld -shared -expect_unresolved "*"' + ], [ + SHLIB_LD='ld -non_shared -expect_unresolved "*"' + ]) + SHLIB_SUFFIX=".so" + AS_IF([test $doRpath = yes], [ + CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}' + LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}']) + AS_IF([test "$GCC" = yes], [CFLAGS="$CFLAGS -mieee"], [ + CFLAGS="$CFLAGS -DHAVE_TZSET -std1 -ieee"]) + # see pthread_intro(3) for pthread support on osf1, k.furukawa + AS_IF([test "${TCL_THREADS}" = 1], [ + CFLAGS="$CFLAGS -DHAVE_PTHREAD_ATTR_SETSTACKSIZE" + CFLAGS="$CFLAGS -DTCL_THREAD_STACK_MIN=PTHREAD_STACK_MIN*64" + LIBS=`echo $LIBS | sed s/-lpthreads//` + AS_IF([test "$GCC" = yes], [ + LIBS="$LIBS -lpthread -lmach -lexc" + ], [ + CFLAGS="$CFLAGS -pthread" + LDFLAGS="$LDFLAGS -pthread" + ]) + ]) + ;; + QNX-6*) + # QNX RTP + # This may work for all QNX, but it was only reported for v6. + SHLIB_CFLAGS="-fPIC" + SHLIB_LD="ld -Bshareable -x" + SHLIB_LD_LIBS="" + SHLIB_SUFFIX=".so" + CC_SEARCH_FLAGS="" + LD_SEARCH_FLAGS="" + ;; + SCO_SV-3.2*) + AS_IF([test "$GCC" = yes], [ + SHLIB_CFLAGS="-fPIC -melf" + LDFLAGS="$LDFLAGS -melf -Wl,-Bexport" + ], [ + SHLIB_CFLAGS="-Kpic -belf" + LDFLAGS="$LDFLAGS -belf -Wl,-Bexport" + ]) + SHLIB_LD="ld -G" + SHLIB_LD_LIBS="" + SHLIB_SUFFIX=".so" + CC_SEARCH_FLAGS="" + LD_SEARCH_FLAGS="" + ;; + SunOS-5.[[0-6]]) + # Careful to not let 5.10+ fall into this case + + # Note: If _REENTRANT isn't defined, then Solaris + # won't define thread-safe library routines. + + AC_DEFINE(_REENTRANT, 1, [Do we want the reentrant OS API?]) + AC_DEFINE(_POSIX_PTHREAD_SEMANTICS, 1, + [Do we really want to follow the standard? Yes we do!]) + + SHLIB_CFLAGS="-KPIC" + SHLIB_SUFFIX=".so" + AS_IF([test "$GCC" = yes], [ + SHLIB_LD='${CC} -shared' + CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' + LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} + ], [ + SHLIB_LD="/usr/ccs/bin/ld -G -z text" + CC_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}' + LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} + ]) + ;; + SunOS-5*) + # Note: If _REENTRANT isn't defined, then Solaris + # won't define thread-safe library routines. + + AC_DEFINE(_REENTRANT, 1, [Do we want the reentrant OS API?]) + AC_DEFINE(_POSIX_PTHREAD_SEMANTICS, 1, + [Do we really want to follow the standard? Yes we do!]) + + SHLIB_CFLAGS="-KPIC" + + # Check to enable 64-bit flags for compiler/linker + AS_IF([test "$do64bit" = yes], [ + arch=`isainfo` + AS_IF([test "$arch" = "sparcv9 sparc"], [ + AS_IF([test "$GCC" = yes], [ + AS_IF([test "`${CC} -dumpversion | awk -F. '{print [$]1}'`" -lt 3], [ + AC_MSG_WARN([64bit mode not supported with GCC < 3.2 on $system]) + ], [ + do64bit_ok=yes + CFLAGS="$CFLAGS -m64 -mcpu=v9" + LDFLAGS="$LDFLAGS -m64 -mcpu=v9" + SHLIB_CFLAGS="-fPIC" + ]) + ], [ + do64bit_ok=yes + AS_IF([test "$do64bitVIS" = yes], [ + CFLAGS="$CFLAGS -xarch=v9a" + LDFLAGS_ARCH="-xarch=v9a" + ], [ + CFLAGS="$CFLAGS -xarch=v9" + LDFLAGS_ARCH="-xarch=v9" + ]) + # Solaris 64 uses this as well + #LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH_64" + ]) + ], [AS_IF([test "$arch" = "amd64 i386"], [ + AS_IF([test "$GCC" = yes], [ + case $system in + SunOS-5.1[[1-9]]*|SunOS-5.[[2-9]][[0-9]]*) + do64bit_ok=yes + CFLAGS="$CFLAGS -m64" + LDFLAGS="$LDFLAGS -m64";; + *) + AC_MSG_WARN([64bit mode not supported with GCC on $system]);; + esac + ], [ + do64bit_ok=yes + case $system in + SunOS-5.1[[1-9]]*|SunOS-5.[[2-9]][[0-9]]*) + CFLAGS="$CFLAGS -m64" + LDFLAGS="$LDFLAGS -m64";; + *) + CFLAGS="$CFLAGS -xarch=amd64" + LDFLAGS="$LDFLAGS -xarch=amd64";; + esac + ]) + ], [AC_MSG_WARN([64bit mode not supported for $arch])])]) + ]) + + SHLIB_SUFFIX=".so" + AS_IF([test "$GCC" = yes], [ + SHLIB_LD='${CC} -shared' + CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' + LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} + AS_IF([test "$do64bit_ok" = yes], [ + AS_IF([test "$arch" = "sparcv9 sparc"], [ + # We need to specify -static-libgcc or we need to + # add the path to the sparv9 libgcc. + # JH: static-libgcc is necessary for core Tcl, but may + # not be necessary for extensions. + SHLIB_LD="$SHLIB_LD -m64 -mcpu=v9 -static-libgcc" + # for finding sparcv9 libgcc, get the regular libgcc + # path, remove so name and append 'sparcv9' + #v9gcclibdir="`gcc -print-file-name=libgcc_s.so` | ..." + #CC_SEARCH_FLAGS="${CC_SEARCH_FLAGS},-R,$v9gcclibdir" + ], [AS_IF([test "$arch" = "amd64 i386"], [ + # JH: static-libgcc is necessary for core Tcl, but may + # not be necessary for extensions. + SHLIB_LD="$SHLIB_LD -m64 -static-libgcc" + ])]) + ]) + ], [ + case $system in + SunOS-5.[[1-9]][[0-9]]*) + # TEA specific: use LDFLAGS_DEFAULT instead of LDFLAGS + SHLIB_LD='${CC} -G -z text ${LDFLAGS_DEFAULT}';; + *) + SHLIB_LD='/usr/ccs/bin/ld -G -z text';; + esac + CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' + LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}' + ]) + ;; + UNIX_SV* | UnixWare-5*) + SHLIB_CFLAGS="-KPIC" + SHLIB_LD='${CC} -G' + SHLIB_LD_LIBS="" + SHLIB_SUFFIX=".so" + # Some UNIX_SV* systems (unixware 1.1.2 for example) have linkers + # that don't grok the -Bexport option. Test that it does. + AC_CACHE_CHECK([for ld accepts -Bexport flag], tcl_cv_ld_Bexport, [ + hold_ldflags=$LDFLAGS + LDFLAGS="$LDFLAGS -Wl,-Bexport" + AC_TRY_LINK(, [int i;], tcl_cv_ld_Bexport=yes, tcl_cv_ld_Bexport=no) + LDFLAGS=$hold_ldflags]) + AS_IF([test $tcl_cv_ld_Bexport = yes], [ + LDFLAGS="$LDFLAGS -Wl,-Bexport" + ]) + CC_SEARCH_FLAGS="" + LD_SEARCH_FLAGS="" + ;; + esac + + AS_IF([test "$do64bit" = yes -a "$do64bit_ok" = no], [ + AC_MSG_WARN([64bit support being disabled -- don't know magic for this platform]) + ]) + +dnl # Add any CPPFLAGS set in the environment to our CFLAGS, but delay doing so +dnl # until the end of configure, as configure's compile and link tests use +dnl # both CPPFLAGS and CFLAGS (unlike our compile and link) but configure's +dnl # preprocessing tests use only CPPFLAGS. + AC_CONFIG_COMMANDS_PRE([CFLAGS="${CFLAGS} ${CPPFLAGS}"; CPPFLAGS=""]) + + # Add in the arch flags late to ensure it wasn't removed. + # Not necessary in TEA, but this is aligned with core + LDFLAGS="$LDFLAGS $LDFLAGS_ARCH" + + # If we're running gcc, then change the C flags for compiling shared + # libraries to the right flags for gcc, instead of those for the + # standard manufacturer compiler. + + AS_IF([test "$GCC" = yes], [ + case $system in + AIX-*) ;; + BSD/OS*) ;; + CYGWIN_*|MINGW32_*|MINGW64_*) ;; + IRIX*) ;; + NetBSD-*|DragonFly-*|FreeBSD-*|OpenBSD-*) ;; + Darwin-*) ;; + SCO_SV-3.2*) ;; + windows) ;; + *) SHLIB_CFLAGS="-fPIC" ;; + esac]) + + AS_IF([test "$tcl_cv_cc_visibility_hidden" != yes], [ + AC_DEFINE(MODULE_SCOPE, [extern], + [No Compiler support for module scope symbols]) + ]) + + AS_IF([test "$SHARED_LIB_SUFFIX" = ""], [ + # TEA specific: use PACKAGE_VERSION instead of VERSION + SHARED_LIB_SUFFIX='${PACKAGE_VERSION}${SHLIB_SUFFIX}']) + AS_IF([test "$UNSHARED_LIB_SUFFIX" = ""], [ + # TEA specific: use PACKAGE_VERSION instead of VERSION + UNSHARED_LIB_SUFFIX='${PACKAGE_VERSION}.a']) + + if test "${GCC}" = "yes" -a ${SHLIB_SUFFIX} = ".dll"; then + AC_CACHE_CHECK(for SEH support in compiler, + tcl_cv_seh, + AC_TRY_RUN([ +#define WIN32_LEAN_AND_MEAN +#include +#undef WIN32_LEAN_AND_MEAN + + int main(int argc, char** argv) { + int a, b = 0; + __try { + a = 666 / b; + } + __except (EXCEPTION_EXECUTE_HANDLER) { + return 0; + } + return 1; + } + ], + tcl_cv_seh=yes, + tcl_cv_seh=no, + tcl_cv_seh=no) + ) + if test "$tcl_cv_seh" = "no" ; then + AC_DEFINE(HAVE_NO_SEH, 1, + [Defined when mingw does not support SEH]) + fi + + # + # Check to see if the excpt.h include file provided contains the + # definition for EXCEPTION_DISPOSITION; if not, which is the case + # with Cygwin's version as of 2002-04-10, define it to be int, + # sufficient for getting the current code to work. + # + AC_CACHE_CHECK(for EXCEPTION_DISPOSITION support in include files, + tcl_cv_eh_disposition, + AC_TRY_COMPILE([ +# define WIN32_LEAN_AND_MEAN +# include +# undef WIN32_LEAN_AND_MEAN + ],[ + EXCEPTION_DISPOSITION x; + ], + tcl_cv_eh_disposition=yes, + tcl_cv_eh_disposition=no) + ) + if test "$tcl_cv_eh_disposition" = "no" ; then + AC_DEFINE(EXCEPTION_DISPOSITION, int, + [Defined when cygwin/mingw does not support EXCEPTION DISPOSITION]) + fi + + # Check to see if winnt.h defines CHAR, SHORT, and LONG + # even if VOID has already been #defined. The win32api + # used by mingw and cygwin is known to do this. + + AC_CACHE_CHECK(for winnt.h that ignores VOID define, + tcl_cv_winnt_ignore_void, + AC_TRY_COMPILE([ +#define VOID void +#define WIN32_LEAN_AND_MEAN +#include +#undef WIN32_LEAN_AND_MEAN + ], [ + CHAR c; + SHORT s; + LONG l; + ], + tcl_cv_winnt_ignore_void=yes, + tcl_cv_winnt_ignore_void=no) + ) + if test "$tcl_cv_winnt_ignore_void" = "yes" ; then + AC_DEFINE(HAVE_WINNT_IGNORE_VOID, 1, + [Defined when cygwin/mingw ignores VOID define in winnt.h]) + fi + fi + + # See if the compiler supports casting to a union type. + # This is used to stop gcc from printing a compiler + # warning when initializing a union member. + + AC_CACHE_CHECK(for cast to union support, + tcl_cv_cast_to_union, + AC_TRY_COMPILE([], + [ + union foo { int i; double d; }; + union foo f = (union foo) (int) 0; + ], + tcl_cv_cast_to_union=yes, + tcl_cv_cast_to_union=no) + ) + if test "$tcl_cv_cast_to_union" = "yes"; then + AC_DEFINE(HAVE_CAST_TO_UNION, 1, + [Defined when compiler supports casting to union type.]) + fi + + AC_SUBST(CFLAGS_DEBUG) + AC_SUBST(CFLAGS_OPTIMIZE) + AC_SUBST(CFLAGS_WARNING) + + AC_SUBST(STLIB_LD) + AC_SUBST(SHLIB_LD) + + AC_SUBST(SHLIB_LD_LIBS) + AC_SUBST(SHLIB_CFLAGS) + + AC_SUBST(LD_LIBRARY_PATH_VAR) + + # These must be called after we do the basic CFLAGS checks and + # verify any possible 64-bit or similar switches are necessary + TEA_TCL_EARLY_FLAGS + TEA_TCL_64BIT_FLAGS +]) + +#-------------------------------------------------------------------- +# TEA_SERIAL_PORT +# +# Determine which interface to use to talk to the serial port. +# Note that #include lines must begin in leftmost column for +# some compilers to recognize them as preprocessor directives, +# and some build environments have stdin not pointing at a +# pseudo-terminal (usually /dev/null instead.) +# +# Arguments: +# none +# +# Results: +# +# Defines only one of the following vars: +# HAVE_SYS_MODEM_H +# USE_TERMIOS +# USE_TERMIO +# USE_SGTTY +#-------------------------------------------------------------------- + +AC_DEFUN([TEA_SERIAL_PORT], [ + AC_CHECK_HEADERS(sys/modem.h) + AC_CACHE_CHECK([termios vs. termio vs. sgtty], tcl_cv_api_serial, [ + AC_TRY_RUN([ +#include + +int main() { + struct termios t; + if (tcgetattr(0, &t) == 0) { + cfsetospeed(&t, 0); + t.c_cflag |= PARENB | PARODD | CSIZE | CSTOPB; + return 0; + } + return 1; +}], tcl_cv_api_serial=termios, tcl_cv_api_serial=no, tcl_cv_api_serial=no) + if test $tcl_cv_api_serial = no ; then + AC_TRY_RUN([ +#include + +int main() { + struct termio t; + if (ioctl(0, TCGETA, &t) == 0) { + t.c_cflag |= CBAUD | PARENB | PARODD | CSIZE | CSTOPB; + return 0; + } + return 1; +}], tcl_cv_api_serial=termio, tcl_cv_api_serial=no, tcl_cv_api_serial=no) + fi + if test $tcl_cv_api_serial = no ; then + AC_TRY_RUN([ +#include + +int main() { + struct sgttyb t; + if (ioctl(0, TIOCGETP, &t) == 0) { + t.sg_ospeed = 0; + t.sg_flags |= ODDP | EVENP | RAW; + return 0; + } + return 1; +}], tcl_cv_api_serial=sgtty, tcl_cv_api_serial=no, tcl_cv_api_serial=no) + fi + if test $tcl_cv_api_serial = no ; then + AC_TRY_RUN([ +#include +#include + +int main() { + struct termios t; + if (tcgetattr(0, &t) == 0 + || errno == ENOTTY || errno == ENXIO || errno == EINVAL) { + cfsetospeed(&t, 0); + t.c_cflag |= PARENB | PARODD | CSIZE | CSTOPB; + return 0; + } + return 1; +}], tcl_cv_api_serial=termios, tcl_cv_api_serial=no, tcl_cv_api_serial=no) + fi + if test $tcl_cv_api_serial = no; then + AC_TRY_RUN([ +#include +#include + +int main() { + struct termio t; + if (ioctl(0, TCGETA, &t) == 0 + || errno == ENOTTY || errno == ENXIO || errno == EINVAL) { + t.c_cflag |= CBAUD | PARENB | PARODD | CSIZE | CSTOPB; + return 0; + } + return 1; + }], tcl_cv_api_serial=termio, tcl_cv_api_serial=no, tcl_cv_api_serial=no) + fi + if test $tcl_cv_api_serial = no; then + AC_TRY_RUN([ +#include +#include + +int main() { + struct sgttyb t; + if (ioctl(0, TIOCGETP, &t) == 0 + || errno == ENOTTY || errno == ENXIO || errno == EINVAL) { + t.sg_ospeed = 0; + t.sg_flags |= ODDP | EVENP | RAW; + return 0; + } + return 1; +}], tcl_cv_api_serial=sgtty, tcl_cv_api_serial=none, tcl_cv_api_serial=none) + fi]) + case $tcl_cv_api_serial in + termios) AC_DEFINE(USE_TERMIOS, 1, [Use the termios API for serial lines]);; + termio) AC_DEFINE(USE_TERMIO, 1, [Use the termio API for serial lines]);; + sgtty) AC_DEFINE(USE_SGTTY, 1, [Use the sgtty API for serial lines]);; + esac +]) + +#-------------------------------------------------------------------- +# TEA_PATH_X +# +# Locate the X11 header files and the X11 library archive. Try +# the ac_path_x macro first, but if it doesn't find the X stuff +# (e.g. because there's no xmkmf program) then check through +# a list of possible directories. Under some conditions the +# autoconf macro will return an include directory that contains +# no include files, so double-check its result just to be safe. +# +# This should be called after TEA_CONFIG_CFLAGS as setting the +# LIBS line can confuse some configure macro magic. +# +# Arguments: +# none +# +# Results: +# +# Sets the following vars: +# XINCLUDES +# XLIBSW +# PKG_LIBS (appends to) +#-------------------------------------------------------------------- + +AC_DEFUN([TEA_PATH_X], [ + if test "${TEA_WINDOWINGSYSTEM}" = "x11" ; then + TEA_PATH_UNIX_X + fi +]) + +AC_DEFUN([TEA_PATH_UNIX_X], [ + AC_PATH_X + not_really_there="" + if test "$no_x" = ""; then + if test "$x_includes" = ""; then + AC_TRY_CPP([#include ], , not_really_there="yes") + else + if test ! -r $x_includes/X11/Xlib.h; then + not_really_there="yes" + fi + fi + fi + if test "$no_x" = "yes" -o "$not_really_there" = "yes"; then + AC_MSG_CHECKING([for X11 header files]) + found_xincludes="no" + AC_TRY_CPP([#include ], found_xincludes="yes", found_xincludes="no") + if test "$found_xincludes" = "no"; then + dirs="/usr/unsupported/include /usr/local/include /usr/X386/include /usr/X11R6/include /usr/X11R5/include /usr/include/X11R5 /usr/include/X11R4 /usr/openwin/include /usr/X11/include /usr/sww/include" + for i in $dirs ; do + if test -r $i/X11/Xlib.h; then + AC_MSG_RESULT([$i]) + XINCLUDES=" -I$i" + found_xincludes="yes" + break + fi + done + fi + else + if test "$x_includes" != ""; then + XINCLUDES="-I$x_includes" + found_xincludes="yes" + fi + fi + if test "$found_xincludes" = "no"; then + AC_MSG_RESULT([couldn't find any!]) + fi + + if test "$no_x" = yes; then + AC_MSG_CHECKING([for X11 libraries]) + XLIBSW=nope + dirs="/usr/unsupported/lib /usr/local/lib /usr/X386/lib /usr/X11R6/lib /usr/X11R5/lib /usr/lib/X11R5 /usr/lib/X11R4 /usr/openwin/lib /usr/X11/lib /usr/sww/X11/lib" + for i in $dirs ; do + if test -r $i/libX11.a -o -r $i/libX11.so -o -r $i/libX11.sl -o -r $i/libX11.dylib; then + AC_MSG_RESULT([$i]) + XLIBSW="-L$i -lX11" + x_libraries="$i" + break + fi + done + else + if test "$x_libraries" = ""; then + XLIBSW=-lX11 + else + XLIBSW="-L$x_libraries -lX11" + fi + fi + if test "$XLIBSW" = nope ; then + AC_CHECK_LIB(Xwindow, XCreateWindow, XLIBSW=-lXwindow) + fi + if test "$XLIBSW" = nope ; then + AC_MSG_RESULT([could not find any! Using -lX11.]) + XLIBSW=-lX11 + fi + # TEA specific: + if test x"${XLIBSW}" != x ; then + PKG_LIBS="${PKG_LIBS} ${XLIBSW}" + fi +]) + +#-------------------------------------------------------------------- +# TEA_BLOCKING_STYLE +# +# The statements below check for systems where POSIX-style +# non-blocking I/O (O_NONBLOCK) doesn't work or is unimplemented. +# On these systems (mostly older ones), use the old BSD-style +# FIONBIO approach instead. +# +# Arguments: +# none +# +# Results: +# +# Defines some of the following vars: +# HAVE_SYS_IOCTL_H +# HAVE_SYS_FILIO_H +# USE_FIONBIO +# O_NONBLOCK +#-------------------------------------------------------------------- + +AC_DEFUN([TEA_BLOCKING_STYLE], [ + AC_CHECK_HEADERS(sys/ioctl.h) + AC_CHECK_HEADERS(sys/filio.h) + TEA_CONFIG_SYSTEM + AC_MSG_CHECKING([FIONBIO vs. O_NONBLOCK for nonblocking I/O]) + case $system in + OSF*) + AC_DEFINE(USE_FIONBIO, 1, [Should we use FIONBIO?]) + AC_MSG_RESULT([FIONBIO]) + ;; + *) + AC_MSG_RESULT([O_NONBLOCK]) + ;; + esac +]) + +#-------------------------------------------------------------------- +# TEA_TIME_HANDLER +# +# Checks how the system deals with time.h, what time structures +# are used on the system, and what fields the structures have. +# +# Arguments: +# none +# +# Results: +# +# Defines some of the following vars: +# USE_DELTA_FOR_TZ +# HAVE_TM_GMTOFF +# HAVE_TM_TZADJ +# HAVE_TIMEZONE_VAR +#-------------------------------------------------------------------- + +AC_DEFUN([TEA_TIME_HANDLER], [ + AC_CHECK_HEADERS(sys/time.h) + AC_HEADER_TIME + AC_STRUCT_TIMEZONE + + AC_CHECK_FUNCS(gmtime_r localtime_r) + + AC_CACHE_CHECK([tm_tzadj in struct tm], tcl_cv_member_tm_tzadj, [ + AC_TRY_COMPILE([#include ], [struct tm tm; tm.tm_tzadj;], + tcl_cv_member_tm_tzadj=yes, tcl_cv_member_tm_tzadj=no)]) + if test $tcl_cv_member_tm_tzadj = yes ; then + AC_DEFINE(HAVE_TM_TZADJ, 1, [Should we use the tm_tzadj field of struct tm?]) + fi + + AC_CACHE_CHECK([tm_gmtoff in struct tm], tcl_cv_member_tm_gmtoff, [ + AC_TRY_COMPILE([#include ], [struct tm tm; tm.tm_gmtoff;], + tcl_cv_member_tm_gmtoff=yes, tcl_cv_member_tm_gmtoff=no)]) + if test $tcl_cv_member_tm_gmtoff = yes ; then + AC_DEFINE(HAVE_TM_GMTOFF, 1, [Should we use the tm_gmtoff field of struct tm?]) + fi + + # + # Its important to include time.h in this check, as some systems + # (like convex) have timezone functions, etc. + # + AC_CACHE_CHECK([long timezone variable], tcl_cv_timezone_long, [ + AC_TRY_COMPILE([#include ], + [extern long timezone; + timezone += 1; + exit (0);], + tcl_cv_timezone_long=yes, tcl_cv_timezone_long=no)]) + if test $tcl_cv_timezone_long = yes ; then + AC_DEFINE(HAVE_TIMEZONE_VAR, 1, [Should we use the global timezone variable?]) + else + # + # On some systems (eg IRIX 6.2), timezone is a time_t and not a long. + # + AC_CACHE_CHECK([time_t timezone variable], tcl_cv_timezone_time, [ + AC_TRY_COMPILE([#include ], + [extern time_t timezone; + timezone += 1; + exit (0);], + tcl_cv_timezone_time=yes, tcl_cv_timezone_time=no)]) + if test $tcl_cv_timezone_time = yes ; then + AC_DEFINE(HAVE_TIMEZONE_VAR, 1, [Should we use the global timezone variable?]) + fi + fi +]) + +#-------------------------------------------------------------------- +# TEA_BUGGY_STRTOD +# +# Under Solaris 2.4, strtod returns the wrong value for the +# terminating character under some conditions. Check for this +# and if the problem exists use a substitute procedure +# "fixstrtod" (provided by Tcl) that corrects the error. +# Also, on Compaq's Tru64 Unix 5.0, +# strtod(" ") returns 0.0 instead of a failure to convert. +# +# Arguments: +# none +# +# Results: +# +# Might defines some of the following vars: +# strtod (=fixstrtod) +#-------------------------------------------------------------------- + +AC_DEFUN([TEA_BUGGY_STRTOD], [ + AC_CHECK_FUNC(strtod, tcl_strtod=1, tcl_strtod=0) + if test "$tcl_strtod" = 1; then + AC_CACHE_CHECK([for Solaris2.4/Tru64 strtod bugs], tcl_cv_strtod_buggy,[ + AC_TRY_RUN([ + extern double strtod(); + int main() { + char *infString="Inf", *nanString="NaN", *spaceString=" "; + char *term; + double value; + value = strtod(infString, &term); + if ((term != infString) && (term[-1] == 0)) { + exit(1); + } + value = strtod(nanString, &term); + if ((term != nanString) && (term[-1] == 0)) { + exit(1); + } + value = strtod(spaceString, &term); + if (term == (spaceString+1)) { + exit(1); + } + exit(0); + }], tcl_cv_strtod_buggy=ok, tcl_cv_strtod_buggy=buggy, + tcl_cv_strtod_buggy=buggy)]) + if test "$tcl_cv_strtod_buggy" = buggy; then + AC_LIBOBJ([fixstrtod]) + USE_COMPAT=1 + AC_DEFINE(strtod, fixstrtod, [Do we want to use the strtod() in compat?]) + fi + fi +]) + +#-------------------------------------------------------------------- +# TEA_TCL_EARLY_FLAGS +# +# Check for what flags are needed to be passed so the correct OS +# features are available. +# +# Arguments: +# None +# +# Results: +# +# Might define the following vars: +# _ISOC99_SOURCE +# _LARGEFILE64_SOURCE +# _LARGEFILE_SOURCE64 +#-------------------------------------------------------------------- + +AC_DEFUN([TEA_TCL_EARLY_FLAG],[ + AC_CACHE_VAL([tcl_cv_flag_]translit($1,[A-Z],[a-z]), + AC_TRY_COMPILE([$2], $3, [tcl_cv_flag_]translit($1,[A-Z],[a-z])=no, + AC_TRY_COMPILE([[#define ]$1[ 1 +]$2], $3, + [tcl_cv_flag_]translit($1,[A-Z],[a-z])=yes, + [tcl_cv_flag_]translit($1,[A-Z],[a-z])=no))) + if test ["x${tcl_cv_flag_]translit($1,[A-Z],[a-z])[}" = "xyes"] ; then + AC_DEFINE($1, 1, [Add the ]$1[ flag when building]) + tcl_flags="$tcl_flags $1" + fi +]) + +AC_DEFUN([TEA_TCL_EARLY_FLAGS],[ + AC_MSG_CHECKING([for required early compiler flags]) + tcl_flags="" + TEA_TCL_EARLY_FLAG(_ISOC99_SOURCE,[#include ], + [char *p = (char *)strtoll; char *q = (char *)strtoull;]) + TEA_TCL_EARLY_FLAG(_LARGEFILE64_SOURCE,[#include ], + [struct stat64 buf; int i = stat64("/", &buf);]) + TEA_TCL_EARLY_FLAG(_LARGEFILE_SOURCE64,[#include ], + [char *p = (char *)open64;]) + if test "x${tcl_flags}" = "x" ; then + AC_MSG_RESULT([none]) + else + AC_MSG_RESULT([${tcl_flags}]) + fi +]) + +#-------------------------------------------------------------------- +# TEA_TCL_64BIT_FLAGS +# +# Check for what is defined in the way of 64-bit features. +# +# Arguments: +# None +# +# Results: +# +# Might define the following vars: +# TCL_WIDE_INT_IS_LONG +# TCL_WIDE_INT_TYPE +# HAVE_STRUCT_DIRENT64 +# HAVE_STRUCT_STAT64 +# HAVE_TYPE_OFF64_T +#-------------------------------------------------------------------- + +AC_DEFUN([TEA_TCL_64BIT_FLAGS], [ + AC_MSG_CHECKING([for 64-bit integer type]) + AC_CACHE_VAL(tcl_cv_type_64bit,[ + tcl_cv_type_64bit=none + # See if the compiler knows natively about __int64 + AC_TRY_COMPILE(,[__int64 value = (__int64) 0;], + tcl_type_64bit=__int64, tcl_type_64bit="long long") + # See if we should use long anyway Note that we substitute in the + # type that is our current guess for a 64-bit type inside this check + # program, so it should be modified only carefully... + AC_TRY_COMPILE(,[switch (0) { + case 1: case (sizeof(]${tcl_type_64bit}[)==sizeof(long)): ; + }],tcl_cv_type_64bit=${tcl_type_64bit})]) + if test "${tcl_cv_type_64bit}" = none ; then + AC_DEFINE(TCL_WIDE_INT_IS_LONG, 1, [Are wide integers to be implemented with C 'long's?]) + AC_MSG_RESULT([using long]) + elif test "${tcl_cv_type_64bit}" = "__int64" \ + -a "${TEA_PLATFORM}" = "windows" ; then + # TEA specific: We actually want to use the default tcl.h checks in + # this case to handle both TCL_WIDE_INT_TYPE and TCL_LL_MODIFIER* + AC_MSG_RESULT([using Tcl header defaults]) + else + AC_DEFINE_UNQUOTED(TCL_WIDE_INT_TYPE,${tcl_cv_type_64bit}, + [What type should be used to define wide integers?]) + AC_MSG_RESULT([${tcl_cv_type_64bit}]) + + # Now check for auxiliary declarations + AC_CACHE_CHECK([for struct dirent64], tcl_cv_struct_dirent64,[ + AC_TRY_COMPILE([#include +#include ],[struct dirent64 p;], + tcl_cv_struct_dirent64=yes,tcl_cv_struct_dirent64=no)]) + if test "x${tcl_cv_struct_dirent64}" = "xyes" ; then + AC_DEFINE(HAVE_STRUCT_DIRENT64, 1, [Is 'struct dirent64' in ?]) + fi + + AC_CACHE_CHECK([for struct stat64], tcl_cv_struct_stat64,[ + AC_TRY_COMPILE([#include ],[struct stat64 p; +], + tcl_cv_struct_stat64=yes,tcl_cv_struct_stat64=no)]) + if test "x${tcl_cv_struct_stat64}" = "xyes" ; then + AC_DEFINE(HAVE_STRUCT_STAT64, 1, [Is 'struct stat64' in ?]) + fi + + AC_CHECK_FUNCS(open64 lseek64) + AC_MSG_CHECKING([for off64_t]) + AC_CACHE_VAL(tcl_cv_type_off64_t,[ + AC_TRY_COMPILE([#include ],[off64_t offset; +], + tcl_cv_type_off64_t=yes,tcl_cv_type_off64_t=no)]) + dnl Define HAVE_TYPE_OFF64_T only when the off64_t type and the + dnl functions lseek64 and open64 are defined. + if test "x${tcl_cv_type_off64_t}" = "xyes" && \ + test "x${ac_cv_func_lseek64}" = "xyes" && \ + test "x${ac_cv_func_open64}" = "xyes" ; then + AC_DEFINE(HAVE_TYPE_OFF64_T, 1, [Is off64_t in ?]) + AC_MSG_RESULT([yes]) + else + AC_MSG_RESULT([no]) + fi + fi +]) + +## +## Here ends the standard Tcl configuration bits and starts the +## TEA specific functions +## + +#------------------------------------------------------------------------ +# TEA_INIT -- +# +# Init various Tcl Extension Architecture (TEA) variables. +# This should be the first called TEA_* macro. +# +# Arguments: +# none +# +# Results: +# +# Defines and substs the following vars: +# CYGPATH +# EXEEXT +# Defines only: +# TEA_VERSION +# TEA_INITED +# TEA_PLATFORM (windows or unix) +# +# "cygpath" is used on windows to generate native path names for include +# files. These variables should only be used with the compiler and linker +# since they generate native path names. +# +# EXEEXT +# Select the executable extension based on the host type. This +# is a lightweight replacement for AC_EXEEXT that doesn't require +# a compiler. +#------------------------------------------------------------------------ + +AC_DEFUN([TEA_INIT], [ + TEA_VERSION="3.13" + + AC_MSG_CHECKING([TEA configuration]) + if test x"${PACKAGE_NAME}" = x ; then + AC_MSG_ERROR([ +The PACKAGE_NAME variable must be defined by your TEA configure.ac]) + fi + AC_MSG_RESULT([ok (TEA ${TEA_VERSION})]) + + # If the user did not set CFLAGS, set it now to keep macros + # like AC_PROG_CC and AC_TRY_COMPILE from adding "-g -O2". + if test "${CFLAGS+set}" != "set" ; then + CFLAGS="" + fi + + case "`uname -s`" in + *win32*|*WIN32*|*MINGW32_*|*MINGW64_*) + AC_CHECK_PROG(CYGPATH, cygpath, cygpath -m, echo) + EXEEXT=".exe" + TEA_PLATFORM="windows" + ;; + *CYGWIN_*) + EXEEXT=".exe" + # CYGPATH and TEA_PLATFORM are determined later in LOAD_TCLCONFIG + ;; + *) + CYGPATH=echo + # Maybe we are cross-compiling.... + case ${host_alias} in + *mingw32*) + EXEEXT=".exe" + TEA_PLATFORM="windows" + ;; + *) + EXEEXT="" + TEA_PLATFORM="unix" + ;; + esac + ;; + esac + + # Check if exec_prefix is set. If not use fall back to prefix. + # Note when adjusted, so that TEA_PREFIX can correct for this. + # This is needed for recursive configures, since autoconf propagates + # $prefix, but not $exec_prefix (doh!). + if test x$exec_prefix = xNONE ; then + exec_prefix_default=yes + exec_prefix=$prefix + fi + + AC_MSG_NOTICE([configuring ${PACKAGE_NAME} ${PACKAGE_VERSION}]) + + AC_SUBST(EXEEXT) + AC_SUBST(CYGPATH) + + # This package name must be replaced statically for AC_SUBST to work + AC_SUBST(PKG_LIB_FILE) + # Substitute STUB_LIB_FILE in case package creates a stub library too. + AC_SUBST(PKG_STUB_LIB_FILE) + + # We AC_SUBST these here to ensure they are subst'ed, + # in case the user doesn't call TEA_ADD_... + AC_SUBST(PKG_STUB_SOURCES) + AC_SUBST(PKG_STUB_OBJECTS) + AC_SUBST(PKG_TCL_SOURCES) + AC_SUBST(PKG_HEADERS) + AC_SUBST(PKG_INCLUDES) + AC_SUBST(PKG_LIBS) + AC_SUBST(PKG_CFLAGS) + + # Configure the installer. + TEA_INSTALLER +]) + +#------------------------------------------------------------------------ +# TEA_ADD_SOURCES -- +# +# Specify one or more source files. Users should check for +# the right platform before adding to their list. +# It is not important to specify the directory, as long as it is +# in the generic, win or unix subdirectory of $(srcdir). +# +# Arguments: +# one or more file names +# +# Results: +# +# Defines and substs the following vars: +# PKG_SOURCES +# PKG_OBJECTS +#------------------------------------------------------------------------ +AC_DEFUN([TEA_ADD_SOURCES], [ + vars="$@" + for i in $vars; do + case $i in + [\$]*) + # allow $-var names + PKG_SOURCES="$PKG_SOURCES $i" + PKG_OBJECTS="$PKG_OBJECTS $i" + ;; + *) + # check for existence - allows for generic/win/unix VPATH + # To add more dirs here (like 'src'), you have to update VPATH + # in Makefile.in as well + if test ! -f "${srcdir}/$i" -a ! -f "${srcdir}/generic/$i" \ + -a ! -f "${srcdir}/win/$i" -a ! -f "${srcdir}/unix/$i" \ + -a ! -f "${srcdir}/macosx/$i" \ + ; then + AC_MSG_ERROR([could not find source file '$i']) + fi + PKG_SOURCES="$PKG_SOURCES $i" + # this assumes it is in a VPATH dir + i=`basename $i` + # handle user calling this before or after TEA_SETUP_COMPILER + if test x"${OBJEXT}" != x ; then + j="`echo $i | sed -e 's/\.[[^.]]*$//'`.${OBJEXT}" + else + j="`echo $i | sed -e 's/\.[[^.]]*$//'`.\${OBJEXT}" + fi + PKG_OBJECTS="$PKG_OBJECTS $j" + ;; + esac + done + AC_SUBST(PKG_SOURCES) + AC_SUBST(PKG_OBJECTS) +]) + +#------------------------------------------------------------------------ +# TEA_ADD_STUB_SOURCES -- +# +# Specify one or more source files. Users should check for +# the right platform before adding to their list. +# It is not important to specify the directory, as long as it is +# in the generic, win or unix subdirectory of $(srcdir). +# +# Arguments: +# one or more file names +# +# Results: +# +# Defines and substs the following vars: +# PKG_STUB_SOURCES +# PKG_STUB_OBJECTS +#------------------------------------------------------------------------ +AC_DEFUN([TEA_ADD_STUB_SOURCES], [ + vars="$@" + for i in $vars; do + # check for existence - allows for generic/win/unix VPATH + if test ! -f "${srcdir}/$i" -a ! -f "${srcdir}/generic/$i" \ + -a ! -f "${srcdir}/win/$i" -a ! -f "${srcdir}/unix/$i" \ + -a ! -f "${srcdir}/macosx/$i" \ + ; then + AC_MSG_ERROR([could not find stub source file '$i']) + fi + PKG_STUB_SOURCES="$PKG_STUB_SOURCES $i" + # this assumes it is in a VPATH dir + i=`basename $i` + # handle user calling this before or after TEA_SETUP_COMPILER + if test x"${OBJEXT}" != x ; then + j="`echo $i | sed -e 's/\.[[^.]]*$//'`.${OBJEXT}" + else + j="`echo $i | sed -e 's/\.[[^.]]*$//'`.\${OBJEXT}" + fi + PKG_STUB_OBJECTS="$PKG_STUB_OBJECTS $j" + done + AC_SUBST(PKG_STUB_SOURCES) + AC_SUBST(PKG_STUB_OBJECTS) +]) + +#------------------------------------------------------------------------ +# TEA_ADD_TCL_SOURCES -- +# +# Specify one or more Tcl source files. These should be platform +# independent runtime files. +# +# Arguments: +# one or more file names +# +# Results: +# +# Defines and substs the following vars: +# PKG_TCL_SOURCES +#------------------------------------------------------------------------ +AC_DEFUN([TEA_ADD_TCL_SOURCES], [ + vars="$@" + for i in $vars; do + # check for existence, be strict because it is installed + if test ! -f "${srcdir}/$i" ; then + AC_MSG_ERROR([could not find tcl source file '${srcdir}/$i']) + fi + PKG_TCL_SOURCES="$PKG_TCL_SOURCES $i" + done + AC_SUBST(PKG_TCL_SOURCES) +]) + +#------------------------------------------------------------------------ +# TEA_ADD_HEADERS -- +# +# Specify one or more source headers. Users should check for +# the right platform before adding to their list. +# +# Arguments: +# one or more file names +# +# Results: +# +# Defines and substs the following vars: +# PKG_HEADERS +#------------------------------------------------------------------------ +AC_DEFUN([TEA_ADD_HEADERS], [ + vars="$@" + for i in $vars; do + # check for existence, be strict because it is installed + if test ! -f "${srcdir}/$i" ; then + AC_MSG_ERROR([could not find header file '${srcdir}/$i']) + fi + PKG_HEADERS="$PKG_HEADERS $i" + done + AC_SUBST(PKG_HEADERS) +]) + +#------------------------------------------------------------------------ +# TEA_ADD_INCLUDES -- +# +# Specify one or more include dirs. Users should check for +# the right platform before adding to their list. +# +# Arguments: +# one or more file names +# +# Results: +# +# Defines and substs the following vars: +# PKG_INCLUDES +#------------------------------------------------------------------------ +AC_DEFUN([TEA_ADD_INCLUDES], [ + vars="$@" + for i in $vars; do + PKG_INCLUDES="$PKG_INCLUDES $i" + done + AC_SUBST(PKG_INCLUDES) +]) + +#------------------------------------------------------------------------ +# TEA_ADD_LIBS -- +# +# Specify one or more libraries. Users should check for +# the right platform before adding to their list. For Windows, +# libraries provided in "foo.lib" format will be converted to +# "-lfoo" when using GCC (mingw). +# +# Arguments: +# one or more file names +# +# Results: +# +# Defines and substs the following vars: +# PKG_LIBS +#------------------------------------------------------------------------ +AC_DEFUN([TEA_ADD_LIBS], [ + vars="$@" + for i in $vars; do + if test "${TEA_PLATFORM}" = "windows" -a "$GCC" = "yes" ; then + # Convert foo.lib to -lfoo for GCC. No-op if not *.lib + i=`echo "$i" | sed -e 's/^\([[^-]].*\)\.lib[$]/-l\1/i'` + fi + PKG_LIBS="$PKG_LIBS $i" + done + AC_SUBST(PKG_LIBS) +]) + +#------------------------------------------------------------------------ +# TEA_ADD_CFLAGS -- +# +# Specify one or more CFLAGS. Users should check for +# the right platform before adding to their list. +# +# Arguments: +# one or more file names +# +# Results: +# +# Defines and substs the following vars: +# PKG_CFLAGS +#------------------------------------------------------------------------ +AC_DEFUN([TEA_ADD_CFLAGS], [ + PKG_CFLAGS="$PKG_CFLAGS $@" + AC_SUBST(PKG_CFLAGS) +]) + +#------------------------------------------------------------------------ +# TEA_ADD_CLEANFILES -- +# +# Specify one or more CLEANFILES. +# +# Arguments: +# one or more file names to clean target +# +# Results: +# +# Appends to CLEANFILES, already defined for subst in LOAD_TCLCONFIG +#------------------------------------------------------------------------ +AC_DEFUN([TEA_ADD_CLEANFILES], [ + CLEANFILES="$CLEANFILES $@" +]) + +#------------------------------------------------------------------------ +# TEA_PREFIX -- +# +# Handle the --prefix=... option by defaulting to what Tcl gave +# +# Arguments: +# none +# +# Results: +# +# If --prefix or --exec-prefix was not specified, $prefix and +# $exec_prefix will be set to the values given to Tcl when it was +# configured. +#------------------------------------------------------------------------ +AC_DEFUN([TEA_PREFIX], [ + if test "${prefix}" = "NONE"; then + prefix_default=yes + if test x"${TCL_PREFIX}" != x; then + AC_MSG_NOTICE([--prefix defaulting to TCL_PREFIX ${TCL_PREFIX}]) + prefix=${TCL_PREFIX} + else + AC_MSG_NOTICE([--prefix defaulting to /usr/local]) + prefix=/usr/local + fi + fi + if test "${exec_prefix}" = "NONE" -a x"${prefix_default}" = x"yes" \ + -o x"${exec_prefix_default}" = x"yes" ; then + if test x"${TCL_EXEC_PREFIX}" != x; then + AC_MSG_NOTICE([--exec-prefix defaulting to TCL_EXEC_PREFIX ${TCL_EXEC_PREFIX}]) + exec_prefix=${TCL_EXEC_PREFIX} + else + AC_MSG_NOTICE([--exec-prefix defaulting to ${prefix}]) + exec_prefix=$prefix + fi + fi +]) + +#------------------------------------------------------------------------ +# TEA_SETUP_COMPILER_CC -- +# +# Do compiler checks the way we want. This is just a replacement +# for AC_PROG_CC in TEA configure.ac files to make them cleaner. +# +# Arguments: +# none +# +# Results: +# +# Sets up CC var and other standard bits we need to make executables. +#------------------------------------------------------------------------ +AC_DEFUN([TEA_SETUP_COMPILER_CC], [ + # Don't put any macros that use the compiler (e.g. AC_TRY_COMPILE) + # in this macro, they need to go into TEA_SETUP_COMPILER instead. + + AC_PROG_CC + AC_PROG_CPP + + #-------------------------------------------------------------------- + # Checks to see if the make program sets the $MAKE variable. + #-------------------------------------------------------------------- + + AC_PROG_MAKE_SET + + #-------------------------------------------------------------------- + # Find ranlib + #-------------------------------------------------------------------- + + AC_CHECK_TOOL(RANLIB, ranlib) + + #-------------------------------------------------------------------- + # Determines the correct binary file extension (.o, .obj, .exe etc.) + #-------------------------------------------------------------------- + + AC_OBJEXT + AC_EXEEXT +]) + +#------------------------------------------------------------------------ +# TEA_SETUP_COMPILER -- +# +# Do compiler checks that use the compiler. This must go after +# TEA_SETUP_COMPILER_CC, which does the actual compiler check. +# +# Arguments: +# none +# +# Results: +# +# Sets up CC var and other standard bits we need to make executables. +#------------------------------------------------------------------------ +AC_DEFUN([TEA_SETUP_COMPILER], [ + # Any macros that use the compiler (e.g. AC_TRY_COMPILE) have to go here. + AC_REQUIRE([TEA_SETUP_COMPILER_CC]) + + #------------------------------------------------------------------------ + # If we're using GCC, see if the compiler understands -pipe. If so, use it. + # It makes compiling go faster. (This is only a performance feature.) + #------------------------------------------------------------------------ + + if test -z "$no_pipe" -a -n "$GCC"; then + AC_CACHE_CHECK([if the compiler understands -pipe], + tcl_cv_cc_pipe, [ + hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -pipe" + AC_TRY_COMPILE(,, tcl_cv_cc_pipe=yes, tcl_cv_cc_pipe=no) + CFLAGS=$hold_cflags]) + if test $tcl_cv_cc_pipe = yes; then + CFLAGS="$CFLAGS -pipe" + fi + fi + + #-------------------------------------------------------------------- + # Common compiler flag setup + #-------------------------------------------------------------------- + + AC_C_BIGENDIAN +]) + +#------------------------------------------------------------------------ +# TEA_MAKE_LIB -- +# +# Generate a line that can be used to build a shared/unshared library +# in a platform independent manner. +# +# Arguments: +# none +# +# Requires: +# +# Results: +# +# Defines the following vars: +# CFLAGS - Done late here to note disturb other AC macros +# MAKE_LIB - Command to execute to build the Tcl library; +# differs depending on whether or not Tcl is being +# compiled as a shared library. +# MAKE_SHARED_LIB Makefile rule for building a shared library +# MAKE_STATIC_LIB Makefile rule for building a static library +# MAKE_STUB_LIB Makefile rule for building a stub library +# VC_MANIFEST_EMBED_DLL Makefile rule for embedded VC manifest in DLL +# VC_MANIFEST_EMBED_EXE Makefile rule for embedded VC manifest in EXE +#------------------------------------------------------------------------ + +AC_DEFUN([TEA_MAKE_LIB], [ + if test "${TEA_PLATFORM}" = "windows" -a "$GCC" != "yes"; then + MAKE_STATIC_LIB="\${STLIB_LD} -out:\[$]@ \$(PKG_OBJECTS)" + MAKE_SHARED_LIB="\${SHLIB_LD} \${SHLIB_LD_LIBS} \${LDFLAGS_DEFAULT} -out:\[$]@ \$(PKG_OBJECTS)" + AC_EGREP_CPP([manifest needed], [ +#if defined(_MSC_VER) && _MSC_VER >= 1400 +print("manifest needed") +#endif + ], [ + # Could do a CHECK_PROG for mt, but should always be with MSVC8+ + VC_MANIFEST_EMBED_DLL="if test -f \[$]@.manifest ; then mt.exe -nologo -manifest \[$]@.manifest -outputresource:\[$]@\;2 ; fi" + VC_MANIFEST_EMBED_EXE="if test -f \[$]@.manifest ; then mt.exe -nologo -manifest \[$]@.manifest -outputresource:\[$]@\;1 ; fi" + MAKE_SHARED_LIB="${MAKE_SHARED_LIB} ; ${VC_MANIFEST_EMBED_DLL}" + TEA_ADD_CLEANFILES([*.manifest]) + ]) + MAKE_STUB_LIB="\${STLIB_LD} -nodefaultlib -out:\[$]@ \$(PKG_STUB_OBJECTS)" + else + MAKE_STATIC_LIB="\${STLIB_LD} \[$]@ \$(PKG_OBJECTS)" + MAKE_SHARED_LIB="\${SHLIB_LD} -o \[$]@ \$(PKG_OBJECTS) \${SHLIB_LD_LIBS}" + MAKE_STUB_LIB="\${STLIB_LD} \[$]@ \$(PKG_STUB_OBJECTS)" + fi + + if test "${SHARED_BUILD}" = "1" ; then + MAKE_LIB="${MAKE_SHARED_LIB} " + else + MAKE_LIB="${MAKE_STATIC_LIB} " + fi + + #-------------------------------------------------------------------- + # Shared libraries and static libraries have different names. + # Use the double eval to make sure any variables in the suffix is + # substituted. (@@@ Might not be necessary anymore) + #-------------------------------------------------------------------- + + if test "${TEA_PLATFORM}" = "windows" ; then + if test "${SHARED_BUILD}" = "1" ; then + # We force the unresolved linking of symbols that are really in + # the private libraries of Tcl and Tk. + if test x"${TK_BIN_DIR}" != x ; then + SHLIB_LD_LIBS="${SHLIB_LD_LIBS} \"`${CYGPATH} ${TK_BIN_DIR}/${TK_STUB_LIB_FILE}`\"" + fi + SHLIB_LD_LIBS="${SHLIB_LD_LIBS} \"`${CYGPATH} ${TCL_BIN_DIR}/${TCL_STUB_LIB_FILE}`\"" + if test "$GCC" = "yes"; then + SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -static-libgcc" + fi + eval eval "PKG_LIB_FILE=${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}${SHARED_LIB_SUFFIX}" + else + eval eval "PKG_LIB_FILE=${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}${UNSHARED_LIB_SUFFIX}" + if test "$GCC" = "yes"; then + PKG_LIB_FILE=lib${PKG_LIB_FILE} + fi + fi + # Some packages build their own stubs libraries + eval eval "PKG_STUB_LIB_FILE=${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}stub${UNSHARED_LIB_SUFFIX}" + if test "$GCC" = "yes"; then + PKG_STUB_LIB_FILE=lib${PKG_STUB_LIB_FILE} + fi + # These aren't needed on Windows (either MSVC or gcc) + RANLIB=: + RANLIB_STUB=: + else + RANLIB_STUB="${RANLIB}" + if test "${SHARED_BUILD}" = "1" ; then + SHLIB_LD_LIBS="${SHLIB_LD_LIBS} ${TCL_STUB_LIB_SPEC}" + if test x"${TK_BIN_DIR}" != x ; then + SHLIB_LD_LIBS="${SHLIB_LD_LIBS} ${TK_STUB_LIB_SPEC}" + fi + eval eval "PKG_LIB_FILE=lib${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}${SHARED_LIB_SUFFIX}" + RANLIB=: + else + eval eval "PKG_LIB_FILE=lib${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}${UNSHARED_LIB_SUFFIX}" + fi + # Some packages build their own stubs libraries + eval eval "PKG_STUB_LIB_FILE=lib${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}stub${UNSHARED_LIB_SUFFIX}" + fi + + # These are escaped so that only CFLAGS is picked up at configure time. + # The other values will be substituted at make time. + CFLAGS="${CFLAGS} \${CFLAGS_DEFAULT} \${CFLAGS_WARNING}" + if test "${SHARED_BUILD}" = "1" ; then + CFLAGS="${CFLAGS} \${SHLIB_CFLAGS}" + fi + + AC_SUBST(MAKE_LIB) + AC_SUBST(MAKE_SHARED_LIB) + AC_SUBST(MAKE_STATIC_LIB) + AC_SUBST(MAKE_STUB_LIB) + AC_SUBST(RANLIB_STUB) + AC_SUBST(VC_MANIFEST_EMBED_DLL) + AC_SUBST(VC_MANIFEST_EMBED_EXE) +]) + +#------------------------------------------------------------------------ +# TEA_LIB_SPEC -- +# +# Compute the name of an existing object library located in libdir +# from the given base name and produce the appropriate linker flags. +# +# Arguments: +# basename The base name of the library without version +# numbers, extensions, or "lib" prefixes. +# extra_dir Extra directory in which to search for the +# library. This location is used first, then +# $prefix/$exec-prefix, then some defaults. +# +# Requires: +# TEA_INIT and TEA_PREFIX must be called first. +# +# Results: +# +# Defines the following vars: +# ${basename}_LIB_NAME The computed library name. +# ${basename}_LIB_SPEC The computed linker flags. +#------------------------------------------------------------------------ + +AC_DEFUN([TEA_LIB_SPEC], [ + AC_MSG_CHECKING([for $1 library]) + + # Look in exec-prefix for the library (defined by TEA_PREFIX). + + tea_lib_name_dir="${exec_prefix}/lib" + + # Or in a user-specified location. + + if test x"$2" != x ; then + tea_extra_lib_dir=$2 + else + tea_extra_lib_dir=NONE + fi + + for i in \ + `ls -dr ${tea_extra_lib_dir}/$1[[0-9]]*.lib 2>/dev/null ` \ + `ls -dr ${tea_extra_lib_dir}/lib$1[[0-9]]* 2>/dev/null ` \ + `ls -dr ${tea_lib_name_dir}/$1[[0-9]]*.lib 2>/dev/null ` \ + `ls -dr ${tea_lib_name_dir}/lib$1[[0-9]]* 2>/dev/null ` \ + `ls -dr /usr/lib/$1[[0-9]]*.lib 2>/dev/null ` \ + `ls -dr /usr/lib/lib$1[[0-9]]* 2>/dev/null ` \ + `ls -dr /usr/lib64/$1[[0-9]]*.lib 2>/dev/null ` \ + `ls -dr /usr/lib64/lib$1[[0-9]]* 2>/dev/null ` \ + `ls -dr /usr/local/lib/$1[[0-9]]*.lib 2>/dev/null ` \ + `ls -dr /usr/local/lib/lib$1[[0-9]]* 2>/dev/null ` ; do + if test -f "$i" ; then + tea_lib_name_dir=`dirname $i` + $1_LIB_NAME=`basename $i` + $1_LIB_PATH_NAME=$i + break + fi + done + + if test "${TEA_PLATFORM}" = "windows"; then + $1_LIB_SPEC=\"`${CYGPATH} ${$1_LIB_PATH_NAME} 2>/dev/null`\" + else + # Strip off the leading "lib" and trailing ".a" or ".so" + + tea_lib_name_lib=`echo ${$1_LIB_NAME}|sed -e 's/^lib//' -e 's/\.[[^.]]*$//' -e 's/\.so.*//'` + $1_LIB_SPEC="-L${tea_lib_name_dir} -l${tea_lib_name_lib}" + fi + + if test "x${$1_LIB_NAME}" = x ; then + AC_MSG_ERROR([not found]) + else + AC_MSG_RESULT([${$1_LIB_SPEC}]) + fi +]) + +#------------------------------------------------------------------------ +# TEA_PRIVATE_TCL_HEADERS -- +# +# Locate the private Tcl include files +# +# Arguments: +# +# Requires: +# TCL_SRC_DIR Assumes that TEA_LOAD_TCLCONFIG has +# already been called. +# +# Results: +# +# Substitutes the following vars: +# TCL_TOP_DIR_NATIVE +# TCL_INCLUDES +#------------------------------------------------------------------------ + +AC_DEFUN([TEA_PRIVATE_TCL_HEADERS], [ + # Allow for --with-tclinclude to take effect and define ${ac_cv_c_tclh} + AC_REQUIRE([TEA_PUBLIC_TCL_HEADERS]) + AC_MSG_CHECKING([for Tcl private include files]) + + TCL_SRC_DIR_NATIVE=`${CYGPATH} ${TCL_SRC_DIR}` + TCL_TOP_DIR_NATIVE=\"${TCL_SRC_DIR_NATIVE}\" + + # Check to see if tclPort.h isn't already with the public headers + # Don't look for tclInt.h because that resides with tcl.h in the core + # sources, but the Port headers are in a different directory + if test "${TEA_PLATFORM}" = "windows" -a \ + -f "${ac_cv_c_tclh}/tclWinPort.h"; then + result="private headers found with public headers" + elif test "${TEA_PLATFORM}" = "unix" -a \ + -f "${ac_cv_c_tclh}/tclUnixPort.h"; then + result="private headers found with public headers" + else + TCL_GENERIC_DIR_NATIVE=\"${TCL_SRC_DIR_NATIVE}/generic\" + if test "${TEA_PLATFORM}" = "windows"; then + TCL_PLATFORM_DIR_NATIVE=\"${TCL_SRC_DIR_NATIVE}/win\" + else + TCL_PLATFORM_DIR_NATIVE=\"${TCL_SRC_DIR_NATIVE}/unix\" + fi + # Overwrite the previous TCL_INCLUDES as this should capture both + # public and private headers in the same set. + # We want to ensure these are substituted so as not to require + # any *_NATIVE vars be defined in the Makefile + TCL_INCLUDES="-I${TCL_GENERIC_DIR_NATIVE} -I${TCL_PLATFORM_DIR_NATIVE}" + if test "`uname -s`" = "Darwin"; then + # If Tcl was built as a framework, attempt to use + # the framework's Headers and PrivateHeaders directories + case ${TCL_DEFS} in + *TCL_FRAMEWORK*) + if test -d "${TCL_BIN_DIR}/Headers" -a \ + -d "${TCL_BIN_DIR}/PrivateHeaders"; then + TCL_INCLUDES="-I\"${TCL_BIN_DIR}/Headers\" -I\"${TCL_BIN_DIR}/PrivateHeaders\" ${TCL_INCLUDES}" + else + TCL_INCLUDES="${TCL_INCLUDES} ${TCL_INCLUDE_SPEC} `echo "${TCL_INCLUDE_SPEC}" | sed -e 's/Headers/PrivateHeaders/'`" + fi + ;; + esac + result="Using ${TCL_INCLUDES}" + else + if test ! -f "${TCL_SRC_DIR}/generic/tclInt.h" ; then + AC_MSG_ERROR([Cannot find private header tclInt.h in ${TCL_SRC_DIR}]) + fi + result="Using srcdir found in tclConfig.sh: ${TCL_SRC_DIR}" + fi + fi + + AC_SUBST(TCL_TOP_DIR_NATIVE) + + AC_SUBST(TCL_INCLUDES) + AC_MSG_RESULT([${result}]) +]) + +#------------------------------------------------------------------------ +# TEA_PUBLIC_TCL_HEADERS -- +# +# Locate the installed public Tcl header files +# +# Arguments: +# None. +# +# Requires: +# CYGPATH must be set +# +# Results: +# +# Adds a --with-tclinclude switch to configure. +# Result is cached. +# +# Substitutes the following vars: +# TCL_INCLUDES +#------------------------------------------------------------------------ + +AC_DEFUN([TEA_PUBLIC_TCL_HEADERS], [ + AC_MSG_CHECKING([for Tcl public headers]) + + AC_ARG_WITH(tclinclude, [ --with-tclinclude directory containing the public Tcl header files], with_tclinclude=${withval}) + + AC_CACHE_VAL(ac_cv_c_tclh, [ + # Use the value from --with-tclinclude, if it was given + + if test x"${with_tclinclude}" != x ; then + if test -f "${with_tclinclude}/tcl.h" ; then + ac_cv_c_tclh=${with_tclinclude} + else + AC_MSG_ERROR([${with_tclinclude} directory does not contain tcl.h]) + fi + else + list="" + if test "`uname -s`" = "Darwin"; then + # If Tcl was built as a framework, attempt to use + # the framework's Headers directory + case ${TCL_DEFS} in + *TCL_FRAMEWORK*) + list="`ls -d ${TCL_BIN_DIR}/Headers 2>/dev/null`" + ;; + esac + fi + + # Look in the source dir only if Tcl is not installed, + # and in that situation, look there before installed locations. + if test -f "${TCL_BIN_DIR}/Makefile" ; then + list="$list `ls -d ${TCL_SRC_DIR}/generic 2>/dev/null`" + fi + + # Check order: pkg --prefix location, Tcl's --prefix location, + # relative to directory of tclConfig.sh. + + eval "temp_includedir=${includedir}" + list="$list \ + `ls -d ${temp_includedir} 2>/dev/null` \ + `ls -d ${TCL_PREFIX}/include 2>/dev/null` \ + `ls -d ${TCL_BIN_DIR}/../include 2>/dev/null`" + if test "${TEA_PLATFORM}" != "windows" -o "$GCC" = "yes"; then + list="$list /usr/local/include /usr/include" + if test x"${TCL_INCLUDE_SPEC}" != x ; then + d=`echo "${TCL_INCLUDE_SPEC}" | sed -e 's/^-I//'` + list="$list `ls -d ${d} 2>/dev/null`" + fi + fi + for i in $list ; do + if test -f "$i/tcl.h" ; then + ac_cv_c_tclh=$i + break + fi + done + fi + ]) + + # Print a message based on how we determined the include path + + if test x"${ac_cv_c_tclh}" = x ; then + AC_MSG_ERROR([tcl.h not found. Please specify its location with --with-tclinclude]) + else + AC_MSG_RESULT([${ac_cv_c_tclh}]) + fi + + # Convert to a native path and substitute into the output files. + + INCLUDE_DIR_NATIVE=`${CYGPATH} ${ac_cv_c_tclh}` + + TCL_INCLUDES=-I\"${INCLUDE_DIR_NATIVE}\" + + AC_SUBST(TCL_INCLUDES) +]) + +#------------------------------------------------------------------------ +# TEA_PRIVATE_TK_HEADERS -- +# +# Locate the private Tk include files +# +# Arguments: +# +# Requires: +# TK_SRC_DIR Assumes that TEA_LOAD_TKCONFIG has +# already been called. +# +# Results: +# +# Substitutes the following vars: +# TK_INCLUDES +#------------------------------------------------------------------------ + +AC_DEFUN([TEA_PRIVATE_TK_HEADERS], [ + # Allow for --with-tkinclude to take effect and define ${ac_cv_c_tkh} + AC_REQUIRE([TEA_PUBLIC_TK_HEADERS]) + AC_MSG_CHECKING([for Tk private include files]) + + TK_SRC_DIR_NATIVE=`${CYGPATH} ${TK_SRC_DIR}` + TK_TOP_DIR_NATIVE=\"${TK_SRC_DIR_NATIVE}\" + + # Check to see if tkPort.h isn't already with the public headers + # Don't look for tkInt.h because that resides with tk.h in the core + # sources, but the Port headers are in a different directory + if test "${TEA_PLATFORM}" = "windows" -a \ + -f "${ac_cv_c_tkh}/tkWinPort.h"; then + result="private headers found with public headers" + elif test "${TEA_PLATFORM}" = "unix" -a \ + -f "${ac_cv_c_tkh}/tkUnixPort.h"; then + result="private headers found with public headers" + else + TK_GENERIC_DIR_NATIVE=\"${TK_SRC_DIR_NATIVE}/generic\" + TK_XLIB_DIR_NATIVE=\"${TK_SRC_DIR_NATIVE}/xlib\" + if test "${TEA_PLATFORM}" = "windows"; then + TK_PLATFORM_DIR_NATIVE=\"${TK_SRC_DIR_NATIVE}/win\" + else + TK_PLATFORM_DIR_NATIVE=\"${TK_SRC_DIR_NATIVE}/unix\" + fi + # Overwrite the previous TK_INCLUDES as this should capture both + # public and private headers in the same set. + # We want to ensure these are substituted so as not to require + # any *_NATIVE vars be defined in the Makefile + TK_INCLUDES="-I${TK_GENERIC_DIR_NATIVE} -I${TK_PLATFORM_DIR_NATIVE}" + # Detect and add ttk subdir + if test -d "${TK_SRC_DIR}/generic/ttk"; then + TK_INCLUDES="${TK_INCLUDES} -I\"${TK_SRC_DIR_NATIVE}/generic/ttk\"" + fi + if test "${TEA_WINDOWINGSYSTEM}" != "x11"; then + TK_INCLUDES="${TK_INCLUDES} -I\"${TK_XLIB_DIR_NATIVE}\"" + fi + if test "${TEA_WINDOWINGSYSTEM}" = "aqua"; then + TK_INCLUDES="${TK_INCLUDES} -I\"${TK_SRC_DIR_NATIVE}/macosx\"" + fi + if test "`uname -s`" = "Darwin"; then + # If Tk was built as a framework, attempt to use + # the framework's Headers and PrivateHeaders directories + case ${TK_DEFS} in + *TK_FRAMEWORK*) + if test -d "${TK_BIN_DIR}/Headers" -a \ + -d "${TK_BIN_DIR}/PrivateHeaders"; then + TK_INCLUDES="-I\"${TK_BIN_DIR}/Headers\" -I\"${TK_BIN_DIR}/PrivateHeaders\" ${TK_INCLUDES}" + else + TK_INCLUDES="${TK_INCLUDES} ${TK_INCLUDE_SPEC} `echo "${TK_INCLUDE_SPEC}" | sed -e 's/Headers/PrivateHeaders/'`" + fi + ;; + esac + result="Using ${TK_INCLUDES}" + else + if test ! -f "${TK_SRC_DIR}/generic/tkInt.h" ; then + AC_MSG_ERROR([Cannot find private header tkInt.h in ${TK_SRC_DIR}]) + fi + result="Using srcdir found in tkConfig.sh: ${TK_SRC_DIR}" + fi + fi + + AC_SUBST(TK_TOP_DIR_NATIVE) + AC_SUBST(TK_XLIB_DIR_NATIVE) + + AC_SUBST(TK_INCLUDES) + AC_MSG_RESULT([${result}]) +]) + +#------------------------------------------------------------------------ +# TEA_PUBLIC_TK_HEADERS -- +# +# Locate the installed public Tk header files +# +# Arguments: +# None. +# +# Requires: +# CYGPATH must be set +# +# Results: +# +# Adds a --with-tkinclude switch to configure. +# Result is cached. +# +# Substitutes the following vars: +# TK_INCLUDES +#------------------------------------------------------------------------ + +AC_DEFUN([TEA_PUBLIC_TK_HEADERS], [ + AC_MSG_CHECKING([for Tk public headers]) + + AC_ARG_WITH(tkinclude, [ --with-tkinclude directory containing the public Tk header files], with_tkinclude=${withval}) + + AC_CACHE_VAL(ac_cv_c_tkh, [ + # Use the value from --with-tkinclude, if it was given + + if test x"${with_tkinclude}" != x ; then + if test -f "${with_tkinclude}/tk.h" ; then + ac_cv_c_tkh=${with_tkinclude} + else + AC_MSG_ERROR([${with_tkinclude} directory does not contain tk.h]) + fi + else + list="" + if test "`uname -s`" = "Darwin"; then + # If Tk was built as a framework, attempt to use + # the framework's Headers directory. + case ${TK_DEFS} in + *TK_FRAMEWORK*) + list="`ls -d ${TK_BIN_DIR}/Headers 2>/dev/null`" + ;; + esac + fi + + # Look in the source dir only if Tk is not installed, + # and in that situation, look there before installed locations. + if test -f "${TK_BIN_DIR}/Makefile" ; then + list="$list `ls -d ${TK_SRC_DIR}/generic 2>/dev/null`" + fi + + # Check order: pkg --prefix location, Tk's --prefix location, + # relative to directory of tkConfig.sh, Tcl's --prefix location, + # relative to directory of tclConfig.sh. + + eval "temp_includedir=${includedir}" + list="$list \ + `ls -d ${temp_includedir} 2>/dev/null` \ + `ls -d ${TK_PREFIX}/include 2>/dev/null` \ + `ls -d ${TK_BIN_DIR}/../include 2>/dev/null` \ + `ls -d ${TCL_PREFIX}/include 2>/dev/null` \ + `ls -d ${TCL_BIN_DIR}/../include 2>/dev/null`" + if test "${TEA_PLATFORM}" != "windows" -o "$GCC" = "yes"; then + list="$list /usr/local/include /usr/include" + if test x"${TK_INCLUDE_SPEC}" != x ; then + d=`echo "${TK_INCLUDE_SPEC}" | sed -e 's/^-I//'` + list="$list `ls -d ${d} 2>/dev/null`" + fi + fi + for i in $list ; do + if test -f "$i/tk.h" ; then + ac_cv_c_tkh=$i + break + fi + done + fi + ]) + + # Print a message based on how we determined the include path + + if test x"${ac_cv_c_tkh}" = x ; then + AC_MSG_ERROR([tk.h not found. Please specify its location with --with-tkinclude]) + else + AC_MSG_RESULT([${ac_cv_c_tkh}]) + fi + + # Convert to a native path and substitute into the output files. + + INCLUDE_DIR_NATIVE=`${CYGPATH} ${ac_cv_c_tkh}` + + TK_INCLUDES=-I\"${INCLUDE_DIR_NATIVE}\" + + AC_SUBST(TK_INCLUDES) + + if test "${TEA_WINDOWINGSYSTEM}" != "x11"; then + # On Windows and Aqua, we need the X compat headers + AC_MSG_CHECKING([for X11 header files]) + if test ! -r "${INCLUDE_DIR_NATIVE}/X11/Xlib.h"; then + INCLUDE_DIR_NATIVE="`${CYGPATH} ${TK_SRC_DIR}/xlib`" + TK_XINCLUDES=-I\"${INCLUDE_DIR_NATIVE}\" + AC_SUBST(TK_XINCLUDES) + fi + AC_MSG_RESULT([${INCLUDE_DIR_NATIVE}]) + fi +]) + +#------------------------------------------------------------------------ +# TEA_PATH_CONFIG -- +# +# Locate the ${1}Config.sh file and perform a sanity check on +# the ${1} compile flags. These are used by packages like +# [incr Tk] that load *Config.sh files from more than Tcl and Tk. +# +# Arguments: +# none +# +# Results: +# +# Adds the following arguments to configure: +# --with-$1=... +# +# Defines the following vars: +# $1_BIN_DIR Full path to the directory containing +# the $1Config.sh file +#------------------------------------------------------------------------ + +AC_DEFUN([TEA_PATH_CONFIG], [ + # + # Ok, lets find the $1 configuration + # First, look for one uninstalled. + # the alternative search directory is invoked by --with-$1 + # + + if test x"${no_$1}" = x ; then + # we reset no_$1 in case something fails here + no_$1=true + AC_ARG_WITH($1, [ --with-$1 directory containing $1 configuration ($1Config.sh)], with_$1config=${withval}) + AC_MSG_CHECKING([for $1 configuration]) + AC_CACHE_VAL(ac_cv_c_$1config,[ + + # First check to see if --with-$1 was specified. + if test x"${with_$1config}" != x ; then + case ${with_$1config} in + */$1Config.sh ) + if test -f ${with_$1config}; then + AC_MSG_WARN([--with-$1 argument should refer to directory containing $1Config.sh, not to $1Config.sh itself]) + with_$1config=`echo ${with_$1config} | sed 's!/$1Config\.sh$!!'` + fi;; + esac + if test -f "${with_$1config}/$1Config.sh" ; then + ac_cv_c_$1config=`(cd ${with_$1config}; pwd)` + else + AC_MSG_ERROR([${with_$1config} directory doesn't contain $1Config.sh]) + fi + fi + + # then check for a private $1 installation + if test x"${ac_cv_c_$1config}" = x ; then + for i in \ + ../$1 \ + `ls -dr ../$1*[[0-9]].[[0-9]]*.[[0-9]]* 2>/dev/null` \ + `ls -dr ../$1*[[0-9]].[[0-9]][[0-9]] 2>/dev/null` \ + `ls -dr ../$1*[[0-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../$1*[[0-9]].[[0-9]]* 2>/dev/null` \ + ../../$1 \ + `ls -dr ../../$1*[[0-9]].[[0-9]]*.[[0-9]]* 2>/dev/null` \ + `ls -dr ../../$1*[[0-9]].[[0-9]][[0-9]] 2>/dev/null` \ + `ls -dr ../../$1*[[0-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../../$1*[[0-9]].[[0-9]]* 2>/dev/null` \ + ../../../$1 \ + `ls -dr ../../../$1*[[0-9]].[[0-9]]*.[[0-9]]* 2>/dev/null` \ + `ls -dr ../../../$1*[[0-9]].[[0-9]][[0-9]] 2>/dev/null` \ + `ls -dr ../../../$1*[[0-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ../../../$1*[[0-9]].[[0-9]]* 2>/dev/null` \ + ${srcdir}/../$1 \ + `ls -dr ${srcdir}/../$1*[[0-9]].[[0-9]]*.[[0-9]]* 2>/dev/null` \ + `ls -dr ${srcdir}/../$1*[[0-9]].[[0-9]][[0-9]] 2>/dev/null` \ + `ls -dr ${srcdir}/../$1*[[0-9]].[[0-9]] 2>/dev/null` \ + `ls -dr ${srcdir}/../$1*[[0-9]].[[0-9]]* 2>/dev/null` \ + ; do + if test -f "$i/$1Config.sh" ; then + ac_cv_c_$1config=`(cd $i; pwd)` + break + fi + if test -f "$i/unix/$1Config.sh" ; then + ac_cv_c_$1config=`(cd $i/unix; pwd)` + break + fi + done + fi + + # check in a few common install locations + if test x"${ac_cv_c_$1config}" = x ; then + for i in `ls -d ${libdir} 2>/dev/null` \ + `ls -d ${exec_prefix}/lib 2>/dev/null` \ + `ls -d ${prefix}/lib 2>/dev/null` \ + `ls -d /usr/local/lib 2>/dev/null` \ + `ls -d /usr/contrib/lib 2>/dev/null` \ + `ls -d /usr/pkg/lib 2>/dev/null` \ + `ls -d /usr/lib 2>/dev/null` \ + `ls -d /usr/lib64 2>/dev/null` \ + ; do + if test -f "$i/$1Config.sh" ; then + ac_cv_c_$1config=`(cd $i; pwd)` + break + fi + done + fi + ]) + + if test x"${ac_cv_c_$1config}" = x ; then + $1_BIN_DIR="# no $1 configs found" + AC_MSG_WARN([Cannot find $1 configuration definitions]) + exit 0 + else + no_$1= + $1_BIN_DIR=${ac_cv_c_$1config} + AC_MSG_RESULT([found $$1_BIN_DIR/$1Config.sh]) + fi + fi +]) + +#------------------------------------------------------------------------ +# TEA_LOAD_CONFIG -- +# +# Load the $1Config.sh file +# +# Arguments: +# +# Requires the following vars to be set: +# $1_BIN_DIR +# +# Results: +# +# Substitutes the following vars: +# $1_SRC_DIR +# $1_LIB_FILE +# $1_LIB_SPEC +#------------------------------------------------------------------------ + +AC_DEFUN([TEA_LOAD_CONFIG], [ + AC_MSG_CHECKING([for existence of ${$1_BIN_DIR}/$1Config.sh]) + + if test -f "${$1_BIN_DIR}/$1Config.sh" ; then + AC_MSG_RESULT([loading]) + . "${$1_BIN_DIR}/$1Config.sh" + else + AC_MSG_RESULT([file not found]) + fi + + # + # If the $1_BIN_DIR is the build directory (not the install directory), + # then set the common variable name to the value of the build variables. + # For example, the variable $1_LIB_SPEC will be set to the value + # of $1_BUILD_LIB_SPEC. An extension should make use of $1_LIB_SPEC + # instead of $1_BUILD_LIB_SPEC since it will work with both an + # installed and uninstalled version of Tcl. + # + + if test -f "${$1_BIN_DIR}/Makefile" ; then + AC_MSG_WARN([Found Makefile - using build library specs for $1]) + $1_LIB_SPEC=${$1_BUILD_LIB_SPEC} + $1_STUB_LIB_SPEC=${$1_BUILD_STUB_LIB_SPEC} + $1_STUB_LIB_PATH=${$1_BUILD_STUB_LIB_PATH} + $1_INCLUDE_SPEC=${$1_BUILD_INCLUDE_SPEC} + $1_LIBRARY_PATH=${$1_LIBRARY_PATH} + fi + + AC_SUBST($1_VERSION) + AC_SUBST($1_BIN_DIR) + AC_SUBST($1_SRC_DIR) + + AC_SUBST($1_LIB_FILE) + AC_SUBST($1_LIB_SPEC) + + AC_SUBST($1_STUB_LIB_FILE) + AC_SUBST($1_STUB_LIB_SPEC) + AC_SUBST($1_STUB_LIB_PATH) + + # Allow the caller to prevent this auto-check by specifying any 2nd arg + AS_IF([test "x$2" = x], [ + # Check both upper and lower-case variants + # If a dev wanted non-stubs libs, this function could take an option + # to not use _STUB in the paths below + AS_IF([test "x${$1_STUB_LIB_SPEC}" = x], + [TEA_LOAD_CONFIG_LIB(translit($1,[a-z],[A-Z])_STUB)], + [TEA_LOAD_CONFIG_LIB($1_STUB)]) + ]) +]) + +#------------------------------------------------------------------------ +# TEA_LOAD_CONFIG_LIB -- +# +# Helper function to load correct library from another extension's +# ${PACKAGE}Config.sh. +# +# Results: +# Adds to LIBS the appropriate extension library +#------------------------------------------------------------------------ +AC_DEFUN([TEA_LOAD_CONFIG_LIB], [ + AC_MSG_CHECKING([For $1 library for LIBS]) + # This simplifies the use of stub libraries by automatically adding + # the stub lib to your path. Normally this would add to SHLIB_LD_LIBS, + # but this is called before CONFIG_CFLAGS. More importantly, this adds + # to PKG_LIBS, which becomes LIBS, and that is only used by SHLIB_LD. + if test "x${$1_LIB_SPEC}" != "x" ; then + if test "${TEA_PLATFORM}" = "windows" -a "$GCC" != "yes" ; then + TEA_ADD_LIBS([\"`${CYGPATH} ${$1_LIB_PATH}`\"]) + AC_MSG_RESULT([using $1_LIB_PATH ${$1_LIB_PATH}]) + else + TEA_ADD_LIBS([${$1_LIB_SPEC}]) + AC_MSG_RESULT([using $1_LIB_SPEC ${$1_LIB_SPEC}]) + fi + else + AC_MSG_RESULT([file not found]) + fi +]) + +#------------------------------------------------------------------------ +# TEA_EXPORT_CONFIG -- +# +# Define the data to insert into the ${PACKAGE}Config.sh file +# +# Arguments: +# +# Requires the following vars to be set: +# $1 +# +# Results: +# Substitutes the following vars: +#------------------------------------------------------------------------ + +AC_DEFUN([TEA_EXPORT_CONFIG], [ + #-------------------------------------------------------------------- + # These are for $1Config.sh + #-------------------------------------------------------------------- + + # pkglibdir must be a fully qualified path and (not ${exec_prefix}/lib) + eval pkglibdir="[$]{libdir}/$1${PACKAGE_VERSION}" + if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then + eval $1_LIB_FLAG="-l$1${PACKAGE_VERSION}${DBGX}" + eval $1_STUB_LIB_FLAG="-l$1stub${PACKAGE_VERSION}${DBGX}" + else + eval $1_LIB_FLAG="-l$1`echo ${PACKAGE_VERSION} | tr -d .`${DBGX}" + eval $1_STUB_LIB_FLAG="-l$1stub`echo ${PACKAGE_VERSION} | tr -d .`${DBGX}" + fi + $1_BUILD_LIB_SPEC="-L`$CYGPATH $(pwd)` ${$1_LIB_FLAG}" + $1_LIB_SPEC="-L`$CYGPATH ${pkglibdir}` ${$1_LIB_FLAG}" + $1_BUILD_STUB_LIB_SPEC="-L`$CYGPATH $(pwd)` [$]{$1_STUB_LIB_FLAG}" + $1_STUB_LIB_SPEC="-L`$CYGPATH ${pkglibdir}` [$]{$1_STUB_LIB_FLAG}" + $1_BUILD_STUB_LIB_PATH="`$CYGPATH $(pwd)`/[$]{PKG_STUB_LIB_FILE}" + $1_STUB_LIB_PATH="`$CYGPATH ${pkglibdir}`/[$]{PKG_STUB_LIB_FILE}" + + AC_SUBST($1_BUILD_LIB_SPEC) + AC_SUBST($1_LIB_SPEC) + AC_SUBST($1_BUILD_STUB_LIB_SPEC) + AC_SUBST($1_STUB_LIB_SPEC) + AC_SUBST($1_BUILD_STUB_LIB_PATH) + AC_SUBST($1_STUB_LIB_PATH) + + AC_SUBST(MAJOR_VERSION) + AC_SUBST(MINOR_VERSION) + AC_SUBST(PATCHLEVEL) +]) + + +#------------------------------------------------------------------------ +# TEA_PATH_CELIB -- +# +# Locate Keuchel's celib emulation layer for targeting Win/CE +# +# Arguments: +# none +# +# Results: +# +# Adds the following arguments to configure: +# --with-celib=... +# +# Defines the following vars: +# CELIB_DIR Full path to the directory containing +# the include and platform lib files +#------------------------------------------------------------------------ + +AC_DEFUN([TEA_PATH_CELIB], [ + # First, look for one uninstalled. + # the alternative search directory is invoked by --with-celib + + if test x"${no_celib}" = x ; then + # we reset no_celib in case something fails here + no_celib=true + AC_ARG_WITH(celib,[ --with-celib=DIR use Windows/CE support library from DIR], with_celibconfig=${withval}) + AC_MSG_CHECKING([for Windows/CE celib directory]) + AC_CACHE_VAL(ac_cv_c_celibconfig,[ + # First check to see if --with-celibconfig was specified. + if test x"${with_celibconfig}" != x ; then + if test -d "${with_celibconfig}/inc" ; then + ac_cv_c_celibconfig=`(cd ${with_celibconfig}; pwd)` + else + AC_MSG_ERROR([${with_celibconfig} directory doesn't contain inc directory]) + fi + fi + + # then check for a celib library + if test x"${ac_cv_c_celibconfig}" = x ; then + for i in \ + ../celib-palm-3.0 \ + ../celib \ + ../../celib-palm-3.0 \ + ../../celib \ + `ls -dr ../celib-*3.[[0-9]]* 2>/dev/null` \ + ${srcdir}/../celib-palm-3.0 \ + ${srcdir}/../celib \ + `ls -dr ${srcdir}/../celib-*3.[[0-9]]* 2>/dev/null` \ + ; do + if test -d "$i/inc" ; then + ac_cv_c_celibconfig=`(cd $i; pwd)` + break + fi + done + fi + ]) + if test x"${ac_cv_c_celibconfig}" = x ; then + AC_MSG_ERROR([Cannot find celib support library directory]) + else + no_celib= + CELIB_DIR=${ac_cv_c_celibconfig} + CELIB_DIR=`echo "$CELIB_DIR" | sed -e 's!\\\!/!g'` + AC_MSG_RESULT([found $CELIB_DIR]) + fi + fi +]) + +#------------------------------------------------------------------------ +# TEA_INSTALLER -- +# +# Configure the installer. +# +# Arguments: +# none +# +# Results: +# Substitutes the following vars: +# INSTALL +# INSTALL_DATA_DIR +# INSTALL_DATA +# INSTALL_PROGRAM +# INSTALL_SCRIPT +# INSTALL_LIBRARY +#------------------------------------------------------------------------ + +AC_DEFUN([TEA_INSTALLER], [ + INSTALL='$(SHELL) $(srcdir)/tclconfig/install-sh -c' + INSTALL_DATA_DIR='${INSTALL} -d -m 755' + INSTALL_DATA='${INSTALL} -m 644' + INSTALL_PROGRAM='${INSTALL} -m 755' + INSTALL_SCRIPT='${INSTALL} -m 755' + + TEA_CONFIG_SYSTEM + case $system in + HP-UX-*) INSTALL_LIBRARY='${INSTALL} -m 755' ;; + *) INSTALL_LIBRARY='${INSTALL} -m 644' ;; + esac + + AC_SUBST(INSTALL) + AC_SUBST(INSTALL_DATA_DIR) + AC_SUBST(INSTALL_DATA) + AC_SUBST(INSTALL_PROGRAM) + AC_SUBST(INSTALL_SCRIPT) + AC_SUBST(INSTALL_LIBRARY) +]) + +### +# Tip 430 - ZipFS Modifications +### +#------------------------------------------------------------------------ +# SC_ZIPFS_SUPPORT +# Locate a zip encoder installed on the system path, or none. +# +# Arguments: +# none +# +# Results: +# Substitutes the following vars: +# TCL_ZIP_FILE +# TCL_ZIPFS_SUPPORT +# TCL_ZIPFS_FLAG +# ZIP_PROG +#------------------------------------------------------------------------ + +#------------------------------------------------------------------------ +# SC_PROG_ZIP +# Locate a zip encoder installed on the system path, or none. +# +# Arguments: +# none +# +# Results: +# Substitutes the following vars: +# ZIP_PROG +# ZIP_PROG_OPTIONS +# ZIP_PROG_VFSSEARCH +# ZIP_INSTALL_OBJS +#------------------------------------------------------------------------ +AC_DEFUN([TEA_ZIPFS_SUPPORT], [ + AC_MSG_CHECKING([for zipfs support]) + ZIP_PROG="" + ZIP_PROG_OPTIONS="" + ZIP_PROG_VFSSEARCH="" + INSTALL_MSGS="" + # If our native tclsh processes the "install" command line option + # we can use it to mint zip files + AS_IF([$TCLSH_PROG install],[ + ZIP_PROG=${TCLSH_PROG} + ZIP_PROG_OPTIONS="install mkzip" + ZIP_PROG_VFSSEARCH="." + AC_MSG_RESULT([Can use Native Tclsh for Zip encoding]) + ]) + if test "x$ZIP_PROG" = "x" ; then + AC_CACHE_VAL(ac_cv_path_zip, [ + search_path=`echo ${PATH} | sed -e 's/:/ /g'` + for dir in $search_path ; do + for j in `ls -r $dir/zip 2> /dev/null` \ + `ls -r $dir/zip 2> /dev/null` ; do + if test x"$ac_cv_path_zip" = x ; then + if test -f "$j" ; then + ac_cv_path_zip=$j + break + fi + fi + done + done + ]) + if test -f "$ac_cv_path_zip" ; then + ZIP_PROG="$ac_cv_path_zip " + AC_MSG_RESULT([$ZIP_PROG]) + ZIP_PROG_OPTIONS="-rq" + ZIP_PROG_VFSSEARCH="." + AC_MSG_RESULT([Found INFO Zip in environment]) + # Use standard arguments for zip + fi + fi + if test "x$ZIP_PROG" = "x" ; then + # It is not an error if an installed version of Zip can't be located. + ZIP_PROG="" + ZIP_PROG_OPTIONS="" + ZIP_PROG_VFSSEARCH="" + TCL_ZIPFS_SUPPORT=0 + TCL_ZIPFS_FLAG= + else + # ZIPFS Support + eval "TCL_ZIP_FILE=\"${TCL_ZIP_FILE}\"" + if test ${TCL_ZIP_FILE} = "" ; then + TCL_ZIPFS_SUPPORT=0 + TCL_ZIPFS_FLAG= + INSTALL_LIBRARIES=install-libraries + INSTALL_MSGS=install-msgs + else + if test ${SHARED_BUILD} = 1 ; then + TCL_ZIPFS_SUPPORT=1 + INSTALL_LIBRARIES=install-libraries-zipfs-shared + else + TCL_ZIPFS_SUPPORT=2 + INSTALL_LIBRARIES=install-libraries-zipfs-static + fi + TCL_ZIPFS_FLAG=-DTCL_ZIPFS_SUPPORT + fi + fi + + AC_SUBST(TCL_ZIP_FILE) + AC_SUBST(TCL_ZIPFS_SUPPORT) + AC_SUBST(TCL_ZIPFS_FLAG) + AC_SUBST(ZIP_PROG) + AC_SUBST(ZIP_PROG_OPTIONS) + AC_SUBST(ZIP_PROG_VFSSEARCH) + AC_SUBST(INSTALL_LIBRARIES) + AC_SUBST(INSTALL_MSGS) +]) + +# Local Variables: +# mode: autoconf +# End: diff --git a/tcldom-libxml2.c b/tcldom-libxml2.c new file mode 100644 index 0000000..79960d0 --- /dev/null +++ b/tcldom-libxml2.c @@ -0,0 +1,7178 @@ +/* tcldom-libxml2.c -- + * + * A Tcl wrapper for libxml's node tree API, + * conformant to the TclDOM API. + * + * Copyright (c) 2005-2008 by Explain. + * http://www.explain.com.au/ + * Copyright (c) 2001-2004 Zveno Pty Ltd + * http://www.zveno.com/ + * + * See the file "LICENSE" for information on usage and + * redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * $Id: tcldom-libxml2.c,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $ + */ + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#define TCL_DOES_STUBS \ + (TCL_MAJOR_VERSION > 8 || TCL_MAJOR_VERSION == 8 && (TCL_MINOR_VERSION > 1 || \ + (TCL_MINOR_VERSION == 1 && TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE))) + +#undef TCL_STORAGE_CLASS +#define TCL_STORAGE_CLASS DLLEXPORT + +/* + * Manage lists of Tcl_Obj's + */ + +typedef struct ObjList { + Tcl_Obj *objPtr; + struct ObjList *next; +} ObjList; + +/* + * Forward declarations for private functions. + */ + +static void FreeDocument _ANSI_ARGS_((ClientData clientData)); +static TclDOM_libxml2_Document * GetDOMDocument _ANSI_ARGS_((Tcl_Interp *interp, + TclXML_libxml2_Document *tDocPtr)); + +static void TclDOM_libxml2_DestroyNode _ANSI_ARGS_((Tcl_Interp *interp, TclDOM_libxml2_Node *tNodePtr)); +static void TclDOM_libxml2_InvalidateNode _ANSI_ARGS_((TclDOM_libxml2_Node *tNodePtr)); + +static char * TclDOMLiveNodeListNode _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, + char *name1, + char *name2, + int flags)); +static char * TclDOMLiveNodeListDoc _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, + char *name1, + char *name2, + int flags)); +static char * TclDOMLiveNamedNodeMap _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, + char *name1, + char *name2, + int flags)); +static int TclDOMSetLiveNodeListNode _ANSI_ARGS_((Tcl_Interp *interp, + char *varname, + xmlNodePtr nodePtr)); +static int TclDOMSetLiveNodeListDoc _ANSI_ARGS_((Tcl_Interp *interp, + char *varname, + xmlDocPtr docPtr)); +static int TclDOMSetLiveNamedNodeMap _ANSI_ARGS_((Tcl_Interp *interp, + char *varname, + xmlNodePtr nodePtr)); + +/* + * Forward declarations of commands + */ + +static int TclDOMDOMImplementationCommand _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST objv[])); +static int TclDOMDocumentCommand _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST objv[])); +static void DocumentNodeCmdDelete _ANSI_ARGS_((ClientData clientdata)); +static int TclDOMNodeCommand _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST objv[])); +static void TclDOMNodeCommandDelete _ANSI_ARGS_((ClientData clientdata)); +static int TclDOMElementCommand _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST objv[])); +static int TclDOMEventCommand _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST objv[])); +static void TclDOMEventCommandDelete _ANSI_ARGS_((ClientData clientdata)); +static Tcl_Obj * TclDOM_libxml2_NewEventObj _ANSI_ARGS_((Tcl_Interp *interp, + xmlDocPtr docPtr, + enum TclDOM_EventTypes type, + Tcl_Obj *typeObjPtr)); + +/* + * Functions that implement the TclDOM_Implementation interface + */ + +static int TclDOM_HasFeatureCommand _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST objv[])); +static int TclDOMCreateCommand _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST objv[])); +static int TclDOMDestroyCommand _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST objv[])); +static int TclDOMParseCommand _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST objv[])); +static int TclDOMSerializeCommand _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST objv[])); +static int TclDOMSelectNodeCommand _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST objv[])); +static int TclDOMIsNodeCommand _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST objv[])); +static int TclDOMAdoptCommand _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST objv[])); + +/* + * Additional features + */ + +static int TclDOMXIncludeCommand _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST objv[])); + +static int TclDOMPrefix2NSCommand _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST objv[])); +static int TclDOMTrimCommand _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST objv[])); + +static void TrimDocument _ANSI_ARGS_((Tcl_Interp *interp, xmlDocPtr docPtr)); +static int AdoptDocument _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr)); + +static int DocumentCget _ANSI_ARGS_((Tcl_Interp *interp, + xmlDocPtr docPtr, + Tcl_Obj *CONST objPtr)); +static int NodeCget _ANSI_ARGS_((Tcl_Interp *interp, + xmlDocPtr docPtr, + xmlNodePtr nodePtr, + Tcl_Obj *CONST objPtr)); +static int NodeConfigure _ANSI_ARGS_((Tcl_Interp *interp, + xmlNodePtr nodePtr, + int objc, + Tcl_Obj *CONST objPtr[])); +static int ElementCget _ANSI_ARGS_((Tcl_Interp *interp, + xmlNodePtr nodePtr, + Tcl_Obj *CONST objPtr)); + +static int TclDOM_NodeAppendChild _ANSI_ARGS_((Tcl_Interp *interp, + xmlNodePtr nodePtr, + xmlNodePtr newPtr)); +static int TclDOM_NodeInsertBefore _ANSI_ARGS_((Tcl_Interp *interp, + xmlNodePtr refPtr, + xmlNodePtr newPtr)); + +static void PostMutationEvents _ANSI_ARGS_((Tcl_Interp *interp, + TclXML_libxml2_Document *tDocPtr, + xmlNodePtr nodePtr, + xmlNodePtr refPtr, + xmlNodePtr newPtr, + xmlNodePtr oldParent, + xmlNodePtr newParent)); + +static int DTDValidate _ANSI_ARGS_((Tcl_Interp *interp, + TclDOM_libxml2_Document *domDocPtr)); +static int SchemaCompile _ANSI_ARGS_((Tcl_Interp *interp, + TclDOM_libxml2_Document *domDocPtr)); +static int SchemaValidate _ANSI_ARGS_((Tcl_Interp *interp, + TclDOM_libxml2_Document *domDocPtr, + xmlDocPtr instancePtr)); +/* +static int RelaxNGCompile _ANSI_ARGS_((Tcl_Interp *interp, + xmlDocPtr doc)); +static int RelaxNGValidate _ANSI_ARGS_((Tcl_Interp *interp, + xmlRelaxNGPtr schema, + xmlDocPtr instance)); +*/ + +static void NodeAddObjRef _ANSI_ARGS_((TclDOM_libxml2_Node *tNodePtr, + Tcl_Obj *objPtr)); +#if 0 +static void DumpNode _ANSI_ARGS_((TclDOM_libxml2_Node *tNodePtr)); +#endif + +/* + * Other utilities + */ + +static Tcl_Obj * GetPath _ANSI_ARGS_((Tcl_Interp *interp, + xmlNodePtr nodePtr)); + +/* + * MS VC++ oddities + */ + +#ifdef WIN32 +#if !defined (__CYGWIN__) +#define vsnprintf _vsnprintf +#define snprintf _snprintf +#endif /* __CYGWIN__ */ +#endif /* WIN32 */ + +/* + * Nodes as Tcl Objects (overloaded to also support event nodes). + */ + +Tcl_FreeInternalRepProc NodeTypeFree; +Tcl_DupInternalRepProc NodeTypeDup; +Tcl_UpdateStringProc NodeTypeUpdate; +Tcl_SetFromAnyProc NodeTypeSetFromAny; + +Tcl_ObjType NodeObjType = { + "libxml2-node", + NodeTypeFree, + NodeTypeDup, + NodeTypeUpdate, + NodeTypeSetFromAny +}; + +/* + * For additional checks when creating nodes. + * These are setup at initialisation-time, but thereafter are read-only. + */ + +static Tcl_Obj *checkName; +static Tcl_Obj *checkQName; + +/* + * libxml2 is mostly thread-safe, but there are issues with error callbacks + */ + +TCL_DECLARE_MUTEX(libxml2) + +/* + * Statically include the definitions of option tables: + * Due to linking problems on Windows, using MS VC++. + */ + +#include "tcldom.c" + +/* + *---------------------------------------------------------------------------- + * + * Tcldom_libxml2_Init -- + * + * Initialisation routine for module. + * This is no longer loaded as a separate module. + * + * Results: + * None. + * + * Side effects: + * Creates commands in the interpreter, + * + *---------------------------------------------------------------------------- + */ + +int +Tcldom_libxml2_Init (interp) + Tcl_Interp *interp; /* Interpreter to initialise */ +{ + + Tcl_MutexLock(&libxml2); + xmlXPathInit(); + Tcl_MutexUnlock(&libxml2); + + /* + * Provide a handler for nodes for structured error reporting + */ + + TclXML_libxml2_SetErrorNodeFunc(interp, + (TclXML_ErrorNodeHandlerProc *) TclDOM_libxml2_CreateObjFromNode); + + /* + * For each of the standard commands, register the command + * in both the ::dom and ::dom::libxml2 Tcl namespaces - + * they are equivalent. + */ + + Tcl_CreateObjCommand(interp, "dom::libxml2::DOMImplementation", + TclDOMDOMImplementationCommand, NULL, NULL); + Tcl_CreateObjCommand(interp, "dom::DOMImplementation", + TclDOMDOMImplementationCommand, NULL, NULL); + Tcl_CreateObjCommand(interp, "dom::libxml2::hasfeature", + TclDOM_HasFeatureCommand, NULL, NULL); + Tcl_CreateObjCommand(interp, "dom::hasfeature", + TclDOM_HasFeatureCommand, NULL, NULL); + Tcl_CreateObjCommand(interp, "dom::libxml2::document", + TclDOMDocumentCommand, NULL, NULL); + Tcl_CreateObjCommand(interp, "dom::document", + TclDOMDocumentCommand, NULL, NULL); + Tcl_CreateObjCommand(interp, "dom::libxml2::node", + TclDOMNodeCommand, NULL, NULL); + Tcl_CreateObjCommand(interp, "dom::node", + TclDOMNodeCommand, NULL, NULL); + Tcl_CreateObjCommand(interp, "dom::libxml2::create", + TclDOMCreateCommand, NULL, NULL); + Tcl_CreateObjCommand(interp, "dom::create", + TclDOMCreateCommand, NULL, NULL); + + /* + * Implemented in Tcl (for the moment) + Tcl_CreateObjCommand(interp, "dom::libxml2::parse", + TclDOMParseCommand, NULL, NULL); + Tcl_CreateObjCommand(interp, "dom::parse", + TclDOMParseCommand, NULL, NULL); + */ + Tcl_CreateObjCommand(interp, "dom::libxml2::adoptdocument", + TclDOMAdoptCommand, NULL, NULL); + + Tcl_CreateObjCommand(interp, "dom::libxml2::serialize", + TclDOMSerializeCommand, NULL, NULL); + Tcl_CreateObjCommand(interp, "dom::serialize", + TclDOMSerializeCommand, NULL, NULL); + Tcl_CreateObjCommand(interp, "dom::libxml2::selectnode", + TclDOMSelectNodeCommand, NULL, NULL); + Tcl_CreateObjCommand(interp, "dom::selectNode", + TclDOMSelectNodeCommand, NULL, NULL); + Tcl_CreateObjCommand(interp, "dom::libxml2::isNode", + TclDOMIsNodeCommand, NULL, NULL); + Tcl_CreateObjCommand(interp, "dom::isNode", + TclDOMIsNodeCommand, NULL, NULL); + Tcl_CreateObjCommand(interp, "dom::libxml2::element", + TclDOMElementCommand, NULL, NULL); + Tcl_CreateObjCommand(interp, "dom::element", + TclDOMElementCommand, NULL, NULL); + Tcl_CreateObjCommand(interp, "dom::libxml2::event", + TclDOMEventCommand, NULL, NULL); + Tcl_CreateObjCommand(interp, "dom::event", + TclDOMEventCommand, NULL, NULL); + Tcl_CreateObjCommand(interp, "dom::libxml2::xinclude", + TclDOMXIncludeCommand, NULL, NULL); + Tcl_CreateObjCommand(interp, "dom::xinclude", + TclDOMXIncludeCommand, NULL, NULL); + Tcl_CreateObjCommand(interp, "dom::libxml2::prefix2namespaceURI", + TclDOMPrefix2NSCommand, NULL, NULL); + Tcl_CreateObjCommand(interp, "dom::prefix2namespaceURI", + TclDOMPrefix2NSCommand, NULL, NULL); + Tcl_CreateObjCommand(interp, "dom::libxml2::destroy", + TclDOMDestroyCommand, NULL, NULL); + Tcl_CreateObjCommand(interp, "dom::destroy", + TclDOMDestroyCommand, NULL, NULL); + Tcl_CreateObjCommand(interp, "dom::libxml2::trim", + TclDOMTrimCommand, NULL, NULL); + Tcl_CreateObjCommand(interp, "dom::trim", + TclDOMTrimCommand, NULL, NULL); + + /* Setup name checking REs */ + checkName = Tcl_NewStringObj("^", -1); + Tcl_AppendObjToObj(checkName, Tcl_GetVar2Ex(interp, "::xml::Name", NULL, 0)); + Tcl_AppendToObj(checkName, "$", -1); + Tcl_IncrRefCount(checkName); + checkQName = Tcl_NewStringObj("^", -1); + Tcl_AppendObjToObj(checkQName, Tcl_GetVar2Ex(interp, "::xml::QName", NULL, 0)); + Tcl_AppendToObj(checkQName, "$", -1); + Tcl_IncrRefCount(checkQName); + + TclDOM_SetVars(interp); + + Tcl_RegisterObjType(&NodeObjType); + + return TCL_OK; +} + +/* + * DOM is safe, since it is merely an in-memory representation of the document tree. + * However, XInclude is not safe. This is still OK because XInclude uses the external + * entity mechanism to load remote documents and TclXML/libxml2 intercepts those calls. + */ +int +Tcldom_libxml2_SafeInit (interp) + Tcl_Interp *interp; /* Interpreter to initialise */ +{ + return Tcldom_libxml2_Init(interp); +} + +#if 0 +void +DumpDocNodeTable(domDocPtr) + TclDOM_libxml2_Document *domDocPtr; +{ + return; + + /* + TclDOM_libxml2_Node *tNodePtr; + Tcl_HashEntry *entryPtr; + Tcl_HashSearch search; + + sprintf(dbgbuf, " Nodes in doc \"%s\":\n", domDocPtr->tDocPtr->token); + Tcl_WriteChars(stderrChan, dbgbuf, -1); + + for (entryPtr = Tcl_FirstHashEntry(domDocPtr->nodes, &search); + entryPtr; + entryPtr = Tcl_NextHashEntry(&search)) { + tNodePtr = (TclDOM_libxml2_Node *) Tcl_GetHashValue(entryPtr); + sprintf(dbgbuf, " Hash entry \"%s\" (x%x)\n", Tcl_GetHashKey(domDocPtr->nodes, entryPtr), tNodePtr); + Tcl_WriteChars(stderrChan, dbgbuf, -1); + sprintf(dbgbuf, " Node \"%s\"\n", tNodePtr->token); + Tcl_WriteChars(stderrChan, dbgbuf, -1); + } + */ +} +#endif + +/* + *---------------------------------------------------------------------------- + * + * TclDOM_HasFeatureCommand -- + * + * Implements dom::libxml2::hasfeature command + * + * Results: + * Returns boolean. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------------- + */ + +int +TclDOM_HasFeatureCommand (dummy, interp, objc, objv) + ClientData dummy; + Tcl_Interp *interp; + int objc; + Tcl_Obj *CONST objv[]; +{ + if (objc != 3) { + Tcl_WrongNumArgs(interp, 0, objv, "hasfeature feature version"); + return TCL_ERROR; + } + + if (Tcl_RegExpMatchObj(interp, objv[1], Tcl_NewStringObj("create|destroy|parse|query|serialize|trim|Events|UIEvents|isNode", -1)) == 1) { + if (Tcl_StringMatch(Tcl_GetStringFromObj(objv[2], NULL), "1.0") == 1) { + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1)); + } else { + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0)); + } + } else { + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0)); + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * TclDOMCreateCommand -- + * + * Implements dom::libxml2::create command + * + * Results: + * Creates a new document. + * + * Side effects: + * Allocates memory. + * + *---------------------------------------------------------------------------- + */ + +int +TclDOMCreateCommand (dummy, interp, objc, objv) + ClientData dummy; + Tcl_Interp *interp; + int objc; + Tcl_Obj *CONST objv[]; +{ + Tcl_Obj *objPtr; + + if (objc != 1) { + Tcl_WrongNumArgs(interp, 1, objv, ""); + return TCL_ERROR; + } + + objPtr = TclXML_libxml2_NewDocObj(interp); + if (!objPtr) { + return TCL_ERROR; + } + TclXML_libxml2_DocKeep(objPtr, TCLXML_LIBXML2_DOCUMENT_KEEP); + + if (AdoptDocument(interp, objPtr) != TCL_OK) { + return TCL_ERROR; + } + + return TCL_OK; +} +int +AdoptDocument(interp, objPtr) + Tcl_Interp *interp; + Tcl_Obj *objPtr; +{ + TclXML_libxml2_Document *tDocPtr; + TclDOM_libxml2_Document *domDocPtr; + + /* + * Claim this object so the document will not be destroyed + * underneath us. + */ + Tcl_IncrRefCount(objPtr); + + if (TclXML_libxml2_GetTclDocFromObj(interp, objPtr, &tDocPtr) != TCL_OK) { + return TCL_ERROR; + } + + domDocPtr = (TclDOM_libxml2_Document *) Tcl_Alloc(sizeof(TclDOM_libxml2_Document)); + domDocPtr->interp = interp; + domDocPtr->tDocPtr = tDocPtr; + domDocPtr->objPtr = objPtr; + + domDocPtr->schema = NULL; + + domDocPtr->nodes = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable)); + Tcl_InitHashTable(domDocPtr->nodes, TCL_STRING_KEYS); + domDocPtr->nodeCntr = 0; + + domDocPtr->captureListeners = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable)); + Tcl_InitHashTable(domDocPtr->captureListeners, TCL_ONE_WORD_KEYS); + domDocPtr->bubbleListeners = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable)); + Tcl_InitHashTable(domDocPtr->bubbleListeners, TCL_ONE_WORD_KEYS); + memset(domDocPtr->listening, 0, TCLDOM_NUM_EVENT_TYPES * sizeof(int)); + + /* + * When the document is eventually destroyed, + * make sure all memory is freed. + */ + tDocPtr->dom = (ClientData) domDocPtr; + tDocPtr->domfree = FreeDocument; + + /* + * Create a Tcl namespace for this document + */ + + Tcl_VarEval(interp, "namespace eval ::dom::", tDocPtr->token, " {}\n", NULL); + + /* + * Create a DOM command to control the document. + */ + + domDocPtr->cmd = Tcl_CreateObjCommand(interp, tDocPtr->token, TclDOMDocumentCommand, (ClientData) domDocPtr, DocumentNodeCmdDelete); + + Tcl_SetObjResult(interp, objPtr); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * TclDOM_libxml2_CreateObjFromDoc -- + * + * Wrapper for TclXML_libxml2_CreateObjFromDoc + * + * Results: + * Returns Tcl_Obj. + * + * Side effects: + * Allocates memory. + * + *---------------------------------------------------------------------------- + */ + +Tcl_Obj * +TclDOM_libxml2_CreateObjFromDoc (interp, docPtr) + Tcl_Interp *interp; + xmlDocPtr docPtr; +{ + Tcl_Obj *newPtr; + + newPtr = TclXML_libxml2_CreateObjFromDoc(docPtr); + + if (AdoptDocument(interp, newPtr) != TCL_OK) { + Tcl_DecrRefCount(newPtr); + return NULL; + } + + return newPtr; +} + +/* + *---------------------------------------------------------------------------- + * + * TclDOMDestroyCommand -- + * + * Implements dom::libxml2::destroy command + * + * Results: + * Frees document or node. + * + * Side effects: + * Deallocates memory. + * + *---------------------------------------------------------------------------- + */ + +int +TclDOMDestroyCommand (dummy, interp, objc, objv) + ClientData dummy; + Tcl_Interp *interp; + int objc; + Tcl_Obj *CONST objv[]; +{ + TclXML_libxml2_Document *tDocPtr; + TclDOM_libxml2_Node *tNodePtr; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "token"); + return TCL_ERROR; + } + + if (TclXML_libxml2_GetTclDocFromObj(interp, objv[1], &tDocPtr) == TCL_OK) { + TclDOM_libxml2_Document *domDocPtr = GetDOMDocument(interp, tDocPtr); + + if (domDocPtr == NULL) { + /* This is an error! */ + TclXML_libxml2_DestroyDocument(tDocPtr); + } else { + Tcl_DeleteCommandFromToken(interp, domDocPtr->cmd); + } + + } else if (TclDOM_libxml2_GetTclNodeFromObj(interp, objv[1], &tNodePtr) == TCL_OK) { + TclDOM_libxml2_DestroyNode(interp, tNodePtr); + } else if (TclDOM_libxml2_GetTclEventFromObj(interp, objv[1], &tNodePtr) == TCL_OK) { + TclDOM_libxml2_DestroyNode(interp, tNodePtr); + } else { + Tcl_SetResult(interp, "not a DOM node", NULL); + return TCL_ERROR; + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * DocumentNodeCmdDelete -- + * + * Invoked when a DOM document's command is deleted. + * + * Results: + * Frees document. + * + * Side effects: + * Deallocates memory. + * + *---------------------------------------------------------------------------- + */ + +void +DocumentNodeCmdDelete (clientData) + ClientData clientData; +{ + TclDOM_libxml2_Document *domDocPtr = (TclDOM_libxml2_Document *) clientData; + +#ifndef WIN32 + TclXML_libxml2_DestroyDocument(domDocPtr->tDocPtr); +#endif /* not WIN32 */ +#ifdef WIN32 + /* + * Workaround bug in TclXML/libxml2. + * This will, of course, leak memory. + */ + + /* FreeDocument((ClientData) domDocPtr); */ +#endif /* WIN32 */ +} + +/* + *---------------------------------------------------------------------------- + * + * FreeDocument -- + * + * Frees resources associated with a document. + * + * Results: + * None. + * + * Side effects: + * Deallocates memory. + * + *---------------------------------------------------------------------------- + */ + +#ifdef WIN32 +/* + * Using Tcl internal functions appears to cause linking problems + * when using MS VC++, so avoid the problem by invoking a script instead. + */ + +void DeleteNamespace (interp, ns) + Tcl_Interp *interp; + char *ns; +{ + Tcl_Obj *cmdPtr = Tcl_NewObj(); + + Tcl_AppendStringsToObj(cmdPtr, "namespace delete ", ns, NULL); + Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL); + Tcl_DecrRefCount(cmdPtr); +} +#else /* not WIN32 */ +/* + * Internal Tcl functions + */ + +#if (TCL_MAJOR_VERSION < 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 5)) + +/* + * SRB: 2005-12-29: This should use #include , but private sources may not be available. + */ + +EXTERN Tcl_Namespace * Tcl_FindNamespace _ANSI_ARGS_((Tcl_Interp * interp, + CONST char * name, + Tcl_Namespace * contextNsPtr, + int flags)); +EXTERN void Tcl_DeleteNamespace _ANSI_ARGS_((Tcl_Namespace * nsPtr)); + +#endif /* Tcl < 8.5 */ + +void DeleteNamespace (interp, ns) + Tcl_Interp *interp; + char *ns; +{ + Tcl_Namespace *namespacePtr; + namespacePtr = Tcl_FindNamespace(interp, ns, + (Tcl_Namespace *) NULL, 0); + if (namespacePtr) { + Tcl_DeleteNamespace(namespacePtr); + } /* else internal error */ +} +#endif /* WIN32 */ + +void +FreeDocument (clientData) + ClientData clientData; +{ + TclDOM_libxml2_Document *domDocPtr = (TclDOM_libxml2_Document *) clientData; + char buf[1024]; + + snprintf(buf, 1023, "::dom::%s", domDocPtr->tDocPtr->token); + DeleteNamespace(domDocPtr->interp, buf); + + /* + * Deleting the namespace deletes all of the node commands, + * which in turn invalidates the node references. + * So no need to do it again here. + * + entry = Tcl_FirstHashEntry(domDocPtr->nodes, &search); + while (entry) { + tNodePtr = (TclDOM_libxml2_Node *) Tcl_GetHashValue(entry); + TclDOM_libxml2_InvalidateNode(tNodePtr); + entry = Tcl_NextHashEntry(&search); + } + */ + Tcl_DeleteHashTable(domDocPtr->nodes); + Tcl_Free((char *) domDocPtr->nodes); + + if (domDocPtr->schema) { + Tcl_MutexLock(&libxml2); + /* This also frees the copy of the document used by the schema context */ + xmlSchemaFree(domDocPtr->schema); + Tcl_MutexUnlock(&libxml2); + } + + Tcl_Free((char *) domDocPtr->captureListeners); + Tcl_Free((char *) domDocPtr->bubbleListeners); + + /* Workaround win32 destroy bug, see above */ +#ifndef WIN32 + Tcl_DecrRefCount(domDocPtr->objPtr); +#endif /* not WIN32 */ + + Tcl_Free((char *) domDocPtr); +} + +/* + *---------------------------------------------------------------------------- + * + * GetDOMDocument -- + * + * Retrieves the DOM document structure associated with a libxml2 document. + * libxslt synthesizes documents, so it is often the case that a node + * must be processed that has not had its document "adopted". + * + * Results: + * Returns pointer to DOM structure. + * + * Side effects: + * Document is "adopted" if necessary. + * + *---------------------------------------------------------------------------- + */ + +TclDOM_libxml2_Document * +GetDOMDocument(interp, tDocPtr) + Tcl_Interp *interp; + TclXML_libxml2_Document *tDocPtr; +{ + if (tDocPtr->dom != NULL) { + return (TclDOM_libxml2_Document *) tDocPtr->dom; + } else if (interp == NULL) { + return NULL; + } else { + Tcl_Obj *objPtr; + + objPtr = TclXML_libxml2_CreateObjFromDoc(tDocPtr->docPtr); + if (AdoptDocument(interp, objPtr) != TCL_OK) { + Tcl_DecrRefCount(objPtr); + return NULL; + } else { + return (TclDOM_libxml2_Document *) tDocPtr->dom; + } + } +} + +/* + *---------------------------------------------------------------------------- + * + * TclDOMParseCommand -- + * + * Implements dom::libxml2::parse command + * + * Not implemented here at present - calls Tcl script + * + * Results: + * Depends on method. + * + * Side effects: + * Depends on method. + * + *---------------------------------------------------------------------------- + */ + +int +TclDOMParseCommand (dummy, interp, objc, objv) + ClientData dummy; + Tcl_Interp *interp; + int objc; + Tcl_Obj *CONST objv[]; +{ + /* Tcl_Obj *objPtr; */ + Tcl_Obj **newobjv; + int i; + + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "xml ?args ...?"); + return TCL_ERROR; + } + + newobjv = (Tcl_Obj **) Tcl_Alloc((objc + 1) * sizeof(Tcl_Obj *)); + newobjv[0] = Tcl_NewStringObj("::dom::libxml2::parse", -1); + for (i = 1; i < objc; i++) { + newobjv[i] = objv[i]; + } + newobjv[i] = NULL; + + return Tcl_EvalObjv(interp, objc, newobjv, 0); + + /* + if (TclXML_CreateParser(interp, objc, objv) != TCL_OK) { + return TCL_ERROR; + } + parserObj = Tcl_GetObjResult(interp); + if (TclXML_Parse(interp, parserObj, objc, objv) != TCL_OK) { + return TCL_ERROR; + } + + if (TclXML_Get(interp, parserObj, "document") != TCL_OK) { + return TCL_ERROR; + } + + Tcl_SetObjResult(interp, objPtr); + */ + + return TCL_OK; +} +int +TclDOMAdoptCommand (dummy, interp, objc, objv) + ClientData dummy; + Tcl_Interp *interp; + int objc; + Tcl_Obj *CONST objv[]; +{ + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "doc"); + return TCL_ERROR; + } + + return AdoptDocument(interp, objv[1]); +} + +/* + *---------------------------------------------------------------------------- + * + * TclDOMSerializeCommand -- + * + * Implements dom::libxml2::serialize command + * + * Results: + * Depends on method. + * + * Side effects: + * Depends on method. + * + *---------------------------------------------------------------------------- + */ + +int +TclDOMSerializeCommand (dummy, interp, objc, objv) + ClientData dummy; + Tcl_Interp *interp; + int objc; + Tcl_Obj *CONST objv[]; +{ + xmlDocPtr docPtr; + xmlNodePtr nodePtr; + xmlBufferPtr bufptr = NULL; + xmlSaveCtxtPtr savectxtptr = NULL; + xmlChar *result = NULL; + Tcl_Obj *encodingPtr = NULL; + int option, method = TCLDOM_SERIALIZE_METHOD_XML, indent = 0, len = 0, omitXMLDeclaration = 0, saveoptions = 0; + char *buf, *encoding; + Tcl_Encoding tclencoding; + Tcl_DString *serialized; + + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "node ?option value ...?"); + return TCL_ERROR; + } + + if (TclXML_libxml2_GetDocFromObj(interp, objv[1], &docPtr) != TCL_OK) { + if (TclDOM_libxml2_GetNodeFromObj(interp, objv[1], &nodePtr) == TCL_OK) { + /* Serialize just the node */ + Tcl_SetResult(interp, "not yet implemented - serialize whole document", NULL); + return TCL_ERROR; + } else { + Tcl_SetResult(interp, "not a libxml2 node", NULL); + return TCL_ERROR; + } + } + + if (objc > 2) { + objc -= 2; + objv += 2; + + while (objc) { + + if (objc == 1) { + Tcl_Obj *msgPtr; + + msgPtr = Tcl_NewStringObj("missing value for configuration option \"", -1); + Tcl_AppendObjToObj(msgPtr, objv[0]); + Tcl_AppendStringsToObj(msgPtr, "\"", (char *) NULL); + Tcl_SetObjResult(interp, msgPtr); + return TCL_ERROR; + } + + if (Tcl_GetIndexFromObj(interp, objv[0], TclDOM_SerializeCommandOptions, + "option", 0, &option) != TCL_OK) { + return TCL_ERROR; + } + + switch ((enum TclDOM_SerializeCommandOptions) option) { + case TCLDOM_SERIALIZE_METHOD: + + buf = Tcl_GetStringFromObj(objv[1], &len); + if (len == 0) { + method = TCLDOM_SERIALIZE_METHOD_XML; + } else if (Tcl_GetIndexFromObj(interp, objv[1], TclDOM_SerializeMethods, + "method", 0, &method) != TCL_OK) { + return TCL_ERROR; + } + + break; + + case TCLDOM_SERIALIZE_INDENT: + + if (Tcl_GetBooleanFromObj(interp, objv[1], &indent) != TCL_OK) { + return TCL_ERROR; + } + + break; + + case TCLDOM_SERIALIZE_OMIT_XML_DECLARATION: + + if (Tcl_GetBooleanFromObj(interp, objv[1], &omitXMLDeclaration) != TCL_OK) { + return TCL_ERROR; + } + + break; + + case TCLDOM_SERIALIZE_ENCODING: + encodingPtr = objv[1]; + + break; + + default: + Tcl_SetResult(interp, "unknown option", NULL); + return TCL_ERROR; + } + + objc -= 2; + objv += 2; + } + } + + switch ((enum TclDOM_SerializeMethods) method) { + + case TCLDOM_SERIALIZE_METHOD_XML: + + serialized = (Tcl_DString *) Tcl_Alloc(sizeof(Tcl_DString)); + Tcl_DStringInit(serialized); + + if (encodingPtr) { + encoding = Tcl_GetStringFromObj(encodingPtr, NULL); + } else { + encoding = "utf-8"; + } + tclencoding = Tcl_GetEncoding(interp, encoding); + + Tcl_MutexLock(&libxml2); + + if ((bufptr = xmlBufferCreate()) == NULL) { + Tcl_MutexUnlock(&libxml2); + Tcl_Free((void *)serialized); + Tcl_SetResult(interp, "unable to allocate output buffer", NULL); + return TCL_ERROR; + } + + if (indent) { + saveoptions |= XML_SAVE_FORMAT; + } + if (omitXMLDeclaration) { + saveoptions |= XML_SAVE_NO_DECL; + } + if ((savectxtptr = xmlSaveToBuffer(bufptr, encoding, saveoptions)) == NULL) { + Tcl_MutexUnlock(&libxml2); + Tcl_Free((void *)serialized); + xmlBufferFree(bufptr); + Tcl_SetResult(interp, "unable to create save context", NULL); + return TCL_ERROR; + } + + xmlSaveDoc(savectxtptr, docPtr); + xmlSaveClose(savectxtptr); + + Tcl_MutexUnlock(&libxml2); + + Tcl_ExternalToUtfDString(tclencoding, (CONST char *) xmlBufferContent(bufptr), xmlBufferLength(bufptr), serialized); + Tcl_DStringResult(interp, serialized); + + Tcl_MutexLock(&libxml2); + xmlBufferFree(bufptr); + Tcl_MutexUnlock(&libxml2); + + break; + + case TCLDOM_SERIALIZE_METHOD_HTML: + + Tcl_MutexLock(&libxml2); + htmlSetMetaEncoding(docPtr, (const xmlChar *) "UTF-8"); + htmlDocDumpMemory(docPtr, &result, &len); + Tcl_MutexUnlock(&libxml2); + Tcl_SetObjResult(interp, Tcl_NewStringObj((CONST char *) result, len)); + xmlFree(result); + + break; + + case TCLDOM_SERIALIZE_METHOD_TEXT: + + nodePtr = docPtr->children; + + while (nodePtr != NULL) { + if (nodePtr->type == XML_TEXT_NODE) + Tcl_AppendResult(interp, (char *) nodePtr->content, NULL); + + if (nodePtr->children != NULL) { + if ((nodePtr->children->type != XML_ENTITY_DECL) && + (nodePtr->children->type != XML_ENTITY_REF_NODE) && + (nodePtr->children->type != XML_ENTITY_NODE)) { + nodePtr = nodePtr->children; + continue; + } + } + + if (nodePtr->next != NULL) { + nodePtr = nodePtr->next; + continue; + } + + do { + nodePtr = nodePtr->parent; + if (nodePtr == NULL) + break; + if (nodePtr == (xmlNodePtr) docPtr) { + nodePtr = NULL; + break; + } + if (nodePtr->next != NULL) { + nodePtr = nodePtr->next; + break; + } + } while (nodePtr != NULL); + } + + break; + + default: + Tcl_SetResult(interp, "internal error", NULL); + return TCL_ERROR; + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * TclDOMDOMImplementationCommand -- + * + * Implements dom::libxml2::DOMImplementation command + * + * Results: + * Depends on method. + * + * Side effects: + * Depends on method. + * + *---------------------------------------------------------------------------- + */ + +int +TclDOMDOMImplementationCommand (dummy, interp, objc, objv) + ClientData dummy; + Tcl_Interp *interp; + int objc; + Tcl_Obj *CONST objv[]; +{ + int method; + + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "method ?args...?"); + return TCL_ERROR; + } + + if (Tcl_GetIndexFromObj(interp, objv[1], TclDOM_DOMImplementationCommandMethods, + "method", 0, &method) != TCL_OK) { + return TCL_ERROR; + } + + switch ((enum TclDOM_DOMImplementationCommandMethods) method) { + case TCLDOM_IMPL_HASFEATURE: + return TclDOM_HasFeatureCommand(dummy, interp, objc - 1, objv + 1); + case TCLDOM_IMPL_CREATE: + if (objc == 2) { + return TclDOMCreateCommand(dummy, interp, 1, objv); + } else if (objc == 3) { + Tcl_Obj *objPtr; + xmlDocPtr docPtr; + xmlNodePtr nodePtr; + + if (TclDOMCreateCommand(dummy, interp, 0, NULL) != TCL_OK) { + return TCL_ERROR; + } + objPtr = Tcl_GetObjResult(interp); + TclXML_libxml2_GetDocFromObj(interp, objPtr, &docPtr); + Tcl_MutexLock(&libxml2); + nodePtr = xmlNewDocNode(docPtr, NULL, (const xmlChar *) Tcl_GetStringFromObj(objv[2], NULL), NULL); + Tcl_MutexUnlock(&libxml2); + if (nodePtr == NULL) { + Tcl_SetResult(interp, "unable to create document element", NULL); + return TCL_ERROR; + } + + Tcl_SetObjResult(interp, objPtr); + } else { + Tcl_WrongNumArgs(interp, 1, objv, "create ?doc?"); + return TCL_ERROR; + } + + break; + + case TCLDOM_IMPL_PARSE: + return TclDOMParseCommand(dummy, interp, objc - 1, objv + 1); + + case TCLDOM_IMPL_SERIALIZE: + return TclDOMSerializeCommand(dummy, interp, objc - 1, objv + 1); + + case TCLDOM_IMPL_SELECTNODE: + return TclDOMSelectNodeCommand(dummy, interp, objc - 1, objv + 1); + + case TCLDOM_IMPL_DESTROY: + return TclDOMDestroyCommand(dummy, interp, objc - 1, objv + 1); + + case TCLDOM_IMPL_ISNODE: + return TclDOMIsNodeCommand(dummy, interp, objc - 1, objv + 1); + + default: + Tcl_SetResult(interp, "method \"", NULL); + Tcl_AppendResult(interp, Tcl_GetStringFromObj(objv[1], NULL)); + Tcl_AppendResult(interp, "\" not yet implemented", NULL); + return TCL_ERROR; + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * [Schema|RNG][Compile|Validate] -- + * + * Implements DTD, XML Schema and RelaxNG parsing and validation + * + * Results: + * Depends on method. + * + * Side effects: + * May create or destroy validation contexts. + * + *---------------------------------------------------------------------------- + */ + +int +DTDValidate (interp, domDocPtr) + Tcl_Interp *interp; + TclDOM_libxml2_Document *domDocPtr; +{ + xmlValidCtxtPtr ctxt; + + TclXML_libxml2_ResetError(interp); + + Tcl_MutexLock(&libxml2); + + ctxt = xmlNewValidCtxt(); + if (ctxt == NULL) { + Tcl_MutexUnlock(&libxml2); + + Tcl_SetResult(interp, "unable to prepare validation context", NULL); + return TCL_ERROR; + } + + Tcl_SetResult(interp, "document is not valid", NULL); + + if (xmlValidateDocument(ctxt, domDocPtr->tDocPtr->docPtr) == 0) { + Tcl_Obj *errObjPtr; + + Tcl_MutexUnlock(&libxml2); + + errObjPtr = TclXML_libxml2_GetErrorObj(interp); + + if (errObjPtr) { + Tcl_IncrRefCount(errObjPtr); + Tcl_SetObjResult(interp, errObjPtr); + } + return TCL_ERROR; + } + + Tcl_MutexUnlock(&libxml2); + + Tcl_ResetResult(interp); + + return TCL_OK; +} + +int +SchemaCompile (interp, domDocPtr) + Tcl_Interp *interp; + TclDOM_libxml2_Document *domDocPtr; +{ + xmlDocPtr schemaDocPtr; + xmlSchemaParserCtxtPtr ctxt = NULL; + + if (domDocPtr->schema) { + /* Re-compile */ + Tcl_MutexLock(&libxml2); + xmlSchemaFree(domDocPtr->schema); + Tcl_MutexUnlock(&libxml2); + domDocPtr->schema = NULL; + } + + Tcl_MutexLock(&libxml2); + + schemaDocPtr = xmlCopyDoc(domDocPtr->tDocPtr->docPtr, 1); + + if (schemaDocPtr == NULL) { + Tcl_MutexUnlock(&libxml2); + Tcl_SetResult(interp, "unable to prepare schema document", NULL); + return TCL_ERROR; + } + + ctxt = xmlSchemaNewDocParserCtxt(schemaDocPtr); + if (ctxt == NULL) { + xmlFreeDoc(schemaDocPtr); + Tcl_MutexUnlock(&libxml2); + Tcl_SetResult(interp, "unable to create schema context", NULL); + return TCL_ERROR; + } + + TclXML_libxml2_ResetError(interp); + + Tcl_SetResult(interp, "unable to parse schema document", NULL); + domDocPtr->schema = xmlSchemaParse(ctxt); +#if 0 + xmlSchemaFreeParserCtxt(ctxt); /* This frees the doc */ +#endif + Tcl_MutexUnlock(&libxml2); + + if (domDocPtr->schema == NULL) { + Tcl_Obj * errObjPtr = TclXML_libxml2_GetErrorObj(interp); + + if (errObjPtr) { + Tcl_SetObjResult(interp, errObjPtr); + } + + return TCL_ERROR; + } + + Tcl_ResetResult(interp); + + return TCL_OK; +} + +int +SchemaValidate (interp, domDocPtr, instancePtr) + Tcl_Interp *interp; + TclDOM_libxml2_Document *domDocPtr; + xmlDocPtr instancePtr; +{ + xmlSchemaValidCtxtPtr ctxt = NULL; + Tcl_Obj *errObjPtr; + int ret; + + if (domDocPtr->schema == NULL) { + Tcl_SetResult(interp, "schema not compiled", NULL); + return TCL_ERROR; + } + + TclXML_libxml2_ResetError(interp); + + Tcl_MutexLock(&libxml2); + + ctxt = xmlSchemaNewValidCtxt(domDocPtr->schema); + + Tcl_SetResult(interp, "document is not valid", NULL); + + ret = xmlSchemaValidateDoc(ctxt, instancePtr); + errObjPtr = TclXML_libxml2_GetErrorObj(interp); + if (ret > 0) { + if (errObjPtr) { + Tcl_SetObjResult(interp, errObjPtr); + } + goto error; + } else if (ret < 0) { + Tcl_SetResult(interp, "schema processor internal error", NULL); + + if (errObjPtr) { + Tcl_SetObjResult(interp, errObjPtr); + } + goto error; + } + + xmlSchemaFreeValidCtxt(ctxt); + + Tcl_MutexUnlock(&libxml2); + + /* There may be warnings */ + + if (errObjPtr) { + Tcl_SetObjResult(interp, errObjPtr); + } else { + Tcl_ResetResult(interp); + } + + return TCL_OK; + + error: + if (ctxt) { + xmlSchemaFreeValidCtxt(ctxt); + } + + Tcl_MutexUnlock(&libxml2); + + return TCL_ERROR; +} +/* + * TODO: RelaxNG validation. + */ + +int +TclDOMTrimCommand (dummy, interp, objc, objv) + ClientData dummy; + Tcl_Interp *interp; + int objc; + Tcl_Obj *CONST objv[]; +{ + xmlDocPtr docPtr; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "doc"); + } + + if (TclXML_libxml2_GetDocFromObj(interp, objv[1], &docPtr) != TCL_OK) { + return TCL_ERROR; + } + + TrimDocument(interp, docPtr); + + return TCL_OK; +} + +/* + * Remove all blank text nodes + * + * NB. This code mostly copied from xmlschemas.c + */ + +/** Copied directly from xmlschemas.c: + * + * xmlSchemaIsBlank: + * @str: a string + * + * Check if a string is ignorable + * + * Returns 1 if the string is NULL or made of blanks chars, 0 otherwise + */ +/* SRB: 2008-11-24: Updated against libxml2 2.7.2. + */ +#define IS_BLANK_NODE(n) \ + (((n)->type == XML_TEXT_NODE) && (xmlSchemaIsBlank((n)->content, -1))) + +/* + * SRB: 2008-06-12: Updated against libxml2 2.6.32. + * See also SF bug 1943963. + */ + +static int +xmlSchemaIsBlank(xmlChar *str, int len) { + if (str == NULL) + return(1); + if (len < 0) { + while (*str != 0) { + if (!(IS_BLANK_CH(*str))) return(0); + str++; + } + } else { + while ((*str != 0) && (len != 0)) { + if (!(IS_BLANK_CH(*str))) return (0); + str++; + len--; + } + } + return(1); +} + +static void +TrimDocument(interp, docPtr) + Tcl_Interp *interp; + xmlDocPtr docPtr; +{ + xmlNodePtr root, cur, delete; + Tcl_Obj *nodeObjPtr; + TclDOM_libxml2_Node *tNodePtr = NULL; + + delete = NULL; + root = xmlDocGetRootElement(docPtr); + if (root == NULL) { + return; + } + cur = root; + + while (cur != NULL) { + if (delete != NULL) { + nodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, delete); + TclDOM_libxml2_GetTclNodeFromObj(interp, nodeObjPtr, &tNodePtr); + TclDOM_libxml2_InvalidateNode(tNodePtr); + Tcl_DecrRefCount(nodeObjPtr); + xmlUnlinkNode(delete); + xmlFreeNode(delete); + delete = NULL; + } + if (cur->type == XML_TEXT_NODE) { + if (IS_BLANK_NODE(cur)) { + if (xmlNodeGetSpacePreserve(cur) != 1) { + delete = cur; + } + } + } else if ((cur->type != XML_ELEMENT_NODE) && + (cur->type != XML_CDATA_SECTION_NODE)) { + delete = cur; + goto skip_children; + } + + /* + * Skip to next node + */ + if (cur->children != NULL) { + if ((cur->children->type != XML_ENTITY_DECL) && + (cur->children->type != XML_ENTITY_REF_NODE) && + (cur->children->type != XML_ENTITY_NODE)) { + cur = cur->children; + continue; + } + } + skip_children: + if (cur->next != NULL) { + cur = cur->next; + continue; + } + + do { + cur = cur->parent; + if (cur == NULL) + break; + if (cur == root) { + cur = NULL; + break; + } + if (cur->next != NULL) { + cur = cur->next; + break; + } + } while (cur != NULL); + } + if (delete != NULL) { + nodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, delete); + TclDOM_libxml2_GetTclNodeFromObj(interp, nodeObjPtr, &tNodePtr); + TclDOM_libxml2_InvalidateNode(tNodePtr); + Tcl_DecrRefCount(nodeObjPtr); + xmlUnlinkNode(delete); + xmlFreeNode(delete); + delete = NULL; + } + + return; +} + +/* + *---------------------------------------------------------------------------- + * + * TclDOMXIncludeCommand -- + * + * Implements dom::libxml2::xinclude command. + * + * Results: + * Performs XInclude processing on a document. + * + * Side effects: + * The supplied DOM tree may be modified. + * + *---------------------------------------------------------------------------- + */ +int +TclDOMXIncludeCommand (dummy, interp, objc, objv) + ClientData dummy; + Tcl_Interp *interp; + int objc; + Tcl_Obj *CONST objv[]; +{ + xmlDocPtr docPtr; + int subs; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "doc"); + return TCL_ERROR; + } + + if (TclXML_libxml2_GetDocFromObj(interp, objv[1], &docPtr) != TCL_OK) { + return TCL_ERROR; + } + + Tcl_MutexLock(&libxml2); + subs = xmlXIncludeProcess(docPtr); + Tcl_MutexUnlock(&libxml2); + + if (subs < 0) { + Tcl_SetResult(interp, "unable to complete XInclude processing", NULL); + return TCL_ERROR; + } + + Tcl_SetObjResult(interp, Tcl_NewIntObj(subs)); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * TclDOMPrefix2NSCommand -- + * + * Implements dom::libxml2::prefix2namespaceURI command. + * + * Results: + * Returns namespace URI for a given prefix. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------------- + */ +int +TclDOMPrefix2NSCommand (dummy, interp, objc, objv) + ClientData dummy; + Tcl_Interp *interp; + int objc; + Tcl_Obj *CONST objv[]; +{ + xmlNodePtr nodePtr; + xmlNsPtr nsPtr; + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "node prefix"); + return TCL_ERROR; + } + + if (TclDOM_libxml2_GetNodeFromObj(interp, objv[1], &nodePtr) != TCL_OK) { + return TCL_ERROR; + } + + nsPtr = xmlSearchNs(nodePtr->doc, nodePtr, (const xmlChar *) Tcl_GetStringFromObj(objv[2], NULL)); + + if (!nsPtr) { + Tcl_SetResult(interp, "no XML Namespace declaration", NULL); + return TCL_ERROR; + } + + Tcl_SetObjResult(interp, Tcl_NewStringObj((CONST char *) nsPtr->href, -1)); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * TclDOMIsNodeCommand -- + * + * Implements dom::libxml2::isNode command. + * + * Results: + * Returns boolean. + * + * Side effects: + * Tcl object may be converted to internal rep. + * + *---------------------------------------------------------------------------- + */ + +int +TclDOMIsNodeCommand (dummy, interp, objc, objv) + ClientData dummy; + Tcl_Interp *interp; + int objc; + Tcl_Obj *CONST objv[]; +{ + xmlDocPtr docPtr; + xmlNodePtr nodePtr; + TclDOM_libxml2_Node *tNodePtr; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "token"); + return TCL_ERROR; + } + + if (TclDOM_libxml2_GetNodeFromObj(interp, objv[1], &nodePtr) != TCL_OK) { + if (TclXML_libxml2_GetDocFromObj(interp, objv[1], &docPtr) != TCL_OK) { + if (TclDOM_libxml2_GetTclEventFromObj(interp, objv[1], &tNodePtr) != TCL_OK) { + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0)); + } else { + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1)); + } + } else { + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1)); + } + } else { + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1)); + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * TclDOMSelectNodeCommand -- + * + * Implements dom::libxml2::selectnode command. + * + * Results: + * Returns result of XPath expression evaluation. + * + * Side effects: + * Memory is allocated for Tcl object to return result. + * + *---------------------------------------------------------------------------- + */ + +int +TclDOMSelectNodeCommand (dummy, interp, objc, objv) + ClientData dummy; + Tcl_Interp *interp; + int objc; + Tcl_Obj *CONST objv[]; +{ + int i, len, option; + char *path; + Tcl_Obj *objPtr, *nsOptPtr = NULL, *nodeObjPtr; + xmlDocPtr docPtr; + xmlNodePtr nodePtr = NULL; + xmlXPathContextPtr ctxt = NULL; + xmlXPathObjectPtr xpathObj = NULL; + + if (objc < 3) { + Tcl_WrongNumArgs(interp, 1, objv, "doc location-path ?option value...?"); + return TCL_ERROR; + } + + path = Tcl_GetStringFromObj(objv[2], &len); + if (len == 0) { + return TCL_OK; + } + + if (TclXML_libxml2_GetDocFromObj(interp, objv[1], &docPtr) != TCL_OK) { + if (TclDOM_libxml2_GetNodeFromObj(interp, objv[1], &nodePtr) == TCL_OK) { + docPtr = nodePtr->doc; + } else { + return TCL_ERROR; + } + } + + for (i = 3; i < objc; i += 2) { + if (i == objc - 1) { + Tcl_AppendResult(interp, "missing value for option \"", Tcl_GetStringFromObj(objv[i], NULL), "\"", NULL); + return TCL_ERROR; + } + if (Tcl_GetIndexFromObj(interp, objv[i], TclDOM_SelectNodeOptions, + "option", 0, &option) != TCL_OK) { + goto opt_error; + } + switch ((enum TclDOM_SelectNodeOptions) option) { + + case TCLDOM_SELECTNODE_OPTION_NAMESPACES: + if (nsOptPtr) { + if (Tcl_ListObjAppendList(interp, nsOptPtr, objv[i + 1]) != TCL_OK) { + Tcl_SetResult(interp, "-namespaces option value must be a list", NULL); + goto opt_error; + } + } else { + nsOptPtr = Tcl_DuplicateObj(objv[i + 1]); + } + if (Tcl_ListObjLength(interp, nsOptPtr, &len) != TCL_OK) { + Tcl_SetResult(interp, "-namespaces option value must be a list", NULL); + goto opt_error; + } else if (len % 2 != 0) { + Tcl_SetResult(interp, "value missing from namespaces list", NULL); + goto opt_error; + } + + break; + + default: + Tcl_AppendResult(interp, "unknown option \"", Tcl_GetStringFromObj(objv[i], NULL), "\"", NULL); + goto opt_error; + } + } + + Tcl_MutexLock(&libxml2); + ctxt = xmlXPathNewContext(docPtr); + if (ctxt == NULL) { + Tcl_SetResult(interp, "unable to create XPath context", NULL); + return TCL_ERROR; + } + + if (nodePtr) { + ctxt->node = nodePtr; + } + + TclXML_libxml2_ResetError(interp); + + /* + * Setup any XML Namespace prefixes given as arguments + */ + if (nsOptPtr) { + Tcl_ListObjLength(interp, nsOptPtr, &len); + for (i = 0; i < len; i += 2) { + Tcl_Obj *prefixPtr, *nsURIPtr; + + Tcl_ListObjIndex(interp, nsOptPtr, i, &prefixPtr); + Tcl_ListObjIndex(interp, nsOptPtr, i + 1, &nsURIPtr); + if (xmlXPathRegisterNs(ctxt, + (const xmlChar *) Tcl_GetStringFromObj(prefixPtr, NULL), + (const xmlChar *) Tcl_GetStringFromObj(nsURIPtr, NULL))) { + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "unable to register XML Namespace \"", Tcl_GetStringFromObj(nsURIPtr, NULL), "\"", NULL); + goto error; + } + } + } + + xpathObj = xmlXPathEval((const xmlChar *) path, ctxt); + + if (xpathObj == NULL) { + Tcl_Obj *errObjPtr = TclXML_libxml2_GetErrorObj(interp); + + if (errObjPtr) { + Tcl_SetObjResult(interp, errObjPtr); + goto error; + } else { + Tcl_SetResult(interp, "error evaluating XPath location path", NULL); + goto error; + } + } + + objPtr = Tcl_NewObj(); + switch (xpathObj->type) { + + case XPATH_NODESET: + len = xmlXPathNodeSetGetLength(xpathObj->nodesetval); + for (i = 0; i < len; i++) { + nodePtr = xmlXPathNodeSetItem(xpathObj->nodesetval, i); + nodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, nodePtr); + if (nodeObjPtr != NULL) { + Tcl_ListObjAppendElement(interp, objPtr, nodeObjPtr); + } else { + Tcl_MutexUnlock(&libxml2); + Tcl_DecrRefCount(objPtr); + return TCL_ERROR; + } + } + break; + + case XPATH_BOOLEAN: + Tcl_SetBooleanObj(objPtr, xpathObj->boolval); + break; + + case XPATH_NUMBER: + Tcl_SetDoubleObj(objPtr, xpathObj->floatval); + break; + + case XPATH_STRING: + Tcl_SetStringObj(objPtr, + (CONST char *) xpathObj->stringval, + strlen((char *) xpathObj->stringval)); + break; + + default: + Tcl_SetResult(interp, "bad XPath object type", NULL); + goto error2; + } + + if (nsOptPtr) { + Tcl_DecrRefCount(nsOptPtr); + } + xmlXPathFreeObject(xpathObj); + xmlXPathFreeContext(ctxt); + + Tcl_MutexUnlock(&libxml2); + + Tcl_SetObjResult(interp, objPtr); + return TCL_OK; + + opt_error: + + Tcl_MutexUnlock(&libxml2); + + if (nsOptPtr) { + Tcl_DecrRefCount(nsOptPtr); + return TCL_ERROR; + } + + error2: + if (nsOptPtr) { + Tcl_DecrRefCount(nsOptPtr); + } + xmlXPathFreeObject(xpathObj); + xmlXPathFreeContext(ctxt); + + Tcl_MutexUnlock(&libxml2); + + return TCL_ERROR; + + error: + if (nsOptPtr) { + Tcl_DecrRefCount(nsOptPtr); + } + xmlXPathFreeContext(ctxt); + + Tcl_MutexUnlock(&libxml2); + + return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------------- + * + * TclDOMDocumentCommand -- + * + * Implements dom::libxml2::document command. + * + * Results: + * Depends on method. + * + * Side effects: + * Depends on method. + * + *---------------------------------------------------------------------------- + */ + +int +TclDOMDocumentCommand (clientData, interp, objc, objv) + ClientData clientData; + Tcl_Interp *interp; + int objc; + Tcl_Obj *CONST objv[]; +{ + TclXML_libxml2_Document *tDocPtr; + TclDOM_libxml2_Document *domDocPtr = NULL; + enum TclDOM_EventTypes type; + int method, optobjc, wrongidx = 1, postMutationEvent = 0, idx, len; + xmlDocPtr docPtr = NULL; + xmlNodePtr nodePtr = NULL, newNodePtr = NULL; + xmlNsPtr nsPtr = NULL; + Tcl_Obj *nodeObjPtr = NULL, *newNodeObjPtr = NULL; + Tcl_Obj *CONST *optobjv; + char *buf, *bufptr, *prefix; + + if (clientData == NULL) { + if (objc < 3) { + Tcl_WrongNumArgs(interp, 2, objv, "method token ?args...?"); + return TCL_ERROR; + } + + if (TclXML_libxml2_GetTclDocFromObj(interp, objv[2], &tDocPtr) != TCL_OK) { + tDocPtr = NULL; + docPtr = NULL; + if (TclDOM_libxml2_GetNodeFromObj(interp, objv[2], &nodePtr) != TCL_OK) { + return TCL_ERROR; + } else { + nodeObjPtr = objv[2]; + if (TclXML_libxml2_GetTclDocFromNode(interp, nodePtr, &tDocPtr) != TCL_OK) { + return TCL_ERROR; + } + } + } else { + docPtr = tDocPtr->docPtr; + domDocPtr = GetDOMDocument(interp, tDocPtr); + if (domDocPtr == NULL) { + Tcl_SetResult(interp, "internal error", NULL); + return TCL_ERROR; + } + } + + optobjv = objv + 3; + optobjc = objc - 3; + wrongidx = 3; + + } else { + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "method ?args...?"); + return TCL_ERROR; + } + + domDocPtr = (TclDOM_libxml2_Document *) clientData; + tDocPtr = domDocPtr->tDocPtr; + docPtr = tDocPtr->docPtr; + + optobjv = objv + 2; + optobjc = objc - 2; + wrongidx = 2; + } + + if (Tcl_GetIndexFromObj(interp, objv[1], TclDOM_DocumentCommandMethods, + "method", 0, &method) != TCL_OK) { + return TCL_ERROR; + } + + Tcl_ResetResult(interp); + + switch ((enum TclDOM_DocumentCommandMethods) method) { + + case TCLDOM_DOCUMENT_CGET: + + if (optobjc != 1) { + Tcl_WrongNumArgs(interp, wrongidx, objv, "option"); + return TCL_ERROR; + } + + if (!docPtr) { + Tcl_SetResult(interp, "not a document", NULL); + return TCL_ERROR; + } + + return DocumentCget(interp, docPtr, optobjv[0]); + + break; + + case TCLDOM_DOCUMENT_CONFIGURE: + + if (!docPtr) { + Tcl_SetResult(interp, "not a document", NULL); + return TCL_ERROR; + } + + if (optobjc == 1) { + return DocumentCget(interp, docPtr, optobjv[0]); + } else { + Tcl_AppendResult(interp, "attribute \"", Tcl_GetStringFromObj(optobjv[0], NULL), "\" is read-only", NULL); + return TCL_ERROR; + } + + break; + + case TCLDOM_DOCUMENT_CREATEELEMENTNS: + if (optobjc != 2) { + Tcl_WrongNumArgs(interp, wrongidx, objv, "nsuri qualname"); + return TCL_ERROR; + } + + /* + * libxml2 doesn't check for invalid element name, + * so must do that here. + */ + if (Tcl_RegExpMatchObj(interp, optobjv[1], checkQName) == 0) { + Tcl_SetResult(interp, "invalid element name", NULL); + return TCL_ERROR; + } + + /* Find localName of element */ + buf = Tcl_GetStringFromObj(optobjv[1], &len); + for (idx = 0; buf[idx] != ':' && idx < len; idx++) ; + if (idx == len) { + /* no prefix was given */ + bufptr = buf; + } else { + /* NB. name must have a local part, since it is a valid QName */ + bufptr = &buf[idx + 1]; + } + + if (docPtr && clientData == NULL) { + /* We're creating the document element, so must create the namespace too */ + xmlNodePtr old; + + Tcl_MutexLock(&libxml2); + newNodePtr = xmlNewDocNode(docPtr, NULL, (const xmlChar *) bufptr, NULL); + if (newNodePtr == NULL) { + Tcl_SetResult(interp, "unable to create element node", NULL); + Tcl_MutexUnlock(&libxml2); + return TCL_ERROR; + } + old = xmlDocSetRootElement(docPtr, newNodePtr); + if (old) { + xmlDocSetRootElement(docPtr, old); + xmlFreeNode(newNodePtr); + Tcl_SetResult(interp, "document element already exists", NULL); + Tcl_MutexUnlock(&libxml2); + return TCL_ERROR; + } + + if (idx < len) { + prefix = Tcl_Alloc(bufptr - buf); + strncpy(prefix, buf, bufptr - buf - 1); + prefix[bufptr - buf - 1] = '\0'; + } else { + /* synthesize prefix for this XML Namespace */ + prefix = Tcl_Alloc(20); + sprintf(prefix, "ns%d", domDocPtr->nodeCntr++); + } + + nsPtr = xmlNewNs(newNodePtr, (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL), (const xmlChar *) prefix); + if (nsPtr == NULL) { + Tcl_SetResult(interp, "unable to create XML Namespace", NULL); + Tcl_Free(prefix); + xmlUnlinkNode(newNodePtr); + xmlFreeNode(newNodePtr); + Tcl_MutexUnlock(&libxml2); + return TCL_ERROR; + } + + xmlSetNs(newNodePtr, nsPtr); + + Tcl_MutexUnlock(&libxml2); + + newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr); + if (newNodeObjPtr == NULL) { + Tcl_MutexLock(&libxml2); + xmlFreeNode(newNodePtr); + Tcl_MutexUnlock(&libxml2); + + return TCL_ERROR; + } + + postMutationEvent = 1; + + } else if (docPtr && clientData != NULL) { + /* Create an unattached element node */ + Tcl_MutexLock(&libxml2); + newNodePtr = xmlNewDocNode(docPtr, NULL, (const xmlChar *) bufptr, NULL); + + if (idx < len) { + prefix = Tcl_Alloc(bufptr - buf); + strncpy(prefix, buf, bufptr - buf - 1); + prefix[bufptr - buf - 1] = '\0'; + } else { + /* synthesize prefix for this XML Namespace */ + prefix = Tcl_Alloc(20); + sprintf(prefix, "ns%d", domDocPtr->nodeCntr); + } + + nsPtr = xmlNewNs(newNodePtr, (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL), (const xmlChar *) prefix); + if (nsPtr == NULL) { + Tcl_SetResult(interp, "unable to create XML Namespace", NULL); + Tcl_Free(prefix); + xmlUnlinkNode(newNodePtr); + xmlFreeNode(newNodePtr); + Tcl_MutexUnlock(&libxml2); + return TCL_ERROR; + } + + xmlSetNs(newNodePtr, nsPtr); + + Tcl_MutexUnlock(&libxml2); + + if (newNodePtr == NULL) { + Tcl_SetResult(interp, "unable to create element node", NULL); + return TCL_ERROR; + } + + newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr); + if (newNodeObjPtr == NULL) { + Tcl_MutexLock(&libxml2); + xmlFreeNode(newNodePtr); + Tcl_MutexUnlock(&libxml2); + return TCL_ERROR; + } else { + Tcl_SetObjResult(interp, newNodeObjPtr); + } + + /* + * The tree hasn't changed yet, so no events need to be fired. + */ + postMutationEvent = 0; + + } else { + + Tcl_MutexLock(&libxml2); + /* Find XML Namespace */ + nsPtr = xmlSearchNsByHref(nodePtr->doc, + nodePtr, + (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL)); + if (nsPtr == NULL) { + if (idx < len) { + prefix = Tcl_Alloc(bufptr - buf); + strncpy(prefix, buf, bufptr - buf - 1); + prefix[bufptr - buf - 1] = '\0'; + } else { + prefix = Tcl_Alloc(20); + sprintf(prefix, "ns%d", domDocPtr->nodeCntr++); + } + + newNodePtr = xmlNewChild(nodePtr, NULL, (const xmlChar *) bufptr, NULL); + nsPtr = xmlNewNs(newNodePtr, + (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL), + (const xmlChar *) prefix); + if (nsPtr == NULL) { + Tcl_SetResult(interp, "unable to create XML Namespace", NULL); + Tcl_MutexUnlock(&libxml2); + return TCL_ERROR; + } + xmlSetNs(newNodePtr, nsPtr); + + } else { + newNodePtr = xmlNewChild(nodePtr, nsPtr, (const xmlChar *) bufptr, NULL); + if (newNodePtr == NULL) { + Tcl_SetResult(interp, "unable to create element node", NULL); + Tcl_MutexUnlock(&libxml2); + return TCL_ERROR; + } + } + + Tcl_MutexUnlock(&libxml2); + + newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr); + if (newNodeObjPtr == NULL) { + Tcl_MutexLock(&libxml2); + xmlFreeNode(newNodePtr); + Tcl_MutexUnlock(&libxml2); + return TCL_ERROR; + } + + postMutationEvent = 1; + } + + break; + + case TCLDOM_DOCUMENT_CREATEELEMENT: + + if (optobjc != 1) { + Tcl_WrongNumArgs(interp, wrongidx, objv, "name"); + return TCL_ERROR; + } + + /* + * libxml2 doesn't check for invalid element name, + * so must do that here. + */ + if (Tcl_RegExpMatchObj(interp, optobjv[0], checkName) == 0) { + Tcl_AppendResult(interp, "invalid element name \"", Tcl_GetStringFromObj(optobjv[0], NULL), "\"", NULL); + return TCL_ERROR; + } + + Tcl_MutexLock(&libxml2); + + if (docPtr && clientData == NULL) { + xmlNodePtr old; + newNodePtr = xmlNewDocNode(docPtr, + NULL, + (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL), + NULL); + if (newNodePtr == NULL) { + Tcl_SetResult(interp, "unable to create element node", NULL); + Tcl_MutexUnlock(&libxml2); + return TCL_ERROR; + } + old = xmlDocSetRootElement(docPtr, newNodePtr); + if (old) { + xmlDocSetRootElement(docPtr, old); + xmlFreeNode(newNodePtr); + Tcl_SetResult(interp, "document element already exists", NULL); + Tcl_MutexUnlock(&libxml2); + return TCL_ERROR; + } + + newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr); + if (newNodeObjPtr == NULL) { + xmlFreeNode(newNodePtr); + Tcl_MutexUnlock(&libxml2); + return TCL_ERROR; + } + + postMutationEvent = 1; + } else if (docPtr && clientData != NULL) { + /* Create an unattached element node */ + newNodePtr = xmlNewDocNode(docPtr, + NULL, + (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL), + NULL); + if (newNodePtr == NULL) { + Tcl_SetResult(interp, "unable to create element node", NULL); + Tcl_MutexUnlock(&libxml2); + return TCL_ERROR; + } + + newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr); + if (newNodeObjPtr == NULL) { + xmlFreeNode(newNodePtr); + Tcl_MutexUnlock(&libxml2); + return TCL_ERROR; + } else { + Tcl_SetObjResult(interp, newNodeObjPtr); + } + + /* + * The tree hasn't changed yet, so no events need to be fired. + */ + postMutationEvent = 0; + } else { + newNodePtr = xmlNewChild(nodePtr, + NULL, + (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL), + NULL); + if (newNodePtr == NULL) { + Tcl_SetResult(interp, "unable to create element node", NULL); + Tcl_MutexUnlock(&libxml2); + return TCL_ERROR; + } + newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr); + if (newNodeObjPtr == NULL) { + xmlFreeNode(newNodePtr); + Tcl_MutexUnlock(&libxml2); + return TCL_ERROR; + } + postMutationEvent = 1; + } + + Tcl_MutexUnlock(&libxml2); + + break; + + case TCLDOM_DOCUMENT_CREATEDOCUMENTFRAGMENT: + + if (optobjc != 0) { + Tcl_WrongNumArgs(interp, wrongidx, objv, ""); + return TCL_ERROR; + } + + Tcl_MutexLock(&libxml2); + + if (docPtr) { + newNodePtr = xmlNewDocFragment(docPtr); + } else { + newNodePtr = xmlNewDocFragment(nodePtr->doc); + } + if (newNodePtr == NULL) { + Tcl_SetResult(interp, "unable to create document fragment", NULL); + Tcl_MutexUnlock(&libxml2); + return TCL_ERROR; + } + + newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr); + if (newNodeObjPtr == NULL) { + xmlFreeNode(newNodePtr); + Tcl_MutexUnlock(&libxml2); + return TCL_ERROR; + } else { + Tcl_SetObjResult(interp, newNodeObjPtr); + } + + Tcl_MutexUnlock(&libxml2); + + /* The node hasn't been inserted into the tree yet */ + postMutationEvent = 0; + + break; + + case TCLDOM_DOCUMENT_CREATETEXTNODE: + + if (optobjc != 1) { + Tcl_WrongNumArgs(interp, wrongidx, objv, "text"); + return TCL_ERROR; + } + + Tcl_MutexLock(&libxml2); + + if (docPtr) { + char *content; + int len; + + content = Tcl_GetStringFromObj(optobjv[0], &len); + newNodePtr = xmlNewDocTextLen(docPtr, (const xmlChar *) content, len); + if (newNodePtr == NULL) { + Tcl_SetResult(interp, "unable to create text node", NULL); + Tcl_MutexUnlock(&libxml2); + return TCL_ERROR; + } + + newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr); + if (newNodeObjPtr == NULL) { + xmlFreeNode(newNodePtr); + Tcl_MutexUnlock(&libxml2); + return TCL_ERROR; + } else { + Tcl_SetObjResult(interp, newNodeObjPtr); + } + + Tcl_MutexUnlock(&libxml2); + + postMutationEvent = 0; + + } else { + xmlNodePtr returnNode; + char *content; + int len; + + content = Tcl_GetStringFromObj(optobjv[0], &len); + newNodePtr = xmlNewTextLen((const xmlChar *) content, len); + if (newNodePtr == NULL) { + Tcl_SetResult(interp, "creating text node failed", NULL); + Tcl_MutexUnlock(&libxml2); + return TCL_ERROR; + } + returnNode = xmlAddChild(nodePtr, newNodePtr); + if (returnNode == NULL) { + xmlFreeNode(newNodePtr); + Tcl_SetResult(interp, "add child failed", NULL); + Tcl_MutexUnlock(&libxml2); + return TCL_ERROR; + } + + newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr); + if (newNodeObjPtr == NULL) { + xmlFreeNode(newNodePtr); + Tcl_MutexUnlock(&libxml2); + return TCL_ERROR; + } + + Tcl_MutexUnlock(&libxml2); + + postMutationEvent = 1; + } + + break; + + case TCLDOM_DOCUMENT_CREATECOMMENT: + + if (optobjc != 1) { + Tcl_WrongNumArgs(interp, wrongidx, objv, "data"); + return TCL_ERROR; + } + + Tcl_MutexLock(&libxml2); + + if (docPtr) { + newNodePtr = xmlNewDocComment(docPtr, (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL)); + if (newNodePtr == NULL) { + Tcl_SetResult(interp, "unable to create comment node", NULL); + Tcl_MutexUnlock(&libxml2); + return TCL_ERROR; + } + newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr); + if (newNodeObjPtr == NULL) { + xmlFreeNode(newNodePtr); + Tcl_MutexUnlock(&libxml2); + return TCL_ERROR; + } else { + Tcl_SetObjResult(interp, newNodeObjPtr); + } + + postMutationEvent = 0; + + } else { + newNodePtr = xmlNewDocComment(nodePtr->doc, (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL)); + if (newNodePtr == NULL) { + Tcl_SetResult(interp, "unable to create comment node", NULL); + Tcl_MutexUnlock(&libxml2); + return TCL_ERROR; + } + xmlAddChild(nodePtr, newNodePtr); + + newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr); + if (newNodeObjPtr == NULL) { + xmlFreeNode(newNodePtr); + Tcl_MutexUnlock(&libxml2); + return TCL_ERROR; + } + + postMutationEvent = 1; + } + + Tcl_MutexUnlock(&libxml2); + + break; + + case TCLDOM_DOCUMENT_CREATECDATASECTION: + + if (optobjc != 1) { + Tcl_WrongNumArgs(interp, wrongidx, objv, "text"); + return TCL_ERROR; + } + + Tcl_MutexLock(&libxml2); + + if (docPtr) { + char *content; + int len; + + content = Tcl_GetStringFromObj(optobjv[0], &len); + newNodePtr = xmlNewDocTextLen(docPtr, (const xmlChar *) content, len); + if (newNodePtr == NULL) { + Tcl_SetResult(interp, "unable to create text node", NULL); + Tcl_MutexUnlock(&libxml2); + return TCL_ERROR; + } + newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr); + if (newNodeObjPtr == NULL) { + xmlFreeNode(newNodePtr); + Tcl_MutexUnlock(&libxml2); + return TCL_ERROR; + } else { + Tcl_SetObjResult(interp, newNodeObjPtr); + } + + postMutationEvent = 0; + + } else { + char *content; + int len; + + content = Tcl_GetStringFromObj(optobjv[0], &len); + newNodePtr = xmlNewTextLen((const xmlChar *) content, len); + if (newNodePtr == NULL) { + Tcl_SetResult(interp, "unable to create text node", NULL); + Tcl_MutexUnlock(&libxml2); + return TCL_ERROR; + } + xmlAddChild(nodePtr, newNodePtr); + + newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr); + if (newNodeObjPtr == NULL) { + xmlFreeNode(newNodePtr); + Tcl_MutexUnlock(&libxml2); + return TCL_ERROR; + } + + postMutationEvent = 1; + } + + Tcl_MutexUnlock(&libxml2); + + break; + + case TCLDOM_DOCUMENT_CREATEPI: + if (optobjc != 2) { + Tcl_WrongNumArgs(interp, wrongidx, objv, "target data"); + return TCL_ERROR; + } + + Tcl_MutexLock(&libxml2); + + newNodePtr = xmlNewPI((const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL), + (const xmlChar *) Tcl_GetStringFromObj(optobjv[1], NULL)); + if (newNodePtr == NULL) { + Tcl_SetResult(interp, "unable to create processing instruction node", NULL); + Tcl_MutexUnlock(&libxml2); + return TCL_ERROR; + } + + if (docPtr) { + /* + * libxml2 does not provide 'xmlNewDocPI' so the PI must be added to the tree + * before we wrap it in an object. We'll use the document element as a placeholder + * for the PI node; the user may move it from there. + */ + xmlNodePtr docElPtr = xmlDocGetRootElement(docPtr); + + if (docElPtr == NULL) { + xmlFreeNode(newNodePtr); + Tcl_MutexUnlock(&libxml2); + Tcl_SetResult(interp, "document element must exist before adding a PI", NULL); + return TCL_ERROR; + } + xmlAddNextSibling(docElPtr, newNodePtr); + + newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr); + if (newNodeObjPtr == NULL) { + xmlFreeNode(newNodePtr); + Tcl_MutexUnlock(&libxml2); + return TCL_ERROR; + } else { + Tcl_SetObjResult(interp, newNodeObjPtr); + } + + postMutationEvent = 0; + + } else { + xmlAddChild(nodePtr, newNodePtr); + + newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr); + if (newNodeObjPtr == NULL) { + xmlFreeNode(newNodePtr); + Tcl_MutexUnlock(&libxml2); + return TCL_ERROR; + } + + postMutationEvent = 1; + } + + Tcl_MutexUnlock(&libxml2); + + break; + + case TCLDOM_DOCUMENT_CREATEEVENT: + + if (optobjc != 1) { + Tcl_WrongNumArgs(interp, wrongidx, objv, "type"); + return TCL_ERROR; + } + + if (!docPtr) { + docPtr = nodePtr->doc; + } + + if (Tcl_GetIndexFromObj(interp, optobjv[0], TclDOM_EventTypes, + "type", TCL_EXACT, &method) == TCL_OK) { + type = (enum TclDOM_EventTypes) method; + } else { + type = TCLDOM_EVENT_USERDEFINED; + } + + newNodeObjPtr = TclDOM_libxml2_NewEventObj(interp, docPtr, type, optobjv[0]); + if (newNodeObjPtr == NULL) { + return TCL_ERROR; + } else { + Tcl_SetObjResult(interp, newNodeObjPtr); + } + + postMutationEvent = 0; + + break; + + case TCLDOM_DOCUMENT_SCHEMA: + + if (optobjc < 1) { + Tcl_WrongNumArgs(interp, wrongidx, objv, "submethod ?args ...?"); + return TCL_ERROR; + } + + if (Tcl_GetIndexFromObj(interp, optobjv[0], TclDOM_DocumentSchemaSubmethods, + "submethod", 0, &method) != TCL_OK) { + return TCL_ERROR; + } + + switch ((enum TclDOM_DocumentSchemaSubmethods) method) { + case TCLDOM_DOCUMENT_SCHEMA_COMPILE: + if (optobjc != 1) { + Tcl_WrongNumArgs(interp, wrongidx, objv, "compile"); + return TCL_ERROR; + } + return SchemaCompile(interp, domDocPtr); + + case TCLDOM_DOCUMENT_SCHEMA_VALIDATE: + if (optobjc != 2) { + Tcl_WrongNumArgs(interp, wrongidx, objv, "validate instance"); + return TCL_ERROR; + } else { + xmlDocPtr instancePtr; + + if (TclXML_libxml2_GetDocFromObj(interp, optobjv[1], &instancePtr) != TCL_OK) { + return TCL_ERROR; + } + + return SchemaValidate(interp, domDocPtr, instancePtr); + } + + break; + + default: + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "unknown submethod \"", + Tcl_GetStringFromObj(optobjv[0], NULL), "\"", NULL); + return TCL_ERROR; + } + + break; + + case TCLDOM_DOCUMENT_DTD: + + if (optobjc < 1) { + Tcl_WrongNumArgs(interp, wrongidx, objv, "submethod ?args...?"); + return TCL_ERROR; + } + + if (Tcl_GetIndexFromObj(interp, optobjv[0], TclDOM_DocumentDTDSubmethods, + "submethod", 0, &method) != TCL_OK) { + return TCL_ERROR; + } + + switch ((enum TclDOM_DocumentDTDSubmethods) method) { + case TCLDOM_DOCUMENT_DTD_VALIDATE: + if (optobjc != 1) { + Tcl_WrongNumArgs(interp, wrongidx, objv, "validate"); + return TCL_ERROR; + } else { + return DTDValidate(interp, domDocPtr); + } + default: + Tcl_SetResult(interp, "unknown submethod", NULL); + return TCL_ERROR; + } + + break; + + case TCLDOM_DOCUMENT_CREATEATTRIBUTE: + case TCLDOM_DOCUMENT_CREATEENTITY: + case TCLDOM_DOCUMENT_CREATEENTITYREFERENCE: + case TCLDOM_DOCUMENT_CREATEDOCTYPEDECL: + default: + Tcl_SetResult(interp, "method \"", NULL); + Tcl_AppendResult(interp, Tcl_GetStringFromObj(objv[1], NULL), "\" not yet implemented", NULL); + return TCL_ERROR; + } + + if (postMutationEvent) { + + TclDOM_PostMutationEvent(interp, tDocPtr, newNodeObjPtr, TCLDOM_EVENT_DOMNODEINSERTED, NULL, Tcl_NewIntObj(1), Tcl_NewIntObj(0), objv[2], NULL, NULL, NULL, NULL); + TclDOM_PostMutationEvent(interp, tDocPtr, newNodeObjPtr, TCLDOM_EVENT_DOMNODEINSERTEDINTODOCUMENT, NULL, Tcl_NewIntObj(0), Tcl_NewIntObj(0), NULL, NULL, NULL, NULL, NULL); + + if (nodePtr) { + TclDOM_PostMutationEvent(interp, tDocPtr, nodeObjPtr, TCLDOM_EVENT_DOMSUBTREEMODIFIED, NULL, Tcl_NewIntObj(1), Tcl_NewIntObj(0), NULL, NULL, NULL, NULL, NULL); + } else { + /* + * We just added the document element. + */ + } + + Tcl_SetObjResult(interp, newNodeObjPtr); + } + + return TCL_OK; +} + +int +DocumentCget(interp, docPtr, optObj) + Tcl_Interp *interp; + xmlDocPtr docPtr; + Tcl_Obj *CONST optObj; +{ + xmlNodePtr nodePtr; + int option; + + if (Tcl_GetIndexFromObj(interp, optObj, TclDOM_DocumentCommandOptions, + "option", 0, &option) != TCL_OK) { + return TCL_ERROR; + } + + switch ((enum TclDOM_DocumentCommandOptions) option) { + + case TCLDOM_DOCUMENT_DOCTYPE: + Tcl_SetResult(interp, "cget option \"", NULL); + Tcl_AppendResult(interp, Tcl_GetStringFromObj(optObj, NULL), NULL); + Tcl_AppendResult(interp, "\" not yet implemented", NULL); + return TCL_ERROR; + + case TCLDOM_DOCUMENT_IMPLEMENTATION: + Tcl_SetResult(interp, "::dom::libxml2::DOMImplementation", NULL); + break; + + case TCLDOM_DOCUMENT_DOCELEMENT: + + Tcl_MutexLock(&libxml2); + nodePtr = xmlDocGetRootElement(docPtr); + Tcl_MutexUnlock(&libxml2); + + if (nodePtr) { + Tcl_SetObjResult(interp, TclDOM_libxml2_CreateObjFromNode(interp, nodePtr)); + } else { + Tcl_ResetResult(interp); + return TCL_OK; + } + + break; + + default: + Tcl_SetResult(interp, "unknown option", NULL); + return TCL_ERROR; + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * TriggerEventListeners -- + * + * Iterates through the list of event listeners for + * a node or document and fires events. + * + * Results: + * Depends on listeners. + * + * Side effects: + * Depends on listeners. + * + *---------------------------------------------------------------------------- + */ + +static int +TriggerEventListeners(interp, type, tokenPtr, eventObjPtr, eventPtr) + Tcl_Interp *interp; + Tcl_HashTable *type; + void *tokenPtr; + Tcl_Obj *eventObjPtr; + TclDOM_libxml2_Event *eventPtr; +{ + Tcl_HashEntry *entryPtr; + Tcl_HashTable *tablePtr; + Tcl_Obj *listenerListPtr; + int listenerLen, listenerIdx; + char *eventType; + + entryPtr = Tcl_FindHashEntry(type, tokenPtr); + if (!entryPtr) { + return TCL_OK; + } + tablePtr = (Tcl_HashTable *) Tcl_GetHashValue(entryPtr); + + if (eventPtr->type != TCLDOM_EVENT_USERDEFINED) { + eventType = (char *) TclDOM_EventTypes[eventPtr->type]; + } else { + eventType = Tcl_GetStringFromObj(eventPtr->typeObjPtr, NULL); + } + entryPtr = Tcl_FindHashEntry(tablePtr, eventType); + if (!entryPtr) { + return TCL_OK; + } + listenerListPtr = (Tcl_Obj *) Tcl_GetHashValue(entryPtr); + + /* + * DOM L2 specifies that the ancestors are determined + * at the moment of event dispatch, so using a static + * list is the correct thing to do. + */ + + Tcl_ListObjLength(interp, listenerListPtr, &listenerLen); + for (listenerIdx = 0; listenerIdx < listenerLen; listenerIdx++) { + Tcl_Obj *listenerObj, *cmdPtr; + + Tcl_ListObjIndex(interp, listenerListPtr, listenerIdx, &listenerObj); + + cmdPtr = Tcl_DuplicateObj(listenerObj); + Tcl_IncrRefCount(cmdPtr); + if (Tcl_ListObjAppendElement(interp, cmdPtr, eventObjPtr) != TCL_OK) { + Tcl_DecrRefCount(cmdPtr); + return TCL_ERROR; + } + Tcl_Preserve((ClientData) interp); + if (Tcl_GlobalEvalObj(interp, cmdPtr) != TCL_OK) { + Tcl_BackgroundError(interp); + } + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) interp); + } + + return TCL_OK; +} + +static int +TclDOMSetLiveNodeListNode(interp, varName, nodePtr) + Tcl_Interp *interp; + char *varName; + xmlNodePtr nodePtr; +{ + Tcl_Obj *valuePtr = Tcl_NewListObj(0, NULL); + xmlNodePtr childPtr; + + for (childPtr = nodePtr->children; childPtr; childPtr = childPtr->next) { + Tcl_ListObjAppendElement(interp, valuePtr, TclDOM_libxml2_CreateObjFromNode(interp, childPtr)); + } + + Tcl_SetVar2Ex(interp, varName, NULL, valuePtr, TCL_GLOBAL_ONLY); + + return TCL_OK; +} + +static int +TclDOMSetLiveNodeListDoc(interp, varName, docPtr) + Tcl_Interp *interp; + char *varName; + xmlDocPtr docPtr; +{ + Tcl_Obj *valuePtr = Tcl_NewListObj(0, NULL); + xmlNodePtr childPtr; + + for (childPtr = docPtr->children; childPtr; childPtr = childPtr->next) { + Tcl_ListObjAppendElement(interp, valuePtr, TclDOM_libxml2_CreateObjFromNode(interp, childPtr)); + } + + Tcl_SetVar2Ex(interp, varName, NULL, valuePtr, TCL_GLOBAL_ONLY); + + return TCL_OK; +} + +static char * +TclDOMLiveNodeListNode(clientData, interp, name1, name2, flags) + ClientData clientData; + Tcl_Interp *interp; + char *name1; + char *name2; + int flags; +{ + xmlNodePtr nodePtr = (xmlNodePtr) clientData; + + if (flags & (TCL_INTERP_DESTROYED | TCL_TRACE_DESTROYED)) { + return NULL; + } else if (flags & TCL_TRACE_READS) { + TclDOMSetLiveNodeListNode(interp, name1, nodePtr); + } else if (flags & TCL_TRACE_WRITES) { + TclDOMSetLiveNodeListNode(interp, name1, nodePtr); + return "variable is read-only"; + } else if (flags & TCL_TRACE_UNSETS) { + } + + return NULL; +} +static char * +TclDOMLiveNodeListDoc(clientData, interp, name1, name2, flags) + ClientData clientData; + Tcl_Interp *interp; + char *name1; + char *name2; + int flags; +{ + xmlDocPtr docPtr = (xmlDocPtr) clientData; + + if (flags & (TCL_INTERP_DESTROYED | TCL_TRACE_DESTROYED)) { + return NULL; + } else if (flags & TCL_TRACE_READS) { + TclDOMSetLiveNodeListDoc(interp, name1, docPtr); + } else if (flags & TCL_TRACE_WRITES) { + TclDOMSetLiveNodeListDoc(interp, name1, docPtr); + return "variable is read-only"; + } else if (flags & TCL_TRACE_UNSETS) { + } + + return NULL; +} + +static int +TclDOMSetLiveNamedNodeMap(interp, varName, nodePtr) + Tcl_Interp *interp; + char *varName; + xmlNodePtr nodePtr; +{ + xmlAttrPtr attrPtr; + + Tcl_UnsetVar(interp, varName, TCL_GLOBAL_ONLY); + + for (attrPtr = nodePtr->properties; attrPtr; attrPtr = attrPtr->next) { + + if (Tcl_SetVar2Ex(interp, varName, (char *) attrPtr->name, Tcl_NewStringObj((CONST char *) xmlGetProp(nodePtr, attrPtr->name), -1), TCL_GLOBAL_ONLY) == NULL) { + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "unable to set attribute \"", attrPtr->name, "\"", NULL); + return TCL_ERROR; + } + + if (Tcl_TraceVar2(interp, varName, (char *) attrPtr->name, TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS|TCL_GLOBAL_ONLY, (Tcl_VarTraceProc *) TclDOMLiveNamedNodeMap, (ClientData) nodePtr) != TCL_OK) { + return TCL_ERROR; + } + } + + return TCL_OK; +} + +static char * +TclDOMLiveNamedNodeMap(clientData, interp, name1, name2, flags) + ClientData clientData; + Tcl_Interp *interp; + char *name1; + char *name2; + int flags; +{ + xmlNodePtr nodePtr = (xmlNodePtr) clientData; + + if (flags & (TCL_INTERP_DESTROYED | TCL_TRACE_DESTROYED)) { + return NULL; + } else if (flags & TCL_TRACE_READS && name2 == NULL) { + TclDOMSetLiveNamedNodeMap(interp, name1, nodePtr); + } else if (flags & TCL_TRACE_READS && name2 != NULL) { + if (Tcl_SetVar2Ex(interp, name1, name2, Tcl_NewStringObj((CONST char *) xmlGetProp(nodePtr, (const xmlChar *) name2), -1), TCL_GLOBAL_ONLY) == NULL) { + return "unable to set attribute"; + } + } else if (flags & TCL_TRACE_WRITES) { + TclDOMSetLiveNamedNodeMap(interp, name1, nodePtr); + return "variable is read-only"; + } else if (flags & TCL_TRACE_UNSETS) { + } + + return NULL; +} + +/* + *---------------------------------------------------------------------------- + * + * TclDOMNodeCommand -- + * + * Implements dom::libxml2::node command. + * + * Results: + * Depends on method. + * + * Side effects: + * Depends on method. + * + *---------------------------------------------------------------------------- + */ + +int +TclDOMNodeCommand (clientData, interp, objc, objv) + ClientData clientData; + Tcl_Interp *interp; + int objc; + Tcl_Obj *CONST objv[]; +{ + TclXML_libxml2_Document *tDocPtr; + TclDOM_libxml2_Node *tNodePtr; + int method, optobjc, option, wrongidx, usecapture = 0; + char *buf; + xmlNodePtr nodePtr = NULL, childNodePtr, refPtr, newPtr, oldParent; + xmlDocPtr docPtr = NULL; + Tcl_Obj *nodeObjPtr = NULL; + Tcl_Obj *docObjPtr = NULL; + Tcl_Obj *resultPtr; + Tcl_Obj *CONST *optobjv; + + if (clientData == NULL) { + + if (objc < 3) { + Tcl_WrongNumArgs(interp, 1, objv, "method token ?arg ...?"); + return TCL_ERROR; + } + + if (TclDOM_libxml2_GetTclNodeFromObj(interp, objv[2], &tNodePtr) != TCL_OK) { + if (TclXML_libxml2_GetTclDocFromObj(interp, objv[2], &tDocPtr) != TCL_OK) { + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "\"", Tcl_GetStringFromObj(objv[2], NULL), "\" is neither a DOM document nor a DOM node", NULL); + return TCL_ERROR; + } else { + Tcl_ResetResult(interp); + docObjPtr = objv[2]; + docPtr = tDocPtr->docPtr; + nodeObjPtr = NULL; + nodePtr = NULL; + } + } else { + nodePtr = tNodePtr->ptr.nodePtr; + nodeObjPtr = objv[2]; + docPtr = NULL; + docObjPtr = NULL; + if (TclXML_libxml2_GetTclDocFromNode(interp, nodePtr, &tDocPtr) != TCL_OK) { + return TCL_ERROR; + } + } + + optobjc = objc - 3; + optobjv = objv + 3; + wrongidx = 3; + + } else { + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "method ?arg ...?"); + return TCL_ERROR; + } + + tNodePtr = (TclDOM_libxml2_Node *) clientData; + nodePtr = tNodePtr->ptr.nodePtr; + nodeObjPtr = NULL; + docPtr = NULL; + docObjPtr = NULL; + if (TclXML_libxml2_GetTclDocFromNode(interp, nodePtr, &tDocPtr) != TCL_OK) { + return TCL_ERROR; + } + + optobjc = objc - 2; + optobjv = objv + 2; + wrongidx = 2; + + } + + if (Tcl_GetIndexFromObj(interp, objv[1], TclDOM_NodeCommandMethods, + "method", 0, &method) != TCL_OK) { + return TCL_ERROR; + } + + switch ((enum TclDOM_NodeCommandMethods) method) { + + case TCLDOM_NODE_CGET: + + if (optobjc != 1) { + Tcl_WrongNumArgs(interp, wrongidx, objv, "option"); + return TCL_ERROR; + } + + NodeCget(interp, docPtr, nodePtr, optobjv[0]); + + break; + + case TCLDOM_NODE_PATH: + + if (docPtr) { + Tcl_Obj *newobjv[2]; + + newobjv[0] = TclXML_libxml2_CreateObjFromDoc(docPtr); + newobjv[1] = NULL; + Tcl_SetObjResult(interp, Tcl_NewListObj(1, newobjv)); + } else { + Tcl_SetObjResult(interp, GetPath(interp, nodePtr)); + } + + break; + + case TCLDOM_NODE_CONFIGURE: + + if (optobjc < 1) { + Tcl_WrongNumArgs(interp, wrongidx, objv, "option ?value? ?option value ...?"); + return TCL_ERROR; + } + + if (optobjc == 1) { + return NodeCget(interp, docPtr, nodePtr, optobjv[0]); + } + + if (optobjc % 2 == 1) { + Tcl_WrongNumArgs(interp, wrongidx, objv, "option ?value? ?option value ...?"); + return TCL_ERROR; + } + + return NodeConfigure(interp, nodePtr, optobjc, optobjv); + break; + + case TCLDOM_NODE_INSERTBEFORE: + if (optobjc < 1 || optobjc > 2) { + Tcl_WrongNumArgs(interp, wrongidx, objv, "ref ?new?"); + return TCL_ERROR; + } else if (docPtr) { + /* TODO: allow comments & PIs in document prologue */ + Tcl_SetResult(interp, "document already has document element", NULL); + return TCL_ERROR; + } else if (optobjc == 1) { + /* No reference child specified - new appended to child list */ + if (TclDOM_libxml2_GetNodeFromObj(interp, optobjv[0], &newPtr) != TCL_OK) { + return TCL_ERROR; + } + return TclDOM_NodeAppendChild(interp, nodePtr, newPtr); + } else if (optobjc == 2) { + if (TclDOM_libxml2_GetNodeFromObj(interp, optobjv[0], &newPtr) != TCL_OK) { + return TCL_ERROR; + } + if (TclDOM_libxml2_GetNodeFromObj(interp, optobjv[1], &refPtr) != TCL_OK) { + return TCL_ERROR; + } + return TclDOM_NodeInsertBefore(interp, refPtr, newPtr); + } + + break; + + case TCLDOM_NODE_REPLACECHILD: + if (optobjc != 2) { + Tcl_WrongNumArgs(interp, wrongidx, objv, "new old"); + return TCL_ERROR; + } else if (docPtr) { + /* TODO: allow replacing comments & PIs */ + Tcl_SetResult(interp, "document already has document element", NULL); + return TCL_ERROR; + } else { + if (TclDOM_libxml2_GetNodeFromObj(interp, optobjv[0], &newPtr) != TCL_OK) { + return TCL_ERROR; + } + if (TclDOM_libxml2_GetNodeFromObj(interp, optobjv[1], &refPtr) != TCL_OK) { + return TCL_ERROR; + } + oldParent = newPtr->parent; + if (oldParent != refPtr->parent) { + TclDOM_PostMutationEvent(interp, + tDocPtr, + TclDOM_libxml2_CreateObjFromNode(interp, newPtr), + TCLDOM_EVENT_DOMNODEREMOVED, + NULL, + Tcl_NewIntObj(1), Tcl_NewIntObj(0), + TclDOM_libxml2_CreateObjFromNode(interp, newPtr->parent), + NULL, NULL, NULL, NULL); + } + + Tcl_MutexLock(&libxml2); + + if (xmlReplaceNode(refPtr, newPtr) == NULL) { + Tcl_SetResult(interp, "unable to replace node", NULL); + Tcl_MutexUnlock(&libxml2); + return TCL_ERROR; + } + + Tcl_MutexUnlock(&libxml2); + + } + + PostMutationEvents(interp, tDocPtr, nodePtr, refPtr, newPtr, oldParent, refPtr->parent); + + Tcl_SetObjResult(interp, TclDOM_libxml2_CreateObjFromNode(interp, refPtr)); + + break; + + case TCLDOM_NODE_REMOVECHILD: + if (optobjc != 1) { + Tcl_WrongNumArgs(interp, wrongidx, objv, "child"); + return TCL_ERROR; + } else if (docPtr) { + /* TODO: allow removing comments & PIs */ + Tcl_SetResult(interp, "document must have document element", NULL); + return TCL_ERROR; + } else { + xmlNodePtr childPtr; + if (TclDOM_libxml2_GetNodeFromObj(interp, optobjv[0], &childPtr) != TCL_OK) { + return TCL_ERROR; + } + if (nodePtr != childPtr->parent) { + Tcl_SetResult(interp, "not found: \"", NULL); + Tcl_AppendResult(interp, Tcl_GetStringFromObj(optobjv[0], NULL), + "\" is not a child", NULL); + if (nodeObjPtr) { + Tcl_AppendResult(interp, " of \"", + Tcl_GetStringFromObj(nodeObjPtr, NULL), "\"", NULL); + } + return TCL_ERROR; + } + oldParent = childPtr->parent; + TclDOM_PostMutationEvent(interp, + tDocPtr, optobjv[0], + TCLDOM_EVENT_DOMNODEREMOVED, + NULL, + Tcl_NewIntObj(1), Tcl_NewIntObj(0), + TclDOM_libxml2_CreateObjFromNode(interp, oldParent), + NULL, NULL, NULL, NULL); + TclDOM_PostMutationEvent(interp, + tDocPtr, optobjv[0], + TCLDOM_EVENT_DOMNODEREMOVEDFROMDOCUMENT, + NULL, + Tcl_NewIntObj(0), Tcl_NewIntObj(0), + NULL, NULL, NULL, NULL, NULL); + + Tcl_MutexLock(&libxml2); + xmlUnlinkNode(childPtr); + Tcl_MutexUnlock(&libxml2); + + Tcl_SetObjResult(interp, optobjv[0]); + TclDOM_PostMutationEvent(interp, + tDocPtr, + TclDOM_libxml2_CreateObjFromNode(interp, oldParent), + TCLDOM_EVENT_DOMSUBTREEMODIFIED, + NULL, + Tcl_NewIntObj(1), Tcl_NewIntObj(0), NULL, NULL, NULL, NULL, NULL); + } + + break; + + case TCLDOM_NODE_APPENDCHILD: + if (optobjc != 1) { + Tcl_WrongNumArgs(interp, wrongidx, objv, "child"); + return TCL_ERROR; + } else if (docPtr) { + xmlNodePtr oldPtr; + + if (TclDOM_libxml2_GetNodeFromObj(interp, optobjv[0], &childNodePtr) != TCL_OK) { + return TCL_ERROR; + } + + Tcl_MutexLock(&libxml2); + + /* TODO: allow appending comments & PIs */ + oldPtr = xmlDocSetRootElement(docPtr, childNodePtr); + if (oldPtr) { + xmlDocSetRootElement(docPtr, oldPtr); + Tcl_SetResult(interp, "document element already exists", NULL); + Tcl_MutexUnlock(&libxml2); + return TCL_ERROR; + } + + Tcl_MutexUnlock(&libxml2); + + Tcl_SetObjResult(interp, optobjv[0]); + + } else { + if (TclDOM_libxml2_GetNodeFromObj(interp, optobjv[0], &childNodePtr) != TCL_OK) { + return TCL_ERROR; + } + + return TclDOM_NodeAppendChild(interp, nodePtr, childNodePtr); + } + + break; + + case TCLDOM_NODE_HASCHILDNODES: + if (docPtr) { + if (docPtr->children) { + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1)); + } else { + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0)); + } + } else { + if (nodePtr->children) { + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1)); + } else { + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0)); + } + } + + break; + + case TCLDOM_NODE_ISSAMENODE: + /* DOM Level 3 method */ + + if (optobjc != 1) { + Tcl_WrongNumArgs(interp, wrongidx, objv, "ref"); + return TCL_ERROR; + } + + if (docPtr) { + xmlDocPtr docRefPtr; + + if (TclXML_libxml2_GetDocFromObj(interp, optobjv[0], &docRefPtr) != TCL_OK) { + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0)); + return TCL_OK; + } + + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(docPtr == docRefPtr)); + + } else { + if (TclDOM_libxml2_GetNodeFromObj(interp, optobjv[0], &refPtr) != TCL_OK) { + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0)); + return TCL_OK; + } + + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(nodePtr == refPtr)); + } + + break; + + case TCLDOM_NODE_CLONENODE: + if (optobjc != 0 && optobjc != 2) { + Tcl_WrongNumArgs(interp, wrongidx, objv, "?-deep boolean?"); + return TCL_ERROR; + } else if (docPtr) { + Tcl_SetResult(interp, "documents cannot be cloned", NULL); + return TCL_ERROR; + } else { + int deep = 0; + xmlNodePtr copyPtr; + + if (optobjc == 2) { + if (Tcl_RegExpMatchObj(interp, optobjv[0], Tcl_NewStringObj("-de?e?p?", -1)) == 0) { + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "invalid option \"", Tcl_GetStringFromObj(optobjv[0], NULL), "\", must be \"-deep\"", NULL); + return TCL_ERROR; + } + if (Tcl_GetBooleanFromObj(interp, optobjv[1], &deep) != TCL_OK) { + return TCL_ERROR; + } + } + + Tcl_MutexLock(&libxml2); + copyPtr = xmlDocCopyNode(nodePtr, nodePtr->doc, deep); + Tcl_MutexUnlock(&libxml2); + + if (copyPtr == NULL) { + Tcl_SetResult(interp, "unable to copy node", NULL); + return TCL_ERROR; + } + Tcl_SetObjResult(interp, TclDOM_libxml2_CreateObjFromNode(interp, copyPtr)); + } + break; + + case TCLDOM_NODE_PARENT: + + if (docPtr) { + break; + } + + if (nodePtr->parent) { + Tcl_SetObjResult(interp, TclDOM_libxml2_CreateObjFromNode(interp, nodePtr->parent)); + } else { + Tcl_SetObjResult(interp, TclXML_libxml2_CreateObjFromDoc(nodePtr->doc)); + } + + break; + + case TCLDOM_NODE_CHILDREN: + + resultPtr = Tcl_NewListObj(0, NULL); + + if (docPtr) { + childNodePtr = docPtr->children; + } else { + childNodePtr = nodePtr->children; + } + + while (childNodePtr) { + Tcl_ListObjAppendElement(interp, resultPtr, TclDOM_libxml2_CreateObjFromNode(interp, childNodePtr)); + childNodePtr = childNodePtr->next; + } + + Tcl_SetObjResult(interp, resultPtr); + + break; + + case TCLDOM_NODE_ADDEVENTLISTENER: + + /* TODO: type optional, missing type returns all types that have a listener */ + + if (optobjc < 1) { + Tcl_WrongNumArgs(interp, wrongidx, objv, "type ?listener? ?-usecapture boolean?"); + return TCL_ERROR; + } else { + enum TclDOM_EventTypes type; + Tcl_Obj *typeObjPtr, *listenerPtr = NULL; + void *tokenPtr = NULL; + + if (nodePtr) { + tokenPtr = (void *) nodePtr; + } else { + tokenPtr = (void *) docPtr; + } + + if (Tcl_GetIndexFromObj(interp, optobjv[0], TclDOM_EventTypes, + "type", TCL_EXACT, &option) == TCL_OK) { + type = (enum TclDOM_EventTypes) option; + } else { + type = TCLDOM_EVENT_USERDEFINED; + } + typeObjPtr = optobjv[0]; + Tcl_ResetResult(interp); + optobjc -= 1; + optobjv += 1; + + if (optobjc > 0 && *Tcl_GetStringFromObj(optobjv[0], NULL) != '-') { + listenerPtr = optobjv[0]; + optobjc -= 1; + optobjv += 1; + } /* else we will return the registered listener */ + + while (optobjc) { + if (optobjc == 1) { + Tcl_SetResult(interp, "missing value", NULL); + return TCL_ERROR; + } + if (Tcl_GetIndexFromObj(interp, optobjv[0], TclDOM_NodeCommandAddEventListenerOptions, + "option", 0, &option) != TCL_OK) { + return TCL_ERROR; + } + switch ((enum TclDOM_NodeCommandAddEventListenerOptions) option) { + case TCLDOM_NODE_ADDEVENTLISTENER_USECAPTURE: + + if (Tcl_GetBooleanFromObj(interp, optobjv[1], &usecapture) != TCL_OK) { + return TCL_ERROR; + } + + break; + + default: + Tcl_SetResult(interp, "unknown option", NULL); + return TCL_ERROR; + } + + optobjc -= 2; + optobjv += 2; + } + + if (nodePtr) { + docObjPtr = TclXML_libxml2_CreateObjFromDoc(nodePtr->doc); + } else { + docObjPtr = TclXML_libxml2_CreateObjFromDoc(docPtr); + } + TclXML_libxml2_GetTclDocFromObj(interp, docObjPtr, &tDocPtr); + + if (listenerPtr == NULL) { + listenerPtr = TclDOM_GetEventListener(interp, tDocPtr, tokenPtr, type, typeObjPtr, usecapture); + if (listenerPtr) { + Tcl_SetObjResult(interp, listenerPtr); + } else { + Tcl_SetResult(interp, "unable to find listeners", NULL); + return TCL_ERROR; + } + } else { + return TclDOM_AddEventListener(interp, tDocPtr, tokenPtr, type, typeObjPtr, listenerPtr, usecapture); + } + } + + break; + + + case TCLDOM_NODE_REMOVEEVENTLISTENER: + + if (optobjc < 2) { + Tcl_WrongNumArgs(interp, wrongidx, objv, "type listener ?-usecapture boolean?"); + return TCL_ERROR; + } else { + Tcl_Obj *typeObjPtr, *listenerPtr; + void *tokenPtr = NULL; + TclXML_libxml2_Document *tDocPtr; + enum TclDOM_EventTypes type; + + if (nodePtr) { + tokenPtr = (void *) nodePtr; + } else { + tokenPtr = (void *) docPtr; + } + + typeObjPtr = optobjv[0]; + if (Tcl_GetIndexFromObj(interp, optobjv[0], TclDOM_EventTypes, + "type", TCL_EXACT, &option) == TCL_OK) { + type = (enum TclDOM_EventTypes) option; + } else { + type = TCLDOM_EVENT_USERDEFINED; + } + listenerPtr = optobjv[1]; + + optobjc -= 2; + optobjv += 2; + while (optobjc) { + if (Tcl_GetIndexFromObj(interp, optobjv[0], TclDOM_NodeCommandAddEventListenerOptions, + "option", 0, &option) != TCL_OK) { + return TCL_ERROR; + } + switch ((enum TclDOM_NodeCommandAddEventListenerOptions) option) { + case TCLDOM_NODE_ADDEVENTLISTENER_USECAPTURE: + + if (Tcl_GetBooleanFromObj(interp, optobjv[1], &usecapture) != TCL_OK) { + return TCL_ERROR; + } + + break; + + default: + Tcl_SetResult(interp, "unknown option", NULL); + return TCL_ERROR; + } + + optobjc -= 2; + optobjv += 2; + } + + if (nodePtr) { + if (TclXML_libxml2_GetTclDocFromNode(interp, nodePtr, &tDocPtr) != TCL_OK) { + return TCL_ERROR; + } + } else { + docObjPtr = TclXML_libxml2_CreateObjFromDoc(docPtr); + if (TclXML_libxml2_GetTclDocFromObj(interp, docObjPtr, &tDocPtr) != TCL_OK) { + return TCL_ERROR; + } + } + + return TclDOM_RemoveEventListener(interp, tDocPtr, tokenPtr, type, typeObjPtr, listenerPtr, usecapture); + } + + break; + + case TCLDOM_NODE_DISPATCHEVENT: + + if (optobjc != 1) { + Tcl_WrongNumArgs(interp, wrongidx, objv, "event"); + return TCL_ERROR; + } else { + TclDOM_libxml2_Event *eventPtr; + + if (TclDOM_libxml2_GetEventFromObj(interp, optobjv[0], &eventPtr) != TCL_OK) { + return TCL_ERROR; + } + + if (nodeObjPtr) { + return TclDOM_DispatchEvent(interp, nodeObjPtr, optobjv[0], eventPtr); + } else if (nodePtr) { + return TclDOM_DispatchEvent(interp, TclDOM_libxml2_CreateObjFromNode(interp, nodePtr), optobjv[0], eventPtr); + } else if (docObjPtr) { + return TclDOM_DispatchEvent(interp, docObjPtr, optobjv[0], eventPtr); + } else { + Tcl_SetResult(interp, "unable to dispatch event", NULL); + return TCL_ERROR; + } + } + + break; + + case TCLDOM_NODE_STRINGVALUE: + + if (optobjc != 0) { + Tcl_WrongNumArgs(interp, wrongidx, objv, ""); + return TCL_ERROR; + } + + Tcl_ResetResult(interp); + + Tcl_MutexLock(&libxml2); + + if (nodePtr) { + buf = (char *) xmlNodeGetContent(nodePtr); + Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1)); + xmlFree (buf); + } else if (docPtr) { + nodePtr = xmlDocGetRootElement(docPtr); + if (nodePtr) { + buf = (char *) xmlNodeGetContent(nodePtr); + Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1)); + xmlFree (buf); + } else { + nodePtr = docPtr->children; + while (nodePtr != NULL) { + if (nodePtr->type == XML_TEXT_NODE) { + Tcl_AppendResult(interp, (char *) nodePtr->content, NULL); + } + nodePtr = nodePtr->next; + } + } + } else { + Tcl_SetResult(interp, "cannot determine string value: internal error", NULL); + Tcl_MutexUnlock(&libxml2); + return TCL_ERROR; + } + + Tcl_MutexUnlock(&libxml2); + + break; + + case TCLDOM_NODE_SELECTNODE: + + Tcl_ResetResult(interp); + + return TclDOMSelectNodeCommand(clientData, interp, objc - 1, objv + 1); + + break; + + default: + Tcl_SetResult(interp, "method \"", NULL); + Tcl_AppendResult(interp, Tcl_GetStringFromObj(objv[1], NULL), "\" not yet implemented", NULL); + return TCL_ERROR; + } + + return TCL_OK; +} +int +NodeCget(interp, docPtr, nodePtr, optPtr) + Tcl_Interp *interp; + xmlDocPtr docPtr; + xmlNodePtr nodePtr; + Tcl_Obj *CONST optPtr; +{ + TclXML_libxml2_Document *tDocPtr; + TclDOM_libxml2_Document *domDocPtr; + Tcl_Obj *objPtr; + xmlNodePtr childNodePtr; + int option; + char varname[100]; + Tcl_Obj *livePtr; + + if (Tcl_GetIndexFromObj(interp, optPtr, TclDOM_NodeCommandOptions, + "option", 0, &option) != TCL_OK) { + return TCL_ERROR; + } + + switch ((enum TclDOM_NodeCommandOptions) option) { + + case TCLDOM_NODE_NODETYPE: + + if (docPtr) { + Tcl_SetResult(interp, "document", NULL); + break; + } + + switch (nodePtr->type) { + case XML_ELEMENT_NODE: + Tcl_SetResult(interp, "element", NULL); + break; + case XML_ATTRIBUTE_NODE: + Tcl_SetResult(interp, "attribute", NULL); + break; + case XML_TEXT_NODE: + case XML_CDATA_SECTION_NODE: + Tcl_SetResult(interp, "textNode", NULL); + break; + case XML_ENTITY_REF_NODE: + Tcl_SetResult(interp, "entityReference", NULL); + break; + case XML_ENTITY_NODE: + Tcl_SetResult(interp, "entity", NULL); + break; + case XML_PI_NODE: + Tcl_SetResult(interp, "processingInstruction", NULL); + break; + case XML_COMMENT_NODE: + Tcl_SetResult(interp, "comment", NULL); + break; + case XML_DOCUMENT_NODE: + Tcl_SetResult(interp, "document", NULL); + break; + case XML_DOCUMENT_TYPE_NODE: + Tcl_SetResult(interp, "docType", NULL); + break; + case XML_DOCUMENT_FRAG_NODE: + Tcl_SetResult(interp, "documentFragment", NULL); + break; + case XML_NOTATION_NODE: + Tcl_SetResult(interp, "notation", NULL); + break; + case XML_HTML_DOCUMENT_NODE: + Tcl_SetResult(interp, "HTMLdocument", NULL); + break; + case XML_DTD_NODE: + Tcl_SetResult(interp, "dtd", NULL); + break; + case XML_ELEMENT_DECL: + Tcl_SetResult(interp, "elementDecl", NULL); + break; + case XML_ATTRIBUTE_DECL: + Tcl_SetResult(interp, "attributeDecl", NULL); + break; + case XML_ENTITY_DECL: + Tcl_SetResult(interp, "entityDecl", NULL); + break; + case XML_NAMESPACE_DECL: + Tcl_SetResult(interp, "namespaceDecl", NULL); + break; + case XML_XINCLUDE_START: + Tcl_SetResult(interp, "xincludeStart", NULL); + break; + case XML_XINCLUDE_END: + Tcl_SetResult(interp, "xincludeEnd", NULL); + break; + default: + Tcl_SetResult(interp, "unknown", NULL); + } + + break; + + case TCLDOM_NODE_LOCALNAME: + case TCLDOM_NODE_NODENAME: + + /* This isn't quite right: nodeName should return the expanded name */ + + if (docPtr) { + Tcl_SetResult(interp, "#document", NULL); + break; + } + /* libxml2 doesn't maintain the correct DOM node name */ + switch (nodePtr->type) { + case XML_ELEMENT_NODE: + case XML_ATTRIBUTE_NODE: + case XML_ENTITY_REF_NODE: + case XML_ENTITY_NODE: + case XML_PI_NODE: + case XML_DOCUMENT_TYPE_NODE: + case XML_NOTATION_NODE: + Tcl_SetObjResult(interp, Tcl_NewStringObj((CONST char *) nodePtr->name, -1)); + break; + case XML_TEXT_NODE: + Tcl_SetResult(interp, "#text", NULL); + break; + case XML_CDATA_SECTION_NODE: + Tcl_SetResult(interp, "#cdata-section", NULL); + break; + case XML_COMMENT_NODE: + Tcl_SetResult(interp, "#comment", NULL); + break; + case XML_DOCUMENT_NODE: + /* Already handled above */ + Tcl_SetResult(interp, "#document", NULL); + break; + case XML_DOCUMENT_FRAG_NODE: + Tcl_SetResult(interp, "#document-fragment", NULL); + break; + case XML_HTML_DOCUMENT_NODE: + /* Not standard DOM */ + Tcl_SetResult(interp, "#HTML-document", NULL); + break; + case XML_DTD_NODE: + /* Not standard DOM */ + Tcl_SetResult(interp, "#dtd", NULL); + break; + case XML_ELEMENT_DECL: + /* Not standard DOM */ + Tcl_SetResult(interp, "#element-declaration", NULL); + break; + case XML_ATTRIBUTE_DECL: + /* Not standard DOM */ + Tcl_SetResult(interp, "#attribute-declaration", NULL); + break; + case XML_ENTITY_DECL: + /* Not standard DOM */ + Tcl_SetResult(interp, "#entity-declaration", NULL); + break; + case XML_NAMESPACE_DECL: + /* Not standard DOM */ + Tcl_SetResult(interp, "#namespace-declaration", NULL); + break; + case XML_XINCLUDE_START: + /* Not standard DOM */ + Tcl_SetResult(interp, "#xinclude-start", NULL); + break; + case XML_XINCLUDE_END: + /* Not standard DOM */ + Tcl_SetResult(interp, "#xinclude-end", NULL); + break; + default: + Tcl_SetResult(interp, "#unknown", NULL); + } + + break; + + case TCLDOM_NODE_NODEVALUE: + + if (docPtr) { + break; + } + + Tcl_MutexLock(&libxml2); + + if (XML_GET_CONTENT(nodePtr) != NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj((CONST char *) XML_GET_CONTENT(nodePtr), -1)); + } + + Tcl_MutexUnlock(&libxml2); + + break; + + case TCLDOM_NODE_OWNERDOCUMENT: + + if (docPtr) { + Tcl_SetObjResult(interp, TclXML_libxml2_CreateObjFromDoc(docPtr)); + break; + } + + Tcl_SetObjResult(interp, TclXML_libxml2_CreateObjFromDoc(nodePtr->doc)); + + break; + + case TCLDOM_NODE_PARENTNODE: + + if (docPtr) { + Tcl_ResetResult(interp); + break; + } + + if (nodePtr->parent) { + if (nodePtr->parent->type == XML_DOCUMENT_NODE || + nodePtr->parent->type == XML_HTML_DOCUMENT_NODE) { + Tcl_SetObjResult(interp, TclXML_libxml2_CreateObjFromDoc(nodePtr->doc)); + } else { + Tcl_SetObjResult(interp, TclDOM_libxml2_CreateObjFromNode(interp, nodePtr->parent)); + } + } else { + Tcl_SetObjResult(interp, TclXML_libxml2_CreateObjFromDoc(nodePtr->doc)); + } + + break; + + case TCLDOM_NODE_CHILDNODES: + + /* Set up live NodeList variable */ + + if (docPtr) { + objPtr = TclXML_libxml2_CreateObjFromDoc(docPtr); + if (TclXML_libxml2_GetTclDocFromObj(interp, objPtr, &tDocPtr) != TCL_OK) { + return TCL_ERROR; + } + } else { + if (TclXML_libxml2_GetTclDocFromNode(interp, nodePtr, &tDocPtr) != TCL_OK) { + return TCL_ERROR; + } + } + domDocPtr = GetDOMDocument(interp, tDocPtr); + if (domDocPtr == NULL) { + Tcl_SetResult(interp, "internal error", NULL); + return TCL_ERROR; + } + sprintf(varname, "::dom::%s::nodelist.%d", tDocPtr->token, domDocPtr->nodeCntr++); + livePtr = Tcl_GetVar2Ex(interp, varname, NULL, TCL_GLOBAL_ONLY); + if (!livePtr) { + Tcl_Obj *nodelistPtr = Tcl_NewListObj(0, NULL); + + Tcl_SetVar2Ex(interp, varname, NULL, nodelistPtr, TCL_GLOBAL_ONLY); + Tcl_IncrRefCount(nodelistPtr); + + if (docPtr) { + if (Tcl_TraceVar(interp, varname, TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS|TCL_GLOBAL_ONLY, (Tcl_VarTraceProc *) TclDOMLiveNodeListDoc, (ClientData) docPtr) != TCL_OK) { + Tcl_DecrRefCount(nodelistPtr); + return TCL_ERROR; + } else { + TclDOMLiveNodeListDoc((ClientData) tDocPtr->docPtr, interp, varname, NULL, TCL_TRACE_READS); + } + } else { + if (Tcl_TraceVar(interp, varname, TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS|TCL_GLOBAL_ONLY, (Tcl_VarTraceProc *) TclDOMLiveNodeListNode, (ClientData) nodePtr) != TCL_OK) { + Tcl_DecrRefCount(nodelistPtr); + return TCL_ERROR; + } else { + TclDOMLiveNodeListNode((ClientData) nodePtr, interp, varname, NULL, TCL_TRACE_READS); + } + } + } + + Tcl_SetObjResult(interp, Tcl_NewStringObj(varname, -1)); + + break; + + case TCLDOM_NODE_FIRSTCHILD: + + /* + * Handle case where no children are present + * Bug #1089114 w/- patch by dwcollins + */ + + if (docPtr) { + childNodePtr = docPtr->children; + } else { + childNodePtr = nodePtr->children; + } + + if (childNodePtr != NULL) { + Tcl_SetObjResult(interp, + TclDOM_libxml2_CreateObjFromNode(interp, childNodePtr)); + } + + break; + + case TCLDOM_NODE_LASTCHILD: + + if (docPtr) { + childNodePtr = docPtr->last; + } else { + Tcl_MutexLock(&libxml2); + childNodePtr = xmlGetLastChild(nodePtr); + Tcl_MutexUnlock(&libxml2); + } + if (childNodePtr != NULL) { + Tcl_SetObjResult(interp, TclDOM_libxml2_CreateObjFromNode(interp, childNodePtr)); + } + + break; + + case TCLDOM_NODE_NEXTSIBLING: + if (!docPtr && nodePtr->next) { + Tcl_SetObjResult(interp, TclDOM_libxml2_CreateObjFromNode(interp, nodePtr->next)); + } + + break; + + case TCLDOM_NODE_PREVIOUSSIBLING: + if (!docPtr && nodePtr->prev) { + Tcl_SetObjResult(interp, TclDOM_libxml2_CreateObjFromNode(interp, nodePtr->prev)); + } + + break; + + case TCLDOM_NODE_ATTRIBUTES: + + if (docPtr) { + Tcl_ResetResult(interp); + return TCL_OK; + } else if (nodePtr->type != XML_ELEMENT_NODE) { + Tcl_SetResult(interp, "wrong object type", NULL); + return TCL_ERROR; + } else { + /* Set up live NamedNodeMap variable */ + + /* If there's already a variable, return it */ + objPtr = TclXML_libxml2_CreateObjFromDoc(nodePtr->doc); + TclXML_libxml2_GetTclDocFromObj(interp, objPtr, &tDocPtr); + domDocPtr = GetDOMDocument(interp, tDocPtr); + if (domDocPtr == NULL) { + Tcl_SetResult(interp, "internal error", NULL); + return TCL_ERROR; + } + sprintf(varname, "::dom::%s::att%d", tDocPtr->token, domDocPtr->nodeCntr++); + livePtr = Tcl_GetVar2Ex(interp, varname, NULL, TCL_GLOBAL_ONLY); + if (!livePtr) { + if (TclDOMSetLiveNamedNodeMap(interp, varname, (ClientData) nodePtr) != TCL_OK) { + Tcl_UnsetVar(interp, varname, TCL_GLOBAL_ONLY); + return TCL_ERROR; + } + + if (Tcl_TraceVar(interp, varname, TCL_TRACE_ARRAY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS|TCL_GLOBAL_ONLY, (Tcl_VarTraceProc *) TclDOMLiveNamedNodeMap, (ClientData) nodePtr) != TCL_OK) { + Tcl_UnsetVar(interp, varname, TCL_GLOBAL_ONLY); + return TCL_ERROR; + } + } + + Tcl_SetObjResult(interp, Tcl_NewStringObj(varname, -1)); + + } + + break; + + case TCLDOM_NODE_NAMESPACEURI: + + if (!docPtr && nodePtr->ns) { + if (nodePtr->ns->href) { + Tcl_SetObjResult(interp, Tcl_NewStringObj((CONST char *) nodePtr->ns->href, -1)); + } + } + + break; + + case TCLDOM_NODE_PREFIX: + + if (!docPtr && nodePtr->ns) { + if (nodePtr->ns->prefix) { + Tcl_SetObjResult(interp, Tcl_NewStringObj((CONST char *) nodePtr->ns->prefix, -1)); + } + } + + break; + + default: + Tcl_SetResult(interp, "unknown option or not yet implemented", NULL); + return TCL_ERROR; + } + + return TCL_OK; +} +int +NodeConfigure(interp, nodePtr, objc, objv) + Tcl_Interp *interp; + xmlNodePtr nodePtr; + int objc; + Tcl_Obj *CONST objv[]; +{ + TclXML_libxml2_Document *tDocPtr; + Tcl_Obj *objPtr; + char *buf; + int option, len; + + while (objc) { + if (objc == 1) { + Tcl_SetResult(interp, "missing value", NULL); + return TCL_ERROR; + } + + if (Tcl_GetIndexFromObj(interp, objv[0], TclDOM_NodeCommandOptions, + "option", 0, &option) != TCL_OK) { + return TCL_ERROR; + } + + switch ((enum TclDOM_NodeCommandOptions) option) { + case TCLDOM_NODE_NODETYPE: + case TCLDOM_NODE_NODENAME: + case TCLDOM_NODE_PARENTNODE: + case TCLDOM_NODE_CHILDNODES: + case TCLDOM_NODE_FIRSTCHILD: + case TCLDOM_NODE_LASTCHILD: + case TCLDOM_NODE_PREVIOUSSIBLING: + case TCLDOM_NODE_NEXTSIBLING: + case TCLDOM_NODE_ATTRIBUTES: + case TCLDOM_NODE_NAMESPACEURI: + case TCLDOM_NODE_PREFIX: + case TCLDOM_NODE_LOCALNAME: + case TCLDOM_NODE_OWNERDOCUMENT: + + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "attribute \"", Tcl_GetStringFromObj(objv[0], NULL), "\" is read-only", NULL); + return TCL_ERROR; + + case TCLDOM_NODE_NODEVALUE: + + if (!nodePtr) { + Tcl_ResetResult(interp); + return TCL_OK; + } + + switch (nodePtr->type) { + case XML_ELEMENT_NODE: + case XML_DOCUMENT_NODE: + case XML_DOCUMENT_FRAG_NODE: + case XML_DOCUMENT_TYPE_NODE: + case XML_ENTITY_NODE: + case XML_ENTITY_REF_NODE: + case XML_NOTATION_NODE: + case XML_HTML_DOCUMENT_NODE: + case XML_DTD_NODE: + case XML_ELEMENT_DECL: + case XML_ATTRIBUTE_DECL: + case XML_ENTITY_DECL: + case XML_NAMESPACE_DECL: + case XML_XINCLUDE_START: + case XML_XINCLUDE_END: + /* + * DOM defines these nodes as not having a node value. + * libxml2 clobbers existing content if the value is set, + * so don't do it! + */ + Tcl_ResetResult(interp); + return TCL_OK; + + default: + /* fall-through */ + break; + } + + if (TclXML_libxml2_GetTclDocFromNode(interp, nodePtr, &tDocPtr) != TCL_OK) { + return TCL_ERROR; + } + + Tcl_MutexLock(&libxml2); + + objPtr = Tcl_NewStringObj((CONST char *) xmlNodeGetContent(nodePtr), -1); + + buf = Tcl_GetStringFromObj(objv[1], &len); + xmlNodeSetContentLen(nodePtr, (const xmlChar *) buf, len); + + Tcl_MutexUnlock(&libxml2); + + TclDOM_PostMutationEvent(interp, + tDocPtr, TclDOM_libxml2_CreateObjFromNode(interp, nodePtr), + TCLDOM_EVENT_DOMCHARACTERDATAMODIFIED, NULL, + Tcl_NewIntObj(1), Tcl_NewIntObj(0), NULL, objPtr, objv[1], NULL, NULL); + + Tcl_DecrRefCount(objPtr); + + break; + + case TCLDOM_NODE_CDATASECTION: + + break; + } + + objc -= 2; + objv += 2; + + } + + return TCL_OK; +} + +int +TclDOM_NodeAppendChild(interp, nodePtr, childPtr) + Tcl_Interp *interp; + xmlNodePtr nodePtr; + xmlNodePtr childPtr; +{ + TclXML_libxml2_Document *tDocPtr; + xmlNodePtr oldParent; + xmlNodePtr oldSibling; + + if (TclXML_libxml2_GetTclDocFromNode(interp, nodePtr, &tDocPtr) != TCL_OK) { + return TCL_ERROR; + } + + oldParent = childPtr->parent; + oldSibling = childPtr->next; + + if (oldParent && oldParent != nodePtr) { + TclDOM_PostMutationEvent(interp, + tDocPtr, + TclDOM_libxml2_CreateObjFromNode(interp, childPtr), + TCLDOM_EVENT_DOMNODEREMOVED, NULL, + Tcl_NewIntObj(1), Tcl_NewIntObj(0), + TclDOM_libxml2_CreateObjFromNode(interp, oldParent), + NULL, NULL, NULL, NULL); + } + + Tcl_MutexLock(&libxml2); + + /* Although xmlAddChild claims to release the child from its previous context, + * that doesn't appear to actually happen. + */ + xmlUnlinkNode(childPtr); + if (xmlAddChild(nodePtr, childPtr) == NULL) { + if (oldSibling) { + xmlAddPrevSibling(oldSibling, childPtr); + } else { + xmlAddChild(oldParent, childPtr); + } + + Tcl_SetResult(interp, "unable to insert node", NULL); + Tcl_MutexUnlock(&libxml2); + return TCL_ERROR; + } + + Tcl_MutexUnlock(&libxml2); + + PostMutationEvents(interp, tDocPtr, nodePtr, childPtr, childPtr, oldParent, childPtr->parent); + + Tcl_SetObjResult(interp, TclDOM_libxml2_CreateObjFromNode(interp, childPtr)); + + return TCL_OK; +} + +int +TclDOM_NodeInsertBefore(interp, refPtr, newPtr) + Tcl_Interp *interp; + xmlNodePtr refPtr; + xmlNodePtr newPtr; +{ + TclXML_libxml2_Document *tDocPtr; + xmlNodePtr oldParent; + + if (TclXML_libxml2_GetTclDocFromNode(interp, refPtr, &tDocPtr) != TCL_OK) { + return TCL_ERROR; + } + + oldParent = newPtr->parent; + if (oldParent != refPtr->parent) { + TclDOM_PostMutationEvent(interp, + tDocPtr, + TclDOM_libxml2_CreateObjFromNode(interp, refPtr), + TCLDOM_EVENT_DOMNODEREMOVED, NULL, + Tcl_NewIntObj(1), Tcl_NewIntObj(0), + TclDOM_libxml2_CreateObjFromNode(interp, newPtr->parent), + NULL, NULL, NULL, NULL); + } + + Tcl_MutexLock(&libxml2); + + if (xmlAddPrevSibling(refPtr, newPtr) == NULL) { + Tcl_SetResult(interp, "unable to insert node", NULL); + Tcl_MutexUnlock(&libxml2); + return TCL_ERROR; + } + + Tcl_MutexUnlock(&libxml2); + + PostMutationEvents(interp, tDocPtr, refPtr, refPtr, newPtr, oldParent, refPtr->parent); + + return TCL_OK; +} + +void PostMutationEvents(interp, tDocPtr, nodePtr, refPtr, newPtr, oldParent, newParent) + Tcl_Interp *interp; + TclXML_libxml2_Document *tDocPtr; + xmlNodePtr nodePtr; + xmlNodePtr refPtr; + xmlNodePtr newPtr; + xmlNodePtr oldParent; + xmlNodePtr newParent; +{ + /* If parent has changed, notify old parent */ + if (oldParent != NULL && oldParent != newParent) { + TclDOM_PostMutationEvent(interp, + tDocPtr, + TclDOM_libxml2_CreateObjFromNode(interp, oldParent), + TCLDOM_EVENT_DOMSUBTREEMODIFIED, NULL, + Tcl_NewIntObj(1), Tcl_NewIntObj(0), + NULL, NULL, NULL, NULL, NULL); + } + /* Notify new parent */ + if (newParent != NULL) { + TclDOM_PostMutationEvent(interp, + tDocPtr, + TclDOM_libxml2_CreateObjFromNode(interp, newParent), + TCLDOM_EVENT_DOMSUBTREEMODIFIED, NULL, + Tcl_NewIntObj(1), Tcl_NewIntObj(0), + NULL, NULL, NULL, NULL, NULL); + } + + /* Inserted event */ + if (newPtr != NULL) { + TclDOM_PostMutationEvent(interp, + tDocPtr, + TclDOM_libxml2_CreateObjFromNode(interp, newPtr), + TCLDOM_EVENT_DOMNODEINSERTED, NULL, + Tcl_NewIntObj(1), Tcl_NewIntObj(0), + NULL, NULL, NULL, NULL, NULL); + } +} + +/* + *---------------------------------------------------------------------------- + * + * TclDOM_AddEventListener -- + * + * Register an event listener. + * + * Results: + * Success code. + * + * Side effects: + * Event listener stored. + * + *---------------------------------------------------------------------------- + */ + +int +TclDOM_AddEventListener(interp, tDocPtr, tokenPtr, type, typeObjPtr, listenerPtr, capturer) + Tcl_Interp *interp; + TclXML_libxml2_Document *tDocPtr; + void *tokenPtr; /* xmlNodePtr or xmlDocPtr */ + enum TclDOM_EventTypes type; + Tcl_Obj *typeObjPtr; + Tcl_Obj *listenerPtr; + int capturer; +{ + TclDOM_libxml2_Document *domDocPtr; + Tcl_HashTable *tablePtr; + Tcl_HashEntry *entryPtr; + int new; + + domDocPtr = GetDOMDocument(interp, tDocPtr); + if (domDocPtr == NULL) { + Tcl_SetResult(interp, "internal error", NULL); + return TCL_ERROR; + } + + if (capturer) { + tablePtr = domDocPtr->captureListeners; + } else { + tablePtr = domDocPtr->bubbleListeners; + } + + entryPtr = Tcl_CreateHashEntry(tablePtr, tokenPtr, &new); + if (new) { + tablePtr = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable)); + Tcl_InitHashTable(tablePtr, TCL_STRING_KEYS); + Tcl_SetHashValue(entryPtr, (char *) tablePtr); + } else { + tablePtr = (Tcl_HashTable *) Tcl_GetHashValue(entryPtr); + } + + if (type == TCLDOM_EVENT_USERDEFINED) { + entryPtr = Tcl_CreateHashEntry(tablePtr, Tcl_GetStringFromObj(typeObjPtr, NULL), &new); + } else { + entryPtr = Tcl_CreateHashEntry(tablePtr, TclDOM_EventTypes[type], &new); + } + if (new) { + Tcl_Obj *listPtr = Tcl_NewListObj(0, NULL); + + Tcl_IncrRefCount(listenerPtr); + Tcl_IncrRefCount(listPtr); + Tcl_ListObjAppendElement(interp, listPtr, listenerPtr); + Tcl_SetHashValue(entryPtr, (char *) listPtr); + + } else { + Tcl_Obj *listPtr = (Tcl_Obj *) Tcl_GetHashValue(entryPtr); + Tcl_Obj *curPtr; + int idx, len, listenerLen, len2, listlen; + char *listenerBuf, *buf2; + + if (Tcl_ListObjLength(interp, listPtr, &len) != TCL_OK) { + Tcl_SetResult(interp, "internal error - bad list", NULL); + return TCL_ERROR; + } + listenerBuf = Tcl_GetStringFromObj(listenerPtr, &listenerLen); + + new = 0; + for (idx = 0; idx < len; idx++) { + Tcl_ListObjIndex(interp, listPtr, idx, &curPtr); + buf2 = Tcl_GetStringFromObj(curPtr, &len2); + + if (listenerLen == len2 && + !strncmp(listenerBuf, buf2, listenerLen)) { + new = 1; + break; + } + } + + if (Tcl_ListObjLength(interp, listPtr, &listlen) != TCL_OK) { + return TCL_ERROR; + } + + Tcl_ListObjReplace(interp, listPtr, idx, new, 1, &listenerPtr); + + } + + /* + * Performance optimization: + * Keep track of which event types have listeners registered. + * If there are no listeners for an event type, then there's + * no point in dispatching that type of event. + * NB. This does not keep track of user-defined events types. + */ + + if (type != TCLDOM_EVENT_USERDEFINED) { + domDocPtr->listening[type]++; + } /* else this is a user-defined event type - it won't be tracked */ + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * TclDOM_GetEventListener -- + * + * Find the listener registered for an event type. + * + * Results: + * Event listener returned. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------------- + */ + +Tcl_Obj * +TclDOM_GetEventListener(interp,tDocPtr, tokenPtr, type, typeObjPtr, capturer) + Tcl_Interp *interp; + TclXML_libxml2_Document *tDocPtr; + void *tokenPtr; + enum TclDOM_EventTypes type; + Tcl_Obj *typeObjPtr; + int capturer; +{ + TclDOM_libxml2_Document *domDocPtr; + Tcl_HashTable *tablePtr; + Tcl_HashEntry *entryPtr; + + domDocPtr = GetDOMDocument(interp, tDocPtr); + if (domDocPtr == NULL) { + Tcl_SetResult(interp, "internal error", NULL); + return NULL; + } + + if (capturer) { + tablePtr = domDocPtr->captureListeners; + } else { + tablePtr = domDocPtr->bubbleListeners; + } + + entryPtr = Tcl_FindHashEntry(tablePtr, tokenPtr); + if (entryPtr) { + tablePtr = (Tcl_HashTable *) Tcl_GetHashValue(entryPtr); + + if (type == TCLDOM_EVENT_USERDEFINED) { + entryPtr = Tcl_FindHashEntry(tablePtr, Tcl_GetStringFromObj(typeObjPtr, NULL)); + } else { + entryPtr = Tcl_FindHashEntry(tablePtr, TclDOM_EventTypes[type]); + } + if (entryPtr) { + return (Tcl_Obj *) Tcl_GetHashValue(entryPtr); + } + } + + return Tcl_NewObj(); +} + +/* + *---------------------------------------------------------------------------- + * + * TclDOM_RemoveEventListener -- + * + * Deregister an event listener. + * + * Results: + * Success code. + * + * Side effects: + * May free Tcl objects. + * + *---------------------------------------------------------------------------- + */ + +int +TclDOM_RemoveEventListener(interp, tDocPtr, tokenPtr, type, typeObjPtr, listenerPtr, capturer) + Tcl_Interp *interp; + TclXML_libxml2_Document *tDocPtr; + void *tokenPtr; + enum TclDOM_EventTypes type; + Tcl_Obj *typeObjPtr; + Tcl_Obj *listenerPtr; + int capturer; +{ + TclDOM_libxml2_Document *domDocPtr; + Tcl_HashTable *tablePtr; + Tcl_HashEntry *entryPtr; + + domDocPtr = GetDOMDocument(interp, tDocPtr); + if (domDocPtr == NULL) { + Tcl_SetResult(interp, "internal error", NULL); + return TCL_ERROR; + } + + if (capturer) { + tablePtr = domDocPtr->captureListeners; + } else { + tablePtr = domDocPtr->bubbleListeners; + } + + entryPtr = Tcl_FindHashEntry(tablePtr, tokenPtr); + if (entryPtr) { + tablePtr = (Tcl_HashTable *) Tcl_GetHashValue(entryPtr); + + if (type == TCLDOM_EVENT_USERDEFINED) { + entryPtr = Tcl_FindHashEntry(tablePtr, Tcl_GetStringFromObj(typeObjPtr, NULL)); + } else { + entryPtr = Tcl_FindHashEntry(tablePtr, TclDOM_EventTypes[type]); + } + if (entryPtr) { + Tcl_Obj *listPtr = (Tcl_Obj *) Tcl_GetHashValue(entryPtr); + Tcl_Obj *curPtr; + int idx, listenerLen, len, len2, found; + char *listenerBuf, *buf2; + + if (Tcl_ListObjLength(interp, listPtr, &len) != TCL_OK) { + Tcl_SetResult(interp, "internal error - bad list", NULL); + return TCL_ERROR; + } + listenerBuf = Tcl_GetStringFromObj(listenerPtr, &listenerLen); + found = 0; + for (idx = 0; idx < len; idx++) { + Tcl_ListObjIndex(interp, listPtr, idx, &curPtr); + buf2 = Tcl_GetStringFromObj(curPtr, &len2); + if (listenerLen == len2 && + !strncmp(listenerBuf, buf2, listenerLen)) { + found = 1; + break; + } + } + + if (!found) { + Tcl_SetResult(interp, "listener not found", NULL); + return TCL_ERROR; + } else { + Tcl_ListObjReplace(interp, listPtr, idx, 1, 0, NULL); + + /* + * Keep track of which event types have listeners registered. + */ + + if (type != TCLDOM_EVENT_USERDEFINED) { + domDocPtr->listening[type]--; + } /* else user-defined event type - not being tracked */ + } + } else { + Tcl_SetResult(interp, "no listeners registered", NULL); + return TCL_ERROR; + } + } else { + Tcl_SetResult(interp, "no listeners registered", NULL); + return TCL_ERROR; + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * HasListener -- + * + * Check whether an event listener is registered for an event type. + * + * Results: + * Returns boolean. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------------- + */ + +int +HasListener(interp, tDocPtr, eventType) + Tcl_Interp *interp; + TclXML_libxml2_Document *tDocPtr; + enum TclDOM_EventTypes eventType; +{ + TclDOM_libxml2_Document *domDocPtr = GetDOMDocument(interp, tDocPtr); + + if (domDocPtr == NULL) { + return 0; + } + + if (eventType == TCLDOM_EVENT_USERDEFINED) { + /* + * We don't know whether there is a listener or not, + * so play it safe. + */ + return 1; + } + + if (domDocPtr->listening[eventType] > 0) { + return 1; + } + + return 0; +} + +/* + *---------------------------------------------------------------------------- + * + * TclDOM_DispatchEvent -- + * + * Dispatch an event object. + * + * Results: + * Event propagates through the DOM tree. + * + * Side effects: + * Depends on event listeners. + * + *---------------------------------------------------------------------------- + */ + +int +TclDOM_DispatchEvent(interp, nodeObjPtr, eventObjPtr, eventPtr) + Tcl_Interp *interp; + Tcl_Obj *nodeObjPtr; + Tcl_Obj *eventObjPtr; + TclDOM_libxml2_Event *eventPtr; +{ + xmlNodePtr nodePtr; + xmlDocPtr docPtr; + TclXML_libxml2_Document *tDocPtr; + TclDOM_libxml2_Document *domDocPtr; + char *phase; + Tcl_Obj *docObjPtr, *pathPtr = NULL; + int idx, len, cancelable; + void *tokenPtr; + + if (TclDOM_libxml2_GetNodeFromObj(interp, nodeObjPtr, &nodePtr) != TCL_OK) { + if (TclXML_libxml2_GetTclDocFromObj(interp, nodeObjPtr, &tDocPtr) != TCL_OK) { + Tcl_SetResult(interp, "unrecognised token", NULL); + return TCL_ERROR; + } else { + docObjPtr = nodeObjPtr; + docPtr = tDocPtr->docPtr; + nodeObjPtr = NULL; + nodePtr = NULL; + tokenPtr = (void *) docPtr; + } + } else { + docPtr = nodePtr->doc; + docObjPtr = TclXML_libxml2_CreateObjFromDoc(docPtr); + if (TclXML_libxml2_GetTclDocFromObj(interp, docObjPtr, &tDocPtr) != TCL_OK) { + Tcl_SetResult(interp, "unknown document", NULL); + return TCL_ERROR; + } + tokenPtr = (void *) nodePtr; + } + Tcl_ResetResult(interp); + + /* + * Performance optimization: + * If there are no listeners registered for this event type, + * then there is no point in propagating the event. + */ + if (!HasListener(interp, tDocPtr, eventPtr->type)) { + return TCL_OK; + } + + domDocPtr = GetDOMDocument(interp, tDocPtr); + if (domDocPtr == NULL) { + Tcl_SetResult(interp, "internal error", NULL); + return TCL_ERROR; + } + + phase = Tcl_GetStringFromObj(eventPtr->eventPhase, &len); + + if (!len) { + /* + * This is the initial dispatch of the event. + * First trigger any capturing event listeners + * Starting from the root, proceed downward + */ + + Tcl_SetStringObj(eventPtr->eventPhase, "capturing_phase", -1); + eventPtr->target = nodeObjPtr; + Tcl_IncrRefCount(nodeObjPtr); + + if (nodePtr) { + pathPtr = GetPath(interp, nodePtr); + } else { + pathPtr = Tcl_NewObj(); + } + if (eventPtr->currentNode) { + Tcl_DecrRefCount(eventPtr->currentNode); + } + eventPtr->currentNode = docObjPtr; + Tcl_IncrRefCount(docObjPtr); + if (TriggerEventListeners(interp, domDocPtr->captureListeners, (void *) docPtr, eventObjPtr, eventPtr) != TCL_OK) { + Tcl_DecrRefCount(pathPtr); + return TCL_ERROR; + } + + if (Tcl_GetBooleanFromObj(interp, eventPtr->cancelable, &cancelable) != TCL_OK) { + Tcl_DecrRefCount(pathPtr); + return TCL_ERROR; + } + if (cancelable && eventPtr->stopPropagation) { + goto stop_propagation; + } + + Tcl_ListObjLength(interp, pathPtr, &len); + Tcl_ListObjReplace(interp, pathPtr, len - 1, 1, 0, NULL); + Tcl_ListObjReplace(interp, pathPtr, 0, 1, 0, NULL); + Tcl_ListObjLength(interp, pathPtr, &len); + for (idx = 0; idx < len; idx++) { + Tcl_Obj *ancestorObjPtr; + xmlNodePtr ancestorPtr; + + Tcl_ListObjIndex(interp, pathPtr, idx, &ancestorObjPtr); + if (eventPtr->currentNode) { + Tcl_DecrRefCount(eventPtr->currentNode); + } + eventPtr->currentNode = ancestorObjPtr; + Tcl_IncrRefCount(ancestorObjPtr); + if (TclDOM_libxml2_GetNodeFromObj(interp, ancestorObjPtr, &ancestorPtr) != TCL_OK) { + Tcl_SetResult(interp, "cannot find ancestor node \"", NULL); + Tcl_AppendResult(interp, Tcl_GetStringFromObj(ancestorObjPtr, NULL), "\"", NULL); + return TCL_ERROR; + } + + if (TriggerEventListeners(interp, domDocPtr->captureListeners, (void *) ancestorPtr, eventObjPtr, eventPtr) != TCL_OK) { + return TCL_ERROR; + } + + /* + * A listener may stop propagation, + * but we check here to let all of the + * listeners at that level complete. + */ + + if (Tcl_GetBooleanFromObj(interp, eventPtr->cancelable, &cancelable) != TCL_OK) { + Tcl_DecrRefCount(ancestorObjPtr); + return TCL_ERROR; + } + if (cancelable && eventPtr->stopPropagation) { + Tcl_DecrRefCount(ancestorObjPtr); + goto stop_propagation; + } + + Tcl_DecrRefCount(ancestorObjPtr); + + } + + /* Prepare for the next phase */ + + if (Tcl_IsShared(eventPtr->eventPhase)) { + Tcl_DecrRefCount(eventPtr->eventPhase); + eventPtr->eventPhase = Tcl_NewStringObj("at_target", -1); + Tcl_IncrRefCount(eventPtr->eventPhase); + } else { + Tcl_SetStringObj(eventPtr->eventPhase, "at_target", -1); + } + } + + if (eventPtr->currentNode) { + Tcl_DecrRefCount(eventPtr->currentNode); + } + if (nodePtr) { + eventPtr->currentNode = nodeObjPtr; + tokenPtr = (void *) nodePtr; + } else { + eventPtr->currentNode = docObjPtr; + tokenPtr = (void *) docPtr; + } + Tcl_IncrRefCount(eventPtr->currentNode); + + if (TriggerEventListeners(interp, domDocPtr->bubbleListeners, tokenPtr, eventObjPtr, eventPtr) != TCL_OK) { + return TCL_ERROR; + } + + if (Tcl_IsShared(eventPtr->eventPhase)) { + Tcl_DecrRefCount(eventPtr->eventPhase); + eventPtr->eventPhase = Tcl_NewStringObj("bubbling_phase", -1); + Tcl_IncrRefCount(eventPtr->eventPhase); + } else { + Tcl_SetStringObj(eventPtr->eventPhase, "bubbling_phase", -1); + } + + if (Tcl_GetBooleanFromObj(interp, eventPtr->cancelable, &cancelable) != TCL_OK) { + return TCL_ERROR; + } + if (cancelable && eventPtr->stopPropagation) { + /* Do no more */ + } else if (nodePtr && nodePtr->parent && nodePtr->parent != (xmlNodePtr) nodePtr->doc) { + Tcl_Obj *objPtr; + + objPtr = TclDOM_libxml2_CreateObjFromNode(interp, nodePtr->parent); + if (objPtr == NULL) { + return TCL_ERROR; + } + return TclDOM_DispatchEvent(interp, + objPtr, + eventObjPtr, eventPtr); + } else if (nodePtr && nodePtr->parent) { + Tcl_Obj *objPtr; + + objPtr = TclXML_libxml2_CreateObjFromDoc(nodePtr->doc); + if (objPtr == NULL) { + return TCL_ERROR; + } + return TclDOM_DispatchEvent(interp, + objPtr, + eventObjPtr, eventPtr); + } + +stop_propagation: + eventPtr->dispatched = 1; + + if (pathPtr) { + Tcl_DecrRefCount(pathPtr); + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * TclDOMElementCommand -- + * + * Implements dom::libxml2::element command. + * + * Results: + * Depends on method. + * + * Side effects: + * Depends on method. + * + *---------------------------------------------------------------------------- + */ + +int +TclDOMElementCommand (clientData, interp, objc, objv) + ClientData clientData; + Tcl_Interp *interp; + int objc; + Tcl_Obj *CONST objv[]; +{ + int method, optobjc; + Tcl_Obj *CONST *optobjv; + xmlNodePtr nodePtr; + TclXML_libxml2_Document *tDocPtr; + char *value; + xmlAttrPtr attrPtr; + xmlNsPtr nsPtr; + + if (clientData == NULL) { + if (objc < 3) { + Tcl_WrongNumArgs(interp, 1, objv, "method ?args...?"); + return TCL_ERROR; + } + + if (TclDOM_libxml2_GetNodeFromObj(interp, objv[2], &nodePtr) != TCL_OK) { + return TCL_ERROR; + } + + optobjv = objv + 3; + optobjc = objc - 3; + + } else { + + nodePtr = (xmlNodePtr) clientData; + + optobjv = objv + 2; + optobjc = objc - 2; + } + + if (Tcl_GetIndexFromObj(interp, objv[1], TclDOM_ElementCommandMethods, + "method", 0, &method) != TCL_OK) { + return TCL_ERROR; + } + + /* Should check that the node is of element type */ + + Tcl_ResetResult(interp); + + switch ((enum TclDOM_ElementCommandMethods) method) { + + case TCLDOM_ELEMENT_CGET: + if (optobjc != 1) { + Tcl_WrongNumArgs(interp, 1, objv, "option"); + return TCL_ERROR; + } + + return ElementCget(interp, nodePtr, optobjv[0]); + + break; + + case TCLDOM_ELEMENT_CONFIGURE: + + if (optobjc == 1) { + return ElementCget(interp, nodePtr, optobjv[0]); + } else { + Tcl_AppendResult(interp, "option \"", Tcl_GetStringFromObj(optobjv[0], NULL), "\" cannot be modified", NULL); + return TCL_ERROR; + } + + break; + + case TCLDOM_ELEMENT_GETATTRIBUTE: + if (optobjc != 1) { + Tcl_WrongNumArgs(interp, 1, objv, "attr"); + return TCL_ERROR; + } + + Tcl_MutexLock(&libxml2); + value = (char *) xmlGetProp(nodePtr, (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL)); + Tcl_MutexUnlock(&libxml2); + + if (value) { + Tcl_SetObjResult(interp, Tcl_NewStringObj(value, -1)); + } + + break; + + case TCLDOM_ELEMENT_GETATTRIBUTENS: + if (optobjc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "ns attr"); + return TCL_ERROR; + } + + Tcl_MutexLock(&libxml2); + value = (char *) xmlGetNsProp(nodePtr, + (const xmlChar *) Tcl_GetStringFromObj(optobjv[1], NULL), + (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL)); + Tcl_MutexUnlock(&libxml2); + + if (value) { + Tcl_SetObjResult(interp, Tcl_NewStringObj(value, -1)); + } + + break; + + case TCLDOM_ELEMENT_SETATTRIBUTE: + if (optobjc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "attr value"); + return TCL_ERROR; + } + + if (TclXML_libxml2_GetTclDocFromNode(interp, nodePtr, &tDocPtr) != TCL_OK) { + return TCL_ERROR; + } + + Tcl_MutexLock(&libxml2); + value = (char *) xmlGetProp(nodePtr, (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL)); + attrPtr = xmlSetProp(nodePtr, + (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL), + (const xmlChar *) Tcl_GetStringFromObj(optobjv[1], NULL)); + Tcl_MutexUnlock(&libxml2); + + if (!attrPtr) { + Tcl_SetResult(interp, "unable to set attribute", NULL); + return TCL_ERROR; + } + + TclDOM_PostMutationEvent(interp, tDocPtr, objv[2], TCLDOM_EVENT_DOMATTRMODIFIED, NULL, Tcl_NewIntObj(1), Tcl_NewIntObj(0), NULL, Tcl_NewStringObj(value, -1), optobjv[1], optobjv[0], value == NULL? Tcl_NewStringObj("modification", -1) : Tcl_NewStringObj("addition", -1)); + + Tcl_SetObjResult(interp, optobjv[1]); + + break; + + case TCLDOM_ELEMENT_SETATTRIBUTENS: + if (optobjc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "ns attr value"); + return TCL_ERROR; + } + + if (TclXML_libxml2_GetTclDocFromNode(interp, nodePtr, &tDocPtr) != TCL_OK) { + return TCL_ERROR; + } + + Tcl_MutexLock(&libxml2); + + nsPtr = xmlSearchNsByHref(nodePtr->doc, nodePtr, (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL)); + if (!nsPtr) { + Tcl_SetResult(interp, "no XML Namespace declaration for namespace", NULL); + Tcl_MutexUnlock(&libxml2); + return TCL_ERROR; + } + + value = (char *) xmlGetNsProp(nodePtr, + (const xmlChar *) Tcl_GetStringFromObj(optobjv[1], NULL), + (const xmlChar *) Tcl_GetStringFromObj(optobjv[2], NULL)); + attrPtr = xmlSetNsProp(nodePtr, + nsPtr, + (const xmlChar *) Tcl_GetStringFromObj(optobjv[1], NULL), + (const xmlChar *) Tcl_GetStringFromObj(optobjv[3], NULL)); + + Tcl_MutexUnlock(&libxml2); + + if (!attrPtr) { + Tcl_SetResult(interp, "unable to set attribute", NULL); + return TCL_ERROR; + } + + TclDOM_PostMutationEvent(interp, tDocPtr, objv[2], TCLDOM_EVENT_DOMATTRMODIFIED, NULL, Tcl_NewIntObj(1), Tcl_NewIntObj(0), NULL, Tcl_NewStringObj(value, -1), optobjv[3], optobjv[2], value == NULL? Tcl_NewStringObj("modification", -1) : Tcl_NewStringObj("addition", -1)); + + break; + + case TCLDOM_ELEMENT_REMOVEATTRIBUTE: + + if (optobjc != 1) { + Tcl_WrongNumArgs(interp, 1, objv, "attr"); + return TCL_ERROR; + } + + if (TclXML_libxml2_GetTclDocFromNode(interp, nodePtr, &tDocPtr) != TCL_OK) { + return TCL_ERROR; + } + + /* It doesn't matter if this fails due to a non-existant attribute */ + Tcl_MutexLock(&libxml2); + xmlUnsetProp(nodePtr, (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL)); + Tcl_MutexUnlock(&libxml2); + + TclDOM_PostMutationEvent(interp, tDocPtr, objv[2], TCLDOM_EVENT_DOMATTRMODIFIED, NULL, Tcl_NewIntObj(1), Tcl_NewIntObj(0), NULL, NULL, NULL, optobjv[2], Tcl_NewStringObj("removed", -1)); + + break; + + default: + Tcl_SetResult(interp, "method \"", NULL); + Tcl_AppendResult(interp, Tcl_GetStringFromObj(objv[1], NULL), "\" not yet implemented", NULL); + return TCL_ERROR; + } + + return TCL_OK; +} + +int +ElementCget(interp, nodePtr, optObj) + Tcl_Interp *interp; + xmlNodePtr nodePtr; + Tcl_Obj *CONST optObj; +{ + int option; + + if (Tcl_GetIndexFromObj(interp, optObj, TclDOM_ElementCommandOptions, + "option", 0, &option) != TCL_OK) { + return TCL_ERROR; + } + + switch ((enum TclDOM_ElementCommandOptions) option) { + case TCLDOM_ELEMENT_TAGNAME: + Tcl_SetObjResult(interp, Tcl_NewStringObj((CONST char *) nodePtr->name, -1)); + break; + + case TCLDOM_ELEMENT_EMPTY: + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0)); + break; + + default: + Tcl_SetResult(interp, "unknown option", NULL); + return TCL_ERROR; + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * TclDOM_InitEvent -- + * + * Initializes an event object. + * + * Results: + * Tcl_Obj references stored. + * + * Side effects: + * Tcl_Obj's reference count changed. + * + *---------------------------------------------------------------------------- + */ + +void +TclDOM_InitEvent(eventPtr, type, typeObjPtr, bubblesPtr, cancelablePtr) + TclDOM_libxml2_Event *eventPtr; + enum TclDOM_EventTypes type; + Tcl_Obj *typeObjPtr; + Tcl_Obj *bubblesPtr; + Tcl_Obj *cancelablePtr; +{ + if (type != TCLDOM_EVENT_USERDEFINED) { + if (eventPtr->type != type) { + if (eventPtr->typeObjPtr) { + Tcl_DecrRefCount(eventPtr->typeObjPtr); + eventPtr->typeObjPtr = NULL; + } + eventPtr->type = type; + } + } else { + char *oldType, *newType; + int oldLen, newLen; + + oldType = Tcl_GetStringFromObj(eventPtr->typeObjPtr, &oldLen); + newType = Tcl_GetStringFromObj(typeObjPtr, &newLen); + if (oldLen != newLen || + strncmp(oldType, newType, oldLen)) { + Tcl_DecrRefCount(eventPtr->typeObjPtr); + eventPtr->typeObjPtr = typeObjPtr; + Tcl_IncrRefCount(typeObjPtr); + eventPtr->type = TCLDOM_EVENT_USERDEFINED; + } + } + + if (bubblesPtr && eventPtr->bubbles != bubblesPtr) { + Tcl_DecrRefCount(eventPtr->bubbles); + eventPtr->bubbles = bubblesPtr; + Tcl_IncrRefCount(eventPtr->bubbles); + } + if (cancelablePtr && eventPtr->cancelable != cancelablePtr) { + Tcl_DecrRefCount(eventPtr->cancelable); + eventPtr->cancelable = cancelablePtr; + Tcl_IncrRefCount(eventPtr->cancelable); + } +} + +/* + *---------------------------------------------------------------------------- + * + * TclDOM_InitUIEvent -- + * + * Initializes an event object. + * + * Results: + * Tcl_Obj references stored. + * + * Side effects: + * Tcl_Obj's reference count changed. + * + *---------------------------------------------------------------------------- + */ + +void +TclDOM_InitUIEvent(eventPtr, type, typeObjPtr, bubblesPtr, cancelablePtr, viewPtr, detailPtr) + TclDOM_libxml2_Event *eventPtr; + enum TclDOM_EventTypes type; + Tcl_Obj *typeObjPtr; + Tcl_Obj *bubblesPtr; + Tcl_Obj *cancelablePtr; + Tcl_Obj *viewPtr; + Tcl_Obj *detailPtr; +{ + TclDOM_InitEvent(eventPtr, type, typeObjPtr, bubblesPtr, cancelablePtr); + + if (viewPtr && eventPtr->view != viewPtr) { + Tcl_DecrRefCount(eventPtr->view); + eventPtr->view = viewPtr; + Tcl_IncrRefCount(eventPtr->view); + } + if (detailPtr && eventPtr->detail != detailPtr) { + Tcl_DecrRefCount(eventPtr->detail); + eventPtr->detail = detailPtr; + Tcl_IncrRefCount(eventPtr->detail); + } else if (detailPtr == NULL) { + Tcl_DecrRefCount(eventPtr->detail); + eventPtr->detail = Tcl_NewObj(); + } +} + +/* + *---------------------------------------------------------------------------- + * + * TclDOM_InitMouseEvent -- + * + * Initializes an event object. + * + * Results: + * Tcl_Obj references stored. + * + * Side effects: + * Tcl_Obj's reference count changed. + * + *---------------------------------------------------------------------------- + */ + +void +TclDOM_InitMouseEvent(eventPtr, type, typeObjPtr, bubblesPtr, cancelablePtr, viewPtr, detailPtr, screenXPtr, screenYPtr, clientXPtr, clientYPtr, ctrlKeyPtr, altKeyPtr, shiftKeyPtr, metaKeyPtr, buttonPtr, relatedNodePtr) + TclDOM_libxml2_Event *eventPtr; + enum TclDOM_EventTypes type; + Tcl_Obj *typeObjPtr; + Tcl_Obj *bubblesPtr; + Tcl_Obj *cancelablePtr; + Tcl_Obj *viewPtr; + Tcl_Obj *detailPtr; + Tcl_Obj *screenXPtr; + Tcl_Obj *screenYPtr; + Tcl_Obj *clientXPtr; + Tcl_Obj *clientYPtr; + Tcl_Obj *ctrlKeyPtr; + Tcl_Obj *altKeyPtr; + Tcl_Obj *shiftKeyPtr; + Tcl_Obj *metaKeyPtr; + Tcl_Obj *buttonPtr; + Tcl_Obj *relatedNodePtr; +{ + TclDOM_InitUIEvent(eventPtr, type, typeObjPtr, bubblesPtr, cancelablePtr, viewPtr, detailPtr); + + if (screenXPtr && eventPtr->screenX != screenXPtr) { + Tcl_DecrRefCount(eventPtr->screenX); + eventPtr->screenX = screenXPtr; + Tcl_IncrRefCount(eventPtr->screenX); + } + if (screenYPtr && eventPtr->screenY != screenYPtr) { + Tcl_DecrRefCount(eventPtr->screenY); + eventPtr->screenY = screenYPtr; + Tcl_IncrRefCount(eventPtr->screenY); + } + + if (clientXPtr && eventPtr->clientX != clientXPtr) { + Tcl_DecrRefCount(eventPtr->clientX); + eventPtr->clientX = clientXPtr; + Tcl_IncrRefCount(eventPtr->clientX); + } + if (clientYPtr && eventPtr->clientY != clientYPtr) { + Tcl_DecrRefCount(eventPtr->clientY); + eventPtr->clientY = clientYPtr; + Tcl_IncrRefCount(eventPtr->clientY); + } + + if (ctrlKeyPtr && eventPtr->ctrlKey != ctrlKeyPtr) { + Tcl_DecrRefCount(eventPtr->ctrlKey); + eventPtr->ctrlKey = ctrlKeyPtr; + Tcl_IncrRefCount(eventPtr->ctrlKey); + } + if (altKeyPtr && eventPtr->altKey != altKeyPtr) { + Tcl_DecrRefCount(eventPtr->altKey); + eventPtr->altKey = altKeyPtr; + Tcl_IncrRefCount(eventPtr->altKey); + } + if (shiftKeyPtr && eventPtr->shiftKey != shiftKeyPtr) { + Tcl_DecrRefCount(eventPtr->shiftKey); + eventPtr->shiftKey = shiftKeyPtr; + Tcl_IncrRefCount(eventPtr->shiftKey); + } + if (metaKeyPtr && eventPtr->metaKey != metaKeyPtr) { + Tcl_DecrRefCount(eventPtr->metaKey); + eventPtr->metaKey = metaKeyPtr; + Tcl_IncrRefCount(eventPtr->metaKey); + } + if (buttonPtr && eventPtr->button != buttonPtr) { + Tcl_DecrRefCount(eventPtr->button); + eventPtr->button = buttonPtr; + Tcl_IncrRefCount(eventPtr->button); + } + + if (relatedNodePtr && eventPtr->relatedNode != relatedNodePtr) { + Tcl_DecrRefCount(eventPtr->relatedNode); + eventPtr->relatedNode = relatedNodePtr; + Tcl_IncrRefCount(eventPtr->relatedNode); + } +} + +/* + *---------------------------------------------------------------------------- + * + * TclDOM_InitMutationEvent -- + * + * Initializes an event object. + * + * Results: + * Tcl_Obj references stored. + * + * Side effects: + * Tcl_Obj's reference count changed. + * + *---------------------------------------------------------------------------- + */ + +void +TclDOM_InitMutationEvent(eventPtr, type, typeObjPtr, bubblesPtr, cancelablePtr, relatedNodePtr, prevValuePtr, newValuePtr, attrNamePtr, attrChangePtr) + TclDOM_libxml2_Event *eventPtr; + enum TclDOM_EventTypes type; + Tcl_Obj *typeObjPtr; + Tcl_Obj *bubblesPtr; + Tcl_Obj *cancelablePtr; + Tcl_Obj *relatedNodePtr; + Tcl_Obj *prevValuePtr; + Tcl_Obj *newValuePtr; + Tcl_Obj *attrNamePtr; + Tcl_Obj *attrChangePtr; +{ + TclDOM_InitEvent(eventPtr, type, typeObjPtr, bubblesPtr, cancelablePtr); + + if (relatedNodePtr && eventPtr->relatedNode != relatedNodePtr) { + Tcl_DecrRefCount(eventPtr->relatedNode); + eventPtr->relatedNode = relatedNodePtr; + Tcl_IncrRefCount(eventPtr->relatedNode); + } + + if (prevValuePtr && eventPtr->prevValue != prevValuePtr) { + Tcl_DecrRefCount(eventPtr->prevValue); + eventPtr->prevValue = prevValuePtr; + Tcl_IncrRefCount(eventPtr->prevValue); + } + if (newValuePtr && eventPtr->newValue != newValuePtr) { + Tcl_DecrRefCount(eventPtr->newValue); + eventPtr->newValue = newValuePtr; + Tcl_IncrRefCount(eventPtr->newValue); + } + if (attrNamePtr && eventPtr->attrName != attrNamePtr) { + Tcl_DecrRefCount(eventPtr->attrName); + eventPtr->attrName = attrNamePtr; + Tcl_IncrRefCount(eventPtr->attrName); + } + if (attrChangePtr && eventPtr->attrChange != attrChangePtr) { + Tcl_DecrRefCount(eventPtr->attrChange); + eventPtr->attrChange = attrChangePtr; + Tcl_IncrRefCount(eventPtr->attrChange); + } +} + +/* + *---------------------------------------------------------------------------- + * + * TclDOM_PostUIEvent -- + * + * Post an event and cleanup afterward. + * + * Results: + * Event created and propagated. + * + * Side effects: + * Depends on event listeners. + * + *---------------------------------------------------------------------------- + */ + +int +TclDOM_PostUIEvent(interp, tDocPtr, nodeObjPtr, type, typeObjPtr, bubblesPtr, cancelablePtr, viewPtr, detailPtr) + Tcl_Interp *interp; + TclXML_libxml2_Document *tDocPtr; + Tcl_Obj *nodeObjPtr; + enum TclDOM_EventTypes type; + Tcl_Obj *typeObjPtr; + Tcl_Obj *bubblesPtr; + Tcl_Obj *cancelablePtr; + Tcl_Obj *viewPtr; + Tcl_Obj *detailPtr; +{ + Tcl_Obj *eventObj; + TclDOM_libxml2_Event *eventPtr = NULL; + int result; + + /* + * Performance optimisation: if there are no event listeners for this + * event type then don't bother creating an event. + */ + if (!HasListener(interp, tDocPtr, type)) { + return TCL_OK; + } + + eventObj = TclDOM_libxml2_NewEventObj(interp, tDocPtr->docPtr, type, typeObjPtr); + if (eventObj == NULL) { + Tcl_SetResult(interp, "unable to create event", NULL); + return TCL_ERROR; + } + + TclDOM_libxml2_GetEventFromObj(interp, eventObj, &eventPtr); + + TclDOM_InitUIEvent(eventPtr, type, typeObjPtr, bubblesPtr, cancelablePtr, viewPtr, detailPtr); + + Tcl_ResetResult(interp); + result = TclDOM_DispatchEvent(interp, nodeObjPtr, eventObj, eventPtr); + + TclDOM_libxml2_DestroyNode(interp, eventPtr->tNodePtr); + + return result; +} + +/* + *---------------------------------------------------------------------------- + * + * TclDOM_PostMouseEvent -- + * + * Post an event and cleanup afterward. + * + * Results: + * Event created and propagated. + * + * Side effects: + * Depends on event listeners. + * + *---------------------------------------------------------------------------- + */ + +int +TclDOM_PostMouseEvent(interp, tDocPtr, nodeObjPtr, type, typeObjPtr, bubblesPtr, cancelablePtr, relatedNodePtr, viewPtr, detailPtr, screenXPtr, screenYPtr, clientXPtr, clientYPtr, ctrlKeyPtr, altKeyPtr, shiftKeyPtr, metaKeyPtr, buttonPtr) + Tcl_Interp *interp; + TclXML_libxml2_Document *tDocPtr; + Tcl_Obj *nodeObjPtr; + enum TclDOM_EventTypes type; + Tcl_Obj *typeObjPtr; + Tcl_Obj *bubblesPtr; + Tcl_Obj *cancelablePtr; + Tcl_Obj *relatedNodePtr; + Tcl_Obj *viewPtr; + Tcl_Obj *detailPtr; + Tcl_Obj *screenXPtr; + Tcl_Obj *screenYPtr; + Tcl_Obj *clientXPtr; + Tcl_Obj *clientYPtr; + Tcl_Obj *ctrlKeyPtr; + Tcl_Obj *altKeyPtr; + Tcl_Obj *shiftKeyPtr; + Tcl_Obj *metaKeyPtr; + Tcl_Obj *buttonPtr; +{ + Tcl_Obj *eventObj; + TclDOM_libxml2_Event *eventPtr = NULL; + int result; + + /* + * Performance optimisation: if there are no event listeners for this + * event type then don't bother creating an event. + */ + if (!HasListener(interp, tDocPtr, type)) { + return TCL_OK; + } + + eventObj = TclDOM_libxml2_NewEventObj(interp, tDocPtr->docPtr, type, typeObjPtr); + if (eventObj == NULL) { + Tcl_SetResult(interp, "unable to create event", NULL); + return TCL_ERROR; + } + + TclDOM_libxml2_GetEventFromObj(interp, eventObj, &eventPtr); + + TclDOM_InitMouseEvent(eventPtr, type, typeObjPtr, bubblesPtr, cancelablePtr, + viewPtr, detailPtr, + screenXPtr, screenYPtr, clientXPtr, clientYPtr, + ctrlKeyPtr, altKeyPtr, shiftKeyPtr, metaKeyPtr, + buttonPtr, relatedNodePtr); + + Tcl_ResetResult(interp); + result = TclDOM_DispatchEvent(interp, nodeObjPtr, eventObj, eventPtr); + + TclDOM_libxml2_DestroyNode(interp, eventPtr->tNodePtr); + + return result; +} + +/* + *---------------------------------------------------------------------------- + * + * TclDOM_PostMutationEvent -- + * + * Post an event and cleanup afterward. + * + * Results: + * Event created and propagated. + * + * Side effects: + * Depends on event listeners. + * + *---------------------------------------------------------------------------- + */ + +int +TclDOM_PostMutationEvent(interp, tDocPtr, nodeObjPtr, type, typeObjPtr, bubblesPtr, cancelablePtr, relatedNodePtr, prevValuePtr, newValuePtr, attrNamePtr, attrChangePtr) + Tcl_Interp *interp; + TclXML_libxml2_Document *tDocPtr; + Tcl_Obj *nodeObjPtr; + enum TclDOM_EventTypes type; + Tcl_Obj *typeObjPtr; + Tcl_Obj *bubblesPtr; + Tcl_Obj *cancelablePtr; + Tcl_Obj *relatedNodePtr; + Tcl_Obj *prevValuePtr; + Tcl_Obj *newValuePtr; + Tcl_Obj *attrNamePtr; + Tcl_Obj *attrChangePtr; +{ + Tcl_Obj *eventObj; + TclDOM_libxml2_Event *eventPtr = NULL; + int result; + + /* + * Performance optimisation: if there are no event listeners for this + * event type then don't bother creating an event. + */ + if (!HasListener(interp, tDocPtr, type)) { + return TCL_OK; + } + + eventObj = TclDOM_libxml2_NewEventObj(interp, tDocPtr->docPtr, type, typeObjPtr); + if (eventObj == NULL) { + Tcl_SetResult(interp, "unable to create event", NULL); + return TCL_ERROR; + } + + TclDOM_libxml2_GetEventFromObj(interp, eventObj, &eventPtr); + + TclDOM_InitMutationEvent(eventPtr, type, typeObjPtr, bubblesPtr, cancelablePtr, relatedNodePtr, prevValuePtr, newValuePtr, attrNamePtr, attrChangePtr); + + Tcl_ResetResult(interp); + result = TclDOM_DispatchEvent(interp, nodeObjPtr, eventObj, eventPtr); + + TclDOM_libxml2_DestroyNode(interp, eventPtr->tNodePtr); + + return result; +} + +/* + *---------------------------------------------------------------------------- + * + * TclDOMEventCommand -- + * + * Implements dom::libxml2::event command. + * + * Results: + * Depends on method. + * + * Side effects: + * Depends on method. + * + *---------------------------------------------------------------------------- + */ + +int +TclDOMEventCommand (clientData, interp, objc, objv) + ClientData clientData; + Tcl_Interp *interp; + int objc; + Tcl_Obj *CONST objv[]; +{ + int method, option; + TclXML_libxml2_Document *tDocPtr; + TclDOM_libxml2_Node *tNodePtr; + TclDOM_libxml2_Event *eventPtr; + xmlNodePtr nodePtr; + enum TclDOM_EventTypes type; + Tcl_Obj *typeObjPtr = NULL; + Tcl_Obj *nodeObj; + Tcl_Obj *bubblesPtr, *cancelablePtr, *viewPtr, *detailPtr; + Tcl_Obj *relatedNodePtr, *screenXPtr, *screenYPtr, *clientXPtr, *clientYPtr; + Tcl_Obj *ctrlKeyPtr, *shiftKeyPtr, *metaKeyPtr, *buttonPtr; + Tcl_Obj *prevValuePtr, *newValuePtr, *attrNamePtr, *attrChangePtr; + + if (objc < 2) { + if (clientData == NULL) { + Tcl_WrongNumArgs(interp, 1, objv, "method token ?args...?"); + } else { + Tcl_WrongNumArgs(interp, 1, objv, "method ?args...?"); + } + return TCL_ERROR; + } + + if (Tcl_GetIndexFromObj(interp, objv[1], TclDOM_EventCommandMethods, + "method", 0, &method) != TCL_OK) { + return TCL_ERROR; + } + + switch ((enum TclDOM_EventCommandMethods) method) { + + case TCLDOM_EVENT_CGET: + + if (clientData) { + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "cget option"); + return TCL_ERROR; + } + tNodePtr = (TclDOM_libxml2_Node *) clientData; + if (tNodePtr->type != TCLDOM_LIBXML2_NODE_EVENT) { + Tcl_SetResult(interp, "bad event node", NULL); + return TCL_ERROR; + } + eventPtr = tNodePtr->ptr.eventPtr; + objc -= 2; + objv += 2; + } else { + if (objc != 4) { + Tcl_WrongNumArgs(interp, 3, objv, "cget event option"); + return TCL_ERROR; + } + if (TclDOM_libxml2_GetEventFromObj(interp, objv[2], &eventPtr) != TCL_OK) { + return TCL_ERROR; + } + objc -= 3; + objv += 3; + } + + if (Tcl_GetIndexFromObj(interp, objv[0], TclDOM_EventCommandOptions, + "option", 0, &option) != TCL_OK) { + return TCL_ERROR; + } + + switch ((enum TclDOM_EventCommandOptions) option) { + case TCLDOM_EVENT_ALTKEY: + Tcl_SetObjResult(interp, eventPtr->altKey); + break; + case TCLDOM_EVENT_ATTRNAME: + Tcl_SetObjResult(interp, eventPtr->attrName); + break; + case TCLDOM_EVENT_ATTRCHANGE: + Tcl_SetObjResult(interp, eventPtr->attrChange); + break; + case TCLDOM_EVENT_BUBBLES: + Tcl_SetObjResult(interp, eventPtr->bubbles); + break; + case TCLDOM_EVENT_BUTTON: + Tcl_SetObjResult(interp, eventPtr->button); + break; + case TCLDOM_EVENT_CANCELABLE: + Tcl_SetObjResult(interp, eventPtr->cancelable); + break; + case TCLDOM_EVENT_CLIENTX: + Tcl_SetObjResult(interp, eventPtr->clientX); + break; + case TCLDOM_EVENT_CLIENTY: + Tcl_SetObjResult(interp, eventPtr->clientY); + break; + case TCLDOM_EVENT_CTRLKEY: + Tcl_SetObjResult(interp, eventPtr->ctrlKey); + break; + case TCLDOM_EVENT_CURRENTNODE: + Tcl_SetObjResult(interp, eventPtr->currentNode); + break; + case TCLDOM_EVENT_DETAIL: + Tcl_SetObjResult(interp, eventPtr->detail); + break; + case TCLDOM_EVENT_EVENTPHASE: + Tcl_SetObjResult(interp, eventPtr->eventPhase); + break; + case TCLDOM_EVENT_METAKEY: + Tcl_SetObjResult(interp, eventPtr->metaKey); + break; + case TCLDOM_EVENT_NEWVALUE: + Tcl_SetObjResult(interp, eventPtr->newValue); + break; + case TCLDOM_EVENT_PREVVALUE: + Tcl_SetObjResult(interp, eventPtr->prevValue); + break; + case TCLDOM_EVENT_RELATEDNODE: + Tcl_SetObjResult(interp, eventPtr->relatedNode); + break; + case TCLDOM_EVENT_SCREENX: + Tcl_SetObjResult(interp, eventPtr->screenX); + break; + case TCLDOM_EVENT_SCREENY: + Tcl_SetObjResult(interp, eventPtr->screenY); + break; + case TCLDOM_EVENT_SHIFTKEY: + Tcl_SetObjResult(interp, eventPtr->shiftKey); + break; + case TCLDOM_EVENT_TARGET: + Tcl_SetObjResult(interp, eventPtr->target); + break; + case TCLDOM_EVENT_TIMESTAMP: + Tcl_SetObjResult(interp, eventPtr->timeStamp); + break; + case TCLDOM_EVENT_TYPE: + if (eventPtr->type == TCLDOM_EVENT_USERDEFINED) { + Tcl_SetObjResult(interp, eventPtr->typeObjPtr); + } else { + Tcl_SetObjResult(interp, Tcl_NewStringObj(TclDOM_EventTypes[eventPtr->type], -1)); + } + break; + case TCLDOM_EVENT_VIEW: + Tcl_SetObjResult(interp, eventPtr->view); + break; + default: + Tcl_SetResult(interp, "unknown option", NULL); + return TCL_ERROR; + } + + break; + + case TCLDOM_EVENT_CONFIGURE: + if (objc < 2) { + Tcl_WrongNumArgs(interp, 3, objv, "configure option ?value?"); + return TCL_ERROR; + } + + /* No event options are writable */ + Tcl_SetResult(interp, "option cannot be modified", NULL); + return TCL_ERROR; + + break; + + case TCLDOM_EVENT_STOPPROPAGATION: + + if (clientData) { + if (objc != 2) { + Tcl_WrongNumArgs(interp, 2, objv, ""); + return TCL_ERROR; + } + + tNodePtr = (TclDOM_libxml2_Node *) clientData; + if (tNodePtr->type != TCLDOM_LIBXML2_NODE_EVENT) { + Tcl_SetResult(interp, "bad event node", NULL); + return TCL_ERROR; + } + eventPtr = tNodePtr->ptr.eventPtr; + } else { + if (objc != 3) { + Tcl_WrongNumArgs(interp, 3, objv, ""); + return TCL_ERROR; + } + + if (TclDOM_libxml2_GetEventFromObj(interp, objv[2], &eventPtr) != TCL_OK) { + return TCL_ERROR; + } + } + + eventPtr->stopPropagation = 1; + + break; + + case TCLDOM_EVENT_PREVENTDEFAULT: + + if (clientData) { + if (objc != 2) { + Tcl_WrongNumArgs(interp, 2, objv, ""); + return TCL_ERROR; + } + + tNodePtr = (TclDOM_libxml2_Node *) clientData; + if (tNodePtr->type != TCLDOM_LIBXML2_NODE_EVENT) { + Tcl_SetResult(interp, "bad event node", NULL); + return TCL_ERROR; + } + eventPtr = tNodePtr->ptr.eventPtr; + } else { + if (objc != 3) { + Tcl_WrongNumArgs(interp, 3, objv, ""); + return TCL_ERROR; + } + + if (TclDOM_libxml2_GetEventFromObj(interp, objv[2], &eventPtr) != TCL_OK) { + return TCL_ERROR; + } + } + + eventPtr->preventDefault = 1; + + break; + + case TCLDOM_EVENT_INITEVENT: + + if (clientData) { + if (objc != 5) { + Tcl_WrongNumArgs(interp, 2, objv, "type bubbles cancelable"); + return TCL_ERROR; + } + + tNodePtr = (TclDOM_libxml2_Node *) clientData; + if (tNodePtr->type != TCLDOM_LIBXML2_NODE_EVENT) { + Tcl_SetResult(interp, "bad event node", NULL); + return TCL_ERROR; + } + eventPtr = tNodePtr->ptr.eventPtr; + objc -= 2; + objv += 2; + } else { + if (objc != 6) { + Tcl_WrongNumArgs(interp, 3, objv, "type bubbles cancelable"); + return TCL_ERROR; + } + + if (TclDOM_libxml2_GetEventFromObj(interp, objv[2], &eventPtr) != TCL_OK) { + return TCL_ERROR; + } + objc -= 3; + objv += 3; + } + + if (eventPtr->dispatched) { + Tcl_SetResult(interp, "event has been dispatched", NULL); + return TCL_ERROR; + } + + if (Tcl_GetIndexFromObj(interp, objv[0], TclDOM_EventTypes, + "type", TCL_EXACT, &option) == TCL_OK) { + type = (enum TclDOM_EventTypes) option; + } else { + type = TCLDOM_EVENT_USERDEFINED; + } + Tcl_ResetResult(interp); + + TclDOM_InitEvent(eventPtr, type, objv[0], objv[1], objv[2]); + + break; + + case TCLDOM_EVENT_INITUIEVENT: + + if (clientData) { + if (objc < 6 || objc > 7) { + Tcl_WrongNumArgs(interp, 2, objv, "type bubbles cancelable view ?detail?"); + return TCL_ERROR; + } + + tNodePtr = (TclDOM_libxml2_Node *) clientData; + if (tNodePtr->type != TCLDOM_LIBXML2_NODE_EVENT) { + Tcl_SetResult(interp, "bad event node", NULL); + return TCL_ERROR; + } + eventPtr = tNodePtr->ptr.eventPtr; + + objc -= 2; + objv += 2; + } else { + if (objc < 7 || objc > 8) { + Tcl_WrongNumArgs(interp, 3, objv, "type bubbles cancelable view ?detail?"); + return TCL_ERROR; + } + + if (TclDOM_libxml2_GetEventFromObj(interp, objv[2], &eventPtr) != TCL_OK) { + return TCL_ERROR; + } + + objc -= 3; + objv += 3; + } + + if (eventPtr->dispatched) { + Tcl_SetResult(interp, "event has been dispatched", NULL); + return TCL_ERROR; + } + + if (Tcl_GetIndexFromObj(interp, objv[0], TclDOM_EventTypes, + "type", TCL_EXACT, &option) == TCL_OK) { + type = (enum TclDOM_EventTypes) option; + } else { + type = TCLDOM_EVENT_USERDEFINED; + } + Tcl_ResetResult(interp); + + TclDOM_InitUIEvent(eventPtr, type, objv[0], objv[1], objv[2], objv[3], objc == 5 ? objv[4] : NULL); + + break; + + case TCLDOM_EVENT_INITMOUSEEVENT: + + if (clientData) { + if (objc != 17) { + Tcl_WrongNumArgs(interp, 2, objv, "type bubbles cancelable view detail screenX screenY clientX clientY ctrlKey altKey shiftKey metaKey button relatedNode"); + return TCL_ERROR; + } + + tNodePtr = (TclDOM_libxml2_Node *) clientData; + if (tNodePtr->type != TCLDOM_LIBXML2_NODE_EVENT) { + Tcl_SetResult(interp, "bad event node", NULL); + return TCL_ERROR; + } + eventPtr = tNodePtr->ptr.eventPtr; + + objc -= 2; + objv += 2; + } else { + if (objc != 18) { + Tcl_WrongNumArgs(interp, 3, objv, "type bubbles cancelable view detail screenX screenY clientX clientY ctrlKey altKey shiftKey metaKey button relatedNode"); + return TCL_ERROR; + } + + if (TclDOM_libxml2_GetEventFromObj(interp, objv[2], &eventPtr) != TCL_OK) { + return TCL_ERROR; + } + + objc -= 3; + objv += 3; + } + + if (eventPtr->dispatched) { + Tcl_SetResult(interp, "event has been dispatched", NULL); + return TCL_ERROR; + } + + if (Tcl_GetIndexFromObj(interp, objv[0], TclDOM_EventTypes, + "type", TCL_EXACT, &option) == TCL_OK) { + type = (enum TclDOM_EventTypes) option; + } else { + type = TCLDOM_EVENT_USERDEFINED; + } + Tcl_ResetResult(interp); + + TclDOM_InitMouseEvent(eventPtr, type, objv[0], objv[1], objv[2], objv[3], objv[4], objv[5], objv[6], objv[7], objv[8], objv[9], objv[10], objv[11], objv[12], objv[13], objv[14]); + + break; + + case TCLDOM_EVENT_INITMUTATIONEVENT: + + if (clientData) { + if (objc != 10) { + Tcl_WrongNumArgs(interp, 2, objv, "type bubbles cancelable relatedNode prevValue newValue attrName attrChange"); + return TCL_ERROR; + } + + tNodePtr = (TclDOM_libxml2_Node *) clientData; + if (tNodePtr->type != TCLDOM_LIBXML2_NODE_EVENT) { + Tcl_SetResult(interp, "bad event node", NULL); + return TCL_ERROR; + } + eventPtr = tNodePtr->ptr.eventPtr; + + objc -= 2; + objv += 2; + } else { + if (objc != 11) { + Tcl_WrongNumArgs(interp, 3, objv, "type bubbles cancelable relatedNode prevValue newValue attrName attrChange"); + return TCL_ERROR; + } + + if (TclDOM_libxml2_GetEventFromObj(interp, objv[2], &eventPtr) != TCL_OK) { + return TCL_ERROR; + } + + objc -= 3; + objv += 3; + } + + if (eventPtr->dispatched) { + Tcl_SetResult(interp, "event has been dispatched", NULL); + return TCL_ERROR; + } + + if (Tcl_GetIndexFromObj(interp, objv[0], TclDOM_EventTypes, + "type", TCL_EXACT, &option) == TCL_OK) { + type = (enum TclDOM_EventTypes) option; + } else { + type = TCLDOM_EVENT_USERDEFINED; + } + Tcl_ResetResult(interp); + + TclDOM_InitMutationEvent(eventPtr, type, objv[0], objv[1], objv[2], objv[3], objv[4], objv[5], objv[6], objv[7]); + + break; + + case TCLDOM_EVENT_POSTUIEVENT: + + if (clientData) { + Tcl_SetResult(interp, "bad method for event", NULL); + return TCL_ERROR; + } + + if (objc < 4) { + Tcl_WrongNumArgs(interp, 1, objv, "postUIEvent node type ?args ...?"); + return TCL_ERROR; + } + + if (TclDOM_libxml2_GetNodeFromObj(interp, objv[2], &nodePtr) != TCL_OK) { + return TCL_ERROR; + } + nodeObj = objv[2]; + + if (TclXML_libxml2_GetTclDocFromNode(interp, nodePtr, &tDocPtr) != TCL_OK) { + return TCL_ERROR; + } + + if (Tcl_GetIndexFromObj(interp, objv[3], TclDOM_EventTypes, + "type", TCL_EXACT, &option) == TCL_OK) { + type = (enum TclDOM_EventTypes) option; + } else { + type = TCLDOM_EVENT_USERDEFINED; + } + typeObjPtr = objv[3]; + Tcl_ResetResult(interp); + + bubblesPtr = Tcl_GetVar2Ex(interp, "::dom::bubbles", Tcl_GetStringFromObj(objv[3], NULL), TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG); + if (!bubblesPtr) { + return TCL_ERROR; + } + Tcl_IncrRefCount(bubblesPtr); + cancelablePtr = Tcl_GetVar2Ex(interp, "::dom::cancelable", Tcl_GetStringFromObj(objv[3], NULL), TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG); + if (!cancelablePtr) { + Tcl_DecrRefCount(bubblesPtr); + return TCL_ERROR; + } + Tcl_IncrRefCount(cancelablePtr); + + viewPtr = Tcl_NewObj(); + detailPtr = Tcl_NewObj(); + + objc -= 4; + objv += 4; + while (objc) { + + if (objc == 1) { + Tcl_SetResult(interp, "value missing", NULL); + Tcl_DecrRefCount(bubblesPtr); + Tcl_DecrRefCount(cancelablePtr); + Tcl_DecrRefCount(viewPtr); + Tcl_DecrRefCount(detailPtr); + return TCL_ERROR; + } + + if (Tcl_GetIndexFromObj(interp, objv[0], TclDOM_EventCommandOptions, + "option", 0, &option) != TCL_OK) { + Tcl_DecrRefCount(bubblesPtr); + Tcl_DecrRefCount(cancelablePtr); + Tcl_DecrRefCount(viewPtr); + Tcl_DecrRefCount(detailPtr); + return TCL_ERROR; + } + switch ((enum TclDOM_EventCommandOptions) option) { + case TCLDOM_EVENT_BUBBLES: + Tcl_DecrRefCount(bubblesPtr); + bubblesPtr = objv[1]; + Tcl_IncrRefCount(bubblesPtr); + break; + case TCLDOM_EVENT_CANCELABLE: + Tcl_DecrRefCount(cancelablePtr); + cancelablePtr = objv[1]; + Tcl_IncrRefCount(cancelablePtr); + break; + case TCLDOM_EVENT_VIEW: + Tcl_DecrRefCount(viewPtr); + viewPtr = objv[1]; + Tcl_IncrRefCount(viewPtr); + break; + case TCLDOM_EVENT_DETAIL: + Tcl_DecrRefCount(detailPtr); + detailPtr = objv[1]; + Tcl_IncrRefCount(detailPtr); + break; + default: + Tcl_SetResult(interp, "bad option", NULL); + Tcl_DecrRefCount(bubblesPtr); + Tcl_DecrRefCount(cancelablePtr); + Tcl_DecrRefCount(viewPtr); + Tcl_DecrRefCount(detailPtr); + return TCL_ERROR; + } + + objc -= 2; + objv += 2; + } + + if (TclDOM_PostUIEvent(interp, tDocPtr, nodeObj, type, typeObjPtr, bubblesPtr, cancelablePtr, viewPtr, detailPtr) != TCL_OK) { + Tcl_DecrRefCount(bubblesPtr); + Tcl_DecrRefCount(cancelablePtr); + Tcl_DecrRefCount(viewPtr); + Tcl_DecrRefCount(detailPtr); + return TCL_ERROR; + } + + break; + + case TCLDOM_EVENT_POSTMOUSEEVENT: + + if (clientData) { + Tcl_SetResult(interp, "bad method for event", NULL); + return TCL_ERROR; + } + + if (objc < 4) { + Tcl_WrongNumArgs(interp, 1, objv, "postMouseEvent node type ?args ...?"); + return TCL_ERROR; + } + + if (TclDOM_libxml2_GetNodeFromObj(interp, objv[2], &nodePtr) != TCL_OK) { + return TCL_ERROR; + } + nodeObj = objv[2]; + + if (TclXML_libxml2_GetTclDocFromNode(interp, nodePtr, &tDocPtr) != TCL_OK) { + return TCL_ERROR; + } + + if (Tcl_GetIndexFromObj(interp, objv[3], TclDOM_EventTypes, + "type", TCL_EXACT, &option) == TCL_OK) { + type = (enum TclDOM_EventTypes) option; + } else { + type = TCLDOM_EVENT_USERDEFINED; + } + typeObjPtr = objv[3]; + Tcl_ResetResult(interp); + + bubblesPtr = Tcl_GetVar2Ex(interp, "::dom::bubbles", Tcl_GetStringFromObj(objv[3], NULL), TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG); + if (!bubblesPtr) { + return TCL_ERROR; + } + Tcl_IncrRefCount(bubblesPtr); + cancelablePtr = Tcl_GetVar2Ex(interp, "::dom::cancelable", Tcl_GetStringFromObj(objv[3], NULL), TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG); + if (!cancelablePtr) { + Tcl_DecrRefCount(bubblesPtr); + return TCL_ERROR; + } + Tcl_IncrRefCount(cancelablePtr); + + viewPtr = Tcl_NewObj(); + detailPtr = Tcl_NewObj(); + relatedNodePtr = Tcl_NewObj(); + screenXPtr = Tcl_NewObj(); + screenYPtr = Tcl_NewObj(); + clientXPtr = Tcl_NewObj(); + clientYPtr = Tcl_NewObj(); + ctrlKeyPtr = Tcl_NewObj(); + shiftKeyPtr = Tcl_NewObj(); + metaKeyPtr = Tcl_NewObj(); + buttonPtr = Tcl_NewObj(); + + objc -= 4; + objv += 4; + while (objc) { + + if (objc == 1) { + Tcl_SetResult(interp, "value missing", NULL); + goto mouse_error; + } + + if (Tcl_GetIndexFromObj(interp, objv[0], TclDOM_EventCommandOptions, + "option", 0, &option) != TCL_OK) { + goto mouse_error; + } + switch ((enum TclDOM_EventCommandOptions) option) { + case TCLDOM_EVENT_BUBBLES: + Tcl_DecrRefCount(bubblesPtr); + bubblesPtr = objv[1]; + Tcl_IncrRefCount(bubblesPtr); + break; + case TCLDOM_EVENT_CANCELABLE: + Tcl_DecrRefCount(cancelablePtr); + cancelablePtr = objv[1]; + Tcl_IncrRefCount(cancelablePtr); + break; + case TCLDOM_EVENT_RELATEDNODE: + Tcl_DecrRefCount(relatedNodePtr); + relatedNodePtr = objv[1]; + Tcl_IncrRefCount(relatedNodePtr); + break; + case TCLDOM_EVENT_VIEW: + Tcl_DecrRefCount(viewPtr); + viewPtr = objv[1]; + Tcl_IncrRefCount(viewPtr); + break; + case TCLDOM_EVENT_DETAIL: + Tcl_DecrRefCount(detailPtr); + detailPtr = objv[1]; + Tcl_IncrRefCount(detailPtr); + break; + case TCLDOM_EVENT_SCREENX: + Tcl_DecrRefCount(screenXPtr); + screenXPtr = objv[1]; + Tcl_IncrRefCount(screenXPtr); + break; + case TCLDOM_EVENT_SCREENY: + Tcl_DecrRefCount(screenYPtr); + screenYPtr = objv[1]; + Tcl_IncrRefCount(screenYPtr); + break; + case TCLDOM_EVENT_CLIENTX: + Tcl_DecrRefCount(clientXPtr); + clientXPtr = objv[1]; + Tcl_IncrRefCount(clientXPtr); + break; + case TCLDOM_EVENT_CLIENTY: + Tcl_DecrRefCount(clientYPtr); + clientYPtr = objv[1]; + Tcl_IncrRefCount(clientYPtr); + break; + case TCLDOM_EVENT_CTRLKEY: + Tcl_DecrRefCount(ctrlKeyPtr); + ctrlKeyPtr = objv[1]; + Tcl_IncrRefCount(ctrlKeyPtr); + break; + case TCLDOM_EVENT_SHIFTKEY: + Tcl_DecrRefCount(shiftKeyPtr); + shiftKeyPtr = objv[1]; + Tcl_IncrRefCount(shiftKeyPtr); + break; + case TCLDOM_EVENT_METAKEY: + Tcl_DecrRefCount(metaKeyPtr); + metaKeyPtr = objv[1]; + Tcl_IncrRefCount(metaKeyPtr); + break; + case TCLDOM_EVENT_BUTTON: + Tcl_DecrRefCount(buttonPtr); + buttonPtr = objv[1]; + Tcl_IncrRefCount(buttonPtr); + break; + default: + Tcl_SetResult(interp, "bad option", NULL); + goto mouse_error; + } + + objc -= 2; + objv += 2; + } + + if (TclDOM_PostMouseEvent(interp, tDocPtr, nodeObj, type, typeObjPtr, bubblesPtr, cancelablePtr, relatedNodePtr, viewPtr, detailPtr, screenXPtr, screenYPtr, clientXPtr, clientYPtr, ctrlKeyPtr, shiftKeyPtr, metaKeyPtr, buttonPtr, relatedNodePtr) != TCL_OK) { + goto mouse_error; + } + + break; + +mouse_error: + Tcl_DecrRefCount(bubblesPtr); + Tcl_DecrRefCount(cancelablePtr); + Tcl_DecrRefCount(viewPtr); + Tcl_DecrRefCount(detailPtr); + Tcl_DecrRefCount(relatedNodePtr); + Tcl_DecrRefCount(screenXPtr); + Tcl_DecrRefCount(screenYPtr); + Tcl_DecrRefCount(clientXPtr); + Tcl_DecrRefCount(clientYPtr); + Tcl_DecrRefCount(ctrlKeyPtr); + Tcl_DecrRefCount(shiftKeyPtr); + Tcl_DecrRefCount(metaKeyPtr); + Tcl_DecrRefCount(buttonPtr); + + return TCL_ERROR; + + case TCLDOM_EVENT_POSTMUTATIONEVENT: + + if (clientData) { + Tcl_SetResult(interp, "bad method for event", NULL); + return TCL_ERROR; + } + + if (objc < 4) { + Tcl_WrongNumArgs(interp, 1, objv, "postMutationEvent node type ?args ...?"); + return TCL_ERROR; + } + + if (TclDOM_libxml2_GetNodeFromObj(interp, objv[2], &nodePtr) != TCL_OK) { + return TCL_ERROR; + } + nodeObj = objv[2]; + + if (TclXML_libxml2_GetTclDocFromNode(interp, nodePtr, &tDocPtr) != TCL_OK) { + return TCL_ERROR; + } + + if (Tcl_GetIndexFromObj(interp, objv[3], TclDOM_EventTypes, + "type", TCL_EXACT, &option) == TCL_OK) { + type = (enum TclDOM_EventTypes) option; + } else { + type = TCLDOM_EVENT_USERDEFINED; + } + typeObjPtr = objv[3]; + Tcl_ResetResult(interp); + + bubblesPtr = Tcl_GetVar2Ex(interp, "::dom::bubbles", Tcl_GetStringFromObj(objv[3], NULL), TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG); + if (!bubblesPtr) { + return TCL_ERROR; + } + Tcl_IncrRefCount(bubblesPtr); + cancelablePtr = Tcl_GetVar2Ex(interp, "::dom::cancelable", Tcl_GetStringFromObj(objv[3], NULL), TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG); + if (!cancelablePtr) { + Tcl_DecrRefCount(bubblesPtr); + return TCL_ERROR; + } + Tcl_IncrRefCount(cancelablePtr); + + relatedNodePtr = Tcl_NewObj(); + prevValuePtr = Tcl_NewObj(); + newValuePtr = Tcl_NewObj(); + attrNamePtr = Tcl_NewObj(); + attrChangePtr = Tcl_NewObj(); + + objc -= 4; + objv += 4; + while (objc) { + + if (objc == 1) { + Tcl_SetResult(interp, "value missing", NULL); + goto mutation_error; + } + + if (Tcl_GetIndexFromObj(interp, objv[0], TclDOM_EventCommandOptions, + "option", 0, &option) != TCL_OK) { + goto mutation_error; + } + switch ((enum TclDOM_EventCommandOptions) option) { + case TCLDOM_EVENT_BUBBLES: + Tcl_DecrRefCount(bubblesPtr); + bubblesPtr = objv[1]; + Tcl_IncrRefCount(bubblesPtr); + break; + case TCLDOM_EVENT_CANCELABLE: + Tcl_DecrRefCount(cancelablePtr); + cancelablePtr = objv[1]; + Tcl_IncrRefCount(cancelablePtr); + break; + case TCLDOM_EVENT_RELATEDNODE: + Tcl_DecrRefCount(relatedNodePtr); + relatedNodePtr = objv[1]; + Tcl_IncrRefCount(relatedNodePtr); + break; + case TCLDOM_EVENT_PREVVALUE: + Tcl_DecrRefCount(prevValuePtr); + prevValuePtr = objv[1]; + Tcl_IncrRefCount(prevValuePtr); + break; + case TCLDOM_EVENT_NEWVALUE: + Tcl_DecrRefCount(newValuePtr); + newValuePtr = objv[1]; + Tcl_IncrRefCount(newValuePtr); + break; + case TCLDOM_EVENT_ATTRNAME: + Tcl_DecrRefCount(attrNamePtr); + attrNamePtr = objv[1]; + Tcl_IncrRefCount(attrNamePtr); + break; + case TCLDOM_EVENT_ATTRCHANGE: + Tcl_DecrRefCount(attrChangePtr); + attrChangePtr = objv[1]; + Tcl_IncrRefCount(attrChangePtr); + break; + default: + Tcl_SetResult(interp, "bad option", NULL); + goto mutation_error; + } + + objc -= 2; + objv += 2; + } + + if (TclDOM_PostMutationEvent(interp, tDocPtr, nodeObj, type, typeObjPtr, bubblesPtr, cancelablePtr, relatedNodePtr, prevValuePtr, newValuePtr, attrNamePtr, attrChangePtr) != TCL_OK) { + goto mutation_error; + } + + break; + +mutation_error: + Tcl_DecrRefCount(bubblesPtr); + Tcl_DecrRefCount(cancelablePtr); + Tcl_DecrRefCount(relatedNodePtr); + Tcl_DecrRefCount(prevValuePtr); + Tcl_DecrRefCount(newValuePtr); + Tcl_DecrRefCount(attrNamePtr); + Tcl_DecrRefCount(attrChangePtr); + + return TCL_ERROR; + + default: + + Tcl_SetResult(interp, "unknown method", NULL); + return TCL_ERROR; + + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * GetPath -- + * + * Constructs a list of ancestor nodes. + * + * Results: + * Returns list as a Tcl_Obj. + * + * Side effects: + * Allocates Tcl_Obj structures. + * + *---------------------------------------------------------------------------- + */ + +static Tcl_Obj * +GetPath (interp, nodePtr) + Tcl_Interp *interp; + xmlNodePtr nodePtr; +{ + Tcl_Obj *listPtr, *resultPtr; + Tcl_Obj *objv[2]; + + if (nodePtr) { + if (nodePtr->type == XML_DOCUMENT_NODE) { + objv[0] = TclXML_libxml2_CreateObjFromDoc((xmlDocPtr) nodePtr); + } else { + objv[0] = TclDOM_libxml2_CreateObjFromNode(interp, nodePtr); + } + objv[1] = NULL; + + listPtr = Tcl_NewListObj(1, objv); + if (nodePtr->parent) { + resultPtr = GetPath(interp, nodePtr->parent); + Tcl_ListObjAppendList(interp, resultPtr, listPtr); + } else { + resultPtr = listPtr; + } + return resultPtr; + } else { + return Tcl_NewObj(); + } +} + +/* + *---------------------------------------------------------------------------- + * + * Node (and event) Tcl Object management + * + *---------------------------------------------------------------------------- + */ + +/* + *---------------------------------------------------------------------------- + * + * TclDOM_libxml2_CreateObjFromNode -- + * + * Create a Tcl_Obj to wrap a tree node. + * + * Results: + * Returns Tcl_Obj*. + * + * Side effects: + * Allocates object. Creates node command. + * + *---------------------------------------------------------------------------- + */ + +Tcl_Obj * +TclDOM_libxml2_CreateObjFromNode (interp, nodePtr) + Tcl_Interp *interp; + xmlNodePtr nodePtr; +{ + TclDOM_libxml2_Node *tNodePtr; + TclXML_libxml2_Document *tDocPtr; + TclDOM_libxml2_Document *domDocPtr; + Tcl_Obj *objPtr; + Tcl_HashEntry *entry; + int new; + + if (TclXML_libxml2_GetTclDocFromNode(interp, nodePtr, &tDocPtr) != TCL_OK) { + Tcl_SetResult(interp, "unable to find document for node", NULL); + return NULL; + } + if ((domDocPtr = GetDOMDocument(interp, tDocPtr)) == NULL) { + Tcl_SetResult(interp, "internal error", NULL); + return NULL; + } + + tNodePtr = (TclDOM_libxml2_Node *) Tcl_Alloc(sizeof(TclDOM_libxml2_Node)); + tNodePtr->ptr.nodePtr = nodePtr; + tNodePtr->type = TCLDOM_LIBXML2_NODE_NODE; + tNodePtr->objs = NULL; + tNodePtr->token = Tcl_Alloc(30); + sprintf(tNodePtr->token, "::dom::%s::node%d", tDocPtr->token, domDocPtr->nodeCntr++); + + entry = Tcl_CreateHashEntry(domDocPtr->nodes, tNodePtr->token, &new); + if (!new) { + Tcl_Free((char *) tNodePtr->token); + Tcl_Free((char *) tNodePtr); + Tcl_SetResult(interp, "internal error", NULL); + return NULL; + } + Tcl_SetHashValue(entry, (void *) tNodePtr); + + tNodePtr->cmd = Tcl_CreateObjCommand(interp, tNodePtr->token, TclDOMNodeCommand, (ClientData) tNodePtr, TclDOMNodeCommandDelete); + + objPtr = Tcl_NewObj(); + objPtr->internalRep.otherValuePtr = (VOID *) tNodePtr; + objPtr->typePtr = &NodeObjType; + + objPtr->bytes = Tcl_Alloc(strlen(tNodePtr->token) + 1); + strcpy(objPtr->bytes, tNodePtr->token); + objPtr->length = strlen(objPtr->bytes); + + NodeAddObjRef(tNodePtr, objPtr); + + return objPtr; +} + +/* + *---------------------------------------------------------------------------- + * + * NodeAddObjRef -- + * + * Add an object reference to a node wrapper. + * + * Results: + * Adds a reference to the Tcl_Obj for the node. + * + * Side effects: + * Allocates memory. + * + *---------------------------------------------------------------------------- + */ + +static void +NodeAddObjRef(tNodePtr, objPtr) + TclDOM_libxml2_Node *tNodePtr; + Tcl_Obj *objPtr; +{ + ObjList *listPtr; + + listPtr = (ObjList *) Tcl_Alloc(sizeof(ObjList)); + listPtr->next = tNodePtr->objs; + listPtr->objPtr = objPtr; + + tNodePtr->objs = (void *) listPtr; +} + +/* + *---------------------------------------------------------------------------- + * + * TclDOMNodeCommandDelete -- + * + * Invoked when a DOM node's Tcl command is deleted. + * + * Results: + * Invalidates the Tcl_Obj for the node, but doesn't actually destroy the node. + * + * Side effects: + * Frees memory. + * + *---------------------------------------------------------------------------- + */ + +void +TclDOMNodeCommandDelete (clientData) + ClientData clientData; +{ + TclDOM_libxml2_Node *tNodePtr = (TclDOM_libxml2_Node *) clientData; + + TclDOM_libxml2_InvalidateNode(tNodePtr); +} + +/* + *---------------------------------------------------------------------------- + * + * TclDOM_libxml2_GetNodeFromObj -- + * + * Gets an xmlNodePtr from a Tcl_Obj. + * + * Results: + * Returns success code. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------------- + */ + +int +TclDOM_libxml2_GetNodeFromObj (interp, objPtr, nodePtrPtr) + Tcl_Interp *interp; + Tcl_Obj *objPtr; + xmlNodePtr *nodePtrPtr; +{ + TclDOM_libxml2_Node *tNodePtr; + + if (TclDOM_libxml2_GetTclNodeFromObj(interp, objPtr, &tNodePtr) != TCL_OK) { + return TCL_ERROR; + } + + *nodePtrPtr = tNodePtr->ptr.nodePtr; + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * TclDOM_libxml2_GetTclNodeFromObj -- + * + * Gets the TclDOM node structure from a Tcl_Obj. + * + * Results: + * Returns success code. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------------- + */ + +int +TclDOM_libxml2_GetTclNodeFromObj (interp, objPtr, tNodePtrPtr) + Tcl_Interp *interp; + Tcl_Obj *objPtr; + TclDOM_libxml2_Node **tNodePtrPtr; +{ + TclDOM_libxml2_Node *tNodePtr; + + if (objPtr->typePtr == &NodeObjType) { + tNodePtr = (TclDOM_libxml2_Node *) objPtr->internalRep.otherValuePtr; + } else if (NodeTypeSetFromAny(interp, objPtr) == TCL_OK) { + tNodePtr = (TclDOM_libxml2_Node *) objPtr->internalRep.otherValuePtr; + } else { + return TCL_ERROR; + } + + if (tNodePtr->type != TCLDOM_LIBXML2_NODE_NODE) { + return TCL_ERROR; + } + + *tNodePtrPtr = tNodePtr; + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * TclDOM_libxml2_GetEventFromObj -- + * + * Gets an eventPtr from a Tcl_Obj. + * + * Results: + * Returns success code. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------------- + */ + +int +TclDOM_libxml2_GetEventFromObj (interp, objPtr, eventPtrPtr) + Tcl_Interp *interp; + Tcl_Obj *objPtr; + TclDOM_libxml2_Event **eventPtrPtr; +{ + TclDOM_libxml2_Node *tNodePtr; + + if (TclDOM_libxml2_GetTclEventFromObj(interp, objPtr, &tNodePtr) != TCL_OK) { + return TCL_ERROR; + } + + *eventPtrPtr = tNodePtr->ptr.eventPtr; + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * TclDOM_libxml2_GetTclEventFromObj -- + * + * Gets the node structure for an event from a Tcl_Obj. + * + * Results: + * Returns success code. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------------- + */ + +int +TclDOM_libxml2_GetTclEventFromObj (interp, objPtr, nodePtrPtr) + Tcl_Interp *interp; + Tcl_Obj *objPtr; + TclDOM_libxml2_Node **nodePtrPtr; +{ + TclDOM_libxml2_Node *tNodePtr; + + if (objPtr->typePtr == &NodeObjType) { + tNodePtr = (TclDOM_libxml2_Node *) objPtr->internalRep.otherValuePtr; + } else if (NodeTypeSetFromAny(interp, objPtr) == TCL_OK) { + tNodePtr = (TclDOM_libxml2_Node *) objPtr->internalRep.otherValuePtr; + } else { + return TCL_ERROR; + } + + if (tNodePtr->type != TCLDOM_LIBXML2_NODE_EVENT) { + return TCL_ERROR; + } + + *nodePtrPtr = tNodePtr; + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * TclDOM_libxml2_DestroyNode -- + * + * Destroys a node + * + * Results: + * Frees node. + * + * Side effects: + * Deallocates memory. + * + *---------------------------------------------------------------------------- + */ + +static void +TclDOM_libxml2_DeleteNode(clientData) + ClientData clientData; +{ + TclDOM_libxml2_Node *tNodePtr = (TclDOM_libxml2_Node *) clientData; + TclDOM_libxml2_Event *eventPtr; + TclXML_libxml2_Document *tDocPtr; + TclDOM_libxml2_Document *domDocPtr; + Tcl_Obj *objPtr; + xmlNodePtr nodePtr; + Tcl_HashEntry *entry; + + if (tNodePtr->type == TCLDOM_LIBXML2_NODE_NODE) { + nodePtr = tNodePtr->ptr.nodePtr; + objPtr = TclXML_libxml2_CreateObjFromDoc(nodePtr->doc); + TclXML_libxml2_GetTclDocFromObj(NULL, objPtr, &tDocPtr); + domDocPtr = GetDOMDocument(NULL, tDocPtr); + if (domDocPtr == NULL) { + /* internal error */ + return; + } + } else { + eventPtr = tNodePtr->ptr.eventPtr; + domDocPtr = eventPtr->ownerDocument; + Tcl_Free((char *) eventPtr); + } + + entry = Tcl_FindHashEntry(domDocPtr->nodes, tNodePtr->token); + if (entry) { + Tcl_DeleteHashEntry(entry); + } else { + fprintf(stderr, "cannot delete node hash entry!\n"); + } + + TclDOM_libxml2_InvalidateNode(tNodePtr); + + if (tNodePtr->appfree) { + (tNodePtr->appfree)(tNodePtr->apphook); + } + + Tcl_Free((char *) tNodePtr); +} + +void +TclDOM_libxml2_DestroyNode (interp, tNodePtr) + Tcl_Interp *interp; + TclDOM_libxml2_Node *tNodePtr; +{ + Tcl_DeleteCommandFromToken(interp, tNodePtr->cmd); +} + +/* + *---------------------------------------------------------------------------- + * + * TclDOM_libxml2_InvalidateNode -- + * + * Invalidates the internal representation of any Tcl_obj that refers to + * this node. NB. This does not destroy the node, or delete the node command. + * + * Results: + * Tcl_Obj internal reps changed. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------------- + */ + +void +TclDOM_libxml2_InvalidateNode (tNodePtr) + TclDOM_libxml2_Node *tNodePtr; +{ + ObjList *listPtr, *nextPtr; + + for (listPtr = (ObjList *) tNodePtr->objs; listPtr;) { + + listPtr->objPtr->internalRep.otherValuePtr = NULL; + listPtr->objPtr->typePtr = NULL; + + nextPtr = listPtr->next; + Tcl_Free((char *) listPtr); + listPtr = nextPtr; + } + + tNodePtr->objs = NULL; +} + +/* + *---------------------------------------------------------------------------- + * + * Node object type management + * + *---------------------------------------------------------------------------- + */ + +/* + * NodeTypeSetFromAny -- + * + * Sets the internal representation from the string rep. + * + * Results: + * Success code. + * + * Side effects: + * Changes internal rep. + * + *---------------------------------------------------------------------------- + */ + +int +NodeTypeSetFromAny(interp, objPtr) + Tcl_Interp *interp; + Tcl_Obj *objPtr; +{ + Tcl_Obj *docObjPtr; + TclXML_libxml2_Document *tDocPtr; + TclDOM_libxml2_Document *domDocPtr; + Tcl_HashEntry *entry; + char *id, doc[21], node[21]; + int i, idlen, len; + + /* Parse string rep for doc and node ids */ + id = Tcl_GetStringFromObj(objPtr, &idlen); + /* node tokens are prefixed with "::dom::" */ + if (idlen < 7 || strncmp("::dom::", id, 7) != 0) { + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "malformed node token \"", id, "\"", NULL); + return TCL_ERROR; + } + for (i = 0; i < idlen && id[i + 7] != ':' && i < 21; i++) { + if (!((id[i + 7] >= 'a' && id[i + 7] <= 'z') || (id[i + 7] >= '0' && id[i + 7] <= '9'))) { + /* only lowercase chars and digits are found in a token */ + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "malformed node token \"", id, "\"", NULL); + return TCL_ERROR; + } + doc[i] = id[i + 7]; + } + if (i == idlen || id[i + 7] != ':') { + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "malformed node token \"", id, "\"", NULL); + return TCL_ERROR; + } + doc[i] = '\0'; + i++; + + if (i == idlen || id[i + 7] != ':') { + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "malformed node token \"", id, "\"", NULL); + return TCL_ERROR; + } + i++; + for (len = i + 7, i = 0; i + len < idlen && i < 21; i++) { + node[i] = id[len + i]; + } + node[i] = '\0'; + + docObjPtr = Tcl_NewStringObj(doc, -1); + if (TclXML_libxml2_GetTclDocFromObj(interp, docObjPtr, &tDocPtr) != TCL_OK) { + Tcl_DecrRefCount(docObjPtr); + Tcl_SetResult(interp, "invalid node token", NULL); + return TCL_ERROR; + } + domDocPtr = GetDOMDocument(interp, tDocPtr); + if (domDocPtr == NULL) { + Tcl_SetResult(interp, "internal error", NULL); + return TCL_ERROR; + } + + entry = Tcl_FindHashEntry(domDocPtr->nodes, id); + if (entry) { + TclDOM_libxml2_Node *tNodePtr; + + if (objPtr->typePtr != NULL && objPtr->typePtr->freeIntRepProc != NULL) { + objPtr->typePtr->freeIntRepProc(objPtr); + } + + tNodePtr = (TclDOM_libxml2_Node *) Tcl_GetHashValue(entry); + objPtr->internalRep.otherValuePtr = (void *) tNodePtr; + objPtr->typePtr = &NodeObjType; + NodeAddObjRef(tNodePtr, objPtr); + + } else { + Tcl_DecrRefCount(docObjPtr); + Tcl_SetResult(interp, "not a DOM node", NULL); + return TCL_ERROR; + } + + Tcl_DecrRefCount(docObjPtr); + + return TCL_OK; +} + +void +NodeTypeUpdate(objPtr) + Tcl_Obj *objPtr; +{ + TclDOM_libxml2_Node *tNodePtr = (TclDOM_libxml2_Node *) objPtr->internalRep.otherValuePtr; + + objPtr->bytes = Tcl_Alloc(strlen(tNodePtr->token) + 1); + strcpy(objPtr->bytes, tNodePtr->token); + objPtr->length = strlen(objPtr->bytes); +} + +void +NodeTypeDup(srcPtr, dstPtr) + Tcl_Obj *srcPtr; + Tcl_Obj *dstPtr; +{ + TclDOM_libxml2_Node *tNodePtr = (TclDOM_libxml2_Node *) srcPtr->internalRep.otherValuePtr; + + if (dstPtr->typePtr != NULL && dstPtr->typePtr->freeIntRepProc != NULL) { + dstPtr->typePtr->freeIntRepProc(dstPtr); + } + + Tcl_InvalidateStringRep(dstPtr); + + dstPtr->internalRep.otherValuePtr = (ClientData) tNodePtr; + dstPtr->typePtr = srcPtr->typePtr; + + NodeAddObjRef(tNodePtr, dstPtr); +} + +/* + * Unlike documents, nodes are not destroyed just because they have no Tcl_Obj's + * referring to them. + */ + +void +NodeTypeFree(objPtr) + Tcl_Obj *objPtr; +{ + TclDOM_libxml2_Node *tNodePtr = (TclDOM_libxml2_Node *) objPtr->internalRep.otherValuePtr; + ObjList *listPtr = tNodePtr->objs; + ObjList *prevPtr = NULL; + + while (listPtr) { + if (listPtr->objPtr == objPtr) { + break; + } + prevPtr = listPtr; + listPtr = listPtr->next; + } + + if (listPtr == NULL) { + /* internal error */ + } else if (prevPtr == NULL) { + tNodePtr->objs = listPtr->next; + } else { + prevPtr->next = listPtr->next; + } + Tcl_Free((char *) listPtr); + + objPtr->internalRep.otherValuePtr = NULL; + objPtr->typePtr = NULL; +} +#if 0 +static void +DumpNode(tNodePtr) +TclDOM_libxml2_Node *tNodePtr; +{ + ObjList *listPtr; + + fprintf(stderr, " node token \"%s\" type %d ptr x%x\n", + tNodePtr->token, tNodePtr->type, + tNodePtr->ptr.nodePtr); + listPtr = (ObjList *) tNodePtr->objs; + if (listPtr) { + fprintf(stderr, " objects:"); + while (listPtr) { + fprintf(stderr, " objPtr x%x", listPtr->objPtr); + listPtr = listPtr->next; + fprintf(stderr, "\n"); + } + } else { + fprintf(stderr, " no objects\n"); + } +} +#endif + +/* + *---------------------------------------------------------------------------- + * + * TclDOM_libxml2_NewEventObj -- + * + * Create a Tcl_Obj for an event. + * + * Results: + * Returns Tcl_Obj*. + * + * Side effects: + * Allocates object. + * + *---------------------------------------------------------------------------- + */ + +Tcl_Obj * +TclDOM_libxml2_NewEventObj (interp, docPtr, type, typeObjPtr) + Tcl_Interp *interp; + xmlDocPtr docPtr; + enum TclDOM_EventTypes type; + Tcl_Obj *typeObjPtr; /* NULL for standard types */ +{ + Tcl_Obj *objPtr, *docObjPtr; + TclDOM_libxml2_Node *tNodePtr; + TclDOM_libxml2_Event *eventPtr; + TclXML_libxml2_Document *tDocPtr; + TclDOM_libxml2_Document *domDocPtr; + Tcl_HashEntry *entry; + int new; + + docObjPtr = TclXML_libxml2_CreateObjFromDoc(docPtr); + TclXML_libxml2_GetTclDocFromObj(interp, docObjPtr, &tDocPtr); + domDocPtr = GetDOMDocument(interp, tDocPtr); + if (domDocPtr == NULL) { + Tcl_SetResult(interp, "internal error", NULL); + return NULL; + } + + tNodePtr = (TclDOM_libxml2_Node *) Tcl_Alloc(sizeof(TclDOM_libxml2_Node)); + tNodePtr->token = Tcl_Alloc(30); + sprintf(tNodePtr->token, "::dom::%s::event%d", tDocPtr->token, domDocPtr->nodeCntr++); + tNodePtr->type = TCLDOM_LIBXML2_NODE_EVENT; + tNodePtr->objs = NULL; + tNodePtr->apphook = NULL; + tNodePtr->appfree = NULL; + + entry = Tcl_CreateHashEntry(domDocPtr->nodes, tNodePtr->token, &new); + if (!new) { + Tcl_Free((char *) tNodePtr->token); + Tcl_Free((char *) tNodePtr); + return NULL; + } + Tcl_SetHashValue(entry, (void *) tNodePtr); + + tNodePtr->cmd = Tcl_CreateObjCommand(interp, tNodePtr->token, TclDOMEventCommand, (ClientData) tNodePtr, TclDOMEventCommandDelete); + + eventPtr = (TclDOM_libxml2_Event *) Tcl_Alloc(sizeof(TclDOM_libxml2_Event)); + eventPtr->ownerDocument = domDocPtr; + eventPtr->tNodePtr = tNodePtr; + + /* + * Overload the node pointer to refer to the event structure. + */ + tNodePtr->ptr.eventPtr = eventPtr; + + objPtr = Tcl_NewObj(); + objPtr->internalRep.otherValuePtr = (VOID *) tNodePtr; + objPtr->typePtr = &NodeObjType; + + objPtr->bytes = Tcl_Alloc(strlen(tNodePtr->token) + 1); + strcpy(objPtr->bytes, tNodePtr->token); + objPtr->length = strlen(objPtr->bytes); + + NodeAddObjRef(tNodePtr, objPtr); + + eventPtr->type = type; + if (type == TCLDOM_EVENT_USERDEFINED) { + eventPtr->typeObjPtr = typeObjPtr; + Tcl_IncrRefCount(eventPtr->typeObjPtr); + } else { + eventPtr->typeObjPtr = NULL; + } + + eventPtr->stopPropagation = 0; + eventPtr->preventDefault = 0; + eventPtr->dispatched = 0; + + eventPtr->altKey = Tcl_NewObj(); + Tcl_IncrRefCount(eventPtr->altKey); + eventPtr->attrName = Tcl_NewObj(); + Tcl_IncrRefCount(eventPtr->attrName); + eventPtr->attrChange = Tcl_NewObj(); + Tcl_IncrRefCount(eventPtr->attrChange); + eventPtr->bubbles = Tcl_NewIntObj(1); + Tcl_IncrRefCount(eventPtr->bubbles); + eventPtr->button = Tcl_NewObj(); + Tcl_IncrRefCount(eventPtr->button); + eventPtr->cancelable = Tcl_NewIntObj(1); + Tcl_IncrRefCount(eventPtr->cancelable); + eventPtr->clientX = Tcl_NewObj(); + Tcl_IncrRefCount(eventPtr->clientX); + eventPtr->clientY = Tcl_NewObj(); + Tcl_IncrRefCount(eventPtr->clientY); + eventPtr->ctrlKey = Tcl_NewObj(); + Tcl_IncrRefCount(eventPtr->ctrlKey); + eventPtr->currentNode = Tcl_NewObj(); + Tcl_IncrRefCount(eventPtr->currentNode); + eventPtr->detail = Tcl_NewObj(); + Tcl_IncrRefCount(eventPtr->detail); + eventPtr->eventPhase = Tcl_NewObj(); + Tcl_IncrRefCount(eventPtr->eventPhase); + eventPtr->metaKey = Tcl_NewObj(); + Tcl_IncrRefCount(eventPtr->metaKey); + eventPtr->newValue = Tcl_NewObj(); + Tcl_IncrRefCount(eventPtr->newValue); + eventPtr->prevValue = Tcl_NewObj(); + Tcl_IncrRefCount(eventPtr->prevValue); + eventPtr->relatedNode = Tcl_NewObj(); + Tcl_IncrRefCount(eventPtr->relatedNode); + eventPtr->screenX = Tcl_NewObj(); + Tcl_IncrRefCount(eventPtr->screenX); + eventPtr->screenY = Tcl_NewObj(); + Tcl_IncrRefCount(eventPtr->screenY); + eventPtr->shiftKey = Tcl_NewObj(); + Tcl_IncrRefCount(eventPtr->shiftKey); + eventPtr->target = Tcl_NewObj(); + Tcl_IncrRefCount(eventPtr->target); + + /* Timestamping of DOM events is not available in Tcl 8.3.x. + * The required API (Tcl_GetTime) is public only since 8.4.0. + */ + + eventPtr->timeStamp = Tcl_NewLongObj(0); +#if (TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION > 3)) + { + Tcl_Time time; + + Tcl_GetTime(&time); + Tcl_SetLongObj(eventPtr->timeStamp, time.sec*1000 + time.usec/1000); + } +#endif + Tcl_IncrRefCount(eventPtr->timeStamp); + + eventPtr->view = Tcl_NewObj(); + Tcl_IncrRefCount(eventPtr->view); + + return objPtr; +} +/* + *---------------------------------------------------------------------------- + * + * TclDOMEventCommandDelete -- + * + * Invoked when a DOM event node's Tcl command is deleted. + * + * Results: + * Destroy the node. + * + * Side effects: + * Frees memory. + * + *---------------------------------------------------------------------------- + */ + +void +TclDOMEventCommandDelete (clientData) +ClientData clientData; +{ + TclDOM_libxml2_Node *tNodePtr = (TclDOM_libxml2_Node *) clientData; + TclDOM_libxml2_Event *eventPtr; + + if (tNodePtr->type != TCLDOM_LIBXML2_NODE_EVENT) { + return; /* internal error. should this panic? */ + } + eventPtr = tNodePtr->ptr.eventPtr; + + if (eventPtr->typeObjPtr) { + Tcl_DecrRefCount(eventPtr->typeObjPtr); + } + if (eventPtr->altKey) { + Tcl_DecrRefCount(eventPtr->altKey); + } + if (eventPtr->attrName) { + Tcl_DecrRefCount(eventPtr->attrName); + } + if (eventPtr->attrChange) { + Tcl_DecrRefCount(eventPtr->attrChange); + } + if (eventPtr->bubbles) { + Tcl_DecrRefCount(eventPtr->bubbles); + } + if (eventPtr->button) { + Tcl_DecrRefCount(eventPtr->button); + } + if (eventPtr->cancelable) { + Tcl_DecrRefCount(eventPtr->cancelable); + } + if (eventPtr->clientX) { + Tcl_DecrRefCount(eventPtr->clientX); + } + if (eventPtr->clientY) { + Tcl_DecrRefCount(eventPtr->clientY); + } + if (eventPtr->ctrlKey) { + Tcl_DecrRefCount(eventPtr->ctrlKey); + } + if (eventPtr->currentNode) { + Tcl_DecrRefCount(eventPtr->currentNode); + } + if (eventPtr->detail) { + Tcl_DecrRefCount(eventPtr->detail); + } + if (eventPtr->eventPhase) { + Tcl_DecrRefCount(eventPtr->eventPhase); + } + if (eventPtr->metaKey) { + Tcl_DecrRefCount(eventPtr->metaKey); + } + if (eventPtr->newValue) { + Tcl_DecrRefCount(eventPtr->newValue); + } + if (eventPtr->prevValue) { + Tcl_DecrRefCount(eventPtr->prevValue); + } + if (eventPtr->relatedNode) { + Tcl_DecrRefCount(eventPtr->relatedNode); + } + if (eventPtr->screenX) { + Tcl_DecrRefCount(eventPtr->screenX); + } + if (eventPtr->screenY) { + Tcl_DecrRefCount(eventPtr->screenY); + } + if (eventPtr->shiftKey) { + Tcl_DecrRefCount(eventPtr->shiftKey); + } + if (eventPtr->target) { + Tcl_DecrRefCount(eventPtr->target); + } + if (eventPtr->timeStamp) { + Tcl_DecrRefCount(eventPtr->timeStamp); + } + if (eventPtr->view) { + Tcl_DecrRefCount(eventPtr->view); + } + + /* Invalidates all referring objects and frees all data structures */ + TclDOM_libxml2_DeleteNode((ClientData) tNodePtr); +} + diff --git a/tcldom-libxml2.tcl b/tcldom-libxml2.tcl new file mode 100644 index 0000000..d5ef415 --- /dev/null +++ b/tcldom-libxml2.tcl @@ -0,0 +1,37 @@ +# impl.tcl -- +# +# Support script for libxml2 implementation. +# +# Std disclaimer +# +# $Id: tcldom-libxml2.tcl,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $ + +namespace eval ::dom { + variable strictDOM 1 +} + +proc dom::libxml2::parse {xml args} { + + array set options { + -keep normal + -retainpath /* + } + array set options $args + + if {[catch {eval ::xml::parser -parser libxml2 [array get options]} parser]} { + return -code error "unable to create XML parser due to \"$parser\"" + } + + if {[catch {$parser parse $xml} msg]} { + return -code error $msg + } + + set doc [$parser get document] + set dom [dom::libxml2::adoptdocument $doc] + $parser free + + return $dom +} +proc dom::parse {xml args} { + return [eval ::dom::libxml2::parse [list $xml] $args] +} diff --git a/tcldom-tcl/dom.tcl b/tcldom-tcl/dom.tcl new file mode 100644 index 0000000..b3edc99 --- /dev/null +++ b/tcldom-tcl/dom.tcl @@ -0,0 +1,4291 @@ +# dom.tcl -- +# +# This file implements the Tcl language binding for the DOM - +# the Document Object Model. Support for the core specification +# is given here. Layered support for specific languages, +# such as HTML, will be in separate modules. +# +# Copyright (c) 1998-2004 Zveno Pty Ltd +# http://www.zveno.com/ +# +# See the file "LICENSE" in this distribution for information on usage and +# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# $Id: dom.tcl,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $ + +# We need the xml package, so that we get Name defined + +package require xml 3.0 + +package provide dom::tcl 3.0 + +# Define generic constants + +namespace eval dom { + namespace export DOMImplementation + namespace export hasFeature createDocument create createDocumentType + namespace export createNode destroy isNode parse selectNode serialize + namespace export trim + + namespace export document documentFragment node + namespace export element textNode attribute + namespace export processingInstruction + namespace export documenttype + namespace export event + + variable maxSpecials + if {![info exists maxSpecials]} { + set maxSpecials 10 + } + + variable strictDOM 0 + + # Default -indentspec value + # spaces-per-indent-level {collapse-re collapse-value} + variable indentspec [list 2 [list { } \t]] + + # The Namespace URI for XML Namespace declarations + variable xmlnsURI http://www.w3.org/2000/xmlns/ + + # DOM Level 2 Event defaults + variable bubbles + array set bubbles { + DOMFocusIn 1 + DOMFocusOut 1 + DOMActivate 1 + click 1 + mousedown 1 + mouseup 1 + mouseover 1 + mousemove 1 + mouseout 1 + DOMSubtreeModified 1 + DOMNodeInserted 1 + DOMNodeRemoved 1 + DOMNodeInsertedIntoDocument 0 + DOMNodeRemovedFromDocument 0 + DOMAttrModified 1 + DOMAttrRemoved 1 + DOMCharacterDataModified 1 + } + variable cancelable + array set cancelable { + DOMFocusIn 0 + DOMFocusOut 0 + DOMActivate 1 + click 1 + mousedown 1 + mouseup 1 + mouseover 1 + mousemove 0 + mouseout 1 + DOMSubtreeModified 0 + DOMNodeInserted 0 + DOMNodeRemoved 0 + DOMNodeInsertedIntoDocument 0 + DOMNodeRemovedFromDocument 0 + DOMAttrModified 0 + DOMAttrRemoved 0 + DOMCharacterDataModified 0 + } +} + +namespace eval dom::tcl { + namespace export DOMImplementation + namespace export hasFeature createDocument create createDocumentType + namespace export createNode destroy isNode parse selectNode serialize + namespace export trim + + namespace export document documentFragment node + namespace export element textNode attribute + namespace export processingInstruction + namespace export event +} + +foreach p {DOMImplementation hasFeature createDocument create createDocumentType createNode destroy isNode parse selectNode serialize trim document documentFragment node element textNode attribute processingInstruction event documenttype} { + + proc dom::$p args "return \[eval tcl::$p \$args\]" + +} + +# Data structures +# +# Documents are stored in a Tcl namespace within the ::dom namespace. +# The Document array variable stores data for the document itself. +# Each node has an array variable for its data. +# +# "Live" data objects are stored as a separate Tcl variable. +# Lists, such as child node lists, are Tcl list variables (ie scalar) +# and keyed-value lists, such as attribute lists, are Tcl array +# variables. The accessor function returns the variable name, +# which the application should treat as a read-only object. +# +# A token is a FQ Tcl variable name. + +# dom::tcl::DOMImplementation -- +# +# Implementation-dependent functions. +# Most importantly, this command provides a function to +# create a document instance. +# +# Arguments: +# method method to invoke +# token token for node +# args arguments for method +# +# Results: +# Depends on method used. + +namespace eval dom::tcl { + variable DOMImplementationOptions {} + variable DOMImplementationCounter + if {![info exists DOMImplementationCounter]} { + set DOMImplementationCounter 0 + } +} + +proc dom::tcl::DOMImplementation {method args} { + variable DOMImplementationOptions + variable DOMImplementationCounter + + switch -- $method { + + hasFeature { + + if {[llength $args] != 2} { + return -code error "wrong # args: should be dom::DOMImplementation method args..." + } + + # Later on, could use Tcl package facility + if {[regexp {create|destroy|parse|query|serialize|trim|Events|UIEvents|isNode} [lindex $args 0]]} { + if {![string compare [lindex $args 1] "1.0"]} { + return 1 + } else { + return 0 + } + } else { + return 0 + } + + } + + createDocument { + # createDocument introduced in DOM Level 2 + + if {[llength $args] != 3} { + return -code error "wrong # args: should be DOMImplementation nsURI name doctype" + } + + set doc [DOMImplementation create] + + if {[string length [lindex $args 2]]} { + array set $doc [list document:doctype [lindex $args 2]] + } + + document createElementNS $doc [lindex $args 0] [lindex $args 1] + + return $doc + } + + create { + + # Non-standard method (see createDocument) + # Bootstrap a document instance + + if {[llength $args] > 0} { + return -code error "wrong # args: should be DOMImplementation create" + } + + # Allocate unique document array name + set ns [namespace current]::document[incr DOMImplementationCounter] + set name ${ns}::Document + + # Create the Tcl namespace for this document + namespace eval $ns { + namespace export Document + } + + set varPrefix ${name}var + set arrayPrefix ${name}arr + + array set $name [list counter 1 \ + node:nodeType document \ + node:parentNode {} \ + node:nodeName #document \ + node:nodeValue {} \ + node:childNodes ${varPrefix}1 \ + documentFragment:masterDoc $name \ + document:implementation [namespace current]::DOMImplementation \ + document:xmldecl {version 1.0} \ + document:documentElement {} \ + document:doctype {} \ + ] + + # Initialise child node list + set $varPrefix {} + + # Create a Tcl command for the document + proc $name {method args} "return \[eval [namespace current]::document \[list \$method\] $name \$args\]" + + # Capture destruction of the document + trace add command $name delete [namespace code [list Document:Delete $name]] + + # Return the new toplevel node + return $name + } + + createDocumentType { + # Introduced in DOM Level 2 + + # Patch from c.l.t., Richard Calmbach (rc@hnc.com ) + + if {[llength $args] < 3 || [llength $args] > 4} { + return -code error "wrong # args: should be: DOMImplementation createDocumentType qname publicid systemid ?internaldtd?" + } + + return [eval CreateDocType $args] + } + + createNode { + # Non-standard method + # Creates node(s) in the given document given an XPath expression + + if {[llength $args] != 2} { + return -code error "wrong # args: should be dom::DOMImplementation createNode xpath" + } + + package require xpath + + return [XPath:CreateNode [lindex $args 0] [lindex $args 1]] + } + + destroy { + + # Free all memory associated with a node + + if {[llength $args] != 1} { + return -code error "wrong # args: should be dom::DOMImplementation destroy token" + } + + if {[catch {upvar #0 [lindex $args 0] node}]} { + # If the document is being destroyed then the Tcl namespace no longer exists + return {} + } + + switch $node(node:nodeType) { + + document - + documentFragment { + + if {[string length $node(node:parentNode)]} { + unset $node(node:childNodes) + + # Dispatch events + event postMutationEvent $node(node:parentNode) DOMSubtreeModified + + return {} + } + + # else this is the root document node, + # and we can optimize the cleanup. + # No need to dispatch events. + + # First remove all command traces + foreach nodecmd [info commands [namespace qualifiers [lindex $args 0]]::*] { + trace remove command $nodecmd delete [namespace code [list Node:Delete $nodecmd]] + } + + namespace delete [namespace qualifiers [lindex $args 0]] + } + + documentType { + trace remove command [lindex $args 0] delete [namespace code [list DocumentType:Delete [lindex $args 0]]] + rename [lindex $args 0] {} + unset [lindex $args 0] + } + + element { + # First make sure the node is removed from the tree + if {[string length $node(node:parentNode)]} { + node removeChild $node(node:parentNode) [lindex $args 0] + } + unset $node(node:childNodes) + unset $node(element:attributeList) + unset node + set name [lindex $args 0] + trace remove command $name delete [namespace code [list Node:Delete $name]] + rename $name {} + + # Don't dispatch events here - + # already done by removeChild + } + + event { + set name [lindex $args 0] + trace remove command $name delete [namespace code [list Node:Delete $name]] + rename $name {} + unset node + } + + default { + # Store the parent for later + set parent $node(node:parentNode) + + # First make sure the node is removed from the tree + if {[string length $node(node:parentNode)]} { + node removeChild $node(node:parentNode) [lindex $args 0] + } + unset node + set name [lindex $args 0] + trace remove command $name delete [namespace code [list Node:Delete $name]] + rename $name {} + + # Dispatch events + event postMutationEvent $parent DOMSubtreeModified + + } + + } + + return {} + + } + + isNode { + # isNode - non-standard method + # Sometimes it is useful to check if an arbitrary string + # refers to a DOM node + + upvar #0 [lindex $args 0] node + + if {![info exists node]} { + return 0 + } elseif {[info exists node(node:nodeType)]} { + return 1 + } else { + return 0 + } + } + + parse { + + # This implementation uses TclXML version 2.0. + # TclXML can choose the best installed parser. + + if {[llength $args] < 1} { + return -code error "wrong # args: should be dom::DOMImplementation parse xml ?args...?" + } + + array set opts {-parser {} -progresscommand {} -chunksize 8196} + if {[catch {array set opts [lrange $args 1 end]}]} { + return -code error "bad configuration options" + } + + # Create a state array for this parse session + set state [namespace current]::parse[incr DOMImplementationCounter] + array set $state [array get opts -*] + array set $state [list progCounter 0] + set errorCleanup {} + + if {[string length $opts(-parser)]} { + set parserOpt [list -parser $opts(-parser)] + } else { + set parserOpt {} + } + if {[catch {package require xml} version]} { + eval $errorCleanup + return -code error "unable to load XML parsing package" + } + set parser [eval xml::parser $parserOpt] + + $parser configure \ + -elementstartcommand [namespace code [list ParseElementStart $state]] \ + -elementendcommand [namespace code [list ParseElementEnd $state]] \ + -characterdatacommand [namespace code [list ParseCharacterData $state]] \ + -processinginstructioncommand [namespace code [list ParseProcessingInstruction $state]] \ + -commentcommand [namespace code [list ParseComment $state]] \ + -entityreferencecommand [namespace code [list ParseEntityReference $state]] \ + -xmldeclcommand [namespace code [list ParseXMLDeclaration $state]] \ + -doctypecommand [namespace code [list ParseDocType $state]] \ + -final 1 + + # Create top-level document + array set $state [list docNode [DOMImplementation create]] + array set $state [list current [lindex [array get $state docNode] 1]] + + # Parse data + # Bug in TclExpat - doesn't handle non-final inputs + if {0 && [string length $opts(-progresscommand)]} { + $parser configure -final false + while {[string length [lindex $args 0]]} { + $parser parse [string range [lindex $args 0] 0 $opts(-chunksize)] + set args [lreplace $args 0 0 \ + [string range [lindex $args 0] $opts(-chunksize) end]] + uplevel #0 $opts(-progresscommand) + } + $parser configure -final true + } elseif {[catch {$parser parse [lindex $args 0]} err]} { + catch {rename $parser {}} + catch {unset $state} + return -code error $err + } + + # Free data structures which are no longer required + $parser free + catch {rename $parser {}} + + set doc [lindex [array get $state docNode] 1] + unset $state + return $doc + + } + + selectNode { + # Non-standard method + # Returns nodeset in the given document matching an XPath expression + + if {[llength $args] != 2} { + return -code error "wrong # args: should be dom::DOMImplementation selectNode token xpath" + } + + package require xpath + + return [XPath:SelectNode [lindex $args 0] [lindex $args 1]] + } + + serialize { + + if {[llength $args] < 1} { + return -code error "wrong # args: should be dom::DOMImplementation serialize token" + } + + upvar #0 [lindex $args 0] node + + return [eval [list Serialize:$node(node:nodeType)] $args] + + } + + trim { + + # Removes textNodes that only contain white space + + if {[llength $args] != 1} { + return -code error "wrong # args: should be dom::DOMImplementation trim token" + } + + Trim [lindex $args 0] + + # Dispatch DOMSubtreeModified event once here? + + return {} + + } + + default { + return -code error "unknown method \"$method\"" + } + + } + + return {} +} + +namespace eval dom::tcl { + foreach method {hasFeature createDocument create createDocumentType createNode destroy isNode parse selectNode serialize trim} { + proc $method args "eval [namespace current]::DOMImplementation $method \$args" + } +} + +# dom::tcl::Document:Delete -- +# +# Handle destruction of a document +# +# Arguments: +# name document token +# old ) +# new ) args added by trace command +# op ) + +proc dom::tcl::Document:Delete {name old new op} { + DOMImplementation destroy $name + return {} +} + +# dom::tcl::document -- +# +# Functions for a document node. +# +# Arguments: +# method method to invoke +# token token for node +# args arguments for method +# +# Results: +# Depends on method used. + +namespace eval dom::tcl { + variable documentOptionsRO doctype|implementation|documentElement + variable documentOptionsRW actualEncoding|encoding|standalone|version +} + +proc dom::tcl::document {method token args} { + variable documentOptionsRO + variable documentOptionsRW + + upvar #0 $token node + + set result {} + + switch -- $method { + cget { + if {[llength $args] != 1} { + return -code error "wrong # args: should be \"dom::document method token ?args ...?\"" + } + if {[regexp [format {^-(%s)$} $documentOptionsRO] [lindex $args 0] discard option]} { + return $node(document:$option) + } elseif {[regexp [format {^-(%s)$} $documentOptionsRW] [lindex $args 0] discard option]} { + switch -- $option { + encoding - + version - + standalone { + array set xmldecl $node(document:xmldecl) + return $xmldecl($option) + } + default { + return $node(document:$option) + } + } + } else { + return -code error "bad option \"[lindex $args 0]\"" + } + } + configure { + if {[llength $args] == 1} { + return [document cget $token [lindex $args 0]] + } elseif {[expr [llength $args] % 2]} { + return -code error "no value specified for option \"[lindex $args end]\"" + } else { + foreach {option value} $args { + if {[regexp [format {^-(%s)$} $documentOptionsRW] $option discard opt]} { + switch -- $opt { + encoding { + catch {unset xmldecl} + array set xmldecl $node(document:xmldecl) + set xmldecl(encoding) $value + set node(document:xmldecl) [array get xmldecl] + } + standalone { + if {[string is boolean $value]} { + catch {unset xmldecl} + array set xmldecl $node(document:xmldecl) + if {[string is true $value]} { + set xmldecl(standalone) yes + } else { + set xmldecl(standalone) no + } + set node(document:xmldecl) [array get xmldecl] + } else { + return -code error "unsupported value for option \"$option\" - must be boolean" + } + } + version { + if {$value == "1.0"} { + catch {unset xmldecl} + array set xmldecl $node(document:xmldecl) + set xmldecl(version) $value + set node(document:xmldecl) [array get xmldecl] + } else { + return -code error "unsupported value for option \"$option\"" + } + } + default { + set node(document:$opt) $value + } + } + } elseif {[regexp [format {^-(%s)$} $documentOptionsRO] $option discard opt]} { + return -code error "attribute \"$option\" is read-only" + } else { + return -code error "bad option \"$option\"" + } + } + } + } + + createElement { + if {[llength $args] != 1} { + return -code error "wrong # args: should be \"document createElement token name\"" + } + + # Check that the element name is kosher + if {![regexp ^$::xml::Name\$ [lindex $args 0]]} { + return -code error "invalid element name \"[lindex $args 0]\"" + } + + # Invoke internal factory function + set result [CreateElement $token [lindex $args 0] {}] + + } + createDocumentFragment { + if {[llength $args]} { + return -code error "wrong # args: should be \"document createDocumentFragment token\"" + } + + set result [CreateGeneric $token node:nodeType documentFragment node:nodeName #document-fragment node:nodeValue {}] + } + createTextNode { + if {[llength $args] != 1} { + return -code error "wrong # args: should be \"document createTextNode token text\"" + } + + set result [CreateTextNode $token [lindex $args 0]] + } + createComment { + if {[llength $args] != 1} { + return -code error "wrong # args: should be \"document createComment token data\"" + } + + set result [CreateGeneric $token node:nodeType comment node:nodeName #comment node:nodeValue [lindex $args 0]] + } + createCDATASection { + if {[llength $args] != 1} { + return -code error "wrong # args: should be \"document createCDATASection token data\"" + } + + set result [CreateTextNode $token [lindex $args 0]] + node configure $result -cdatasection 1 + } + createProcessingInstruction { + if {[llength $args] != 2} { + return -code error "wrong # args: should be \"document createProcessingInstruction token target data\"" + } + + set result [CreateGeneric $token node:nodeType processingInstruction \ + node:nodeName [lindex $args 0] node:nodeValue [lindex $args 1]] + } + createAttribute { + if {[llength $args] != 1} { + return -code error "wrong # args: should be \"document createAttributes token name\"" + } + + # Check that the attribute name is kosher + if {![regexp ^$::xml::Name\$ [lindex $args 0]]} { + return -code error "invalid attribute name \"[lindex $args 0]\"" + } + + set result [CreateGeneric $token node:nodeType attribute node:nodeName [lindex $args 0]] + } + createEntity { + set result [CreateGeneric $token node:nodeType entity] + } + createEntityReference { + if {[llength $args] != 1} { + return -code error "wrong # args: should be \"document createEntityReference token name\"" + } + set result [CreateGeneric $token node:nodeType entityReference node:nodeName [lindex $args 0]] + } + + importNode { + # Introduced in DOM Level 2 + + if {[llength $args] < 1} { + return -code error "wrong # args: should be \"importNode token ?-deep boolean?\"" + } + array set opts { + -deep 1 + } + array set opts [lrange $args 1 end] + set opts(-deep) [Boolean $opts(-deep)] + + if {[namespace qualifiers [lindex $args 0]] == [namespace qualifiers $token]} { + return -code error "source node \"[lindex $args 0]\" is in the same document" + } + + switch [node cget [lindex $args 0] -nodeType] { + document - + documentType { + return -code error "node type \"[node cget [lindex $args 0] -type]\" cannot be imported" + } + documentFragment { + set result [document createDocumentFragment $token] + if {$opts(-deep)} { + foreach child [node children [lindex $args 0]] { + $result appendChild [$token importNode $child -deep 1] + } + } + } + element { + set result [CreateElement {} [node cget [lindex $args 0] -nodeName] [array get [node cget [lindex $args 0] -attributes]] -document $token] + if {$opts(-deep)} { + foreach child [node children [lindex $args 0]] { + $result appendChild [$token importNode $child -deep 1] + } + } + } + textNode { + set result [CreateTextNode {} [node cget [lindex $args 0] -nodeValue] -document $token] + } + attribute - + processingInstruction - + comment { + set result [CreateGeneric {} -document $token node:nodeType [node cget [lindex $args 0] -nodeType] node:nodeName [node cget [lindex $args 0] -nodeName] node:nodeValue [node cget [lindex $args 0] -nodeValue]] + } + } + } + + createElementNS { + # Introduced in DOM Level 2 + + if {[llength $args] != 2} { + return -code error "wrong # args: should be: \"createElementNS nsuri qualname\"" + } + + # Check that the qualified name is kosher + if {[catch {foreach {prefix localname} [::xml::qnamesplit [lindex $args 1]] break} err]} { + return -code error "invalid qualified name \"[lindex $args 1]\" due to \"$err\"" + } + + # Invoke internal factory function + set result [CreateElement $token [lindex $args 1] {} -prefix $prefix -namespace [lindex $args 0] -localname $localname] + } + + createAttributeNS { + # Introduced in DOM Level 2 + + return -code error "not yet implemented" + } + + getElementsByTagNameNS { + # Introduced in DOM Level 2 + + return -code error "not yet implemented" + } + + getElementsById { + # Introduced in DOM Level 2 + + return -code error "not yet implemented" + } + + createEvent { + # Introduced in DOM Level 2 + + if {[llength $args] != 1} { + return -code error "wrong # args: should be \"document createEvent token type\"" + } + + set result [CreateEvent $token [lindex $args 0]] + + } + + getElementsByTagName { + if {[llength $args] < 1} { + return -code error "wrong # args: should be \"document getElementsByTagName token what\"" + } + + return [eval Element:GetByTagName [list $token [lindex $args 0]] \ + [lrange $args 1 end]] + } + + default { + return -code error "unknown method \"$method\"" + } + + } + + # Dispatch events + + # Node insertion events are generated here instead of the + # internal factory procedures. This is because the factory + # procedures are meant to be mean-and-lean during the parsing + # phase, and dispatching events at that time would be an + # excessive overhead. The factory methods here are pretty + # heavyweight anyway. + + if {[string match create* $method] && [string compare $method "createEvent"]} { + + event postMutationEvent $result DOMNodeInserted -relatedNode $token + event postMutationEvent $result DOMNodeInsertedIntoDocument + event postMutationEvent $token DOMSubtreeModified + + } + + return $result +} + +### Factory methods +### +### These are lean-and-mean for fastest possible tree building + +# dom::tcl::CreateElement -- +# +# Append an element to the given (parent) node (if any) +# +# Arguments: +# token parent node (if empty -document option is mandatory) +# name element name (no checking performed here) +# aList attribute list +# args configuration options +# +# Results: +# New node created, parent optionally modified + +proc dom::tcl::CreateElement {token name aList args} { + array set opts $args + + if {[string length $token]} { + upvar #0 $token parent + upvar #0 [namespace qualifiers $token]::Document document + set child [namespace qualifiers $token]::node[incr document(counter)] + } elseif {[info exists opts(-document)]} { + upvar #0 $opts(-document) document + set child [namespace qualifiers $opts(-document)]::node[incr document(counter)] + } else { + return -code error "no parent or document specified" + } + + upvar #0 $child new + + # Create the new node + # NB. normally we'd use Node:create here, + # but inline it instead for performance + array set new [list \ + node:parentNode $token \ + node:childNodes ${child}var \ + node:nodeType element \ + node:nodeName $name \ + node:namespaceURI {} \ + node:prefix {} \ + node:localName $name \ + node:nodeValue {} \ + element:attributeList ${child}arr \ + element:attributeNodes {} \ + ] + + catch {set new(node:namespaceURI) $opts(-namespace)} + catch {set new(node:localName) $opts(-localname)} + catch {set new(node:prefix) $opts(-prefix)} + + # Initialise associated variables + set ${child}var {} + array set ${child}arr $aList + catch { + foreach {ns nsAttrList} $opts(-namespaceattributelists) { + foreach {attrName attrValue} $nsAttrList { + array set ${child}arr [list $ns^$attrName $attrValue] + } + } + } + + # Update parent record + + # Does this element qualify as the document element? + # If so, then has a document element already been set? + + if {[string length $token] && + [string equal $parent(node:nodeType) document]} { + + if {$token == $parent(documentFragment:masterDoc)} { + if {[info exists parent(document:documentElement)] && \ + [string length $parent(document:documentElement)]} { + # Do not attach to the tree + set new(node:parentNode) {} + } else { + + # Check against document type decl + if {[string length $parent(document:doctype)]} { + upvar #0 $parent(document:doctype) doctypedecl + if {[string compare $name $doctypedecl(doctype:name)]} { + return -code error "mismatch between root element type in document type declaration \"$doctypedecl(doctype:name)\" and root element \"$name\"" + } + + } else { + # Synthesize document type declaration + set doctype [CreateDocType $name {} {}] + set document(document:doctype) $doctype + } + + set parent(document:documentElement) $child + catch {lappend $parent(node:childNodes) $child} + } + } else { + catch {lappend $parent(node:childNodes) $child} + } + } else { + catch {lappend $parent(node:childNodes) $child} + } + + proc $child {method args} "return \[eval [namespace current]::node \[list \$method\] $child \$args\]" + trace add command $child delete [namespace code [list Node:Delete $child]] + + return $child +} + +# dom::tcl::CreateTextNode -- +# +# Append a textNode node to the given (parent) node (if any). +# +# This factory function can also be performed by +# CreateGeneric, but text nodes are created so often +# that this specific factory procedure speeds things up. +# +# Arguments: +# token parent node (if empty -document option is mandatory) +# text initial text +# args additional configuration options +# +# Results: +# New node created, parent optionally modified + +proc dom::tcl::CreateTextNode {token text args} { + array set opts $args + + if {[string length $token]} { + upvar #0 $token parent + upvar #0 [namespace qualifiers $token]::Document document + set child [namespace qualifiers $token]::node[incr document(counter)] + } elseif {[info exists opts(-document)]} { + upvar #0 $opts(-document) document + set child [namespace qualifiers $opts(-document)]::node[incr document(counter)] + } else { + return -code error "no parent or document specified" + } + + upvar #0 $child new + + # Create the new node + # NB. normally we'd use Node:create here, + # but inline it instead for performance + + # Text nodes never have children, so don't create a variable + + array set new [list \ + node:parentNode $token \ + node:childNodes ${child}var \ + node:nodeType textNode \ + node:nodeValue $text \ + node:nodeName #text \ + node:cdatasection 0 \ + ] + + set ${child}var {} + + # Update parent record + catch {lappend $parent(node:childNodes) $child} + + proc $child {method args} "return \[eval [namespace current]::node \[list \$method\] $child \$args\]" + trace add command $child delete [namespace code [list Node:Delete $child]] + + return $child +} + +# dom::tcl::CreateGeneric -- +# +# This is a template used for type-specific factory procedures +# +# Arguments: +# token parent node (if empty -document option is mandatory) +# args optional values +# +# Results: +# New node created, parent modified + +proc dom::tcl::CreateGeneric {token args} { + array set opts $args + + if {[string length $token]} { + upvar #0 $token parent + upvar #0 [namespace qualifiers $token]::Document document + set child [namespace qualifiers $token]::node[incr document(counter)] + } elseif {[info exists opts(-document)]} { + upvar #0 $opts(-document) document + set child [namespace qualifiers $opts(-document)]::node[incr document(counter)] + } else { + return -code error "no parent or document specified" + } + upvar #0 $child new + + # Create the new node + # NB. normally we'd use Node:create here, + # but inline it instead for performance + array set new [eval list [list \ + node:parentNode $token \ + node:childNodes ${child}var ] \ + $args \ + ] + set ${child}var {} + + switch -glob -- [string length $token],$opts(node:nodeType) { + 0,* - + *,attribute - + *,namespace { + # These type of nodes are not children of their parent + } + + default { + # Update parent record + lappend $parent(node:childNodes) $child + } + } + + proc $child {method args} "return \[eval [namespace current]::node \[list \$method\] $child \$args\]" + trace add command $child delete [namespace code [list Node:Delete $child]] + + return $child +} + +### Specials + +# dom::tcl::CreateDocType -- +# +# Create a Document Type Declaration node. +# +# Arguments: +# name root element type +# publicid public identifier +# systemid system identifier +# internaldtd internal DTD subset +# +# Results: +# Returns node id of the newly created node. + +proc dom::tcl::CreateDocType {name publicid systemid {internaldtd {}}} { + if {![regexp ^$::xml::QName\$ $name]} { + return -code error "invalid QName \"$name\"" + } + + set nodename [namespace current]::$name + upvar #0 $nodename doctype + if {[info exists doctype]} { + return $nodename + } + + if {[llength $internaldtd] == 1 && [string length [lindex $internaldtd 0]] == 0} { + set dtd {} + } + + array set doctype [list \ + node:childNodes {} \ + node:nodeType documentType \ + node:nodeName $name \ + node:nodeValue {} \ + doctype:name $name \ + doctype:entities {} \ + doctype:notations {} \ + doctype:publicId $publicid \ + doctype:systemId $systemid \ + doctype:internalSubset $internaldtd \ + ] + + proc $nodename {method args} "return \[eval [namespace current]::documenttype \[list \$method\] $nodename \$args\]" + trace add command $nodename delete [namespace code [list DocumentType:Delete $nodename]] + + return $nodename +} + +# dom::tcl::documenttype -- +# +# Functions for a document type declaration node. +# +# Arguments: +# method method to invoke +# token token for node +# args arguments for method +# +# Results: +# Depends on method used. + +namespace eval dom::tcl { + variable documenttypeOptionsRO name|entities|notations|publicId|systemId|internalSubset + variable documenttypeOptionsRW {} +} + +proc dom::tcl::documenttype {method token args} { + variable documenttypeOptionsRO + variable documenttypeOptionsRW + + upvar #0 $token node + + set result {} + + switch -- $method { + cget { + if {[llength $args] != 1} { + return -code error "wrong # args: should be \"dom::documenttype method token ?args ...?\"" + } + if {[regexp [format {^-(%s)$} $documenttypeOptionsRO] [lindex $args 0] discard option]} { + switch -- $option { + name { + return $node(node:nodeName) + } + default { + return $node(doctype:$option) + } + } + } elseif {[regexp [format {^-(%s)$} $documenttypeOptionsRW] [lindex $args 0] discard option]} { + return $node(doctype:$option) + } else { + return -code error "bad option \"[lindex $args 0]\"" + } + } + configure { + if {[llength $args] == 1} { + return [documenttype cget $token [lindex $args 0]] + } elseif {[expr [llength $args] % 2]} { + return -code error "no value specified for option \"[lindex $args end]\"" + } else { + foreach {option value} $args { + if {[regexp [format {^-(%s)$} $documenttypeOptionsRW] $option discard opt]} { + switch -- $opt { + default { + set node(doctype:$opt) $value + } + } + } elseif {[regexp [format {^-(%s)$} $documenttypeOptionsRO] $option discard opt]} { + return -code error "attribute \"$option\" is read-only" + } else { + return -code error "bad option \"$option\"" + } + } + } + } + } + + return $result +} + +# dom::tcl::DocumentType:Delete -- +# +# Handle node destruction +# +# Arguments: +# name node token +# old ) +# new ) arguments appended by trace command +# op ) +# +# Results: +# Node is destroyed + +proc dom::tcl::DocumentType:Delete {name old new op} { + DOMImplementation destroy $name +} + +# dom::tcl::node -- +# +# Functions for a general node. +# +# Implements EventTarget Interface - introduced in DOM Level 2 +# +# Arguments: +# method method to invoke +# token token for node +# args arguments for method +# +# Results: +# Depends on method used. + +namespace eval dom::tcl { + variable nodeOptionsRO nodeType|parentNode|childNodes|firstChild|lastChild|previousSibling|nextSibling|attributes|namespaceURI|prefix|localName|ownerDocument + variable nodeOptionsRW nodeValue|cdatasection + + # Allowing nodeName to be rw is not standard DOM. + # A validating implementation would have to be very careful + # in allowing this feature + if {$::dom::strictDOM} { + append nodeOptionsRO |nodeName + } else { + append nodeOptionsRW |nodeName + } +} +# NB. cdatasection is not a standard DOM option + +proc dom::tcl::node {method token args} { + variable nodeOptionsRO + variable nodeOptionsRW + + upvar #0 $token node + + set result {} + + switch -glob -- $method { + cg* { + # cget + + # Some read-only configuration options are computed + if {[llength $args] != 1} { + return -code error "wrong # args: should be \"dom::node cget token option\"" + } + if {[regexp [format {^-(%s)$} $nodeOptionsRO] [lindex $args 0] discard option]} { + switch $option { + nodeName { + set result $node(node:nodeName) + switch $node(node:nodeType) { + textNode { + catch {set result [expr {$node(node:cdatasection) ? "#cdata-section" : $node(node:nodeName)}]} + } + default { + } + } + } + childNodes { + # How are we going to handle documentElement? + set result $node(node:childNodes) + } + firstChild { + upvar #0 $node(node:childNodes) children + switch $node(node:nodeType) { + document { + set result [lindex $children 0] + catch {set result $node(document:documentElement)} + } + default { + set result [lindex $children 0] + } + } + } + lastChild { + upvar #0 $node(node:childNodes) children + switch $node(node:nodeType) { + document { + set result [lindex $children end] + catch {set result $node(document:documentElement)} + } + default { + set result [lindex $children end] + } + } + } + previousSibling { + # BUG: must take documentElement into account + # Find the parent node + upvar #0 $node(node:parentNode) parent + upvar #0 $parent(node:childNodes) children + set idx [lsearch $children $token] + if {$idx >= 0} { + set sib [lindex $children [incr idx -1]] + if {[llength $sib]} { + set result $sib + } else { + set result {} + } + } else { + set result {} + } + } + nextSibling { + # BUG: must take documentElement into account + # Find the parent node + upvar #0 $node(node:parentNode) parent + upvar #0 $parent(node:childNodes) children + set idx [lsearch $children $token] + if {$idx >= 0} { + set sib [lindex $children [incr idx]] + if {[llength $sib]} { + set result $sib + } else { + set result {} + } + } else { + set result {} + } + } + attributes { + if {[string compare $node(node:nodeType) element]} { + set result {} + } else { + set result $node(element:attributeList) + } + } + ownerDocument { + if {[string compare $node(node:parentNode) {}]} { + return [namespace qualifiers $token]::Document + } else { + return $token + } + } + default { + return [GetField node(node:$option)] + } + } + } elseif {[regexp [format {^-(%s)$} $nodeOptionsRW] [lindex $args 0] discard option]} { + return [GetField node(node:$option)] + } else { + return -code error "unknown option \"[lindex $args 0]\"" + } + } + co* { + # configure + + if {[llength $args] == 1} { + return [node cget $token [lindex $args 0]] + } elseif {[expr [llength $args] % 2]} { + return -code error "wrong \# args: should be \"::dom::node configure node option\"" + } else { + foreach {option value} $args { + if {[regexp [format {^-(%s)$} $nodeOptionsRW] $option discard opt]} { + + switch $opt,$node(node:nodeType) { + nodeValue,textNode - + nodeValue,processingInstruction { + # Dispatch event + set evid [CreateEvent $token DOMCharacterDataModified] + event initMutationEvent $evid DOMCharacterDataModified 1 0 {} $node(node:nodeValue) $value {} {} + set node(node:nodeValue) $value + node dispatchEvent $token $evid + DOMImplementation destroy $evid + } + default { + set node(node:$opt) $value + } + } + + } elseif {[regexp [format {^-(%s)$} $nodeOptionsRO] $option discard opt]} { + return -code error "attribute \"$option\" is read-only" + } else { + return -code error "unknown option \"$option\"" + } + } + } + } + + in* { + + # insertBefore + + # Previous and next sibling relationships are OK, + # because they are dynamically determined + + if {[llength $args] < 1 || [llength $args] > 2} { + return -code error "wrong # args: should be \"dom::node insertBefore token new ?ref?\"" + } + + upvar #0 [lindex $args 0] newChild + if {[string compare [namespace qualifiers [lindex $args 0]] [namespace qualifiers $token]]} { + return -code error "new node must be in the same document" + } + + switch [llength $args] { + 1 { + # Append as the last node + if {[string length $newChild(node:parentNode)]} { + node removeChild $newChild(node:parentNode) [lindex $args 0] + } + lappend $node(node:childNodes) [lindex $args 0] + set newChild(node:parentNode) $token + } + 2 { + upvar #0 [lindex $args 1] refChild + + if {[string compare [namespace qualifiers [lindex $args 1]] [namespace qualifiers [lindex $args 0]]]} { + return -code error "nodes must be in the same document" + } + set idx [lsearch [set $node(node:childNodes)] [lindex $args 1]] + if {$idx < 0} { + return -code error "no such reference child" + } else { + + # Remove from previous parent + if {[string length $newChild(node:parentNode)]} { + node removeChild $newChild(node:parentNode) [lindex $args 0] + } + + # Insert into new node + set $node(node:childNodes) \ + [linsert [set $node(node:childNodes)] $idx [lindex $args 0]] + set newChild(node:parentNode) $token + } + } + } + + event postMutationEvent [lindex $args 0] DOMNodeInserted -relatedNode $token + FireNodeInsertedEvents [lindex $args 0] + event postMutationEvent $token DOMSubtreeModified + + set result [lindex $args 0] + + } + + rep* { + + # replaceChild + + if {[llength $args] != 2} { + return -code error "wrong # args: should be \"dom::node replaceChild token new old\"" + } + + upvar #0 [lindex $args 0] newChild + upvar #0 [lindex $args 1] oldChild + upvar #0 $node(node:childNodes) children + + # Find where to insert new child + set idx [lsearch $children [lindex $args 1]] + if {$idx < 0} { + return -code error "no such old child" + } + + # Remove new child from current parent + if {[string length $newChild(node:parentNode)]} { + node removeChild $newChild(node:parentNode) [lindex $args 0] + } + + set children \ + [lreplace $children $idx $idx [lindex $args 0]] + set newChild(node:parentNode) $token + + # Update old child to reflect lack of parentage + set oldChild(node:parentNode) {} + + set result [lindex $args 1] + + event postMutationEvent [lindex $args 0] DOMNodeInserted -relatedNode $token + FireNodeInsertedEvents [lindex $args 0] + event postMutationEvent $token DOMSubtreeModified + + } + + removeC* { + + # removeChild + + if {[llength $args] != 1} { + return -code error "wrong # args: should be \"dom::node removeChild token child\"" + } + upvar #0 [lindex $args 0] oldChild + if {[string compare [namespace qualifiers [lindex $args 0]] [namespace qualifiers $token]]} { + return -code error "node \"[lindex $args 0]\" is not a child" + } + + # Remove the child from the parent + upvar #0 $node(node:childNodes) myChildren + if {[set idx [lsearch $myChildren [lindex $args 0]]] < 0} { + return -code error "node \"[lindex $args 0]\" is not a child" + } + set myChildren [lreplace $myChildren $idx $idx] + + # Update the child to reflect lack of parentage + set oldChild(node:parentNode) {} + + set result [lindex $args 0] + + # Event propagation has a problem here: + # Nodes that until recently were ancestors may + # want to capture the event, but we've just removed + # the parentage information. They get a DOMSubtreeModified + # instead. + event postMutationEvent [lindex $args 0] DOMNodeRemoved -relatedNode $token + FireNodeRemovedEvents [lindex $args 0] + event postMutationEvent $token DOMSubtreeModified + + } + + ap* { + + # appendChild + + if {[llength $args] != 1} { + return -code error "wrong # args: should be \"dom::node appendChild token child\"" + } + + # Add to new parent + node insertBefore $token [lindex $args 0] + + set result [lindex $args 0] + + } + + hasChildNodes { + set result [Min 1 [llength [set $node(node:childNodes)]]] + } + + isSameNode { + # Introduced in DOM Level 3 + switch [llength $args] { + 1 { + return [expr {$token == [lindex $args 0]}] + } + default { + return -code error "wrong # args: should be \"dom::node isSameNode token ref\"" + } + } + } + + cl* { + # cloneNode + + # May need to pay closer attention to generation of events here + + set deep 0 + switch [llength $args] { + 0 { + } + 2 { + foreach {opt value} $args { + switch -- $opt { + -deep { + set deep [Boolean $value] + } + default { + return -code error "bad option \"$opt\"" + } + } + } + } + default { + return -code error "wrong # args: should be \"dom::node cloneNode token ?-deep boolean?\"" + } + } + + switch $node(node:nodeType) { + element { + set result [CreateElement {} $node(node:nodeName) [array get $node(element:attributeList)] -document [namespace qualifiers $token]::Document] + if {$deep} { + foreach child [set $node(node:childNodes)] { + node appendChild $result [node cloneNode $child -deep 1] + } + } + } + textNode { + set result [CreateTextNode {} $node(node:nodeValue) -document [namespace qualifiers $token]::Document] + } + document { + set result [DOMImplementation create] + upvar #0 $result clonedDoc + array set clonedDoc [array get node document:doctype] + if {$deep} { + foreach child [set $node(node:childNodes)] { + node appendChild $result [document importNode $result $child -deep 1] + } + } + } + documentFragment - + default { + set result [CreateGeneric {} node:nodeType $node(node:nodeType) -document [namespace qualifiers $token]::Document] + if {$deep} { + foreach child [set $node(node:childNodes)] { + node appendChild $result [node cloneNode $child -deep 1] + } + } + } + } + } + + ch* { + # children -- non-standard method + + # If this is a textNode, then catch the error + set result {} + catch {set result [set $node(node:childNodes)]} + + } + + par* { + # parent -- non-standard method + + return $node(node:parentNode) + + } + + pat* { + # path -- non-standard method + + for { + set ancestor $token + upvar #0 $token ancestorNd + set result {} + } {[string length $ancestorNd(node:parentNode)]} { + set ancestor $ancestorNd(node:parentNode) + upvar #0 $ancestor ancestorNd + } { + set result [linsert $result 0 $ancestor] + } + # The last node is the document node + set result [linsert $result 0 $ancestor] + + } + + createNode { + # createNode -- non-standard method + + # Creates node(s) in this document given an XPath expression. + # Relative location paths have this node as their initial context. + + if {[llength $args] != 1} { + return -code error "wrong # args: should be \"dom::node createNode token path\"" + } + + package require xpath + + return [XPath:CreateNode $token [lindex $args 0]] + } + + selectNode { + # selectNode -- non-standard method + + # Returns nodeset in this document matching an XPath expression. + # Relative location paths have this node as their initial context. + + if {[llength $args] != 1} { + return -code error "wrong # args: should be \"dom::node selectNode token path\"" + } + + package require xpath + + return [XPath:SelectNode $token [lindex $args 0]] + } + + stringValue { + # stringValue -- non-standard method + # Returns string value of a node, as defined by XPath Rec. + + if {[llength $args] > 0} { + return -code error "wrong # args: should be \"dom::node stringValue token\"" + } + + switch $node(node:nodeType) { + document - + documentFragment - + element { + set value {} + foreach child [set $node(node:childNodes)] { + switch [node cget $child -nodeType] { + element - + textNode { + append value [node stringValue $child] + } + default { + # Other nodes are not considered + } + } + } + return $value + } + attribute - + textNode - + processingInstruction - + comment { + return $node(node:nodeValue) + } + default { + return {} + } + } + + } + + addEv* { + # addEventListener -- introduced in DOM Level 2 + + if {[llength $args] < 1} { + return -code error "wrong # args: should be \"dom::node addEventListener token type ?listener? ?option value...?\"" + } + + set type [lindex $args 0] + set args [lrange $args 1 end] + set listener [lindex $args 0] + if {[llength $args] == 1} { + set args {} + } elseif {[llength $args] > 1} { + if {[string match -* $listener]} { + set listener {} + } else { + set args [lrange $args 1 end] + } + } + array set opts {-usecapture 0} + if {[catch {array set opts $args}]} { + return -code error "missing value for option \"[lindex $args end]\"" + } + set opts(-usecapture) [Boolean $opts(-usecapture)] + set listenerType [expr {$opts(-usecapture) ? "capturer" : "listener"}] + + if {[string length $listener]} { + if {![info exists node(event:$type:$listenerType)] || \ + [lsearch $node(event:$type:$listenerType) $listener] < 0} { + lappend node(event:$type:$listenerType) $listener + } + # else avoid registering same listener twice + } else { + # List all listeners + set result {} + catch {set result $node(event:$type:$listenerType)} + return $result + } + } + + removeE* { + # removeEventListener -- introduced in DOM Level 2 + + if {[llength $args] < 2} { + return -code error "wrong # args: should be \"dom::node removeEventListener token type listener ?option value...?\"" + } + + set type [lindex $args 0] + set listener [lindex $args 1] + array set opts {-usecapture 0} + array set opts [lrange $args 2 end] + set opts(-usecapture) [Boolean $opts(-usecapture)] + set listenerType [expr {$opts(-usecapture) ? "capturer" : "listener"}] + + set idx [lsearch $node(event:$type:$listenerType) $listener] + if {$idx >= 0} { + set node(event:$type:$listenerType) [lreplace $node(event:$type:$listenerType) $idx $idx] + } + + } + + disp* { + # dispatchEvent -- introduced in DOM Level 2 + + # This is where the fun happens! + # Check to see if there one or more event listener, + # if so trigger the listener(s). + # Then pass the event up to the ancestor. + # This may be modified by event capturing and bubbling. + + if {[llength $args] != 1} { + return -code error "wrong # args: should be \"dom::node dispatchEvent token eventnode\"" + } + + set eventId [lindex $args 0] + upvar #0 $eventId event + set type $event(type) + + if {![string length $event(eventPhase)]} { + + # This is the initial dispatch of the event. + # First trigger any capturing event listeners + # Starting from the root, proceed downward + + set event(eventPhase) capturing_phase + set event(target) $token + + # DOM L2 specifies that the ancestors are determined + # at the moment of event dispatch, so using a static + # list is the correct thing to do + + foreach ancestor [lreplace [node path $token] end end] { + set event(currentNode) $ancestor + + upvar #0 $ancestor ancNode + + if {[info exists ancNode(event:$type:capturer)]} { + foreach capturer $ancNode(event:$type:capturer) { + if {[catch {uplevel #0 $capturer [list $eventId]} capturerError]} { + bgerror "error in capturer \"$capturerError\"" + } + } + + # A listener may stop propagation, + # but we check here to let all of the + # listeners at that level complete + + if {$event(cancelable) && $event(stopPropagation)} { + break + } + } + } + + # Prepare for next phase + set event(eventPhase) at_target + + } + + set event(currentNode) $token + + if {[info exists node(event:$type:listener)]} { + foreach listener $node(event:$type:listener) { + if {[catch {uplevel #0 $listener [list $eventId]} listenerError]} { + bgerror "error in listener \"$listenerError\"" + } + } + } + + set event(eventPhase) bubbling_phase + + # Now propagate the event + if {$event(cancelable) && $event(stopPropagation)} { + # Event has been cancelled + } elseif {[llength $node(node:parentNode)]} { + # Go ahead and propagate + node dispatchEvent $node(node:parentNode) $eventId + } + + set event(dispatched) 1 + } + + default { + return -code error "unknown method \"$method\"" + } + + } + + return $result +} + +# dom::tcl::Node:create -- +# +# Generic node creation. +# See also CreateElement, CreateTextNode, CreateGeneric. +# +# Arguments: +# pVar array in caller which contains parent details +# args configuration options +# +# Results: +# New child node created. + +proc dom::tcl::Node:create {pVar args} { + upvar #0 $pVar parent + + array set opts {-name {} -value {}} + array set opts $args + + upvar #0 [namespace qualifiers $pVar]::Document document + + # Create new node + if {![info exists opts(-id)]} { + set opts(-id) node[incr document(counter)] + } + set child [namespace qualifiers $pVar]::$opts(-id) + upvar #0 $child new + array set new [list \ + node:parentNode $opts(-parent) \ + node:childNodes ${child}var \ + node:nodeType $opts(-type) \ + node:nodeName $opts(-name) \ + node:nodeValue $opts(-value) \ + element:attributeList ${child}arr \ + ] + set ${child}var {} + array set ${child}arr {} + + # Update parent node + if {![info exists parent(document:documentElement)]} { + lappend parent(node:childNodes) $child + } + + proc $child {method args} "return \[eval [namespace current]::node \[list \$method\] $child \$args\]" + trace add command $child delete [namespace code [list Node:Delete $child]] + + return $child +} + +# dom::tcl::Node:set -- +# +# Generic node update +# +# Arguments: +# token node token +# args configuration options +# +# Results: +# Node modified. + +proc dom::tcl::Node:set {token args} { + upvar #0 $token node + + foreach {key value} $args { + set node($key) $value + } + + return {} +} + +# dom::tcl::Node:Delete -- +# +# Handle node destruction +# +# Arguments: +# name node token +# old ) +# new ) arguments appended by trace command +# op ) +# +# Results: +# Node is destroyed + +proc dom::tcl::Node:Delete {name old new op} { + if {[catch {DOMImplementation destroy $name} ret]} { + # Document has been deleted... namespace has been destroyed + } else { + return $ret + } +} + +# dom::tcl::FireNodeInsertedEvents -- +# +# Recursively descend the tree triggering DOMNodeInserted +# events as we go. +# +# Arguments: +# nodeid Node ID +# +# Results: +# DOM L2 DOMNodeInserted events posted + +proc dom::tcl::FireNodeInsertedEvents nodeid { + event postMutationEvent $nodeid DOMNodeInsertedIntoDocument + foreach child [node children $nodeid] { + FireNodeInsertedEvents $child + } + + return {} +} + +# dom::tcl::FireNodeRemovedEvents -- +# +# Recursively descend the tree triggering DOMNodeRemoved +# events as we go. +# +# Arguments: +# nodeid Node ID +# +# Results: +# DOM L2 DOMNodeRemoved events posted + +proc dom::tcl::FireNodeRemovedEvents nodeid { + event postMutationEvent $nodeid DOMNodeRemovedFromDocument + foreach child [node children $nodeid] { + FireNodeRemovedEvents $child + } + + return {} +} + +# dom::tcl::element -- +# +# Functions for an element. +# +# Arguments: +# method method to invoke +# token token for node +# args arguments for method +# +# Results: +# Depends on method used. + +namespace eval dom::tcl { + variable elementOptionsRO tagName|empty + variable elementOptionsRW {} +} + +proc dom::tcl::element {method token args} { + variable elementOptionsRO + variable elementOptionsRW + + upvar #0 $token node + + if {[string compare $node(node:nodeType) "element"]} { + return -code error "malformed node token \"$token\"" + } + set result {} + + switch -- $method { + + cget { + # Some read-only configuration options are computed + if {[llength $args] != 1} { + return -code error "wrong # args: should be \"dom::element cget token option\"" + } + if {[regexp [format {^-(%s)$} $elementOptionsRO] [lindex $args 0] discard option]} { + switch $option { + tagName { + set result [lindex $node(node:nodeName) 0] + } + empty { + if {![info exists node(element:empty)]} { + return 0 + } else { + return $node(element:empty) + } + } + default { + return $node(node:$option) + } + } + } elseif {[regexp [format {^-(%s)$} $elementOptionsRW] [lindex $args 0] discard option]} { + return $node(node:$option) + } else { + return -code error "bad option \"[lindex $args 0]\"" + } + } + configure { + if {[llength $args] == 1} { + return [document cget $token [lindex $args 0]] + } elseif {[expr [llength $args] % 2]} { + return -code error "no value specified for option \"[lindex $args end]\"" + } else { + foreach {option value} $args { + if {[regexp [format {^-(%s)$} $elementOptionsRO] $option discard opt]} { + return -code error "option \"$option\" cannot be modified" + } elseif {[regexp [format {^-(%s)$} $elementOptionsRW] $option discard opt]} { + return -code error "not implemented" + } else { + return -code error "bad option \"$option\"" + } + } + } + } + + getAttribute { + if {[llength $args] != 1} { + return -code error "wrong # args: should be \"dom::element getAttribute token name\"" + } + + set result {} + + upvar #0 $node(element:attributeList) attrList + catch {set result $attrList([lindex $args 0])} + + return $result + + } + + setAttribute { + if {[llength $args] != 2} { + return -code error "wrong # args: should be \"dom::element setAttribute token name value\"" + } + + # Check that the attribute name is kosher + if {![regexp ^$::xml::Name\$ [lindex $args 0]]} { + return -code error "invalid attribute name \"[lindex $args 0]\"" + } + + upvar #0 $node(element:attributeList) attrList + set evid [CreateEvent $token DOMAttrModified] + set oldValue {} + catch {set oldValue $attrList([lindex $args 0])} + event initMutationEvent $evid DOMAttrModified 1 0 $token $oldValue [lindex $args 1] [lindex $args 0] [expr {[info exists attrList([lindex $args 0])] ? "modification" : "addition"}] + set result [set attrList([lindex $args 0]) [lindex $args 1]] + node dispatchEvent $token $evid + DOMImplementation destroy $evid + + } + + removeAttribute { + if {[llength $args] != 1} { + return -code error "wrong # args: should be \"dom::element removeAttribute token name\"" + } + + upvar #0 $node(element:attributeList) attrList + catch {unset attrList([lindex $args 0])} + + event postMutationEvent $token DOMAttrRemoved -attrName [lindex $args 0] -attrChange removal + + } + + getAttributeNS { + if {[llength $args] != 2} { + return -code error "wrong # args: should be \"dom::element getAttributeNS token ns name\"" + } + + set result {} + upvar #0 $node(element:attributeList) attrList + catch {set result $attrList([lindex $args 0]^[lindex $args 1])} + + return $result + + } + + setAttributeNS { + if {[llength $args] != 3} { + return -code error "wrong # args: should be \"dom::element setAttributeNS token ns attr value\"" + } + + # Check that the attribute name is kosher + if {![regexp ^$::xml::QName\$ [lindex $args 1] discard prefix localName]} { + return -code error "invalid qualified attribute name \"[lindex $args 1]\"" + } + + # BUG: At the moment the prefix is ignored + + upvar #0 $node(element:attributeList) attrList + set evid [CreateEvent $token DOMAttrModified] + set oldValue {} + catch {set oldValue $attrList([lindex $args 0]^$localName)} + event initMutationEvent $evid DOMAttrModified 1 0 $token $oldValue [lindex $args 2] [lindex $args 0]^localName [expr {[info exists attrList([lindex $args 0]^$localName)] ? "modification" : "addition"}] + set result [set attrList([lindex $args 0]^$localName) [lindex $args 2]] + node dispatchEvent $token $evid + DOMImplementation destroy $evid + + } + + removeAttributeNS { + if {[llength $args] != 2} { + return -code error "wrong # args: should be \"dom::element removeAttributeNS token ns name\"" + } + + upvar #0 $node(element:attributeList) attrList + catch {unset attrList([lindex $args 0]^[lindex $args 1])} + + event postMutationEvent $token DOMAttrRemoved -attrName [lindex $args 0]^[lindex $args 1] -attrChange removal + + } + + getAttributeNode { + array set tmp [array get $node(element:attributeList)] + if {![info exists tmp([lindex $args 0])]} { + return {} + } + + # Synthesize an attribute node if one doesn't already exist + array set attrNodes $node(element:attributeNodes) + if {[catch {set result $attrNodes([lindex $args 0])}]} { + set result [CreateGeneric $token node:nodeType attribute node:nodeName [lindex $args 0] node:nodeValue $tmp([lindex $args 0])] + lappend node(element:attributeNodes) [lindex $args 0] $result + } + } + + setAttributeNode - + removeAttributeNode - + getAttributeNodeNS - + setAttributeNodeNS - + removeAttributeNodeNS { + return -code error "not yet implemented" + } + + getElementsByTagName { + if {[llength $args] < 1} { + return -code error "wrong # args: should be \"dom::element getElementsByTagName token name\"" + } + + return [eval Element:GetByTagName [list $token [lindex $args 0]] \ + [lrange $args 1 end]] + } + + normalize { + if {[llength $args]} { + return -code error "wrong # args: should be dom::element normalize token" + } + + Element:Normalize node [set $node(node:childNodes)] + } + + default { + return -code error "bad method \"$method\": should be cget, configure, getAttribute, setAttribute, removeAttribute, getAttributeNS, setAttributeNS, removeAttributeNS, getAttributeNode, setAttributeNode, removeAttributeNode, getAttributeNodeNS, setAttributeNodeNS, removeAttributeNodeNS, getElementsByTagName or normalize" + } + + } + + return $result +} + +# dom::tcl::Element:GetByTagName -- +# +# Search for (child) elements +# +# This used to be non-recursive, but then I read the DOM spec +# properly and discovered that it should recurse. The -deep +# option allows for backward-compatibility, and defaults to the +# DOM-specified value of true. +# +# Arguments: +# token parent node +# name element type to search for +# args configuration options +# +# Results: +# The name of the variable containing the list of matching node tokens + +proc dom::tcl::Element:GetByTagName {token name args} { + upvar #0 $token node + upvar #0 [namespace qualifiers $token]::Document document + + array set cfg {-deep 1} + array set cfg $args + set cfg(-deep) [Boolean $cfg(-deep)] + + # Guard against arbitrary glob characters + # Checking that name is a legal XML Name does this + # However, '*' is permitted + if {![regexp ^$::xml::Name\$ $name] && [string compare $name "*"]} { + return -code error "invalid element name" + } + + # Allocate variable name for this search + set searchVar ${token}search[incr document(counter)] + upvar \#0 $searchVar search + + # Make list live by interposing on variable reads + # I don't think we need to interpose on unsets, + # and writing to this variable by the application is + # not permitted. + + trace variable $searchVar w [namespace code Element:GetByTagName:Error] + + if {[string compare $node(node:nodeType) "document"]} { + trace variable $searchVar r [namespace code [list Element:GetByTagName:Search [set $node(node:childNodes)] $name $cfg(-deep)]] + } elseif {[llength $node(document:documentElement)]} { + # Document Element must exist and must be an element type node + trace variable $searchVar r [namespace code [list Element:GetByTagName:Search $node(document:documentElement) $name $cfg(-deep)]] + } + + return $searchVar +} + +# dom::tcl::Element:GetByTagName:Search -- +# +# Search for elements. This does the real work. +# Because this procedure is invoked everytime +# the variable is read, it returns the live list. +# +# Arguments: +# tokens nodes to search (inclusive) +# name element type to search for +# deep whether to search recursively +# name1 \ +# name2 > appended by trace command +# op / +# +# Results: +# List of matching node tokens + +proc dom::tcl::Element:GetByTagName:Search {tokens name deep name1 name2 op} { + set result {} + + foreach tok $tokens { + upvar #0 $tok nodeInfo + switch -- $nodeInfo(node:nodeType) { + element { + if {[string match $name [GetField nodeInfo(node:nodeName)]]} { + lappend result $tok + } + if {$deep} { + set childResult [Element:GetByTagName:Search [set $nodeInfo(node:childNodes)] $name $deep {} {} {}] + if {[llength $childResult]} { + eval lappend result $childResult + } + } + } + } + } + + if {[string length $name1]} { + set $name1 $result + return {} + } else { + return $result + } +} + +# dom::tcl::Element:GetByTagName:Error -- +# +# Complain about the application writing to a variable +# that this package maintains. +# +# Arguments: +# name1 \ +# name2 > appended by trace command +# op / +# +# Results: +# Error code returned. + +proc dom::tcl::Element:GetByTagName:Error {name1 name2 op} { + return -code error "dom: Read-only variable" +} + +# dom::tcl::Element:Normalize -- +# +# Normalize the text nodes +# +# Arguments: +# pVar parent array variable in caller +# nodes list of node tokens +# +# Results: +# Adjacent text nodes are coalesced + +proc dom::tcl::Element:Normalize {pVar nodes} { + upvar #0 $pVar parent + + set textNode {} + + foreach n $nodes { + upvar #0 $n child + set cleanup {} + + switch $child(node:nodeType) { + textNode { + if {[llength $textNode]} { + + # Coalesce into previous node + set evid [CreateEvent $n DOMCharacterDataModified] + event initMutationEvent $evid DOMCharacterDataModified 1 0 {} $text(node:nodeValue) $text(node:nodeValue)$child(node:nodeValue) {} {} + append text(node:nodeValue) $child(node:nodeValue) + node dispatchEvent $n $evid + DOMImplementation destroy $evid + + # Remove this child + upvar #0 $parent(node:childNodes) childNodes + set idx [lsearch $childNodes $n] + set childNodes [lreplace $childNodes $idx $idx] + unset $n + set cleanup [list event postMutationEvent [node parent $n] DOMSubtreeModified] + event postMutationEvent $n DOMNodeRemoved + + set $textNode [array get text] + } else { + set textNode $n + catch {unset text} + array set text [array get child] + } + } + element - + document - + documentFragment { + set textNode {} + Element:Normalize child [set $child(node:childNodes)] + } + default { + set textNode {} + } + } + + eval $cleanup + } + + return {} +} + +# dom::tcl::processinginstruction -- +# +# Functions for a processing intruction. +# +# Arguments: +# method method to invoke +# token token for node +# args arguments for method +# +# Results: +# Depends on method used. + +namespace eval dom::tcl { + variable piOptionsRO target + variable piOptionsRW data +} + +proc dom::tcl::processinginstruction {method token args} { + variable piOptionsRO + variable piOptionsRW + + upvar #0 $token node + + set result {} + + switch -- $method { + + cget { + # Some read-only configuration options are computed + if {[llength $args] != 1} { + return -code error "too many arguments" + } + if {[regexp [format {^-(%s)$} $elementOptionsRO] [lindex $args 0] discard option]} { + switch $option { + target { + set result [lindex $node(node:nodeName) 0] + } + default { + return $node(node:$option) + } + } + } elseif {[regexp [format {^-(%s)$} $elementOptionsRW] [lindex $args 0] discard option]} { + switch $option { + data { + return $node(node:nodeValue) + } + default { + return $node(node:$option) + } + } + } else { + return -code error "unknown option \"[lindex $args 0]\"" + } + } + configure { + if {[llength $args] == 1} { + return [document cget $token [lindex $args 0]] + } elseif {[expr [llength $args] % 2]} { + return -code error "no value specified for option \"[lindex $args end]\"" + } else { + foreach {option value} $args { + if {[regexp [format {^-(%s)$} $elementOptionsRO] $option discard opt]} { + return -code error "attribute \"$option\" is read-only" + } elseif {[regexp [format {^-(%s)$} $elementOptionsRW] $option discard opt]} { + switch $opt { + data { + set evid [CreateEvent $token DOMCharacterDataModified] + event initMutationEvent $evid DOMCharacterModified 1 0 {} $node(node:nodeValue) $value {} {} + set node(node:nodeValue) $value + node dispatchEvent $token $evid + DOMImplementation destroy $evid + } + default { + set node(node:$opt) $value + } + } + } else { + return -code error "unknown option \"$option\"" + } + } + } + } + + default { + return -code error "unknown method \"$method\"" + } + + } + + return $result +} + +################################################# +# +# DOM Level 2 Interfaces +# +################################################# + +# dom::tcl::event -- +# +# Implements Event Interface +# +# Subclassed Interfaces are also defined here, +# such as UIEvents. +# +# Arguments: +# method method to invoke +# token token for event +# args arguments for method +# +# Results: +# Depends on method used. + +namespace eval dom::tcl { + variable eventOptionsRO type|target|currentNode|eventPhase|bubbles|cancelable|timeStamp|detail|view|screenX|screenY|clientX|clientY|ctrlKey|shiftKey|altKey|metaKey|button|relatedNode|prevValue|newValue|attrName|attrChange + variable eventOptionsRW {} + + # Issue: should the attributes belonging to the subclassed Interface + # be separated out? + + variable uieventOptionsRO detail|view + variable uieventOptionsRW {} + + variable mouseeventOptionsRO screenX|screenY|clientX|clientY|ctrlKey|shiftKey|altKey|metaKey|button|relatedNode + variable mouseeventOptionsRW {} + + variable mutationeventOptionsRO relatedNode|prevValue|newValue|attrName + variable mutationeventOptionsRW {} +} + +proc dom::tcl::event {method token args} { + variable eventOptionsRO + variable eventOptionsRW + + upvar #0 $token event + + set result {} + + switch -glob -- $method { + + cg* { + # cget + + if {[llength $args] != 1} { + return -code error "too many arguments" + } + if {[regexp [format {^-(%s)$} $eventOptionsRO] [lindex $args 0] discard option]} { + return $event($option) + } elseif {[regexp [format {^-(%s)$} $eventOptionsRW] [lindex $args 0] discard option]} { + return $event($option) + } else { + return -code error "unknown option \"[lindex $args 0]\"" + } + } + + co* { + # configure + + if {[llength $args] == 1} { + return [event cget $token [lindex $args 0]] + } elseif {[expr [llength $args] % 2]} { + return -code error "no value specified for option \"[lindex $args end]\"" + } else { + foreach {option value} $args { + if {[regexp [format {^-(%s)$} $eventOptionsRW] $option discard opt]} { + set event($opt) $value + } elseif {[regexp [format {^-(%s)$} $eventOptionsRO] $option discard opt]} { + return -code error "attribute \"$option\" is read-only" + } else { + return -code error "unknown option \"$option\"" + } + } + } + + } + + st* { + # stopPropagation + + set event(stopPropagation) 1 + } + + pr* { + # preventDefault + + set event(preventDefault) 1 + } + + initE* { + # initEvent + + if {[llength $args] != 3} { + return -code error "wrong # args: should be dom::event initEvent token type bubbles cancelable" + } + + if {$event(dispatched)} { + return -code error "event has been dispatched" + } + + foreach {event(type) event(bubbles) event(cancelable)} $args break + } + + initU* { + # initUIEvent + + if {[llength $args] < 4 || [llength $args] > 5} { + return -code error "wrong # args: should be dom::event initUIEvent token type bubbles cancelable view detail" + } + + if {$event(dispatched)} { + return -code error "event has been dispatched" + } + + set event(detail) 0 + foreach {event(type) event(bubbles) event(cancelable) event(view) event(detail)} $args break + } + + initMo* { + # initMouseEvent + + if {[llength $args] != 15} { + return -code error "wrong # args: should be dom::event initMouseEvent token type bubbles cancelable view detail screenX screenY clientX clientY ctrlKey altKey shiftKey metaKey button relatedNode" + } + + if {$event(dispatched)} { + return -code error "event has been dispatched" + } + + set event(detail) 1 + foreach {event(type) event(bubbles) event(cancelable) event(view) event(detail) event(screenX) event(screenY) event(clientX) event(clientY) event(ctrlKey) event(altKey) event(shiftKey) event(metaKey) event(button) event(relatedNode)} $args break + } + + initMu* { + # initMutationEvent + + if {[llength $args] != 8} { + return -code error "wrong # args: should be dom::event initMutationEvent token type bubbles cancelable relatedNode prevValue newValue attrName attrChange" + } + + if {$event(dispatched)} { + return -code error "event has been dispatched" + } + + foreach {event(type) event(bubbles) event(cancelable) event(relatedNode) event(prevValue) event(newValue) event(attrName) event(attrChange)} $args break + } + + postUI* { + # postUIEvent, non-standard convenience method + + set evType [lindex $args 0] + array set evOpts [list \ + -bubbles $::dom::bubbles($evType) -cancelable $::dom::cancelable($evType) \ + -view {} \ + -detail {} \ + ] + array set evOpts [lrange $args 1 end] + + set evid [CreateEvent $token $evType] + event initUIEvent $evid $evType $evOpts(-bubbles) $evOpts(-cancelable) $evOpts(-view) $evOpts(-detail) + node dispatchEvent $token $evid + DOMImplementation destroy $evid + + } + + postMo* { + # postMouseEvent, non-standard convenience method + + set evType [lindex $args 0] + array set evOpts [list \ + -bubbles $::dom::bubbles($evType) -cancelable $::dom::cancelable($evType) \ + -view {} \ + -detail {} \ + -screenX {} \ + -screenY {} \ + -clientX {} \ + -clientY {} \ + -ctrlKey {} \ + -altKey {} \ + -shiftKey {} \ + -metaKey {} \ + -button {} \ + -relatedNode {} \ + ] + array set evOpts [lrange $args 1 end] + + set evid [CreateEvent $token $evType] + event initMouseEvent $evid $evType $evOpts(-bubbles) $evOpts(-cancelable) $evOpts(-view) $evOpts(-detail) $evOpts(-screenX) $evOpts(-screenY) $evOpts(-clientX) $evOpts(-clientY) $evOpts(-ctrlKey) $evOpts(-altKey) $evOpts(-shiftKey) $evOpts(-metaKey) $evOpts(-button) $evOpts(-relatedNode) + node dispatchEvent $token $evid + DOMImplementation destroy $evid + + } + + postMu* { + # postMutationEvent, non-standard convenience method + + set evType [lindex $args 0] + array set evOpts [list \ + -bubbles $::dom::bubbles($evType) -cancelable $::dom::cancelable($evType) \ + -relatedNode {} \ + -prevValue {} -newValue {} \ + -attrName {} -attrChange {} \ + ] + array set evOpts [lrange $args 1 end] + + set evid [CreateEvent $token $evType] + event initMutationEvent $evid $evType $evOpts(-bubbles) $evOpts(-cancelable) $evOpts(-relatedNode) $evOpts(-prevValue) $evOpts(-newValue) $evOpts(-attrName) $evOpts(-attrChange) + node dispatchEvent $token $evid + DOMImplementation destroy $evid + + } + + default { + return -code error "unknown method \"$method\"" + } + } + + return $result +} + +# dom::tcl::CreateEvent -- +# +# Create an event object +# +# Arguments: +# token parent node +# type event type +# args configuration options +# +# Results: +# Returns event token + +proc dom::tcl::CreateEvent {token type args} { + array set opts $args + if {[string length $token]} { + upvar #0 $token parent + upvar #0 [namespace qualifiers $token]::Document document + set child [namespace qualifiers $token]::event[incr document(counter)] + } elseif {[info exists $opts(-document)]} { + upvar #0 $opts(-document) document + set child [namespace qualifiers $opts(-document)]::event[incr document(counter)] + } + + upvar #0 $child event + + # Create the event + array set event [list \ + node:nodeType event \ + type $type \ + target {} \ + currentNode {} \ + cancelable 1 \ + stopPropagation 0 \ + preventDefault 0 \ + dispatched 0 \ + bubbles 1 \ + eventPhase {} \ + timeStamp [clock clicks -milliseconds] \ + ] + + proc $child {method args} "return \[eval [namespace current]::event \[list \$method\] $child \$args\]" + trace add command $child delete [namespace code [list Node:Delete $child]] + + return $child +} + +################################################# +# +# Serialisation +# +################################################# + +# dom::tcl::Serialize:documentFragment -- +# +# Produce text for documentFragment. +# +# Arguments: +# token node token +# args configuration options +# +# Results: +# XML format text. + +proc dom::tcl::Serialize:documentFragment {token args} { + upvar #0 $token node + + if {[string compare "Document" [namespace tail $token]]} { + return [eval [list Serialize:node $token] $args] + } else { + if {[string compare {} [GetField node(document:documentElement)]]} { + return [eval Serialize:document [list $token] $args] + } else { + return -code error "document has no document element" + } + } + +} + +# dom::tcl::Serialize:document -- +# +# Produce text for document. +# +# Arguments: +# token node token +# args configuration options +# +# Results: +# XML format text. + +proc dom::tcl::Serialize:document {token args} { + upvar #0 $token node + array set opts { + -showxmldecl 1 + -showdoctypedecl 1 + } + array set opts $args + + set result {} + + if {[string length $node(document:doctype)]} { + + upvar #0 $node(document:doctype) doctype + + # Bug fix: can't use Serialize:attributeList for XML declaration, + # since attributes must occur in a given order (XML 2.8 [23]) + + set result {} + + if {$opts(-showxmldecl)} { + append result \n + } + if {$opts(-showdoctypedecl)} { + # Is document element in an XML Namespace? + # If so then include prefix in doctype decl + foreach {prefix localName} [::xml::qnamesplit $doctype(doctype:name)] break + if {![string length $prefix]} { + # The prefix may not have been allocated yet + upvar #0 $node(document:documentElement) docel + if {[info exists docel(node:namespaceURI)] && \ + [string length $docel(node:namespaceURI)]} { + set declPrefix [GetNamespacePrefix $node(document:documentElement) $docel(node:namespaceURI)] + set docelName $declPrefix:$doctype(doctype:name) + } else { + set docelName $doctype(doctype:name) + } + } else { + set docelName $doctype(doctype:name) + } + # Applied patch by Marco Gonnelli, bug #590914 + append result \n + } + } + + # BUG #525505: Want to serialize all children including the + # document element. + + if {[info exists $node(node:childNodes)]} { + foreach child [set $node(node:childNodes)] { + append result [eval Serialize:[node cget $child -nodeType] [list $child] $args] + } + } + + return $result +} + +# dom::tcl::Serialize:ExternalID -- +# +# Returned appropriately quoted external identifiers +# +# Arguments: +# publicid public identifier +# systemid system identifier +# +# Results: +# text + +proc dom::tcl::Serialize:ExternalID {publicid systemid} { + + switch -glob -- [string length $publicid],[string length $systemid] { + 0,0 { + return {} + } + 0,* { + return " SYSTEM \"$systemid\"" + } + *,* { + # Patch from c.l.t., Richard Calmbach (rc@hnc.com ) + return " PUBLIC \"$publicid\" \"$systemid\"" + } + } + + return {} +} + +# dom::tcl::Serialize:XMLDecl -- +# +# Produce text for XML Declaration attribute. +# Order is determine by document serialisation procedure. +# +# Arguments: +# attr required attribute +# attList attribute list +# +# Results: +# XML format text. + +proc dom::tcl::Serialize:XMLDecl {attr attrList} { + array set data $attrList + if {![info exists data($attr)]} { + return {} + } elseif {[string length $data($attr)]} { + return " $attr='$data($attr)'" + } else { + return {} + } +} + +# dom::tcl::Serialize:node -- +# +# Produce text for an arbitrary node. +# This simply serializes the child nodes of the node. +# +# Arguments: +# token node token +# args configuration options +# +# Results: +# XML format text. + +proc dom::tcl::Serialize:node {token args} { + upvar #0 $token node + array set opts $args + + if {[info exists opts(-indent)]} { + # NB. 0|1 cannot be used as booleans - mention this in docn + if {[regexp {^false|no|off$} $opts(-indent)]} { + # No action required + } elseif {[regexp {^true|yes|on$} $opts(-indent)]} { + set opts(-indent) 1 + } else { + incr opts(-indent) + } + } + + set result {} + foreach childToken [set $node(node:childNodes)] { + upvar #0 $childToken child + append result [eval [list Serialize:$child(node:nodeType) $childToken] [array get opts]] + } + + return $result +} + +# dom::tcl::Serialize:element -- +# +# Produce text for an element. +# +# Arguments: +# token node token +# args configuration options +# +# Results: +# XML format text. + +proc dom::tcl::Serialize:element {token args} { + upvar #0 $token node + array set opts {-newline {}} + array set opts $args + + set result {} + set newline {} + if {[lsearch $opts(-newline) $node(node:nodeName)] >= 0} { + append result \n + set newline \n + } + append result [eval Serialize:Indent [array get opts]] + switch [info exists node(node:namespaceURI)],[info exists node(node:prefix)] { + + 1,1 { + # XML Namespace is in scope, prefix supplied + if {[string length $node(node:prefix)]} { + # Make sure that there's a declaration for this XML Namespace + set declPrefix [GetNamespacePrefix $token $node(node:namespaceURI) -prefix $node(node:prefix)] + # ASSERTION: $declPrefix == $node(node:prefix) + set nsPrefix $node(node:prefix): + } elseif {[string length $node(node:namespaceURI)]} { + set nsPrefix [GetNamespacePrefix $token $node(node:namespaceURI)]: + } else { + set nsPrefix {} + } + } + + 1,0 { + # XML Namespace is in scope, no prefix + set nsPrefix [GetNamespacePrefix $token $node(node:namespaceURI)]: + if {![string compare $nsPrefix :]} { + set nsPrefix {} + } + } + + 0,1 { + # Internal error + set nsPrefix {} + } + + 0,0 - + default { + # No XML Namespace is in scope + set nsPrefix {} + } + } + append result <$nsPrefix$node(node:localName) + + append result [Serialize:attributeList [array get $node(element:attributeList)]] + + if {![llength [set $node(node:childNodes)]]} { + + append result />$newline + + } else { + + append result >$newline + + # Do the children + if {[hasmixedcontent $token]} { + set opts(-indent) no + } + append result [eval Serialize:node [list $token] [array get opts]] + + append result [eval Serialize:Indent [array get opts]] + append result "$newline$newline" + + } + + return $result +} + +# dom::tcl::GetNamespacePrefix -- +# +# Determine the XML Namespace prefix for a Namespace URI +# +# Arguments: +# token node token +# nsuri XML Namespace URI +# args configuration options +# +# Results: +# Returns prefix. +# May add prefix information to node + +proc dom::tcl::GetNamespacePrefix {token nsuri args} { + upvar #0 $token node + array set options $args + + GetNamespaceDecl $token $nsuri declNode prefix + + if {[llength $declNode]} { + # A declaration was found for this Namespace URI + return $prefix + } else { + # No declaration found. Allocate a prefix + # and add XML Namespace declaration + set prefix {} + catch {set prefix $options(-prefix)} + if {![string compare $prefix {}]} { + upvar #0 [namespace qualifiers $token]::Document document + set prefix ns[incr document(counter)] + } + set node(node:prefix) $prefix + upvar \#0 $node(element:attributeList) attrs + set attrs(${::dom::xmlnsURI}^$prefix) $nsuri + + return $prefix + } +} + +# dom::tcl::GetNamespaceDecl -- +# +# Find the XML Namespace declaration. +# +# Arguments: +# token node token +# nsuri XML Namespace URI +# nodeVar Variable name for declaration +# prefVar Variable for prefix +# +# Results: +# If the declaration is found returns node and prefix + +proc dom::tcl::GetNamespaceDecl {token nsuri nodeVar prefVar} { + upvar #0 $token node + upvar $nodeVar declNode + upvar $prefVar prefix + + while {[string length $node(node:parentNode)]} { + + # Check this node's XML Namespace declarations + catch {unset attrs} + array set attrs [array get $node(element:attributeList)] + foreach {nsdecl decluri} [array get attrs ${::dom::xmlnsURI}^*] { + if {![string compare $decluri $nsuri]} { + regexp [format {%s\^(.*)} $::dom::xmlnsURI] $nsdecl dummy prefix + set declNode $token + return + } + } + + # Move up to parent + set token $node(node:parentNode) + upvar #0 $token node + } + + # Got to Document node and didn't find XML NS decl + set prefix {} + set declNode {} +} + +# dom::tcl::Serialize:textNode -- +# +# Produce text for a text node. This procedure may +# return a CDATA section where appropriate. +# +# Arguments: +# token node token +# args configuration options +# +# Results: +# XML format text. + +proc dom::tcl::Serialize:textNode {token args} { + upvar #0 $token node + + if {$node(node:cdatasection)} { + return [Serialize:CDATASection $node(node:nodeValue)] + } elseif {[Serialize:ExceedsThreshold $node(node:nodeValue)]} { + return [Serialize:CDATASection $node(node:nodeValue)] + } else { + return [Encode $node(node:nodeValue)] + } +} + +# dom::tcl::Serialize:ExceedsThreshold -- +# +# Applies heuristic(s) to determine whether a text node +# should be formatted as a CDATA section. +# +# Arguments: +# text node text +# +# Results: +# Boolean. + +proc dom::tcl::Serialize:ExceedsThreshold {text} { + return [expr {[regsub -all {[<>&]} $text {} discard] > $::dom::maxSpecials}] +} + +# dom::tcl::Serialize:CDATASection -- +# +# Formats a CDATA section. +# +# Arguments: +# text node text +# +# Results: +# XML text. + +proc dom::tcl::Serialize:CDATASection {text} { + set result {} + while {[regexp {(.*)]]>(.*)} $text discard text trailing]} { + set result \]\]>\;$result + } + return $result +} + +# dom::tcl::Serialize:processingInstruction -- +# +# Produce text for a PI node. +# +# Arguments: +# token node token +# args configuration options +# +# Results: +# XML format text. + +proc dom::tcl::Serialize:processingInstruction {token args} { + upvar #0 $token node + + return "[eval Serialize:Indent $args]" +} + +# dom::tcl::Serialize:comment -- +# +# Produce text for a comment node. +# +# Arguments: +# token node token +# args configuration options +# +# Results: +# XML format text. + +proc dom::tcl::Serialize:comment {token args} { + upvar #0 $token node + + return [eval Serialize:Indent $args] +} + +# dom::tcl::Serialize:entityReference -- +# +# Produce text for an entity reference. +# +# Arguments: +# token node token +# args configuration options +# +# Results: +# XML format text. + +proc dom::tcl::Serialize:entityReference {token args} { + upvar #0 $token node + + return &$node(node:nodeName)\; +} + +# dom::tcl::Encode -- +# +# Encode special characters +# +# Arguments: +# value text value +# +# Results: +# XML format text. + +proc dom::tcl::Encode value { + array set Entity { + $ $ + < < + > > + & & + \" " + ' ' + } + + regsub -all {([$<>&"'])} $value {$Entity(\1)} value + + return [subst -nocommand -nobackslash $value] +} + +# dom::tcl::Serialize:attributeList -- +# +# Produce text for an attribute list. +# +# Arguments: +# l name/value paired list +# +# Results: +# XML format text. + +proc dom::tcl::Serialize:attributeList {l} { + + set result {} + foreach {name value} $l { + + if {[regexp {^([^^]+)\^(.*)$} $name discard nsuri prefix]} { + if {[string compare $nsuri $::dom::xmlnsURI]} { + # Need the node token to resolve the Namespace URI + append result { } ?:$prefix = + } else { + # A Namespace declaration + append result { } xmlns:$prefix = + } + } else { + append result { } $name = + } + + # Handle special characters + regsub -all & $value {\&} value + regsub -all < $value {\<} value + + if {![string match *\"* $value]} { + append result \"$value\" + } elseif {![string match *'* $value]} { + append result '$value' + } else { + regsub -all \" $value {\"} value + append result \"$value\" + } + + } + + return $result +} + +# dom::tcl::Serialize:Indent -- +# +# Calculate the indentation required, if any +# +# Arguments: +# args configuration options, which may specify -indent +# +# Results: +# May return white space + +proc dom::tcl::Serialize:Indent args { + array set opts [list -indentspec $::dom::indentspec] + array set opts $args + + if {![info exists opts(-indent)] || \ + [regexp {^false|no|off$} $opts(-indent)]} { + return {} + } + + if {[regexp {^true|yes|on$} $opts(-indent)]} { + # Default indent level is 0 + return \n + } + + if {!$opts(-indent)} { + return \n + } + + set ws [format \n%\ [expr $opts(-indent) * [lindex $opts(-indentspec) 0]]s { }] + regsub -all [lindex [lindex $opts(-indentspec) 1] 0] $ws [lindex [lindex $opts(-indentspec) 1] 1] ws + + return $ws + +} + +################################################# +# +# Parsing +# +################################################# + +# dom::tcl::ParseElementStart -- +# +# Push a new element onto the stack. +# +# Arguments: +# stateVar global state array variable +# name element name +# attrList attribute list +# args configuration options +# +# Results: +# An element is created within the currently open element. + +proc dom::tcl::ParseElementStart {stateVar name attrList args} { + + upvar #0 $stateVar state + array set opts $args + + # Push namespace declarations + # We need to be able to map namespaceURI's back to prefixes + set nsattrlists {} + catch { + foreach {namespaceURI prefix} $opts(-namespacedecls) { + lappend state(NS:$namespaceURI) $prefix + + # Also, synthesize namespace declaration attributes + # TclXML is a little too clever when it parses them away! + + lappend nsattrlists $prefix $namespaceURI + } + lappend opts(-namespaceattributelists) $::dom::xmlnsURI $nsattrlists + + } + + set nsarg {} + catch { + lappend nsarg -namespace $opts(-namespace) + lappend nsarg -localname $name + lappend nsarg -prefix [lindex $state(NS:$opts(-namespace)) end] + } + + lappend state(current) \ + [eval CreateElement [list [lindex $state(current) end] $name $attrList] $nsarg [array get opts -namespaceattributelists]] + + if {[info exists opts(-empty)] && $opts(-empty)} { + # Flag this node as being an empty element + upvar #0 [lindex $state(current) end] node + set node(element:empty) 1 + } + + # Temporary: implement -progresscommand here, because of broken parser + if {[string length $state(-progresscommand)]} { + if {!([incr state(progCounter)] % $state(-chunksize))} { + uplevel #0 $state(-progresscommand) + } + } +} + +# dom::tcl::ParseElementEnd -- +# +# Pop an element from the stack. +# +# Arguments: +# stateVar global state array variable +# name element name +# args configuration options +# +# Results: +# Currently open element is closed. + +proc dom::tcl::ParseElementEnd {stateVar name args} { + upvar #0 $stateVar state + + set state(current) [lreplace $state(current) end end] +} + +# dom::tcl::ParseCharacterData -- +# +# Add a textNode to the currently open element. +# +# Arguments: +# stateVar global state array variable +# data character data +# +# Results: +# A textNode is created. + +proc dom::tcl::ParseCharacterData {stateVar data} { + upvar #0 $stateVar state + + CreateTextNode [lindex $state(current) end] $data +} + +# dom::tcl::ParseProcessingInstruction -- +# +# Add a PI to the currently open element. +# +# Arguments: +# stateVar global state array variable +# name PI name +# target PI target +# +# Results: +# A processingInstruction node is created. + +proc dom::tcl::ParseProcessingInstruction {stateVar name target} { + upvar #0 $stateVar state + + CreateGeneric [lindex $state(current) end] node:nodeType processingInstruction node:nodeName $name node:nodeValue $target +} + +# dom::tcl::ParseXMLDeclaration -- +# +# Add information from the XML Declaration to the document. +# +# Arguments: +# stateVar global state array variable +# version version identifier +# encoding character encoding +# standalone standalone document declaration +# +# Results: +# Document node modified. + +proc dom::tcl::ParseXMLDeclaration {stateVar version encoding standalone} { + upvar #0 $stateVar state + + upvar #0 $state(docNode) document + array set xmldecl $document(document:xmldecl) + + array set xmldecl [list version $version \ + standalone $standalone \ + encoding $encoding \ + ] + + set document(document:xmldecl) [array get xmldecl] + + return {} +} + +# dom::tcl::ParseDocType -- +# +# Add a Document Type Declaration node to the document. +# +# Arguments: +# stateVar global state array variable +# root root element type +# publit public identifier literal +# systemlist system identifier literal +# dtd internal DTD subset +# +# Results: +# DocType node added + +proc dom::tcl::ParseDocType {stateVar root {publit {}} {systemlit {}} {dtd {}} args} { + upvar #0 $stateVar state + upvar #0 $state(docNode) document + + set document(document:doctype) [CreateDocType $state(docNode) $publit $systemlit $dtd] + + return {} +} + +# dom::tcl::ParseComment -- +# +# Parse comment +# +# Arguments: +# stateVar state array +# data comment data +# +# Results: +# Comment node added to DOM tree + +proc dom::tcl::ParseComment {stateVar data} { + upvar #0 $stateVar state + + CreateGeneric [lindex $state(current) end] node:nodeType comment node:nodeValue $data + + return {} +} + +# dom::tcl::ParseEntityReference -- +# +# Parse an entity reference +# +# Arguments: +# stateVar state variable +# ref entity +# +# Results: +# Entity reference node added to DOM tree + +proc dom::tcl::ParseEntityReference {stateVar ref} { + upvar #0 $stateVar state + + CreateGeneric [lindex $state(current) end] node:nodeType entityReference node:nodeName $ref + + return {} +} + +################################################# +# +# Trim white space +# +################################################# + +# dom::tcl::Trim -- +# +# Remove textNodes that only contain white space +# +# Arguments: +# nodeid node to trim +# +# Results: +# textNode nodes may be removed (from descendants) + +proc dom::tcl::Trim nodeid { + upvar #0 $nodeid node + + switch $node(node:nodeType) { + + textNode { + if {![string length [string trim $node(node:nodeValue)]]} { + node removeChild $node(node:parentNode) $nodeid + } + } + + default { + # Some nodes have no child list. Reported by Jim Hollister + set children {} + catch {set children [set $node(node:childNodes)]} + foreach child $children { + Trim $child + } + } + + } + + return {} +} + +################################################# +# +# XPath support +# +################################################# + +# dom::tcl::XPath:CreateNode -- +# +# Given an XPath expression, create the node +# referred to by the expression. Nodes required +# as steps of the path are created if they do +# not exist. +# +# Arguments: +# node context node +# path location path +# +# Results: +# Node(s) created in the DOM tree. +# Returns token for deepest node in the expression. + +proc dom::tcl::XPath:CreateNode {node path} { + + set root [::dom::node cget $node -ownerDocument] + + set spath [::xpath::split $path] + + if {[llength $spath] <= 1} { + # / - do nothing + return $root + } + + if {![llength [lindex $spath 0]]} { + # Absolute location path + set context $root + set spath [lrange $spath 1 end] + set contexttype document + } else { + set context $node + set contexttype [::dom::node cget $node -nodeType] + } + + foreach step $spath { + + # Sanity check on path + switch $contexttype { + document - + documentFragment - + element {} + default { + return -code error "node type \"$contexttype\" have no children" + } + } + + switch [lindex $step 0] { + + child { + if {[llength [lindex $step 1]] > 1} { + foreach {nodetype discard} [lindex $step 1] break + + switch -- $nodetype { + text { + set posn [CreateNode:FindPosition [lindex $step 2]] + + set count 0 + set targetNode {} + foreach child [::dom::node children $context] { + switch [::dom::node cget $child -nodeType] { + textNode { + incr count + if {$count == $posn} { + set targetNode $child + break + } + } + default {} + } + } + + if {[string length $targetNode]} { + set context $targetNode + } else { + # Creating sequential textNodes doesn't make sense + set context [::dom::document createTextNode $context {}] + } + set contexttype textNode + } + default { + return -code error "node type test \"${nodetype}()\" not supported" + } + } + } else { + # Find the child element + set posn [CreateNode:FindPosition [lindex $step 2]] + + set count 0 + set targetNode {} + foreach child [::dom::node children $context] { + switch [node cget $child -nodeType] { + element { + if {![string compare [lindex $step 1] [::dom::node cget $child -nodeName]]} { + incr count + if {$count == $posn} { + set targetNode $child + break + } + } + } + default {} + } + } + + if {[string length $targetNode]} { + set context $targetNode + } else { + # Didn't find it so create required elements + while {$count < $posn} { + set child [::dom::document createElement $context [lindex $step 1]] + incr count + } + set context $child + } + set contexttype element + + } + } + + default { + return -code error "axis \"[lindex $step 0]\" is not supported" + } + } + } + + return $context +} + +# dom::tcl::CreateNode:FindPosition -- + +proc dom::tcl::CreateNode:FindPosition predicates { + switch [llength $predicates] { + 0 { + return 1 + } + 1 { + # Fall-through + } + default { + return -code error "multiple predicates not yet supported" + } + } + set predicate [lindex $predicates 0] + + switch -- [lindex [lindex $predicate 0] 0] { + function { + switch -- [lindex [lindex $predicate 0] 1] { + position { + if {[lindex $predicate 1] == "="} { + if {[string compare [lindex [lindex $predicate 2] 0] "number"]} { + return -code error "operand must be a number" + } else { + set posn [lindex [lindex $predicate 2] 1] + } + } else { + return -code error "operator must be \"=\"" + } + } + default { + return -code error "predicate function \"[lindex [lindex $predicate 0] 1]\" not supported" + } + } + } + default { + return -code error "predicate must be position() function" + } + } + + return $posn +} + +# dom::tcl::XPath:SelectNode -- +# +# Match nodes with an XPath location path +# +# Arguments: +# ctxt context - Tcl list +# path location path +# +# Results: +# Returns Tcl list of matching nodes + +proc dom::tcl::XPath:SelectNode {ctxt path} { + + if {![llength $ctxt]} { + return {} + } + + set spath [xpath::split $path] + + if {[string length [node parent [lindex $ctxt 0]]]} { + set root [namespace qualifiers [lindex $ctxt 0]]::Document + } else { + set root [lindex $ctxt 0] + } + + if {[llength $spath] == 0} { + return $root + } + if {[llength $spath] == 1 && [llength [lindex $spath 0]] == 0} { + return $root + } + + if {![llength [lindex $spath 0]]} { + set ctxt $root + set spath [lrange $spath 1 end] + } + + return [XPath:SelectNode:Rel $ctxt $spath] +} + +# dom::tcl::XPath:SelectNode:Rel -- +# +# Match nodes with an XPath location path +# +# Arguments: +# ctxt context - Tcl list +# path split location path +# +# Results: +# Returns Tcl list of matching nodes + +proc dom::tcl::XPath:SelectNode:Rel {ctxt spath} { + if {![llength $spath]} { + return $ctxt + } + + set step [lindex $spath 0] + set result {} + switch [lindex $step 0] { + + child { + # All children are candidates + set children {} + foreach node [XPath:SN:GetElementTypeNodes $ctxt] { + eval lappend children [node children $node] + } + + # Now apply node test to each child + foreach node $children { + if {[XPath:SN:ApplyNodeTest $node [lindex $step 1]]} { + lappend result $node + } + } + + } + + descendant-or-self { + foreach node $ctxt { + if {[XPath:SN:ApplyNodeTest $node [lindex $step 1]]} { + lappend result $node + } + eval lappend result [XPath:SN:DescendAndTest [node children $node] [lindex $step 1]] + } + } + + descendant { + foreach node $ctxt { + eval lappend result [XPath:SN:DescendAndTest [node children $node] [lindex $step 1]] + } + } + + attribute { + if {[string compare [lindex $step 1] "*"]} { + foreach node $ctxt { + set attrNode [element getAttributeNode $node [lindex $step 1]] + if {[llength $attrNode]} { + lappend result $attrNode + } + } + } else { + # All attributes are returned + foreach node $ctxt { + foreach attrName [array names [node cget $node -attributes]] { + set attrNode [element getAttributeNode $node $attrName] + if {[llength $attrNode]} { + lappend result $attrNode + } + } + } + } + } + + default { + return -code error "axis \"[lindex $step 0]\" is not supported" + } + } + + # Now apply predicates + set result [XPath:ApplyPredicates $result [lindex $step 2]] + + # Apply the next location step + return [XPath:SelectNode:Rel $result [lrange $spath 1 end]] +} + +# dom::tcl::XPath:SN:GetElementTypeNodes -- +# +# Reduce nodeset to those nodes of element type +# +# Arguments: +# nodeset set of nodes +# +# Results: +# Returns nodeset in which all nodes are element type + +proc dom::tcl::XPath:SN:GetElementTypeNodes nodeset { + set result {} + foreach node $nodeset { + switch [node cget $node -nodeType] { + document - + documentFragment - + element { + lappend result $node + } + default {} + } + } + return $result +} + +# dom::tcl::XPath:SN:ApplyNodeTest -- +# +# Apply the node test to a node +# +# Arguments: +# node DOM node to test +# test node test +# +# Results: +# 1 if node passes, 0 otherwise + +proc dom::tcl::XPath:SN:ApplyNodeTest {node test} { + if {[llength $test] > 1} { + foreach {name typetest} $test break + # Node type test + switch -glob -- $name,[node cget $node -nodeType] { + node,* { + return 1 + } + text,textNode - + comment,comment - + processing-instruction,processingInstruction { + return 1 + } + text,* - + comment,* - + processing-instruction,* { + return 0 + } + default { + return -code error "illegal node type test \"[lindex $step 1]\"" + } + } + } else { + # Node name test + switch -glob -- $test,[node cget $node -nodeType],[node cget $node -nodeName] \ + \\*,element,* { + return 1 + } \ + \\*,* { + return 0 + } \ + *,element,$test { + return 1 + } + } + + return 0 +} + +# dom::tcl::XPath:SN:DescendAndTest -- +# +# Descend the element hierarchy, +# apply the node test as we go +# +# Arguments: +# nodeset nodes to be tested and descended +# test node test +# +# Results: +# Returned nodeset of nodes which pass the test + +proc dom::tcl::XPath:SN:DescendAndTest {nodeset test} { + set result {} + + foreach node $nodeset { + if {[XPath:SN:ApplyNodeTest $node $test]} { + lappend result $node + } + switch [node cget $node -nodeType] { + document - + documentFragment - + element { + eval lappend result [XPath:SN:DescendAndTest [node children $node] $test] + } + } + } + + return $result +} + +# dom::tcl::XPath:ApplyPredicates -- +# +# Filter a nodeset with predicates +# +# Arguments: +# ctxt current context nodeset +# preds list of predicates +# +# Results: +# Returns new (possibly reduced) context nodeset + +proc dom::tcl::XPath:ApplyPredicates {ctxt preds} { + + set result {} + foreach node $ctxt { + set passed 1 + foreach predicate $preds { + if {![XPath:ApplyPredicate $node $predicate]} { + set passed 0 + break + } + } + if {$passed} { + lappend result $node + } + } + + return $result +} + +# dom::tcl::XPath:ApplyPredicate -- +# +# Filter a node with a single predicate +# +# Arguments: +# node current context node +# pred predicate +# +# Results: +# Returns boolean + +proc dom::tcl::XPath:ApplyPredicate {node pred} { + + switch -- [lindex $pred 0] { + = - + != - + >= - + <= - + > - + > { + + if {[llength $pred] != 3} { + return -code error "malformed expression" + } + + set operand1 [XPath:Pred:ResolveExpr $node [lindex $pred 1]] + set operand2 [XPath:Pred:ResolveExpr $node [lindex $pred 2]] + + # Convert operands to the correct type, if necessary + switch -glob [lindex $operand1 0],[lindex $operand2 0] { + literal,literal { + return [XPath:Pred:CompareLiterals [lindex $pred 0] [lindex $operand1 1] [lindex $operand2 1]] + } + + number,number - + literal,number - + number,literal { + # Compare as numbers + return [XPath:Pred:CompareNumbers [lindex $pred 0] [lindex $operand1 1] [lindex $operand2 1]] + } + + boolean,boolean { + # Compare as booleans + return -code error "boolean comparison not yet implemented" + } + + node,node { + # Nodeset comparison + return -code error "nodeset comparison not yet implemented" + } + + node,* { + set value {} + if {[llength [lindex $operand1 1]]} { + set value [node stringValue [lindex [lindex $operand1 1] 0]] + } + return [XPath:Pred:CompareLiterals [lindex $pred 0] $value [lindex $operand2 1]] + } + *,node { + set value {} + if {[llength [lindex $operand2 1]]} { + set value [node stringValue [lindex [lindex $operand2 1] 0]] + } + return [XPath:Pred:CompareLiterals [lindex $pred 0] $value [lindex $operand1 1]] + } + + default { + return -code error "can't compare [lindex $operand1 0] to [lindex $operand2 0]" + } + } + } + + function { + return -code error "invalid predicate" + } + number - + literal { + return -code error "invalid predicate" + } + + path { + set nodeset [XPath:SelectNode:Rel $node [lindex $pred 1]] + return [expr {[llength $nodeset] > 0 ? 1 : 0}] + } + + } + + return 1 +} + +# dom::tcl::XPath:Pred:Compare -- + +proc dom::tcl::XPath:Pred:CompareLiterals {op operand1 operand2} { + set result [string compare $operand1 $operand2] + + # The obvious: + #return [expr {$result $opMap($op) 0}] + # doesn't compile + + switch $op { + = { + return [expr {$result == 0}] + } + != { + return [expr {$result != 0}] + } + <= { + return [expr {$result <= 0}] + } + >= { + return [expr {$result >= 0}] + } + < { + return [expr {$result < 0}] + } + > { + return [expr {$result > 0}] + } + } + return -code error "internal error" +} + +# dom::tcl::XPath:Pred:ResolveExpr -- + +proc dom::tcl::XPath:Pred:ResolveExpr {node expr} { + + switch [lindex $expr 0] { + path { + return [list node [XPath:SelectNode:Rel $node [lindex $expr 1]]] + } + + function - + group { + return -code error "[lindex $expr 0] not yet implemented" + } + literal - + number - + boolean { + return $expr + } + + default { + return -code error "internal error" + } + } + + return {} +} + +################################################# +# +# Miscellaneous +# +################################################# + +# dom::tcl::hasmixedcontent -- +# +# Determine whether an element contains mixed content +# +# Arguments: +# token dom node +# +# Results: +# Returns 1 if element contains mixed content, +# 0 otherwise + +proc dom::tcl::hasmixedcontent token { + upvar #0 $token node + + if {[string compare $node(node:nodeType) "element"]} { + # Really undefined + return 0 + } + + foreach child [set $node(node:childNodes)] { + upvar #0 $child childnode + if {![string compare $childnode(node:nodeType) "textNode"]} { + return 1 + } + } + + return 0 +} + +# dom::tcl::prefix2namespaceURI -- +# +# Given an XML Namespace prefix, find the corresponding Namespace URI +# +# Arguments: +# node DOM Node +# prefix XML Namespace prefix +# +# Results: +# Returns URI + +proc dom::tcl::prefix2namespaceURI {node prefix} { + + # Search this node and its ancestors for the appropriate + # XML Namespace declaration + + set parent [dom::node parent $node] + set nsuri [dom::element getAttributeNS $node $::dom::xmlnsURI $prefix] + if {[string length $parent] && ![string length $nsuri]} { + set nsuri [dom::element getAttributeNS $parent $::dom::xmlnsURI $prefix] + set parent [dom::node parent $parent] + } + + if {[string length $nsuri]} { + return $nsuri + } else { + return -code error "unable to find namespace URI for prefix \"$prefix\"" + } + +} + +# dom::tcl::namespaceURI2prefix -- +# +# Given an XML Namespace URI, find the corresponding prefix +# +# Arguments: +# node DOM Node +# nsuri XML Namespace URI +# +# Results: +# Returns prefix + +proc dom::tcl::namespaceURI2prefix {node nsuri} { + + # Search this node and its ancestors for the desired + # XML Namespace declaration + + set found 0 + set prefix {} + set parent [dom::node parent $node] + while {[string length $parent]} { + upvar #0 $node nodeinfo + catch {unset attrs} + array set attrs [array get $nodeinfo(element:attributeList)] + foreach {nsdecl declNSuri} [array get attrs ${::dom::xmlnsURI}^*] { + if {![string compare $declNSuri $nsuri]} { + set found 1 + set prefix [lindex [split $nsdecl ^] 1] + break + } + } + if {$found} { + break + } + set node $parent + set parent [dom::node parent $node] + } + + if {$found} { + return $prefix + } else { + return -code error "unable to find prefix for namespace URI \"$nsuri\"" + } + +} + +# dom::tcl::GetField -- +# +# Return a value, or empty string if not defined +# +# Arguments: +# var name of variable to return +# +# Results: +# Returns the value, or empty string if variable is not defined. + +proc dom::tcl::GetField var { + upvar $var v + if {[info exists v]} { + return $v + } else { + return {} + } +} + +# dom::tcl::Min -- +# +# Return the minimum of two numeric values +# +# Arguments: +# a a value +# b another value +# +# Results: +# Returns the value which is lower than the other. + +proc dom::tcl::Min {a b} { + return [expr {$a < $b ? $a : $b}] +} + +# dom::tcl::Max -- +# +# Return the maximum of two numeric values +# +# Arguments: +# a a value +# b another value +# +# Results: +# Returns the value which is greater than the other. + +proc dom::tcl::Max {a b} { + return [expr {$a > $b ? $a : $b}] +} + +# dom::tcl::Boolean -- +# +# Return a boolean value +# +# Arguments: +# b value +# +# Results: +# Returns 0 or 1 + +proc dom::tcl::Boolean b { + regsub -nocase {^(true|yes|1|on)$} $b 1 b + regsub -nocase {^(false|no|0|off)$} $b 0 b + return $b +} + diff --git a/tcldom-tcl/dommap.tcl b/tcldom-tcl/dommap.tcl new file mode 100644 index 0000000..9d9ec87 --- /dev/null +++ b/tcldom-tcl/dommap.tcl @@ -0,0 +1,108 @@ +# dommap.tcl -- +# +# Apply a mapping function to a DOM structure +# +# Copyright (c) 1998-2003 Zveno Pty Ltd +# http://www.zveno.com/ +# +# See the file "LICENSE" in this distribution for information on usage and +# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# $Id: dommap.tcl,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $ + +package provide dommap 1.0 + +# We need the DOM +package require dom 2.6 + +namespace eval dommap { + namespace export map +} + +# dommap::apply -- +# +# Apply a function to a DOM document. +# +# The callback command is invoked with the node ID of the +# matching DOM node as its argument. The command may return +# an error, continue or break code to alter the processing +# of further nodes. +# +# Filter functions may be applied to match particular +# nodes. Valid functions include: +# +# -nodeType regexp +# -nodeName regexp +# -nodeValue regexp +# -attribute {regexp regexp} +# +# If a filter is specified then the node must match for the +# callback command to be invoked. If a filter is not specified +# then all nodes match that filter. +# +# Arguments: +# node DOM document node +# cmd callback command +# args configuration options +# +# Results: +# Depends on callback command + +proc dommap::apply {node cmd args} { + array set opts $args + + # Does this node match? + set match 1 + catch {set match [expr $match && [regexp $opts(-nodeType) [::dom::node cget $node -nodeType]]]} + catch {set match [expr $match && [regexp $opts(-nodeName) [::dom::node cget $node -nodeName]]]} + catch {set match [expr $match && [regexp $opts(-nodeValue) [::dom::node cget $node -nodeValue]]]} + if {$match && ![string compare [::dom::node cget $node -nodeType] element]} { + set match 0 + foreach {attrName attrValue} [array get [::dom::node cget $node -attributes]] { + set match 1 + catch {set match [expr $match && [regexp [lindex $opts(-attribute) 0] $attrName]]} + catch {set match [expr $match && [regexp [lindex $opts(-attribute) 1] $attrValue]]} + if {$match} break + } + } + if {$match && [set code [catch {eval $cmd [list $node]} msg]]} { + switch $code { + 0 {} + 3 { + return -code break + } + 4 { + return -code continue + } + default { + return -code error $msg + } + } + } + + # Process children + foreach child [::dom::node children $node] { + switch [catch {eval apply [list $child] [list $cmd] $args} msg] { + 0 { + # No action required + } + 3 { + # break + return -code break + } + 4 { + # continue - skip processing of siblings + return + } + 1 - + 2 - + default { + # propagate the error message + return -code error $msg + } + } + } + + return {} +} + diff --git a/tcldom-tcl/xmlswitch.tcl b/tcldom-tcl/xmlswitch.tcl new file mode 100644 index 0000000..4e2a2a1 --- /dev/null +++ b/tcldom-tcl/xmlswitch.tcl @@ -0,0 +1,520 @@ +# xmlswitch.tcl -- +# +# This file implements a control structure for Tcl. +# 'xmlswitch' iterates over an XML document. Features in +# the document may be specified using XPath location paths, +# and these will trigger Tcl scripts when matched. +# +# Copyright (c) 2008 Explain +# http://www.explain.com.au/ +# Copyright (c) 2000-2003 Zveno Pty Ltd +# http://www.zveno.com/ +# +# See the file "LICENSE" in this distribution for information on usage and +# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# $Id: xmlswitch.tcl,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $ + +package provide xmlswitch 3.2 + +# We need the xml, dom and xpath packages + +package require xml 3.2 +package require dom 3.2 +package require xpath 1.0 + +namespace eval xmlswitch { + namespace export xmlswitch xmlswitchcont xmlswitchend + namespace export domswitch + namespace export free rootnode + + variable counter 0 + + variable typemap + array set typemap { + text textNode + comment comment + processing-instruction processingInstruction + } +} + +# xmlswitch::xmlswitch -- +# +# Parse XML data, matching for XPath locations along the way +# and (possibly) triggering callbacks. +# +# A DOM tree is built as a side-effect (necessary for resolving +# XPath location paths). +# +# Arguments: +# xml XML document +# args configuration options, +# plus a single path/script expression, or multiple expressions +# +# Results: +# Tcl callbacks may be invoked. +# If -async option is true returns a token for this "process". + +proc xmlswitch::xmlswitch {xml args} { + variable counter + + set stateVarName [namespace current]::State[incr counter] + upvar #0 $stateVarName state + set state(stateVarName) $stateVarName + set state(-async) 0 + + set state(pathArray) ${stateVarName}Paths + upvar #0 $state(pathArray) paths + array set paths {} + + set cleanup { + unset state + unset paths + } + + # Find configuration options and remove + set numOpts 0 + foreach {opt value} $args { + switch -glob -- $opt { + -* { + set state($opt) $value + incr numOpts 2 + } + default { + set args [lrange $args $numOpts end] + break + } + } + } + + switch -- [llength $args] { + 0 { + # Nothing to do + eval $cleanup + return $stateVarName + } + 1 { + foreach {path script} [lindex $args 0] { + set paths([xpath::split $path]) $script + } + } + default { + if {[llength $args] % 2} { + eval $cleanup + return -code error "no script matching location path \"[lindex $args end]\"" + } + foreach {path script} $args { + set paths([xpath::split $path]) $script + } + } + } + + set root [set state(root) [dom::DOMImplementation create]] + set state(current) $root + + # Parse the document + # We're going to do this incrementally, so the caller can + # break at any time + set state(parser) [eval xml::parser [array get state -parser]] + #append cleanup "\n $parser destroy\n" + $state(parser) configure \ + -elementstartcommand [namespace code [list ParseElementStart $stateVarName]] \ + -elementendcommand [namespace code [list ParseElementEnd $stateVarName]] \ + -characterdatacommand [namespace code [list ParseCharacterData $stateVarName]] \ + -final 0 + +# -processinginstructioncommand [namespace code [list ParsePI $stateVarName]] \ +# -commentcommand [namespace code [list ParseComment]] + + if {[catch {$state(parser) parse $xml} err]} { + eval $cleanup + return -code error $err + } + + if {$state(-async)} { + return $stateVarName + } else { + eval $cleanup + return {} + } +} + +# xmlswitch::xmlswitchcont -- +# +# Provide more XML data to parse +# +# Arguments: +# token state variable name +# xml XML data +# +# Results: +# More parsing + +proc xmlswitch::xmlswitchcont {token xml} { + upvar #0 $token state + + $state(parser) parse $xml + + return {} +} + +# xmlswitch::xmlswitchend -- +# +# Signal that no further data is available +# +# Arguments: +# token state array +# +# Results: +# Parser configuration changed + +proc xmlswitch::xmlswitchend token { + upvar #0 $token state + + $state(parser) configure -final true + + return {} +} + +# xmlswitch::rootnode -- +# +# Get the root node +# +# Arguments: +# token state array +# +# Results: +# Returns root node token + +proc xmlswitch::rootnode token { + upvar #0 $token state + + return $state(root) +} + +# xmlswitch::free -- +# +# Free resources EXCEPT the DOM tree. +# "-all" causes DOM tree to be destroyed too. +# +# Arguments: +# token state array +# args options +# +# Results: +# Resources freed. + +proc xmlswitch::free {token args} { + upvar #0 $token state + + if {[lsearch $args "-all"] >= 0} { + dom::DOMImplementation destroy $state(root) + } + + catch {unset $state(pathArray)} + catch {unset state} + + catch {$state(parser) free} + + return {} +} + +# xmlswitch::ParseElementStart -- +# +# Handle element start tag +# +# Arguments: +# token state array +# name element type +# attrList attribute list +# args options +# Results: +# All XPath location paths are checked for a match, +# and script evaluated for matching XPath. +# DOM tree node added. + +proc xmlswitch::ParseElementStart:dbgdisabled {token name attrList args} { + if {[catch {eval ParseElementStart:dbg [list $token $name $attrList] $args} msg]} { + puts stderr [list ParseElementStart failed with msg $msg] + puts stderr $::errorInfo + return -code error $msg + } else { + puts stderr [list ParseElementStart returned OK] + } + return $msg +} +proc xmlswitch::ParseElementStart {token name attrList args} { + + upvar #0 $token state + array set opts $args + + #puts stderr [list xmlswitch::ParseElementStart $token $name $attrList $args] + + lappend state(current) \ + [dom::document createElement [lindex $state(current) end] $name] + foreach {name value} $attrList { + dom::element setAttribute [lindex $state(current) end] $name $value + } + + MatchTemplates $token [lindex $state(current) end] + + return {} +} + +# xmlswitch::ParseElementEnd -- +# +# Handle element end tag +# +# Arguments: +# token state array +# name element type +# args options +# Results: +# State changed + +proc xmlswitch::ParseElementEnd {token name args} { + upvar #0 $token state + + set state(current) [lreplace $state(current) end end] + + return {} +} + +# xmlswitch::ParseCharacterData -- +# +# Handle character data +# +# Arguments: +# token state array +# data pcdata +# +# Results: +# All XPath location paths are checked for a match, +# and script evaluated for matching XPath. +# DOM tree node added. + +proc xmlswitch::ParseCharacterData {token data} { + upvar #0 $token state + + lappend state(current) \ + [dom::document createTextNode [lindex $state(current) end] $data] + + MatchTemplates $token [lindex $state(current) end] + + set state(current) [lreplace $state(current) end end] + + return {} +} + +# xmlswitch::domswitch -- +# +# Similar to xmlswitch above, but iterates over a pre-built +# DOM tree. +# +# Arguments: +# xml XML document +# args a single path/script expression, or multiple expressions +# +# Results: +# Tcl callbacks may be invoked. + +proc xmlswitch::domswitch {xml args} { +} + +# xmlswitch::MatchTemplates -- +# +# Check all templates for one which matches +# the current node. +# +# Arguments: +# token state array +# node Current DOM node +# +# Results: +# If a template matches, its script is evaluated + +proc xmlswitch::MatchTemplates {token node} { + upvar #0 $token state + upvar #0 $state(pathArray) paths + + #puts stderr [list xmlswitch::MatchTemplates $token $node (type: [dom::node cget $node -nodeType]) (name: [dom::node cget $node -nodeName])] + + set matches {} + + foreach {path script} [array get paths] { + + #puts stderr [list checking path $path for a match] + + set context $node + + # Work backwards along the path, reversing each axis + set match 0 + set i [llength $path] + #puts stderr [list $i steps to be tested] + while {[incr i -1] >= 0} { + #puts stderr [list step $i [lindex $path $i]] + switch -glob [llength [lindex $path $i]],$i { + 0,0 { + #puts stderr [list absolute path, end of steps - am I at the root?] + if {![string length [dom::node parent $context]]} { + #puts stderr [list absolute path matched] + lappend matches [list $path $script] + } else { + #puts stderr [list absolute path did not match] + } + } + *,0 { + #puts stderr [list last step, relative path] + switch [lindex [lindex $path $i] 0] { + child { + if {[NodeTest [lindex $path $i] $context] && \ + [CheckPredicates [lindex $path $i] $context]} { + #puts stderr [list relative path matched] + lappend matches [list $path $script] + } else { + #puts stderr [list relative path did not match] + } + } + default { + return -code error "axis \"[lindex [lindex $path $i] 0]\" not supported" + } + } + } + default { + #puts stderr [list continuing checking steps] + switch [lindex [lindex $path $i] 0] { + child { + if {[NodeTest [lindex $path $i] $context] && \ + [CheckPredicates [lindex $path $i] $context]} { + set context [dom::node parent $context] + } else { + #puts stderr [list no match] + } + } + default { + return -code error "axis \"[lindex [lindex $path $i] 0]\" not supported" + } + } + } + } + } + } + + # TODO: If there are multiple matches then we must pick the + # most specific match + + if {[llength $matches] > 1} { + # For the moment we'll just take the first match + set matches [list [lindex $matches 0]] + } + + if {[llength $matches]} { + #puts stderr [list evaluating callback at level [info level]] + uplevel 3 [lindex [lindex $matches 0] 1] + } + + return {} +} + +# xmlswitch::NodeTest -- +# +# Check that the node passes the node (type) test +# +# Arguments: +# step Location step +# node DOM node +# +# Results: +# Boolean + +proc xmlswitch::NodeTest {step node} { + + if {[llength [lindex $step 1]] > 1} { + switch -glob -- [lindex [lindex $step 1] 0],[dom::node cget $node -nodeType] { + node,* - + text,textNode - + comment,comment - + processing-instruction,processingInstruction { + return 1 + } + default { + return 0 + } + } + } elseif {![string compare [lindex $step 1] "*"]} { + return 1 + } elseif {![string compare [lindex $step 1] [dom::node cget $node -nodeName]]} { + return 1 + } else { + return 0 + } +} + +# xmlswitch::CheckPredicates -- +# +# Check that the node passes the predicates +# +# Arguments: +# step Location step +# node DOM node +# +# Results: +# Boolean + +proc xmlswitch::CheckPredicates {step node} { + variable typemap + + set predicates [lindex $step 2] + # Shortcut: no predicates means everything passes + if {![llength $predicates]} { + return 1 + } + + # Get the context node set + switch [lindex $step 0] { + child { + set nodeset {} + if {[llength [lindex $step 1]]} { + foreach {name typetest} [lindex $step 1] break + switch -- $name { + node { + set nodeset [dom::node children [dom::node parent $node]] + } + text - + comment - + processing-instruction { + foreach child [dom::node children [dom::node parent $node]] { + if {![string compare [dom::node cget $child -nodeType] $typemap($name)]} { + lappend nodeset $child + } + } + } + default { + # Error + } + } + } else { + foreach child [dom::node children [dom::node parent $node]] { + if {![string compare [lindex $step 1] [dom::node cget $child -nodeName]]} { + lappend nodeset $child + } + } + } + } + default { + return -code error "axis \"[lindex $step 0]\" not supported" + } + } + + foreach predicate $predicates { + # position() is the only supported predicate + if {[lsearch $nodeset $node] + 1 == $predicate} { + # continue + } else { + return 0 + } + } + + return 1 +} + diff --git a/tcldom.c b/tcldom.c new file mode 100644 index 0000000..467a9c2 --- /dev/null +++ b/tcldom.c @@ -0,0 +1,333 @@ +/* + * tcldom.c -- + * + * Generic interface to DOM Implementation. + * As of v3.0, there is no substantial generic layer; + * instead each implementation provides its own commands + * directly. This module now provides common definitions + * for method/option tables, etc. + * + * Copyright (c) 2006-2007 Explain + * http://www.explain.com.au/ + * Copyright (c) 2002-2004 Steve Ball, Zveno Pty Ltd + * + * See the file "LICENSE" for information on usage and + * redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * $Id: tcldom.c,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $ + * + */ + +#include + +/* + * Method tables for commands + */ + +#ifndef CONST84 +#define CONST84 /* Before 8.4 no 'const' required */ +#endif + +CONST84 char *TclDOM_DOMImplementationCommandMethods[] = { + "hasFeature", + "createDocument", + "create", + "createDocumentType", + "createNode", + "destroy", + "isNode", + "parse", + "selectNode", + "serialize", + "trim", + (char *) NULL +}; +CONST84 char *TclDOM_DocumentCommandMethods[] = { + "cget", + "configure", + "createElement", + "createDocumentFragment", + "createTextNode", + "createComment", + "createCDATASection", + "createProcessingInstruction", + "createAttribute", + "createEntity", + "createEntityReference", + "createDocTypeDecl", + "importNode", + "createElementNS", + "createAttributeNS", + "getElementsByTagNameNS", + "getElementsById", + "createEvent", + "getElementsByTagName", + "dtd", + "schema", + (char *) NULL +}; +CONST84 char *TclDOM_DocumentCommandOptions[] = { + "-doctype", + "-implementation", + "-documentElement", + (char *) NULL +}; +CONST84 char *TclDOM_DocumentDTDSubmethods[] = { + "validate", + (char *) NULL +}; +CONST84 char *TclDOM_DocumentSchemaSubmethods[] = { + "compile", + "validate", + (char *) NULL +}; +CONST84 char *TclDOM_DocumentRelaxNGSubmethods[] = { + "compile", + "validate", + (char *) NULL +}; +CONST84 char *TclDOM_NodeCommandMethods[] = { + "cget", + "configure", + "insertBefore", + "replaceChild", + "removeChild", + "appendChild", + "hasChildNodes", + "cloneNode", + "children", + "parent", + "path", + "createNode", + "selectNode", + "stringValue", + "addEventListener", + "removeEventListener", + "dispatchEvent", + "isSameNode", + (char *) NULL +}; +CONST84 char *TclDOM_NodeCommandOptions[] = { + "-nodeType", + "-parentNode", + "-childNodes", + "-firstChild", + "-lastChild", + "-previousSibling", + "-nextSibling", + "-attributes", + "-namespaceURI", + "-prefix", + "-localName", + "-nodeValue", + "-cdatasection", + "-nodeName", + "-ownerDocument", + (char *) NULL +}; +CONST84 char *TclDOM_NodeCommandAddEventListenerOptions[] = { + "-usecapture", + (char *) NULL +}; +CONST84 char *TclDOM_ElementCommandMethods[] = { + "cget", + "configure", + "getAttribute", + "setAttribute", + "removeAttribute", + "getAttributeNS", + "setAttributeNS", + "removeAttributeNS", + "getAttributeNode", + "setAttributeNode", + "removeAttributeNode", + "getAttributeNodeNS", + "setAttributeNodeNS", + "removeAttributeNodeNS", + "getElementsByTagName", + "normalize", + (char *) NULL +}; +CONST84 char *TclDOM_ElementCommandOptions[] = { + "-tagName", + "-empty", + (char *) NULL +}; +CONST84 char *TclDOM_EventCommandMethods[] = { + "cget", + "configure", + "stopPropagation", + "preventDefault", + "initEvent", + "initUIEvent", + "initMouseEvent", + "initMutationEvent", + "postUIEvent", + "postMouseEvent", + "postMutationEvent", + (char *) NULL +}; +CONST84 char *TclDOM_EventCommandOptions[] = { + "-altKey", + "-attrName", + "-attrChange", + "-bubbles", + "-button", + "-cancelable", + "-clientX", + "-clientY", + "-ctrlKey", + "-currentNode", + "-detail", + "-eventPhase", + "-metaKey", + "-newValue", + "-prevValue", + "-relatedNode", + "-screenX", + "-screenY", + "-shiftKey", + "-target", + "-timeStamp", + "-type", + "-view", + (char *) NULL +}; +CONST84 char *TclDOM_EventTypes[] = { + "DOMFocusIn", + "DOMFocusOut", + "DOMActivate", + "click", + "mousedown", + "mouseup", + "mouseover", + "mousemove", + "mouseout", + "DOMSubtreeModified", + "DOMNodeInserted", + "DOMNodeRemoved", + "DOMNodeInsertedIntoDocument", + "DOMNodeRemovedFromDocument", + "DOMAttrModified", + "DOMCharacterDataModified" +}; + +CONST84 char *TclDOM_ParseCommandOptions[] = { + "-baseuri", + "-externalentitycommand", + (char *) NULL +}; +CONST84 char *TclDOM_SerializeCommandOptions[] = { + "-indent", + "-method", + "-encoding", + "-omitxmldeclaration", + (char *) NULL +}; +CONST84 char *TclDOM_SerializeMethods[] = { + "xml", + "html", + "text", + (char *) NULL +}; +CONST84 char *TclDOM_SelectNodeOptions[] = { + "-namespaces", + (char *) NULL +}; + +#if 0 +/* + *---------------------------------------------------------------------------- + * + * Tcldom_Init -- + * + * Initialisation routine for generic module. + * NB. As of TclDOM v3.0 this module no longer gets loaded as + * a separate package. + * + * Results: + * None. + * + * Side effects: + * Creates variables. + * + *---------------------------------------------------------------------------- + */ + +int +Tcldom_Init (interp) + Tcl_Interp *interp; /* Interpreter to initialise. */ +{ + Tcl_Obj *objPtr; + + Tcl_SetVar(interp, "::dom::strictDOM", "0", TCL_GLOBAL_ONLY); + Tcl_SetVar(interp, "::dom::maxSpecials", "10", TCL_GLOBAL_ONLY); + objPtr = Tcl_NewListObj(0, NULL); + Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewIntObj(2)); + Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(" ", -1)); + Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("\t", -1)); + Tcl_SetVar2Ex(interp, "::dom::indentspec", NULL, objPtr, TCL_GLOBAL_ONLY); + Tcl_SetVar(interp, "::dom::xmlnsURI", "http://www.w3.org/2000/xmlns/", TCL_GLOBAL_ONLY); + + return TCL_OK; +} +#endif /* 0 */ + +/* + *---------------------------------------------------------------------------- + * + * TclDOM_SetVars -- + * + * Initialisation routine for TclDOM modules. + * + * Results: + * None. + * + * Side effects: + * Creates variables. + * + *---------------------------------------------------------------------------- + */ + +int +TclDOM_SetVars(interp) + Tcl_Interp *interp; +{ + Tcl_SetVar2Ex(interp, "::dom::bubbles", "DOMFocusIn", Tcl_NewIntObj(1), 0); + Tcl_SetVar2Ex(interp, "::dom::bubbles", "DOMFocusOut", Tcl_NewIntObj(1), 0); + Tcl_SetVar2Ex(interp, "::dom::bubbles", "DOMActivate", Tcl_NewIntObj(1), 0); + Tcl_SetVar2Ex(interp, "::dom::bubbles", "click", Tcl_NewIntObj(1), 0); + Tcl_SetVar2Ex(interp, "::dom::bubbles", "mousedown", Tcl_NewIntObj(1), 0); + Tcl_SetVar2Ex(interp, "::dom::bubbles", "mouseup", Tcl_NewIntObj(1), 0); + Tcl_SetVar2Ex(interp, "::dom::bubbles", "mouseover", Tcl_NewIntObj(1), 0); + Tcl_SetVar2Ex(interp, "::dom::bubbles", "mousemove", Tcl_NewIntObj(1), 0); + Tcl_SetVar2Ex(interp, "::dom::bubbles", "mouseout", Tcl_NewIntObj(1), 0); + Tcl_SetVar2Ex(interp, "::dom::bubbles", "DOMSubtreeModified", Tcl_NewIntObj(1), 0); + Tcl_SetVar2Ex(interp, "::dom::bubbles", "DOMNodeInserted", Tcl_NewIntObj(1), 0); + Tcl_SetVar2Ex(interp, "::dom::bubbles", "DOMRemoved", Tcl_NewIntObj(1), 0); + Tcl_SetVar2Ex(interp, "::dom::bubbles", "DOMNodeInsertedIntoDocument", Tcl_NewIntObj(0), 0); + Tcl_SetVar2Ex(interp, "::dom::bubbles", "DOMRemovedFromDocument", Tcl_NewIntObj(0), 0); + Tcl_SetVar2Ex(interp, "::dom::bubbles", "DOMAttrModified", Tcl_NewIntObj(1), 0); + Tcl_SetVar2Ex(interp, "::dom::bubbles", "DOMAttrRemoved", Tcl_NewIntObj(1), 0); + Tcl_SetVar2Ex(interp, "::dom::bubbles", "DOMCharacterDataModified", Tcl_NewIntObj(1), 0); + + Tcl_SetVar2Ex(interp, "::dom::cancelable", "DOMFocusIn", Tcl_NewIntObj(0), 0); + Tcl_SetVar2Ex(interp, "::dom::cancelable", "DOMFocusOut", Tcl_NewIntObj(0), 0); + Tcl_SetVar2Ex(interp, "::dom::cancelable", "DOMActivate", Tcl_NewIntObj(1), 0); + Tcl_SetVar2Ex(interp, "::dom::cancelable", "click", Tcl_NewIntObj(1), 0); + Tcl_SetVar2Ex(interp, "::dom::cancelable", "mousedown", Tcl_NewIntObj(1), 0); + Tcl_SetVar2Ex(interp, "::dom::cancelable", "mouseup", Tcl_NewIntObj(1), 0); + Tcl_SetVar2Ex(interp, "::dom::cancelable", "mouseover", Tcl_NewIntObj(1), 0); + Tcl_SetVar2Ex(interp, "::dom::cancelable", "mousemove", Tcl_NewIntObj(0), 0); + Tcl_SetVar2Ex(interp, "::dom::cancelable", "mouseout", Tcl_NewIntObj(1), 0); + Tcl_SetVar2Ex(interp, "::dom::cancelable", "DOMSubtreeModified", Tcl_NewIntObj(0), 0); + Tcl_SetVar2Ex(interp, "::dom::cancelable", "DOMNodeInserted", Tcl_NewIntObj(0), 0); + Tcl_SetVar2Ex(interp, "::dom::cancelable", "DOMRemoved", Tcl_NewIntObj(0), 0); + Tcl_SetVar2Ex(interp, "::dom::cancelable", "DOMNodeInsertedIntoDocument", Tcl_NewIntObj(0), 0); + Tcl_SetVar2Ex(interp, "::dom::cancelable", "DOMRemovedFromDocument", Tcl_NewIntObj(0), 0); + Tcl_SetVar2Ex(interp, "::dom::cancelable", "DOMAttrModified", Tcl_NewIntObj(0), 0); + Tcl_SetVar2Ex(interp, "::dom::cancelable", "DOMAttrRemoved", Tcl_NewIntObj(0), 0); + Tcl_SetVar2Ex(interp, "::dom::cancelable", "DOMCharacterDataModified", Tcl_NewIntObj(0), 0); + + return TCL_OK; +} diff --git a/tclxml-libxml2.c b/tclxml-libxml2.c new file mode 100755 index 0000000..29ee985 --- /dev/null +++ b/tclxml-libxml2.c @@ -0,0 +1,982 @@ +/* tcllibxml2.c -- + * + * A Tcl wrapper for libxml2. + * + * Copyright (c) 2005-2008 Explain. + * http://www.explain.com.au/ + * Copyright (c) 2003-2004 Zveno Pty Ltd + * http://www.zveno.com/ + * + * See the file "LICENSE" for information on usage and + * redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * $Id: tclxml-libxml2.c,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $ + */ + +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#define TCL_DOES_STUBS \ + (TCL_MAJOR_VERSION > 8 || TCL_MAJOR_VERSION == 8 && (TCL_MINOR_VERSION > 1 || \ + (TCL_MINOR_VERSION == 1 && TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE))) + +/* + * The structure below is used to refer to a libxml2 parser object. + */ + +typedef struct TclXMLlibxml2Info { + Tcl_Interp *interp; /* Interpreter for this instance */ + + xmlTextReaderPtr reader; /* New TextReader interface */ + + Tcl_Obj *docObjPtr; /* Result of parsing */ + TclXML_libxml2_DocumentHandling keep; /* Document handling flag */ + Tcl_Obj *preserve; /* XPath for retaining (a portion of) the document */ + Tcl_Obj *preservens; /* list of namespace declarations */ + + TclXML_Info *xmlinfo; /* Generic data structure */ + + Tcl_HashTable *scope; /* XML namespaces in scope */ + +} TclXMLlibxml2Info; + +/* + * Forward declarations for private functions. + */ + +static ClientData ReaderCreate _ANSI_ARGS_((Tcl_Interp *interp, + TclXML_Info *xmlinfo)); +static int ReaderReset _ANSI_ARGS_((ClientData clientData)); +static int TclXMLlibxml2Delete _ANSI_ARGS_((ClientData clientData)); +static int ReaderParse _ANSI_ARGS_((ClientData clientData, + char *data, int len, int final)); +static int TclXMLlibxml2Configure _ANSI_ARGS_((ClientData clientdata, + Tcl_Obj *CONST optionPtr, + Tcl_Obj *CONST valuePtr)); +static int TclXMLlibxml2Get _ANSI_ARGS_((ClientData clientData, + int objc, Tcl_Obj *CONST objv[])); + +static xmlParserInputPtr TclXMLlibxml2ExternalEntityLoader _ANSI_ARGS_((const char *URL, + const char *ID, + xmlParserCtxtPtr ctxt)); + +/* + * Externally visible functions + */ + +typedef struct ThreadSpecificData { + int initialized; + + Tcl_Interp *interp; + + /* + * Interpose on default external entity loader + */ + + TclXMLlibxml2Info *current; + xmlExternalEntityLoader defaultLoader; + +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; + +/* + * libxml2 is mostly thread-safe, but there are issues with error callbacks + */ + +TCL_DECLARE_MUTEX(libxml2) + +#ifndef CONST84 +#define CONST84 /* Before 8.4 no 'const' required */ +#endif + +/* + *---------------------------------------------------------------------------- + * + * Tclxml_libxml2_Init -- + * + * Initialisation routine for loadable module + * + * Results: + * None. + * + * Side effects: + * Creates commands in the interpreter, + * + *---------------------------------------------------------------------------- + */ + +int +Tclxml_libxml2_Init (interp) + Tcl_Interp *interp; /* Interpreter to initialise */ +{ + ThreadSpecificData *tsdPtr; + TclXML_ParserClassInfo *classinfo; + +#ifdef USE_TCL_STUBS + if (Tcl_InitStubs(interp, "8.1", 0) == NULL) { + return TCL_ERROR; + } +#endif +#ifdef USE_TCLXML_STUBS + if (TclXML_InitStubs(interp, TCLXML_VERSION, 1) == NULL) { + return TCL_ERROR; + } +#endif + + classinfo = (TclXML_ParserClassInfo *) ckalloc(sizeof(TclXML_ParserClassInfo)); + classinfo->name = Tcl_NewStringObj("libxml2", -1); + classinfo->create = ReaderCreate; + classinfo->createCmd = NULL; + classinfo->createEntity = NULL; /* TclXMLlibxml2CreateEntityParser; */ + classinfo->createEntityCmd = NULL; + classinfo->parse = ReaderParse; + classinfo->parseCmd = NULL; + classinfo->configure = TclXMLlibxml2Configure; + classinfo->configureCmd = NULL; + classinfo->get = TclXMLlibxml2Get; + classinfo->getCmd = NULL; + classinfo->destroy = TclXMLlibxml2Delete; + classinfo->destroyCmd = NULL; + classinfo->reset = ReaderReset; + classinfo->resetCmd = NULL; + + if (TclXML_RegisterXMLParser(interp, classinfo) != TCL_OK) { + Tcl_SetResult(interp, "unable to register parser", NULL); + return TCL_ERROR; + } + + /* Configure the libxml2 parser */ + + Tcl_MutexLock(&libxml2); + + xmlInitParser(); + xmlSubstituteEntitiesDefault(1); + + /* + * TODO: provide configuration option for setting this value. + */ + xmlLoadExtDtdDefaultValue |= 1; + xmlLoadExtDtdDefaultValue |= XML_COMPLETE_ATTRS; + + /* + * Override default entity loader so we can implement callbacks + */ + + tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + if (!tsdPtr->initialized) { + tsdPtr->initialized = 1; + tsdPtr->interp = interp; + + tsdPtr->current = NULL; + tsdPtr->defaultLoader = xmlGetExternalEntityLoader(); + xmlSetExternalEntityLoader(TclXMLlibxml2ExternalEntityLoader); + } /* only need to init the library once per process */ + + /* Setting the variable is insufficient - must create namespace too. */ + if (Tcl_VarEval(interp, "namespace eval ::xml::libxml2 {variable libxml2version ", xmlParserVersion, "}\n", NULL) != TCL_OK) { + return TCL_ERROR; + } + + Tcl_MutexUnlock(&libxml2); + + TclXML_libxml2_InitDocObj(interp); + + #if (TCL_DOES_STUBS && USE_TCLXML_STUBS) + { + extern Tclxml_libxml2Stubs tclxml_libxml2Stubs; + if (Tcl_PkgProvideEx(interp, "xml::libxml2", TCLXML_VERSION, + (ClientData) &tclxml_libxml2Stubs) != TCL_OK) { + return TCL_ERROR; + } + } + #else + if (Tcl_PkgProvide(interp, "xml::libxml2", TCLXML_VERSION) != TCL_OK) { + return TCL_ERROR; + } + #endif + + return TCL_OK; +} + +/* + * TclXML/libxml2 is made safe by preventing the use of the default + * external entity loader. + */ + +int +Tclxml_libxml2_SafeInit (interp) + Tcl_Interp *interp; /* Interpreter to initialise */ +{ + return Tclxml_libxml2_Init(interp); +} + +/* + *---------------------------------------------------------------------------- + * + * TclXMLlibxml2Create -- + * + * Prepare for parsing. + * + * Results: + * Standard Tcl result. + * + * Side effects: + * This creates a Text Reader. + * + *---------------------------------------------------------------------------- + */ + +static ClientData +ReaderCreate(interp, xmlinfo) + Tcl_Interp *interp; + TclXML_Info *xmlinfo; +{ + TclXMLlibxml2Info *info; + xmlParserInputBufferPtr inputPtr; + + if (!(info = (TclXMLlibxml2Info *) Tcl_Alloc(sizeof(TclXMLlibxml2Info)))) { + Tcl_Free((char *) info); + Tcl_SetResult(interp, "unable to create parser", NULL); + return NULL; + } + info->interp = interp; + info->xmlinfo = xmlinfo; + info->preserve = NULL; + info->preservens = NULL; + + /* Create a dummy input buffer for the purpose of creating the TextReader. + * This will be replaced when we come to actually parse the document. + */ + Tcl_MutexLock(&libxml2); + inputPtr = xmlAllocParserInputBuffer(XML_CHAR_ENCODING_NONE); + if (inputPtr == NULL) { + Tcl_MutexUnlock(&libxml2); + + Tcl_Free((char *) info); + Tcl_SetResult(interp, "unable to create input buffer", NULL); + return NULL; + } + info->reader = xmlNewTextReader(inputPtr, NULL); + if (info->reader == NULL) { + Tcl_MutexUnlock(&libxml2); + + Tcl_Free((char *) info); + Tcl_SetResult(interp, "unable to create XML reader", NULL); + return NULL; + } + xmlTextReaderSetStructuredErrorHandler(info->reader, + (xmlStructuredErrorFunc) TclXML_libxml2_ErrorHandler, + NULL); + + Tcl_MutexUnlock(&libxml2); + + info->docObjPtr = NULL; + info->keep = TCLXML_LIBXML2_DOCUMENT_IMPLICIT; + info->scope = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable)); + Tcl_InitHashTable(info->scope, TCL_STRING_KEYS); + + return (ClientData) info; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXMLlibxml2Delete -- + * + * Destroy the libxml2 parser structure. + * + * Results: + * None. + * + * Side effects: + * Frees any memory allocated for the XML parser. + * + *---------------------------------------------------------------------------- + */ + +static int +TclXMLlibxml2Delete(clientData) + ClientData clientData; +{ + TclXMLlibxml2Info *info = (TclXMLlibxml2Info *) clientData; + + if (info->reader) { + xmlFreeTextReader(info->reader); + } + if (info->docObjPtr) { + Tcl_DecrRefCount(info->docObjPtr); + } + if (info->preserve) { + Tcl_DecrRefCount(info->preserve); + } + if (info->preservens) { + Tcl_DecrRefCount(info->preservens); + } + Tcl_DeleteHashTable(info->scope); + Tcl_Free((char *) info->scope); + Tcl_Free((char *) info); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * ReaderReset -- + * + * Reset the libxml2 parser structure. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------------- + */ + +static int +ReaderReset(clientData) +ClientData clientData; +{ + TclXML_Info *xmlinfo = (TclXML_Info *) clientData; + + if (xmlinfo->clientData == NULL) { + xmlinfo->clientData = (ClientData) ReaderCreate(xmlinfo->interp, xmlinfo); + if (xmlinfo->clientData == NULL) { + return TCL_ERROR; + } + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * ReaderParse -- + * + * Wrapper to invoke libxml2 parser and check return result. + * + * NB. Most of the logic from xmlSAXUserParseMemory is used here. + * + * Results: + * TCL_OK if no errors, TCL_ERROR otherwise. + * + * Side effects: + * Sets interpreter result as appropriate. + * + *---------------------------------------------------------------------------- + */ + +static int +ReaderParse(clientData, data, len, final) + ClientData clientData; + char *data; + int len; + int final; +{ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + TclXMLlibxml2Info *info = (TclXMLlibxml2Info *) clientData; + Tcl_Obj *nameObj, *nsObj, *nsdeclObj, *valueObj, *attrsObj, *errObj, *baseuriObj, *sysidObj, *extidObj; + const char *baseuri, *encoding, *name, *ns, *value; + xmlChar **preservens = NULL; + int ret, result = TCL_OK, i, listlen, options = 0, empty; + + /* not used... at present (see case XML_READER_TYPE_DOCUMENT_TYPE) + xmlNodePtr nodePtr; + */ + xmlEntityPtr entityPtr = NULL; + + if (final == 0) { + Tcl_SetResult(info->interp, "partial input not yet supported", NULL); + return TCL_ERROR; + } + + if (info->preserve && info->preservens) { + if (Tcl_ListObjLength(info->interp, info->preservens, &listlen) != TCL_OK) { + return TCL_ERROR; + } + preservens = (xmlChar **) Tcl_Alloc(len * sizeof(xmlChar *) + 1); + for (i = 0; i < listlen; i++) { + Tcl_Obj *objPtr; + const char *str; + int strlen; + + if (Tcl_ListObjIndex(info->interp, info->preservens, i, &objPtr) != TCL_OK) { + Tcl_Free((char *) preservens); + return TCL_ERROR; + } + str = Tcl_GetStringFromObj(objPtr, &strlen); + preservens[i] = xmlCharStrndup(str, strlen); + } + preservens[listlen] = NULL; + } + if (info->xmlinfo->base) { + baseuri = Tcl_GetStringFromObj(info->xmlinfo->base, NULL); + } else { + baseuri = NULL; + } + if (info->xmlinfo->encoding) { + encoding = Tcl_GetStringFromObj(info->xmlinfo->encoding, NULL); + if (strcmp(encoding, "unknown") == 0) { + encoding = NULL; + } + } else { + encoding = "utf-8"; + } + + TclXML_libxml2_ResetError(info->interp); + + options |= XML_PARSE_NOCDATA; + + tsdPtr->current = info; + + Tcl_MutexLock(&libxml2); + + if (info->xmlinfo->expandinternalentities) { + options |= XML_PARSE_NOENT; + xmlSubstituteEntitiesDefault(1); + } else { + xmlSubstituteEntitiesDefault(0); + } + if (info->xmlinfo->nowhitespace) { + options |= XML_PARSE_NOBLANKS; + } + + if (xmlReaderNewMemory(info->reader, + data, len, + baseuri, + encoding, + options) != 0) { + Tcl_MutexUnlock(&libxml2); + if (preservens) { + int i; + for (i = 0; preservens[i]; i++) { + xmlFree(preservens[i]); + } + Tcl_Free((char *) preservens); + } + tsdPtr->current = NULL; + Tcl_SetResult(info->interp, "unable to prepare parser", NULL); + return TCL_ERROR; + } + + if (info->preserve) { + int preserveret; + preserveret = xmlTextReaderPreservePattern(info->reader, + (const xmlChar *) Tcl_GetStringFromObj(info->preserve, NULL), + (const xmlChar **) preservens); + if (preserveret < 0) { + Tcl_MutexUnlock(&libxml2); + if (preservens) { + int i; + for (i = 0; preservens[i]; i++) { + xmlFree(preservens[i]); + } + Tcl_Free((char *) preservens); + } + tsdPtr->current = NULL; + Tcl_ResetResult(info->interp); + Tcl_AppendResult(info->interp, + "preparation for parsing failed: unable to preserve pattern \"", + Tcl_GetStringFromObj(info->preserve, NULL), + "\"", + NULL); + return TCL_ERROR; + } + } + + for (ret = xmlTextReaderRead(info->reader); + ret == 1; + ret = xmlTextReaderRead(info->reader)) { + result = TCL_OK; + switch (xmlTextReaderNodeType(info->reader)) { + case XML_READER_TYPE_ELEMENT: + name = (const char *) xmlTextReaderConstLocalName(info->reader); + ns = (const char *) xmlTextReaderConstNamespaceUri(info->reader); + Tcl_MutexUnlock(&libxml2); + if (name != NULL) { + nameObj = Tcl_NewStringObj(name, -1); + } else { + nameObj = Tcl_NewObj(); + } + Tcl_IncrRefCount(nameObj); + if (ns != NULL) { + nsObj = Tcl_NewStringObj(ns, -1); + } else { + nsObj = Tcl_NewObj(); + } + Tcl_IncrRefCount(nsObj); + + attrsObj = Tcl_NewObj(); + Tcl_IncrRefCount(attrsObj); + Tcl_MutexLock(&libxml2); + if (xmlTextReaderHasAttributes(info->reader)) { + if (xmlTextReaderMoveToFirstAttribute(info->reader) == 1) { + Tcl_Obj *itemObj; + + itemObj = Tcl_NewObj(); + Tcl_SetStringObj(itemObj, (CONST char *) xmlTextReaderConstLocalName(info->reader), -1); + Tcl_ListObjAppendElement(info->interp, attrsObj, itemObj); + itemObj = Tcl_NewStringObj((CONST char *) xmlTextReaderConstValue(info->reader), -1); + Tcl_ListObjAppendElement(info->interp, attrsObj, itemObj); + + while (xmlTextReaderMoveToNextAttribute(info->reader) == 1) { + itemObj = Tcl_NewStringObj((CONST char *) xmlTextReaderConstLocalName(info->reader), -1); + Tcl_ListObjAppendElement(info->interp, attrsObj, itemObj); + itemObj = Tcl_NewStringObj((CONST char *) xmlTextReaderConstValue(info->reader), -1); + Tcl_ListObjAppendElement(info->interp, attrsObj, itemObj); + } + } + } + empty = xmlTextReaderIsEmptyElement(info->reader); + Tcl_MutexUnlock(&libxml2); + + nsdeclObj = Tcl_NewObj(); + Tcl_IncrRefCount(nsdeclObj); + + TclXML_ElementStartHandler(info->xmlinfo, + nameObj, + nsObj, + attrsObj, nsdeclObj); + + Tcl_DecrRefCount(nsdeclObj); + + if (empty) { + TclXML_ElementEndHandler(info->xmlinfo, + nameObj); + } + + Tcl_DecrRefCount(nameObj); + Tcl_DecrRefCount(nsObj); + Tcl_DecrRefCount(attrsObj); + break; + + case XML_READER_TYPE_END_ELEMENT: + name = (const char *) xmlTextReaderConstLocalName(info->reader); + ns = (const char *) xmlTextReaderConstNamespaceUri(info->reader); + Tcl_MutexUnlock(&libxml2); + + if (name != NULL) { + nameObj = Tcl_NewStringObj(name, -1); + } else { + nameObj = Tcl_NewObj(); + } + Tcl_IncrRefCount(nameObj); + if (ns != NULL) { + nsObj = Tcl_NewStringObj(ns, -1); + } else { + nsObj = Tcl_NewObj(); + } + Tcl_IncrRefCount(nsObj); + + TclXML_ElementEndHandler(info->xmlinfo, + nameObj); + + Tcl_DecrRefCount(nameObj); + Tcl_DecrRefCount(nsObj); + break; + + case XML_READER_TYPE_TEXT: + case XML_READER_TYPE_CDATA: + case XML_READER_TYPE_WHITESPACE: + case XML_READER_TYPE_SIGNIFICANT_WHITESPACE: + value = (const char *) xmlTextReaderConstValue(info->reader); + Tcl_MutexUnlock(&libxml2); + if (value != NULL) { + valueObj = Tcl_NewStringObj(value, -1); + } else { + valueObj = Tcl_NewObj(); + } + Tcl_IncrRefCount(valueObj); + + TclXML_CharacterDataHandler(info->xmlinfo, + valueObj); + + Tcl_DecrRefCount(valueObj); + break; + + case XML_READER_TYPE_COMMENT: + value = (const char *) xmlTextReaderConstValue(info->reader); + Tcl_MutexUnlock(&libxml2); + if (value != NULL) { + valueObj = Tcl_NewStringObj(value, -1); + } else { + valueObj = Tcl_NewObj(); + } + + TclXML_CommentHandler(info->xmlinfo, + valueObj); + break; + + case XML_READER_TYPE_PROCESSING_INSTRUCTION: + name = (const char *) xmlTextReaderConstName(info->reader); + value = (const char *) xmlTextReaderConstValue(info->reader); + Tcl_MutexUnlock(&libxml2); + if (name != NULL) { + nameObj = Tcl_NewStringObj(name, -1); + } else { + nameObj = Tcl_NewObj(); + } + if (value != NULL) { + valueObj = Tcl_NewStringObj(value, -1); + } else { + valueObj = Tcl_NewObj(); + } + + TclXML_ProcessingInstructionHandler(info->xmlinfo, + nameObj, + valueObj); + break; + + case XML_READER_TYPE_ENTITY_REFERENCE: + name = (const char *) xmlTextReaderConstName(info->reader); + baseuri = (const char *) xmlTextReaderConstBaseUri(info->reader); + entityPtr = xmlGetDocEntity(xmlTextReaderCurrentDoc(info->reader), + (const xmlChar *) name); + Tcl_MutexUnlock(&libxml2); + + nameObj = Tcl_NewStringObj(name, -1); + Tcl_IncrRefCount(nameObj); + baseuriObj = Tcl_NewStringObj(baseuri, -1); + Tcl_IncrRefCount(baseuriObj); + sysidObj = Tcl_NewStringObj((CONST char *) entityPtr->SystemID, -1); + Tcl_IncrRefCount(sysidObj); + extidObj = Tcl_NewStringObj((CONST char *) entityPtr->ExternalID, -1); + Tcl_IncrRefCount(extidObj); + + result = TclXML_ExternalEntityRefHandler(info->xmlinfo, + nameObj, + baseuriObj, + sysidObj, + extidObj); + + Tcl_MutexLock(&libxml2); + + Tcl_DecrRefCount(nameObj); + Tcl_DecrRefCount(baseuriObj); + Tcl_DecrRefCount(sysidObj); + Tcl_DecrRefCount(extidObj); + + if (result == TCL_ERROR || result == TCL_BREAK) { + Tcl_MutexUnlock(&libxml2); + xmlTextReaderClose(info->reader); + break; + } + Tcl_MutexUnlock(&libxml2); + + break; + + case XML_READER_TYPE_DOCUMENT_TYPE: + /* these are not used... at present + name = xmlTextReaderName(info->reader); + nodePtr = xmlTextReaderCurrentNode(info->reader); + */ + Tcl_MutexUnlock(&libxml2); + + default: + break; + } + Tcl_MutexLock(&libxml2); + } + + Tcl_MutexUnlock(&libxml2); + + if (preservens) { + int i; + for (i = 0; preservens[i]; i++) { + xmlFree(preservens[i]); + } + Tcl_Free((char *) preservens); + } + + if (ret != 0 || result != TCL_OK) { + errObj = TclXML_libxml2_GetErrorObj(info->interp); + if (errObj) { + Tcl_SetObjResult(info->interp, errObj); + } else { + Tcl_SetResult(info->interp, "parsing error", NULL); + } + tsdPtr->current = NULL; + + return TCL_ERROR; + } + + info->docObjPtr = TclXML_libxml2_CreateObjFromDoc(xmlTextReaderCurrentDoc(info->reader)); + + TclXML_libxml2_DocKeep(info->docObjPtr, info->keep); + + /* TODO: errObjPtr may contain warnings, flush them through */ + + tsdPtr->current = NULL; + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXMLlibxml2Configure -- + * + * Set options for the parser. + * + * Results: + * None. + * + * Side effects: + * None (there are no options to set). + * + *---------------------------------------------------------------------------- + */ + +static int +TclXMLlibxml2Configure(clientData, optionPtr, valuePtr) + ClientData clientData; + Tcl_Obj *CONST optionPtr; + Tcl_Obj *CONST valuePtr; +{ + TclXMLlibxml2Info *info = (TclXMLlibxml2Info *) clientData; + int option, len; + char *value; + CONST84 char *Options[] = { + "-keep", + "-retainpath", + "-retainpathns", + NULL + }; + enum Options { + OPTION_KEEP, + OPTION_RETAINPATH, + OPTION_RETAINPATHNS + }; + CONST84 char *KeepOptions[] = { + "normal", + "implicit", + NULL + }; + enum KeepOptions { + OPTION_KEEP_NORMAL, + OPTION_KEEP_IMPLICIT + }; + + if (Tcl_GetIndexFromObj(info->interp, optionPtr, Options, + "option", 0, &option) != TCL_OK) { + /* + * Just ignore options we don't understand + */ + return TCL_OK; + } + + switch ((enum Options) option) { + case OPTION_KEEP: + + value = Tcl_GetStringFromObj(valuePtr, &len); + if (len == 0) { + info->keep = TCLXML_LIBXML2_DOCUMENT_KEEP; + if (info->docObjPtr) { + TclXML_libxml2_DocKeep(info->docObjPtr, TCLXML_LIBXML2_DOCUMENT_KEEP); + return TCL_BREAK; + } + } else { + if (Tcl_GetIndexFromObj(info->interp, valuePtr, KeepOptions, + "value", 0, &option) != TCL_OK) { + return TCL_ERROR; + } + switch ((enum KeepOptions) option) { + case OPTION_KEEP_NORMAL: + info->keep = TCLXML_LIBXML2_DOCUMENT_KEEP; + if (info->docObjPtr) { + TclXML_libxml2_DocKeep(info->docObjPtr, TCLXML_LIBXML2_DOCUMENT_KEEP); + } + return TCL_BREAK; + + case OPTION_KEEP_IMPLICIT: + info->keep = TCLXML_LIBXML2_DOCUMENT_IMPLICIT; + if (info->docObjPtr) { + TclXML_libxml2_DocKeep(info->docObjPtr, TCLXML_LIBXML2_DOCUMENT_IMPLICIT); + } + return TCL_BREAK; + + default: + Tcl_SetResult(info->interp, "bad value", NULL); + return TCL_ERROR; + } + } + + break; + + case OPTION_RETAINPATH: + if (info->preserve) { + Tcl_DecrRefCount(info->preserve); + } + info->preserve = valuePtr; + Tcl_IncrRefCount(valuePtr); + return TCL_BREAK; + + case OPTION_RETAINPATHNS: + if (info->preservens) { + Tcl_DecrRefCount(info->preservens); + } + info->preservens = valuePtr; + Tcl_IncrRefCount(valuePtr); + return TCL_BREAK; + + default: + + Tcl_SetResult(info->interp, "no such option", NULL); + return TCL_ERROR; + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXMLlibxml2Get -- + * + * Retrieve data from the parser. + * + * Results: + * Depends on argument. + * + * Side effects: + * May create Tcl object. + * + *---------------------------------------------------------------------------- + */ + +static int +TclXMLlibxml2Get(clientData, objc, objv) + ClientData clientData; + int objc; + Tcl_Obj *CONST objv[]; +{ + TclXMLlibxml2Info *info = (TclXMLlibxml2Info *) clientData; + CONST84 char *methods[] = { + "document", + NULL + }; + enum methods { + TCLXML_LIBXML2_GET_DOCUMENT + }; + int option; + + if (objc != 1) { + Tcl_WrongNumArgs(info->interp, 0, objv, "method"); + return TCL_ERROR; + } + + if (Tcl_GetIndexFromObj(info->interp, objv[0], methods, + "method", 0, &option) != TCL_OK) { + return TCL_ERROR; + } + + switch ((enum methods) option) { + case TCLXML_LIBXML2_GET_DOCUMENT: + if (info->docObjPtr) { + Tcl_SetObjResult(info->interp, info->docObjPtr); + } + + break; + + default: + Tcl_SetResult(info->interp, "unknown method", NULL); + return TCL_ERROR; + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXMLlibxml2ExternalEntityLoader -- + * + * Retrieve an external entity, allowing interposing by the application. + * + * Results: + * External entity parsed. + * + * Side effects: + * Depends on application callback. + * + *---------------------------------------------------------------------------- + */ + +static xmlParserInputPtr +Result2ParserInput(interp, ctxt, URL) + Tcl_Interp *interp; + xmlParserCtxtPtr ctxt; + const char *URL; +{ + xmlParserInputPtr inputPtr = NULL; + + /* build our own xmlParserInput from returned data */ + inputPtr = xmlNewStringInputStream(ctxt, (const xmlChar *) Tcl_GetStringFromObj(Tcl_GetObjResult(interp), NULL)); + if (inputPtr == NULL) { + Tcl_SetResult(interp, "unable to create input stream", NULL); + Tcl_BackgroundError(interp); + return NULL; + } + inputPtr->filename = (char *) xmlCanonicPath((const xmlChar *) URL); + + return inputPtr; +} + +static xmlParserInputPtr +TclXMLlibxml2ExternalEntityLoader(URL, ID, ctxt) + const char *URL; + const char *ID; + xmlParserCtxtPtr ctxt; +{ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + TclXMLlibxml2Info *info; + Tcl_Interp *interp; + int result; + + info = tsdPtr->current; + + if (info) { + result = TclXML_ExternalEntityRefHandler(info->xmlinfo, NULL, NULL, + Tcl_NewStringObj(URL, -1), + Tcl_NewStringObj(ID, -1)); + interp = info->interp; + } else { + result = TclXML_ExternalEntityRefHandler(NULL, NULL, NULL, + Tcl_NewStringObj(URL, -1), + Tcl_NewStringObj(ID, -1)); + interp = tsdPtr->interp; + } + + switch (result) { + case TCL_OK: + return Result2ParserInput(interp, ctxt, URL); + + case TCL_BREAK: + return NULL; + + case TCL_CONTINUE: + break; + + case TCL_ERROR: + case TCL_RETURN: + default: + Tcl_BackgroundError(interp); + return NULL; + } + + if (Tcl_IsSafe(interp)) { + return NULL; + } else { + return (tsdPtr->defaultLoader)(URL, ID, ctxt); + } +} diff --git a/tclxml-tcl/sgml-8.0.tcl b/tclxml-tcl/sgml-8.0.tcl new file mode 100755 index 0000000..f1179cf --- /dev/null +++ b/tclxml-tcl/sgml-8.0.tcl @@ -0,0 +1,143 @@ +# sgml-8.0.tcl -- +# +# This file provides generic parsing services for SGML-based +# languages, namely HTML and XML. +# This file supports Tcl 8.0 characters and regular expressions. +# +# NB. It is a misnomer. There is no support for parsing +# arbitrary SGML as such. +# +# Copyright (c) 1998,1999 Zveno Pty Ltd +# http://www.zveno.com/ +# +# See the file "LICENSE" in this distribution for information on usage and +# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# $Id: sgml-8.0.tcl,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $ + +package require -exact Tcl 8.0 + +package provide sgml 1.9 + +namespace eval sgml { + + # Convenience routine + proc cl x { + return "\[$x\]" + } + + # Define various regular expressions + + # Character classes + variable Char \t\n\r\ -\xFF + variable BaseChar A-Za-z + variable Letter $BaseChar + variable Digit 0-9 + variable CombiningChar {} + variable Extender {} + variable Ideographic {} + + # white space + variable Wsp " \t\r\n" + variable noWsp [cl ^$Wsp] + + # Various XML names + variable NameChar \[-$Letter$Digit._:$CombiningChar$Extender\] + variable Name \[_:$BaseChar$Ideographic\]$NameChar* + variable Names ${Name}(?:$Wsp$Name)* + variable Nmtoken $NameChar+ + variable Nmtokens ${Nmtoken}(?:$Wsp$Nmtoken)* + + # table of predefined entities for XML + + variable EntityPredef + array set EntityPredef { + lt < gt > amp & quot \" apos ' + } + +} + +# These regular expressions are defined here once for better performance + +namespace eval sgml { + variable Wsp + + # Watch out for case-sensitivity + + set attlist_exp [cl $Wsp]*([cl ^$Wsp]+)[cl $Wsp]*([cl ^$Wsp]+)[cl $Wsp]*(#REQUIRED|#IMPLIED) + set attlist_enum_exp [cl $Wsp]*([cl ^$Wsp]+)[cl $Wsp]*\\(([cl ^)]*)\\)[cl $Wsp]*("([cl ^")])")? ;# " + set attlist_fixed_exp [cl $Wsp]*([cl ^$Wsp]+)[cl $Wsp]*([cl ^$Wsp]+)[cl $Wsp]*(#FIXED)[cl $Wsp]*([cl ^$Wsp]+) + + set param_entity_exp [cl $Wsp]*([cl ^$Wsp]+)[cl $Wsp]*([cl ^"$Wsp]*)[cl $Wsp]*"([cl ^"]*)" + + set notation_exp [cl $Wsp]*([cl ^$Wsp]+)[cl $Wsp]*(.*) + +} + +### Utility procedures + +# sgml::noop -- +# +# A do-nothing proc +# +# Arguments: +# args arguments +# +# Results: +# Nothing. + +proc sgml::noop args { + return 0 +} + +# sgml::identity -- +# +# Identity function. +# +# Arguments: +# a arbitrary argument +# +# Results: +# $a + +proc sgml::identity a { + return $a +} + +# sgml::Error -- +# +# Throw an error +# +# Arguments: +# args arguments +# +# Results: +# Error return condition. + +proc sgml::Error args { + uplevel return -code error [list $args] +} + +### Following procedures are based on html_library + +# sgml::zapWhite -- +# +# Convert multiple white space into a single space. +# +# Arguments: +# data plain text +# +# Results: +# As above + +proc sgml::zapWhite data { + regsub -all "\[ \t\r\n\]+" $data { } data + return $data +} + +proc sgml::Boolean value { + regsub {1|true|yes|on} $value 1 value + regsub {0|false|no|off} $value 0 value + return $value +} + diff --git a/tclxml-tcl/sgml-8.1.tcl b/tclxml-tcl/sgml-8.1.tcl new file mode 100755 index 0000000..60748bb --- /dev/null +++ b/tclxml-tcl/sgml-8.1.tcl @@ -0,0 +1,143 @@ +# sgml-8.1.tcl -- +# +# This file provides generic parsing services for SGML-based +# languages, namely HTML and XML. +# This file supports Tcl 8.1 characters and regular expressions. +# +# NB. It is a misnomer. There is no support for parsing +# arbitrary SGML as such. +# +# Copyright (c) 1998-2003 Zveno Pty Ltd +# http://www.zveno.com/ +# +# See the file "LICENSE" in this distribution for information on usage and +# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# $Id: sgml-8.1.tcl,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $ + +package require Tcl 8.1 + +package provide sgml 1.9 + +namespace eval sgml { + + # Convenience routine + proc cl x { + return "\[$x\]" + } + + # Define various regular expressions + + # Character classes + variable Char \t\n\r\ -\uD7FF\uE000-\uFFFD\u10000-\u10FFFF + variable BaseChar \u0041-\u005A\u0061-\u007A\u00C0-\u00D6\u00D8-\u00F6\u00F8-\u00FF\u0100-\u0131\u0134-\u013E\u0141-\u0148\u014A-\u017E\u0180-\u01C3\u01CD-\u01F0\u01F4-\u01F5\u01FA-\u0217\u0250-\u02A8\u02BB-\u02C1\u0386\u0388-\u038A\u038C\u038E-\u03A1\u03A3-\u03CE\u03D0-\u03D6\u03DA\u03DC\u03DE\u03E0\u03E2-\u03F3\u0401-\u040C\u040E-\u044F\u0451-\u045C\u045E-\u0481\u0490-\u04C4\u04C7-\u04C8\u04CB-\u04CC\u04D0-\u04EB\u04EE-\u04F5\u04F8-\u04F9\u0531-\u0556\u0559\u0561-\u0586\u05D0-\u05EA\u05F0-\u05F2\u0621-\u063A\u0641-\u064A\u0671-\u06B7\u06BA-\u06BE\u06C0-\u06CE\u06D0-\u06D3\u06D5\u06E5-\u06E6\u0905-\u0939\u093D\u0958-\u0961\u0985-\u098C\u098F-\u0990\u0993-\u09A8\u09AA-\u09B0\u09B2\u09B6-\u09B9\u09DC-\u09DD\u09DF-\u09E1\u09F0-\u09F1\u0A05-\u0A0A\u0A0F-\u0A10\u0A13-\u0A28\u0A2A-\u0A30\u0A32-\u0A33\u0A35-\u0A36\u0A38-\u0A39\u0A59-\u0A5C\u0A5E\u0A72-\u0A74\u0A85-\u0A8B\u0A8D\u0A8F-\u0A91\u0A93-\u0AA8\u0AAA-\u0AB0\u0AB2-\u0AB3\u0AB5-\u0AB9\u0ABD\u0AE0\u0B05-\u0B0C\u0B0F-\u0B10\u0B13-\u0B28\u0B2A-\u0B30\u0B32-\u0B33\u0B36-\u0B39\u0B3D\u0B5C-\u0B5D\u0B5F-\u0B61\u0B85-\u0B8A\u0B8E-\u0B90\u0B92-\u0B95\u0B99-\u0B9A\u0B9C\u0B9E-\u0B9F\u0BA3-\u0BA4\u0BA8-\u0BAA\u0BAE-\u0BB5\u0BB7-\u0BB9\u0C05-\u0C0C\u0C0E-\u0C10\u0C12-\u0C28\u0C2A-\u0C33\u0C35-\u0C39\u0C60-\u0C61\u0C85-\u0C8C\u0C8E-\u0C90\u0C92-\u0CA8\u0CAA-\u0CB3\u0CB5-\u0CB9\u0CDE\u0CE0-\u0CE1\u0D05-\u0D0C\u0D0E-\u0D10\u0D12-\u0D28\u0D2A-\u0D39\u0D60-\u0D61\u0E01-\u0E2E\u0E30\u0E32-\u0E33\u0E40-\u0E45\u0E81-\u0E82\u0E84\u0E87-\u0E88\u0E8A\u0E8D\u0E94-\u0E97\u0E99-\u0E9F\u0EA1-\u0EA3\u0EA5\u0EA7\u0EAA-\u0EAB\u0EAD-\u0EAE\u0EB0\u0EB2-\u0EB3\u0EBD\u0EC0-\u0EC4\u0F40-\u0F47\u0F49-\u0F69\u10A0-\u10C5\u10D0-\u10F6\u1100\u1102-\u1103\u1105-\u1107\u1109\u110B-\u110C\u110E-\u1112\u113C\u113E\u1140\u114C\u114E\u1150\u1154-\u1155\u1159\u115F-\u1161\u1163\u1165\u1167\u1169\u116D-\u116E\u1172-\u1173\u1175\u119E\u11A8\u11AB\u11AE-\u11AF\u11B7-\u11B8\u11BA\u11BC-\u11C2\u11EB\u11F0\u11F9\u1E00-\u1E9B\u1EA0-\u1EF9\u1F00-\u1F15\u1F18-\u1F1D\u1F20-\u1F45\u1F48-\u1F4D\u1F50-\u1F57\u1F59\u1F5B\u1F5D\u1F5F-\u1F7D\u1F80-\u1FB4\u1FB6-\u1FBC\u1FBE\u1FC2-\u1FC4\u1FC6-\u1FCC\u1FD0-\u1FD3\u1FD6-\u1FDB\u1FE0-\u1FEC\u1FF2-\u1FF4\u1FF6-\u1FFC\u2126\u212A-\u212B\u212E\u2180-\u2182\u3041-\u3094\u30A1-\u30FA\u3105-\u312C\uAC00-\uD7A3 + variable Ideographic \u4E00-\u9FA5\u3007\u3021-\u3029 + variable CombiningChar \u0300-\u0345\u0360-\u0361\u0483-\u0486\u0591-\u05A1\u05A3-\u05B9\u05BB-\u05BD\u05BF\u05C1-\u05C2\u05C4\u064B-\u0652\u0670\u06D6-\u06DC\u06DD-\u06DF\u06E0-\u06E4\u06E7-\u06E8\u06EA-\u06ED\u0901-\u0903\u093C\u093E-\u094C\u094D\u0951-\u0954\u0962-\u0963\u0981-\u0983\u09BC\u09BE\u09BF\u09C0-\u09C4\u09C7-\u09C8\u09CB-\u09CD\u09D7\u09E2-\u09E3\u0A02\u0A3C\u0A3E\u0A3F\u0A40-\u0A42\u0A47-\u0A48\u0A4B-\u0A4D\u0A70-\u0A71\u0A81-\u0A83\u0ABC\u0ABE-\u0AC5\u0AC7-\u0AC9\u0ACB-\u0ACD\u0B01-\u0B03\u0B3C\u0B3E-\u0B43\u0B47-\u0B48\u0B4B-\u0B4D\u0B56-\u0B57\u0B82-\u0B83\u0BBE-\u0BC2\u0BC6-\u0BC8\u0BCA-\u0BCD\u0BD7\u0C01-\u0C03\u0C3E-\u0C44\u0C46-\u0C48\u0C4A-\u0C4D\u0C55-\u0C56\u0C82-\u0C83\u0CBE-\u0CC4\u0CC6-\u0CC8\u0CCA-\u0CCD\u0CD5-\u0CD6\u0D02-\u0D03\u0D3E-\u0D43\u0D46-\u0D48\u0D4A-\u0D4D\u0D57\u0E31\u0E34-\u0E3A\u0E47-\u0E4E\u0EB1\u0EB4-\u0EB9\u0EBB-\u0EBC\u0EC8-\u0ECD\u0F18-\u0F19\u0F35\u0F37\u0F39\u0F3E\u0F3F\u0F71-\u0F84\u0F86-\u0F8B\u0F90-\u0F95\u0F97\u0F99-\u0FAD\u0FB1-\u0FB7\u0FB9\u20D0-\u20DC\u20E1\u302A-\u302F\u3099\u309A + variable Digit \u0030-\u0039\u0660-\u0669\u06F0-\u06F9\u0966-\u096F\u09E6-\u09EF\u0A66-\u0A6F\u0AE6-\u0AEF\u0B66-\u0B6F\u0BE7-\u0BEF\u0C66-\u0C6F\u0CE6-\u0CEF\u0D66-\u0D6F\u0E50-\u0E59\u0ED0-\u0ED9\u0F20-\u0F29 + variable Extender \u00B7\u02D0\u02D1\u0387\u0640\u0E46\u0EC6\u3005\u3031-\u3035\u309D-\u309E\u30FC-\u30FE + variable Letter $BaseChar|$Ideographic + + # white space + variable Wsp " \t\r\n" + variable noWsp [cl ^$Wsp] + + # Various XML names + variable NameChar \[-$Letter$Digit._:$CombiningChar$Extender\] + variable Name \[_:$BaseChar$Ideographic\]$NameChar* + variable Names ${Name}(?:$Wsp$Name)* + variable Nmtoken $NameChar+ + variable Nmtokens ${Nmtoken}(?:$Wsp$Nmtoken)* + + # table of predefined entities for XML + + variable EntityPredef + array set EntityPredef { + lt < gt > amp & quot \" apos ' + } + +} + +# These regular expressions are defined here once for better performance + +namespace eval sgml { + variable Wsp + + # Watch out for case-sensitivity + + set attlist_exp [cl $Wsp]*([cl ^$Wsp]+)[cl $Wsp]*([cl ^$Wsp]+)[cl $Wsp]*(#REQUIRED|#IMPLIED) + set attlist_enum_exp [cl $Wsp]*([cl ^$Wsp]+)[cl $Wsp]*\\(([cl ^)]*)\\)[cl $Wsp]*("([cl ^")]*)")? ;# " + set attlist_fixed_exp [cl $Wsp]*([cl ^$Wsp]+)[cl $Wsp]*([cl ^$Wsp]+)[cl $Wsp]*(#FIXED)[cl $Wsp]*([cl ^$Wsp]+) + + set param_entity_exp [cl $Wsp]*([cl ^$Wsp]+)[cl $Wsp]*([cl ^"$Wsp]*)[cl $Wsp]*"([cl ^"]*)" + + set notation_exp [cl $Wsp]*([cl ^$Wsp]+)[cl $Wsp]*(.*) + +} + +### Utility procedures + +# sgml::noop -- +# +# A do-nothing proc +# +# Arguments: +# args arguments +# +# Results: +# Nothing. + +proc sgml::noop args { + return 0 +} + +# sgml::identity -- +# +# Identity function. +# +# Arguments: +# a arbitrary argument +# +# Results: +# $a + +proc sgml::identity a { + return $a +} + +# sgml::Error -- +# +# Throw an error +# +# Arguments: +# args arguments +# +# Results: +# Error return condition. + +proc sgml::Error args { + uplevel return -code error [list $args] +} + +### Following procedures are based on html_library + +# sgml::zapWhite -- +# +# Convert multiple white space into a single space. +# +# Arguments: +# data plain text +# +# Results: +# As above + +proc sgml::zapWhite data { + regsub -all "\[ \t\r\n\]+" $data { } data + return $data +} + +proc sgml::Boolean value { + regsub {1|true|yes|on} $value 1 value + regsub {0|false|no|off} $value 0 value + return $value +} + diff --git a/tclxml-tcl/sgmlparser.tcl b/tclxml-tcl/sgmlparser.tcl new file mode 100755 index 0000000..2677a44 --- /dev/null +++ b/tclxml-tcl/sgmlparser.tcl @@ -0,0 +1,2814 @@ +# sgmlparser.tcl -- +# +# This file provides the generic part of a parser for SGML-based +# languages, namely HTML and XML. +# +# NB. It is a misnomer. There is no support for parsing +# arbitrary SGML as such. +# +# See sgml.tcl for variable definitions. +# +# Copyright (c) 2008 Explain +# http://www.explain.com.au/ +# Copyright (c) 1998-2003 Zveno Pty Ltd +# http://www.zveno.com/ +# +# See the file "LICENSE" in this distribution for information on usage and +# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# $Id: sgmlparser.tcl,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $ + +package require sgml 1.9 + +package require uri 1.1 + +package provide sgmlparser 1.1 + +namespace eval sgml { + namespace export tokenise parseEvent + + namespace export parseDTD + + # NB. Most namespace variables are defined in sgml-8.[01].tcl + # to account for differences between versions of Tcl. + # This especially includes the regular expressions used. + + variable ParseEventNum + if {![info exists ParseEventNum]} { + set ParseEventNum 0 + } + variable ParseDTDnum + if {![info exists ParseDTDNum]} { + set ParseDTDNum 0 + } + + variable declExpr [cl $::sgml::Wsp]*([cl ^$::sgml::Wsp]+)[cl $::sgml::Wsp]*([cl ^>]*) + variable EntityExpr [cl $::sgml::Wsp]*(%[cl $::sgml::Wsp])?[cl $::sgml::Wsp]*($::sgml::Name)[cl $::sgml::Wsp]+(.*) + + #variable MarkupDeclExpr <([cl ^$::sgml::Wsp>]+)[cl $::sgml::Wsp]*([cl ^$::sgml::Wsp]+)[cl $::sgml::Wsp]*([cl ^>]*)> + #variable MarkupDeclSub "} {\\1} {\\2} {\\3} {" + variable MarkupDeclExpr <[cl $::sgml::Wsp]*([cl ^$::sgml::Wsp>]+)[cl $::sgml::Wsp]*([cl ^>]*)> + variable MarkupDeclSub "\} {\\1} {\\2} \{" + + variable ExternalEntityExpr ^(PUBLIC|SYSTEM)[cl $::sgml::Wsp]+("|')(.*?)\\2([cl $::sgml::Wsp]+("|')(.*?)\\2)?([cl $::sgml::Wsp]+NDATA[cl $::sgml::Wsp]+($::xml::Name))?\$ + + variable StdOptions + array set StdOptions [list \ + -elementstartcommand [namespace current]::noop \ + -elementendcommand [namespace current]::noop \ + -characterdatacommand [namespace current]::noop \ + -processinginstructioncommand [namespace current]::noop \ + -externalentitycommand {} \ + -xmldeclcommand [namespace current]::noop \ + -doctypecommand [namespace current]::noop \ + -commentcommand [namespace current]::noop \ + -entitydeclcommand [namespace current]::noop \ + -unparsedentitydeclcommand [namespace current]::noop \ + -parameterentitydeclcommand [namespace current]::noop \ + -notationdeclcommand [namespace current]::noop \ + -elementdeclcommand [namespace current]::noop \ + -attlistdeclcommand [namespace current]::noop \ + -paramentityparsing 1 \ + -defaultexpandinternalentities 1 \ + -startdoctypedeclcommand [namespace current]::noop \ + -enddoctypedeclcommand [namespace current]::noop \ + -entityreferencecommand {} \ + -warningcommand [namespace current]::noop \ + -errorcommand [namespace current]::Error \ + -final 1 \ + -validate 0 \ + -baseuri {} \ + -name {} \ + -cmd {} \ + -emptyelement [namespace current]::EmptyElement \ + -parseattributelistcommand [namespace current]::noop \ + -parseentitydeclcommand [namespace current]::noop \ + -normalize 1 \ + -internaldtd {} \ + -reportempty 0 \ + -ignorewhitespace 0 \ + ] +} + +# sgml::tokenise -- +# +# Transform the given HTML/XML text into a Tcl list. +# +# Arguments: +# sgml text to tokenize +# elemExpr RE to recognise tags +# elemSub transform for matched tags +# args options +# +# Valid Options: +# -internaldtdvariable +# -final boolean True if no more data is to be supplied +# -statevariable varName Name of a variable used to store info +# +# Results: +# Returns a Tcl list representing the document. + +proc sgml::tokenise {sgml elemExpr elemSub args} { + array set options {-final 1} + array set options $args + set options(-final) [Boolean $options(-final)] + + # If the data is not final then there must be a variable to store + # unused data. + if {!$options(-final) && ![info exists options(-statevariable)]} { + return -code error {option "-statevariable" required if not final} + } + + # Pre-process stage + # + # Extract the internal DTD subset, if any + + catch {upvar #0 $options(-internaldtdvariable) dtd} + if {[regexp {]*$)} [lindex $sgml end] x text rest]} { + set sgml [lreplace $sgml end end $text] + # Mats: unmatched stuff means that it is chopped off. Cache it for next round. + set state(leftover) $rest + } + + # Patch from bug report #596959, Marshall Rose + if {[string compare [lindex $sgml 4] ""]} { + set sgml [linsert $sgml 0 {} {} {} {} {}] + } + + } else { + + # Performance note (Tcl 8.0): + # In this case, no conversion to list object is performed + + # Mats: This fails if not -final and $sgml is chopped off right in a tag. + regsub -all $elemExpr $sgml $elemSub sgml + set sgml "{} {} {} \{$sgml\}" + } + + return $sgml + +} + +# sgml::parseEvent -- +# +# Produces an event stream for a XML/HTML document, +# given the Tcl list format returned by tokenise. +# +# This procedure checks that the document is well-formed, +# and throws an error if the document is found to be not +# well formed. Warnings are passed via the -warningcommand script. +# +# The procedure only check for well-formedness, +# no DTD is required. However, facilities are provided for entity expansion. +# +# Arguments: +# sgml Instance data, as a Tcl list. +# args option/value pairs +# +# Valid Options: +# -final Indicates end of document data +# -validate Boolean to enable validation +# -baseuri URL for resolving relative URLs +# -elementstartcommand Called when an element starts +# -elementendcommand Called when an element ends +# -characterdatacommand Called when character data occurs +# -entityreferencecommand Called when an entity reference occurs +# -processinginstructioncommand Called when a PI occurs +# -externalentitycommand Called for an external entity reference +# +# -xmldeclcommand Called when the XML declaration occurs +# -doctypecommand Called when the document type declaration occurs +# -commentcommand Called when a comment occurs +# -entitydeclcommand Called when a parsed entity is declared +# -unparsedentitydeclcommand Called when an unparsed external entity is declared +# -parameterentitydeclcommand Called when a parameter entity is declared +# -notationdeclcommand Called when a notation is declared +# -elementdeclcommand Called when an element is declared +# -attlistdeclcommand Called when an attribute list is declared +# -paramentityparsing Boolean to enable/disable parameter entity substitution +# -defaultexpandinternalentities Boolean to enable/disable expansion of entities declared in internal DTD subset +# +# -startdoctypedeclcommand Called when the Doc Type declaration starts (see also -doctypecommand) +# -enddoctypedeclcommand Called when the Doc Type declaration ends (see also -doctypecommand) +# +# -errorcommand Script to evaluate for a fatal error +# -warningcommand Script to evaluate for a reportable warning +# -statevariable global state variable +# -normalize whether to normalize names +# -reportempty whether to include an indication of empty elements +# -ignorewhitespace whether to automatically strip whitespace +# +# Results: +# The various callback scripts are invoked. +# Returns empty string. +# +# BUGS: +# If command options are set to empty string then they should not be invoked. + +proc sgml::parseEvent {sgml args} { + variable Wsp + variable noWsp + variable Nmtoken + variable Name + variable ParseEventNum + variable StdOptions + + array set options [array get StdOptions] + catch {array set options $args} + + # Mats: + # If the data is not final then there must be a variable to persistently store the parse state. + if {!$options(-final) && ![info exists options(-statevariable)]} { + return -code error {option "-statevariable" required if not final} + } + + foreach {opt value} [array get options *command] { + if {[string compare $opt "-externalentitycommand"] && ![string length $value]} { + set options($opt) [namespace current]::noop + } + } + + if {![info exists options(-statevariable)]} { + set options(-statevariable) [namespace current]::ParseEvent[incr ParseEventNum] + } + if {![info exists options(entities)]} { + set options(entities) [namespace current]::Entities$ParseEventNum + array set $options(entities) [array get [namespace current]::EntityPredef] + } + if {![info exists options(extentities)]} { + set options(extentities) [namespace current]::ExtEntities$ParseEventNum + } + if {![info exists options(parameterentities)]} { + set options(parameterentities) [namespace current]::ParamEntities$ParseEventNum + } + if {![info exists options(externalparameterentities)]} { + set options(externalparameterentities) [namespace current]::ExtParamEntities$ParseEventNum + } + if {![info exists options(elementdecls)]} { + set options(elementdecls) [namespace current]::ElementDecls$ParseEventNum + } + if {![info exists options(attlistdecls)]} { + set options(attlistdecls) [namespace current]::AttListDecls$ParseEventNum + } + if {![info exists options(notationdecls)]} { + set options(notationdecls) [namespace current]::NotationDecls$ParseEventNum + } + if {![info exists options(namespaces)]} { + set options(namespaces) [namespace current]::Namespaces$ParseEventNum + } + + # For backward-compatibility + catch {set options(-baseuri) $options(-baseurl)} + + # Choose an external entity resolver + + if {![string length $options(-externalentitycommand)]} { + if {$options(-validate)} { + set options(-externalentitycommand) [namespace code ResolveEntity] + } else { + set options(-externalentitycommand) [namespace code noop] + } + } + + upvar #0 $options(-statevariable) state + upvar #0 $options(entities) entities + + # Mats: + # The problem is that the state is not maintained when -final 0 ! + # I've switched back to an older version here. + + if {![info exists state(line)]} { + # Initialise the state variable + array set state { + mode normal + haveXMLDecl 0 + haveDocElement 0 + inDTD 0 + context {} + stack {} + line 0 + defaultNS {} + defaultNSURI {} + } + } + + foreach {tag close param text} $sgml { + + # Keep track of lines in the input + incr state(line) [regsub -all \n $param {} discard] + incr state(line) [regsub -all \n $text {} discard] + + # If the current mode is cdata or comment then we must undo what the + # regsub has done to reconstitute the data + + set empty {} + switch $state(mode) { + comment { + # This had "[string length $param] && " as a guard - + # can't remember why :-( + if {[regexp ([cl ^-]*)--\$ $tag discard comm1]} { + # end of comment (in tag) + set tag {} + set close {} + set state(mode) normal + DeProtect1 $options(-commentcommand) $state(commentdata)<$comm1 + unset state(commentdata) + } elseif {[regexp ([cl ^-]*)--\$ $param discard comm1]} { + # end of comment (in attributes) + DeProtect1 $options(-commentcommand) $state(commentdata)<$close$tag>$comm1 + unset state(commentdata) + set tag {} + set param {} + set close {} + set state(mode) normal + } elseif {[regexp ([cl ^-]*)-->(.*) $text discard comm1 text]} { + # end of comment (in text) + DeProtect1 $options(-commentcommand) $state(commentdata)<$close$tag$param>$comm1 + unset state(commentdata) + set tag {} + set param {} + set close {} + set state(mode) normal + } else { + # comment continues + append state(commentdata) <$close$tag$param>$text + continue + } + } + cdata { + if {[string length $param] && [regexp ([cl ^\]]*)\]\][cl $Wsp]*\$ $tag discard cdata1]} { + # end of CDATA (in tag) + PCDATA [array get options] $state(cdata)<[subst -nocommand -novariable $close$cdata1] + set text [subst -novariable -nocommand $text] + set tag {} + unset state(cdata) + set state(mode) normal + } elseif {[regexp ([cl ^\]]*)\]\][cl $Wsp]*\$ $param discard cdata1]} { + # end of CDATA (in attributes) + PCDATA [array get options] $state(cdata)<[subst -nocommand -novariable $close$tag$cdata1] + set text [subst -novariable -nocommand $text] + set tag {} + set param {} + unset state(cdata) + set state(mode) normal + } elseif {[regexp (.*)\]\][cl $Wsp]*>(.*) $text discard cdata1 text]} { + # end of CDATA (in text) + PCDATA [array get options] $state(cdata)<[subst -nocommand -novariable $close$tag$param>$cdata1] + set text [subst -novariable -nocommand $text] + set tag {} + set param {} + set close {} + unset state(cdata) + set state(mode) normal + } else { + # CDATA continues + append state(cdata) [subst -nocommand -novariable <$close$tag$param>$text] + continue + } + } + continue { + # We're skipping elements looking for the close tag + switch -glob -- [string length $tag],[regexp {^\?|!.*} $tag],$close { + 0,* { + continue + } + *,0, { + if {![string compare $tag $state(continue:tag)]} { + set empty [uplevel #0 $options(-emptyelement) [list $tag $param $empty]] + if {![string length $empty]} { + incr state(continue:level) + } + } + continue + } + *,0,/ { + if {![string compare $tag $state(continue:tag)]} { + incr state(continue:level) -1 + } + if {!$state(continue:level)} { + unset state(continue:tag) + unset state(continue:level) + set state(mode) {} + } + } + default { + continue + } + } + } + default { + # The trailing slash on empty elements can't be automatically separated out + # in the RE, so we must do it here. + regexp (.*)(/)[cl $Wsp]*$ $param discard param empty + } + } + + # default: normal mode + + # Bug: if the attribute list has a right angle bracket then the empty + # element marker will not be seen + + set empty [uplevel #0 $options(-emptyelement) [list $tag $param $empty]] + + switch -glob -- [string length $tag],[regexp {^\?|!.*} $tag],$close,$empty { + + 0,0,, { + # Ignore empty tag - dealt with non-normal mode above + } + *,0,, { + + # Start tag for an element. + + # Check if the internal DTD entity is in an attribute value + regsub -all &xml:intdtd\; $param \[$options(-internaldtd)\] param + + set code [catch {ParseEvent:ElementOpen $tag $param [array get options]} msg] + set state(haveDocElement) 1 + switch $code { + 0 {# OK} + 3 { + # break + return {} + } + 4 { + # continue + # Remember this tag and look for its close + set state(continue:tag) $tag + set state(continue:level) 1 + set state(mode) continue + continue + } + default { + return -code $code -errorinfo $::errorInfo $msg + } + } + + } + + *,0,/, { + + # End tag for an element. + + set code [catch {ParseEvent:ElementClose $tag [array get options]} msg] + switch $code { + 0 {# OK} + 3 { + # break + return {} + } + 4 { + # continue + # skip sibling nodes + set state(continue:tag) [lindex $state(stack) end] + set state(continue:level) 1 + set state(mode) continue + continue + } + default { + return -code $code -errorinfo $::errorInfo $msg + } + } + + } + + *,0,,/ { + + # Empty element + + # The trailing slash sneaks through into the param variable + regsub -all /[cl $::sgml::Wsp]*\$ $param {} param + + set code [catch {ParseEvent:ElementOpen $tag $param [array get options] -empty 1} msg] + set state(haveDocElement) 1 + switch $code { + 0 {# OK} + 3 { + # break + return {} + } + 4 { + # continue + # Pretty useless since it closes straightaway + } + default { + return -code $code -errorinfo $::errorInfo $msg + } + } + set code [catch {ParseEvent:ElementClose $tag [array get options] -empty 1} msg] + switch $code { + 0 {# OK} + 3 { + # break + return {} + } + 4 { + # continue + # skip sibling nodes + set state(continue:tag) [lindex $state(stack) end] + set state(continue:level) 1 + set state(mode) continue + continue + } + default { + return -code $code -errorinfo $::errorInfo $msg + } + } + + } + + *,1,* { + # Processing instructions or XML declaration + switch -glob -- $tag { + + {\?xml} { + # XML Declaration + if {$state(haveXMLDecl)} { + uplevel #0 $options(-errorcommand) [list illegalcharacter "unexpected characters \"<$tag\" around line $state(line)"] + } elseif {![regexp {\?$} $param]} { + uplevel #0 $options(-errorcommand) [list missingcharacters "XML Declaration missing characters \"?>\" around line $state(line)"] + } else { + + # We can do the parsing in one step with Tcl 8.1 RE's + # This has the benefit of performing better WF checking + + set adv_re [format {^[%s]*version[%s]*=[%s]*("|')(-+|[a-zA-Z0-9_.:]+)\1([%s]+encoding[%s]*=[%s]*("|')([A-Za-z][-A-Za-z0-9._]*)\4)?([%s]*standalone[%s]*=[%s]*("|')(yes|no)\7)?[%s]*\?$} $::sgml::Wsp $::sgml::Wsp $::sgml::Wsp $::sgml::Wsp $::sgml::Wsp $::sgml::Wsp $::sgml::Wsp $::sgml::Wsp $::sgml::Wsp $::sgml::Wsp] + + if {[catch {regexp $adv_re $param discard delimiter version discard delimiter encoding discard delimiter standalone} matches]} { + # Otherwise we must fallback to 8.0. + # This won't detect certain well-formedness errors + + # Get the version number + if {[regexp [format {[%s]*version[%s]*=[%s]*"(-+|[a-zA-Z0-9_.:]+)"[%s]*} $::sgml::Wsp $::sgml::Wsp $::sgml::Wsp $::sgml::Wsp] $param discard version] || [regexp [format {[%s]*version[%s]*=[%s]*'(-+|[a-zA-Z0-9_.:]+)'[%s]*} $::sgml::Wsp $::sgml::Wsp $::sgml::Wsp $::sgml::Wsp] $param discard version]} { + if {[string compare $version "1.0"]} { + # Should we support future versions? + # At least 1.X? + uplevel #0 $options(-errorcommand) [list versionincompatibility "document XML version \"$version\" is incompatible with XML version 1.0"] + } + } else { + uplevel #0 $options(-errorcommand) [list missingversion "XML Declaration missing version information around line $state(line)"] + } + + # Get the encoding declaration + set encoding {} + regexp [format {[%s]*encoding[%s]*=[%s]*"([A-Za-z]([A-Za-z0-9._]|-)*)"[%s]*} $::sgml::Wsp $::sgml::Wsp $::sgml::Wsp $::sgml::Wsp] $param discard encoding + regexp [format {[%s]*encoding[%s]*=[%s]*'([A-Za-z]([A-Za-z0-9._]|-)*)'[%s]*} $::sgml::Wsp $::sgml::Wsp $::sgml::Wsp $::sgml::Wsp] $param discard encoding + + # Get the standalone declaration + set standalone {} + regexp [format {[%s]*standalone[%s]*=[%s]*"(yes|no)"[%s]*} $::sgml::Wsp $::sgml::Wsp $::sgml::Wsp $::sgml::Wsp] $param discard standalone + regexp [format {[%s]*standalone[%s]*=[%s]*'(yes|no)'[%s]*} $::sgml::Wsp $::sgml::Wsp $::sgml::Wsp $::sgml::Wsp] $param discard standalone + + # Invoke the callback + uplevel #0 $options(-xmldeclcommand) [list $version $encoding $standalone] + + } elseif {$matches == 0} { + uplevel #0 $options(-errorcommand) [list illformeddeclaration "XML Declaration not well-formed around line $state(line)"] + } else { + + # Invoke the callback + uplevel #0 $options(-xmldeclcommand) [list $version $encoding $standalone] + + } + + } + + } + + {\?*} { + # Processing instruction + set tag [string range $tag 1 end] + if {[regsub {\?$} $tag {} tag]} { + if {[string length [string trim $param]]} { + uplevel #0 $options(-errorcommand) [list unexpectedtext "unexpected text \"$param\" in processing instruction around line $state(line)"] + } + } elseif {![regexp ^$Name\$ $tag]} { + uplevel #0 $options(-errorcommand) [list illegalcharacter "illegal character in processing instruction target \"$tag\""] + } elseif {[regexp {[xX][mM][lL]} $tag]} { + uplevel #0 $options(-errorcommand) [list illegalcharacters "characters \"xml\" not permitted in processing instruction target \"$tag\""] + } elseif {![regsub {\?$} $param {} param]} { + uplevel #0 $options(-errorcommand) [list missingquestion "PI: expected '?' character around line $state(line)"] + } + set code [catch {uplevel #0 $options(-processinginstructioncommand) [list $tag [string trimleft $param]]} msg] + switch $code { + 0 {# OK} + 3 { + # break + return {} + } + 4 { + # continue + # skip sibling nodes + set state(continue:tag) [lindex $state(stack) end] + set state(continue:level) 1 + set state(mode) continue + continue + } + default { + return -code $code -errorinfo $::errorInfo $msg + } + } + } + + !DOCTYPE { + # External entity reference + # This should move into xml.tcl + # Parse the params supplied. Looking for Name, ExternalID and MarkupDecl + set matched [regexp ^[cl $Wsp]*($Name)[cl $Wsp]*(.*) $param x state(doc_name) param] + set state(doc_name) [Normalize $state(doc_name) $options(-normalize)] + set externalID {} + set pubidlit {} + set systemlit {} + set externalID {} + if {[regexp -nocase ^[cl $Wsp]*(SYSTEM|PUBLIC)(.*) $param x id param]} { + switch [string toupper $id] { + SYSTEM { + if {[regexp ^[cl $Wsp]+"([cl ^"]*)"(.*) $param x systemlit param] || [regexp ^[cl $Wsp]+'([cl ^']*)'(.*) $param x systemlit param]} { + set externalID [list SYSTEM $systemlit] ;# " + } else { + uplevel #0 $options(-errorcommand) {syntaxerror {syntax error: SYSTEM identifier not followed by literal}} + } + } + PUBLIC { + if {[regexp ^[cl $Wsp]+"([cl ^"]*)"(.*) $param x pubidlit param] || [regexp ^[cl $Wsp]+'([cl ^']*)'(.*) $param x pubidlit param]} { + if {[regexp ^[cl $Wsp]+"([cl ^"]*)"(.*) $param x systemlit param] || [regexp ^[cl $Wsp]+'([cl ^']*)'(.*) $param x systemlit param]} { + set externalID [list PUBLIC $pubidlit $systemlit] + } else { + uplevel #0 $options(-errorcommand) [list syntaxerror "syntax error: PUBLIC identifier not followed by system literal around line $state(line)"] + } + } else { + uplevel #0 $options(-errorcommand) [list syntaxerror "syntax error: PUBLIC identifier not followed by literal around line $state(line)"] + } + } + } + if {[regexp -nocase ^[cl $Wsp]+NDATA[cl $Wsp]+($Name)(.*) $param x notation param]} { + lappend externalID $notation + } + } + + set state(inDTD) 1 + + ParseEvent:DocTypeDecl [array get options] $state(doc_name) $pubidlit $systemlit $options(-internaldtd) + + set state(inDTD) 0 + + } + + !--* { + + # Start of a comment + # See if it ends in the same tag, otherwise change the + # parsing mode + + regexp {!--(.*)} $tag discard comm1 + if {[regexp ([cl ^-]*)--[cl $Wsp]*\$ $comm1 discard comm1_1]} { + # processed comment (end in tag) + uplevel #0 $options(-commentcommand) [list $comm1_1] + } elseif {[regexp ([cl ^-]*)--[cl $Wsp]*\$ $param discard comm2]} { + # processed comment (end in attributes) + uplevel #0 $options(-commentcommand) [list $comm1$comm2] + } elseif {[regexp ([cl ^-]*)-->(.*) $text discard comm2 text]} { + # processed comment (end in text) + uplevel #0 $options(-commentcommand) [list $comm1$param$empty>$comm2] + } else { + # start of comment + set state(mode) comment + set state(commentdata) "$comm1$param$empty>$text" + continue + } + } + + {!\[CDATA\[*} { + + regexp {!\[CDATA\[(.*)} $tag discard cdata1 + if {[regexp {(.*)]]$} $cdata1 discard cdata2]} { + # processed CDATA (end in tag) + PCDATA [array get options] [subst -novariable -nocommand $cdata2] + set text [subst -novariable -nocommand $text] + } elseif {[regexp {(.*)]]$} $param discard cdata2]} { + # processed CDATA (end in attribute) + # Backslashes in param are quoted at this stage + PCDATA [array get options] $cdata1[subst -novariable -nocommand $cdata2] + set text [subst -novariable -nocommand $text] + } elseif {[regexp {(.*)]]>(.*)} $text discard cdata2 text]} { + # processed CDATA (end in text) + # Backslashes in param and text are quoted at this stage + PCDATA [array get options] $cdata1[subst -novariable -nocommand $param]$empty>[subst -novariable -nocommand $cdata2] + set text [subst -novariable -nocommand $text] + } else { + # start CDATA + set state(cdata) "$cdata1$param>$text" + set state(mode) cdata + continue + } + + } + + !ELEMENT - + !ATTLIST - + !ENTITY - + !NOTATION { + uplevel #0 $options(-errorcommand) [list illegaldeclaration "[string range $tag 1 end] declaration not expected in document instance around line $state(line)"] + } + + default { + uplevel #0 $options(-errorcommand) [list unknowninstruction "unknown processing instruction \"<$tag>\" around line $state(line)"] + } + } + } + *,1,* - + *,0,/,/ { + # Syntax error + uplevel #0 $options(-errorcommand) [list syntaxerror "syntax error: closed/empty tag: tag $tag param $param empty $empty close $close around line $state(line)"] + } + } + + # Process character data + + if {$state(haveDocElement) && [llength $state(stack)]} { + + # Check if the internal DTD entity is in the text + regsub -all &xml:intdtd\; $text \[$options(-internaldtd)\] text + + # Look for entity references + if {([array size entities] || \ + [string length $options(-entityreferencecommand)]) && \ + $options(-defaultexpandinternalentities) && \ + [regexp {&[^;]+;} $text]} { + + # protect Tcl specials + # NB. braces and backslashes may already be protected + regsub -all {\\({|}|\\)} $text {\1} text + regsub -all {([][$\\{}])} $text {\\\1} text + + # Mark entity references + regsub -all {&([^;]+);} $text [format {%s; %s {\1} ; %s %s} \}\} [namespace code [list Entity [array get options] $options(-entityreferencecommand) [namespace code [list PCDATA [array get options]]] $options(entities)]] [namespace code [list DeProtect [namespace code [list PCDATA [array get options]]]]] \{\{] text + set text "uplevel #0 [namespace code [list DeProtect1 [namespace code [list PCDATA [array get options]]]]] {{$text}}" + eval $text + } else { + + # Restore protected special characters + regsub -all {\\([][{}\\])} $text {\1} text + PCDATA [array get options] $text + } + } elseif {[string length [string trim $text]]} { + uplevel #0 $options(-errorcommand) [list unexpectedtext "unexpected text \"$text\" in document prolog around line $state(line)"] + } + + } + + # If this is the end of the document, close all open containers + if {$options(-final) && [llength $state(stack)]} { + eval $options(-errorcommand) [list unclosedelement "element [lindex $state(stack) end] remains unclosed around line $state(line)"] + } + + return {} +} + +# sgml::DeProtect -- +# +# Invoke given command after removing protecting backslashes +# from given text. +# +# Arguments: +# cmd Command to invoke +# text Text to deprotect +# +# Results: +# Depends on command + +proc sgml::DeProtect1 {cmd text} { + if {[string compare {} $text]} { + regsub -all {\\([]$[{}\\])} $text {\1} text + uplevel #0 $cmd [list $text] + } +} +proc sgml::DeProtect {cmd text} { + set text [lindex $text 0] + if {[string compare {} $text]} { + regsub -all {\\([]$[{}\\])} $text {\1} text + uplevel #0 $cmd [list $text] + } +} + +# sgml::ParserDelete -- +# +# Free all memory associated with parser +# +# Arguments: +# var global state array +# +# Results: +# Variables unset + +proc sgml::ParserDelete var { + upvar #0 $var state + + if {![info exists state]} { + return -code error "unknown parser" + } + + catch {unset $state(entities)} + catch {unset $state(parameterentities)} + catch {unset $state(elementdecls)} + catch {unset $state(attlistdecls)} + catch {unset $state(notationdecls)} + catch {unset $state(namespaces)} + + unset state + + return {} +} + +# sgml::ParseEvent:ElementOpen -- +# +# Start of an element. +# +# Arguments: +# tag Element name +# attr Attribute list +# opts Options +# args further configuration options +# +# Options: +# -empty boolean +# indicates whether the element was an empty element +# +# Results: +# Modify state and invoke callback + +proc sgml::ParseEvent:ElementOpen {tag attr opts args} { + variable Name + variable Wsp + + array set options $opts + upvar #0 $options(-statevariable) state + array set cfg {-empty 0} + array set cfg $args + set handleEmpty 0 + + if {$options(-normalize)} { + set tag [string toupper $tag] + } + + # Update state + lappend state(stack) $tag + + # Parse attribute list into a key-value representation + if {[string compare $options(-parseattributelistcommand) {}]} { + if {[catch {uplevel #0 $options(-parseattributelistcommand) [list $opts $attr]} attr]} { + if {[string compare [lindex $attr 0] "unterminated attribute value"]} { + uplevel #0 $options(-errorcommand) [list unterminatedattribute "$attr around line $state(line)"] + set attr {} + } else { + + # It is most likely that a ">" character was in an attribute value. + # This manifests itself by ">" appearing in the element's text. + # In this case the callback should return a three element list; + # the message "unterminated attribute value", the attribute list it + # did manage to parse and the remainder of the attribute list. + + foreach {msg attlist brokenattr} $attr break + + upvar text elemText + if {[string first > $elemText] >= 0} { + + # Now piece the attribute list back together + regexp [cl $Wsp]*($Name)[cl $Wsp]*=[cl $Wsp]*("|')(.*) $brokenattr discard attname delimiter attvalue + regexp (.*)>([cl ^>]*)\$ $elemText discard remattlist elemText + regexp ([cl ^$delimiter]*)${delimiter}(.*) $remattlist discard remattvalue remattlist + + # Gotcha: watch out for empty element syntax + if {[string match */ [string trimright $remattlist]]} { + set remattlist [string range $remattlist 0 end-1] + set handleEmpty 1 + set cfg(-empty) 1 + } + + append attvalue >$remattvalue + lappend attlist $attname $attvalue + + # Complete parsing the attribute list + if {[catch {uplevel #0 $options(-parseattributelistcommand) [list $options(-statevariable) $remattlist]} attr]} { + uplevel #0 $options(-errorcommand) [list unterminatedattribute "$attr around line $state(line)"] + set attr {} + set attlist {} + } else { + eval lappend attlist $attr + } + + set attr $attlist + + } else { + uplevel #0 $options(-errorcommand) [list unterminatedattribute "$attr around line $state(line)"] + set attr {} + } + } + } + } + + set empty {} + if {$cfg(-empty) && $options(-reportempty)} { + set empty {-empty 1} + } + + # Check for namespace declarations + upvar #0 $options(namespaces) namespaces + set nsdecls {} + if {[llength $attr]} { + array set attrlist $attr + foreach {attrName attrValue} [array get attrlist xmlns*] { + unset attrlist($attrName) + set colon [set prefix {}] + if {[regexp {^xmlns(:(.+))?$} $attrName discard colon prefix]} { + switch -glob [string length $colon],[string length $prefix] { + 0,0 { + # default NS declaration + lappend state(defaultNSURI) $attrValue + lappend state(defaultNS) [llength $state(stack)] + lappend nsdecls $attrValue {} + } + 0,* { + # Huh? + } + *,0 { + # Error + uplevel #0 $state(-warningcommand) "no prefix specified for namespace URI \"$attrValue\" in element \"$tag\"" + } + default { + set namespaces($prefix,[llength $state(stack)]) $attrValue + lappend nsdecls $attrValue $prefix + } + } + } + } + if {[llength $nsdecls]} { + set nsdecls [list -namespacedecls $nsdecls] + } + set attr [array get attrlist] + } + + # Check whether this element has an expanded name + set ns {} + if {[regexp {([^:]+):(.*)$} $tag discard prefix tag]} { + set nsspec [lsort -dictionary -decreasing [array names namespaces $prefix,*]] + if {[llength $nsspec]} { + set nsuri $namespaces([lindex $nsspec 0]) + set ns [list -namespace $nsuri] + } else { + uplevel #0 $options(-errorcommand) [list namespaceundeclared "no namespace declared for prefix \"$prefix\" in element $tag"] + } + } elseif {[llength $state(defaultNSURI)]} { + set ns [list -namespace [lindex $state(defaultNSURI) end]] + } + + # Invoke callback + set code [catch {uplevel #0 $options(-elementstartcommand) [list $tag $attr] $empty $ns $nsdecls} msg] + + # Sometimes empty elements must be handled here (see above) + if {$code == 0 && $handleEmpty} { + ParseEvent:ElementClose $tag $opts -empty 1 + } + + return -code $code -errorinfo $::errorInfo $msg +} + +# sgml::ParseEvent:ElementClose -- +# +# End of an element. +# +# Arguments: +# tag Element name +# opts Options +# args further configuration options +# +# Options: +# -empty boolean +# indicates whether the element as an empty element +# +# Results: +# Modify state and invoke callback + +proc sgml::ParseEvent:ElementClose {tag opts args} { + array set options $opts + upvar #0 $options(-statevariable) state + array set cfg {-empty 0} + array set cfg $args + + # WF check + if {[string compare $tag [lindex $state(stack) end]]} { + uplevel #0 $options(-errorcommand) [list illegalendtag "end tag \"$tag\" does not match open element \"[lindex $state(stack) end]\" around line $state(line)"] + return + } + + # Check whether this element has an expanded name + upvar #0 $options(namespaces) namespaces + set ns {} + if {[regexp {([^:]+):(.*)$} $tag discard prefix tag]} { + set nsuri $namespaces([lindex [lsort -dictionary -decreasing [array names namespaces $prefix,*]] 0]) + set ns [list -namespace $nsuri] + } elseif {[llength $state(defaultNSURI)]} { + set ns [list -namespace [lindex $state(defaultNSURI) end]] + } + + # Pop namespace stacks, if any + if {[llength $state(defaultNS)]} { + if {[llength $state(stack)] == [lindex $state(defaultNS) end]} { + set state(defaultNS) [lreplace $state(defaultNS) end end] + } + } + foreach nsspec [array names namespaces *,[llength $state(stack)]] { + unset namespaces($nsspec) + } + + # Update state + set state(stack) [lreplace $state(stack) end end] + + set empty {} + if {$cfg(-empty) && $options(-reportempty)} { + set empty {-empty 1} + } + + # Invoke callback + # Mats: Shall be same as sgml::ParseEvent:ElementOpen to handle exceptions in callback. + set code [catch {uplevel #0 $options(-elementendcommand) [list $tag] $empty $ns} msg] + return -code $code -errorinfo $::errorInfo $msg +} + +# sgml::PCDATA -- +# +# Process PCDATA before passing to application +# +# Arguments: +# opts options +# pcdata Character data to be processed +# +# Results: +# Checks that characters are legal, +# checks -ignorewhitespace setting. + +proc sgml::PCDATA {opts pcdata} { + array set options $opts + + if {$options(-ignorewhitespace) && \ + ![string length [string trim $pcdata]]} { + return {} + } + + if {![regexp ^[cl $::sgml::Char]*\$ $pcdata]} { + upvar \#0 $options(-statevariable) state + uplevel \#0 $options(-errorcommand) [list illegalcharacters "illegal, non-Unicode characters found in text \"$pcdata\" around line $state(line)"] + } + + uplevel \#0 $options(-characterdatacommand) [list $pcdata] +} + +# sgml::Normalize -- +# +# Perform name normalization if required +# +# Arguments: +# name name to normalize +# req normalization required +# +# Results: +# Name returned as upper-case if normalization required + +proc sgml::Normalize {name req} { + if {$req} { + return [string toupper $name] + } else { + return $name + } +} + +# sgml::Entity -- +# +# Resolve XML entity references (syntax: &xxx;). +# +# Arguments: +# opts options +# entityrefcmd application callback for entity references +# pcdatacmd application callback for character data +# entities name of array containing entity definitions. +# ref entity reference (the "xxx" bit) +# +# Results: +# Returns substitution text for given entity. + +proc sgml::Entity {opts entityrefcmd pcdatacmd entities ref} { + array set options $opts + upvar #0 $options(-statevariable) state + + if {![string length $entities]} { + set entities [namespace current]::EntityPredef + } + + # SRB: Bug fix 2008-11-18 #812051: surround case labels in braces for compatibility with Freewrap + switch -glob -- $ref { + {%*} { + # Parameter entity - not recognised outside of a DTD + } + {#x*} { + # Character entity - hex + if {[catch {format %c [scan [string range $ref 2 end] %x tmp; set tmp]} char]} { + return -code error "malformed character entity \"$ref\"" + } + uplevel #0 $pcdatacmd [list $char] + + return {} + + } + {#*} { + # Character entity - decimal + if {[catch {format %c [scan [string range $ref 1 end] %d tmp; set tmp]} char]} { + return -code error "malformed character entity \"$ref\"" + } + uplevel #0 $pcdatacmd [list $char] + + return {} + + } + default { + # General entity + upvar #0 $entities map + if {[info exists map($ref)]} { + + if {![regexp {<|&} $map($ref)]} { + + # Simple text replacement - optimise + uplevel #0 $pcdatacmd [list $map($ref)] + + return {} + + } + + # Otherwise an additional round of parsing is required. + # This only applies to XML, since HTML doesn't have general entities + + # Must parse the replacement text for start & end tags, etc + # This text must be self-contained: balanced closing tags, and so on + + set tokenised [tokenise $map($ref) $::xml::tokExpr $::xml::substExpr] + set options(-final) 0 + eval parseEvent [list $tokenised] [array get options] + + return {} + + } elseif {[string compare $entityrefcmd "::sgml::noop"]} { + + set result [uplevel #0 $entityrefcmd [list $ref]] + + if {[string length $result]} { + uplevel #0 $pcdatacmd [list $result] + } + + return {} + + } else { + + # Reconstitute entity reference + + uplevel #0 $options(-errorcommand) [list illegalentity "undefined entity reference \"$ref\""] + + return {} + + } + } + } + + # If all else fails leave the entity reference untouched + uplevel #0 $pcdatacmd [list &$ref\;] + + return {} +} + +#################################### +# +# DTD parser for SGML (XML). +# +# This DTD actually only handles XML DTDs. Other language's +# DTD's, such as HTML, must be written in terms of a XML DTD. +# +#################################### + +# sgml::ParseEvent:DocTypeDecl -- +# +# Entry point for DTD parsing +# +# Arguments: +# opts configuration options +# docEl document element name +# pubId public identifier +# sysId system identifier (a URI) +# intSSet internal DTD subset + +proc sgml::ParseEvent:DocTypeDecl {opts docEl pubId sysId intSSet} { + array set options {} + array set options $opts + + set code [catch {uplevel #0 $options(-doctypecommand) [list $docEl $pubId $sysId $intSSet]} err] + switch $code { + 3 { + # break + return {} + } + 0 - + 4 { + # continue + } + default { + return -code $code $err + } + } + + # Otherwise we'll parse the DTD and report it piecemeal + + # The internal DTD subset is processed first (XML 2.8) + # During this stage, parameter entities are only allowed + # between markup declarations + + ParseDTD:Internal [array get options] $intSSet + + # The external DTD subset is processed last (XML 2.8) + # During this stage, parameter entities may occur anywhere + + # We must resolve the external identifier to obtain the + # DTD data. The application may supply its own resolver. + + if {[string length $pubId] || [string length $sysId]} { + uplevel #0 $options(-externalentitycommand) [list $options(-cmd) $options(-baseuri) $sysId $pubId] + } + + return {} +} + +# sgml::ParseDTD:Internal -- +# +# Parse the internal DTD subset. +# +# Parameter entities are only allowed between markup declarations. +# +# Arguments: +# opts configuration options +# dtd DTD data +# +# Results: +# Markup declarations parsed may cause callback invocation + +proc sgml::ParseDTD:Internal {opts dtd} { + variable MarkupDeclExpr + variable MarkupDeclSub + + array set options {} + array set options $opts + + upvar #0 $options(-statevariable) state + upvar #0 $options(parameterentities) PEnts + upvar #0 $options(externalparameterentities) ExtPEnts + + # Bug 583947: remove comments before further processing + regsub -all {} $dtd {} dtd + + # Tokenize the DTD + + # Protect Tcl special characters + regsub -all {([{}\\])} $dtd {\\\1} dtd + + regsub -all $MarkupDeclExpr $dtd $MarkupDeclSub dtd + + # Entities may have angle brackets in their replacement + # text, which breaks the RE processing. So, we must + # use a similar technique to processing doc instances + # to rebuild the declarations from the pieces + + set mode {} ;# normal + set delimiter {} + set name {} + set param {} + + set state(inInternalDTD) 1 + + # Process the tokens + foreach {decl value text} [lrange "{} {} \{$dtd\}" 3 end] { + + # Keep track of line numbers + incr state(line) [regsub -all \n $text {} discard] + + ParseDTD:EntityMode [array get options] mode replText decl value text $delimiter $name $param + + ParseDTD:ProcessMarkupDecl [array get options] decl value delimiter name mode replText text param + + # There may be parameter entity references between markup decls + + if {[regexp {%.*;} $text]} { + + # Protect Tcl special characters + regsub -all {([{}\\])} $text {\\\1} text + + regsub -all %($::sgml::Name)\; $text "\} {\\1} \{" text + + set PElist "\{$text\}" + set PElist [lreplace $PElist end end] + foreach {text entref} $PElist { + if {[string length [string trim $text]]} { + uplevel #0 $options(-errorcommand) [list unexpectedtext "unexpected text in internal DTD subset around line $state(line)"] + } + + # Expand parameter entity and recursively parse + # BUG: no checks yet for recursive entity references + + if {[info exists PEnts($entref)]} { + set externalParser [$options(-cmd) entityparser] + $externalParser parse $PEnts($entref) -dtdsubset internal + } elseif {[info exists ExtPEnts($entref)]} { + set externalParser [$options(-cmd) entityparser] + $externalParser parse $ExtPEnts($entref) -dtdsubset external + #$externalParser free + } else { + uplevel #0 $options(-errorcommand) [list illegalreference "reference to undeclared parameter entity \"$entref\""] + } + } + + } + + } + + return {} +} + +# sgml::ParseDTD:EntityMode -- +# +# Perform special processing for various parser modes +# +# Arguments: +# opts configuration options +# modeVar pass-by-reference mode variable +# replTextVar pass-by-ref +# declVar pass-by-ref +# valueVar pass-by-ref +# textVar pass-by-ref +# delimiter delimiter currently in force +# name +# param +# +# Results: +# Depends on current mode + +proc sgml::ParseDTD:EntityMode {opts modeVar replTextVar declVar valueVar textVar delimiter name param} { + upvar 1 $modeVar mode + upvar 1 $replTextVar replText + upvar 1 $declVar decl + upvar 1 $valueVar value + upvar 1 $textVar text + array set options $opts + + switch $mode { + {} { + # Pass through to normal processing section + } + entity { + # Look for closing delimiter + if {[regexp ([cl ^$delimiter]*)${delimiter}(.*) $decl discard val1 remainder]} { + append replText <$val1 + DTD:ENTITY [array get options] $name [string trim $param] $delimiter$replText$delimiter + set decl / + set text $remainder\ $value>$text + set value {} + set mode {} + } elseif {[regexp ([cl ^$delimiter]*)${delimiter}(.*) $value discard val2 remainder]} { + append replText <$decl\ $val2 + DTD:ENTITY [array get options] $name [string trim $param] $delimiter$replText$delimiter + set decl / + set text $remainder>$text + set value {} + set mode {} + } elseif {[regexp ([cl ^$delimiter]*)${delimiter}(.*) $text discard val3 remainder]} { + append replText <$decl\ $value>$val3 + DTD:ENTITY [array get options] $name [string trim $param] $delimiter$replText$delimiter + set decl / + set text $remainder + set value {} + set mode {} + } else { + + # Remain in entity mode + append replText <$decl\ $value>$text + return -code continue + + } + } + + ignore { + upvar #0 $options(-statevariable) state + + if {[regexp {]](.*)$} $decl discard remainder]} { + set state(condSections) [lreplace $state(condSections) end end] + set decl $remainder + set mode {} + } elseif {[regexp {]](.*)$} $value discard remainder]} { + set state(condSections) [lreplace $state(condSections) end end] + regexp <[cl $::sgml::Wsp]*($::sgml::Name)(.*) $remainder discard decl value + set mode {} + } elseif {[regexp {]]>(.*)$} $text discard remainder]} { + set state(condSections) [lreplace $state(condSections) end end] + set decl / + set value {} + set text $remainder + #regexp <[cl $::sgml::Wsp]*($::sgml::Name)([cl ^>]*)>(.*) $remainder discard decl value text + set mode {} + } else { + set decl / + } + + } + + comment { + # Look for closing comment delimiter + + upvar #0 $options(-statevariable) state + + if {[regexp (.*?)--(.*)\$ $decl discard data1 remainder]} { + } elseif {[regexp (.*?)--(.*)\$ $value discard data1 remainder]} { + } elseif {[regexp (.*?)--(.*)\$ $text discard data1 remainder]} { + } else { + # comment continues + append state(commentdata) <$decl\ $value>$text + set decl / + set value {} + set text {} + } + } + + } + + return {} +} + +# sgml::ParseDTD:ProcessMarkupDecl -- +# +# Process a single markup declaration +# +# Arguments: +# opts configuration options +# declVar pass-by-ref +# valueVar pass-by-ref +# delimiterVar pass-by-ref for current delimiter in force +# nameVar pass-by-ref +# modeVar pass-by-ref for current parser mode +# replTextVar pass-by-ref +# textVar pass-by-ref +# paramVar pass-by-ref +# +# Results: +# Depends on markup declaration. May change parser mode + +proc sgml::ParseDTD:ProcessMarkupDecl {opts declVar valueVar delimiterVar nameVar modeVar replTextVar textVar paramVar} { + upvar 1 $modeVar mode + upvar 1 $replTextVar replText + upvar 1 $textVar text + upvar 1 $declVar decl + upvar 1 $valueVar value + upvar 1 $nameVar name + upvar 1 $delimiterVar delimiter + upvar 1 $paramVar param + + variable declExpr + variable ExternalEntityExpr + + array set options $opts + upvar #0 $options(-statevariable) state + + switch -glob -- $decl { + + / { + # continuation from entity processing + } + + !ELEMENT { + # Element declaration + if {[regexp $declExpr $value discard tag cmodel]} { + DTD:ELEMENT [array get options] $tag $cmodel + } else { + uplevel #0 $options(-errorcommand) [list illegaldeclaration "malformed element declaration around line $state(line)"] + } + } + + !ATTLIST { + # Attribute list declaration + variable declExpr + if {[regexp $declExpr $value discard tag attdefns]} { + if {[catch {DTD:ATTLIST [array get options] $tag $attdefns} err]} { + #puts stderr "Stack trace: $::errorInfo\n***\n" + # Atttribute parsing has bugs at the moment + #return -code error "$err around line $state(line)" + return {} + } + } else { + uplevel #0 $options(-errorcommand) [list illegaldeclaration "malformed attribute list declaration around line $state(line)"] + } + } + + !ENTITY { + # Entity declaration + variable EntityExpr + + if {[regexp $EntityExpr $value discard param name value]} { + + # Entity replacement text may have a '>' character. + # In this case, the real delimiter will be in the following + # text. This is complicated by the possibility of there + # being several '<','>' pairs in the replacement text. + # At this point, we are searching for the matching quote delimiter. + + if {[regexp $ExternalEntityExpr $value]} { + DTD:ENTITY [array get options] $name [string trim $param] $value + } elseif {[regexp ("|')(.*?)\\1(.*) $value discard delimiter replText value]} { + + if {[string length [string trim $value]]} { + uplevel #0 $options(-errorcommand) [list illegaldeclaration "malformed entity declaration around line $state(line)"] + } else { + DTD:ENTITY [array get options] $name [string trim $param] $delimiter$replText$delimiter + } + } elseif {[regexp ("|')(.*) $value discard delimiter replText]} { + append replText >$text + set text {} + set mode entity + } else { + uplevel #0 $options(-errorcommand) [list illegaldeclaration "no delimiter for entity declaration around line $state(line)"] + } + + } else { + uplevel #0 $options(-errorcommand) [list illegaldeclaration "malformed entity declaration around line $state(line)"] + } + } + + !NOTATION { + # Notation declaration + if {[regexp $declExpr param discard tag notation]} { + DTD:ENTITY [array get options] $tag $notation + } else { + uplevel #0 $options(-errorcommand) [list illegaldeclaration "malformed entity declaration around line $state(line)"] + } + } + + !--* { + # Start of a comment + + if {[regexp !--(.*?)--\$ $decl discard data]} { + if {[string length [string trim $value]]} { + uplevel #0 $options(-errorcommand) [list unexpectedtext "unexpected text \"$value\""] + } + uplevel #0 $options(-commentcommand) [list $data] + set decl / + set value {} + } elseif {[regexp -- ^(.*?)--\$ $value discard data2]} { + regexp !--(.*)\$ $decl discard data1 + uplevel #0 $options(-commentcommand) [list $data1\ $data2] + set decl / + set value {} + } elseif {[regexp (.*?)-->(.*)\$ $text discard data3 remainder]} { + regexp !--(.*)\$ $decl discard data1 + uplevel #0 $options(-commentcommand) [list $data1\ $value>$data3] + set decl / + set value {} + set text $remainder + } else { + regexp !--(.*)\$ $decl discard data1 + set state(commentdata) $data1\ $value>$text + set decl / + set value {} + set text {} + set mode comment + } + } + + !*INCLUDE* - + !*IGNORE* { + if {$state(inInternalDTD)} { + uplevel #0 $options(-errorcommand) [list illegalsection "conditional section not permitted in internal DTD subset around line $state(line)"] + } + + if {[regexp {^!\[INCLUDE\[(.*)} $decl discard remainder]} { + # Push conditional section stack, popped by ]]> sequence + + if {[regexp {(.*?)]]$} $remainder discard r2]} { + # section closed immediately + if {[string length [string trim $r2]]} { + uplevel #0 $options(-errorcommand) [list unexpectedtext "unexpected text \"$r2\" in conditional section"] + } + } elseif {[regexp {(.*?)]](.*)} $value discard r2 r3]} { + # section closed immediately + if {[string length [string trim $r2]]} { + uplevel #0 $options(-errorcommand) [list unexpectedtext "unexpected text \"$r2\" in conditional section"] + } + if {[string length [string trim $r3]]} { + uplevel #0 $options(-errorcommand) [list unexpectedtext "unexpected text \"$r3\" in conditional section"] + } + } else { + + lappend state(condSections) INCLUDE + + set parser [$options(-cmd) entityparser] + $parser parse $remainder\ $value> -dtdsubset external + #$parser free + + if {[regexp {(.*?)]]>(.*)} $text discard t1 t2]} { + if {[string length [string trim $t1]]} { + uplevel #0 $options(-errorcommand) [list unexpectedtext "unexpected text \"$t1\""] + } + if {![llength $state(condSections)]} { + uplevel #0 $options(-errorcommand) [list illegalsection "extraneous conditional section close"] + } + set state(condSections) [lreplace $state(condSections) end end] + set text $t2 + } + + } + } elseif {[regexp {^!\[IGNORE\[(.*)} $decl discard remainder]} { + # Set ignore mode. Still need a stack + set mode ignore + + if {[regexp {(.*?)]]$} $remainder discard r2]} { + # section closed immediately + if {[string length [string trim $r2]]} { + uplevel #0 $options(-errorcommand) [list unexpectedtext "unexpected text \"$r2\" in conditional section"] + } + } elseif {[regexp {(.*?)]](.*)} $value discard r2 r3]} { + # section closed immediately + if {[string length [string trim $r2]]} { + uplevel #0 $options(-errorcommand) [list unexpectedtext "unexpected text \"$r2\" in conditional section"] + } + if {[string length [string trim $r3]]} { + uplevel #0 $options(-errorcommand) [list unexpectedtext "unexpected text \"$r3\" in conditional section"] + } + } else { + + lappend state(condSections) IGNORE + + if {[regexp {(.*?)]]>(.*)} $text discard t1 t2]} { + if {[string length [string trim $t1]]} { + uplevel #0 $options(-errorcommand) [list unexpectedtext "unexpected text \"$t1\""] + } + if {![llength $state(condSections)]} { + uplevel #0 $options(-errorcommand) [list illegalsection "extraneous conditional section close"] + } + set state(condSections) [lreplace $state(condSections) end end] + set text $t2 + } + + } + } else { + uplevel #0 $options(-errorcommand) [list illegaldeclaration "illegal markup declaration \"$decl\" around line $state(line)"] + } + + } + + default { + if {[regexp {^\?(.*)} $decl discard target]} { + # Processing instruction + } else { + uplevel #0 $options(-errorcommand) [list illegaldeclaration "illegal markup declaration \"$decl\""] + } + } + } + + return {} +} + +# sgml::ParseDTD:External -- +# +# Parse the external DTD subset. +# +# Parameter entities are allowed anywhere. +# +# Arguments: +# opts configuration options +# dtd DTD data +# +# Results: +# Markup declarations parsed may cause callback invocation + +proc sgml::ParseDTD:External {opts dtd} { + variable MarkupDeclExpr + variable MarkupDeclSub + variable declExpr + + array set options $opts + upvar #0 $options(parameterentities) PEnts + upvar #0 $options(externalparameterentities) ExtPEnts + upvar #0 $options(-statevariable) state + + # As with the internal DTD subset, watch out for + # entities with angle brackets + set mode {} ;# normal + set delimiter {} + set name {} + set param {} + + set oldState 0 + catch {set oldState $state(inInternalDTD)} + set state(inInternalDTD) 0 + + # Initialise conditional section stack + if {![info exists state(condSections)]} { + set state(condSections) {} + } + set startCondSectionDepth [llength $state(condSections)] + + while {[string length $dtd]} { + set progress 0 + set PEref {} + if {![string compare $mode "ignore"]} { + set progress 1 + if {[regexp {]]>(.*)} $dtd discard dtd]} { + set remainder {} + set mode {} ;# normal + set state(condSections) [lreplace $state(condSections) end end] + continue + } else { + uplevel #0 $options(-errorcommand) [list missingdelimiter "IGNORE conditional section closing delimiter not found"] + } + } elseif {[regexp ^(.*?)%($::sgml::Name)\;(.*)\$ $dtd discard data PEref remainder]} { + set progress 1 + } else { + set data $dtd + set dtd {} + set remainder {} + } + + # Tokenize the DTD (so far) + + # Protect Tcl special characters + regsub -all {([{}\\])} $data {\\\1} dataP + + set n [regsub -all $MarkupDeclExpr $dataP $MarkupDeclSub dataP] + + if {$n} { + set progress 1 + # All but the last markup declaration should have no text + set dataP [lrange "{} {} \{$dataP\}" 3 end] + if {[llength $dataP] > 3} { + foreach {decl value text} [lrange $dataP 0 [expr [llength $dataP] - 4]] { + ParseDTD:EntityMode [array get options] mode replText decl value text $delimiter $name $param + ParseDTD:ProcessMarkupDecl [array get options] decl value delimiter name mode repltextVar text param + + if {[string length [string trim $text]]} { + # check for conditional section close + if {[regexp {]]>(.*)$} $text discard text]} { + if {[string length [string trim $text]]} { + uplevel #0 $options(-errorcommand) [list unexpectedtext "unexpected text \"$text\""] + } + if {![llength $state(condSections)]} { + uplevel #0 $options(-errorcommand) [list illegalsection "extraneous conditional section close"] + } + set state(condSections) [lreplace $state(condSections) end end] + if {![string compare $mode "ignore"]} { + set mode {} ;# normal + } + } else { + uplevel #0 $options(-errorcommand) [list unexpectedtext "unexpected text \"$text\""] + } + } + } + } + # Do the last declaration + foreach {decl value text} [lrange $dataP [expr [llength $dataP] - 3] end] { + ParseDTD:EntityMode [array get options] mode replText decl value text $delimiter $name $param + ParseDTD:ProcessMarkupDecl [array get options] decl value delimiter name mode repltextVar text param + } + } + + # Now expand the PE reference, if any + switch -glob $mode,[string length $PEref],$n { + ignore,0,* { + set dtd $text + } + ignore,*,* { + set dtd $text$remainder + } + *,0,0 { + set dtd $data + } + *,0,* { + set dtd $text + } + *,*,0 { + if {[catch {append data $PEnts($PEref)}]} { + if {[info exists ExtPEnts($PEref)]} { + set externalParser [$options(-cmd) entityparser] + $externalParser parse $ExtPEnts($PEref) -dtdsubset external + #$externalParser free + } else { + uplevel #0 $options(-errorcommand) [list entityundeclared "parameter entity \"$PEref\" not declared"] + } + } + set dtd $data$remainder + } + default { + if {[catch {append text $PEnts($PEref)}]} { + if {[info exists ExtPEnts($PEref)]} { + set externalParser [$options(-cmd) entityparser] + $externalParser parse $ExtPEnts($PEref) -dtdsubset external + #$externalParser free + } else { + uplevel #0 $options(-errorcommand) [list entityundeclared "parameter entity \"$PEref\" not declared"] + } + } + set dtd $text$remainder + } + } + + # Check whether a conditional section has been terminated + if {[regexp {^(.*?)]]>(.*)$} $dtd discard t1 t2]} { + if {![regexp <.*> $t1]} { + if {[string length [string trim $t1]]} { + uplevel #0 $options(-errorcommand) [list unexpectedtext "unexpected text \"$t1\""] + } + if {![llength $state(condSections)]} { + uplevel #0 $options(-errorcommand) [list illegalsection "extraneous conditional section close"] + } + set state(condSections) [lreplace $state(condSections) end end] + if {![string compare $mode "ignore"]} { + set mode {} ;# normal + } + set dtd $t2 + set progress 1 + } + } + + if {!$progress} { + # No parameter entity references were found and + # the text does not contain a well-formed markup declaration + # Avoid going into an infinite loop + upvar #0 $options(-errorcommand) [list syntaxerror "external entity does not contain well-formed markup declaration"] + break + } + } + + set state(inInternalDTD) $oldState + + # Check that conditional sections have been closed properly + if {[llength $state(condSections)] > $startCondSectionDepth} { + uplevel #0 $options(-errorcommand) [list syntaxerror "[lindex $state(condSections) end] conditional section not closed"] + } + if {[llength $state(condSections)] < $startCondSectionDepth} { + uplevel #0 $options(-errorcommand) [list syntaxerror "too many conditional section closures"] + } + + return {} +} + +# Procedures for handling the various declarative elements in a DTD. +# New elements may be added by creating a procedure of the form +# parse:DTD:_element_ + +# For each of these procedures, the various regular expressions they use +# are created outside of the proc to avoid overhead at runtime + +# sgml::DTD:ELEMENT -- +# +# defines an element. +# +# The content model for the element is stored in the contentmodel array, +# indexed by the element name. The content model is parsed into the +# following list form: +# +# {} Content model is EMPTY. +# Indicated by an empty list. +# * Content model is ANY. +# Indicated by an asterix. +# {ELEMENT ...} +# Content model is element-only. +# {MIXED {element1 element2 ...}} +# Content model is mixed (PCDATA and elements). +# The second element of the list contains the +# elements that may occur. #PCDATA is assumed +# (ie. the list is normalised). +# +# Arguments: +# opts configuration options +# name element GI +# modspec unparsed content model specification + +proc sgml::DTD:ELEMENT {opts name modspec} { + variable Wsp + array set options $opts + + upvar #0 $options(elementdecls) elements + + if {$options(-validate) && [info exists elements($name)]} { + eval $options(-errorcommand) [list elementdeclared "element \"$name\" already declared"] + } else { + switch -- $modspec { + EMPTY { + set elements($name) {} + uplevel #0 $options(-elementdeclcommand) $name {{}} + } + ANY { + set elements($name) * + uplevel #0 $options(-elementdeclcommand) $name * + } + default { + # Don't parse the content model for now, + # just pass the model to the application + if {0 && [regexp [format {^\([%s]*#PCDATA[%s]*(\|([^)]+))?[%s]*\)*[%s]*$} $Wsp $Wsp $Wsp $Wsp] discard discard mtoks]} { + set cm($name) [list MIXED [split $mtoks |]] + } elseif {0} { + if {[catch {CModelParse $state(state) $value} result]} { + eval $options(-errorcommand) [list element? $result] + } else { + set cm($id) [list ELEMENT $result] + } + } else { + set elements($name) $modspec + uplevel #0 $options(-elementdeclcommand) $name [list $modspec] + } + } + } + } +} + +# sgml::CModelParse -- +# +# Parse an element content model (non-mixed). +# A syntax tree is constructed. +# A transition table is built next. +# +# This is going to need alot of work! +# +# Arguments: +# state state array variable +# value the content model data +# +# Results: +# A Tcl list representing the content model. + +proc sgml::CModelParse {state value} { + upvar #0 $state var + + # First build syntax tree + set syntaxTree [CModelMakeSyntaxTree $state $value] + + # Build transition table + set transitionTable [CModelMakeTransitionTable $state $syntaxTree] + + return [list $syntaxTree $transitionTable] +} + +# sgml::CModelMakeSyntaxTree -- +# +# Construct a syntax tree for the regular expression. +# +# Syntax tree is represented as a Tcl list: +# rep {:choice|:seq {{rep list1} {rep list2} ...}} +# where: rep is repetition character, *, + or ?. {} for no repetition +# listN is nested expression or Name +# +# Arguments: +# spec Element specification +# +# Results: +# Syntax tree for element spec as nested Tcl list. +# +# Examples: +# (memo) +# {} {:seq {{} memo}} +# (front, body, back?) +# {} {:seq {{} front} {{} body} {? back}} +# (head, (p | list | note)*, div2*) +# {} {:seq {{} head} {* {:choice {{} p} {{} list} {{} note}}} {* div2}} +# (p | a | ul)+ +# + {:choice {{} p} {{} a} {{} ul}} + +proc sgml::CModelMakeSyntaxTree {state spec} { + upvar #0 $state var + variable Wsp + variable name + + # Translate the spec into a Tcl list. + + # None of the Tcl special characters are allowed in a content model spec. + if {[regexp {\$|\[|\]|\{|\}} $spec]} { + return -code error "illegal characters in specification" + } + + regsub -all [format {(%s)[%s]*(\?|\*|\+)?[%s]*(,|\|)?} $name $Wsp $Wsp] $spec [format {%sCModelSTname %s {\1} {\2} {\3}} \n $state] spec + regsub -all {\(} $spec "\nCModelSTopenParen $state " spec + regsub -all [format {\)[%s]*(\?|\*|\+)?[%s]*(,|\|)?} $Wsp $Wsp] $spec [format {%sCModelSTcloseParen %s {\1} {\2}} \n $state] spec + + array set var {stack {} state start} + eval $spec + + # Peel off the outer seq, its redundant + return [lindex [lindex $var(stack) 1] 0] +} + +# sgml::CModelSTname -- +# +# Processes a name in a content model spec. +# +# Arguments: +# state state array variable +# name name specified +# rep repetition operator +# cs choice or sequence delimiter +# +# Results: +# See CModelSTcp. + +proc sgml::CModelSTname {state name rep cs args} { + if {[llength $args]} { + return -code error "syntax error in specification: \"$args\"" + } + + CModelSTcp $state $name $rep $cs +} + +# sgml::CModelSTcp -- +# +# Process a content particle. +# +# Arguments: +# state state array variable +# name name specified +# rep repetition operator +# cs choice or sequence delimiter +# +# Results: +# The content particle is added to the current group. + +proc sgml::CModelSTcp {state cp rep cs} { + upvar #0 $state var + + switch -glob -- [lindex $var(state) end]=$cs { + start= { + set var(state) [lreplace $var(state) end end end] + # Add (dummy) grouping, either choice or sequence will do + CModelSTcsSet $state , + CModelSTcpAdd $state $cp $rep + } + :choice= - + :seq= { + set var(state) [lreplace $var(state) end end end] + CModelSTcpAdd $state $cp $rep + } + start=| - + start=, { + set var(state) [lreplace $var(state) end end [expr {$cs == "," ? ":seq" : ":choice"}]] + CModelSTcsSet $state $cs + CModelSTcpAdd $state $cp $rep + } + :choice=| - + :seq=, { + CModelSTcpAdd $state $cp $rep + } + :choice=, - + :seq=| { + return -code error "syntax error in specification: incorrect delimiter after \"$cp\", should be \"[expr {$cs == "," ? "|" : ","}]\"" + } + end=* { + return -code error "syntax error in specification: no delimiter before \"$cp\"" + } + default { + return -code error "syntax error" + } + } + +} + +# sgml::CModelSTcsSet -- +# +# Start a choice or sequence on the stack. +# +# Arguments: +# state state array +# cs choice oir sequence +# +# Results: +# state is modified: end element of state is appended. + +proc sgml::CModelSTcsSet {state cs} { + upvar #0 $state var + + set cs [expr {$cs == "," ? ":seq" : ":choice"}] + + if {[llength $var(stack)]} { + set var(stack) [lreplace $var(stack) end end $cs] + } else { + set var(stack) [list $cs {}] + } +} + +# sgml::CModelSTcpAdd -- +# +# Append a content particle to the top of the stack. +# +# Arguments: +# state state array +# cp content particle +# rep repetition +# +# Results: +# state is modified: end element of state is appended. + +proc sgml::CModelSTcpAdd {state cp rep} { + upvar #0 $state var + + if {[llength $var(stack)]} { + set top [lindex $var(stack) end] + lappend top [list $rep $cp] + set var(stack) [lreplace $var(stack) end end $top] + } else { + set var(stack) [list $rep $cp] + } +} + +# sgml::CModelSTopenParen -- +# +# Processes a '(' in a content model spec. +# +# Arguments: +# state state array +# +# Results: +# Pushes stack in state array. + +proc sgml::CModelSTopenParen {state args} { + upvar #0 $state var + + if {[llength $args]} { + return -code error "syntax error in specification: \"$args\"" + } + + lappend var(state) start + lappend var(stack) [list {} {}] +} + +# sgml::CModelSTcloseParen -- +# +# Processes a ')' in a content model spec. +# +# Arguments: +# state state array +# rep repetition +# cs choice or sequence delimiter +# +# Results: +# Stack is popped, and former top of stack is appended to previous element. + +proc sgml::CModelSTcloseParen {state rep cs args} { + upvar #0 $state var + + if {[llength $args]} { + return -code error "syntax error in specification: \"$args\"" + } + + set cp [lindex $var(stack) end] + set var(stack) [lreplace $var(stack) end end] + set var(state) [lreplace $var(state) end end] + CModelSTcp $state $cp $rep $cs +} + +# sgml::CModelMakeTransitionTable -- +# +# Given a content model's syntax tree, constructs +# the transition table for the regular expression. +# +# See "Compilers, Principles, Techniques, and Tools", +# Aho, Sethi and Ullman. Section 3.9, algorithm 3.5. +# +# Arguments: +# state state array variable +# st syntax tree +# +# Results: +# The transition table is returned, as a key/value Tcl list. + +proc sgml::CModelMakeTransitionTable {state st} { + upvar #0 $state var + + # Construct nullable, firstpos and lastpos functions + array set var {number 0} + foreach {nullable firstpos lastpos} [ \ + TraverseDepth1st $state $st { + # Evaluated for leaf nodes + # Compute nullable(n) + # Compute firstpos(n) + # Compute lastpos(n) + set nullable [nullable leaf $rep $name] + set firstpos [list {} $var(number)] + set lastpos [list {} $var(number)] + set var(pos:$var(number)) $name + } { + # Evaluated for nonterminal nodes + # Compute nullable, firstpos, lastpos + set firstpos [firstpos $cs $firstpos $nullable] + set lastpos [lastpos $cs $lastpos $nullable] + set nullable [nullable nonterm $rep $cs $nullable] + } \ + ] break + + set accepting [incr var(number)] + set var(pos:$accepting) # + + # var(pos:N) maps from position to symbol. + # Construct reverse map for convenience. + # NB. A symbol may appear in more than one position. + # var is about to be reset, so use different arrays. + + foreach {pos symbol} [array get var pos:*] { + set pos [lindex [split $pos :] 1] + set pos2symbol($pos) $symbol + lappend sym2pos($symbol) $pos + } + + # Construct the followpos functions + catch {unset var} + followpos $state $st $firstpos $lastpos + + # Construct transition table + # Dstates is [union $marked $unmarked] + set unmarked [list [lindex $firstpos 1]] + while {[llength $unmarked]} { + set T [lindex $unmarked 0] + lappend marked $T + set unmarked [lrange $unmarked 1 end] + + # Find which input symbols occur in T + set symbols {} + foreach pos $T { + if {$pos != $accepting && [lsearch $symbols $pos2symbol($pos)] < 0} { + lappend symbols $pos2symbol($pos) + } + } + foreach a $symbols { + set U {} + foreach pos $sym2pos($a) { + if {[lsearch $T $pos] >= 0} { + # add followpos($pos) + if {$var($pos) == {}} { + lappend U $accepting + } else { + eval lappend U $var($pos) + } + } + } + set U [makeSet $U] + if {[llength $U] && [lsearch $marked $U] < 0 && [lsearch $unmarked $U] < 0} { + lappend unmarked $U + } + set Dtran($T,$a) $U + } + + } + + return [list [array get Dtran] [array get sym2pos] $accepting] +} + +# sgml::followpos -- +# +# Compute the followpos function, using the already computed +# firstpos and lastpos. +# +# Arguments: +# state array variable to store followpos functions +# st syntax tree +# firstpos firstpos functions for the syntax tree +# lastpos lastpos functions +# +# Results: +# followpos functions for each leaf node, in name/value format + +proc sgml::followpos {state st firstpos lastpos} { + upvar #0 $state var + + switch -- [lindex [lindex $st 1] 0] { + :seq { + for {set i 1} {$i < [llength [lindex $st 1]]} {incr i} { + followpos $state [lindex [lindex $st 1] $i] \ + [lindex [lindex $firstpos 0] [expr $i - 1]] \ + [lindex [lindex $lastpos 0] [expr $i - 1]] + foreach pos [lindex [lindex [lindex $lastpos 0] [expr $i - 1]] 1] { + eval lappend var($pos) [lindex [lindex [lindex $firstpos 0] $i] 1] + set var($pos) [makeSet $var($pos)] + } + } + } + :choice { + for {set i 1} {$i < [llength [lindex $st 1]]} {incr i} { + followpos $state [lindex [lindex $st 1] $i] \ + [lindex [lindex $firstpos 0] [expr $i - 1]] \ + [lindex [lindex $lastpos 0] [expr $i - 1]] + } + } + default { + # No action at leaf nodes + } + } + + switch -- [lindex $st 0] { + ? { + # We having nothing to do here ! Doing the same as + # for * effectively converts this qualifier into the other. + } + * { + foreach pos [lindex $lastpos 1] { + eval lappend var($pos) [lindex $firstpos 1] + set var($pos) [makeSet $var($pos)] + } + } + } + +} + +# sgml::TraverseDepth1st -- +# +# Perform depth-first traversal of a tree. +# A new tree is constructed, with each node computed by f. +# +# Arguments: +# state state array variable +# t The tree to traverse, a Tcl list +# leaf Evaluated at a leaf node +# nonTerm Evaluated at a nonterminal node +# +# Results: +# A new tree is returned. + +proc sgml::TraverseDepth1st {state t leaf nonTerm} { + upvar #0 $state var + + set nullable {} + set firstpos {} + set lastpos {} + + switch -- [lindex [lindex $t 1] 0] { + :seq - + :choice { + set rep [lindex $t 0] + set cs [lindex [lindex $t 1] 0] + + foreach child [lrange [lindex $t 1] 1 end] { + foreach {childNullable childFirstpos childLastpos} \ + [TraverseDepth1st $state $child $leaf $nonTerm] break + lappend nullable $childNullable + lappend firstpos $childFirstpos + lappend lastpos $childLastpos + } + + eval $nonTerm + } + default { + incr var(number) + set rep [lindex [lindex $t 0] 0] + set name [lindex [lindex $t 1] 0] + eval $leaf + } + } + + return [list $nullable $firstpos $lastpos] +} + +# sgml::firstpos -- +# +# Computes the firstpos function for a nonterminal node. +# +# Arguments: +# cs node type, choice or sequence +# firstpos firstpos functions for the subtree +# nullable nullable functions for the subtree +# +# Results: +# firstpos function for this node is returned. + +proc sgml::firstpos {cs firstpos nullable} { + switch -- $cs { + :seq { + set result [lindex [lindex $firstpos 0] 1] + for {set i 0} {$i < [llength $nullable]} {incr i} { + if {[lindex [lindex $nullable $i] 1]} { + eval lappend result [lindex [lindex $firstpos [expr $i + 1]] 1] + } else { + break + } + } + } + :choice { + foreach child $firstpos { + eval lappend result $child + } + } + } + + return [list $firstpos [makeSet $result]] +} + +# sgml::lastpos -- +# +# Computes the lastpos function for a nonterminal node. +# Same as firstpos, only logic is reversed +# +# Arguments: +# cs node type, choice or sequence +# lastpos lastpos functions for the subtree +# nullable nullable functions forthe subtree +# +# Results: +# lastpos function for this node is returned. + +proc sgml::lastpos {cs lastpos nullable} { + switch -- $cs { + :seq { + set result [lindex [lindex $lastpos end] 1] + for {set i [expr [llength $nullable] - 1]} {$i >= 0} {incr i -1} { + if {[lindex [lindex $nullable $i] 1]} { + eval lappend result [lindex [lindex $lastpos $i] 1] + } else { + break + } + } + } + :choice { + foreach child $lastpos { + eval lappend result $child + } + } + } + + return [list $lastpos [makeSet $result]] +} + +# sgml::makeSet -- +# +# Turn a list into a set, ie. remove duplicates. +# +# Arguments: +# s a list +# +# Results: +# A set is returned, which is a list with duplicates removed. + +proc sgml::makeSet s { + foreach r $s { + if {[llength $r]} { + set unique($r) {} + } + } + return [array names unique] +} + +# sgml::nullable -- +# +# Compute the nullable function for a node. +# +# Arguments: +# nodeType leaf or nonterminal +# rep repetition applying to this node +# name leaf node: symbol for this node, nonterm node: choice or seq node +# subtree nonterm node: nullable functions for the subtree +# +# Results: +# Returns nullable function for this branch of the tree. + +proc sgml::nullable {nodeType rep name {subtree {}}} { + switch -glob -- $rep:$nodeType { + :leaf - + +:leaf { + return [list {} 0] + } + \\*:leaf - + \\?:leaf { + return [list {} 1] + } + \\*:nonterm - + \\?:nonterm { + return [list $subtree 1] + } + :nonterm - + +:nonterm { + switch -- $name { + :choice { + set result 0 + foreach child $subtree { + set result [expr $result || [lindex $child 1]] + } + } + :seq { + set result 1 + foreach child $subtree { + set result [expr $result && [lindex $child 1]] + } + } + } + return [list $subtree $result] + } + } +} + +# sgml::DTD:ATTLIST -- +# +# defines an attribute list. +# +# Arguments: +# opts configuration opions +# name Element GI +# attspec unparsed attribute definitions +# +# Results: +# Attribute list variables are modified. + +proc sgml::DTD:ATTLIST {opts name attspec} { + variable attlist_exp + variable attlist_enum_exp + variable attlist_fixed_exp + + array set options $opts + + # Parse the attribute list. If it were regular, could just use foreach, + # but some attributes may have values. + regsub -all {([][$\\])} $attspec {\\\1} attspec + regsub -all $attlist_exp $attspec "\}\nDTDAttribute {$options(-attlistdeclcommand)} $name $options(attlistdecls) {\\1} {\\2} {\\3} {} \{" attspec + regsub -all $attlist_enum_exp $attspec "\}\nDTDAttribute {$options(-attlistdeclcommand)} $name $options(attlistdecls) {\\1} {\\2} {} {\\4} \{" attspec + regsub -all $attlist_fixed_exp $attspec "\}\nDTDAttribute {$options(-attlistdeclcommand)} $name $options(attlistdecls) {\\1} {\\2} {\\3} {\\4} \{" attspec + + eval "noop \{$attspec\}" + + return {} +} + +# sgml::DTDAttribute -- +# +# Parse definition of a single attribute. +# +# Arguments: +# callback attribute defn callback +# name element name +# var array variable +# att attribute name +# type type of this attribute +# default default value of the attribute +# value other information +# text other text (should be empty) +# +# Results: +# Attribute defn added to array, unless it already exists + +proc sgml::DTDAttribute args { + # BUG: Some problems with parameter passing - deal with it later + foreach {callback name var att type default value text} $args break + + upvar #0 $var atts + + if {[string length [string trim $text]]} { + return -code error "unexpected text \"$text\" in attribute definition" + } + + # What about overridden attribute defns? + # A non-validating app may want to know about them + # (eg. an editor) + if {![info exists atts($name/$att)]} { + set atts($name/$att) [list $type $default $value] + uplevel #0 $callback [list $name $att $type $default $value] + } + + return {} +} + +# sgml::DTD:ENTITY -- +# +# declaration. +# +# Callbacks: +# -entitydeclcommand for general entity declaration +# -unparsedentitydeclcommand for unparsed external entity declaration +# -parameterentitydeclcommand for parameter entity declaration +# +# Arguments: +# opts configuration options +# name name of entity being defined +# param whether a parameter entity is being defined +# value unparsed replacement text +# +# Results: +# Modifies the caller's entities array variable + +proc sgml::DTD:ENTITY {opts name param value} { + + array set options $opts + + if {[string compare % $param]} { + # Entity declaration - general or external + upvar #0 $options(entities) ents + upvar #0 $options(extentities) externals + + if {[info exists ents($name)] || [info exists externals($name)]} { + eval $options(-warningcommand) entity [list "entity \"$name\" already declared"] + } else { + if {[catch {uplevel #0 $options(-parseentitydeclcommand) [list $value]} value]} { + return -code error "unable to parse entity declaration due to \"$value\"" + } + switch -glob [lindex $value 0],[lindex $value 3] { + internal, { + set ents($name) [EntitySubst [array get options] [lindex $value 1]] + uplevel #0 $options(-entitydeclcommand) [list $name $ents($name)] + } + internal,* { + return -code error "unexpected NDATA declaration" + } + external, { + set externals($name) [lrange $value 1 2] + uplevel #0 $options(-entitydeclcommand) [eval list $name [lrange $value 1 2]] + } + external,* { + set externals($name) [lrange $value 1 3] + uplevel #0 $options(-unparsedentitydeclcommand) [eval list $name [lrange $value 1 3]] + } + default { + return -code error "internal error: unexpected parser state" + } + } + } + } else { + # Parameter entity declaration + upvar #0 $options(parameterentities) PEnts + upvar #0 $options(externalparameterentities) ExtPEnts + + if {[info exists PEnts($name)] || [info exists ExtPEnts($name)]} { + eval $options(-warningcommand) parameterentity [list "parameter entity \"$name\" already declared"] + } else { + if {[catch {uplevel #0 $options(-parseentitydeclcommand) [list $value]} value]} { + return -code error "unable to parse parameter entity declaration due to \"$value\"" + } + if {[string length [lindex $value 3]]} { + return -code error "NDATA illegal in parameter entity declaration" + } + switch [lindex $value 0] { + internal { + # Substitute character references and PEs (XML: 4.5) + set value [EntitySubst [array get options] [lindex $value 1]] + + set PEnts($name) $value + uplevel #0 $options(-parameterentitydeclcommand) [list $name $value] + } + external - + default { + # Get the replacement text now. + # Could wait until the first reference, but easier + # to just do it now. + + set token [uri::geturl [uri::resolve $options(-baseuri) [lindex $value 1]]] + + set ExtPEnts($name) [lindex [array get $token data] 1] + uplevel #0 $options(-parameterentitydeclcommand) [eval list $name [lrange $value 1 2]] + } + } + } + } +} + +# sgml::EntitySubst -- +# +# Perform entity substitution on an entity replacement text. +# This differs slightly from other substitution procedures, +# because only parameter and character entity substitution +# is performed, not general entities. +# See XML Rec. section 4.5. +# +# Arguments: +# opts configuration options +# value Literal entity value +# +# Results: +# Expanded replacement text + +proc sgml::EntitySubst {opts value} { + array set options $opts + + # Protect Tcl special characters + regsub -all {([{}\\])} $value {\\\1} value + + # Find entity references + regsub -all (&#\[0-9\]+|&#x\[0-9a-fA-F\]+|%${::sgml::Name})\; $value "\[EntitySubstValue [list $options(parameterentities)] {\\1}\]" value + + set result [subst $value] + + return $result +} + +# sgml::EntitySubstValue -- +# +# Handle a single character or parameter entity substitution +# +# Arguments: +# PEvar array variable containing PE declarations +# ref character or parameter entity reference +# +# Results: +# Replacement text + +proc sgml::EntitySubstValue {PEvar ref} { + # SRB: Bug fix 2008-11-18 #812051: surround case labels in braces for compatibility with Freewrap + switch -glob -- $ref { + {&#x*} { + scan [string range $ref 3 end] %x hex + return [format %c $hex] + } + {&#*} { + return [format %c [string range $ref 2 end]] + } + {%*} { + upvar #0 $PEvar PEs + set ref [string range $ref 1 end] + if {[info exists PEs($ref)]} { + return $PEs($ref) + } else { + return -code error "parameter entity \"$ref\" not declared" + } + } + default { + return -code error "internal error - unexpected entity reference" + } + } + return {} +} + +# sgml::DTD:NOTATION -- +# +# Process notation declaration +# +# Arguments: +# opts configuration options +# name notation name +# value unparsed notation spec + +proc sgml::DTD:NOTATION {opts name value} { + return {} + + variable notation_exp + upvar opts state + + if {[regexp $notation_exp $value x scheme data] == 2} { + } else { + eval $state(-errorcommand) [list notationvalue "notation value \"$value\" incorrectly specified"] + } +} + +# sgml::ResolveEntity -- +# +# Default entity resolution routine +# +# Arguments: +# cmd command of parent parser +# base base URL for relative URLs +# sysId system identifier +# pubId public identifier + +proc sgml::ResolveEntity {cmd base sysId pubId} { + variable ParseEventNum + + if {[catch {uri::resolve $base $sysId} url]} { + return -code error "unable to resolve system identifier \"$sysId\"" + } + if {[catch {uri::geturl $url} token]} { + return -code error "unable to retrieve external entity \"$url\" for system identifier \"$sysId\"" + } + + upvar #0 $token data + + set parser [uplevel #0 $cmd entityparser] + + set body {} + catch {set body $data(body)} + catch {set body $data(data)} + if {[string length $body]} { + uplevel #0 $parser parse [list $body] -dtdsubset external + } + $parser free + + return {} +} diff --git a/tclxml-tcl/tclparser-8.0.tcl b/tclxml-tcl/tclparser-8.0.tcl new file mode 100755 index 0000000..e2573f8 --- /dev/null +++ b/tclxml-tcl/tclparser-8.0.tcl @@ -0,0 +1,359 @@ +# tclparser-8.0.tcl -- +# +# This file provides a Tcl implementation of a XML parser. +# This file supports Tcl 8.0. +# +# See xml-8.[01].tcl for definitions of character sets and +# regular expressions. +# +# Copyright (c) 2005-2008 by Explain. +# http://www.explain.com.au/ +# Copyright (c) 1998-2004 Zveno Pty Ltd +# http://www.zveno.com/ +# +# See the file "LICENSE" in this distribution for information on usage and +# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# $Id: tclparser-8.0.tcl,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $ + +package require -exact Tcl 8.0 + +package require xmldefs 3.2 + +package require sgmlparser 1.0 + +package provide xml::tclparser 3.2 + +namespace eval xml { + + # Procedures for parsing XML documents + namespace export parser + # Procedures for parsing XML DTDs + namespace export DTDparser + + # Counter for creating unique parser objects + variable ParserCounter 0 + +} + +# xml::parser -- +# +# Creates XML parser object. +# +# Arguments: +# args Unique name for parser object +# plus option/value pairs +# +# Recognised Options: +# -final Indicates end of document data +# -elementstartcommand Called when an element starts +# -elementendcommand Called when an element ends +# -characterdatacommand Called when character data occurs +# -processinginstructioncommand Called when a PI occurs +# -externalentityrefcommand Called for an external entity reference +# +# (Not compatible with expat) +# -xmldeclcommand Called when the XML declaration occurs +# -doctypecommand Called when the document type declaration occurs +# +# -errorcommand Script to evaluate for a fatal error +# -warningcommand Script to evaluate for a reportable warning +# -statevariable global state variable +# -reportempty whether to provide empty element indication +# +# Results: +# The state variable is initialised. + +proc xml::parser {args} { + variable ParserCounter + + if {[llength $args] > 0} { + set name [lindex $args 0] + set args [lreplace $args 0 0] + } else { + set name parser[incr ParserCounter] + } + + if {[info command [namespace current]::$name] != {}} { + return -code error "unable to create parser object \"[namespace current]::$name\" command" + } + + # Initialise state variable and object command + upvar \#0 [namespace current]::$name parser + set sgml_ns [namespace parent]::sgml + array set parser [list name $name \ + -final 1 \ + -elementstartcommand ${sgml_ns}::noop \ + -elementendcommand ${sgml_ns}::noop \ + -characterdatacommand ${sgml_ns}::noop \ + -processinginstructioncommand ${sgml_ns}::noop \ + -externalentityrefcommand ${sgml_ns}::noop \ + -xmldeclcommand ${sgml_ns}::noop \ + -doctypecommand ${sgml_ns}::noop \ + -warningcommand ${sgml_ns}::noop \ + -statevariable [namespace current]::$name \ + -reportempty 0 \ + internaldtd {} \ + ] + + proc [namespace current]::$name {method args} \ + "eval ParseCommand $name \$method \$args" + + eval ParseCommand [list $name] configure $args + + return [namespace current]::$name +} + +# xml::ParseCommand -- +# +# Handles parse object command invocations +# +# Valid Methods: +# cget +# configure +# parse +# reset +# +# Arguments: +# parser parser object +# method minor command +# args other arguments +# +# Results: +# Depends on method + +proc xml::ParseCommand {parser method args} { + upvar \#0 [namespace current]::$parser state + + switch -- $method { + cget { + return $state([lindex $args 0]) + } + configure { + foreach {opt value} $args { + set state($opt) $value + } + } + parse { + ParseCommand_parse $parser [lindex $args 0] + } + reset { + if {[llength $args]} { + return -code error "too many arguments" + } + ParseCommand_reset $parser + } + default { + return -code error "unknown method \"$method\"" + } + } + + return {} +} + +# xml::ParseCommand_parse -- +# +# Parses document instance data +# +# Arguments: +# object parser object +# xml data +# +# Results: +# Callbacks are invoked, if any are defined + +proc xml::ParseCommand_parse {object xml} { + upvar \#0 [namespace current]::$object parser + variable Wsp + variable tokExpr + variable substExpr + + set parent [namespace parent] + if {![string compare :: $parent]} { + set parent {} + } + + set tokenised [lrange \ + [${parent}::sgml::tokenise $xml \ + $tokExpr \ + $substExpr \ + -internaldtdvariable [namespace current]::${object}(internaldtd)] \ + 4 end] + + eval ${parent}::sgml::parseEvent \ + [list $tokenised \ + -emptyelement [namespace code ParseEmpty] \ + -parseattributelistcommand [namespace code ParseAttrs]] \ + [array get parser -*command] \ + [array get parser -entityvariable] \ + [array get parser -reportempty] \ + [array get parser -final] \ + -normalize 0 \ + -internaldtd [list $parser(internaldtd)] + + return {} +} + +# xml::ParseEmpty -- Tcl 8.0 version +# +# Used by parser to determine whether an element is empty. +# This should be dead easy in XML. The only complication is +# that the RE above can't catch the trailing slash, so we have +# to dig it out of the tag name or attribute list. +# +# Tcl 8.1 REs should fix this. +# +# Arguments: +# tag element name +# attr attribute list (raw) +# e End tag delimiter. +# +# Results: +# "/" if the trailing slash is found. Optionally, return a list +# containing new values for the tag name and/or attribute list. + +proc xml::ParseEmpty {tag attr e} { + + if {[string match */ [string trimright $tag]] && \ + ![string length $attr]} { + regsub {/$} $tag {} tag + return [list / $tag $attr] + } elseif {[string match */ [string trimright $attr]]} { + regsub {/$} [string trimright $attr] {} attr + return [list / $tag $attr] + } else { + return {} + } + +} + +# xml::ParseAttrs -- +# +# Parse element attributes. +# +# There are two forms for name-value pairs: +# +# name="value" +# name='value' +# +# Watch out for the trailing slash on empty elements. +# +# Arguments: +# attrs attribute string given in a tag +# +# Results: +# Returns a Tcl list representing the name-value pairs in the +# attribute string + +proc xml::ParseAttrs attrs { + variable Wsp + variable Name + + # First check whether there's any work to do + if {![string compare {} [string trim $attrs]]} { + return {} + } + + # Strip the trailing slash on empty elements + regsub [format {/[%s]*$} " \t\n\r"] $attrs {} atList + + set mode name + set result {} + foreach component [split $atList =] { + switch $mode { + name { + set component [string trim $component] + if {[regexp $Name $component]} { + lappend result $component + } else { + return -code error "invalid attribute name \"$component\"" + } + set mode value:start + } + value:start { + set component [string trimleft $component] + set delimiter [string index $component 0] + set value {} + switch -- $delimiter { + \" - + ' { + if {[regexp [format {%s([^%s]*)%s(.*)} $delimiter $delimiter $delimiter] $component discard value remainder]} { + lappend result $value + set remainder [string trim $remainder] + if {[string length $remainder]} { + if {[regexp $Name $remainder]} { + lappend result $remainder + set mode value:start + } else { + return -code error "invalid attribute name \"$remainder\"" + } + } else { + set mode end + } + } else { + set value [string range $component 1 end] + set mode value:continue + } + } + default { + return -code error "invalid value for attribute \"[lindex $result end]\"" + } + } + } + value:continue { + if {[regexp [format {([^%s]*)%s(.*)} $delimiter $delimiter] $component discard valuepart remainder]} { + append value = $valuepart + lappend result $value + set remainder [string trim $remainder] + if {[string length $remainder]} { + if {[regexp $Name $remainder]} { + lappend result $remainder + set mode value:start + } else { + return -code error "invalid attribute name \"$remainder\"" + } + } else { + set mode end + } + } else { + append value = $component + } + } + end { + return -code error "unexpected data found after end of attribute list" + } + } + } + + switch $mode { + name - + end { + # This is normal + } + default { + return -code error "unexpected end of attribute list" + } + } + + return $result +} + +# xml::ParseCommand_reset -- +# +# Initialize parser data +# +# Arguments: +# object parser object +# +# Results: +# Parser data structure initialised + +proc xml::ParseCommand_reset object { + upvar \#0 [namespace current]::$object parser + + array set parser [list \ + -final 1 \ + internaldtd {} \ + ] +} + diff --git a/tclxml-tcl/tclparser-8.1.tcl b/tclxml-tcl/tclparser-8.1.tcl new file mode 100755 index 0000000..40a0af9 --- /dev/null +++ b/tclxml-tcl/tclparser-8.1.tcl @@ -0,0 +1,614 @@ +# tclparser-8.1.tcl -- +# +# This file provides a Tcl implementation of a XML parser. +# This file supports Tcl 8.1. +# +# See xml-8.[01].tcl for definitions of character sets and +# regular expressions. +# +# Copyright (c) 2005-2008 by Explain. +# http://www.explain.com.au/ +# Copyright (c) 1998-2003 Zveno Pty Ltd +# http://www.zveno.com/ +# +# See the file "LICENSE" in this distribution for information on usage and +# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# $Id: tclparser-8.1.tcl,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $ + +package require Tcl 8.1 + +package provide xml::tclparser 3.2 + +package require xmldefs 3.2 + +package require sgmlparser 1.0 + +namespace eval xml::tclparser { + + namespace export create createexternal externalentity parse configure get delete + + # Tokenising expressions + + variable tokExpr $::xml::tokExpr + variable substExpr $::xml::substExpr + + # Register this parser class + + ::xml::parserclass create tcl \ + -createcommand [namespace code create] \ + -createentityparsercommand [namespace code createentityparser] \ + -parsecommand [namespace code parse] \ + -configurecommand [namespace code configure] \ + -deletecommand [namespace code delete] \ + -resetcommand [namespace code reset] +} + +# xml::tclparser::create -- +# +# Creates XML parser object. +# +# Arguments: +# name unique identifier for this instance +# +# Results: +# The state variable is initialised. + +proc xml::tclparser::create name { + + # Initialise state variable + upvar \#0 [namespace current]::$name parser + array set parser [list -name $name \ + -cmd [uplevel 3 namespace current]::$name \ + -final 1 \ + -validate 0 \ + -statevariable [namespace current]::$name \ + -baseuri {} \ + internaldtd {} \ + entities [namespace current]::Entities$name \ + extentities [namespace current]::ExtEntities$name \ + parameterentities [namespace current]::PEntities$name \ + externalparameterentities [namespace current]::ExtPEntities$name \ + elementdecls [namespace current]::ElDecls$name \ + attlistdecls [namespace current]::AttlistDecls$name \ + notationdecls [namespace current]::NotDecls$name \ + depth 0 \ + leftover {} \ + ] + + # Initialise entities with predefined set + array set [namespace current]::Entities$name [array get ::sgml::EntityPredef] + + return $parser(-cmd) +} + +# xml::tclparser::createentityparser -- +# +# Creates XML parser object for an entity. +# +# Arguments: +# name name for the new parser +# parent name of parent parser +# +# Results: +# The state variable is initialised. + +proc xml::tclparser::createentityparser {parent name} { + upvar #0 [namespace current]::$parent p + + # Initialise state variable + upvar \#0 [namespace current]::$name external + array set external [array get p] + + regsub $parent $p(-cmd) {} parentns + + array set external [list -name $name \ + -cmd $parentns$name \ + -statevariable [namespace current]::$name \ + internaldtd {} \ + line 0 \ + ] + incr external(depth) + + return $external(-cmd) +} + +# xml::tclparser::configure -- +# +# Configures a XML parser object. +# +# Arguments: +# name unique identifier for this instance +# args option name/value pairs +# +# Results: +# May change values of config options + +proc xml::tclparser::configure {name args} { + upvar \#0 [namespace current]::$name parser + + # BUG: very crude, no checks for illegal args + # Mats: Should be synced with sgmlparser.tcl + set options {-elementstartcommand -elementendcommand \ + -characterdatacommand -processinginstructioncommand \ + -externalentitycommand -xmldeclcommand \ + -doctypecommand -commentcommand \ + -entitydeclcommand -unparsedentitydeclcommand \ + -parameterentitydeclcommand -notationdeclcommand \ + -elementdeclcommand -attlistdeclcommand \ + -paramentityparsing -defaultexpandinternalentities \ + -startdoctypedeclcommand -enddoctypedeclcommand \ + -entityreferencecommand -warningcommand \ + -defaultcommand -unknownencodingcommand -notstandalonecommand \ + -startcdatasectioncommand -endcdatasectioncommand \ + -errorcommand -final \ + -validate -baseuri -baseurl \ + -name -cmd -emptyelement \ + -parseattributelistcommand -parseentitydeclcommand \ + -normalize -internaldtd -dtdsubset \ + -reportempty -ignorewhitespace \ + -reportempty \ + } + set usage [join $options ", "] + regsub -all -- - $options {} options + set pat ^-([join $options |])$ + foreach {flag value} $args { + if {[regexp $pat $flag]} { + # Validate numbers + if {[info exists parser($flag)] && \ + [string is integer -strict $parser($flag)] && \ + ![string is integer -strict $value]} { + return -code error "Bad value for $flag ($value), must be integer" + } + set parser($flag) $value + } else { + return -code error "Unknown option $flag, can be: $usage" + } + } + + # Backward-compatibility: -baseuri is a synonym for -baseurl + catch {set parser(-baseuri) $parser(-baseurl)} + + return {} +} + +# xml::tclparser::parse -- +# +# Parses document instance data +# +# Arguments: +# name parser object +# xml data +# args configuration options +# +# Results: +# Callbacks are invoked + +proc xml::tclparser::parse {name xml args} { + + array set options $args + upvar \#0 [namespace current]::$name parser + variable tokExpr + variable substExpr + + # Mats: + if {[llength $args]} { + eval {configure $name} $args + } + + set parseOptions [list \ + -emptyelement [namespace code ParseEmpty] \ + -parseattributelistcommand [namespace code ParseAttrs] \ + -parseentitydeclcommand [namespace code ParseEntity] \ + -normalize 0] + eval lappend parseOptions \ + [array get parser -*command] \ + [array get parser -reportempty] \ + [array get parser -ignorewhitespace] \ + [array get parser -name] \ + [array get parser -cmd] \ + [array get parser -baseuri] \ + [array get parser -validate] \ + [array get parser -final] \ + [array get parser -defaultexpandinternalentities] \ + [array get parser entities] \ + [array get parser extentities] \ + [array get parser parameterentities] \ + [array get parser externalparameterentities] \ + [array get parser elementdecls] \ + [array get parser attlistdecls] \ + [array get parser notationdecls] + + # Mats: + # If -final 0 we also need to maintain the state with a -statevariable ! + if {!$parser(-final)} { + eval lappend parseOptions [array get parser -statevariable] + } + + set dtdsubset no + catch {set dtdsubset $options(-dtdsubset)} + switch -- $dtdsubset { + internal { + # Bypass normal parsing + lappend parseOptions -statevariable $parser(-statevariable) + array set intOptions [array get ::sgml::StdOptions] + array set intOptions $parseOptions + ::sgml::ParseDTD:Internal [array get intOptions] $xml + return {} + } + external { + # Bypass normal parsing + lappend parseOptions -statevariable $parser(-statevariable) + array set intOptions [array get ::sgml::StdOptions] + array set intOptions $parseOptions + ::sgml::ParseDTD:External [array get intOptions] $xml + return {} + } + default { + # Pass through to normal processing + } + } + + lappend tokenOptions \ + -internaldtdvariable [namespace current]::${name}(internaldtd) + + # Mats: If -final 0 we also need to maintain the state with a -statevariable ! + if {!$parser(-final)} { + eval lappend tokenOptions [array get parser -statevariable] \ + [array get parser -final] + } + + # Mats: + # Why not the first four? Just padding? Lrange undos \n interp. + # It is necessary to have the first four as well if chopped off in + # middle of pcdata. + set tokenised [lrange \ + [eval {::sgml::tokenise $xml $tokExpr $substExpr} $tokenOptions] \ + 0 end] + + lappend parseOptions -internaldtd [list $parser(internaldtd)] + eval ::sgml::parseEvent [list $tokenised] $parseOptions + + return {} +} + +# xml::tclparser::ParseEmpty -- Tcl 8.1+ version +# +# Used by parser to determine whether an element is empty. +# This is usually dead easy in XML, but as always not quite. +# Have to watch out for empty element syntax +# +# Arguments: +# tag element name +# attr attribute list (raw) +# e End tag delimiter. +# +# Results: +# Return value of e + +proc xml::tclparser::ParseEmpty {tag attr e} { + switch -glob [string length $e],[regexp "/[::xml::cl $::xml::Wsp]*$" $attr] { + 0,0 { + return {} + } + 0,* { + return / + } + default { + return $e + } + } +} + +# xml::tclparser::ParseAttrs -- Tcl 8.1+ version +# +# Parse element attributes. +# +# There are two forms for name-value pairs: +# +# name="value" +# name='value' +# +# Arguments: +# opts parser options +# attrs attribute string given in a tag +# +# Results: +# Returns a Tcl list representing the name-value pairs in the +# attribute string +# +# A ">" occurring in the attribute list causes problems when parsing +# the XML. This manifests itself by an unterminated attribute value +# and a ">" appearing the element text. +# In this case return a three element list; +# the message "unterminated attribute value", the attribute list it +# did manage to parse and the remainder of the attribute list. + +proc xml::tclparser::ParseAttrs {opts attrs} { + + set result {} + + while {[string length [string trim $attrs]]} { + if {[regexp [::sgml::cl $::xml::Wsp]*($::xml::Name)[::sgml::cl $::xml::Wsp]*=[::sgml::cl $::xml::Wsp]*("|')([::sgml::cl ^<]*?)\\2(.*) $attrs discard attrName delimiter value attrs]} { + lappend result $attrName [NormalizeAttValue $opts $value] + } elseif {[regexp [::sgml::cl $::xml::Wsp]*$::xml::Name[::sgml::cl $::xml::Wsp]*=[::sgml::cl $::xml::Wsp]*("|')[::sgml::cl ^<]*\$ $attrs]} { + return -code error [list {unterminated attribute value} $result $attrs] + } else { + return -code error "invalid attribute list" + } + } + + return $result +} + +# xml::tclparser::NormalizeAttValue -- +# +# Perform attribute value normalisation. This involves: +# . character references are appended to the value +# . entity references are recursively processed and replacement value appended +# . whitespace characters cause a space to be appended +# . other characters appended as-is +# +# Arguments: +# opts parser options +# value unparsed attribute value +# +# Results: +# Normalised value returned. + +proc xml::tclparser::NormalizeAttValue {opts value} { + + # sgmlparser already has backslashes protected + # Protect Tcl specials + regsub -all {([][$])} $value {\\\1} value + + # Deal with white space + regsub -all "\[$::xml::Wsp\]" $value { } value + + # Find entity refs + regsub -all {&([^;]+);} $value {[NormalizeAttValue:DeRef $opts {\1}]} value + + return [subst $value] +} + +# xml::tclparser::NormalizeAttValue:DeRef -- +# +# Handler to normalize attribute values +# +# Arguments: +# opts parser options +# ref entity reference +# +# Results: +# Returns character + +proc xml::tclparser::NormalizeAttValue:DeRef {opts ref} { + # SRB: Bug fix 2008-11-18 #812051: surround case labels in braces for compatibility with Freewrap + switch -glob -- $ref { + {#x*} { + scan [string range $ref 2 end] %x value + set char [format %c $value] + # Check that the char is legal for XML + if {[regexp [format {^[%s]$} $::xml::Char] $char]} { + return $char + } else { + return -code error "illegal character" + } + } + {#*} { + scan [string range $ref 1 end] %d value + set char [format %c $value] + # Check that the char is legal for XML + if {[regexp [format {^[%s]$} $::xml::Char] $char]} { + return $char + } else { + return -code error "illegal character" + } + } + lt - + gt - + amp - + quot - + apos { + array set map {lt < gt > amp & quot \" apos '} + return $map($ref) + } + default { + # A general entity. Must resolve to a text value - no element structure. + + array set options $opts + upvar #0 $options(entities) map + + if {[info exists map($ref)]} { + + if {[regexp < $map($ref)]} { + return -code error "illegal character \"<\" in attribute value" + } + + if {![regexp & $map($ref)]} { + # Simple text replacement + return $map($ref) + } + + # There are entity references in the replacement text. + # Can't use child entity parser since must catch element structures + + return [NormalizeAttValue $opts $map($ref)] + + } elseif {[string compare $options(-entityreferencecommand) "::sgml::noop"]} { + + set result [uplevel #0 $options(-entityreferencecommand) [list $ref]] + + return $result + + } else { + return -code error "unable to resolve entity reference \"$ref\"" + } + } + } +} + +# xml::tclparser::ParseEntity -- +# +# Parse general entity declaration +# +# Arguments: +# data text to parse +# +# Results: +# Tcl list containing entity declaration + +proc xml::tclparser::ParseEntity data { + set data [string trim $data] + if {[regexp $::sgml::ExternalEntityExpr $data discard type delimiter1 id1 discard delimiter2 id2 optNDATA ndata]} { + switch $type { + PUBLIC { + return [list external $id2 $id1 $ndata] + } + SYSTEM { + return [list external $id1 {} $ndata] + } + } + } elseif {[regexp {^("|')(.*?)\1$} $data discard delimiter value]} { + return [list internal $value] + } else { + return -code error "badly formed entity declaration" + } +} + +# xml::tclparser::delete -- +# +# Destroy parser data +# +# Arguments: +# name parser object +# +# Results: +# Parser data structure destroyed + +proc xml::tclparser::delete name { + upvar \#0 [namespace current]::$name parser + catch {::sgml::ParserDelete $parser(-statevariable)} + catch {unset parser} + return {} +} + +# xml::tclparser::get -- +# +# Retrieve additional information from the parser +# +# Arguments: +# name parser object +# method info to retrieve +# args additional arguments for method +# +# Results: +# Depends on method + +proc xml::tclparser::get {name method args} { + upvar #0 [namespace current]::$name parser + + switch -- $method { + + elementdecl { + switch [llength $args] { + + 0 { + # Return all element declarations + upvar #0 $parser(elementdecls) elements + return [array get elements] + } + + 1 { + # Return specific element declaration + upvar #0 $parser(elementdecls) elements + if {[info exists elements([lindex $args 0])]} { + return [array get elements [lindex $args 0]] + } else { + return -code error "element \"[lindex $args 0]\" not declared" + } + } + + default { + return -code error "wrong number of arguments: should be \"elementdecl ?element?\"" + } + } + } + + attlist { + if {[llength $args] != 1} { + return -code error "wrong number of arguments: should be \"get attlist element\"" + } + + upvar #0 $parser(attlistdecls) + + return {} + } + + entitydecl { + } + + parameterentitydecl { + } + + notationdecl { + } + + default { + return -code error "unknown method \"$method\"" + } + } + + return {} +} + +# xml::tclparser::ExternalEntity -- +# +# Resolve and parse external entity +# +# Arguments: +# name parser object +# base base URL +# sys system identifier +# pub public identifier +# +# Results: +# External entity is fetched and parsed + +proc xml::tclparser::ExternalEntity {name base sys pub} { +} + +# xml::tclparser:: -- +# +# Reset a parser instance, ready to parse another document +# +# Arguments: +# name parser object +# +# Results: +# Variables unset + +proc xml::tclparser::reset {name} { + upvar \#0 [namespace current]::$name parser + + # Has this parser object been properly initialised? + if {![info exists parser] || \ + ![info exists parser(-name)]} { + return [create $name] + } + + array set parser { + -final 1 + depth 0 + leftover {} + } + + foreach var {Entities ExtEntities PEntities ExtPEntities ElDecls AttlistDecls NotDecls} { + catch {unset [namespace current]::${var}$name} + } + + # Initialise entities with predefined set + array set [namespace current]::Entities$name [array get ::sgml::EntityPredef] + + return {} +} diff --git a/tclxml-tcl/xml-8.0.tcl b/tclxml-tcl/xml-8.0.tcl new file mode 100755 index 0000000..db28423 --- /dev/null +++ b/tclxml-tcl/xml-8.0.tcl @@ -0,0 +1,92 @@ +# xml-8.0.tcl -- +# +# This file provides generic XML services for all implementations. +# This file supports Tcl 8.0 regular expressions. +# +# See xmlparse.tcl for the Tcl implementation of a XML parser. +# +# Copyright (c) 2005 by Explain. +# http://www.explain.com.au/ +# Copyright (c) 1998-2004 Zveno Pty Ltd +# http://www.zveno.com/ +# +# See the file "LICENSE" in this distribution for information on usage and +# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# $Id: xml-8.0.tcl,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $ + +package require -exact Tcl 8.0 + +package require sgml 1.8 + +package provide xmldefs 3.2 + +namespace eval xml { + + # Convenience routine + proc cl x { + return "\[$x\]" + } + + # Define various regular expressions + + # Characters + variable Char $::sgml::Char + + # white space + variable Wsp " \t\r\n" + variable noWsp [cl ^$Wsp] + + # Various XML names and tokens + + variable NameChar $::sgml::NameChar + variable Name $::sgml::Name + variable Names $::sgml::Names + variable Nmtoken $::sgml::Nmtoken + variable Nmtokens $::sgml::Nmtokens + + # The definition of the Namespace URI for XML Namespaces themselves. + # The prefix 'xml' is automatically bound to this URI. + variable xmlnsNS http://www.w3.org/XML/1998/namespace + + # Tokenising expressions + + variable tokExpr <(/?)([cl ^$Wsp>/]+)([cl $Wsp]*[cl ^>]*)> + variable substExpr "\}\n{\\2} {\\1} {\\3} \{" + + # table of predefined entities + + variable EntityPredef + array set EntityPredef { + lt < gt > amp & quot \" apos ' + } + +} + +### +### General utility procedures +### + +# xml::noop -- +# +# A do-nothing proc + +proc xml::noop args {} + +### Following procedures are based on html_library + +# xml::zapWhite -- +# +# Convert multiple white space into a single space. +# +# Arguments: +# data plain text +# +# Results: +# As above + +proc xml::zapWhite data { + regsub -all "\[ \t\r\n\]+" $data { } data + return $data +} + diff --git a/tclxml-tcl/xml-8.1.tcl b/tclxml-tcl/xml-8.1.tcl new file mode 100755 index 0000000..5ec410b --- /dev/null +++ b/tclxml-tcl/xml-8.1.tcl @@ -0,0 +1,135 @@ +# xml.tcl -- +# +# This file provides generic XML services for all implementations. +# This file supports Tcl 8.1 regular expressions. +# +# See tclparser.tcl for the Tcl implementation of a XML parser. +# +# Copyright (c) 2005 by Explain. +# http://www.explain.com.au/ +# Copyright (c) 1998-2004 Zveno Pty Ltd +# http://www.zveno.com/ +# +# See the file "LICENSE" in this distribution for information on usage and +# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# $Id: xml-8.1.tcl,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $ + +package require Tcl 8.1 + +package provide xmldefs 3.2 + +package require sgml 1.8 + +namespace eval xml { + + namespace export qnamesplit + + # Convenience routine + proc cl x { + return "\[$x\]" + } + + # Define various regular expressions + + # Characters + variable Char $::sgml::Char + + # white space + variable Wsp " \t\r\n" + variable allWsp [cl $Wsp]* + variable noWsp [cl ^$Wsp] + + # Various XML names and tokens + + variable NameChar $::sgml::NameChar + variable Name $::sgml::Name + variable Names $::sgml::Names + variable Nmtoken $::sgml::Nmtoken + variable Nmtokens $::sgml::Nmtokens + + # XML Namespaces names + + # NCName ::= Name - ':' + variable NCName $::sgml::Name + regsub -all : $NCName {} NCName + variable QName (${NCName}:)?$NCName ;# (Prefix ':')? LocalPart + + # The definition of the Namespace URI for XML Namespaces themselves. + # The prefix 'xml' is automatically bound to this URI. + variable xmlnsNS http://www.w3.org/XML/1998/namespace + + # table of predefined entities + + variable EntityPredef + array set EntityPredef { + lt < gt > amp & quot \" apos ' + } + + # Expressions for pulling things apart + variable tokExpr <(/?)([::xml::cl ^$::xml::Wsp>/]+)([::xml::cl $::xml::Wsp]*[::xml::cl ^>]*)> + variable substExpr "\}\n{\\2} {\\1} {\\3} \{" + +} + +### +### Exported procedures +### + +# xml::qnamesplit -- +# +# Split a QName into its constituent parts: +# the XML Namespace prefix and the Local-name +# +# Arguments: +# qname XML Qualified Name (see XML Namespaces [6]) +# +# Results: +# Returns prefix and local-name as a Tcl list. +# Error condition returned if the prefix or local-name +# are not valid NCNames (XML Name) + +proc xml::qnamesplit qname { + variable NCName + variable Name + + set prefix {} + set localname $qname + if {[regexp : $qname]} { + if {![regexp ^($NCName)?:($NCName)\$ $qname discard prefix localname]} { + return -code error "name \"$qname\" is not a valid QName" + } + } elseif {![regexp ^$Name\$ $qname]} { + return -code error "name \"$qname\" is not a valid Name" + } + + return [list $prefix $localname] +} + +### +### General utility procedures +### + +# xml::noop -- +# +# A do-nothing proc + +proc xml::noop args {} + +### Following procedures are based on html_library + +# xml::zapWhite -- +# +# Convert multiple white space into a single space. +# +# Arguments: +# data plain text +# +# Results: +# As above + +proc xml::zapWhite data { + regsub -all "\[ \t\r\n\]+" $data { } data + return $data +} + diff --git a/tclxml-tcl/xml__tcl.tcl b/tclxml-tcl/xml__tcl.tcl new file mode 100644 index 0000000..bdb7bd9 --- /dev/null +++ b/tclxml-tcl/xml__tcl.tcl @@ -0,0 +1,272 @@ +# xml__tcl.tcl -- +# +# This file provides a Tcl implementation of the parser +# class support found in ../tclxml.c. It is only used +# when the C implementation is not installed (for some reason). +# +# Copyright (c) 2005 by Explain. +# http://www.explain.com.au/ +# Copyright (c) 2000-2004 Zveno Pty Ltd +# http://www.zveno.com/ +# +# See the file "LICENSE" in this distribution for information on usage and +# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# $Id: xml__tcl.tcl,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $ + +package provide xml::tcl 3.2 + +namespace eval xml { + namespace export configure parser parserclass + + # Parser implementation classes + variable classes + array set classes {} + + # Default parser class + variable default {} + + # Counter for generating unique names + variable counter 0 +} + +# xml::configure -- +# +# Configure the xml package +# +# Arguments: +# None +# +# Results: +# None (not yet implemented) + +proc xml::configure args {} + +# xml::parserclass -- +# +# Implements the xml::parserclass command for managing +# parser implementations. +# +# Arguments: +# method subcommand +# args method arguments +# +# Results: +# Depends on method + +proc xml::parserclass {method args} { + variable classes + variable default + + switch -- $method { + + create { + if {[llength $args] < 1} { + return -code error "wrong number of arguments, should be xml::parserclass create name ?args?" + } + + set name [lindex $args 0] + if {[llength [lrange $args 1 end]] % 2} { + return -code error "missing value for option \"[lindex $args end]\"" + } + array set classes [list $name [list \ + -createcommand [namespace current]::noop \ + -createentityparsercommand [namespace current]::noop \ + -parsecommand [namespace current]::noop \ + -configurecommand [namespace current]::noop \ + -getcommand [namespace current]::noop \ + -deletecommand [namespace current]::noop \ + ]] + # BUG: we're not checking that the arguments are kosher + set classes($name) [lrange $args 1 end] + set default $name + } + + destroy { + if {[llength $args] < 1} { + return -code error "wrong number of arguments, should be xml::parserclass destroy name" + } + + if {[info exists classes([lindex $args 0])]} { + unset classes([lindex $args 0]) + } else { + return -code error "no such parser class \"[lindex $args 0]\"" + } + } + + info { + if {[llength $args] < 1} { + return -code error "wrong number of arguments, should be xml::parserclass info method" + } + + switch -- [lindex $args 0] { + names { + return [array names classes] + } + default { + return $default + } + } + } + + default { + return -code error "unknown method \"$method\"" + } + } + + return {} +} + +# xml::parser -- +# +# Create a parser object instance +# +# Arguments: +# args optional name, configuration options +# +# Results: +# Returns object name. Parser instance created. + +proc xml::parser args { + variable classes + variable default + + if {[llength $args] < 1} { + # Create unique name, no options + set parserName [FindUniqueName] + } else { + if {[string index [lindex $args 0] 0] == "-"} { + # Create unique name, have options + set parserName [FindUniqueName] + } else { + # Given name, optional options + set parserName [lindex $args 0] + set args [lrange $args 1 end] + } + } + + array set options [list \ + -parser $default + ] + array set options $args + + if {![info exists classes($options(-parser))]} { + return -code error "no such parser class \"$options(-parser)\"" + } + + # Now create the parser instance command and data structure + # The command must be created in the caller's namespace + uplevel 1 [list proc $parserName {method args} "eval [namespace current]::ParserCmd [list $parserName] \[list \$method\] \$args"] + upvar #0 [namespace current]::$parserName data + array set data [list class $options(-parser)] + + array set classinfo $classes($options(-parser)) + if {[string compare $classinfo(-createcommand) ""]} { + eval $classinfo(-createcommand) [list $parserName] + } + if {[string compare $classinfo(-configurecommand) ""] && \ + [llength $args]} { + eval $classinfo(-configurecommand) [list $parserName] $args + } + + return $parserName +} + +# xml::FindUniqueName -- +# +# Generate unique object name +# +# Arguments: +# None +# +# Results: +# Returns string. + +proc xml::FindUniqueName {} { + variable counter + return xmlparser[incr counter] +} + +# xml::ParserCmd -- +# +# Implements parser object command +# +# Arguments: +# name object reference +# method subcommand +# args method arguments +# +# Results: +# Depends on method + +proc xml::ParserCmd {name method args} { + variable classes + upvar #0 [namespace current]::$name data + + array set classinfo $classes($data(class)) + + switch -- $method { + + configure { + # BUG: We're not checking for legal options + array set data $args + eval $classinfo(-configurecommand) [list $name] $args + return {} + } + + cget { + return $data([lindex $args 0]) + } + + entityparser { + set new [FindUniqueName] + + upvar #0 [namespace current]::$name parent + upvar #0 [namespace current]::$new data + array set data [array get parent] + + uplevel 1 [list proc $new {method args} "eval [namespace current]::ParserCmd [list $new] \[list \$method\] \$args"] + + return [eval $classinfo(-createentityparsercommand) [list $name $new] $args] + } + + free { + eval $classinfo(-deletecommand) [list $name] + unset data + uplevel 1 [list rename $name {}] + } + + get { + eval $classinfo(-getcommand) [list $name] $args + } + + parse { + if {[llength $args] < 1} { + return -code error "wrong number of arguments, should be $name parse xml ?options?" + } + eval $classinfo(-parsecommand) [list $name] $args + } + + reset { + eval $classinfo(-resetcommand) [list $name] + } + + default { + return -code error "unknown method" + } + } + + return {} +} + +# xml::noop -- +# +# Do nothing utility proc +# +# Arguments: +# args whatever +# +# Results: +# Nothing happens + +proc xml::noop args {} diff --git a/tclxml-tcl/xmldep.tcl b/tclxml-tcl/xmldep.tcl new file mode 100644 index 0000000..bbb2613 --- /dev/null +++ b/tclxml-tcl/xmldep.tcl @@ -0,0 +1,179 @@ +# xmldep.tcl -- +# +# Find the dependencies in an XML document. +# Supports external entities and XSL include/import. +# +# TODO: +# XInclude +# +# Copyright (c) 2001-2003 Zveno Pty Ltd +# http://www.zveno.com/ +# +# See the file "LICENSE" in this distribution for information on usage and +# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# $Id: xmldep.tcl,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $ + +package require xml + +package provide xml::dep 1.0 + +namespace eval xml::dep { + namespace export depend + + variable extEntities + array set extEntities {} + + variable XSLTNS http://www.w3.org/1999/XSL/Transform +} + +# xml::dep::depend -- +# +# Find the resources which an XML document +# depends on. The document is parsed +# sequentially, rather than using DOM, for efficiency. +# +# TODO: +# Asynchronous parsing. +# +# Arguments: +# xml XML document entity +# args configuration options +# +# Results: +# Returns list of resource (system) identifiers + +proc xml::dep::depend {xml args} { + variable resources + variable entities + + set resources {} + catch {unset entities} + array set entities {} + + set p [xml::parser \ + -elementstartcommand [namespace code ElStart] \ + -doctypecommand [namespace code DocTypeDecl] \ + -entitydeclcommand [namespace code EntityDecl] \ + -entityreferencecommand [namespace code EntityReference] \ + -validate 1 \ + ] + if {[llength $args]} { + eval [list $p] configure $args + } + $p parse $xml + + return $resources +} + +# xml::dep::ElStart -- +# +# Process start element +# +# Arguments: +# name tag name +# atlist attribute list +# args options +# +# Results: +# May add to resources list + +proc xml::dep::ElStart {name atlist args} { + variable XSLTNS + variable resources + + array set opts { + -namespace {} + } + array set opts $args + + switch -- $opts(-namespace) \ + $XSLTNS { + switch $name { + import - + include { + array set attr { + href {} + } + array set attr $atlist + + if {[string length $attr(href)]} { + if {[lsearch $resources $attr(href)] < 0} { + lappend resources $attr(href) + } + } + + } + } + } +} + +# xml::dep::DocTypeDecl -- +# +# Process Document Type Declaration +# +# Arguments: +# name Document element +# pubid Public identifier +# sysid System identifier +# dtd Internal DTD Subset +# +# Results: +# Resource added to list + +proc xml::dep::DocTypeDecl {name pubid sysid dtd} { + variable resources + + puts stderr [list DocTypeDecl $name $pubid $sysid dtd] + + if {[string length $sysid] && \ + [lsearch $resources $sysid] < 0} { + lappend resources $sysid + } + + return {} +} + +# xml::dep::EntityDecl -- +# +# Process entity declaration, looking for external entity +# +# Arguments: +# name entity name +# sysid system identifier +# pubid public identifier or repl. text +# +# Results: +# Store external entity info for later reference + +proc xml::dep::EntityDecl {name sysid pubid} { + variable extEntities + + puts stderr [list EntityDecl $name $sysid $pubid] + + set extEntities($name) $sysid +} + +# xml::dep::EntityReference -- +# +# Process entity reference +# +# Arguments: +# name entity name +# +# Results: +# May add to resources list + +proc xml::dep::EntityReference name { + variable extEntities + variable resources + + puts stderr [list EntityReference $name] + + if {[info exists extEntities($name)] && \ + [lsearch $resources $extEntities($name)] < 0} { + lappend resources $extEntities($name) + } + +} + diff --git a/tclxml-tcl/xpath.tcl b/tclxml-tcl/xpath.tcl new file mode 100644 index 0000000..e772e67 --- /dev/null +++ b/tclxml-tcl/xpath.tcl @@ -0,0 +1,362 @@ +# xpath.tcl -- +# +# Provides an XPath parser for Tcl, +# plus various support procedures +# +# Copyright (c) 2000-2003 Zveno Pty Ltd +# +# See the file "LICENSE" in this distribution for information on usage and +# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# $Id: xpath.tcl,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $ + +package provide xpath 1.0 + +# We need the XML package for definition of Names +package require xml + +namespace eval xpath { + namespace export split join createnode + + variable axes { + ancestor + ancestor-or-self + attribute + child + descendant + descendant-or-self + following + following-sibling + namespace + parent + preceding + preceding-sibling + self + } + + variable nodeTypes { + comment + text + processing-instruction + node + } + + # NB. QName has parens for prefix + + variable nodetestExpr ^(${::xml::QName})${::xml::allWsp}(\\(${::xml::allWsp}(("|')(.*?)\\5)?${::xml::allWsp}\\))?${::xml::allWsp}(.*) + + variable nodetestExpr2 ((($::xml::QName)${::xml::allWsp}(\\(${::xml::allWsp}(("|')(.*?)\\7)?${::xml::allWsp}\\))?)|${::xml::allWsp}(\\*))${::xml::allWsp}(.*) +} + +# xpath::split -- +# +# Parse an XPath location path +# +# Arguments: +# locpath location path +# +# Results: +# A Tcl list representing the location path. +# The list has the form: {{axis node-test {predicate predicate ...}} ...} +# Where each list item is a location step. + +proc xpath::split locpath { + set leftover {} + + set result [InnerSplit $locpath leftover] + + if {[string length [string trim $leftover]]} { + return -code error "unexpected text \"$leftover\"" + } + + return $result +} + +proc xpath::InnerSplit {locpath leftoverVar} { + upvar $leftoverVar leftover + + variable axes + variable nodetestExpr + variable nodetestExpr2 + + # First determine whether we have an absolute location path + if {[regexp {^/(.*)} $locpath discard locpath]} { + set path {{}} + } else { + set path {} + } + + while {[string length [string trimleft $locpath]]} { + if {[regexp {^\.\.(.*)} $locpath discard locpath]} { + # .. abbreviation + set axis parent + set nodetest * + } elseif {[regexp {^/(.*)} $locpath discard locpath]} { + # // abbreviation + set axis descendant-or-self + if {[regexp ^$nodetestExpr2 [string trimleft $locpath] discard discard discard nodetest discard typetest discard discard literal wildcard locpath]} { + set nodetest [ResolveWildcard $nodetest $typetest $wildcard $literal] + } else { + set leftover $locpath + return $path + } + } elseif {[regexp ^\\.${::xml::allWsp}(.*) $locpath discard locpath]} { + # . abbreviation + set axis self + set nodetest * + } elseif {[regexp ^@($::xml::QName)${::xml::allWsp}=${::xml::allWsp}"(\[^"\])"(.*) $locpath discard attrName discard attrValue locpath]} { + # @ abbreviation + set axis attribute + set nodetest $attrName + } elseif {[regexp ^@($::xml::QName)${::xml::allWsp}=${::xml::allWsp}'(\[^'\])'(.*) $locpath discard attrName discard attrValue locpath]} { + # @ abbreviation + set axis attribute + set nodetest $attrName + } elseif {[regexp ^@($::xml::QName)(.*) $locpath discard attrName discard2 locpath]} { + # @ abbreviation + set axis attribute + set nodetest $attrName + } elseif {[regexp ^((${::xml::QName})${::xml::allWsp}::${::xml::allWsp})?\\*(.*) $locpath discard discard axis discard locpath]} { + # wildcard specified + set nodetest * + if {![string length $axis]} { + set axis child + } + } elseif {[regexp ^((${::xml::QName})${::xml::allWsp}::${::xml::allWsp})?$nodetestExpr2 $locpath discard discard axis discard discard discard nodetest discard typetest discard discard literal wildcard locpath]} { + # nodetest, with or without axis + if {![string length $axis]} { + set axis child + } + set nodetest [ResolveWildcard $nodetest $typetest $wildcard $literal] + } else { + set leftover $locpath + return $path + } + + # ParsePredicates + set predicates {} + set locpath [string trimleft $locpath] + while {[regexp {^\[(.*)} $locpath discard locpath]} { + if {[regexp {^([0-9]+)(\].*)} [string trim $locpath] discard posn locpath]} { + set predicate [list = {function position {}} [list number $posn]] + } else { + set leftover2 {} + set predicate [ParseExpr $locpath leftover2] + set locpath $leftover2 + unset leftover2 + } + + if {[regexp {^\](.*)} [string trimleft $locpath] discard locpath]} { + lappend predicates $predicate + } else { + return -code error "unexpected text in predicate \"$locpath\"" + } + } + + set axis [string trim $axis] + set nodetest [string trim $nodetest] + + # This step completed + if {[lsearch $axes $axis] < 0} { + return -code error "invalid axis \"$axis\"" + } + lappend path [list $axis $nodetest $predicates] + + # Move to next step + + if {[string length $locpath] && ![regexp ^/(.*) $locpath discard locpath]} { + set leftover $locpath + return $path + } + + } + + return $path +} + +# xpath::ParseExpr -- +# +# Parse one expression in a predicate +# +# Arguments: +# locpath location path to parse +# leftoverVar Name of variable in which to store remaining path +# +# Results: +# Returns parsed expression as a Tcl list + +proc xpath::ParseExpr {locpath leftoverVar} { + upvar $leftoverVar leftover + variable nodeTypes + + set expr {} + set mode expr + set stack {} + + while {[string index [string trimleft $locpath] 0] != "\]"} { + set locpath [string trimleft $locpath] + switch $mode { + expr { + # We're looking for a term + if {[regexp ^-(.*) $locpath discard locpath]} { + # UnaryExpr + lappend stack "-" + } elseif {[regexp ^\\\$({$::xml::QName})(.*) $locpath discard varname discard locpath]} { + # VariableReference + lappend stack [list varRef $varname] + set mode term + } elseif {[regexp {^\((.*)} $locpath discard locpath]} { + # Start grouping + set leftover2 {} + lappend stack [list group [ParseExpr $locpath leftover2]] + set locpath $leftover2 + unset leftover2 + + if {[regexp {^\)(.*)} [string trimleft $locpath] discard locpath]} { + set mode term + } else { + return -code error "unexpected text \"$locpath\", expected \")\"" + } + + } elseif {[regexp {^"([^"]*)"(.*)} $locpath discard literal locpath]} { + # Literal (" delimited) + lappend stack [list literal $literal] + set mode term + } elseif {[regexp {^'([^']*)'(.*)} $locpath discard literal locpath]} { + # Literal (' delimited) + lappend stack [list literal $literal] + set mode term + } elseif {[regexp {^([0-9]+(\.[0-9]+)?)(.*)} $locpath discard number discard locpath]} { + # Number + lappend stack [list number $number] + set mode term + } elseif {[regexp {^(\.[0-9]+)(.*)} $locpath discard number locpath]} { + # Number + lappend stack [list number $number] + set mode term + } elseif {[regexp ^(${::xml::QName})\\(${::xml::allWsp}(.*) $locpath discard functionName discard locpath]} { + # Function call start or abbreviated node-type test + + if {[lsearch $nodeTypes $functionName] >= 0} { + # Looking like a node-type test + if {[regexp ^\\)${::xml::allWsp}(.*) $locpath discard locpath]} { + lappend stack [list path [list child [list $functionName ()] {}]] + set mode term + } else { + return -code error "invalid node-type test \"$functionName\"" + } + } else { + if {[regexp ^\\)${::xml::allWsp}(.*) $locpath discard locpath]} { + set parameters {} + } else { + set leftover2 {} + set parameters [ParseExpr $locpath leftover2] + set locpath $leftover2 + unset leftover2 + while {[regexp {^,(.*)} $locpath discard locpath]} { + set leftover2 {} + lappend parameters [ParseExpr $locpath leftover2] + set locpath $leftover2 + unset leftover2 + } + + if {![regexp ^\\)${::xml::allWsp}(.*) [string trimleft $locpath] discard locpath]} { + return -code error "unexpected text \"locpath\" - expected \")\"" + } + } + + lappend stack [list function $functionName $parameters] + set mode term + } + + } else { + # LocationPath + set leftover2 {} + lappend stack [list path [InnerSplit $locpath leftover2]] + set locpath $leftover2 + unset leftover2 + set mode term + } + } + term { + # We're looking for an expression operator + if {[regexp ^-(.*) $locpath discard locpath]} { + # UnaryExpr + set stack [linsert $stack 0 expr "-"] + set mode expr + } elseif {[regexp ^(and|or|\\=|!\\=|<|>|<\\=|>\\=|\\||\\+|\\-|\\*|div|mod)(.*) $locpath discard exprtype locpath]} { + # AndExpr, OrExpr, EqualityExpr, RelationalExpr or UnionExpr + set stack [linsert $stack 0 $exprtype] + set mode expr + } else { + return -code error "unexpected text \"$locpath\", expecting operator" + } + } + default { + # Should never be here! + return -code error "internal error" + } + } + } + + set leftover $locpath + return $stack +} + +# xpath::ResolveWildcard -- + +proc xpath::ResolveWildcard {nodetest typetest wildcard literal} { + variable nodeTypes + + switch -glob -- [string length $nodetest],[string length $typetest],[string length $wildcard],[string length $literal] { + 0,0,0,* { + return -code error "bad location step (nothing parsed)" + } + 0,0,* { + # Name wildcard specified + return * + } + *,0,0,* { + # Element type test - nothing to do + return $nodetest + } + *,0,*,* { + # Internal error? + return -code error "bad location step (found both nodetest and wildcard)" + } + *,*,0,0 { + # Node type test + if {[lsearch $nodeTypes $nodetest] < 0} { + return -code error "unknown node type \"$typetest\"" + } + return [list $nodetest $typetest] + } + *,*,0,* { + # Node type test + if {[lsearch $nodeTypes $nodetest] < 0} { + return -code error "unknown node type \"$typetest\"" + } + return [list $nodetest $literal] + } + default { + # Internal error? + return -code error "bad location step" + } + } +} + +# xpath::join -- +# +# Reconstitute an XPath location path from a +# Tcl list representation. +# +# Arguments: +# spath split path +# +# Results: +# Returns an Xpath location path + +proc xpath::join spath { + return -code error "not yet implemented" +} + diff --git a/tclxml.c b/tclxml.c new file mode 100755 index 0000000..adc2e0f --- /dev/null +++ b/tclxml.c @@ -0,0 +1,3708 @@ +/* + * tclxml.c -- + * + * Entry point for XML parsers, DOM and XSLT. + * + * Copyright (c) 2005-2007 Steve Ball, explain + * http://www.explain.com.au/ + * Copyright (c) 1998-2004 Steve Ball, Zveno Pty Ltd + * + * See the file "LICENSE" for information on usage and + * redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * $Id: tclxml.c,v 1.2 2009/03/03 22:55:36 joye Exp $ + * + */ + +#include +#include +#include +#include +#include + +#define TCL_DOES_STUBS \ + (TCL_MAJOR_VERSION > 8 || TCL_MAJOR_VERSION == 8 && (TCL_MINOR_VERSION > 1 || \ + (TCL_MINOR_VERSION == 1 && TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE))) +#ifdef USE_TCLXML_STUBS +#ifndef TCLXML_DOES_STUBS +# define TCLXML_DOES_STUBS TCL_DOES_STUBS +#endif /* USE_TCLXML_STUBS */ +#endif /* TCL_DOES_STUBS */ + +/* + * The structure below is used to manage package options. + */ + +typedef struct ThreadSpecificData { + int initialized; + + TclXML_ParserClassInfo *defaultParser; /* Current default parser */ + Tcl_HashTable *registeredParsers; /* All known parser classes */ + + /* + * Retain a pointer to the whitespace variable + */ + + Tcl_Obj *whitespaceRE; + + /* + * Counter to generate unique command names + */ + + int uniqueCounter; + + /* + * Callback for external entity resolution + */ + + Tcl_Obj *externalentitycmd; + Tcl_Interp *interp; +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; + +/* This string is a backup. Value should be defined in xml package. */ +static char whitespace[] = " \t\r\n"; + +/* + * Configuration option tables + */ + +static CONST84 char *globalConfigureSwitches[] = { + "-externalentitycommand", + (char *) NULL +}; +enum globalConfigureSwitches { + TCLXML_GLOBAL_EXTERNALENTITYCOMMAND +}; + +static CONST84 char *instanceConfigureSwitches[] = { + "-final", + "-validate", + "-baseurl", + "-baseuri", + "-encoding", + "-elementstartcommand", + "-elementendcommand", + "-characterdatacommand", + "-processinginstructioncommand", + "-defaultcommand", + "-unparsedentitydeclcommand", + "-notationdeclcommand", + "-externalentitycommand", + "-unknownencodingcommand", + "-commentcommand", + "-notstandalonecommand", + "-startcdatasectioncommand", + "-endcdatasectioncommand", + "-defaultexpandinternalentities", + "-elementdeclcommand", + "-attlistdeclcommand", + "-startdoctypedeclcommand", + "-enddoctypedeclcommand", + "-paramentityparsing", + "-ignorewhitespace", + "-reportempty", + "-entitydeclcommand", /* added to avoid exception */ + "-parameterentitydeclcommand", /* added to avoid exception */ + "-doctypecommand", /* added to avoid exception */ + "-entityreferencecommand", /* added to avoid exception */ + "-xmldeclcommand", /* added to avoid exception */ + (char *) NULL + }; +enum instanceConfigureSwitches { + TCLXML_FINAL, TCLXML_VALIDATE, TCLXML_BASEURL, TCLXML_BASEURI, + TCLXML_ENCODING, + TCLXML_ELEMENTSTARTCMD, TCLXML_ELEMENTENDCMD, + TCLXML_DATACMD, TCLXML_PICMD, + TCLXML_DEFAULTCMD, + TCLXML_UNPARSEDENTITYCMD, TCLXML_NOTATIONCMD, + TCLXML_EXTERNALENTITYCMD, TCLXML_UNKNOWNENCODINGCMD, + TCLXML_COMMENTCMD, TCLXML_NOTSTANDALONECMD, + TCLXML_STARTCDATASECTIONCMD, TCLXML_ENDCDATASECTIONCMD, + TCLXML_DEFAULTEXPANDINTERNALENTITIES, + TCLXML_ELEMENTDECLCMD, TCLXML_ATTLISTDECLCMD, + TCLXML_STARTDOCTYPEDECLCMD, TCLXML_ENDDOCTYPEDECLCMD, + TCLXML_PARAMENTITYPARSING, + TCLXML_NOWHITESPACE, + TCLXML_REPORTEMPTY, + TCLXML_ENTITYDECLCMD, + TCLXML_PARAMENTITYDECLCMD, + TCLXML_DOCTYPECMD, + TCLXML_ENTITYREFCMD, + TCLXML_XMLDECLCMD +}; + +/* + * Prototypes for procedures defined later in this file: + */ + +static void TclXMLInstanceDeleteCmd _ANSI_ARGS_((ClientData clientData)); +static int TclXMLDestroyParserInstance _ANSI_ARGS_((TclXML_Info *xmlinfo)); +static int TclXMLInstanceCmd _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, int objc, struct Tcl_Obj *CONST objv[])); +static int TclXMLCreateParserCmd _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +static int TclXMLParserClassCmd _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +static int TclXMLResetParser _ANSI_ARGS_((Tcl_Interp *interp, TclXML_Info *xmlinfo)); +static int TclXMLConfigureCmd _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +static Tcl_Obj* FindUniqueCmdName _ANSI_ARGS_((Tcl_Interp *interp)); +static int TclXMLInstanceConfigure _ANSI_ARGS_((Tcl_Interp *interp, + TclXML_Info *xmlinfo, int objc, Tcl_Obj *CONST objv[])); +static int TclXMLCget _ANSI_ARGS_((Tcl_Interp *interp, + TclXML_Info *xmlinfo, int objc, Tcl_Obj *CONST objv[])); +static int TclXMLConfigureParserInstance _ANSI_ARGS_(( + TclXML_Info *xmlinfo, Tcl_Obj *option, Tcl_Obj *value)); +static int TclXMLGet _ANSI_ARGS_((Tcl_Interp *interp, + TclXML_Info *xmlinfo, int objc, Tcl_Obj *CONST objv[])); +static int TclXMLParse _ANSI_ARGS_((Tcl_Interp *interp, + TclXML_Info *xmlinfo, char *data, int len)); +static void TclXMLDispatchPCDATA _ANSI_ARGS_((TclXML_Info *xmlinfo)); + +#if (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0) + +/* + *---------------------------------------------------------------------------- + * + * Tcl_GetString -- + * + * Compatibility routine for Tcl 8.0 + * + * Results: + * String representation of object.. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------------- + */ + +static char * +Tcl_GetString (obj) + Tcl_Obj *obj; /* Object to retrieve string from. */ +{ + char *s; + int i; + + s = Tcl_GetStringFromObj(obj, &i); + return s; +} +#endif /* TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0 */ + +/* + *---------------------------------------------------------------------------- + * + * Tclxml_Init -- + * + * Initialisation routine for loadable module. + * Also calls the initialisation routines for TclDOM and TclXSLT, + * as these were originally separate modules. + * + * Results: + * None. + * + * Side effects: + * Creates commands in the interpreter, + * loads xml, dom and xslt packages. + * + *---------------------------------------------------------------------------- + */ + +int +Tclxml_Init (interp) + Tcl_Interp *interp; /* Interpreter to initialise. */ +{ + ThreadSpecificData *tsdPtr; + +#ifdef USE_TCL_STUBS + if (Tcl_InitStubs(interp, "8.1", 0) == NULL) { + return TCL_ERROR; + } +#endif + + tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + tsdPtr->initialized = 1; + tsdPtr->defaultParser = NULL; + tsdPtr->uniqueCounter = 0; + + /* + tsdPtr->whitespaceRE = Tcl_GetVar2Ex(interp, "::xml::Wsp", NULL, TCL_GLOBAL_ONLY); + if (tsdPtr->whitespaceRE == NULL) { + tsdPtr->whitespaceRE = Tcl_SetVar2Ex(interp, "::xml::Wsp", NULL, Tcl_NewStringObj(whitespace, -1), TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG); + if (tsdPtr->whitespaceRE == NULL) { + return TCL_ERROR; + } + } + Tcl_IncrRefCount(tsdPtr->whitespaceRE); + */ + + tsdPtr->registeredParsers = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable)); + Tcl_InitHashTable(tsdPtr->registeredParsers, TCL_STRING_KEYS); + + tsdPtr->externalentitycmd = NULL; + tsdPtr->interp = interp; + + Tcl_CreateObjCommand(interp, "xml::configure", TclXMLConfigureCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "xml::parser", TclXMLCreateParserCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "xml::parserclass", TclXMLParserClassCmd, NULL, NULL); + + if (Tclxml_libxml2_Init(interp) != TCL_OK) { + return TCL_ERROR; + } + + /* + if (Tcldom_libxml2_Init(interp) != TCL_OK) { + return TCL_ERROR; + } + + if (Tclxslt_libxslt_Init(interp) != TCL_OK) { + return TCL_ERROR; + } + */ + + #if TCLXML_DOES_STUBS + { + extern TclxmlStubs tclxmlStubs; + if (Tcl_PkgProvideEx(interp, "xml::c", TCLXML_VERSION, + (ClientData) &tclxmlStubs) != TCL_OK) { + return TCL_ERROR; + } + } + #else + if (Tcl_PkgProvide(interp, "xml::c", TCLXML_VERSION) != TCL_OK) { + return TCL_ERROR; + } + #endif + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * Tclxml_SafeInit -- + * + * Initialisation routine for loadable module in a safe interpreter. + * + * Results: + * None. + * + * Side effects: + * Creates commands in the interpreter, + * loads xml package. + * + *---------------------------------------------------------------------------- + */ + +int +Tclxml_SafeInit (interp) + Tcl_Interp *interp; /* Interpreter to initialise. */ +{ + return Tclxml_Init(interp); +} + +/* + *---------------------------------------------------------------------------- + * + * TclXMLConfigureCmd -- + * + * Command for xml::configure command. + * + * Results: + * Depends on method. + * + * Side effects: + * Depends on method. + * + *---------------------------------------------------------------------------- + */ + +static int +TclXMLConfigureCmd(clientData, interp, objc, objv) + ClientData clientData; + Tcl_Interp *interp; + int objc; + Tcl_Obj *CONST objv[]; +{ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + int index; + + if (objc < 3) { + Tcl_SetResult(interp, "must specify option", NULL); + return TCL_ERROR; + } else if (objc == 3) { + /* TODO: retrieve option's value */ + return TCL_OK; + } else if (objc % 2 == 1) { + Tcl_SetResult(interp, "value for option missing", NULL); + return TCL_ERROR; + } + + for (objc -= 2, objv += 2; objc; objc -= 2, objv += 2) { + if (Tcl_GetIndexFromObj(interp, objv[0], globalConfigureSwitches, + "switch", 0, &index) != TCL_OK) { + return TCL_ERROR; + } + switch ((enum globalConfigureSwitches) index) { + case TCLXML_GLOBAL_EXTERNALENTITYCOMMAND: + tsdPtr->externalentitycmd = objv[1]; + Tcl_IncrRefCount(tsdPtr->externalentitycmd); + break; + + default: + return TCL_ERROR; + } + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXMLParserClassCmd -- + * + * Command for xml::parserclass command. + * + * Results: + * Depends on method. + * + * Side effects: + * Depends on method. + * + *---------------------------------------------------------------------------- + */ + +static int +TclXMLParserClassCmd(clientData, interp, objc, objv) + ClientData clientData; + Tcl_Interp *interp; + int objc; + Tcl_Obj *CONST objv[]; +{ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + TclXML_ParserClassInfo *classinfo; + int method, index; + Tcl_Obj *listPtr; + Tcl_HashEntry *entryPtr; + Tcl_HashSearch search; + + static CONST84 char *methods[] = { + "create", "destroy", "info", + NULL + }; + enum methods { + TCLXML_CREATE, TCLXML_DESTROY, TCLXML_INFO + }; + static CONST84 char *createOptions[] = { + "-createcommand", "-createentityparsercommand", + "-parsecommand", "-configurecommand", + "-deletecommand", "-resetcommand", + NULL + }; + enum createOptions { + TCLXML_CREATEPROC, TCLXML_CREATE_ENTITY_PARSER, + TCLXML_PARSEPROC, TCLXML_CONFIGUREPROC, + TCLXML_DELETEPROC, TCLXML_RESETPROC + }; + static CONST84 char *infoMethods[] = { + "names", "default", + NULL + }; + enum infoMethods { + TCLXML_INFO_NAMES, TCLXML_INFO_DEFAULT + }; + + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "method ?args?"); + return TCL_ERROR; + } + + if (Tcl_GetIndexFromObj(interp, objv[1], methods, + "method", 0, &method) != TCL_OK) { + return TCL_ERROR; + } + + switch ((enum methods) method) { + case TCLXML_CREATE: + if (objc < 3) { + Tcl_WrongNumArgs(interp, 2, objv, "create name ?args?"); + return TCL_ERROR; + } + + classinfo = (TclXML_ParserClassInfo *) Tcl_Alloc(sizeof(TclXML_ParserClassInfo)); + classinfo->name = objv[2]; + Tcl_IncrRefCount(classinfo->name); + classinfo->create = NULL; + classinfo->createCmd = NULL; + classinfo->createEntity = NULL; + classinfo->createEntityCmd = NULL; + classinfo->parse = NULL; + classinfo->parseCmd = NULL; + classinfo->configure = NULL; + classinfo->configureCmd = NULL; + classinfo->reset = NULL; + classinfo->resetCmd = NULL; + classinfo->destroy = NULL; + classinfo->destroyCmd = NULL; + + objv += 3; + objc -= 3; + while (objc > 1) { + if (Tcl_GetIndexFromObj(interp, objv[0], createOptions, + "options", 0, &index) != TCL_OK) { + return TCL_ERROR; + } + Tcl_IncrRefCount(objv[1]); + switch ((enum createOptions) index) { + + case TCLXML_CREATEPROC: + + classinfo->createCmd = objv[1]; + break; + + case TCLXML_CREATE_ENTITY_PARSER: + + classinfo->createEntityCmd = objv[1]; + break; + + case TCLXML_PARSEPROC: + + classinfo->parseCmd = objv[1]; + break; + + case TCLXML_CONFIGUREPROC: + + classinfo->configureCmd = objv[1]; + break; + + case TCLXML_RESETPROC: + + classinfo->resetCmd = objv[1]; + break; + + case TCLXML_DELETEPROC: + + classinfo->destroyCmd = objv[1]; + break; + + default: + Tcl_AppendResult(interp, "unknown option \"", Tcl_GetStringFromObj(objv[0], NULL), "\"", NULL); + Tcl_DecrRefCount(objv[1]); + Tcl_DecrRefCount(classinfo->name); + Tcl_Free((char *)classinfo); + return TCL_ERROR; + } + + objc -= 2; + objv += 2; + + } + + if (TclXML_RegisterXMLParser(interp, classinfo) != TCL_OK) { + Tcl_Free((char *)classinfo); + return TCL_ERROR; + } + break; + + case TCLXML_DESTROY: + /* Not yet implemented */ + break; + + case TCLXML_INFO: + if (objc < 3) { + Tcl_WrongNumArgs(interp, 2, objv, "method"); + return TCL_ERROR; + } + + if (Tcl_GetIndexFromObj(interp, objv[2], infoMethods, + "method", 0, &index) != TCL_OK) { + return TCL_ERROR; + } + switch ((enum infoMethods) index) { + case TCLXML_INFO_NAMES: + + listPtr = Tcl_NewListObj(0, NULL); + entryPtr = Tcl_FirstHashEntry(tsdPtr->registeredParsers, &search); + while (entryPtr != NULL) { + Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(Tcl_GetHashKey(tsdPtr->registeredParsers, entryPtr), -1)); + entryPtr = Tcl_NextHashEntry(&search); + } + + Tcl_SetObjResult(interp, listPtr); + + break; + + case TCLXML_INFO_DEFAULT: + + if (!tsdPtr->defaultParser) { + Tcl_SetResult(interp, "", NULL); + } else { + Tcl_SetObjResult(interp, tsdPtr->defaultParser->name); + } + + break; + + default: + Tcl_SetResult(interp, "unknown method", NULL); + return TCL_ERROR; + } + break; + + default: + Tcl_SetResult(interp, "unknown method", NULL); + return TCL_ERROR; + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXML_RegisterXMLParser -- + * + * Adds a new XML parser. + * + * Results: + * Standard Tcl return code. + * + * Side effects: + * New parser is available for use in parser instances. + * + *---------------------------------------------------------------------------- + */ + +int +TclXML_RegisterXMLParser(interp, classinfo) + Tcl_Interp *interp; + TclXML_ParserClassInfo *classinfo; +{ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + int new; + Tcl_HashEntry *entryPtr; + + entryPtr = Tcl_CreateHashEntry(tsdPtr->registeredParsers, Tcl_GetStringFromObj(classinfo->name, NULL), &new); + if (!new) { + Tcl_Obj *ptr = Tcl_NewStringObj("parser class \"", -1); + Tcl_AppendObjToObj(ptr, classinfo->name); + Tcl_AppendObjToObj(ptr, Tcl_NewStringObj("\" already registered", -1)); + + Tcl_ResetResult(interp); + Tcl_SetObjResult(interp, ptr); + return TCL_ERROR; + } + + Tcl_SetHashValue(entryPtr, (ClientData) classinfo); + + /* + * Set default parser - last wins + */ + + tsdPtr->defaultParser = classinfo; + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXMLCreateParserCmd -- + * + * Creation command for xml::parser command. + * + * Results: + * The name of the newly created parser instance. + * + * Side effects: + * This creates a parser instance. + * + *---------------------------------------------------------------------------- + */ + +static int +TclXMLCreateParserCmd(clientData, interp, objc, objv) + ClientData clientData; + Tcl_Interp *interp; + int objc; + Tcl_Obj *CONST objv[]; +{ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + TclXML_Info *xmlinfo; + int found, i, index, poption; + + static CONST84 char *switches[] = { + "-parser", + (char *) NULL + }; + enum switches { + TCLXML_PARSER + }; + + if (tsdPtr == NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("TclXML package improperly initialised", -1)); + return TCL_ERROR; + } + if (!tsdPtr->defaultParser) { + Tcl_SetResult(interp, "no parsers available", NULL); + return TCL_ERROR; + } + + /* + * Create the data structures for this parser. + */ + + if (!(xmlinfo = (TclXML_Info *) Tcl_Alloc(sizeof(TclXML_Info)))) { + Tcl_SetResult(interp, "unable to create parser", NULL); + return TCL_ERROR; + } + xmlinfo->interp = interp; + xmlinfo->clientData = NULL; + xmlinfo->base = NULL; + xmlinfo->encoding = Tcl_NewStringObj("utf-8", -1); + + /* + * Find unique command name + */ + if (objc < 2) { + xmlinfo->name = FindUniqueCmdName(interp); + } else { + xmlinfo->name = objv[1]; + if (*(Tcl_GetStringFromObj(xmlinfo->name, NULL)) != '-') { + Tcl_IncrRefCount(xmlinfo->name); + objv++; + objc--; + } else { + xmlinfo->name = FindUniqueCmdName(interp); + } + } + + xmlinfo->validate = 0; + xmlinfo->elementstartcommand = NULL; + xmlinfo->elementstart = NULL; + xmlinfo->elementstartdata = 0; + xmlinfo->elementendcommand = NULL; + xmlinfo->elementend = NULL; + xmlinfo->elementenddata = 0; + xmlinfo->datacommand = NULL; + xmlinfo->cdatacb = NULL; + xmlinfo->cdatacbdata = 0; + xmlinfo->picommand = NULL; + xmlinfo->pi = NULL; + xmlinfo->pidata = 0; + xmlinfo->defaultcommand = NULL; + xmlinfo->defaultcb = NULL; + xmlinfo->defaultdata = 0; + xmlinfo->unparsedcommand = NULL; + xmlinfo->unparsed = NULL; + xmlinfo->unparseddata = 0; + xmlinfo->notationcommand = NULL; + xmlinfo->notation = NULL; + xmlinfo->notationdata = 0; + xmlinfo->entitycommand = NULL; + xmlinfo->entity = NULL; + xmlinfo->entitydata = 0; + xmlinfo->unknownencodingcommand = NULL; + xmlinfo->unknownencoding = NULL; + xmlinfo->unknownencodingdata = 0; + /* ericm@scriptics.com */ + xmlinfo->commentCommand = NULL; + xmlinfo->comment = NULL; + xmlinfo->commentdata = 0; + xmlinfo->notStandaloneCommand = NULL; + xmlinfo->notStandalone = NULL; + xmlinfo->notstandalonedata = 0; + xmlinfo->elementDeclCommand = NULL; + xmlinfo->elementDecl = NULL; + xmlinfo->elementdecldata = 0; + xmlinfo->attlistDeclCommand = NULL; + xmlinfo->attlistDecl = NULL; + xmlinfo->attlistdecldata = 0; + xmlinfo->startDoctypeDeclCommand = NULL; + xmlinfo->startDoctypeDecl = NULL; + xmlinfo->startdoctypedecldata = 0; + xmlinfo->endDoctypeDeclCommand = NULL; + xmlinfo->endDoctypeDecl = NULL; + xmlinfo->enddoctypedecldata = 0; +#ifdef TCLXML_CDATASECTIONS + xmlinfo->startCDATASectionCommand = NULL; + xmlinfo->startCDATASection = NULL; + xmlinfo->startcdatasectiondata = 0; + xmlinfo->endCdataSectionCommand = NULL; + xmlinfo->endCdataSection = NULL; + xmlinfo->endcdatasectiondata = 0; +#endif + + /* + * Options may include an explicit desired parser class + * + * SF TclXML Bug 513909 ... + * Start search at first argument! If there was a parser name + * specified we already skipped over it. + * + * Changing the search. Do not stop at the first occurence of + * "-parser". There can be more than one instance of the option in + * the argument list and it is the last instance that counts. + */ + + found = 0; + i = 1; + poption = -1; + + while (i < objc) { + Tcl_ResetResult (interp); + if (Tcl_GetIndexFromObj(interp, objv[i], switches, "option", 0, &index) == TCL_OK) { + poption = i; + found = 1; + } + i += 2; + } + Tcl_ResetResult (interp); + + if (found) { + Tcl_HashEntry *pentry; + + if (poption == (objc - 1)) { + Tcl_SetResult(interp, "no value for option", NULL); + goto error; + } + + /* + * Use given parser class + */ + + pentry = Tcl_FindHashEntry(tsdPtr->registeredParsers, + Tcl_GetStringFromObj(objv[poption + 1], + NULL)); + if (pentry != NULL) { + xmlinfo->parserClass = Tcl_GetHashValue(pentry); + } else { + Tcl_AppendResult(interp, "no such parser class \"", + Tcl_GetStringFromObj(objv[poption + 1], NULL), + "\"", NULL); + goto error; + } + + } else { + /* + * Use default parser + */ + xmlinfo->parserClass = tsdPtr->defaultParser; + } + + if (TclXMLResetParser(interp, xmlinfo) != TCL_OK) { + /* this may leak memory... + Tcl_Free((char *)xmlinfo); + */ + return TCL_ERROR; + } + + /* + * Register a Tcl command for this parser instance. + */ + + Tcl_CreateObjCommand(interp, Tcl_GetStringFromObj(xmlinfo->name, NULL), + TclXMLInstanceCmd, (ClientData) xmlinfo, TclXMLInstanceDeleteCmd); + + /* + * Handle configuration options + * + * SF TclXML Bug 513909 ... + * Note: If the caller used "-parser" to specify a parser class we + * have to take care that it and its argument are *not* seen by + * "TclXMLInstanceConfigure" because this option is not allowed + * during general configuration. + */ + + if (objc > 1) { + if (found) { + /* + * The options contained at least one instance of "-parser + * class". We now go through the whole list of arguments and + * build a new list which contains only the non-"-parser" + * switches. The 'ResetResult' takes care of clearing the + * interpreter result before "Tcl_GetIndexFromObj" tries to + * use it again. + */ + + int res; + int cfgc = 0; + Tcl_Obj** cfgv = (Tcl_Obj**) Tcl_Alloc (objc * sizeof (Tcl_Obj*)); + + i = 1; + while (i < objc) { + Tcl_ResetResult (interp); + if (Tcl_GetIndexFromObj(interp, objv[i], switches, "option", 0, &index) == TCL_OK) { + /* Ignore "-parser" during copying */ + i += 2; + continue; + } + + cfgv [cfgc] = objv [i]; i++ ; cfgc++ ; /* copy option ... */ + cfgv [cfgc] = objv [i]; i++ ; cfgc++ ; /* ... and value */ + } + Tcl_ResetResult (interp); + + res = TclXMLInstanceConfigure(interp, xmlinfo, cfgc, cfgv); + Tcl_Free ((char*) cfgv); + if (res == TCL_ERROR) { + return TCL_ERROR; + } + } else { + /* + * The options contained no "-parser class" specification. We + * can propagate it unchanged. + */ + + if (TclXMLInstanceConfigure(interp, xmlinfo, objc - 1, objv + 1) == TCL_ERROR) { + return TCL_ERROR; + } + } + } + + Tcl_SetObjResult(interp, xmlinfo->name); + return TCL_OK; + + error: +/* this may leak memory + Tcl_Free((char*)xmlinfo); +*/ + return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------------- + * + * FindUniqueCmdName -- + * + * Generate new command name in caller's namespace. + * + * Results: + * Returns newly allocated Tcl object containing name. + * + * Side effects: + * Allocates Tcl object. + * + *---------------------------------------------------------------------------- + */ + +static Tcl_Obj * +FindUniqueCmdName(interp) + Tcl_Interp *interp; +{ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + Tcl_Obj *name; + Tcl_CmdInfo cmdinfo; + char s[20]; + + name = Tcl_NewObj(); + Tcl_IncrRefCount(name); + + do { + sprintf(s, "xmlparser%d", tsdPtr->uniqueCounter++); + Tcl_SetStringObj(name, s, -1); + } while (Tcl_GetCommandInfo(interp, Tcl_GetStringFromObj(name, NULL), &cmdinfo)); + + return name; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXMLResetParser -- + * + * (Re-)Initialise the parser instance structure. + * + * Results: + * Parser made ready for parsing. + * + * Side effects: + * Destroys and creates a parser instance. + * Modifies TclXML_Info fields. + * + *---------------------------------------------------------------------------- + */ + +static int +TclXMLResetParser(interp, xmlinfo) + Tcl_Interp *interp; + TclXML_Info *xmlinfo; +{ + TclXML_ParserClassInfo *classInfo = (TclXML_ParserClassInfo *) xmlinfo->parserClass; + + if (xmlinfo->base) { + Tcl_DecrRefCount(xmlinfo->base); + xmlinfo->base = NULL; + } + + xmlinfo->final = 1; + xmlinfo->status = TCL_OK; + xmlinfo->result = NULL; + xmlinfo->continueCount = 0; + xmlinfo->context = NULL; + + xmlinfo->cdata = NULL; + xmlinfo->nowhitespace = 0; + + xmlinfo->reportempty = 0; + xmlinfo->expandinternalentities = 1; + xmlinfo->paramentities = 1; + + if (classInfo->reset) { + if ((*classInfo->reset)((ClientData) xmlinfo) != TCL_OK) { + return TCL_ERROR; + } + } else if (classInfo->resetCmd) { + Tcl_Obj *cmdPtr = Tcl_DuplicateObj(classInfo->resetCmd); + int result; + + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) interp); + Tcl_ListObjAppendElement(interp, cmdPtr, xmlinfo->name); + + result = Tcl_GlobalEvalObj(xmlinfo->interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) interp); + + if (result != TCL_OK) { + Tcl_Free((char*)xmlinfo); + return TCL_ERROR; + } + } else if (classInfo->create) { + + /* + * Otherwise destroy and then create a fresh parser instance + */ + + /* + * Destroy the old parser instance, if it exists + * Could probably just reset it, but this approach + * is pretty much guaranteed to work. + */ + + if (TclXMLDestroyParserInstance(xmlinfo) != TCL_OK) { + return TCL_ERROR; + } + + /* + * Directly invoke the create routine + */ + if ((xmlinfo->clientData = (*classInfo->create)(interp, xmlinfo)) == NULL) { + Tcl_Free((char*)xmlinfo); + return TCL_ERROR; + } + } else if (classInfo->createCmd) { + Tcl_Obj *cmdPtr = Tcl_DuplicateObj(classInfo->createCmd); + int result, i; + + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) interp); + Tcl_ListObjAppendElement(interp, cmdPtr, xmlinfo->name); + + result = Tcl_GlobalEvalObj(xmlinfo->interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) interp); + + if (result != TCL_OK) { + Tcl_Free((char*)xmlinfo); + return TCL_ERROR; + } else { + + /* + * Return result is parser instance argument + */ + + xmlinfo->clientData = (ClientData) Tcl_GetObjResult(interp); + Tcl_IncrRefCount((Tcl_Obj *) xmlinfo->clientData); + + /* + * Add all of the currently configured callbacks to the + * creation command line. Destroying the parser instance + * just clobbered all of these settings. + */ + + cmdPtr = Tcl_DuplicateObj(classInfo->configureCmd); + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) interp); + Tcl_ListObjAppendElement(interp, cmdPtr, xmlinfo->name); + + for (i = 0; instanceConfigureSwitches[i]; i++) { + Tcl_Obj *objPtr = Tcl_NewStringObj(instanceConfigureSwitches[i], -1); + Tcl_ListObjAppendElement(interp, cmdPtr, objPtr); + TclXMLCget(interp, xmlinfo, 1, &objPtr); + Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_GetObjResult(interp)); + } + + result = Tcl_GlobalEvalObj(xmlinfo->interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) interp); + + if (result != TCL_OK) { + Tcl_Free((char *)xmlinfo); + return TCL_ERROR; + } + + } + + } else { + Tcl_SetResult(interp, "bad parser class data", NULL); + Tcl_Free((char*)xmlinfo); + return TCL_ERROR; + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TclXMLCreateEntityParser -- + * + * Create an entity parser, based on the original + * parser referred to by parent. + * + * Results: + * New entity parser created and initialized. + * + * Side effects: + * The TclXML_Info struct pointed to by external is modified. + * + *---------------------------------------------------------------------- + */ + +static int +TclXMLCreateEntityParser(interp, external, parent) + Tcl_Interp *interp; + TclXML_Info *external; + TclXML_Info *parent; +{ + TclXML_ParserClassInfo *extClassInfo; + + external->parserClass = parent->parserClass; + extClassInfo = (TclXML_ParserClassInfo *) external->parserClass; + + if (!extClassInfo->createEntity || !extClassInfo->createEntityCmd) { + Tcl_SetResult(interp, "cannot create entity parser", NULL); + return TCL_ERROR; + } + + if (parent->elementstartcommand) { + Tcl_IncrRefCount(parent->elementstartcommand); + } + if (parent->elementendcommand) { + Tcl_IncrRefCount(parent->elementendcommand); + } + if (parent->datacommand) { + Tcl_IncrRefCount(parent->datacommand); + } + if (parent->picommand) { + Tcl_IncrRefCount(parent->picommand); + } + if (parent->defaultcommand) { + Tcl_IncrRefCount(parent->defaultcommand); + } + if (parent->unparsedcommand) { + Tcl_IncrRefCount(parent->unparsedcommand); + } + if (parent->notationcommand) { + Tcl_IncrRefCount(parent->notationcommand); + } + if (parent->entitycommand) { + Tcl_IncrRefCount(parent->entitycommand); + } + if (parent->unknownencodingcommand) { + Tcl_IncrRefCount(parent->unknownencodingcommand); + } + if (parent->commentCommand) { + Tcl_IncrRefCount(parent->commentCommand); + } + if (parent->notStandaloneCommand) { + Tcl_IncrRefCount(parent->notStandaloneCommand); + } +#ifdef TCLXML_CDATASECTIONS + if (parent->startCdataSectionCommand) { + Tcl_IncrRefCount(parent->startCdataSectionCommand); + } + if (parent->endCdataSectionCommand) { + Tcl_IncrRefCount(parent->endCdataSectionCommand); + } +#endif + if (parent->elementDeclCommand) { + Tcl_IncrRefCount(parent->elementDeclCommand); + } + if (parent->attlistDeclCommand) { + Tcl_IncrRefCount(parent->attlistDeclCommand); + } + if (parent->startDoctypeDeclCommand) { + Tcl_IncrRefCount(parent->startDoctypeDeclCommand); + } + if (parent->endDoctypeDeclCommand) { + Tcl_IncrRefCount(parent->endDoctypeDeclCommand); + } + + external->elementstartcommand = parent->elementstartcommand; + external->elementstart = parent->elementstart; + external->elementendcommand = parent->elementendcommand; + external->elementend = parent->elementend; + external->datacommand = parent->datacommand; + external->cdatacb = parent->cdatacb; + external->picommand = parent->picommand; + external->pi = parent->pi; + external->defaultcommand = parent->defaultcommand; + external->defaultcb = parent->defaultcb; + external->unparsedcommand = parent->unparsedcommand; + external->unparsed = parent->unparsed; + external->notationcommand = parent->notationcommand; + external->notation = parent->notation; + external->entitycommand = parent->entitycommand; + external->entity = parent->entity; + external->unknownencodingcommand = parent->unknownencodingcommand; + external->unknownencoding = parent->unknownencoding; + external->commentCommand = parent->commentCommand; + external->comment = parent->comment; + external->notStandaloneCommand = parent->notStandaloneCommand; + external->notStandalone = parent->notStandalone; + external->elementDeclCommand = parent->elementDeclCommand; + external->elementDecl = parent->elementDecl; + external->attlistDeclCommand = parent->attlistDeclCommand; + external->attlistDecl = parent->attlistDecl; + external->startDoctypeDeclCommand = parent->startDoctypeDeclCommand; + external->startDoctypeDecl = parent->startDoctypeDecl; + external->endDoctypeDeclCommand = parent->endDoctypeDeclCommand; + external->endDoctypeDecl = parent->endDoctypeDecl; +#ifdef TCLXML_CDATASECTIONS + external->startCdataSectionCommand = parent->startCdataSectionCommand; + external->startCdataSection = parent->startCdataSection; + external->endCdataSectionCommand = parent->endCdataSectionCommand; + external->endCdataSection = parent->endCdataSection; +#endif + + external->final = 1; + external->validate = parent->validate; + external->status = TCL_OK; + external->result = NULL; + external->continueCount = 0; + external->context = NULL; + external->cdata = NULL; + external->nowhitespace = parent->nowhitespace; + if (parent->encoding) { + external->encoding = Tcl_DuplicateObj(parent->encoding); + } else { + external->encoding = Tcl_NewStringObj("utf-8", -1); + } + + if (extClassInfo->createEntity) { + /* + * Directly invoke the create routine + */ + if ((external->clientData = (*extClassInfo->createEntity)(interp, (ClientData) external)) == NULL) { + Tcl_Free((char*)external); + return TCL_ERROR; + } + } else if (extClassInfo->createEntityCmd) { + int result; + + result = Tcl_GlobalEvalObj(interp, extClassInfo->createEntityCmd); + if (result != TCL_OK) { + Tcl_Free((char*)external); + return TCL_ERROR; + } else { + + /* + * Return result is parser instance argument + */ + + external->clientData = (ClientData) Tcl_GetObjResult(interp); + Tcl_IncrRefCount((Tcl_Obj *) external->clientData); + + } + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXMLDestroyParserInstance -- + * + * Destroys the parser instance. + * + * Results: + * None. + * + * Side effects: + * Depends on class destroy proc. + * + *---------------------------------------------------------------------------- + */ + +static int +TclXMLDestroyParserInstance(xmlinfo) + TclXML_Info *xmlinfo; +{ + TclXML_ParserClassInfo *classInfo = (TclXML_ParserClassInfo *) xmlinfo->parserClass; + + if (xmlinfo->clientData) { + if (classInfo->destroy) { + if ((*classInfo->destroy)(xmlinfo->clientData) != TCL_OK) { + if (xmlinfo->encoding) { + Tcl_DecrRefCount(xmlinfo->encoding); + } + Tcl_Free((char *)xmlinfo); + return TCL_ERROR; + } + } else if (classInfo->destroyCmd) { + Tcl_Obj *cmdPtr = Tcl_DuplicateObj(classInfo->destroyCmd); + int result; + + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) xmlinfo->interp); + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, (Tcl_Obj *) xmlinfo->clientData); + + result = Tcl_GlobalEvalObj(xmlinfo->interp, cmdPtr); + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) xmlinfo->interp); + + if (result != TCL_OK) { + if (xmlinfo->encoding) { + Tcl_DecrRefCount(xmlinfo->encoding); + } + Tcl_Free((char *)xmlinfo); + return TCL_ERROR; + } + + Tcl_DecrRefCount((Tcl_Obj *) xmlinfo->clientData); + + } + + xmlinfo->clientData = NULL; + + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXMLFreeParser -- + * + * Destroy the parser instance structure. + * + * Results: + * None. + * + * Side effects: + * Frees any memory allocated for the XML parser instance. + * + *---------------------------------------------------------------------------- + */ + +static void +TclXMLFreeParser(xmlinfo) + TclXML_Info *xmlinfo; +{ + if (TclXMLDestroyParserInstance(xmlinfo) == TCL_OK) { + if (xmlinfo->encoding) { + Tcl_DecrRefCount(xmlinfo->encoding); + } + Tcl_Free((char*)xmlinfo); + } +} + +/* + *---------------------------------------------------------------------------- + * + * TclXMLInstanceCmd -- + * + * Implements instance command for XML parsers. + * + * Results: + * Depends on the method. + * + * Side effects: + * Depends on the method. + * + *---------------------------------------------------------------------------- + */ + +static int +TclXMLInstanceCmd (clientData, interp, objc, objv) + ClientData clientData; + Tcl_Interp *interp; + int objc; + Tcl_Obj *CONST objv[]; +{ + TclXML_Info *xmlinfo = (TclXML_Info *) clientData; + TclXML_Info *child; + char *encoding, *data; + int len, index, result = TCL_OK; + Tcl_Obj *childNamePtr; + static CONST84 char *options[] = { + "configure", "cget", "entityparser", "free", "get", "parse", "reset", NULL + }; + enum options { + TCLXML_CONFIGURE, TCLXML_CGET, TCLXML_ENTITYPARSER, TCLXML_FREE, TCLXML_GET, + TCLXML_PARSE, TCLXML_RESET + }; + + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "method ?args?"); + return TCL_ERROR; + } + + if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, + &index) != TCL_OK) { + return TCL_ERROR; + } + + switch ((enum options) index) { + case TCLXML_CONFIGURE: + + result = TclXMLInstanceConfigure(interp, xmlinfo, objc - 2, objv + 2); + break; + + case TCLXML_CGET: + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "cget option"); + return TCL_ERROR; + } + + result = TclXMLCget(interp, xmlinfo, objc - 2, objv + 2); + break; + + case TCLXML_ENTITYPARSER: + /* ericm@scriptics.com, 1999.9.13 */ + + /* check for args - Pat Thoyts */ + if (objc == 2) { + childNamePtr = FindUniqueCmdName(interp); + } else if (objc == 3) { + childNamePtr = objv[2]; + } else { + Tcl_WrongNumArgs(interp, 1, objv, "entityparser ?args?"); + return TCL_ERROR; + } + + /* + * Create the data structures for this parser. + */ + if (!(child = (TclXML_Info *) Tcl_Alloc(sizeof(TclXML_Info)))) { + Tcl_Free((char*)child); + Tcl_SetResult(interp, "unable to create parser", NULL); + return TCL_ERROR; + } + + child->interp = interp; + Tcl_IncrRefCount(childNamePtr); + child->name = childNamePtr; + + /* Actually create the parser instance */ + if (TclXMLCreateEntityParser(interp, child, + xmlinfo) != TCL_OK) { + Tcl_DecrRefCount(childNamePtr); + Tcl_Free((char*)child); + return TCL_ERROR; + } + + /* Register a Tcl command for this parser instance */ + Tcl_CreateObjCommand(interp, Tcl_GetString(child->name), + TclXMLInstanceCmd, (ClientData) child, TclXMLInstanceDeleteCmd); + + Tcl_SetObjResult(interp, child->name); + result = TCL_OK; + break; + + case TCLXML_FREE: + + /* ericm@scriptics.com, 1999.9.13 */ + Tcl_DeleteCommand(interp, Tcl_GetString(xmlinfo->name)); + result = TCL_OK; + break; + + case TCLXML_GET: + + /* ericm@scriptics.com, 1999.6.28 */ + result = TclXMLGet(interp, xmlinfo, objc - 2, objv + 2); + break; + + case TCLXML_PARSE: + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "data"); + return TCL_ERROR; + } + + if (xmlinfo->encoding) { + encoding = Tcl_GetStringFromObj(xmlinfo->encoding, NULL); + } else { + encoding = "utf-8"; + } + if (strlen(encoding) == 0 || strcmp(encoding, "utf-8") == 0) { + data = Tcl_GetStringFromObj(objv[2], &len); + } else { + data = (char *) Tcl_GetByteArrayFromObj(objv[2], &len); + } + + result = TclXMLParse(interp, xmlinfo, data, len); + + break; + + case TCLXML_RESET: + + if (objc > 2) { + Tcl_WrongNumArgs(interp, 1, objv, ""); + return TCL_ERROR; + } + + TclXMLResetParser(interp, xmlinfo); + break; + + default: + + Tcl_SetResult(interp, "unknown method", NULL); + return TCL_ERROR; + } + + return result; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXMLParse -- + * + * Invoke parser class' parse proc and check return result. + * + * Results: + * TCL_OK if no errors, TCL_ERROR otherwise. + * + * Side effects: + * Sets interpreter result as appropriate. + * + *---------------------------------------------------------------------------- + */ + +static int +TclXMLParse (interp, xmlinfo, data, len) + Tcl_Interp *interp; + TclXML_Info *xmlinfo; + char *data; + int len; +{ + int result; + TclXML_ParserClassInfo *classInfo = (TclXML_ParserClassInfo *) xmlinfo->parserClass; + + xmlinfo->status = TCL_OK; + if (xmlinfo->result != NULL) { + Tcl_DecrRefCount(xmlinfo->result); + } + xmlinfo->result = NULL; + + if (classInfo->parse) { + if ((*classInfo->parse)(xmlinfo->clientData, data, len, xmlinfo->final) != TCL_OK) { + return TCL_ERROR; + } + } else if (classInfo->parseCmd) { + Tcl_Obj *cmdPtr = Tcl_DuplicateObj(classInfo->parseCmd); + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) xmlinfo->interp); + + if (xmlinfo->clientData) { + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, (Tcl_Obj *) xmlinfo->clientData); + } else if (xmlinfo->name) { + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, xmlinfo->name); + } + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, Tcl_NewStringObj(data, len)); + + result = Tcl_GlobalEvalObj(xmlinfo->interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) xmlinfo->interp); + + if (result != TCL_OK) { + return TCL_ERROR; + } + + } else { + Tcl_SetResult(interp, "XML parser cannot parse", NULL); + return TCL_ERROR; + } + + switch (xmlinfo->status) { + case TCL_OK: + case TCL_BREAK: + case TCL_CONTINUE: + TclXMLDispatchPCDATA(xmlinfo); + Tcl_ResetResult(interp); + return TCL_OK; + + case TCL_ERROR: + Tcl_SetObjResult(interp, xmlinfo->result); + return TCL_ERROR; + + default: + /* + * Propagate application-specific error condition. + * Patch by Marshall Rose + */ + Tcl_SetObjResult(interp, xmlinfo->result); + return xmlinfo->status; + } +} + +/* + *---------------------------------------------------------------------------- + * + * TclXMLInstanceConfigure -- + * + * Configures a XML parser instance. + * + * Results: + * Depends on the method. + * + * Side effects: + * Depends on the method. + * + *---------------------------------------------------------------------------- + */ + +static int +TclXMLInstanceConfigure (interp, xmlinfo, objc, objv) + Tcl_Interp *interp; + TclXML_Info *xmlinfo; + int objc; + Tcl_Obj *CONST objv[]; +{ + int index, bool, doParse = 0, result; + TclXML_ParserClassInfo *classinfo = (TclXML_ParserClassInfo *) xmlinfo->parserClass; + + while (objc > 1) { + /* + * Firstly, pass the option to the parser's own + * configuration management routine. + * It may pass back an error or break code to + * stop us from further processing the options. + */ + + if (classinfo->configure) { + result = (*classinfo->configure)(xmlinfo->clientData, objv[0], objv[1]); + if (result == TCL_BREAK) { + objc -= 2; + objv += 2; + continue; + } + if (result != TCL_OK) { + return TCL_ERROR; + } + } else if (classinfo->configureCmd) { + Tcl_Obj *cmdPtr = Tcl_DuplicateObj(classinfo->configureCmd); + + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) interp); + + if (xmlinfo->clientData) { + Tcl_ListObjAppendElement(interp, cmdPtr, (Tcl_Obj *) xmlinfo->clientData); + } else if (xmlinfo->name) { + Tcl_ListObjAppendElement(interp, cmdPtr, xmlinfo->name); + } + + Tcl_ListObjAppendElement(interp, cmdPtr, objv[0]); + Tcl_ListObjAppendElement(interp, cmdPtr, objv[1]); + + result = Tcl_GlobalEvalObj(interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) interp); + + if (result == TCL_BREAK) { + objc -= 2; + objv += 2; + continue; + } else if (result != TCL_OK) { + return TCL_ERROR; + } + } + + Tcl_ResetResult (interp); + + if (Tcl_GetIndexFromObj(interp, objv[0], instanceConfigureSwitches, + "switch", 0, &index) != TCL_OK) { + return TCL_ERROR; + } + switch ((enum instanceConfigureSwitches) index) { + case TCLXML_FINAL: /* -final */ + + if (Tcl_GetBooleanFromObj(interp, objv[1], &bool) != TCL_OK) { + return TCL_ERROR; + } + + if (bool && !xmlinfo->final) { + doParse = 1; + + } else if (!bool && xmlinfo->final) { + /* + * Reset the parser for new input + */ + + TclXMLResetParser(interp, xmlinfo); + doParse = 0; + } + xmlinfo->final = bool; + break; + + case TCLXML_ENCODING: /* -encoding */ + if (xmlinfo->encoding) { + Tcl_DecrRefCount(xmlinfo->encoding); + } + xmlinfo->encoding = objv[1]; + Tcl_IncrRefCount(xmlinfo->encoding); + break; + + case TCLXML_VALIDATE: /* -validate */ + if (Tcl_GetBooleanFromObj(interp, objv[1], &bool) != TCL_OK) { + return TCL_ERROR; + } + /* + * If the parser is in the middle of parsing a document, + * this will be ignored. Perhaps an error should be returned? + */ + xmlinfo->validate = bool; + break; + + case TCLXML_BASEURL: /* -baseurl, -baseuri */ + case TCLXML_BASEURI: + if (xmlinfo->base != NULL) { + Tcl_DecrRefCount(xmlinfo->base); + } + + xmlinfo->base = objv[1]; + Tcl_IncrRefCount(xmlinfo->base); + break; + + case TCLXML_DEFAULTEXPANDINTERNALENTITIES: /* -defaultexpandinternalentities */ + /* ericm@scriptics */ + if (Tcl_GetBooleanFromObj(interp, objv[1], &bool) != TCL_OK) { + return TCL_ERROR; + } + xmlinfo->expandinternalentities = bool; + break; + + case TCLXML_PARAMENTITYPARSING: + /* ericm@scriptics */ + case TCLXML_NOWHITESPACE: + case TCLXML_REPORTEMPTY: + /* + * All of these get passed through to the instance's + * configure procedure. + */ + + if (TclXMLConfigureParserInstance(xmlinfo, objv[0], objv[1]) != TCL_OK) { + return TCL_ERROR; + } + break; + + case TCLXML_ELEMENTSTARTCMD: /* -elementstartcommand */ + + if (xmlinfo->elementstartcommand != NULL) { + Tcl_DecrRefCount(xmlinfo->elementstartcommand); + } + xmlinfo->elementstart = NULL; + + xmlinfo->elementstartcommand = objv[1]; + Tcl_IncrRefCount(xmlinfo->elementstartcommand); + break; + + case TCLXML_ELEMENTENDCMD: /* -elementendcommand */ + + if (xmlinfo->elementendcommand != NULL) { + Tcl_DecrRefCount(xmlinfo->elementendcommand); + } + xmlinfo->elementend = NULL; + + xmlinfo->elementendcommand = objv[1]; + Tcl_IncrRefCount(xmlinfo->elementendcommand); + break; + + case TCLXML_DATACMD: /* -characterdatacommand */ + + if (xmlinfo->datacommand != NULL) { + Tcl_DecrRefCount(xmlinfo->datacommand); + } + xmlinfo->cdatacb = NULL; + + xmlinfo->datacommand = objv[1]; + Tcl_IncrRefCount(xmlinfo->datacommand); + break; + + case TCLXML_PICMD: /* -processinginstructioncommand */ + + if (xmlinfo->picommand != NULL) { + Tcl_DecrRefCount(xmlinfo->picommand); + } + xmlinfo->pi = NULL; + + xmlinfo->picommand = objv[1]; + Tcl_IncrRefCount(xmlinfo->picommand); + break; + + case TCLXML_DEFAULTCMD: /* -defaultcommand */ + + if (xmlinfo->defaultcommand != NULL) { + Tcl_DecrRefCount(xmlinfo->defaultcommand); + } + xmlinfo->defaultcb = NULL; + + xmlinfo->defaultcommand = objv[1]; + Tcl_IncrRefCount(xmlinfo->defaultcommand); + break; + + case TCLXML_UNPARSEDENTITYCMD: /* -unparsedentitydeclcommand */ + + if (xmlinfo->unparsedcommand != NULL) { + Tcl_DecrRefCount(xmlinfo->unparsedcommand); + } + xmlinfo->unparsed = NULL; + + xmlinfo->unparsedcommand = objv[1]; + Tcl_IncrRefCount(xmlinfo->unparsedcommand); + break; + + case TCLXML_NOTATIONCMD: /* -notationdeclcommand */ + + if (xmlinfo->notationcommand != NULL) { + Tcl_DecrRefCount(xmlinfo->notationcommand); + } + xmlinfo->notation = NULL; + + xmlinfo->notationcommand = objv[1]; + Tcl_IncrRefCount(xmlinfo->notationcommand); + break; + + case TCLXML_EXTERNALENTITYCMD: /* -externalentitycommand */ + + if (xmlinfo->entitycommand != NULL) { + Tcl_DecrRefCount(xmlinfo->entitycommand); + } + xmlinfo->entity = NULL; + + xmlinfo->entitycommand = objv[1]; + Tcl_IncrRefCount(xmlinfo->entitycommand); + break; + + case TCLXML_UNKNOWNENCODINGCMD: /* -unknownencodingcommand */ + + /* Not implemented */ + break; + + if (xmlinfo->unknownencodingcommand != NULL) { + Tcl_DecrRefCount(xmlinfo->unknownencodingcommand); + } + xmlinfo->unknownencoding = NULL; + + xmlinfo->unknownencodingcommand = objv[1]; + Tcl_IncrRefCount(xmlinfo->unknownencodingcommand); + break; + + case TCLXML_COMMENTCMD: /* -commentcommand */ + /* ericm@scriptics.com */ + if (xmlinfo->commentCommand != NULL) { + Tcl_DecrRefCount(xmlinfo->commentCommand); + } + xmlinfo->comment = NULL; + + xmlinfo->commentCommand = objv[1]; + Tcl_IncrRefCount(xmlinfo->commentCommand); + break; + + case TCLXML_NOTSTANDALONECMD: /* -notstandalonecommand */ + /* ericm@scriptics.com */ + if (xmlinfo->notStandaloneCommand != NULL) { + Tcl_DecrRefCount(xmlinfo->notStandaloneCommand); + } + xmlinfo->notStandalone = NULL; + + xmlinfo->notStandaloneCommand = objv[1]; + Tcl_IncrRefCount(xmlinfo->notStandaloneCommand); + break; + +#ifdef TCLXML_CDATASECTIONS + case TCLXML_STARTCDATASECTIONCMD: /* -startcdatasectioncommand */ + /* ericm@scriptics */ + if (xmlinfo->startCdataSectionCommand != NULL) { + Tcl_DecrRefCount(xmlinfo->startCdataSectionCommand); + } + xmlinfo->startCDATASection = NULL; + + xmlinfo->startCdataSectionCommand = objv[1]; + Tcl_IncrRefCount(xmlinfo->startCdataSectionCommand); + break; + + case TCLXML_ENDCDATASECTIONCMD: /* -endcdatasectioncommand */ + /* ericm@scriptics */ + if (xmlinfo->endCdataSectionCommand != NULL) { + Tcl_DecrRefCount(xmlinfo->endCdataSectionCommand); + } + xmlinfo->endCDATASection = NULL; + + xmlinfo->endCdataSectionCommand = objv[1]; + Tcl_IncrRefCount(xmlinfo->endCdataSectionCommand); + break; +#endif + + case TCLXML_ELEMENTDECLCMD: /* -elementdeclcommand */ + /* ericm@scriptics.com */ + if (xmlinfo->elementDeclCommand != NULL) { + Tcl_DecrRefCount(xmlinfo->elementDeclCommand); + } + xmlinfo->elementDecl = NULL; + + xmlinfo->elementDeclCommand = objv[1]; + Tcl_IncrRefCount(xmlinfo->elementDeclCommand); + break; + + case TCLXML_ATTLISTDECLCMD: /* -attlistdeclcommand */ + /* ericm@scriptics.com */ + if (xmlinfo->attlistDeclCommand != NULL) { + Tcl_DecrRefCount(xmlinfo->attlistDeclCommand); + } + xmlinfo->attlistDecl = NULL; + + xmlinfo->attlistDeclCommand = objv[1]; + Tcl_IncrRefCount(xmlinfo->attlistDeclCommand); + break; + + case TCLXML_STARTDOCTYPEDECLCMD: /* -startdoctypedeclcommand */ + /* ericm@scriptics.com */ + if (xmlinfo->startDoctypeDeclCommand != NULL) { + Tcl_DecrRefCount(xmlinfo->startDoctypeDeclCommand); + } + xmlinfo->startDoctypeDecl = NULL; + + xmlinfo->startDoctypeDeclCommand = objv[1]; + Tcl_IncrRefCount(xmlinfo->startDoctypeDeclCommand); + break; + + case TCLXML_ENDDOCTYPEDECLCMD: /* -enddoctypedeclcommand */ + /* ericm@scriptics.com */ + if (xmlinfo->endDoctypeDeclCommand != NULL) { + Tcl_DecrRefCount(xmlinfo->endDoctypeDeclCommand); + } + xmlinfo->endDoctypeDecl = NULL; + + xmlinfo->endDoctypeDeclCommand = objv[1]; + Tcl_IncrRefCount(xmlinfo->endDoctypeDeclCommand); + break; + + case TCLXML_ENTITYDECLCMD: /* -entitydeclcommand */ + case TCLXML_PARAMENTITYDECLCMD: /* -parameterentitydeclcommand */ + case TCLXML_DOCTYPECMD: /* -doctypecommand */ + case TCLXML_ENTITYREFCMD: /* -entityreferencecommand */ + case TCLXML_XMLDECLCMD: /* -xmldeclcommand */ + /* commands used by tcldom, but not here yet */ + break; + + default: + return TCL_ERROR; + break; + } + + objv += 2; + objc -= 2; + + } + + if (doParse) { + return TclXMLParse(interp, xmlinfo, "", 0); + } else { + return TCL_OK; + } + +} + +/* + *---------------------------------------------------------------------------- + * + * TclXMLCget -- + * + * Returns setting of configuration option. + * + * Results: + * Option value. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------------- + */ + +static int +TclXMLCget (interp, xmlinfo, objc, objv) + Tcl_Interp *interp; + TclXML_Info *xmlinfo; + int objc; + Tcl_Obj *CONST objv[]; +{ + int index; + + if (Tcl_GetIndexFromObj(interp, objv[0], instanceConfigureSwitches, "switch", 0, &index) != TCL_OK) { + return TCL_ERROR; + } + + Tcl_SetObjResult(interp, Tcl_NewObj()); + + switch ((enum instanceConfigureSwitches) index) { + case TCLXML_FINAL: + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(xmlinfo->final)); + break; + case TCLXML_VALIDATE: + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(xmlinfo->validate)); + break; + case TCLXML_DEFAULTEXPANDINTERNALENTITIES: + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(xmlinfo->expandinternalentities)); + break; + case TCLXML_REPORTEMPTY: + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(xmlinfo->reportempty)); + break; + case TCLXML_PARAMENTITYPARSING: + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(xmlinfo->paramentities)); + break; + case TCLXML_NOWHITESPACE: + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(xmlinfo->nowhitespace)); + break; + case TCLXML_BASEURL: + case TCLXML_BASEURI: + if (xmlinfo->base) { + Tcl_SetObjResult(interp, xmlinfo->base); + } + break; + case TCLXML_ENCODING: + if (xmlinfo->encoding) { + Tcl_SetObjResult(interp, xmlinfo->encoding); + } + break; + case TCLXML_ELEMENTSTARTCMD: + if (xmlinfo->elementstartcommand) { + Tcl_SetObjResult(interp, xmlinfo->elementstartcommand); + } + break; + case TCLXML_ELEMENTENDCMD: + if (xmlinfo->elementendcommand) { + Tcl_SetObjResult(interp, xmlinfo->elementendcommand); + } + break; + case TCLXML_DATACMD: + if (xmlinfo->datacommand) { + Tcl_SetObjResult(interp, xmlinfo->datacommand); + } + break; + case TCLXML_PICMD: + if (xmlinfo->picommand) { + Tcl_SetObjResult(interp, xmlinfo->picommand); + } + break; + case TCLXML_DEFAULTCMD: + if (xmlinfo->defaultcommand) { + Tcl_SetObjResult(interp, xmlinfo->defaultcommand); + } + break; + case TCLXML_UNPARSEDENTITYCMD: + if (xmlinfo->unparsedcommand) { + Tcl_SetObjResult(interp, xmlinfo->unparsedcommand); + } + break; + case TCLXML_NOTATIONCMD: + if (xmlinfo->notationcommand) { + Tcl_SetObjResult(interp, xmlinfo->notationcommand); + } + break; + case TCLXML_EXTERNALENTITYCMD: + if (xmlinfo->entitycommand) { + Tcl_SetObjResult(interp, xmlinfo->entitycommand); + } + break; + case TCLXML_UNKNOWNENCODINGCMD: + if (xmlinfo->unknownencodingcommand) { + Tcl_SetObjResult(interp, xmlinfo->unknownencodingcommand); + } + break; + case TCLXML_COMMENTCMD: + if (xmlinfo->commentCommand) { + Tcl_SetObjResult(interp, xmlinfo->commentCommand); + } + break; + case TCLXML_NOTSTANDALONECMD: + if (xmlinfo->notStandaloneCommand) { + Tcl_SetObjResult(interp, xmlinfo->notStandaloneCommand); + } + break; +#ifdef TCLXML_CDATASECTIONS + case TCLXML_STARTCDATASECTIONCMD: + if (xmlinfo->startCdataSectionCommand) { + Tcl_SetObjResult(interp, xmlinfo->startCdataSectionCommand); + } + break; + case TCLXML_ENDCDATASECTIONCMD: + if (xmlinfo->endCdataSectionCommand) { + Tcl_SetObjResult(interp, xmlinfo->endCdataSectionCommand); + } + break; +#else + case TCLXML_STARTCDATASECTIONCMD: + case TCLXML_ENDCDATASECTIONCMD: + break; +#endif + case TCLXML_ELEMENTDECLCMD: + if (xmlinfo->elementDeclCommand) { + Tcl_SetObjResult(interp, xmlinfo->elementDeclCommand); + } + break; + case TCLXML_ATTLISTDECLCMD: + if (xmlinfo->attlistDeclCommand) { + Tcl_SetObjResult(interp, xmlinfo->attlistDeclCommand); + } + break; + case TCLXML_STARTDOCTYPEDECLCMD: + if (xmlinfo->startDoctypeDeclCommand) { + Tcl_SetObjResult(interp, xmlinfo->startDoctypeDeclCommand); + } + break; + case TCLXML_ENDDOCTYPEDECLCMD: + if (xmlinfo->endDoctypeDeclCommand) { + Tcl_SetObjResult(interp, xmlinfo->endDoctypeDeclCommand); + } + break; + + case TCLXML_ENTITYDECLCMD: + case TCLXML_PARAMENTITYDECLCMD: + case TCLXML_DOCTYPECMD: + case TCLXML_ENTITYREFCMD: + case TCLXML_XMLDECLCMD: + /* These are not (yet) supported) */ + break; + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXMLConfigureParserInstance -- + * + * Set an option in a parser instance. + * + * Results: + * Standard Tcl result. + * + * Side effects: + * Depends on parser class. + * + *---------------------------------------------------------------------------- + */ + +static int +TclXMLConfigureParserInstance (xmlinfo, option, value) + TclXML_Info *xmlinfo; + Tcl_Obj *option; + Tcl_Obj *value; +{ + TclXML_ParserClassInfo *classInfo = (TclXML_ParserClassInfo *) xmlinfo->parserClass; + + if (classInfo->configure) { + if ((*classInfo->configure)(xmlinfo->clientData, option, value) != TCL_OK) { + return TCL_ERROR; + } + } else if (classInfo->configureCmd) { + Tcl_Obj *cmdPtr = Tcl_DuplicateObj(classInfo->configureCmd); + int result; + + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) xmlinfo->interp); + + /* SF Bug 514045. + */ + + if (xmlinfo->clientData) { + Tcl_ListObjAppendElement(NULL, cmdPtr, (Tcl_Obj *) xmlinfo->clientData); + } else if (xmlinfo->name) { + Tcl_ListObjAppendElement(NULL, cmdPtr, xmlinfo->name); + } + + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, option); + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, value); + + result = Tcl_GlobalEvalObj(xmlinfo->interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) xmlinfo->interp); + + if (result != TCL_OK) { + return TCL_ERROR; + } + } else { + Tcl_SetResult(xmlinfo->interp, "no configure procedure for parser", NULL); + return TCL_ERROR; + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXMLGet -- + * + * Returns runtime parser information, depending on option + * ericm@scriptics.com, 1999.6.28 + * + * Results: + * Option value. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------------- + */ + +static int +TclXMLGet (interp, xmlinfo, objc, objv) + Tcl_Interp *interp; + TclXML_Info *xmlinfo; + int objc; + Tcl_Obj *CONST objv[]; +{ + TclXML_ParserClassInfo *classInfo = (TclXML_ParserClassInfo *) xmlinfo->parserClass; + + if (classInfo->get) { + return (*classInfo->get)(xmlinfo->clientData, objc, objv); + } else if (classInfo->getCmd) { + Tcl_Obj *cmdPtr = Tcl_DuplicateObj(classInfo->getCmd); + int i, result; + + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) xmlinfo->interp); + + for (i = 0; i < objc; i++) { + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, objv[i]); + } + + result = Tcl_GlobalEvalObj(xmlinfo->interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) xmlinfo->interp); + + return result; + } else { + Tcl_SetResult(interp, "parser has no get procedure", NULL); + return TCL_ERROR; + } +} + +/* + *---------------------------------------------------------------------------- + * + * TclXMLHandlerResult -- + * + * Manage the result of the application callback. + * + * Results: + * None. + * + * Side Effects: + * Further invocation of callback scripts may be inhibited. + * + *---------------------------------------------------------------------------- + */ + +static void +TclXMLHandlerResult(xmlinfo, result) + TclXML_Info *xmlinfo; + int result; +{ + switch (result) { + case TCL_OK: + xmlinfo->status = TCL_OK; + break; + + case TCL_CONTINUE: + /* + * Skip callbacks until the matching end element event + * occurs for the currently open element. + * Keep a reference count to handle nested + * elements. + */ + xmlinfo->status = TCL_CONTINUE; + xmlinfo->continueCount = 0; + break; + + case TCL_BREAK: + /* + * Skip all further callbacks, but return OK. + */ + xmlinfo->status = TCL_BREAK; + break; + + case TCL_ERROR: + default: + /* + * Skip all further callbacks, and return error. + */ + xmlinfo->status = TCL_ERROR; + xmlinfo->result = Tcl_GetObjResult(xmlinfo->interp); + Tcl_IncrRefCount(xmlinfo->result); + break; + } +} + +/* + *---------------------------------------------------------------------------- + * + * TclXML_ElementStartHandler -- + * + * Called by parser instance for each start tag. + * + * Results: + * None. + * + * Side Effects: + * Callback script is invoked. + * + *---------------------------------------------------------------------------- + */ + +void +TclXML_ElementStartHandler(userData, name, nsuri, atts, nsDecls) + void *userData; + Tcl_Obj *name; + Tcl_Obj *nsuri; + Tcl_Obj *atts; + Tcl_Obj *nsDecls; +{ + TclXML_Info *xmlinfo = (TclXML_Info *) userData; + int result = TCL_OK; + + TclXMLDispatchPCDATA(xmlinfo); + + if (xmlinfo->status == TCL_CONTINUE) { + + /* + * We're currently skipping elements looking for the + * close of the continued element. + */ + + xmlinfo->continueCount++; + return; + } + + if ((xmlinfo->elementstartcommand == NULL && + xmlinfo->elementstart == NULL) || + xmlinfo->status != TCL_OK) { + return; + } + + if (xmlinfo->elementstart) { + result = (xmlinfo->elementstart)(xmlinfo->interp, xmlinfo->elementstartdata, name, nsuri, atts, nsDecls); + } else if (xmlinfo->elementstartcommand) { + Tcl_Obj *cmdPtr; + + /* + * Take a copy of the callback script so that arguments may be appended. + */ + + cmdPtr = Tcl_DuplicateObj(xmlinfo->elementstartcommand); + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) xmlinfo->interp); + + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, name); + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, atts); + if (nsuri) { + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, Tcl_NewStringObj("-namespace", -1)); + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, nsuri); + } + if (nsDecls) { + int len; + if ((Tcl_ListObjLength(xmlinfo->interp, nsDecls, &len) == TCL_OK) && (len > 0)) { + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, Tcl_NewStringObj("-namespacedecls", -1)); + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, nsDecls); + } + } + + /* + * It would be desirable to be able to terminate parsing + * if the return result is TCL_ERROR or TCL_BREAK. + */ + + result = Tcl_GlobalEvalObj(xmlinfo->interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) xmlinfo->interp); + } + + TclXMLHandlerResult(xmlinfo, result); +} + +/* + *---------------------------------------------------------------------------- + * + * TclXML_ElementEndHandler -- + * + * Called by parser instance for each end tag. + * + * Results: + * None. + * + * Side Effects: + * Callback script is invoked. + * + *---------------------------------------------------------------------------- + */ + +void +TclXML_ElementEndHandler(userData, name) + void *userData; + Tcl_Obj *name; +{ + TclXML_Info *xmlinfo = (TclXML_Info *) userData; + int result = TCL_OK;; + + TclXMLDispatchPCDATA(xmlinfo); + + if (xmlinfo->status == TCL_CONTINUE) { + /* + * We're currently skipping elements looking for the + * end of the currently open element. + */ + + if (!--(xmlinfo->continueCount)) { + xmlinfo->status = TCL_OK; + } else { + return; + } + } + + if ((xmlinfo->elementend == NULL && + xmlinfo->elementendcommand == NULL) || + xmlinfo->status != TCL_OK) { + return; + } + + if (xmlinfo->elementend) { + result = (xmlinfo->elementend)(xmlinfo->interp, xmlinfo->elementenddata, name); + } else if (xmlinfo->elementendcommand) { + Tcl_Obj *cmdPtr; + + /* + * Take a copy of the callback script so that arguments may be appended. + */ + + cmdPtr = Tcl_DuplicateObj(xmlinfo->elementendcommand); + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) xmlinfo->interp); + + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, name); + + /* + * It would be desirable to be able to terminate parsing + * if the return result is TCL_ERROR or TCL_BREAK. + */ + result = Tcl_GlobalEvalObj(xmlinfo->interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) xmlinfo->interp); + } + + TclXMLHandlerResult(xmlinfo, result); + + return; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXML_CharacterDataHandler -- + * + * Called by parser instance for character data. + * + * Results: + * None. + * + * Side Effects: + * Character data is accumulated in a string object + * + *---------------------------------------------------------------------------- + */ + +void +TclXML_CharacterDataHandler(userData, s) + void *userData; + Tcl_Obj *s; +{ + TclXML_Info *xmlinfo = (TclXML_Info *) userData; + if (xmlinfo->cdata == NULL) { + xmlinfo->cdata = s; + Tcl_IncrRefCount(xmlinfo->cdata); + } else { + Tcl_AppendObjToObj(xmlinfo->cdata, s); + } +} + +/* + *---------------------------------------------------------------------------- + * + * TclXMLDispatchPCDATA -- + * + * Called to check whether any accumulated character data + * exists, and if so invoke the callback. + * + * Results: + * None. + * + * Side Effects: + * Callback script evaluated. + * + *---------------------------------------------------------------------------- + */ + +static void +TclXMLDispatchPCDATA(xmlinfo) + TclXML_Info *xmlinfo; +{ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + int result = TCL_OK; + + if (xmlinfo->cdata == NULL || + (xmlinfo->datacommand == NULL && xmlinfo->cdatacb == NULL) || + xmlinfo->status != TCL_OK) { + return; + } + + /* + * Optionally ignore white-space-only PCDATA + */ + + if (xmlinfo->nowhitespace) { + if (!Tcl_RegExpMatchObj(xmlinfo->interp, xmlinfo->cdata, tsdPtr->whitespaceRE)) { + goto finish; + } + } + + if (xmlinfo->cdatacb) { + result = (xmlinfo->cdatacb)(xmlinfo->interp, xmlinfo->cdatacbdata, xmlinfo->cdata); + } else if (xmlinfo->datacommand) { + Tcl_Obj *cmdPtr; + + /* + * Take a copy of the callback script so that arguments may be appended. + */ + + cmdPtr = Tcl_DuplicateObj(xmlinfo->datacommand); + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) xmlinfo->interp); + + if (Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, xmlinfo->cdata) != TCL_OK) { + xmlinfo->status = TCL_ERROR; + return; + } + + /* + * It would be desirable to be able to terminate parsing + * if the return result is TCL_ERROR or TCL_BREAK. + */ + result = Tcl_GlobalEvalObj(xmlinfo->interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) xmlinfo->interp); + } + + TclXMLHandlerResult(xmlinfo, result); + + finish: + Tcl_DecrRefCount(xmlinfo->cdata); + xmlinfo->cdata = NULL; + + return; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXML_ProcessingInstructionHandler -- + * + * Called by parser instance for processing instructions. + * + * Results: + * None. + * + * Side Effects: + * Callback script is invoked. + * + *---------------------------------------------------------------------------- + */ + +void +TclXML_ProcessingInstructionHandler(userData, target, data) + void *userData; + Tcl_Obj *target; + Tcl_Obj *data; +{ + TclXML_Info *xmlinfo = (TclXML_Info *) userData; + int result = TCL_OK; + + TclXMLDispatchPCDATA(xmlinfo); + + if ((xmlinfo->picommand == NULL && xmlinfo->pi == NULL) || + xmlinfo->status != TCL_OK) { + return; + } + + if (xmlinfo->pi) { + result = (xmlinfo->pi)(xmlinfo->interp, xmlinfo->pidata, target, data); + } else if (xmlinfo->picommand) { + Tcl_Obj *cmdPtr; + + /* + * Take a copy of the callback script so that arguments may be appended. + */ + + cmdPtr = Tcl_DuplicateObj(xmlinfo->picommand); + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) xmlinfo->interp); + + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, target); + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, data); + + /* + * It would be desirable to be able to terminate parsing + * if the return result is TCL_ERROR or TCL_BREAK. + */ + result = Tcl_GlobalEvalObj(xmlinfo->interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) xmlinfo->interp); + } + + TclXMLHandlerResult(xmlinfo, result); + + return; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXML_DefaultHandler -- + * + * Called by parser instance for processing data which has no other handler. + * + * Results: + * None. + * + * Side Effects: + * Callback script is invoked. + * + *---------------------------------------------------------------------------- + */ + +void +TclXML_DefaultHandler(userData, s) + void *userData; + Tcl_Obj *s; +{ + TclXML_Info *xmlinfo = (TclXML_Info *) userData; + int result = TCL_OK; + + TclXMLDispatchPCDATA(xmlinfo); + + if ((xmlinfo->defaultcommand == NULL && xmlinfo->defaultcb == NULL) || + xmlinfo->status != TCL_OK) { + return; + } + + if (xmlinfo->defaultcb) { + result = (xmlinfo->defaultcb)(xmlinfo->interp, xmlinfo->defaultdata, s); + } else if (xmlinfo->defaultcommand) { + Tcl_Obj *cmdPtr; + + /* + * Take a copy of the callback script so that arguments may be appended. + */ + + cmdPtr = Tcl_DuplicateObj(xmlinfo->defaultcommand); + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) xmlinfo->interp); + + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, s); + + /* + * It would be desirable to be able to terminate parsing + * if the return result is TCL_ERROR or TCL_BREAK. + */ + result = Tcl_GlobalEvalObj(xmlinfo->interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) xmlinfo->interp); + } + + TclXMLHandlerResult(xmlinfo, result); + + return; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXML_UnparsedDeclHandler -- + * + * Called by parser instance for processing an unparsed entity references. + * + * Results: + * None. + * + * Side Effects: + * Callback script is invoked. + * + *---------------------------------------------------------------------------- + */ + +void +TclXML_UnparsedDeclHandler(userData, entityName, base, systemId, publicId, notationName) + void *userData; + Tcl_Obj *entityName; + Tcl_Obj *base; + Tcl_Obj *systemId; + Tcl_Obj *publicId; + Tcl_Obj *notationName; +{ + TclXML_Info *xmlinfo = (TclXML_Info *) userData; + int result = TCL_OK; + + TclXMLDispatchPCDATA(xmlinfo); + + if ((xmlinfo->unparsedcommand == NULL && xmlinfo->unparsed == NULL) || + xmlinfo->status != TCL_OK) { + return; + } + + if (xmlinfo->unparsed) { + result = (xmlinfo->unparsed)(xmlinfo->interp, xmlinfo->unparseddata, entityName, base, systemId, publicId, notationName); + } else if (xmlinfo->unparsedcommand) { + Tcl_Obj *cmdPtr; + + /* + * Take a copy of the callback script so that arguments may be appended. + */ + + cmdPtr = Tcl_DuplicateObj(xmlinfo->unparsedcommand); + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) xmlinfo->interp); + + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, entityName); + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, base); + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, systemId); + if (publicId == NULL) { + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, Tcl_NewObj()); + } else { + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, publicId); + } + if (notationName == NULL) { + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, Tcl_NewObj()); + } else { + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, notationName); + } + + /* + * It would be desirable to be able to terminate parsing + * if the return result is TCL_ERROR or TCL_BREAK. + */ + result = Tcl_GlobalEvalObj(xmlinfo->interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) xmlinfo->interp); + } + + TclXMLHandlerResult(xmlinfo, result); + + return; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXML_NotationDeclHandler -- + * + * Called by parser instance for processing a notation declaration. + * + * Results: + * None. + * + * Side Effects: + * Callback script is invoked. + * + *---------------------------------------------------------------------------- + */ + +void +TclXML_NotationDeclHandler(userData, notationName, base, systemId, publicId) + void *userData; + Tcl_Obj *notationName; + Tcl_Obj *base; + Tcl_Obj *systemId; + Tcl_Obj *publicId; +{ + TclXML_Info *xmlinfo = (TclXML_Info *) userData; + int result = TCL_OK; + + TclXMLDispatchPCDATA(xmlinfo); + + if ((xmlinfo->notationcommand == NULL && xmlinfo->notation == NULL) || + xmlinfo->status != TCL_OK) { + return; + } + + if (xmlinfo->notation) { + result = (xmlinfo->notation)(xmlinfo->interp, xmlinfo->notationdata, notationName, base, systemId, publicId); + } else if (xmlinfo->notationcommand) { + Tcl_Obj *cmdPtr; + + /* + * Take a copy of the callback script so that arguments may be appended. + */ + + cmdPtr = Tcl_DuplicateObj(xmlinfo->notationcommand); + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) xmlinfo->interp); + + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, notationName); + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, base); + if (systemId == NULL) { + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, Tcl_NewObj()); + } else { + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, systemId); + } + if (publicId == NULL) { + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, Tcl_NewObj()); + } else { + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, publicId); + } + + /* + * It would be desirable to be able to terminate parsing + * if the return result is TCL_ERROR or TCL_BREAK. + */ + result = Tcl_GlobalEvalObj(xmlinfo->interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) xmlinfo->interp); + } + + TclXMLHandlerResult(xmlinfo, result); + + return; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXML_UnknownEncodingHandler -- + * + * Called by parser instance for processing a reference to a character in an + * unknown encoding. + * + * Results: + * None. + * + * Side Effects: + * Callback script is invoked. + * + *---------------------------------------------------------------------------- + */ + +int +TclXML_UnknownEncodingHandler(encodingHandlerData, name, info) + void *encodingHandlerData; + Tcl_Obj *name; + void *info; +{ + TclXML_Info *xmlinfo = (TclXML_Info *) encodingHandlerData; + int result = TCL_OK; + + TclXMLDispatchPCDATA(xmlinfo); + + Tcl_SetResult(xmlinfo->interp, "not implemented", NULL); + return 0; + + if ((xmlinfo->unknownencodingcommand == NULL && xmlinfo->unknownencoding == NULL) || + xmlinfo->status != TCL_OK) { + return 0; + } + + if (xmlinfo->unknownencoding) { + result = (xmlinfo->unknownencoding)(xmlinfo->interp, xmlinfo->unknownencodingdata, name, info); + } else if (xmlinfo->unknownencodingcommand) { + Tcl_Obj *cmdPtr; + + /* + * Take a copy of the callback script so that arguments may be appended. + */ + + cmdPtr = Tcl_DuplicateObj(xmlinfo->unknownencodingcommand); + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) xmlinfo->interp); + + /* + * Setup the arguments + */ + + /* + * It would be desirable to be able to terminate parsing + * if the return result is TCL_ERROR or TCL_BREAK. + */ + result = Tcl_GlobalEvalObj(xmlinfo->interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) xmlinfo->interp); + } + + TclXMLHandlerResult(xmlinfo, result); + + return 0; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXML_ExternalEntityRefHandler -- + * + * Called by parser instance for processing external entity references. + * May also be called outside the context of a parser for XInclude + * or XSLT import/include. + * + * Results: + * Returns success code. + * + * Side Effects: + * Callback script is invoked. + * + *---------------------------------------------------------------------------- + */ + +int +TclXML_ExternalEntityRefHandler(userData, openEntityNames, base, + systemId, publicId) + ClientData userData; /* NULL if not in parser context, current interp gets result */ + Tcl_Obj *openEntityNames; + Tcl_Obj *base; + Tcl_Obj *systemId; + Tcl_Obj *publicId; +{ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + TclXML_Info *xmlinfo = (TclXML_Info *) userData; + int result = TCL_OK; + Tcl_Obj *oldContext; + + if (xmlinfo != NULL) { + TclXMLDispatchPCDATA(xmlinfo); + + if (xmlinfo->entitycommand == NULL && xmlinfo->entity == NULL) { + if (Tcl_IsSafe(xmlinfo->interp)) { + return TCL_BREAK; + } else { + return TCL_CONTINUE; + } + } + if (xmlinfo->status != TCL_OK) { + return xmlinfo->status; + } + oldContext = xmlinfo->context; + xmlinfo->context = openEntityNames; + + if (xmlinfo->entity) { + result = (xmlinfo->entity)(xmlinfo->interp, xmlinfo->entitydata, xmlinfo->name, base, systemId, publicId); + } else if (xmlinfo->entitycommand) { + Tcl_Obj *cmdPtr; + + /* + * Take a copy of the callback script so that arguments may be appended. + */ + + cmdPtr = Tcl_DuplicateObj(xmlinfo->entitycommand); + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) xmlinfo->interp); + + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, xmlinfo->name); + + if (base) { + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, base); + } else { + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, Tcl_NewObj()); + } + + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, systemId); + + if (publicId) { + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, publicId); + } else { + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, Tcl_NewObj()); + } + + /* + * It would be desirable to be able to terminate parsing + * if the return result is TCL_ERROR or TCL_BREAK. + */ + result = Tcl_GlobalEvalObj(xmlinfo->interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) xmlinfo->interp); + } + + /* + * Return results have a different meaning for external entities, + * so don't retain the result for later use. + * TclXMLHandlerResult(xmlinfo, result); + */ + xmlinfo->context = oldContext; + + } else { + /* + * No parser context + */ + + if (tsdPtr->externalentitycmd) { + Tcl_Obj *cmdPtr; + + /* + * Take a copy of the callback script so that arguments may be appended. + */ + + cmdPtr = Tcl_DuplicateObj(tsdPtr->externalentitycmd); + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) tsdPtr->interp); + + if (base) { + Tcl_ListObjAppendElement(tsdPtr->interp, cmdPtr, base); + } else { + Tcl_ListObjAppendElement(tsdPtr->interp, cmdPtr, Tcl_NewObj()); + } + + Tcl_ListObjAppendElement(tsdPtr->interp, cmdPtr, systemId); + + if (publicId) { + Tcl_ListObjAppendElement(tsdPtr->interp, cmdPtr, publicId); + } else { + Tcl_ListObjAppendElement(tsdPtr->interp, cmdPtr, Tcl_NewObj()); + } + + /* + * It would be desirable to be able to terminate parsing + * if the return result is TCL_ERROR or TCL_BREAK. + */ + result = Tcl_GlobalEvalObj(tsdPtr->interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) tsdPtr->interp); + } else if (Tcl_IsSafe(tsdPtr->interp)) { + return TCL_BREAK; + } else { + return TCL_CONTINUE; + } + } + + return result; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXML_CommentHandler -- + * + * Called by parser instance to handle comments encountered while parsing + * Added by ericm@scriptics.com, 1999.6.25. + * + * Results: + * None. + * + * Side Effects: + * Callback script is invoked. + * + *---------------------------------------------------------------------------- + */ +void +TclXML_CommentHandler(userData, data) + void *userData; + Tcl_Obj *data; +{ + TclXML_Info *xmlinfo = (TclXML_Info *) userData; + int result = TCL_OK; + + TclXMLDispatchPCDATA(xmlinfo); + + if (xmlinfo->status == TCL_CONTINUE) { + /* Currently skipping elements, looking for the close of the + * continued element. Comments don't have an end tag, so + * don't increment xmlinfo->continueCount + */ + return; + } + + if ((xmlinfo->commentCommand == NULL && xmlinfo->comment == NULL) || + xmlinfo->status != TCL_OK) { + return; + } + + if (xmlinfo->comment) { + result = (xmlinfo->comment)(xmlinfo->interp, xmlinfo->commentdata, data); + } else if (xmlinfo->commentCommand) { + Tcl_Obj *cmdPtr; + + cmdPtr = Tcl_DuplicateObj(xmlinfo->commentCommand); + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) xmlinfo->interp); + + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, data); + + result = Tcl_GlobalEvalObj(xmlinfo->interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) xmlinfo->interp); + } + + TclXMLHandlerResult(xmlinfo, result); + + return; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXML_NotStandaloneHandler -- + * + * Called by parser instance to handle "not standalone" documents (ie, documents + * that have an external subset or a reference to a parameter entity, + * but do not have standalone="yes") + * Added by ericm@scriptics.com, 1999.6.25. + * + * Results: + * None. + * + * Side Effects: + * Callback script is invoked. + * + *---------------------------------------------------------------------------- + */ + +int +TclXML_NotStandaloneHandler(userData) + void *userData; +{ + TclXML_Info *xmlinfo = (TclXML_Info *) userData; + int result = TCL_OK; + + TclXMLDispatchPCDATA(xmlinfo); + + if (xmlinfo->status != TCL_OK) { + return 0; + } else if (xmlinfo->notStandaloneCommand == NULL && xmlinfo->notStandalone == NULL) { + return 1; + } + + if (xmlinfo->notStandalone) { + result = (xmlinfo->notStandalone)(xmlinfo->interp, xmlinfo->notstandalonedata); + } else if (xmlinfo->notStandaloneCommand) { + Tcl_Obj *cmdPtr; + + cmdPtr = Tcl_DuplicateObj(xmlinfo->notStandaloneCommand); + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) xmlinfo->interp); + + result = Tcl_GlobalEvalObj(xmlinfo->interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) xmlinfo->interp); + } + + TclXMLHandlerResult(xmlinfo, result); + + return 1; +} + +/* + *---------------------------------------------------------------------- + * + * TclXML_ElementDeclHandler -- + * + * Called by expat to handle elementDeclCommand == NULL && xmlinfo->elementDecl == NULL) || + xmlinfo->status != TCL_OK) { + return; + } + + if (xmlinfo->elementDecl) { + result = (xmlinfo->elementDecl)(xmlinfo->interp, xmlinfo->elementdecldata, name, contentspec); + } else if (xmlinfo->elementDeclCommand) { + Tcl_Obj *cmdPtr; + + cmdPtr = Tcl_DuplicateObj(xmlinfo->elementDeclCommand); + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) xmlinfo->interp); + + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, name); + + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, contentspec); + + result = Tcl_GlobalEvalObj(xmlinfo->interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) xmlinfo->interp); + } + + TclXMLHandlerResult(xmlinfo, result); + + return; +} + +/* + *---------------------------------------------------------------------- + * + * TclXML_AttlistDeclHandler -- + * + * Called by parser instance to handle attlistDeclCommand == NULL && xmlinfo->attlistDecl == NULL) || + xmlinfo->status != TCL_OK) { + return; + } + + if (xmlinfo->attlistDecl) { + result = (xmlinfo->attlistDecl)(xmlinfo->interp, xmlinfo->attlistdecldata, name, attributes); + } else if (xmlinfo->attlistDeclCommand) { + Tcl_Obj *cmdPtr; + + cmdPtr = Tcl_DuplicateObj(xmlinfo->attlistDeclCommand); + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) xmlinfo->interp); + + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, name); + + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, attributes); + + result = Tcl_GlobalEvalObj(xmlinfo->interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) xmlinfo->interp); + } + + TclXMLHandlerResult(xmlinfo, result); + + return; +} + +/* + *---------------------------------------------------------------------- + * + * TclXML_StartDoctypeDeclHandler -- + * + * Called by parser instance to handle the start of startDoctypeDeclCommand == NULL && xmlinfo->startDoctypeDecl == NULL) || + xmlinfo->status != TCL_OK) { + return; + } + + if (xmlinfo->startDoctypeDecl) { + result = (xmlinfo->startDoctypeDecl)(xmlinfo->interp, xmlinfo->startdoctypedecldata, name); + } else if (xmlinfo->startDoctypeDeclCommand) { + Tcl_Obj *cmdPtr; + + cmdPtr = Tcl_DuplicateObj(xmlinfo->startDoctypeDeclCommand); + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) xmlinfo->interp); + + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, name); + + result = Tcl_GlobalEvalObj(xmlinfo->interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) xmlinfo->interp); + } + + TclXMLHandlerResult(xmlinfo, result); + + return; +} + +/* + *---------------------------------------------------------------------- + * + * TclXML_EndDoctypeDeclHandler -- + * + * Called by parser instance to handle the end of endDoctypeDeclCommand == NULL && xmlinfo->endDoctypeDecl == NULL) || + xmlinfo->status != TCL_OK) { + return; + } + + if (xmlinfo->endDoctypeDecl) { + result = (xmlinfo->endDoctypeDecl)(xmlinfo->interp, xmlinfo->enddoctypedecldata); + } else if (xmlinfo->endDoctypeDeclCommand) { + Tcl_Obj *cmdPtr; + + cmdPtr = Tcl_DuplicateObj(xmlinfo->endDoctypeDeclCommand); + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) xmlinfo->interp); + + result = Tcl_GlobalEvalObj(xmlinfo->interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) xmlinfo->interp); + } + + TclXMLHandlerResult(xmlinfo, result); + + return; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXMLInstanceDeleteCmd -- + * + * Called when a parser instance is deleted. + * + * Results: + * None. + * + * Side Effects: + * Memory structures are freed. + * + *---------------------------------------------------------------------------- + */ + +static void +TclXMLInstanceDeleteCmd(clientData) + ClientData clientData; +{ + TclXML_Info *xmlinfo = (TclXML_Info *) clientData; + + Tcl_DecrRefCount(xmlinfo->name); + + if (xmlinfo->cdata) { + Tcl_DecrRefCount(xmlinfo->cdata); + xmlinfo->cdata = NULL; + } + + if (xmlinfo->elementstartcommand) { + Tcl_DecrRefCount(xmlinfo->elementstartcommand); + } + if (xmlinfo->elementendcommand) { + Tcl_DecrRefCount(xmlinfo->elementendcommand); + } + if (xmlinfo->datacommand) { + Tcl_DecrRefCount(xmlinfo->datacommand); + } + if (xmlinfo->picommand) { + Tcl_DecrRefCount(xmlinfo->picommand); + } + if (xmlinfo->entitycommand) { + Tcl_DecrRefCount(xmlinfo->entitycommand); + } + + if (xmlinfo->unknownencodingcommand) { + Tcl_DecrRefCount(xmlinfo->unknownencodingcommand); + } + + if (xmlinfo->commentCommand) { + Tcl_DecrRefCount(xmlinfo->commentCommand); + } + + if (xmlinfo->notStandaloneCommand) { + Tcl_DecrRefCount(xmlinfo->notStandaloneCommand); + } + + if (xmlinfo->elementDeclCommand) { + Tcl_DecrRefCount(xmlinfo->elementDeclCommand); + } + + if (xmlinfo->attlistDeclCommand) { + Tcl_DecrRefCount(xmlinfo->attlistDeclCommand); + } + + if (xmlinfo->startDoctypeDeclCommand) { + Tcl_DecrRefCount(xmlinfo->startDoctypeDeclCommand); + } + + if (xmlinfo->endDoctypeDeclCommand) { + Tcl_DecrRefCount(xmlinfo->endDoctypeDeclCommand); + } + + TclXMLFreeParser(xmlinfo); +} + +/* + *---------------------------------------------------------------------------- + * + * TclXML_Register*Cmd -- + * + * Configures a direct callback handler. + * + * Results: + * None. + * + * Side Effects: + * Parser data structure modified. + * + *---------------------------------------------------------------------------- + */ + +int +TclXML_RegisterElementStartProc(interp, parser, clientData, callback) + Tcl_Interp *interp; + TclXML_Info *parser; + ClientData clientData; + TclXML_ElementStartProc *callback; +{ + parser->elementstart = callback; + parser->elementstartdata = clientData; + + if (parser->elementstartcommand) { + Tcl_DecrRefCount(parser->elementstartcommand); + parser->elementstartcommand = NULL; + } + + return TCL_OK; +} + +int +TclXML_RegisterElementEndProc(interp, parser, clientData, callback) + Tcl_Interp *interp; + TclXML_Info *parser; + ClientData clientData; + TclXML_ElementEndProc *callback; +{ + parser->elementend = callback; + parser->elementenddata = clientData; + + if (parser->elementendcommand) { + Tcl_DecrRefCount(parser->elementendcommand); + parser->elementendcommand = NULL; + } + + return TCL_OK; +} + +int +TclXML_RegisterCharacterDataProc(interp, parser, clientData, callback) + Tcl_Interp *interp; + TclXML_Info *parser; + ClientData clientData; + TclXML_CharacterDataProc *callback; +{ + parser->cdatacb = callback; + parser->cdatacbdata = clientData; + + if (parser->datacommand) { + Tcl_DecrRefCount(parser->datacommand); + parser->datacommand = NULL; + } + + return TCL_OK; +} + +int +TclXML_RegisterPIProc(interp, parser, clientData, callback) + Tcl_Interp *interp; + TclXML_Info *parser; + ClientData clientData; + TclXML_PIProc *callback; +{ + parser->pi = callback; + parser->pidata = clientData; + + if (parser->picommand) { + Tcl_DecrRefCount(parser->picommand); + parser->picommand = NULL; + } + + return TCL_OK; +} + +int +TclXML_RegisterDefaultProc(interp, parser, clientData, callback) + Tcl_Interp *interp; + TclXML_Info *parser; + ClientData clientData; + TclXML_DefaultProc *callback; +{ + parser->defaultcb = callback; + parser->defaultdata = clientData; + + if (parser->defaultcommand) { + Tcl_DecrRefCount(parser->defaultcommand); + parser->defaultcommand = NULL; + } + + return TCL_OK; +} + +int +TclXML_RegisterUnparsedProc(interp, parser, clientData, callback) + Tcl_Interp *interp; + TclXML_Info *parser; + ClientData clientData; + TclXML_UnparsedProc *callback; +{ + parser->unparsed = callback; + parser->unparseddata = clientData; + + if (parser->unparsedcommand) { + Tcl_DecrRefCount(parser->unparsedcommand); + parser->unparsedcommand = NULL; + } + + return TCL_OK; +} + +int +TclXML_RegisterNotationDeclProc(interp, parser, clientData, callback) + Tcl_Interp *interp; + TclXML_Info *parser; + ClientData clientData; + TclXML_NotationDeclProc *callback; +{ + parser->notation = callback; + parser->notationdata = clientData; + + if (parser->notationcommand) { + Tcl_DecrRefCount(parser->notationcommand); + parser->notationcommand = NULL; + } + + return TCL_OK; +} + +int +TclXML_RegisterEntityProc(interp, parser, clientData, callback) + Tcl_Interp *interp; + TclXML_Info *parser; + ClientData clientData; + TclXML_EntityProc *callback; +{ + parser->entity = callback; + parser->entitydata = clientData; + + if (parser->entitycommand) { + Tcl_DecrRefCount(parser->entitycommand); + parser->entitycommand = NULL; + } + + return TCL_OK; +} + +int +TclXML_RegisterUnknownEncodingProc(interp, parser, clientData, callback) + Tcl_Interp *interp; + TclXML_Info *parser; + ClientData clientData; + TclXML_UnknownEncodingProc *callback; +{ + parser->unknownencoding = callback; + parser->unknownencodingdata = clientData; + + if (parser->unknownencodingcommand) { + Tcl_DecrRefCount(parser->unknownencodingcommand); + parser->unknownencodingcommand = NULL; + } + + return TCL_OK; +} + +int +TclXML_RegisterCommentProc(interp, parser, clientData, callback) + Tcl_Interp *interp; + TclXML_Info *parser; + ClientData clientData; + TclXML_CommentProc *callback; +{ + parser->comment = callback; + parser->commentdata = clientData; + + if (parser->commentCommand) { + Tcl_DecrRefCount(parser->commentCommand); + parser->commentCommand = NULL; + } + + return TCL_OK; +} + +int +TclXML_RegisterNotStandaloneProc(interp, parser, clientData, callback) + Tcl_Interp *interp; + TclXML_Info *parser; + ClientData clientData; + TclXML_NotStandaloneProc *callback; +{ + parser->notStandalone = callback; + parser->notstandalonedata = clientData; + + if (parser->notStandaloneCommand) { + Tcl_DecrRefCount(parser->notStandaloneCommand); + parser->notStandaloneCommand = NULL; + } + + return TCL_OK; +} + +int +TclXML_RegisterElementDeclProc(interp, parser, clientData, callback) + Tcl_Interp *interp; + TclXML_Info *parser; + ClientData clientData; + TclXML_ElementDeclProc *callback; +{ + parser->elementDecl = callback; + parser->elementdecldata = clientData; + + if (parser->elementDeclCommand) { + Tcl_DecrRefCount(parser->elementDeclCommand); + parser->elementDeclCommand = NULL; + } + + return TCL_OK; +} + +int +TclXML_RegisterAttListDeclProc(interp, parser, clientData, callback) + Tcl_Interp *interp; + TclXML_Info *parser; + ClientData clientData; + TclXML_AttlistDeclProc *callback; +{ + parser->attlistDecl = callback; + parser->attlistdecldata = clientData; + + if (parser->attlistDeclCommand) { + Tcl_DecrRefCount(parser->attlistDeclCommand); + parser->attlistDeclCommand = NULL; + } + + return TCL_OK; +} + +int +TclXML_RegisterStartDoctypeDeclProc(interp, parser, clientData, callback) + Tcl_Interp *interp; + TclXML_Info *parser; + ClientData clientData; + TclXML_StartDoctypeDeclProc *callback; +{ + parser->startDoctypeDecl = callback; + parser->startdoctypedecldata = clientData; + + if (parser->startDoctypeDeclCommand) { + Tcl_DecrRefCount(parser->startDoctypeDeclCommand); + parser->startDoctypeDeclCommand = NULL; + } + + return TCL_OK; +} + +int +TclXML_RegisterEndDoctypeDeclProc(interp, parser, clientData, callback) + Tcl_Interp *interp; + TclXML_Info *parser; + ClientData clientData; + TclXML_EndDoctypeDeclProc *callback; +{ + parser->endDoctypeDecl = callback; + parser->enddoctypedecldata = clientData; + + if (parser->endDoctypeDeclCommand) { + Tcl_DecrRefCount(parser->endDoctypeDeclCommand); + parser->endDoctypeDeclCommand = NULL; + } + + return TCL_OK; +} diff --git a/tclxml.decls b/tclxml.decls new file mode 100644 index 0000000..72fd483 --- /dev/null +++ b/tclxml.decls @@ -0,0 +1,187 @@ +# tclxml.decls -- +# +# This file contains the declarations for all supported public functions +# that are exported by the TCLXML library via the stubs table. This file +# is used to generate the tclxmlDecls.h/tclxmlStubsLib.c/tclxmlStubsInit.c +# files. +# + +# Declare each of the functions in the public TclXML interface. Note that +# the an index should never be reused for a different function in order +# to preserve backwards compatibility. + +library tclxml + +# Define the TCLXML interface: + +interface tclxml +#hooks {} + +declare 0 generic { + int Tclxml_Init(Tcl_Interp *interp) +} +declare 1 generic { + int Tclxml_SafeInit(Tcl_Interp *interp) +} + +######################################################################### +### Parser registration API + +declare 2 generic { + int TclXML_RegisterXMLParser (Tcl_Interp *interp, \ + TclXML_ParserClassInfo *parser) +} + +######################################################################### +### Application callback C API. +### These are equivalent to the Tcl API, and may be used in conjunction. + +declare 3 generic { + int TclXML_RegisterElementStartProc (Tcl_Interp *interp, \ + TclXML_Info *parser, ClientData clientData, \ + TclXML_ElementStartProc *callback) +} +declare 4 generic { + int TclXML_RegisterElementEndProc (Tcl_Interp *interp, \ + TclXML_Info *parser, ClientData clientData, \ + TclXML_ElementEndProc *callback) +} +declare 5 generic { + int TclXML_RegisterCharacterDataProc (Tcl_Interp *interp, \ + TclXML_Info *parser, ClientData clientData, \ + TclXML_CharacterDataProc *callback) +} +declare 6 generic { + int TclXML_RegisterPIProc (Tcl_Interp *interp, TclXML_Info *parser, \ + ClientData clientData, TclXML_PIProc *callback) +} +declare 7 generic { + int TclXML_RegisterDefaultProc (Tcl_Interp *interp, \ + TclXML_Info *parser, ClientData clientData, \ + TclXML_DefaultProc *callback) +} +declare 8 generic { + int TclXML_RegisterUnparsedProc (Tcl_Interp *interp, \ + TclXML_Info *parser, ClientData clientData, \ + TclXML_UnparsedProc *callback) +} +declare 9 generic { + int TclXML_RegisterNotationDeclProc (Tcl_Interp *interp, \ + TclXML_Info *parser, ClientData clientData, \ + TclXML_NotationDeclProc *callback) +} +declare 10 generic { + int TclXML_RegisterEntityProc (Tcl_Interp *interp, TclXML_Info *parser, \ + ClientData clientData, TclXML_EntityProc *callback) +} +declare 11 generic { + int TclXML_RegisterUnknownEncodingProc (Tcl_Interp *interp, \ + TclXML_Info *parser, ClientData clientData, \ + TclXML_UnknownEncodingProc *callback) +} +declare 12 generic { + int TclXML_RegisterCommentProc (Tcl_Interp *interp, TclXML_Info *parser, \ + ClientData clientData, TclXML_CommentProc *callback) +} +declare 13 generic { + int TclXML_RegisterNotStandaloneProc (Tcl_Interp *interp, \ + TclXML_Info *parser, ClientData clientData, \ + TclXML_NotStandaloneProc *callback) +} +declare 14 generic { + int TclXML_RegisterElementDeclProc (Tcl_Interp *interp, \ + TclXML_Info *parser, ClientData clientData, \ + TclXML_ElementDeclProc *callback) +} +declare 15 generic { + int TclXML_RegisterAttListDeclProc (Tcl_Interp *interp, \ + TclXML_Info *parser, ClientData clientData, \ + TclXML_AttlistDeclProc *callback) +} +declare 16 generic { + int TclXML_RegisterStartDoctypeDeclProc (Tcl_Interp *interp, \ + TclXML_Info *parser, ClientData clientData, \ + TclXML_StartDoctypeDeclProc *callback) +} +declare 17 generic { + int TclXML_RegisterEndDoctypeDeclProc (Tcl_Interp *interp, \ + TclXML_Info *parser, ClientData clientData, \ + TclXML_EndDoctypeDeclProc *callback) +} + +######################################################################### +### Call-ins for parser class implementations. +### A parser implementation calls these functions. +### The generic layer then invokes application callbacks +### that may be defined. + +declare 18 generic { + void TclXML_ElementStartHandler (void *userdata, Tcl_Obj *name, \ + Tcl_Obj *nsuri, \ + Tcl_Obj *atts, Tcl_Obj *nsDeclsObj) +} +declare 19 generic { + void TclXML_ElementEndHandler (void *userData, Tcl_Obj *name) +} +declare 20 generic { + void TclXML_CharacterDataHandler (void *userData, Tcl_Obj *s) +} +declare 21 generic { + void TclXML_ProcessingInstructionHandler (void *userData, \ + Tcl_Obj *target, Tcl_Obj *data) +} +declare 22 generic { + int TclXML_ExternalEntityRefHandler (ClientData clientData, \ + Tcl_Obj *openEntityNames, Tcl_Obj *base, Tcl_Obj *systemId, \ + Tcl_Obj *publicId) +} +declare 23 generic { + void TclXML_DefaultHandler (void *userData, Tcl_Obj *s) +} +declare 24 generic { + void TclXML_UnparsedDeclHandler (void *userData, Tcl_Obj *entityname, \ + Tcl_Obj *base, Tcl_Obj *systemId, Tcl_Obj *publicId, \ + Tcl_Obj *notationName) +} +declare 25 generic { + void TclXML_NotationDeclHandler (void *userData, Tcl_Obj *notationName, \ + Tcl_Obj *base, Tcl_Obj *systemId, Tcl_Obj *publicId) +} +declare 26 generic { + int TclXML_UnknownEncodingHandler (void *encodingHandlerData, \ + Tcl_Obj *name, void *info) +} + +######################################################################### +### Following added by ericm@scriptics, 1999.6.25 + +### Prototype definition for the comment handler +declare 27 generic { + void TclXML_CommentHandler (void *userData, Tcl_Obj *data) +} + +### Prototype for Not Standalone Handler +declare 28 generic { + int TclXML_NotStandaloneHandler (void *userData) +} + +######################################################################### +### Added by ericm@scriptics.com, 1999.09.13 + +### Prototype for (Element|Attlist) Declaration Handlers +declare 31 generic { + void TclXML_ElementDeclHandler (void *userData, Tcl_Obj *name, \ + Tcl_Obj *contentspec) +} +declare 32 generic { + void TclXML_AttlistDeclHandler (void *userData, Tcl_Obj *name, \ + Tcl_Obj *attributes) +} + +### Prototypes for the Doctype Decl handlers +declare 33 generic { + void TclXML_StartDoctypeDeclHandler (void *userData, Tcl_Obj *name) +} +declare 34 generic { + void TclXML_EndDoctypeDeclHandler (void *userData) +} diff --git a/tclxmlConfig.sh.in b/tclxmlConfig.sh.in new file mode 100755 index 0000000..5188db3 --- /dev/null +++ b/tclxmlConfig.sh.in @@ -0,0 +1,45 @@ +# tclxmlConfig.sh -- +# +# This shell script (for sh) is generated automatically by tclxml's +# configure script. It will create shell variables for most of +# the configuration options discovered by the configure script. +# This script is intended to be included by the configure scripts +# for tclxml extensions so that they don't have to figure this all +# out for themselves. This file does not duplicate information +# already provided by tclConfig.sh, so you may need to use that +# file in addition to this one. +# +# The information in this file is specific to a single platform. + +# tclxml's version number. +tclxml_VERSION='@PACKAGE_VERSION@' + +# The name of the tclxml library (may be either a .a file or a shared library): +tclxml_LIB_FILE=@PKG_LIB_FILE@ + +# String to pass to linker to pick up the tclxml library from its +# build directory. +tclxml_BUILD_LIB_SPEC='@tclxml_BUILD_LIB_SPEC@' + +# String to pass to linker to pick up the tclxml library from its +# installed directory. +tclxml_LIB_SPEC='@tclxml_LIB_SPEC@' + +# The name of the tclxml stub library (a .a file): +#tclxml_STUB_LIB_FILE=@PKG_STUB_LIB_FILE@ + +# String to pass to linker to pick up the tclxml stub library from its +# build directory. +#tclxml_BUILD_STUB_LIB_SPEC='@tclxml_BUILD_STUB_LIB_SPEC@' + +# String to pass to linker to pick up the tclxml stub library from its +# installed directory. +#tclxml_STUB_LIB_SPEC='@tclxml_STUB_LIB_SPEC@' + +# String to pass to linker to pick up the tclxml stub library from its +# build directory. +#tclxml_BUILD_STUB_LIB_PATH='@tclxml_BUILD_STUB_LIB_PATH@' + +# String to pass to linker to pick up the tclxml stub library from its +# installed directory. +#tclxml_STUB_LIB_PATH='@tclxml_STUB_LIB_PATH@' diff --git a/tclxmlDecls.h b/tclxmlDecls.h new file mode 100644 index 0000000..9576479 --- /dev/null +++ b/tclxmlDecls.h @@ -0,0 +1,361 @@ +/* + * tclxmlDecls.h -- + * + * Declarations of functions in the platform independent public TCLXML API. + * + */ + +#ifndef _TCLXMLDECLS +#define _TCLXMLDECLS + +/* + * WARNING: The contents of this file is automatically generated by the + * genStubs.tcl script. Any modifications to the function declarations + * below should be made in the tclxml.decls script. + */ + +/* !BEGIN!: Do not edit below this line. */ + +/* + * Exported function declarations: + */ + +/* 0 */ +EXTERN int Tclxml_Init _ANSI_ARGS_((Tcl_Interp * interp)); +/* 1 */ +EXTERN int Tclxml_SafeInit _ANSI_ARGS_((Tcl_Interp * interp)); +/* 2 */ +EXTERN int TclXML_RegisterXMLParser _ANSI_ARGS_(( + Tcl_Interp * interp, + TclXML_ParserClassInfo * parser)); +/* 3 */ +EXTERN int TclXML_RegisterElementStartProc _ANSI_ARGS_(( + Tcl_Interp * interp, TclXML_Info * parser, + ClientData clientData, + TclXML_ElementStartProc * callback)); +/* 4 */ +EXTERN int TclXML_RegisterElementEndProc _ANSI_ARGS_(( + Tcl_Interp * interp, TclXML_Info * parser, + ClientData clientData, + TclXML_ElementEndProc * callback)); +/* 5 */ +EXTERN int TclXML_RegisterCharacterDataProc _ANSI_ARGS_(( + Tcl_Interp * interp, TclXML_Info * parser, + ClientData clientData, + TclXML_CharacterDataProc * callback)); +/* 6 */ +EXTERN int TclXML_RegisterPIProc _ANSI_ARGS_(( + Tcl_Interp * interp, TclXML_Info * parser, + ClientData clientData, + TclXML_PIProc * callback)); +/* 7 */ +EXTERN int TclXML_RegisterDefaultProc _ANSI_ARGS_(( + Tcl_Interp * interp, TclXML_Info * parser, + ClientData clientData, + TclXML_DefaultProc * callback)); +/* 8 */ +EXTERN int TclXML_RegisterUnparsedProc _ANSI_ARGS_(( + Tcl_Interp * interp, TclXML_Info * parser, + ClientData clientData, + TclXML_UnparsedProc * callback)); +/* 9 */ +EXTERN int TclXML_RegisterNotationDeclProc _ANSI_ARGS_(( + Tcl_Interp * interp, TclXML_Info * parser, + ClientData clientData, + TclXML_NotationDeclProc * callback)); +/* 10 */ +EXTERN int TclXML_RegisterEntityProc _ANSI_ARGS_(( + Tcl_Interp * interp, TclXML_Info * parser, + ClientData clientData, + TclXML_EntityProc * callback)); +/* 11 */ +EXTERN int TclXML_RegisterUnknownEncodingProc _ANSI_ARGS_(( + Tcl_Interp * interp, TclXML_Info * parser, + ClientData clientData, + TclXML_UnknownEncodingProc * callback)); +/* 12 */ +EXTERN int TclXML_RegisterCommentProc _ANSI_ARGS_(( + Tcl_Interp * interp, TclXML_Info * parser, + ClientData clientData, + TclXML_CommentProc * callback)); +/* 13 */ +EXTERN int TclXML_RegisterNotStandaloneProc _ANSI_ARGS_(( + Tcl_Interp * interp, TclXML_Info * parser, + ClientData clientData, + TclXML_NotStandaloneProc * callback)); +/* 14 */ +EXTERN int TclXML_RegisterElementDeclProc _ANSI_ARGS_(( + Tcl_Interp * interp, TclXML_Info * parser, + ClientData clientData, + TclXML_ElementDeclProc * callback)); +/* 15 */ +EXTERN int TclXML_RegisterAttListDeclProc _ANSI_ARGS_(( + Tcl_Interp * interp, TclXML_Info * parser, + ClientData clientData, + TclXML_AttlistDeclProc * callback)); +/* 16 */ +EXTERN int TclXML_RegisterStartDoctypeDeclProc _ANSI_ARGS_(( + Tcl_Interp * interp, TclXML_Info * parser, + ClientData clientData, + TclXML_StartDoctypeDeclProc * callback)); +/* 17 */ +EXTERN int TclXML_RegisterEndDoctypeDeclProc _ANSI_ARGS_(( + Tcl_Interp * interp, TclXML_Info * parser, + ClientData clientData, + TclXML_EndDoctypeDeclProc * callback)); +/* 18 */ +EXTERN void TclXML_ElementStartHandler _ANSI_ARGS_(( + void * userdata, Tcl_Obj * name, + Tcl_Obj * nsuri, Tcl_Obj * atts, + Tcl_Obj * nsDeclsObj)); +/* 19 */ +EXTERN void TclXML_ElementEndHandler _ANSI_ARGS_(( + void * userData, Tcl_Obj * name)); +/* 20 */ +EXTERN void TclXML_CharacterDataHandler _ANSI_ARGS_(( + void * userData, Tcl_Obj * s)); +/* 21 */ +EXTERN void TclXML_ProcessingInstructionHandler _ANSI_ARGS_(( + void * userData, Tcl_Obj * target, + Tcl_Obj * data)); +/* 22 */ +EXTERN int TclXML_ExternalEntityRefHandler _ANSI_ARGS_(( + ClientData clientData, + Tcl_Obj * openEntityNames, Tcl_Obj * base, + Tcl_Obj * systemId, Tcl_Obj * publicId)); +/* 23 */ +EXTERN void TclXML_DefaultHandler _ANSI_ARGS_((void * userData, + Tcl_Obj * s)); +/* 24 */ +EXTERN void TclXML_UnparsedDeclHandler _ANSI_ARGS_(( + void * userData, Tcl_Obj * entityname, + Tcl_Obj * base, Tcl_Obj * systemId, + Tcl_Obj * publicId, Tcl_Obj * notationName)); +/* 25 */ +EXTERN void TclXML_NotationDeclHandler _ANSI_ARGS_(( + void * userData, Tcl_Obj * notationName, + Tcl_Obj * base, Tcl_Obj * systemId, + Tcl_Obj * publicId)); +/* 26 */ +EXTERN int TclXML_UnknownEncodingHandler _ANSI_ARGS_(( + void * encodingHandlerData, Tcl_Obj * name, + void * info)); +/* 27 */ +EXTERN void TclXML_CommentHandler _ANSI_ARGS_((void * userData, + Tcl_Obj * data)); +/* 28 */ +EXTERN int TclXML_NotStandaloneHandler _ANSI_ARGS_(( + void * userData)); +/* Slot 29 is reserved */ +/* Slot 30 is reserved */ +/* 31 */ +EXTERN void TclXML_ElementDeclHandler _ANSI_ARGS_(( + void * userData, Tcl_Obj * name, + Tcl_Obj * contentspec)); +/* 32 */ +EXTERN void TclXML_AttlistDeclHandler _ANSI_ARGS_(( + void * userData, Tcl_Obj * name, + Tcl_Obj * attributes)); +/* 33 */ +EXTERN void TclXML_StartDoctypeDeclHandler _ANSI_ARGS_(( + void * userData, Tcl_Obj * name)); +/* 34 */ +EXTERN void TclXML_EndDoctypeDeclHandler _ANSI_ARGS_(( + void * userData)); + +typedef struct TclxmlStubs { + int magic; + struct TclxmlStubHooks *hooks; + + int (*tclxml_Init) _ANSI_ARGS_((Tcl_Interp * interp)); /* 0 */ + int (*tclxml_SafeInit) _ANSI_ARGS_((Tcl_Interp * interp)); /* 1 */ + int (*tclXML_RegisterXMLParser) _ANSI_ARGS_((Tcl_Interp * interp, TclXML_ParserClassInfo * parser)); /* 2 */ + int (*tclXML_RegisterElementStartProc) _ANSI_ARGS_((Tcl_Interp * interp, TclXML_Info * parser, ClientData clientData, TclXML_ElementStartProc * callback)); /* 3 */ + int (*tclXML_RegisterElementEndProc) _ANSI_ARGS_((Tcl_Interp * interp, TclXML_Info * parser, ClientData clientData, TclXML_ElementEndProc * callback)); /* 4 */ + int (*tclXML_RegisterCharacterDataProc) _ANSI_ARGS_((Tcl_Interp * interp, TclXML_Info * parser, ClientData clientData, TclXML_CharacterDataProc * callback)); /* 5 */ + int (*tclXML_RegisterPIProc) _ANSI_ARGS_((Tcl_Interp * interp, TclXML_Info * parser, ClientData clientData, TclXML_PIProc * callback)); /* 6 */ + int (*tclXML_RegisterDefaultProc) _ANSI_ARGS_((Tcl_Interp * interp, TclXML_Info * parser, ClientData clientData, TclXML_DefaultProc * callback)); /* 7 */ + int (*tclXML_RegisterUnparsedProc) _ANSI_ARGS_((Tcl_Interp * interp, TclXML_Info * parser, ClientData clientData, TclXML_UnparsedProc * callback)); /* 8 */ + int (*tclXML_RegisterNotationDeclProc) _ANSI_ARGS_((Tcl_Interp * interp, TclXML_Info * parser, ClientData clientData, TclXML_NotationDeclProc * callback)); /* 9 */ + int (*tclXML_RegisterEntityProc) _ANSI_ARGS_((Tcl_Interp * interp, TclXML_Info * parser, ClientData clientData, TclXML_EntityProc * callback)); /* 10 */ + int (*tclXML_RegisterUnknownEncodingProc) _ANSI_ARGS_((Tcl_Interp * interp, TclXML_Info * parser, ClientData clientData, TclXML_UnknownEncodingProc * callback)); /* 11 */ + int (*tclXML_RegisterCommentProc) _ANSI_ARGS_((Tcl_Interp * interp, TclXML_Info * parser, ClientData clientData, TclXML_CommentProc * callback)); /* 12 */ + int (*tclXML_RegisterNotStandaloneProc) _ANSI_ARGS_((Tcl_Interp * interp, TclXML_Info * parser, ClientData clientData, TclXML_NotStandaloneProc * callback)); /* 13 */ + int (*tclXML_RegisterElementDeclProc) _ANSI_ARGS_((Tcl_Interp * interp, TclXML_Info * parser, ClientData clientData, TclXML_ElementDeclProc * callback)); /* 14 */ + int (*tclXML_RegisterAttListDeclProc) _ANSI_ARGS_((Tcl_Interp * interp, TclXML_Info * parser, ClientData clientData, TclXML_AttlistDeclProc * callback)); /* 15 */ + int (*tclXML_RegisterStartDoctypeDeclProc) _ANSI_ARGS_((Tcl_Interp * interp, TclXML_Info * parser, ClientData clientData, TclXML_StartDoctypeDeclProc * callback)); /* 16 */ + int (*tclXML_RegisterEndDoctypeDeclProc) _ANSI_ARGS_((Tcl_Interp * interp, TclXML_Info * parser, ClientData clientData, TclXML_EndDoctypeDeclProc * callback)); /* 17 */ + void (*tclXML_ElementStartHandler) _ANSI_ARGS_((void * userdata, Tcl_Obj * name, Tcl_Obj * nsuri, Tcl_Obj * atts, Tcl_Obj * nsDeclsObj)); /* 18 */ + void (*tclXML_ElementEndHandler) _ANSI_ARGS_((void * userData, Tcl_Obj * name)); /* 19 */ + void (*tclXML_CharacterDataHandler) _ANSI_ARGS_((void * userData, Tcl_Obj * s)); /* 20 */ + void (*tclXML_ProcessingInstructionHandler) _ANSI_ARGS_((void * userData, Tcl_Obj * target, Tcl_Obj * data)); /* 21 */ + int (*tclXML_ExternalEntityRefHandler) _ANSI_ARGS_((ClientData clientData, Tcl_Obj * openEntityNames, Tcl_Obj * base, Tcl_Obj * systemId, Tcl_Obj * publicId)); /* 22 */ + void (*tclXML_DefaultHandler) _ANSI_ARGS_((void * userData, Tcl_Obj * s)); /* 23 */ + void (*tclXML_UnparsedDeclHandler) _ANSI_ARGS_((void * userData, Tcl_Obj * entityname, Tcl_Obj * base, Tcl_Obj * systemId, Tcl_Obj * publicId, Tcl_Obj * notationName)); /* 24 */ + void (*tclXML_NotationDeclHandler) _ANSI_ARGS_((void * userData, Tcl_Obj * notationName, Tcl_Obj * base, Tcl_Obj * systemId, Tcl_Obj * publicId)); /* 25 */ + int (*tclXML_UnknownEncodingHandler) _ANSI_ARGS_((void * encodingHandlerData, Tcl_Obj * name, void * info)); /* 26 */ + void (*tclXML_CommentHandler) _ANSI_ARGS_((void * userData, Tcl_Obj * data)); /* 27 */ + int (*tclXML_NotStandaloneHandler) _ANSI_ARGS_((void * userData)); /* 28 */ + void *reserved29; + void *reserved30; + void (*tclXML_ElementDeclHandler) _ANSI_ARGS_((void * userData, Tcl_Obj * name, Tcl_Obj * contentspec)); /* 31 */ + void (*tclXML_AttlistDeclHandler) _ANSI_ARGS_((void * userData, Tcl_Obj * name, Tcl_Obj * attributes)); /* 32 */ + void (*tclXML_StartDoctypeDeclHandler) _ANSI_ARGS_((void * userData, Tcl_Obj * name)); /* 33 */ + void (*tclXML_EndDoctypeDeclHandler) _ANSI_ARGS_((void * userData)); /* 34 */ +} TclxmlStubs; + +#ifdef __cplusplus +extern "C" { +#endif +extern TclxmlStubs *tclxmlStubsPtr; +#ifdef __cplusplus +} +#endif + +#if defined(USE_TCLXML_STUBS) && !defined(USE_TCLXML_STUB_PROCS) + +/* + * Inline function declarations: + */ + +#ifndef Tclxml_Init +#define Tclxml_Init \ + (tclxmlStubsPtr->tclxml_Init) /* 0 */ +#endif +#ifndef Tclxml_SafeInit +#define Tclxml_SafeInit \ + (tclxmlStubsPtr->tclxml_SafeInit) /* 1 */ +#endif +#ifndef TclXML_RegisterXMLParser +#define TclXML_RegisterXMLParser \ + (tclxmlStubsPtr->tclXML_RegisterXMLParser) /* 2 */ +#endif +#ifndef TclXML_RegisterElementStartProc +#define TclXML_RegisterElementStartProc \ + (tclxmlStubsPtr->tclXML_RegisterElementStartProc) /* 3 */ +#endif +#ifndef TclXML_RegisterElementEndProc +#define TclXML_RegisterElementEndProc \ + (tclxmlStubsPtr->tclXML_RegisterElementEndProc) /* 4 */ +#endif +#ifndef TclXML_RegisterCharacterDataProc +#define TclXML_RegisterCharacterDataProc \ + (tclxmlStubsPtr->tclXML_RegisterCharacterDataProc) /* 5 */ +#endif +#ifndef TclXML_RegisterPIProc +#define TclXML_RegisterPIProc \ + (tclxmlStubsPtr->tclXML_RegisterPIProc) /* 6 */ +#endif +#ifndef TclXML_RegisterDefaultProc +#define TclXML_RegisterDefaultProc \ + (tclxmlStubsPtr->tclXML_RegisterDefaultProc) /* 7 */ +#endif +#ifndef TclXML_RegisterUnparsedProc +#define TclXML_RegisterUnparsedProc \ + (tclxmlStubsPtr->tclXML_RegisterUnparsedProc) /* 8 */ +#endif +#ifndef TclXML_RegisterNotationDeclProc +#define TclXML_RegisterNotationDeclProc \ + (tclxmlStubsPtr->tclXML_RegisterNotationDeclProc) /* 9 */ +#endif +#ifndef TclXML_RegisterEntityProc +#define TclXML_RegisterEntityProc \ + (tclxmlStubsPtr->tclXML_RegisterEntityProc) /* 10 */ +#endif +#ifndef TclXML_RegisterUnknownEncodingProc +#define TclXML_RegisterUnknownEncodingProc \ + (tclxmlStubsPtr->tclXML_RegisterUnknownEncodingProc) /* 11 */ +#endif +#ifndef TclXML_RegisterCommentProc +#define TclXML_RegisterCommentProc \ + (tclxmlStubsPtr->tclXML_RegisterCommentProc) /* 12 */ +#endif +#ifndef TclXML_RegisterNotStandaloneProc +#define TclXML_RegisterNotStandaloneProc \ + (tclxmlStubsPtr->tclXML_RegisterNotStandaloneProc) /* 13 */ +#endif +#ifndef TclXML_RegisterElementDeclProc +#define TclXML_RegisterElementDeclProc \ + (tclxmlStubsPtr->tclXML_RegisterElementDeclProc) /* 14 */ +#endif +#ifndef TclXML_RegisterAttListDeclProc +#define TclXML_RegisterAttListDeclProc \ + (tclxmlStubsPtr->tclXML_RegisterAttListDeclProc) /* 15 */ +#endif +#ifndef TclXML_RegisterStartDoctypeDeclProc +#define TclXML_RegisterStartDoctypeDeclProc \ + (tclxmlStubsPtr->tclXML_RegisterStartDoctypeDeclProc) /* 16 */ +#endif +#ifndef TclXML_RegisterEndDoctypeDeclProc +#define TclXML_RegisterEndDoctypeDeclProc \ + (tclxmlStubsPtr->tclXML_RegisterEndDoctypeDeclProc) /* 17 */ +#endif +#ifndef TclXML_ElementStartHandler +#define TclXML_ElementStartHandler \ + (tclxmlStubsPtr->tclXML_ElementStartHandler) /* 18 */ +#endif +#ifndef TclXML_ElementEndHandler +#define TclXML_ElementEndHandler \ + (tclxmlStubsPtr->tclXML_ElementEndHandler) /* 19 */ +#endif +#ifndef TclXML_CharacterDataHandler +#define TclXML_CharacterDataHandler \ + (tclxmlStubsPtr->tclXML_CharacterDataHandler) /* 20 */ +#endif +#ifndef TclXML_ProcessingInstructionHandler +#define TclXML_ProcessingInstructionHandler \ + (tclxmlStubsPtr->tclXML_ProcessingInstructionHandler) /* 21 */ +#endif +#ifndef TclXML_ExternalEntityRefHandler +#define TclXML_ExternalEntityRefHandler \ + (tclxmlStubsPtr->tclXML_ExternalEntityRefHandler) /* 22 */ +#endif +#ifndef TclXML_DefaultHandler +#define TclXML_DefaultHandler \ + (tclxmlStubsPtr->tclXML_DefaultHandler) /* 23 */ +#endif +#ifndef TclXML_UnparsedDeclHandler +#define TclXML_UnparsedDeclHandler \ + (tclxmlStubsPtr->tclXML_UnparsedDeclHandler) /* 24 */ +#endif +#ifndef TclXML_NotationDeclHandler +#define TclXML_NotationDeclHandler \ + (tclxmlStubsPtr->tclXML_NotationDeclHandler) /* 25 */ +#endif +#ifndef TclXML_UnknownEncodingHandler +#define TclXML_UnknownEncodingHandler \ + (tclxmlStubsPtr->tclXML_UnknownEncodingHandler) /* 26 */ +#endif +#ifndef TclXML_CommentHandler +#define TclXML_CommentHandler \ + (tclxmlStubsPtr->tclXML_CommentHandler) /* 27 */ +#endif +#ifndef TclXML_NotStandaloneHandler +#define TclXML_NotStandaloneHandler \ + (tclxmlStubsPtr->tclXML_NotStandaloneHandler) /* 28 */ +#endif +/* Slot 29 is reserved */ +/* Slot 30 is reserved */ +#ifndef TclXML_ElementDeclHandler +#define TclXML_ElementDeclHandler \ + (tclxmlStubsPtr->tclXML_ElementDeclHandler) /* 31 */ +#endif +#ifndef TclXML_AttlistDeclHandler +#define TclXML_AttlistDeclHandler \ + (tclxmlStubsPtr->tclXML_AttlistDeclHandler) /* 32 */ +#endif +#ifndef TclXML_StartDoctypeDeclHandler +#define TclXML_StartDoctypeDeclHandler \ + (tclxmlStubsPtr->tclXML_StartDoctypeDeclHandler) /* 33 */ +#endif +#ifndef TclXML_EndDoctypeDeclHandler +#define TclXML_EndDoctypeDeclHandler \ + (tclxmlStubsPtr->tclXML_EndDoctypeDeclHandler) /* 34 */ +#endif + +#endif /* defined(USE_TCLXML_STUBS) && !defined(USE_TCLXML_STUB_PROCS) */ + +/* !END!: Do not edit above this line. */ + +#endif /* _TCLXMLDECLS */ + diff --git a/tclxmlStubInit.c b/tclxmlStubInit.c new file mode 100644 index 0000000..2c6db27 --- /dev/null +++ b/tclxmlStubInit.c @@ -0,0 +1,60 @@ +/* + * tclxmlStubInit.c -- + */ + +#include + +/* + * Remove macros that will interfere with the definitions below. + */ + + +/* + * WARNING: The contents of this file is automatically generated by the + * genStubs.tcl script. Any modifications to the function declarations + * below should be made in the tclxml.decls script. + */ + +/* !BEGIN!: Do not edit below this line. */ + +TclxmlStubs tclxmlStubs = { + TCL_STUB_MAGIC, + NULL, + Tclxml_Init, /* 0 */ + Tclxml_SafeInit, /* 1 */ + TclXML_RegisterXMLParser, /* 2 */ + TclXML_RegisterElementStartProc, /* 3 */ + TclXML_RegisterElementEndProc, /* 4 */ + TclXML_RegisterCharacterDataProc, /* 5 */ + TclXML_RegisterPIProc, /* 6 */ + TclXML_RegisterDefaultProc, /* 7 */ + TclXML_RegisterUnparsedProc, /* 8 */ + TclXML_RegisterNotationDeclProc, /* 9 */ + TclXML_RegisterEntityProc, /* 10 */ + TclXML_RegisterUnknownEncodingProc, /* 11 */ + TclXML_RegisterCommentProc, /* 12 */ + TclXML_RegisterNotStandaloneProc, /* 13 */ + TclXML_RegisterElementDeclProc, /* 14 */ + TclXML_RegisterAttListDeclProc, /* 15 */ + TclXML_RegisterStartDoctypeDeclProc, /* 16 */ + TclXML_RegisterEndDoctypeDeclProc, /* 17 */ + TclXML_ElementStartHandler, /* 18 */ + TclXML_ElementEndHandler, /* 19 */ + TclXML_CharacterDataHandler, /* 20 */ + TclXML_ProcessingInstructionHandler, /* 21 */ + TclXML_ExternalEntityRefHandler, /* 22 */ + TclXML_DefaultHandler, /* 23 */ + TclXML_UnparsedDeclHandler, /* 24 */ + TclXML_NotationDeclHandler, /* 25 */ + TclXML_UnknownEncodingHandler, /* 26 */ + TclXML_CommentHandler, /* 27 */ + TclXML_NotStandaloneHandler, /* 28 */ + NULL, /* 29 */ + NULL, /* 30 */ + TclXML_ElementDeclHandler, /* 31 */ + TclXML_AttlistDeclHandler, /* 32 */ + TclXML_StartDoctypeDeclHandler, /* 33 */ + TclXML_EndDoctypeDeclHandler, /* 34 */ +}; + +/* !END!: Do not edit above this line. */ diff --git a/tclxmlStubLib.c b/tclxmlStubLib.c new file mode 100644 index 0000000..b376329 --- /dev/null +++ b/tclxmlStubLib.c @@ -0,0 +1,71 @@ +/* + * tclxmlStubLib.c -- + * + * Stub object that will be statically linked into extensions that wish + * to access the TCLXML API. + * + * Copyright (c) 1998 Paul Duffin. + * Copyright (c) 1998-1999 by Scriptics Corporation. + * Copyright (c) 2004 Zveno Pty Ltd. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: tclxmlStubLib.c,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $ + */ + +#ifndef USE_TCL_STUBS +#define USE_TCL_STUBS +#endif + +#include + +TclxmlStubs *tclxmlStubsPtr; + +/* + *---------------------------------------------------------------------- + * + * TclXML_InitStubs -- + * + * Checks that the correct version of Blt is loaded and that it + * supports stubs. It then initialises the stub table pointers. + * + * Results: + * The actual version of BLT that satisfies the request, or + * NULL to indicate that an error occurred. + * + * Side effects: + * Sets the stub table pointers. + * + *---------------------------------------------------------------------- + */ + +CONST char * +TclXML_InitStubs(interp, version, exact) + Tcl_Interp *interp; + CONST char *version; + int exact; +{ + CONST char *result; + + /* HACK: de-CONST 'version' if compiled against 8.3. + * The API has no CONST despite not modifying the argument + * And a debug build with high warning-level on windows + * will abort the compilation. + */ + +#if ((TCL_MAJOR_VERSION < 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION < 4))) +#define UNCONST (char*) +#else +#define UNCONST +#endif + + result = Tcl_PkgRequireEx(interp, "xml::c", UNCONST version, exact, + (ClientData *) &tclxmlStubsPtr); + if (!result || !tclxmlStubsPtr) { + return (char *) NULL; + } + + return result; +} +#undef UNCONST diff --git a/tclxslt-libxslt.c b/tclxslt-libxslt.c new file mode 100644 index 0000000..73e0f61 --- /dev/null +++ b/tclxslt-libxslt.c @@ -0,0 +1,1872 @@ +/* + * tclxslt.c -- + * + * Interface to Gnome libxslt. + * + * Copyright (c) 2005-2007 Explain + * http://www.explain.com.au/ + * Copyright (c) 2001-2004 Zveno Pty Ltd + * http://www.zveno.com/ + * + * See the file "LICENSE" for information on usage and + * redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * $Id: tclxslt-libxslt.c,v 1.2 2016/01/15 21:06:01 joye Exp $ + * + */ + +#include +#include +#include +#include + +#undef TCL_STORAGE_CLASS +#define TCL_STORAGE_CLASS DLLEXPORT + +#ifdef __WIN32__ +/*# include "win/win32config.h"*/ +#endif + +/* + * Manage stylesheet objects + */ + +typedef struct TclXSLT_Stylesheet { + Tcl_Interp *interp; + char *name; + xsltStylesheetPtr stylesheet; + Tcl_HashEntry *entryPtr; + + Tcl_Obj *resulturi; + Tcl_Obj *profilechannelObj; + + Tcl_Obj *messagecommand; +} TclXSLT_Stylesheet; + +/* + * Extension management + */ + +typedef struct TclXSLT_Extension { + Tcl_Interp *interp; + Tcl_Obj *nsuri; + Tcl_Obj *tclns; + xsltTransformContextPtr xformCtxt; +} TclXSLT_Extension; + +typedef struct ThreadSpecificData { + int initialised; + Tcl_Interp *interp; + int ssheetCntr; + Tcl_HashTable *stylesheets; + Tcl_HashTable *extensions; +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; + +/* + * Prototypes for procedures defined later in this file: + */ + +/* + * Forward declarations for private functions. + */ + +static void TclXSLTGenericError _ANSI_ARGS_((void *ctx, const char *msg, ...)); + +static int TclXSLTCompileCommand _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST objv[])); +static int TclXSLTInstanceCommand _ANSI_ARGS_((ClientData ssheet, + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST objv[])); +static void TclXSLTDeleteStylesheet _ANSI_ARGS_((ClientData ssheet)); +static int TclXSLTExtensionCommand _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST objv[])); + +static Tcl_Obj * GetParameters _ANSI_ARGS_((Tcl_Interp *interp, + xsltStylesheetPtr stylesheet)); +static int TclXSLTTransform _ANSI_ARGS_((TclXSLT_Stylesheet *stylesheet, + Tcl_Obj *source, + int paramc, + Tcl_Obj *CONST paramv[])); + +static void TclXSLT_RegisterAll _ANSI_ARGS_((TclXSLT_Extension *extinfo, + const xmlChar *nsuri)); + +/* static xsltExtInitFunction TclXSLTExtInit; */ +static void *TclXSLTExtInit _ANSI_ARGS_((xsltTransformContextPtr ctxt, + const xmlChar *URI)); +/* static xsltExtShutdownFunction TclXSLTExtShutdown; */ +static void TclXSLTExtShutdown _ANSI_ARGS_((xsltTransformContextPtr ctxt, + const xmlChar *URI, + void *userdata)); +/* static xmlXPathEvalFunc TclXSLTExtFunction; */ +static void TclXSLTExtFunction _ANSI_ARGS_((xmlXPathParserContextPtr xpathCtxt, + int nargs)); +/* static xsltPreComputeFunction TclXSLTExtElementPreComp; */ +static void TclXSLTExtElementPreComp _ANSI_ARGS_((xsltStylesheetPtr style, + xmlNodePtr inst, + xsltTransformFunction function)); +/* static xsltTransformFunction TclXSLTExtElementTransform; */ +static void TclXSLTExtElementTransform _ANSI_ARGS_((xsltTransformContextPtr ctxt, + xmlNodePtr node, + xmlNodePtr inst, + xsltStylePreCompPtr comp)); +/* static xsltSecurityCheck TclXSLTSecurityReadFile; */ +static int TclXSLTSecurityReadFile _ANSI_ARGS_((xsltSecurityPrefsPtr sec, + xsltTransformContextPtr ctxt, + const char *value)); +/* static xsltSecurityCheck TclXSLTSecurityWriteFile; */ +static int TclXSLTSecurityWriteFile _ANSI_ARGS_((xsltSecurityPrefsPtr sec, + xsltTransformContextPtr ctxt, + const char *value)); +/* static xsltSecurityCheck TclXSLTSecurityCreateDirectory; */ +static int TclXSLTSecurityCreateDirectory _ANSI_ARGS_((xsltSecurityPrefsPtr sec, + xsltTransformContextPtr ctxt, + const char *value)); +/* static xsltSecurityCheck TclXSLTSecurityReadNetwork; */ +static int TclXSLTSecurityReadNetwork _ANSI_ARGS_((xsltSecurityPrefsPtr sec, + xsltTransformContextPtr ctxt, + const char *value)); +/* static xsltSecurityCheck TclXSLTSecurityWriteNetwork; */ +static int TclXSLTSecurityWriteNetwork _ANSI_ARGS_((xsltSecurityPrefsPtr sec, + xsltTransformContextPtr ctxt, + const char *value)); + +static Tcl_Obj * TclXSLT_ConvertXPathObjToTclObj _ANSI_ARGS_((Tcl_Interp *interp, + xmlXPathObjectPtr xpobj)); +static xmlXPathObjectPtr TclXSLT_ConvertTclObjToXPathObj _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Obj *objPtr)); + +/* + * Error context for passing error result back to caller. + */ + +typedef struct GenericError_Info { + Tcl_Interp *interp; + TclXSLT_Stylesheet *stylesheet; + int code; + Tcl_Obj *msg; +} GenericError_Info; + +/* + * Switch tables + */ + +#ifndef CONST84 +#define CONST84 /* Before 8.4 no 'const' required */ +#endif + +static CONST84 char *instanceCommandMethods[] = { + "cget", + "configure", + "get", + "transform", + (char *) NULL +}; +enum instanceCommandMethods { + TCLXSLT_CGET, + TCLXSLT_CONFIGURE, + TCLXSLT_GET, + TCLXSLT_TRANSFORM +}; +static CONST84 char *instanceCommandOptions[] = { + "-messagecommand", + "-method", + "-indent", + "-resulturi", + "-profilechannel", + "-encoding", + "-omitxmldeclaration", + (char *) NULL +}; +enum instanceCommandOptions { + TCLXSLT_OPTION_MESSAGECOMMAND, + TCLXSLT_OPTION_METHOD, + TCLXSLT_OPTION_INDENT, + TCLXSLT_OPTION_RESULTURI, + TCLXSLT_OPTION_PROFILECHANNEL, + TCLXSLT_OPTION_ENCODING, + TCLXSLT_OPTION_OMITXMLDECLARATION +}; + +static CONST84 char *instanceGetMethods[] = { + "parameters", + (char *) NULL +}; +enum instanceGetMethods { + TCLXSLT_GET_PARAMETERS +}; + +static CONST84 char *extensionCommandMethods[] = { + "add", + "remove", + (char *) NULL +}; +enum extensionCommandMethods { + TCLXSLT_EXT_ADD, + TCLXSLT_EXT_REMOVE +}; + +/* + * libxml2 and libxslt are mostly thread-safe, + * but there are issues with error callbacks. + */ + +TCL_DECLARE_MUTEX(libxslt) + +/* + *---------------------------------------------------------------------------- + * + * Tclxslt_libxslt_Init -- + * + * Initialisation routine for loadable module + * + * Results: + * None. + * + * Side effects: + * Creates commands in the interpreter, + * + *---------------------------------------------------------------------------- + */ + +int +Tclxslt_libxslt_Init (interp) + Tcl_Interp *interp; /* Interpreter to initialise */ +{ + ThreadSpecificData *tsdPtr; + xsltSecurityPrefsPtr sec; + + tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + if (!tsdPtr->initialised) { + tsdPtr->initialised = 1; + tsdPtr->interp = interp; + tsdPtr->ssheetCntr = 0; + tsdPtr->stylesheets = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable)); + Tcl_InitHashTable(tsdPtr->stylesheets, TCL_ONE_WORD_KEYS); + tsdPtr->extensions = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable)); + Tcl_InitHashTable(tsdPtr->extensions, TCL_STRING_KEYS); + } /* only need to init the library once per process */ + + Tcl_CreateObjCommand(interp, "xslt::compile", TclXSLTCompileCommand, NULL, NULL); + Tcl_CreateObjCommand(interp, "xslt::extension", TclXSLTExtensionCommand, NULL, NULL); + + Tcl_MutexLock(&libxslt); +#ifndef TCLXML_STATIC_TCLXSLT + exsltRegisterAll(); +#endif /* TCLXML_STATIC_TCLXSLT */ + + /* + * Setup security preferences + */ + sec = xsltNewSecurityPrefs(); + if (xsltSetSecurityPrefs(sec, XSLT_SECPREF_READ_FILE, + TclXSLTSecurityReadFile)) { + Tcl_SetResult(interp, "unable to set readfile security", NULL); + return TCL_ERROR; + } + if (xsltSetSecurityPrefs(sec, XSLT_SECPREF_WRITE_FILE, + TclXSLTSecurityWriteFile)) { + Tcl_SetResult(interp, "unable to set writefile security", NULL); + return TCL_ERROR; + } + if (xsltSetSecurityPrefs(sec, XSLT_SECPREF_CREATE_DIRECTORY, + TclXSLTSecurityCreateDirectory)) { + Tcl_SetResult(interp, "unable to set createdirectory security", NULL); + return TCL_ERROR; + } + if (xsltSetSecurityPrefs(sec, XSLT_SECPREF_READ_NETWORK, + TclXSLTSecurityReadNetwork)) { + Tcl_SetResult(interp, "unable to set readnetwork security", NULL); + return TCL_ERROR; + } + if (xsltSetSecurityPrefs(sec, XSLT_SECPREF_WRITE_NETWORK, + TclXSLTSecurityWriteNetwork)) { + Tcl_SetResult(interp, "unable to set writenetwork security", NULL); + return TCL_ERROR; + } + /* xsltSetCtxtSecurityPrefs(sec, userCtxt); */ + xsltSetDefaultSecurityPrefs(sec); + + Tcl_MutexUnlock(&libxslt); + + Tcl_SetVar2Ex(interp, "::xslt::libxsltversion", NULL, Tcl_NewStringObj(xsltEngineVersion, -1), 0); + Tcl_SetVar2Ex(interp, "::xslt::libexsltversion", NULL, Tcl_NewStringObj(exsltLibraryVersion, -1), 0); + + return TCL_OK; +} + +/* + * XSLT is not safe due to the document(), xsl:include and xsl:import functions/elements. + * However, libxslt checks whether access is permitted to external resources. + * + * NOTE: need to make sure decision to allow access to resources is made by a trusted interpreter, not the untrusted slave. Even better, use a mechanism similar to TclXML/libxml2 to access external resources. + */ + +int +Tclxslt_libxslt_SafeInit (interp) + Tcl_Interp *interp; /* Interpreter to initialise */ +{ + return Tclxslt_libxslt_Init(interp); +} + +/* + *---------------------------------------------------------------------------- + * + * TclXSLTCompileCommand -- + * + * Class creation command for xslt stylesheet objects. + * + * Results: + * Compiles the XSLT stylesheet. + * Creates a Tcl command associated with that stylesheet. + * + * Side effects: + * Memory allocated, stylesheet is compiled. + * + *---------------------------------------------------------------------------- + */ + +static int +TclXSLTCompileCommand(dummy, interp, objc, objv) + ClientData dummy; + Tcl_Interp *interp; + int objc; + Tcl_Obj *CONST objv[]; +{ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + TclXSLT_Stylesheet *info; + xmlDocPtr origDoc, doc; + xsltStylesheetPtr ssheetPtr = NULL; + void *oldxsltErrorCtx, *oldxmlErrorCtx; + xmlGenericErrorFunc old_xsltGenericError, old_xmlGenericError; + GenericError_Info *errorInfoPtr; + Tcl_Obj *errObjPtr = NULL; + int new; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "stylesheet-doc"); + return TCL_ERROR; + } + + if (TclXML_libxml2_GetDocFromObj(interp, objv[1], &origDoc) != TCL_OK) { + return TCL_ERROR; + } + + Tcl_MutexLock(&libxslt); + doc = xmlCopyDoc(origDoc, 1); + /* + * xmlCopyDoc doesn't copy some of the fields. + */ + if (origDoc->URL) { + doc->URL = (const xmlChar *) Tcl_Alloc(strlen((char *) origDoc->URL) + 1); + strcpy((char *) doc->URL, (char *) origDoc->URL); + } + + /* + * Prepare for compiling stylesheet + */ + + TclXML_libxml2_ResetError(interp); + + errorInfoPtr = (GenericError_Info *) Tcl_Alloc(sizeof(GenericError_Info)); + errorInfoPtr->interp = interp; + errorInfoPtr->stylesheet = NULL; + errorInfoPtr->code = TCL_OK; + errorInfoPtr->msg = NULL; + xmlSetGenericErrorFunc((void *) errorInfoPtr, + TclXSLTGenericError); + + /* + * Save the previous error context so that it can + * be restored upon completion of the operation. + */ + old_xsltGenericError = xsltGenericError; + oldxsltErrorCtx = xsltGenericErrorContext; + old_xmlGenericError = xmlGenericError; + oldxmlErrorCtx = xmlGenericErrorContext; + + xmlSetGenericErrorFunc((void *) errorInfoPtr, + TclXSLTGenericError); + xsltSetGenericErrorFunc((void *) errorInfoPtr, TclXSLTGenericError); + + /* + * Compile stylesheet + */ + + ssheetPtr = xsltParseStylesheetDoc(doc); + + xmlSetGenericErrorFunc((void *) oldxmlErrorCtx, old_xmlGenericError); + xsltSetGenericErrorFunc((void *) oldxsltErrorCtx, old_xsltGenericError); + + Tcl_MutexUnlock(&libxslt); + + errObjPtr = TclXML_libxml2_GetErrorObj(interp); + + if (ssheetPtr == NULL) { + Tcl_SetResult(interp, "error compiling stylesheet", NULL); + goto error; + } + + if (ssheetPtr->errors > 0) { + Tcl_SetResult(interp, "error compiling XSLT stylesheet", NULL); + goto error; + } + + if (errorInfoPtr->code != TCL_OK) { + goto error; + } + + /* TODO: notify app of any warnings */ + + info = (TclXSLT_Stylesheet *) Tcl_Alloc(sizeof(TclXSLT_Stylesheet)); + info->interp = interp; + info->name = Tcl_Alloc(20); + sprintf(info->name, "style%d", tsdPtr->ssheetCntr++); + info->stylesheet = ssheetPtr; + info->messagecommand = NULL; + info->resulturi = NULL; + info->profilechannelObj = NULL; + + /* + * Create reverse mapping of stylesheet to name of stylesheet command. + */ + info->entryPtr = Tcl_CreateHashEntry(tsdPtr->stylesheets, (ClientData) ssheetPtr, &new); + /* sanity check: new == 1 */ + Tcl_SetHashValue(info->entryPtr, (ClientData) info->name); + + Tcl_CreateObjCommand(interp, info->name, TclXSLTInstanceCommand, (ClientData) info, TclXSLTDeleteStylesheet); + + Tcl_SetObjResult(interp, Tcl_NewStringObj(info->name, -1)); + + return TCL_OK; + +error: + + if (errObjPtr) { + Tcl_SetObjResult(interp, errObjPtr); + } else if (errorInfoPtr->msg) { + Tcl_SetObjResult(interp, errorInfoPtr->msg); + Tcl_DecrRefCount(errorInfoPtr->msg); + } + Tcl_Free((char *) errorInfoPtr); + + Tcl_MutexLock(&libxslt); + if (ssheetPtr) { + xsltFreeStylesheet(ssheetPtr); + } else { + xmlFreeDoc(doc); + } + Tcl_MutexUnlock(&libxslt); + + return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXSLTDeleteStylesheet -- + * + * Class destruction command for xslt stylesheet objects. + * + * Results: + * Frees memory associated with a stylesheet. + * + * Side effects: + * Memory deallocated. + * + *---------------------------------------------------------------------------- + */ + +static void +TclXSLTDeleteStylesheet(clientData) + ClientData clientData; +{ + TclXSLT_Stylesheet *ssheet = (TclXSLT_Stylesheet *) clientData; + + Tcl_DeleteHashEntry(ssheet->entryPtr); + + Tcl_Free(ssheet->name); + if (ssheet->messagecommand) { + Tcl_DecrRefCount(ssheet->messagecommand); + } + if (ssheet->resulturi) { + Tcl_DecrRefCount(ssheet->resulturi); + } + if (ssheet->profilechannelObj) { + Tcl_DecrRefCount(ssheet->profilechannelObj); + } + Tcl_MutexLock(&libxslt); + xsltFreeStylesheet(ssheet->stylesheet); /* Also frees document */ + Tcl_MutexUnlock(&libxslt); + Tcl_Free((char *) ssheet); +} + +/* + *---------------------------------------------------------------------------- + * + * TclXSLTInstanceCommand -- + * + * Handles the stylesheet object command. + * + * Results: + * Depends on method. + * + * Side effects: + * Depends on method. + * + *---------------------------------------------------------------------------- + */ + +static int +TclXSLTInstanceCommand(clientData, interp, objc, objv) + ClientData clientData; + Tcl_Interp *interp; + int objc; + Tcl_Obj *CONST objv[]; +{ + TclXSLT_Stylesheet *ssheet = (TclXSLT_Stylesheet *) clientData; + int method, option, indent = 0, theOmitXMLDeclaration = 0; + const xmlChar *theMethod, *theEncoding; + + if (objc < 3) { + Tcl_WrongNumArgs(interp, 1, objv, "method ?args ...?"); + return TCL_ERROR; + } + + if (Tcl_GetIndexFromObj(interp, objv[1], instanceCommandMethods, + "method", 0, &method) != TCL_OK) { + return TCL_ERROR; + } + + switch ((enum instanceCommandMethods) method) { + case TCLXSLT_CGET: + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "option"); + return TCL_ERROR; + } + + if (Tcl_GetIndexFromObj(interp, objv[2], instanceCommandOptions, + "option", 0, &option) != TCL_OK) { + return TCL_ERROR; + } + + switch ((enum instanceCommandOptions) option) { + + case TCLXSLT_OPTION_METHOD: + XSLT_GET_IMPORT_PTR(theMethod, ssheet->stylesheet, method); + if (theMethod != NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj((CONST char *) theMethod, -1)); + } /* theMethod == NULL means XML method; result should be empty. + EXCEPTION: if the result document is of type XML_HTML_DOCUMENT_NODE + then the method should be "html". + */ + break; + + case TCLXSLT_OPTION_ENCODING: + XSLT_GET_IMPORT_PTR(theEncoding, ssheet->stylesheet, encoding); + if (theEncoding != NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj((CONST char *) theEncoding, -1)); + } /* theEncoding == NULL means default (UTF-8) encoding; result should be empty. + */ + break; + + case TCLXSLT_OPTION_OMITXMLDECLARATION: + XSLT_GET_IMPORT_INT(theOmitXMLDeclaration, ssheet->stylesheet, omitXmlDeclaration); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(theOmitXMLDeclaration == 1)); + break; + + case TCLXSLT_OPTION_INDENT: + XSLT_GET_IMPORT_INT(indent, ssheet->stylesheet, indent); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(indent)); + break; + + case TCLXSLT_OPTION_MESSAGECOMMAND: + if (ssheet->messagecommand != NULL) { + Tcl_SetObjResult(interp, ssheet->messagecommand); + } + break; + + case TCLXSLT_OPTION_RESULTURI: + if (ssheet->resulturi != NULL) { + Tcl_SetObjResult(interp, ssheet->resulturi); + } + break; + + case TCLXSLT_OPTION_PROFILECHANNEL: + if (ssheet->profilechannelObj != NULL) { + Tcl_SetObjResult(interp, ssheet->profilechannelObj); + } + break; + + default: + Tcl_SetResult(interp, "unknown option", NULL); + return TCL_ERROR; + } + + break; + + case TCLXSLT_CONFIGURE: + + if (objc != 4) { + Tcl_WrongNumArgs(interp, 2, objv, "option value"); + return TCL_ERROR; + } + + if (Tcl_GetIndexFromObj(interp, objv[2], instanceCommandOptions, + "option", 0, &option) != TCL_OK) { + return TCL_ERROR; + } + + switch ((enum instanceCommandOptions) option) { + + case TCLXSLT_OPTION_METHOD: + case TCLXSLT_OPTION_INDENT: + case TCLXSLT_OPTION_ENCODING: + case TCLXSLT_OPTION_OMITXMLDECLARATION: + Tcl_SetResult(interp, "read-only option", NULL); + return TCL_ERROR; + break; + + case TCLXSLT_OPTION_MESSAGECOMMAND: + if (ssheet->messagecommand != NULL) { + Tcl_DecrRefCount(ssheet->messagecommand); + } + ssheet->messagecommand = objv[3]; + Tcl_IncrRefCount(ssheet->messagecommand); + break; + + case TCLXSLT_OPTION_RESULTURI: + if (ssheet->resulturi != NULL) { + Tcl_DecrRefCount(ssheet->resulturi); + } + ssheet->resulturi = objv[3]; + Tcl_IncrRefCount(ssheet->resulturi); + break; + + case TCLXSLT_OPTION_PROFILECHANNEL: + if (ssheet->profilechannelObj != NULL) { + Tcl_DecrRefCount(ssheet->profilechannelObj); + } +#ifdef __WIN32__ + Tcl_SetResult(interp, "profiling not available", NULL); + return TCL_ERROR; +#else + ssheet->profilechannelObj = objv[3]; + Tcl_IncrRefCount(ssheet->profilechannelObj); +#endif + break; + + default: + Tcl_SetResult(interp, "unknown option", NULL); + return TCL_ERROR; + } + + break; + + case TCLXSLT_GET: + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "name"); + return TCL_ERROR; + } + + if (Tcl_GetIndexFromObj(interp, objv[2], instanceGetMethods, + "name", 0, &option) != TCL_OK) { + return TCL_ERROR; + } + + switch ((enum instanceGetMethods) option) { + case TCLXSLT_GET_PARAMETERS: + + Tcl_SetObjResult(interp, GetParameters(interp, ssheet->stylesheet)); + break; + + default: + Tcl_SetResult(interp, "unknown name", NULL); + return TCL_ERROR; + } + + break; + + case TCLXSLT_TRANSFORM: + if (objc < 3) { + Tcl_WrongNumArgs(interp, 2, objv, "source ?param value...?"); + return TCL_ERROR; + } + + return TclXSLTTransform(ssheet, objv[2], objc - 3, &objv[3]); + + break; + + default: + Tcl_SetResult(interp, "unknown method", NULL); + return TCL_OK; + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXSLTTransform -- + * + * Performs an XSL transformation. + * + * Results: + * Result document created. + * + * Side effects: + * Memory allocated for result document. + * + *---------------------------------------------------------------------------- + */ + +static int +TclXSLTTransform(stylesheet, source, paramc, paramv) + TclXSLT_Stylesheet *stylesheet; + Tcl_Obj *source; + int paramc; + Tcl_Obj *CONST paramv[]; +{ + xmlDocPtr doc, result; + char **params = NULL; + int nbparams = 0, i; + GenericError_Info *errorInfoPtr; + void *oldxsltErrorCtx, *oldxmlErrorCtx; + xmlGenericErrorFunc old_xsltGenericError, old_xmlGenericError; + Tcl_Obj *resultObjPtr, *errObjPtr = NULL; + char *resulturi = NULL; + FILE *profile = NULL; + xsltTransformContextPtr userCtxt = NULL; + + errorInfoPtr = (GenericError_Info *) Tcl_Alloc(sizeof(GenericError_Info)); + errorInfoPtr->interp = stylesheet->interp; + errorInfoPtr->stylesheet = stylesheet; + errorInfoPtr->code = TCL_OK; + errorInfoPtr->msg = NULL; + + if (TclXML_libxml2_GetDocFromObj(stylesheet->interp, source, &doc) != TCL_OK) { + goto error; + } + + TclXML_libxml2_ResetError(stylesheet->interp); + + params = (char **) Tcl_Alloc(sizeof(char **) * (paramc + 1)); + for (i = 0; i < paramc; i++) { + params[nbparams++] = Tcl_GetStringFromObj(paramv[i++], NULL); + params[nbparams++] = Tcl_GetStringFromObj(paramv[i], NULL); + } + params[nbparams] = NULL; + + if (stylesheet->resulturi) { + resulturi = Tcl_GetStringFromObj(stylesheet->resulturi, NULL); + } +#ifdef __WIN32__ + /* Tcl_GetOpenFile not available on Windows */ +#else + if (stylesheet->profilechannelObj) { + if (Tcl_GetOpenFile(stylesheet->interp, + Tcl_GetStringFromObj(stylesheet->profilechannelObj, NULL), + 1, 1, + (ClientData *) &profile) != TCL_OK) { + goto error; + } + } +#endif + + /* + * Perform the transformation + */ + + Tcl_MutexLock(&libxslt); + + /* + * Save the previous error context so that it can + * be restored upon completion of the transformation. + * This is necessary because transformations may occur + * recursively (usually due to extensions). + */ + old_xsltGenericError = xsltGenericError; + oldxsltErrorCtx = xsltGenericErrorContext; + old_xmlGenericError = xmlGenericError; + oldxmlErrorCtx = xmlGenericErrorContext; + + xmlSetGenericErrorFunc((void *) errorInfoPtr, + TclXSLTGenericError); + xsltSetGenericErrorFunc((void *) errorInfoPtr, TclXSLTGenericError); + + userCtxt = xsltNewTransformContext(stylesheet->stylesheet, doc); + if (userCtxt == NULL) { + xmlSetGenericErrorFunc((void *) oldxmlErrorCtx, old_xmlGenericError); + xsltSetGenericErrorFunc((void *) oldxsltErrorCtx, old_xsltGenericError); + + Tcl_MutexUnlock(&libxslt); + Tcl_SetResult(stylesheet->interp, "unable to create transformation context", NULL); + goto error; + } + + result = xsltApplyStylesheetUser(stylesheet->stylesheet, + doc, + (const char **)params, + resulturi, + profile, + userCtxt); + + xsltFreeTransformContext(userCtxt); + + xmlSetGenericErrorFunc((void *) oldxmlErrorCtx, old_xmlGenericError); + xsltSetGenericErrorFunc((void *) oldxsltErrorCtx, old_xsltGenericError); + + Tcl_MutexUnlock(&libxslt); + + errObjPtr = TclXML_libxml2_GetErrorObj(stylesheet->interp); + + if (result == NULL) { + Tcl_Obj *resultPtr = Tcl_NewStringObj("no result document: ", -1); + + if (errObjPtr) { + Tcl_AppendObjToObj(resultPtr, errObjPtr); + Tcl_SetObjResult(stylesheet->interp, resultPtr); + goto error; + } else { + if (errorInfoPtr->msg) { + Tcl_AppendObjToObj(resultPtr, errorInfoPtr->msg); + } + + Tcl_SetObjResult(stylesheet->interp, resultPtr); + goto error; + } + } + + if ((errObjPtr || (errorInfoPtr->code != TCL_OK && errorInfoPtr->msg)) && stylesheet->messagecommand) { + + /* We have produced a result, but there may possibly + * have been errors. Trouble is, there might also + * have been some completely innocent messages. + * -messageCommand is the only way to find out about these. + */ + + Tcl_Obj *cmdPtr = Tcl_DuplicateObj(stylesheet->messagecommand); + if (errObjPtr) { + if (Tcl_ListObjAppendElement(stylesheet->interp, cmdPtr, errObjPtr) != TCL_OK) { + goto error; + } + } else { + if (Tcl_ListObjAppendElement(stylesheet->interp, cmdPtr, errorInfoPtr->msg) != TCL_OK) { + goto error; + } + } + if (Tcl_GlobalEvalObj(stylesheet->interp, cmdPtr) != TCL_OK) { + Tcl_Obj *resultPtr = Tcl_NewStringObj("message command failed: ", -1); + + Tcl_AppendObjToObj(resultPtr, Tcl_GetObjResult(stylesheet->interp)); + Tcl_SetObjResult(stylesheet->interp, resultPtr); + goto error; + } + + } + + resultObjPtr = TclDOM_libxml2_CreateObjFromDoc(stylesheet->interp, result); + Tcl_SetObjResult(stylesheet->interp, resultObjPtr); + + if (errorInfoPtr->msg) { + Tcl_DecrRefCount(errorInfoPtr->msg); + } + Tcl_Free((char *) errorInfoPtr); + Tcl_Free((char *) params); + + return TCL_OK; + + error: + + if (errorInfoPtr->msg) { + Tcl_DecrRefCount(errorInfoPtr->msg); + } + if (params) { + Tcl_Free((char *) params); + } + Tcl_Free((char *) errorInfoPtr); + + return TCL_ERROR; +} + +void +ListObjAppendUniqueList(interp, tablePtr, listPtr, newElementsPtr) + Tcl_Interp *interp; + Tcl_HashTable *tablePtr; + Tcl_Obj *listPtr; + Tcl_Obj *newElementsPtr; +{ + int len, idx; + Tcl_Obj *elementPtr, *keyPtr, *namePtr, *nameURIPtr; + Tcl_HashEntry *entryPtr; + + Tcl_ListObjLength(interp, newElementsPtr, &len); + for (idx = 0; idx < len; idx++) { + Tcl_ListObjIndex(interp, newElementsPtr, idx, &elementPtr); + Tcl_ListObjIndex(interp, elementPtr, 0, &namePtr); + Tcl_ListObjIndex(interp, elementPtr, 1, &nameURIPtr); + + keyPtr = Tcl_NewObj(); + Tcl_AppendStringsToObj(keyPtr, + Tcl_GetStringFromObj(nameURIPtr, NULL), + "^", + Tcl_GetStringFromObj(namePtr, NULL), + NULL); + entryPtr = Tcl_FindHashEntry(tablePtr, (CONST char *) keyPtr); + if (entryPtr == NULL) { + Tcl_ListObjAppendElement(interp, listPtr, elementPtr); + } + Tcl_DecrRefCount(keyPtr); + } +} + +/* + *---------------------------------------------------------------------------- + * + * GetParameters -- + * + * Retrieves the parameters for a stylesheet. + * + * Results: + * Returns a Tcl list object. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------------- + */ + +static Tcl_Obj * +GetParameters(interp, stylesheet) + Tcl_Interp *interp; + xsltStylesheetPtr stylesheet; +{ + Tcl_Obj *resultPtr, *objPtr, *keyPtr; + xsltStackElemPtr varPtr; + Tcl_HashTable entries; /* to keep track of parameter qnames */ + int new; + + if (stylesheet == NULL) { + return NULL; + } + + resultPtr = Tcl_NewListObj(0, NULL); + Tcl_InitObjHashTable(&entries); + + for (varPtr = stylesheet->variables; varPtr; varPtr = varPtr->next) { + Tcl_Obj *listPtr; + + if (strcmp((char *) varPtr->comp->inst->name, "param") == 0) { + listPtr = Tcl_NewListObj(0, NULL); + Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj((CONST char *) varPtr->name, -1)); + Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj((CONST char *) varPtr->nameURI, -1)); + Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj((CONST char *) varPtr->select, -1)); + + Tcl_ListObjAppendElement(interp, resultPtr, listPtr); + + keyPtr = Tcl_NewStringObj((CONST char *) varPtr->nameURI, -1); + Tcl_AppendStringsToObj(keyPtr, "^", varPtr->name, NULL); + Tcl_CreateHashEntry(&entries, (CONST char *) keyPtr, &new); + } + } + + objPtr = GetParameters(interp, stylesheet->next); + if (objPtr) { + ListObjAppendUniqueList(interp, &entries, resultPtr, objPtr); + } + objPtr = GetParameters(interp, stylesheet->imports); + if (objPtr) { + ListObjAppendUniqueList(interp, &entries, resultPtr, objPtr); + } + + Tcl_DeleteHashTable(&entries); + + return resultPtr; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXSLTGenericError -- + * + * Handler for stylesheet errors. + * + * NB. Cannot distinguish between errors and use of xsl:message element. + * + * Results: + * Stores error message. + * + * Side effects: + * Transform will return error condition. + * + *---------------------------------------------------------------------------- + */ + +static void +TclXSLTGenericError (void *ctx, const char *msg, ...) +{ + va_list args; + char buf[2048]; + int len; + GenericError_Info *errorInfoPtr = (GenericError_Info *) ctx; + + if (ctx < (void *) 0x1000) { + fprintf(stderr, "TclXSLT: bad context\n"); + va_start(args,msg); + vfprintf(stderr, msg, args); + va_end(args); + return; + } + + va_start(args,msg); + len = vsnprintf(buf, 2047, msg, args); + va_end(args); + + if (!errorInfoPtr->interp) { + return; + } + + if (errorInfoPtr->stylesheet && errorInfoPtr->stylesheet->messagecommand) { + + Tcl_Obj *cmdPtr = Tcl_DuplicateObj(errorInfoPtr->stylesheet->messagecommand); + if (Tcl_ListObjAppendElement(errorInfoPtr->interp, cmdPtr, Tcl_NewStringObj(buf, len)) != TCL_OK) { + Tcl_BackgroundError(errorInfoPtr->interp); + return; + } + if (Tcl_GlobalEvalObj(errorInfoPtr->interp, cmdPtr) != TCL_OK) { + Tcl_BackgroundError(errorInfoPtr->interp); + return; + } + + } else { + + if (!errorInfoPtr->msg) { + errorInfoPtr->msg = Tcl_NewObj(); + Tcl_IncrRefCount(errorInfoPtr->msg); + } + + errorInfoPtr->code = TCL_ERROR; + + Tcl_AppendToObj(errorInfoPtr->msg, buf, len); + + } +} + +/* + *---------------------------------------------------------------------------- + * + * TclXSLTExtensionCommand -- + * + * Command for xslt::extension command. + * + * Results: + * Depends on method. + * + * Side effects: + * Depends on method + * + *---------------------------------------------------------------------------- + */ + +static int +TclXSLTExtensionCommand(dummy, interp, objc, objv) + ClientData dummy; + Tcl_Interp *interp; + int objc; + Tcl_Obj *CONST objv[]; +{ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + int method, new; + TclXSLT_Extension *extinfo; + Tcl_HashEntry *entry; + + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "method ?args ...?"); + return TCL_ERROR; + } + + if (Tcl_GetIndexFromObj(interp, objv[1], extensionCommandMethods, + "method", 0, &method) != TCL_OK) { + return TCL_ERROR; + } + + switch ((enum extensionCommandMethods) method) { + + case TCLXSLT_EXT_ADD: + if (objc != 4) { + Tcl_WrongNumArgs(interp, 2, objv, "nsuri tcl-namespace"); + return TCL_ERROR; + } + + Tcl_MutexLock(&libxslt); + + if (xsltRegisterExtModule((const xmlChar *) Tcl_GetStringFromObj(objv[2], NULL), + TclXSLTExtInit, + TclXSLTExtShutdown)) { + Tcl_MutexUnlock(&libxslt); + Tcl_SetResult(interp, "cannot register extension module", NULL); + } + + Tcl_MutexUnlock(&libxslt); + + extinfo = (TclXSLT_Extension *) Tcl_Alloc(sizeof(TclXSLT_Extension)); + extinfo->interp = interp; + extinfo->nsuri = objv[2]; + Tcl_IncrRefCount(objv[2]); + extinfo->tclns = objv[3]; + Tcl_IncrRefCount(objv[3]); + + extinfo->xformCtxt = NULL; + + entry = Tcl_CreateHashEntry(tsdPtr->extensions, Tcl_GetStringFromObj(objv[2], NULL), &new); + + if (!new) { + Tcl_SetResult(interp, "extension already exists", NULL); + Tcl_Free((char *) extinfo); + return TCL_ERROR; + } + + Tcl_SetHashValue(entry, extinfo); + + TclXSLT_RegisterAll(extinfo, (const xmlChar *) Tcl_GetStringFromObj(objv[2], NULL)); + + Tcl_ResetResult(interp); + + break; + + case TCLXSLT_EXT_REMOVE: + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "nsuri"); + return TCL_ERROR; + } + + /* + * TODO: Remove previously registered elements and functions. + */ + + entry = Tcl_FindHashEntry(tsdPtr->extensions, Tcl_GetStringFromObj(objv[2], NULL)); + if (entry == NULL) { + Tcl_SetResult(interp, "unknown XML Namespace URI", NULL); + return TCL_ERROR; + } + + extinfo = (TclXSLT_Extension *) Tcl_GetHashValue(entry); + Tcl_DecrRefCount(extinfo->nsuri); + Tcl_DecrRefCount(extinfo->tclns); + Tcl_Free((char *) extinfo); + + Tcl_DeleteHashEntry(entry); + + break; + + default: + Tcl_SetResult(interp, "unknown method", NULL); + return TCL_ERROR; + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXSLTExtInit -- + * + * Load extensions into a transformation context. + * + * Results: + * Returns pointer to extension data. + * Elements and functions are pre-registered. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------------- + */ + +static void * +TclXSLTExtInit(ctxt, URI) + xsltTransformContextPtr ctxt; + const xmlChar *URI; +{ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + Tcl_HashEntry *entry; + TclXSLT_Extension *extinfo; + + entry = Tcl_FindHashEntry(tsdPtr->extensions, (CONST char *) URI); + if (entry == NULL) { + /* Extension module was removed */ + return NULL; + } + + extinfo = (TclXSLT_Extension *) Tcl_GetHashValue(entry); + extinfo->xformCtxt = ctxt; + + return (void *) extinfo; +} + +void +TclXSLT_RegisterAll(extinfo, nsuri) + TclXSLT_Extension *extinfo; + const xmlChar *nsuri; +{ + Tcl_Obj *cmdPtr, *objPtr; + Tcl_Obj **reg; + int ret, i, len; + + /* + * Q: How to distinguish between extension elements and functions? + * A: Use the formal parameters. If the command can accept + * a variable argument list, then it is registered as a function. + * Otherwise it will be registered as an extension (and expected + * to accept certain arguments). + */ + + cmdPtr = Tcl_NewStringObj("::xslt::getprocs ", -1); + Tcl_IncrRefCount(cmdPtr); + Tcl_AppendObjToObj(cmdPtr, extinfo->tclns); + ret = Tcl_EvalObjEx(extinfo->interp, cmdPtr, TCL_EVAL_GLOBAL|TCL_EVAL_DIRECT); + objPtr = Tcl_GetObjResult(extinfo->interp); + Tcl_IncrRefCount(objPtr); + Tcl_DecrRefCount(cmdPtr); + + if (ret != TCL_OK || objPtr == NULL) { + /* + * Something went wrong, therefore nothing to register. + */ + return; + } + + ret = Tcl_ListObjGetElements(extinfo->interp, objPtr, &len, ®); + if (ret != TCL_OK || len != 2) { + /* + * Something went wrong, therefore nothing to register. + */ + return; + } + + /* + * reg[0] contains extension elements + * reg[1] contains extension functions + */ + + Tcl_MutexLock(&libxslt); + + /* + * First register the extension elements. + */ + + ret = Tcl_ListObjLength(extinfo->interp, reg[0], &len); + if (ret == TCL_OK && len > 0) { + for (i = 0; i < len; i++) { + + if (Tcl_ListObjIndex(extinfo->interp, reg[0], i, &objPtr) != TCL_OK) { + continue; + } + + xsltRegisterExtModuleElement((const xmlChar *) Tcl_GetStringFromObj(objPtr, NULL), + nsuri, + (xsltPreComputeFunction) TclXSLTExtElementPreComp, + (xsltTransformFunction) TclXSLTExtElementTransform); + } + } + + /* + * Now register the extension functions. + */ + + ret = Tcl_ListObjLength(extinfo->interp, reg[1], &len); + if (ret != TCL_OK || len == 0) { + Tcl_MutexUnlock(&libxslt); + return; + } + + for (i = 0; i < len; i++) { + + if (Tcl_ListObjIndex(extinfo->interp, reg[1], i, &objPtr) != TCL_OK) { + continue; + } + + xsltRegisterExtModuleFunction((const xmlChar *) Tcl_GetStringFromObj(objPtr, NULL), + nsuri, + TclXSLTExtFunction); + } + + Tcl_MutexUnlock(&libxslt); + + Tcl_DecrRefCount(objPtr); + + return; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXSLTExtElementPreComp -- + * + * Compilation step for extension element. + * + * Results: + * Not currently used. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------------- + */ + +static void +TclXSLTExtElementPreComp(style, inst, function) + xsltStylesheetPtr style; + xmlNodePtr inst; + xsltTransformFunction function; +{ + return; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXSLTExtElementTransform -- + * + * Implements extension element. + * + * Results: + * Returns string returned by Tcl command evaluation. + * + * Side effects: + * Depends on Tcl command evaluated. + * + *---------------------------------------------------------------------------- + */ + +static void +TclXSLTExtElementTransform(ctxt, node, inst, comp) + xsltTransformContextPtr ctxt; /* unused */ + xmlNodePtr node; + xmlNodePtr inst; + xsltStylePreCompPtr comp; /* unused */ +{ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + TclXSLT_Extension *extinfo; + Tcl_HashEntry *entry; + Tcl_Obj *cmdPtr; + int ret; + + if (inst == NULL) { + return; + } + + entry = Tcl_FindHashEntry(tsdPtr->extensions, (CONST char *) inst->ns->href); + if (entry == NULL) { + /* + * Cannot find extension module. + * Must have been removed. + */ + return; + } + + extinfo = (TclXSLT_Extension *) Tcl_GetHashValue(entry); + + /* + * Start constructing the script by first defining the command. + */ + + cmdPtr = Tcl_DuplicateObj(extinfo->tclns); + Tcl_AppendStringsToObj(cmdPtr, "::", inst->name, NULL); + + if (Tcl_ListObjAppendElement(extinfo->interp, cmdPtr, TclDOM_libxml2_CreateObjFromNode(extinfo->interp, node)) != TCL_OK) { + Tcl_DecrRefCount(cmdPtr); + return; + } + + /* + * Converting the stylesheet node to a TclDOM node may clobber the + * _private pointer. It would be nice to find the equivalent node + * in the original DOM tree, but it may not even exist anymore :-( + * + * TODO: make extension elements more effective, and allow + * pre-computation. + */ + + /* + * Now evaluate the complete command. + * Can't propagqte a return error result to + * XSLT, so flag background error instead. + */ + ret = Tcl_EvalObjEx(extinfo->interp, cmdPtr, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); + if (ret != TCL_OK) { + Tcl_BackgroundError(extinfo->interp); + } +} + +/* + *---------------------------------------------------------------------------- + * + * TclXSLTExtFunction -- + * + * Handles evaluation of an extension function. + * + * Results: + * Returns string returned by Tcl command evaluation. + * + * Side effects: + * Depends on Tcl command evaluated. + * + *---------------------------------------------------------------------------- + */ + +static void +TclXSLTExtFunction(xpathCtxt, nargs) + xmlXPathParserContextPtr xpathCtxt; + int nargs; +{ + xsltTransformContextPtr xformCtxt; + TclXSLT_Extension *extinfo; + Tcl_Obj *cmdPtr, *resultPtr; + xmlXPathObjectPtr obj; + int ret; + + Tcl_MutexLock(&libxslt); + + xformCtxt = xsltXPathGetTransformContext(xpathCtxt); + + /* + * In order to find the instance data we need the + * XML Namespace URI of this function. + */ + + extinfo = (TclXSLT_Extension *) xsltGetExtData(xformCtxt, + xpathCtxt->context->functionURI); + + /* + * Start constructing the script by first defining the command. + */ + + cmdPtr = Tcl_DuplicateObj(extinfo->tclns); + Tcl_IncrRefCount(cmdPtr); + Tcl_AppendStringsToObj(cmdPtr, "::", xpathCtxt->context->function, NULL); + + /* + * Each argument on the stack is converted to a Tcl_Obj + * of an appropriate type and passed as an argument to the Tcl command. + */ + + while (nargs) { + Tcl_Obj *objv[2]; + + obj = (xmlXPathObjectPtr) valuePop(xpathCtxt); + if (obj == NULL) { + xmlXPathSetError(xpathCtxt, XPATH_INVALID_OPERAND); + Tcl_DecrRefCount(cmdPtr); + Tcl_MutexUnlock(&libxslt); + return; + } + + objv[0] = TclXSLT_ConvertXPathObjToTclObj(extinfo->interp, obj); + objv[1] = NULL; + if (Tcl_ListObjReplace(extinfo->interp, cmdPtr, 1, 0, 1, objv) != TCL_OK) { + Tcl_BackgroundError(extinfo->interp); + Tcl_DecrRefCount(objv[0]); + Tcl_DecrRefCount(cmdPtr); + Tcl_MutexUnlock(&libxslt); + return; + } + + /* When should this XPath object be freed? + * Immediately before returning from the function call? + * What if the application retains a pointer to it? + * If the application destroys the contents, then memory + * will leak because the XPath object is not freed. + * + * TODO: take a copy of the object's content and pass that + * to the application callback. That would allow this object + * to be freed and allow the application to manage the copy. + + xmlXPathFreeObject(obj); + */ + + nargs--; + } + + ret = Tcl_EvalObjEx(extinfo->interp, cmdPtr, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); + resultPtr = Tcl_GetObjResult(extinfo->interp); + Tcl_DecrRefCount(cmdPtr); + Tcl_IncrRefCount(resultPtr); + + if (ret == TCL_OK) { + obj = TclXSLT_ConvertTclObjToXPathObj(extinfo->interp, resultPtr); + valuePush(xpathCtxt, obj); + } else { + xmlGenericError(xmlGenericErrorContext, + "%s", Tcl_GetStringFromObj(resultPtr, NULL)); + /* Need to define a new error code - this is the closest in meaning */ + xpathCtxt->error = XPATH_UNKNOWN_FUNC_ERROR; + } + + Tcl_MutexUnlock(&libxslt); + + Tcl_DecrRefCount(resultPtr); + +} + +/* + *---------------------------------------------------------------------------- + * + * TclXSLT_ConvertTclObjToXPathObj -- + * + * Convert a Tcl Object to an XPath object. + * Data type is preserved, with nodesets being + * mapped from a list of nodes. + * + * NB. Mutex is assumed to be locked when invoking this routine. + * + * Results: + * XPath Object. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------------- + */ + +static xmlXPathObjectPtr +TclXSLT_ConvertTclObjToXPathObj(interp, objPtr) + Tcl_Interp *interp; + Tcl_Obj *objPtr; +{ + xmlNodePtr nodePtr; + xmlDocPtr docPtr; + + if (TclDOM_libxml2_GetNodeFromObj(interp, objPtr, &nodePtr) == TCL_OK) { + return xmlXPathNewNodeSet(nodePtr); + } + + if (TclXML_libxml2_GetDocFromObj(interp, objPtr, &docPtr) == TCL_OK) { + return xmlXPathNewNodeSet((xmlNodePtr) docPtr); + + } + + if (objPtr->typePtr == Tcl_GetObjType("int") || + objPtr->typePtr == Tcl_GetObjType("double")) { + double number; + + if (Tcl_GetDoubleFromObj(interp, objPtr, &number) == TCL_OK) { + return xmlXPathNewFloat(number); + } else { + return NULL; + } + } else if (objPtr->typePtr == Tcl_GetObjType("boolean")) { + int bool; + + if (Tcl_GetBooleanFromObj(interp, objPtr, &bool) == TCL_OK) { + return xmlXPathNewBoolean(bool); + } else { + return NULL; + } + } else if (objPtr->typePtr == Tcl_GetObjType("list")) { + /* + * If each of the elements can be converted to a node, + * then return a nodeset. + */ + + int i, len; + Tcl_Obj **listPtr; + xmlNodeSetPtr nset; + + Tcl_ListObjGetElements(interp, objPtr, &len, &listPtr); + if (len == 0) { + return xmlXPathNewNodeSet(NULL); + } + + /* + * First pass: check that the elements are all nodes. + */ + for (i = 0; i < len; i++) { + if (TclXML_libxml2_GetDocFromObj(interp, listPtr[i], &docPtr) == TCL_OK) { + continue; + } + if (TclDOM_libxml2_GetNodeFromObj(interp, listPtr[i], &nodePtr) != TCL_OK) { + return xmlXPathNewString((const xmlChar *) Tcl_GetStringFromObj(objPtr, NULL)); + } + } + /* + * Now go ahead and create the nodeset (we already did the hard + * work to create internal reps in pass 1). + */ + if (TclXML_libxml2_GetDocFromObj(interp, listPtr[0], &docPtr) == TCL_OK) { + nset = xmlXPathNodeSetCreate((xmlNodePtr) docPtr); + } else { + TclDOM_libxml2_GetNodeFromObj(interp, listPtr[0], &nodePtr); + nset = xmlXPathNodeSetCreate(nodePtr); + } + for (i = 1; i < len; i++) { + if (TclXML_libxml2_GetDocFromObj(interp, listPtr[i], &docPtr) == TCL_OK) { + xmlXPathNodeSetAdd(nset, (xmlNodePtr) docPtr); + } else { + TclDOM_libxml2_GetNodeFromObj(interp, listPtr[i], &nodePtr); + xmlXPathNodeSetAdd(nset, nodePtr); + } + } + return xmlXPathWrapNodeSet(nset); + + } else { + return xmlXPathNewString((const xmlChar *) Tcl_GetStringFromObj(objPtr, NULL)); + } +} + +/* + *---------------------------------------------------------------------------- + * + * TclXSLT_ConvertXPathObjToTclObj -- + * + * Convert an XPath object to a Tcl Object. + * Data type is preserved, with nodesets being + * mapped to a list of nodes. + * + * Results: + * Tcl Object. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------------- + */ + +static Tcl_Obj * +TclXSLT_ConvertXPathObjToTclObj(interp, xpobj) + Tcl_Interp *interp; + xmlXPathObjectPtr xpobj; +{ + Tcl_Obj *objPtr; + int i; + + switch (xpobj->type) { + case XPATH_XSLT_TREE: + case XPATH_NODESET: + + objPtr = Tcl_NewListObj(0, NULL); + if (xpobj->nodesetval) { + for (i = 0; i < xpobj->nodesetval->nodeNr; i++) { + Tcl_Obj *nodeObjPtr = NULL; + if (xpobj->nodesetval->nodeTab[i] && + xpobj->nodesetval->nodeTab[i]->type == XML_DOCUMENT_NODE) { + nodeObjPtr = TclXML_libxml2_CreateObjFromDoc((xmlDocPtr) xpobj->nodesetval->nodeTab[i]); + } else if (xpobj->nodesetval->nodeTab[i]) { + nodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, xpobj->nodesetval->nodeTab[i]); + } + Tcl_ListObjAppendElement(interp, objPtr, nodeObjPtr); + } + } + + break; + + case XPATH_BOOLEAN: + objPtr = Tcl_NewBooleanObj(xpobj->boolval); + break; + + case XPATH_NUMBER: + objPtr = Tcl_NewDoubleObj(xpobj->floatval); + break; + + case XPATH_STRING: + case XPATH_UNDEFINED: + case XPATH_POINT: + case XPATH_RANGE: + case XPATH_LOCATIONSET: + case XPATH_USERS: + default: + objPtr = Tcl_NewStringObj((CONST char *) xmlXPathCastToString(xpobj), -1); + + break; + } + + return objPtr; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXSLTExtShutdown -- + * + * Clean up. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------------- + */ + +static void +TclXSLTExtShutdown(ctxt, URI, userdata) + xsltTransformContextPtr ctxt; + const xmlChar *URI; + void *userdata; +{ + /* Nothing to do */ +} + +/* + *---------------------------------------------------------------------------- + * + * TclXSLTSecurity -- + * TclXSLTSecurityReadFile -- + * TclXSLTSecurityWriteFile -- + * TclXSLTSecurityCreateDirectory -- + * TclXSLTSecurityReadNetwork -- + * TclXSLTSecurityWriteNetwork -- + * + * Check if external operations are permitted. + * + * Results: + * Returns boolean value. + * + * Side effects: + * Depends on callback. + * + *---------------------------------------------------------------------------- + */ + +static int +TclXSLTSecurity(name, method, value) + Tcl_Obj *name; + const char *method; + const char *value; +{ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + Tcl_Interp *master; + Tcl_Obj *cmdPtr, *pathPtr; + int result, permitted; + + if (Tcl_IsSafe(tsdPtr->interp)) { + + /* + * Invoke hidden command + */ + + master = Tcl_GetMaster(tsdPtr->interp); + + if (!Tcl_IsSafe(master)) { + return 0; + } + + if (Tcl_GetInterpPath(master, tsdPtr->interp) != TCL_OK) { + return 0; + } + pathPtr = Tcl_GetObjResult(master); + + cmdPtr = Tcl_NewListObj(0, NULL); + Tcl_IncrRefCount(cmdPtr); + Tcl_ListObjAppendElement(master, cmdPtr, Tcl_NewStringObj("interp", -1)); + Tcl_ListObjAppendElement(master, cmdPtr, Tcl_NewStringObj("invokehidden", -1)); + Tcl_ListObjAppendElement(master, cmdPtr, pathPtr); + Tcl_ListObjAppendElement(master, cmdPtr, Tcl_NewStringObj("-global", -1)); + Tcl_ListObjAppendElement(master, cmdPtr, Tcl_NewStringObj("::xslt::security", -1)); + Tcl_ListObjAppendElement(master, cmdPtr, name); + Tcl_ListObjAppendElement(master, cmdPtr, Tcl_NewStringObj(method, -1)); + Tcl_ListObjAppendElement(master, cmdPtr, Tcl_NewStringObj(value, -1)); + + result = Tcl_EvalObjEx(master, cmdPtr, TCL_EVAL_GLOBAL|TCL_EVAL_DIRECT); + + Tcl_DecrRefCount(cmdPtr); + } else { + + /* + * Invoke command normally + */ + + cmdPtr = Tcl_NewListObj(0, NULL); + Tcl_IncrRefCount(cmdPtr); + Tcl_ListObjAppendElement(tsdPtr->interp, cmdPtr, Tcl_NewStringObj("::xslt::security", -1)); + Tcl_ListObjAppendElement(tsdPtr->interp, cmdPtr, name); + Tcl_ListObjAppendElement(tsdPtr->interp, cmdPtr, Tcl_NewStringObj(method, -1)); + Tcl_ListObjAppendElement(tsdPtr->interp, cmdPtr, Tcl_NewStringObj(value, -1)); + + result = Tcl_EvalObjEx(tsdPtr->interp, cmdPtr, TCL_EVAL_GLOBAL|TCL_EVAL_DIRECT); + + Tcl_DecrRefCount(cmdPtr); + } + + if (result == TCL_OK) { + if (Tcl_GetBooleanFromObj(tsdPtr->interp, Tcl_GetObjResult(tsdPtr->interp), &permitted) == TCL_OK) { + return permitted; + } else if (Tcl_IsSafe(tsdPtr->interp)) { + return 0; + } else { + return 1; + } + } else if (Tcl_IsSafe(tsdPtr->interp)) { + return 0; + } else { + return 1; + } +} +static Tcl_Obj * +TclXSLTSecurityGetName(ctxt) + xsltTransformContextPtr ctxt; +{ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + Tcl_HashEntry *entryPtr; + + if (ctxt) { + entryPtr = Tcl_FindHashEntry(tsdPtr->stylesheets, (ClientData) ctxt->style); + if (entryPtr) { + return Tcl_NewStringObj((char *) Tcl_GetHashValue(entryPtr), -1); + } else { + return Tcl_NewObj(); + } + } else { + return Tcl_NewObj(); + } +} +static int +TclXSLTSecurityReadFile(sec, ctxt, value) + xsltSecurityPrefsPtr sec; + xsltTransformContextPtr ctxt; + const char *value; +{ + return TclXSLTSecurity(TclXSLTSecurityGetName(ctxt), "readfile", value); +} +static int +TclXSLTSecurityWriteFile(sec, ctxt, value) + xsltSecurityPrefsPtr sec; + xsltTransformContextPtr ctxt; + const char *value; +{ + return TclXSLTSecurity(TclXSLTSecurityGetName(ctxt), "writefile", value); +} +static int +TclXSLTSecurityCreateDirectory(sec, ctxt, value) + xsltSecurityPrefsPtr sec; + xsltTransformContextPtr ctxt; + const char *value; +{ + return TclXSLTSecurity(TclXSLTSecurityGetName(ctxt), "createdirectory", value); +} +static int +TclXSLTSecurityReadNetwork(sec, ctxt, value) + xsltSecurityPrefsPtr sec; + xsltTransformContextPtr ctxt; + const char *value; +{ + return TclXSLTSecurity(TclXSLTSecurityGetName(ctxt), "readnetwork", value); +} +static int +TclXSLTSecurityWriteNetwork(sec, ctxt, value) + xsltSecurityPrefsPtr sec; + xsltTransformContextPtr ctxt; + const char *value; +{ + return TclXSLTSecurity(TclXSLTSecurityGetName(ctxt), "writenetwork", value); +} diff --git a/tclxslt-libxslt.tcl b/tclxslt-libxslt.tcl new file mode 100644 index 0000000..e67d02a --- /dev/null +++ b/tclxslt-libxslt.tcl @@ -0,0 +1,30 @@ +# tclxslt.tcl -- +# +# Tcl library for TclXSLT package. +# +# Copyright (c) 2001-2003 Zveno Pty Ltd +# http://www.zveno.com/ +# +# See the file "LICENSE" in this distribution for information on usage and +# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# $Id: tclxslt-libxslt.tcl,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $ + +namespace eval xslt { + namespace export getprocs +} + +proc xslt::getprocs ns { + set functions {} + set elements {} + foreach proc [info commands ${ns}::*] { + if {[regexp {::([^:]+)$} $proc discard name]} { + if {[string equal [lindex [info args $proc] end] "args"]} { + lappend functions $name + } else { + lappend elements $name + } + } + } + return [list $elements $functions] +} diff --git a/tclxslt/process.tcl b/tclxslt/process.tcl new file mode 100644 index 0000000..d38e5fb --- /dev/null +++ b/tclxslt/process.tcl @@ -0,0 +1,312 @@ +# process.tcl -- +# +# XSLT extension providing processing functions +# +# Copyright (c) 2007 Packaged Press +# http://www.packagedpress.com/ +# Copyright (c) 2002-2004 Zveno Pty Ltd +# http://www.zveno.com/ +# +# See the file "LICENSE" in this distribution for information on usage and +# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# $Id: process.tcl,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $ + +package provide xslt::process 1.1 + +package require uri 1.1 +package require xslt::cache 3.2 + +namespace eval xslt::process { + namespace export transform fop + namespace export transform-result + namespace export dtd-valid +} + +# Add support for the dom: URI scheme. +# +# This scheme allows a script to reference an in-memory DOM tree. + +proc ::uri::SplitDom url { + return [list dom $url] +} + +proc ::uri::JoinDom args { + array set components { + dom {} + } + array set components $args + + return dom:$components(dom) +} + +# xslt::process::transform -- +# +# Perform an XSL Transformation. +# +# TODO: +# Return messages +# Cache source and stylesheet documents. +# Generate dependency documents. +# +# Arguments: +# src Location of source document +# ssheet Location of stylesheet +# result Location for result document +# params Parameters (nodelist) +# args not needed +# +# Results: +# Returns empty string for success + +# This version forks a process +proc xslt::process::transform_fork {src ssheet result {params {}} args} { + if {[catch {exec tclxsltproc -config /Users/steve/scms/lib/config.tcl --xinclude -o $result $ssheet $src} out]} { + return $out + } else { + return {} + } +} + +# This version performs the transformation in-process. +proc xslt::process::transform:dbg {src ssheet result {params {}} args} { + puts stderr [list process::transform $src $ssheet $result $params $args] + if {[catch {eval transform:dbg [list $src $ssheet $result] $params $args} msg]} { + puts stderr "\nprocess::transform returned error $msg\nStack trace:$::errorInfo\n" + return -code error $msg + } else { + puts stderr [list process::transform ran OK] + return $msg + } +} +proc xslt::process::transform {srcNd ssheetNd resultNd {params {}} args} { + + # The filenames may be passed in as nodesets + set src $srcNd + catch {set src [dom::node stringValue [lindex $srcNd 0]]} + set ssheet $ssheetNd + catch {set ssheet [dom::node stringValue [lindex $ssheetNd 0]]} + set result $resultNd + catch {set result [dom::node stringValue [lindex $resultNd 0]]} + + # params will be a nodeset consisting of name/value pairs. + # These must be converted to strings + set parameterList {} + switch [llength $params] { + 1 { + puts stderr [list xslt::process::transform params nodeType [dom::node cget $params -nodeType]] + set pNdList [dom::node children $params] + } + default { + set pNdList $params + } + } + foreach paramNd $pNdList { + set name [set value {}] + foreach child [dom::node children $paramNd] { + set nameNd [dom::node selectNode $child name] + set name [dom::node stringValue $nameNd] + set valueNd [dom::node selectNode $child value] + set value [dom::node stringValue $valueNd] + } + if {[string compare $name {}]} { + lappend parameterList $name $value + } + } + + puts stderr [list xslt::process::transform parameters: $parameterList] + + set cleanup {} + + if {[catch {open $src} ch]} { + # eval $cleanup + return "unable to open source document \"$src\" for reading due to \"$ch\"" + } + if {[catch {::dom::parse [read $ch] -baseuri $src} sourcedoc]} { + # eval $cleanup + return "unable to parse source document \"$src\" due to \"$sourcedoc\"" + } + close $ch + + append cleanup "dom::destroy $sourcedoc" \n + + dom::xinclude $sourcedoc + + if {[catch {open $ssheet} ch]} { + eval $cleanup + return "unable to open stylesheet document \"$ssheet\" for reading due to \"$ch\"" + } + if {[catch {::dom::parse [read $ch] -baseuri $ssheet} styledoc]} { + eval $cleanup + return "unable to parse stylesheet document \"$ssheet\" due to \"$styledoc\"" + } + close $ch + + append cleanup "dom::destroy $styledoc" \n + + if {[catch {xslt::compile $styledoc} style]} { + eval $cleanup + return "unable to compile stylesheet \"$ssheet\" due to \"$style\"" + } + + append cleanup "rename $style {}" \n + + if {[catch {eval [list $style] transform [list $sourcedoc] $parameterList} resultdoc]} { + eval $cleanup + return "unable to transform document \"$src\" with stylesheet \"$ssheet\" due to \"$resultdoc\"" + } + + append cleanup "dom::destroy $resultdoc" \n + + if {[catch {open $result w} ch]} { + eval $cleanup + return "unable to save result document \"$result\" due to \"$ch\"" + } + + puts $ch [dom::serialize $resultdoc -method [$style cget -method]] + close $ch + + catch { + uplevel \#0 $cleanup + } + + return {} +} + +# xslt::process::transform-result -- +# +# Perform an XSL Transformation. +# This version returns the result document. +# +# Arguments: +# src Location of source document +# ssheet Location of stylesheet +# params Parameters (nodelist) +# args not needed +# +# Results: +# Returns result document. + +proc xslt::process::transform-result {srcNd ssheetNd {params {}} args} { + + # The filenames may be passed in as nodesets + set src $srcNd + catch {set src [dom::node stringValue [lindex $srcNd 0]]} + set ssheet $ssheetNd + catch {set ssheet [dom::node stringValue [lindex $ssheetNd 0]]} + + # params will be a nodeset consisting of name/value pairs. + # These must be converted to strings + set parameterList {} + foreach paramNd $params { + set name [set value {}] + foreach child [dom::node children $paramNd] { + set nameNd [dom::node selectNode $child name] + set name [dom::node stringValue $nameNd] + set valueNd [dom::node selectNode $child value] + set value [dom::node stringValue $valueNd] + } + if {[string compare $name {}]} { + lappend parameterList $name $value + } + } + + if {[catch {eval xslt::cache::transform [list $src $ssheet] $parameterList} rd]} { + return "unable to perform transformation due to \"$rd\"" + } + + return $rd +} + +# xslt::process::checkwffdoc -- +# +# Test a document for well-formedness +# +# Arguments: +# doc DOM token for document to check +# args not needed +# +# Results: +# Returns success message + +proc xslt::process::checkwffdoc {doc args} { + return "of course it's well-formed, it's a DOM tree!" +} + +# xslt::process::dtd-valid -- +# +# Test a document for (DTD) validity +# +# Arguments: +# uri URI for document to check, supports dom: scheme +# args not needed +# +# Results: +# Returns success/failure message + +proc xslt::process::dtd-valid {uri args} { + array set components [uri::split $uri] + + switch -- $components(scheme) { + file { + set ch [open $components(path)] + set xmldata [read $ch] + close $ch + set doc [dom::parse $xmldata -baseuri $uri] + set cleanup [list dom::destroy $doc] + } + dom { + set doc $components(dom) + set cleanup {} + } + default { + # TODO: support http: scheme + return -code error "unable to resolve entity $uri" + } + } + + if {[catch {dom::validate $doc} msg]} { + set result $msg + } else { + set result {document is valid} + } + + eval $cleanup + + return $result +} + +# xslt::process::fop -- +# +# Format an XSL FO document using FOP +# +# Arguments: +# fo Location of FO document +# pdf Location for PDF document +# params Parameters (nodelist) +# args not needed +# +# Results: +# Returns success message + +proc xslt::process::fop {fo pdf params args} { + return "format fo $fo to produce $pdf" +} + +# xslt::process::log -- +# +# Emit a log message. The application is expected to override this. +# +# Arguments: +# msg Log message +# args not needed +# +# Results: +# None + +proc xslt::process::log {msg args} { + Stderr Log:\ $msg + return {} +} + + diff --git a/tclxslt/resources.tcl b/tclxslt/resources.tcl new file mode 100644 index 0000000..b107a77 --- /dev/null +++ b/tclxslt/resources.tcl @@ -0,0 +1,388 @@ +# resources.tcl -- +# +# XSLT extension providing access to resources. +# +# Copyright (c) 2005-2008 Explain +# http://www.explain.com.au/ +# Copyright (c) 2001-2004 Zveno Pty Ltd +# http://www.zveno.com/ +# +# See the file "LICENSE" in this distribution for information on usage and +# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# $Id: resources.tcl,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $ + +catch { + package require base64 +} + +package provide xslt::resources 1.3 + +namespace eval xslt::resources { + namespace export list type exists modified +} + +# xslt::resources::list -- +# +# List the resources available at a given location +# +# Arguments: +# locn Resource path to list +# basedir Base directory +# args not needed +# +# Results: +# Returns list of resources + +proc xslt::resources::list {locnNd {baseNd {}} args} { + # What kind of resource is this? file, http, ftp, etc? + + if {[llength $args]} { + return -code error "too many arguments" + } + + set locn $locnNd + # The resource may be passed in as a nodeset + catch {set locn [dom::node stringValue [lindex $locnNd 0]]} + set base $baseNd + catch {set base [dom::node stringValue [lindex $baseNd 0]]} + + if {[string match /* $base]} { + regsub {^(/)} $locn {} locn + } + + set result {} + foreach entry [glob -nocomplain [file join $base $locn *]] { + lappend result [file tail $entry] + } + + return $result +} + +# xslt::resources::type -- +# +# Gives the type of the resource +# +# Arguments: +# locn Resource path to type +# args not needed +# +# Results: +# Returns string describing resource + +proc xslt::resources::type {locnNd args} { + + if {[llength $args]} { + return -code error "too many arguments" + } + + set locn $locnNd + catch {set locn [dom::node stringValue [lindex $locnNd 0]]} + + if {[file isdir $locn]} { + return directory + } elseif {[file isfile $locn]} { + return file + } else { + return other + } +} + +# xslt::resources::exists -- +# +# Check whether a resource exists +# +# Arguments: +# locn Resource path to type +# args not needed +# +# Results: +# Returns boolean + +proc xslt::resources::exists {locnNd args} { + + if {[llength $args]} { + return -code error "too many arguments" + } + + set locn $locnNd + catch {set locn [dom::node stringValue [lindex $locnNd 0]]} + + if {[file exists $locn]} { + return 1 + } else { + return 0 + } +} + +# xslt::resources::modified -- +# +# Report last modification time of a resource +# +# Arguments: +# locn Resource path +# args not needed +# +# Results: +# Returns ISO standard date-time string + +proc xslt::resources::modified {locnNd args} { + + if {[llength $args]} { + return -code error "too many arguments" + } + + set locn $locnNd + catch {set locn [dom::node stringValue [lindex $locnNd 0]]} + + if {[file exists $locn]} { + return [clock format [file mtime $locn] -format {%Y-%m-%dT%H:%M:%S}] + } else { + return {} + } +} + +# xslt::resources::mkdir -- +# +# Create a directory hierarchy. +# +# Arguments: +# locn Resource path for directory +# args not needed +# +# Results: +# Returns directory created or empty string if unsuccessful + +proc xslt::resources::mkdir {locnNd args} { + + if {[llength $args]} { + return {} + } + + set locn $locnNd + catch {set locn [dom::node stringValue [lindex $locnNd 0]]} + + set dir [file split $locn] + set current [lindex $dir 0] + set remaining [lrange $dir 1 end] + while {[llength $remaining]} { + set current [file join $current [lindex $remaining 0]] + set remaining [lrange $remaining 1 end] + if {[file exists $current]} { + if {![file isdir $current]} { + return {} + } + } elseif {[file isdir $current]} { + continue + } else { + if {[catch {file mkdir $current}]} { + return {} + } + } + } + + return $locn +} + +# xslt::resources::copy -- +# +# Copy a resource. +# +# Arguments: +# src Resource to copy +# dest Destination for resource +# args not needed +# +# Results: +# Resource copied + +proc xslt::resources::copy {srcNd destNd args} { + set src $srcNd + catch {set src [dom::node stringValue [lindex $srcNd 0]]} + set dest $destNd + catch {set dest [dom::node stringValue [lindex $destNd 0]]} + + if {[catch {file copy -force $src $dest} msg]} { + catch { + package require log + log::log error "copy failed due to \"$msg\"" + } + return 0 + } else { + return 1 + } +} + +# xslt::resources::move -- +# +# Move (rename) a resource. +# +# Arguments: +# src Resource to move +# dest Destination for resource +# args not needed +# +# Results: +# Resource renamed + +proc xslt::resources::move {srcNd destNd args} { + set src $srcNd + catch {set src [dom::node stringValue [lindex $srcNd 0]]} + set dest $destNd + catch {set dest [dom::node stringValue [lindex $destNd 0]]} + + if {[catch {file rename -force $src $dest}]} { + return 0 + } else { + return 1 + } +} + +# xslt::resources::file-attributes -- +# +# Change attributes of a resource. +# +# Arguments: +# src Resource to change +# what Attribute to change +# detail Attribute value +# args not needed +# +# Results: +# Resource attribute changed + +proc xslt::resources::file-set-attributes {srcNd whatNd detailNd args} { + set src $srcNd + catch {set src [dom::node stringValue [lindex $srcNd 0]]} + set what $whatNd + catch {set what [dom::node stringValue [lindex $whatNd 0]]} + set detail $detailNd + catch {set detail [dom::node stringValue [lindex $detailNd 0]]} + + if {[catch {file attributes $src -$what $detail} result]} { + return {} + } else { + return $result + } +} + +# xslt::resources::delete -- +# +# Delete a resource +# +# Arguments: +# locn Resource path to type +# args not needed +# +# Results: +# Returns boolean + +proc xslt::resources::delete {locnNd args} { + + if {[llength $args]} { + return -code error "too many arguments" + } + + set locn $locnNd + catch {set locn [dom::node stringValue [lindex $locnNd 0]]} + + if {[catch {file delete -force $locn} msg]} { + catch { + package require log + log::log error "delete failed due to \"$msg\"" + } + return 0 + } else { + return 1 + } +} + +# xslt::resources::link -- +# +# Link a resource. +# +# Arguments: +# from Link to create +# to Target of link +# args not needed +# +# Results: +# Symbolic link created + +proc xslt::resources::link {fromNd toNd args} { + set from $fromNd + catch {set from [dom::node stringValue [lindex $fromNd 0]]} + set to $toNd + catch {set to [dom::node stringValue [lindex $toNd 0]]} + + if {[catch {file link $from $to}]} { + return 0 + } else { + return 1 + } +} + +# xslt::resources::write-base64 -- +# +# Decode base64 encoded data and write the binary data to a file +# +# Arguments: +# fname Filename +# b64 base64 encoded data +# args not needed +# +# Results: +# File opened for writing and binary data written. +# Returns 1 if file successfully written, 0 otherwise. + +proc xslt::resources::write-base64 {fnameNd b64Nd args} { + set fname $fnameNd + catch {set fname [dom::node stringValue [lindex $fnameNd 0]]} + set b64 $b64Nd + catch {set b64 [dom::node stringValue [lindex $b64Nd 0]]} + + if {[catch {package require base64}]} { + return 0 + } + + if {[catch {open $fname w} ch]} { + return 0 + } else { + set binarydata [base64::decode $b64] + fconfigure $ch -trans binary -encoding binary + puts -nonewline $ch $binarydata + close $ch + return 1 + } +} + +# xslt::resources::read-base64 -- +# +# Read binary data from a file and base64 encode it +# +# Arguments: +# fname Filename +# args not needed +# +# Results: +# File opened for readng and contents read. +# Returns content as base64-encoded data. + +proc xslt::resources::read-base64 {fnameNd args} { + set fname $fnameNd + catch {set fname [dom::node stringValue [lindex $fnameNd 0]]} + + if {[catch {package require base64}]} { + return 0 + } + + if {[catch {open $fname} ch]} { + return 0 + } else { + fconfigure $ch -trans binary -encoding binary + set binarydata [read $ch] + close $ch + return [base64::encode $binarydata] + } +} + diff --git a/tclxslt/tclxslt.tcl b/tclxslt/tclxslt.tcl new file mode 100644 index 0000000..6aa6a2c --- /dev/null +++ b/tclxslt/tclxslt.tcl @@ -0,0 +1,30 @@ +# tclxslt.tcl -- +# +# Tcl library for TclXSLT package. +# +# Copyright (c) 2001-2003 Zveno Pty Ltd +# http://www.zveno.com/ +# +# See the file "LICENSE" in this distribution for information on usage and +# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# $Id: tclxslt.tcl,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $ + +namespace eval xslt { + namespace export getprocs +} + +proc xslt::getprocs ns { + set functions {} + set elements {} + foreach proc [info commands ${ns}::*] { + if {[regexp {::([^:]+)$} $proc discard name]} { + if {[string equal [lindex [info args $proc] end] "args"]} { + lappend functions $name + } else { + lappend elements $name + } + } + } + return [list $elements $functions] +} diff --git a/tclxslt/utilities.tcl b/tclxslt/utilities.tcl new file mode 100644 index 0000000..8459598 --- /dev/null +++ b/tclxslt/utilities.tcl @@ -0,0 +1,144 @@ +# utilities.tcl -- +# +# Miscellaneous extension functions for XSLT. +# +# Copyright (c) 2007 Explain +# http://www.explain.com.au/ +# Copyright (c) 2004 Zveno Pty Ltd +# http://www.zveno.com/ +# +# See the file "LICENSE" in this distribution for information on usage and +# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# $Id: utilities.tcl,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $ + +package provide xslt::utilities 1.2 + +namespace eval xslt::utilities { + namespace export character-first decode-base64 +} + +# xslt::utilities::character-first -- +# +# Returns the character that occurs first from a string +# of possible characters. +# +# Arguments: +# src source string +# chars characters to find +# args not needed +# +# Results: +# Returns a character or empty string. + +proc xslt::utilities::character-first {srcNd charsNd args} { + if {[llength $args]} { + return -code error "too many arguments" + } + + set src $srcNd + catch {set src [dom::node stringValue [lindex $srcNd 0]]} + set chars $charsNd + catch {set chars [dom::node stringValue [lindex $charsNd 0]]} + + regsub -all {([\\\[\]^$-])} $chars {\\\1} chars + if {[regexp [format {([%s])} $chars] $src dummy theChar]} { + return $theChar + } + + return {} +} + +# xslt::utilities::decode-base64 -- +# +# Returns decoded (binary) base64-encoded data. +# +# Arguments: +# src source string +# args not needed +# +# Results: +# Returns binary data. + +proc xslt::utilities::decode-base64 {srcNd args} { + if {[llength $args]} { + return -code error "too many arguments" + } + + if {[catch {package require base64}]} { + return {} + } + + set src $srcNd + catch {set src [dom::node stringValue [lindex $srcNd 0]]} + + return [base64::decode $src] +} + +# xslt::utilities::binary-document -- +# +# Writes binary data into a document +# (this should be an extension element) +# +# Arguments: +# fname filename +# data binary data +# args not needed +# +# Results: +# File opened for writing and data written. +# Returns 1 on success, 0 otherwise + +proc xslt::utilities::binary-document {fnameNd srcNd args} { + if {[llength $args]} { + return -code error "too many arguments" + } + + set fname $fnameNd + catch {set fname [dom::node stringValue [lindex $fnameNd 0]]} + set data $dataNd + catch {set data [dom::node stringValue [lindex $dataNd 0]]} + + if {[catch {open $fname w} ch]} { + return 0 + } + fconfigure $ch -trans binary -encoding binary + puts -nonewline $ch $data + close $ch + + return 1 +} + +# xslt::utilities::base64-binary-document -- +# +# Returns base64-encoded data from a file. +# +# Arguments: +# fname filename +# args not needed +# +# Results: +# Returns text. Returns empty string on error. + +proc xslt::utilities::base64-binary-document {fnameNd args} { + if {[llength $args]} { + return -code error "too many arguments" + } + + if {[catch {package require base64}]} { + return {} + } + + set fname $fnameNd + catch {set fname [dom::node stringValue [lindex $fnameNd 0]]} + + if {[catch {open $fname} ch]} { + return {} + } + fconfigure $ch -trans binary -encoding binary + set data [read $ch] + close $ch + + return [base64::encode $data] +} + diff --git a/tclxslt/xsltcache.tcl b/tclxslt/xsltcache.tcl new file mode 100644 index 0000000..9a3d8f7 --- /dev/null +++ b/tclxslt/xsltcache.tcl @@ -0,0 +1,379 @@ +# xsltcache.tcl -- +# +# Handles performing XSLT transformations, +# caching documents and results. +# +# Copyright (c) 2005-2007 Steve Ball +# http://www.packagedpress.com/staff/Steve.Ball +# Copyright (c) 2002-2003 Zveno Pty Ltd +# http://www.zveno.com/ +# +# See the file "LICENSE" in this distribution for information on usage and +# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# $Id: xsltcache.tcl,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $ + +package require xslt 3.2 +package require uri + +package provide xslt::cache 3.2 + +namespace eval xslt::cache { + namespace export transform transformdoc flush + namespace export parse_depend + namespace export loadstylesheet + + variable sources + array set sources {} + variable stylesheets + array set stylesheets {} + variable results + array set results {} +} + +# xslt::cache::transform -- +# +# Perform an XSLT transformation. +# +# Arguments: +# src Filename of source document +# ssheet Filename of stylesheet document +# args Configuration options, stylesheet parameters +# +# Results: +# Result document token + +proc xslt::cache::transform {src ssheet args} { + variable sources + variable stylesheets + variable results + + # Separate parameters from options + set parameters {} + set options {} + foreach {key value} $args { + switch -glob -- $key { + -* { + lappend options $key $value + } + default { + lappend parameters $key $value + } + } + } + + # Normalize the parameter list + array set paramArray $parameters + set parameters {} + foreach name [lsort [array names paramArray]] { + lappend parameters $name $paramArray($name) + } + + set hash $src.$ssheet.$parameters + + array set opts { + -xmlinclude 1 + } + array set opts $options + + set readSource [ReadXML $src -xmlinclude $opts(-xmlinclude)] + + set readStylesheet 1 + if {[info exists stylesheets($ssheet)]} { + if {[file mtime $ssheet] < $stylesheets($ssheet,time)} { + set readStylesheet 0 + } + } + if {$readStylesheet} { + catch {rename $stylesheets($ssheet) {}} + ReadXML $ssheet -xmlinclude $opts(-xmlinclude) + + set stylesheets($ssheet) [xslt::compile $sources($ssheet)] + set stylesheets($ssheet,time) [clock seconds] + } + + if {$readSource || $readStylesheet || ![info exists results($hash)]} { + + set results($hash) [eval [list $stylesheets($ssheet)] transform [list $sources($src)] $parameters] + set results($hash,time) [clock seconds] + } + + return $results($hash) +} + +# xslt::cache::loadstylesheet -- +# +# Read, parse and compile an XSLT stylesheet. +# +# Arguments: +# src Filename for the stylesheet document +# args options +# +# Results: +# Returns compiled stylesheet token. Adds reference to stylesheet to cache. + +proc xslt::cache::loadstylesheet {src args} { + variable sources + variable stylesheets + + array set options { + -keepsource 0 + -xmlinclude 0 + } + array set options $args + + eval ReadXML [list $src] [array get options -xmlinclude] + + set stylesheets($src) [xslt::compile $sources($src)] + set stylesheets($src,time) [clock seconds] + + if {!$options(-keepsource)} { + flush $src {} + } + + # TODO: set command trace so that if the stylesheet is deleted + # the cache is invalidated + + return $stylesheets($src) +} + +# xslt::cache::ReadXML -- +# +# Internal proc to manage parsing a document. +# Used for both source and stylesheet documents. +# +# Arguments: +# src Filename of source document +# args Configuration options +# +# Results: +# Returns 1 if document was read. Returns 0 if document is cached. + +proc xslt::cache::ReadXML {src args} { + variable sources + array set opts { + -xmlinclude 1 + } + array set opts $args + + set readSource 1 + if {[info exists sources($src)]} { + if {[file mtime $src] < $sources($src,time)} { + set readSource 0 + } + } + if {$readSource} { + catch {dom::destroy $sources($src)} + set ch [open $src] + set sources($src) [dom::parse [read $ch] -baseuri file://$src] + close $ch + if {$opts(-xmlinclude)} { + dom::xinclude $sources($src) + } + set sources($src,time) [clock seconds] + } + + return $readSource +} + +# xslt::cache::transformdoc -- +# +# Perform an XSLT transformation on a DOM document. +# +# Arguments: +# src DOM token of source document +# ssheet Filename of stylesheet document +# args Configuration options, stylesheet parameters +# +# Results: +# Result document token + +proc xslt::cache::transformdoc {src ssheet args} { + variable sources + variable stylesheets + + # Separate parameters from options + set parameters {} + set options {} + foreach {key value} $args { + switch -glob -- $key { + -* { + lappend options $key $value + } + default { + lappend parameters $key $value + } + } + } + + # Normalize the parameter list + array set paramArray $parameters + set parameters {} + foreach name [lsort [array names paramArray]] { + lappend parameters $name $paramArray($name) + } + + array set opts { + -xmlinclude 1 + } + array set opts $options + + set readStylesheet 1 + if {[info exists stylesheets($ssheet)]} { + if {[file mtime $ssheet] < $stylesheets($ssheet,time)} { + set readStylesheet 0 + } + } + if {$readStylesheet} { + catch {rename $stylesheets($ssheet) {}} + ReadXML $ssheet -xmlinclude $opts(-xmlinclude) + + set stylesheets($ssheet) [xslt::compile $sources($ssheet)] + set stylesheets($ssheet,time) [clock seconds] + } + + set result [eval [list $stylesheets($ssheet)] transform [list $src] $parameters] + + return $result +} + +# ::xslt::cache::parse_depend -- +# +# Parse a document while determining its dependencies. +# +# Arguments: +# uri Document's URI +# depVar Global variable name for dependency document +# +# Results: +# Returns parsed document token. +# Document token for dependency document is stored in depVar. + +proc xslt::cache::parse_depend {uri depVar} { + upvar #0 $depVar dep + + set dep [dom::create] + dom::document createElement $dep dependencies + + array set uriParsed [uri::split $uri] + + switch -- $uriParsed(scheme) { + file { + set ch [open $uriParsed(path)] + set doc [dom::parse [read $ch] -baseuri $uri -externalentitycommand [namespace code [list ParseDepend_Entity $depVar]]] + close $ch + + ParseDepend_XInclude $doc $depVar + ParseDepend_XSLT $doc $depVar + } + http { + return -code error "URI scheme \"http\" not yet implemented" + } + dom { + set doc $uriParsed(dom) + + # Can't determine external entities, but can find XInclude + # and XSL stylesheet includes/imports. + ParseDepend_XInclude $uriParsed(dom) $depVar + ParseDepend_XSLT $uriParsed(dom) $depVar + } + default { + return -code error "URI scheme \"$uriParsed(scheme)\" not supported" + } + } + + return $doc +} + +# xslt::cache::ParseDepend_Entity -- +# +# Callback for external entity inclusion. +# +# Arguments: +# depVar Global variable of dependency document +# pubId Public identifier +# sysId System identifier +# +# Results: +# Dependency added to dependency document + +proc xslt::cache::ParseDepend_Entity {depVar pubId sysId} { + upvar #0 $depVar dep + + dom::document createNode $dep /dependencies/external-entities/entity +} + +# ::xslt::cache::flush -- +# +# Flush the cache +# +# Arguments: +# src source document filename +# ssheet stylesheet document filename +# args parameters +# +# Results: +# Returns the empty string. +# If all arguments are given then all entries corresponding +# to that transformation are destroyed. +# If the source and/or stylesheet are given then all +# entries corresponding to those documents are destroyed. + +proc xslt::cache::flush {src ssheet args} { + variable sources + variable stylesheets + variable results + + # Normalize parameter list + array set paramArray $args + set parameters {} + foreach name [lsort [array names paramArray]] { + lappend parameters $name $paramArray($name) + } + + set hash $src.$ssheet.$parameters + + switch -glob [string length $src],[string length $ssheet],[llength $args] { + 0,0,* { + # Special case: flush all + unset sources + array set sources {} + unset stylesheets + array set stylesheets {} + unset results + array set results {} + } + + 0,*,0 { + # Flush all entries for the given stylesheet + catch {rename $stylesheets($ssheet) {}} + catch {unset stylesheets($ssheet)} + catch {unset stylesheets($ssheet,time)} + + foreach entry [array names results *.$ssheet.*] { + catch {dom::destroy $results($entry)} + catch {unset results($entry)} + catch {unset results($entry,time)} + } + } + + *,0,0 { + # Flush all entries for the given source document + catch {dom::destroy $sources($src)} + catch {unset sources($src)} + catch {unset sources($src,time)} + foreach entry [array names results $src.*] { + catch {dom::destroy $results($entry)} + catch {unset results($entry)} + catch {unset results($entry,time)} + } + } + + default { + # Flush specific entry + catch {dom::destroy $results($hash)} + catch {unset results($hash)} + catch {unset results($hash,time)} + } + } +} diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl new file mode 100644 index 0000000..d4ef368 --- /dev/null +++ b/tools/genStubs.tcl @@ -0,0 +1,894 @@ +# genStubs.tcl -- +# +# This script generates a set of stub files for a given +# interface. +# +# +# Copyright (c) 1998-1999 by Scriptics Corporation. +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: genStubs.tcl,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $ + +namespace eval genStubs { + # libraryName -- + # + # The name of the entire library. This value is used to compute + # the USE_*_STUB_PROCS macro and the name of the init file. + + variable libraryName "UNKNOWN" + + # interfaces -- + # + # An array indexed by interface name that is used to maintain + # the set of valid interfaces. The value is empty. + + array set interfaces {} + + # curName -- + # + # The name of the interface currently being defined. + + variable curName "UNKNOWN" + + # hooks -- + # + # An array indexed by interface name that contains the set of + # subinterfaces that should be defined for a given interface. + + array set hooks {} + + # stubs -- + # + # This three dimensional array is indexed first by interface name, + # second by platform name, and third by a numeric offset or the + # constant "lastNum". The lastNum entry contains the largest + # numeric offset used for a given interface/platform combo. Each + # numeric offset contains the C function specification that + # should be used for the given entry in the stub table. The spec + # consists of a list in the form returned by parseDecl. + + array set stubs {} + + # outDir -- + # + # The directory where the generated files should be placed. + + variable outDir . +} + +# genStubs::library -- +# +# This function is used in the declarations file to set the name +# of the library that the interfaces are associated with (e.g. "tcl"). +# This value will be used to define the inline conditional macro. +# +# Arguments: +# name The library name. +# +# Results: +# None. + +proc genStubs::library {name} { + variable libraryName $name +} + +# genStubs::interface -- +# +# This function is used in the declarations file to set the name +# of the interface currently being defined. +# +# Arguments: +# name The name of the interface. +# +# Results: +# None. + +proc genStubs::interface {name} { + variable curName $name + variable interfaces + + set interfaces($name) {} + return +} + +# genStubs::hooks -- +# +# This function defines the subinterface hooks for the current +# interface. +# +# Arguments: +# names The ordered list of interfaces that are reachable through the +# hook vector. +# +# Results: +# None. + +proc genStubs::hooks {names} { + variable curName + variable hooks + + set hooks($curName) $names + return +} + +# genStubs::declare -- +# +# This function is used in the declarations file to declare a new +# interface entry. +# +# Arguments: +# index The index number of the interface. +# platform The platform the interface belongs to. Should be one +# of generic, win, unix, or mac. +# decl The C function declaration, or {} for an undefined +# entry. +# +# Results: +# None. + +proc genStubs::declare {args} { + variable stubs + variable curName + + if {[llength $args] != 3} { + puts stderr "wrong # args: declare $args" + } + lassign $args index platformList decl + + # Check for duplicate declarations, then add the declaration and + # bump the lastNum counter if necessary. + + foreach platform $platformList { + if {[info exists stubs($curName,$platform,$index)]} { + puts stderr "Duplicate entry: declare $args" + } + } + regsub -all "\[ \t\n\]+" [string trim $decl] " " decl + set decl [parseDecl $decl] + + foreach platform $platformList { + if {$decl != ""} { + set stubs($curName,$platform,$index) $decl + if {![info exists stubs($curName,$platform,lastNum)] \ + || ($index > $stubs($curName,$platform,lastNum))} { + set stubs($curName,$platform,lastNum) $index + } + } + } + return +} + +# genStubs::rewriteFile -- +# +# This function replaces the machine generated portion of the +# specified file with new contents. It looks for the !BEGIN! and +# !END! comments to determine where to place the new text. +# +# Arguments: +# file The name of the file to modify. +# text The new text to place in the file. +# +# Results: +# None. + +proc genStubs::rewriteFile {file text} { + if {![file exist $file]} { + puts stderr "Cannot find file: $file" + return + } + set in [open ${file} r] + set out [open ${file}.new w] + + # Always write out the file with LF termination + fconfigure $out -translation lf + + while {![eof $in]} { + set line [gets $in] + if {[regexp {!BEGIN!} $line]} { + break + } + puts $out $line + } + puts $out "/* !BEGIN!: Do not edit below this line. */" + puts $out $text + while {![eof $in]} { + set line [gets $in] + if {[regexp {!END!} $line]} { + break + } + } + puts $out "/* !END!: Do not edit above this line. */" + puts -nonewline $out [read $in] + close $in + close $out + file rename -force ${file}.new ${file} + return +} + +# genStubs::addPlatformGuard -- +# +# Wrap a string inside a platform #ifdef. +# +# Arguments: +# plat Platform to test. +# +# Results: +# Returns the original text inside an appropriate #ifdef. + +proc genStubs::addPlatformGuard {plat text} { + switch $plat { + win { + return "#ifdef __WIN32__\n${text}#endif /* __WIN32__ */\n" + } + unix { + return "#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */\n${text}#endif /* UNIX */\n" + } + mac { + return "#ifdef MAC_TCL\n${text}#endif /* MAC_TCL */\n" + } + } + return "$text" +} + +# genStubs::emitSlots -- +# +# Generate the stub table slots for the given interface. If there +# are no generic slots, then one table is generated for each +# platform, otherwise one table is generated for all platforms. +# +# Arguments: +# name The name of the interface being emitted. +# textVar The variable to use for output. +# +# Results: +# None. + +proc genStubs::emitSlots {name textVar} { + variable stubs + upvar $textVar text + + forAllStubs $name makeSlot 1 text {" void *reserved$i;\n"} + return +} + +# genStubs::parseDecl -- +# +# Parse a C function declaration into its component parts. +# +# Arguments: +# decl The function declaration. +# +# Results: +# Returns a list of the form {returnType name args}. The args +# element consists of a list of type/name pairs, or a single +# element "void". If the function declaration is malformed +# then an error is displayed and the return value is {}. + +proc genStubs::parseDecl {decl} { + if {![regexp {^(.*)\((.*)\)$} $decl all prefix args]} { + puts stderr "Malformed declaration: $decl" + return + } + set prefix [string trim $prefix] + if {![regexp {^(.+[ ][*]*)([^ *]+)$} $prefix all rtype fname]} { + puts stderr "Bad return type: $decl" + return + } + set rtype [string trim $rtype] + foreach arg [split $args ,] { + lappend argList [string trim $arg] + } + if {![string compare [lindex $argList end] "..."]} { + if {[llength $argList] != 2} { + puts stderr "Only one argument is allowed in varargs form: $decl" + } + set arg [parseArg [lindex $argList 0]] + if {$arg == "" || ([llength $arg] != 2)} { + puts stderr "Bad argument: '[lindex $argList 0]' in '$decl'" + return + } + set args [list TCL_VARARGS $arg] + } else { + set args {} + foreach arg $argList { + set argInfo [parseArg $arg] + if {![string compare $argInfo "void"]} { + lappend args "void" + break + } elseif {[llength $argInfo] == 2 || [llength $argInfo] == 3} { + lappend args $argInfo + } else { + puts stderr "Bad argument: '$arg' in '$decl'" + return + } + } + } + return [list $rtype $fname $args] +} + +# genStubs::parseArg -- +# +# This function parses a function argument into a type and name. +# +# Arguments: +# arg The argument to parse. +# +# Results: +# Returns a list of type and name with an optional third array +# indicator. If the argument is malformed, returns "". + +proc genStubs::parseArg {arg} { + if {![regexp {^(.+[ ][*]*)([^][ *]+)(\[\])?$} $arg all type name array]} { + if {$arg == "void"} { + return $arg + } else { + return + } + } + set result [list [string trim $type] $name] + if {$array != ""} { + lappend result $array + } + return $result +} + +# genStubs::makeDecl -- +# +# Generate the prototype for a function. +# +# Arguments: +# name The interface name. +# decl The function declaration. +# index The slot index for this function. +# +# Results: +# Returns the formatted declaration string. + +proc genStubs::makeDecl {name decl index} { + lassign $decl rtype fname args + + append text "/* $index */\n" + set line "EXTERN $rtype" + set count [expr {2 - ([string length $line] / 8)}] + append line [string range "\t\t\t" 0 $count] + set pad [expr {24 - [string length $line]}] + if {$pad <= 0} { + append line " " + set pad 0 + } + append line "$fname _ANSI_ARGS_(" + + set arg1 [lindex $args 0] + switch -exact $arg1 { + void { + append line "(void)" + } + TCL_VARARGS { + set arg [lindex $args 1] + append line "TCL_VARARGS([lindex $arg 0],[lindex $arg 1])" + } + default { + set sep "(" + foreach arg $args { + append line $sep + set next {} + append next [lindex $arg 0] " " [lindex $arg 1] \ + [lindex $arg 2] + if {[string length $line] + [string length $next] \ + + $pad > 76} { + append text $line \n + set line "\t\t\t\t" + set pad 28 + } + append line $next + set sep ", " + } + append line ")" + } + } + append text $line + + append text ");\n" + return $text +} + +# genStubs::makeMacro -- +# +# Generate the inline macro for a function. +# +# Arguments: +# name The interface name. +# decl The function declaration. +# index The slot index for this function. +# +# Results: +# Returns the formatted macro definition. + +proc genStubs::makeMacro {name decl index} { + lassign $decl rtype fname args + + set lfname [string tolower [string index $fname 0]] + append lfname [string range $fname 1 end] + + set text "#ifndef $fname\n#define $fname" + set arg1 [lindex $args 0] + set argList "" + switch -exact $arg1 { + void { + set argList "()" + } + TCL_VARARGS { + } + default { + set sep "(" + foreach arg $args { + append argList $sep [lindex $arg 1] + set sep ", " + } + append argList ")" + } + } + append text " \\\n\t(${name}StubsPtr->$lfname)" + append text " /* $index */\n#endif\n" + return $text +} + +# genStubs::makeStub -- +# +# Emits a stub function definition. +# +# Arguments: +# name The interface name. +# decl The function declaration. +# index The slot index for this function. +# +# Results: +# Returns the formatted stub function definition. + +proc genStubs::makeStub {name decl index} { + lassign $decl rtype fname args + + set lfname [string tolower [string index $fname 0]] + append lfname [string range $fname 1 end] + + append text "/* Slot $index */\n" $rtype "\n" $fname + + set arg1 [lindex $args 0] + + if {![string compare $arg1 "TCL_VARARGS"]} { + lassign [lindex $args 1] type argName + append text " TCL_VARARGS_DEF($type,$argName)\n\{\n" + append text " " $type " var;\n va_list argList;\n" + if {[string compare $rtype "void"]} { + append text " " $rtype " resultValue;\n" + } + append text "\n var = (" $type ") TCL_VARARGS_START(" \ + $type "," $argName ",argList);\n\n " + if {[string compare $rtype "void"]} { + append text "resultValue = " + } + append text "(" $name "StubsPtr->" $lfname "VA)(var, argList);\n" + append text " va_end(argList);\n" + if {[string compare $rtype "void"]} { + append text "return resultValue;\n" + } + append text "\}\n\n" + return $text + } + + if {![string compare $arg1 "void"]} { + set argList "()" + set argDecls "" + } else { + set argList "" + set sep "(" + foreach arg $args { + append argList $sep [lindex $arg 1] + append argDecls " " [lindex $arg 0] " " \ + [lindex $arg 1] [lindex $arg 2] ";\n" + set sep ", " + } + append argList ")" + } + append text $argList "\n" $argDecls "{\n " + if {[string compare $rtype "void"]} { + append text "return " + } + append text "(" $name "StubsPtr->" $lfname ")" $argList ";\n}\n\n" + return $text +} + +# genStubs::makeSlot -- +# +# Generate the stub table entry for a function. +# +# Arguments: +# name The interface name. +# decl The function declaration. +# index The slot index for this function. +# +# Results: +# Returns the formatted table entry. + +proc genStubs::makeSlot {name decl index} { + lassign $decl rtype fname args + + set lfname [string tolower [string index $fname 0]] + append lfname [string range $fname 1 end] + + set text " " + append text $rtype " (*" $lfname ") _ANSI_ARGS_(" + + set arg1 [lindex $args 0] + switch -exact $arg1 { + void { + append text "(void)" + } + TCL_VARARGS { + set arg [lindex $args 1] + append text "TCL_VARARGS([lindex $arg 0],[lindex $arg 1])" + } + default { + set sep "(" + foreach arg $args { + append text $sep [lindex $arg 0] " " [lindex $arg 1] \ + [lindex $arg 2] + set sep ", " + } + append text ")" + } + } + + append text "); /* $index */\n" + return $text +} + +# genStubs::makeInit -- +# +# Generate the prototype for a function. +# +# Arguments: +# name The interface name. +# decl The function declaration. +# index The slot index for this function. +# +# Results: +# Returns the formatted declaration string. + +proc genStubs::makeInit {name decl index} { + append text " " [lindex $decl 1] ", /* " $index " */\n" + return $text +} + +# genStubs::forAllStubs -- +# +# This function iterates over all of the platforms and invokes +# a callback for each slot. The result of the callback is then +# placed inside appropriate platform guards. +# +# Arguments: +# name The interface name. +# slotProc The proc to invoke to handle the slot. It will +# have the interface name, the declaration, and +# the index appended. +# onAll If 1, emit the skip string even if there are +# definitions for one or more platforms. +# textVar The variable to use for output. +# skipString The string to emit if a slot is skipped. This +# string will be subst'ed in the loop so "$i" can +# be used to substitute the index value. +# +# Results: +# None. + +proc genStubs::forAllStubs {name slotProc onAll textVar \ + {skipString {"/* Slot $i is reserved */\n"}}} { + variable stubs + upvar $textVar text + + set plats [array names stubs $name,*,lastNum] + if {[info exists stubs($name,generic,lastNum)]} { + # Emit integrated stubs block + set lastNum -1 + foreach plat [array names stubs $name,*,lastNum] { + if {$stubs($plat) > $lastNum} { + set lastNum $stubs($plat) + } + } + for {set i 0} {$i <= $lastNum} {incr i} { + set slots [array names stubs $name,*,$i] + set emit 0 + if {[info exists stubs($name,generic,$i)]} { + if {[llength $slots] > 1} { + puts stderr "platform entry duplicates generic entry: $i" + } + append text [$slotProc $name $stubs($name,generic,$i) $i] + set emit 1 + } elseif {[llength $slots] > 0} { + foreach plat {unix win mac} { + if {[info exists stubs($name,$plat,$i)]} { + append text [addPlatformGuard $plat \ + [$slotProc $name $stubs($name,$plat,$i) $i]] + set emit 1 + } elseif {$onAll} { + append text [eval {addPlatformGuard $plat} $skipString] + set emit 1 + } + } + } + if {$emit == 0} { + eval {append text} $skipString + } + } + + } else { + # Emit separate stubs blocks per platform + foreach plat {unix win mac} { + if {[info exists stubs($name,$plat,lastNum)]} { + set lastNum $stubs($name,$plat,lastNum) + set temp {} + for {set i 0} {$i <= $lastNum} {incr i} { + if {![info exists stubs($name,$plat,$i)]} { + eval {append temp} $skipString + } else { + append temp [$slotProc $name $stubs($name,$plat,$i) $i] + } + } + append text [addPlatformGuard $plat $temp] + } + } + } + +} + +# genStubs::emitDeclarations -- +# +# This function emits the function declarations for this interface. +# +# Arguments: +# name The interface name. +# textVar The variable to use for output. +# +# Results: +# None. + +proc genStubs::emitDeclarations {name textVar} { + variable stubs + upvar $textVar text + + append text "\n/*\n * Exported function declarations:\n */\n\n" + forAllStubs $name makeDecl 0 text + return +} + +# genStubs::emitMacros -- +# +# This function emits the inline macros for an interface. +# +# Arguments: +# name The name of the interface being emitted. +# textVar The variable to use for output. +# +# Results: +# None. + +proc genStubs::emitMacros {name textVar} { + variable stubs + variable libraryName + upvar $textVar text + + set upName [string toupper $libraryName] + append text "\n#if defined(USE_${upName}_STUBS) && !defined(USE_${upName}_STUB_PROCS)\n" + append text "\n/*\n * Inline function declarations:\n */\n\n" + + forAllStubs $name makeMacro 0 text + + append text "\n#endif /* defined(USE_${upName}_STUBS) && !defined(USE_${upName}_STUB_PROCS) */\n" + return +} + +# genStubs::emitHeader -- +# +# This function emits the body of the Decls.h file for +# the specified interface. +# +# Arguments: +# name The name of the interface being emitted. +# +# Results: +# None. + +proc genStubs::emitHeader {name} { + variable outDir + variable hooks + + set capName [string toupper [string index $name 0]] + append capName [string range $name 1 end] + + emitDeclarations $name text + + if {[info exists hooks($name)]} { + append text "\ntypedef struct ${capName}StubHooks {\n" + foreach hook $hooks($name) { + set capHook [string toupper [string index $hook 0]] + append capHook [string range $hook 1 end] + append text " struct ${capHook}Stubs *${hook}Stubs;\n" + } + append text "} ${capName}StubHooks;\n" + } + append text "\ntypedef struct ${capName}Stubs {\n" + append text " int magic;\n" + append text " struct ${capName}StubHooks *hooks;\n\n" + + emitSlots $name text + + append text "} ${capName}Stubs;\n" + + append text "\n#ifdef __cplusplus\nextern \"C\" {\n#endif\n" + append text "extern ${capName}Stubs *${name}StubsPtr;\n" + append text "#ifdef __cplusplus\n}\n#endif\n" + + emitMacros $name text + + rewriteFile [file join $outDir ${name}Decls.h] $text + return +} + +# genStubs::emitStubs -- +# +# This function emits the body of the Stubs.c file for +# the specified interface. +# +# Arguments: +# name The name of the interface being emitted. +# +# Results: +# None. + +proc genStubs::emitStubs {name} { + variable outDir + + append text "\n/*\n * Exported stub functions:\n */\n\n" + forAllStubs $name makeStub 0 text + + rewriteFile [file join $outDir ${name}Stubs.c] $text + return +} + +# genStubs::emitInit -- +# +# Generate the table initializers for an interface. +# +# Arguments: +# name The name of the interface to initialize. +# textVar The variable to use for output. +# +# Results: +# Returns the formatted output. + +proc genStubs::emitInit {name textVar} { + variable stubs + variable hooks + upvar $textVar text + + set capName [string toupper [string index $name 0]] + append capName [string range $name 1 end] + + if {[info exists hooks($name)]} { + append text "\nstatic ${capName}StubHooks ${name}StubHooks = \{\n" + set sep " " + foreach sub $hooks($name) { + append text $sep "&${sub}Stubs" + set sep ",\n " + } + append text "\n\};\n" + } + append text "\n${capName}Stubs ${name}Stubs = \{\n" + append text " TCL_STUB_MAGIC,\n" + if {[info exists hooks($name)]} { + append text " &${name}StubHooks,\n" + } else { + append text " NULL,\n" + } + + forAllStubs $name makeInit 1 text {" NULL, /* $i */\n"} + + append text "\};\n" + return +} + +# genStubs::emitInits -- +# +# This function emits the body of the StubInit.c file for +# the specified interface. +# +# Arguments: +# name The name of the interface being emitted. +# +# Results: +# None. + +proc genStubs::emitInits {} { + variable hooks + variable outDir + variable libraryName + variable interfaces + + # Assuming that dependencies only go one level deep, we need to emit + # all of the leaves first to avoid needing forward declarations. + + set leaves {} + set roots {} + foreach name [lsort [array names interfaces]] { + if {[info exists hooks($name)]} { + lappend roots $name + } else { + lappend leaves $name + } + } + foreach name $leaves { + emitInit $name text + } + foreach name $roots { + emitInit $name text + } + + rewriteFile [file join $outDir ${libraryName}StubInit.c] $text +} + +# genStubs::init -- +# +# This is the main entry point. +# +# Arguments: +# None. +# +# Results: +# None. + +proc genStubs::init {} { + global argv argv0 + variable outDir + variable interfaces + + if {[llength $argv] < 2} { + puts stderr "usage: $argv0 outDir declFile ?declFile...?" + exit 1 + } + + set outDir [lindex $argv 0] + + foreach file [lrange $argv 1 end] { + source $file + } + + foreach name [lsort [array names interfaces]] { + puts "Emitting $name" + emitHeader $name + } + + emitInits +} + +# lassign -- +# +# This function emulates the TclX lassign command. +# +# Arguments: +# valueList A list containing the values to be assigned. +# args The list of variables to be assigned. +# +# Results: +# Returns any values that were not assigned to variables. + +proc lassign {valueList args} { + if {[llength $args] == 0} { + error "wrong # args: lassign list varname ?varname..?" + } + + uplevel [list foreach $args $valueList {break}] + return [lrange $valueList [llength $args] end] +} + +genStubs::init diff --git a/win/build.data b/win/build.data new file mode 100755 index 0000000..1a4072a --- /dev/null +++ b/win/build.data @@ -0,0 +1,28 @@ +# build.data -- +# + + macro exec_prefix {${prefix}} + macro program_transform_name {s,x,x,} + macro bindir {${exec_prefix}/bin} + macro sbindir {${exec_prefix}/sbin} + macro libexecdir {${exec_prefix}/libexec} + macro datadir {${prefix}/share} + macro sysconfdir {${prefix}/etc} + macro sharedstatedir {${prefix}/com} + macro localstatedir {${prefix}/var} + macro libdir {${exec_prefix}/lib} + macro includedir {${prefix}/include} + macro infodir {${prefix}/info} + macro mandir {${prefix}/man} + + macro PACKAGE {tclxml} + macro VERSION {$::Installer::Version} + + macro OBJEXT {obj} + + macro RELPATH {..} + macro TCLXML_LIB_FILE {tclxml.dll} + macro expat_TCL_LIB_FILE {tclexpat.dll} + macro BUILD_expat {yes} + macro expat_TCL_LIB_NAME {tclexpat} + macro BUILD_xerces {no} diff --git a/win/makefile.vc b/win/makefile.vc new file mode 100644 index 0000000..ae15eb8 --- /dev/null +++ b/win/makefile.vc @@ -0,0 +1,564 @@ +# makefile.vc -- -*- Makefile -*- +# +# Microsoft Visual C++ makefile for use with nmake.exe v1.62+ (VC++ 5.0+) +# +# This makefile is based upon the Tcl 8.4 Makefile.vc and modified to +# make it suitable as a general package makefile. Look for the word EDIT +# which marks sections that may need modification. As a minumum you will +# need to change the PROJECT, DOTVERSION and DLLOBJS variables to values +# relevant to your package. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# Copyright (c) 1995-1996 Sun Microsystems, Inc. +# Copyright (c) 1998-2000 Ajuba Solutions. +# Copyright (c) 2001 ActiveState Corporation. +# Copyright (c) 2001-2002 David Gravereaux. +# Copyright (c) 2003 Pat Thoyts +# Copyright (c) 2004 Zveno Pty Ltd +# +#------------------------------------------------------------------------- +# RCS: @(#)$Id: makefile.vc,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $ +#------------------------------------------------------------------------- + +!if "$(MSVCDIR)" == "" +MSG = ^ +You will need to run vcvars32.bat from Developer Studio, first, to setup^ +the environment. Jump to this line to read the new instructions. +!error $(MSG) +!endif + +#------------------------------------------------------------------------------ +# HOW TO USE this makefile: +# +# 1) It is now necessary to have %MSVCDir% set in the environment. This is +# used as a check to see if vcvars32.bat had been run prior to running +# nmake or during the installation of Microsoft Visual C++, MSVCDir had +# been set globally and the PATH adjusted. Either way is valid. +# +# You'll need to run vcvars32.bat contained in the MsDev's vc(98)/bin +# directory to setup the proper environment, if needed, for your current +# setup. This is a needed bootstrap requirement and allows the swapping of +# different environments to be easier. +# +# 2) To use the Platform SDK (not expressly needed), run setenv.bat after +# vcvars32.bat according to the instructions for it. This can also turn on +# the 64-bit compiler, if your SDK has it. +# +# 3) Targets are: +# all -- Builds everything. +# -- Builds the project (eg: nmake sample) +# test -- Builds and runs the test suite. +# install -- Installs the built binaries and libraries to $(INSTALLDIR) +# in an appropriate subdirectory. +# clean/realclean/distclean -- varying levels of cleaning. +# +# 4) Macros usable on the commandline: +# INSTALLDIR= +# Sets where to install Tcl from the built binaries. +# C:\Progra~1\Tcl is assumed when not specified. +# +# OPTS=static,msvcrt,staticpkg,threads,symbols,profile,loimpact,none +# Sets special options for the core. The default is for none. +# Any combination of the above may be used (comma separated). +# 'none' will over-ride everything to nothing. +# +# static = Builds a static library of the core instead of a +# dll. The shell will be static (and large), as well. +# msvcrt = Effects the static option only to switch it from +# using libcmt(d) as the C runtime [by default] to +# msvcrt(d). This is useful for static embedding +# support. +# staticpkg = Effects the static option only to switch +# tclshXX.exe to have the dde and reg extension linked +# inside it. +# threads = Turns on full multithreading support. +# thrdalloc = Use the thread allocator (shared global free pool). +# symbols = Adds symbols for step debugging. +# profile = Adds profiling hooks. Map file is assumed. +# loimpact = Adds a flag for how NT treats the heap to keep memory +# in use, low. This is said to impact alloc performance. +# +# STATS=memdbg,compdbg,none +# Sets optional memory and bytecode compiler debugging code added +# to the core. The default is for none. Any combination of the +# above may be used (comma separated). 'none' will over-ride +# everything to nothing. +# +# memdbg = Enables the debugging memory allocator. +# compdbg = Enables byte compilation logging. +# +# MACHINE=(IX86|IA64|ALPHA) +# Set the machine type used for the compiler, linker, and +# resource compiler. This hook is needed to tell the tools +# when alternate platforms are requested. IX86 is the default +# when not specified. +# +# TMP_DIR= +# OUT_DIR= +# Hooks to allow the intermediate and output directories to be +# changed. $(OUT_DIR) is assumed to be +# $(BINROOT)\(Release|Debug) based on if symbols are requested. +# $(TMP_DIR) will de $(OUT_DIR)\ by default. +# +# TESTPAT= +# Reads the tests requested to be run from this file. +# +# CFG_ENCODING=encoding +# name of encoding for configuration information. Defaults +# to cp1252 +# +# 5) Examples: +# +# Basic syntax of calling nmake looks like this: +# nmake [-nologo] -f makefile.vc [target|macrodef [target|macrodef] [...]] +# +# Standard (no frills) +# c:\tcl_src\win\>c:\progra~1\micros~1\vc98\bin\vcvars32.bat +# Setting environment for using Microsoft Visual C++ tools. +# c:\tcl_src\win\>nmake -f makefile.vc all +# c:\tcl_src\win\>nmake -f makefile.vc install INSTALLDIR=c:\progra~1\tcl +# +# Building for Win64 +# c:\tcl_src\win\>c:\progra~1\micros~1\vc98\bin\vcvars32.bat +# Setting environment for using Microsoft Visual C++ tools. +# c:\tcl_src\win\>c:\progra~1\platfo~1\setenv.bat /pre64 /RETAIL +# Targeting Windows pre64 RETAIL +# c:\tcl_src\win\>nmake -f makefile.vc MACHINE=IA64 +# +#------------------------------------------------------------------------------ +#============================================================================== +############################################################################### +#------------------------------------------------------------------------------ + +!if !exist("makefile.vc") +MSG = ^ +You must run this makefile only from the directory it is in.^ +Please `cd` to its location first. +!error $(MSG) +!endif + +#------------------------------------------------------------------------- +# Project specific information (EDIT) +# +# You should edit this with the name and version of your project. This +# information is used to generate the name of the package library and +# it's install location. +# +# For example, the sample extension is going to build sample04.dll and +# would install it into $(INSTALLDIR)\lib\sample04 +# +# You need to specify the object files that need to be linked into your +# binary here. +# +#------------------------------------------------------------------------- + +PROJECT = Tclxml +!include "rules.vc" + +DOTVERSION = 3.1 +VERSION = $(DOTVERSION:.=) +STUBPREFIX = $(PROJECT)stub + +#-- Use this line for VC++ 6.0 +#WSOCKLIB = "C:\Program Files\Microsoft Visual Studio\VC98\Lib\WSOCK32.LIB" +#-- Use this line for VC++ .NET 2003 +WSOCKLIB = "C:\Program Files\Microsoft Visual Studio .NET 2003\Vc7\PlatformSDK\Lib\WSOCK32.LIB" + +DLLOBJS = \ + $(TMP_DIR)\tclxml.obj +PRJSTUBOBJS = \ + $(TMP_DIR)\tclxmlStubInit.obj \ + $(TMP_DIR)\tclxmlStubLib.obj +EXPATDLLOBJS = \ + $(TMP_DIR)\tclexpat.obj \ + $(TMP_DIR)\xmltok.obj \ + $(TMP_DIR)\xmlrole.obj \ + $(TMP_DIR)\xmlwf.obj \ + $(TMP_DIR)\xmlfile.obj \ + $(TMP_DIR)\codepage.obj \ + $(TMP_DIR)\hashtable.obj \ + $(TMP_DIR)\win32filemap.obj \ + $(TMP_DIR)\xmlparse.obj +LIBXML2DLLOBJS = \ + $(TMP_DIR)\tcllibxml2.obj \ + $(TMP_DIR)\docObj.obj +LIBXML2STUBOBJS = \ + $(TMP_DIR)\tcllibxml2StubInit.obj + +#------------------------------------------------------------------------- +# Target names and paths ( shouldn't need changing ) +#------------------------------------------------------------------------- + +BINROOT = . +ROOT = .. + +PRJIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib +PRJLIBNAME = $(PROJECT)$(VERSION)$(SUFX).$(EXT) +PRJLIB = $(OUT_DIR)\$(PRJLIBNAME) + +PRJSTUBLIBNAME = $(STUBPREFIX)$(VERSION).lib +PRJSTUBLIB = $(OUT_DIR)\$(PRJSTUBLIBNAME) + +EXPATIMPLIB = $(OUT_DIR)\expat$(VERSION)$(SUFX).lib +EXPATLIBNAME = expat$(VERSION)$(SUFX).$(EXT) +EXPATLIB = $(OUT_DIR)\$(EXPATLIBNAME) + +EXPATSTUBLIBNAME = expatstub$(VERSION).lib +EXPATSTUBLIB = $(OUT_DIR)\$(EXPATSTUBLIBNAME) + +LIBXML2IMPLIB = $(OUT_DIR)\tcllibxml2$(VERSION)$(SUFX).lib +LIBXML2LIBNAME = tcllibxml2$(VERSION)$(SUFX).$(EXT) +LIBXML2LIB = $(OUT_DIR)\$(LIBXML2LIBNAME) + +LIBXML2STUBLIBNAME = tcllibxml2stub$(VERSION).lib +LIBXML2STUBLIB = $(OUT_DIR)\$(LIBXML2STUBLIBNAME) + +### Make sure we use backslash only. +LIB_INSTALL_DIR = $(_INSTALLDIR)\lib +BIN_INSTALL_DIR = $(_INSTALLDIR)\bin +DOC_INSTALL_DIR = $(_INSTALLDIR)\doc +SCRIPT_INSTALL_DIR = $(_INSTALLDIR)\lib\$(PROJECT)$(DOTVERSION) +EXPAT_INSTALL_DIR = $(_INSTALLDIR)\lib\Tclexpat$(DOTVERSION) +LIBXML2_INSTALL_DIR = $(_INSTALLDIR)\lib\Tcllibxml$(DOTVERSION) +INCLUDE_INSTALL_DIR = $(_INSTALLDIR)\include + +### The following paths CANNOT have spaces in them. +GENERICDIR = $(ROOT) +EXPATDIR = $(ROOT)\expat +TCLLIBXML2DIR = $(ROOT)\libxml2 +WINDIR = $(ROOT)\win +LIBDIR = $(ROOT)\library +DOCDIR = $(ROOT)\doc +TOOLSDIR = $(ROOT)\tools +COMPATDIR = $(ROOT)\compat +INCLUDEDIR = $(ROOT)\include + +### Find a tclsh for testing and installation. +!if !exist("$(TCLSH)") +TCLSH = $(BIN_INSTALL_DIR)\tclsh$(TCL_VERSION).exe +!endif + +#--------------------------------------------------------------------- +# Compile flags +#--------------------------------------------------------------------- + +!if !$(DEBUG) +!if $(OPTIMIZING) +### This cranks the optimization level to maximize speed +cdebug = -O2 -Op -Gs +!else +cdebug = +!endif +!else if "$(MACHINE)" == "IA64" +### Warnings are too many, can't support warnings into errors. +cdebug = -Z7 -Od +!else +cdebug = -Z7 -WX -Od +!endif + +### Declarations common to all compiler options +cflags = -nologo -c -W3 -YX -Fp$(TMP_DIR)^\ + +!if $(PENT_0F_ERRATA) +cflags = $(cflags) -QI0f +!endif + +!if $(ITAN_B_ERRATA) +cflags = $(cflags) -QIA64_Bx +!endif + +!if $(MSVCRT) +!if $(DEBUG) +crt = -MDd +!else +crt = -MD +!endif +!else +!if $(DEBUG) +crt = -MTd +!else +crt = -MT +!endif +!endif + +#---------------------------------------------------------- +# TclXML/libxml2 needs libz, libiconv and libxml2 headers +#---------------------------------------------------------- + +!if !defined(LIBZDIR) +MSG=^ +Don't know where libz is. Set the LIBZDIR macro. +!error $(MSG) +!else +_LIBZDIR = $(LIBZDIR:/=\) +!if !exist("$(_LIBZDIR)\include\zlib.h") +MSG=^ +Don't know where zlib.h is. The LIBZDIR macro doesn't appear to be correct. +!error $(MSG) +!endif +!endif + +!if !defined(LIBICONVDIR) +MSG=^ +Don't know where libiconv is. Set the LIBICONVDIR macro. +!error $(MSG) +!else +_LIBICONVDIR = $(LIBICONVDIR:/=\) +!if !exist("$(_LIBICONVDIR)\include\iconv.h") +MSG=^ +Don't know where iconv.h is. The LIBICONVDIR macro doesn't appear to be correct. +!error $(MSG) +!endif +!endif + +!if !defined(LIBXML2DIR) +MSG=^ +Don't know where libxml2 is. Set the LIBXML2DIR macro. +!error $(MSG) +!else +_LIBXML2DIR = $(LIBXML2DIR:/=\) +!if !exist("$(_LIBXML2DIR)\include\libxml\tree.h") +MSG=^ +Don't know where libxml2 tree.h is. The LIBXML2DIR macro doesn't appear to be correct. +!error $(MSG) +!endif +!endif + +TCL_INCLUDES = -I"$(TCLDIR)\include" -I"$(WINDIR)" -I"$(GENERICDIR)" +EXPAT_INCLUDES = -I"$(EXPATDIR)\xmlparse" -I"$(EXPATDIR)\xmltok" +LIBXML2_INCLUDES = -I"$(LIBZDIR)\include" -I"$(LIBICONVDIR)\include" -I"$(LIBXML2DIR)\include" +BASE_CLFAGS = $(cflags) $(cdebug) $(crt) $(TCL_INCLUDES) -I"..\include" +CON_CFLAGS = $(cflags) $(cdebug) $(crt) -DCONSOLE +TCL_CFLAGS = -DUSE_TCL_STUBS -DVERSION="\"$(DOTVERSION)\"" $(BASE_CLFAGS) $(OPTDEFINES) +LIBXML2_CFLAGS = -DTCLXML_LIBXML2_VERSION="\"$(DOTVERSION)\"" + +#--------------------------------------------------------------------- +# Link flags +#--------------------------------------------------------------------- + +!if $(DEBUG) +ldebug = -debug:full -debugtype:cv +!else +ldebug = -release -opt:ref -opt:icf,3 +!endif + +### Declarations common to all linker options +lflags = -nologo -machine:$(MACHINE) $(ldebug) + +!if $(PROFILE) +lflags = $(lflags) -profile +!endif + +!if $(ALIGN98_HACK) && !$(STATIC_BUILD) +### Align sections for PE size savings. +lflags = $(lflags) -opt:nowin98 +!else if !$(ALIGN98_HACK) && $(STATIC_BUILD) +### Align sections for speed in loading by choosing the virtual page size. +lflags = $(lflags) -align:4096 +!endif + +!if $(LOIMPACT) +lflags = $(lflags) -ws:aggressive +!endif + +dlllflags = $(lflags) -dll +conlflags = $(lflags) -subsystem:console +guilflags = $(lflags) -subsystem:windows +baselibs = $(TCLSTUBLIB) + +#--------------------------------------------------------------------- +# TclTest flags +#--------------------------------------------------------------------- + +!IF "$(TESTPAT)" != "" +TESTFLAGS = -file $(TESTPAT) +!ENDIF + +#--------------------------------------------------------------------- +# Project specific targets (EDIT) +#--------------------------------------------------------------------- + +all: setup $(PROJECT) +$(PROJECT): setup $(PRJLIB) $(EXPATLIB) $(LIBXML2LIB) +install: install-binaries install-includes install-libraries install-docs + + +test: setup $(PROJECT) + set TCL_LIBRARY=$(ROOT)/library +!if "$(OS)" == "Windows_NT" || "$(MSVCDIR)" == "IDE" + $(TCLSH) "$(ROOT)/tests/all.tcl" $(TESTFLAGS) +!else + @echo Please wait while the tests are collected... + $(TCLSH) "$(ROOT)/tests/all.tcl" $(TESTFLAGS) > tests.log + type tests.log | more +!endif + +setup: + @if not exist $(OUT_DIR)\nul mkdir $(OUT_DIR) + @if not exist $(TMP_DIR)\nul mkdir $(TMP_DIR) + +$(PRJLIB): $(DLLOBJS) $(PRJSTUBOBJS) + $(link32) $(dlllflags) -out:$@ $(baselibs) $(DLLOBJS) $(PRJSTUBOBJS) + -@del $*.exp + +$(EXPATLIB): $(EXPATDLLOBJS) + $(link32) $(dlllflags) -out:$@ $(baselibs) $(PRJIMPLIB) @<< +$** +<< + -@del $*.exp + +$(LIBXML2LIB): $(LIBXML2DLLOBJS) + $(link32) $(dlllflags) -out:$@ $(baselibs) $(PRJIMPLIB) $(LIBZDIR)\lib\zlib.lib $(LIBICONVDIR)\lib\iconv.lib $(LIBXML2DIR)\lib\libxml2.lib $(WSOCKLIB) @<< +$** +<< + -@del $*.exp + +$(PRJSTUBLIB): $(PRJSTUBOBJS) + $(lib32) -nologo -out:$@ $(PRJSTUBOBJS) +$(EXPATSTUBLIB): $(EXPATSTUBOBJS) + $(lib32) -nologo -out:$@ $(EXPATSTUBOBJS) +$(LIBXML2STUBLIB): $(LIBXML2STUBOBJS) + $(lib32) -nologo -out:$@ $(LIBXML2STUBOBJS) + +#--------------------------------------------------------------------- +# Special case object file targets +#--------------------------------------------------------------------- + +$(TMP_DIR)\tclxml.obj: $(GENERICDIR)\tclxml.c + $(cc32) $(TCL_CFLAGS) -DBUILD_$(PROJECT) -Fo$@ $? + +$(TMP_DIR)\tclexpat.obj: $(GENERICDIR)\tclexpat.c + $(cc32) $(TCL_CFLAGS) $(EXPAT_INCLUDES) -DBUILD_$(PROJECT) -Fo$@ $? + +$(TMP_DIR)\xmltok.obj: $(EXPATDIR)\xmltok\xmltok.c + $(cc32) $(TCL_CFLAGS) -DBUILD_$(PROJECT) -Fo$@ $? + +$(TMP_DIR)\xmlrole.obj: $(EXPATDIR)\xmltok\xmlrole.c + $(cc32) $(TCL_CFLAGS) -DBUILD_$(PROJECT) -Fo$@ $? + +$(TMP_DIR)\xmlwf.obj: $(EXPATDIR)\xmlwf\xmlwf.c + $(cc32) $(TCL_CFLAGS) $(EXPAT_INCLUDES) -DBUILD_$(PROJECT) -Fo$@ $? + +$(TMP_DIR)\xmlfile.obj: $(EXPATDIR)\xmlwf\xmlfile.c + $(cc32) $(TCL_CFLAGS) $(EXPAT_INCLUDES) -DBUILD_$(PROJECT) -Fo$@ $? + +$(TMP_DIR)\codepage.obj: $(EXPATDIR)\xmlwf\codepage.c + $(cc32) $(TCL_CFLAGS) -DBUILD_$(PROJECT) -Fo$@ $? + +$(TMP_DIR)\hashtable.obj: $(EXPATDIR)\xmlparse\hashtable.c + $(cc32) $(TCL_CFLAGS) $(EXPAT_INCLUDES) -DBUILD_$(PROJECT) -Fo$@ $? + +$(TMP_DIR)\win32filemap.obj: $(EXPATDIR)\xmlwf\win32filemap.c + $(cc32) $(TCL_CFLAGS) -DBUILD_$(PROJECT) -Fo$@ $? + +$(TMP_DIR)\xmlparse.obj: $(EXPATDIR)\xmlparse\xmlparse.c + $(cc32) $(TCL_CFLAGS) $(EXPAT_INCLUDES) -DBUILD_$(PROJECT) -Fo$@ $? + +$(TMP_DIR)\tcllibxml2.obj: $(TCLLIBXML2DIR)\tcllibxml2.c + $(cc32) $(TCL_CFLAGS) $(LIBXML2_CFLAGS) $(LIBXML2_INCLUDES) -DBUILD_TclXML_libxml2 -Fo$@ $? + +$(TMP_DIR)\docObj.obj: $(TCLLIBXML2DIR)\docObj.c + $(cc32) $(TCL_CFLAGS) $(LIBXML2_CFLAGS) $(LIBXML2_INCLUDES) -DBUILD_TclXML_libxml2 -Fo$@ $? + +$(TMP_DIR)\tcllibxml2StubInit.obj: $(TCLLIBXML2DIR)\tcllibxml2StubInit.c + $(cc32) $(TCL_CFLAGS) $(LIBXML2_CFLAGS) $(LIBXML2_INCLUDES) -DBUILD_TclXML_libxml2 -Fo$@ $? + +#--------------------------------------------------------------------- +# Implicit rules +#--------------------------------------------------------------------- + +{$(WINDIR)}.c{$(TMP_DIR)}.obj:: + $(cc32) $(TCL_CFLAGS) -DBUILD_$(PROJECT) -Fo$(TMP_DIR)\ @<< +$< +<< + +{$(GENERICDIR)}.c{$(TMP_DIR)}.obj:: + $(cc32) $(TCL_CFLAGS) -DBUILD_$(PROJECT) -Fo$(TMP_DIR)\ @<< +$< +<< + +{$(COMPATDIR)}.c{$(TMP_DIR)}.obj:: + $(cc32) $(TCL_CFLAGS) -DBUILD_$(PROJECT) -Fo$(TMP_DIR)\ @<< +$< +<< + +{$(WINDIR)}.rc{$(TMP_DIR)}.res: + $(rc32) -fo $@ -r -i "$(GENERICDIR)" -D__WIN32__ \ +!if $(DEBUG) + -d DEBUG \ +!endif +!if $(TCL_THREADS) + -d TCL_THREADS \ +!endif +!if $(STATIC_BUILD) + -d STATIC_BUILD \ +!endif + $< + +.SUFFIXES: +.SUFFIXES:.c .rc + +#--------------------------------------------------------------------- +# Installation. (EDIT) +# +# You may need to modify this section to reflect the final distribution +# of your files and possibly to generate documentation. +# +#--------------------------------------------------------------------- + +install-binaries: install-tclxml-binaries install-expat-binaries install-libxml2-binaries + @echo Installing to '$(SCRIPT_INSTALL_DIR)' + +install-tclxml-binaries: + @if not exist $(SCRIPT_INSTALL_DIR)\nul mkdir $(SCRIPT_INSTALL_DIR) + $(CPY) $(PRJLIB) $(SCRIPT_INSTALL_DIR) + $(CPY) $(PRJIMPLIB) $(SCRIPT_INSTALL_DIR) + +install-expat-binaries: + @if not exist $(EXPAT_INSTALL_DIR)\nul mkdir $(EXPAT_INSTALL_DIR) + $(CPY) $(EXPATLIB) $(EXPAT_INSTALL_DIR) + $(CPY) $(EXPATIMPLIB) $(EXPAT_INSTALL_DIR) + @echo package ifneeded xml::expat $(DOTVERSION) [list load [file join $$dir $(EXPATLIBNAME)]] > $(EXPAT_INSTALL_DIR)\pkgIndex.tcl + +install-libxml2-binaries: + @if not exist $(LIBXML2_INSTALL_DIR)\nul mkdir $(LIBXML2_INSTALL_DIR) + $(CPY) $(LIBXML2LIB) $(LIBXML2_INSTALL_DIR) + $(CPY) $(LIBXML2IMPLIB) $(LIBXML2_INSTALL_DIR) + @echo package ifneeded xml::libxml2 $(DOTVERSION) [list load [file join $$dir $(LIBXML2LIBNAME)] Tclxml_libxml2] > $(LIBXML2_INSTALL_DIR)\pkgIndex.tcl + +install-includes: install-tclxml-includes install-expat-includes install-libxml2-includes + @echo Installing to '$(INCLUDE_INSTALL_DIR)' + @if not exist $(INCLUDE_INSTALL_DIR)\nul mkdir $(INCLUDE_INSTALL_DIR) + +install-tclxml-includes: + @if not exist $(INCLUDE_INSTALL_DIR)\tclxml\nul mkdir $(INCLUDE_INSTALL_DIR)\tclxml + $(CPY) $(INCLUDEDIR)\tclxml\*.h $(INCLUDE_INSTALL_DIR)\tclxml + +install-expat-includes: + +install-libxml2-includes: + @if not exist $(INCLUDE_INSTALL_DIR)\tclxml-libxml2\nul mkdir $(INCLUDE_INSTALL_DIR)\tclxml-libxml2 + $(CPY) $(INCLUDEDIR)\tclxml-libxml2\*.h $(INCLUDE_INSTALL_DIR)\tclxml-libxml2 + +install-libraries: + @echo Installing to '$(SCRIPT_INSTALL_DIR)' + @if exist $(LIBDIR)\nul $(CPY) $(LIBDIR)\*.tcl $(SCRIPT_INSTALL_DIR) + $(TCLSH) $(WINDIR)\mkPkgIndex.tcl $(LIBDIR)\pkgIndex.tcl.in $(SCRIPT_INSTALL_DIR)\pkgIndex.tcl VERSION=$(DOTVERSION) Tclxml_LIB_FILE=$(PRJLIBNAME) + +install-docs: + +#--------------------------------------------------------------------- +# Clean up +#--------------------------------------------------------------------- + +clean: + @if exist $(TMP_DIR)\nul $(RMDIR) $(TMP_DIR) + +realclean: clean + @if exist $(OUT_DIR)\nul $(RMDIR) $(OUT_DIR) + +distclean: realclean + @if exist $(WINDIR)\nmakehlp.exe del $(WINDIR)\nmakehlp.exe + @if exist $(WINDIR)\nmakehlp.obj del $(WINDIR)\nmakehlp.obj diff --git a/win/mkPkgIndex.tcl b/win/mkPkgIndex.tcl new file mode 100644 index 0000000..63b8e12 --- /dev/null +++ b/win/mkPkgIndex.tcl @@ -0,0 +1,31 @@ +# mkPkgIndex.tcl -- +# +# Helper script for non-TEA installion on Windows. +# This script resolves configure symbols. +# +# Copyright (c) 2003 Zveno Pty Ltd +# http://www.zveno.com/ +# +# See the file "LICENSE" in this distribution for information on usage and +# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# $Id: mkPkgIndex.tcl,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $ + +set infile [lindex $argv 0] +set outfile [lindex $argv 1] + +set ch [open $infile] +set script [read $ch] +close $ch + +set ch [open $outfile w] + +foreach parameter [lrange $argv 2 end] { + regexp {^([^=]+)=(.*)$} $parameter dummy name value + regsub -all @${name}@ $script $value script +} + +puts $ch $script +close $ch + +exit 0 diff --git a/win/nmakehlp.c b/win/nmakehlp.c new file mode 100644 index 0000000..f8c7ea0 --- /dev/null +++ b/win/nmakehlp.c @@ -0,0 +1,297 @@ +/* ---------------------------------------------------------------------------- + * nmakehlp.c -- + * + * This is used to fix limitations within nmake and the environment. + * + * Copyright (c) 2002 by David Gravereaux. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * ---------------------------------------------------------------------------- + * RCS: @(#) $Id: nmakehlp.c,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $ + * ---------------------------------------------------------------------------- + */ +#include +#pragma comment (lib, "user32.lib") +#pragma comment (lib, "kernel32.lib") + +/* protos */ +int CheckForCompilerFeature (const char *option); +int CheckForLinkerFeature (const char *option); +int IsIn (const char *string, const char *substring); +DWORD WINAPI ReadFromPipe (LPVOID args); + +/* globals */ +typedef struct { + HANDLE pipe; + char buffer[1000]; +} pipeinfo; + +pipeinfo Out = {INVALID_HANDLE_VALUE, '\0'}; +pipeinfo Err = {INVALID_HANDLE_VALUE, '\0'}; + + + +/* exitcodes: 0 == no, 1 == yes, 2 == error */ +int +main (int argc, char *argv[]) +{ + char msg[300]; + DWORD dwWritten; + int chars; + + if (argc > 1 && *argv[1] == '-') { + switch (*(argv[1]+1)) { + case 'c': + if (argc != 3) { + chars = wsprintf(msg, "usage: %s -c \n" + "Tests for whether cl.exe supports an option\n" + "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL); + return 2; + } + return CheckForCompilerFeature(argv[2]); + case 'l': + if (argc != 3) { + chars = wsprintf(msg, "usage: %s -l \n" + "Tests for whether link.exe supports an option\n" + "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL); + return 2; + } + return CheckForLinkerFeature(argv[2]); + case 'f': + if (argc == 2) { + chars = wsprintf(msg, "usage: %s -f \n" + "Find a substring within another\n" + "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL); + return 2; + } else if (argc == 3) { + /* if the string is blank, there is no match */ + return 0; + } else { + return IsIn(argv[2], argv[3]); + } + } + } + chars = wsprintf(msg, "usage: %s -c|-l|-f ...\n" + "This is a little helper app to equalize shell differences between WinNT and\n" + "Win9x and get nmake.exe to accomplish its job.\n", + argv[0]); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL); + return 2; +} + +int +CheckForCompilerFeature (const char *option) +{ + STARTUPINFO si; + PROCESS_INFORMATION pi; + SECURITY_ATTRIBUTES sa; + DWORD threadID; + char msg[300]; + BOOL ok; + HANDLE hProcess, h, pipeThreads[2]; + char cmdline[100]; + + hProcess = GetCurrentProcess(); + + ZeroMemory(&pi, sizeof(PROCESS_INFORMATION)); + ZeroMemory(&si, sizeof(STARTUPINFO)); + si.cb = sizeof(STARTUPINFO); + si.dwFlags = STARTF_USESTDHANDLES; + si.hStdInput = INVALID_HANDLE_VALUE; + + ZeroMemory(&sa, sizeof(SECURITY_ATTRIBUTES)); + sa.nLength = sizeof(SECURITY_ATTRIBUTES); + sa.lpSecurityDescriptor = NULL; + sa.bInheritHandle = FALSE; + + /* create a non-inheritible pipe. */ + CreatePipe(&Out.pipe, &h, &sa, 0); + + /* dupe the write side, make it inheritible, and close the original. */ + DuplicateHandle(hProcess, h, hProcess, &si.hStdOutput, + 0, TRUE, DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE); + + /* Same as above, but for the error side. */ + CreatePipe(&Err.pipe, &h, &sa, 0); + DuplicateHandle(hProcess, h, hProcess, &si.hStdError, + 0, TRUE, DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE); + + /* base command line */ + strcpy(cmdline, "cl.exe -nologo -c -TC -Fdtemp "); + /* append our option for testing */ + strcat(cmdline, option); + /* filename to compile, which exists, but is nothing and empty. */ + strcat(cmdline, " nul"); + + ok = CreateProcess( + NULL, /* Module name. */ + cmdline, /* Command line. */ + NULL, /* Process handle not inheritable. */ + NULL, /* Thread handle not inheritable. */ + TRUE, /* yes, inherit handles. */ + DETACHED_PROCESS, /* No console for you. */ + NULL, /* Use parent's environment block. */ + NULL, /* Use parent's starting directory. */ + &si, /* Pointer to STARTUPINFO structure. */ + &pi); /* Pointer to PROCESS_INFORMATION structure. */ + + if (!ok) { + DWORD err = GetLastError(); + int chars = wsprintf(msg, "Tried to launch: \"%s\", but got error [%u]: ", cmdline, err); + + FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS | + FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPVOID) &msg[chars], + (300-chars), 0); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, strlen(msg), &err, NULL); + return 2; + } + + /* close our references to the write handles that have now been inherited. */ + CloseHandle(si.hStdOutput); + CloseHandle(si.hStdError); + + WaitForInputIdle(pi.hProcess, 5000); + CloseHandle(pi.hThread); + + /* start the pipe reader threads. */ + pipeThreads[0] = CreateThread(NULL, 0, ReadFromPipe, &Out, 0, &threadID); + pipeThreads[1] = CreateThread(NULL, 0, ReadFromPipe, &Err, 0, &threadID); + + /* block waiting for the process to end. */ + WaitForSingleObject(pi.hProcess, INFINITE); + CloseHandle(pi.hProcess); + + /* clean up temporary files before returning */ + DeleteFile("temp.idb"); + DeleteFile("temp.pdb"); + + /* wait for our pipe to get done reading, should it be a little slow. */ + WaitForMultipleObjects(2, pipeThreads, TRUE, 500); + CloseHandle(pipeThreads[0]); + CloseHandle(pipeThreads[1]); + + /* look for the commandline warning code in both streams. */ + return !(strstr(Out.buffer, "D4002") != NULL || strstr(Err.buffer, "D4002") != NULL); +} + +int +CheckForLinkerFeature (const char *option) +{ + STARTUPINFO si; + PROCESS_INFORMATION pi; + SECURITY_ATTRIBUTES sa; + DWORD threadID; + char msg[300]; + BOOL ok; + HANDLE hProcess, h, pipeThreads[2]; + char cmdline[100]; + + hProcess = GetCurrentProcess(); + + ZeroMemory(&pi, sizeof(PROCESS_INFORMATION)); + ZeroMemory(&si, sizeof(STARTUPINFO)); + si.cb = sizeof(STARTUPINFO); + si.dwFlags = STARTF_USESTDHANDLES; + si.hStdInput = INVALID_HANDLE_VALUE; + + ZeroMemory(&sa, sizeof(SECURITY_ATTRIBUTES)); + sa.nLength = sizeof(SECURITY_ATTRIBUTES); + sa.lpSecurityDescriptor = NULL; + sa.bInheritHandle = TRUE; + + /* create a non-inheritible pipe. */ + CreatePipe(&Out.pipe, &h, &sa, 0); + + /* dupe the write side, make it inheritible, and close the original. */ + DuplicateHandle(hProcess, h, hProcess, &si.hStdOutput, + 0, TRUE, DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE); + + /* Same as above, but for the error side. */ + CreatePipe(&Err.pipe, &h, &sa, 0); + DuplicateHandle(hProcess, h, hProcess, &si.hStdError, + 0, TRUE, DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE); + + /* base command line */ + strcpy(cmdline, "link.exe -nologo "); + /* append our option for testing */ + strcat(cmdline, option); + /* filename to compile, which exists, but is nothing and empty. */ +// strcat(cmdline, " nul"); + + ok = CreateProcess( + NULL, /* Module name. */ + cmdline, /* Command line. */ + NULL, /* Process handle not inheritable. */ + NULL, /* Thread handle not inheritable. */ + TRUE, /* yes, inherit handles. */ + DETACHED_PROCESS, /* No console for you. */ + NULL, /* Use parent's environment block. */ + NULL, /* Use parent's starting directory. */ + &si, /* Pointer to STARTUPINFO structure. */ + &pi); /* Pointer to PROCESS_INFORMATION structure. */ + + if (!ok) { + DWORD err = GetLastError(); + int chars = wsprintf(msg, "Tried to launch: \"%s\", but got error [%u]: ", cmdline, err); + + FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS | + FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPVOID) &msg[chars], + (300-chars), 0); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, strlen(msg), &err, NULL); + return 2; + } + + /* close our references to the write handles that have now been inherited. */ + CloseHandle(si.hStdOutput); + CloseHandle(si.hStdError); + + WaitForInputIdle(pi.hProcess, 5000); + CloseHandle(pi.hThread); + + /* start the pipe reader threads. */ + pipeThreads[0] = CreateThread(NULL, 0, ReadFromPipe, &Out, 0, &threadID); + pipeThreads[1] = CreateThread(NULL, 0, ReadFromPipe, &Err, 0, &threadID); + + /* block waiting for the process to end. */ + WaitForSingleObject(pi.hProcess, INFINITE); + CloseHandle(pi.hProcess); + + /* wait for our pipe to get done reading, should it be a little slow. */ + WaitForMultipleObjects(2, pipeThreads, TRUE, 500); + CloseHandle(pipeThreads[0]); + CloseHandle(pipeThreads[1]); + + /* look for the commandline warning code in the stderr stream. */ + return !(strstr(Out.buffer, "LNK1117") != NULL || strstr(Err.buffer, "LNK1117") != NULL); +} + +DWORD WINAPI +ReadFromPipe (LPVOID args) +{ + pipeinfo *pi = (pipeinfo *) args; + char *lastBuf = pi->buffer; + DWORD dwRead; + BOOL ok; + +again: + ok = ReadFile(pi->pipe, lastBuf, 25, &dwRead, 0L); + if (!ok || dwRead == 0) { + CloseHandle(pi->pipe); + return 0; + } + lastBuf += dwRead; + goto again; + + return 0; /* makes the compiler happy */ +} + +int +IsIn (const char *string, const char *substring) +{ + return (strstr(string, substring) != NULL); +} diff --git a/win/rules.vc b/win/rules.vc new file mode 100644 index 0000000..a337669 --- /dev/null +++ b/win/rules.vc @@ -0,0 +1,376 @@ +#------------------------------------------------------------------------------ +# rules.vc -- +# +# Microsoft Visual C++ makefile include for decoding the commandline +# macros. This file does not need editing to build Tcl. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# Copyright (c) 2001-2002 David Gravereaux. +# +#------------------------------------------------------------------------------ +# RCS: @(#) $Id: rules.vc,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $ +#------------------------------------------------------------------------------ + +!ifndef _RULES_VC +_RULES_VC = 1 + +cc32 = $(CC) # built-in default. +link32 = link +lib32 = lib +rc32 = $(RC) # built-in default. + +!ifndef INSTALLDIR +### Assume the normal default. +_INSTALLDIR = C:\Program Files\Tcl +!else +### Fix the path seperators. +_INSTALLDIR = $(INSTALLDIR:/=\) +!endif + +!ifndef MACHINE +MACHINE = IX86 +!endif + +!ifndef CFG_ENCODING +CFG_ENCODING = \"cp1252\" +!endif + +#---------------------------------------------------------- +# Set the proper copy method to avoid overwrite questions +# to the user when copying files and selecting the right +# "delete all" method. +#---------------------------------------------------------- + +!if "$(OS)" == "Windows_NT" +RMDIR = rmdir /S /Q +!if ![ver | find "4.0" > nul] +CPY = echo y | xcopy /i +!else +CPY = xcopy /i /y +!endif +!else +CPY = xcopy /i +RMDIR = deltree /Y +!endif + + +!message =============================================================================== + +#---------------------------------------------------------- +# build the helper app we need to overcome nmake's limiting +# environment. +#---------------------------------------------------------- + +!if !exist(nmakehlp.exe) +!if [$(cc32) -nologo -ML nmakehlp.c -link -subsystem:console > nul] +!endif +!endif + +#---------------------------------------------------------- +# Test for compiler features +#---------------------------------------------------------- + +### test for optimizations +!if [nmakehlp -c -Otip] +!message *** Compiler has 'Optimizations' +OPTIMIZING = 1 +!else +!message *** Compiler doesn't have 'Optimizations' +OPTIMIZING = 0 +!endif + +!if "$(MACHINE)" == "IX86" +### test for pentium errata +!if [nmakehlp -c -QI0f] +!message *** Compiler has 'Pentium 0x0f fix' +PENT_0F_ERRATA = 1 +!else +!message *** Compiler doesn't have 'Pentium 0x0f fix' +PENT_0F_ERRATA = 0 +!endif +### test for -align:4096, when align:512 will do. +!if [nmakehlp -l -opt:nowin98] +!message *** Linker has 'Win98 alignment problem' +ALIGN98_HACK = 1 +!else +!message *** Linker doesn't have 'Win98 alignment problem' +ALIGN98_HACK = 0 +!endif +!else +PENT_0F_ERRATA = 0 +ALIGN98_HACK = 0 +!endif + +!if "$(MACHINE)" == "IA64" +### test for Itanium errata +!if [nmakehlp -c -QIA64_Bx] +!message *** Compiler has 'B-stepping errata workarounds' +ITAN_B_ERRATA = 1 +!else +!message *** Compiler doesn't have 'B-stepping errata workarounds' +ITAN_B_ERRATA = 0 +!endif +!else +ITAN_B_ERRATA = 0 +!endif + +#---------------------------------------------------------- +# Decode the options requested. +#---------------------------------------------------------- + +!if "$(OPTS)" == "" || [nmakehlp -f "$(OPTS)" "none"] +STATIC_BUILD = 0 +TCL_THREADS = 0 +DEBUG = 0 +PROFILE = 0 +MSVCRT = 0 +LOIMPACT = 0 +TCL_USE_STATIC_PACKAGES = 0 +USE_THREAD_ALLOC = 0 +!else +!if [nmakehlp -f $(OPTS) "static"] +!message *** Doing static +STATIC_BUILD = 1 +!else +STATIC_BUILD = 0 +!endif +!if [nmakehlp -f $(OPTS) "msvcrt"] +!message *** Doing msvcrt +MSVCRT = 1 +!else +MSVCRT = 0 +!endif +!if [nmakehlp -f $(OPTS) "staticpkg"] +!message *** Doing staticpkg +TCL_USE_STATIC_PACKAGES = 1 +!else +TCL_USE_STATIC_PACKAGES = 0 +!endif +!if [nmakehlp -f $(OPTS) "threads"] +!message *** Doing threads +TCL_THREADS = 1 +!else +TCL_THREADS = 0 +!endif +!if [nmakehlp -f $(OPTS) "symbols"] +!message *** Doing symbols +DEBUG = 1 +!else +DEBUG = 0 +!endif +!if [nmakehlp -f $(OPTS) "profile"] +!message *** Doing profile +PROFILE = 1 +!else +PROFILE = 0 +!endif +!if [nmakehlp -f $(OPTS) "loimpact"] +!message *** Doing loimpact +LOIMPACT = 1 +!else +LOIMPACT = 0 +!endif +!if [nmakehlp -f $(OPTS) "thrdalloc"] +!message *** Doing thrdalloc +USE_THREAD_ALLOC = 1 +!else +USE_THREAD_ALLOC = 0 +!endif +!endif + + +!if !$(STATIC_BUILD) +# Make sure we don't build overly fat DLLs. +MSVCRT = 1 +# We shouldn't statically put the extensions inside the shell when dynamic. +TCL_USE_STATIC_PACKAGES = 0 +!endif + + +#---------------------------------------------------------- +# Figure-out how to name our intermediate and output directories. +# We wouldn't want different builds to use the same .obj files +# by accident. +#---------------------------------------------------------- + +SUFX = tsgx + +!if $(DEBUG) +BUILDDIRTOP = Debug +DBGX = g +!else +BUILDDIRTOP = Release +DBGX = +SUFX = $(SUFX:g=) +!endif + +TMP_DIRFULL = .\$(BUILDDIRTOP)\$(PROJECT)_ThreadedDynamicStaticX + +!if !$(STATIC_BUILD) +TMP_DIRFULL = $(TMP_DIRFULL:Static=) +SUFX = $(SUFX:s=) +EXT = dll +!if $(MSVCRT) +TMP_DIRFULL = $(TMP_DIRFULL:X=) +SUFX = $(SUFX:x=) +!endif +!else +TMP_DIRFULL = $(TMP_DIRFULL:Dynamic=) +EXT = lib +!if !$(MSVCRT) +TMP_DIRFULL = $(TMP_DIRFULL:X=) +SUFX = $(SUFX:x=) +!endif +!endif + +!if !$(TCL_THREADS) +TMP_DIRFULL = $(TMP_DIRFULL:Threaded=) +SUFX = $(SUFX:t=) +!endif + +!ifndef TMP_DIR +TMP_DIR = $(TMP_DIRFULL) +!ifndef OUT_DIR +OUT_DIR = .\$(BUILDDIRTOP) +!endif +!else +!ifndef OUT_DIR +OUT_DIR = $(TMP_DIR) +!endif +!endif + + +#---------------------------------------------------------- +# Decode the statistics requested. +#---------------------------------------------------------- + +!if "$(STATS)" == "" || [nmakehlp -f "$(STATS)" "none"] +TCL_MEM_DEBUG = 0 +TCL_COMPILE_DEBUG = 0 +!else +!if [nmakehlp -f $(STATS) "memdbg"] +!message *** Doing memdbg +TCL_MEM_DEBUG = 1 +!else +TCL_MEM_DEBUG = 0 +!endif +!if [nmakehlp -f $(STATS) "compdbg"] +!message *** Doing compdbg +TCL_COMPILE_DEBUG = 1 +!else +TCL_COMPILE_DEBUG = 0 +!endif +!endif + + +#---------------------------------------------------------- +# Set our defines now armed with our options. +#---------------------------------------------------------- + +OPTDEFINES = -DTCL_CFGVAL_ENCODING=$(CFG_ENCODING) + +!if $(TCL_MEM_DEBUG) +OPTDEFINES = -DTCL_MEM_DEBUG +!endif +!if $(TCL_COMPILE_DEBUG) +OPTDEFINES = $(OPTDEFINES) -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS +!endif +!if $(TCL_THREADS) +OPTDEFINES = $(OPTDEFINES) -DTCL_THREADS=1 +!if $(USE_THREAD_ALLOC) +OPTDEFINES = $(OPTDEFINES) -DUSE_THREAD_ALLOC=1 +!endif +!endif +!if $(STATIC_BUILD) +OPTDEFINES = $(OPTDEFINES) -DSTATIC_BUILD +!endif + +!if $(DEBUG) +OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_DEBUG +!elseif $(OPTIMIZING) +OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_OPTIMIZED +!endif +!if $(PROFILE) +OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_PROFILED +!endif +!if "$(MACHINE)" == "IA64" +OPTDEFINES = $(OPTDEFINES) -DTCL_CFG_DO64BIT +!endif + + +#---------------------------------------------------------- +# Get common info used when building extensions. +#---------------------------------------------------------- + +!if "$(PROJECT)" != "tcl" + +!if !defined(TCLDIR) +!if exist("$(_INSTALLDIR)\include\tcl.h") +TCLINSTALL = 1 +_TCLDIR = $(_INSTALLDIR) +!else +MSG=^ +Don't know where tcl.h is. Set the TCLDIR macro. +!error $(MSG) +!endif +!else +_TCLDIR = $(TCLDIR:/=\) +!if exist("$(_TCLDIR)\include\tcl.h") +TCLINSTALL = 1 +!elseif exist("$(_TCLDIR)\generic\tcl.h") +TCLINSTALL = 0 +!else +MSG =^ +Don't know where tcl.h is. The TCLDIR macro doesn't appear correct. +!error $(MSG) +!endif +!endif + +### TODO: add a command to nmakehlp.c to grep for Tcl's version from tcl.h. +### Because nmake can't return a string, we'll need to play games with return +### codes. It might look something like this: +#!if [nmakehlp -g $(TCL.H)] == 81 +#TCL_DOTVERSION = 8.1 +#!elseif [nmakehlp -g $(TCL.H)] == 82 +#TCL_DOTVERSION = 8.2 +#... +#!endif + +TCL_DOTVERSION = 8.4 +TCL_VERSION = $(TCL_DOTVERSION:.=) + +!if $(TCLINSTALL) +TCLSH = "$(_INSTALLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX).exe" +TCLSTUBLIB = "$(_INSTALLDIR)\lib\tclstub$(TCL_VERSION).lib" +TCLIMPLIB = "$(_INSTALLDIR)\lib\tcl$(TCL_VERSION)$(SUFX).lib" +TCL_LIBRARY = $(_INSTALLDIR)\lib +TCLREGLIB = "$(_INSTALLDIR)\lib\tclreg11$(SUFX:t=).lib" +TCLDDELIB = "$(_INSTALLDIR)\lib\tcldde12$(SUFX:t=).lib" +COFFBASE = \must\have\tcl\sources\to\build\this\target +TCLTOOLSDIR = \must\have\tcl\sources\to\build\this\target +!else +TCLSH = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)$(SUFX).exe" +TCLSTUBLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib" +TCLIMPLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX).lib" +TCL_LIBRARY = $(_TCLDIR)\library +TCLREGLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg11$(SUFX:t=).lib" +TCLDDELIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde12$(SUFX:t=).lib" +COFFBASE = "$(_TCLDIR)\win\coffbase.txt" +TCLTOOLSDIR = $(_TCLDIR)\tools +!endif + +!endif + + +#---------------------------------------------------------- +# Display stats being used. +#---------------------------------------------------------- + +!message *** Intermediate directory will be '$(TMP_DIR)' +!message *** Output directory will be '$(OUT_DIR)' +!message *** Suffix for binaries will be '$(SUFX)' +!message *** Optional defines are '$(OPTDEFINES)' + +!endif -- cgit v0.12