1/*
2 * tclexpat.c --
3 *
4 *	A Tcl interface to James Clark's expat XML parser
5 *
6 * Copyright (c) 1998 Steve Ball, Zveno Pty Ltd
7 *
8 * Zveno Pty Ltd makes this software and associated documentation
9 * available free of charge for any purpose.  You may make copies
10 * of the software but you must include all of this notice on any copy.
11 *
12 * Zveno Pty Ltd does not warrant that this software is error free
13 * or fit for any purpose.  Zveno Pty Ltd disclaims any liability for
14 * all claims, expenses, losses, damages and costs any user may incur
15 * as a result of using, copying or modifying the software.
16 *
17 * $Id: tclexpat.c,v 1.1 2004/05/23 22:50:39 neumann Exp $
18 *
19 */
20
21#include <tcl.h>
22#include <xotcl.h>
23#include <string.h>
24#include "xmlparse.h"
25
26
27/*
28 * The structure below is used to refer to an expat parser object.
29 */
30
31typedef struct TclExpatInfo {
32  XML_Parser parser;		/* The expat parser structure */
33  Tcl_Interp *interp;		/* Interpreter for this instance */
34  Tcl_Obj *name;		/* name of this instance */
35
36  int final;			/* input data complete? */
37
38  int status;			/* application status */
39  Tcl_Obj *result;		/* application return result */
40
41  int continueCount;		/* reference count for continue */
42
43  Tcl_Obj *elementstartcommand;	/* Script for element start */
44  Tcl_Obj *elementendcommand;	/* Script for element end */
45  Tcl_Obj *datacommand;		/* Script for character data */
46  Tcl_Obj *picommand;		/* Script for processing instruction */
47  Tcl_Obj *defaultcommand;	/* Script for default data */
48  Tcl_Obj *unparsedcommand;	/* Script for unparsed entity declaration */
49  Tcl_Obj *notationcommand;	/* Script for notation declaration */
50  Tcl_Obj *externalentitycommand;	/* Script for external entity */
51  Tcl_Obj *unknownencodingcommand;	/* Script for unknown character encoding */
52
53} TclExpatInfo;
54
55/*
56 * Prototypes for procedures defined later in this file:
57 */
58
59static Tcl_ObjCmdProc TclExpatObjCmd;
60static Tcl_ObjCmdProc TclExpatInstanceCmd;
61static Tcl_CmdDeleteProc TclExpatDeleteCmd;
62static int (TclExpatCreateParser) _ANSI_ARGS_((Tcl_Interp *interp,
63					       TclExpatInfo *expat));
64static void (TclExpatFreeParser)  _ANSI_ARGS_((TclExpatInfo *expat));
65static int (TclExpatParse) _ANSI_ARGS_((Tcl_Interp *interp,
66					TclExpatInfo *expat,
67					char *data,
68					size_t len));
69static int (TclExpatConfigure) _ANSI_ARGS_((Tcl_Interp *interp,
70					    TclExpatInfo *expat,
71					    int objc,
72					    Tcl_Obj *CONST objv[]));
73static int (TclExpatCget) _ANSI_ARGS_((Tcl_Interp *interp,
74				       TclExpatInfo *expat,
75				       int objc,
76				       Tcl_Obj *CONST objv[]));
77
78static void * (TclExpatElementStartHandler) _ANSI_ARGS_((void *userdata,
79							 const XML_Char *name,
80							 const XML_Char **atts));
81static void * (TclExpatElementEndHandler) _ANSI_ARGS_((void *userData,
82						       const XML_Char *name));
83static void * (TclExpatCharacterDataHandler) _ANSI_ARGS_((void *userData,
84							  const XML_Char *s,
85							  int len));
86static void * (TclExpatProcessingInstructionHandler) _ANSI_ARGS_((void *userData,
87								  const XML_Char *target,
88								  const XML_Char *data));
89static void * (TclExpatExternalEntityRefHandler) _ANSI_ARGS_((XML_Parser parser,
90							      const XML_Char *openEntityNames,
91							      const XML_Char *base,
92							      const XML_Char *systemId,
93							      const XML_Char *publicId));
94static void * (TclExpatDefaultHandler) _ANSI_ARGS_ ((void *userData,
95						     const XML_Char *s,
96						     int len));
97static void * (TclExpatUnparsedDeclHandler) _ANSI_ARGS_ ((void *userData,
98							  const XML_Char *entityname,
99							  const XML_Char *base,
100							  const XML_Char *systemId,
101							  const XML_Char *publicId,
102							  const XML_Char *notationName));
103static void * (TclExpatNotationDeclHandler) _ANSI_ARGS_ ((void *userData,
104							  const XML_Char *notationName,
105							  const XML_Char *base,
106							  const XML_Char *systemId,							  const XML_Char *publicId));
107static int (TclExpatUnknownEncodingHandler) _ANSI_ARGS_ ((void *encodingHandlerData,
108							 const XML_Char *name,
109							 XML_Encoding *info));
110
111#if defined(PRE81)
112
113/*
114 *----------------------------------------------------------------------------
115 *
116 * Tcl_GetString --
117 *
118 *	Compatibility routine for Tcl 8.0
119 *
120 * Results:
121 *	String representation of object..
122 *
123 * Side effects:
124 *	None.
125 *
126 *----------------------------------------------------------------------------
127 */
128
129char *
130Tcl_GetString (obj)
131     Tcl_Obj *obj; /* Object to retrieve string from. */
132{
133  char *s;
134  int i;
135
136  s = Tcl_GetStringFromObj(obj, &i);
137  return s;
138}
139#endif
140
141/*
142 *----------------------------------------------------------------------------
143 *
144 * TclExpat_Init --
145 *
146 *	Initialisation routine for loadable module
147 *
148 * Results:
149 *	None.
150 *
151 * Side effects:
152 *	Defines "expat" command in the interpreter.
153 *
154 *----------------------------------------------------------------------------
155 */
156
157/* this should be done via the stubs ... for the time being
158   simply export */
159#ifdef VISUAL_CC
160DLLEXPORT extern int Xotclexpat_Init(Tcl_Interp * interp);
161# define CONST_XOTCL_EXPAT
162#else
163# if defined(PRE84)
164#  define CONST_XOTCL_EXPAT
165# else
166#  define CONST_XOTCL_EXPAT CONST84
167# endif
168#endif
169
170extern int
171Xotclexpat_Init (interp)
172     Tcl_Interp *interp; /* Interpreter to initialise. */
173{
174#ifdef USE_TCL_STUBS
175    if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
176        return TCL_ERROR;
177    }
178#ifdef USE_XOTCL_STUBS
179    if (Xotcl_InitStubs(interp, "1.1", 0) == NULL) {
180        return TCL_ERROR;
181    }
182#endif
183#else
184    if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 0) == NULL) {
185        return TCL_ERROR;
186    }
187#endif
188
189
190  Tcl_PkgProvide(interp, "xotcl::xml::expat", PACKAGE_VERSION);
191
192  Tcl_CreateObjCommand(interp, "expat", TclExpatObjCmd, NULL, NULL);
193
194  return TCL_OK;
195}
196
197/*
198 *----------------------------------------------------------------------------
199 *
200 * TclExpatObjCmd --
201 *
202 *	Creation command for expat class.
203 *
204 * Results:
205 *	The name of the newly created parser instance.
206 *
207 * Side effects:
208 *	This creates an expat parser.
209 *
210 *----------------------------------------------------------------------------
211 */
212
213int
214TclExpatObjCmd(dummy, interp, objc, objv)
215     ClientData dummy;
216     Tcl_Interp *interp;
217     int objc;
218     Tcl_Obj *CONST objv[];
219{
220  TclExpatInfo *expat;
221
222  if (objc < 2) {
223    Tcl_WrongNumArgs(interp, 1, objv, "name ?args?");
224    return TCL_ERROR;
225  }
226
227  /*
228   * Create the data structures for this parser.
229   */
230
231  if (!(expat = (TclExpatInfo *) ckalloc(sizeof(TclExpatInfo)))) {
232    ckfree((char*)expat);
233    Tcl_SetResult(interp, "unable to create parser", NULL);
234    return TCL_ERROR;
235  }
236  expat->interp = interp;
237  Tcl_IncrRefCount(objv[1]);
238  expat->name = objv[1];
239
240  expat->elementstartcommand = NULL;
241  expat->elementendcommand = NULL;
242  expat->datacommand = NULL;
243  expat->picommand = NULL;
244  expat->defaultcommand = NULL;
245  expat->unparsedcommand = NULL;
246  expat->notationcommand = NULL;
247  expat->externalentitycommand = NULL;
248  expat->unknownencodingcommand = NULL;
249
250  if (TclExpatCreateParser(interp, expat) != TCL_OK) {
251    ckfree((char*)expat);
252    return TCL_ERROR;
253  }
254
255  /*
256   * Register a Tcl command for this parser instance.
257   */
258
259  Tcl_CreateObjCommand(interp, Tcl_GetString(expat->name), TclExpatInstanceCmd, (ClientData) expat, TclExpatDeleteCmd);
260
261  /*
262   * Handle configuration options
263   */
264
265  if (objc > 2) {
266    TclExpatConfigure(interp, expat, objc - 2, objv + 2);
267  }
268
269  Tcl_SetObjResult(interp, expat->name);
270
271  return TCL_OK;
272}
273
274/*
275 *----------------------------------------------------------------------------
276 *
277 * TclExpatCreateParser --
278 *
279 *	Create the expat parser and initialise (some of) the TclExpatInfo
280 *	structure.
281 *
282 *	Note that callback commands are not affected by this routine,
283 *	to allow a reset to leave these intact.
284 *
285 * Results:
286 *	New parser instance created and initialised.
287 *
288 * Side effects:
289 *	Creates an expat parser.
290 *	Modifies TclExpatInfo fields.
291 *
292 *----------------------------------------------------------------------------
293 */
294
295int
296TclExpatCreateParser(interp, expat)
297     Tcl_Interp *interp;
298     TclExpatInfo *expat;
299{
300  if (!(expat->parser = XML_ParserCreate(NULL))) {
301    Tcl_SetResult(interp, "unable to create expat parser", NULL);
302    return TCL_ERROR;
303  }
304
305  expat->final = 1;
306  expat->status = TCL_OK;
307  expat->result = NULL;
308  expat->continueCount = 0;
309
310  /*
311   * Set handlers for the parser to routines in this module.
312   */
313
314  XML_SetElementHandler(expat->parser,
315			(XML_StartElementHandler) TclExpatElementStartHandler,
316			(XML_EndElementHandler) TclExpatElementEndHandler);
317  XML_SetCharacterDataHandler(expat->parser,
318			      (XML_CharacterDataHandler) TclExpatCharacterDataHandler);
319  XML_SetProcessingInstructionHandler(expat->parser,
320				      (XML_ProcessingInstructionHandler) TclExpatProcessingInstructionHandler);
321  XML_SetDefaultHandler(expat->parser,
322			(XML_DefaultHandler) TclExpatDefaultHandler);
323  XML_SetUnparsedEntityDeclHandler(expat->parser,
324				   (XML_UnparsedEntityDeclHandler) TclExpatUnparsedDeclHandler);
325  XML_SetNotationDeclHandler(expat->parser,
326			     (XML_NotationDeclHandler) TclExpatNotationDeclHandler);
327  XML_SetExternalEntityRefHandler(expat->parser,
328				  (XML_ExternalEntityRefHandler) TclExpatExternalEntityRefHandler);
329  XML_SetUnknownEncodingHandler(expat->parser,
330				(XML_UnknownEncodingHandler) TclExpatUnknownEncodingHandler,
331				(void *) expat);
332  XML_SetUserData(expat->parser,
333		  (void *) expat);
334
335  return TCL_OK;
336}
337
338/*
339 *----------------------------------------------------------------------------
340 *
341 * TclExpatFreeParser --
342 *
343 *	Destroy the expat parser structure.
344 *
345 * Results:
346 *	None.
347 *
348 * Side effects:
349 *	Frees any memory allocated for the XML parser.
350 *
351 *----------------------------------------------------------------------------
352 */
353
354void
355TclExpatFreeParser(expat)
356     TclExpatInfo *expat;
357{
358  XML_ParserFree(expat->parser);
359  expat->parser = NULL;
360}
361
362/*
363 *----------------------------------------------------------------------------
364 *
365 * TclExpatInstanceCmd --
366 *
367 *	Implements instance command for expat class objects.
368 *
369 * Results:
370 *	Depends on the method.
371 *
372 * Side effects:
373 *	Depends on the method.
374 *
375 *----------------------------------------------------------------------------
376 */
377
378int
379TclExpatInstanceCmd (clientData, interp, objc, objv)
380     ClientData clientData;
381     Tcl_Interp *interp;
382     int objc;
383     Tcl_Obj *CONST objv[];
384{
385  TclExpatInfo *expat = (TclExpatInfo *) clientData;
386  char *data;
387  int len;
388  int index, result = TCL_OK;
389  static char CONST_XOTCL_EXPAT *options[] = {
390    "configure", "cget", "parse", "reset", NULL
391  };
392  enum options {
393    EXPAT_CONFIGURE, EXPAT_CGET, EXPAT_PARSE, EXPAT_RESET
394  };
395
396  if (objc < 2) {
397    Tcl_WrongNumArgs(interp, 1, objv, "method ?args?");
398    return TCL_ERROR;
399  }
400
401  if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0,
402			  &index) != TCL_OK) {
403    return TCL_ERROR;
404  }
405
406  switch ((enum options) index) {
407    case EXPAT_CONFIGURE:
408
409      result = TclExpatConfigure(interp, (TclExpatInfo *) clientData, objc - 2, objv + 2);
410      break;
411
412    case EXPAT_CGET:
413
414      result = TclExpatCget(interp, (TclExpatInfo *) clientData, objc - 2, objv + 2);
415      break;
416
417    case EXPAT_PARSE:
418
419      if (objc != 3) {
420	Tcl_WrongNumArgs(interp, 2, objv, "data");
421	return TCL_ERROR;
422      }
423
424      data = Tcl_GetStringFromObj(objv[2], &len);
425
426      result = TclExpatParse(interp, expat, data, (size_t)len);
427
428      break;
429
430    case EXPAT_RESET:
431
432      if (objc > 2) {
433	Tcl_WrongNumArgs(interp, 1, objv, "");
434	return TCL_ERROR;
435      }
436
437      /*
438       * Destroy the parser and create a fresh one.
439       */
440
441      TclExpatFreeParser(expat);
442      TclExpatCreateParser(interp, expat);
443
444      break;
445
446    default:
447
448      Tcl_SetResult(interp, "unknown method", NULL);
449      return TCL_ERROR;
450
451  }
452
453  return result;
454}
455
456/*
457 *----------------------------------------------------------------------------
458 *
459 * TclExpatParse --
460 *
461 *	Wrapper to invoke expat parser and check return result.
462 *
463 * Results:
464 *     TCL_OK if no errors, TCL_ERROR otherwise.
465 *
466 * Side effects:
467 *     Sets interpreter result as appropriate.
468 *
469 *----------------------------------------------------------------------------
470 */
471
472int
473TclExpatParse (interp, expat, data, len)
474     Tcl_Interp *interp;
475     TclExpatInfo *expat;
476     char *data;
477     size_t len;
478{
479  int result;
480  char s[255];
481
482  expat->status = TCL_OK;
483  if (expat->result != NULL) {
484    Tcl_DecrRefCount(expat->result);
485  }
486  expat->result = NULL;
487
488  result = XML_Parse(expat->parser,
489		     data, len,
490		     expat->final);
491
492  if (!result) {
493    Tcl_ResetResult(interp);
494    sprintf(s, "%d", XML_GetCurrentLineNumber(expat->parser));
495    Tcl_AppendResult(interp, "error \"",
496 		     XML_ErrorString(XML_GetErrorCode(expat->parser)),
497		     "\" at line ", s, " character ", NULL);
498    sprintf(s, "%d", XML_GetCurrentColumnNumber(expat->parser));
499    Tcl_AppendResult(interp, s, NULL);
500
501    return TCL_ERROR;
502  }
503
504  switch (expat->status) {
505    case TCL_OK:
506    case TCL_BREAK:
507    case TCL_CONTINUE:
508      Tcl_ResetResult(interp);
509      return TCL_OK;
510
511    case TCL_ERROR:
512      Tcl_SetObjResult(interp, expat->result);
513      return TCL_ERROR;
514
515    default:
516      Tcl_SetResult(interp, "unknown parsing status", NULL);
517      return TCL_ERROR;
518  }
519
520}
521
522/*
523 *----------------------------------------------------------------------------
524 *
525 * TclExpatConfigure --
526 *
527 *	Implements instance command for expat class objects.
528 *
529 * Results:
530 *	Depends on the method.
531 *
532 * Side effects:
533 *	Depends on the method.
534 *
535 *----------------------------------------------------------------------------
536 */
537
538int
539TclExpatConfigure (interp, expat, objc, objv)
540     Tcl_Interp *interp;
541     TclExpatInfo *expat;
542     int objc;
543     Tcl_Obj *CONST objv[];
544{
545  static CONST_XOTCL_EXPAT char *switchTable[] = {
546    "-final",
547    "-baseurl",
548    "-elementstartcommand",
549    "-elementendcommand",
550    "-characterdatacommand",
551    "-processinginstructioncommand",
552    "-defaultcommand",
553    "-unparsedentitydeclcommand",
554    "-notationdeclcommand",
555    "-externalentitycommand",
556    "-unknownencodingcommand",
557    (char *) NULL
558  };
559  enum switches {
560    EXPAT_FINAL, EXPAT_BASE,
561    EXPAT_ELEMENTSTARTCMD, EXPAT_ELEMENTENDCMD,
562    EXPAT_DATACMD, EXPAT_PICMD,
563    EXPAT_DEFAULTCMD,
564    EXPAT_UNPARSEDENTITYCMD, EXPAT_NOTATIONCMD,
565    EXPAT_EXTERNALENTITYCMD, EXPAT_UNKNOWNENCODINGCMD
566  };
567  int index, bool, doParse = 0;
568  Tcl_Obj *CONST *objPtr = objv;
569
570  while (objc > 1) {
571    if (Tcl_GetIndexFromObj(interp, objPtr[0], switchTable,
572			    "switch", 0, &index) != TCL_OK) {
573      return TCL_ERROR;
574    }
575    switch ((enum switches) index) {
576      case EXPAT_FINAL:			/* -final */
577
578	if (Tcl_GetBooleanFromObj(interp, objPtr[1], &bool) != TCL_OK) {
579	  return TCL_ERROR;
580	}
581
582	if (bool && !expat->final) {
583
584	  expat->final = bool;
585	  doParse = 1;
586
587	} else if (!bool && expat->final) {
588
589	  /*
590	   * Reset the parser for new input
591	   */
592
593	  TclExpatFreeParser(expat);
594	  TclExpatCreateParser(interp, expat);
595	  doParse = 0;
596
597	}
598
599	break;
600
601      case EXPAT_BASE:			/* -base */
602
603	if (XML_SetBase(expat->parser, Tcl_GetString(objPtr[1])) == 0) {
604	  Tcl_SetResult(interp, "unable to set base URL", NULL);
605	  return TCL_ERROR;
606	}
607	break;
608
609      case EXPAT_ELEMENTSTARTCMD:	/* -elementstartcommand */
610
611	if (expat->elementstartcommand != NULL) {
612	  Tcl_DecrRefCount(expat->elementstartcommand);
613	}
614
615	expat->elementstartcommand = objPtr[1];
616	Tcl_IncrRefCount(expat->elementstartcommand);
617
618	break;
619
620      case EXPAT_ELEMENTENDCMD:		/* -elementendcommand */
621
622	if (expat->elementendcommand != NULL) {
623	  Tcl_DecrRefCount(expat->elementendcommand);
624	}
625
626	expat->elementendcommand = objPtr[1];
627	Tcl_IncrRefCount(expat->elementendcommand);
628
629	break;
630
631      case EXPAT_DATACMD:		/* -characterdatacommand */
632
633	if (expat->datacommand != NULL) {
634	  Tcl_DecrRefCount(expat->datacommand);
635	}
636
637	expat->datacommand = objPtr[1];
638	Tcl_IncrRefCount(expat->datacommand);
639
640	break;
641
642      case EXPAT_PICMD:			/* -processinginstructioncommand */
643
644	if (expat->picommand != NULL) {
645	  Tcl_DecrRefCount(expat->picommand);
646	}
647
648	expat->picommand = objPtr[1];
649	Tcl_IncrRefCount(expat->picommand);
650
651	break;
652
653      case EXPAT_DEFAULTCMD:		/* -defaultcommand */
654
655	if (expat->defaultcommand != NULL) {
656	  Tcl_DecrRefCount(expat->defaultcommand);
657	}
658
659	expat->defaultcommand = objPtr[1];
660	Tcl_IncrRefCount(expat->defaultcommand);
661
662	break;
663
664      case EXPAT_UNPARSEDENTITYCMD:		/* -unparsedentitydeclcommand */
665
666	if (expat->unparsedcommand != NULL) {
667	  Tcl_DecrRefCount(expat->unparsedcommand);
668	}
669
670	expat->unparsedcommand = objPtr[1];
671	Tcl_IncrRefCount(expat->unparsedcommand);
672
673	break;
674
675      case EXPAT_NOTATIONCMD:			/* -notationdeclcommand */
676
677	if (expat->notationcommand != NULL) {
678	  Tcl_DecrRefCount(expat->notationcommand);
679	}
680
681	expat->notationcommand = objPtr[1];
682	Tcl_IncrRefCount(expat->notationcommand);
683
684	break;
685
686      case EXPAT_EXTERNALENTITYCMD:	/* -externalentitycommand */
687
688	if (expat->externalentitycommand != NULL) {
689	  Tcl_DecrRefCount(expat->externalentitycommand);
690	}
691
692	expat->externalentitycommand = objPtr[1];
693	Tcl_IncrRefCount(expat->externalentitycommand);
694
695	break;
696
697      case EXPAT_UNKNOWNENCODINGCMD:		/* -unknownencodingcommand */
698
699	/* Not implemented */
700	break;
701
702	if (expat->unknownencodingcommand != NULL) {
703	  Tcl_DecrRefCount(expat->unknownencodingcommand);
704	}
705
706	expat->unknownencodingcommand = objPtr[1];
707	Tcl_IncrRefCount(expat->unknownencodingcommand);
708
709	break;
710
711    }
712
713    objPtr += 2;
714    objc -= 2;
715
716  }
717
718  if (doParse) {
719    return TclExpatParse(interp, expat->parser, "", 0);
720  } else {
721    return TCL_OK;
722  }
723
724}
725
726/*
727 *----------------------------------------------------------------------------
728 *
729 * TclExpatCget --
730 *
731 *	Returns setting of configuration option.
732 *	Not yet implemented.
733 *
734 * Results:
735 *	Option value.
736 *
737 * Side effects:
738 *	None.
739 *
740 *----------------------------------------------------------------------------
741 */
742
743int
744TclExpatCget (interp, expat, objc, objv)
745     Tcl_Interp *interp;
746     TclExpatInfo *expat;
747     int objc;
748     Tcl_Obj *CONST objv[];
749{
750  Tcl_SetResult(interp, "method not implemented", NULL);
751  return TCL_ERROR;
752}
753
754/*
755 *----------------------------------------------------------------------------
756 *
757 * TclExpatHandlerResult --
758 *
759 *	Manage the result of the application callback.
760 *
761 * Results:
762 *	None.
763 *
764 * Side Effects:
765 *	Further invocation of callback scripts may be inhibited.
766 *
767 *----------------------------------------------------------------------------
768 */
769
770void
771TclExpatHandlerResult(expat, result)
772     TclExpatInfo *expat;
773     int result;
774{
775  switch (result) {
776    case TCL_OK:
777      expat->status = TCL_OK;
778      break;
779
780    case TCL_CONTINUE:
781      /*
782       * Skip callbacks until the matching end element event
783       * occurs for the currently open element.
784       * Keep a reference count to handle nested
785       * elements.
786       */
787      expat->status = TCL_CONTINUE;
788      expat->continueCount = 1;
789      break;
790
791    case TCL_BREAK:
792      /*
793       * Skip all further callbacks, but return OK.
794       */
795      expat->status = TCL_BREAK;
796      break;
797
798    case TCL_ERROR:
799      /*
800       * Skip all further callbacks, and return error.
801       */
802    default:
803      expat->status = TCL_ERROR;
804      expat->result = Tcl_GetObjResult(expat->interp);
805      Tcl_IncrRefCount(expat->result);
806      break;
807  }
808}
809
810/*
811 *----------------------------------------------------------------------------
812 *
813 * TclExpatElementStartHandler --
814 *
815 *	Called by expat for each start tag.
816 *
817 * Results:
818 *	None.
819 *
820 * Side Effects:
821 *	Callback script is invoked.
822 *
823 *----------------------------------------------------------------------------
824 */
825
826static void *
827TclExpatElementStartHandler(userData, name, atts)
828     void *userData;
829     const char *name;
830     const char **atts;
831{
832  TclExpatInfo *expat = (TclExpatInfo *) userData;
833  Tcl_Obj *atList, *cmdPtr;
834  const char **atPtr;
835  int result;
836
837  if (expat->status == TCL_CONTINUE) {
838
839    /*
840     * We're currently skipping elements looking for the
841     * close of the continued element.
842     */
843
844    expat->continueCount++;
845    return NULL;
846  }
847
848  if (expat->elementstartcommand == NULL ||
849      expat->status != TCL_OK) {
850    return NULL;
851  }
852
853  /*
854   * Convert the attribute list into a Tcl key-value paired list.
855   */
856
857  atList = Tcl_NewListObj(0, NULL);
858  for (atPtr = atts; atPtr[0] && atPtr[1]; atPtr += 2) {
859    Tcl_ListObjAppendElement(expat->interp, atList, Tcl_NewStringObj((char *)atPtr[0], strlen(atPtr[0])));
860    Tcl_ListObjAppendElement(expat->interp, atList, Tcl_NewStringObj((char *)atPtr[1], strlen(atPtr[1])));
861  }
862
863  /*
864   * Take a copy of the callback script so that arguments may be appended.
865   */
866
867  cmdPtr = Tcl_DuplicateObj(expat->elementstartcommand);
868  Tcl_IncrRefCount(cmdPtr);
869  Tcl_Preserve((ClientData) expat->interp);
870
871  Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)name, strlen(name)));
872  Tcl_ListObjAppendElement(expat->interp, cmdPtr, atList);
873
874  /*
875   * It would be desirable to be able to terminate parsing
876   * if the return result is TCL_ERROR or TCL_BREAK.
877   */
878#if defined(PRE81)
879  result = Tcl_GlobalEvalObj(expat->interp, cmdPtr);
880#elif defined(PRE82)
881  result = Tcl_EvalObj(expat->interp, cmdPtr, TCL_EVAL_GLOBAL);
882#else
883  result = Tcl_EvalObjEx(expat->interp, cmdPtr, TCL_EVAL_GLOBAL);
884#endif
885
886  Tcl_DecrRefCount(cmdPtr);
887  Tcl_Release((ClientData) expat->interp);
888
889  TclExpatHandlerResult(expat, result);
890
891  return NULL;
892}
893
894/*
895 *----------------------------------------------------------------------------
896 *
897 * TclExpatElementEndHandler --
898 *
899 *	Called by expat for each end tag.
900 *
901 * Results:
902 *	None.
903 *
904 * Side Effects:
905 *	Callback script is invoked.
906 *
907 *----------------------------------------------------------------------------
908 */
909
910static void *
911TclExpatElementEndHandler(userData, name)
912     void *userData;
913     CONST char *name;
914{
915  TclExpatInfo *expat = (TclExpatInfo *) userData;
916  Tcl_Obj *cmdPtr;
917  int result;
918
919  if (expat->status == TCL_CONTINUE) {
920    /*
921     * We're currently skipping elements looking for the
922     * end of the currently open element.
923     */
924
925    if (!--(expat->continueCount)) {
926      expat->status = TCL_OK;
927      return NULL;
928    }
929  }
930
931  if (expat->elementendcommand == NULL ||
932      expat->status != TCL_OK) {
933    return NULL;
934  }
935
936  /*
937   * Take a copy of the callback script so that arguments may be appended.
938   */
939
940  cmdPtr = Tcl_DuplicateObj(expat->elementendcommand);
941  Tcl_IncrRefCount(cmdPtr);
942  Tcl_Preserve((ClientData) expat->interp);
943
944  Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)name, strlen(name)));
945
946  /*
947   * It would be desirable to be able to terminate parsing
948   * if the return result is TCL_ERROR or TCL_BREAK.
949   */
950#if defined(PRE81)
951  result = Tcl_GlobalEvalObj(expat->interp, cmdPtr);
952#elif defined(PRE82)
953  result = Tcl_EvalObj(expat->interp, cmdPtr, TCL_EVAL_GLOBAL);
954#else
955  result = Tcl_EvalObjEx(expat->interp, cmdPtr, TCL_EVAL_GLOBAL);
956#endif
957
958  Tcl_DecrRefCount(cmdPtr);
959  Tcl_Release((ClientData) expat->interp);
960
961  TclExpatHandlerResult(expat, result);
962
963  return NULL;
964}
965
966/*
967 *----------------------------------------------------------------------------
968 *
969 * TclExpatCharacterDataHandler --
970 *
971 *	Called by expat for character data.
972 *
973 * Results:
974 *	None.
975 *
976 * Side Effects:
977 *	Callback script is invoked.
978 *
979 *----------------------------------------------------------------------------
980 */
981
982static void *
983TclExpatCharacterDataHandler(userData, s, len)
984     void *userData;
985     CONST char *s;
986     int len;
987{
988  TclExpatInfo *expat = (TclExpatInfo *) userData;
989  Tcl_Obj *cmdPtr;
990  int result;
991
992  if (expat->datacommand == NULL ||
993      expat->status != TCL_OK) {
994    return NULL;
995  }
996
997  /*
998   * Take a copy of the callback script so that arguments may be appended.
999   */
1000
1001  cmdPtr = Tcl_DuplicateObj(expat->datacommand);
1002  Tcl_IncrRefCount(cmdPtr);
1003  Tcl_Preserve((ClientData) expat->interp);
1004
1005  Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)s, len));
1006
1007  /*
1008   * It would be desirable to be able to terminate parsing
1009   * if the return result is TCL_ERROR or TCL_BREAK.
1010   */
1011#if defined(PRE81)
1012  result = Tcl_GlobalEvalObj(expat->interp, cmdPtr);
1013#elif defined(PRE82)
1014  result = Tcl_EvalObj(expat->interp, cmdPtr, TCL_EVAL_GLOBAL);
1015#else
1016  result = Tcl_EvalObjEx(expat->interp, cmdPtr, TCL_EVAL_GLOBAL);
1017#endif
1018
1019  Tcl_DecrRefCount(cmdPtr);
1020  Tcl_Release((ClientData) expat->interp);
1021
1022  TclExpatHandlerResult(expat, result);
1023
1024  return NULL;
1025}
1026
1027/*
1028 *----------------------------------------------------------------------------
1029 *
1030 * TclExpatProcessingInstructionHandler --
1031 *
1032 *	Called by expat for processing instructions.
1033 *
1034 * Results:
1035 *	None.
1036 *
1037 * Side Effects:
1038 *	Callback script is invoked.
1039 *
1040 *----------------------------------------------------------------------------
1041 */
1042
1043static void *
1044TclExpatProcessingInstructionHandler(userData, target, data)
1045     void *userData;
1046     CONST char *target;
1047     CONST char *data;
1048{
1049  TclExpatInfo *expat = (TclExpatInfo *) userData;
1050  Tcl_Obj *cmdPtr;
1051  int result;
1052
1053  if (expat->picommand == NULL ||
1054      expat->status != TCL_OK) {
1055    return NULL;
1056  }
1057
1058  /*
1059   * Take a copy of the callback script so that arguments may be appended.
1060   */
1061
1062  cmdPtr = Tcl_DuplicateObj(expat->picommand);
1063  Tcl_IncrRefCount(cmdPtr);
1064  Tcl_Preserve((ClientData) expat->interp);
1065
1066  Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)target, strlen(target)));
1067  Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)data, strlen(data)));
1068
1069  /*
1070   * It would be desirable to be able to terminate parsing
1071   * if the return result is TCL_ERROR or TCL_BREAK.
1072   */
1073#if defined(PRE81)
1074  result = Tcl_GlobalEvalObj(expat->interp, cmdPtr);
1075#elif defined(PRE82)
1076  result = Tcl_EvalObj(expat->interp, cmdPtr, TCL_EVAL_GLOBAL);
1077#else
1078  result = Tcl_EvalObjEx(expat->interp, cmdPtr, TCL_EVAL_GLOBAL);
1079#endif
1080
1081  Tcl_DecrRefCount(cmdPtr);
1082  Tcl_Release((ClientData) expat->interp);
1083
1084  TclExpatHandlerResult(expat, result);
1085
1086  return NULL;
1087}
1088
1089/*
1090 *----------------------------------------------------------------------------
1091 *
1092 * TclExpatDefaultHandler --
1093 *
1094 *	Called by expat for processing data which has no other handler.
1095 *
1096 * Results:
1097 *	None.
1098 *
1099 * Side Effects:
1100 *	Callback script is invoked.
1101 *
1102 *----------------------------------------------------------------------------
1103 */
1104
1105static void *
1106TclExpatDefaultHandler(userData, s, len)
1107     void *userData;
1108     CONST char *s;
1109     int len;
1110{
1111  TclExpatInfo *expat = (TclExpatInfo *) userData;
1112  Tcl_Obj *cmdPtr;
1113  int result;
1114
1115  if (expat->defaultcommand == NULL ||
1116      expat->status != TCL_OK) {
1117    return NULL;
1118  }
1119
1120  /*
1121   * Take a copy of the callback script so that arguments may be appended.
1122   */
1123
1124  cmdPtr = Tcl_DuplicateObj(expat->defaultcommand);
1125  Tcl_IncrRefCount(cmdPtr);
1126  Tcl_Preserve((ClientData) expat->interp);
1127
1128  Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)s, len));
1129
1130  /*
1131   * It would be desirable to be able to terminate parsing
1132   * if the return result is TCL_ERROR or TCL_BREAK.
1133   */
1134#if defined(PRE81)
1135  result = Tcl_GlobalEvalObj(expat->interp, cmdPtr);
1136#elif defined(PRE82)
1137  result = Tcl_EvalObj(expat->interp, cmdPtr, TCL_EVAL_GLOBAL);
1138#else
1139  result = Tcl_EvalObjEx(expat->interp, cmdPtr, TCL_EVAL_GLOBAL);
1140#endif
1141
1142  Tcl_DecrRefCount(cmdPtr);
1143  Tcl_Release((ClientData) expat->interp);
1144
1145  TclExpatHandlerResult(expat, result);
1146
1147  return NULL;
1148}
1149
1150/*
1151 *----------------------------------------------------------------------------
1152 *
1153 * TclExpatUnparsedDeclHandler --
1154 *
1155 *	Called by expat for processing an unparsed entity references.
1156 *
1157 * Results:
1158 *	None.
1159 *
1160 * Side Effects:
1161 *	Callback script is invoked.
1162 *
1163 *----------------------------------------------------------------------------
1164 */
1165
1166static void *
1167TclExpatUnparsedDeclHandler(userData, entityname, base, systemId, publicId, notationName)
1168     void *userData;
1169     CONST char *entityname;
1170     CONST char *base;
1171     CONST char *systemId;
1172     CONST char *publicId;
1173     CONST char *notationName;
1174{
1175  TclExpatInfo *expat = (TclExpatInfo *) userData;
1176  Tcl_Obj *cmdPtr;
1177  int result;
1178
1179  if (expat->unparsedcommand == NULL ||
1180      expat->status != TCL_OK) {
1181    return NULL;
1182  }
1183
1184  /*
1185   * Take a copy of the callback script so that arguments may be appended.
1186   */
1187
1188  cmdPtr = Tcl_DuplicateObj(expat->unparsedcommand);
1189  Tcl_IncrRefCount(cmdPtr);
1190  Tcl_Preserve((ClientData) expat->interp);
1191
1192  Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)entityname, strlen(entityname)));
1193  Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)base, strlen(base)));
1194  Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)systemId, strlen(systemId)));
1195  if (publicId == NULL) {
1196    Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewListObj(0, NULL));
1197  } else {
1198    Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)publicId, strlen(publicId)));
1199  }
1200  if (notationName == NULL) {
1201    Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewListObj(0, NULL));
1202  } else {
1203    Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)notationName, strlen(notationName)));
1204  }
1205
1206  /*
1207   * It would be desirable to be able to terminate parsing
1208   * if the return result is TCL_ERROR or TCL_BREAK.
1209   */
1210#if defined(PRE81)
1211  result = Tcl_GlobalEvalObj(expat->interp, cmdPtr);
1212#elif defined(PRE82)
1213  result = Tcl_EvalObj(expat->interp, cmdPtr, TCL_EVAL_GLOBAL);
1214#else
1215  result = Tcl_EvalObjEx(expat->interp, cmdPtr, TCL_EVAL_GLOBAL);
1216#endif
1217
1218  Tcl_DecrRefCount(cmdPtr);
1219  Tcl_Release((ClientData) expat->interp);
1220
1221  TclExpatHandlerResult(expat, result);
1222
1223  return NULL;
1224}
1225
1226/*
1227 *----------------------------------------------------------------------------
1228 *
1229 * TclExpatNotationDeclHandler --
1230 *
1231 *	Called by expat for processing a notation declaration.
1232 *
1233 * Results:
1234 *	None.
1235 *
1236 * Side Effects:
1237 *	Callback script is invoked.
1238 *
1239 *----------------------------------------------------------------------------
1240 */
1241
1242static void *
1243TclExpatNotationDeclHandler(userData, notationName, base, systemId, publicId)
1244     void *userData;
1245     CONST char *notationName;
1246     CONST char *base;
1247     CONST char *systemId;
1248     CONST char *publicId;
1249{
1250  TclExpatInfo *expat = (TclExpatInfo *) userData;
1251  Tcl_Obj *cmdPtr;
1252  int result;
1253
1254  if (expat->notationcommand == NULL ||
1255      expat->status != TCL_OK) {
1256    return NULL;
1257  }
1258
1259  /*
1260   * Take a copy of the callback script so that arguments may be appended.
1261   */
1262
1263  cmdPtr = Tcl_DuplicateObj(expat->notationcommand);
1264  Tcl_IncrRefCount(cmdPtr);
1265  Tcl_Preserve((ClientData) expat->interp);
1266
1267  Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)notationName, strlen(notationName)));
1268  Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)base, strlen(base)));
1269  if (systemId == NULL) {
1270    Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewListObj(0, NULL));
1271  } else {
1272    Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)systemId, strlen(systemId)));
1273  }
1274  if (publicId == NULL) {
1275    Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewListObj(0, NULL));
1276  } else {
1277    Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)publicId, strlen(publicId)));
1278  }
1279
1280  /*
1281   * It would be desirable to be able to terminate parsing
1282   * if the return result is TCL_ERROR or TCL_BREAK.
1283   */
1284#if defined(PRE81)
1285  result = Tcl_GlobalEvalObj(expat->interp, cmdPtr);
1286#elif defined(PRE82)
1287  result = Tcl_EvalObj(expat->interp, cmdPtr, TCL_EVAL_GLOBAL);
1288#else
1289  result = Tcl_EvalObjEx(expat->interp, cmdPtr, TCL_EVAL_GLOBAL);
1290#endif
1291
1292  Tcl_DecrRefCount(cmdPtr);
1293  Tcl_Release((ClientData) expat->interp);
1294
1295  TclExpatHandlerResult(expat, result);
1296
1297  return NULL;
1298}
1299
1300/*
1301 *----------------------------------------------------------------------------
1302 *
1303 * TclExpatUnknownEncodingHandler --
1304 *
1305 *	Called by expat for processing a reference to a character in an
1306 *	unknown encoding.
1307 *
1308 * Results:
1309 *	None.
1310 *
1311 * Side Effects:
1312 *	Callback script is invoked.
1313 *
1314 *----------------------------------------------------------------------------
1315 */
1316
1317static int
1318TclExpatUnknownEncodingHandler(encodingHandlerData, name, info)
1319     void *encodingHandlerData;
1320     CONST char *name;
1321     XML_Encoding *info;
1322{
1323  TclExpatInfo *expat = (TclExpatInfo *) encodingHandlerData;
1324  Tcl_Obj *cmdPtr;
1325  int result;
1326
1327  Tcl_SetResult(expat->interp, "not implemented", NULL);
1328  return 0;
1329
1330  if (expat->unknownencodingcommand == NULL ||
1331      expat->status != TCL_OK) {
1332    return 0;
1333  }
1334
1335  /*
1336   * Take a copy of the callback script so that arguments may be appended.
1337   */
1338
1339  cmdPtr = Tcl_DuplicateObj(expat->unknownencodingcommand);
1340  Tcl_IncrRefCount(cmdPtr);
1341  Tcl_Preserve((ClientData) expat->interp);
1342
1343  /*
1344   * Setup the arguments
1345   */
1346
1347  /*
1348   * It would be desirable to be able to terminate parsing
1349   * if the return result is TCL_ERROR or TCL_BREAK.
1350   */
1351#if defined(PRE81)
1352  result = Tcl_GlobalEvalObj(expat->interp, cmdPtr);
1353#elif defined(PRE82)
1354  result = Tcl_EvalObj(expat->interp, cmdPtr, TCL_EVAL_GLOBAL);
1355#else
1356  result = Tcl_EvalObjEx(expat->interp, cmdPtr, TCL_EVAL_GLOBAL);
1357#endif
1358
1359  Tcl_DecrRefCount(cmdPtr);
1360  Tcl_Release((ClientData) expat->interp);
1361
1362  TclExpatHandlerResult(expat, result);
1363
1364  /*
1365   * NOTE: have to decide whether to return 0 or 1 here,
1366   * since Expat is waiting for an answer.
1367   */
1368  return 0;
1369}
1370
1371/*
1372 *----------------------------------------------------------------------------
1373 *
1374 * TclExpatExternalEntityRefHandler --
1375 *
1376 *	Called by expat for processing external entity references.
1377 *
1378 * Results:
1379 *	None.
1380 *
1381 * Side Effects:
1382 *	Callback script is invoked.
1383 *
1384 *----------------------------------------------------------------------------
1385 */
1386
1387static void *
1388TclExpatExternalEntityRefHandler(parser, openEntityNames, base, systemId, publicId)
1389     XML_Parser parser;
1390     CONST char *openEntityNames;
1391     CONST char *base;
1392     CONST char *systemId;
1393     CONST char *publicId;
1394{
1395  TclExpatInfo *expat = (TclExpatInfo *) XML_GetUserData(parser);
1396  Tcl_Obj *cmdPtr;
1397  int result;
1398
1399  if (expat->externalentitycommand == NULL ||
1400      expat->status != TCL_OK) {
1401    return NULL;
1402  }
1403
1404  /*
1405   * Take a copy of the callback script so that arguments may be appended.
1406   */
1407
1408  cmdPtr = Tcl_DuplicateObj(expat->externalentitycommand);
1409  Tcl_IncrRefCount(cmdPtr);
1410  Tcl_Preserve((ClientData) expat->interp);
1411
1412  Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)openEntityNames, strlen(openEntityNames)));
1413  Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)base, strlen(base)));
1414  Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)systemId, strlen(systemId)));
1415  Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)publicId, strlen(publicId)));
1416
1417  /*
1418   * It would be desirable to be able to terminate parsing
1419   * if the return result is TCL_ERROR or TCL_BREAK.
1420   */
1421#if defined(PRE81)
1422  result = Tcl_GlobalEvalObj(expat->interp, cmdPtr);
1423#elif defined(PRE82)
1424  result = Tcl_EvalObj(expat->interp, cmdPtr, TCL_EVAL_GLOBAL);
1425#else
1426  result = Tcl_EvalObjEx(expat->interp, cmdPtr, TCL_EVAL_GLOBAL);
1427#endif
1428
1429  Tcl_DecrRefCount(cmdPtr);
1430  Tcl_Release((ClientData) expat->interp);
1431
1432  TclExpatHandlerResult(expat, result);
1433
1434  return NULL;
1435}
1436
1437/*
1438 *----------------------------------------------------------------------------
1439 *
1440 * TclExpatDeleteCmd --
1441 *
1442 *	Called when a expat parser is deleted.
1443 *
1444 * Results:
1445 *	None.
1446 *
1447 * Side Effects:
1448 *	Memory structures are freed.
1449 *
1450 *----------------------------------------------------------------------------
1451 */
1452
1453static void
1454TclExpatDeleteCmd(clientData)
1455     ClientData clientData;
1456{
1457  TclExpatInfo *expat = (TclExpatInfo *) clientData;
1458
1459  TclExpatFreeParser(expat);
1460
1461  Tcl_DecrRefCount(expat->name);
1462
1463  if (expat->elementstartcommand) {
1464    Tcl_DecrRefCount(expat->elementstartcommand);
1465  }
1466  if (expat->elementendcommand) {
1467    Tcl_DecrRefCount(expat->elementendcommand);
1468  }
1469  if (expat->datacommand) {
1470    Tcl_DecrRefCount(expat->datacommand);
1471  }
1472  if (expat->picommand) {
1473    Tcl_DecrRefCount(expat->picommand);
1474  }
1475  if (expat->externalentitycommand) {
1476    Tcl_DecrRefCount(expat->externalentitycommand);
1477  }
1478}
1479