Re[1]: What that come from?

["Eric M. Ludlam" <zappo@ultranet.com>]

>>> Greg Badros <gjb@cs.washington.edu> seems to think that:
>"Eric M. Ludlam" <zappo@ultranet.com> writes:
>
>>   I'm working on an app using gtk as the front end, and guile as the
>>   scripting language.  The C application provides guile bindings for
>>   various graphical features used in making maps and postgres data forms.
>>   
>>   Since C defines a simple API, the actual application is in scheme.
>>   When the C code catches an error in a callback (written in scheme) I
>>   was able to figure out how to display the stack trace in a dialog
>>   box.  This was immensely useful.  I'd like to add a button on this
>>   dialog that says "go fix it", or something roughly equivalent which
>>   would have the immediate benefit of also re-loading that file, or
>>   file section without having to restart.  (I have no command line to
>>   re-enter stuff in... yet)
>
>Is your code available somewhere... I'd love to see what you've done as
>it sounds like it'd be useful for Scwm, the Scheme Configurable Window Manager
>(http://vicarious-existence.mit.edu/scwm/).
  [ ... ]

Thanks for those pointers.  I'll examine them in more detail.  My app
is still attempting to hatch, but I've attached the relevent code
below.  The EXPORT keyword is for my header generator.  dialog_error
just puts a string in an error dialog.  cac is the name of my
application.  It should be pretty generic otherwise.

The various functions are used for callback strings under GTK, or for
applying lambda expressions under more sophisticated conditions.

Hope this is useful.
Eric

/* scheme.c - Handy scheme files friendly with CAC
 *
 * Copyright (C) 1999 Eric Ludlam
 *
 * 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
 * the Free Software Foundation; either version 2, or (at your option)
 * any later version.
 * 
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 * 
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, you can either send email to this
 * program's author (see below) or write to:
 * 
 *              The Free Software Foundation, Inc.
 *              675 Mass Ave.
 *              Cambridge, MA 02139, USA. 
 * 
 * Please send bug reports, etc. to zappo@gnu.org
 * 
 * Description:
 *   Generic evals and applies.
 */

#include "cac.h"
#include "scheme.h"
#include "stock-dialog.h"

#include <libguile/fluids.h>

static SCM catcher(void *data, SCM tag, SCM throw_args)
{
  SCM tmp;
  SCM port = scm_mkstrport(SCM_INUM0, 
			   scm_make_string(SCM_MAKINUM(200), SCM_UNDEFINED),
			   SCM_OPN | SCM_WRTNG,
			   "error-handler");
  SCM answer;
  SCM the_stack;

  /* Throw args seem to be: ( FN FORMAT ARGS #f )
   *
   * Write all the crap into a SCM string.
   */
  scm_puts("Function: ", port);
  scm_display(gh_car(throw_args), port);
  scm_puts(", ", port);
  scm_display(tag, port);
  scm_newline(port);
  tmp = gh_cadr(throw_args);
  if(gh_string_p(tmp))
    {
      scm_puts("Error: ", port);
      scm_display_error_message(tmp, gh_caddr(throw_args), port);
    }
  scm_puts("Other Data: ", port);
  scm_display(gh_car(gh_cdddr(throw_args)), port);
  scm_newline(port);
  scm_newline(port);

  the_stack = scm_fluid_ref(SCM_CDR(scm_the_last_stack_fluid));

  if(SCM_NFALSEP(the_stack))
    {
      scm_display_backtrace(the_stack, port, SCM_UNDEFINED, SCM_UNDEFINED);
    }

  SCM_DEFER_INTS;
  answer = scm_makfromstr (SCM_CHARS (SCM_CDR (SCM_STREAM (port))),
			   SCM_INUM (SCM_CAR (SCM_STREAM (port))),
			   0);
  /* Display this error in a dialog box! */
  dialog_error(answer);

  SCM_ALLOW_INTS;

  return gh_int2scm(1);
}

EXPORT
void cs_eval_file(char *file)
{
  scm_internal_stack_catch (SCM_BOOL_T, (scm_catch_body_t) gh_eval_file, file,
			    (scm_catch_handler_t) catcher, file);
}

EXPORT
void cs_eval_str(char *str)
{
  scm_internal_stack_catch (SCM_BOOL_T, (scm_catch_body_t) gh_eval_str, str,
			    (scm_catch_handler_t) catcher, str);
}

static void cs_eval_helper(SCM *arglist)
{
  SCM a = *arglist;

  scm_eval(a);
}

EXPORT
void cs_eval_scm(SCM scm)
{
#if 0
  gh_display(scm);
  gh_newline();
#endif

  scm_internal_stack_catch (SCM_BOOL_T, (scm_catch_body_t) cs_eval_helper,
			    &scm, (scm_catch_handler_t) catcher, &scm);
}

static SCM crossproc;

static void cs_apply_helper(SCM *arglist)
{
  SCM a = *arglist;

  gh_apply(crossproc, a);
}

EXPORT
void cs_apply(SCM proc, SCM arglist)
{
  crossproc = proc;

  scm_internal_stack_catch (SCM_BOOL_T, (scm_catch_body_t) cs_apply_helper,
			    &arglist, (scm_catch_handler_t) catcher, &arglist);
}

-- 
|\/\/\___/\/\/|  Eric Ludlam                 zappo@gnu.org; zappo@ultranet.com
\____ o o ____/  Homepage:                      http://www.ultranet.com/~zappo
     )   (       Trebuchets:    http://www.ultranet.com/~zappo/trebuchet.shtml
    ( * * )      GNU:				            http://www.gnu.org
     \___/        "We wern't last, Woo Hoo!" - Team Juggernaut @ Punkin Chunk