Add logo to frames, move code around

Author: lehitoskin

base.rkt

@@ -107,6 +107,18 @@
       str
       (substring str 0 n)))
 
+; awww yeah... so oldskool...
+(define (remove-children parent kids)
+  (when (> (length kids) 0)
+    (send parent delete-child (car kids))
+    (remove-children parent (cdr kids))))
+
+; just check out those tail recursions...
+(define (add-children parent kids)
+  (when (> (length kids) 0)
+    (send parent add-child (car kids))
+    (add-children parent (cdr kids))))
+
 ; objects that will be used extensively in transparency-grid
 (define dgray-color (make-object color% 128 128 128))
 (define lgray-color (make-object color% 204 204 204))

db-statistics.rkt

@@ -4,23 +4,24 @@
          racket/format
          racket/gui/base
          racket/list
-         "db.rkt")
+         "base.rkt"
+         "db.rkt"
+         "files.rkt")
 (provide stats-frame update-stats)
 
 (define stats-frame (new frame%
                          [label "Ivy Statistics"]
                          [width 800]
                          [height 100]))
 
+(unless (macosx?)
+  (send stats-frame set-icon (read-bitmap logo)))
+
 (define stats-vpanel
   (new vertical-panel%
        [parent stats-frame]
        [alignment '(left center)]))
 
-(define (remove-children)
-  (for ([child (in-list (send stats-vpanel get-children))])
-    (send stats-vpanel delete-child child)))
-
 (define (greater lst [num 0] [name ""])
   (cond [(empty? lst) (values num name)]
         [else
@@ -62,5 +63,5 @@
   (void))
 
 (define (update-stats)
-  (remove-children)
+  (remove-children stats-vpanel (send stats-vpanel get-children))
   (create-children))

frame.rkt

@@ -60,18 +60,6 @@
 
 ;; Fullscreen handling ;;
 
-; awww yeah... so oldskool...
-(define (remove-children parent kids)
-  (when (> (length kids) 0)
-    (send parent delete-child (car kids))
-    (remove-children parent (cdr kids))))
-
-; just check out those tail recursions...
-(define (add-children parent kids)
-  (when (> (length kids) 0)
-    (send parent add-child (car kids))
-    (add-children parent (cdr kids))))
-
 (define (toggle-fullscreen canvas frame)
   (define was-fullscreen?  (send frame is-fullscreened?))
   (define going-to-be-fullscreen? (not was-fullscreen?))

tag-browser.rkt

@@ -5,7 +5,8 @@
          racket/gui/base
          racket/string
          "base.rkt"
-         "db.rkt")
+         "db.rkt"
+         "files.rkt")
 (provide show-tag-browser)
 
 (define browser-frame
@@ -14,6 +15,10 @@
        [width 800]
        [height 500]))
 
+; set the icon for the frame
+(unless (macosx?)
+  (send browser-frame set-icon (read-bitmap logo)))
+
 ; begin menu bar definitions
 
 (define browser-menu-bar
@@ -144,9 +149,7 @@
                  ; 15 the tallest any column can be
                  (define tag-grid (grid-list (image-taglist img-label) 15))
                  ; remove any children vpanel might have
-                 (define children (send edit-tags-check-hpanel get-children))
-                 (unless (null? children)
-                   (map (λ (child) (send edit-tags-check-hpanel delete-child child)) children))
+                 (remove-children edit-tags-check-hpanel (send edit-tags-check-hpanel get-children))
                  ; loop over the tag sections
                  (for ([tag-section (in-list tag-grid)])
                    (define vpanel-section
@@ -259,9 +262,7 @@
               (generate-thumbnails (list img-str)))
             (send thumb-bmp load-file thumb-path)
             ; remove old thumb-button
-            (define vpanel-children (send thumb-vpanel get-children))
-            (unless (null? vpanel-children)
-              (send thumb-vpanel delete-child (car (send thumb-vpanel get-children))))
+            (remove-children thumb-vpanel (send thumb-vpanel get-children))
             ; generate new thumb-button
             (new button%
                  [parent thumb-vpanel]
@@ -303,9 +304,7 @@
   (send tag-lbox clear)
   (send img-lbox clear)
   ; remove old thumb-button
-  (define vpanel-children (send thumb-vpanel get-children))
-  (unless (null? vpanel-children)
-    (send thumb-vpanel delete-child (car (send thumb-vpanel get-children))))
+  (remove-children thumb-vpanel (send thumb-vpanel get-children))
   ; get every tag in the database
   (define tag-labels (sort (table-column 'tags 'Tag_Label) string<?))
   ; add them to the list-box