[Clean up source
clinton@unknownlamer.org**20091208210047
 Ignore-this: 14f2e925cf2f3bf457400ad39d189aee
 Of course, stupid me forgot to use `darcs mv' and just did the renames
 by hand... blech
] hunk ./beesknees.asd 12
-     (:file "authentication" :depends-on ("packages"))
-     (:file "applications" :depends-on ("packages" "authentication"))
-     (:file "weblog" :depends-on ("packages"))
-     (:file "video-gallery" :depends-on ("packages"))
-     (:file "bee-page" :depends-on ("packages"))
-     (:file "image-manager" :depends-on ("packages"))
-     (:file "web-common" :depends-on ("packages" "bee-page"))
-     (:file "frontend-weblog" :depends-on ("packages" "weblog" "web-common"))
-     (:file "frontend-videos" :depends-on ("packages" "video-gallery" "web-common"))
-     (:file "web-frontend" :depends-on ("packages" "web-common"
-					"frontend-weblog" "frontend-videos"))
-     (:file "markdown-editor" :depends-on ("packages" "web-common"))
-     (:file "admin-common" :depends-on ("packages" "web-common"))
-     (:file "admin-videos" :depends-on ("packages" "admin-common"
-					"video-gallery"))
-     (:file "admin-weblog" :depends-on ("packages" "admin-common"
-					"markdown-editor" "weblog"))
-     (:file "web-admin" :depends-on ("packages" "admin-common"
-				     "admin-weblog" "admin-videos"
-				     "markdown-editor" "image-manager"))
-     (:file "site-control" :depends-on ("packages")))))
+     (:module :core
+	      :components ((:file "authentication")
+			   (:file "applications" :depends-on ("authentication"))
+			   (:file "site-control"))
+	      :depends-on ("packages"))
+     (:module :video
+	      :components ((:file "youtube"))
+	      :depends-on ("packages"))
+     (:module :web
+	      :components ((:file "bee-page")
+			   (:file "common" :depends-on ("bee-page")))
+	      :depends-on ("packages"))
+     (:module :weblog
+	      :components ((:file "core")
+			   (:file "image-manager")
+			   (:file "markdown-editor"))
+	      :depends-on ("packages"))
+     (:module :admin
+	      :components ((:file "common")
+			   (:file "videos" :depends-on ("common"))
+			   (:file "weblog" :depends-on ("common"))
+			   (:file "web" :depends-on ("common" "weblog"
+						     "videos")))
+	      :depends-on (:core :web :video :weblog))
+     (:module :frontend
+	      :components ((:file "weblog")
+			   (:file "videos")
+			   (:file "web" :depends-on ("weblog" "videos")))
+	      :depends-on (:core :web :video :weblog)))))
adddir ./src/admin
hunk ./src/admin-common.lisp 1
-(in-package :beesknees.web)
-
-(defcomponent bee-admin-pane (tabbed-pane)
-  ())
-
-(defcomponent bee-admin-list (golgonooza:query-paged-view-mixin
-			      golgonooza-db:elephant-query-view-mixin
-			      golgonooza:query-view)
-  ())
-
-(defmethod render ((list bee-admin-list))
-  (<:ul (mapc (lambda (entry)
-		(<:li (golgonooza:render-query-view-result entry list)))
-	      (golgonooza:current-items list))))
-
-(defcomponent toplevel (task-component)
-  ((wrapped-class :initarg :wrap :accessor wrapped-class)))
-
-(defaction start ((c toplevel))
-  (loop (call (wrapped-class c))))
-
-(defclass image-selector-field (select-field)
-  ((path :initarg :image-directory :accessor image-directory-path))
-  (:default-initargs :test-fn #'string=))
-
-(defmethod ucw-forms:data-set ((field image-selector-field))
-  (mapcar (lambda (p)
-	    (format nil "~A.~A" (pathname-name p)
-		    (pathname-type p)))
-	  (directory (image-directory-path field))))
rmfile ./src/admin-common.lisp
hunk ./src/admin-videos.lisp 1
-(in-package :beesknees.web)
-
-(define-html-form video-editor ()
-  ((title (string-field :input-size 80
-			:validators (make-validators 'not-empty-validator)))
-   (youtube-id (string-field :input-size 11
-			     :validators (make-validators 'not-empty-validator)))
-   (thumbnail (image-selector-field
-	       :image-directory (merge-pathnames
-				 "wwwroot/img/thumbnails/*.*"
-				 beesknees.site-control::*bee-data-root*))))
-  ((video :initarg :video :accessor edited-video :initform nil)))
-
-(defmethod initialize-instance :after ((editor video-editor) &rest keys)
-  (declare (ignore keys))
-  (when-bind video (edited-video editor)
-    (with-slots (title youtube-id thumbnail)
-	editor
-      (setf (value title) (beesknees.videos:title video)
-	    (value youtube-id) (beesknees.videos:youtube-id video)
-	    (value thumbnail) (beesknees.videos:thumbnail video)))))
-
-(defaction process-form ((editor video-editor))
-  (elephant:ensure-transaction ()
-    (let ((video (or (edited-video editor)
-		     (make-instance 'beesknees.videos:youtube-video))))
-      (with-slots (title youtube-id thumbnail)
-	  editor
-	(setf (beesknees.videos:title video) (value title)
-	      (beesknees.videos:youtube-id video) (value youtube-id)
-	      (beesknees.videos:thumbnail video) (value thumbnail)))
-      (answer video))))
-
-(defcomponent video-list (bee-admin-list)
-  ()
-  (:default-initargs
-   :index-class 'beesknees.videos:youtube-video
-   :index-slot 'beesknees.videos:youtube-id
-   :page-size 10
-   :reverse t))
-
-(defmethod golgonooza:render-query-view-result ((video beesknees.videos:youtube-video)
-						(list video-list))
-  (<ucw:a :action (call 'video-editor :video video)
-	  (<:as-html (beesknees.videos:title video))))
+
rmfile ./src/admin-videos.lisp
hunk ./src/admin-weblog.lisp 1
-(in-package :beesknees.web)
-
-(define-html-form weblog-entry-editor (markdown-content-editor)
-  ((title (string-field :input-size 80
-			:validators (make-validators 'not-empty-validator))))
-  ((entry :initarg :entry :accessor edited-entry :initform nil))
-  (:default-initargs :field-order '(title content)))
-
-(defmethod initialize-instance :after ((editor weblog-entry-editor) &rest keys)
-  (declare (ignore keys))
-  (when-bind entry (edited-entry editor)
-    (with-slots (title content)
-	editor
-      (setf (value title)   (beesknees.weblog:entry-title entry)
-	    (value content) (beesknees.weblog:entry-body entry)))))
-
-(defaction process-form ((editor weblog-entry-editor))
-  (elephant:ensure-transaction ()
-    (let ((entry (or (edited-entry editor)
-		     (make-instance 'beesknees.weblog:weblog-entry
-				    :posted (get-universal-time)
-				    :author (session-user)))))
-      (with-slots (title content)
-	  editor
-	(setf (beesknees.weblog:entry-title entry) (value title)
-	      (beesknees.weblog:entry-body entry)  (value content)))
-      (answer entry))))
-
-(defcomponent weblog-comment-review (golgonooza:query-keyed-view-mixin
-				     golgonooza-db:elephant-query-view-mixin
-				     golgonooza:query-view)
-  ()
-  (:default-initargs
-    :index-class 'beesknees.weblog:weblog-comment
-    :index-slot 'beesknees.weblog::parent))
-
-(defmethod render ((cr weblog-comment-review))
-  (labels ((render-comment (comment)
-	     (<:li
-	      (<:progn
-		(<:ah (beesknees.weblog:comment-title comment))
-		(<:ah " by ")
-		(<:ah (beesknees.weblog:comment-author comment))
-		(<ucw:form
-		 :action (refresh-component list)
-		 :method "post"
-		 :style "display: inline;"
-		 (<ucw:submit :action (call 'markdown-preview
-					    :text (beesknees.weblog:comment-body comment))
-			      :value "View Body")
-		 (<ucw:submit :action (elephant:drop-instances (list comment))
-			      "Delete")))
-	      (when-bind children (beesknees.weblog:child-comments comment)
-			 (<:ul (mapc #'render-comment children))))))
-    (<:ul (mapc #'render-comment (golgonooza:current-items cr)))
-    (<ucw:a :action (answer) (<:ah "Ok"))))
-
-(defcomponent weblog-entry-list (bee-admin-list)
-  ()
-  (:default-initargs
-   :index-class 'beesknees.weblog:weblog-entry
-   :index-slot 'beesknees.weblog::posted
-   :page-size 10
-   :reverse t))
-
-(defmethod golgonooza:render-query-view-result ((entry weblog-entry)
-						(list bee-admin-list))
-  (<:progn (<:format "~A by ~A: "
-		     (metatilities:date-and-time-string
-		      (entry-posted entry))
-		     (beesknees.auth:username (entry-author entry)))
-	   (<ucw:a :action (call 'weblog-entry-editor :entry entry)
-		   (<:ah (entry-title entry)))
-	   (<ucw:form :action (refresh-component list)
-		      :method "post"
-		      :style "display: inline;"
-		      (<ucw:submit :action (call 'weblog-comment-review
-						 :query-key entry)
-				   "Comments")
-		      (<ucw:submit :action (elephant:drop-instances (list entry))
-				   "Delete"))))
-
-(defmethod render :after ((self bee-admin-list))
-  ;; mark with css classes
-  (<:p :class "ranged-show-list-pager"
-       (<:format "Page ~D of ~D"
-		 (1+ (golgonooza:page-offset self))
-		 (1+ (golgonooza:page-count self)))
-       (<:as-html " ")
-       (if (golgonooza:have-previous-page-p self)
-	   (<ucw:a :action (golgonooza:scroll-backward self)
-		   (<:as-html "Previous"))
-	   (<:as-html "Previous"))
-       (<:as-html " ")
-       (if (golgonooza:have-next-page-p self)
-	   (<ucw:a :action (golgonooza:scroll-forward self)
-		   (<:as-html "Next"))
-	   (<:as-html "Next"))
-       (<:as-html " ")
-       (<ucw:a :action (golgonooza:scroll-start self)
-	       (<:as-html "First"))
-       (<:as-html " ")      
-       (<ucw:a :action (golgonooza:scroll-end self)
-	       (<:as-html "Last"))))
rmfile ./src/admin-weblog.lisp
addfile ./src/admin/common.lisp
hunk ./src/admin/common.lisp 1
+(in-package :beesknees.web)
+
+(defcomponent bee-admin-pane (tabbed-pane)
+  ())
+
+(defcomponent bee-admin-list (golgonooza:query-paged-view-mixin
+			      golgonooza-db:elephant-query-view-mixin
+			      golgonooza:query-view)
+  ())
+
+(defmethod render ((list bee-admin-list))
+  (<:ul (mapc (lambda (entry)
+		(<:li (golgonooza:render-query-view-result entry list)))
+	      (golgonooza:current-items list))))
+
+(defcomponent toplevel (task-component)
+  ((wrapped-class :initarg :wrap :accessor wrapped-class)))
+
+(defaction start ((c toplevel))
+  (loop (ucw::with-transaction ()
+	  (call (wrapped-class c)))
+     (break "toplevel: after transaction")))
+
+(defclass image-selector-field (select-field)
+  ((path :initarg :image-directory :accessor image-directory-path))
+  (:default-initargs :test-fn #'string=))
+
+(defmethod ucw-forms:data-set ((field image-selector-field))
+  (mapcar (lambda (p)
+	    (format nil "~A.~A" (pathname-name p)
+		    (pathname-type p)))
+	  (directory (image-directory-path field))))
addfile ./src/admin/videos.lisp
hunk ./src/admin/videos.lisp 1
-
+(in-package :beesknees.web)
+
+(define-html-form video-editor ()
+  ((title (string-field :input-size 80
+			:validators (make-validators 'not-empty-validator)))
+   (youtube-id (string-field :input-size 11
+			     :validators (make-validators 'not-empty-validator)))
+   (thumbnail (image-selector-field
+	       :image-directory (merge-pathnames
+				 "wwwroot/img/thumbnails/*.*"
+				 beesknees.site-control::*bee-data-root*))))
+  ((video :initarg :video :accessor edited-video :initform nil)))
+
+(defmethod initialize-instance :after ((editor video-editor) &rest keys)
+  (declare (ignore keys))
+  (when-bind video (edited-video editor)
+    (with-slots (title youtube-id thumbnail)
+	editor
+      (setf (value title) (beesknees.videos:title video)
+	    (value youtube-id) (beesknees.videos:youtube-id video)
+	    (value thumbnail) (beesknees.videos:thumbnail video)))))
+
+(defaction process-form ((editor video-editor))
+  (elephant:ensure-transaction ()
+    (let ((video (or (edited-video editor)
+		     (make-instance 'beesknees.videos:youtube-video))))
+      (with-slots (title youtube-id thumbnail)
+	  editor
+	(setf (beesknees.videos:title video) (value title)
+	      (beesknees.videos:youtube-id video) (value youtube-id)
+	      (beesknees.videos:thumbnail video) (value thumbnail)))
+      (answer video))))
+
+(defcomponent video-list (bee-admin-list)
+  ()
+  (:default-initargs
+   :index-class 'beesknees.videos:youtube-video
+   :index-slot 'beesknees.videos:youtube-id
+   :page-size 10
+   :reverse t))
+
+(defmethod golgonooza:render-query-view-result ((video beesknees.videos:youtube-video)
+						(list video-list))
+  (<ucw:a :action (call 'video-editor :video video)
+	  (<:as-html (beesknees.videos:title video))))
addfile ./src/admin/web.lisp
hunk ./src/admin/web.lisp 1
+(in-package :beesknees.web)
+
+(define-html-form page-editor (markdown-content-editor)
+  ((name (string-field :input-size 80
+		       :validators (make-validators 'not-empty-validator))))
+  ((page :initarg :page :accessor edited-page :initform nil))
+  (:default-initargs :field-order '(name content)))
+
+(defmethod initialize-instance :after ((editor page-editor) &rest keys)
+  (declare (ignore keys))
+  (when-bind page (edited-page editor)
+    (with-slots (name content)
+	editor
+      (setf (value name)    (symbol-name (page-name page))
+	    (value content) (page-content page)))))
+
+(defaction process-form ((editor page-editor))
+  (elephant:ensure-transaction ()
+    (let ((page (or (edited-page editor)
+		     (make-instance 'bee-page))))
+      (with-slots (name content)
+	  editor
+	(setf (page-name page)    (intern (string-upcase (value name)) :keyword)
+	      (page-content page) (value content)))
+      (answer page))))
+
+(defmethod render :after ((e page-editor))
+  (<ucw:script
+   `(.droppable ($ "#content-editor")
+		(ps:create
+		 :accept ".droppable-image-link"
+		 :drop (lambda (event ui)
+			 (let* ((text (.text ($ this)))
+				(before (.substring
+					 text 0 ui.element[0].selection-start))
+				(after (.substr
+					text ui.element[0].selection-end)))
+			   (.append (.empty ($ this))
+				    (+ before
+				       (.data ui.draggable "markdown-text")
+				       after))))))))
+
+(defcomponent page-list (bee-admin-list)
+  ()
+  (:default-initargs
+   :index-class 'bee-page
+   :index-slot 'beesknees.pages::name
+   :page-size 10
+   :reverse nil))
+
+(defmethod golgonooza:render-query-view-result ((page bee-page)
+						(list bee-admin-list))
+  (<ucw:a :action (progn (ucw::with-transaction ()
+			   (call 'page-editor :page page)
+			   (break "after page editor call"))
+			 (break "page-editor: after transaction"))
+	  (<:as-html (string-downcase
+		      (symbol-name (page-name page))))))
+
+(define-html-form page-style-editor ()
+  ((name (string-field :input-size 80
+		       :validators (make-validators 'not-empty-validator)))
+   (background (image-selector-field
+		:image-directory (merge-pathnames
+				  "wwwroot/img/backgrounds/*.*"
+				  beesknees.site-control::*bee-data-root*)
+		: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 golgonooza:render-query-view-result ((page bee-page-style)
+						(list bee-admin-list))
+  (<ucw:a :action (call 'page-style-editor :page-style page)
+	  (<:as-html (string-downcase
+		      (symbol-name (page-name page))))))
+
+;; add to window
+;; optionally -- (toplevel)
+
+(defclass fields-not-equal (form-validator)
+  ((field-1 :initarg :field-1)
+   (field-2 :initarg :field-2)
+   (equal-predicate :initarg :equalp :initform #'equalp)))
+
+(defmethod validate ((form simple-form) (validator fields-not-equal))
+  (with-slots (field-1 field-2 equal-predicate) validator
+    (funcall equal-predicate
+	     (value (slot-value form field-1))
+	     (value (slot-value form field-2)))))
+
+(define-html-form password-change ()
+    ((current-password (password-field
+			:validators (make-validators 'not-empty-validator)))
+     (new-password-1 (password-field
+		      :validators (make-validators 'not-empty-validator)
+		      :initially-validate nil))
+     (new-password-2 (password-field
+		      :validators (make-validators 'not-empty-validator)
+		      :initially-validate nil)))
+    ((user :initarg :user))
+    (:validators (fields-not-equal
+		  :field-1 'new-password-1
+		  :field-2 'new-password-2
+		  :message "New passwords do not match")
+		 (user-password-correct
+		  :field 'current-password
+		  :message "Current password is incorrect")))
+
+(defclass user-password-correct (form-validator)
+  ())
+
+(defmethod validate ((form password-change)
+		     (validator user-password-correct))
+  (with-slots (user) form
+    (beesknees.auth:check-password user (client-value
+					 (slot-value form
+						     (slot-value validator 'ucw-simple-form::field))))))
+
+(defmethod render :before ((self password-change))
+  (unless (slot-boundp self 'user)
+    (setf (slot-value self 'user) (session-user)))
+  (<:h1 (<:format "Change password for ~A"
+		 (beesknees.auth:username (slot-value self 'user)))))
+
+(defaction process-form ((self password-change))
+  (with-slots (user current-password new-password-1 new-password-2)
+      self
+    (cond ((and (beesknees.auth:check-password user (value current-password))
+		(string= (value new-password-1) (value new-password-2)))
+	   (setf (beesknees.auth:password user) (value new-password-1))
+	   (exit-user self)))))
+
+;; User List
+
+(defcomponent admin-user-list (bee-admin-list)
+  ()
+  (:default-initargs
+      :index-class 'beesknees.auth:user :index-slot 'beesknees.auth:username))
+
+(defmethod golgonooza:render-query-view-result ((user beesknees.auth:user)
+						(list bee-admin-list))
+  (<:as-html (beesknees.auth:username user)))
+
+(defcomponent user-logout (bee-widget)
+  ())
+
+(defmethod render ((c user-logout))
+  (<:p (<ucw:a :action (exit-user c) (<:as-html "Logout"))))
+
+(defcomponent weblog-admin (tabbed-pane)
+  ()
+  (:default-initargs
+      :current-component-key 'list
+      :contents `((list  . ,(make-instance 'weblog-entry-list))
+		  (new . ,(make-instance 'toplevel :wrap 'weblog-entry-editor)))))
+
+(defcomponent page-style-admin (tabbed-pane)
+  ()
+  (:default-initargs
+      :current-component-key 'list
+      :contents `((list  . ,(make-instance 'page-style-list))
+		  (new . ,(make-instance 'toplevel :wrap 'page-style-editor)))))
+
+(defcomponent page-admin (tabbed-pane)
+  ()
+  (:default-initargs
+      :current-component-key 'list
+      :contents `((list  . ,(make-instance 'page-list))
+		  (new . ,(make-instance 'toplevel :wrap 'page-editor))
+		  (style . ,(make-instance 'page-style-admin)))))
+
+(defcomponent user-admin (tabbed-pane)
+  ()
+  (:default-initargs
+      :current-component-key 'logout
+    :contents `((logout   . ,(make-instance 'user-logout))
+		(password . ,(make-instance 'password-change))
+		(manage   . ,(make-instance 'admin-user-list)))))
+
+(defcomponent video-admin (tabbed-pane)
+  ()
+  (:default-initargs
+    :current-component-key 'list
+    :contents `((list . ,(make-instance 'video-list))
+		(new . ,(make-instance 'toplevel :wrap 'video-editor)))))
+
+(defcomponent bee-admin-window (bee-window)
+  ()
+  (:default-initargs
+    :stylesheet '("static/css/admin.css")
+    :javascript '((:src "static/js/jquery/jquery-1.2.6.js"))
+    :body (make-instance 'bee-admin-pane
+			 :current-component-key 'weblog
+			 :contents `((weblog . ,(make-instance 'weblog-admin))
+				     (pages . ,(make-instance 'page-admin))
+				     (videos . ,(make-instance 'video-admin))
+				     (users . ,(make-instance 'user-admin))))))
addfile ./src/admin/weblog.lisp
hunk ./src/admin/weblog.lisp 1
+(in-package :beesknees.web)
+
+(define-html-form weblog-entry-editor (markdown-content-editor)
+  ((title (string-field :input-size 80
+			:validators (make-validators 'not-empty-validator))))
+  ((entry :initarg :entry :accessor edited-entry :initform nil))
+  (:default-initargs :field-order '(title content)))
+
+(defmethod initialize-instance :after ((editor weblog-entry-editor) &rest keys)
+  (declare (ignore keys))
+  (when-bind entry (edited-entry editor)
+    (with-slots (title content)
+	editor
+      (setf (value title)   (beesknees.weblog:entry-title entry)
+	    (value content) (beesknees.weblog:entry-body entry)))))
+
+(defaction process-form ((editor weblog-entry-editor))
+  (elephant:ensure-transaction ()
+    (let ((entry (or (edited-entry editor)
+		     (make-instance 'beesknees.weblog:weblog-entry
+				    :posted (get-universal-time)
+				    :author (session-user)))))
+      (with-slots (title content)
+	  editor
+	(setf (beesknees.weblog:entry-title entry) (value title)
+	      (beesknees.weblog:entry-body entry)  (value content)))
+      (answer entry))))
+
+(defcomponent weblog-comment-review (golgonooza:query-keyed-view-mixin
+				     golgonooza-db:elephant-query-view-mixin
+				     golgonooza:query-view)
+  ()
+  (:default-initargs
+    :index-class 'beesknees.weblog:weblog-comment
+    :index-slot 'beesknees.weblog::parent))
+
+(defmethod render ((cr weblog-comment-review))
+  (labels ((render-comment (comment)
+	     (<:li
+	      (<:progn
+		(<:ah (beesknees.weblog:comment-title comment))
+		(<:ah " by ")
+		(<:ah (beesknees.weblog:comment-author comment))
+		(<ucw:form
+		 :action (refresh-component list)
+		 :method "post"
+		 :style "display: inline;"
+		 (<ucw:submit :action (call 'markdown-preview
+					    :text (beesknees.weblog:comment-body comment))
+			      :value "View Body")
+		 (<ucw:submit :action (elephant:drop-instances (list comment))
+			      "Delete")))
+	      (when-bind children (beesknees.weblog:child-comments comment)
+			 (<:ul (mapc #'render-comment children))))))
+    (<:ul (mapc #'render-comment (golgonooza:current-items cr)))
+    (<ucw:a :action (answer) (<:ah "Ok"))))
+
+(defcomponent weblog-entry-list (bee-admin-list)
+  ()
+  (:default-initargs
+   :index-class 'beesknees.weblog:weblog-entry
+   :index-slot 'beesknees.weblog::posted
+   :page-size 10
+   :reverse t))
+
+(defmethod golgonooza:render-query-view-result ((entry weblog-entry)
+						(list bee-admin-list))
+  (<:progn (<:format "~A by ~A: "
+		     (metatilities:date-and-time-string
+		      (entry-posted entry))
+		     (beesknees.auth:username (entry-author entry)))
+	   (<ucw:a :action (call 'weblog-entry-editor :entry entry)
+		   (<:ah (entry-title entry)))
+	   (<ucw:form :action (refresh-component list)
+		      :method "post"
+		      :style "display: inline;"
+		      (<ucw:submit :action (call 'weblog-comment-review
+						 :query-key entry)
+				   "Comments")
+		      (<ucw:submit :action (elephant:drop-instances (list entry))
+				   "Delete"))))
+
+(defmethod render :after ((self bee-admin-list))
+  ;; mark with css classes
+  (<:p :class "ranged-show-list-pager"
+       (<:format "Page ~D of ~D"
+		 (1+ (golgonooza:page-offset self))
+		 (1+ (golgonooza:page-count self)))
+       (<:as-html " ")
+       (if (golgonooza:have-previous-page-p self)
+	   (<ucw:a :action (golgonooza:scroll-backward self)
+		   (<:as-html "Previous"))
+	   (<:as-html "Previous"))
+       (<:as-html " ")
+       (if (golgonooza:have-next-page-p self)
+	   (<ucw:a :action (golgonooza:scroll-forward self)
+		   (<:as-html "Next"))
+	   (<:as-html "Next"))
+       (<:as-html " ")
+       (<ucw:a :action (golgonooza:scroll-start self)
+	       (<:as-html "First"))
+       (<:as-html " ")      
+       (<ucw:a :action (golgonooza:scroll-end self)
+	       (<:as-html "Last"))))
hunk ./src/applications.lisp 1
-(in-package :beesknees.web)
-
-(defclass bee-application (standard-application
-			   static-roots-application-mixin
-			   tal-application-mixin
-			   golgonooza-db:elephant-store-application-mixin)
-  
-  ())
-
-(defclass bee-frontend-application (bee-application)
-  ())
-
-(defclass bee-admin-application (bee-application
-				 secure-application-mixin)
-  ())
-
-(defmethod application-find-user ((app bee-admin-application) username)
-  (bee-auth:find-user username))
-
-(defmethod application-check-password ((app bee-admin-application) user pass)
-  (bee-auth:check-password user pass))
+
rmfile ./src/applications.lisp
hunk ./src/authentication.lisp 1
-(in-package :beesknees.auth)
-
-(defpclass user ()
-  ((username :initarg :username :accessor username :index t)
-   (password :initarg :password :accessor password)))
-
-(defmethod (setf password) (new-password (user user))
-  (setf (slot-value user 'password) (md5:md5sum-sequence new-password)))
-
-(defun create-user (name password)
-  (make-instance 'user
-		 :username name
-		 :password (md5:md5sum-sequence password)))
-
-(defun find-user (name)
-  (get-instance-by-value 'user 'username name))
-
-(defun check-password (user-or-name password)
-  (let ((user (typecase user-or-name
-		(user user-or-name)
-		(t (find-user user-or-name)))))
-    (and user (equalp (md5:md5sum-sequence password) (password user)))))
+
rmfile ./src/authentication.lisp
hunk ./src/bee-page.lisp 1
-(in-package :beesknees.pages)
-
-(defparameter *markdown-output-cache*
-  (make-hash-table :test #'equalp
-		   ;; may need to just do locking manually for
-		   ;; portability... OTOH as long as an implementation
-		   ;; gurantees that concurrent writers won't corrupt
-		   ;; the hash table it doesn't particularly matter
-		   #+sbcl :synchronized #+sbcl t))
-
-(defun find-cached-markdown-output (markdown-hash)
-  (gethash markdown-hash *markdown-output-cache*))
-
-(defun cache-markdown-output! (markdown-hash markdown-text)
-  (setf (gethash markdown-hash *markdown-output-cache*)
-	(multiple-value-bind (doc string)
-	    (markdown:markdown markdown-text :stream nil :format :html)
-	  (declare (ignore doc))
-	  string)))
-
-(defextension (image :arguments ((name :required)
-				 alt
-				 (float :keyword))
-		     :insertp t)
-  (ecase phase
-    (:parse nil)
-    (:render (yaclml:with-yaclml-output-to-string
-	       ;; fixme: use url-prefix
-	       (<:img :src (format nil "/static/img/uploaded/~A" name)
-		      :alt (or alt "image")
-		      :style (case float
-			       ((:left) "float: left;")
-			       ((:right) "float: right")))))))
-
-(pushnew 'cl-markdown-user:image *render-active-functions*)
-
-(defpclass bee-page (cacheable-persistent-object)
-  ((name :accessor page-name :initarg :name :index t)
-   (content :accessor page-content :initarg :content)))
-
-(defmethod initialize-instance :after ((page bee-page)
-				       &key (content nil content-supplied-p)
-				       &allow-other-keys)
-  (when content-supplied-p
-    (setf (page-content page) content)))
-
-(defmethod (setf page-content) :after (content (page bee-page))
-  (setf (golgonooza-db:object-hash page) (md5:md5sum-sequence content)))
-
-(defun page->html (bee-page)
-  (ensure-transaction ()
-    (or (find-cached-markdown-output (golgonooza-db:object-hash bee-page))
-	(cache-markdown-output! (golgonooza-db:object-hash bee-page)
-				(page-content bee-page)))))
-
rmfile ./src/bee-page.lisp
adddir ./src/core
addfile ./src/core/applications.lisp
hunk ./src/core/applications.lisp 1
-
+(in-package :beesknees.web)
+
+(defclass bee-application (standard-application
+			   static-roots-application-mixin
+			   tal-application-mixin
+			   ucw::transactional-application-mixin
+			   golgonooza-db:elephant-store-application-mixin)
+  
+  ())
+
+(defclass bee-frontend-application (bee-application)
+  ())
+
+(defclass bee-admin-application (bee-application
+				 secure-application-mixin)
+  ())
+
+(defmethod application-find-user ((app bee-admin-application) username)
+  (bee-auth:find-user username))
+
+(defmethod application-check-password ((app bee-admin-application) user pass)
+  (bee-auth:check-password user pass))
addfile ./src/core/authentication.lisp
hunk ./src/core/authentication.lisp 1
-
+(in-package :beesknees.auth)
+
+(defpclass user ()
+  ((username :initarg :username :accessor username :index t)
+   (password :initarg :password :accessor password)))
+
+(defmethod (setf password) (new-password (user user))
+  (setf (slot-value user 'password) (md5:md5sum-sequence new-password)))
+
+(defun create-user (name password)
+  (make-instance 'user
+		 :username name
+		 :password (md5:md5sum-sequence password)))
+
+(defun find-user (name)
+  (get-instance-by-value 'user 'username name))
+
+(defun check-password (user-or-name password)
+  (let ((user (typecase user-or-name
+		(user user-or-name)
+		(t (find-user user-or-name)))))
+    (and user (equalp (md5:md5sum-sequence password) (password user)))))
addfile ./src/core/site-control.lisp
hunk ./src/core/site-control.lisp 1
-
+(in-package :beesknees.site-control)
+
+(defvar *bee-data-root*
+  "/home/clinton/local/var/beesknees/")
+
+(defclass bee-site (ucw-site elephant-store-site-mixin)
+  ()
+  (:default-initargs
+   :data-root *bee-data-root*
+    :store-spec "bdb/"))
+
+(defmethod make-entry-points ((site bee-site))
+  (defentry-point "^(index.ucw|)$" (:application (find-site-application site :frontend)
+						:class regexp-dispatcher)
+      ()
+    (call 'bee-frontend-window))
+  (defentry-point "^pages/blog/(\\d+)$" (:application (find-site-application site :frontend)
+						:class regexp-dispatcher)
+      ()
+    (let ((window (make-instance 'beesknees.web:bee-frontend-window)))
+	(setf (container.current-component-key (window-body window))
+	      'beesknees.web::blog)
+	(setf (golgonooza:page-offset (container.current-component
+				       (window-body window)))
+	      (- (golgonooza:page-count (container.current-component
+					 (window-body window)))
+		 (parse-integer (aref *dispatcher-registers* 0))))
+	(call-component nil window)))
+  (defentry-point "^pages/blog/entry/(\\d+)$" (:application (find-site-application site :frontend)
+						:class regexp-dispatcher)
+      ()
+    (let ((window (make-instance 'beesknees.web:bee-frontend-window)))
+	(setf (container.current-component-key (window-body window))
+	      'beesknees.web::blog)
+	(setf (ucw-core::find-component (window-body window)
+					'beesknees.web::blog)
+	      (make-instance 'beesknees.web::weblog-entry-bookmark-helper
+			     :posted (parse-integer (aref *dispatcher-registers* 0))
+			     :parent (window-body window)))
+	(call-component nil window)))
+  (defentry-point "^pages/videos/(\\S{11}?)$" (:application (find-site-application site :frontend)
+						:class regexp-dispatcher)
+      ()
+    (let ((window (make-instance 'beesknees.web:bee-frontend-window)))
+	(setf (container.current-component-key (window-body window))
+	      'beesknees.web::videos)
+	(setf (ucw-core::find-component (window-body window)
+					'beesknees.web::videos)
+	      (make-instance 'beesknees.web::video-bookmark-helper
+			     :video-id (aref *dispatcher-registers* 0)
+			     :parent (window-body window)))
+	(call-component nil window)))
+    (defentry-point "^pages/(\\w+)$" (:application (find-site-application site :frontend)
+						:class regexp-dispatcher)
+      ()
+    (let ((page-name (aref *dispatcher-registers* 0))
+	  (window (make-instance 'beesknees.web:bee-frontend-window)))
+      (setf (container.current-component-key (window-body window))
+	    (intern (string-upcase page-name) :beesknees.web))
+      (call-component nil window)))
+  
+  (defentry-point "^(index.ucw|)$" (:application (find-site-application site :backend)
+						:class regexp-dispatcher)
+      ()
+    (call 'bee-admin-window)))
+
+(defvar *markdown-cache-size-limit* 50)
+(defvar *markdown-cache-collector* nil)
+
+(defun markdown-cache-collector ()
+  (let ((count (hash-table-count beesknees.pages::*markdown-output-cache*)))
+    (when (> count *markdown-cache-size-limit*)
+      (with-hash-table-iterator (next beesknees.pages::*markdown-output-cache*)
+	(dotimes (i (- count *markdown-cache-size-limit*))
+	  (multiple-value-bind (foundp key value)
+	      (next)
+	    (declare (ignore foundp value))
+	    (remhash key beesknees.pages::*markdown-output-cache*)))))))
+
+(defmethod start-site :before ((site bee-site))
+  (setf *markdown-cache-collector*
+	(clon:schedule-function
+	 #'markdown-cache-collector
+	 (clon:make-scheduler (clon:make-typed-cron-schedule :hour '*))
+	 :thread t :name "markdown cache collector"))
+  (let* ((data-root (data-root site))
+	 (static-root (merge-pathnames "wwwroot/" data-root)))
+    (setf (applications site)
+	  (list
+	   (cons :frontend
+		 (make-instance 'bee-frontend-application
+				:url-prefix "/"
+				:static-roots
+				(list `("static/"
+					. ,static-root))
+				:tal-generator
+				(make-instance 'yaclml:file-system-generator
+					       :cachep t
+					       :root-directories `(,(format nil "~A~A"
+									    data-root "tal/")))))
+	   (cons :backend
+		 (make-instance 'bee-admin-application
+				:url-prefix "/admin/"
+				:static-roots
+				(list `("static/"
+					. ,static-root))))))))
+
+(defmethod stop-site :after ((site bee-site))
+  (when *markdown-cache-collector*
+    (trivial-timers:unschedule-timer *markdown-cache-collector*)
+    (setf *markdown-cache-collector* nil)))
+
+(defun start-bee-site ()
+  (register-site 'beesknees (make-instance 'bee-site)))
+
+(defun stop-bee-site ()
+  (unregister-site 'beesknees))
+
+(defun restart-bee-site ()
+  (stop-bee-site)
+  (start-bee-site))
adddir ./src/frontend
hunk ./src/frontend-videos.lisp 1
-(in-package :beesknees.web)
-
-(defcomponent bee-videos-video (bee-video)
-  ())
-
-(defmethod render :after ((vid bee-videos-video))
-  (<ucw:a :action (answer) (<:ah "Back")))
-
-(defcomponent bee-videos (golgonooza:query-ranged-view-mixin
-			  golgonooza-db:elephant-query-view-mixin
-			  golgonooza:query-view
-			  bee-widget)
-  ()
-  (:default-initargs
-   :index-class 'beesknees.videos:youtube-video
-   :index-slot 'beesknees.videos:youtube-id
-   :reverse t))
-
-(defclass video-page-link (standard-action)
-  ((video :initarg :video :accessor video :initform nil))
-  (:metaclass c2mop:funcallable-standard-class))
-
-(defmethod compute-url ((link video-page-link) (c bee-videos))
-  (let ((url (call-next-method)))
-    (when-bind video (video link)
-      (append-path-to-uri url (format nil "pages/videos/~A"
-				      (beesknees.videos:youtube-id video))))
-    url))
-
-(defun video-link (video)
-  (make-action (lambda ()
-		 (with-call/cc
-		   (call 'bee-videos-video
-			 :video-id (beesknees.videos:youtube-id video))))
-	       :class 'video-page-link
-	       :video video))
-
-(defcomponent video-bookmark-helper (task-component)
-  ((video-id :initarg :video-id)))
-
-(defaction start ((task video-bookmark-helper))
-  (call 'bee-videos-video :video-id (slot-value task 'video-id))
-  (call 'bee-videos))
-
-(defmethod golgonooza:render-query-view-result ((video beesknees.videos:youtube-video)
-						(list bee-videos))
-  (<:div :class "video-entry"
-	 (<ucw:a :action* (video-link video)
-		 (<:img :src (format nil "~Astatic/img/thumbnails/~A"
-				     (application.url-prefix
-				      (context.application *context*))
-				     (beesknees.videos:thumbnail video))
-			:alt (beesknees.videos:title video)))))
rmfile ./src/frontend-videos.lisp
hunk ./src/frontend-weblog.lisp 1
-(in-package :beesknees.web)
-
-(defcomponent bee-blog (golgonooza:query-ranged-view-mixin
-			golgonooza-db:elephant-query-view-mixin
-			golgonooza:query-view
-			bee-widget)
-  ()
-  (:default-initargs
-   :index-class 'beesknees.weblog:weblog-entry
-   :index-slot 'beesknees.weblog::posted
-   :reverse t))
-
-(defmethod golgonooza:render-query-view-result ((entry weblog-entry)
-						(list bee-blog))
-  (render-template *context* "bee-blog-list-entry.tal"
-		   (yaclml:make-standard-tal-environment
-		    `((entry . ,entry)) entry)))
-
-(defcomponent bee-paged-blog (golgonooza:query-paged-view-mixin
-			      bee-blog)
-  ())
-
-(defclass weblog-archive-page-link (standard-action)
-  ((page :initarg :page :accessor page :initform nil))
-  (:metaclass c2mop:funcallable-standard-class))
-
-(defclass weblog-entry-page-link (standard-action)
-  ((entry :initarg :entry :accessor entry :initform nil))
-  (:metaclass c2mop:funcallable-standard-class))
-
-(defmethod compute-url ((link weblog-archive-page-link) (c bee-paged-blog))
-  ;; Store the page offset as if it the blog were sorted normally
-  ;; instead of reversed so that bookmarks will always point to (more or
-  ;; less) the same page even if the archive ends up with more items
-  (let ((url (call-next-method)))
-    (when-bind archive-page (page link)
-      (append-path-to-uri url (format nil "pages/blog/~A"
-				      (- (golgonooza:page-count c)
-					 archive-page))))
-    url))
-
-(defmethod compute-url ((link weblog-entry-page-link) (c bee-blog))
-  (let ((url (call-next-method)))
-    (when-bind entry (entry link)
-      (append-path-to-uri url (format nil "pages/blog/entry/~D"
-				      (entry-posted entry))))
-    url))
-
-(defclass captcha-validator (validator)
-  ())
-
-(defclass captcha-field (string-field)
-  ((captcha-text :initarg :captcha :accessor captcha-text))
-  (:default-initargs :validators (make-validators 'captcha-validator)))
-
-(defmethod validate ((field captcha-field) (validator captcha-validator))
-  (string= (captcha-text field) (or (value field) "")))
-
-(defmethod render :after ((field captcha-field))
-  (<:span :class "captcha-field-message"
-	  "Prove you are a human (type "
-	  (<:tt :class "captcha-text" (<:ah (captcha-text field)))
-	  " here)"))
-
-(define-html-form comment-entry ()
-  ((title (string-field :input-size 40
-			:validators (make-validators 'not-empty-validator)))
-   (author (string-field :input-size 40
-			:validators (make-validators 'not-empty-validator)))
-   (captcha (captcha-field :input-size 10
-			   :captcha "lisp"))
-   (body (textarea-field :rows 10 :cols 40)))
-  ((comment-parent :initarg :comment-parent :accessor comment-parent)))
-
-(defaction process-form ((ce comment-entry))
-  (let ((res (with-slots (title author body comment-parent)
-		  ce
-	       (make-instance 'beesknees.weblog::weblog-comment
-			      :parent comment-parent
-			      :title (value title)
-			      :author (value author)
-			      :body (value body)
-			      :posted (get-universal-time)))))
-    (answer res)))
-
-(defmethod render :around ((c comment-entry))
-  (<:div :class "comment-entry"
-	 (call-next-method)))
-
-(defcomponent list-comment-entry (task-component)
-  ((entry :initarg :comment-parent :accessor entry)))
-
-(defaction start ((ce list-comment-entry))
-  (when-bind comment (call 'comment-entry :comment-parent (entry ce))
-    (call 'weblog-entry-view :entry (comment-parent comment)))
-  (answer nil))
-
-(defcomponent weblog-entry-view (html-block-element-mixin)
-  ((entry :initarg :entry :accessor weblog-entry)))
-
-(defmethod render ((e weblog-entry-view))
-  (labels ((render-comment (comment)
-	     (<:li
-	      (<:div :class "comment-header"
-		     (<:h1 (<:ah (beesknees.weblog::comment-title comment)))
-		     (<:h2 (<:format "By ~A on ~A"
-				     (beesknees.weblog::comment-author comment)
-				     (metatilities:date-and-time-string
-				      (beesknees.weblog::comment-posted comment)))))
-		   (<:p :class "comment-body"
-			(<:ah (beesknees.weblog::comment-body comment)))
-		   (<ucw:a :action (call 'comment-entry :comment-parent comment)
-			   (<:ah "reply"))
-		   (render-child-comments comment)))
-	   (render-child-comments (entry/comment)
-	     (when-bind comments (beesknees.weblog::child-comments entry/comment)
-	       (<:ul :class "comments"
-		     (mapc #'render-comment comments)))))
-    (with-slots (entry) e
-      (<:div :class "bee-blog-entry"
-	(<:h1 :class "title" (<:as-html (entry-title entry)))
-	(<:h2 :class "author-date"
-	      (<:format "By ~A on ~A"
-			(beesknees.auth:username (entry-author entry))
-			(metatilities:date-and-time-string
-			 (entry-posted entry))))
-	(<:p :class "body "
-	     (cl-markdown:markdown (entry-body entry)
-				   :stream yaclml:*yaclml-stream*
-				   :format :html)))
-      (render-child-comments entry)
-      (<ucw:a :action (call 'comment-entry :comment-parent entry)
-	      "Comment")
-      (<:ah " ")
-      (<ucw:a :action (answer t) "Ok"))))
-
-(defcomponent weblog-entry-bookmark-helper (task-component)
-  ((posted :initarg :posted)))
-
-(defaction start ((task weblog-entry-bookmark-helper))
-  (call 'weblog-entry-view :entry (get-instance-by-value 'weblog-entry
-							 'beesknees.weblog::posted
-							 (slot-value task 'posted)))
-  (call 'bee-paged-blog :page-size 5))
-
-(defun weblog-entry-link (entry)
-  (make-action (lambda ()
-		 (with-call/cc
-		   (call 'weblog-entry-view :entry entry)))
-	       :class 'weblog-entry-page-link
-	       :entry entry))
-
-(defmacro weblog-pager-link (offset &body lambda)
-  `(make-action (lambda () (with-call/cc
-			,@lambda))
-		:class 'weblog-archive-page-link
-		:page ,offset))
-
-(defmethod render :after ((self bee-paged-blog))
-  ;; mark with css classes
-  ;; replace text with images!
-  (<:p :class "bee-blog-pager"
-       (if (golgonooza:have-previous-page-p self)
-	   (<ucw:a :action* (weblog-pager-link (1- (golgonooza:page-offset self))
-			      (golgonooza:scroll-backward self))
-		   (<:as-html "Previous"))
-	   (<:as-html "Previous"))
-       (<:as-html " ")
-       (if (golgonooza:have-next-page-p self)
-	   (<ucw:a :action* (weblog-pager-link (1+ (golgonooza:page-offset self))
-			      (golgonooza:scroll-forward self))
-		   (<:as-html "Next"))
-	   (<:as-html "Next"))
-       (<:as-html " ")
-       (<ucw:a :action* (weblog-pager-link 0
-			  (golgonooza:scroll-start self))
-	       (<:as-html "First"))
-       (<:as-html " ")
-       (<ucw:a :action* (weblog-pager-link (golgonooza:page-count self)
-			  (golgonooza:scroll-end self))
-	       (<:as-html "Last"))
-       (<:as-html " ")
-       (<:format "Page ~D of ~D"
-		 (1+ (golgonooza:page-offset self))
-		 (1+ (golgonooza:page-count self)))))
-
-(defcomponent bee-home-blog (bee-blog)
-  ())
-
-(defmethod render :before ((list bee-home-blog))
-  (<:img :src (arnesi:strcat
-	       (application.url-prefix (context.application *context*))
-	       "static/img/logos/blog.png")
-	 :alt "Weblog"
-	 :class "header"))
rmfile ./src/frontend-weblog.lisp
addfile ./src/frontend/videos.lisp
hunk ./src/frontend/videos.lisp 1
+(in-package :beesknees.web)
+
+(defcomponent bee-videos-video (bee-video)
+  ())
+
+(defmethod render :after ((vid bee-videos-video))
+  (<ucw:a :action (answer) (<:ah "Back")))
+
+(defcomponent bee-videos (golgonooza:query-ranged-view-mixin
+			  golgonooza-db:elephant-query-view-mixin
+			  golgonooza:query-view
+			  bee-widget)
+  ()
+  (:default-initargs
+   :index-class 'beesknees.videos:youtube-video
+   :index-slot 'beesknees.videos:youtube-id
+   :reverse t))
+
+(defclass video-page-link (standard-action)
+  ((video :initarg :video :accessor video :initform nil))
+  (:metaclass c2mop:funcallable-standard-class))
+
+(defmethod compute-url ((link video-page-link) (c bee-videos))
+  (let ((url (call-next-method)))
+    (when-bind video (video link)
+      (append-path-to-uri url (format nil "pages/videos/~A"
+				      (beesknees.videos:youtube-id video))))
+    url))
+
+(defun video-link (video)
+  (make-action (lambda ()
+		 (with-call/cc
+		   (call 'bee-videos-video
+			 :video-id (beesknees.videos:youtube-id video))))
+	       :class 'video-page-link
+	       :video video))
+
+(defcomponent video-bookmark-helper (task-component)
+  ((video-id :initarg :video-id)))
+
+(defaction start ((task video-bookmark-helper))
+  (call 'bee-videos-video :video-id (slot-value task 'video-id))
+  (call 'bee-videos))
+
+(defmethod golgonooza:render-query-view-result ((video beesknees.videos:youtube-video)
+						(list bee-videos))
+  (<:div :class "video-entry"
+	 (<ucw:a :action* (video-link video)
+		 (<:img :src (format nil "~Astatic/img/thumbnails/~A"
+				     (application.url-prefix
+				      (context.application *context*))
+				     (beesknees.videos:thumbnail video))
+			:alt (beesknees.videos:title video)))
+	 (<:h1 (<:ah (beesknees.videos:title video)))))
+
addfile ./src/frontend/web.lisp
hunk ./src/frontend/web.lisp 1
-
+(in-package :beesknees.web)
+
+(defcomponent bee-frontend-page (bee-page-component)
+  ())
+
+(defcomponent bee-home-video (bee-video)
+  ())
+
+(defmethod render :before ((c bee-home-video))
+  (<:img :src (arnesi:strcat
+	       (application.url-prefix (context.application *context*))
+	       "static/img/logos/latest-video.png")
+	 :alt "Latest Video"
+	 :class "header"))
+
+(defcomponent bee-home (bee-widget composite-container)
+  ()
+  (:default-initargs
+    :contents `((video . ,(make-instance 'bee-home-video :video-id "JPL4oz6G8l4"))
+		(blog  . ,(make-instance 'bee-home-blog :limit 1)))))
+
+;; rename image-navigation-pane-mixin?
+(defcomponent bee-frontend-pane (tabbed-pane tal-component)
+  ((img-root :initarg :img-root)))
+
+(defclass bee-switch-link-action (standard-action)
+  ((target-component :initarg :target :accessor target-component :initform nil))
+  (:metaclass c2mop:funcallable-standard-class))
+
+(defmethod compute-url ((action bee-switch-link-action) (pane bee-frontend-pane))
+  (let ((url (call-next-method)))
+    (when-bind target (target-component action)
+      (append-path-to-uri url (format nil "pages/~(~A~)" (car target))))
+    url))
+
+(defun switch-link (pane component)
+  (make-action (lambda ()
+		 (with-call/cc
+		   (switch-component pane (car component))))
+	       :class 'bee-switch-link-action
+	       :target component))
+
+(defmethod tal-component-environment nconc ((pane bee-frontend-pane))
+  (let ((page-style (elephant:get-instance-by-value
+		     'bee-page-style 'name
+		     (container.current-component-key pane))))
+    (yaclml:tal-env
+     'contents
+     (mapcar (lambda (component)
+	       (let ((selectedp (funcall (container.key-test pane)
+					 (car component)
+					 (container.current-component-key pane))))
+		 (yaclml:tal-env
+		  'value component
+		  'selected selectedp
+		  'navbar-image-url (format nil "~A~A~A~D.png"
+					    (application.url-prefix
+					     (context.application *context*))
+					    (slot-value pane 'img-root)
+					    (string-downcase
+					     (symbol-name (car component)))
+					    (if selectedp 2 1)))))
+	     (container.contents pane))
+     'selected-component (container.current-component pane)
+     'component-style page-style
+     'page-background-url (when page-style
+			    (format nil
+				    "/static/img/backgrounds/~A"
+				    (arnesi:escape-as-uri
+				     (page-background page-style)))))))
+
+(defcomponent bee-frontend-window (bee-window)
+  ()
+  (:default-initargs
+    :stylesheet '("/static/css/frontend.css")
+    :javascript '((:src "/static/js/flashembed-0.34.js"))
+    :body (make-instance
+	   'bee-frontend-pane
+	   :css-class "bee-frontend-pane"
+	   :img-root "static/img/navigation/"
+	   :current-component-key 'home
+	   :template-name "frontend-pane.tal"
+	   :contents
+	   `((home . ,(make-instance 'bee-home :name :home))
+	     (videos . ,(make-instance 'bee-videos))
+	     (blog . ,(make-instance 'bee-paged-blog :name :blog :page-size 5))
+	     (about . ,(make-instance 'bee-frontend-page :name :about))
+	     (contact . ,(make-instance 'bee-frontend-page :name :contact))
+	     (links . ,(make-instance 'bee-frontend-page :name :links))))))
addfile ./src/frontend/weblog.lisp
hunk ./src/frontend/weblog.lisp 1
+(in-package :beesknees.web)
+
+(defcomponent bee-blog (golgonooza:query-ranged-view-mixin
+			golgonooza-db:elephant-query-view-mixin
+			golgonooza:query-view
+			bee-widget)
+  ()
+  (:default-initargs
+   :index-class 'beesknees.weblog:weblog-entry
+   :index-slot 'beesknees.weblog::posted
+   :reverse t))
+
+(defmethod golgonooza:render-query-view-result ((entry weblog-entry)
+						(list bee-blog))
+  (render-template *context* "bee-blog-list-entry.tal"
+		   (yaclml:make-standard-tal-environment
+		    `((entry . ,entry)) entry)))
+
+(defcomponent bee-paged-blog (golgonooza:query-paged-view-mixin
+			      bee-blog)
+  ())
+
+(defclass weblog-archive-page-link (standard-action)
+  ((page :initarg :page :accessor page :initform nil))
+  (:metaclass c2mop:funcallable-standard-class))
+
+(defclass weblog-entry-page-link (standard-action)
+  ((entry :initarg :entry :accessor entry :initform nil))
+  (:metaclass c2mop:funcallable-standard-class))
+
+(defmethod compute-url ((link weblog-archive-page-link) (c bee-paged-blog))
+  ;; Store the page offset as if it the blog were sorted normally
+  ;; instead of reversed so that bookmarks will always point to (more or
+  ;; less) the same page even if the archive ends up with more items
+  (let ((url (call-next-method)))
+    (when-bind archive-page (page link)
+      (append-path-to-uri url (format nil "pages/blog/~A"
+				      (- (golgonooza:page-count c)
+					 archive-page))))
+    url))
+
+(defmethod compute-url ((link weblog-entry-page-link) (c bee-blog))
+  (let ((url (call-next-method)))
+    (when-bind entry (entry link)
+      (append-path-to-uri url (format nil "pages/blog/entry/~D"
+				      (entry-posted entry))))
+    url))
+
+(defclass captcha-validator (validator)
+  ())
+
+(defclass captcha-field (string-field)
+  ((captcha-text :initarg :captcha :accessor captcha-text))
+  (:default-initargs :validators (make-validators 'captcha-validator)))
+
+(defmethod validate ((field captcha-field) (validator captcha-validator))
+  (string= (captcha-text field) (or (value field) "")))
+
+(defmethod render :after ((field captcha-field))
+  (<:span :class "captcha-field-message"
+	  "Prove you are a human (type "
+	  (<:tt :class "captcha-text" (<:ah (captcha-text field)))
+	  " here)"))
+
+(define-html-form comment-entry ()
+  ((title (string-field :input-size 40
+			:validators (make-validators 'not-empty-validator)))
+   (author (string-field :input-size 40
+			:validators (make-validators 'not-empty-validator)))
+   (captcha (captcha-field :input-size 10
+			   :captcha "lisp"))
+   (body (textarea-field :rows 10 :cols 40)))
+  ((comment-parent :initarg :comment-parent :accessor comment-parent)))
+
+(defaction process-form ((ce comment-entry))
+  (let ((res (with-slots (title author body comment-parent)
+		  ce
+	       (make-instance 'beesknees.weblog::weblog-comment
+			      :parent comment-parent
+			      :title (value title)
+			      :author (value author)
+			      :body (value body)
+			      :posted (get-universal-time)))))
+    (answer res)))
+
+(defmethod render :around ((c comment-entry))
+  (<:div :class "comment-entry"
+	 (call-next-method)))
+
+(defcomponent list-comment-entry (task-component)
+  ((entry :initarg :comment-parent :accessor entry)))
+
+(defaction start ((ce list-comment-entry))
+  (when-bind comment (call 'comment-entry :comment-parent (entry ce))
+    (call 'weblog-entry-view :entry (comment-parent comment)))
+  (answer nil))
+
+(defcomponent weblog-entry-view (html-block-element-mixin)
+  ((entry :initarg :entry :accessor weblog-entry)))
+
+(defmethod render ((e weblog-entry-view))
+  (labels ((render-comment (comment)
+	     (<:li
+	      (<:div :class "comment-header"
+		     (<:h1 (<:ah (beesknees.weblog::comment-title comment)))
+		     (<:h2 (<:format "By ~A on ~A"
+				     (beesknees.weblog::comment-author comment)
+				     (metatilities:date-and-time-string
+				      (beesknees.weblog::comment-posted comment)))))
+		   (<:p :class "comment-body"
+			(<:ah (beesknees.weblog::comment-body comment)))
+		   (<ucw:a :action (call 'comment-entry :comment-parent comment)
+			   (<:ah "reply"))
+		   (render-child-comments comment)))
+	   (render-child-comments (entry/comment)
+	     (when-bind comments (beesknees.weblog::child-comments entry/comment)
+	       (<:ul :class "comments"
+		     (mapc #'render-comment comments)))))
+    (with-slots (entry) e
+      (<:div :class "bee-blog-entry"
+	(<:h1 :class "title" (<:as-html (entry-title entry)))
+	(<:h2 :class "author-date"
+	      (<:format "By ~A on ~A"
+			(beesknees.auth:username (entry-author entry))
+			(metatilities:date-and-time-string
+			 (entry-posted entry))))
+	(<:p :class "body "
+	     (cl-markdown:markdown (entry-body entry)
+				   :stream yaclml:*yaclml-stream*
+				   :format :html)))
+      (render-child-comments entry)
+      (<ucw:a :action (call 'comment-entry :comment-parent entry)
+	      "Comment")
+      (<:ah " ")
+      (<ucw:a :action (answer t) "Ok"))))
+
+(defcomponent weblog-entry-bookmark-helper (task-component)
+  ((posted :initarg :posted)))
+
+(defaction start ((task weblog-entry-bookmark-helper))
+  (call 'weblog-entry-view :entry (get-instance-by-value 'weblog-entry
+							 'beesknees.weblog::posted
+							 (slot-value task 'posted)))
+  (call 'bee-paged-blog :page-size 5))
+
+(defun weblog-entry-link (entry)
+  (make-action (lambda ()
+		 (with-call/cc
+		   (call 'weblog-entry-view :entry entry)))
+	       :class 'weblog-entry-page-link
+	       :entry entry))
+
+(defmacro weblog-pager-link (offset &body lambda)
+  `(make-action (lambda () (with-call/cc
+			,@lambda))
+		:class 'weblog-archive-page-link
+		:page ,offset))
+
+(defmethod render :after ((self bee-paged-blog))
+  ;; mark with css classes
+  ;; replace text with images!
+  (<:p :class "bee-blog-pager"
+       (if (golgonooza:have-previous-page-p self)
+	   (<ucw:a :action* (weblog-pager-link (1- (golgonooza:page-offset self))
+			      (golgonooza:scroll-backward self))
+		   (<:as-html "Previous"))
+	   (<:as-html "Previous"))
+       (<:as-html " ")
+       (if (golgonooza:have-next-page-p self)
+	   (<ucw:a :action* (weblog-pager-link (1+ (golgonooza:page-offset self))
+			      (golgonooza:scroll-forward self))
+		   (<:as-html "Next"))
+	   (<:as-html "Next"))
+       (<:as-html " ")
+       (<ucw:a :action* (weblog-pager-link 0
+			  (golgonooza:scroll-start self))
+	       (<:as-html "First"))
+       (<:as-html " ")
+       (<ucw:a :action* (weblog-pager-link (golgonooza:page-count self)
+			  (golgonooza:scroll-end self))
+	       (<:as-html "Last"))
+       (<:as-html " ")
+       (<:format "Page ~D of ~D"
+		 (1+ (golgonooza:page-offset self))
+		 (1+ (golgonooza:page-count self)))))
+
+(defcomponent bee-home-blog (bee-blog)
+  ())
+
+(defmethod render :before ((list bee-home-blog))
+  (<:img :src (arnesi:strcat
+	       (application.url-prefix (context.application *context*))
+	       "static/img/logos/blog.png")
+	 :alt "Weblog"
+	 :class "header"))
hunk ./src/image-manager.lisp 1
-(in-package :beesknees.web)
-
-(define-html-form image-upload (file-upload-form)
-  ((image (file-upload-field)))
-  ((upload-root :initarg :root :initform `("wwwroot" "img" "uploaded"))))
-
-(defaction process-form ((form image-upload))
-  (with-slots (image upload-root) form
-    (let ((upload-stream
-	   (let ((original-file-name (rfc2388-binary:get-header-attribute
-				      (rfc2388-binary:get-header (value image)
-								 "Content-Disposition")
-				      "filename")))
-	     (open (make-pathname
-		    :directory `(:absolute
-				 ,@(split-sequence:split-sequence
-				    #\/ beesknees.site-control::*bee-data-root*)
-				 ,@upload-root)
-		    :name (pathname-name original-file-name)
-		    :type (pathname-type original-file-name))
-		   :direction :output
-		   :element-type 'unsigned-byte
-		   :if-exists :supersede))))
-      (fad:copy-stream (mime-part-body (value image)) upload-stream)
-      (answer (namestring upload-stream)))))
-
rmfile ./src/image-manager.lisp
hunk ./src/markdown-editor.lisp 1
-(in-package :beesknees.web)
-
-(defcomponent markdown-preview (bee-widget)
-  ((text :initarg :text :reader text)))
-
-(defmethod render ((m markdown-preview))
-  (<:div
-   (cl-markdown:markdown (text m) :stream yaclml:*yaclml-stream* :format :html))
-  (<ucw:form :action (answer)
-	     (<ucw:submit :action (answer) :value "Ok")))
-
-(define-html-form markdown-content-editor ()
-  ((content (textarea-field :rows 30 :cols 80 :dom-id "content-editor")))
-  ())
-
-(defvar *last-image-upload* nil)
-
-(defmethod render :before ((e markdown-content-editor))
-  (with-slots (content) e
-    (<:fieldset
-     (<:legend "Markdown")
-     (<:script :src "static/js/jquery/ui/ui.core.js")
-     (<:script :src "static/js/jquery/ui/ui.draggable.js")
-     (<:script :src "static/js/jquery/ui/ui.droppable.js")
-     (<ucw:submit :value "Preview" :action (call 'markdown-preview
-						 :text (value content)))
-     (<ucw:submit
-      :value "Upload Image"
-      :action (setf *last-image-upload*
-		    (let ((path (call 'image-upload)))
-		      (format nil "~A.~A" (pathname-name path)
-			      (pathname-type path)))))
-     (<:a :href "http://daringfireball.net/projects/markdown/syntax"
-	  :target "_new"
-	  (<:as-html "Markdown Syntax Reference"))
-     (when *last-image-upload*
-       (<:p (<:img :id "last-image-upload"
-		   :class "droppable-image-link"
-		   :alt "last uploaded image"
-		   :style "max-width: 200px;"
-		   :title *last-image-upload*
-		   :src (format nil
-				"/static/img/uploaded/~A" *last-image-upload*))
-	    (<:ah "Drag the image into the document where you want to display it."))
-       (<ucw:script
-	`(.data (.draggable ($ "#last-image-upload")
-			    (ps:create :revert true))
-		"markdown-text"
-		,(format nil "{image ~S}" *last-image-upload*)))
-       (setf *last-image-upload* nil)))))
rmfile ./src/markdown-editor.lisp
hunk ./src/site-control.lisp 1
-(in-package :beesknees.site-control)
-
-(defvar *bee-data-root*
-  "/home/clinton/local/var/beesknees/")
-
-(defclass bee-site (ucw-site elephant-store-site-mixin)
-  ()
-  (:default-initargs
-   :data-root *bee-data-root*
-    :store-spec "bdb/"))
-
-(defmethod make-entry-points ((site bee-site))
-  (defentry-point "^(index.ucw|)$" (:application (find-site-application site :frontend)
-						:class regexp-dispatcher)
-      ()
-    (call 'bee-frontend-window))
-  (defentry-point "^pages/blog/(\\d+)$" (:application (find-site-application site :frontend)
-						:class regexp-dispatcher)
-      ()
-    (let ((window (make-instance 'beesknees.web:bee-frontend-window)))
-	(setf (container.current-component-key (window-body window))
-	      'beesknees.web::blog)
-	(setf (golgonooza:page-offset (container.current-component
-				       (window-body window)))
-	      (- (golgonooza:page-count (container.current-component
-					 (window-body window)))
-		 (parse-integer (aref *dispatcher-registers* 0))))
-	(call-component nil window)))
-  (defentry-point "^pages/blog/entry/(\\d+)$" (:application (find-site-application site :frontend)
-						:class regexp-dispatcher)
-      ()
-    (let ((window (make-instance 'beesknees.web:bee-frontend-window)))
-	(setf (container.current-component-key (window-body window))
-	      'beesknees.web::blog)
-	(setf (ucw-core::find-component (window-body window)
-					'beesknees.web::blog)
-	      (make-instance 'beesknees.web::weblog-entry-bookmark-helper
-			     :posted (parse-integer (aref *dispatcher-registers* 0))
-			     :parent (window-body window)))
-	(call-component nil window)))
-  (defentry-point "^pages/videos/(\\S{11}?)$" (:application (find-site-application site :frontend)
-						:class regexp-dispatcher)
-      ()
-    (let ((window (make-instance 'beesknees.web:bee-frontend-window)))
-	(setf (container.current-component-key (window-body window))
-	      'beesknees.web::videos)
-	(setf (ucw-core::find-component (window-body window)
-					'beesknees.web::videos)
-	      (make-instance 'beesknees.web::video-bookmark-helper
-			     :video-id (aref *dispatcher-registers* 0)
-			     :parent (window-body window)))
-	(call-component nil window)))
-    (defentry-point "^pages/(\\w+)$" (:application (find-site-application site :frontend)
-						:class regexp-dispatcher)
-      ()
-    (let ((page-name (aref *dispatcher-registers* 0))
-	  (window (make-instance 'beesknees.web:bee-frontend-window)))
-      (setf (container.current-component-key (window-body window))
-	    (intern (string-upcase page-name) :beesknees.web))
-      (call-component nil window)))
-  
-  (defentry-point "^(index.ucw|)$" (:application (find-site-application site :backend)
-						:class regexp-dispatcher)
-      ()
-    (call 'bee-admin-window)))
-
-(defvar *markdown-cache-size-limit* 50)
-(defvar *markdown-cache-collector* nil)
-
-(defun markdown-cache-collector ()
-  (let ((count (hash-table-count beesknees.pages::*markdown-output-cache*)))
-    (when (> count *markdown-cache-size-limit*)
-      (with-hash-table-iterator (next beesknees.pages::*markdown-output-cache*)
-	(dotimes (i (- count *markdown-cache-size-limit*))
-	  (multiple-value-bind (foundp key value)
-	      (next)
-	    (declare (ignore foundp value))
-	    (remhash key beesknees.pages::*markdown-output-cache*)))))))
-
-(defmethod start-site :before ((site bee-site))
-  (setf *markdown-cache-collector*
-	(clon:schedule-function
-	 #'markdown-cache-collector
-	 (clon:make-scheduler (clon:make-typed-cron-schedule :hour '*))
-	 :thread t :name "markdown cache collector"))
-  (let* ((data-root (data-root site))
-	 (static-root (merge-pathnames "wwwroot/" data-root)))
-    (setf (applications site)
-	  (list
-	   (cons :frontend
-		 (make-instance 'bee-frontend-application
-				:url-prefix "/"
-				:static-roots
-				(list `("static/"
-					. ,static-root))
-				:tal-generator
-				(make-instance 'yaclml:file-system-generator
-					       :cachep t
-					       :root-directories `(,(format nil "~A~A"
-									    data-root "tal/")))))
-	   (cons :backend
-		 (make-instance 'bee-admin-application
-				:url-prefix "/admin/"
-				:static-roots
-				(list `("static/"
-					. ,static-root))))))))
-
-(defmethod stop-site :after ((site bee-site))
-  (when *markdown-cache-collector*
-    (trivial-timers:unschedule-timer *markdown-cache-collector*)
-    (setf *markdown-cache-collector* nil)))
-
-(defun start-bee-site ()
-  (register-site 'beesknees (make-instance 'bee-site)))
-
-(defun stop-bee-site ()
-  (unregister-site 'beesknees))
-
-(defun restart-bee-site ()
-  (stop-bee-site)
-  (start-bee-site))
+
rmfile ./src/site-control.lisp
adddir ./src/video
hunk ./src/video-gallery.lisp 1
-(in-package :beesknees.videos)
-
-(defpclass youtube-video ()
-  ((youtube-id :initarg :video-id :accessor youtube-id :index t)
-   (title :initarg :title :accessor title)
-   (thumbnail :initarg :thumbnail :initform nil :accessor thumbnail)))
rmfile ./src/video-gallery.lisp
addfile ./src/video/youtube.lisp
hunk ./src/video/youtube.lisp 1
+(in-package :beesknees.videos)
+
+(defpclass youtube-video ()
+  ((youtube-id :initarg :video-id :accessor youtube-id :index t)
+   (title :initarg :title :accessor title)
+   (thumbnail :initarg :thumbnail :initform nil :accessor thumbnail)
+   (description :initarg :description :initform nil :accessor description)))
adddir ./src/web
hunk ./src/web-admin.lisp 1
-(in-package :beesknees.web)
-
-(define-html-form page-editor (markdown-content-editor)
-  ((name (string-field :input-size 80
-		       :validators (make-validators 'not-empty-validator))))
-  ((page :initarg :page :accessor edited-page :initform nil))
-  (:default-initargs :field-order '(name content)))
-
-(defmethod initialize-instance :after ((editor page-editor) &rest keys)
-  (declare (ignore keys))
-  (when-bind page (edited-page editor)
-    (with-slots (name content)
-	editor
-      (setf (value name)    (symbol-name (page-name page))
-	    (value content) (page-content page)))))
-
-(defaction process-form ((editor page-editor))
-  (elephant:ensure-transaction ()
-    (let ((page (or (edited-page editor)
-		     (make-instance 'bee-page))))
-      (with-slots (name content)
-	  editor
-	(setf (page-name page)    (intern (string-upcase (value name)) :keyword)
-	      (page-content page) (value content)))
-      (answer page))))
-
-(defmethod render :after ((e page-editor))
-  (<ucw:script
-   `(.droppable ($ "#content-editor")
-		(ps:create
-		 :accept ".droppable-image-link"
-		 :drop (lambda (event ui)
-			 (let* ((text (.text ($ this)))
-				(before (.substring
-					 text 0 ui.element[0].selection-start))
-				(after (.substr
-					text ui.element[0].selection-end)))
-			   (.append (.empty ($ this))
-				    (+ before
-				       (.data ui.draggable "markdown-text")
-				       after))))))))
-
-(defcomponent page-list (bee-admin-list)
-  ()
-  (:default-initargs
-   :index-class 'bee-page
-   :index-slot 'beesknees.pages::name
-   :page-size 10
-   :reverse nil))
-
-(defmethod golgonooza:render-query-view-result ((page bee-page)
-						(list bee-admin-list))
-  (<ucw:a :action (call 'page-editor :page page)
-	  (<:as-html (string-downcase
-		      (symbol-name (page-name page))))))
-
-(define-html-form page-style-editor ()
-  ((name (string-field :input-size 80
-		       :validators (make-validators 'not-empty-validator)))
-   (background (image-selector-field
-		:image-directory (merge-pathnames
-				  "wwwroot/img/backgrounds/*.*"
-				  beesknees.site-control::*bee-data-root*)
-		: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 golgonooza:render-query-view-result ((page bee-page-style)
-						(list bee-admin-list))
-  (<ucw:a :action (call 'page-style-editor :page-style page)
-	  (<:as-html (string-downcase
-		      (symbol-name (page-name page))))))
-
-;; add to window
-;; optionally -- (toplevel)
-
-(defclass fields-not-equal (form-validator)
-  ((field-1 :initarg :field-1)
-   (field-2 :initarg :field-2)
-   (equal-predicate :initarg :equalp :initform #'equalp)))
-
-(defmethod validate ((form simple-form) (validator fields-not-equal))
-  (with-slots (field-1 field-2 equal-predicate) validator
-    (funcall equal-predicate
-	     (value (slot-value form field-1))
-	     (value (slot-value form field-2)))))
-
-(define-html-form password-change ()
-    ((current-password (password-field
-			:validators (make-validators 'not-empty-validator)))
-     (new-password-1 (password-field
-		      :validators (make-validators 'not-empty-validator)
-		      :initially-validate nil))
-     (new-password-2 (password-field
-		      :validators (make-validators 'not-empty-validator)
-		      :initially-validate nil)))
-    ((user :initarg :user))
-    (:validators (fields-not-equal
-		  :field-1 'new-password-1
-		  :field-2 'new-password-2
-		  :message "New passwords do not match")
-		 (user-password-correct
-		  :field 'current-password
-		  :message "Current password is incorrect")))
-
-(defclass user-password-correct (form-validator)
-  ())
-
-(defmethod validate ((form password-change)
-		     (validator user-password-correct))
-  (with-slots (user) form
-    (beesknees.auth:check-password user (client-value
-					 (slot-value form
-						     (slot-value validator 'ucw-simple-form::field))))))
-
-(defmethod render :before ((self password-change))
-  (unless (slot-boundp self 'user)
-    (setf (slot-value self 'user) (session-user)))
-  (<:h1 (<:format "Change password for ~A"
-		 (beesknees.auth:username (slot-value self 'user)))))
-
-(defaction process-form ((self password-change))
-  (with-slots (user current-password new-password-1 new-password-2)
-      self
-    (cond ((and (beesknees.auth:check-password user (value current-password))
-		(string= (value new-password-1) (value new-password-2)))
-	   (setf (beesknees.auth:password user) (value new-password-1))
-	   (exit-user self)))))
-
-;; User List
-
-(defcomponent admin-user-list (bee-admin-list)
-  ()
-  (:default-initargs
-      :index-class 'beesknees.auth:user :index-slot 'beesknees.auth:username))
-
-(defmethod golgonooza:render-query-view-result ((user beesknees.auth:user)
-						(list bee-admin-list))
-  (<:as-html (beesknees.auth:username user)))
-
-(defcomponent user-logout (bee-widget)
-  ())
-
-(defmethod render ((c user-logout))
-  (<:p (<ucw:a :action (exit-user c) (<:as-html "Logout"))))
-
-(defcomponent weblog-admin (tabbed-pane)
-  ()
-  (:default-initargs
-      :current-component-key 'list
-      :contents `((list  . ,(make-instance 'weblog-entry-list))
-		  (new . ,(make-instance 'toplevel :wrap 'weblog-entry-editor)))))
-
-(defcomponent page-style-admin (tabbed-pane)
-  ()
-  (:default-initargs
-      :current-component-key 'list
-      :contents `((list  . ,(make-instance 'page-style-list))
-		  (new . ,(make-instance 'toplevel :wrap 'page-style-editor)))))
-
-(defcomponent page-admin (tabbed-pane)
-  ()
-  (:default-initargs
-      :current-component-key 'list
-      :contents `((list  . ,(make-instance 'page-list))
-		  (new . ,(make-instance 'toplevel :wrap 'page-editor))
-		  (style . ,(make-instance 'page-style-admin)))))
-
-(defcomponent user-admin (tabbed-pane)
-  ()
-  (:default-initargs
-      :current-component-key 'logout
-    :contents `((logout   . ,(make-instance 'user-logout))
-		(password . ,(make-instance 'password-change))
-		(manage   . ,(make-instance 'admin-user-list)))))
-
-(defcomponent video-admin (tabbed-pane)
-  ()
-  (:default-initargs
-    :current-component-key 'list
-    :contents `((list . ,(make-instance 'video-list))
-		(new . ,(make-instance 'toplevel :wrap 'video-editor)))))
-
-(defcomponent bee-admin-window (bee-window)
-  ()
-  (:default-initargs
-    :stylesheet '("static/css/admin.css")
-    :javascript '((:src "static/js/jquery/jquery-1.2.6.js"))
-    :body (make-instance 'bee-admin-pane
-			 :current-component-key 'weblog
-			 :contents `((weblog . ,(make-instance 'weblog-admin))
-				     (pages . ,(make-instance 'page-admin))
-				     (videos . ,(make-instance 'video-admin))
-				     (users . ,(make-instance 'user-admin))))))
rmfile ./src/web-admin.lisp
hunk ./src/web-common.lisp 1
-(in-package :beesknees.web)
-
-(defcomponent bee-window (standard-window-component)
-  ()
-  (:default-initargs
-    :title "The Bee's Knees"
-    :stylesheet '("static/css/common.css")))
-
-(defcomponent composite-container (html-block-element-mixin container)
-  ()
-  (:default-initargs :css-class "ucw-composite-container"))
-
-(defmethod render ((container composite-container))
-  (mapc (lambda (c)
-	  (<:div :class (symbol-name (car c))
-		 (render (cdr c))))
-	(container.contents container)))
-
-(defclass bee-widget (html-block-element-mixin)
-  ()
-  (:documentation "Widget component that sets css-class to class-name by default"))
-
-(defmethod initialize-instance :after ((c bee-widget)
-				       &rest keys)
-  (setf (html-element.css-class c)
-	(or (getf keys :css-class)
-	    (string-downcase (symbol-name (class-name (class-of c)))))))
-
-(defcomponent bee-page-component (bee-widget)
-  ((name :initarg :name :accessor page-name)
-   (hash :initform nil :accessor page-hash)))
-
-(defmethod render ((c bee-page-component))
-  (<:as-is (page->html (get-instance-by-value 'bee-page
-					      'beesknees.pages::name
-					      (page-name c)))))
-
-(defpclass bee-page-style ()
-  ((name :initarg :name :accessor page-name :index t)
-   (background :initarg :background :initform nil :accessor page-background))
-  (:index t))
-
-(defcomponent bee-video (bee-widget)
-  ((video-id :initarg :video-id :accessor video-id)))
-
-(defmethod render ((video bee-video))
-  (let ((id (ps:ps-gensym)))
-    (<:p :class "video-object"
-	 :id id
-	 (<:as-html "It would appear that you do not have flash."))
-    (<ucw:script
-     `(flashembed ,(format nil "~A" id)
-		  ,(format nil "http://www.youtube.com/v/~A"
-			   (video-id video))
-		  (ps:create :movie ,(format nil "http://www.youtube.com/v/~A"
-					   (video-id video)))))))
rmfile ./src/web-common.lisp
hunk ./src/web-frontend.lisp 1
-(in-package :beesknees.web)
-
-(defcomponent bee-frontend-page (bee-page-component)
-  ())
-
-(defcomponent bee-home-video (bee-video)
-  ())
-
-(defmethod render :before ((c bee-home-video))
-  (<:img :src (arnesi:strcat
-	       (application.url-prefix (context.application *context*))
-	       "static/img/logos/latest-video.png")
-	 :alt "Latest Video"
-	 :class "header"))
-
-(defcomponent bee-home (bee-widget composite-container)
-  ()
-  (:default-initargs
-    :contents `((video . ,(make-instance 'bee-home-video :video-id "JPL4oz6G8l4"))
-		(blog  . ,(make-instance 'bee-home-blog :limit 1)))))
-
-;; rename image-navigation-pane-mixin?
-(defcomponent bee-frontend-pane (tabbed-pane tal-component)
-  ((img-root :initarg :img-root)))
-
-(defclass bee-switch-link-action (standard-action)
-  ((target-component :initarg :target :accessor target-component :initform nil))
-  (:metaclass c2mop:funcallable-standard-class))
-
-(defmethod compute-url ((action bee-switch-link-action) (pane bee-frontend-pane))
-  (let ((url (call-next-method)))
-    (when-bind target (target-component action)
-      (append-path-to-uri url (format nil "pages/~(~A~)" (car target))))
-    url))
-
-(defun switch-link (pane component)
-  (make-action (lambda ()
-		 (with-call/cc
-		   (switch-component pane (car component))))
-	       :class 'bee-switch-link-action
-	       :target component))
-
-(defmethod tal-component-environment nconc ((pane bee-frontend-pane))
-  (let ((page-style (elephant:get-instance-by-value
-		     'bee-page-style 'name
-		     (container.current-component-key pane))))
-    (yaclml:tal-env
-     'contents
-     (mapcar (lambda (component)
-	       (let ((selectedp (funcall (container.key-test pane)
-					 (car component)
-					 (container.current-component-key pane))))
-		 (yaclml:tal-env
-		  'value component
-		  'selected selectedp
-		  'navbar-image-url (format nil "~A~A~A~D.png"
-					    (application.url-prefix
-					     (context.application *context*))
-					    (slot-value pane 'img-root)
-					    (string-downcase
-					     (symbol-name (car component)))
-					    (if selectedp 2 1)))))
-	     (container.contents pane))
-     'selected-component (container.current-component pane)
-     'component-style page-style
-     'page-background-url (when page-style
-			    (format nil
-				    "/static/img/backgrounds/~A"
-				    (arnesi:escape-as-uri
-				     (page-background page-style)))))))
-
-(defcomponent bee-frontend-window (bee-window)
-  ()
-  (:default-initargs
-    :stylesheet '("/static/css/frontend.css")
-    :javascript '((:src "/static/js/flashembed-0.34.js"))
-    :body (make-instance
-	   'bee-frontend-pane
-	   :css-class "bee-frontend-pane"
-	   :img-root "static/img/navigation/"
-	   :current-component-key 'home
-	   :template-name "frontend-pane.tal"
-	   :contents
-	   `((home . ,(make-instance 'bee-home :name :home))
-	     (videos . ,(make-instance 'bee-videos))
-	     (blog . ,(make-instance 'bee-paged-blog :name :blog :page-size 5))
-	     (about . ,(make-instance 'bee-frontend-page :name :about))
-	     (contact . ,(make-instance 'bee-frontend-page :name :contact))
-	     (links . ,(make-instance 'bee-frontend-page :name :links))))))
+
rmfile ./src/web-frontend.lisp
addfile ./src/web/bee-page.lisp
hunk ./src/web/bee-page.lisp 1
+(in-package :beesknees.pages)
+
+(defparameter *markdown-output-cache*
+  (make-hash-table :test #'equalp
+		   ;; may need to just do locking manually for
+		   ;; portability... OTOH as long as an implementation
+		   ;; gurantees that concurrent writers won't corrupt
+		   ;; the hash table it doesn't particularly matter
+		   #+sbcl :synchronized #+sbcl t))
+
+(defun find-cached-markdown-output (markdown-hash)
+  (gethash markdown-hash *markdown-output-cache*))
+
+(defun cache-markdown-output! (markdown-hash markdown-text)
+  (setf (gethash markdown-hash *markdown-output-cache*)
+	(multiple-value-bind (doc string)
+	    (markdown:markdown markdown-text :stream nil :format :html)
+	  (declare (ignore doc))
+	  string)))
+
+(defextension (image :arguments ((name :required)
+				 alt
+				 (float :keyword))
+		     :insertp t)
+  (ecase phase
+    (:parse nil)
+    (:render (yaclml:with-yaclml-output-to-string
+	       ;; fixme: use url-prefix
+	       (<:img :src (format nil "/static/img/uploaded/~A" name)
+		      :alt (or alt "image")
+		      :style (case float
+			       ((:left) "float: left;")
+			       ((:right) "float: right")))))))
+
+(pushnew 'cl-markdown-user:image *render-active-functions*)
+
+(defpclass bee-page (cacheable-persistent-object)
+  ((name :accessor page-name :initarg :name :index t)
+   (content :accessor page-content :initarg :content)))
+
+(defmethod initialize-instance :after ((page bee-page)
+				       &key (content nil content-supplied-p)
+				       &allow-other-keys)
+  (when content-supplied-p
+    (setf (page-content page) content)))
+
+(defmethod (setf page-content) :after (content (page bee-page))
+  (setf (golgonooza-db:object-hash page) (md5:md5sum-sequence content)))
+
+(defun page->html (bee-page)
+  (ensure-transaction ()
+    (or (find-cached-markdown-output (golgonooza-db:object-hash bee-page))
+	(cache-markdown-output! (golgonooza-db:object-hash bee-page)
+				(page-content bee-page)))))
+
addfile ./src/web/common.lisp
hunk ./src/web/common.lisp 1
+(in-package :beesknees.web)
+
+(defcomponent bee-window (standard-window-component)
+  ()
+  (:default-initargs
+    :title "The Bee's Knees"
+    :stylesheet '("static/css/common.css")))
+
+(defcomponent composite-container (html-block-element-mixin container)
+  ()
+  (:default-initargs :css-class "ucw-composite-container"))
+
+(defmethod render ((container composite-container))
+  (mapc (lambda (c)
+	  (<:div :class (symbol-name (car c))
+		 (render (cdr c))))
+	(container.contents container)))
+
+(defclass bee-widget (html-block-element-mixin)
+  ()
+  (:documentation "Widget component that sets css-class to class-name by default"))
+
+(defmethod initialize-instance :after ((c bee-widget)
+				       &rest keys)
+  (setf (html-element.css-class c)
+	(or (getf keys :css-class)
+	    (string-downcase (symbol-name (class-name (class-of c)))))))
+
+(defcomponent bee-page-component (bee-widget)
+  ((name :initarg :name :accessor page-name)
+   (hash :initform nil :accessor page-hash)))
+
+(defmethod render ((c bee-page-component))
+  (<:as-is (page->html (get-instance-by-value 'bee-page
+					      'beesknees.pages::name
+					      (page-name c)))))
+
+(defpclass bee-page-style ()
+  ((name :initarg :name :accessor page-name :index t)
+   (background :initarg :background :initform nil :accessor page-background))
+  (:index t))
+
+(defcomponent bee-video (bee-widget)
+  ((video-id :initarg :video-id :accessor video-id)))
+
+(defmethod render ((video bee-video))
+  (let ((id (ps:ps-gensym)))
+    (<:p :class "video-object"
+	 :id id
+	 (<:as-html "It would appear that you do not have flash."))
+    (<ucw:script
+     `(flashembed ,(format nil "~A" id)
+		  ,(format nil "http://www.youtube.com/v/~A"
+			   (video-id video))
+		  (ps:create :movie ,(format nil "http://www.youtube.com/v/~A"
+					   (video-id video)))))))
adddir ./src/weblog
hunk ./src/weblog.lisp 1
-(in-package :beesknees.weblog)
-
-(defpclass weblog-entry ()
-  ((title :initarg :title :accessor entry-title)
-   (author :initarg :author :accessor entry-author :index t)
-   (posted :initarg :posted :accessor entry-posted :index t)
-   (body :initarg :body :accessor entry-body)
-   (%comment-count :initform 0 :reader entry-comment-count)))
-
-(defpclass weblog-comment ()
-  ((parent :initarg :parent :accessor comment-parent :index t)
-   (title :initarg :title :accessor comment-title)
-   (author :initarg :author :accessor comment-author)
-   (posted :initarg :posted :accessor comment-posted :index t)
-   (body :initarg :body :accessor comment-body)))
-
-(defmethod initialize-instance :after ((comment weblog-comment)
-				       &key (from-oid nil from-oid-p) parent
-				       &allow-other-keys)
-  (declare (ignore from-oid))
-  (unless (or from-oid-p (not parent))
-    (ensure-transaction ()
-      (iter:iter (iter:for p :initially (comment-parent comment)
-			     :then (comment-parent p))
-		 (iter:finding p :such-that (typep p 'weblog-entry))
-		 (iter:finally (setf (slot-value p '%comment-count)
-				     (1+ (slot-value p '%comment-count))))))))
-
-(defmethod elephant:drop-instance :before ((comment weblog-comment))
-  (when (comment-parent comment)
-    (ensure-transaction ()
-      (iter:iter (iter:for p :initially (comment-parent comment)
-			     :then (comment-parent p))
-		 (iter:finding p :such-that (typep p 'weblog-entry))
-		 (iter:finally (setf (slot-value p '%comment-count)
-				     (1- (slot-value p '%comment-count))))))))
-
-(defun child-comments (entry/comment)
-  (get-instances-by-value 'weblog-comment 'parent entry/comment))
+
rmfile ./src/weblog.lisp
addfile ./src/weblog/core.lisp
hunk ./src/weblog/core.lisp 1
-
+(in-package :beesknees.weblog)
+
+(defpclass weblog-entry ()
+  ((title :initarg :title :accessor entry-title)
+   (author :initarg :author :accessor entry-author :index t)
+   (posted :initarg :posted :accessor entry-posted :index t)
+   (body :initarg :body :accessor entry-body)
+   (%comment-count :initform 0 :reader entry-comment-count)))
+
+(defpclass weblog-comment ()
+  ((parent :initarg :parent :accessor comment-parent :index t)
+   (title :initarg :title :accessor comment-title)
+   (author :initarg :author :accessor comment-author)
+   (posted :initarg :posted :accessor comment-posted :index t)
+   (body :initarg :body :accessor comment-body)))
+
+(defmethod initialize-instance :after ((comment weblog-comment)
+				       &key (from-oid nil from-oid-p) parent
+				       &allow-other-keys)
+  (declare (ignore from-oid))
+  (unless (or from-oid-p (not parent))
+    (ensure-transaction ()
+      (iter:iter (iter:for p :initially (comment-parent comment)
+			     :then (comment-parent p))
+		 (iter:finding p :such-that (typep p 'weblog-entry))
+		 (iter:finally (setf (slot-value p '%comment-count)
+				     (1+ (slot-value p '%comment-count))))))))
+
+(defmethod elephant:drop-instance :before ((comment weblog-comment))
+  (when (comment-parent comment)
+    (ensure-transaction ()
+      (iter:iter (iter:for p :initially (comment-parent comment)
+			     :then (comment-parent p))
+		 (iter:finding p :such-that (typep p 'weblog-entry))
+		 (iter:finally (setf (slot-value p '%comment-count)
+				     (1- (slot-value p '%comment-count))))))))
+
+(defun child-comments (entry/comment)
+  (get-instances-by-value 'weblog-comment 'parent entry/comment))
addfile ./src/weblog/image-manager.lisp
hunk ./src/weblog/image-manager.lisp 1
+(in-package :beesknees.web)
+
+(define-html-form image-upload (file-upload-form)
+  ((image (file-upload-field)))
+  ((upload-root :initarg :root :initform `("wwwroot" "img" "uploaded"))))
+
+(defaction process-form ((form image-upload))
+  (with-slots (image upload-root) form
+    (let ((upload-stream
+	   (let ((original-file-name (rfc2388-binary:get-header-attribute
+				      (rfc2388-binary:get-header (value image)
+								 "Content-Disposition")
+				      "filename")))
+	     (open (make-pathname
+		    :directory `(:absolute
+				 ,@(split-sequence:split-sequence
+				    #\/ beesknees.site-control::*bee-data-root*)
+				 ,@upload-root)
+		    :name (pathname-name original-file-name)
+		    :type (pathname-type original-file-name))
+		   :direction :output
+		   :element-type 'unsigned-byte
+		   :if-exists :supersede))))
+      (fad:copy-stream (mime-part-body (value image)) upload-stream)
+      (answer (namestring upload-stream)))))
+
+
+(defcomponent pathname-query-view-mixin ()
+  ((query-path :initarg :pathname :accessor query-pathname)))
+
+(defmethod golgonooza:query-view-get-instances ((query pathname-query-view-mixin)
+						lower upper
+						&key limit skip from-end exclusive)
+  (declare (ignore lower upper exclusive)) ; ranges make no sense for pathnames
+  (let ((matches (directory (query-pathname query))))
+    (break "~A" matches)
+    (when from-end (setf matches (nreverse matches)))
+    (when skip (setf matches (nthcdr skip matches)))
+    (when limit (let ((tail (nthcdr limit matches)))
+		  (setf tail nil)))
+    matches))
+
addfile ./src/weblog/markdown-editor.lisp
hunk ./src/weblog/markdown-editor.lisp 1
+(in-package :beesknees.web)
+
+(defcomponent markdown-preview (bee-widget)
+  ((text :initarg :text :reader text)))
+
+(defmethod render ((m markdown-preview))
+  (<:div
+   (cl-markdown:markdown (text m) :stream yaclml:*yaclml-stream* :format :html))
+  (<ucw:form :action (answer)
+	     (<ucw:submit :action (answer) :value "Ok")))
+
+(define-html-form markdown-content-editor ()
+  ((content (textarea-field :rows 30 :cols 80 :dom-id "content-editor")))
+  ())
+
+(defvar *last-image-upload* nil)
+
+(defmethod render :before ((e markdown-content-editor))
+  (with-slots (content) e
+    (<:fieldset
+     (<:legend "Markdown")
+     (<:script :src "static/js/jquery/ui/ui.core.js")
+     (<:script :src "static/js/jquery/ui/ui.draggable.js")
+     (<:script :src "static/js/jquery/ui/ui.droppable.js")
+     (<ucw:submit :value "Preview" :action (call 'markdown-preview
+						 :text (value content)))
+     (<ucw:submit
+      :value "Upload Image"
+      :action (setf *last-image-upload*
+		    (let ((path (call 'image-upload)))
+		      (format nil "~A.~A" (pathname-name path)
+			      (pathname-type path)))))
+     (<:a :href "http://daringfireball.net/projects/markdown/syntax"
+	  :target "_new"
+	  (<:as-html "Markdown Syntax Reference"))
+     (when *last-image-upload*
+       (<:p (<:img :id "last-image-upload"
+		   :class "droppable-image-link"
+		   :alt "last uploaded image"
+		   :style "max-width: 200px;"
+		   :title *last-image-upload*
+		   :src (format nil
+				"/static/img/uploaded/~A" *last-image-upload*))
+	    (<:ah "Drag the image into the document where you want to display it."))
+       (<ucw:script
+	`(.data (.draggable ($ "#last-image-upload")
+			    (ps:create :revert true))
+		"markdown-text"
+		,(format nil "{image ~S}" *last-image-upload*)))
+       (setf *last-image-upload* nil)))))