PLplot  5.9.9
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Macros
tk.c
Go to the documentation of this file.
1 // $Id: tk.c 12207 2012-08-13 21:02:37Z airwin $
2 //
3 // PLplot Tcl/Tk and Tcl-DP device drivers.
4 // Should be broken up somewhat better to allow use of DP w/o X.
5 //
6 // Maurice LeBrun
7 // 30-Apr-93
8 //
9 // Copyright (C) 2004 Maurice LeBrun
10 // Copyright (C) 2004 Joao Cardoso
11 // Copyright (C) 2004 Andrew Ross
12 //
13 // This file is part of PLplot.
14 //
15 // PLplot is free software; you can redistribute it and/or modify
16 // it under the terms of the GNU Library General Public License as published
17 // by the Free Software Foundation; either version 2 of the License, or
18 // (at your option) any later version.
19 //
20 // PLplot is distributed in the hope that it will be useful,
21 // but WITHOUT ANY WARRANTY; without even the implied warranty of
22 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23 // GNU Library General Public License for more details.
24 //
25 // You should have received a copy of the GNU Library General Public License
26 // along with PLplot; if not, write to the Free Software
27 // Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
28 //
29 
30 //
31 // #define DEBUG_ENTER
32 //
33 
34 #define DEBUG
35 
36 #include "plDevs.h"
37 
38 #ifdef PLD_tk
39 
40 #define NEED_PLDEBUG
41 #include "pltkd.h"
42 #include "pltcl.h"
43 #include "tcpip.h"
44 #include "drivers.h"
45 #include "metadefs.h"
46 #include "plevent.h"
47 #include <X11/keysym.h>
48 
49 #if PL_HAVE_UNISTD_H
50 # include <unistd.h>
51 #endif
52 #include <sys/types.h>
53 #if HAVE_SYS_WAIT_H
54 # include <sys/wait.h>
55 #endif
56 #include <sys/stat.h>
57 #include <fcntl.h>
58 #include <errno.h>
59 #include <signal.h>
60 
61 #ifdef PLD_dp
62 # include <dp.h>
63 #endif
64 
65 // Device info
66 PLDLLIMPEXP_DRIVER const char* plD_DEVICE_INFO_tk = "tk:Tcl/TK Window:1:tk:7:tk\n";
67 
68 
69 // Number of instructions to skip between updates
70 
71 #define MAX_INSTR 100
72 
73 // Pixels/mm
74 
75 #define PHYSICAL 0 // Enables physical scaling..
76 
77 // These need to be distinguished since the handling is slightly different.
78 
79 #define LOCATE_INVOKED_VIA_API 1
80 #define LOCATE_INVOKED_VIA_DRIVER 2
81 
82 #define STR_LEN 10
83 #define CMD_LEN 100
84 
85 // A handy command wrapper
86 
87 #define tk_wr( code ) \
88  if ( code ) { abort_session( pls, "Unable to write to PDFstrm" ); }
89 
90 //--------------------------------------------------------------------------
91 // Function prototypes
92 
93 // Driver entry and dispatch setup
94 
96 
97 void plD_init_tk( PLStream * );
98 void plD_line_tk( PLStream *, short, short, short, short );
99 void plD_polyline_tk( PLStream *, short *, short *, PLINT );
100 void plD_eop_tk( PLStream * );
101 void plD_bop_tk( PLStream * );
102 void plD_tidy_tk( PLStream * );
103 void plD_state_tk( PLStream *, PLINT );
104 void plD_esc_tk( PLStream *, PLINT, void * );
105 void plD_init_dp( PLStream *pls );
106 
107 // various
108 
109 static void init( PLStream *pls );
110 static void tk_start( PLStream *pls );
111 static void tk_stop( PLStream *pls );
112 static void tk_di( PLStream *pls );
113 static void tk_fill( PLStream *pls );
114 static void WaitForPage( PLStream *pls );
115 static void CheckForEvents( PLStream *pls );
116 static void HandleEvents( PLStream *pls );
117 static void init_server( PLStream *pls );
118 static void launch_server( PLStream *pls );
119 static void flush_output( PLStream *pls );
120 static void plwindow_init( PLStream *pls );
121 static void link_init( PLStream *pls );
122 static void GetCursor( PLStream *pls, PLGraphicsIn *ptr );
123 static void tk_XorMod( PLStream *pls, PLINT *ptr );
124 static void set_windowname( PLStream *pls );
125 
126 // performs Tk-driver-specific initialization
127 
128 static int pltkdriver_Init( PLStream *pls );
129 
130 // Tcl/TK utility commands
131 
132 static void tk_wait( PLStream *pls, const char * );
133 static void abort_session( PLStream *pls, const char * );
134 static void server_cmd( PLStream *pls, const char *, int );
135 static void tcl_cmd( PLStream *pls, const char * );
136 static void copybuf( PLStream *pls, const char *cmd );
137 static int pltk_toplevel( Tk_Window *w, Tcl_Interp *interp );
138 
139 static void ProcessKey( PLStream *pls );
140 static void ProcessButton( PLStream *pls );
141 static void LocateKey( PLStream *pls );
142 static void LocateButton( PLStream *pls );
143 static void Locate( PLStream *pls );
144 
145 // These are internal TCL commands
146 
147 static int Abort( ClientData, Tcl_Interp *, int, char ** );
148 static int Plfinfo( ClientData, Tcl_Interp *, int, char ** );
149 static int KeyEH( ClientData, Tcl_Interp *, int, char ** );
150 static int ButtonEH( ClientData, Tcl_Interp *, int, char ** );
151 static int LookupTkKeyEvent( PLStream *pls, Tcl_Interp *interp,
152  int argc, char **argv );
153 static int LookupTkButtonEvent( PLStream *pls, Tcl_Interp *interp,
154  int argc, char **argv );
155 
156 static char *drvoptcmd = NULL; // tcl command from command line option parsing
157 
158 static DrvOpt tk_options[] = { { "tcl_cmd", DRV_STR, &drvoptcmd, "Execute tcl command" },
159  { NULL, DRV_INT, NULL, NULL } };
160 
162 {
163 #ifndef ENABLE_DYNDRIVERS
164  pdt->pl_MenuStr = "Tcl/TK Window";
165  pdt->pl_DevName = "tk";
166 #endif
168  pdt->pl_seq = 7;
169  pdt->pl_init = (plD_init_fp) plD_init_tk;
170  pdt->pl_line = (plD_line_fp) plD_line_tk;
171  pdt->pl_polyline = (plD_polyline_fp) plD_polyline_tk;
172  pdt->pl_eop = (plD_eop_fp) plD_eop_tk;
173  pdt->pl_bop = (plD_bop_fp) plD_bop_tk;
174  pdt->pl_tidy = (plD_tidy_fp) plD_tidy_tk;
175  pdt->pl_state = (plD_state_fp) plD_state_tk;
176  pdt->pl_esc = (plD_esc_fp) plD_esc_tk;
177 }
178 
179 //--------------------------------------------------------------------------
180 // plD_init_dp()
181 // plD_init_tk()
182 // init_tk()
183 //
184 // Initialize device.
185 // TK-dependent stuff done in tk_start(). You can set the display by
186 // calling plsfnam() with the display name as the (string) argument.
187 //--------------------------------------------------------------------------
188 
189 void
190 plD_init_tk( PLStream *pls )
191 {
192  pls->dp = 0;
193  plParseDrvOpts( tk_options );
194  init( pls );
195 }
196 
197 void
198 plD_init_dp( PLStream *pls )
199 {
200 #ifdef PLD_dp
201  pls->dp = 1;
202 #else
203  fprintf( stderr, "The Tcl-DP driver hasn't been installed!\n" );
204  pls->dp = 0;
205 #endif
206  init( pls );
207 }
208 
209 static void
210 tk_wr_header( PLStream *pls, const char *header )
211 {
212  tk_wr( pdf_wr_header( pls->pdfs, header ) );
213 }
214 
215 static void
216 init( PLStream *pls )
217 {
218  U_CHAR c = (U_CHAR) INITIALIZE;
219  TkDev *dev;
220  PLFLT pxlx, pxly;
221  int xmin = 0;
222  int xmax = PIXELS_X - 1;
223  int ymin = 0;
224  int ymax = PIXELS_Y - 1;
225 
226  dbug_enter( "plD_init_tk" );
227 
228  pls->color = 1; // Is a color device
229  pls->termin = 1; // Is an interactive terminal
230  pls->dev_di = 1; // Handle driver interface commands
231  pls->dev_flush = 1; // Handle our own flushes
232  pls->dev_fill0 = 1; // Handle solid fills
233  pls->dev_fill1 = 1; // Driver handles pattern fills
234  pls->server_nokill = 1; // don't kill if ^C
235  pls->dev_xor = 1; // device support xor mode
236 
237 // Activate plot buffer. To programmatically save a file we can't call
238 // plreplot(), but instead one must send a command to plserver. As there is
239 // no API call for this, the user must use the plserver "save/print" menu
240 // entries. Activating the plot buffer enables the normal
241 // plmkstrm/plcpstrm/plreplot/plend1 way of saving plots.
242 //
243  pls->plbuf_write = 1;
244 
245 // Specify buffer size if not yet set (can be changed by -bufmax option).
246 // A small buffer works best for socket communication
247 
248  if ( pls->bufmax == 0 )
249  {
250  if ( pls->dp )
251  pls->bufmax = 450;
252  else
253  pls->bufmax = 3500;
254  }
255 
256 // Allocate and initialize device-specific data
257 
258  if ( pls->dev != NULL )
259  free( (void *) pls->dev );
260 
261  pls->dev = calloc( 1, (size_t) sizeof ( TkDev ) );
262  if ( pls->dev == NULL )
263  plexit( "plD_init_tk: Out of memory." );
264 
265  dev = (TkDev *) pls->dev;
266 
267  dev->iodev = (PLiodev *) calloc( 1, (size_t) sizeof ( PLiodev ) );
268  if ( dev->iodev == NULL )
269  plexit( "plD_init_tk: Out of memory." );
270 
271  dev->exit_eventloop = 0;
272 
273 // Variables used in querying plserver for events
274 
275  dev->instr = 0;
276  dev->max_instr = MAX_INSTR;
277 
278 // Start interpreter and spawn server process
279 
280  tk_start( pls );
281 
282 // Get ready for plotting
283 
284  dev->xold = PL_UNDEFINED;
285  dev->yold = PL_UNDEFINED;
286 
287 #if PHYSICAL
288  pxlx = (double) PIXELS_X / dev->width * DPMM;
289  pxly = (double) PIXELS_Y / dev->height * DPMM;
290 #else
291  pxlx = (double) PIXELS_X / LPAGE_X;
292  pxly = (double) PIXELS_Y / LPAGE_Y;
293 #endif
294 
295  plP_setpxl( pxlx, pxly );
296  plP_setphy( xmin, xmax, ymin, ymax );
297 
298 // Send init info
299 
300  tk_wr( pdf_wr_1byte( pls->pdfs, c ) );
301 
302 // The header and version fields are useful when the client & server
303 // reside on different machines
304 
305  tk_wr_header( pls, PLSERV_HEADER );
306  tk_wr_header( pls, PLSERV_VERSION );
307 
308  tk_wr_header( pls, "xmin" );
309  tk_wr( pdf_wr_2bytes( pls->pdfs, (U_SHORT) xmin ) );
310 
311  tk_wr_header( pls, "xmax" );
312  tk_wr( pdf_wr_2bytes( pls->pdfs, (U_SHORT) xmax ) );
313 
314  tk_wr_header( pls, "ymin" );
315  tk_wr( pdf_wr_2bytes( pls->pdfs, (U_SHORT) ymin ) );
316 
317  tk_wr_header( pls, "ymax" );
318  tk_wr( pdf_wr_2bytes( pls->pdfs, (U_SHORT) ymax ) );
319 
320  tk_wr_header( pls, "" );
321 
322 // Write color map state info
323  plD_state_tk( pls, PLSTATE_CMAP0 );
324  plD_state_tk( pls, PLSTATE_CMAP1 );
325 
326 // Good place to make sure the data transfer is working OK
327 
328  flush_output( pls );
329 }
330 
331 //--------------------------------------------------------------------------
332 // plD_line_tk()
333 //
334 // Draw a line in the current color from (x1,y1) to (x2,y2).
335 //--------------------------------------------------------------------------
336 
337 void
338 plD_line_tk( PLStream *pls, short x1, short y1, short x2, short y2 )
339 {
340  U_CHAR c;
341  U_SHORT xy[4];
342  TkDev *dev = (TkDev *) pls->dev;
343 
344  CheckForEvents( pls );
345 
346  if ( x1 == dev->xold && y1 == dev->yold )
347  {
348  c = (U_CHAR) LINETO;
349  tk_wr( pdf_wr_1byte( pls->pdfs, c ) );
350 
351  xy[0] = (U_SHORT) x2;
352  xy[1] = (U_SHORT) y2;
353  tk_wr( pdf_wr_2nbytes( pls->pdfs, xy, 2 ) );
354  }
355  else
356  {
357  c = (U_CHAR) LINE;
358  tk_wr( pdf_wr_1byte( pls->pdfs, c ) );
359 
360  xy[0] = (U_SHORT) x1;
361  xy[1] = (U_SHORT) y1;
362  xy[2] = (U_SHORT) x2;
363  xy[3] = (U_SHORT) y2;
364  tk_wr( pdf_wr_2nbytes( pls->pdfs, xy, 4 ) );
365  }
366  dev->xold = x2;
367  dev->yold = y2;
368 
369  if ( pls->pdfs->bp > (size_t) pls->bufmax )
370  flush_output( pls );
371 }
372 
373 //--------------------------------------------------------------------------
374 // plD_polyline_tk()
375 //
376 // Draw a polyline in the current color from (x1,y1) to (x2,y2).
377 //--------------------------------------------------------------------------
378 
379 void
380 plD_polyline_tk( PLStream *pls, short *xa, short *ya, PLINT npts )
381 {
382  U_CHAR c = (U_CHAR) POLYLINE;
383  TkDev *dev = (TkDev *) pls->dev;
384 
385  CheckForEvents( pls );
386 
387  tk_wr( pdf_wr_1byte( pls->pdfs, c ) );
388  tk_wr( pdf_wr_2bytes( pls->pdfs, (U_SHORT) npts ) );
389 
390  tk_wr( pdf_wr_2nbytes( pls->pdfs, (U_SHORT *) xa, npts ) );
391  tk_wr( pdf_wr_2nbytes( pls->pdfs, (U_SHORT *) ya, npts ) );
392 
393  dev->xold = xa[npts - 1];
394  dev->yold = ya[npts - 1];
395 
396  if ( pls->pdfs->bp > (size_t) pls->bufmax )
397  flush_output( pls );
398 }
399 
400 //--------------------------------------------------------------------------
401 // plD_eop_tk()
402 //
403 // End of page.
404 // User must hit <RETURN> to continue.
405 //--------------------------------------------------------------------------
406 
407 void
408 plD_eop_tk( PLStream *pls )
409 {
410  U_CHAR c = (U_CHAR) EOP;
411 
412  dbug_enter( "plD_eop_tk" );
413 
414  tk_wr( pdf_wr_1byte( pls->pdfs, c ) );
415  flush_output( pls );
416  if ( !pls->nopause )
417  WaitForPage( pls );
418 }
419 
420 //--------------------------------------------------------------------------
421 // plD_bop_tk()
422 //
423 // Set up for the next page.
424 //--------------------------------------------------------------------------
425 
426 void
427 plD_bop_tk( PLStream *pls )
428 {
429  U_CHAR c = (U_CHAR) BOP;
430  TkDev *dev = (TkDev *) pls->dev;
431 
432  dbug_enter( "plD_bop_tk" );
433 
434  dev->xold = PL_UNDEFINED;
435  dev->yold = PL_UNDEFINED;
436  pls->page++;
437  tk_wr( pdf_wr_1byte( pls->pdfs, c ) );
438 }
439 
440 //--------------------------------------------------------------------------
441 // plD_tidy_tk()
442 //
443 // Close graphics file
444 //--------------------------------------------------------------------------
445 
446 void
447 plD_tidy_tk( PLStream *pls )
448 {
449  TkDev *dev = (TkDev *) pls->dev;
450 
451  dbug_enter( "plD_tidy_tk" );
452 
453  if ( dev != NULL )
454  tk_stop( pls );
455 }
456 
457 //--------------------------------------------------------------------------
458 // plD_state_tk()
459 //
460 // Handle change in PLStream state (color, pen width, fill attribute, etc).
461 //--------------------------------------------------------------------------
462 
463 void
464 plD_state_tk( PLStream *pls, PLINT op )
465 {
466  U_CHAR c = (U_CHAR) CHANGE_STATE;
467  int i;
468 
469  dbug_enter( "plD_state_tk" );
470 
471  tk_wr( pdf_wr_1byte( pls->pdfs, c ) );
472  tk_wr( pdf_wr_1byte( pls->pdfs, (U_CHAR) op ) );
473 
474  switch ( op )
475  {
476  case PLSTATE_WIDTH:
477  tk_wr( pdf_wr_2bytes( pls->pdfs, (U_SHORT) ( pls->width ) ) );
478  break;
479 
480  case PLSTATE_COLOR0:
481  tk_wr( pdf_wr_2bytes( pls->pdfs, (U_SHORT) pls->icol0 ) );
482 
483  if ( pls->icol0 == PL_RGB_COLOR )
484  {
485  tk_wr( pdf_wr_1byte( pls->pdfs, pls->curcolor.r ) );
486  tk_wr( pdf_wr_1byte( pls->pdfs, pls->curcolor.g ) );
487  tk_wr( pdf_wr_1byte( pls->pdfs, pls->curcolor.b ) );
488  }
489  break;
490 
491  case PLSTATE_COLOR1:
492  tk_wr( pdf_wr_2bytes( pls->pdfs, (U_SHORT) pls->icol1 ) );
493  break;
494 
495  case PLSTATE_FILL:
496  tk_wr( pdf_wr_1byte( pls->pdfs, (U_CHAR) pls->patt ) );
497  break;
498 
499  case PLSTATE_CMAP0:
500  tk_wr( pdf_wr_2bytes( pls->pdfs, (U_SHORT) pls->ncol0 ) );
501  for ( i = 0; i < pls->ncol0; i++ )
502  {
503  tk_wr( pdf_wr_1byte( pls->pdfs, pls->cmap0[i].r ) );
504  tk_wr( pdf_wr_1byte( pls->pdfs, pls->cmap0[i].g ) );
505  tk_wr( pdf_wr_1byte( pls->pdfs, pls->cmap0[i].b ) );
506  }
507  break;
508 
509  case PLSTATE_CMAP1:
510  tk_wr( pdf_wr_2bytes( pls->pdfs, (U_SHORT) pls->ncol1 ) );
511  for ( i = 0; i < pls->ncol1; i++ )
512  {
513  tk_wr( pdf_wr_1byte( pls->pdfs, pls->cmap1[i].r ) );
514  tk_wr( pdf_wr_1byte( pls->pdfs, pls->cmap1[i].g ) );
515  tk_wr( pdf_wr_1byte( pls->pdfs, pls->cmap1[i].b ) );
516  }
517  // Need to send over the control points too!
518  tk_wr( pdf_wr_2bytes( pls->pdfs, (U_SHORT) pls->ncp1 ) );
519  for ( i = 0; i < pls->ncp1; i++ )
520  {
521  tk_wr( pdf_wr_ieeef( pls->pdfs, (float) pls->cmap1cp[i].h ) );
522  tk_wr( pdf_wr_ieeef( pls->pdfs, (float) pls->cmap1cp[i].l ) );
523  tk_wr( pdf_wr_ieeef( pls->pdfs, (float) pls->cmap1cp[i].s ) );
524  tk_wr( pdf_wr_1byte( pls->pdfs, (U_CHAR) pls->cmap1cp[i].alt_hue_path ) );
525  }
526  break;
527  }
528 
529  if ( pls->pdfs->bp > (size_t) pls->bufmax )
530  flush_output( pls );
531 }
532 
533 //--------------------------------------------------------------------------
534 // plD_esc_tk()
535 //
536 // Escape function.
537 // Functions:
538 //
539 // PLESC_EXPOSE Force an expose (just passes token)
540 // PLESC_RESIZE Force a resize (just passes token)
541 // PLESC_REDRAW Force a redraw
542 // PLESC_FLUSH Flush X event buffer
543 // PLESC_FILL Fill polygon
544 // PLESC_EH Handle events only
545 // PLESC_XORMOD Xor mode
546 //
547 //--------------------------------------------------------------------------
548 
549 void
550 plD_esc_tk( PLStream *pls, PLINT op, void *ptr )
551 {
552  U_CHAR c = (U_CHAR) ESCAPE;
553 
554  dbug_enter( "plD_esc_tk" );
555 
556  switch ( op )
557  {
558  case PLESC_DI:
559  tk_wr( pdf_wr_1byte( pls->pdfs, c ) );
560  tk_wr( pdf_wr_1byte( pls->pdfs, (U_CHAR) op ) );
561  tk_di( pls );
562  break;
563 
564  case PLESC_EH:
565  tk_wr( pdf_wr_1byte( pls->pdfs, c ) );
566  tk_wr( pdf_wr_1byte( pls->pdfs, (U_CHAR) op ) );
567  HandleEvents( pls );
568  break;
569 
570  case PLESC_FLUSH:
571  tk_wr( pdf_wr_1byte( pls->pdfs, c ) );
572  tk_wr( pdf_wr_1byte( pls->pdfs, (U_CHAR) op ) );
573  flush_output( pls );
574  break;
575 
576  case PLESC_FILL:
577  tk_wr( pdf_wr_1byte( pls->pdfs, c ) );
578  tk_wr( pdf_wr_1byte( pls->pdfs, (U_CHAR) op ) );
579  tk_fill( pls );
580  break;
581 
582  case PLESC_GETC:
583  GetCursor( pls, (PLGraphicsIn *) ptr );
584  break;
585 
586  case PLESC_XORMOD:
587  tk_XorMod( pls, (PLINT *) ptr );
588  break;
589 
590  default:
591  tk_wr( pdf_wr_1byte( pls->pdfs, c ) );
592  tk_wr( pdf_wr_1byte( pls->pdfs, (U_CHAR) op ) );
593  }
594 }
595 
596 //--------------------------------------------------------------------------
597 // tk_XorMod()
598 //
599 // enter (mod = 1) or leave (mod = 0) xor mode
600 //
601 //--------------------------------------------------------------------------
602 
603 static void
604 tk_XorMod( PLStream *pls, PLINT *ptr )
605 {
606  if ( *ptr != 0 )
607  server_cmd( pls, "$plwidget cmd plxormod 1 st", 1 );
608  else
609  server_cmd( pls, "$plwidget cmd plxormod 0 st", 1 );
610 }
611 
612 
613 //--------------------------------------------------------------------------
614 // GetCursor()
615 //
616 // Waits for a graphics input event and returns coordinates.
617 //--------------------------------------------------------------------------
618 
619 static void
620 GetCursor( PLStream *pls, PLGraphicsIn *ptr )
621 {
622  TkDev *dev = (TkDev *) pls->dev;
623  PLGraphicsIn *gin = &( dev->gin );
624 
625 // Initialize
626 
627  plGinInit( gin );
629  plD_esc_tk( pls, PLESC_FLUSH, NULL );
630  server_cmd( pls, "$plwidget configure -xhairs on", 1 );
631 
632 // Run event loop until a point is selected
633 
634  while ( gin->pX < 0 && dev->locate_mode )
635  {
636  Tk_DoOneEvent( 0 );
637  }
638 
639 // Clean up
640 
641  server_cmd( pls, "$plwidget configure -xhairs off", 1 );
642  *ptr = *gin;
643 }
644 
645 //--------------------------------------------------------------------------
646 // tk_di
647 //
648 // Process driver interface command.
649 // Just send the command to the remote PLplot library.
650 //--------------------------------------------------------------------------
651 
652 static void
653 tk_di( PLStream *pls )
654 {
655  TkDev *dev = (TkDev *) pls->dev;
656  char str[STR_LEN];
657 
658  dbug_enter( "tk_di" );
659 
660 // Safety feature, should never happen
661 
662  if ( dev == NULL )
663  {
664  plabort( "tk_di: Illegal call to driver (not yet initialized)" );
665  return;
666  }
667 
668 // Flush the buffer before proceeding
669 
670  flush_output( pls );
671 
672 // Change orientation
673 
674  if ( pls->difilt & PLDI_ORI )
675  {
676  snprintf( str, STR_LEN, "%f", pls->diorot );
677  Tcl_SetVar( dev->interp, "rot", str, 0 );
678 
679  server_cmd( pls, "$plwidget cmd plsetopt -ori $rot", 1 );
680  pls->difilt &= ~PLDI_ORI;
681  }
682 
683 // Change window into plot space
684 
685  if ( pls->difilt & PLDI_PLT )
686  {
687  snprintf( str, STR_LEN, "%f", pls->dipxmin );
688  Tcl_SetVar( dev->interp, "xl", str, 0 );
689  snprintf( str, STR_LEN, "%f", pls->dipymin );
690  Tcl_SetVar( dev->interp, "yl", str, 0 );
691  snprintf( str, STR_LEN, "%f", pls->dipxmax );
692  Tcl_SetVar( dev->interp, "xr", str, 0 );
693  snprintf( str, STR_LEN, "%f", pls->dipymax );
694  Tcl_SetVar( dev->interp, "yr", str, 0 );
695 
696  server_cmd( pls, "$plwidget cmd plsetopt -wplt $xl,$yl,$xr,$yr", 1 );
697  pls->difilt &= ~PLDI_PLT;
698  }
699 
700 // Change window into device space
701 
702  if ( pls->difilt & PLDI_DEV )
703  {
704  snprintf( str, STR_LEN, "%f", pls->mar );
705  Tcl_SetVar( dev->interp, "mar", str, 0 );
706  snprintf( str, STR_LEN, "%f", pls->aspect );
707  Tcl_SetVar( dev->interp, "aspect", str, 0 );
708  snprintf( str, STR_LEN, "%f", pls->jx );
709  Tcl_SetVar( dev->interp, "jx", str, 0 );
710  snprintf( str, STR_LEN, "%f", pls->jy );
711  Tcl_SetVar( dev->interp, "jy", str, 0 );
712 
713  server_cmd( pls, "$plwidget cmd plsetopt -mar $mar", 1 );
714  server_cmd( pls, "$plwidget cmd plsetopt -a $aspect", 1 );
715  server_cmd( pls, "$plwidget cmd plsetopt -jx $jx", 1 );
716  server_cmd( pls, "$plwidget cmd plsetopt -jy $jy", 1 );
717  pls->difilt &= ~PLDI_DEV;
718  }
719 
720 // Update view
721 
722  server_cmd( pls, "update", 1 );
723  server_cmd( pls, "plw::update_view $plwindow", 1 );
724 }
725 
726 //--------------------------------------------------------------------------
727 // tk_fill()
728 //
729 // Fill polygon described in points pls->dev_x[] and pls->dev_y[].
730 //--------------------------------------------------------------------------
731 
732 static void
733 tk_fill( PLStream *pls )
734 {
735  PLDev *dev = (PLDev *) pls->dev;
736 
737  dbug_enter( "tk_fill" );
738 
739  tk_wr( pdf_wr_2bytes( pls->pdfs, (U_SHORT) pls->dev_npts ) );
740 
741  tk_wr( pdf_wr_2nbytes( pls->pdfs, (U_SHORT *) pls->dev_x, pls->dev_npts ) );
742  tk_wr( pdf_wr_2nbytes( pls->pdfs, (U_SHORT *) pls->dev_y, pls->dev_npts ) );
743 
744  dev->xold = PL_UNDEFINED;
745  dev->yold = PL_UNDEFINED;
746 }
747 
748 //--------------------------------------------------------------------------
749 // tk_start
750 //
751 // Create TCL interpreter and spawn off server process.
752 // Each stream that uses the tk driver gets its own interpreter.
753 //--------------------------------------------------------------------------
754 
755 static void
756 tk_start( PLStream *pls )
757 {
758  TkDev *dev = (TkDev *) pls->dev;
759 
760  dbug_enter( "tk_start" );
761 
762 // Instantiate a TCL interpreter, and get rid of the exec command
763 
764  dev->interp = Tcl_CreateInterp();
765 
766  if ( Tcl_Init( dev->interp ) != TCL_OK )
767  {
768  fprintf( stderr, "%s\n", Tcl_GetStringResult( dev->interp ) );
769  abort_session( pls, "Unable to initialize Tcl" );
770  }
771 
772  tcl_cmd( pls, "rename exec {}" );
773 
774 // Set top level window name & initialize
775 
776  set_windowname( pls );
777  if ( pls->dp )
778  {
779  Tcl_SetVar( dev->interp, "dp", "1", TCL_GLOBAL_ONLY );
780  dev->updatecmd = "dp_update";
781  }
782  else
783  {
784  Tcl_SetVar( dev->interp, "dp", "0", TCL_GLOBAL_ONLY );
785 
786  // tk_init needs this. Use pls->FileName first, then DISPLAY, then :0.0
787 
788  if ( pls->FileName != NULL )
789  Tcl_SetVar2( dev->interp, "env", "DISPLAY", pls->FileName, TCL_GLOBAL_ONLY );
790  else if ( getenv( "DISPLAY" ) != NULL )
791  Tcl_SetVar2( dev->interp, "env", "DISPLAY", getenv( "DISPLAY" ), TCL_GLOBAL_ONLY ); // tk_init need this
792  else
793  Tcl_SetVar2( dev->interp, "env", "DISPLAY", "unix:0.0", TCL_GLOBAL_ONLY ); // tk_init need this
794 
795  dev->updatecmd = "update";
796  if ( pltk_toplevel( &dev->w, dev->interp ) )
797  abort_session( pls, "Unable to create top-level window" );
798  }
799 
800 // Eval startup procs
801 
802  if ( pltkdriver_Init( pls ) != TCL_OK )
803  {
804  abort_session( pls, "" );
805  }
806 
807  if ( pls->debug )
808  tcl_cmd( pls, "global auto_path; puts \"auto_path: $auto_path\"" );
809 
810 // Other initializations.
811 // Autoloaded, so the user can customize it if desired
812 
813  tcl_cmd( pls, "plclient_init" );
814 
815 // A different way to customize the interface.
816 // E.g. used by plrender to add a back page button.
817 
818  if ( drvoptcmd )
819  tcl_cmd( pls, drvoptcmd );
820 
821 // Initialize server process
822 
823  init_server( pls );
824 
825 // By now we should be done with all autoloaded procs, so blow away
826 // the open command just in case security has been compromised
827 
828  tcl_cmd( pls, "rename open {}" );
829  tcl_cmd( pls, "rename rename {}" );
830 
831 // Initialize widgets
832 
833  plwindow_init( pls );
834 
835 // Initialize data link
836 
837  link_init( pls );
838 
839  return;
840 }
841 
842 //--------------------------------------------------------------------------
843 // tk_stop
844 //
845 // Normal termination & cleanup.
846 //--------------------------------------------------------------------------
847 
848 static void
849 tk_stop( PLStream *pls )
850 {
851  TkDev *dev = (TkDev *) pls->dev;
852 
853  dbug_enter( "tk_stop" );
854 
855 // Safety check for out of control code
856 
857  if ( dev->pass_thru )
858  return;
859 
860  dev->pass_thru = 1;
861 
862 // Kill plserver
863 
864  tcl_cmd( pls, "plclient_link_end" );
865 
866 // Wait for child process to complete
867 
868  if ( dev->child_pid )
869  {
870  waitpid( dev->child_pid, NULL, 0 );
871 //
872 // problems if parent has not caught/ignore SIGCHLD. Returns -1 and errno=EINTR
873 // if (waitpid(dev->child_pid, NULL, 0) != dev->child_pid)
874 // fprintf(stderr, "tk_stop: waidpid error");
875 //
876  }
877 
878 // Blow away interpreter
879 
880  Tcl_DeleteInterp( dev->interp );
881  dev->interp = NULL;
882 
883 // Free up memory and other miscellanea
884 
885  pdf_close( pls->pdfs );
886  if ( dev->iodev != NULL )
887  {
888  if ( dev->iodev->file != NULL )
889  plCloseFile( pls );
890 
891  free( (void *) dev->iodev );
892  }
893  free_mem( dev->cmdbuf );
894 }
895 
896 //--------------------------------------------------------------------------
897 // abort_session
898 //
899 // Terminates with an error.
900 // Cleanup is done here, and once pls->level is cleared the driver will
901 // never be called again.
902 //--------------------------------------------------------------------------
903 
904 static void
905 abort_session( PLStream *pls, const char *msg )
906 {
907  TkDev *dev = (TkDev *) pls->dev;
908 
909  dbug_enter( "abort_session" );
910 
911 // Safety check for out of control code
912 
913  if ( dev->pass_thru )
914  return;
915 
916  tk_stop( pls );
917  pls->level = 0;
918 
919  plexit( msg );
920 }
921 
922 //--------------------------------------------------------------------------
923 // pltkdriver_Init
924 //
925 // Performs PLplot/TK driver-specific Tcl initialization.
926 //--------------------------------------------------------------------------
927 
928 static int
929 pltkdriver_Init( PLStream *pls )
930 {
931  TkDev *dev = (TkDev *) pls->dev;
932  Tcl_Interp *interp = (Tcl_Interp *) dev->interp;
933 
934 //
935 // Call the init procedures for included packages. Each call should
936 // look like this:
937 //
938 // if (Mod_Init(interp) == TCL_ERROR) {
939 // return TCL_ERROR;
940 // }
941 //
942 // where "Mod" is the name of the module.
943 //
944 
945  if ( Tcl_Init( interp ) == TCL_ERROR )
946  {
947  return TCL_ERROR;
948  }
949 #ifdef PLD_dp
950  if ( pls->dp )
951  {
952  if ( Tdp_Init( interp ) == TCL_ERROR )
953  {
954  return TCL_ERROR;
955  }
956  }
957 #endif
958 
959 //
960 // Call Tcl_CreateCommand for application-specific commands, if
961 // they weren't already created by the init procedures called above.
962 //
963 
964  Tcl_CreateCommand( interp, "wait_until", (Tcl_CmdProc *) plWait_Until,
965  (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL );
966 
967 #ifdef PLD_dp
968  if ( pls->dp )
969  {
970  Tcl_CreateCommand( interp, "host_id", (Tcl_CmdProc *) plHost_ID,
971  (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL );
972  }
973 #endif
974 
975  Tcl_CreateCommand( interp, "abort", (Tcl_CmdProc *) Abort,
976  (ClientData) pls, (Tcl_CmdDeleteProc *) NULL );
977 
978  Tcl_CreateCommand( interp, "plfinfo", (Tcl_CmdProc *) Plfinfo,
979  (ClientData) pls, (Tcl_CmdDeleteProc *) NULL );
980 
981  Tcl_CreateCommand( interp, "keypress", (Tcl_CmdProc *) KeyEH,
982  (ClientData) pls, (Tcl_CmdDeleteProc *) NULL );
983 
984  Tcl_CreateCommand( interp, "buttonpress", (Tcl_CmdProc *) ButtonEH,
985  (ClientData) pls, (Tcl_CmdDeleteProc *) NULL );
986 
987 // Set some relevant interpreter variables
988 
989  if ( !pls->dp )
990  tcl_cmd( pls, "set client_name [winfo name .]" );
991 
992  if ( pls->server_name != NULL )
993  Tcl_SetVar( interp, "server_name", pls->server_name, 0 );
994 
995  if ( pls->server_host != NULL )
996  Tcl_SetVar( interp, "server_host", pls->server_host, 0 );
997 
998  if ( pls->server_port != NULL )
999  Tcl_SetVar( interp, "server_port", pls->server_port, 0 );
1000 
1001 // Set up auto_path
1002 
1003  if ( pls_auto_path( interp ) == TCL_ERROR )
1004  return TCL_ERROR;
1005 
1006  return TCL_OK;
1007 }
1008 
1009 //--------------------------------------------------------------------------
1010 // init_server
1011 //
1012 // Starts interaction with server process, launching it if necessary.
1013 //
1014 // There are several possibilities we must account for, depending on the
1015 // message protocol, input flags, and whether plserver is already running
1016 // or not. From the point of view of the code, they are:
1017 //
1018 // 1. Driver: tk
1019 // Flags: <none>
1020 // Meaning: need to start up plserver (same host)
1021 // Actions: fork plserver, passing it our TK main window name
1022 // for communication. Once started, plserver will send
1023 // back its main window name.
1024 //
1025 // 2. Driver: dp
1026 // Flags: <none>
1027 // Meaning: need to start up plserver (same host)
1028 // Actions: fork plserver, passing it our Tcl-DP communication port
1029 // for communication. Once started, plserver will send
1030 // back its created message port number.
1031 //
1032 // 3. Driver: tk
1033 // Flags: -server_name
1034 // Meaning: plserver already running (same host)
1035 // Actions: communicate to plserver our TK main window name.
1036 //
1037 // 4. Driver: dp
1038 // Flags: -server_port
1039 // Meaning: plserver already running (same host)
1040 // Actions: communicate to plserver our Tcl-DP port number.
1041 //
1042 // 5. Driver: dp
1043 // Flags: -server_host
1044 // Meaning: need to start up plserver (remote host)
1045 // Actions: rsh (remsh) plserver, passing it our host ID and Tcl-DP
1046 // port for communication. Once started, plserver will send
1047 // back its created message port number.
1048 //
1049 // 6. Driver: dp
1050 // Flags: -server_host -server_port
1051 // Meaning: plserver already running (remote host)
1052 // Actions: communicate to remote plserver our host ID and Tcl-DP
1053 // port number.
1054 //
1055 // For a bit more flexibility, you can change the name of the process
1056 // invoked from "plserver" to something else, using the -plserver flag.
1057 //
1058 // The startup procedure involves some rather involved handshaking between
1059 // client and server. This is made easier by using the Tcl variables:
1060 //
1061 // client_host client_port server_host server_port
1062 //
1063 // when using Tcl-DP sends and
1064 //
1065 // client_name server_name
1066 //
1067 // when using TK sends. The global Tcl variables
1068 //
1069 // client server
1070 //
1071 // are used as the defining identification for the client and server
1072 // respectively -- they denote the main window name when TK sends are used
1073 // and the respective process's listening socket when Tcl-DP sends are
1074 // used. Note that in the former case, $client is just the same as
1075 // $client_name. In addition, since the server may need to communicate
1076 // with many different client processes, every command to the server
1077 // contains the sender's client id (so it knows how to report back if
1078 // necessary). Thus the Tk driver's interpreter must know both $server as
1079 // well as $client. It is most convenient to set $client from the server,
1080 // as a way to signal that communication has been set up and it is safe to
1081 // proceed.
1082 //
1083 // Often it is necessary to use constructs such as [list $server] instead
1084 // of just $server. This occurs since you could have multiple copies
1085 // running on the display (resulting in names of the form "plserver #2",
1086 // etc). Embedding such a string in a "[list ...]" construct prevents the
1087 // string from being interpreted as two separate strings.
1088 //--------------------------------------------------------------------------
1089 
1090 static void
1091 init_server( PLStream *pls )
1092 {
1093  int server_exists = 0;
1094 
1095  dbug_enter( "init_server" );
1096 
1097  pldebug( "init_server", "%s -- PID: %d, PGID: %d, PPID: %d\n",
1098  __FILE__, (int) getpid(), (int) getpgrp(), (int) getppid() );
1099 
1100 // If no means of communication provided, need to launch plserver
1101 
1102  if ( ( !pls->dp && pls->server_name != NULL ) ||
1103  ( pls->dp && pls->server_port != NULL ) )
1104  server_exists = 1;
1105 
1106 // So launch it
1107 
1108  if ( !server_exists )
1109  launch_server( pls );
1110 
1111 // Set up communication channel to server
1112 
1113  if ( pls->dp )
1114  {
1115  tcl_cmd( pls,
1116  "set server [dp_MakeRPCClient $server_host $server_port]" );
1117  }
1118  else
1119  {
1120  tcl_cmd( pls, "set server $server_name" );
1121  }
1122 
1123 // If server didn't need launching, contact it here
1124 
1125  if ( server_exists )
1126  tcl_cmd( pls, "plclient_link_init" );
1127 }
1128 
1129 //--------------------------------------------------------------------------
1130 // launch_server
1131 //
1132 // Launches plserver, locally or remotely.
1133 //--------------------------------------------------------------------------
1134 
1135 static void
1136 launch_server( PLStream *pls )
1137 {
1138  TkDev *dev = (TkDev *) pls->dev;
1139  const char *argv[20];
1140  char *plserver_exec = NULL, *ptr;
1141  char *tmp = NULL;
1142  int i;
1143 
1144  dbug_enter( "launch_server" );
1145 
1146  if ( pls->plserver == NULL )
1147  pls->plserver = plstrdup( "plserver" );
1148 
1149 // Build argument list
1150 
1151  i = 0;
1152 
1153 // If we're doing a rsh, need to set up its arguments first.
1154 
1155  if ( pls->dp && pls->server_host != NULL )
1156  {
1157  argv[i++] = pls->server_host; // Host name for rsh
1158 
1159  if ( pls->user != NULL )
1160  {
1161  argv[i++] = "-l";
1162  argv[i++] = pls->user; // User name on remote node
1163  }
1164  }
1165 
1166 // The invoked executable name comes next
1167 
1168  argv[i++] = pls->plserver;
1169 
1170 // The rest are arguments to plserver
1171 
1172  argv[i++] = "-child"; // Tell plserver its ancestry
1173 
1174  argv[i++] = "-e"; // Startup script
1175  argv[i++] = "plserver_init";
1176 
1177 // aaahhh. This is it! Without the next statements, control is either
1178 // in tk or octave, because tcl/tk was in interative mode (I think).
1179 // This had the inconvenient of having to press the enter key or cliking a
1180 // mouse button in the plot window after every plot.
1181 //
1182 // This couldn't be done with
1183 // Tcl_SetVar(dev->interp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);
1184 // after plserver has been launched? It doesnt work, hoewever.
1185 // Tk_CreateFileHandler (0, TK_READABLE, NULL, 0) doesnt work also
1186 //
1187 
1188  argv[i++] = "-file"; // Startup file
1189  if ( pls->tk_file )
1190  argv[i++] = pls->tk_file;
1191  else
1192  argv[i++] = "/dev/null";
1193 
1194 
1195 //
1196 // Give interpreter the base name of the plwindow.
1197 // Useful to know the interpreter name
1198 //
1199 
1200  if ( pls->plwindow != NULL )
1201  {
1202  char *t;
1203  argv[i++] = "-name"; // plserver name
1204  tmp = plstrdup( pls->plwindow + 1 ); // get rid of the initial dot
1205  argv[i++] = tmp;
1206  if ( ( t = strchr( tmp, '.' ) ) != NULL )
1207  *t = '\0'; // and keep only the base name
1208  }
1209  else
1210  {
1211  argv[i++] = "-name"; // plserver name
1212  argv[i++] = pls->program;
1213  }
1214 
1215  if ( pls->auto_path != NULL )
1216  {
1217  argv[i++] = "-auto_path"; // Additional directory(s)
1218  argv[i++] = pls->auto_path; // to autoload
1219  }
1220 
1221  if ( pls->geometry != NULL )
1222  {
1223  argv[i++] = "-geometry"; // Top level window geometry
1224  argv[i++] = pls->geometry;
1225  }
1226 
1227 // If communicating via Tcl-DP, specify communications port id
1228 // If communicating via TK send, specify main window name
1229 
1230  if ( pls->dp )
1231  {
1232  argv[i++] = "-client_host";
1233  argv[i++] = Tcl_GetVar( dev->interp, "client_host", TCL_GLOBAL_ONLY );
1234 
1235  argv[i++] = "-client_port";
1236  argv[i++] = Tcl_GetVar( dev->interp, "client_port", TCL_GLOBAL_ONLY );
1237 
1238  if ( pls->user != NULL )
1239  {
1240  argv[i++] = "-l";
1241  argv[i++] = pls->user;
1242  }
1243  }
1244  else
1245  {
1246  argv[i++] = "-client_name";
1247  argv[i++] = Tcl_GetVar( dev->interp, "client_name", TCL_GLOBAL_ONLY );
1248  }
1249 
1250 // The display absolutely must be set if invoking a remote server (by rsh)
1251 // Use the DISPLAY environmental, if set. Otherwise use the remote host.
1252 
1253  if ( pls->FileName != NULL )
1254  {
1255  argv[i++] = "-display";
1256  argv[i++] = pls->FileName;
1257  }
1258  else if ( pls->dp && pls->server_host != NULL )
1259  {
1260  argv[i++] = "-display";
1261  if ( ( ptr = getenv( "DISPLAY" ) ) != NULL )
1262  argv[i++] = ptr;
1263  else
1264  argv[i++] = "unix:0.0";
1265  }
1266 
1267 // Add terminating null
1268 
1269  argv[i++] = NULL;
1270 #ifdef DEBUG
1271  if ( pls->debug )
1272  {
1273  int j;
1274  fprintf( stderr, "argument list: \n " );
1275  for ( j = 0; j < i; j++ )
1276  fprintf( stderr, "%s ", argv[j] );
1277  fprintf( stderr, "\n" );
1278  }
1279 #endif
1280 
1281 // Start server process
1282 // It's a fork/rsh if on a remote machine
1283 
1284  if ( pls->dp && pls->server_host != NULL )
1285  {
1286  if ( ( dev->child_pid = fork() ) < 0 )
1287  {
1288  abort_session( pls, "Unable to fork server process" );
1289  }
1290  else if ( dev->child_pid == 0 )
1291  {
1292  fprintf( stderr, "Starting up %s on node %s\n", pls->plserver,
1293  pls->server_host );
1294 
1295  if ( execvp( "rsh", (char * const *) argv ) )
1296  {
1297  perror( "Unable to exec server process" );
1298  _exit( 1 );
1299  }
1300  }
1301  }
1302 
1303 // Running locally, so its a fork/exec
1304 
1305  else
1306  {
1307  plserver_exec = plFindCommand( pls->plserver );
1308  if ( ( plserver_exec == NULL ) || ( dev->child_pid = fork() ) < 0 )
1309  {
1310  abort_session( pls, "Unable to fork server process" );
1311  }
1312  else if ( dev->child_pid == 0 )
1313  {
1314  // Don't kill plserver on a ^C if pls->server_nokill is set
1315 
1316  if ( pls->server_nokill )
1317  {
1318  sigset_t set;
1319  sigemptyset( &set );
1320  sigaddset( &set, SIGINT );
1321  if ( sigprocmask( SIG_BLOCK, &set, 0 ) < 0 )
1322  fprintf( stderr, "PLplot: sigprocmask failure\n" );
1323  }
1324 
1325  pldebug( "launch_server", "Starting up %s\n", plserver_exec );
1326  if ( execv( plserver_exec, (char * const *) argv ) )
1327  {
1328  fprintf( stderr, "Unable to exec server process.\n" );
1329  _exit( 1 );
1330  }
1331  }
1332  free_mem( plserver_exec );
1333  }
1334  free_mem( tmp );
1335 
1336 // Wait for server to set up return communication channel
1337 
1338  tk_wait( pls, "[info exists client]" );
1339 }
1340 
1341 //--------------------------------------------------------------------------
1342 // plwindow_init
1343 //
1344 // Configures the widget hierarchy we are sending the data stream to.
1345 //
1346 // If a widget name (identifying the actual widget or a container widget)
1347 // hasn't been supplied already we assume it needs to be created.
1348 //
1349 // In order to achieve maximum flexibility, the PLplot tk driver requires
1350 // only that certain TCL procs must be defined in the server interpreter.
1351 // These can be used to set up the desired widget configuration. The procs
1352 // invoked from this driver currently include:
1353 //
1354 // $plw_create_proc Creates the widget environment
1355 // $plw_start_proc Does any remaining startup necessary
1356 // $plw_end_proc Prepares for shutdown
1357 // $plw_flash_proc Invoked when waiting for page advance
1358 //
1359 // Since all of these are interpreter variables, they can be trivially
1360 // changed by the user.
1361 //
1362 // Each of these utility procs is called with a widget name ($plwindow)
1363 // as argument. "plwindow" is set from the value of pls->plwindow, and
1364 // if null is generated from the name of the client main window (to
1365 // ensure uniqueness). $plwindow usually indicates the container frame
1366 // for the actual PLplot widget, but can be arbitrary -- as long as the
1367 // usage in all the TCL procs is consistent.
1368 //
1369 // In order that the TK driver be able to invoke the actual PLplot
1370 // widget, the proc "$plw_create_proc" deposits the widget name in the local
1371 // interpreter variable "plwidget".
1372 //--------------------------------------------------------------------------
1373 
1374 static void
1375 plwindow_init( PLStream *pls )
1376 {
1377  TkDev *dev = (TkDev *) pls->dev;
1378  char command[CMD_LEN];
1379  unsigned int bg;
1380  char *tmp;
1381  int i, n;
1382 
1383  dbug_enter( "plwindow_init" );
1384 
1385  // Set tcl plwindow variable to be pls->plwindow with a . prepended and
1386  // and with ' ' replaced by '_' and all other '.' by '_' to avoid
1387  // quoting and bad window name problems. Also avoid name starting with
1388  // an upper case letter.
1389  n = (int) strlen( pls->plwindow ) + 1;
1390  tmp = (char *) malloc( sizeof ( char ) * (size_t) ( n + 1 ) );
1391  sprintf( tmp, ".%s", pls->plwindow );
1392  for ( i = 1; i < n; i++ )
1393  {
1394  if ( ( tmp[i] == ' ' ) || ( tmp[i] == '.' ) )
1395  tmp[i] = '_';
1396  }
1397  if ( isupper( tmp[1] ) )
1398  tmp[1] = tolower( tmp[1] );
1399  Tcl_SetVar( dev->interp, "plwindow", tmp, 0 );
1400  free( tmp );
1401 
1402 // Create the plframe widget & anything else you want with it.
1403 
1404  server_cmd( pls,
1405  "$plw_create_proc $plwindow [list $client]", 1 );
1406 
1407  tk_wait( pls, "[info exists plwidget]" );
1408 
1409 // Now we should have the actual PLplot widget name in $plwidget
1410 // Configure remote PLplot stream.
1411 
1412 // Configure background color if anything other than black
1413 // The default color is handled from a resource setting in plconfig.tcl
1414 
1415  bg = (unsigned int) ( pls->cmap0[0].b | ( pls->cmap0[0].g << 8 ) | ( pls->cmap0[0].r << 16 ) );
1416  if ( bg > 0 )
1417  {
1418  snprintf( command, CMD_LEN, "$plwidget configure -plbg #%06x", bg );
1419  server_cmd( pls, command, 0 );
1420  }
1421 
1422 // nopixmap option
1423 
1424  if ( pls->nopixmap )
1425  server_cmd( pls, "$plwidget cmd plsetopt -nopixmap", 0 );
1426 
1427 // debugging
1428 
1429  if ( pls->debug )
1430  server_cmd( pls, "$plwidget cmd plsetopt -debug", 0 );
1431 
1432 // double buffering
1433 
1434  if ( pls->db )
1435  server_cmd( pls, "$plwidget cmd plsetopt -db", 0 );
1436 
1437 // color map options
1438 
1439  if ( pls->ncol0 )
1440  {
1441  snprintf( command, CMD_LEN, "$plwidget cmd plsetopt -ncol0 %d", pls->ncol0 );
1442  server_cmd( pls, command, 0 );
1443  }
1444 
1445  if ( pls->ncol1 )
1446  {
1447  snprintf( command, CMD_LEN, "$plwidget cmd plsetopt -ncol1 %d", pls->ncol1 );
1448  server_cmd( pls, command, 0 );
1449  }
1450 
1451 // Start up remote PLplot
1452 
1453  server_cmd( pls, "$plw_start_proc $plwindow", 1 );
1454  tk_wait( pls, "[info exists widget_is_ready]" );
1455 }
1456 
1457 //--------------------------------------------------------------------------
1458 // set_windowname
1459 //
1460 // Set up top level window name. Use pls->program, modified appropriately.
1461 //--------------------------------------------------------------------------
1462 
1463 static void
1464 set_windowname( PLStream *pls )
1465 {
1466  const char *pname;
1467  int i;
1468  size_t maxlen;
1469 
1470  // Set to "plclient" if not initialized via plargs or otherwise
1471 
1472  if ( pls->program == NULL )
1473  pls->program = plstrdup( "plclient" );
1474 
1475  // Eliminate any leading path specification
1476 
1477  pname = strrchr( pls->program, '/' );
1478  if ( pname )
1479  pname++;
1480  else
1481  pname = pls->program;
1482 
1483  if ( pls->plwindow == NULL ) // dont override -plwindow cmd line option
1484  {
1485  maxlen = strlen( pname ) + 10;
1486  pls->plwindow = (char *) malloc( maxlen * sizeof ( char ) );
1487 
1488  // Allow for multiple widgets created by multiple streams
1489 
1490  if ( pls->ipls == 0 )
1491  snprintf( pls->plwindow, maxlen, ".%s", pname );
1492  else
1493  snprintf( pls->plwindow, maxlen, ".%s_%d", pname, (int) pls->ipls );
1494 
1495  // Replace any ' 's with '_'s to avoid quoting problems.
1496  // Replace any '.'s (except leading) with '_'s to avoid bad window names.
1497 
1498  for ( i = 0; i < (int) strlen( pls->plwindow ); i++ )
1499  {
1500  if ( pls->plwindow[i] == ' ' )
1501  pls->plwindow[i] = '_';
1502  if ( i == 0 )
1503  continue;
1504  if ( pls->plwindow[i] == '.' )
1505  pls->plwindow[i] = '_';
1506  }
1507  }
1508 }
1509 
1510 //--------------------------------------------------------------------------
1511 // link_init
1512 //
1513 // Initializes the link between the client and the PLplot widget for
1514 // data transfer. Defaults to a FIFO when the TK driver is selected and
1515 // a socket when the DP driver is selected.
1516 //--------------------------------------------------------------------------
1517 
1518 static void
1519 link_init( PLStream *pls )
1520 {
1521  TkDev *dev = (TkDev *) pls->dev;
1522  PLiodev *iodev = (PLiodev *) dev->iodev;
1523  size_t bufmax = (size_t) ( pls->bufmax * 1.2 );
1524 
1525  dbug_enter( "link_init" );
1526 
1527 // Create FIFO for data transfer to the plframe widget
1528 
1529  if ( !pls->dp )
1530  {
1531  // This of tmpnam should (?) be safe since mkfifo
1532  // will fail if the filename already exists
1533  iodev->fileName = (char *) tmpnam( NULL );
1534  if ( mkfifo( iodev->fileName,
1535  S_IRUSR | S_IWUSR | S_IRGRP | S_IROTH ) < 0 )
1536  abort_session( pls, "mkfifo error" );
1537 
1538  // Tell plframe widget to open FIFO (for reading).
1539 
1540  Tcl_SetVar( dev->interp, "fifoname", iodev->fileName, 0 );
1541  server_cmd( pls, "$plwidget openlink fifo $fifoname", 1 );
1542 
1543  // Open the FIFO for writing
1544  // This will block until the server opens it for reading
1545 
1546  if ( ( iodev->fd = open( iodev->fileName, O_WRONLY ) ) == -1 )
1547  abort_session( pls, "Error opening fifo for write" );
1548 
1549  // Create stream interface (C file handle) to FIFO
1550 
1551  iodev->type = 0;
1552  iodev->typeName = "fifo";
1553  iodev->file = fdopen( iodev->fd, "wb" );
1554 
1555 // Unlink FIFO so that it isn't left around if program crashes.
1556 // This also ensures no other program can mess with it.
1557 
1558  if ( unlink( iodev->fileName ) == -1 )
1559  abort_session( pls, "Error removing fifo" );
1560  }
1561 
1562 // Create socket for data transfer to the plframe widget
1563 
1564  else
1565  {
1566  iodev->type = 1;
1567  iodev->typeName = "socket";
1568  tcl_cmd( pls, "plclient_dp_init" );
1569  iodev->fileHandle = Tcl_GetVar( dev->interp, "data_sock", 0 );
1570 
1571  if ( Tcl_GetOpenFile( dev->interp, iodev->fileHandle,
1572  0, 1, ( ClientData ) & iodev->file ) != TCL_OK )
1573  {
1574  fprintf( stderr, "Cannot get file info:\n\t %s\n",
1575  Tcl_GetStringResult( dev->interp ) );
1576  abort_session( pls, "" );
1577  }
1578  iodev->fd = fileno( iodev->file );
1579  }
1580 
1581 // Create data buffer
1582 
1583  pls->pdfs = pdf_bopen( NULL, (size_t) bufmax );
1584 }
1585 
1586 //--------------------------------------------------------------------------
1587 // WaitForPage()
1588 //
1589 // Waits for a page advance.
1590 //--------------------------------------------------------------------------
1591 
1592 static void
1593 WaitForPage( PLStream *pls )
1594 {
1595  TkDev *dev = (TkDev *) pls->dev;
1596 
1597  dbug_enter( "WaitForPage" );
1598 
1599  while ( !dev->exit_eventloop )
1600  {
1601  Tk_DoOneEvent( 0 );
1602  }
1603  dev->exit_eventloop = 0;
1604 }
1605 
1606 //--------------------------------------------------------------------------
1607 // CheckForEvents()
1608 //
1609 // A front-end to HandleEvents(), which is only called if certain conditions
1610 // are satisfied:
1611 //
1612 // - only check for events and process them every dev->max_instr times this
1613 // function is called (good for performance since performing an update is
1614 // a nontrivial performance hit).
1615 //--------------------------------------------------------------------------
1616 
1617 static void
1618 CheckForEvents( PLStream *pls )
1619 {
1620  TkDev *dev = (TkDev *) pls->dev;
1621 
1622  if ( ++dev->instr % dev->max_instr == 0 )
1623  {
1624  dev->instr = 0;
1625  HandleEvents( pls );
1626  }
1627 }
1628 
1629 //--------------------------------------------------------------------------
1630 // HandleEvents()
1631 //
1632 // Just a front-end to the update command, for use when not actually waiting
1633 // for an event but only checking the event queue.
1634 //--------------------------------------------------------------------------
1635 
1636 static void
1637 HandleEvents( PLStream *pls )
1638 {
1639  TkDev *dev = (TkDev *) pls->dev;
1640 
1641  dbug_enter( "HandleEvents" );
1642 
1643  Tcl_VarEval( dev->interp, dev->updatecmd, (char **) NULL );
1644 }
1645 
1646 //--------------------------------------------------------------------------
1647 // flush_output()
1648 //
1649 // Sends graphics instructions to the {FIFO|socket} via a packet send.
1650 //
1651 // The packet i/o routines are modified versions of the ones from the
1652 // Tcl-DP package. They have been altered to take a pointer to a PDFstrm
1653 // struct, and read-to or write-from pdfs->buffer. The length of the
1654 // buffer is stored in pdfs->bp (the original Tcl-DP routine assumes the
1655 // message is character data and uses strlen). Also, they can
1656 // send/receive from either a fifo or a socket.
1657 //--------------------------------------------------------------------------
1658 
1659 static void
1660 flush_output( PLStream *pls )
1661 {
1662  TkDev *dev = (TkDev *) pls->dev;
1663  PDFstrm *pdfs = (PDFstrm *) pls->pdfs;
1664 
1665  dbug_enter( "flush_output" );
1666 
1667  HandleEvents( pls );
1668 
1669 // Send packet -- plserver filehandler will be invoked automatically.
1670 
1671  if ( pdfs->bp > 0 )
1672  {
1673 #ifdef DEBUG_ENTER
1674  pldebug( "flush_output", "%s: Flushing buffer, bytes = %ld\n",
1675  __FILE__, pdfs->bp );
1676 #endif
1677  if ( pl_PacketSend( dev->interp, dev->iodev, pls->pdfs ) )
1678  {
1679  fprintf( stderr, "Packet send failed:\n\t %s\n",
1680  Tcl_GetStringResult( dev->interp ) );
1681  abort_session( pls, "" );
1682  }
1683  pdfs->bp = 0;
1684  }
1685 }
1686 
1687 //--------------------------------------------------------------------------
1688 // Abort
1689 //
1690 // Just a TCL front-end to abort_session().
1691 //--------------------------------------------------------------------------
1692 
1693 static int
1694 Abort( ClientData clientData, Tcl_Interp *PL_UNUSED( interp ), int PL_UNUSED( argc ), char **PL_UNUSED( argv ) )
1695 {
1696  PLStream *pls = (PLStream *) clientData;
1697 
1698  dbug_enter( "Abort" );
1699 
1700  abort_session( pls, "" );
1701  return TCL_OK;
1702 }
1703 
1704 //--------------------------------------------------------------------------
1705 // Plfinfo
1706 //
1707 // Sends info about the server plframe. Usually issued after some
1708 // modification to the plframe is made by the user, such as a resize.
1709 //--------------------------------------------------------------------------
1710 
1711 static int
1712 Plfinfo( ClientData clientData, Tcl_Interp *interp, int argc, char **argv )
1713 {
1714  PLStream *pls = (PLStream *) clientData;
1715  TkDev *dev = (TkDev *) pls->dev;
1716  int result = TCL_OK;
1717 
1718  dbug_enter( "Plfinfo" );
1719 
1720  if ( argc < 3 )
1721  {
1722  Tcl_AppendResult( interp, "wrong # args: should be \"",
1723  " plfinfo wx wy\"", (char *) NULL );
1724  result = TCL_ERROR;
1725  }
1726  else
1727  {
1728  dev->width = (unsigned int) atoi( argv[1] );
1729  dev->height = (unsigned int) atoi( argv[2] );
1730 #if PHYSICAL
1731  {
1732  PLFLT pxlx = (double) PIXELS_X / dev->width * DPMM;
1733  PLFLT pxly = (double) PIXELS_Y / dev->height * DPMM;
1734  plP_setpxl( pxlx, pxly );
1735  }
1736 #endif
1737  }
1738 
1739  return result;
1740 }
1741 
1742 //--------------------------------------------------------------------------
1743 // KeyEH()
1744 //
1745 // This TCL command handles keyboard events.
1746 //--------------------------------------------------------------------------
1747 
1748 static int
1749 KeyEH( ClientData clientData, Tcl_Interp *interp, int argc, char **argv )
1750 {
1751  PLStream *pls = (PLStream *) clientData;
1752  TkDev *dev = (TkDev *) pls->dev;
1753  int result;
1754 
1755  dbug_enter( "KeyEH" );
1756 
1757  if ( ( result = LookupTkKeyEvent( pls, interp, argc, argv ) ) != TCL_OK )
1758  return result;
1759 
1760  if ( dev->locate_mode )
1761  LocateKey( pls );
1762  else
1763  ProcessKey( pls );
1764 
1765  return result;
1766 }
1767 
1768 //--------------------------------------------------------------------------
1769 // ButtonEH()
1770 //
1771 // This TCL command handles button events.
1772 //--------------------------------------------------------------------------
1773 
1774 static int
1775 ButtonEH( ClientData clientData, Tcl_Interp *interp, int argc, char **argv )
1776 {
1777  PLStream *pls = (PLStream *) clientData;
1778  TkDev *dev = (TkDev *) pls->dev;
1779  int result;
1780 
1781  dbug_enter( "ButtonEH" );
1782 
1783  if ( ( result = LookupTkButtonEvent( pls, interp, argc, argv ) ) != TCL_OK )
1784  return result;
1785 
1786  if ( dev->locate_mode )
1787  LocateButton( pls );
1788  else
1789  ProcessButton( pls );
1790 
1791  return result;
1792 }
1793 
1794 //--------------------------------------------------------------------------
1795 // LookupTkKeyEvent()
1796 //
1797 // Fills in the PLGraphicsIn from a Tk KeyEvent.
1798 //
1799 // Contents of argv array:
1800 // command name
1801 // keysym value
1802 // keysym state
1803 // absolute x coordinate of cursor
1804 // absolute y coordinate of cursor
1805 // relative x coordinate (normalized to [0.0 1.0])
1806 // relative y coordinate (normalized to [0.0 1.0])
1807 // keysym name
1808 // ASCII equivalent (optional)
1809 //
1810 // Note that the keysym name is only used for debugging, and the string is
1811 // not always passed (i.e. the character may not have an ASCII
1812 // representation).
1813 //--------------------------------------------------------------------------
1814 
1815 static int
1816 LookupTkKeyEvent( PLStream *pls, Tcl_Interp *interp, int argc, char **argv )
1817 {
1818  TkDev *dev = (TkDev *) pls->dev;
1819  PLGraphicsIn *gin = &( dev->gin );
1820  char *keyname;
1821 
1822  dbug_enter( "LookupTkKeyEvent" );
1823 
1824  if ( argc < 8 )
1825  {
1826  Tcl_AppendResult( interp, "wrong # args: should be \"",
1827  argv[0], " key-value state pX pY dX dY key-name ?ascii-value?\"",
1828  (char *) NULL );
1829  return TCL_ERROR;
1830  }
1831 
1832  gin->keysym = (unsigned int) atol( argv[1] );
1833  gin->state = (unsigned int) atol( argv[2] );
1834  gin->pX = atoi( argv[3] );
1835  gin->pY = atoi( argv[4] );
1836  gin->dX = atof( argv[5] );
1837  gin->dY = atof( argv[6] );
1838 
1839  keyname = argv[7];
1840 
1841  gin->string[0] = '\0';
1842  if ( argc > 8 )
1843  {
1844  gin->string[0] = argv[8][0];
1845  gin->string[1] = '\0';
1846  }
1847 
1848 // Fix up keysym value -- see notes in xwin.c about key representation
1849 
1850  switch ( gin->keysym )
1851  {
1852  case XK_BackSpace:
1853  case XK_Tab:
1854  case XK_Linefeed:
1855  case XK_Return:
1856  case XK_Escape:
1857  case XK_Delete:
1858  gin->keysym &= 0xFF;
1859  break;
1860  }
1861 
1862  pldebug( "LookupTkKeyEvent",
1863  "KeyEH: stream: %d, Keyname %s, hex %x, ASCII: %s\n",
1864  (int) pls->ipls, keyname, (unsigned int) gin->keysym, gin->string );
1865 
1866  return TCL_OK;
1867 }
1868 
1869 //--------------------------------------------------------------------------
1870 // LookupTkButtonEvent()
1871 //
1872 // Fills in the PLGraphicsIn from a Tk ButtonEvent.
1873 //
1874 // Contents of argv array:
1875 // command name
1876 // button number
1877 // state (decimal string)
1878 // absolute x coordinate
1879 // absolute y coordinate
1880 // relative x coordinate (normalized to [0.0 1.0])
1881 // relative y coordinate (normalized to [0.0 1.0])
1882 //--------------------------------------------------------------------------
1883 
1884 static int
1885 LookupTkButtonEvent( PLStream *pls, Tcl_Interp *interp, int argc, char **argv )
1886 {
1887  TkDev *dev = (TkDev *) pls->dev;
1888  PLGraphicsIn *gin = &( dev->gin );
1889 
1890  dbug_enter( "LookupTkButtonEvent" );
1891 
1892  if ( argc != 7 )
1893  {
1894  Tcl_AppendResult( interp, "wrong # args: should be \"",
1895  argv[0], " button-number state pX pY dX dY\"", (char *) NULL );
1896  return TCL_ERROR;
1897  }
1898 
1899  gin->button = (unsigned int) atol( argv[1] );
1900  gin->state = (unsigned int) atol( argv[2] );
1901  gin->pX = atoi( argv[3] );
1902  gin->pY = atoi( argv[4] );
1903  gin->dX = atof( argv[5] );
1904  gin->dY = atof( argv[6] );
1905  gin->keysym = 0x20;
1906 
1907  pldebug( "LookupTkButtonEvent",
1908  "button %d, state %d, pX: %d, pY: %d, dX: %f, dY: %f\n",
1909  gin->button, gin->state, gin->pX, gin->pY, gin->dX, gin->dY );
1910 
1911  return TCL_OK;
1912 }
1913 
1914 //--------------------------------------------------------------------------
1915 // ProcessKey()
1916 //
1917 // Process keyboard events other than locate input.
1918 //--------------------------------------------------------------------------
1919 
1920 static void
1921 ProcessKey( PLStream *pls )
1922 {
1923  TkDev *dev = (TkDev *) pls->dev;
1924  PLGraphicsIn *gin = &( dev->gin );
1925 
1926  dbug_enter( "ProcessKey" );
1927 
1928 // Call user keypress event handler. Since this is called first, the user
1929 // can disable all internal event handling by setting key.keysym to 0.
1930 //
1931  if ( pls->KeyEH != NULL )
1932  ( *pls->KeyEH )( gin, pls->KeyEH_data, &dev->exit_eventloop );
1933 
1934 // Handle internal events
1935 
1936  switch ( gin->keysym )
1937  {
1938  case PLK_Return:
1939  case PLK_Linefeed:
1940  case PLK_Next:
1941  // Advance to next page (i.e. terminate event loop) on a <eol>
1942  // Check for both <CR> and <LF> for portability, also a <Page Down>
1943  dev->exit_eventloop = TRUE;
1944  break;
1945 
1946  case 'Q':
1947  // Terminate on a 'Q' (not 'q', since it's too easy to hit by mistake)
1948  tcl_cmd( pls, "abort" );
1949  break;
1950 
1951  case 'L':
1952  // Begin locate mode
1954  server_cmd( pls, "$plwidget configure -xhairs on", 1 );
1955  break;
1956  }
1957 }
1958 
1959 //--------------------------------------------------------------------------
1960 // ProcessButton()
1961 //
1962 // Process ButtonPress events other than locate input.
1963 // On:
1964 // Button1: nothing (except when in locate mode, see ButtonLocate)
1965 // Button2: nothing
1966 // Button3: set page advance flag
1967 //--------------------------------------------------------------------------
1968 
1969 static void
1970 ProcessButton( PLStream *pls )
1971 {
1972  TkDev *dev = (TkDev *) pls->dev;
1973  PLGraphicsIn *gin = &( dev->gin );
1974 
1975  dbug_enter( "ButtonEH" );
1976 
1977 // Call user event handler. Since this is called first, the user can
1978 // disable all PLplot internal event handling by setting gin->button to 0.
1979 //
1980  if ( pls->ButtonEH != NULL )
1981  ( *pls->ButtonEH )( gin, pls->ButtonEH_data, &dev->exit_eventloop );
1982 
1983 // Handle internal events
1984 
1985  switch ( gin->button )
1986  {
1987  case Button3:
1988  dev->exit_eventloop = TRUE;
1989  break;
1990  }
1991 }
1992 
1993 //--------------------------------------------------------------------------
1994 // LocateKey()
1995 //
1996 // Front-end to locate handler for KeyPress events.
1997 // Only provides for:
1998 //
1999 // <Escape> Ends locate mode
2000 //--------------------------------------------------------------------------
2001 
2002 static void
2003 LocateKey( PLStream *pls )
2004 {
2005  TkDev *dev = (TkDev *) pls->dev;
2006  PLGraphicsIn *gin = &( dev->gin );
2007 
2008 // End locate mode on <Escape>
2009 
2010  if ( gin->keysym == PLK_Escape )
2011  {
2012  dev->locate_mode = 0;
2013  server_cmd( pls, "$plwidget configure -xhairs off", 1 );
2014  plGinInit( gin );
2015  }
2016  else
2017  {
2018  Locate( pls );
2019  }
2020 }
2021 
2022 //--------------------------------------------------------------------------
2023 // LocateButton()
2024 //
2025 // Front-end to locate handler for ButtonPress events.
2026 // Only passes control to Locate() for Button1 presses.
2027 //--------------------------------------------------------------------------
2028 
2029 static void
2030 LocateButton( PLStream *pls )
2031 {
2032  TkDev *dev = (TkDev *) pls->dev;
2033  PLGraphicsIn *gin = &( dev->gin );
2034 
2035  switch ( gin->button )
2036  {
2037  case Button1:
2038  Locate( pls );
2039  break;
2040  }
2041 }
2042 
2043 //--------------------------------------------------------------------------
2044 // Locate()
2045 //
2046 // Handles locate mode events.
2047 //
2048 // In locate mode: move cursor to desired location and select by pressing a
2049 // key or by clicking on the mouse (if available). Typically the world
2050 // coordinates of the selected point are reported.
2051 //
2052 // There are two ways to enter Locate mode -- via the API, or via a driver
2053 // command. The API entry point is the call plGetCursor(), which initiates
2054 // locate mode and does not return until input has been obtained. The
2055 // driver entry point is by entering a 'L' while the driver is waiting for
2056 // events.
2057 //
2058 // Locate mode input is reported in one of three ways:
2059 // 1. Through a returned PLGraphicsIn structure, when user has specified a
2060 // locate handler via (*pls->LocateEH).
2061 // 2. Through a returned PLGraphicsIn structure, when locate mode is invoked
2062 // by a plGetCursor() call.
2063 // 3. Through writes to stdout, when locate mode is invoked by a driver
2064 // command and the user has not supplied a locate handler.
2065 //
2066 // Hitting <Escape> will at all times end locate mode. Other keys will
2067 // typically be interpreted as locator input. Selecting a point out of
2068 // bounds will end locate mode unless the user overrides with a supplied
2069 // Locate handler.
2070 //--------------------------------------------------------------------------
2071 
2072 static void
2073 Locate( PLStream *pls )
2074 {
2075  TkDev *dev = (TkDev *) pls->dev;
2076  PLGraphicsIn *gin = &( dev->gin );
2077 
2078 // Call user locate mode handler if provided
2079 
2080  if ( pls->LocateEH != NULL )
2081  ( *pls->LocateEH )( gin, pls->LocateEH_data, &dev->locate_mode );
2082 
2083 // Use default procedure
2084 
2085  else
2086  {
2087  // Try to locate cursor
2088 
2089  if ( plTranslateCursor( gin ) )
2090  {
2091  // If invoked by the API, we're done
2092  // Otherwise send report to stdout
2093 
2094  if ( dev->locate_mode == LOCATE_INVOKED_VIA_DRIVER )
2095  {
2096  pltext();
2097  if ( gin->keysym < 0xFF && isprint( gin->keysym ) )
2098  printf( "%f %f %c\n", gin->wX, gin->wY, gin->keysym );
2099  else
2100  printf( "%f %f 0x%02x\n", gin->wX, gin->wY, gin->keysym );
2101 
2102  plgra();
2103  }
2104  }
2105  else
2106  {
2107  // Selected point is out of bounds, so end locate mode
2108 
2109  dev->locate_mode = 0;
2110  server_cmd( pls, "$plwidget configure -xhairs off", 1 );
2111  }
2112  }
2113 }
2114 
2115 //--------------------------------------------------------------------------
2116 //
2117 // pltk_toplevel --
2118 //
2119 // Create top level window without mapping it.
2120 //
2121 // Results:
2122 // Returns 1 on error.
2123 //
2124 // Side effects:
2125 // Returns window ID as *w.
2126 //
2127 //--------------------------------------------------------------------------
2128 
2129 static int
2130 pltk_toplevel( Tk_Window *PL_UNUSED( w ), Tcl_Interp *interp )
2131 {
2132  static char wcmd[] = "wm withdraw .";
2133 
2134 // Create the main window without mapping it
2135 
2136  if ( Tk_Init( interp ) )
2137  {
2138  fprintf( stderr, "tk_init:%s\n", Tcl_GetStringResult( interp ) );
2139  return 1;
2140  }
2141 
2142  Tcl_VarEval( interp, wcmd, (char *) NULL );
2143 
2144  return 0;
2145 }
2146 
2147 //--------------------------------------------------------------------------
2148 // tk_wait()
2149 //
2150 // Waits for the specified expression to evaluate to true before
2151 // proceeding. While we are waiting to proceed, all events (for this
2152 // or other interpreters) are handled.
2153 //
2154 // Use a static string buffer to hold the command, to ensure it's in
2155 // writable memory (grrr...).
2156 //--------------------------------------------------------------------------
2157 
2158 static void
2159 tk_wait( PLStream *pls, const char *cmd )
2160 {
2161  TkDev *dev = (TkDev *) pls->dev;
2162  int result = 0;
2163 
2164  dbug_enter( "tk_wait" );
2165 
2166  copybuf( pls, cmd );
2167  for (;; )
2168  {
2169  if ( Tcl_ExprBoolean( dev->interp, dev->cmdbuf, &result ) )
2170  {
2171  fprintf( stderr, "tk_wait command \"%s\" failed:\n\t %s\n",
2172  cmd, Tcl_GetStringResult( dev->interp ) );
2173  break;
2174  }
2175  if ( result )
2176  break;
2177 
2178  Tk_DoOneEvent( 0 );
2179  }
2180 }
2181 
2182 //--------------------------------------------------------------------------
2183 // server_cmd
2184 //
2185 // Sends specified command to server, aborting on an error.
2186 // If nowait is set, the command is issued in the background.
2187 //
2188 // If commands MUST proceed in a certain order (e.g. initialization), it
2189 // is safest to NOT run them in the background.
2190 //
2191 // In order to protect args that have embedded spaces in them, I enclose
2192 // the entire command in a [list ...], but for TK sends ONLY. If done with
2193 // Tcl-DP RPC, the sent command is no longer recognized. Evidently an
2194 // extra scan of the line is done with TK sends for some reason.
2195 //--------------------------------------------------------------------------
2196 
2197 static void
2198 server_cmd( PLStream *pls, const char *cmd, int nowait )
2199 {
2200  TkDev *dev = (TkDev *) pls->dev;
2201  static char dpsend_cmd0[] = "dp_RPC $server ";
2202  static char dpsend_cmd1[] = "dp_RDO $server ";
2203  static char tksend_cmd0[] = "send $server ";
2204  static char tksend_cmd1[] = "send $server after 1 ";
2205  int result;
2206 
2207  dbug_enter( "server_cmd" );
2208  pldebug( "server_cmd", "Sending command: %s\n", cmd );
2209 
2210  if ( pls->dp )
2211  {
2212  if ( nowait )
2213  result = Tcl_VarEval( dev->interp, dpsend_cmd1, cmd,
2214  (char **) NULL );
2215  else
2216  result = Tcl_VarEval( dev->interp, dpsend_cmd0, cmd,
2217  (char **) NULL );
2218  }
2219  else
2220  {
2221  if ( nowait )
2222  result = Tcl_VarEval( dev->interp, tksend_cmd1, "[list ",
2223  cmd, "]", (char **) NULL );
2224  else
2225  result = Tcl_VarEval( dev->interp, tksend_cmd0, "[list ",
2226  cmd, "]", (char **) NULL );
2227  }
2228 
2229  if ( result != TCL_OK )
2230  {
2231  fprintf( stderr, "Server command \"%s\" failed:\n\t %s\n",
2232  cmd, Tcl_GetStringResult( dev->interp ) );
2233  abort_session( pls, "" );
2234  }
2235 }
2236 
2237 //--------------------------------------------------------------------------
2238 // tcl_cmd
2239 //
2240 // Evals the specified command, aborting on an error.
2241 //--------------------------------------------------------------------------
2242 
2243 static void
2244 tcl_cmd( PLStream *pls, const char *cmd )
2245 {
2246  TkDev *dev = (TkDev *) pls->dev;
2247 
2248  dbug_enter( "tcl_cmd" );
2249 
2250  pldebug( "tcl_cmd", "Evaluating command: %s\n", cmd );
2251  if ( Tcl_VarEval( dev->interp, cmd, (char **) NULL ) != TCL_OK )
2252  {
2253  fprintf( stderr, "TCL command \"%s\" failed:\n\t %s\n",
2254  cmd, Tcl_GetStringResult( dev->interp ) );
2255  abort_session( pls, "" );
2256  }
2257 }
2258 
2259 //--------------------------------------------------------------------------
2260 // copybuf
2261 //
2262 // Puts command in a static string buffer, to ensure it's in writable
2263 // memory (grrr...).
2264 //--------------------------------------------------------------------------
2265 
2266 static void
2267 copybuf( PLStream *pls, const char *cmd )
2268 {
2269  TkDev *dev = (TkDev *) pls->dev;
2270 
2271  if ( dev->cmdbuf == NULL )
2272  {
2273  dev->cmdbuf_len = 100;
2274  dev->cmdbuf = (char *) malloc( dev->cmdbuf_len );
2275  }
2276 
2277  if ( strlen( cmd ) >= dev->cmdbuf_len )
2278  {
2279  free( (void *) dev->cmdbuf );
2280  dev->cmdbuf_len = strlen( cmd ) + 20;
2281  dev->cmdbuf = (char *) malloc( dev->cmdbuf_len );
2282  }
2283 
2284  strcpy( dev->cmdbuf, cmd );
2285 }
2286 
2287 //--------------------------------------------------------------------------
2288 #else
2289 int
2291 {
2292  return 0;
2293 }
2294 
2295 #endif // PLD_tk