;;;; blog-v4: add a blog widget
;;;; One straightforward way to go is to have the BLOG-WIDGET contain
;;;; a list of POST-WIDGETs for each post, and one for the current
;;;; post. The weblocks COMPOSITE widget can already handle a list of
;;;; widgets for us, so we'll use it again.
;;; src/specials.lisp
(in-package :blog)
(defvar *blog-title* "Blog")
;;; src/widgets/blog.lisp
(in-package :blog)
(defwidget blog-widget ()
((current-post :accessor current-post
:initarg :current-post
:initform nil
:documentation "POST-WIDGET containing the current
post when the blog is in :POST mode")
(posts :accessor posts
:initarg :posts
:initform (make-instance 'composite)
:documentation "composite widget that contains a POST-WIDGET
for each post of the blog")
(mode :accessor mode
:initarg :mode
:initform :blog
:documentation "The blog can be in two modes, :BLOG
and :POST. In :BLOG mode to display a list of posts, and
in :POST mode to display an individual post.")
(post-short-view :accessor post-short-view
:initarg :post-short-view
:initform nil
:documentation "see SHORT-VIEW slot of POST-WIDGET")
(post-full-view :accessor post-full-view
:initarg :post-full-view
:initform nil
:documentation "see FULL-VIEW slot of POST-WIDGET"))
(:documentation "widget to handle a blog"))
(defgeneric blog-action-blog-mode (blog-widget)
(:documentation "return an action that will switch BLOG-WIDGET into :BLOG
mode")
(:method ((blog-widget blog-widget))
(make-action
(lambda (&rest args)
(declare (ignore args))
(when (current-post blog-widget)
(setf (mode (current-post blog-widget)) :short))
(setf (mode blog-widget) :blog)
(reset-blog blog-widget)))))
(defgeneric blog-make-post-widget (blog-widget post)
(:documentation "make a POST-WIDGET containing POST. (called by
RESET-BLOG)")
(:method ((blog-widget blog-widget) (post post))
(make-instance 'post-widget
:post post
:short-view (post-short-view blog-widget)
:full-view (post-full-view blog-widget)
;;; we'll add a new slot to POST-WIDGET for this
:on-select (lambda (post-widget)
(setf (current-post blog-widget) post-widget)
(setf (mode blog-widget) :post)))))
(defgeneric reset-blog (blog-widget)
(:documentation "Reset the list of post widgets from the posts in
the database. This function is called by BLOG-ACTION-BLOG-MODE.")
(:method ((blog-widget blog-widget))
(setf (composite-widgets (posts blog-widget))
(mapcar (lambda (post)
(blog-make-post-widget blog-widget post))
(all-posts)))))
(defmethod initialize-instance :after ((obj blog-widget) &key)
(reset-blog obj))
(defgeneric render-blog (blog-widget mode)
(:documentation "render a blog widget in mode MODE. This function
is called by RENDER-WIDGET-BODY."))
(defmethod render-blog ((blog-widget blog-widget) (mode (eql :blog)))
(with-html (:h1 *blog-title*))
(render-widget (posts blog-widget)))
(defmethod render-blog ((blog-widget blog-widget) (mode (eql :post)))
(with-html
(:h1
;; link to come back to the blog
(render-link (blog-action-blog-mode blog-widget)
*blog-title*)))
(render-widget (current-post blog-widget)))
(defmethod render-widget-body ((obj blog-widget) &key)
(render-blog obj (mode obj)))
;;;; When we make the POST-WIDGET in the function
;;;; BLOG-MAKE-POST-WIDGET, we introduced a new :ON-SELECT initarg
;;;; which is a function that should be called when the post is
;;;; selected (to view it) to appropriately set the state of
;;;; BLOG-WIDGET. So we'll now make the corresponding changes to
;;;; POST-WIDGET.
;;; src/widgets/post.lisp
(in-package :blog)
(defwidget post-widget ()
(;; slots as before
(post :accessor post
:initarg :post
:initform nil)
(mode :accessor mode
:initarg :mode
:initform :short
:documentation "The post can be displayed in two
versions, :SHORT and :FULL.")
(short-view :accessor short-view
:initarg :short-view
:initform nil
:documentation "View to determine how the post is
displayed when in :SHORT mode.")
(full-view :accessor full-view
:initarg :full-view
:initform nil
:documentation "View to determine how the post is
displayed when in :SHORT mode.")
;; new slot
(on-select :accessor on-select
:initarg :on-select
:initform nil
:documentation "Function to be called when this post is
selected. It accepts POST-WIDGET as argument."))
(:documentation "widget to handle a blog post"))
;;; new function
(defgeneric post-action-select (post-widget)
(:documentation "return an action that selects POST-WIDGET")
(:method ((post-widget post-widget))
(make-action
(lambda (&rest args)
(declare (ignore args))
(setf (mode post-widget) :full)
(safe-funcall (on-select post-widget) post-widget)))))
(defmethod render-widget-body ((obj post-widget) &key)
(ecase (mode obj)
(:short
(when (short-view obj)
(render-object-view (post obj) (short-view obj)
:widget obj
;; after the fields of the POST object,
;; display a link to see the full post
:fields-suffix-fn
(lambda (&rest args)
(declare (ignore args))
(when (on-select obj)
(render-link (post-action-select obj) "more"))))))
(:full
(when (full-view obj)
(render-object-view (post obj) (full-view obj) :widget obj)))))
;;;; Now we'll change the MAKE-BLOG-WIDGET function in the layout to
;;;; make a BLOG-WIDGET instead of a POST-WIDGET. And provide two
;;;; specialized views POST-SHORT-VIEW and POST-FULL-VIEW to nicely
;;;; display the posts.
;;; modification in src/layout.lisp
(defun make-blog-widget ()
(let ((composite
(make-instance
'composite
:widgets (list
(make-instance 'blog-widget
:post-short-view 'post-short-view
:post-full-view 'post-full-view)))))
(push (lambda ()
(render-link (lambda (&rest args)
(declare (ignore args))
(answer composite))
"admin"))
(composite-widgets composite))
composite))
;;;; For the views, we'll have POST-DATA-VIEW display properly
;;;; formatted time and the author name instead of "User" that is the
;;;; default when converting an object of class USER to a string. We
;;;; can then inherit from this view and hide either the TEXT slot or
;;;; the SHORT-TEXT slot to define the short and full views.
;;; modification in src/views.lisp
(defview post-data-view (:type data :inherit-from '(:scaffold post))
(author :reader #'post-author-name)
(time :reader #'post-formatted-time))
(defview post-short-view (:type data :inherit-from 'post-data-view)
(text :hidep t))
(defview post-full-view (:type data :inherit-from 'post-data-view)
(short-text :hidep t))
;;; add in src/models.lisp
(defgeneric post-author-name (post)
(:method ((post post))
(when (post-author post)
(user-name (post-author post)))))
(defun post-formatted-time (post)
(multiple-value-bind (second minute hour date month year day
daylight-p zone)
(decode-universal-time (post-time post))
(declare (ignore second daylight-p zone date))
;; my format-foo is not very good so please improve if you can :)
(format nil "~d-~d-~d ~d:~d" year month day hour minute)))
;;;; ChangeLog
blog-v4
* blog.asd (blog): add new file
* src/models.lisp (post-author-name, post-formatted-time): backend
functions
* src/layout.lisp (make-blog-widget): make a BLOG-WIDGET instead
of POST-WIDGET
(make-blog-widget): use new views for the post
* src/views.lisp (post-data-view): modify to display formatted
time, and user name instead of "User"
(post-short-view, post-full-view): new views for used the two
states POST-WIDGET
* src/widgets/post.lisp (post-widget): add ON-SELECT slot so that
BLOG-WIDGET can set a call-back
(post-action-select): return an action that selects POST-WIDGET
(render-widget-body): modify to add a link to see the full post
[and call the ON-SELECT function if defined]
* src/widgets/blog.lisp:
(blog-action-blog-mode, blog-make-post-widget, reset-blog)
(render-blog, initialize-instance, render-widget-body): new blog
widget
* src/specials.lisp (*blog-title*): blog title
blog-v3
* blog.asd (blog): updated for new files
* src/layout.lisp (make-blog-widget): create a composite widget
with a post widget and a link
(make-admin-page): add a link to MAKE-BLOG-WIDGET
* src/models.lisp (all-posts, post-by-id): backend functions
* src/widgets/post.lisp (post-widget): simple post widget
(render-widget-body): specialized method to render the post
blog-v2
* src/models.lisp (post-author-id, all-users): functions used by
the views
* src/views.lisp (post-form-view): override some fields - textarea
for the texts, and dropdown list for the author
blog-v1:
* src/views.lisp (user-table-view, user-data-view, user-form-view)
(post-table-view, post-data-view, post-form-view): scaffolded views
for the gridedit interface
* src/init-session.lisp (init-user-session): call MAKE-ADMIN-PAGE
* src/layout.lisp (make-users-gridedit, make-posts-gridedit)
(make-admin-page): add simple gridedit interface for the two
models
* src/models.lisp (user, post): USER and POST models
