[Groupscheme-devel] groupscheme/src/groupscheme/platform/GS GroupChat.scm,1.1,1.2 GroupTextAreaClient.scm,1.1,1.2

[Kenroy G. <kg...@us...>]

Update of /cvsroot/groupscheme/groupscheme/src/groupscheme/platform/GS
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv21021/src/groupscheme/platform/GS

Modified Files:
	GroupChat.scm GroupTextAreaClient.scm 
Log Message:
fixed other users output tab color bug, added directed chat messages, added automatic save request on compile, added chat saving, disabled Help menu tutorial, added default rendezvous server tab, added Beta Version numbers, added alert window for connecting to a group, worked on RendezvousServer, move stop to the other side of the textfield

Index: GroupChat.scm
===================================================================
RCS file: /cvsroot/groupscheme/groupscheme/src/groupscheme/platform/GS/GroupChat.scm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- GroupChat.scm	9 Sep 2004 06:10:55 -0000	1.1
+++ GroupChat.scm	1 Apr 2005 00:09:04 -0000	1.2
@@ -29,6 +29,7 @@
       ;; state variables for the chat panel
     (let (
       (Name "anonymous")
+      (chat-buf (java.lang.StringBuffer.))
       (Color (java.awt.Color. 255 0 0))
       (inchannel 'groupchatchannel)
       (rgbcolorlist (list 255 0 0))
@@ -53,17 +54,30 @@
           )
           (south
            (border 
-             (west (label ">>"))
+             (west (tt "uchoice" (apply choice 
+                     (cons "ALL" (GC 'get 'users-in-my-group)))));;(label ">>"))
              (center
               (tt "chatline" (textfield "" 1)))))))
 
 
       (define chat-action
-         (action (lambda(e)			       
-                (GC 'send inchannel Name (readstring (tt "chatline")) rgbcolorlist)
+         (action (lambda(e)
+                (GC 'send inchannel Name (readstring (tt "chatline"))
+		    rgbcolorlist (readstring (tt "uchoice")))
                 (writestring (tt "chatline") ""))))
 
 
+      (define (update-users)
+	(.removeAllItems (tt "uchoice"))
+	(map (lambda (x) (.addItem (tt "uchoice") x))
+	     (cons "ALL" (GC 'get 'users-in-my-group))))
+
+      (define groupserver-listeners
+	(lambda (cmd . R)
+	  (case (first R)
+	    ;;R= ('userleft threadcount username #peers-left-in-group)
+	    ((newuser userleft) (update-users)))))
+
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        ;; This listense to messages sent as follows:
        ;; (GC 'send inchannel Name (readstring (tt "chatline")) rgbcolorlist)               
@@ -75,14 +89,26 @@
         (lambda R   
           (define username (second R))
           (define raw-text (third R))
-          (define text (string-append username ":\t   " raw-text "    \n"))
+	  (define recipient (fifth R))
+          (define text (string-append username
+				      (if (equal? recipient "ALL")
+					  ""
+					  {->[recipient]})
+				      ":\t   " raw-text "    \n"))
           (define currentline (.getLineOfOffset ta (+ -1 (.getOffset endPos))))
-          (.append ta text) 
-          (.addHighlight highlighter 
-                   (.getLineStartOffset ta currentline) 
-                   (+ -2 (.getLineEndOffset ta currentline)) 
-                   (getHighlight (list-ref R 3)))
-          (.setCaretPosition ta (+ -1 (.getOffset endPos)))
+	  (if (and
+	       (not (equal? "" (.trim raw-text)))
+	       (or (equal? recipient Name) (equal? username Name)
+		   (equal? recipient "ALL")))
+	      (begin
+		(if (equal? recipient "ALL")
+		    (.append chat-buf text))
+		(.append ta text) 
+		(.addHighlight highlighter 
+			       (.getLineStartOffset ta currentline) 
+			       (+ -2 (.getLineEndOffset ta currentline)) 
+			       (getHighlight (list-ref R 3)))
+		(.setCaretPosition ta (+ -1 (.getOffset endPos)))))
      )))
 
       ;; this looks up a highlight painter for a color list '(R G B)
@@ -104,16 +130,21 @@
               (case (first args)
                  ((panel) the-panel)
                  ((chatarea) (tt "chatarea"))
+		 ((chat-text) (.toString chat-buf))
                  ((name) Name)
                  ((inchannel) inchannel)
                  ((group-client) GC)))
 
-                 ((setall)     ;; this allows multiple sets: (P 'setall 'name "Tim" 'color blue)
-                  (let loop ((L args)) 
-                    (if (null? L) #t
+	     ((append-chat) (.append chat-buf (first args)))
+	     ((set-chat) (.setLength chat-buf 0)
+	                 (.append chat-buf (first args)))
+
+	     ((setall)     ;; this allows multiple sets: (P 'setall 'name "Tim" 'color blue)
+	      (let loop ((L args)) 
+		(if (null? L) #t
                     (begin 
-                        (msghandler 'set (first L) (second L)) 
-                        (loop (rest (rest L)))))))
+		      (msghandler 'set (first L) (second L)) 
+		      (loop (rest (rest L)))))))
 
              ((setfont)
                   (.setFont (tt "chatarea") (first args))
@@ -134,8 +165,8 @@
                      (GC 'logout)
                	     (set! GC (second args))
                      (GC 'add-listener inchannel chat-listener)
-
-                     
+		     (GC 'add-listener 'GROUPSERVER groupserver-listeners)
+                     (update-users)
                  ))))
 
 
@@ -148,8 +179,7 @@
      (.setBackground (tt "chatarea") white)
      (.addActionListener (tt "chatline") chat-action)
 
-
-;      (GC 'add-listener 'GROUPSERVER (lambda (cmd . R)				     
+;      (GC 'add-listener 'GROUPSERVER (lambda (cmd . R)
 ;        (case (first R)
 ; 	 ((userleft) ;;R= ('userleft threadcount username #peers-left-in-group)
 ; 	  (GC 'send inchannel Name {Left Grewp ([(Date.)])} rgbcolorlist))

Index: GroupTextAreaClient.scm
===================================================================
RCS file: /cvsroot/groupscheme/groupscheme/src/groupscheme/platform/GS/GroupTextAreaClient.scm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- GroupTextAreaClient.scm	9 Sep 2004 06:10:55 -0000	1.1
+++ GroupTextAreaClient.scm	1 Apr 2005 00:09:05 -0000	1.2
@@ -251,7 +251,8 @@
                 (case (first args)
                   ((tracking) tracking)
                   ((groupclient) G)
-		  ((color) (apply color colorRGBlist))
+		  ((color) (apply Swing:color colorRGBlist))
+		  ((colorRGB) colorRGBlist)
                   (else (printdebug 'error (list "unknown command" cmd args)) #f)))
              ((setall)     ;; this allows multiple sets: (P 'setall 'tracking #t 'group-client G2)
                   (let loop ((L args))