1 /* gEDA - GPL Electronic Design Automation
2 * libgeda - gEDA's library
3 * Copyright (C) 1998-2007 Ales Hvezda
4 * Copyright (C) 1998-2007 gEDA Contributors (see ChangeLog for details)
6 * This program is free software; you can redistribute it and/or modify
7 * it under the terms of the GNU General Public License as published by
8 * the Free Software Foundation; either version 2 of the License, or
9 * (at your option) any later version.
11 * This program is distributed in the hope that it will be useful,
12 * but WITHOUT ANY WARRANTY; without even the implied warranty of
13 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 * GNU General Public License for more details.
16 * You should have received a copy of the GNU General Public License
17 * along with this program; if not, write to the Free Software
18 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111 USA
31 #include "libgeda_priv.h"
33 #ifdef HAVE_LIBDMALLOC
37 struct st_object_smob
{
38 TOPLEVEL
*world
; /* We need this when updating schematic */
43 TOPLEVEL
*world
; /* We need this when updating schematic */
47 struct st_toplevel_smob
{
51 static long attrib_smob_tag
; /*! Attribute SMOB tag */
52 static long object_smob_tag
; /*! Object SMOB tag */
53 static long page_smob_tag
; /*! Page SMOB tag */
54 static long toplevel_smob_tag
; /*! Toplevel SMOB tag */
56 /* Private function declarations */
57 static SCM
g_set_attrib_value_internal(SCM attrib_smob
,
62 custom_world_get_single_object_bounds(OBJECT
*o_current
,
64 int *right
, int *bottom
,
65 GList
*exclude_attrib_list
,
66 GList
*exclude_obj_type_list
);
69 custom_world_get_object_list_bounds(OBJECT
*o_current
,
71 int *right
, int *bottom
,
72 GList
*exclude_attrib_list
,
73 GList
*exclude_obj_type_list
);
75 /*! \brief Free attribute smob memory.
76 * \par Function Description
77 * Free the memory allocated by the attribute smob and return its size.
79 * \param [in] attrib_smob The attribute smob to free.
80 * \return Size of attribute smob.
82 static scm_sizet
g_free_attrib_smob(SCM attrib_smob
)
84 struct st_attrib_smob
*attribute
=
85 (struct st_attrib_smob
*) SCM_SMOB_DATA (attrib_smob
);
87 scm_gc_free(attribute
, sizeof (*attribute
), "attribute");
91 /*! \brief Prints attribute smob to port.
92 * \par Function Description
93 * This function prints the given attribute smob to the port.
94 * It just prints a string showing it is an attribute and its string.
96 * \param [in] attrib_smob The attribute smob.
97 * \param [in] port The port to print to.
98 * \param [in] pstate Unused.
99 * \return non-zero means success.
101 static int g_print_attrib_smob(SCM attrib_smob
, SCM port
,
102 scm_print_state
*pstate G_GNUC_UNUSED
)
104 struct st_attrib_smob
*attribute
=
105 (struct st_attrib_smob
*) SCM_SMOB_DATA (attrib_smob
);
108 char const *representation
= o_text_get_string(attribute
->attribute
);
109 scm_simple_format(port
, scm_from_locale_string("#<attribute ~a>"),
110 scm_list_1(scm_from_locale_string(representation
)));
113 /* non-zero means success */
118 /*! \brief Creates a name-value smob
119 * \par Function Description
120 * This function Creates and returns a new attribute smob,
121 * based on the given TOPLEVEL curr_w and attribute curr_attr.
123 * \param [in] curr_attr The current attribute.
126 SCM
g_make_attrib_smob(OBJECT
*curr_attr
)
128 struct st_attrib_smob
*smob_attribute
;
130 smob_attribute
= scm_gc_malloc(sizeof(struct st_attrib_smob
), "attribute");
132 smob_attribute
->attribute
= curr_attr
;
134 /* Assumes Guile version >= 1.3.2 */
135 SCM_RETURN_NEWSMOB(attrib_smob_tag
, smob_attribute
);
138 /*! \todo Finish function documentation!!!
140 * \par Function Description
143 /* Makes a list of all attributes currently connected to object. *
144 * Principle stolen from o_attrib_return_attribs */
145 SCM
g_make_attrib_smob_list(OBJECT
*object
)
149 SCM smob_list
= SCM_EOL
;
155 if (!object
->attribs
) {
159 /* go through attribs */
160 a_iter
= object
->attribs
;
161 while(a_iter
!= NULL
) {
162 a_current
= a_iter
->data
;
163 if (a_current
->type
== OBJ_TEXT
) {
164 if (o_text_get_string(a_current
)) {
165 smob_list
= scm_cons(g_make_attrib_smob(a_current
), smob_list
);
168 a_iter
= g_list_next (a_iter
);
174 /*! \brief Get name and value of attribute.
175 * \par Function Description
176 * Returns a list with the name and value of the given attribute smob
178 * \param [in] attrib_smob The attribute smob to get name and value from.
179 * \return A list containing the name and value of the attribute.
181 SCM
g_get_attrib_name_value(SCM attrib_smob
)
183 struct st_attrib_smob
*attribute
;
186 char const *attrib_chars
= NULL
;
187 SCM returned
= SCM_EOL
;
189 SCM_ASSERT ( SCM_NIMP(attrib_smob
) &&
190 ((long) SCM_CAR(attrib_smob
) == attrib_smob_tag
),
191 attrib_smob
, SCM_ARG1
, "get-attribute-name-value");
193 attribute
= (struct st_attrib_smob
*) SCM_SMOB_DATA (attrib_smob
);
195 if (attribute
&& attribute
->attribute
) {
196 attrib_chars
= o_text_get_string(attribute
->attribute
);
200 o_attrib_get_name_value(attrib_chars
, &name
, &value
);
201 returned
= scm_cons(scm_from_locale_string(name
),
202 scm_from_locale_string(value
));
210 /*! \brief Set the attribute value.
211 * \par Function Description
212 * This function puts the attribute smob name into a new_string and
213 * the new scm_value (attribute=value format). It also returns the
214 * TOPLEVEL and OBJECT pointers.
216 * \param [in] attrib_smob The attribute to update.
217 * \param [in] scm_value The new value of the attribute.
218 * \param [in,out] o_attrib Pointer to the updated attribute smob.
219 * \param [in] new_string Returns the attribute=value format string for the
221 * \return Always SCM_UNDEFINED
223 static SCM
g_set_attrib_value_internal(SCM attrib_smob
, SCM scm_value
,
227 struct st_attrib_smob
*attribute
;
230 char const *attrib_chars
= NULL
;
232 SCM_ASSERT ( SCM_NIMP(attrib_smob
) &&
233 ((long) SCM_CAR(attrib_smob
) == attrib_smob_tag
),
234 attrib_smob
, SCM_ARG1
, "set-attribute-value!");
235 SCM_ASSERT (scm_is_string(scm_value
), scm_value
, SCM_ARG2
,
236 "set-attribute-value!");
238 scm_dynwind_begin(0);
239 attribute
= (struct st_attrib_smob
*) SCM_SMOB_DATA (attrib_smob
);
240 value
= scm_to_locale_string(scm_value
);
241 scm_dynwind_free(value
);
243 if (attribute
&& attribute
->attribute
) {
244 attrib_chars
= o_text_get_string(attribute
->attribute
);
248 o_attrib_get_name_value(attrib_chars
, &name
, NULL
);
250 *new_string
= g_strconcat (name
, "=", value
, NULL
);
252 *o_attrib
= attribute
->attribute
;
258 return SCM_UNDEFINED
;
261 /*! \brief Calculate the attribute bounds as it has the given properties.
262 * \par Function Description
263 * Given an attribute, and a new angle, position and alignment,
264 * this function calculates the bounds of the attribute with the new properties,
265 * but without modifying the attribute.
267 * \param [in] attrib_smob The attribute.
268 * \param [in] scm_alignment The new alignment of the attribute.
269 * String with the alignment of the text. Possible values are:
270 * "" : Keep the previous alignment.
280 * \param [in] angle_scm The new angle of the attribute,
281 * or -1 to keep the previous angle.
282 * \param [in] x_scm The new x position of the attribute
283 * or -1 to keep the previous value.
284 * \param [in] y_scm The new y position of the attribute
285 * or -1 to keep the previous value.
286 * \return A list of the form ( (x1 x2) (y1 y2) ) with:
287 * (x1, y1): bottom left corner.
288 * (x2, y2): upper right corner.
290 SCM
g_calculate_new_attrib_bounds(SCM attrib_smob
, SCM scm_alignment
,
291 SCM angle_scm
, SCM x_scm
, SCM y_scm
)
293 OBJECT
*object
= NULL
;
294 struct st_attrib_smob
*attribute
;
295 char *alignment_string
;
299 int old_angle
, old_x
, old_y
, old_alignment
;
300 int left
=0, right
=0, top
=0, bottom
=0;
301 SCM vertical
= SCM_EOL
;
302 SCM horizontal
= SCM_EOL
;
303 SCM returned
= SCM_EOL
;
305 SCM_ASSERT (scm_is_string(scm_alignment
), scm_alignment
,
306 SCM_ARG2
, "calculate-new-attrib-bounds");
307 SCM_ASSERT(scm_is_integer(angle_scm
),
308 angle_scm
, SCM_ARG3
, "calculate-new-attrib-bounds");
309 SCM_ASSERT(scm_is_integer(x_scm
),
310 x_scm
, SCM_ARG4
, "calculate-new-attrib-bounds");
311 SCM_ASSERT(scm_is_integer(y_scm
),
312 y_scm
, SCM_ARG5
, "calculate-new-attrib-bounds");
314 angle
= scm_to_int(angle_scm
);
315 x
= scm_to_int(x_scm
);
316 y
= scm_to_int(y_scm
);
318 alignment_string
= scm_to_locale_string(scm_alignment
);
320 if (strlen(alignment_string
) == 0) {
323 if (strcmp(alignment_string
, "Lower Left") == 0) {
326 if (strcmp(alignment_string
, "Middle Left") == 0) {
329 if (strcmp(alignment_string
, "Upper Left") == 0) {
332 if (strcmp(alignment_string
, "Lower Middle") == 0) {
335 if (strcmp(alignment_string
, "Middle Middle") == 0) {
338 if (strcmp(alignment_string
, "Upper Middle") == 0) {
341 if (strcmp(alignment_string
, "Lower Right") == 0) {
344 if (strcmp(alignment_string
, "Middle Right") == 0) {
347 if (strcmp(alignment_string
, "Upper Right") == 0) {
351 free(alignment_string
);
353 if (alignment
== -2) {
355 SCM_ASSERT (scm_is_string(scm_alignment
), scm_alignment
,
356 SCM_ARG2
, "calculate-new-attrib-bounds");
359 attribute
= (struct st_attrib_smob
*) SCM_SMOB_DATA (attrib_smob
);
361 SCM_ASSERT ( attribute
&&
362 attribute
->attribute
&&
363 attribute
->attribute
->type
== OBJ_TEXT
,
364 attrib_smob
, SCM_ARG1
, "calculate-new-attrib-bounds");
366 object
= attribute
->attribute
;
368 /* Store the previous values */
369 old_alignment
= object
->text
->alignment
;
370 old_angle
= object
->text
->angle
;
371 old_x
= object
->text
->x
;
372 old_y
= object
->text
->y
;
374 /* Set the new ones */
376 object
->text
->alignment
= alignment
;
378 object
->text
->angle
= angle
;
384 o_text_recreate(object
);
386 /* Get the new bounds */
387 world_get_text_bounds(object
, &left
, &top
, &right
, &bottom
);
389 /* Restore the original attributes */
390 object
->text
->alignment
= old_alignment
;
391 object
->text
->angle
= old_angle
;
392 object
->text
->x
= old_x
;
393 object
->text
->y
= old_y
;
395 o_text_recreate(object
);
397 /* Construct the return value */
398 horizontal
= scm_cons (scm_from_int(left
), scm_from_int(right
));
399 vertical
= scm_cons (scm_from_int(top
), scm_from_int(bottom
));
400 returned
= scm_cons (horizontal
, vertical
);
405 /*! \brief Initialize the framework to support an attribute smob.
406 * \par Function Description
407 * Initialize the framework to support an attribute smob.
410 void g_init_attrib_smob(void)
413 attrib_smob_tag
= scm_make_smob_type("attribute",
414 sizeof (struct st_attrib_smob
));
415 scm_set_smob_mark(attrib_smob_tag
, 0);
416 scm_set_smob_free(attrib_smob_tag
, g_free_attrib_smob
);
417 scm_set_smob_print(attrib_smob_tag
, g_print_attrib_smob
);
419 scm_c_define_gsubr("get-attribute-name-value", 1, 0, 0,
420 g_get_attrib_name_value
);
422 scm_c_define_gsubr ("get-attribute-bounds", 1, 0, 0, g_get_attrib_bounds
);
423 scm_c_define_gsubr ("get-attribute-angle", 1, 0, 0, g_get_attrib_angle
);
424 scm_c_define_gsubr("calculate-new-attrib-bounds", 5, 0, 0,
425 g_calculate_new_attrib_bounds
);
426 /* Keep the misnamed interface around in case someone uses it. */
427 scm_c_define_gsubr("calcule-new-attrib-bounds", 5, 0, 0,
428 g_calculate_new_attrib_bounds
);
433 /*! \brief Get the bounds of an attribute.
434 * \par Function Description
435 * Get the bounds of an attribute.
436 * WARNING: top and bottom are mis-named in world-coords,
437 * top is the smallest "y" value, and bottom is the largest.
438 * Be careful! This doesn't correspond to what you'd expect,
439 * nor to the coordinate system whose origin is the bottom, left of the page.
440 * \param[in] attrib_smob the attribute.
441 * \return a list of the bounds of the <B>attrib smob</B>.
442 * The list has the format: ( (left right) (top bottom) )
444 SCM
g_get_attrib_bounds(SCM attrib_smob
)
446 struct st_attrib_smob
*attribute
;
447 SCM vertical
= SCM_EOL
;
448 SCM horizontal
= SCM_EOL
;
449 int left
=0, right
=0, bottom
=0, top
=0;
450 SCM returned
= SCM_EOL
;
452 SCM_ASSERT ( SCM_NIMP(attrib_smob
) &&
453 ((long) SCM_CAR(attrib_smob
) == attrib_smob_tag
),
454 attrib_smob
, SCM_ARG1
, "get-attribute-bounds");
456 attribute
= (struct st_attrib_smob
*) SCM_SMOB_DATA (attrib_smob
);
459 attribute
->attribute
&&
460 attribute
->attribute
->type
== OBJ_TEXT
) {
461 world_get_text_bounds(attribute
->attribute
, &left
, &top
, &right
, &bottom
);
463 horizontal
= scm_cons (scm_from_int(left
), scm_from_int(right
));
464 vertical
= scm_cons (scm_from_int(top
), scm_from_int(bottom
));
465 returned
= scm_cons (horizontal
, vertical
);
471 /*! \brief Get the angle of an attribute.
472 * \par Function Description
473 * Get the angle of an attribute.
474 * \param[in] attrib_smob the attribute.
475 * \return the angle of the <B>attrib smob</B>.
477 SCM
g_get_attrib_angle(SCM attrib_smob
)
479 struct st_attrib_smob
*attribute
;
481 SCM_ASSERT ( SCM_NIMP(attrib_smob
) &&
482 ((long) SCM_CAR(attrib_smob
) == attrib_smob_tag
),
483 attrib_smob
, SCM_ARG1
, "get-attribute-angle");
485 attribute
= (struct st_attrib_smob
*) SCM_SMOB_DATA (attrib_smob
);
487 SCM_ASSERT ( attribute
&&
488 attribute
->attribute
&&
489 attribute
->attribute
->text
,
490 attrib_smob
, SCM_ARG1
, "get-attribute-angle");
492 return scm_from_int(attribute
->attribute
->text
->angle
);
495 /*! \brief Free object smob memory.
496 * \par Function Description
497 * Free the memory allocated by the object smob and return its size.
499 * \param [in] object_smob The object smob to free.
500 * \return Size of object smob.
502 static scm_sizet
g_free_object_smob(SCM object_smob
)
504 struct st_object_smob
*object
=
505 (struct st_object_smob
*) SCM_SMOB_DATA(object_smob
);
507 scm_gc_free(object
, sizeof (*object
), "object");
511 /*! \brief Prints object smob to port.
512 * \par Function Description
513 * This function prints the given object smob to the port.
514 * It just prints a string showing it is an object and the object name.
516 * \param [in] object_smob The object smob.
517 * \param [in] port The port to print to.
518 * \param [in] pstate Unused.
519 * \return non-zero means success.
521 static int g_print_object_smob(SCM object_smob
, SCM port
,
522 scm_print_state
*pstate G_GNUC_UNUSED
)
524 struct st_object_smob
*object
=
525 (struct st_object_smob
*) SCM_SMOB_DATA(object_smob
);
529 object
->object
->name
) {
530 char const *representation
= object
->object
->name
;
531 scm_simple_format(port
, scm_from_locale_string("#<object ~a>"),
532 scm_list_1(scm_from_locale_string(representation
)));
535 /* non-zero means success */
539 /*! \brief Creates a object smob
540 * \par Function Description
541 * This function creates and returns a new object smob,
542 * from the given TOPLEVEL curr_w and object pointers.
544 * \param [in] curr_w The current TOPLEVEL object.
545 * \param [in] object The current object.
548 SCM
g_make_object_smob(TOPLEVEL
*curr_w
, OBJECT
*object
)
550 struct st_object_smob
*smob_object
;
554 smob_object
= scm_gc_malloc(sizeof(struct st_object_smob
), "object");
556 smob_object
->world
= curr_w
;
557 smob_object
->object
= object
;
559 /* Assumes Guile version >= 1.3.2 */
560 SCM_RETURN_NEWSMOB(object_smob_tag
, smob_object
);
563 /*! \brief Get all object attributes in a list.
564 * \par Function Description
565 * This function returns a list with all the attributes of a given object smob.
567 * \param [in] object_smob The object smob to get attributes from.
568 * \return A list of attributes associated with this object smob.
570 SCM
g_get_object_attributes(SCM object_smob
)
572 struct st_object_smob
*object
;
573 SCM returned
= SCM_EOL
;
577 SCM_ASSERT ( SCM_NIMP(object_smob
) &&
578 ((long) SCM_CAR(object_smob
) == object_smob_tag
),
579 object_smob
, SCM_ARG1
, "get-object-attributes");
581 object
= (struct st_object_smob
*) SCM_SMOB_DATA(object_smob
);
586 a_iter
= object
->object
->attribs
;
587 while (a_iter
!= NULL
) {
588 a_current
= a_iter
->data
;
589 if (a_current
&& a_current
->text
) {
590 returned
= scm_cons(g_make_attrib_smob(a_current
), returned
);
592 a_iter
= g_list_next (a_iter
);
599 /*! \brief Get the value(s) of the attributes with the given name in the
601 * \par Function Description
602 * This function returns a list with all the attribute values, providing that
603 * its attribute name is the given name, in a given object smob.
605 * \param [in] object_smob The object smob to get attributes from.
606 * \param [in] scm_attrib_name The name of the attribute you want the value.
607 * \return A list of attribute values.
609 SCM
g_get_attrib_value_by_attrib_name(SCM object_smob
, SCM scm_attrib_name
)
611 struct st_object_smob
*object
;
612 gchar
*attrib_name
=NULL
;
613 SCM returned
= SCM_EOL
;
614 gchar
*name
=NULL
, *value
=NULL
;
618 SCM_ASSERT ( SCM_NIMP(object_smob
) &&
619 ((long) SCM_CAR(object_smob
) == object_smob_tag
),
620 object_smob
, SCM_ARG1
, "get-attrib-value-by-attrib-name");
622 SCM_ASSERT (scm_is_string(scm_attrib_name
), scm_attrib_name
,
623 SCM_ARG2
, "get-attrib-value-by-attrib-name");
625 scm_dynwind_begin(0);
628 object
= (struct st_object_smob
*) SCM_SMOB_DATA(object_smob
);
629 attrib_name
= scm_to_locale_string(scm_attrib_name
);
630 scm_dynwind_free(attrib_name
);
632 if (object
&& object
->object
) {
633 a_iter
= object
->object
->attribs
;
634 while (a_iter
!= NULL
) {
635 a_current
= a_iter
->data
;
637 o_attrib_get_name_value(o_text_get_string(a_current
), &name
, &value
);
638 if (strcmp(name
, attrib_name
) == 0) {
639 returned
= scm_cons(scm_from_locale_string(value
), returned
);
642 a_iter
= g_list_next (a_iter
);
650 /*! \todo Finish function documentation!!!
652 * \par Function Description
655 SCM
g_set_attrib_value_x(SCM attrib_smob
, SCM scm_value
)
659 char *new_string
= NULL
;
661 returned
= g_set_attrib_value_internal(attrib_smob
, scm_value
,
662 &o_attrib
, &new_string
);
665 o_text_change(o_attrib
, new_string
,
666 o_attrib
->visibility
, o_attrib
->show_name_value
);
673 /*! \brief Get the object type.
674 * \par Function Description
675 * This function returns a string with the type of a given object smob.
677 * \param [in] object_smob The object smob to get the type from.
678 * \return A string with the type of the given object.
679 * Actually it is the object->type character converted into a string.
681 SCM
g_get_object_type(SCM object_smob
)
683 struct st_object_smob
*object_struct
;
685 SCM returned
= SCM_EOL
;
687 SCM_ASSERT ( SCM_NIMP(object_smob
) &&
688 ((long) SCM_CAR(object_smob
) == object_smob_tag
),
689 object_smob
, SCM_ARG1
, "get-object-type");
691 object_struct
= (struct st_object_smob
*) SCM_SMOB_DATA(object_smob
);
693 g_assert(object_struct
);
694 g_assert(object_struct
->object
);
696 object
= object_struct
->object
;
698 returned
= SCM_MAKE_CHAR((unsigned char) object
->type
);
704 * Returns a list with coords of the ends of the given pin <B>object</B>.
705 The list is ( (x0 y0) (x1 y1) ), where the beginning is at (x0,y0) and the end at (x1,y1).
706 The active connection end of the pin is the beginning, so this function cares about the whichend property of the pin object. If whichend is 1, then it has to reverse the ends.
708 SCM
g_get_pin_ends(SCM object
)
711 SCM coord1
= SCM_EOL
;
712 SCM coord2
= SCM_EOL
;
713 SCM coords
= SCM_EOL
;
716 /* Get toplevel and o_current */
717 SCM_ASSERT(g_get_data_from_object_smob(object
, NULL
, &o_current
),
718 object
, SCM_ARG1
, "get-pin-ends");
720 /* Check that it is a pin object */
721 SCM_ASSERT (o_current
!= NULL
,
722 object
, SCM_ARG1
, "get-pin-ends");
723 SCM_ASSERT (o_current
->type
== OBJ_PIN
,
724 object
, SCM_ARG1
, "get-pin-ends");
725 SCM_ASSERT (o_current
->line
!= NULL
,
726 object
, SCM_ARG1
, "get-pin-ends");
728 s_basic_get_grip(o_current
, GRIP_1
, &x1
, &y1
);
729 s_basic_get_grip(o_current
, GRIP_2
, &x2
, &y2
);
731 coord1
= scm_cons(scm_from_int(x1
), scm_from_int(y1
));
732 coord2
= scm_cons(scm_from_int(x2
), scm_from_int(y2
));
733 if (o_current
->whichend
== 0) {
734 coords
= scm_cons(coord1
, scm_list(coord2
));
736 coords
= scm_cons(coord2
, scm_list(coord1
));
742 SCM
g_swap_pins(SCM component
, SCM n1
, SCM n2
)
744 OBJECT
*owner
, *attrib
;
745 char *packagepins
, *vpads
, *pin1
, *pin2
;
746 char *pad1
= NULL
, *pad2
= NULL
;
748 SCM_ASSERT(g_get_data_from_object_smob(component
, NULL
, &owner
),
749 component
, SCM_ARG1
, "swap-pins");
750 SCM_ASSERT(scm_is_string(n1
), n1
, SCM_ARG2
, "swap-pins");
751 SCM_ASSERT(scm_is_string(n2
), n2
, SCM_ARG3
, "swap-pins");
753 scm_dynwind_begin(0);
755 pin1
= scm_to_locale_string(n1
);
756 scm_dynwind_free(pin1
);
757 pin2
= scm_to_locale_string(n2
);
758 scm_dynwind_free(pin2
);
760 /* First find which pads correspond to the pins. */
761 packagepins
= o_attrib_search_name_single(owner
, "packagepins", &attrib
);
764 gboolean shorted_pads
= FALSE
;
766 for (s
= packagepins
; s
!= NULL
; ) {
772 pair
= u_basic_split(&s
, ',');
773 equals
= strchr(pair
, '=');
776 /* I think this should be bad, but for now just assume identity. */
785 /* If this entry assigns one of the pins, remember the pad. */
786 for (i
= 0, ppad
= &pad1
, ppin
= &pin1
; i
< 2;
787 i
++, ppad
= &pad2
, ppin
= &pin2
) {
788 if (strcmp(pin
, *ppin
) == 0) {
790 /* An earlier entry already used the pad. */
794 *ppad
= g_strdup(pad
);
802 char *refdes
= o_complex_get_refdes(owner
);
804 g_warning(_("Component %s #<object %s> has shorted pads\n"),
805 refdes
, owner
->name
);
811 /* If there is no package map, assume an identity map. */
813 pad1
= g_strdup(pin1
);
816 pad2
= g_strdup(pin2
);
819 vpads
= o_attrib_search_name_single(owner
, "vpads", &attrib
);
823 int pad1_seen
= 0, pad2_seen
= 0;
825 newmap
= g_string_sized_new(0);
827 for (s
= vpads
; s
!= NULL
; ) {
831 pair
= u_basic_split(&s
, ',');
832 equals
= strchr(pair
, '=');
839 if (strcmp(pad
, pad1
) == 0) {
840 g_string_append_printf(newmap
, ",%s=%s", vpad
, pad2
);
842 } else if (strcmp(pad
, pad2
) == 0) {
843 g_string_append_printf(newmap
, ",%s=%s", vpad
, pad1
);
846 g_string_append_printf(newmap
, ",%s=%s", vpad
, pad
);
850 /* Build the new attribute, skipping the leading comma. */
852 vpads
= g_strdup_printf("vpads=%s", newmap
->len
? newmap
->str
+ 1 : "");
853 g_string_free(newmap
, TRUE
);
855 if (pad1_seen
!= 1 || pad2_seen
!= 1) {
856 /* Component doesn't have exactly one of each of the named pads. */
857 char *refdes
= o_complex_get_refdes(owner
);
859 scm_dynwind_unwind_handler(g_free
, refdes
, SCM_F_WIND_EXPLICITLY
);
860 g_warning(_("Component %s #<object %s> has broken vpads attribute\n"),
861 refdes
, owner
->name
);
868 /* Signal handler will update OBJECT::pad_to_pin. */
869 o_text_change(attrib
, vpads
, attrib
->visibility
, attrib
->show_name_value
);
871 /* Component doesn't support pin swapping at all. */
872 char *refdes
= o_complex_get_refdes(owner
);
874 scm_dynwind_unwind_handler(g_free
, refdes
, SCM_F_WIND_EXPLICITLY
);
875 g_warning(_("Component %s #<object %s> does not support pin swapping\n"),
876 refdes
, owner
->name
);
888 /*! \brief Get the object bounds of the given object, excluding the object
889 * types given as parameters.
890 * \par Function Description
891 * Get the object bounds without considering the attributes in
892 * exclude_attrib_list, neither the object types included in
893 * exclude_obj_type_list
894 * \param [in] o_current The object we want to know the bounds of.
895 * \param [in] exclude_attrib_list A list with the attribute names we don't
896 * want to include when calculating the bounds.
897 * \param [in] exclude_obj_type_list A list with the object types we don't
898 * want to include when calculating the bounds.
899 * The object types are those used in (OBJECT *)->type converted into strings.
900 * \param [out] left Left bound of the object.
901 * \param [out] top Top bound of the object.
902 * \param [out] right Right bound of the object.
903 * \param [out] bottom Bottom bound of the object.
907 custom_world_get_single_object_bounds(OBJECT
*o_current
,
909 int *right
, int *bottom
,
910 GList
*exclude_attrib_list
,
911 GList
*exclude_obj_type_list
) {
912 OBJECT
*obj_ptr
= NULL
;
915 int rleft
, rright
, rbottom
, rtop
;
916 const gchar
*text_value
;
917 char *name_ptr
, aux_ptr
[2];
918 gboolean include_text
;
926 sprintf(aux_ptr
, "%c", obj_ptr
->type
);
928 if (!g_list_find_custom(exclude_obj_type_list
, aux_ptr
,
929 (GCompareFunc
) &strcmp
)) {
930 switch(obj_ptr
->type
) {
932 world_get_single_object_bounds (obj_ptr
,
933 &rleft
, &rtop
, &rright
, &rbottom
);
936 text_value
= o_text_get_string(obj_ptr
);
938 if (o_attrib_get_name_value(text_value
, &name_ptr
, NULL
) &&
939 g_list_find_custom(exclude_attrib_list
, name_ptr
, (GCompareFunc
) &strcmp
)) {
940 include_text
= FALSE
;
942 if (g_list_find_custom(exclude_attrib_list
, "all",
943 (GCompareFunc
) &strcmp
)) {
944 include_text
= FALSE
;
947 world_get_single_object_bounds (obj_ptr
,
948 &rleft
, &rtop
, &rright
, &rbottom
);
954 case (OBJ_PLACEHOLDER
):
955 custom_world_get_object_list_bounds(o_current
->complex->prim_objs
,
956 left
, top
, right
, bottom
,
958 exclude_obj_type_list
);
962 world_get_single_object_bounds (obj_ptr
,
963 &rleft
, &rtop
, &rright
, &rbottom
);
967 if (rleft
< *left
) *left
= rleft
;
968 if (rtop
< *top
) *top
= rtop
;
969 if (rright
> *right
) *right
= rright
;
970 if (rbottom
> *bottom
) *bottom
= rbottom
;
972 /* If it's a pin object, check the pin attributes */
973 if (obj_ptr
->type
== OBJ_PIN
) {
974 a_iter
= obj_ptr
->attribs
;
975 while (a_iter
!= NULL
) {
976 a_current
= a_iter
->data
;
978 if (a_current
->type
== OBJ_TEXT
) {
979 custom_world_get_single_object_bounds(a_current
,
983 exclude_obj_type_list
);
984 if (rleft
< *left
) *left
= rleft
;
985 if (rtop
< *top
) *top
= rtop
;
986 if (rright
> *right
) *right
= rright
;
987 if (rbottom
> *bottom
) *bottom
= rbottom
;
990 a_iter
= g_list_next (a_iter
);
997 custom_world_get_object_list_bounds(OBJECT
*o_current
,
999 int *right
, int *bottom
,
1000 GList
*exclude_attrib_list
,
1001 GList
*exclude_obj_type_list
) {
1002 OBJECT
*obj_ptr
=NULL
;
1003 int rleft
, rtop
, rright
, rbottom
;
1010 obj_ptr
= o_current
;
1012 while ( obj_ptr
!= NULL
) {
1013 custom_world_get_single_object_bounds(obj_ptr
, &rleft
, &rtop
,
1015 exclude_attrib_list
,
1016 exclude_obj_type_list
);
1017 if (rleft
< *left
) *left
= rleft
;
1018 if (rtop
< *top
) *top
= rtop
;
1019 if (rright
> *right
) *right
= rright
;
1020 if (rbottom
> *bottom
) *bottom
= rbottom
;
1022 obj_ptr
=obj_ptr
->next
;
1026 /*! \brief Get the object bounds of the given object, excluding the object
1027 * types or the attributes given as parameters.
1028 * \par Function Description
1029 * Get the object bounds without considering the attributes in
1030 * scm_exclude_attribs, neither the object types included in
1031 * scm_exclude_object_type
1032 * \param [in] object_smob Get this object's bounds
1033 * \param [in] scm_exclude_attribs Ignore attributes with these names.
1034 * \param [in] scm_exclude_object_type Ignore objects of these types.
1035 * The object types are those used in (OBJECT *)->type converted into strings.
1036 * \return a list of the bounds of the <B>object smob</B>.
1037 * The list has the format: ( (left right) (top bottom) )
1038 * WARNING: top and bottom are mis-named in world-coords,
1039 * top is the smallest "y" value, and bottom is the largest.
1040 * Be careful! This doesn't correspond to what you'd expect,
1041 * nor to the coordinate system whose origin is the bottom, left of the page.
1043 SCM
g_get_object_bounds (SCM object_smob
, SCM scm_exclude_attribs
, SCM scm_exclude_object_type
)
1045 OBJECT
*object
=NULL
;
1046 int left
=G_MAXINT
, right
=0, bottom
=0, top
=G_MAXINT
;
1047 SCM returned
= SCM_EOL
;
1048 SCM vertical
= SCM_EOL
;
1049 SCM horizontal
= SCM_EOL
;
1050 GList
*exclude_attrib_list
= NULL
, *exclude_obj_type_list
= NULL
;
1053 SCM_ASSERT (scm_list_p(scm_exclude_attribs
), scm_exclude_attribs
,
1054 SCM_ARG2
, "get-object-bounds");
1055 SCM_ASSERT (scm_list_p(scm_exclude_object_type
), scm_exclude_object_type
,
1056 SCM_ARG3
, "get-object-bounds");
1058 scm_dynwind_begin(0);
1060 /* Build the exclude attrib list */
1061 for (rest
= scm_exclude_attribs
; !scm_is_null(rest
); rest
= SCM_CDR(rest
)) {
1064 SCM_ASSERT(scm_is_string(SCM_CAR(rest
)), SCM_CAR(rest
), SCM_ARG2
,
1065 "get-object-bounds");
1067 attrib_name
= scm_to_locale_string(SCM_CAR(rest
));
1068 scm_dynwind_free(attrib_name
);
1070 exclude_attrib_list
= g_list_prepend(exclude_attrib_list
, attrib_name
);
1073 /* Build the exclude object type list */
1074 for (rest
= scm_exclude_object_type
;
1076 rest
= SCM_CDR(rest
)) {
1079 SCM_ASSERT(scm_is_string(SCM_CAR(rest
)), SCM_CAR(rest
), SCM_ARG3
,
1080 "get-object-bounds");
1082 object_type
= scm_to_locale_string(SCM_CAR(rest
));
1083 scm_dynwind_free(object_type
);
1085 exclude_obj_type_list
= g_list_prepend(exclude_obj_type_list
, object_type
);
1088 /* Get toplevel and o_current. */
1089 g_get_data_from_object_smob(object_smob
, NULL
, &object
);
1091 SCM_ASSERT(object
, object_smob
, SCM_ARG1
, "get-object-bounds");
1093 custom_world_get_single_object_bounds(object
, &left
, &top
, &right
, &bottom
,
1094 exclude_attrib_list
,
1095 exclude_obj_type_list
);
1097 g_list_free(exclude_attrib_list
);
1098 g_list_free(exclude_obj_type_list
);
1101 horizontal
= scm_cons (scm_from_int(left
), scm_from_int(right
));
1102 vertical
= scm_cons (scm_from_int(top
), scm_from_int(bottom
));
1103 returned
= scm_cons (horizontal
, vertical
);
1108 /*! \todo Finish function documentation!!!
1110 * \par Function Description
1114 *Returns a list of the pins of the <B>object smob</B>.
1116 SCM
g_get_object_pins (SCM object_smob
)
1118 TOPLEVEL
*toplevel
=NULL
;
1119 OBJECT
*object
=NULL
;
1121 SCM returned
=SCM_EOL
;
1123 /* Get toplevel and o_current */
1124 SCM_ASSERT (g_get_data_from_object_smob (object_smob
, &toplevel
, &object
),
1125 object_smob
, SCM_ARG1
, "get-object-pins");
1130 if (object
->complex && object
->complex->prim_objs
) {
1131 prim_obj
= object
->complex->prim_objs
;
1132 while (prim_obj
!= NULL
) {
1133 if (prim_obj
->type
== OBJ_PIN
) {
1134 returned
= scm_cons (g_make_object_smob(toplevel
, prim_obj
),returned
);
1136 prim_obj
= prim_obj
->next
;
1143 /*! \brief Get the line width used to draw an object.
1144 * \par Function Description
1145 * This function returns the line width used to draw an object.
1147 * \param [in] object_smob The object smob to get the line width.
1148 * \return The line width.
1149 * Actually it is the object->line_width.
1151 SCM
g_get_line_width(SCM object_smob
)
1153 struct st_object_smob
*object_struct
;
1155 SCM returned
= SCM_EOL
;
1157 SCM_ASSERT ( SCM_NIMP(object_smob
) &&
1158 ((long) SCM_CAR(object_smob
) == object_smob_tag
),
1159 object_smob
, SCM_ARG1
, "get-line-width");
1161 object_struct
= (struct st_object_smob
*) SCM_SMOB_DATA(object_smob
);
1163 g_assert (object_struct
&& object_struct
->object
);
1165 object
= object_struct
->object
;
1167 returned
= scm_from_int(object
->line_width
);
1172 struct get_slots_context
{
1177 static void get_slots_visitor(OBJECT
*o
, void *context
)
1179 struct get_slots_context
*ctx
= context
;
1182 if (o
->type
!= OBJ_SLOT
) {
1186 slot_smob
= g_make_object_smob(ctx
->toplevel
, o
);
1188 ctx
->retval
= scm_cons(slot_smob
, ctx
->retval
);
1191 /*! \brief Get all slots in a list.
1192 * \par Function Description
1193 * This function returns a list with all the slots in an object.
1195 * \param [in] object_smob The object smob to get slots from.
1196 * \return A list of slots belonging to \a object_smob.
1198 SCM
g_get_object_slots(SCM object_smob
)
1200 struct st_object_smob
*object
;
1201 SCM returned
= SCM_EOL
;
1203 SCM_ASSERT ( SCM_NIMP(object_smob
) &&
1204 ((long) SCM_CAR(object_smob
) == object_smob_tag
),
1205 object_smob
, SCM_ARG1
, "get-object-slots");
1207 object
= (struct st_object_smob
*) SCM_SMOB_DATA(object_smob
);
1209 if (object
->object
->type
!= OBJ_COMPLEX
) {
1210 g_warning(_("g_get_object_attributes: object is not a component\n"));
1214 if (object
&& object
->object
) {
1216 struct get_slots_context ctx
;
1218 toplevel
= object
->world
;
1220 ctx
.toplevel
= toplevel
;
1221 ctx
.retval
= returned
;
1223 s_visit(object
->object
, &get_slots_visitor
, &ctx
, VISIT_UNORDERED
, 2);
1225 returned
= ctx
.retval
;
1231 /*! \brief Get the occupant of a slot object
1232 * \par Function Description
1233 * This function returns the abstract symbol occupying a slot
1235 * \param [in] object_smob The object smob of a slot object
1236 * \return The abstract symbol object
1238 SCM
g_get_slot_occupant(SCM object_smob
)
1240 struct st_object_smob
*object_struct
;
1243 SCM returned
= SCM_EOL
;
1245 SCM_ASSERT ( SCM_NIMP(object_smob
) &&
1246 ((long) SCM_CAR(object_smob
) == object_smob_tag
),
1247 object_smob
, SCM_ARG1
, "get-slot-occupant");
1249 object_struct
= (struct st_object_smob
*) SCM_SMOB_DATA(object_smob
);
1251 g_assert (object_struct
&& object_struct
->object
);
1253 toplevel
= object_struct
->world
;
1254 object
= object_struct
->object
;
1256 if (object
->type
!= OBJ_SLOT
) {
1257 g_warning(_("g_get_slot_occupant: object is not a slot\n"));
1261 if (object
->slot
->symbol
) {
1264 occupant
= s_slot_get_occupant(object
);
1265 returned
= g_make_object_smob(toplevel
, occupant
);
1271 /*! \brief Determine if an object is compatible with a slot
1272 * \par Function Description
1274 * \param [in] object_smob An object to put in a slot
1275 * \param [in] slot_smob A slot object
1276 * \return True if \a object_smob is compatible with \a slot_smob.
1278 SCM
g_object_compatiblep(SCM object_smob
, SCM slot_smob
)
1280 struct st_object_smob
*object_data
;
1281 struct st_object_smob
*slot_data
;
1282 SCM retval
= SCM_BOOL_F
;
1284 SCM_ASSERT ( SCM_NIMP(object_smob
) &&
1285 ((long) SCM_CAR(object_smob
) == object_smob_tag
),
1286 object_smob
, SCM_ARG1
, "object-compatible?");
1287 SCM_ASSERT ( SCM_NIMP(slot_smob
) &&
1288 ((long) SCM_CAR(slot_smob
) == object_smob_tag
),
1289 slot_smob
, SCM_ARG2
, "object-compatible?");
1291 object_data
= (struct st_object_smob
*) SCM_SMOB_DATA(object_smob
);
1292 slot_data
= (struct st_object_smob
*) SCM_SMOB_DATA(slot_smob
);
1294 g_assert (object_data
&& object_data
->object
);
1295 g_assert (slot_data
&& slot_data
->object
);
1297 if (slot_data
->object
->type
!= OBJ_SLOT
) {
1298 g_warning(_("g_object_compatiblep: object is not a slot\n"));
1302 if (s_slot_compatible(object_data
->object
, slot_data
->object
)) {
1303 retval
= SCM_BOOL_T
;
1309 /*! \brief Put a component into a slot
1310 * \par Function Description
1312 * \param [in] object_smob An object to put in a slot
1313 * \param [in] symbol_smob A slot object
1314 * \return True iff the slot-link succeeded.
1316 SCM
g_slot_link(SCM object_smob
, SCM symbol_smob
)
1318 struct st_object_smob
*object_data
;
1319 struct st_object_smob
*symbol_data
;
1321 OBJECT
*object
, *symbol
;
1322 SCM retval
= SCM_BOOL_F
;
1324 SCM_ASSERT ( SCM_NIMP(object_smob
) &&
1325 ((long) SCM_CAR(object_smob
) == object_smob_tag
),
1326 object_smob
, SCM_ARG1
, "slot-link");
1327 SCM_ASSERT ( SCM_NIMP(symbol_smob
) &&
1328 ((long) SCM_CAR(symbol_smob
) == object_smob_tag
),
1329 symbol_smob
, SCM_ARG2
, "slot-link");
1331 object_data
= (struct st_object_smob
*) SCM_SMOB_DATA(object_smob
);
1332 symbol_data
= (struct st_object_smob
*) SCM_SMOB_DATA(symbol_smob
);
1334 g_assert (object_data
&& object_data
->object
);
1335 g_assert (symbol_data
&& symbol_data
->object
);
1337 /* FIXME: Don't infer toplevel. */
1338 toplevel
= object_data
->world
;
1339 object
= object_data
->object
;
1340 symbol
= symbol_data
->object
;
1342 if (s_slot_link(toplevel
, object
, symbol
) == 0) {
1343 retval
= SCM_BOOL_T
;
1349 /*! \brief Remove a component from its slot
1350 * \par Function Description
1352 * \param [in] object_smob An object to remove from its slot
1353 * \return True iff the slot-link succeeded.
1355 SCM
g_slot_unlink(SCM object_smob
)
1357 struct st_object_smob
*object_data
;
1358 OBJECT
*object
, *old_slot
;
1360 SCM retval
= SCM_BOOL_F
;
1362 SCM_ASSERT ( SCM_NIMP(object_smob
) &&
1363 ((long) SCM_CAR(object_smob
) == object_smob_tag
),
1364 object_smob
, SCM_ARG1
, "slot-unlink");
1366 object_data
= (struct st_object_smob
*) SCM_SMOB_DATA(object_smob
);
1368 g_assert (object_data
&& object_data
->object
);
1370 toplevel
= object_data
->world
;
1371 object
= object_data
->object
;
1373 old_slot
= s_slot_unlink(object
);
1374 s_slot_reset_attribs(object
);
1376 retval
= g_make_object_smob(toplevel
, old_slot
);
1382 /*! \brief Initialize the framework to support an object smob.
1383 * \par Function Description
1384 * Initialize the framework to support an object smob.
1387 void g_init_object_smob(void)
1390 object_smob_tag
= scm_make_smob_type("object", sizeof (struct st_object_smob
));
1391 scm_set_smob_mark(object_smob_tag
, 0);
1392 scm_set_smob_free(object_smob_tag
, g_free_object_smob
);
1393 scm_set_smob_print(object_smob_tag
, g_print_object_smob
);
1395 scm_c_define_gsubr("get-attrib-value-by-attrib-name", 2, 0, 0,
1396 g_get_attrib_value_by_attrib_name
);
1397 scm_c_define_gsubr("get-object-type", 1, 0, 0, g_get_object_type
);
1398 scm_c_define_gsubr("get-line-width", 1, 0, 0, g_get_line_width
);
1400 scm_c_define_gsubr("get-object-slots", 1, 0, 0, g_get_object_slots
);
1401 scm_c_define_gsubr("get-slot-occupant", 1, 0, 0, g_get_slot_occupant
);
1402 scm_c_define_gsubr("object-compatible?", 2, 0, 0, g_object_compatiblep
);
1403 scm_c_define_gsubr("slot-link", 2, 0, 0, g_slot_link
);
1404 scm_c_define_gsubr("slot-unlink", 1, 0, 0, g_slot_unlink
);
1410 /*! \brief Get the TOPLEVEL and OBJECT data from an object smob.
1411 * \par Function Description
1412 * Get the TOPLEVEL and OBJECT data from an object smob.
1414 * \param [in] object_smob The object smob to get data from.
1415 * \param [out] toplevel The TOPLEVEL to write data to.
1416 * \param [out] object The OBJECT to write data to.
1417 * \return TRUE on success, FALSE otherwise
1419 gboolean
g_get_data_from_object_smob(SCM object_smob
, TOPLEVEL
**toplevel
,
1423 if ( (!SCM_NIMP(object_smob
)) ||
1424 ((long) SCM_CAR(object_smob
) != object_smob_tag
) ) {
1427 if (toplevel
!= NULL
) {
1428 *toplevel
= (TOPLEVEL
*)
1429 (((struct st_object_smob
*) SCM_SMOB_DATA(object_smob
))->world
);
1431 if (object
!= NULL
) {
1432 *object
= (((struct st_object_smob
*) SCM_SMOB_DATA(object_smob
))->object
);
1437 /*! \brief Free page smob memory.
1438 * \par Function Description
1439 * Free the memory allocated by the page smob and return its size.
1441 * \param [in] page_smob The page smob to free.
1442 * \return Size of page smob.
1444 static scm_sizet
g_free_page_smob(SCM page_smob
)
1446 struct st_page_smob
*page
=
1447 (struct st_page_smob
*) SCM_SMOB_DATA(page_smob
);
1449 scm_gc_free(page
, sizeof (*page
), "page");
1453 /*! \brief Prints page smob to port.
1454 * \par Function Description
1455 * This function prints the given page smob to the port.
1456 * It just prints a string showing it is a page and the page name.
1458 * \param [in] page_smob The page smob.
1459 * \param [in] port The port to print to.
1460 * \param [in] pstate Unused.
1461 * \return non-zero means success.
1463 static int g_print_page_smob(SCM page_smob
, SCM port
,
1464 scm_print_state
*pstate G_GNUC_UNUSED
)
1466 struct st_page_smob
*page
=
1467 (struct st_page_smob
*) SCM_SMOB_DATA(page_smob
);
1471 page
->page
->page_filename
) {
1472 char const *representation
= page
->page
->page_filename
;
1473 scm_simple_format(port
, scm_from_locale_string("#<page ~a>"),
1474 scm_list_1(scm_from_locale_string(representation
)));
1477 /* non-zero means success */
1481 /*! \brief Initialize the framework to support a page smob.
1482 * \par Function Description
1483 * Initialize the framework to support a page smob.
1486 void g_init_page_smob(void)
1489 page_smob_tag
= scm_make_smob_type("page",
1490 sizeof (struct st_page_smob
));
1491 scm_set_smob_mark(page_smob_tag
, 0);
1492 scm_set_smob_free(page_smob_tag
, g_free_page_smob
);
1493 scm_set_smob_print(page_smob_tag
, g_print_page_smob
);
1495 scm_c_define_gsubr ("get-page-filename", 1, 0, 0, g_get_page_filename
);
1500 /*! \brief Creates a page smob
1501 * \par Function Description
1502 * This function creates and returns a new page smob,
1503 * from the given TOPLEVEL curr_w and page pointers.
1505 * \param [in] curr_w The current TOPLEVEL object.
1506 * \param [in] page The page object.
1507 * \return SCM The new page smob
1509 SCM
g_make_page_smob(TOPLEVEL
*curr_w
, PAGE
*page
)
1511 struct st_page_smob
*smob_page
;
1513 smob_page
= scm_gc_malloc(sizeof(struct st_page_smob
), "page");
1515 smob_page
->world
= curr_w
;
1516 smob_page
->page
= page
;
1518 /* Assumes Guile version >= 1.3.2 */
1519 SCM_RETURN_NEWSMOB(page_smob_tag
, smob_page
);
1522 /*! \brief Get the TOPLEVEL and PAGE data from a page smob.
1523 * \par Function Description
1524 * Get the TOPLEVEL and OBJECT data from a page smob.
1526 * \param [in] page_smob The page smob to get data from.
1527 * \param [out] toplevel The TOPLEVEL to write data to.
1528 * \param [out] page The PAGE to write data to.
1529 * \return TRUE on success, FALSE otherwise
1531 gboolean
g_get_data_from_page_smob(SCM page_smob
, TOPLEVEL
**toplevel
,
1535 if ( (!SCM_NIMP(page_smob
)) ||
1536 ((long) SCM_CAR(page_smob
) != page_smob_tag
) ) {
1539 if (toplevel
!= NULL
) {
1540 *toplevel
= (TOPLEVEL
*)
1541 (((struct st_page_smob
*) SCM_SMOB_DATA (page_smob
))->world
);
1545 (((struct st_page_smob
*) SCM_SMOB_DATA (page_smob
))->page
);
1550 /*! \brief Get the page filename from a page smob.
1551 * \par Function Description
1552 * Get the page filename from a page smob.
1554 * \param [in] page_smob The page smob to get the filename from.
1555 * \return the page filename or SCM_EOL if there was some error.
1557 SCM
g_get_page_filename(SCM page_smob
)
1559 SCM returned
= SCM_EOL
;
1562 SCM_ASSERT ( SCM_NIMP(page_smob
) &&
1563 ((long) SCM_CAR(page_smob
) == page_smob_tag
),
1564 page_smob
, SCM_ARG1
, "get-page-filename");
1567 (((struct st_page_smob
*) SCM_SMOB_DATA (page_smob
))->page
);
1569 if (page
->page_filename
) {
1570 returned
= scm_from_locale_string(page
->page_filename
);
1576 /*! \brief Add a component to the page.
1577 * \par Function Description
1578 * Adds a component <B>comp_name_scm</B> to the schematic, at
1579 * position (<B>x_scm</B>, <B>y_scm</B>), with some properties set by
1581 * \param [in] x_scm Coordinate X of the symbol.
1582 * \param [in] y_scm Coordinate Y of the symbol.
1583 * \param [in] angle_scm Angle of rotation of the symbol.
1584 * \param [in] selectable_scm True if the symbol is selectable, false otherwise.
1585 * \param [in] mirror_scm True if the symbol is mirrored, false otherwise.
1586 * If comp_name_scm is a scheme empty list, SCM_BOOL_F, or an empty
1587 * string (""), then g_add_component returns SCM_BOOL_F without writing
1589 * \return TRUE if the component was added, FALSE otherwise.
1592 SCM
g_add_component(SCM page_smob
, SCM comp_name_scm
, SCM x_scm
, SCM y_scm
,
1593 SCM angle_scm
, SCM selectable_scm
, SCM mirror_scm
)
1597 gboolean selectable
, mirror
;
1601 const CLibSymbol
*clib
;
1603 /* Return if comp_name_scm is NULL (an empty list) or scheme's FALSE */
1604 if (SCM_NULLP(comp_name_scm
) ||
1605 (SCM_BOOLP(comp_name_scm
) && !(SCM_NFALSEP(comp_name_scm
))) ) {
1609 /* Get toplevel and the page */
1610 SCM_ASSERT (g_get_data_from_page_smob (page_smob
, &toplevel
, &page
),
1611 page_smob
, SCM_ARG1
, "add-component-at-xy");
1612 /* Check the arguments */
1613 SCM_ASSERT(scm_is_string(comp_name_scm
), comp_name_scm
,
1614 SCM_ARG2
, "add-component-at-xy");
1615 SCM_ASSERT(scm_is_integer(x_scm
), x_scm
,
1616 SCM_ARG3
, "add-component-at-xy");
1617 SCM_ASSERT(scm_is_integer(y_scm
), y_scm
,
1618 SCM_ARG4
, "add-component-at-xy");
1619 SCM_ASSERT(scm_is_integer(angle_scm
), angle_scm
,
1620 SCM_ARG5
, "add-component-at-xy");
1621 SCM_ASSERT(scm_boolean_p(selectable_scm
), selectable_scm
,
1622 SCM_ARG6
, "add-component-at-xy");
1623 SCM_ASSERT(scm_boolean_p(mirror_scm
), mirror_scm
,
1624 SCM_ARG7
, "add-component-at-xy");
1626 scm_dynwind_begin(0);
1628 /* Get the parameters */
1629 comp_name
= scm_to_locale_string(comp_name_scm
);
1630 scm_dynwind_free(comp_name
);
1631 x
= scm_to_int(x_scm
);
1632 y
= scm_to_int(y_scm
);
1633 angle
= scm_to_int(angle_scm
);
1634 selectable
= SCM_NFALSEP(selectable_scm
);
1635 mirror
= SCM_NFALSEP(mirror_scm
);
1637 SCM_ASSERT(comp_name
, comp_name_scm
, SCM_ARG2
, "add-component-at-xy");
1639 if (strcmp(comp_name
, "") == 0) {
1644 clib
= s_clib_get_symbol_by_name (comp_name
);
1646 new_obj
= o_complex_new (toplevel
, 'C', WHITE
, x
, y
, angle
, mirror
,
1647 clib
, comp_name
, selectable
);
1648 s_page_append(page
, new_obj
);
1649 o_complex_promote_attribs(toplevel
, page
, new_obj
);
1650 o_attrib_fix_uuid(new_obj
);
1651 s_toplevel_register_object(toplevel
, new_obj
);
1654 * For now, do not redraw the newly added complex, since this might cause
1655 * flicker if you are zoom/panning right after this function executes
1658 /* Now the new component should be added to the object's list and
1659 drawn in the screen */
1660 o_redraw_single(toplevel
, new_object
);
1667 /*! \brief Return the objects in a page.
1668 * \par Function Description
1669 * Returns an object smob list with all the objects in the given page.
1670 * \param [in] page_smob Page to look at.
1671 * \return the object smob list with the objects in the page.
1674 SCM
g_get_objects_in_page(SCM page_smob
) {
1678 SCM return_list
=SCM_EOL
;
1680 /* Get toplevel and the page */
1681 SCM_ASSERT (g_get_data_from_page_smob (page_smob
, &toplevel
, &page
),
1682 page_smob
, SCM_ARG1
, "get-objects-in-page");
1684 if (page
&& page
->object_head
&& page
->object_head
->next
) {
1685 object
= page
->object_head
->next
;
1687 return_list
= scm_cons (g_make_object_smob(toplevel
, object
),
1689 object
= object
->next
;
1696 /*! \brief Free toplevel smob memory.
1697 * \par Function Description
1698 * Free the memory allocated by the toplevel smob and return its size.
1700 * \param [in] toplevel_smob The toplevel smob to free.
1701 * \return Size of toplevel smob.
1703 static scm_sizet
g_free_toplevel_smob(SCM toplevel_smob
)
1705 struct st_toplevel_smob
*toplevel
=
1706 (struct st_toplevel_smob
*) SCM_SMOB_DATA(toplevel_smob
);
1708 scm_gc_free(toplevel
, sizeof (*toplevel
), "geda-toplevel");
1712 /*! \brief Initialize the framework to support a toplevel smob.
1713 * \par Function Description
1714 * Initialize the framework to support a toplevel smob.
1717 void g_init_toplevel_smob(void)
1720 toplevel_smob_tag
= scm_make_smob_type("geda-toplevel",
1721 sizeof (struct st_toplevel_smob
));
1722 scm_set_smob_mark(toplevel_smob_tag
, 0);
1723 scm_set_smob_free(toplevel_smob_tag
, g_free_toplevel_smob
);
1725 scm_c_define_gsubr("get-toplevel-from", 1, 0, 0, g_get_toplevel_from
);
1726 scm_c_define_gsubr("get-toplevel-pages", 1, 0, 0, g_get_toplevel_pages
);
1731 /*! \brief Creates a toplevel smob
1732 * \par Function Description
1733 * This function creates and returns a new toplevel smob,
1734 * from the given TOPLEVEL toplevel pointer.
1736 * \param [in] toplevel The current TOPLEVEL object.
1737 * \return SCM The new toplevel smob
1739 SCM
g_make_toplevel_smob(TOPLEVEL
*toplevel
)
1741 struct st_toplevel_smob
*smob_toplevel
;
1743 smob_toplevel
= scm_gc_malloc(sizeof(struct st_toplevel_smob
), "geda-toplevel");
1745 smob_toplevel
->toplevel
= toplevel
;
1747 /* Assumes Guile version >= 1.3.2 */
1748 SCM_RETURN_NEWSMOB(toplevel_smob_tag
, smob_toplevel
);
1751 /*! \brief Get the TOPLEVEL in which another smob exists.
1752 * \par Function Description
1753 * This function returns a TOPLEVEL in which a PAGE or OBJECT exist.
1755 * \param [in] smob The PAGE or OBJECT smob to get TOPLEVEL from.
1756 * \return A TOPLEVEL smob.
1758 SCM
g_get_toplevel_from(SCM smob
)
1760 SCM returned
= SCM_BOOL_F
;
1761 TOPLEVEL
*toplevel
= NULL
;
1763 SCM_ASSERT(SCM_NIMP(smob
), smob
, SCM_ARG1
, "get-toplevel-from");
1765 if ((long) SCM_CAR(smob
) == object_smob_tag
) {
1766 struct st_object_smob
*object
=
1767 (struct st_object_smob
*) SCM_SMOB_DATA(smob
);
1768 toplevel
= object
->world
;
1769 } else if ((long) SCM_CAR(smob
) == page_smob_tag
) {
1770 struct st_page_smob
*page
=
1771 (struct st_page_smob
*) SCM_SMOB_DATA(smob
);
1772 toplevel
= page
->world
;
1774 SCM_ASSERT(0, smob
, SCM_ARG1
, "get-toplevel-from");
1777 returned
= g_make_toplevel_smob(toplevel
);
1782 /*! \brief Get all pages in a list.
1783 * \par Function Description
1784 * This function returns a list with all the pages of a given toplevel smob.
1786 * \param [in] toplevel_smob The toplevel smob to get pages from.
1787 * \return A list of pages associated with this toplevel smob.
1789 SCM
g_get_toplevel_pages(SCM toplevel_smob
)
1791 struct st_toplevel_smob
*toplevel
;
1792 SCM returned
= SCM_EOL
;
1794 SCM_ASSERT ( SCM_NIMP(toplevel_smob
) &&
1795 ((long) SCM_CAR(toplevel_smob
) == toplevel_smob_tag
),
1796 toplevel_smob
, SCM_ARG1
, "get-toplevel-pages");
1798 toplevel
= (struct st_toplevel_smob
*) SCM_SMOB_DATA(toplevel_smob
);
1800 if (toplevel
&& toplevel
->toplevel
) {
1803 for (iter
= geda_list_get_glist(toplevel
->toplevel
->pages
);
1805 iter
= g_list_next(iter
)) {
1806 PAGE
*page
= iter
->data
;
1807 returned
= scm_cons(g_make_page_smob(toplevel
->toplevel
, page
),
1815 /*! \brief Find a component from the global UUID map.
1816 * \par Function Description
1817 * Look up a UUID in the TOPLEVEL uuidmap and return the object found.
1819 * \param [in] toplevel_smob The TOPLEVEL smob containing the map.
1820 * \param [in] uuid_smob The UUID of the desired object.
1822 * \return OBJECT smob for the found object, or #f if not found.
1824 SCM
g_lookup_uuid(SCM toplevel_smob
, SCM uuid_smob
)
1827 struct st_toplevel_smob
*metatoplevel
;
1830 SCM retval
= SCM_BOOL_F
;
1832 SCM_ASSERT(SCM_NIMP(toplevel_smob
) &&
1833 ((long) SCM_CAR(toplevel_smob
) == toplevel_smob_tag
),
1834 toplevel_smob
, SCM_ARG1
, "lookup-uuid");
1835 SCM_ASSERT(scm_is_string(uuid_smob
), uuid_smob
, SCM_ARG2
, "lookup-uuid");
1836 metatoplevel
= (struct st_toplevel_smob
*) SCM_SMOB_DATA(toplevel_smob
);
1837 SCM_ASSERT(metatoplevel
&& metatoplevel
->toplevel
,
1838 toplevel_smob
, SCM_ARG1
, "lookup-uuid");
1839 toplevel
= metatoplevel
->toplevel
;
1841 uuid
= scm_to_locale_string(uuid_smob
);
1842 component
= g_hash_table_lookup(toplevel
->uuidmap
, uuid
);
1846 retval
= g_make_object_smob(toplevel
, component
);