From: Matt Birkholz <puck@birchwood-abbey.net>
Date: Fri, 5 Sep 2014 22:14:42 +0000 (-0700)
Subject: gtk: Fix testing code to use new fluid library-directory-path.
X-Git-Tag: mit-scheme-pucked-9.2.12~400
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=6b8c8b7660c93c8261b7d5263d2d7e79570dcafa;p=mit-scheme.git

gtk: Fix testing code to use new fluid library-directory-path.
---

diff --git a/src/cairo/cairo-optiondb.scm b/src/cairo/cairo-optiondb.scm
index 672717a0e..50ebdbef1 100644
--- a/src/cairo/cairo-optiondb.scm
+++ b/src/cairo/cairo-optiondb.scm
@@ -11,5 +11,5 @@
 
 (further-load-options
  (merge-pathnames "optiondb"
-		  (last (access library-directory-path
-				(->environment '(runtime pathname))))))
\ No newline at end of file
+		  (last (fluid (access library-directory-path
+				       (->environment '(runtime pathname)))))))
\ No newline at end of file
diff --git a/src/cairo/check.scm b/src/cairo/check.scm
index 585ddf46f..4aad05b8b 100644
--- a/src/cairo/check.scm
+++ b/src/cairo/check.scm
@@ -2,10 +2,10 @@
 
 ;;;; Test the cairo wrapper.
 
-(let ((env (->environment '(runtime pathname)))
+(let ((flu (access library-directory-path
+		     (->environment '(runtime pathname))))
       (dirname (directory-pathname (current-load-pathname))))
-  (set! (access library-directory-path env)
-	(cons dirname (access library-directory-path env)))
+  (set-fluid! flu (cons dirname (fluid flu)))
   (set! *initial-options-file* (merge-pathnames "cairo-optiondb" dirname)))
 
 (load-option 'CAIRO)
diff --git a/src/gl/check.scm b/src/gl/check.scm
index fc1001576..4db8aa587 100644
--- a/src/gl/check.scm
+++ b/src/gl/check.scm
@@ -9,10 +9,9 @@
 
 (if (gtk-initialized?)
     (begin
-      (let ((env (->environment '(runtime pathname))))
-	(set! (access library-directory-path env)
-	      (cons (merge-pathnames "./")
-		    (access library-directory-path env))))
+      (let ((flu (access library-directory-path
+			 (->environment '(runtime pathname)))))
+	(set-fluid! flu (cons (merge-pathnames "./") (fluid flu))))
       (load "make")
       (let* ((widget (make-glxgears-demo))
 	     (thread ((access glxgears-demo-animation-thread
diff --git a/src/glib/check.scm b/src/glib/check.scm
index 643e838a6..f35f39f1d 100644
--- a/src/glib/check.scm
+++ b/src/glib/check.scm
@@ -2,10 +2,10 @@
 
 ;;;; Test the glib wrapper.
 
-(let ((env (->environment '(runtime pathname)))
-      (dirname (directory-pathname (current-load-pathname))))
-  (set! (access library-directory-path env)
-	(cons dirname (access library-directory-path env)))
+(let ((dirname (directory-pathname (current-load-pathname)))
+      (flu (access library-directory-path
+		   (->environment '(runtime pathname)))))
+  (set-fluid! flu (cons dirname (fluid flu)))
   (set! *initial-options-file* (merge-pathnames "glib-optiondb" dirname)))
 
 (load-option 'GLIB)
diff --git a/src/glib/glib-optiondb.scm b/src/glib/glib-optiondb.scm
index 317eec22d..cde1d703d 100644
--- a/src/glib/glib-optiondb.scm
+++ b/src/glib/glib-optiondb.scm
@@ -11,5 +11,5 @@
 
 (further-load-options
  (merge-pathnames "optiondb"
-		  (last (access library-directory-path
-				(->environment '(runtime pathname))))))
\ No newline at end of file
+		  (last (fluid (access library-directory-path
+				       (->environment '(runtime pathname)))))))
\ No newline at end of file
diff --git a/src/gtk/check.scm b/src/gtk/check.scm
index 6522aab60..6019ba2bc 100644
--- a/src/gtk/check.scm
+++ b/src/gtk/check.scm
@@ -2,10 +2,9 @@
 
 ;;;; Test the gtk wrapper.
 
-(let ((env (->environment '(runtime pathname)))
-      (dirname (directory-pathname (current-load-pathname))))
-  (set! (access library-directory-path env)
-	(cons dirname (access library-directory-path env)))
+(let ((dirname (directory-pathname (current-load-pathname)))
+      (flu (access library-directory-path (->environment '(runtime pathname)))))
+  (set-fluid! flu (cons dirname (fluid flu)))
   (set! *initial-options-file* (merge-pathnames "gtk-optiondb" dirname)))
 
 (load-option 'GTK)
diff --git a/src/gtk/gtk-optiondb.scm b/src/gtk/gtk-optiondb.scm
index 1bfbfe2de..bc5c0b245 100644
--- a/src/gtk/gtk-optiondb.scm
+++ b/src/gtk/gtk-optiondb.scm
@@ -11,5 +11,5 @@
 
 (further-load-options
  (merge-pathnames "optiondb"
-		  (last (access library-directory-path
-				(->environment '(runtime pathname))))))
\ No newline at end of file
+		  (last (fluid (access library-directory-path
+				       (->environment '(runtime pathname)))))))
\ No newline at end of file
diff --git a/src/pango/check.scm b/src/pango/check.scm
index ba5268213..1ffcefd7f 100644
--- a/src/pango/check.scm
+++ b/src/pango/check.scm
@@ -2,10 +2,9 @@
 
 ;;;; Test the pango wrapper.
 
-(let ((env (->environment '(runtime pathname)))
-      (dirname (directory-pathname (current-load-pathname))))
-  (set! (access library-directory-path env)
-	(cons dirname (access library-directory-path env)))
+(let ((dirname (directory-pathname (current-load-pathname)))
+      (flu (access library-directory-path (->environment '(runtime pathname)))))
+  (set-fluid! flu (cons dirname (fluid flu)))
   (set! *initial-options-file* (merge-pathnames "pango-optiondb" dirname)))
 
 (load-option 'PANGO)
diff --git a/src/pango/pango-optiondb.scm b/src/pango/pango-optiondb.scm
index 3298a02ea..65b09800b 100644
--- a/src/pango/pango-optiondb.scm
+++ b/src/pango/pango-optiondb.scm
@@ -11,5 +11,5 @@
 
 (further-load-options
  (merge-pathnames "optiondb"
-		  (last (access library-directory-path
-				(->environment '(runtime pathname))))))
\ No newline at end of file
+		  (last (fluid (access library-directory-path
+				       (->environment '(runtime pathname)))))))
\ No newline at end of file