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 else.
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.
Table of contents
- The Various Weblocks Content Elements
- Taking Back The URL
- Page Titles
- A Caution About Composite Widgets
- Custom Widgets Are Your Friends!
- Using do-page, do-widget, and answer
- A Trick To Check For Re-Creation
- About Stores
- cl-who Issues
- Making A Hiding Widget
- A Simplified Flow-Like Widget
- Working With Flow Without with-flow
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 me.
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 stuff.
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.
Widgets
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:
(make-navigation
'main-menu
'users (make-users-page)
'clients (make-clients-page))
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. 
That's actually unfair; the selector widget is for when you want the behaviour of the navigation widget without the little menu.
(make-instance
'selector
:panes (list
(cons "users" (make-users-page))
(cons "clients" (make-clients-page))))
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.
(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)))))
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:
(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)))
That's if you want to modify just a single object; if you want to make your own modified class, do this instead:
(defmethod selector-on-dispatch ((self my-navigation-or-selector) tokens)
(describe (list obj tokens)) ;; YOUR CODE GOES HERE
(call-next-method))
(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 start-webapp.
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:
(declare (special *current-page-description*)) (setf *current-page-description* "Search For A User")
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
mailing
list thread with my whining.
do-page and answer
So from reading
Continuations-Based
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
at
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:
(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.")
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 Eslick:
(defmethod render-widget-body (widget &rest args)
(render-link (lambda (&rest args)
(answer widget))))
"This action answers"))
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.
Non-Persistence
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 book-keeping.
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
mailing
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.
(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)))))
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 bail.
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.
(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)))
Here's some usage:
(make-navigation
'main-menu
'home (make-main-page)
'self (make-instance
'login-maybe
:on-login #'check-login
:child-widget (make-self-page))
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:
(rand :initform (random 10000))
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 changing.
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.
O.o
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:
(make-instance 'dataform :data (find-persistent-object-by-id *prevalence-store* 'users 1))
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:
(make-instance 'gridedit :data-class 'users)
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:
(make-instance 'dataform :data (make-instance 'users))
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
(persist-object
*prevalence-store*
(make-instance 'users :name ...))
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
Quoting
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('foo')'></tag>.
(defun my-escape-string (maybe-string)
;(format t "my-escape-string: ~s~%" (describe maybe-string))
(cond
((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)
(call-next-method
tag
(loop for inner-attr-list in attr-list
collect
(cons
(car inner-attr-list)
(cons 'my-escape-string (list (cdr inner-attr-list)))))
body
body-fn))
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))) <p></p>
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)))) <p>bar</p>
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:
(make-instance
'composite :widgets
(list
(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:
(make-instance
'composite :widgets
(list
(lambda () (with-html ...))
(lambda ()
(make-instance
'toggle-widget
:showp t
:data "Test data."))
(lambda () (with-html ...))))
That seemed to work; great. OK, let's add some code to toggle the shew flag:
(make-instance
'composite :widgets
(list
(lambda () (with-html ...))
(lambda ()
(make-instance
'toggle-widget
:showp t
:data "Test data.")
(render-form-and-button
"Show"
(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.
(make-instance
'composite :widgets
(list
(lambda () (with-html ...))
(make-instance
'toggle-widget
:showp t
:data "Test data.")
(lambda ()
(render-form-and-button
"Show"
(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:
(make-instance
'composite :widgets
(let
((toggle-bit
(make-instance
'toggle-widget
:showp t
:data "Test data.")))
(list
(lambda () (with-html ...))
toggle-bit
(lambda ()
(render-form-and-button
"Show"
(lambda (&rest x)
(cond
((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 anyways.
(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))))
(render-form-and-button
"Show"
(lambda (&rest x)
;(describe x)
(cond
((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)))
(cond
((toggle-widget-showp widget)
(render-form-and-button
"- Hide"
(lambda (&rest x)
(declare (ignore x))
(setf (toggle-widget-showp widget) nil))
:form-class "toggle-button"))
(t
(render-form-and-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)))
...
(make-instance
'toggle-widget
: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.
(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)))))
And here's a (contrived) usage example:
(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)))))
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.
;*****************************
; 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
;*****************************
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 link.
(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")))))
Created by rlpowell. Last Modification: Wednesday 11 of March, 2009 01:47:00 PDT by rlpowell.
![[toggle]](javascript:icntoggle('mod-ApplicationMenul3','module.png'); "[toggle]"){kind=small}
Wiki
Powered by TikiWiki CMS/Groupware |
Theme: Feb12