[bknr-cvs] r1848 - in branches/xml-class-rework: bknr/src/web bknr/src/xml-impex projects/lisp-ecoop/src projects/lisp-ecoop/website/templates
bknr at bknr.net
bknr at bknr.net
Sun Feb 19 10:29:20 UTC 2006
Author: hhubner
Date: 2006-02-19 04:29:19 -0600 (Sun, 19 Feb 2006)
New Revision: 1848
Modified:
branches/xml-class-rework/bknr/src/web/menu.lisp
branches/xml-class-rework/bknr/src/xml-impex/xml-class.lisp
branches/xml-class-rework/bknr/src/xml-impex/xml-import.lisp
branches/xml-class-rework/projects/lisp-ecoop/src/tags.lisp
branches/xml-class-rework/projects/lisp-ecoop/website/templates/cfp.xml
branches/xml-class-rework/projects/lisp-ecoop/website/templates/contact.xml
branches/xml-class-rework/projects/lisp-ecoop/website/templates/home.xml
branches/xml-class-rework/projects/lisp-ecoop/website/templates/people.xml
branches/xml-class-rework/projects/lisp-ecoop/website/templates/schedule.xml
Log:
First workable DTD-less impex version. Parses menu definition of LISP-ECOOP
website, displays pages correctly.
Modified: branches/xml-class-rework/bknr/src/web/menu.lisp
===================================================================
--- branches/xml-class-rework/bknr/src/web/menu.lisp 2006-02-18 12:58:11 UTC (rev 1847)
+++ branches/xml-class-rework/bknr/src/web/menu.lisp 2006-02-19 10:29:19 UTC (rev 1848)
@@ -1,24 +1,14 @@
(in-package :bknr.site-menu)
-(defparameter *menu-dtd* (ext:unix-namestring (merge-pathnames #p"menu.dtd" *load-truename*)))
-
-(defclass menu-defs ()
- ((menus :initarg :menus
- :element "menu"
- :reader menu-defs-menus))
- (:metaclass xml-class)
- (:dtd-name *menu-dtd*)
- (:element "menus"))
-
(defclass menu ()
((name :initarg :name
:attribute "name"
:reader menu-name)
(items :initarg items
:element "item"
+ :containment :+
:reader menu-items))
(:metaclass xml-class)
- (:dtd-name *menu-dtd*)
(:element "menu"))
(defclass item ()
@@ -39,10 +29,9 @@
:reader item-hover-image))
(:default-initargs :inactive-image nil :active-image nil :hover-image nil)
(:metaclass xml-class)
- (:dtd-name *menu-dtd*)
(:element "item"))
-(defparameter *menu-def-classes* (mapcar #'find-class '(menu-defs menu item)))
+(defparameter *menu-def-classes* (mapcar #'find-class '(menu item)))
(defun print-menu (menu)
(format t "MENU: ~A ITEMS:~{ ~A~}~%" (menu-name menu) (mapcar #'item-url (menu-items menu))))
@@ -51,11 +40,11 @@
(search subtree-url url))
(define-bknr-tag site-menu (&key config menu-name container-class active-class inactive-class)
- (let* ((menu-defs (bknr.impex:parse-xml-file
- #+cmu (ext:unix-namestring (merge-pathnames config *default-pathname-defaults*))
- #+sbcl (sb-int:unix-namestring (merge-pathnames config *default-pathname-defaults*))
- *menu-def-classes*))
- (menu (find menu-name (menu-defs-menus menu-defs) :key #'menu-name :test #'equal)))
+ (declare (ignore menu-name))
+ (let* ((menu (bknr.impex:parse-xml-file
+ #+cmu (ext:unix-namestring (merge-pathnames config *default-pathname-defaults*))
+ #+sbcl (sb-int:unix-namestring (merge-pathnames config *default-pathname-defaults*))
+ *menu-def-classes*)))
(html
((:div :class container-class)
(dolist (item (menu-items menu))
Modified: branches/xml-class-rework/bknr/src/xml-impex/xml-class.lisp
===================================================================
--- branches/xml-class-rework/bknr/src/xml-impex/xml-class.lisp 2006-02-18 12:58:11 UTC (rev 1847)
+++ branches/xml-class-rework/bknr/src/xml-impex/xml-class.lisp 2006-02-19 10:29:19 UTC (rev 1848)
@@ -30,7 +30,9 @@
(body :initarg :body
:initform nil
:documentation "Whether the value of the slot has to be stored in the body of the class element.")
-
+ (containment :initarg :containment
+ :initform nil
+ :documentation "Containment specification for this slot, either nil, :* or :+")
(parser :initarg :parser
:initform #'identity
:documentation "Function used to parse the slot value from the XML string.")
@@ -131,7 +133,6 @@
slots))
-
(defmethod direct-slot-definition-class ((class xml-class) &key parent attribute element body &allow-other-keys)
(if (or attribute element body parent)
'xml-direct-slot-definition
@@ -165,8 +166,9 @@
(unless (or element attribute)
(error "Could not find element or attribute for slot ~A." name))))
+ ;; copy direct-slot-definition slots to effective-slot-definition
(dolist (slot '(parser serializer body id-to-object object-to-id
- parent attribute element))
+ parent attribute element containment))
(setf (slot-value normal-slot slot)
(slot-value xml-direct slot))))
Modified: branches/xml-class-rework/bknr/src/xml-impex/xml-import.lisp
===================================================================
--- branches/xml-class-rework/bknr/src/xml-impex/xml-import.lisp 2006-02-18 12:58:11 UTC (rev 1847)
+++ branches/xml-class-rework/bknr/src/xml-impex/xml-import.lisp 2006-02-19 10:29:19 UTC (rev 1848)
@@ -178,15 +178,10 @@
(defun parse-xml-file (xml-file classes &key (recoder #'cxml::rod-string)
(importer-class 'xml-class-importer))
- (let ((dtds (remove-duplicates (mapcar #'xml-class-dtd classes))))
- (when (> (length dtds) 1)
- (error "All the classes do not use the same DTD."))
- (let ((class-hash (make-hash-table :test #'equal)))
- (dolist (class classes)
- (let ((name (cxml::rod-string (cxml::elmdef-name (xml-class-element class)))))
- (setf (gethash name class-hash) class)))
- (let ((importer (make-instance importer-class
- :dtd (first dtds)
- :class-hash class-hash)))
- (cxml:parse-file xml-file (cxml:make-recoder importer recoder))
- (importer-root-elt importer)))))
+ (let ((class-hash (make-hash-table :test #'equal)))
+ (dolist (class classes)
+ (setf (gethash (xml-class-element class) class-hash) class))
+ (let ((importer (make-instance importer-class
+ :class-hash class-hash)))
+ (cxml:parse-file xml-file (cxml:make-recoder importer recoder))
+ (importer-root-elt importer))))
Modified: branches/xml-class-rework/projects/lisp-ecoop/src/tags.lisp
===================================================================
--- branches/xml-class-rework/projects/lisp-ecoop/src/tags.lisp 2006-02-18 12:58:11 UTC (rev 1847)
+++ branches/xml-class-rework/projects/lisp-ecoop/src/tags.lisp 2006-02-19 10:29:19 UTC (rev 1848)
@@ -312,3 +312,10 @@
(setf (get-template-var :object-id) (store-object-id object))
(mapc #'emit-template-node children)))
+(define-bknr-tag page (&key children name)
+ (setf (get-template-var :title) name)
+ (let* ((expander bknr.web::*template-expander*)
+ (pathname (find-template-pathname expander "toplevel"))
+ (toplevel (bknr.web::get-cached-template pathname expander))
+ (bknr.web::*toplevel-children* children))
+ (emit-template-node toplevel)))
\ No newline at end of file
Modified: branches/xml-class-rework/projects/lisp-ecoop/website/templates/cfp.xml
===================================================================
--- branches/xml-class-rework/projects/lisp-ecoop/website/templates/cfp.xml 2006-02-18 12:58:11 UTC (rev 1847)
+++ branches/xml-class-rework/projects/lisp-ecoop/website/templates/cfp.xml 2006-02-19 10:29:19 UTC (rev 1848)
@@ -1,6 +1,7 @@
<?xml version="1.0" encoding="UTF-8"?>
<?xml-stylesheet type="text/xsl" href="lisp-ecoop.xsl" ?>
-<page name="cfp">
+<lisp-ecoop:page name="cfp"
+ xmlns:lisp-ecoop="http://lisp-ecoop06.bknr.net">
<h1>Call for Participation</h1>
@@ -144,4 +145,4 @@
<li>Christophe Rhodes, <a href="http://www.goldsmiths.ac.uk/departments/computing/staff/CR.html">http://www.goldsmiths.ac.uk/departments/computing/staff/CR.html</a>, Goldsmiths Colloge, University of London, United Kingdom</li>
</ul>
-</page>
\ No newline at end of file
+</lisp-ecoop:page>
\ No newline at end of file
Modified: branches/xml-class-rework/projects/lisp-ecoop/website/templates/contact.xml
===================================================================
--- branches/xml-class-rework/projects/lisp-ecoop/website/templates/contact.xml 2006-02-18 12:58:11 UTC (rev 1847)
+++ branches/xml-class-rework/projects/lisp-ecoop/website/templates/contact.xml 2006-02-19 10:29:19 UTC (rev 1848)
@@ -1,9 +1,10 @@
<?xml version="1.0" encoding="UTF-8"?>
<?xml-stylesheet type="text/xsl" href="lisp-ecoop.xsl" ?>
-<page name="contact">
+<lisp-ecoop:page name="contact"
+ xmlns:lisp-ecoop="http://lisp-ecoop06.bknr.net">
<h1>Contact</h1>
<p>Workshop related: <a href="mailto:pc at p-cos.net">Pascal Costanza</a></p>
<p>Website related: <a href="mailto:hans at bknr.net">Hans Hübner</a></p>
-</page>
+</lisp-ecoop:page>
Modified: branches/xml-class-rework/projects/lisp-ecoop/website/templates/home.xml
===================================================================
--- branches/xml-class-rework/projects/lisp-ecoop/website/templates/home.xml 2006-02-18 12:58:11 UTC (rev 1847)
+++ branches/xml-class-rework/projects/lisp-ecoop/website/templates/home.xml 2006-02-19 10:29:19 UTC (rev 1848)
@@ -1,6 +1,7 @@
<?xml version="1.0" encoding="UTF-8"?>
<?xml-stylesheet type="text/xsl" href="lisp-ecoop.xsl" ?>
-<page name="home">
+<lisp-ecoop:page name="home"
+ xmlns:lisp-ecoop="http://lisp-ecoop06.bknr.net">
<p>Welcome to the Website of the 3rd European Lisp
Workshop. Please see the <a href="cfp">Call for Participation</a> for a
@@ -44,4 +45,4 @@
</div>
-->
-</page>
+</lisp-ecoop:page>
Modified: branches/xml-class-rework/projects/lisp-ecoop/website/templates/people.xml
===================================================================
--- branches/xml-class-rework/projects/lisp-ecoop/website/templates/people.xml 2006-02-18 12:58:11 UTC (rev 1847)
+++ branches/xml-class-rework/projects/lisp-ecoop/website/templates/people.xml 2006-02-19 10:29:19 UTC (rev 1848)
@@ -1,6 +1,7 @@
<?xml version="1.0" encoding="UTF-8"?>
<?xml-stylesheet type="text/xsl" href="lisp-ecoop.xsl" ?>
-<page name="people">
+<lisp-ecoop:page name="people"
+ xmlns:lisp-ecoop="http://lisp-ecoop06.bknr.net">
<h1>People</h1>
@@ -9,4 +10,4 @@
<lisp-ecoop:participant-list />
-</page>
+</lisp-ecoop:page>
Modified: branches/xml-class-rework/projects/lisp-ecoop/website/templates/schedule.xml
===================================================================
--- branches/xml-class-rework/projects/lisp-ecoop/website/templates/schedule.xml 2006-02-18 12:58:11 UTC (rev 1847)
+++ branches/xml-class-rework/projects/lisp-ecoop/website/templates/schedule.xml 2006-02-19 10:29:19 UTC (rev 1848)
@@ -1,6 +1,7 @@
<?xml version="1.0" encoding="UTF-8"?>
<?xml-stylesheet type="text/xsl" href="lisp-ecoop.xsl" ?>
-<page name="schedule">
+<lisp-ecoop:page name="schedule"
+ xmlns:lisp-ecoop="http://lisp-ecoop06.bknr.net">
<lisp-ecoop:admin-only>
<lisp-ecoop:schedule-submission />
@@ -21,7 +22,7 @@
<h2>Tuesday, July 4, 2006</h2>
<table>
<tr><th>Time</th><th>Event</th></tr>
- <lisp-ecoop:show-day-schedule day="03-07-2006">
+ <lisp-ecoop:show-day-schedule day="04-07-2006">
<tr><td><lisp-ecoop:time/></td><td><lisp-ecoop:content/></td></tr>
</lisp-ecoop:show-day-schedule>
</table>
@@ -53,4 +54,4 @@
<input type="submit" value="add to schedule" />
</form>
</lisp-ecoop:admin-only>
-</page>
+</lisp-ecoop:page>
More information about the Bknr-cvs
mailing list