From 27249014f2c6b199777e4082862ec3268034cf1c Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@racket-lang.org>
Date: Thu, 14 Aug 2008 02:23:56 +0000
Subject: [PATCH] some code improvements, mainly removing the redundantly
 threaded home argument, and a warning message if there is no GL support.

svn: r11234
---
 collects/sgl/make-gl-info.ss | 53 +++++++++++++++++-------------------
 collects/sgl/makefile.ss     |  8 +++---
 2 files changed, 29 insertions(+), 32 deletions(-)

diff --git a/collects/sgl/make-gl-info.ss b/collects/sgl/make-gl-info.ss
index a58f5b3951..39d131261c 100644
--- a/collects/sgl/make-gl-info.ss
+++ b/collects/sgl/make-gl-info.ss
@@ -88,7 +88,7 @@ end-string
            (substring s 2 (string-length s)))
          (string-tokenize s)))
   
-  (define (get-args which-arg home)
+  (define (get-args which-arg)
     (let ((fp (build-path (find-lib-dir) "buildinfo")))
       (cond
         ((file-exists? fp)
@@ -104,17 +104,15 @@ end-string
                         (loop (read-line i))))))))))
         (else ""))))
 
-  (define (compile-c-to-so file file.c file.so home)
+  (define (compile-c-to-so file file.c file.so)
     (let ((file.o (append-object-suffix file)))
-      (dynext:compile-extension #f 
-                                file.c
-                                file.o
-                                `(,@(parse-includes (get-args "X_CFLAGS" home))
-                                    ,(collection-path "compiler")))
+      (dynext:compile-extension #f file.c file.o
+                                `(,@(parse-includes (get-args "X_CFLAGS"))
+                                  ,(collection-path "compiler")))
       (dynext:link-extension #f (list file.o) file.so)
       (delete/continue file.o)))
 
-  (define (build-helper compile-directory home variant)
+  (define (build-helper compile-directory variant)
     (let* ((file "make-gl-info-helper.ss")
            (c (build-path compile-directory (append-c-suffix file)))
            (so (build-path compile-directory
@@ -125,30 +123,29 @@ end-string
       (with-output-to-file c
         (lambda () (display c-file))
         'replace)
-      (compile-c-to-so file c so home)))
+      (compile-c-to-so file c so)))
 
-  (define (effective-system-type home)
+  (define (effective-system-type)
     (let ([t (system-type)])
-      (if (eq? t 'unix)
-	  ;; Check "buildinfo" for USE_GL flag:
-	  (let ([buildinfo (build-path (find-lib-dir) "buildinfo")])
-	    (if (file-exists? buildinfo)
-		(with-input-from-file buildinfo
-		  (lambda ()
-		    (let loop ()
-		      (let ([l (read-line)])
-			(cond
-			 [(eof-object? l) 'no-gl]
-			 [(regexp-match #rx"-DUSE_GL" l) t]
-			 [else (loop)])))))
-		t))
-	  t)))
-  
-  (define (make-gl-info compile-directory home)
+      (if (not (eq? t 'unix))
+        t
+        ;; Check "buildinfo" for USE_GL flag:
+        (let ([buildinfo (build-path (find-lib-dir) "buildinfo")])
+          (if (not (file-exists? buildinfo))
+            (begin (printf "WARNING: buildinfo file missing: ~a\n" buildinfo)
+                   t)
+            (with-input-from-file buildinfo
+              (lambda ()
+                (if (regexp-match? #rx"-DUSE_GL" (current-input-port))
+                  t
+                  (begin (printf "WARNING: no GL support\n")
+                         'no-gl)))))))))
+
+  (define (make-gl-info compile-directory)
     (let ((zo (build-path compile-directory (append-zo-suffix "gl-info.ss")))
           (mod
            (compile
-            (case (effective-system-type home)
+            (case (effective-system-type)
               ((macosx windows no-gl)
                `(,#'module gl-info mzscheme
                   (provide (all-defined))
@@ -169,7 +166,7 @@ end-string
              (else
               (for-each (lambda (variant)
                           (parameterize ([dynext:link-variant variant])
-                            (build-helper compile-directory home variant)))
+                            (build-helper compile-directory variant)))
                         (available-mzscheme-variants))
               `(,#'module gl-info mzscheme
                  (provide (all-defined))
diff --git a/collects/sgl/makefile.ss b/collects/sgl/makefile.ss
index e609175b57..7f114dde24 100644
--- a/collects/sgl/makefile.ss
+++ b/collects/sgl/makefile.ss
@@ -4,15 +4,15 @@
            "make-gl-info.ss")
 
   (provide pre-installer)
-    
+
   (define dir (build-path "compiled"))
-  
+
   (define (pre-installer home)
     (parameterize ((current-directory (collection-path "sgl"))
 		   (make-print-reasons #f)
 		   (make-print-checking #f))
       (make/proc
        `((,(build-path dir "gl-info_ss.zo")
-           ("make-gl-info.ss" ,(build-path (find-include-dir) "schvers.h"))
-           ,(lambda () (make-gl-info dir home)))))))
+          ("make-gl-info.ss" ,(build-path (find-include-dir) "schvers.h"))
+          ,(lambda () (make-gl-info dir)))))))
   )