*** empty log message ***

[bpt/guile.git] / libguile / print.c

diff --git a/libguile/print.c b/libguile/print.c
index a243b4e..5b3e35e 100644 (file)
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -1,4 +1,4 @@
-/*     Copyright (C) 1995-1999 Free Software Foundation, Inc.
+/*     Copyright (C) 1995-1999, 2000 Free Software Foundation, Inc.
  * 
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -193,7 +193,10 @@ SCM_DEFINE (scm_current_pstate, "current-pstate", 0, 0, 0,
             "`current-pstate' is only included in GUILE_DEBUG builds.")
 #define FUNC_NAME s_scm_current_pstate
 {
-  return SCM_CADR (print_state_pool);
+  if (SCM_NNULLP (SCM_CDR (print_state_pool)))
+    return SCM_CADR (print_state_pool);
+  else
+    return SCM_BOOL_F;
 }
 #undef FUNC_NAME
 
@@ -407,11 +410,11 @@ taloop:
                    env = SCM_ENV (SCM_CDR (exp));
                    scm_puts ("#<", port);
                  }
-               if (SCM_UNPACK_CAR(exp) & (3L << 16))
+               if (SCM_CELL_WORD_0 (exp) & (3L << 16))
                  scm_puts ("macro", port);
                else
                  scm_puts ("syntax", port);
-               if (SCM_UNPACK_CAR (exp) & (2L << 16))
+               if (SCM_CELL_WORD_0 (exp) & (2L << 16))
                  scm_putc ('!', port);
              }
            else
@@ -957,18 +960,24 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1,
   char *start;
   char *p;
 
-  if (SCM_TRUE_P (destination)) {
-    destination = scm_cur_outp;
-  } else if (SCM_FALSEP (destination)) {
-    fReturnString = 1;
-    destination = scm_mkstrport (SCM_INUM0, 
-                          scm_make_string (SCM_INUM0, SCM_UNDEFINED),
-                          SCM_OPN | SCM_WRTNG,
-                          FUNC_NAME);
-  } else {
-    SCM_VALIDATE_OPORT_VALUE (1,destination);
-  }
-  SCM_VALIDATE_STRING(2,message);
+  if (SCM_EQ_P (destination, SCM_BOOL_T))
+    {
+      destination = scm_cur_outp;
+    }
+  else if (SCM_FALSEP (destination))
+    {
+      fReturnString = 1;
+      destination = scm_mkstrport (SCM_INUM0, 
+                                  scm_make_string (SCM_INUM0, SCM_UNDEFINED),
+                                  SCM_OPN | SCM_WRTNG,
+                                  FUNC_NAME);
+    }
+  else
+    {
+      SCM_VALIDATE_OPORT_VALUE (1, destination);
+      destination = SCM_COERCE_OUTPORT (destination);
+    }
+  SCM_VALIDATE_STRING (2, message);
   SCM_VALIDATE_REST_ARGUMENT (args);
 
   start = SCM_ROCHARS (message);
@@ -979,9 +988,9 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1,
          continue;
        
        ++p;
-       if (*p == 'A')
+       if (*p == 'A' || *p == 'a')
          writingp = 0;
-       else if (*p == 'S')
+       else if (*p == 'S' || *p == 's')
          writingp = 1;
        else
          continue;
@@ -996,7 +1005,7 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1,
   if (fReturnString)
     answer = scm_strport_to_string (destination);
 
-  return scm_return_first(answer,message);
+  return scm_return_first (answer, message);
 }
 #undef FUNC_NAME
 
@@ -1104,9 +1113,7 @@ scm_init_print ()
   SCM vtable, layout, type;
   
   scm_init_opts (scm_print_options, scm_print_opts, SCM_N_PRINT_OPTIONS);
-  vtable = scm_make_vtable_vtable (scm_make_struct_layout (scm_nullstr),
-                                  SCM_INUM0,
-                                  SCM_EOL);
+  vtable = scm_make_vtable_vtable (scm_nullstr, SCM_INUM0, SCM_EOL);
   layout = scm_make_struct_layout (scm_makfrom0str (SCM_PRINT_STATE_LAYOUT));
   type = scm_make_struct (vtable, SCM_INUM0, SCM_LIST1 (layout));
   scm_set_struct_vtable_name_x (type, SCM_CAR (scm_intern0 ("print-state")));