[SCM] General FITS file browser/editor/plotter with a gui branch, upstream+dfsg, updated. fe2fd4e4c033d4fe212d15d997916216d7a839d1
Ole Streicher
debian at liska.ath.cx
Thu Aug 23 13:37:55 UTC 2012
The following commit has been merged in the upstream+dfsg branch:
commit fe2fd4e4c033d4fe212d15d997916216d7a839d1
Author: Ole Streicher <debian at liska.ath.cx>
Date: Thu Aug 23 15:04:08 2012 +0200
Remove unneeded (and partly GPLed) "mktclapp" files
diff --git a/ftools/guis/fv/unix/Et_AppInit.c b/ftools/guis/fv/unix/Et_AppInit.c
deleted file mode 100644
index 2bc3267..0000000
--- a/ftools/guis/fv/unix/Et_AppInit.c
+++ /dev/null
@@ -1,77 +0,0 @@
-#include <tk.h>
-#include <tix.h>
-#include <itcl.h>
-#include <itk.h>
-#include "pow.h"
-#include "fitsTcl.h"
-#include "fvexec.h"
-
-int Et_AppInit(Tcl_Interp *interp)
-{
-
- if (Itcl_Init(interp) == TCL_ERROR) {
- return TCL_ERROR;
- }
-
- /*
- * This is itclsh, so import all [incr Tcl] commands by
- * default into the global namespace. Fix up the autoloader
- * to do the same.
- */
- if (Tcl_Import(interp, Tcl_GetGlobalNamespace(interp),
- "::itcl::*", /* allowOverwrite */ 1) != TCL_OK) {
- return TCL_ERROR;
- }
-
- if (Tcl_Eval(interp, "auto_mkindex_parser::slavehook { _%@namespace import -force ::itcl::* }") != TCL_OK) {
- return TCL_ERROR;
- }
-
- if (Itk_Init(interp) == TCL_ERROR) {
- return TCL_ERROR;
- }
-
- /*
- * This is itclsh, so import all [incr Tcl] commands by
- * default into the global namespace. Fix up the autoloader
- * to do the same.
- */
- if (Tcl_Import(interp, Tcl_GetGlobalNamespace(interp),
- "::itk::*", /* allowOverwrite */ 1) != TCL_OK) {
- return TCL_ERROR;
- }
-
- if (Tcl_Eval(interp, "auto_mkindex_parser::slavehook { _%@namespace import -force ::itk::* }") != TCL_OK) {
- return TCL_ERROR;
- }
-
- if (Fits_Init(interp) == TCL_ERROR) {
- return TCL_ERROR;
- }
-
- if (Pow_InitExec(interp) == TCL_ERROR) {
- return TCL_ERROR;
- }
-
- putenv("TIX_LIBRARY=../../tklib/Tix8.4");
- putenv("TIX_VERSION=8.4");
-
- if (Tix_Init(interp) == TCL_ERROR) {
- fprintf(stderr, "Error init TIX\n");
- return TCL_ERROR;
- }
-
- Tcl_StaticPackage(interp, "Tix", Tix_Init, (Tcl_PackageInitProc *) NULL);
-
- /* Pan Chai: add XPA shared library */
-
- if (Tclxpa_Init(interp) == TCL_ERROR) {
- fprintf(stderr, "Error init XPA, don't know why?\n");
- return TCL_ERROR;
- }
-
- Tcl_StaticPackage(interp, "tclxpa", Tclxpa_Init, NULL);
-
- return TCL_OK;
-}
-
diff --git a/ftools/guis/fv/unix/Makefile b/ftools/guis/fv/unix/Makefile
deleted file mode 100644
index 699cabf..0000000
--- a/ftools/guis/fv/unix/Makefile
+++ /dev/null
@@ -1,92 +0,0 @@
-HD_COMPONENT_NAME = ftools
-
-HD_CTASK = fv
-
-FV_VERSION = 5.3
-
-PKG_ARCH = `uname`
-
-PKG_DIR = fv${FV_VERSION}
-
-PKG_FILE = fv${FV_VERSION}_${PKG_ARCH}.tar
-
-HD_CTASK_SRC_c = fvexec.c Et_AppInit.c
-
-HD_CFLAGS = ${FV_CFLAGS} \
- -I${HC_BLD_EXEC_PFX}/include \
- -I${TCLTK_BLD_EXEC_PFX}/include \
- -I${TIX_DIR}/generic \
- -I${HD_BLD_INC} ${XINCLUDES}
-
-HD_CLIBS = ${HC_BLD_EXEC_PFX}/lib/lib${CFITSIO}.a \
- ${HC_BLD_EXEC_PFX}/lib/lib${WCSLIB}.a \
- ${TCLTK_BLD_EXEC_PFX}/lib/libpow.a \
- ${TCLTK_BLD_EXEC_PFX}/lib/${ITCL}/lib${ITCL}.a \
- ${TCLTK_BLD_EXEC_PFX}/lib/${ITK}/lib${ITK}.a \
- ${TCLTK_BLD_EXEC_PFX}/lib/lib${TCL}.a \
- ${TCLTK_BLD_EXEC_PFX}/lib/lib${TK}.a \
- ${TCLTK_BLD_EXEC_PFX}/lib/lib${XPA}.a \
- ${TCLTK_BLD_EXEC_PFX}/lib/${TIX}/lib${TIX}.a \
- ${HD_BLD_LIB}/libfitstcl.a \
- ${XLIBS} ${FV_LIBS}
-
-LD_FLAGS_C = ${FV_CFLAGS} ${FV_LDFLAGS}
-
-HD_INSTALL_TASKS = ${HD_CTASK}
-
-HD_CLEAN = ${PKG_DIR} ${PKG_FILE}.gz pow
-
-HD_DISTCLEAN = fvexec.c fvexec.h mktclapp tklib
-
-include ${HD_STD_MAKEFILE}
-
-fvexec:
- @${HD_INSTALL} ${TCLTK_BLD_EXEC_PFX}/lib/${TCL} tklib/${TCL} ${HD_CP_P}
- @${HD_INSTALL} ${TCLTK_BLD_EXEC_PFX}/lib/${TK} tklib/${TK} ${HD_CP_P}
- @${HD_INSTALL} ${TCLTK_BLD_EXEC_PFX}/lib/${ITCL} \
- tklib/${ITCL} ${HD_CP_P}
- @${HD_INSTALL} ${TCLTK_BLD_EXEC_PFX}/lib/${ITK} tklib/${ITK} ${HD_CP_P}
- @${HD_INSTALL} ${TCLTK_BLD_EXEC_PFX}/lib/${IWIDGETS} \
- tklib/${IWIDGETS} ${HD_CP_P}
- @${HD_INSTALL} ${TCLTK_BLD_EXEC_PFX}/lib/${TIX} tklib/${TIX} ${HD_CP_P}
- @-rm -f tklib/${TIX}/Init.tcl
- @${HD_INSTALL} ${TIX_DIR}/library/Init.tcl.fv \
- tklib/${TIX}/Init.tcl ${HD_CP}
- @${HD_INSTALL} ${XPA_DIR}/pkgIndex.tcl tklib/xpa/pkgIndex.tcl ${HD_CP_P}
- @${HD_INSTALL} ${XPA_DIR}/test.tcl tklib/xpa/test.tcl ${HD_CP_P}
- @${HD_INSTALL} ${XPA_DIR}/xpainfo.tcl tklib/xpa/xpainfo.tcl ${HD_CP_P}
- @cd ${HD_SRC}/../tcltk/pow; ../BUILD_DIR/hmake install-pow-extras \
- HD_LIB=${HD_SRC}/guis/fv/unix/tklib POW_EXTRAS="" POW_HTML=""
- @${HD_BUILD_DIR}/hmake mktclapp HD_CTASK=mktclapp \
- HD_CTASK_SRC_c=mktclapp.c HD_CFLAGS="" LD_FLAGS="" HD_CLIBS=""
- @PATH=.:${PATH}; export PATH; \
- ${TCLTK_BLD_EXEC_PFX}/bin/wish xmktclapp.tcl &
-
-fvpkg:
- @${HD_INSTALL} ${HD_CTASK} ${PKG_DIR}/${HD_CTASK} ${HD_CP_P}
- @${HD_INSTALL} ${XPA_DIR}/xpaaccess ${PKG_DIR}/xpabin/xpaaccess ${HD_CP_P}
- @${HD_INSTALL} ${XPA_DIR}/xpaget ${PKG_DIR}/xpabin/xpaget ${HD_CP_P}
- @${HD_INSTALL} ${XPA_DIR}/xpainfo ${PKG_DIR}/xpabin/xpainfo ${HD_CP_P}
- @${HD_INSTALL} ${XPA_DIR}/xpamb ${PKG_DIR}/xpabin/xpamb ${HD_CP_P}
- @${HD_INSTALL} ${XPA_DIR}/xpans ${PKG_DIR}/xpabin/xpans ${HD_CP_P}
- @${HD_INSTALL} ${XPA_DIR}/xpaset ${PKG_DIR}/xpabin/xpaset ${HD_CP_P}
- @${HD_INSTALL} tklib/${TIX} ${PKG_DIR}/${TIX} ${HD_CP_P}
- @cd ${HD_SRC}/../tcltk/pow; ../BUILD_DIR/hmake install-pow-extras \
- HD_LIB=${HD_SRC}/guis/fv/unix POW_EXTRAS="" POW_TCL=""
- @${HD_INSTALL} pow ${PKG_DIR}/doc ${HD_CP_P}
- @${HD_INSTALL} ../doc ${PKG_DIR}/doc ${HD_CP_P}
- @${HD_INSTALL} ../Release_Notes ${PKG_DIR}/Release_Notes ${HD_CP_P}
- @${HD_INSTALL} ../sample_data ${PKG_DIR}/sample_data ${HD_CP_P}
- @${HD_INSTALL} ../scripts ${PKG_DIR}/sample_scripts ${HD_CP_P}
- @-rm -f ${PKG_DIR}/${TIX}/lib*
- @-rm -rf ${PKG_DIR}/doc/CVS
- @-rm -rf ${PKG_DIR}/sample_data/CVS
- @-rm -rf ${PKG_DIR}/sample_scripts/CVS
- @cd ${PKG_DIR}/doc; \
- sed -e "s:..\/..\/pow\/::" fv_scripting.html > fv_scripting.html-edit; \
- sed -e "s:..\/fv\/doc\/::" Scripting.html > Scripting.html-edit; \
- ${HD_INSTALL} fv_scripting.html-edit fv_scripting.html "mv -f"; \
- ${HD_INSTALL} Scripting.html-edit Scripting.html "mv -f"
- @-rm -f ${PKG_FILE} ${PKG_FILE}.gz
- @echo "tar cf ${PKG_FILE} ${PKG_DIR}"; tar cf ${PKG_FILE} ${PKG_DIR}
- @echo "gzip ${PKG_FILE}"; gzip ${PKG_FILE}
diff --git a/ftools/guis/fv/unix/README b/ftools/guis/fv/unix/README
deleted file mode 100644
index 5c7f5e6..0000000
--- a/ftools/guis/fv/unix/README
+++ /dev/null
@@ -1,52 +0,0 @@
-Procedure for building the FV stand-alone binary (PC Linux, Solaris/SunOS,
-and Mac/Darwin Universal Binary):
-
-1) With CVSROOT=":pserver:<username>@daria:/headas", log in to the
- cvs server and check out the "fv" module:
-
- cvs co fv
-
- * If building on Darwin 10.4 or newer, patches must be applied to
- some Tcl/Tk code in order for the binary to work on Darwin 10.3:
-
- Index: tcltk/tcl/macosx/tclMacOSXNotify.c
- ===================================================================
- diff -r1.1 tclMacOSXNotify.c
- 159a160
- > #undef HAVE_OSSPINLOCKLOCK
- Index: tcltk/tk/macosx/tkMacOSXWm.c
- ===================================================================
- diff -r1.2 tkMacOSXWm.c
- 22a23,24
- > #define MAC_OS_X_VERSION_MAX_ALLOWED MAC_OS_X_VERSION_10_3
- >
-
-
-2) Configure:
-
- cd headas/BUILD_DIR
- ./configure --enable-fv-standalone
-
-3) Build the libraries:
-
- make
-
-4) Build the fv executable source code (fvexec.c & fvexec.h):
-
- cd ../ftools/guis/fv/unix
- ../../../BUILD_DIR/hmake fvexec
-
- This populates ./tklib (needed to create the fv source code) and
- runs the mktclapp GUI. In the start-up window of the mktclapp GUI
- (the "Settings" tab), press "build". If it notifies you that fvexec.c
- and fvexec.h were built without errors, continue to the next step.
-
-5) Build the fv executable:
-
- ../../../BUILD_DIR/hmake
-
-6) Package everything up into a tar file:
-
- ../../../BUILD_DIR/hmake fvpkg
-
- You should now have a zipped tar file "fvX.X_<OS-Name>.tar.gz".
diff --git a/ftools/guis/fv/unix/appinit.mta b/ftools/guis/fv/unix/appinit.mta
deleted file mode 100644
index bc25b35..0000000
--- a/ftools/guis/fv/unix/appinit.mta
+++ /dev/null
@@ -1,306 +0,0 @@
-# Configuration file generated by xmktclapp
-# Hand editing is not recommended
-#
-# The "xmktclapp" program reads the lines that begin with "##".
-# The "mktclapp" program reads lines that don't begin with "#".
-# Lines beginning with a single "#" are comment.
-#
-## Autofork No
-## CFile:Et_AppInit.c 1
-## CmdLine None
-## ConfigFile appinit.mta
-## MainScript fvInit.tcl
-## Mode Tcl/Tk
-## NoSource No
-## OtherLib:../class 1
-## OtherLib:tklib/Tix8.4 1
-## OtherLib:tklib/Tix8.4/bitmaps 1
-## OtherLib:tklib/Tix8.4/pref 1
-## OtherLib:tklib/itcl3.3 1
-## OtherLib:tklib/itk3.3 1
-## OtherLib:tklib/iwidgets4.0.1 1
-## OtherLib:tklib/iwidgets4.0.1/scripts 1
-## OtherLib:tklib/pow 1
-## OtherLib:tklib/tcl8.4/http2.5 1
-## OtherLib:tklib/tcl8.4/msgcat1.3 1
-## OtherLib:tklib/xpa 1
-## OutputFile fvexec.c
-## Shroud No
-## Standalone Yes
-## TclFile:fvInit.tcl 1
-## TclLib tklib/tcl8.4
-## TkLib tklib/tk8.4
-## saved-Autofork No
-## saved-CmdLine None
-## saved-Standalone No
-#
--main-script "fvInit.tcl"
--tcl-library "tklib/tcl8.4"
--tk-library "tklib/tk8.4"
--strip-tcl "../class/CubeImage.tcl"
--strip-tcl "../class/FVFile.tcl"
--strip-tcl "../class/FVFtool.tcl"
--strip-tcl "../class/FVSkyview.tcl"
--strip-tcl "../class/FVVizier.tcl"
--strip-tcl "../class/FitsBaseCalculator.tcl"
--strip-tcl "../class/FitsCalculator.tcl"
--strip-tcl "../class/FitsClipBoard.tcl"
--strip-tcl "../class/FitsDelCalculator.tcl"
--strip-tcl "../class/FitsExtension.tcl"
--strip-tcl "../class/FitsFile.tcl"
--strip-tcl "../class/FitsFileSelection.tcl"
--strip-tcl "../class/FitsHeader.tcl"
--strip-tcl "../class/FitsHistoParam.tcl"
--strip-tcl "../class/FitsImage.tcl"
--strip-tcl "../class/FitsImgPlotSel.tcl"
--strip-tcl "../class/FitsPlotSel.tcl"
--strip-tcl "../class/FitsSelCalculator.tcl"
--strip-tcl "../class/FitsTable.tcl"
--strip-tcl "../class/NewExtension.tcl"
--strip-tcl "../class/NewFITS.tcl"
--strip-tcl "../class/NewImage.tcl"
--strip-tcl "../class/NewTable.tcl"
--strip-tcl "../class/RemoteAccess.tcl"
--strip-tcl "../class/Table.tcl"
--strip-tcl "../class/VectorTable.tcl"
--strip-tcl "../class/WFPC2Image.tcl"
--strip-tcl "../class/XPA_access.tcl"
--strip-tcl "../class/fedit.tcl"
--strip-tcl "../class/ftp_lib.tcl"
--strip-tcl "../class/fvApp.tcl"
--strip-tcl "../class/fvPreferences.tcl"
--strip-tcl "../class/fvWinKeeper.tcl"
--strip-tcl "../class/tclIndex"
--strip-tcl "tklib/Tix8.4/Balloon.tcl"
--strip-tcl "tklib/Tix8.4/BtnBox.tcl"
--strip-tcl "tklib/Tix8.4/CObjView.tcl"
--strip-tcl "tklib/Tix8.4/ChkList.tcl"
--strip-tcl "tklib/Tix8.4/ComboBox.tcl"
--strip-tcl "tklib/Tix8.4/Compat.tcl"
--strip-tcl "tklib/Tix8.4/Console.tcl"
--strip-tcl "tklib/Tix8.4/Control.tcl"
--strip-tcl "tklib/Tix8.4/DefSchm.tcl"
--strip-tcl "tklib/Tix8.4/DialogS.tcl"
--strip-tcl "tklib/Tix8.4/DirBox.tcl"
--strip-tcl "tklib/Tix8.4/DirDlg.tcl"
--strip-tcl "tklib/Tix8.4/DirList.tcl"
--strip-tcl "tklib/Tix8.4/DirTree.tcl"
--strip-tcl "tklib/Tix8.4/DragDrop.tcl"
--strip-tcl "tklib/Tix8.4/DtlList.tcl"
--strip-tcl "tklib/Tix8.4/EFileBox.tcl"
--strip-tcl "tklib/Tix8.4/EFileDlg.tcl"
--strip-tcl "tklib/Tix8.4/Event.tcl"
--strip-tcl "tklib/Tix8.4/FileBox.tcl"
--strip-tcl "tklib/Tix8.4/FileCbx.tcl"
--strip-tcl "tklib/Tix8.4/FileDlg.tcl"
--strip-tcl "tklib/Tix8.4/FileEnt.tcl"
--strip-tcl "tklib/Tix8.4/FloatEnt.tcl"
--strip-tcl "tklib/Tix8.4/Grid.tcl"
--strip-tcl "tklib/Tix8.4/HList.tcl"
--strip-tcl "tklib/Tix8.4/HListDD.tcl"
--strip-tcl "tklib/Tix8.4/IconView.tcl"
--strip-tcl "tklib/Tix8.4/Init.tcl"
--strip-tcl "tklib/Tix8.4/LabEntry.tcl"
--strip-tcl "tklib/Tix8.4/LabFrame.tcl"
--strip-tcl "tklib/Tix8.4/LabWidg.tcl"
--strip-tcl "tklib/Tix8.4/ListNBk.tcl"
--strip-tcl "tklib/Tix8.4/Meter.tcl"
--strip-tcl "tklib/Tix8.4/MultView.tcl"
--strip-tcl "tklib/Tix8.4/NoteBook.tcl"
--strip-tcl "tklib/Tix8.4/OldUtil.tcl"
--strip-tcl "tklib/Tix8.4/OptMenu.tcl"
--strip-tcl "tklib/Tix8.4/PanedWin.tcl"
--strip-tcl "tklib/Tix8.4/PopMenu.tcl"
--strip-tcl "tklib/Tix8.4/Primitiv.tcl"
--strip-tcl "tklib/Tix8.4/ResizeH.tcl"
--strip-tcl "tklib/Tix8.4/SGrid.tcl"
--strip-tcl "tklib/Tix8.4/SHList.tcl"
--strip-tcl "tklib/Tix8.4/SListBox.tcl"
--strip-tcl "tklib/Tix8.4/STList.tcl"
--strip-tcl "tklib/Tix8.4/SText.tcl"
--strip-tcl "tklib/Tix8.4/SWidget.tcl"
--strip-tcl "tklib/Tix8.4/SWindow.tcl"
--strip-tcl "tklib/Tix8.4/Select.tcl"
--strip-tcl "tklib/Tix8.4/Shell.tcl"
--strip-tcl "tklib/Tix8.4/SimpDlg.tcl"
--strip-tcl "tklib/Tix8.4/StackWin.tcl"
--strip-tcl "tklib/Tix8.4/StatBar.tcl"
--strip-tcl "tklib/Tix8.4/StdBBox.tcl"
--strip-tcl "tklib/Tix8.4/StdShell.tcl"
--strip-tcl "tklib/Tix8.4/TList.tcl"
--strip-tcl "tklib/Tix8.4/Tix.tcl"
--strip-tcl "tklib/Tix8.4/Tree.tcl"
--strip-tcl "tklib/Tix8.4/Utils.tcl"
--strip-tcl "tklib/Tix8.4/VResize.tcl"
--strip-tcl "tklib/Tix8.4/VStack.tcl"
--strip-tcl "tklib/Tix8.4/VTree.tcl"
--strip-tcl "tklib/Tix8.4/Variable.tcl"
--strip-tcl "tklib/Tix8.4/WInfo.tcl"
--strip-tcl "tklib/Tix8.4/bitmaps/mktransgif.tcl"
--strip-tcl "tklib/Tix8.4/fs.tcl"
--strip-tcl "tklib/Tix8.4/pkgIndex.tcl"
--strip-tcl "tklib/Tix8.4/pref/10Point.fs"
--strip-tcl "tklib/Tix8.4/pref/10Point.fsc"
--strip-tcl "tklib/Tix8.4/pref/12Point.fs"
--strip-tcl "tklib/Tix8.4/pref/12Point.fsc"
--strip-tcl "tklib/Tix8.4/pref/14Point.fs"
--strip-tcl "tklib/Tix8.4/pref/14Point.fsc"
--strip-tcl "tklib/Tix8.4/pref/Bisque.cs"
--strip-tcl "tklib/Tix8.4/pref/Bisque.csc"
--strip-tcl "tklib/Tix8.4/pref/Blue.cs"
--strip-tcl "tklib/Tix8.4/pref/Blue.csc"
--strip-tcl "tklib/Tix8.4/pref/Gray.cs"
--strip-tcl "tklib/Tix8.4/pref/Gray.csc"
--strip-tcl "tklib/Tix8.4/pref/Old12Pt.fs"
--strip-tcl "tklib/Tix8.4/pref/Old14Pt.fs"
--strip-tcl "tklib/Tix8.4/pref/SGIGray.cs"
--strip-tcl "tklib/Tix8.4/pref/SGIGray.csc"
--strip-tcl "tklib/Tix8.4/pref/TK.cs"
--strip-tcl "tklib/Tix8.4/pref/TK.csc"
--strip-tcl "tklib/Tix8.4/pref/TK.fs"
--strip-tcl "tklib/Tix8.4/pref/TK.fsc"
--strip-tcl "tklib/Tix8.4/pref/TixGray.cs"
--strip-tcl "tklib/Tix8.4/pref/TixGray.csc"
--strip-tcl "tklib/Tix8.4/pref/TkWin.cs"
--strip-tcl "tklib/Tix8.4/pref/TkWin.csc"
--strip-tcl "tklib/Tix8.4/pref/TkWin.fs"
--strip-tcl "tklib/Tix8.4/pref/TkWin.fsc"
--strip-tcl "tklib/Tix8.4/pref/WmDefault.cs"
--strip-tcl "tklib/Tix8.4/pref/WmDefault.csc"
--strip-tcl "tklib/Tix8.4/pref/WmDefault.fs"
--strip-tcl "tklib/Tix8.4/pref/WmDefault.fsc"
--strip-tcl "tklib/Tix8.4/pref/WmDefault.tcl"
--strip-tcl "tklib/Tix8.4/pref/pkgIndex.tcl"
--strip-tcl "tklib/itcl3.3/itcl.tcl"
--strip-tcl "tklib/itcl3.3/pkgIndex.tcl"
--strip-tcl "tklib/itk3.3/Archetype.itk"
--strip-tcl "tklib/itk3.3/Toplevel.itk"
--strip-tcl "tklib/itk3.3/Widget.itk"
--strip-tcl "tklib/itk3.3/itk.tcl"
--strip-tcl "tklib/itk3.3/pkgIndex.tcl"
--strip-tcl "tklib/itk3.3/tclIndex"
--strip-tcl "tklib/iwidgets4.0.1/iwidgets.tcl"
--strip-tcl "tklib/iwidgets4.0.1/pkgIndex.tcl"
--strip-tcl "tklib/iwidgets4.0.1/scripts/buttonbox.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/calendar.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/canvasprintbox.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/canvasprintdialog.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/checkbox.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/colors.itcl"
--strip-tcl "tklib/iwidgets4.0.1/scripts/combobox.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/dateentry.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/datefield.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/dialog.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/dialogshell.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/disjointlistbox.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/entryfield.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/extbutton.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/extfileselectionbox.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/extfileselectiondialog.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/feedback.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/fileselectionbox.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/fileselectiondialog.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/finddialog.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/hierarchy.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/hyperhelp.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/labeledframe.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/labeledwidget.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/mainwindow.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/menubar.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/messagebox.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/messagedialog.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/notebook.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/optionmenu.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/pane.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/panedwindow.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/promptdialog.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/pushbutton.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/radiobox.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/regexpfield.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/roman.itcl"
--strip-tcl "tklib/iwidgets4.0.1/scripts/scopedobject.itcl"
--strip-tcl "tklib/iwidgets4.0.1/scripts/scrolledcanvas.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/scrolledframe.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/scrolledhtml.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/scrolledlistbox.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/scrolledtext.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/scrolledwidget.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/selectionbox.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/selectiondialog.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/shell.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/spindate.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/spinint.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/spinner.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/spintime.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/tabnotebook.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/tabset.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/tclIndex"
--strip-tcl "tklib/iwidgets4.0.1/scripts/timeentry.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/timefield.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/toolbar.itk"
--strip-tcl "tklib/iwidgets4.0.1/scripts/watch.itk"
--strip-tcl "tklib/pow/Notifications.tcl"
--strip-tcl "tklib/pow/POWplot.tcl"
--strip-tcl "tklib/pow/PowCmdsClass.tcl"
--strip-tcl "tklib/pow/Region.tcl"
--strip-tcl "tklib/pow/RegionList.tcl"
--strip-tcl "tklib/pow/Shape.tcl"
--strip-tcl "tklib/pow/html_library.tcl"
--strip-tcl "tklib/pow/notebook.tcl"
--strip-tcl "tklib/pow/pow.tcl"
--strip-tcl "tklib/pow/powEdit.tcl"
--strip-tcl "tklib/pow/powImgProbe.tcl"
--strip-tcl "tklib/pow/powMovie.tcl"
--strip-tcl "tklib/pow/powProfile.tcl"
--strip-tcl "tklib/pow/powRgn.tcl"
--strip-tcl "tklib/pow/powRuler.tcl"
--strip-tcl "tklib/pow/powScript.tcl"
--strip-tcl "tklib/pow/powXRange.tcl"
--strip-tcl "tklib/pow/tclIndex"
--strip-tcl "tklib/pow/visu_widgets.tcl"
--strip-tcl "tklib/tcl8.4/auto.tcl"
--strip-tcl "tklib/tcl8.4/history.tcl"
--strip-tcl "tklib/tcl8.4/http2.5/http.tcl"
--strip-tcl "tklib/tcl8.4/http2.5/pkgIndex.tcl"
--strip-tcl "tklib/tcl8.4/init.tcl"
--strip-tcl "tklib/tcl8.4/ldAout.tcl"
--strip-tcl "tklib/tcl8.4/msgcat1.3/msgcat.tcl"
--strip-tcl "tklib/tcl8.4/msgcat1.3/pkgIndex.tcl"
--strip-tcl "tklib/tcl8.4/package.tcl"
--strip-tcl "tklib/tcl8.4/parray.tcl"
--strip-tcl "tklib/tcl8.4/safe.tcl"
--strip-tcl "tklib/tcl8.4/tclIndex"
--strip-tcl "tklib/tcl8.4/word.tcl"
--strip-tcl "tklib/tk8.4/bgerror.tcl"
--strip-tcl "tklib/tk8.4/button.tcl"
--strip-tcl "tklib/tk8.4/choosedir.tcl"
--strip-tcl "tklib/tk8.4/clrpick.tcl"
--strip-tcl "tklib/tk8.4/comdlg.tcl"
--strip-tcl "tklib/tk8.4/console.tcl"
--strip-tcl "tklib/tk8.4/dialog.tcl"
--strip-tcl "tklib/tk8.4/entry.tcl"
--strip-tcl "tklib/tk8.4/focus.tcl"
--strip-tcl "tklib/tk8.4/listbox.tcl"
--strip-tcl "tklib/tk8.4/menu.tcl"
--strip-tcl "tklib/tk8.4/mkpsenc.tcl"
--strip-tcl "tklib/tk8.4/msgbox.tcl"
--strip-tcl "tklib/tk8.4/obsolete.tcl"
--strip-tcl "tklib/tk8.4/optMenu.tcl"
--strip-tcl "tklib/tk8.4/palette.tcl"
--strip-tcl "tklib/tk8.4/panedwindow.tcl"
--strip-tcl "tklib/tk8.4/safetk.tcl"
--strip-tcl "tklib/tk8.4/scale.tcl"
--strip-tcl "tklib/tk8.4/scrlbar.tcl"
--strip-tcl "tklib/tk8.4/spinbox.tcl"
--strip-tcl "tklib/tk8.4/tclIndex"
--strip-tcl "tklib/tk8.4/tearoff.tcl"
--strip-tcl "tklib/tk8.4/text.tcl"
--strip-tcl "tklib/tk8.4/tk.tcl"
--strip-tcl "tklib/tk8.4/tkfbox.tcl"
--strip-tcl "tklib/tk8.4/unsupported.tcl"
--strip-tcl "tklib/tk8.4/xmfbox.tcl"
--strip-tcl "tklib/xpa/pkgIndex.tcl"
--strip-tcl "tklib/xpa/test.tcl"
--strip-tcl "tklib/xpa/xpainfo.tcl"
-"Et_AppInit.c"
--strip-tcl "fvInit.tcl"
diff --git a/ftools/guis/fv/unix/fvInit.tcl b/ftools/guis/fv/unix/fvInit.tcl
deleted file mode 100644
index bbd8391..0000000
--- a/ftools/guis/fv/unix/fvInit.tcl
+++ /dev/null
@@ -1,165 +0,0 @@
-set env(FITSVIEWER_LIBRARY) /
-set env(FV) /
-set env(FV_ISEXEC) 1
-
-# The order is important! The derived class file should come after
-# the base class file from which it inherits.
-
-#source http stuff
-source tklib/tcl8.4/http2.5/http.tcl
-source tklib/tcl8.4/msgcat1.3/msgcat.tcl
-
-#source the iwidgets stuff
-source tklib/iwidgets4.0.1/scripts/colors.itcl
-source tklib/iwidgets4.0.1/scripts/scopedobject.itcl
-source tklib/iwidgets4.0.1/scripts/buttonbox.itk
-source tklib/iwidgets4.0.1/scripts/extbutton.itk
-source tklib/iwidgets4.0.1/scripts/shell.itk
-source tklib/iwidgets4.0.1/scripts/dialogshell.itk
-source tklib/iwidgets4.0.1/scripts/dialog.itk
-source tklib/iwidgets4.0.1/scripts/calendar.itk
-source tklib/iwidgets4.0.1/scripts/canvasprintbox.itk
-source tklib/iwidgets4.0.1/scripts/canvasprintdialog.itk
-source tklib/iwidgets4.0.1/scripts/labeledframe.itk
-source tklib/iwidgets4.0.1/scripts/checkbox.itk
-source tklib/iwidgets4.0.1/scripts/colors.itcl
-source tklib/iwidgets4.0.1/scripts/labeledwidget.itk
-source tklib/iwidgets4.0.1/scripts/entryfield.itk
-source tklib/iwidgets4.0.1/scripts/combobox.itk
-source tklib/iwidgets4.0.1/scripts/datefield.itk
-source tklib/iwidgets4.0.1/scripts/dateentry.itk
-source tklib/iwidgets4.0.1/scripts/disjointlistbox.itk
-source tklib/iwidgets4.0.1/scripts/extfileselectionbox.itk
-source tklib/iwidgets4.0.1/scripts/extfileselectiondialog.itk
-source tklib/iwidgets4.0.1/scripts/feedback.itk
-source tklib/iwidgets4.0.1/scripts/fileselectionbox.itk
-source tklib/iwidgets4.0.1/scripts/fileselectiondialog.itk
-source tklib/iwidgets4.0.1/scripts/finddialog.itk
-source tklib/iwidgets4.0.1/scripts/scrolledwidget.itk
-source tklib/iwidgets4.0.1/scripts/hierarchy.itk
-source tklib/iwidgets4.0.1/scripts/hyperhelp.itk
-source tklib/iwidgets4.0.1/scripts/mainwindow.itk
-source tklib/iwidgets4.0.1/scripts/menubar.itk
-source tklib/iwidgets4.0.1/scripts/messagebox.itk
-source tklib/iwidgets4.0.1/scripts/messagedialog.itk
-source tklib/iwidgets4.0.1/scripts/notebook.itk
-source tklib/iwidgets4.0.1/scripts/optionmenu.itk
-source tklib/iwidgets4.0.1/scripts/pane.itk
-source tklib/iwidgets4.0.1/scripts/panedwindow.itk
-source tklib/iwidgets4.0.1/scripts/promptdialog.itk
-source tklib/iwidgets4.0.1/scripts/pushbutton.itk
-source tklib/iwidgets4.0.1/scripts/radiobox.itk
-source tklib/iwidgets4.0.1/scripts/regexpfield.itk
-source tklib/iwidgets4.0.1/scripts/roman.itcl
-source tklib/iwidgets4.0.1/scripts/scrolledcanvas.itk
-source tklib/iwidgets4.0.1/scripts/scrolledframe.itk
-source tklib/iwidgets4.0.1/scripts/scrolledtext.itk
-source tklib/iwidgets4.0.1/scripts/scrolledhtml.itk
-source tklib/iwidgets4.0.1/scripts/scrolledlistbox.itk
-source tklib/iwidgets4.0.1/scripts/selectionbox.itk
-source tklib/iwidgets4.0.1/scripts/selectiondialog.itk
-source tklib/iwidgets4.0.1/scripts/spindate.itk
-source tklib/iwidgets4.0.1/scripts/spinner.itk
-source tklib/iwidgets4.0.1/scripts/spinint.itk
-source tklib/iwidgets4.0.1/scripts/spintime.itk
-source tklib/iwidgets4.0.1/scripts/tabnotebook.itk
-source tklib/iwidgets4.0.1/scripts/tabset.itk
-source tklib/iwidgets4.0.1/scripts/timefield.itk
-source tklib/iwidgets4.0.1/scripts/timeentry.itk
-source tklib/iwidgets4.0.1/scripts/toolbar.itk
-source tklib/iwidgets4.0.1/scripts/watch.itk
-
-#source the pow
-source tklib/pow/Notifications.tcl
-source tklib/pow/Shape.tcl
-source tklib/pow/Region.tcl
-source tklib/pow/RegionList.tcl
-source tklib/pow/html_library.tcl
-source tklib/pow/notebook.tcl
-source tklib/pow/pow.tcl
-source tklib/pow/powEdit.tcl
-source tklib/pow/powImgProbe.tcl
-source tklib/pow/powMovie.tcl
-source tklib/pow/powProfile.tcl
-source tklib/pow/powRgn.tcl
-source tklib/pow/powRuler.tcl
-source tklib/pow/powScript.tcl
-source tklib/pow/PowCmdsClass.tcl
-source tklib/pow/powXRange.tcl
-# source tklib/pow/POWplot.tcl
-# source visu_widgets.tcl
-# POWplot
-
-# source fv
-#
-
-source ../class/FVFile.tcl
-source ../class/FVFtool.tcl
-source ../class/FVSkyview.tcl
-source ../class/FVVizier.tcl
-source ../class/Table.tcl
-source ../class/FitsTable.tcl
-source ../class/FitsBaseCalculator.tcl
-source ../class/FitsCalculator.tcl
-source ../class/FitsClipBoard.tcl
-source ../class/FitsDelCalculator.tcl
-source ../class/FitsExtension.tcl
-source ../class/FitsFile.tcl
-source ../class/FitsFileSelection.tcl
-source ../class/FitsHeader.tcl
-source ../class/FitsHistoParam.tcl
-source ../class/FitsImage.tcl
-source ../class/CubeImage.tcl
-source ../class/FitsImgPlotSel.tcl
-source ../class/FitsPlotSel.tcl
-source ../class/FitsSelCalculator.tcl
-source ../class/NewExtension.tcl
-source ../class/NewFITS.tcl
-source ../class/NewImage.tcl
-source ../class/NewTable.tcl
-source ../class/RemoteAccess.tcl
-source ../class/VectorTable.tcl
-source ../class/WFPC2Image.tcl
-source ../class/fvApp.tcl
-source ../class/fvPreferences.tcl
-source ../class/fvWinKeeper.tcl
-
-#plain fv tcl/tk files
-source ../class/ftp_lib.tcl
-source ../class/XPA_access.tcl
-source ../class/fedit.tcl
-
-set origPath ""
-set xpaBinPath ""
-
-# check to see if fv is part of environment
-if [info exists env(PATH)] {
- set origPath $env(PATH)
- set token [split $origPath ":"]
- foreach dir $token {
- set checkName [format "%s/fv" $dir]
- if [file exists $checkName] {
- set xpaBinPath $dir/xpabin
- if [file exists $xpaBinPath] {
- break
- } else {
- set xpaBinPath ""
- }
- }
- }
-}
-
-# hopefully it is going to be part of command line
-if { $xpaBinPath == "" } {
- set xpaBinPath $argv0
-
- if { [string range $xpaBinPath 0 0] != "/" } {
- # relative path
- set xpaBinPath [format "%s/%s" [pwd] $xpaBinPath]
- }
- set xpaBinPath [file dirname $xpaBinPath]/xpabin
-}
-
-set env(PATH) "$origPath:$xpaBinPath"
-
-eval fvInit $argv
diff --git a/ftools/guis/fv/unix/mktclapp.c b/ftools/guis/fv/unix/mktclapp.c
deleted file mode 100644
index 7d3e389..0000000
--- a/ftools/guis/fv/unix/mktclapp.c
+++ /dev/null
@@ -1,3415 +0,0 @@
-static char const rcsid[] = "@(#) $Id: mktclapp.c,v 1.1 2001/02/06 20:58:08 ngan Exp $";
-/*
-** Copyright (c) 1998, 1999 D. Richard Hipp
-**
-** This program is free software; you can redistribute it and/or
-** modify it under the terms of the GNU General Public
-** License as published by the Free Software Foundation; either
-** version 2 of the License, or (at your option) any later version.
-**
-** This program is distributed in the hope that it will be useful,
-** but WITHOUT ANY WARRANTY; without even the implied warranty of
-** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-** General Public License for more details.
-**
-** You should have received a copy of the GNU General Public
-** License along with this library; if not, write to the
-** Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-** Boston, MA 02111-1307, USA.
-**
-** Author contact information:
-** drh at acm.org
-** http://www.hwaci.com/drh/
-*/
-#include <stdio.h>
-#include <ctype.h>
-#include <stdlib.h>
-#include <string.h>
-#include <sys/stat.h>
-#if defined(_WIN32) || defined(WIN32)
-# include <windows.h>
-# if !defined(R_OK)
-# define R_OK 4
-# endif
-#else
-# include <unistd.h>
-#endif
-#include <time.h>
-#include <assert.h>
-
-/*
-** Version information for this program
-*/
-static char zVersion[] = "mktclapp version 3.9. January 30, 2000";
-
-/*
-** Each new TCL commands discovered while scanning C/C++ source code is
-** stored in an instance of the following structure.
-*/
-typedef struct EtCmd EtCmd;
-struct EtCmd {
- char *zIf; /* Surrounding #if statement */
- char *zName; /* Name of the command */
- int isObj; /* True if this is a Tcl_Obj command */
- EtCmd *pNext; /* Next command on a list of them all */
-};
-
-/*
-** This is a list of all TCL commands in the scanned source
-*/
-static EtCmd *cmdList = 0;
-
-/*
-** Number of commands and object commands.
-*/
-static int nCmd = 0;
-static int nObjCmd = 0;
-
-/*
-** Each nested "#if" statement is stored as an instance of the
-** following structure.
-*/
-typedef struct IfStmt IfStmt;
-struct IfStmt {
- char *zArg; /* Argument to the #if. Ex: "defined(DEBUG)" */
- int invert; /* True to put a "!" in front */
- int line; /* Line number of the original #if */
- IfStmt *pNext; /* Next #if statement down on the stack */
-};
-
-/*
-** The nested #if statements
-*/
-static IfStmt *ifStack = 0;
-
-/*
-** Name of this program.
-*/
-static char *Argv0 = "mktclapp";
-
-/*
-** Number of errors
-*/
-static int nError = 0;
-
-/*
-** Surround the call to Et_AppInit() with this #if
-*/
-static char *seenEtAppInit = "0";
-
-/*
-** Surround the call to Et_PreInit() with this #if
-*/
-static char *seenEtPreInit = "0";
-
-/*
-** Surround the implmentation of main() with the inverse of this #if
-*/
-static char *seenMain = "0";
-
-/*
-** Surround the call to Et_CustomMainLoop() with the inverse of this #if
-*/
-static char *seenEtCustomMainLoop = "0";
-
-/*
-** Allocate memory. Never fail. If not enough memory is available,
-** print an error message and abort.
-*/
-void *SafeMalloc(int nByte){
- void *p = malloc(nByte);
- if( p==0 ){
- fprintf(stderr,"Out of memory. Can't allocate %d bytes\n", nByte);
- exit(1);
- }
- memset(p, 0, nByte);
- return p;
-}
-void *SafeRealloc(void *old, int nByte){
- void *p;
- if( old==0 ) return SafeMalloc(nByte);
- p = realloc(old, nByte);
- if( p==0 ){
- fprintf(stderr,"Out of memory. Can't allocate %d bytes\n", nByte);
- exit(1);
- }
- return p;
-}
-
-/*
-** The opposite of SafeMalloc(). Free memory previously obtained.
-*/
-void SafeFree(void *pMem){
- if( pMem ) free(pMem);
-}
-
-/*
-** Return TRUE if the given character can be part of a C identifier.
-*/
-static int IsIdent(int c){
- return isalnum(c) || c=='_';
-}
-
-/*
-** Create an "#if" argument that captures the state of all nested
-** "#if" statements, ORed with "zExtra". Space to hold
-** the returned string is obtained from SafeMalloc and must be
-** freed by the calling function.
-**
-** If the conditional is always TRUE, then NULL is returned.
-*/
-static char *IfString(char *zExtra){
- int len = 0;
- IfStmt *p;
- char *z;
- int i;
- int isStackTrue = 1;
- int isStackFalse = 0;
- int isExtraFalse = 0;
- char *zSep;
- IfStmt *altStack;
-
- if( zExtra && *zExtra ){
- if( zExtra[1]==0 && zExtra[0]=='0' ){
- isExtraFalse = 1;
- }else if( zExtra[1]==0 && zExtra[0]=='1' ){
- return 0;
- }
- len = strlen(zExtra) + 10;
- }else{
- len = 1;
- isExtraFalse = 1;
- }
- for(p=ifStack; p; p=p->pNext){
- len += strlen(p->zArg) + 6;
- if( p->zArg[0]=='0' && p->zArg[1]==0 ){
- if( !p->invert ){
- isStackFalse = 1;
- isStackTrue = 0;
- break;
- }
- }else if( p->zArg[0]=='1' && p->zArg[1]==0 ){
- if( p->invert ){
- isStackFalse = 1;
- isStackTrue = 0;
- break;
- }
- }else{
- isStackTrue = 0;
- }
- }
- if( isStackTrue ){
- return 0;
- }else if( isStackFalse && isExtraFalse ){
- z = SafeMalloc( 2 );
- strcpy(z,"0");
- return z;
- }
- z = SafeMalloc( len );
- if( !isExtraFalse ){
- sprintf(z,"(%s) || (",zExtra);
- i = strlen(z);
- }else{
- i = 0;
- }
- zSep = "";
- altStack = 0;
- while( ifStack ){
- p = ifStack;
- ifStack = p->pNext;
- p->pNext = altStack;
- altStack = p;
- }
- for(p=altStack; p; p=p->pNext){
- if( p->zArg[0]=='0' && p->zArg[1]==0 && p->invert ) continue;
- if( p->zArg[0]=='1' && p->zArg[1]==0 && !p->invert ) continue;
- if( p->invert ){
- sprintf(&z[i],"%s!%s",zSep,p->zArg);
- }else{
- sprintf(&z[i],"%s%s",zSep,p->zArg);
- }
- i += strlen(&z[i]);
- zSep = " && ";
- }
- while( altStack ){
- p = altStack;
- altStack = p->pNext;
- p->pNext = ifStack;
- ifStack = p;
- }
- if( !isExtraFalse ){
- sprintf(&z[i],")");
- }
- return z;
-}
-
-/*
-** Push a new "#if" onto the if stack.
-*/
-static void PushIf(char *zArg, int line, int isNegated, int isDefined){
- char *z;
- IfStmt *p;
- if( !isDefined ){
- int i;
- z = SafeMalloc( strlen(zArg) + 3 );
- for(i=0; zArg[i] && IsIdent(zArg[i]); i++){}
- if( zArg[i]==0 ){
- sprintf(z,"%s",zArg);
- }else{
- sprintf(z,"(%s)",zArg);
- }
- }else{
- z = SafeMalloc( strlen(zArg) + 10 );
- sprintf(z,"defined(%s)",zArg);
- }
- p = SafeMalloc( sizeof(IfStmt) );
- p->zArg = z;
- p->line = line;
- p->invert = isNegated;
- p->pNext = ifStack;
- ifStack = p;
-}
-
-/*
-** Extract the argument to an #if. Remove all leading and trailing
-** space.
-*/
-static char *GetArg(const char *fileName, char *z, int *pI, int *pLine){
- int i = *pI;
- int line = *pLine;
- int start;
- char *zResult;
- int j, k;
-
- while( isspace(z[i]) && z[i]!='\n' ){ i++; }
- start = i;
- if( z[i]=='\n' || z[i]==0 ){
- fprintf(stderr,"%s: Missing argument to \"#if\" on line %d\n",
- fileName, *pLine);
- nError++;
- line++;
- }else{
- while( z[i] && z[i]!='\n' ){
- if( z[i]=='\\' && z[i+1]!=0 ){
- i++;
- }
- if( z[i]=='\n' ){
- line++;
- }
- i++;
- }
- }
- zResult = SafeMalloc( i + 1 - start );
- for(j=0, k=start; k<i; k++){
- if( isspace(z[k]) && j>0 && isspace(zResult[j-1]) ){
- /* Do nothing */
- }else if( z[k]=='\\' && z[k+1]=='\n' ){
- if( j>0 && !isspace(zResult[j-1]) ){
- zResult[j++] = ' ';
- }
- k++;
- }else if( z[k]=='\\' ){
- zResult[j++] = z[k++];
- }
- zResult[j++] = z[k];
- }
- zResult[j] = 0;
- while( j>0 && isspace(zResult[j-1]) ){
- j--;
- zResult[j] = 0;
- }
- *pI = i;
- *pLine = line;
- return zResult;
-}
-
-
-/*
-** Read the complete text of a file into memory. Return 0 if there
-** is any kind of error.
-*/
-char *ReadFileIntoMemory(const char *fileName, int *pLength){
- FILE *in; /* Input file stream */
- char *textBuf; /* A buffer in which to put entire text of input */
- int toRead; /* Amount of input file read to read */
- int got; /* Amount read so far */
- struct stat statBuf; /* Status buffer for the file */
-
- if( stat(fileName,&statBuf)!=0 ){
- fprintf(stderr,"%s: no such file: %s\n", Argv0, fileName);
- return 0;
- }
- textBuf = SafeMalloc( statBuf.st_size + 1 );
- in = fopen(fileName,"rb");
- if( in==0 ){
- fprintf(stderr,"%s: can't open for reading: %s\n", Argv0, fileName);
- SafeFree(textBuf);
- return 0;
- }
- textBuf[statBuf.st_size] = 0;
- toRead = statBuf.st_size;
- got = 0;
- while( toRead ){
- int n = fread(&textBuf[got],1,toRead,in);
- if( n<=0 ) break;
- toRead -= n;
- got += n;
- }
- fclose(in);
- textBuf[got] = 0;
- if( pLength ) *pLength = got;
- return textBuf;
-}
-
-/*
-** Given the "aaaa" part of the name of an ET_COMMAND_aaaa function,
-** compute the name of the corresponding Tcl command.
-**
-** The name is usually the same, except if there are two underscores
-** in the middle of the command, they are changed to colons. This
-** feature allows namespaces to be used. Example: The function
-** named
-**
-** ET_COMMAND_space1__proc1(ET_TCLARGS){...}
-**
-** will generate a TCL command called
-**
-** space1::proc1
-**
-** Space to hold the TCL command name is obtained from malloc().
-*/
-static char *FuncToProc(char *zFunc){
- char *zProc;
- int i;
-
- zProc = SafeMalloc( strlen(zFunc) + 1 );
- strcpy(zProc, zFunc);
- for(i=0; zProc[i]; i++){
- if( i>0 && zProc[i]=='_' && zProc[i+1]=='_' &&
- isalnum(zProc[i-1]) && isalnum(zProc[i+2]) ){
- zProc[i] = ':';
- zProc[i+1] = ':';
- }
- }
- return zProc;
-}
-
-/*
-** Scan a source file looking for new TCL commands and/or the Et_AppInit()
-** or Et_PreInit() functions.
-**
-** Skip all comments, and any text contained within "#if 0".."#endif"
-*/
-void ScanFile(const char *fileName){
- char *z; /* Complete text of the file, NULL terminated. */
- int i, j;
- int inBrace = 0;
- int line = 1;
-
- z = ReadFileIntoMemory(fileName, 0);
- if( z==0 ){
- nError++;
- return;
- }
- for(i=0; z[i]; i++){
- switch( z[i] ){
- case '\n':
- line++;
- break;
- case '/':
- /* This might be a comment. If it is, skip it. */
- if( z[i+1]=='*' ){
- int start = line;
- i += 2;
- while( z[i] && (z[i]!='*' || z[i+1]!='/') ){
- if( z[i]=='\n' ) line++;
- i++;
- }
- if( z[i]==0 ){
- fprintf(stderr,"%s: Unterminated comment beginning on line %d\n",
- fileName, start);
- nError++;
- }else{
- i++;
- }
- }else if( z[i+1]=='/' ){
- while( z[i] && z[i]!='\n' ){ i++; }
- if( z[i] ){ line++; };
- }
- break;
- case '\'': {
- /* Skip character literals */
- int start = line;
- for(i++; z[i] && z[i]!='\''; i++){
- if( z[i]=='\n' ){
- fprintf(stderr,"%s: Newline in character literal on line %d\n",
- fileName, start);
- line++;
- }
- if( z[i]=='\\' ) i++;
- }
- if( z[i]==0 ){
- fprintf(stderr,"%s: unterminate character literal on line %d\n",
- fileName, start);
- nError++;
- }
- break;
- }
- case '"': {
- /* Skip over a string */
- int start = line;
- for(i++; z[i] && z[i]!='"'; i++){
- if( z[i]=='\n' ){
- fprintf(stderr,"%s: Newline in string literal on line %d\n",
- fileName, start);
- line++;
- }
- if( z[i]=='\\' ) i++;
- }
- if( z[i]==0 ){
- fprintf(stderr,"%s: unterminate string literal on line %d\n",
- fileName, start);
- nError++;
- }
- break;
- }
- case '#':
- /* This might be a preprocessor macro such as #if 0 or #endif */
- if( i>0 && z[i-1]!='\n' ) break;
- for(j=i+1; isspace(z[j]); j++){}
- if( strncmp(&z[j],"endif",5)==0 ){
- if( ifStack==0 ){
- fprintf(stderr,"%s: Unmatched \"#endif\" on line %d\n",
- fileName, line);
- nError++;
- }else{
- IfStmt *p = ifStack;
- ifStack = p->pNext;
- SafeFree(p->zArg);
- SafeFree(p);
- }
- break;
- }
- if( strncmp(&z[j],"else",4)==0 ){
- if( ifStack==0 ){
- fprintf(stderr,"%s: No \"#if\" to pair with \"#else\" on line %d\n",
- fileName, line);
- nError++;
- }else{
- ifStack->invert = !ifStack->invert;
- }
- break;
- }
- if( z[j]!='i' || z[j+1]!='f' ) break;
- if( strncmp(&z[j+2],"ndef",4)==0 ){
- char *zArg;
- int start = line;
- i = j+6;
- zArg = GetArg(fileName, z,&i,&line);
- PushIf(zArg,start,1,1);
- SafeFree(zArg);
- }else if( strncmp(&z[j+2],"def",3)==0 ){
- char *zArg;
- int start = line;
- i = j+5;
- zArg = GetArg(fileName,z,&i,&line);
- PushIf(zArg,start,0,1);
- SafeFree(zArg);
- }else{
- char *zArg;
- int start = line;
- i = j+2;
- zArg = GetArg(fileName,z,&i,&line);
- PushIf(zArg,start,0,0);
- SafeFree(zArg);
- }
- break;
- case '{':
- inBrace++;
- break;
- case '}':
- inBrace--;
- break;
- case 'm':
- /* Check main() */
- if( inBrace>0 ) break;
- if( i>0 && IsIdent(z[i-1]) ) break;
- if( strncmp(&z[i],"main",4)==0 && !IsIdent(z[i+4]) ){
- seenMain = IfString(seenMain);
- }
- case 'E':
- /* Check ET_COMMAND_... or Et_AppInit or Et_PreInit */
- if( inBrace>0 ) break;
- if( i>0 && IsIdent(z[i-1]) ) break;
- if( z[i+1]=='T' && strncmp(&z[i],"ET_COMMAND_",11)==0 ){
- EtCmd *p;
- for(j=i+11; IsIdent(z[j]); j++){}
- p = SafeMalloc( sizeof(EtCmd) );
- p->zIf = IfString(0);
- p->zName = SafeMalloc( j-(i+9) );
- sprintf(p->zName,"%.*s",j-(i+11),&z[i+11]);
- p->pNext = cmdList;
- cmdList = p;
- nCmd++;
- }else if( z[i+1]=='T' && strncmp(&z[i],"ET_OBJCOMMAND_",14)==0 ){
- EtCmd *p;
- for(j=i+14; IsIdent(z[j]); j++){}
- p = SafeMalloc( sizeof(EtCmd) );
- p->zIf = IfString(0);
- p->zName = SafeMalloc( j-(i+9) );
- p->isObj = 1;
- sprintf(p->zName,"%.*s",j-(i+14),&z[i+14]);
- p->pNext = cmdList;
- cmdList = p;
- nObjCmd++;
- }else if( z[i+1]=='t' ){
- if( strncmp(&z[i],"Et_AppInit",10)==0 && !IsIdent(z[i+10]) ){
- seenEtAppInit = IfString(seenEtAppInit);
- }
- if( strncmp(&z[i],"Et_PreInit",10)==0 && !IsIdent(z[i+10]) ){
- seenEtPreInit = IfString(seenEtPreInit);
- }
- if( strncmp(&z[i],"Et_CustomMainLoop",17)==0 && !IsIdent(z[i+17]) ){
- seenEtCustomMainLoop = IfString(seenEtCustomMainLoop);
- }
- }
- break;
- default:
- /* Do nothing. Continue to the next character */
- break;
- }
- }
- SafeFree(z);
- while( ifStack ){
- IfStmt *p = ifStack;
- fprintf(stderr,"%s: unterminated \"#if\" on line %d\n", fileName, p->line);
- nError++;
- ifStack = p->pNext;
- SafeFree(p->zArg);
- SafeFree(p);
- }
-}
-
-/*
-** Set a macro according to the value of an #if argument.
-*/
-static void SetMacro(char *zMacroName, char *zIf){
- if( zIf==0 || *zIf==0 ){
- printf("#define %s 1\n",zMacroName);
- }else if( zIf[0]=='0' && zIf[1]==0 ){
- printf("#define %s 0\n",zMacroName);
- }else{
- printf(
- "#if %s\n"
- "# define %s 1\n"
- "#else\n"
- "# define %s 0\n"
- "#endif\n",
- zIf, zMacroName, zMacroName
- );
- }
-}
-
-/* Forward declaration...*/
-static void WriteAsString(char*,int);
-
-/*
-** Set a string macro to the value given, if that value is not NULL.
-*/
-static void SetStringMacro(char *zMacroName, char *z){
- if( z==0 || *z==0 ) return;
- printf("#define %s ", zMacroName);
- WriteAsString(z,0);
-}
-
-/*
-** Look at the name of the file given and see if it is a Tcl file
-** or a C or C++ source file. Return TRUE for TCL and FALSE for
-** C or C++.
-*/
-static int IsTclFile(char *zFile){
- static char *azCSuffix[] = {
- ".c", ".cc", ".C", ".cpp", ".CPP", ".cxx", ".CXX"
- };
- int len = strlen(zFile);
- int i;
- for(i=0; i<sizeof(azCSuffix)/sizeof(azCSuffix[0]); i++){
- int len2 = strlen(azCSuffix[i]);
- if( len>len2 && strcmp(&zFile[len-len2],azCSuffix[i])==0 ){
- return 0;
- }
- }
- return 1;
-}
-
-/*
-** Compress a TCL script by removing comments and excess white-space
-*/
-static void CompressTcl(char *z){
- int i, j, c;
- int atLineStart = 1;
- for(i=j=0; (c=z[i])!=0; i++){
- switch( c ){
- case ' ':
- case '\t':
- case '\r':
- if( atLineStart ){
- c = 0;
- }
- break;
- case '#':
- if( atLineStart && !isalpha(z[i+1]) && strncmp(z,"# @(#)",6)!=0 ){
- while( z[i] && z[i]!='\n' ){
- if( z[i]=='\\' ){
- i++;
- if( z[i]=='\r' && z[i+1]=='\n' ){ i++; }
- }
- i++;
- }
- c = 0;
- if( z[i]==0 ){ i--; }
- }else{
- atLineStart = 0;
- }
- break;
- case '\n':
- if( atLineStart ){
- c = 0;
- }else if( (i>0 && z[i-1]=='\\')
- || (i>1 && z[i-1]=='\r' && z[i-2]=='\\') ){
- /* The line continues. Do not compress.
- ** Compressing here breaks BWidgets... */
- }else{
- atLineStart = 1;
- }
- break;
- default:
- atLineStart = 0;
- break;
- }
- if( c!=0 ){
- z[j++] = c;
- }
- }
- z[j] = 0;
-}
-
-/*
-** Write the text of the given file as a string. Tcl-style comments
-** are removed if the doCompress flag is true.
-*/
-static void WriteAsString(char *z, int shroud){
- int c;
- int priorc = 0;
- int xor;
- int atLineStart = 1;
- if( shroud>0 ){
- xor = shroud;
- }
- putchar('"');
- atLineStart = 0;
- while( (c=*z)!=0 ){
- z++;
- if( c=='\r' && *z=='\n' ) continue;
- if( shroud>0 && c>=0x20 ){ c ^= xor; xor = (xor+1)&0x1f; }
- if( atLineStart ){
- putchar('"');
- atLineStart = 0;
- }
- switch( c ){
- case '?':
- /* Prevent two "?" characters in a row, as this causes problems
- ** for compilers that interpret trigraphs */
- if( c==priorc ){
- putchar('\\');
- putchar( ((c>>6)&3) + '0' );
- putchar( ((c>>3)&7) + '0' );
- putchar( (c&7) + '0' );
- c = 0;
- }else{
- putchar(c);
- }
- break;
- case '"':
- case '\\':
- putchar('\\');
- putchar(c);
- break;
- case '\n':
- putchar('\\');
- putchar('n');
- putchar('"');
- putchar('\n');
- atLineStart = 1;
- break;
- default:
- if( c<' ' || c>'~' ){
- putchar('\\');
- putchar( ((c>>6)&3) + '0' );
- putchar( ((c>>3)&7) + '0' );
- putchar( (c&7) + '0' );
- }else{
- putchar(c);
- }
- break;
- }
- priorc = c;
- }
- if( !atLineStart ){
- putchar('"');
- putchar('\n');
- }
-}
-
-/*
-** The header string.
-*/
-static char zHeader[] =
-"/* Automatically generated code */\n"
-"/* DO NOT EDIT */\n"
-"#ifndef ET_TCLARGS\n"
-"#include <tcl.h>\n"
-"#ifdef __cplusplus\n"
-"# define ET_EXTERN extern \"C\"\n"
-"#else\n"
-"# define ET_EXTERN extern\n"
-"#endif\n"
-"ET_EXTERN char *mprintf(const char*,...);\n"
-"ET_EXTERN char *vmprintf(const char*,...);\n"
-"ET_EXTERN int Et_EvalF(Tcl_Interp*,const char *,...);\n"
-"ET_EXTERN int Et_GlobalEvalF(Tcl_Interp*,const char *,...);\n"
-"ET_EXTERN int Et_DStringAppendF(Tcl_DString*,const char*,...);\n"
-"ET_EXTERN int Et_ResultF(Tcl_Interp*,const char*,...);\n"
-"ET_EXTERN int Et_Init(int,char**);\n"
-"ET_EXTERN Tcl_Interp *Et_Interp;\n"
-"#if TCL_RELEASE_VERSION>=8\n"
-"ET_EXTERN int Et_AppendObjF(Tcl_Obj*,const char*,...);\n"
-"#endif\n"
-"#define ET_TCLARGS "
- "ClientData clientData,Tcl_Interp*interp,int argc,char**argv\n"
-"#define ET_OBJARGS "
- "ClientData clientData,Tcl_Interp*interp,int objc,Tcl_Obj *CONST objv[]\n"
-"#endif\n"
-;
-
-/*
-** Print a usage comment and die
-*/
-static void Usage(char *argv0){
- fprintf(stderr,"Usage: %s arguments...\n", argv0);
- fprintf(stderr,
- " -version print the version number of mktclapp and exit\n"
- " -header print a header file and exit\n"
- " -srcdir DIR Prepend DIR to all relative pathnames\n"
- " -notk built a Tcl-only program. No GUI\n"
- " -extension NAME build a Tcl/Tk extension with the given name\n"
- " -autofork automatically fork the program into the background\n"
- " -strip-tcl remove comments and extra white-space from\n"
- " subsequent TCL files\n"
- " -dont-strip-tcl stop stripping TCL files\n"
- " -tcl-library DIR directory holding the TCL script library\n"
- " -tk-library DIR directory holding the TK script library\n"
- " -main-script FILE run the script FILE after initialization\n"
- " -read-stdin read standard input\n"
- " -console create a console window\n"
- " -shroud hide compile-in TCL from view\n"
- " -enable-obj use TCL Obj commands where possible\n"
- " -standalone make the \"source\" TCL command only work\n"
- " for builtin scripts\n"
- " -f FILE read more command-line parameters from FILE\n"
- " -i FILE make the binary file FILE part of the C code\n"
- " *.c scan this file for new TCL commands\n"
- " *.tcl compile this file into the generated C code\n"
- );
- exit(1);
-}
-
-/*
-** Read one or more characters form "in" that follow a \ and
-** interpret them appropriately. Return the character that
-** results from this interpretation.
-*/
-static int EscapeChar(FILE *in){
- int c, d;
- c = getc(in);
- switch( c ){
- case 'n':
- c = '\n';
- break;
- case 'r':
- c = '\r';
- break;
- case 'f':
- c = '\f';
- break;
- case 't':
- c = '\t';
- break;
- case 'b':
- c = '\b';
- break;
- case 'a':
- c = '\a';
- break;
- case '0':
- case '1':
- case '2':
- case '3':
- case '4':
- case '5':
- case '6':
- case '7':
- c -= '0';
- d = getc(in);
- if( d<'0' || d>'7' ){
- ungetc(d,in);
- break;
- }
- c = (c<<3) + (d - '0');
- if( d<'0' || d>'7' ){
- ungetc(d,in);
- break;
- }
- c = (c<<3) + (d - '0');
- break;
- default:
- break;
- }
- return c;
-}
-
-/* MS-Windows and MS-DOS both have the following serious OS bug: the
-** length of a command line is severely restricted. But this program
-** occasionally requires long command lines. Hence the following
-** work around.
-**
-** If the parameters "-f FILENAME" appear anywhere on the command line,
-** then the named file is scanned for additional command line arguments.
-** These arguments are substituted in place of the "FILENAME" argument
-** in the original argument list.
-**
-** This first parameter to this routine is the index of the "-f"
-** parameter in the argv[] array. The argc and argv are passed by
-** pointer so that they can be changed.
-**
-** Parsing of the parameters in the file is very simple. Parameters
-** can be separated by any amount of white-space (including newlines
-** and carriage returns.) " and ' can be used for quoting strings
-** with embedded spaces. The \ character escapes the following character.
-** The length of a token is limited to about 1000 characters.
-*/
-static void AddParameters(int index, int *pArgc, char ***pArgv){
- int argc = *pArgc; /* The original argc value */
- char **argv = *pArgv; /* The original argv value */
- int newArgc; /* Value for argc after inserting new arguments */
- char **zNew; /* The new argv after this routine is done */
- char *zFile; /* Name of the input file */
- int nNew = 0; /* Number of new entries in the argv[] file */
- int nAlloc = 0; /* Space allocated for zNew[] */
- int i; /* Loop counter */
- int n; /* Number of characters in a new argument */
- int c; /* Next character of input */
- int startOfLine = 1; /* True if we are where '#' can start a comment */
- FILE *in; /* The input file */
- char zBuf[1000]; /* A single argument is accumulated here */
-
- if( index+1==argc ) return;
- zFile = argv[index+1];
- in = fopen(zFile,"r");
- if( in==0 ){
- fprintf(stderr,"Can't open input file \"%s\"\n",zFile);
- exit(1);
- }
- c = ' ';
- while( c!=EOF ){
- while( c!=EOF && isspace(c) ){
- if( c=='\n' ){
- startOfLine = 1;
- }
- c = getc(in);
- if( startOfLine && c=='#' ){
- while( c!=EOF && c!='\n' ){
- c = getc(in);
- }
- }
- }
- n = 0;
- if( c=='\'' || c=='"' ){
- int quote = c;
- c = getc(in);
- startOfLine = 0;
- while( c!=EOF && c!=quote ){
- if( c=='\\' ) c = EscapeChar(in);
- if( n<sizeof(zBuf)-1 ){ zBuf[n++] = c; }
- c = getc(in);
- }
- if( c!=EOF ) c = getc(in);
- }else{
- while( c!=EOF && !isspace(c) ){
- if( c=='\\' ) c = EscapeChar(in);
- if( n<sizeof(zBuf)-1 ){ zBuf[n++] = c; }
- startOfLine = 0;
- c = getc(in);
- }
- }
- zBuf[n] = 0;
- if( n>0 ){
- nNew++;
- if( nNew + argc >= nAlloc ){
- if( nAlloc==0 ){
- nAlloc = 100 + argc;
- zNew = malloc( sizeof(char*) * nAlloc );
- }else{
- nAlloc *= 2;
- zNew = realloc( zNew, sizeof(char*) * nAlloc );
- }
- }
- if( zNew ){
- int j = nNew + index;
- zNew[j] = malloc( n + 1 );
- if( zNew[j] ){
- strcpy( zNew[j], zBuf );
- }
- }
- }
- }
- if( nNew>0 ){
- newArgc = argc + nNew - 1;
- for(i=0; i<=index; i++){
- zNew[i] = argv[i];
- }
- }else{
- zNew = argv;
- }
- for(i=nNew + index + 1; i<newArgc; i++){
- zNew[i] = argv[i + 1 - nNew];
- }
- zNew[newArgc] = 0;
- *pArgc = newArgc;
- *pArgv = zNew;
-}
-
-int main(int argc, char **argv){
- int i; /* Loop counter */
- EtCmd *pCmd; /* A new TCL command found in C code */
- int useTk = 1; /* False if the -notk flag is used */
- int autoFork = 0; /* True if the -autofork flag is used */
- int nTcl = 0; /* Number of TCL scripts */
- char **azTcl; /* Name of all TCL scripts */
- int *aDoCompress; /* Whether or not to compress each TCL script */
- int nData = 0; /* Number of data files */
- char **azData; /* Names of all data files */
- int doCompress = 1; /* Current state of the compression flag */
- char *zTclLib = 0; /* Name of the TCL library */
- char *zTkLib = 0; /* Name of the TK library */
- char *zMainScript = 0; /* Name of a script to run first */
- int shroud = 0; /* True to encrypt the compiled-in TCL */
- int readStdin = 0; /* True to read TCL commands from STDIN */
- int enableObj = 0; /* Enable the use of object commands */
- int standalone = 0; /* True to disable the "source" command */
- int stringify = 0; /* True to output only strings of the scripts */
- int console = 0; /* True to put up a debugging console */
- char *zExtension = 0; /* Name of the extension. NULL if a complete app */
- int nHash; /* Number of entries in hash table */
- extern char zTail[];
-
- if( argc>=2 && strcmp(argv[1],"-header")==0 ){
- printf("%s",zHeader);
- return 0;
- }
- if( argc>=2 && strcmp(argv[1],"-version")==0 ){
- printf("%s\n",zVersion);
- return 0;
- }
- azTcl = SafeMalloc( sizeof(char*)*(argc + 100) );
- azData = SafeMalloc( sizeof(char*)*(argc + 100) );
- aDoCompress = SafeMalloc( sizeof(int)*(argc + 100) );
- for(i=1; i<argc; i++){
- if( argv[i][0]=='-' ){
- if( strcmp(argv[i],"-header")==0 ){
- printf("%s",zHeader);
- return 0;
- }else if( strcmp(argv[i],"-notk")==0 ){
- useTk = 0;
- }else if( i<argc-1 && strcmp(argv[i],"-extension")==0 ){
- zExtension = argv[++i];
- }else if( strcmp(argv[i],"-autofork")==0 ){
- autoFork = 1;
- }else if( strcmp(argv[i],"-read-stdin")==0 ){
- readStdin = 1;
- }else if( strcmp(argv[i],"-console")==0 ){
- console = 1;
- }else if( strcmp(argv[i],"-shroud")==0 ){
- shroud = 1;
- }else if( strcmp(argv[i],"-strip-tcl")==0 ){
- doCompress = 1;
- }else if( strcmp(argv[i],"-dont-strip-tcl")==0 ){
- doCompress = 0;
- }else if( strcmp(argv[i],"-enable-obj")==0 ){
- enableObj = 1;
- }else if( strcmp(argv[i],"-standalone")==0 ){
- standalone = 1;
- }else if( strcmp(argv[i],"-stringify")==0 ){
- stringify = 1;
- }else if( i<argc-1 && strcmp(argv[i],"-srcdir")==0 ){
- chdir(argv[++i]);
- }else if( i<argc-1 && strcmp(argv[i],"-main-script")==0 ){
- zMainScript = argv[++i];
- }else if( i<argc-1 && strcmp(argv[i],"-tcl-library")==0 ){
- zTclLib = argv[++i];
- }else if( i<argc-1 && strcmp(argv[i],"-tk-library")==0 ){
- zTkLib = argv[++i];
- }else if( i<argc-1 && strcmp(argv[i],"-i")==0 ){
- i++;
- if( access(argv[i],R_OK) ){
- fprintf(stderr,"%s: can't open \"%s\" for reading\n",Argv0,argv[i]);
- nError++;
- }else{
- azData[nData] = argv[i];
- }
- nData++;
- }else if( strcmp(argv[i],"-f")==0 ){
- AddParameters(i, &argc, &argv);
- azTcl = SafeRealloc(azTcl, sizeof(char*)*(argc + 100) );
- azData = SafeRealloc(azData, sizeof(char*)*(argc + 100) );
- aDoCompress = SafeRealloc(aDoCompress, sizeof(int)*(argc + 100) );
- }else{
- Usage(argv[0]);
- }
- }else if( IsTclFile(argv[i]) ){
- if( access(argv[i],R_OK) ){
- fprintf(stderr,"%s: can't open \"%s\" for reading\n", Argv0, argv[i]);
- nError++;
- }else{
- int len = strlen(argv[i]);
- azTcl[nTcl] = argv[i];
- if( len>=9 && strcmp(&argv[i][len-9],"/tclIndex")==0 ){
- aDoCompress[nTcl] = 0;
- }else{
- aDoCompress[nTcl] = doCompress;
- }
- nTcl++;
- }
- }else{
- ScanFile(argv[i]);
- }
- }
- if( nError>0 ) return nError;
- if( shroud>0 ){
- shroud = time(0) % 31 + 1;
- }
- if( stringify ){
- for(i=0; i<nTcl; i++){
- char *z;
- z = ReadFileIntoMemory(azTcl[i], 0);
- if( z==0 ) continue;
- if( aDoCompress[i] ) CompressTcl(z);
- WriteAsString(z,shroud);
- printf(";\n");
- SafeFree(z);
- }
- return 0;
- }
- if( nObjCmd>0 ) enableObj = 1;
- printf(
- "/* This code is automatically generated by \"mktclapp\""
- " version 3.9 */\n"
- "/* DO NOT EDIT */\n"
- "#include <tcl.h>\n"
- "#define INTERFACE 1\n"
- "#if INTERFACE\n"
- "#define ET_TCLARGS "
- "ClientData clientData,Tcl_Interp*interp,int argc,char**argv\n"
- "#define ET_OBJARGS "
- "ClientData clientData,Tcl_Interp*interp,int objc,Tcl_Obj*CONST objv[]\n"
- "#endif\n"
- );
- printf("#define ET_ENABLE_OBJ %d\n", enableObj);
- printf("#define ET_ENABLE_TK %d\n", useTk!=0);
- printf("#define ET_AUTO_FORK %d\n", autoFork!=0);
- printf("#define ET_STANDALONE %d\n", standalone!=0);
- printf("#define ET_N_BUILTIN_SCRIPT %d\n", nTcl);
- printf("#define ET_VERSION \"3.9\"\n");
- SetMacro("ET_HAVE_APPINIT",seenEtAppInit);
- SetMacro("ET_HAVE_PREINIT",seenEtPreInit);
- SetMacro("ET_HAVE_MAIN",seenMain);
- SetMacro("ET_HAVE_CUSTOM_MAINLOOP",seenEtCustomMainLoop);
- SetStringMacro("ET_TCL_LIBRARY", zTclLib);
- SetStringMacro("ET_TK_LIBRARY", zTkLib);
- SetStringMacro("ET_MAIN_SCRIPT", zMainScript);
- if( zExtension ){
- int i;
- if( islower(zExtension[0]) ){
- zExtension[0] = toupper(zExtension[0]);
- }
- for(i=1; zExtension[i]; i++){
- if( isupper(zExtension[i]) ){
- zExtension[i] = tolower(zExtension[i]);
- }
- }
- printf("#define ET_EXTENSION_NAME %s_Init\n", zExtension);
- printf("#define ET_SAFE_EXTENSION_NAME %s_SafeInit\n", zExtension);
- printf("#define ET_EXTENSION 1\n");
- }else{
- printf("#define ET_EXTENSION 0\n");
- }
- printf("#define ET_SHROUD_KEY %d\n",shroud);
- printf("#define ET_READ_STDIN %d\n",readStdin);
- printf("#define ET_CONSOLE %d\n",console);
- for(pCmd=cmdList; pCmd; pCmd=pCmd->pNext){
- if( pCmd->zIf && pCmd->zIf[0]=='0' && pCmd->zIf[1]==0 ) continue;
- if( pCmd->isObj ){
- printf("extern int ET_OBJCOMMAND_%s(ET_OBJARGS);\n", pCmd->zName);
- }else{
- printf("extern int ET_COMMAND_%s(ET_TCLARGS);\n", pCmd->zName);
- }
- }
- printf(
- "static struct {\n"
- " char *zName;\n"
- " int (*xProc)(ET_TCLARGS);\n"
- "} Et_CmdSet[] = {\n"
- );
- for(pCmd=cmdList; pCmd; pCmd=pCmd->pNext){
- char *zProc;
- if( pCmd->isObj ) continue;
- if( pCmd->zIf ){
- if( pCmd->zIf[0]=='0' && pCmd->zIf[1]==0 ) continue;
- printf("#if %s\n",pCmd->zIf);
- }
- zProc = FuncToProc(pCmd->zName);
- printf(" { \"%s\", ET_COMMAND_%s },\n", zProc, pCmd->zName);
- SafeFree(zProc);
- if( pCmd->zIf ){
- printf("#endif\n");
- }
- }
- printf("{0, 0}};\n");
- if( enableObj ){
- char *zProc;
- printf(
- "static struct {\n"
- " char *zName;\n"
- " int (*xProc)(ET_OBJARGS);\n"
- "} Et_ObjSet[] = {\n"
- );
- for(pCmd=cmdList; pCmd; pCmd=pCmd->pNext){
- if( !pCmd->isObj ) continue;
- if( pCmd->zIf ){
- if( pCmd->zIf[0]=='0' && pCmd->zIf[1]==0 ) continue;
- printf("#if %s\n",pCmd->zIf);
- }
- zProc = FuncToProc(pCmd->zName);
- printf(" { \"%s\", ET_OBJCOMMAND_%s },\n", zProc, pCmd->zName);
- SafeFree(zProc);
- if( pCmd->zIf ){
- printf("#endif\n");
- }
- }
- printf("{0, 0}};\n");
- }
- for(i=0; i<nTcl; i++){
- char *z;
- printf("static char Et_zFile%d[] = \n",i);
- z = ReadFileIntoMemory(azTcl[i], 0);
- if( z==0 ) continue;
- if( aDoCompress[i] ) CompressTcl(z);
- WriteAsString(z,shroud);
- printf(";\n");
- SafeFree(z);
- }
- for(i=0; i<nData; i++){
- char *z;
- int len, j, col;
- printf("static unsigned char Et_acData%d[] = {\n",i);
- z = ReadFileIntoMemory(azData[i], &len);
- if( z==0 ) continue;
- for(j=col=0; j<len; j++){
- printf(" 0x%02x,", z[j]&0xff);
- if( ++col >= 12 ){
- printf("\n");
- col = 0;
- }
- }
- if( col>0 ) printf("\n");
- printf("};\n");
- SafeFree(z);
- }
- printf(
- "struct EtFile {\n"
- " char *zName;\n"
- " char *zData;\n"
- " int nData;\n"
- " int shrouded;\n"
- " struct EtFile *pNext;\n"
- "};\n"
- "static struct EtFile Et_FileSet[] = {\n"
- );
- for(i=0; i<nTcl; i++){
- printf(" { \"%s\", Et_zFile%d, sizeof(Et_zFile%d)-1, %d, 0 },\n",
- azTcl[i], i, i, shroud);
- }
- for(i=0; i<nData; i++){
- printf(" { \"%s\", Et_acData%d, sizeof(Et_acData%d), 0, 0 },\n",
- azData[i], i, i);
- }
- fflush(stdout);
- nHash = nTcl*2 + 1;
- if( nHash<71 ){
- nHash = 71;
- }
- printf(
- "{0, 0}};\n"
- "static struct EtFile *Et_FileHashTable[%d];\n"
- "%s",
- nHash, zTail
- );
- return nError;
-}
-
-char zTail[] =
-"/* The following copyright notice applies to code generated by\n"
-"** \"mktclapp\". The \"mktclapp\" program itself is covered by the\n"
-"** GNU Public License.\n"
-"**\n"
-"** Copyright (c) 1998 D. Richard Hipp\n"
-"**\n"
-"** The author hereby grants permission to use, copy, modify, distribute,\n"
-"** and license this software and its documentation for any purpose, provided\n"
-"** that existing copyright notices are retained in all copies and that this\n"
-"** notice is included verbatim in any distributions. No written agreement,\n"
-"** license, or royalty fee is required for any of the authorized uses.\n"
-"** Modifications to this software may be copyrighted by their authors\n"
-"** and need not follow the licensing terms described here, provided that\n"
-"** the new terms are clearly indicated on the first page of each file where\n"
-"** they apply.\n"
-"**\n"
-"** In no event shall the author or the distributors be liable to any party\n"
-"** for direct, indirect, special, incidental, or consequential damages\n"
-"** arising out of the use of this software, its documentation, or any\n"
-"** derivatives thereof, even if the author has been advised of the \n"
-"** possibility of such damage. The author and distributors specifically\n"
-"** disclaim any warranties, including but not limited to the implied\n"
-"** warranties of merchantability, fitness for a particular purpose, and\n"
-"** non-infringment. This software is provided at no fee on an\n"
-"** \"as is\" basis. The author and/or distritutors have no obligation\n"
-"** to provide maintenance, support, updates, enhancements and/or\n"
-"** modifications.\n"
-"**\n"
-"** GOVERNMENT USE: If you are acquiring this software on behalf of the\n"
-"** U.S. government, the Government shall have only \"Restricted Rights\"\n"
-"** in the software and related documentation as defined in the Federal \n"
-"** Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you\n"
-"** are acquiring the software on behalf of the Department of Defense, the\n"
-"** software shall be classified as \"Commercial Computer Software\" and the\n"
-"** Government shall have only \"Restricted Rights\" as defined in Clause\n"
-"** 252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the\n"
-"** author grants the U.S. Government and others acting in its behalf\n"
-"** permission to use and distribute the software in accordance with the\n"
-"** terms specified in this license. \n"
-"*/\n"
-"#include <ctype.h>\n"
-"#include <string.h>\n"
-"#include <stdarg.h>\n"
-"#include <stdio.h>\n"
-"#include <stdlib.h>\n"
-"#include <sys/types.h>\n"
-"#include <sys/stat.h>\n"
-"#include <fcntl.h>\n"
-"\n"
-"/* Include either the Tcl or the Tk header file. Use the \"Internal\"\n"
-"** version of the header file if and only if we are generating an\n"
-"** extension that is linking against the Stub library.\n"
-"** Many installations do not have the internal header files\n"
-"** available, so using the internal headers only when absolutely\n"
-"** necessary will help to reduce compilation problems.\n"
-"*/\n"
-"#if ET_EXTENSION && defined(TCL_USE_STUBS)\n"
-"# if ET_ENABLE_TK\n"
-"# include <tkInt.h>\n"
-"# else\n"
-"# include <tclInt.h>\n"
-"# endif\n"
-"#else\n"
-"# if ET_ENABLE_TK\n"
-"# include <tk.h>\n"
-"# else\n"
-"# include <tcl.h>\n"
-"# endif\n"
-"#endif\n"
-"\n"
-"/*\n"
-"** ET_WIN32 is true if we are running Tk under windows. The\n"
-"** <tcl.h> module will define __WIN32__ for us if we are compiling\n"
-"** for windows.\n"
-"*/\n"
-"#if defined(__WIN32__) && ET_ENABLE_TK\n"
-"# define ET_WIN32 1\n"
-"# include <windows.h>\n"
-"#else\n"
-"# define ET_WIN32 0\n"
-"#endif\n"
-"\n"
-"/*\n"
-"** Always disable ET_AUTO_FORK under windows. Windows doesn't\n"
-"** fork well.\n"
-"*/\n"
-"#if defined(__WIN32__)\n"
-"# undef ET_AUTO_FORK\n"
-"# define ET_AUTO_FORK 0\n"
-"#endif\n"
-"\n"
-"/*\n"
-"** Omit <unistd.h> under windows. But we need it for Unix.\n"
-"*/\n"
-"#if !defined(__WIN32__)\n"
-"# include <unistd.h>\n"
-"#endif\n"
-"\n"
-"/*\n"
-"** The Tcl*InsertProc functions allow the system calls \"stat\",\n"
-"** \"access\" and \"open\" to be overloaded. This in turns allows us\n"
-"** to substituted compiled-in strings for files in the filesystem.\n"
-"** But the Tcl*InsertProc functions are only available in Tcl8.0.3\n"
-"** and later.\n"
-"**\n"
-"** Define the ET_HAVE_INSERTPROC macro if and only if we are dealing\n"
-"** with Tcl8.0.3 or later.\n"
-"*/\n"
-"#if TCL_MAJOR_VERSION==8 && (TCL_MINOR_VERSION>0 || TCL_RELEASE_SERIAL>=3)\n"
-"# define ET_HAVE_INSERTPROC\n"
-"#endif\n"
-"\n"
-"/*\n"
-"** If we are using the Tcl*InsertProc() functions, we should provide\n"
-"** prototypes for them. But the prototypes are in the tclInt.h include\n"
-"** file, which we don't want to require the user to have on hand. So\n"
-"** we provide our own prototypes here.\n"
-"**\n"
-"** Note that if TCL_USE_STUBS is defined, then the tclInt.h is required\n"
-"** anyway, so these prototypes are not included if TCL_USE_STUBS is\n"
-"** defined. \n"
-"*/\n"
-"#if defined(ET_HAVE_INSERTPROC) && !defined(TCL_USE_STUBS)\n"
-"#ifdef __cplusplus\n"
-" extern \"C\" int TclStatInsertProc(int (*)(char*, struct stat *));\n"
-" extern \"C\" int TclAccessInsertProc(int (*)(char*, int));\n"
-" extern \"C\" int TclOpenFileChannelInsertProc(Tcl_Channel (*)(Tcl_Interp*,char*,\n"
-" char*,int));\n"
-"#else\n"
-" extern int TclStatInsertProc(int (*)(char*, struct stat *));\n"
-" extern int TclAccessInsertProc(int (*)(char*, int));\n"
-" extern int TclOpenFileChannelInsertProc(Tcl_Channel (*)(Tcl_Interp*,char*,\n"
-" char*,int));\n"
-"#endif\n"
-"#endif\n"
-"\n"
-"\n"
-"/*\n"
-"** Don't allow Win32 applications to read from stdin. Nor\n"
-"** programs that automatically go into the background. Force\n"
-"** the use of a console in these cases.\n"
-"*/\n"
-"#if (ET_WIN32 || ET_AUTO_FORK) && ET_READ_STDIN\n"
-"# undef ET_READ_STDIN\n"
-"# undef ET_CONSOLE\n"
-"# define ET_READ_STDIN 0\n"
-"# define ET_CONSOLE 1\n"
-"#endif\n"
-"\n"
-"/*\n"
-"** The console won't work without Tk.\n"
-"*/\n"
-"#if ET_ENABLE_TK==0 && ET_CONSOLE\n"
-"# undef ET_CONSOLE\n"
-"# define ET_CONSOLE 0\n"
-"# undef ET_READ_STDIN\n"
-"# define ET_READ_STDIN 1\n"
-"#endif\n"
-"\n"
-"/*\n"
-"** Set ET_HAVE_OBJ to true if we are able to link against the\n"
-"** new Tcl_Obj interface. This is only the case for Tcl version\n"
-"** 8.0 and later.\n"
-"*/\n"
-"#if ET_ENABLE_OBJ || TCL_MAJOR_VERSION>=8\n"
-"# define ET_HAVE_OBJ 1\n"
-"#else\n"
-"# define ET_HAVE_OBJ 0\n"
-"#endif\n"
-"\n"
-"/*\n"
-"** The Tcl_GetByteArrayFromObj() only appears in Tcl version 8.1\n"
-"** and later. Substitute Tcl_GetStringFromObj() in Tcl version 8.0.X\n"
-"*/\n"
-"#if ET_HAVE_OBJ && TCL_MINOR_VERSION==0\n"
-"# define Tcl_GetByteArrayFromObj Tcl_GetStringFromObj\n"
-"#endif\n"
-"\n"
-"/*\n"
-"** Tcl code to implement the console.\n"
-"**\n"
-"** This code is written and tested separately, then run through\n"
-"** \"mktclapp -stringify\" and then pasted in here.\n"
-"*/\n"
-"#if ET_ENABLE_TK && !ET_EXTENSION\n"
-"static char zEtConsole[] =\n"
-"\"proc console:create {w prompt title} {\\n\"\n"
-"\"upvar #0 $w.t v\\n\"\n"
-"\"if {[winfo exists $w]} {destroy $w}\\n\"\n"
-"\"catch {unset v}\\n\"\n"
-"\"toplevel $w\\n\"\n"
-"\"wm title $w $title\\n\"\n"
-"\"wm iconname $w $title\\n\"\n"
-"\"frame $w.mb -bd 2 -relief raised\\n\"\n"
-"\"pack $w.mb -side top -fill x\\n\"\n"
-"\"menubutton $w.mb.file -text File -menu $w.mb.file.m\\n\"\n"
-"\"menubutton $w.mb.edit -text Edit -menu $w.mb.edit.m\\n\"\n"
-"\"pack $w.mb.file $w.mb.edit -side left -padx 8 -pady 1\\n\"\n"
-"\"set m [menu $w.mb.file.m]\\n\"\n"
-"\"$m add command -label {Source...} -command \\\"console:SourceFile $w.t\\\"\\n\"\n"
-"\"$m add command -label {Save As...} -command \\\"console:SaveFile $w.t\\\"\\n\"\n"
-"\"$m add separator\\n\"\n"
-"\"$m add command -label {Close} -command \\\"destroy $w\\\"\\n\"\n"
-"\"$m add command -label {Exit} -command exit\\n\"\n"
-"\"set m [menu $w.mb.edit.m]\\n\"\n"
-"\"$m add command -label Cut -command \\\"console:Cut $w.t\\\"\\n\"\n"
-"\"$m add command -label Copy -command \\\"console:Copy $w.t\\\"\\n\"\n"
-"\"$m add command -label Paste -command \\\"console:Paste $w.t\\\"\\n\"\n"
-"\"$m add command -label {Clear Screen} -command \\\"console:Clear $w.t\\\"\\n\"\n"
-"\"catch {$m config -postcommand \\\"console:EnableEditMenu $w\\\"}\\n\"\n"
-"\"scrollbar $w.sb -orient vertical -command \\\"$w.t yview\\\"\\n\"\n"
-"\"pack $w.sb -side right -fill y\\n\"\n"
-"\"text $w.t -font fixed -yscrollcommand \\\"$w.sb set\\\"\\n\"\n"
-"\"pack $w.t -side right -fill both -expand 1\\n\"\n"
-"\"bindtags $w.t Console\\n\"\n"
-"\"set v(text) $w.t\\n\"\n"
-"\"set v(history) 0\\n\"\n"
-"\"set v(historycnt) 0\\n\"\n"
-"\"set v(current) -1\\n\"\n"
-"\"set v(prompt) $prompt\\n\"\n"
-"\"set v(prior) {}\\n\"\n"
-"\"set v(plength) [string length $v(prompt)]\\n\"\n"
-"\"set v(x) 0\\n\"\n"
-"\"set v(y) 0\\n\"\n"
-"\"$w.t mark set insert end\\n\"\n"
-"\"$w.t tag config ok -foreground blue\\n\"\n"
-"\"$w.t tag config err -foreground red\\n\"\n"
-"\"$w.t insert end $v(prompt)\\n\"\n"
-"\"$w.t mark set out 1.0\\n\"\n"
-"\"catch {rename puts console:oldputs$w}\\n\"\n"
-"\"proc puts args [format {\\n\"\n"
-"\"if {![winfo exists %s]} {\\n\"\n"
-"\"rename puts {}\\n\"\n"
-"\"rename console:oldputs%s puts\\n\"\n"
-"\"return [uplevel #0 puts $args]\\n\"\n"
-"\"}\\n\"\n"
-"\"switch -glob -- \\\"[llength $args] $args\\\" {\\n\"\n"
-"\"{1 *} {\\n\"\n"
-"\"set msg [lindex $args 0]\\\\n\\n\"\n"
-"\"set tag ok\\n\"\n"
-"\"}\\n\"\n"
-"\"{2 stdout *} {\\n\"\n"
-"\"set msg [lindex $args 1]\\\\n\\n\"\n"
-"\"set tag ok\\n\"\n"
-"\"}\\n\"\n"
-"\"{2 stderr *} {\\n\"\n"
-"\"set msg [lindex $args 1]\\\\n\\n\"\n"
-"\"set tag err\\n\"\n"
-"\"}\\n\"\n"
-"\"{2 -nonewline *} {\\n\"\n"
-"\"set msg [lindex $args 1]\\n\"\n"
-"\"set tag ok\\n\"\n"
-"\"}\\n\"\n"
-"\"{3 -nonewline stdout *} {\\n\"\n"
-"\"set msg [lindex $args 2]\\n\"\n"
-"\"set tag ok\\n\"\n"
-"\"}\\n\"\n"
-"\"{3 -nonewline stderr *} {\\n\"\n"
-"\"set msg [lindex $args 2]\\n\"\n"
-"\"set tag err\\n\"\n"
-"\"}\\n\"\n"
-"\"default {\\n\"\n"
-"\"uplevel #0 console:oldputs%s $args\\n\"\n"
-"\"return\\n\"\n"
-"\"}\\n\"\n"
-"\"}\\n\"\n"
-"\"console:Puts %s $msg $tag\\n\"\n"
-"\"} $w $w $w $w.t]\\n\"\n"
-"\"after idle \\\"focus $w.t\\\"\\n\"\n"
-"\"}\\n\"\n"
-"\"bind Console <1> {console:Button1 %W %x %y}\\n\"\n"
-"\"bind Console <B1-Motion> {console:B1Motion %W %x %y}\\n\"\n"
-"\"bind Console <B1-Leave> {console:B1Leave %W %x %y}\\n\"\n"
-"\"bind Console <B1-Enter> {console:cancelMotor %W}\\n\"\n"
-"\"bind Console <ButtonRelease-1> {console:cancelMotor %W}\\n\"\n"
-"\"bind Console <KeyPress> {console:Insert %W %A}\\n\"\n"
-"\"bind Console <Left> {console:Left %W}\\n\"\n"
-"\"bind Console <Control-b> {console:Left %W}\\n\"\n"
-"\"bind Console <Right> {console:Right %W}\\n\"\n"
-"\"bind Console <Control-f> {console:Right %W}\\n\"\n"
-"\"bind Console <BackSpace> {console:Backspace %W}\\n\"\n"
-"\"bind Console <Control-h> {console:Backspace %W}\\n\"\n"
-"\"bind Console <Delete> {console:Delete %W}\\n\"\n"
-"\"bind Console <Control-d> {console:Delete %W}\\n\"\n"
-"\"bind Console <Home> {console:Home %W}\\n\"\n"
-"\"bind Console <Control-a> {console:Home %W}\\n\"\n"
-"\"bind Console <End> {console:End %W}\\n\"\n"
-"\"bind Console <Control-e> {console:End %W}\\n\"\n"
-"\"bind Console <Return> {console:Enter %W}\\n\"\n"
-"\"bind Console <KP_Enter> {console:Enter %W}\\n\"\n"
-"\"bind Console <Up> {console:Prior %W}\\n\"\n"
-"\"bind Console <Control-p> {console:Prior %W}\\n\"\n"
-"\"bind Console <Down> {console:Next %W}\\n\"\n"
-"\"bind Console <Control-n> {console:Next %W}\\n\"\n"
-"\"bind Console <Control-k> {console:EraseEOL %W}\\n\"\n"
-"\"bind Console <<Cut>> {console:Cut %W}\\n\"\n"
-"\"bind Console <<Copy>> {console:Copy %W}\\n\"\n"
-"\"bind Console <<Paste>> {console:Paste %W}\\n\"\n"
-"\"bind Console <<Clear>> {console:Clear %W}\\n\"\n"
-"\"proc console:Puts {w t tag} {\\n\"\n"
-"\"set nc [string length $t]\\n\"\n"
-"\"set endc [string index $t [expr $nc-1]]\\n\"\n"
-"\"if {$endc==\\\"\\\\n\\\"} {\\n\"\n"
-"\"if {[$w index out]<[$w index {insert linestart}]} {\\n\"\n"
-"\"$w insert out [string range $t 0 [expr $nc-2]] $tag\\n\"\n"
-"\"$w mark set out {out linestart +1 lines}\\n\"\n"
-"\"} else {\\n\"\n"
-"\"$w insert out $t $tag\\n\"\n"
-"\"}\\n\"\n"
-"\"} else {\\n\"\n"
-"\"if {[$w index out]<[$w index {insert linestart}]} {\\n\"\n"
-"\"$w insert out $t $tag\\n\"\n"
-"\"} else {\\n\"\n"
-"\"$w insert out $t\\\\n $tag\\n\"\n"
-"\"$w mark set out {out -1 char}\\n\"\n"
-"\"}\\n\"\n"
-"\"}\\n\"\n"
-"\"$w yview insert\\n\"\n"
-"\"}\\n\"\n"
-"\"proc console:Insert {w a} {\\n\"\n"
-"\"$w insert insert $a\\n\"\n"
-"\"$w yview insert\\n\"\n"
-"\"}\\n\"\n"
-"\"proc console:Left {w} {\\n\"\n"
-"\"upvar #0 $w v\\n\"\n"
-"\"scan [$w index insert] %d.%d row col\\n\"\n"
-"\"if {$col>$v(plength)} {\\n\"\n"
-"\"$w mark set insert \\\"insert -1c\\\"\\n\"\n"
-"\"}\\n\"\n"
-"\"}\\n\"\n"
-"\"proc console:Backspace {w} {\\n\"\n"
-"\"upvar #0 $w v\\n\"\n"
-"\"scan [$w index insert] %d.%d row col\\n\"\n"
-"\"if {$col>$v(plength)} {\\n\"\n"
-"\"$w delete {insert -1c}\\n\"\n"
-"\"}\\n\"\n"
-"\"}\\n\"\n"
-"\"proc console:EraseEOL {w} {\\n\"\n"
-"\"upvar #0 $w v\\n\"\n"
-"\"scan [$w index insert] %d.%d row col\\n\"\n"
-"\"if {$col>=$v(plength)} {\\n\"\n"
-"\"$w delete insert {insert lineend}\\n\"\n"
-"\"}\\n\"\n"
-"\"}\\n\"\n"
-"\"proc console:Right {w} {\\n\"\n"
-"\"$w mark set insert \\\"insert +1c\\\"\\n\"\n"
-"\"}\\n\"\n"
-"\"proc console:Delete w {\\n\"\n"
-"\"$w delete insert\\n\"\n"
-"\"}\\n\"\n"
-"\"proc console:Home w {\\n\"\n"
-"\"upvar #0 $w v\\n\"\n"
-"\"scan [$w index insert] %d.%d row col\\n\"\n"
-"\"$w mark set insert $row.$v(plength)\\n\"\n"
-"\"}\\n\"\n"
-"\"proc console:End w {\\n\"\n"
-"\"$w mark set insert {insert lineend}\\n\"\n"
-"\"}\\n\"\n"
-"\"proc console:Enter w {\\n\"\n"
-"\"upvar #0 $w v\\n\"\n"
-"\"scan [$w index insert] %d.%d row col\\n\"\n"
-"\"set start $row.$v(plength)\\n\"\n"
-"\"set line [$w get $start \\\"$start lineend\\\"]\\n\"\n"
-"\"if {$v(historycnt)>0} {\\n\"\n"
-"\"set last [lindex $v(history) [expr $v(historycnt)-1]]\\n\"\n"
-"\"if {[string compare $last $line]} {\\n\"\n"
-"\"lappend v(history) $line\\n\"\n"
-"\"incr v(historycnt)\\n\"\n"
-"\"}\\n\"\n"
-"\"} else {\\n\"\n"
-"\"set v(history) [list $line]\\n\"\n"
-"\"set v(historycnt) 1\\n\"\n"
-"\"}\\n\"\n"
-"\"set v(current) $v(historycnt)\\n\"\n"
-"\"$w insert end \\\\n\\n\"\n"
-"\"$w mark set out end\\n\"\n"
-"\"if {$v(prior)==\\\"\\\"} {\\n\"\n"
-"\"set cmd $line\\n\"\n"
-"\"} else {\\n\"\n"
-"\"set cmd $v(prior)\\\\n$line\\n\"\n"
-"\"}\\n\"\n"
-"\"if {[info complete $cmd]} {\\n\"\n"
-"\"set rc [catch {uplevel #0 $cmd} res]\\n\"\n"
-"\"if {![winfo exists $w]} return\\n\"\n"
-"\"if {$rc} {\\n\"\n"
-"\"$w insert end $res\\\\n err\\n\"\n"
-"\"} elseif {[string length $res]>0} {\\n\"\n"
-"\"$w insert end $res\\\\n ok\\n\"\n"
-"\"}\\n\"\n"
-"\"set v(prior) {}\\n\"\n"
-"\"$w insert end $v(prompt)\\n\"\n"
-"\"} else {\\n\"\n"
-"\"set v(prior) $cmd\\n\"\n"
-"\"regsub -all {[^ ]} $v(prompt) . x\\n\"\n"
-"\"$w insert end $x\\n\"\n"
-"\"}\\n\"\n"
-"\"$w mark set insert end\\n\"\n"
-"\"$w mark set out {insert linestart}\\n\"\n"
-"\"$w yview insert\\n\"\n"
-"\"}\\n\"\n"
-"\"proc console:Prior w {\\n\"\n"
-"\"upvar #0 $w v\\n\"\n"
-"\"if {$v(current)<=0} return\\n\"\n"
-"\"incr v(current) -1\\n\"\n"
-"\"set line [lindex $v(history) $v(current)]\\n\"\n"
-"\"console:SetLine $w $line\\n\"\n"
-"\"}\\n\"\n"
-"\"proc console:Next w {\\n\"\n"
-"\"upvar #0 $w v\\n\"\n"
-"\"if {$v(current)>=$v(historycnt)} return\\n\"\n"
-"\"incr v(current) 1\\n\"\n"
-"\"set line [lindex $v(history) $v(current)]\\n\"\n"
-"\"console:SetLine $w $line\\n\"\n"
-"\"}\\n\"\n"
-"\"proc console:SetLine {w line} {\\n\"\n"
-"\"upvar #0 $w v\\n\"\n"
-"\"scan [$w index insert] %d.%d row col\\n\"\n"
-"\"set start $row.$v(plength)\\n\"\n"
-"\"$w delete $start end\\n\"\n"
-"\"$w insert end $line\\n\"\n"
-"\"$w mark set insert end\\n\"\n"
-"\"$w yview insert\\n\"\n"
-"\"}\\n\"\n"
-"\"proc console:Button1 {w x y} {\\n\"\n"
-"\"global tkPriv\\n\"\n"
-"\"upvar #0 $w v\\n\"\n"
-"\"set v(mouseMoved) 0\\n\"\n"
-"\"set v(pressX) $x\\n\"\n"
-"\"set p [console:nearestBoundry $w $x $y]\\n\"\n"
-"\"scan [$w index insert] %d.%d ix iy\\n\"\n"
-"\"scan $p %d.%d px py\\n\"\n"
-"\"if {$px==$ix} {\\n\"\n"
-"\"$w mark set insert $p\\n\"\n"
-"\"}\\n\"\n"
-"\"$w mark set anchor $p\\n\"\n"
-"\"focus $w\\n\"\n"
-"\"}\\n\"\n"
-"\"proc console:nearestBoundry {w x y} {\\n\"\n"
-"\"set p [$w index @$x,$y]\\n\"\n"
-"\"set bb [$w bbox $p]\\n\"\n"
-"\"if {![string compare $bb \\\"\\\"]} {return $p}\\n\"\n"
-"\"if {($x-[lindex $bb 0])<([lindex $bb 2]/2)} {return $p}\\n\"\n"
-"\"$w index \\\"$p + 1 char\\\"\\n\"\n"
-"\"}\\n\"\n"
-"\"proc console:SelectTo {w x y} {\\n\"\n"
-"\"upvar #0 $w v\\n\"\n"
-"\"set cur [console:nearestBoundry $w $x $y]\\n\"\n"
-"\"if {[catch {$w index anchor}]} {\\n\"\n"
-"\"$w mark set anchor $cur\\n\"\n"
-"\"}\\n\"\n"
-"\"set anchor [$w index anchor]\\n\"\n"
-"\"if {[$w compare $cur != $anchor] || (abs($v(pressX) - $x) >= 3)} {\\n\"\n"
-"\"if {$v(mouseMoved)==0} {\\n\"\n"
-"\"$w tag remove sel 0.0 end\\n\"\n"
-"\"}\\n\"\n"
-"\"set v(mouseMoved) 1\\n\"\n"
-"\"}\\n\"\n"
-"\"if {[$w compare $cur < anchor]} {\\n\"\n"
-"\"set first $cur\\n\"\n"
-"\"set last anchor\\n\"\n"
-"\"} else {\\n\"\n"
-"\"set first anchor\\n\"\n"
-"\"set last $cur\\n\"\n"
-"\"}\\n\"\n"
-"\"if {$v(mouseMoved)} {\\n\"\n"
-"\"$w tag remove sel 0.0 $first\\n\"\n"
-"\"$w tag add sel $first $last\\n\"\n"
-"\"$w tag remove sel $last end\\n\"\n"
-"\"update idletasks\\n\"\n"
-"\"}\\n\"\n"
-"\"}\\n\"\n"
-"\"proc console:B1Motion {w x y} {\\n\"\n"
-"\"upvar #0 $w v\\n\"\n"
-"\"set v(y) $y\\n\"\n"
-"\"set v(x) $x\\n\"\n"
-"\"console:SelectTo $w $x $y\\n\"\n"
-"\"}\\n\"\n"
-"\"proc console:B1Leave {w x y} {\\n\"\n"
-"\"upvar #0 $w v\\n\"\n"
-"\"set v(y) $y\\n\"\n"
-"\"set v(x) $x\\n\"\n"
-"\"console:motor $w\\n\"\n"
-"\"}\\n\"\n"
-"\"proc console:motor w {\\n\"\n"
-"\"upvar #0 $w v\\n\"\n"
-"\"if {![winfo exists $w]} return\\n\"\n"
-"\"if {$v(y)>=[winfo height $w]} {\\n\"\n"
-"\"$w yview scroll 1 units\\n\"\n"
-"\"} elseif {$v(y)<0} {\\n\"\n"
-"\"$w yview scroll -1 units\\n\"\n"
-"\"} else {\\n\"\n"
-"\"return\\n\"\n"
-"\"}\\n\"\n"
-"\"console:SelectTo $w $v(x) $v(y)\\n\"\n"
-"\"set v(timer) [after 50 console:motor $w]\\n\"\n"
-"\"}\\n\"\n"
-"\"proc console:cancelMotor w {\\n\"\n"
-"\"upvar #0 $w v\\n\"\n"
-"\"catch {after cancel $v(timer)}\\n\"\n"
-"\"catch {unset v(timer)}\\n\"\n"
-"\"}\\n\"\n"
-"\"proc console:Copy w {\\n\"\n"
-"\"if {![catch {set text [$w get sel.first sel.last]}]} {\\n\"\n"
-"\"clipboard clear -displayof $w\\n\"\n"
-"\"clipboard append -displayof $w $text\\n\"\n"
-"\"}\\n\"\n"
-"\"}\\n\"\n"
-"\"proc console:canCut w {\\n\"\n"
-"\"set r [catch {\\n\"\n"
-"\"scan [$w index sel.first] %d.%d s1x s1y\\n\"\n"
-"\"scan [$w index sel.last] %d.%d s2x s2y\\n\"\n"
-"\"scan [$w index insert] %d.%d ix iy\\n\"\n"
-"\"}]\\n\"\n"
-"\"if {$r==1} {return 0}\\n\"\n"
-"\"if {$s1x==$ix && $s2x==$ix} {return 1}\\n\"\n"
-"\"return 2\\n\"\n"
-"\"}\\n\"\n"
-"\"proc console:Cut w {\\n\"\n"
-"\"if {[console:canCut $w]==1} {\\n\"\n"
-"\"console:Copy $w\\n\"\n"
-"\"$w delete sel.first sel.last\\n\"\n"
-"\"}\\n\"\n"
-"\"}\\n\"\n"
-"\"proc console:Paste w {\\n\"\n"
-"\"if {[console:canCut $w]==1} {\\n\"\n"
-"\"$w delete sel.first sel.last\\n\"\n"
-"\"}\\n\"\n"
-"\"if {[catch {selection get -displayof $w -selection CLIPBOARD} topaste]} {\\n\"\n"
-"\"return\\n\"\n"
-"\"}\\n\"\n"
-"\"set prior 0\\n\"\n"
-"\"foreach line [split $topaste \\\\n] {\\n\"\n"
-"\"if {$prior} {\\n\"\n"
-"\"console:Enter $w\\n\"\n"
-"\"update\\n\"\n"
-"\"}\\n\"\n"
-"\"set prior 1\\n\"\n"
-"\"$w insert insert $line\\n\"\n"
-"\"}\\n\"\n"
-"\"}\\n\"\n"
-"\"proc console:EnableEditMenu w {\\n\"\n"
-"\"set m $w.mb.edit.m\\n\"\n"
-"\"switch [console:canCut $w.t] {\\n\"\n"
-"\"0 {\\n\"\n"
-"\"$m entryconf Copy -state disabled\\n\"\n"
-"\"$m entryconf Cut -state disabled\\n\"\n"
-"\"}\\n\"\n"
-"\"1 {\\n\"\n"
-"\"$m entryconf Copy -state normal\\n\"\n"
-"\"$m entryconf Cut -state normal\\n\"\n"
-"\"}\\n\"\n"
-"\"2 {\\n\"\n"
-"\"$m entryconf Copy -state normal\\n\"\n"
-"\"$m entryconf Cut -state disabled\\n\"\n"
-"\"}\\n\"\n"
-"\"}\\n\"\n"
-"\"}\\n\"\n"
-"\"proc console:SourceFile w {\\n\"\n"
-"\"set types {\\n\"\n"
-"\"{{TCL Scripts} {.tcl}}\\n\"\n"
-"\"{{All Files} *}\\n\"\n"
-"\"}\\n\"\n"
-"\"set f [tk_getOpenFile -filetypes $types -title \\\"TCL Script To Source...\\\"]\\n\"\n"
-"\"if {$f!=\\\"\\\"} {\\n\"\n"
-"\"uplevel #0 source $f\\n\"\n"
-"\"}\\n\"\n"
-"\"}\\n\"\n"
-"\"proc console:SaveFile w {\\n\"\n"
-"\"set types {\\n\"\n"
-"\"{{Text Files} {.txt}}\\n\"\n"
-"\"{{All Files} *}\\n\"\n"
-"\"}\\n\"\n"
-"\"set f [tk_getSaveFile -filetypes $types -title \\\"Write Screen To...\\\"]\\n\"\n"
-"\"if {$f!=\\\"\\\"} {\\n\"\n"
-"\"if {[catch {open $f w} fd]} {\\n\"\n"
-"\"tk_messageBox -type ok -icon error -message $fd\\n\"\n"
-"\"} else {\\n\"\n"
-"\"puts $fd [string trimright [$w get 1.0 end] \\\\n]\\n\"\n"
-"\"close $fd\\n\"\n"
-"\"}\\n\"\n"
-"\"}\\n\"\n"
-"\"}\\n\"\n"
-"\"proc console:Clear w {\\n\"\n"
-"\"$w delete 1.0 {insert linestart}\\n\"\n"
-"\"}\\n\"\n"
-"; /* End of the console code */\n"
-"#endif /* ET_ENABLE_TK */\n"
-"\n"
-"/*\n"
-"** The \"printf\" code that follows dates from the 1980's. It is in\n"
-"** the public domain. The original comments are included here for\n"
-"** completeness. They are slightly out-of-date.\n"
-"**\n"
-"** The following modules is an enhanced replacement for the \"printf\" programs\n"
-"** found in the standard library. The following enhancements are\n"
-"** supported:\n"
-"**\n"
-"** + Additional functions. The standard set of \"printf\" functions\n"
-"** includes printf, fprintf, sprintf, vprintf, vfprintf, and\n"
-"** vsprintf. This module adds the following:\n"
-"**\n"
-"** * snprintf -- Works like sprintf, but has an extra argument\n"
-"** which is the size of the buffer written to.\n"
-"**\n"
-"** * mprintf -- Similar to sprintf. Writes output to memory\n"
-"** obtained from malloc.\n"
-"**\n"
-"** * xprintf -- Calls a function to dispose of output.\n"
-"**\n"
-"** * nprintf -- No output, but returns the number of characters\n"
-"** that would have been output by printf.\n"
-"**\n"
-"** * A v- version (ex: vsnprintf) of every function is also\n"
-"** supplied.\n"
-"**\n"
-"** + A few extensions to the formatting notation are supported:\n"
-"**\n"
-"** * The \"=\" flag (similar to \"-\") causes the output to be\n"
-"** be centered in the appropriately sized field.\n"
-"**\n"
-"** * The %b field outputs an integer in binary notation.\n"
-"**\n"
-"** * The %c field now accepts a precision. The character output\n"
-"** is repeated by the number of times the precision specifies.\n"
-"**\n"
-"** * The %' field works like %c, but takes as its character the\n"
-"** next character of the format string, instead of the next\n"
-"** argument. For example, printf(\"%.78'-\") prints 78 minus\n"
-"** signs, the same as printf(\"%.78c\",'-').\n"
-"**\n"
-"** + When compiled using GCC on a SPARC, this version of printf is\n"
-"** faster than the library printf for SUN OS 4.1.\n"
-"**\n"
-"** + All functions are fully reentrant.\n"
-"**\n"
-"*/\n"
-"/*\n"
-"** Undefine COMPATIBILITY to make some slight changes in the way things\n"
-"** work. I think the changes are an improvement, but they are not\n"
-"** backwards compatible.\n"
-"*/\n"
-"/* #define COMPATIBILITY / * Compatible with SUN OS 4.1 */\n"
-"\n"
-"/*\n"
-"** Characters that need to be escaped inside a TCL string.\n"
-"*/\n"
-"static char NeedEsc[] = {\n"
-" 1, 1, 1, 1, 1, 1, 1, 1, 'b', 't', 'n', 1, 'f', 'r', 1, 1,\n"
-" 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,\n"
-" 0, 0, '\"', 0, '$', 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,\n"
-" 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,\n"
-" 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,\n"
-" 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, '[','\\\\', ']', 0, 0,\n"
-" 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,\n"
-" 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 1,\n"
-" 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,\n"
-" 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,\n"
-" 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,\n"
-" 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,\n"
-" 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,\n"
-" 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,\n"
-" 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,\n"
-" 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,\n"
-"};\n"
-"\n"
-"/*\n"
-"** Conversion types fall into various categories as defined by the\n"
-"** following enumeration.\n"
-"*/\n"
-"enum et_type { /* The type of the format field */\n"
-" etRADIX, /* Integer types. %d, %x, %o, and so forth */\n"
-" etFLOAT, /* Floating point. %f */\n"
-" etEXP, /* Exponentional notation. %e and %E */\n"
-" etGENERIC, /* Floating or exponential, depending on exponent. %g */\n"
-" etSIZE, /* Return number of characters processed so far. %n */\n"
-" etSTRING, /* Strings. %s */\n"
-" etPERCENT, /* Percent symbol. %% */\n"
-" etCHARX, /* Characters. %c */\n"
-" etERROR, /* Used to indicate no such conversion type */\n"
-"/* The rest are extensions, not normally found in printf() */\n"
-" etCHARLIT, /* Literal characters. %' */\n"
-" etTCLESCAPE, /* Strings with special characters escaped. %q */\n"
-" etMEMSTRING, /* A string which should be deleted after use. %z */\n"
-" etORDINAL /* 1st, 2nd, 3rd and so forth */\n"
-"};\n"
-"\n"
-"/*\n"
-"** Each builtin conversion character (ex: the 'd' in \"%d\") is described\n"
-"** by an instance of the following structure\n"
-"*/\n"
-"typedef struct et_info { /* Information about each format field */\n"
-" int fmttype; /* The format field code letter */\n"
-" int base; /* The base for radix conversion */\n"
-" char *charset; /* The character set for conversion */\n"
-" int flag_signed; /* Is the quantity signed? */\n"
-" char *prefix; /* Prefix on non-zero values in alt format */\n"
-" enum et_type type; /* Conversion paradigm */\n"
-"} et_info;\n"
-"\n"
-"/*\n"
-"** The following table is searched linearly, so it is good to put the\n"
-"** most frequently used conversion types first.\n"
-"*/\n"
-"static et_info fmtinfo[] = {\n"
-" { 'd', 10, \"0123456789\", 1, 0, etRADIX, },\n"
-" { 's', 0, 0, 0, 0, etSTRING, }, \n"
-" { 'q', 0, 0, 0, 0, etTCLESCAPE, },\n"
-" { 'z', 0, 0, 0, 0, etMEMSTRING, },\n"
-" { 'c', 0, 0, 0, 0, etCHARX, },\n"
-" { 'o', 8, \"01234567\", 0, \"0\", etRADIX, },\n"
-" { 'u', 10, \"0123456789\", 0, 0, etRADIX, },\n"
-" { 'x', 16, \"0123456789abcdef\", 0, \"x0\", etRADIX, },\n"
-" { 'X', 16, \"0123456789ABCDEF\", 0, \"X0\", etRADIX, },\n"
-" { 'r', 10, \"0123456789\", 0, 0, etORDINAL, },\n"
-" { 'f', 0, 0, 1, 0, etFLOAT, },\n"
-" { 'e', 0, \"e\", 1, 0, etEXP, },\n"
-" { 'E', 0, \"E\", 1, 0, etEXP, },\n"
-" { 'g', 0, \"e\", 1, 0, etGENERIC, },\n"
-" { 'G', 0, \"E\", 1, 0, etGENERIC, },\n"
-" { 'i', 10, \"0123456789\", 1, 0, etRADIX, },\n"
-" { 'n', 0, 0, 0, 0, etSIZE, },\n"
-" { '%', 0, 0, 0, 0, etPERCENT, },\n"
-" { 'b', 2, \"01\", 0, \"b0\", etRADIX, }, /* Binary */\n"
-" { 'p', 10, \"0123456789\", 0, 0, etRADIX, }, /* Pointers */\n"
-" { '\\'', 0, 0, 0, 0, etCHARLIT, }, /* Literal char */\n"
-"};\n"
-"#define etNINFO (sizeof(fmtinfo)/sizeof(fmtinfo[0]))\n"
-"\n"
-"/*\n"
-"** If NOFLOATINGPOINT is defined, then none of the floating point\n"
-"** conversions will work.\n"
-"*/\n"
-"#ifndef etNOFLOATINGPOINT\n"
-"/*\n"
-"** \"*val\" is a double such that 0.1 <= *val < 10.0\n"
-"** Return the ascii code for the leading digit of *val, then\n"
-"** multiply \"*val\" by 10.0 to renormalize.\n"
-"**\n"
-"** Example:\n"
-"** input: *val = 3.14159\n"
-"** output: *val = 1.4159 function return = '3'\n"
-"**\n"
-"** The counter *cnt is incremented each time. After counter exceeds\n"
-"** 16 (the number of significant digits in a 64-bit float) '0' is\n"
-"** always returned.\n"
-"*/\n"
-"static int et_getdigit(double *val, int *cnt){\n"
-" int digit;\n"
-" double d;\n"
-" if( (*cnt)++ >= 16 ) return '0';\n"
-" digit = (int)*val;\n"
-" d = digit;\n"
-" digit += '0';\n"
-" *val = (*val - d)*10.0;\n"
-" return digit;\n"
-"}\n"
-"#endif\n"
-"\n"
-"#define etBUFSIZE 1000 /* Size of the output buffer */\n"
-"\n"
-"/*\n"
-"** The root program. All variations call this core.\n"
-"**\n"
-"** INPUTS:\n"
-"** func This is a pointer to a function taking three arguments\n"
-"** 1. A pointer to anything. Same as the \"arg\" parameter.\n"
-"** 2. A pointer to the list of characters to be output\n"
-"** (Note, this list is NOT null terminated.)\n"
-"** 3. An integer number of characters to be output.\n"
-"** (Note: This number might be zero.)\n"
-"**\n"
-"** arg This is the pointer to anything which will be passed as the\n"
-"** first argument to \"func\". Use it for whatever you like.\n"
-"**\n"
-"** fmt This is the format string, as in the usual print.\n"
-"**\n"
-"** ap This is a pointer to a list of arguments. Same as in\n"
-"** vfprint.\n"
-"**\n"
-"** OUTPUTS:\n"
-"** The return value is the total number of characters sent to\n"
-"** the function \"func\". Returns -1 on a error.\n"
-"**\n"
-"** Note that the order in which automatic variables are declared below\n"
-"** seems to make a big difference in determining how fast this beast\n"
-"** will run.\n"
-"*/\n"
-"int vxprintf(\n"
-" void (*func)(void*,char*,int),\n"
-" void *arg,\n"
-" const char *format,\n"
-" va_list ap\n"
-"){\n"
-" register const char *fmt; /* The format string. */\n"
-" register int c; /* Next character in the format string */\n"
-" register char *bufpt; /* Pointer to the conversion buffer */\n"
-" register int precision; /* Precision of the current field */\n"
-" register int length; /* Length of the field */\n"
-" register int idx; /* A general purpose loop counter */\n"
-" int count; /* Total number of characters output */\n"
-" int width; /* Width of the current field */\n"
-" int flag_leftjustify; /* True if \"-\" flag is present */\n"
-" int flag_plussign; /* True if \"+\" flag is present */\n"
-" int flag_blanksign; /* True if \" \" flag is present */\n"
-" int flag_alternateform; /* True if \"#\" flag is present */\n"
-" int flag_zeropad; /* True if field width constant starts with zero */\n"
-" int flag_long; /* True if \"l\" flag is present */\n"
-" int flag_center; /* True if \"=\" flag is present */\n"
-" unsigned long longvalue; /* Value for integer types */\n"
-" double realvalue; /* Value for real types */\n"
-" et_info *infop; /* Pointer to the appropriate info structure */\n"
-" char buf[etBUFSIZE]; /* Conversion buffer */\n"
-" char prefix; /* Prefix character. \"+\" or \"-\" or \" \" or '\\0'. */\n"
-" int errorflag = 0; /* True if an error is encountered */\n"
-" enum et_type xtype; /* Conversion paradigm */\n"
-" char *zMem; /* String to be freed */\n"
-" char *zExtra; /* Extra memory used for etTCLESCAPE conversions */\n"
-" static char spaces[] = \" \"\n"
-" \" \";\n"
-"#define etSPACESIZE (sizeof(spaces)-1)\n"
-"#ifndef etNOFLOATINGPOINT\n"
-" int exp; /* exponent of real numbers */\n"
-" double rounder; /* Used for rounding floating point values */\n"
-" int flag_dp; /* True if decimal point should be shown */\n"
-" int flag_rtz; /* True if trailing zeros should be removed */\n"
-" int flag_exp; /* True to force display of the exponent */\n"
-" int nsd; /* Number of significant digits returned */\n"
-"#endif\n"
-"\n"
-" fmt = format; /* Put in a register for speed */\n"
-" count = length = 0;\n"
-" bufpt = 0;\n"
-" for(; (c=(*fmt))!=0; ++fmt){\n"
-" if( c!='%' ){\n"
-" register int amt;\n"
-" bufpt = (char *)fmt;\n"
-" amt = 1;\n"
-" while( (c=(*++fmt))!='%' && c!=0 ) amt++;\n"
-" (*func)(arg,bufpt,amt);\n"
-" count += amt;\n"
-" if( c==0 ) break;\n"
-" }\n"
-" if( (c=(*++fmt))==0 ){\n"
-" errorflag = 1;\n"
-" (*func)(arg,\"%\",1);\n"
-" count++;\n"
-" break;\n"
-" }\n"
-" /* Find out what flags are present */\n"
-" flag_leftjustify = flag_plussign = flag_blanksign = \n"
-" flag_alternateform = flag_zeropad = flag_center = 0;\n"
-" do{\n"
-" switch( c ){\n"
-" case '-': flag_leftjustify = 1; c = 0; break;\n"
-" case '+': flag_plussign = 1; c = 0; break;\n"
-" case ' ': flag_blanksign = 1; c = 0; break;\n"
-" case '#': flag_alternateform = 1; c = 0; break;\n"
-" case '0': flag_zeropad = 1; c = 0; break;\n"
-" case '=': flag_center = 1; c = 0; break;\n"
-" default: break;\n"
-" }\n"
-" }while( c==0 && (c=(*++fmt))!=0 );\n"
-" if( flag_center ) flag_leftjustify = 0;\n"
-" /* Get the field width */\n"
-" width = 0;\n"
-" if( c=='*' ){\n"
-" width = va_arg(ap,int);\n"
-" if( width<0 ){\n"
-" flag_leftjustify = 1;\n"
-" width = -width;\n"
-" }\n"
-" c = *++fmt;\n"
-" }else{\n"
-" while( isdigit(c) ){\n"
-" width = width*10 + c - '0';\n"
-" c = *++fmt;\n"
-" }\n"
-" }\n"
-" if( width > etBUFSIZE-10 ){\n"
-" width = etBUFSIZE-10;\n"
-" }\n"
-" /* Get the precision */\n"
-" if( c=='.' ){\n"
-" precision = 0;\n"
-" c = *++fmt;\n"
-" if( c=='*' ){\n"
-" precision = va_arg(ap,int);\n"
-"#ifndef etCOMPATIBILITY\n"
-" /* This is sensible, but SUN OS 4.1 doesn't do it. */\n"
-" if( precision<0 ) precision = -precision;\n"
-"#endif\n"
-" c = *++fmt;\n"
-" }else{\n"
-" while( isdigit(c) ){\n"
-" precision = precision*10 + c - '0';\n"
-" c = *++fmt;\n"
-" }\n"
-" }\n"
-" /* Limit the precision to prevent overflowing buf[] during conversion */\n"
-" if( precision>etBUFSIZE-40 ) precision = etBUFSIZE-40;\n"
-" }else{\n"
-" precision = -1;\n"
-" }\n"
-" /* Get the conversion type modifier */\n"
-" if( c=='l' ){\n"
-" flag_long = 1;\n"
-" c = *++fmt;\n"
-" }else{\n"
-" flag_long = 0;\n"
-" }\n"
-" /* Fetch the info entry for the field */\n"
-" infop = 0;\n"
-" for(idx=0; idx<etNINFO; idx++){\n"
-" if( c==fmtinfo[idx].fmttype ){\n"
-" infop = &fmtinfo[idx];\n"
-" break;\n"
-" }\n"
-" }\n"
-" /* No info entry found. It must be an error. */\n"
-" if( infop==0 ){\n"
-" xtype = etERROR;\n"
-" }else{\n"
-" xtype = infop->type;\n"
-" }\n"
-" zExtra = 0;\n"
-"\n"
-" /*\n"
-" ** At this point, variables are initialized as follows:\n"
-" **\n"
-" ** flag_alternateform TRUE if a '#' is present.\n"
-" ** flag_plussign TRUE if a '+' is present.\n"
-" ** flag_leftjustify TRUE if a '-' is present or if the\n"
-" ** field width was negative.\n"
-" ** flag_zeropad TRUE if the width began with 0.\n"
-" ** flag_long TRUE if the letter 'l' (ell) prefixed\n"
-" ** the conversion character.\n"
-" ** flag_blanksign TRUE if a ' ' is present.\n"
-" ** width The specified field width. This is\n"
-" ** always non-negative. Zero is the default.\n"
-" ** precision The specified precision. The default\n"
-" ** is -1.\n"
-" ** xtype The class of the conversion.\n"
-" ** infop Pointer to the appropriate info struct.\n"
-" */\n"
-" switch( xtype ){\n"
-" case etORDINAL:\n"
-" case etRADIX:\n"
-" if( flag_long ) longvalue = va_arg(ap,long);\n"
-" else longvalue = va_arg(ap,int);\n"
-"#ifdef etCOMPATIBILITY\n"
-" /* For the format %#x, the value zero is printed \"0\" not \"0x0\".\n"
-" ** I think this is stupid. */\n"
-" if( longvalue==0 ) flag_alternateform = 0;\n"
-"#else\n"
-" /* More sensible: turn off the prefix for octal (to prevent \"00\"),\n"
-" ** but leave the prefix for hex. */\n"
-" if( longvalue==0 && infop->base==8 ) flag_alternateform = 0;\n"
-"#endif\n"
-" if( infop->flag_signed ){\n"
-" if( *(long*)&longvalue<0 ){\n"
-" longvalue = -*(long*)&longvalue;\n"
-" prefix = '-';\n"
-" }else if( flag_plussign ) prefix = '+';\n"
-" else if( flag_blanksign ) prefix = ' ';\n"
-" else prefix = 0;\n"
-" }else prefix = 0;\n"
-" if( flag_zeropad && precision<width-(prefix!=0) ){\n"
-" precision = width-(prefix!=0);\n"
-" }\n"
-" bufpt = &buf[etBUFSIZE];\n"
-" if( xtype==etORDINAL ){\n"
-" long a,b;\n"
-" a = longvalue%10;\n"
-" b = longvalue%100;\n"
-" bufpt -= 2;\n"
-" if( a==0 || a>3 || (b>10 && b<14) ){\n"
-" bufpt[0] = 't';\n"
-" bufpt[1] = 'h';\n"
-" }else if( a==1 ){\n"
-" bufpt[0] = 's';\n"
-" bufpt[1] = 't';\n"
-" }else if( a==2 ){\n"
-" bufpt[0] = 'n';\n"
-" bufpt[1] = 'd';\n"
-" }else if( a==3 ){\n"
-" bufpt[0] = 'r';\n"
-" bufpt[1] = 'd';\n"
-" }\n"
-" }\n"
-" {\n"
-" register char *cset; /* Use registers for speed */\n"
-" register int base;\n"
-" cset = infop->charset;\n"
-" base = infop->base;\n"
-" do{ /* Convert to ascii */\n"
-" *(--bufpt) = cset[longvalue%base];\n"
-" longvalue = longvalue/base;\n"
-" }while( longvalue>0 );\n"
-" }\n"
-" length = (long)&buf[etBUFSIZE]-(long)bufpt;\n"
-" for(idx=precision-length; idx>0; idx--){\n"
-" *(--bufpt) = '0'; /* Zero pad */\n"
-" }\n"
-" if( prefix ) *(--bufpt) = prefix; /* Add sign */\n"
-" if( flag_alternateform && infop->prefix ){ /* Add \"0\" or \"0x\" */\n"
-" char *pre, x;\n"
-" pre = infop->prefix;\n"
-" if( *bufpt!=pre[0] ){\n"
-" for(pre=infop->prefix; (x=(*pre))!=0; pre++) *(--bufpt) = x;\n"
-" }\n"
-" }\n"
-" length = (long)&buf[etBUFSIZE]-(long)bufpt;\n"
-" break;\n"
-" case etFLOAT:\n"
-" case etEXP:\n"
-" case etGENERIC:\n"
-" realvalue = va_arg(ap,double);\n"
-"#ifndef etNOFLOATINGPOINT\n"
-" if( precision<0 ) precision = 6; /* Set default precision */\n"
-" if( precision>etBUFSIZE-10 ) precision = etBUFSIZE-10;\n"
-" if( realvalue<0.0 ){\n"
-" realvalue = -realvalue;\n"
-" prefix = '-';\n"
-" }else{\n"
-" if( flag_plussign ) prefix = '+';\n"
-" else if( flag_blanksign ) prefix = ' ';\n"
-" else prefix = 0;\n"
-" }\n"
-" if( infop->type==etGENERIC && precision>0 ) precision--;\n"
-" rounder = 0.0;\n"
-"#ifdef COMPATIBILITY\n"
-" /* Rounding works like BSD when the constant 0.4999 is used. Wierd! */\n"
-" for(idx=precision, rounder=0.4999; idx>0; idx--, rounder*=0.1);\n"
-"#else\n"
-" /* It makes more sense to use 0.5 */\n"
-" for(idx=precision, rounder=0.5; idx>0; idx--, rounder*=0.1);\n"
-"#endif\n"
-" if( infop->type==etFLOAT ) realvalue += rounder;\n"
-" /* Normalize realvalue to within 10.0 > realvalue >= 1.0 */\n"
-" exp = 0;\n"
-" if( realvalue>0.0 ){\n"
-" int k = 0;\n"
-" while( realvalue>=1e8 && k++<100 ){ realvalue *= 1e-8; exp+=8; }\n"
-" while( realvalue>=10.0 && k++<100 ){ realvalue *= 0.1; exp++; }\n"
-" while( realvalue<1e-8 && k++<100 ){ realvalue *= 1e8; exp-=8; }\n"
-" while( realvalue<1.0 && k++<100 ){ realvalue *= 10.0; exp--; }\n"
-" if( k>=100 ){\n"
-" bufpt = \"NaN\";\n"
-" length = 3;\n"
-" break;\n"
-" }\n"
-" }\n"
-" bufpt = buf;\n"
-" /*\n"
-" ** If the field type is etGENERIC, then convert to either etEXP\n"
-" ** or etFLOAT, as appropriate.\n"
-" */\n"
-" flag_exp = xtype==etEXP;\n"
-" if( xtype!=etFLOAT ){\n"
-" realvalue += rounder;\n"
-" if( realvalue>=10.0 ){ realvalue *= 0.1; exp++; }\n"
-" }\n"
-" if( xtype==etGENERIC ){\n"
-" flag_rtz = !flag_alternateform;\n"
-" if( exp<-4 || exp>precision ){\n"
-" xtype = etEXP;\n"
-" }else{\n"
-" precision = precision - exp;\n"
-" xtype = etFLOAT;\n"
-" }\n"
-" }else{\n"
-" flag_rtz = 0;\n"
-" }\n"
-" /*\n"
-" ** The \"exp+precision\" test causes output to be of type etEXP if\n"
-" ** the precision is too large to fit in buf[].\n"
-" */\n"
-" nsd = 0;\n"
-" if( xtype==etFLOAT && exp+precision<etBUFSIZE-30 ){\n"
-" flag_dp = (precision>0 || flag_alternateform);\n"
-" if( prefix ) *(bufpt++) = prefix; /* Sign */\n"
-" if( exp<0 ) *(bufpt++) = '0'; /* Digits before \".\" */\n"
-" else for(; exp>=0; exp--) *(bufpt++) = et_getdigit(&realvalue,&nsd);\n"
-" if( flag_dp ) *(bufpt++) = '.'; /* The decimal point */\n"
-" for(exp++; exp<0 && precision>0; precision--, exp++){\n"
-" *(bufpt++) = '0';\n"
-" }\n"
-" while( (precision--)>0 ) *(bufpt++) = et_getdigit(&realvalue,&nsd);\n"
-" *(bufpt--) = 0; /* Null terminate */\n"
-" if( flag_rtz && flag_dp ){ /* Remove trailing zeros and \".\" */\n"
-" while( bufpt>=buf && *bufpt=='0' ) *(bufpt--) = 0;\n"
-" if( bufpt>=buf && *bufpt=='.' ) *(bufpt--) = 0;\n"
-" }\n"
-" bufpt++; /* point to next free slot */\n"
-" }else{ /* etEXP or etGENERIC */\n"
-" flag_dp = (precision>0 || flag_alternateform);\n"
-" if( prefix ) *(bufpt++) = prefix; /* Sign */\n"
-" *(bufpt++) = et_getdigit(&realvalue,&nsd); /* First digit */\n"
-" if( flag_dp ) *(bufpt++) = '.'; /* Decimal point */\n"
-" while( (precision--)>0 ) *(bufpt++) = et_getdigit(&realvalue,&nsd);\n"
-" bufpt--; /* point to last digit */\n"
-" if( flag_rtz && flag_dp ){ /* Remove tail zeros */\n"
-" while( bufpt>=buf && *bufpt=='0' ) *(bufpt--) = 0;\n"
-" if( bufpt>=buf && *bufpt=='.' ) *(bufpt--) = 0;\n"
-" }\n"
-" bufpt++; /* point to next free slot */\n"
-" if( exp || flag_exp ){\n"
-" *(bufpt++) = infop->charset[0];\n"
-" if( exp<0 ){ *(bufpt++) = '-'; exp = -exp; } /* sign of exp */\n"
-" else { *(bufpt++) = '+'; }\n"
-" if( exp>=100 ){\n"
-" *(bufpt++) = (exp/100)+'0'; /* 100's digit */\n"
-" exp %= 100;\n"
-" }\n"
-" *(bufpt++) = exp/10+'0'; /* 10's digit */\n"
-" *(bufpt++) = exp%10+'0'; /* 1's digit */\n"
-" }\n"
-" }\n"
-" /* The converted number is in buf[] and zero terminated. Output it.\n"
-" ** Note that the number is in the usual order, not reversed as with\n"
-" ** integer conversions. */\n"
-" length = (long)bufpt-(long)buf;\n"
-" bufpt = buf;\n"
-"\n"
-" /* Special case: Add leading zeros if the flag_zeropad flag is\n"
-" ** set and we are not left justified */\n"
-" if( flag_zeropad && !flag_leftjustify && length < width){\n"
-" int i;\n"
-" int nPad = width - length;\n"
-" for(i=width; i>=nPad; i--){\n"
-" bufpt[i] = bufpt[i-nPad];\n"
-" }\n"
-" i = prefix!=0;\n"
-" while( nPad-- ) bufpt[i++] = '0';\n"
-" length = width;\n"
-" }\n"
-"#endif\n"
-" break;\n"
-" case etSIZE:\n"
-" *(va_arg(ap,int*)) = count;\n"
-" length = width = 0;\n"
-" break;\n"
-" case etPERCENT:\n"
-" buf[0] = '%';\n"
-" bufpt = buf;\n"
-" length = 1;\n"
-" break;\n"
-" case etCHARLIT:\n"
-" case etCHARX:\n"
-" c = buf[0] = (xtype==etCHARX ? va_arg(ap,int) : *++fmt);\n"
-" if( precision>=0 ){\n"
-" for(idx=1; idx<precision; idx++) buf[idx] = c;\n"
-" length = precision;\n"
-" }else{\n"
-" length =1;\n"
-" }\n"
-" bufpt = buf;\n"
-" break;\n"
-" case etSTRING:\n"
-" case etMEMSTRING:\n"
-" zMem = bufpt = va_arg(ap,char*);\n"
-" if( bufpt==0 ) bufpt = \"(null)\";\n"
-" length = strlen(bufpt);\n"
-" if( precision>=0 && precision<length ) length = precision;\n"
-" break;\n"
-" case etTCLESCAPE:\n"
-" {\n"
-" int i, j, n, c, k;\n"
-" char *arg = va_arg(ap,char*);\n"
-" if( arg==0 ) arg = \"(NULL)\";\n"
-" for(i=n=0; (c=arg[i])!=0; i++){\n"
-" k = NeedEsc[c&0xff];\n"
-" if( k==0 ){\n"
-" n++;\n"
-" }else if( k==1 ){\n"
-" n+=4;\n"
-" }else{\n"
-" n+=2;\n"
-" }\n"
-" }\n"
-" n++;\n"
-" if( n>etBUFSIZE ){\n"
-" bufpt = zExtra = Tcl_Alloc( n );\n"
-" }else{\n"
-" bufpt = buf;\n"
-" }\n"
-" for(i=j=0; (c=arg[i])!=0; i++){\n"
-" k = NeedEsc[c&0xff];\n"
-" if( k==0 ){\n"
-" bufpt[j++] = c;\n"
-" }else if( k==1 ){\n"
-" bufpt[j++] = '\\\\';\n"
-" bufpt[j++] = ((c>>6) & 3) + '0';\n"
-" bufpt[j++] = ((c>>3) & 7) + '0';\n"
-" bufpt[j++] = (c & 7) + '0';\n"
-" }else{\n"
-" bufpt[j++] = '\\\\';\n"
-" bufpt[j++] = k;\n"
-" }\n"
-" }\n"
-" bufpt[j] = 0;\n"
-" length = j;\n"
-" if( precision>=0 && precision<length ) length = precision;\n"
-" }\n"
-" break;\n"
-" case etERROR:\n"
-" buf[0] = '%';\n"
-" buf[1] = c;\n"
-" errorflag = 0;\n"
-" idx = 1+(c!=0);\n"
-" (*func)(arg,\"%\",idx);\n"
-" count += idx;\n"
-" if( c==0 ) fmt--;\n"
-" break;\n"
-" }/* End switch over the format type */\n"
-" /*\n"
-" ** The text of the conversion is pointed to by \"bufpt\" and is\n"
-" ** \"length\" characters long. The field width is \"width\". Do\n"
-" ** the output.\n"
-" */\n"
-" if( !flag_leftjustify ){\n"
-" register int nspace;\n"
-" nspace = width-length;\n"
-" if( nspace>0 ){\n"
-" if( flag_center ){\n"
-" nspace = nspace/2;\n"
-" width -= nspace;\n"
-" flag_leftjustify = 1;\n"
-" }\n"
-" count += nspace;\n"
-" while( nspace>=etSPACESIZE ){\n"
-" (*func)(arg,spaces,etSPACESIZE);\n"
-" nspace -= etSPACESIZE;\n"
-" }\n"
-" if( nspace>0 ) (*func)(arg,spaces,nspace);\n"
-" }\n"
-" }\n"
-" if( length>0 ){\n"
-" (*func)(arg,bufpt,length);\n"
-" count += length;\n"
-" }\n"
-" if( xtype==etMEMSTRING && zMem ){\n"
-" Tcl_Free(zMem);\n"
-" }\n"
-" if( flag_leftjustify ){\n"
-" register int nspace;\n"
-" nspace = width-length;\n"
-" if( nspace>0 ){\n"
-" count += nspace;\n"
-" while( nspace>=etSPACESIZE ){\n"
-" (*func)(arg,spaces,etSPACESIZE);\n"
-" nspace -= etSPACESIZE;\n"
-" }\n"
-" if( nspace>0 ) (*func)(arg,spaces,nspace);\n"
-" }\n"
-" }\n"
-" if( zExtra ){\n"
-" Tcl_Free(zExtra);\n"
-" }\n"
-" }/* End for loop over the format string */\n"
-" return errorflag ? -1 : count;\n"
-"} /* End of function */\n"
-"\n"
-"/*\n"
-"** The following section of code handles the mprintf routine, that\n"
-"** writes to memory obtained from malloc().\n"
-"*/\n"
-"\n"
-"/* This structure is used to store state information about the\n"
-"** write to memory that is currently in progress.\n"
-"*/\n"
-"struct sgMprintf {\n"
-" char *zBase; /* A base allocation */\n"
-" char *zText; /* The string collected so far */\n"
-" int nChar; /* Length of the string so far */\n"
-" int nAlloc; /* Amount of space allocated in zText */\n"
-"};\n"
-"\n"
-"/* \n"
-"** The xprintf callback function. \n"
-"**\n"
-"** This routine add nNewChar characters of text in zNewText to\n"
-"** the sgMprintf structure pointed to by \"arg\".\n"
-"*/\n"
-"static void mout(void *arg, char *zNewText, int nNewChar){\n"
-" struct sgMprintf *pM = (struct sgMprintf*)arg;\n"
-" if( pM->nChar + nNewChar + 1 > pM->nAlloc ){\n"
-" pM->nAlloc = pM->nChar + nNewChar*2 + 1;\n"
-" if( pM->zText==pM->zBase ){\n"
-" pM->zText = Tcl_Alloc(pM->nAlloc);\n"
-" if( pM->zText && pM->nChar ) memcpy(pM->zText,pM->zBase,pM->nChar);\n"
-" }else{\n"
-" pM->zText = Tcl_Realloc(pM->zText, pM->nAlloc);\n"
-" }\n"
-" }\n"
-" if( pM->zText ){\n"
-" memcpy(&pM->zText[pM->nChar], zNewText, nNewChar);\n"
-" pM->nChar += nNewChar;\n"
-" pM->zText[pM->nChar] = 0;\n"
-" }\n"
-"}\n"
-"\n"
-"/*\n"
-"** mprintf() works like printf(), but allocations memory to hold the\n"
-"** resulting string and returns a pointer to the allocated memory.\n"
-"*/\n"
-"char *mprintf(const char *zFormat, ...){\n"
-" va_list ap;\n"
-" struct sgMprintf sMprintf;\n"
-" char *zNew;\n"
-" char zBuf[200];\n"
-"\n"
-" sMprintf.nChar = 0;\n"
-" sMprintf.nAlloc = sizeof(zBuf);\n"
-" sMprintf.zText = zBuf;\n"
-" sMprintf.zBase = zBuf;\n"
-" va_start(ap,zFormat);\n"
-" vxprintf(mout,&sMprintf,zFormat,ap);\n"
-" va_end(ap);\n"
-" sMprintf.zText[sMprintf.nChar] = 0;\n"
-" if( sMprintf.zText==sMprintf.zBase ){\n"
-" zNew = Tcl_Alloc( sMprintf.nChar+1 );\n"
-" if( zNew ) strcpy(zNew,zBuf);\n"
-" }else{\n"
-" zNew = Tcl_Realloc(sMprintf.zText,sMprintf.nChar+1);\n"
-" }\n"
-" return zNew;\n"
-"}\n"
-"\n"
-"/* This is the varargs version of mprintf. \n"
-"*/\n"
-"char *vmprintf(const char *zFormat, va_list ap){\n"
-" struct sgMprintf sMprintf;\n"
-" char zBuf[200];\n"
-" sMprintf.nChar = 0;\n"
-" sMprintf.zText = zBuf;\n"
-" sMprintf.nAlloc = sizeof(zBuf);\n"
-" sMprintf.zBase = zBuf;\n"
-" vxprintf(mout,&sMprintf,zFormat,ap);\n"
-" sMprintf.zText[sMprintf.nChar] = 0;\n"
-" if( sMprintf.zText==sMprintf.zBase ){\n"
-" sMprintf.zText = Tcl_Alloc( strlen(zBuf)+1 );\n"
-" if( sMprintf.zText ) strcpy(sMprintf.zText,zBuf);\n"
-" }else{\n"
-" sMprintf.zText = Tcl_Realloc(sMprintf.zText,sMprintf.nChar+1);\n"
-" }\n"
-" return sMprintf.zText;\n"
-"}\n"
-"\n"
-"/*\n"
-"** Add text output to a Tcl_DString.\n"
-"**\n"
-"** This routine is called by vxprintf(). It's job is to add\n"
-"** nNewChar characters of text from zNewText to the Tcl_DString\n"
-"** that \"arg\" is pointing to.\n"
-"*/\n"
-"static void dstringout(void *arg, char *zNewText, int nNewChar){\n"
-" Tcl_DString *str = (Tcl_DString*)arg;\n"
-" Tcl_DStringAppend(str,zNewText,nNewChar);\n"
-"}\n"
-"\n"
-"/*\n"
-"** Append formatted output to a DString.\n"
-"*/\n"
-"char *Et_DStringAppendF(Tcl_DString *str, const char *zFormat, ...){\n"
-" va_list ap;\n"
-" va_start(ap,zFormat);\n"
-" vxprintf(dstringout,str,zFormat,ap);\n"
-" va_end(ap);\n"
-" return Tcl_DStringValue(str);\n"
-"}\n"
-"\n"
-"/*\n"
-"** Make this variable true to trace all calls to EvalF\n"
-"*/\n"
-"int Et_EvalTrace = 0;\n"
-"\n"
-"/*\n"
-"** Eval the results of a string.\n"
-"*/\n"
-"int Et_EvalF(Tcl_Interp *interp, const char *zFormat, ...){\n"
-" char *zCmd;\n"
-" va_list ap;\n"
-" int result;\n"
-" va_start(ap,zFormat);\n"
-" zCmd = vmprintf(zFormat,ap);\n"
-" if( Et_EvalTrace ) printf(\"%s\\n\",zCmd);\n"
-" result = Tcl_Eval(interp,zCmd);\n"
-" if( Et_EvalTrace ) printf(\"%d %s\\n\",result,interp->result);\n"
-" Tcl_Free(zCmd);\n"
-" return result;\n"
-"}\n"
-"int Et_GlobalEvalF(Tcl_Interp *interp, const char *zFormat, ...){\n"
-" char *zCmd;\n"
-" va_list ap;\n"
-" int result;\n"
-" va_start(ap,zFormat);\n"
-" zCmd = vmprintf(zFormat,ap);\n"
-" if( Et_EvalTrace ) printf(\"%s\\n\",zCmd);\n"
-" result = Tcl_GlobalEval(interp,zCmd);\n"
-" if( Et_EvalTrace ) printf(\"%d %s\\n\",result,interp->result);\n"
-" Tcl_Free(zCmd);\n"
-" return result;\n"
-"}\n"
-"\n"
-"/*\n"
-"** Set the result of an interpreter using printf-like arguments.\n"
-"*/\n"
-"void Et_ResultF(Tcl_Interp *interp, const char *zFormat, ...){\n"
-" Tcl_DString str;\n"
-" va_list ap;\n"
-"\n"
-" Tcl_DStringInit(&str);\n"
-" va_start(ap,zFormat);\n"
-" vxprintf(dstringout,&str,zFormat,ap);\n"
-" va_end(ap);\n"
-" Tcl_DStringResult(interp,&str); \n"
-"}\n"
-"\n"
-"#if ET_HAVE_OBJ\n"
-"/*\n"
-"** Append text to a string object.\n"
-"*/\n"
-"int Et_AppendObjF(Tcl_Obj *pObj, const char *zFormat, ...){\n"
-" va_list ap;\n"
-" int rc;\n"
-"\n"
-" va_start(ap,zFormat);\n"
-" rc = vxprintf((void(*)(void*,char*,int))Tcl_AppendToObj, pObj, zFormat, ap);\n"
-" va_end(ap);\n"
-" return rc;\n"
-"}\n"
-"#endif\n"
-"\n"
-"\n"
-"#if ET_WIN32\n"
-"/*\n"
-"** This array translates all characters into themselves. Except\n"
-"** for the \\ which gets translated into /. And all upper-case\n"
-"** characters are translated into lower case. This is used for\n"
-"** hashing and comparing filenames, to work around the Windows\n"
-"** bug of ignoring filename case and using the wrong separator\n"
-"** character for directories.\n"
-"**\n"
-"** The array is initialized by FilenameHashInit().\n"
-"**\n"
-"** We also define a macro ET_TRANS() that actually does\n"
-"** the character translation. ET_TRANS() is a no-op under\n"
-"** unix.\n"
-"*/\n"
-"static char charTrans[256];\n"
-"#define ET_TRANS(X) (charTrans[0xff&(int)(X)])\n"
-"#else\n"
-"#define ET_TRANS(X) (X)\n"
-"#endif\n"
-"\n"
-"/*\n"
-"** Hash a filename. The value returned is appropriate for\n"
-"** indexing into the Et_FileHashTable[] array.\n"
-"*/\n"
-"static int FilenameHash(char *zName){\n"
-" int h = 0;\n"
-" while( *zName ){\n"
-" h = h ^ (h<<5) ^ ET_TRANS(*(zName++));\n"
-" }\n"
-" if( h<0 ) h = -h;\n"
-" return h % (sizeof(Et_FileHashTable)/sizeof(Et_FileHashTable[0]));\n"
-"}\n"
-"\n"
-"/*\n"
-"** Compare two filenames. Return 0 if they are the same and\n"
-"** non-zero if they are different.\n"
-"*/\n"
-"static int FilenameCmp(char *z1, char *z2){\n"
-" int diff;\n"
-" while( (diff = ET_TRANS(*z1)-ET_TRANS(*z2))==0 && *z1!=0){\n"
-" z1++;\n"
-" z2++;\n"
-" }\n"
-" return diff;\n"
-"}\n"
-"\n"
-"/*\n"
-"** Initialize the file hash table\n"
-"*/\n"
-"static void FilenameHashInit(void){\n"
-" int i;\n"
-"#if ET_WIN32\n"
-" for(i=0; i<sizeof(charTrans); i++){\n"
-" charTrans[i] = i;\n"
-" }\n"
-" for(i='A'; i<='Z'; i++){\n"
-" charTrans[i] = i + 'a' - 'A';\n"
-" }\n"
-" charTrans['\\\\'] = '/';\n"
-"#endif\n"
-" for(i=0; i<sizeof(Et_FileSet)/sizeof(Et_FileSet[0]) - 1; i++){\n"
-" struct EtFile *p;\n"
-" int h;\n"
-" p = &Et_FileSet[i];\n"
-" h = FilenameHash(p->zName);\n"
-" p->pNext = Et_FileHashTable[h];\n"
-" Et_FileHashTable[h] = p;\n"
-" }\n"
-"}\n"
-"\n"
-"/*\n"
-"** Locate the text of a built-in file given its name. \n"
-"** Return 0 if not found. Return this size of the file (not\n"
-"** counting the null-terminator) in *pSize if pSize!=NULL.\n"
-"**\n"
-"** If deshroud==1 and the file is shrouded, then descramble\n"
-"** the text.\n"
-"*/\n"
-"static char *FindBuiltinFile(char *zName, int deshroud, int *pSize){\n"
-" int h;\n"
-" struct EtFile *p;\n"
-"\n"
-" h = FilenameHash(zName);\n"
-" p = Et_FileHashTable[h];\n"
-" while( p && FilenameCmp(p->zName,zName)!=0 ){ p = p->pNext; }\n"
-"#if ET_SHROUD_KEY>0\n"
-" if( p && p->shrouded && deshroud ){\n"
-" char *z;\n"
-" int xor = ET_SHROUD_KEY;\n"
-" for(z=p->zData; *z; z++){\n"
-" if( *z>=0x20 ){ *z ^= xor; xor = (xor+1)&0x1f; }\n"
-" }\n"
-" p->shrouded = 0;\n"
-" }\n"
-"#endif\n"
-" if( p && pSize ){\n"
-" *pSize = p->nData;\n"
-" }\n"
-" return p ? p->zData : 0;\n"
-"}\n"
-"\n"
-"/*\n"
-"** Add a new file to the list of built-in files.\n"
-"**\n"
-"** This routine makes a copy of zFilename. But it does NOT make\n"
-"** a copy of zData. It just holds a pointer to zData and uses\n"
-"** that for all file access. So after calling this routine,\n"
-"** you should never change zData!\n"
-"*/\n"
-"void Et_NewBuiltinFile(\n"
-" char *zFilename, /* Name of the new file */\n"
-" char *zData, /* Data for the new file */\n"
-" int nData /* Number of bytes in the new file */\n"
-"){\n"
-" int h;\n"
-" struct EtFile *p;\n"
-"\n"
-" p = (struct EtFile*)Tcl_Alloc( sizeof(struct EtFile) + strlen(zFilename) + 1);\n"
-" if( p==0 ) return;\n"
-" p->zName = (char*)&p[1];\n"
-" strcpy(p->zName, zFilename);\n"
-" p->zData = zData;\n"
-" p->nData = nData;\n"
-" p->shrouded = 0;\n"
-" h = FilenameHash(zFilename);\n"
-" p->pNext = Et_FileHashTable[h];\n"
-" Et_FileHashTable[h] = p;\n"
-"}\n"
-"\n"
-"/*\n"
-"** A TCL interface to the Et_NewBuiltinFile function. For Tcl8.0\n"
-"** and later, we make this an Obj command so that it can deal with\n"
-"** binary data.\n"
-"*/\n"
-"#if ET_HAVE_OBJ\n"
-"static int Et_NewBuiltinFileCmd(ET_OBJARGS){\n"
-" char *zData, *zNew;\n"
-" int nData;\n"
-" if( objc!=3 ){\n"
-" Tcl_WrongNumArgs(interp, 1, objv, \"filename data\");\n"
-" return TCL_ERROR;\n"
-" }\n"
-" zData = (char*)Tcl_GetByteArrayFromObj(objv[2], &nData);\n"
-" zNew = Tcl_Alloc( nData + 1 );\n"
-" if( zNew ){\n"
-" memcpy(zNew, zData, nData);\n"
-" zNew[nData] = 0;\n"
-" Et_NewBuiltinFile(Tcl_GetStringFromObj(objv[1], 0), zNew, nData);\n"
-" }\n"
-" return TCL_OK;\n"
-"}\n"
-"#else\n"
-"static int Et_NewBuiltinFileCmd(ET_TCLARGS){\n"
-" char *zData;\n"
-" int nData;\n"
-" if( argc!=3 ){\n"
-" Et_ResultF(interp,\"wrong # args: should be \\\"%s FILENAME DATA\\\"\", argv[0]);\n"
-" return TCL_ERROR;\n"
-" }\n"
-" nData = strlen(argv[2]) + 1;\n"
-" zData = Tcl_Alloc( nData );\n"
-" if( zData ){\n"
-" strcpy(zData, argv[2]);\n"
-" Et_NewBuiltinFile(argv[1], zData, nData);\n"
-" }\n"
-" return TCL_OK;\n"
-"}\n"
-"#endif\n"
-"\n"
-"/*\n"
-"** The following section implements the InsertProc functionality. The\n"
-"** new InsertProc feature of Tcl8.0.3 and later allows us to overload\n"
-"** the usual system call commands for file I/O and replace them with\n"
-"** commands that operate on the built-in files.\n"
-"*/\n"
-"#ifdef ET_HAVE_INSERTPROC\n"
-"\n"
-"/* \n"
-"** Each open channel to a built-in file is an instance of the\n"
-"** following structure.\n"
-"*/\n"
-"typedef struct Et_FileStruct {\n"
-" char *zData; /* All of the data */\n"
-" int nData; /* Bytes of data, not counting the null terminator */\n"
-" int cursor; /* How much of the data has been read so far */\n"
-"} Et_FileStruct;\n"
-"\n"
-"/*\n"
-"** Close a previously opened built-in file.\n"
-"*/\n"
-"static int Et_FileClose(ClientData instanceData, Tcl_Interp *interp){\n"
-" Et_FileStruct *p = (Et_FileStruct*)instanceData;\n"
-" Tcl_Free((char*)p);\n"
-" return 0;\n"
-"}\n"
-"\n"
-"/*\n"
-"** Read from a built-in file.\n"
-"*/\n"
-"static int Et_FileInput(\n"
-" ClientData instanceData, /* The file structure */\n"
-" char *buf, /* Write the data read here */\n"
-" int bufSize, /* Read this much data */\n"
-" int *pErrorCode /* Write the error code here */\n"
-"){\n"
-" Et_FileStruct *p = (Et_FileStruct*)instanceData;\n"
-" *pErrorCode = 0;\n"
-" if( p->cursor+bufSize>p->nData ){\n"
-" bufSize = p->nData - p->cursor;\n"
-" }\n"
-" memcpy(buf, &p->zData[p->cursor], bufSize);\n"
-" p->cursor += bufSize;\n"
-" return bufSize;\n"
-"}\n"
-"\n"
-"/*\n"
-"** Writes to a built-in file always return EOF.\n"
-"*/\n"
-"static int Et_FileOutput(\n"
-" ClientData instanceData, /* The file structure */\n"
-" char *buf, /* Read the data from here */\n"
-" int toWrite, /* Write this much data */\n"
-" int *pErrorCode /* Write the error code here */\n"
-"){\n"
-" *pErrorCode = 0;\n"
-" return 0;\n"
-"}\n"
-"\n"
-"/*\n"
-"** Move the cursor around within the built-in file.\n"
-"*/\n"
-"static int Et_FileSeek(\n"
-" ClientData instanceData, /* The file structure */\n"
-" long offset, /* Offset to seek to */\n"
-" int mode, /* One of SEEK_CUR, SEEK_SET or SEEK_END */\n"
-" int *pErrorCode /* Write the error code here */\n"
-"){\n"
-" Et_FileStruct *p = (Et_FileStruct*)instanceData;\n"
-" switch( mode ){\n"
-" case SEEK_CUR: offset += p->cursor; break;\n"
-" case SEEK_END: offset += p->nData; break;\n"
-" default: break;\n"
-" }\n"
-" if( offset<0 ) offset = 0;\n"
-" if( offset>p->nData ) offset = p->nData;\n"
-" p->cursor = offset;\n"
-" return offset;\n"
-"}\n"
-"\n"
-"/*\n"
-"** The Watch method is a no-op\n"
-"*/\n"
-"static void Et_FileWatch(ClientData instanceData, int mask){\n"
-"}\n"
-"\n"
-"/*\n"
-"** The Handle method always returns an error.\n"
-"*/\n"
-"static int Et_FileHandle(ClientData notUsed, int dir, ClientData *handlePtr){\n"
-" return TCL_ERROR;\n"
-"}\n"
-"\n"
-"/*\n"
-"** This is the channel type that will access the built-in files.\n"
-"*/\n"
-"static Tcl_ChannelType builtinChannelType = {\n"
-" \"builtin\", /* Type name. */\n"
-" NULL, /* Always non-blocking.*/\n"
-" Et_FileClose, /* Close proc. */\n"
-" Et_FileInput, /* Input proc. */\n"
-" Et_FileOutput, /* Output proc. */\n"
-" Et_FileSeek, /* Seek proc. */\n"
-" NULL, /* Set option proc. */\n"
-" NULL, /* Get option proc. */\n"
-" Et_FileWatch, /* Watch for events on console. */\n"
-" Et_FileHandle, /* Get a handle from the device. */\n"
-"};\n"
-"\n"
-"/*\n"
-"** This routine attempts to do an open of a built-in file.\n"
-"*/\n"
-"static Tcl_Channel Et_FileOpen(\n"
-" Tcl_Interp *interp, /* The TCL interpreter doing the open */\n"
-" char *zFilename, /* Name of the file to open */\n"
-" char *modeString, /* Mode string for the open (ignored) */\n"
-" int permissions /* Permissions for a newly created file (ignored) */\n"
-"){\n"
-" char *zData;\n"
-" Et_FileStruct *p;\n"
-" int nData;\n"
-" char zName[50];\n"
-" Tcl_Channel chan;\n"
-" static int count = 1;\n"
-"\n"
-" zData = FindBuiltinFile(zFilename, 1, &nData);\n"
-" if( zData==0 ) return NULL;\n"
-" p = (Et_FileStruct*)Tcl_Alloc( sizeof(Et_FileStruct) );\n"
-" if( p==0 ) return NULL;\n"
-" p->zData = zData;\n"
-" p->nData = nData;\n"
-" p->cursor = 0;\n"
-" sprintf(zName,\"etbi_%x_%x\",((int)Et_FileOpen)>>12,count++);\n"
-" chan = Tcl_CreateChannel(&builtinChannelType, zName, \n"
-" (ClientData)p, TCL_READABLE);\n"
-" return chan;\n"
-"}\n"
-"\n"
-"/*\n"
-"** This routine does a stat() system call for a built-in file.\n"
-"*/\n"
-"static int Et_FileStat(char *path, struct stat *buf){\n"
-" char *zData;\n"
-" int nData;\n"
-"\n"
-" zData = FindBuiltinFile(path, 0, &nData);\n"
-" if( zData==0 ){\n"
-" return -1;\n"
-" }\n"
-" memset(buf, 0, sizeof(*buf));\n"
-" buf->st_mode = 0400;\n"
-" buf->st_size = nData;\n"
-" return 0;\n"
-"}\n"
-"\n"
-"/*\n"
-"** This routien does an access() system call for a built-in file.\n"
-"*/\n"
-"static int Et_FileAccess(char *path, int mode){\n"
-" char *zData;\n"
-"\n"
-" if( mode & 3 ){\n"
-" return -1;\n"
-" }\n"
-" zData = FindBuiltinFile(path, 0, 0);\n"
-" if( zData==0 ){\n"
-" return -1;\n"
-" }\n"
-" return 0; \n"
-"}\n"
-"#endif /* ET_HAVE_INSERTPROC */\n"
-"\n"
-"/*\n"
-"** An overloaded version of \"source\". First check for the file\n"
-"** is one of the built-ins. If it isn't a built-in, then check the\n"
-"** disk. But if ET_STANDALONE is set (which corresponds to the\n"
-"** \"Strict\" option in the user interface) then never check the disk.\n"
-"** This gives us a quick way to check for the common error of\n"
-"** sourcing a file that exists on the development by mistake, \n"
-"** and only discovering the mistake when you move the program\n"
-"** to your customer's machine.\n"
-"*/\n"
-"static int Et_Source(ET_TCLARGS){\n"
-" char *z;\n"
-"\n"
-" if( argc!=2 ){\n"
-" Et_ResultF(interp,\"wrong # args: should be \\\"%s FILENAME\\\"\", argv[0]);\n"
-" return TCL_ERROR;\n"
-" }\n"
-" z = FindBuiltinFile(argv[1], 1, 0);\n"
-" if( z ){\n"
-" int rc;\n"
-" rc = Tcl_Eval(interp,z);\n"
-" if (rc == TCL_ERROR) {\n"
-" char msg[200];\n"
-" sprintf(msg, \"\\n (file \\\"%.150s\\\" line %d)\", argv[1],\n"
-" interp->errorLine);\n"
-" Tcl_AddErrorInfo(interp, msg);\n"
-" } else {\n"
-" rc = TCL_OK;\n"
-" }\n"
-" return rc;\n"
-" }\n"
-"#if ET_STANDALONE\n"
-" Et_ResultF(interp,\"no such file: \\\"%s\\\"\", argv[1]);\n"
-" return TCL_ERROR;\n"
-"#else\n"
-" return Tcl_EvalFile(interp,argv[1]);\n"
-"#endif\n"
-"}\n"
-"\n"
-"#ifndef ET_HAVE_INSERTPROC\n"
-"/*\n"
-"** An overloaded version of \"file exists\". First check for the file\n"
-"** in the file table, then go to disk.\n"
-"**\n"
-"** We only overload \"file exists\" if we don't have InsertProc() \n"
-"** procedures. If we do have InsertProc() procedures, they will\n"
-"** handle this more efficiently.\n"
-"*/\n"
-"static int Et_FileExists(ET_TCLARGS){\n"
-" int i, rc;\n"
-" Tcl_DString str;\n"
-" if( argc==3 && strncmp(argv[1],\"exis\",4)==0 ){\n"
-" if( FindBuiltinFile(argv[2], 0, 0)!=0 ){\n"
-" interp->result = \"1\";\n"
-" return TCL_OK;\n"
-" }\n"
-" }\n"
-" Tcl_DStringInit(&str);\n"
-" Tcl_DStringAppendElement(&str,\"Et_FileCmd\");\n"
-" for(i=1; i<argc; i++){\n"
-" Tcl_DStringAppendElement(&str, argv[i]);\n"
-" }\n"
-" rc = Tcl_Eval(interp, Tcl_DStringValue(&str));\n"
-" Tcl_DStringFree(&str);\n"
-" return rc;\n"
-"}\n"
-"#endif\n"
-"\n"
-"/*\n"
-"** This is the main Tcl interpreter. It's a global variable so it\n"
-"** can be accessed easily from C code.\n"
-"*/\n"
-"Tcl_Interp *Et_Interp = 0;\n"
-"\n"
-"\n"
-"#if ET_WIN32\n"
-"/*\n"
-"** Implement the Et_MessageBox command on Windows platforms. We\n"
-"** use the MessageBox() function from the Win32 API so that the\n"
-"** error message will be displayed as a dialog box. Writing to\n"
-"** standard error doesn't do anything on windows.\n"
-"*/\n"
-"int Et_MessageBox(ET_TCLARGS){\n"
-" char *zMsg = \"(Empty Message)\";\n"
-" char *zTitle = \"Message...\";\n"
-"\n"
-" if( argc>1 ){\n"
-" zTitle = argv[1];\n"
-" }\n"
-" if( argc>2 ){\n"
-" zMsg = argv[2];\n"
-" }\n"
-" MessageBox(0, zMsg, zTitle, MB_ICONSTOP | MB_OK);\n"
-" return TCL_OK;\n"
-"}\n"
-"#endif\n"
-"\n"
-"/*\n"
-"** A default implementation for \"bgerror\"\n"
-"*/\n"
-"static char zBgerror[] = \n"
-" \"proc Et_Bgerror err {\\n\"\n"
-" \" global errorInfo tk_library\\n\"\n"
-" \" if {[info exists errorInfo]} {\\n\"\n"
-" \" set ei $errorInfo\\n\"\n"
-" \" } else {\\n\"\n"
-" \" set ei {}\\n\"\n"
-" \" }\\n\"\n"
-" \" if {[catch {bgerror $err}]==0} return\\n\"\n"
-" \" if {[string length $ei]>0} {\\n\"\n"
-" \" set err $ei\\n\"\n"
-" \" }\\n\"\n"
-" \" if {[catch {Et_MessageBox {Error} $err}]} {\\n\"\n"
-" \" puts stderr $err\\n\"\n"
-" \" }\\n\"\n"
-" \" exit\\n\"\n"
-" \"}\\n\"\n"
-";\n"
-"\n"
-"/*\n"
-"** Do the initialization.\n"
-"**\n"
-"** This routine is called after the interpreter is created, but\n"
-"** before Et_PreInit() or Et_AppInit() have been run.\n"
-"*/\n"
-"static int Et_DoInit(Tcl_Interp *interp){\n"
-" int i;\n"
-" extern int Et_PreInit(Tcl_Interp*);\n"
-" extern int Et_AppInit(Tcl_Interp*);\n"
-"\n"
-" /* Insert our alternative stat(), access() and open() procedures\n"
-" ** so that any attempt to work with a file will check our built-in\n"
-" ** scripts first.\n"
-" */\n"
-"#ifdef ET_HAVE_INSERTPROC\n"
-" TclStatInsertProc(Et_FileStat);\n"
-" TclAccessInsertProc(Et_FileAccess);\n"
-" TclOpenFileChannelInsertProc(Et_FileOpen);\n"
-"#endif\n"
-"\n"
-" /* Initialize the hash-table for built-in scripts\n"
-" */\n"
-" FilenameHashInit();\n"
-"\n"
-" /* The Et_NewBuiltFile command is inserted for use by FreeWrap\n"
-" ** and similar tools.\n"
-" */\n"
-"#if ET_HAVE_OBJ\n"
-" Tcl_CreateObjCommand(interp,\"Et_NewBuiltinFile\",Et_NewBuiltinFileCmd,0,0);\n"
-"#else\n"
-" Tcl_CreateCommand(interp,\"Et_NewBuiltinFile\",Et_NewBuiltinFileCmd,0,0);\n"
-"#endif\n"
-"\n"
-" /* Overload the \"file\" and \"source\" commands\n"
-" */\n"
-"#ifndef ET_HAVE_INSERTPROC\n"
-" {\n"
-" static char zRename[] = \"rename file Et_FileCmd\";\n"
-" Tcl_Eval(interp,zRename);\n"
-" Tcl_CreateCommand(interp,\"file\",Et_FileExists,0,0);\n"
-" }\n"
-"#endif\n"
-" Tcl_CreateCommand(interp,\"source\",Et_Source,0,0);\n"
-"\n"
-" Et_Interp = interp;\n"
-"#ifdef ET_TCL_LIBRARY\n"
-" Tcl_SetVar(interp,\"tcl_library\",ET_TCL_LIBRARY,TCL_GLOBAL_ONLY);\n"
-" Tcl_SetVar(interp,\"tcl_libPath\",ET_TCL_LIBRARY,TCL_GLOBAL_ONLY);\n"
-" Tcl_SetVar2(interp,\"env\",\"TCL_LIBRARY\",ET_TCL_LIBRARY,TCL_GLOBAL_ONLY);\n"
-"#endif\n"
-"#ifdef ET_TK_LIBRARY\n"
-" Tcl_SetVar(interp,\"tk_library\",ET_TK_LIBRARY,TCL_GLOBAL_ONLY);\n"
-" Tcl_SetVar2(interp,\"env\",\"TK_LIBRARY\",ET_TK_LIBRARY,TCL_GLOBAL_ONLY);\n"
-"#endif\n"
-"#if ET_WIN32\n"
-" Tcl_CreateCommand(interp,\"Et_MessageBox\",Et_MessageBox, 0, 0);\n"
-"#endif \n"
-" Tcl_Eval(interp,zBgerror);\n"
-"#if ET_HAVE_PREINIT\n"
-" if( Et_PreInit(interp) == TCL_ERROR ){\n"
-" goto initerr;\n"
-" }\n"
-"#endif\n"
-" if( Tcl_Init(interp) == TCL_ERROR ){\n"
-" goto initerr;\n"
-" }\n"
-" Et_GlobalEvalF(interp,\"set dir $tcl_library;source $dir/tclIndex;unset dir\");\n"
-"#if ET_ENABLE_TK\n"
-" if( Tk_Init(interp) == TCL_ERROR ){\n"
-" goto initerr;\n"
-" }\n"
-" Tcl_StaticPackage(interp,\"Tk\", Tk_Init, 0);\n"
-" Et_GlobalEvalF(interp,\"set dir $tk_library;source $dir/tclIndex;unset dir\");\n"
-"#endif\n"
-" /* Tcl_SetVar(interp, \"tcl_rcFileName\", \"~/.wishrc\", TCL_GLOBAL_ONLY); */\n"
-" for(i=0; i<sizeof(Et_CmdSet)/sizeof(Et_CmdSet[0]) - 1; i++){\n"
-" Tcl_CreateCommand(interp, Et_CmdSet[i].zName, Et_CmdSet[i].xProc, 0, 0);\n"
-" }\n"
-"#if ET_ENABLE_OBJ\n"
-" for(i=0; i<sizeof(Et_ObjSet)/sizeof(Et_ObjSet[0]) - 1; i++){\n"
-" Tcl_CreateObjCommand(interp, Et_ObjSet[i].zName, Et_ObjSet[i].xProc, 0, 0);\n"
-" }\n"
-"#endif\n"
-" Tcl_LinkVar(interp,\"Et_EvalTrace\",(char*)&Et_EvalTrace,TCL_LINK_BOOLEAN);\n"
-" Tcl_SetVar(interp,\"et_version\",ET_VERSION,TCL_GLOBAL_ONLY);\n"
-"#if ET_HAVE_APPINIT\n"
-" if( Et_AppInit(interp) == TCL_ERROR ){\n"
-" goto initerr;\n"
-" }\n"
-"#endif\n"
-"#if ET_ENABLE_TK && !ET_EXTENSION\n"
-" Et_NewBuiltinFile(\"builtin:/console.tcl\", zEtConsole, sizeof(zEtConsole));\n"
-"#if ET_CONSOLE\n"
-" Tcl_Eval(interp,\n"
-" \"source builtin:/console.tcl\\n\"\n"
-" \"console:create {. at console} {% } {Tcl/Tk Console}\\n\"\n"
-" );\n"
-"#endif\n"
-"#endif\n"
-"#ifdef ET_MAIN_SCRIPT\n"
-" if( Et_EvalF(interp,\"source \\\"%q\\\"\", ET_MAIN_SCRIPT)!=TCL_OK ){\n"
-" goto initerr;\n"
-" }\n"
-"#endif\n"
-" return TCL_OK;\n"
-"\n"
-"initerr:\n"
-" Et_EvalF(interp,\"Et_Bgerror \\\"%q\\\"\", interp->result);\n"
-" return TCL_ERROR;\n"
-"}\n"
-"\n"
-"#if ET_READ_STDIN==0 || ET_AUTO_FORK!=0\n"
-"/*\n"
-"** Initialize everything.\n"
-"*/\n"
-"static int Et_Local_Init(int argc, char **argv){\n"
-" Tcl_Interp *interp;\n"
-" char *args;\n"
-" char buf[100];\n"
-"#if !ET_HAVE_CUSTOM_MAINLOOP\n"
-" static char zWaitForever[] = \n"
-"#if ET_ENABLE_TK\n"
-" \"bind . <Destroy> {if {![winfo exists .]} exit}\\n\"\n"
-"#endif\n"
-" \"while 1 {vwait forever}\";\n"
-"#endif\n"
-"\n"
-" Tcl_FindExecutable(argv[0]);\n"
-" interp = Tcl_CreateInterp();\n"
-" args = Tcl_Merge(argc-1, argv+1);\n"
-" Tcl_SetVar(interp, \"argv\", args, TCL_GLOBAL_ONLY);\n"
-" ckfree(args);\n"
-" sprintf(buf, \"%d\", argc-1);\n"
-" Tcl_SetVar(interp, \"argc\", buf, TCL_GLOBAL_ONLY);\n"
-" Tcl_SetVar(interp, \"argv0\", argv[0], TCL_GLOBAL_ONLY);\n"
-" Tcl_SetVar(interp, \"tcl_interactive\", \"0\", TCL_GLOBAL_ONLY);\n"
-" Et_DoInit(interp);\n"
-"#if ET_HAVE_CUSTOM_MAINLOOP\n"
-" Et_CustomMainLoop(interp);\n"
-"#else\n"
-" Tcl_Eval(interp,zWaitForever);\n"
-"#endif\n"
-" return 0;\n"
-"}\n"
-"#endif\n"
-"\n"
-"/*\n"
-"** This routine is called to do the complete initialization.\n"
-"*/\n"
-"int Et_Init(int argc, char **argv){\n"
-"#ifdef ET_TCL_LIBRARY\n"
-" putenv(\"TCL_LIBRARY=\" ET_TCL_LIBRARY);\n"
-"#endif\n"
-"#ifdef ET_TK_LIBRARY\n"
-" putenv(\"TK_LIBRARY=\" ET_TK_LIBRARY);\n"
-"#endif\n"
-"#if ET_CONSOLE || !ET_READ_STDIN\n"
-" Et_Local_Init(argc, argv);\n"
-"#else\n"
-"# if ET_ENABLE_TK\n"
-" Tk_Main(argc,argv,Et_DoInit);\n"
-"# else\n"
-" Tcl_Main(argc, argv, Et_DoInit);\n"
-"# endif\n"
-"#endif\n"
-" return 0;\n"
-"}\n"
-"\n"
-"#if !ET_HAVE_MAIN && !ET_EXTENSION\n"
-"/*\n"
-"** Main routine for UNIX programs. If the user has supplied\n"
-"** their own main() routine in a C module, then the ET_HAVE_MAIN\n"
-"** macro will be set to 1 and this code will be skipped.\n"
-"*/\n"
-"int main(int argc, char **argv){\n"
-"#if ET_AUTO_FORK\n"
-" int rc = fork();\n"
-" if( rc<0 ){\n"
-" perror(\"can't fork\");\n"
-" exit(1);\n"
-" }\n"
-" if( rc>0 ) return 0;\n"
-" close(0);\n"
-" open(\"/dev/null\",O_RDONLY);\n"
-" close(1);\n"
-" open(\"/dev/null\",O_WRONLY);\n"
-"#endif\n"
-" return Et_Init(argc,argv)!=TCL_OK;\n"
-"}\n"
-"#endif\n"
-"\n"
-"#if ET_EXTENSION\n"
-"/*\n"
-"** If the -extension flag is used, then generate code that will be\n"
-"** turned into a loadable shared library or DLL, not a standalone\n"
-"** executable.\n"
-"*/\n"
-"int ET_EXTENSION_NAME(Tcl_Interp *interp){\n"
-" int i;\n"
-"#ifndef ET_HAVE_INSERTPROC\n"
-" Tcl_AppendResult(interp,\n"
-" \"mktclapp can only generate extensions for Tcl/Tk version \"\n"
-" \"8.0.3 and later. This is version \"\n"
-" TCL_MAJOR_VERSION \".\" TCL_MINOR_VERSION \".\" TCL_RELEASE_SERIAL, 0);\n"
-" return TCL_ERROR;\n"
-"#endif\n"
-"#ifdef ET_HAVE_INSERTPROC\n"
-"#ifdef USE_TCL_STUBS\n"
-" if( Tcl_InitStubs(interp,\"8.0\",0)==0 ){\n"
-" return TCL_ERROR;\n"
-" }\n"
-" if( Tk_InitStubs(interp,\"8.0\",0)==0 ){\n"
-" return TCL_ERROR;\n"
-" }\n"
-"#endif\n"
-" Et_Interp = interp;\n"
-" TclStatInsertProc(Et_FileStat);\n"
-" TclAccessInsertProc(Et_FileAccess);\n"
-" TclOpenFileChannelInsertProc(Et_FileOpen);\n"
-" FilenameHashInit();\n"
-" for(i=0; i<sizeof(Et_CmdSet)/sizeof(Et_CmdSet[0]) - 1; i++){\n"
-" Tcl_CreateCommand(interp, Et_CmdSet[i].zName, Et_CmdSet[i].xProc, 0, 0);\n"
-" }\n"
-"#if ET_ENABLE_OBJ\n"
-" for(i=0; i<sizeof(Et_ObjSet)/sizeof(Et_ObjSet[0]) - 1; i++){\n"
-" Tcl_CreateObjCommand(interp, Et_ObjSet[i].zName, Et_ObjSet[i].xProc, 0, 0);\n"
-" }\n"
-"#endif\n"
-" Tcl_LinkVar(interp,\"Et_EvalTrace\",(char*)&Et_EvalTrace,TCL_LINK_BOOLEAN);\n"
-" Tcl_SetVar(interp,\"et_version\",ET_VERSION,TCL_GLOBAL_ONLY);\n"
-"#if ET_HAVE_APPINIT\n"
-" if( Et_AppInit(interp) == TCL_ERROR ){\n"
-" return TCL_ERROR;\n"
-" }\n"
-"#endif\n"
-"#ifdef ET_MAIN_SCRIPT\n"
-" if( Et_EvalF(interp,\"source \\\"%q\\\"\", ET_MAIN_SCRIPT)!=TCL_OK ){\n"
-" return TCL_ERROR;\n"
-" }\n"
-"#endif\n"
-" return TCL_OK;\n"
-"#endif /* ET_HAVE_INSERTPROC */\n"
-"}\n"
-"int ET_SAFE_EXTENSION_NAME(Tcl_Interp *interp){\n"
-" return ET_EXTENSION_NAME(interp);\n"
-"}\n"
-"#endif\n"
-;
diff --git a/ftools/guis/fv/unix/runfv.csh b/ftools/guis/fv/unix/runfv.csh
deleted file mode 100644
index 75c8ea6..0000000
--- a/ftools/guis/fv/unix/runfv.csh
+++ /dev/null
@@ -1,4 +0,0 @@
-#!/bin/csh
-open -a X11
-setenv DISPLAY :0.0
-$1/Contents/Resources/fv5.0/fv $2
diff --git a/ftools/guis/fv/unix/xmktclapp.tcl b/ftools/guis/fv/unix/xmktclapp.tcl
deleted file mode 100644
index 2b8a9ee..0000000
--- a/ftools/guis/fv/unix/xmktclapp.tcl
+++ /dev/null
@@ -1,2830 +0,0 @@
-# A Notebook widget for Tcl/Tk
-# $Revision: 1.1 $
-#
-# Copyright (C) 1996,1997,1998 D. Richard Hipp
-#
-# This library is free software; you can redistribute it and/or
-# modify it under the terms of the GNU Library General Public
-# License as published by the Free Software Foundation; either
-# version 2 of the License, or (at your option) any later version.
-#
-# This library is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# Library General Public License for more details.
-#
-# You should have received a copy of the GNU Library General Public
-# License along with this library; if not, write to the
-# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-# Boston, MA 02111-1307, USA.
-#
-# Author contact information:
-# drh at acm.org
-# http://www.hwaci.com/drh/
-
-#
-# Create a new notebook widget
-#
-proc Notebook:create {w args} {
- global Notebook
- set Notebook($w,width) 400
- set Notebook($w,height) 300
- set Notebook($w,pages) {}
- set Notebook($w,top) 0
- set Notebook($w,pad) 5
- set Notebook($w,fg,on) black
- set Notebook($w,fg,off) grey50
- canvas $w -bd 0 -highlightthickness 0 -takefocus 0
- set Notebook($w,bg) [$w cget -bg]
- bind $w <1> "Notebook:click $w %x %y"
- bind $w <Configure> "Notebook:scheduleExpand $w"
- eval Notebook:config $w $args
-}
-
-#
-# Change configuration options for the notebook widget
-#
-proc Notebook:config {w args} {
- global Notebook
- foreach {tag value} $args {
- switch -- $tag {
- -width {
- set Notebook($w,width) $value
- }
- -height {
- set Notebook($w,height) $value
- }
- -pages {
- set Notebook($w,pages) $value
- }
- -pad {
- set Notebook($w,pad) $value
- }
- -bg {
- set Notebook($w,bg) $value
- }
- -fg {
- set Notebook($w,fg,on) $value
- }
- -disabledforeground {
- set Notebook($w,fg,off) $value
- }
- }
- }
-
- #
- # After getting new configuration values, reconstruct the widget
- #
- $w delete all
- set Notebook($w,x1) $Notebook($w,pad)
- set Notebook($w,x2) [expr $Notebook($w,x1)+2]
- set Notebook($w,x3) [expr $Notebook($w,x2)+$Notebook($w,width)]
- set Notebook($w,x4) [expr $Notebook($w,x3)+2]
- set Notebook($w,y1) [expr $Notebook($w,pad)+2]
- set Notebook($w,y2) [expr $Notebook($w,y1)+2]
- set Notebook($w,y5) [expr $Notebook($w,y1)+30]
- set Notebook($w,y6) [expr $Notebook($w,y5)+2]
- set Notebook($w,y3) [expr $Notebook($w,y6)+$Notebook($w,height)]
- set Notebook($w,y4) [expr $Notebook($w,y3)+2]
- set x $Notebook($w,x1)
- set cnt 0
- set y7 [expr $Notebook($w,y1)+10]
- label $w.dummy -text hi
- set font [$w.dummy cget -font]
- destroy $w.dummy
- foreach p $Notebook($w,pages) {
- set Notebook($w,p$cnt,x5) $x
- set id [$w create text 0 0 -text $p -anchor nw \
- -font $font -tags "p$cnt t$cnt"]
- set bbox [$w bbox $id]
- set width [lindex $bbox 2]
- $w move $id [expr $x+10] $y7
- $w create line \
- $x $Notebook($w,y5)\
- $x $Notebook($w,y2) \
- [expr $x+2] $Notebook($w,y1) \
- [expr $x+$width+16] $Notebook($w,y1) \
- -width 2 -fill white -tags p$cnt
- $w create line \
- [expr $x+$width+16] $Notebook($w,y1) \
- [expr $x+$width+18] $Notebook($w,y2) \
- [expr $x+$width+18] $Notebook($w,y5) \
- -width 2 -fill black -tags p$cnt
- set x [expr $x+$width+20]
- set Notebook($w,p$cnt,x6) [expr $x-2]
- if {![winfo exists $w.f$cnt]} {
- frame $w.f$cnt -bd 0
- }
- $w.f$cnt config -bg $Notebook($w,bg)
- place $w.f$cnt -x $Notebook($w,x2) -y $Notebook($w,y6) \
- -width $Notebook($w,width) -height $Notebook($w,height)
- incr cnt
- }
- $w create line \
- $Notebook($w,x1) [expr $Notebook($w,y5)-2] \
- $Notebook($w,x1) $Notebook($w,y3) \
- -width 2 -fill white
- $w create line \
- $Notebook($w,x1) $Notebook($w,y3) \
- $Notebook($w,x2) $Notebook($w,y4) \
- $Notebook($w,x3) $Notebook($w,y4) \
- $Notebook($w,x4) $Notebook($w,y3) \
- $Notebook($w,x4) $Notebook($w,y6) \
- $Notebook($w,x3) $Notebook($w,y5) \
- -width 2 -fill black
- $w config -width [expr $Notebook($w,x4)+$Notebook($w,pad)] \
- -height [expr $Notebook($w,y4)+$Notebook($w,pad)] \
- -bg $Notebook($w,bg)
- set top $Notebook($w,top)
- set Notebook($w,top) -1
- Notebook:raise.page $w $top
-}
-
-#
-# This routine is called whenever the mouse-button is pressed over
-# the notebook. It determines if any page should be raised and raises
-# that page.
-#
-proc Notebook:click {w x y} {
- global Notebook
- if {$y<$Notebook($w,y1) || $y>$Notebook($w,y6)} return
- set N [llength $Notebook($w,pages)]
- for {set i 0} {$i<$N} {incr i} {
- if {$x>=$Notebook($w,p$i,x5) && $x<=$Notebook($w,p$i,x6)} {
- Notebook:raise.page $w $i
- break
- }
- }
-}
-
-#
-# For internal use only. This procedure raised the n-th page of
-# the notebook
-#
-proc Notebook:raise.page {w n} {
- global Notebook
- if {$n<0 || $n>=[llength $Notebook($w,pages)]} return
- set top $Notebook($w,top)
- if {$top>=0 && $top<[llength $Notebook($w,pages)]} {
- $w move p$top 0 2
- }
- $w move p$n 0 -2
- $w delete topline
- if {$n>0} {
- $w create line \
- $Notebook($w,x1) $Notebook($w,y6) \
- $Notebook($w,x2) $Notebook($w,y5) \
- $Notebook($w,p$n,x5) $Notebook($w,y5) \
- $Notebook($w,p$n,x5) [expr $Notebook($w,y5)-2] \
- -width 2 -fill white -tags topline
- }
- $w create line \
- $Notebook($w,p$n,x6) [expr $Notebook($w,y5)-2] \
- $Notebook($w,p$n,x6) $Notebook($w,y5) \
- -width 2 -fill white -tags topline
- $w create line \
- $Notebook($w,p$n,x6) $Notebook($w,y5) \
- $Notebook($w,x3) $Notebook($w,y5) \
- -width 2 -fill white -tags topline
- set Notebook($w,top) $n
- raise $w.f$n
-}
-
-#
-# Change the page-specific configuration options for the notebook
-#
-proc Notebook:pageconfig {w name args} {
- global Notebook
- set i [lsearch $Notebook($w,pages) $name]
- if {$i<0} return
- foreach {tag value} $args {
- switch -- $tag {
- -state {
- if {"$value"=="disabled"} {
- $w itemconfig t$i -fg $Notebook($w,fg,off)
- } else {
- $w itemconfig t$i -fg $Notebook($w,fg,on)
- }
- }
- -onexit {
- set Notebook($w,p$i,onexit) $value
- }
- }
- }
-}
-
-#
-# This procedure raises a notebook page given its name. But first
-# we check the "onexit" procedure for the current page (if any) and
-# if it returns false, we don't allow the raise to proceed.
-#
-proc Notebook:raise {w name} {
- global Notebook
- set i [lsearch $Notebook($w,pages) $name]
- if {$i<0} return
- if {[info exists Notebook($w,p$i,onexit)]} {
- set onexit $Notebook($w,p$i,onexit)
- if {"$onexit"!="" && [eval uplevel #0 $onexit]!=0} {
- Notebook:raise.page $w $i
- }
- } else {
- Notebook:raise.page $w $i
- }
-}
-
-#
-# Return the frame associated with a given page of the notebook.
-#
-proc Notebook:frame {w name} {
- global Notebook
- set i [lsearch $Notebook($w,pages) $name]
- if {$i>=0} {
- return $w.f$i
- } else {
- return {}
- }
-}
-
-#
-# Try to resize the notebook to the next time we become idle.
-#
-proc Notebook:scheduleExpand w {
- global Notebook
- if {[info exists Notebook($w,expand)]} return
- set Notebook($w,expand) 1
- after idle "Notebook:expand $w"
-}
-
-#
-# Resize the notebook to fit inside its containing widget.
-#
-proc Notebook:expand w {
- global Notebook
- set wi [expr [winfo width $w]-($Notebook($w,pad)*2+4)]
- set hi [expr [winfo height $w]-($Notebook($w,pad)*2+36)]
- Notebook:config $w -width $wi -height $hi
- catch {unset Notebook($w,expand)}
-}
-
-# End of the notebook widget.
-#################################
-
-################################ Label Frame #############################
-#
-#
-proc LabelFrame:create {w args} {
- frame $w -bd 0
- label $w.l
- frame $w.f -bd 2 -relief groove
- frame $w.f.f
- pack $w.f.f
- set text {}
- set font {}
- set padx 3
- set pady 7
- set ipadx 2
- set ipady 9
- foreach {tag value} $args {
- switch -- $tag {
- -font {set font $value}
- -text {set text $value}
- -padx {set padx $value}
- -pady {set pady $value}
- -ipadx {set ipadx $value}
- -ipady {set ipady $value}
- -bd {$w.f config -bd $value}
- -relief {$w.f config -relief $value}
- }
- }
- if {"$font"!=""} {
- $w.l config -font $font
- }
- $w.l config -text $text
- pack $w.f -padx $padx -pady $pady -fill both -expand 1
- place $w.l -x [expr $padx+10] -y $pady -anchor w
- pack $w.f.f -padx $ipadx -pady $ipady -fill both -expand 1
- raise $w.l
- return $w.f.f
-}
-# End of the labeled frame widget.
-########################################################
-
-#########################################################
-# Directory Selector TCL version 1.1
-#
-# Originally written by:
-# Daniel Roche, <dan at lectra.com>
-#
-# Modified for xmktclapp (and for version of Tk prior to 8.0) by:
-# D. Richard Hipp, <drh at hwaci.com>
-
-# tk_getDirectory [option value ...]
-#
-# options are :
-# [-initialdir dir] display in dir
-# [-title string] make string title of dialog window
-# [-ok string] make string the label of OK button
-# [-open string] make string the label of OPEN button
-# [-cancel string] make string the label of CANCEL button
-# [-msg1 string] make string the label of the first directory message
-# [-msg2 string] make string the label of the second directory message
-#
-proc tk_getDirectory {args} {
- global tcl_platform tk_getDirectory
-
- #
- # arguments
- #
- set _titre "Directory Selector"
- set _ldir Directory:
- set _ldnam "Directory Name:"
- set _open Ok
- set _expand Open
- set _cancel Cancel
- if {![info exists tk_getDirectory(curdir)]} {
- set tk_getDirectory(curdir) [pwd]
- }
-
- set ind 0
- set max [llength $args]
- while { $ind < $max } {
- switch -exact -- [lindex $args $ind] {
- "-initialdir" {
- incr ind
- set tk_getDirectory(curdir) [lindex $args $ind]
- incr ind
- }
- "-title" {
- incr ind
- set _titre [lindex $args $ind]
- incr ind
- }
- "-ok" {
- incr ind
- set _open [lindex $args $ind]
- incr ind
- }
- "-open" {
- incr ind
- set _expand [lindex $args $ind]
- incr ind
- }
- "-cancel" {
- incr ind
- set _cancel [lindex $args $ind]
- incr ind
- }
- "-msg1" {
- incr ind
- set _ldir [lindex $args $ind]
- incr ind
- }
- "-msg2" {
- incr ind
- set _ldnam [lindex $args $ind]
- incr ind
- }
- default {
- puts "unknown option [lindex $args $ind]"
- return ""
- }
- }
- }
-
- #
- # variables et data
- #
- set tk_getDirectory(fini) 0
-
- image create bitmap tk_getDirectory:b_up -data "
- #define up_width 31
- #define up_height 23
- static unsigned char up_bits[] = {
- 0x00, 0x00, 0x00, 0x80, 0x00, 0x00, 0x00, 0x80, 0x00, 0x00, 0x00, 0x80,
- 0x00, 0x00, 0x00, 0x80, 0x00, 0x3f, 0x00, 0x80, 0x80, 0x40, 0x00, 0x80,
- 0x40, 0x80, 0x00, 0x80, 0xe0, 0xff, 0xff, 0x83, 0x20, 0x00, 0x00, 0x82,
- 0x20, 0x04, 0x00, 0x82, 0x20, 0x0e, 0x00, 0x82, 0x20, 0x1f, 0x00, 0x82,
- 0x20, 0x04, 0x00, 0x82, 0x20, 0x04, 0x00, 0x82, 0x20, 0x04, 0x00, 0x82,
- 0x20, 0xfc, 0x0f, 0x82, 0x20, 0x00, 0x00, 0x82, 0x20, 0x00, 0x00, 0x82,
- 0xe0, 0xff, 0xff, 0x83, 0x00, 0x00, 0x00, 0x80, 0x00, 0x00, 0x00, 0x80,
- 0x00, 0x00, 0x00, 0x80, 0x00, 0x00, 0x00, 0x80};"
-
- image create bitmap tk_getDirectory:b_dir -background #ffff80 -data "
- #define dir_width 17
- #define dir_height 16
- static unsigned char dir_bits[] = {
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x01, 0x00, 0x10, 0x02, 0x00,
- 0x08, 0x04, 0x00, 0xfc, 0x7f, 0x00, 0x04, 0x40, 0x00, 0x04, 0x40, 0x00,
- 0x04, 0x40, 0x00, 0x04, 0x40, 0x00, 0x04, 0x40, 0x00, 0x04, 0x40, 0x00,
- 0x04, 0x40, 0x00, 0xfc, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};" \
- -maskdata "
- #define dirm_width 17
- #define dirm_height 16
- static unsigned char dirm_bits[] = {
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x01, 0x00, 0xf0, 0x03, 0x00,
- 0xf8, 0x07, 0x00, 0xfc, 0x7f, 0x00, 0xfc, 0x7f, 0x00, 0xfc, 0x7f, 0x00,
- 0xfc, 0x7f, 0x00, 0xfc, 0x7f, 0x00, 0xfc, 0x7f, 0x00, 0xfc, 0x7f, 0x00,
- 0xfc, 0x7f, 0x00, 0xfc, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};"
-
- switch -exact $tcl_platform(platform) {
- unix {
- set tk_getDirectory(myfont) \
- -adobe-helvetica-bold-r-normal-*-12-120-75-75-p-70-iso8859-1
- }
- windows {
- set tk_getDirectory(myfont) {Courier 12}
- }
- }
-
- #
- # widgets
- #
- if {[winfo exists .dirsel]} {destroy .dirsel}
- toplevel .dirsel
- grab set .dirsel
- wm geometry .dirsel 500x250
- wm title .dirsel $_titre
-
- frame .dirsel.f1 -relief flat -borderwidth 0
- frame .dirsel.f2 -relief sunken -borderwidth 2
- frame .dirsel.f3 -relief flat -borderwidth 0
- frame .dirsel.f4 -relief flat -borderwidth 0
-
- pack .dirsel.f1 -fill x
- pack .dirsel.f2 -fill both -expand 1 -padx 6 -pady 6
- pack .dirsel.f3 -fill x
- pack .dirsel.f4 -fill x
-
- label .dirsel.f1.lab -text $_ldir
- menubutton .dirsel.f1.dir -relief raised -indicatoron 1 -anchor w \
- -menu .dirsel.f1.dir.m
- menu .dirsel.f1.dir.m -tearoff 0
- button .dirsel.f1.up -image tk_getDirectory:b_up \
- -command tk_getDirectory:UpDir
-
- pack .dirsel.f1.up -side right -padx 4 -pady 4
- pack .dirsel.f1.lab -side left -padx 4 -pady 4
- pack .dirsel.f1.dir -side right -padx 4 -pady 4 -fill x -expand 1
-
- canvas .dirsel.f2.cv -borderwidth 0 -xscrollcommand ".dirsel.f2.sb set" \
- -height 10 -bg white
- scrollbar .dirsel.f2.sb -command ".dirsel.f2.cv xview" -orient horizontal
- pack .dirsel.f2.cv -side top -fill both -expand 1
- pack .dirsel.f2.sb -side top -fill x
-
- .dirsel.f2.cv bind TXT <Any-Button> tk_getDirectory:ClickItem
- .dirsel.f2.cv bind IMG <Any-Button> tk_getDirectory:ClickItem
-
- button .dirsel.f4.open -text $_open \
- -command {set tk_getDirectory(fini) 1}
- button .dirsel.f4.cancel -text $_cancel \
- -command {set tk_getDirectory(fini) -1}
- pack .dirsel.f4.open -side left -padx 25 -pady 4
- pack .dirsel.f4.cancel -side right -padx 25 -pady 4
-
- # Withdraw the window, then update all the geometry information
- # so we know how big it wants to be, then center the window in the
- # display and de-iconify it.
-
- wm withdraw .dirsel
- update
- set p [winfo parent .dirsel]
- regsub -all {\+\-} [wm geometry $p] {-} geom
- scan $geom %dx%d%d%d pw ph px py
- set x [expr {$px + ($pw - 500)/2}]
- set y [expr {$py + ($ph - 250)/2}]
- if {$x<0} {set x 0}
- if {$y<0} {set y 0}
- wm geom .dirsel +$x+$y
- wm deiconify .dirsel
-
- #
- # realwork
- #
- tk_getDirectory:ShowDir $tk_getDirectory(curdir)
-
- #
- # wait user
- #
- tkwait variable tk_getDirectory(fini)
-
- if { $tk_getDirectory(fini) == 1 } {
- set retval [.dirsel.f1.dir cget -text]
- } else {
- set retval ""
- }
-
- destroy .dirsel
- global tk_getDirectory_xref
- catch {unset tk_getDirectory_xref}
-# unset tk_getDirectory
- return $retval
-}
-
-proc tk_getDirectory:ShowDir {curdir} {
- global tcl_platform tk_getDirectory tk_getDirectory_xref
-
- set tk_getDirectory(curdir) $curdir
- .dirsel.f1.dir configure -text $curdir
-
- set hi [image height tk_getDirectory:b_dir]
- set wi [image width tk_getDirectory:b_dir]
- incr wi 4
- update
- set maxy [expr [winfo height .dirsel.f2.cv]-$hi]
-
- set lidir [list]
- foreach file [glob -nocomplain $curdir/*] {
- if [ file isdirectory $file ] {
- lappend lidir [file tail $file]
- }
- }
- set sldir [lsort $lidir]
-
- .dirsel.f2.cv delete all
- set ind 0
- set x 2
- set y 2
- catch {unset tk_getDirectory_xref}
- foreach file $sldir {
- set id [.dirsel.f2.cv create image $x $y \
- -anchor nw -image tk_getDirectory:b_dir -tags IMG]
- set tk_getDirectory_xref($id) $file
- set id [.dirsel.f2.cv create text [expr $x+$wi] $y \
- -anchor nw -text $file -font $tk_getDirectory(myfont) -tags TXT]
- set tk_getDirectory_xref($id) $file
- incr y $hi
- if {$y>=$maxy} {
- set bbox [.dirsel.f2.cv bbox all]
- set x [expr [lindex $bbox 2]+10]
- set y 2
- }
- }
- .dirsel.f2.cv configure -scrollregion [.dirsel.f2.cv bbox all]
-
- set curlst [file split $curdir]
- set nbr [llength $curlst]
-
- .dirsel.f1.dir.m delete 0 last
- incr nbr -2
- for {set ind $nbr} {$ind >= 0} {incr ind -1} {
- set tmplst [ lrange $curlst 0 $ind]
- set tmpdir [ eval file join $tmplst]
- .dirsel.f1.dir.m add command -label $tmpdir \
- -command "tk_getDirectory:ShowDir [list $tmpdir]"
- }
- if {[info exist tk_getDirectory(drives)] == 0} {
- update
- if {[catch {file volume} tk_getDirectory(drives)]} {
- set tk_getDirectory(drives) {}
- }
- }
- if ![string compare $tcl_platform(platform) windows] {
- foreach drive $tk_getDirectory(drives) {
- .dirsel.f1.dir.m add command -label $drive \
- -command "tk_getDirectory:ShowDir [list $drive]"
- }
- }
-
-}
-
-proc tk_getDirectory:UpDir {} {
- set curdir [.dirsel.f1.dir cget -text]
- set curlst [file split $curdir]
- set nbr [llength $curlst]
- if { $nbr < 2 } {
- return
- }
- set tmp [expr $nbr - 2]
- set newlst [ lrange $curlst 0 $tmp ]
- set newdir [ eval file join $newlst ]
- tk_getDirectory:ShowDir $newdir
-}
-
-proc tk_getDirectory:ClickItem {} {
- global tk_getDirectory tk_getDirectory_xref
- set id [.dirsel.f2.cv find withtag current]
- if {[catch {set tk_getDirectory_xref($id)} dir]} {
- if {[catch {.dirsel.f2.cv itemcget $id -text} dir]} {
- return
- }
- }
- if {[string length $dir]==0} return
- tk_getDirectory:ShowDir [file join $tk_getDirectory(curdir) $dir]
-}
-
-#
-# End tk_getDirectory widget
-########################################################################
-
-########################################################################
-#
-# This version of msgbox.tcl has been modified in two ways:
-#
-# 1. Color icons are used on Unix displays that have a color
-# depth of 4 or more. Most users like the color icons better.
-#
-# 2. The button on error dialog boxes says "Bummer" instead of
-# "OK", because errors are not ok.
-#
-# Other than that, the code is identical and should be fully
-# backwards compatible.
-#
-
-image create bitmap tkPriv:b1 -foreground black \
--data "#define b1_width 32\n#define b1_height 32
-static unsigned char q1_bits[] = {
- 0x00, 0xf8, 0x1f, 0x00, 0x00, 0x07, 0xe0, 0x00, 0xc0, 0x00, 0x00, 0x03,
- 0x20, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x08, 0x08, 0x00, 0x00, 0x10,
- 0x04, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x40,
- 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80,
- 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80,
- 0x01, 0x00, 0x00, 0x80, 0x02, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x40,
- 0x04, 0x00, 0x00, 0x20, 0x08, 0x00, 0x00, 0x10, 0x10, 0x00, 0x00, 0x08,
- 0x60, 0x00, 0x00, 0x04, 0x80, 0x03, 0x80, 0x03, 0x00, 0x0c, 0x78, 0x00,
- 0x00, 0x30, 0x04, 0x00, 0x00, 0x40, 0x04, 0x00, 0x00, 0x40, 0x04, 0x00,
- 0x00, 0x80, 0x04, 0x00, 0x00, 0x00, 0x05, 0x00, 0x00, 0x00, 0x06, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};"
-image create bitmap tkPriv:b2 -foreground white \
--data "#define b2_width 32\n#define b2_height 32
-static unsigned char b2_bits[] = {
- 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x1f, 0x00, 0x00, 0xff, 0xff, 0x00,
- 0xc0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x07, 0xf0, 0xff, 0xff, 0x0f,
- 0xf8, 0xff, 0xff, 0x1f, 0xfc, 0xff, 0xff, 0x3f, 0xfc, 0xff, 0xff, 0x3f,
- 0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f,
- 0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f,
- 0xfe, 0xff, 0xff, 0x7f, 0xfc, 0xff, 0xff, 0x3f, 0xfc, 0xff, 0xff, 0x3f,
- 0xf8, 0xff, 0xff, 0x1f, 0xf0, 0xff, 0xff, 0x0f, 0xe0, 0xff, 0xff, 0x07,
- 0x80, 0xff, 0xff, 0x03, 0x00, 0xfc, 0x7f, 0x00, 0x00, 0xf0, 0x07, 0x00,
- 0x00, 0xc0, 0x03, 0x00, 0x00, 0x80, 0x03, 0x00, 0x00, 0x80, 0x03, 0x00,
- 0x00, 0x00, 0x03, 0x00, 0x00, 0x00, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};"
-image create bitmap tkPriv:q -foreground blue \
--data "#define q_width 32\n#define q_height 32
-static unsigned char q_bits[] = {
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x07, 0x00,
- 0x00, 0x10, 0x0f, 0x00, 0x00, 0x18, 0x1e, 0x00, 0x00, 0x38, 0x1e, 0x00,
- 0x00, 0x38, 0x1e, 0x00, 0x00, 0x10, 0x0f, 0x00, 0x00, 0x80, 0x07, 0x00,
- 0x00, 0xc0, 0x01, 0x00, 0x00, 0xc0, 0x00, 0x00, 0x00, 0xc0, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x00, 0x00, 0x00, 0xe0, 0x01, 0x00,
- 0x00, 0xe0, 0x01, 0x00, 0x00, 0xc0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};"
-image create bitmap tkPriv:i -foreground blue \
--data "#define i_width 32\n#define i_height 32
-static unsigned char i_bits[] = {
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0xe0, 0x01, 0x00, 0x00, 0xf0, 0x03, 0x00, 0x00, 0xf0, 0x03, 0x00,
- 0x00, 0xe0, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0xf8, 0x03, 0x00, 0x00, 0xf0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00,
- 0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00,
- 0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00, 0x00, 0xf0, 0x07, 0x00,
- 0x00, 0xf8, 0x0f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};"
-image create bitmap tkPriv:w1 -foreground black \
--data "#define w1_width 32\n#define w1_height 32
-static unsigned char w1_bits[] = {
- 0x00, 0x80, 0x01, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x20, 0x04, 0x00,
- 0x00, 0x10, 0x04, 0x00, 0x00, 0x10, 0x08, 0x00, 0x00, 0x08, 0x08, 0x00,
- 0x00, 0x08, 0x10, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x04, 0x20, 0x00,
- 0x00, 0x02, 0x20, 0x00, 0x00, 0x02, 0x40, 0x00, 0x00, 0x01, 0x40, 0x00,
- 0x00, 0x01, 0x80, 0x00, 0x80, 0x00, 0x80, 0x00, 0x80, 0x00, 0x00, 0x01,
- 0x40, 0x00, 0x00, 0x01, 0x40, 0x00, 0x00, 0x02, 0x20, 0x00, 0x00, 0x02,
- 0x20, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x08,
- 0x08, 0x00, 0x00, 0x08, 0x08, 0x00, 0x00, 0x10, 0x04, 0x00, 0x00, 0x10,
- 0x04, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x20, 0x01, 0x00, 0x00, 0x40,
- 0x01, 0x00, 0x00, 0x40, 0x01, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x20,
- 0xfc, 0xff, 0xff, 0x1f, 0x00, 0x00, 0x00, 0x00};"
-image create bitmap tkPriv:w2 -foreground yellow \
--data "#define w2_width 32\n#define w2_height 32
-static unsigned char w2_bits[] = {
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0xc0, 0x03, 0x00,
- 0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x07, 0x00, 0x00, 0xf0, 0x07, 0x00,
- 0x00, 0xf0, 0x0f, 0x00, 0x00, 0xf8, 0x0f, 0x00, 0x00, 0xf8, 0x1f, 0x00,
- 0x00, 0xfc, 0x1f, 0x00, 0x00, 0xfc, 0x3f, 0x00, 0x00, 0xfe, 0x3f, 0x00,
- 0x00, 0xfe, 0x7f, 0x00, 0x00, 0xff, 0x7f, 0x00, 0x00, 0xff, 0xff, 0x00,
- 0x80, 0xff, 0xff, 0x00, 0x80, 0xff, 0xff, 0x01, 0xc0, 0xff, 0xff, 0x01,
- 0xc0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x07,
- 0xf0, 0xff, 0xff, 0x07, 0xf0, 0xff, 0xff, 0x0f, 0xf8, 0xff, 0xff, 0x0f,
- 0xf8, 0xff, 0xff, 0x1f, 0xfc, 0xff, 0xff, 0x1f, 0xfe, 0xff, 0xff, 0x3f,
- 0xfe, 0xff, 0xff, 0x3f, 0xfe, 0xff, 0xff, 0x3f, 0xfc, 0xff, 0xff, 0x1f,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};"
-image create bitmap tkPriv:w3 -foreground black \
--data "#define w3_width 32\n#define w3_height 32
-static unsigned char w3_bits[] = {
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0xc0, 0x03, 0x00, 0x00, 0xe0, 0x07, 0x00, 0x00, 0xe0, 0x07, 0x00,
- 0x00, 0xe0, 0x07, 0x00, 0x00, 0xe0, 0x07, 0x00, 0x00, 0xe0, 0x07, 0x00,
- 0x00, 0xc0, 0x03, 0x00, 0x00, 0xc0, 0x03, 0x00, 0x00, 0xc0, 0x03, 0x00,
- 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0xc0, 0x03, 0x00,
- 0x00, 0xc0, 0x03, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};"
-
-# tkMessageBox --
-#
-# Pops up a messagebox with an application-supplied message with
-# an icon and a list of buttons. This procedure will be called
-# by tk_messageBox if the platform does not have native
-# messagebox support, or if the particular type of messagebox is
-# not supported natively.
-#
-# This procedure is a private procedure shouldn't be called
-# directly. Call tk_messageBox instead.
-#
-# See the user documentation for details on what tk_messageBox does.
-#
-proc tkMessageBox {args} {
- global tkPriv tcl_platform
-
- set w tkPrivMsgBox
- upvar #0 $w data
-
- #
- # The default value of the title is space (" ") not the empty string
- # because for some window managers, a
- # wm title .foo ""
- # causes the window title to be "foo" instead of the empty string.
- #
- set specs {
- {-default "" "" ""}
- {-icon "" "" "info"}
- {-message "" "" ""}
- {-parent "" "" .}
- {-title "" "" " "}
- {-type "" "" "ok"}
- }
-
- tclParseConfigSpec $w $specs "" $args
-
- if {[lsearch {info warning error question} $data(-icon)] == -1} {
- error "invalid icon \"$data(-icon)\", must be error, info, question or warning"
- }
- if {$tcl_platform(platform) == "macintosh"} {
- if {$data(-icon) == "error"} {
- set data(-icon) "stop"
- } elseif {$data(-icon) == "warning"} {
- set data(-icon) "caution"
- } elseif {$data(-icon) == "info"} {
- set data(-icon) "note"
- }
- }
-
- if {![winfo exists $data(-parent)]} {
- error "bad window path name \"$data(-parent)\""
- }
-
- case $data(-type) {
- abortretryignore {
- set buttons {
- {abort -width 6 -text Abort -under 0}
- {retry -width 6 -text Retry -under 0}
- {ignore -width 6 -text Ignore -under 0}
- }
- }
- ok {
- if {$data(-icon) == "error"} {
- set buttons {
- {ok -width 6 -text Bummer -under 0}
- }
- } else {
- set buttons {
- {ok -width 6 -text OK -under 0}
- }
- }
- if {$data(-default) == ""} {
- set data(-default) "ok"
- }
- }
- okcancel {
- set buttons {
- {ok -width 6 -text OK -under 0}
- {cancel -width 6 -text Cancel -under 0}
- }
- }
- retrycancel {
- set buttons {
- {retry -width 6 -text Retry -under 0}
- {cancel -width 6 -text Cancel -under 0}
- }
- }
- yesno {
- set buttons {
- {yes -width 6 -text Yes -under 0}
- {no -width 6 -text No -under 0}
- }
- }
- yesnocancel {
- set buttons {
- {yes -width 6 -text Yes -under 0}
- {no -width 6 -text No -under 0}
- {cancel -width 6 -text Cancel -under 0}
- }
- }
- default {
- error "invalid message box type \"$data(-type)\", must be abortretryignore, ok, okcancel, retrycancel, yesno or yesnocancel"
- }
- }
-
- if {[string compare $data(-default) ""]} {
- set valid 0
- foreach btn $buttons {
- if {![string compare [lindex $btn 0] $data(-default)]} {
- set valid 1
- break
- }
- }
- if {!$valid} {
- error "invalid default button \"$data(-default)\""
- }
- }
-
- # 2. Set the dialog to be a child window of $parent
- #
- #
- if {[string compare $data(-parent) .]} {
- set w $data(-parent).__tk__messagebox
- } else {
- set w .__tk__messagebox
- }
-
- # 3. Create the top-level window and divide it into top
- # and bottom parts.
-
- catch {destroy $w}
- toplevel $w -class Dialog
- wm title $w $data(-title)
- wm iconname $w Dialog
- wm protocol $w WM_DELETE_WINDOW { }
- wm transient $w $data(-parent)
- if {$tcl_platform(platform) == "macintosh"} {
- unsupported1 style $w dBoxProc
- }
-
- frame $w.bot
- pack $w.bot -side bottom -fill both
- frame $w.top
- pack $w.top -side top -fill both -expand 1
- if {$tcl_platform(platform) != "macintosh"} {
- $w.bot configure -relief raised -bd 1
- $w.top configure -relief raised -bd 1
- }
-
- # 4. Fill the top part with bitmap and message (use the option
- # database for -wraplength so that it can be overridden by
- # the caller).
-
- option add *Dialog.msg.wrapLength 3i widgetDefault
- label $w.msg -justify left -text $data(-message)
- catch {$w.msg configure -font \
- -Adobe-Times-Medium-R-Normal--*-180-*-*-*-*-*-*
- }
- pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
- if {$data(-icon) != ""} {
- if {$tcl_platform(platform)=="macintosh" || [winfo depth $w]<4} {
- label $w.bitmap -bitmap $data(-icon)
- } else {
- canvas $w.bitmap -width 32 -height 32 -highlightthickness 0
- switch $data(-icon) {
- error {
- $w.bitmap create oval 0 0 31 31 -fill red -outline black
- $w.bitmap create line 9 9 23 23 -fill white -width 4
- $w.bitmap create line 9 23 23 9 -fill white -width 4
- }
- info {
- $w.bitmap create image 0 0 -anchor nw -image tkPriv:b1
- $w.bitmap create image 0 0 -anchor nw -image tkPriv:b2
- $w.bitmap create image 0 0 -anchor nw -image tkPriv:i
- }
- question {
- $w.bitmap create image 0 0 -anchor nw -image tkPriv:b1
- $w.bitmap create image 0 0 -anchor nw -image tkPriv:b2
- $w.bitmap create image 0 0 -anchor nw -image tkPriv:q
- }
- default {
- $w.bitmap create image 0 0 -anchor nw -image tkPriv:w1
- $w.bitmap create image 0 0 -anchor nw -image tkPriv:w2
- $w.bitmap create image 0 0 -anchor nw -image tkPriv:w3
- }
- }
- }
- pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m
- }
-
- # 5. Create a row of buttons at the bottom of the dialog.
-
- set i 0
- foreach but $buttons {
- set name [lindex $but 0]
- set opts [lrange $but 1 end]
- if {![string compare $opts {}]} {
- # Capitalize the first letter of $name
- set capName \
- [string toupper \
- [string index $name 0]][string range $name 1 end]
- set opts [list -text $capName]
- }
-
- eval button $w.$name $opts -command [list "set tkPriv(button) $name"]
-
- if {![string compare $name $data(-default)]} {
- catch {$w.$name configure -default active}
- }
- pack $w.$name -in $w.bot -side left -expand 1 \
- -padx 3m -pady 2m
-
- # create the binding for the key accelerator, based on the underline
- #
- set underIdx [$w.$name cget -under]
- if {$underIdx >= 0} {
- set key [string index [$w.$name cget -text] $underIdx]
- bind $w <Alt-[string tolower $key]> "$w.$name invoke"
- bind $w <Alt-[string toupper $key]> "$w.$name invoke"
- }
- incr i
- }
-
- # 6. Create a binding for <Return> on the dialog if there is a
- # default button.
-
- if {[string compare $data(-default) ""]} {
- bind $w <Return> "tkButtonInvoke $w.$data(-default)"
- }
-
- # 7. Withdraw the window, then update all the geometry information
- # so we know how big it wants to be, then center the window in the
- # display and de-iconify it.
-
- wm withdraw $w
- update idletasks
- set p [winfo parent $w]
- regsub -all {\+\-} [wm geometry $p] {-} geom
- scan $geom %dx%d%d%d pw ph px py
- set x [expr {$px + ($pw - [winfo reqwidth $w])/2}]
- set y [expr {$py + ($ph - [winfo reqheight $w])/2}]
- if {$x<0} {set x 0}
- if {$y<0} {set y 0}
- wm geom $w +$x+$y
- wm deiconify $w
-
- # 8. Set a grab and claim the focus too.
-
- set oldFocus [focus]
- set oldGrab [grab current $w]
- if {$oldGrab != ""} {
- set grabStatus [grab status $oldGrab]
- }
- grab $w
- if {[string compare $data(-default) ""]} {
- focus $w.$data(-default)
- } else {
- focus $w
- }
-
- # 9. Wait for the user to respond, then restore the focus and
- # return the index of the selected button. Restore the focus
- # before deleting the window, since otherwise the window manager
- # may take the focus away so we can't redirect it. Finally,
- # restore any grab that was in effect.
-
- tkwait variable tkPriv(button)
- catch {focus $oldFocus}
- destroy $w
- if {$oldGrab != ""} {
- if {$grabStatus == "global"} {
- grab -global $oldGrab
- } else {
- grab $oldGrab
- }
- }
- return $tkPriv(button)
-}
-#
-##################### End Tk_MessageBox ############################
-
-#################### Begin Console Wdiget ##########################
-# A console widget for Tcl/Tk. Invoke OpenConsole with a window name
-# and prompt string to get a new top-level window that allows the
-# user to enter tcl commands. This is mainly useful for testing and
-# debugging.
-#
-# Copyright (C) 1998 D. Richard Hipp
-#
-# This library is free software; you can redistribute it and/or
-# modify it under the terms of the GNU Library General Public
-# License as published by the Free Software Foundation; either
-# version 2 of the License, or (at your option) any later version.
-#
-# This library is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# Library General Public License for more details.
-#
-# You should have received a copy of the GNU Library General Public
-# License along with this library; if not, write to the
-# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-# Boston, MA 02111-1307, USA.
-#
-# Author contact information:
-# drh at acm.org
-# http://www.hwaci.com/drh/
-
-
-proc OpenConsole {w prompt} {
- upvar #0 $w.t v
- if {[winfo exists $w]} {destroy $w}
- catch {unset v}
- toplevel $w
- wm title $w {Test And Debug Console}
- wm iconname $w {Console}
- button $w.quit -text Dismiss -command "destroy $w"
- pack $w.quit -side bottom
- scrollbar $w.sb -orient vertical -command "$w.t yview"
- pack $w.sb -side right -fill y
- text $w.t -font fixed -yscrollcommand "$w.sb set"
- pack $w.t -side right -fill both -expand 1
- bindtags $w.t Console
- set v(text) $w.t
- set v(history) 0
- set v(historycnt) 0
- set v(current) -1
- set v(prompt) $prompt
- set v(plength) [string length $v(prompt)]
- $w.t insert end $v(prompt)
- $w.t mark set insert end
- $w.t tag config ok -foreground blue
- $w.t tag config err -foreground red
- after idle "focus $w.t"
-}
-
-bind Console <1> {focus %W}
-bind Console <KeyPress> {conInsert %W %A}
-bind Console <Left> {conLeft %W}
-bind Console <Control-b> {conLeft %W}
-bind Console <Right> {conRight %W}
-bind Console <Control-f> {conRight %W}
-bind Console <BackSpace> {conBackspace %W}
-bind Console <Control-h> {conBackspace %W}
-bind Console <Delete> {conDelete %W}
-bind Console <Control-d> {conDelete %W}
-bind Console <Home> {conHome %W}
-bind Console <Control-a> {conHome %W}
-bind Console <End> {conEnd %W}
-bind Console <Control-e> {conEnd %W}
-bind Console <Return> {conEnter %W}
-bind Console <KP_Enter> {conEnter %W}
-bind Console <Up> {conPrior %W}
-bind Console <Control-p> {conPrior %W}
-bind Console <Down> {conNext %W}
-bind Console <Control-n> {conNext %W}
-
-# Insert a single character at the insertion cursor
-#
-proc conInsert {w a} {
- $w insert insert $a
-}
-
-# Move the cursor one character to the left
-#
-proc conLeft {w} {
- upvar #0 $w v
- scan [$w index insert] %d.%d row col
- if {$col>$v(plength)} {
- $w mark set insert "insert -1c"
- }
-}
-
-# Erase the character to the left of the cursor
-#
-proc conBackspace {w} {
- upvar #0 $w v
- scan [$w index insert] %d.%d row col
- if {$col>$v(plength)} {
- $w delete {insert -1c}
- }
-}
-
-# Move the cursor one character to the right
-#
-proc conRight {w} {
- $w mark set insert "insert +1c"
-}
-
-# Erase the character to the right of the cursor
-#
-proc conDelete w {
- $w delete insert
-}
-
-# Move the cursor to the beginning of the current line
-#
-proc conHome w {
- upvar #0 $w v
- scan [$w index insert] %d.%d row col
- $w mark set insert $row.$v(plength)
-}
-
-# Move the cursor to the end of the current line
-#
-proc conEnd w {
- $w mark set insert {insert lineend}
-}
-
-# Called when "Enter" is pressed. Do something with the line
-# of text that was entered.
-#
-proc conEnter w {
- upvar #0 $w v
- scan [$w index insert] %d.%d row col
- set start $row.$v(plength)
- set line [$w get $start "$start lineend"]
- if {$v(historycnt)>0} {
- set last [lindex $v(history) [expr $v(historycnt)-1]]
- if {[string compare $last $line]} {
- lappend v(history) $line
- incr v(historycnt)
- }
- } else {
- set v(history) [list $line]
- set v(historycnt) 1
- }
- set v(current) $v(historycnt)
- $w insert end \n
- if {[catch {uplevel #0 $line} res]} {
- $w insert end $res\n err
- } elseif {[string length $res]>0} {
- $w insert end $res\n ok
- }
- $w insert end $v(prompt)
- $w mark set insert end
- $w yview insert
-}
-
-# Change the line to the previous line
-#
-proc conPrior w {
- upvar #0 $w v
- if {$v(current)<=0} return
- incr v(current) -1
- set line [lindex $v(history) $v(current)]
- conSetLine $w $line
-}
-
-# Change the line to the next line
-#
-proc conNext w {
- upvar #0 $w v
- if {$v(current)>=$v(historycnt)} return
- incr v(current) 1
- set line [lindex $v(history) $v(current)]
- conSetLine $w $line
-}
-
-# Change the contents of the entry line
-#
-proc conSetLine {w line} {
- upvar #0 $w v
- scan [$w index insert] %d.%d row col
- set start $row.$v(plength)
- $w delete $start end
- $w insert end $line
- $w mark set insert end
- $w yview insert
-}
-########################### End Console Widget ###########################
-
-# A configuration file can be read either by this program (the
-# xmktclapp GUI) or by the command-line based mktclapp program.
-# But each program reads different parts of the same file.
-#
-# Mktclapp treats each line that begins with '#' as a comment.
-# Xmktclapp reads only those lines that begin with '##'. Hence,
-# each program reads a different part of the same file.
-
-# Write the current configuration out to the file whose name is
-# given as an argument. The current configuration is stored in
-# global variables.
-#
-# If an error occurs (such as we can't open the output file)
-# generate an error.
-#
-proc WriteConfig {filename} {
- if {[catch {open $filename w} f]} {
- error "can't open $filename: $f"
- }
- puts $f "# Configuration file generated by xmktclapp"
- puts $f "# Hand editing is not recommended"
- puts $f "#"
- puts $f "# The \"xmktclapp\" program reads the lines that begin with \"##\"."
- puts $f "# The \"mktclapp\" program reads lines that don't begin with \"#\"."
- puts $f "# Lines beginning with a single \"#\" are comment."
- puts $f "#"
-
- # Write the part that xmktclapp uses
- #
- global conf
- foreach v [lsort [array names conf]] {
- puts $f "## $v [list $conf($v)]"
- }
- puts $f "#"
-
- # Write the part that mktclapp uses
- #
- set isExt 0
- switch $conf(Mode) {
- {Tcl Only} {
- puts $f "-notk"
- }
- Extension {
- if {[info exists conf(OutputFile)] && $conf(OutputFile)!=""} {
- set fnm $conf(OutputFile)
- } else {
- set fnm $filename
- }
- set enm1 [file tail [file rootname $fnm]]
- set enm2 [string toupper [string index $enm1 0]]
- append enm2 [string tolower [string range $enm1 1 end]]
- puts $f "-extension $enm2"
- set isExt 1
- }
- }
- if {!$isExt} {
- if {$conf(Autofork)=="Yes"} {
- puts $f "-autofork"
- }
- if {$conf(CmdLine)=="Console"} {
- puts $f "-console"
- } elseif {$conf(CmdLine)=="Stdin"} {
- puts $f "-read-stdin"
- }
- if {$conf(Standalone)=="Strict"} {
- puts $f "-standalone"
- }
- }
- if {$conf(Shroud)=="Yes"} {
- puts $f "-shroud"
- }
- if {[string length $conf(MainScript)]>0} {
- puts $f "-main-script \"$conf(MainScript)\""
- }
- if {$conf(Standalone)!="No"} {
- set filelist {}
- if {!$isExt} {
- set filelist [glob -nocomplain $conf(TclLib)/*.tcl]
- if {[file exists $conf(TclLib)/tclIndex]} {
- lappend filelist $conf(TclLib)/tclIndex
- }
- # foreach file [glob -nocomplain $conf(TclLib)/*/*.tcl] {
- # lappend filelist $file
- # }
- puts $f "-tcl-library \"$conf(TclLib)\""
- if {$conf(Mode)=="Tcl/Tk"} {
- set l2 [glob -nocomplain $conf(TkLib)/*.tcl]
- set filelist [concat $filelist $l2]
- if {[file exists $conf(TkLib)/tclIndex]} {
- lappend filelist $conf(TkLib)/tclIndex
- }
- puts $f "-tk-library \"$conf(TkLib)\""
- }
- }
- set suffixes {.tcl .tk .itcl .itk .fs .fsc .cs .csc}
- foreach lib [array names conf OtherLib:*] {
- set lib [string range $lib 9 end]
- foreach file [glob -nocomplain $lib/*] {
- if {![file isfile $file]} continue
- if {[lsearch $suffixes [string tolower [file ext $file]]]<0} continue
- lappend filelist $file
- }
- if {[file exists $lib/tclIndex]} {
- lappend filelist $lib/tclIndex
- }
- }
- foreach file [lsort $filelist] {
- puts $f "-strip-tcl \"$file\""
- }
- }
- foreach file [lsort [array names conf CFile:*]] {
- set fn [string range $file 6 end]
- puts $f \"$fn\"
- }
- foreach file [lsort [array names conf Data:*]] {
- set fn [string range $file 5 end]
- puts $f "-i \"$fn\""
- }
- set tclFileList [lsort [array names conf TclFile:*]]
- foreach file $tclFileList {
- set fn [string range $file 8 end]
- if {$conf(TclFile:$fn)} {
- puts $f "-strip-tcl \"$fn\""
- } else {
- puts $f "-dont-strip-tcl \"$fn\""
- }
- }
- close $f
- Baseline
-}
-
-# This routine does the work of the "Save" action.
-#
-proc DoSave {} {
- global conf
- if {[string length $conf(ConfigFile)]==0} {
- return [DoSaveAs]
- }
- set ext [file extension $conf(ConfigFile)]
- if {[string length $ext]==0} {
- set conf(ConfigFile) $conf(ConfigFile).mta
- }
- return [catch {WriteConfig $conf(ConfigFile)}]
-}
-
-# This routine does the work of the "Save As..." action.
-#
-proc DoSaveAs {} {
- global conf initdir
- set types {
- {{Mktclapp Config Files} {.mta}}
- {{All Files} *}
- }
- set f [tk_getSaveFile -filetypes $types -defaultextension .mta \
- -initialdir $initdir]
- if {$f!=""} {
- set initdir [file dirname $f]
- set f [RelativePath $f]
- set conf(ConfigFile) $f
- return [DoSave]
- }
- return 0
-}
-
-# Read state information from a named file. Return the number of
-# errors encountered. If the second parameter is not 0, then issue
-# an error message for each error found.
-#
-proc ReadState {fn {quiet 0}} {
- if {[catch {open $fn r} f]} {
- if {!$quiet} {
- tk_messageBox -message "Can't open \"$fn\": $f" -type ok -icon error
- }
- return 1
- }
- set text [read $f]
- close $f
- SetDefaults
- global conf
- foreach line [split $text \n] {
- if {![regexp {^## } $line]} continue
- if {[lindex $line 0]!="##"} continue
- set var [lindex $line 1]
- set value [lindex $line 2]
- set conf($var) $value
- }
- set conf(ConfigFile) $fn
- if {![info exists conf(OutputFile)] || [string length $conf(OutputFile)]==0} {
- set conf(OutputFile) [file root $conf(ConfigFile)].c
- }
- InsertC
- InsertTcl
- InsertData
- FillOtherLib
- return 0
-}
-
-# This routine does the work of the Open action.
-#
-proc DoOpen {} {
- global conf initdir
- set types {
- {{Mktclapp Config Files} {.mta}}
- {{All Files} *}
- }
- set f [tk_getOpenFile -filetypes $types -defaultextension .mta \
- -initialdir $initdir]
- if {$f==""} return
- set initdir [file dirname $f]
- set f [RelativePath $f]
- set conf(ConfigFile) $f
- ReadState $conf(ConfigFile)
- Baseline
-}
-set initdir [pwd]
-
-# Compare the current configuration with the configuration that
-# we read from disk. Return 1 if we need to save to disk.
-#
-proc IsDirty {} {
- global conf saved
-
- foreach v [array names conf] {
- if {![info exists saved($v)] || [string compare $conf($v) $saved($v)]} {
- return 1
- }
- }
- foreach v [array names saved] {
- if {![info exists conf($v)]} {
- return 1
- }
- }
- return 0
-}
-
-# We currently are not dirty. Remember the current state of
-# everything so we can compare it later to see if anything has
-# changed.
-#
-proc Baseline {} {
- global conf saved
- catch {unset saved}
- foreach v [array names conf] {
- set saved($v) $conf($v)
- }
-}
-
-# Make the current configuration dirty by clearing all the
-# "saved()" variables.
-#
-proc MakeDirty {} {
- catch {unset saved}
-}
-
-# Exit the GUI, after first saving the state
-#
-proc DoExit {} {
- if {[IsDirty]} {
- set r [tk_messageBox -message "Save changes before exiting?" \
- -type yesnocancel]
- if {$r=="cancel"} return
- if {$r=="yes"} {
- if {[DoSave]} return
- }
- }
- exit
-}
-
-# Initialize the application to its default state.
-#
-proc SetDefaults {} {
- global conf tcl_library tk_library
- foreach v [array names conf *File:*] {unset conf($v)}
- foreach v [array names conf OtherLib:*] {unset conf($v)}
- set conf(Mode) Tcl/Tk
- set conf(Autofork) No
- set conf(Standalone) No
- set conf(NoSource) No
- set conf(ConfigFile) appinit.mta
- set conf(Shroud) No
- set conf(MainScript) {}
- set conf(TclLib) $tcl_library
- set conf(TkLib) $tk_library
-}
-
-# Try to convert a full pathname into a relative pathname.
-# But do the convertion only if no ".." are required up front.
-#
-proc RelativePath {full} {
- if {[file pathtype $full]=="absolute"} {
- set pwd [string trimright [pwd] /]
- set len [string length $pwd]
- set path [string range $full 0 $len]
- if {[string compare $path $pwd/]==0} {
- set full [string range $full [expr $len+1] end]
- }
- }
- return $full
-}
-
-# Force a filename to be relative to the current working directory.
-# ".." are inserted if needed.
-#
-proc ForceRelative {name} {
- switch [file pathtype $name] {
- absolute {
- set pwd [file split [pwd]]
- set path [file split $name]
- global tcl_platform
- if {$tcl_platform(platform)=="windows"} {
- set pwd [string tolower $pwd]
- set path [string tolower $path]
- }
- set npwd [llength $pwd]
- set npath [llength $path]
- for {set i 0} {$i<$npwd && $i<$npath} {incr i} {
- if {[string compare [lindex $pwd $i] [lindex $path $i]]} break
- }
- set res {}
- for {set j 0} {$j<$npwd-$i} {incr j} {
- lappend res ..
- }
- set res [concat $res [lrange $path $i end]]
- if {[llength $res]==0} {
- return "."
- }
- return [eval file join $res]
- }
- relative -
- volumerelative {
- return $name
- }
- }
-}
-
-# Force a filename to be absolute.
-#
-proc ForceAbsolute {name} {
- switch [file pathtype $name] {
- relative {
- set path [file split [pwd]/$name]
- set len [llength $path]
- for {set i 1} {$i<$len} {incr i} {
- set dir [lindex $path $i]
- if {$dir=="."} {
- set path [lreplace $path $i $i]
- incr i -1
- incr len -1
- continue
- }
- if {$dir==".."} {
- if {$i==1} {
- set path [lreplace $path $i $i]
- incr i -1
- incr len -1
- } else {
- set path [lreplace $path [expr $i-1] $i]
- incr i -2
- incr len -2
- }
- continue
- }
- }
- return [eval file join $path]
- }
- absolute {
- return $name
- }
- volumerelative {
- return $name
- }
- }
-}
-
-# Change a relative path to absolute and an absolute path to relative.
-#
-proc TogglePath {path} {
- switch [file pathtype $path] {
- absolute {
- return [ForceRelative $path]
- }
- relative {
- return [ForceAbsolute $path]
- }
- volumerelative {
- return $path
- }
- }
-}
-
-# This routine is called to when various "Relative Path" buttons
-# are pressed. $w is the button widget. $var is the name of the
-# variable that contains the pathname that needs to be toggled
-# between relative and absolute.
-#
-proc RelAbsPath {w var} {
- upvar #0 $var path
- set path [TogglePath $path]
- ConfigPathButton $w $path
-}
-
-# This routine works like RelAbsPath above, but for the special
-# case of the Startup Script on the Tcl Scripts page. In addition
-# to toggling the path of the Startup Script (in conf(MainScript))
-# we check to see if the script is in the list of Tcl scripts and
-# toggle its name there too.
-#
-proc MainScriptChngPath {w} {
- global conf
- set old $conf(MainScript)
- RelAbsPath $w conf(MainScript)
- set new $conf(MainScript)
- if {[info exists conf(TclFile:$old)] && [string compare $new $old]} {
- set conf(TclFile:$new) $conf(TclFile:$old)
- unset conf(TclFile:$old)
- InsertTcl
- }
-}
-
-# Given a pathname and a button widget, set the button widget depending
-# on the pathname. As follows:
-#
-# 1. If the pathname is NULL, disable the button.
-#
-# 2. If the pathname is a relative path, make the button read
-# "Absolute Path".
-#
-# 3. If the pathname is absolute, make the button read "Relative Path".
-#
-proc ConfigPathButton {w path} {
- if {[string length $path]==0} {
- $w config -state disabled -text {Rel/Abs Path}
- } else {
- switch [file pathtype $path] {
- relative {
- $w config -state normal -text {Absolute Path}
- }
- absolute {
- $w config -state normal -text {Relative Path}
- }
- volumerelative {
- $w config -state disabled -text {}
- }
- }
- }
-}
-
-# This routine allows ConfigPathButton to be called from a
-# variable trace.
-#
-proc TracePath {w var args} {
- global conf
- ConfigPathButton $w [set $var]
-}
-
-# Insert all the files named in the CFile array into the
-# listbox on the C/C++ modules page
-#
-proc InsertC {{sel {}}} {
- global conf
- set w [Notebook:frame .n {C/C++ Modules}]
- $w.c.lb delete 0 end
- set idx 0
- foreach i [lsort [array names conf CFile:*]] {
- set fn [string range $i 6 end]
- $w.c.lb insert end $fn
- if {[string compare $sel $fn]==0} {
- $w.c.lb select clear 0 end
- $w.c.lb select set $idx
- }
- incr idx
- }
- SetCSelect
-}
-
-# Insert all the files named in the Data array into the
-# listbox on the Data Files page
-#
-proc InsertData {{sel {}}} {
- global conf
- set w [Notebook:frame .n {Data Files}]
- $w.c.lb delete 0 end
- set idx 0
- foreach i [lsort [array names conf Data:*]] {
- set fn [string range $i 5 end]
- $w.c.lb insert end $fn
- if {[string compare $sel $fn]==0} {
- $w.c.lb select clear 0 end
- $w.c.lb select set $idx
- }
- incr idx
- }
- SetDataSelect
-}
-
-# Insert all the files named in the TclFile array into the
-# listbox on the Tcl Scripts page.
-#
-proc InsertTcl {{sel {}}} {
- global conf
- set w [Notebook:frame .n {Tcl Scripts}]
- $w.c.lb delete 0 end
- set idx 0
- foreach i [lsort [array names conf TclFile:*]] {
- set fn [string range $i 8 end]
- if {$conf($i)} {
- set x "* $fn"
- } else {
- set x " $fn"
- }
- $w.c.lb insert end $x
- if {[string compare $sel $fn]==0} {
- $w.c.lb select clear 0 end
- $w.c.lb select set $idx
- }
- incr idx
- }
- SetTclSelect
-}
-
-# This routine runs when the user presses the "Insert" button
-# on the C/C++ Modules page
-#
-proc DoInsertC {} {
- set types {
- {{C/C++ Source} {.c .cpp .cc .C}}
- }
- global initdir
- set f [tk_getOpenFile -filetypes $types \
- -title {Select C/C++ source} -initialdir $initdir]
- if {[string length $f]>0} {
- set initdir [file dirname $f]
- set f [RelativePath $f]
- global conf
- set conf(CFile:$f) 1
- InsertC
- }
-}
-
-# This routine runs when the user presses the "Insert" button
-# on the Data Files page
-#
-proc DoInsertData {} {
- set types {
- {{All files} *}
- }
- global initdir
- set f [tk_getOpenFile -filetypes $types \
- -title {Select Data File} -initialdir $initdir]
- if {[string length $f]>0} {
- set initdir [file dirname $f]
- set f [RelativePath $f]
- global conf
- set conf(Data:$f) 1
- InsertData
- }
-}
-
-# This routine runs when the user presses the "Insert" button
-# on the Tcl Scripts page
-#
-proc DoInsertTcl {} {
- set types {
- {{Tcl Scripts} {.tcl}}
- {{All Files} *}
- }
- global initdir
- set f [tk_getOpenFile -filetypes $types -title {Select Tcl Script} \
- -initialdir $initdir]
- if {[string length $f]>0} {
- set initdir [file dirname $f]
- set f [RelativePath $f]
- global conf
- set conf(TclFile:$f) 1
- InsertTcl
- }
-}
-
-# This routine runs when the user presses the "Browse" button on
-# the Output C File entry box.
-#
-proc BrowseForOutputFile {} {
- set types {
- {{C/C++ Source Files} {.c .C}}
- {{All Files} *}
- }
- global initdir
- set f [tk_getSaveFile -filetypes $types -title {Select Output File} \
- -initialdir $initdir]
- if {[string length $f]>0} {
- set initdir [file dirname $f]
- set f [RelativePath $f]
- global conf
- set conf(OutputFile) $f
- }
-}
-
-# This routine runs when the user presses the "Browse" button on
-# the Tcl Scripts page
-#
-proc BrowseForMainScript {} {
- set types {
- {{Tcl Scripts} {.tcl}}
- {{All Files} *}
- }
- global initdir
- set f [tk_getOpenFile -filetypes $types -title {Select Tcl Script} \
- -initialdir $initdir]
- if {[string length $f]>0} {
- set initdir [file dirname $f]
- set f [RelativePath $f]
- global conf
- set conf(MainScript) $f
- }
-}
-
-# This routine runs when the user presses the "Browse" button beside
-# The Tcl Library entry box. We want to select the directory that
-# contains the Tcl Script library.
-#
-proc BrowseForTclLib {} {
- global conf
- set f [tk_getDirectory -initialdir $conf(TclLib) -title "Tcl Script Library"]
- if {[string length $f]>0} {
- set conf(TclLib) $f
- }
-}
-
-# This routine runs when the user presses the "Browse" button beside
-# The Tk Library entry box. We want to select the directory that
-# contains the Tk Script library.
-#
-proc BrowseForTkLib {} {
- global conf
- set f [tk_getDirectory -initialdir $conf(TkLib) -title "Tk Script Library"]
- if {[string length $f]>0} {
- set conf(TkLib) $f
- }
-}
-
-# After the user clicks in the listbox on the Libraries page,
-# this routine runs to update the screen according to what is
-# selected.
-#
-proc SetOtherLibSelect {} {
- global widget
- set f3 $widget(OtherLib)
- set s [$f3.lb cursel]
- if {[llength $s]>0} {
- $f3.b.del config -state normal
- set fn [$f3.lb get [lindex $s 0]]
- } else {
- $f3.b.del config -state disabled
- set fn {}
- }
- ConfigPathButton $f3.b.rp $fn
-}
-
-# This routine runs when the user presses the "Delete" button on
-# the Libraries page in the "Other Libraries" frame.
-#
-proc DoDeleteOtherLib {} {
- global widget
- set f3 $widget(OtherLib)
- set s [$f3.lb cursel]
- global conf
- foreach i $s {
- set dir [$f3.lb get $i]
- catch {unset conf(OtherLib:$dir)}
- $f3.lb delete $i
- }
- SetOtherLibSelect
-}
-
-# This routine runs when the user presses the "Insert" button beside
-# The Other Library entry box. We want select a directory to add
-# to the list box.
-#
-proc DoInsertOtherLib {} {
- global conf
- set f [tk_getDirectory -title "Script Library"]
- if {[string length $f]>0} {
- set conf(OtherLib:$f) 1
- }
- FillOtherLib $f
-}
-
-# Look at the conf(OtherLib:*) entries and fill the Other Libraries
-# list box accordingly.
-#
-proc FillOtherLib {{sel {}}} {
- global conf widget
- set f3 $widget(OtherLib)
- $f3.lb delete 0 end
- set idx 0
- foreach i [lsort [array names conf OtherLib:*]] {
- set fn [string range $i 9 end]
- $f3.lb insert end $fn
- if {[string compare $sel $fn]==0} {
- $f3.lb select clear 0 end
- $f3.lb select set $idx
- }
- incr idx
- }
- SetOtherLibSelect
-}
-
-# After the user clicks in the listbox on the C/C++ Modules page,
-# this routine runs to update the screen according to what is
-# selected.
-#
-proc SetCSelect {} {
- set w [Notebook:frame .n {C/C++ Modules}]
- set s [$w.c.lb cursel]
- if {[llength $s]>0} {
- $w.b.del config -state normal
- set fn [$w.c.lb get [lindex $s 0]]
- } else {
- $w.b.del config -state disabled
- set fn {}
- }
- ConfigPathButton $w.b.rp $fn
-}
-
-# After the user clicks in the listbox on the Data Files page,
-# This routine runs to update the screen according to what is
-# selected.
-#
-proc SetDataSelect {} {
- set w [Notebook:frame .n {Data Files}]
- set s [$w.c.lb cursel]
- if {[llength $s]>0} {
- $w.b.del config -state normal
- set fn [$w.c.lb get [lindex $s 0]]
- } else {
- $w.b.del config -state disabled
- set fn {}
- }
- ConfigPathButton $w.b.rp $fn
-}
-
-# This routine runs when the user presses the "Delete" button on
-# the C/C++ Modules page.
-#
-proc DoDeleteC {} {
- set w [Notebook:frame .n {C/C++ Modules}]
- set s [$w.c.lb cursel]
- global conf
- foreach i $s {
- set file [$w.c.lb get $i]
- catch {unset conf(CFile:$file)}
- $w.c.lb delete $i
- }
- SetCSelect
-}
-
-# This routine runs when the user presses the "Delete" button on
-# the Data Files page.
-#
-proc DoDeleteData {} {
- set w [Notebook:frame .n {Data Files}]
- set s [$w.c.lb cursel]
- global conf
- foreach i $s {
- set file [$w.c.lb get $i]
- catch {unset conf(Data:$file)}
- $w.c.lb delete $i
- }
- SetDataSelect
-}
-
-# This routine runs when the user presses the "Relative Path" or
-# "Absolute Path" button associated with the list of C/C++ Modules
-#
-proc CChngPath {} {
- set w [Notebook:frame .n {C/C++ Modules}]
- set s [$w.c.lb cursel]
- global conf
- set new {}
- foreach i $s {
- set file [$w.c.lb get $i]
- if {[info exists conf(CFile:$file)]} {
- set new [TogglePath $file]
- if {[string compare $new $file]} {
- set conf(CFile:$new) $conf(CFile:$file)
- unset conf(CFile:$file)
- }
- }
- }
- InsertC $new
-}
-
-# This routine runs when the user presses the "Relative Path" or
-# "Absolute Path" button associated with the list of Data files
-#
-proc DataChngPath {} {
- set w [Notebook:frame .n {Data Files}]
- set s [$w.c.lb cursel]
- global conf
- set new {}
- foreach i $s {
- set file [$w.c.lb get $i]
- if {[info exists conf(Data:$file)]} {
- set new [TogglePath $file]
- if {[string compare $new $file]} {
- set conf(Data:$new) $conf(Data:$file)
- unset conf(Data:$file)
- }
- }
- }
- InsertData $new
-}
-
-# After the user clicks in the listbox on the Tcl Scripts page,
-# this routine runs to update the screen according to what is
-# selected.
-#
-proc SetTclSelect {} {
- set w [Notebook:frame .n {Tcl Scripts}]
- set s [$w.c.lb cursel]
- if {[llength $s]>0} {
- $w.b.del config -state normal
- $w.b.stc config -state normal
- set i [lindex $s 0]
- set f [string range [$w.c.lb get $i] 2 end]
- global conf
- if {$conf(TclFile:$f)} {
- $w.b.stc config -text {Don't Strip Comments} \
- -command "DontStrip [list $f]"
- } else {
- $w.b.stc config -text {Do Strip Comments} \
- -command "DoStrip [list $f]"
- }
- } else {
- $w.b.del config -state disabled
- $w.b.stc config -state disabled
- set f {}
- }
- ConfigPathButton $w.b2.rp $f
-}
-
-# This routine runs when the user clicks on the "Don't Strip Comments"
-# button on the Tcl Scripts page.
-#
-proc DontStrip f {
- global conf
- set conf(TclFile:$f) 0
- InsertTcl $f
-}
-
-# This routine runs when the user clicks on the "Do Strip Comments"
-# button on the Tcl Scripts page.
-#
-proc DoStrip f {
- global conf
- set conf(TclFile:$f) 1
- InsertTcl $f
-}
-
-# This routine runs when the user presses the "Delete" button on
-# the Tcl Scripts page.
-#
-proc DoDeleteTcl {} {
- set w [Notebook:frame .n {Tcl Scripts}]
- set s [$w.c.lb cursel]
- global conf
- foreach i $s {
- set file [string range [$w.c.lb get $i] 2 end]
- catch {unset conf(TclFile:$file)}
- $w.c.lb delete $i
- }
- SetTclSelect
-}
-
-# This routine runs when the user presses the "Relative Path" or
-# "Absolute Path" button associated with the list of Tcl Scripts.
-#
-proc TclChngPath {} {
- set w [Notebook:frame .n {Tcl Scripts}]
- set s [$w.c.lb cursel]
- global conf
- set new {}
- foreach i $s {
- set file [string range [$w.c.lb get $i] 2 end]
- if {[info exists conf(TclFile:$file)]} {
- set new [TogglePath $file]
- if {[string compare $new $file]} {
- set conf(TclFile:$new) $conf(TclFile:$file)
- unset conf(TclFile:$file)
- if {[string compare $file $conf(MainScript)]==0} {
- set conf(MainScript) $new
- }
- }
- }
- }
- InsertTcl $new
-}
-
-# This routine runs when the user presses the "Relative Path" or
-# "Absolute Path" button associated with the list of Other Libraries.
-#
-proc OtherLibChngPath {} {
- global conf widget
- set f3 $widget(OtherLib)
- set s [$f3.lb cursel]
- set new {}
- foreach i $s {
- set dir [$f3.lb get $i]
- if {[info exists conf(OtherLib:$dir)]} {
- set new [TogglePath $dir]
- if {[string compare $new $dir]} {
- set conf(OtherLib:$new) $conf(OtherLib:$dir)
- unset conf(OtherLib:$dir)
- }
- }
- }
- FillOtherLib $new
-}
-
-# Check for dubious information in the configuration parameters.
-# Report an error and return 1 if found. Return 0 if everything
-# looks ok.
-#
-proc CheckData {} {
- global conf
- set tclFileList [array names conf TclFile:*]
- set res 0
- if {[llength $tclFileList]>0 && [string length $conf(MainScript)]==0} {
- set msg "No \"Startup\" Tcl Script Specified"
- set res [tk_messageBox -icon warning -message $msg -type okcancel]
- set res [string compare $res ok]
- }
- if {[string length $conf(MainScript)]>0
- && [lsearch -exact $tclFileList TclFile:$conf(MainScript)]<0} {
- set msg "The \"Startup\" Tcl Script Is Not A Built-In Script!"
- set res [tk_messageBox -icon warning -message $msg -type okcancel]
- set res [string compare $res ok]
- }
- return $res
-}
-
-# This routine runs when the "Build" button is pressed on the
-# Settings page.
-#
-proc DoBuild {} {
- if {[CheckData]} return
- DoSave
- set nerr 0
- global conf
- if {![info exists conf(OutputFile)] || [string length $conf(OutputFile)]==0} {
- set conf(OutputFile) [file root $conf(ConfigFile)].c
- }
- set h [file root $conf(OutputFile)].h
- if {[catch {exec mktclapp -header >$h} msg]} {
- tk_messageBox -message "Error in command: $msg" \
- -type ok -icon error -title {Error In Build}
- incr nerr
- }
- if {[catch {exec mktclapp -f $conf(ConfigFile) >$conf(OutputFile)} msg]} {
- tk_messageBox -message "Error in command: $msg" \
- -type ok -icon error -title {Error In Build}
- incr nerr
- }
- if {$nerr==0} {
- set msg "Built \"$conf(OutputFile)\" and \"$h\" with "
- append msg "no errors."
- tk_messageBox -message $msg -type ok -icon info -title {Build Complete}
- }
-}
-
-# This routine pops up a help dialog. The help topic is the
-# argument.
-#
-proc DoHelp subject {
- global Help
- if {[winfo exists .help]} {
- destroy .help
- }
- toplevel .help
- wm title .help {Help}
- wm iconname .help {Help}
- button .help.dismiss -text Dismiss -command {catch {destroy .help}}
- pack .help.dismiss -side bottom
- text .help.t -yscrollcommand ".help.sb set" -wrap word -width 60
- pack .help.t -side left -fill both -expand 1
- scrollbar .help.sb -orient vertical -command ".help.t yview"
- pack .help.sb -side right -fill y
- .help.t tag config heading -justify center \
- -font -adobe-helvetica-bold-r-normal-*-18-180-75-75-p-103-iso8859-1
- .help.t tag config bold -font \
- -adobe-helvetica-bold-r-normal-*-14-140-75-75-p-82-iso8859-1
- .help.t tag config normal -justify left \
- -font -adobe-helvetica-medium-r-normal-*-14-140-75-75-p-77-iso8859-1
- if {![info exists Help($subject)]} {
- set msg $Help(unknown)
- } else {
- set msg $Help($subject)
- }
- .help.t delete 1.0 end
- set cnt 0
- set linestart 0
- set ll [llength $msg]
- for {set i 0} {$i<$ll} {incr i} {
- set cmd [lindex $msg $i]
- switch $cmd {
- heading -
- text -
- bold {
- incr i
- set txt [lindex $msg $i]
- regsub -all "\n *" $txt { } txt
- }
- }
- switch $cmd {
- heading {
- if {$cnt>0} {.help.t insert end \n\n heading}
- .help.t insert end $txt\n\n heading
- set linestart 1
- }
- text {
- if {!$linestart} {.help.t insert end " " normal}
- .help.t insert end $txt normal
- set linestart 0
- }
- bold {
- if {!$linestart} {.help.t insert end " " normal}
- .help.t insert end $txt bold
- set linestart 0
- }
- paragraph {
- .help.t insert end "\n\n" normal
- set linestart 1
- }
- }
- incr cnt
- }
- .help.t config -state disabled
-}
-
-# The help screens
-#
-set Help(About) {
- heading {About XMktclapp}
- text {This is xmktclapp.tcl version 3.9, released on January 30, 2000.
- XMktclapp itself and the associated mktclapp program are both
- covered by the GNU Public License. The code that
- xmktclapp generates is in the public domain.}
- paragraph
- text {Report bugs to drh at acm.org.}
- paragraph
- text {If you find this program useful, a note to the
- author would be appreciated. drh at acm.org.}
-}
-
-set Help(What) {
- heading {Introduction}
- text {This program, and a related program "mktclapp", are used to help
- convert a collection of Tcl/Tk and C/C++ source files into
- a single stand-alone executable that will run on machines that
- do not have Tcl/Tk installed.}
- paragraph
- text {Fill in the information on the various notebook pages, then
- choose the File/Build menu option. That will generate a
- C source code file and an associated header file
- that contain all of your Tcl/Tk code
- embedded in static strings. The generated C code will also
- contain routines to initialize the Tcl/Tk interpreter.}
- paragraph
- text {Most entry boxes and menus have a help button nearby. Press
- these help buttons for additional information about the particular
- entry box or menu.}
-}
-
-set Help(unknown) {
- heading {Unknown Topic}
- text {No help is available at this time for the topic you
- have specified. Sorry...}
-}
-
-set Help(Mode) {
- heading {Application Mode}
- text {The "mktclapp" application generator can produce code that uses
- only Tcl (no GUI) or that uses both Tcl and Tk (with a GUI).
- A third option, called "Extension", will cause mktclapp to
- output code for a Tcl extension library or DLL rather than a
- a complete application.}
- paragraph
- text {The "Tcl Only" option is only useful for Unix.
- Under Windows, use only "Tcl/Tk" or "Extension".}
- paragraph
- text {If the "Extension" option is chosen, the name of the extension
- will be derived from the name of the Output C File.}
-}
-
-set Help(Autofork) {
- heading {Fork Into Background?}
- text {If you select "Yes" for the "Fork Into Background" option
- then the generated application will automatically
- run in the background, disconnected from its controlling terminal.
- This is often a useful feature for GUIs.}
- paragraph
- text {Only set the option to "Yes" under Unix. Under MS-Windows always
- set this option to "No". The Window C compiler will make the
- necessary arrangements to fork Windows GUIs
- into the background.}
- paragraph
- text {It is hard to use a debugger on an application running in the
- background, so while debugging it is best to leave this option
- turned off. You can always turn it on before a "real" build if
- it is the behavior that you want.}
-}
-
-set Help(Standalone) {
- heading {Standalone}
- text {If Standalone is "Yes",
- then the generated code will run on binary-compatible
- machines that do not have Tcl/Tk installed. If you choose "No",
- then Tcl/Tk must be installed on the machine for your application
- to work properly.}
- paragraph
- text {Setting Standalone to "Strict" is like setting it to "Yes" but
- with the following addition: When Standalone is "Strict" the
- "source" command of Tcl is modified so that it can only see
- files that have been compiled into your binary. In other words,
- when Standalone is "Strict", only files listed on the "Tcl Scripts"
- page and in the Tcl/Tk library directories can be sourced. The
- strict standalone mode helps detect the common bug of omitting
- one or more Tcl scripts from the "Tcl Scripts" page.}
- paragraph
- text {In order to be truely standalone, you must also link your application
- against the static Tcl/Tk libraries, not the dynamic or shared
- libraries. How you do this depends on your compiler. Typically,
- you give the compiler an option like "-static" or "-Bstatic". Or
- you can specify the static Tcl/Tk library files on the compiler
- command line, like this: "/usr/lib/libtcl8.0.a", instead of using
- the compiler's -l option like this: "-ltcl8.0".}
-}
-
-set Help(ConfigFile) {
- heading {Configuration File}
- text {This entry contains the name of a file that holds the
- configuration information used by both mktclapp and xmktclapp.
- By convention, this file has a ".mta" suffix.}
- paragraph
- text {XMktclapp reads in the first configuration
- file it finds in when it is first invoked. You can read a
- different configuration file using the "Open" button.
- To save the current configuration file to a different filename,
- use the "Save As" button.}
-}
-
-set Help(OutputFile) {
- heading {Output C File}
- text {This entry contains the name of the file into which C code
- is written when you press the
- "Build" button or choose the File/Build menu option. If you
- run mktclapp manually, the generated C code appears on
- standard output.}
- paragraph
- text {Pressing the "Build" button also generates a header file.
- The name of the header file is the same as the name of the C
- file except that the suffix is changed to ".h".}
-}
-
-set Help(TclLib) {
- heading {Tcl Library}
- text {The Tcl Library is a directory on your computer that contains
- a bunch of Tcl scripts and an index (named "tclIndex") that are
- needed for many applications. In a stand-alone executable,
- these scripts must be compiled into the executable because they
- might not exist on the target machine.}
- paragraph
- text {The mktclapp program will automatically add the Tcl Library
- scripts to your executable if you select Standalone mode on
- the Settings page. But you have to tell mktclapp where to go
- to look for the Tcl scripts. Enter the name of the directory
- that contains the Tcl scripts you want to use here.}
- paragraph
- text {If you have more than one version of Tcl/Tk installed on your
- machine, there will be more than one Tcl Library directory.
- Make sure you chose a Tcl Library that is compatible with the
- Tcl C Library.}
-}
-
-set Help(TkLib) {
- heading {Tk Library}
- text {The Tk Library is a directory on your computer that contains
- a bunch of Tcl scripts and an index (named "tclIndex") that are
- needed for many applications. In a stand-alone executable,
- these scripts must be compiled into the executable because they
- might not exist on the target machine.}
- paragraph
- text {The mktclapp program will automatically add the Tk Library
- scripts to your executable if you select Standalone mode on
- the Settings page. But you have to tell mktclapp where to go
- to look for the Tcl scripts by entering a directory name here.}
- paragraph
- text {If you have more than one version of Tcl/Tk installed on your
- machine, there will be more than one Tk Library directory.
- Make sure you chose a Tk Library that is compatible with the
- Tk C Library that you are linking against.}
-}
-
-set Help(OtherLib) {
- heading {Other Script Libraries}
- text {Put in this listbox the names of directories that contain
- script libraries other than the standard Tcl and Tk script
- libraries. Every file in the named directories that ends with
- ".tcl" or whose name is "tclIndex" will be compiled into your
- executable when you build with Standalone set to "Yes" or
- "Strict".}
- paragraph
- text {This listbox is designed to load the script libraries associated
- with Tcl extensions, like Tix, [incr tcl], or TclX.}
-}
-
-set Help(C/C++) {
- heading {C and C++ Source Files}
- text {This page lists all the C and C++ source files that will be
- used by your application. (Except, the C source file generated
- by this program should not be listed!)}
- paragraph
- text {The mktclapp application generator scans all of the C source files
- you list looking for function definitions with a name of the form
- "ET_COMMAND_aaaaa(ET_TCLARGS)". For each such function definition
- found, mktclapp will create a new Tcl command named "aaaaa" that
- is implemented by the C function.}
- paragraph
- text {Mktclapp also extracts some other information it needs by scanning
- source files, so it is important to list all the source files for
- your application here, even if they contain no new Tcl command
- implementations.}
-}
-
-set Help(DataFiles) {
- heading {Data Files}
- text {This page is intended as a place to put the names of image
- files, GIFs, and bitmaps. But any kind of binary data file
- can be named here. Each file named on this page will be
- compiled into the application as a static array of bytes.}
- paragraph
- text {Tcl/Tk scripts can be named on this page and then run from the
- main script using the "source" command. But scripts entered
- on this page are neither shrouded nor compressed.}
- paragraph
- text {Data files named on this page will not be accessible if you
- compile with a version of Tcl before 8.0.3}
-}
-
-set Help(Tcl) {
- heading {Tcl Scripts}
- text {This page lists Tcl Scripts that will be converted into C strings
- and compiled into your application. You can invoke any of these
- scripts by executing the Tcl command}
- bold {source FILENAME}
- text {where "FILENAME" is replaced by the exact same text that appears
- in the window. Note that the FILENAME on the source command must
- be character-by-character identical to the name that appears on
- this page, or the source command will not work}
- paragraph
- text {Only your own Tcl Scripts should be listed here. The Tcl/Tk Library
- Tcl Scripts are loaded automatically when you select the Standalone
- option on the Settings page. See the help on the Standalone option,
- and the help on the Libraries page for more information.}
- paragraph
- text {To save space, mktclapp can attempt to strip comments and
- excess whitespace from your Tcl
- scripts before compiling them into your application. But on some
- rare occasions, a Tcl script will not work correctly if its comments
- are removed. On this page, an asterisk appears to the left of
- every Tcl Script which will have its comments removed. Use the
- "Don't Strip Comments"
- button to turn this feature off if you need to.}
-}
-
-set Help(Shroud) {
- heading {Shroud Tcl Scripts}
- text {Normally, the Tcl Scripts that are compiled into your executable
- can be easily extracted and read using the "strings" command of
- Unix. But if you select the Shroud options, the compiled-in Tcl
- Scripts are encoded in a way that makes them much more difficult
- to read. Some users may wish to invoke this option in order to
- "protect" their proprietary code from prying eyes.}
- paragraph
- text {Note that shrouding only makes the code more difficult to read.
- It is not impossible. A clever hacker can
- still access your code. But the same is true of C code, which
- can be de-compiled using commercially available tools. No
- method of code concealment is perfect.}
- paragraph
- text {Recent trends are for source code to be accessible and readable
- by the end user. We encouraged you to continue this trend by
- leaving the Shroud option turned off.}
-}
-
-set Help(CmdLine) {
- heading {Interactively Reading Tcl Commands}
- text {If you want to be able to type commands to Tcl interactively,
- set this option to either Stdin or Console. In Stdin mode,
- Tcl commands are read from the command-line. In Console mode,
- a separate console window is started.}
- paragraph
- text {This option is useful for testing and debugging during
- program development.}
- paragraph
- text {Console mode only works if you run Tk. It automatically reverts
- to Stdin mode if you build a Tcl-only application. Stdin mode
- does not work with Tk under Windows. If you select Stdin with
- Tk on Windows, it automatically changes to Console mode.}
-}
-
-set Help(MainScript) {
- heading {Startup Script}
- text {A Startup Script is a single Tcl script that is run as soon
- as the interpreter has been initialized. This is the script
- the draws the main screen of an application, or does other
- one-time setup to get the program going.}
- paragraph
- text {If the Startup entry box is blank, no startup script will be run.
- If a Startup script is specified, but cannot be located, or if
- the Startup script contains an error, no error message is reported
- back to the user.}
- paragraph
- text {The Startup script is not automatically compiled into the
- executable. If you need the Startup script to be compiled into
- the executable (as most applications do) then you must include
- the script in the list of Tcl Scripts to be compiled in, in addition
- to putting it in the Startup entry box.}
-}
-
-SetDefaults
-frame .mb -bd 2 -relief raised
-pack .mb -side top -fill x
-menubutton .mb.file -text File -menu .mb.file.m
-pack .mb.file -side left -padx 5
-set m [menu .mb.file.m]
-$m add command -label "Open..." -underline 0 -command DoOpen
-$m add command -label "Save" -underline 0 -command DoSave
-$m add command -label "Save As..." -underline 5 -command DoSaveAs
-$m add command -label "Build" -underline 0 -command DoBuild
-$m add separator
-$m add command -label Exit -underline 1 -command DoExit
-
-menubutton .mb.help -text Help -menu .mb.help.m
-pack .mb.help -side left -padx 5
-set m [menu .mb.help.m]
-$m add command -label "About This Program..." -underline 0 \
- -command "DoHelp About"
-$m add command -label "Introduction..." -underline 0 -command "DoHelp What"
-
-set NotebookPages {Settings Libraries {C/C++ Modules} {Tcl Scripts} \
- {Data Files}}
-Notebook:create .n -pad 10 -pages $NotebookPages
-pack .n -fill both -expand 1
-set w [Notebook:frame .n Settings]
-
-proc Page1Option {w text var choices help} {
- frame $w
- pack $w -side top -fill x -pady 3
- label $w.l -text $text -anchor e -width 28
- eval tk_optionMenu $w.e conf($var) $choices
- $w.e config -width 8
- button $w.h -text Help -command "DoHelp $help"
- pack $w.l $w.e -side left
- pack $w.h -side left -fill y
-}
-
-frame $w.spacer -height 5
-pack $w.spacer -side top
-Page1Option $w.f1 {Application Mode} Mode {{Extension} {Tcl Only} {Tcl/Tk}} Mode
-Page1Option $w.f2 {Fork Into Background?} Autofork {Yes No} Autofork
-Page1Option $w.f3 {Command Line Input?} CmdLine {Console Stdin None} CmdLine
-Page1Option $w.f4 {Standalone?} Standalone {Strict Yes No} Standalone
-Page1Option $w.f5 {Shroud Tcl Scripts?} Shroud {Yes No} Shroud
-set f [LabelFrame:create $w.f7 -text "Configuration File" -ipadx 10 -ipady 7 -bd 4]
-pack $w.f7 -side top -fill x
-entry $f.e -bd 2 -relief sunken -bg white -fg black \
- -textvariable conf(ConfigFile) -width 30 -font fixed
-pack $f.e -side top -fill x
-button $f.open -text Open -command DoOpen
-button $f.save -text Save -command DoSave
-button $f.saveas -text {Save As} -command DoSaveAs
-button $f.help -text Help -command "DoHelp ConfigFile"
-pack $f.help $f.saveas $f.save $f.open -side right -pady 5
-set f [LabelFrame:create $w.f8 -text "Output C File" -ipadx 10 -ipady 7 -bd 4]
-pack $w.f8 -side top -fill x
-entry $f.e -bd 2 -relief sunken -bg white -fg black \
- -textvariable conf(OutputFile) -width 30 -font fixed
-pack $f.e -side top -fill x
-button $f.br -text Browse -command BrowseForOutputFile
-button $f.rp -text {Relative Path} -command "RelAbsPath $f.rp conf(OutputFile)"
-trace variable conf(OutputFile) w "TracePath $f.rp conf(OutputFile)"
-button $f.bld -text {Build} -command DoBuild
-button $f.help -text Help -command "DoHelp OutputFile"
-pack $f.help $f.bld $f.rp $f.br -side right -pady 5
-
-# An Easter Egg: Clicking on the Help button within the Output C File
-# box while holding down both Control and Shift causes a debugging console
-# to come up. The debugging console can be used to type Tcl commands
-# directly into a running instance of this program. Very useful on
-# Windows, since TkCon doesn't work there.
-#
-bind $f.help <Control-Shift-1> {
- OpenConsole .con {Debug> }
- break
-}
-
-# This routine runs whenever the value of conf(Mode) changes.
-#
-proc ModeChanged {args} {
- global conf
- set w [Notebook:frame .n Settings]
- switch $conf(Mode) {
- {Tcl Only} -
- {Tcl/Tk} {
- foreach v {Autofork CmdLine Standalone} {
- if {[info exists conf(saved-$v)]} {
- set conf($v) $conf(saved-$v)
- }
- }
- foreach f {f2 f3 f4} {
- $w.$f.e config -state normal
- $w.$f.l config -fg [$w.$f.e cget -foreground]
- }
- }
- {Extension} {
- foreach v {Autofork CmdLine Standalone} {
- set conf(saved-$v) $conf($v)
- }
- set conf(saved-Autofork) $conf(Autofork)
- set conf(saved-CmdLine) $conf(CmdLine)
- set conf(saved-Standalone) $conf(Standalone)
- set conf(Autofork) No
- set conf(CmdLine) None
- set conf(Standalone) Yes
- foreach f {f2 f3 f4} {
- $w.$f.e config -state disabled
- $w.$f.l config -fg [$w.$f.e cget -disabledforeground]
- }
- }
- }
-}
-trace variable conf(Mode) w ModeChanged
-
-set w [Notebook:frame .n {C/C++ Modules}]
-frame $w.c
-frame $w.b
-pack $w.c -side top -fill both -expand 1 -pady 10 -padx 10
-pack $w.b -side top -pady 10
-button $w.b.ins -text Insert -command DoInsertC
-button $w.b.del -text Delete -command DoDeleteC -state disabled
-button $w.b.rp -text {Relative Path} -width 12 -command CChngPath
-button $w.b.help -text Help -command "DoHelp C/C++"
-pack $w.b.ins $w.b.del $w.b.rp $w.b.help -expand 1 -side left
-listbox $w.c.lb -yscrollcommand "$w.c.sb set" -bg white -exportselection 0 \
- -width 50 -font fixed -fg black
-bind $w.c.lb <1> {after idle SetCSelect}
-pack $w.c.lb -side left -fill both -expand 1
-scrollbar $w.c.sb -orient vertical -command "$w.c.lb yview"
-pack $w.c.sb -side right -fill y
-InsertC
-
-set w [Notebook:frame .n {Tcl Scripts}]
-frame $w.c
-set f1 [LabelFrame:create $w.m -text "Startup Script" -ipadx 10 -ipady 10 -bd 4]
-frame $w.b
-frame $w.b2
-frame $w.sp -height 8
-frame $w.bar -height 4 -relief sunken -bd 2
-pack $w.sp -side top -pady 1
-pack $w.c -side top -pady 1 -fill both -expand 1 -padx 10
-pack $w.b $w.b2 -side top -pady 1
-pack $w.bar -side top -fill x -pady 5
-pack $w.m -side top -pady 15 -fill x -padx 10
-button $w.b.ins -text Insert -command DoInsertTcl
-button $w.b.del -text Delete -command DoDeleteTcl -state disabled
-button $w.b.stc -text {Do Strip Comments} -width 20 -state disabled
-button $w.b2.rp -text {Relative Path} -width 12 -state disabled \
- -command TclChngPath
-button $w.b2.help -text Help -command "DoHelp Tcl"
-pack $w.b.ins $w.b.del $w.b.stc -side left -expand 1
-pack $w.b2.rp $w.b2.help -side left
-entry $f1.e -bd 2 -bg white -relief sunken -textvariable conf(MainScript) \
- -width 50 -font fixed -fg black
-pack $f1.e -side top -fill x
-button $f1.s -text {Browse} -command BrowseForMainScript
-button $f1.rp -text {Relative Path} -width 12 \
- -command "MainScriptChngPath $f1.rp"
-trace variable conf(MainScript) w "TracePath $f1.rp conf(MainScript)"
-button $f1.h -text {Help} -command "DoHelp MainScript"
-pack $f1.h $f1.rp $f1.s -side right
-listbox $w.c.lb -yscrollcommand "$w.c.sb set" -bg white -exportselection 0 \
- -width 30 -font [$f1.e cget -font] -fg black -height 3
-bind $w.c.lb <1> {after idle SetTclSelect}
-pack $w.c.lb -side left -fill both -expand 1
-scrollbar $w.c.sb -orient vertical -command "$w.c.lb yview"
-pack $w.c.sb -side right -fill y
-InsertTcl
-
-set w [Notebook:frame .n Libraries]
-set f1 [LabelFrame:create $w.f1 -text "Tcl Script Library" \
- -ipadx 10 -ipady 2 -bd 4]
-entry $f1.e -bd 2 -relief sunken -bg white -textvariable conf(TclLib) \
- -width 40 -font fixed -fg black
-pack $f1.e -side top -pady 5 -fill x
-button $f1.b -text Browse -command BrowseForTclLib
-button $f1.rp -text {Relative Path} -width 12 \
- -command "RelAbsPath $f1.rp conf(TclLib)"
-trace variable conf(TclLib) w "TracePath $f1.rp conf(TclLib)"
-button $f1.g -text Guess -command {
- catch {set conf(TclLib) $tcl_library}
-}
-button $f1.h -text Help -command "DoHelp TclLib"
-pack $f1.h $f1.g $f1.rp $f1.b -side right
-pack $w.f1 -side top -padx 10 -pady 5 -fill x
-set f2 [LabelFrame:create $w.f2 -text "Tk Script Library" \
- -ipadx 10 -ipady 2 -bd 4]
-entry $f2.e -bd 2 -relief sunken -bg white -textvariable conf(TkLib) \
- -width 40 -font fixed -fg black
-pack $f2.e -side top -pady 5 -fill x
-button $f2.b -text Browse -command BrowseForTkLib
-button $f2.rp -text {Relative Path} -width 12 \
- -command "RelAbsPath $f2.rp conf(TkLib)"
-trace variable conf(TkLib) w "TracePath $f2.rp conf(TkLib)"
-button $f2.g -text Guess -command {
- catch {set conf(TkLib) $tk_library}
-}
-button $f2.h -text Help -command "DoHelp TkLib"
-pack $f2.h $f2.g $f2.rp $f2.b -side right
-pack $w.f2 -side top -padx 10 -pady 5 -fill x
-set f3 [LabelFrame:create $w.f3 -text "Other Script Libraries" \
- -ipadx 10 -ipady 2 -bd 4]
-set widget(OtherLib) $f3
-frame $f3.b
-listbox $f3.lb -font [$f2.e cget -font] -yscrollcommand "$f3.sb set" \
- -height 3 -bg white -fg black -exportselection 0
-bind $f3.lb <1> {after idle SetOtherLibSelect}
-scrollbar $f3.sb -orient vertical -command "$f3.lb yview"
-pack $f3.b -side bottom -fill x
-pack $f3.lb -side left -fill both -expand 1 -pady 5
-pack $f3.sb -side left -fill y -pady 5
-button $f3.b.help -text Help -command "DoHelp OtherLib"
-button $f3.b.rp -text {Relative Path} -width 12 -command OtherLibChngPath
-button $f3.b.ins -text {Insert} -command DoInsertOtherLib
-button $f3.b.del -text {Delete} -command DoDeleteOtherLib
-pack $f3.b.help $f3.b.rp $f3.b.del $f3.b.ins -side right
-pack $w.f3 -side top -padx 10 -pady 5 -fill both -expand 1
-SetOtherLibSelect
-
-set w [Notebook:frame .n Makefile]
-if {$w!=""} {
- set f [LabelFrame:create $w.f1 -text "C Compiler and Options" \
- -ipadx 10 -ipady 2 -bd 4]
- entry $f.e -bd 2 -relief sunken -bg white -textvariable conf(CC) \
- -width 60 -font fixed -fg black
- button $f.h -text Help -command "DoHelp CC"
- pack $f.h -side right
- pack $f.e -side top -pady 5 -fill x
- pack $w.f1 -side top -padx 10 -pady 5 -fill x
- set f [LabelFrame:create $w.f2 -text "Linker and Options" \
- -ipadx 10 -ipady 2 -bd 4]
- entry $f.e -bd 2 -relief sunken -bg white -textvariable conf(Linker) \
- -width 60 -font fixed -fg black
- button $f.h -text Help -command "DoHelp Linker"
- pack $f.h -side right
- pack $f.e -side top -pady 5 -fill x
- pack $w.f2 -side top -padx 10 -pady 5 -fill x
- set f [LabelFrame:create $w.f3 -text "Linker Arguments" \
- -ipadx 10 -ipady 2 -bd 4]
- entry $f.e -bd 2 -relief sunken -bg white -textvariable conf(LinkArg) \
- -width 60 -font fixed -fg black
- button $f.h -text Help -command "DoHelp LinkArg"
- pack $f.h -side right
- pack $f.e -side top -pady 5 -fill x
- pack $w.f3 -side top -padx 10 -pady 5 -fill x
-}
-
-set w [Notebook:frame .n {Data Files}]
-if {$w!=""} {
- frame $w.c
- frame $w.b
- pack $w.c -side top -fill both -expand 1 -pady 10 -padx 10
- pack $w.b -side top -pady 10
- button $w.b.ins -text Insert -command DoInsertData
- button $w.b.del -text Delete -command DoDeleteData -state disabled
- button $w.b.rp -text {Relative Path} -width 12 -command DataChngPath
- button $w.b.help -text Help -command "DoHelp DataFiles"
- pack $w.b.ins $w.b.del $w.b.rp $w.b.help -expand 1 -side left
- listbox $w.c.lb -yscrollcommand "$w.c.sb set" -bg white -exportselection 0 \
- -width 50 -font fixed -fg black
- bind $w.c.lb <1> {after idle SetDataSelect}
- pack $w.c.lb -side left -fill both -expand 1
- scrollbar $w.c.sb -orient vertical -command "$w.c.lb yview"
- pack $w.c.sb -side right -fill y
- InsertData
-}
-
-wm withdraw .
-update idletasks
-set W 420
-set H 200
-foreach f $NotebookPages {
- set w [Notebook:frame .n $f]
- if {[winfo reqwidth $w]>$W} {
- set W [winfo reqwidth $w]
- }
- if {[winfo reqheight $w]>$H} {
- set H [winfo reqheight $w]
- }
-}
-Notebook:config .n -width $W -height $H
-wm deiconify .
-wm protocol . WM_DELETE_WINDOW DoExit
-wm protocol . WM_SAVE_YOURSELF DoSave
-set filelist [glob -nocomplain *.mta]
-if {[llength $filelist]==0} {
- InsertC
- InsertTcl
-} else {
- set conf(ConfigFile) [lindex $argv 0]
- if {[string length $conf(ConfigFile)]==0 || [ReadState $conf(ConfigFile) 1]} {
- set conf(ConfigFile) [lindex [lsort $filelist] 0]
- ReadState $conf(ConfigFile) 1
- }
- Baseline
-}
--
General FITS file browser/editor/plotter with a gui
More information about the debian-science-commits
mailing list