1 /* gEDA - GPL Electronic Design Automation
2 * gschem - gEDA Schematic Capture
3 * Copyright (C) 2011 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
22 * \brief Scheme API functions for manipulating attributes in
23 * gschem-specific ways.
30 SCM_SYMBOL (name_sym
, "name");
31 SCM_SYMBOL (value_sym
, "value");
32 SCM_SYMBOL (both_sym
, "both");
33 SCM_SYMBOL (object_state_sym
, "object-state");
35 /*! \brief Add an attribute to an object, or floating.
36 * \par Function Description
37 * Creates a new attribute, either attached to an object or floating.
39 * The \a name_s and \a value_s should be strings. If \a visible_s is
40 * false, the new attribute will be invisible; otherwise it will be
41 * visible. \a show_s determines which parts of an
42 * attribute-formatted string should be shown, and should be one of
43 * the symbols "name", "value" or "both".
45 * If \a target_s is specified and is a gEDA object, the new attribute
46 * will be attached to it. If \a target_s is not in gschem's active
47 * page, an "object-state" error will be raised.
49 * If \a target_s is #f, the new attribute will be floating in
50 * gschem's current active page.
52 * \note Scheme API: Implements the %add-attrib! procedure in the
53 * (gschem core attrib) module.
55 * \bug This function does not verify that \a name_s is actually a
56 * valid attribute name.
58 * \todo It would be nice to support pages other than the current
61 * \param target_s where to attach the new attribute.
62 * \param name_s name for the new attribute.
63 * \param value_s value for the new attribute.
64 * \param visible_s visibility of the new attribute (true or false).
65 * \param show_s the attribute part visibility setting.
67 * \return the newly created text object.
69 SCM_DEFINE (add_attrib_x
, "%add-attrib!", 5, 0, 0,
70 (SCM target_s
, SCM name_s
, SCM value_s
, SCM visible_s
, SCM show_s
),
71 "Add an attribute to an object, or floating")
73 SCM_ASSERT ((edascm_is_page (target_s
) ||
74 edascm_is_object (target_s
) ||
75 scm_is_false (target_s
)),
76 target_s
, SCM_ARG1
, s_add_attrib_x
);
77 SCM_ASSERT (scm_is_string (name_s
), name_s
, SCM_ARG2
, s_add_attrib_x
);
78 SCM_ASSERT (scm_is_string (value_s
), value_s
, SCM_ARG3
, s_add_attrib_x
);
79 SCM_ASSERT (scm_is_symbol (show_s
), show_s
, SCM_ARG5
, s_add_attrib_x
);
81 GschemToplevel
*w_current
= g_current_window ();
82 TOPLEVEL
*toplevel
= gschem_toplevel_get_toplevel (w_current
);
84 /* Check target object, if present */
86 if (edascm_is_object (target_s
)) {
87 obj
= edascm_to_object (target_s
);
88 if (o_get_page (toplevel
, obj
) != toplevel
->page_current
) {
89 scm_error (object_state_sym
,
91 _("Object ~A is not included in the current gschem page."),
92 scm_list_1 (target_s
), SCM_EOL
);
98 if (scm_is_false (visible_s
)) {
99 visibility
= INVISIBLE
;
101 visibility
= VISIBLE
;
104 /* Name/value visibility */
106 if (scm_is_eq (show_s
, name_sym
)) { show
= SHOW_NAME
; }
107 else if (scm_is_eq (show_s
, value_sym
)) { show
= SHOW_VALUE
; }
108 else if (scm_is_eq (show_s
, both_sym
)) { show
= SHOW_NAME_VALUE
; }
110 scm_misc_error (s_add_attrib_x
,
111 _("Invalid text name/value visibility ~A."),
112 scm_list_1 (show_s
));
116 scm_dynwind_begin (0);
119 name
= scm_to_utf8_string (name_s
);
120 scm_dynwind_free (name
);
123 value
= scm_to_utf8_string (value_s
);
124 scm_dynwind_free (value
);
126 gchar
*str
= g_strdup_printf ("%s=%s", name
, value
);
127 scm_dynwind_unwind_handler (g_free
, str
, SCM_F_WIND_EXPLICITLY
);
129 OBJECT
*result
= o_attrib_add_attrib (w_current
, str
, visibility
, show
, obj
);
133 return edascm_from_object (result
);
137 * \brief Create the (gschem core attrib) Scheme module.
138 * \par Function Description
139 * Defines procedures in the (gschem core attrib) module. The module can
140 * be accessed using (use-modules (gschem core attrib)).
143 init_module_gschem_core_attrib ()
145 /* Register the functions and symbols */
146 #include "g_attrib.x"
148 /* Add them to the module's public definitions. */
149 scm_c_export (s_add_attrib_x
, NULL
);
153 * \brief Initialise the gschem attribute procedures.
154 * \par Function Description
156 * Registers some Scheme procedures for working with
157 * attributes. Should only be called by main_prog().
162 /* Define the (gschem core attrib) module */
163 scm_c_define_module ("gschem core attrib",
164 init_module_gschem_core_attrib
,