1 /* gEDA - GPL Electronic Design Automation
2 * libgeda - gEDA's library - Scheme API
3 * Copyright (C) 2010 Peter Brett <peter@peter-b.co.uk>
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.
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.
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
22 * \brief Scheme API page manipulation procedures.
27 #include "libgeda_priv.h"
28 #include "libgedaguile_priv.h"
30 SCM_SYMBOL (edascm_string_format_sym
, "string-format");
32 /*! \brief Get a of open pages.
33 * \par Function Description
34 * Retrieves a Scheme list of currently-opened pages.
36 * \note Scheme API: Implements the %active-pages procedure of the
37 * (geda core page) module.
39 * \return a Scheme list of #PAGE smobs.
41 SCM_DEFINE (active_pages
, "%active-pages", 0, 0, 0,
42 (), "Retrieve a list of currently-opened pages")
44 TOPLEVEL
*toplevel
= edascm_c_current_toplevel ();
47 GList
*page_list
= geda_list_get_glist (toplevel
->pages
);
49 while (page_list
!= NULL
) {
50 lst
= scm_cons (edascm_from_page (page_list
->data
), lst
);
51 page_list
= g_list_next (page_list
);
54 rlst
= scm_reverse (lst
);
55 scm_remember_upto_here_1 (lst
);
59 /*! \brief Create a new page.
60 * \par Function Description
61 * Creates and initialises a new #PAGE structure associated with the
62 * filename \a filename_s. Note that this does not check that a file
63 * exists with that name, or attempt to load any data from it.
65 * \note Scheme API: Implements the %new-page procedure of the (geda
68 * \return a newly-created #PAGE smob.
70 SCM_DEFINE (new_page
, "%new-page", 1, 0, 0,
71 (SCM filename_s
), "Create a new page")
73 TOPLEVEL
*toplevel
= edascm_c_current_toplevel ();
77 /* Ensure that the argument is a string */
78 SCM_ASSERT (scm_is_string (filename_s
), filename_s
,
79 SCM_ARG1
, s_new_page
);
81 filename
= scm_to_utf8_string (filename_s
);
82 page
= s_page_new (toplevel
, filename
);
85 return edascm_from_page (page
);
88 /*! \brief Close a page
89 * \par Function Description
91 * Destroys the #PAGE structure \a page_s, freeing all of its
92 * resources. Attempting to use \a page_s after calling this function
93 * will cause an error.
95 * \note Scheme API: Implements the %close-page procedure of the (geda
98 * \param page_s The page to close.
99 * \return SCM_UNDEFINED.
101 SCM_DEFINE (close_page_x
, "%close-page!", 1, 0, 0,
102 (SCM page_s
), "Close a page.")
104 /* Ensure that the argument is a page smob */
105 SCM_ASSERT (EDASCM_PAGEP (page_s
), page_s
,
106 SCM_ARG1
, s_close_page_x
);
108 TOPLEVEL
*toplevel
= edascm_c_current_toplevel ();
109 PAGE
*page
= edascm_to_page (page_s
);
111 s_page_delete (toplevel
, page
);
113 return SCM_UNDEFINED
;
116 /*! \brief Get the filename associated with a page.
117 * \par Function Description
118 * Retrieves the filename associated with the #PAGE smob \a page_s.
120 * \note Scheme API: Implements the %page-filename procedure of the
121 * (geda core page) module.
123 * \return a Scheme string containing the page filename.
125 SCM_DEFINE (page_filename
, "%page-filename", 1, 0, 0,
126 (SCM page_s
), "Get a page's associated filename")
130 /* Ensure that the argument is a page smob */
131 SCM_ASSERT (EDASCM_PAGEP (page_s
), page_s
,
132 SCM_ARG1
, s_page_filename
);
135 page
= edascm_to_page (page_s
);
136 return scm_from_utf8_string (page
->page_filename
);
139 /*! \brief Change the filename associated with a page.
140 * \par Function Description
141 * Sets the filename associated with the #PAGE smob \a page_s.
143 * \note Scheme API: Implements the %set-page-filename! procedure of
144 * the (geda core page) module.
146 * \param page_s page to set filename for.
147 * \param filename_s new filename for \a page.
150 SCM_DEFINE (set_page_filename_x
, "%set-page-filename!", 2, 0, 0,
151 (SCM page_s
, SCM filename_s
), "Set a page's associated filename")
153 SCM_ASSERT (EDASCM_PAGEP (page_s
), page_s
,
154 SCM_ARG1
, s_set_page_filename_x
);
155 SCM_ASSERT (scm_is_string (filename_s
), filename_s
,
156 SCM_ARG2
, s_set_page_filename_x
);
158 PAGE
*page
= edascm_to_page (page_s
);
159 char *new_fn
= scm_to_utf8_string (filename_s
);
160 if (page
->page_filename
!= NULL
) {
161 g_free (page
->page_filename
);
163 page
->page_filename
= g_strdup (new_fn
);
169 /*! \brief Get a list of objects in a page.
170 * \par Function Description
171 * Retrieves the contents of a the #PAGE smob \a page_s as a Scheme
172 * list of #OBJECT smobs.
174 * \note Scheme API: Implements the %page-contents procedure of the
175 * (geda core page) module.
177 * \return a list of #OBJECT smobs.
179 SCM_DEFINE (page_contents
, "%page-contents", 1, 0, 0,
180 (SCM page_s
), "Get a page's contents.")
184 /* Ensure that the argument is a page smob */
185 SCM_ASSERT (EDASCM_PAGEP (page_s
), page_s
,
186 SCM_ARG1
, s_page_contents
);
188 page
= edascm_to_page (page_s
);
190 return edascm_from_object_glist (s_page_objects (page
));
193 /*! \brief Get the page an object belongs to.
194 * \par Function Description
195 * Returns a smob for the #PAGE that \a obj_s belongs to. If \a obj_s
196 * does not belong to a #PAGE, returns SCM_BOOL_F.
198 * \note Scheme API: Implements the %object-page procedure in the
199 * (geda core page) module.
201 * \param [in] obj_s an #OBJECT smob.
202 * \return a #PAGE smob or SCM_BOOL_F.
204 SCM_DEFINE (object_page
, "%object-page", 1, 0, 0,
205 (SCM obj_s
), "Get the page that an object smob belongs to")
207 SCM_ASSERT (EDASCM_OBJECTP (obj_s
), obj_s
,
208 SCM_ARG1
, s_object_page
);
210 PAGE
*page
= o_get_page (edascm_c_current_toplevel (),
211 edascm_to_object (obj_s
));
214 return edascm_from_page (page
);
221 /*! \brief Add an object to a page.
222 * \par Function Description
223 * Adds \a obj_s to \a page_s. If \a obj_s is already attached to a
224 * #PAGE or to a complex #OBJECT, throws a Scheme error.
226 * \note Scheme API: Implements the %page-append! procedure of the
227 * (geda core page) module.
231 SCM_DEFINE (page_append_x
, "%page-append!", 2, 0, 0,
232 (SCM page_s
, SCM obj_s
), "Add an object to a page.")
234 /* Ensure that the arguments have the correct types. */
235 SCM_ASSERT (EDASCM_PAGEP (page_s
), page_s
,
236 SCM_ARG1
, s_page_append_x
);
237 SCM_ASSERT (EDASCM_OBJECTP (obj_s
), obj_s
,
238 SCM_ARG2
, s_page_append_x
);
240 PAGE
*page
= edascm_to_page (page_s
);
241 OBJECT
*obj
= edascm_to_object (obj_s
);
242 TOPLEVEL
*toplevel
= edascm_c_current_toplevel ();
244 /* Check that the object isn't already attached to something. */
245 PAGE
*curr_page
= o_get_page (toplevel
, obj
);
246 if (((curr_page
!= NULL
) && (curr_page
!= page
))
247 || (obj
->parent
!= NULL
)) {
248 scm_error (edascm_object_state_sym
, s_page_append_x
,
249 _("Object ~A is already attached to something"),
250 scm_list_1 (obj_s
), SCM_EOL
);
253 if (curr_page
== page
) return obj_s
;
255 /* Object cleanup now managed by C code. */
256 edascm_c_set_gc (obj_s
, 0);
257 o_emit_pre_change_notify (toplevel
, obj
);
258 s_page_append (edascm_c_current_toplevel (), page
, obj
);
259 o_emit_change_notify (toplevel
, obj
);
260 page
->CHANGED
= 1; /* Ugh. */
265 /*! \brief Remove an object from a page.
266 * \par Function Description
267 * Removes \a obj_s from \a page_s. If \a obj_s is attached to a
268 * #PAGE other than \a page_s, or to a complex #OBJECT, throws a
269 * Scheme error. If \a obj_s is not attached to a page, does nothing.
271 * \note Scheme API: Implements the %page-remove! procedure of the
272 * (geda core page) module.
276 SCM_DEFINE (page_remove_x
, "%page-remove!", 2, 0, 0,
277 (SCM page_s
, SCM obj_s
), "Remove an object from a page.")
279 /* Ensure that the arguments have the correct types. */
280 SCM_ASSERT (EDASCM_PAGEP (page_s
), page_s
,
281 SCM_ARG1
, s_page_remove_x
);
282 SCM_ASSERT (EDASCM_OBJECTP (obj_s
), obj_s
,
283 SCM_ARG2
, s_page_remove_x
);
285 PAGE
*page
= edascm_to_page (page_s
);
286 OBJECT
*obj
= edascm_to_object (obj_s
);
287 TOPLEVEL
*toplevel
= edascm_c_current_toplevel ();
289 /* Check that the object is not attached to something else. */
290 PAGE
*curr_page
= o_get_page (toplevel
, obj
);
291 if ((curr_page
!= NULL
&& curr_page
!= page
)
292 || (obj
->parent
!= NULL
)) {
293 scm_error (edascm_object_state_sym
, s_page_remove_x
,
294 _("Object ~A is attached to a complex or different page"),
295 scm_list_1 (obj_s
), SCM_EOL
);
298 /* Check that object is not attached as an attribute. */
299 if (obj
->attached_to
!= NULL
) {
300 scm_error (edascm_object_state_sym
, s_page_remove_x
,
301 _("Object ~A is attached as an attribute"),
302 scm_list_1 (obj_s
), SCM_EOL
);
305 /* Check that object doesn't have attributes. */
306 if (obj
->attribs
!= NULL
) {
307 scm_error (edascm_object_state_sym
, s_page_remove_x
,
308 _("Object ~A has attributes"),
309 scm_list_1 (obj_s
), SCM_EOL
);
312 if (curr_page
== NULL
) return obj_s
;
314 o_emit_pre_change_notify (toplevel
, obj
);
315 s_page_remove (toplevel
, page
, obj
);
316 page
->CHANGED
= 1; /* Ugh. */
317 /* If the object is currently selected, unselect it. */
318 o_selection_remove (toplevel
, page
->selection_list
, obj
);
319 o_emit_change_notify (toplevel
, obj
);
321 /* Object cleanup now managed by Guile. */
322 edascm_c_set_gc (obj_s
, 1);
326 /*! \brief Check whether a page has been flagged as changed.
327 * \par Function Description
328 * Returns SCM_BOOL_T if \a page_s has been flagged as having been
331 * \note Scheme API: Implements the %page-dirty? procedure of the
332 * (geda core page) module.
334 * \param page_s page to inspect.
335 * \return SCM_BOOL_T if page is dirtied, otherwise SCM_BOOL_F.
337 SCM_DEFINE (page_dirty
, "%page-dirty?", 1, 0, 0,
338 (SCM page_s
), "Check whether a page has been flagged as changed.")
340 /* Ensure that the argument is a page smob */
341 SCM_ASSERT (EDASCM_PAGEP (page_s
), page_s
,
342 SCM_ARG1
, s_page_dirty
);
344 PAGE
*page
= edascm_to_page (page_s
);
345 return page
->CHANGED
? SCM_BOOL_T
: SCM_BOOL_F
;
348 /*! \brief Set a page's changed flag.
349 * \par Function Description
350 * If \a flag_s is true, flag \a page_s as having been modified.
351 * Otherwise, clears the change flag.
353 * \note Scheme API: Implements the %set-page-dirty! procedure of the
354 * (geda core page) module.
356 * \param page_s page to modify.
357 * \param flag_s new flag setting.
360 SCM_DEFINE (set_page_dirty_x
, "%set-page-dirty!", 2, 0, 0,
361 (SCM page_s
, SCM flag_s
),
362 "Set whether a page is flagged as changed.")
364 /* Ensure that the argument is a page smob */
365 SCM_ASSERT (EDASCM_PAGEP (page_s
), page_s
,
366 SCM_ARG1
, s_set_page_dirty_x
);
368 PAGE
*page
= edascm_to_page (page_s
);
369 page
->CHANGED
= scm_is_true (flag_s
);
373 /*! \brief Create a string representation of a page.
374 * \par Function Description
375 * Returns a string representation of the contents of \a page_s.
377 * \note Scheme API: Implements the %page->string procedure of the
378 * (geda core page) module.
380 * \param page_s page to convert to a string.
381 * \return a string representation of \a page_s.
383 SCM_DEFINE (page_to_string
, "%page->string", 1, 0, 0,
385 "Create a string representation of a page.")
387 /* Ensure that the argument is a page smob */
388 SCM_ASSERT (EDASCM_PAGEP (page_s
), page_s
,
389 SCM_ARG1
, s_page_to_string
);
391 PAGE
*page
= edascm_to_page (page_s
);
392 TOPLEVEL
*toplevel
= edascm_c_current_toplevel ();
394 gchar
*buf
= o_save_buffer (toplevel
, s_page_objects (page
));
395 scm_dynwind_begin (0);
396 scm_dynwind_unwind_handler (g_free
, buf
, SCM_F_WIND_EXPLICITLY
);
397 SCM result
= scm_from_utf8_string (buf
);
402 /*! \brief Create a page from a string representation.
403 * \par Function Description
404 * Returns a page with filename \a filename_s created by parsing \a
405 * str_s. Throws an error if \a str_s contains invalid gEDA file
408 * \note Scheme API: Implements the %string->page procedure of the
409 * (geda core page) module.
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.
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.")
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
);
425 TOPLEVEL
*toplevel
= edascm_c_current_toplevel ();
426 char *filename
= scm_to_utf8_string (filename_s
);
427 PAGE
*page
= s_page_new (toplevel
, filename
);
432 char *str
= scm_to_utf8_stringn (str_s
, &len
);
433 GList
*objects
= o_read_buffer (toplevel
, NULL
, str
, len
,
434 page
->page_filename
, &err
);
438 SCM error_message
= scm_from_utf8_string (err
->message
);
441 scm_error (edascm_string_format_sym
, s_string_to_page
,
442 _("Parse error: ~s"), scm_list_1 (error_message
), SCM_EOL
);
445 s_page_append_list (toplevel
, page
, objects
);
447 return edascm_from_page (page
);
451 * \brief Create the (geda core page) Scheme module.
452 * \par Function Description
453 * Defines procedures in the (geda core page) module. The module can
454 * be accessed using (use-modules (geda core page)).
457 init_module_geda_core_page ()
459 /* Register the functions */
460 #include "scheme_page.x"
462 /* Add them to the module's public definitions. */
464 scm_c_export (s_active_pages
, s_new_page
, s_close_page_x
,
465 s_page_filename
, s_set_page_filename_x
, s_page_contents
,
466 s_object_page
, s_page_append_x
, s_page_remove_x
, s_page_dirty
,
467 s_set_page_dirty_x
, s_page_to_string
, s_string_to_page
, NULL
);
471 * \brief Initialise the basic gEDA page manipulation procedures.
472 * \par Function Description
473 * Registers some Scheme procedures for working with #PAGE
474 * smobs. Should only be called by edascm_init().
479 /* Define the (geda core page) module */
480 scm_c_define_module ("geda core page",
481 init_module_geda_core_page
,