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