- cxml-devel - mailman3.common-lisp.net

[cxml-devel] Feed Blaster puts your ad right to the screens of millions in 15 Minutes !
by Feed＠common-lisp.net 21 Aug '07

21 Aug '07

1 0

[cxml-devel] "How would you like to have your ad on 2 Million Websites ?"
by BlogBlaster＠common-lisp.net 19 Aug '07

19 Aug '07

1 0

[cxml-devel] No Matter what you are selling - Hit-Booster will send targeted visitors to your website!
by Hit-Booster＠common-lisp.net 18 Aug '07

18 Aug '07

New Break-through Automation Technology WILL Pull in hordes of Within 15 minutes you will have your own website traffic generator that will bring in an ever increasing amount of hits to your websites! Automatically This software is perfect for bringing real traffic to your site... even if... it's an affiliate link where you have no control over the website content! Using my automated program I have developed, just insert your url... ...choose a category... ...have HIT-BOOSTER send thousands of targeted visitors to your site. Let me tell you what Hit-Booster can do for you ...Hit-Booster will start sending hits to your website instantly at $0 cost to you! ...No matter what you are selling or offering - HIT BOOSTER will pull in hordes of potential customers to your website or affiliate website! ...sets this up completely for you on Auto-Pilot! ...Use it for all of your websites - there is no limit . ...Receive my personal support and email address with your purchase so I can help you to succeed! ...your web site will quickly achieve Ultra High Link Popularity on the Major Search Engines ...you'll get 1000's of Highly Targeted visitors to your web site or affiliate web site overnight ...many are getting more Customers and Sales than they can handle For Full Details please download the attached .html file Unsubscribe Please read the attached .txt file

1 0

[cxml-devel] No Matter what you are selling - Hit-Booster will send targeted visitors to your website!
by Hit-Booster＠common-lisp.net 18 Aug '07

18 Aug '07

New Break-through Automation Technology WILL Pull in hordes of Within 15 minutes you will have your own website traffic generator that will bring in an ever increasing amount of hits to your websites! Automatically This software is perfect for bringing real traffic to your site... even if... it's an affiliate link where you have no control over the website content! Using my automated program I have developed, just insert your url... ...choose a category... ...have HIT-BOOSTER send thousands of targeted visitors to your site. Let me tell you what Hit-Booster can do for you ...Hit-Booster will start sending hits to your website instantly at $0 cost to you! ...No matter what you are selling or offering - HIT BOOSTER will pull in hordes of potential customers to your website or affiliate website! ...sets this up completely for you on Auto-Pilot! ...Use it for all of your websites - there is no limit . ...Receive my personal support and email address with your purchase so I can help you to succeed! ...your web site will quickly achieve Ultra High Link Popularity on the Major Search Engines ...you'll get 1000's of Highly Targeted visitors to your web site or affiliate web site overnight ...many are getting more Customers and Sales than they can handle For Full Details please download the attached .html file Unsubscribe Please read the attached .txt file

1 0

[cxml-devel] How would you like an extra $500 - $1000 a week with 15 minutes of your time ?
by Work＠common-lisp.net 17 Aug '07

17 Aug '07

1 0

[cxml-devel] New release: cxml-stp
by David Lichteblau 05 Aug '07

05 Aug '07

Hi, the first release of cxml-stp is available for download at http://www.lichteblau.com/cxml-stp/ STP is a new data structure for well-formed XML documents, inspired by Java's XOM, but designed for Common Lisp as an alternative to DOM. cxml-stp is available under an X11-style license. d.

1 0

[cxml-devel] New release: cxml
by David Lichteblau 05 Aug '07

05 Aug '07

Hi, a new release tarball is available for download. This is a bugfix release including these changes: * Various DTD serialization fixes * UTF-8 fix, thanks to Francis Leboutte d.

1 0

[cxml-devel] suggestion and bug report
by Francis Leboutte 22 Jul '07

22 Jul '07

Hello, Below, a small suggestion and a bug report. Regards, Francis 1. In rod-to-utf8-string, element-type should be base-char, which is used for strings of characters having 8-bit encoding in some implementations (would take less memory in these implementations - LW, ACL and others maybe) (defun rod-to-utf8-string (rod) (let ((out (make-buffer :element-type 'character))) (runes-to-utf8/adjustable-string out rod (length rod)) out)) 2. While experimenting with the functions cxml:utf8-string-to-rod and cxml:rod-to-utf8-string, I found that the string returned by cxml:utf8-string-to-rod doesn't include the last input character when this character is not an ascii character. On LWw 5.0.2, an example with the micro sign: USER 8 > (cxml:rod-to-utf8-string (format nil "abc~C" (code-char #x03BC))) "abcÎ¼" USER 9 > (cxml:utf8-string-to-rod (cxml:rod-to-utf8-string (format nil "abc~C." (code-char #x03BC)))) "abcµ." USER 10 > (cxml:utf8-string-to-rod (cxml:rod-to-utf8-string (format nil "abc~C" (code-char #x03BC)))) "abc" The problem seems to come from the method (defmethod runes-encoding:decode-sequence ((encoding (eql :utf-8)) ...) ...) where the tests (< (%+ rptr ...) in-end) should probably be (<= (%+ rptr ...) in-end) instead. -- Francis Leboutte Algorithme, Rue de la Charrette 141, 4130 Tilff (Esneux), Belgique Service en informatique f.leboutte(a)algo.be www.algo.be +32-(0)4.388.3919

2 1

[cxml-devel] New release: cxml
by David Lichteblau 07 Jul '07

07 Jul '07

Hi, a new release tarball is available for download. The new release fixes the build on non-Unicode lisps and on OpenMCL, which were broken in the previous tarball. In addition, the following changes are part of the release: * New function cxml:parse. * Serialization no longer defaults to canonical form. * Fixed octet array argument to make-source. * XMLS compatibility is not bug-for-bug-compatible with XMLS any more. There is now a mode using pairs of local name and namespace URI, and a second mode using qualified names only. The old behaviour using pairs of prefix and local names was removed. (Thanks to Douglas Crosher.) * SCL support (thanks to Douglas Crosher). Includes support for implementations where URIs are valid namestrings, and a mode where normal streams are used instead of xstreams and ystreams (albeit both SCL-specific at this point). * new convenience serialization function cxml:doctype. Various DTD serialization fixes.

1 0

[cxml-devel] ASD files for cxml don't work for openmcl
by David Lichteblau 06 Jul '07

06 Jul '07

Hi, (sorry for starting a new thread, I don't have your original mail right now) Quoting Sunil Mishra (smishra at sfmishras.com) > I've recently updated to the latest cxml, to the CVS HEAD, and am having > trouble with openmcl64. All in all, it looks like rune-is-integer has > been poorly tested. I've had trouble with the asd files, compiling the > tester, and with parsing XML. I've included lots of detail below. I am > happy to help debug cxml, but I don't understand the system and will > need guidance. I have just checked in fixes for the two problems you reported (build broken without Unicode, and xml:base handling broken without Unicode). In addition, OpenMCL actually supports Unicode now, but cxml failed to detect that. (Also fixed.) Please test! Make sure to clean out fasls before doing so. If it works for you, I will make a new release. Thanks, David

2 1

[cxml-devel] ASD files for cxml don't work for openmcl
by Sunil Mishra 05 Jul '07

05 Jul '07

-----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 Hi, I've recently updated to the latest cxml, to the CVS HEAD, and am having trouble with openmcl64. All in all, it looks like rune-is-integer has been poorly tested. I've had trouble with the asd files, compiling the tester, and with parsing XML. I've included lots of detail below. I am happy to help debug cxml, but I don't understand the system and will need guidance. I'm finding that the asd files for cxml don't work as written for #+rune-is-integer. Consider what happens in the script below: ? (asdf:operate 'asdf:load-op 'cxml) ; loading system definition from /usr/local/asdf-install/site-systems/cxml.asd into #<Package "ASDF0"> ; registering #<SYSTEM :CXML-XML #x300040E0D25D> as CXML-XML ; registering #<SYSTEM :CXML-DOM #x300040E4A05D> as CXML-DOM ; registering #<SYSTEM :CXML-KLACKS #x300040E78FAD> as CXML-KLACKS ; registering #<SYSTEM :CXML-TEST #x300040E67EAD> as CXML-TEST ; registering #<SYSTEM :CXML #x300040E9841D> as CXML ; loading system definition from /usr/local/asdf-install/site-systems/trivial-gray-streams.asd into #<Package "ASDF0"> ; registering #<SYSTEM :TRIVIAL-GRAY-STREAMS #x300040E8191D> as TRIVIAL-GRAY-STREAMS ; loading system definition from /usr/local/asdf-install/site-systems/puri.asd into #<Package "ASDF0"> ; registering #<SYSTEM PURI #x300040EAA8FD> as PURI ; registering #<SYSTEM PURI-TESTS #x300040ED2FAD> as PURI-TESTS ; loading system definition from /usr/local/asdf-install/site-systems/runes.asd into #<Package "ASDF0"> ;;; Checking for wide character support... no, reverting to octet strings. ;;; Building Closure with (UNSIGNED-BYTE 16) RUNES ; registering #<SYSTEM :RUNES #x300040F11DFD> as RUNES > Error: There is no package named "UTF8-DOM" . > While executing: CCL::%FASL-NVPACKAGE, in process listener(1). > Type :GO to continue, :POP to abort, :R for a list of available restarts. > If continued: Retry finding package with name "UTF8-DOM". > Type :? for other options. 1 > :pop ;;; *** At this point, go off to the shell and force reloading cxml.asd $ touch cxml.asd ;;; *** Now back to lisp... ? (asdf:operate 'asdf:load-op 'cxml) ; loading system definition from /usr/local/asdf-install/site-systems/cxml.asd into #<Package "ASDF0"> NIL ? I think what's happening here is that the feature rune-is-integer is not yet defined when cxml.asd is loaded. So the system definition cxml-dom is defined incorrectly. Only *after* cxml.asd is loaded, we load rune.asd, which is where rune-is-integer is defined. When I touch cxml.asd, it is reloaded and things work fine as rune-is-integer is now correctly defined. Splitting rune.asd and cxml.asd is currently clearly not working. I think you will be able to replicate this problem if you define cxml-dom as follows: (asdf:defsystem :cxml-dom :default-component-class closure-source-file :pathname (merge-pathnames "dom/" (make-pathname :name nil :type nil :defaults *load-truename*)) :components ((:file "package") #+rune-is-character (:file rune-impl :pathname "dom-impl" :depends-on ("package")) #+rune-is-character (:file rune-builder :pathname "dom-builder" :depends-on (rune-impl)) #+rune-is-integer (utf8dom-file utf8-impl :pathname "dom-impl" :depends-on ("package")) #+rune-is-integer (utf8dom-file utf8-builder :pathname "dom-builder" :depends-on (utf8-impl)) (:file "dom-sax" :depends-on ("package"))) :depends-on (:cxml-xml)) Concatenating the files runes.asd followed by cxml.asd, and using the result as cxml.asd, allows cxml to load. However, even parsing an XML document currently is non-functional. All this used to work fine in the previous build of cxml. In addition, the files test/domtest.lisp and test/xmlconf.lisp have repeated references to the package rune-dom, which does not work for rune-is-integer. Parsing an XML document breaks in the function compute-base. When #+rune-is-integer, sax:find-attribute is called with a string name of an attribute while document data is stored as an integer array. Here's a part of the stack trace: 0: (STRING) 1: (CCL::STRING-START-END "xml:base" #(120 109 108 110 115) 0) 2: (STRING= "xml:base" #(120 109 108 110 115)) 3: (MEMBER "xml:base" '(#S(SAX::ATTRIBUTE :NAMESPACE-URI #(104 116 116 112 58 47 47 119 119 119 ...) :LOCAL-NAME NIL :QNAME #(120 109 108 110 115) :VALUE #(104 116 116 112 58 47 47 119 119 119 ...) :SPECIFIED-P ...))) 4: (CCL::FIND-POSITIONAL-TEST-KEY "xml:base" #<Compiled-function SAX::%ROD= #x30004143E34F> #<Anonymous Function #x30004143F5AF> 'NIL) 5: (CXML::COMPUTE-BASE) Locals: CXML::ATTRS = (#S(SAX::ATTRIBUTE :NAMESPACE-URI #(104 116 116 112 58 47 47 119 119 119 ...) :LOCAL-NAME NIL :QNAME #(120 109 108 110 115) :VALUE #(104 116 116 112 58 47 47 119 119 119 ...) :SPECIFIED-P ...)) 6: (CXML::P/SZTAG #S(CXML::ZSTREAM :TOKEN-CATEGORY NIL :TOKEN-SEMANTIC NIL :INPUT-STACK (#<RUNES:XSTREAM #<error printing CXML::STREAM-NAME #x3000429E545D>>))) Locals: CXML::INPUT = #S(CXML::ZSTREAM :TOKEN-CATEGORY NIL :TOKEN-SEMANTIC NIL :INPUT-STACK (#<RUNES:XSTREAM #<error printing CXML::STREAM-NAME #x3000429C8E4D>>)) CXML::CAT = :STAG CXML::SEM = (#(104 116 109 108) (#(120 109 108 110 115) . #(104 116 116 112 58 47 47 119 119 119 ...))) #:ARGS3257 = #<DESTRUCTURE-STATE #x4216E6D> CXML::NAME = #(104 116 109 108) #:REST3258 = ((#(120 109 108 110 115) . #(104 116 116 112 58 47 47 119 119 119 ...))) CXML::*NAMESPACE-BINDINGS* = ((#()) (#(120 109 108 110 115) . #(104 116 116 112 58 47 47 119 119 119 ...)) (#(120 109 108) . #(104 116 116 112 58 47 47 119 119 119 ...))) CXML::NEW-NAMESPACES = ((NIL . #(104 116 116 112 58 47 47 119 119 119 ...))) 7: (CXML::P/ELEMENT #S(CXML::ZSTREAM :TOKEN-CATEGORY NIL :TOKEN-SEMANTIC NIL :INPUT-STACK (#<RUNES:XSTREAM #<error printing CXML::STREAM-NAME #x3000429E545D>>))) Locals: 8: (CXML::P/DOCUMENT #S(CXML::ZSTREAM :TOKEN-CATEGORY NIL :TOKEN-SEMANTIC NIL :INPUT-STACK (#<RUNES:XSTREAM #<error printing CXML::STREAM-NAME #x3000429E545D>>)) #<UTF8-DOM::DOM-BUILDER #x3000429EBCAD>) Locals: CXML::VALIDATE = NIL CXML::ROOT = NIL CXML::ENTITY-RESOLVER = #<Compiled-function HAXL::DEFAULT-ENTITY-RESOLVER #x30004161DECF> CXML::DISALLOW-INTERNAL-SUBSET = NIL CXML::RECODE = T RUNES:XSTREAM = #<RUNES:XSTREAM #<error printing CXML::STREAM-NAME #x3000429C8E4D>> CXML::NAME = #<error printing CXML::STREAM-NAME #x3000429C8E4D> CXML::BASE = #<URI file://+/Users/smishra/lisp/wessal/templates/error.xml> CXML::*CTX* = NIL CXML::*VALIDATE* = T CXML::*NAMESPACE-BINDINGS* = ((#()) (#(120 109 108 110 115) . #(104 116 116 112 58 47 47 119 119 119 ...)) (#(120 109 108) . #(104 116 116 112 58 47 47 119 119 119 ...))) CXML::*DATA-BEHAVIOUR* = #<Unbound> CXML::*DATA-BEHAVIOUR* = :DTD 9: (#<Anonymous Function #x3000414D19AF> '(:ENTITY-RESOLVER #<Compiled-function HAXL::DEFAULT-ENTITY-RESOLVER #x30004161DECF>) #<UTF8-DOM::DOM-BUILDER #x3000429EBCAD> #<RUNES:XSTREAM #<error printing CXML::STREAM-NAME #x3000429E545D>> #S(CXML::ZSTREAM :TOKEN-CATEGORY NIL :TOKEN-SEMANTIC NIL :INPUT-STACK (#<RUNES:XSTREAM #<error printing CXML::STREAM-NAME #x3000429E545D>>))) Locals: CXML::ARGS = (:ENTITY-RESOLVER #<Compiled-function HAXL::DEFAULT-ENTITY-RESOLVER #x30004161DECF>) CXML::HANDLER = #<UTF8-DOM::DOM-BUILDER #x3000429CF69D> RUNES:XSTREAM = #<RUNES:XSTREAM #<error printing CXML::STREAM-NAME #x3000429C8E4D>> CXML::ZSTREAM = #S(CXML::ZSTREAM :TOKEN-CATEGORY NIL :TOKEN-SEMANTIC NIL :INPUT-STACK (#<RUNES:XSTREAM #<error printing CXML::STREAM-NAME #x3000429C8E4D>>)) CXML::*SCRATCH-PAD* = #<Unbound> CXML::*SCRATCH-PAD-2* = #<Unbound> CXML::*SCRATCH-PAD-3* = #<Unbound> CXML::*SCRATCH-PAD-4* = #<Unbound> 10: (CXML::CALL-WITH-ZSTREAM #<COMPILED-LEXICAL-CLOSURE #x3000429E53EF> #S(CXML::ZSTREAM :TOKEN-CATEGORY NIL :TOKEN-SEMANTIC NIL :INPUT-STACK (#<RUNES:XSTREAM #<error printing CXML::STREAM-NAME #x3000429E545D>>))) Locals: CXML::FN = #<COMPILED-LEXICAL-CLOSURE #x3000429C8DDF> CXML::ZSTREAM = #S(CXML::ZSTREAM :TOKEN-CATEGORY NIL :TOKEN-SEMANTIC NIL :INPUT-STACK (#<RUNES:XSTREAM #<error printing CXML::STREAM-NAME #x3000429C8E4D>>)) CCL::*INTERRUPT-LEVEL* = 0 CCL::*INTERRUPT-LEVEL* = -1 Catch-tags: NIL 11: (CXML::PARSE-XSTREAM #<RUNES:XSTREAM #<error printing CXML::STREAM-NAME #x3000429E545D>> #<UTF8-DOM::DOM-BUILDER #x3000429EBCAD>) Locals: CXML::HANDLER = #<UTF8-DOM::DOM-BUILDER #x3000429CF69D> CXML::ARGS = (:ENTITY-RESOLVER #<Compiled-function HAXL::DEFAULT-ENTITY-RESOLVER #x30004161DECF>) CXML::*CTX* = NIL #:G3378 = (RUNES-ENCODING:ENCODING-ERROR) CCL::%HANDLERS% = ((PROCESS-RESET)) Catch-tags: NIL 12: (CXML::CALL-WITH-OPEN-XFILE #<COMPILED-LEXICAL-CLOSURE #x3000429EB9FF>) Locals: CXML::CONTINUATION = #<COMPILED-LEXICAL-CLOSURE #x3000429CF3EF> CXML::OPEN-ARGS = (#P"/Users/smishra/lisp/wessal/templates/error.xml") CXML::INPUT = #<BASIC-FILE-BINARY-INPUT-STREAM ("/Users/smishra/lisp/wessal/templates/error.xml"/12 ISO-8859-1) #x3000429CF36D> CCL::*INTERRUPT-LEVEL* = 0 CCL::*INTERRUPT-LEVEL* = -1 Catch-tags: NIL I know that the particular invocation of parse-xml matters. Here's how I'm doing mine: (cxml:parse-file document-path #+allegro (rune-dom:make-dom-builder) #+openmcl (cxml-dom:make-dom-builder) :entity-resolver #'default-entity-resolver) Any help will be much appreciated. Thanks, Sunil -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.7 (Darwin) Comment: Using GnuPG with Mozilla - http://enigmail.mozdev.org iD8DBQFGjTU8jRnqWMAEf1cRAueTAKDLo+dR9MWXtg6Sr78j340q4nGaHQCgsK8Q 4cfCfsF+BZQ6qd7y77sbAoA= =j+fv -----END PGP SIGNATURE-----

2 1

[cxml-devel] Patch: casing down some code.
by Marco Monteiro 27 Jun '07

27 Jun '07

The attached patch changes the case of some code that prevents cxml to be used in 'modern mode' Lisp implementations. Please apply. Thanks, Marco

2 1

[cxml-devel] Patch: Support for the Scieneer CL.
by Douglas Crosher 17 Jun '07

17 Jun '07

o Add support for the Scieneer CL. The Scieneer CL has a very fast stream implementation which is comparable in performance to the runes implementation so CXML on the SCL can use CL streams rather than xstreams and ystreams - enabled via the :x&y-streams-are-stream feature. This also enables support for a wider range of encodings. The Scieneer CL also supports http and https URLs for pathnames so can open such external files without the need for an entity resolver. Regards Douglas Crosher o Add support for the Scieneer CL. ? runes/stream-scl.lisp Index: cxml.asd =================================================================== RCS file: /project/cxml/cvsroot/cxml/cxml.asd,v retrieving revision 1.18 diff -u -r1.18 cxml.asd --- cxml.asd 26 May 2007 21:55:57 -0000 1.18 +++ cxml.asd 13 Jun 2007 08:15:02 -0000 @@ -30,7 +30,7 @@ (:file "space-normalizer" :depends-on ("xml-parse")) (:file "catalog" :depends-on ("xml-parse")) (:file "sax-proxy" :depends-on ("xml-parse"))) - :depends-on (:runes :puri :trivial-gray-streams)) + :depends-on (:runes :puri #-scl :trivial-gray-streams)) (defclass utf8dom-file (closure-source-file) ((of))) Index: runes.asd =================================================================== RCS file: /project/cxml/cvsroot/cxml/runes.asd,v retrieving revision 1.1 diff -u -r1.1 runes.asd --- runes.asd 26 May 2007 22:05:13 -0000 1.1 +++ runes.asd 13 Jun 2007 08:15:03 -0000 @@ -52,7 +52,9 @@ #+rune-is-character "characters") #+rune-is-integer (:file "utf8") (:file "syntax") - (:file "encodings") - (:file "encodings-data") - (:file "xstream") - (:file "ystream"))) + #-x&y-streams-are-stream (:file "encodings") + #-x&y-streams-are-stream (:file "encodings-data") + #-x&y-streams-are-stream (:file "xstream") + #-x&y-streams-are-stream (:file "ystream") + #+x&y-streams-are-stream (:file #+scl "stream-scl") + )) Index: xml/package.lisp =================================================================== RCS file: /project/cxml/cvsroot/cxml/xml/package.lisp,v retrieving revision 1.16 diff -u -r1.16 package.lisp --- xml/package.lisp 1 May 2007 20:07:00 -0000 1.16 +++ xml/package.lisp 13 Jun 2007 08:15:04 -0000 @@ -6,7 +6,7 @@ (in-package :cl-user) (defpackage :cxml - (:use :cl :runes :runes-encoding :trivial-gray-streams) + (:use :cl :runes :runes-encoding #-scl :trivial-gray-streams) (:export ;; xstreams #:make-xstream Index: xml/unparse.lisp =================================================================== RCS file: /project/cxml/cvsroot/cxml/xml/unparse.lisp,v retrieving revision 1.13 diff -u -r1.13 unparse.lisp --- xml/unparse.lisp 1 May 2007 20:07:00 -0000 1.13 +++ xml/unparse.lisp 13 Jun 2007 08:15:04 -0000 @@ -621,14 +621,22 @@ data) (defun rod-to-utf8-string (rod) + #-scl (let ((out (make-buffer :element-type 'character))) (runes-to-utf8/adjustable-string out rod (length rod)) - out)) + out) + #+scl + (ext:make-string-from-bytes (ext:make-bytes-from-string rod :utf8) + :iso-8859-1)) (defun utf8-string-to-rod (str) + #-scl (let* ((bytes (map '(vector (unsigned-byte 8)) #'char-code str)) (buffer (make-array (length bytes) :element-type '(unsigned-byte 16))) (n (decode-sequence :utf-8 bytes 0 (length bytes) buffer 0 0 nil)) (result (make-array n :element-type 'rune))) (map-into result #'code-rune buffer) - result)) + result) + #+scl + (let ((bytes (map '(vector (unsigned-byte 8)) #'char-code str))) + (ext:make-string-from-bytes bytes :utf-8))) Index: xml/xml-parse.lisp =================================================================== RCS file: /project/cxml/cvsroot/cxml/xml/xml-parse.lisp,v retrieving revision 1.67 diff -u -r1.67 xml-parse.lisp --- xml/xml-parse.lisp 4 Mar 2007 21:04:13 -0000 1.67 +++ xml/xml-parse.lisp 13 Jun 2007 08:15:07 -0000 @@ -2957,6 +2973,7 @@ ;;;; --------------------------------------------------------------------------- ;;;; User interface ;;;; +#-scl (defun specific-or (component &optional (alternative nil)) (if (eq component :unspecific) alternative @@ -2967,6 +2984,7 @@ alternative str)) +#-scl (defun make-uri (&rest initargs &key path query &allow-other-keys) (apply #'make-instance 'puri:uri @@ -2974,9 +2992,11 @@ :query (and query (escape-query query)) initargs)) +#-scl (defun escape-path (list) (puri::render-parsed-path list t)) +#-scl (defun escape-query (pairs) (flet ((escape (str) (puri::encode-escaped-encoding str puri::*reserved-characters* t))) @@ -2990,6 +3010,7 @@ (write-char #\= s) (write-string (escape (cdr pair)) s)))))) +#-scl (defun uri-parsed-query (uri) (flet ((unescape (str) (puri::decode-escaped-encoding str t puri::*reserved-characters*))) @@ -3005,9 +3026,11 @@ (t nil))))) +#-scl (defun query-value (name alist) (cdr (assoc name alist :test #'equal))) +#-scl (defun pathname-to-uri (pathname) (let ((path (append (pathname-directory pathname) @@ -3027,6 +3050,11 @@ (specific-or (pathname-device pathname))) :path path)))) +#+scl +(defun pathname-to-uri (pathname) + (puri:parse-uri (namestring pathname))) + +#-scl (defun parse-name.type (str) (if str (let ((i (position #\. str :from-end t))) @@ -3035,6 +3063,7 @@ (values str nil))) (values nil nil))) +#-scl (defun uri-to-pathname (uri) (let ((scheme (puri:uri-scheme uri)) (path (puri:uri-parsed-path uri))) @@ -3058,11 +3087,17 @@ :directory (cons :absolute (butlast (cdr path))) :name name :type type)))))) +#+scl +(defun uri-to-pathname (uri) + (let ((pathname (puri:render-uri uri nil))) + (when (equalp (pathname-host pathname) "+") + (setf (slot-value pathname 'lisp::host) "localhost")) + pathname)) (defun parse-xstream (xstream handler &rest args) (let ((*ctx* nil)) (handler-case - (let ((zstream (make-zstream :input-stack (list xstream)))) + (with-zstream (zstream :input-stack (list xstream)) (peek-rune xstream) (with-scratch-pads () (apply #'p/document zstream handler args))) @@ -3129,10 +3164,10 @@ (unless (dtd *ctx*) (with-scratch-pads () (let ((*data-behaviour* :DTD)) - (let* ((xi2 (xstream-open-extid extid)) - (zi2 (make-zstream :input-stack (list xi2)))) - (ensure-dtd) - (p/ext-subset zi2))))) + (let ((xi2 (xstream-open-extid extid))) + (with-zstream (zi2 :input-stack (list xi2)) + (ensure-dtd) + (p/ext-subset zi2)))))) (sax:end-dtd handler) (let ((dtd (dtd *ctx*))) (sax:entity-resolver handler (lambda (n h) (resolve-entity n h dtd))) @@ -3193,15 +3228,18 @@ (defun string->xstream (string) (make-rod-xstream (string-rod string))) +#-scl (defclass octet-input-stream (trivial-gray-stream-mixin fundamental-binary-input-stream) ((octets :initarg :octets) (pos :initform 0))) +#-scl (defmethod close ((stream octet-input-stream) &key abort) (declare (ignore abort)) (open-stream-p stream)) +#-scl (defmethod stream-read-byte ((stream octet-input-stream)) (with-slots (octets pos) stream (if (>= pos (length octets)) @@ -3210,6 +3248,7 @@ (elt octets pos) (incf pos))))) +#-scl (defmethod stream-read-sequence ((stream octet-input-stream) sequence start end &key &allow-other-keys) (with-slots (octets pos) stream @@ -3221,7 +3260,10 @@ end1))) (defun make-octet-input-stream (octets) - (make-instance 'octet-input-stream :octets octets)) + #-scl + (make-instance 'octet-input-stream :octets octets) + #+scl + (ext:make-byte-input-stream octets)) (defun parse-octets (octets handler &rest args) (apply #'parse-stream (make-octet-input-stream octets) handler args)) ;;; -*- Mode: Lisp; Syntax: Common-Lisp; readtable: runes; Encoding: utf-8; -*- ;;; --------------------------------------------------------------------------- ;;; Title: Fast streams ;;; Created: 1999-07-17 ;;; Author: Douglas Crosher ;;; License: Lisp-LGPL (See file COPYING for details). ;;; --------------------------------------------------------------------------- ;;; (c) copyright 2007 by Douglas Crosher ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Library General Public ;;; License as published by the Free Software Foundation; either ;;; version 2 of the License, or (at your option) any later version. ;;; ;;; This library is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;; Library General Public License for more details. ;;; ;;; You should have received a copy of the GNU Library General Public ;;; License along with this library; if not, write to the ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307 USA. (in-package :runes) (eval-when (:compile-toplevel :load-toplevel :execute) (defparameter *fast* '(optimize (speed 3) (safety 3)))) (deftype runes-encoding:encoding-error () 'ext:character-conversion-error) ;;; xstream (eval-when (:compile-toplevel :load-toplevel :execute) (defclass xstream (ext:character-stream) ((name :initarg :name :initform nil :accessor xstream-name) (column :initarg :column :initform 0) (line :initarg :line :initform 1) (unread-column :initarg :unread-column :initform 0))) (defclass eol-conversion-xstream (lisp::eol-conversion-input-stream xstream) ()) ) ; eval-when (defun make-eol-conversion-xstream (source-stream) "Returns a character stream that conversion CR-LF pairs and lone CR characters into single linefeed character." (declare (type stream source-stream)) (let ((stream (ext:make-eol-conversion-stream source-stream :input t :close-stream-p t))) (change-class stream 'eol-conversion-xstream))) (definline xstream-p (stream) (typep stream 'xstream)) (defun close-xstream (input) (close input)) (definline read-rune (input) (declare (type stream input) (inline read-char) #.*fast*) (let ((char (read-char input nil :eof))) (cond ((member char '(#\UFFFE #\UFFFF)) ;; These characters are illegal within XML documents. (simple-error 'ext:character-conversion-error "~@<Illegal XML document character: ~S~:@>" char)) ((eql char #\linefeed) (setf (slot-value input 'unread-column) (slot-value input 'column)) (setf (slot-value input 'column) 0) (incf (the kernel:index (slot-value input 'line)))) (t (incf (the kernel:index (slot-value input 'column))))) char)) (definline peek-rune (input) (declare (type stream input) (inline peek-char) #.*fast*) (peek-char nil input nil :eof)) (definline consume-rune (input) (declare (type stream input) (inline read-rune) #.*fast*) (read-rune input) nil) (definline unread-rune (rune input) (declare (type stream input) (inline unread-char) #.*fast*) (unread-char rune input) (cond ((eql rune #\linefeed) (setf (slot-value input 'column) (slot-value input 'unread-column)) (setf (slot-value input 'unread-column) 0) (decf (the kernel:index (slot-value input 'line)))) (t (decf (the kernel:index (slot-value input 'column))))) nil) (defun fread-rune (input) (read-rune input)) (defun fpeek-rune (input) (peek-rune input)) (defun xstream-position (input) (file-position input)) (defun runes-encoding:find-encoding (encoding) encoding) (defun make-xstream (os-stream &key name (speed 8192) (initial-speed 1) (initial-encoding :guess)) (declare (ignore speed)) (assert (eql initial-speed 1)) (assert (eq initial-encoding :guess)) (let* ((stream (ext:make-xml-character-conversion-stream os-stream :input t :close-stream-p t)) (xstream (make-eol-conversion-xstream stream))) (setf (xstream-name xstream) name) xstream)) (defclass xstream-string-input-stream (lisp::string-input-stream xstream) ()) (defun make-rod-xstream (string &key name) (declare (type string string)) (let ((stream (make-string-input-stream string))) (change-class stream 'xstream-string-input-stream :name name))) ;;; already at 'full speed' so just return the buffer size. (defun set-to-full-speed (stream) (length (ext:stream-in-buffer stream))) (defun xstream-speed (stream) (length (ext:stream-in-buffer stream))) (defun xstream-line-number (stream) (slot-value stream 'line)) (defun xstream-column-number (stream) (slot-value stream 'column)) (defun xstream-encoding (stream) (stream-external-format stream)) ;;; the encoding will have already been detected, but it is checked against the ;;; declared encoding here. (defun (setf xstream-encoding) (declared-encoding stream) (let* ((initial-encoding (xstream-encoding stream)) (canonical-encoding (cond ((and (eq initial-encoding :utf-16le) (member declared-encoding '(:utf-16 :utf16 :utf-16le :utf16le) :test 'string-equal)) :utf-16le) ((and (eq initial-encoding :utf-16be) (member declared-encoding '(:utf-16 :utf16 :utf-16be :utf16be) :test 'string-equal)) :utf-16be) ((and (eq initial-encoding :ucs-4be) (member declared-encoding '(:ucs-4 :ucs4 :ucs-4be :ucs4be) :test 'string-equal)) :ucs4-be) ((and (eq initial-encoding :ucs-4le) (member declared-encoding '(:ucs-4 :ucs4 :ucs-4le :ucs4le) :test 'string-equal)) :ucs4-le) (t declared-encoding)))) (unless (string-equal initial-encoding canonical-encoding) (warn "Unable to change xstream encoding from ~S to ~S (~S)~%" initial-encoding declared-encoding canonical-encoding)) declared-encoding)) ;;; ystream - a run output stream. (deftype ystream () 'stream) (defun ystream-column (stream) (ext:line-column stream)) (definline write-rune (rune stream) (declare (inline write-char)) (write-char rune stream)) (defun write-rod (rod stream) (declare (type rod rod) (type stream stream)) (write-string rod stream)) (defun make-rod-ystream () (make-string-output-stream)) (defun close-ystream (stream) (etypecase stream (ext:string-output-stream (get-output-stream-string stream)) (ext:character-conversion-output-stream (let ((target (slot-value stream 'stream))) (close stream) (if (typep target 'ext:byte-output-stream) (ext:get-output-stream-bytes target) stream))))) ;;;; CHARACTER-STREAM-YSTREAM (defun make-character-stream-ystream (target-stream) target-stream) ;;;; OCTET-VECTOR-YSTREAM (defun make-octet-vector-ystream () (let ((target (ext:make-byte-output-stream))) (ext:make-character-conversion-stream target :output t :external-format :utf-8 :close-stream-p t))) ;;;; OCTET-STREAM-YSTREAM (defun make-octet-stream-ystream (os-stream) (ext:make-character-conversion-stream os-stream :output t :external-format :utf-8 :close-stream-p t))

2 2

[cxml-devel] Patch: Add XMLS support for including the namespace URI in the element and attribute names.
by Douglas Crosher 16 Jun '07

16 Jun '07

o Add support for including the namespace URI in the element and attribute names. o Add support for including the namespace URI in the element and attribute names. Index: xml/xmls-compat.lisp =================================================================== RCS file: /project/cxml/cvsroot/cxml/xml/xmls-compat.lisp,v retrieving revision 1.3 diff -u -r1.3 xmls-compat.lisp --- xml/xmls-compat.lisp 15 May 2006 21:57:47 -0000 1.3 +++ xml/xmls-compat.lisp 13 Jun 2007 08:15:07 -0000 @@ -69,32 +69,56 @@ (root :initform nil :accessor root) (include-default-values :initform t :initarg :include-default-values - :accessor include-default-values))) - -(defun make-xmls-builder (&key (include-default-values t)) - (make-instance 'xmls-builder :include-default-values include-default-values)) + :accessor include-default-values) + (include-namespace-uri :initform nil + :initarg :include-namespace-uri + :accessor include-namespace-uri))) + +(defun make-xmls-builder (&key (include-default-values t) + (include-namespace-uri nil)) + "Make a XMLS style builder. When 'include-namespace-uri is true a modified + XMLS tree is generated that includes the element namespace URI rather than + the qualified name prefix and also includes the namespace URI for attributes." + (make-instance 'xmls-builder :include-default-values include-default-values + :include-namespace-uri include-namespace-uri)) (defmethod sax:end-document ((handler xmls-builder)) (root handler)) (defmethod sax:start-element ((handler xmls-builder) namespace-uri local-name qname attributes) - (declare (ignore namespace-uri)) (setf local-name (or local-name qname)) - (let* ((attributes + (let* ((include-default-values (include-default-values handler)) + (include-namespace-uri (include-namespace-uri handler)) + (attributes (loop for attr in attributes - when (or (sax:attribute-specified-p attr) - (include-default-values handler)) + for attr-namespace-uri = (sax:attribute-namespace-uri attr) + for attr-local-name = (sax:attribute-local-name attr) + when (and (or (sax:attribute-specified-p attr) + include-default-values) + (or (not include-namespace-uri) + (not attr-namespace-uri) + attr-local-name)) collect - (list (sax:attribute-qname attr) + (list (cond (include-namespace-uri + (cond (attr-namespace-uri + (cons attr-local-name attr-namespace-uri)) + (t + (sax:attribute-qname attr)))) + (t + (sax:attribute-qname attr))) (sax:attribute-value attr)))) + (namespace (cond (include-namespace-uri + namespace-uri) + (t + (let ((lq (length qname)) + (ll (length local-name))) + (if (eql lq ll) + nil + (subseq qname 0 (- lq ll 1))))))) (node (make-node :name local-name - :ns (let ((lq (length qname)) - (ll (length local-name))) - (if (eql lq ll) - nil - (subseq qname 0 (- lq ll 1)))) + :ns namespace :attrs attributes)) (parent (car (element-stack handler)))) (if parent

2 2

[cxml-devel] Patch: close zstream input streams.
by Douglas Crosher 16 Jun '07

16 Jun '07

o with-zstream: new macro that ensures all the streams in the input stack are closed even if parsing does not exit normally. Closing stream can also allow resources to be reused. o with-zstream: new macro that ensures all the streams in the input stack are closed even if parsing does not exit normally. Closing streams can also allow resources to be reused. Index: xml/xml-parse.lisp =================================================================== RCS file: /project/cxml/cvsroot/cxml/xml/xml-parse.lisp,v retrieving revision 1.67 diff -u -r1.67 xml-parse.lisp --- xml/xml-parse.lisp 4 Mar 2007 21:04:13 -0000 1.67 +++ xml/xml-parse.lisp 13 Jun 2007 08:15:07 -0000 @@ -1175,6 +1175,21 @@ token-semantic input-stack) +(defun call-with-zstream (fn zstream) + (unwind-protect + (funcall fn zstream) + (dolist (input (zstream-input-stack zstream)) + (cond #-x&y-streams-are-stream + ((xstream-p input) + (close-xstream input)) + #+x&y-streams-are-stream + ((streamp input) + (close input)))))) + +(defmacro with-zstream ((zstream &rest args) &body body) + `(call-with-zstream (lambda (,zstream) ,@body) + (make-zstream ,@args))) + (defun read-token (input) (cond ((zstream-token-category input) (multiple-value-prog1 @@ -2545,15 +2560,15 @@ (setf (dtd *ctx*) cached-dtd) (report-cached-dtd cached-dtd)) (t - (let* ((xi2 (xstream-open-extid effective-extid)) - (zi2 (make-zstream :input-stack (list xi2)))) - (ensure-dtd) - (p/ext-subset zi2) - (when (and fresh-dtd-p - *cache-all-dtds* - *validate* - (not (standalone-p *ctx*))) - (setf (getdtd sysid *dtd-cache*) (dtd *ctx*)))))))) + (let ((xi2 (xstream-open-extid effective-extid))) + (with-zstream (zi2 :input-stack (list xi2)) + (ensure-dtd) + (p/ext-subset zi2) + (when (and fresh-dtd-p + *cache-all-dtds* + *validate* + (not (standalone-p *ctx*))) + (setf (getdtd sysid *dtd-cache*) (dtd *ctx*))))))))) (sax:end-dtd (handler *ctx*)) (let ((dtd (dtd *ctx*))) (sax:entity-resolver @@ -2657,7 +2672,8 @@ :entity-name "dummy doctype" :entity-kind :main :uri (zstream-base-sysid input))) - (p/doctype-decl (make-zstream :input-stack (list dummy)) dtd))) + (with-zstream (zstream :input-stack (list dummy)) + (p/doctype-decl zstream dtd)))) (defun fix-seen-< (input) (when (eq (peek-token input) :seen-<) @@ -2841,106 +2857,106 @@ (defun parse-xml-decl (content) (let* ((res (make-xml-header)) - (i (make-rod-xstream content)) - (z (make-zstream :input-stack (list i))) - (atts (read-attribute-list z i t))) - (unless (eq (peek-rune i) :eof) - (wf-error i "Garbage at end of XMLDecl.")) - ;; versioninfo muss da sein - ;; dann ? encodingdecl - ;; dann ? sddecl - ;; dann ende - (unless (eq (caar atts) (intern-name '#.(string-rod "version"))) - (wf-error i "XMLDecl needs version.")) - (unless (and (>= (length (cdar atts)) 1) - (every (lambda (x) + (i (make-rod-xstream content))) + (with-zstream (z :input-stack (list i)) + (let ((atts (read-attribute-list z i t))) + (unless (eq (peek-rune i) :eof) + (wf-error i "Garbage at end of XMLDecl.")) + ;; versioninfo muss da sein + ;; dann ? encodingdecl + ;; dann ? sddecl + ;; dann ende + (unless (eq (caar atts) (intern-name '#.(string-rod "version"))) + (wf-error i "XMLDecl needs version.")) + (unless (and (>= (length (cdar atts)) 1) + (every (lambda (x) + (or (rune<= #/a x #/z) + (rune<= #/A x #/Z) + (rune<= #/0 x #/9) + (rune= x #/_) + (rune= x #/.) + (rune= x #/:) + (rune= x #/-))) + (cdar atts))) + (wf-error i"Bad XML version number: ~S." (rod-string (cdar atts)))) + (setf (xml-header-version res) (rod-string (cdar atts))) + (pop atts) + (when (eq (caar atts) (intern-name '#.(string-rod "encoding"))) + (unless (and (>= (length (cdar atts)) 1) + (every (lambda (x) + (or (rune<= #/a x #/z) + (rune<= #/A x #/Z) + (rune<= #/0 x #/9) + (rune= x #/_) + (rune= x #/.) + (rune= x #/-))) + (cdar atts)) + ((lambda (x) (or (rune<= #/a x #/z) - (rune<= #/A x #/Z) - (rune<= #/0 x #/9) - (rune= x #/_) - (rune= x #/.) - (rune= x #/:) - (rune= x #/-))) - (cdar atts))) - (wf-error i"Bad XML version number: ~S." (rod-string (cdar atts)))) - (setf (xml-header-version res) (rod-string (cdar atts))) - (pop atts) - (when (eq (caar atts) (intern-name '#.(string-rod "encoding"))) - (unless (and (>= (length (cdar atts)) 1) - (every (lambda (x) - (or (rune<= #/a x #/z) - (rune<= #/A x #/Z) - (rune<= #/0 x #/9) - (rune= x #/_) - (rune= x #/.) - (rune= x #/-))) - (cdar atts)) - ((lambda (x) - (or (rune<= #/a x #/z) - (rune<= #/A x #/Z))) - (aref (cdar atts) 0))) - (wf-error i "Bad XML encoding name: ~S." (rod-string (cdar atts)))) - (setf (xml-header-encoding res) (rod-string (cdar atts))) - (pop atts)) - (when (eq (caar atts) (intern-name '#.(string-rod "standalone"))) - (unless (or (rod= (cdar atts) '#.(string-rod "yes")) - (rod= (cdar atts) '#.(string-rod "no"))) - (wf-error i "XMLDecl's 'standalone' attribute must be exactly \"yes\" or \"no\" and not ~S." - (rod-string (cdar atts)))) - (setf (xml-header-standalone-p res) - (if (rod-equal '#.(string-rod "yes") (cdar atts)) - :yes - :no)) - (pop atts)) - (when atts - (wf-error i "Garbage in XMLDecl: ~A" (rod-string content))) - res)) + (rune<= #/A x #/Z))) + (aref (cdar atts) 0))) + (wf-error i "Bad XML encoding name: ~S." (rod-string (cdar atts)))) + (setf (xml-header-encoding res) (rod-string (cdar atts))) + (pop atts)) + (when (eq (caar atts) (intern-name '#.(string-rod "standalone"))) + (unless (or (rod= (cdar atts) '#.(string-rod "yes")) + (rod= (cdar atts) '#.(string-rod "no"))) + (wf-error i "XMLDecl's 'standalone' attribute must be exactly \"yes\" or \"no\" and not ~S." + (rod-string (cdar atts)))) + (setf (xml-header-standalone-p res) + (if (rod-equal '#.(string-rod "yes") (cdar atts)) + :yes + :no)) + (pop atts)) + (when atts + (wf-error i "Garbage in XMLDecl: ~A" (rod-string content))) + res)))) (defun parse-text-decl (content) (let* ((res (make-xml-header)) - (i (make-rod-xstream content)) - (z (make-zstream :input-stack (list i))) - (atts (read-attribute-list z i t))) - (unless (eq (peek-rune i) :eof) - (wf-error i "Garbage at end of TextDecl")) - ;; versioninfo optional - ;; encodingdecl muss da sein - ;; dann ende - (when (eq (caar atts) (intern-name '#.(string-rod "version"))) - (unless (and (>= (length (cdar atts)) 1) - (every (lambda (x) - (or (rune<= #/a x #/z) - (rune<= #/A x #/Z) - (rune<= #/0 x #/9) - (rune= x #/_) - (rune= x #/.) - (rune= x #/:) - (rune= x #/-))) - (cdar atts))) - (wf-error i "Bad XML version number: ~S." (rod-string (cdar atts)))) - (setf (xml-header-version res) (rod-string (cdar atts))) - (pop atts)) - (unless (eq (caar atts) (intern-name '#.(string-rod "encoding"))) - (wf-error i "TextDecl needs encoding.")) - (unless (and (>= (length (cdar atts)) 1) - (every (lambda (x) - (or (rune<= #/a x #/z) - (rune<= #/A x #/Z) - (rune<= #/0 x #/9) - (rune= x #/_) - (rune= x #/.) - (rune= x #/-))) - (cdar atts)) - ((lambda (x) - (or (rune<= #/a x #/z) - (rune<= #/A x #/Z) - (rune<= #/0 x #/9))) - (aref (cdar atts) 0))) - (wf-error i "Bad XML encoding name: ~S." (rod-string (cdar atts)))) - (setf (xml-header-encoding res) (rod-string (cdar atts))) - (pop atts) - (when atts - (wf-error i "Garbage in TextDecl: ~A" (rod-string content))) + (i (make-rod-xstream content))) + (with-zstream (z :input-stack (list i)) + (let ((atts (read-attribute-list z i t))) + (unless (eq (peek-rune i) :eof) + (wf-error i "Garbage at end of TextDecl")) + ;; versioninfo optional + ;; encodingdecl muss da sein + ;; dann ende + (when (eq (caar atts) (intern-name '#.(string-rod "version"))) + (unless (and (>= (length (cdar atts)) 1) + (every (lambda (x) + (or (rune<= #/a x #/z) + (rune<= #/A x #/Z) + (rune<= #/0 x #/9) + (rune= x #/_) + (rune= x #/.) + (rune= x #/:) + (rune= x #/-))) + (cdar atts))) + (wf-error i "Bad XML version number: ~S." (rod-string (cdar atts)))) + (setf (xml-header-version res) (rod-string (cdar atts))) + (pop atts)) + (unless (eq (caar atts) (intern-name '#.(string-rod "encoding"))) + (wf-error i "TextDecl needs encoding.")) + (unless (and (>= (length (cdar atts)) 1) + (every (lambda (x) + (or (rune<= #/a x #/z) + (rune<= #/A x #/Z) + (rune<= #/0 x #/9) + (rune= x #/_) + (rune= x #/.) + (rune= x #/-))) + (cdar atts)) + ((lambda (x) + (or (rune<= #/a x #/z) + (rune<= #/A x #/Z) + (rune<= #/0 x #/9))) + (aref (cdar atts) 0))) + (wf-error i "Bad XML encoding name: ~S." (rod-string (cdar atts)))) + (setf (xml-header-encoding res) (rod-string (cdar atts))) + (pop atts) + (when atts + (wf-error i "Garbage in TextDecl: ~A" (rod-string content))))) res)) ;;;; --------------------------------------------------------------------------- @@ -3129,10 +3164,10 @@ (unless (dtd *ctx*) (with-scratch-pads () (let ((*data-behaviour* :DTD)) - (let* ((xi2 (xstream-open-extid extid)) - (zi2 (make-zstream :input-stack (list xi2)))) - (ensure-dtd) - (p/ext-subset zi2))))) + (let ((xi2 (xstream-open-extid extid))) + (with-zstream (zi2 :input-stack (list xi2)) + (ensure-dtd) + (p/ext-subset zi2)))))) (sax:end-dtd handler) (let ((dtd (dtd *ctx*))) (sax:entity-resolver handler (lambda (n h) (resolve-entity n h dtd))) @@ -3171,15 +3206,15 @@ :entity-name "dtd" :entity-kind :main :uri (safe-stream-sysid stream))) - (let ((zstream (make-zstream :input-stack (list input))) - (*ctx* (make-context :handler handler)) + (let ((*ctx* (make-context :handler handler)) (*validate* t) (*data-behaviour* :DTD)) - (with-scratch-pads () - (ensure-dtd) - (peek-rune input) - (p/ext-subset zstream) - (dtd *ctx*))))) + (with-zstream (zstream :input-stack (list input)) + (with-scratch-pads () + (ensure-dtd) + (peek-rune input) + (p/ext-subset zstream) + (dtd *ctx*)))))) (defun parse-rod (string handler &rest args) (let ((xstream (string->xstream string))) @@ -3389,63 +3431,63 @@ ;; used only by read-att-value-2 (defun find-internal-entity-expansion (name) - (let ((zinput (make-zstream))) + (with-zstream (zinput) (with-rune-collector-3 (collect) (labels ((muffle (input) - (let (c) - (loop - (setf c (read-rune input)) - (cond ((eq c :eof) - (return)) - ((rune= c #/&) - (setf c (peek-rune input)) - (cond ((eql c :eof) - (eox input)) - ((rune= c #/#) - (let ((c (read-character-reference input))) - (%put-unicode-char c collect))) - (t - (unless (name-start-rune-p c) - (wf-error zinput "Expecting name after &.")) - (let ((name (read-name-token input))) - (setf c (read-rune input)) - (check-rune input c #/\;) - (recurse-on-entity - zinput name :general - (lambda (zinput) - (muffle (car (zstream-input-stack zinput))))))))) - ((rune= c #/<) - (wf-error zinput "unexpected #\/<")) - ((space-rune-p c) - (collect #/space)) - ((not (data-rune-p c)) - (wf-error zinput "illegal char: ~S." c)) - (t - (collect c))))))) - (declare (dynamic-extent #'muffle)) - (recurse-on-entity - zinput name :general - (lambda (zinput) - (muffle (car (zstream-input-stack zinput))))) )))) + (let (c) + (loop + (setf c (read-rune input)) + (cond ((eq c :eof) + (return)) + ((rune= c #/&) + (setf c (peek-rune input)) + (cond ((eql c :eof) + (eox input)) + ((rune= c #/#) + (let ((c (read-character-reference input))) + (%put-unicode-char c collect))) + (t + (unless (name-start-rune-p c) + (wf-error zinput "Expecting name after &.")) + (let ((name (read-name-token input))) + (setf c (read-rune input)) + (check-rune input c #/\;) + (recurse-on-entity + zinput name :general + (lambda (zinput) + (muffle (car (zstream-input-stack zinput))))))))) + ((rune= c #/<) + (wf-error zinput "unexpected #\/<")) + ((space-rune-p c) + (collect #/space)) + ((not (data-rune-p c)) + (wf-error zinput "illegal char: ~S." c)) + (t + (collect c))))))) + (declare (dynamic-extent #'muffle)) + (recurse-on-entity + zinput name :general + (lambda (zinput) + (muffle (car (zstream-input-stack zinput))))))))) ;; callback for DOM (defun resolve-entity (name handler dtd) (let ((*validate* nil)) (if (get-entity-definition name :general dtd) (let* ((*ctx* (make-context :handler handler :dtd dtd)) - (input (make-zstream)) (*data-behaviour* :DOC)) - (with-scratch-pads () - (recurse-on-entity - input name :general - (lambda (input) - (prog1 - (etypecase (checked-get-entdef name :general) - (internal-entdef (p/content input)) - (external-entdef (p/ext-parsed-ent input))) - (unless (eq (peek-token input) :eof) - (wf-error input "Trailing garbage. - ~S" - (peek-token input)))))))) + (with-zstream (input) + (with-scratch-pads () + (recurse-on-entity + input name :general + (lambda (input) + (prog1 + (etypecase (checked-get-entdef name :general) + (internal-entdef (p/content input)) + (external-entdef (p/ext-parsed-ent input))) + (unless (eq (peek-token input) :eof) + (wf-error input "Trailing garbage. - ~S" + (peek-token input))))))))) nil))) (defun read-att-value-2 (input)

2 1

[cxml-devel] Patch: dribble-tests
by Douglas Crosher 16 Jun '07

16 Jun '07

o dribble-tests: 'run-all-tests require the parser function. o dribble-tests: 'run-all-tests require the parser function. Index: test/xmlconf.lisp =================================================================== RCS file: /project/cxml/cvsroot/cxml/test/xmlconf.lisp,v retrieving revision 1.14 diff -u -r1.14 xmlconf.lisp --- test/xmlconf.lisp 18 Feb 2007 14:35:16 -0000 1.14 +++ test/xmlconf.lisp 13 Jun 2007 08:15:04 -0000 @@ -66,14 +71,14 @@ (read-sequence result s ) result))) -(defun dribble-tests (directory) +(defun dribble-tests (parser-fn directory) (let ((base (slot-value (asdf:find-system :cxml) 'asdf::relative-pathname))) (with-open-file (*standard-output* (merge-pathnames "XMLCONF" base) :direction :output :external-format :iso-8859-1 :if-exists :supersede) - (run-all-tests directory)))) + (run-all-tests parser-fn directory)))) (defvar *parser-fn* 'sax-test)

2 1

[cxml-devel] Patch: make-string-sink/utf8 and make-character-stream-sink/utf8 not needed.
by Douglas Crosher 16 Jun '07

16 Jun '07

o make-string-sink/utf8, make-character-stream-sink/utf8: these functions are not needed when compiling with the :rune-is-character feature. o make-string-sink/utf8, make-character-stream-sink/utf8: these functions are not needed when compiling with the :rune-is-character feature. Index: xml/unparse.lisp =================================================================== RCS file: /project/cxml/cvsroot/cxml/xml/unparse.lisp,v retrieving revision 1.13 diff -u -r1.13 unparse.lisp --- xml/unparse.lisp 1 May 2007 20:07:00 -0000 1.13 +++ xml/unparse.lisp 13 Jun 2007 08:15:04 -0000 @@ -110,10 +110,10 @@ #+rune-is-character (define-maker make-character-stream-sink make-character-stream-ystream stream) - ;; #-rune-is-character + #-rune-is-character (define-maker make-string-sink/utf8 make-string-ystream/utf8) - ;; #-rune-is-character + #-rune-is-character (define-maker make-character-stream-sink/utf8 make-character-stream-ystream/utf8 stream))

2 1

[cxml-devel] Patch: extid-using-catalog: make-extid requires a URI object.
by Douglas Crosher 16 Jun '07

16 Jun '07

o extid-using-catalog: convert the URI string returned by 'resolve-extid into the 'uri object required by 'make-extid. o extid-using-catalog: convert the URI string returned by 'resolve-extid into the 'uri object required by 'make-extid. Index: xml/xml-parse.lisp =================================================================== RCS file: /project/cxml/cvsroot/cxml/xml/xml-parse.lisp,v retrieving revision 1.67 diff -u -r1.67 xml-parse.lisp --- xml/xml-parse.lisp 4 Mar 2007 21:04:13 -0000 1.67 +++ xml/xml-parse.lisp 13 Jun 2007 08:15:07 -0000 @@ -2481,7 +2496,7 @@ (extid-system extid) *catalog*))) (if sysid - (make-extid nil sysid) + (make-extid nil (safe-parse-uri sysid)) extid)) extid))

2 1

[cxml-devel] Patch: translate-uri-equals work with puri.
by Douglas Crosher 16 Jun '07

16 Jun '07

o translate-uri-equals: should work on all CL implementations, not just the Allegro CL because 'puri' is used for compatibility. o translate-uri-equals: should work on all CL implementations, not just the Allegro CL because 'puri' is used for compatibility. Index: test/domtest.lisp =================================================================== RCS file: /project/cxml/cvsroot/cxml/test/domtest.lisp,v retrieving revision 1.17 diff -u -r1.17 domtest.lisp --- test/domtest.lisp 20 Aug 2006 11:48:58 -0000 1.17 +++ test/domtest.lisp 13 Jun 2007 08:15:04 -0000 @@ -274,13 +274,6 @@ (with-attributes (|type|) element `(equal ,|type| "text/xml"))) -#-allegro -(defun translate-uri-equals (element) - (declare (ignore element)) - (warn "oops, assert-uri-equals needs Franz' URI package") - (throw 'give-up nil)) - -#+allegro (defun translate-uri-equals (element) (with-attributes (|actual|

2 1

[cxml-devel] Patch: downcase symbol names.
by Douglas Crosher 13 Jun '07

13 Jun '07

o Downcase symbol names for compatibility with CL variants with lower case symbol names such the Scieneer CL and ACL 'modern' mode. o Downcase symbol names for compatibility with CL variants with lower case symbol names such the Scieneer CL and ACL 'modern' mode. Index: klacks/klacks.lisp =================================================================== RCS file: /project/cxml/cvsroot/cxml/klacks/klacks.lisp,v retrieving revision 1.8 diff -u -r1.8 klacks.lisp --- klacks/klacks.lisp 1 May 2007 18:21:41 -0000 1.8 +++ klacks/klacks.lisp 13 Jun 2007 08:15:03 -0000 @@ -93,7 +93,7 @@ (sax:start-cdata source) (sax:characters handler a) (sax:end-cdata source)) - (T + (t (sax:characters handler a)))) (:processing-instruction (sax:processing-instruction handler a b)) Index: runes/ystream.lisp =================================================================== RCS file: /project/cxml/cvsroot/cxml/runes/ystream.lisp,v retrieving revision 1.5 diff -u -r1.5 ystream.lisp --- runes/ystream.lisp 2 Dec 2006 13:21:36 -0000 1.5 +++ runes/ystream.lisp 13 Jun 2007 08:15:03 -0000 @@ -42,11 +42,11 @@ (defstruct (utf8-ystream (:include ystream) - (:conc-name "YSTREAM-")) + (:conc-name #:ystream-)) (out-buffer (make-ub8-array (* 6 +ystream-bufsize+)) :type (simple-array (unsigned-byte 8) (*)))) -(defstruct (%stream-ystream (:include utf8-ystream) (:conc-name "YSTREAM-")) +(defstruct (%stream-ystream (:include utf8-ystream) (:conc-name #:ystream-)) (os-stream nil)) (definline write-rune (rune ystream) @@ -176,7 +176,7 @@ (defstruct (character-stream-ystream (:constructor make-character-stream-ystream (target-stream)) (:include ystream) - (:conc-name "YSTREAM-")) + (:conc-name #:ystream-)) (target-stream nil)) (defmethod flush-ystream ((ystream character-stream-ystream)) @@ -193,7 +193,7 @@ (defstruct (octet-vector-ystream (:include utf8-ystream) - (:conc-name "YSTREAM-")) + (:conc-name #:ystream-)) (result (make-buffer))) (defmethod ystream-device-write ((ystream octet-vector-ystream) buf nbytes) @@ -214,7 +214,7 @@ (defstruct (octet-stream-ystream (:include %stream-ystream) (:constructor make-octet-stream-ystream (os-stream)) - (:conc-name "YSTREAM-"))) + (:conc-name #:ystream-))) (defmethod ystream-device-write ((ystream octet-stream-ystream) buf nbytes) (write-sequence buf (ystream-os-stream ystream) :end nbytes)) @@ -227,7 +227,7 @@ (defstruct (character-stream-ystream/utf8 (:constructor make-character-stream-ystream/utf8 (os-stream)) (:include %stream-ystream) - (:conc-name "YSTREAM-"))) + (:conc-name #:ystream-))) (defmethod ystream-device-write ((ystream character-stream-ystream/utf8) buf nbytes) @@ -244,7 +244,7 @@ (defstruct (string-ystream/utf8 (:include character-stream-ystream/utf8 (os-stream (make-string-output-stream))) - (:conc-name "YSTREAM-"))) + (:conc-name #:ystream-))) (defmethod close-ystream ((ystream string-ystream/utf8)) (get-output-stream-string (ystream-os-stream ystream)))) Index: xml/xml-name-rune-p.lisp =================================================================== RCS file: /project/cxml/cvsroot/cxml/xml/xml-name-rune-p.lisp,v retrieving revision 1.8 diff -u -r1.8 xml-name-rune-p.lisp --- xml/xml-name-rune-p.lisp 10 Sep 2006 14:52:44 -0000 1.8 +++ xml/xml-name-rune-p.lisp 13 Jun 2007 08:15:04 -0000 @@ -162,20 +162,20 @@ (setf (aref r i) 1))))) ) `(progn - (DEFINLINE NAME-RUNE-P (RUNE) - (SETF RUNE (RUNE-CODE RUNE)) - (LOCALLY (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3)) + (definline name-rune-p (rune) + (setf rune (rune-code rune)) + (locally (declare (optimize (safety 0) (speed 3)) (type fixnum rune)) - (AND (<= 0 RUNE ,+max+) - (= 1 (SBIT ',(predicate-to-bv #'name-rune-p) - RUNE))))) - (DEFINLINE NAME-START-RUNE-P (RUNE) - (SETF RUNE (RUNE-CODE RUNE)) - (LOCALLY (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3)) + (and (<= 0 rune ,+max+) + (= 1 (sbit ',(predicate-to-bv #'name-rune-p) + rune))))) + (definline name-start-rune-p (rune) + (setf rune (rune-code rune)) + (locally (declare (optimize (safety 0) (speed 3)) (type fixnum rune)) - (AND (<= 0 RUNE ,+MAX+) - (= 1 (SBIT ',(predicate-to-bv #'name-start-rune-p) - RUNE))))) + (and (<= 0 rune ,+max+) + (= 1 (sbit ',(predicate-to-bv #'name-start-rune-p) + rune))))) (definline valid-name-p (rod) (and (plusp (length rod)) (name-start-rune-p (elt rod 0)) Index: xml/xml-parse.lisp =================================================================== RCS file: /project/cxml/cvsroot/cxml/xml/xml-parse.lisp,v retrieving revision 1.67 diff -u -r1.67 xml-parse.lisp --- xml/xml-parse.lisp 4 Mar 2007 21:04:13 -0000 1.67 +++ xml/xml-parse.lisp 13 Jun 2007 08:15:07 -0000 @@ -3326,20 +3368,20 @@ (let ((input-var (gensym)) (collect (gensym)) (c (gensym))) - `(LET ((,input-var ,input)) - (MULTIPLE-VALUE-BIND (,res ,res-start ,res-end) - (WITH-RUNE-COLLECTOR/RAW (,collect) - (LOOP - (LET ((,c (PEEK-RUNE ,input-var))) - (COND ((EQ ,c :EOF) + `(let ((,input-var ,input)) + (multiple-value-bind (,res ,res-start ,res-end) + (with-rune-collector/raw (,collect) + (loop + (let ((,c (peek-rune ,input-var))) + (cond ((eq ,c :eof) ;; xxx error message - (RETURN)) - ((FUNCALL ,predicate ,c) - (RETURN)) + (return)) + ((funcall ,predicate ,c) + (return)) (t (,collect ,c) - (CONSUME-RUNE ,input-var)))))) - (LOCALLY + (consume-rune ,input-var)))))) + (locally ,@body))))) (defun read-name-token (input)

1 0

[cxml-devel] cxml-rng patch.
by Marco Monteiro 03 Jun '07

03 Jun '07

Hi. Names created for define/ref nodes (when simplifying) are symbols. This causes problems with cxml:unparse-attribute when serializing the grammar. Adding a call to #'STRING on the generated symbol solves the problem. Patch attached. Marco

1 0

[cxml-devel] cxml-rng simplified schema
by Marco Monteiro 03 Jun '07

03 Jun '07

Hello. From the homepage: "The resulting schema object is a representation of a simplified schema using Lisp objects, which has gone through most stages of simplification as described the Relax NG specification." What does "through most stages" mean? What are the differences between the representation and what is described in the specification? Thanks, Marco

2 1

[cxml-devel] New release: cxml-rng
by David Lichteblau 26 May '07

26 May '07

Hi, the first release of cxml-rng is available for download at http://www.lichteblau.com/cxml-rng/ cxml-rng is an implementation of Relax NG schema validation, including support for compact syntax, DTD Compatibility, and the XSD type library. Make sure to upgrade to today's CXML release before trying cxml-rng. d.

1 0

[cxml-devel] New release: cxml
by David Lichteblau 26 May '07

26 May '07

Hi, a new release tarball is available for download. * cxml.asd has been split up into cxml.asd for the XML parser and runes.asd for the runes package, in preparation of a complete split of the two systems. Future CXML releases will use separate tarballs for runes and cxml. * xml:base support (SAX and Klacks only, not yet used in DOM). * New class broadcast-handler as a generalization of the older sax-proxy. * New class tapping-source, a klacks source that relays events from an upstream klacks source unchanged, while also emitting them as SAX events to a user-specified handler at the same time. * Changed attributes to carry an lname even when occurring without a namespace. Added new functions attribute*, unparse-attribute, and macro with-element*, with-namespace* to the SAX generation wrapper API. * Klacks improvements: Incompatibly changed klacks:find-element and find-event to consider the current event as a result. Added klacks-error, klacks:expect, klacks:skip, klacks:expecting-element. Fixed serialize-event to generate start-prefix-mapping and end-prefix-mapping events. New function map-current-namespace-declarations. * fixed build with common-lisp-controller

1 0

[cxml-devel] Bugs in namespace parsing.
by Peder Chr. Nørgaard 22 May '07

22 May '07

I think I have run into a pretty bad bug in namespace handling in Closure XML. Of course, I may just be using the code wrongly. I am using the 2007-02-18 tarball of cxml on a piece of XML code from RFC 4741 (netconf protocol): (defvar example "<rpc message-id=\"101\" xmlns=\"urn:ietf:params:xml:ns:netconf:base:1.0\"> <my-own-method xmlns=\"http://example.net/me/my-own/1.0\"> <my-first-parameter>14</my-first-parameter> <another-parameter>fred</another-parameter> </my-own-method> </rpc>") I run (defvar p-example (cxml:parse-stream (make-string-input-stream example) cxml-xmls:make-xmls-builder))) This is the result: (("rpc" (("xmlns" "urn:ietf:params:xml:ns:netconf:base:1.0") ("message-id" "101")) " " ("my-own-method" (("xmlns" "http://example.net/me/my-own/1.0")) " " ("my-first-parameter" NIL "14") " " ("another-parameter" NIL "fred") " ") " ")) It should have been something like ((("rpc" . "urn:ietf:params:xml:ns:netconf:base:1.0") (("xmlns" "urn:ietf:params:xml:ns:netconf:base:1.0") (("message-id" . "urn:ietf:params:xml:ns:netconf:base:1.0") "101")) " " (("my-own-method" . "http://example.net/me/my-own/1.0") (("xmlns" "http://example.net/me/my-own/1.0")) " " (("my-first-parameter" . "http://example.net/me/my-own/1.0) NIL "14") " " (("another-parameter" . "http://example.net/me/my-own/1.0) NIL "fred") " ") " ")) There seems to be not one, but two problems. First, the parser or the builder ignores the rule that the scope of an xmlns attribute starts from the tag of the element in which it is included. Second, (and that is probably the builder) fail to apply the default namespace to internal elements. FYI, XMLS has the approximately the same kind of bug. So has the PXML suite from Franz. It is evidently something that is a bit tough to get right. Maybe because it involves two scans of a <> construction - you really don't know the namespace of tags and attributes until you have parsed the entire <> construction and located the zero-or-one "xmlns=" and the zero-one-or-many "xmlns:<name>=" attributes. best regards -- Peder Chr. Nørgaard e-mail: pcn(a)pogt.dk Gefionsvej 19 spejder-e-mail: hathi(a)gallerne.dk DK-8230 Åbyhøj tel: +45 87 44 11 99 Denmark mob: +45 30 91 84 31

2 2