[Gnucash-changes] Implement SCM hooks in C -- not yet used.

Derek Atkins warlord at cvs.gnucash.org
Sun Jun 12 13:18:33 EDT 2005


Log Message:
-----------
Implement SCM hooks in C -- not yet used.

	* src/engine/gnc-hooks*:
	  First attempt at implementing SCM hooks in C.
	* src/engine/Makefile.am:
	  Handle new (private) header file, gnc-hooks-scm.h

Tags:
----
gnucash-gnome2-dev

Modified Files:
--------------
    gnucash:
        ChangeLog
    gnucash/src/engine:
        Makefile.am
        gnc-hooks.c
        gnc-hooks.h

Added Files:
-----------
    gnucash/src/engine:
        gnc-hooks-scm.h

Revision Data
-------------
Index: ChangeLog
===================================================================
RCS file: /home/cvs/cvsroot/gnucash/ChangeLog,v
retrieving revision 1.1487.2.225
retrieving revision 1.1487.2.226
diff -LChangeLog -LChangeLog -u -r1.1487.2.225 -r1.1487.2.226
--- ChangeLog
+++ ChangeLog
@@ -1,3 +1,10 @@
+2005-06-12  Derek Atkins  <derek at ihtfp.com>
+
+	* src/engine/gnc-hooks*:
+	  First attempt at implementing SCM hooks in C.
+	* src/engine/Makefile.am:
+	  Handle new (private) header file, gnc-hooks-scm.h
+
 2005-06-11  David Hampton  <hampton at employees.org>
 
 	* src/gnome-utils/gnc-plugin-manager.[ch]: Take ownership of
Index: gnc-hooks.h
===================================================================
RCS file: /home/cvs/cvsroot/gnucash/src/engine/Attic/gnc-hooks.h,v
retrieving revision 1.1.2.4
retrieving revision 1.1.2.5
diff -Lsrc/engine/gnc-hooks.h -Lsrc/engine/gnc-hooks.h -u -r1.1.2.4 -r1.1.2.5
--- src/engine/gnc-hooks.h
+++ src/engine/gnc-hooks.h
@@ -1,6 +1,7 @@
 /*
  * gnc-hooks.h -- helpers for using Glib hook functions
  * Copyright (C) 2005 David Hampton <hampton at employees.org>
+ *                    Derek Atkins <derek at ihtfp.com>
  *
  * This program is free software; you can redistribute it and/or
  * modify it under the terms of the GNU General Public License as
@@ -44,14 +45,6 @@
 void gnc_hook_add_dangler(const gchar *name, GFunc callback, gpointer cb_data);
 void gnc_hook_remove_dangler(const gchar *name, GFunc callback);
 
-#if 0
-/**
- * add and remove Scheme-style danglers from a hook
- */
-void gnc_hook_add_scm_dangler(const gchar *name, SCM proc);
-void gnc_hook_del_scm_dangler(const gchar *name, SCM proc);
-#endif
-
 /**
  * Run the hook danglers.
  */
Index: gnc-hooks.c
===================================================================
RCS file: /home/cvs/cvsroot/gnucash/src/engine/Attic/gnc-hooks.c,v
retrieving revision 1.1.2.3
retrieving revision 1.1.2.4
diff -Lsrc/engine/gnc-hooks.c -Lsrc/engine/gnc-hooks.c -u -r1.1.2.3 -r1.1.2.4
--- src/engine/gnc-hooks.c
+++ src/engine/gnc-hooks.c
@@ -1,6 +1,7 @@
 /*
  * gnc-hooks.c -- helpers for using Glib hook functions
  * Copyright (C) 2005 David Hampton <hampton at employees.org>
+ *                    Derek Atkins <derek at ihtfp.com>
  *
  * This program is free software; you can redistribute it and/or
  * modify it under the terms of the GNU General Public License as
@@ -24,7 +25,10 @@
 
 #include <glib.h>
 #include <stdio.h>
+#include <libguile.h>
+#include <g-wrap-wct.h>
 #include "gnc-hooks.h"
+#include "gnc-hooks-scm.h"
 
 static GHashTable* gnc_hooks_list = NULL;
 static gboolean gnc_hooks_initialized = FALSE;
@@ -35,6 +39,10 @@
   GHookList	*scm_danglers;
 } GncHook;
 
+typedef struct {
+  SCM		proc;
+} GncScmDangler;
+
 const gchar *
 gnc_hook_create (const gchar *name, const gchar *desc)
 {
@@ -139,19 +147,91 @@
   //printf("Leave %s: Removed %p from %s\n", __FUNCTION__ , hook, name);
 }
 
+static void
+delete_scm_hook (gpointer data)
+{
+  GncScmDangler *scm = data;
+  scm_unprotect_object(scm->proc);
+  g_free(scm);
+}
 
 static void
-call_c_hook (GHook *hook, gpointer data)
+call_scm_hook (GHook *hook, gpointer data)
 {
-  //printf("Enter %s: hook %p (func %p), data %p\n", __FUNCTION__, hook, hook->func, data);
-  ((GFunc)hook->func)(data, hook->data);
+  GncScmDangler *scm = hook->data;
+
+  // XXX: FIXME: We really should make sure this is a session!!! */
+  scm_call_1 (scm->proc,
+	      (data ? 
+	       gw_wcp_assimilate_ptr (data,
+				      scm_c_eval_string("<gnc:Session*>")) :
+               SCM_BOOL_F));
+}
+
+void
+gnc_hook_add_scm_dangler (const gchar *name, SCM proc)
+{
+  GncHook *gnc_hook;
+  GHook *hook;
+  GncScmDangler *scm;
+
+  //printf("Enter %s: list %s, function %p\n\n", __FUNCTION__, name, callback);
+  gnc_hook = gnc_hook_lookup(name);
+  g_return_if_fail(gnc_hook != NULL);
+  scm = g_new0(GncScmDangler, 1);
+  scm_protect_object(proc);
+  scm->proc = proc;
+  hook = g_hook_alloc(gnc_hook->scm_danglers);
+  hook->func = call_scm_hook;
+  hook->data = scm;
+  hook->destroy = delete_scm_hook;
+  g_hook_append(gnc_hook->scm_danglers, hook);
   //printf("Leave %s:  \n", __FUNCTION__);
 }
 
+static gboolean
+hook_remove_scm_runner (GHook *hook, gpointer data)
+{
+  GncScmDangler *scm1 = data;
+  GncScmDangler *scm2 = hook->data;
+  SCM res;
+
+  res = scm_equal_p(scm1->proc, scm2->proc);
+  return(SCM_NFALSEP(res));
+}
+
+void
+gnc_hook_del_scm_dangler (const gchar *name, SCM proc)
+{
+  GncHook *gnc_hook;
+  GHook *hook;
+  GncScmDangler scm;
+
+  scm.proc = proc;
+
+  //printf("Enter %s: name %s, function %p\n\n", __FUNCTION__, name, &scm);
+  gnc_hook = gnc_hook_lookup(name);
+  if (gnc_hook == NULL) {
+    //printf("Leave %s: Unknown hook list %s\n", __FUNCTION__, name);
+    return;
+  }
+
+  hook = g_hook_find(gnc_hook->scm_danglers, TRUE, hook_remove_scm_runner, &scm);
+  if (hook == NULL) {
+    //printf("Leave %s: Hook %p not found in %s\n", __FUNCTION__, callback, name);
+    return;
+  }
+
+  g_hook_unref(gnc_hook->scm_danglers, hook);
+  //printf("Leave %s: Removed %p from %s\n", __FUNCTION__ , hook, name);
+}
+
 static void
-call_scm_hook (GHook *hook, gpointer data)
+call_c_hook (GHook *hook, gpointer data)
 {
-  // XXX.  Implement me.
+  //printf("Enter %s: hook %p (func %p), data %p\n", __FUNCTION__, hook, hook->func, data);
+  ((GFunc)hook->func)(data, hook->data);
+  //printf("Leave %s:  \n", __FUNCTION__);
 }
 
 void
Index: Makefile.am
===================================================================
RCS file: /home/cvs/cvsroot/gnucash/src/engine/Makefile.am,v
retrieving revision 1.94.2.9
retrieving revision 1.94.2.10
diff -Lsrc/engine/Makefile.am -Lsrc/engine/Makefile.am -u -r1.94.2.9 -r1.94.2.10
--- src/engine/Makefile.am
+++ src/engine/Makefile.am
@@ -145,6 +145,7 @@
   gnc-budget-period-p.h \
   gnc-budget-p.h \
   gnc-event-p.h \
+  gnc-hooks-scm.h \
   gnc-lot.h \
   gnc-lot-p.h \
   gnc-pricedb-p.h \
--- /dev/null
+++ src/engine/gnc-hooks-scm.h
@@ -0,0 +1,36 @@
+/*
+ * gnc-hooks-scm.h -- scheme helpers for using Glib hook functions
+ * Copyright (C) 2005 Derek Atkins <derek at ihtfp.com
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License as
+ * published by the Free Software Foundation; either version 2 of
+ * the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, contact:
+ *
+ * Free Software Foundation           Voice:  +1-617-542-5942
+ * 59 Temple Place - Suite 330        Fax:    +1-617-542-2652
+ * Boston, MA  02111-1307,  USA       gnu at gnu.org
+ *
+ */
+
+#ifndef GNC_HOOKS_SCM_H
+#define GNC_HOOKS_SCM_H
+
+#include "gnc-hooks.h"
+#include <libguile.h>
+
+/**
+ * add and remove Scheme-style danglers from a hook
+ */
+void gnc_hook_add_scm_dangler(const gchar *name, SCM proc);
+void gnc_hook_del_scm_dangler(const gchar *name, SCM proc);
+
+#endif /* GNC_HOOKS_SCM_H */


More information about the gnucash-changes mailing list