[bknr-cvs] r2451 - in branches/trunk-reorg/bknr: datastore/src/data datastore/src/utils web/src web/src/rss web/src/web

hhubner at common-lisp.net hhubner at common-lisp.net
Thu Feb 7 08:30:36 UTC 2008


Author: hhubner
Date: Thu Feb  7 03:30:34 2008
New Revision: 2451

Modified:
   branches/trunk-reorg/bknr/datastore/src/data/object.lisp
   branches/trunk-reorg/bknr/datastore/src/utils/utils.lisp
   branches/trunk-reorg/bknr/web/src/bknr-web.asd
   branches/trunk-reorg/bknr/web/src/packages.lisp
   branches/trunk-reorg/bknr/web/src/rss/rss.lisp
   branches/trunk-reorg/bknr/web/src/web/handlers.lisp
   branches/trunk-reorg/bknr/web/src/web/host.lisp
   branches/trunk-reorg/bknr/web/src/web/template-handler.lisp
Log:
save current state

Modified: branches/trunk-reorg/bknr/datastore/src/data/object.lisp
==============================================================================
--- branches/trunk-reorg/bknr/datastore/src/data/object.lisp	(original)
+++ branches/trunk-reorg/bknr/datastore/src/data/object.lisp	Thu Feb  7 03:30:34 2008
@@ -574,8 +574,7 @@
 			    (if restoring
 				(remove-transient-slot-initargs (find-class class-name) initargs)
 				initargs)))
-	   (unless restoring
-	     (initialize-persistent-instance obj))
+	   (initialize-persistent-instance obj)
 	   (initialize-transient-instance obj)
 	   (setf error nil)
 	   obj)

Modified: branches/trunk-reorg/bknr/datastore/src/utils/utils.lisp
==============================================================================
--- branches/trunk-reorg/bknr/datastore/src/utils/utils.lisp	(original)
+++ branches/trunk-reorg/bknr/datastore/src/utils/utils.lisp	Thu Feb  7 03:30:34 2008
@@ -511,7 +511,7 @@
   (with-open-file (s pathname :element-type '(unsigned-byte 8))
     (let ((result
            (make-array (file-length s) :element-type '(unsigned-byte 8))))
-      (read-sequence result s )
+      (read-sequence result s)
       result)))
 
 (defun class-subclasses (class)

Modified: branches/trunk-reorg/bknr/web/src/bknr-web.asd
==============================================================================
--- branches/trunk-reorg/bknr/web/src/bknr-web.asd	(original)
+++ branches/trunk-reorg/bknr/web/src/bknr-web.asd	Thu Feb  7 03:30:34 2008
@@ -31,6 +31,7 @@
 		 :hunchentoot
 		 :xhtmlgen
 		 :puri
+		 :usocket
 		 :bknr-datastore
 		 :bknr-data-impex
 		 :parenscript)

Modified: branches/trunk-reorg/bknr/web/src/packages.lisp
==============================================================================
--- branches/trunk-reorg/bknr/web/src/packages.lisp	(original)
+++ branches/trunk-reorg/bknr/web/src/packages.lisp	Thu Feb  7 03:30:34 2008
@@ -263,6 +263,7 @@
 
 	   ;; templates
 	   #:expand-template
+	   #:expand-variables
 	   #:get-template-var
 	   #:with-template-vars
 	   #:emit-template-node
@@ -313,6 +314,7 @@
 	   #:object-handler
 	   #:edit-object-handler
 	   #:template-handler
+	   #:template-handler-destination
 	   #:page-handler
 	   #:page-handler-prefix
 	   #:page-handler-site

Modified: branches/trunk-reorg/bknr/web/src/rss/rss.lisp
==============================================================================
--- branches/trunk-reorg/bknr/web/src/rss/rss.lisp	(original)
+++ branches/trunk-reorg/bknr/web/src/rss/rss.lisp	Thu Feb  7 03:30:34 2008
@@ -129,7 +129,7 @@
   (remove-item (rss-item-channel rss-item) rss-item))
 
 (defun item-slot-element (item slot-name)
-  (let ((accessor (kmrcl:concat-symbol-pkg (find-package :bknr.rss) 'rss-item- slot-name)))
+  (let ((accessor (find-symbol (format nil "RSS-ITEM-~A" slot-name) (find-package :bknr.rss))))
     (aif (funcall accessor item)
 	 (with-element (string-downcase (symbol-name slot-name))
 	   (text it)))))

Modified: branches/trunk-reorg/bknr/web/src/web/handlers.lisp
==============================================================================
--- branches/trunk-reorg/bknr/web/src/web/handlers.lisp	(original)
+++ branches/trunk-reorg/bknr/web/src/web/handlers.lisp	Thu Feb  7 03:30:34 2008
@@ -557,4 +557,4 @@
 
 (defun unpublish ()
   (setf *dispatch-table* (remove 'bknr-handler *dispatch-table*)
-	*handlers* nil))
\ No newline at end of file
+	*handlers* nil))

Modified: branches/trunk-reorg/bknr/web/src/web/host.lisp
==============================================================================
--- branches/trunk-reorg/bknr/web/src/web/host.lisp	(original)
+++ branches/trunk-reorg/bknr/web/src/web/host.lisp	Thu Feb  7 03:30:34 2008
@@ -46,11 +46,11 @@
     (host-ip-address host)))
 
 (defmethod host-ipaddr ((host host))
-  (kmrcl::dotted-to-ipaddr (host-ip-address host)))
+  (usocket:host-byte-order (host-ip-address host)))
 
 (defun find-host (&key ip-address create ipaddr)
   (when ipaddr
-    (setf ip-address (kmrcl::ipaddr-to-dotted ipaddr)))
+    (setf ip-address (usocket:hbo-to-dotted-quad ipaddr)))
   (or (host-with-ipaddress ip-address)
       (and create
 	   (make-object 'host :ip-address ip-address))))

Modified: branches/trunk-reorg/bknr/web/src/web/template-handler.lisp
==============================================================================
--- branches/trunk-reorg/bknr/web/src/web/template-handler.lisp	(original)
+++ branches/trunk-reorg/bknr/web/src/web/template-handler.lisp	Thu Feb  7 03:30:34 2008
@@ -92,7 +92,7 @@
                            ,(intern (symbol-name var) :keyword)))))
     , at body))
 
-(defun expand-variables (string)
+(defun expand-variables (string lookup-variable)
   (if (find #\$ string)
       (regex-replace-all
        #?r"\$\(([\*_-\w]+)\)" string
@@ -101,7 +101,7 @@
 	   (let* ((var (make-keyword-from-string
 			(subseq target-string (aref reg-starts 0)
 				(aref reg-ends 0))))
-		  (val (get-template-var var)))
+		  (val (funcall lookup-variable var)))
 	     (cond
 	       ((stringp val) val)
 	       ((null val) "")
@@ -136,7 +136,7 @@
 
 (defun emit-template-node (expander node)
   (if (stringp node)
-      (sax:characters *html-sink* (expand-variables node))
+      (sax:characters *html-sink* (expand-variables node #'get-template-var))
       (let* ((name (node-name node))
              (ns (node-ns node))
              (children (node-children node))
@@ -148,10 +148,10 @@
 	     (apply (find-tag-function expander name ns)
 		    (append (loop for (key name) in attrs
 				  collect (make-keyword-from-string key)
-				  collect (expand-variables name))))))
+				  collect (expand-variables name #'get-template-var))))))
           (t
            (sax:start-element *html-sink* nil nil name
-                              (xmls-attributes-to-sax #'expand-variables attrs))
+                              (xmls-attributes-to-sax (rcurry #'expand-variables #'get-template-var) attrs))
            (dolist (child children)
              (emit-template-node expander child))
            (sax:end-element *html-sink* nil nil name))))))



More information about the Bknr-cvs mailing list