xref: /dports/graphics/pgplot/pgplot/drivers/xtk/tkpgplot.c

#include <stdio.h>
#include <stdlib.h>
#include <string.h>

#include <X11/Xlib.h>
#include <X11/Xutil.h>
#include <X11/keysym.h>

#ifdef USE_RIVET
#include "rvpgplot.h"  /* This includes rivet.h (which includes tcl.h & tk.h) */
#else
#include <tk.h>
#include "tkpgplot.h"  /* This includes tcl.h */
#endif

#include "pgxwin.h"

/*
 * VAX VMS includes etc..
 */
#ifdef VMS
#include <descrip.h>
#include <ssdef.h>
typedef struct dsc$descriptor_s VMS_string;
#define VMS_STRING(dsc, string) \
  dsc.dsc$w_length = strlen(string); \
  dsc.dsc$b_dtype = DSC$K_DTYPE_T; \
  dsc.dsc$b_class = DSC$K_CLASS_S; \
  dsc.dsc$a_pointer = string;
#endif

/*
 * Compose the pgplot-callable driver function name.
 * Allow tkdriv to be calleable by FORTRAN using the two commonest
 * calling conventions. Both conventions append length arguments for
 * each FORTRAN string at the end of the argument list, and convert the
 * name to lower-case, but one post-pends an underscore to the function
 * name (PG_PPU) while the other doesn't. Note the VMS is handled
 * separately below. For other calling conventions you must write a
 * C wrapper routine to call tkdriv() or tkdriv_().
 */
#ifdef PG_PPU
#ifdef RIVET
#define DRIV rvdriv_    /* Rivet with PG_PPU defined */
#else
#define DRIV tkdriv_    /* Normal Tk with PG_PPU defined */
#endif
#else
#ifdef RIVET
#define DRIV rvdriv     /* Rivet with PG_PPU undefined */
#else
#define DRIV tkdriv     /* Normal Tk with PG_PPU undefined */
#endif
#endif

/*
 * List widget defaults. Note that the macros that are prefixed
 * TKPG_STR_ are for use in the configSpecs resource database. These
 * have to be strings.
 */
#define TKPG_MIN_WIDTH 64           /* Minimum width (pixels) */

#define TKPG_MIN_HEIGHT 64          /* Minimum height (pixels) */

#define TKPG_DEF_WIDTH 256          /* Default width (pixels) */
#define TKPG_STR_DEF_WIDTH "256"    /* String version of TKPG_DEF_WIDTH */

#define TKPG_DEF_HEIGHT 256         /* Default height (pixels) */
#define TKPG_STR_DEF_HEIGHT "256"   /* String version of TKPG_DEF_HEIGHT */

#define TKPG_MIN_COLORS 2           /* Min number of colors per colormap */
#define TKPG_STR_MIN_COLORS "2"     /* String version of TKPG_MIN_COLORS */

#define TKPG_DEF_COLORS 100         /* Default number of colors to try for */
#define TKPG_STR_DEF_COLORS "100"   /* String version of TKPG_DEF_COLORS */

#define TKPG_MAX_COLORS 255         /* Max number of colors per colormap */

#define TKPG_DEF_HIGHLIGHT_WIDTH 2  /* Default width of traversal highlight */
#define TKPG_STR_DEF_HIGHLIGHT_WIDTH "2"/* String ver of TKPG_DEF_HIGHLIGHT_WIDTH */
#define TKPG_STR_MARGIN_DEF "20"    /* The default number of pixels of */
                                    /*  extra space to allocate around the */
                                    /*  edge of the plot area. */

/*
 * Specify the name to prefix errors with.
 */
#define TKPG_IDENT "PgplotWidget"

typedef struct TkPgplot TkPgplot;

/*
 * Declare a container for a list of PGPLOT widgets.
 */
typedef struct {
  TkPgplot *head;       /* The head of the list of widgets */
} TkPgplotList;

/*
 * A context descriptor for managing parent ScrolledWindow scroll-bars.
 */
typedef struct {
#ifdef RIVET
  Callback xScrollCmd;  /* Rivet X-axis update-scrollbar callback */
  Callback yScrollCmd;  /* Rivet Y-axis update-scrollbar callback */
#else
  char *xScrollCmd;     /* Tcl X-axis scrollbar-update command */
  char *yScrollCmd;     /* Tcl Y-axis scrollbar-update command */
#endif
  unsigned x;           /* Pixmap X coordinate of top left corner of window */
  unsigned y;           /* Pixmap Y coordinate of top left corner of window */
} TkpgScroll;

/*
 * This container records state-values that are modified by X events.
 */
typedef struct {
  unsigned long mask;  /* Event mask registered to tkpg_EventHandler() */
  int focus_acquired;  /* True when we have keyboard-input focus */
  int cursor_active;   /* True when cursor augmentation is active */
} TkpgEvents;

struct TkPgplot {
#ifdef RIVET
  RIVET_CLASS_DECL
#endif
                      /* Widget context */
  Tk_Window tkwin;          /* Tk's window object */
  Display *display;         /* The X display of the window */
  Tcl_Interp *interp;       /* The application's TCL interpreter */
  char buffer[81];          /* A work buffer for constructing result strings */

                      /* Public resource attributes */
  int max_colors;           /* The max number of colors needed */
  int min_colors;           /* The min number of colors needed */
  int req_width;            /* The requested widget width (pixels) */
  int req_height;           /* The requested widget height (pixels) */
  int highlight_thickness;  /* The width of the highlight border */
  XColor *highlightBgColor; /* The inactive traversal highlight color */
  XColor *highlightColor;   /* The active traversal highlight color */
  XColor *normalFg;         /* Normal foreground color (color index 1) */
  Tk_3DBorder border;       /* 3D border structure */
  int borderWidth;          /* The width of the 3D border */
  int relief;               /* Relief of the 3D border */
  char *takeFocus;          /* "1" to allow focus traversal, "0" to disallow */
  Cursor cursor;            /* The active cursor of the window */
  int share;                /* True if shared colors are desired */
  int padx,pady;            /* Extra padding margin widths (pixels) */
                      /* Private attributes */
  TkPgplot *next;           /* The next widget of a list of PGPLOT Xt widgets */
  int tkslct_id;            /* The device ID returned to PGPLOT by the */
                            /* open-workstation driver opcode, and used for */
                            /* subsequent device selection via the */
                            /* select-plot driver opcode */
  int pgslct_id;            /* The device ID returned to the application by */
                            /* pgopen() for subsequent device selection with */
                            /* the pgslct() function */
  char *device;             /* A possible PGPLOT cpgbeg() file string */
  TkpgScroll scroll;        /* Used to maintain parent scroll bars */
  TkpgEvents events;        /* X event context */
  PgxWin *pgx;              /* PGPLOT generic X-window context descriptor */
};

static TkPgplot *new_TkPgplot(Tcl_Interp *interp, Tk_Window main_w, char *name,
			      int argc, char *argv[]);
static TkPgplot *del_TkPgplot(TkPgplot *tkpg);


/*
 * Describe all recognized widget resources.
 */
static Tk_ConfigSpec configSpecs[] = {

  {TK_CONFIG_BORDER,
     "-background", "background", "Background",
     "Black", Tk_Offset(TkPgplot, border), 0},
  {TK_CONFIG_SYNONYM,
     "-bg", "background", (char *) NULL, NULL, 0, 0},

  {TK_CONFIG_COLOR,
     "-foreground", "foreground", "Foreground",
     "White", Tk_Offset(TkPgplot, normalFg), 0},
  {TK_CONFIG_SYNONYM,
     "-fg", "foreground", (char *) NULL, NULL, 0, 0},

  {TK_CONFIG_ACTIVE_CURSOR,
     "-cursor", "cursor", "Cursor",
     "", Tk_Offset(TkPgplot, cursor), TK_CONFIG_NULL_OK},

  {TK_CONFIG_PIXELS,
     "-borderwidth", "borderWidth", "BorderWidth",
     "0", Tk_Offset(TkPgplot, borderWidth), 0},
  {TK_CONFIG_SYNONYM,
     "-bd", "borderWidth", (char *) NULL, NULL, 0, 0},

  {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
     "raised", Tk_Offset(TkPgplot, relief), 0},

  {TK_CONFIG_PIXELS,
     "-height", "height", "Height",
     TKPG_STR_DEF_HEIGHT, Tk_Offset(TkPgplot, req_height), 0},

  {TK_CONFIG_PIXELS,
     "-width", "width", "Width",
     TKPG_STR_DEF_WIDTH, Tk_Offset(TkPgplot, req_width), 0},

  {TK_CONFIG_COLOR,
     "-highlightbackground", "highlightBackground", "HighlightBackground",
     "grey", Tk_Offset(TkPgplot, highlightBgColor), 0},

  {TK_CONFIG_COLOR,
     "-highlightcolor", "highlightColor", "HighlightColor",
     "White", Tk_Offset(TkPgplot, highlightColor), 0},

  {TK_CONFIG_PIXELS,
     "-highlightthickness", "highlightThickness", "HighlightThickness",
     TKPG_STR_DEF_HIGHLIGHT_WIDTH, Tk_Offset(TkPgplot, highlight_thickness), 0},

  {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
     "0", Tk_Offset(TkPgplot, takeFocus), TK_CONFIG_NULL_OK},

#ifdef RIVET
  {TK_CONFIG_CUSTOM,
     "-xscrollcommand", "xScrollCommand", "ScrollCommand",
     0, Tk_Offset(TkPgplot, scroll.xScrollCmd),
     TK_CONFIG_NULL_OK, &rivet_custom_callback_option},
#else
  {TK_CONFIG_STRING,
     "-xscrollcommand", "xScrollCommand", "ScrollCommand",
     "", Tk_Offset(TkPgplot, scroll.xScrollCmd),
     TK_CONFIG_NULL_OK},
#endif

#ifdef RIVET
  {TK_CONFIG_CUSTOM,
     "-yscrollcommand", "yScrollCommand", "ScrollCommand",
     0, Tk_Offset(TkPgplot, scroll.yScrollCmd),
     TK_CONFIG_NULL_OK, &rivet_custom_callback_option},
#else
  {TK_CONFIG_STRING,
     "-yscrollcommand", "yScrollCommand", "ScrollCommand",
     "", Tk_Offset(TkPgplot, scroll.yScrollCmd),
     TK_CONFIG_NULL_OK},
#endif

  {TK_CONFIG_INT,
     "-mincolors", "minColors", "MinColors",
     TKPG_STR_MIN_COLORS, Tk_Offset(TkPgplot, min_colors), 0},

  {TK_CONFIG_INT,
     "-maxcolors", "maxColors", "MaxColors",
     TKPG_STR_DEF_COLORS, Tk_Offset(TkPgplot, max_colors), 0},

  {TK_CONFIG_BOOLEAN,
     "-share", "share", "Share",
     0, Tk_Offset(TkPgplot, share), 0},

  {TK_CONFIG_PIXELS,
     "-padx", "padX", "Pad",
     TKPG_STR_MARGIN_DEF, Tk_Offset(TkPgplot, padx), 0},

  {TK_CONFIG_PIXELS,
     "-pady", "padY", "Pad",
     TKPG_STR_MARGIN_DEF, Tk_Offset(TkPgplot, pady), 0},

  {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
     (char *) NULL, 0, 0}
};

/* Enumerate the PGPLOT class widget lists */

#define TKPG_ACTIVE_WIDGETS 1
#define TKPG_FREE_WIDGETS 2

static TkPgplotList *tkpg_WidgetList(int type);

static TkPgplot *tkpg_FindWidgetByName(char *name, int type, TkPgplot **prev);
static TkPgplot *tkpg_FindWidgetByID(int tkslct_id, int type, TkPgplot **prev);

static TkPgplot *tkpg_RemoveWidget(char *name, int type);
static TkPgplot *tkpg_PrependWidget(TkPgplot *tkpg, int type);
static TkPgplot *tkpg_CurrentWidget(char *context);

static TkPgplot *tkpg_open_widget(char *name);
static TkPgplot *tkpg_close_widget(char *name);

static void tkpg_NewPixmap(PgxWin *pgx, unsigned width, unsigned height);
static void tkpg_update_scroll_bars(TkPgplot *tkpg);
static void tkpg_update_clip(TkPgplot *tkpg);
static void tkpg_update_border(TkPgplot *tkpg);

static int PgplotCmd(ClientData context, Tcl_Interp *interp, int argc,
		     char *argv[]);

static int tkpg_InstanceCommand(ClientData context, Tcl_Interp *interp,
				int argc, char *argv[]);
static int tkpg_InstanceCommand_return(ClientData context, int iret);

static int tkpg_Configure(TkPgplot *tkpg, Tcl_Interp *interp,
			  int argc, char *argv[], int flags);
static void tkpg_expose_handler(TkPgplot *tkpg, XEvent *event);
static void tkpg_draw_focus_highlight(TkPgplot *tkpg);
static void tkpg_draw_3d_border(TkPgplot *tkpg);
static int tkpg_refresh_window(TkPgplot *tkpg);

static void tkpg_ClrCursor(TkPgplot *tkpg);
static void tkpg_EventHandler(ClientData context, XEvent *event);
static void tkpg_CursorHandler(ClientData context, XEvent *event);

static Tk_Window tkpg_toplevel_of_path(Tcl_Interp *interp, Tk_Window main_w,
				       char *path);

/*
 * Enumerate supported pgband() cursor types.
 */
typedef enum {
  TKPG_NORM_CURSOR  = 0, /* Un-augmented X cursor */
  TKPG_LINE_CURSOR  = 1, /* Line cursor between ref and pointer */
  TKPG_RECT_CURSOR  = 2, /* Rectangular cursor between ref and pointer */
  TKPG_YRNG_CURSOR  = 3, /* Two horizontal lines, at ref.x and pointer.x */
  TKPG_XRNG_CURSOR  = 4, /* Two vertical lines, at ref.y and pointer.y */
  TKPG_HLINE_CURSOR = 6, /* Horizontal line cursor at y=ref.y */
  TKPG_VLINE_CURSOR = 5, /* Vertical line cursor at x=ref.x */
  TKPG_CROSS_CURSOR = 7  /* Cross-hair cursor centered on the pointer */
} TkpgCursorMode;

static int tkpg_SetCursor(TkPgplot *tkpg, TkpgCursorMode mode,
		 	  float xref, float yref, int ci);
#ifdef RIVET
static void tkpg_FreeProc(ClientData context);
#else
static void tkpg_FreeProc(char *context);
#endif

static int tkpg_scrollbar_callback(TkPgplot *tkpg, Tcl_Interp *interp,
				   char *widget, char *view, int argc,
				   char *argv[]);
static int tkpg_scrollbar_error(TkPgplot *tkpg, Tcl_Interp *interp,
				char *widget, char *view, int argc,
				char *argv[]);

static int tkpg_tcl_setcursor(TkPgplot *tkpg, Tcl_Interp *interp,
			      int argc, char *argv[]);
static int tkpg_tcl_world(TkPgplot *tkpg, Tcl_Interp *interp,
			  char *widget, int argc, char *argv[]);
static int tkpg_tcl_pixel(TkPgplot *tkpg, Tcl_Interp *interp,
			  char *widget, int argc, char *argv[]);
static int tkpg_tcl_id(TkPgplot *tkpg, Tcl_Interp *interp,
		       char *widget, int argc, char *argv[]);
static int tkpg_tcl_device(TkPgplot *tkpg, Tcl_Interp *interp,
			   char *widget, int argc, char *argv[]);

#ifdef RIVET
static void del_RvPgplot(ClientData obj);

static Rivet_class_struct PgplotClassObj = {
	0,
	"Pgplot",
	PgplotCmd,
	tkpg_InstanceCommand,
	del_RvPgplot,
	0,
	configSpecs,
	0,
};

Rivetclass      PgplotClass = &PgplotClassObj;
#endif

/*
 * The following file-scope container records the list of active and
 * inactive PGPLOT widgets.
 */
static struct {
  int id_counter;              /* Used to give widgets unique identifiers */
  TkPgplotList active_widgets; /* List of active widgets */
  TkPgplotList free_widgets;   /* List of unnassigned widgets */
} tkPgplotClassRec = {
  0,         /* id_counter */
  {NULL},    /* active_widgets */
  {NULL},    /* free_widgets */
};

/*
 * The following macro defines the event mask used by the cursor event
 * handler. It is here to ensure that Tk_CreateEventHandler() and
 * Tk_DeleteEventHandler() are presented with identical event masks.
 */
#define CURSOR_EVENT_MASK ((unsigned long)(EnterWindowMask | LeaveWindowMask | \
					   PointerMotionMask))
/*
 * The following macro defines the event mask normally used by the widget.
 */
#define NORMAL_EVENT_MASK ((unsigned long)(StructureNotifyMask | \
					   ExposureMask | FocusChangeMask))

/*.......................................................................
 * Provide a package initialization procedure. This creates the Tcl
 * "pgplot" widget creation command.
 *
 * Input:
 *  interp  Tcl_Interp *  The TCL interpreter of the application.
 * Output:
 *  return         int    TCL_OK    - Success.
 *                        TCL_ERROR - Failure.
 */
#ifdef RIVET
int Rvpgplot_Init(Tcl_Interp *interp)
#else
int Tkpgplot_Init(Tcl_Interp *interp)
#endif
{
/*
 * Get the main window of the application.
 */
  Tk_Window main_w = Tk_MainWindow(interp);
/*
 * If Tk_Init() hasn't been called, then there won't be a main window
 * yet. In such cases, Tk_MainWindow() places a suitable error message
 * in interp->result.
 */
  if(!main_w)
    return TCL_ERROR;
/*
 * Create the TCL command that is to be used for creating PGPLOT widgets.
 */
  Tcl_CreateCommand(interp, "pgplot", PgplotCmd, (ClientData) main_w, 0);
  return TCL_OK;
}

/*.......................................................................
 * This function provides the TCL command that creates a PGPLOT widget.
 *
 * Input:
 *  context   ClientData    The client_data argument specified in
 *                          TkPgplot_Init() when PgplotCmd was registered.
 *                          This is the main window cast to (ClientData).
 *  interp    Tcl_Interp *  The TCL intrepreter.
 *  argc             int    The number of command arguments.
 *  argv            char ** The array of 'argc' command arguments.
 *                          argv[0] = "pgplot"
 *                          argv[1] = the name to give the new widget.
 *                          argv[2..argc-1] = attribute settings.
 * Output:
 *  return           int    TCL_OK    - Success.
 *                          TCL_ERROR - Failure.
 */
static int PgplotCmd(ClientData context, Tcl_Interp *interp, int argc,
		     char *argv[])
{
  Tk_Window main_tkw = (Tk_Window)context; /* The application main window */
  TkPgplot *tkpg;                          /* The new widget instance object */
/*
 * Make sure that a name for the new widget has been provided.
 */
  if(argc < 2) {
    Tcl_AppendResult(interp, "Wrong number of arguments - should be \'",
		     argv[0], " pathName \?options\?\'", NULL);
    return TCL_ERROR;
  };
/*
 * Allocate the widget-instance object.
 */
  tkpg = new_TkPgplot(interp, main_tkw, argv[1], argc-2, argv+2);
  if(!tkpg)
    return TCL_ERROR;
  return TCL_OK;
}

/*.......................................................................
 * Create a new widget instance object.
 *
 * Input:
 *  interp   Tcl_Interp *  The TCL interpreter object.
 *  main_w    Tk_Window    The main window of the application.
 *  name           char *  The name to give the new widget.
 *  argc            int    The number of argument in argv[]
 *  argv           char ** Any configuration arguments.
 * Output:
 *  return     TkPgplot *  The new PGPLOT widget, or NULL on error.
 *                         If NULL is returned then the context of the
 *                         error will have been recorded in the result
 *                         field of the interpreter.
 */
static TkPgplot *new_TkPgplot(Tcl_Interp *interp, Tk_Window main_w, char *name,
			      int argc, char *argv[])
{
  TkPgplot *tkpg;  /* The new widget object */
  PgxWin *pgx;     /* The PGPLOT X window object of the widget */
  Tk_Window top_w; /* The top-level window parent of 'name' */
/*
 * Get the toplevel window associated with the pathname in 'name'.
 */
  top_w = tkpg_toplevel_of_path(interp, main_w, name);
  if(!top_w)
    return NULL;
/*
 * Allocate the container.
 */
  tkpg = (TkPgplot *) malloc(sizeof(TkPgplot));
  if(!tkpg) {
    Tcl_AppendResult(interp, "Insufficient memory to create ", name, NULL);
    return NULL;
  };
/*
 * Before attempting any operation that might fail, initialize the container
 * at least up to the point at which it can safely be passed to
 * del_TkPgplot().
 */
  tkpg->tkwin = NULL;
  tkpg->display = Tk_Display(main_w);
  tkpg->interp = interp;
  tkpg->max_colors = TKPG_DEF_COLORS;
  tkpg->min_colors = TKPG_MIN_COLORS;
  tkpg->req_width = TKPG_DEF_WIDTH;
  tkpg->req_height = TKPG_DEF_HEIGHT;
  tkpg->highlight_thickness = TKPG_DEF_HIGHLIGHT_WIDTH;
  tkpg->highlightBgColor = NULL;
  tkpg->highlightColor = NULL;
  tkpg->normalFg = NULL;
  tkpg->border = NULL;
  tkpg->borderWidth = 0;
  tkpg->relief = TK_RELIEF_RAISED;
  tkpg->takeFocus = NULL;
  tkpg->cursor = None;
  tkpg->share = 0;
  tkpg->padx = 0;
  tkpg->pady = 0;
  tkpg->next = NULL;
  tkpg->tkslct_id = tkPgplotClassRec.id_counter++;
  tkpg->pgslct_id = 0;
  tkpg->device = NULL;
  tkpg->scroll.xScrollCmd = NULL;
  tkpg->scroll.yScrollCmd = NULL;
  tkpg->scroll.x = 0;
  tkpg->scroll.y = 0;
  tkpg->events.mask = NoEventMask;
  tkpg->events.focus_acquired = 0;
  tkpg->events.cursor_active = 0;
  tkpg->pgx = NULL;
/*
 * Allocate the PGPLOT-window context descriptor.
 */
  pgx = tkpg->pgx = new_PgxWin(tkpg->display, Tk_ScreenNumber(top_w),
			(void *) tkpg, name, 0, tkpg_NewPixmap);
  if(!pgx) {
    Tcl_AppendResult(interp, "Unable to create Pgplot window object for: ",
		     name, NULL);
    return NULL;
  };
/*
 * Compose a sample PGPLOT device-specification for use in opening this
 * widget to PGPLOT.
 */
  tkpg->device = (char *) malloc(sizeof(char) *
				 (strlen(name)+1+strlen(TK_PGPLOT_DEVICE)+1));
  if(!tkpg->device) {
    Tcl_AppendResult(interp, "Insufficient memory for ", name, NULL);
    return NULL;
  };
  sprintf(tkpg->device, "%s/%s", name, TK_PGPLOT_DEVICE);
/*
 * Ensure that the toplevel window parent of the new window exists,
 * before attempting to determine its visual.
 */
  Tk_MakeWindowExist(top_w);
/*
 * Create the widget window from the specified path.
 */
  tkpg->tkwin = Tk_CreateWindowFromPath(interp, main_w, name, NULL);
  if(!tkpg->tkwin)
    return del_TkPgplot(tkpg);
/*
 * Give the widget a class name.
 */
  Tk_SetClass(tkpg->tkwin, "Pgplot");
/*
 * Register an event handler.
 */
  tkpg->events.mask = NORMAL_EVENT_MASK;
  Tk_CreateEventHandler(tkpg->tkwin, tkpg->events.mask, tkpg_EventHandler,
			(ClientData) tkpg);
/*
 * Create the TCL command that will allow users to configure the widget.
 */
  Tcl_CreateCommand(interp, name, tkpg_InstanceCommand, (ClientData) tkpg, 0);
/*
 * Parse command line defaults into tkpg so that tkpg->min_colors,
 * tkpg->max_colors and tkpg->share are known.
 */
  if(Tk_ConfigureWidget(interp, tkpg->tkwin, configSpecs, argc, argv,
			(char *) tkpg, 0) == TCL_ERROR)
    return del_TkPgplot(tkpg);
/*
 * If requested, try to allocate read/write colors.
 * If this fails arrange to try shared colors.
 */
  if(!tkpg->share && !pgx_window_visual(pgx, Tk_WindowId(top_w),
				       tkpg->min_colors, tkpg->max_colors, 0))
    tkpg->share = 1;
/*
 * Allocate shared colors?
 */
  if(tkpg->share) {
    if(!pgx_window_visual(pgx, Tk_WindowId(top_w), tkpg->min_colors,
			tkpg->max_colors, 1)) {
      Tcl_AppendResult(interp, "Unable to allocate any colors for ",name,NULL);
      return del_TkPgplot(tkpg);
    };
  };
/*
 * Force Tk to create the window.
 */
  Tk_MakeWindowExist(tkpg->tkwin);
/*
 * Fill in details about the window in pgx.
 */
  pgx->window = Tk_WindowId(tkpg->tkwin);
/*
 * Create and initialize a graphical context descriptor. This is where
 * Line widths, line styles, fill styles, plot color etc.. are
 * recorded.
 */
  {
    XGCValues gcv;
    gcv.graphics_exposures = False;
    pgx_start_error_watch(pgx);
    pgx->expose_gc = XCreateGC(pgx->display, pgx->window, (unsigned long)
			       (GCGraphicsExposures), &gcv);
    if(pgx_end_error_watch(pgx) || pgx->expose_gc==NULL) {
      Tcl_AppendResult(interp,
	       "Failed to allocate a graphical context for ", name, NULL);
      return del_TkPgplot(tkpg);
    };
  };
/*
 * Parse the command-line arguments again and install the relevant
 * defaults into the color descriptor created by pgx_window_visual().
 */
  if(tkpg_Configure(tkpg, interp, argc, argv, 0))
    return del_TkPgplot(tkpg);
/*
 * If the widget has scroll-bars make sure that they agree with the
 * window.
 */
  tkpg_update_scroll_bars(tkpg);
  tkpg_update_clip(tkpg);
/*
 * Replace the share configuration attribute with the actual
 * value that was acheived.
 */
  tkpg->share = pgx->color->readonly;
/*
 * Prepend the new widget to the list of unassigned widgets to be
 * used by pgbeg().
 */
  tkpg_PrependWidget(tkpg, TKPG_FREE_WIDGETS);
/*
 * Return the widget name.
 */
  Tcl_SetResult(interp, Tk_PathName(tkpg->tkwin), TCL_STATIC);
  return tkpg;
}

/*.......................................................................
 * Delete a TkPgplot widget.
 *
 * Input:
 *  tkpg    TkPgplot *   The widget to be deleted.
 * Output:
 *  return  TkPgplot *   Always NULL.
 */
static TkPgplot *del_TkPgplot(TkPgplot *tkpg)
{
  if(tkpg) {
    if(tkpg->pgx) {
      PgxWin *pgx = tkpg->pgx;
/*
 * Remove the device from the appropriate list of PGPLOT widgets.
 */
      tkpg_RemoveWidget(pgx->name, pgx->state ? TKPG_ACTIVE_WIDGETS :
		                                TKPG_FREE_WIDGETS);
/*
 * Delete the Tcl command attached to the widget.
 */
      Tcl_DeleteCommand(tkpg->interp, pgx->name);
/*
 * Delete the window context descriptor.
 */
      tkpg->pgx = del_PgxWin(tkpg->pgx);
    };
/*
 * Delete the device name string.
 */
    if(tkpg->device)
      free(tkpg->device);
    tkpg->device = NULL;
/*
 * Clear the cursor.
 */
    tkpg_ClrCursor(tkpg);
/*
 * Delete resource values.
 */
    if(tkpg->display)
      Tk_FreeOptions(configSpecs, (char *) tkpg, tkpg->display, 0);
/*
 * Remove the DestroyNotify event handler before destroying the
 * window. Otherwise this function would call itself recursively
 * and pgx would be free'd twice.
 */
    if(tkpg->events.mask != NoEventMask) {
      Tk_DeleteEventHandler(tkpg->tkwin, tkpg->events.mask,
			    tkpg_EventHandler, (ClientData) tkpg);
      tkpg->events.mask = NoEventMask;
    };
/*
 * Zap the window.
 */
    if(tkpg->tkwin) {
      Tk_DestroyWindow(tkpg->tkwin);
      tkpg->tkwin = NULL;
    };
/*
 * Delete the container.
 */
    free(tkpg);
  };
  return NULL;
}

#ifdef RIVET
/*.......................................................................
 * This is a rivet-friendly wrapper around del_TkPgplot().
 */
static void del_RvPgplot(ClientData obj)
{
  del_TkPgplot((TkPgplot *) obj);
}
#endif

/*.......................................................................
 * This function is called upon by the pgxwin toolkit whenever the
 * pixmap used as backing store needs to be resized.
 *
 * Input:
 *  pgx      PgxWin *   The pgxwin toolkit context descriptor.
 *  width  unsigned     The desired new pixmap width.
 *  height unsigned     The desired new pixmap height.
 */
static void tkpg_NewPixmap(PgxWin *pgx, unsigned width, unsigned height)
{
  TkPgplot *tkpg = (TkPgplot *) pgx->context;
/*
 * Reset the scrollbars then hand the job of allocating the
 * pixmap back to the pgxwin toolkit.
 */
  tkpg->scroll.x = 0;
  tkpg->scroll.y = 0;
  tkpg_update_scroll_bars(tkpg);
  pgx_new_pixmap(pgx, width, height);
  return;
}

/*.......................................................................
 * Whenever the size of a pixmap and/or window of a PGPLOT winget are
 * changed, this function should be called to adjust scroll bars.
 *
 * Input:
 *  tkpg     TkPgplot *  The pgplot widget instance.
 */
static void tkpg_update_scroll_bars(TkPgplot *tkpg)
{
  TkpgScroll *scroll = &tkpg->scroll;
#ifndef RIVET
  char scroll_args[60];  /* Scrollbar set-command arguments */
#endif
/*
 * Block widget deletion, so that if one of the scroll-bar callbacks
 * deletes the widget we won't end up using a deleted tkpg pointer.
 */
  Tk_Preserve((ClientData)tkpg);
/*
 * Update the horizontal scroll-bar if there is one.
 */
  if(scroll->xScrollCmd) {
    double pixmap_width = pgx_pixmap_width(tkpg->pgx);
    double first, last;
    if(pixmap_width < 1.0) {
      first = 0.0;
      last = 1.0;
    } else {
      first = scroll->x / pixmap_width;
      last = (scroll->x + Tk_Width(tkpg->tkwin)) / pixmap_width;
    };
#ifdef RIVET
    rivet_scrollbar_update((Rivetobj)tkpg, scroll->xScrollCmd, first, last);
#else
    sprintf(scroll_args, " %f %f", first, last);
    (void) Tcl_VarEval(tkpg->interp, scroll->xScrollCmd, scroll_args, NULL);
#endif
  };
/*
 * Update the vertical scroll-bar if there is one.
 */
  if(scroll->yScrollCmd) {
    double pixmap_height = pgx_pixmap_height(tkpg->pgx);
    double first, last;
    if(pixmap_height < 1.0) {
      first = 0.0;
      last = 1.0;
    } else {
      first = scroll->y / pixmap_height;
      last = (scroll->y + Tk_Height(tkpg->tkwin)) / pixmap_height;
    };
#ifdef RIVET
    rivet_scrollbar_update((Rivetobj)tkpg, scroll->yScrollCmd, first, last);
#else
    sprintf(scroll_args, " %f %f", first, last);
    (void) Tcl_VarEval(tkpg->interp, scroll->yScrollCmd, scroll_args, NULL);
#endif
  };
/*
 * Tell pgplot about the current scroll and pan values.
 */
  pgx_scroll(tkpg->pgx, scroll->x, scroll->y);
/*
 * Unblock widget deletion.
 */
  Tk_Release((ClientData)tkpg);
  return;
}

/*.......................................................................
 * Update the clip-area of the window to prevent pgxwin functions from
 * drawing over the highlight-borders.
 *
 * Input:
 *  tkpg    TkPgplot *  The pgplot widget instance.
 */
static void tkpg_update_clip(TkPgplot *tkpg)
{
  (void) pgx_update_clip(tkpg->pgx, 1, Tk_Width(tkpg->tkwin),
			 Tk_Height(tkpg->tkwin),
			 tkpg->highlight_thickness + tkpg->borderWidth);
}

/*.......................................................................
 * Find an inactive PGPLOT widget of a given name, open it to PGPLOT,
 * and move it to the head of the active list of widgets.
 *
 * Input:
 *  name         char *  The name of the widget to be opened.
 * Output:
 *  tkpg     TkPgplot *  The selected widget, or NULL on error.
 */
static TkPgplot *tkpg_open_widget(char *name)
{
  TkPgplot *tkpg;
/*
 * Remove the named widget from the free-widget list.
 */
  tkpg = tkpg_RemoveWidget(name, TKPG_FREE_WIDGETS);
  if(!tkpg) {
    if(tkpg_FindWidgetByName(name, TKPG_ACTIVE_WIDGETS, NULL)) {
      fprintf(stderr, "%s: Widget %s is already open.\n", TKPG_IDENT, name);
    } else {
      fprintf(stderr, "%s: Can't open non-existent widget (%s).\n",
	      TKPG_IDENT, name ? name : "(null)");
    };
    return NULL;
  };
/*
 * Pre-pend the widget to the active list.
 */
  tkpg_PrependWidget(tkpg, TKPG_ACTIVE_WIDGETS);
/*
 * Open the connection to the PgxWin library.
 */
  pgx_open(tkpg->pgx);
  if(!tkpg->pgx->state)
    tkpg_close_widget(name);
/*
 * Reset the background and foreground colors to match the current
 * configuration options.
 */
  pgx_set_background(tkpg->pgx, Tk_3DBorderColor(tkpg->border));
  pgx_set_foreground(tkpg->pgx, tkpg->normalFg);
/*
 * Reset its scroll-bars.
 */
  tkpg_update_scroll_bars(tkpg);
  return tkpg;
}

/*.......................................................................
 * Find an active PGPLOT widget of a given name, close it to PGPLOT and
 * move it to the head of the inactive list of widgets.
 *
 * Input:
 *  name       char *  The name of the widget.
 * Output:
 *  return TkPgplot *  The selected widget, or NULL if not found.
 */
static TkPgplot *tkpg_close_widget(char *name)
{
  TkPgplot *tkpg;
/*
 * Remove the widget from the active list.
 */
  tkpg = tkpg_RemoveWidget(name, TKPG_ACTIVE_WIDGETS);
  if(!tkpg) {
    fprintf(stderr, "%s: Request to close non-existent widget (%s).\n",
	    TKPG_IDENT, name ? name : "(null)");
    return NULL;
  };
/*
 * Remove cursor handler.
 */
  tkpg_ClrCursor(tkpg);
/*
 * Close the connection to the PgxWin library.
 */
  pgx_close(tkpg->pgx);
/*
 * Invalidate the pgslct() id. The next time that the widget is opened
 * to PGPLOT a different value will likely be used.
 */
  tkpg->pgslct_id = 0;
/*
 * Prepend the widget to the free list.
 */
  tkpg_PrependWidget(tkpg, TKPG_FREE_WIDGETS);
  return tkpg;
}

/*.......................................................................
 * Lookup a widget by name from a given list of widgets.
 *
 * Input:
 *  name       char *  The name of the widget.
 *  type        int    The enumerated name of the list to search,
 *                     from:
 *                       TKPG_ACTIVE_WIDGETS
 *                       TKPG_FREE_WIDGETS
 * Output:
 *  prev   TkPgplot ** *prev will either be NULL if the widget
 *                     was at the head of the list, or be the
 *                     widget in the list that immediately precedes
 *                     the specified widget.
 *  return TkPgplot *  The located widget, or NULL if not found.
 */
static TkPgplot *tkpg_FindWidgetByName(char *name, int type, TkPgplot **prev)
{
  TkPgplotList *widget_list; /* The list to be searched */
  widget_list = tkpg_WidgetList(type);
  if(widget_list && name) {
    TkPgplot *last = NULL;
    TkPgplot *node = widget_list->head;
    for( ; node; last = node, node = node->next) {
      if(strcmp(node->pgx->name, name)==0) {
	if(prev)
	  *prev = last;
	return node;
      };
    };
  };
/*
 * Widget not found.
 */
  if(prev)
    *prev = NULL;
  return NULL;
}

/*.......................................................................
 * Lookup a widget by its PGPLOT id from a given list of widgets.
 *
 * Input:
 *  tkslct_id   int    The number used by PGPLOT to select the
 *                     device.
 *  type        int    The enumerated name of the list to search,
 *                     from:
 *                       TKPG_ACTIVE_WIDGETS
 *                       TKPG_FREE_WIDGETS
 * Output:
 *  prev   TkPgplot ** *prev will either be NULL if the widget
 *                     was at the head of the list, or be the
 *                     widget in the list that immediately precedes
 *                     the specified widget.
 *  return TkPgplot *  The located widget, or NULL if not found.
 */
static TkPgplot *tkpg_FindWidgetByID(int tkslct_id, int type, TkPgplot **prev)
{
  TkPgplotList *widget_list; /* The list to be searched */
  widget_list = tkpg_WidgetList(type);
  if(widget_list) {
    TkPgplot *last = NULL;
    TkPgplot *node = widget_list->head;
    for( ; node; last = node, node = node->next) {
      if(tkslct_id == node->tkslct_id) {
	if(prev)
	  *prev = last;
	return node;
      };
    };
  };
/*
 * Widget not found.
 */
  if(prev)
    *prev = NULL;
  return NULL;
}

/*.......................................................................
 * Lookup one of the PGPLOT class widget lists by its enumerated type.
 *
 * Input:
 *  type            int   The enumerated name of the list, from:
 *                          TKPG_ACTIVE_WIDGETS
 *                          TKPG_FREE_WIDGETS
 * Output:
 *  return TkPgplotList * The widget list, or NULL if not recognized.
 */
static TkPgplotList *tkpg_WidgetList(int type)
{
  switch(type) {
  case TKPG_ACTIVE_WIDGETS:
    return &tkPgplotClassRec.active_widgets;
  case TKPG_FREE_WIDGETS:
    return &tkPgplotClassRec.free_widgets;
  default:
    fprintf(stderr, "tkpg_WidgetList: No such list.\n");
  };
  return NULL;
}

/*.......................................................................
 * Remove a given widget from one of the PGPLOT class widget lists.
 *
 * Input:
 *  name       char *  The name of the widget to be removed from
 *                     the list.
 *  type        int    The enumerated name of the list from which to
 *                     remove the widget, from:
 *                       TKPG_ACTIVE_WIDGETS
 *                       TKPG_FREE_WIDGETS
 * Output:
 *  return TkPgplot *  The removed widget, or NULL if not found.
 */
static TkPgplot *tkpg_RemoveWidget(char *name, int type)
{
  TkPgplotList *widget_list; /* The list to remove the widget from */
  TkPgplot *tkpg = NULL;     /* The widget being removed */
  TkPgplot *prev;            /* The widget preceding tkpg in the list */
/*
 * Get the widget list.
 */
  widget_list = tkpg_WidgetList(type);
  if(widget_list) {
    tkpg = tkpg_FindWidgetByName(name, type, &prev);
    if(tkpg) {
      if(prev) {
	prev->next = tkpg->next;
      } else {
	widget_list->head = tkpg->next;
      };
      tkpg->next = NULL;
    };
  };
  return tkpg;
}

/*.......................................................................
 * Prepend a PGPLOT widget to a given PGPLOT class widget list.
 *
 * Input:
 *  tkpg   TkPgplot *  The widget to add to the list.
 *  type        int    The enumerated name of the list to add to, from:
 *                       TKPG_ACTIVE_WIDGETS
 *                       TKPG_FREE_WIDGETS
 * Output:
 *  return TkPgplot *  The added widget (the same as tkpg), or NULL
 *                     on error.
 */
static TkPgplot *tkpg_PrependWidget(TkPgplot *tkpg, int type)
{
  TkPgplotList *widget_list;  /* The list to prepend the widget to */
/*
 * Get the widget list.
 */
  widget_list = tkpg_WidgetList(type);
  if(widget_list) {
    tkpg->next = widget_list->head;
    widget_list->head = tkpg;
  };
  return tkpg;
}

/*.......................................................................
 * Return the currently selected PGPLOT device.
 *
 * Input:
 *  context     char *  If no TkPgplot device is currently selected
 *                      and context!=NULL then, an error message of
 *                      the form printf("%s: ...\n", context) will
 *                      be written to stderr reporting that no
 *                      device is open.
 * Output:
 *  return  TkPgplot *  The currently selected PGPLOT device, or
 *                      NULL if no device is currently selected.
 */
static TkPgplot *tkpg_CurrentWidget(char *context)
{
  TkPgplot *tkpg = tkPgplotClassRec.active_widgets.head;
  if(!tkpg && context)
    fprintf(stderr, "%s: No /%s device is currently selected.\n", context,
	    TK_PGPLOT_DEVICE);
  return tkpg;
}

/*.......................................................................
 * This is the only external entry point to the tk device driver.
 * It is called by PGPLOT to open, perform operations on, return
 * information about and close tk windows.
 *
 * Input:
 *  ifunc   int *  The PGPLOT operation code to be executed.
 * Input/output:
 *  rbuf  float *  A general buffer for input/output of float values.
 *  nbuf    int *  Where relevant this is used to return the number of
 *                 elements in rbuf[]. Also used on input to specify
 *                 number of pixels in the line-of-pixels primitive.
 *  chr    char *  A general buffer for string I/O.
 *  lchr    int *  Where relevant this is used to send and return the
 *                 number of significant characters in chr.
 * Input:
 *  len     int    Added to the call line by the FORTRAN compiler.
 *                 This contains the declared size of chr[].
 */
#ifdef VMS
void DRIV(ifunc, rbuf, nbuf, chrdsc, lchr)
     int *ifunc;
     float rbuf[];
     int *nbuf;
     struct dsc$descriptor_s *chrdsc; /* VMS FORTRAN string descriptor */
     int *lchr;
{
  int len = chrdsc->dsc$w_length;
  char *chr = chrdsc->dsc$a_pointer;
#else
void DRIV(ifunc, rbuf, nbuf, chr, lchr, len)
 int   *ifunc, *nbuf, *lchr;
 int   len;
 float rbuf[];
 char  *chr;
{
#endif
/*
 * Get the active widget if there is one.
 */
  TkPgplot *tkpg = tkpg_CurrentWidget(NULL);
  PgxWin *pgx = tkpg ? tkpg->pgx : NULL;
  int i;
/*
 * Flush buffered opcodes.
 */
  pgx_pre_opcode(pgx, *ifunc);
/*
 * Branch on the specified PGPLOT opcode.
 */
  switch(*ifunc) {

/*--- IFUNC=1, Return device name ---------------------------------------*/

  case 1:
    {
      char *dev_name = TK_PGPLOT_DEVICE " (widget_path/" TK_PGPLOT_DEVICE ")";
      strncpy(chr, dev_name, len);
      *lchr = strlen(dev_name);
      for(i = *lchr; i < len; i++)
	chr[i] = ' ';
    };
    break;

/*--- IFUNC=2, Return physical min and max for plot device, and range
               of color indices -----------------------------------------*/
  case 2:
    rbuf[0] = 0.0;
    rbuf[1] = -1.0;  /* Report no effective max plot width */
    rbuf[2] = 0.0;
    rbuf[3] = -1.0;  /* Report no effective max plot height */
    rbuf[4] = 0.0;
    rbuf[5] = (pgx && !pgx->bad_device) ? pgx->color->ncol-1 : 1;
    *nbuf = 6;
    break;

/*--- IFUNC=3, Return device resolution ---------------------------------*/

  case 3:
    pgx_get_resolution(pgx, &rbuf[0], &rbuf[1]);
    rbuf[2] = 1.0;		/* Device coordinates per pixel */
    *nbuf = 3;
    break;

/*--- IFUNC=4, Return misc device info ----------------------------------*/

  case 4:
    chr[0] = 'I'; /* Interactive device */
    chr[1] = 'X'; /* Cursor is available and opcode 27 is desired */
    chr[2] = 'N'; /* No dashed lines */
    chr[3] = 'A'; /* Area fill available */
    chr[4] = 'T'; /* Thick lines */
    chr[5] = 'R'; /* Rectangle fill available */
    chr[6] = 'P'; /* Line of pixels available */
    chr[7] = 'N'; /* Don't prompt on pgend */
    chr[8] = 'Y'; /* Can return color representation */
    chr[9] = 'N'; /* Not used */
    chr[10]= 'S'; /* Area-scroll available */
    *lchr = 11;
    break;

/*--- IFUNC=5, Return default file name ---------------------------------*/

  case 5:
    chr[0] = '\0';  /* Default name is "" */
    *lchr = 0;
    break;

/*--- IFUNC=6, Return default physical size of plot ---------------------*/

  case 6:
    pgx_def_size(pgx, Tk_Width(tkpg->tkwin), Tk_Height(tkpg->tkwin), rbuf, nbuf);
    break;

/*--- IFUNC=7, Return misc defaults -------------------------------------*/

  case 7:
    rbuf[0] = 1.0;
    *nbuf = 1;
    break;

/*--- IFUNC=8, Select plot ----------------------------------------------*/

  case 8:
    {
      TkPgplot *new_tkpg = tkpg_FindWidgetByID((int)(rbuf[1]+0.5),
					   TKPG_ACTIVE_WIDGETS, NULL);
      if(new_tkpg) {
	new_tkpg->pgslct_id = (int) (rbuf[0]+0.5);
	tkpg_RemoveWidget(new_tkpg->pgx->name, TKPG_ACTIVE_WIDGETS);
	tkpg_PrependWidget(new_tkpg, TKPG_ACTIVE_WIDGETS);
      } else {
	fprintf(stderr, "%s: [Select plot] No such open device.\n", TKPG_IDENT);
      };
    };
    break;

/*--- IFUNC=9, Open workstation -----------------------------------------*/

  case 9:
/*
 * Assign the returned device unit number and success indicator.
 * Assume failure to open until the workstation is open.
 */
    rbuf[0] = rbuf[1] = 0.0;
    *nbuf = 2;
/*
 * Prepare the display name.
 */
    if(*lchr >= len) {
      fprintf(stderr, "%s: Widget name too long.\n", TKPG_IDENT);
      return;
    } else {
      chr[*lchr] = '\0';
    };
/*
 * Get the requested widget from the free widget list.
 */
    tkpg = tkpg_open_widget(chr);
    if(!tkpg)
      return;
    rbuf[0] = tkpg->tkslct_id; /* The number used to select this device */
    rbuf[1] = 1.0;
    *nbuf = 2;
    break;

/*--- IFUNC=10, Close workstation ---------------------------------------*/

  case 10:
/*
 * Remove the device from the list of open devices.
 */
    if(pgx)
      tkpg_close_widget(pgx->name);
    break;

/*--- IFUNC=11, Begin picture -------------------------------------------*/

  case 11:
    pgx_begin_picture(pgx, rbuf);
    break;

/*--- IFUNC=12, Draw line -----------------------------------------------*/

  case 12:
    pgx_draw_line(pgx, rbuf);
    break;

/*--- IFUNC=13, Draw dot ------------------------------------------------*/

  case 13:
    pgx_draw_dot(pgx, rbuf);
    break;

/*--- IFUNC=14, End picture ---------------------------------------------*/

  case 14:
    break;

/*--- IFUNC=15, Select color index --------------------------------------*/

  case 15:
    pgx_set_ci(pgx, (int) (rbuf[0] + 0.5));
    break;

/*--- IFUNC=16, Flush buffer. -------------------------------------------*/

  case 16:
    pgx_flush(pgx);
    break;

/*--- IFUNC=17, Read cursor. --------------------------------------------*/

  case 17:
    if(tkpg)
      tkpg_ClrCursor(tkpg);
    pgx_read_cursor(pgx, rbuf, chr, nbuf, lchr);
    break;

/*--- IFUNC=18, Erase alpha screen. -------------------------------------*/
  /* (Not implemented: no alpha screen) */
  case 18:
    break;

/*--- IFUNC=19, Set line style. -----------------------------------------*/
  /* (Not implemented: should not be called) */
  case 19:
    break;

/*--- IFUNC=20, Polygon fill. -------------------------------------------*/

  case 20:
    pgx_poly_fill(pgx, rbuf);
    break;

/*--- IFUNC=21, Set color representation. -------------------------------*/

  case 21:
    {
      int ci = (int)(rbuf[0]+0.5);
      pgx_set_rgb(pgx, ci, rbuf[1],rbuf[2],rbuf[3]);
      if(ci==0)
	tkpg_update_border(tkpg);
    };
    break;

/*--- IFUNC=22, Set line width. -----------------------------------------*/

  case 22:
    pgx_set_lw(pgx, rbuf[0]);
    break;

/*--- IFUNC=23, Escape --------------------------------------------------*/
    /* (Not implemented: ignored) */
  case 23:
    break;

/*--- IFUNC=24, Rectangle Fill. -----------------------------------------*/

  case 24:
    pgx_rect_fill(pgx, rbuf);
    break;

/*--- IFUNC=25, ---------------------------------------------------------*/
  /* (Not implemented: ignored) */
  case 25:
    break;

/*--- IFUNC=26, Line of pixels ------------------------------------------*/

  case 26:
    pgx_pix_line(pgx, rbuf, nbuf);
    break;

/*--- IFUNC=27, World-coordinate scaling --------------------------------*/

  case 27:
    pgx_set_world(pgx, rbuf);
    break;

/*--- IFUNC=29, Query color representation ------------------------------*/
  case 29:
    pgx_get_rgb(pgx, rbuf, nbuf);
    break;

/*--- IFUNC=30, Scroll rectangle ----------------------------------------*/
  case 30:
    pgx_scroll_rect(pgx, rbuf);
    break;

/*--- IFUNC=?, ----------------------------------------------------------*/

  default:
    fprintf(stderr, "%s: Ignoring unimplemented opcode=%d.\n",
	    TKPG_IDENT, *ifunc);
    *nbuf = -1;
    break;
  };
  return;
}

/*.......................................................................
 * This function services TCL commands for a given widget.
 *
 * Input:
 *  context   ClientData    The tkpg widget cast to (ClientData).
 *  interp    Tcl_Interp *  The TCL intrepreter.
 *  argc             int    The number of command arguments.
 *  argv            char ** The array of 'argc' command arguments.
 * Output:
 *  return           int    TCL_OK    - Success.
 *                          TCL_ERROR - Failure.
 */
static int tkpg_InstanceCommand(ClientData context, Tcl_Interp *interp,
			       int argc, char *argv[])
{
  TkPgplot *tkpg = (TkPgplot *) context;
  char *widget;     /* The name of the widget */
  char *command;    /* The name of the command */
/*
 * Get the name of the widget.
 */
  widget = argv[0];
/*
 * Get the name of the command.
 */
  if(argc < 2) {
    Tcl_AppendResult(interp, "Missing arguments to ", widget, " command.",
		     NULL);
    return TCL_ERROR;
  };
  command = argv[1];
/*
 * Prevent untimely deletion of the widget while this function runs.
 * Note that following this statement you must return via
 * tkpg_InstanceCommand_return() to ensure that Tk_Release() gets called.
 */
  Tk_Preserve(context);
/*
 * Check for recognized command names.
 */
  if(strcmp(command, "xview") == 0) {             /* X-axis scroll-bar update */
    return tkpg_InstanceCommand_return(context,
		      tkpg_scrollbar_callback(tkpg, interp, widget, command,
					      argc-2, argv+2));
  } else if(strcmp(command, "yview") == 0) {      /* Y-axis scroll-bar update */
    return tkpg_InstanceCommand_return(context,
		      tkpg_scrollbar_callback(tkpg, interp, widget, command,
					      argc-2, argv+2));
  } else if(strcmp(command, "configure") == 0) {  /* Configure widget */
/*
 * Check the number of configure arguments.
 */
    switch(argc - 2) {
    case 0:   /* Return the values of all configuration options */
      return tkpg_InstanceCommand_return(context,
			Tk_ConfigureInfo(interp, tkpg->tkwin, configSpecs,
					 (char *) tkpg, NULL, 0));
      break;
    case 1:   /* Return the value of a single given configuration option */
      return tkpg_InstanceCommand_return(context,
		        Tk_ConfigureInfo(interp, tkpg->tkwin, configSpecs,
					 (char *) tkpg, argv[2], 0));
      break;
    default:  /* Change one of more of the configuration options */
      return tkpg_InstanceCommand_return(context,
			tkpg_Configure(tkpg, interp, argc-2, argv+2,
				       TK_CONFIG_ARGV_ONLY));
      break;
    };
  } else if(strcmp(command, "cget") == 0) {  /* Get a configuration value */
    if(argc != 3) {
      Tcl_AppendResult(interp, "Wrong number of arguments to \"", widget,
		       " cget\" command", NULL);
      return tkpg_InstanceCommand_return(context, TCL_ERROR);
    } else {
      return tkpg_InstanceCommand_return(context,
			Tk_ConfigureValue(interp, tkpg->tkwin, configSpecs,
					  (char *) tkpg, argv[2], 0));
    };
  } else if(strcmp(command, "setcursor") == 0) { /* Augment the cursor */
    return tkpg_InstanceCommand_return(context,
			tkpg_tcl_setcursor(tkpg, interp, argc - 2, argv + 2));
  } else if(strcmp(command, "clrcursor") == 0) { /* Clear cursor augmentation */
    tkpg_ClrCursor(tkpg);
    return tkpg_InstanceCommand_return(context, TCL_OK);
  } else if(strcmp(command, "world") == 0) {  /* Pixel to world coordinates */
    return tkpg_InstanceCommand_return(context,
				       tkpg_tcl_world(tkpg, interp, widget,
						      argc-2, argv+2));
  } else if(strcmp(command, "pixel") == 0) {  /* World to pixel coordinates */
    return tkpg_InstanceCommand_return(context,
				       tkpg_tcl_pixel(tkpg, interp, widget,
						      argc-2, argv+2));
  } else if(strcmp(command, "id") == 0) {     /* PGPLOT id of widget */
    return tkpg_InstanceCommand_return(context,
				       tkpg_tcl_id(tkpg, interp, widget,
						   argc-2, argv+2));
  } else if(strcmp(command, "device") == 0) { /* PGPLOT name for the widget */
    return tkpg_InstanceCommand_return(context,
				       tkpg_tcl_device(tkpg, interp, widget,
						       argc-2, argv+2));
  };
/*
 * Unknown command name.
 */
  Tcl_AppendResult(interp, "Unknown command \"", widget, " ", command, "\"",
		   NULL);
  return tkpg_InstanceCommand_return(context, TCL_ERROR);
}

/*.......................................................................
 * This is a private cleanup-return function of tkpg_InstanceCommand().
 * It should be used to return from said function after Tk_Preserve() has
 * been called. It calls Tk_Release() on the widget to unblock deletion
 * and returns the specified error code.
 *
 * Input:
 *  context   ClientData    The tkpg widget cast to (ClientData).
 *  iret             int    TCL_OK or TCL_ERROR.
 * Output:
 *  return           int    The value of iret.
 */
static int tkpg_InstanceCommand_return(ClientData context, int iret)
{
  Tk_Release(context);
  return iret;
}

/*.......................................................................
 * This function is services TCL commands for a given widget.
 *
 * Input:
 *  tkpg        TkPgplot *  The widget record to be configured.
 *  interp    Tcl_Interp *  The TCL intrepreter.
 *  argc             int    The number of configuration arguments.
 *  argv            char ** The array of 'argc' configuration arguments.
 *  flags            int    The flags argument of Tk_ConfigureWidget():
 *                           0                - No flags.
 *                           TK_CONFIG_ARGV   - Override the X defaults
 *                                              database and the configSpecs
 *                                              defaults.
 * Output:
 *  return           int    TCL_OK    - Success.
 *                          TCL_ERROR - Failure.
 */
static int tkpg_Configure(TkPgplot *tkpg, Tcl_Interp *interp,
			  int argc, char *argv[], int flags)
{
/*
 * Get the X-window pgplot object.
 */
  PgxWin *pgx = tkpg->pgx;
/*
 * Install the new defaults in tkpg.
 */
  if(Tk_ConfigureWidget(interp, tkpg->tkwin, configSpecs, argc, argv,
			(char *) tkpg, flags) == TCL_ERROR)
    return TCL_ERROR;
/*
 * Install the background color in PGPLOT color-index 0.
 */
  pgx_set_background(pgx, Tk_3DBorderColor(tkpg->border));
/*
 * Install the foreground color in PGPLOT color-index 1.
 */
  pgx_set_foreground(pgx, tkpg->normalFg);
/*
 * Install changes to window attributes.
 */
  {
    XSetWindowAttributes attr;  /* The attribute-value container */
    unsigned long mask = 0;     /* The set of attributes that have changed */
    attr.background_pixel = pgx->color->pixel[0];
    mask |= CWBackPixel;
    attr.colormap = pgx->color->cmap;
    mask |= CWColormap;
    attr.border_pixel = pgx->color->pixel[0];
    mask |= CWBorderPixel;
    attr.do_not_propagate_mask = ButtonPressMask | ButtonReleaseMask |
      KeyPressMask | KeyReleaseMask;
    mask |= CWDontPropagate;
    Tk_ChangeWindowAttributes(tkpg->tkwin, mask, &attr);
  };
/*
 * Tell Tk what window size we want.
 */
  Tk_GeometryRequest(tkpg->tkwin, tkpg->req_width, tkpg->req_height);
/*
 * Tell pgxwin that the clip margin may have changed.
 */
  tkpg_update_clip(tkpg);
/*
 * Update the optional window margins.
 */
  pgx_set_margin(pgx, tkpg->padx, tkpg->pady);
/*
 * Refresh the window.
 */
  tkpg_refresh_window(tkpg);
  return TCL_OK;
}

/*.......................................................................
 * This is the main X event callback for Pgplot widgets.
 *
 * Input:
 *  context   ClientData    The tkpg widget cast to (ClientData).
 *  event         XEvent *  The event that triggered the callback.
 */
static void tkpg_EventHandler(ClientData context, XEvent *event)
{
  TkPgplot *tkpg = (TkPgplot *) context;
/*
 * Determine what type of event triggered this call.
 */
  switch(event->type) {
  case ConfigureNotify:   /* The window has been resized */
    tkpg->scroll.x = 0;
    tkpg->scroll.y = 0;
    tkpg_update_clip(tkpg);
    tkpg_update_scroll_bars(tkpg);
    tkpg_refresh_window(tkpg);
    break;
  case DestroyNotify:     /* The window has been destroyed */
/*
 * Delete the cursor event handler to prevent further use by user.
 */
    tkpg_ClrCursor(tkpg);
/*
 * Delete the main event handler to prevent prolonged use.
 */
    Tk_DeleteEventHandler(tkpg->tkwin, tkpg->events.mask, tkpg_EventHandler,
			  (ClientData) tkpg);
/*
 * Tell del_TkPgplot() that we have already deleted the event mask.
 */
    tkpg->events.mask = NoEventMask;
/*
 * Force the functions in pgxwin.c to discard subsequent graphics.
 */
    if(tkpg->pgx)
      tkpg->pgx->window = None;
/*
 * Queue deletion of tkpg until all references to the widget have been
 * completed.
 */
    Tk_EventuallyFree(context, tkpg_FreeProc);
    break;
  case FocusIn:           /* Keyboard-input focus has been acquired */
    tkpg->events.focus_acquired = 1;
    tkpg_draw_focus_highlight(tkpg);
    break;
  case FocusOut:          /* Keyboard-input focus has been lost */
    tkpg->events.focus_acquired = 0;
    tkpg_draw_focus_highlight(tkpg);
    break;
  case Expose:            /* Redraw the specified area */
    tkpg_expose_handler(tkpg, event);
    break;
  };
  return;
}

/*.......................................................................
 * The expose-event handler for PGPLOT widgets.
 *
 * Input:
 *  tkpg   TkPgplot * The Tk Pgplot widget.
 *  event    XEvent   The expose event that invoked the callback.
 */
static void tkpg_expose_handler(TkPgplot *tkpg, XEvent *event)
{
/*
 * Re-draw the focus-highlight border.
 */
  tkpg_draw_focus_highlight(tkpg);
/*
 * Re-draw the 3D borders.
 */
  tkpg_draw_3d_border(tkpg);
/*
 * Re-draw the damaged area.
 */
  pgx_expose(tkpg->pgx, event);
  return;
}

/*.......................................................................
 * Re-draw the focus highlight border if it has a finite size.
 *
 * Input:
 *  tkpg    TkPgplot * The Tk Pgplot widget.
 */
static void tkpg_draw_focus_highlight(TkPgplot *tkpg)
{
  Window w = Tk_WindowId(tkpg->tkwin);
/*
 * Re-draw the focus-highlight border.
 */
  if(tkpg->highlight_thickness != 0) {
    GC gc = Tk_GCForColor(tkpg->events.focus_acquired ?
			  tkpg->highlightColor : tkpg->highlightBgColor,
			  w);
    Tk_DrawFocusHighlight(tkpg->tkwin, gc, tkpg->highlight_thickness, w);
  };
  return;
}

/*.......................................................................
 * Re-draw the 3D border if necessary.
 *
 * Input:
 *  tkpg    TkPgplot * The Tk Pgplot widget.
 */
static void tkpg_draw_3d_border(TkPgplot *tkpg)
{
  Tk_Window tkwin = tkpg->tkwin;
  Window w = Tk_WindowId(tkwin);
/*
 * Re-draw the focus-highlight border.
 */
  if(tkpg->border && tkpg->borderWidth > 0) {
    int margin = tkpg->highlight_thickness;
    Tk_Draw3DRectangle(tkwin, w, tkpg->border, margin, margin,
		       Tk_Width(tkwin) - 2*margin, Tk_Height(tkwin) - 2*margin,
		       tkpg->borderWidth, tkpg->relief);
  };
  return;
}

/*.......................................................................
 * Augment the cursor of a given widget.
 *
 * Input:
 *  tkpg       TkPgplot * The PGPLOT widget to connect a cursor to.
 *  mode TkpgCursorMode   The type of cursor augmentation.
 *  xref,yref     float   The world-coordinate reference point for band-type
 *                        cursors.
 *  ci              int   The color index with which to plot the cursor,
 *                        or -1 to select the current foreground color.
 * Output:
 *  return          int   TCL_OK or TCL_ERROR.
 */
static int tkpg_SetCursor(TkPgplot *tkpg, TkpgCursorMode mode,
			  float xref, float yref, int ci)
{
  PgxWin *pgx = tkpg->pgx;
  float rbuf[2];
/*
 * Remove any existing cursor augmentation.
 */
  tkpg_ClrCursor(tkpg);
/*
 * Mark the cursor as active.
 */
  tkpg->events.cursor_active = 1;
/*
 * Convert xref, yref from world coordinates to device coordinates.
 */
  rbuf[0] = xref;
  rbuf[1] = yref;
  pgx_world2dev(pgx, rbuf);
/*
 * Raise the cursor.
 */
  if(pgx_set_cursor(pgx, ci, (int)mode, 0, rbuf, rbuf)) {
    Tcl_AppendResult(tkpg->interp, "Unable to display cursor.\n", NULL);
    tkpg_ClrCursor(tkpg);
    return TCL_ERROR;
  };
/*
 * If the pointer is currently in the window, record its position
 * and draw the cursor.
 */
  if(pgx_locate_cursor(pgx))
    pgx_draw_cursor(pgx);
/*
 * Create an event handler to handle asychronous cursor input.
 */
  Tk_CreateEventHandler(tkpg->tkwin, CURSOR_EVENT_MASK,
			tkpg_CursorHandler, (ClientData) tkpg);
  return TCL_OK;
}

/*.......................................................................
 * This is the X event callback for Pgplot cursor events. It is called
 * only when the cursor augmentation has been established by
 * tkpg_SetCursor() and not cleared by tkpg_ClrCursor().
 *
 * Input:
 *  context   ClientData    The tkpg widget cast to (ClientData).
 *  event         XEvent *  The event that triggered the callback.
 */
static void tkpg_CursorHandler(ClientData context, XEvent *event)
{
  TkPgplot *tkpg = (TkPgplot *) context;
  PgxWin *pgx = tkpg->pgx;
  float rbuf[2];
  char key;
/*
 * Handle the event. Note that button-press and keyboard events
 * have not been selected so the return values are irrelevent.
 */
  (void) pgx_cursor_event(pgx, event, rbuf, &key);
/*
 * Handle errors.
 */
  if(pgx->bad_device)
    tkpg_ClrCursor(tkpg);
  return;
}

/*.......................................................................
 * Clear the cursor of a given widget.
 *
 *  tkpg  TkPgplot * The widget to disconnect the cursor from.
 */
static void tkpg_ClrCursor(TkPgplot *tkpg)
{
  if(tkpg) {
    PgxWin *pgx = tkpg->pgx;
/*
 * Do nothing if the cursor is inactive.
 */
    if(tkpg->events.cursor_active) {
/*
 * Remove the current event handler.
 */
      Tk_DeleteEventHandler(tkpg->tkwin, CURSOR_EVENT_MASK,
			    tkpg_CursorHandler, (ClientData) tkpg);
/*
 * Reset the cursor context to its inactive state.
 */
      tkpg->events.cursor_active = 0;
/*
 * Erase the cursor.
 */
      pgx_erase_cursor(pgx);
      pgx_set_cursor(pgx, 0, TKPG_NORM_CURSOR, 0, NULL, NULL);
    };
  };
  return;
}

/*.......................................................................
 * Augment the cursor as specified in the arguments of the setcursor
 * widget command.
 *
 * Input:
 *  tkpg        TkPgplot *  The widget record to be configured.
 *  interp    Tcl_Interp *  The TCL intrepreter.
 *  argc             int    The number of configuration arguments.
 *  argv            char ** The array of 'argc' configuration arguments.
 *                           [0] The type of cursor augmentation, from:
 *                                norm  - Un-augmented X cursor
 *                                line  - Line cursor between ref and pointer
 *                                rect  - Rectangle between ref and pointer
 *                                yrng  - Horizontal lines at ref.x & pointer.x
 *                                xrng  - Vertical lines at ref.y & pointer.y
 *                                hline - Horizontal line cursor at y=ref.y
 *                                vline - Vertical line cursor at x=ref.x
 *                                cross - Pointer centered cross-hair
 *                           [1] The X-axis world coordinate at which
 *                               to anchor rect,yrng and xrng cursors.
 *                           [2] The Y-axis world coordinate at which
 *                               to anchor rect,yrng and xrng cursors.
 *                           [3] The color index of the cursor.
 *  flags            int    The flags argument of Tk_ConfigureWidget():
 *                           0                - No flags.
 *                           TK_CONFIG_ARGV   - Override the X defaults
 *                                              database and the configSpecs
 *                                              defaults.
 * Output:
 *  return           int    TCL_OK    - Success.
 *                          TCL_ERROR - Failure.
 */
static int tkpg_tcl_setcursor(TkPgplot *tkpg, Tcl_Interp *interp,
			      int argc, char *argv[])
{
  TkpgCursorMode mode;  /* Cursor augmentation mode */
  double xref,yref;    /* The X and Y reference positions of the cursor */
  int ci;              /* The color index used to draw the cursor */
  int found = 0;       /* True once the mode has been identified */
  int i;
/*
 * List the correspondence between cursor-mode names and pgband() mode
 * enumerators.
 */
  struct {
    TkpgCursorMode mode;
    char *name;
  } modes[] = {
    {TKPG_NORM_CURSOR, "norm"},  /* Un-augmented X cursor */
    {TKPG_LINE_CURSOR, "line"},  /* Line cursor between ref and pointer */
    {TKPG_RECT_CURSOR, "rect"},  /* Rectangle between ref and pointer */
    {TKPG_YRNG_CURSOR, "yrng"},  /* Horizontal lines at ref.x & pointer.x */
    {TKPG_XRNG_CURSOR, "xrng"},  /* Vertical lines at ref.y & pointer.y */
    {TKPG_HLINE_CURSOR, "hline"},/* Horizontal line cursor at y=ref.y */
    {TKPG_VLINE_CURSOR, "vline"},/* Vertical line cursor at x=ref.x */
    {TKPG_CROSS_CURSOR, "cross"},/* Pointer centered cross-hair */
  };
/*
 * Check that we have the expected number of arguments.
 */
  if(argc != 4) {
    Tcl_AppendResult(interp, "Wrong number of arguments. Should be: \"",
		     tkpg->pgx->name, " setcursor mode x y ci",
		     NULL);
    return TCL_ERROR;
  };
/*
 * Make sure that the widget is currently open to PGPLOT.
 */
  if(tkpg->pgslct_id == 0) {
    Tcl_AppendResult(interp, tkpg->pgx->name,
		     " setcursor: Widget not open to PGPLOT.", NULL);
    return TCL_ERROR;
  };
/*
 * Lookup the cursor mode.
 */
  mode = TKPG_NORM_CURSOR;
  for(i=0; !found && i<sizeof(modes)/sizeof(modes[0]); i++) {
    if(strcmp(modes[i].name, argv[0]) == 0) {
      found = 1;
      mode = modes[i].mode;
    };
  };
/*
 * Mode not found?
 */
  if(!found) {
    Tcl_AppendResult(interp, "Unknown PGPLOT cursor mode \"", argv[0],
		     "\". Should be one of:", NULL);
    for(i=0; i<sizeof(modes)/sizeof(modes[0]); i++)
      Tcl_AppendResult(interp, " ", modes[i].name, NULL);
    return TCL_ERROR;
  };
/*
 * Read the cursor X and Y coordinate.
 */
  if(Tcl_GetDouble(interp, argv[1], &xref) == TCL_ERROR ||
     Tcl_GetDouble(interp, argv[2], &yref) == TCL_ERROR)
    return TCL_ERROR;
/*
 * Get the color index to use when drawing the cursor.
 */
  if(Tcl_GetInt(interp, argv[3], &ci) == TCL_ERROR)
    return TCL_ERROR;
/*
 * Delegate the rest of the work to tkpg_SetCursor().
 */
  return tkpg_SetCursor(tkpg, mode, xref, yref, ci);
}

/*.......................................................................
 * This is a Tk_FreeProc() wrapper function around del_TkPgplot(),
 * suitable for use with Tk_EventuallyFree().
 *
 * Input:
 *  context   ClientData  The tkpg widget to be deleted, cast to
 *                        ClientData.
 */
#ifdef RIVET
static void tkpg_FreeProc(ClientData context)
#else
static void tkpg_FreeProc(char *context)
#endif
{
  (void) del_TkPgplot((TkPgplot *) context);
}

#ifdef RIVET
/*.......................................................................
 * Return an unambiguous PGPLOT device-specification that can be used
 * as the FILE argument of cpgbeg() to open a given Rivet PGPLOT widget.
 *
 * Input:
 *  widget Rivetobj   A rivet pgplot widget.
 * Output:
 *  return     char * The PGPLOT device-specication. Note that the returned
 *                    string is owned by the widget driver and must not be
 *                    free()d or overwritten.
 */
char *rvp_device_name(Rivetobj widget)
{
  TkPgplot *tkpg = (TkPgplot *) widget;
  return tkpg->device;
}

/*.......................................................................
 * Return the pgslct_id of the given Rivet pgplot widget. This can then
 * be used with the cpgslct() function to select the widget as the currently
 * active widget.
 *
 * Input:
 *  widget Rivetobj   A rivet pgplot widget.
 * Output:
 *  return     int   The PGPLOT device-id. This will be 0 if the widget
 *                   is not currently open to PGPLOT.
 */
int rvp_device_id(Rivetobj widget)
{
  TkPgplot *tkpg = (TkPgplot *) widget;
  return tkpg->pgslct_id;
}

/*.......................................................................
 * Convert from X window pixel coordinates to PGPLOT world coordinates.
 *
 * Input:
 *  widget Rivetobj    A rivet pgplot widget.
 *  px, py      int    The X-window pixel coordinates to be converted.
 *  wx, wy    float *  The corresponding PGPLOT world coordinates are
 *                     assigned to the variables pointed to by wx and wy.
 * Output:
 *  return      int    0 - OK.
 *                     1 - Error.
 */
int rvp_xwin2world(Rivetobj widget, int px, int py, float *wx, float *wy)
{
  TkPgplot *tkpg = (TkPgplot *) widget;
  float rbuf[2];
/*
 * Convert from pixels to world coordinates.
 */
  if(pgx_win2dev(tkpg->pgx, px, py, rbuf) ||
     pgx_dev2world(tkpg->pgx, rbuf))
    return 1;
/*
 * Assign the return values.
 */
  *wx = rbuf[0];
  *wy = rbuf[1];
  return 0;
}

/*.......................................................................
 * Convert from PGPLOT world coordinates to X window pixel coordinates.
 *
 * Input:
 *  widget Rivetobj    A rivet pgplot widget.
 *  wx, wy    float    The PGPLOT world coordinates to be converted.
 *  px, py      int *  The corresponding X-window pixel coordinates are
 *                     assigned to the variables pointed to by px and py.
 * Output:
 *  return      int    0 - OK.
 *                     1 - Error.
 */
int rvp_world2xwin(Rivetobj widget, float wx, float wy, int *px, int *py)
{
  TkPgplot *tkpg = (TkPgplot *) widget;
  float rbuf[2];
/*
 * Convert from world coordinates to pixel coordinates.
 */
  rbuf[0] = wx;
  rbuf[1] = wy;
  if(pgx_world2dev(tkpg->pgx, rbuf) ||
     pgx_dev2win(tkpg->pgx, rbuf, px, py))
    return 1;
  return 0;
}

#endif

/*.......................................................................
 * Refresh the contents of the window.
 *
 * Input:
 *  tkpg        TkPgplot *  The widget record to be configured.
 * Output:
 *  return           int    0 - OK.
 *                          1 - Error.
 */
static int tkpg_refresh_window(TkPgplot *tkpg)
{
  if(Tk_IsMapped(tkpg->tkwin)) {
    tkpg_draw_focus_highlight(tkpg);
    tkpg_draw_3d_border(tkpg);
    return pgx_scroll(tkpg->pgx, tkpg->scroll.x, tkpg->scroll.y);
  };
  return 0;
}

/*.......................................................................
 * Whenever the color representation of the background color is changed
 * via PGPLOT, this function is called to update the Tk 3D border.
 *
 * Input:
 *  tkpg     TkPgplot *   The associated PGPLOT widget.
 */
static void tkpg_update_border(TkPgplot *tkpg)
{
  XColor *bg;     /* The new background color */
  char cname[20]; /* The color as a string of the form #rrrrggggbbbb */
  Tk_3DBorder bd; /* The new Tk border */
/*
 * Get the PGPLOT background color.
 */
  bg = &tkpg->pgx->color->xcolor[0];
/*
 * Tk_Get3DBorder requires a standard X color resource string.
 */
  sprintf(cname, "#%4.4hx%4.4hx%4.4hx", bg->red, bg->green, bg->blue);
  bd = Tk_Get3DBorder(tkpg->interp, tkpg->tkwin, cname);
  if(bd) {
/*
 * Replace the previous border with the new one.
 */
    if(tkpg->border)
      Tk_Free3DBorder(tkpg->border);
    tkpg->border = bd;
    tkpg_draw_3d_border(tkpg);
  } else {
    fprintf(stderr, "Tk_Get3DBorder failed: %s\n", tkpg->interp->result);
  };
}

/*.......................................................................
 * Respond to an xview or yview scrollbar command.
 *
 * Input:
 *  tkpg        TkPgplot *  The widget record to be configured.
 *  interp    Tcl_Interp *  The TCL intrepreter.
 *  widget          char *  The name of the PGPLOT widget.
 *  view            char *  "xview" or "yview".
 *  argc             int    The number of configuration arguments.
 *  argv            char ** The array of 'argc' configuration arguments.
 * Output:
 *  return           int    TCL_OK    - Success.
 *                          TCL_ERROR - Failure.
 */
static int tkpg_scrollbar_callback(TkPgplot *tkpg, Tcl_Interp *interp,
				  char *widget, char *view, int argc,
				  char *argv[])
{
  int window_size;  /* The size of the window along the direction of motion */
  int pixmap_size;  /* The size of the pixmap along the direction of motion */
  int new_start_pos;/* The new pixmap coord of the top|left of the window */
  int old_start_pos;/* The old pixmap coord of the top|left of the window */
/*
 * Fill in the current scroll-statistics along the requested direction.
 */
  if(*view == 'x') {
    window_size = Tk_Width(tkpg->tkwin);
    pixmap_size = pgx_pixmap_width(tkpg->pgx);
    old_start_pos = tkpg->scroll.x;
  } else {
    window_size = Tk_Height(tkpg->tkwin);
    pixmap_size = pgx_pixmap_height(tkpg->pgx);
    old_start_pos = tkpg->scroll.y;
  };
/*
 * The first argument specifies what form of scrollbar command has
 * been received (see 'man scrollbar' for details).
 */
  if(argc < 1) {
    return tkpg_scrollbar_error(tkpg, interp, widget, view, argc, argv);
/*
 * The moveto command requests a new start position as a
 * fraction of the pixmap size.
 */
  } else if(strcmp(argv[0], "moveto")==0) {
    double fractional_position;
    if(argc != 2)
      return tkpg_scrollbar_error(tkpg, interp, widget, view, argc, argv);
/*
 * Read the fractional position.
 */
    if(Tcl_GetDouble(interp, argv[1], &fractional_position) == TCL_ERROR)
      return TCL_ERROR;
    new_start_pos = fractional_position * pixmap_size;
/*
 * The "scroll" command specifies an increment to move the pixmap by
 * and the units to which the increment refers.
 */
  } else if(strcmp(argv[0], "scroll")==0) {
    int scroll_increment;
    if(argc != 3)
      return tkpg_scrollbar_error(tkpg, interp, widget, view, argc, argv);
/*
 * Read the scroll-increment.
 */
    if(Tcl_GetInt(interp, argv[1], &scroll_increment) == TCL_ERROR)
      return TCL_ERROR;
/*
 * The unit of the increment can either be "units", which in our case
 * translates to a single pixel, or "pages", which corresponds to the
 * width/height of the window.
 */
    if(strcmp(argv[2], "units")==0) {
      new_start_pos = old_start_pos + scroll_increment;
    } else if(strcmp(argv[2], "pages")==0) {
      int page_size = window_size - 2 *
	(tkpg->highlight_thickness + tkpg->borderWidth);
      if(page_size < 0)
	page_size = 0;
      new_start_pos = old_start_pos + scroll_increment * page_size;
    } else {
      return tkpg_scrollbar_error(tkpg, interp, widget, view, argc, argv);
    };
  } else {
    Tcl_AppendResult(interp, "Unknown xview command \"", argv[0], "\"", NULL);
    return TCL_ERROR;
  };
/*
 * Keep the pixmap visible.
 */
  if(new_start_pos < 0 || window_size > pixmap_size) {
    new_start_pos = 0;
  } else if(new_start_pos + window_size > pixmap_size) {
    new_start_pos = pixmap_size - window_size;
  };
/*
 * Record the top left corner of the new scrolling-area.
 */
  if(*view == 'x')
    tkpg->scroll.x = new_start_pos;
  else
    tkpg->scroll.y = new_start_pos;
/*
 * Update the scrolled area and the scrollbar slider.
 */
  tkpg_update_scroll_bars(tkpg);
  return TCL_OK;
}

/*.......................................................................
 * This is a private error-return function of tkpg_scrollbar_callback().
 *
 * Input:
 *  tkpg        TkPgplot *  The widget record.
 *  interp    Tcl_Interp *  The TCL intrepreter.
 *  widget          char *  The name of the PGPLOT widget.
 *  view            char *  "xview" or "yview".
 *  argc             int    The number of arguments in argv.
 *  argv            char ** The array of 'argc' configuration arguments.
 * Output:
 *  return           int    TCL_ERROR and the context of the error
 *                          is recorded in interp->result.
 */
static int tkpg_scrollbar_error(TkPgplot *tkpg, Tcl_Interp *interp,
			       char *widget, char *view, int argc,
			       char *argv[])
{
  int i;
  Tcl_AppendResult(interp, "Bad command: ", widget, " ", view, NULL);
  for(i=0; i<argc; i++)
    Tcl_AppendResult(interp, " ", argv[i], NULL);
  Tcl_AppendResult(interp, "\nAfter \"widget [xy]view\", use one of:\n \"moveto <fraction>\" or \"scroll -1|1 units|pages\"", NULL);
  return TCL_ERROR;
}


/*.......................................................................
 * Implement the Tcl world function. This converts an X-window
 * pixel coordinate to the corresponding PGPLOT world coordinate.
 *
 * Input:
 *  tkpg        TkPgplot *  The widget record.
 *  interp    Tcl_Interp *  The TCL intrepreter.
 *  widget          char *  The name of the PGPLOT widget.
 *  argc             int    The number of configuration arguments.
 *  argv            char ** The array of 'argc' configuration arguments.
 *                           [0] The coordinate axes to convert, from:
 *                                "x"  - Convert an X-axis coord.
 *                                "y"  - Convert a Y-axis coord.
 *                                "xy" - Convert a an X Y axis pair.
 *                           [1] An X-axis pixel coordinate if [0][0] is
 *                               'x'.
 *                               A Y-axis pixel coordinate if [0][0] is
 *                               'y'.
 *                           [2] This is only expected if [0]=="xy". It
 *                               should then contain the Y-axis
 *                               coordinate to be converted.
 * Output:
 *  return           int    TCL_OK    - Success.
 *                          TCL_ERROR - Failure.
 */
static int tkpg_tcl_world(TkPgplot *tkpg, Tcl_Interp *interp,
			 char *widget, int argc, char *argv[])
{
  int xpix, ypix;     /* The input X window coordinate */
  float rbuf[2];      /* The conversion buffer */
  char *axis;         /* The axis specification string */
  enum {BAD_AXIS, X_AXIS, Y_AXIS, XY_AXIS}; /* Enumerated axis type */
  int axtype;         /* The decoded axis type */
  char *usage = " world [x <xpix>]|[y <xpix>]|[xy <xpix> <ypix>]";
/*
 * Check that an axis specification argument has been provided.
 */
  if(argc < 1) {
    Tcl_AppendResult(interp, "Usage: ", widget, usage, NULL);
    return TCL_ERROR;
  };
/*
 * Decode the axis type and check the expected argument count.
 */
  axis = argv[0];
  axtype = BAD_AXIS;
  switch(*axis++) {
  case 'x':
    switch(*axis++) {
    case 'y':
      if(*axis == '\0' && argc == 3)
	axtype = XY_AXIS;
      break;
    case '\0':
      if(argc == 2)
	axtype = X_AXIS;
      break;
    };
    break;
  case 'y':
    if(*axis == '\0' && argc == 2)
      axtype = Y_AXIS;
    break;
  };
/*
 * Unrecognised axis description?
 */
  if(axtype == BAD_AXIS) {
    Tcl_AppendResult(interp, "Usage: ", widget, usage, NULL);
    return TCL_ERROR;
  };
/*
 * Get the pixel coordinates to be converted.
 */
  switch(axtype) {
  case X_AXIS:
    if(Tcl_GetInt(interp, argv[1], &xpix) == TCL_ERROR)
      return TCL_ERROR;
    ypix = 0;
    break;
  case Y_AXIS:
    xpix = 0;
    if(Tcl_GetInt(interp, argv[1], &ypix) == TCL_ERROR)
      return TCL_ERROR;
    break;
  case XY_AXIS:
    if(Tcl_GetInt(interp, argv[1], &xpix) == TCL_ERROR ||
       Tcl_GetInt(interp, argv[2], &ypix) == TCL_ERROR)
      return TCL_ERROR;
    break;
  };
/*
 * Convert the pixel coordinates to world coordinates.
 */
  pgx_win2dev(tkpg->pgx, xpix, ypix, rbuf);
  pgx_dev2world(tkpg->pgx, rbuf);
/*
 * Write the world coordinate(s) into the reply string.
 */
  switch(axtype) {
  case X_AXIS:
    Tcl_PrintDouble(interp, rbuf[0], tkpg->buffer);
    Tcl_AppendResult(interp, tkpg->buffer, NULL);
    break;
  case Y_AXIS:
    Tcl_PrintDouble(interp, rbuf[1], tkpg->buffer);
    Tcl_AppendResult(interp, tkpg->buffer, NULL);
    break;
  case XY_AXIS:
    Tcl_PrintDouble(interp, rbuf[0], tkpg->buffer);
    Tcl_AppendResult(interp, tkpg->buffer, NULL);
    Tcl_PrintDouble(interp, rbuf[1], tkpg->buffer);
    Tcl_AppendResult(interp, tkpg->buffer, NULL);
    break;
  };
  return TCL_OK;
}

/*.......................................................................
 * Implement the Tcl pixel function. This converts PGPLOT world
 * coordinates to X-window pixel coordinates.
 *
 * Input:
 *  tkpg        TkPgplot *  The widget record.
 *  interp    Tcl_Interp *  The TCL intrepreter.
 *  widget          char *  The name of the PGPLOT widget.
 *  argc             int    The number of configuration arguments.
 *  argv            char ** The array of 'argc' configuration arguments.
 *                           [0] The coordinate axes to convert, from:
 *                                "x"  - Convert an X-axis coord.
 *                                "y"  - Convert a Y-axis coord.
 *                                "xy" - Convert a an X Y axis pair.
 *                           [1] An X-axis world coordinate if [0][0] is
 *                               'x'.
 *                               A Y-axis world coordinate if [0][0] is
 *                               'y'.
 *                           [2] This is only expected if [0]=="xy". It
 *                               should then contain the Y-axis
 *                               coordinate to be converted.
 * Output:
 *  return           int    TCL_OK    - Success.
 *                          TCL_ERROR - Failure.
 */
static int tkpg_tcl_pixel(TkPgplot *tkpg, Tcl_Interp *interp,
			 char *widget, int argc, char *argv[])
{
  double wx, wy;      /* The world X and Y coordinates to be converted */
  int xpix, ypix;     /* The output X window coordinate */
  float rbuf[2];      /* The conversion buffer */
  char *axis;         /* The axis specification string */
  enum {BAD_AXIS, X_AXIS, Y_AXIS, XY_AXIS}; /* Enumerated axis type */
  int axtype;         /* The decoded axis type */
  char *usage = " pixel [x <x>]|[y <x>]|[xy <x> <y>]";
/*
 * Check that an axis specification argument has been provided.
 */
  if(argc < 1) {
    Tcl_AppendResult(interp, "Usage: ", widget, usage, NULL);
    return TCL_ERROR;
  };
/*
 * Decode the axis type and check the expected argument count.
 */
  axis = argv[0];
  axtype = BAD_AXIS;
  switch(*axis++) {
  case 'x':
    switch(*axis++) {
    case 'y':
      if(*axis == '\0' && argc == 3)
	axtype = XY_AXIS;
      break;
    case '\0':
      if(argc == 2)
	axtype = X_AXIS;
      break;
    };
    break;
  case 'y':
    if(*axis == '\0' && argc == 2)
      axtype = Y_AXIS;
    break;
  };
/*
 * Unrecognised axis description?
 */
  if(axtype == BAD_AXIS) {
    Tcl_AppendResult(interp, "Usage: ", widget, usage, NULL);
    return TCL_ERROR;
  };
/*
 * Get the pixel coordinates to be converted.
 */
  switch(axtype) {
  case X_AXIS:
    if(Tcl_GetDouble(interp, argv[1], &wx) == TCL_ERROR)
      return TCL_ERROR;
    wy = 0;
    break;
  case Y_AXIS:
    wx = 0;
    if(Tcl_GetDouble(interp, argv[1], &wy) == TCL_ERROR)
      return TCL_ERROR;
    break;
  case XY_AXIS:
    if(Tcl_GetDouble(interp, argv[1], &wx) == TCL_ERROR ||
       Tcl_GetDouble(interp, argv[2], &wy) == TCL_ERROR)
      return TCL_ERROR;
    break;
  };
/*
 * Convert the world coordinate to pixel coordinates.
 */
  rbuf[0] = wx;
  rbuf[1] = wy;
  pgx_world2dev(tkpg->pgx, rbuf);
  pgx_dev2win(tkpg->pgx, rbuf, &xpix, &ypix);
/*
 * Write the pixel coordinate(s) into the reply string.
 */
  switch(axtype) {
  case X_AXIS:
    sprintf(tkpg->buffer, "%d", xpix);
    Tcl_AppendResult(interp, tkpg->buffer, NULL);
    break;
  case Y_AXIS:
    sprintf(tkpg->buffer, "%d", ypix);
    Tcl_AppendResult(interp, tkpg->buffer, NULL);
    break;
  case XY_AXIS:
    sprintf(tkpg->buffer, "%d %d", xpix, ypix);
    Tcl_AppendResult(interp, tkpg->buffer, NULL);
    break;
  };
  return TCL_OK;
}

/*.......................................................................
 * Implement the Tcl "return PGPLOT id" function.
 *
 * Input:
 *  tkpg        TkPgplot *  The widget record.
 *  interp    Tcl_Interp *  The TCL intrepreter.
 *  widget          char *  The name of the PGPLOT widget.
 *  argc             int    The number of configuration arguments.
 *  argv            char ** The array of 'argc' configuration arguments.
 *                          (None are expected).
 * Output:
 *  return           int    TCL_OK    - Success.
 *                          TCL_ERROR - Failure.
 */
static int tkpg_tcl_id(TkPgplot *tkpg, Tcl_Interp *interp,
		      char *widget, int argc, char *argv[])
{
/*
 * There shouldn't be any arguments.
 */
  if(argc != 0) {
    Tcl_AppendResult(interp, "Usage: ", widget, " id", NULL);
    return TCL_ERROR;
  };
/*
 * Return the id in the Tcl result string.
 */
  sprintf(tkpg->buffer, "%d", tkpg->pgslct_id);
  Tcl_AppendResult(interp, tkpg->buffer, NULL);
  return TCL_OK;
}

/*.......................................................................
 * Implement the Tcl "return PGPLOT device specifier" function.
 *
 * Input:
 *  tkpg        TkPgplot *  The widget record.
 *  interp    Tcl_Interp *  The TCL intrepreter.
 *  widget          char *  The name of the PGPLOT widget.
 *  argc             int    The number of configuration arguments.
 *  argv            char ** The array of 'argc' configuration arguments.
 *                          (None are expected).
 * Output:
 *  return           int    TCL_OK    - Success.
 *                          TCL_ERROR - Failure.
 */
static int tkpg_tcl_device(TkPgplot *tkpg, Tcl_Interp *interp,
			   char *widget, int argc, char *argv[])
{
/*
 * There shouldn't be any arguments.
 */
  if(argc != 0) {
    Tcl_AppendResult(interp, "Usage: ", widget, " device", NULL);
    return TCL_ERROR;
  };
/*
 * Return the device specifier in the Tcl result string.
 */
  Tcl_AppendResult(interp, tkpg->device, NULL);
  return TCL_OK;
}

/*.......................................................................
 * Return the toplevel window ID of a given tk pathname.
 *
 * Input:
 *  interp  Tcl_Interp *  The TCL intrepreter.
 *  main_w   Tk_Window    The main window of the application.
 *  path          char *  The tk path name of a window.
 * Output:
 *  return   Tk_Window    The top-level window of the path, or NULL if
 *                        it doesn't exist. In the latter case an error
 *                        message will have been appended to interp->result.
 */
static Tk_Window tkpg_toplevel_of_path(Tcl_Interp *interp, Tk_Window main_w,
				       char *path)
{
  char *endp;   /* The element in path[] following the first path component */
  char *first;  /* A copy of the first component of the pathname */
  int length;   /* The length of the first component of the pathname */
  Tk_Window w;  /* The Tk window of the first component of the pathname */
/*
 * The first character of the path should be a dot.
 */
  if(!path || *path == '\0' || *path != '.') {
    Tcl_AppendResult(interp, "Unknown window: ", path ? path : "(null)",
		     NULL);
    return NULL;
  };
/*
 * Find the end of the first component of the pathname.
 */
  for(endp=path+1; *endp && *endp != '.'; endp++)
    ;
  length = endp - path;
/*
 * Make a copy of the name of the first component of the path name.
 */
  first = malloc(length + 1);
  if(!first) {
    Tcl_AppendResult(interp, "Ran out of memory while finding toplevel window.",
		     NULL);
    return NULL;
  };
  strncpy(first, path, length);
  first[length] = '\0';
/*
 * Lookup the corresponding window.
 */
  w = Tk_NameToWindow(interp, first, main_w);
/*
 * Discard the copy.
 */
  free(first);
/*
 * If the window doesn't exist, Tk_NameToWindow() is documented to place
 * an error message in interp->result, so just return the error condition.
 */
  if(!w)
    return NULL;
/*
 * If the looked up window is a toplevel window return it, otherwise
 * the toplevel for the specified path must be the main window.
 */
  return Tk_IsTopLevel(w) ? w : main_w;
}