From 864b560cf4c823351c5405b185565e72b2821e1a Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Thu, 11 Nov 2004 15:36:17 +0000
Subject: [PATCH] .

original commit: 81c3805bbb57ee65f2632d1856df8ab73feb01c0
---
 collects/mred/mred.ss           | 13 ++++++++++++-
 collects/mred/private/kernel.ss |  1 +
 collects/tests/mred/item.ss     | 10 ++++++----
 3 files changed, 19 insertions(+), 5 deletions(-)

diff --git a/collects/mred/mred.ss b/collects/mred/mred.ss
index 0e41fdd9..ac93d3ae 100644
--- a/collects/mred/mred.ss
+++ b/collects/mred/mred.ss
@@ -2062,6 +2062,12 @@
 	       (on-paint)
 	       (send dc set-clipping-region #f)))))))
 
+    (define/public (set-label i s)
+      (set-car! (list-tail tabs i) (wx:label->plain-label s))
+      (set! tab-widths #f)
+      (set! regions #f)
+      (on-paint))
+
     (define -append
       (entry-point
        (lambda (s)
@@ -5380,7 +5386,12 @@
 				     (if (= p i)
 					 (cdr l)
 					 (cons (car l) (loop (add1 p) (cdr l))))))
-		(as-exit (lambda () (send (mred->wx tabs) delete i)))))])
+		(as-exit (lambda () (send (mred->wx tabs) delete i)))))]
+     [set-item-label (entry-point
+		      (lambda (i s)
+			(check-item 'set-item-label i)
+			(check-label-string '(method tab-panel% set-item-label) s)
+			(as-exit (lambda () (send (mred->wx tabs) set-label i s)))))])
     
     (private
       [check-item
diff --git a/collects/mred/private/kernel.ss b/collects/mred/private/kernel.ss
index a19822a3..f1e7c7c7 100644
--- a/collects/mred/private/kernel.ss
+++ b/collects/mred/private/kernel.ss
@@ -1435,6 +1435,7 @@
     basic-style)
   (define-function get-the-style-list)
   (define-class tab-group% item% #f
+    set-label
     delete
     append
     enable
diff --git a/collects/tests/mred/item.ss b/collects/tests/mred/item.ss
index 045e43ee..75ae789b 100644
--- a/collects/tests/mred/item.ss
+++ b/collects/tests/mred/item.ss
@@ -1941,10 +1941,12 @@
 				    (set! count (add1 count))))
   (make-object button% "Delete" p2 (lambda (b e)
 				     (send p delete 0)))
-  (make-object button% "Set First" p2 (lambda (b e)
-					(send p set-selection 0)))
-  (make-object button% "Set Last" p2 (lambda (b e)
-				       (send p set-selection (sub1 (send p get-number)))))
+  (make-object button% "First" p2 (lambda (b e)
+				    (send p set-selection 0)))
+  (make-object button% "Last" p2 (lambda (b e)
+				   (send p set-selection (sub1 (send p get-number)))))
+  (make-object button% "Rename" p2 (lambda (b e)
+				     (send p set-item-label (quotient (send p get-number) 2) "Do&nut")))
   (when no-border?
     (make-object button% "Toggle" p2 (lambda (b e)
 				       (if on?