/* Printing of backtraces and error messages
- * Copyright (C) 1996,1997,1998,1999,2000,2001, 2003, 2004 Free Software Foundation
+ * Copyright (C) 1996,1997,1998,1999,2000,2001, 2003, 2004, 2006 Free Software Foundation
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
#if HAVE_CONFIG_H
#include "libguile/lang.h"
#include "libguile/backtrace.h"
#include "libguile/filesys.h"
+#include "libguile/private-options.h"
/* {Error reporting and backtraces}
*
static void
display_frame_expr (char *hdr, SCM exp, char *tlr, int indentation, SCM sport, SCM port, scm_print_state *pstate)
{
- SCM string;
int i = 0, n;
scm_t_ptob_descriptor *ptob = scm_ptobs + SCM_PTOBNUM (sport);
do
{
pstate->length = print_params[i].length;
ptob->seek (sport, 0, SEEK_SET);
- if (SCM_CONSP (exp))
+ if (scm_is_pair (exp))
{
pstate->level = print_params[i].level - 1;
scm_iprlist (hdr, exp, tlr[0], sport, pstate);
}
while (indentation + n > SCM_BACKTRACE_WIDTH && i < n_print_params);
ptob->truncate (sport, n);
- string = scm_strport_to_string (sport);
- assert (scm_is_string (string));
-
- {
- char *data = scm_i_string_writable_chars (string);
-
- /* Remove control characters */
- for (i = 0; i < n; ++i)
- if (iscntrl (data[i]))
- data[i] = ' ';
- /* Truncate */
- if (indentation + n > SCM_BACKTRACE_WIDTH)
- {
- n = SCM_BACKTRACE_WIDTH - indentation;
- data[n-1] = '$';
- }
-
- scm_i_string_stop_writing ();
- }
- scm_lfwrite (scm_i_string_chars (string), n, port);
- scm_remember_upto_here_1 (string);
+ scm_display (scm_strport_to_string (sport), port);
}
static void
{
SCM_VALIDATE_FRAME (1, frame);
if (SCM_UNBNDP (port))
- port = scm_cur_outp;
+ port = scm_current_output_port ();
else
SCM_VALIDATE_OPOUTPORT (2, port);
if (SCM_UNBNDP (indent))
/* Display a special form. */
{
SCM source = SCM_FRAME_SOURCE (frame);
- SCM copy = (SCM_CONSP (source)
+ SCM copy = (scm_is_pair (source)
? scm_source_property (source, scm_sym_copy)
: SCM_BOOL_F);
SCM umcopy = (SCM_MEMOIZEDP (source)
? scm_i_unmemoize_expr (source)
: SCM_BOOL_F);
display_frame_expr ("(",
- SCM_CONSP (copy) ? copy : umcopy,
+ scm_is_pair (copy) ? copy : umcopy,
")",
nfield + 1 + indentation,
sport,
SCM port;
SCM first;
SCM depth;
+ SCM highlight_objects;
};
static SCM
pstate = SCM_PRINT_STATE (print_state);
pstate->writingp = 1;
pstate->fancyp = 1;
+ pstate->highlight_objects = a->highlight_objects;
/* First find out if it's reasonable to do indentation. */
if (SCM_BACKWARDS_P)
}
#undef FUNC_NAME
-SCM_DEFINE (scm_display_backtrace, "display-backtrace", 2, 2, 0,
- (SCM stack, SCM port, SCM first, SCM depth),
- "Display a backtrace to the output port @var{port}. @var{stack}\n"
+SCM_DEFINE (scm_display_backtrace_with_highlights, "display-backtrace", 2, 3, 0,
+ (SCM stack, SCM port, SCM first, SCM depth, SCM highlights),
+ "Display a backtrace to the output port @var{port}. @var{stack}\n"
"is the stack to take the backtrace from, @var{first} specifies\n"
- "where in the stack to start and @var{depth} how much frames\n"
- "to display. Both @var{first} and @var{depth} can be @code{#f},\n"
- "which means that default values will be used.")
-#define FUNC_NAME s_scm_display_backtrace
+ "where in the stack to start and @var{depth} how many frames\n"
+ "to display. @var{first} and @var{depth} can be @code{#f},\n"
+ "which means that default values will be used.\n"
+ "If @var{highlights} is given it should be a list; the elements\n"
+ "of this list will be highlighted wherever they appear in the\n"
+ "backtrace.")
+#define FUNC_NAME s_scm_display_backtrace_with_highlights
{
struct display_backtrace_args a;
struct display_error_handler_data data;
a.port = port;
a.first = first;
a.depth = depth;
+ if (SCM_UNBNDP (highlights))
+ a.highlight_objects = SCM_EOL;
+ else
+ a.highlight_objects = highlights;
data.mode = "backtrace";
data.port = port;
scm_internal_catch (SCM_BOOL_T,
}
#undef FUNC_NAME
+SCM
+scm_display_backtrace (SCM stack, SCM port, SCM first, SCM depth)
+{
+ return scm_display_backtrace_with_highlights (stack, port, first, depth,
+ SCM_EOL);
+}
+
SCM_VARIABLE (scm_has_shown_backtrace_hint_p_var, "has-shown-backtrace-hint?");
-SCM_DEFINE (scm_backtrace, "backtrace", 0, 0, 0,
- (),
+SCM_DEFINE (scm_backtrace_with_highlights, "backtrace", 0, 1, 0,
+ (SCM highlights),
"Display a backtrace of the stack saved by the last error\n"
- "to the current output port.")
-#define FUNC_NAME s_scm_backtrace
+ "to the current output port. If @var{highlights} is given\n"
+ "it should be a list; the elements of this list will be\n"
+ "highlighted wherever they appear in the backtrace.")
+#define FUNC_NAME s_scm_backtrace_with_highlights
{
+ SCM port = scm_current_output_port ();
SCM the_last_stack =
scm_fluid_ref (SCM_VARIABLE_REF (scm_the_last_stack_fluid_var));
+
+ if (SCM_UNBNDP (highlights))
+ highlights = SCM_EOL;
+
if (scm_is_true (the_last_stack))
{
- scm_newline (scm_cur_outp);
- scm_puts ("Backtrace:\n", scm_cur_outp);
- scm_display_backtrace (the_last_stack,
- scm_cur_outp,
- SCM_UNDEFINED,
- SCM_UNDEFINED);
- scm_newline (scm_cur_outp);
+ scm_newline (port);
+ scm_puts ("Backtrace:\n", port);
+ scm_display_backtrace_with_highlights (the_last_stack,
+ port,
+ SCM_BOOL_F,
+ SCM_BOOL_F,
+ highlights);
+ scm_newline (port);
if (scm_is_false (SCM_VARIABLE_REF (scm_has_shown_backtrace_hint_p_var))
&& !SCM_BACKTRACE_P)
{
scm_puts ("Type \"(debug-enable 'backtrace)\" if you would like "
"a backtrace\n"
"automatically if an error occurs in the future.\n",
- scm_cur_outp);
+ port);
SCM_VARIABLE_SET (scm_has_shown_backtrace_hint_p_var, SCM_BOOL_T);
}
}
else
{
- scm_puts ("No backtrace available.\n", scm_cur_outp);
+ scm_puts ("No backtrace available.\n", port);
}
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
+SCM
+scm_backtrace (void)
+{
+ return scm_backtrace_with_highlights (SCM_EOL);
+}
+
\f
void
HCoop / bpt / guile.git / blobdiff