From 65b01513fd5008182e6e25cd97b1b8a78390bc8e Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Tue, 30 May 2006 14:54:10 +0000
Subject: [PATCH] infrastrure for capabilities added (and added first
 capabilities)

svn: r3119

original commit: b6372a2e223625c24a1ac4b39157b422ba04d0d7
---
 collects/framework/private/scheme.ss |  2 +-
 collects/mrlib/name-message.ss       | 85 +++++++++++++++++-----------
 2 files changed, 52 insertions(+), 35 deletions(-)

diff --git a/collects/framework/private/scheme.ss b/collects/framework/private/scheme.ss
index 9dc6c7cd..d0d32ebb 100644
--- a/collects/framework/private/scheme.ss
+++ b/collects/framework/private/scheme.ss
@@ -1263,7 +1263,7 @@
                                      (ormap
                                       (λ (x)
                                         (text-between-equal? x text backward-match before-whitespace-pos))
-                                      '("cond" "provide/contract")))
+                                      '("cond" "field" "provide/contract")))
                           (change-to #\())]))]
                   [(not (zero? before-whitespace-pos))
                    ;; this is the first thing in the sequence
diff --git a/collects/mrlib/name-message.ss b/collects/mrlib/name-message.ss
index 81a3c91b..25eba414 100644
--- a/collects/mrlib/name-message.ss
+++ b/collects/mrlib/name-message.ss
@@ -38,6 +38,12 @@
                stretchable-width stretchable-height
                get-top-level-window refresh)
       
+      (define hidden? #f)
+      (define/public (set-hidden? d?) 
+        (unless (eq? hidden? d?)
+          (set! hidden? d?)
+          (refresh)))
+      
       (define paths #f)
       
       ;; label : string
@@ -87,38 +93,39 @@
 	      (send i enable #f))))
 	
       (define/override (on-event evt)
-	(let-values ([(max-x max-y) (get-size)])
-	  (let ([inside? (and (not (send evt leaving?))
-			      (<= 0 (send evt get-x) max-x)
-			      (<= 0 (send evt get-y) max-y))])
-	    (unless (eq? inside? mouse-over?)
-	      (set! mouse-over? inside?)
-	      (refresh))))
-	
-	(cond
-	 [(send evt button-down?)
-	  (let-values ([(width height) (get-size)]
-		       [(reset) (lambda ()
-				  (set! mouse-grabbed? #f)
-				  (set! mouse-over? #f)
-				  (refresh))])
-	    (set! mouse-over? #t)
-	    (set! mouse-grabbed? #t)
-	    (let ([menu (make-object popup-menu% #f
-				     (lambda x
-				       (reset)))])
-	      (fill-popup menu reset)
-	      
-	      ;; Refresh the screen (wait for repaint)
-	      (set! paint-sema (make-semaphore))
-	      (refresh) 
-	      (yield paint-sema)
-	      (set! paint-sema #f)
-
-	      ;; Popup menu
-	      (popup-menu menu
-			  0
-			  height)))]))
+	(unless hidden?
+          (let-values ([(max-x max-y) (get-size)])
+            (let ([inside? (and (not (send evt leaving?))
+                                (<= 0 (send evt get-x) max-x)
+                                (<= 0 (send evt get-y) max-y))])
+              (unless (eq? inside? mouse-over?)
+                (set! mouse-over? inside?)
+                (refresh))))
+          
+          (cond
+            [(send evt button-down?)
+             (let-values ([(width height) (get-size)]
+                          [(reset) (lambda ()
+                                     (set! mouse-grabbed? #f)
+                                     (set! mouse-over? #f)
+                                     (refresh))])
+               (set! mouse-over? #t)
+               (set! mouse-grabbed? #t)
+               (let ([menu (make-object popup-menu% #f
+                             (lambda x
+                               (reset)))])
+                 (fill-popup menu reset)
+                 
+                 ;; Refresh the screen (wait for repaint)
+                 (set! paint-sema (make-semaphore))
+                 (refresh) 
+                 (yield paint-sema)
+                 (set! paint-sema #f)
+                 
+                 ;; Popup menu
+                 (popup-menu menu
+                             0
+                             height)))])))
 
       (define paint-sema #f)
       
@@ -134,8 +141,18 @@
 	  (semaphore-post paint-sema))
         (let ([dc (get-dc)])
           (let-values ([(w h) (get-client-size)])
-            (when (and (> w 5) (> h 5))
-              (draw-button-label dc label 0 0 w h mouse-over? mouse-grabbed?)))))
+            (cond
+              [hidden? 
+               (let ([pen (send dc get-pen)]
+                     [brush (send dc get-brush)])
+                 (send dc set-brush (send the-brush-list find-or-create-brush (get-panel-background) 'panel))
+                 (send dc set-pen (send the-pen-list find-or-create-pen "black" 1 'transparent))
+                 (send dc draw-rectangle 0 0 w h)
+                 (send dc set-pen pen)
+                 (send dc set-brush brush))]
+              [else
+               (when (and (> w 5) (> h 5))
+                 (draw-button-label dc label 0 0 w h mouse-over? mouse-grabbed?))]))))
       
       (super-new [style '(transparent)])
       (update-min-sizes)