/*************************************************************************\
* Copyright (c) 2002 The University of Chicago, as Operator of Argonne
* National Laboratory.
* Copyright (c) 2002 The Regents of the University of California, as
* Operator of Los Alamos National Laboratory.
* This file is distributed subject to a Software License Agreement found
* in the file LICENSE that is included with this distribution. 
\*************************************************************************/

/* 
 * $Log: not supported by cvs2svn $
 * Revision 1.7  2003/09/09 19:22:13  soliday
 * Added the "pv toggleErrorMode" command to work with Tcl catch statements.
 *
 * Revision 1.6  2003/08/08 20:43:59  soliday
 * Updated code so that this is a dynamically loadable extension.
 *
 * Revision 1.5  2002/08/14 20:44:34  soliday
 * Added Open License
 *
 * Revision 1.4  2001/01/16 22:33:26  soliday
 * BLT is no longer required to build this extension.
 *
 * Revision 1.3  2001/01/16 19:22:06  soliday
 * Added the ability to compile the extension with -DCATCH
 * This changes the return values so that you can use the catch() function.
 *
 * Revision 1.2  2001/01/15 22:16:58  soliday
 * Merged some of the changes from caTCL.
 *
 * Revision 1.1  1999/06/10 19:35:46  soliday
 * Moved to oag tree.
 *
 * Revision 1.3  1999/06/08 20:00:32  soliday
 * Removed compiler warnings under Linux.
 *
 * Revision 1.2  1999/03/17 22:35:02  soliday
 * Added blunderAhead option to tclCaLink.
 *
 * Revision 1.1.1.1  1996/05/07 19:08:39  saunders
 * Imported Files
 *
 *
 *-------------------------------------------------------------------
 * The following is the revision history while in OAG CVS Repository
 *-------------------------------------------------------------------
 * Revision 1.4  1996/04/19 20:09:59  saunders
 * 1. Added "pv unlink" command.
 * 2. Repaired a number of bugs in existing link command. Now permits
 *    multiple linkw on same pv, and behaves better if IOC goes down/up.
 * 3. Changed link command so that ca flushes are done in groups, not
 *    on a channel by channel basis. The only loss is in the specificity
 *    of the error messages when a connect fails.
 * 4. Tcl var is now initialized with pv value upon completion of the link.
 * 5. Removed length limitation on tcl var names supplied to pv commands.
 * 6. Removed repeated free/malloc's when DBR_STRING and DBR_ENUM gets
 *    are performed.
 *
 * Revision 1.3  1996/04/18 20:32:13  saunders
 * 1. Add drvh/drvl options to "pv info" command.
 * 2. Change tclCaHash.c to use Tcl supplied hash table library.
 * 3. Removed more unneeded indirection and variables in structs.
 *
 * Revision 1.2  1996/04/11 19:18:32  saunders
 * 1. Periodic pend_io time from .001 to 1e-9, resulting in poll.
 * 2. Use search_and_connect, not build_and_connect ca call.
 * 3. Removed ca_pend_io calls at end of async functions.
 * 4. Remove redundant call to ca_change_connection_event in updateChCtrl.
 * 5. Removed switch statement from howManyBytes (should be macro).
 * 6. Changed byte-by-byte copies to use memcpy instead.
 * 7. Removed some mixed use of ca_field_type() and iType.
 * 8. Removed redundant clause in if-then-else.
 * 9. Removed hardcoded pend_io timeouts. Use #define now.
 * 10. Removed unused calls to system time().
 * 11. Uppercased and lowercased stuff to follow conventions.
 *
 * Revision 1.1  1996/04/04 23:16:24  saunders
 * Renamed library files, ANSI-fied and reformatted code. Renamed external
 * function names to begin with tclCa library name.
 * */

#include <ctype.h>
#include <string.h>
#include <stdio.h>
#include <math.h>
#include <stdlib.h>
#include <tclCa.h>

#define VERSION "1.0"

#if ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 4)) || (TCL_MAJOR_VERSION > 8)
#define CACONST const
#else
#define CACONST
#endif

static int UseCatch=0;

/* Function Prototypes */
EXTERN int Tclca_Init(Tcl_Interp *interp);
int tclCaCmd(ClientData dummy, Tcl_Interp *interp, int argc, CACONST char *argv[]);
int tclCaCmd(ClientData dummy, Tcl_Interp *interp, int argc, CACONST char *argv[]) {

  int retval,temp;
  float pendVal;
  float pendIO_time = CA_PEND_IO_TIME;
  
  if (argc < 2) {
    if (UseCatch) {
      Tcl_SetResult(interp, "wrong # args: should be \"pv option arg ?arg ...?\"", TCL_STATIC);
      return TCL_ERROR;
    } else {
      Tcl_SetResult(interp, "1", (Tcl_FreeProc *) NULL);
      Tcl_SetErrorCode(interp, "pv: wrong # of args", (char *) NULL);
      return TCL_OK;
    }
  }
  else if (strcmp(argv[1], "stat") == 0) {
    if (UseCatch) {
      if (argc == 4) {
        return tclCaStat(interp,(char*)argv[2],(char*)argv[3], UseCatch);
      } else {
      	Tcl_SetResult(interp, "wrong # args: should be \"pv stat tclVar associative_array_name\"", TCL_STATIC);
      	return TCL_ERROR;
      }
    } else {
      if (argc == 4) {
	if (tclCaStat(interp,(char*)argv[2],(char*)argv[3], UseCatch) == 0){
	  Tcl_SetResult(interp, "0", (Tcl_FreeProc *) NULL);
	} else {
	  Tcl_SetResult(interp, "1", (Tcl_FreeProc *) NULL);
	}
      } else {
	Tcl_SetResult(interp, "1", (Tcl_FreeProc *) NULL);
	Tcl_SetErrorCode(interp, "stat: wrong # of args", (char *) NULL);
      }
      return TCL_OK;
    }
  }
  else if (strcmp(argv[1], "get") == 0) {
    if (UseCatch) {
      if (argc == 3) {
      	return tclCaGet(interp,(char*)argv[2],False,pendIO_time, UseCatch);
      } else if (argc == 4) {
        if ((pendVal = atof(argv[3])) == 0) {
          Tcl_SetResult(interp,"get: timeout must be a number", TCL_STATIC);
          return TCL_ERROR;
        } else {
          return tclCaGet(interp,(char*)argv[2],False,pendVal, UseCatch);
        }
      } else {
      	Tcl_SetResult(interp, "wrong # args: should be \"pv get tclVars ?timeout?\"", TCL_STATIC);
      	return TCL_ERROR;
      }
    } else {
      if (argc == 3) {
        if ((retval=tclCaGet(interp,(char*)argv[2],False,pendIO_time, UseCatch)) == 0){
          Tcl_SetResult(interp, "0", (Tcl_FreeProc *) NULL);
        } else {
          Tcl_SetResult(interp, "1",(Tcl_FreeProc *) NULL);
        }
      } else if (argc == 4) {
        if ((pendVal = atof(argv[3])) == 0) {
          Tcl_SetResult(interp, "1", (Tcl_FreeProc *) NULL);
          Tcl_SetErrorCode(interp, argv[3],"get: timeout must be a number", 
                           (char *) NULL);
        } else if ((retval = tclCaGet(interp,(char*)argv[2],False,pendVal, UseCatch)) == 0){
          Tcl_SetResult(interp, "0", (Tcl_FreeProc *) NULL);
        } else { 
          Tcl_SetResult(interp, "1",(Tcl_FreeProc *) NULL);
        }
      } else {
        Tcl_SetResult(interp, "1", (Tcl_FreeProc *) NULL);
        Tcl_SetErrorCode(interp, "get: wrong # of args", (char *) NULL);
      }
      return TCL_OK;
    }
  }
  else if (strcmp(argv[1], "getw") == 0) {
    if (UseCatch) {
      if (argc == 3) {
        return tclCaGet(interp,(char*)argv[2],True,pendIO_time, UseCatch);
      } else if (argc == 4) {
        if ((pendVal = atof(argv[3])) == 0 ) {
          Tcl_SetResult(interp,"getw: timeout must be a number", TCL_STATIC);
          return TCL_ERROR;
        } else {
          return tclCaGet(interp,(char*)argv[2],True,pendVal, UseCatch);
        }
      } else {
        Tcl_SetResult(interp, "wrong # args: should be \"pv getw tclVars ?timeout?\"", TCL_STATIC);
        return TCL_ERROR;
      }
    } else {
      if (argc == 3) {
        if((retval=tclCaGet(interp,(char*)argv[2],True,pendIO_time, UseCatch)) == 0){
          Tcl_SetResult(interp, "0", (Tcl_FreeProc *) NULL);
        } else {
          Tcl_SetResult(interp, "1",(Tcl_FreeProc *) NULL);
        }
      } else if (argc == 4) {
        if ((pendVal = atof(argv[3])) == 0 ) {
          Tcl_SetResult(interp, "1", (Tcl_FreeProc *) NULL);
          Tcl_SetErrorCode(interp, argv[3],"getw: timeout must be a number", 
                           (char *) NULL);
        } else if ((retval = tclCaGet(interp,(char*)argv[2],True,pendVal, UseCatch)) == 0){
          Tcl_SetResult(interp, "0", (Tcl_FreeProc *) NULL);
        } else {
          Tcl_SetResult(interp, "1",(Tcl_FreeProc *) NULL);
        }
      } else {
        Tcl_SetResult(interp, "1", (Tcl_FreeProc *) NULL);
        Tcl_SetErrorCode(interp, "getw: wrong # of args", (char *) NULL);
      }
      return TCL_OK;
    }
  }
  else if (strcmp(argv[1], "put") == 0) {
    if (UseCatch) {
      if (argc == 3) {
        return tclCaPut(interp,(char*)argv[2],False,False,pendIO_time, UseCatch);
      } else if (argc == 4) {
        if ((pendVal = atof(argv[3])) == 0 ) {
          Tcl_SetResult(interp,"put: timeout must be a number", TCL_STATIC);
          return TCL_ERROR;
        } else {
          return tclCaPut(interp,(char*)argv[2],False,False,pendVal, UseCatch);
        }
      } else {
        Tcl_SetResult(interp, "wrong # args: should be \"pv put tclVars ?timeout?\"", TCL_STATIC);
        return TCL_ERROR;
      }
    } else {
      if (argc == 3) {
        if ((retval=tclCaPut(interp,(char*)argv[2],False,False,pendIO_time, UseCatch)) == 0) {
          Tcl_SetResult(interp, "0", (Tcl_FreeProc *) NULL);
        } else {
          Tcl_SetResult(interp, "1",(Tcl_FreeProc *) NULL);
        }
        return TCL_OK;
      } else if (argc == 4) {
        if ((pendVal = atof(argv[3])) == 0 ) {
          Tcl_SetResult(interp, "1", (Tcl_FreeProc *) NULL);
          Tcl_SetErrorCode(interp, argv[3],"put: timeout must be a number", 
                           (char *) NULL);
        } else if ((retval=tclCaPut(interp,(char*)argv[2],False,False,pendVal, UseCatch)) == 0) {
          Tcl_SetResult(interp, "0", (Tcl_FreeProc *) NULL);
        } else { 
          Tcl_SetResult(interp, "1",(Tcl_FreeProc *) NULL);
        }
        return TCL_OK;
      } else {
        Tcl_SetResult(interp, "1", (Tcl_FreeProc *) NULL);
        Tcl_SetErrorCode(interp, "put: wrong # of args", (char *) NULL);
        return TCL_OK;
      }
    }
  }
  else if (strcmp(argv[1], "putw") == 0) {
    if (UseCatch) {
      if (argc == 3) {
      	return tclCaPut(interp,(char*)argv[2],True,False,pendIO_time, UseCatch);
      } else if (argc == 4) {
        if ((pendVal = atof(argv[3])) == 0) {
          Tcl_SetResult(interp, "putw: timeout must be a number", TCL_STATIC);
          return TCL_ERROR;
        } else {
          return tclCaPut(interp,(char*)argv[2],True,False,pendVal, UseCatch);
        }
      } else {
        Tcl_SetResult(interp, "wrong # args: should be \"pv putw tclVars ?timeout?\"", TCL_STATIC);
        return TCL_ERROR;
      }
    } else {
      if (argc == 3) {
        if ((retval=tclCaPut(interp,(char*)argv[2],True,False,pendIO_time, UseCatch)) == 0){
          Tcl_SetResult(interp, "0", (Tcl_FreeProc *) NULL);
        } else {
          Tcl_SetResult(interp, "1",(Tcl_FreeProc *) NULL);
        }
        return TCL_OK;
      } else if (argc == 4) {
        if ((pendVal = atof(argv[3])) == 0) {
          Tcl_SetResult(interp, "1", (Tcl_FreeProc *) NULL);
          Tcl_SetErrorCode(interp, argv[3],"putw: timeout must be a number", 
                           (char *) NULL);
        } else if ((retval=tclCaPut(interp,(char*)argv[2],True,False,pendVal, UseCatch)) == 0) {
          Tcl_SetResult(interp, "0", (Tcl_FreeProc *) NULL);
        } else {
          Tcl_SetResult(interp, "1",(Tcl_FreeProc *) NULL);
        }
        return TCL_OK;
      } else {
        Tcl_SetResult(interp, "1", (Tcl_FreeProc *) NULL);
        Tcl_SetErrorCode(interp, "putw: wrong # of args", (char *) NULL);
        return TCL_OK;
      }
    }
  }
  else if (strcmp(argv[1], "putq") == 0) {
    if (UseCatch) {
      if (argc == 3) {
      	return tclCaPut(interp,(char*)argv[2],True,True,pendIO_time, UseCatch);
      } else if (argc == 4) {
        if ((pendVal = atof(argv[3])) == 0) {
          Tcl_SetResult(interp,"putq: timeout must be a number", TCL_STATIC);
          return TCL_ERROR;
        } else {
          return tclCaPut(interp,(char*)argv[2],True,True,pendVal, UseCatch);
        }
      } else {
        Tcl_SetResult(interp, "wrong # args: should be \"pv putq tclVars ?timeout?\"", TCL_STATIC);
        return TCL_ERROR;
      }
    } else {
      if (argc == 3) {
        if ((retval=tclCaPut(interp,(char*)argv[2],True,True,pendIO_time, UseCatch)) == 0) {
          Tcl_SetResult(interp, "0", (Tcl_FreeProc *) NULL);
        } else {
          Tcl_SetResult(interp, "1",(Tcl_FreeProc *) NULL);
        }
        return TCL_OK;
      } else if (argc == 4) {
        if ((pendVal = atof(argv[3])) == 0) {
          Tcl_SetResult(interp, "1", (Tcl_FreeProc *) NULL);
          Tcl_SetErrorCode(interp, argv[3],"putq: timeout must be a number", 
                           (char *) NULL);
        } else if ((retval=tclCaPut(interp,(char*)argv[2],True,True,pendVal, UseCatch)) == 0) {
          Tcl_SetResult(interp, "0", (Tcl_FreeProc *) NULL);
        } else {
          Tcl_SetResult(interp, "1",(Tcl_FreeProc *) NULL);
        }
        return TCL_OK;
      } else {
        Tcl_SetResult(interp, "1", (Tcl_FreeProc *) NULL);
        Tcl_SetErrorCode(interp, "putq: wrong # of args", (char *) NULL);
        return TCL_OK;
      }
    }
  }
  else if (strcmp(argv[1], "link") == 0) {
    if (UseCatch) {
      if (argc == 4) {
      	return tclCaLink(interp,(char*)argv[2],(char*)argv[3],False,pendIO_time,0, UseCatch);
      } else if (argc == 5) {
        if ((pendVal = atof(argv[4])) == 0) {
          Tcl_SetResult(interp,"link: timeout must be a number:", TCL_STATIC);
          return TCL_ERROR;
        } else {
          return tclCaLink(interp,(char*)argv[2],(char*)argv[3],False,pendVal,0, UseCatch); 
        }
      } else {
        Tcl_SetResult(interp, "wrong # args: should be \"pv link tclVars iocVars ?timeout?\"", TCL_STATIC);
        return TCL_ERROR;
      }
    } else {
      if (argc == 4) {
        if ((retval=tclCaLink(interp,(char*)argv[2],(char*)argv[3],False,pendIO_time,0, UseCatch)) 
            == 0) {
          Tcl_SetResult(interp, "0", (Tcl_FreeProc *) NULL);
        } else {
          Tcl_SetResult(interp, "1",(Tcl_FreeProc *) NULL);
        }
      } else if (argc == 5) {
        if ((pendVal = atof(argv[4])) == 0) {
          Tcl_SetResult(interp, "1", (Tcl_FreeProc *) NULL);
          Tcl_SetErrorCode(interp, argv[4],"link: timeout must be a number:", 
                           (char *) NULL);
        } else if ((retval=tclCaLink(interp,(char*)argv[2],(char*)argv[3],False,pendVal,0, UseCatch)) 
                   == 0) {
          Tcl_SetResult(interp, "0", (Tcl_FreeProc *) NULL);
        } else { 
          Tcl_SetResult(interp, "1",(Tcl_FreeProc *) NULL);
        }
      } else {
        Tcl_SetResult(interp, "1", (Tcl_FreeProc *) NULL);
        Tcl_SetErrorCode(interp, "link: wrong # of args ", (char *) NULL);
      }
      return TCL_OK;
    }
  }
  else if (strcmp(argv[1], "linkw") == 0) {
    if (UseCatch) {
      if (argc == 4) {
      	return tclCaLink(interp,(char*)argv[2],(char*)argv[3],True,pendIO_time,0, UseCatch);
      } else if (argc == 5) {
        if (strcmp(argv[4], "-blunderAhead") == 0) {
          return tclCaLink(interp,(char*)argv[2],(char*)argv[3],True,pendIO_time,1, UseCatch);
        } else if ((pendVal = atof(argv[4])) == 0) {
          Tcl_SetResult(interp,"linkw: timeout must be a number", TCL_STATIC);
          return TCL_ERROR;
        } else {
          return tclCaLink(interp,(char*)argv[2],(char*)argv[3],True,pendVal,0, UseCatch);
        }
      } else if (argc == 6) {
        if (((pendVal = atof(argv[4])) == 0) || (strcmp(argv[5], "-blunderAhead") != 0)) {
          Tcl_SetResult(interp,"linkw: timeout must be a number and last option must be -blunderAhead", TCL_STATIC);
          return TCL_ERROR;
        }
        return tclCaLink(interp,(char*)argv[2],(char*)argv[3],True,pendVal,1, UseCatch);
      } else {
        Tcl_SetResult(interp, "wrong # args: should be \"pv linkw tclVars iocVars ?timeout?\"", TCL_STATIC);
        return TCL_ERROR;
      }
    } else {
      if (argc == 4) {
        if ((retval=tclCaLink(interp,(char*)argv[2],(char*)argv[3],True,pendIO_time,0, UseCatch)) 
            == 0) {
          Tcl_SetResult(interp, "0", (Tcl_FreeProc *) NULL);
        } else {
          Tcl_SetResult(interp, "1",(Tcl_FreeProc *) NULL);
        }
      } else if (argc == 5) {
        if (strcmp(argv[4], "-blunderAhead") == 0) {
          if ((retval=tclCaLink(interp,(char*)argv[2],(char*)argv[3],True,pendIO_time,1, UseCatch)) 
              == 0) {
            Tcl_SetResult(interp, "0", (Tcl_FreeProc *) NULL);
          } else {
            Tcl_SetResult(interp, "1",(Tcl_FreeProc *) NULL);
          }
        } else if ((pendVal = atof(argv[4])) == 0) {
          Tcl_SetResult(interp, "1", (Tcl_FreeProc *) NULL);
          Tcl_SetErrorCode(interp, argv[4],"linkw: timeout must be a number or -blunderAhead", 
                           (char *) NULL);
        } else if ((retval=tclCaLink(interp,(char*)argv[2],(char*)argv[3],True,pendVal,0, UseCatch)) 
                   == 0) {
          Tcl_SetResult(interp, "0", (Tcl_FreeProc *) NULL);
        } else {
          Tcl_SetResult(interp, "1",(Tcl_FreeProc *) NULL);
        }
      } else if (argc == 6) {
        if (((pendVal = atof(argv[4])) == 0) || (strcmp(argv[5], "-blunderAhead") != 0)) {
          Tcl_SetResult(interp, "1", (Tcl_FreeProc *) NULL);
          Tcl_SetErrorCode(interp, argv[4],"linkw: timeout must be a number and last option must be -blunderAhead", 
                           (char *) NULL);
        } else if ((retval=tclCaLink(interp,(char*)argv[2],(char*)argv[3],True,pendVal,1, UseCatch)) 
                   == 0) {
          Tcl_SetResult(interp, "0", (Tcl_FreeProc *) NULL);
        } else {
          Tcl_SetResult(interp, "1",(Tcl_FreeProc *) NULL);
        }
      } else {
        Tcl_SetResult(interp, "1", (Tcl_FreeProc *) NULL);
        Tcl_SetErrorCode(interp, "linkw: wrong # of args", (char *) NULL);
      }
      return TCL_OK;
    }
  }
  else if ( (strcmp(argv[1], "mon") == 0) ||
            (strcmp(argv[1], "umon") == 0)) {
    temp=0;
    if (UseCatch) {
      if (strcmp(argv[1], "umon") == 0) temp =1; 
      if (argc == 3) {
      	return tclCaMon(interp,(char*)argv[2],NULL,temp, UseCatch);
      } else if (argc == 4) {
      	return tclCaMon(interp,(char*)argv[2],(char*)argv[3],temp, UseCatch);
      } else {
        Tcl_SetResult(interp, "wrong # args: should be \"pv mon tclVars ?script?\"", TCL_STATIC);
        return TCL_ERROR;
      }
    } else {
      if (strcmp(argv[1], "umon") == 0) 
        temp =1; 
      if (argc == 3) {
        if (tclCaMon(interp,(char*)argv[2],NULL,temp, UseCatch) == 0) {
          Tcl_SetResult(interp, "0", (Tcl_FreeProc *) NULL);
        } else {
          Tcl_SetResult(interp, "1", (Tcl_FreeProc *) NULL);
        }
      } else if (argc == 4) {
        if (tclCaMon(interp,(char*)argv[2],(char*)argv[3],temp, UseCatch) == 0) {
          Tcl_SetResult(interp, "0", (Tcl_FreeProc *) NULL);
        } else {
          Tcl_SetResult(interp, "1", (Tcl_FreeProc *) NULL);
        }
      } else {
        Tcl_SetResult(interp, "1", (Tcl_FreeProc *) NULL);
        Tcl_SetErrorCode(interp, "mon: wrong # of args", (char *) NULL);
      }
      return TCL_OK;
    }
  }
  else if (strcmp(argv[1], "cmon") == 0) {
    if (UseCatch) {
      if (argc == 3) {
      	return tclCaCmon(interp,(char*)argv[2], UseCatch);
      } else {
        Tcl_SetResult(interp, "wrong # args: should be \"pv cmon tclVars\"", TCL_STATIC);
        return TCL_ERROR;
      }
    } else {
      if (argc == 3) {
        if (tclCaCmon(interp,(char*)argv[2], UseCatch) == 0) {
          Tcl_SetResult(interp, "0", (Tcl_FreeProc *) NULL);
        } else {
          Tcl_SetResult(interp, "1", (Tcl_FreeProc *) NULL);
        }
      } else {
        Tcl_SetResult(interp, "1", (Tcl_FreeProc *) NULL);
        Tcl_SetErrorCode(interp, "cmon: wrong # of args", (char *) NULL);
      }
      return TCL_OK;
    }
  }
  else if (strcmp(argv[1], "vdef") == 0) {
    if (UseCatch) {
      if (argc == 3) {
      	return tclCaVviewport(interp,(char*)argv[2],"{}", UseCatch);
      } else if (argc == 4) {
      	return tclCaVviewport(interp,(char*)argv[2],(char*)argv[3], UseCatch);
      } else {
        Tcl_SetResult(interp, "wrong # args: should be \"pv vdef tclVars ?base_size_precision?\"", TCL_STATIC);
        return TCL_ERROR;
      }
    } else {
      if (argc == 3) {
        if (tclCaVviewport(interp,(char*)argv[2],"{}", UseCatch) == 0) {
          Tcl_SetResult(interp, "0", (Tcl_FreeProc *) NULL);
        } else {
          Tcl_SetResult(interp, "1", (Tcl_FreeProc *) NULL);
        }
      }
      else if (argc == 4) {
        if (tclCaVviewport(interp,(char*)argv[2],(char*)argv[3], UseCatch) == 0) {
          Tcl_SetResult(interp, "0", (Tcl_FreeProc *) NULL);
        } else {
          Tcl_SetResult(interp, "1", (Tcl_FreeProc *) NULL);
        }
      } else {
        Tcl_SetResult(interp, "1", (Tcl_FreeProc *) NULL);
        Tcl_SetErrorCode(interp, "vdef: wrong # of args", (char *) NULL);
      }
      return TCL_OK;
    }
  }
  else if (strcmp(argv[1], "vset") == 0) {
    if (UseCatch) {
      if (argc == 3) {
      	return tclCaVviewget(interp,(char*)argv[2], UseCatch);
      } else if (argc == 4) {
      	return tclCaVviewput(interp,(char*)argv[2],(char*)argv[3], UseCatch);
      } else {
        Tcl_SetResult(interp, "wrong # args: should be \"pv vset tclVars ?list_of_values_to_be_written_to_tclVars?\"", TCL_STATIC);
        return TCL_ERROR;
      }
    } else {
      if (argc == 3) {
        if (tclCaVviewget(interp,(char*)argv[2], UseCatch) != 0) {
          Tcl_SetResult(interp, "1", (Tcl_FreeProc *) NULL);
        }
      }
      else if (argc == 4) {
        if (tclCaVviewput(interp,(char*)argv[2],(char*)argv[3], UseCatch) != 0) {
          Tcl_SetResult(interp, "1", (Tcl_FreeProc *) NULL);
        }
      } else {
        Tcl_SetResult(interp, "1", (Tcl_FreeProc *) NULL);
        Tcl_SetErrorCode(interp, "vset: wrong # of args", (char *) NULL);
      }
      return TCL_OK;
    }
  }
  else if (strcmp(argv[1], "vmap") == 0) {
#if !defined(USE_BLT)
    Tcl_SetResult(interp, "vmap: not available in this version", TCL_STATIC);
    return TCL_ERROR;
#else
    if (UseCatch) {
      if (argc == 4) {
      	return tclCaVmapToVector(interp,argv[2],argv[3], UseCatch); 
      } else {
        Tcl_SetResult(interp, "vmap: wrong # of args ", TCL_STATIC);
        return TCL_ERROR;
      }
    } else {
      if (argc == 4) {
        if ((retval=tclCaVmapToVector(interp,argv[2],argv[3], UseCatch)) 
            == 0) {
          Tcl_SetResult(interp, "0", (Tcl_FreeProc *) NULL);
        } else {
          Tcl_SetResult(interp, "1",(Tcl_FreeProc *) NULL);
        }
      } else {
        Tcl_SetResult(interp, "1", (Tcl_FreeProc *) NULL);
        Tcl_SetErrorCode(interp, "vmap: wrong # of args ", (char *) NULL);
      }
      return TCL_OK;
    }
#endif
  }
  else if (strcmp(argv[1], "info") == 0) {
    if (UseCatch) {
      if (argc != 4) {
        Tcl_SetResult(interp, "wrong # args: should be \"pv info tclVars requestedInfo\"", TCL_STATIC);
        return TCL_ERROR;
      }
      return tclCaInfostate(interp,(char*)argv[2],(char*)argv[3], UseCatch);
    } else {
      if (argc != 4) {
        Tcl_SetResult(interp, "1", (Tcl_FreeProc *) NULL);
        Tcl_SetErrorCode(interp, "wrong # args: should be \"pv info tclVars requestedInfo\"", (char *) NULL);
        return TCL_OK;
      }
      if (tclCaInfostate(interp,(char*)argv[2],(char*)argv[3], UseCatch) == -1) {
        Tcl_SetResult(interp, "1", (Tcl_FreeProc *) NULL);
      } 
      return TCL_OK;
    }
  }
  else if (strcmp(argv[1], "unlink") == 0) {
    if (UseCatch) {
      if (argc == 3) {
      	return tclCaUnLink(interp,(char*)argv[2], UseCatch);
      } else {
        Tcl_SetResult(interp, "wrong # args: should be \"pv unlink tclVars\"", TCL_STATIC);
        return TCL_ERROR;
      }
    } else {
      if (argc == 3) {
        if ((retval=tclCaUnLink(interp,(char*)argv[2], UseCatch)) == 0) {
          Tcl_SetResult(interp, "0", (Tcl_FreeProc *) NULL);
        } else {
          Tcl_SetResult(interp, "1",(Tcl_FreeProc *) NULL);
        }
      } else {
        Tcl_SetResult(interp, "1", (Tcl_FreeProc *) NULL);
        Tcl_SetErrorCode(interp, "unlink: wrong # of args ", (char *) NULL);
      }
      return TCL_OK;
    }
  }
  else if (strcmp(argv[1], "exit") == 0) {
    if (UseCatch) {
      if (argc == 2) {
      	return tclCaExit(interp, UseCatch);
      } else {
        Tcl_SetResult(interp, "wrong # args: should be \"pv exit\"", TCL_STATIC);
        return TCL_ERROR;
      }
    } else {
      if (argc == 2) {
        if ((retval=tclCaExit(interp, UseCatch)) == 0) {
          Tcl_SetResult(interp, "0", (Tcl_FreeProc *) NULL);
        } else {
          Tcl_SetResult(interp, "1",(Tcl_FreeProc *) NULL);
        }
      } else {
        Tcl_SetResult(interp, "1", (Tcl_FreeProc *) NULL);
        Tcl_SetErrorCode(interp, "exit: wrong # of args ", (char *) NULL);
      }
      return TCL_OK;
    }
  }
  else if (strcmp(argv[1], "toggleErrorMode") == 0) {
    if (UseCatch)
      UseCatch=0;
    else
      UseCatch=1;
    return TCL_OK;
  }
  else {
    if (UseCatch) {
      Tcl_AppendResult(interp, "bad option \"",argv[1],"\": must be stat, get, getw, put, putw, putq, link, linkw, mon, umon, cmon, vdef, vset, vmap, info, unlink, exit, toggleErrorMode" ,NULL);
      return TCL_ERROR;
    } else {
      Tcl_SetErrorCode(interp, argv[1], "Unknown command type ", (char *) NULL);
      Tcl_SetResult(interp, "1", (Tcl_FreeProc *) NULL);
      return TCL_OK;
    }
  }
}

int Tclca_Init(Tcl_Interp *interp) {
  if (Tcl_InitStubs(interp, "8.0", 0) == NULL) {
    return TCL_ERROR;
  }
  if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 0) == NULL) {
    if (TCL_VERSION[0] == '7') {
      if (Tcl_PkgRequire(interp, "Tcl", "8.0", 0) == NULL) {
	return TCL_ERROR;
      }
    }
  }
  if (Tcl_PkgProvide(interp, "ca", VERSION) != TCL_OK) {
    return TCL_ERROR;
  }

  Tcl_CreateCommand(interp, "pv", tclCaCmd, (ClientData *) NULL, \
		    (Tcl_CmdDeleteProc *)NULL);
  pv_hash_init();
  return TCL_OK;
}




