libgeda/src/scheme_page.c

   1 /* gEDA - GPL Electronic Design Automation
   2  * libgeda - gEDA's library - Scheme API
   3  * Copyright (C) 2010 Peter Brett <peter@peter-b.co.uk>
   4  *
   5  * This program is free software; you can redistribute it and/or modify
   6  * it under the terms of the GNU General Public License as published by
   7  * the Free Software Foundation; either version 2 of the License, or
   8  * (at your option) any later version.
   9  *
  10  * This program is distributed in the hope that it will be useful,
  11  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  12  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13  * GNU General Public License for more details.
  14  *
  15  * You should have received a copy of the GNU General Public License
  16  * along with this program; if not, write to the Free Software
  17  * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111 USA
  18  */
  19
  20 /*!
  21  * \file scheme_page.c
  22  * \brief Scheme API page manipulation procedures.
  23  */
  24
  25 #include <config.h>
  26
  27 #include "libgeda_priv.h"
  28 #include "libgedaguile_priv.h"
  29
  30 /*! \brief Get a of open pages.
  31  * \par Function Description
  32  * Retrieves a Scheme list of currently-opened pages.
  33  *
  34  * \note Scheme API: Implements the %active-pages procedure of the
  35  * (geda core page) module.
  36  *
  37  * \return a Scheme list of #PAGE smobs.
  38  */
  39 SCM_DEFINE (active_pages, "%active-pages", 0, 0, 0,
  40             (), "Retrieve a list of currently-opened pages")
  41 {
  42   TOPLEVEL *toplevel = edascm_c_current_toplevel ();
  43   SCM lst = SCM_EOL;
  44   SCM rlst;
  45   GList *page_list = geda_list_get_glist (toplevel->pages);
  46
  47   while (page_list != NULL) {
  48     lst = scm_cons (edascm_from_page (page_list->data), lst);
  49     page_list = g_list_next (page_list);
  50   }
  51
  52   rlst = scm_reverse (lst);
  53   scm_remember_upto_here_1 (lst);
  54   return rlst;
  55 }
  56
  57 /*! \brief Create a new page.
  58  * \par Function Description
  59  * Creates and initialises a new #PAGE structure associated with the
  60  * filename \a filename_s. Note that this does not check that a file
  61  * exists with that name, or attempt to load any data from it.
  62  *
  63  * \note Scheme API: Implements the %new-page procedure of the (geda
  64  * core page) module.
  65  *
  66  * \return a newly-created #PAGE smob.
  67  */
  68 SCM_DEFINE (new_page, "%new-page", 1, 0, 0,
  69             (SCM filename_s), "Create a new page")
  70 {
  71   TOPLEVEL *toplevel = edascm_c_current_toplevel ();
  72   char *filename;
  73   PAGE *page;
  74
  75   /* Ensure that the argument is a string */
  76   SCM_ASSERT (scm_is_string (filename_s), filename_s,
  77               SCM_ARG1, s_new_page);
  78
  79   filename = scm_to_utf8_string (filename_s);
  80   page = s_page_new (toplevel, filename);
  81   g_free (filename);
  82
  83   return edascm_from_page (page);
  84 }
  85
  86 /*! \brief Close a page
  87  * \par Function Description
  88
  89  * Destroys the #PAGE structure \a page_s, freeing all of its
  90  * resources.  Attempting to use \a page_s after calling this function
  91  * will cause an error.
  92  *
  93  * \note Scheme API: Implements the %close-page procedure of the (geda
  94  * core page) module.
  95  *
  96  * \param page_s The page to close.
  97  * \return SCM_UNDEFINED.
  98  */
  99 SCM_DEFINE (close_page_x, "%close-page!", 1, 0, 0,
 100             (SCM page_s), "Close a page.")
 101 {
 102   /* Ensure that the argument is a page smob */
 103   SCM_ASSERT (EDASCM_PAGEP (page_s), page_s,
 104               SCM_ARG1, s_close_page_x);
 105
 106   TOPLEVEL *toplevel = edascm_c_current_toplevel ();
 107   PAGE *page = edascm_to_page (page_s);
 108
 109   s_page_delete (toplevel, page);
 110
 111   return SCM_UNDEFINED;
 112 }
 113
 114 /*! \brief Get the filename associated with a page.
 115  * \par Function Description
 116  * Retrieves the filename associated with the #PAGE smob \a page_s.
 117  *
 118  * \note Scheme API: Implements the %page-filename procedure of the
 119  * (geda core page) module.
 120  *
 121  * \return a Scheme string containing the page filename.
 122  */
 123 SCM_DEFINE (page_filename, "%page-filename", 1, 0, 0,
 124             (SCM page_s), "Get a page's associated filename")
 125 {
 126   PAGE *page;
 127
 128   /* Ensure that the argument is a page smob */
 129   SCM_ASSERT (EDASCM_PAGEP (page_s), page_s,
 130               SCM_ARG1, s_page_filename);
 131
 132
 133   page = edascm_to_page (page_s);
 134   return scm_from_utf8_string (page->page_filename);
 135 }
 136
 137 /*! \brief Change the filename associated with a page.
 138  * \par Function Description
 139  * Sets the filename associated with the #PAGE smob \a page_s.
 140  *
 141  * \note Scheme API: Implements the %set-page-filename! procedure of
 142  * the (geda core page) module.
 143  *
 144  * \param page_s page to set filename for.
 145  * \param filename_s new filename for \a page.
 146  * \return \a page.
 147  */
 148 SCM_DEFINE (set_page_filename_x, "%set-page-filename!", 2, 0, 0,
 149             (SCM page_s, SCM filename_s), "Set a page's associated filename")
 150 {
 151   SCM_ASSERT (EDASCM_PAGEP (page_s), page_s,
 152               SCM_ARG1, s_set_page_filename_x);
 153   SCM_ASSERT (scm_is_string (filename_s), filename_s,
 154               SCM_ARG2, s_set_page_filename_x);
 155
 156   PAGE *page = edascm_to_page (page_s);
 157   char *new_fn = scm_to_utf8_string (filename_s);
 158   if (page->page_filename != NULL) {
 159     g_free (page->page_filename);
 160   }
 161   page->page_filename = g_strdup (new_fn);
 162   free (new_fn);
 163
 164   return page_s;
 165 }
 166
 167 /*! \brief Get a list of objects in a page.
 168  * \par Function Description
 169  * Retrieves the contents of a the #PAGE smob \a page_s as a Scheme
 170  * list of #OBJECT smobs.
 171  *
 172  * \note Scheme API: Implements the %page-contents procedure of the
 173  * (geda core page) module.
 174  *
 175  * \return a list of #OBJECT smobs.
 176  */
 177 SCM_DEFINE (page_contents, "%page-contents", 1, 0, 0,
 178             (SCM page_s), "Get a page's contents.")
 179 {
 180   PAGE *page;
 181
 182   /* Ensure that the argument is a page smob */
 183   SCM_ASSERT (EDASCM_PAGEP (page_s), page_s,
 184               SCM_ARG1, s_page_contents);
 185
 186   page = edascm_to_page (page_s);
 187
 188   return edascm_from_object_glist (s_page_objects (page));
 189 }
 190
 191 /*! \brief Get the page an object belongs to.
 192  * \par Function Description
 193  * Returns a smob for the #PAGE that \a obj_s belongs to.  If \a obj_s
 194  * does not belong to a #PAGE, returns SCM_BOOL_F.
 195  *
 196  * \note Scheme API: Implements the %object-page procedure in the
 197  * (geda core page) module.
 198  *
 199  * \param [in] obj_s an #OBJECT smob.
 200  * \return a #PAGE smob or SCM_BOOL_F.
 201  */
 202 SCM_DEFINE (object_page, "%object-page", 1, 0, 0,
 203             (SCM obj_s), "Get the page that an object smob belongs to")
 204 {
 205   SCM_ASSERT (EDASCM_OBJECTP (obj_s), obj_s,
 206               SCM_ARG1, s_object_page);
 207
 208   PAGE *page = o_get_page (edascm_c_current_toplevel (),
 209                            edascm_to_object (obj_s));
 210
 211   if (page != NULL) {
 212     return edascm_from_page (page);
 213   } else {
 214     return SCM_BOOL_F;
 215   }
 216 }
 217
 218
 219 /*! \brief Add an object to a page.
 220  * \par Function Description
 221  * Adds \a obj_s to \a page_s.  If \a obj_s is already attached to a
 222  * #PAGE or to a complex #OBJECT, throws a Scheme error.
 223  *
 224  * \note Scheme API: Implements the %page-append! procedure of the
 225  * (geda core page) module.
 226  *
 227  * \return \a page_s.
 228  */
 229 SCM_DEFINE (page_append_x, "%page-append!", 2, 0, 0,
 230             (SCM page_s, SCM obj_s), "Add an object to a page.")
 231 {
 232   /* Ensure that the arguments have the correct types. */
 233   SCM_ASSERT (EDASCM_PAGEP (page_s), page_s,
 234               SCM_ARG1, s_page_append_x);
 235   SCM_ASSERT (EDASCM_OBJECTP (obj_s), obj_s,
 236               SCM_ARG2, s_page_append_x);
 237
 238   PAGE *page = edascm_to_page (page_s);
 239   OBJECT *obj = edascm_to_object (obj_s);
 240   TOPLEVEL *toplevel = edascm_c_current_toplevel ();
 241
 242   /* Check that the object isn't already attached to something. */
 243   PAGE *curr_page = o_get_page (toplevel, obj);
 244   if (((curr_page != NULL) && (curr_page != page))
 245       || (obj->parent != NULL)) {
 246     scm_error (edascm_object_state_sym, s_page_append_x,
 247                _("Object ~A is already attached to something"),
 248                scm_list_1 (obj_s), SCM_EOL);
 249   }
 250
 251   if (curr_page == page) return obj_s;
 252
 253   /* Object cleanup now managed by C code. */
 254   edascm_c_set_gc (obj_s, 0);
 255   o_emit_pre_change_notify (toplevel, obj);
 256   s_page_append (edascm_c_current_toplevel (), page, obj);
 257   o_emit_change_notify (toplevel, obj);
 258   page->CHANGED = 1; /* Ugh. */
 259
 260   return page_s;
 261 }
 262
 263 /*! \brief Remove an object from a page.
 264  * \par Function Description
 265  * Removes \a obj_s from \a page_s.  If \a obj_s is attached to a
 266  * #PAGE other than \a page_s, or to a complex #OBJECT, throws a
 267  * Scheme error. If \a obj_s is not attached to a page, does nothing.
 268  *
 269  * \note Scheme API: Implements the %page-remove! procedure of the
 270  * (geda core page) module.
 271  *
 272  * \return \a page_s.
 273  */
 274 SCM_DEFINE (page_remove_x, "%page-remove!", 2, 0, 0,
 275             (SCM page_s, SCM obj_s), "Remove an object from a page.")
 276 {
 277   /* Ensure that the arguments have the correct types. */
 278   SCM_ASSERT (EDASCM_PAGEP (page_s), page_s,
 279               SCM_ARG1, s_page_remove_x);
 280   SCM_ASSERT (EDASCM_OBJECTP (obj_s), obj_s,
 281               SCM_ARG2, s_page_remove_x);
 282
 283   PAGE *page = edascm_to_page (page_s);
 284   OBJECT *obj = edascm_to_object (obj_s);
 285   TOPLEVEL *toplevel = edascm_c_current_toplevel ();
 286
 287   /* Check that the object is not attached to something else. */
 288   PAGE *curr_page = o_get_page (toplevel, obj);
 289   if ((curr_page != NULL && curr_page != page)
 290       || (obj->parent != NULL)) {
 291     scm_error (edascm_object_state_sym, s_page_remove_x,
 292                _("Object ~A is attached to a complex or different page"),
 293                scm_list_1 (obj_s), SCM_EOL);
 294   }
 295
 296   /* Check that object is not attached as an attribute. */
 297   if (obj->attached_to != NULL) {
 298     scm_error (edascm_object_state_sym, s_page_remove_x,
 299                _("Object ~A is attached as an attribute"),
 300                scm_list_1 (obj_s), SCM_EOL);
 301   }
 302
 303   /* Check that object doesn't have attributes. */
 304   if (obj->attribs != NULL) {
 305     scm_error (edascm_object_state_sym, s_page_remove_x,
 306                _("Object ~A has attributes"),
 307                scm_list_1 (obj_s), SCM_EOL);
 308   }
 309
 310   if (curr_page == NULL) return obj_s;
 311
 312   o_emit_pre_change_notify (toplevel, obj);
 313   s_page_remove (toplevel, page, obj);
 314   page->CHANGED = 1; /* Ugh. */
 315   /* If the object is currently selected, unselect it. */
 316   o_selection_remove (toplevel, page->selection_list, obj);
 317   o_emit_change_notify (toplevel, obj);
 318
 319   /* Object cleanup now managed by Guile. */
 320   edascm_c_set_gc (obj_s, 1);
 321   return page_s;
 322 }
 323
 324 /*! \brief Check whether a page has been flagged as changed.
 325  * \par Function Description
 326  * Returns SCM_BOOL_T if \a page_s has been flagged as having been
 327  * modified.
 328  *
 329  * \note Scheme API: Implements the %page-dirty? procedure of the
 330  * (geda core page) module.
 331  *
 332  * \param page_s page to inspect.
 333  * \return SCM_BOOL_T if page is dirtied, otherwise SCM_BOOL_F.
 334  */
 335 SCM_DEFINE (page_dirty, "%page-dirty?", 1, 0, 0,
 336             (SCM page_s), "Check whether a page has been flagged as changed.")
 337 {
 338   /* Ensure that the argument is a page smob */
 339   SCM_ASSERT (EDASCM_PAGEP (page_s), page_s,
 340               SCM_ARG1, s_page_dirty);
 341
 342   PAGE *page = edascm_to_page (page_s);
 343   return page->CHANGED ? SCM_BOOL_T : SCM_BOOL_F;
 344 }
 345
 346 /*! \brief Set a page's changed flag.
 347  * \par Function Description
 348  * If \a flag_s is true, flag \a page_s as having been modified.
 349  * Otherwise, clears the change flag.
 350  *
 351  * \note Scheme API: Implements the %set-page-dirty! procedure of the
 352  * (geda core page) module.
 353  *
 354  * \param page_s page to modify.
 355  * \param flag_s new flag setting.
 356  * \return \a page_s
 357  */
 358 SCM_DEFINE (set_page_dirty_x, "%set-page-dirty!", 2, 0, 0,
 359             (SCM page_s, SCM flag_s),
 360             "Set whether a page is flagged as changed.")
 361 {
 362   /* Ensure that the argument is a page smob */
 363   SCM_ASSERT (EDASCM_PAGEP (page_s), page_s,
 364               SCM_ARG1, s_set_page_dirty_x);
 365
 366   PAGE *page = edascm_to_page (page_s);
 367   page->CHANGED = scm_is_true (flag_s);
 368   return page_s;
 369 }
 370
 371 /*! \brief Create a string representation of a page.
 372  * \par Function Description
 373  * Returns a string representation of the contents of \a page_s.
 374  *
 375  * \note Scheme API: Implements the %page->string procedure of the
 376  * (geda core page) module.
 377  *
 378  * \param page_s page to convert to a string.
 379  * \return a string representation of \a page_s.
 380  */
 381 SCM_DEFINE (page_to_string, "%page->string", 1, 0, 0,
 382             (SCM page_s),
 383             "Create a string representation of a page.")
 384 {
 385   /* Ensure that the argument is a page smob */
 386   SCM_ASSERT (EDASCM_PAGEP (page_s), page_s,
 387               SCM_ARG1, s_page_to_string);
 388
 389   PAGE *page = edascm_to_page (page_s);
 390   TOPLEVEL *toplevel = edascm_c_current_toplevel ();
 391
 392   gchar *buf = o_save_buffer (toplevel, s_page_objects (page));
 393   scm_dynwind_begin (0);
 394   scm_dynwind_unwind_handler (g_free, buf, SCM_F_WIND_EXPLICITLY);
 395   SCM result = scm_from_utf8_string (buf);
 396   scm_dynwind_end ();
 397   return result;
 398 }
 399
 400 /*! \brief Create a page from a string representation.
 401  * \par Function Description
 402  * Returns a page with filename \a filename_s created by parsing \a
 403  * str_s.
 404  *
 405  * \note Scheme API: Implements the %string->page procedure of the
 406  * (geda core page) module.
 407  *
 408  * \bug Should throw an error if \a str_s contains invalid gEDA file
 409  * format syntax.  Requires support in gEDA file parser.
 410  *
 411  * \param filename_s Filename for new page.
 412  * \param str_s      String to parse to create page.
 413  * \return a new page created by parsing \a str_s.
 414  */
 415 SCM_DEFINE (string_to_page, "%string->page", 2, 0, 0,
 416             (SCM filename_s, SCM str_s),
 417             "Create a new page from a string.")
 418 {
 419   /* Ensure that the arguments are strings */
 420   SCM_ASSERT (scm_is_string (filename_s), filename_s,
 421               SCM_ARG1, s_string_to_page);
 422   SCM_ASSERT (scm_is_string (str_s), str_s,
 423               SCM_ARG2, s_string_to_page);
 424
 425   TOPLEVEL *toplevel = edascm_c_current_toplevel ();
 426   char *filename = scm_to_utf8_string (filename_s);
 427   PAGE *page = s_page_new (toplevel, filename);
 428   free (filename);
 429
 430   size_t len;
 431   char *str = scm_to_utf8_stringn (str_s, &len);
 432   GList *objects = o_read_buffer (toplevel, NULL, str, len,
 433                                   page->page_filename);
 434   free (str);
 435
 436   s_page_append_list (toplevel, page, objects);
 437
 438   return edascm_from_page (page);
 439 }
 440
 441 /*!
 442  * \brief Create the (geda core page) Scheme module.
 443  * \par Function Description
 444  * Defines procedures in the (geda core page) module. The module can
 445  * be accessed using (use-modules (geda core page)).
 446  */
 447 static void
 448 init_module_geda_core_page ()
 449 {
 450   /* Register the functions */
 451   #include "scheme_page.x"
 452
 453   /* Add them to the module's public definitions. */
 454
 455   scm_c_export (s_active_pages, s_new_page, s_close_page_x,
 456                 s_page_filename, s_set_page_filename_x, s_page_contents,
 457                 s_object_page, s_page_append_x, s_page_remove_x, s_page_dirty,
 458                 s_set_page_dirty_x, s_page_to_string, s_string_to_page, NULL);
 459 }
 460
 461 /*!
 462  * \brief Initialise the basic gEDA page manipulation procedures.
 463  * \par Function Description
 464  * Registers some Scheme procedures for working with #PAGE
 465  * smobs. Should only be called by scheme_api_init().
 466  */
 467 void
 468 edascm_init_page ()
 469 {
 470   /* Define the (geda core page) module */
 471   scm_c_define_module ("geda core page",
 472                        init_module_geda_core_page,
 473                        NULL);
 474 }