2004-07-21 19:22:35 -04:00
|
|
|
! 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.
|
|
|
|
|
!
|
2005-04-04 18:31:31 -04:00
|
|
|
! 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.
|
2004-07-21 19:22:35 -04:00
|
|
|
IN: todo
|
|
|
|
|
USE: strings
|
2005-06-19 17:50:35 -04:00
|
|
|
USE: io
|
2004-07-21 19:22:35 -04:00
|
|
|
USE: namespaces
|
|
|
|
|
USE: lists
|
2004-08-26 22:34:09 -04:00
|
|
|
USE: math
|
2004-07-21 19:22:35 -04:00
|
|
|
USE: kernel
|
2004-08-23 16:21:49 -04:00
|
|
|
USE: prettyprint
|
2004-11-02 17:23:35 -05:00
|
|
|
USE: hashtables
|
2005-04-04 18:31:31 -04:00
|
|
|
USE: sequences
|
2005-05-02 00:18:34 -04:00
|
|
|
USE: http
|
2004-07-21 19:22:35 -04:00
|
|
|
|
|
|
|
|
: <todo> ( user password -- <todo> )
|
|
|
|
|
#! Create an empty todo list
|
2005-08-23 19:49:52 -04:00
|
|
|
[
|
2004-07-21 19:22:35 -04:00
|
|
|
"password" set
|
|
|
|
|
"user" set
|
|
|
|
|
f "items" set
|
2005-08-23 19:49:52 -04:00
|
|
|
] make-hash ;
|
2004-07-21 19:22:35 -04:00
|
|
|
|
|
|
|
|
: <todo-item> ( priority description -- )
|
|
|
|
|
#! Create a todo item
|
2005-08-23 19:49:52 -04:00
|
|
|
[
|
2004-07-21 19:22:35 -04:00
|
|
|
"description" set
|
|
|
|
|
"priority" set
|
|
|
|
|
f "complete?" set
|
2005-08-23 19:49:52 -04:00
|
|
|
] make-hash ;
|
2004-07-21 19:22:35 -04:00
|
|
|
|
|
|
|
|
: add-todo-item ( <todo> <item> -- )
|
|
|
|
|
#! Add the item to the todo list
|
|
|
|
|
swap [
|
2005-06-23 15:53:54 -04:00
|
|
|
"items" get swap add "items" set
|
2004-07-21 19:22:35 -04:00
|
|
|
] bind ;
|
|
|
|
|
|
2004-11-02 17:23:35 -05:00
|
|
|
: >yes/no ( bool -- str )
|
|
|
|
|
#! Return the string "yes" if the boolean is true, else
|
|
|
|
|
#! return "no".
|
|
|
|
|
"yes" "no" ? ;
|
2004-07-21 19:22:35 -04:00
|
|
|
|
2004-08-23 16:21:49 -04:00
|
|
|
: write-item ( <todo-item> -- )
|
|
|
|
|
#! write the item in a manner that can be later re-read
|
|
|
|
|
[
|
2004-11-02 17:23:35 -05:00
|
|
|
"complete?" get >yes/no url-encode print
|
2004-08-23 16:21:49 -04:00
|
|
|
"priority" get url-encode print
|
|
|
|
|
"description" get url-encode print
|
|
|
|
|
] bind ;
|
|
|
|
|
|
|
|
|
|
: write-items ( list -- )
|
|
|
|
|
#! write the todo list items
|
2004-11-02 17:23:35 -05:00
|
|
|
dup length .
|
2004-08-23 16:21:49 -04:00
|
|
|
[ write-item ] each ;
|
|
|
|
|
|
2004-07-21 19:22:35 -04:00
|
|
|
: write-todo ( <todo> -- )
|
|
|
|
|
#! Write the todo list to the current output stream
|
|
|
|
|
#! in a format that if loaded by the parser will result
|
|
|
|
|
#! in a <todo> again.
|
|
|
|
|
[
|
2004-08-23 16:21:49 -04:00
|
|
|
"user" get url-encode print
|
|
|
|
|
"password" get url-encode print
|
|
|
|
|
"items" get write-items
|
2004-07-21 19:22:35 -04:00
|
|
|
] bind ;
|
|
|
|
|
|
|
|
|
|
: store-todo ( <todo> filename -- )
|
|
|
|
|
#! store the todo list in the given file.
|
2005-02-06 19:08:14 -05:00
|
|
|
<file-writer> [ write-todo ] with-stream ;
|
2004-07-21 19:22:35 -04:00
|
|
|
|
2004-08-23 16:21:49 -04:00
|
|
|
: read-todo ( -- <todo> )
|
|
|
|
|
#! Read a todo list from the current input stream.
|
2005-07-25 18:34:59 -04:00
|
|
|
readln url-decode readln url-decode <todo>
|
2005-08-23 19:49:52 -04:00
|
|
|
readln string>number [
|
2004-08-23 16:21:49 -04:00
|
|
|
dup
|
2005-08-23 19:49:52 -04:00
|
|
|
[
|
2005-07-25 18:34:59 -04:00
|
|
|
readln url-decode "yes" = "complete?" set
|
|
|
|
|
readln url-decode "priority" set
|
|
|
|
|
readln url-decode "description" set
|
2005-08-23 19:49:52 -04:00
|
|
|
] make-hash add-todo-item
|
2004-08-23 16:21:49 -04:00
|
|
|
] times ;
|
|
|
|
|
|
2004-07-21 19:22:35 -04:00
|
|
|
: load-todo ( filename -- <todo> )
|
2005-02-06 19:08:14 -05:00
|
|
|
<file-reader> [ read-todo ] with-stream ;
|
2004-07-21 19:22:35 -04:00
|
|
|
|
|
|
|
|
: password-matches? ( password <todo> -- <todo> )
|
|
|
|
|
#! Returns the <todo> if the password matches otherwise
|
|
|
|
|
#! returns false.
|
2004-11-02 17:23:35 -05:00
|
|
|
tuck [ "password" get ] bind = [ drop f ] unless ;
|
2004-07-21 19:22:35 -04:00
|
|
|
|
|
|
|
|
: user-exists? ( db-path name password -- <todo> )
|
|
|
|
|
#! Returns a <todo> if a user with the given name exists
|
|
|
|
|
#! otherwise returns false.
|
2005-05-18 18:37:42 -04:00
|
|
|
-rot ".todo" append3 dup exists? [
|
2004-07-21 19:22:35 -04:00
|
|
|
load-todo password-matches?
|
|
|
|
|
] [
|
|
|
|
|
2drop f
|
2005-09-25 02:03:36 -04:00
|
|
|
] if ;
|
2004-07-21 19:22:35 -04:00
|
|
|
|
2004-11-02 17:23:35 -05:00
|
|
|
: each-bind ( quot list -- )
|
|
|
|
|
[ swap [ bind ] keep ] each drop ;
|
|
|
|
|
|
2004-07-21 19:22:35 -04:00
|
|
|
: items-each-bind ( quot -- )
|
|
|
|
|
#! For each item in the currently bound todo list, call the quotation
|
|
|
|
|
#! with that item bound.
|
2004-11-02 17:23:35 -05:00
|
|
|
"items" get each-bind ;
|
2004-07-21 19:22:35 -04:00
|
|
|
|
2004-07-22 18:04:53 -04:00
|
|
|
: todo-username ( <todo> -- username )
|
|
|
|
|
#! return the username for the todo list item.
|
2004-11-02 17:23:35 -05:00
|
|
|
"user" swap hash ;
|
2004-07-22 18:04:53 -04:00
|
|
|
|
|
|
|
|
: item-priority ( <todo-item> -- priority )
|
|
|
|
|
#! return the priority for the todo list item.
|
2004-11-02 17:23:35 -05:00
|
|
|
"priority" swap hash ;
|
2004-07-22 18:04:53 -04:00
|
|
|
|
|
|
|
|
: item-complete? ( <todo-item> -- boolean )
|
|
|
|
|
#! return true if the todo list item is completed.
|
2004-11-02 17:23:35 -05:00
|
|
|
"complete?" swap hash ;
|
2004-07-22 18:04:53 -04:00
|
|
|
|
|
|
|
|
: set-item-completed ( <todo-item> -- )
|
2004-11-02 17:23:35 -05:00
|
|
|
t "complete?" rot set-hash ;
|
2004-07-22 18:04:53 -04:00
|
|
|
|
|
|
|
|
: item-description ( <todo-item> -- description )
|
|
|
|
|
#! return the description for the todo list item.
|
2004-11-02 17:23:35 -05:00
|
|
|
"description" swap hash ;
|
2004-07-22 18:04:53 -04:00
|
|
|
|
2005-08-16 19:10:13 -04:00
|
|
|
: priority-comparator ( item1 item2 -- number )
|
|
|
|
|
#! Return 0 if item equals item2, -1 if item1 < item2 and
|
|
|
|
|
#! 1 if item1 > item2.
|
2006-01-09 01:34:23 -05:00
|
|
|
>r item-priority r> item-priority <=> ;
|
2004-07-22 18:04:53 -04:00
|
|
|
|
2004-08-23 16:21:49 -04:00
|
|
|
: todo-items ( <todo> -- alist )
|
2004-07-22 18:04:53 -04:00
|
|
|
#! Return a list of items for the given todo list.
|
2004-11-02 17:23:35 -05:00
|
|
|
"items" swap hash [ priority-comparator ] sort ;
|
2004-07-22 18:04:53 -04:00
|
|
|
|
|
|
|
|
: delete-item ( <todo> <todo-item> -- )
|
|
|
|
|
#! Delete the item from the todo list
|
|
|
|
|
swap dup >r todo-items remove r> [ "items" set ] bind ;
|
|
|
|
|
|
2004-07-21 19:22:35 -04:00
|
|
|
: test-todo
|
|
|
|
|
"user" "password" <todo>
|
|
|
|
|
dup "1" "item1" <todo-item> add-todo-item
|
2004-08-22 19:39:14 -04:00
|
|
|
dup "2" "item2" <todo-item> add-todo-item ;
|