[bknr-cvs] r1870 - branches/xml-class-rework/bknr/src/web

[bknr at bknr.net]

Author: hhubner
Date: 2006-02-23 00:29:32 -0600 (Thu, 23 Feb 2006)
New Revision: 1870

Modified:
   branches/xml-class-rework/bknr/src/web/handlers.lisp
   branches/xml-class-rework/bknr/src/web/menu.lisp
   branches/xml-class-rework/bknr/src/web/tags.lisp
Log:
Changes to allow a BKNR site as part of another website (i.e. using Apache
with mod_proxy under a non-root URL).  To use this, the base path of the site
must be specified as :base-href argument to the created website instance.


Modified: branches/xml-class-rework/bknr/src/web/handlers.lisp
===================================================================
--- branches/xml-class-rework/bknr/src/web/handlers.lisp	2006-02-20 19:51:53 UTC (rev 1869)
+++ branches/xml-class-rework/bknr/src/web/handlers.lisp	2006-02-23 06:29:32 UTC (rev 1870)
@@ -34,6 +34,9 @@
 	       :accessor website-navigation)
    (admin-navigation :initarg :admin-navigation
 		     :accessor website-admin-navigation)
+   (base-href :initarg :base-href
+              :accessor website-base-href
+              :initform "/")
    (style-sheet-urls :initarg :style-sheet-urls
 		     :accessor website-style-sheet-urls)
    (javascript-urls :initarg :javascript-urls

Modified: branches/xml-class-rework/bknr/src/web/menu.lisp
===================================================================
--- branches/xml-class-rework/bknr/src/web/menu.lisp	2006-02-20 19:51:53 UTC (rev 1869)
+++ branches/xml-class-rework/bknr/src/web/menu.lisp	2006-02-23 06:29:32 UTC (rev 1870)
@@ -50,18 +50,19 @@
       (dolist (item (menu-items menu))
 	(let ((item-is-active (in-subtree (puri:uri-path (net.aserve:request-uri *req*)) (item-url item))))
 	  (with-slots (url title active-image inactive-image) item
-	    (cond
-	      ((and active-image inactive-image)
-	       (if item-is-active
-		   (html ((:div :class active-class)
-			  ((:img :src active-image :alt title))))
-		   (html ((:div :class inactive-class)
-			  ((:a :href url)
-			   ((:img :src inactive-image :alt title)))))))
-	      (t
-	       (if item-is-active
-		   (html ((:div :class active-class)
-			  (:princ-safe title)))
-		   (html ((:div :class inactive-class)
-			  ((:a :href url)
-			   (:princ-safe title))))))))))))))
+            (let ((link-url (format nil "~A~A" (website-base-href *website*) url)))
+              (cond
+                ((and active-image inactive-image)
+                 (if item-is-active
+                     (html ((:div :class active-class)
+                            ((:img :src active-image :alt title))))
+                     (html ((:div :class inactive-class)
+                            ((:a :href link-url)
+                             ((:img :src inactive-image :alt title)))))))
+                (t
+                 (if item-is-active
+                     (html ((:div :class active-class)
+                            (:princ-safe title)))
+                     (html ((:div :class inactive-class)
+                            ((:a :href link-url)
+                             (:princ-safe title)))))))))))))))

Modified: branches/xml-class-rework/bknr/src/web/tags.lisp
===================================================================
--- branches/xml-class-rework/bknr/src/web/tags.lisp	2006-02-20 19:51:53 UTC (rev 1869)
+++ branches/xml-class-rework/bknr/src/web/tags.lisp	2006-02-23 06:29:32 UTC (rev 1870)
@@ -183,6 +183,7 @@
 <link rel=\"stylesheet\" href=\"/static/css/dynastyle_01.css\" ....
 "
   (html
+   ((:base :href (website-base-href *website*)))
    (loop for stylesheet in (website-style-sheet-urls *website*)
 	 do (html ((:link :rel "stylesheet" :type "text/css" :href stylesheet))))
    (loop for javascript in (website-javascript-urls *website*)