PLplot  5.10.0
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Macros
tk.c
Go to the documentation of this file.
1 // $Id: tk.c 12965 2014-01-28 20:23:52Z arjenmarkus $
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 = FALSE;
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  const char *dirname = NULL;
1525 
1526  dbug_enter( "link_init" );
1527 
1528 // Create FIFO for data transfer to the plframe widget
1529 
1530  if ( !pls->dp )
1531  {
1532  // This uses the pl_create_tempfifo function to create
1533  // the fifo in a safe manner by first creating a private
1534  // temporary directory.
1535  iodev->fileName = pl_create_tempfifo( (const char **) &iodev->fileName, &dirname );
1536  if ( dirname == NULL || iodev->fileName == NULL )
1537  abort_session( pls, "mkfifo error" );
1538 
1539  // Tell plframe widget to open FIFO (for reading).
1540 
1541  Tcl_SetVar( dev->interp, "fifoname", iodev->fileName, 0 );
1542  server_cmd( pls, "$plwidget openlink fifo $fifoname", 1 );
1543 
1544  // Open the FIFO for writing
1545  // This will block until the server opens it for reading
1546 
1547  if ( ( iodev->fd = open( iodev->fileName, O_WRONLY ) ) == -1 )
1548  abort_session( pls, "Error opening fifo for write" );
1549 
1550  // Create stream interface (C file handle) to FIFO
1551 
1552  iodev->type = 0;
1553  iodev->typeName = "fifo";
1554  iodev->file = fdopen( iodev->fd, "wb" );
1555 
1556 // Unlink FIFO so that it isn't left around if program crashes.
1557 // This also ensures no other program can mess with it.
1558 
1559  if ( unlink( iodev->fileName ) == -1 )
1560  abort_session( pls, "Error removing fifo" );
1561  free( (void *) iodev->fileName );
1562  iodev->fileName = NULL;
1563  if ( rmdir( dirname ) == -1 )
1564  abort_session( pls, "Error removing temporary directory" );
1565  free( (void *) dirname );
1566  }
1567 
1568 // Create socket for data transfer to the plframe widget
1569 
1570  else
1571  {
1572  iodev->type = 1;
1573  iodev->typeName = "socket";
1574  tcl_cmd( pls, "plclient_dp_init" );
1575  iodev->fileHandle = Tcl_GetVar( dev->interp, "data_sock", 0 );
1576 
1577  if ( Tcl_GetOpenFile( dev->interp, iodev->fileHandle,
1578  0, 1, ( ClientData ) & iodev->file ) != TCL_OK )
1579  {
1580  fprintf( stderr, "Cannot get file info:\n\t %s\n",
1581  Tcl_GetStringResult( dev->interp ) );
1582  abort_session( pls, "" );
1583  }
1584  iodev->fd = fileno( iodev->file );
1585  }
1586 
1587 // Create data buffer
1588 
1589  pls->pdfs = pdf_bopen( NULL, (size_t) bufmax );
1590 }
1591 
1592 //--------------------------------------------------------------------------
1593 // WaitForPage()
1594 //
1595 // Waits for a page advance.
1596 //--------------------------------------------------------------------------
1597 
1598 static void
1599 WaitForPage( PLStream *pls )
1600 {
1601  TkDev *dev = (TkDev *) pls->dev;
1602 
1603  dbug_enter( "WaitForPage" );
1604 
1605  while ( !dev->exit_eventloop )
1606  {
1607  Tk_DoOneEvent( 0 );
1608  }
1609  dev->exit_eventloop = 0;
1610 }
1611 
1612 //--------------------------------------------------------------------------
1613 // CheckForEvents()
1614 //
1615 // A front-end to HandleEvents(), which is only called if certain conditions
1616 // are satisfied:
1617 //
1618 // - only check for events and process them every dev->max_instr times this
1619 // function is called (good for performance since performing an update is
1620 // a nontrivial performance hit).
1621 //--------------------------------------------------------------------------
1622 
1623 static void
1624 CheckForEvents( PLStream *pls )
1625 {
1626  TkDev *dev = (TkDev *) pls->dev;
1627 
1628  if ( ++dev->instr % dev->max_instr == 0 )
1629  {
1630  dev->instr = 0;
1631  HandleEvents( pls );
1632  }
1633 }
1634 
1635 //--------------------------------------------------------------------------
1636 // HandleEvents()
1637 //
1638 // Just a front-end to the update command, for use when not actually waiting
1639 // for an event but only checking the event queue.
1640 //--------------------------------------------------------------------------
1641 
1642 static void
1643 HandleEvents( PLStream *pls )
1644 {
1645  TkDev *dev = (TkDev *) pls->dev;
1646 
1647  dbug_enter( "HandleEvents" );
1648 
1649  Tcl_VarEval( dev->interp, dev->updatecmd, (char **) NULL );
1650 }
1651 
1652 //--------------------------------------------------------------------------
1653 // flush_output()
1654 //
1655 // Sends graphics instructions to the {FIFO|socket} via a packet send.
1656 //
1657 // The packet i/o routines are modified versions of the ones from the
1658 // Tcl-DP package. They have been altered to take a pointer to a PDFstrm
1659 // struct, and read-to or write-from pdfs->buffer. The length of the
1660 // buffer is stored in pdfs->bp (the original Tcl-DP routine assumes the
1661 // message is character data and uses strlen). Also, they can
1662 // send/receive from either a fifo or a socket.
1663 //--------------------------------------------------------------------------
1664 
1665 static void
1666 flush_output( PLStream *pls )
1667 {
1668  TkDev *dev = (TkDev *) pls->dev;
1669  PDFstrm *pdfs = (PDFstrm *) pls->pdfs;
1670 
1671  dbug_enter( "flush_output" );
1672 
1673  HandleEvents( pls );
1674 
1675 // Send packet -- plserver filehandler will be invoked automatically.
1676 
1677  if ( pdfs->bp > 0 )
1678  {
1679 #ifdef DEBUG_ENTER
1680  pldebug( "flush_output", "%s: Flushing buffer, bytes = %ld\n",
1681  __FILE__, pdfs->bp );
1682 #endif
1683  if ( pl_PacketSend( dev->interp, dev->iodev, pls->pdfs ) )
1684  {
1685  fprintf( stderr, "Packet send failed:\n\t %s\n",
1686  Tcl_GetStringResult( dev->interp ) );
1687  abort_session( pls, "" );
1688  }
1689  pdfs->bp = 0;
1690  }
1691 }
1692 
1693 //--------------------------------------------------------------------------
1694 // Abort
1695 //
1696 // Just a TCL front-end to abort_session().
1697 //--------------------------------------------------------------------------
1698 
1699 static int
1700 Abort( ClientData clientData, Tcl_Interp *PL_UNUSED( interp ), int PL_UNUSED( argc ), char **PL_UNUSED( argv ) )
1701 {
1702  PLStream *pls = (PLStream *) clientData;
1703 
1704  dbug_enter( "Abort" );
1705 
1706  abort_session( pls, "" );
1707  return TCL_OK;
1708 }
1709 
1710 //--------------------------------------------------------------------------
1711 // Plfinfo
1712 //
1713 // Sends info about the server plframe. Usually issued after some
1714 // modification to the plframe is made by the user, such as a resize.
1715 //--------------------------------------------------------------------------
1716 
1717 static int
1718 Plfinfo( ClientData clientData, Tcl_Interp *interp, int argc, char **argv )
1719 {
1720  PLStream *pls = (PLStream *) clientData;
1721  TkDev *dev = (TkDev *) pls->dev;
1722  int result = TCL_OK;
1723 
1724  dbug_enter( "Plfinfo" );
1725 
1726  if ( argc < 3 )
1727  {
1728  Tcl_AppendResult( interp, "wrong # args: should be \"",
1729  " plfinfo wx wy\"", (char *) NULL );
1730  result = TCL_ERROR;
1731  }
1732  else
1733  {
1734  dev->width = (unsigned int) atoi( argv[1] );
1735  dev->height = (unsigned int) atoi( argv[2] );
1736 #if PHYSICAL
1737  {
1738  PLFLT pxlx = (double) PIXELS_X / dev->width * DPMM;
1739  PLFLT pxly = (double) PIXELS_Y / dev->height * DPMM;
1740  plP_setpxl( pxlx, pxly );
1741  }
1742 #endif
1743  }
1744 
1745  return result;
1746 }
1747 
1748 //--------------------------------------------------------------------------
1749 // KeyEH()
1750 //
1751 // This TCL command handles keyboard events.
1752 //--------------------------------------------------------------------------
1753 
1754 static int
1755 KeyEH( ClientData clientData, Tcl_Interp *interp, int argc, char **argv )
1756 {
1757  PLStream *pls = (PLStream *) clientData;
1758  TkDev *dev = (TkDev *) pls->dev;
1759  int result;
1760 
1761  dbug_enter( "KeyEH" );
1762 
1763  if ( ( result = LookupTkKeyEvent( pls, interp, argc, argv ) ) != TCL_OK )
1764  return result;
1765 
1766  if ( dev->locate_mode )
1767  LocateKey( pls );
1768  else
1769  ProcessKey( pls );
1770 
1771  return result;
1772 }
1773 
1774 //--------------------------------------------------------------------------
1775 // ButtonEH()
1776 //
1777 // This TCL command handles button events.
1778 //--------------------------------------------------------------------------
1779 
1780 static int
1781 ButtonEH( ClientData clientData, Tcl_Interp *interp, int argc, char **argv )
1782 {
1783  PLStream *pls = (PLStream *) clientData;
1784  TkDev *dev = (TkDev *) pls->dev;
1785  int result;
1786 
1787  dbug_enter( "ButtonEH" );
1788 
1789  if ( ( result = LookupTkButtonEvent( pls, interp, argc, argv ) ) != TCL_OK )
1790  return result;
1791 
1792  if ( dev->locate_mode )
1793  LocateButton( pls );
1794  else
1795  ProcessButton( pls );
1796 
1797  return result;
1798 }
1799 
1800 //--------------------------------------------------------------------------
1801 // LookupTkKeyEvent()
1802 //
1803 // Fills in the PLGraphicsIn from a Tk KeyEvent.
1804 //
1805 // Contents of argv array:
1806 // command name
1807 // keysym value
1808 // keysym state
1809 // absolute x coordinate of cursor
1810 // absolute y coordinate of cursor
1811 // relative x coordinate (normalized to [0.0 1.0])
1812 // relative y coordinate (normalized to [0.0 1.0])
1813 // keysym name
1814 // ASCII equivalent (optional)
1815 //
1816 // Note that the keysym name is only used for debugging, and the string is
1817 // not always passed (i.e. the character may not have an ASCII
1818 // representation).
1819 //--------------------------------------------------------------------------
1820 
1821 static int
1822 LookupTkKeyEvent( PLStream *pls, Tcl_Interp *interp, int argc, char **argv )
1823 {
1824  TkDev *dev = (TkDev *) pls->dev;
1825  PLGraphicsIn *gin = &( dev->gin );
1826  char *keyname;
1827 
1828  dbug_enter( "LookupTkKeyEvent" );
1829 
1830  if ( argc < 8 )
1831  {
1832  Tcl_AppendResult( interp, "wrong # args: should be \"",
1833  argv[0], " key-value state pX pY dX dY key-name ?ascii-value?\"",
1834  (char *) NULL );
1835  return TCL_ERROR;
1836  }
1837 
1838  gin->keysym = (unsigned int) atol( argv[1] );
1839  gin->state = (unsigned int) atol( argv[2] );
1840  gin->pX = atoi( argv[3] );
1841  gin->pY = atoi( argv[4] );
1842  gin->dX = atof( argv[5] );
1843  gin->dY = atof( argv[6] );
1844 
1845  keyname = argv[7];
1846 
1847  gin->string[0] = '\0';
1848  if ( argc > 8 )
1849  {
1850  gin->string[0] = argv[8][0];
1851  gin->string[1] = '\0';
1852  }
1853 
1854 // Fix up keysym value -- see notes in xwin.c about key representation
1855 
1856  switch ( gin->keysym )
1857  {
1858  case XK_BackSpace:
1859  case XK_Tab:
1860  case XK_Linefeed:
1861  case XK_Return:
1862  case XK_Escape:
1863  case XK_Delete:
1864  gin->keysym &= 0xFF;
1865  break;
1866  }
1867 
1868  pldebug( "LookupTkKeyEvent",
1869  "KeyEH: stream: %d, Keyname %s, hex %x, ASCII: %s\n",
1870  (int) pls->ipls, keyname, (unsigned int) gin->keysym, gin->string );
1871 
1872  return TCL_OK;
1873 }
1874 
1875 //--------------------------------------------------------------------------
1876 // LookupTkButtonEvent()
1877 //
1878 // Fills in the PLGraphicsIn from a Tk ButtonEvent.
1879 //
1880 // Contents of argv array:
1881 // command name
1882 // button number
1883 // state (decimal string)
1884 // absolute x coordinate
1885 // absolute y coordinate
1886 // relative x coordinate (normalized to [0.0 1.0])
1887 // relative y coordinate (normalized to [0.0 1.0])
1888 //--------------------------------------------------------------------------
1889 
1890 static int
1891 LookupTkButtonEvent( PLStream *pls, Tcl_Interp *interp, int argc, char **argv )
1892 {
1893  TkDev *dev = (TkDev *) pls->dev;
1894  PLGraphicsIn *gin = &( dev->gin );
1895 
1896  dbug_enter( "LookupTkButtonEvent" );
1897 
1898  if ( argc != 7 )
1899  {
1900  Tcl_AppendResult( interp, "wrong # args: should be \"",
1901  argv[0], " button-number state pX pY dX dY\"", (char *) NULL );
1902  return TCL_ERROR;
1903  }
1904 
1905  gin->button = (unsigned int) atol( argv[1] );
1906  gin->state = (unsigned int) atol( argv[2] );
1907  gin->pX = atoi( argv[3] );
1908  gin->pY = atoi( argv[4] );
1909  gin->dX = atof( argv[5] );
1910  gin->dY = atof( argv[6] );
1911  gin->keysym = 0x20;
1912 
1913  pldebug( "LookupTkButtonEvent",
1914  "button %d, state %d, pX: %d, pY: %d, dX: %f, dY: %f\n",
1915  gin->button, gin->state, gin->pX, gin->pY, gin->dX, gin->dY );
1916 
1917  return TCL_OK;
1918 }
1919 
1920 //--------------------------------------------------------------------------
1921 // ProcessKey()
1922 //
1923 // Process keyboard events other than locate input.
1924 //--------------------------------------------------------------------------
1925 
1926 static void
1927 ProcessKey( PLStream *pls )
1928 {
1929  TkDev *dev = (TkDev *) pls->dev;
1930  PLGraphicsIn *gin = &( dev->gin );
1931 
1932  dbug_enter( "ProcessKey" );
1933 
1934 // Call user keypress event handler. Since this is called first, the user
1935 // can disable all internal event handling by setting key.keysym to 0.
1936 //
1937  if ( pls->KeyEH != NULL )
1938  ( *pls->KeyEH )( gin, pls->KeyEH_data, &dev->exit_eventloop );
1939 
1940 // Handle internal events
1941 
1942  switch ( gin->keysym )
1943  {
1944  case PLK_Return:
1945  case PLK_Linefeed:
1946  case PLK_Next:
1947  // Advance to next page (i.e. terminate event loop) on a <eol>
1948  // Check for both <CR> and <LF> for portability, also a <Page Down>
1949  dev->exit_eventloop = TRUE;
1950  break;
1951 
1952  case 'Q':
1953  // Terminate on a 'Q' (not 'q', since it's too easy to hit by mistake)
1954  tcl_cmd( pls, "abort" );
1955  break;
1956 
1957  case 'L':
1958  // Begin locate mode
1960  server_cmd( pls, "$plwidget configure -xhairs on", 1 );
1961  break;
1962  }
1963 }
1964 
1965 //--------------------------------------------------------------------------
1966 // ProcessButton()
1967 //
1968 // Process ButtonPress events other than locate input.
1969 // On:
1970 // Button1: nothing (except when in locate mode, see ButtonLocate)
1971 // Button2: nothing
1972 // Button3: set page advance flag
1973 //--------------------------------------------------------------------------
1974 
1975 static void
1976 ProcessButton( PLStream *pls )
1977 {
1978  TkDev *dev = (TkDev *) pls->dev;
1979  PLGraphicsIn *gin = &( dev->gin );
1980 
1981  dbug_enter( "ButtonEH" );
1982 
1983 // Call user event handler. Since this is called first, the user can
1984 // disable all PLplot internal event handling by setting gin->button to 0.
1985 //
1986  if ( pls->ButtonEH != NULL )
1987  ( *pls->ButtonEH )( gin, pls->ButtonEH_data, &dev->exit_eventloop );
1988 
1989 // Handle internal events
1990 
1991  switch ( gin->button )
1992  {
1993  case Button3:
1994  dev->exit_eventloop = TRUE;
1995  break;
1996  }
1997 }
1998 
1999 //--------------------------------------------------------------------------
2000 // LocateKey()
2001 //
2002 // Front-end to locate handler for KeyPress events.
2003 // Only provides for:
2004 //
2005 // <Escape> Ends locate mode
2006 //--------------------------------------------------------------------------
2007 
2008 static void
2009 LocateKey( PLStream *pls )
2010 {
2011  TkDev *dev = (TkDev *) pls->dev;
2012  PLGraphicsIn *gin = &( dev->gin );
2013 
2014 // End locate mode on <Escape>
2015 
2016  if ( gin->keysym == PLK_Escape )
2017  {
2018  dev->locate_mode = 0;
2019  server_cmd( pls, "$plwidget configure -xhairs off", 1 );
2020  plGinInit( gin );
2021  }
2022  else
2023  {
2024  Locate( pls );
2025  }
2026 }
2027 
2028 //--------------------------------------------------------------------------
2029 // LocateButton()
2030 //
2031 // Front-end to locate handler for ButtonPress events.
2032 // Only passes control to Locate() for Button1 presses.
2033 //--------------------------------------------------------------------------
2034 
2035 static void
2036 LocateButton( PLStream *pls )
2037 {
2038  TkDev *dev = (TkDev *) pls->dev;
2039  PLGraphicsIn *gin = &( dev->gin );
2040 
2041  switch ( gin->button )
2042  {
2043  case Button1:
2044  Locate( pls );
2045  break;
2046  }
2047 }
2048 
2049 //--------------------------------------------------------------------------
2050 // Locate()
2051 //
2052 // Handles locate mode events.
2053 //
2054 // In locate mode: move cursor to desired location and select by pressing a
2055 // key or by clicking on the mouse (if available). Typically the world
2056 // coordinates of the selected point are reported.
2057 //
2058 // There are two ways to enter Locate mode -- via the API, or via a driver
2059 // command. The API entry point is the call plGetCursor(), which initiates
2060 // locate mode and does not return until input has been obtained. The
2061 // driver entry point is by entering a 'L' while the driver is waiting for
2062 // events.
2063 //
2064 // Locate mode input is reported in one of three ways:
2065 // 1. Through a returned PLGraphicsIn structure, when user has specified a
2066 // locate handler via (*pls->LocateEH).
2067 // 2. Through a returned PLGraphicsIn structure, when locate mode is invoked
2068 // by a plGetCursor() call.
2069 // 3. Through writes to stdout, when locate mode is invoked by a driver
2070 // command and the user has not supplied a locate handler.
2071 //
2072 // Hitting <Escape> will at all times end locate mode. Other keys will
2073 // typically be interpreted as locator input. Selecting a point out of
2074 // bounds will end locate mode unless the user overrides with a supplied
2075 // Locate handler.
2076 //--------------------------------------------------------------------------
2077 
2078 static void
2079 Locate( PLStream *pls )
2080 {
2081  TkDev *dev = (TkDev *) pls->dev;
2082  PLGraphicsIn *gin = &( dev->gin );
2083 
2084 // Call user locate mode handler if provided
2085 
2086  if ( pls->LocateEH != NULL )
2087  ( *pls->LocateEH )( gin, pls->LocateEH_data, &dev->locate_mode );
2088 
2089 // Use default procedure
2090 
2091  else
2092  {
2093  // Try to locate cursor
2094 
2095  if ( plTranslateCursor( gin ) )
2096  {
2097  // If invoked by the API, we're done
2098  // Otherwise send report to stdout
2099 
2100  if ( dev->locate_mode == LOCATE_INVOKED_VIA_DRIVER )
2101  {
2102  pltext();
2103  if ( gin->keysym < 0xFF && isprint( gin->keysym ) )
2104  printf( "%f %f %c\n", gin->wX, gin->wY, gin->keysym );
2105  else
2106  printf( "%f %f 0x%02x\n", gin->wX, gin->wY, gin->keysym );
2107 
2108  plgra();
2109  }
2110  }
2111  else
2112  {
2113  // Selected point is out of bounds, so end locate mode
2114 
2115  dev->locate_mode = 0;
2116  server_cmd( pls, "$plwidget configure -xhairs off", 1 );
2117  }
2118  }
2119 }
2120 
2121 //--------------------------------------------------------------------------
2122 //
2123 // pltk_toplevel --
2124 //
2125 // Create top level window without mapping it.
2126 //
2127 // Results:
2128 // Returns 1 on error.
2129 //
2130 // Side effects:
2131 // Returns window ID as *w.
2132 //
2133 //--------------------------------------------------------------------------
2134 
2135 static int
2136 pltk_toplevel( Tk_Window *PL_UNUSED( w ), Tcl_Interp *interp )
2137 {
2138  static char wcmd[] = "wm withdraw .";
2139 
2140 // Create the main window without mapping it
2141 
2142  if ( Tk_Init( interp ) )
2143  {
2144  fprintf( stderr, "tk_init:%s\n", Tcl_GetStringResult( interp ) );
2145  return 1;
2146  }
2147 
2148  Tcl_VarEval( interp, wcmd, (char *) NULL );
2149 
2150  return 0;
2151 }
2152 
2153 //--------------------------------------------------------------------------
2154 // tk_wait()
2155 //
2156 // Waits for the specified expression to evaluate to true before
2157 // proceeding. While we are waiting to proceed, all events (for this
2158 // or other interpreters) are handled.
2159 //
2160 // Use a static string buffer to hold the command, to ensure it's in
2161 // writable memory (grrr...).
2162 //--------------------------------------------------------------------------
2163 
2164 static void
2165 tk_wait( PLStream *pls, const char *cmd )
2166 {
2167  TkDev *dev = (TkDev *) pls->dev;
2168  int result = 0;
2169 
2170  dbug_enter( "tk_wait" );
2171 
2172  copybuf( pls, cmd );
2173  for (;; )
2174  {
2175  if ( Tcl_ExprBoolean( dev->interp, dev->cmdbuf, &result ) )
2176  {
2177  fprintf( stderr, "tk_wait command \"%s\" failed:\n\t %s\n",
2178  cmd, Tcl_GetStringResult( dev->interp ) );
2179  break;
2180  }
2181  if ( result )
2182  break;
2183 
2184  Tk_DoOneEvent( 0 );
2185  }
2186 }
2187 
2188 //--------------------------------------------------------------------------
2189 // server_cmd
2190 //
2191 // Sends specified command to server, aborting on an error.
2192 // If nowait is set, the command is issued in the background.
2193 //
2194 // If commands MUST proceed in a certain order (e.g. initialization), it
2195 // is safest to NOT run them in the background.
2196 //
2197 // In order to protect args that have embedded spaces in them, I enclose
2198 // the entire command in a [list ...], but for TK sends ONLY. If done with
2199 // Tcl-DP RPC, the sent command is no longer recognized. Evidently an
2200 // extra scan of the line is done with TK sends for some reason.
2201 //--------------------------------------------------------------------------
2202 
2203 static void
2204 server_cmd( PLStream *pls, const char *cmd, int nowait )
2205 {
2206  TkDev *dev = (TkDev *) pls->dev;
2207  static char dpsend_cmd0[] = "dp_RPC $server ";
2208  static char dpsend_cmd1[] = "dp_RDO $server ";
2209  static char tksend_cmd0[] = "send $server ";
2210  static char tksend_cmd1[] = "send $server after 1 ";
2211  int result;
2212 
2213  dbug_enter( "server_cmd" );
2214  pldebug( "server_cmd", "Sending command: %s\n", cmd );
2215 
2216  if ( pls->dp )
2217  {
2218  if ( nowait )
2219  result = Tcl_VarEval( dev->interp, dpsend_cmd1, cmd,
2220  (char **) NULL );
2221  else
2222  result = Tcl_VarEval( dev->interp, dpsend_cmd0, cmd,
2223  (char **) NULL );
2224  }
2225  else
2226  {
2227  if ( nowait )
2228  result = Tcl_VarEval( dev->interp, tksend_cmd1, "[list ",
2229  cmd, "]", (char **) NULL );
2230  else
2231  result = Tcl_VarEval( dev->interp, tksend_cmd0, "[list ",
2232  cmd, "]", (char **) NULL );
2233  }
2234 
2235  if ( result != TCL_OK )
2236  {
2237  fprintf( stderr, "Server command \"%s\" failed:\n\t %s\n",
2238  cmd, Tcl_GetStringResult( dev->interp ) );
2239  abort_session( pls, "" );
2240  }
2241 }
2242 
2243 //--------------------------------------------------------------------------
2244 // tcl_cmd
2245 //
2246 // Evals the specified command, aborting on an error.
2247 //--------------------------------------------------------------------------
2248 
2249 static void
2250 tcl_cmd( PLStream *pls, const char *cmd )
2251 {
2252  TkDev *dev = (TkDev *) pls->dev;
2253 
2254  dbug_enter( "tcl_cmd" );
2255 
2256  pldebug( "tcl_cmd", "Evaluating command: %s\n", cmd );
2257  if ( Tcl_VarEval( dev->interp, cmd, (char **) NULL ) != TCL_OK )
2258  {
2259  fprintf( stderr, "TCL command \"%s\" failed:\n\t %s\n",
2260  cmd, Tcl_GetStringResult( dev->interp ) );
2261  abort_session( pls, "" );
2262  }
2263 }
2264 
2265 //--------------------------------------------------------------------------
2266 // copybuf
2267 //
2268 // Puts command in a static string buffer, to ensure it's in writable
2269 // memory (grrr...).
2270 //--------------------------------------------------------------------------
2271 
2272 static void
2273 copybuf( PLStream *pls, const char *cmd )
2274 {
2275  TkDev *dev = (TkDev *) pls->dev;
2276 
2277  if ( dev->cmdbuf == NULL )
2278  {
2279  dev->cmdbuf_len = 100;
2280  dev->cmdbuf = (char *) malloc( dev->cmdbuf_len );
2281  }
2282 
2283  if ( strlen( cmd ) >= dev->cmdbuf_len )
2284  {
2285  free( (void *) dev->cmdbuf );
2286  dev->cmdbuf_len = strlen( cmd ) + 20;
2287  dev->cmdbuf = (char *) malloc( dev->cmdbuf_len );
2288  }
2289 
2290  strcpy( dev->cmdbuf, cmd );
2291 }
2292 
2293 //--------------------------------------------------------------------------
2294 #else
2295 int
2297 {
2298  return 0;
2299 }
2300 
2301 #endif // PLD_tk