(let ((%name (gensym)))
`(let ((,%name ,name))
(with-open-file (stream ,%name :direction :output
- :if-exists :supersede)
- (docbook-stream stream ,tree))
+ :if-exists :supersede)
+ (docbook-stream stream ,tree))
(values))))
-#+allegro
+#+allegro
(eval-when (:compile-toplevel :load-toplevel :execute)
(require 'pxml)
(require 'uri))
(declare (ignore token public))
(cond
((and (net.uri:uri-scheme var)
- (string= "http" (net.uri:uri-scheme var)))
+ (string= "http" (net.uri:uri-scheme var)))
nil)
(t
(let ((path (net.uri:uri-path var)))
(if (probe-file path)
- (ignore-errors (open path))
- (make-string-input-stream
- (let ((*print-circle* nil))
- (format nil "<!ENTITY ~A '~A'>" path path))))))))
-
+ (ignore-errors (open path))
+ (make-string-input-stream
+ (let ((*print-circle* nil))
+ (format nil "<!ENTITY ~A '~A'>" path path))))))))
+
#+allegro
(defun xml-file->sexp-file (file &key (preprocess nil))
(let* ((path (etypecase file
- (string (parse-namestring file))
- (pathname file)))
- (new-path (make-pathname :defaults path
- :type "sexp"))
- raw-sexp)
-
+ (string (parse-namestring file))
+ (pathname file)))
+ (new-path (make-pathname :defaults path
+ :type "sexp"))
+ raw-sexp)
+
(if preprocess
- (multiple-value-bind (xml error status)
- (kmrcl:command-output (format nil
- "sh -c \"export XML_CATALOG_FILES='~A'; cd ~A; xsltproc --xinclude pprint.xsl ~A\""
- "catalog-debian.xml"
- (namestring (make-pathname :defaults (if (pathname-directory path)
- path
- *default-pathname-defaults*)
- :name nil :type nil))
- (namestring path)))
- (unless (and (zerop status) (or (null error) (zerop (length error))))
- (error "Unable to preprocess XML file ~A, status ~D.~%Error: ~A"
- path status error))
- (setq raw-sexp (net.xml.parser:parse-xml
- (apply #'concatenate 'string xml)
- :content-only nil)))
+ (multiple-value-bind (xml error status)
+ (kmrcl:command-output (format nil
+ "sh -c \"export XML_CATALOG_FILES='~A'; cd ~A; xsltproc --xinclude pprint.xsl ~A\""
+ "catalog-debian.xml"
+ (namestring (make-pathname :defaults (if (pathname-directory path)
+ path
+ *default-pathname-defaults*)
+ :name nil :type nil))
+ (namestring path)))
+ (unless (and (zerop status) (or (null error) (zerop (length error))))
+ (error "Unable to preprocess XML file ~A, status ~D.~%Error: ~A"
+ path status error))
+ (setq raw-sexp (net.xml.parser:parse-xml
+ (apply #'concatenate 'string xml)
+ :content-only nil)))
(with-open-file (input path :direction :input)
- (setq raw-sexp (net.xml.parser:parse-xml input :external-callback #'entity-callback))))
+ (setq raw-sexp (net.xml.parser:parse-xml input :external-callback #'entity-callback))))
(with-open-file (output new-path :direction :output
- :if-exists :supersede)
+ :if-exists :supersede)
(let ((filtered (kmrcl:remove-from-tree-if #'is-whitespace-string
- raw-sexp
- #'atom-processor)))
- (write filtered :stream output :pretty t))))
+ raw-sexp
+ #'atom-processor)))
+ (write filtered :stream output :pretty t))))
(values))