# 
# Patch name: tcl
# Patch version: 10
# Author's name: Thorvald Natvig 
# Author's email: slicer@bimbo.hive.no
# Version of PennMUSH: 1.7.2p13
# Date patch made: tir jul 21 22:23:53 CEST 1998
# Author is willing to support (yes/no): yes
# Patch format: context diff
#
#
# This is a contributed PennMUSH patch. Its use is subject to the
# same restrictions found in PennMUSH's hdrs/copyrite.h file.
#
# No warranty is given for this patch. It is not necessarily going
# to work on your system, with any version of PennMUSH other than
# the one above, etc.
#
# If the author given above was willing to support the patch, you
# should write to the author if you have any questions or problems. Do
# *NOT* send email messages to Javelin or any PennMUSH mailing list about
# this patch!
#
# Below this line is the author's description of the patch,
# followed by the patch itself. If the patch is in context diff
# format, you'll probably apply it by typing: patch < patchfile
# in your top-level MUSH directory, unless instructed otherwise
# below.
#

This header and patchfile is autogenerated - Patch Version 10

Patch comments (if any):

This is the TCL patches for PennMUSH.

The patches are named tcl-<pennversion>-<patchversion>.diff[gz|bz2]
The one with the highest number is always the latest one :)

Documentation is on http://lists.pennmush.org/tcl/

If you have previously patched in an older version of the TCL patch, you
must first UNPATCH that one before applying this. To do so, type
patch -p0 -R < OldPatchName
Rewrite as necesarry if you've gotten the gzip or bzip2 version.


If you get the gzip or bzip2 compresed patch (which I prefer since they are
smaller), do this to patch:
gzip -cd PatchNameThatEndsWith.gz | patch -p0
or
bzip2 -cd PatchNameThatEndsWith.bz2 | patch -p0

You also need TCL 8.0p2 with the Command Limit patch. This is necesarry if
you want players other than GOD to use TCL.
Download the TCL 8.0p2 source from ftp://ftp.smli.com/pub/tcl/tcl8.0p2.tar.gz

Unpack it and go into the tcl8.0 directory, then use

patch -p1 < Tcl8.0p2.CommandLimit.Patch

Then compile and build as usual.

If you do this on a machine you're not root on, you'll have to tweak the
installation a little, and also change the PennMUSH Makefiles to reflect the
correct path (with an -L statement on the loader flags).

**** IMPORTANT ****
You *MUST* delete config.sh and rerun Configure before compiling, or you
WILL get errors.

Please report any problems to me (slicer@bimbo.hive.no)
*** ../clean/options.h.dist	Tue Jul 21 22:11:32 1998
--- options.h.dist	Tue Jul 21 22:21:07 1998
***************
*** 86,91 ****
--- 86,95 ----
   */
  #define COMPRESSION_TYPE 1
  
+ /* Enable TCL. Be damn carefull
+  */
+ /* #define ENABLE_TCL /* */
+ 
  
  /*------------------------- Other internals ----------------------*/
  
*** ../clean/hdrs/conf.h	Thu May 28 16:09:41 1998
--- hdrs/conf.h	Fri Apr 24 15:35:42 1998
***************
*** 252,257 ****
--- 252,260 ----
    int max_parents;
    int purge_interval;
    int dbck_interval;
+  #ifdef ENABLE_TCL
+    char tcl_bootfile[256];
+  #endif
  };
  
  extern OPTTAB options;
*** /dev/null	Tue May  5 22:32:27 1998
--- hdrs/penntcl.h	Tue Feb 24 17:58:10 1998
***************
*** 0 ****
--- 1,198 ----
+ /* The defines for penntcl.h
+  */
+ 
+ #ifndef PENNTCL_H
+ #define PENNTCL_H
+ #ifdef ENABLE_TCL
+ 
+ 
+ #include "config.h"
+ #include "confmagic.h"
+ #include <tcl.h>
+ #include "function.h"
+ #include "command.h"
+ 
+ 
+ #define TCL_PATCHVERSION "0.1a2"
+ 
+ #define TCL_LIMIT_GLOBAL 1000000
+ #define TCL_LIMIT_GOD    1000000
+ #define TCL_LIMIT_WIZ     500000
+ #define TCL_LIMIT_MORTAL  100000
+ 
+ #define TCL_ASSOCNAME "hash_instance"
+ 
+ struct tcl_instance {
+   Tcl_Interp *tcli;
+   char *name;
+   int restrict;
+   dbref player;
+   int uses;
+   int cmds;
+   int refs;
+   int level;
+   Tcl_Trace trace;
+ };
+ 
+ struct tcl_hook {
+   /* Only used by the event hooks, but it's nice to have a conforming structure. */
+   struct tcl_hook *next;
+   struct tcl_instance *ti;
+   char *proc;
+ };
+ 
+ struct tcl_command {
+   Tcl_ObjCmdProc *proc;
+   int restrict;
+   ClientData clientData;
+ };
+ 
+ struct tcl_hc_command {
+   const char *name;
+   struct tcl_command cmd;
+ };
+ 
+ struct tcl_variable {
+   char *data;
+   int restrict;
+   int type;
+ };
+ 
+ struct tcl_hc_variable {
+   const char *name;
+   struct tcl_variable var;
+ };
+ 
+ #define EVENT_STARTUP 0
+ #define EVENT_DBDUMP 1
+ #define EVENT_SHUTDOWN 2
+ #define EVENT_TIMER 3
+ #define EVENT_CREATE 4
+ #define EVENT_CLONE 5
+ #define EVENT_FREE 6
+ #define EVENT_MAX 7
+ 
+ 	/* ClientData? tcl_instance? Same thing :) */
+ #define TCLCMD(x) \
+ int \
+ x(ti, interp, objc, objv) \
+      struct tcl_instance *ti; \
+      Tcl_Interp *interp; \
+      int objc; \
+      Tcl_Obj *CONST objv[]; \
+ 
+ 
+ #define TCLCMD_PROTO(x) int x _((struct tcl_instance *ti, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]))
+ #define TCL_INSTANCE struct tcl_instance *ti=(struct tcl_instance *)
+ 
+ 
+ /* Tiny 2.2.4 commands */
+ TCLCMD_PROTO(tclcmd_pemit);
+ TCLCMD_PROTO(tclcmd_getattrib);
+ TCLCMD_PROTO(tclcmd_setattrib);
+ TCLCMD_PROTO(tclcmd_mushfunc);
+ 
+ /* Our commands */
+ TCLCMD_PROTO(tclcmd_addhook);
+ TCLCMD_PROTO(tclcmd_addcmd);
+ TCLCMD_PROTO(tclcmd_addfunc);
+ TCLCMD_PROTO(tclcmd_loadfile);
+ TCLCMD_PROTO(tclcmd_attrib);
+ TCLCMD_PROTO(tclcmd_object);
+ TCLCMD_PROTO(tclcmd_notify);
+ TCLCMD_PROTO(tclcmd_connection);
+ TCLCMD_PROTO(tclcmd_ansi);
+ TCLCMD_PROTO(tclcmd_html);
+ TCLCMD_PROTO(tclcmd_debug);
+ 
+ /* Hooks for additions */
+ FUNCTION_PROTO(fun_tclfun);
+ COMMAND_PROTO(cmd_tclcmd);
+ 
+ /* Our MUSH Online interfaces */
+ FUNCTION_PROTO(fun_tclclear);
+ FUNCTION_PROTO(fun_tclparams);
+ FUNCTION_PROTO(fun_tclregs);
+ FUNCTION_PROTO(fun_tcleval);
+ FUNCTION_PROTO(fun_tcl);
+ FUNCTION_PROTO(fun_evaltime);
+ COMMAND_PROTO(cmd_tcl);
+ 
+ struct tcl_hook *hook_init _((struct tcl_hook * hook, struct tcl_instance * ti, char *proc));
+ void hook_free _((struct tcl_hook * hook));
+ void tclhook_doem _((int ht, char *args));
+ void tclhook_startup _((void));
+ void tclhook_dbdump _((void));
+ void tclhook_shutdown _((void));
+ void tclhook_timer _((void));
+ void tclhook_create _((dbref new));
+ void tclhook_clone _((dbref new, dbref source));
+ void tclhook_free _((dbref item));
+ char *filebasename _((char *filename));
+ struct tcl_instance *tcl_spawn _((dbref player, char *name, char **result));
+ void tcl_init _((void));
+ int tcl_kill_interp _((struct tcl_instance * ti));
+ struct tcl_instance *tcl_find_name _((char *name));
+ struct tcl_instance *tcl_findinstance _((Tcl_Interp * interp));
+ int tcl_load _((int master, char *filename, char **result));
+ int tcl_eval _((struct tcl_instance * ti, char *command, char **result));
+ void tcl_timer _((void));
+ void tcl_setdebug _((struct tcl_instance * ti, int level));
+ void tcl_interp_delete _((ClientData clientData, Tcl_Interp * interp));
+ void tcl_addcmd _((char *name, Tcl_ObjCmdProc * proc, int restrict, ClientData clientData));
+ void tcl_addvar _((char *name, char *data, int restrict, int type));
+ 
+ #define TCL_INIT \
+     Tcl_Obj *resultPtr; \
+     dbref player; \
+     resultPtr = Tcl_GetObjResult(interp); \
+     player = ti->player;
+ 
+ #define TCLERROR_STRING(x) \
+     Tcl_SetStringObj(resultPtr, (char *)x, -1); return TCL_ERROR
+ 
+ #define TCL_NOPERM \
+     Tcl_SetStringObj(resultPtr, (char *) "permission denied", -1); return TCL_ERROR
+ 
+ #define TCLGETINT(x, y) \
+      if (Tcl_GetIntFromObj(interp, objv[x], &y)==TCL_ERROR) \
+         return TCL_ERROR
+ 
+ #define CMD_ATTRIB_READCHECK \
+   if ((a && !Can_Read_Attr(player, target, a)) || !Can_Examine(player, target)) { \
+      TCLERROR_STRING("permission denied"); \
+   } \
+   if (!a) { \
+      TCLERROR_STRING("attribute not found"); \
+   }
+ 
+ #define CMD_ATTRIB_WRITECHECK \
+   if ((a && !Can_Write_Attr(player, target, a)) || !controls(player, target)) { \
+      TCLERROR_STRING("Permission denied"); \
+   } \
+   if (!a) { \
+      TCLERROR_STRING("Attribute not found"); \
+   }
+ 
+ 
+ #define CMD_CONVOBJECT(x, y) \
+   if (Tcl_GetIntFromObj(interp, objv[y], &x) != TCL_OK) { \
+      Tcl_ResetResult(interp); \
+      x = match_result(player, Tcl_GetStringFromObj(objv[y], NULL), NOTYPE, MAT_EVERYTHING | MAT_ME | MAT_HERE); \
+   }
+ 
+ #define CMD_GETOBJECT(x, y) \
+   CMD_CONVOBJECT(x, y) \
+   if (!GoodObject(x)) { \
+      TCLERROR_STRING("object not found"); \
+   }
+ 
+ /* Externals we need */
+ int okay_pemit _((dbref player, dbref target));
+ void do_chown _((dbref player, const char *name, const char *newobj));
+ lock_type check_lock_type _((dbref player, dbref thing, char *name));
+ void oemit_notify_except _((dbref loc, dbref exc1, dbref exc2, const char *msg));
+ 
+ 
+ #endif
+ #endif
*** ../clean/src/bsd.c	Tue Jul 21 22:11:32 1998
--- src/bsd.c	Tue Jul 21 22:17:38 1998
***************
*** 89,94 ****
--- 89,95 ----
  #include "ansi.h"
  #include "pueblo.h"
  #include "parse.h"
+ #include "penntcl.h"
  #include "access.h"
  #include "version.h"
  #include "ident.h"
***************
*** 505,510 ****
--- 506,514 ----
  
    dump_database();
  
+ #ifdef ENABLE_TCL
+   tclhook_shutdown();
+ #endif
    local_shutdown();
  
  #ifndef SINGLE_LOGFILE
***************
*** 4612,4614 ****
--- 4616,4736 ----
    remove(REBOOTFILE);
    flag_broadcast(0, 0, "GAME: Reboot finished.");
  }
+ 
+ #ifdef ENABLE_TCL
+ TCLCMD(tclcmd_connection)
+ {
+   DESC *d;
+   int cindex;
+   int powered;
+   Tcl_DString ds;
+   time_t now;
+   dbref target;
+ 
+   static const char *coptions[] =
+   {
+     "list", "mortallist", "idle", "connected", "hidden", "poll", "doing",
+     NULL
+   };
+ 
+   enum coptions {
+     CONN_LWHO, CONN_MWHO, CONN_IDLE, CONN_CONNECTED, CONN_HIDDEN, CONN_POLL, CONN_DOING,
+   };
+ 
+   TCL_INIT;
+ 
+   now = time((time_t *) NULL);
+ 
+   if (objc < 2) {
+     Tcl_WrongNumArgs(interp, 1, objv, (char *) "option ?arg?");
+     return TCL_ERROR;
+   }
+   if (Tcl_GetIndexFromObj(interp, objv[1], (char **) coptions, (char *) "option", 0,
+ 			  &cindex) != TCL_OK) {
+     return TCL_ERROR;
+   }
+   switch ((enum coptions) cindex) {
+   case CONN_LWHO:
+   case CONN_MWHO:
+     if (objc != 2) {
+       Tcl_WrongNumArgs(interp, 2, objv, NULL);
+       return TCL_ERROR;
+     }
+     Tcl_DStringInit(&ds);
+     powered = (cindex == CONN_LWHO);
+     DESC_ITER_CONN(d) {
+       if (!Hidden(d) || (powered && Priv_Who(player))) {
+ 	Tcl_DStringAppendElement(&ds, unparse_integer(d->player));
+       }
+     }
+ 
+     Tcl_DStringResult(interp, &ds);
+     break;
+   case CONN_IDLE:
+   case CONN_CONNECTED:
+     if (objc != 3) {
+       Tcl_WrongNumArgs(interp, 2, objv, (char *) "player");
+       return TCL_ERROR;
+     }
+     CMD_GETOBJECT(target, 2);
+     if (!Connected(target)) {
+       Tcl_SetIntObj(resultPtr, -1);
+     } else {
+       DESC_ITER_CONN(d) {
+ 	if (d->player == target) {
+ 	  if (!Hidden(d) || Priv_Who(player)) {
+ 	    if (cindex == CONN_IDLE)
+ 	      Tcl_SetIntObj(resultPtr, now - d->last_time);
+ 	    else
+ 	      Tcl_SetIntObj(resultPtr, now - d->connected_at);
+ 	  } else {
+ 	    Tcl_SetIntObj(resultPtr, -1);
+ 	  }
+ 	}
+       }
+     }
+     break;
+   case CONN_HIDDEN:
+     if (objc != 3) {
+       Tcl_WrongNumArgs(interp, 2, objv, (char *) "player");
+       return TCL_ERROR;
+     }
+     if (!See_All(player)) {
+       TCLERROR_STRING("permission denied");
+     }
+     CMD_GETOBJECT(target, 2);
+     Tcl_SetIntObj(resultPtr, hidden(target) ? 1 : 0);
+     break;
+   case CONN_DOING:
+     if (objc != 3) {
+       Tcl_WrongNumArgs(interp, 2, objv, (char *) "player");
+       return TCL_ERROR;
+     }
+     CMD_GETOBJECT(target, 2);
+     DESC_ITER_CONN(d) {
+       if (d->player == target) {
+ 	if (!Hidden(d) || Priv_Who(player)) {
+ 	  Tcl_SetStringObj(resultPtr, d->doing, -1);
+ 	} else {
+ 	}
+       }
+     }
+     break;
+   case CONN_POLL:
+     if (objc == 3) {
+       if (!Change_Poll(player)) {
+ 	TCLERROR_STRING("permission denied");
+       }
+       strncpy(poll_msg, Tcl_GetStringFromObj(objv[2], NULL), DOING_LEN - 1);
+       poll_msg[DOING_LEN - 1] = '\0';
+       do_log(LT_WIZ, player, NOTHING, "Poll Set to '%s'.", poll_msg);
+     } else if (objc != 2) {
+       Tcl_WrongNumArgs(interp, 2, objv, (char *) "?newpoll?");
+       return TCL_ERROR;
+     }
+     Tcl_SetStringObj(resultPtr, poll_msg, -1);
+     break;
+   }
+   return TCL_OK;
+ }
+ #endif
*** ../clean/src/conf.c	Thu May 28 16:10:08 1998
--- src/conf.c	Fri Apr 24 15:35:42 1998
***************
*** 114,119 ****
--- 114,122 ----
  {"down_html_file", cf_str, (int *) options.down_file[1], 256, 0, "files"},
  {"full_html_file", cf_str, (int *) options.full_file[1], 256, 0, "files"},
    {"guest_html_file", cf_str, (int *) options.guest_file[1], 256, 0, "files"},
+ #ifdef ENABLE_TCL
+   {(char *) "tcl_bootfile", cf_str, (int *) options.tcl_bootfile, 256, 0, "files"},
+ #endif
    {"log_commands", cf_bool, &options.log_commands, 2, 0, "log"},
    {"log_huhs", cf_bool, &options.log_huhs, 2, 0, "log"},
    {"log_forces", cf_bool, &options.log_forces, 2, 0, "log"},
***************
*** 488,493 ****
--- 491,499 ----
    options.warn_interval = 3600;
  #endif
    options.use_dns = 1;
+ #ifdef ENABLE_TCL
+   *options.tcl_bootfile='\0';
+ #endif
    options.haspower_restricted = 0;
    options.safer_ufun = 1;
    strcpy(options.dump_warning_1min, "GAME: Database will be dumped in 1 minute.");
*** ../clean/src/create.c	Thu May 28 16:10:10 1998
--- src/create.c	Wed Mar  4 22:32:44 1998
***************
*** 159,164 ****
--- 159,167 ----
  #ifdef LOCAL_DATA
      local_data_create(new_exit);
  #endif
+ #ifdef ENABLE_TCL
+     tclhook_create(new_exit);
+ #endif
      return new_exit;
    }
    return NOTHING;
***************
*** 402,407 ****
--- 405,413 ----
  #ifdef LOCAL_DATA
      local_data_create(room);
  #endif
+ #ifdef ENABLE_TCL
+     tclhook_create(room);
+ #endif
      return room;
    }
    return NOTHING;
***************
*** 471,476 ****
--- 477,485 ----
  #ifdef LOCAL_DATA
      local_data_create(thing);
  #endif
+ #ifdef ENABLE_TCL
+     tclhook_create(thing);
+ #endif
      return thing;
    }
    return NOTHING;
***************
*** 547,552 ****
--- 556,564 ----
        db[clone].local_data = NULL;
        local_data_clone(clone, thing);
  #endif
+ #ifdef ENABLE_TCL
+       tclhook_clone(clone, thing);
+ #endif
        did_it(player, clone, NULL, NULL, NULL, NULL, "ACLONE", NOTHING);
        return clone;
      }
***************
*** 584,589 ****
--- 596,604 ----
  #ifdef LOCAL_DATA
        db[clone].local_data = NULL;
        local_data_clone(clone, thing);
+ #endif
+ #ifdef ENABLE_TCL
+       tclhook_clone(clone, thing);
  #endif
        return clone;
      }
*** ../clean/src/destroy.c	Thu May 28 16:10:13 1998
--- src/destroy.c	Mon Jun  1 14:14:43 1998
***************
*** 577,582 ****
--- 577,585 ----
   */
  {
    dbref i;
+ #ifdef ENABLE_TCL
+   tclhook_free(thing);
+ #endif
  #ifdef LOCAL_DATA
    local_data_free(thing);
  #endif
*** ../clean/src/game.c	Thu May 28 16:10:25 1998
--- src/game.c	Wed Mar  4 22:32:45 1998
***************
*** 307,312 ****
--- 307,315 ----
    char tmpfl[2048];
    FILE *f;
  
+ #ifdef ENABLE_TCL
+   tclhook_dbdump();
+ #endif
    local_dump_database();
  
  #ifdef ALWAYS_PARANOID
***************
*** 621,626 ****
--- 624,633 ----
    config_file_startup(conf);
    command_init_postconfig();
  
+  #ifdef ENABLE_TCL
+    tcl_init();
+  #endif
+ 
  #ifdef WIN32
    Win32MUSH_setup();		/* create index files, copy databases etc. */
  #endif
***************
*** 723,728 ****
--- 730,739 ----
  
    /* Call Local Startup */
    local_startup();
+ 
+ #ifdef ENABLE_TCL
+   tcl_boot();
+ #endif
  
    /* everything else ok. Restart all objects. */
    do_restart();
*** ../clean/src/lock.c	Thu May 28 16:10:28 1998
--- src/lock.c	Sat Feb 21 22:54:45 1998
***************
*** 101,107 ****
  static void free_one_lock_list _((lock_list *ll));
  void delete_lock _((dbref thing, lock_type type));
  void free_locks _((lock_list *ll));
! static lock_type check_lock_type _((dbref player, dbref thing, char *name));
  void do_unlock _((dbref player, const char *name, lock_type type));
  void do_lock _((dbref player, const char *name, const char *keyname, lock_type type));
  int eval_lock _((dbref player, dbref thing, lock_type ltype));
--- 101,107 ----
  static void free_one_lock_list _((lock_list *ll));
  void delete_lock _((dbref thing, lock_type type));
  void free_locks _((lock_list *ll));
! lock_type check_lock_type _((dbref player, dbref thing, char *name));
  void do_unlock _((dbref player, const char *name, lock_type type));
  void do_lock _((dbref player, const char *name, const char *keyname, lock_type type));
  int eval_lock _((dbref player, dbref thing, lock_type ltype));
***************
*** 263,269 ****
   *
   * Might destructively modify name.
   */
! static lock_type
  check_lock_type(player, thing, name)
      dbref player;
      dbref thing;
--- 263,269 ----
   *
   * Might destructively modify name.
   */
! lock_type
  check_lock_type(player, thing, name)
      dbref player;
      dbref thing;
*** /dev/null	Tue May  5 22:32:27 1998
--- src/nmalloc.c	Fri Apr 24 15:35:43 1998
***************
*** 0 ****
--- 1,99 ----
+ /* Win32 memory allocation statistics routines */
+ 
+ /* Author: Nick Gammon */
+ 
+ #ifdef WIN32
+ 
+ #include "copyrite.h"
+ #include "config.h"
+ 
+ #ifdef I_STDLIB
+ #include <stdlib.h>
+ #endif
+ 
+ #include "conf.h"
+ #include "mushdb.h"
+ #include "intrface.h"
+ #include "match.h"
+ #include "externs.h"
+ #include "mymalloc.h"
+ #include "confmagic.h"
+ 
+ #define SLONG sizeof (long)
+ 
+ static long malloc_count = 0, free_count = 0, total_mallocked = 0, total_freed = 0;
+ 
+ void *
+ Win32_malloc(size_t size)
+ {
+   void *p = malloc(size);
+ 
+   if (p) {
+     malloc_count++;
+     total_mallocked += _msize(p);
+   }
+   return p;
+ }
+ 
+ void *
+ Win32_realloc(void *memblock, size_t size)
+ {
+   void *p;
+ 
+   if (memblock) {
+     total_freed += _msize(memblock);
+     free_count++;
+   }
+   p = realloc(memblock, size);
+ 
+   if (p) {
+     malloc_count++;
+     total_mallocked += _msize(p);
+   }
+   return p;
+ }
+ 
+ void *
+ Win32_calloc(size_t num, size_t size)
+ {
+   long totalsize = size * num;
+ 
+   void *p = calloc(num, size);
+ 
+   if (p) {
+     malloc_count++;
+     total_mallocked += _msize(p);
+   }
+   return p;
+ 
+ }
+ 
+ void
+ Win32_free(void *memblock)
+ {
+ 
+ /* Do not attempt to free a nil pointer */
+ 
+   if (!memblock)
+     return;
+ 
+   total_freed += _msize(memblock);
+   free_count++;
+ 
+   free(memblock);
+ }
+ 
+ 
+ void
+ Win32_return_memory_used(long *mallocs,
+ 			 long *frees,
+ 			 long *allocated,
+ 			 long *freed)
+ {
+   *mallocs = malloc_count;
+   *frees = free_count;
+   *allocated = total_mallocked;
+   *freed = total_freed;
+ }
+ 
+ #endif
*** ../clean/src/player.c	Thu May 28 16:10:37 1998
--- src/player.c	Sat Feb 21 22:54:45 1998
***************
*** 321,326 ****
--- 321,329 ----
  #ifdef LOCAL_DATA
    local_data_create(player);
  #endif
+ #ifdef ENABLE_TCL
+   tclhook_create(player);
+ #endif
  
    return player;
  }
*** ../clean/src/speech.c	Tue Jul 21 22:11:32 1998
--- src/speech.c	Tue Jul 21 22:17:38 1998
***************
*** 20,26 ****
  #include "parse.h"
  #include "confmagic.h"
  
! static void oemit_notify_except _((dbref loc, dbref exc1, dbref exc2, const char *msg));
  const char *reconstruct_message _((char *arg1, char *arg2));
  int okay_pemit _((dbref player, dbref target));
  static dbref speech_loc _((dbref thing));
--- 20,26 ----
  #include "parse.h"
  #include "confmagic.h"
  
! void oemit_notify_except _((dbref loc, dbref exc1, dbref exc2, const char *msg));
  const char *reconstruct_message _((char *arg1, char *arg2));
  int okay_pemit _((dbref player, dbref target));
  static dbref speech_loc _((dbref thing));
***************
*** 1261,1267 ****
    do_audible_stuff(loc, exc1, exc2, msg);
  }
  
! static void
  oemit_notify_except(loc, exc1, exc2, msg)
      dbref loc;
      dbref exc1;
--- 1261,1267 ----
    do_audible_stuff(loc, exc1, exc2, msg);
  }
  
! void
  oemit_notify_except(loc, exc1, exc2, msg)
      dbref loc;
      dbref exc1;
*** /dev/null	Tue May  5 22:32:27 1998
--- src/tcl.c	Sat Apr 25 14:33:07 1998
***************
*** 0 ****
--- 1,2574 ----
+ /* tcl.c */
+ 
+ /* By Thorvald Natvig. Questions about this SHOULD BE SENT TO ME, and 
+  * ***** NOT ***** to the PennMUSH developers or Javelin.
+  *
+  * My email is slicer@bimbo.hive.no
+  *
+  * Inspiration for this came from TinyMUSH 2.2.4 by Amberyl, and some came from
+  * various versions of eggdrop.
+  *
+  * I include the TCL functionality of Tiny 2.2.4, so people can use code written for
+  * it.
+  *
+  * This is my first use of TCL as an embedded language, so PLEASE send me ideas :)
+  * Also, if you ever hack anything in here... Read the copyrite, and send me a patch ;)
+  *
+  * The homepage for this is http://lists.pennmush.org/tcl/
+  * That page contains links to updated source, as well as full documentation
+  *
+  */
+ 
+ 
+ #include "copyrite.h"
+ 
+ 
+ #include "config.h"
+ #include <limits.h>
+ #ifdef I_STRING
+ #include <string.h>
+ #else
+ #include <strings.h>
+ #endif
+ #include <ctype.h>
+ 
+ #include "conf.h"
+ 
+ /* No TCL? Oh well */
+ #ifdef ENABLE_TCL
+ #include "ansi.h"
+ #include "dbdefs.h"
+ #include "externs.h"
+ #include "function.h"
+ #include "globals.h"
+ #include "intrface.h"
+ #include "match.h"
+ #include "mushdb.h"
+ #include "parse.h"
+ #include "match.h"
+ #include "htab.h"
+ #include "privtab.h"
+ #include "lock.h"
+ 
+ #ifdef MEM_CHECK
+ #include "memcheck.h"
+ #endif
+ #include "confmagic.h"
+ 
+ /* Include our definitions */
+ #include "penntcl.h"
+ 
+ /* Hashtables to hold functions and commands */
+ Tcl_HashTable tclhash_funs;
+ Tcl_HashTable tclhash_cmds;
+ Tcl_HashTable tclhash_ins;
+ Tcl_HashTable tclhash_tclcmds;
+ Tcl_HashTable tclhash_tclvars;
+ 
+ /* The inMUSH commands/functions, from command.c and function.c */
+ extern HASHTAB htab_function;
+ extern HASHTAB htab_command;
+ extern PRIV attr_privs[];
+ 
+ /* Linked lists of our event hooks */
+ struct tcl_hook *event_hooks[EVENT_MAX];
+ 
+ /* Our linked list of instances */
+ struct tcl_instance *master_instance;
+ 
+ Tcl_HashTable tclhash_ins;
+ 
+ /* Current 'depth' */
+ int tcl_level = 0;
+ 
+ /* TickTimer for tcl_timer() */
+ int tcl_timer_tick = 1;
+ 
+ /* SelfReminder Block (ignore)
+  * Functions we really should have:
+  * lwho() - All that's left.
+  */
+ 
+ struct tcl_hc_command tclcommands[] =
+ {
+   {"pemit",
+    {(Tcl_ObjCmdProc *) tclcmd_pemit, 2, NULL}},
+   {"setattrib",
+    {(Tcl_ObjCmdProc *) tclcmd_setattrib, 2, NULL}},
+   {"getattrib",
+    {(Tcl_ObjCmdProc *) tclcmd_getattrib, 2, NULL}},
+   {"mushfunc",
+    {(Tcl_ObjCmdProc *) tclcmd_mushfunc, 2, NULL}},
+   {"attrib",
+    {(Tcl_ObjCmdProc *) tclcmd_attrib, 2, NULL}},
+   {"object",
+    {(Tcl_ObjCmdProc *) tclcmd_object, 2, NULL}},
+   {"notify",
+    {(Tcl_ObjCmdProc *) tclcmd_notify, 2, NULL}},
+   {"connection",
+    {(Tcl_ObjCmdProc *) tclcmd_connection, 2, NULL}},
+   {"ansi",
+    {(Tcl_ObjCmdProc *) tclcmd_ansi, 2, NULL}},
+   {"html",
+    {(Tcl_ObjCmdProc *) tclcmd_html, 2, NULL}},
+   {"debug",
+    {(Tcl_ObjCmdProc *) tclcmd_debug, 2, NULL}},
+   {"addfunc",
+    {(Tcl_ObjCmdProc *) tclcmd_addfunc, 1, NULL}},
+   {"addcmd",
+    {(Tcl_ObjCmdProc *) tclcmd_addcmd, 1, NULL}},
+   {"addhook",
+    {(Tcl_ObjCmdProc *) tclcmd_addhook, 1, NULL}},
+   {"loadfile",
+    {(Tcl_ObjCmdProc *) tclcmd_loadfile, 0, NULL}},
+   {NULL,
+    {NULL, 0, NULL}}
+ };
+ 
+ struct tcl_hc_variable tclvars[] =
+ {
+   {"db_top",
+    {(char *) &db_top, 2, TCL_LINK_INT | TCL_LINK_READ_ONLY}},
+   {"v(0)",
+    {(char *) &wenv[0], 2, TCL_LINK_STRING | TCL_LINK_READ_ONLY}},
+   {"v(1)",
+    {(char *) &wenv[1], 2, TCL_LINK_STRING | TCL_LINK_READ_ONLY}},
+   {"v(2)",
+    {(char *) &wenv[2], 2, TCL_LINK_STRING | TCL_LINK_READ_ONLY}},
+   {"v(3)",
+    {(char *) &wenv[3], 2, TCL_LINK_STRING | TCL_LINK_READ_ONLY}},
+   {"v(4)",
+    {(char *) &wenv[4], 2, TCL_LINK_STRING | TCL_LINK_READ_ONLY}},
+   {"v(5)",
+    {(char *) &wenv[5], 2, TCL_LINK_STRING | TCL_LINK_READ_ONLY}},
+   {"v(6)",
+    {(char *) &wenv[6], 2, TCL_LINK_STRING | TCL_LINK_READ_ONLY}},
+   {"v(7)",
+    {(char *) &wenv[7], 2, TCL_LINK_STRING | TCL_LINK_READ_ONLY}},
+   {"v(8)",
+    {(char *) &wenv[8], 2, TCL_LINK_STRING | TCL_LINK_READ_ONLY}},
+   {"v(9)",
+    {(char *) &wenv[9], 2, TCL_LINK_STRING | TCL_LINK_READ_ONLY}},
+   {NULL,
+    {NULL, 0, 0}}
+ };
+ 
+ /*********************************************************************
+  * Interpreter Manipulation and Execution Functions
+  *
+  * These are functions to initialize TCL and interpreters as well
+  * as deleting and executing from them. Also includes the timer.
+  *
+  */
+ 
+ void
+ tcl_init()
+ {
+   int i;
+ 
+   Tcl_InitHashTable(&tclhash_funs, TCL_STRING_KEYS);
+   Tcl_InitHashTable(&tclhash_cmds, TCL_STRING_KEYS);
+   Tcl_InitHashTable(&tclhash_ins, TCL_STRING_KEYS);
+   Tcl_InitHashTable(&tclhash_tclcmds, TCL_STRING_KEYS);
+   Tcl_InitHashTable(&tclhash_tclvars, TCL_STRING_KEYS);
+   for (i = 0; i < EVENT_MAX; i++)
+     event_hooks[i] = NULL;
+ 
+   command_add("@TCL", CMD_T_ANY | CMD_T_NOPARSE, 0, 0, 0, switchmask("LIST KILL LOAD RELOAD MASTER DEBUG STATUS"), cmd_tcl);
+   function_add((char *) "TCLCLEAR", fun_tclclear, 1, 1, FN_REG);
+   function_add((char *) "TCLPARAMS", fun_tclparams, 0, 10, FN_REG);
+   function_add((char *) "TCLREGS", fun_tclregs, 0, 0, FN_REG);
+   function_add((char *) "TCLEVAL", fun_tcleval, 1, 10, FN_REG);
+   function_add((char *) "TCL", fun_tcl, 1, 10, FN_REG);
+   function_add((char *) "EVALTIME", fun_evaltime, 1, 2, FN_NOPARSE);
+ 
+   i = 0;
+   while (tclcommands[i].name) {
+     tcl_addcmd((char *) tclcommands[i].name, tclcommands[i].cmd.proc, tclcommands[i].cmd.restrict, tclcommands[i].cmd.clientData);
+     i++;
+   }
+ 
+   i = 0;
+   while (tclvars[i].name) {
+     tcl_addvar((char *) tclvars[i].name, tclvars[i].var.data, tclvars[i].var.restrict, tclvars[i].var.type);
+     i++;
+   }
+ }
+ 
+ void
+ tcl_boot()
+ {
+   char *bp;
+   master_instance = tcl_spawn(NOTHING, NULL, &bp);
+ 
+   if (!master_instance) {
+     fprintf(stderr, "ERROR: Could not spawn master TCL Interpreter.");
+     exit(1);
+   }
+   /* There's ALWAYS a reference to the master interpreter */
+   master_instance->refs = 1;
+ 
+   if (options.tcl_bootfile && *options.tcl_bootfile)
+     if (Tcl_EvalFile(master_instance->tcli, options.tcl_bootfile) != TCL_OK)
+       do_rawlog(LT_ERR, "Loading tcl_bootfile %s failed with: %s", options.tcl_bootfile, Tcl_GetStringResult(master_instance->tcli));
+   tclhook_startup();
+ }
+ 
+ void
+ tcl_addcmd(name, proc, restrict, clientData)
+     char *name;
+     Tcl_ObjCmdProc *proc;
+     int restrict;
+     ClientData clientData;
+ {
+   Tcl_HashEntry *th;
+   int i;
+   struct tcl_command *tclcmd;
+ 
+   if (!name || !proc)
+     return;
+ 
+   th = Tcl_FindHashEntry(&tclhash_tclcmds, name);
+   if (th) {
+     tclcmd = Tcl_GetHashValue(th);
+   } else {
+     tclcmd = mush_malloc(sizeof(struct tcl_command), "tcl_command");
+     th = Tcl_CreateHashEntry(&tclhash_tclcmds, name, &i);
+     if (!th)
+       return;
+     Tcl_SetHashValue(th, tclcmd);
+   }
+   tclcmd->proc = proc;
+   tclcmd->restrict = restrict;
+   tclcmd->clientData = clientData;
+ }
+ 
+ void
+ tcl_addvar(name, data, restrict, type)
+     char *name;
+     char *data;
+     int restrict;
+     int type;
+ {
+   Tcl_HashEntry *th;
+   int i;
+   struct tcl_variable *tclvar;
+ 
+   if (!name || !data)
+     return;
+ 
+   th = Tcl_FindHashEntry(&tclhash_tclvars, name);
+   if (th) {
+     tclvar = Tcl_GetHashValue(th);
+   } else {
+     tclvar = mush_malloc(sizeof(struct tcl_variable), "tcl_variable");
+     th = Tcl_CreateHashEntry(&tclhash_tclvars, name, &i);
+     if (!th)
+       return;
+     Tcl_SetHashValue(th, tclvar);
+   }
+   tclvar->data = data;
+   tclvar->restrict = restrict;
+   tclvar->type = type;
+ }
+ 
+ struct tcl_instance *
+ tcl_spawn(player, name, result)
+     dbref player;
+     char *name;
+     char **result;
+ {
+   Tcl_Interp *tcli;
+   const char *n;
+   int restrict;
+   int i;
+   struct tcl_instance *ti;
+   Tcl_HashEntry *th;
+   Tcl_HashSearch hs;
+   struct tcl_command *tclcmd;
+   struct tcl_variable *tclvar;
+   ATTR *a;
+   char value[BUFFER_LEN];
+   char aname[20];
+ 
+   if (player == NOTHING) {
+     tcli = Tcl_CreateInterp();
+     restrict = 0;
+     n = "MASTER";
+     player = GOD;
+   } else {
+ #ifndef TCL_HASLIMITS
+     if (!God(player)) {
+       *result = (char *) "TCL is not patched - Only GOD can use";
+       return NULL;
+     }
+ #endif
+     if (!name)
+       n = unparse_dbref(player);
+     else
+       n = filebasename(name);
+ 
+     th = Tcl_FindHashEntry(&tclhash_ins, n);
+     if (th)
+       return Tcl_GetHashValue(th);
+ 
+     if ((player == NOTHING) || God(player))
+       restrict = 0;
+     else if (Wizard(player))
+       restrict = 1;
+     else
+       restrict = 2;
+ 
+     tcli = Tcl_CreateSlave(master_instance->tcli, (char *) n, restrict);
+   }
+ 
+   if (!tcli) {
+     *result = (char *) "Could not spawn interpreter";
+     return NULL;
+   }
+   ti = mush_malloc(sizeof(struct tcl_instance), "tcl_instance");
+   if (!ti) {
+     *result = (char *) "Could not allocate structure";
+     Tcl_DeleteInterp(tcli);
+     return NULL;
+   }
+   ti->tcli = tcli;
+   ti->name = strdup((name) ? name : n);
+ #ifdef MEM_CHECK
+   add_check("tcl_instance_name");
+ #endif
+   ti->restrict = restrict;
+   ti->player = player;
+   ti->uses = 1;
+   ti->cmds = 0;
+   ti->refs = 0;
+   ti->level = 0;
+   ti->trace = NULL;
+ 
+ 
+   th = Tcl_FirstHashEntry(&tclhash_tclcmds, &hs);
+   while (th) {
+     tclcmd = Tcl_GetHashValue(th);
+     if (tclcmd->restrict >= restrict)
+       Tcl_CreateObjCommand(tcli, Tcl_GetHashKey(&tclhash_tclcmds, th), tclcmd->proc, (tclcmd->clientData) ? tclcmd->clientData : (ClientData) ti, NULL);
+     th = Tcl_NextHashEntry(&hs);
+   }
+ 
+   th = Tcl_FirstHashEntry(&tclhash_tclvars, &hs);
+   while (th) {
+     tclvar = Tcl_GetHashValue(th);
+     if (tclvar->restrict >= restrict)
+       Tcl_LinkVar(tcli, Tcl_GetHashKey(&tclhash_tclvars, th), tclvar->data, tclvar->type);
+     th = Tcl_NextHashEntry(&hs);
+   }
+   /* Create Association for Unlink */
+   th = Tcl_CreateHashEntry(&tclhash_ins, ti->name, &i);
+   Tcl_SetHashValue(th, ti);
+   Tcl_SetAssocData(tcli, (char *) TCL_ASSOCNAME, tcl_interp_delete, th);
+ 
+   *result = (char *) "";
+ 
+   if (player != NOTHING) {
+     i = 0;
+     sprintf(aname, "TCLBOOT%d", i);
+     while ((a = atr_get(player, aname)) != NULL) {
+       i++;
+       sprintf(aname, "TCLBOOT%d", i);
+       strcpy(value, uncompress(a->value));
+       tcl_eval(ti, value, result);
+     }
+   }
+   return ti;
+ }
+ 
+ void
+ tcl_interp_delete(clientData, interp)
+     ClientData clientData;
+     Tcl_Interp *interp;
+ {
+   struct tcl_hook *hook, *ehook, *phook;
+   struct tcl_instance *ti;
+   int i;
+   FUN *fun;
+   COMMAND_INFO *cmd;
+   Tcl_HashEntry *th;
+   Tcl_HashSearch hs;
+   char *k;
+   Tcl_HashEntry *ihash;
+ 
+   /* Find Me */
+   ihash = (Tcl_HashEntry *) clientData;
+   ti = Tcl_GetHashValue(ihash);
+   Tcl_DeleteHashEntry(ihash);
+ 
+   /* Remove defined functions */
+ 
+   th = Tcl_FirstHashEntry(&tclhash_funs, &hs);
+   while (th) {
+     hook = Tcl_GetHashValue(th);
+     if (hook->ti == ti) {
+       /* Oh blunder */
+       k = Tcl_GetHashKey(&tclhash_funs, th);
+       fun = hashfind(k, &htab_function);
+       if (fun) {
+ 	hashdelete(k, &htab_function);
+ 	mush_free(fun, "function");
+       }
+       Tcl_DeleteHashEntry(th);
+       hook_free(hook);
+       th = Tcl_FirstHashEntry(&tclhash_funs, &hs);
+     } else {
+       th = Tcl_NextHashEntry(&hs);
+     }
+   }
+ 
+   /* Remove defined commands.. Need refining for aliases */
+ 
+   th = Tcl_FirstHashEntry(&tclhash_cmds, &hs);
+   while (th) {
+     hook = Tcl_GetHashValue(th);
+     if (hook->ti == ti) {
+       /* Oh double blunder */
+       k = Tcl_GetHashKey(&tclhash_cmds, th);
+       cmd = hashfind(k, &htab_command);
+       if (cmd) {
+ 	hashdelete(k, &htab_command);
+ 	free((char *) cmd->name);
+ 	mush_free(cmd, "tcl_command");
+       }
+       Tcl_DeleteHashEntry(th);
+       hook_free(hook);
+       th = Tcl_FirstHashEntry(&tclhash_cmds, &hs);
+     } else {
+       th = Tcl_NextHashEntry(&hs);
+     }
+   }
+ 
+   /* Remove defined event hooks */
+ 
+   for (i = 0; i < EVENT_MAX; i++) {
+     ehook = event_hooks[i];
+     phook = NULL;
+     while (ehook) {
+       hook = ehook->next;
+       if (ehook->ti == ti) {
+ 	if (!phook)
+ 	  event_hooks[i] = ehook->next;
+ 	else
+ 	  phook->next = ehook->next;
+ 	hook_free(ehook);
+ 	phook = ehook;
+       }
+       ehook = hook;
+     }
+   }
+ 
+   /* This should NOT happen */
+   if (ti->refs)
+     notify(Owner(ti->player), tprintf("TCL Warning: Intepreter %s killed with ref %i", ti->name, ti->refs));
+ 
+   free(ti->name);
+   mush_free(ti, "tcl_instance");
+ }
+ 
+ struct tcl_instance *
+ tcl_find_name(name)
+     char *name;
+ {
+   Tcl_HashEntry *th;
+   th = Tcl_FindHashEntry(&tclhash_ins, name);
+   if (th)
+     return Tcl_GetHashValue(th);
+   else
+     return NULL;
+ }
+ 
+ struct tcl_instance *
+ tcl_findinstance(interp)
+     Tcl_Interp *interp;
+ {
+   Tcl_HashEntry *th;
+   th = Tcl_GetAssocData(interp, (char *) TCL_ASSOCNAME, NULL);
+   if (th)
+     return Tcl_GetHashValue(th);
+   else
+     return NULL;
+ }
+ 
+ void
+ tcl_timer()
+ {
+   struct tcl_instance *ti;
+   Tcl_HashEntry *th;
+   Tcl_HashSearch hs;
+ 
+   tcl_timer_tick--;
+   if (tcl_timer_tick)
+     return;
+   tcl_timer_tick = 60;
+ 
+   th = Tcl_FirstHashEntry(&tclhash_ins, &hs);
+   while (th) {
+     /* Kill if unused, unreferenced, and not currently evaluating */
+     ti = Tcl_GetHashValue(th);
+     if ((ti->uses == 0) && (ti->refs == 0) && (ti->level == 0)) {
+       Tcl_DeleteInterp(ti->tcli);
+     } else {
+       ti->uses = 0;
+     }
+     th = Tcl_NextHashEntry(&hs);
+   }
+ }
+ 
+ int
+ tcl_load(master, filename, result)
+     int master;
+     char *filename;
+     char **result;
+ {
+   struct tcl_instance *ti;
+   Tcl_Obj *namePtr, *messagePtr;
+ 
+   if (!master) {
+     ti = tcl_spawn(GOD, filename, result);
+   } else {
+     ti = master_instance;
+   }
+ 
+   if (!ti)
+     return 0;
+ 
+   if (Tcl_EvalFile(ti->tcli, filename) != TCL_OK) {
+     namePtr = Tcl_NewStringObj((char *) "errorInfo", -1);
+     Tcl_IncrRefCount(namePtr);
+     messagePtr = Tcl_ObjGetVar2(ti->tcli, namePtr, NULL, TCL_GLOBAL_ONLY);
+     if (messagePtr) {
+       *result = Tcl_GetStringFromObj(messagePtr, NULL);
+     } else {
+       *result = Tcl_GetStringResult(ti->tcli);
+     }
+     Tcl_DecrRefCount(namePtr);
+     return 0;
+   }
+   *result = (char *) "Ok";
+   return 1;
+ }
+ 
+ 
+ int
+ tcl_eval(ti, command, result)
+     struct tcl_instance *ti;
+     char *command;
+     char **result;
+ {
+   int r;
+   char ebuff[BUFFER_LEN];
+   char *bp = ebuff;
+   Tcl_Obj *namePtr, *messagePtr;
+ 
+   if (!ti)
+     return 0;
+ 
+   ti->uses++;
+ 
+ #ifdef TCL_HASLIMITS
+   if (!tcl_level)
+     Tcl_SetGlobalCommandLimit(TCL_LIMIT_GLOBAL);
+ 
+   if (!ti->level) {
+     if (ti->restrict == 0)
+       Tcl_SetCommandLimit(ti->tcli, TCL_LIMIT_GOD);
+     else if (ti->restrict == 1)
+       Tcl_SetCommandLimit(ti->tcli, TCL_LIMIT_WIZ);
+     else
+       Tcl_SetCommandLimit(ti->tcli, TCL_LIMIT_MORTAL);
+   }
+ #endif
+ 
+   ti->level++;
+   tcl_level++;
+   r = (Tcl_Eval(ti->tcli, command) == TCL_OK);
+   tcl_level--;
+   ti->level--;
+ 
+   if (result) {
+     *result = Tcl_GetStringResult(ti->tcli);
+   }
+   if (!r && Connected(Owner(ti->player))) {
+     namePtr = Tcl_NewStringObj((char *) "errorInfo", -1);
+     Tcl_IncrRefCount(namePtr);
+     messagePtr = Tcl_ObjGetVar2(ti->tcli, namePtr, NULL, TCL_GLOBAL_ONLY);
+     safe_str("TCL: ", ebuff, &bp);
+     safe_str(ti->name, ebuff, &bp);
+     safe_chr('(', ebuff, &bp);
+     safe_str(unparse_dbref(ti->player), ebuff, &bp);
+     safe_str(") ERROR while executing \"", ebuff, &bp);
+     safe_str(command, ebuff, &bp);
+     safe_str("\":\n", ebuff, &bp);
+     safe_str(Tcl_GetStringFromObj(messagePtr, NULL), ebuff, &bp);
+     Tcl_DecrRefCount(namePtr);	/* free the name object */
+     *bp = '\0';
+     notify(Owner(ti->player), ebuff);
+   }
+   return r;
+ }
+ 
+ void
+ tcl_debugtrace(clientData, interp, level, command, cmdProc, cmdClientData, argc, argv)
+     ClientData clientData;
+     Tcl_Interp *interp;
+     int level;
+     char *command;
+     Tcl_CmdProc *cmdProc;
+     ClientData cmdClientData;
+     int argc;
+     char *argv[];
+ {
+   char buff[BUFFER_LEN];
+   struct tcl_instance *ti;
+   char *p;
+   int i;
+ 
+   ti = (struct tcl_instance *) clientData;
+   p = buff;
+   safe_str(ti->name, buff, &p);
+   safe_str("> ", buff, &p);
+   for (i = 1; i < level; i++)
+     safe_str("   ", buff, &p);
+   safe_str(command, buff, &p);
+   *p = '\0';
+   notify(Owner(ti->player), buff);
+ }
+ 
+ void
+ tcl_setdebug(ti, level)
+     struct tcl_instance *ti;
+     int level;
+ {
+   if (ti->trace)
+     Tcl_DeleteTrace(ti->tcli, ti->trace);
+ 
+   if (level)
+     ti->trace = Tcl_CreateTrace(ti->tcli, level, tcl_debugtrace, (ClientData) ti);
+   else
+     ti->trace = NULL;
+ }
+ 
+ /*********************************************************************
+  * Hooks
+  *
+  * Hooks are 'hooks' the TCL code here uses to know where and what
+  * should be executed when the hardcode requests something
+  * This handles the (semi)classic PennMUSH hooks, as well as 
+  * the wrappers for commands and functions
+  *
+  */
+ 
+ struct tcl_hook *
+ hook_init(hook, ti, proc)
+     struct tcl_hook *hook;
+     struct tcl_instance *ti;
+     char *proc;
+ {
+   if (!ti || !proc || !*proc)
+     return NULL;
+   if (hook) {
+     free(hook->proc);
+     hook->ti->refs--;
+   } else {
+     hook = mush_malloc(sizeof(struct tcl_hook), "tcl_hook");
+     hook->next = NULL;
+   }
+   hook->proc = strdup(proc);
+ #ifdef MEM_CHECK
+   add_check("tcl_hook_proc");
+ #endif
+   hook->ti = ti;
+   ti->refs++;
+   return hook;
+ }
+ 
+ void
+ hook_free(hook)
+     struct tcl_hook *hook;
+ {
+   if (!hook)
+     return;
+   hook->ti->refs--;
+   free(hook->proc);
+   mush_free(hook, "tcl_hook");
+ }
+ 
+ void
+ tclhook_doem(ht, args)
+     int ht;
+     char *args;
+ {
+   struct tcl_hook *hook;
+   Tcl_DString ds;
+   int r;
+   char *result;
+   char *execute;
+ 
+   hook = event_hooks[ht];
+ 
+   while (hook) {
+     if (args) {
+       Tcl_DStringInit(&ds);
+       Tcl_DStringAppend(&ds, hook->proc, -1);
+       Tcl_DStringAppend(&ds, " ", 1);
+       Tcl_DStringAppend(&ds, args, -1);
+       execute = Tcl_DStringValue(&ds);
+     } else {
+       execute = hook->proc;
+     }
+     r = tcl_eval(hook->ti, execute, &result);
+     if (args) {
+       Tcl_DStringFree(&ds);
+     }
+     hook = hook->next;
+   }
+ }
+ 
+ void
+ tclhook_startup()
+ {
+   tclhook_doem(EVENT_STARTUP, NULL);
+ }
+ 
+ void
+ tclhook_dbdump()
+ {
+   tclhook_doem(EVENT_DBDUMP, NULL);
+ }
+ 
+ void
+ tclhook_shutdown()
+ {
+   tclhook_doem(EVENT_SHUTDOWN, NULL);
+ }
+ 
+ void
+ tclhook_timer()
+ {
+   tclhook_doem(EVENT_TIMER, NULL);
+   tcl_timer();
+ }
+ 
+ void
+ tclhook_create(new)
+     dbref new;
+ {
+   tclhook_doem(EVENT_CREATE, unparse_integer(new));
+ }
+ 
+ void
+ tclhook_clone(new, source)
+     dbref new;
+     dbref source;
+ {
+   char buff[128];
+   sprintf(buff, "%d %d", new, source);
+   tclhook_doem(EVENT_CLONE, buff);
+ }
+ 
+ void
+ tclhook_free(item)
+     dbref item;
+ {
+   tclhook_doem(EVENT_FREE, unparse_integer(item));
+ }
+ 
+ /*********************************************************************
+  * TinyMUSH 2.2.4 Compability Commands.
+  *
+  * These are here so we can do exactly what TinyMUSH 2.2.4 does.
+  *
+  */
+ 
+ TCLCMD(tclcmd_pemit)
+ {
+   dbref target;
+   TCL_INIT;
+ 
+   if (objc != 3) {
+     Tcl_WrongNumArgs(interp, 1, objv, (char *) "target message");
+     return TCL_ERROR;
+   }
+   CMD_GETOBJECT(target, 1);
+   if (!okay_pemit(player, target)) {
+     TCL_NOPERM;
+   }
+   notify(target, Tcl_GetStringFromObj(objv[2], NULL));
+   return TCL_OK;
+ }
+ 
+ TCLCMD(tclcmd_getattrib)
+ {
+   dbref target;
+   ATTR *a;
+   TCL_INIT;
+ 
+   if (objc != 3) {
+     Tcl_WrongNumArgs(interp, 1, objv, (char *) "object attrname");
+     return TCL_ERROR;
+   }
+   CMD_GETOBJECT(target, 1);
+   a = atr_get(target, upcasestr(Tcl_GetStringFromObj(objv[2], NULL)));
+   if (!a && Can_Examine(player, target)) {
+     return TCL_OK;
+   } else if (!a || !Can_Read_Attr(player, target, a)) {
+     TCL_NOPERM;
+   }
+   Tcl_SetStringObj(resultPtr, uncompress(a->value), -1);
+   return TCL_OK;
+ }
+ 
+ TCLCMD(tclcmd_setattrib)
+ {
+   dbref target;
+   int res;
+   char *v;
+   char *an;
+   TCL_INIT;
+ 
+   if (objc != 4) {
+     Tcl_WrongNumArgs(interp, 1, objv, (char *) "object attrname value");
+     return TCL_ERROR;
+   }
+   CMD_GETOBJECT(target, 1);
+   if (!controls(player, target)) {
+     TCL_NOPERM;
+   }
+   an = upcasestr(Tcl_GetStringFromObj(objv[2], NULL));
+   v = Tcl_GetStringFromObj(objv[3], NULL);
+ 
+   res = (v && *v) ? atr_add(target, an, v, player, NOTHING)
+     : atr_clr(target, an, player);
+   if (res == -1) {
+     TCL_NOPERM;
+   }
+   return TCL_OK;
+ }
+ 
+ TCLCMD(tclcmd_mushfunc)
+ {
+   int j;
+   char *tptr[10];
+   char const *tp;
+   int nargs;
+   char buff[BUFFER_LEN];
+   char *bp;
+   TCL_INIT;
+ 
+   if (objc < 2) {
+     Tcl_WrongNumArgs(interp, 1, objv, (char *) "function");
+     return TCL_ERROR;
+   }
+   /* save our stack */
+   for (j = 0; j < 10; j++)
+     tptr[j] = wenv[j];
+ 
+   /* copy the appropriate args into the stack */
+   nargs = objc - 2;
+ 
+   if (nargs > 10)
+     nargs = 10;			/* maximum ten args */
+   for (j = 0; j < nargs; j++)
+     wenv[j] = Tcl_GetStringFromObj(objv[j + 2], NULL);
+   for (; j < 10; j++)
+     wenv[j] = NULL;
+ 
+   bp = buff;
+ 
+   tp = Tcl_GetStringFromObj(objv[1], NULL);
+   process_expression(buff, &bp, &tp, player, player, player,
+ 		     PE_DEFAULT, PT_DEFAULT, NULL);
+ 
+ 
+   /* restore the stack */
+   for (j = 0; j < 10; j++)
+     wenv[j] = tptr[j];
+ 
+   *bp = 0;
+   Tcl_SetStringObj(resultPtr, buff, -1);
+   return TCL_OK;
+ }
+ 
+ /*********************************************************************
+  * MUSHcode functions.
+  *
+  * These are MUSHcode callable functions, some of which were
+  * 'inherited' from 2.2.4
+  *
+  */
+ 
+ static void
+ handle_tclarrays(player, strname, copybufs, num, buff, bp)
+     dbref player;
+     char *strname;
+     char **copybufs;
+     int num;
+     char *buff;
+     char **bp;
+ {
+   struct tcl_instance *ti;
+   char *ep;
+   char tbuf[BUFFER_LEN];
+   int i;
+   char *v;
+   char eb[3];
+ 
+   ti = tcl_spawn(player, NULL, &ep);
+   if (!ti) {
+     safe_str("#-1 TCL SPAWN FAILED: ", buff, bp);
+     safe_str(ep, buff, bp);
+     return;
+   }
+   eb[0] = 0;
+ 
+   for (i = 0; i < num; i++) {
+     sprintf(tbuf, "%d", i);
+     if (copybufs && copybufs[i] && *copybufs[i])
+       v = copybufs[i];
+     else
+       v = eb;
+ 
+     Tcl_SetVar2(ti->tcli, strname, tbuf, v, 0);
+   }
+ }
+ 
+ FUNCTION(fun_tclclear)
+ {
+   struct tcl_instance *ti;
+ 
+   ti = tcl_find_name(args[0]);
+   if (!ti) {
+     safe_str("#-1 NOT FOUND", buff, bp);
+     return;
+   }
+   if (!controls(executor, ti->player)) {
+     safe_str("#-1 PERMISSION DENIED", buff, bp);
+     return;
+   }
+   Tcl_DeleteInterp(ti->tcli);
+ }
+ 
+ 
+ FUNCTION(fun_tclparams)
+ {
+   handle_tclarrays(executor, "mushparams", args, 10, buff, bp);
+ }
+ 
+ FUNCTION(fun_tclregs)
+ {
+   /* Oh blunder */
+   char *hum[10];
+   int i;
+ 
+   for (i = 0; i < 10; i++)
+     hum[i] = renv[i];
+ 
+   handle_tclarrays(executor, "mushregs", hum, 10, buff, bp);
+ }
+ 
+ FUNCTION(fun_tcleval)
+ {
+   dbref thing;
+   ATTR *a;
+   struct tcl_instance *ti;
+   char tbuf[BUFFER_LEN];
+   char command[BUFFER_LEN];
+   char *ep;
+   int r;
+ 
+   parse_attrib(executor, args[0], &thing, &a);
+   if (!a || !Can_Read_Attr(executor, thing, a)) {
+     safe_str("#-1 PERMISSION DENIED", buff, bp);
+     return;
+   }
+   /* The code is executed by the executor */
+ 
+   ti = tcl_spawn(executor, NULL, &ep);
+   if (!ti) {
+     safe_str("#-1 TCL SPAWN FAILED: ", buff, bp);
+     safe_str(ep, buff, bp);
+     return;
+   }
+   sprintf(tbuf, "%d", executor);
+   Tcl_SetVar(ti->tcli, (char *) "me", tbuf, 0);
+   sprintf(tbuf, "%d", enactor);
+   Tcl_SetVar(ti->tcli, (char *) "enactor", tbuf, 0);
+ 
+   handle_tclarrays(executor, "in", args + 1, 9, buff, bp);
+ 
+   strcpy(command, uncompress(a->value));
+   r = tcl_eval(ti, command, &ep);
+   if (!r)
+     safe_str("TCL ERROR", buff, bp);
+   else if (ep && *ep)
+     safe_str(ep, buff, bp);
+ }
+ 
+ FUNCTION(fun_tcl)
+ {
+   struct tcl_instance *ti;
+   char *ep;
+   int r;
+ 
+   ti = tcl_spawn(executor, NULL, &ep);
+   if (!ti) {
+     safe_str("#-1 TCL SPAWN FAILED: ", buff, bp);
+     safe_str(ep, buff, bp);
+     return;
+   }
+   handle_tclarrays(executor, "in", args + 1, 9, buff, bp);
+ 
+   r = tcl_eval(ti, args[0], &ep);
+ 
+   if (!r)
+     safe_str("TCL ERROR", buff, bp);
+   else if (ep && *ep)
+     safe_str(ep, buff, bp);
+ }
+ 
+ FUNCTION(fun_evaltime)
+ {
+   int run, min, max, total;
+   struct timeval start, stop;
+   char tbuff[BUFFER_LEN];
+   char *tbp;
+   const char *ep;
+   int j, i, count;
+   char *ws[10];
+ 
+ 
+ 
+   if (!Wizard(executor)) {
+     safe_str("#-1 NO PERMISSION", buff, bp);
+     return;
+   }
+   if (nargs == 2)
+     count = parse_number(args[1]);
+   else
+     count = 1;
+ 
+   for (j = 0; j < 10; j++)
+     ws[j] = wenv[j];
+ 
+   total = 0;
+   min = INT_MAX;
+   max = 0;
+   i = count;
+ 
+ 
+   while (i-- > 0) {
+     ep = args[0];
+     tbp = tbuff;
+     for (j = 0; j < 10; j++)
+       wenv[j] = 0;
+ 
+     gettimeofday(&start, NULL);
+     process_expression(tbuff, &tbp, &ep, executor, caller, enactor, PE_DEFAULT, PT_DEFAULT, NULL);
+     gettimeofday(&stop, NULL);
+     run = (stop.tv_sec - start.tv_sec) * 1000000 + (stop.tv_usec - start.tv_usec);
+     if (run > max)
+       max = run;
+     if (run < min)
+       min = run;
+     total += run;
+   }
+ 
+   for (j = 0; j < 10; j++)
+     wenv[j] = ws[j];
+ 
+   sprintf(tbuff, "%i %i %.2f", min, max, (total * 1.0) / (count * 1.0));
+   safe_str(tbuff, buff, bp);
+   return;
+ }
+ 
+ /*********************************************************************
+  * Server extending commands and callbacks
+  *
+  * This functions are the TCL commands and callbacks for new
+  * hardcode commands and functions
+  *
+  */
+ 
+ TCLCMD(tclcmd_addhook)
+ {
+   char *p, *t;
+   struct tcl_hook *hook, *ehook;
+   int ht;
+   TCL_INIT;
+ 
+   if (objc != 3) {
+     Tcl_WrongNumArgs(interp, 1, objv, (char *) "type proc");
+     return TCL_ERROR;
+   }
+   t = upcasestr(Tcl_GetStringFromObj(objv[1], NULL));
+   p = Tcl_GetStringFromObj(objv[2], NULL);
+ 
+   if (!t || !*t || !p || !*p) {
+     TCLERROR_STRING("addhook: function of proc name missing");
+   }
+   if (!strcmp(t, "STARTUP"))
+     ht = EVENT_STARTUP;
+   else if (!strcmp(t, "DBDUMP"))
+     ht = EVENT_DBDUMP;
+   else if (!strcmp(t, "SHUTDOWN"))
+     ht = EVENT_SHUTDOWN;
+   else if (!strcmp(t, "TIMER"))
+     ht = EVENT_TIMER;
+   else if (!strcmp(t, "CREATE"))
+     ht = EVENT_CREATE;
+   else if (!strcmp(t, "CLONE"))
+     ht = EVENT_CLONE;
+   else if (!strcmp(t, "FREE"))
+     ht = EVENT_FREE;
+   else {
+     TCLERROR_STRING("addhook: unknown hooktype");
+   }
+ 
+   hook = NULL;
+   ehook = event_hooks[ht];
+   while (ehook) {
+     if ((ehook->ti == ti) && !strcmp(ehook->proc, p)) {
+       hook = ehook;
+       break;
+     }
+     ehook = ehook->next;
+   }
+ 
+   hook = hook_init(hook, ti, p);
+ 
+   if (!ehook) {
+     hook->next = event_hooks[ht];
+     event_hooks[ht] = hook;
+   }
+   return TCL_OK;
+ }
+ 
+ TCLCMD(tclcmd_addfunc)
+ {
+   char *f, *p, *t;
+   struct tcl_hook *tf;
+   Tcl_HashEntry *th;
+   int min, max, type;
+   int r;
+   FUN *fun;
+   TCL_INIT;
+ 
+   if (objc != 6) {
+     Tcl_WrongNumArgs(interp, 1, objv, (char *) "funname proc minargs maxargs type");
+     return TCL_ERROR;
+   }
+   f = upcasestr(Tcl_GetStringFromObj(objv[1], NULL));
+   p = Tcl_GetStringFromObj(objv[2], NULL);
+   TCLGETINT(3, min);
+   TCLGETINT(4, max);
+   t = Tcl_GetStringFromObj(objv[5], NULL);
+ 
+   if (!f || !*f || !p || !*p) {
+     TCLERROR_STRING("addfunc: function or proc name missing");
+   }
+   if (t && !strcasecmp(t, "reg")) {
+     type = FN_REG;
+   } else if (t && !strcasecmp(t, "noparse")) {
+     type = FN_NOPARSE;
+   } else {
+     TCLERROR_STRING("addfunc: type is invalid");
+   }
+ 
+   th = Tcl_FindHashEntry(&tclhash_funs, f);
+   if (th)
+     tf = (struct tcl_hook *) Tcl_GetHashValue(th);
+   else
+     tf = NULL;
+ 
+   if (th && ti->restrict) {
+     if (tf->ti->tcli != interp) {
+       TCLERROR_STRING("addfunc: Function defined by other interpreter");
+     }
+   }
+   fun = hashfind(f, &htab_function);
+   if (fun) {
+     if (fun->fun == fun_gfun) {
+       TCLERROR_STRING("addfunc: Function is already @function defined");
+     }
+     if (fun->fun == fun_tclfun)
+       mush_free(fun, "tclfun");
+     hashdelete(f, &htab_function);
+   }
+   if (!th) {
+     th = Tcl_CreateHashEntry(&tclhash_funs, f, &r);
+     if (!r) {
+       TCLERROR_STRING("addfunc: Could not add to hash");
+     }
+   }
+   tf = hook_init(tf, ti, p);
+   Tcl_SetHashValue(th, tf);
+ 
+   p = strdup(f);
+ #ifdef MEM_CHECK
+   add_check("tcl_addfunc_name");
+ #endif
+   function_add(p, fun_tclfun, min, max, type);
+   return TCL_OK;
+ }
+ 
+ TCLCMD(tclcmd_addcmd)
+ {
+   char *c, *p, *flags;
+   struct tcl_hook *tf;
+   Tcl_HashEntry *th;
+   int r;
+   int cflag, ct, cf, cp;
+   char tbuff[BUFFER_LEN];
+   COMMAND_INFO *cmd;
+   TCL_INIT;
+ 
+   /* The only thing tclcommands don't do, is the HC switches. They are currently
+    * a bit outtascope
+    */
+ 
+   if (objc != 4) {
+     Tcl_WrongNumArgs(interp, 1, objv, (char *) "command proc flags");
+     return TCL_ERROR;
+   }
+   c = upcasestr(Tcl_GetStringFromObj(objv[1], NULL));
+   p = Tcl_GetStringFromObj(objv[2], NULL);
+   flags = Tcl_GetStringFromObj(objv[3], NULL);
+ 
+   if (!c || !*c || !p || !*p) {
+     TCLERROR_STRING("addcmd: command or proc name missing");
+   }
+   ct = cf = cp = 0;
+ 
+   cflag = CMD_T_ANY | CMD_T_SWITCHES;
+ 
+   /* FIXME : Do proper splitting, JEEZ! */
+   if (flags && *flags) {
+     sprintf(tbuff, " %s ", flags);
+     if (strstr(tbuff, " nogag "))
+       cflag |= CMD_T_NOGAGGED;
+     if (strstr(tbuff, " noguest "))
+       cflag |= CMD_T_NOGUEST;
+     if (strstr(tbuff, " wizard "))
+       cf |= WIZARD;
+     else if (strstr(tbuff, " admin "))
+       cf |= ROYALTY | WIZARD;
+     if (strstr(tbuff, " god "))
+       cflag |= CMD_T_GOD;
+     if (strstr(tbuff, " eqsplit "))
+       cflag |= CMD_T_EQSPLIT;
+     if (strstr(tbuff, " lnp "))
+       cflag |= CMD_T_LS_NOPARSE;
+     if (strstr(tbuff, " rnp "))
+       cflag |= CMD_T_RS_NOPARSE;
+     if (strstr(tbuff, " la "))
+       cflag |= CMD_T_LS_ARGS;
+     if (strstr(tbuff, " ra "))
+       cflag |= CMD_T_RS_ARGS;
+   }
+   th = Tcl_FindHashEntry(&tclhash_cmds, c);
+   if (th)
+     tf = (struct tcl_hook *) Tcl_GetHashValue(th);
+   else
+     tf = NULL;
+ 
+   if (tf && ti->restrict) {
+     if (tf->ti->tcli != interp) {
+       TCLERROR_STRING("cmdfunc: Command defined by other interpreter");
+     }
+   }
+   if (!th) {
+     th = Tcl_CreateHashEntry(&tclhash_cmds, c, &r);
+     if (!r) {
+       TCLERROR_STRING("addfunc: Could not add to hash");
+     }
+   }
+   cmd = hashfind(c, &htab_command);
+   if (!cmd) {
+     cmd = mush_malloc(sizeof(COMMAND_INFO), "tcl_command");
+     cmd->name = strdup(c);
+ #ifdef MEM_CHECK
+     add_check("tcl_command_name");
+ #endif
+     hashadd(cmd->name, (void *) cmd, &htab_command);
+   }
+   cmd->func = cmd_tclcmd;
+   cmd->type = cflag;
+   cmd->flags = cf;
+   cmd->toggles = ct;
+   cmd->powers = cp;
+   SW_ZERO(cmd->sw);
+ 
+   tf = hook_init(tf, ti, p);
+   Tcl_SetHashValue(th, tf);
+ 
+   return TCL_OK;
+ }
+ 
+ FUNCTION(fun_tclfun)
+ {
+   char *result;
+   Tcl_HashEntry *th;
+   struct tcl_hook *tf;
+   char tbuff[BUFFER_LEN];
+   int r;
+   int i;
+   Tcl_DString td;
+ 
+   th = Tcl_FindHashEntry(&tclhash_funs, called_as);
+   if (!th) {
+     safe_str("#-1 TCL INCONSISTENCY", buff, bp);
+     return;
+   }
+   tf = (struct tcl_hook *) Tcl_GetHashValue(th);
+ 
+   Tcl_DStringInit(&td);
+ 
+   sprintf(tbuff, "%s %i %i %i ", tf->proc, executor, caller, enactor);
+   Tcl_DStringAppend(&td, tbuff, -1);
+   Tcl_DStringStartSublist(&td);
+ 
+   for (i = 0; i < nargs; i++)
+     Tcl_DStringAppendElement(&td, args[i]);
+   Tcl_DStringEndSublist(&td);
+ 
+   r = tcl_eval(tf->ti, Tcl_DStringValue(&td), &result);
+   Tcl_DStringFree(&td);
+   if (!r) {
+     safe_str("#-1 TCL ERROR", buff, bp);
+   } else {
+     safe_str(result, buff, bp);
+   }
+ }
+ 
+ COMMAND (cmd_tclcmd) {
+   char *result;
+   Tcl_HashEntry *th;
+   struct tcl_hook *tf;
+   Tcl_DString td;
+   char tbuff[BUFFER_LEN];
+   int i, r;
+ 
+   th = Tcl_FindHashEntry(&tclhash_cmds, cmd->name);
+ 
+   if (!th) {
+     notify(player, "TCL ERROR");
+     return;
+   }
+   tf = (struct tcl_hook *) Tcl_GetHashValue(th);
+ 
+   Tcl_DStringInit(&td);
+ 
+   sprintf(tbuff, "%s %i %i ", tf->proc, player, cause);
+   Tcl_DStringAppend(&td, tbuff, -1);
+   Tcl_DStringAppendElement(&td, switches);
+   if (cmd->type & CMD_T_LS_ARGS) {
+     Tcl_DStringStartSublist(&td);
+     for (i = 1; args_left[i]; i++) {
+       Tcl_DStringAppendElement(&td, args_left[i]);
+     }
+     Tcl_DStringEndSublist(&td);
+   } else {
+     Tcl_DStringAppendElement(&td, arg_left);
+   }
+ 
+   if (cmd->type & CMD_T_EQSPLIT) {
+     if (cmd->type & CMD_T_RS_ARGS) {
+       Tcl_DStringStartSublist(&td);
+       for (i = 1; args_right[i]; i++) {
+ 	Tcl_DStringAppendElement(&td, args_right[i]);
+       }
+       Tcl_DStringEndSublist(&td);
+     } else {
+       Tcl_DStringAppendElement(&td, arg_right);
+     }
+   }
+   r = tcl_eval(tf->ti, Tcl_DStringValue(&td), &result);
+   Tcl_DStringFree(&td);
+   if (!r && (tf->ti->player != player))
+     notify(player, "TCL ERROR");
+ }
+ 
+ 
+ /*********************************************************************
+  *
+  * TCL Utility commands
+  * These are commands added to TCL which provide various utility
+  * functions
+  *
+  */
+ 
+ TCLCMD(tclcmd_loadfile)
+ {
+   int r;
+   char *result;
+   TCL_INIT;
+ 
+   if (objc != 2) {
+     Tcl_WrongNumArgs(interp, 1, objv, (char *) "filename");
+     return TCL_ERROR;
+   }
+   r = tcl_load(0, Tcl_GetStringFromObj(objv[1], NULL), &result);
+   if (!r) {
+     TCLERROR_STRING(result);
+   }
+   return TCL_OK;
+ }
+ 
+ /*********************************************************************
+  *
+  * Utility functions
+  * Various utility functions used elsewhere
+  *
+  */
+ 
+ char *
+ filebasename(filename)
+     char *filename;
+ {
+   char *s;
+   s = rindex(filename, '/');
+   if (s)
+     return (s + 1);
+   else
+     return filename;
+ }
+ 
+ int tb_num = 0;
+ 
+ char tb_buff[10][BUFFER_LEN];
+ 
+ char *
+ tempbuffer()
+ {
+   tb_num++;
+   if (tb_num >= 10)
+     tb_num = 0;
+   return tb_buff[tb_num];
+ }
+ 
+ char *
+ pdbref(object)
+     dbref object;
+ {
+   char *b;
+   b = tempbuffer();
+   sprintf(b, "#%d", object);
+   return b;
+ }
+ 
+ /*********************************************************************
+  *
+  * Penn TCL Commands
+  *
+  * Functions actually, since everything in TCL returns something..
+  * Anyway, this is the brunt of the commands that DO something
+  *
+  */
+ 
+ static int
+ attrib_lattr_helper(player, thing, pattern, atr, args)
+     dbref player;
+     dbref thing;
+     char const *pattern;
+     ATTR *atr;
+     void *args;
+ {
+   Tcl_DString *ds = args;
+   Tcl_DStringAppendElement(ds, AL_NAME(atr));
+   return 0;
+ }
+ 
+ TCLCMD(tclcmd_attrib)
+ {
+   dbref target, owner;
+   ATTR *a;
+   char *aname;
+   char *value;
+   int res;
+   int cindex;
+   Tcl_DString ds;
+   int toggle;
+ 
+   static const char *coptions[] =
+   {
+     "get", "getp", "canget",
+     "set", "canset",
+     "has", "hasp", "hasv", "haspv",
+     "list",
+     "flags",
+     "lock",
+     "owner",
+     NULL
+   };
+ 
+   enum coptions {
+     ATR_GET, ATR_GETP, ATR_CANGET,
+     ATR_SET, ATR_CANSET,
+     ATR_HAS, ATR_HASP, ATR_HASV, ATR_HASPV,
+     ATR_LIST,
+     ATR_FLAGS,
+     ATR_LOCK,
+     ATR_OWNER
+   };
+ 
+   TCL_INIT;
+ 
+   if (objc < 4) {
+     Tcl_WrongNumArgs(interp, 1, objv, (char *) "option object atrname ?arg ...?");
+     return TCL_ERROR;
+   }
+   if (Tcl_GetIndexFromObj(interp, objv[1], (char **) coptions, (char *) "option", 0,
+ 			  &cindex) != TCL_OK) {
+     return TCL_ERROR;
+   }
+   CMD_GETOBJECT(target, 2);
+   if (!GoodObject(target)) {
+     TCLERROR_STRING("Object not found");
+   }
+   aname = upcasestr(Tcl_GetStringFromObj(objv[3], NULL));
+   if (!aname || !*aname) {
+     TCLERROR_STRING("attrname cannot be empty");
+   }
+   value = NULL;
+   switch ((enum coptions) cindex) {
+   case ATR_GET:
+   case ATR_GETP:
+   case ATR_CANGET:
+     if (objc != 4) {
+       Tcl_WrongNumArgs(interp, 2, objv, (char *) "object atrname");
+       return TCL_ERROR;
+     }
+     if (cindex == ATR_GET)
+       a = atr_get_noparent(target, aname);
+     else
+       a = atr_get(target, aname);
+ 
+     if (cindex == ATR_CANGET) {
+       if (a)
+ 	Tcl_SetIntObj(resultPtr, (Can_Read_Attr(player, target, a)) ? 1 : 0);
+       else
+ 	Tcl_SetIntObj(resultPtr, (Can_Examine(player, target)) ? 1 : 0);
+       return TCL_OK;
+     }
+     if (!a) {
+       if (Can_Examine(player, target)) {
+ 	return TCL_OK;
+       } else {
+ 	TCL_NOPERM;
+       }
+     }
+     if (!Can_Read_Attr(player, target, a)) {
+       TCL_NOPERM;
+     }
+     Tcl_SetStringObj(resultPtr, uncompress(a->value), -1);
+     break;
+   case ATR_SET:
+     if ((objc != 5) && (objc != 4)) {
+       Tcl_WrongNumArgs(interp, 2, objv, (char *) "object atrname ?value?");
+       return TCL_ERROR;
+     }
+     if (objc == 5)
+       value = Tcl_GetStringFromObj(objv[4], NULL);
+ 
+     if (!controls(player, target)) {
+       TCL_NOPERM;
+     }
+     if (objc == 5)
+       res = atr_add(target, aname, value, player, NOTHING);
+     else
+       res = atr_clr(target, aname, player);
+ 
+     if (res == -1) {
+       TCL_NOPERM;
+     }
+     break;
+   case ATR_CANSET:
+     if (objc != 4) {
+       Tcl_WrongNumArgs(interp, 2, objv, (char *) "object atrname");
+       return TCL_ERROR;
+     }
+     if (!controls(player, target)) {
+       Tcl_SetIntObj(resultPtr, 0);
+     } else {
+       a = atr_get_noparent(target, aname);
+       if (a && !Can_Write_Attr(Owner(player), thing, a))
+ 	Tcl_SetIntObj(resultPtr, 0);
+       else
+ 	Tcl_SetIntObj(resultPtr, 1);
+     }
+     break;
+   case ATR_HAS:
+   case ATR_HASP:
+   case ATR_HASV:
+   case ATR_HASPV:
+     if (objc != 4) {
+       Tcl_WrongNumArgs(interp, 2, objv, (char *) "object atrname");
+       return TCL_ERROR;
+     }
+     if ((cindex == ATR_HAS) || (cindex == ATR_HASV))
+       a = atr_get_noparent(target, aname);
+     else
+       a = atr_get(target, aname);
+ 
+     if ((a && !Can_Read_Attr(player, target, a)) || (!Can_Examine(player, target))) {
+       TCL_NOPERM;
+     }
+     if ((cindex == ATR_HAS) || (cindex == ATR_HASP))
+       Tcl_SetIntObj(resultPtr, a ? 1 : 0);
+     else
+       Tcl_SetIntObj(resultPtr, (a && *AL_STR(a)) ? 1 : 0);
+     break;
+   case ATR_LIST:
+     if (objc != 4) {
+       Tcl_WrongNumArgs(interp, 2, objv, (char *) "object atrmask");
+       return TCL_ERROR;
+     }
+     if (!Can_Examine(player, target)) {
+       TCL_NOPERM;
+     }
+     Tcl_DStringInit(&ds);
+     atr_iter_get(player, target, aname, attrib_lattr_helper, &ds);
+     Tcl_DStringResult(interp, &ds);
+     Tcl_DStringFree(&ds);
+     break;
+   case ATR_FLAGS:
+     if ((objc != 4) && (objc != 5)) {
+       Tcl_WrongNumArgs(interp, 2, objv, (char *) "object atrname ?flags?");
+       return TCL_ERROR;
+     }
+     a = atr_get_noparent(target, aname);
+ 
+     if (objc == 5) {
+       CMD_ATTRIB_WRITECHECK;
+ 
+       value = Tcl_GetStringFromObj(objv[4], NULL);
+ 
+       res = string_to_privs(attr_privs, value, AL_FLAGS(a));
+       if (!Hasprivs(player))
+ 	res &= ~(AF_MDARK | AF_WIZARD);
+       AL_FLAGS(a) = res;
+     } else {
+       CMD_ATTRIB_READCHECK;
+     }
+     Tcl_SetStringObj(resultPtr, (char *) privs_to_string(attr_privs, AL_FLAGS(a)), -1);
+     break;
+   case ATR_LOCK:
+     if ((objc != 4) && (objc != 5)) {
+       Tcl_WrongNumArgs(interp, 2, objv, (char *) "object atrname ?0/1?");
+       return TCL_ERROR;
+     }
+     a = atr_get_noparent(target, aname);
+ 
+     if (objc == 5) {
+       CMD_ATTRIB_WRITECHECK;
+ 
+       res = Tcl_GetIntFromObj(interp, objv[4], &toggle);
+       if (res != TCL_OK)
+ 	return res;
+ 
+       if (toggle)
+ 	AL_FLAGS(a) |= AF_LOCKED;
+       else
+ 	AL_FLAGS(a) &= ~AF_LOCKED;
+     } else {
+       CMD_ATTRIB_READCHECK;
+     }
+     Tcl_SetIntObj(resultPtr, (AL_FLAGS(a) & AF_LOCKED) ? 1 : 0);
+     break;
+   case ATR_OWNER:
+     if ((objc != 4) && (objc != 5)) {
+       Tcl_WrongNumArgs(interp, 2, objv, (char *) "object atrname ?owner?");
+       return TCL_ERROR;
+     }
+     a = atr_get_noparent(target, aname);
+ 
+     if (objc == 5) {
+       CMD_ATTRIB_WRITECHECK;
+       CMD_GETOBJECT(owner, 4);
+       if (!GoodObject(owner)) {
+ 	TCLERROR_STRING("Object not found");
+       }
+       if (!Wizard(player) && (Owner(target) != owner)) {
+ 	TCL_NOPERM;
+       }
+       AL_CREATOR(a) = Owner(owner);
+     } else {
+       CMD_ATTRIB_READCHECK;
+     }
+     Tcl_SetIntObj(resultPtr, AL_CREATOR(a));
+     break;
+   }
+   return TCL_OK;
+ }
+ 
+ TCLCMD(tclcmd_object)
+ {
+   dbref target, new;
+   char *name;
+   char *value;
+   int cindex;
+   Tcl_DString ds;
+   char *p;
+   int ctype;
+   char *regs[10];
+   lock_type real_type;
+   struct boolexp *key;
+   object_flag_type pref_type;
+   long match_flags;
+   int ambig_ok;
+ 
+   static const char *coptions[] =
+   {
+     "create", "clone", "destroy",
+     "location", "contents", "exits",
+     "firstcontent", "firstexit", "next",
+     "link",
+     "owner", "parent", "zone",
+     "flags", "powers",
+     "lock", "elock",
+     "name",
+     "nearby", "match", "controls", "cansee",
+     NULL
+   };
+ 
+   enum coptions {
+     OBJ_CREATE, OBJ_CLONE, OBJ_DESTROY,
+     OBJ_LOCATION, OBJ_CONTENTS, OBJ_EXITS,
+     OBJ_FIRSTCONTENT, OBJ_FIRSTEXIT, OBJ_NEXT,
+     OBJ_LINK,
+     OBJ_OWNER, OBJ_PARENT, OBJ_ZONE,
+     OBJ_FLAGS, OBJ_POWERS,
+     OBJ_LOCK, OBJ_ELOCK,
+     OBJ_NAME,
+     OBJ_NEARBY, OBJ_MATCH, OBJ_CONTROLS, OBJ_CANSEE
+   };
+ 
+   TCL_INIT;
+ 
+   if (objc < 3) {
+     Tcl_WrongNumArgs(interp, 1, objv, (char *) "option ?arg ...?");
+     return TCL_ERROR;
+   }
+   if (Tcl_GetIndexFromObj(interp, objv[1], (char **) coptions, (char *) "option", 0,
+ 			  &cindex) != TCL_OK) {
+     return TCL_ERROR;
+   }
+   switch ((enum coptions) cindex) {
+   case OBJ_CREATE:
+     if (objc == 3) {
+       ctype = TYPE_THING;
+     } else if (objc == 4) {
+       value = Tcl_GetStringFromObj(objv[3], NULL);
+       if (!strcasecmp(value, "thing"))
+ 	ctype = TYPE_THING;
+       else if (!strcasecmp(value, "room"))
+ 	ctype = TYPE_ROOM;
+       else if (!strcasecmp(value, "exit"))
+ 	ctype = TYPE_EXIT;
+       else {
+ 	TCLERROR_STRING("Unknown object type");
+       }
+     } else {
+       Tcl_WrongNumArgs(interp, 2, objv, (char *) "name ?type?");
+       return TCL_ERROR;
+     }
+     name = Tcl_GetStringFromObj(objv[2], NULL);
+     if (!name || !*name) {
+       TCLERROR_STRING("Name cannot be blank");
+     }
+     switch (ctype) {
+     case TYPE_THING:
+       target = do_create(player, name, 10);
+       break;
+     case TYPE_ROOM:
+       regs[1] = NULL;
+       regs[2] = NULL;
+       target = do_dig(player, name, regs, 0);
+       break;
+     case TYPE_EXIT:
+       target = do_real_open(player, name, "", NOTHING);
+       break;
+     }
+     if (!GoodObject(target)) {
+       TCLERROR_STRING("Create failed for some reason");
+     }
+     Tcl_SetIntObj(resultPtr, target);
+     break;
+   case OBJ_CLONE:
+     if (objc != 3) {
+       Tcl_WrongNumArgs(interp, 2, objv, (char *) "object");
+       return TCL_ERROR;
+     }
+     CMD_GETOBJECT(target, 2);
+     target = do_clone(player, pdbref(target));
+     if (!GoodObject(target)) {
+       TCLERROR_STRING("Clone failed for some reason");
+     }
+     Tcl_SetIntObj(resultPtr, target);
+     break;
+   case OBJ_DESTROY:
+     if (objc != 3) {
+       Tcl_WrongNumArgs(interp, 2, objv, (char *) "object");
+       return TCL_ERROR;
+     }
+     CMD_GETOBJECT(target, 2);
+     do_destroy(player, pdbref(target), 1);
+     break;
+   case OBJ_LOCATION:
+     if ((objc != 3) && (objc != 4)) {
+       Tcl_WrongNumArgs(interp, 2, objv, (char *) "object ?newloc?");
+       return TCL_ERROR;
+     }
+     CMD_GETOBJECT(target, 2);
+     if (!Can_Examine(player, target)) {
+       TCL_NOPERM;
+     }
+     if (objc == 4) {
+       CMD_GETOBJECT(new, 3);
+       do_teleport(player, pdbref(target), pdbref(new));
+     }
+     Tcl_SetIntObj(resultPtr, Location(target));
+     break;
+   case OBJ_CONTENTS:
+     if (objc != 3) {
+       Tcl_WrongNumArgs(interp, 2, objv, (char *) "object");
+       return TCL_ERROR;
+     }
+     CMD_GETOBJECT(target, 2);
+     if (!Can_Examine(player, target)) {
+       TCL_NOPERM;
+     }
+     Tcl_DStringInit(&ds);
+     DOLIST(target, Contents(target)) {
+       Tcl_DStringAppendElement(&ds, unparse_integer(target));
+     }
+     Tcl_DStringResult(interp, &ds);
+     Tcl_DStringFree(&ds);
+     break;
+   case OBJ_FIRSTCONTENT:
+     if (objc != 3) {
+       Tcl_WrongNumArgs(interp, 2, objv, (char *) "object");
+       return TCL_ERROR;
+     }
+     CMD_GETOBJECT(target, 2);
+     if (!Can_Examine(player, target)) {
+       TCL_NOPERM;
+     }
+     Tcl_SetIntObj(resultPtr, Contents(target));
+     break;
+   case OBJ_EXITS:
+     if (objc != 3) {
+       Tcl_WrongNumArgs(interp, 2, objv, (char *) "object");
+       return TCL_ERROR;
+     }
+     CMD_GETOBJECT(target, 2);
+     if (!Can_Examine(player, target) || (Typeof(target) != TYPE_ROOM)) {
+       TCL_NOPERM;
+     }
+     Tcl_DStringInit(&ds);
+     DOLIST(target, Exits(target)) {
+       Tcl_DStringAppendElement(&ds, unparse_integer(target));
+     }
+     Tcl_DStringResult(interp, &ds);
+     Tcl_DStringFree(&ds);
+     break;
+   case OBJ_FIRSTEXIT:
+     if (objc != 3) {
+       Tcl_WrongNumArgs(interp, 2, objv, (char *) "object");
+       return TCL_ERROR;
+     }
+     CMD_GETOBJECT(target, 2);
+     if (!Can_Examine(player, target)) {
+       TCL_NOPERM;
+     }
+     Tcl_SetIntObj(resultPtr, Exits(target));
+     break;
+   case OBJ_NEXT:
+     if (objc != 3) {
+       Tcl_WrongNumArgs(interp, 2, objv, (char *) "object");
+       return TCL_ERROR;
+     }
+     CMD_GETOBJECT(target, 2);
+     if ((Typeof(target) == TYPE_ROOM) || ((Typeof(target) == TYPE_EXIT) && !Can_Examine(player, Source(target))) ||
+ 	!Can_Examine(player, Location(target))) {
+       TCL_NOPERM;
+     }
+     Tcl_SetIntObj(resultPtr, Next(target));
+     break;
+   case OBJ_LINK:
+     if (objc != 4) {
+       Tcl_WrongNumArgs(interp, 2, objv, (char *) "object linkto");
+       return TCL_ERROR;
+     }
+     CMD_GETOBJECT(target, 2);
+     CMD_GETOBJECT(new, 3);
+     do_link(player, pdbref(target), pdbref(new));
+     break;
+   case OBJ_OWNER:
+     if ((objc != 3) && (objc != 4)) {
+       Tcl_WrongNumArgs(interp, 2, objv, (char *) "object ?newowner?");
+       return TCL_ERROR;
+     }
+     CMD_GETOBJECT(target, 2);
+     if (objc == 4) {
+       CMD_GETOBJECT(new, 3);
+       do_chown(player, pdbref(target), pdbref(new));
+     }
+     Tcl_SetIntObj(resultPtr, Owner(target));
+     break;
+   case OBJ_PARENT:
+     if ((objc != 3) && (objc != 4)) {
+       Tcl_WrongNumArgs(interp, 2, objv, (char *) "object ?newparent?");
+       return TCL_ERROR;
+     }
+     CMD_GETOBJECT(target, 2);
+     if (!Can_Examine(player, target)) {
+       TCL_NOPERM;
+     }
+     if (objc == 4) {
+       CMD_GETOBJECT(new, 3);
+       do_parent(player, pdbref(target), (new == 0) ? (char *) "none" : pdbref(new));
+     }
+     Tcl_SetIntObj(resultPtr, Parent(target));
+     break;
+   case OBJ_ZONE:
+     if ((objc != 3) && (objc != 4)) {
+       Tcl_WrongNumArgs(interp, 2, objv, (char *) "object ?newzone?");
+       return TCL_ERROR;
+     }
+     CMD_GETOBJECT(target, 2);
+     if (!Can_Examine(player, target)) {
+       TCL_NOPERM;
+     }
+     if (objc == 4) {
+       CMD_GETOBJECT(new, 3);
+       do_chzone(player, pdbref(target), (new == 0) ? "none" : pdbref(new));
+     }
+     Tcl_SetIntObj(resultPtr, Zone(target));
+     break;
+   case OBJ_FLAGS:
+     if ((objc != 3) && (objc != 4)) {
+       Tcl_WrongNumArgs(interp, 2, objv, (char *) "object ?newflags?");
+       return TCL_ERROR;
+     }
+     CMD_GETOBJECT(target, 2);
+     if (objc == 4) {
+       if (!controls(player, target)) {
+ 	TCL_NOPERM;
+       }
+       value = Tcl_GetStringFromObj(objv[3], NULL);
+       for (p = value; *p && (*p == NOT_TOKEN || isspace(*p)); p++) ;
+       set_flag(player, target, p, (*value == NOT_TOKEN) ? 1 : 0, Hearer(target), Listener(target));
+     } else if (!Can_Examine(player, target)) {
+       TCL_NOPERM;
+     }
+     Tcl_SetStringObj(resultPtr, (char *) unparse_flags(target, player), -1);
+     break;
+   case OBJ_POWERS:
+     if ((objc != 3) && (objc != 4)) {
+       Tcl_WrongNumArgs(interp, 2, objv, (char *) "object ?newpowers?");
+       return TCL_ERROR;
+     }
+     CMD_GETOBJECT(target, 2);
+     if (objc == 4) {
+       if (!Wizard(player)) {
+ 	TCL_NOPERM;
+       }
+       value = Tcl_GetStringFromObj(objv[3], NULL);
+       for (p = value; *p && (*p == NOT_TOKEN || isspace(*p)); p++) ;
+       ctype = find_power(p);
+       if ((ctype == -1) || ((ctype == IS_GUEST) && Hasprivs(target))) {
+ 	TCLERROR_STRING("No such power");
+       }
+       if (*value == NOT_TOKEN)
+ 	Powers(target) &= ~ctype;
+       else
+ 	Powers(target) |= ctype;
+     } else if (!Can_Examine(player, target)) {
+       TCL_NOPERM;
+     }
+     Tcl_SetStringObj(resultPtr, (char *) power_description(target), -1);
+     break;
+   case OBJ_LOCK:
+     if ((objc != 4) && (objc != 5)) {
+       Tcl_WrongNumArgs(interp, 2, objv, (char *) "object locktype ?newkey?");
+       return TCL_ERROR;
+     }
+     CMD_GETOBJECT(target, 2);
+     if (!controls(player, target)) {
+       TCL_NOPERM;
+     }
+     real_type = check_lock_type(player, target, Tcl_GetStringFromObj(objv[3], NULL));
+     if (!real_type) {
+       TCLERROR_STRING("Unknown locktype");
+     }
+     if (objc == 4) {
+       delete_lock(target, real_type);
+     } else {
+       value = Tcl_GetStringFromObj(objv[4], NULL);
+       key = parse_boolexp(player, value);
+       if (key == TRUE_BOOLEXP) {
+ 	TCLERROR_STRING("Unknown key");
+       }
+       add_lock(target, real_type, key);
+     }
+     break;
+   case OBJ_ELOCK:
+     if (objc != 5) {
+       Tcl_WrongNumArgs(interp, 2, objv, (char *) "object locktype passer");
+       return TCL_ERROR;
+     }
+     CMD_GETOBJECT(target, 2);
+     CMD_GETOBJECT(new, 4);
+     if (!Can_Run_Lock(player, target, NULL)) {
+       TCL_NOPERM;
+     }
+     Tcl_SetIntObj(resultPtr, (eval_lock(new, target, Tcl_GetStringFromObj(objv[3], NULL))) ? 1 : 0);
+     break;
+   case OBJ_NAME:
+     if ((objc != 3) && (objc != 4)) {
+       Tcl_WrongNumArgs(interp, 2, objv, (char *) "object ?newname?");
+       return TCL_ERROR;
+     }
+     CMD_GETOBJECT(target, 2);
+     if (objc == 4) {
+       value = Tcl_GetStringFromObj(objv[3], NULL);
+       do_name(player, pdbref(target), value);
+     }
+     Tcl_SetStringObj(resultPtr, shortname(target), -1);
+     break;
+   case OBJ_NEARBY:
+     if (objc != 4) {
+       Tcl_WrongNumArgs(interp, 2, objv, (char *) "objecta objectb");
+       return TCL_ERROR;
+     }
+     CMD_GETOBJECT(target, 2);
+     CMD_GETOBJECT(new, 3);
+     if (!controls(player, target) && !controls(player, new) && !nearby(player, target) && !nearby(player, new)) {
+       TCL_NOPERM;
+     }
+     Tcl_SetIntObj(resultPtr, nearby(target, new) ? 1 : 0);
+     break;
+   case OBJ_MATCH:
+     if (objc != 5) {
+       Tcl_WrongNumArgs(interp, 2, objv, (char *) "object type matchstring");
+       return TCL_ERROR;
+     }
+     CMD_GETOBJECT(target, 2);
+     value = Tcl_GetStringFromObj(objv[3], NULL);
+     p = value;
+     pref_type = NOTYPE;
+     match_flags = 0;
+     ambig_ok = 0;
+     while (p && *p) {
+       switch (*p) {
+       case 'N':
+ 	pref_type = NOTYPE;
+ 	break;
+       case 'E':
+ 	pref_type = TYPE_EXIT;
+ 	break;
+       case 'P':
+ 	pref_type = TYPE_PLAYER;
+ 	break;
+       case 'R':
+ 	pref_type = TYPE_ROOM;
+ 	break;
+       case 'T':
+ 	pref_type = TYPE_THING;
+ 	break;
+       case 'L':
+ 	match_flags |= MAT_CHECK_KEYS;
+ 	break;
+       case '*':
+ 	match_flags |= MAT_EVERYTHING;
+ 	break;
+       case 'a':
+ 	match_flags |= MAT_ABSOLUTE;
+ 	break;
+       case 'c':
+ 	match_flags |= MAT_CARRIED_EXIT;
+ 	break;
+       case 'e':
+ 	match_flags |= MAT_EXIT;
+ 	break;
+       case 'h':
+ 	match_flags |= MAT_HERE;
+ 	break;
+       case 'i':
+ 	match_flags |= MAT_POSSESSION;
+ 	break;
+       case 'l':
+ 	match_flags |= MAT_CONTAINER;
+ 	break;
+       case 'm':
+ 	match_flags |= MAT_ME;
+ 	break;
+       case 'n':
+ 	match_flags |= MAT_NEIGHBOR;
+ 	break;
+       case 'p':
+ 	match_flags |= MAT_PLAYER;
+ 	break;
+       }
+       p++;
+     }
+     value = Tcl_GetStringFromObj(objv[4], NULL);
+     if (ambig_ok)
+       new = last_match_result(target, value, pref_type, match_flags);
+     else
+       new = match_result(target, value, pref_type, match_flags);
+     Tcl_SetIntObj(resultPtr, new);
+     break;
+   case OBJ_CONTROLS:
+     if (objc != 4) {
+       Tcl_WrongNumArgs(interp, 2, objv, (char *) "objecta objectb");
+       return TCL_ERROR;
+     }
+     CMD_GETOBJECT(target, 2);
+     CMD_GETOBJECT(new, 3);
+     if (!controls(player, target)) {
+       TCL_NOPERM;
+     }
+     Tcl_SetIntObj(resultPtr, controls(target, new) ? 1 : 0);
+     break;
+   case OBJ_CANSEE:
+     if (objc != 4) {
+       Tcl_WrongNumArgs(interp, 2, objv, (char *) "objecta objectb");
+       return TCL_ERROR;
+     }
+     CMD_GETOBJECT(target, 2);
+     CMD_GETOBJECT(new, 3);
+     Tcl_SetIntObj(resultPtr, Can_Examine(target, new) ? 1 : 0);
+     break;
+   }
+   return TCL_OK;
+ }
+ 
+ TCLCMD(tclcmd_notify)
+ {
+   int cindex;
+   char *string;
+   int narg, maxarg;
+   dbref room, target, exc;
+ 
+   static const char *coptions[] =
+   {
+     "object", "room", "zone", "channel",
+     NULL
+   };
+ 
+   enum coptions {
+     NOTIFY_OBJECT, NOTIFY_ROOM, NOTIFY_ZONE, NOTIFY_CHANNEL
+   };
+ 
+   TCL_INIT;
+ 
+   if (objc < 4) {
+     Tcl_WrongNumArgs(interp, 1, objv, (char *) "option arg ?args ...? message");
+     return TCL_ERROR;
+   }
+   if (Tcl_GetIndexFromObj(interp, objv[1], (char **) coptions, (char *) "option", 0,
+ 			  &cindex) != TCL_OK) {
+     return TCL_ERROR;
+   }
+   string = Tcl_GetStringFromObj(objv[objc - 1], NULL);
+   maxarg = objc - 1;
+   narg = 2;
+ 
+   switch ((enum coptions) cindex) {
+   case NOTIFY_OBJECT:
+     while (narg < maxarg) {
+       CMD_GETOBJECT(target, narg);
+       if (!okay_pemit(player, target)) {
+ 	TCL_NOPERM;
+       }
+       notify(target, string);
+       narg++;
+     }
+     break;
+   case NOTIFY_ROOM:
+     if (objc != 5) {
+       Tcl_WrongNumArgs(interp, 2, objv, (char *) "room exception message");
+       return TCL_ERROR;
+     }
+     CMD_GETOBJECT(target, 2);
+ #ifdef SPEECH_LOCK
+     if (!Hasprivs(player) && !eval_lock(player, target, Speech_Lock)) {
+       TCL_NOPERM;
+     }
+ #endif
+     CMD_CONVOBJECT(exc, 3);
+     if ((player != exc) && (Location(player) == target))
+       notify(player, string);
+     oemit_notify_except(target, player, GoodObject(exc) ? exc : NOTHING, string);
+     break;
+   case NOTIFY_ZONE:
+     if (objc != 4) {
+       Tcl_WrongNumArgs(interp, 2, objv, (char *) "zone message");
+       return TCL_ERROR;
+     }
+     CMD_GETOBJECT(target, 2);
+     if (!controls(player, target)) {
+       TCL_NOPERM;
+     }
+     for (room = 0; room < db_top; room++)
+       if ((Zone(room) == target) && (Typeof(room) == TYPE_ROOM)
+ #ifdef SPEECH_LOCK
+ 	  && (Hasprivs(player) || eval_lock(player, room, Speech_Lock))
+ #endif
+ 	)
+ 	oemit_notify_except(room, player, room, string);
+     break;
+   case NOTIFY_CHANNEL:
+     if (objc != 4) {
+       Tcl_WrongNumArgs(interp, 2, objv, (char *) "channel message");
+       return TCL_ERROR;
+     }
+     do_cemit(player, Tcl_GetStringFromObj(objv[2], NULL), string);
+     break;
+   }
+ 
+   return TCL_OK;
+ }
+ 
+ TCLCMD(tclcmd_ansi)
+ {
+   char *value;
+   int v;
+   TCL_INIT;
+ 
+   if (objc > 2) {
+     Tcl_WrongNumArgs(interp, 1, objv, (char *) "?color?");
+     return TCL_ERROR;
+   }
+   if (objc == 1) {
+     Tcl_SetStringObj(resultPtr, (char *) ANSI_NORMAL, -1);
+   } else {
+     value = Tcl_GetStringFromObj(objv[1], NULL);
+     if (*value) {
+       while (*value) {
+ 	v = -1;
+ 	switch (*value) {
+ 	case 'n':
+ 	  v = 0;
+ 	  break;
+ 	case 'h':
+ 	  v = 1;
+ 	  break;
+ 	case 'i':
+ 	  v = 7;
+ 	  break;
+ 	case 'f':
+ 	  v = 5;
+ 	  break;
+ 	case 'u':
+ 	  v = 4;
+ 	  break;
+ 	case 'x':
+ 	  v = 30;
+ 	  break;
+ 	case 'r':
+ 	  v = 31;
+ 	  break;
+ 	case 'g':
+ 	  v = 32;
+ 	  break;
+ 	case 'y':
+ 	  v = 33;
+ 	  break;
+ 	case 'b':
+ 	  v = 34;
+ 	  break;
+ 	case 'm':
+ 	  v = 35;
+ 	  break;
+ 	case 'c':
+ 	  v = 36;
+ 	  break;
+ 	case 'w':
+ 	  v = 37;
+ 	  break;
+ 	case 'X':
+ 	  v = 40;
+ 	  break;
+ 	case 'R':
+ 	  v = 41;
+ 	  break;
+ 	case 'G':
+ 	  v = 42;
+ 	  break;
+ 	case 'Y':
+ 	  v = 43;
+ 	  break;
+ 	case 'B':
+ 	  v = 44;
+ 	  break;
+ 	case 'M':
+ 	  v = 45;
+ 	  break;
+ 	case 'C':
+ 	  v = 46;
+ 	  break;
+ 	case 'W':
+ 	  v = 47;
+ 	  break;
+ 	case 't':
+ 	  Tcl_AppendToObj(resultPtr, (char *) "\t", -1);
+ 	  break;
+ 	case 'a':
+ 	  if (Wizard(player))
+ 	    Tcl_AppendToObj(resultPtr, (char *) "\a", -1);
+ 	  break;
+ 	default:
+ 	  TCLERROR_STRING("unknown ansi code");
+ 	}
+ 	if (v >= 0) {
+ 	  Tcl_AppendToObj(resultPtr, (char *) "\x1B[", -1);
+ 	  Tcl_AppendToObj(resultPtr, unparse_integer(v), -1);
+ 	  Tcl_AppendToObj(resultPtr, (char *) "m", -1);
+ 	}
+ 	value++;
+       }
+     }
+   }
+   return TCL_OK;
+ }
+ 
+ TCLCMD(tclcmd_html)
+ {
+   int cindex;
+   char *string;
+   int narg, maxarg;
+   dbref room, target, exc;
+ 
+   static const char *coptions[] =
+   {
+     "tag", "endtag", "tagwrap",
+     NULL
+   };
+ 
+   enum coptions {
+     HTML_TAG, HTML_ENDTAG, HTML_TAGWRAP
+   };
+ 
+   TCL_INIT;
+ 
+   if (objc == 2) {
+     Tcl_AppendToObj(resultPtr, (char *) "\02", -1);
+     Tcl_AppendToObj(resultPtr, Tcl_GetStringFromObj(objv[1], NULL), -1);
+     Tcl_AppendToObj(resultPtr, (char *) "\03", -1);
+     return TCL_OK;
+   }
+   if (objc < 3) {
+     Tcl_WrongNumArgs(interp, 1, objv, (char *) "option arg ?args ...?");
+     return TCL_ERROR;
+   }
+   if (Tcl_GetIndexFromObj(interp, objv[1], (char **) coptions, (char *) "option", 0,
+ 			  &cindex) != TCL_OK) {
+     return TCL_ERROR;
+   }
+   switch ((enum coptions) cindex) {
+   case HTML_TAG:
+     if ((objc != 3) && (objc != 4)) {
+       Tcl_WrongNumArgs(interp, 2, objv, (char *) "tag ?args?");
+       return TCL_ERROR;
+     }
+     Tcl_AppendToObj(resultPtr, (char *) "\02", -1);
+     Tcl_AppendToObj(resultPtr, Tcl_GetStringFromObj(objv[2], NULL), -1);
+     if (objc == 4) {
+       Tcl_AppendToObj(resultPtr, (char *) " ", -1);
+       Tcl_AppendToObj(resultPtr, Tcl_GetStringFromObj(objv[3], NULL), -1);
+     }
+     Tcl_AppendToObj(resultPtr, (char *) "\03", -1);
+     break;
+   case HTML_ENDTAG:
+     if (objc != 3) {
+       Tcl_WrongNumArgs(interp, 2, objv, (char *) "tag");
+       return TCL_ERROR;
+     }
+     Tcl_AppendToObj(resultPtr, (char *) "\02/", -1);
+     Tcl_AppendToObj(resultPtr, Tcl_GetStringFromObj(objv[2], NULL), -1);
+     Tcl_AppendToObj(resultPtr, (char *) "\03", -1);
+     break;
+   case HTML_TAGWRAP:
+     if ((objc != 4) && (objc != 5)) {
+       Tcl_WrongNumArgs(interp, 2, objv, (char *) "tag ?args? text");
+       return TCL_ERROR;
+     }
+     Tcl_AppendToObj(resultPtr, (char *) "\02", -1);
+     Tcl_AppendToObj(resultPtr, Tcl_GetStringFromObj(objv[2], NULL), -1);
+     if (objc == 5) {
+       Tcl_AppendToObj(resultPtr, (char *) " ", -1);
+       Tcl_AppendToObj(resultPtr, Tcl_GetStringFromObj(objv[3], NULL), -1);
+     }
+     Tcl_AppendToObj(resultPtr, (char *) "\03", -1);
+     if (objc == 5)
+       Tcl_AppendToObj(resultPtr, Tcl_GetStringFromObj(objv[4], NULL), -1);
+     else
+       Tcl_AppendToObj(resultPtr, Tcl_GetStringFromObj(objv[3], NULL), -1);
+     Tcl_AppendToObj(resultPtr, (char *) "\02/", -1);
+     Tcl_AppendToObj(resultPtr, Tcl_GetStringFromObj(objv[2], NULL), -1);
+     Tcl_AppendToObj(resultPtr, (char *) "\03", -1);
+     break;
+   }
+   return TCL_OK;
+ }
+ 
+ TCLCMD(tclcmd_debug)
+ {
+   int l;
+   TCL_INIT;
+ 
+   if (objc != 2) {
+     Tcl_WrongNumArgs(interp, 1, objv, (char *) "level");
+     return TCL_ERROR;
+   }
+   if (Tcl_GetIntFromObj(ti->tcli, objv[1], &l) == TCL_ERROR)
+     return TCL_ERROR;
+   tcl_setdebug(ti, l);
+   return TCL_OK;
+ }
+ 
+ /*********************************************************************
+  *
+  * MUSH Interface
+  * These are the MUSH @Commands and function()s we add to interface
+  * with TCL in PennStyle.
+  *
+  */
+ 
+ COMMAND (cmd_tcl) {
+   char *bp;
+   struct tcl_instance *ti;
+   int r, is;
+   Tcl_HashEntry *th;
+   Tcl_HashSearch hs;
+ 
+   if (SW_ISSET(sw, SWITCH_LOAD)) {
+     if (!God(player)) {
+       notify(player, "Permission REALLY denied.");
+       return;
+     }
+     r = tcl_load(SW_ISSET(sw, SWITCH_MASTER), arg_left, &bp);
+     notify(player, bp);
+   } else if (SW_ISSET(sw, SWITCH_RELOAD)) {
+     if (!God(player)) {
+       notify(player, "No, you can't");
+       return;
+     }
+     ti = tcl_find_name(arg_left);
+     if (!ti) {
+       notify(player, "Not found");
+       return;
+     }
+     Tcl_DeleteInterp(ti->tcli);
+     r = tcl_load(SW_ISSET(sw, SWITCH_MASTER), arg_left, &bp);
+     notify(player, bp);
+   } else if (SW_ISSET(sw, SWITCH_LIST)) {
+     th = Tcl_FirstHashEntry(&tclhash_ins, &hs);
+     notify(player, tprintf("%-20s%5s%5s%6s", "Name (Dbref#)", "Priv", "Refs", "Uses"));
+     while (th) {
+       ti = Tcl_GetHashValue(th);
+       if (Can_Examine(player, ti->player))
+ 	notify(player, tprintf("%-20s%5i%5i%6i", ti->name, ti->restrict, ti->refs, ti->uses));
+       th = Tcl_NextHashEntry(&hs);
+     }
+   } else if (SW_ISSET(sw, SWITCH_KILL)) {
+     if (!*arg_left) {
+       ti = tcl_find_name(pdbref(player));
+     } else {
+       ti = tcl_find_name(arg_left);
+     }
+     if (!ti || !controls(player, ti->player)) {
+       notify(player, "Not found or not controlled");
+       return;
+     }
+     Tcl_DeleteInterp(ti->tcli);
+     notify(player, "Killed");
+   } else if (SW_ISSET(sw, SWITCH_DEBUG)) {
+     if (!*arg_left) {
+       ti = tcl_find_name(pdbref(player));
+     } else {
+       ti = tcl_find_name(arg_left);
+     }
+     if (!ti || !controls(player, ti->player)) {
+       notify(player, "Not found or not controlled");
+       return;
+     }
+     if (ti->trace)
+       is = 1;
+     else
+       is = 0;
+     if (SW_ISSET(sw, SWITCH_ON))
+       r = 1;
+     if (SW_ISSET(sw, SWITCH_OFF))
+       r = 0;
+     else
+       r = !is;
+     if (r == is)
+       return;
+     if (r && (player != Owner(ti->player))) {
+       notify(player, "Only the owner can set something debug");
+       return;
+     }
+     tcl_setdebug(ti, (r) ? 1 : 0);
+     notify(player, tprintf("TCL Debugging now %s.", (r) ? "on" : "off"));
+   } else if (SW_ISSET(sw, SWITCH_STATUS)) {
+     if (SW_ISSET(sw, SWITCH_MASTER)) {
+       notify(player, "TCL Configuration");
+ #ifdef TCL_HASLIMITS
+       notify(player, tprintf("TCL Version      : %s (Patched)", TCL_PATCH_LEVEL));
+ #else
+       notify(player, tprintf("TCL Version      : %s (Unsafe)", TCL_PATCH_LEVEL));
+ #endif
+       notify(player, tprintf("TCL PatchVersion : %s", TCL_PATCHVERSION));
+ #ifdef TCL_HASLIMITS
+       notify(player, "Command Limits");
+       notify(player, tprintf("  Global         : %6ik", TCL_LIMIT_GLOBAL / 1000));
+       notify(player, tprintf("  God            : %6ik", TCL_LIMIT_GOD / 1000));
+       notify(player, tprintf("  Wizard         : %6ik", TCL_LIMIT_WIZ / 1000));
+       notify(player, tprintf("  Mortal         : %6ik", TCL_LIMIT_MORTAL / 1000));
+ #endif
+     } else {
+       if (!*arg_left) {
+ 	ti = tcl_find_name(pdbref(player));
+       } else {
+ 	ti = tcl_find_name(arg_left);
+       }
+       if (!ti || !Can_Examine(player, ti->player)) {
+ 	notify(player, "Not found or not allowed");
+ 	return;
+       }
+       notify(player, tprintf("Name  : %s", ti->name));
+       notify(player, tprintf("Owner : %s", pdbref(ti->player)));
+       notify(player, tprintf("Refs  : %i", ti->refs));
+       notify(player, tprintf("Uses  : %i", ti->uses));
+       notify(player, tprintf("Debug : %s", (ti->trace) ? "Yes" : "No"));
+       r = tcl_eval(ti, (char *) "if {[info procs status] == \"status\"} {status}", &bp);
+       if (r && *bp)
+ 	notify(player, tprintf("Status: %s", bp));
+     }
+   } else {
+     if (God(player) && SW_ISSET(sw, SWITCH_MASTER)) {
+       ti = master_instance;
+     } else {
+       ti = tcl_spawn(player, NULL, &bp);
+       if (!ti) {
+ 	notify(player, tprintf("TCL Spawn failed: %s", bp));
+ 	return;
+       }
+     }
+     r = tcl_eval(ti, arg_left, &bp);
+     if (r && bp && *bp)
+       notify(player, tprintf("Result: %s", bp));
+   }
+ }
+ 
+ #endif
*** ../clean/src/timer.c	Thu May 28 16:10:48 1998
--- src/timer.c	Sat Feb 21 22:54:46 1998
***************
*** 218,221 ****
--- 218,224 ----
  #endif
  
    local_timer();
+ #ifdef ENABLE_TCL
+   tclhook_timer();
+ #endif
  }
*** ../clean/src/Makefile	Tue Jul 21 22:11:22 1998
--- src/Makefile	Tue Jul 21 22:17:29 1998
***************
*** 104,109 ****
--- 104,110 ----
  speech.o \
  strdup.o \
  strutil.o \
+ tcl.o \
  timer.o \
  unparse.o \
  utils.o \
*** ../clean/src/SWITCHES	Thu May 28 16:10:54 1998
--- src/SWITCHES	Sat Feb 21 22:54:46 1998
***************
*** 49,56 ****
--- 49,59 ----
  INVENTORY
  IPRINT
  JOIN
+ KILL
+ LOAD
  LIST
  LOCATION
+ MASTER
  ME
  MOD
  MORTAL
***************
*** 80,85 ****
--- 83,89 ----
  QUIET
  READ
  REBOOT
+ RELOAD
  RENAME
  REGISTER
  RETROACTIVE
***************
*** 93,98 ****
--- 97,103 ----
  SILENT
  SPEAK
  STATS
+ STATUS
  SUMMARY
  TAG
  TELEPORT