/********************************************************************\ * glib-guile.c -- glib helper functions for guile * * Copyright (C) 2000 Linas Vepstas * * Copyright (C) 2006 Chris Shoemaker * * * * 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 * * 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652 * * Boston, MA 02110-1301, USA gnu@gnu.org * * * \********************************************************************/ #include #include #include #include #ifdef __MINGW32__ #define _GL_UNISTD_H //Deflect poisonous define of close in Guile's GnuLib #endif #include #ifdef HAVE_UNISTD_H # ifdef close # undef close # endif # include #else # include # define close _close #endif #include #include "swig-runtime.h" #include "guile-mappings.h" #include "gnc-glib-utils.h" #include "gnc-guile-utils.h" #include "glib-guile.h" #include #if PLATFORM(WINDOWS) #include #include #endif #include "qof.h" #include "gnc-engine-guile.h" #define UNUSED_VAR __attribute__ ((unused)) /* This static indicates the debugging module this .o belongs to. */ static QofLogModule UNUSED_VAR log_module = GNC_MOD_GUILE; static SCM glist_to_scm_list_helper(GList *glist, swig_type_info *wct) { SCM list = SCM_EOL; GList *node; for (node = glist; node; node = node->next) list = scm_cons(SWIG_NewPointerObj(node->data, wct, 0), list); return scm_reverse (list); } SCM gnc_glist_to_scm_list(GList *glist, const gchar *wct) { swig_type_info *stype = SWIG_TypeQuery(wct); g_return_val_if_fail(stype, SCM_UNDEFINED); return glist_to_scm_list_helper(glist, stype); } GList * gnc_scm_list_to_glist(SCM rest) { GList *result = NULL; SCM scm_item; SWIG_GetModule(NULL); /* Work-around for SWIG bug. */ SCM_ASSERT(scm_is_list(rest), rest, SCM_ARG1, "gnc_scm_list_to_glist"); while (!scm_is_null(rest)) { void *item; scm_item = SCM_CAR(rest); rest = SCM_CDR(rest); if (scm_item == SCM_BOOL_F) { result = g_list_prepend(result, NULL); } else { if (!SWIG_IsPointer(scm_item)) scm_misc_error("gnc_scm_list_to_glist", "Item in list not a wcp.", scm_item); item = (void *)SWIG_PointerAddress(scm_item); result = g_list_prepend(result, item); } } return g_list_reverse(result); } /******************************************************************** * gnc_glist_string_to_scm * i.e. (glist-of ( calee-owned) callee-owned) * or equivalently * i.e. (glist-of ( calee-owned) callee-owned) ********************************************************************/ SCM gnc_glist_string_to_scm(GList *glist) { SCM list = SCM_EOL; GList *node; for (node = glist; node; node = node->next) { if (node->data) list = scm_cons (scm_from_utf8_string(node->data), list); else list = scm_cons (SCM_BOOL_F, list); } return scm_reverse (list); } /******************************************************************** * gnc_scm_to_glist_string * i.e. (glist-of ( callee-owned) callee-owned) * or equivalently * i.e. (glist-of ( callee-owned) callee-owned) ********************************************************************/ GList * gnc_scm_to_glist_string(SCM list) { GList *glist = NULL; while (!scm_is_null (list)) { if (scm_is_string(SCM_CAR(list))) { gchar * str; str = gnc_scm_to_utf8_string (SCM_CAR(list)); if (str) glist = g_list_prepend (glist, str); } list = SCM_CDR (list); } return g_list_reverse (glist); } GSList * gnc_scm_to_gslist_string(SCM list) { GSList *gslist = NULL; while (!scm_is_null (list)) { if (scm_is_string(SCM_CAR(list))) { gchar * str; str = gnc_scm_to_utf8_string (SCM_CAR(list)); if (str) gslist = g_slist_prepend (gslist, str); } list = SCM_CDR (list); } return g_slist_reverse (gslist); } /******************************************************************** * gnc_glist_string_p ********************************************************************/ int gnc_glist_string_p(SCM list) { return scm_is_list(list); }