Further improvements in expat.

* src/expat.sci (xml-make-parser): Fix definition.
(xml-error-descr): New syntax.
* src/gamma-expat.c (xml-expat-version-string)
(xml-expat-version)
(xml-default-current)
(xml-error-string)
(xml-current-line-number)
(xml-current-byte-count): New functions.
(xml-primitive-make-parser): Include context data int the
error information.
(generic_xml_decl_handler): Account for possible NULLs.

* examples/xml-check.scm: New file.
* examples/xml-struct.scm: New file.
* examples/xmlck.scm: New file.
* examples/expat-info.scm: New file.
* examples/Makefile.am, examples/README: Update.

* doc/expat.texi: Update.

3 files changed, 151 insertions, 17 deletions

diff --git a/src/expat.sci b/src/expat.sci
index 258e387..1dcabc6 100644
--- a/src/expat.sci
+++ b/src/expat.sci
@@ -18,7 +18,14 @@ changequote([,])dnl
 
 (define-module (gamma expat)
   :use-module (ice-9 rdelim)
-  :use-module (srfi srfi-1))
+  :use-module (srfi srfi-1)
+  :export (xml-make-parser
+	   xml-parse-more
+	   xml-parse
+	   xml-set-handler)
+  :export-syntax (xml-error-descr))
+
+(use-syntax (ice-9 syncase))
 
 (let ((lib-path "LIBDIR/"))
   (load-extension (string-append
@@ -26,7 +33,7 @@ changequote([,])dnl
 
 include(BUILDDIR/gamma-expat.inc)
 
-(define-public (xml-make-parser . rest)
+(define (xml-make-parser . rest)
   (if (null? rest)
       (xml-primitive-make-parser)
       (letrec ((parser-setup (lambda (setup handler-args)
@@ -38,26 +45,28 @@ include(BUILDDIR/gamma-expat.inc)
 	(if (string? (car rest))
 	    (let ((encoding (car rest))
 		  (rest (cdr rest)))
-	      (if (char? (car rest))
-		  (parser-setup (list encoding (car rest))
-				(cdr rest))
-		  (parser-setup (list encoding) rest)))
+	      (cond
+	       ((null? rest)
+		(parser-setup (list encoding) rest))
+	       ((char? (car rest))
+		(parser-setup (list encoding (car rest))
+			      (cdr rest)))))
 	    (parser-setup '() rest)))))
 	       
-(define-public (xml-parse-more parser input)
+(define (xml-parse-more parser input)
   (cond
    ((eof-object? input)
     (xml-primitive-parse parser "" #t))
    (else
     (xml-primitive-parse parser input #f))))
 
-(define-public (xml-parse parser)
+(define (xml-parse parser)
   (let loop ((line (read-line)))
     (xml-parse-more parser line)
     (if (not (eof-object? line))
 	(loop (read-line)))))
 
-(define-public (xml-set-handler parser . rest)
+(define (xml-set-handler parser . rest)
   (if (odd? (length rest))
       (scm-error 'wrong-number-of-args
 		 "xml-set-handler"
@@ -82,6 +91,20 @@ include(BUILDDIR/gamma-expat.inc)
 	  prev)))
       '()
       rest))))
-		 
+
+(define-syntax xml-error-descr
+  (syntax-rules ()
+    ((xml-error-descr ctx #:error-code)
+     (list-ref ctx 0))
+    ((xml-error-descr ctx #:line)
+     (list-ref ctx 1))
+    ((xml-error-descr ctx #:column)
+     (list-ref ctx 2))
+    ((xml-error-descr ctx #:context)
+     (list-ref ctx 3))
+    ((xml-error-descr ctx #:error-offset)
+     (list-ref ctx 4))
+    ((xml-error-descr ctx #:has-context?)
+     (= (length ctx) 5))))
 
 ;;;; End of expat.scm
diff --git a/src/gamma-expat.c b/src/gamma-expat.c
index c606273..84a2a9d 100644
--- a/src/gamma-expat.c
+++ b/src/gamma-expat.c
@@ -110,6 +110,23 @@ make_user_data ()
 
 SCM_GLOBAL_SYMBOL(gamma_xml_error, "gamma-xml-error");
 
+SCM_DEFINE(scm_xml_expat_version_string, "xml-expat-version-string", 0, 0, 0,
+	   (),
+	   "Return the version of the expat library as a string.")
+{
+	return scm_from_locale_string(XML_ExpatVersion());
+}
+
+SCM_DEFINE(scm_xml_expat_version, "xml-expat-version", 0, 0, 0,
+	   (),
+	   "Return expat library version information.")
+{
+	XML_Expat_Version vinfo = XML_ExpatVersionInfo();
+	return scm_list_3(scm_from_int(vinfo.major),
+			  scm_from_int(vinfo.minor),
+			  scm_from_int(vinfo.micro));
+}
+
 SCM_DEFINE(scm_xml_primitive_make_parser, "xml-primitive-make-parser", 0, 2, 0,
 	   (SCM enc, SCM sep),
 	   "Return a new parser. If @var{enc} is given, it must be one of:"
@@ -191,16 +208,107 @@ SCM_DEFINE(scm_xml_primitive_parse, "xml-primitive-parse", 3, 0, 0,
 	free(str);
 	if (status == XML_STATUS_ERROR) {
 		enum XML_Error error = XML_GetErrorCode(gp->parser);
+		int line = XML_GetCurrentLineNumber(gp->parser);
+		int column = XML_GetCurrentColumnNumber(gp->parser);
+		int offset, size;
+		const char *bufptr;
+
+		bufptr = XML_GetInputContext(gp->parser, &offset, &size);
 		scm_error(gamma_xml_error, FUNC_NAME,
-			  "~A",
-			  scm_list_1(scm_from_locale_string(XML_ErrorString(error))),
-			  scm_list_2(scm_from_int(error), input));
+			  "~A near line ~A",
+			  scm_list_2(scm_from_locale_string(XML_ErrorString(error)),
+				     scm_from_int(line)),
+			  bufptr ?
+			    scm_list_5(scm_from_int(error),
+				       scm_from_int(line),
+				       scm_from_int(column),
+				       scm_from_locale_stringn(bufptr, size),
+				       scm_from_int(offset)) :
+			    scm_list_3(scm_from_int(error),
+				       scm_from_int(line),
+				       scm_from_int(column)));
 	}
 	return SCM_UNSPECIFIED;
 		
 }
 #undef FUNC_NAME
 
+SCM_DEFINE(scm_xml_default_current, "xml-default-current", 1, 0, 0,
+	   (SCM parser),
+	   "Pass current markup to the default handler.")
+#define FUNC_NAME s_scm_xml_default_current
+{
+	struct gamma_xml_parser *gp;
+	
+	SCM_ASSERT(gamma_scm_is_xml_parser(parser), parser,
+		   SCM_ARG1, FUNC_NAME);
+	gp = GAMMA_XML_PARSER_PTR(parser);
+	XML_DefaultCurrent(gp->parser);
+	return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE(scm_xml_error_string, "xml-error-string", 1, 0, 0,
+	   (SCM code),
+	   "Return a textual description corresponding to the error @code{code}.")
+#define FUNC_NAME s_scm_xml_error_string
+{
+	const char *p;
+	SCM_ASSERT(scm_is_integer(code), code, SCM_ARG1, FUNC_NAME);
+	p = XML_ErrorString(scm_to_int(code));
+	return scm_from_locale_string(p);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE(scm_xml_current_line_number, "xml-current-line-number", 1, 0, 0,
+	   (SCM parser),
+	   "Return the current line number in the input stream. "
+	   "The first line is reported as 1.")
+#define FUNC_NAME s_scm_xml_current_line_number
+{
+	struct gamma_xml_parser *gp;
+	
+	SCM_ASSERT(gamma_scm_is_xml_parser(parser), parser,
+		   SCM_ARG1, FUNC_NAME);
+	gp = GAMMA_XML_PARSER_PTR(parser);
+	return scm_from_int(XML_GetCurrentLineNumber(gp->parser));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE(scm_xml_current_column_number, "xml-current-column-number", 1, 0, 0,
+	   (SCM parser),
+	   "Return the current column number in the input stream. "
+	   "The first column is reported as 0.")
+#define FUNC_NAME s_scm_xml_current_column_number
+{
+	struct gamma_xml_parser *gp;
+	
+	SCM_ASSERT(gamma_scm_is_xml_parser(parser), parser,
+		   SCM_ARG1, FUNC_NAME);
+	gp = GAMMA_XML_PARSER_PTR(parser);
+	return scm_from_int(XML_GetCurrentColumnNumber(gp->parser));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE(scm_xml_current_byte_count, "xml-current-byte-count", 1, 0, 0,
+	   (SCM parser),
+	   "Return the number of bytes in the current event. "
+	   "Returns 0 if the event is inside a reference to an internal "
+	   "entity and for the end-tag event for empty element tags "
+	   "(the later can be used to distinguish empty-element tags "
+	   "from empty elements using separate start and end tags).")
+#define FUNC_NAME s_scm_xml_current_byte_count
+{
+	struct gamma_xml_parser *gp;
+	
+	SCM_ASSERT(gamma_scm_is_xml_parser(parser), parser,
+		   SCM_ARG1, FUNC_NAME);
+	gp = GAMMA_XML_PARSER_PTR(parser);
+	return scm_from_int(XML_GetCurrentByteCount(gp->parser));
+}
+#undef FUNC_NAME
+
+
 
 static SCM
 attrs_to_scm(const XML_Char **attr)
@@ -543,11 +651,14 @@ generic_xml_decl_handler(void *user_data,
 	struct gamma_expat_user_data *udata = user_data;
 
 	xdata.proc = udata->handler[xml_decl_handler];
-	xdata.arg = scm_list_3(scm_from_locale_string(version),
-			       scm_from_locale_string(encoding),
+	xdata.arg = scm_list_3(version ?
+			       scm_from_locale_string(version) : SCM_BOOL_F,
+			       encoding ?
+			       scm_from_locale_string(encoding) : SCM_BOOL_F,
 			       standalone == -1 ?
 			         SCM_UNSPECIFIED :
-			         (standalone ? SCM_BOOL_T : SCM_BOOL_F));
+			       scm_list_1 (standalone ?
+					   SCM_BOOL_T : SCM_BOOL_F));
 	gamma_safe_exec(gamma_apply_catch_body, &xdata, NULL);
 }
 
diff --git a/src/gamma-expat.h b/src/gamma-expat.h
index 621eadf..2376e4a 100644
--- a/src/gamma-expat.h
+++ b/src/gamma-expat.h
@@ -47,7 +47,7 @@ enum gamma_expat_handler {
 	element_decl_handler,
 	attlist_decl_handler,
 	entity_decl_handler,
-	unparsed_entity_decl_handler,
+	unparsed_entity_decl_handler,/* Deprecated */
 	notation_decl_handler,
 	not_standalone_handler,