Prefix-based dispatch for Weblocks

gistfile1.cl

;
; An example of prefix-based dispatch for Weblocks.
;
; This code allows you to have URLs like http://foo/details/callsign and
; http://foo/limited/callsign, and dispatch to different widgets based on
; pattern matching. In this case we dispatch to one widget for /details
; and another for /limited, in both cases passing callsign to the
; target widget.
;
; Error handling is left as an exercise for the reader ;)
;
(defwidget prefix-selector (on-demand-selector)
  ()
  (:default-initargs :lookup-function #'galosh-selector)
  (:documentation "Foo"))

(defun galosh-selector (selector tokens)
  (cond ((equal (first tokens) "details")
	 (values (make-instance 'log-details :call (second tokens) :cols *detail-columns*)
		 tokens nil :no-cache))
	((equal (first tokens) "limited")
	 (values (make-instance 'log-details :call (second tokens) :cols *limited-columns*)
		 tokens nil :no-cache))
	(t
	 (values (make-instance 'funcall-widget :fun-designator (lambda (&rest args)
								  (with-html (:p "Something else"))))
		 (car tokens) (cdr tokens)))))

(defwidget log-details ()
  ((call :accessor log-widget-call :initform nil :initarg :call)
   (cols :accessor log-widget-cols :initform *limited-columns* :initarg :cols)))

(defmethod render-widget-body ((widget log-details) &rest args)
   ; your rendering code here)

(defun init-user-session (comp)
  (setf (composite-widgets comp)
    (make-instance 'prefix-selector)))