;;;; parser.lisp --- FFI definitions for libxml-clisp

;;; Copyright (C) 2009 N. Raghavendra.  All rights reserved.
;;; 
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;; 1. Redistributions of source code must retain the above copyright
;;;    notice, this list of conditions and the following disclaimer.
;;; 2. Redistributions in binary form must reproduce the above
;;;    copyright notice, this list of conditions and the following
;;;    disclaimer in the documentation and/or other materials provided
;;;    with the distribution.
;;; 
;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
;;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

;;; N. Raghavendra <raghu@retrotexts.net>
;;; 
;;; Created: 2009-07-08
;;; 
;;; $Hg$

(in-package "NET.RETROTEXTS.LIBXML-CLISP")



(defun cleanup-parser ()
  "Clean up the memory allocated by libxml2.
Tries to reclaim all related global memory allocated for libxml
processing.  Does not deallocate any document-related memory.  This
function should be called only when the process has finished using the
libxml2 library, and all documents built with it."
  ($xml-cleanup-parser))

(defvar *parser-options*
  (loop for i from 0 to 16
     collect (enum-from-value '$xml-parser-option (ash 1 i)))
  "List of XML parser options.")

(defun combine-options (options)
  "Return an integer denoting the union of all the parser options OPTIONS.
OPTIONS must be symbol or a list of symbols from `*parser-options*'."
  (flet ((option-value (option)
           (enum-to-value '$xml-parser-option option)))
    (if (listp options)
      (loop for result = 0 then (logior result (option-value option))
         for option in options
         finally (return result))
      (option-value options))))

(defun parse-file (filename &key encoding options)
  "Return the Document obtained by parsing FILENAME.
FILENAME must be a pathname designator for an XML file.  If ENCODING
is non-nil, it is assumed to be the encoding of FILENAME.  If ENCODING
is nil, then the encoding of FILENAME is taken from the XML
declaration, if any, in FILENAME.  If the encoding of FILENAME cannot
be obtained from its XML declaration, then the encoding of FILENAME is
assumed to be UTF-8.  OPTIONS must be symbol or a list of symbols from
`*parser-options*'."
  (let* ((encoding-name (encoding-name encoding))
         (doc-address ($xml-read-file (namestring filename) encoding-name
                                      (combine-options options))))
    (if doc-address
      (make-document doc-address)
      (restart-case (error 'file-parse-error
                           :pathname (pathname filename))
        (parse-new-file (new-filename)
          :report "Parse another file."
          :interactive read-new-value
          (parse-file new-filename :encoding encoding :options options))))))

(defmacro with-xml-file ((document filename &key encoding options) &body body)
  "Evaluate BODY using the Document parsed from FILENAME.
FILENAME must be a pathname designator for an XML file.  During the
evaluation, the variable DOCUMENT and the special variable *DOCUMENT*
are both bound to the Document parsed from FILENAME.  That Document
has dynamic extent, which ends when the form is exited.

If ENCODING is non-nil, it is assumed to be the encoding of FILENAME.
If ENCODING is nil, then the encoding of FILENAME is taken from the
XML declaration, if any, in FILENAME.  If the encoding of FILENAME
cannot be obtained from its XML declaration, then the encoding of
FILENAME is assumed to be UTF-8.  OPTIONS must be symbol or a list of
symbols from `*parser-options*'."
  (let ((created (gensym)))
    `(let* ((,created nil)
            (,document (parse-file ,filename :encoding ,encoding
                                   :options ,options))
            (*document* ,document))
       (unwind-protect (progn (setf ,created t)
                              (init-library)
                              ,@body)
         (when ,created
           (free-item ,document)
           (cleanup-parser))))))

(defun initialize-catalog ()
  "Initialize XML catalogs."
  ($xml-initialize-catalog))

(defun load-catalog (filename)
  "Load the XML catalog FILENAME.
FILENAME must be pathname designator."
  (let ((status ($xml-load-catalog (namestring filename))))
    (or (zerop status)
        (error "Unable to load catalog ~A." filename))))



;;; Local Variables:
;;; mode: lisp
;;; comment-column: 32
;;; End:

;;;; parser.lisp ends here