Only in tab-layout.space: radio-layout.fasl
Only in tab-layout.space: stack-layout.fasl
Only in tab-layout.space: tab-layout.fasl
diff -ur tab-layout/tab-layout.lisp tab-layout.space/tab-layout.lisp
--- tab-layout/tab-layout.lisp	2005-09-19 17:15:30.000000000 +0200
+++ tab-layout.space/tab-layout.lisp	2006-03-07 01:16:59.000000000 +0100
@@ -6,9 +6,7 @@
 ;;; ---------------------------------------------------------------------------
 ;;;  (c) copyright 2005 by Max-Gerd Retzlaff
 
-(in-package :cl-user)
-
-(defpackage :tab-layout
+(cl:defpackage :tab-layout
   (:use :clim :clim-lisp :radio-layout)
   (:export :tab-layout-pane :add-pane :remove-pane
            :enabled-pane :switch-to-pane
@@ -30,6 +28,9 @@
    (ptype :initform nil :accessor tab-pane-ptype :initarg :ptype)
    (drawing-options :initform nil :accessor drawing-options-of-tab-pane)))
 
+(defclass tab-drag-marker ()
+  ((index :initform nil :initarg :index :accessor marker-index)))
+
 (defgeneric find-in-tab-panes-list (thing parent))
 
 (defmethod find-in-tab-panes-list ((thing sheet) (parent tab-layout-pane))
@@ -40,6 +41,20 @@
   (find thing (tab-panes-of-tab-layout parent)
         :key #'tab-pane-title :test #'string-equal))
 
+(defmethod reorder-pane-in-tab-panes-list ((thing sheet) new-index (parent tab-layout-pane))
+  (let ((pane-entry (find thing (tab-panes-of-tab-layout parent)
+                    :key #'tab-pane-pane :test #'equal)))
+    (loop for pane in (tab-panes-of-tab-layout parent)
+          for index from 0
+          if (= index new-index)
+            collect pane-entry
+          unless (eql pane-entry pane)
+            collect pane)))
+
+(defmethod reorder-pane-in-tab-panes-list ((thing sheet) new-index (parent (eql 'tab-layout-pane)))
+  (reorder-pane-in-tab-panes-list thing new-index (sheet-parent thing)))
+
+
 (defmethod find-in-tab-panes-list ((thing sheet) (parent (eql 'tab-layout-pane)))
   (find-in-tab-panes-list thing (sheet-parent (sheet-parent thing))))
 
@@ -85,6 +100,11 @@
     ((tab-pane 'tab-pane :prompt "Tab pane"))
   (remove-pane tab-pane 'tab-layout-pane))
 
+(define-command (com-reorder-tab-pane :command-table clim:global-command-table)
+    ((tab-pane 'tab-pane :prompt "Tab pane")
+     (position 'integer :prompt "To position"))
+  (reorder-pane-in-tab-panes-list tab-pane position 'tab-layout-pane))
+
 ;;;You probably don't want to uncomment this general command translator.
 ;;;
 ;;; (define-presentation-to-command-translator remove-tab-pane
@@ -102,7 +122,7 @@
 (defparameter +tab-bar-view+ (make-instance 'tab-bar-view))
 
 (define-presentation-method present (tab-pane (type tab-pane) stream
-                                                (view tab-bar-view) &key)
+                                              (view tab-bar-view) &key)
   (stream-increment-cursor-position stream 5 0)
   (multiple-value-bind (x y) (stream-cursor-position stream)
     (let* ((length-top-line (+ x 6 (text-size stream (tab-pane-title tab-pane)) 3))
@@ -123,7 +143,6 @@
         (draw-line stream (apply #'make-point (subseq tab-button-polygon 0 2))
                           (apply #'make-point (subseq tab-button-polygon (- (length tab-button-polygon) 2)))
                           :ink +background-ink+))))
-  
   (stream-increment-cursor-position stream 8 0)
   (apply #'invoke-with-drawing-options stream
          (lambda (rest)
@@ -132,40 +151,72 @@
          (drawing-options-of-tab-pane tab-pane))
   (stream-increment-cursor-position stream 10 0))
 
+(defun drag-marker-polygon (x y)
+  (list
+   (- x 8) y
+   (- x 2) (+ y 14)
+   (+ x 6) (+ y 14)
+   (+ x 11) y))
+
+(define-presentation-method present (tab-pane (type tab-drag-marker) stream
+                                              (view tab-bar-view) &key)
+  (multiple-value-bind (x y) (stream-cursor-position stream)
+    (draw-polygon* stream
+                   (drag-marker-polygon x y) 
+                   :ink +background-ink+)))
+
+(define-presentation-method highlight-presentation ((type tab-drag-marker) record stream (state (eql :highlight)))
+  (multiple-value-bind (x y) (bounding-rectangle* record)
+    (draw-polygon* stream
+                   (drag-marker-polygon x y) 
+                   :ink +blue+)))
+
+(define-presentation-method highlight-presentation ((type tab-drag-marker) record stream (state (eql :unhighlight)))
+  (multiple-value-bind (x y) (bounding-rectangle* record)
+    (draw-polygon* stream
+                   (drag-marker-polygon x y) 
+                   :ink +background-ink+)))
+
+#+(or)(define-drag-and-drop-translator drag-reorder-tabs (tab-pane tab-drag-marker command clim:global-command-table )
+    (object)
+  (print object *debug-io*))
 
+(defun repaint-tab-bar (default-ptype pane)
+  (stream-increment-cursor-position pane 0 3)
+  (draw-line* pane 0 17 (slot-value pane 'climi::current-width) 17 :ink +black+)
+  (loop for tab-pane in (reverse
+                          (tab-panes-of-tab-layout
+                           (sheet-parent (sheet-parent
+                                          (or (climi::pane-border pane) pane)))))
+        for i from 0
+        do (with-output-as-presentation (pane (tab-pane-pane tab-pane)
+                                              (or (tab-pane-ptype tab-pane)
+                                                  default-ptype))
+             (present tab-pane 'tab-pane :stream pane))
+        do (present (make-instance 'tab-drag-marker :index i) 'tab-drag-marker :stream pane)))
 
 (defmacro with-tab-layout ((default-ptype &key name)
-                              &body body)
+                           &body body)
   (let* ((radio-layout-pane (gensym "radio-layout-pane-"))
          (tab-bar-pane (gensym "tab-bar-pane-"))
          (tab-layout-name-gensym (gensym "tab-layout-"))
          (tab-layout-name (or name `',tab-layout-name-gensym)))
     `(let ((,tab-bar-pane (make-clim-stream-pane
-                                   :default-view +tab-bar-view+
-                                   :display-time :command-loop
-                                   :scroll-bars nil
-                                   :borders nil
-                                   :height 22
-                                   :display-function
-                                   (lambda (frame pane)
-                                     (declare (ignore frame))
-                                     (stream-increment-cursor-position pane 0 3)
-                                     (draw-line* pane 0 17 (slot-value pane 'climi::current-width) 17 :ink +black+)
-                                     (mapcar (lambda (tab-pane)
-                                                 (with-output-as-presentation (pane (tab-pane-pane tab-pane)
-                                                                                    (or (tab-pane-ptype tab-pane)
-                                                                                        ,default-ptype))
-                                                   (present tab-pane 'tab-pane :stream pane)))
-                                             (tab-panes-of-tab-layout (sheet-parent
-                                                                             (sheet-parent
-                                                                              (or (climi::pane-border pane) pane))))))))
+                           :default-view +tab-bar-view+
+                           :display-time :command-loop
+                           :scroll-bars nil
+                           :borders nil
+                           :height 22
+                           :display-function  (lambda (frame pane)
+                                                (declare (ignore frame))
+                                                (repaint-tab-bar ,default-ptype pane))))
            (,radio-layout-pane (make-pane 'radio-layout-pane
                                           :contents (list ,@(mapcar #'second body)))))
        (make-pane 'tab-layout-pane
                   :name ,tab-layout-name
                   :tab-panes (list ,@(mapcar (lambda (tab-spec)
-                                                  `(apply #'make-tab-pane-from-list (list ,@tab-spec)))
-                                                body))
+                                               `(apply #'make-tab-pane-from-list (list ,@tab-spec)))
+                                             body))
                   :radio-layout-pane ,radio-layout-pane
                   :tab-bar-pane ,tab-bar-pane
                   :contents (list ,tab-bar-pane