scheme_page.c

Go to the documentation of this file.

/* gEDA - GPL Electronic Design Automation
 * libgeda - gEDA's library - Scheme API
 * Copyright (C) 2010 Peter Brett <peter@peter-b.co.uk>
 *
 * 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
 */

#include <config.h>

#include "libgeda_priv.h"
#include "libgedaguile_priv.h"

SCM_SYMBOL (edascm_string_format_sym , "string-format");

SCM_DEFINE (active_pages, "%active-pages", 0, 0, 0,
            (), "Retrieve a list of currently-opened pages")
{
  TOPLEVEL *toplevel = edascm_c_current_toplevel ();
  SCM lst = SCM_EOL;
  SCM rlst;
  GList *page_list = geda_list_get_glist (toplevel->pages);

  while (page_list != NULL) {
    lst = scm_cons (edascm_from_page (page_list->data), lst);
    page_list = g_list_next (page_list);
  }

  rlst = scm_reverse (lst);
  scm_remember_upto_here_1 (lst);
  return rlst;
}

SCM_DEFINE (new_page, "%new-page", 1, 0, 0,
            (SCM filename_s), "Create a new page")
{
  TOPLEVEL *toplevel = edascm_c_current_toplevel ();
  char *filename;
  PAGE *page;

  /* Ensure that the argument is a string */
  SCM_ASSERT (scm_is_string (filename_s), filename_s,
              SCM_ARG1, s_new_page);

  filename = scm_to_utf8_string (filename_s);
  page = s_page_new (toplevel, filename);
  g_free (filename);

  return edascm_from_page (page);
}

SCM_DEFINE (close_page_x, "%close-page!", 1, 0, 0,
            (SCM page_s), "Close a page.")
{
  /* Ensure that the argument is a page smob */
  SCM_ASSERT (EDASCM_PAGEP (page_s), page_s,
              SCM_ARG1, s_close_page_x);

  TOPLEVEL *toplevel = edascm_c_current_toplevel ();
  PAGE *page = edascm_to_page (page_s);

  s_page_delete (toplevel, page);

  return SCM_UNDEFINED;
}

SCM_DEFINE (page_filename, "%page-filename", 1, 0, 0,
            (SCM page_s), "Get a page's associated filename")
{
  PAGE *page;

  /* Ensure that the argument is a page smob */
  SCM_ASSERT (EDASCM_PAGEP (page_s), page_s,
              SCM_ARG1, s_page_filename);


  page = edascm_to_page (page_s);
  return scm_from_utf8_string (page->page_filename);
}

SCM_DEFINE (set_page_filename_x, "%set-page-filename!", 2, 0, 0,
            (SCM page_s, SCM filename_s), "Set a page's associated filename")
{
  SCM_ASSERT (EDASCM_PAGEP (page_s), page_s,
              SCM_ARG1, s_set_page_filename_x);
  SCM_ASSERT (scm_is_string (filename_s), filename_s,
              SCM_ARG2, s_set_page_filename_x);

  PAGE *page = edascm_to_page (page_s);
  char *new_fn = scm_to_utf8_string (filename_s);
  if (page->page_filename != NULL) {
    g_free (page->page_filename);
  }
  page->page_filename = g_strdup (new_fn);
  free (new_fn);

  return page_s;
}

SCM_DEFINE (page_contents, "%page-contents", 1, 0, 0,
            (SCM page_s), "Get a page's contents.")
{
  PAGE *page;

  /* Ensure that the argument is a page smob */
  SCM_ASSERT (EDASCM_PAGEP (page_s), page_s,
              SCM_ARG1, s_page_contents);

  page = edascm_to_page (page_s);

  return edascm_from_object_glist (s_page_objects (page));
}

SCM_DEFINE (object_page, "%object-page", 1, 0, 0,
            (SCM obj_s), "Get the page that an object smob belongs to")
{
  SCM_ASSERT (EDASCM_OBJECTP (obj_s), obj_s,
              SCM_ARG1, s_object_page);

  PAGE *page = o_get_page (edascm_c_current_toplevel (),
                           edascm_to_object (obj_s));

  if (page != NULL) {
    return edascm_from_page (page);
  } else {
    return SCM_BOOL_F;
  }
}


SCM_DEFINE (page_append_x, "%page-append!", 2, 0, 0,
            (SCM page_s, SCM obj_s), "Add an object to a page.")
{
  /* Ensure that the arguments have the correct types. */
  SCM_ASSERT (EDASCM_PAGEP (page_s), page_s,
              SCM_ARG1, s_page_append_x);
  SCM_ASSERT (EDASCM_OBJECTP (obj_s), obj_s,
              SCM_ARG2, s_page_append_x);

  PAGE *page = edascm_to_page (page_s);
  OBJECT *obj = edascm_to_object (obj_s);
  TOPLEVEL *toplevel = edascm_c_current_toplevel ();

  /* Check that the object isn't already attached to something. */
  PAGE *curr_page = o_get_page (toplevel, obj);
  if (((curr_page != NULL) && (curr_page != page))
      || (obj->parent != NULL)) {
    scm_error (edascm_object_state_sym, s_page_append_x,
               _("Object ~A is already attached to something"),
               scm_list_1 (obj_s), SCM_EOL);
  }

  if (curr_page == page) return obj_s;

  /* Object cleanup now managed by C code. */
  edascm_c_set_gc (obj_s, 0);
  o_emit_pre_change_notify (toplevel, obj);
  s_page_append (edascm_c_current_toplevel (), page, obj);
  o_emit_change_notify (toplevel, obj);
  page->CHANGED = 1; /* Ugh. */

  return page_s;
}

SCM_DEFINE (page_remove_x, "%page-remove!", 2, 0, 0,
            (SCM page_s, SCM obj_s), "Remove an object from a page.")
{
  /* Ensure that the arguments have the correct types. */
  SCM_ASSERT (EDASCM_PAGEP (page_s), page_s,
              SCM_ARG1, s_page_remove_x);
  SCM_ASSERT (EDASCM_OBJECTP (obj_s), obj_s,
              SCM_ARG2, s_page_remove_x);

  PAGE *page = edascm_to_page (page_s);
  OBJECT *obj = edascm_to_object (obj_s);
  TOPLEVEL *toplevel = edascm_c_current_toplevel ();

  /* Check that the object is not attached to something else. */
  PAGE *curr_page = o_get_page (toplevel, obj);
  if ((curr_page != NULL && curr_page != page)
      || (obj->parent != NULL)) {
    scm_error (edascm_object_state_sym, s_page_remove_x,
               _("Object ~A is attached to a complex or different page"),
               scm_list_1 (obj_s), SCM_EOL);
  }

  /* Check that object is not attached as an attribute. */
  if (obj->attached_to != NULL) {
    scm_error (edascm_object_state_sym, s_page_remove_x,
               _("Object ~A is attached as an attribute"),
               scm_list_1 (obj_s), SCM_EOL);
  }

  /* Check that object doesn't have attributes. */
  if (obj->attribs != NULL) {
    scm_error (edascm_object_state_sym, s_page_remove_x,
               _("Object ~A has attributes"),
               scm_list_1 (obj_s), SCM_EOL);
  }

  if (curr_page == NULL) return obj_s;

  o_emit_pre_change_notify (toplevel, obj);
  s_page_remove (toplevel, page, obj);
  page->CHANGED = 1; /* Ugh. */
  /* If the object is currently selected, unselect it. */
  o_selection_remove (toplevel, page->selection_list, obj);
  o_emit_change_notify (toplevel, obj);

  /* Object cleanup now managed by Guile. */
  edascm_c_set_gc (obj_s, 1);
  return page_s;
}

SCM_DEFINE (page_dirty, "%page-dirty?", 1, 0, 0,
            (SCM page_s), "Check whether a page has been flagged as changed.")
{
  /* Ensure that the argument is a page smob */
  SCM_ASSERT (EDASCM_PAGEP (page_s), page_s,
              SCM_ARG1, s_page_dirty);

  PAGE *page = edascm_to_page (page_s);
  return page->CHANGED ? SCM_BOOL_T : SCM_BOOL_F;
}

SCM_DEFINE (set_page_dirty_x, "%set-page-dirty!", 2, 0, 0,
            (SCM page_s, SCM flag_s),
            "Set whether a page is flagged as changed.")
{
  /* Ensure that the argument is a page smob */
  SCM_ASSERT (EDASCM_PAGEP (page_s), page_s,
              SCM_ARG1, s_set_page_dirty_x);

  PAGE *page = edascm_to_page (page_s);
  page->CHANGED = scm_is_true (flag_s);
  return page_s;
}

SCM_DEFINE (page_to_string, "%page->string", 1, 0, 0,
            (SCM page_s),
            "Create a string representation of a page.")
{
  /* Ensure that the argument is a page smob */
  SCM_ASSERT (EDASCM_PAGEP (page_s), page_s,
              SCM_ARG1, s_page_to_string);

  PAGE *page = edascm_to_page (page_s);
  TOPLEVEL *toplevel = edascm_c_current_toplevel ();

  gchar *buf = o_save_buffer (toplevel, s_page_objects (page));
  scm_dynwind_begin (0);
  scm_dynwind_unwind_handler (g_free, buf, SCM_F_WIND_EXPLICITLY);
  SCM result = scm_from_utf8_string (buf);
  scm_dynwind_end ();
  return result;
}

SCM_DEFINE (string_to_page, "%string->page", 2, 0, 0,
            (SCM filename_s, SCM str_s),
            "Create a new page from a string.")
{
  /* Ensure that the arguments are strings */
  SCM_ASSERT (scm_is_string (filename_s), filename_s,
              SCM_ARG1, s_string_to_page);
  SCM_ASSERT (scm_is_string (str_s), str_s,
              SCM_ARG2, s_string_to_page);

  TOPLEVEL *toplevel = edascm_c_current_toplevel ();
  char *filename = scm_to_utf8_string (filename_s);
  PAGE *page = s_page_new (toplevel, filename);
  free (filename);

  size_t len;
  GError * err = NULL;
  char *str = scm_to_utf8_stringn (str_s, &len);
  GList *objects = o_read_buffer (toplevel, NULL, str, len,
                                  page->page_filename, &err);
  free (str);

  if (err) {
      SCM error_message = scm_from_utf8_string (err->message);

      g_error_free(err);
      scm_error (edascm_string_format_sym, s_string_to_page,
                 _("Parse error: ~s"), scm_list_1 (error_message), SCM_EOL);
  }

  s_page_append_list (toplevel, page, objects);

  return edascm_from_page (page);
}

static void
init_module_geda_core_page ()
{
  /* Register the functions */
  #include "scheme_page.x"

  /* Add them to the module's public definitions. */

  scm_c_export (s_active_pages, s_new_page, s_close_page_x,
                s_page_filename, s_set_page_filename_x, s_page_contents,
                s_object_page, s_page_append_x, s_page_remove_x, s_page_dirty,
                s_set_page_dirty_x, s_page_to_string, s_string_to_page, NULL);
}

void
edascm_init_page ()
{
  /* Define the (geda core page) module */
  scm_c_define_module ("geda core page",
                       init_module_geda_core_page,
                       NULL);
}