PLplot: pltcl.c Source File

PLplot 5.10.0

- Main Page
- Namespaces
- Classes
- Files

- File List
- File Members

All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Macros
pltcl.c
Go to the documentation of this file.
1 // $Id: pltcl.c 12749 2013-11-25 19:44:36Z airwin $
2 //
3 // Main program for Tcl-interface to PLplot. Allows interpretive
4 // execution of plotting primitives without regard to output driver.
5 //
6 // Maurice LeBrun
7 // IFS, University of Texas at Austin
8 // 19-Jun-1994
9 //
10 // Copyright (C) 2004 Joao Cardoso
11 //
12 // This file is part of PLplot.
13 //
14 // PLplot is free software; you can redistribute it and/or modify
15 // it under the terms of the GNU Library General Public License as published
16 // by the Free Software Foundation; either version 2 of the License, or
17 // (at your option) any later version.
18 //
19 // PLplot is distributed in the hope that it will be useful,
20 // but WITHOUT ANY WARRANTY; without even the implied warranty of
21 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 // GNU Library General Public License for more details.
23 //
24 // You should have received a copy of the GNU Library General Public License
25 // along with PLplot; if not, write to the Free Software
26 // Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
27 //
28 //
29
30 #include "plplotP.h"
31 #define USINGPLDLL
32 #include "pltcl.h"
33 #ifdef HAVE_ITCL
34 # ifndef HAVE_ITCLDECLS_H
35 # define RESOURCE_INCLUDED
36 # endif
37 # include <itcl.h>
38 #endif
39
40 static int
41 AppInit( Tcl_Interp *interp );
42
43 //--------------------------------------------------------------------------
44 // main --
45 //
46 // Just a stub routine to call pltclMain. The latter is nice to have when
47 // building extended tclsh's, since then you don't have to rely on sucking
48 // the Tcl main out of libtcl (which doesn't work correctly on all
49 // systems/compilers/linkers/etc). Hopefully in the future Tcl will
50 // supply a sufficiently capable tclMain() type function that can be used
51 // instead.
52 //--------------------------------------------------------------------------
53
54 int
55 main( int argc, const char **argv )
56 {
57 exit( pltclMain( argc, argv, NULL, AppInit ) );
58 }
59
60 //--------------------------------------------------------------------------
61 // plExitCmd
62 //
63 // PLplot/Tcl extension command -- handle exit.
64 // The reason for overriding the normal exit command is so we can tell
65 // the PLplot library to clean up.
66 //--------------------------------------------------------------------------
67
68 static int
69 plExitCmd( ClientData clientData, Tcl_Interp *interp, int argc, char **argv )
70 {
71 const char *tmp = Tcl_GetStringResult( interp );
72 (void) argc;
73 (void) argv;
74 (void) clientData;
75
76 // Print error message if one given
77 if ( tmp != NULL && tmp != '\0' )
78 fprintf( stderr, "%s\n", Tcl_GetStringResult( interp ) );
79
80 plspause( 0 );
81 plend();
82
83 Tcl_UnsetVar( interp, "tcl_prompt1", 0 );
84 Tcl_Eval( interp, "tclexit" );
85
86 return TCL_OK;
87 }
88
89 //--------------------------------------------------------------------------
90 // prPromptCmd
91 //
92 // PLplot/Tcl extension command -- print the prompt.
93 // Allows much more flexible setting of the prompt.
94 //--------------------------------------------------------------------------
95
96 static int
97 prPromptCmd( ClientData clientData, Tcl_Interp *interp, int argc, char **argv )
98 {
99 PLStream *pls;
100 char prompt[80];
101 (void) argc;
102 (void) argv;
103 (void) clientData;
104
105 plgpls( &pls );
106
107 if ( pls->ipls == 0 )
108 sprintf( prompt, "pltext; puts -nonewline \"pltcl> \"; flush stdout" );
109 else
110 sprintf( prompt, "pltext; puts -nonewline \"pltcl_%d> \"; flush stdout", pls->ipls );
111
112 Tcl_VarEval( interp, prompt, 0 );
113
114 return TCL_OK;
115 }
116
117 //
118 //--------------------------------------------------------------------------
119 //
120 // AppInit --
121 //
122 // This procedure performs application-specific initialization.
123 // Most applications, especially those that incorporate additional
124 // packages, will have their own version of this procedure.
125 //
126 // Results:
127 // Returns a standard Tcl completion code, and leaves an error
128 // message in interp->result if an error occurs.
129 //
130 // Side effects:
131 // Depends on the startup script.
132 //
133 //--------------------------------------------------------------------------
134 //
135
136 static int
137 AppInit( Tcl_Interp *interp )
138 {
139 //
140 // Call the init procedures for included packages. Each call should
141 // look like this:
142 //
143 // if (Mod_Init(interp) == TCL_ERROR) {
144 // return TCL_ERROR;
145 // }
146 //
147 // where "Mod" is the name of the module.
148 //
149 if ( Tcl_Init( interp ) == TCL_ERROR )
150 {
151 printf( "Error Tcl_Init\n" );
152 return TCL_ERROR;
153 }
154 #ifdef HAVE_ITCL
155 if ( Itcl_Init( interp ) == TCL_ERROR )
156 {
157 return TCL_ERROR;
158 }
159 #endif
160 if ( Pltcl_Init( interp ) == TCL_ERROR )
161 {
162 return TCL_ERROR;
163 }
164
165 // Application-specific startup. That means: for use in pltcl ONLY.
166
167 // Rename "exit" to "tclexit", and insert custom exit handler
168
169 Tcl_VarEval( interp, "rename exit tclexit", (char *) NULL );
170
171 Tcl_CreateCommand( interp, "exit", (Tcl_CmdProc *) plExitCmd,
172 (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL );
173
174 Tcl_CreateCommand( interp, "pr_prompt", (Tcl_CmdProc *) prPromptCmd,
175 (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL );
176
177 // Custom prompt, to make sure we are in text mode when entering commands
178
179 Tcl_SetVar( interp, "tcl_prompt1", "pr_prompt", 0 );
180
181 return TCL_OK;
182 }