cxml-cvs May 2007

cxml-cvs@common-lisp.net

1 participants
11 discussions

[cxml-cvs] CVS cxml
by dlichteblau 27 May '07

27 May '07

Update of /project/cxml/cvsroot/cxml In directory clnet:/tmp/cvs-serv31965 Added Files: runes.asd Log Message: runes.asd --- /project/cxml/cvsroot/cxml/runes.asd 2007/05/26 22:05:14 NONE +++ /project/cxml/cvsroot/cxml/runes.asd 2007/05/26 22:05:14 1.1 ;;; XXX Die vielen verschiedenen Systeme hier sollten vielleicht ;;; Module eines grossen Systems CXML werden? (defpackage :runes-system (:use :asdf :cl) (:export #:*utf8-runes-readtable*)) (in-package :runes-system) (defvar *utf8-runes-readtable*) (defclass closure-source-file (cl-source-file) ()) #+sbcl (defmethod perform :around ((o compile-op) (s closure-source-file)) ;; shut up already. Correctness first. (handler-bind ((sb-ext:compiler-note #'muffle-warning)) (let (#+sbcl (*compile-print* nil)) (call-next-method)))) #-(or rune-is-character rune-is-integer) (progn (format t "~&;;; Checking for wide character support...") (force-output) (pushnew (dotimes (x 65536 (progn (format t " ok, characters have at least 16 bits.~%") :rune-is-character)) (unless (and (< x char-code-limit) (code-char x)) (format t " no, reverting to octet strings.~%") (return :rune-is-integer))) *features*)) #-rune-is-character (format t "~&;;; Building Closure with (UNSIGNED-BYTE 16) RUNES~%") #+rune-is-character (format t "~&;;; Building Closure with CHARACTER RUNES~%") (defsystem :runes :default-component-class closure-source-file :pathname (merge-pathnames "runes/" (make-pathname :name nil :type nil :defaults *load-truename*)) :serial t :components ((:file "package") (:file "definline") (:file runes :pathname #-rune-is-character "runes" #+rune-is-character "characters") #+rune-is-integer (:file "utf8") (:file "syntax") (:file "encodings") (:file "encodings-data") (:file "xstream") (:file "ystream")))

1 0

[cxml-cvs] CVS cxml/runes
by dlichteblau 26 May '07

26 May '07

Update of /project/cxml/cvsroot/cxml/runes In directory clnet:/tmp/cvs-serv28676/runes Modified Files: utf8.lisp Log Message: runes.asd neues release --- /project/cxml/cvsroot/cxml/runes/utf8.lisp 2005/12/27 20:01:16 1.2 +++ /project/cxml/cvsroot/cxml/runes/utf8.lisp 2007/05/26 21:55:58 1.3 @@ -29,7 +29,7 @@ (defun rod-reader (stream subchar arg) (runes::rod-string (runes::rod-reader stream subchar arg))) -(setf cxml-system::*utf8-runes-readtable* +(setf runes-system:*utf8-runes-readtable* (let ((rt (copy-readtable))) (set-dispatch-macro-character #\# #\/ 'rune-reader rt) (set-dispatch-macro-character #\# #\" 'rod-reader rt)

1 0

[cxml-cvs] CVS cxml
by dlichteblau 26 May '07

26 May '07

Update of /project/cxml/cvsroot/cxml In directory clnet:/tmp/cvs-serv28676 Modified Files: cxml.asd Log Message: runes.asd neues release --- /project/cxml/cvsroot/cxml/cxml.asd 2007/05/20 09:39:04 1.17 +++ /project/cxml/cvsroot/cxml/cxml.asd 2007/05/26 21:55:57 1.18 @@ -1,6 +1,3 @@ -;;; XXX Die vielen verschiedenen Systeme hier sollten vielleicht -;;; Module eines grossen Systems CXML werden? - (defpackage :cxml-system (:use :asdf :cl)) (in-package :cxml-system) @@ -14,45 +11,6 @@ (let (#+sbcl (*compile-print* nil)) (call-next-method)))) -#-(or rune-is-character rune-is-integer) -(progn - (format t "~&;;; Checking for wide character support...") - (force-output) - (pushnew (dotimes (x 65536 - (progn - (format t " ok, characters have at least 16 bits.~%") - :rune-is-character)) - (unless (and (< x char-code-limit) (code-char x)) - (format t " no, reverting to octet strings.~%") - (return :rune-is-integer))) - *features*)) - -#-rune-is-character -(format t "~&;;; Building cxml with (UNSIGNED-BYTE 16) RUNES~%") - -#+rune-is-character -(format t "~&;;; Building cxml with CHARACTER RUNES~%") - -(defsystem :cxml-runes - :default-component-class closure-source-file - :pathname (merge-pathnames - "runes/" - (make-pathname :name nil :type nil :defaults *load-truename*)) - :serial t - :components - ((:file "package") - (:file "definline") - (:file runes - :pathname - #-rune-is-character "runes" - #+rune-is-character "characters") - #+rune-is-integer (:file "utf8") - (:file "syntax") - (:file "encodings") - (:file "encodings-data") - (:file "xstream") - (:file "ystream"))) - (asdf:defsystem :cxml-xml :default-component-class closure-source-file :pathname (merge-pathnames @@ -72,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 (:cxml-runes :puri :trivial-gray-streams)) + :depends-on (:runes :puri :trivial-gray-streams)) (defclass utf8dom-file (closure-source-file) ((of))) @@ -90,11 +48,10 @@ (defmethod perform ((o load-op) (c utf8dom-file)) (load (slot-value c 'of))) -(defvar *utf8-runes-readtable*) - (defmethod perform ((operation compile-op) (c utf8dom-file)) (let ((*features* (cons 'utf8dom-file *features*)) - (*readtable* *utf8-runes-readtable*)) + (*readtable* + (symbol-value (find-symbol "*UTF8-RUNES-READTABLE*" :runes-system)))) (call-next-method))) (asdf:defsystem :cxml-dom

1 0

[cxml-cvs] CVS cxml/doc
by dlichteblau 26 May '07

26 May '07

Update of /project/cxml/cvsroot/cxml/doc In directory clnet:/tmp/cvs-serv28676/doc Modified Files: index.xml installation.xml Log Message: runes.asd neues release --- /project/cxml/cvsroot/cxml/doc/index.xml 2007/05/01 20:06:59 1.7 +++ /project/cxml/cvsroot/cxml/doc/index.xml 2007/05/26 21:55:58 1.8 @@ -51,14 +51,19 @@ <h3>See also</h3> <p> Relax NG validation is available as a separate - project: <a href="">cxml-rng</a>. + project: <a href="http://www.lichteblau.com/cxml-rng/">cxml-rng</a>. </p> <a name="changes"/> <h3>Recent Changes</h3> - <p class="nomargin"><tt>rel-2007-xx-yy</tt></p> + <p class="nomargin"><tt>rel-2007-05-26</tt></p> <ul class="nomargin"> + <li><b>cxml.asd has been split up into <tt>cxml.asd</tt> for the + XML parser and <tt>runes.asd</tt> for the runes package, in + preparation of a complete split of the two systems. Future CXML + releases will use separate tarballs for <tt>runes</tt> + and <tt>cxml</tt>.</b></li> <li>xml:base support (SAX and Klacks only, not yet used in DOM). See documentation <a href="sax.html#saxparser">here</a> and <a href="klacks.html#locator">here</a>.</li> @@ -78,6 +83,7 @@ klacks:expecting-element. Fixed serialize-event to generate start-prefix-mapping and end-prefix-mapping events. New function map-current-namespace-declarations.</li> + <li>fixed build with common-lisp-controller</li> </ul> <p class="nomargin"><tt>rel-2007-02-18</tt></p> <ul class="nomargin"> --- /project/cxml/cvsroot/cxml/doc/installation.xml 2007/03/04 18:30:41 1.2 +++ /project/cxml/cvsroot/cxml/doc/installation.xml 2007/05/26 21:55:58 1.3 @@ -47,7 +47,8 @@ <b>Compiling and loading CXML.</b> Register the .asd file, e.g. by symlinking it: </p> - <pre>$ ln -sf `pwd`/cxml.asd /path/to/your/registry/</pre> + <pre>$ ln -sf `pwd`/cxml.asd /path/to/your/registry/ +$ ln -sf `pwd`/runes.asd /path/to/your/registry/</pre> <p>Then compile CXML using:</p> <pre>* (asdf:operate 'asdf:load-op :cxml)</pre>

1 0

[cxml-cvs] CVS cxml
by dlichteblau 20 May '07

20 May '07

Update of /project/cxml/cvsroot/cxml In directory clnet:/tmp/cvs-serv1258 Modified Files: cxml.asd Log Message: workaround for common-lisp-controller --- /project/cxml/cvsroot/cxml/cxml.asd 2007/04/22 13:23:54 1.16 +++ /project/cxml/cvsroot/cxml/cxml.asd 2007/05/20 09:39:04 1.17 @@ -78,10 +78,14 @@ (defmethod output-files ((operation compile-op) (c utf8dom-file)) (let* ((normal (car (call-next-method))) - (name (concatenate 'string (pathname-name normal) "-utf8")) - (of (make-pathname :name name :defaults normal))) - (setf (slot-value c 'of) of) - (list of))) + (name (concatenate 'string (pathname-name normal) "-utf8"))) + (list (make-pathname :name name :defaults normal)))) + +;; must be an extra method because of common-lisp-controller's :around method +(defmethod output-files :around ((operation compile-op) (c utf8dom-file)) + (let ((x (call-next-method))) + (setf (slot-value c 'of) (car x)) + x)) (defmethod perform ((o load-op) (c utf8dom-file)) (load (slot-value c 'of)))

1 0

[cxml-cvs] CVS cxml/xml
by dlichteblau 20 May '07

20 May '07

Update of /project/cxml/cvsroot/cxml/xml In directory clnet:/tmp/cvs-serv1140/xml Modified Files: sax-proxy.lisp Log Message: added sax-parser-mixin to broadcast-handler --- /project/cxml/cvsroot/cxml/xml/sax-proxy.lisp 2007/04/22 13:23:55 1.5 +++ /project/cxml/cvsroot/cxml/xml/sax-proxy.lisp 2007/05/20 09:38:35 1.6 @@ -8,7 +8,7 @@ (in-package :cxml) -(defclass broadcast-handler () +(defclass broadcast-handler (sax:sax-parser-mixin) ((handlers :initform nil :initarg :handlers :accessor broadcast-handler-handlers))) @@ -59,6 +59,6 @@ (define-proxy-method sax:entity-resolver (resolver)) (define-proxy-method sax::dtd (dtd))) -(defmethod sax:register-sax-parser :after ((handler sax-proxy) parser) +(defmethod sax:register-sax-parser :after ((handler broadcast-handler) parser) (dolist (next (broadcast-handler-handlers handler)) (sax:register-sax-parser next parser)))

1 0

[cxml-cvs] CVS cxml/klacks
by dlichteblau 06 May '07

06 May '07

Update of /project/cxml/cvsroot/cxml/klacks In directory clnet:/tmp/cvs-serv17389 Modified Files: klacks-impl.lisp Log Message: nach :eof beliebig lange nil liefern --- /project/cxml/cvsroot/cxml/klacks/klacks-impl.lisp 2007/05/01 18:21:41 1.9 +++ /project/cxml/cvsroot/cxml/klacks/klacks-impl.lisp 2007/05/06 11:28:13 1.10 @@ -285,7 +285,10 @@ (with-source (source current-key current-values) (setf current-key nil) (setf current-values nil) - (labels ((klacks/done () #'klacks/done)) + (labels ((klacks/done () + (setf current-key nil) + (setf current-values nil) + #'klacks/done)) #'klacks/done))) (defun klacks/element (source input cont)

1 0

[cxml-cvs] CVS cxml/xml
by dlichteblau 01 May '07

01 May '07

Update of /project/cxml/cvsroot/cxml/xml In directory clnet:/tmp/cvs-serv10936/xml Modified Files: package.lisp unparse.lisp Log Message: Added new functions attribute*, unparse-attribute, and macro with-element*, with-namespace* to the SAX generation wrapper API. --- /project/cxml/cvsroot/cxml/xml/package.lisp 2007/04/22 13:23:55 1.15 +++ /project/cxml/cvsroot/cxml/xml/package.lisp 2007/05/01 20:07:00 1.16 @@ -50,8 +50,12 @@ #:make-character-stream-sink/utf8 #:with-xml-output + #:with-namespace #:with-element + #:with-element* #:attribute + #:attribute* + #:unparse-attribute #:cdata #:text --- /project/cxml/cvsroot/cxml/xml/unparse.lisp 2006/12/02 13:21:37 1.12 +++ /project/cxml/cvsroot/cxml/xml/unparse.lisp 2007/05/01 20:07:00 1.13 @@ -509,13 +509,17 @@ (defvar *current-element*) (defvar *sink*) +(defvar *unparse-namespace-bindings*) +(defvar *current-namespace-bindings*) (defmacro with-xml-output (sink &body body) `(invoke-with-xml-output (lambda () ,@body) ,sink)) (defun invoke-with-xml-output (fn sink) (let ((*sink* sink) - (*current-element* nil)) + (*current-element* nil) + (*unparse-namespace-bindings* *initial-namespace-bindings*) + (*current-namespace-bindings* nil)) (sax:start-document *sink*) (funcall fn) (sax:end-document *sink*))) @@ -523,37 +527,86 @@ (defmacro with-element (qname &body body) `(invoke-with-element (lambda () ,@body) ,qname)) +(defmacro with-element* ((prefix lname) &body body) + `(invoke-with-element* (lambda () ,@body) ,prefix ,lname)) + +(defmacro with-namespace ((prefix uri) &body body) + `(invoke-with-namespace (lambda () ,@body) ,prefix ,uri)) + (defun maybe-emit-start-tag () (when *current-element* ;; starting child node, need to emit opening tag of parent first: - (destructuring-bind (qname &rest attributes) *current-element* - (sax:start-element *sink* nil nil qname (reverse attributes))) + (destructuring-bind ((uri lname qname) &rest attributes) *current-element* + (sax:start-element *sink* uri lname qname (reverse attributes))) (setf *current-element* nil))) +(defun invoke-with-namespace (fn prefix uri) + (let ((*unparse-namespace-bindings* + (acons prefix uri *unparse-namespace-bindings*)) + (*current-namespace-bindings* + (acons prefix uri *current-namespace-bindings*))) + (sax:start-prefix-mapping *sink* prefix uri) + (multiple-value-prog1 + (funcall fn) + (sax:end-prefix-mapping *sink* prefix)))) + (defun invoke-with-element (fn qname) (setf qname (rod qname)) + (multiple-value-bind (prefix lname) + (split-qname qname) + (invoke-with-element* fn prefix lname qname))) + +(defun find-unparse-namespace (prefix) + (cdr (assoc prefix *unparse-namespace-bindings* :test 'equal))) + +(defun invoke-with-element* (fn prefix lname &optional qname) + (setf prefix (when prefix (rod prefix))) + (setf lname (rod lname)) (maybe-emit-start-tag) - (let ((*current-element* (list qname))) + (let* ((qname (or qname + (if prefix (concatenate 'rod prefix #":" lname) lname))) + (uri (find-unparse-namespace (or prefix #""))) + (*current-element* + (cons (list uri lname qname) + (mapcar (lambda (x) + (destructuring-bind (prefix &rest uri) x + (sax:make-attribute + :namespace-uri #"http://www.w3.org/2000/xmlns/" + :local-name prefix + :qname (if (zerop (length prefix)) + #"xmlns" + (concatenate 'rod #"xmlns:" prefix)) + :value uri))) + *current-namespace-bindings*)))) (multiple-value-prog1 - (funcall fn) + (let ((*current-namespace-bindings* nil)) + (funcall fn)) (maybe-emit-start-tag) - (sax:end-element *sink* nil nil qname)))) + (sax:end-element *sink* uri lname qname)))) -(defun attribute-1 (name value) - (push (sax:make-attribute :qname (rod name) :value (rod value)) - (cdr *current-element*)) - value) +(defgeneric unparse-attribute (value)) +(defmethod unparse-attribute ((value string)) value) +(defmethod unparse-attribute ((value null)) nil) +(defmethod unparse-attribute ((value integer)) (write-to-string value)) -(defgeneric attribute (name value)) - -(defmethod attribute (name (value string)) - (attribute-1 name value)) - -(defmethod attribute (name (value null)) - (declare (ignore name))) - -(defmethod attribute (name (value integer)) - (attribute-1 name (write-to-string value))) +(defun attribute (qname value) + (setf qname (rod qname)) + (multiple-value-bind (prefix lname) + (split-qname qname) + (attribute* prefix lname value qname))) + +(defun attribute* (prefix lname value &optional qname) + (setf value (unparse-attribute value)) + (when value + (setf prefix (when prefix (rod prefix))) + (setf lname (rod lname)) + (push (sax:make-attribute + :namespace-uri (find-unparse-namespace prefix) + :local-name lname + :qname (or qname + (if prefix (concatenate 'rod prefix #":" lname) lname)) + :value (rod value)) + (cdr *current-element*)))) (defun cdata (data) (maybe-emit-start-tag)

1 0

[cxml-cvs] CVS cxml/doc
by dlichteblau 01 May '07

01 May '07

Update of /project/cxml/cvsroot/cxml/doc In directory clnet:/tmp/cvs-serv10936/doc Modified Files: index.xml sax.xml Log Message: Added new functions attribute*, unparse-attribute, and macro with-element*, with-namespace* to the SAX generation wrapper API. --- /project/cxml/cvsroot/cxml/doc/index.xml 2007/05/01 18:21:40 1.6 +++ /project/cxml/cvsroot/cxml/doc/index.xml 2007/05/01 20:06:59 1.7 @@ -69,7 +69,9 @@ emitting them as SAX events to a user-specified handler at the same time.</li> <li>Changed attributes to carry an lname even when occurring - without a namespace.</li> + without a namespace. Added new functions attribute*, + unparse-attribute, and macro with-element*, with-namespace* to + the SAX generation wrapper API.</li> <li>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, --- /project/cxml/cvsroot/cxml/doc/sax.xml 2007/04/22 13:23:54 1.3 +++ /project/cxml/cvsroot/cxml/doc/sax.xml 2007/05/01 20:07:00 1.4 @@ -291,8 +291,12 @@ <p> <div class="def">Macro CXML:WITH-XML-OUTPUT (sink &body body) => sink-specific result</div> + <div class="def">Macro CXML:WITH-NAMESPACE ((prefix uri) &body body) => result</div> <div class="def">Macro CXML:WITH-ELEMENT (qname &body body) => result</div> - <div class="def">Function CXML:ATTRIBUTE (name value) => value</div> + <div class="def">Macro CXML:WITH-ELEMENT* ((prefix lname) &body body) => result</div> + <div class="def">Function CXML:ATTRIBUTE (qname value) => value</div> + <div class="def">Generic Function CXML:UNPARSE-ATTRIBUTE (value) => string</div> + <div class="def">Function CXML:ATTRIBUTE* (prefix lname value) => value</div> <div class="def">Function CXML:TEXT (data) => data</div> <div class="def">Function CXML:CDATA (data) => data</div> Convenience syntax for event-based serialization.

1 0

[cxml-cvs] CVS cxml/klacks
by dlichteblau 01 May '07

01 May '07

Update of /project/cxml/cvsroot/cxml/klacks In directory clnet:/tmp/cvs-serv20218/klacks Modified Files: klacks-impl.lisp klacks.lisp package.lisp tap-source.lisp Log Message: klacks:get-attribute; dribbling source fix; FAQ --- /project/cxml/cvsroot/cxml/klacks/klacks-impl.lisp 2007/04/22 13:23:55 1.8 +++ /project/cxml/cvsroot/cxml/klacks/klacks-impl.lisp 2007/05/01 18:21:41 1.9 @@ -102,6 +102,13 @@ (sax:attribute-value a) (sax:attribute-specified-p a)))) +(defmethod klacks:get-attribute + ((source cxml-source) lname &optional uri) + (dolist (a (slot-value source 'current-attributes)) + (when (and (equal (sax:attribute-local-name a) lname) + (equal (sax:attribute-namespace-uri a) uri)) + (return (sax:attribute-value a))))) + (defmethod klacks:list-attributes ((source cxml-source)) (slot-value source 'current-attributes)) --- /project/cxml/cvsroot/cxml/klacks/klacks.lisp 2007/04/22 13:23:55 1.7 +++ /project/cxml/cvsroot/cxml/klacks/klacks.lisp 2007/05/01 18:21:41 1.8 @@ -34,13 +34,13 @@ (defgeneric klacks:map-attributes (fn source)) (defgeneric klacks:list-attributes (source)) +(defgeneric klacks:get-attribute (source lname &optional uri)) ;;;(defgeneric klacks:current-uri (source)) ;;;(defgeneric klacks:current-lname (source)) ;;;(defgeneric klacks:current-qname (source)) ;;;(defgeneric klacks:current-characters (source)) (defgeneric klacks:current-cdata-section-p (source)) (defgeneric klacks:map-current-namespace-declarations (fn source)) -(defgeneric klacks:map-previous-namespace-declarations (fn source)) (defgeneric klacks:current-line-number (source)) (defgeneric klacks:current-column-number (source)) --- /project/cxml/cvsroot/cxml/klacks/package.lisp 2007/04/22 13:23:55 1.5 +++ /project/cxml/cvsroot/cxml/klacks/package.lisp 2007/05/01 18:21:41 1.6 @@ -37,6 +37,7 @@ #:map-attributes #:list-attributes + #:get-attribute #:current-uri #:current-lname #:current-qname --- /project/cxml/cvsroot/cxml/klacks/tap-source.lisp 2007/04/22 13:23:55 1.1 +++ /project/cxml/cvsroot/cxml/klacks/tap-source.lisp 2007/05/01 18:21:41 1.2 @@ -26,7 +26,8 @@ (defclass klacks:tapping-source (klacks:source) ((upstream-source :initarg :upstream-source :accessor upstream-source) (dribble-handler :initarg :dribble-handler :accessor dribble-handler) - (seen-event-p :initform nil :accessor seen-event-p))) + (seen-event-p :initform nil :accessor seen-event-p) + (document-done-p :initform nil :accessor document-done-p))) (defmethod initialize-instance :after ((instance klacks:tapping-source) &key) (let ((s-p (make-instance 'klacksax :source (upstream-source instance)))) @@ -36,7 +37,9 @@ ;;; event dribbling (defun maybe-dribble (source) - (unless (seen-event-p source) + (unless (or (seen-event-p source) (document-done-p source)) + (when (eq (klacks:peek (upstream-source source)) :end-document) + (setf (document-done-p source) t)) (klacks:serialize-event (upstream-source source) (dribble-handler source) :consume nil)

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

cxml-cvs May 2007