Context Navigation

txscript.c

Revision 10, 32.4 kB (checked in by jvw, 3 years ago)
Fix FileDialog? trap, other minor updates

Line
1	//
2	// TxWin, Textmode Windowing Library
3	//
4	// Original code Copyright (c) 1995-2005 Fsys Software and Jan van Wijk
5	//
6	// ==========================================================================
7	//
8	// This file contains Original Code and/or Modifications of Original Code as
9	// defined in and that are subject to the GNU Lesser General Public License.
10	// You may not use this file except in compliance with the License.
11	// BY USING THIS FILE YOU AGREE TO ALL TERMS AND CONDITIONS OF THE LICENSE.
12	// A copy of the License is provided with the Original Code and Modifications,
13	// and is also available at http://www.dfsee.com/txwin/lgpl.htm
14	//
15	// This library is free software; you can redistribute it and/or modify
16	// it under the terms of the GNU Lesser General Public License as published
17	// by the Free Software Foundation; either version 2.1 of the License,
18	// or (at your option) any later version.
19	//
20	// This library 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.
23	// See the GNU Lesser General Public License for more details.
24	//
25	// You should have received a copy of the GNU Lesser General Public License
26	// along with this library; (lgpl.htm) if not, write to the Free Software
27	// Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
28	//
29	// Questions on TxWin licensing can be directed to: txwin@fsys.nl
30	//
31	// ==========================================================================
32	//
33	// TX script execution with subcommand-handler callback and TxPrint routing
34	//
35	// Author: J. van Wijk
36	//
37	// Developed for LPT/DFS utilities
38	//
39
40	#include <txlib.h> // TX library interface
41	#include <txwpriv.h> // TX library private interface
42
43	#define TXSC_HELPREG 0xffff0220 // base help-id registration
44
45	#define TXSC_PRAGMA ";;"
46	#define TXSC_P_PARDEF ";;defaultparam"
47	#define TXSC_P_PARSET ";;setparam"
48	#define TXSC_P_SISTEP ";;singlestep"
49	#define TXSC_P_VERBOS ";;verbose"
50	#define TXSC_P_PROMPT ";;prompt"
51	#define TXSC_P_ERRORS ";;error"
52
53	#define TXSC_PARAMS 10 // substitutable parameters
54
55	static char *runhelp[] =
56	{
57	"",
58	"Run a SCRIPT-file with a sequence of commands"
59	#if defined (DEV32)
60	", or containing REXX code",
61	#else
62	" to be executed",
63	#endif
64	"",
65	"usage: RUN scriptfile-name [options] [arguments]",
66	"",
67	#if defined (DEV32)
68	" Options: (Options and Arguments for NATIVE scripts, not REXX)",
69	#else
70	" Options:",
71	#endif
72	" -v = verbose, show details about running the script",
73	" -p- = no prompting and command-echo by the command handler",
74	" -p:1 = echo command by handler, but no prompting afterwards",
75	" -p:2 = no echo by handler, but prompting afterwards",
76	" -p:3 = echo before, and prompt after executing (default)",
77	" -E:i = ignore errors, continue execution when RC is not 0",
78	" -E:q = quit on any errors, exit (default when in batch mode)",
79	" -E:c = confirm by user on errors (default when interactive)",
80	" -s = single-step, confirm each line before executing it",
81	" -q = quit the program after executing the script",
82	"",
83	" Arguments : upto 9 arguments can be specified and can be used anywhere",
84	" in the script as '$1' to '$9' while $0 is the scriptname.",
85	" Arguments can be enclosed in single- or double-quotes",
86	" to allow embedded spaces or special characters.",
87	"",
88	NULL
89	};
90
91	#if defined (USEWINDOWING)
92	static BOOL txs_help_registred = FALSE;
93
94	static char *confirmhelp[] =
95	{
96	"",
97	" Script command execution prompt",
98	"",
99	" This is to acknowledge that you want the displayed command to",
100	" be executed, taking the latest return-code (RC) into account.",
101	"",
102	"",
103	"",
104	"",
105	"",
106	NULL
107	};
108	#endif
109
110
111	/*****************************************************************************/
112	// Run native TXS script using callback (from parsed RUN cmd if runcmd == NULL)
113	/*****************************************************************************/
114	ULONG TxsNativeRun
115	(
116	char *name, // IN TXS script to execute
117	char *runcmd, // IN RUN cmd string or NULL
118	TX_NATIVE_CALLBACK subcom // IN subcommand handler
119	)
120	{
121	ULONG rc = NO_ERROR; // function return
122	FILE *script = NULL;
123	TXLN scrline; // script line
124	TXLN command;
125	ULONG linenr = 0;
126	ULONG scep = TxaOptNum('p', "prompt/echo", 3);
127	BOOL loud = TxaOption('v'); // verbose script handling
128	BOOL step = TxaOption('s'); // single step
129	BOOL execute = TRUE; // execute next command
130	BOOL abort = FALSE; // abort whole script
131	char error; // type of error handling
132	BOOL confirm; // confirm continuation
133	TXTM basename; // script basename ($0)
134	char *params[10]; // script parameters
135	char *pardef[10]; // default parameter values
136	char *pp; // parameter
137	char *s; // generic char pointer
138	int pi; // parameter index
139
140	ENTER();
141
142	#if defined (USEWINDOWING)
143	if (!txs_help_registred)
144	{
145	txwRegisterHelpText( TXSC_HELPREG, "Script confirmation", confirmhelp);
146	txs_help_registred = TRUE;
147	}
148	#endif // USEWINDOWING
149
150	error = TxaErrorStrategy( 'E', TxaExeSwitch('b'));
151
152	if (subcom != NULL) // command handler present ?
153	{
154	if ((script = TxFindAndOpenFile( name, "PATH", scrline)) != NULL)
155	{
156	if (loud) // verbose ?
157	{
158	TxPrint( "\nRUN native script : '%s'\n", scrline);
159	}
160	strcpy( basename, TxGetBaseName( name));
161	TxStripExtension( basename);
162
163	for (pi = 0; pi < 10; pi++) // params 0..9
164	{
165	pardef[ pi] = NULL; // default parameter value
166	params[ pi] = TxaArgValue( pi +1); // parsed arguments
167	}
168	params[0] = basename; // use base script name
169
170	while (!abort && !TxAbort() && !feof(script) && !ferror(script))
171	{
172	strcpy( scrline, "");
173	confirm = FALSE;
174	if (fgets( scrline, TXMAXLN, script) != NULL)
175	{
176	linenr++;
177	TxRepl( scrline, '\n', '\0');
178	TxRepl( scrline, '\r', '\0'); // mainly for Linux/Unix ...
179	txsSubstituteParams( scrline, params, TXSC_PARAMS,
180	TXMAXLN, command);
181
182	if ( (strlen( command) > 0) && // not empty, and
183	((command[0] != ';') \|\| // not a comment
184	(command[1] == ';'))) // except when a pragma
185	{
186	if (step) // single step ?
187	{
188	confirm = TRUE;
189	}
190	else if (rc != NO_ERROR) // some error
191	{
192	switch (error)
193	{
194	case 'q': abort = TRUE; break;
195	case 'c': confirm = TRUE; break;
196	default: break;
197	}
198	}
199	if (!abort)
200	{
201	execute = TRUE;
202	if (confirm)
203	{
204	if (!TxConfirm( TXSC_HELPREG + 00,
205	"Script line nr : % 2lu, Last RC was : %ld\n"
206	"Next command is:\n\n%s%s%s\n\n"
207	"Execute this command ? [Y/N] : ",
208	linenr, rc, CBC, command, CNN))
209	{
210	execute = FALSE;
211	}
212	}
213	if (execute)
214	{
215	if (loud) // verbose ?
216	{
217	TxPrint( "RUN exec line % 3lu : '%s'\n",
218	linenr, command);
219	}
220	if (strncmp( command, TXSC_PRAGMA,
221	strlen(TXSC_PRAGMA)) == 0)
222	{
223	TRACES(("Pragma: '%s'\n", command));
224	for (pp = command; pp && (pp != ' '); pp++)
225	{
226	}
227	while (pp && (pp == ' '))
228	{
229	pp++; // skip whitespace
230	}
231	TRACES(("Params: '%s'\n", pp));
232	if (strnicmp( command, TXSC_P_PARDEF,
233	strlen( TXSC_P_PARDEF)) == 0)
234	{
235	if (isdigit(*pp))
236	{
237	pi = (int) ((*pp) - '0'); //- index 0..9
238	if (( params[pi] == NULL) \|\|
239	(strlen(params[pi]) == 0)) //- need default ?
240	{
241	pp += 2;
242	TxFreeMem( pardef[pi]);
243	if ((pardef[pi] = TxAlloc( 1, strlen(pp) + 1))
244	!= NULL)
245	{
246	if (loud) // verbose ?
247	{
248	TxPrint( "RUN def $%d value : '%s'\n", pi, pp);
249	}
250	strcpy( pardef[pi], pp);
251	if ((s = strchr( pardef[pi], ';')) != NULL)
252	{
253	*s = 0; // strip comment from value
254	}
255	//- also removes translated CR/LF on Linux
256	TxStrip( pardef[pi], pardef[pi], 0, ' ');
257	params[pi] = pardef[pi];
258	}
259	}
260	}
261	}
262	else if (strnicmp( command, TXSC_P_PARSET,
263	strlen( TXSC_P_PARSET)) == 0)
264	{
265	if (isdigit(*pp))
266	{
267	TXLN value;
268
269	strcpy( value, params[pi]); //- current is default
270	pi = (int) ((*pp) - '0'); //- index 0..9
271	pp += 2; //- skip param number
272	TxFreeMem( pardef[pi]); //- free old value
273	if (loud) //- verbose ?
274	{
275	TxPrint( "RUN set $%d value : '%s'\n", pi, pp);
276	}
277	if (*pp == '?') //- prompt for a value
278	{
279	pp += 2; //- skip questionmark
280
281	TxPrompt( 0, TXMAXLN, value, pp);
282	if ((pardef[pi] = TxAlloc( 1,
283	strlen(value) + 1)) != NULL)
284	{
285	strcpy( pardef[pi], value);
286	TxStrip( pardef[pi], pardef[pi], 0, ' ');
287	params[pi] = pardef[pi];
288	}
289	}
290	else // direct set of a value
291	{
292	if ((pardef[pi] = TxAlloc( 1,
293	strlen(pp) + 1)) != NULL)
294	{
295	strcpy( pardef[pi], pp);
296	if ((s = strchr( pardef[pi], ';')) != NULL)
297	{
298	*s = 0; // strip comment from value
299	}
300	//- also removes translated CR/LF on Linux
301	TxStrip( pardef[pi], pardef[pi], 0, ' ');
302	params[pi] = pardef[pi];
303	}
304	}
305	}
306	}
307	else if (strnicmp( command, TXSC_P_VERBOS,
308	strlen(TXSC_P_VERBOS)) == 0)
309	{
310	BOOL verbose = loud;
311
312	loud = TxaParseBool( pp);
313	if (loud \|\| verbose)
314	{
315	TxPrint( "RUN set verbose : %s\n",
316	(loud) ? "ON" : "OFF");
317	}
318	}
319	else if (strnicmp( command, TXSC_P_SISTEP,
320	strlen(TXSC_P_SISTEP)) == 0)
321	{
322	step = TxaParseBool( pp);
323	if (loud) // verbose ?
324	{
325	TxPrint( "RUN set singlestep: %s\n",
326	(step) ? "ON" : "OFF");
327	}
328	}
329	else if (strnicmp( command, TXSC_P_PROMPT,
330	strlen(TXSC_P_PROMPT)) == 0)
331	{
332	if (isdigit(*pp))
333	{
334	scep = (ULONG) (*pp - '0');
335	if (loud) // verbose ?
336	{
337	TxPrint( "RUN set prompting : %lu\n",
338	scep);
339	}
340	}
341	}
342	else if (strnicmp( command, TXSC_P_ERRORS,
343	strlen(TXSC_P_ERRORS)) == 0)
344	{
345	if (strchr( "icqICQ", *pp) != NULL)
346	{
347	error = tolower(*pp);
348	if (loud) // verbose ?
349	{
350	TxPrint( "RUN set error mode: '%c'\n",
351	error);
352	}
353	}
354	}
355	else // unrecognized pragma
356	{
357	if (loud)
358	{
359	TxPrint( "RUN warning Pragma: '%s' unknown!\n",
360	command);
361	}
362	}
363	}
364	else // execute by subcom handler
365	{
366	TRACES(("Subcom: '%s'\n", command))
367	rc = (subcom)( command,
368	(scep & 0x01),
369	(scep & 0x02),
370	TRUE);
371	}
372	}
373	}
374	else
375	{
376	TxPrint( "Aborting execution\n");
377	}
378	}
379	else
380	{
381	if (loud) // verbose ?
382	{
383	TxPrint( "RUN skip line % 3lu : '%s'\n",
384	linenr, command);
385	}
386	}
387	}
388	}
389	for (pi = 0; pi < 10; pi++) // params 0..9
390	{
391	TxFreeMem( pardef[ pi]); // free allocated defaults
392	}
393	fclose( script);
394	}
395	else
396	{
397	TxPrint( "TXs native script : '%s' not found\n", name);
398	rc = TX_INVALID_FILE;
399	}
400	}
401	else // give usage for RUN
402	{
403	TxShowTxt( runhelp);
404	}
405	RETURN (rc);
406	} // end 'TxsNativeRun'
407	/---------------------------------------------------------------------------/
408
409
410	/*****************************************************************************/
411	// Substitute $n parameters in a string by supplied values; n = 0..9 (maximum)
412	/*****************************************************************************/
413	ULONG txsSubstituteParams // RET nr of substitutions
414	(
415	char *string, // IN base string
416	char **values, // IN values to substitute
417	int count, // IN number of values
418	int size, // IN size of output buffer
419	char *result // OUT substituted (MAXLIN)
420	)
421	{
422	ULONG rc = 0; // function return
423	char *bs = string;
424	char *rs = result;
425	int rl = 0; // resulting length
426	int si; // substitution index
427
428	ENTER();
429	TRARGS(("string: '%s'\n", string));
430
431	while ((*bs) && (rl < TXMAXLN))
432	{
433	if ((bs == '$') && isdigit((bs+1))) // substitution candidate
434	{
435	bs++; // skip $
436	si = (int) ((*bs) - '0'); // index 0..9
437	if ((si < count) &&
438	(values[si] != NULL)) // value available ?
439	{
440	rl += strlen( values[si]);
441	if (rl < size) // room to grow ?
442	{
443	strcpy( rs, values[si]); // copy value
444	rs += strlen( values[si]); // and update destination
445	}
446	}
447	bs++; // skip digit
448	}
449	else
450	{
451	rs++ = bs++; // copy single char
452	rl++;
453	}
454	}
455	*rs = '\0'; // terminate result string
456
457	TRARGS(("result: '%s'\n", result));
458	RETURN (rc);
459	} // end 'txsSubstituteParams'
460	/---------------------------------------------------------------------------/
461
462
463	/*****************************************************************************/
464	// Test if script exists, is REXX, return parameter description and full-name
465	/*****************************************************************************/
466	BOOL TxsValidateScript // RET script exists
467	(
468	char *sname, // IN script name
469	BOOL *rexx, // OUT script is REXX
470	char *pdesc, // OUT param description or NULL
471	char *fname // OUT full scriptname or NULL
472	)
473	{
474	BOOL rc = FALSE; // function return
475	TXLN line;
476	FILE *script;
477	char *pp = NULL; // parameter position
478
479	ENTER();
480
481	if ((script = TxFindAndOpenFile( sname, "PATH", line)) != NULL)
482	{
483	rc = TRUE; // script exists
484	if (fname != NULL) // full name wanted
485	{
486	strcpy( fname, line); // copy full name
487	TRACES(("fname: '%s'\n", fname));
488	}
489	if (fgets( line, TXMAXLN, script) != NULL)
490	{
491	if (rexx != NULL) // want REXX test ?
492	{
493	rexx = (memcmp( line, "/" "", 2) == 0);
494	}
495	if (pdesc != NULL) // want descriptions ?
496	{
497	strcpy( pdesc, "");
498	if (fgets( line, TXMAXLN, script) != NULL)
499	{
500	if ((pp = strrchr( line, '~')) != NULL)
501	{
502	*(pp+1) = 0; // clean up the line
503	}
504	if ((pp = strchr( line, '~') ) != NULL)
505	{
506	TxRepl( pp, '~', '\n'); // make descriptions readable
507	strcpy( pdesc, pp); // and copy to caller ...
508	}
509	}
510	TRACES(("pdesc: '%s'\n", pdesc));
511	}
512	}
513	fclose( script);
514	}
515	BRETURN (rc);
516	} // end 'TxsValidateScript'
517	/---------------------------------------------------------------------------/
518
519
520
521	#if defined (DEV32) // REXX for OS/2 only
522	#define TX_SIOEXIT ((PSZ) "tx_sioexit") // name of exit function
523
524	#define TX_REXXDLL ((PSZ) "REXX") // name of REXX dll
525	#define TX_REXXAPI ((PSZ) "REXXAPI") // name of REXXAPI dll
526
527	PFN txRexxStart;
528	PFN txRexxRegExe;
529	PFN txRexxRegExit;
530	PFN txRexxDeregEx;
531	PFN txRexxDereg;
532	PFN txRexxVarPool;
533
534	// Route 'say' output through the TxPrint channel
535	static LONG _System tx_sioexit
536	(
537	LONG exitnr, // IN exit-id (RXSIO)
538	LONG funcnr, // IN func-id
539	PEXIT parmblock // IN parameters to func
540	);
541
542
543	/*****************************************************************************/
544	// Execute a REXX command script using a subcommand environment
545	/*****************************************************************************/
546	ULONG TxsRexxRun
547	(
548	char *name, // IN REXX proc to execute
549	char *args, // IN Arguments
550	char *envname, // IN REXX environment name
551	TX_SUBCOM_CALLBACK subcom // IN subcommand handler
552	)
553	{
554	ULONG dr = NO_ERROR;
555	LONG rc; /* rc from REXX interpreter */
556	RXSTRING arg; /* argument string for REXX */
557	RXSTRING rxret; /* return value from REXX */
558	SHORT rexxrc = 0; /* return code from function */
559	TXLN rxcode;
560	HMODULE rexxdll; // handle for REXX dll
561	HMODULE rexxapi; // handle for REXXAPI dll
562	RXSYSEXIT exit_list[2]; // list of exit-handlers
563
564	ENTER();
565
566	if (TxaOption('v')) // verbose ?
567	{
568	TxPrint( "\nRUN REXX script : '%s %s'\n", name, args);
569	}
570	dr = DosLoadModule( rxcode, TXMAXLN, // error buffer and size
571	TX_REXXDLL, // name of dll
572	&rexxdll); // module handle
573	if (dr == NO_ERROR)
574	{
575	dr = DosLoadModule( rxcode, TXMAXLN, // error buffer and size
576	TX_REXXAPI, // name of dll
577	&rexxapi); // module handle
578	if (dr == NO_ERROR)
579	{
580	TRACES(("REXX/API mod handles: %lu / %lu\n", rexxdll, rexxapi));
581	if ((DosQueryProcAddr(rexxapi, 0,
582	"RexxRegisterSubcomExe", (PFN *) &txRexxRegExe ) == NO_ERROR) &&
583	(DosQueryProcAddr(rexxapi, 0,
584	"RexxRegisterExitExe", (PFN *) &txRexxRegExit) == NO_ERROR) &&
585	(DosQueryProcAddr(rexxapi, 0,
586	"RexxDeregisterExit", (PFN *) &txRexxDeregEx) == NO_ERROR) &&
587	(DosQueryProcAddr(rexxapi, 0,
588	"RexxDeregisterSubcom", (PFN *) &txRexxDereg ) == NO_ERROR) &&
589	(DosQueryProcAddr(rexxdll, 0,
590	"RexxStart", (PFN *) &txRexxStart ) == NO_ERROR) &&
591	(DosQueryProcAddr(rexxdll, 0,
592	"RexxVariablePool", (PFN *) &txRexxVarPool) == NO_ERROR)
593	)
594	{
595	dr = txRexxRegExe( envname, subcom, NULL );
596	TRACES(("RegSubcomExe RC: %lu\n", (ULONG) dr));
597	if (dr == RXSUBCOM_OK)
598	{
599	dr = txRexxRegExit( TX_SIOEXIT, (PFN) &tx_sioexit, NULL );
600	if (dr == RXSUBCOM_OK)
601	{
602	exit_list[0].sysexit_name = TX_SIOEXIT;
603	exit_list[0].sysexit_code = RXSIO;
604	exit_list[1].sysexit_code = RXENDLST;
605
606	rxret.strlength = 0L; /* force REXX to alloc rxret */
607	MAKERXSTRING(arg, args, strlen(args));
608
609	TRACES(("RexxStart to be executed\n"));
610	rc = txRexxStart(
611	1, /* number of arguments */
612	&arg, /* array of arguments */
613	(PSZ) name, /* name of REXX file */
614	0, /* No INSTORE used */
615	envname, /* Command env. name */
616	RXSUBROUTINE, /* invoked as subroutine */
617	exit_list, /* used EXITs on this call */
618	&rexxrc, /* Rexx program output */
619	&rxret ); /* Rexx program output */
620	if (rc == 0)
621	{
622	if (rexxrc != 0)
623	{
624	dr = (ULONG) rexxrc;
625	}
626	}
627	else
628	{
629	dr = (ULONG) 20000-rc;
630	TxPrint("Rexx interpreter error: %d on macro '%s'\n", rc, name);
631	sprintf( rxcode, "help REX%04.4u", (USHORT) (0-rc));
632	TxExternalCommand( rxcode);
633	}
634	if (rxret.strlength != 0)
635	{
636	//- to be refined, may want to pass that back
637	//- as a string to caller ?
638
639	TxPrint( "REXX return: '%.s'\n",
640	rxret.strlength, rxret.strlength, rxret.strptr);
641	}
642	DosFreeMem(rxret.strptr); /* Release storage */
643	txRexxDeregEx( TX_SIOEXIT, NULL);
644	}
645	else
646	{
647	TxPrint("Error registering SAY exit handler\n");
648	}
649	txRexxDereg( envname, NULL);
650	}
651	else
652	{
653	TxPrint("Error registering REXX subcommand handler\n");
654	}
655	}
656	else
657	{
658	TxPrint("Error resolving REXX API's from: '%s' and/or '%s'\n",
659	TX_REXXDLL, TX_REXXAPI);
660	}
661	DosFreeModule( rexxapi);
662	}
663	else
664	{
665	TxPrint("Error %lu loading Rexx API DLL: '%s'\n", dr, TX_REXXAPI);
666	}
667	DosFreeModule( rexxdll);
668	}
669	else
670	{
671	TxPrint("Error %lu loading Rexx DLL: '%s'\n", dr, TX_REXXDLL);
672	TxPrint("Rexx functionality not available\n");
673	}
674	RETURN (dr);
675	} // end 'TxsRexxRun'
676	/---------------------------------------------------------------------------/
677
678
679	/*****************************************************************************/
680	// Route 'say' output through the TxPrint channel
681	/*****************************************************************************/
682	static LONG _System tx_sioexit
683	(
684	LONG exitnr, // IN exit-id (RXSIO)
685	LONG funcnr, // IN func-id
686	PEXIT parmblock // IN parameters to func
687	)
688	{
689	ULONG dr;
690	RXSIOSAY_PARM sio = (RXSIOSAY_PARM