Learning About Weblocks

Weblocks is a
continuation-based web server, which means it's basically Magic.

Unfortunately, magic has a steep learning curve. I'm going to try
to write down here the things that weren't obvious to me as I learn
how to use the thing, in the hopes they'll be helpful to someone

On top of that, by the way, I am a very fast learner but a very slow
understander. I know, for example, how to fix problems with LDAP
accounts, but have not the slightest clue how LDAP works. I don't
tend to bother to really understand anything about the context
of what I do, because it takes me such a very long time. As a
sysadmin, this is surprisingly effective (my career has been doing
very well). As a programmer... Well, there are reasons I'm not a
professional programmer, and this is one of them. So if you find
yourself going "duh" to the things I had to figure out, well, that's
probably why.

The Various Weblocks Content Elements

There are a bunch of different ways that weblocks can present
content, and it's a bit confusing when to use which, at least for

Lambdas Are Widgets Too!

The user manual actually says this, but I keep forgetting. :-)

(lambda () ...) is a valid Weblocks widget. It is expected to run
with-html, which writes to *weblocks-output-stream*, which is where
html needs to go sooner or later to be seen in Weblocks.

Now, in theory you want to not actually produce HTML directly if you
can avoid it. You want to make widgets and views and have them
generate the HTML. In the early phases, though, I use lots of this

But They Are Special; Use With Caution!

There is one really, really big difference between using lambdas as
widgets and pretty much everything else: lack of persistence. A
lambda is re-executed every time it needs to be rendered; it's not
executed once and the return value stored or anything like that.
This means that if you want a widget to behave persistently, there
can't be a lambda involved anywhere in the stack that generates it,
or it'll get recreated on every user action.

Render Calls

Inside of functions and widgets you can directly call the render-*
functions for various purposes, for example having a link that
performs an action (render-link). These do not count as widgets
by themselves, so if you want to use them in a composite widget or
whatever you have to wrap them in a function.


The weblocks manual gives the impression that you'll spend most of
your time using actual widgets as such. In the early stages at
least, I haven't been doing that very much; I've been using render-*
functions and with-html inside functions.

Having said that, widgets really are the right way to do things
once you get to the point where you're trying to do things right, at
least for the most part.

Regardless of that, you definately need widgets if you're going
to rely on Weblocks' wonderful automatic change detection. The way
that works is that if any part of your code changes the data in a
slot on a widget, Weblocks redraws it as efficiently as it can.
This is really, really neat. :-)

Taking Back The URL

Sometimes, whether it fits your model or not, you really want to
control the URLs that your application uses. Weblocks doesn't want
you to do that... Or does it!?

It's actually not that hard to pick your URLs in a Weblocks app once
you know how. Figuring out how is pretty non-trivial, but having
finally done so I'm going to share my hard-won knowledge with you.

The general mechanism is dispatchers. Weblocks has some magic tree
of dispatchers inside it somewhere, and it calls them to ask them if
they want to handle various URLs. The actual dispatcher widget is
the hardest one to use, though, so we'll do it last.

The Navigation Widget

The navigation widget is by far the easiest way to manage your
application's URLs. The make-navigation function makes this extra
easy. Just pass the thing a list of names and functions/widgets,
and that's it:

<pre> (make-navigation 'main-menu 'users (make-users-page) 'clients (make-clients-page)) </pre>

This will present the user with a menu that says "Users" and
"Clients" (they will be marked up as links), and depending on which
the user picks they will get presented with the output of the
appropriate function.

This is great for dividing your site into sections, or cases when
there's a fixed list of options and you want the user to be able to
pop between them.

The Selector Widget

The selector widget is just like the navigation widget, except far
harder to use. :-D

That's actually unfair; the selector widget is for when you want the
behaviour of the navigation widget without the little menu.

<pre> (make-instance 'selector :panes (list (cons "users" (make-users-page)) (cons "clients" (make-clients-page)))) </pre>

Given this at the root, if the user goes to "your site/users" they
will get (make-users-page), but there will be no menu presented to
let them move between the various options.

The Dispatcher Widget

The navigation widget is built on the selector widget which is built
on the dispatcher widget. All the dispatcher widget does is run its
on-dispatch function
(function, not method).

The docts for on-dispatch are actually pretty decent, so I'll let
you read them for the basic functionality, but there are a few
things that are a bit surprising.

If any dispatcher at a given level (see nesting below) returns
nil as the first value, a 404 is given to the user. This means that
if you want an invisible dispatcher, you need to return "" or
something, not nil. Same for when you're just testing and don't
know what you're gonna do with the thing yet.

A side effect of this is that if you want to add dispatcher and to
have it work on the base URL of the section it's in, you need to
code in the no-url-tokens case (which is passed as nil, btw).

Here's a simple dispatcher that approximately emulates the selector
above, except that it defaults to the clients page instead of the
users page.

<pre> (make-instance 'dispatcher :on-dispatch (lambda (widget url-bits) (declare (ignore widget)) (cond ((string= (first url-bits) "users") (make-users-page)) ((string= (first url-bits) "clients") (make-clients-page)) ((not url-bits) (make-clients-page))))) </pre>

There's no reason to use dispatcher for this case, though. Where
you want to use dispatcher is for cases like wikis (where the URL
gets looked up in a database but you still want it to be meaningful)
or when you want meangiful urls for a bunch of databased items (like
/users?id=5 to retrieve the 5th user).

You shouldn't have any trouble figuring out how to do that from
here, though. The URL segments being requested live in url-bits
above, and if you need the GET parameters, use request-parameters
or request-parameter.

Nesting Of Dispatchers

If you put a dispatcher (meaning anything descended from dispather)
the widgets present by another dispatcher, it will only get asked
about the URL bits that haven't already been handled by the parent.
So if you are already in /users and you ask for /users/foo, the
widget will only get asked about ("foo"). Just FYI.

Extending Navigation Or Selector Dispatching

If you want to extend a navigation or selector widget into custom
dispatcher stuff, you can do something like this, assuming a widget
named nav has already been created:

<pre> (setf (dispatcher-on-dispatch nav) (lambda (widget url-bits) (declare (ignore widget)) (describe url-bits) ;; YOUR CODE GOES HERE (apply #'selector-on-dispatch widget url-bits))) </pre>

That's if you want to modify just a single object; if you want to
make your own modified class, do this instead:

<pre> (defmethod selector-on-dispatch ((self my-navigation-or-selector) tokens) (describe (list obj tokens)) ;; YOUR CODE GOES HERE (call-next-method)) </pre>

(props to Stephen Compall for that).

Page Titles

The page title is, by default, generated from the application name
followed by a dash, followed by the application description or
current page description, depending on whether you're at the home
page or not.

To override the first component, pass a string with :name to

To override the second component on the home page, pass a string
with :description to start-webapp.

To override the second component, put this in the page's widget
somewhere it'll get executed (i.e., make a lambda component of a
composite widget or something) and put this in:

<pre> (declare (special *current-page-description*)) (setf *current-page-description* "Search For A User") </pre>

A Caution About Composite Widgets

Just as a general note, you may have noticed that I use composite
widgets quite a lot. There's a simple reason for this: they
are the swiss-army knife of half-finished weblocks code.


Composite widgets are how I string a bunch of half-assed (lambda ()
(with-html ... )) clusters together as I'm learning how this stuff
really works. This isn't actually how a decent Weblocks application
looks, I don't think. I'm tentative here because I haven't actually
written a decent weblocks app, but I think that in such a thing
composite widgets would be used to hold together a bunch of
fully-fleshed-out custom widgets, not a bunch of with-html bits, and
would only be used when holding widgets together without any kind of
other common context was actually what was called for.

Custom Widgets Are Your Friends!

If you're like me, making custom widgets sounds kind of like
creating a template or something: if you're writing exploratory or
half-assed code, it seems like overhead you should just skip.

This turns out to really not be the case if you're doing anything
much in response to user input. It turns out in Weblocks that using
custom widgets to display different things depending on what the
user does is actually far easier than doing it yourself with
with-html and composite widgets and so on. Trust me on this.

Using do-page, do-widget, and answer

For more than you ever wanted to know about this whole topic, I
started a non-trivial
list thread
with my whining.

do-page and answer

So from reading
Web Applications in Common Lisp With Weblocks
, it seemed that
continuation based stuff in Weblocks is easy (which is true) and
that using answer and do-page is trivial (rather less so).

In particular, I was quite surprised to discover that answer has a
required argument. You can get the blow-by-blow of my confusion
the relevant mailing list thread
, but I've tried to distill what
I've learned here. Thanks to Stephen Compall (again) and Ian Eslick
for the help.

answer can take either a continuation or a widget. I won't get into
passing it actual continuations; for one thing, I don't really
understand it, and for another, if you wanted to deal with
continuations manually you probably wouldn't be using Weblocks.

So, we need to pass it a widget. Great. How?

Well, here's ... not the easiest way, but the way that involves
using only what Weblocks comes with:

<pre> (render-link (lambda/cc (&rest args) (declare (ignore args)) (let comp (make-instance 'composite) (setf (composite-widgets comp) (list "Some Text." (lambda () (render-link (lambda (&rest args) (answer comp)) "OK, Done")))) (do-page comp))) "Should Make A Page, Then Return.") </pre>

There's nothing especially exciting going on here. The outer
render-link runs the lambda when clicked. The lambda runs do-page
on a composite widget. The composite widget describes a page with
with "Some Text." and another link. That link runs answer against
the composite widget.

Do notice, however, that to get the widget we put a let around the
simplest possible form of it, and then setf the composite widgets
slot with what we actually want.

What (do-page comp) does here is it takes the current state of the
app, stores it away, and replaces it with the contents of comp. It
also stores the current state in the "continuation" slot on comp.
Then when you run (answer comp), the previous state is restored by
getting it out of comp's continuation slot.

So the upshot is, you need to call do-page on a widget, then answer
on that same widget (or, conveniently, one of its children), and
then do-page returns like a function call. Yay.

If you want to actually make use of that function-like behaviour,
pass another argument to answer, and do-page will return it.

do-widget and navigation widgets

Unfortunately, if you try this on a page with a non-trivial URL
(i.e. one that has a navigation widget; see the "Taking Back The
URL" section), the results will not be what you're looking for:
you'll get a 404. The reason is this:

Let's say you're at http://my-site/foo, because that's
where you went in the navigation widget. You then have a bit of
do-page code like the one above. You click on the link. You're
still at http://my-site/foo, and you have a 404. This is
because do-page replaces the entire page, including the
navigation widget.

Whoopsie. No navigation widget, no /foo (or anything else other
than /, in fact).

FWIW (which isn't much), you can strip off the last bit and just go
to http://my-site/, where you'll see the do-page page presented in
all its glory. You can go through it as normal and... when you're
done, you'll end up back at http://my-site/. Not so helpful.

This sort of thing is what do-widget is for. do-widget replaces a
given widget A with another widget B, storing the current state in
A's continuation slot. In fact, do-page is a special case of
do-widget; if you pass nil as the first argument to do-widget, it'll
replace the whole page just like do-page.

So with the navigation widget example, what you want is to do is use
the same let+setf trick as the code snippet above (or any other
trick you like, actually) to get access to the widget that is
hanging off the navigation widget for the page you're working on.
Then the only difference to the example above is instead of (do-page
comp) you run (do-widget widget-under-navigation comp).

Getting At The Widget From The Inside

Having to wrap the widget in let or something and then pass it to
the code that has answer in it is, at the least, inelegant. There
are a few ways you can get access to the widget from inside the
widget's code, which makes things less ugly. This means not dealing
with composite widgets, though, although you can certainly defwidget
an unchanged descendant of them or something. An example, from Ian

<pre> (defmethod render-widget-body (widget &rest args) (render-link (lambda (&rest args) (answer widget)))) "This action answers")) </pre>

The other option there is to use things like the on-login slot of
the login widget, and other similar slots on other widgets. That
is, for slots that take a function and that pass the widget to the
function, well, there's your widget. The fact that the login widget
has an easy way to call answer should hardly be a surprise. :-)


do-widget and friends (pretty much everything else like it,
including with-yield, is just a do-widget wrapper) are not
persistent. That is, the system doesn't keep track of the fact that
you replaced the widget in any magical way that stops future
renderings of the widget or future runs of the same do-widget call.
This means that you really don't want to put do-widget inside
render-body and things like that that can, and will, be rendered
multiple times. Each time such a render-body is entered, the
do-widget will be run again, even if it had already been resolved
with answer, which is unlikely to be the behaviour you want.

On top of that, if you use with-flow inside of render-body, you'll
be surprised when after all the yielding is done, the last thing
in the yield isn't what you see, because the rendering simply
contiues on after the with-yield; it's all a big mess.

You really want to put do-widget and friends inside actions. A
weblocks action is anything that eventually calls make-action;
render-link in particular is the most common way to get at them.

What About with-flow and yield?

For the most part, with-flow/yield/answer is just like
do-widget/answer and, in fact, the former is short-hand for the
latter. The case where you want to use with-flow is when you're
going to be replacing the same widget more than once; each yield
call will replace in the same place, saving you some do-widget

Wrapping Things In Login Widgets The Bad Way

NB: I wrote this before I knew that do-widget and friends should
only be used inside of actions. See the resulting
list thread
for details. In particular, the redirect bug I mention
in that thread was a side effect of that same issue, and doesn't
actually exist. That bug being that I had to put a redirect in the
code below to simulate manually hitting refresh or reload, otherwise
things didn't actually display properly.

I wrote a macro to be used when you want to protect content from
access by people who aren't logged in. This turns out to be a
little trickier than it would otherwise be because of the redirect
issue mentioned above, but also because of some persistence issues I
will explain.

<pre> (defmacro needs-login (url widget) (with-gensyms (wrapper-widget login-widget) `(make-instance 'composite :widgets (list (let ,wrapper-widget (make-instance 'composite) (setf (composite-widgets ,wrapper-widget) (list (lambda () (with-flow ,wrapper-widget (cond not (authenticatedp (yield (let ,login-widget (make-instance 'login) (setf (widget-prefix-fn ,login-widget) (lambda (widg &rest args) (cond ((authenticatedp) (answer ,login-widget) (redirect ,url))))) ,login-widget))) (t (yield ,widget)))) (redirect ,url)))) ,wrapper-widget))))) </pre>

OK, let's break it down. url is something like "/foo"; it only
exists because of the redirect bug. widget is the widget we won't
let the user get at if they haven't logged in.

gensym is a macro straight out of
Practical Common Lisp.

So it makes a composite widget. Always a good starting point. In
this case, it's so we have an argument for with-flow, and that's
it, so it can pretty much be ignored. The core of the whole thing
is the with-flow itself. The first argument to with-flow is the
widget to replace; this is, in fact, the composite widget, which is
what's returned by this whole mess, so we create a widget and then
immediately replace it. How's that for efficiency?

Then we check if we've been authenticated. If not, we yield to a
login widget. If we have, we yield to the widget we were passed.

In either case (yes, control flow does continue out of the
yield, despite what you might expect) we redirect back to ourselves
because of the redirect bug.

THe login widget itself is a bit odd, because of the
widget-prefix-fn. The reason there is that if you wrap a bunch of
widgets with this macro, and the user goes to more than one of them
before they log in, the yields will have already been done on
the others, so they'll have to login at every widget the had already
caused to be yielded to a login widget. Ick. So, before displaying
the login widget, we check that it's still needed and, if not, we

Wrapping Things In Login Widgets A Better Way

The nice thing about widgets is you don't actually need
do-widget or whatever for the most part; you can just use normal
conditionals. Here's a login wrapper widget, originally by Stephen
Compall, that does the right thing for me. Note that this is
let-anybody-in login checking; actual credentials checking is left
somewhat as an exercise for the reader, although if you mail me I
can show you my code for that.

<pre> (defwidget login-maybe (login) ((child-widget :accessor login-maybe-child-widget :initarg :child-widget :documentation "The widget to render if we are already logged in. Must be wrapped in (lambda () ...) so that the bits inside can use auth information. The lambda will be run exactly once.") (real-child-widget :documentation "Where the result of the child-widget lambda gets put.")) (:documentation "Render login form only if not logged in.")) (defmethod initialize-instance ((self login-maybe) &key &allow-other-keys) (call-next-method) (setf (widget-continuation self) (lambda (&optional auth) (declare (ignore auth)) ;unless you care... (mark-dirty self)))) (defmethod render-widget-body ((self login-maybe) &key &allow-other-keys) (cond ((authenticatedp) (render-widget (slot-value self 'real-child-widget) :inlinep t)) (t (call-next-method)))) (defun check-login (login-widget credentials-obj) "Check the user's login credentials" (declare (ignore login-widget)) (cond ; For now, we accept anything (t (when (login-maybe-child-widget login-widget) (setf (slot-value login-widget 'real-child-widget) (funcall (login-maybe-child-widget login-widget))) (setf (login-maybe-child-widget login-widget) nil)) t))) </pre>

Here's some usage:

<pre> (make-navigation 'main-menu 'home (make-main-page) 'self (make-instance 'login-maybe :on-login #'check-login :child-widget (make-self-page)) </pre>

A Trick To Check For Re-Creation

One of the weirdest, hardest-to-debug (until I got used to it)
things I encountered in weblocks was widgets getting recreated on
every user action or render (see the cautionary note on lambdas
elsewhere in this document). It looks like your widget is failing
to act on its persistent data, and when you explore more carefully,
it looks like your widget is failing to save the data properly, when
what's actually happening is the widget keeps getting recreated.

An easy way to test for this is to add:

<pre> (rand :initform (random 10000)) </pre>

to the list of widget slots. Then just call (describe self) at the
top of render-widget-body. If you're getting a new widget every
time, it'll be pretty obvious because the rand number will keep

About Stores

Backend stores in Weblocks are kind of magic. For example, I
discovered that if you comment out the sandbox stuff in the main
demo, you get data that persists across invocations using the
prevalence engine... Which is only mentioned once in the entire
application, when it's created.


I'm used to have to code at least some interaction with the
database, so I went exploring a bit to figure out how this worked.
After a short while, I stopped, because if I wanted to understand
how everything worked, I wouldn't be using Weblocks; I want the
magic to stay magical, thanks.

I do want to be able to use the magic, though, and how to do
that wasn't at all obvious, so here's some tutorial-like bits and
some notes.

In terms of setting up the store, I'm just using conf/stores.lisp
that comes with the basic webapp, so it's a simple prevalence store.

Single Object Manipulation

When dealing with a single object, you'll probably want to use
dataform, and you need to tell the widget which object it's dealing
with directly. Here's a very simple version of such a setup:

<pre> (make-instance 'dataform :data (find-persistent-object-by-id *prevalence-store* 'users 1)) </pre>

This'll get saved back, so that if you completely shut down and
restart your changes will be preserved. I assume it uses the id
field or something to figure out where to save changes to.

Multiple Object Manipulation

If you just want to edit everything in a given class, that's easy:

<pre> (make-instance 'gridedit :data-class 'users) </pre>

Whether you can look at anything less than everything in a given
class depends on the store type, but regardless uses the on-query
slot of the widegt.

The on-query slot can contain a list of keywords to be passed to the
data sore. Prevalence doesn't have any querying mechanism of this
type that I can see. CLSQL has fairly standard WHERE clauses, it
seems; haven't tried it yet.

The other option is for on-query to be a function; see the dataseq
docs for that. FIXME: I haven't actually used it yet, but when I do
I'll try to say something useful about it.

Bootstrapping (Making The Initial Data Set)

Again, this depends on the backing store, but with prevalence it's
easiest to just start off with:

<pre> (make-instance 'dataform :data (make-instance 'users)) </pre>

You can save the resulting data file for future restoration, and
just replace that make-instance above with a find-persistent-object
or just use a grid-edit widget or whatever.

The other option is to use something like

<pre> (persist-object *prevalence-store* (make-instance 'users :name ...)) </pre>

to manually enter data in the store.

Manual Store Interaction

You can interact with the store directly using its underlying
mechanisms, but you can also use Weblocks functions to do so.
Unfortunately, as of this writing (11 Oct 2008), these functions
aren't present in the Tinaa documentation, even though they're
fairly well documented, so you're going to have to look in src/store
yourself, I'm afraid.

cl-who Issues


cl-who doesn't do some intelligent quoting stuff that I think it should; (:tag :onclick "alert('foo')") gets rendered as <tag inhibited_click='alert('foo')'></tag>. Note the '. Uncool. Adding the following bits to your code should make it render as <tag inhibited_click='alert(&#039;foo&#039;)'></tag>.

(defun my-escape-string (maybe-string)
  ;(format t "my-escape-string: ~s~%" (describe maybe-string))
    ((stringp maybe-string)
     (cl-who:escape-string-minimal-plus-quotes maybe-string))
    (t maybe-string)))

(defmethod convert-tag-to-string-list (tag (attr-list list) body body-fn)
  ;(format *standard-output* "non-cl-who tag: ~s, attr-list ~s.~%" tag attr-list)
    (loop for inner-attr-list in attr-list
            (car inner-attr-list)
            (cons 'my-escape-string (list (cdr inner-attr-list)))))

Variable Usage In cl-who

This one cost me a fair bit of an afternoon, I'm ashamed to say. The issue was, why the hell doesn't this work:

* (let ((data "bar")) (with-html-output (*standard-output*) (:p data)))

The answer is that cl-who really does need you to tell it you're using a variable, even in the simplest case, so you want:

* (let ((data "bar")) (with-html-output (*standard-output*) (:p (str data))))

For reasons I'm not clear on and haven't bothered to investigate (see
"understading above), (esc...) doesn't seem to work in Weblocks' with-html;
(str...) seems to do the trick, though.

Making A Hiding Widget

Weblocks detects when you update a widget, and automatically redraws it, which
is hella cool. I asked how to make a button that could hide or show a bit of
text, and was told to make use of that functionality. What follows is a
morons-eye-view of the process of me making a widget for this purpose, on the
off chance it might be helpful to myself or someone else in the future.

The initial setup is a page (AKA function, because that's how Weblocks works)
that consists loosely of:

    'composite :widgets
	(lambda () (with-html ...))
	(lambda () (with-html ...))))

OK, first crack at a new widget; no functionality really, just seeing if I can
make one work:

(defwidget toggle-widget (widget)
 ((data :accessor toggle-widget-data
   :initform nil
   :initarg :data
   (showp :accessor toggle-widget-showp
    :initform t
    :initarg :showp))))

(defmethod render-widget-body ((widget toggle-widget) &rest args)
 (let ((data (toggle-widget-data widget)))
  (format t "t-w-d: ~A~%" data)
  (with-html (:div (:p (str data))))))

Like I said, it's just there to see if I can get the widget running. So I put it in the main code:

 'composite :widgets
  (lambda () (with-html ...))
  (lambda ()
    :showp t
    :data "Test data."))
  (lambda () (with-html ...))))

That seemed to work; great. OK, let's add some code to toggle the shew flag:

 'composite :widgets
  (lambda () (with-html ...))

  (lambda ()
    :showp t
    :data "Test data.")
    (lambda (&rest x) (describe x))))

  (lambda () (with-html ...))))

Again, at this point I'm just testing that I can get the button to show up,
because I've never used render-form-and-button before. Button shows up; yay.

Text of toggle widget: not so much. That's odd.

Oh. I'm not actually *returning* the toggle-widget I'm making out
of that lambda, so the composite widget never sees it. Whoops.

 'composite :widgets
  (lambda () (with-html ...))

   :showp t
   :data "Test data.")

  (lambda ()
    (lambda (&rest x) (describe x))))
  (lambda () (with-html ...))))

OK, button shows up, text shows up. Yay. Now to make the button do
something... OK, the button will need a reference to the toggle.
Can't return multiple values in that place. So:

 'composite :widgets
     :showp t
     :data "Test data.")))

   (lambda () (with-html ...))


   (lambda ()
     (lambda (&rest x)
       ((toggle-widget-showp toggle-bit)
	(setf (toggle-widget-showp toggle-bit) nil))
       ((not (toggle-widget-showp toggle-bit))
	(setf (toggle-widget-showp toggle-bit) t))))))

   (lambda () (with-html ...)))))

Hey, that seems to work! It's Miller Time! (note that I don't
actually drink alcohol, and I can't even be around beer, but I
really like Ghostbusters.)

Kind of a pain in the ass, though, yeah? I bet that could be turned
into its own seperate widget. Oh, and the button looks like crap,
but that's really a CSS issue. Should probably deal with it

(defmethod render-widget-body ((widget toggle-widget) &rest args &key)
  (let ((data (toggle-widget-data widget))
    (when (toggle-widget-showp widget)
      (with-html (:p (str data))))
      (lambda (&rest x)
        ;(describe x)
          ((toggle-widget-showp widget)
           (setf (toggle-widget-showp widget) nil))
          ((not (toggle-widget-showp widget))
           (setf (toggle-widget-showp widget) t)))))))

Much better; all nice and self contained. Hmm. Button says "Show" in both
states; that's silly. Oh, and traditionally such a button is above the thing
it toggles.

Since I'm pretty much done with this one, here's the whole thing:

(defwidget toggle-widget (widget)
           ((data :accessor toggle-widget-data
                  :initform nil
                  :initarg :data
                  :documentation "FIXME: isn't any")
            (showp :accessor toggle-widget-showp
                   :initform t
                   :initarg :showp
                   :documentation "FIXME: isn't any"))
           (:documentation "FIXME: isn't any"))

(defmethod render-widget-body ((widget toggle-widget) &rest args)
  (declare (ignore args))
  (let ((data (toggle-widget-data widget)))
      ((toggle-widget-showp widget)
         "- Hide"
         (lambda (&rest x)
           (declare (ignore x))
           (setf (toggle-widget-showp widget) nil))
         :form-class "toggle-button"))
          "+ Show"
          (lambda (&rest x)
            (declare (ignore x))
            (setf (toggle-widget-showp widget) t))
          :form-class "toggle-button")))
    (when (toggle-widget-showp widget)
      (with-html (:p (str data))))))

There's still some refinements available: making seperate classes for the two
cases, letting the user pass their own classes, letting the user pass their
own show and hide strings, probably others. But that's the meat of
it. I actually ended up using render-link instead of
render-form-and-button, fwiw.

One wrinkle worth mentioning is moving the with-html out of the
widget, where you end up with something like this:

(defmethod render-widget-body ((widget toggle-widget) &rest args)
    (when (toggle-widget-showp widget)
          (render-widget data)))


  :showp t
  :data (lambda () (with-html (:p "Test data."))))

A Simplified Flow-Like Widget

I'm probably going to not end up using this myself, because I'm
going to see about making a more flexible version, but it seems like
it might be useful to others, if nothing else than as an
illustration of how to use regular lisp conditionals to get
something like with-flow out of a widget without actually (directly)
using contiunations, but still with all the control in one place.
It's pretty sweet that such a thing is even possible.

The use case was that I had a few cases where I wanted to present a
link, do some stuff when the user clicked the link, present another
link, do some more stuff when that was clicked, and then return to
presenting the original link. In the process of trying to
generalize that, I turned it into a general presenter for a series
of links and surrounding text.

I like to think the internal documentation is sufficient for
user-level docs, but feel free to
e-mail me if you disgree.

<pre> (defwidget simple-flow (widget) ((steps :accessor simple-flow-steps :initarg :-Steps :documentation "Steps takes a list of alists, one for each step in the flow. The alists can include the following elements: 'preamble What to say before the link; should be a plain string. 'postamble What to say after the link; should be a plain string. 'link-text REQUIRED. The text to have in the link to the next step. 'link-id HTML id to use for the link. 'func Function of 2 args that gets run when the link is clicked. Should return t to continue to the next step, nil to fail. 'backout-text The text for a link, if any, to backout of the process, i.e. to use the failure slot (or return to the first step) immediately. 'backout-id HTML id to use for the backout link. 'backout-func Function of 2 args that gets run when the backout link is clicked. The return value is ignored. " ) (current-step :initform 0 :documentation "Keeps track of which step we're on. No user-servicable parts inside.") (success :accessor simple-flow-success :initarg :-Success :initform nil :documentation "A widget to display when the last function returns t. If none, success returns to the initial state (i.e. step 1).") (failure :accessor simple-flow-failure :initarg :failure :initform nil :documentation "A widget to display when any function returns nil, or the backout link is used. If none, success returns to the initial state (i.e. step 1).") ) (:documentation "A widget that presents a uni-directional flow; at each step, a function can be run. If the function turns t, the next step is shown. If it returns nil, the failure slot is used. If the last step returns t, the success slot is used.")) ; A utility function that returns the cdr of the results of assoc, ; or nil if assoc returned nil. This means that you can't really ; use it on alists that might legitimately have nil as a ; non-degenerate value in the cdr. (defun my-assoc (key alist) (let val (assoc key alist) (cond ((null val) nil) (t (cdr val))))) (defmethod render-widget-body ((self simple-flow) &rest args) ; Check for, and deal with, abnormal states. (cond ; We're in the failure state ((eq (slot-value self 'current-step) 'failure) (cond ; We have a failure widget; show it ((simple-flow-failure self) (render-widget (simple-flow-failure self)) (mark-dirty self)) ; We don't have a failure widget; go back to the start (t (setf (slot-value self 'current-step) 0) (mark-dirty self)))) ; We're in the success state ((eq (slot-value self 'current-step) 'success) (cond ; We have a success widget; show it ((simple-flow-success self) (format t "rendering success.~%") (render-widget (simple-flow-success self)) (mark-dirty self)) ; We don't have a success widget; go back to the start (t (format t "not rendering success.~%") (setf (slot-value self 'current-step) 0) (mark-dirty self))))) ; If we're in a normal stat, deal with it. (when (and (integerp (slot-value self 'current-step)) (nth (slot-value self 'current-step) (simple-flow-steps self))) (let* current (nth (slot-value self 'current-step) (simple-flow-steps self) (preamble (my-assoc 'preamble current)) (postamble (my-assoc 'postamble current)) (link-text (my-assoc 'link-text current)) (link-id (my-assoc 'link-id current)) (backout-text (my-assoc 'backout-text current)) (backout-id (my-assoc 'backout-id current)) (func (my-assoc 'func current)) (backout-func (my-assoc 'backout-func current)) ) ; Present the preamble (with-html (str preamble)) ; Present the main link (render-link (lambda (&rest args) (cond ; If the function returns t, continue on ((apply func args) (setf (slot-value self 'current-step) (+ 1 (slot-value self 'current-step))) ; See if we succeeded (when (null (nth (slot-value self 'current-step) (simple-flow-steps self))) (setf (slot-value self 'current-step) 'success)) (mark-dirty self)) ; Else failure (t (setf (slot-value self 'current-step) 'failure)))) link-text :id link-id) ; Present the backout link, if any (when (not (null backout-text)) (render-link ; Run the backout-func (if any) and fail (lambda (&rest args) (when backout-func (apply backout-func args)) (setf (slot-value self 'current-step) 'failure) (mark-dirty self)) backout-text :id backout-id)) ; Present the postamble (with-html (str postamble))))) </pre>

And here's a (contrived) usage example:

<pre> (make-instance 'simple-flow :-Success (make-instance 'composite :widgets (list "Success.")) :failure (make-instance 'composite :widgets (list "Failure.")) :-Steps (list (list (cons 'preamble "preamble1") (cons 'postamble '(:h1 "postamble1")) (cons 'link-text "link-text1") (cons 'link-id "link-id1") (cons 'backout-text "backout-text1") (cons 'backout-id "link-id1") (cons 'func (lambda (&rest args) (format t "function1 ~A ~%" args) t))) (list (cons 'preamble "preamble2") (cons 'postamble '(:h1 "postamble2")) (cons 'link-text "link-text2") (cons 'backout-text "backout-text2") (cons 'func (lambda (&rest args) (format t "function2 ~A ~%" args) t))))) </pre>

Working With Flow Without with-flow

I put a lot of work into the documentation for this one, so I'm
going to largely let them speak for themselves. Start with the
main widget docs, or the slot docs won't make much sense.

The basic point here is that you give it a list of widgets (actually
lambdas around widgets) and tell it how to move from one widget to
another based on user input, and it handles everything else for you.

<pre> ;***************************** ; Mult-Flow Widget ; ; An alternative way of handling flow issues; sort of a flow ; multiplexer/dispatcher sort of thing. ;***************************** (defwidget multi-flow (widget) ( ; Uncomment and add a (describe self) at the top of ; render-widget-body if you need to make sure that the ; widget isn't being repeatedly recreated. ; ; (rand :initform (random 10000)) (state :initform 1 :documentation "Holds the current state of the widget; that is, the current place in the list of items to preset.") (current :initform nil :documentation "Holds the widget currently being presented; that is, the appropriate function in the items slot is called with the available arguments, if any, and the result is stored here for presentation.") (items :accessor multi-flow-items :initarg :items :documentation "Holds a list of items to present for the user, not unlike the widgets list in a composite widget. The difference here is that the items should be functions, and only one is presented at a time. The first argument to the function will be a continuation used to move away from the current item, i.e. the first argument to answer. The remaining arguments, if any, will be the values passed by the call to answer that led to the current item, if any. The lambda is guaranteed to be called exactly once each time another part of the multi-flow leads to that item, and at no other times.")) (:documentation "The multi-flow widget is designed to handle the same sorts of things as with-flow and do-widget, but without the requirement of being called inside an action to function properly, and is also (I hope) easier to use. The basic idea is that you give multi-flow a list of widgets, each of which knows which other widget in the list to pass control to when the user performs an action with it. multi-flow starts by presenting the first widget, and from there where to go within the multi-flow list is under the control of the widgets themselves. Except you don't actually give it a list of widgets, you give it a list of functions. See the documentation for the items slot for the format of those functions. To move on to another widget in the multi-flow, have the user run an action that calls answer. The first argument to answer must be the first argument passed to the function you gave to the multi-flow list. The second argument must be the number (counting from 1) in the list of items to pass control to next. If you want to also want to pass data onto the next widget, make the second argument be a list, where the first element of the list is the number of the next widget. The next widget will be called with the continuation and any arguments that were passed to answer; if the second argument to answer is a list, everything but the first list element is passed as additional arguments. For a usage example and other notes, see http://teddyb.org/rlp/tiki-index.php?page=Learning+About+ Weblocks#Working_With_Flow_Without_with_flow ")) (defmethod render-widget-body ((self multi-flow) &rest args) ; If we have not processed the current lambda already, do so. ; This only happens when this widget is first rendered. (when (not (slot-value self 'current)) ; Set up the current widget, and give it us for continuation. (setf (slot-value self 'current) (funcall (nth (- (slot-value self 'state) 1) (multi-flow-items self)) self)) ; Set up a continuation, for when people call answer against us (setf (widget-continuation self) (lambda/cc ; answer passes the second argument directly, which means ; it'll either be a single number (the next widget to load) ; or a list, the first element of which is the next widget ; to load. (args) ; Break up the argument list as described above. (let ((next (cond ((listp args) (first args)) (t args))) (passon (cond ((listp args) (rest args)) (t nil)))) ; Set the state to the next widget (setf (slot-value self 'state) next) ; Run the next lambda and load it into current (setf (slot-value self 'current) (apply (nth (- (slot-value self 'state) 1) (multi-flow-items self)) ; The continuation self ; Any arguments we were passed passon))) ; Mark ourselves dirty for good measure. (mark-dirty self)))) ; Show the current widget (render-widget (slot-value self 'current))) ;***************************** ; END Mult-Flow Widget ;***************************** </pre>

A Usage Example

This example creates 3 widgets, with links to each other that do
nothing except call the next widget and pass some simple data
around. The first widget has a link to the second and a link to the
third. The second has two links to the third: one that passes data,
and one that doesn't. The third has a link to the first.

In all cases, any data passed will be displayed before the first

<pre> (make-instance 'multi-flow :items (list (lambda (continuation &rest outer-args) (make-instance 'composite :widgets (list "foo 1" (lambda (&rest args) (with-html (str outer-args))) (lambda (&rest args) (render-link (lambda (&rest args) (answer continuation '(2 stuff1))) "link to 2")) "bar 1" (lambda (&rest args) (render-link (lambda (&rest args) (answer continuation '(3 stuff2))) "link to 3")) "baz 1"))) (lambda (continuation &rest outer-args) (make-instance 'composite :widgets (list "foo 2" (lambda (&rest args) (with-html (str outer-args))) (lambda (&rest args) (render-link (lambda (&rest args) (answer continuation '(3 stuff3))) "link to 3")) (lambda (&rest args) (render-link (lambda (&rest args) (answer continuation 3)) "no-value link to 3")) "baz 2"))) (lambda (continuation &rest outer-args) (make-instance 'composite :widgets (list "foo 3" (lambda (&rest args) (with-html (str outer-args))) (lambda (&rest args) (render-link (lambda (&rest args) (answer continuation '(1 stuff4))) "link to 1")) "baz 3"))))) </pre>