* dynwind.c (scm_dowinds): Handle fluids on the wind list.

* fluids.h (scm_internal_with_fluids, scm_with_fluids,
scm_swap_fluids, scm_swap_fluids_reverse): New prototypes.
* fluids.c (scm_internal_with_fluids, scm_with_fluids,
scm_swap_fluids, scm_swap_fluids_reverse): New functions.

libguile/dynwind.c

@@ -44,12 +44,23 @@
 #include "_scm.h"
 #include "eval.h"
 #include "alist.h"
+#include "fluids.h"
 
 #include "dynwind.h"
 
 
 /* {Dynamic wind}
- */
+ 
+   Things that can be on the wind list:
+
+   (enter-proc . leave-proc)     dynamic-wind
+   (tag . jmpbuf)                catch
+   (tag . lazy-catch)            lazy-catch
+     tag is either a symbol or a boolean
+
+   ((fluid ...) . (value ...))   with-fluids
+
+*/
 
 
 
@@ -94,10 +105,15 @@ scm_dowinds (to, delta)
 #endif
 	{
 	  wind_key = SCM_CAR (wind_elt);
-	  if (   !(SCM_NIMP (wind_key) && SCM_SYMBOLP (wind_key))
+	  if (!(SCM_NIMP (wind_key) && SCM_SYMBOLP (wind_key))
 	      && (wind_key != SCM_BOOL_F)
 	      && (wind_key != SCM_BOOL_T))
-	    scm_apply (wind_key, SCM_EOL, SCM_EOL);
+	    {
+	      if (SCM_NIMP (wind_key) && SCM_CONSP (wind_key))
+		scm_swap_fluids (wind_key, SCM_CDR (wind_elt));
+	      else
+		scm_apply (wind_key, SCM_EOL, SCM_EOL);
+	    }
 	}
       scm_dynwinds = to;
     }
@@ -119,10 +135,15 @@ scm_dowinds (to, delta)
 #endif
 	{
 	  wind_key = SCM_CAR (wind_elt);
-	  if (   !(SCM_NIMP (wind_key) && SCM_SYMBOLP (wind_key))
+	  if (!(SCM_NIMP (wind_key) && SCM_SYMBOLP (wind_key))
 	      && (wind_key != SCM_BOOL_F)
 	      && (wind_key != SCM_BOOL_T))
-	    scm_apply (from, SCM_EOL, SCM_EOL);
+	    {
+	      if (SCM_NIMP (wind_key) && SCM_CONSP (wind_key))
+		scm_swap_fluids_reverse (wind_key, from);
+	      else
+		scm_apply (from, SCM_EOL, SCM_EOL);
+	    }
 	}
       delta--;
       goto tail;		/* scm_dowinds(to, delta-1); */
@@ -136,4 +157,3 @@ scm_init_dynwind ()
 {
 #include "dynwind.x"
 }
-

libguile/fluids.c

@@ -44,7 +44,10 @@
 #include "_scm.h"
 #include "print.h"
 #include "smob.h"
+#include "dynwind.h"
 #include "fluids.h"
+#include "alist.h"
+#include "eval.h"
 
 #define INITIAL_FLUIDS 10
 
@@ -146,6 +149,15 @@ scm_make_fluid ()
   return z;
 }
 
+SCM_PROC (s_fluid_p, "fluid?", 1, 0, 0, scm_fluid_p);
+
+SCM
+scm_fluid_p (fl)
+     SCM fl;
+{
+  return (SCM_NIMP (fl) && SCM_FLUIDP (fl))? SCM_BOOL_T : SCM_BOOL_F;
+}
+
 SCM_PROC (s_fluid_ref, "fluid-ref", 1, 0, 0, scm_fluid_ref);
 
 SCM
@@ -154,7 +166,7 @@ scm_fluid_ref (fl)
 {
   int n;
 
-  SCM_ASSERT (SCM_NIMP (fl) && SCM_FLUIDP (fl), SCM_ARG1, fl, s_fluid_ref);
+  SCM_ASSERT (SCM_NIMP (fl) && SCM_FLUIDP (fl), fl, SCM_ARG1, s_fluid_ref);
 
   n = SCM_FLUID_NUM (fl);
   assert (n >= 0 && n < n_fluids);
@@ -173,7 +185,7 @@ scm_fluid_set_x (fl, val)
 {
   int n;
 
-  SCM_ASSERT (SCM_NIMP (fl) && SCM_FLUIDP (fl), SCM_ARG1, fl, s_fluid_set_x);
+  SCM_ASSERT (SCM_NIMP (fl) && SCM_FLUIDP (fl), fl, SCM_ARG1, s_fluid_set_x);
 
   n = SCM_FLUID_NUM (fl);
   assert (n >= 0 && n < n_fluids);
@@ -184,6 +196,78 @@ scm_fluid_set_x (fl, val)
   return val;
 }
 
+void
+scm_swap_fluids (fluids, vals)
+     SCM fluids, vals;
+{
+  while (SCM_NIMP (fluids))
+    {
+      SCM fl = SCM_CAR (fluids);
+      SCM old_val = scm_fluid_ref (fl);
+      scm_fluid_set_x (fl, SCM_CAR (vals));
+      SCM_SETCAR (vals, old_val);
+      fluids = SCM_CDR (fluids);
+      vals = SCM_CDR (vals);
+    }
+}
+
+/* Swap the fluid values in reverse order.  This is important when the
+same fluid appears multiple times in the fluids list. */
+
+void
+scm_swap_fluids_reverse (fluids, vals)
+     SCM fluids, vals;
+{
+  if (SCM_NIMP (fluids))
+    {
+      SCM fl, old_val;
+
+      scm_swap_fluids_reverse (SCM_CDR (fluids), SCM_CDR (vals));
+      fl = SCM_CAR (fluids);
+      old_val = scm_fluid_ref (fl);
+      scm_fluid_set_x (fl, SCM_CAR (vals));
+      SCM_SETCAR (vals, old_val);
+    }
+}
+
+SCM_PROC (s_with_fluids, "with-fluids*", 3, 0, 0, scm_with_fluids);
+
+SCM
+scm_internal_with_fluids (fluids, vals, cproc, cdata)
+     SCM fluids, vals;
+     SCM (*cproc) ();
+     void *cdata;
+{
+  SCM ans;
+
+  int flen = scm_ilength (fluids);
+  int vlen = scm_ilength (vals);
+  SCM_ASSERT (flen >= 0, fluids, SCM_ARG1, s_with_fluids);
+  SCM_ASSERT (vlen >= 0, vals, SCM_ARG2, s_with_fluids);
+  if (flen != vlen)
+    scm_out_of_range (s_with_fluids, vals);
+
+  scm_swap_fluids (fluids, vals);
+  scm_dynwinds = scm_acons (fluids, vals, scm_dynwinds);
+  ans = cproc (cdata);
+  scm_dynwinds = SCM_CDR (scm_dynwinds);
+  scm_swap_fluids_reverse (fluids, vals);
+  return ans;
+}
+
+static SCM
+apply_thunk (void *thunk)
+{
+  return scm_apply ((SCM) thunk, SCM_EOL, SCM_EOL);
+}
+
+SCM
+scm_with_fluids (fluids, vals, thunk)
+     SCM fluids, vals, thunk;
+{
+  return scm_internal_with_fluids (fluids, vals, apply_thunk, (void *)thunk);
+}
+
 void
 scm_init_fluids ()
 {

libguile/fluids.h

@@ -62,10 +62,10 @@
    to index a vector that holds the values of all fluids.  Each root
    has its own vector.
 
-   Currently, you can't get rid a certain fluid if you don't use any
+   Currently, you can't get rid a certain fluid if you don't use it
-   longer.  The slot that has been allocated for it in the fluid
+   any longer.  The slot that has been allocated for it in the fluid
    vector will not be reused for other fluids.  Therefore, only use
-   SCM_MAKE_FLUID or it Scheme variant `make-fluid' in initialization
+   SCM_MAKE_FLUID or its Scheme variant `make-fluid' in initialization
    code that is only run once.  Nevertheless, it should be possible to
    implement a more lightweight version of fluids on top of this basic
    mechanism. */
@@ -76,7 +76,7 @@ extern long scm_tc16_fluid;
 #define SCM_FLUID_NUM(x) SCM_CDR(x)
 
 /* The fastest way to acces/modify the value of a fluid.  These macros
-does no error checking at all.  You should only use them when you know
+do no error checking at all.  You should only use them when you know
 that the relevant fluid already exists in the current dynamic root.
 The easiest way to ensure this is to execute a SCM_FLUID_SET_X in the
 topmost root, for example right after SCM_MAKE_FLUID in your
@@ -91,8 +91,14 @@ SCM scm_make_fluid SCM_P ((void));
 SCM scm_fluid_ref SCM_P ((SCM fluid));
 SCM scm_fluid_set_x SCM_P ((SCM fluid, SCM value));
 
+SCM scm_internal_with_fluids SCM_P ((SCM fluids, SCM vals,
+				     SCM (*cproc)(void *), void *cdata));
+SCM scm_with_fluids SCM_P ((SCM fluids, SCM vals, SCM thunk));
+
 SCM scm_make_initial_fluids SCM_P ((void));
 void scm_copy_fluids SCM_P ((scm_root_state *));
+void scm_swap_fluids SCM_P ((SCM fluids, SCM vals));
+void scm_swap_fluids_reverse SCM_P ((SCM fluids, SCM vals));
 
 void scm_init_fluids SCM_P ((void));