예제 #1
0
static void
test_query (QofQuery *q)
{
    SCM scm_q;
    QofQuery *q2;

    scm_q = gnc_query2scm (q);

    q2 = gnc_scm2query (scm_q);

    if (!qof_query_equal (q, q2))
    {
        failure ("queries don't match");
        scm_display (scm_q, SCM_UNDEFINED);
        scm_newline (SCM_UNDEFINED);
        scm_q = gnc_query2scm (q2);
        scm_display (scm_q, SCM_UNDEFINED);
        scm_newline (SCM_UNDEFINED);
        exit (1);
    }
    else
    {
        success ("queries match");
    }

    qof_query_destroy (q2);
}
예제 #2
0
static int print_board (SCM board_smob, SCM port, scm_print_state *pstate) {
	struct board *board = (struct board *)SCM_SMOB_DATA(board_smob);

	scm_puts("#<board ", port);
	scm_display(scm_from_int(board->width), port);
	scm_puts(":", port);
	scm_display(scm_from_int(board->height), port);
	scm_puts(">", port);

	return 1;
}
예제 #3
0
static int print_cell (SCM cell_smob, SCM port, scm_print_state *pstate) {
	struct cell *cell = (struct cell *) SCM_SMOB_DATA(cell_smob);

	scm_puts("#<cell ", port);
	scm_display(scm_from_int(cell->x), port);
	scm_puts(":", port);
	scm_display(scm_from_int(cell->y), port);
	scm_puts(" ", port);
	scm_display(scm_from_int(cell->status), port);
	scm_puts(">", port);

	return 1;
}
예제 #4
0
static int
print_key (SCM smob, SCM port, scm_print_state *pstate)
{
  struct key_data *key_data = _scm_to_key_data (smob);
  SCM type = guile_ssh_key_get_type (smob);

  scm_puts ("#<key ", port);
  scm_display (type, port);
  scm_putc (' ', port);
  scm_puts (_private_key_p (key_data) ? "(private) " : "(public) ", port);
  scm_display (_scm_object_hex_address (smob), port);
  scm_puts (">", port);

  return 1;
}
예제 #5
0
static int
pascm_print_param_smob (SCM self, SCM port, scm_print_state *pstate)
{
  param_smob *p_smob = (param_smob *) SCM_SMOB_DATA (self);
  SCM value;

  gdbscm_printf (port, "#<%s", param_smob_name);

  gdbscm_printf (port, " %s", p_smob->name);

  if (! pascm_is_valid (p_smob))
    scm_puts (" {invalid}", port);

  gdbscm_printf (port, " %s ", pascm_param_type_name (p_smob->type));

  value = pascm_param_value (p_smob->type, &p_smob->value,
			     GDBSCM_ARG_NONE, NULL);
  scm_display (value, port);

  scm_puts (">", port);

  scm_remember_upto_here_1 (self);

  /* Non-zero means success.  */
  return 1;
}
예제 #6
0
파일: expPrint.c 프로젝트: pexip/os-autogen
/*=gfunc fprintf
 *
 * what:  format to a file
 * general_use:
 *
 * exparg: port, Guile-scheme output port
 * exparg: format, formatting string
 * exparg: format-arg, list of arguments to formatting string, opt, list
 *
 * doc:  Format a string using arguments from the alist.
 *       Write to a specified port.  The result will NOT appear in your
 *       output.  Use this to print information messages to a template user.
=*/
SCM
ag_scm_fprintf(SCM port, SCM fmt, SCM alist)
{
    int   list_len = scm_ilength(alist);
    char* pzFmt    = ag_scm2zchars(fmt, zFormat);
    SCM   res      = run_printf(pzFmt, list_len, alist);

    return  scm_display(res, port);
}
예제 #7
0
파일: scm-utils.c 프로젝트: ChrisG0x20/gdb
void
gdbscm_debug_display (SCM obj)
{
  SCM port = scm_current_output_port ();

  scm_display (obj, port);
  scm_newline (port);
  scm_force_output (port);
}
예제 #8
0
파일: scm-cmd.c 프로젝트: RWTH-OS/binutils
static void
cmdscm_bad_completion_result (const char *msg, SCM completion)
{
  SCM port = scm_current_error_port ();

  scm_puts (msg, port);
  scm_display (completion, port);
  scm_newline (port);
}
예제 #9
0
파일: s_menu.c 프로젝트: SayCV/geda-gaf
/*! \todo Finish function documentation!!!
 *  \brief
 *  \par Function Description
 *
 */
void s_menu_print()
{
  int i;

  for (i = 0; i < menu_index; i++) {
    printf("Name; %s\n", menu[i].menu_name);
    scm_display (menu[i].menu_items, scm_current_output_port ());
    printf("\n");
  }
}
예제 #10
0
파일: scheme.c 프로젝트: nizmic/nwm
static int print_client(SCM client_smob, SCM port, scm_print_state *pstate)
{
    client_t *client = (client_t *)SCM_SMOB_DATA(client_smob);

    scm_puts("#<client ", port);
    scm_display(scm_from_unsigned_integer(client->window), port);
    scm_puts(">", port);

    /* success */
    return 1;
}
예제 #11
0
static int
print_image (SCM image_smob, SCM port, scm_print_state *pstate)
{
  struct image *image = (struct image *) SCM_SMOB_DATA (image_smob);

  scm_puts ("#<image ", port);
  scm_display (image->name, port);
  scm_puts (">", port);

  /* non-zero means success */
  return 1;
}
static void
test_display__specify_closed_port__return_ERROR(ScmObj port, int type)
{
  ScmObj o = SCM_OBJ_INIT;

  SCM_REFSTK_INIT_REG(&port,
                      &o);

  o = scm_make_string_from_cstr("hello", SCM_ENC_SRC);

  scm_close_port(port);
  TEST_ASSERT_EQUAL_INT(-1, scm_display(o, port));
}
예제 #13
0
파일: error.c 프로젝트: barak/sigscheme
SCM_EXPORT ScmObj
scm_p_inspect_error(ScmObj err_obj)
{
    ScmObj rest;
#if SCM_USE_BACKTRACE
    ScmObj trace_stack;
#endif
    DECLARE_FUNCTION("%%inspect-error", procedure_fixed_1);

    if (ERROBJP(err_obj)) {
        rest = err_obj;
        MUST_POP_ARG(rest);
        MUST_POP_ARG(rest);
        MUST_POP_ARG(rest);
#if SCM_USE_BACKTRACE
        trace_stack = MUST_POP_ARG(rest);
#else
        MUST_POP_ARG(rest);
#endif
        ASSERT_NO_MORE_ARG(rest);
    } else {
#if SCM_USE_BACKTRACE
        trace_stack = scm_trace_stack();
#else
        scm_trace_stack();
#endif
    }

    if (scm_debug_categories() & SCM_DBG_ERRMSG) {
        scm_port_puts(scm_err, SCM_ERR_HEADER);
        if (ERROBJP(err_obj)) {
#if SCM_USE_SRFI38
            scm_display_errobj_ss(scm_err, err_obj);
#else
            scm_display(scm_err, err_obj);
#endif
        } else {
            scm_port_puts(scm_err, ERRMSG_UNHANDLED_EXCEPTION ": ");
            SCM_WRITE_SS(scm_err, err_obj);
        }
        scm_port_newline(scm_err);
    }

#if SCM_USE_BACKTRACE
    if (scm_debug_categories() & SCM_DBG_BACKTRACE)
        scm_show_backtrace(trace_stack);
#endif

    return SCM_UNDEF;
}
static void
test_display__write_NULL(ScmObj port, int type)
{
  const char *expected = "#<INTERNAL-NULL-VALUE 0>";

  SCM_REFSTK_INIT_REG(&port);

  TEST_ASSERT_EQUAL_INT(0, scm_display(SCM_OBJ_NULL, port));

  scm_close_port(port);

  if (type == FILEPORT)
    chk_file_contents(expected);
  else if (type == STRINGPORT)
    chk_string_port_contents(port, expected);
}
예제 #15
0
static void
test_query (Query *q, SCM val2str)
{
    SCM scm_q;
    SCM str_q;
    SCM res_q;
    SCM args = SCM_EOL;
    Query *q2;
    gchar *str2 = NULL;

    scm_q = gnc_query2scm (q);
    args = scm_cons (scm_q, SCM_EOL);
    str_q = scm_apply (val2str, args, SCM_EOL);

    args = scm_cons (scm_from_utf8_string ("'"), scm_cons (str_q, SCM_EOL));
    str_q = scm_string_append (args);

    str2 = gnc_scm_to_utf8_string (str_q);
    if (str2)
    {
        res_q = scm_c_eval_string (str2);
    }
    else
    {
        res_q = SCM_BOOL_F;
    }

    q2 = gnc_scm2query (res_q);

    if (!qof_query_equal (q, q2))
    {
        failure ("queries don't match");
        fprintf (stderr, "%s\n\n", str2 ? str2 : "(null)");
        scm_q = gnc_query2scm (q2);
        scm_display (scm_q, SCM_UNDEFINED);
        scm_newline (SCM_UNDEFINED);
        g_free(str2);
        exit (1);
    }
    else
    {
        success ("queries match");
    }
    g_free(str2);
    if (q2) qof_query_destroy (q2);
}
예제 #16
0
static void
test_query (Query *q, SCM val2str)
{
    SCM scm_q;
    SCM str_q;
    SCM args = SCM_EOL;

    scm_q = gnc_query2scm (q);
    args = scm_cons (scm_q, SCM_EOL);
    str_q = scm_apply (val2str, args, SCM_EOL);

    args = scm_cons (scm_makfrom0str ("'"), scm_cons (str_q, SCM_EOL));
    str_q = scm_string_append (args);

    scm_display (str_q, SCM_UNDEFINED);
    scm_newline (SCM_UNDEFINED);
    scm_newline (SCM_UNDEFINED);
}
예제 #17
0
static void
gdbscm_print_exception_message (SCM port, SCM frame, SCM key, SCM args)
{
  SCM printer, status;

  if (gdbscm_is_false (port))
    port = scm_current_error_port ();

  gdb_assert (!scm_is_eq (key, with_stack_error_symbol));

  /* This does not use scm_print_exception because we tweak the output a bit.
     Compare Guile's print-exception with our %print-exception-message for
     details.  */
  if (gdbscm_is_false (percent_print_exception_message_var))
    {
      percent_print_exception_message_var
	= scm_c_private_variable (gdbscm_init_module_name,
				  percent_print_exception_message_name);
      /* If we can't find %print-exception-message, there's a problem on the
	 Scheme side.  Don't kill GDB, just flag an error and leave it at
	 that.  */
      if (gdbscm_is_false (percent_print_exception_message_var))
	{
	  gdbscm_printf (port, _("Error in Scheme exception printing,"
				 " can't find %s.\n"),
			 percent_print_exception_message_name);
	  return;
	}
    }
  printer = scm_variable_ref (percent_print_exception_message_var);

  status = gdbscm_safe_call_4 (printer, port, frame, key, args, NULL);

  /* If that failed still tell the user something.
     But don't use the exception printing machinery!  */
  if (gdbscm_is_exception (status))
    {
      gdbscm_printf (port, _("Error in Scheme exception printing:\n"));
      scm_display (status, port);
      scm_newline (port);
    }
}
static void
test_display(ScmObj port, int type)
{
  const char *expected = "hello";
  ScmObj o = SCM_OBJ_INIT;

  SCM_REFSTK_INIT_REG(&port,
                      &o);

  o = scm_make_string_from_cstr("hello", SCM_ENC_SRC);

  TEST_ASSERT_EQUAL_INT(0, scm_display(o, port));

  scm_close_port(port);

  if (type == FILEPORT)
    chk_file_contents(expected);
  else if (type == STRINGPORT)
    chk_string_port_contents(port, expected);
}
static void
test_display__write_shared_structure(ScmObj port, int type)
{
  const char *expected = "#0=(#t . #0#)";
  ScmObj o = SCM_OBJ_INIT;

  SCM_REFSTK_INIT_REG(&port,
                      &o);

  o = scm_cons(SCM_TRUE_OBJ, SCM_FALSE_OBJ);
  scm_set_cdr(o, o);

  TEST_ASSERT_EQUAL_INT(0, scm_display(o, port));

  scm_close_port(port);

  if (type == FILEPORT)
    chk_file_contents(expected);
  else if (type == STRINGPORT)
    chk_string_port_contents(port, expected);
}
예제 #20
0
파일: keysym.c 프로젝트: emallson/gram
static int
gram_keysym_print (SCM keysym_smob, SCM port, scm_print_state * pstate)
{
  struct gram_keysym *keysym =
    (struct gram_keysym *) SCM_SMOB_DATA (keysym_smob);

  scm_puts ("#<keysym ", port);
  if (keysym->mods.mods & WLC_BIT_MOD_LOGO)
  {
    scm_puts ("S-", port);
  }
  if (keysym->mods.mods & WLC_BIT_MOD_CTRL)
  {
    scm_puts ("C-", port);
  }
  if (keysym->mods.mods & WLC_BIT_MOD_ALT)
  {
    scm_puts ("M-", port);
  }

  if(keysym->mouse) {
    scm_puts ("Mouse", port);
    scm_putc(keysym->mouse_button + '0', port);
  } else {
    char buf[64];
    xkb_keysym_to_utf8 (keysym->sym, buf, 64);

    if (buf[0] > 0 && buf[0] <= 0x7F)
    {
      xkb_keysym_get_name (keysym->sym, buf, 64);
    }

    SCM name = scm_from_utf8_string (buf);
    scm_display (name, port);
  }
  scm_puts (">", port);

  return 1;
}
예제 #21
0
void
gdbscm_print_exception_with_stack (SCM port, SCM stack, SCM key, SCM args)
{
  SCM printer, status;

  if (gdbscm_is_false (port))
    port = scm_current_error_port ();

  if (gdbscm_is_false (percent_print_exception_with_stack_var))
    {
      percent_print_exception_with_stack_var
	= scm_c_private_variable (gdbscm_init_module_name,
				  percent_print_exception_with_stack_name);
      /* If we can't find %print-exception-with-stack, there's a problem on the
	 Scheme side.  Don't kill GDB, just flag an error and leave it at
	 that.  */
      if (gdbscm_is_false (percent_print_exception_with_stack_var))
	{
	  gdbscm_printf (port, _("Error in Scheme exception printing,"
				 " can't find %s.\n"),
			 percent_print_exception_with_stack_name);
	  return;
	}
    }
  printer = scm_variable_ref (percent_print_exception_with_stack_var);

  status = gdbscm_safe_call_4 (printer, port, stack, key, args, NULL);

  /* If that failed still tell the user something.
     But don't use the exception printing machinery!  */
  if (gdbscm_is_exception (status))
    {
      gdbscm_printf (port, _("Error in Scheme exception printing:\n"));
      scm_display (status, port);
      scm_newline (port);
    }
}
예제 #22
0
/* Print the CHANNEL object to port PORT. */
static int
print_channel (SCM channel, SCM port, scm_print_state *pstate)
{
  struct channel_data *ch = NULL;

#if USING_GUILE_BEFORE_2_2
  if (SCM_PTAB_ENTRY (channel))
    ch = _scm_to_channel_data (channel);
#else
  ch = _scm_to_channel_data (channel);
#endif

  scm_puts ("#<", port);

  if (! ch)
    {
      scm_puts ("unknown channel (freed) ", port);
    }
  else
    {
      scm_print_port_mode (channel, port);
      scm_puts ("channel ", port);
      if (SCM_OPPORTP (channel))
        {
          int is_open = ssh_channel_is_open (ch->ssh_channel);
          scm_puts (is_open ? "(open) " : "(closed) ", port);
        }
      else
        {
          scm_puts ("(closed) ", port);
        }
    }
  scm_display (_scm_object_hex_address (channel), port);
  scm_puts (">", port);
  return 1;
}
예제 #23
0
파일: gwave.c 프로젝트: krichter722/gwave
void gwave_main(void *p, int argc, char **argv)
{
	int c;
	int i;
	int nobacktrace = 0;

	/* In guile-1.5 and later, need to use scm_primitive_eval_x
	 * in order to change modules so that our C primitives
	 * registered below become globals, instead of hidden away
	 * in the guile-user module
	 */
	{
		SCM exp = scm_c_read_string("(define-module (guile))");
		scm_primitive_eval_x(exp);
	}

	init_scwm_guile();
	init_gtkmisc();
	init_gwave();
	init_cmd();
	init_wavewin();
	init_wavelist();
	init_wavepanel();
	init_event();
	init_draw();
	
	gtk_init(&argc, &argv);

	prog_name = argv[0];

	/* simple pre-processing of debugging options that we need to set up
	 * before we get into guile.   These options cannot be bundled.
	 * Most of the general user options are handled in std-args.scm  */
	for(i = 1; i < argc; i++) {
		if(strcmp(argv[i], "-n") == 0) {
			nobacktrace = 1;
		} else if (strcmp(argv[i], "-v") == 0) {
			v_flag = 1;
		} else if (strcmp(argv[i], "-x") == 0) {
			x_flag = 1;
			SCM_SETCDR(scm_gwave_debug, SCM_BOOL_T);
		}
	}

	gtk_rc_parse_string(gwave_base_gtkrc);
	gtk_rc_parse("gwave.gtkrc");
//	assert( SCM_CONSP(scm_gwave_tooltips) );

#ifdef GUILE_GTK_EXTRA_LOADPATH
	scm_c_eval_string("(set! %load-path (cons \"" GUILE_GTK_EXTRA_LOADPATH "\" %load-path))");
#endif

	/* the default for this seems to have changed between guile-1.3
	   and guile-1.3.2;  only the first clause is needed when 
	   we drop support for guile-1.3.2 */
	if (!nobacktrace) {
		scm_c_eval_string("(debug-enable 'debug)(debug-enable 'backtrace) (read-enable 'positions)");
	} /* else {
	scm_c_eval_str("(debug-disable 'debug)(read-disable 'positions)");
	}*/

	/* the compiled-in initial scheme code comes from minimal.scm,
	   built into init_scheme_string.c by the Makefile
	   Among other things, it finds and loads system and user .gwaverc
	   files.
	*/
	{ /* scope */
		extern char *init_scheme_string;
		SCM res;
		if(v_flag) {fprintf(stderr, "running init_scheme_string\n");}
		res = scwm_safe_eval_str(init_scheme_string);
		if(v_flag) {
			printf("result="); fflush(stdout);
			scm_display(res, scm_cur_outp);
			printf("\n"); fflush(stdout);
		}
                if(!SCM_NFALSEP(res)) {
                        fprintf(stderr, "gwave: aborting due to errors.\n");
                        exit(1);
                }

	} /* end scope */

	wtable = g_new0(WaveTable, 1);
	wtable->cursor[0] = g_new0(VBCursor, 1);
	wtable->cursor[1] = g_new0(VBCursor, 1);
	wtable->srange = g_new0(SelRange, 1);
	wtable->npanels = 0;
	wtable->panels = NULL;

	setup_colors(wtable);
	setup_waveform_window();

	xg_init(NULL);  /* X-server interprocess communication for Gtk+ */

	gtk_main();
	exit(0);
}
예제 #24
0
int
weechat_guile_command_cb (void *data, struct t_gui_buffer *buffer,
                          int argc, char **argv, char **argv_eol)
{
    char *path_script;
    SCM value;

    /* make C compiler happy */
    (void) data;
    (void) buffer;

    if (argc == 1)
    {
        script_display_list (weechat_guile_plugin, guile_scripts,
                             NULL, 0);
    }
    else if (argc == 2)
    {
        if (weechat_strcasecmp (argv[1], "list") == 0)
        {
            script_display_list (weechat_guile_plugin, guile_scripts,
                                 NULL, 0);
        }
        else if (weechat_strcasecmp (argv[1], "listfull") == 0)
        {
            script_display_list (weechat_guile_plugin, guile_scripts,
                                 NULL, 1);
        }
        else if (weechat_strcasecmp (argv[1], "autoload") == 0)
        {
            script_auto_load (weechat_guile_plugin, &weechat_guile_load_cb);
        }
        else if (weechat_strcasecmp (argv[1], "reload") == 0)
        {
            weechat_guile_unload_all ();
            script_auto_load (weechat_guile_plugin, &weechat_guile_load_cb);
        }
        else if (weechat_strcasecmp (argv[1], "unload") == 0)
        {
            weechat_guile_unload_all ();
        }
    }
    else
    {
        if (weechat_strcasecmp (argv[1], "list") == 0)
        {
            script_display_list (weechat_guile_plugin, guile_scripts,
                                 argv_eol[2], 0);
        }
        else if (weechat_strcasecmp (argv[1], "listfull") == 0)
        {
            script_display_list (weechat_guile_plugin, guile_scripts,
                                 argv_eol[2], 1);
        }
        else if (weechat_strcasecmp (argv[1], "load") == 0)
        {
            /* load Guile script */
            path_script = script_search_path (weechat_guile_plugin,
                                              argv_eol[2]);
            weechat_guile_load ((path_script) ? path_script : argv_eol[2]);
            if (path_script)
                free (path_script);
        }
        else if (weechat_strcasecmp (argv[1], "reload") == 0)
        {
            /* reload one Guile script */
            weechat_guile_reload_name (argv_eol[2]);
        }
        else if (weechat_strcasecmp (argv[1], "unload") == 0)
        {
            /* unload Guile script */
            weechat_guile_unload_name (argv_eol[2]);
        }
        else if (weechat_strcasecmp (argv[1], "eval") == 0)
        {
            /* eval Guile code */
            value = weechat_guile_catch (scm_c_eval_string, argv_eol[2]);
            if (!SCM_EQ_P (value, SCM_UNDEFINED)
                && !SCM_EQ_P (value, SCM_UNSPECIFIED))
            {
                scm_display (value, guile_port);
            }
            weechat_guile_stdout_flush ();
        }
        else
        {
            weechat_printf (NULL,
                            weechat_gettext ("%s%s: unknown option for "
                                             "command \"%s\""),
                            weechat_prefix ("error"), GUILE_PLUGIN_NAME,
                            "guile");
        }
    }

    return WEECHAT_RC_OK;
}
예제 #25
0
파일: write.c 프로젝트: barak/sigscheme
static void
write_obj(ScmObj port, ScmObj obj, enum ScmOutputType otype)
{
    ScmObj sym;

#if SCM_USE_SRFI38
    if (INTERESTINGP(obj)) {
        scm_intobj_t index = get_shared_index(obj);
        if (index > 0) {
            /* defined datum */
            scm_format(port, SCM_FMT_RAW_C, "#~ZU#", (size_t)index);
            return;
        }
        if (index < 0) {
            /* defining datum, with the new index negated */
            scm_format(port, SCM_FMT_RAW_C, "#~ZU=", (size_t)-index);
            /* Print it; the next time it'll be defined. */
        }
    }
#endif
    switch (SCM_TYPE(obj)) {
#if SCM_USE_INT
    case ScmInt:
        scm_format(port, SCM_FMT_RAW_C, "~MD", SCM_INT_VALUE(obj));
        break;
#endif
    case ScmCons:
        if (ERROBJP(obj))
            write_errobj(port, obj, otype);
        else
            write_list(port, obj, otype);
        break;
    case ScmSymbol:
        scm_port_puts(port, SCM_SYMBOL_NAME(obj));
        break;
#if SCM_USE_CHAR
    case ScmChar:
        write_char(port, obj, otype);
        break;
#endif
#if SCM_USE_STRING
    case ScmString:
        write_string(port, obj, otype);
        break;
#endif
    case ScmFunc:
        scm_port_puts(port, (SCM_SYNTAXP(obj)) ? "#<syntax " : "#<subr ");
        sym = scm_symbol_bound_to(obj);
        if (TRUEP(sym))
            scm_display(port, sym);
        else
            scm_format(port, SCM_FMT_RAW_C, "~P", (void *)obj);
        scm_port_put_char(port, '>');
        break;
#if SCM_USE_HYGIENIC_MACRO
    case ScmMacro:
        scm_port_puts(port, "#<macro ");
        write_obj(port, SCM_HMACRO_RULES(obj), otype);
        scm_port_puts(port, ">");
        break;
    case ScmFarsymbol:
        write_farsymbol(port, obj, otype);
        break;
    case ScmSubpat:
        if (SCM_SUBPAT_PVARP(obj)) {
#if SCM_DEBUG_MACRO
            scm_port_puts(port, "#<pvar ");
            write_obj(port, SCM_SUBPAT_OBJ(obj), otype);
            scm_format(port, SCM_FMT_RAW_C, " ~MD>",
                       SCM_SUBPAT_PVAR_INDEX(obj));
#else  /* not SCM_DEBUG_MACRO */
            write_obj(port, SCM_SUBPAT_OBJ(obj), otype);
#endif /* not SCM_DEBUG_MACRO */
        } else {
            SCM_ASSERT(SCM_SUBPAT_REPPATP(obj));
            write_obj(port, SCM_SUBPAT_REPPAT_PAT(obj), otype);
#if SCM_DEBUG_MACRO
            scm_format(port, SCM_FMT_RAW_C, " ..[~MD]..",
                       SCM_SUBPAT_REPPAT_PVCOUNT(obj));
#else
            scm_port_puts(port, " ...");
#endif
        }
        break;
#endif /* SCM_USE_HYGIENIC_MACRO */
    case ScmClosure:
#if SCM_USE_LEGACY_MACRO
        if (SYNTACTIC_CLOSUREP(obj))
            scm_port_puts(port, "#<syntactic closure ");
        else
#endif
            scm_port_puts(port, "#<closure ");
        write_obj(port, SCM_CLOSURE_EXP(obj), otype);
        scm_port_put_char(port, '>');
        break;
#if SCM_USE_VECTOR
    case ScmVector:
        write_vector(port, obj, otype);
        break;
#endif
    case ScmPort:
        write_port(port, obj, otype);
        break;
#if SCM_USE_CONTINUATION
    case ScmContinuation:
        scm_format(port, SCM_FMT_RAW_C, "#<continuation ~P>", (void *)obj);
        break;
#endif
    case ScmValuePacket:
        scm_port_puts(port, "#<values ");
        write_obj(port, SCM_VALUEPACKET_VALUES(obj), otype);
#if SCM_USE_VALUECONS
#if SCM_USE_STORAGE_FATTY
        /* SCM_VALUEPACKET_VALUES() changes the type destructively */
        SCM_ENTYPE(obj, ScmValuePacket);
#else /* SCM_USE_STORAGE_FATTY */
#error "valuecons is not supported on this storage implementation"
#endif /* SCM_USE_STORAGE_FATTY */
#endif /* SCM_USE_VALUECONS */
        scm_port_put_char(port, '>');
        break;
    case ScmConstant:
        write_constant(port, obj, otype);
        break;
#if SCM_USE_SSCM_EXTENSIONS
    case ScmCPointer:
        scm_format(port, SCM_FMT_RAW_C,
                   "#<c_pointer ~P>", SCM_C_POINTER_VALUE(obj));
        break;
    case ScmCFuncPointer:
        scm_format(port, SCM_FMT_RAW_C,
                   "#<c_func_pointer ~P>",
                   (void *)(uintptr_t)SCM_C_FUNCPOINTER_VALUE(obj));
        break;
#endif

    case ScmRational:
    case ScmReal:
    case ScmComplex:
    default:
        SCM_NOTREACHED;
    }
}
예제 #26
0
int
weechat_guile_command_cb (void *data, struct t_gui_buffer *buffer,
                          int argc, char **argv, char **argv_eol)
{
    char *ptr_name, *path_script;
    SCM value;

    /* make C compiler happy */
    (void) data;
    (void) buffer;

    if (argc == 1)
    {
        plugin_script_display_list (weechat_guile_plugin, guile_scripts,
                                    NULL, 0);
    }
    else if (argc == 2)
    {
        if (weechat_strcasecmp (argv[1], "list") == 0)
        {
            plugin_script_display_list (weechat_guile_plugin, guile_scripts,
                                        NULL, 0);
        }
        else if (weechat_strcasecmp (argv[1], "listfull") == 0)
        {
            plugin_script_display_list (weechat_guile_plugin, guile_scripts,
                                        NULL, 1);
        }
        else if (weechat_strcasecmp (argv[1], "autoload") == 0)
        {
            plugin_script_auto_load (weechat_guile_plugin, &weechat_guile_load_cb);
        }
        else if (weechat_strcasecmp (argv[1], "reload") == 0)
        {
            weechat_guile_unload_all ();
            plugin_script_auto_load (weechat_guile_plugin, &weechat_guile_load_cb);
        }
        else if (weechat_strcasecmp (argv[1], "unload") == 0)
        {
            weechat_guile_unload_all ();
        }
        else
            return WEECHAT_RC_ERROR;
    }
    else
    {
        if (weechat_strcasecmp (argv[1], "list") == 0)
        {
            plugin_script_display_list (weechat_guile_plugin, guile_scripts,
                                        argv_eol[2], 0);
        }
        else if (weechat_strcasecmp (argv[1], "listfull") == 0)
        {
            plugin_script_display_list (weechat_guile_plugin, guile_scripts,
                                        argv_eol[2], 1);
        }
        else if ((weechat_strcasecmp (argv[1], "load") == 0)
                 || (weechat_strcasecmp (argv[1], "reload") == 0)
                 || (weechat_strcasecmp (argv[1], "unload") == 0))
        {
            ptr_name = argv_eol[2];
            if (strncmp (ptr_name, "-q ", 3) == 0)
            {
                guile_quiet = 1;
                ptr_name += 3;
                while (ptr_name[0] == ' ')
                {
                    ptr_name++;
                }
            }
            if (weechat_strcasecmp (argv[1], "load") == 0)
            {
                /* load guile script */
                path_script = plugin_script_search_path (weechat_guile_plugin,
                                                         ptr_name);
                weechat_guile_load ((path_script) ? path_script : ptr_name);
                if (path_script)
                    free (path_script);
            }
            else if (weechat_strcasecmp (argv[1], "reload") == 0)
            {
                /* reload one guile script */
                weechat_guile_reload_name (ptr_name);
            }
            else if (weechat_strcasecmp (argv[1], "unload") == 0)
            {
                /* unload guile script */
                weechat_guile_unload_name (ptr_name);
            }
            guile_quiet = 0;
        }
        else if (weechat_strcasecmp (argv[1], "eval") == 0)
        {
            /* eval guile code */
            value = weechat_guile_catch (scm_c_eval_string, argv_eol[2]);
            if (!SCM_EQ_P (value, SCM_UNDEFINED)
                && !SCM_EQ_P (value, SCM_UNSPECIFIED))
            {
                scm_display (value, guile_port);
            }
            weechat_guile_stdout_flush ();
        }
        else
            return WEECHAT_RC_ERROR;
    }

    return WEECHAT_RC_OK;
}