Tcl Source Code

2015-09-29 (bug)[219866] Cygwin support error (yorick,nijtmans)
=> platform 1.0.14

2015-10-06 (bug)[b42a85] Win: [file normalize ~user] wrong dir (nadkarni)

2015-10-21 (bug)[818a1a][a3c350][d7ea9f][8f2450][1080042] Many fixes and
improvements to regexp engine from Postgres (lane,porter,fellows,seltenreich)

2015-11-10 (bug)[261a8a] Overflow segfault in I/O translation (brooks,porter)

2015-11-20 (bug)[3293874] let lists grow all the way to the limit (porter)

2015-11-20 (bug)[40f628] ListObjReplace callers fail to detect max (porter)

--- Released 8.5.19, December 1, 2015 --- http://core.tcl.tk/tcl/ for details

\fBmcflmset\fR, setting the necessary translation strings
for the language, likely enclosed in a \fBnamespace eval\fR
so that all source strings are tied to the namespace of
the package. For example, a short \fBes.msg\fR might contain:
.PP
.CS
namespace eval ::mypackage {
    \fB::msgcat::mcflset\fR "Free Beer" "Cerveza Gratis"
}
.CE
.SH "RECOMMENDED MESSAGE SETUP FOR PACKAGES"
.PP
If a package is installed into a subdirectory of the
\fBtcl_pkgPath\fR and loaded via \fBpackage require\fR, the
following procedure is recommended.

# tcl.decls --
#
#	This file contains the declarations for all supported public
#	functions that are exported by the Tcl library via the stubs table.
#	This file is used to generate the tclDecls.h, tclPlatDecls.h
#	and tclStubInit.c files.
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
# Copyright (c) 2007 Daniel A. Steffen <[email protected]>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

    if ((objc == 4) && (index == len)) {
	/*
	 * Special case: insert one element at the end of the list.
	 */

	Tcl_ListObjAppendElement(NULL, listPtr, objv[3]);
    } else {
	if (TCL_OK != Tcl_ListObjReplace(interp, listPtr, index, 0,
		(objc-3), &(objv[3]))) {
	    return TCL_ERROR;
	}
    }

    /*
     * Set the interpreter's object result.
     */

    Tcl_SetObjResult(interp, listPtr);

     * Note that we call Tcl_ListObjReplace even when numToDelete == 0 and
     * objc == 4. In this case, the list value of listPtr is not changed (no
     * elements are removed or added), but by making the call we are assured
     * we end up with a list in canonical form. Resist any temptation to
     * optimize this case away.
     */

    if (TCL_OK != Tcl_ListObjReplace(interp, listPtr, first, numToDelete,
	    objc-4, &(objv[4]))) {
	return TCL_ERROR;
    }

    /*
     * Set the interpreter's object result.
     */

    Tcl_SetObjResult(interp, listPtr);
    return TCL_OK;

	if (srcLen > dstLen) {
	/* In these modes, each src byte become a dst byte. */
	    srcLen = dstLen;
	}
	break;
    default:
	/* In other modes, at most 2 src bytes become a dst byte. */
	if (srcLen/2 > dstLen) {
	    srcLen = 2 * dstLen;
	}
	break;
    }

    if (inEofChar != '\0') {
	/*

# tclInt.decls --
#
#	This file contains the declarations for all unsupported
#	functions that are exported by the Tcl library.  This file
#	is used to generate the tclIntDecls.h, tclIntPlatDecls.h

#	and tclStubInit.c files
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
# Copyright (c) 2007 Daniel A. Steffen <[email protected]>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

	/*
	 * The 'first+count < 0' condition here guards agains integer
	 * overflow in determining 'first+count'
	 */
	count = numElems - first;
    }

    if (objc > LIST_MAX - (numElems - count)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"max length of a Tcl list (%d elements) exceeded", LIST_MAX));
	return TCL_ERROR;
    }
    isShared = (listRepPtr->refCount > 1);
    numRequired = numElems - count + objc; /* Known <= LIST_MAX */

    for (i = 0;  i < objc;  i++) {
	Tcl_IncrRefCount(objv[i]);
    }

    if ((numRequired <= listRepPtr->maxElemCount) && !isShared) {
	int shift;

	    newMax = 2 * numRequired;
	} else {
	    newMax = listRepPtr->maxElemCount;
	}

	listRepPtr = AttemptNewList(interp, newMax, NULL);
	if (listRepPtr == NULL) {
	listRepPtr = AttemptNewList(interp, numRequired, NULL);
	if (listRepPtr == NULL) {
	    for (i = 0;  i < objc;  i++) {
		/* See bug 3598580 */
#if TCL_MAJOR_VERSION > 8
		Tcl_DecrRefCount(objv[i]);
#else
		objv[i]->refCount--;
#endif
	    }
	    return TCL_ERROR;
	}
	}

	listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr;
	listRepPtr->refCount++;

	elemPtrs = &listRepPtr->elements;

# tclTomMath.decls --
#
#	This file contains the declarations for the functions in
#	'libtommath' that are contained within the Tcl library.
#	This file is used to generate the 'tclTomMathDecls.h' and
#	'tclStubInit.c' files.
#
# If you edit this file, advance the revision number (and the epoch
# if the new stubs are not backward compatible) in tclTomMathDecls.h
#
# Copyright (c) 2005 by Kevin B. Kenny.  All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution

	    objPtr = objv[i];
	    if (objPtr->bytes && objPtr->length == 0) {
		continue;
	    }
	    TclListObjGetElements(NULL, objPtr, &listc, &listv);
	    if (listc) {
		if (resPtr) {
		    if (TCL_OK != Tcl_ListObjReplace(NULL, resPtr,
			    INT_MAX, 0, listc, listv)) {
			/* Abandon ship! */
			Tcl_DecrRefCount(resPtr);
			goto slow;
		    }
		} else {
		    resPtr = TclListObjCopy(NULL, objPtr);
		}
	    }
	}
	if (!resPtr) {
	    resPtr = Tcl_NewObj();
	}
	return resPtr;
    }

    /*
     * Something cannot be determined to be safe, so build the concatenation
     * the slow way, using the string representations.
     */

  slow:
    /* First try to pre-allocate the size required */
    for (i = 0;  i < objc;  i++) {
	element = TclGetStringFromObj(objv[i], &elemLength);
	bytesNeeded += elemLength;
	if (bytesNeeded < 0) {
	    break;
	}

# library or non-shared library for Tcl.
${LIB_FILE}: ${STUB_LIB_FILE} ${OBJS}
	rm -f $@
	@MAKE_LIB@

${STUB_LIB_FILE}: ${STUB_LIB_OBJS}
	@if test "x${LIB_FILE}" = "xlibtcl${MAJOR_VERSION}.${MINOR_VERSION}.dll"; then \
	    (cd ${TOP_DIR}/win; ${MAKE} winextensions); \
	fi
	rm -f $@
	@MAKE_STUB_LIB@

# Make target which outputs the list of the .o contained in the Tcl lib useful
# to build a single big shared library containing Tcl and other extensions.
# Used for the Tcl Plugin.  -- dl

    if test "${SHARED_BUILD}" = 1 -a "${SHLIB_SUFFIX}" != ""; then

        LIB_SUFFIX=${SHARED_LIB_SUFFIX}
        MAKE_LIB='${SHLIB_LD} -o $@ ${OBJS} ${SHLIB_LD_LIBS} ${TCL_SHLIB_LD_EXTRAS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}'
        if test "${SHLIB_SUFFIX}" = ".dll"; then

            INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(BIN_INSTALL_DIR)/$(LIB_FILE)";if test -f $(LIB_FILE).a; then $(INSTALL_DATA) $(LIB_FILE).a "$(LIB_INSTALL_DIR)"; fi;'
            DLL_INSTALL_DIR="\$(BIN_INSTALL_DIR)"

else

            INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"'

fi

	UNSHARED_LIB_SUFFIX='${VERSION}.a'])
    DLL_INSTALL_DIR="\$(LIB_INSTALL_DIR)"

    AS_IF([test "${SHARED_BUILD}" = 1 -a "${SHLIB_SUFFIX}" != ""], [
        LIB_SUFFIX=${SHARED_LIB_SUFFIX}
        MAKE_LIB='${SHLIB_LD} -o [$]@ ${OBJS} ${SHLIB_LD_LIBS} ${TCL_SHLIB_LD_EXTRAS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}'
        AS_IF([test "${SHLIB_SUFFIX}" = ".dll"], [
            INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(BIN_INSTALL_DIR)/$(LIB_FILE)";if test -f $(LIB_FILE).a; then $(INSTALL_DATA) $(LIB_FILE).a "$(LIB_INSTALL_DIR)"; fi;'
            DLL_INSTALL_DIR="\$(BIN_INSTALL_DIR)"
        ], [
            INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"'
        ])
    ], [
        LIB_SUFFIX=${UNSHARED_LIB_SUFFIX}

doc:

winhelp: $(ROOT_DIR)/tools/man2help.tcl $(MAN2TCL)
	TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
	./$(TCLSH) "$(ROOT_DIR_NATIVE)"/tools/man2help.tcl tcl "$(VER)" $(TCL_DOCS)
	hcw /c /e tcl.hpj

winextensions: ${DDE_DLL_FILE} ${REG_DLL_FILE}

$(MAN2TCL): $(ROOT_DIR)/tools/man2tcl.c
	$(CC) $(CFLAGS_OPTIMIZE) $(MAN2TCLFLAGS) -o $(MAN2TCL) "$(ROOT_DIR_NATIVE)"/tools/man2tcl.c

$(TCLSH): $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(TCLSH_OBJS) tclsh.$(RES)
	$(CC) $(CFLAGS) $(TCLSH_OBJS) $(TCL_LIB_FILE) $(LIBS) \
        tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE)

#" emacs fix

install-libraries: tclConfig install-msgs install-tzdata
	@if not exist "$(SCRIPT_INSTALL_DIR)$(NULL)" \
		$(MKDIR) "$(SCRIPT_INSTALL_DIR)"
	@if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8$(NULL)" \
		$(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8"




	@if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4$(NULL)" \
		$(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4"
	@if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform$(NULL)" \
		$(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform"
	@if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5$(NULL)" \
		$(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5"
	@echo Installing header files

	while (fgets(szBuffer, cbBuffer, fp) != NULL) {
	    LPSTR p, q;

	    p = strstr(szBuffer, match);
	    if (p != NULL) {
		/*
		 * Skip to first digit after the match.
		 */

		p += strlen(match);
		while (*p && !isdigit(*p)) {
		    ++p;
		}

		/*
		 * Find ending whitespace.
		 */

	/*
	 * Build a list of substutitions from the first filename
	 */

	sp = fopen(substitutions, "rt");
	if (sp != NULL) {
	    while (fgets(szBuffer, cbBuffer, sp) != NULL) {
		unsigned char *ks, *ke, *vs, *ve;
		ks = (unsigned char*)szBuffer;
		while (ks && *ks && isspace(*ks)) ++ks;
		ke = ks;
		while (ke && *ke && !isspace(*ke)) ++ke;
		vs = ke;
		while (vs && *vs && isspace(*vs)) ++vs;
		ve = vs;
		while (ve && *ve && !(*ve == '\r' || *ve == '\n')) ++ve;
		*ke = 0, *ve = 0;
		list_insert(&substPtr, (char*)ks, (char*)vs);
	    }
	    fclose(sp);
	}

	/* debug: dump the list */
#ifdef _DEBUG
	{
	    int n = 0;
	    list_item_t *p = NULL;
	    for (p = substPtr; p != NULL; p = p->nextPtr, ++n) {
		fprintf(stderr, "% 3d '%s' => '%s'\n", n, p->key, p->value);
	    }
	}
#endif

	/*
	 * Run the substitutions over each line of the input
	 */

	while (fgets(szBuffer, cbBuffer, fp) != NULL) {
	    list_item_t *p = NULL;
	    for (p = substPtr; p != NULL; p = p->nextPtr) {
		char *m = strstr(szBuffer, p->key);
		if (m) {
		    char *cp, *op, *sp;
		    cp = szCopy;
		    op = szBuffer;
		    while (op != m) *cp++ = *op++;
		    sp = p->value;
		    while (sp && *sp) *cp++ = *sp++;
		    op += strlen(p->key);
		    while (*op) *cp++ = *op++;
		    *cp = 0;
		    memcpy(szBuffer, szCopy, sizeof(szCopy));
		}
	    }
	    printf(szBuffer);
	}

	list_free(&substPtr);
    }
    fclose(fp);
    return 0;
}

/*