add-todo-item
+ swap "database-path" get swap ".todo" cat3 store-todo ;
+
+: get-login-information ( -- user password )
+ [
+ "Login"
+ [
+ [ "Please enter your username and password (" write
+ "Click to Register" [ register-new-user ] quot-href
+ "):" write
+ ]
+ [
+ "" write
+ [ [ "Username:" write ] [ "username" simple-input ] ] row
+ [ [ "Password:" write ] [ "password" simple-input ] ] row
+ "
" write
+ "Login" button
+ ] swap form
+ ] simple-todo-page
+ ] show alist>namespace [ "username" input-value "password" input-value ] bind ;
+
+: get-todo-list ( -- )
+ #! Prompts for a username or password until a valid combination
+ #! is entered then returns the list for that user.
+ get-login-information "database-path" get -rot user-exists? [ get-todo-list ] unless* ;
+
+: enter-new-todo-item ( -- )
+ #! Enter a new item to the current todo list.
+ [
+ "Enter New Todo Item"
+ [
+ [
+ "" write
+ [ [ "Priority:" write ] [ "priority" simple-input ] ] row
+ [ [ "Description:" write ] [ "description" simple-input ] ] row
+ "
" write
+ "Add" button
+ ] swap form
+ ] simple-todo-page
+ ] show alist>namespace [
+ "priority" get "description" get
+ ] bind ;
+
+: save-current-todo ( -- )
+ #! Save the current todo list
+ "todo" get dup "database-path" get swap [ "user" get ] bind ".todo" cat3 store-todo ;
+
+: todo-example ( path -- )
+ #! Startup the todo list example using the given path as the
+ #! directory holding the todo files.
+ "database-path" set
+ get-todo-list "todo" set
+ [
+ "todo" get [ "user" get ] bind "'s" "To Do list" cat3
+ [
+ drop
+ "todo" get [
+ "" write
+ [ [ "Priority" write ] [ "Complete?" write ] [ "Description" write ] ] row
+ [
+ [ [ "priority" get write ]
+ [ "complete?" get [ "Yes" ] [ "No" ] ifte write ]
+ [ "description" get write ] ] row
+ ] items-each-bind
+ "
" write
+ "Add Item" [
+ "todo" get enter-new-todo-item add-todo-item save-current-todo
+ ] quot-href
+ ] bind
+ ] simple-todo-page
+ ] show drop ;
+
+"todo" [ drop "todo/" todo-example ] install-cont-responder
\ No newline at end of file
diff --git a/contrib/cont-responder/todo.factor b/contrib/cont-responder/todo.factor
new file mode 100644
index 0000000000..c031329797
--- /dev/null
+++ b/contrib/cont-responder/todo.factor
@@ -0,0 +1,114 @@
+! Copyright (C) 2004 Chris Double.
+!
+! Redistribution and use in source and binary forms, with or without
+! modification, are permitted provided that the following conditions are met:
+!
+! 1. Redistributions of source code must retain the above copyright notice,
+! this list of conditions and the following disclaimer.
+!
+! 2. Redistributions in binary form must reproduce the above copyright notice,
+! this list of conditions and the following disclaimer in the documentation
+! and/or other materials provided with the distribution.
+!
+! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+!
+! Routines for managing a simple "To Do list". A todo list has a 'user', 'password'
+! and list of items. Each item has a priority, description, and indication if it is
+! complete.
+IN: todo
+USE: parser
+USE: stack
+USE: strings
+USE: streams
+USE: namespaces
+USE: lists
+USE: stdio
+USE: kernel
+
+: ( user password -- )
+ #! Create an empty todo list
+ [
+ "password" set
+ "user" set
+ f "items" set
+ ] extend ;
+
+: ( priority description -- )
+ #! Create a todo item
+ [
+ "description" set
+ "priority" set
+ f "complete?" set
+ ] extend ;
+
+: add-todo-item ( - -- )
+ #! Add the item to the todo list
+ swap [
+ "items" add@
+ ] bind ;
+
+: namespace>alist ( namespace -- alist )
+ #! Convert a namespace to an alist
+ [ vars-values ] bind ;
+
+: print-quoted ( str -- )
+ #! Print the string with quotes around it
+ "\"" write write "\"" print ;
+
+: write-todo ( -- )
+ #! Write the todo list to the current output stream
+ #! in a format that if loaded by the parser will result
+ #! in a again.
+ [
+ "USE: namespaces" print
+ "USE: lists" print
+ " [" print
+ "password" get print-quoted
+ "password" print-quoted "set" print
+ "user" get print-quoted
+ "user" print-quoted "set" print
+ "items" get [ namespace>alist ] map print
+ "[ alist>namespace ] map" print
+ "items" print-quoted "set" print
+ "] extend" print
+ ] bind ;
+
+: store-todo ( filename -- )
+ #! store the todo list in the given file.
+ [ write-todo ] with-stream ;
+
+: load-todo ( filename -- )
+ run-file ;
+
+: password-matches? ( password -- )
+ #! Returns the if the password matches otherwise
+ #! returns false.
+ dup -rot [ "password" get ] bind = [ ] [ drop f ] ifte ;
+
+: user-exists? ( db-path name password -- )
+ #! Returns a if a user with the given name exists
+ #! otherwise returns false.
+ -rot ".todo" cat3 dup exists? [
+ load-todo password-matches?
+ ] [
+ 2drop f
+ ] ifte ;
+
+: items-each-bind ( quot -- )
+ #! For each item in the currently bound todo list, call the quotation
+ #! with that item bound.
+ unit [ bind ] append "items" get swap each ;
+
+: test-todo
+ "user" "password"
+ dup "1" "item1" add-todo-item
+ dup "2" "item2" add-todo-item ;
\ No newline at end of file