From 4b2dab10a0e11e46508151fb7f5e3e12e83d56f8 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 30 May 2009 16:50:38 -0400
Subject: [PATCH] refactor a bit of the chat server, add /nick

---
 extra/managed-server/chat/chat.factor | 38 ++++++++++++++++++++++++---
 1 file changed, 34 insertions(+), 4 deletions(-)

diff --git a/extra/managed-server/chat/chat.factor b/extra/managed-server/chat/chat.factor
index 723814bb13..e1331f360b 100644
--- a/extra/managed-server/chat/chat.factor
+++ b/extra/managed-server/chat/chat.factor
@@ -4,7 +4,8 @@ USING: accessors assocs combinators combinators.smart
 destructors fry io io.encodings.utf8 kernel managed-server
 namespaces parser sequences sorting splitting strings.parser
 unicode.case unicode.categories calendar calendar.format
-locals multiline ;
+locals multiline io.encodings.binary io.encodings.string
+prettyprint ;
 IN: managed-server.chat
 
 TUPLE: chat-server < managed-server ;
@@ -35,6 +36,31 @@ CONSTANT: line-beginning "-!- "
         [ "Unknown command: " prepend print flush ] if
     ] if-empty ;
 
+: usage ( string -- )
+    chat-docs get at print flush ;
+
+: username-taken-string ( username -- string )
+    "The username ``" "'' is already in use; try again." surround ;
+
+: warn-name-changed ( old new -- )
+    [
+        [ line-beginning "``" ] 2dip
+        [ "'' is now known as ``" ] dip "''"
+    ] "" append-outputs-as send-everyone ;
+
+: handle-nick ( string -- )
+    [
+        "nick" usage
+    ] [
+        dup clients key? [
+            username-taken-string print flush
+        ] [
+            [ username swap warn-name-changed ]
+            [ username clients rename-at ]
+            [ client (>>username) ] tri
+        ] if
+    ] if-empty ;
+
 :: add-command ( quot docs key -- )
     quot key commands get set-at
     docs key chat-docs get set-at ;
@@ -44,7 +70,7 @@ CONSTANT: line-beginning "-!- "
 Displays the documentation for a command.">
 "help" add-command
 
-[ drop clients keys ", " join print flush ]
+[ drop clients keys [ "``" "''" surround ] map ", " join print flush ]
 <" Syntax: /who
 Shows the list of connected users.">
 "who" add-command
@@ -53,6 +79,11 @@ Shows the list of connected users.">
 <" Syntax: /time
 Returns the current GMT time."> "time" add-command
 
+[ handle-nick ]
+<" Syntax: /nick nickname
+Changes your nickname.">
+"nick" add-command
+
 [ handle-me ]
 <" Syntax: /me action">
 "me" add-command
@@ -93,8 +124,7 @@ M: chat-server handle-client-disconnect
     ] "" append-outputs-as send-everyone ;
 
 M: chat-server handle-already-logged-in
-    "The username ``" username "'' is already in use; try again."
-    3append print flush ;
+    username username-taken-string print flush ;
 
 M: chat-server handle-managed-client*
     readln dup f = [ t client (>>quit?) ] when