From 4ab3da47a98309e4f91ca9e46443ab26423ff6a7 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 14 Sep 2010 14:20:51 -0600
Subject: [PATCH] fix focus and frame-modified problems

original commit: af499e303930f8ba117f979bb1fa260416c55152
---
 collects/mred/private/wx/cocoa/canvas.rkt |  9 ++++++++-
 collects/mred/private/wx/cocoa/frame.rkt  |  6 ++++--
 collects/mred/private/wx/cocoa/window.rkt |  5 ++++-
 collects/mred/private/wx/gtk/canvas.rkt   |  5 +++--
 collects/mred/private/wx/gtk/frame.rkt    | 16 +++++++++++++---
 5 files changed, 32 insertions(+), 9 deletions(-)

diff --git a/collects/mred/private/wx/cocoa/canvas.rkt b/collects/mred/private/wx/cocoa/canvas.rkt
index 6a000998..a29c47d6 100644
--- a/collects/mred/private/wx/cocoa/canvas.rkt
+++ b/collects/mred/private/wx/cocoa/canvas.rkt
@@ -192,6 +192,7 @@
     (define virtual-height #f)
     (define virtual-width #f)
 
+    (define wants-focus? (not (memq 'no-focus style)))
     (define is-combo? (memq 'combo style))
     (define has-control-border? (and (not is-combo?)
                                      (memq 'control-border style)))
@@ -656,7 +657,8 @@
     
     (define/override (definitely-wants-event? e) 
       ;; Called in Cocoa event-handling mode
-      (when (and (e . is-a? . mouse-event%)
+      (when (and wants-focus?
+                 (e . is-a? . mouse-event%)
                  (send e button-down? 'left))
         (set-focus))
       (or (not is-combo?)
@@ -664,6 +666,11 @@
           (not (send e button-down? 'left))
           (not (on-menu-click? e))))
 
+    (define/override (gets-focus?)
+      wants-focus?)
+    (define/override (can-be-responder?)
+      wants-focus?)
+
     (define/private (on-menu-click? e)
       ;; Called in Cocoa event-handling mode
       (let ([xb (box 0)]
diff --git a/collects/mred/private/wx/cocoa/frame.rkt b/collects/mred/private/wx/cocoa/frame.rkt
index 457035ff..460251d9 100644
--- a/collects/mred/private/wx/cocoa/frame.rkt
+++ b/collects/mred/private/wx/cocoa/frame.rkt
@@ -23,6 +23,8 @@
 (import-class NSWindow NSGraphicsContext NSMenu NSPanel
               NSApplication NSAutoreleasePool NSScreen)
 
+(define NSWindowCloseButton 0)
+
 (define front #f)
 
 (define (get-front) front)
@@ -459,8 +461,8 @@
     (def/public-unimplemented system-menu)
 
     (define/public (set-modified on?)
-      ;; Use standardWindowButton: ...
-      (void))
+      (let ([b (tell cocoa standardWindowButton: #:type _NSInteger NSWindowCloseButton)])
+        (tellv b setDocumentEdited: #:type _BOOL on?)))
     
     (define/public (create-status-line) (void))
     (define/public (set-status-text s) (void))
diff --git a/collects/mred/private/wx/cocoa/window.rkt b/collects/mred/private/wx/cocoa/window.rkt
index 00debc66..033f8da7 100644
--- a/collects/mred/private/wx/cocoa/window.rkt
+++ b/collects/mred/private/wx/cocoa/window.rkt
@@ -57,7 +57,9 @@
 (define-objc-mixin (FocusResponder Superclass)
   [wxb]
   [-a _BOOL (acceptsFirstResponder)
-      #t]
+      (let ([wx (->wx wxb)])
+        (or (not wx)
+            (send wx can-be-responder?)))]
   [-a _BOOL (becomeFirstResponder)
       (and (super-tell becomeFirstResponder)
            (let ([wx (->wx wxb)])
@@ -635,6 +637,7 @@
     (define/public (get-cursor-width-delta) 0)
     
     (define/public (gets-focus?) #f)
+    (define/public (can-be-responder?) #t)
     
     (def/public-unimplemented centre)))
 
diff --git a/collects/mred/private/wx/gtk/canvas.rkt b/collects/mred/private/wx/gtk/canvas.rkt
index 52af2441..26200fcd 100644
--- a/collects/mred/private/wx/gtk/canvas.rkt
+++ b/collects/mred/private/wx/gtk/canvas.rkt
@@ -305,8 +305,9 @@
                                                    GDK_FOCUS_CHANGE_MASK
                                                    GDK_ENTER_NOTIFY_MASK
                                                    GDK_LEAVE_NOTIFY_MASK))
-    (set-gtk-object-flags! client-gtk (bitwise-ior (get-gtk-object-flags client-gtk)
-                                                   GTK_CAN_FOCUS))
+    (unless (memq 'no-focus style)
+      (set-gtk-object-flags! client-gtk (bitwise-ior (get-gtk-object-flags client-gtk)
+                                                     GTK_CAN_FOCUS)))
     (when combo-button-gtk
       (connect-combo-key-and-mouse combo-button-gtk))
 
diff --git a/collects/mred/private/wx/gtk/frame.rkt b/collects/mred/private/wx/gtk/frame.rkt
index a1054c74..c872fcb9 100644
--- a/collects/mred/private/wx/gtk/frame.rkt
+++ b/collects/mred/private/wx/gtk/frame.rkt
@@ -136,6 +136,9 @@
     (connect-delete gtk)
     (connect-configure gtk)
 
+    (define saved-title (or label ""))
+    (define is-modified? #f)
+
     (when label
       (gtk_window_set_title gtk label))
 
@@ -288,7 +291,10 @@
     (def/public-unimplemented designate-root-frame)
     (def/public-unimplemented system-menu)
 
-    (define/public (set-modified mod?) (void))
+    (define/public (set-modified mod?)
+      (unless (eq? is-modified? (and mod? #t))
+        (set! is-modified? (and mod? #t))
+        (set-title saved-title)))
 
     (define/public (create-status-line) (void))
     (define/public (set-status-text s) (void))
@@ -334,6 +340,10 @@
     (def/public-unimplemented iconized?)
     (def/public-unimplemented get-menu-bar)
     (def/public-unimplemented iconize)
-    (define/public (set-title s)
-      (gtk_window_set_title gtk s))))
+
+    (define/public (set-title s)
+      (set! saved-title s)
+      (gtk_window_set_title gtk (if is-modified?
+                                    (string-append s "*")
+                                    s)))))