/* Parsing results */
CAMLprim value camltk_splitlist (value v)
{
int argc;
char **argv;
int result;
char *utf;
CheckInit();
utf = caml_string_to_tcl(v);
/* argv is allocated by Tcl, to be freed by us */
result = Tcl_SplitList(cltclinterp,utf,&argc,&argv);
switch(result) {
case TCL_OK:
{ value res = copy_string_list(argc,argv);
Tcl_Free((char *)argv); /* only one large block was allocated */
/* argv points into utf: utf must be freed after argv are freed */
stat_free( utf );
return res;
}
case TCL_ERROR:
default:
stat_free( utf );
tk_error(Tcl_GetStringResult(cltclinterp));
}
}
/***********************************************************************
* Allocate memory for a transfac motif
***********************************************************************/
TRANSFAC_MOTIF_T *new_transfac_motif(
const char *accession,
const char *id,
const char *name,
const char *description,
const char *consensus,
STRING_LIST_T *species_list,
MATRIX_T *counts
) {
TRANSFAC_MOTIF_T *motif = mm_malloc(sizeof(TRANSFAC_MOTIF_T));
motif->accession = NULL;
motif->id = NULL;
motif->name = NULL;
motif->description = NULL;
motif->species_list = NULL;
motif->consensus = NULL;
motif->counts = NULL;
copy_string(&motif->accession, accession);
copy_string(&motif->id, id);
copy_string(&motif->name, name);
copy_string(&motif->description, description);
copy_string(&motif->consensus, consensus);
if (species_list != NULL) {
motif->species_list = copy_string_list(species_list);
}
if (counts != NULL) {
motif->counts = duplicate_matrix(counts);
}
return motif;
}
GSList*
dir_all_subdirs (Dir* d, GError** err)
{
if (!dir_rescan_subdirs (d, err))
return NULL;
return copy_string_list (d->subdir_names);
}
XFontSet
XCreateFontSet (
Display *dpy,
_Xconst char *base_font_name_list,
char ***missing_charset_list,
int *missing_charset_count,
char **def_string)
{
XOM om;
XOC oc;
XOMCharSetList *list;
*missing_charset_list = NULL;
*missing_charset_count = 0;
om = XOpenOM(dpy, NULL, NULL, NULL);
if (om == NULL)
return (XFontSet) NULL;
if ((oc = XCreateOC(om, XNBaseFontName, base_font_name_list, NULL))) {
list = &oc->core.missing_list;
oc->core.om_automatic = True;
} else
list = &om->core.required_charset;
*missing_charset_list = copy_string_list(list->charset_list,
list->charset_count);
*missing_charset_count = list->charset_count;
if (list->charset_list && *missing_charset_list == NULL)
oc = NULL;
if (oc && def_string) {
*def_string = oc->core.default_string;
if (!*def_string)
*def_string = "";
}
if (oc == NULL)
XCloseOM(om);
return (XFontSet) oc;
}
/* The Tcl command for evaluating callback in OCaml */
int CamlCBCmd(ClientData clientdata, Tcl_Interp *interp,
int argc, CONST84 char **argv)
{
CheckInit();
/* Assumes no result */
Tcl_SetResult(interp, NULL, NULL);
if (argc >= 2) {
int id;
if (Tcl_GetInt(interp, argv[1], &id) != TCL_OK)
return TCL_ERROR;
callback2(*handler_code,Val_int(id),
copy_string_list(argc - 2,(char **)&argv[2]));
/* Never fails (OCaml would have raised an exception) */
/* but result may have been set by callback */
return TCL_OK;
}
else
return TCL_ERROR;
}
/* Parsing results */
value camltk_splitlist (value v) /* ML */
{
int argc;
char **argv;
int result;
CheckInit();
/* argv is allocated by Tcl, to be freed by us using Tcl_Free */
result = Tcl_SplitList(cltclinterp,String_val(v),&argc,&argv);
switch(result) {
case TCL_OK:
{ value res = copy_string_list(argc,argv);
Tcl_Free((char *)argv); /* only one large block was allocated */
return res;
}
case TCL_ERROR:
default:
tk_error(cltclinterp->result);
}
}
