Ur/Web: demo/chat.ur annotate

annotate demo/chat.ur @ 1909:659d1f4e95bf

make dist: Use fewer wildcards The remaining ones only work by accident: http://www.gnu.org/software/automake/manual/html_node/Wildcards.html and they have some practical problems too (we don?t really want to distribute include/urweb/config.h or src/config.sml), but this is enough for now to pass ?make distcheck? as long as we don?t run it from a separate build directory. Signed-off-by: Anders Kaseorg <andersk@mit.edu> --- Makefile.am | 6 +++--- src/c/Makefile.am | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-)

author	Anders Kaseorg <andersk@mit.edu>
date	Fri, 22 Nov 2013 09:36:14 -0500
parents	e6bc6bbd7a32
children

rev	line source
adamc@699	1 structure Room = Broadcast.Make(struct
adamc@699	2 type t = string
adamc@699	3 end)
adamc@699	4
adamc@699	5 sequence s
adamc@699	6 table t : { Id : int, Title : string, Room : Room.topic }
adamc@708	7 PRIMARY KEY Id
adamc@699	8
adamc@732	9 fun chat id () =
adamc@699	10 r <- oneRow (SELECT t.Title, t.Room FROM t WHERE t.Id = {[id]});
adamc@699	11 ch <- Room.subscribe r.T.Room;
adamc@699	12
adamc@699	13 newLine <- source "";
adamc@699	14 buf <- Buffer.create;
adamc@699	15
adamc@699	16 let
adamc@699	17 fun onload () =
adamc@699	18 let
adamc@699	19 fun listener () =
adamc@699	20 s <- recv ch;
adamc@699	21 Buffer.write buf s;
adamc@699	22 listener ()
adamc@699	23 in
adamc@699	24 listener ()
adamc@699	25 end
adamc@699	26
adamc@699	27 fun getRoom () =
adamc@699	28 r <- oneRow (SELECT t.Room FROM t WHERE t.Id = {[id]});
adamc@699	29 return r.T.Room
adamc@699	30
adamc@699	31 fun speak line =
adamc@699	32 room <- getRoom ();
adamc@699	33 Room.send room line
adamc@699	34
adamc@699	35 fun doSpeak () =
adamc@699	36 line <- get newLine;
adamc@699	37 set newLine "";
adamc@908	38 rpc (speak line)
adamc@699	39 in
adamc@699	40 return <xml><body onload={onload ()}>
adamc@699	41 <h1>{[r.T.Title]}</h1>
adamc@699	42
adam@1784	43 <button value="Send:" onclick={fn _ => doSpeak ()}/> <ctextbox source={newLine}/>
adamc@699	44
adamc@699	45 <h2>Messages</h2>
adamc@699	46
adamc@699	47 <dyn signal={Buffer.render buf}/>
adamc@699	48
adamc@699	49 </body></xml>
adamc@699	50 end
adamc@699	51
adamc@699	52 fun list () =
adamc@699	53 queryX' (SELECT * FROM t)
adamc@699	54 (fn r =>
adamc@699	55 count <- Room.subscribers r.T.Room;
adamc@699	56 return <xml><tr>
adamc@699	57 <td>{[r.T.Id]}</td>
adamc@732	58 <td>{[r.T.Title]}</td>
adamc@699	59 <td>{[count]}</td>
adamc@732	60 <td><form><submit action={chat r.T.Id} value="Enter"/></form></td>
adamc@732	61 <td><form><submit action={delete r.T.Id} value="Delete"/></form></td>
adamc@699	62 </tr></xml>)
adamc@699	63
adamc@732	64 and delete id () =
adamc@699	65 dml (DELETE FROM t WHERE Id = {[id]});
adamc@699	66 main ()
adamc@699	67
adamc@699	68 and main () =
adamc@699	69 let
adamc@699	70 fun create r =
adamc@699	71 id <- nextval s;
adamc@699	72 room <- Room.create;
adamc@699	73 dml (INSERT INTO t (Id, Title, Room) VALUES ({[id]}, {[r.Title]}, {[room]}));
adamc@699	74 main ()
adamc@699	75 in
adamc@699	76 ls <- list ();
adamc@699	77 return <xml><body>
adamc@699	78 <h1>Current Channels</h1>
adamc@699	79
adamc@699	80 <table>
adamc@699	81 <tr> <th>ID</th> <th>Title</th> <th>#Subscribers</th> </tr>
adamc@699	82 {ls}
adamc@699	83 </table>
adamc@699	84
adamc@699	85 <h1>New Channel</h1>
adamc@699	86
adamc@699	87 <form>
adamc@699	88 Title: <textbox{#Title}/><br/>
adamc@699	89 <submit action={create}/>
adamc@699	90 </form>
adamc@699	91 </body></xml>
adamc@699	92 end

Mercurial > urweb

annotate demo/chat.ur @ 1909:659d1f4e95bf