Fixed the crashing bugs

It technically doesn't crash, but for some reason the GUI is frozen
immediately on startup and is completely unresponsive. It may have
something to do with calling some function in them multiple times over
and over again but I don't know. I added some debugging text with
comments next to them as "eat this note". Those lines can be removed
with no concequences.

.gitignore

@@ -9,3 +9,6 @@
 # ignore racket compile files
 *.dep
 *.zo
+
+#ignore backup files
+*.bak

Hermes/Hermes_Gui1.3.rkt

@@ -13,9 +13,10 @@
 
 (define (make-gui)
   (begin
+    (displayln "Makin...");;eat this note
     ;;Create the frame
     (define main-frame (new frame%
-                            [label "Example5"]
+                            [label "Hermes"]
                             [width 500]
                             [height 700]
                             ))
@@ -54,13 +55,18 @@
     ;;button stuff
     (define (button-do-stuff b e);b and e do nothing :/
       (begin
-        (if (color-change-request? (send input get-value))
+        (define given-input (send input get-value))
-            (set! my-color (get-color-from-input (send input get-value)))
+        (if (string? given-input)
-            (if (< 0 (string-length (send input get-value)))
+            (if (color-change-request? given-input)
+                (set! my-color (get-color-from-input given-input))
+                (if (quit-request? given-input)
+                    (write "quit" the-output-port)
+                    (if (< 0 (string-length-safe given-input))
                         (send-message (send input get-value) my-color);;
-                '()))
+                        '())))
-        (send input set-value "")
+        '())
-        ))
+        (send input set-value "")))
+    
     (define send-button (new button%
                              [parent main-frame]
                              [label "Send"]
@@ -72,37 +78,46 @@
     ;;messaging stuff
 
     (define (user-message-parse string start)
-      (begin
       (define (helper str index)
+        (if (string? string)
+            (if (>= (+ start index) (string-length-safe string))
+                (display string);;Something went wrong
                 (if (eq? (string-ref str (+ start index)) #\~)
-              (substring str start (+ start index))
+                    (substring-s str start (+ start index))
                     (helper str (+ index 1))))
-        (helper string 0)))
+            '()))
+      (helper string start))
       
     (define (user-message onetrueinput)
-      (begin
+      (display "Godit!");;eat this note
+      (displayln onetrueinput);;eat this note
+      (if (not (string=? onetrueinput ""))
+          (let();;This is kind of stupid but whatever it works.
             (define username (user-message-parse onetrueinput 0))
-        (define input (user-message-parse onetrueinput  (+ 1(string-length username))))
+            (define user-input (user-message-parse onetrueinput  (+ 1(string-length-safe username))))
-        (define color (substring onetrueinput (+ 2 (string-length username) (string-length input))))
+            (define color (substring-s onetrueinput (+ 2 (string-length-safe username) (string-length-safe user-input)) (string-length-safe onetrueinput)))
             (send dc set-text-foreground color)
-        (send dc draw-text (string-append username ":" input) 0 height)
+            (send dc draw-text (string-append username ":" user-input) 0 height)
-        (set! listy (appendlist listy (list username input color height)))
+            (set! listy (appendlist listy (list username user-input color height)))
             (set! height (+ height 15))
             (set! min-v-size (+ min-v-size 15))
-        (if (> (* 20 (string-length input)) min-h-size)
+            (if (> (* 20 (string-length-safe user-input)) min-h-size)
-            (set! min-h-size (* 20 (string-length input)))
+                (set! min-h-size (* 20 (string-length-safe user-input)))
                 '())
-        (send read-canvas init-auto-scrollbars min-h-size min-v-size 0 1)
+            (send read-canvas init-auto-scrollbars min-h-size min-v-size 0 1))
-        ))
+          '()))
     ;;Add a function that parces input from a string and extracts elements
 
+    (define the-output-port (open-output-string))
+    
     ;;This probably won't change...
     (define (send-message input color)
-      (user-message (string-append name "~" input "~" color)))
+      (write (string-append name "~" input "~" color) the-output-port))
     ;;Although re-draw is kind of misleading, it is just print the whole
     ;;list of strings to the screen
     (define (re-draw-message username input color in-height)
       (begin
+        (displayln "Fixy!");eat this note
         (send dc set-text-foreground color)
         (send dc draw-text (string-append username ":" input) 0 in-height)
         ))
@@ -133,13 +148,15 @@
     ;;dispatch goes below that
     (define (dispatch command)
       (cond ((eq? command 'show) (send main-frame show #t))
+            ((eq? command 'close)(send main-frame show #f))
             ((eq? command 'send) send-message)
             ((eq? command 'set-name) (lambda (newname) (if (string? newname)
                                                   (set! name newname)
                                                   (print "Thats not good"))))
             ((eq? command 'recieve-message) user-message)
-            ((eq? command 'get-list) listy)
+            ;((eq? command 'get-list) listy)
-            ((eq? command 'set-list) update)
+            ;((eq? command 'set-list) update)
+            ((eq? command 'get-output-port) the-output-port)
             ;;Something up with that
             (else (error "Invalid Request" command))
             ))
@@ -179,18 +196,38 @@
 (define (get-height-from-list in-list)
   (car (cdr (cdr (cdr in-list)))))
 
+(define (get-color-from-input input)
+  (substring-s input 6 (string-length-safe input)))
+
 
 
 ;this one is a crap version of justpressing the enter key
 (define (color-change-request? given-string)
-  (if (> (string-length given-string) 7)
+  (if (> (string-length-safe given-string) 7)
-      (if (equal? (substring given-string 0 6) "/color")
+      (if (equal? (substring-s given-string 0 6) "/color")
           #t
           #f)
       #f))
 
-(define (get-color-from-input given-string)
+
-  (substring given-string 7))
+(define (quit-request? given-string)
+  (if (>= (string-length-safe given-string) 5)
+      (if (equal? (substring-s given-string 0 5) "/quit")
+          #t
+          #f)
+      #f))
+
+(define (string-length-safe string)
+  (if (string? string)
+      (string-length string)
+      0))
+
+(define (substring-s string start end)
+  (if (<= start end)
+      (if (<= end (string-length-safe string))
+          (substring string start end)
+          "")
+      ""))
 ;(define thing1 (make-gui))
 ;(define thing2 (make-gui))
 

Hermes/client.rkt

@@ -25,6 +25,7 @@
 (define error-out (open-output-file "./error_client.out" #:exists 'append))
 (define error-out-s (make-semaphore 1))
 
+(define gui (make-gui))
 ; custodian for client connections
 (define main-client-cust (make-custodian))
 ; make connection to server
@@ -38,9 +39,10 @@
     ; info used for authentication with server
     (displayln "What's your name?")
     (define username (read-line))
-
+    ((gui 'set-name) username)
+    (gui 'show)
     ;send the username to the server (username in out)
-    (displayln username out)
+    ;(displayln username out)
     (flush-output out)
 
     (define a (thread
@@ -61,32 +63,40 @@
     (thread-wait t) ;; returns prompt back to drracket
     (displayln-safe "Closing client ports." error-out-s error-out)
     (close-input-port in)
-    (close-output-port out))
+    (close-output-port out)
+    (gui 'close))
     (custodian-shutdown-all main-client-cust))
 
-
 ;; sends a message to the server
 (define (send-messages username out)
   ; get current time
-  (define date-today (seconds->date (current-seconds) #t))
+  ;(define date-today (seconds->date (current-seconds) #t))
   ;TODO pad the second if its only 1 character
-  (define date-print (string-append (number->string (date-hour date-today))
+  ;(define date-print (string-append (number->string (date-hour date-today))
-                                    ":"
+   ;                                 ":"
-                                    (number->string (date-minute date-today))
+    ;                                (number->string (date-minute date-today))
-                                    ":"
+     ;                               ":"
-                                    (number->string (date-second date-today))
+      ;                              (number->string (date-second date-today))
-                                    " | "))
+       ;                             " | "))
   ;; read, quits when user types in "quit"
-  (define input (read-line))
+  ;(define input (read-line))
+  (define input (get-output-string (gui 'get-output-port)))
   ; TODO /quit instead of quit
   (cond ((string=? input "quit")
-             (displayln (string-append date-print username " signing out. See ya!") out)
+             ;(displayln (string-append date-print username " signing out. See ya!") out)
              (flush-output out)
              (close-output-port error-out)
              (close-output-port convs-out)
              (exit)))
   
-  (displayln (string-append date-print username ": " input) out)
+  ;(displayln (string-append date-print username ": " input) out)
+  (if (not (null? input))
+      (if (not (equal? input ""))
+      ((let()
+        (displayln input);;eat this note
+        (displayln input out)))
+      '())
+      '())
   (flush-output out))
 
 ; receives input from server and displays it to stdout
@@ -100,9 +110,14 @@
          ;(exit)
          ]
         [(string? evt)
-         (displayln-safe evt convs-out-s convs-out)] ; could time stamp here or to send message
+         ;(displayln-safe evt convs-out-s convs-out)] ; could time stamp here or to send message
+         (if (not (equal? evt ""))
+         ((gui 'recieve-message) evt)
+         '())]
         [else
-          (displayln-safe (string-append "Nothing received from server for 2 minutes.") convs-out-s convs-out)]))
+          (displayln-safe
+           (string-append "Nothing received from server for 2 minutes.")
+           convs-out-s convs-out)]))
 
 (displayln-safe "Starting client." error-out-s error-out)
 (define stop-client (client 4321))

Hermes/server.rkt

@@ -60,8 +60,10 @@
 ; Track received messages in a closure
 (define (make-messages messages)
   (define (add message)
-    (set! messages (append messages (list message)))
+    (if (string=? message "")
-    messages)
+        messages
+    ((set! messages (append messages (list message)))
+    messages)))
   (define (mes-list)
     messages)
   (define (remove-top)
@@ -126,10 +128,10 @@
     (semaphore-post c-count-s)
 
     (displayln-safe successful-connection-m)
-    (displayln welcome-message out)
+    ;(displayln welcome-message out)
     ;; print to server log and client
-    (define print-no-users (string-append "Number of users in chat: "
+    (define print-no-users (string-append "Server~Number of users in chat: "
-                                          (number->string ((c-count 'current-count)))))
+                                          (number->string ((c-count 'current-count))) "~Red"))
     (displayln print-no-users out)
     (displayln-safe print-no-users convs-out-s convs-out)
     (flush-output out)
@@ -195,7 +197,7 @@
                   ; try to send that user the whisper
                   (if (port-closed? (get-output-port that-user-ports))
                       (begin
-                        (displayln "User is unavailable" out)
+                        (displayln "Server~User is unavailable~red" out)
                         (flush-output out))
                       (begin
                         (displayln (string-append (whisper-info whisper) (whisper-message whisper))
@@ -206,8 +208,9 @@
                   ;;should put a semaphore on connections
                   (semaphore-wait c-count-s)
                   (semaphore-wait connections-s)
-                  (define no-of-users (string-append "Number of users in chat: "
+                  (define no-of-users (string-append "Server~Number of users in chat: "
-                                          (number->string ((c-count 'current-count)))))
+                                          (number->string ((c-count 'current-count)))
+                                          "~red"))
                   (displayln no-of-users out)
                   (flush-output out)
                   (semaphore-post connections-s)
@@ -216,10 +219,13 @@
                  [list-users
                   (semaphore-wait connections-s)
                   ; map over connections sending the username to the client
-                  (displayln "Here is a list of users in chat." out)
+                  (displayln "Server~Here is a list of users in chat.~red" out)
                   (map
                    (lambda (ports)
-                     (displayln (get-username ports) out))
+                     (displayln (string-append
+                                 "Server~"
+                                 (get-username ports)
+                                 "~red")out))
                    ((c-connections 'cons-list)))
                   (flush-output out)
                   (semaphore-post connections-s)]
@@ -262,12 +268,15 @@
                 (lambda (ports)
                   (if (not (port-closed? (get-output-port ports)))
                     (begin 
-                        (displayln (first ((c-messages 'mes-list))) (get-output-port ports))
+                        (displayln (first ((c-messages 'mes-list)))
+                                   (get-output-port ports))
                         (flush-output (get-output-port ports)))
                     (displayln-safe "Failed to broadcast. Port not open." error-out-s error-out)))
                 ((c-connections 'cons-list)))
                (displayln-safe (first ((c-messages 'mes-list))) convs-out-s convs-out)
                ;; remove top message
+               (displayln (null? ((c-messages 'mes-list))));;eat this note
+               (displayln ((c-messages 'mes-list)));;eat this note
                ((c-messages 'remove-top))
                (displayln "Message broadcasted"))])
     (semaphore-post messages-s)))