1 /* gEDA - GPL Electronic Design Automation
2 * gschem - gEDA Schematic Capture
3 * Copyright (C) 2011 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
18 */
19
20 /*!
21 * \file g_attrib.c
22 * \brief Scheme API functions for manipulating attributes in
23 * gschem-specific ways.
24 */
25
26 #include <config.h>
27 #include <missing.h>
28
29 #include "gschem.h"
30
31 SCM_SYMBOL (name_sym , "name");
32 SCM_SYMBOL (value_sym , "value");
33 SCM_SYMBOL (both_sym , "both");
34 SCM_SYMBOL (object_state_sym, "object-state");
35
36 /*! \brief Add an attribute to an object, or floating.
37 * \par Function Description
38 * Creates a new attribute, either attached to an object or floating.
39 *
40 * The \a name_s and \a value_s should be strings. If \a visible_s is
41 * false, the new attribute will be invisible; otherwise it will be
42 * visible. \a show_s determines which parts of an
43 * attribute-formatted string should be shown, and should be one of
44 * the symbols "name", "value" or "both".
45 *
46 * If \a target_s is specified and is a gEDA object, the new attribute
47 * will be attached to it. If \a target_s is not in gschem's active
48 * page, an "object-state" error will be raised.
49 *
50 * If \a target_s is #f, the new attribute will be floating in
51 * gschem's current active page.
52 *
53 * \note Scheme API: Implements the %add-attrib! procedure in the
54 * (gschem core attrib) module.
55 *
56 * \bug This function does not verify that \a name_s is actually a
57 * valid attribute name.
58 *
59 * \todo It would be nice to support pages other than the current
60 * active page.
61 *
62 * \param target_s where to attach the new attribute.
63 * \param name_s name for the new attribute.
64 * \param value_s value for the new attribute.
65 * \param visible_s visibility of the new attribute (true or false).
66 * \param show_s the attribute part visibility setting.
67 *
68 * \return the newly created text object.
69 */
70 SCM_DEFINE (add_attrib_x, "%add-attrib!", 5, 0, 0,
71 (SCM target_s, SCM name_s, SCM value_s, SCM visible_s, SCM show_s),
72 "Add an attribute to an object, or floating")
73 {
74 SCM_ASSERT ((edascm_is_page (target_s) ||
75 edascm_is_object (target_s) ||
76 scm_is_false (target_s)),
77 target_s, SCM_ARG1, s_add_attrib_x);
78 SCM_ASSERT (scm_is_string (name_s), name_s, SCM_ARG2, s_add_attrib_x);
79 SCM_ASSERT (scm_is_string (value_s), value_s, SCM_ARG3, s_add_attrib_x);
80 SCM_ASSERT (scm_is_symbol (show_s), show_s, SCM_ARG5, s_add_attrib_x);
81
82 GSCHEM_TOPLEVEL *w_current = g_current_window ();
83 TOPLEVEL *toplevel = w_current->toplevel;
84
85 /* Check target object, if present */
86 OBJECT *obj = NULL;
87 if (edascm_is_object (target_s)) {
88 obj = edascm_to_object (target_s);
89 if (o_get_page (toplevel, obj) != toplevel->page_current) {
90 scm_error (object_state_sym,
91 s_add_attrib_x,
92 _("Object ~A is not included in the current gschem page."),
93 scm_list_1 (target_s), SCM_EOL);
94 }
95 }
96
97 /* Visibility */
98 int visibility;
99 if (scm_is_false (visible_s)) {
100 visibility = INVISIBLE;
101 } else {
102 visibility = VISIBLE;
103 }
104
105 /* Name/value visibility */
106 int show;
107 if (show_s == name_sym) { show = SHOW_NAME; }
108 else if (show_s == value_sym) { show = SHOW_VALUE; }
109 else if (show_s == both_sym) { show = SHOW_NAME_VALUE; }
110 else {
111 scm_misc_error (s_add_attrib_x,
112 _("Invalid text name/value visibility ~A."),
113 scm_list_1 (show_s));
114 }
115
116
117 scm_dynwind_begin (0);
118
119 char *name;
120 name = scm_to_utf8_string (name_s);
121 scm_dynwind_free (name);
122
123 char *value;
124 value = scm_to_utf8_string (value_s);
125 scm_dynwind_free (value);
126
127 gchar *str = g_strdup_printf ("%s=%s", name, value);
128 scm_dynwind_unwind_handler (g_free, str, SCM_F_WIND_EXPLICITLY);
129
130 OBJECT *result = o_attrib_add_attrib (w_current, str, visibility, show, obj);
131
132 scm_dynwind_end ();
133
134 return edascm_from_object (result);
135 }
136
137 /*!
138 * \brief Create the (geda core object) Scheme module.
139 * \par Function Description
140 * Defines procedures in the (geda core object) module. The module can
141 * be accessed using (use-modules (geda core object)).
142 */
143 static void
init_module_gschem_core_attrib()144 init_module_gschem_core_attrib ()
145 {
146 /* Register the functions and symbols */
147 #include "g_attrib.x"
148
149 /* Add them to the module's public definitions. */
150 scm_c_export (s_add_attrib_x, NULL);
151 }
152
153 /*!
154 * \brief Initialise the gschem attribute procedures.
155 * \par Function Description
156
157 * Registers some Scheme procedures for working with
158 * attributes. Should only be called by main_prog().
159 */
160 void
g_init_attrib()161 g_init_attrib ()
162 {
163 /* Define the (gschem core attrib) module */
164 scm_c_define_module ("gschem core attrib",
165 init_module_gschem_core_attrib,
166 NULL);
167 }
168