From d84a9e299120fd0ac8734d16e5aedf934b055d04 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Sun, 18 Aug 2002 22:02:14 +0000
Subject: [PATCH] ..

original commit: f0d369cbd78dee61867e195dc32ca38cad21e3e8
---
 collects/framework/gui-utils.ss      | 18 +++++++---
 collects/framework/private/scheme.ss | 50 ++++++++++++++++------------
 2 files changed, 41 insertions(+), 27 deletions(-)

diff --git a/collects/framework/gui-utils.ss b/collects/framework/gui-utils.ss
index 8d960fb0..98966765 100644
--- a/collects/framework/gui-utils.ss
+++ b/collects/framework/gui-utils.ss
@@ -484,10 +484,12 @@
       (min-width (floor (inexact->exact (get-total-width (get-dc)))))))
 
   ;; selected-text-color : color
-  (define selected-text-color (make-object color% "black"))
+  (define selected-text-color (send the-color-database find-color "black"))
 
   ;; unselected-text-color : color
-  (define unselected-text-color (make-object color% "black"))
+  (define unselected-text-color (case (system-type)
+                                  [(macosx) (make-object color% 75 75 75)]
+                                  [else (send the-color-database find-color "black")]))
 
   ;; selected-brush : brush
   (define selected-brush (send the-brush-list find-or-create-brush "WHITE" 'solid))
@@ -496,9 +498,15 @@
   (define unselected-brush (send the-brush-list find-or-create-brush (get-panel-background) 'solid))
 
   ;; button-down/over-brush : brush
-  (define button-down/over-brush (send the-brush-list find-or-create-brush
-                                       (make-object color% 225 225 255)
-                                       'solid))
+  (define button-down/over-brush 
+    (case (system-type)
+      [(macosx) (send the-brush-list find-or-create-brush
+                      "light blue"
+                      'solid)]
+      [else
+       (send the-brush-list find-or-create-brush
+             (make-object color% 225 225 255)
+             'solid)]))
   
   ;; label-font : font
   (define label-font (send the-font-list find-or-create-font
diff --git a/collects/framework/private/scheme.ss b/collects/framework/private/scheme.ss
index 3c27b0ef..62ee8cf4 100644
--- a/collects/framework/private/scheme.ss
+++ b/collects/framework/private/scheme.ss
@@ -858,28 +858,34 @@
               #t)) 
           
           (define box-comment-out-selection
-            (opt-lambda ([start-pos (get-start-position)]
-                         [end-pos (get-end-position)])
-              (begin-edit-sequence)
-              (split-snip start-pos)
-              (split-snip end-pos)
-              (let* ([cb (instantiate cb:comment-box-snip% ())]
-                     [text (send cb get-editor)])
-                (send text set-style-list style-list)
-                (let loop ([snip (find-snip start-pos 'after-or-none)])
-                  (cond
-                    [(not snip) (void)]
-                    [((get-snip-position snip) . >= . end-pos) (void)]
-                    [else
-                     (send text insert (send snip copy)
-                           (send text last-position)
-                           (send text last-position))
-                     (loop (send snip next))]))
-                (delete start-pos end-pos)
-                (insert cb start-pos)
-                (set-position start-pos start-pos))
-              (end-edit-sequence)
-              #t)) 
+            (opt-lambda ([_start-pos 'start]
+                         [_end-pos 'end])
+	      (let ([start-pos (if (eq? _start-pos 'start)
+				   (get-start-position)
+				   _start-pos)]
+		    [end-pos (if (eq? _end-pos 'end)
+				 (get-end-position)
+				 _end-pos)])
+		(begin-edit-sequence)
+		(split-snip start-pos)
+		(split-snip end-pos)
+		(let* ([cb (instantiate cb:comment-box-snip% ())]
+		       [text (send cb get-editor)])
+		  (send text set-style-list style-list)
+		  (let loop ([snip (find-snip start-pos 'after-or-none)])
+		    (cond
+		      [(not snip) (void)]
+		      [((get-snip-position snip) . >= . end-pos) (void)]
+		      [else
+		       (send text insert (send snip copy)
+			     (send text last-position)
+			     (send text last-position))
+		       (loop (send snip next))]))
+		  (delete start-pos end-pos)
+		  (insert cb start-pos)
+		  (set-position start-pos start-pos))
+		(end-edit-sequence)
+		#t)))
           
           (define uncomment-selection
             (opt-lambda ([start-pos (get-start-position)]