-/* 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
\f
#include <stdio.h>
-#include "_scm.h"
-#include "chars.h"
-#include "smob.h"
-#include "eval.h"
-#include "macros.h"
-#include "procprop.h"
-#include "read.h"
-#include "weaks.h"
-#include "unif.h"
-#include "alist.h"
-#include "struct.h"
-#include "objects.h"
-#include "ports.h"
-#include "root.h"
-#include "strings.h"
-#include "strports.h"
-#include "vectors.h"
-
-#include "validate.h"
-#include "print.h"
+#include "libguile/_scm.h"
+#include "libguile/chars.h"
+#include "libguile/smob.h"
+#include "libguile/eval.h"
+#include "libguile/macros.h"
+#include "libguile/procprop.h"
+#include "libguile/read.h"
+#include "libguile/weaks.h"
+#include "libguile/unif.h"
+#include "libguile/alist.h"
+#include "libguile/struct.h"
+#include "libguile/objects.h"
+#include "libguile/ports.h"
+#include "libguile/root.h"
+#include "libguile/strings.h"
+#include "libguile/strports.h"
+#include "libguile/vectors.h"
+
+#include "libguile/validate.h"
+#include "libguile/print.h"
\f
/* {Names of immediate symbols}
"`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
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
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);
- SCM_VALIDATE_LIST(3,args);
+ 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);
for (p = start; *p != '\0'; ++p)
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;
if (fReturnString)
answer = scm_strport_to_string (destination);
- return scm_return_first(answer,message);
+ return scm_return_first (answer, message);
}
#undef FUNC_NAME
{
if (SCM_PORT_WITH_PS_P (port))
return SCM_PORT_WITH_PS_PS (port);
- if (SCM_OUTPORTP (port))
+ if (SCM_OUTPUT_PORT_P (port))
return SCM_BOOL_F;
RETURN_SCM_WTA (1,port);
}
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")));
scm_set_smob_mark (scm_tc16_port_with_ps, scm_markcdr);
scm_set_smob_print (scm_tc16_port_with_ps, print_port_with_ps);
-#include "print.x"
+#include "libguile/print.x"
}
/*