gschem/src/g_hook.c

   1 /* gEDA - GPL Electronic Design Automation
   2  * gschem - gEDA Schematic Capture
   3  * Copyright (C) 1998-2010 Ales Hvezda
   4  * Copyright (C) 1998-2020 gEDA Contributors (see ChangeLog for details)
   5  *
   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.
  10  *
  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.
  15  *
  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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  19  */
  20 #include <config.h>
  21
  22 #include <stdio.h>
  23 #ifdef HAVE_STRING_H
  24 #include <string.h>
  25 #endif
  26 #include <math.h>
  27
  28 #include "gschem.h"
  29
  30 SCM_SYMBOL (at_sym, "@");
  31 SCM_SYMBOL (gschem_sym, "gschem");
  32 SCM_SYMBOL (core_sym, "core");
  33 SCM_SYMBOL (hook_sym, "hook");
  34 SCM_SYMBOL (run_hook_sym, "run-hook");
  35 SCM_SYMBOL (list_sym, "list");
  36
  37 /*! \brief Gets a Scheme hook object by name.
  38  * \par Function Description
  39  * Returns the contents of variable with the given name in the (gschem
  40  * core hook).  Used for looking up hook objects.
  41  *
  42  * \param name name of hook to lookup.
  43  * \return value found in the (gschem core hook) module.
  44  */
  45 static SCM
  46 g_get_hook_by_name (const char *name)
  47 {
  48   SCM exp = scm_list_3 (at_sym,
  49                         scm_list_3 (gschem_sym, core_sym, hook_sym),
  50                         scm_from_utf8_symbol (name));
  51   return g_scm_eval_protected (exp, SCM_UNDEFINED);
  52 }
  53
  54 /*! \brief Runs a object hook for a list of objects.
  55  * \par Function Description
  56  * Runs a hook called \a name, which should expect a list of #OBJECT
  57  * smobs as its argument, with \a obj_lst as the argument list.
  58  *
  59  * \see g_run_hook_object()
  60  *
  61  * \param name    name of hook to run.
  62  * \param obj_lst list of #OBJECT smobs as hook argument.
  63  */
  64 void
  65 g_run_hook_object_list (GschemToplevel *w_current, const char *name,
  66                         GList *obj_lst)
  67 {
  68   SCM lst = SCM_EOL;
  69   GList *iter;
  70
  71   scm_dynwind_begin (0);
  72   g_dynwind_window (w_current);
  73
  74   for (iter = obj_lst; iter != NULL; iter = g_list_next (iter)) {
  75     lst = scm_cons (edascm_from_object ((OBJECT *) iter->data), lst);
  76   }
  77   SCM expr = scm_list_3 (run_hook_sym,
  78                          g_get_hook_by_name (name),
  79                          scm_cons (list_sym,
  80                                    scm_reverse_x (lst, SCM_EOL)));
  81
  82   g_scm_eval_protected (expr, scm_interaction_environment ());
  83   scm_dynwind_end ();
  84   scm_remember_upto_here_1 (expr);
  85 }
  86
  87 /*! \brief Runs a object hook with a single OBJECT.
  88  * \par Function Description
  89  * Runs a hook called \a name, which should expect a list of #OBJECT
  90  * smobs as its argument, with a single-element list containing only \a obj.
  91  *
  92  * \see g_run_hook_object_list()
  93  *
  94  * \param name name of hook to run.
  95  * \param obj  #OBJECT argument for hook.
  96  */
  97 void
  98 g_run_hook_object (GschemToplevel *w_current, const char *name, OBJECT *obj)
  99 {
 100   scm_dynwind_begin (0);
 101   g_dynwind_window (w_current);
 102
 103   SCM expr = scm_list_3 (run_hook_sym,
 104                          g_get_hook_by_name (name),
 105                          scm_list_2 (list_sym, edascm_from_object (obj)));
 106
 107   g_scm_eval_protected (expr, scm_interaction_environment ());
 108   scm_dynwind_end ();
 109   scm_remember_upto_here_1 (expr);
 110 }
 111
 112 /*! \brief Runs a page hook.
 113  * \par Function Description
 114  * Runs a hook called \a name, which should expect the single #PAGE \a
 115  * page as its argument.
 116  *
 117  * \param name name of hook to run
 118  * \param page #PAGE argument for hook.
 119  */
 120 void
 121 g_run_hook_page (GschemToplevel *w_current, const char *name, PAGE *page)
 122 {
 123   scm_dynwind_begin (0);
 124   g_dynwind_window (w_current);
 125
 126   SCM expr = scm_list_3 (run_hook_sym,
 127                          g_get_hook_by_name (name),
 128                          edascm_from_page (page));
 129
 130   g_scm_eval_protected (expr, scm_interaction_environment ());
 131   scm_dynwind_end ();
 132   scm_remember_upto_here_1 (expr);
 133 }
 134
 135 /*! \brief Creates an EdascmHookProxy for a named hook.
 136  * Return a newly-created hook proxy object for the hook called \a
 137  * name.
 138  *
 139  * \param name  name of the hook for which to create a proxy.
 140  * \return      newly-created EdascmHookProxy instance.
 141  */
 142 EdascmHookProxy *
 143 g_hook_new_proxy_by_name (const char *name)
 144 {
 145   SCM hook = g_get_hook_by_name (name);
 146   return edascm_hook_proxy_new_with_hook (hook);
 147 }
 148
 149 /*! \brief Create the (gschem core hook) Scheme module.
 150  * \par Function Description
 151  * Defines some hooks in the (gschem core hook) module.  These hooks
 152  * allow Scheme callbacks to be triggered on certain gschem actions.
 153  * For a description of the arguments and behaviour of these hooks,
 154  * please see ../scheme/gschem/hook.scm.
 155  */
 156 static void
 157 init_module_gschem_core_hook ()
 158 {
 159
 160 #include "g_hook.x"
 161
 162 #define DEFINE_HOOK(name,arity)                      \
 163   do { \
 164     scm_c_define (name, scm_make_hook (scm_from_int (arity)));      \
 165     scm_c_export (name, NULL); \
 166   } while (0)
 167
 168   DEFINE_HOOK ("%add-objects-hook",1);
 169   DEFINE_HOOK ("%copy-objects-hook",1);
 170   DEFINE_HOOK ("%remove-objects-hook",1);
 171   DEFINE_HOOK ("%move-objects-hook",1);
 172   DEFINE_HOOK ("%mirror-objects-hook",1);
 173   DEFINE_HOOK ("%rotate-objects-hook",1);
 174   DEFINE_HOOK ("%paste-objects-hook",1);
 175   DEFINE_HOOK ("%attach-attribs-hook",1);
 176   DEFINE_HOOK ("%detach-attribs-hook",1);
 177   DEFINE_HOOK ("%select-objects-hook",1);
 178   DEFINE_HOOK ("%deselect-objects-hook",1);
 179   DEFINE_HOOK ("%new-page-hook",1);
 180   DEFINE_HOOK ("%action-property-hook",3);
 181   DEFINE_HOOK ("%bind-keys-hook",3);
 182 }
 183
 184 /*!
 185  * \brief Initialise the gschem hooks.
 186  * \par Function Description
 187
 188  * Registers gschem's Guile hooks for various events.. Should only be
 189  * called by main_prog().
 190  */
 191 void
 192 g_init_hook ()
 193 {
 194   /* Define the (gschem core hook) module */
 195   scm_c_define_module ("gschem core hook",
 196                        init_module_gschem_core_hook,
 197                        NULL);
 198 }