From 92dcfca644ce8ae64b7d910b7a2de9f232afeaa2 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Fri, 31 Oct 2008 01:20:39 +0000
Subject: [PATCH] improved tab navigation keybindings

svn: r12189
---
 collects/drscheme/private/main.ss             | 33 +++++++++++++++++++
 collects/framework/main.ss                    |  7 ++++
 collects/framework/private/group.ss           | 14 ++++++--
 collects/framework/private/sig.ss             |  3 +-
 .../english-string-constants.ss               |  4 +++
 5 files changed, 58 insertions(+), 3 deletions(-)

diff --git a/collects/drscheme/private/main.ss b/collects/drscheme/private/main.ss
index 694f106a17..f42f04ab56 100644
--- a/collects/drscheme/private/main.ss
+++ b/collects/drscheme/private/main.ss
@@ -477,6 +477,39 @@
                                             "text:ports out"
                                             (string-constant repl-out-color))))
 
+(let* ([find-frame
+        (λ (item)
+          (let loop ([item item])
+            (cond
+              [(is-a? item top-level-window<%>)
+               (and (is-a? item drscheme:unit:frame%)
+                    item)]
+              [(is-a? item menu-item<%>)
+               (loop (send item get-parent))]
+              [(is-a? item menu-bar%)
+               (loop (send item get-frame))]
+              [else #f])))]
+       [dc
+        (λ (item)
+          (let ([frame (find-frame item)])
+            (send item enable (and frame (> (length (send frame get-tabs)) 1)))))])
+  (group:add-to-windows-menu
+   (λ (windows-menu)
+     (new menu-item%
+          [parent windows-menu] [label (string-constant prev-tab)] [shortcut #\[]
+          [demand-callback dc]
+          [callback (λ (item _) 
+                      (let ([frame (find-frame item)])
+                        (when frame
+                          (send frame prev-tab))))])
+     (new menu-item% [parent windows-menu] [label (string-constant next-tab)] [shortcut #\]]
+          [demand-callback dc]
+          [callback (λ (item _) 
+                      (let ([frame (find-frame item)])
+                        (when frame
+                          (send frame next-tab))))])
+     (new separator-menu-item% [parent windows-menu]))))
+
 ;; Check for any files lost last time.
 ;; Ignore the framework's empty frames test, since
 ;;   the autosave information window may appear and then
diff --git a/collects/framework/main.ss b/collects/framework/main.ss
index 5478e1c118..c6a4febfcf 100644
--- a/collects/framework/main.ss
+++ b/collects/framework/main.ss
@@ -630,6 +630,13 @@
         callback of a frame in order for the group to properly close the
         application.})
  
+ (proc-doc/names
+  group:add-to-windows-menu
+  (-> (-> (is-a?/c menu%) any) any)
+  (proc)
+  @{Procedures passed to this function are called when the @onscreen{Windows} menu is
+               created. Use it to add additional menu items.})
+ 
  (proc-doc/names
   handler:handler?
   (any/c . -> . boolean?)
diff --git a/collects/framework/private/group.ss b/collects/framework/private/group.ss
index f3bea07cea..bce86ecdf9 100644
--- a/collects/framework/private/group.ss
+++ b/collects/framework/private/group.ss
@@ -22,6 +22,14 @@
   
   (define mdi-parent #f)
   
+  (define extra-windows-menus-proc void)
+  (define (add-to-windows-menu f)
+    (let ([old extra-windows-menus-proc])
+      (set! extra-windows-menus-proc
+            (λ (menu)
+              (f menu)
+              (old menu)))))
+  
   (define %
     (class object%
       
@@ -97,8 +105,7 @@
                     [parent menu]
                     [callback (λ (x y) 
                                 (let ([frame (send (send menu get-parent) get-frame)])
-                                  (send frame maximize (not (send frame is-maximized?)))))])
-               (make-object separator-menu-item% menu)) 
+                                  (send frame maximize (not (send frame is-maximized?)))))])) 
              (instantiate menu:can-restore-menu-item% ()
                (label (string-constant bring-frame-to-front...))
                (parent menu)
@@ -110,6 +117,9 @@
                (callback (λ (x y) (most-recent-window-to-front)))
                (shortcut #\'))
              (make-object separator-menu-item% menu)
+             
+             (extra-windows-menus-proc menu)
+             
              (for-each
               (λ (frame)
                 (let ([frame (frame-frame frame)])
diff --git a/collects/framework/private/sig.ss b/collects/framework/private/sig.ss
index dc69259b49..d0c1521030 100644
--- a/collects/framework/private/sig.ss
+++ b/collects/framework/private/sig.ss
@@ -294,7 +294,8 @@
   (define-signature group^ extends group-class^
     (get-the-frame-group
      on-close-action
-     can-close-check))
+     can-close-check
+     add-to-windows-menu))
   
   (define-signature handler-class^
     ())
diff --git a/collects/string-constants/english-string-constants.ss b/collects/string-constants/english-string-constants.ss
index 63b6471ff0..2e53a97017 100644
--- a/collects/string-constants/english-string-constants.ss
+++ b/collects/string-constants/english-string-constants.ss
@@ -707,12 +707,15 @@ please adhere to these guidelines:
 
  (wrap-text-item "Wrap Text")
 
+  ;; windows menu
  (windows-menu-label "&Windows")
  (minimize "Minimize") ;; minimize and zoom are only used under mac os x
  (zoom "Zoom")
  (bring-frame-to-front "Bring Frame to Front")       ;;; title of dialog
  (bring-frame-to-front... "Bring Frame to Front...") ;;; corresponding title of menu item
  (most-recent-window "Most Recent Window")
+  (next-tab "Next Tab")
+  (prev-tab "Previous Tab")
 
  (view-menu-label "&View")
  (show-overview "Show Program Contour") 
@@ -1430,5 +1433,6 @@ please adhere to these guidelines:
   (leave-alone "Leave alone")
   (normalize-string-info "The string you pasted contains ligatures or other non-normalized characters. Normalize them?")
   (normalize-string-preference "Normalize pasted strings")
+  (ask-about-normalizing-strings "Ask about normalizing strings")
   
   )