|
|
@@ -0,0 +1,1032 @@
|
|
|
+{*
|
|
|
+ * tcl.h --
|
|
|
+ *
|
|
|
+ * This header file describes the externally-visible facilities of the Tcl
|
|
|
+ * interpreter.
|
|
|
+ *
|
|
|
+ * Translated to Pascal Copyright (c) 2002 by Max Artemev
|
|
|
+ * aka Bert Raccoon ([email protected], [email protected])
|
|
|
+ *
|
|
|
+ *
|
|
|
+ * Copyright (c) 1998-2000 by Scriptics Corporation.
|
|
|
+ * Copyright (c) 1994-1998 Sun Microsystems, Inc.
|
|
|
+ * Copyright (c) 1993-1996 Lucent Technologies.
|
|
|
+ * Copyright (c) 1987-1994 John Ousterhout, The Regents of the
|
|
|
+ * University of California, Berkeley.
|
|
|
+ *
|
|
|
+ * ***********************************************************************
|
|
|
+ * 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.
|
|
|
+ * ***********************************************************************
|
|
|
+ *}
|
|
|
+unit Tcl80;
|
|
|
+
|
|
|
+{$MODE OBJFPC}
|
|
|
+{$ASMMODE INTEL}
|
|
|
+
|
|
|
+{$IFNDEF WIN32}
|
|
|
+ {$LINKLIB c}
|
|
|
+ {$LINKLIB m}
|
|
|
+{$ENDIF}
|
|
|
+
|
|
|
+{$PACKRECORDS C}
|
|
|
+
|
|
|
+{ $DEFINE USE_C}
|
|
|
+{*
|
|
|
+ * I recommend you to compile and link "argv.o" file to this unit.
|
|
|
+ * If you don't have the GCC and you working on the Intel platform
|
|
|
+ * undefine/comment the `USE_C` macro
|
|
|
+ *}
|
|
|
+{$IFDEF USE_C}
|
|
|
+ {$LINK argv.o}
|
|
|
+{$ENDIF}
|
|
|
+
|
|
|
+interface
|
|
|
+
|
|
|
+// M$ Win32?
|
|
|
+{$IFDEF WIN32}
|
|
|
+uses windows;
|
|
|
+{$ENDIF}
|
|
|
+
|
|
|
+const
|
|
|
+{$IFDEF WIN32}
|
|
|
+ TCL_LIBRARY = 'tcl80.dll';
|
|
|
+{$ELSE}
|
|
|
+ TCL_LIBRARY = 'tcl80';
|
|
|
+{$ENDIF}
|
|
|
+
|
|
|
+ TCL_DESTROYED = integer($DEADDEAD); // yeah it dead ;)
|
|
|
+ TCL_OK = 0;
|
|
|
+ TCL_ERROR = 1;
|
|
|
+ TCL_RETURN = 2;
|
|
|
+ TCL_BREAK = 3;
|
|
|
+ TCL_CONTINUE = 4;
|
|
|
+ TCL_RESULT_SIZE = 200;
|
|
|
+ MAX_ARGV = $7FFF;
|
|
|
+ TCL_VERSION_MAJOR: integer = 0;
|
|
|
+ TCL_VERSION_MINOR: integer = 0;
|
|
|
+
|
|
|
+ TCL_NO_EVAL = $10000;
|
|
|
+ TCL_EVAL_GLOBAL = $20000;
|
|
|
+
|
|
|
+{* Flag values passed to variable-related procedures. *}
|
|
|
+ TCL_GLOBAL_ONLY = 1;
|
|
|
+ TCL_NAMESPACE_ONLY = 2;
|
|
|
+ TCL_APPEND_VALUE = 4;
|
|
|
+ TCL_LIST_ELEMENT = 8;
|
|
|
+ TCL_TRACE_READS = $10;
|
|
|
+ TCL_TRACE_WRITES = $20;
|
|
|
+ TCL_TRACE_UNSETS = $40;
|
|
|
+ TCL_TRACE_DESTROYED = $80;
|
|
|
+ TCL_INTERP_DESTROYED = $100;
|
|
|
+ TCL_LEAVE_ERR_MSG = $200;
|
|
|
+ TCL_PARSE_PART1 = $400;
|
|
|
+
|
|
|
+{* Types for linked variables: *}
|
|
|
+ TCL_LINK_INT = 1;
|
|
|
+ TCL_LINK_DOUBLE = 2;
|
|
|
+ TCL_LINK_BOOLEAN = 3;
|
|
|
+ TCL_LINK_STRING = 4;
|
|
|
+ TCL_LINK_READ_ONLY = $80;
|
|
|
+ TCL_SMALL_HASH_TABLE = 4;
|
|
|
+
|
|
|
+{* Hash Table *}
|
|
|
+ TCL_STRING_KEYS = 0;
|
|
|
+ TCL_ONE_WORD_KEYS = 1;
|
|
|
+
|
|
|
+{* Const/enums Tcl_QueuePosition *}
|
|
|
+// typedef enum {
|
|
|
+ TCL_QUEUE_TAIL = 0;
|
|
|
+ TCL_QUEUE_HEAD = 1;
|
|
|
+ TCL_QUEUE_MARK = 2;
|
|
|
+//} Tcl_QueuePosition;
|
|
|
+
|
|
|
+// Event Flags
|
|
|
+ TCL_DONT_WAIT = 1 shl 1;
|
|
|
+ TCL_WINDOW_EVENTS = 1 shl 2;
|
|
|
+ TCL_FILE_EVENTS = 1 shl 3;
|
|
|
+ TCL_TIMER_EVENTS = 1 shl 4;
|
|
|
+ TCL_IDLE_EVENTS = 1 shl 5; {* WAS 0x10 ???? *}
|
|
|
+ TCL_ALL_EVENTS = ($FFFFFFFF xor TCL_DONT_WAIT); // (~TCL_DONT_WAIT)
|
|
|
+
|
|
|
+// Result type
|
|
|
+ TCL_VOLATILE = 1;
|
|
|
+ TCL_STATIC = 0;
|
|
|
+ TCL_DYNAMIC = 3;
|
|
|
+
|
|
|
+// Channel
|
|
|
+ TCL_STDIN = 1 shl 1;
|
|
|
+ TCL_STDOUT = 1 shl 2;
|
|
|
+ TCL_STDERR = 1 shl 3;
|
|
|
+ TCL_ENFORCE_MODE = 1 shl 4;
|
|
|
+
|
|
|
+ TCL_READABLE = 1 shl 1;
|
|
|
+ TCL_WRITABLE = 1 shl 2;
|
|
|
+ TCL_EXCEPTION = 1 shl 3;
|
|
|
+
|
|
|
+{* POSIX *}
|
|
|
+
|
|
|
+ EPERM = 1;
|
|
|
+{* Operation not permitted; only the owner of the file (or other
|
|
|
+ * resource) or processes with special privileges can perform the
|
|
|
+ * operation.
|
|
|
+ *}
|
|
|
+
|
|
|
+ ENOENT = 2;
|
|
|
+{* No such file or directory. This is a "file doesn't exist" error
|
|
|
+ * for ordinary files that are referenced in contexts where they are
|
|
|
+ * expected to already exist.
|
|
|
+ *}
|
|
|
+
|
|
|
+ ESRCH = 3;
|
|
|
+{* No process matches the specified process ID. *}
|
|
|
+
|
|
|
+ EINTR = 4;
|
|
|
+{* Interrupted function call; an asynchronous signal occurred and
|
|
|
+ * prevented completion of the call. When this happens, you should
|
|
|
+ * try the call again.
|
|
|
+ *}
|
|
|
+
|
|
|
+ EIO = 5;
|
|
|
+{* Input/output error; usually used for physical read or write errors. *}
|
|
|
+
|
|
|
+ ENXIO = 6;
|
|
|
+{* No such device or address. The system tried to use the device
|
|
|
+ * represented by a file you specified, and it couldn't find the
|
|
|
+ * device. This can mean that the device file was installed
|
|
|
+ * incorrectly, or that the physical device is missing or not
|
|
|
+ * correctly attached to the computer.
|
|
|
+ *}
|
|
|
+
|
|
|
+ E2BIG = 7;
|
|
|
+{* Argument list too long; used when the arguments passed to a new
|
|
|
+ * program being executed with one of the `exec' functions (*note
|
|
|
+ * Executing a File::.) occupy too much memory space. This condition
|
|
|
+ * never arises in the GNU system.
|
|
|
+ *}
|
|
|
+
|
|
|
+ ENOEXEC = 8;
|
|
|
+{* Invalid executable file format. This condition is detected by the
|
|
|
+ * `exec' functions; see *Note Executing a File::.
|
|
|
+ *}
|
|
|
+
|
|
|
+ EBADF = 9;
|
|
|
+{* Bad file descriptor; for example, I/O on a descriptor that has been
|
|
|
+ * closed or reading from a descriptor open only for writing (or vice
|
|
|
+ * versa).
|
|
|
+ *}
|
|
|
+
|
|
|
+ ECHILD = 10;
|
|
|
+{* There are no child processes. This error happens on operations
|
|
|
+ * that are supposed to manipulate child processes, when there aren't
|
|
|
+ * any processes to manipulate.
|
|
|
+ *}
|
|
|
+
|
|
|
+ EDEADLK = 11;
|
|
|
+{* Deadlock avoided; allocating a system resource would have resulted
|
|
|
+ * in a deadlock situation. The system does not guarantee that it
|
|
|
+ * will notice all such situations. This error means you got lucky
|
|
|
+ * and the system noticed; it might just hang. *Note File Locks::,
|
|
|
+ * for an example.
|
|
|
+ *}
|
|
|
+
|
|
|
+ ENOMEM = 12;
|
|
|
+{* No memory available. The system cannot allocate more virtual
|
|
|
+ * memory because its capacity is full.
|
|
|
+ *}
|
|
|
+
|
|
|
+ EACCES = 13;
|
|
|
+{* Permission denied; the file permissions do not allow the attempted
|
|
|
+ * operation.
|
|
|
+ *}
|
|
|
+
|
|
|
+ EFAULT = 14;
|
|
|
+{* Bad address; an invalid pointer was detected. In the GNU system,
|
|
|
+ * this error never happens; you get a signal instead.
|
|
|
+ *}
|
|
|
+
|
|
|
+ ENOTBLK = 15;
|
|
|
+{* A file that isn't a block special file was given in a situation
|
|
|
+ * that requires one. For example, trying to mount an ordinary file
|
|
|
+ * as a file system in Unix gives this error.
|
|
|
+ *}
|
|
|
+
|
|
|
+ EBUSY = 16;
|
|
|
+{* Resource busy; a system resource that can't be shared is already
|
|
|
+ * in use. For example, if you try to delete a file that is the root
|
|
|
+ * of a currently mounted filesystem, you get this error.
|
|
|
+ *}
|
|
|
+
|
|
|
+ EEXIST = 17;
|
|
|
+{* File exists; an existing file was specified in a context where it
|
|
|
+ * only makes sense to specify a new file.
|
|
|
+ *}
|
|
|
+
|
|
|
+ EXDEV = 18;
|
|
|
+{* An attempt to make an improper link across file systems was
|
|
|
+ * detected. This happens not only when you use `link' (*note Hard
|
|
|
+ * Links::.) but also when you rename a file with `rename' (*note
|
|
|
+ * Renaming Files::.).
|
|
|
+ *}
|
|
|
+
|
|
|
+ ENODEV = 19;
|
|
|
+{* The wrong type of device was given to a function that expects a
|
|
|
+ * particular sort of device.
|
|
|
+ *}
|
|
|
+
|
|
|
+ ENOTDIR = 20;
|
|
|
+{* A file that isn't a directory was specified when a directory is
|
|
|
+ * required.
|
|
|
+ *}
|
|
|
+
|
|
|
+ EISDIR = 21;
|
|
|
+{* File is a directory; you cannot open a directory for writing, or
|
|
|
+ * create or remove hard links to it.
|
|
|
+ *}
|
|
|
+
|
|
|
+ EINVAL = 22;
|
|
|
+{* Invalid argument. This is used to indicate various kinds of
|
|
|
+ * problems with passing the wrong argument to a library function.
|
|
|
+ *}
|
|
|
+
|
|
|
+ EMFILE = 24;
|
|
|
+{* The current process has too many files open and can't open any
|
|
|
+ * more. Duplicate descriptors do count toward this limit.
|
|
|
+ *
|
|
|
+ * In BSD and GNU, the number of open files is controlled by a
|
|
|
+ * resource limit that can usually be increased. If you get this
|
|
|
+ * error, you might want to increase the `RLIMIT_NOFILE' limit or
|
|
|
+ * make it unlimited; *note Limits on Resources::..
|
|
|
+ *}
|
|
|
+
|
|
|
+ ENFILE = 23;
|
|
|
+{* There are too many distinct file openings in the entire system.
|
|
|
+ * Note that any number of linked channels count as just one file
|
|
|
+ * opening; see *Note Linked Channels::. This error never occurs in
|
|
|
+ * the GNU system.
|
|
|
+ *}
|
|
|
+
|
|
|
+ ENOTTY = 25;
|
|
|
+{* Inappropriate I/O control operation, such as trying to set terminal
|
|
|
+ * modes on an ordinary file.
|
|
|
+ *}
|
|
|
+
|
|
|
+ ETXTBSY = 26;
|
|
|
+{* An attempt to execute a file that is currently open for writing, or
|
|
|
+ * write to a file that is currently being executed. Often using a
|
|
|
+ * debugger to run a program is considered having it open for writing
|
|
|
+ * and will cause this error. (The name stands for "text file
|
|
|
+ * busy".) This is not an error in the GNU system; the text is
|
|
|
+ * copied as necessary.
|
|
|
+ *}
|
|
|
+
|
|
|
+ EFBIG = 27;
|
|
|
+{* File too big; the size of a file would be larger than allowed by
|
|
|
+ * the system.
|
|
|
+ *}
|
|
|
+
|
|
|
+ ENOSPC = 28;
|
|
|
+{* No space left on device; write operation on a file failed because
|
|
|
+ * the disk is full.
|
|
|
+ *}
|
|
|
+
|
|
|
+ ESPIPE = 29;
|
|
|
+{* Invalid seek operation (such as on a pipe). *}
|
|
|
+
|
|
|
+ EROFS = 30;
|
|
|
+{* An attempt was made to modify something on a read-only file system. *}
|
|
|
+
|
|
|
+ EMLINK = 31;
|
|
|
+{* Too many links; the link count of a single file would become too
|
|
|
+ * large. `rename' can cause this error if the file being renamed
|
|
|
+ * already has as many links as it can take (*note Renaming Files::.).
|
|
|
+ *}
|
|
|
+
|
|
|
+ EPIPE = 32;
|
|
|
+{* Broken pipe; there is no process reading from the other end of a
|
|
|
+ * pipe. Every library function that returns this error code also
|
|
|
+ * generates a `SIGPIPE' signal; this signal terminates the program
|
|
|
+ * if not handled or blocked. Thus, your program will never actually
|
|
|
+ * see `EPIPE' unless it has handled or blocked `SIGPIPE'.
|
|
|
+ *}
|
|
|
+
|
|
|
+ EDOM = 33;
|
|
|
+{* Domain error; used by mathematical functions when an argument
|
|
|
+ * value does not fall into the domain over which the function is
|
|
|
+ * defined.
|
|
|
+ *}
|
|
|
+
|
|
|
+ ERANGE = 34;
|
|
|
+{* Range error; used by mathematical functions when the result value
|
|
|
+ * is not representable because of overflow or underflow.
|
|
|
+ *}
|
|
|
+
|
|
|
+ EAGAIN = 35;
|
|
|
+{* Resource temporarily unavailable; the call might work if you try
|
|
|
+ * again later. The macro `EWOULDBLOCK' is another name for `EAGAIN';
|
|
|
+ * they are always the same in the GNU C library.
|
|
|
+ *}
|
|
|
+
|
|
|
+ EWOULDBLOCK = EAGAIN;
|
|
|
+{* In the GNU C library, this is another name for `EAGAIN' (above).
|
|
|
+ * The values are always the same, on every operating system.
|
|
|
+ * C libraries in many older Unix systems have `EWOULDBLOCK' as a
|
|
|
+ * separate error code.
|
|
|
+ *}
|
|
|
+
|
|
|
+ EINPROGRESS = 36;
|
|
|
+{* An operation that cannot complete immediately was initiated on an
|
|
|
+ * object that has non-blocking mode selected. Some functions that
|
|
|
+ * must always block (such as `connect'; *note Connecting::.) never
|
|
|
+ * return `EAGAIN'. Instead, they return `EINPROGRESS' to indicate
|
|
|
+ * that the operation has begun and will take some time. Attempts to
|
|
|
+ * manipulate the object before the call completes return `EALREADY'.
|
|
|
+ * You can use the `select' function to find out when the pending
|
|
|
+ * operation has completed; *note Waiting for I/O::..
|
|
|
+ *}
|
|
|
+
|
|
|
+ EALREADY = 37;
|
|
|
+{* An operation is already in progress on an object that has
|
|
|
+ * non-blocking mode selected.
|
|
|
+ *}
|
|
|
+
|
|
|
+ ENOTSOCK = 38;
|
|
|
+{* A file that isn't a socket was specified when a socket is required. *}
|
|
|
+
|
|
|
+ EDESTADDRREQ = 39;
|
|
|
+{* No default destination address was set for the socket. You get
|
|
|
+ * this error when you try to transmit data over a connectionless
|
|
|
+ * socket, without first specifying a destination for the data with
|
|
|
+ * `connect'.
|
|
|
+ *}
|
|
|
+
|
|
|
+ EMSGSIZE = 40;
|
|
|
+{* The size of a message sent on a socket was larger than the
|
|
|
+ * supported maximum size.
|
|
|
+ *}
|
|
|
+
|
|
|
+ EPROTOTYPE = 41;
|
|
|
+{* The socket type does not support the requested communications
|
|
|
+ * protocol.
|
|
|
+ *}
|
|
|
+
|
|
|
+ ENOPROTOOPT = 42;
|
|
|
+{* You specified a socket option that doesn't make sense for the
|
|
|
+ * particular protocol being used by the socket. *Note Socket
|
|
|
+ * Options::.
|
|
|
+ *}
|
|
|
+
|
|
|
+ EPROTONOSUPPORT = 43;
|
|
|
+{* The socket domain does not support the requested communications
|
|
|
+ * protocol (perhaps because the requested protocol is completely
|
|
|
+ * invalid.) *Note Creating a Socket::.
|
|
|
+ *}
|
|
|
+
|
|
|
+ ESOCKTNOSUPPORT = 44;
|
|
|
+{* The socket type is not supported. *}
|
|
|
+
|
|
|
+ EOPNOTSUPP = 45;
|
|
|
+{* The operation you requested is not supported. Some socket
|
|
|
+ * functions don't make sense for all types of sockets, and others
|
|
|
+ * may not be implemented for all communications protocols. In the
|
|
|
+ * GNU system, this error can happen for many calls when the object
|
|
|
+ * does not support the particular operation; it is a generic
|
|
|
+ * indication that the server knows nothing to do for that call.
|
|
|
+ *}
|
|
|
+
|
|
|
+ EPFNOSUPPORT = 46;
|
|
|
+{* The socket communications protocol family you requested is not
|
|
|
+ * supported.
|
|
|
+ *}
|
|
|
+
|
|
|
+ EAFNOSUPPORT = 47;
|
|
|
+{* The address family specified for a socket is not supported; it is
|
|
|
+ * inconsistent with the protocol being used on the socket. *Note
|
|
|
+ * Sockets::.
|
|
|
+ *}
|
|
|
+
|
|
|
+ EADDRINUSE = 48;
|
|
|
+{* The requested socket address is already in use. *Note Socket
|
|
|
+ * Addresses::.
|
|
|
+ *}
|
|
|
+
|
|
|
+ EADDRNOTAVAIL = 49;
|
|
|
+{* The requested socket address is not available; for example, you
|
|
|
+ * tried to give a socket a name that doesn't match the local host
|
|
|
+ * name. *Note Socket Addresses::.
|
|
|
+ *}
|
|
|
+
|
|
|
+ ENETDOWN = 50;
|
|
|
+{* A socket operation failed because the network was down. *}
|
|
|
+
|
|
|
+ ENETUNREACH = 51;
|
|
|
+{* A socket operation failed because the subnet containing the remote
|
|
|
+ * host was unreachable.
|
|
|
+ *}
|
|
|
+
|
|
|
+ ENETRESET = 52;
|
|
|
+{* A network connection was reset because the remote host crashed. *}
|
|
|
+
|
|
|
+ ECONNABORTED = 53;
|
|
|
+{* A network connection was aborted locally. *}
|
|
|
+
|
|
|
+ ECONNRESET = 54;
|
|
|
+{* A network connection was closed for reasons outside the control of
|
|
|
+ * the local host, such as by the remote machine rebooting or an
|
|
|
+ * unrecoverable protocol violation.
|
|
|
+ *}
|
|
|
+
|
|
|
+ ENOBUFS = 55;
|
|
|
+{* The kernel's buffers for I/O operations are all in use. In GNU,
|
|
|
+ * this error is always synonymous with `ENOMEM'; you may get one or
|
|
|
+ * the other from network operations.
|
|
|
+ *}
|
|
|
+
|
|
|
+ EISCONN = 56;
|
|
|
+{* You tried to connect a socket that is already connected. *Note
|
|
|
+ * Connecting::.
|
|
|
+ *}
|
|
|
+
|
|
|
+ ENOTCONN = 57;
|
|
|
+{* The socket is not connected to anything. You get this error when
|
|
|
+ * you try to transmit data over a socket, without first specifying a
|
|
|
+ * destination for the data. For a connectionless socket (for
|
|
|
+ * datagram protocols, such as UDP), you get `EDESTADDRREQ' instead.
|
|
|
+ *}
|
|
|
+
|
|
|
+ ESHUTDOWN = 58;
|
|
|
+{* The socket has already been shut down. *}
|
|
|
+
|
|
|
+ ETOOMANYREFS = 59;
|
|
|
+{* ??? *}
|
|
|
+
|
|
|
+ ETIMEDOUT = 60;
|
|
|
+{* A socket operation with a specified timeout received no response
|
|
|
+ * during the timeout period.
|
|
|
+ *}
|
|
|
+
|
|
|
+ ECONNREFUSED = 61;
|
|
|
+{* A remote host refused to allow the network connection (typically
|
|
|
+ * because it is not running the requested service).
|
|
|
+ *}
|
|
|
+
|
|
|
+ ELOOP = 62;
|
|
|
+{* Too many levels of symbolic links were encountered in looking up a
|
|
|
+ * file name. This often indicates a cycle of symbolic links.
|
|
|
+ *}
|
|
|
+
|
|
|
+ ENAMETOOLONG = 63;
|
|
|
+{* Filename too long (longer than `PATH_MAX'; *note Limits for
|
|
|
+ * Files::.) or host name too long (in `gethostname' or
|
|
|
+ * `sethostname'; *note Host Identification::.).
|
|
|
+ *}
|
|
|
+
|
|
|
+ EHOSTDOWN = 64;
|
|
|
+{* The remote host for a requested network connection is down. *}
|
|
|
+
|
|
|
+ EHOSTUNREACH = 65;
|
|
|
+{* The remote host for a requested network connection is not
|
|
|
+ * reachable.
|
|
|
+ *}
|
|
|
+
|
|
|
+ ENOTEMPTY = 66;
|
|
|
+{* Directory not empty, where an empty directory was expected.
|
|
|
+ * Typically, this error occurs when you are trying to delete a
|
|
|
+ * directory.
|
|
|
+ *}
|
|
|
+
|
|
|
+ EPROCLIM = 67;
|
|
|
+{* This means that the per-user limit on new process would be
|
|
|
+ * exceeded by an attempted `fork'. *Note Limits on Resources::, for
|
|
|
+ * details on the `RLIMIT_NPROC' limit.
|
|
|
+ *}
|
|
|
+
|
|
|
+ EUSERS = 68;
|
|
|
+{* The file quota system is confused because there are too many users. *}
|
|
|
+
|
|
|
+ EDQUOT = 69;
|
|
|
+{* The user's disk quota was exceeded. *}
|
|
|
+
|
|
|
+ ESTALE = 70;
|
|
|
+{* Stale NFS file handle. This indicates an internal confusion in
|
|
|
+ * the NFS system which is due to file system rearrangements on the
|
|
|
+ * server host. Repairing this condition usually requires unmounting
|
|
|
+ * and remounting the NFS file system on the local host.
|
|
|
+ *}
|
|
|
+
|
|
|
+ EREMOTE = 71;
|
|
|
+{* An attempt was made to NFS-mount a remote file system with a file
|
|
|
+ * name that already specifies an NFS-mounted file. (This is an
|
|
|
+ * error on some operating systems, but we expect it to work properly
|
|
|
+ * on the GNU system, making this error code impossible.)
|
|
|
+ *}
|
|
|
+
|
|
|
+ EBADRPC = 72;
|
|
|
+{* ??? *}
|
|
|
+ ERPCMISMATCH = 73;
|
|
|
+{* ??? *}
|
|
|
+ EPROGUNAVAIL = 74;
|
|
|
+{* ??? *}
|
|
|
+ EPROGMISMATCH = 75;
|
|
|
+{* ??? *}
|
|
|
+ EPROCUNAVAIL = 76;
|
|
|
+{* ??? *}
|
|
|
+ ENOLCK = 77;
|
|
|
+{* No locks available. This is used by the file locking facilities;
|
|
|
+ * see *Note File Locks::. This error is never generated by the GNU
|
|
|
+ * system, but it can result from an operation to an NFS server
|
|
|
+ * running another operating system.
|
|
|
+ *}
|
|
|
+
|
|
|
+ ENOSYS = 78;
|
|
|
+{* Function not implemented. Some functions have commands or options
|
|
|
+ * defined that might not be supported in all implementations, and
|
|
|
+ * this is the kind of error you get if you request them and they are
|
|
|
+ * not supported.
|
|
|
+ *}
|
|
|
+
|
|
|
+ EFTYPE = 79;
|
|
|
+{* Inappropriate file type or format. The file was the wrong type
|
|
|
+ * for the operation, or a data file had the wrong format.
|
|
|
+ * On some systems `chmod' returns this error if you try to set the
|
|
|
+ * sticky bit on a non-directory file; *note Setting Permissions::..
|
|
|
+ *}
|
|
|
+
|
|
|
+
|
|
|
+type
|
|
|
+ PPChar = ^PChar;
|
|
|
+ Tcl_Argv = PPChar;
|
|
|
+ Tcl_ClientData = pointer;
|
|
|
+ Tcl_FreeProc = procedure(block : pointer); cdecl;
|
|
|
+ PTcl_Interp = ^Tcl_Interp;
|
|
|
+
|
|
|
+ Tcl_Interp = packed record
|
|
|
+ result : PChar; {* Do not access this directly. Use
|
|
|
+ * Tcl_GetStringResult since result
|
|
|
+ * may be pointing to an object
|
|
|
+ *}
|
|
|
+ freeProc : Tcl_FreeProc;
|
|
|
+ errorLine: integer;
|
|
|
+ end;
|
|
|
+
|
|
|
+{* Event Definitions *}
|
|
|
+ TTcl_EventSetupProc = procedure(clientData: Tcl_ClientData; flags: integer); cdecl;
|
|
|
+ TTcl_EventCheckProc = TTcl_EventSetupProc;
|
|
|
+
|
|
|
+ PTcl_Event = ^Tcl_Event;
|
|
|
+ TTcl_EventProc = function(evPtr: PTcl_Event; flags: integer): integer; cdecl;
|
|
|
+
|
|
|
+ Tcl_Event = packed record
|
|
|
+ proc : TTcl_EventProc;
|
|
|
+ nextPtr : PTcl_Event;
|
|
|
+ ClientData: TObject; {* ClientData is just pointer.*}
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+ PTcl_Time = ^Tcl_Time;
|
|
|
+ Tcl_Time = packed record
|
|
|
+ sec: longInt; { * Seconds. * }
|
|
|
+ usec: longInt; { * Microseconds. * }
|
|
|
+ end;
|
|
|
+
|
|
|
+ Tcl_TimerToken = pointer;
|
|
|
+ PInteger = ^integer;
|
|
|
+
|
|
|
+ PTcl_HashTable = pointer;
|
|
|
+ PTcl_HashEntry = ^Tcl_HashEntry;
|
|
|
+ PPTcl_HashEntry = ^PTcl_HashEntry;
|
|
|
+
|
|
|
+ Tcl_HashEntry = packed record
|
|
|
+ nextPtr : PTcl_HashEntry;
|
|
|
+ tablePtr : PTcl_HashTable;
|
|
|
+ bucketPtr : PPTcl_HashEntry;
|
|
|
+ clientData : Tcl_ClientData;
|
|
|
+ key : array[0..3] of Char;
|
|
|
+ end;
|
|
|
+{ case key: integer of
|
|
|
+ 0: (oneWordValue: pChar);
|
|
|
+ 1: (words : pInteger);
|
|
|
+ 2: (str : pChar);
|
|
|
+}
|
|
|
+ Tcl_HashFindProc = function(tablePtr: PTcl_HashTable; key: PChar): PTcl_HashEntry; cdecl;
|
|
|
+ Tcl_HashCreateProc = function(tablePtr: PTcl_HashTable; key: PChar; newPtr: PInteger): PTcl_HashEntry; cdecl;
|
|
|
+
|
|
|
+ PHashTable = ^Tcl_HashTable;
|
|
|
+ Tcl_HashTable = packed record
|
|
|
+ buckets : ppTcl_HashEntry;
|
|
|
+ staticBuckets : array[0..TCL_SMALL_HASH_TABLE - 1] of PTcl_HashEntry;
|
|
|
+ numBuckets : integer;
|
|
|
+ numEntries : integer;
|
|
|
+ rebuildSize : integer;
|
|
|
+ downShift : integer;
|
|
|
+ mask : integer;
|
|
|
+ keyType : integer;
|
|
|
+ findProc : Tcl_HashFindProc;
|
|
|
+ createProc : Tcl_HashCreateProc;
|
|
|
+ end;
|
|
|
+
|
|
|
+ PTcl_HashSearch = ^Tcl_HashSearch;
|
|
|
+ Tcl_HashSearch = packed record
|
|
|
+ tablePtr : PTcl_HashTable;
|
|
|
+ nextIndex : integer;
|
|
|
+ nextEntryPtr: PTcl_HashEntry;
|
|
|
+ end;
|
|
|
+
|
|
|
+ TTclAppInitProc = function(interp: pTcl_Interp): integer; cdecl;
|
|
|
+ TTclPackageInitProc = function(interp: pTcl_Interp): integer; cdecl;
|
|
|
+ TTclCmdProc = function(clientData : Tcl_ClientData; interp : pTcl_Interp; argc: integer; argv : Tcl_Argv): integer; cdecl;
|
|
|
+ TTclVarTraceProc = function (clientData: Tcl_ClientData; interp: pTcl_Interp;
|
|
|
+ varName: PChar; elemName: PChar; flags: integer): PChar; cdecl;
|
|
|
+ TTclFreeProc = procedure(block: pointer); cdecl;
|
|
|
+ TTclInterpDeleteProc = procedure(clientData: Tcl_ClientData; interp: pTcl_Interp); cdecl;
|
|
|
+ TTclCmdDeleteProc = procedure(clientData: Tcl_ClientData); cdecl;
|
|
|
+ TTclNamespaceDeleteProc = procedure(clientData: Tcl_ClientData); cdecl;
|
|
|
+
|
|
|
+
|
|
|
+const
|
|
|
+ TCL_DSTRING_STATIC_SIZE = 200;
|
|
|
+
|
|
|
+type
|
|
|
+ PTcl_DString = ^Tcl_DString;
|
|
|
+ Tcl_DString = packed record
|
|
|
+ str : PChar;
|
|
|
+ length : integer;
|
|
|
+ spaceAvl : integer;
|
|
|
+ staticSpace: array[0..TCL_DSTRING_STATIC_SIZE - 1] of char;
|
|
|
+ end;
|
|
|
+
|
|
|
+ PTcl_Channel = ^Tcl_Channel;
|
|
|
+ Tcl_Channel = packed record
|
|
|
+ end;
|
|
|
+
|
|
|
+ TTclDriverBlockModeProc = function(instanceData: Tcl_ClientData; mode: integer): integer; cdecl;
|
|
|
+ TTclDriverCloseProc = function(instanceData: Tcl_ClientData; interp: PTcl_Interp): integer; cdecl;
|
|
|
+ TTclDriverInputProc = function(instanceData: Tcl_ClientData; buf: PChar; toRead: integer;
|
|
|
+ errorCodePtr: PInteger): integer; cdecl;
|
|
|
+ TTclDriverOutputProc = function(instanceData: Tcl_ClientData; buf: PChar; toWrite: integer;
|
|
|
+ errorCodePtr: PInteger): integer; cdecl;
|
|
|
+ TTclDriverSeekProc = function(instanceData: Tcl_ClientData; offset: longint; mode: integer;
|
|
|
+ errorCodePtr: PInteger): integer; cdecl;
|
|
|
+ TTclDriverSetOptionProc = function(instanceData: Tcl_ClientData; interp: PTcl_Interp; optionName: PChar;
|
|
|
+ value: PChar): integer; cdecl;
|
|
|
+ TTclDriverGetOptionProc = function(instanceData: Tcl_ClientData; interp: pTcl_Interp; optionName: PChar;
|
|
|
+ dsPtr: PTcl_DString): integer; cdecl;
|
|
|
+ TTclDriverWatchProc = procedure(instanceData: Tcl_ClientData; mask: integer); cdecl;
|
|
|
+ TTclDriverGetHandleProc = function(instanceData: Tcl_ClientData; direction: integer;
|
|
|
+ var handlePtr: Tcl_ClientData): integer; cdecl;
|
|
|
+ PTcl_ChannelType = ^Tcl_ChannelType;
|
|
|
+ Tcl_ChannelType = packed record
|
|
|
+ typeName : PChar;
|
|
|
+ blockModeProc: TTclDriverBlockModeProc;
|
|
|
+ closeProc : TTclDriverCloseProc;
|
|
|
+ inputProc : TTclDriverInputProc;
|
|
|
+ ouputProc : TTclDriverOutputProc;
|
|
|
+ seekProc : TTclDriverSeekProc;
|
|
|
+ setOptionProc: TTclDriverSetOptionProc;
|
|
|
+ getOptionProc: TTclDriverGetOptionProc;
|
|
|
+ watchProc : TTclDriverWatchProc;
|
|
|
+ getHandleProc: TTclDriverGetHandleProc;
|
|
|
+ end;
|
|
|
+
|
|
|
+ TTclChannelProc = procedure(clientData: Tcl_ClientData; mask: integer); cdecl;
|
|
|
+
|
|
|
+ PTcl_Obj = ^Tcl_Obj;
|
|
|
+ PPTcl_Obj = ^PTcl_Obj;
|
|
|
+ Tcl_Obj = packed record
|
|
|
+ refCount: integer;
|
|
|
+ // ...
|
|
|
+ end;
|
|
|
+
|
|
|
+ TTclObjCmdProc = function(clientData: Tcl_ClientData; interp: PTcl_Interp; objc: integer; PPObj: PPTcl_Obj): integer; cdecl;
|
|
|
+
|
|
|
+ PTcl_Namespace = ^Tcl_Namespace;
|
|
|
+ Tcl_Namespace = packed record
|
|
|
+ name : pchar;
|
|
|
+ fullName : PChar;
|
|
|
+ clientData: Tcl_ClientData;
|
|
|
+ deleteProc: TTclNamespaceDeleteProc;
|
|
|
+ parentPtr : PTcl_Namespace;
|
|
|
+ end;
|
|
|
+
|
|
|
+ PTcl_CallFrame = ^Tcl_CallFrame;
|
|
|
+ Tcl_CallFrame = packed record
|
|
|
+ nsPtr : PTcl_Namespace;
|
|
|
+ dummy1 : integer;
|
|
|
+ dummy2 : integer;
|
|
|
+ dummy3 : PChar;
|
|
|
+ dummy4 : PChar;
|
|
|
+ dummy5 : PChar;
|
|
|
+ dummy6 : integer;
|
|
|
+ dummy7 : PChar;
|
|
|
+ dummy8 : PChar;
|
|
|
+ dummy9 : integer;
|
|
|
+ dummy10: PChar;
|
|
|
+ end;
|
|
|
+
|
|
|
+ PTcl_CmdInfo = ^Tcl_CmdInfo;
|
|
|
+ Tcl_CmdInfo = packed record
|
|
|
+ isNativeObjectProc: integer;
|
|
|
+ objProc : TTclObjCmdProc;
|
|
|
+ objClientData : Tcl_ClientData;
|
|
|
+ proc : TTclCmdProc;
|
|
|
+ clientData : Tcl_ClientData;
|
|
|
+ deleteProc : TTclCmdDeleteProc;
|
|
|
+ deleteData : Tcl_ClientData;
|
|
|
+ namespacePtr : pTcl_Namespace;
|
|
|
+ end;
|
|
|
+
|
|
|
+ pTcl_Command = ^Tcl_Command;
|
|
|
+ Tcl_Command = packed record
|
|
|
+ end;
|
|
|
+
|
|
|
+{ hPtr : pTcl_HashEntry;
|
|
|
+ nsPtr : pTcl_Namespace;
|
|
|
+ refCount : integer;
|
|
|
+ isCmdEpoch : integer;
|
|
|
+ compileProc : pointer;
|
|
|
+ objProc : pointer;
|
|
|
+ objClientData : Tcl_ClientData;
|
|
|
+ proc : pointer;
|
|
|
+ clientData : Tcl_ClientData;
|
|
|
+ deleteProc : TTclCmdDeleteProc;
|
|
|
+ deleteData : Tcl_ClientData;
|
|
|
+ deleted : integer;
|
|
|
+ importRefPtr : pointer;
|
|
|
+}
|
|
|
+
|
|
|
+type
|
|
|
+ ulong = longint;
|
|
|
+ uint = integer;
|
|
|
+ bool = longbool;
|
|
|
+
|
|
|
+ TTclPanicProc = procedure(fmt, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8: PChar); cdecl; // 1/15/97 orig. Tcl style
|
|
|
+ TTclClientDataProc = procedure (clientData: Tcl_ClientData); cdecl;
|
|
|
+ TTclIdleProc = procedure (clientData: Tcl_ClientData); cdecl;
|
|
|
+ TTclTimerProc = TTclIdleProc;
|
|
|
+ TTclCreateCloseHandler = procedure (channel: pTcl_Channel; proc: TTclClientDataProc; clientData: Tcl_ClientData); cdecl;
|
|
|
+ TTclDeleteCloseHandler = TTclCreateCloseHandler;
|
|
|
+ TTclEventDeleteProc = function(evPtr: pTcl_Event; clientData: Tcl_ClientData): integer; cdecl;
|
|
|
+
|
|
|
+ function Tcl_Alloc(size: Cardinal): PChar; cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_CreateInterp : pTcl_Interp; cdecl; external TCL_LIBRARY;
|
|
|
+ procedure Tcl_DeleteInterp(interp: pTcl_Interp); cdecl; external TCL_LIBRARY;
|
|
|
+ procedure Tcl_ResetResult(interp: pTcl_Interp); cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_Eval(interp: pTcl_Interp; script : PChar):integer; cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_EvalFile(interp: pTcl_Interp; filename: PChar):integer; cdecl; external TCL_LIBRARY;
|
|
|
+ procedure Tcl_AddErrorInfo(interp: pTcl_Interp; message: PChar); cdecl; external TCL_LIBRARY;
|
|
|
+ procedure Tcl_BackgroundError(interp: pTcl_Interp); cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_CreateCommand(interp: pTcl_Interp; name: PChar; cmdProc: TTclCmdProc;
|
|
|
+ clientData: Tcl_ClientData; deleteProc: TTclCmdDeleteProc): pTcl_Command; cdecl; external TCL_LIBRARY;
|
|
|
+
|
|
|
+ function Tcl_DeleteCommand(interp: pTcl_Interp; name: PChar): integer; cdecl; external TCL_LIBRARY;
|
|
|
+ procedure Tcl_CallWhenDeleted(interp: pTcl_Interp; proc: TTclInterpDeleteProc; clientData: Tcl_ClientData); cdecl; external TCL_LIBRARY;
|
|
|
+ procedure Tcl_DontCallWhenDeleted(interp: pTcl_Interp; proc: TTclInterpDeleteProc; clientData: Tcl_ClientData); cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_CommandComplete(cmd: PChar): integer; cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_LinkVar(interp: pTcl_Interp; varName: PChar; var addr; typ: integer): integer; cdecl; external TCL_LIBRARY;
|
|
|
+ procedure Tcl_UnlinkVar(interp: pTcl_Interp; varName: PChar); cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_TraceVar(interp: pTcl_Interp; varName: PChar; flags: integer; proc: TTclVarTraceProc;
|
|
|
+ clientData: Tcl_ClientData): integer; cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_TraceVar2(interp: pTcl_Interp; varName: PChar; elemName: PChar; flags : integer; proc: TTclVarTraceProc;
|
|
|
+ clientData: Tcl_ClientData): integer; cdecl; external TCL_LIBRARY;
|
|
|
+ procedure Tcl_UntraceVar(interp: pTcl_Interp; varName: PChar; flags: integer;
|
|
|
+ proc: TTclVarTraceProc; clientData: Tcl_ClientData); cdecl; external TCL_LIBRARY;
|
|
|
+ procedure Tcl_UntraceVar2(interp: pTcl_Interp; varName: PChar; elemName: PChar; flags: integer;
|
|
|
+ proc: TTclVarTraceProc; clientData: Tcl_ClientData); cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_GetVar(interp: pTcl_Interp; varName: PChar; flags: integer): PChar; cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_GetVar2(interp: pTcl_Interp; varName: PChar; elemName: PChar; flags: integer): PChar; cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_SetVar(interp: pTcl_Interp; varName: PChar; newValue: PChar; flags: integer): PChar; cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_SetVar2(interp: pTcl_Interp; varName: PChar; elemName: PChar; newValue: PChar; flags: integer): PChar; cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_UnsetVar(interp: pTcl_Interp; varName: PChar; flags: integer): integer; cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_UnsetVar2(interp: pTcl_Interp; varName: PChar; elemName: PChar; flags: integer): integer; cdecl; external TCL_LIBRARY;
|
|
|
+ procedure Tcl_SetResult(interp: pTcl_Interp; newValue: PChar; freeProc: TTclFreeProc); cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_FirstHashEntry(hashTbl: pTcl_HashTable; var searchInfo: Tcl_HashSearch): pTcl_HashEntry; cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_NextHashEntry(var searchInfo: Tcl_HashSearch): pTcl_HashEntry; cdecl; external TCL_LIBRARY;
|
|
|
+ procedure Tcl_InitHashTable(hashTbl: pTcl_HashTable; keyType: integer); cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_StringMatch(str: PChar; pattern: PChar): integer; cdecl; external TCL_LIBRARY;
|
|
|
+ function _Tcl_GetHashKey(hashTbl: pTcl_HashTable; hashEntry: pTcl_HashEntry): PChar; cdecl;
|
|
|
+ function Tcl_GetErrno:integer; cdecl; external TCL_LIBRARY;
|
|
|
+ procedure Tcl_SetErrno(val: integer); cdecl; external TCL_LIBRARY;
|
|
|
+
|
|
|
+
|
|
|
+ procedure Tcl_SetPanicProc(proc: TTclPanicProc); cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_PkgProvide(interp: pTcl_Interp; name: PChar; version: PChar): integer; cdecl; external TCL_LIBRARY;
|
|
|
+ procedure Tcl_StaticPackage(interp: pTcl_Interp; pkgName: PChar; initProc: TTclPackageInitProc;
|
|
|
+ safeInitProc: TTclPackageInitProc); cdecl; external TCL_LIBRARY;
|
|
|
+ procedure Tcl_CreateEventSource(setupProc: TTcl_EventSetupProc;
|
|
|
+ checkProc: TTcl_EventCheckProc; clientData: Tcl_ClientData); cdecl; external TCL_LIBRARY;
|
|
|
+ procedure Tcl_DeleteEventSource(setupProc: TTcl_EventSetupProc;
|
|
|
+ checkProc: TTcl_EventCheckProc; clientData: Tcl_ClientData); cdecl; external TCL_LIBRARY;
|
|
|
+ procedure Tcl_QueueEvent(evPtr: pTcl_Event; pos: integer); cdecl; external TCL_LIBRARY;
|
|
|
+ procedure Tcl_SetMaxBlockTime(timePtr: pTcl_Time); cdecl; external TCL_LIBRARY;
|
|
|
+
|
|
|
+ procedure Tcl_DeleteEvents(proc: TTclEventDeleteProc; clientData: Tcl_ClientData); cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_DoOneEvent(flags: integer): integer; cdecl; external TCL_LIBRARY;
|
|
|
+
|
|
|
+
|
|
|
+ procedure Tcl_DoWhenIdle(proc: TTclIdleProc; clientData: Tcl_ClientData); cdecl; external TCL_LIBRARY;
|
|
|
+ procedure Tcl_CancelIdleCall(proc: TTclIdleProc; clientData: Tcl_ClientData); cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_CreateTimerHandler(milliseconds: integer; proc: TTclTimerProc;
|
|
|
+ clientData: Tcl_ClientData): Tcl_TimerToken; cdecl; external TCL_LIBRARY;
|
|
|
+ procedure Tcl_DeleteTimerHandler(token: Tcl_TimerToken); cdecl; external TCL_LIBRARY;
|
|
|
+// procedure Tcl_CreateModalTimeout(milliseconds: integer; proc: TTclTimerProc; clientData: Tcl_ClientData); cdecl; external TCL_LIBRARY;
|
|
|
+// procedure Tcl_DeleteModalTimeout(proc: TTclTimerProc; clientData: Tcl_ClientData); cdecl; external TCL_LIBRARY;
|
|
|
+
|
|
|
+ function Tcl_SplitList(interp: pTcl_Interp; list: PChar; var argcPtr: integer; var argvPtr: Tcl_Argv): integer; cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_Merge(argc: integer; argv: Tcl_Argv):PChar; cdecl; external TCL_LIBRARY;
|
|
|
+ procedure Tcl_Free( ptr: PChar ); cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_Init(interp: pTcl_Interp): integer; cdecl; external TCL_LIBRARY;
|
|
|
+// procedure Tcl_InterpDeleteProc(clientData: Tcl_ClientData; interp: pTcl_Interp); cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_GetAssocData(interp:pTcl_Interp; key: PChar; var proc: TTclInterpDeleteProc): Tcl_ClientData; cdecl; external TCL_LIBRARY;
|
|
|
+ procedure Tcl_DeleteAssocData(interp: pTcl_Interp; key: PChar); cdecl; external TCL_LIBRARY;
|
|
|
+ procedure Tcl_SetAssocData(interp: pTcl_Interp; key: PChar; proc: TTclInterpDeleteProc;
|
|
|
+ clientData: Tcl_ClientData); cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_IsSafe(interp: pTcl_Interp): integer; cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_MakeSafe(interp: pTcl_Interp): integer; cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_CreateSlave(interp: pTcl_Interp; slaveName: PChar; isSafe: integer): pTcl_Interp; cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_GetSlave(interp: pTcl_Interp; slaveName: PChar): pTcl_Interp; cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_GetMaster(interp: pTcl_Interp): pTcl_Interp; cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_GetInterpPath(askingInterp: pTcl_Interp; slaveInterp: pTcl_Interp): integer; cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_CreateAlias(slaveInterp: pTcl_Interp; srcCmd: PChar; targetInterp: pTcl_Interp; targetCmd: PChar;
|
|
|
+ argc: integer; argv: Tcl_Argv): integer; cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_GetAlias(interp: pTcl_Interp; srcCmd: PChar; var targetInterp: pTcl_Interp; var targetCmd: PChar;
|
|
|
+ var argc: integer; var argv: Tcl_Argv): integer; cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_ExposeCommand(interp: pTcl_Interp; hiddenCmdName: PChar; cmdName: PChar): integer; cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_HideCommand(interp: pTcl_Interp; cmdName: PChar; hiddenCmdName: PChar): integer; cdecl; external TCL_LIBRARY;
|
|
|
+
|
|
|
+
|
|
|
+ procedure Tcl_EventuallyFree(clientData: Tcl_ClientData; freeProc: TTclFreeProc); cdecl; external TCL_LIBRARY;
|
|
|
+ procedure Tcl_Preserve(clientData: Tcl_ClientData); cdecl; external TCL_LIBRARY;
|
|
|
+ procedure Tcl_Release(clientData: Tcl_ClientData); cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_InterpDeleted(interp: pTcl_Interp): integer; cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_GetCommandInfo(interp: pTcl_Interp; cmdName: PChar; var info: Tcl_CmdInfo): integer; cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_SetCommandInfo(interp: pTcl_Interp; cmdName: PChar; var info: Tcl_CmdInfo): integer; cdecl; external TCL_LIBRARY;
|
|
|
+ procedure Tcl_FindExecutable(path: PChar); cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_GetStringResult(interp: pTcl_Interp): PChar; cdecl; external TCL_LIBRARY; //v1.0
|
|
|
+ function Tcl_FindCommand(interp: pTcl_Interp; cmdName: PChar;
|
|
|
+ contextNsPtr: pTcl_Namespace; flags: integer): Tcl_Command; cdecl; external TCL_LIBRARY; //v1.0
|
|
|
+ function Tcl_DeleteCommandFromToken(interp: pTcl_Interp; cmd: pTcl_Command): integer; cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_CreateNamespace(interp: pTcl_Interp; name: PChar; clientData: Tcl_ClientData;
|
|
|
+ deleteProc: TTclNamespaceDeleteProc): pTcl_Namespace; cdecl; external TCL_LIBRARY; //v1.0
|
|
|
+ procedure Tcl_DeleteNamespace(namespacePtr: pTcl_Namespace); cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_FindNamespace(interp: pTcl_Interp; name: PChar; contextNsPtr: pTcl_Namespace; flags: integer): pTcl_Namespace; cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_Export(interp: pTcl_Interp; namespacePtr: pTcl_Namespace; pattern: PChar;
|
|
|
+ resetListFirst: integer): integer; cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_Import(interp: pTcl_Interp; namespacePtr: pTcl_Namespace; pattern: PChar;
|
|
|
+ allowOverwrite: integer): integer; cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_GetCurrentNamespace(interp: pTcl_Interp): pTcl_Namespace; cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_GetGlobalNamespace(interp: pTcl_Interp): pTcl_Namespace; cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_PushCallFrame(interp: pTcl_Interp; var callFramePtr: Tcl_CallFrame;
|
|
|
+ namespacePtr: pTcl_Namespace; isProcCallFrame: integer): integer; cdecl; external TCL_LIBRARY;
|
|
|
+
|
|
|
+ procedure Tcl_PopCallFrame(interp: pTcl_Interp); cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_VarEval(interp: pTcl_Interp; args: array of const):integer; cdecl; external TCL_LIBRARY;
|
|
|
+
|
|
|
+{* For TkConsole.c *}
|
|
|
+ function Tcl_RecordAndEval(interp: pTcl_Interp; cmd: PChar; flags: integer): integer; cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_GlobalEval(interp: pTcl_Interp; command: PChar): integer; cdecl; external TCL_LIBRARY;
|
|
|
+ procedure Tcl_DStringFree(dsPtr: pTcl_DString); cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_DStringAppend(dsPtr: pTcl_DString; str: PChar; len: integer): PChar; cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_DStringAppendElement(dsPtr: pTcl_DString; str: PChar): PChar; cdecl; external TCL_LIBRARY;
|
|
|
+ procedure Tcl_DStringInit(dsPtr: pTcl_DString); cdecl; external TCL_LIBRARY;
|
|
|
+ procedure Tcl_AppendResult(interp: pTcl_Interp; args: array of const); cdecl; external TCL_LIBRARY; // actually a "C" var array
|
|
|
+ procedure Tcl_SetStdChannel(channel: pTcl_Channel; typ: integer); cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_SetChannelOption(interp: pTcl_Interp; chan: pTcl_Channel; optionName: PChar; newValue: PChar): integer; cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_GetChannelOption(interp: pTcl_Interp; chan: pTcl_Channel; optionName: PChar; dsPtr: pTcl_DString): integer; cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_CreateChannel(typePtr: pTcl_ChannelType; chanName: PChar;
|
|
|
+ instanceData: Tcl_ClientData; mask: integer):pTcl_Channel; cdecl; external TCL_LIBRARY;
|
|
|
+ procedure Tcl_RegisterChannel(interp: pTcl_Interp; channel: pTcl_Channel); cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_UnregisterChannel(interp: pTcl_Interp; channel: pTcl_Channel): integer; cdecl; external TCL_LIBRARY;
|
|
|
+
|
|
|
+ procedure Tcl_CreateChannelHandler(chan: pTcl_Channel; mask: integer; proc: TTclChannelProc; clientData: Tcl_ClientData); cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_GetChannel(interp: pTcl_Interp; chanName: PChar; modePtr: pInteger): pTcl_Channel; cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_GetStdChannel(typ: integer): pTcl_Channel; cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_Gets(chan: pTcl_Channel; dsPtr: pTcl_DString): integer; cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_Write(chan: pTcl_Channel; s: PChar; slen: integer): integer; cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_Flush(chan: pTcl_Channel): integer; cdecl; external TCL_LIBRARY;
|
|
|
+// TclWinLoadLibrary = function(name: PChar): HMODULE; cdecl; external TCL_LIBRARY;
|
|
|
+ procedure Tcl_CreateExitHandler(proc: TTclClientDataProc; clientData: Tcl_ClientData); cdecl; external TCL_LIBRARY;
|
|
|
+ procedure Tcl_DeleteExitHandler(proc: TTclClientDataProc; clientData: Tcl_ClientData); cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_GetStringFromObj(pObj: pTcl_Obj; pLen: pInteger): PChar; cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_CreateObjCommand(interp: pTcl_Interp; name: PChar; cmdProc: TTclObjCmdProc;
|
|
|
+ clientData: Tcl_ClientData; deleteProc: TTclCmdDeleteProc): pTcl_Command; cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_NewStringObj(bytes: PChar; len: integer): pTcl_Obj; cdecl; external TCL_LIBRARY;
|
|
|
+// procedure TclFreeObj(pObj: pTcl_Obj); cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_EvalObj(interp: pTcl_Interp; pObj: pTcl_Obj): integer; cdecl; external TCL_LIBRARY;
|
|
|
+ function Tcl_GlobalEvalObj(interp: pTcl_Interp; pObj: pTcl_Obj): integer; cdecl; external TCL_LIBRARY;
|
|
|
+ function TclRegComp(exp: PChar): pointer; cdecl; external TCL_LIBRARY;
|
|
|
+ function TclRegExec(prog: pointer; str: PChar; start: PChar): integer; cdecl; external TCL_LIBRARY;
|
|
|
+ procedure TclRegError(msg: PChar); cdecl; external TCL_LIBRARY;
|
|
|
+ function TclGetRegError: PChar; cdecl; external TCL_LIBRARY;
|
|
|
+ procedure Tcl_RegExpRange(prog: pointer; index: integer; var head: PChar; var tail: PChar); cdecl; external TCL_LIBRARY;
|
|
|
+
|
|
|
+// C Macro Emulation
|
|
|
+ function Tcl_GetCommandTable(interp: pTcl_Interp): pHashTable;
|
|
|
+ function Tcl_CreateHashEntry(tablePtr: pTcl_HashTable; key: PChar; newPtr: pInteger): pTcl_HashEntry;
|
|
|
+ function Tcl_FindHashEntry(tablePtr: pTcl_HashTable; key: PChar): pTcl_HashEntry;
|
|
|
+ procedure Tcl_SetHashValue(h: pTcl_HashEntry; clientData: Tcl_ClientData);
|
|
|
+ function Tcl_GetHashValue(h: pTcl_HashEntry): Tcl_ClientData;
|
|
|
+ procedure Tcl_IncrRefCount(pObj: pTcl_Obj); cdecl;
|
|
|
+ procedure Tcl_DecrRefCount(pObj: pTcl_Obj); cdecl;
|
|
|
+ function Tcl_IsShared(pObj: pTcl_Obj): integer; cdecl;
|
|
|
+
|
|
|
+{$IFDEF USE_C}
|
|
|
+ function ArgvItem(argv: PPChar; idx: integer): PChar; cdecl; external; // argv.c must be compiled by GCC
|
|
|
+{$ELSE}
|
|
|
+ function ArgvItem(argv: PPChar; idx: integer): PChar; cdecl;
|
|
|
+{$ENDIF}
|
|
|
+
|
|
|
+
|
|
|
+implementation
|
|
|
+uses SysUtils, Classes;
|
|
|
+
|
|
|
+
|
|
|
+// Macro emulation
|
|
|
+function Tcl_CreateHashEntry(tablePtr: pTcl_HashTable; key: PChar; newPtr: pInteger): pTcl_HashEntry;
|
|
|
+begin
|
|
|
+ result := pHashTable(tablePtr)^.createProc(tablePtr, key, newPtr);
|
|
|
+end;
|
|
|
+
|
|
|
+function Tcl_FindHashEntry(tablePtr: pTcl_HashTable; key: PChar): pTcl_HashEntry;
|
|
|
+begin
|
|
|
+ result := pHashTable(tablePtr)^.findProc(tablePtr, key);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure Tcl_SetHashValue(h: pTcl_HashEntry; clientData: Tcl_ClientData);
|
|
|
+begin
|
|
|
+ h^.clientData := clientData;
|
|
|
+end;
|
|
|
+
|
|
|
+function Tcl_GetHashValue(h: pTcl_HashEntry): Tcl_ClientData;
|
|
|
+begin
|
|
|
+ result := h^.clientData;
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+function _Tcl_GetHashKey(hashTbl: pTcl_HashTable; hashEntry: pTcl_HashEntry): PChar; cdecl;
|
|
|
+begin
|
|
|
+ if (hashTbl = nil) or (hashEntry = nil) then
|
|
|
+ result := nil
|
|
|
+ else if pHashTable(hashTbl)^.keyType = 1 then
|
|
|
+ result := PChar(pLongInt(@(hashEntry^.key[0]))^)
|
|
|
+ else
|
|
|
+ result := hashEntry^.key;
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+procedure Tcl_IncrRefCount(pObj: pTcl_Obj); cdecl;
|
|
|
+begin
|
|
|
+ inc(pObj^.refCount);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure Tcl_DecrRefCount(pObj: pTcl_Obj); cdecl;
|
|
|
+begin
|
|
|
+ dec(pObj^.refCount);
|
|
|
+ if pObj^.refCount <= 0 then
|
|
|
+ FreeMem(pObj);
|
|
|
+end;
|
|
|
+
|
|
|
+function Tcl_IsShared(pObj: pTcl_Obj): integer; cdecl;
|
|
|
+begin
|
|
|
+ if pObj^.refCount > 0 then
|
|
|
+ result := 1
|
|
|
+ else
|
|
|
+ result := 0;
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+function Tcl_GetCommandTable(interp: pTcl_Interp): pHashTable;
|
|
|
+begin
|
|
|
+ if interp = nil then
|
|
|
+ result := nil
|
|
|
+ else if TCL_VERSION_MAJOR >= 8 then // pretty sure it happened in this version
|
|
|
+ result := pHashTable(longint(interp) + sizeof(Tcl_Interp) + sizeof(pointer))
|
|
|
+ else
|
|
|
+ result := pHashTable(longint(interp) + sizeof(Tcl_Interp));
|
|
|
+end;
|
|
|
+
|
|
|
+{$IFNDEF USE_C}
|
|
|
+{*
|
|
|
+ * Use this if you don't have the C compiler and you're on
|
|
|
+ * the Intel platform.
|
|
|
+ * Otherwise define `USE_C` macro.
|
|
|
+ *}
|
|
|
+function ArgvItem(argv: PPChar; idx: integer): PChar; cdecl;
|
|
|
+var
|
|
|
+ Buf: LongWord;
|
|
|
+begin
|
|
|
+ asm
|
|
|
+ MOV EAX,idx //* index please
|
|
|
+ MOV EDX,[argv] //* gotcha argv^
|
|
|
+ MOV EAX,[EDX + EAX*4] //* PChar is 32bit pointer, so EAX*4 its offset for
|
|
|
+ //* one item in array.
|
|
|
+ //* gotcha something like this: (argv^)^[idx]
|
|
|
+ //*
|
|
|
+ MOV Buf,EAX
|
|
|
+ end;
|
|
|
+ ArgvItem:=PChar(Buf);
|
|
|
+end;
|
|
|
+{$ENDIF}
|
|
|
+
|
|
|
+end.
|
|
|
+
|
michael