From 6b8c8b7660c93c8261b7d5263d2d7e79570dcafa Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Fri, 5 Sep 2014 15:14:42 -0700 Subject: [PATCH] gtk: Fix testing code to use new fluid library-directory-path. --- src/cairo/cairo-optiondb.scm | 4 ++-- src/cairo/check.scm | 6 +++--- src/gl/check.scm | 7 +++---- src/glib/check.scm | 8 ++++---- src/glib/glib-optiondb.scm | 4 ++-- src/gtk/check.scm | 7 +++---- src/gtk/gtk-optiondb.scm | 4 ++-- src/pango/check.scm | 7 +++---- src/pango/pango-optiondb.scm | 4 ++-- 9 files changed, 24 insertions(+), 27 deletions(-) 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 -- 2.25.1