Tcl Source Code

'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: open.n,v 1.2.2.2 1999/03/24 05:21:07 jingham Exp $
'\" 
.so man.macros
.TH open n 7.6 Tcl "Tcl Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
open \- Open a file-based or command pipeline channel

writes to the open pipe will instead be discarded.
.sp
Since Tcl cannot be run with a real console under Windows 3.X, there are
no interactions between command pipelines and the console.
.TP
\fBMacintosh\fR
.
Access to the serial port is not accomplished through magic cookies passed
to the \fIopen\fR command on the Macintosh.  Instead, you can use Sean Wood's 
([email protected]) \fIDevice\fR extension for the same purpose.
.sp
Opening a command pipeline is not supported under Macintosh, since 
applications do not support the concept of standard input or output.
.TP
\fBUnix\fR\0\0\0\0\0\0\0
.
Valid values for \fIfileName\fR to open a serial port are generally of the

# init.tcl --
#
# Default system startup file for Tcl-based applications.  Defines
# "unknown" procedure and auto-load facilities.
#
# RCS: @(#) $Id: init.tcl,v 1.25.2.1 1999/02/11 03:06:23 stanton Exp $
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

	append index "# more commands.  Typically each line is a command that\n"
	append index "# sets an element in the auto_index array, where the\n"
	append index "# element name is the name of a command and the value is\n"
	append index "# a script that loads the command.\n\n"
	if {$args == ""} {
	    set args *.tcl
	}

	auto_mkindex_parser::init
	foreach file [eval glob $args] {
	    if {[catch {auto_mkindex_parser::mkindex $file} msg] == 0} {
		append index $msg
	    } else {
		set code $errorCode
		set info $errorInfo

    namespace eval auto_mkindex_parser {
	variable parser ""          ;# parser used to build index
	variable index ""           ;# maintains index as it is built
	variable scriptFile ""      ;# name of file being processed
	variable contextStack ""    ;# stack of namespace scopes
	variable imports ""         ;# keeps track of all imported cmds
	variable initCommands ""    ;# list of commands that create aliases

	proc init {} {
	    variable parser
	    variable initCommands
	    
	    if {![interp issafe]} {
		set parser [interp create -safe]
		$parser hide info
		$parser hide rename
		$parser hide proc
		$parser hide namespace
		$parser hide eval

    # Registers a Tcl command to evaluate when initializing the
    # slave interpreter used by the mkindex parser.
    # The command is evaluated in the slave interpreter.

    proc auto_mkindex_parser::slavehook {cmd} {
	variable initCommands

	lappend initCommands [list \$parser eval $cmd]
    }

    # auto_mkindex_parser::command --
    # Registers a new command with the "auto_mkindex_parser" interpreter
    # that parses Tcl files.  These commands are fake versions of things
    # like the "proc" command.  When you execute them, they simply write
    # out an entry to a "tclIndex" file for auto-loading.

	# we have to build procs with the fully qualified names, and
	# have the procs point to the aliases.
	#
	if {[regexp {::} $name]} {
	    set exportCmd [list _%@namespace export [namespace tail $name]]
	    $parser eval [list _%@namespace eval $ns $exportCmd]
	    set alias [namespace tail $fakeName]
	    $parser invokehidden proc $name {args} [list _%@eval $alias \$args]
	    $parser alias $alias $fakeName
	} else {
	    $parser alias $name $fakeName
	}
	return
    }

    # AUTO MKINDEX:  proc name arglist body
    # Adds an entry to the auto index list for the given procedure name.

    auto_mkindex_parser::command proc {name args} {
	variable index
	variable scriptFile
	append index [list set auto_index([fullname $name])] \
		" \[list source \[file join \$dir [list $scriptFile]\]\]\n"
    }

    # Conditionally add support for Tcl byte code files.  There are some
    # tricky details here.  First, we need to get the tbcload library
    # initialized in the current interpreter.  We cannot load tbcload into the
    # slave until we have done so because it needs access to the tcl_patchLevel
    # variable.  Second, because the package index file may defer loading the
    # library until we invoke a command, we need to explicitly invoke auto_load
    # to force it to be loaded.  This should be a noop if the package has
    # already been loaded

    auto_mkindex_parser::hook {
	if {![catch {package require tbcload}]} {
	    if {[info commands tbcload::bcproc] == ""} {
		auto_load tbcload::bcproc
	    }
	    load {} tbcload $auto_mkindex_parser::parser

	    # AUTO MKINDEX:  tbcload::bcproc name arglist body
	    # Adds an entry to the auto index list for the given pre-compiled
	    # procedure name.  

	    auto_mkindex_parser::commandInit tbcload::bcproc {name args} {
		variable index
		variable scriptFile
		append index [list set auto_index([fullname $name])] \
			" \[list source \[file join \$dir [list $scriptFile]\]\]\n"
	    }
	}
    }

    # AUTO MKINDEX:  namespace eval name command ?arg arg...?
    # Adds the namespace name onto the context stack and evaluates the
    # associated body of commands.
    #
    # AUTO MKINDEX:  namespace import ?-force? pattern ?pattern...?

		variable parser
		variable contextStack

		set name [lindex $args 0]
		set args [lrange $args 1 end]

		set contextStack [linsert $contextStack 0 $name]

		$parser eval [list _%@namespace eval $name] $args



		set contextStack [lrange $contextStack 1 end]
	    }
	    import {
		variable parser
		variable imports
		foreach pattern $args {
		    if {$pattern != "-force"} {
			lappend imports $pattern
		    }
		}
		catch {$parser eval [list _%@namespace import] $args}
	    }
	}
    }

# Close of the if ![interp issafe] block
}

 *  compiler flags.  See MetroWerks documention for more details.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: MW_TclHeader.pch,v 1.4.2.1 1999/03/24 05:25:29 jingham Exp $
 */

/*
 * To use the compilied header you need to set the "Prefix file" in
 * the "C/C++ Language" preference panel to point to the created
 * compilied header.  The name of the header depends on the
 * architecture we are compiling for (see the code below).  For

 * to control what functions are exported in the Tcl shared library.
 */

#pragma export on
#include "tcl.h"
#include "tclMac.h"
#include "tclInt.h"
#ifdef TCL_TEST
#include "tclMacPort.h"
#endif
#pragma export reset

Tcl 8.0.5 for Macintosh

by Ray Johnson
Scriptics Corporation
[email protected]
with major help from
Jim Ingham
Cygnus Solutions
[email protected]

RCS: @(#) $Id: README,v 1.4.2.2 1999/03/24 05:21:07 jingham Exp $

1. Introduction
---------------

This is the README file for the Macintosh version of the Tcl
scripting language.  The file consists of information specific
to the Macintosh version of Tcl.  For more general information

6. Compiling Tcl
----------------

In order to compile Macintosh Tcl you must have the 
following items:

	CodeWarrior Pro 2 through 4
	Mac Tcl 8.0 (source)
	More Files 1.4.3, or 1.4.9

There are two sets of project files included with the package. The ones
we use for the release are for CodeWarrior Pro 3, and are not compatible
with CodeWarrior Gold release 11 and earlier. We have included the files
for earlier versions of CodeWarrior in the folder tcl8.0:mac:CW11 Projects,
but they are unsupported, and a little out of date.

and Power PC builds, for building a CFM 68K build, and for building a
shared library Power PC only build.

Special notes:

* There is a small bug in More Files 1.4.3.  Also you should not use
  MoreFiles 1.4.4 - 1.4.6.  Look in the file named morefiles.doc for
  more details.  Tcl 8.0.5 is compiled with MoreFiles 1.4.9.

* You may not have the libmoto library which will cause a compile 
  error.  You don't REALLY need it - it can be removed.  Look at the
  file libmoto.doc for more details.

* Check out the file bugs.doc for information about known bugs.

If you have comments or Bug reports send them to:
Jim Ingham
[email protected]

/* 
 * tclMacChan.c
 *
 *	Channel drivers for Macintosh channels for the
 *	console fds.
 *
 * Copyright (c) 1996-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclMacChan.c,v 1.3.2.2 1999/03/24 05:21:16 jingham Exp $
 */

#include "tclInt.h"
#include "tclPort.h"
#include "tclMacInt.h"
#include <Aliases.h>
#include <Errors.h>

				 * all events. */
    FileState *infoPtr;		/* Pointer to file info structure.  Note
				 * that we still have to verify that the
				 * file exists before dereferencing this
				 * pointer. */
} FileEvent;

/*
 * This is defined in tclMacSerial.c.
 */

EXTERN Tcl_Channel TclMacOpenSerialChannel _ANSI_ARGS_((Tcl_Interp *interp,
	char *fileName, int *errorCode));

/*
 * Static routines for this file:
 */

static int		CommonGetHandle _ANSI_ARGS_((ClientData instanceData,
		            int direction, ClientData *handlePtr));

                                         * file, with what modes to create
                                         * it? */
{
    Tcl_Channel chan;
    int mode;
    char *nativeName;
    Tcl_DString buffer;
    int errorCode, port = 0;
    
    mode = GetOpenMode(interp, modeString);
    if (mode == -1) {
	return NULL;
    }

    /* 
     * Look for the magic cookies that refer to the modem ports.
     */
    
    nativeName = Tcl_TranslateFileName(interp, fileName, &buffer);
    if (nativeName == NULL) {
	return NULL;
    }

    chan = OpenFileChannel(nativeName, mode, permissions, &errorCode);
    Tcl_DStringFree(&buffer);
    
    if (chan == NULL) {
	Tcl_SetErrno(errorCode);
	if (interp != (Tcl_Interp *) NULL) {
            Tcl_AppendResult(interp, "couldn't open \"", fileName, "\": ",
                    Tcl_PosixError(interp), (char *) NULL);
        }
	return NULL;

/* 
 * tclMacFCmd.c --
 *
 * Implements the Macintosh specific portions of the file manipulation
 * subcommands of the "file" command.
 *
 * Copyright (c) 1996-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclMacFCmd.c,v 1.2.2.1 1999/03/22 05:42:37 jingham Exp $
 */

#include "tclInt.h"
#include "tclMac.h"
#include "tclMacInt.h"
#include "tclPort.h"
#include <FSpCompat.h>

/*
 * Prototypes for procedure only used in this file
 */

static pascal Boolean 	CopyErrHandler _ANSI_ARGS_((OSErr error, 
			    short failedOperation,
			    short srcVRefNum, long srcDirID,
			    const unsigned char *srcName, short dstVRefNum,
			    long dstDirID, const unsigned char *dstName));
OSErr			FSpGetFLockCompat _ANSI_ARGS_((const FSSpec *specPtr, 
			    Boolean *lockedPtr));
static OSErr		GenerateUniqueName _ANSI_ARGS_((short vRefNum, 
			    long dirID1, long dirID2, Str31 uniqueName));
static OSErr		GetFileSpecs _ANSI_ARGS_((char *path, FSSpec *pathSpecPtr,
			    FSSpec *dirSpecPtr,	Boolean *pathExistsPtr,	
			    Boolean *pathIsDirectoryPtr));

static pascal Boolean 
CopyErrHandler(
    OSErr error,		/* Error that occured */
    short failedOperation,	/* operation that caused the error */
    short srcVRefNum,		/* volume ref number of source */
    long srcDirID,		/* directory id of source */
    const unsigned char *srcName,	/* name of source */
    short dstVRefNum,		/* volume ref number of dst */
    long dstDirID,		/* directory id of dst */
    const unsigned char *dstName)	/* name of dst directory */
{
    return true;
}

/*
 *---------------------------------------------------------------------------
 *

/* 
 * tclMacSock.c
 *
 *	Channel drivers for Macintosh sockets.
 *
 * Copyright (c) 1996-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclMacSock.c,v 1.2.2.1 1999/03/22 05:42:54 jingham Exp $
 */

#include "tclInt.h"
#include "tclPort.h"
#include "tclMacInt.h"
#include <AddressXlation.h>
#include <Aliases.h>

				    * TCL_WRITABLE as set by Tcl_WatchFile. */
    Tcl_TcpAcceptProc *acceptProc; /* Proc to call on accept. */
    ClientData acceptProcData;	   /* The data for the accept proc. */
    wdsEntry dataSegment[2];       /* List of buffers to be written async. */
    rdsEntry rdsarray[5+1];	   /* Array used when cleaning out recieve 
				    * buffers on a closing socket. */
    Tcl_Channel channel;	   /* Channel associated with this socket. */
    int writeBufferSize;           /* Size of buffer to hold data for
                                    *  asynchronous writes. */
    void *writeBuffer;             /* Buffer for async write data. */
    struct TcpState *nextPtr;	   /* The next socket on the global socket
				    * list. */
} TcpState;

/*
 * This structure is used by domain name resolver callback.
 */

	 * write isn't in progress and there is room in the output buffers.
	 */

	if (!(statePtr->flags & TCP_WRITING) && amount > 0) {
	    if (toWrite < amount) {
		amount = toWrite;
	    }

            /* We need to copy the data, otherwise the caller may overwrite
             * the buffer in the middle of our asynchronous call
             */
             
            if (amount > statePtr->writeBufferSize) {
                /* 
                 * need to grow write buffer 
                 */
                 
                if (statePtr->writeBuffer != (void *) NULL) {
                    ckfree(statePtr->writeBuffer);
                }
                statePtr->writeBuffer = (void *) ckalloc(amount);
                statePtr->writeBufferSize = amount;
            }
            memcpy(statePtr->writeBuffer, buf, amount);
            statePtr->dataSegment[0].ptr = statePtr->writeBuffer;

	    statePtr->dataSegment[0].length = amount;
	    statePtr->dataSegment[1].length = 0;
	    InitMacTCPParamBlock(&statePtr->pb, TCPSend);
	    statePtr->pb.ioCompletion = completeUPP;
	    statePtr->pb.tcpStream = tcpStream;
	    statePtr->pb.csParam.send.wdsPtr = (Ptr) statePtr->dataSegment;
	    statePtr->pb.csParam.send.pushFlag = 1;
	    statePtr->pb.csParam.send.userDataPtr = (Ptr) statePtr;

    statePtr->tcpStream = tcpStream;
    statePtr->psn = applicationPSN;
    statePtr->flags = 0;
    statePtr->checkMask = 0;
    statePtr->watchMask = 0;
    statePtr->acceptProc = (Tcl_TcpAcceptProc *) NULL;
    statePtr->acceptProcData = (ClientData) NULL;
    statePtr->writeBuffer = (void *) NULL;
    statePtr->writeBufferSize = 0;
    statePtr->nextPtr = socketList;
    socketList = statePtr;
    return statePtr;
}

/*
 *----------------------------------------------------------------------

	for (p = socketList; p != NULL; p = p->nextPtr) {
	    if (p->nextPtr == statePtr) {
		p->nextPtr = statePtr->nextPtr;
		break;
	    }
	}
    }
    
    if (statePtr->writeBuffer != (void *) NULL) {
        ckfree(statePtr->writeBuffer);
    }
    
    ckfree((char *) statePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_MakeTcpClientChannel --

# This makefile is used to convert Tcl manual pages into various
# alternate formats:
#
#    Windows help file:  1. Build the winhelp target on Unix
#			 2. Build the helpfile target on Windows
#
#    HTML:		 1. Build the html target on Unix

# RCS: @(#) $Id: Makefile.in,v 1.6.2.1 1999/02/19 02:17:04 stanton Exp $



TCL = tcl@TCL_VERSION@
TK = tk@TCL_VERSION@
VER=@TCL_WIN_VERSION@

TCL_BIN_DIR = @TCL_BIN_DIR@
TCL_SOURCE = @TCL_SRC_DIR@
TK_SOURCE = $(TCL_SOURCE)/../$(TK)
PRO_SOURCE = $(TCL_SOURCE)/../pro
ITCL_SOURCE = $(TCL_SOURCE)/../itcl3.0.1

TCL_DOCS = \
	$(TCL_SOURCE)/doc/*.[13n]

TK_DOCS = \
	$(TK_SOURCE)/doc/*.[13n]

PRO_DOCS = \
	$(PRO_SOURCE)/doc/man/*.[13n]

ITCL_DOCS = \
	$(ITCL_SOURCE)/itcl/doc/*.[13n] \
	$(ITCL_SOURCE)/itk/doc/*.[13n]

#	$(ITCL_SOURCE)/iwidgets3.0.0/doc/*.[13n]

COREDOCS = $(TCL_DOCS) $(TK_DOCS) 
PRODOCS = $(COREDOCS) $(PRO_DOCS) $(ITCL_DOCS)
TCLSH = $(TCL_BIN_DIR)/tclsh
CC=@CC@

all: core

pro:
	$(MAKE) DOCS="$(PRODOCS)" VER="" rtf

core:
	$(MAKE) DOCS="$(COREDOCS)" rtf

rtf: $(TCL_SOURCE)/tools/man2help.tcl man2tcl $(DOCS)
	LD_LIBRARY_PATH=$(TCL_BIN_DIR) \
	TCL_LIBRARY=$(TCL_SOURCE)/library \
	$(TCLSH) $(TCL_SOURCE)/tools/man2help.tcl tcl "$(VER)" $(DOCS)

winhelp: tcl.rtf

man2tcl: $(TCL_SOURCE)/tools/man2tcl.c
	$(CC) $(CFLAGS) -o man2tcl $(TCL_SOURCE)/tools/man2tcl.c

clean:
	-rm -f man2tcl *.o *.cnt *.rtf

helpfile:
	hcw /c /e tcl.hpj

dnl	This file is an input file used by the GNU "autoconf" program to
dnl	generate the file "configure", which is run to configure the
dnl	Makefile in this directory.
AC_INIT(man2tcl.c)
# RCS: @(#) $Id: configure.in,v 1.2.2.2 1999/02/19 03:40:21 stanton Exp $

# Recover information that Tcl computed with its configure script.

#--------------------------------------------------------------------
#       See if there was a command-line option for where Tcl is;  if
#       not, assume that its top-level directory is a sibling of ours.
#--------------------------------------------------------------------

AC_ARG_WITH(tcl, [  --with-tcl=DIR          use Tcl 8.0 binaries from DIR], TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd ../../tcl8.0$TK_PATCH_LEVEL/unix; pwd`)
if test ! -d $TCL_BIN_DIR; then
    AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR doesn't exist)
fi
if test ! -f $TCL_BIN_DIR/tclConfig.sh; then
    AC_MSG_ERROR(There's no tclConfig.sh in $TCL_BIN_DIR;  perhaps you didn't specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?)
fi

. $TCL_BIN_DIR/tclConfig.sh

TCL_WIN_VERSION=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
AC_SUBST(TCL_WIN_VERSION)
CC=$TCL_CC
AC_SUBST(CC)
AC_SUBST(TCL_VERSION)
AC_SUBST(TCL_PATCH_LEVEL)
AC_SUBST(TCL_SRC_DIR)
AC_SUBST(TCL_BIN_DIR)

AC_OUTPUT(tcl.hpj Makefile)

# man2help.tcl --
#
# This file defines procedures that work in conjunction with the
# man2tcl program to generate a Windows help file from Tcl manual
# entries.
#
# Copyright (c) 1996 by Sun Microsystems, Inc.
#
# RCS: @(#) $Id: man2help.tcl,v 1.3.2.1 1999/02/19 02:17:04 stanton Exp $
# 

#
# PASS 1
#

proc generateContents {basename version files} {
    global curID topics
    set curID 0
    foreach f $files {
	regsub -all -- {-} [file tail $f] {} curFile
	puts "Pass 1 -- $f"
	flush stdout
	doFile $f
    }
    set fd [open "$basename$version.cnt" w]
    fconfigure $fd -translation crlf
    puts $fd ":Base $basename$version.hlp"
    foreach package [getPackages] {
	foreach section [getSections $package] {
	    puts $fd "1 $section"
	    set lastTopic {}
	    foreach topic [getTopics $package $section] {
		if {[string compare $lastTopic $topic] != 0} {

    foreach key [array names keywords] {
	foreach id $keywords($key) {
	    lappend id_keywords($id) $key
	}
    }
	    
    set file [open "$basename.rtf" w]
    fconfigure $file -translation crlf
    puts $file "\{\\rtf1\\ansi \\deff0\\deflang1033\{\\fonttbl\{\\f0\\froman\\fcharset0\\fprq2 Times New Roman\;\}\}"
    foreach f $files {
	regsub -all -- {-} [file tail $f] {} curFile
	puts "Pass 2 -- $f"
	flush stdout
	initGlobals
	doFile $f

/* 
 * tclWinSock.c --
 *
 *	This file contains Windows-specific socket related code.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclWinSock.c,v 1.5.2.1 1999/04/13 18:12:43 redman Exp $
 */

#include "tclInt.h"
#include "tclPort.h"

/*
 * The following variable is used to tell whether this module has been

		if (error != ERROR_SUCCESS) {
		    TclWinConvertWSAError(error);
		    infoPtr->lastError = Tcl_GetErrno();
		}

	    } 
	    if(infoPtr->flags & SOCKET_ASYNC_CONNECT) {
		infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
		if (error != ERROR_SUCCESS) {
		    TclWinConvertWSAError(error);
		    infoPtr->lastError = Tcl_GetErrno();
		}
		infoPtr->readyEvents |= FD_WRITE;
	    }
	    infoPtr->readyEvents |= event;
	    break;
	}
    }

    /*
     * Flush the Tcl event queue before returning to the event loop.