/*--------------------------------------------------------------*/
/* tclxcircuit.c:						*/
/*	Tcl routines for xcircuit command-line functions	*/
/* Copyright (c) 2003  Tim Edwards, Johns Hopkins University    */
/* Copyright (c) 2004  Tim Edwards, MultiGiG, Inc.		*/
/*--------------------------------------------------------------*/

#if defined(TCL_WRAPPER) && !defined(HAVE_PYTHON)

#include <stdio.h>
#include <stdarg.h>	/* for va_copy() */
#include <stdlib.h>	/* for atoi() and others */
#ifndef _MSC_VER
#include <unistd.h>     /* for usleep() */
#endif
#include <string.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <errno.h>

#include <tk.h>

#ifndef _MSC_VER
#include <X11/Intrinsic.h>
#include <X11/StringDefs.h>
#endif

#ifdef OPENGL
#include <GL/gl.h>
#include <GL/glx.h>
#endif /* OPENGL */

#include "xcircuit.h"
#include "cursors.h"
#include "colordefs.h"
#include "menudep.h"
#include "prototypes.h"

Tcl_HashTable XcTagTable;

extern Tcl_Interp *xcinterp;
extern Tcl_Interp *consoleinterp;
extern Display *dpy;
extern Colormap cmap;
extern Pixmap   STIPPLE[STIPPLES];  /* Polygon fill-style stipple patterns */
extern char _STR[150], _STR2[250];
extern Clientdata areastruct;
extern Globaldata xobjs;
extern int number_colors;
extern int *appcolors;
extern colorindex *colorlist;
extern Cursor appcursors[NUM_CURSORS];
extern ApplicationData appdata;
extern fontinfo *fonts;
extern short fontcount;
extern short eventmode;
extern u_char param_select[];
extern short textend, textpos;
extern keybinding *keylist;
extern Boolean spice_end;
extern short flstart;
extern Boolean pressmode;

#ifdef OPENGL
GLXContext	grXcontext;
XVisualInfo	*grVisualInfo;
float gl_line_limit, gl_point_limit;
#endif /* OPENGL */

char *message1, *message2, *message3;	/* Tk path names of message widgets */

/* Can't be extern? */
static char STIPDATA[STIPPLES][4] = {
   "\000\004\000\001",
   "\000\005\000\012",
   "\001\012\005\010",
   "\005\012\005\012",
   "\016\005\012\007",
   "\017\012\017\005",
   "\017\012\017\016",
   "\000\000\000\000"
};

short flags = -1;

#define LIBOVERRIDE     1
#define LIBLOADED       2
#define COLOROVERRIDE   4
#define FONTOVERRIDE    8
#define KEYOVERRIDE     16

/*-----------------------*/
/* Tcl 8.4 compatibility */
/*-----------------------*/

#ifndef CONST84
#define CONST84
#endif

/*----------------------------------------------------------------------*/
/* Deal with systems which don't define va_copy().			*/
/*----------------------------------------------------------------------*/

#ifndef HAVE_VA_COPY
  #ifdef HAVE___VA_COPY
    #define va_copy(a, b) __va_copy(a, b)
  #else
    #define va_copy(a, b) a = b
  #endif
#endif

/*----------------------------------------------------------------------*/
/* Reimplement strdup() to use Tcl_Alloc().				*/
/* Note that "strdup" is defined as "Tcl_Strdup" in xcircuit.h.		*/
/*----------------------------------------------------------------------*/

char *Tcl_Strdup(const char *s)
{
   char *snew;
   int slen;

   slen = 1 + strlen(s);
   snew = Tcl_Alloc(slen);
   if (snew != NULL)
      memcpy(snew, s, slen);

   return snew;
}

/*----------------------------------------------------------------------*/
/* Reimplement vfprintf() as a call to Tcl_Eval().			*/
/*----------------------------------------------------------------------*/

void tcl_vprintf(FILE *f, const char *fmt, va_list args_in)
{
   va_list args;
   static char outstr[128] = "puts -nonewline std";
   char *outptr, *bigstr = NULL, *finalstr = NULL;
   int i, nchars, result, escapes = 0, limit;

   /* If we are printing an error message, we want to bring attention	*/
   /* to it by mapping the console window and raising it, as necessary.	*/
   /* I'd rather do this internally than by Tcl_Eval(), but I can't	*/
   /* find the right window ID to map!					*/

   if ((f == stderr) && (consoleinterp != xcinterp)) {
      Tk_Window tkwind;
      tkwind = Tk_MainWindow(consoleinterp);
      if ((tkwind != NULL) && (!Tk_IsMapped(tkwind)))
	 result = Tcl_Eval(consoleinterp, "wm deiconify .\n");
      result = Tcl_Eval(consoleinterp, "raise .\n");
   }

   strcpy (outstr + 19, (f == stderr) ? "err \"" : "out \"");
   outptr = outstr;

   /* This mess circumvents problems with systems which do not have	*/
   /* va_copy() defined.  Some define __va_copy();  otherwise we must	*/
   /* assume that args = args_in is valid.				*/

   va_copy(args, args_in);
   nchars = vsnprintf(outptr + 24, 102, fmt, args);
   va_end(args);

   if (nchars >= 102) {
      va_copy(args, args_in);
      bigstr = Tcl_Alloc(nchars + 26);
      strncpy(bigstr, outptr, 24);
      outptr = bigstr;
      vsnprintf(outptr + 24, nchars + 2, fmt, args);
      va_end(args);
    }
    else if (nchars == -1) nchars = 126;

    for (i = 24; *(outptr + i) != '\0'; i++) {
       if (*(outptr + i) == '\"' || *(outptr + i) == '[' ||
	  	*(outptr + i) == ']' || *(outptr + i) == '\\')
	  escapes++;
    }

    if (escapes > 0) {
      finalstr = Tcl_Alloc(nchars + escapes + 26);
      strncpy(finalstr, outptr, 24);
      escapes = 0;
      for (i = 24; *(outptr + i) != '\0'; i++) {
	  if (*(outptr + i) == '\"' || *(outptr + i) == '[' ||
	    		*(outptr + i) == ']' || *(outptr + i) == '\\') {
	     *(finalstr + i + escapes) = '\\';
	     escapes++;
	  }
	  *(finalstr + i + escapes) = *(outptr + i);
      }
      outptr = finalstr;
    }

    *(outptr + 24 + nchars + escapes) = '\"';
    *(outptr + 25 + nchars + escapes) = '\0';

    result = Tcl_Eval(consoleinterp, outptr);

    if (bigstr != NULL) Tcl_Free(bigstr);
    if (finalstr != NULL) Tcl_Free(finalstr);
}
    
/*------------------------------------------------------*/
/* Console output flushing which goes along with the	*/
/* routine tcl_vprintf() above.				*/
/*------------------------------------------------------*/

void tcl_stdflush(FILE *f)
{   
   Tcl_SavedResult state;
   static char stdstr[] = "::flush stdxxx";
   char *stdptr = stdstr + 11;

   if ((f != stderr) && (f != stdout)) {
      fflush(f);
   }
   else {
      Tcl_SaveResult(xcinterp, &state);
      strcpy(stdptr, (f == stderr) ? "err" : "out");
      Tcl_Eval(xcinterp, stdstr);
      Tcl_RestoreResult(xcinterp, &state);
   }
}

/*----------------------------------------------------------------------*/
/* Reimplement fprintf() as a call to Tcl_Eval().			*/
/* Make sure that files (not stdout or stderr) get treated normally.	*/
/*----------------------------------------------------------------------*/

void tcl_printf(FILE *f, const char *format, ...)
{
  va_list ap;

  va_start(ap, format);
  if ((f != stderr) && (f != stdout))
     vfprintf(f, format, ap);
  else
     tcl_vprintf(f, format, ap);
  va_end(ap);
}

/*----------------------------------------------------------------------*/
/* Fill in standard areas of a key event structure.  This includes	*/
/* everything necessary except type, keycode, and state (although	*/
/* state defaults to zero).  This is also good for button events, which	*/
/* share the same structure as key events (except that keycode is	*/
/* changed to button).							*/
/*----------------------------------------------------------------------*/

void make_new_event(XKeyEvent *event)
{
   XPoint newpos, wpoint;

   newpos = UGetCursorPos();
   user_to_window(newpos, &wpoint);
   event->x = wpoint.x;
   event->y = wpoint.y;

   event->same_screen = TRUE;
   event->send_event = TRUE;
   event->display = dpy;
   event->window = Tk_WindowId(areastruct.area);

   event->state = 0;
}

/*----------------------------------------------------------------------*/
/* Implement tag callbacks on functions					*/
/* Find any tags associated with a command and execute them.		*/
/*----------------------------------------------------------------------*/

int XcTagCallback(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    int objidx, result = TCL_OK;
    char *postcmd, *substcmd, *newcmd, *sptr, *sres;
    char *croot = Tcl_GetString(objv[0]);
    Tcl_HashEntry *entry;
    Tcl_SavedResult state;
    int reset = FALSE;
    int i, llen, cmdnum;

    /* Skip over namespace qualifier, if any */

    if (!strncmp(croot, "::", 2)) croot += 2;
    if (!strncmp(croot, "xcircuit::", 10)) croot += 10;

    entry = Tcl_FindHashEntry(&XcTagTable, croot);
    postcmd = (entry) ? (char *)Tcl_GetHashValue(entry) : NULL;

    if (postcmd)
    {
	substcmd = (char *)Tcl_Alloc(strlen(postcmd) + 1);
	strcpy(substcmd, postcmd);
	sptr = substcmd;

	/*--------------------------------------------------------------*/
	/* Parse "postcmd" for Tk-substitution escapes			*/
	/* Allowed escapes are:						*/
	/* 	%W	substitute the tk path of the calling window	*/
	/*	%r	substitute the previous Tcl result string	*/
	/*	%R	substitute the previous Tcl result string and	*/
	/*		reset the Tcl result.				*/
	/*	%[0-5]  substitute the argument to the original command	*/
	/*	%N	substitute all arguments as a list		*/
	/*	%%	substitute a single percent character		*/
	/*	%*	(all others) no action: print as-is.		*/
	/*--------------------------------------------------------------*/

	while ((sptr = strchr(sptr, '%')) != NULL)
	{
	    switch (*(sptr + 1))
	    {
		case 'W': {
		    char *tkpath = NULL;
		    Tk_Window tkwind = Tk_MainWindow(interp);
		    if (tkwind != NULL) tkpath = Tk_PathName(tkwind);
		    if (tkpath == NULL)
			newcmd = (char *)Tcl_Alloc(strlen(substcmd));
		    else
			newcmd = (char *)Tcl_Alloc(strlen(substcmd) + strlen(tkpath));

		    strcpy(newcmd, substcmd);

		    if (tkpath == NULL)
			strcpy(newcmd + (int)(sptr - substcmd), sptr + 2);
		    else
		    {
			strcpy(newcmd + (int)(sptr - substcmd), tkpath);
			strcat(newcmd, sptr + 2);
		    }
		    Tcl_Free(substcmd);
		    substcmd = newcmd;
		    sptr = substcmd;
		    } break;

		case 'R':
		    reset = TRUE;
		case 'r':
		    sres = (char *)Tcl_GetStringResult(interp);
		    newcmd = (char *)Tcl_Alloc(strlen(substcmd)
				+ strlen(sres) + 1);
		    strcpy(newcmd, substcmd);
		    sprintf(newcmd + (int)(sptr - substcmd), "\"%s\"", sres);
		    strcat(newcmd, sptr + 2);
		    Tcl_Free(substcmd);
		    substcmd = newcmd;
		    sptr = substcmd;
		    break;

		case '0': case '1': case '2': case '3': case '4': case '5':
		    objidx = (int)(*(sptr + 1) - '0');
		    if ((objidx >= 0) && (objidx < objc))
		    {
		        newcmd = (char *)Tcl_Alloc(strlen(substcmd)
				+ strlen(Tcl_GetString(objv[objidx])));
		        strcpy(newcmd, substcmd);
			strcpy(newcmd + (int)(sptr - substcmd),
				Tcl_GetString(objv[objidx]));
			strcat(newcmd, sptr + 2);
			Tcl_Free(substcmd);
			substcmd = newcmd;
			sptr = substcmd;
		    }
		    else if (objidx >= objc)
		    {
		        newcmd = (char *)Tcl_Alloc(strlen(substcmd) + 1);
		        strcpy(newcmd, substcmd);
			strcpy(newcmd + (int)(sptr - substcmd), sptr + 2);
			Tcl_Free(substcmd);
			substcmd = newcmd;
			sptr = substcmd;
		    }
		    else sptr++;
		    break;

		case 'N':
		    llen = 1;
		    for (i = 1; i < objc; i++)
		       llen += (1 + strlen(Tcl_GetString(objv[i])));
		    newcmd = (char *)Tcl_Alloc(strlen(substcmd) + llen);
		    strcpy(newcmd, substcmd);
		    strcpy(newcmd + (int)(sptr - substcmd), "{");
		    for (i = 1; i < objc; i++) {
		       strcat(newcmd, Tcl_GetString(objv[i]));
		       if (i < (objc - 1))
			  strcat(newcmd, " ");
		    }
		    strcat(newcmd, "}");
		    strcat(newcmd, sptr + 2);
		    Tcl_Free(substcmd);
		    substcmd = newcmd;
		    sptr = substcmd;
		    break;

		case '%':
		    newcmd = (char *)Tcl_Alloc(strlen(substcmd) + 1);
		    strcpy(newcmd, substcmd);
		    strcpy(newcmd + (int)(sptr - substcmd), sptr + 1);
		    Tcl_Free(substcmd);
		    substcmd = newcmd;
		    sptr = substcmd;
		    break;

		default:
		    break;
	    }
	}

	/* Fprintf(stderr, "Substituted tag callback is \"%s\"\n", substcmd); */
	/* Flush(stderr); */

	Tcl_SaveResult(interp, &state);
	result = Tcl_Eval(interp, substcmd);
	if ((result == TCL_OK) && (reset == FALSE))
	    Tcl_RestoreResult(interp, &state);
	else
	    Tcl_DiscardResult(&state);

	Tcl_Free(substcmd);
    }
    return result;
}

/*--------------------------------------------------------------*/
/* Return the event mode					*/
/* Event mode can be set in specific cases.			*/
/*--------------------------------------------------------------*/

int xctcl_eventmode(ClientData clientData,
        Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
   static char *modeNames[] = {
	"normal", "undo", "move", "copy", "pan",
	"selarea", "rescale", "catalog", "cattext",
	"fontcat", "efontcat", "text", "wire", "box",
	"arc", "spline", "etext", "epoly", "earc",
	"espline", "epath", "assoc",
	NULL
   };

   /* This routine is diagnostic only */

   if (objc != 1) return TCL_ERROR;

   Tcl_SetResult(interp, modeNames[eventmode], NULL);
   return TCL_OK;
}

/*--------------------------------------------------------------*/
/* Add a command tag callback					*/
/*--------------------------------------------------------------*/

int xctcl_tag(ClientData clientData,
        Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    Tcl_HashEntry *entry;
    char *hstring;
    int new;

    if (objc != 2 && objc != 3)
	return TCL_ERROR;

    entry = Tcl_CreateHashEntry(&XcTagTable, Tcl_GetString(objv[1]), &new);
    if (entry == NULL) return TCL_ERROR;

    hstring = (char *)Tcl_GetHashValue(entry);
    if (objc == 2)
    {
	Tcl_SetResult(interp, hstring, NULL);
	return TCL_OK;
    }

    if (strlen(Tcl_GetString(objv[2])) == 0)
    {
	Tcl_DeleteHashEntry(entry);
    }
    else
    {
	hstring = strdup(Tcl_GetString(objv[2]));
	Tcl_SetHashValue(entry, hstring);
    }
    return TCL_OK;
}

/*----------------------------------------------------------------------*/
/* Get an x,y position (as an XPoint structure) from a list of size 2	*/
/*----------------------------------------------------------------------*/

int GetPositionFromList(Tcl_Interp *interp, Tcl_Obj *list, XPoint *rpoint)
{
   int result, numobjs;
   Tcl_Obj *lobj;
   int pos;

   if (!strcmp(Tcl_GetString(list), "here")) {
      if (rpoint) *rpoint = UGetCursorPos();
      return TCL_OK;
   }
   result = Tcl_ListObjLength(interp, list, &numobjs);
   if (result != TCL_OK) return result;

   if (numobjs != 2) {
      Tcl_SetResult(interp, "list must contain x y positions", NULL);
      return TCL_ERROR;
   }
   result = Tcl_ListObjIndex(interp, list, 0, &lobj);
   if (result != TCL_OK) return result;
   result = Tcl_GetIntFromObj(interp, lobj, &pos);
   if (result != TCL_OK) return result;
   if (rpoint) rpoint->x = pos;

   result = Tcl_ListObjIndex(interp, list, 1, &lobj);
   if (result != TCL_OK) return result;
   result = Tcl_GetIntFromObj(interp, lobj, &pos);
   if (result != TCL_OK) return result;
   if (rpoint) rpoint->y = pos;

   return TCL_OK;
}

/*--------------------------------------------------------------*/
/* Convert color index to a list of 3 elements			*/
/* We assume that this color exists in the color table.		*/
/*--------------------------------------------------------------*/

Tcl_Obj *TclIndexToRGB(int cidx)
{
   int i;
   Tcl_Obj *RGBTuple;

   if (cidx < 0) {	/* Handle "default color" */
      return Tcl_NewStringObj("Default", 7);
   }

   for (i = 0; i < number_colors; i++) {
      if (cidx == colorlist[i].color.pixel) {
	 RGBTuple = Tcl_NewListObj(0, NULL);
	 Tcl_ListObjAppendElement(xcinterp, RGBTuple,
		Tcl_NewIntObj((int)(colorlist[i].color.red / 256)));
	 Tcl_ListObjAppendElement(xcinterp, RGBTuple,
		Tcl_NewIntObj((int)(colorlist[i].color.green / 256)));
	 Tcl_ListObjAppendElement(xcinterp, RGBTuple,
		Tcl_NewIntObj((int)(colorlist[i].color.blue / 256)));
	 return RGBTuple;
      }
   }
   Tcl_SetResult(xcinterp, "invalid or unknown color index", NULL);
   return NULL;
}


/*--------------------------------------------------------------*/
/* Convert a stringpart* to a Tcl list object 			*/
/*--------------------------------------------------------------*/

Tcl_Obj *TclGetStringParts(stringpart *thisstring)
{
   Tcl_Obj *lstr, *sdict, *stup;
   int i;
   stringpart *strptr;
   
   lstr = Tcl_NewListObj(0, NULL);
   for (strptr = thisstring, i = 0; strptr != NULL;
      strptr = strptr->nextpart, i++) {
      switch(strptr->type) {
	 case TEXT_STRING:
	    sdict = Tcl_NewListObj(0, NULL);
	    Tcl_ListObjAppendElement(xcinterp, sdict, Tcl_NewStringObj("Text", 4));
	    Tcl_ListObjAppendElement(xcinterp, sdict,
			Tcl_NewStringObj(strptr->data.string,
			strlen(strptr->data.string)));
	    Tcl_ListObjAppendElement(xcinterp, lstr, sdict);
	    break;
	 case PARAM_START:
	    sdict = Tcl_NewListObj(0, NULL);
	    Tcl_ListObjAppendElement(xcinterp, sdict, Tcl_NewStringObj("Parameter", 9));
	    Tcl_ListObjAppendElement(xcinterp, sdict,
			Tcl_NewStringObj(strptr->data.string,
			strlen(strptr->data.string)));
	    Tcl_ListObjAppendElement(xcinterp, lstr, sdict);
	    break;
	 case PARAM_END:
	    Tcl_ListObjAppendElement(xcinterp, lstr,
			Tcl_NewStringObj("End Parameter", 13));
	    break;
	 case FONT_NAME:
	    sdict = Tcl_NewListObj(0, NULL);
	    Tcl_ListObjAppendElement(xcinterp, sdict, Tcl_NewStringObj("Font", 4));
	    Tcl_ListObjAppendElement(xcinterp, sdict,
		  Tcl_NewStringObj(fonts[strptr->data.font].psname,
		  strlen(fonts[strptr->data.font].psname)));
	    Tcl_ListObjAppendElement(xcinterp, lstr, sdict);
	    break;
	 case FONT_SCALE:
	    sdict = Tcl_NewListObj(0, NULL);
	    Tcl_ListObjAppendElement(xcinterp, sdict,
			Tcl_NewStringObj("Font Scale", 10));
	    Tcl_ListObjAppendElement(xcinterp, sdict,
			Tcl_NewDoubleObj((double)strptr->data.scale));
	    Tcl_ListObjAppendElement(xcinterp, lstr, sdict);
	    break;
	 case KERN:
	    sdict = Tcl_NewListObj(0, NULL);
	    stup = Tcl_NewListObj(0, NULL);
	    Tcl_ListObjAppendElement(xcinterp, stup,
			Tcl_NewIntObj((int)strptr->data.kern[0]));
	    Tcl_ListObjAppendElement(xcinterp, stup,
			Tcl_NewIntObj((int)strptr->data.kern[1]));

	    Tcl_ListObjAppendElement(xcinterp, sdict, Tcl_NewStringObj("Kern", 4));
	    Tcl_ListObjAppendElement(xcinterp, sdict, stup);
	    Tcl_ListObjAppendElement(xcinterp, lstr, sdict);
	    break;
	 case FONT_COLOR:
	    stup = TclIndexToRGB(strptr->data.color);
	    if (stup != NULL) {
	       sdict = Tcl_NewListObj(0, NULL);
	       Tcl_ListObjAppendElement(xcinterp, sdict,
			Tcl_NewStringObj("Color", 5));
	       Tcl_ListObjAppendElement(xcinterp, sdict, stup); 
	       Tcl_ListObjAppendElement(xcinterp, lstr, sdict);
	    }
	    break;
	 case TABSTOP:
	    Tcl_ListObjAppendElement(xcinterp, lstr,
			Tcl_NewStringObj("Tab Stop", 8));
	    break;
	 case TABFORWARD:
	    Tcl_ListObjAppendElement(xcinterp, lstr,
			Tcl_NewStringObj("Tab Forward", 11));
	    break;
	 case TABBACKWARD:
	    Tcl_ListObjAppendElement(xcinterp, lstr,
			Tcl_NewStringObj("Tab Backward", 12));
	    break;
	 case RETURN:
	    Tcl_ListObjAppendElement(xcinterp, lstr,
			Tcl_NewStringObj("Return", 6));
	    break;
	 case SUBSCRIPT:
	    Tcl_ListObjAppendElement(xcinterp, lstr,
			Tcl_NewStringObj("Subscript", 9));
	    break;
	 case SUPERSCRIPT:
	    Tcl_ListObjAppendElement(xcinterp, lstr,
			Tcl_NewStringObj("Superscript", 11));
	    break;
	 case NORMALSCRIPT:
	    Tcl_ListObjAppendElement(xcinterp, lstr,
			Tcl_NewStringObj("Normalscript", 12));
	    break;
	 case UNDERLINE:
	    Tcl_ListObjAppendElement(xcinterp, lstr,
			Tcl_NewStringObj("Underline", 9));
	    break;
	 case OVERLINE:
	    Tcl_ListObjAppendElement(xcinterp, lstr,
			Tcl_NewStringObj("Overline", 8));
	    break;
	 case NOLINE:
	    Tcl_ListObjAppendElement(xcinterp, lstr,
			Tcl_NewStringObj("No Line", 7));
	    break;
	 case HALFSPACE:
	    Tcl_ListObjAppendElement(xcinterp, lstr,
			Tcl_NewStringObj("Half Space", 10));
	    break;
	 case QTRSPACE:
	    Tcl_ListObjAppendElement(xcinterp, lstr,
			Tcl_NewStringObj("Quarter Space", 13));
	    break;
      }
   }
   return lstr;
}

/*----------------------------------------------------------------------*/
/* Get a stringpart linked list from a Tcl list				*/
/*----------------------------------------------------------------------*/

int GetXCStringFromList(Tcl_Interp *interp, Tcl_Obj *list, stringpart **rstring)
{
   int result, j, k, numobjs, idx, numparts, ptype, ival;
   Tcl_Obj *lobj, *pobj, *tobj, *t2obj;
   stringpart *newpart;
   char *fname;
   double fscale;

   static char *partTypes[] = {"Text", "Subscript", "Superscript",
	"Normalscript", "Underline", "Overline", "No Line", "Tab Stop",
	"Tab Forward", "Tab Backward", "Half Space", "Quarter Space", "Return",
	"Font", "Font Scale", "Color", "Kern", "Parameter", "End Parameter",
	"Special", NULL};

   static int partTypesIdx[] = {TEXT_STRING, SUBSCRIPT, SUPERSCRIPT,
	NORMALSCRIPT, UNDERLINE, OVERLINE, NOLINE, TABSTOP, TABFORWARD,
	TABBACKWARD, HALFSPACE, QTRSPACE, RETURN, FONT_NAME, FONT_SCALE,
	FONT_COLOR, KERN, PARAM_START, PARAM_END, SPECIAL};

   /* No place to put result! */
   if (rstring == NULL) return TCL_ERROR;

   result = Tcl_ListObjLength(interp, list, &numobjs);
   if (result != TCL_OK) return result;

   newpart = NULL;
   for (j = 0; j < numobjs; j++) {
      result = Tcl_ListObjIndex(interp, list, j, &lobj);
      if (result != TCL_OK) return result;

      result = Tcl_ListObjLength(interp, lobj, &numparts);

      /* Must define TCL_EXACT in flags, or else, for instance, "u" gets */
      /* interpreted as "underline", which is usually not intended.	 */

      result = Tcl_ListObjIndex(interp, lobj, 0, &pobj);
      if (Tcl_GetIndexFromObj(interp, pobj, (CONST84 char **)partTypes,
		"string part types", TCL_EXACT, &idx) != TCL_OK) {
	 Tcl_ResetResult(interp);
	 idx = -1;
         result = Tcl_ListObjIndex(interp, lobj, 0, &tobj);
      }
      else {
	 if (numparts > 1)
	    result = Tcl_ListObjIndex(interp, lobj, 1, &tobj);
      }
      if (result != TCL_OK) return result;

      if (idx < 0) {
	 if ((newpart == NULL) || (newpart->type != TEXT_STRING))
	    idx = 0;
	 else {
	    /* We have an implicit text string which should be appended	*/
	    /* to the previous text string with a space character.	*/
	    newpart->data.string = (char *)realloc(newpart->data.string,
		strlen(newpart->data.string) + strlen(Tcl_GetString(tobj))
		+ 2);
	    strcat(newpart->data.string, " ");
	    strcat(newpart->data.string, Tcl_GetString(tobj));
	    continue;
	 }
      }
      ptype = partTypesIdx[idx];

      newpart = makesegment(rstring, NULL);
      newpart->nextpart = NULL;
      newpart->type = ptype;
      
      switch(ptype) {
	 case TEXT_STRING:
	 case PARAM_START:
	    newpart->data.string = strdup(Tcl_GetString(tobj));
	    break;
	 case FONT_NAME:
	    fname = Tcl_GetString(tobj);
	    for (k = 0; k < fontcount; k++) {
	       if (!strcmp(fonts[k].psname, fname)) {
		  newpart->data.font = k;
		  break;
	       }
	    }
	    if (k == fontcount) {
	       Tcl_SetResult(interp, "Bad font name", NULL);
	       return TCL_ERROR;
	    }
	    break;
	 case FONT_SCALE:
	    result = Tcl_GetDoubleFromObj(interp, tobj, &fscale);
	    if (result != TCL_OK) return result;
	    newpart->data.scale = (float)fscale;
	    break;
	 case KERN:
	    result = Tcl_ListObjLength(interp, tobj, &numparts);
	    if (result != TCL_OK) return result;
	    if (numparts != 2) {
	       Tcl_SetResult(interp, "Bad kern list:  need 2 values", NULL);
	       return TCL_ERROR;
	    }
	    result = Tcl_ListObjIndex(interp, tobj, 0, &t2obj);
	    if (result != TCL_OK) return result;
	    result = Tcl_GetIntFromObj(interp, t2obj, &ival);
	    if (result != TCL_OK) return result;
	    newpart->data.kern[0] = (short)ival;

	    result = Tcl_ListObjIndex(interp, tobj, 1, &t2obj);
	    if (result != TCL_OK) return result;
	    result = Tcl_GetIntFromObj(interp, t2obj, &ival);
	    if (result != TCL_OK) return result;
	    newpart->data.kern[1] = (short)ival;

	    break;
	 case FONT_COLOR:
	    /* Not implemented:  Need TclRGBToIndex() function */
	    break;

	 /* All other types have no arguments */
      }
   }
   return TCL_OK;
}

/*----------------------------------------------------------------------*/
/* Handle (integer representation of internal xcircuit object) checking	*/
/* if "checkobject" is NULL, then 
/*----------------------------------------------------------------------*/

genericptr *CheckHandle(pointertype eaddr, objectptr checkobject)
{
   genericptr *gelem;
   int i, j;
   objectptr thisobj;
   Library *thislib;

   if (checkobject != NULL) {
      for (gelem = checkobject->plist; gelem < checkobject->plist +
		checkobject->parts; gelem++)
	 if ((pointertype)(*gelem) == eaddr) goto exists;
      return NULL;
   }

   /* Look through all the pages. */

   for (i = 0; i < xobjs.pages; i++) {
      if (xobjs.pagelist[i]->pageinst == NULL) continue;
      thisobj = xobjs.pagelist[i]->pageinst->thisobject;
      for (gelem = thisobj->plist; gelem < thisobj->plist + thisobj->parts; gelem++)
         if ((pointertype)(*gelem) == eaddr) goto exists;
   }

   /* Not found?  Maybe in a library */

   for (i = 0; i < xobjs.numlibs; i++) {
      thislib = xobjs.userlibs + i;
      for (j = 0; j < thislib->number; j++) {
         thisobj = thislib->library[j];
         for (gelem = thisobj->plist; gelem < thisobj->plist + thisobj->parts; gelem++)
            if ((pointertype)(*gelem) == eaddr) goto exists;
      }
   }

   /* Either in the delete list (where we don't want to go) or	*/
   /* is an invalid number.					*/
   return NULL;

exists:
   return gelem;
}

/*----------------------------------------------------------------------*/
/* Find the index into the "plist" list of elements			*/
/* Part number must be of a type in "mask" or no selection occurs.	*/
/* return values:  -1 = no object found, -2 = found, but wrong type	*/
/*----------------------------------------------------------------------*/

short GetPartNumber(genericptr egen, objectptr checkobject, int mask)
{
   genericptr *gelem;
   objectptr thisobject = checkobject;
   int i;

   if (checkobject == NULL) thisobject = topobject;

   for (i = 0, gelem = thisobject->plist; gelem < thisobject->plist +
		thisobject->parts; gelem++, i++) {
      if ((*gelem) == egen) {
	 if ((*gelem)->type & mask)
	    return i;
	 else
	    return -2;
      }
   }
   return -1;
}

/*----------------------------------------------------------------------*/
/* This routine is used by a number of menu functions.  It looks for	*/
/* the arguments "selected" or an integer (object handle).  If the	*/
/* argument is a valid object handle, it is added to the select list.	*/
/* The argument can be a list of handles, of which each is checked and	*/
/* added to the select list.						*/
/* "extra" indicates the number of required arguments beyond 2.		*/
/* "next" returns the integer of the argument after the handle, or the	*/
/* argument after the command, if there is no handle.  If the handle is	*/
/* specified as a hierarchical list of element handles then		*/
/* areastruct.hierstack contains the hierarchy of object instances.	*/
/*----------------------------------------------------------------------*/

int ParseElementArguments(Tcl_Interp *interp, int objc,
		Tcl_Obj *CONST objv[], int *next, int mask) {

   short *newselect;
   char *argstr;
   int i, j, result, numobjs;
   pointertype ehandle;
   Tcl_Obj *lobj;
   int extra = 0, badobjs = 0;

   if (next != NULL) {
      extra = *next;
      *next = 1;
   }

   if ((objc > (2 + extra)) || (objc == 1)) {
      Tcl_WrongNumArgs(interp, 1, objv, "[selected | <element_handle>] <option>");
      return TCL_ERROR;
   }
   else if (objc == 1) {
      *next = 0;
      return TCL_OK;
   }
   else {
      argstr = Tcl_GetString(objv[1]);

      if (strcmp(argstr, "selected")) {

         /* check for object handle (special type) */

         result = Tcl_ListObjLength(interp, objv[1], &numobjs);
         if (result != TCL_OK) return result;

	 /* Non-integer, non-list types: assume operation is to be applied */
	 /* to currently selected elements, and return to caller.	   */

	 if (numobjs == 1) {
	    result = Tcl_GetHandleFromObj(interp, objv[1], (void *)&ehandle);
	    if (result != TCL_OK) {
	       Tcl_ResetResult(interp);
	       return TCL_OK;
	    }
	 }
         unselect_all();

	 for (j = 0; j < numobjs; j++) {
            result = Tcl_ListObjIndex(interp, objv[1], j, &lobj);
            if (result != TCL_OK) return result;
	    result = Tcl_GetHandleFromObj(interp, lobj, (void *)&ehandle);
            if (result != TCL_OK) return result;
	    if (areastruct.hierstack != NULL)
	       i = GetPartNumber((genericptr)ehandle, 
			areastruct.hierstack->thisinst->thisobject, mask);
	    else
               i = GetPartNumber((genericptr)ehandle, topobject, mask);

            if (i == -1) {
	       free_stack(&areastruct.hierstack);
	       Tcl_SetResult(interp, "No such element exists.", NULL);
	       return TCL_ERROR;
            }
	    else if (i == -2)
	       badobjs++;
	    else {
               newselect = allocselect();
               *newselect = i;
	       if (next != NULL) *next = 2;
	    }
	 }
	 if (badobjs == numobjs) {
	    Tcl_SetResult(interp, "No element matches required type.", NULL);
	    return TCL_ERROR;
	 }
         draw_normal_selected(topobject, areastruct.topinstance);
      }
      else if (next != NULL) *next = 2;
   }
   return TCL_OK;
}

/*----------------------------------------------------------------------*/
/* Generate a transformation matrix according to the object instance	*/
/* hierarchy left on the hierstack.					*/
/*----------------------------------------------------------------------*/

void MakeHierCTM(Matrix *hierCTM)
{
   objinstptr thisinst;
   pushlistptr cs;

   UResetCTM(hierCTM);
   for (cs = areastruct.hierstack; cs != NULL; cs = cs->next) {
      thisinst = cs->thisinst;
      UMultCTM(hierCTM, thisinst->position, thisinst->scale, thisinst->rotation);
   }
}

/*----------------------------------------------------------------------*/
/* This routine is similar to ParseElementArguments.  It looks for a	*/
/* page number or page name in the second argument position.  If it	*/
/* finds one, it sets the page number in the return value.  Otherwise,	*/
/* it sets the return value to the value of areastruct.page.		*/
/*----------------------------------------------------------------------*/

int ParsePageArguments(Tcl_Interp *interp, int objc,
		Tcl_Obj *CONST objv[], int *next, int *pageret) {

   char *pagename;
   int i, page, result;
   Tcl_Obj *objPtr;

   if (next != NULL) *next = 1;
   if (pageret != NULL) *pageret = areastruct.page;  /* default */

   if ((objc == 1) || ((objc == 2) && !strcmp(Tcl_GetString(objv[1]), ""))) {
      objPtr = Tcl_NewIntObj(areastruct.page + 1);
      Tcl_SetObjResult(interp, objPtr);
      if (next) *next = -1;
      return TCL_OK;
   }
   else {
      pagename = Tcl_GetString(objv[1]);
      if (strcmp(pagename, "directory")) {

         /* check for page number (integer) */

	 result = Tcl_GetIntFromObj(interp, objv[1], &page);
	 if (result != TCL_OK) {
	    Tcl_ResetResult(interp);

	    /* check for page name (string) */

	    for (i = 0; i < xobjs.pages; i++) {
	       if (xobjs.pagelist[i]->pageinst == NULL) continue;
	       if (!strcmp(pagename, xobjs.pagelist[i]->pageinst->thisobject->name)) {
		  if (pageret) *pageret = i;
		  break;
	       }
	    }
	    if (i == xobjs.pages) {
	       if (next != NULL) *next = 0;
	    }
	 }
         else {
	    if (page < 1) {
	       Tcl_SetResult(interp, "Illegal page number: zero or negative", NULL);
	       return TCL_ERROR;
	    }
	    else if (page > xobjs.pages) {
	       Tcl_SetResult(interp, "Illegal page number: page does not exist", NULL);
	       return TCL_ERROR;
	    }
	    else if (pageret) *pageret = (page - 1);
	 }
      }
      else {
	 *next = 0;
      }
   }
   return TCL_OK;
}

/*----------------------------------------------------------------------*/
/* This routine is similar to ParsePageArguments.  It looks for a	*/
/* library number or library name in the second argument position.  If 	*/
/* it finds one, it sets the page number in the return value.		*/
/* Otherwise, if a library page is currently being viewed, it sets the	*/
/* return value to that library.  Otherwise, it sets the return value	*/
/* to the User Library.							*/
/*----------------------------------------------------------------------*/

int ParseLibArguments(Tcl_Interp *interp, int objc,
		Tcl_Obj *CONST objv[], int *next, int *libret) {

   char *libname, *slib;
   int i, library, result;
   Tcl_Obj *objPtr;

   if (next != NULL) *next = 1;

   if (objc == 1) {
      library = is_library(topobject);
      if (library < 0) {
	 Tcl_SetResult(interp, "No current library.", NULL);
	 return TCL_ERROR;
      }
      objPtr = Tcl_NewIntObj(library + 1);
      Tcl_SetObjResult(interp, objPtr);
      if (next) *next = -1;
      return TCL_OK;
   }
   else {
      libname = Tcl_GetString(objv[1]);
      if (strcmp(libname, "directory")) {

         /* check for library number (integer) */

	 result = Tcl_GetIntFromObj(interp, objv[1], &library);
	 if (result != TCL_OK) {
	    Tcl_ResetResult(xcinterp);

	    /* Check for library name (string).  Because XCircuit */
	    /* generates the text "Library: <filename>" for	  */
	    /* library names, we also check against <filename>	  */
	    /* only in these names.				  */

	    for (i = 0; i < xobjs.numlibs; i++) {
	       slib = xobjs.libtop[i + LIBRARY]->thisobject->name;
	       if (!strcmp(libname, slib)) {
		  *libret = i;
		  break;
	       }
	       else if (!strncmp(slib, "Library: ", 9)) {
	          if (!strcmp(libname, slib + 9)) {
		     *libret = i;
		     break;
	          }
	       }
	    }
	    if (i == xobjs.numlibs) {
	       *libret = xobjs.numlibs - 1;
	       if (next != NULL) *next = 0;
	    }
	 }
         else {
	    if (library < 1) {
	       Tcl_SetResult(interp, "Illegal library number: zero or negative", NULL);
	       return TCL_ERROR;
	    }
	    else if (library > xobjs.numlibs) {
	       Tcl_SetResult(interp, "Illegal library number: library "
			"does not exist", NULL);
	       return TCL_ERROR;
	    }
	    else *libret = (library - 1);
	 }
      }
      else *next = 0;
   }
   return TCL_OK;
}

/*----------------------------------------------------------------------*/
/* Schematic and symbol creation and association			*/
/*----------------------------------------------------------------------*/

int xctcl_symschem(ClientData clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *CONST objv[])
{
   int i, idx, result, stype;
   objectptr otherobj = NULL;
   char *objname;

   static char *subCmds[] = {
      "associate", "disassociate", "make", "goto", "get", "type", NULL
   };
   enum SubIdx {
      AssocIdx, DisAssocIdx, MakeIdx, GoToIdx, NameIdx, TypeIdx
   };

   /* The order of these must match the definitions in xcircuit.h */
   static char *schemTypes[] = {
	"primary", "secondary", "trivial", "symbol", "fundamental"
   };

   if (objc == 1 || objc > 4) {
      Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
      return TCL_ERROR;
   }
   else if ((result = Tcl_GetIndexFromObj(interp, objv[1],
		(CONST84 char **)subCmds, "option", 0, &idx)) != TCL_OK) {
      return result;
   }

   switch(idx) {
      case AssocIdx:
	 if (objc == 3) {
	    /* To do: accept name for association */
	    objname = Tcl_GetString(objv[2]);
	    if (topobject->schemtype == PRIMARY) {

	       /* Name has to be that of a library object */

	       int j;
	       objectptr *libobj;

	       for (i = 0; i < xobjs.numlibs; i++) {
		  for (j = 0; j < xobjs.userlibs[i].number; j++) {
		     libobj = xobjs.userlibs[i].library + j;
		     if (!strcmp(objname, (*libobj)->name)) {
		        otherobj = *libobj;
		        break;
		     }
		  }
		  if (otherobj != NULL) break;
	       }
	       if (otherobj == NULL)
	       {
	          Tcl_SetResult(interp, "Name is not a known object", NULL);
		  return TCL_ERROR;
	       }
	    }
	    else {

	       /* Name has to be that of a page label */

	       objectptr pageobj;
	       for (i = 0; i < xobjs.pages; i++) {
		  pageobj = xobjs.pagelist[i]->pageinst->thisobject;
		  if (!strcmp(objname, pageobj->name)) {
		     otherobj = pageobj;
		     break;
		  }
	       }
	       if (otherobj == NULL)
	       {
	          Tcl_SetResult(interp, "Name is not a known page label", NULL);
		  return TCL_ERROR;
	       }
	    }
	    if (schemassoc(topobject, otherobj) == False)
	       return TCL_ERROR;
	 }
	 else
	    startschemassoc(NULL, 0, NULL);
	 break;
      case DisAssocIdx:
	 schemdisassoc();
	 break;
      case MakeIdx:
	 if (topobject->symschem != NULL)
	    Wprintf("Error:  Schematic already has an associated symbol.");
	 else if (topobject->schemtype != PRIMARY)
	    Wprintf("Error:  Current page is not a primary schematic.");
	 else if (!strncmp(topobject->name, "Page ", 5))
	    Wprintf("Error:  Schematic page must have a valid name.");
	 else {
	    int libnum = -1;
	    if (objc >= 3) {
	       objname = Tcl_GetString(objv[2]);
	       strcpy(topobject->name, objname);
	       checkname(topobject);

	       if (objc == 4) {
		  ParseLibArguments(xcinterp, 2, &objv[2], NULL, &libnum);
		  if (libnum < 0) {
	             Tcl_SetResult(interp, "Invalid library name.", NULL);
		     return TCL_ERROR;
		  }
	       }
	    }
	    else {
	       /* Use this error condition to generate the popup prompt */
	       Tcl_SetResult(interp, "Must supply a name for the page", NULL);
	       return TCL_ERROR;
	    }
	    swapschem(1, libnum);
	    return TCL_OK;
	 }
	 return TCL_ERROR;
	 break;
      case GoToIdx:
	 swapschem(0, -1);
	 break;
      case NameIdx:
	 if (topobject->symschem != NULL)
	    Tcl_AppendElement(interp, topobject->symschem->name);
	 break;
      case TypeIdx:
	 if (objc == 3) {
	    if (topobject->schemtype == PRIMARY || topobject->schemtype == SECONDARY) {
	       Tcl_SetResult(interp, "Make object to change from schematic to symbol",
			NULL);
	       return TCL_ERROR;
	    }
	    if ((result = Tcl_GetIndexFromObj(interp, objv[2],
			(CONST84 char **)schemTypes, "schematic types",
			0, &stype)) != TCL_OK)
	       return result;
	    if (stype == PRIMARY || stype == SECONDARY) {
	       Tcl_SetResult(interp, "Cannot change symbol into a schematic", NULL);
	       return TCL_ERROR;
	    }
	    topobject->schemtype = stype;
	    if (topobject->symschem) schemdisassoc();
	 }
	 else
	    Tcl_AppendElement(interp, schemTypes[topobject->schemtype]);

	 break;
   }
   setsymschem();	/* Update GUI */
   return XcTagCallback(interp, objc, objv);
}

/*----------------------------------------------------------------------*/
/* Generate netlist into a Tcl hierarchical list			*/
/* (plus other netlist functions)					*/
/*----------------------------------------------------------------------*/

int xctcl_netlist(ClientData clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *CONST objv[])
{
   Tcl_Obj *rdict;
   int idx, format, result, mpage, spage, bvar;
   Boolean valid;
   pushlistptr stack;
   objectptr master, slave;

   static char *subCmds[] = {
      "write", "highlight", "goto", "get", "make", "connect", "autonumber",
	"ratsnest", NULL
   };
   enum SubIdx {
      WriteIdx, HighLightIdx, GoToIdx, GetIdx, MakeIdx, ConnectIdx,
	AutoNumberIdx, RatsNestIdx
   };

   static char *formats[] = {
      "spice", "spiceflat", "sim", "pcb", NULL
   };
   enum FmtIdx {
      SpiceIdx, FlatSpiceIdx, SimIdx, PcbIdx
   };

   if (objc == 1 || objc > 4) {
      Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
      return TCL_ERROR;
   }
   else if ((result = Tcl_GetIndexFromObj(interp, objv[1],
		(CONST84 char **)subCmds, "option", 0, &idx)) != TCL_OK) {
      return result;
   }

   /* Make sure a valid netlist exists for the current schematic */
   /* for those commands which require a valid netlist (non-ASG	 */
   /* functions).						 */

   valid = False;
   switch(idx) {
      case RatsNestIdx:
	 if ((topobject->labels != NULL) || (topobject->polygons != NULL))
	    valid = True;
	 break;
   }   

   if (!valid) {
      if ((result = updatenets(areastruct.topinstance)) < 0) {
	 Tcl_SetResult(interp, "Check circuit for infinite recursion.", NULL);
	 return TCL_ERROR;
      }
      else if (result == 0) {
	 Tcl_SetResult(interp, "Failure to generate a network.", NULL);
	 return TCL_ERROR;
      }
   }

   switch(idx) {
      case WriteIdx:		/* write netlist formats */
         if (objc < 3) {
	    Tcl_WrongNumArgs(interp, 1, objv, "write format");
	    return TCL_ERROR;
	 }
	 else if ((result = Tcl_GetIndexFromObj(interp, objv[2],
		(CONST84 char **)formats, "format", 0, &format)) != TCL_OK) {
	    return result;
	 }
	 if ((objc == 4) && (format == SpiceIdx)) {
	    if ((result = Tcl_GetBooleanFromObj(interp, objv[3], &bvar))
			!= TCL_OK)
	       return result;
	    else
	       spice_end = (Boolean)bvar;
         }
	 else
	    spice_end = True;

	 switch(format) {
	    case SpiceIdx:
	       writenet(topobject, "spice", "spc");
	       break;
	    case FlatSpiceIdx:
	       writenet(topobject, "flatspice", "fspc");
	       break;
	    case SimIdx:
	       writenet(topobject, "sim", "sim");
	       break;
	    case PcbIdx:
	       writenet(topobject, "pcb", "pcbnet");
	       break;
	 }
	 break;
      case GoToIdx:	/* go to top-level page having specified name */
         if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 1, objv, "goto hierarchical-network-name");
	    return TCL_ERROR;
	 }

	 stack = NULL;
	 valid = hiernametoobject(topobject, Tcl_GetString(objv[2]), &stack);

	 if (valid) {
	     /* add the current edit object to the push stack, then append */
	     /* the new push stack 					   */
	     fprintf(stderr, "freeing primary call stack\n");
	     fflush(stderr);
	     free_stack(&areastruct.stack);
	     fprintf(stderr, "setting current object to %s\n",
			stack->thisinst->thisobject->name);
	     fflush(stderr);
	     areastruct.topinstance = stack->thisinst;
	     fprintf(stderr, "popping netlist call stack\n");
	     fflush(stderr);
	     pop_stack(&stack);
	     areastruct.stack = stack;
	     fprintf(stderr, "setting new page\n");
	     fflush(stderr);
	     setpage(TRUE);
	     transferselects();
	     fprintf(stderr, "redraw page\n");
	     fflush(stderr);
	     refresh(NULL, NULL, NULL);
	     setsymschem();
	 }
	 else {
	    Tcl_SetResult(interp, "Not a valid network.", NULL);
	    return TCL_ERROR;
	 }
	 break;

      case GetIdx: {	/* return hierarchical name of selected network */
	 int stype, netid, lbus;
	 Boolean uplevel;
	 char *option;
	 Matrix locctm;
	 short *newselect;
	 Genericlist *netlist;
	 objinstptr refinstance;
	 objectptr refobject;
	 XPoint refpoint, *refptptr;
	 stringpart *ppin;
	 char *snew;
	 buslist *sbus;
	 Tcl_Obj *tlist;

	 option = Tcl_GetString(objv[objc - 1]);
	 uplevel = FALSE;
	 if (option[0] == '-') {
	    if (!strncmp(option + 1, "up", 2)) {
	       uplevel = TRUE;
	    }
	    objc--;
	 }
	 
	 refinstance = (areastruct.hierstack) ?  areastruct.hierstack->thisinst
		: areastruct.topinstance;

	 if (uplevel) {
	    if (areastruct.hierstack == NULL) {
	       if (areastruct.stack == NULL) {
	          Fprintf(stderr, "Option \"up\" used, but current page is the"
			" top of the schematic\n");
	          return TCL_ERROR;
	       }
	       else {
	          UResetCTM(&locctm);
	          UPreMultCTM(&locctm, refinstance->position, refinstance->scale,
			refinstance->rotation);
	          refinstance = areastruct.stack->thisinst;
	          refobject = refinstance->thisobject;
	       }
	    }
	    else {
	       if (areastruct.hierstack->next == NULL) {
	          Fprintf(stderr, "Option \"up\" used, but current page is the"
			" top of the drawing stack\n");
	          return TCL_ERROR;
	       }
	       else {
	          UResetCTM(&locctm);
	          UPreMultCTM(&locctm, refinstance->position, refinstance->scale,
			refinstance->rotation);
	          refinstance = areastruct.hierstack->next->thisinst;
	          refobject = refinstance->thisobject;
	       }
	    }
	 }
	 else {
	    refobject = topobject;
	 }
         if ((objc != 2) && (objc != 3)) {
	    Tcl_WrongNumArgs(interp, 1, objv, "get [selected|here|<name>] [-up]");
	    return TCL_ERROR;
	 }
	 if ((objc == 3) && !strcmp(Tcl_GetString(objv[2]), "here")) {
	    /* If "here", make a selection. */
            areastruct.save = UGetCursorPos();
            newselect = select_element(POLYGON | LABEL);
	    objc--;
	 }
	 if ((objc == 2) || (!strcmp(Tcl_GetString(objv[2]), "selected"))) {
	    /* If no argument, or "selected", use the selected element */
            newselect = areastruct.selectlist;
            if (areastruct.selects != 1) {
	       Fprintf(stderr, "Choose only one network element\n");
	       return TCL_ERROR;
	    }
	    else {
	       stype = SELECTTYPE(newselect);
	       if (stype == LABEL) {
	          labelptr nlabel = SELTOLABEL(newselect);
		  refptptr = &(nlabel->position);
		  if ((nlabel->pin != LOCAL) && (nlabel->pin != GLOBAL)) {
		     Fprintf(stderr, "Selected label is not a pin\n");
		     return TCL_ERROR;
		  }
	       }
	       else if (stype == POLYGON) {
	          polyptr npoly = SELTOPOLY(newselect);
		  refptptr = npoly->points;
		  if (nonnetwork(npoly)) {
		     Fprintf(stderr, "Selected polygon is not a wire\n");
		     return TCL_ERROR;
		  }
	       }
	    }
	 }
	 else if ((objc == 3) && (result = GetPositionFromList(interp, objv[2],
		&refpoint)) == TCL_OK) {
	    /* Find net at indicated position in reference object.	*/
	    /* This allows us to query points without generating a pin	*/
	    /* at the position, which can alter the netlist under	*/
	    /* observation.						*/
	    refptptr = &refpoint;
	 }
	 else {
	    /* If a name, find the pin label element matching the name */
	    int x, y;
	    objinstptr instofname = (areastruct.hierstack) ?
			areastruct.hierstack->thisinst :
			areastruct.topinstance;

	    Tcl_ResetResult(interp);

	    if (NameToPinLocation(instofname, Tcl_GetString(objv[2]),
			&x, &y) == 0) {
	       refpoint.x = x;		/* conversion from int to short */
	       refpoint.y = y;
	       refptptr = &refpoint;
	    }
	    else {
	       Fprintf(stderr, "Cannot find pin position for pin %s\n", 
			Tcl_GetString(objv[2]));
	       return TCL_ERROR;
	    }
	 }

	 /* Now that we have a reference point, convert it to a netlist */
	 if (uplevel) {
	    UTransformbyCTM(&locctm, refptptr, &refpoint, 1);
	    refptptr = &refpoint;
	 }
	 netlist = pointtonet(refobject, refinstance, refptptr);
	 if (netlist == NULL) {
	    Fprintf(stderr, "Error:  No netlist found!\n");
	    return TCL_ERROR;
	 }

	 /* If refobject is a secondary schematic, we need to find the	*/
	 /* corresponding primary page to call nettopin().		*/
         master = (refobject->schemtype == SECONDARY) ?
		refobject->symschem : refobject;

	 /* Now that we have a netlist, convert it to a name		*/
	 /* Need to get prefix from the current call stack so we	*/
	 /* can represent flat names as well as hierarchical names.	*/

	 if (netlist->subnets == 0) {
	    netid = netlist->net.id;
	    ppin = nettopin(netid, master, "");	/* Add prefix... */
	    snew = textprint(ppin, refinstance);
	    Tcl_SetResult(interp, snew, TCL_DYNAMIC);
	 }
	 else if (netlist->subnets == 1) {

	    /* Need to get prefix from the current call stack! */
	    sbus = netlist->net.list;
	    netid = sbus->netid;
	    ppin = nettopin(netid, master, "");	/* Add prefix... */
	    snew = textprintsubnet(ppin, refinstance, sbus->subnetid);
	    Tcl_SetResult(interp, snew, TCL_DYNAMIC);
	 }
	 else {
	    tlist = Tcl_NewListObj(0, NULL);
	    for (lbus = 0; lbus < netlist->subnets; lbus++) {
	       sbus = netlist->net.list + lbus;
	       netid = sbus->netid;
	       ppin = nettopin(netid, master, "");	/* Add prefix... */
	       snew = textprintsubnet(ppin, refinstance, sbus->subnetid);
	       Tcl_ListObjAppendElement(interp, tlist, Tcl_NewStringObj(snew, -1));
	       Tcl_SetObjResult(interp, tlist);
	       free(snew);
	    }
	 }
	 } break;

      case ConnectIdx:		/* associate the page with another one */
         if ((objc != 3) && (objc != 4)) {
	    Tcl_WrongNumArgs(interp, 1, objv, "connect master [slave]");
	    return TCL_ERROR;
	 }
	 else if (objc == 4) {
	    result = Tcl_GetIntFromObj(interp, objv[3], &spage);
	    if (result != TCL_OK) {
	       Tcl_ResetResult(interp);
	       slave = NameToPageObject(Tcl_GetString(objv[3]), NULL, &spage);
	    }
	    else {
	       if (spage >= xobjs.pages) {
		  Tcl_SetResult(interp, "Bad page number for slave schematic", NULL);
		  return TCL_ERROR;
	       }
	       slave = xobjs.pagelist[spage]->pageinst->thisobject;
	    }
	    if ((slave == NULL) || (is_page(slave) < 0)) {
	       Tcl_SetResult(interp, "Error determining slave schematic", NULL);
	       return TCL_ERROR;
	    }
	 }
	 else {
	    slave = topobject;
	    spage = areastruct.page;
	 }

	 result = Tcl_GetIntFromObj(interp, objv[2], &mpage);
	 if (result != TCL_OK) {
	    Tcl_ResetResult(interp);
	    master = NameToPageObject(Tcl_GetString(objv[2]), NULL, &mpage);
	 }
	 else
	    mpage--;

	 if ((mpage >= xobjs.pages) || (xobjs.pagelist[mpage]->pageinst == NULL)) {
	    Tcl_SetResult(interp, "Bad page number for master schematic", NULL);
	    return TCL_ERROR;
	 }
	 else if (mpage == areastruct.page) {
	    Tcl_SetResult(interp, "Attempt to specify schematic "
				"as its own master", NULL);
	    return TCL_ERROR;
	 }
	 if (xobjs.pagelist[mpage]->pageinst->thisobject->symschem == slave) {
	    Tcl_SetResult(interp, "Attempt to create recursive "
				"master/slave schematic relationship", NULL);
	    return TCL_ERROR;
	 }
	 master = xobjs.pagelist[mpage]->pageinst->thisobject;

	 if ((master == NULL) || (is_page(master) < 0)) {
	    Tcl_SetResult(interp, "Error determining master schematic", NULL);
	    return TCL_ERROR;
	 }

	 slave->schemtype = SECONDARY;
	 slave->symschem = master;
	 break;

      case HighLightIdx:	/* highlight network connectivity */
         if (objc == 2) {
	    startconnect(NULL, NULL, NULL);
	 }
	 else {
	    int netid, lbus;
	    XPoint newpos;
	    char *tname;
	    Genericlist *lnets;
	    buslist *sbus;

	    result = GetPositionFromList(interp, objv[2], &newpos);
	    if (result == TCL_OK) {	/* find net at indicated position */
	       areastruct.save = newpos;
	       connectivity(NULL, NULL, NULL);
	       /* should there be any result here? */
	    }
	    else {			/* assume objv[2] is net name */
	       Tcl_ResetResult(interp);
	       tname = Tcl_GetString(objv[2]);
	       lnets = nametonet(topobject, areastruct.topinstance, tname);
	       if (lnets == NULL) {
		  Tcl_SetResult(interp, "No such network ", NULL);
	          Tcl_AppendElement(interp, tname);
	       }
	       else {
		  Genericlist *netlist = (Genericlist *)malloc(sizeof(Genericlist));

		  /* Erase any existing highlights first */
		  highlightnetlist(topobject, areastruct.topinstance, 0);
		  netlist->subnets = 0;
		  copy_bus(netlist, lnets);
		  topobject->highlight.netlist = netlist;
		  topobject->highlight.thisinst = areastruct.topinstance;
		  highlightnetlist(topobject, areastruct.topinstance, 1);
		  Tcl_SetObjResult(interp,  Tcl_NewIntObj(netid));
	       }
	    }
	 }
	 break;
      case MakeIdx:		/* generate Tcl-list netlist */
	 if ((objc == 3) && !strcmp(Tcl_GetString(objv[2]), "-force")) {
	    destroynets(areastruct.topinstance->thisobject);
	 }
	 if ((result = updatenets(areastruct.topinstance)) < 0) {
	    Tcl_SetResult(interp, "Check circuit for infinite recursion.", NULL);
	    return TCL_ERROR;
	 }
	 else if (result == 0) {
	    Tcl_SetResult(interp, "Failure to generate a network.", NULL);
	    return TCL_ERROR;
         }

	 rdict = Tcl_NewListObj(0, NULL);
	 Tcl_ListObjAppendElement(interp, rdict, Tcl_NewStringObj("globals", 7));
	 Tcl_ListObjAppendElement(interp, rdict, tclglobals(areastruct.topinstance));
	 Tcl_ListObjAppendElement(interp, rdict, Tcl_NewStringObj("circuit", 7));
	 Tcl_ListObjAppendElement(interp, rdict, tcltoplevel(areastruct.topinstance));

	 Tcl_SetObjResult(interp, rdict);
	 break;
      case AutoNumberIdx:	/* auto-number circuit components */
	 if (checkvalid(topobject) == -1) {
	    destroynets(topobject);
	    createnets(areastruct.topinstance);
	 }
	 else {
	    cleartraversed(topobject);
	    clear_indices(topobject);
	 }
	 if ((objc == 3) && !strcmp(Tcl_GetString(objv[2]), "-forget")) {
	    cleartraversed(topobject);
	    unnumber(topobject);
	 }
	 else {
	    cleartraversed(topobject);
	    resolve_indices(topobject, FALSE);  /* Do fixed assignments first */
	    cleartraversed(topobject);
	    resolve_indices(topobject, TRUE);   /* Now do the auto-numbering */
	 }
	 break;
      case RatsNestIdx:
	 /* Experimental netlist stuff! */
	 ratsnest(topobject);
	 break;
   }
   return XcTagCallback(interp, objc, objv);
}

/*----------------------------------------------------------------------*/
/* Return current position						*/
/*----------------------------------------------------------------------*/

int xctcl_here(ClientData clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *CONST objv[])
{
   int result;
   Tcl_Obj *listPtr, *objPtr;
   XPoint newpos;

   if (objc != 1) {
      Tcl_WrongNumArgs(interp, 0, objv, "(no arguments)");
      return TCL_ERROR;
   }
   newpos = UGetCursorPos();

   listPtr = Tcl_NewListObj(0, NULL);
   objPtr = Tcl_NewIntObj((int)newpos.x);
   Tcl_ListObjAppendElement(interp, listPtr, objPtr);

   objPtr = Tcl_NewIntObj((int)newpos.y);
   Tcl_ListObjAppendElement(interp, listPtr, objPtr);

   Tcl_SetObjResult(interp, listPtr);

   return XcTagCallback(interp, objc, objv);
}


/*----------------------------------------------------------------------*/
/* Argument-converting wrappers from Tcl command callback to xcircuit	*/
/*----------------------------------------------------------------------*/

int xctcl_pan(ClientData clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *CONST objv[])
{
   int result, idx;
   double frac = 0.0;
   XPoint newpos, wpoint;
   static char *directions[] = {"here", "left", "right", "up", "down",
		"center", "follow", NULL};
   enum DirIdx {
      DirHere, DirLeft, DirRight, DirUp, DirDown, DirCenter, DirFollow
   };

   if (objc != 2 && objc != 3) {
      Tcl_WrongNumArgs(interp, 0, objv, "option ?arg ...?");
      return TCL_ERROR;
   }

   /* Check against keywords */

   if (Tcl_GetIndexFromObj(interp, objv[1], (CONST84 char **)directions,
		"option", 0, &idx) != TCL_OK) {
      result = GetPositionFromList(interp, objv[1], &newpos);
      if (result != TCL_OK) return result;
      idx = 5;
   }
   else
      newpos = UGetCursorPos();

   user_to_window(newpos, &wpoint);

   switch(idx) {
      case DirHere:
      case DirCenter:
      case DirFollow:
	 if (objc != 2) {
            Tcl_WrongNumArgs(interp, 0, objv, "(no arguments)");
	 }
	 break;
      default:
	 if (objc == 2) frac = 0.3;
	 else
	    Tcl_GetDoubleFromObj(interp, objv[2], &frac);
   }

   panbutton((u_int)idx, wpoint.x, wpoint.y, (float)frac);
   return XcTagCallback(interp, objc, objv);
}

/*----------------------------------------------------------------------*/

int xctcl_zoom(ClientData clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *CONST objv[])
{
   int result, idx;
   float save;
   double factor;
   XPoint newpos, wpoint;

   static char *subCmds[] = {"in", "out", "view", "factor", NULL};
   enum SubIdx {
      InIdx, OutIdx, ViewIdx, FactorIdx
   };

   newpos = UGetCursorPos();
   user_to_window(newpos, &wpoint);

   if (objc == 1)
      zoomview(NULL, NULL, NULL);
   else if ((result = Tcl_GetDoubleFromObj(interp, objv[1], &factor)) != TCL_OK)
   {
      Tcl_ResetResult(interp);
      if (Tcl_GetIndexFromObj(interp, objv[1], (CONST84 char **)subCmds,
		"option", 0, &idx) != TCL_OK) {
	 Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
	 return TCL_ERROR;
      }
      switch(idx) {
	 case InIdx:
	    zoominrefresh(wpoint.x, wpoint.y);
	    break;
	 case OutIdx:
	    zoomoutrefresh(wpoint.x, wpoint.y);
	    break;
	 case ViewIdx:
	    zoomview(NULL, NULL, NULL);
	    break;
	 case FactorIdx:
	    if (objc == 2) {
	       Tcl_Obj *objPtr = Tcl_NewDoubleObj((double)areastruct.zoomfactor);
	       Tcl_SetObjResult(interp, objPtr);
	       break;
	    }
	    else if (objc != 3) {
	       Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
	       return TCL_ERROR;
	    }
	    if (!strcmp(Tcl_GetString(objv[2]), "default"))
	       factor = SCALEFAC;
	    else {
	       result = Tcl_GetDoubleFromObj(interp, objv[2], &factor);
	       if (result != TCL_OK) return result;
	       if (factor <= 0) {
	          Tcl_SetResult(interp, "Negative/Zero zoom factors not allowed.",
			NULL);
	          return TCL_ERROR;
	       }
	       if (factor < 1.0) factor = 1.0 / factor;
	    }
	    if ((float)factor == areastruct.zoomfactor) break;
	    sprintf(_STR2, "Zoom factor changed from %2.1f to %2.1f",
		areastruct.zoomfactor, (float)factor);
	    areastruct.zoomfactor = (float) factor;
	    Wprintf(_STR2);
	    break;
      }
   }
   else {
    
      save = areastruct.zoomfactor;

      if (factor < 1.0) {
         areastruct.zoomfactor = (float)(1.0 / factor);
         zoomoutrefresh(wpoint.x, wpoint.y);
      }
      else {
         areastruct.zoomfactor = (float)factor;
         zoominrefresh(wpoint.x, wpoint.y);
      }
      areastruct.zoomfactor = save;
   }
   return XcTagCallback(interp, objc, objv);
}

/*----------------------------------------------------------------------*/
/* To do: check for color name before integer (index) value.		*/
/*----------------------------------------------------------------------*/

int GetColorFromObj(Tcl_Interp *interp, Tcl_Obj *obj, int *cindex)
{
   int result;

   if (cindex == NULL) return TCL_ERROR;

   if (!strcmp(Tcl_GetString(obj), "inherit")) {
      *cindex = -1;
   }
   else {
      result = Tcl_GetIntFromObj(interp, obj, cindex);
      if (result != TCL_OK) {
	 Tcl_SetResult(interp, "Color must be inherit or index", NULL);
	 return result;
      }

      if ((*cindex >= number_colors) || (*cindex < -1)) {
	 Tcl_SetResult(interp, "Color index out of range", NULL);
	 return TCL_ERROR;
      }
   }
   return TCL_OK;
}

/*----------------------------------------------------------------------*/

int xctcl_color(ClientData clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *CONST objv[])
{
   int result, nidx, cindex, idx, i;
   char *colorname;
   Boolean priorselects = (areastruct.selectlist != NULL);

   static char *subCmds[] = {"set", "get", "add", "override", NULL};
   enum SubIdx { SetIdx, GetIdx, AddIdx, OverrideIdx };

   nidx = 2;
   result = ParseElementArguments(interp, objc, objv, &nidx, ALL_TYPES);
   if (result != TCL_OK) return result;

   if ((result = Tcl_GetIndexFromObj(interp, objv[nidx],
		(CONST84 char **)subCmds, "option", nidx - 1,
		&idx)) != TCL_OK)
      return result;

   switch (idx) {
      case SetIdx:
         if ((objc - nidx) == 2) {
            result = GetColorFromObj(interp, objv[nidx + 1], &cindex);
            if (result != TCL_OK) return result;
            setcolor((Tk_Window)clientData, cindex);
	    /* Tag callback performed by setcolormarks() via setcolor() */
	    return TCL_OK;
	 }
	 else {
	    Tcl_WrongNumArgs(interp, 1, objv, "set <index> | inherit");
	    return TCL_ERROR;
	 }
         break;

      case GetIdx:
	 if (nidx == 2) {	/* operation on element */
	    genericptr genobj = SELTOGENERIC(areastruct.selectlist);
	    cindex = (int)genobj->color;
	 }
	 else			/* global setting */
	    cindex = areastruct.color;

	 /* Find and return the index of the color */
	 if (cindex == DEFAULTCOLOR)
	     Tcl_SetObjResult(interp, Tcl_NewStringObj("inherit", 7));
	 else {
	    for (i = 0; i < number_colors; i++)
	       if (colorlist[i].color.pixel == cindex)
	          break;
	    Tcl_SetObjResult(interp, Tcl_NewIntObj(i));
	 }
	 break;

      case AddIdx:
         if ((objc - nidx) == 2) {
	    colorname = Tcl_GetString(objv[nidx + 1]);
	    addnewcolorentry(xc_alloccolor(colorname));
	    Tcl_SetObjResult(interp, Tcl_NewIntObj((int)number_colors - 1));
	 }
	 else {
	    Tcl_WrongNumArgs(interp, 1, objv, "add <color_name>");
	    return TCL_ERROR;
	 }
	 break;

      case OverrideIdx:
	 flags |= COLOROVERRIDE;
	 return TCL_OK;			/* no tag callback */
	 break;
   }
   return XcTagCallback(interp, objc, objv);
}

/*----------------------------------------------------------------------*/

int xctcl_delete(ClientData clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *CONST objv[])
{
   int result = ParseElementArguments(interp, objc, objv, NULL, ALL_TYPES);

   if (result != TCL_OK) return result;

   /* delete element */
   if (areastruct.selects > 0)
      deletebutton(0, 0);	/* Note: arguments are not used */

   return XcTagCallback(interp, objc, objv);
}

/*----------------------------------------------------------------------*/

int xctcl_undo(ClientData clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *CONST objv[])
{
   if (objc != 1) {
      Tcl_WrongNumArgs(interp, 1, objv, "(no arguments)");
      return TCL_ERROR;
   }
   undo_action();
   return XcTagCallback(interp, objc, objv);
}

/*----------------------------------------------------------------------*/

int xctcl_redo(ClientData clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *CONST objv[])
{
   if (objc != 1) {
      Tcl_WrongNumArgs(interp, 1, objv, "(no arguments)");
      return TCL_ERROR;
   }
   redo_action();
   return XcTagCallback(interp, objc, objv);
}

/*----------------------------------------------------------------------*/

int xctcl_move(ClientData clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *CONST objv[])
{
   XPoint position;
   int nidx = 3;
   int result = ParseElementArguments(interp, objc, objv, &nidx, ALL_TYPES);

   if (result != TCL_OK) return result;

   if (areastruct.selects == 0) {
      Tcl_SetResult(interp, "Error in move setup:  nothing selected.", NULL);
      return TCL_ERROR;
   }

   if ((objc - nidx) == 0) {
      eventmode = MOVE_MODE;
      u2u_snap(&areastruct.save);
      Tk_CreateEventHandler(areastruct.area, PointerMotionMask,
		(Tk_EventProc *)xctk_drag, NULL);
   }
   else if ((objc - nidx) >= 1) {
      if ((objc - nidx) == 2) {
	 if (!strcmp(Tcl_GetString(objv[nidx]), "relative")) {
	    if ((result = GetPositionFromList(interp, objv[nidx + 1],
			&position)) != TCL_OK) {
	       Tcl_SetResult(interp, "Position must be {x y} list", NULL);
	       return TCL_ERROR;
	    }
	 }
	 else {
	    Tcl_WrongNumArgs(interp, 1, objv, "relative {x y}");
	    return TCL_ERROR;
	 }
      }
      else {
	 if ((result = GetPositionFromList(interp, objv[nidx],
			&position)) != TCL_OK) {
	    Tcl_SetResult(interp, "Position must be {x y} list", NULL);
	    return TCL_ERROR;
	 }
         position.x -= areastruct.save.x;
         position.y -= areastruct.save.y;
      }
      placeselects(position.x, position.y, NULL);
   }
   else {
      Tcl_WrongNumArgs(interp, 1, objv, "[relative] {x y}");
      return TCL_ERROR;
   }
   return XcTagCallback(interp, objc, objv);
}

/*----------------------------------------------------------------------*/

int xctcl_copy(ClientData clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *CONST objv[])
{
   XPoint position;
   int nidx = 3;
   int result = ParseElementArguments(interp, objc, objv, &nidx, ALL_TYPES);

   if (result != TCL_OK) return result;

   if ((objc - nidx) == 0) {
      if (areastruct.selects > 0) {
	 createcopies();
	 copydrag();
      }
   }
   else if ((objc - nidx) >= 1) {
      if (areastruct.selects == 0) {
         Tcl_SetResult(interp, "Error in copy:  nothing selected.", NULL);
         return TCL_ERROR;
      }
      if ((objc - nidx) == 2) {
	 if (!strcmp(Tcl_GetString(objv[nidx]), "relative")) {
	    if ((result = GetPositionFromList(interp, objv[nidx + 1],
			&position)) != TCL_OK) {
	       Tcl_SetResult(interp, "Position must be {x y} list", NULL);
	       return TCL_ERROR;
	    }
	 }
	 else {
	    Tcl_WrongNumArgs(interp, 1, objv, "relative {x y}");
	    return TCL_ERROR;
	 }
      }
      else {
	 if ((result = GetPositionFromList(interp, objv[nidx],
			&position)) != TCL_OK) {
	    Tcl_SetResult(interp, "Position must be {x y} list", NULL);
	    return TCL_ERROR;
	 }
         position.x -= areastruct.save.x;
         position.y -= areastruct.save.y;
      }
      createcopies();
      placeselects(position.x, position.y, NULL);
   }
   else {
      Tcl_WrongNumArgs(interp, 1, objv, "[relative] {x y}");
      return TCL_ERROR;
   }
   return XcTagCallback(interp, objc, objv);
}

/*----------------------------------------------------------------------*/

int xctcl_flip(ClientData clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *CONST objv[])
{
   char *teststr;
   int nidx = 2;
   int result = ParseElementArguments(interp, objc, objv, &nidx, ALL_TYPES);

   if (result != TCL_OK) return result;

   if ((objc - nidx) == 2) {
      XPoint position;
      if ((result = GetPositionFromList(interp, objv[nidx + 1],
			&position)) != TCL_OK)
	 return result;
      else
	 areastruct.save = position;
   }
   else if ((objc - nidx) == 1) {
      if (areastruct.selects > 1)
	 areastruct.save = UGetCursorPos();
   }
   else {
      Tcl_WrongNumArgs(interp, 1, objv, "horizontal|vertical [<center>]");
      return TCL_ERROR;
   }  

   teststr = Tcl_GetString(objv[nidx]);

   switch(teststr[0]) {
      case 'h': case 'H':
         elementflip();
	 break;
      case 'v': case 'V':
         elementvflip();
	 break;
      default:
	 Tcl_SetResult(interp, "Error: options are horizontal or vertical", NULL);
         return TCL_ERROR;
   }
   return XcTagCallback(interp, objc, objv);
}

/*----------------------------------------------------------------------*/

int xctcl_rotate(ClientData clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *CONST objv[])
{
   int rval, nidx = 2;
   int result = ParseElementArguments(interp, objc, objv, &nidx, ALL_TYPES);

   if (result != TCL_OK) return result;

   /* No options --- return the rotation value(s) */
   if ((objc - nidx) == 0) {
      int i, numfound = 0;
      Tcl_Obj *listPtr, *objPtr;
      for (i = 0; i < areastruct.selects; i++) {
	 objPtr = NULL;
	 if (SELECTTYPE(areastruct.selectlist + i) == OBJINST) {
	    objinstptr pinst = SELTOOBJINST(areastruct.selectlist + i);
	    objPtr = Tcl_NewIntObj(pinst->rotation);
	 }
	 else if (SELECTTYPE(areastruct.selectlist + i) == LABEL) {
	    labelptr plab = SELTOLABEL(areastruct.selectlist + i);
	    objPtr = Tcl_NewIntObj(plab->rotation);
	 }
	 else if (SELECTTYPE(areastruct.selectlist + i) == GRAPHIC) {
	    graphicptr gp = SELTOGRAPHIC(areastruct.selectlist + i);
	    objPtr = Tcl_NewIntObj(gp->rotation);
	 }
	 if (objPtr != NULL) {
	    if (numfound > 0)
	       Tcl_ListObjAppendElement(interp, listPtr, objPtr);
	    if ((++numfound) == 1)
	       listPtr = objPtr;
	 }
      }
      switch (numfound) {
	 case 0:
	    Tcl_SetResult(interp, "Error: no object instances, graphic "
			"images, or labels selected", NULL);
	    return TCL_ERROR;
	    break;
	 case 1:
	    Tcl_SetObjResult(interp, objPtr);
	    break;
	 default:
	    Tcl_SetObjResult(interp, listPtr);
	    break;
      }
      return XcTagCallback(interp, objc, objv);
   }

   result = Tcl_GetIntFromObj(interp, objv[nidx], &rval);
   if (result != TCL_OK) return result;

   if ((objc - nidx) == 2) {
      XPoint position;
      if ((result = GetPositionFromList(interp, objv[nidx + 1],
			&position)) != TCL_OK)
	 return result;
      else {
	 areastruct.save = position;
	 elementrotate(rval);
         return XcTagCallback(interp, objc, objv);
      }
   }
   else if ((objc - nidx) == 1) {
      areastruct.save = UGetCursorPos();
      elementrotate(rval);
      return XcTagCallback(interp, objc, objv);
   }

   Tcl_WrongNumArgs(interp, 1, objv, "<angle> [<center>]");
   return TCL_ERROR;
}

/*----------------------------------------------------------------------*/

int xctcl_edit(ClientData clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *CONST objv[])
{
   int result = ParseElementArguments(interp, objc, objv, NULL, ALL_TYPES);

   if (result != TCL_OK) return result;

   /* To be done---edit element */

   return XcTagCallback(interp, objc, objv);
}

/*----------------------------------------------------------------------*/
/* Support procedure for xctcl_param:  Given a pointer to a parameter,	*/
/* return the value of the parameter as a pointer to a Tcl object.	*/
/* This takes care of the fact that the parameter value can be a	*/
/* string, integer, or float, depending on the parameter type.		*/
/*									*/
/* If "verbatim" is true, then expression parameters return the string	*/
/* representation of the expression, not the result, and indirect	*/
/* parameters return the parameter name referenced, not the value.	*/
/*									*/
/* refinst, if non-NULL, is the instance containing ops, used when	*/
/* "verbatim" is true and the parameter is indirectly referenced.	*/
/*----------------------------------------------------------------------*/

Tcl_Obj *GetParameterValue(oparamptr ops, Boolean verbatim, objinstptr refinst)
{
   Tcl_Obj *robj;
   Tcl_SavedResult state;
   char *refkey;

   if (verbatim && (refinst != NULL) &&
		((refkey = find_indirect_param(refinst, ops->key)) != NULL)) {
      robj = Tcl_NewStringObj(refkey, strlen(refkey)); 
      return robj;
   }

   switch (ops->type) {
      case XC_STRING:
	 robj = TclGetStringParts(ops->parameter.string);
	 break;
      case XC_EXPR:
	 if (verbatim) {
	    robj = Tcl_NewStringObj(ops->parameter.expr,
			strlen(ops->parameter.expr));
	 }
	 else {
	    Tcl_SaveResult(xcinterp, &state);
	    Tcl_Eval(xcinterp, ops->parameter.expr);
	    robj = Tcl_GetObjResult(xcinterp);
	    Tcl_IncrRefCount(robj);
	    Tcl_RestoreResult(xcinterp, &state);
	 }
	 break;
      case XC_INT:
	 robj = Tcl_NewIntObj(ops->parameter.ivalue);
	 break;
      case XC_FLOAT:
	 robj = Tcl_NewDoubleObj((double)ops->parameter.fvalue);
	 break;
   }
   return robj;
}

/*----------------------------------------------------------------------*/
/* Given a pointer to a parameter and a Tcl object, set the parameter	*/
/* to the value of the object.  Return the standard Tcl return type	*/
/*									*/
/* If searchinst is non-NULL, then it refers to the level above in the	*/
/* hierarchy, and we are supposed to set an indirect reference.		*/
/*----------------------------------------------------------------------*/

int SetParameterValue(Tcl_Interp *interp, oparamptr ops, Tcl_Obj *objv)
{
   int result, ivalue;
   double dvalue;
   stringpart *strptr = NULL, *newpart;

   switch (ops->type) {
      case XC_FLOAT:
	 result = Tcl_GetDoubleFromObj(interp, objv, &dvalue);
	 if (result != TCL_OK) return result;
	 ops->parameter.fvalue = (float)dvalue;
	 break;
      case XC_INT:
	 result = Tcl_GetIntFromObj(interp, objv, &ivalue);
	 if (result != TCL_OK) return result;
	 ops->parameter.ivalue = ivalue;
	 break;
      case XC_EXPR:
	 ops->parameter.expr = strdup(Tcl_GetString(objv));
	 break;
      case XC_STRING:
	 result = GetXCStringFromList(interp, objv, &strptr);
	 if (result != TCL_OK) return result;
	 freelabel(ops->parameter.string);
	 /* Must add a "param end" */
         newpart = makesegment(&strptr, NULL);
         newpart->nextpart = NULL;
         newpart->type = PARAM_END;
	 newpart->data.string = (u_char *)NULL;
	 ops->parameter.string = strptr;
	 break;
   }
   return TCL_OK;
}

/*----------------------------------------------------------------------*/
/* Parameter command:							*/
/*									*/
/* Normally, a selected element will produce a list of backwards-	*/
/* referenced parameters (eparam).  However, it is useful to pick up	*/
/* the forwards-referenced parameters of an object instance, so that	*/
/* parameters can be modified from the level above (e.g., to change	*/
/* circuit component values, component indices, etc.).  The optional	*/
/* final argument "-forward" can be used to access this mode.		*/
/*----------------------------------------------------------------------*/

int xctcl_param(ClientData clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *CONST objv[])
{
   int i, j, value, idx, nidx = 4;
   int result = ParseElementArguments(interp, objc, objv, &nidx, ALL_TYPES);
   oparamptr ops, instops;
   eparamptr epp;
   genericptr thiselem = NULL;
   Tcl_Obj *plist, *kpair;
   objinstptr refinst;
   objectptr refobj;
   char *dash_opt;
   Boolean verbatim = FALSE, indirection = FALSE, forwarding = FALSE;

   static char *subCmds[] = {"allowed", "get", "type", "default", "set", "make",
	"forget", NULL};
   enum SubIdx {
      AllowedIdx, GetIdx, TypeIdx, DefaultIdx, SetIdx, MakeIdx, ForgetIdx
   };

   /* The order of these type names must match the enumeration in xcircuit.h	*/

   static char *param_types[] = {"numeric", "substring", "x position",
        "y position", "style", "justification", "start angle", "end angle",
        "radius", "minor axis", "rotation", "scale", "linewidth", "color",
	"expression", "position"};

   /* The first object instance in the select list becomes "thiselem",	*/
   /* if such exists.  Otherwise, it remains null.			*/

   for (j = 0; j < areastruct.selects; j++) {
      if (SELECTTYPE(areastruct.selectlist + j) == OBJINST) {
	 thiselem = SELTOGENERIC(areastruct.selectlist + j);
	 break;
      }
   }

   if (objc - nidx < 1)
      idx = GetIdx;
   else {
      dash_opt = Tcl_GetString(objv[nidx]);
      if (*dash_opt == '-')
	 idx = GetIdx;
      else {
	if ((result = Tcl_GetIndexFromObj(interp, objv[nidx],
		(CONST84 char **)subCmds, "option", nidx - 1, &idx)) != TCL_OK)
	   return result;
      }
   }

   /* Use the topobject by default */
   refinst = areastruct.topinstance;
   refobj = topobject;

   /* command-line switches */

   dash_opt = Tcl_GetString(objv[objc - 1]);
   while (*dash_opt == '-') {

      /* If an object instance is selected, we list backwards-referenced */
      /* (eparam) parameters, unless the command ends in "-forward".	 */

      if (!strncmp(dash_opt + 1, "forw", 4)) {
	 switch (idx) {
	    case SetIdx:
	    case GetIdx:
	    case TypeIdx:
	    case DefaultIdx:
	       if (thiselem && IS_OBJINST(thiselem)) {
		  refinst = (objinstptr)thiselem;
		  refobj = refinst->thisobject;
		  thiselem = NULL;
		  forwarding = TRUE;
	       }
	    break;
	 }
      }
      else if (!strncmp(dash_opt + 1, "verb", 4)) {
	 verbatim = TRUE;
      }
      else if (!strncmp(dash_opt + 1, "ind", 3)) {
	 indirection = TRUE;
      }
      
      objc--;
      if (objc == 0) {
	 Tcl_SetResult(interp, "Must have a valid option", NULL);
	 return TCL_ERROR;
      }
      dash_opt = Tcl_GetString(objv[objc - 1]);
   }


   switch (idx) {
      case AllowedIdx:
	 for (i = 0; i < (sizeof(param_types) / sizeof(char *)); i++)
	    if ((thiselem == NULL) || (param_select[i] & thiselem->type))
	       Tcl_AppendElement(interp, param_types[i]);
	    
         break;

      case GetIdx:
      case TypeIdx:

	 if (objc == nidx + 2) {

	    /* Check argument against all parameter keys */
	    ops = find_param(refinst, Tcl_GetString(objv[nidx + 1]));
	    if (ops == NULL) {
	       /* Otherwise, the argument must be a parameter type. */
               if ((result = Tcl_GetIndexFromObj(interp, objv[nidx + 1],
		   	(CONST84 char **)param_types, "parameter type",
			nidx - 1, &value)) != TCL_OK) {
	          Tcl_SetResult(interp, "Must have a valid key or parameter type",
			NULL);
	          return result;
	       }
	    }

	    /* Return the value of the indicated parameter  */

	    plist = Tcl_NewListObj(0, NULL);
	    if (thiselem == NULL) {
	       if (ops != NULL) {
		  if (idx == GetIdx)
		     Tcl_ListObjAppendElement(interp, plist,
			   	GetParameterValue(ops, verbatim, refinst));
		  else
	             Tcl_ListObjAppendElement(interp, plist,
				Tcl_NewStringObj(param_types[ops->which],
				strlen(param_types[ops->which])));
	       }
	       else {
		  for (ops = refobj->params; ops != NULL; ops = ops->next) {
		     instops = find_param(refinst, ops->key);
		     if (instops->which == value) {
	       	        kpair = Tcl_NewListObj(0, NULL);
	                Tcl_ListObjAppendElement(interp, kpair,
			   	Tcl_NewStringObj(instops->key, strlen(instops->key)));
			if (idx == GetIdx)
		           Tcl_ListObjAppendElement(interp, kpair,
				   	GetParameterValue(instops, verbatim, refinst));
			else
		           Tcl_ListObjAppendElement(interp, kpair,
					Tcl_NewStringObj(param_types[instops->which],
					strlen(param_types[instops->which])));
	                Tcl_ListObjAppendElement(interp, plist, kpair);
		     }
	          }
	       }
	    }
	    else {
	       for (epp = thiselem->passed; epp != NULL; epp = epp->next) {
		  instops = find_param(refinst, epp->key);
		  if (instops->which == value) {
		     if (idx == GetIdx)
		        Tcl_ListObjAppendElement(interp, plist,
				GetParameterValue(instops, verbatim, refinst));
		     else
		        Tcl_ListObjAppendElement(interp, plist,
				Tcl_NewStringObj(param_types[instops->which],
				strlen(param_types[instops->which])));
		  }
	       }

	       /* Search label for parameterized substrings.  These are	*/
	       /* backwards-referenced parameters, although they are 	*/
	       /* not stored in the eparam record of the label.		*/

	       if ((value == P_SUBSTRING) && IS_LABEL(thiselem)) {
		  stringpart *cstr;
		  labelptr clab = (labelptr)thiselem;
		  for (cstr = clab->string; cstr != NULL; cstr = cstr->nextpart) {
		     if (cstr->type == PARAM_START) {
	       	        kpair = Tcl_NewListObj(0, NULL);
			ops = find_param(refinst, cstr->data.string);
	                Tcl_ListObjAppendElement(interp, kpair,
			   	Tcl_NewStringObj(ops->key, strlen(ops->key)));
			if (idx == GetIdx)
		           Tcl_ListObjAppendElement(interp, kpair,
					GetParameterValue(ops, verbatim, refinst));
			else
		           Tcl_ListObjAppendElement(interp, kpair,
					Tcl_NewStringObj(param_types[ops->which],
					strlen(param_types[ops->which])));
	                Tcl_ListObjAppendElement(interp, plist, kpair);
		     }
		  }
	       }
	    }
	    Tcl_SetObjResult(interp, plist);
	 }
	 else {
	    plist = Tcl_NewListObj(0, NULL);
	    if (thiselem == NULL) {
	       for (ops = refobj->params; ops != NULL; ops = ops->next) {
	       	  kpair = Tcl_NewListObj(0, NULL);
	          Tcl_ListObjAppendElement(interp, kpair,
		     Tcl_NewStringObj(ops->key, strlen(ops->key)));
		  if (idx == GetIdx) {
		     instops = find_param(refinst, ops->key);
		     Tcl_ListObjAppendElement(interp, kpair,
				GetParameterValue(instops, verbatim, refinst));
		  }
		  else
	             Tcl_ListObjAppendElement(interp, kpair,
				Tcl_NewStringObj(param_types[ops->which],
				strlen(param_types[ops->which])));
	          Tcl_ListObjAppendElement(interp, plist, kpair);
	       }
	    }
	    else {
	       for (epp = thiselem->passed; epp != NULL; epp = epp->next) {
		  kpair = Tcl_NewListObj(0, NULL);
		  ops = find_param(refinst, epp->key);
	          Tcl_ListObjAppendElement(interp, kpair,
			Tcl_NewStringObj(ops->key, strlen(ops->key)));
		  if (idx == GetIdx)
		     Tcl_ListObjAppendElement(interp, kpair,
				GetParameterValue(ops, verbatim, refinst));
		  else
	             Tcl_ListObjAppendElement(interp, kpair,
			   Tcl_NewStringObj(param_types[ops->which],
			   strlen(param_types[ops->which])));
	          Tcl_ListObjAppendElement(interp, plist, kpair);
	       }

	       /* Search label for parameterized substrings.  These are	*/
	       /* backwards-referenced parameters, although they are 	*/
	       /* not stored in the eparam record of the label.		*/

	       if (IS_LABEL(thiselem)) {
		  stringpart *cstr;
		  labelptr clab = (labelptr)thiselem;
		  for (cstr = clab->string; cstr != NULL; cstr = cstr->nextpart) {
		     if (cstr->type == PARAM_START) {
	       	        kpair = Tcl_NewListObj(0, NULL);
			ops = find_param(refinst, cstr->data.string);
	                Tcl_ListObjAppendElement(interp, kpair,
			   	Tcl_NewStringObj(ops->key, strlen(ops->key)));
			if (idx == GetIdx)
		           Tcl_ListObjAppendElement(interp, kpair,
					GetParameterValue(ops, verbatim, refinst));
			else
		           Tcl_ListObjAppendElement(interp, kpair,
					Tcl_NewStringObj(param_types[ops->which],
					strlen(param_types[ops->which])));
	                Tcl_ListObjAppendElement(interp, plist, kpair);
		     }
		  }
	       }
	    }
	    Tcl_SetObjResult(interp, plist);
	 }
         break;

      case DefaultIdx:
	 if (objc == nidx + 2) {
	    /* Check against keys */
	    ops = match_param(refobj, Tcl_GetString(objv[nidx + 1]));
	    if (ops == NULL) {
               if ((result = Tcl_GetIndexFromObj(interp, objv[nidx + 1],
			(CONST84 char **)param_types, "parameter type",
			nidx - 1, &value)) != TCL_OK) {
	          Tcl_SetResult(interp, "Must have a valid key or parameter type",
			NULL);
	          return result;
	       }
	    }
	    else {		/* get default value(s) */
	       plist = Tcl_NewListObj(0, NULL);
	       if (thiselem == NULL) {
		  if (ops != NULL) {
		     Tcl_ListObjAppendElement(interp, plist,
				GetParameterValue(ops, verbatim, refinst));
		  }
		  else {
		     for (ops = refobj->params; ops != NULL; ops = ops->next) {
		        if (ops->which == value) {
		           Tcl_ListObjAppendElement(interp, plist,
				GetParameterValue(ops, verbatim, refinst));
			}
		     }
	          }
	       }
	       else {
		  for (epp = thiselem->passed; epp != NULL; epp = epp->next) {
		     ops = match_param(refobj, epp->key);
		     if (ops->which == value) {
		        Tcl_ListObjAppendElement(interp, plist,
				GetParameterValue(ops, verbatim, refinst));
		     }
		  }

		  /* search label for parameterized substrings */

		  if ((value == P_SUBSTRING) && IS_LABEL(thiselem)) {
		     stringpart *cstr;
		     labelptr clab = (labelptr)thiselem;
		     for (cstr = clab->string; cstr != NULL; cstr = cstr->nextpart) {
			if (cstr->type == PARAM_START) {
			   ops = match_param(refobj, cstr->data.string);
			   if (ops != NULL)
		              Tcl_ListObjAppendElement(interp, plist,
					GetParameterValue(ops, verbatim, refinst));
			}
		     }
		  }
	       }
	       Tcl_SetObjResult(interp, plist);
	    }
	 }
	 else if (objc == nidx + 1) {	/* list all parameters and their defaults */
	    plist = Tcl_NewListObj(0, NULL);
	    for (ops = refobj->params; ops != NULL; ops = ops->next) {
	       kpair = Tcl_NewListObj(0, NULL);
	       Tcl_ListObjAppendElement(interp, kpair,
			Tcl_NewStringObj(ops->key, strlen(ops->key)));
	       Tcl_ListObjAppendElement(interp, kpair,
			GetParameterValue(ops, verbatim, refinst));
	       Tcl_ListObjAppendElement(interp, plist, kpair);
	    }
	    Tcl_SetObjResult(interp, plist);
	 }
	 else {
	    Tcl_WrongNumArgs(interp, 1, objv, "default <type|key> [<value>]");
	    return TCL_ERROR;
	 }
	 break;

      case SetIdx:			/* currently, instances only. . .*/
	 if (objc == nidx + 3) {	/* possibly to be expanded. . .	 */
	    char *key = Tcl_GetString(objv[nidx + 1]);
	    objinstptr searchinst = NULL;

	    /* Allow option "set" to act on more than one selection */

	    if (areastruct.selects == 0) goto keycheck;

	    while (j < areastruct.selects) {

	       refinst = SELTOOBJINST(areastruct.selectlist + j);
	       refobj = refinst->thisobject;

	       /* Check against keys */
keycheck:
	       instops = match_instance_param(refinst, key);
	       ops = match_param(refobj, key);
	       if (instops == NULL) {
	          if (ops == NULL) {
		     if (!forwarding || (areastruct.selects <= 1)) {
			Tcl_SetResult(interp, "Invalid key", NULL);
			return TCL_ERROR;
		     }
		     else
			goto next_param;
	          }
	          copyparams(refinst, refinst);
	          instops = match_instance_param(refinst, key);
	       }
	       else if (ops->type == XC_EXPR) {
	          /* If the expression is currently the default expression	*/
	          /* but the instance value is holding the last evaluated	*/
	          /* result, then we have to delete and regenerate the		*/
	          /* existing instance parameter ("verbatim" assumed even	*/
	          /* if not declared because you can't change the result	*/
	          /* of the expression).					*/

	          free_instance_param(refinst, instops);
	          instops = copyparameter(ops);
	          instops->next = refinst->params;
	          refinst->params = instops;
	       }
	       if (indirection) {
	          char *refkey = Tcl_GetString(objv[nidx + 2]);
	       
	          if (refinst != areastruct.topinstance)
		     searchinst = areastruct.topinstance;
	          else if (areastruct.stack) {
		     searchinst = areastruct.stack->thisinst;
	          }
	          else {
		     resolveparams(refinst);
		     Tcl_SetResult(interp, "On top-level page:  "
				"no indirection possible!", NULL);
		     return TCL_ERROR;
	          }
	          if (match_param(searchinst->thisobject, refkey) == NULL) {
		     resolveparams(refinst);
	             Tcl_SetResult(interp, "Invalid indirect reference key", NULL);
	             return TCL_ERROR;
	          }
	          /* Create an eparam record in the instance */
	          epp = make_new_eparam(refkey);
	          epp->pdata.refkey = strdup(key);
	          epp->next = refinst->passed;
	          refinst->passed = epp;
	       }
	       else
	          SetParameterValue(interp, instops, objv[nidx + 2]);
	       resolveparams(refinst);

	       /* Check if there are more selections to modify */

next_param:
	       if (!forwarding) break;
	       while (++j != areastruct.selects)
		  if (SELECTTYPE(areastruct.selectlist + j) == OBJINST)
		     break;
	    }

	    /* Redraw everything (this could be finessed. . .) */
	    drawarea(areastruct.area, (caddr_t)NULL, (caddr_t)NULL);
	 }
	 else {
	    Tcl_WrongNumArgs(interp, 1, objv, "set <key>");
	    return TCL_ERROR;
	 }
         break;

      case MakeIdx: 
	 if (objc >= (nidx + 2) && objc <= (nidx + 4)) {
            if ((result = Tcl_GetIndexFromObj(interp, objv[nidx + 1],
			(CONST84 char **)param_types, "parameter type",
			nidx - 1, &value)) != TCL_OK)
	       return result;

	    if (objc == (nidx + 4)) {
	       if (value == P_SUBSTRING) {
		  stringpart *strptr = NULL, *newpart;
	          result = GetXCStringFromList(interp, objv[nidx + 3], &strptr);
		  if (result != TCL_ERROR) {
	             makestringparam(topobject, Tcl_GetString(objv[nidx + 2]),
				strptr);
		     /* Add the "parameter end" marker to this string */
		     newpart = makesegment(&strptr, NULL);
		     newpart->nextpart = NULL;
		     newpart->type = PARAM_END;
		     newpart->data.string = (u_char *)NULL;
		  }
	       }
	       else if (value == P_NUMERIC) {
		  double tmpdbl;
		  char *exprstr;
		  Tcl_Obj *exprres;

		  result = Tcl_GetDoubleFromObj(interp, objv[nidx + 3], &tmpdbl);
		  if (result != TCL_ERROR)
		     makefloatparam(topobject, Tcl_GetString(objv[nidx + 2]),
				(float)tmpdbl);
		  else {
		     /* This may be an expression; if so, it must evaluate */
		     /* to a numeric type.				   */
		     Tcl_ResetResult(interp);
		     exprstr = Tcl_GetString(objv[nidx + 3]);
		     result = Tcl_Eval(interp, exprstr);
		     if (result != TCL_OK) {
			Tcl_SetResult(xcinterp, "Bad result from expression!", NULL);
			return result;
		     }
		     exprres = Tcl_GetObjResult(interp);
		     result = Tcl_GetDoubleFromObj(interp, exprres, &tmpdbl);
		     if (result != TCL_ERROR)
		        makeexprparam(topobject, Tcl_GetString(objv[nidx + 2]),
				exprstr, P_NUMERIC);
		     else {
			Tcl_SetResult(xcinterp, "Expression evaluates to "
				"non-numeric type!", NULL);
			return result;
		     }
		  }
	       }
	       else if (value == P_EXPRESSION) {
		  char *exprstr;

		  exprstr = Tcl_GetString(objv[nidx + 3]);
		  result = Tcl_Eval(interp, exprstr);
		  if (result != TCL_OK) {
		     Tcl_SetResult(xcinterp, "Bad result from expression!", NULL);
		     /* Not fatal to have a bad expression result. . . */
		     /* return result; */
		  }
		  makeexprparam(topobject, Tcl_GetString(objv[nidx + 2]),
				exprstr, P_EXPRESSION);
	       }
	       else {
		  Tcl_WrongNumArgs(interp, 1, objv,
			"Use only with substring, numeric, and expression");
		  return TCL_ERROR;
	       }
	    }
	    else if (objc == nidx + 3) {
               startparam((Tk_Window)clientData, (pointertype)value,
			Tcl_GetString(objv[nidx + 2]));
	    }
	    else {
	       if ((value == P_SUBSTRING) || (value == P_NUMERIC) ||
			(value == P_EXPRESSION)) {
		  Tcl_WrongNumArgs(interp, 1, objv,
				"make substring|numeric|expression <key>");
		  return TCL_ERROR;
	       }
	       else
                  startparam((Tk_Window)clientData, (pointertype)value, NULL);
	    }
	 }
	 else {
	    Tcl_WrongNumArgs(interp, 1, objv, "make <type> [<key>]");
	    return TCL_ERROR;
	 }
         break;

      case ForgetIdx: 
	 if (objc == nidx + 2) {
	    /* Check against keys */
	    ops = match_param(topobject, Tcl_GetString(objv[nidx + 1]));
	    if (ops == NULL) {
               if ((result = Tcl_GetIndexFromObj(interp, objv[nidx + 1],
			(CONST84 char **)param_types, "parameter type",
			nidx - 1, &value)) != TCL_OK)
	          return result;
               unparameterize(value);
	    }
	    else {
               unparameterize(ops->which);
	    }
	 }
	 else {
	    Tcl_WrongNumArgs(interp, 1, objv, "forget <type>");
	    return TCL_ERROR;
	 }
         break;
   }
   return XcTagCallback(interp, objc, objv);
}

/*----------------------------------------------------------------------*/

int xctcl_select(ClientData clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *CONST objv[])
{
   char *argstr;
   short *newselect;
   int selected_prior, selected_new, nidx, result;
   Tcl_Obj *objPtr, *listPtr;
   genericptr *egen, *esrch;
   XPoint newpos;

   if (objc == 1) {
      /* Special case: "select" by itself returns the number of	*/
      /* selected objects.					*/
      Tcl_SetObjResult(interp, Tcl_NewIntObj((int)areastruct.selects));
      return XcTagCallback(interp, objc, objv);
   }
   else {
      nidx = 1;
      result = ParseElementArguments(interp, objc, objv, &nidx, ALL_TYPES);
      if (result != TCL_OK) return result;
   }

   if (objc != 2) {
      Tcl_WrongNumArgs(interp, 1, objv, "here | get | <element_handle>");
      return TCL_ERROR;
   }

   if (nidx == 1) {
      argstr = Tcl_GetString(objv[1]);
      if (!strcmp(argstr, "here")) {
         newpos = UGetCursorPos();
         areastruct.save = newpos;
         selected_prior = areastruct.selects;
         newselect = select_element(ALL_TYPES);
         selected_new = areastruct.selects - selected_prior;
      }
      else if (!strcmp(argstr, "get")) {
         newselect = areastruct.selectlist;
         selected_new = areastruct.selects;
      }
      else {
         Tcl_WrongNumArgs(interp, 1, objv, "here | get | <object_handle>");
	 return TCL_ERROR;
      }

      listPtr = Tcl_NewListObj(0, NULL);
      if (selected_new == 0) {
      }
      else if (selected_new == 1) {
         objPtr = Tcl_NewHandleObj(SELTOGENERIC(newselect));
	 Tcl_ListObjAppendElement(interp, listPtr, objPtr);
      }
      else if (selected_new > 1) {
         int i;
         for (i = 0; i < selected_new; i++) {
	    newselect = areastruct.selectlist + i;
            objPtr = Tcl_NewHandleObj(SELTOGENERIC(newselect));
	    Tcl_ListObjAppendElement(interp, listPtr, objPtr);
         }
      }
      Tcl_SetObjResult(interp, listPtr);
   }
   return XcTagCallback(interp, objc, objv);
}

/*----------------------------------------------------------------------*/

int xctcl_deselect(ClientData clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *CONST objv[])
{
   int i, j, k, result, numobjs;
   pointertype ehandle;
   char *argstr;
   Tcl_Obj *lobj;

   if (objc > 3) {
      Tcl_WrongNumArgs(interp, 1, objv, "[element_handle]");
      return TCL_ERROR;
   }
   else if (objc == 3 || (objc == 2 && !strcmp(Tcl_GetString(objv[0]), "deselect"))) {

      argstr = Tcl_GetString(objv[1]);
      if (strcmp(argstr, "selected")) {

         /* check for object handles (integer list) */

         result = Tcl_ListObjLength(interp, objv[1], &numobjs);
         if (result != TCL_OK) return result;

	 for (j = 0; j < numobjs; j++) {
            result = Tcl_ListObjIndex(interp, objv[1], j, &lobj);
            if (result != TCL_OK) return result;
	    result = Tcl_GetHandleFromObj(interp, lobj, (void *)&ehandle);
            if (result != TCL_OK) return result;
            i = GetPartNumber((genericptr)ehandle, topobject, ALL_TYPES);
            if (i == -1) {
	       Tcl_SetResult(interp, "No such element exists.", NULL);
	       return TCL_ERROR;
            }
	    for (i = 0; i < areastruct.selects; i++) {
	       short *newselect = areastruct.selectlist + i;
	       if ((genericptr)ehandle == SELTOGENERIC(newselect)) {
		  SetFunction(dpy, areastruct.gc, GXcopy);
		  XTopSetForeground(SELTOCOLOR(newselect));
		  geneasydraw(*newselect, DEFAULTCOLOR, topobject,
			areastruct.topinstance);

		  areastruct.selects--;
		  for (k = i; k < areastruct.selects; k++)
		      *(areastruct.selectlist + k) = *(areastruct.selectlist + k + 1);
		  if (areastruct.selects == 0) {
		     free(areastruct.selectlist);
		     freeselects();  	/* specifically, free hierstack */
		  }
	       }
	    }
	 }
      }
      else
	 unselect_all();
   }
   else
      startdesel((Tk_Window)clientData, NULL, NULL);

   return XcTagCallback(interp, objc, objv);
}

/*----------------------------------------------------------------------*/

int xctcl_push(ClientData clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *CONST objv[])
{
   int result = ParseElementArguments(interp, objc, objv, NULL, OBJINST);

   if (result != TCL_OK) return result;

   pushobject(NULL);

   return XcTagCallback(interp, objc, objv);
}

/*----------------------------------------------------------------------*/

int xctcl_pop(ClientData clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *CONST objv[])
{
   if (objc != 1) {
      Tcl_WrongNumArgs(interp, 1, objv, "(no arguments)");
      return TCL_ERROR;
   }
   popobject((Tk_Window)clientData, 0, NULL);

   return XcTagCallback(interp, objc, objv);
}

/*----------------------------------------------------------------------*/
/* Object queries							*/
/*----------------------------------------------------------------------*/

int xctcl_object(ClientData clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *CONST objv[])
{
   int i, j, idx, idx2, result, value, nidx, libno;
   double tmpdbl;
   char *tmpstr, *objname;
   genericptr egen;
   Tcl_Obj *objPtr, **newobjv, *ilist, *plist, *hobj;
   pointertype ehandle;
   objinstptr thisinst;
   objectptr thisobj, *libobj;

   static char *subCmds[] = {"make", "name", "parts", "library",
	"handle", "hide", "unhide", NULL};
   enum SubIdx {
      MakeIdx, NameIdx, PartsIdx, LibraryIdx, HandleIdx, HideIdx, UnhideIdx
   };

   /* (revision) "object handle <name>" returns a handle (or null), so	*/
   /* all commands can unambiguously operate on a handle (or nothing)	*/
   /* in the second position.						*/

   nidx = 0;

   /* 2nd argument may be a handle, object name, or nothing.	 */
   /* If nothing, the instance of the top-level page is assumed. */

   if (objc < 2) {
      Tcl_WrongNumArgs(interp, 0, objv, "object [handle] <option> ...");
      return TCL_ERROR;
   }

   result = Tcl_GetHandleFromObj(interp, objv[1], (void *)&ehandle);
   if (result != TCL_OK) {
      Tcl_ResetResult(interp);
      ehandle = (pointertype)(areastruct.topinstance);
   }
   else {
      nidx = 1;
      objc--;
   }
   egen = (genericptr)ehandle;

   if (ELEMENTTYPE(egen) != OBJINST) {
      Tcl_SetResult(interp, "handle does not point to an object instance!", NULL);
      return TCL_ERROR;
   }
   if (objc < 2) {
      Tcl_WrongNumArgs(interp, 0, objv, "object <handle> <option> ...");
      return TCL_ERROR;
   }
   thisinst = (objinstptr)egen;

   if ((result = Tcl_GetIndexFromObj(interp, objv[1 + nidx],
		(CONST84 char **)subCmds, "option", 1 + nidx, &idx)) != TCL_OK)
      return result;

   switch (idx) {
      case LibraryIdx:
      case HideIdx:
      case UnhideIdx:
	 objname = thisinst->thisobject->name;
         for (i = 0; i < xobjs.numlibs; i++) {
            for (j = 0; j < xobjs.userlibs[i].number; j++) {
               libobj = xobjs.userlibs[i].library + j;
               if (!objnamecmp(objname, (*libobj)->name)) {
		  libno = i;
		  break;
	       }
	    }
	 }
	 break;
   }

   switch (idx) {
      case HandleIdx:
	 if ((objc == 3) && (!NameToObject(Tcl_GetString(objv[nidx + 2]),
			(objinstptr *)&ehandle, TRUE))) {
	    Tcl_SetResult(interp, "Object is not loaded.", NULL);
	    return TCL_ERROR;
	 }
	 else
	    Tcl_SetObjResult(interp, Tcl_NewHandleObj(ehandle));
         break;

      case LibraryIdx:
	 Tcl_SetObjResult(interp, Tcl_NewIntObj(libno));
	 break;

      case HideIdx:
	 thisinst->thisobject->hidden = True;
	 composelib(libno + LIBRARY);
         break;

      case UnhideIdx:
	 thisinst->thisobject->hidden = False;
	 composelib(libno + LIBRARY);
         break;

      case MakeIdx:
	 if ((areastruct.selects == 0) && (nidx == 0)) {
	    /* h = object make "name" [{element_list}] [library]*/
	    newobjv = (Tcl_Obj **)(&objv[2]);
	    result = ParseElementArguments(interp, objc - 2, newobjv, NULL, ALL_TYPES);
	    if (result != TCL_OK) return result;
	 }
	 else if (nidx == 1) {
	    Tcl_SetResult(interp, "\"object <handle> make\" is illegal", NULL);
	    return TCL_ERROR;
	 }
	 else if (objc < 3) {
	    Tcl_WrongNumArgs(interp, 1, objv, "make <name> [element_list] [<library>]");
	    return TCL_ERROR;
	 }
	 strcpy(_STR2, Tcl_GetString(objv[nidx + 2]));
	 if (objc >= 4)
	    ParseLibArguments(xcinterp, 2, &objv[objc - 2], NULL, &libno);
	 else
	    libno = -1;
	 domakeobject(libno);
	 break;

      case NameIdx:
	 if (nidx == 1 || areastruct.selects == 0) {
	    Tcl_AppendElement(interp, thisinst->thisobject->name);
	 }
	 else {
	    for (i = 0; i < areastruct.selects; i++) {
	       if (SELECTTYPE(areastruct.selectlist + i) == OBJINST) {
		  thisinst = SELTOOBJINST(areastruct.selectlist + i);
	          Tcl_AppendElement(interp, thisinst->thisobject->name);
	       }
	    }
	 }
	 break;
      case PartsIdx:
	 /* Make a list of the handles of all parts in the object */
	 if (nidx == 1 || areastruct.selects == 0) {
	    plist = Tcl_NewListObj(0, NULL);
	    for (j = 0; j < thisinst->thisobject->parts; j++) {
	       hobj = Tcl_NewHandleObj(*(thisinst->thisobject->plist + j));
	       Tcl_ListObjAppendElement(interp, plist, hobj);
	    }
	    Tcl_SetObjResult(interp, plist);
	 }
	 else {
	    ilist = Tcl_NewListObj(0, NULL);
	    for (i = 0; i < areastruct.selects; i++) {
	       if (SELECTTYPE(areastruct.selectlist + i) == OBJINST) {
		  objinstptr thisinst = SELTOOBJINST(areastruct.selectlist + i);
	          Tcl_ListObjAppendElement(interp, ilist,
			Tcl_NewStringObj(thisinst->thisobject->name,
			strlen(thisinst->thisobject->name)));
		  plist = Tcl_NewListObj(0, NULL);
		  for (j = 0; j < thisinst->thisobject->parts; j++) {
		     hobj = Tcl_NewHandleObj(*(thisinst->thisobject->plist + j));
		     Tcl_ListObjAppendElement(interp, plist, hobj);
		  }
		  Tcl_ListObjAppendElement(interp, ilist, plist);
	       }
	    }
	    Tcl_SetObjResult(interp, ilist);
	 }
	 break;
   }
   return XcTagCallback(interp, objc, objv);
}

/*----------------------------------------------------------------------*/
/* Individual element handling.						*/
/*----------------------------------------------------------------------*/

int xctcl_label(ClientData clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *CONST objv[])
{
   int i, idx, idx2, nidx, result, value;
   double tmpdbl;
   char *tmpstr;
   Tcl_Obj *objPtr, *listPtr;
   labelptr tlab;

   static char *subCmds[] = {"make", "type", "insert", "justify", "flipinvariant",
	"visible", "font", "scale", "encoding", "style", "family", "substring",
	"text", "latex", "list", "replace", "position", NULL};
   enum SubIdx {
      MakeIdx, TypeIdx, InsertIdx, JustIdx, FlipIdx, VisibleIdx,
	FontIdx, ScaleIdx, EncodingIdx, StyleIdx, FamilyIdx, SubstringIdx,
	TextIdx, LaTeXIdx, ListIdx, ReplaceIdx, PositionIdx
   };

   static char *subsubCmds[] = {"text", "subscript", "superscript",
	"normalscript", "underline", "overline", "noline", "stop",
	"forward", "backward", "halfspace", "quarterspace", "return",
	"name", "scale", "color", "kern", "parameter", "special", NULL};

   static char *pinTypes[] = {"normal", "pin", "local", "global", "info", NULL};

   static char *encValues[] = {"Standard", "special", "ISOLatin1",
	"ISOLatin2", "ISOLatin3", "ISOLatin4", "ISOLatin5",
	"ISOLatin6", NULL};

   static char *styValues[] = {"normal", "bold", "italic", "bolditalic", NULL};

   static char *justValues[] = {"left", "center", "right", "top", "middle",
	"bottom", NULL};

   /* Tk "label" has been renamed to "tcl_label", but we want to	*/
   /* consider the "label" command to be overloaded, such that the	*/
   /* command "label" may be used without reference to namespace.	*/

   Tcl_Obj **newobjv = (Tcl_Obj **)Tcl_Alloc(objc * sizeof(Tcl_Obj *));

   newobjv[0] = Tcl_NewStringObj("tcl_label", 9);
   Tcl_IncrRefCount(newobjv[0]);
   for (i = 1; i < objc; i++) {
      newobjv[i] = Tcl_DuplicateObj(objv[i]);
      Tcl_IncrRefCount(newobjv[i]);
   }

   result = Tcl_EvalObjv(interp, objc, newobjv, 0);

   for (i = 0; i < objc; i++)
      Tcl_DecrRefCount(newobjv[i]);
   Tcl_Free((char *)newobjv);

   if (result == TCL_OK) return result;
   Tcl_ResetResult(interp);

   /* Now, assuming that Tcl didn't like the syntax, we continue on with */
   /* our own version.							 */

   nidx = 4;
   result = ParseElementArguments(interp, objc, objv, &nidx, LABEL);
   if (result != TCL_OK) return result;

   if ((result = Tcl_GetIndexFromObj(interp, objv[nidx],
		(CONST84 char **)subCmds, "option", nidx - 1, &idx)) != TCL_OK)
      return result;

   /* If there are no selections at this point, check if the command is */
   /* appropriate for setting a default value.				*/

   switch (idx) {
      case MakeIdx:
	 if ((areastruct.selects == 0) && (nidx == 1)) {
	    if (objc != 2) {
	       result = Tcl_GetIndexFromObj(interp, objv[2],
			(CONST84 char **)pinTypes, "pin type", 0, &idx2);
	       if (result != TCL_OK) {
	          if (objc == 3) return result;
	          else {
		     Tcl_ResetResult(interp);
		     idx2 = 0;
		  }
	       }
	       else {
	          nidx++;
	          if (idx2 > 1) idx2--;   /* idx2 now matches defs in xcircuit.h */
	       }
	    }
	    if ((objc != 4) && (objc != 5)) {
	       Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
	       return TCL_ERROR;
	    }
	    else {
	       labelptr newlab;
	       stringpart *strptr = NULL;
	       XPoint position;

	       if ((result = GetXCStringFromList(interp, objv[nidx + 1],
			&strptr)) != TCL_OK)
		  return result;

	       if ((result = GetPositionFromList(interp, objv[nidx + 2],
			&position)) != TCL_OK)
		  return result;

	       newlab = new_label(NULL, strptr, idx2, position.x, position.y);
	       objPtr = Tcl_NewHandleObj(newlab);
	       Tcl_SetObjResult(interp, objPtr);
	    }
	 }
	 else if (nidx == 2) {
	    Tcl_SetResult(interp, "\"label <handle> make\" is illegal", NULL);
	    return TCL_ERROR;
	 }
	 else {
	    Tcl_SetResult(interp, "No selections allowed", NULL);
	    return TCL_ERROR;
	 }
	 break;

      case ScaleIdx:
	 if (objc == 2) {
	    if ((areastruct.selects == 0) && (nidx == 1) &&
		eventmode != TEXT_MODE && eventmode != ETEXT_MODE) {
	       objPtr = Tcl_NewDoubleObj((double)areastruct.textscale);
	       Tcl_SetObjResult(interp, objPtr);
	    }
	    else {
	       float *floatptr;
	       gettextsize(&floatptr);
	       objPtr = Tcl_NewDoubleObj((double)((float)(*floatptr)));
	       Tcl_SetObjResult(interp, objPtr);
	    }
	 }
	 else if ((areastruct.selects == 0) && (nidx == 1) &&
		eventmode != TEXT_MODE && eventmode != ETEXT_MODE) {
	    result = Tcl_GetDoubleFromObj(interp, objv[2], &tmpdbl);
	    if (result != TCL_OK) return result;
	    areastruct.textscale = (float)tmpdbl;
	 }
	 else {
	    /* If we're in edit mode, it will use EDITPART; otherwise,  */
	    /* 2nd argument is ignored and select list is used instead. */
	    strcpy(_STR2, Tcl_GetString(objv[2]));
	    settsize((Tk_Window)clientData, *((labelptr *)EDITPART));
	 }
	 break;

      case FontIdx:
	 if (objc == 2) {
	    tmpstr = fonts[areastruct.psfont].psname;
	    objPtr = Tcl_NewStringObj(tmpstr, strlen(tmpstr));
	    Tcl_SetObjResult(interp, objPtr);
	 }
	 else {
	    tmpstr = Tcl_GetString(objv[2]);
	    for (i = 0; i < fontcount; i++)
	       if (!strcmp(fonts[i].psname, tmpstr)) break;
	    setfont((Tk_Window)clientData, (u_int)i, NULL);
	 }
	 break;

      case FamilyIdx:
	 if (objc == 2) {
	    tmpstr = fonts[areastruct.psfont].family;
	    objPtr = Tcl_NewStringObj(tmpstr, strlen(tmpstr));
	    Tcl_SetObjResult(interp, objPtr);
	 }
	 else {
	    tmpstr = Tcl_GetString(objv[2]);
	    for (i = 0; i < fontcount; i++)
	       if (!strcmp(fonts[i].family, tmpstr)) break;
	    setfont((Tk_Window)clientData, (u_int)i, NULL);
	 }
	 break;

      case EncodingIdx:
	 if (objc == 2) {
	    i = (fonts[areastruct.psfont].flags & 0xe0) >> 5;
	    tmpstr = encValues[i];
	    objPtr = Tcl_NewStringObj(tmpstr, strlen(tmpstr));
	    Tcl_SetObjResult(interp, objPtr);
	 }
	 else {
	    if (Tcl_GetIndexFromObj(interp, objv[2],
			(CONST84 char **)encValues, "encodings", 0,
			&idx2) != TCL_OK) {
	       return TCL_ERROR;
	    }
	    fontencoding((Tk_Window)clientData, idx2, NULL);
	 }
	 break;

      case StyleIdx:
	 if (objc == 2) {
	    i = fonts[areastruct.psfont].flags & 0x3;
	    tmpstr = styValues[i];
	    objPtr = Tcl_NewStringObj(tmpstr, strlen(tmpstr));
	    Tcl_SetObjResult(interp, objPtr);
	 }
	 else {
	    if (Tcl_GetIndexFromObj(interp, objv[2],
			(CONST84 char **)styValues,
			"styles", 0, &idx2) != TCL_OK) {
	       return TCL_ERROR;
	    }
	    fontstyle((Tk_Window)clientData, idx2, NULL);
	 }
	 break;

      case VisibleIdx:	/* Change visibility of pin */
	 if ((areastruct.selects == 0) && (nidx == 1)) {
	    Tcl_SetResult(interp, "Must have a label selection.", NULL);
	    return TCL_ERROR;
	 }
	 if (objc == nidx + 1) {	/* Return pin visibility flag(s) */
	    for (i = 0; i < areastruct.selects; i++) {
	       if (SELECTTYPE(areastruct.selectlist + i) != LABEL) continue;
	       tlab = SELTOLABEL(areastruct.selectlist + i);
	       if (tlab->pin == NORMAL) continue;
	       Tcl_AppendElement(interp, (tlab->justify & PINVISIBLE) ?
			"true" : "false");
	    }
	 }
	 else {
	    int pval;
	    char *pstr = Tcl_GetString(objv[nidx + 1]);
	    char pl = tolower(pstr[0]);
	    pval = ((pl == 'v') || (pl == 'y') || (pl = 't')) ? True : False;
	    for (i = 0; i < areastruct.selects; i++) {
	       if (SELECTTYPE(areastruct.selectlist + i) != LABEL) continue;
	       tlab = SELTOLABEL(areastruct.selectlist + i);
	       if (tlab->pin == NORMAL) continue;
	       if (pval)
	          tlab->justify |= PINVISIBLE;
	       else
	          tlab->justify &= ~PINVISIBLE;
	    }
	 }
	 break;

      case TypeIdx:	/* Change type of label */
	 if ((areastruct.selects == 0) && (nidx == 1)) {
	    Tcl_SetResult(interp, "Must have a label selection.", NULL);
	    return TCL_ERROR;
	 }
	 if (objc == nidx + 1) {	/* Return pin type(s) */
	    int pidx;
	    for (i = 0; i < areastruct.selects; i++) {
	       if (SELECTTYPE(areastruct.selectlist + i) != LABEL) continue;
	       tlab = SELTOLABEL(areastruct.selectlist + i);
	       switch(tlab->pin) {
		  case NORMAL:
		     pidx = 0; break;
		  case LOCAL:
		     pidx = 2; break;
		  case GLOBAL:
		     pidx = 3; break;
		  case INFO:
		     pidx = 4; break;
	       }
	       Tcl_AppendElement(interp, pinTypes[pidx]);
	    }
	 }
	 else {
	    if (Tcl_GetIndexFromObj(interp, objv[nidx + 1],
			(CONST84 char **)pinTypes,
			"pin types", 0, &idx2) != TCL_OK) {
	       return TCL_ERROR;
	    }
	    for (i = 0; i < areastruct.selects; i++) {
	       if (SELECTTYPE(areastruct.selectlist + i) != LABEL) continue;
	       tlab = SELTOLABEL(areastruct.selectlist + i);
	       switch(idx2) {
	          case 0: 
		     tlab->pin = NORMAL;
	             break;
	          case 1: case 2:
		     tlab->pin = LOCAL;
	             break;
	          case 3:
		     tlab->pin = GLOBAL;
	             break;
	          case 4:
		     tlab->pin = INFO;
	             break;
	       }
	       pinconvert(tlab, tlab->pin);
	       setobjecttype(topobject);
	    }
	 }
	 break;

      case InsertIdx:	/* Text insertion */
	 if ((areastruct.selects != 0) || (nidx != 1)) {
	    Tcl_SetResult(interp, "Insertion into handle or selection"
			" not supported (yet)", NULL);
	    return TCL_ERROR;
	 }
	 if (eventmode != TEXT_MODE && eventmode != ETEXT_MODE) {
	    Tcl_SetResult(interp, "Must be in edit mode to insert into label.",
			NULL);
	    return TCL_ERROR;
	 }
	 if (Tcl_GetIndexFromObj(interp, objv[nidx + 1],
			(CONST84 char **)subsubCmds,
			"insertions", 0, &idx2) != TCL_OK) {
	    return TCL_ERROR;
	 }
	 if ((idx2 > TEXT_STRING) && (idx2 < FONT_NAME) && (objc - nidx == 2)) { 
	    labeltext(idx2, (char *)1);
	 }
	 else if ((idx2 == PARAM_START) && (objc - nidx == 3)) { 
	    result = Tcl_GetIntFromObj(interp, objv[nidx + 2], &value);
	    if (result != TCL_OK) return result;
	    labeltext(idx2, (char *)&value);
	 }
	 else if ((idx2 == PARAM_START) && (objc - nidx == 2)) { 
	    insertparam();
	 }
	 else if ((idx2 == FONT_COLOR) && (objc - nidx == 3)) {
	    result = GetColorFromObj(interp, objv[nidx + 2], &value);
	    if (result != TCL_OK) return result;
	    labeltext(idx2, (char *)&value);
	 }
	 else if ((idx2 == FONT_NAME) && (objc - nidx == 3)) {
	    tmpstr = Tcl_GetString(objv[nidx + 2]);
	    for (i = 0; i < fontcount; i++)
	       if (!strcmp(fonts[i].psname, tmpstr)) break;
	    if (i == fontcount) {
	       Tcl_SetResult(interp, "Invalid font name.", NULL);
	       return TCL_ERROR;
	    }
	    else
	       labeltext(idx2, (char *)&i);
	 }
	 else if ((idx2 == FONT_SCALE) && (objc - nidx == 3)) {
	    float fvalue;
	    double dvalue;
	    result = Tcl_GetDoubleFromObj(interp, objv[nidx + 2], &dvalue);
	    if (result != TCL_OK) return result;
	    fvalue = (float)dvalue;
	    labeltext(idx2, (char *)&fvalue);
	 }
	 else if ((idx2 == KERN) && (objc - nidx == 3)) {
	    strcpy(_STR2, Tcl_GetString(objv[nidx + 2]));
	    setkern(NULL, NULL);
	 }
	 else if ((idx2 == TEXT_STRING) && (objc - nidx == 3)) {
	    char *substring = Tcl_GetString(objv[nidx + 2]);
	    for (i = 0; i < strlen(substring); i++)
	       labeltext(substring[i], NULL);
	 }

	 /* PARAM_END in xcircuit.h is actually mapped to the same */
	 /* position as "special" in subsubCommands[] above; don't */
	 /* be confused. . .					   */

	 else if ((idx2 == PARAM_END) && (objc - nidx == 2)) {
	    dospecial();
	 }
	 else if ((idx2 == PARAM_END) && (objc - nidx == 3)) {
	    result = Tcl_GetIntFromObj(interp, objv[nidx + 2], &value);
	    if (result != TCL_OK) return result;
	    labeltext(value, NULL);
	 }
	 else {
	    Tcl_WrongNumArgs(interp, 2, objv, "insertion_type ?arg ...?");
	    return TCL_ERROR;
	 }
	 break;

      case SubstringIdx:
	 objPtr = Tcl_NewListObj(0, NULL);
	 if (areastruct.selects == 1) {
	    if (SELECTTYPE(areastruct.selectlist) == LABEL) {
	       Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewIntObj(textend));
	       Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewIntObj(textpos));
	    }
	 }
	 Tcl_SetObjResult(interp, objPtr);
	 break;

      case JustIdx:
	 if (Tcl_GetIndexFromObj(interp, objv[2],
		(CONST84 char **)justValues,
		"horizontal justification", 1, &idx2) != TCL_OK) {
	    return TCL_ERROR;
	 }
	 switch (idx2) {
	    case 0: value = NORMAL; break;
	    case 1: value = NOTLEFT; break;
	    case 2: value = NOTLEFT | RIGHT; break;
	    case 3: value = NOTBOTTOM | TOP; break;
	    case 4: value = NOTBOTTOM; break;
	    case 5: value = NORMAL; break;
	 }
	 switch (idx2) {
	    case 0: case 1: case 2:
	       sethjust(NULL, value, NULL);
	       break;
	    case 3: case 4: case 5:
	       setvjust(NULL, value, NULL);
	       break;
	 }
	 break;

      case FlipIdx:
	 if ((result = Tcl_GetBooleanFromObj(interp, objv[nidx + 1], &value)) != TCL_OK)
	    return result;
	 setjustbit(NULL, FLIPINV, NULL);
	 break;

      case LaTeXIdx:
	 if ((result = Tcl_GetBooleanFromObj(interp, objv[nidx + 1], &value)) != TCL_OK)
	    return result;
	 setjustbit(NULL, LATEXLABEL, NULL);
	 break;

      case TextIdx:
	 if ((areastruct.selects == 0) && (nidx == 1)) {
	    Tcl_SetResult(interp, "Must have a label selection.", NULL);
	    return TCL_ERROR;
	 }
	 if (objc == nidx + 1) {	/* Return label as printable string */
	    char *tstr;
	    objPtr = Tcl_NewListObj(0, NULL);
	    for (i = 0; i < areastruct.selects; i++) {
	       if (SELECTTYPE(areastruct.selectlist + i) != LABEL) continue;
	       tlab = SELTOLABEL(areastruct.selectlist + i);
	       tstr = textprint(tlab->string, areastruct.topinstance);
	       Tcl_ListObjAppendElement(interp, objPtr, 
			Tcl_NewStringObj(tstr, strlen(tstr)));
	       free(tstr);
	    }
	    Tcl_SetObjResult(interp, objPtr);
	 }
	 break;

      case ListIdx:
	 if ((areastruct.selects == 0) && (nidx == 1)) {
	    Tcl_SetResult(interp, "Must have a label selection.", NULL);
	    return TCL_ERROR;
	 }
	 if (objc == nidx + 1) {	/* Return label as printable string */
	    char *tstr;
	    listPtr = Tcl_NewListObj(0, NULL);
	    for (i = 0; i < areastruct.selects; i++) {
	       if (SELECTTYPE(areastruct.selectlist + i) != LABEL) continue;
	       tlab = SELTOLABEL(areastruct.selectlist + i);
	       objPtr = TclGetStringParts(tlab->string);
	       Tcl_ListObjAppendElement(interp, listPtr, objPtr);
	    }
	    Tcl_SetObjResult(interp, listPtr);
	 }
	 break;

      case ReplaceIdx:	/* the opposite of "list" */
	 if ((areastruct.selects == 0) && (nidx == 1)) {
	    Tcl_SetResult(interp, "Must have a label selection.", NULL);
	    return TCL_ERROR;
	 }
	 if (objc == nidx + 2) {	/* Replace string from list */
	    stringpart *strptr = NULL;
	    char *tstr;

	    if ((result = GetXCStringFromList(interp, objv[nidx + 1],
			&strptr)) != TCL_OK)
	       return result;

	    for (i = 0; i < areastruct.selects; i++) {
	       if (SELECTTYPE(areastruct.selectlist + i) != LABEL) continue;
	       tlab = SELTOLABEL(areastruct.selectlist + i);
	       freelabel(tlab->string);
	       tlab->string = stringcopy(strptr);
	    }
	    freelabel(strptr);
	 }
	 break;

      case PositionIdx:
	 if ((areastruct.selects == 0) && (nidx == 1)) {
	    Tcl_SetResult(interp, "Must have a label selection.", NULL);
	    return TCL_ERROR;
	 }
	 if (objc == nidx + 1) {	/* Return position of label */
	    char *tstr;
	    Tcl_Obj *cpair;

	    listPtr = Tcl_NewListObj(0, NULL);
	    for (i = 0; i < areastruct.selects; i++) {
	       if (SELECTTYPE(areastruct.selectlist + i) != LABEL) continue;
	       tlab = SELTOLABEL(areastruct.selectlist + i);
	       cpair = Tcl_NewListObj(0, NULL);
	       objPtr = Tcl_NewIntObj((int)tlab->position.x);
	       Tcl_ListObjAppendElement(interp, cpair, objPtr);
	       objPtr = Tcl_NewIntObj((int)tlab->position.y);
	       Tcl_ListObjAppendElement(interp, cpair, objPtr);
	       Tcl_ListObjAppendElement(interp, listPtr, cpair);
	    }
	    Tcl_SetObjResult(interp, listPtr);
	 }
	 break;
   }
   return XcTagCallback(interp, objc, objv);
}

/*----------------------------------------------------------------------*/
/* Element Fill Styles							*/
/*----------------------------------------------------------------------*/

int xctcl_dofill(ClientData clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *CONST objv[])
{
   char *tstr;
   u_int value;
   int i, idx, result, rval = -1;

   static char *Styles[] = {"opaque", "transparent", "filled", "unfilled",
	"solid", NULL};
   enum StylesIdx {
      OpaqueIdx, TransparentIdx, FilledIdx, UnfilledIdx, SolidIdx
   };

   if (objc == 1) {
      value = areastruct.style;
      Tcl_AppendElement(interp, ((value & OPAQUE) ? "opaque" : "transparent"));
      if (value & FILLED) {
         Tcl_AppendElement(interp, "filled");
	 switch (value & FILLSOLID) {
	    case 0:
               Tcl_AppendElement(interp, "12"); break;
	    case STIP0:
               Tcl_AppendElement(interp, "25"); break;
	    case STIP1:
               Tcl_AppendElement(interp, "37"); break;
	    case STIP1 | STIP0:
               Tcl_AppendElement(interp, "50"); break;
	    case STIP2:
               Tcl_AppendElement(interp, "62"); break;
	    case STIP2 | STIP0:
               Tcl_AppendElement(interp, "75"); break;
	    case STIP2 | STIP1:
               Tcl_AppendElement(interp, "87"); break;
	    case FILLSOLID:
               Tcl_AppendElement(interp, "solid"); break;
	 }
      }
      else {
	 Tcl_AppendElement(interp, "unfilled");
      }
      return TCL_OK;
   }

   for (i = 1; i < objc; i++) {
      if (Tcl_GetIndexFromObj(interp, objv[i],
			(CONST84 char **)Styles, "fill styles",
			0, &idx) != TCL_OK) {
	 Tcl_ResetResult(interp);
         result = Tcl_GetIntFromObj(interp, objv[i], &value);
         if (result != TCL_OK) {
	    Tcl_SetResult(interp, "Expected fill style or fillfactor 0 to 100", NULL);
	    return result;
	 }
	 else {
            if (value >= 0 && value < 6) value = FILLSOLID;
            else if (value >= 6 && value < 19) value = FILLED;
            else if (value >= 19 && value < 31) value = FILLED | STIP0;
            else if (value >= 31 && value < 44) value = FILLED | STIP1;
            else if (value >= 44 && value < 56) value = FILLED | STIP0 | STIP1;
            else if (value >= 56 && value < 69) value = FILLED | STIP2;
            else if (value >= 69 && value < 81) value = FILLED | STIP2 | STIP0;
            else if (value >= 81 && value < 94) value = FILLED | STIP2 | STIP1;
            else if (value >= 94 && value <= 100) value = FILLED | FILLSOLID;
            else {
               Tcl_SetResult(interp, "Fill value should be 0 to 100", NULL);
               return TCL_ERROR;
            }
            rval = setelementstyle((Tk_Window)clientData, (pointertype)value, 
		FILLED | FILLSOLID);
	 }
      }
      else {
         switch(idx) {
	    case OpaqueIdx:
               rval = setelementstyle((Tk_Window)clientData, OPAQUE, OPAQUE);
	       break;
	    case TransparentIdx:
               rval = setelementstyle((Tk_Window)clientData, NORMAL, OPAQUE);
	       break;
	    case UnfilledIdx:
               rval = setelementstyle((Tk_Window)clientData, FILLSOLID,
			FILLED | FILLSOLID);
	       break;
	    case SolidIdx:
               rval = setelementstyle((Tk_Window)clientData, FILLED | FILLSOLID,
			FILLED | FILLSOLID);
	       break;
	    case FilledIdx:
	       break;
	 }
      }
   }
   if (rval < 0)
      return TCL_ERROR;

   setallstylemarks((u_short)rval);

   /* Tag callback is handled by setallstylemarks() */
   /* return XcTagCallback(interp, objc, objv); */
   return TCL_OK;
}

/*----------------------------------------------------------------------*/
/* Element border styles						*/
/*----------------------------------------------------------------------*/

int xctcl_doborder(ClientData clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *CONST objv[])
{
   int result, i, idx, value, rval = -1;
   u_short mask;
   double wvalue;

   static char *borderStyles[] = {"solid", "dashed", "dotted", "none",
	"unbordered", "unclosed", "closed", "bbox", "set", "get", "square",
	"round", NULL};
   enum StyIdx {
	SolidIdx, DashedIdx, DottedIdx, NoneIdx, UnborderedIdx,
	UnclosedIdx, ClosedIdx, BBoxIdx, SetIdx, GetIdx, SquareIdx,
	RoundIdx
   };

   if (objc == 1) {
      Tcl_Obj *listPtr;
      listPtr = Tcl_NewListObj(0, NULL);
      value = areastruct.style;
      wvalue = (double)areastruct.linewidth;
      switch (value & (DASHED | DOTTED | NOBORDER | SQUARECAP)) {
	 case NORMAL:
	    Tcl_ListObjAppendElement(interp, listPtr, 
			Tcl_NewStringObj("solid", 5)); break;
	 case DASHED:
	    Tcl_ListObjAppendElement(interp, listPtr, 
			Tcl_NewStringObj("dashed", 6)); break;
	 case DOTTED:
	    Tcl_ListObjAppendElement(interp, listPtr, 
			Tcl_NewStringObj("dotted", 6)); break;
	 case NOBORDER:
	    Tcl_ListObjAppendElement(interp, listPtr, 
			Tcl_NewStringObj("unbordered", 10)); break;
	 case SQUARECAP:
	    Tcl_ListObjAppendElement(interp, listPtr, 
			Tcl_NewStringObj("square-endcaps", 10)); break;
      }
      if (value & UNCLOSED)
         Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("unclosed", 8));
      else
         Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("closed", 6));

      if (value & BBOX) 
         Tcl_ListObjAppendElement(interp, listPtr,
		Tcl_NewStringObj("bounding box", 12));

      Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewDoubleObj(wvalue));
      Tcl_SetObjResult(interp, listPtr);
      return TCL_OK;
   }

   for (i = 1; i < objc; i++) {
      result = Tcl_GetIndexFromObj(interp, objv[i],
		 (CONST84 char **)borderStyles,
		"border style", 0, &idx);
      if (result != TCL_OK)
	 return result;

      switch (idx) {
         case GetIdx:
	    {
	       int j, numfound = 0;
	       genericptr setel;
	       Tcl_Obj *objPtr, *listPtr = NULL;

	       for (j = 0; j < areastruct.selects; j++) {
	          setel = SELTOGENERIC(areastruct.selectlist + j);
	          if (IS_ARC(setel) || IS_POLYGON(setel) ||
			IS_SPLINE(setel) || IS_PATH(setel)) {
	             switch(ELEMENTTYPE(setel)) {
		        case ARC: wvalue = ((arcptr)setel)->width; break;
		        case POLYGON: wvalue = ((polyptr)setel)->width; break;
		        case SPLINE: wvalue = ((splineptr)setel)->width; break;
		        case PATH: wvalue = ((pathptr)setel)->width; break;
	             }
		     if ((++numfound) == 2) {
			listPtr = Tcl_NewListObj(0, NULL);
		        Tcl_ListObjAppendElement(interp, listPtr, objPtr);
		     }
		     objPtr = Tcl_NewDoubleObj(wvalue);
		     if (numfound > 1)
		        Tcl_ListObjAppendElement(interp, listPtr, objPtr);
	          }
	       }
	       switch (numfound) {
	          case 0:
		     objPtr = Tcl_NewDoubleObj(areastruct.linewidth);
		     /* fall through */
	          case 1:
	             Tcl_SetObjResult(interp, objPtr);
		     break;
	          default:
	             Tcl_SetObjResult(interp, listPtr);
		     break;
	       }
	    }
	    break;
         case SetIdx:
	    if ((objc - i) != 2) {
	       Tcl_SetResult(interp, "Error: no linewidth given.", NULL);
	       return TCL_ERROR;
	    }
	    result = Tcl_GetDoubleFromObj(interp, objv[++i], &wvalue);
	    if (result == TCL_OK) {
	       sprintf(_STR2, "%f", wvalue);
	       setwwidth((Tk_Window)clientData, NULL);
	    }
	    else {
	       Tcl_SetResult(interp, "Error: invalid border linewidth.", NULL);
	       return TCL_ERROR;
	    }
	    break;
         case SolidIdx: value = NORMAL; mask = DASHED | DOTTED | NOBORDER; break;
         case DashedIdx: value = DASHED; mask = DASHED | DOTTED | NOBORDER; break;
         case DottedIdx: value = DOTTED; mask = DASHED | DOTTED | NOBORDER; break;
         case NoneIdx: case UnborderedIdx:
	    value = NOBORDER; mask = DASHED | DOTTED | NOBORDER; break;
         case UnclosedIdx: value = UNCLOSED; mask = UNCLOSED; break;
         case ClosedIdx: value = NORMAL; mask = UNCLOSED; break;
         case SquareIdx: value = SQUARECAP; mask = SQUARECAP; break;
         case RoundIdx: value = NORMAL; mask = SQUARECAP; break;
         case BBoxIdx:
	    mask = BBOX;
	    if ((objc - i) < 2) value = BBOX;
	    else {
	       char *yesno = Tcl_GetString(objv[++i]);
	       value = (tolower(yesno[0]) == 'y' || tolower(yesno[0]) == 't') ?
		   BBOX : NORMAL;
	    }
	    break;
      }
      if (idx != SetIdx && idx != GetIdx)
         rval = setelementstyle((Tk_Window)clientData, (u_short)value, mask);
   }

   if (rval >= 0) {
      setallstylemarks((u_short)rval);
      return TCL_OK;
   }
   else
      return XcTagCallback(interp, objc, objv);
}

/*----------------------------------------------------------------------*/

int xctcl_polygon(ClientData clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *CONST objv[])
{
   int idx, idx2, nidx, result, value, npoints, j;
   polyptr newpoly, ppoly;
   XPoint ppt;
   pointlist points;
   Tcl_Obj *objPtr, *coord, *cpair, **newobjv;
   Boolean is_box = FALSE;
   Matrix hierCTM;

   static char *subCmds[] = {"make", "border", "fill", "points", "number", NULL};
   enum SubIdx {
	MakeIdx, BorderIdx, FillIdx, PointsIdx, NumberIdx
   };

   nidx = 255;
   result = ParseElementArguments(interp, objc, objv, &nidx, POLYGON);
   if (result != TCL_OK) return result;

   if ((result = Tcl_GetIndexFromObj(interp, objv[nidx],
		(CONST84 char **)subCmds,
		"option", nidx - 1, &idx)) != TCL_OK)
      return result;

   switch (idx) {
      case MakeIdx:
	 if ((areastruct.selects == 0) && (nidx == 1)) {
	    if (objc < 5) {
	       Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
	       return TCL_ERROR;
	    }
	    if (!strcmp(Tcl_GetString(objv[2]), "box")) {
	       npoints = 4;
	       is_box = TRUE;
	    }
	    else {
	       result = Tcl_GetIntFromObj(interp, objv[2], &npoints);
	       if (result != TCL_OK) return result;
	    }
	    if (objc != npoints + 3) {
	       Tcl_WrongNumArgs(interp, 1, objv, "N {x1 y1}...{xN yN}");
	       return TCL_ERROR;
	    }
	    points = (pointlist)malloc(npoints * sizeof(XPoint));
	    for (j = 0; j < npoints; j++) {
	       result = GetPositionFromList(interp, objv[3 + j], &ppt);
	       if (result == TCL_OK) {
	          points[j].x = ppt.x;
	          points[j].y = ppt.y;
	       }
	    }
	    newpoly = new_polygon(NULL, &points, npoints);
	    if (!is_box) newpoly->style |= UNCLOSED;
	    objPtr = Tcl_NewHandleObj(newpoly);
	    Tcl_SetObjResult(interp, objPtr);
	 }
	 else if (nidx == 2) {
	    Tcl_SetResult(interp, "\"polygon <handle> make\" is illegal", NULL);
	    return TCL_ERROR;
	 }
	 else {
	    Tcl_SetResult(interp, "No selections allowed", NULL);
	    return TCL_ERROR;
	 }
	 break;

      case BorderIdx:
	 newobjv = (Tcl_Obj **)(&objv[nidx]);
	 result = xctcl_doborder(clientData, interp, objc - nidx, newobjv);
	 break;

      case FillIdx:
	 newobjv = (Tcl_Obj **)(&objv[nidx]);
	 result = xctcl_dofill(clientData, interp, objc - nidx, newobjv);
	 break;

      case NumberIdx:
	 if (areastruct.selects != 1) {
	    Tcl_SetResult(interp, "Must have exactly one selection to "
		"query points", NULL);
	    return TCL_ERROR;
	 }
	 else {
	    if (SELECTTYPE(areastruct.selectlist) != POLYGON) {
		Tcl_SetResult(interp, "Selected element is not a polygon", NULL);
		return TCL_ERROR;
	    }
	    else
	       ppoly = SELTOPOLY(areastruct.selectlist);

	    if ((objc - nidx) == 1) {
	       objPtr = Tcl_NewIntObj(ppoly->number);
	       Tcl_SetObjResult(interp, objPtr);
	    }
	    else
	    {
		Tcl_SetResult(interp, "Cannot change number of points.\n", NULL);
		return TCL_ERROR;
	    }
	 }
	 break;

      case PointsIdx:
	 if (areastruct.selects != 1) {
	    Tcl_SetResult(interp, "Must have exactly one selection to "
		"query or manipulate points", NULL);
	    return TCL_ERROR;
	 }
	 else {
	    ppoly = SELTOPOLY(areastruct.selectlist);
	    MakeHierCTM(&hierCTM);
	    if (ppoly->type != POLYGON) {
		Tcl_SetResult(interp, "Selected element is not a polygon", NULL);
		return TCL_ERROR;
	    }
	    points = ppoly->points;

	    if ((objc - nidx) == 1)	/* Return a list of all points */
	    {
	       objPtr = Tcl_NewListObj(0, NULL);
	       for (npoints = 0; npoints < ppoly->number; npoints++) {
		  cpair = Tcl_NewListObj(0, NULL);
		  UTransformbyCTM(&hierCTM, points + npoints, &ppt, 1);
	          coord = Tcl_NewIntObj((int)ppt.x);
	          Tcl_ListObjAppendElement(interp, cpair, coord);
	          coord = Tcl_NewIntObj((int)ppt.y);
	          Tcl_ListObjAppendElement(interp, cpair, coord);
	          Tcl_ListObjAppendElement(interp, objPtr, cpair);
	       }
	       Tcl_SetObjResult(interp, objPtr);
	    }
	    else if ((objc - nidx) == 2)  /* Return a specific point */
	    {
	       result = Tcl_GetIntFromObj(interp, objv[2], &npoints);
	       if (result != TCL_OK) return result;
	       if (npoints >= ppoly->number) {
		  Tcl_SetResult(interp, "Point number out of range", NULL);
		  return TCL_ERROR;
	       }
	       objPtr = Tcl_NewListObj(0, NULL);
	       UTransformbyCTM(&hierCTM, points + npoints, &ppt, 1);
	       coord = Tcl_NewIntObj((int)ppt.x);
	       Tcl_ListObjAppendElement(interp, objPtr, coord);
	       coord = Tcl_NewIntObj((int)ppt.y);
	       Tcl_ListObjAppendElement(interp, objPtr, coord);
	       Tcl_SetObjResult(interp, objPtr);
	    }
	    else
	    {
		Tcl_SetResult(interp, "Individual point setting unimplemented\n", NULL);
		return TCL_ERROR;
	    }
	 }
	 break;
   }
   return XcTagCallback(interp, objc, objv);
}

/*----------------------------------------------------------------------*/

int xctcl_spline(ClientData clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *CONST objv[])
{
   int idx, idx2, nidx, result, value, j, npoints;
   splineptr newspline, pspline;
   XPoint ppt, ctrlpoints[4];
   Tcl_Obj *objPtr, *cpair, *coord, **newobjv;
   Matrix hierCTM;

   static char *subCmds[] = {"make", "border", "fill", "points", NULL};
   enum SubIdx {
	MakeIdx, BorderIdx, FillIdx, PointsIdx
   };

   nidx = 5;
   result = ParseElementArguments(interp, objc, objv, &nidx, SPLINE);
   if (result != TCL_OK) return result;

   if ((result = Tcl_GetIndexFromObj(interp, objv[nidx],
		(CONST84 char **)subCmds,
		"option", nidx - 1, &idx)) != TCL_OK)
      return result;

   /* h = spline make {x1 y1} ... {x4 y4} */

   switch (idx) {
      case MakeIdx:
	 if ((areastruct.selects == 0) && (nidx == 1)) {
	    if (objc != 6) {
	       Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
	       return TCL_ERROR;
	    }
	    for (j = 0; j < 4; j++) {
	       result = GetPositionFromList(interp, objv[2 + j], &ppt);
	       if (result == TCL_OK) {
	          ctrlpoints[j].x = ppt.x;
	          ctrlpoints[j].y = ppt.y;
	       }
	    }
	    newspline = new_spline(NULL, ctrlpoints);
	    objPtr = Tcl_NewHandleObj(newspline);
	    Tcl_SetObjResult(interp, objPtr);
	 }
	 else if (nidx == 2) {
	    Tcl_SetResult(interp, "\"spline <handle> make\" is illegal", NULL);
	    return TCL_ERROR;
	 }
	 else {
	    Tcl_SetResult(interp, "No selections allowed", NULL);
	    return TCL_ERROR;
	 }
	 break;

      case BorderIdx:
	 newobjv = (Tcl_Obj **)(&objv[nidx]);
	 result = xctcl_doborder(clientData, interp, objc - nidx, newobjv);
	 break;

      case FillIdx:
	 newobjv = (Tcl_Obj **)(&objv[nidx]);
	 result = xctcl_dofill(clientData, interp, objc - nidx, newobjv);
	 break;

      case PointsIdx:
	 if (areastruct.selects != 1) {
	    Tcl_SetResult(interp, "Must have exactly one selection to "
		"query or manipulate points", NULL);
	    return TCL_ERROR;
	 }
	 else {
	    /* check for ESPLINE mode? */
	    if (SELECTTYPE(areastruct.selectlist) != SPLINE) {
		Tcl_SetResult(interp, "Selected element is not a spline", NULL);
		return TCL_ERROR;
	    }
	    else
	       pspline = SELTOSPLINE(areastruct.selectlist);

	    MakeHierCTM(&hierCTM);

	    if ((objc - nidx) == 1)	/* Return a list of all points */
	    {
	       objPtr = Tcl_NewListObj(0, NULL);
	       for (npoints = 0; npoints < 4; npoints++) {
		  cpair = Tcl_NewListObj(0, NULL);
		  UTransformbyCTM(&hierCTM, pspline->ctrl + npoints, &ppt, 1);
	          coord = Tcl_NewIntObj((int)ppt.x);
	          Tcl_ListObjAppendElement(interp, cpair, coord);
	          coord = Tcl_NewIntObj((int)ppt.y);
	          Tcl_ListObjAppendElement(interp, cpair, coord);
	          Tcl_ListObjAppendElement(interp, objPtr, cpair);
	       }
	       Tcl_SetObjResult(interp, objPtr);
	    }
	    else if ((objc - nidx) == 2)  /* Return a specific point */
	    {
	       result = Tcl_GetIntFromObj(interp, objv[objc - nidx + 1], &npoints);
	       if (result != TCL_OK) return result;
	       if (npoints >= 4) {
		  Tcl_SetResult(interp, "Point number out of range", NULL);
		  return TCL_ERROR;
	       }
	       objPtr = Tcl_NewListObj(0, NULL);
	       UTransformbyCTM(&hierCTM, pspline->ctrl + npoints, &ppt, 1);
	       coord = Tcl_NewIntObj((int)ppt.x);
	       Tcl_ListObjAppendElement(interp, objPtr, coord);
	       coord = Tcl_NewIntObj((int)ppt.y);
	       Tcl_ListObjAppendElement(interp, objPtr, coord);
	       Tcl_SetObjResult(interp, objPtr);
	    }
	    else
	    {
		Tcl_SetResult(interp, "Individual control point setting "
				"unimplemented\n", NULL);
		return TCL_ERROR;
	    }
	 }
   }
   return XcTagCallback(interp, objc, objv);
}

/*----------------------------------------------------------------------*/

int xctcl_graphic(ClientData clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *CONST objv[])
{
   int i, idx, idx2, nidx, result;
   double dvalue;
   graphicptr newgp, gp;
   XPoint ppt;
   Tcl_Obj *objPtr, *listPtr, **newobjv;
   char *filename;

   static char *subCmds[] = {"make", "scale", "position", NULL};
   enum SubIdx {
	MakeIdx, ScaleIdx, PositionIdx
   };

   nidx = 7;
   result = ParseElementArguments(interp, objc, objv, &nidx, GRAPHIC);
   if (result != TCL_OK) return result;

   if ((result = Tcl_GetIndexFromObj(interp, objv[nidx],
		(CONST84 char **)subCmds,
		"option", nidx - 1, &idx)) != TCL_OK)
      return result;

   switch (idx) {
      case MakeIdx:
	 if ((areastruct.selects == 0) && (nidx == 1)) {
	    if (objc != 5) {
	       Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
	       return TCL_ERROR;
	    }

	    filename = Tcl_GetString(objv[2]);

	    result = GetPositionFromList(interp, objv[3], &ppt);
	    if (result != TCL_OK) return result;

	    result = Tcl_GetDoubleFromObj(interp, objv[4], &dvalue);
	    if (result != TCL_OK) return result;

	    newgp = new_graphic(NULL, filename, ppt.x, ppt.y);
	    if (newgp == NULL) return TCL_ERROR;

	    newgp->scale = (float)dvalue;
	    singlebbox((genericptr *)&newgp);

	    objPtr = Tcl_NewHandleObj(*newgp);
	    Tcl_SetObjResult(interp, objPtr);
	 }
	 else if (nidx == 2) {
	    Tcl_SetResult(interp, "\"graphic <handle> make\" is illegal", NULL);
	    return TCL_ERROR;
	 }
	 else {
	    Tcl_SetResult(interp, "No selections allowed", NULL);
	    return TCL_ERROR;
	 }
	 break;

      case ScaleIdx:
      case PositionIdx:
	 if ((areastruct.selects == 0) && (nidx == 1)) {
	    Tcl_SetResult(interp, "Must have a graphic selection.", NULL);
	    return TCL_ERROR;
	 }
	 if (objc == nidx + 1) {	/* Return position of graphic origin */
	    Tcl_Obj *cpair;
	    graphicptr gp;

	    listPtr = Tcl_NewListObj(0, NULL);
	    for (i = 0; i < areastruct.selects; i++) {
	       if (SELECTTYPE(areastruct.selectlist + i) != GRAPHIC) continue;
	       gp = SELTOGRAPHIC(areastruct.selectlist + i);

	       switch (idx) {
		  case ScaleIdx:
		     objPtr = Tcl_NewDoubleObj(gp->scale);
		     Tcl_ListObjAppendElement(interp, listPtr, objPtr);
		     break;
		  case PositionIdx:
		     cpair = Tcl_NewListObj(0, NULL);
		     objPtr = Tcl_NewIntObj((int)gp->position.x);
		     Tcl_ListObjAppendElement(interp, cpair, objPtr);
		     objPtr = Tcl_NewIntObj((int)gp->position.y);
		     Tcl_ListObjAppendElement(interp, cpair, objPtr);
		     Tcl_ListObjAppendElement(interp, listPtr, cpair);
		     break;
	       }
	    }
	    Tcl_SetObjResult(interp, listPtr);
	 }
	 else if (objc == nidx + 2) {	/* Change position or scale */
	    if (idx == ScaleIdx) {
	       result = Tcl_GetDoubleFromObj(interp, objv[nidx + 1], &dvalue);
	       if (result == TCL_OK) {
		  for (i = 0; i < areastruct.selects; i++) {
		     if (SELECTTYPE(areastruct.selectlist + i) != GRAPHIC) continue;
		     gp = SELTOGRAPHIC(areastruct.selectlist + i);
		     gp->scale = (float)dvalue;
		     gp->valid = False;
		     drawarea(areastruct.area, (caddr_t)clientData, (caddr_t)NULL);
		     calcbboxvalues(areastruct.topinstance,
				topobject->plist + *(areastruct.selectlist + i));
		  }
	       }
	    }
	    else {
	       result = GetPositionFromList(interp, objv[nidx + 1], &ppt);
	       if (result == TCL_OK) {
		  for (i = 0; i < areastruct.selects; i++) {
		     if (SELECTTYPE(areastruct.selectlist + i) != GRAPHIC) continue;
		     gp = SELTOGRAPHIC(areastruct.selectlist + i);
		     gp->position.x = ppt.x;
		     gp->position.y = ppt.y;
		     calcbboxvalues(areastruct.topinstance,
				topobject->plist + *(areastruct.selectlist + i));
		  }
	       }
	    }
	    updatepagebounds(topobject);
	    incr_changes(topobject);
 	 }
	 break;
   }
   return XcTagCallback(interp, objc, objv);
}

/*----------------------------------------------------------------------*/

int xctcl_arc(ClientData clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *CONST objv[])
{
   int idx, idx2, nidx, result, value;
   double angle;
   arcptr newarc, parg;
   XPoint ppt;
   Tcl_Obj *objPtr, *listPtr, **newobjv;

   static char *subCmds[] = {"make", "border", "fill", "radius", "minor",
	"angle", "position", NULL};
   enum SubIdx {
	MakeIdx, BorderIdx, FillIdx, RadiusIdx, MinorIdx, AngleIdx,
	PositionIdx
   };

   nidx = 7;
   result = ParseElementArguments(interp, objc, objv, &nidx, ARC);
   if (result != TCL_OK) return result;

   if ((result = Tcl_GetIndexFromObj(interp, objv[nidx],
		(CONST84 char **)subCmds,
		"option", nidx - 1, &idx)) != TCL_OK)
      return result;

   switch (idx) {
      case MakeIdx:
	 if ((areastruct.selects == 0) && (nidx == 1)) {
	    if ((objc < 4) || (objc > 7)) {
	       Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
	       return TCL_ERROR;
	    }
	    result = GetPositionFromList(interp, objv[2], &ppt);
	    if (result != TCL_OK) return result;

	    result = Tcl_GetIntFromObj(interp, objv[3], &value);
	    if (result != TCL_OK) return result;

	    newarc = new_arc(NULL, value, ppt.x, ppt.y);

	    switch (objc) {
	       case 6:
	          result = Tcl_GetDoubleFromObj(interp, objv[4], &angle);
		  if (result == TCL_OK) newarc->angle1 = (float)angle;
	          result = Tcl_GetDoubleFromObj(interp, objv[5], &angle);
		  if (result == TCL_OK) newarc->angle2 = (float)angle;
		  singlebbox((genericptr *)&newarc);
	 	  break;
	       case 7:
	          result = Tcl_GetDoubleFromObj(interp, objv[5], &angle);
		  if (result == TCL_OK) newarc->angle1 = (float)angle;
	          result = Tcl_GetDoubleFromObj(interp, objv[6], &angle);
		  if (result == TCL_OK) newarc->angle2 = (float)angle;
	       case 5:
	          result = Tcl_GetIntFromObj(interp, objv[4], &value);
		  if (result == TCL_OK) newarc->yaxis = value;
		  singlebbox((genericptr *)&newarc);
	 	  break;
	    }
	    objPtr = Tcl_NewHandleObj(*newarc);
	    Tcl_SetObjResult(interp, objPtr);
	 }
	 else if (nidx == 2) {
	    Tcl_SetResult(interp, "\"arc <handle> make\" is illegal", NULL);
	    return TCL_ERROR;
	 }
	 else {
	    Tcl_SetResult(interp, "No selections allowed", NULL);
	    return TCL_ERROR;
	 }
	 break;

      case BorderIdx:
	 newobjv = (Tcl_Obj **)(&objv[nidx]);
	 result = xctcl_doborder(clientData, interp, objc - nidx, newobjv);
	 break;

      case FillIdx:
	 newobjv = (Tcl_Obj **)(&objv[nidx]);
	 result = xctcl_dofill(clientData, interp, objc - nidx, newobjv);
	 break;

      case RadiusIdx:
      case MinorIdx:
      case AngleIdx:
      case PositionIdx:
	 if ((areastruct.selects == 0) && (nidx == 1)) {
	    Tcl_SetResult(interp, "Must have an arc selection.", NULL);
	    return TCL_ERROR;
	 }
	 if (objc == nidx + 1) {	/* Return position of arc center */
	    Tcl_Obj *cpair;
	    int i;
	    arcptr parc;

	    listPtr = Tcl_NewListObj(0, NULL);
	    for (i = 0; i < areastruct.selects; i++) {
	       if (SELECTTYPE(areastruct.selectlist + i) != ARC) continue;
	       parc = SELTOARC(areastruct.selectlist + i);

	       switch (idx) {
		  case RadiusIdx:
		     objPtr = Tcl_NewIntObj(parc->radius);
		     Tcl_ListObjAppendElement(interp, listPtr, objPtr);
		     break;
		  case MinorIdx:
		     objPtr = Tcl_NewIntObj(parc->yaxis);
		     Tcl_ListObjAppendElement(interp, listPtr, objPtr);
		     break;
		  case AngleIdx:
		     cpair = Tcl_NewListObj(0, NULL);
		     objPtr = Tcl_NewDoubleObj(parc->angle1);
		     Tcl_ListObjAppendElement(interp, cpair, objPtr);
		     objPtr = Tcl_NewDoubleObj(parc->angle2);
		     Tcl_ListObjAppendElement(interp, cpair, objPtr);
		     Tcl_ListObjAppendElement(interp, listPtr, cpair);
		     break;
		  case PositionIdx:
		     cpair = Tcl_NewListObj(0, NULL);
		     objPtr = Tcl_NewIntObj((int)parc->position.x);
		     Tcl_ListObjAppendElement(interp, cpair, objPtr);
		     objPtr = Tcl_NewIntObj((int)parc->position.y);
		     Tcl_ListObjAppendElement(interp, cpair, objPtr);
		     Tcl_ListObjAppendElement(interp, listPtr, cpair);
		     break;
	       }
	    }
	    Tcl_SetObjResult(interp, listPtr);
	 }
	 break;
   }
   return XcTagCallback(interp, objc, objv);
}

/*----------------------------------------------------------------------*/

int xctcl_path(ClientData clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *CONST objv[])
{
   int idx, idx2, nidx, result, value;
   genericptr newgen;
   Tcl_Obj *objPtr, **newobjv;

   static char *subCmds[] = {"join", "make", "border", "fill", "point", "unjoin", NULL};
   enum SubIdx {
	JoinIdx, MakeIdx, BorderIdx, FillIdx, PointIdx, UnJoinIdx
   };

   nidx = 5;
   result = ParseElementArguments(interp, objc, objv, &nidx, PATH);
   if (result != TCL_OK) return result;

   if ((result = Tcl_GetIndexFromObj(interp, objv[nidx],
		(CONST84 char **)subCmds,
		"option", nidx - 1, &idx)) != TCL_OK)
      return result;

   switch (idx) {
      case MakeIdx: case JoinIdx:
	 if ((areastruct.selects == 0) && (nidx == 1)) {
	    /* h = path make {element_list} */
	    newobjv = (Tcl_Obj **)(&objv[1]);
	    result = ParseElementArguments(interp, objc - 1, newobjv, NULL,
			POLYGON | ARC | SPLINE | PATH);
	    if (result != TCL_OK) return result;
	 }
	 else if (nidx == 2) {
	    Tcl_SetResult(interp, "\"path <handle> make\" is illegal", NULL);
	    return TCL_ERROR;
	 }
	 /* h = path make */
	 join();
	 newgen = *(topobject->plist + topobject->parts - 1);
	 objPtr = Tcl_NewHandleObj(newgen);
	 Tcl_SetObjResult(interp, objPtr);
	 break;

      case BorderIdx:
	 newobjv = (Tcl_Obj **)(&objv[nidx]);
	 result = xctcl_doborder(clientData, interp, objc - nidx, newobjv);
	 break;

      case FillIdx:
	 newobjv = (Tcl_Obj **)(&objv[nidx]);
	 result = xctcl_dofill(clientData, interp, objc - nidx, newobjv);
	 break;

      case PointIdx:
	 Tcl_SetResult(interp, "Unimpemented function.", NULL);
	 return TCL_ERROR;
	 break;

      case UnJoinIdx:
	 unjoin();
	 /* Would be nice to return the list of constituent elements. . . */
	 break;
   }
   return XcTagCallback(interp, objc, objv);
}

/*----------------------------------------------------------------------*/

int xctcl_instance(ClientData clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *CONST objv[])
{
   int idx, idx2, nidx, result, value;
   objectptr pobj;
   objinstptr pinst, newinst;
   short *newselect;
   XPoint newpos, ppt;
   Tcl_Obj *objPtr;
   Matrix hierCTM;

   static char *subCmds[] = {"make", "object", "scale", "center", "bbox", NULL};
   enum SubIdx {
	MakeIdx, ObjectIdx, ScaleIdx, CenterIdx, BBoxIdx
   };

   nidx = 3;
   result = ParseElementArguments(interp, objc, objv, &nidx, OBJINST);
   if (result != TCL_OK) return result;

   if ((result = Tcl_GetIndexFromObj(interp, objv[nidx],
		(CONST84 char **)subCmds,
		"option", nidx - 1, &idx)) != TCL_OK)
      return result;

   switch (idx) {
      case MakeIdx:
	 if ((areastruct.selects == 0) && (nidx == 1)) {
	    if (objc == 3) {
	       pobj = NameToObject(Tcl_GetString(objv[2]), &pinst, False);
	       if (pobj == NULL) {
		  Tcl_SetResult(interp, "no such object", NULL);
		  return TCL_ERROR;
	       }
	       newpos = UGetCursorPos();
	       u2u_snap(&newpos);
	       newinst = new_objinst(NULL, pinst, newpos.x, newpos.y);
	       newinst->color = areastruct.color;
	       newselect = allocselect();
	       *newselect = (short)(topobject->parts - 1);
	       draw_normal_selected(topobject, areastruct.topinstance);
	       eventmode = COPY_MODE;
	       Tk_CreateEventHandler(areastruct.area, PointerMotionMask,
			(Tk_EventProc *)xctk_drag, NULL);
	       return XcTagCallback(interp, objc, objv);
	    }
	    else if (objc != 4) {
	       Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
	       return TCL_ERROR;
	    }
	    pobj = NameToObject(Tcl_GetString(objv[2]), &pinst, False);
	    if (pobj == NULL) {
	       Tcl_SetResult(interp, "no such object", NULL);
	       return TCL_ERROR;
	    }
	    result = GetPositionFromList(interp, objv[3], &newpos);
	    if (result != TCL_OK) return result;

	    newinst = new_objinst(NULL, pinst, newpos.x, newpos.y);
	    newinst->color = areastruct.color;
	    objPtr = Tcl_NewHandleObj(newinst);
	    Tcl_SetObjResult(interp, objPtr);
	 }
	 else if (nidx == 2) {
	    Tcl_SetResult(interp, "\"instance <handle> make\" is illegal", NULL);
	    return TCL_ERROR;
	 }
	 else {
	    Tcl_SetResult(interp, "No selections allowed.", NULL);
	    return TCL_ERROR;
	 }
	 break;

      case ObjectIdx:
	 if ((objc - nidx) == 1) {
	    int i, numfound = 0;
	    Tcl_Obj *listPtr;
	    for (i = 0; i < areastruct.selects; i++) {
	       if (SELECTTYPE(areastruct.selectlist + i) == OBJINST) {
		  pinst = SELTOOBJINST(areastruct.selectlist + i);
		  objPtr = Tcl_NewStringObj(pinst->thisobject->name, -1);
		  if (numfound > 0)
		     Tcl_ListObjAppendElement(interp, listPtr, objPtr);
		  if ((++numfound) == 1)
		     listPtr = objPtr;
	       }
	    }
	    switch (numfound) {
	       case 0:
		  Tcl_SetResult(interp, "Error: no object instances selected", NULL);
		  return TCL_ERROR;
		  break;
	       case 1:
	          Tcl_SetObjResult(interp, objPtr);
		  break;
	       default:
	          Tcl_SetObjResult(interp, listPtr);
		  break;
	    }
	 }
	 break;

      case ScaleIdx:
	 if (objc == 2) {
	    int i, numfound = 0;
	    Tcl_Obj *listPtr;
	    for (i = 0; i < areastruct.selects; i++) {
	       if (SELECTTYPE(areastruct.selectlist + i) == OBJINST) {
		  pinst = SELTOOBJINST(areastruct.selectlist + i);
		  objPtr = Tcl_NewDoubleObj(pinst->scale);
		  if (numfound > 0)
		     Tcl_ListObjAppendElement(interp, listPtr, objPtr);
		  if ((++numfound) == 1)
		     listPtr = objPtr;
	       }
	    }
	    switch (numfound) {
	       case 0:
		  Tcl_SetResult(interp, "Error: no object instances selected", NULL);
		  return TCL_ERROR;
		  break;
	       case 1:
	          Tcl_SetObjResult(interp, objPtr);
		  break;
	       default:
	          Tcl_SetObjResult(interp, listPtr);
		  break;
	    }
	 }
	 else {
	    strcpy(_STR2, Tcl_GetString(objv[2]));
	    setosize((Tk_Window)clientData, NULL);
	 }
	 break;

      case CenterIdx:

	 if ((objc - nidx) == 1) {
	    int i, numfound = 0;
	    Tcl_Obj *listPtr, *coord;
	    for (i = 0; i < areastruct.selects; i++) {
	       if (SELECTTYPE(areastruct.selectlist + i) == OBJINST) {
		  pinst = SELTOOBJINST(areastruct.selectlist + i);
		  MakeHierCTM(&hierCTM);
		  objPtr = Tcl_NewListObj(0, NULL);
	          UTransformbyCTM(&hierCTM, &pinst->position, &ppt, 1);
		  coord = Tcl_NewIntObj((int)ppt.x);
		  Tcl_ListObjAppendElement(interp, objPtr, coord);
		  coord = Tcl_NewIntObj((int)ppt.y);
		  Tcl_ListObjAppendElement(interp, objPtr, coord);
		  if (numfound > 0)
		     Tcl_ListObjAppendElement(interp, listPtr, objPtr);
		  if ((++numfound) == 1)
		     listPtr = objPtr;
	       }
	    }
	    switch (numfound) {
	       case 0:
		  Tcl_SetResult(interp, "Error: no object instances selected", NULL);
		  return TCL_ERROR;
		  break;
	       case 1:
	          Tcl_SetObjResult(interp, objPtr);
		  break;
	       default:
	          Tcl_SetObjResult(interp, listPtr);
		  break;
	    }
	 }
	 break;

      case BBoxIdx:
	 if (objc == 2) {
	    int i, numfound = 0;
	    Tcl_Obj *listPtr, *coord;
	    for (i = 0; i < areastruct.selects; i++) {
	       if (SELECTTYPE(areastruct.selectlist + i) == OBJINST) {
		  pinst = SELTOOBJINST(areastruct.selectlist + i);
		  objPtr = Tcl_NewListObj(0, NULL);
		  coord = Tcl_NewIntObj((int)pinst->bbox.lowerleft.x);
		  Tcl_ListObjAppendElement(interp, objPtr, coord);
		  coord = Tcl_NewIntObj((int)pinst->bbox.lowerleft.y);
		  Tcl_ListObjAppendElement(interp, objPtr, coord);
		  coord = Tcl_NewIntObj((int)(pinst->bbox.lowerleft.x +
				pinst->bbox.width));
		  Tcl_ListObjAppendElement(interp, objPtr, coord);
		  coord = Tcl_NewIntObj((int)(pinst->bbox.lowerleft.y +
				pinst->bbox.height));
		  Tcl_ListObjAppendElement(interp, objPtr, coord);
		  if (numfound > 0)
		     Tcl_ListObjAppendElement(interp, listPtr, objPtr);
		  if ((++numfound) == 1)
		     listPtr = objPtr;
	       }
	    }
	    switch (numfound) {
	       case 0:
		  Tcl_SetResult(interp, "Error: no object instances selected", NULL);
		  return TCL_ERROR;
		  break;
	       case 1:
	          Tcl_SetObjResult(interp, objPtr);
		  break;
	       default:
	          Tcl_SetObjResult(interp, listPtr);
		  break;
	    }
	 }
	 break;
   }
   return XcTagCallback(interp, objc, objv);
}

/*----------------------------------------------------------------------*/
/* "element" configures properties of elements.  Note that if the 	*/
/* second argument is not an element handle (pointer), then operations	*/
/* will be applied to all selected elements.  If there is no element	*/
/* handle and no objects are selected, the operation will be applied	*/
/* to default settings, like the "xcircuit::set" command.		*/
/*----------------------------------------------------------------------*/

int xctcl_element(ClientData clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *CONST objv[])
{
   int result, nidx, idx, i, flags;
   Tcl_Obj *listPtr;
   Tcl_Obj **newobjv;
   int newobjc;
   genericptr egen;
   short *newselect;

   /* Commands */
   static char *subCmds[] = {
      "delete", "copy", "flip", "rotate", "edit", "select", "snap", "move",
	"color", "parameters", "raise", "lower", "exchange", "hide", "show",
	"handle", "deselect", NULL
   };
   enum SubIdx {
      DeleteIdx, CopyIdx, FlipIdx, RotateIdx, EditIdx, 	SelectIdx, SnapIdx,
	MoveIdx, ColorIdx, ParamIdx, RaiseIdx, LowerIdx, ExchangeIdx,
	HideIdx, ShowIdx, HandleIdx, DeselectIdx
   };

   static char *etypes[] = {
	"Label", "Polygon", "Bezier Curve", "Object Instance", "Path",
	"Arc", "Graphic"
   };

   /* Before doing a standard parse, we need to check for the single case */
   /* "element X deselect"; otherwise, calling ParseElementArguements()  */
   /* is going to destroy the selection list.				  */

   if ((objc == 3) && (!strcmp(Tcl_GetString(objv[2]), "deselect"))) {
      result = xctcl_deselect(clientData, interp, objc, objv);
      return result;
   }

   /* All other commands are dispatched to individual element commands	*/
   /* for the indicated element or for each selected element.		*/

   nidx = 7;
   result = ParseElementArguments(interp, objc, objv, &nidx, ALL_TYPES);
   if (result != TCL_OK) return result;

   if ((objc - nidx) < 1) {
      Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
      return TCL_ERROR;
   }

   if (!strcmp(Tcl_GetString(objv[nidx]), "type")) {
      /* Return a list of types of the selected elements */

      if (areastruct.selects > 1)
	 listPtr = Tcl_NewListObj(0, NULL);

      for (i = 0; i < areastruct.selects; i++) {
	 Tcl_Obj *objPtr;
	 int idx2, type = SELECTTYPE(areastruct.selectlist + i);
	 switch (type) {
	    case LABEL: idx2 = 0; break;
	    case POLYGON: idx2 = 1; break;
	    case SPLINE: idx2 = 2; break;
	    case OBJINST: idx2 = 3; break;
	    case PATH: idx2 = 4; break;
	    case ARC: idx2 = 5; break;
	    case GRAPHIC: idx2 = 6; break;
	    default: return TCL_ERROR;
	 }
	 objPtr = Tcl_NewStringObj(etypes[idx2], strlen(etypes[idx2]));
	 if (areastruct.selects == 1) {
	    Tcl_SetObjResult(interp, objPtr);
	    return TCL_OK;
	 }
	 else {
	    Tcl_ListObjAppendElement(interp, listPtr, objPtr);
	 }
	 Tcl_SetObjResult(interp, listPtr);
      }
      return XcTagCallback(interp, objc, objv);
   }
   else if (!strcmp(Tcl_GetString(objv[nidx]), "handle")) {
      /* Return a list of handles of the selected elements */

      if (areastruct.selects > 1)
	 listPtr = Tcl_NewListObj(0, NULL);

      for (i = 0; i < areastruct.selects; i++) {
	 Tcl_Obj *objPtr;
	 objPtr = Tcl_NewHandleObj(SELTOGENERIC(areastruct.selectlist + i));
	 if (areastruct.selects == 1) {
	    Tcl_SetObjResult(interp, objPtr);
	    return TCL_OK;
	 }
	 else {
	    Tcl_ListObjAppendElement(interp, listPtr, objPtr);
	 }
	 Tcl_SetObjResult(interp, listPtr);
      }
      return XcTagCallback(interp, objc, objv);
   }
   
   if (Tcl_GetIndexFromObj(interp, objv[nidx],
		(CONST84 char **)subCmds,
		"option", 0, &idx) == TCL_OK) {

      newobjv = (Tcl_Obj **)(&objv[nidx]);
      newobjc = objc - nidx;

      /* Shift the argument list and call the indicated function. */

      switch(idx) {
	 case DeleteIdx:
	    result = xctcl_delete(clientData, interp, newobjc, newobjv);
	    break;
	 case CopyIdx:
	    result = xctcl_copy(clientData, interp, newobjc, newobjv);
	    break;
	 case FlipIdx:
	    result = xctcl_flip(clientData, interp, newobjc, newobjv);
	    break;
	 case RotateIdx:
	    result = xctcl_rotate(clientData, interp, newobjc, newobjv);
	    break;
	 case EditIdx:
	    result = xctcl_edit(clientData, interp, newobjc, newobjv);
	    break;
	 case ParamIdx:
	    result = xctcl_param(clientData, interp, newobjc, newobjv);
	    break;
	 case HideIdx:
	    for (i = 0; i < areastruct.selects; i++) {
	       newselect = areastruct.selectlist + i;
	       egen = SELTOGENERIC(newselect);
	       egen->type |= DRAW_HIDE;
	    }
	    refresh(NULL, NULL, NULL);
	    break;
	 case ShowIdx:
	    if (newobjc == 2) {
	       if (!strcmp(Tcl_GetString(newobjv[1]), "all")) {
		  for (i = 0; i < topobject->parts; i++) {
		     egen = *(topobject->plist + i);
		     egen->type &= (~DRAW_HIDE);
		  }
	       }
	    }
	    else {
	       for (i = 0; i < areastruct.selects; i++) {
		  newselect = areastruct.selectlist + i;
		  egen = SELTOGENERIC(newselect);
		  egen->type &= (~DRAW_HIDE);
	       }
	    }
	    refresh(NULL, NULL, NULL);
	    break;
	 case SelectIdx:
	    if (newobjc == 2) {
	       if (!strncmp(Tcl_GetString(newobjv[1]), "hide", 4)) {
		  for (i = 0; i < areastruct.selects; i++) {
		     newselect = areastruct.selectlist + i;
		     egen = SELTOGENERIC(newselect);
		     egen->type |= SELECT_HIDE;
		  }
	       }
	       else if (!strncmp(Tcl_GetString(newobjv[1]), "allow", 5)) {
		  for (i = 0; i < topobject->parts; i++) {
		     egen = *(topobject->plist + i);
		     egen->type &= (~SELECT_HIDE);
		  }
	       }
	       else {
		  Tcl_SetResult(interp, "Select options are \"hide\" "
				"and \"allow\"", NULL);
		  return TCL_ERROR;
	       }
	    }
	    /* If nidx == 2, then we've already done the selection! */
	    else if (nidx == 1)
	       result = xctcl_select(clientData, interp, newobjc, newobjv);
	    else
	       result = TCL_OK;
	    break;
	 case DeselectIdx:
	    /* case nidx == 2 was already taken care of. case nidx == 1 */
	    /* implies "deselect all".					*/
	    unselect_all();
	    result = TCL_OK;
	    break;
	 case ColorIdx:
	    result = xctcl_color(clientData, interp, newobjc, newobjv);
	    break;
	 case SnapIdx:
	    snapelement();
	    break;
	 case ExchangeIdx:
	    exchange();
	    break;
	 case LowerIdx:
	    for (i = 0; i < areastruct.selects; i++)
	       xc_lower(areastruct.selectlist + i);
	    break;
	 case RaiseIdx:
	    for (i = 0; i < areastruct.selects; i++)
	       xc_raise(areastruct.selectlist + i);
	    break;
	 case MoveIdx:
	    result = xctcl_move(clientData, interp, newobjc, newobjv);
	    break;
      }
      return result;
   }

   /* Call each individual element function.				*/
   /* Each function is responsible for filtering the select list to	*/
   /* choose only the appropriate elements.  However, we first check	*/
   /* if at least one of that type exists in the list, so the function	*/
   /* won't return an error.						*/

   Tcl_ResetResult(interp);

   newobjv = (Tcl_Obj **)(&objv[nidx - 1]);
   newobjc = objc - nidx + 1;

   flags = 0;
   for (i = 0; i < areastruct.selects; i++)
      flags |= SELECTTYPE(areastruct.selectlist + i);

   if (flags & LABEL) {
      result = xctcl_label(clientData, interp, newobjc, newobjv);
      if (result != TCL_OK) return result;
   }
   if (flags & POLYGON) {
      result = xctcl_polygon(clientData, interp, newobjc, newobjv);
      if (result != TCL_OK) return result;
   }
   if (flags & OBJINST) {
      result = xctcl_instance(clientData, interp, newobjc, newobjv);
      if (result != TCL_OK) return result;
   }
   if (flags & SPLINE) {
      result = xctcl_spline(clientData, interp, newobjc, newobjv);
      if (result != TCL_OK) return result;
   }
   if (flags & PATH) {
      result = xctcl_path(clientData, interp, newobjc, newobjv);
      if (result != TCL_OK) return result;
   }
   if (flags & ARC) {
      result = xctcl_arc(clientData, interp, newobjc, newobjv);
   }
   if (flags & GRAPHIC) {
      result = xctcl_graphic(clientData, interp, newobjc, newobjv);
   }
   return result;
}

/*----------------------------------------------------------------------*/
/* "config" manipulates a whole bunch of option settings		*/
/*----------------------------------------------------------------------*/

int xctcl_config(ClientData clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *CONST objv[])
{
   double tmpdbl;
   int tmpint, i;
   int result, idx, idx2;
   char *fontname, *tmpstr, buffer[30];
   Pagedata *curpage;

   static char *boxsubCmds[] = {"manhattan", "rhomboidx", "rhomboidy",
	"rhomboida", "normal", NULL};
   static char *coordsubCmds[] = {"decimal inches", "fractional inches",
	"centimeters", "internal units", NULL};
   static char *filterTypes[] = {"instances", "labels", "polygons", "arcs",
	"splines", "paths", NULL};
   static char *filterVar[] = {"sel_obj", "sel_lab", "sel_poly", "sel_arc",
	"sel_spline", "sel_path", NULL};

   static char *subCmds[] = {
      "axis", "axes", "grid", "snap", "bbox", "editinplace",
	"pinpositions", "boxedit", "linewidth", "colorscheme",
	"coordstyle", "drawingscale", "manhattan", "centering",
	"filter", "buschar", "backup", NULL
   };
   enum SubIdx {
      AxisIdx, AxesIdx, GridIdx, SnapIdx, BBoxIdx, EditInPlaceIdx,
	PinPosIdx, BoxEditIdx, LineWidthIdx, ColorSchemeIdx,
	CoordStyleIdx, ScaleIdx, ManhattanIdx, CenteringIdx,
	FilterIdx, BusCharIdx, BackupIdx
   };

   if ((objc == 1) || (objc > 5)) {
      Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
      return TCL_ERROR;
   }
   if (Tcl_GetIndexFromObj(interp, objv[1],
		(CONST84 char **)subCmds,
		"option", 0, &idx) != TCL_OK) {
      return TCL_ERROR;
   }

   curpage = xobjs.pagelist[areastruct.page];

   /* Check number of arguments wholesale (to be done) */

   switch(idx) {
      case AxisIdx: case AxesIdx:
	 if (objc == 2) {
	    Tcl_SetResult(interp, (areastruct.axeson) ? "true" : "false", NULL);
	    break;
	 }
	 else {
	    result = Tcl_GetBooleanFromObj(interp, objv[2], &tmpint);
	    if (result != TCL_OK) return result;
	    areastruct.axeson = (Boolean) tmpint;
	 }
	 Tcl_SetVar2(interp, "XCOps", "showaxes", (areastruct.axeson) ? "true" : "false",
		TCL_NAMESPACE_ONLY);
	 break;

      case GridIdx:
	 if (objc == 2) {
	    Tcl_SetResult(interp, (areastruct.gridon) ? "true" : "false", NULL);
	    break;
	 }
	 else {
	    if (!strncmp("spac", Tcl_GetString(objv[2]), 4)) {
	       if (objc == 3) {
		  measurestr((float)curpage->gridspace, buffer);
		  Tcl_SetObjResult(interp, Tcl_NewStringObj(buffer, strlen(buffer)));
		  break;
	       }
	       else {
	          strcpy(_STR2, Tcl_GetString(objv[3]));
	          setgrid(NULL, &(curpage->gridspace));
	       }
	    }
	    else {
	       result = Tcl_GetBooleanFromObj(interp, objv[2], &tmpint);
	       if (result != TCL_OK) return result;
	       areastruct.gridon = (Boolean) tmpint;
	    }
	 }
	 Tcl_SetVar2(interp, "XCOps", "showgrid", (areastruct.gridon) ?
		"true" : "false", TCL_NAMESPACE_ONLY);
	 break;

      case SnapIdx:
	 if (objc == 2) {
	    Tcl_SetResult(interp, (areastruct.snapto) ? "true" : "false", NULL);
	 }
	 else {
	    if (!strncmp("spac", Tcl_GetString(objv[2]), 4)) {
	       if (objc == 3) {
		  measurestr((float)curpage->snapspace, buffer);
		  Tcl_SetObjResult(interp, Tcl_NewStringObj(buffer, strlen(buffer)));
		  break;
	       }
	       else {
	          strcpy(_STR2, Tcl_GetString(objv[3]));
	          setgrid(NULL, &(curpage->snapspace));
	       }
	    }
	    else {
	       result = Tcl_GetBooleanFromObj(interp, objv[2], &tmpint);
	       if (result != TCL_OK) return result;
	       areastruct.snapto = (Boolean) tmpint;
	    }
	 }
	 Tcl_SetVar2(interp, "XCOps", "showsnap", (areastruct.snapto) ?
		"true" : "false", TCL_NAMESPACE_ONLY);
	 break;

      case BoxEditIdx:
	 if (objc == 2) {
	    switch (areastruct.boxedit) {
	       case MANHATTAN: idx = 0; break;
	       case RHOMBOIDX: idx = 1; break;
	       case RHOMBOIDY: idx = 2; break;
	       case RHOMBOIDA: idx = 3; break;
	       case NORMAL: idx = 4; break;
	    }
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(boxsubCmds[idx],
		strlen(boxsubCmds[idx])));
	 }
	 else if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "boxedit ?arg ...?");
	    return TCL_ERROR;
	 }
	 else {
	    if (Tcl_GetIndexFromObj(interp, objv[2],
			(CONST84 char **)boxsubCmds,
			"option", 0, &idx) != TCL_OK) {
	       return TCL_ERROR;
	    }
	    switch (idx) {
	       case 0: tmpint = MANHATTAN; break;
	       case 1: tmpint = RHOMBOIDX; break;
	       case 2: tmpint = RHOMBOIDY; break;
	       case 3: tmpint = RHOMBOIDA; break;
	       case 4: tmpint = NORMAL; break;
	    }
	    boxedit(NULL, tmpint, NULL);
	 }
	 Tcl_SetVar2(interp, "XCOps", "polyedittype", boxsubCmds[idx], TCL_NAMESPACE_ONLY);
	 break;

      case LineWidthIdx:
	 if (objc == 2) {
	    Tcl_SetObjResult(interp,
		Tcl_NewDoubleObj((double)curpage->wirewidth / 2.0));
	 }
	 else if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 3, objv, "linewidth");
	    return TCL_ERROR;
	 }
	 else {
	    strcpy(_STR2, Tcl_GetString(objv[2]));
	    setwidth(NULL, &(curpage->wirewidth));
	 }
	 break;

      case BBoxIdx:
	 if (objc == 2) {
	    Tcl_SetResult(interp, (areastruct.bboxon) ? "true" : "false", NULL);
	 }
	 else {
	    tmpstr = Tcl_GetString(objv[2]);
	    if (strstr(tmpstr, "visible"))
	       tmpint = (tmpstr[0] == 'i') ? False : True;
	    else {
	       result = Tcl_GetBooleanFromObj(interp, objv[2], &tmpint);
	       if (result != TCL_OK) return result;
	    }
	    areastruct.bboxon = (Boolean) tmpint;
	 }
	 Tcl_SetVar2(interp, "XCOps", "showbbox", (areastruct.bboxon) ?
		"visible" : "invisible", TCL_NAMESPACE_ONLY);
	 break;

      case EditInPlaceIdx:
	 if (objc == 2) {
	    Tcl_SetResult(interp, (areastruct.editinplace) ? "true" : "false", NULL);
	 }
	 else {
	    result = Tcl_GetBooleanFromObj(interp, objv[2], &tmpint);
	    if (result != TCL_OK) return result;
	    areastruct.editinplace = (Boolean) tmpint;
	 }
	 Tcl_SetVar2(interp, "XCOps", "editinplace", (areastruct.editinplace) ?
		"true" : "false", TCL_NAMESPACE_ONLY);
	 break;

      case PinPosIdx:
	 if (objc == 2) {
	    Tcl_SetResult(interp, (areastruct.pinpointon) ? "true" : "false", NULL);
	 }
	 else {
	    tmpstr = Tcl_GetString(objv[2]);
	    if (strstr(tmpstr, "visible"))
	       tmpint = (tmpstr[0] == 'i') ? False : True;
	    else {
	       result = Tcl_GetBooleanFromObj(interp, objv[2], &tmpint);
	       if (result != TCL_OK) return result;
	    }
	    areastruct.pinpointon = (Boolean) tmpint;
	 }
	 Tcl_SetVar2(interp, "XCOps", "pinpositions", (areastruct.pinpointon) ?
		"visible" : "invisible", TCL_NAMESPACE_ONLY);
	 break;

      case ColorSchemeIdx:
	 if (objc == 2) {
	    Tcl_SetResult(interp, (areastruct.invert) ? "inverse" : "normal", NULL);
	 }
	 else {
	    tmpstr = Tcl_GetString(objv[2]);
	    if (!strcmp(tmpstr, "normal") || !strcmp(tmpstr, "standard"))
	       tmpint = False;
	    else if (!strcmp(tmpstr, "inverse") || !strcmp(tmpstr, "alternate"))
	       tmpint = True;
	    else {
	       result = Tcl_GetBooleanFromObj(interp, objv[2], &tmpint);
	       if (result != TCL_OK) return result;
	    }
	    areastruct.invert = (Boolean) tmpint;
	    setcolorscheme(!areastruct.invert);
	 }
	 Tcl_SetVar2(interp, "XCOps", "colorscheme", (areastruct.invert) ?
		"alternate" : "normal", TCL_NAMESPACE_ONLY);
	 break;

      case CoordStyleIdx:
	 if (objc == 2) {
	    switch (curpage->coordstyle) {
	       case DEC_INCH: idx = 0; break;
	       case FRAC_INCH: idx = 1; break;
	       case CM: idx = 2; break;
	       case INTERNAL: idx = 3; break;
	    }
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(coordsubCmds[idx],
		strlen(coordsubCmds[idx])));
	 }
	 else if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "coordstyle ?arg ...?");
	    return TCL_ERROR;
	 }
	 else {
	    if (Tcl_GetIndexFromObj(interp, objv[2],
			(CONST84 char **)coordsubCmds,
			"option", 0, &idx) != TCL_OK) {
	       return TCL_ERROR;
	    }
	    switch (idx) {
	       case 0: tmpint = DEC_INCH; break;
	       case 1: tmpint = FRAC_INCH; break;
	       case 2: tmpint = CM; break;
	       case 3: tmpint = INTERNAL; break;
	    }
	    getgridtype(NULL, tmpint, NULL);
	 }
	 Tcl_SetVar2(interp, "XCOps", "gridstyle", coordsubCmds[idx], TCL_NAMESPACE_ONLY);
	 break;

      case ScaleIdx:
	 if (objc == 2) {
	    Tcl_Obj *objPtr = Tcl_NewListObj(0, NULL);
	    Tcl_ListObjAppendElement(xcinterp, objPtr,
	 	Tcl_NewIntObj((int)curpage->drawingscale.x));
	    Tcl_ListObjAppendElement(xcinterp, objPtr,
	 	Tcl_NewStringObj(":", 1));
	    Tcl_ListObjAppendElement(xcinterp, objPtr,
	 	Tcl_NewIntObj((int)curpage->drawingscale.y));
	    Tcl_SetObjResult(interp, objPtr);
	 }
	 else if (objc == 3) {
	    strcpy(_STR2, Tcl_GetString(objv[2]));
	    setdscale(NULL, &(curpage->drawingscale));
	 }
	 else {
	    Tcl_WrongNumArgs(interp, 2, objv, "drawingscale ?arg ...?");
	    return TCL_ERROR;
	 }
	 break;

      case ManhattanIdx:
	 if (objc == 2) {
	    Tcl_SetResult(interp, (areastruct.manhatn) ? "true" : "false", NULL);
	 }
	 else {
	    result = Tcl_GetBooleanFromObj(interp, objv[2], &tmpint);
	    if (result != TCL_OK) return result;
	    areastruct.manhatn = (Boolean) tmpint;
	 }
	 Tcl_SetVar2(interp, "XCOps", "manhattandraw", (areastruct.manhatn) ?
		"true" : "false", TCL_NAMESPACE_ONLY);
	 break;

      case CenteringIdx:
	 if (objc == 2) {
	    Tcl_SetResult(interp, (areastruct.center) ? "true" : "false", NULL);
	 }
	 else {
	    result = Tcl_GetBooleanFromObj(interp, objv[2], &tmpint);
	    if (result != TCL_OK) return result;
	    areastruct.center = (Boolean) tmpint;
	 }
	 Tcl_SetVar2(interp, "XCOps", "centerobject", (areastruct.center) ?
		"true" : "false", TCL_NAMESPACE_ONLY);
	 break;

      case FilterIdx:
	 if (objc == 2) {
	    for (i = 0; i < 6; i++) {
	       tmpint = 1 << i;
	       if (areastruct.filter & tmpint) {
		  Tcl_AppendElement(interp, filterTypes[i]);
	       }
	    }
	 }
	 else if (objc >= 3) {
	    if (Tcl_GetIndexFromObj(interp, objv[2],
			(CONST84 char **)filterTypes,
			"filter_type", 0, &tmpint) != TCL_OK) {
	       return TCL_ERROR;
	    }
	    if (objc == 3) {
	       if (areastruct.filter & (1 << tmpint))
		  Tcl_SetResult(interp, "true", NULL);
	       else
		  Tcl_SetResult(interp, "false", NULL);
	    }
	    else {
	       int ftype = 1 << tmpint;
	       if (!strcmp(Tcl_GetString(objv[3]), "true"))
	          areastruct.filter |= ftype;
	       else
	          areastruct.filter &= (~ftype);

	       Tcl_SetVar2(interp, "XCOps", filterVar[tmpint], Tcl_GetString(objv[3]),
			TCL_NAMESPACE_ONLY);
	    }
	 }
	 break;

      case BusCharIdx:
	 if (objc == 2) {
	    buffer[0] = '\\';
	    buffer[1] = areastruct.buschar;
	    buffer[2] = '\0';
	    Tcl_SetResult(interp, buffer, TCL_VOLATILE);
	 }
	 else if (objc == 3) {
	    tmpstr = Tcl_GetString(objv[2]);
	    areastruct.buschar = (tmpstr[0] == '\\') ? tmpstr[1] : tmpstr[0];
	 }
	 break;

       case BackupIdx:
	 if (objc == 2) {
	    Tcl_SetResult(interp, (xobjs.retain_backup) ? "true" : "false", NULL);
	 }
	 else {
	    result = Tcl_GetBooleanFromObj(interp, objv[2], &tmpint);
	    if (result != TCL_OK) return result;
	    xobjs.retain_backup = (Boolean) tmpint;
	 }
	 break;
   }
   return XcTagCallback(interp, objc, objv);
}

/*----------------------------------------------------------------------*/

int xctcl_promptsavepage(ClientData clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *CONST objv[])
{
   int page = areastruct.page;
   int result, num_linked;
   Pagedata *curpage;
   objectptr pageobj;
   char scxstr[12], scystr[12], scsstr[12];
   struct stat statbuf;
   char *cstr;

   /* save page popup */

   if (objc > 2) {
      Tcl_WrongNumArgs(interp, 1, objv, "[page_number]");
      return TCL_ERROR;
   }
   else if (objc == 2) {
      result = Tcl_GetIntFromObj(interp, objv[1], &page);
      if (result != TCL_OK) return result;
   }
   else page = areastruct.page; 

   curpage = xobjs.pagelist[page];
   if (curpage->pageinst == NULL) {
      Tcl_SetResult(interp, "Page does not exist. . . cannot save.", NULL);
      return TCL_ERROR;
   }
   pageobj = curpage->pageinst->thisobject;

   /* recompute bounding box and auto-scale, if set */

   calcbbox(xobjs.pagelist[page]->pageinst);
   if (curpage->pmode & 2) autoscale(page);

   /* get file information */

   if (strstr(curpage->filename, ".") == NULL)
      sprintf(_STR2, "%s.ps", curpage->filename);
   else sprintf(_STR2, "%s", curpage->filename);
   if (stat(_STR2, &statbuf) == 0) {
      Wprintf("  Warning:  File exists");
   }
   else {
      if (errno == ENOTDIR)
         Wprintf("Error:  Incorrect pathname");
      else if (errno == EACCES)
         Wprintf("Error:  Path not readable");
      else
         Wprintf("  ");
   }
   Tcl_SetObjResult(interp, Tcl_NewIntObj((int)page));

   return XcTagCallback(interp, objc, objv);
}

/*----------------------------------------------------------------------*/

int xctcl_promptsavelib(ClientData clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *CONST objv[])
{
   int result;
   int libno = 0;

   /* save library */
   if (objc > 2) {
      Tcl_WrongNumArgs(interp, 1, objv, "[library_number]");
      return TCL_ERROR;
   }
   else if (objc == 2) {
      result = Tcl_GetIntFromObj(interp, objv[1], &libno);
      if (result != TCL_OK) return result;
   }
   savelibpopup((Tk_Window)clientData, (u_int)libno, NULL);

   return XcTagCallback(interp, objc, objv);
}

/*----------------------------------------------------------------------*/

int xctcl_quit(ClientData clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *CONST objv[])
{
   /* quit, without checks */
   if (objc != 1) {
      Tcl_WrongNumArgs(interp, 1, objv, "(no arguments)");
      return TCL_ERROR;
   }
   quit(areastruct.area, NULL);
   return XcTagCallback(interp, objc, objv);
}

/*----------------------------------------------------------------------*/

int xctcl_promptquit(ClientData clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *CONST objv[])
{
   /* quit, with checks */
   if (objc != 1) {
      Tcl_WrongNumArgs(interp, 1, objv, "(no arguments)");
      return TCL_ERROR;
   }
   quitcheck(NULL, NULL, NULL);
   return XcTagCallback(interp, objc, objv);
}

/*----------------------------------------------------------------------*/

int xctcl_refresh(ClientData clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *CONST objv[])
{
   /* refresh */
   if (objc != 1) {
      Tcl_WrongNumArgs(interp, 1, objv, "(no arguments)");
      return TCL_ERROR;
   }
   drawarea(areastruct.area, (caddr_t)clientData, (caddr_t)NULL);
   return XcTagCallback(interp, objc, objv);
}

/*----------------------------------------------------------------------*/

int xctcl_page(ClientData clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *CONST objv[])
{
   int result, idx, nidx, aval, i, j = 0;
   int cpage, multi, savepage, pageno = -1, linktype, importtype;
   char *tmpstr, *filename;
   Tcl_Obj *objPtr;
   double newheight, newwidth, newscale;
   float oldscale;
   int newrot, newmode;
   objectptr pageobj;
   char *oldstr, *newstr, *cstr;
   Pagedata *curpage, *lpage;
   short *pagelist;
   int ilib;
   short save_replace;

   char *subCmds[] = {
	"load", "import", "save", "saveonly", "make", "directory",
	"reset", "links", "fit", "filename", "label", "scale", "width",
	"height", "size", "goto", "orientation", "encapsulation",
        "handle", NULL
   };
   enum SubIdx {
	LoadIdx, ImportIdx, SaveIdx, SaveOnlyIdx, MakeIdx, DirIdx,
	ResetIdx, LinksIdx, FitIdx, FileIdx, LabelIdx, ScaleIdx,
	WidthIdx, HeightIdx, SizeIdx, GoToIdx, OrientIdx, EPSIdx,
	HandleIdx
   };

   char *importTypes[] = {"xcircuit", "postscript", "background", NULL};
   enum ImportTypes {
	XCircuitIdx, PostScriptIdx, BackGroundIdx
   };

   char *linkTypes[] = {"independent", "dependent", "total", "pagedependent",
		"all", NULL};
   char *psTypes[] = {"eps", "full", NULL};

   savepage = areastruct.page;

   result = ParsePageArguments(interp, objc, objv, &nidx, &pageno);
   if ((result != TCL_OK) || (nidx < 0)) return result;
   else if (nidx == 1 && objc == 2) {
      idx = GoToIdx;
   }
   else if (Tcl_GetIndexFromObj(interp, objv[1 + nidx],
		(CONST84 char **)subCmds, "option", 0, &idx) != TCL_OK) {
      return result;
   }

   curpage = xobjs.pagelist[pageno];

   if (curpage->pageinst != NULL)
      pageobj = curpage->pageinst->thisobject;
   else {
      if (idx != LoadIdx && idx != MakeIdx && idx != DirIdx && idx != GoToIdx) {
	 Tcl_SetResult(interp, "Cannot do function on non-initialized page.", NULL);
	 return TCL_ERROR;
      }
   } 

   switch (idx) {
      case HandleIdx:
	 /* return handle of page instance */
	 objPtr = Tcl_NewHandleObj(curpage->pageinst);
	 Tcl_SetObjResult(interp, objPtr);
	 break;
	 
      case ResetIdx:
	 /* clear page */
	 resetbutton(NULL, (pointertype)(pageno + 1), NULL);
	 break;

      case LoadIdx:
	 save_replace = xobjs.do_replace;
	 xobjs.do_replace = -1;
	 sprintf(_STR2, Tcl_GetString(objv[2 + nidx]));
	 for (i = 3 + nidx; i < objc; i++) {
	    char *argv = Tcl_GetString(objv[i]);
	    if ((*argv == '-') && !strncmp(argv, "-repl", 5)) {
	       if (i < objc - 1) {
		  char *libstr = Tcl_GetString(objv[i + 1]);
		  if (!strcmp(libstr, "all")) xobjs.do_replace = -2;
		  else if (!strcmp(libstr, "none")) xobjs.do_replace = -1;
		  else {
		     ParseLibArguments(xcinterp, 2, &objv[i],
				NULL, &j);
		     xobjs.do_replace = j;
		  }
		  i++;
	       }
	       else
	          xobjs.do_replace = -2;	/* replace ALL */
	    }
	    else {
	       strcat(_STR2, ",");
	       strcat(_STR2, argv);
	    }
	 }
	 
	 if (savepage != pageno) newpage(pageno);
	 startloadfile();
	 if (savepage != pageno) newpage(savepage);
	 xobjs.do_replace = save_replace;
	 break;

      case ImportIdx:
	 if ((objc - nidx) < 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "option");
	    return TCL_ERROR;
	 }

	 if (Tcl_GetIndexFromObj(interp, objv[2 + nidx],
			(CONST84 char **)importTypes, "file type",
			0, &importtype) != TCL_OK)
	    return TCL_ERROR;

	 /* First check the number of arguments, which varies by option. */

	 switch (importtype) {

	    /* Xcircuit imports may specify any number of files > 1.	*/

	    case XCircuitIdx:
	       if ((objc - nidx) == 3) {
		  Tcl_SetResult(interp, "Must specify a filename to import!", NULL);
		  return TCL_ERROR;
	       }
	       break;

	    /* Postscript imports may specify 1 or 0 files.  0 causes	*/
	    /* the function to report back what file is the background.	*/

	    case PostScriptIdx:
	    case BackGroundIdx:
	       if ((objc - nidx) != 3 && (objc - nidx) != 4) {
		  Tcl_SetResult(interp, "Can only specify one filename "
			"for background", NULL);
		  return TCL_ERROR;
	       }

	    /* All other import types must specify exactly one filename. */

	    default:
	       if ((objc - nidx) != 4) {
		  Tcl_SetResult(interp, "Must specify one filename "
			"for import", NULL);
		  return TCL_ERROR;
	       }
	       break;
	 }

	 /* Now process the option */

	 switch (importtype) {
	    case XCircuitIdx:
	       sprintf(_STR2, Tcl_GetString(objv[3 + nidx]));
	       for (i = 4; i < objc; i++) {
		  strcat(_STR2, ",");
		  strcat(_STR2, Tcl_GetString(objv[i + nidx]));
	       }
	       if (savepage != pageno) newpage(pageno);
	       importfile();
	       if (savepage != pageno) newpage(savepage);
	       break;
	    case PostScriptIdx:		/* replaces "background" */
	    case BackGroundIdx:
	       if (objc - nidx == 2) {
		  objPtr = Tcl_NewStringObj(curpage->background.name,
			strlen(curpage->background.name));
		  Tcl_SetObjResult(interp, objPtr);
		  return XcTagCallback(interp, objc, objv);
	       }
	       sprintf(_STR2, Tcl_GetString(objv[3 + nidx]));
	       if (savepage != pageno) newpage(pageno);
	       loadbackground();
	       if (savepage != pageno) newpage(savepage);
	       break;
	 }

	 /* Redraw */
	 drawarea(areastruct.area, NULL, NULL);
	 break;

      case MakeIdx:
	 if (nidx == 1) {
	    Tcl_SetResult(interp, "syntax is: \"page make [<name>]\"", NULL);
	    return TCL_ERROR;
	 }
	 if (objc != 2 && objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "make [<name>]");
	    return TCL_ERROR;
	 }
	 newpage((short)255);
	 if (objc == 3) {
	    strcpy(curpage->pageinst->thisobject->name,
		Tcl_GetString(objv[2]));
	 }
	 break;
      case SaveOnlyIdx:
      case SaveIdx:
	 if (objc > 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "[filename]");
	    return TCL_ERROR;
	 }
	 else if (objc == 3) {
	    filename = Tcl_GetString(objv[2]);
	    if (strcmp(filename, curpage->filename)) {
	       sprintf(_STR2, "Warning:  Filename is \"%s\" but will be "
		   "saved as \"%s\"\n", curpage->filename, filename);
	       Wprintf(_STR2);
	    }
	 }
	 else
	    filename = curpage->filename;

	 if (savepage != pageno) newpage(pageno);
	 if (!strncmp(Tcl_GetString(objv[1]), "saveo", 5))
	     setfile(filename, NO_SUBCIRCUITS);
	 else
	     setfile(filename, CURRENT_PAGE);
	 if (savepage != pageno) newpage(savepage);
	 break;

      case LinksIdx:
	 if ((objc - nidx) != 2 && (objc - nidx) != 3) {
	    Tcl_WrongNumArgs(interp, 1, objv, "links");
	    return TCL_ERROR;
	 }
	 if ((objc - nidx) == 2)
	    linktype = TOTAL_PAGES;
	 else {
	    if (Tcl_GetIndexFromObj(interp, objv[2 + nidx],
			(CONST84 char **)linkTypes,
			"link type", 0, &linktype) != TCL_OK)
	       return TCL_ERROR;
	 }
	 pagelist = pagetotals(pageno, linktype);
	 multi = 0;
	 for (i = 0; i < xobjs.pages; i++)
	    if (pagelist[i] > 0) multi++;
	 Tcl_SetObjResult(interp, Tcl_NewIntObj(multi));
	 free((char *)pagelist);
	 break;
      case DirIdx:
	 startcatalog(NULL, PAGELIB, NULL);
	 break;
      case GoToIdx:
         newpage((short)pageno);
	 break;
      case SizeIdx:
         if ((objc - nidx) != 2 && (objc - nidx) != 3) {
            Tcl_WrongNumArgs(interp, 1, objv, "size ?\"width x height\"?");
            return TCL_ERROR;
         }
	 if ((objc - nidx) == 2) {
	    float xsize, ysize, cfact;

	    objPtr = Tcl_NewListObj(0, NULL);

	    cfact = (curpage->coordstyle == CM) ? IN_CM_CONVERT
			: 72.0;
            xsize = (float)curpage->pagesize.x / cfact;
            ysize = (float)curpage->pagesize.y / cfact;

	    Tcl_ListObjAppendElement(xcinterp, objPtr,
		Tcl_NewDoubleObj((double)xsize));
	    Tcl_ListObjAppendElement(xcinterp, objPtr,
	 	Tcl_NewStringObj("x", 1));
	    Tcl_ListObjAppendElement(xcinterp, objPtr,
		Tcl_NewDoubleObj((double)ysize));
	    Tcl_ListObjAppendElement(xcinterp, objPtr,
		Tcl_NewStringObj(((curpage->coordstyle == CM) ?
			"cm" : "in"), 2));
	    Tcl_SetObjResult(interp, objPtr);

	    return XcTagCallback(interp, objc, objv);
	 }

         strcpy(_STR2, Tcl_GetString(objv[2 + nidx]));
         setpagesize((Tk_Window)clientData, &curpage->pagesize);

         /* Only need to recompute values and refresh if autoscaling is enabled */
         if (curpage->pmode & 2) autoscale(pageno);
	 break;

      case HeightIdx:
	 if ((objc - nidx) != 2 && (objc - nidx) != 3) {
	    Tcl_WrongNumArgs(interp, 1, objv, "height ?output_height?");
	    return TCL_ERROR;
	 }
	 if ((objc - nidx) == 2) {
	    newheight = toplevelheight(curpage->pageinst, NULL);
	    newheight *= getpsscale(curpage->outscale, pageno);
	    newheight /= (curpage->coordstyle == CM) ?  IN_CM_CONVERT : 72.0;
	    objPtr = Tcl_NewDoubleObj((double)newheight);
	    Tcl_SetObjResult(interp, objPtr);
	    return XcTagCallback(interp, objc, objv);
	 }
	 newheight = (double)parseunits(Tcl_GetString(objv[2 + nidx]));
	 if (newheight <= 0 || topobject->bbox.height == 0) {
	    Tcl_SetResult(interp, "Illegal height value", NULL);
            return TCL_ERROR;
	 }
	 newheight = (newheight * ((curpage->coordstyle == CM) ?
		IN_CM_CONVERT : 72.0)) / topobject->bbox.height;
	 newheight /= getpsscale(1.0, pageno);
	 curpage->outscale = (float)newheight;

	 if (curpage->pmode & 2) autoscale(pageno);
	 break;

      case WidthIdx:
	 if ((objc - nidx) != 2 && (objc - nidx) != 3) {
	    Tcl_WrongNumArgs(interp, 1, objv, "output_width");
	    return TCL_ERROR;
	 }
	 if ((objc - nidx) == 2) {
	    newwidth = toplevelwidth(curpage->pageinst, NULL);
	    newwidth *= getpsscale(curpage->outscale, pageno);
	    newwidth /= (curpage->coordstyle == CM) ?  IN_CM_CONVERT : 72.0;
	    objPtr = Tcl_NewDoubleObj((double)newwidth);
	    Tcl_SetObjResult(interp, objPtr);
	    return XcTagCallback(interp, objc, objv);
	 }
	 newwidth = (double)parseunits(Tcl_GetString(objv[2 + nidx]));
	 if (newwidth <= 0 || topobject->bbox.width == 0) {
	    Tcl_SetResult(interp, "Illegal width value", NULL);
	    return TCL_ERROR;
	 }

	 newwidth = (newwidth * ((curpage->coordstyle == CM) ?
		IN_CM_CONVERT : 72.0)) / topobject->bbox.width;
	 newwidth /= getpsscale(1.0, pageno);
	 curpage->outscale = (float)newwidth;

	 if (curpage->pmode & 2) autoscale(pageno);
	 break;

      case ScaleIdx:
	 if ((objc - nidx) != 2 && (objc - nidx) != 3) {
	    Tcl_WrongNumArgs(interp, 1, objv, "output_scale");
	    return TCL_ERROR;
	 }
	 if ((objc - nidx) == 2) {
	    objPtr = Tcl_NewDoubleObj((double)curpage->outscale);
	    Tcl_SetObjResult(interp, objPtr);
	    return XcTagCallback(interp, objc, objv);
	 }
	 result = Tcl_GetDoubleFromObj(interp, objv[2 + nidx], &newscale);
	 if (result != TCL_OK) return result;

	 oldscale = curpage->outscale;

	 if (oldscale == (float)newscale) return TCL_OK;	/* nothing to do */
	 else curpage->outscale = (float)newscale;

	 if (curpage->pmode & 2) autoscale(pageno);
	 break;

      case OrientIdx:
	 if ((objc - nidx) != 2 && (objc - nidx) != 3) {
	    Tcl_WrongNumArgs(interp, 1, objv, "orientation");
	    return TCL_ERROR;
	 }
	 if ((objc - nidx) == 2) {
	    objPtr = Tcl_NewIntObj((int)curpage->orient);
	    Tcl_SetObjResult(interp, objPtr);
	    return XcTagCallback(interp, objc, objv);
	 }
	 result = Tcl_GetIntFromObj(interp, objv[2 + nidx], &newrot);
	 if (result != TCL_OK) return result;
	 curpage->orient = (short)newrot;

	 /* rescale after rotation if "auto-scale" is set */
	 if (curpage->pmode & 2) autoscale(pageno);
	 break;
	 
      case EPSIdx:
	 if ((objc - nidx) != 2 && (objc - nidx) != 3) {
	    Tcl_WrongNumArgs(interp, 1, objv, "encapsulation");
	    return TCL_ERROR;
	 }
	 if ((objc - nidx) == 2) {
	    newstr = psTypes[curpage->pmode & 1];
	    Tcl_SetResult(interp, newstr, NULL);
	    return XcTagCallback(interp, objc, objv);
	 }
	 newstr = Tcl_GetString(objv[2 + nidx]);
	 if (Tcl_GetIndexFromObj(interp, objv[2 + nidx],
		(CONST84 char **)psTypes,
		"encapsulation", 0, &newmode) != TCL_OK) {
	    return result;
	 }
	 curpage->pmode &= 0x2;			/* preserve auto-fit flag */
	 curpage->pmode |= (short)newmode;
	 if (curpage->pmode == 2)
	    curpage->pmode = 0;	   /* auto-fit does not apply to EPS mode */
	 break;

      case LabelIdx:
	 if ((objc - nidx) != 2 && (objc - nidx) != 3) {
	    Tcl_WrongNumArgs(interp, 1, objv, "label ?name?");
	    return TCL_ERROR;
	 }
	 if ((objc - nidx) == 2) {
	    objPtr = Tcl_NewStringObj(pageobj->name, strlen(pageobj->name));
	    Tcl_SetObjResult(interp, objPtr);
	    return XcTagCallback(interp, objc, objv);
	 }

	 /* Whitespace and non-printing characters not allowed */

	 strcpy(_STR2, Tcl_GetString(objv[2 + nidx]));
	 for (i = 0; i < strlen(_STR2); i++) {
	    if ((!isprint(_STR2[i])) || (isspace(_STR2[i]))) {
	       _STR2[i] = '_';
	       Wprintf("Replaced illegal whitespace in name with underscore");
	    }
	 }

	 if (!strcmp(pageobj->name, _STR2)) return TCL_OK; /* no change in string */
	 if (strlen(_STR2) == 0)
	    sprintf(pageobj->name, "Page %d", areastruct.page + 1);
	 else
	    sprintf(pageobj->name, "%.79s", _STR2);

	 /* For schematics, all pages with associations to symbols must have  */
	 /* unique names.                                                     */
	 if (pageobj->symschem != NULL) checkpagename(pageobj);

	 if (pageobj == topobject) printname(pageobj);
	 renamepage(pageno);
	 break;

      case FileIdx:

	 if ((objc - nidx) != 2 && (objc - nidx) != 3) {
	    Tcl_WrongNumArgs(interp, 1, objv, "filename ?name?");
	    return TCL_ERROR;
	 }

	 oldstr = curpage->filename;

	 if ((objc - nidx) == 2) {
	    objPtr = Tcl_NewStringObj(oldstr, strlen(oldstr));
	    Tcl_SetObjResult(interp, objPtr);
	    return XcTagCallback(interp, objc, objv);
         }

	 newstr = Tcl_GetString(objv[2 + nidx]);

	 if (!strcmp(oldstr, newstr))		/* no change in string */
	    return TCL_OK;

	 multi = pagelinks(pageno);	/* Are there multiple pages? */

	 /* Make the change to the current page */
	 curpage->filename = strdup(newstr);

	 /* All existing filenames which match the old string should	*/
	 /* also be changed unless the filename has been set to the	*/
	 /* null string, which unlinks the page.			*/ 

	 if ((strlen(curpage->filename) > 0) && (multi > 1)) {
	    for (cpage = 0; cpage < xobjs.pages; cpage++) {
	       lpage = xobjs.pagelist[cpage];
	       if ((lpage->pageinst != NULL) && (cpage != pageno)) {
	          if (!strcmp(lpage->filename, oldstr)) {
	             free(lpage->filename);
	             lpage->filename = strdup(newstr);
	          }
	       }
	    }
	 }
	 free(oldstr);
	 autoscale(pageno);
	 break;

      case FitIdx:
	 if ((objc - nidx) > 3) {
	    Tcl_WrongNumArgs(interp, 1, objv, "fit ?true|false?");
	    return TCL_ERROR;
	 }
	 else if ((objc - nidx) == 3) {
	    result = Tcl_GetBooleanFromObj(interp, objv[2], &aval);
	    if (result != TCL_OK) return result;
	    if (aval)
	       curpage->pmode |= 2;
	    else
	       curpage->pmode &= 1;
	 }
	 else
	    Tcl_SetResult(interp, ((curpage->pmode & 2) > 0) ? "true" : "false", NULL);

	 /* Refresh values (does autoscale if specified) */
	 autoscale(pageno);
	 break;
   }
   return XcTagCallback(interp, objc, objv);
}

/*----------------------------------------------------------------------*/

int xctcl_library(ClientData clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *CONST objv[])
{
   char *libname, *filename = NULL, *objname;
   int j = 0, libnum = -1;
   int idx, nidx, result;
   Tcl_Obj *objPtr, *olist;
   Tcl_Obj **newobjv;
   int newobjc, hidmode;
   short save_replace;
   objectptr libobj;
   char *subCmds[] = {
      "load", "make", "save", "directory", "next", "goto", "override",
	"import", "list", "filename", NULL
   };
   enum SubIdx {
      LoadIdx, MakeIdx, SaveIdx, DirIdx, NextIdx, GoToIdx, OverrideIdx,
	ImportIdx, ListIdx, FileIdx
   };

   result = ParseLibArguments(interp, objc, objv, &nidx, &libnum);
   if ((result != TCL_OK) || (nidx < 0)) return result;
   else if ((objc - nidx) > 5) {
      Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
      return TCL_ERROR;
   }
   else if (objc <= (1 + nidx)) {  /* No subcommand */

      /* return index if name given; return name if index given. */
      /* return index if neither is given (current library)	 */
      
      if (objc > 1) {
	 int lnum;	/* unused; only checks if argument is integer */
	 char *lname;
	 result = Tcl_GetIntFromObj(interp, objv[1], &lnum);
	 if (result == TCL_OK) {
	    lname = xobjs.libtop[libnum + LIBRARY]->thisobject->name;
            Tcl_SetObjResult(interp, Tcl_NewStringObj(lname, strlen(lname)));
	 }
	 else
            Tcl_SetObjResult(interp, Tcl_NewIntObj(libnum + 1));
      }
      else
         Tcl_SetObjResult(interp, Tcl_NewIntObj(libnum + 1));
      idx = -1;
   }
   else if (Tcl_GetIndexFromObj(interp, objv[1 + nidx],
		(CONST84 char **)subCmds, "option", 0, &idx) != TCL_OK) {

      /* Backwards compatibility: "library filename [number]" is */
      /* the same as "library [number] load filename"		 */

      Tcl_ResetResult(interp);
      newobjv = (Tcl_Obj **)(&objv[1]);
      newobjc = objc - 1;

      result = ParseLibArguments(interp, newobjc, newobjv, &nidx, &libnum);
      if (result != TCL_OK) return result;

      idx = LoadIdx;
      filename = Tcl_GetString(newobjv[0]);
   }

   switch (idx) {
      case LoadIdx:
	 save_replace = xobjs.do_replace;
	 /* library [<name>|<number>] load <filename> [-replace [library]] */
	 if (objc < (3 + nidx)) {
	    Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
	    return TCL_ERROR;
	 }
	 if (filename == NULL) filename = Tcl_GetString(objv[2 + nidx]);

	 /* if loading of default libraries is not overridden, load them first */

	 if (!(flags & (LIBOVERRIDE | LIBLOADED))) {                          
	    defaultscript();
	    flags |= LIBLOADED;
	 }

	 if (libnum >= (xobjs.numlibs - 1) || libnum < 0)
	    libnum = createlibrary(FALSE);
	 else
	    libnum += LIBRARY;

	 if (objc > (3 + nidx)) {
	    char *argv = Tcl_GetString(objv[3 + nidx]);
	    xobjs.do_replace = -1;
	    if ((*argv == '-') && !strncmp(argv, "-repl", 5)) {
	       if (objc > (4 + nidx)) {
		  char *libstr = Tcl_GetString(objv[3 + nidx]);
		  if (!strcmp(libstr, "all")) xobjs.do_replace = -2;
		  else if (!strcmp(libstr, "none")) xobjs.do_replace = -1;
		  else {
		     ParseLibArguments(xcinterp, 2, &objv[2 + nidx], NULL, &j);
		     xobjs.do_replace = j;
		  }
	       }
	       else
		  xobjs.do_replace = -2;	/* replace ALL */
	    }
	 }

	 strcpy(_STR, filename);
	 loadlibrary(libnum);
	 xobjs.do_replace = save_replace;
	 break;

      case ImportIdx:
	 /* library [<name>|<number>] import <filename> <objectname> */
	 if (objc != (4 + nidx)) {
	    Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
	    return TCL_ERROR;
	 }
	 if (filename == NULL) filename = Tcl_GetString(objv[2 + nidx]);

	 /* if loading of default libraries is not overridden, load them first */

	 if (!(flags & (LIBOVERRIDE | LIBLOADED))) {                          
	    defaultscript();
	    flags |= LIBLOADED;
	 }

	 if ((libnum >= xobjs.numlibs) || (libnum < 0))
	    libnum = createlibrary(FALSE);
	 else
	    libnum += LIBRARY;

	 objname = Tcl_GetString(objv[3 + nidx]);
	 importfromlibrary(libnum, filename, objname);
	 break;

      case ListIdx:
	 if (!strncmp(Tcl_GetString(objv[objc - 1]), "-vis", 4))
	    hidmode = 1;	/* list visible objects only */
	 else if (!strncmp(Tcl_GetString(objv[objc - 1]), "-hid", 4))
	    hidmode = 2;	/* list hidden objects only */
	 else
	    hidmode = 3;	/* list everything */

	 /* library [name|number] list [-visible|-hidden] */
	 olist = Tcl_NewListObj(0, NULL);
         for (j = 0; j < xobjs.userlibs[libnum].number; j++) {
            libobj = *(xobjs.userlibs[libnum].library + j);
	    if (((libobj->hidden) && (hidmode & 2)) ||
			((!libobj->hidden) && (hidmode & 1)))
	       Tcl_ListObjAppendElement(interp, olist,
			Tcl_NewStringObj(libobj->name, strlen(libobj->name)));
	 }
	 Tcl_SetObjResult(interp, olist);
	 break;

      case FileIdx:
	 /* library [<name>|<number>] filename */
         if (xobjs.userlibs[libnum].filename) {
	    objPtr = Tcl_NewStringObj(xobjs.userlibs[libnum].filename,
			strlen(xobjs.userlibs[libnum].filename));
	 }
	 else
	    objPtr = Tcl_NewStringObj("(none)", 6);
	 Tcl_SetObjResult(interp, objPtr);
	 break;

      case MakeIdx:
	 /* library make [name] */
	 if (nidx == 1) {
	    Tcl_SetResult(interp, "syntax is: library make [<name>]", NULL);
	    return TCL_ERROR;
	 }

	 /* If the (named or numbered) library exists, don't create it. */
	 /* ParseLibArguments() returns the library number for the User	*/
	 /* Library.  The User Library always exists and cannot be	*/
	 /* created or destroyed, so it's okay to use it as a check for	*/
	 /* "no library found".						*/

	 if (libnum == xobjs.numlibs - 1)
	    libnum = createlibrary(TRUE);

	 if (objc == 3) {
	    strcpy(xobjs.libtop[libnum]->thisobject->name, Tcl_GetString(objv[2]));
	    renamelib(libnum);
	    composelib(LIBLIB);
	 }
	 /* Don't go to the library page---use "library goto" instead */
	 /* startcatalog((Tk_Window)clientData, libnum, NULL); */
	 break;
      case SaveIdx:
	 /* library [name|number] save filename */
	 if ((objc - nidx) != 3) {
	    Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
	    return TCL_ERROR;
	 }
	 filename = Tcl_GetString(objv[2 + nidx]);

	 if (xobjs.userlibs[libnum].number == 0) {
	    Tcl_SetResult(interp, "No objects in library to save.", NULL);
	    return TCL_ERROR;
	 }
	 strcpy(_STR2, filename);
	 savelibrary((Tk_Window)clientData, libnum);
	 break;
      case DirIdx:
	 /* library directory */
	 if ((nidx == 0) && (objc == 2)) {
	    startcatalog(NULL, LIBLIB, NULL);
	 }
	 else if ((nidx == 0) && (objc == 3) &&
		!strcmp(Tcl_GetString(objv[2]), "list")) {
	    olist = Tcl_NewListObj(0, NULL);
            for (j = 0; j < xobjs.numlibs; j++) {
               libobj = xobjs.libtop[j + LIBRARY]->thisobject;
	       Tcl_ListObjAppendElement(interp, olist,
			Tcl_NewStringObj(libobj->name, strlen(libobj->name)));
	    }
	    Tcl_SetObjResult(interp, olist);
	 }
	 else {
	    Tcl_SetResult(interp, "syntax is: library directory", NULL);
	    return TCL_ERROR;
	 }
	 break;
      case NextIdx:
         libnum = is_library(topobject);
	 if (++libnum >= xobjs.numlibs) libnum = 0;	/* fall through */
      case GoToIdx:
	 /* library go */ 
	 startcatalog(NULL, LIBRARY + libnum, NULL);
	 break;
      case OverrideIdx:
	 flags |= LIBOVERRIDE;
	 return TCL_OK;			/* no tag callback */
	 break;
   }
   return XcTagCallback(interp, objc, objv);
}

/*----------------------------------------------------------------------*/
/* "bindkey" command --- this is a direct implementation of the same	*/
/* key binding found in the "ad-hoc" and Python interfaces;  it is	*/
/* preferable to make use of the Tk "bind" command directly, and work	*/
/* from the event handler.						*/
/*----------------------------------------------------------------------*/

int xctcl_bind(ClientData clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *CONST objv[])
{
   char *keyname, *commandname, *binding;
   int keywstate, func = -1, value = -1;
   int result;

   if (objc == 2) {
      keyname = Tcl_GetString(objv[1]);
      if (!strcmp(keyname, "override")) {
	 flags |= KEYOVERRIDE;
	 return TCL_OK;			/* no tag callback */
      }
   }

   if (!(flags & KEYOVERRIDE)) {
      default_keybindings();
      flags |= KEYOVERRIDE;
   }

   if (objc == 1) {
      Tcl_Obj *list;
      int i;

      list = Tcl_NewListObj(0, NULL);
      for (i = 0; i < NUM_FUNCTIONS; i++) {
         commandname = func_to_string(i);
	 Tcl_ListObjAppendElement(interp, list,
		Tcl_NewStringObj(commandname, strlen(commandname)));
      }
      Tcl_SetObjResult(interp, list);
      return TCL_OK;
   }
   else if (objc > 4) {
      Tcl_WrongNumArgs(interp, 1, objv, "[<key> [<command> [<value>|forget]]]");
      return TCL_ERROR;
   }
   keyname = Tcl_GetString(objv[1]);
   keywstate = string_to_key(keyname);

   /* 1st arg may be a function, not a key, if we want the binding returned */
   if ((objc == 3) && !strncmp(keyname, "-func", 5)) {
      keywstate = -1;
      func = string_to_func(Tcl_GetString(objv[2]), NULL);
      objc = 2;
   }
   else if ((objc == 2) && (keywstate == 0)) {
      keywstate = -1;
      func = string_to_func(keyname, NULL);
   }

   if (objc == 2) {
      binding = binding_to_string(keywstate, func);
      Tcl_SetResult(interp, binding, TCL_VOLATILE);
      free(binding);
      return TCL_OK;
   }

   commandname = Tcl_GetString(objv[2]);
   if (strlen(commandname) == 0)
      func = -1;
   else
      func = string_to_func(commandname, NULL);

   if (objc == 4) {
      result = Tcl_GetIntFromObj(interp, objv[3], &value);
      if (result != TCL_OK)
      {
	 if (strcmp(Tcl_GetString(objv[3]), "forget"))
	    return (result);
	 else {
	    /*  Unbind command */
	    Tcl_ResetResult(interp);
	    result = remove_binding(keywstate, func);
	    if (result == 0)
		return TCL_OK;
	    else {
	       Tcl_SetResult(interp, "Key/Function pair not found "
			"in binding list.\n", NULL);
	       return TCL_ERROR;
	    }
	 }
      }
   }
   result = add_vbinding(keywstate, func, value);
   if (result == 1) {
      Tcl_SetResult(interp, "Key is already bound to a command.\n", NULL);
      return (result);
   }
   return TCL_OK;
}

/*----------------------------------------------------------------------*/

int xctcl_font(ClientData clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *CONST objv[])
{
   char *fontname;
   int result;

   /* font name */
   if (objc != 2) {
      Tcl_WrongNumArgs(interp, 1, objv, "fontname");
      return TCL_ERROR;
   }
   fontname = Tcl_GetString(objv[1]);
   
   /* Allow overrides of the default font loading mechanism */
   if (!strcmp(fontname, "override")) {
      flags |= FONTOVERRIDE;
      return TCL_OK;
   }

   /* If we need to load the default font "Helvetica" because no fonts	*/
   /* have been loaded yet, then we call this function twice, so that	*/
   /* the command tag callback gets applied both times.			*/

   if (!(flags & FONTOVERRIDE)) {
      flags |= FONTOVERRIDE;
      xctcl_font(clientData, interp, objc, objv);
      loadfontfile("Helvetica");
   }
   result = loadfontfile((char *)fontname);
   if (result >= 1) {
      Tcl_SetObjResult(interp, Tcl_NewStringObj(fonts[fontcount - 1].family,
		strlen(fonts[fontcount - 1].family)));
   }
   switch (result) {
      case 1:
	 return XcTagCallback(interp, objc, objv);
      case 0:
	 return TCL_OK;
      case -1:
         return TCL_ERROR;
   }
}

/*----------------------------------------------------------------------*/
/* Set the X11 cursor to one of those defined in the XCircuit cursor	*/
/* set (cursors.h)							*/
/*----------------------------------------------------------------------*/
 
int xctcl_cursor(ClientData clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *CONST objv[])
{
   char *cursorname;
   int idx, result;

   static char *cursNames[] = {
      "arrow", "cross", "scissors", "copy", "rotate", "edit",
      "text", "circle", "question", "wait", "hand", NULL
   };

   /* cursor name */
   if (objc != 2) {
      Tcl_WrongNumArgs(interp, 1, objv, "cursor name");
      return TCL_ERROR;
   }
   if ((result = Tcl_GetIndexFromObj(interp, objv[1],
	(CONST84 char **)cursNames,
	"cursor name", 0, &idx)) != TCL_OK)
      return result;

   XDefineCursor(dpy, areastruct.areawin, appcursors[idx]);
   areastruct.defaultcursor = &appcursors[idx];
   return XcTagCallback(interp, objc, objv);
}

/*----------------------------------------------------------------------*/

int xctcl_filerecover(ClientData clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *CONST objv[])
{
   int i;

   if (objc != 1) {
      Tcl_WrongNumArgs(interp, 1, objv, "(no arguments)");
      return TCL_ERROR;
   }
   crashrecover();
   return XcTagCallback(interp, objc, objv);
}

/*----------------------------------------------------------------------*/
/* Replace the functions of the simple rcfile.c interpreter.    	*/
/*----------------------------------------------------------------------*/

/*----------------------------------------------------------------------*/
/* Execute a single command from a script or from the command line      */
/*----------------------------------------------------------------------*/

short execcommand(short pflags, char *cmdptr)
{
   flags = pflags;
   Tcl_Eval(xcinterp, cmdptr);
   refresh(NULL, NULL, NULL);
   return flags;
}

/*----------------------------------------------------------------------*/
/* Load the default script (like execscript() but don't allow recursive */
/* loading of the startup script)                                       */
/*----------------------------------------------------------------------*/

void defaultscript()
{
   FILE *fd;
   char *tmp_s = getenv((const char *)"XCIRCUIT_LIB_DIR");

   flags = LIBOVERRIDE | LIBLOADED | FONTOVERRIDE;

   if (!tmp_s) tmp_s = BUILTINS_DIR;
   sprintf(_STR2, "%s/%s", tmp_s, STARTUP_FILE);

   if ((fd = fopen(_STR2, "r")) == NULL) {
      sprintf(_STR2, "%s/%s", BUILTINS_DIR, STARTUP_FILE);
      if ((fd = fopen(_STR2, "r")) == NULL) {
         sprintf(_STR2, "%s/tcl/%s", BUILTINS_DIR, STARTUP_FILE);
         if ((fd = fopen(_STR2, "r")) == NULL) {
            sprintf(_STR, "Failed to open startup script \"%s\"\n", STARTUP_FILE);
            Wprintf(_STR);
            return;
	 }
      }
   }
   fclose(fd);
   Tcl_EvalFile(xcinterp, _STR2);
}

/*----------------------------------------------------------------------*/
/* Execute a script                                                     */
/*----------------------------------------------------------------------*/

void execscript()
{
   FILE *fd;
   
   flags = 0;

   xc_tilde_expand(_STR2);
   if ((fd = fopen(_STR2, "r")) != NULL) {
      fclose(fd);
      Tcl_EvalFile(xcinterp, _STR2);
      refresh(NULL, NULL, NULL);
   }
   else {
      sprintf(_STR, "Failed to open script file \"%s\"\n", _STR2);
      Wprintf(_STR);
   }
}

/*----------------------------------------------------------------------*/
/* Evaluate an expression from a parameter and return the result as a 	*/
/* Tcl object.   The actual return value (TCL_OK, TCL_ERROR) is stored	*/
/* in pointer "eval_status", if it is non-NULL.				*/
/*----------------------------------------------------------------------*/

Tcl_Obj *evaluate_raw(oparamptr ops, int *eval_status)
{
   Tcl_SavedResult state;
   Tcl_Obj *robj;
   int status;

   /* Sanity check */
   if (ops->type != XC_EXPR) return NULL;

   /* Evaluate the expression in TCL */

   Tcl_SaveResult(xcinterp, &state);
   status = Tcl_Eval(xcinterp, ops->parameter.expr);
   robj = Tcl_GetObjResult(xcinterp);
   Tcl_IncrRefCount(robj);
   Tcl_RestoreResult(xcinterp, &state);
   if (eval_status) *eval_status = status;
   return robj;
}

/*----------------------------------------------------------------------*/
/* Evaluate an expression from a parameter and return the result as an	*/
/* allocated string.							*/
/*----------------------------------------------------------------------*/

char *evaluate_expr(oparamptr ops, objinstptr pinst)
{
   Tcl_Obj *robj;
   char *rexpr = NULL;
   int status;
   float fp = 0.0;
   stringpart *tmpptr, *promote = NULL;
   oparamptr ips = (pinst == NULL) ? NULL : match_instance_param(pinst, ops->key);

   robj = evaluate_raw(ops, &status);
   if (robj != NULL) { 
      rexpr = strdup(Tcl_GetString(robj));
      Tcl_DecrRefCount(robj);
   }

   if ((status == TCL_ERROR) && (ips != NULL)) {
      switch(ips->type) {
	 case XC_STRING:
            rexpr = textprint(ips->parameter.string, pinst);
	    break;
	 case XC_FLOAT:
	    fp = ips->parameter.fvalue;
	    break;
      }
   }

   /* If an instance redefines an expression, don't preserve	*/
   /* the result.  It is necessary in this case that the	*/
   /* expression does not reference objects during redisplay,	*/
   /* or else the correct result will not be written to the	*/
   /* output.							*/

   if ((ips != NULL) && (ips->type == XC_EXPR))
      return rexpr;

   /* Preserve the result in the object instance; this will be	*/
   /* used when writing the output or when the result cannot	*/
   /* be evaluated (see above).					*/

   if ((rexpr != NULL) && (status == TCL_OK) && (pinst != NULL)) {
      switch (ops->which) {
	 case P_SUBSTRING: case P_EXPRESSION: case P_COLOR:
            if (ips == NULL) {
	       ips = make_new_parameter(ops->key);
	       ips->which = ops->which;
	       ips->type = XC_STRING;
	       ips->next = pinst->params;
	       pinst->params = ips;
            }
            else {
	       free(ips->parameter.string);
            }
            /* Promote the expression result to an XCircuit string type */
            tmpptr = makesegment(&promote, NULL);
            tmpptr->type = TEXT_STRING;
            tmpptr = makesegment(&promote, NULL);
            tmpptr->type = PARAM_END;
            promote->data.string = strdup(rexpr);
            ips->parameter.string = promote;
	    break;

	 default:	/* all others convert to type float */
            if (ips == NULL) {
	       ips = make_new_parameter(ops->key);
	       ips->which = ops->which;
	       ips->type = XC_FLOAT;
	       ips->next = pinst->params;
	       pinst->params = ips;
            }
            /* Promote the expression result to type float */
	    if (rexpr != NULL) {
	       if (sscanf(rexpr, "%g", &fp) == 1)
		  ips->parameter.fvalue = fp;
	       else
		  ips->parameter.fvalue = 0.0;
	    }
	    else
	       ips->parameter.fvalue = fp;
	    break;
      }
   }
   return rexpr;
}

/*----------------------------------------------------------------------*/
/* Execute the .xcircuitrc startup script                               */
/*----------------------------------------------------------------------*/

void loadrcfile()
{
   char *userdir = getenv((const char *)"HOME");
   FILE *fd;
   short i;

   /* Initialize flags */

   flags = 0;

   /* Try first in current directory, then look in user's home directory */
   /* First try looking for a file .xcircuitrc followed by a dash and	 */
   /* the program version; this allows backward compatibility of the rc	 */
   /* file in cases where a new version (e.g., 3 vs. 2) introduces 	 */
   /* incompatible syntax.  Thanks to Romano Giannetti for this		 */
   /* suggestion plus provided code.					 */

   /* (names USER_RC_FILE and PROG_VERSION imported from Makefile) */

   sprintf(_STR2, "%s-%g", USER_RC_FILE, PROG_VERSION);
   xc_tilde_expand(_STR2);
   if ((fd = fopen(_STR2, "r")) == NULL) {
      /* Not found; check for the same in $HOME directory */
      if (userdir != NULL) {
         sprintf(_STR2, "%s/%s-%g", userdir, USER_RC_FILE, PROG_VERSION);
         if ((fd = fopen(_STR2, "r")) == NULL) {
	    /* Not found again; check for rc file w/o version # in CWD */
            sprintf(_STR2, "%s", USER_RC_FILE);
            xc_tilde_expand(_STR2);
            if ((fd = fopen(_STR2, "r")) == NULL) {
               /* last try: plain USER_RC_FILE in $HOME */
               sprintf(_STR2, "%s/%s", userdir, USER_RC_FILE);
               fd = fopen(_STR2, "r");
            }
	 }
      }
   }
   if (fd != NULL) {
      fclose(fd);
      Tcl_EvalFile(xcinterp, _STR2);
   }

   /* Add the default font if not loaded already */
   
   if (!(flags & FONTOVERRIDE)) {
      loadfontfile("Helvetica");
      if (areastruct.psfont == -1)
         for (i = 0; i < fontcount; i++)
            if (!strcmp(fonts[i].psname, "Helvetica")) {
               areastruct.psfont = i;
               break;
            }
   }
   if (areastruct.psfont == -1) areastruct.psfont = 0;

   setdefaultfontmarks();

   /* arrange the loaded libraries */

   if (!(flags & (LIBOVERRIDE | LIBLOADED)))
      defaultscript();

   /* Add the default colors */

   if (!(flags & COLOROVERRIDE)) {
      addnewcolorentry(xc_alloccolor("Gray40"));
      addnewcolorentry(xc_alloccolor("Gray60"));
      addnewcolorentry(xc_alloccolor("Gray80"));
      addnewcolorentry(xc_alloccolor("Gray90"));
      addnewcolorentry(xc_alloccolor("Red"));
      addnewcolorentry(xc_alloccolor("Blue"));
      addnewcolorentry(xc_alloccolor("Green2"));
      addnewcolorentry(xc_alloccolor("Yellow"));
      addnewcolorentry(xc_alloccolor("Purple"));
      addnewcolorentry(xc_alloccolor("SteelBlue2"));
      addnewcolorentry(xc_alloccolor("Red3"));
      addnewcolorentry(xc_alloccolor("Tan"));
      addnewcolorentry(xc_alloccolor("Brown"));
   }  
     
   /* These colors must be enabled whether or not colors are overridden, */
   /* because they are needed by the schematic capture system.           */
      
   addnewcolorentry(xc_getlayoutcolor(LOCALPINCOLOR));
   addnewcolorentry(xc_getlayoutcolor(GLOBALPINCOLOR));
   addnewcolorentry(xc_getlayoutcolor(INFOLABELCOLOR));
   addnewcolorentry(xc_getlayoutcolor(RATSNESTCOLOR));
   addnewcolorentry(xc_getlayoutcolor(BBOXCOLOR));
      
   if (!(flags & KEYOVERRIDE))
      default_keybindings();
}

/*----------------------------------------------------------------------*/
/* Alternative button handler for use with Tk "bind"			*/
/*----------------------------------------------------------------------*/

int xctcl_standardaction(ClientData clientData,
        Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
   int idx, result, knum, kstate;
   XKeyEvent kevent;
   static char *updown[] = {"up", "down", NULL};

   if ((objc != 3) && (objc != 4)) goto badargs;

   if ((result = Tcl_GetIntFromObj(interp, objv[1], &knum)) != TCL_OK)
      goto badargs;

   if ((result = Tcl_GetIndexFromObj(interp, objv[2],
		(CONST84 char **)updown, "direction", 0, &idx)) != TCL_OK)
      goto badargs;

   if (objc == 4) {
      if ((result = Tcl_GetIntFromObj(interp, objv[3], &kstate)) != TCL_OK)
	 goto badargs;
   }
   else
      kstate = 0;

   make_new_event(&kevent);
   kevent.state = kstate;
   kevent.keycode = 0;

   if (idx == 0)
      kevent.type = KeyRelease;
   else
      kevent.type = KeyPress;

   switch (knum) {
      case 1:
	 kevent.state |= Button1Mask;
	 break;
     case 2:
	 kevent.state |= Button2Mask;
	 break;
     case 3:
	 kevent.state |= Button3Mask;
	 break;
     case 4:
	 kevent.state |= Button4Mask;
	 break;
     case 5:
	 kevent.state |= Button5Mask;
	 break;
     default:
	 kevent.keycode = knum;
	 break;
   }
#ifdef _MSC_VER
   if (kevent.state & Mod1Mask) {
     kevent.state &= ~Mod1Mask;
   }
   if (kevent.state & (AnyModifier<<2)) {
     kevent.state &= ~(AnyModifier<<2);
     kevent.state |= Mod1Mask;
   }
#endif
   keyhandler((xcWidget)NULL, (caddr_t)NULL, &kevent);
   return TCL_OK;

badargs:
   Tcl_SetResult(interp, "Usage: standardaction <button_num> up|down [<keystate>]\n"
			"or standardaction <keycode> up|down [<keystate>]\n", NULL);
   return TCL_ERROR;
}

/*----------------------------------------------------------------------*/
/* Argument-converting wrappers from Tk callback to Xt callback format	*/
/*----------------------------------------------------------------------*/

Tk_EventProc *xctk_drawarea(ClientData clientData, XEvent *eventPtr)
{
   Tcl_ServiceAll();
   drawarea(areastruct.area, (caddr_t)clientData, (caddr_t)NULL);
}

/*----------------------------------------------------------------------*/

Tk_EventProc *xctk_resizearea(ClientData clientData, XEvent *eventPtr)
{
   resizearea(areastruct.area, (caddr_t)clientData, (caddr_t)NULL);
   /* Callback to function "arrangetoolbar" */
   Tcl_Eval(xcinterp, "catch xcircuit::arrangetoolbar");
}

/*----------------------------------------------------------------------*/
/* Because Tk doesn't filter MotionEvent events based on context, we	*/
/* have to filter the context here.					*/
/*----------------------------------------------------------------------*/

Tk_EventProc *xctk_panhbar(ClientData clientData, XEvent *eventPtr)
{
   XMotionEvent *mevent = (XMotionEvent *)eventPtr;
   u_int state = mevent->state;
   if (state & (Button1Mask | Button2Mask))
      panhbar(areastruct.scrollbarh, (caddr_t)clientData, (XButtonEvent *)eventPtr);
}

/*----------------------------------------------------------------------*/

Tk_EventProc *xctk_panvbar(ClientData clientData, XEvent *eventPtr)
{
   XMotionEvent *mevent = (XMotionEvent *)eventPtr;
   u_int state = mevent->state;
   if (state & (Button1Mask | Button2Mask))
      panvbar(areastruct.scrollbarv, (caddr_t)clientData, (XButtonEvent *)eventPtr);
}

/*----------------------------------------------------------------------*/

Tk_EventProc *xctk_drawhbar(ClientData clientData, XEvent *eventPtr)
{
   drawhbar(areastruct.scrollbarh, (caddr_t)clientData, (caddr_t)NULL);
}

Tk_EventProc *xctk_drawvbar(ClientData clientData, XEvent *eventPtr)
{
   drawvbar(areastruct.scrollbarv, (caddr_t)clientData, (caddr_t)NULL);
}

/*----------------------------------------------------------------------*/

Tk_EventProc *xctk_endhbar(ClientData clientData, XEvent *eventPtr)
{
   endhbar(areastruct.scrollbarh, (caddr_t)clientData, (XButtonEvent *)eventPtr);
}

/*----------------------------------------------------------------------*/

Tk_EventProc *xctk_endvbar(ClientData clientData, XEvent *eventPtr)
{
   endvbar(areastruct.scrollbarv, (caddr_t)clientData, (XButtonEvent *)eventPtr);
}

/*----------------------------------------------------------------------*/

Tk_EventProc *xctk_zoomview(ClientData clientData, XEvent *eventPtr)
{
   zoomview((xcWidget)NULL, (caddr_t)clientData, (caddr_t)NULL);
}

/*----------------------------------------------------------------------*/

Tk_EventProc *xctk_swapschem(ClientData clientData, XEvent *eventPtr)
{
   swapschem((int)((pointertype)clientData), -1);
}

/*----------------------------------------------------------------------*/

Tk_EventProc *xctk_drag(ClientData clientData, XEvent *eventPtr)
{
   XButtonEvent *b_event = (XButtonEvent *)eventPtr;

   drag((int)b_event->x, (int)b_event->y);
   flusharea();
}

/*----------------------------------------------------------------------*/
/* This really should be set up so that the "okay" button command tcl	*/
/* procedure does the job of lookdirectory().				*/
/*----------------------------------------------------------------------*/

Tk_EventProc *xctk_fileselect(ClientData clientData, XEvent *eventPtr)
{
   XButtonEvent *beventPtr = (XButtonEvent *)eventPtr;
   popupstruct *listp = (popupstruct *)clientData;
   char *curentry;

   if (beventPtr->button == Button2) {
      Tcl_Eval(xcinterp, ".filelist.textent.txt get");
      curentry = (char *)Tcl_GetStringResult(xcinterp);

      if (curentry != NULL) {
         if (lookdirectory(curentry))
            newfilelist(listp->filew, listp);
	 else
	    Tcl_Eval(xcinterp, ".filelist.bbar.okay invoke");
      }
   }
   else if (beventPtr->button == Button4) {	/* scroll wheel binding */
      flstart--;
      showlscroll(listp->scroll, NULL, NULL);
      listfiles(listp->filew, listp, NULL);
   }
   else if (beventPtr->button == Button5) {	/* scroll wheel binding */
      flstart++;
      showlscroll(listp->scroll, NULL, NULL);
      listfiles(listp->filew, listp, NULL);
   }
   else
      fileselect(listp->filew, listp, beventPtr);
}

/*----------------------------------------------------------------------*/

Tk_EventProc *xctk_listfiles(ClientData clientData, XEvent *eventPtr)
{
   popupstruct *listp = (popupstruct *)clientData;
   char *filter;

   Tcl_Eval(xcinterp, ".filelist.listwin.win cget -data");
   filter = (char *)Tcl_GetStringResult(xcinterp);

   if (filter != NULL) {
      if ((listp->filter == NULL) || (strcmp(filter, listp->filter))) {
         if (listp->filter != NULL)
	    free(listp->filter);
         listp->filter = strdup(filter);
         newfilelist(listp->filew, listp);
      }
      else
	 listfiles(listp->filew, listp, NULL);
   }
   else {
      if (listp->filter != NULL) {
	 free(listp->filter);
	 listp->filter = NULL;
      }
      listfiles(listp->filew, listp, NULL);
   }
}

/*----------------------------------------------------------------------*/

Tk_EventProc *xctk_startfiletrack(ClientData clientData, XEvent *eventPtr)
{
   startfiletrack((Tk_Window)clientData, NULL, (XCrossingEvent *)eventPtr);
}

/*----------------------------------------------------------------------*/

Tk_EventProc *xctk_endfiletrack(ClientData clientData, XEvent *eventPtr)
{
   endfiletrack((Tk_Window)clientData, NULL, (XCrossingEvent *)eventPtr);
}

/*----------------------------------------------------------------------*/

Tk_EventProc *xctk_dragfilebox(ClientData clientData, XEvent *eventPtr)
{
   dragfilebox((Tk_Window)clientData, NULL, (XMotionEvent *)eventPtr);
}

/*----------------------------------------------------------------------*/

Tk_EventProc *xctk_draglscroll(ClientData clientData, XEvent *eventPtr)
{
   popupstruct *listp = (popupstruct *)clientData;
   XMotionEvent *mevent = (XMotionEvent *)eventPtr;
   u_int state = mevent->state;
   
   if (state & (Button1Mask | Button2Mask))
      draglscroll(listp->scroll, listp, (XButtonEvent *)eventPtr);
}

/*----------------------------------------------------------------------*/

Tk_EventProc *xctk_showlscroll(ClientData clientData, XEvent *eventPtr)
{
   showlscroll((Tk_Window)clientData, NULL, NULL);
}

/*--------------------------------------*/
/* GUI Initialization under Tk		*/
/*--------------------------------------*/

void GUI_init(int objc, Tcl_Obj *CONST objv[])
{
   Tk_Window 	tkwind, tktop, tkdraw, tksb;
   Tk_Window	wsymb, wschema,	corner, netbutton;
   Tk_Uid	xcuid;
   int 		i;
   XGCValues	values;   
   Window	win;
   popupstruct	*fileliststruct;
   static char *xctopdefault = ".xcircuit";
   char *xctopwin, *xcdrawwin;
   char winpath[512];

#ifdef OPENGL
   static int attributeList[] = { GLX_RGBA, GLX_DOUBLEBUFFER, None };
   /* GLfloat params[2]; */
   GLint params[2];
#endif

   /* Check for a TCL variable named "XCOps(top)".  If not set, then	*/
   /* we assume ".xcircuit" as the top.  It may be set to NULL.		*/

   xctopwin = (char *)Tcl_GetVar2(xcinterp, "XCOps", "top", TCL_NAMESPACE_ONLY);
   if (xctopwin == NULL) xctopwin = xctopdefault;

   tktop = Tk_MainWindow(xcinterp);

   if (tktop == NULL) {
      Fprintf(stderr, "No Top-Level Tk window available. . .\n");
      return;
   }

   /* Expect a top-level window created by the configuration script */

   tkwind = Tk_NameToWindow(xcinterp, xctopwin, tktop);

   if (tkwind == NULL) {
      /* Okay to have no GUI wrapper.  However, if this is the case,	*/
      /* then the variable "XCOps(window)" must be set to the Tk path	*/
      /* name of the drawing window.					*/

      xcdrawwin = (char *)Tcl_GetVar2(xcinterp, "XCOps", "window", TCL_NAMESPACE_ONLY);
      if (xcdrawwin == NULL) {
	  Fprintf(stderr, "The Tk window hierarchy must be rooted at"
		" .xcircuit, or XCOps(top)");
	  Fprintf(stderr, " must point to the hierarchy.  If XCOps(top)"
		" is NULL, then XCOps(window) must");
	  Fprintf(stderr, " point to the drawing window.\n");
	  return;
      }
      tkwind = Tk_NameToWindow(xcinterp, xcdrawwin, tktop);
      if (tkwind == NULL) {
	 Fprintf(stderr, "Error:  XCOps(window) is set but does not point to"
		" a valid Tk window.\n");
	 return;
      }
      areastruct.area = tkwind;

      message1 = NULL;
      message2 = NULL;
      message3 = "";

      /* No GUI---GUI widget pointers need to be NULL'd */
      areastruct.scrollbarv = NULL;
      areastruct.scrollbarh = NULL;
   }
   else {

      /* Fill in global variables from the Tk window values */

      sprintf(winpath, "%s.menubar.message", xctopwin);
      message1 = strdup(winpath);

      sprintf(winpath, "%s.infobar.message1", xctopwin);
      message2 = strdup(winpath);

      sprintf(winpath, "%s.infobar.message2", xctopwin);
      message3 = strdup(winpath);

      sprintf(winpath, "%s.mainframe.mainarea.sbleft", xctopwin);
      areastruct.scrollbarv = Tk_NameToWindow(xcinterp, winpath, tktop);
      sprintf(winpath, "%s.mainframe.mainarea.sbbottom", xctopwin);
      areastruct.scrollbarh = Tk_NameToWindow(xcinterp, winpath, tktop);
      sprintf(winpath, "%s.mainframe.mainarea.drawing", xctopwin);
      areastruct.area = Tk_NameToWindow(xcinterp, winpath, tktop);

      sprintf(winpath, "%s.mainframe.mainarea.corner", xctopwin);
      corner = Tk_NameToWindow(xcinterp, winpath, tktop);

      sprintf(winpath, "%s.infobar.symb", xctopwin);
      wsymb = Tk_NameToWindow(xcinterp, winpath, tktop);

      sprintf(winpath, "%s.infobar.schem", xctopwin);
      wschema = Tk_NameToWindow(xcinterp, winpath, tktop);

      Tk_CreateEventHandler(areastruct.scrollbarh, ButtonMotionMask, 
		(Tk_EventProc *)xctk_panhbar, NULL);
      Tk_CreateEventHandler(areastruct.scrollbarv, ButtonMotionMask, 
		(Tk_EventProc *)xctk_panvbar, NULL);
      Tk_CreateEventHandler(areastruct.scrollbarh, StructureNotifyMask | ExposureMask,
		(Tk_EventProc *)xctk_drawhbar, NULL);
      Tk_CreateEventHandler(areastruct.scrollbarv, StructureNotifyMask | ExposureMask,
		(Tk_EventProc *)xctk_drawvbar, NULL);
      Tk_CreateEventHandler(areastruct.scrollbarh, ButtonReleaseMask, 
		(Tk_EventProc *)xctk_endhbar, NULL);
      Tk_CreateEventHandler(areastruct.scrollbarv, ButtonReleaseMask, 
		(Tk_EventProc *)xctk_endvbar, NULL);

      Tk_CreateEventHandler(corner, ButtonPressMask, 
		(Tk_EventProc *)xctk_zoomview, Number(1));
      Tk_CreateEventHandler(wsymb, ButtonPressMask, 
		(Tk_EventProc *)xctk_swapschem, Number(0));
      Tk_CreateEventHandler(wschema, ButtonPressMask, 
		(Tk_EventProc *)xctk_swapschem, Number(0));
   }

   /* Setup event handlers for the drawing area and scrollbars			*/
   /* There are purposely no callback functions for these windows---they are	*/
   /* defined as type "frame" to keep down the cruft, as I will define my own	*/
   /* event handlers.								*/

   Tk_CreateEventHandler(areastruct.area, StructureNotifyMask, 
		(Tk_EventProc *)xctk_resizearea, NULL);
   Tk_CreateEventHandler(areastruct.area, ExposureMask, 
		(Tk_EventProc *)xctk_drawarea, NULL);

   /* Make sure the window is mapped */

   Tk_MapWindow(tkwind);

   dpy = Tk_Display(tkwind);
   win = Tk_WindowId(tkwind);
   cmap = Tk_Colormap(tkwind);

   areastruct.areawin = Tk_WindowId(areastruct.area);
   areastruct.width = Tk_Width(areastruct.area);
   areastruct.height = Tk_Height(areastruct.area);

   /*-------------------------*/
   /* Create stipple patterns */
   /*-------------------------*/

   for (i = 0; i < STIPPLES; i++)
      STIPPLE[i] = XCreateBitmapFromData(dpy, win, STIPDATA[i], 4, 4);

   /*----------------------------------------*/
   /* Allocate space for the basic color map */
   /*----------------------------------------*/
   
   number_colors = 0; 
   colorlist = (colorindex *)malloc(sizeof(colorindex));
   appcolors = (int *) malloc(NUMBER_OF_COLORS * sizeof(int));

   /*-------------------------------------------------------------------*/
   /* Generate the GC							*/
   /* Set "graphics_exposures" to False.  Every XCopyArea function	*/
   /* copies from virtual memory (dbuf pixmap), which can never be	*/
   /* obscured.  Otherwise, the server gets flooded with useless	*/
   /* NoExpose events.	  						*/
   /*-------------------------------------------------------------------*/

   values.foreground = BlackPixel(dpy, DefaultScreen(dpy));
   values.background = WhitePixel(dpy, DefaultScreen(dpy)); 
   values.graphics_exposures = False;
   areastruct.gc = XCreateGC(dpy, win, GCForeground | GCBackground
		| GCGraphicsExposures, &values);

   XDefineCursor (dpy, win, DEFAULTCURSOR);  

   /*--------------------------*/
   /* Build the color database */
   /*--------------------------*/

   if ((xcuid = Tk_GetOption(tkwind, "globalpincolor", "Color")) == NULL)
      xcuid = "Orange2";
   appdata.globalcolor = xc_alloccolor((char *)xcuid);
   if ((xcuid = Tk_GetOption(tkwind, "localpincolor", "Color")) == NULL)
      xcuid = "Red";
   appdata.localcolor = xc_alloccolor((char *)xcuid);
   if ((xcuid = Tk_GetOption(tkwind, "infolabelcolor", "Color")) == NULL)
      xcuid = "SeaGreen";
   appdata.infocolor = xc_alloccolor((char *)xcuid);
   if ((xcuid = Tk_GetOption(tkwind, "ratsnestcolor", "Color")) == NULL)
      xcuid = "tan4";
   appdata.ratsnestcolor = xc_alloccolor((char *)xcuid);

   if ((xcuid = Tk_GetOption(tkwind, "bboxcolor", "Color")) == NULL)
      xcuid = "greenyellow";
   appdata.bboxpix = xc_alloccolor((char *)xcuid);

   if ((xcuid = Tk_GetOption(tkwind, "paramcolor", "Color")) == NULL)
      xcuid = "Plum3";
   appdata.parampix = xc_alloccolor((char *)xcuid);
   if ((xcuid = Tk_GetOption(tkwind, "auxiliarycolor", "Color")) == NULL)
      xcuid = "Green3";
   appdata.auxpix = xc_alloccolor((char *)xcuid);
   if ((xcuid = Tk_GetOption(tkwind, "axescolor", "Color")) == NULL)
      xcuid = "Antique White";
   appdata.axespix = xc_alloccolor((char *)xcuid);
   if ((xcuid = Tk_GetOption(tkwind, "filtercolor", "Color")) == NULL)
      xcuid = "SteelBlue3";
   appdata.filterpix = xc_alloccolor((char *)xcuid);
   if ((xcuid = Tk_GetOption(tkwind, "querycolor", "Color")) == NULL)
      xcuid = "Turquoise";
   appdata.querypix = xc_alloccolor((char *)xcuid);
   if ((xcuid = Tk_GetOption(tkwind, "selectcolor", "Color")) == NULL)
      xcuid = "Gold3";
   appdata.selectpix = xc_alloccolor((char *)xcuid);
   if ((xcuid = Tk_GetOption(tkwind, "snapcolor", "Color")) == NULL)
      xcuid = "Red";
   appdata.snappix = xc_alloccolor((char *)xcuid);
   if ((xcuid = Tk_GetOption(tkwind, "gridcolor", "Color")) == NULL)
      xcuid = "Gray95";
   appdata.gridpix = xc_alloccolor((char *)xcuid);
   if ((xcuid = Tk_GetOption(tkwind, "pagebackground", "Color")) == NULL)
      xcuid = "White";
   appdata.bg = xc_alloccolor((char *)xcuid);
   if ((xcuid = Tk_GetOption(tkwind, "pageforeground", "Color")) == NULL)
      xcuid = "Black";
   appdata.fg = xc_alloccolor((char *)xcuid);

   if ((xcuid = Tk_GetOption(tkwind, "paramcolor2", "Color")) == NULL)
      xcuid = "Plum3";
   appdata.parampix2 = xc_alloccolor((char *)xcuid);
   if ((xcuid = Tk_GetOption(tkwind, "auxiliarycolor2", "Color")) == NULL)
      xcuid = "Green";
   appdata.auxpix2 = xc_alloccolor((char *)xcuid);
   if ((xcuid = Tk_GetOption(tkwind, "selectcolor2", "Color")) == NULL)
      xcuid = "Gold";
   appdata.selectpix2 = xc_alloccolor((char *)xcuid);
   if ((xcuid = Tk_GetOption(tkwind, "querycolor2", "Color")) == NULL)
      xcuid = "Turquoise";
   appdata.querypix2 = xc_alloccolor((char *)xcuid);
   if ((xcuid = Tk_GetOption(tkwind, "filtercolor2", "Color")) == NULL)
      xcuid = "SteelBlue1";
   appdata.filterpix2 = xc_alloccolor((char *)xcuid);
   if ((xcuid = Tk_GetOption(tkwind, "gridcolor2", "Color")) == NULL)
      xcuid = "Gray40";
   appdata.gridpix2 = xc_alloccolor((char *)xcuid);
   if ((xcuid = Tk_GetOption(tkwind, "snapcolor2", "Color")) == NULL)
      xcuid = "Red";
   appdata.snappix2 = xc_alloccolor((char *)xcuid);
   if ((xcuid = Tk_GetOption(tkwind, "axescolor2", "Color")) == NULL)
      xcuid = "NavajoWhite4";
   appdata.axespix2 = xc_alloccolor((char *)xcuid);
   if ((xcuid = Tk_GetOption(tkwind, "background2", "Color")) == NULL)
      xcuid = "DarkSlateGray";
   appdata.bg2 = xc_alloccolor((char *)xcuid);
   if ((xcuid = Tk_GetOption(tkwind, "foreground2", "Color")) == NULL)
      xcuid = "White";
   appdata.fg2 = xc_alloccolor((char *)xcuid);
   if ((xcuid = Tk_GetOption(tkwind, "barcolor", "Color")) == NULL)
      xcuid = "Tan";
   appdata.barpix = xc_alloccolor((char *)xcuid);
   if ((xcuid = Tk_GetOption(tkwind, "barcolor2", "Color")) == NULL)
      xcuid = "Tan";
   appdata.barpix2 = xc_alloccolor((char *)xcuid);

   /* These are GUI colors---unused by Tcl */
   appdata.buttonpix = xc_alloccolor("Gray85");
   appdata.buttonpix2 = xc_alloccolor("Gray50");

   /* Get some default fonts (Should be using Tk calls here. . . ) */

   if ((xcuid = Tk_GetOption(tkwind, "filelistfont", "Font")) == NULL)
      xcuid = "-*-helvetica-medium-r-normal--14-*";
   appdata.filefont = XLoadQueryFont(dpy, (char *)xcuid);

   if (appdata.filefont == NULL)
   {
      appdata.filefont = XLoadQueryFont(dpy, "-*-*-medium-r-normal--14-*");
      if (appdata.filefont == NULL)
	 appdata.filefont = XLoadQueryFont(dpy, "-*-*-*-*-*--*-*");
   }

   /* Other defaults */

   if ((xcuid = Tk_GetOption(tkwind, "timeout", "TimeOut")) == NULL)
      xcuid = "10";
   appdata.timeout = atoi((char *)xcuid);

   /* Create the filelist window and its event handlers */

   tksb = Tk_NameToWindow(xcinterp, ".filelist.listwin.sb", tktop);
   tkdraw = Tk_NameToWindow(xcinterp, ".filelist.listwin.win", tktop);

   fileliststruct = (popupstruct *) malloc(sizeof(popupstruct));
   fileliststruct->popup = Tk_NameToWindow(xcinterp, ".filelist", tktop);
   fileliststruct->textw = Tk_NameToWindow(xcinterp, ".filelist.textent",
		fileliststruct->popup);
   fileliststruct->filew = tkdraw;
   fileliststruct->scroll = tksb;
   fileliststruct->setvalue = NULL;
   fileliststruct->filter = NULL;

   if (tksb != NULL) {
      Tk_CreateEventHandler(tksb, ButtonMotionMask, 
		(Tk_EventProc *)xctk_draglscroll, (ClientData)fileliststruct);
      Tk_CreateEventHandler(tksb, ExposureMask, 
		(Tk_EventProc *)xctk_showlscroll, (ClientData)tksb);
   }
   if (tkdraw != NULL) {
      Tk_CreateEventHandler(tkdraw, ButtonPressMask, 
		(Tk_EventProc *)xctk_fileselect, (ClientData)fileliststruct);
      Tk_CreateEventHandler(tkdraw, ExposureMask,
		(Tk_EventProc *)xctk_listfiles, (ClientData)fileliststruct);
      Tk_CreateEventHandler(tkdraw, EnterWindowMask, 
		(Tk_EventProc *)xctk_startfiletrack, (ClientData)tkdraw);
      Tk_CreateEventHandler(tkdraw, LeaveWindowMask, 
		(Tk_EventProc *)xctk_endfiletrack, (ClientData)tkdraw);
   }

   /* OpenGL setup */

#ifdef OPENGL

   grVisualInfo = glXChooseVisual(dpy, DefaultScreen(dpy), attributeList);
   grXcontext = glXCreateContext(dpy, grVisualInfo, NULL, GL_FALSE);

   glLineWidth(1.0);
   glShadeModel(GL_FLAT);
   glPixelStorei(GL_PACK_LSB_FIRST, TRUE);
   glMatrixMode(GL_MODELVIEW);
   glLoadIdentity();

   /* Check OpenGL line and point smoothing limits */
   /* glGetFloatv(GL_SMOOTH_LINE_WIDTH_RANGE, params); */
   glGetIntegerv(GL_SMOOTH_LINE_WIDTH_RANGE, params);
   gl_line_limit = (float)params[1];
   Fprintf(stdout, "line limits: %g and %g\n", (float)params[0], gl_line_limit);
   /* glGetFloatv(GL_SMOOTH_POINT_SIZE_RANGE, params); */
   glGetIntegerv(GL_SMOOTH_POINT_SIZE_RANGE, params);
   gl_point_limit = (float)params[1];
   Fprintf(stdout, "point limits: %g and %g\n", (float)params[0], gl_point_limit);
   
#endif /* OPENGL */

#ifdef _MSC_VER
   {
      HWND hParent = GetWindowLong(Tk_GetHWND(win), GWL_HWNDPARENT);
      SetClassLong(hParent, GCL_HICON, (LONG)LoadIcon(GetModuleHandle("xcircuit.dll"), "xcircuit"));
      //SetClassLong(hParent, GCL_HICON, (LONG)LoadIcon(NULL, IDI_APPLICATION));
   }
#endif
}

/*--------------------------------------*/
/* Inline the main wrapper prodedure	*/
/*--------------------------------------*/

int xctcl_start(ClientData clientData, Tcl_Interp *interp,
		int objc, Tcl_Obj *CONST objv[])
{
   FILE *fd;
   char filename[128];
   char *filepath;
   int i, result = TCL_OK;
   Boolean rcoverride = False;
   char *filearg = NULL;

   Fprintf(stdout, "Starting xcircuit under Tcl interpreter\n");

   /* xcircuit initialization routines --- these assume that the */
   /* GUI has been created by the startup script;  otherwise bad */
   /* things will probably occur.				 */

   pre_initialize();
   GUI_init(objc, objv);
   post_initialize();

#ifndef OPENGL
   ghostinit();
#endif

   /* The Tcl version accepts some command-line arguments.  Due	*/
   /* to the way ".wishrc" is processed, all arguments are	*/
   /* glommed into one Tcl (list) object, objv[1].		*/

   if (objc == 2) {
      char **argv;
      int argc;

      Tcl_SplitList(interp, Tcl_GetString(objv[1]), &argc,
		(CONST84 char ***)&argv);
      while (argc) {
         if (**argv == '-') {
	    if (!strncmp(*argv, "-exec", 5)) {
	       if (--argc > 0) {
		  argv++;
	          result = Tcl_EvalFile(interp, *argv);
	          if (result != TCL_OK)
		     return result;
	          else
		     rcoverride = True;
	       }
	       else {
	          Tcl_SetResult(interp, "No filename given to exec argument.", NULL);
	          return TCL_ERROR;
	       }
	    }
	    else if (!strncmp(*argv, "-2", 2)) {
	       /* 2-button mouse bindings option */
	       pressmode = True;
	    }
	 }
	 else filearg = *argv;
	 argv++;
	 argc--;
      }
   }

   if (!rcoverride) loadrcfile();
   composelib(PAGELIB);	/* make sure we have a valid page list */
   composelib(LIBLIB);	/* and library directory */
   if ((objc == 2) && (filearg != NULL)) {
      strcpy(_STR2, filearg);
      startloadfile();
   }
   else {
      findcrashfiles();
   }
   pressmode = False;	/* Done using this to track 2-button bindings */

   /* Note that because the setup has the windows generated and */
   /* mapped prior to calling the xcircuit routines, nothing	*/
   /* gets CreateNotify, MapNotify, or other definitive events.	*/
   /* So, we have to do all the drawing once.			*/

   if (areastruct.scrollbarv)
      drawvbar(areastruct.scrollbarv, NULL, NULL);
   if (areastruct.scrollbarh)
   drawhbar(areastruct.scrollbarh, NULL, NULL);
   drawarea(areastruct.area, NULL, NULL);

   /* Return back to the interpreter; Tk is handling the GUI */
   return XcTagCallback(interp, objc, objv);
}

/*------------------------------------------------------*/
/* Message printing procedures for the Tcl version	*/
/* These subroutines should be replaced with scripts	*/
/*------------------------------------------------------*/

void W0printf(char *string, char *window)
{
    char _STR3[300];
    if (window != NULL) {
       if (*window == '\0')
	  sprintf(_STR3, "puts stdout {%s}", string);
       else
          sprintf(_STR3, "%s config -text {%s}", window, string);
       Tcl_Eval(xcinterp, _STR3);
    }
}

void W1printf(char *string)
{
    W0printf(string, message1);
}

void W2printf(char *string)
{
    W0printf(string, message2);
}

void Wprintf(char *string)
{
    W0printf(string, message3);
}

/*------------------------------------------------------*/

#endif /* defined(TCL_WRAPPER) && !defined(HAVE_PYTHON) */
