Author: hhubner Date: 2007-10-06 19:06:39 -0400 (Sat, 06 Oct 2007) New Revision: 2226
Modified: branches/trunk-reorg/bknr/datastore/src/bknr-impex.asd branches/trunk-reorg/bknr/datastore/src/bknr-xml.asd branches/trunk-reorg/bknr/datastore/src/data/encoding.lisp branches/trunk-reorg/bknr/datastore/src/xml-impex/package.lisp branches/trunk-reorg/bknr/datastore/src/xml-impex/xml-export.lisp branches/trunk-reorg/bknr/datastore/src/xml/xml.lisp Log: Use :closer-mop instead of compiler-specific MOP. Fix import glitches for bknr-xml. Support character datatype for transaction log reading/writing.
Modified: branches/trunk-reorg/bknr/datastore/src/bknr-impex.asd =================================================================== --- branches/trunk-reorg/bknr/datastore/src/bknr-impex.asd 2007-10-06 21:39:22 UTC (rev 2225) +++ branches/trunk-reorg/bknr/datastore/src/bknr-impex.asd 2007-10-06 23:06:39 UTC (rev 2226) @@ -21,7 +21,7 @@ :description "BKNR XML import/export" :long-description ""
- :depends-on (:cl-interpol :cxml :bknr-utils :bknr-xml :bknr-indices) + :depends-on (:cl-interpol :cxml :closer-mop :bknr-utils :bknr-xml :bknr-indices)
:components ((:module "xml-impex" :components
Modified: branches/trunk-reorg/bknr/datastore/src/bknr-xml.asd =================================================================== --- branches/trunk-reorg/bknr/datastore/src/bknr-xml.asd 2007-10-06 21:39:22 UTC (rev 2225) +++ branches/trunk-reorg/bknr/datastore/src/bknr-xml.asd 2007-10-06 23:06:39 UTC (rev 2226) @@ -17,26 +17,5 @@ :description "baikonour - launchpad for lisp satellites" :depends-on (:cl-interpol :cxml) :components ((:module "xml" :components ((:file "package") - (:file "xml"))))) - -;; -*-Lisp-*- - -(in-package :cl-user) - -(defpackage :bknr.xml.system - (:use :cl :asdf)) - -(in-package :bknr.xml.system) - -(defsystem :bknr-xml - :name "baikonour" - :author "Hans Huebner hans@huebner.org" - :author "Manuel Odendahl manuel@bl0rg.net" - :version "0" - :maintainer "Manuel Odendahl manuel@bl0rg.net" - :licence "BSD" - :description "baikonour - launchpad for lisp satellites" - :depends-on (:cl-interpol :cxml) - :components ((:module "xml" :components ((:file "package") (:file "xml")))))
Modified: branches/trunk-reorg/bknr/datastore/src/data/encoding.lisp =================================================================== --- branches/trunk-reorg/bknr/datastore/src/data/encoding.lisp 2007-10-06 21:39:22 UTC (rev 2225) +++ branches/trunk-reorg/bknr/datastore/src/data/encoding.lisp 2007-10-06 23:06:39 UTC (rev 2226) @@ -47,6 +47,10 @@ ;;; tail object Falls n != 0: CDR des letzten Conses ;;; ;;; ---------------------------------------------------------------- +;;; Char +;;; tag #\c +;;; data char Zeichen, mit WRITE-CHAR geschrieben +;;; ---------------------------------------------------------------- ;;; String ;;; tag #\s ;;; n %integer Anzahl der folgenden Zeichen @@ -169,6 +173,10 @@ (%write-char #\l stream) (%encode-list object stream))
+(defun encode-char (object stream) + (%write-char #\c stream) + (%write-char object stream)) + (defun %encode-string (object stream) (%encode-integer (length object) stream) #+allegro @@ -263,6 +271,7 @@ (typecase object (integer (encode-integer object stream)) (symbol (encode-symbol object stream)) + (character (encode-char object stream)) (string (encode-string object stream)) (list (encode-list object stream)) (array (encode-array object stream)) @@ -301,6 +310,9 @@ (assert (plusp n)) ;n==0 geben wir nicht aus (%decode-integer/fixed stream n)))
+(defun %decode-char (stream) + (%read-char stream)) + (defun %decode-string (stream) #-allegro (let* ((n (%decode-integer stream)) @@ -395,6 +407,7 @@ (#\a (%decode-array stream)) (#\i (%decode-integer stream)) (#\y (%decode-symbol stream)) + (#\c (%decode-char stream)) (#\s (%decode-string stream)) (#\l (%decode-list stream)) (## (%decode-hash-table stream))
Modified: branches/trunk-reorg/bknr/datastore/src/xml/xml.lisp =================================================================== --- branches/trunk-reorg/bknr/datastore/src/xml/xml.lisp 2007-10-06 21:39:22 UTC (rev 2225) +++ branches/trunk-reorg/bknr/datastore/src/xml/xml.lisp 2007-10-06 23:06:39 UTC (rev 2226) @@ -61,66 +61,3 @@ (write-char #> stream) (write-char #\Newline stream))))
-(in-package :bknr.xml) - -(defun node-children-nodes (xml) - (remove-if-not #'consp (node-children xml))) - -(defun find-child (xml node-name) - (let ((children (node-children-nodes xml))) - (find node-name children :test #'string-equal :key #'node-name))) - -(defun find-children (xml node-name) - (let ((children (node-children-nodes xml))) - (find-all node-name children :test #'string-equal :key #'node-name))) - -(defun node-string-body (xml) - (let ((children (remove-if #'consp (node-children xml)))) - (if (every #'stringp children) - (apply #'concatenate 'string children) - (error "Some children are not strings")))) - -(defun node-attribute (xml attribute-name) - (cadr (assoc attribute-name (node-attrs xml) :test #'string-equal))) - -(defun node-child-string-body (xml node-name) - (let ((child (find-child xml node-name))) - (if (and child (consp child)) - (node-string-body child) - nil))) - -(defun node-to-html (node &optional (stream *standard-output*)) - (when (stringp node) - (write-string node) - (return-from node-to-html)) - (write-char #< stream) - (when (node-ns node) - (write-string (node-ns node) stream) - (write-char #: stream)) - (write-string (node-name node) stream) - (loop for (key value) in (node-attrs node) - do (write-char #\Space stream) - (write-string key stream) - (write-char #= stream) - (write-char #" stream) - (write-string value stream) - (write-char #" stream)) - (if (node-children node) - (progn - (write-char #> stream) - (write-char #\Newline stream) - (dolist (child (node-children node)) - (node-to-html child stream)) - (write-char #< stream) - (write-char #/ stream) - (when (node-ns node) - (write-string (node-ns node) stream) - (write-char #: stream)) - (write-string (node-name node) stream) - (write-char #> stream) - (write-char #\Newline stream)) - (progn (write-char #\Space stream) - (write-char #/ stream) - (write-char #> stream) - (write-char #\Newline stream)))) -
Modified: branches/trunk-reorg/bknr/datastore/src/xml-impex/package.lisp =================================================================== --- branches/trunk-reorg/bknr/datastore/src/xml-impex/package.lisp 2007-10-06 21:39:22 UTC (rev 2225) +++ branches/trunk-reorg/bknr/datastore/src/xml-impex/package.lisp 2007-10-06 23:06:39 UTC (rev 2226) @@ -6,12 +6,7 @@ :ext :cl-user :cxml - #+allegro - :aclmop - #+cmu - :pcl - #+sbcl - :sb-pcl + :closer-mop :bknr.utils :bknr.xml :bknr.indices)
Modified: branches/trunk-reorg/bknr/datastore/src/xml-impex/xml-export.lisp =================================================================== --- branches/trunk-reorg/bknr/datastore/src/xml-impex/xml-export.lisp 2007-10-06 21:39:22 UTC (rev 2225) +++ branches/trunk-reorg/bknr/datastore/src/xml-impex/xml-export.lisp 2007-10-06 23:06:39 UTC (rev 2226) @@ -39,9 +39,9 @@
(defmethod write-to-xml ((object standard-object) &key &allow-other-keys) (cxml:with-element (string-downcase (class-name (class-of object))) - (dolist (slot (pcl:class-slots (class-of object))) - (cxml:with-element (string-downcase (symbol-name (pcl:slot-definition-name slot))) - (let ((value (slot-value object (pcl:slot-definition-name slot)))) + (dolist (slot (class-slots (class-of object))) + (cxml:with-element (string-downcase (symbol-name (slot-definition-name slot))) + (let ((value (slot-value object (slot-definition-name slot)))) (when value (cxml:text (handler-case (cxml::utf8-string-to-rod (princ-to-string value))