..

original commit: 838f3d4ca8821fd9c04a948e37877486c4e8f648

collects/framework/private/bday.ss

@@ -0,0 +1,17 @@
+(module bday mzscheme
+  (provide mrf-bday?
+           mf-bday?)
+  
+  ;; mf-bday? : -> boolean
+  ;; Matthias's birthday
+  (define (mf-bday?)
+    (let ([date (seconds->date (current-seconds))])
+      (and (= (date-month date) 10)
+           (= (date-day date) 29))))
+  
+  ;; mrf-bday? : -> boolean
+  ;; Matthew's birthday
+  (define (mrf-bday?)
+    (let ([d (seconds->date (current-seconds))])
+       (and (= (date-month d) 11)
+            (= (date-day d) 1)))))

collects/framework/private/frame.ss

@@ -8,6 +8,7 @@
 	   "sig.ss"
 	   "../gui-utils.ss"
 	   "../macro.ss"
+           "bday.ss"
 	   (lib "mred-sig.ss" "mred")
 	   (lib "list.ss")
 	   (lib "file.ss")
@@ -441,7 +442,7 @@
               (send panel stretchable-width #f)))
 
           [define lock-canvas (make-object lock-canvas% (get-info-panel))]
-          [define gc-canvas (make-object canvas% (get-info-panel) '(border))]
+          [define gc-canvas (make-object bday-click-canvas% (get-info-panel) '(border))]
           [define register-gc-blit
             (lambda ()
               (let ([onb (icon:get-gc-on-bitmap)]
@@ -2060,6 +2061,18 @@
                      (super-can-close?))))]
           (super-instantiate ())))
       
+      (define bday-click-canvas%
+        (class canvas%
+          (rename [super-on-event on-event])
+          (define/override (on-event evt)
+            (cond
+              [(and (mrf-bday?)
+                    (send evt button-up?))
+               (message-box (string-constant drscheme)
+                            "Happy Birthday, Matthew!")]
+              [else (super-on-event evt)]))
+          (super-instantiate ())))
+      
       (define basic% (basic-mixin frame%))
       (define info% (info-mixin basic%))
       (define text-info% (text-info-mixin info%))

collects/framework/private/icon.ss

@@ -1,7 +1,8 @@
 (module icon mzscheme
   (require (lib "unitsig.ss")
 	   (lib "class.ss")
-	   "sig.ss"
+	   "bday.ss"
+           "sig.ss"
 	   (lib "mred-sig.ss" "mred")
 	   (lib "mred-sig.ss" "mred"))
 
@@ -80,11 +81,6 @@
                     ((load-icon "mrf.jpg" 'jpeg))
                     ((load-icon "recycle.gif" 'gif))))))
       
-      (define (mrf-bday?)
-        (let ([d (seconds->date (current-seconds))])
-          (and (= (date-month d) 11)
-               (= (date-day d) 1))))
-
       (define (get-gc-on-bitmap) (fetch) gc-on-bitmap)
       
       (define get-gc-off-bitmap