gschem/src/g_attrib.c

   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
  28 #include "gschem.h"
  29
  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");
  34
  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.
  38  *
  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".
  44  *
  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.
  48  *
  49  * If \a target_s is #f, the new attribute will be floating in
  50  * gschem's current active page.
  51  *
  52  * \note Scheme API: Implements the %add-attrib! procedure in the
  53  * (gschem core attrib) module.
  54  *
  55  * \bug This function does not verify that \a name_s is actually a
  56  * valid attribute name.
  57  *
  58  * \todo It would be nice to support pages other than the current
  59  * active page.
  60  *
  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.
  66  *
  67  * \return the newly created text object.
  68  */
  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")
  72 {
  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);
  80
  81   GschemToplevel *w_current = g_current_window ();
  82   TOPLEVEL *toplevel = gschem_toplevel_get_toplevel (w_current);
  83
  84   /* Check target object, if present */
  85   OBJECT *obj = NULL;
  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,
  90                  s_add_attrib_x,
  91                  _("Object ~A is not included in the current gschem page."),
  92                  scm_list_1 (target_s), SCM_EOL);
  93     }
  94   }
  95
  96   /* Visibility */
  97   int visibility;
  98   if (scm_is_false (visible_s)) {
  99     visibility = INVISIBLE;
 100   } else {
 101     visibility = VISIBLE;
 102   }
 103
 104   /* Name/value visibility */
 105   int show;
 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; }
 109   else {
 110     scm_misc_error (s_add_attrib_x,
 111                     _("Invalid text name/value visibility ~A."),
 112                     scm_list_1 (show_s));
 113   }
 114
 115
 116   scm_dynwind_begin (0);
 117
 118   char *name;
 119   name = scm_to_utf8_string (name_s);
 120   scm_dynwind_free (name);
 121
 122   char *value;
 123   value = scm_to_utf8_string (value_s);
 124   scm_dynwind_free (value);
 125
 126   gchar *str = g_strdup_printf ("%s=%s", name, value);
 127   scm_dynwind_unwind_handler (g_free, str, SCM_F_WIND_EXPLICITLY);
 128
 129   OBJECT *result = o_attrib_add_attrib (w_current, str, visibility, show, obj);
 130
 131   scm_dynwind_end ();
 132
 133   return edascm_from_object (result);
 134 }
 135
 136 /*!
 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)).
 141  */
 142 static void
 143 init_module_gschem_core_attrib ()
 144 {
 145   /* Register the functions and symbols */
 146   #include "g_attrib.x"
 147
 148   /* Add them to the module's public definitions. */
 149   scm_c_export (s_add_attrib_x, NULL);
 150 }
 151
 152 /*!
 153  * \brief Initialise the gschem attribute procedures.
 154  * \par Function Description
 155
 156  * Registers some Scheme procedures for working with
 157  * attributes. Should only be called by main_prog().
 158  */
 159 void
 160 g_init_attrib ()
 161 {
 162   /* Define the (gschem core attrib) module */
 163   scm_c_define_module ("gschem core attrib",
 164                        init_module_gschem_core_attrib,
 165                        NULL);
 166 }