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@p-cos.net">Pascal Costanza</a></p> <p>Website related: <a href="mailto:hans@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>