From: Matt Birkholz Date: Wed, 2 Mar 2016 06:35:59 +0000 (-0700) Subject: gtk: Use new parameters, not fluids. X-Git-Tag: mit-scheme-pucked-9.2.12~359 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=bd5bf01b9fde92329f932b9e6c2d3189fdf95d59;p=mit-scheme.git gtk: Use new parameters, not fluids. --- diff --git a/src/cairo/cairo-optiondb.scm b/src/cairo/cairo-optiondb.scm index 50ebdbef1..0127e6d5e 100644 --- a/src/cairo/cairo-optiondb.scm +++ b/src/cairo/cairo-optiondb.scm @@ -11,5 +11,5 @@ (further-load-options (merge-pathnames "optiondb" - (last (fluid (access library-directory-path - (->environment '(runtime pathname))))))) \ No newline at end of file + (last ((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 4aad05b8b..6bf831c9c 100644 --- a/src/cairo/check.scm +++ b/src/cairo/check.scm @@ -2,11 +2,11 @@ ;;;; Test the cairo wrapper. -(let ((flu (access library-directory-path - (->environment '(runtime pathname)))) - (dirname (directory-pathname (current-load-pathname)))) - (set-fluid! flu (cons dirname (fluid flu))) - (set! *initial-options-file* (merge-pathnames "cairo-optiondb" dirname))) +(let ((dirname (directory-pathname (current-load-pathname))) + (param (access library-directory-path + (->environment '(runtime pathname))))) + (parameterize ((param (cons dirname (param)))) + (set! *initial-options-file* (merge-pathnames "cairo-optiondb" dirname)) + (load-option 'CAIRO))) -(load-option 'CAIRO) (load "cairo-check" (->environment '(CAIRO))) \ No newline at end of file diff --git a/src/gl/check.scm b/src/gl/check.scm index 4db8aa587..3c0fdfce1 100644 --- a/src/gl/check.scm +++ b/src/gl/check.scm @@ -9,10 +9,10 @@ (if (gtk-initialized?) (begin - (let ((flu (access library-directory-path - (->environment '(runtime pathname))))) - (set-fluid! flu (cons (merge-pathnames "./") (fluid flu)))) - (load "make") + (let ((param (access library-directory-path + (->environment '(runtime pathname))))) + (parameterize ((param (cons (merge-pathnames "./") (param)))) + (load "make"))) (let* ((widget (make-glxgears-demo)) (thread ((access glxgears-demo-animation-thread (->environment '(gl glxgears))) diff --git a/src/glib/check.scm b/src/glib/check.scm index f35f39f1d..60c38ff09 100644 --- a/src/glib/check.scm +++ b/src/glib/check.scm @@ -3,10 +3,10 @@ ;;;; Test the glib wrapper. (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))) + (param (access library-directory-path + (->environment '(runtime pathname))))) + (parameterize ((param (cons dirname (param)))) + (set! *initial-options-file* (merge-pathnames "glib-optiondb" dirname)) + (load-option 'GLIB))) -(load-option 'GLIB) (load "glib-check" (->environment '(GLIB))) \ No newline at end of file diff --git a/src/glib/glib-optiondb.scm b/src/glib/glib-optiondb.scm index cde1d703d..3d0754f01 100644 --- a/src/glib/glib-optiondb.scm +++ b/src/glib/glib-optiondb.scm @@ -11,5 +11,5 @@ (further-load-options (merge-pathnames "optiondb" - (last (fluid (access library-directory-path - (->environment '(runtime pathname))))))) \ No newline at end of file + (last ((access library-directory-path + (->environment '(runtime pathname))))))) \ No newline at end of file diff --git a/src/gtk-screen/check.scm b/src/gtk-screen/check.scm index 8fb50080a..577649e44 100644 --- a/src/gtk-screen/check.scm +++ b/src/gtk-screen/check.scm @@ -2,12 +2,14 @@ ;;;; Test the gtk screen. -(let ((flu (access library-directory-path (->environment '(runtime pathname)))) - (dirname (directory-pathname (current-load-pathname)))) - (set-fluid! flu (cons dirname (fluid flu))) - (set! *initial-options-file* (merge-pathnames "gtk-screen-optiondb" dirname))) +(let ((dirname (directory-pathname (current-load-pathname))) + (param (access library-directory-path + (->environment '(runtime pathname))))) + (parameterize ((param (cons dirname (param)))) + (set! *initial-options-file* (merge-pathnames "gtk-screen-optiondb" + dirname)) + (load-option 'GTK-SCREEN))) -(load-option 'GTK-SCREEN) (if (gtk-initialized?) (load "gtk-screen-check") (warn "Could not test the GTK subsystem without a DISPLAY.")) \ No newline at end of file diff --git a/src/gtk-screen/gtk-screen-optiondb.scm b/src/gtk-screen/gtk-screen-optiondb.scm index edf537ad8..75d5dac26 100644 --- a/src/gtk-screen/gtk-screen-optiondb.scm +++ b/src/gtk-screen/gtk-screen-optiondb.scm @@ -11,5 +11,5 @@ (further-load-options (merge-pathnames "optiondb" - (last (fluid (access library-directory-path - (->environment '(runtime pathname))))))) \ No newline at end of file + (last ((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 6019ba2bc..ebf89c32d 100644 --- a/src/gtk/check.scm +++ b/src/gtk/check.scm @@ -3,11 +3,12 @@ ;;;; Test the gtk wrapper. (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))) + (param (access library-directory-path + (->environment '(runtime pathname))))) + (parameterize ((param (cons dirname (param)))) + (set! *initial-options-file* (merge-pathnames "gtk-optiondb" dirname)) + (load-option 'GTK))) -(load-option 'GTK) (if (gtk-initialized?) (load "gtk-check" (->environment '(GTK))) (warn "Could not test the GTK subsystem without a DISPLAY.")) \ No newline at end of file diff --git a/src/gtk/gtk-optiondb.scm b/src/gtk/gtk-optiondb.scm index bc5c0b245..1136a024e 100644 --- a/src/gtk/gtk-optiondb.scm +++ b/src/gtk/gtk-optiondb.scm @@ -11,5 +11,5 @@ (further-load-options (merge-pathnames "optiondb" - (last (fluid (access library-directory-path - (->environment '(runtime pathname))))))) \ No newline at end of file + (last ((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 1ffcefd7f..07020735d 100644 --- a/src/pango/check.scm +++ b/src/pango/check.scm @@ -3,9 +3,10 @@ ;;;; Test the pango wrapper. (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))) + (param (access library-directory-path + (->environment '(runtime pathname))))) + (parameterize ((param (cons dirname (param)))) + (set! *initial-options-file* (merge-pathnames "pango-optiondb" dirname)) + (load-option 'PANGO))) -(load-option 'PANGO) (load "pango-check" (->environment '(PANGO))) \ No newline at end of file diff --git a/src/pango/pango-optiondb.scm b/src/pango/pango-optiondb.scm index 65b09800b..c351eb3fa 100644 --- a/src/pango/pango-optiondb.scm +++ b/src/pango/pango-optiondb.scm @@ -11,5 +11,5 @@ (further-load-options (merge-pathnames "optiondb" - (last (fluid (access library-directory-path - (->environment '(runtime pathname))))))) \ No newline at end of file + (last ((access library-directory-path + (->environment '(runtime pathname))))))) \ No newline at end of file