no message

original commit: 3415dee4f14a0d2d91579d4960d551f9c0dbc63f

collects/tests/utils/gui.ss

@@ -2,8 +2,81 @@
   (require (lib "mred.ss" "mred")
            (lib "class.ss")
            (lib "etc.ss"))
-  (provide find-labelled-window)
+  (provide find-labelled-window whitespace-string=?)
   
+  ;; whitespace-string=? : string string -> boolean
+  ;; determines if two strings are equal, up to their whitespace.
+  ;; each string is required to have whitespace in the same place,
+  ;; but not necessarily the same kinds or amount.
+  (define (whitespace-string=? string1 string2)
+    (let loop ([i 0]
+               [j 0]
+               [in-whitespace? #t])
+      (cond
+        [(= i (string-length string1)) (only-whitespace? string2 j)]
+        [(= j (string-length string2)) (only-whitespace? string1 i)]
+        [else (let ([c1 (string-ref string1 i)]
+                    [c2 (string-ref string2 j)])
+                (cond
+                  [in-whitespace?
+                   (cond
+                     [(whitespace? c1)
+                      (loop (+ i 1)
+                            j
+                            #t)]
+                     [(whitespace? c2)
+                      (loop i
+                            (+ j 1)
+                            #t)]
+                     [else (loop i j #f)])]
+                  [(and (whitespace? c1)
+                        (whitespace? c2))
+                   (loop (+ i 1)
+                         (+ j 1)
+                         #t)]
+                  [(char=? c1 c2)
+                   (loop (+ i 1)
+                         (+ j 1)
+                         #f)]
+                  [else #f]))])))
+  
+  ;; whitespace? : char -> boolean
+  ;; deteremines if `c' is whitespace
+  (define (whitespace? c)
+    (or (char=? c #\newline)
+        (char=? c #\space)
+        (char=? c #\tab)
+        (char=? c #\return)))
+  
+  ;; only-whitespace? : string number -> boolean
+  ;; returns true if string only contains whitespace, from index `i' onwards
+  (define (only-whitespace? str i)
+    (let loop ([n i])
+      (cond
+        [(= n (string-length str))
+         #t]
+        [(whitespace? (string-ref str n))
+         (loop (+ n 1))]
+        [else #f])))
+  
+  ;; whitespace-string=? tests
+  '(map (lambda (x) (apply equal? x))
+        (list (list #t (whitespace-string=? "a" "a"))
+              (list #f (whitespace-string=? "a" "A"))
+              (list #f (whitespace-string=? "a" " "))
+              (list #f (whitespace-string=? " " "A"))
+              (list #t (whitespace-string=? " " " "))
+              (list #t (whitespace-string=? " " "  "))
+              (list #t (whitespace-string=? "  " "  "))
+              (list #t (whitespace-string=? "  " " "))
+              (list #t (whitespace-string=? "a a" "a a"))
+              (list #t (whitespace-string=? "a a" "a  a"))
+              (list #t (whitespace-string=? "a  a" "a a"))
+              (list #t (whitespace-string=? " a" "a"))
+              (list #t (whitespace-string=? "a" " a"))
+              (list #t (whitespace-string=? "a " "a"))
+              (list #t (whitespace-string=? "a" "a "))))
+
   ;;; find-labelled-window : (union ((union #f string) -> window<%>)
   ;;;                               ((union #f string) (union #f class) -> window<%>)
   ;;;                               ((union #f string) (union class #f) area-container<%> -> window<%>))