File g_basic.c
**************

File header
===========

     <<g_basic.c : *>>=
     <<g_basic.c : copyright and license -- g_basic.c - copyright and license>>

     /* DO NOT read or edit this file ! Use ../noweb/g_basic.nw instead */

     <<g_basic.c : include directives -- g_basic.c - include directives>>

     <<g_basic.c : load() -- g_basic.c - load()>>

     <<g_basic.c : load_error_handler() -- g_basic.c - load_error_handler()>>

     <<g_basic.c : g_read_file() -- g_basic.c - g_read_file()>>

     <<g_basic.c : copyright and license>>=
     /* gEDA - GPL Electronic Design Automation
      * libgeda - gEDA's library
      * Copyright (C) 1998-2000 Ales V. Hvezda
      *
      * 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 of the License, 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, write to the Free Software
      * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111 USA
      */

     <<g_basic.c : include directives>>=
     #include <config.h>

     #include <stdio.h>
     #include <sys/stat.h>
     #ifdef HAVE_STDLIB_H
     #include <stdlib.h>
     #endif
     #ifdef HAVE_ASSERT_H
     #include <assert.h>
     #endif

     #ifdef HAVE_UNISTD_H
     #include <unistd.h>
     #endif

     #include <gtk/gtk.h>
     #include <libguile.h>

     #include "defines.h"
     #include "struct.h"
     #include "globals.h"
     #include "o_types.h"

     #include "../include/prototype.h"

     #ifdef HAVE_LIBDMALLOC
     #include <dmalloc.h>
     #endif

Function load()
===============

 -- Function: load data

     <<g_basic.c : load()>>=
     /* The following code was contributed by thi (with formating changes
      * by Ales) Thanks!  */
     /* Later updated by spe */

     /* This `load()' is modeled after libguile/load.c, load().
      * Additionally, the most recent form read is saved in case something
      * goes wrong. */

     static SCM most_recently_read_form = SCM_BOOL_F;

     static SCM
     load (void *data)
     {
             SCM load_port = (SCM)data;
             SCM form;
             int eof_found = 0;

             while (!eof_found) {
                     form = scm_read(load_port);
                     if (SCM_EOF_OBJECT_P(form)) {
                             eof_found = 1;
                     } else {
                             most_recently_read_form = form;
     #ifdef HAVE_SCM_EVAL_X_MODULE
                             scm_eval_x (form, scm_current_module() );
     #else
                             scm_eval_x (form);
     #endif
                     }
             }

             most_recently_read_form = SCM_BOOL_F;

             return SCM_BOOL_T;
     }

          Defines :
          load,
           -- g_basic.c - g_read_file().
          most_recently_read_form,
           -- g_basic.c - load_error_handler().

     }

Function load_error_handler()
=============================

 -- Function: load_error_handler data tag throw_args

     <<g_basic.c : load_error_handler()>>=
     static SCM
     load_error_handler(void *data, SCM tag, SCM throw_args)
     {
             SCM cur_out = scm_current_output_port ();
             SCM load_port = (SCM)data;
             SCM filename  = scm_port_filename(load_port);

             /*
              * If misc-error the column and line pointers points
              * to end of file. Not necessary to confuse user.
              */

         if (!scm_eq_p (tag, scm_str2symbol ("misc-error"))) {
                    scm_display(scm_makfrom0str("Error : "), cur_out);
                     scm_display(tag, cur_out);

                     scm_display(scm_makfrom0str(" [C:"), cur_out);
                     scm_display(scm_port_column(load_port), cur_out );
                     scm_display(scm_makfrom0str(" L:"), cur_out);
                     scm_display(scm_port_line(load_port), cur_out );
                     scm_display(scm_makfrom0str("]"), cur_out);
             } else {
                     scm_display(scm_makfrom0str("Probably parenthesis mismatch"),
                                 cur_out);

             }

             scm_display(scm_makfrom0str(" in "), cur_out);
             scm_display(filename, cur_out);
             scm_newline(cur_out);

             if (most_recently_read_form != SCM_BOOL_F) {
                     scm_display(scm_makfrom0str ("Most recently read form: "),
                                 cur_out);
                     scm_display(most_recently_read_form, cur_out);
                     scm_newline(cur_out);
             }

             return SCM_BOOL_F;
     }

          Defines :
          load_error_handler,
           -- g_basic.c - g_read_file().

          Uses :
          most_recently_read_form,  -- g_basic.c - load().

     }

Function g_read_file()
======================

 -- Function: g_read_file filename

     <<g_basic.c : g_read_file()>>=
     int
     g_read_file(const gchar *filename)
     {
             SCM port;
             SCM eval_result = SCM_BOOL_F;

             if (filename == NULL) {
                     return(-1);
             }

             if (access(filename, R_OK) != 0) {
                     s_log_message("Could not find [%s] for interpretion\n",
                                   filename);
                     return(-1);
             }

             port = scm_open_file(scm_makfrom0str(filename), scm_makfrom0str("r"));

             eval_result = scm_internal_catch (SCM_BOOL_T,
                                           (scm_t_catch_body)load,
                                           (void*)port,
                                           (scm_t_catch_handler)load_error_handler,
                                           (void*)port);

             scm_close_port(port);

             return (eval_result == SCM_BOOL_T);
     }

          Defines :
          .

          Uses :
          load,  -- g_basic.c - load().
          load_error_handler,  -- g_basic.c - load_error_handler().

     }