[Page style customization
clinton@unknownlamer.org**20081230044637
 * Style information about frontend pages are stored in a persistent instance
 * Currently can edit the page background image (but not unless you
   know the filenames within the background root)
] hunk ./src/web-admin.lisp 195
-
hunk ./src/web-admin.lisp 211
+(define-html-form page-style-editor ()
+  ((name (string-field :input-size 80
+		       :validators (make-validators 'not-empty-validator)))
+   (background (string-field :input-size 80
+			     :validators (make-validators 'not-empty-validator))))
+  ((style :initarg :page-style :accessor edited-style :initform nil)))
+
+(defmethod initialize-instance :after ((e page-style-editor)
+				       &key &allow-other-keys)
+  (when-bind style (edited-style e)
+    (with-slots (name background) e
+      (setf (value name) (page-name style)
+	    (value background) (page-background style)))))
+
+(defaction process-form ((e page-style-editor))
+  (ensure-transaction ()
+    (let ((style (or (edited-style e)
+		     (make-instance 'bee-page-style))))
+      (with-slots (name background) e
+	(setf (page-name style) (intern (string-upcase (value name)) :keyword)
+	      (page-background style) (value background)))
+      (answer style))))
+
+(defcomponent page-style-list (bee-admin-list)
+  ()
+  (:default-initargs
+   :index-class 'bee-page-style
+   :index-slot 'name
+   :page-size 10
+   :reverse t))
+
+(defmethod render ((list page-style-list))
+  (<:ul
+   (mapc (lambda (page)
+	   (<:li (<ucw:a :action (call 'page-style-editor :page-style page)
+			 (<:as-html (string-downcase
+				     (symbol-name (page-name page)))))))
+	 (golgonooza:current-items list))))
+
+;; add to window
+;; optionally -- (toplevel)
+
hunk ./src/web-admin.lisp 339
+(defcomponent page-style-admin (tabbed-pane)
+  ()
+  (:default-initargs
+      :current-component-key 'list
+      :contents `((new . ,(make-instance 'toplevel :wrap 'page-style-editor))
+		  (list  . ,(make-instance 'page-style-list)))))
+
hunk ./src/web-admin.lisp 363
+				     (style . ,(make-instance 'page-style-admin))
hunk ./src/web-common.lisp 48
+(defpclass bee-page-style ()
+  ((name :initarg :name :accessor page-name :index t)
+   (background :initarg :background :initform nil :accessor page-background))
+  (:index t))
+
hunk ./src/web-frontend.lisp 3
+(defclass bee-stylable-page ()
+  ((name :initarg :name :accessor page-name)
+   (%style :initform nil)))
+
+(defmethod initialize-instance :after ((p bee-stylable-page)
+				       &key name &allow-other-keys)
+  (setf (slot-value p '%style) (get-instance-by-value 'bee-page-style
+						      'name name)))
+
+(defmethod render :before ((page bee-stylable-page))
+  (with-slots (%style) page
+    (<:style
+     (<:as-is (format nil
+		      "body { background: white url(\"~A\") no-repeat fixed 50% 50%; }"
+		      (format nil "/static/img/backgrounds/~A"
+			      (arnesi:escape-as-uri (page-background %style))))))))
+
+(defcomponent bee-frontend-page (bee-page-component bee-stylable-page)
+  ())
+
hunk ./src/web-frontend.lisp 53
-(defcomponent bee-home (bee-widget composite-container)
+(defcomponent bee-home (bee-widget composite-container bee-stylable-page)
hunk ./src/web-frontend.lisp 59
-(defcomponent bee-videos (bee-widget)
+(defcomponent bee-videos (bee-widget bee-stylable-page)
hunk ./src/web-frontend.lisp 106
-	   `((home . ,(make-instance 'bee-home))
-	     (about . ,(make-instance 'bee-page-component :name :about))
-	     (contact . ,(make-instance 'bee-page-component :name :contact))
+	   `((home . ,(make-instance 'bee-home :name :home))
+	     (about . ,(make-instance 'bee-frontend-page :name :about))
+	     (contact . ,(make-instance 'bee-frontend-page :name :contact))
hunk ./src/web-frontend.lisp 110
+				       :name :videos
hunk ./src/web-frontend.lisp 113
-	     (links . ,(make-instance 'bee-page-component :name :links))))))
+	     (links . ,(make-instance 'bee-frontend-page :name :links))))))