/foreign/parser.lisp

  1;;;; parser.lisp --- FFI definitions for libxml-clisp
  2
  3;;; Copyright (C) 2009 N. Raghavendra.  All rights reserved.
  4;;; 
  5;;; Redistribution and use in source and binary forms, with or without
  6;;; modification, are permitted provided that the following conditions
  7;;; are met:
  8;;; 1. Redistributions of source code must retain the above copyright
  9;;;    notice, this list of conditions and the following disclaimer.
 10;;; 2. Redistributions in binary form must reproduce the above
 11;;;    copyright notice, this list of conditions and the following
 12;;;    disclaimer in the documentation and/or other materials provided
 13;;;    with the distribution.
 14;;; 
 15;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
 16;;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
 17;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 18;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
 19;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
 20;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
 21;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
 22;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
 23;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
 24;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
 25;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 26
 27;;; N. Raghavendra <raghu@retrotexts.net>
 28;;; 
 29;;; Created: 2009-07-08
 30;;; 
 31;;; $Hg$
 32
 33(in-package "NET.RETROTEXTS.LIBXML-CLISP")
 34
 35
 36
 37(defun cleanup-parser ()
 38  "Clean up the memory allocated by libxml2.
 39Tries to reclaim all related global memory allocated for libxml
 40processing.  Does not deallocate any document-related memory.  This
 41function should be called only when the process has finished using the
 42libxml2 library, and all documents built with it."
 43  ($xml-cleanup-parser))
 44
 45(defvar *parser-options*
 46  (loop for i from 0 to 16
 47     collect (enum-from-value '$xml-parser-option (ash 1 i)))
 48  "List of XML parser options.")
 49
 50(defun combine-options (options)
 51  "Return an integer denoting the union of all the parser options OPTIONS.
 52OPTIONS must be symbol or a list of symbols from `*parser-options*'."
 53  (flet ((option-value (option)
 54           (enum-to-value '$xml-parser-option option)))
 55    (if (listp options)
 56      (loop for result = 0 then (logior result (option-value option))
 57         for option in options
 58         finally (return result))
 59      (option-value options))))
 60
 61(defun parse-file (filename &key encoding options)
 62  "Return the Document obtained by parsing FILENAME.
 63FILENAME must be a pathname designator for an XML file.  If ENCODING
 64is non-nil, it is assumed to be the encoding of FILENAME.  If ENCODING
 65is nil, then the encoding of FILENAME is taken from the XML
 66declaration, if any, in FILENAME.  If the encoding of FILENAME cannot
 67be obtained from its XML declaration, then the encoding of FILENAME is
 68assumed to be UTF-8.  OPTIONS must be symbol or a list of symbols from
 69`*parser-options*'."
 70  (let* ((encoding-name (encoding-name encoding))
 71         (doc-address ($xml-read-file (namestring filename) encoding-name
 72                                      (combine-options options))))
 73    (if doc-address
 74      (make-document doc-address)
 75      (restart-case (error 'file-parse-error
 76                           :pathname (pathname filename))
 77        (parse-new-file (new-filename)
 78          :report "Parse another file."
 79          :interactive read-new-value
 80          (parse-file new-filename :encoding encoding :options options))))))
 81
 82(defmacro with-xml-file ((document filename &key encoding options) &body body)
 83  "Evaluate BODY using the Document parsed from FILENAME.
 84FILENAME must be a pathname designator for an XML file.  During the
 85evaluation, the variable DOCUMENT and the special variable *DOCUMENT*
 86are both bound to the Document parsed from FILENAME.  That Document
 87has dynamic extent, which ends when the form is exited.
 88
 89If ENCODING is non-nil, it is assumed to be the encoding of FILENAME.
 90If ENCODING is nil, then the encoding of FILENAME is taken from the
 91XML declaration, if any, in FILENAME.  If the encoding of FILENAME
 92cannot be obtained from its XML declaration, then the encoding of
 93FILENAME is assumed to be UTF-8.  OPTIONS must be symbol or a list of
 94symbols from `*parser-options*'."
 95  (let ((created (gensym)))
 96    `(let* ((,created nil)
 97            (,document (parse-file ,filename :encoding ,encoding
 98                                   :options ,options))
 99            (*document* ,document))
100       (unwind-protect (progn (setf ,created t)
101                              (init-library)
102                              ,@body)
103         (when ,created
104           (free-item ,document)
105           (cleanup-parser))))))
106
107(defun initialize-catalog ()
108  "Initialize XML catalogs."
109  ($xml-initialize-catalog))
110
111(defun load-catalog (filename)
112  "Load the XML catalog FILENAME.
113FILENAME must be pathname designator."
114  (let ((status ($xml-load-catalog (namestring filename))))
115    (or (zerop status)
116        (error "Unable to load catalog ~A." filename))))
117
118
119
120;;; Local Variables:
121;;; mode: lisp
122;;; comment-column: 32
123;;; End:
124
125;;;; parser.lisp ends here