gschem/src/g_select.c

   1 /* gEDA - GPL Electronic Design Automation
   2  * gschem - gEDA Schematic Capture
   3  * Copyright (C) 2010 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., 59 Temple Place, Suite 330, Boston, MA 02111 USA
  18  */
  19 #include <config.h>
  20
  21 #include "gschem.h"
  22
  23 SCM_SYMBOL (object_state_sym, "object-state");
  24
  25 /*! \brief Get a list of selected objects on a page.
  26  * \par Function Description
  27  * Retrieve a list of selected objects on \a page_s.
  28  *
  29  * \note Scheme API: Implements the %page-selection procedure in the
  30  * (gschem core selection) module.
  31  *
  32  * \param page_s #PAGE smob for the page from which to get the selection.
  33  * \return a list of #OBJECT smobs.
  34  */
  35 SCM_DEFINE (page_selection, "%page-selection", 1, 0, 0,
  36             (SCM page_s), "Get a list of a page's selected objects")
  37 {
  38   /* Ensure that the argument is a page smob */
  39   SCM_ASSERT (edascm_is_page (page_s), page_s,
  40               SCM_ARG1, s_page_selection);
  41
  42   PAGE *page = edascm_to_page (page_s);
  43   GList *iter;
  44   SCM result = SCM_EOL;
  45   for (iter = geda_list_get_glist (page->selection_list);
  46        iter != NULL; iter = g_list_next (iter)) {
  47     result = scm_cons (edascm_from_object ((OBJECT *) iter->data), result);
  48   }
  49
  50   return result;
  51 }
  52
  53 /*! \brief Select an object.
  54  * \par Function Description
  55  * Add \a obj_s to its associated page's selection.  If \a obj_s is
  56  * not included directly in a page (i.e. inclusion in a component is
  57  * not permitted), throws a Scheme error.  If \a obj_s is already
  58  * selected, does nothing.
  59  *
  60  * \note Scheme API: Implements the %select-object! procedure in the
  61  * (gschem core selection) module.
  62  *
  63  * \param obj_s #OBJECT smob for object to be selected.
  64  * \return obj_s.
  65  */
  66 SCM_DEFINE (select_object_x, "%select-object!", 1, 0, 0,
  67             (SCM obj_s), "Select an object.")
  68 {
  69   /* Ensure that the argument is an object smob */
  70   SCM_ASSERT (edascm_is_object (obj_s), obj_s,
  71               SCM_ARG1, s_select_object_x);
  72
  73   TOPLEVEL *toplevel = edascm_c_current_toplevel ();
  74   OBJECT *obj = edascm_to_object (obj_s);
  75   PAGE *page = o_get_page (toplevel, obj);
  76   if ((page == NULL) || (obj->parent != NULL)) {
  77     scm_error (object_state_sym,
  78                s_select_object_x,
  79                _("Object ~A is not directly included in a page."),
  80                scm_list_1 (obj_s), SCM_EOL);
  81   }
  82
  83   if (!obj->selected) {
  84     o_selection_add (toplevel, page->selection_list, obj);
  85   }
  86
  87   return obj_s;
  88 }
  89
  90 /*! \brief Deselect an object.
  91  * \par Function Description
  92  * Remove \a obj_s from its associated page's selection.  If \a obj_s
  93  * is not included directly in a page (i.e. not via inclusion in a
  94  * component), throws a Scheme error.  If \a obj_s is not selected,
  95  * does nothing.
  96  *
  97  * \note Scheme API: Implements the %deselect-object! procedure in the
  98  * (gschem core selection) module.
  99  *
 100  * \param obj_s #OBJECT smob for object to be deselected.
 101  * \return obj_s.
 102  */
 103 SCM_DEFINE (deselect_object_x, "%deselect-object!", 1, 0, 0,
 104             (SCM obj_s), "Deselect an object.")
 105 {
 106   /* Ensure that the argument is an object smob */
 107   SCM_ASSERT (edascm_is_object (obj_s), obj_s,
 108               SCM_ARG1, s_deselect_object_x);
 109
 110   TOPLEVEL *toplevel = edascm_c_current_toplevel ();
 111   OBJECT *obj = edascm_to_object (obj_s);
 112   PAGE *page = o_get_page (toplevel, obj);
 113   if ((page == NULL) || (obj->parent != NULL)) {
 114     scm_error (object_state_sym,
 115                s_deselect_object_x,
 116                _("Object ~A is not directly included in a page."),
 117                scm_list_1 (obj_s), SCM_EOL);
 118   }
 119
 120   if (obj->selected) {
 121     o_selection_remove (toplevel, page->selection_list, obj);
 122   }
 123
 124   return obj_s;
 125 }
 126
 127 /*! \brief Test if an object is selected.
 128  * \par Function Description
 129  * If \a obj_s is selected, returns SCM_BOOL_T.  Otherwise, returns
 130  * SCM_BOOL_F.  If \a obj_s is not included directly in a page
 131  * (i.e. not via inclusion in a component), throws a Scheme error.
 132  *
 133  * \note Scheme API: Implements the %object-selected? procedure in the
 134  * (gschem core selection) module.
 135  *
 136  * \param obj_s #OBJECT smob to be tested.
 137  * \return SCM_BOOL_T if \a obj_s is selected, otherwise SCM_BOOL_F.
 138  */
 139 SCM_DEFINE (object_selected_p, "%object-selected?", 1, 0, 0,
 140             (SCM obj_s), "Test if an object is selected.")
 141 {
 142   /* Ensure that the argument is an object smob */
 143   SCM_ASSERT (edascm_is_object (obj_s), obj_s,
 144               SCM_ARG1, s_object_selected_p);
 145
 146   TOPLEVEL *toplevel = edascm_c_current_toplevel ();
 147   OBJECT *obj = edascm_to_object (obj_s);
 148   PAGE *page = o_get_page (toplevel, obj);
 149   if ((page == NULL) || (obj->parent != NULL)) {
 150     scm_error (object_state_sym,
 151                s_object_selected_p,
 152                _("Object ~A is not directly included in a page."),
 153                scm_list_1 (obj_s), SCM_EOL);
 154   }
 155   return (obj->selected ? SCM_BOOL_T : SCM_BOOL_F);
 156 }
 157
 158 /*! \brief Create the (gschem core selection) Scheme module
 159  * \par Function Description
 160  * Defines procedures in the (gschem core selection) module. The module
 161  * can be accessed using (use-modules (gschem core selection)).
 162  */
 163 static void
 164 init_module_gschem_core_select ()
 165 {
 166   /* Register the functions */
 167   #include "g_select.x"
 168
 169   /* Add them to the module's public definitions. */
 170   scm_c_export (s_page_selection, s_select_object_x, s_deselect_object_x,
 171                 s_object_selected_p, NULL);
 172 }
 173
 174 /*! \brief Initialise the selection manipulation procedures.
 175  * \par Function Description
 176  * Registers some Scheme procedures for working with the selection.
 177  * Should only be called by main_prog().
 178  */
 179 void
 180 g_init_select ()
 181 {
 182   /* Define the (gschem core selection) module */
 183   scm_c_define_module ("gschem core selection",
 184                        init_module_gschem_core_select,
 185                        NULL);
 186 }