[bknr-cvs] r2226 - in branches/trunk-reorg/bknr/datastore/src: . data xml xml-impex
bknr at bknr.net
bknr at bknr.net
Sat Oct 6 23:06:39 UTC 2007
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 at huebner.org>"
- :author "Manuel Odendahl <manuel at bl0rg.net>"
- :version "0"
- :maintainer "Manuel Odendahl <manuel at 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))
More information about the Bknr-cvs
mailing list