Add reorder tabs facility in DrRacket

pkgs/drracket-pkgs/drracket-test/tests/drracket/reorder-tabs.rkt

@@ -0,0 +1,21 @@
+#lang racket/base
+(require "private/drracket-test-util.rkt"
+         racket/list
+         racket/class
+         rackunit)
+
+(fire-up-drracket-and-run-tests 
+ (λ ()
+   (define drs (wait-for-drracket-frame))
+   (send drs create-new-tab)
+   (send drs create-new-tab)
+   (define tabs (send drs get-tabs))
+
+   (send drs reorder-tabs (reverse (range (length tabs))))
+   (define new-tabs (send drs get-tabs))
+   (check-equal? new-tabs (reverse tabs))
+
+   (send drs reorder-tabs (reverse (range (length tabs))))
+   (define new-tabs2 (send drs get-tabs))
+   (check-equal? new-tabs2 tabs)
+   ))

pkgs/drracket-pkgs/drracket/drracket/private/main.rkt

@@ -747,6 +747,24 @@
                         (when frame
                           (send frame next-tab))))])
      
+     (new menu-item% 
+          [parent windows-menu]
+          [label (string-constant move-current-tab-right)]
+          [demand-callback dc]
+          [callback (λ (item _) 
+                      (let ([frame (find-frame item)])
+                        (when frame
+                          (send frame move-current-tab-right))))])
+     
+     (new menu-item% 
+          [parent windows-menu]
+          [label (string-constant move-current-tab-left)]
+          [demand-callback dc]
+          [callback (λ (item _) 
+                      (let ([frame (find-frame item)])
+                        (when frame
+                          (send frame move-current-tab-left))))])
+     
      (let ([frame (find-frame windows-menu)])
        (unless (or (not frame) (= 1 (send frame get-tab-count)))
          (unless (eq? (system-type) 'macosx)

pkgs/drracket-pkgs/drracket/drracket/private/unit.rkt

@@ -3057,6 +3057,51 @@
       (define/private (change-to-delta-tab dt)
         (change-to-nth-tab (modulo (+ (send current-tab get-i) dt) (length tabs))))
 
+      ;; Re-orders the tabs according to the specified order
+      (define/public (reorder-tabs tab-order)
+        (unless (and
+                  ((listof exact-nonnegative-integer?) tab-order)
+                  (equal? (sort tab-order <)
+                          (range (length tabs))))
+          (raise-argument-error 'reorder-tabs 
+                 "list of unique integers from 0 to n where n is the current number of tabs"
+                 tab-order))
+        (begin-container-sequence)
+        (define-values (new-tabs-rev new-labels-rev)
+          (for/fold ([new-tabs '()]
+                     [new-labels '()]
+                     )([new-i (in-naturals)]
+                       [old-i tab-order])
+            (define t (list-ref tabs old-i))
+            (send t set-i new-i)
+            (values (cons t new-tabs)
+                    (cons (send tabs-panel get-item-label old-i)
+                          new-labels))))
+        (set! tabs (reverse new-tabs-rev))
+        (send tabs-panel set (reverse new-labels-rev))
+        (send tabs-panel set-selection (send current-tab get-i))
+        (end-container-sequence)
+        (update-menu-bindings)
+        (update-tabs-labels))
+
+      ;; Swaps the current tab with its right-hand neighbor
+      (define/public (move-current-tab-right)
+        (define i (send current-tab get-i))
+        (unless (= i (- (length tabs) 1))
+          (reorder-tabs
+           (append (range i)
+                   (list (+ i 1) i)
+                   (range (+ i 2) (length tabs))))))
+
+      ;; Swaps the current tab with its left-hand neighbor
+      (define/public (move-current-tab-left)
+        (define i (send current-tab get-i))
+        (unless (= i 0)
+          (reorder-tabs
+           (append (range (- i 1))
+                   (list i (- i 1))
+                   (range (+ i 1) (length tabs))))))
+
       (define/public-final (close-current-tab)
         (cond
           [(null? tabs) (void)]

pkgs/drracket-pkgs/drracket/scribblings/tools/unit.scrbl

@@ -635,6 +635,26 @@ Returns the currently active tab.
   Switches to the previous tab.
 }
 
+@defmethod[(move-current-tab-right) void?]{
+  Swaps the current tab with its right-hand neighbor.
+}
+
+@defmethod[(move-current-tab-left) void?]{
+  Swaps the current tab with its left-hand neighbor.
+}
+
+@defmethod[(reorder-tabs [tab-order (listof exact-nonnegative-integer?)]) void?]{
+  Reorders the tabs according to @racket[tab-order].
+                                 
+  Each element in @racket[tab-order] identifies a tab by its position in the list
+  @method[drracket:unit:frame<%> get-tabs], and the position of this element identifies
+  the new position of the tab.
+  
+  For example, considering that there are only 3 tabs open, 
+  @racket[(send a-drracket-frame reorder-tabs '(2 1 0))]
+  swaps the first and last tabs, leaving the middle one unchanged.
+}
+
 @defmethod[#:mode public-final (close-current-tab) void?]{
   Closes the current tab, making some other tab visible.
   If there is only one tab open, this method does nothing.

pkgs/string-constants/string-constants-lib/string-constants/private/english-string-constants.rkt

@@ -854,6 +854,8 @@ please adhere to these guidelines:
  (most-recent-window "Most Recent Window")
   (next-tab "Next Tab")
   (prev-tab "Previous Tab")
+  (move-current-tab-right "Move Tab &Right")
+  (move-current-tab-left "Move Tab &Left")
   ;; menu item in the windows menu under mac os x. first ~a is filled with a number between 1 and 9; second one is the filename of the tab
   (tab-i "Tab ~a: ~a")
 

pkgs/string-constants/string-constants-lib/string-constants/private/french-string-constants.rkt

@@ -836,6 +836,8 @@
   (most-recent-window "Fenêtre la plus récente")
   (next-tab "Onglet suivant")
   (prev-tab "Onglet précédent")
+  (move-current-tab-right "Déplacer à &droite")
+  (move-current-tab-left "Déplacer à &gauche")
   ;; menu item in the windows menu under mac os x. first ~a is filled with a number between 1 and 9; second one is the filename of the tab
   (tab-i "Onglet ~a: ~a")