From e2e6516a84ea49e3b81b0df8d6c115f8f873d6c6 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Fri, 14 Oct 2005 14:08:40 +0000
Subject: [PATCH] use 'png for arrow bitmaps, drop redundant with-handlers

svn: r1083
---
 collects/algol60/parse.ss           |  4 +--
 collects/framework/private/frame.ss |  6 ++--
 collects/mrlib/syntax-browser.ss    |  8 ++---
 collects/setup/setup-unit.ss        | 56 +++++++++++++++--------------
 4 files changed, 38 insertions(+), 36 deletions(-)

diff --git a/collects/algol60/parse.ss b/collects/algol60/parse.ss
index cde3cea777..056fb479c8 100644
--- a/collects/algol60/parse.ss
+++ b/collects/algol60/parse.ss
@@ -190,7 +190,7 @@
                                [(IF <Boolean-expression> 
                                     THEN <simple-Boolean> 
                                     ELSE <Boolean-expression>)
-                                (make-a60:if $2 $4 $6)])
+				(make-a60:if $2 $4 $6)])
          ;; -------------------- Designationals --------------------
          (<label> [(<identifier>) $1]
                   [(<unsigned-integer>) $1])
@@ -204,7 +204,7 @@
                                      [(IF <Boolean-expression> 
                                           THEN <simple-designational-expression> 
                                           ELSE <designational-expression>)
-                                      (make-a60:if $2 $4 $6)])
+				      (make-a60:if $2 $4 $6)])
          ;; -------------------- Variables --------------------
          (<subscript-list> [(<arithmetic-expression>) (list $1)]
                            [(<subscript-list> COMMA <arithmetic-expression>) (append $1 (list $3))])
diff --git a/collects/framework/private/frame.ss b/collects/framework/private/frame.ss
index 5d77a9aac2..55f971abe9 100644
--- a/collects/framework/private/frame.ss
+++ b/collects/framework/private/frame.ss
@@ -2288,10 +2288,8 @@
             (with-handlers ([exn:fail:filesystem?
                              (λ (x) #f)])
               (let ([fw (collection-path "framework")])
-                (with-handlers ([exn:fail:filesystem?
-                                 (λ (x) #f)])
-                  (or (directory-exists? (build-path fw ".svn"))
-                      (directory-exists? (build-path fw "CVS"))))))))
+                (or (directory-exists? (build-path fw ".svn"))
+                    (directory-exists? (build-path fw "CVS")))))))
       
       (define bday-click-canvas%
         (class canvas%
diff --git a/collects/mrlib/syntax-browser.ss b/collects/mrlib/syntax-browser.ss
index 1288ae429d..141f179578 100644
--- a/collects/mrlib/syntax-browser.ss
+++ b/collects/mrlib/syntax-browser.ss
@@ -441,10 +441,10 @@ needed to really make this work:
   
   (define (set-box/f! b v) (when (box? b) (set-box! b v)))
   
-  (define down-bitmap (include-bitmap (lib "turn-down.png" "icons")))
-  (define up-bitmap (include-bitmap (lib "turn-up.png" "icons")))
-  (define down-click-bitmap (include-bitmap (lib "turn-down-click.png" "icons")))
-  (define up-click-bitmap (include-bitmap (lib "turn-up-click.png" "icons")))
+  (define down-bitmap (include-bitmap (lib "turn-down.png" "icons") 'png))
+  (define up-bitmap (include-bitmap (lib "turn-up.png" "icons") 'png))
+  (define down-click-bitmap (include-bitmap (lib "turn-down-click.png" "icons") 'png))
+  (define up-click-bitmap (include-bitmap (lib "turn-up-click.png" "icons") 'png))
   (define arrow-snip-height
     (max 10
          (send up-bitmap get-height)
diff --git a/collects/setup/setup-unit.ss b/collects/setup/setup-unit.ss
index e8aee109a2..c990e59fb1 100644
--- a/collects/setup/setup-unit.ss
+++ b/collects/setup/setup-unit.ss
@@ -526,33 +526,37 @@
            ccs-to-compile)))
       
       (do-install-part 'pre)
-      
-      (define (make-it desc compile-directory)
+
+      (define (make-it desc compile-directory get-namespace)
         ;; To avoid polluting the compilation with modules that are
         ;; already loaded, create a fresh namespace before calling
-        ;; this function
+        ;; this function.
+	;; To avoid keeping modules in memory across collections,
+	;; pass `make-namespace' as `get-namespace', otherwise use
+	;; `current-namespace' for `get-namespace'.
         (for-each (lambda (cc)
-                    (record-error
-                     cc
-                     (format "Compiling ~a" desc)
-                     (lambda ()
-                       (unless (control-io-apply
-                                (case-lambda 
-                                  [(p) 
-                                   ;; Main "doing something" message
-                                   (setup-fprintf p "Compiling ~a used by ~a" 
-                                                  desc (cc-name cc))]
-                                  [(p where)
-                                   ;; Doing something specifically in "where"
-                                   (setup-fprintf p "  in ~a" 
-                                                  (path->string
-                                                   (path->complete-path
-                                                    where
-                                                    (cc-path cc))))])
-                                compile-directory
-                                (list (cc-path cc) (cc-info cc)))
-                         (setup-printf "No more ~a to compile for ~a" 
-                                       desc (cc-name cc)))))
+		    (parameterize ([current-namespace (get-namespace)])
+		      (record-error
+		       cc
+		       (format "Compiling ~a" desc)
+		       (lambda ()
+			 (unless (control-io-apply
+				  (case-lambda 
+				   [(p) 
+				    ;; Main "doing something" message
+				    (setup-fprintf p "Compiling ~a used by ~a" 
+						   desc (cc-name cc))]
+				   [(p where)
+				    ;; Doing something specifically in "where"
+				    (setup-fprintf p "  in ~a" 
+						   (path->string
+						    (path->complete-path
+						     where
+						     (cc-path cc))))])
+				  compile-directory
+				  (list (cc-path cc) (cc-info cc)))
+			   (setup-printf "No more ~a to compile for ~a" 
+					 desc (cc-name cc))))))
                     (collect-garbage))
                   ccs-to-compile))
       
@@ -592,8 +596,8 @@
       (when (make-zo) 
         (with-specified-mode
          (lambda ()
-           (make-it ".zos" compile-directory-zos))))
-      (when (make-so) (make-it "extensions" compile-directory-extension))
+           (make-it ".zos" compile-directory-zos make-namespace))))
+      (when (make-so) (make-it "extensions" compile-directory-extension current-namespace))
       
       ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
       ;;               Info-Domain Cache               ;;