karl@sugar.hackercorp.com (Karl Lehenbauer) (03/19/90)
#! /bin/sh
# This is a shell archive. Remove anything before this line, then feed it
# into a shell via "sh file" or similar. To overwrite existing files,
# type "sh file -c".
# The tool that generated this appeared in the comp.sources.unix newsgroup;
# send mail to comp-sources-unix@uunet.uu.net if you want that tool.
# If this archive is complete, you will see the following message at the end:
# "End of shell archive."
# Contents: ./help/list ./help/proc ./help/scan ./help/builtin.vars
# ./help/file ./help/if ./help/stdfile ./help/foreach
# ./help/windowevent ./help/eval ./help/concat ./help/print
# ./help/return ./src/tcl/tcl.c ./src/tcl/makefile ./includes/tcl.h
# ./includes/tcla.h ./includes/tcla/window.h
# ./includes/tcla/header.h ./includes/tcla/events.h
# ./includes/tcla/fonts.h ./includes/tcla/menu.h
# Wrapped by karl@sugar on Sun Mar 18 22:50:10 1990
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f './help/list' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'./help/list'\"
else
echo shar: Extracting \"'./help/list'\" \(792 characters\)
sed "s/^X//" >'./help/list' <<'END_OF_FILE'
X list arg1 arg2 ...
X This command returns a list comprised of all the args.
X Braces and backslashes get added as necessary, so that
X the index command may be used on the result to re-
X extract the original arguments, and also so that eval
X may be used to execute the resulting list, with arg1
X comprising the command's name and the other args
X comprising its arguments. List produces slightly
X different results than concat: concat removes one
X level of grouping before forming the list, while list
X works directly from the original arguments. For
X example, the command
X
X list a b {c d e} {f {g h}}
X
X will return
X
X a b {c d e} {f {g h}}
X
X while concat with the same arguments will return
X
X a b c d e f {g h}
X
END_OF_FILE
if test 792 -ne `wc -c <'./help/list'`; then
echo shar: \"'./help/list'\" unpacked with wrong size!
fi
# end of './help/list'
fi
if test -f './help/proc' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'./help/proc'\"
else
echo shar: Extracting \"'./help/proc'\" \(2635 characters\)
sed "s/^X//" >'./help/proc' <<'END_OF_FILE'
X proc name args body
X The proc command creates a new Tcl command procedure,
X name, replacing any existing command there may have
X been by that name. Whenever the new command is
X invoked, the contents of body will be executed by the
X Tcl interpreter. Args specifies the formal arguments
X to the procedure. It consists of a list, possibly
X empty, each of whose elements specifies one argument.
X
X Each argument specifier is also a list with either one
X or two fields. If there is only a single field in the
X specifier, then it is the name of the argument; if
X there are two fields, then the first is the argument
X name and the second is its default value. braces and
X backslashes may be used in the usual way to specify
X complex default values.
X
X When name is invoked, a local variable will be created
X for each of the formal arguments to the procedure; its
X value will be the value of corresponding argument in
X the invoking command or the argument's default value.
X Arguments with default values need not be specified in
X a procedure invocation. However, there must be enough
X actual arguments for all the formal arguments that
X don't have defaults, and there must not be any extra
X actual arguments. There is one special case to permit
X procedures with variable numbers of arguments. If the
X last formal argument has the name args, then a call to
X the procedure may contain more actual arguments than
X the procedure has formals. In this case, all of the
X actual arguments starting at the one that would be
X assigned to args are combined into a list (as if the
X list command had been used); this combined value is
X assigned to the local variable args.
X
X When body is being executed, variable names normally
X refer to local variables, which are created
X automatically when referenced and deleted when the
X procedure returns. One local variable is automatically
X created for each of the procedure's arguments. Global
X variables can only be accessed by invoking the global
X command.
X
X The proc command returns the null string. When a
X procedure is invoked, the procedure's return value is
X the value specified in a return command. If the
X procedure doesn't execute an explicit return, then its
X return value is the value of the last command executed
X in the procedure's body. If an error occurs while
X executing the procedure body, then the procedure-as-a-
X whole will return that same error.
X
END_OF_FILE
if test 2635 -ne `wc -c <'./help/proc'`; then
echo shar: \"'./help/proc'\" unpacked with wrong size!
fi
# end of './help/proc'
fi
if test -f './help/scan' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'./help/scan'\"
else
echo shar: Extracting \"'./help/scan'\" \(716 characters\)
sed "s/^X//" >'./help/scan' <<'END_OF_FILE'
X scan string format varname1 varname2 ...
X This command parses fields from an input string in the
X same fashion as the C sscanf procedure. String gives
X the input to be parsed and format indicates how to
X parse it, using % fields as in sscanf. All of the
X sscanf options are valid; see the sscanf man page for
X details. Each varname gives the name of a variable;
X when a field is scanned from string, the result is
X converted back into a string and assigned to the
X corresponding varname. The only unusual conversion is
X for %c; in this case, the character value is converted
X to a decimal string, which is then assigned to the
X corresponding varname.
X
END_OF_FILE
if test 716 -ne `wc -c <'./help/scan'`; then
echo shar: \"'./help/scan'\" unpacked with wrong size!
fi
# end of './help/scan'
fi
if test -f './help/builtin.vars' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'./help/builtin.vars'\"
else
echo shar: Extracting \"'./help/builtin.vars'\" \(445 characters\)
sed "s/^X//" >'./help/builtin.vars' <<'END_OF_FILE'
XBUILT-IN VARIABLES
X The following global variables are created and managed
X automatically by the Tcl library. These variables should
X normally be treated as read-only by application-specific
X code and by users.
X
X errorInfo
X After an error has occurred, this string will contain
X two or more lines identifying the Tcl commands and
X procedures that were being executed when the most
X recent error occurred.
X
END_OF_FILE
if test 445 -ne `wc -c <'./help/builtin.vars'`; then
echo shar: \"'./help/builtin.vars'\" unpacked with wrong size!
fi
# end of './help/builtin.vars'
fi
if test -f './help/file' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'./help/file'\"
else
echo shar: Extracting \"'./help/file'\" \(1911 characters\)
sed "s/^X//" >'./help/file' <<'END_OF_FILE'
X file name option
X Operate on a file or a file name. Name is the name of
X a file, and option indicates what to do with the file
X name. Any unique abbreviation for option is
X acceptable. The valid options are:
X
X file name dirname
X Return all of the characters in name up to but not
X including the last slash character. If there are
X no slashes in name then return ``.''. If the last
X slash in name is its first character, then return
X ``/''.
X
X file name executable
X Return 1 if file name is executable by the current
X user, 0 otherwise.
X
X file name exists
X Return 1 if file name exists and the current user
X has search privileges for the directories leading
X to it, 0 otherwise.
X
X file name extension
X Return all of the characters in name after and
X including the last dot in name. If there is no
X dot in name then return the empty string.
X
X file name isdirectory
X Return 1 if file name is a directory, 0 otherwise.
X
X file name isfile
X Return 1 if file name is a regular file, 0
X otherwise.
X
X file name owned
X Return 1 if file name is owned by the current
X user, 0 otherwise.
X
X file name readable
X Return 1 if file name is readable by the current
X user, 0 otherwise.
X
X file name rootname
X Return all of the characters in name up to but not
X including the last ``.'' character in the name.
X If name doesn't contain a dot, then return name.
X
X file name tail
X Return all of the characters in name after the
X last slash. If name contains no slashes then
X return name.
X
X file name writable
X Return 1 if file name is writable by the current
X user, 0 otherwise.
X
X The file commands that return 0/1 results are often
X used in conditional or looping commands, for example:
X
X if {![file foo exists]} then {error {bad file name}} else {...}
X
END_OF_FILE
if test 1911 -ne `wc -c <'./help/file'`; then
echo shar: \"'./help/file'\" unpacked with wrong size!
fi
# end of './help/file'
fi
if test -f './help/if' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'./help/if'\"
else
echo shar: Extracting \"'./help/if'\" \(750 characters\)
sed "s/^X//" >'./help/if' <<'END_OF_FILE'
X if test [then] trueBody [[else] falseBody]
X The if command evaluates test as an expression (in the
X same way that expr evaluates its argument). If the
X result is non-zero then trueBody is called by passing
X it to the Tcl interpreter. Otherwise falseBody is
X executed by passing it to the Tcl interpreter. The
X then and else arguments are optional ``noise words'' to
X make the command easier to read. FalseBody is also
X optional; if it isn't specified then the command does
X nothing if test evaluates to zero. The return value
X from if is the value of the last command executed in
X trueBody or falseBody, or the empty string if test
X evaluates to zero and falseBody isn't specified.
X
END_OF_FILE
if test 750 -ne `wc -c <'./help/if'`; then
echo shar: \"'./help/if'\" unpacked with wrong size!
fi
# end of './help/if'
fi
if test -f './help/stdfile' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'./help/stdfile'\"
else
echo shar: Extracting \"'./help/stdfile'\" \(621 characters\)
sed "s/^X//" >'./help/stdfile' <<'END_OF_FILE'
X
X
Xstdfile - standard file requester
X
XCall TclaInitStdfile(interp) to install the stdfile file requester
Xcommand into your Tcl interpreter.
X
XOnce installed, you can call up a file requester as follows:
X
X stdfile title default_file default_pattern
X
X
XThis uses the file requester written by Peter da Silva. It has been
Xfairly widely distributed. It is not the greatest file requester in
Xthe world, but it shouldn't take too much effort to greatly improve
Xit, or maybe somebody will hack a better one in there, and redistribute
Xit.
X
Xstdfile returns a string containing the name of the file requested, or
Xan empty string.
END_OF_FILE
if test 621 -ne `wc -c <'./help/stdfile'`; then
echo shar: \"'./help/stdfile'\" unpacked with wrong size!
fi
# end of './help/stdfile'
fi
if test -f './help/foreach' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'./help/foreach'\"
else
echo shar: Extracting \"'./help/foreach'\" \(580 characters\)
sed "s/^X//" >'./help/foreach' <<'END_OF_FILE'
X foreach varname list body
X In this command, varname is the name of a variable,
X list is a list of values to assign to varname, and body
X is a collection of Tcl commands. For each field in
X list (in order from left to right), foreach assigns the
X contents of the field to varname (as if the index
X command had been used to extract the field), then calls
X the Tcl interpreter to execute body. The break and
X continue statements may be invoked inside body, with
X the same effect as in the for command. Foreach an
X empty string.
X
END_OF_FILE
if test 580 -ne `wc -c <'./help/foreach'`; then
echo shar: \"'./help/foreach'\" unpacked with wrong size!
fi
# end of './help/foreach'
fi
if test -f './help/windowevent' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'./help/windowevent'\"
else
echo shar: Extracting \"'./help/windowevent'\" \(611 characters\)
sed "s/^X//" >'./help/windowevent' <<'END_OF_FILE'
X
XYou do a
X
X windowevent attach eventtype routine
X
XTo attach a Tcl routine to a window message event type. The events
Xsupported are:
X
X newsize
X refreshwindow
X mousebuttons
X menupick
X closewindow
X vanillakeys
X rawkeys
X intuiticks
X activewindow
X inactivewindow
X newprefs
X diskinserted
X diskremoved
X
X
Xif routine is an empty string, detaches current event
Xif you attach a routine to an event that already has
Xa routine attached, the old one goes away
Xget returns the current routine or empty string if there
Xisn't one attached
X
X windowevent get eventtype
X
X"windowevent detach" allows you to detach window events.
X
X
END_OF_FILE
if test 611 -ne `wc -c <'./help/windowevent'`; then
echo shar: \"'./help/windowevent'\" unpacked with wrong size!
fi
# end of './help/windowevent'
fi
if test -f './help/eval' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'./help/eval'\"
else
echo shar: Extracting \"'./help/eval'\" \(442 characters\)
sed "s/^X//" >'./help/eval' <<'END_OF_FILE'
X eval arg1 arg2 ...
X Eval takes one or more arguments, which together
X comprise a Tcl command (or collection of Tcl commands
X separated by newlines in the usual way). Eval
X concatenates all its arguments in the same fashion as
X the concat command, passes the concatenated string to
X the Tcl interpreter recursively, and returns the result
X of that evaluation (or any error generated by it).
X
END_OF_FILE
if test 442 -ne `wc -c <'./help/eval'`; then
echo shar: \"'./help/eval'\" unpacked with wrong size!
fi
# end of './help/eval'
fi
if test -f './help/concat' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'./help/concat'\"
else
echo shar: Extracting \"'./help/concat'\" \(290 characters\)
sed "s/^X//" >'./help/concat' <<'END_OF_FILE'
X concat arg arg ...
X This command treats each argument as a list and
X concatenates them into a single list. It permits any
X number of arguments. For example, the command
X
X concat a b {c d e} {f {g h}}
X
X will return
X
X a b c d e f {g h}
X
X as its result.
X
END_OF_FILE
if test 290 -ne `wc -c <'./help/concat'`; then
echo shar: \"'./help/concat'\" unpacked with wrong size!
fi
# end of './help/concat'
fi
if test -f './help/print' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'./help/print'\"
else
echo shar: Extracting \"'./help/print'\" \(387 characters\)
sed "s/^X//" >'./help/print' <<'END_OF_FILE'
X print string [file [append]]
X
X Print the string argument. If no file is specified
X then string is output to the standard output file. If
X file is specified, then string is output to that file.
X If the append option is given, then string is appended
X to file; otherwise any existing contents of file are
X discarded before string is written to the file.
X
END_OF_FILE
if test 387 -ne `wc -c <'./help/print'`; then
echo shar: \"'./help/print'\" unpacked with wrong size!
fi
# end of './help/print'
fi
if test -f './help/return' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'./help/return'\"
else
echo shar: Extracting \"'./help/return'\" \(234 characters\)
sed "s/^X//" >'./help/return' <<'END_OF_FILE'
X return [value]
X Return immediately from the current procedure (or top-
X level command or source command), with value as the
X return value. If value is not specified, an empty
X string will be returned as result.
X
END_OF_FILE
if test 234 -ne `wc -c <'./help/return'`; then
echo shar: \"'./help/return'\" unpacked with wrong size!
fi
# end of './help/return'
fi
if test -f './src/tcl/tcl.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'./src/tcl/tcl.c'\"
else
echo shar: Extracting \"'./src/tcl/tcl.c'\" \(4326 characters\)
sed "s/^X//" >'./src/tcl/tcl.c' <<'END_OF_FILE'
X/*
X * Tcl command -- provide a Tcl CLI-command with awk-like command syntax
X *
X * Copyright 1990 Hackercorp
X * Permission to use, copy, modify, and distribute this
X * software and its documentation for any purpose and without
X * fee is hereby granted, provided that the above copyright
X * notice appear in all copies. Hackercorp makes no
X * representations about the suitability of this software for
X * any purpose. It is provided "as is" without express or
X * implied warranty.
X *
X * usage:
X *
X * tcl [-f tcl_source_filename] [-p portname] [args...]
X *
X * tcl command [args...]
X *
X * tcl
X */
X
X#include <stdlib.h>
X#include <functions.h>
X#include <tcl.h>
X#include <tcla.h>
X
Xstruct TclaBase *TclaBase = NULL;
X
X#define ABORT_TEXT "program aborted\n"
X#define LIBRARY_TEXT "unable to open tcla.library"
X
Xvoid _abort(void)
X{
X if (TclaBase != (struct TclaBase *)NULL)
X CloseLibrary(TclaBase);
X Write(Output(),ABORT_TEXT,sizeof(ABORT_TEXT));
X exit(1);
X}
X
Xvoid
Xprint_result(int returnval, char *result_text)
X{
X BPTR Out = Output();
X
X if (returnval == TCL_OK) {
X if (*result_text != 0) {
X Write(Out, result_text, strlen(result_text));
X Write(Out, "\n", 1);
X }
X } else {
X if (returnval == TCL_ERROR) {
X Write(Out, "Error", 5);
X } else {
X Write(Out, "Error (and bad return)", 22);
X }
X if (*result_text != 0) {
X Write(Out, ": ", 2);
X Write(Out, result_text, strlen(result_text));
X }
X Write(Out, "\n", 1);
X }
X}
X
Xusage()
X{
X print_result(TCL_ERROR, "usage: tcl [-f filename] [-p portname] [args..]");
X _abort();
X}
X
Xint
Xmain(int argc, char **argv)
X{
X Tcl_Interp *interp;
X int result;
X char *inputfile = NULL;
X char *command = NULL;
X char *portname = NULL;
X int argsleft, nextarg;
X struct TclaHeader *TclaHead;
X
X if ((TclaBase = OpenLibrary("tcla.library", 0L)) == 0)
X {
X Write(Output(),LIBRARY_TEXT,sizeof(LIBRARY_TEXT));
X exit(1);
X }
X
X interp = Tcl_CreateInterp();
X
X /* set up the Tcl argv variable to an empty string
X *
X /* if no arguments, give the user a Tcl command prompt
X *
X * if there's a "-f" followed by something, that's a filename
X * for Tcl to load
X *
X * if there's a "-p" followed by something, that's a portname
X * for Tcl to use instead of it's argv[0] (program name)
X *
X * if no "-f" was specified and there is at least one argument
X * besides the "-p", the first argument is a command to be
X * evaluated by Tcl and the remaining arguments, if any, are
X * set up as the global varibale argv
X *
X * if there are arguments left over after any "-f filename," they
X * are merged into the argv variable in the same manner
X */
X
X /* set the argv to null so it'll be there even if we don't have
X * any args, which is desirable */
X Tcl_SetVar(interp, "argv", "", 1);
X
X /* argsleft = all but program name (argv[0]), next arg is 1 */
X argsleft = argc - 1;
X nextarg = 1;
X
X while (argsleft > 0)
X {
X
X if (strcmp(argv[nextarg],"-f") == 0)
X {
X if (argsleft < 2)
X usage();
X
X inputfile = argv[nextarg+1];
X nextarg += 2;
X argsleft -= 2;
X }
X else if (strcmp(argv[nextarg],"-p") == 0)
X {
X if (argsleft < 2)
X usage();
X
X portname = argv[nextarg+1];
X nextarg += 2;
X argsleft -= 2;
X }
X else
X {
X /* if we don't have an input file, the next arg is the command*/
X if (inputfile == NULL)
X {
X command = argv[nextarg++];
X argsleft--;
X }
X
X /* if there are any args left, they are destined for the argv */
X if (argsleft > 0)
X {
X char *args;
X args = Tcl_Merge(argsleft, &argv[nextarg]);
X Tcl_SetVar(interp, "argv", args, 1);
X ckfree(args);
X argsleft = 0;
X }
X }
X }
X
X TclaHead = Tcla_Init(interp, argv[0], portname);
X Tcla_CleanupRoutine(TclaHead, _abort); /* call this if Tcla panics */
X
X /* if they specified a file, source it */
X if (inputfile)
X {
X char s[80];
X strcpy(s,"source ");
X strcat(s,inputfile);
X result = Tcl_Eval(interp, s, 0, NULL);
X print_result(result, interp->result);
X }
X else if (command) /* else if they specified a command, evaluate it */
X {
X result = Tcl_Eval(interp, command, 0, NULL);
X print_result(result, interp->result);
X }
X else /* else source startup.tcl and run the command loop */
X {
X Tcl_Eval(interp, "source tclprocs:startup.tcl", 0, NULL);
X Tcl_Eval(interp, "commandloop", 0, NULL);
X }
X
X /* cleanup and exit */
X Tcl_DeleteInterp(interp);
X CloseLibrary(TclaBase);
X exit(0);
X}
X
END_OF_FILE
if test 4326 -ne `wc -c <'./src/tcl/tcl.c'`; then
echo shar: \"'./src/tcl/tcl.c'\" unpacked with wrong size!
fi
# end of './src/tcl/tcl.c'
fi
if test -f './src/tcl/makefile' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'./src/tcl/makefile'\"
else
echo shar: Extracting \"'./src/tcl/makefile'\" \(133 characters\)
sed "s/^X//" >'./src/tcl/makefile' <<'END_OF_FILE'
X
X
X
Xtcl: tcl.o
X ln -o tcl tcl.o -lc
X
Xtcl.o: tcl.c
X cc -so tcl.c
X
Xclean:
X -delete #?.o quiet
X -delete tcl quiet
X -delete #?.bak quiet
END_OF_FILE
if test 133 -ne `wc -c <'./src/tcl/makefile'`; then
echo shar: \"'./src/tcl/makefile'\" unpacked with wrong size!
fi
# end of './src/tcl/makefile'
fi
if test -f './includes/tcl.h' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'./includes/tcl.h'\"
else
echo shar: Extracting \"'./includes/tcl.h'\" \(6588 characters\)
sed "s/^X//" >'./includes/tcl.h' <<'END_OF_FILE'
X/*
X * tcl.h --
X *
X * This header file describes the externally-visible facilities
X * of the Tcl interpreter.
X *
X * Copyright 1987 Regents of the University of California
X * Permission to use, copy, modify, and distribute this
X * software and its documentation for any purpose and without
X * fee is hereby granted, provided that the above copyright
X * notice appear in all copies. The University of California
X * makes no representations about the suitability of this
X * software for any purpose. It is provided "as is" without
X * express or implied warranty.
X *
X * $Header: /sprite/src/lib/tcl/RCS/tcl.h,v 1.33 90/01/15 14:06:02 ouster Exp $ SPRITE (Berkeley)
X */
X
X#ifndef _TCL
X#define _TCL
X
X#define TCL_VERSION "2.1"
X
X/*
X * Data structures defined opaquely in this module. The definitions
X * below just provide dummy types. A few fields are made visible in
X * Tcl_Interp structures, namely those for returning string values.
X * Note: any change to the Tcl_Interp definition below must be mirrored
X * in the "real" definition in tclInt.h.
X */
X
Xtypedef struct {
X char *result; /* Points to result string returned by last
X * command. */
X int dynamic; /* Non-zero means result is dynamically-
X * allocated and must be freed by Tcl_Eval
X * before executing the next command. */
X int errorLine; /* When TCL_ERROR is returned, this gives
X * the line number within the command where
X * the error occurred (1 means first line). */
X} Tcl_Interp;
Xtypedef int *Tcl_Trace;
X
X/*
X * When a TCL command returns, the string pointer interp->result points to
X * a string containing return information from the command. In addition,
X * the command procedure returns an integer value, which is one of the
X * following:
X *
X * TCL_OK Command completed normally; interp->result contains
X * the command's result.
X * TCL_ERROR The command couldn't be completed successfully;
X * interp->result describes what went wrong.
X * TCL_RETURN The command requests that the current procedure
X * return; interp->result contains the procedure's
X * return value.
X * TCL_BREAK The command requests that the innermost loop
X * be exited; interp->result is meaningless.
X * TCL_CONTINUE Go on to the next iteration of the current loop;
X * interp->result is meaninless.
X */
X
X#define TCL_OK 0
X#define TCL_ERROR 1
X#define TCL_RETURN 2
X#define TCL_BREAK 3
X#define TCL_CONTINUE 4
X
X#define TCL_RESULT_SIZE 199
X
X/*
X * Flag values passed to Tcl_Eval (see the man page for details):
X */
X
X#define TCL_BRACKET_TERM 1
X
X/*
X * Flag values passed to Tcl_Return (see the man page for details):
X */
X
X#define TCL_STATIC 0
X#define TCL_DYNAMIC 1
X#define TCL_VOLATILE 2
X
X/*
X * Exported Tcl procedures:
X */
X
Xvoid panic(char *format, ...);
Xvoid *ckalloc(size_t len);
Xvoid ckfree(void *what);
X
Xvoid Tcl_AddErrorInfo(Tcl_Interp *interp, char *message);
Xchar Tcl_Backslash(char *src, int *readPtr);
Xchar *Tcl_Concat(int argc, char **argv);
Xvoid Tcl_CreateCommand(Tcl_Interp *interp, char *cmdName, int (*proc)(),
X int *clientData, void (*deleteProc)());
X
XTcl_Interp *Tcl_CreateInterp(void);
Xint *Tcl_CreateTrace(Tcl_Interp *interp, int level, void (*proc)(),
X int *clientData);
Xvoid Tcl_DeleteCommand(Tcl_Interp *interp, char *cmdName);
Xvoid Tcl_DeleteInterp(Tcl_Interp *interp);
Xvoid Tcl_DeleteTrace(Tcl_Interp *interp, int *trace);
X
Xint Tcl_Eval(Tcl_Interp *interp, char *cmd, int flags, char **termPtr);
Xint Tcl_Expr(Tcl_Interp *interp, char *string, int *valuePtr);
Xchar *Tcl_GetVar(Tcl_Interp *interp, char *varName, int global);
Xchar *Tcl_Merge(int argc, char **argv);
Xchar *Tcl_ParseVar(Tcl_Interp *interp, char *string, char **termPtr);
Xvoid Tcl_Return(Tcl_Interp *interp, char *string, int status);
Xvoid Tcl_SetVar(Tcl_Interp *interp, char *varName, char *newValue,
X int global);
Xint Tcl_SplitList(Tcl_Interp *interp, char *list, int *argcPtr,
X char ***argvPtr);
Xint Tcl_StringMatch(char *string, char *pattern);
Xvoid Tcl_WatchInterp(Tcl_Interp *interp, void (*proc)(), int *clientData);
X
X/*
X * Built-in Tcl command procedures:
X */
X
Xint Tcl_BreakCmd(int *dummy, Tcl_Interp *interp, int argc, char **argv);
Xint Tcl_CaseCmd(int *dummy, Tcl_Interp *interp, int argc, char **argv);
Xint Tcl_CatchCmd(int *dummy, Tcl_Interp *interp, int argc, char **argv);
Xint Tcl_ConcatCmd(int *dummy, Tcl_Interp *interp, int argc, char **argv);
Xint Tcl_ContinueCmd(int *dummy, Tcl_Interp *interp, int argc, char **argv);
Xint Tcl_ErrorCmd(int *dummy, Tcl_Interp *interp, int argc, char **argv);
Xint Tcl_EvalCmd(int *dummy, Tcl_Interp *interp, int argc, char **argv);
Xint Tcl_ExecCmd(int *dummy, Tcl_Interp *interp, int argc, char **argv);
Xint Tcl_ExprCmd(int *dummy, Tcl_Interp *interp, int argc, char **argv);
Xint Tcl_FileCmd(int *dummy, Tcl_Interp *interp, int argc, char **argv);
Xint Tcl_ForCmd(int *dummy, Tcl_Interp *interp, int argc, char **argv);
Xint Tcl_ForeachCmd(int *dummy, Tcl_Interp *interp, int argc, char **argv);
Xint Tcl_FormatCmd(int *dummy, Tcl_Interp *interp, int argc, char **argv);
Xint Tcl_GlobalCmd(int *dummy, Tcl_Interp *interp, int argc, char **argv);
X
Xint Tcl_IfCmd(int *dummy, Tcl_Interp *interp, int argc, char **argv);
Xint Tcl_InfoCmd(int *dummy, Tcl_Interp *interp, int argc, char **argv);
Xint Tcl_IndexCmd(int *dummy, Tcl_Interp *interp, int argc, char **argv);
Xint Tcl_LengthCmd(int *dummy, Tcl_Interp *interp, int argc, char **argv);
Xint Tcl_ListCmd(int *dummy, Tcl_Interp *interp, int argc, char **argv);
Xint Tcl_PrintCmd(int *notUsed, Tcl_Interp *interp, int argc, char **argv);
Xint Tcl_ProcCmd(int *dummy, Tcl_Interp *interp, int argc, char **argv);
Xint Tcl_RangeCmd(int *notUsed, Tcl_Interp *interp, int argc, char **argv);
Xint Tcl_RenameCmd(int *dummy, Tcl_Interp *interp, int argc, char **argv);
Xint Tcl_ReturnCmd(int *dummy, Tcl_Interp *interp, int argc, char **argv);
Xint Tcl_ScanCmd(int *dummy, Tcl_Interp *interp, int argc, char **argv);
Xint Tcl_SetCmd(int *dummy, Tcl_Interp *interp, int argc, char **argv);
Xint Tcl_SourceCmd(int *dummy, Tcl_Interp *interp, int argc, char **argv);
Xint Tcl_StringCmd(int *dummy, Tcl_Interp *interp, int argc, char **argv);
Xint Tcl_TimeCmd(int *dummy, Tcl_Interp *interp, int argc, char **argv);
Xint Tcl_UplevelCmd(int *dummy, Tcl_Interp *interp, int argc, char **argv);
X
X/*
X * Miscellaneous declarations (to allow Tcl to be used stand-alone,
X * without the rest of Sprite).
X */
X#ifndef _CLIENTDATA
Xtypedef int *ClientData;
X#define _CLIENTDATA
X#endif
X
X#ifndef NULL
X#define NULL 0
X#endif
X
X/* Portability stuff */
X#ifndef BSD
X#define bcopy(f,t,l) memcpy(t,f,l)
X#endif
X
X#endif /* _TCL */
X
X
END_OF_FILE
if test 6588 -ne `wc -c <'./includes/tcl.h'`; then
echo shar: \"'./includes/tcl.h'\" unpacked with wrong size!
fi
# end of './includes/tcl.h'
fi
if test -f './includes/tcla.h' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'./includes/tcla.h'\"
else
echo shar: Extracting \"'./includes/tcla.h'\" \(4096 characters\)
sed "s/^X//" >'./includes/tcla.h' <<'END_OF_FILE'
X/* tcla.h - tool command language -- amiga, header file */
X
X/* the structure we send around amongst our Amiga Tcl message ports... */
X
X#include <exec/libraries.h>
X#include <exec/ports.h>
X
Xstruct AmigaTclMessage {
X struct Message message;
X char *request;
X char *result;
X char *callback;
X char *termptr;
X int returnval;
X int errorline;
X};
X
Xstruct TclaBase {
X struct Library ml_Lib;
X unsigned long ml_SegList; /* seg list of mylib itself*/
X long ml_value;
X};
X
Xvoid *ckalloc(size_t len);
Xvoid ckfree(void *what);
Xvoid Tcl_AddErrorInfo(Tcl_Interp *interp, char *message);
Xchar Tcl_Backslash(char *src, int *readPtr);
Xchar *Tcl_Concat(int argc, char **argv);
Xvoid Tcl_CreateCommand(Tcl_Interp *interp, char *cmdName, int (*proc)(),
X int *clientData, void (*deleteProc)());
XTcl_Interp *Tcl_CreateInterp(void);
Xint *Tcl_CreateTrace(Tcl_Interp *interp, int level, void (*proc)(),
X int *clientData);
Xvoid Tcl_DeleteCommand(Tcl_Interp *interp, char *cmdName);
Xvoid Tcl_DeleteInterp(Tcl_Interp *interp);
Xvoid Tcl_DeleteTrace(Tcl_Interp *interp, int *trace);
Xint Tcl_Eval(Tcl_Interp *interp, char *cmd, int flags, char **termPtr);
Xint Tcl_Expr(Tcl_Interp *interp, char *string, int *valuePtr);
Xchar *Tcl_GetVar(Tcl_Interp *interp, char *varName, int global);
Xchar *Tcl_Merge(int argc, char **argv);
Xchar *Tcl_ParseVar(Tcl_Interp *interp, char *string, char **termPtr);
Xvoid Tcl_Return(Tcl_Interp *interp, char *string, int status);
Xvoid Tcl_SetVar(Tcl_Interp *interp, char *varName, char *newValue,
X int global);
Xint Tcl_SplitList(Tcl_Interp *interp, char *list, int *argcPtr,
X char ***argvPtr);
Xint Tcl_StringMatch(char *string, char *pattern);
Xvoid Tcl_WatchInterp(Tcl_Interp *interp, void (*proc)(), int *clientData);
Xvoid *LocateResource(char *groupname, char *itemname);
Xint ConnectResource(char *groupname, char *resourcename, void *data);
Xvoid *DisconnectResource(char *groupname, char *resourcename);
Xstruct TclaHeader *Tcla_Init(Tcl_Interp *interp, char *progname, char *portname);
Xint Tcla_Send(char *program, char *message, char **result);
Xvoid Tcla_AddEventLoop(Tcl_Interp *interp, struct TclaHeader *thp, void (*func)(), long *waitmask_ptr);
Xvoid Tcla_CleanupRoutine(struct TclaHeader *TclaHead, void (*cleanup_routine)(void));
Xvoid Tcla_PanicRoutine(struct TclaHeader *TclaHead, void (*panic_routine)(char *));
Xvoid Tcla_LowMemRoutine(struct TclaHeader *TclaHead, int (*lowmem_routine)(long));
X
X
X#pragma amicall(TclaBase, 0x1e, ckalloc(d0))
X#pragma amicall(TclaBase, 0x24, ckfree(a0))
X#pragma amicall(TclaBase, 0x2a, Tcl_AddErrorInfo(a0,a1))
X#pragma amicall(TclaBase, 0x30, Tcl_Backslash(a0,a1))
X#pragma amicall(TclaBase, 0x36, Tcl_Concat(d0,a0))
X#pragma amicall(TclaBase, 0x3c, Tcl_CreateCommand(a0,a1,a2,a3,d0))
X#pragma amicall(TclaBase, 0x42, Tcl_CreateInterp())
X#pragma amicall(TclaBase, 0x48, Tcl_CreateTrace(a0,d0,a1,a2))
X#pragma amicall(TclaBase, 0x4e, Tcl_DeleteCommand(a0,a1))
X#pragma amicall(TclaBase, 0x54, Tcl_DeleteInterp(a0))
X#pragma amicall(TclaBase, 0x5a, Tcl_DeleteTrace(a0,a1))
X#pragma amicall(TclaBase, 0x60, Tcl_Eval(a0,a1,d0,a2))
X#pragma amicall(TclaBase, 0x66, Tcl_Expr(a0,a1,a2))
X#pragma amicall(TclaBase, 0x6c, Tcl_GetVar(a0,a1,d0))
X#pragma amicall(TclaBase, 0x72, Tcl_Merge(d0,a0))
X#pragma amicall(TclaBase, 0x78, Tcl_ParseVar(a0,a1,a2))
X#pragma amicall(TclaBase, 0x7e, Tcl_Return(a0,a1,d0))
X#pragma amicall(TclaBase, 0x84, Tcl_SetVar(a0,a1,a2,d0))
X#pragma amicall(TclaBase, 0x8a, Tcl_SplitList(a0,a1,a2,a3))
X#pragma amicall(TclaBase, 0x90, Tcl_StringMatch(a0,a1))
X#pragma amicall(TclaBase, 0x96, Tcl_WatchInterp(a0,a1,a2))
X#pragma amicall(TclaBase, 0x9c, LocateResource(a0,a1))
X#pragma amicall(TclaBase, 0xa2, ConnectResource(a0,a1,a2))
X#pragma amicall(TclaBase, 0xa8, DisconnectResource(a0,a1))
X#pragma amicall(TclaBase, 0xae, Tcla_Init(a0,a1,a2))
X#pragma amicall(TclaBase, 0xb4, Tcla_Send(a0,a1,a2))
X#pragma amicall(TclaBase, 0xba, Tcla_AddEventLoop(a0,a1,a2,a3))
X#pragma amicall(TclaBase, 0xc0, Tcla_CleanupRoutine(a0,a1))
X#pragma amicall(TclaBase, 0xc6, Tcla_PanicRoutine(a0,a1))
X#pragma amicall(TclaBase, 0xcc, Tcla_LowMemRoutine(a0,a1))
END_OF_FILE
if test 4096 -ne `wc -c <'./includes/tcla.h'`; then
echo shar: \"'./includes/tcla.h'\" unpacked with wrong size!
fi
# end of './includes/tcla.h'
fi
if test -f './includes/tcla/window.h' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'./includes/tcla/window.h'\"
else
echo shar: Extracting \"'./includes/tcla/window.h'\" \(1113 characters\)
sed "s/^X//" >'./includes/tcla/window.h' <<'END_OF_FILE'
X#ifndef TCLAWINDOW_H
X#define TCLAWINDOW_H
X
X#include <tcla/menu.h>
X
X#define NEWSIZE_EVENT_INDEX 0
X#define REFRESHWINDOW_EVENT_INDEX 1
X#define MOUSEBUTTONS_EVENT_INDEX 2
X#define MENUPICK_EVENT_INDEX 3
X#define CLOSEWINDOW_EVENT_INDEX 4
X#define VANILLAKEY_EVENT_INDEX 5
X#define RAWKEY_EVENT_INDEX 6
X#define INTUITICKS_EVENT_INDEX 7
X#define ACTIVEWINDOW_EVENT_INDEX 8
X#define INACTIVEWINDOW_EVENT_INDEX 9
X#define NEWPREFS_EVENT_INDEX 10
X#define DISKINSERTED_EVENT_INDEX 11
X#define DISKREMOVED_EVENT_INDEX 12
X
X#define NWINDOW_EVENTS 13
X
X/* this is our window structure, it has a node so it can be in a list,
X * and it has a MenuPtr structure, so it can talk to Peter's ezmenu
X * stuff, and it has a struct window * to point to the actual window */
Xstruct TclaWindow
X{
X struct Node node;
X struct MenuPtr menudata;
X struct Window *this_window;
X struct List gadget_list;
X short flags;
X char *window_event_vectors[NWINDOW_EVENTS];
X long next_gadget_handle_number;
X};
X
X/* flag is set if close was requested while window events were being
X * processed, to prevent gurus */
X#define TCLA_WINDOW_DEFERRED_CLOSE_FLAG 1
X
X#endif
X
END_OF_FILE
if test 1113 -ne `wc -c <'./includes/tcla/window.h'`; then
echo shar: \"'./includes/tcla/window.h'\" unpacked with wrong size!
fi
# end of './includes/tcla/window.h'
fi
if test -f './includes/tcla/header.h' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'./includes/tcla/header.h'\"
else
echo shar: Extracting \"'./includes/tcla/header.h'\" \(1199 characters\)
sed "s/^X//" >'./includes/tcla/header.h' <<'END_OF_FILE'
X#ifndef TCLAHEADER_H
X#define TCLAHEADER_H
X
X#include <tcla/menu.h>
X#include <tcla/window.h>
X
X/* this is our header structure for various tcla apps stuff such as
X * windowing and the event loop that we pass around as
X * client data under the Tcl clientdata capability */
X
X#define MAX_TCLA_WINDOWS 16
X
X#define MAX_STRING_GADGET_SIZE 100
X
Xstruct TclaHeader
X{
X struct Node node;
X struct Task *taskid;
X struct List WindowList;
X struct List FontList;
X struct TclaWindow *CurrentTclaWindow;
X long next_window_number;
X long seed;
X
X struct List EventRoutineList;
X short EventLoopRunning;
X short panic_in_progress;
X
X short flags;
X
X /* stuff for communicating between Tcl programs */
X struct MsgPort *MyRequestPort;
X struct MsgPort *async_request_reply_port;
X struct MsgPort *sync_request_reply_port;
X struct AmigaTclMessage *request_message;
X
X char *progname;
X char *tclportname;
X BPTR output_file; /* we Open "*" to get the current window as a file*/
X int (*out_of_memory_routine)(long);
X void (*cleanup_routine)(void);
X void (*panic_routine)(char *);
X char undo_buffer[MAX_STRING_GADGET_SIZE];
X};
X
X#define HEADER_LOOP_INITIALIZED_FLAG 1
X#define DOING_WINDOWEVENTS_FLAG 2
X#define WINDOW_CLOSED_FLAG 4
X
X#endif
END_OF_FILE
if test 1199 -ne `wc -c <'./includes/tcla/header.h'`; then
echo shar: \"'./includes/tcla/header.h'\" unpacked with wrong size!
fi
# end of './includes/tcla/header.h'
fi
if test -f './includes/tcla/events.h' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'./includes/tcla/events.h'\"
else
echo shar: Extracting \"'./includes/tcla/events.h'\" \(144 characters\)
sed "s/^X//" >'./includes/tcla/events.h' <<'END_OF_FILE'
X#ifndef TCLAEVENTS_H
X#define TCLAEVENTS_H
X
Xstruct EventLoopEntry
X{
X struct Node node;
X void (*loopfunction)();
X long *waitmask_ptr;
X};
X
X#endif
X
END_OF_FILE
if test 144 -ne `wc -c <'./includes/tcla/events.h'`; then
echo shar: \"'./includes/tcla/events.h'\" unpacked with wrong size!
fi
# end of './includes/tcla/events.h'
fi
if test -f './includes/tcla/fonts.h' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'./includes/tcla/fonts.h'\"
else
echo shar: Extracting \"'./includes/tcla/fonts.h'\" \(413 characters\)
sed "s/^X//" >'./includes/tcla/fonts.h' <<'END_OF_FILE'
X#ifndef FONTS_H
X#define FONTS_H
X#ifndef GRAPHICS_GFXBASE_H
X#include <graphics/gfxbase.h>
X#endif
X#ifndef GRAPHICS_TEXT_H
X#include <graphics/text.h>
X#endif
X
X#define FONTWIDTH (GfxBase->DefaultFont->tf_XSize)
X#define FONTHEIGHT (GfxBase->DefaultFont->tf_YSize)
X#define FONTBASELINE (GfxBase->DefaultFont->tf_Baseline)
X
Xstruct FontListEntry
X{
X struct Node node;
X struct TextAttr f;
X struct TextFont *font;
X};
X
X#endif
END_OF_FILE
if test 413 -ne `wc -c <'./includes/tcla/fonts.h'`; then
echo shar: \"'./includes/tcla/fonts.h'\" unpacked with wrong size!
fi
# end of './includes/tcla/fonts.h'
fi
if test -f './includes/tcla/menu.h' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'./includes/tcla/menu.h'\"
else
echo shar: Extracting \"'./includes/tcla/menu.h'\" \(515 characters\)
sed "s/^X//" >'./includes/tcla/menu.h' <<'END_OF_FILE'
X#ifndef TCLAMENU_H
X#define TCLAMENU_H
X
Xstruct MenuPtr {
X struct Menu *MenuBar;
X struct Remember *MenuMemory;
X int next_id;
X};
X
X#define MENU_MAGIC 0xBEAD
X
X/* flags */
X#define SUBITEM_NOCHECK 0x0 /* subitem does not require a checkmark. */
X#define SUBITEM_SELECTOR 0x10 /* subitem is a 1 of n selector */
X#define SUBITEM_TOGGLE 0x20 /* subitem is a toggled flag. */
X#define SUBITEM_SELECTED 0x01 /* defaults to checked. */
X
Xstruct tclMenuItem {
X struct MenuItem menuitem;
X short magic;
X char *tclproc;
X};
X
X#endif
END_OF_FILE
if test 515 -ne `wc -c <'./includes/tcla/menu.h'`; then
echo shar: \"'./includes/tcla/menu.h'\" unpacked with wrong size!
fi
# end of './includes/tcla/menu.h'
fi
echo shar: End of shell archive.
exit 0
--
-- uunet!sugar!karl "As long as there is a legion of superheros, all else
-- can surely be made right." -- Sensor Girl
-- Usenet access: (713) 438-5018