"Fossies" - the Fresh Open Source Software Archive

Member "gretl-2020b/lib/src/gretl_func.c" (7 Apr 2020, 229389 Bytes) of package /linux/misc/gretl-2020b.tar.xz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) C and C++ source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "gretl_func.c" see the Fossies "Dox" file reference documentation and the last Fossies "Diffs" side-by-side code changes report: 2020a_vs_2020b.

    1 /*
    2  *  gretl -- Gnu Regression, Econometrics and Time-series Library
    3  *  Copyright (C) 2001 Allin Cottrell and Riccardo "Jack" Lucchetti
    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 3 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, see <http://www.gnu.org/licenses/>.
   17  *
   18  */
   19 
   20 #define FULL_XML_HEADERS
   21 
   22 #include "libgretl.h"
   23 #include "version.h"
   24 #include "monte_carlo.h"
   25 #include "gretl_func.h"
   26 #include "libset.h"
   27 #include "usermat.h"
   28 #include "gretl_xml.h"
   29 #include "cmd_private.h"
   30 #include "gretl_string_table.h"
   31 #include "gretl_typemap.h"
   32 #include "gretl_zip.h"
   33 #include "uservar.h"
   34 #include "flow_control.h"
   35 #include "system.h"
   36 #include "genparse.h"
   37 #include "genr_optim.h"
   38 
   39 #ifdef HAVE_MPI
   40 # include "gretl_mpi.h"
   41 #endif
   42 
   43 #include <errno.h>
   44 #include <glib.h>
   45 #include <glib/gstdio.h>
   46 
   47 #include <sys/types.h>
   48 #include <sys/stat.h>
   49 #include <fcntl.h>
   50 
   51 #define LSDEBUG 0
   52 
   53 #define FNPARSE_DEBUG 0 /* debug parsing of function code */
   54 #define EXEC_DEBUG 0    /* debugging of function execution */
   55 #define UDEBUG 0        /* debug handling of args */
   56 #define PKG_DEBUG 0     /* debug handling of function packages */
   57 #define FN_DEBUG 0      /* miscellaneous debugging */
   58 #define DDEBUG 0        /* debug the debugger */
   59 
   60 #define INT_USE_XLIST (-999)
   61 #define INT_USE_MYLIST (-777)
   62 
   63 typedef struct fn_param_ fn_param;
   64 typedef struct fn_arg_ fn_arg;
   65 typedef struct fn_line_ fn_line;
   66 typedef struct obsinfo_ obsinfo;
   67 
   68 /* structure representing a parameter of a user-defined function */
   69 
   70 struct fn_param_ {
   71     char *name;     /* the name of the parameter */
   72     char type;      /* its type */
   73     char *descrip;  /* its description */
   74     char **labels;  /* value labels, if applicable */
   75     int nlabels;    /* number of value labels */
   76     char flags;     /* additional information (e.g. "const" flag) */
   77     double deflt;   /* default value */
   78     double min;     /* minimum value (scalar parameters only) */
   79     double max;     /* maximum value (scalar parameters only) */
   80     double step;    /* step increment (scalars only) */
   81 };
   82 
   83 /* structure representing a line of a user-defined function */
   84 
   85 struct fn_line_ {
   86     int idx;        /* 1-based line index (allowing for blanks) */
   87     char *s;        /* text of command line */
   88     LOOPSET *loop;  /* attached "compiled" loop */
   89     int next_idx;   /* line index to skip to after loop */
   90     int ignore;     /* flag for comment lines */
   91 };
   92 
   93 #define UNSET_VALUE (-1.0e200)
   94 #define default_unset(p) (p->deflt == UNSET_VALUE)
   95 
   96 /* structure representing sample information at start of
   97    a function call */
   98 
   99 struct obsinfo_ {
  100     int structure;      /* time-series, etc. */
  101     int pd;             /* data frequency */
  102     int t1, t2;         /* starting and ending observations */
  103     int added;          /* number of observations added within function */
  104     char changed;       /* sample has been changed within the function call? */
  105     char stobs[OBSLEN]; /* string representation of starting obs */
  106 };
  107 
  108 /* structure representing a call to a user-defined function */
  109 
  110 struct fncall_ {
  111     ufunc *fun;    /* the function called */
  112     int argc;      /* argument count */
  113     int orig_v;    /* number of series defined on entry */
  114     fn_arg *args;  /* argument array */
  115     int *ptrvars;  /* list of pointer arguments */
  116     int *listvars; /* list of series included in a list argument */
  117     char *retname; /* name of return value (or dummy string) */
  118     int recursing; /* indicator for recursive call */
  119     obsinfo obs;   /* sample info */
  120 };
  121 
  122 /* structure representing a user-defined function */
  123 
  124 struct ufunc_ {
  125     char name[FN_NAMELEN]; /* identifier */
  126     fnpkg *pkg;            /* pointer to parent package, or NULL */
  127     int pkg_role;          /* printer, plotter, etc. */
  128     UfunAttrs flags;       /* private, plugin, etc. */
  129     int line_idx;          /* current line index (compiling) */
  130     int n_lines;           /* number of lines of code */
  131     fn_line *lines;        /* array of lines of code */
  132     int n_params;          /* number of parameters */
  133     fn_param *params;      /* parameter info array */
  134     int rettype;           /* return type (if any) */
  135     int debug;             /* are we debugging this function? */
  136 };
  137 
  138 /* structure representing a function package */
  139 
  140 struct fnpkg_ {
  141     char name[FN_NAMELEN]; /* package name */
  142     char *fname;      /* filename */
  143     char *author;     /* author's name */
  144     char *email;      /* author's email address */
  145     char *version;    /* package version string */
  146     char *date;       /* last revision date */
  147     char *descrip;    /* package description */
  148     char *help;       /* package help text */
  149     char *gui_help;   /* GUI-specific help (optional) */
  150     char *Rdeps;      /* R dependencies (if any) */
  151     char *sample;     /* sample caller script */
  152     char *help_fname;     /* filename: package help text */
  153     char *gui_help_fname; /* filename: GUI-specific help text */
  154     char *sample_fname;   /* filename: sample caller script */
  155     char *tags;       /* tag string(s) */
  156     char *label;      /* for use in GUI menus */
  157     char *mpath;      /* menu path in GUI */
  158     int minver;       /* minimum required gretl version */
  159     char uses_subdir; /* lives in subdirectory (0/1) */
  160     char prechecked;  /* already checked for data requirement */
  161     char data_access; /* wants access to full data range */
  162     DataReq dreq;     /* data requirement */
  163     int modelreq;     /* required model type, if applicable */
  164     ufunc **pub;      /* pointers to public interfaces */
  165     ufunc **priv;     /* pointers to private functions */
  166     int n_pub;        /* number of public functions */
  167     int n_priv;       /* number of private functions */
  168     char overrides;   /* number of overrides of built-in functions */
  169     char **datafiles; /* names of packaged data files */
  170     char **depends;   /* names of dependencies */
  171     char *provider;   /* name of "provider" package, if applicable */
  172     int n_files;      /* number of data files */
  173     int n_depends;    /* number of dependencies */
  174     void *editor;     /* for GUI use */
  175 };
  176 
  177 /* acceptable types for parameters of user-defined functions */
  178 
  179 #define ok_function_arg_type(t) (t == GRETL_TYPE_BOOL ||        \
  180                  t == GRETL_TYPE_INT ||         \
  181                  t == GRETL_TYPE_OBS ||         \
  182                  t == GRETL_TYPE_DOUBLE ||      \
  183                  t == GRETL_TYPE_SERIES ||      \
  184                  t == GRETL_TYPE_LIST ||        \
  185                  t == GRETL_TYPE_MATRIX ||      \
  186                  t == GRETL_TYPE_STRING ||      \
  187                  t == GRETL_TYPE_BUNDLE ||      \
  188                  t == GRETL_TYPE_SCALAR_REF ||      \
  189                  t == GRETL_TYPE_SERIES_REF ||      \
  190                  t == GRETL_TYPE_MATRIX_REF ||      \
  191                  t == GRETL_TYPE_BUNDLE_REF ||      \
  192                  t == GRETL_TYPE_STRING_REF ||      \
  193                  t == GRETL_TYPE_STRINGS ||     \
  194                  t == GRETL_TYPE_MATRICES ||        \
  195                  t == GRETL_TYPE_BUNDLES||      \
  196                  t == GRETL_TYPE_LISTS ||               \
  197                  t == GRETL_TYPE_ARRAYS ||      \
  198                  t == GRETL_TYPE_STRINGS_REF ||     \
  199                  t == GRETL_TYPE_MATRICES_REF ||    \
  200                              t == GRETL_TYPE_BUNDLES_REF ||         \
  201                              t == GRETL_TYPE_LISTS_REF ||           \
  202                  t == GRETL_TYPE_ARRAYS_REF)
  203 
  204 enum {
  205     ARG_OPTIONAL = 1 << 0,
  206     ARG_CONST    = 1 << 1,
  207     ARG_SHIFTED  = 1 << 2
  208 };
  209 
  210 /* structure representing an argument to a user-defined function */
  211 
  212 struct fn_arg_ {
  213     char type;            /* argument type */
  214     char flags;           /* ARG_OPTIONAL, ARG_CONST as appropriate */
  215     const char *name;     /* name as function param */
  216     const char *upname;   /* name of supplied arg at caller level */
  217     user_var *uvar;       /* reference to "parent", if any */
  218     union {
  219     int idnum;        /* named series arg (series ID) */
  220     double x;         /* scalar arg */
  221     double *px;       /* anonymous series arg */
  222     gretl_matrix *m;  /* matrix arg */
  223     char *str;        /* string arg */
  224     int *list;        /* list arg */
  225     gretl_bundle *b;  /* anonymous bundle pointer */
  226     gretl_array *a;   /* array argument */
  227     } val;
  228 };
  229 
  230 static int n_ufuns;         /* number of user-defined functions in memory */
  231 static ufunc **ufuns;       /* array of pointers to user-defined functions */
  232 static ufunc *current_fdef; /* pointer to function currently being defined */
  233 static GList *callstack;    /* stack of function calls */
  234 static int n_pkgs;          /* number of loaded function packages */
  235 static fnpkg **pkgs;        /* array of pointers to loaded packages */
  236 static fnpkg *current_pkg;  /* pointer to package currently being edited */
  237 
  238 static int function_package_record (fnpkg *pkg);
  239 static void function_package_free (fnpkg *pkg);
  240 static int load_function_package (const char *fname,
  241                   gretlopt opt,
  242                   GArray *pstack,
  243                   PRN *prn);
  244 
  245 /* record of state, and communication of state with outside world */
  246 
  247 static int compiling;    /* boolean: are we compiling a function currently? */
  248 static int fn_executing; /* depth of function call stack */
  249 static int compiling_python;
  250 #ifdef HAVE_MPI
  251 static char mpi_caller[FN_NAMELEN];
  252 #endif
  253 
  254 #define function_is_private(f)   (f->flags & UFUN_PRIVATE)
  255 #define function_is_plugin(f)    (f->flags & UFUN_PLUGIN)
  256 #define function_is_noprint(f)   (f->flags & UFUN_NOPRINT)
  257 #define function_is_menu_only(f) (f->flags & UFUN_MENU_ONLY)
  258 
  259 struct flag_and_key {
  260     int flag;
  261     const char *key;
  262 };
  263 
  264 static struct flag_and_key pkg_lookups[] = {
  265     { UFUN_BUNDLE_PRINT, BUNDLE_PRINT },
  266     { UFUN_BUNDLE_PLOT,  BUNDLE_PLOT },
  267     { UFUN_BUNDLE_TEST,  BUNDLE_TEST },
  268     { UFUN_BUNDLE_FCAST, BUNDLE_FCAST },
  269     { UFUN_BUNDLE_EXTRA, BUNDLE_EXTRA },
  270     { UFUN_GUI_MAIN,     GUI_MAIN },
  271     { UFUN_GUI_PRECHECK, GUI_PRECHECK },
  272     { UFUN_LIST_MAKER,   LIST_MAKER },
  273     { -1,                NULL }
  274 };
  275 
  276 #define pkg_aux_role(r) (r == UFUN_BUNDLE_PRINT || \
  277              r == UFUN_BUNDLE_PLOT ||  \
  278              r == UFUN_BUNDLE_TEST ||  \
  279              r == UFUN_BUNDLE_FCAST || \
  280              r == UFUN_BUNDLE_EXTRA)
  281 
  282 static int pkg_key_get_role (const char *key)
  283 {
  284     int i;
  285 
  286     if (key != NULL && *key != '\0') {
  287     for (i=0; pkg_lookups[i].flag > 0; i++) {
  288         if (!strcmp(key, pkg_lookups[i].key)) {
  289         return pkg_lookups[i].flag;
  290         }
  291     }
  292     }
  293 
  294     return UFUN_ROLE_NONE;
  295 }
  296 
  297 const char *package_role_get_key (int flag)
  298 {
  299     int i;
  300 
  301     for (i=0; pkg_lookups[i].flag > 0; i++) {
  302     if (flag == pkg_lookups[i].flag) {
  303         return pkg_lookups[i].key;
  304     }
  305     }
  306 
  307     return NULL;
  308 }
  309 
  310 static void set_function_private (ufunc *u, gboolean s)
  311 {
  312     if (s) {
  313     u->flags |= UFUN_PRIVATE;
  314     } else {
  315     u->flags &= ~UFUN_PRIVATE;
  316     }
  317 }
  318 
  319 int gretl_compiling_function (void)
  320 {
  321     return compiling;
  322 }
  323 
  324 int gretl_compiling_python (const char *line)
  325 {
  326     if (compiling_python) {
  327     char s1[4], s2[8];
  328 
  329     if (sscanf(line, "%3s %7s", s1, s2) == 2 &&
  330         !strcmp(s1, "end") && !strcmp(s2, "foreign")) {
  331         compiling_python = 0;
  332     }
  333     }
  334 
  335     return compiling_python;
  336 }
  337 
  338 static void set_compiling_on (void)
  339 {
  340     compiling = 1;
  341 }
  342 
  343 static void set_compiling_off (void)
  344 {
  345     compiling = compiling_python = 0;
  346 }
  347 
  348 int gretl_function_depth (void)
  349 {
  350     return fn_executing;
  351 }
  352 
  353 static void adjust_array_arg_type (fn_arg *arg)
  354 {
  355     GretlType t = gretl_array_get_type(arg->val.a);
  356 
  357     if (arg->type == GRETL_TYPE_ARRAY_REF) {
  358     arg->type = gretl_type_get_ref_type(t);
  359     } else {
  360     arg->type = t;
  361     }
  362 }
  363 
  364 static int fn_arg_set_data (fn_arg *arg, const char *name,
  365                 user_var *uvar, GretlType type,
  366                 void *p)
  367 {
  368     int err = 0;
  369 
  370     arg->type = type;
  371     arg->flags = 0;
  372     arg->name = NULL;
  373     arg->upname = name;
  374     arg->uvar = uvar;
  375 
  376     if (type == GRETL_TYPE_NONE) {
  377     arg->val.x = 0;
  378     } else if (type == GRETL_TYPE_DOUBLE ||
  379            type == GRETL_TYPE_SCALAR_REF) {
  380     arg->val.x = *(double *) p;
  381     } else if (type == GRETL_TYPE_INT ||
  382            type == GRETL_TYPE_OBS) {
  383     arg->val.x = *(int *) p;
  384     } else if (type == GRETL_TYPE_SERIES) {
  385     arg->val.px = (double *) p;
  386     } else if (type == GRETL_TYPE_MATRIX ||
  387            type == GRETL_TYPE_MATRIX_REF) {
  388     arg->val.m = (gretl_matrix *) p;
  389     } else if (type == GRETL_TYPE_STRING ||
  390            type == GRETL_TYPE_STRING_REF) {
  391     arg->val.str = (char *) p;
  392     } else if (type == GRETL_TYPE_LIST) {
  393     arg->val.list = (int *) p;
  394     } else if (type == GRETL_TYPE_SERIES_REF ||
  395            type == GRETL_TYPE_USERIES) {
  396     arg->val.idnum = *(int *) p;
  397     } else if (type == GRETL_TYPE_BUNDLE ||
  398            type == GRETL_TYPE_BUNDLE_REF) {
  399     arg->val.b = (gretl_bundle *) p;
  400     } else if (type == GRETL_TYPE_ARRAY ||
  401            type == GRETL_TYPE_ARRAY_REF) {
  402     arg->val.a = (gretl_array *) p;
  403     adjust_array_arg_type(arg);
  404     } else {
  405     err = E_TYPES;
  406     }
  407 
  408     return err;
  409 }
  410 
  411 static int fncall_add_args_array (fncall *fc)
  412 {
  413     int i, np = fc->fun->n_params;
  414     int err = 0;
  415 
  416     fc->args = malloc(np * sizeof *fc->args);
  417 
  418     if (fc->args == NULL) {
  419     err = E_ALLOC;
  420     } else {
  421     for (i=0; i<np; i++) {
  422         fc->args[i].type = 0;
  423         fc->args[i].flags = 0;
  424         fc->args[i].name = NULL;
  425         fc->args[i].upname = NULL;
  426         fc->args[i].uvar = NULL;
  427     }
  428     }
  429 
  430     return err;
  431 }
  432 
  433 /**
  434  * push_function_arg:
  435  * @fc: pointer to function call.
  436  * @name: name of variable (or NULL for anonymous).
  437  * @uvar: reference to user_var or NULL.
  438  * @type: type of argument to add.
  439  * @value: pointer to value to add.
  440  *
  441  * Writes a new argument of the specified type and value into the
  442  * argument array of @fc.
  443  *
  444  * Returns: 0 on success, non-zero on failure.
  445  */
  446 
  447 int push_function_arg (fncall *fc, const char *name,
  448                void *uvar, GretlType type,
  449                void *value)
  450 {
  451     int err = 0;
  452 
  453     if (fc == NULL || fc->fun == NULL) {
  454     err = E_DATA;
  455     } else if (fc->argc >= fc->fun->n_params) {
  456     fprintf(stderr, "function %s has %d parameters but argc = %d\n",
  457         fc->fun->name, fc->fun->n_params, fc->argc);
  458     err = E_DATA;
  459     } else if (fc->args == NULL) {
  460     err = fncall_add_args_array(fc);
  461     }
  462 
  463     if (!err) {
  464     err = fn_arg_set_data(&fc->args[fc->argc], name, uvar, type, value);
  465     fc->argc += 1;
  466     }
  467 
  468     return err;
  469 }
  470 
  471 /**
  472  * push_function_arg:
  473  * @fc: pointer to function call.
  474  * @type: type of argument to add.
  475  * @value: pointer to value to add.
  476  *
  477  * Writes a new argument of the specified type and value into the
  478  * argument array of @fc.
  479  *
  480  * Returns: 0 on success, non-zero on failure.
  481  */
  482 
  483 int push_anon_function_arg (fncall *fc, GretlType type,
  484                 void *value)
  485 {
  486     int err = 0;
  487 
  488     if (fc == NULL || fc->fun == NULL) {
  489     err = E_DATA;
  490     } else if (fc->argc >= fc->fun->n_params) {
  491     fprintf(stderr, "function %s has %d parameters but argc = %d\n",
  492         fc->fun->name, fc->fun->n_params, fc->argc);
  493     err = E_DATA;
  494     } else if (fc->args == NULL) {
  495     err = fncall_add_args_array(fc);
  496     }
  497 
  498     if (!err) {
  499     err = fn_arg_set_data(&fc->args[fc->argc], NULL, NULL, type, value);
  500     fc->argc += 1;
  501     }
  502 
  503     return err;
  504 }
  505 
  506 /**
  507  * push_function_args:
  508  * @fc: pointer to function call.
  509  *
  510  * Writes multiple entries into the argument array of @fc.
  511  * Each argument must be given in the form {type, value},
  512  * The list of entries must be terminated with -1.
  513  *
  514  * Returns: 0 on success, non-zero on failure.
  515  */
  516 
  517 int push_function_args (fncall *fc, ...)
  518 {
  519     va_list ap;
  520     int argtype;
  521     void *value;
  522     int i, err = 0;
  523 
  524     va_start(ap, fc);
  525     for (i=0; !err; i++) {
  526     argtype = va_arg(ap, int);
  527     if (argtype < 0) {
  528         /* reached the end of the args */
  529         break;
  530     }
  531     value = va_arg(ap, void *);
  532     err = push_function_arg(fc, NULL, NULL, argtype, value);
  533     }
  534     va_end(ap);
  535 
  536     return err;
  537 }
  538 
  539 fncall *fncall_new (ufunc *fun)
  540 {
  541     fncall *call = malloc(sizeof *call);
  542 
  543     if (call != NULL) {
  544     call->fun = fun;
  545     call->ptrvars = NULL;
  546     call->listvars = NULL;
  547     call->retname = NULL;
  548     call->argc = 0;
  549     call->args = NULL;
  550     call->recursing = 0;
  551     }
  552 
  553     return call;
  554 }
  555 
  556 void fncall_destroy (fncall *call)
  557 {
  558     if (call != NULL) {
  559     free(call->args);
  560     free(call->ptrvars);
  561     free(call->listvars);
  562     free(call->retname);
  563     free(call);
  564     }
  565 }
  566 
  567 /* Portmanteau function to get a caller struct for a
  568    function named @funcname from a function package
  569    named @pkgname. We first check if the specified package
  570    is already in memory; if not we try to find it in
  571    th local filesystem, and load it into memory if
  572    successful.
  573 
  574    If/once the package is in fact loaded we look up the
  575    specified function; and if that's successful we
  576    allocate a caller struct and return it.
  577 
  578    The @pkgpath argument can be given as NULL, but if
  579    the path to the package is known to the caller and
  580    is provided via this argument this will speed up the
  581    look-up in case the package is not already loaded.
  582 */
  583 
  584 fncall *get_pkg_function_call (const char *funcname,
  585                    const char *pkgname,
  586                    const char *pkgpath)
  587 {
  588     fncall *fc = NULL;
  589     ufunc *uf = NULL;
  590     fnpkg *pkg;
  591 
  592     /* is the package already loaded? */
  593     pkg = get_function_package_by_name(pkgname);
  594     if (pkg == NULL) {
  595     /* no, so look it up */
  596     int err = 0;
  597 
  598     if (pkgpath != NULL) {
  599         /* path was supplied by caller */
  600         pkg = get_function_package_by_filename(pkgpath, &err);
  601     } else {
  602         /* we need to search */
  603         char *mypath;
  604 
  605         mypath = gretl_function_package_get_path(pkgname, PKG_ALL);
  606         if (mypath != NULL) {
  607         pkg = get_function_package_by_filename(mypath, &err);
  608         free(mypath);
  609         }
  610     }
  611     }
  612 
  613     if (pkg != NULL) {
  614     uf = get_function_from_package(funcname, pkg);
  615     }
  616 
  617     if (uf == NULL) {
  618     gretl_errmsg_sprintf(_("Couldn't find function %s"), funcname);
  619     } else {
  620     fc = fncall_new(uf);
  621     }
  622 
  623     return fc;
  624 }
  625 
  626 static fnpkg *function_package_alloc (const char *fname)
  627 {
  628     fnpkg *pkg = malloc(sizeof *pkg);
  629 
  630     if (pkg == NULL) {
  631     return NULL;
  632     }
  633 
  634     pkg->fname = gretl_strdup(fname);
  635     if (pkg->fname == NULL) {
  636     free(pkg);
  637     return NULL;
  638     }
  639 
  640 #if PKG_DEBUG
  641     fprintf(stderr, "function_package_alloc: fname='%s'\n", fname);
  642 #endif
  643 
  644     pkg->name[0] = '\0';
  645     pkg->author = NULL;
  646     pkg->email = NULL;
  647     pkg->version = NULL;
  648     pkg->date = NULL;
  649     pkg->descrip = NULL;
  650     pkg->help = NULL;
  651     pkg->gui_help = NULL;
  652     pkg->Rdeps = NULL;
  653     pkg->sample = NULL;
  654     pkg->help_fname = NULL;
  655     pkg->gui_help_fname = NULL;
  656     pkg->sample_fname = NULL;
  657     pkg->tags = NULL;
  658     pkg->label = NULL;
  659     pkg->mpath = NULL;
  660     pkg->dreq = FN_NEEDS_DATA;
  661     pkg->modelreq = 0;
  662     pkg->minver = 0;
  663     pkg->uses_subdir = 0;
  664     pkg->prechecked = 0;
  665     pkg->data_access = 0;
  666 
  667     pkg->pub = pkg->priv = NULL;
  668     pkg->n_pub = pkg->n_priv = 0;
  669     pkg->overrides = 0;
  670     pkg->datafiles = NULL;
  671     pkg->n_files = 0;
  672     pkg->depends = NULL;
  673     pkg->n_depends = 0;
  674     pkg->provider = NULL;
  675     pkg->editor = NULL;
  676 
  677     return pkg;
  678 }
  679 
  680 /* For function call @call, set the 'listarg' status of any named
  681    series provided to the called function via list arguments.  This is
  682    required for correct handling of namespaces.
  683 */
  684 
  685 static void set_listargs_from_call (fncall *call, DATASET *dset)
  686 {
  687     int i, vi;
  688 
  689     if (dset == NULL) {
  690     return;
  691     }
  692 
  693     for (i=1; i<dset->v; i++) {
  694     series_unset_flag(dset, i, VAR_LISTARG);
  695     }
  696 
  697     if (call != NULL && call->listvars != NULL) {
  698     for (i=1; i<=call->listvars[0]; i++) {
  699         vi = call->listvars[i];
  700 #if UDEBUG
  701         fprintf(stderr, "setting listarg status on var %d (%s)\n",
  702             vi, dset->varname[vi]);
  703 #endif
  704         series_set_flag(dset, vi, VAR_LISTARG);
  705     }
  706     }
  707 }
  708 
  709 static void set_executing_off (fncall *call, DATASET *dset, PRN *prn)
  710 {
  711     int dbg = gretl_debugging_on();
  712     fncall *popcall = NULL;
  713 
  714     destroy_option_params_at_level(fn_executing);
  715     set_previous_depth(fn_executing);
  716     fn_executing--;
  717 
  718     callstack = g_list_remove(callstack, call);
  719 
  720 #if EXEC_DEBUG
  721     fprintf(stderr, "set_executing_off: removing call to %s, depth now %d\n",
  722         call->fun->name, g_list_length(callstack));
  723 #endif
  724 
  725     if (dbg) {
  726     pputs(prn, "*** ");
  727     bufspace(gretl_function_depth(), prn);
  728     pprintf(prn, "exiting function %s, ", call->fun->name);
  729     }
  730 
  731     fncall_destroy(call);
  732 
  733     if (fn_executing > 0) {
  734     GList *tmp = g_list_last(callstack);
  735 
  736     popcall = tmp->data;
  737     } else {
  738     g_list_free(callstack);
  739     callstack = NULL;
  740     gretl_insert_builtin_string("pkgdir", NULL);
  741     }
  742 
  743     if (dset != NULL) {
  744     set_listargs_from_call(popcall, dset);
  745     }
  746 
  747     if (popcall == NULL) {
  748     /* returning to main */
  749     switch_uservar_hash(0);
  750     if (dset != NULL) {
  751         series_ensure_level_zero(dset);
  752     }
  753     }
  754 
  755     if (dbg) {
  756     if (popcall != NULL) {
  757         pprintf(prn, "returning to %s\n", popcall->fun->name);
  758     } else {
  759         pputs(prn, "returning to main\n");
  760     }
  761     }
  762 }
  763 
  764 /**
  765  * n_user_functions:
  766  *
  767  * Returns: the number of hansl functions currently loaded in memory.
  768  */
  769 
  770 int n_user_functions (void)
  771 {
  772     return n_ufuns;
  773 }
  774 
  775 /**
  776  * n_free_functions:
  777  *
  778  * Returns: the number of functions loaded in memory
  779  * that are not currently attached to any function package,
  780  * and are therefore available for packaging.
  781  */
  782 
  783 int n_free_functions (void)
  784 {
  785     int i, n = 0;
  786 
  787     for (i=0; i<n_ufuns; i++) {
  788     if (ufuns[i]->pkg == NULL) {
  789         n++;
  790     }
  791     }
  792 
  793     return n;
  794 }
  795 
  796 /**
  797  * get_user_function_by_index:
  798  * @idx: index number.
  799  *
  800  * Returns: pointer to the user-function that currently
  801  * occupies (0-based) slot @idx in the array of loaded
  802  * functions, or %NULL if @idx is out of bounds.
  803  */
  804 
  805 const ufunc *get_user_function_by_index (int idx)
  806 {
  807     return (idx < 0 || idx >= n_ufuns)? NULL : ufuns[idx];
  808 }
  809 
  810 /**
  811  * fn_n_params:
  812  * @fun: pointer to user-function.
  813  *
  814  * Returns: the number of parameters associated with @fun.
  815  */
  816 
  817 int fn_n_params (const ufunc *fun)
  818 {
  819     return fun->n_params;
  820 }
  821 
  822 /**
  823  * fn_param_type:
  824  * @fun: pointer to user-function.
  825  * @i: 0-based parameter index.
  826  *
  827  * Returns: the type of parameter @i of function
  828  * @fun.
  829  */
  830 
  831 int fn_param_type (const ufunc *fun, int i)
  832 {
  833     return (i < 0 || i >= fun->n_params)? 0 :
  834     fun->params[i].type;
  835 }
  836 
  837 /**
  838  * fn_param_name:
  839  * @fun: pointer to user-function.
  840  * @i: 0-based parameter index.
  841  *
  842  * Returns: the name of parameter @i of function
  843  * @fun.
  844  */
  845 
  846 const char *fn_param_name (const ufunc *fun, int i)
  847 {
  848     return (i < 0 || i >= fun->n_params)? NULL :
  849     fun->params[i].name;
  850 }
  851 
  852 /**
  853  * fn_param_descrip:
  854  * @fun: pointer to user-function.
  855  * @i: 0-based parameter index.
  856  *
  857  * Returns: the description of parameter @i of function
  858  * @fun (if any), otherwise %NULL.
  859  */
  860 
  861 const char *fn_param_descrip (const ufunc *fun, int i)
  862 {
  863     return (i < 0 || i >= fun->n_params)? NULL :
  864     fun->params[i].descrip;
  865 }
  866 
  867 /**
  868  * fn_param_value_labels:
  869  * @fun: pointer to user-function.
  870  * @i: 0-based parameter index.
  871  * @n: location to receive number of labels.
  872  *
  873  * Returns: the value-labels associated with parameter @i
  874  * of function @fun (if any), otherwise %NULL.
  875  */
  876 
  877 const char **fn_param_value_labels (const ufunc *fun, int i,
  878                     int *n)
  879 {
  880     if (i >= 0 && i < fun->n_params) {
  881     *n = fun->params[i].nlabels;
  882     return (const char **) fun->params[i].labels;
  883     } else {
  884     *n = 0;
  885     return NULL;
  886     }
  887 }
  888 
  889 /**
  890  * fn_param_has_default:
  891  * @fun: pointer to user-function.
  892  * @i: 0-based parameter index.
  893  *
  894  * Returns: 1 if the (scalar) parameter @i of function @fun
  895  * (if any) has a default value set, otherwise 0.
  896  */
  897 
  898 int fn_param_has_default (const ufunc *fun, int i)
  899 {
  900     if (i < 0 || i >= fun->n_params) {
  901     return 0;
  902     } else {
  903     fn_param *fp = &fun->params[i];
  904 
  905     return !default_unset(fp);
  906     }
  907 }
  908 
  909 /**
  910  * fn_param_default:
  911  * @fun: pointer to user-function.
  912  * @i: 0-based parameter index.
  913  *
  914  * Returns: the default value of (scalar) parameter @i of
  915  * function @fun (if any), otherwise #NADBL.
  916  */
  917 
  918 double fn_param_default (const ufunc *fun, int i)
  919 {
  920     if (i < 0 || i >= fun->n_params) {
  921     return NADBL;
  922     } else {
  923     fn_param *fp = &fun->params[i];
  924 
  925     return default_unset(fp)? NADBL : fp->deflt;
  926     }
  927 }
  928 
  929 /**
  930  * fn_param_minval:
  931  * @fun: pointer to user-function.
  932  * @i: 0-based parameter index.
  933  *
  934  * Returns: the minimum value of (scalar) parameter @i of
  935  * function @fun (if any), otherwise #NADBL.
  936  */
  937 
  938 double fn_param_minval (const ufunc *fun, int i)
  939 {
  940     return (i < 0 || i >= fun->n_params)? NADBL :
  941     fun->params[i].min;
  942 }
  943 
  944 /**
  945  * fn_param_maxval:
  946  * @fun: pointer to user-function.
  947  * @i: 0-based parameter index.
  948  *
  949  * Returns: the maximum value of (scalar) parameter @i of
  950  * function @fun (if any), otherwise #NADBL.
  951  */
  952 
  953 double fn_param_maxval (const ufunc *fun, int i)
  954 {
  955     return (i < 0 || i >= fun->n_params)? NADBL :
  956     fun->params[i].max;
  957 }
  958 
  959 /**
  960  * fn_param_step:
  961  * @fun: pointer to user-function.
  962  * @i: 0-based parameter index.
  963  *
  964  * Returns: the step value for (scalar) parameter @i of
  965  * function @fun (if any), otherwise #NADBL.
  966  */
  967 
  968 double fn_param_step (const ufunc *fun, int i)
  969 {
  970     return (i < 0 || i >= fun->n_params)? NADBL :
  971     fun->params[i].step;
  972 }
  973 
  974 static int arg_may_be_optional (GretlType t)
  975 {
  976     return gretl_ref_type(t) || gretl_is_array_type(t) ||
  977     t == GRETL_TYPE_SERIES ||
  978     t == GRETL_TYPE_MATRIX ||
  979     t == GRETL_TYPE_BUNDLE ||
  980     t == GRETL_TYPE_LIST ||
  981     t == GRETL_TYPE_STRING;
  982 }
  983 
  984 /**
  985  * fn_param_optional:
  986  * @fun: pointer to user-function.
  987  * @i: 0-based parameter index.
  988  *
  989  * Returns: 1 if parameter @i of function @fun is optional,
  990  * otherwise 0.
  991  */
  992 
  993 int fn_param_optional (const ufunc *fun, int i)
  994 {
  995     if (i < 0 || i >= fun->n_params) {
  996     return 0;
  997     }
  998 
  999     return arg_may_be_optional(fun->params[i].type) &&
 1000     (fun->params[i].flags & ARG_OPTIONAL);
 1001 }
 1002 
 1003 /**
 1004  * fn_param_uses_xlist:
 1005  * @fun: pointer to user-function.
 1006  * @i: 0-based parameter index.
 1007  *
 1008  * Returns: 1 if parameter @i of function @fun is
 1009  * designed to select an integer based on a gretl
 1010  * model's list of regressors, otherwise 0.
 1011  */
 1012 
 1013 int fn_param_uses_xlist (const ufunc *fun, int i)
 1014 {
 1015     if (i < 0 || i >= fun->n_params) {
 1016     return 0;
 1017     }
 1018 
 1019     return (fun->params[i].type == GRETL_TYPE_INT &&
 1020         fun->params[i].deflt == INT_USE_XLIST);
 1021 }
 1022 
 1023 /**
 1024  * fn_param_uses_mylist:
 1025  * @fun: pointer to user-function.
 1026  * @i: 0-based parameter index.
 1027  *
 1028  * Returns: 1 if parameter @i of function @fun is
 1029  * designed to select an integer based on a custom
 1030  * list, constructed by the function, otherwise 0.
 1031  */
 1032 
 1033 int fn_param_uses_mylist (const ufunc *fun, int i)
 1034 {
 1035     if (i < 0 || i >= fun->n_params) {
 1036     return 0;
 1037     }
 1038 
 1039     return (fun->params[i].type == GRETL_TYPE_INT &&
 1040         fun->params[i].deflt == INT_USE_MYLIST);
 1041 }
 1042 
 1043 /**
 1044  * user_func_get_return_type:
 1045  * @fun: pointer to user-function.
 1046  *
 1047  * Returns: the return type of function @fun.
 1048  */
 1049 
 1050 int user_func_get_return_type (const ufunc *fun)
 1051 {
 1052     if (fun == NULL) {
 1053     return GRETL_TYPE_NONE;
 1054     } else {
 1055     return fun->rettype;
 1056     }
 1057 }
 1058 
 1059 /**
 1060  * user_func_is_noprint:
 1061  * @fun: pointer to user-function.
 1062  *
 1063  * Returns: 1 if the function is not designed to print anything.
 1064  */
 1065 
 1066 int user_func_is_noprint (const ufunc *fun)
 1067 {
 1068     if (fun == NULL) {
 1069     return 0;
 1070     } else {
 1071     return function_is_noprint(fun);
 1072     }
 1073 }
 1074 
 1075 /**
 1076  * user_func_is_menu_only:
 1077  * @fun: pointer to user-function.
 1078  *
 1079  * Returns: 1 if the function is not designed to be called
 1080  * other than via a GUI menu.
 1081  */
 1082 
 1083 int user_func_is_menu_only (const ufunc *fun)
 1084 {
 1085     if (fun == NULL) {
 1086     return 0;
 1087     } else {
 1088     return function_is_menu_only(fun);
 1089     }
 1090 }
 1091 
 1092 /**
 1093  * user_function_name_by_index:
 1094  * @i: the position of a user-function in the array of
 1095  * loaded functions.
 1096  *
 1097  * Returns: the name of the function, or %NULL if
 1098  * @i is out of bounds.
 1099  */
 1100 
 1101 const char *user_function_name_by_index (int i)
 1102 {
 1103     if (i >= 0 && i < n_ufuns) {
 1104     return ufuns[i]->name;
 1105     } else {
 1106     return NULL;
 1107     }
 1108 }
 1109 
 1110 /**
 1111  * user_function_index_by_name:
 1112  * @name: function name.
 1113  * @pkg: reference function package, or NULL.
 1114  *
 1115  * Looks up the 0-based index of the named function
 1116  * in the current array of user-functions. If @pkg is
 1117  * non-NULL the search for @name is confined to functions
 1118  * that belong to @pkg; otherwise the index of the first
 1119  * match is returned.
 1120  *
 1121  * Returns: 0-based index or -1 on failure.
 1122  */
 1123 
 1124 int user_function_index_by_name (const char *name,
 1125                  fnpkg *pkg)
 1126 {
 1127     int i;
 1128 
 1129     for (i=0; i<n_ufuns; i++) {
 1130     if ((pkg == NULL || ufuns[i]->pkg == pkg) &&
 1131         !strcmp(name, ufuns[i]->name)) {
 1132         return i;
 1133     }
 1134     }
 1135 
 1136     return -1;
 1137 }
 1138 
 1139 static int fname_idx;
 1140 
 1141 void function_names_init (void)
 1142 {
 1143     fname_idx = 0;
 1144 }
 1145 
 1146 /* Apparatus used in the GUI selector for composing a new function
 1147    package, or editing an existing one.  In the first case we want a
 1148    list of names of currently unpackaged functions (and the @pkg
 1149    argument should be NULL); in the second the list should include
 1150    both unpackaged functions and those belonging to the package
 1151    in question (specified via the @pkg arg).
 1152 
 1153    The caller should first invoke function_names_init(), then keep
 1154    calling next_available_function_name() until it returns %NULL. The
 1155    pointer argument @idxp provides a means to grab the "index number"
 1156    (position in the current functions array) corresponding to the
 1157    returned function name.
 1158 */
 1159 
 1160 const char *next_available_function_name (fnpkg *pkg, int *idxp)
 1161 {
 1162     const char *ret = NULL;
 1163     ufunc *fun;
 1164 
 1165     if (n_ufuns == 0) {
 1166     fname_idx = 0;
 1167     return NULL;
 1168     }
 1169 
 1170     while (fname_idx < n_ufuns) {
 1171     fun = ufuns[fname_idx++];
 1172     if (fun->pkg == NULL || fun->pkg == pkg) {
 1173         ret = fun->name;
 1174         *idxp = fname_idx - 1;
 1175         break;
 1176     }
 1177     }
 1178 
 1179     return ret;
 1180 }
 1181 
 1182 /* end GUI function-name apparatus */
 1183 
 1184 static fncall *current_function_call (void)
 1185 {
 1186     if (callstack != NULL) {
 1187     GList *tmp = g_list_last(callstack);
 1188 
 1189     return tmp->data;
 1190     } else {
 1191     return NULL;
 1192     }
 1193 }
 1194 
 1195 static ufunc *currently_called_function (void)
 1196 {
 1197     fncall *call = current_function_call();
 1198 
 1199     return (call != NULL)? call->fun : NULL;
 1200 }
 1201 
 1202 void current_function_info (char const **funcname,
 1203                 char const **pkgname)
 1204 {
 1205     ufunc *u = currently_called_function();
 1206 
 1207     if (u != NULL) {
 1208     if (funcname != NULL) {
 1209         *funcname = u->name;
 1210     }
 1211     if (pkgname != NULL && u->pkg != NULL) {
 1212         *pkgname = u->pkg->name;
 1213     }
 1214     }
 1215 }
 1216 
 1217 fnpkg *get_active_function_package (gretlopt opt)
 1218 {
 1219     ufunc *u = currently_called_function();
 1220 
 1221     if (u != NULL && u->pkg != NULL) {
 1222     if (opt == OPT_NONE) {
 1223         return u->pkg;
 1224     } else if ((opt & OPT_O) && u->pkg->overrides) {
 1225         /* in this case we're only interested if the
 1226            package overrides any built-in functions
 1227         */
 1228         return u->pkg;
 1229     }
 1230     }
 1231 
 1232     return NULL;
 1233 }
 1234 
 1235 fnpkg *gretl_function_get_package (const ufunc *fun)
 1236 {
 1237     return fun == NULL ? NULL : fun->pkg;
 1238 }
 1239 
 1240 /* see if a function is currently employed in the call stack */
 1241 
 1242 static int function_in_use (ufunc *fun)
 1243 {
 1244     GList *tmp = callstack;
 1245     fncall *call;
 1246 
 1247     while (tmp != NULL) {
 1248     call = tmp->data;
 1249     if (fun == call->fun) {
 1250         return 1;
 1251     }
 1252     tmp = tmp->next;
 1253     }
 1254 
 1255     return 0;
 1256 }
 1257 
 1258 int gretl_function_recursing (void)
 1259 {
 1260     if (callstack != NULL) {
 1261     GList *tmp = g_list_last(callstack);
 1262     fncall *call = tmp->data;
 1263 
 1264     return call->recursing;
 1265     } else {
 1266     return 0;
 1267     }
 1268 }
 1269 
 1270 #ifdef HAVE_MPI
 1271 
 1272 static fnpkg *find_caller_package (const char *name)
 1273 {
 1274     fnpkg *pkg = NULL;
 1275     int i;
 1276 
 1277     for (i=0; i<n_ufuns; i++) {
 1278     if (!strcmp(name, ufuns[i]->name)) {
 1279         if (ufuns[i]->pkg != NULL) {
 1280         ufuns[i]->pkg->prechecked = 1;
 1281         pkg = ufuns[i]->pkg;
 1282         }
 1283         break;
 1284     }
 1285     }
 1286 
 1287     return pkg;
 1288 }
 1289 
 1290 #endif
 1291 
 1292 /**
 1293  * get_user_function_by_name:
 1294  * @name: name to test.
 1295  *
 1296  * Returns: pointer to a user-function, if there exists a
 1297  * function of the given name and it is accessible in
 1298  * context (i.e. it's not private to a package other than
 1299  * the one that's currently active, if any), otherwise
 1300  * %NULL.
 1301  */
 1302 
 1303 ufunc *get_user_function_by_name (const char *name)
 1304 {
 1305     fnpkg *pkg = current_pkg;
 1306     ufunc *fun = NULL;
 1307     int i;
 1308 
 1309     if (n_ufuns == 0) {
 1310     return NULL;
 1311     }
 1312 
 1313     if (pkg == NULL) {
 1314     fun = currently_called_function();
 1315     if (fun != NULL) {
 1316         pkg = fun->pkg;
 1317         fun = NULL;
 1318     }
 1319     }
 1320 
 1321 #ifdef HAVE_MPI
 1322     if (pkg == NULL && *mpi_caller != '\0') {
 1323     pkg = find_caller_package(mpi_caller);
 1324     }
 1325 #endif
 1326 
 1327     if (pkg != NULL) {
 1328     /* There's an active function package: try first
 1329        for functions that belong to the package.
 1330     */
 1331     for (i=0; i<pkg->n_pub; i++) {
 1332         /* public members */
 1333         if (!strcmp(name, pkg->pub[i]->name)) {
 1334         fun = pkg->pub[i];
 1335         break;
 1336         }
 1337     }
 1338     if (fun == NULL) {
 1339         /* private members */
 1340         for (i=0; i<pkg->n_priv; i++) {
 1341         if (!strcmp(name, pkg->priv[i]->name)) {
 1342             fun = pkg->priv[i];
 1343             break;
 1344         }
 1345         }
 1346     }
 1347     if (fun == NULL && pkg->provider != NULL) {
 1348         /* functions shared by provider */
 1349         fnpkg *ppkg = get_function_package_by_name(pkg->provider);
 1350 
 1351         if (ppkg != NULL) {
 1352         for (i=0; i<ppkg->n_priv; i++) {
 1353             if (!strcmp(name, ppkg->priv[i]->name)) {
 1354             fun = ppkg->priv[i];
 1355             break;
 1356             }
 1357         }
 1358         }
 1359     }
 1360     }
 1361 
 1362     if (fun == NULL) {
 1363     /* Match any non-private function */
 1364     for (i=0; i<n_ufuns; i++) {
 1365         if (!function_is_private(ufuns[i]) &&
 1366         !strcmp(name, ufuns[i]->name)) {
 1367         fun = ufuns[i];
 1368         break;
 1369         }
 1370     }
 1371     }
 1372 
 1373 #if FN_DEBUG > 1
 1374     if (fun != NULL) {
 1375     fprintf(stderr, "get_user_function_by_name: name = '%s' (n_ufuns = %d);"
 1376         " found match\n", name, n_ufuns);
 1377     }
 1378 #endif
 1379 
 1380     return fun;
 1381 }
 1382 
 1383 /**
 1384  * get_function_from_package:
 1385  * @funname: name of function to retrieve.
 1386  * @pkg: function package.
 1387  *
 1388  * Returns: pointer to a user-function, if there exists a
 1389  * function of the given @funname that is associated with
 1390  * function package @pkg, otherwise NULL.  This is used
 1391  * in the gretl function package editor.
 1392  */
 1393 
 1394 ufunc *get_function_from_package (const char *funname, fnpkg *pkg)
 1395 {
 1396     int i;
 1397 
 1398     for (i=0; i<n_ufuns; i++) {
 1399     if (ufuns[i]->pkg == pkg &&
 1400         !strcmp(funname, ufuns[i]->name)) {
 1401         return ufuns[i];
 1402     }
 1403     }
 1404 
 1405     return NULL;
 1406 }
 1407 
 1408 /* allocate and initialize a new array of @n parameters */
 1409 
 1410 static fn_param *allocate_params (int n)
 1411 {
 1412     fn_param *params;
 1413     int i;
 1414 
 1415     params = malloc(n * sizeof *params);
 1416     if (params == NULL) {
 1417     return NULL;
 1418     }
 1419 
 1420     for (i=0; i<n; i++) {
 1421     params[i].name = NULL;
 1422     params[i].type = 0;
 1423     params[i].descrip = NULL;
 1424     params[i].labels = NULL;
 1425     params[i].nlabels = 0;
 1426     params[i].flags = 0;
 1427     params[i].deflt = UNSET_VALUE;
 1428     params[i].min = NADBL;
 1429     params[i].max = NADBL;
 1430     params[i].step = NADBL;
 1431     }
 1432 
 1433     return params;
 1434 }
 1435 
 1436 static ufunc *ufunc_new (void)
 1437 {
 1438     ufunc *fun = malloc(sizeof *fun);
 1439 
 1440     if (fun == NULL) {
 1441     return NULL;
 1442     }
 1443 
 1444     fun->name[0] = '\0';
 1445     fun->pkg = NULL;
 1446     fun->flags = 0;
 1447     fun->pkg_role = 0;
 1448 
 1449     fun->n_lines = 0;
 1450     fun->line_idx = 1;
 1451     fun->lines = NULL;
 1452 
 1453     fun->n_params = 0;
 1454     fun->params = NULL;
 1455 
 1456     fun->rettype = GRETL_TYPE_NONE;
 1457 
 1458     fun->debug = 0;
 1459 
 1460     return fun;
 1461 }
 1462 
 1463 static void free_lines_array (fn_line *lines, int n)
 1464 {
 1465     int i;
 1466 
 1467     if (lines == NULL) return;
 1468 
 1469     for (i=0; i<n; i++) {
 1470     free(lines[i].s);
 1471     if (lines[i].loop != NULL) {
 1472         gretl_loop_destroy(lines[i].loop);
 1473     }
 1474     }
 1475 
 1476     free(lines);
 1477 }
 1478 
 1479 static void free_params_array (fn_param *params, int n)
 1480 {
 1481     int i;
 1482 
 1483     if (params == NULL) return;
 1484 
 1485     for (i=0; i<n; i++) {
 1486     free(params[i].name);
 1487     free(params[i].descrip);
 1488     strings_array_free(params[i].labels, params[i].nlabels);
 1489     }
 1490     free(params);
 1491 }
 1492 
 1493 static void clear_ufunc_data (ufunc *fun)
 1494 {
 1495     free_lines_array(fun->lines, fun->n_lines);
 1496     free_params_array(fun->params, fun->n_params);
 1497 
 1498     fun->lines = NULL;
 1499     fun->params = NULL;
 1500 
 1501     fun->n_lines = 0;
 1502     fun->line_idx = 1;
 1503     fun->n_params = 0;
 1504 
 1505     fun->rettype = GRETL_TYPE_NONE;
 1506 }
 1507 
 1508 static void ufunc_free (ufunc *fun)
 1509 {
 1510     free_lines_array(fun->lines, fun->n_lines);
 1511     free_params_array(fun->params, fun->n_params);
 1512     free(fun);
 1513 }
 1514 
 1515 static int add_allocated_ufunc (ufunc *fun)
 1516 {
 1517     int nf = n_ufuns;
 1518     ufunc **myfuns;
 1519 
 1520     myfuns = realloc(ufuns, (nf + 1) * sizeof *myfuns);
 1521 
 1522     if (myfuns == NULL) {
 1523     return E_ALLOC;
 1524     }
 1525 
 1526     ufuns = myfuns;
 1527     ufuns[nf] = fun;
 1528     n_ufuns++;
 1529 
 1530 #if PKG_DEBUG
 1531     fprintf(stderr, "add_allocated_ufunc: name '%s', n_ufuns = %d\n",
 1532         fun->name, n_ufuns);
 1533 #endif
 1534 
 1535     return 0;
 1536 }
 1537 
 1538 static ufunc *add_ufunc (const char *fname)
 1539 {
 1540     ufunc *fun = ufunc_new();
 1541 
 1542 #if FN_DEBUG
 1543     fprintf(stderr, "add_ufunc: '%s'\n", fname);
 1544 #endif
 1545 
 1546     if (fun != NULL) {
 1547     strncat(fun->name, fname, FN_NAMELEN - 1);
 1548     if (add_allocated_ufunc(fun)) {
 1549         ufunc_free(fun);
 1550         fun = NULL;
 1551     }
 1552     }
 1553 
 1554     return fun;
 1555 }
 1556 
 1557 static int no_scalar_default (fn_param *fp)
 1558 {
 1559     int ret = 0;
 1560 
 1561     if (default_unset(fp)) {
 1562     ret = 1;
 1563     } else if (fp->type != GRETL_TYPE_DOUBLE && na(fp->deflt)) {
 1564     ret = 1;
 1565     }
 1566 
 1567     return ret;
 1568 }
 1569 
 1570 /* handling of XML function packages */
 1571 
 1572 enum {
 1573     FUNCS_INFO,
 1574     FUNCS_LOAD,
 1575     FUNCS_CODE,
 1576     FUNCS_SAMPLE,
 1577     FUNCS_HELP,
 1578     FUNCS_QUERY
 1579 };
 1580 
 1581 static const char *arg_type_xml_string (int t)
 1582 {
 1583     if (t == GRETL_TYPE_SCALAR_REF) {
 1584     return "scalarref";
 1585     } else if (t == GRETL_TYPE_SERIES_REF) {
 1586     return "seriesref";
 1587     } else if (t == GRETL_TYPE_MATRIX_REF) {
 1588     return "matrixref";
 1589     } else if (t == GRETL_TYPE_BUNDLE_REF) {
 1590     return "bundleref";
 1591     } else if (t == GRETL_TYPE_STRING_REF) {
 1592     return "stringref";
 1593     } else if (t == GRETL_TYPE_STRINGS_REF) {
 1594     return "stringsref";
 1595     } else if (t == GRETL_TYPE_MATRICES_REF) {
 1596     return "matricesref";
 1597     } else if (t == GRETL_TYPE_BUNDLES_REF) {
 1598     return "bundlesref";
 1599     } else if (t == GRETL_TYPE_LISTS_REF) {
 1600     return "listsref"; /* not actually allowed */
 1601     } else {
 1602     return gretl_type_get_name(t);
 1603     }
 1604 }
 1605 
 1606 static GretlType return_type_from_string (const char *s,
 1607                       int *err)
 1608 {
 1609     GretlType t;
 1610 
 1611     if (!strcmp(s, "void")) {
 1612     /* not OK as arg type, but OK as return */
 1613     t = GRETL_TYPE_VOID;
 1614     } else {
 1615     t = gretl_type_from_string(s);
 1616     }
 1617 
 1618     if (!ok_function_return_type(t)) {
 1619     if (*s == '\0') {
 1620         gretl_errmsg_sprintf(_("Missing function return type"));
 1621     } else if (t == GRETL_TYPE_NONE) {
 1622         gretl_errmsg_sprintf(_("Expected a function return type, found '%s'"),
 1623                  s);
 1624     } else {
 1625         gretl_errmsg_sprintf(_("%s: invalid return type for function"),
 1626                  s);
 1627     }
 1628     *err = E_TYPES;
 1629     }
 1630 
 1631     return t;
 1632 }
 1633 
 1634 static GretlType param_field_to_type (const char *s,
 1635                       const char *funname,
 1636                       int *err)
 1637 {
 1638     GretlType t = gretl_type_from_string(s);
 1639 
 1640     if (!ok_function_arg_type(t)) {
 1641     gretl_errmsg_sprintf("function %s: invalid parameter type '%s'",
 1642                  funname, s);
 1643     *err = E_INVARG;
 1644     }
 1645 
 1646     return t;
 1647 }
 1648 
 1649 /* read the parameter info for a function from XML file */
 1650 
 1651 static int func_read_params (xmlNodePtr node, xmlDocPtr doc,
 1652                  ufunc *fun)
 1653 {
 1654     xmlNodePtr cur;
 1655     char *field;
 1656     int n, err = 0;
 1657 
 1658     if (!gretl_xml_get_prop_as_int(node, "count", &n) || n < 0) {
 1659     fprintf(stderr, "Couldn't read param count\n");
 1660     return E_DATA;
 1661     }
 1662 
 1663     if (n == 0) {
 1664     return 0;
 1665     }
 1666 
 1667     fun->params = allocate_params(n);
 1668     if (fun->params == NULL) {
 1669     return E_ALLOC;
 1670     }
 1671 
 1672     fun->n_params = n;
 1673 
 1674     gretl_push_c_numeric_locale();
 1675 
 1676     cur = node->xmlChildrenNode;
 1677     n = 0;
 1678 
 1679     while (cur != NULL && !err) {
 1680     if (!xmlStrcmp(cur->name, (XUC) "param")) {
 1681         fn_param *param = &fun->params[n++];
 1682 
 1683         if (gretl_xml_get_prop_as_string(cur, "name", &field)) {
 1684         param->name = field;
 1685         } else {
 1686         err = E_DATA;
 1687         break;
 1688         }
 1689         if (gretl_xml_get_prop_as_string(cur, "type", &field)) {
 1690         param->type = param_field_to_type(field, fun->name, &err);
 1691         free(field);
 1692         if (gretl_scalar_type(param->type)) {
 1693             double x;
 1694 
 1695             if (gretl_xml_get_prop_as_double(cur, "default", &x)) {
 1696             param->deflt = x;
 1697             } else {
 1698             param->deflt = UNSET_VALUE;
 1699             }
 1700             if (param->type != GRETL_TYPE_BOOL) {
 1701             gretl_xml_get_prop_as_double(cur, "min", &param->min);
 1702             gretl_xml_get_prop_as_double(cur, "max", &param->max);
 1703             gretl_xml_get_prop_as_double(cur, "step", &param->step);
 1704             }
 1705         }
 1706         if (gretl_xml_get_prop_as_bool(cur, "optional")) {
 1707             param->flags |= ARG_OPTIONAL;
 1708         }
 1709         if (gretl_xml_get_prop_as_bool(cur, "const")) {
 1710             param->flags |= ARG_CONST;
 1711         }
 1712         } else {
 1713         err = E_DATA;
 1714         break;
 1715         }
 1716         gretl_xml_child_get_string(cur, doc, "description",
 1717                        &param->descrip);
 1718         gretl_xml_child_get_strings_array(cur, doc, "labels",
 1719                           &param->labels,
 1720                           &param->nlabels);
 1721     }
 1722     cur = cur->next;
 1723     }
 1724 
 1725     gretl_pop_c_numeric_locale();
 1726 
 1727     if (!err && n != fun->n_params) {
 1728     err = E_DATA;
 1729     }
 1730 
 1731     return err;
 1732 }
 1733 
 1734 static int push_function_line (ufunc *fun, char *s, int donate)
 1735 {
 1736     int err = 0;
 1737 
 1738     if (string_is_blank(s)) {
 1739     fun->line_idx += 1;
 1740     } else {
 1741     fn_line *lines;
 1742     int n = fun->n_lines + 1;
 1743 
 1744     lines = realloc(fun->lines, n * sizeof *lines);
 1745 
 1746     if (lines == NULL) {
 1747         err = E_ALLOC;
 1748     } else {
 1749         int i = n - 1;
 1750 
 1751         fun->lines = lines;
 1752         lines[i].idx = fun->line_idx;
 1753         if (donate) {
 1754         lines[i].s = s;
 1755         } else {
 1756         lines[i].s = gretl_strdup(s);
 1757         if (lines[i].s == NULL) {
 1758             err = E_ALLOC;
 1759         }
 1760         }
 1761         if (!err) {
 1762         lines[i].loop = NULL;
 1763         lines[i].next_idx = -1;
 1764         lines[i].ignore = 0;
 1765         fun->n_lines = n;
 1766         fun->line_idx += 1;
 1767         }
 1768     }
 1769     }
 1770 
 1771     return err;
 1772 }
 1773 
 1774 /* read the actual code lines from the XML representation of a
 1775    function */
 1776 
 1777 static int func_read_code (xmlNodePtr node, xmlDocPtr doc, ufunc *fun)
 1778 {
 1779     char line[MAXLINE];
 1780     char *buf, *s;
 1781     int err = 0;
 1782 
 1783     buf = (char *) xmlNodeListGetString(doc, node->xmlChildrenNode, 1);
 1784     if (buf == NULL) {
 1785     return 1;
 1786     }
 1787 
 1788     bufgets_init(buf);
 1789 
 1790     while (bufgets(line, sizeof line, buf) && !err) {
 1791     s = line;
 1792     while (isspace(*s)) s++;
 1793     tailstrip(s);
 1794     err = push_function_line(fun, s, 0);
 1795     }
 1796 
 1797     bufgets_finalize(buf);
 1798 
 1799     free(buf);
 1800 
 1801     return err;
 1802 }
 1803 
 1804 static void print_opt_flags (fn_param *param, PRN *prn)
 1805 {
 1806     if (param->flags & ARG_OPTIONAL) {
 1807     pputs(prn, "[null]");
 1808     }
 1809 }
 1810 
 1811 static void print_param_description (fn_param *param, PRN *prn)
 1812 {
 1813     if (param->descrip != NULL && *param->descrip != '\0') {
 1814     pprintf(prn, " \"%s\"", param->descrip);
 1815     }
 1816 }
 1817 
 1818 static void print_param_labels (fn_param *param, PRN *prn)
 1819 {
 1820     int i;
 1821 
 1822     pputs(prn, " {");
 1823 
 1824     for (i=0; i<param->nlabels; i++) {
 1825     pprintf(prn, "\"%s\"", param->labels[i]);
 1826     if (i < param->nlabels - 1) {
 1827         pputs(prn, ", ");
 1828     }
 1829     }
 1830 
 1831     pputc(prn, '}');
 1832 }
 1833 
 1834 static void print_min_max_deflt (fn_param *param, PRN *prn)
 1835 {
 1836     if (na(param->min) && na(param->max) && default_unset(param)) {
 1837     return; /* no-op */
 1838     } else if (na(param->min) && na(param->max)) {
 1839     /* got a default value only? */
 1840     if (!default_unset(param)) {
 1841         if (na(param->deflt)) {
 1842         pputs(prn, "[NA]");
 1843         } else {
 1844         pprintf(prn, "[%g]", param->deflt);
 1845         }
 1846     }
 1847     return;
 1848     }
 1849 
 1850     pputc(prn, '[');
 1851 
 1852     /* minimum */
 1853     if (!na(param->min)) pprintf(prn, "%g", param->min);
 1854     pputc(prn, ':');
 1855 
 1856     /* maximum */
 1857     if (!na(param->max)) pprintf(prn, "%g", param->max);
 1858     pputc(prn, ':');
 1859 
 1860     /* default */
 1861     if (!default_unset(param)) {
 1862     if (na(param->deflt)) {
 1863         pputs(prn, "NA");
 1864     } else {
 1865         pprintf(prn, "%g", param->deflt);
 1866     }
 1867     }
 1868 
 1869     if (!na(param->step)) {
 1870     /* step */
 1871     pputc(prn, ':');
 1872     pprintf(prn, "%g", param->step);
 1873     }
 1874 
 1875     pputc(prn, ']');
 1876 }
 1877 
 1878 /* free @fun and also remove it from the list of loaded
 1879    functions */
 1880 
 1881 static void ufunc_unload (ufunc *fun)
 1882 {
 1883     int i, j, found = 0;
 1884 
 1885     if (n_ufuns == 0 || fun == NULL) {
 1886     return;
 1887     }
 1888 
 1889 #if PKG_DEBUG
 1890     fprintf(stderr, "ufunc_unload: name %s, pkg %p\n",
 1891         fun->name, (void *) fun->pkg);
 1892 #endif
 1893 
 1894     /* remove this function from the array of loaded functions */
 1895 
 1896     for (i=0; i<n_ufuns; i++) {
 1897     if (ufuns[i] == fun) {
 1898         for (j=i; j<n_ufuns-1; j++) {
 1899         ufuns[j] = ufuns[j+1];
 1900         }
 1901         found = 1;
 1902         break;
 1903     }
 1904     }
 1905 
 1906     if (fun->pkg != NULL && fun->pkg->overrides) {
 1907     delete_function_override(fun->name, fun->pkg->name);
 1908     }
 1909     ufunc_free(fun);
 1910 
 1911     if (found) {
 1912     n_ufuns--;
 1913     }
 1914 }
 1915 
 1916 /* remove a package from the current listing and free it;
 1917    if @full is non-zero, also unload any member functions
 1918 */
 1919 
 1920 static void real_function_package_unload (fnpkg *pkg, int full)
 1921 {
 1922     int i, j, found = 0;
 1923 
 1924 #if PKG_DEBUG
 1925     fprintf(stderr, "function_package_unload: unloading '%s', full=%d\n",
 1926         pkg->name, full);
 1927 #endif
 1928 
 1929     /* unload children? */
 1930     if (full) {
 1931     for (i=0; i<pkg->n_priv; i++) {
 1932         ufunc_unload(pkg->priv[i]);
 1933     }
 1934     for (i=0; i<pkg->n_pub; i++) {
 1935         ufunc_unload(pkg->pub[i]);
 1936     }
 1937     }
 1938 
 1939     /* remove this package from the array of loaded packages */
 1940     for (i=0; i<n_pkgs; i++) {
 1941     if (pkgs[i] == pkg) {
 1942         for (j=i; j<n_pkgs-1; j++) {
 1943         pkgs[j] = pkgs[j+1];
 1944         }
 1945         found = 1;
 1946         break;
 1947     }
 1948     }
 1949 
 1950     /* free the package itself */
 1951     function_package_free(pkg);
 1952 
 1953     if (found) {
 1954     n_pkgs--;
 1955     }
 1956 }
 1957 
 1958 /* Append a pointer to @fun to the array of child-pointers in @pkg: we
 1959    do this when reading the definition of a packaged function from an
 1960    XML file.  Note that this action does not add the functions to the
 1961    array of loaded functions -- that's done separately, if we're
 1962    loading the package 'for real'.
 1963 */
 1964 
 1965 static int attach_ufunc_to_package (ufunc *fun, fnpkg *pkg)
 1966 {
 1967     ufunc **ufs;
 1968     int n, err = 0;
 1969 
 1970     if (function_is_private(fun)) {
 1971     n = pkg->n_priv;
 1972     ufs = realloc(pkg->priv, (n + 1) * sizeof *ufs);
 1973     if (ufs == NULL) {
 1974         err = E_ALLOC;
 1975     } else {
 1976         pkg->priv = ufs;
 1977         pkg->priv[n] = fun;
 1978         pkg->n_priv += 1;
 1979     }
 1980     } else {
 1981     n = pkg->n_pub;
 1982     ufs = realloc(pkg->pub, (n + 1) * sizeof *ufs);
 1983     if (ufs == NULL) {
 1984         err = E_ALLOC;
 1985     } else {
 1986         pkg->pub = ufs;
 1987         pkg->pub[n] = fun;
 1988         pkg->n_pub += 1;
 1989     }
 1990     }
 1991 
 1992 #if PKG_DEBUG
 1993     fprintf(stderr, "attach_ufunc_to_package: package = %s, "
 1994         "private = %d, err = %d\n", pkg->name,
 1995         function_is_private(fun), err);
 1996 #endif
 1997 
 1998     return err;
 1999 }
 2000 
 2001 static void maybe_set_menu_only (ufunc *fun, fnpkg *pkg)
 2002 {
 2003     if (pkg->mpath != NULL && strstr(pkg->mpath, "MODELWIN")) {
 2004     if (fun->pkg_role == UFUN_GUI_MAIN) {
 2005         fun->flags |= UFUN_MENU_ONLY;
 2006     }
 2007     }
 2008 }
 2009 
 2010 /* read a single user-function definition from XML file: if the
 2011    function is a child of a package, the @pkg argument will
 2012    be non-NULL
 2013 */
 2014 
 2015 static int read_ufunc_from_xml (xmlNodePtr node, xmlDocPtr doc, fnpkg *pkg)
 2016 {
 2017     ufunc *fun = ufunc_new();
 2018     xmlNodePtr cur;
 2019     char *tmp;
 2020     int err = 0;
 2021 
 2022     if (fun == NULL) {
 2023     return E_ALLOC;
 2024     }
 2025 
 2026     if (!gretl_xml_get_prop_as_string(node, "name", &tmp)) {
 2027     ufunc_free(fun);
 2028     return E_DATA;
 2029     }
 2030 
 2031     strncat(fun->name, tmp, FN_NAMELEN - 1);
 2032     free(tmp);
 2033 
 2034     if (pkg != NULL) {
 2035     fun->pkg = pkg;
 2036     }
 2037 
 2038     if (gretl_xml_get_prop_as_string(node, "type", &tmp)) {
 2039     fun->rettype = return_type_from_string(tmp, &err);
 2040     free(tmp);
 2041     } else {
 2042     fun->rettype = GRETL_TYPE_VOID;
 2043     }
 2044 
 2045     if (err) {
 2046     ufunc_free(fun);
 2047     return err;
 2048     }
 2049 
 2050     if (gretl_xml_get_prop_as_bool(node, "private")) {
 2051     fun->flags |= UFUN_PRIVATE;
 2052     }
 2053 
 2054     if (gretl_xml_get_prop_as_bool(node, "plugin-wrapper")) {
 2055     fun->flags |= UFUN_PLUGIN;
 2056     }
 2057 
 2058     if (gretl_xml_get_prop_as_bool(node, "no-print")) {
 2059     fun->flags |= UFUN_NOPRINT;
 2060     }
 2061 
 2062     if (gretl_xml_get_prop_as_bool(node, "menu-only")) {
 2063     fun->flags |= UFUN_MENU_ONLY;
 2064     }
 2065 
 2066     if (gretl_xml_get_prop_as_string(node, "pkg-role", &tmp)) {
 2067     fun->pkg_role = pkg_key_get_role(tmp);
 2068     free(tmp);
 2069     }
 2070 
 2071     if (!(fun->flags & UFUN_MENU_ONLY) && pkg != NULL) {
 2072     maybe_set_menu_only(fun, pkg);
 2073     }
 2074 
 2075 #if PKG_DEBUG
 2076     fprintf(stderr, "read_ufunc_from_xml: name '%s', type %d\n"
 2077         " private = %d, plugin = %d\n", fun->name, fun->rettype,
 2078         function_is_private(fun), function_is_plugin(fun));
 2079 #endif
 2080 
 2081     if (pkg == NULL && (function_is_private(fun) || function_is_plugin(fun))) {
 2082     fprintf(stderr, "unpackaged function: can't be private or plugin\n");
 2083     ufunc_free(fun);
 2084     return E_DATA;
 2085     }
 2086 
 2087     cur = node->xmlChildrenNode;
 2088 
 2089     while (cur != NULL && !err) {
 2090     if (!xmlStrcmp(cur->name, (XUC) "help")) {
 2091         /* backward compatibility: help used to be attached to
 2092            a package's public interface */
 2093         if (pkg->help != NULL) {
 2094         free(pkg->help);
 2095         }
 2096         pkg->help = gretl_xml_get_string(cur, doc);
 2097     } else if (!xmlStrcmp(cur->name, (XUC) "params")) {
 2098         err = func_read_params(cur, doc, fun);
 2099         if (err) {
 2100         fprintf(stderr, "%s: error parsing function parameters\n",
 2101             fun->name);
 2102         }
 2103     } else if (!xmlStrcmp(cur->name, (XUC) "return")) {
 2104         gretl_errmsg_set("Old-style function definitions no longer supported");
 2105         err = E_DATA;
 2106     } else if (!xmlStrcmp(cur->name, (XUC) "code")) {
 2107         err = func_read_code(cur, doc, fun);
 2108     }
 2109     cur = cur->next;
 2110     }
 2111 
 2112     if (!err) {
 2113     if (pkg != NULL) {
 2114         /* function belongs to a package */
 2115         err = attach_ufunc_to_package(fun, pkg);
 2116     } else {
 2117         /* reading a standalone function from session file */
 2118         err = add_allocated_ufunc(fun);
 2119     }
 2120     }
 2121 
 2122     if (err) {
 2123     ufunc_free(fun);
 2124     }
 2125 
 2126 #if PKG_DEBUG
 2127     fprintf(stderr, "read_ufunc_from_xml: returning %d\n", err);
 2128 #endif
 2129 
 2130     return err;
 2131 }
 2132 
 2133 static int wordmatch (const char *s, const char *test)
 2134 {
 2135     int n = strlen(test);
 2136 
 2137     return (!strncmp(s, test, n) && (s[n] == '\0' || isspace(s[n])));
 2138 }
 2139 
 2140 void adjust_indent (const char *s, int *this_indent, int *next_indent)
 2141 {
 2142     int ti = *next_indent;
 2143     int ni = *next_indent;
 2144 
 2145     if (*s == '\0') {
 2146     *this_indent = *next_indent;
 2147     return;
 2148     }
 2149 
 2150     if (!strncmp(s, "catch ", 6)) {
 2151     s += 6;
 2152     s += strspn(s, " ");
 2153     }
 2154 
 2155     if (wordmatch(s, "loop")) {
 2156     ni++;
 2157     } else if (wordmatch(s, "if")) {
 2158     ni++;
 2159     } else if (wordmatch(s, "nls")) {
 2160     ni++;
 2161     } else if (wordmatch(s, "mle")) {
 2162     ni++;
 2163     } else if (wordmatch(s, "gmm")) {
 2164     ni++;
 2165     } else if (wordmatch(s, "mpi")) {
 2166     ni++;
 2167     } else if (wordmatch(s, "plot")) {
 2168     ni++;
 2169     } else if (wordmatch(s, "function")) {
 2170     ni++;
 2171     } else if (wordmatch(s, "restrict")) {
 2172     ni++;
 2173     } else if (wordmatch(s, "system")) {
 2174     ni++;
 2175     } else if (wordmatch(s, "foreign")) {
 2176     ni++;
 2177     } else if (wordmatch(s, "outfile")) {
 2178     /* Current syntax is "outfile <lines> end outfile", with
 2179        options --append, --quiet, --buffer available on
 2180        the initial line. Legacy syntax is "outfile --write"
 2181        (or --append) to start and "outfile --close" to
 2182        finish. We should indent <lines> in the first case
 2183        but not the second.
 2184     */
 2185     if (strstr(s, "--close") || strstr(s, "--write")) {
 2186         ; /* no-op */
 2187     } else {
 2188         /* note: --append is ambiguous wrt indenting! */
 2189         ni++;
 2190     }
 2191     } else if (wordmatch(s, "end") ||
 2192            wordmatch(s, "endif") ||
 2193            wordmatch(s, "endloop")) {
 2194     ti--;
 2195     ni--;
 2196     } else if (wordmatch(s, "else") ||
 2197            wordmatch(s, "elif")) {
 2198     ni = ti;
 2199     ti--;
 2200     }
 2201 
 2202     *this_indent = ti;
 2203     *next_indent = ni;
 2204 }
 2205 
 2206 /* ensure use of canonical forms "endif", "endloop" */
 2207 
 2208 static void maybe_correct_line (char *line)
 2209 {
 2210     char *p = strstr(line, "end if");
 2211 
 2212     if (p == NULL) {
 2213     p = strstr(line, "end loop");
 2214     }
 2215 
 2216     if (p != NULL && (p == line || *(p-1) == ' ')) {
 2217     shift_string_left(p + 3, 1);
 2218     }
 2219 }
 2220 
 2221 #define parm_has_children(p) (p->descrip != NULL || p->nlabels > 0)
 2222 
 2223 /* write out a single user-defined function as XML, according to
 2224    gretlfunc.dtd */
 2225 
 2226 static int write_function_xml (ufunc *fun, PRN *prn)
 2227 {
 2228     int rtype = fun->rettype;
 2229     int this_indent = 0;
 2230     int next_indent = 0;
 2231     int i, j;
 2232 
 2233     if (rtype == GRETL_TYPE_NONE) {
 2234     rtype = GRETL_TYPE_VOID;
 2235     }
 2236 
 2237     pprintf(prn, "<gretl-function name=\"%s\" type=\"%s\"",
 2238               fun->name, gretl_type_get_name(rtype));
 2239 
 2240     if (function_is_private(fun)) {
 2241     pputs(prn, " private=\"1\"");
 2242     }
 2243     if (function_is_plugin(fun)) {
 2244     pputs(prn, " plugin-wrapper=\"1\"");
 2245     }
 2246     if (function_is_noprint(fun)) {
 2247     pputs(prn, " no-print=\"1\"");
 2248     }
 2249     if (function_is_menu_only(fun)) {
 2250     pputs(prn, " menu-only=\"1\"");
 2251     }
 2252 
 2253     if (fun->pkg_role) {
 2254     pprintf(prn, " pkg-role=\"%s\"", package_role_get_key(fun->pkg_role));
 2255     }
 2256 
 2257     pputs(prn, ">\n");
 2258 
 2259     if (fun->n_params > 0) {
 2260 
 2261     gretl_push_c_numeric_locale();
 2262 
 2263     pprintf(prn, " <params count=\"%d\">\n", fun->n_params);
 2264     for (i=0; i<fun->n_params; i++) {
 2265         fn_param *param = &fun->params[i];
 2266 
 2267         pprintf(prn, "  <param name=\"%s\" type=\"%s\"",
 2268             param->name, arg_type_xml_string(param->type));
 2269         if (!na(param->min)) {
 2270         pprintf(prn, " min=\"%g\"", param->min);
 2271         }
 2272         if (!na(param->max)) {
 2273         pprintf(prn, " max=\"%g\"", param->max);
 2274         }
 2275         if (!default_unset(param)) {
 2276         if (na(param->deflt)) {
 2277             pputs(prn, " default=\"NA\"");
 2278         } else {
 2279             pprintf(prn, " default=\"%g\"", param->deflt);
 2280         }
 2281         }
 2282         if (!na(param->step)) {
 2283         pprintf(prn, " step=\"%g\"", param->step);
 2284         }
 2285         if (param->flags & ARG_OPTIONAL) {
 2286         pputs(prn, " optional=\"true\"");
 2287         }
 2288         if (param->flags & ARG_CONST) {
 2289         pputs(prn, " const=\"true\"");
 2290         }
 2291         if (parm_has_children(param)) {
 2292         pputs(prn, ">\n"); /* terminate opening tag */
 2293         if (param->descrip != NULL) {
 2294             gretl_xml_put_tagged_string("description",
 2295                         param->descrip,
 2296                         prn);
 2297         }
 2298         if (param->nlabels > 0) {
 2299             gretl_xml_put_strings_array_quoted("labels",
 2300                                (const char **) param->labels,
 2301                                param->nlabels, prn);
 2302         }
 2303         pputs(prn, "  </param>\n");
 2304         } else {
 2305         pputs(prn, "/>\n"); /* terminate opening tag */
 2306         }
 2307     }
 2308     pputs(prn, " </params>\n");
 2309 
 2310     gretl_pop_c_numeric_locale();
 2311     }
 2312 
 2313     pputs(prn, "<code>");
 2314 
 2315     for (i=0; i<fun->n_lines; i++) {
 2316     adjust_indent(fun->lines[i].s, &this_indent, &next_indent);
 2317     for (j=0; j<this_indent; j++) {
 2318         pputs(prn, "  ");
 2319     }
 2320     maybe_correct_line(fun->lines[i].s);
 2321     gretl_xml_put_string(fun->lines[i].s, prn);
 2322     pputs(prn, "\n");
 2323     }
 2324 
 2325     pputs(prn, "</code>\n");
 2326     pputs(prn, "</gretl-function>\n");
 2327 
 2328     return 0;
 2329 }
 2330 
 2331 /* script-style output */
 2332 
 2333 static void print_function_start (ufunc *fun, PRN *prn)
 2334 {
 2335     const char *s;
 2336     int i, pos = 0;
 2337 
 2338     if (fun->rettype == GRETL_TYPE_NONE) {
 2339     pos += pprintf(prn, "function void %s ", fun->name);
 2340     } else {
 2341     const char *typestr = gretl_type_get_name(fun->rettype);
 2342 
 2343     pos += pprintf(prn, "function %s %s ", typestr, fun->name);
 2344     }
 2345 
 2346     gretl_push_c_numeric_locale();
 2347 
 2348     if (fun->n_params == 0) {
 2349     pputs(prn, "(void)");
 2350     } else {
 2351     pos += pputc(prn, '(');
 2352     }
 2353 
 2354     for (i=0; i<fun->n_params; i++) {
 2355     fn_param *fp = &fun->params[i];
 2356 
 2357     if (fp->flags & ARG_CONST) {
 2358         pputs(prn, "const ");
 2359     }
 2360     s = gretl_type_get_name(fp->type);
 2361     if (s[strlen(s) - 1] == '*') {
 2362         pprintf(prn, "%s%s", s, fp->name);
 2363     } else {
 2364         pprintf(prn, "%s %s", s, fp->name);
 2365     }
 2366     if (fp->type == GRETL_TYPE_BOOL) {
 2367         if (!default_unset(fp) && !na(fp->deflt)) {
 2368         pprintf(prn, "[%g]", fp->deflt); /* FIXME? */
 2369         }
 2370     } else if (gretl_scalar_type(fp->type)) {
 2371         print_min_max_deflt(fp, prn);
 2372     } else if (arg_may_be_optional(fp->type)) {
 2373         print_opt_flags(&fun->params[i], prn);
 2374     }
 2375     print_param_description(fp, prn);
 2376     if (fp->nlabels > 0) {
 2377         print_param_labels(fp, prn);
 2378     }
 2379     if (i == fun->n_params - 1) {
 2380         pputc(prn, ')');
 2381     } else {
 2382         pputs(prn, ",\n");
 2383         bufspace(pos, prn);
 2384     }
 2385     }
 2386 
 2387     pputc(prn, '\n');
 2388 
 2389     gretl_pop_c_numeric_locale();
 2390 }
 2391 
 2392 /**
 2393  * gretl_function_print_code:
 2394  * @u: pointer to user-function.
 2395  * @tabwidth: number of spaces per "tab" (logical indent).
 2396  * @prn: printing struct.
 2397  *
 2398  * Prints out function @fun to @prn, script-style.
 2399  *
 2400  * Returns: 0 on success, non-zero if @fun is %NULL.
 2401  */
 2402 
 2403 int gretl_function_print_code (ufunc *u, int tabwidth, PRN *prn)
 2404 {
 2405     int this_indent = 0;
 2406     int next_indent = 0;
 2407     int i, j;
 2408 
 2409     if (u == NULL) {
 2410     return E_DATA;
 2411     }
 2412 
 2413     if (tabwidth == 0) {
 2414     tabwidth = 2;
 2415     }
 2416 
 2417     print_function_start(u, prn);
 2418 
 2419     for (i=0; i<u->n_lines; i++) {
 2420     adjust_indent(u->lines[i].s, &this_indent, &next_indent);
 2421     for (j=0; j<=this_indent; j++) {
 2422         bufspace(tabwidth, prn);
 2423     }
 2424     pputs(prn, u->lines[i].s);
 2425     if (i < u->n_lines - 1) {
 2426         if (u->lines[i+1].idx > u->lines[i].idx + 1) {
 2427         pputc(prn, '\n');
 2428         }
 2429     }
 2430     pputc(prn, '\n');
 2431     }
 2432 
 2433     pputs(prn, "end function\n");
 2434 
 2435     return 0;
 2436 }
 2437 
 2438 char **gretl_function_retrieve_code (ufunc *u, int *nlines)
 2439 {
 2440     char **S = NULL;
 2441     int i, j = 0;
 2442 
 2443     for (i=0; i<u->n_lines; i++) {
 2444     if (!u->lines[i].ignore) {
 2445         j++;
 2446     }
 2447     }
 2448 
 2449     if (j > 0) {
 2450     S = strings_array_new(j);
 2451     }
 2452 
 2453     if (S != NULL) {
 2454     *nlines = j;
 2455     j = 0;
 2456     for (i=0; i<u->n_lines; i++) {
 2457         if (!u->lines[i].ignore) {
 2458         S[j++] = u->lines[i].s;
 2459         }
 2460     }
 2461     }
 2462 
 2463     return S;
 2464 }
 2465 
 2466 /* construct a name for @pkg based on its filename member:
 2467    take the basename and knock off ".gfn"
 2468 */
 2469 
 2470 static void name_package_from_filename (fnpkg *pkg)
 2471 {
 2472     char *p = strrchr(pkg->fname, SLASH);
 2473     int n;
 2474 
 2475     if (p != NULL) {
 2476     p++;
 2477     } else {
 2478     p = pkg->fname;
 2479     }
 2480 
 2481     n = strlen(p);
 2482     if (has_suffix(p, ".gfn")) {
 2483     n -= 4;
 2484     }
 2485 
 2486     if (n > FN_NAMELEN - 1) {
 2487     n = FN_NAMELEN - 1;
 2488     }
 2489 
 2490     *pkg->name = '\0';
 2491     strncat(pkg->name, p, n);
 2492 
 2493 #if PKG_DEBUG
 2494     fprintf(stderr, "filename '%s' -> pkgname '%s'\n",
 2495         pkg->fname, pkg->name);
 2496 #endif
 2497 }
 2498 
 2499 /* name lookup for functions to be connected to a package,
 2500    allowing for the possibility that they're already
 2501    connected */
 2502 
 2503 static ufunc *get_uf_array_member (const char *name, fnpkg *pkg)
 2504 {
 2505     int i;
 2506 
 2507     for (i=0; i<n_ufuns; i++) {
 2508     if (ufuns[i]->pkg == pkg || ufuns[i]->pkg == NULL) {
 2509         if (!strcmp(name, ufuns[i]->name)) {
 2510         return ufuns[i];
 2511         }
 2512     }
 2513     }
 2514 
 2515     return NULL;
 2516 }
 2517 
 2518 static void check_special_comments (ufunc *fun)
 2519 {
 2520     int i;
 2521 
 2522     for (i=0; i<fun->n_lines; i++) {
 2523     if (strstr(fun->lines[i].s, "## plugin-wrapper ##")) {
 2524         fun->flags |= UFUN_PLUGIN;
 2525     } else if (strstr(fun->lines[i].s, "## no-print ##")) {
 2526         fun->flags |= UFUN_NOPRINT;
 2527     } else if (strstr(fun->lines[i].s, "## menu-only ##")) {
 2528         fun->flags |= UFUN_MENU_ONLY;
 2529     }
 2530     }
 2531 }
 2532 
 2533 /* before revising the function members of an existing
 2534    package, detach all its current functions
 2535 */
 2536 
 2537 static void package_disconnect_funcs (fnpkg *pkg)
 2538 {
 2539     int i;
 2540 
 2541     if (pkg->pub != NULL) {
 2542     for (i=0; i<pkg->n_pub; i++) {
 2543         pkg->pub[i]->pkg = NULL;
 2544     }
 2545     free(pkg->pub);
 2546     pkg->pub = NULL;
 2547     pkg->n_pub = 0;
 2548     }
 2549 
 2550     if (pkg->priv != NULL) {
 2551     for (i=0; i<pkg->n_priv; i++) {
 2552         pkg->priv[i]->pkg = NULL;
 2553         set_function_private(pkg->priv[i], FALSE);
 2554     }
 2555     free(pkg->priv);
 2556     pkg->priv = NULL;
 2557     pkg->n_priv = 0;
 2558     }
 2559 }
 2560 
 2561 /* Given an array of @n function names in @names, set up a
 2562    corresponding array of pointers to the named functions in @pkg,
 2563    Flag an error if any of the function names are bad, or if
 2564    allocation fails.
 2565 */
 2566 
 2567 static int set_uf_array_from_names (fnpkg *pkg, char **names,
 2568                     int n, int priv)
 2569 {
 2570     ufunc **uf = NULL;
 2571     ufunc *fun;
 2572     int i, j;
 2573 
 2574     /* check the supplied names */
 2575     for (i=0; i<n; i++) {
 2576     for (j=0; j<i; j++) {
 2577         if (!strcmp(names[j], names[i])) {
 2578         gretl_errmsg_sprintf("Duplicated function name '%s'", names[i]);
 2579         return E_DATA;
 2580         }
 2581     }
 2582     if (get_uf_array_member(names[i], NULL) == NULL) {
 2583         fprintf(stderr, "%s: function not found!\n", names[i]);
 2584         return E_DATA;
 2585     }
 2586     }
 2587 
 2588     /* allocate storage */
 2589     if (n > 0) {
 2590     uf = malloc(n * sizeof *uf);
 2591     if (uf == NULL) {
 2592         return E_ALLOC;
 2593     }
 2594     }
 2595 
 2596     /* connect the specified functions */
 2597     for (i=0; i<n; i++) {
 2598     fun = get_uf_array_member(names[i], NULL);
 2599     fun->pkg = pkg;
 2600     set_function_private(fun, priv);
 2601     check_special_comments(fun);
 2602     uf[i] = fun;
 2603     }
 2604 
 2605     /* set up the package info */
 2606     if (priv) {
 2607     pkg->priv = uf;
 2608     pkg->n_priv = n;
 2609     } else {
 2610     pkg->pub = uf;
 2611     pkg->n_pub = n;
 2612     }
 2613 
 2614     return 0;
 2615 }
 2616 
 2617 /**
 2618  * function_package_connect_funcs:
 2619  * @pkg: function package.
 2620  * @pubnames: array of names of public functions.
 2621  * @n_pub: number of strings in @pubnames.
 2622  * @privnames: array of names of private functions (or %NULL).
 2623  * @n_priv: number of strings in @privnames (may be 0).
 2624  *
 2625  * Looks up the functions named in @pubnames and @privnames
 2626  * and adds pointers to these functions to @pkg, hence marking
 2627  * the functions as belonging to @pkg.
 2628  *
 2629  * Returns: 0 on success, non-zero on error.
 2630  */
 2631 
 2632 int function_package_connect_funcs (fnpkg *pkg,
 2633                     char **pubnames, int n_pub,
 2634                     char **privnames, int n_priv)
 2635 {
 2636     int err;
 2637 
 2638     /* clear the decks first */
 2639     package_disconnect_funcs(pkg);
 2640 
 2641     err = set_uf_array_from_names(pkg, pubnames, n_pub, 0);
 2642 
 2643     if (!err) {
 2644     err = set_uf_array_from_names(pkg, privnames, n_priv, 1);
 2645     }
 2646 
 2647     return err;
 2648 }
 2649 
 2650 /**
 2651  * function_package_new:
 2652  * @fname: filename for package.
 2653  * @pubnames: array of names of public functions.
 2654  * @n_pub: number of strings in @pubnames.
 2655  * @privnames: array of names of private functions (or %NULL).
 2656  * @n_priv: number of strings in @privnames (may be 0).
 2657  * @err: location to receive error code.
 2658  *
 2659  * Allocates a new package with filename-member @fname, including
 2660  * the public and private functions named in @pubnames and
 2661  * @privnames.  Note that this function does not cause the
 2662  * package to be written to file; for that, see
 2663  * write_function_package().
 2664  *
 2665  * Returns: pointer to package on success, %NULL on error.
 2666  */
 2667 
 2668 fnpkg *function_package_new (const char *fname,
 2669                  char **pubnames, int n_pub,
 2670                  char **privnames, int n_priv,
 2671                  int *err)
 2672 {
 2673     fnpkg *pkg = NULL;
 2674 
 2675     if (n_pub <= 0) {
 2676     /* we need at least one public function */
 2677     *err = E_DATA;
 2678     } else {
 2679     pkg = function_package_alloc(fname);
 2680     if (pkg == NULL) {
 2681         *err = E_ALLOC;
 2682     }
 2683     }
 2684 
 2685     if (*err) {
 2686     return NULL;
 2687     }
 2688 
 2689     name_package_from_filename(pkg);
 2690 
 2691     *err = function_package_connect_funcs(pkg, pubnames, n_pub,
 2692                       privnames, n_priv);
 2693 
 2694     if (!*err) {
 2695     *err = function_package_record(pkg);
 2696     }
 2697 
 2698     if (*err) {
 2699     /* note: this does not free the packaged functions, if any */
 2700     function_package_free(pkg);
 2701     pkg = NULL;
 2702     }
 2703 
 2704     return pkg;
 2705 }
 2706 
 2707 static char *trim_text (char *s)
 2708 {
 2709     while (isspace(*s)) s++;
 2710     return tailstrip(s);
 2711 }
 2712 
 2713 static int package_write_translatable_strings (fnpkg *pkg, PRN *prn)
 2714 {
 2715     FILE *fp;
 2716     gchar *trname;
 2717     char **S = NULL;
 2718     int i, n = 0;
 2719 
 2720     trname = g_strdup_printf("%s-i18n.c", pkg->name);
 2721 
 2722     fp = gretl_fopen(trname, "wb");
 2723     if (fp == NULL) {
 2724     gretl_errmsg_sprintf(_("Couldn't open %s"), trname);
 2725     g_free(trname);
 2726     return E_FOPEN;
 2727     }
 2728 
 2729     if (pkg->pub != NULL) {
 2730     int j, k;
 2731 
 2732     for (i=0; i<pkg->n_pub; i++) {
 2733         ufunc *fun = pkg->pub[i];
 2734 
 2735         for (j=0; j<fun->n_params; j++) {
 2736         fn_param *param = &fun->params[j];
 2737 
 2738         if (param->descrip != NULL) {
 2739             strings_array_add(&S, &n, param->descrip);
 2740         }
 2741         for (k=0; k<param->nlabels; k++) {
 2742             strings_array_add(&S, &n, param->labels[k]);
 2743         }
 2744         }
 2745     }
 2746     }
 2747 
 2748     if (pkg->label != NULL || S != NULL) {
 2749     fprintf(fp, "const char *%s_translations[] = {\n", pkg->name);
 2750     if (pkg->label != NULL) {
 2751         fprintf(fp, "    N_(\"%s\"),\n", pkg->label);
 2752     }
 2753     if (S != NULL) {
 2754         strings_array_sort(&S, &n, OPT_U);
 2755         for (i=0; i<n; i++) {
 2756         fprintf(fp, "    N_(\"%s\")", S[i]);
 2757         if (i < n-1) {
 2758             fputc(',', fp);
 2759         }
 2760         fputc('\n', fp);
 2761         }
 2762         strings_array_free(S, n);
 2763     }
 2764     fputs("};\n", fp);
 2765     }
 2766 
 2767     fclose(fp);
 2768 
 2769     pprintf(prn, "Wrote translations file %s\n", trname);
 2770     g_free(trname);
 2771 
 2772     return 0;
 2773 }
 2774 
 2775 int package_is_addon (const char *name)
 2776 {
 2777     char *myname = NULL;
 2778     int ret = 0;
 2779 
 2780     if (strchr(name, '.') != NULL) {
 2781     char *p;
 2782 
 2783     myname = gretl_strdup(name);
 2784     p = strchr(myname, '.');
 2785     *p = '\0';
 2786     name = myname;
 2787     }
 2788 
 2789     if (!strcmp(name, "gig") ||
 2790     !strcmp(name, "SVAR") ||
 2791     !strcmp(name, "HIP") ||
 2792     !strcmp(name, "ivpanel") ||
 2793     !strcmp(name, "dbnomics") ||
 2794     !strcmp(name, "extra")) {
 2795     ret = 1;
 2796     }
 2797 
 2798     free(myname);
 2799 
 2800     return ret;
 2801 }
 2802 
 2803 static int package_write_index (fnpkg *pkg, PRN *inprn)
 2804 {
 2805     PRN *prn;
 2806     gchar *idxname;
 2807     int err = 0;
 2808 
 2809     idxname = g_strdup_printf("%s.xml", pkg->name);
 2810 
 2811     prn = gretl_print_new_with_filename(idxname, &err);
 2812     if (prn == NULL) {
 2813     g_free(idxname);
 2814     return err;
 2815     }
 2816 
 2817     gretl_xml_header(prn);
 2818 
 2819     pprintf(prn, "<gretl-addon name=\"%s\"", pkg->name);
 2820 
 2821     if (pkg->dreq == FN_NEEDS_TS) {
 2822     pprintf(prn, " %s=\"true\"", NEEDS_TS);
 2823     } else if (pkg->dreq == FN_NEEDS_QM) {
 2824     pprintf(prn, " %s=\"true\"", NEEDS_QM);
 2825     } else if (pkg->dreq == FN_NEEDS_PANEL) {
 2826     pprintf(prn, " %s=\"true\"", NEEDS_PANEL);
 2827     } else if (pkg->dreq == FN_NODATA_OK) {
 2828     pprintf(prn, " %s=\"true\"", NO_DATA_OK);
 2829     }
 2830 
 2831     if (pkg->modelreq > 0) {
 2832     pprintf(prn, " model-requirement=\"%s\"",
 2833         gretl_command_word(pkg->modelreq));
 2834     }
 2835 
 2836     if (pkg->minver > 0) {
 2837     char vstr[8];
 2838 
 2839     pprintf(prn, " minver=\"%s\"",
 2840         gretl_version_string(vstr, pkg->minver));
 2841     }
 2842 
 2843     if (pkg->uses_subdir) {
 2844     pputs(prn, " lives-in-subdir=\"true\"");
 2845     }
 2846 
 2847     if (pkg->data_access) {
 2848     pputs(prn, " wants-data-access=\"true\"");
 2849     }
 2850 
 2851     pputs(prn, ">\n");
 2852 
 2853     gretl_xml_put_tagged_string("author",  pkg->author, prn);
 2854     gretl_xml_put_tagged_string("version", pkg->version, prn);
 2855     gretl_xml_put_tagged_string("date",    pkg->date, prn);
 2856     gretl_xml_put_tagged_string("description", pkg->descrip, prn);
 2857 
 2858     if (pkg->tags != NULL) {
 2859     gretl_xml_put_tagged_string("tags", pkg->tags, prn);
 2860     }
 2861 
 2862     if (pkg->label != NULL) {
 2863     gretl_xml_put_tagged_string("label", pkg->label, prn);
 2864     }
 2865 
 2866     if (pkg->mpath != NULL) {
 2867     gretl_xml_put_tagged_string("menu-attachment", pkg->mpath, prn);
 2868     }
 2869 
 2870     pputs(prn, "</gretl-addon>\n");
 2871 
 2872     gretl_print_destroy(prn);
 2873 
 2874     pprintf(inprn, "Wrote index file %s\n", idxname);
 2875     g_free(idxname);
 2876 
 2877     return 0;
 2878 }
 2879 
 2880 /* Write out a function package as XML. If @fp is NULL, then we write
 2881    this as a package file in its own right, using the filename given
 2882    in the package (the 'standalone' case), otherwise we're writing it
 2883    as a component of the functions listing in a gretl session file,
 2884    which already has an associated open stream.
 2885 */
 2886 
 2887 static int real_write_function_package (fnpkg *pkg, PRN *prn)
 2888 {
 2889     int standalone = (prn == NULL);
 2890     int i, err = 0;
 2891 
 2892     if (standalone) {
 2893     prn = gretl_print_new_with_filename(pkg->fname, &err);
 2894     if (prn == NULL) {
 2895         return err;
 2896     } else {
 2897         gretl_xml_header(prn);
 2898         pputs(prn, "<gretl-functions>\n");
 2899     }
 2900     }
 2901 
 2902     pputs(prn, "<gretl-function-package");
 2903 
 2904     if (pkg->name[0] == '\0') {
 2905     name_package_from_filename(pkg);
 2906     }
 2907 
 2908     pprintf(prn, " name=\"%s\"", pkg->name);
 2909 
 2910     if (pkg->dreq == FN_NEEDS_TS) {
 2911     pprintf(prn, " %s=\"true\"", NEEDS_TS);
 2912     } else if (pkg->dreq == FN_NEEDS_QM) {
 2913     pprintf(prn, " %s=\"true\"", NEEDS_QM);
 2914     } else if (pkg->dreq == FN_NEEDS_PANEL) {
 2915     pprintf(prn, " %s=\"true\"", NEEDS_PANEL);
 2916     } else if (pkg->dreq == FN_NODATA_OK) {
 2917     pprintf(prn, " %s=\"true\"", NO_DATA_OK);
 2918     }
 2919 
 2920     if (pkg->modelreq > 0) {
 2921     pprintf(prn, " model-requirement=\"%s\"",
 2922         gretl_command_word(pkg->modelreq));
 2923     }
 2924 
 2925     if (pkg->minver > 0) {
 2926     char vstr[8];
 2927 
 2928     pprintf(prn, " minver=\"%s\"", gretl_version_string(vstr, pkg->minver));
 2929     }
 2930 
 2931     if (pkg->uses_subdir) {
 2932     pprintf(prn, " lives-in-subdir=\"true\"");
 2933     }
 2934 
 2935     if (pkg->data_access) {
 2936     pprintf(prn, " wants-data-access=\"true\"");
 2937     }
 2938 
 2939     pputs(prn, ">\n");
 2940 
 2941     if (pkg->email != NULL && *pkg->email != '\0') {
 2942     gretl_xml_put_tagged_string_plus("author", pkg->author,
 2943                      "email", pkg->email,
 2944                      prn);
 2945     } else {
 2946     gretl_xml_put_tagged_string("author", pkg->author, prn);
 2947     }
 2948     gretl_xml_put_tagged_string("version", pkg->version, prn);
 2949     gretl_xml_put_tagged_string("date",    pkg->date, prn);
 2950     gretl_xml_put_tagged_string("description", pkg->descrip, prn);
 2951 
 2952     if (pkg->tags != NULL) {
 2953     gretl_xml_put_tagged_string("tags", pkg->tags, prn);
 2954     }
 2955 
 2956     if (pkg->label != NULL) {
 2957     gretl_xml_put_tagged_string("label", pkg->label, prn);
 2958     }
 2959 
 2960     if (pkg->mpath != NULL) {
 2961     gretl_xml_put_tagged_string("menu-attachment", pkg->mpath, prn);
 2962     }
 2963 
 2964     if (pkg->help != NULL) {
 2965     if (pkg->help_fname != NULL) {
 2966         pprintf(prn, "<help filename=\"%s\">\n", pkg->help_fname);
 2967     } else {
 2968         pputs(prn, "<help>\n");
 2969     }
 2970     gretl_xml_put_string(trim_text(pkg->help), prn);
 2971     pputs(prn, "\n</help>\n");
 2972     }
 2973 
 2974     if (pkg->gui_help != NULL) {
 2975     if (pkg->gui_help_fname != NULL) {
 2976         pprintf(prn, "<gui-help filename=\"%s\">\n",
 2977                   pkg->gui_help_fname);
 2978     } else {
 2979         pputs(prn, "<gui-help>\n");
 2980     }
 2981     gretl_xml_put_string(trim_text(pkg->gui_help), prn);
 2982     pputs(prn, "\n</gui-help>\n");
 2983     }
 2984 
 2985     if (pkg->datafiles != NULL) {
 2986     gretl_xml_put_strings_array("data-files",
 2987                     (const char **) pkg->datafiles,
 2988                     pkg->n_files, prn);
 2989     }
 2990 
 2991     if (pkg->depends != NULL) {
 2992     gretl_xml_put_strings_array("depends",
 2993                     (const char **) pkg->depends,
 2994                     pkg->n_depends, prn);
 2995     }
 2996 
 2997     if (pkg->provider != NULL) {
 2998     gretl_xml_put_tagged_string("provider", pkg->provider, prn);
 2999     }
 3000 
 3001     if (pkg->Rdeps != NULL) {
 3002     gretl_xml_put_tagged_string("R-depends", pkg->Rdeps, prn);
 3003     }
 3004 
 3005     if (pkg->pub != NULL) {
 3006     for (i=0; i<pkg->n_pub; i++) {
 3007         write_function_xml(pkg->pub[i], prn);
 3008     }
 3009     }
 3010 
 3011     if (pkg->priv != NULL) {
 3012     for (i=0; i<pkg->n_priv; i++) {
 3013         write_function_xml(pkg->priv[i], prn);
 3014     }
 3015     }
 3016 
 3017     if (pkg->sample != NULL) {
 3018     if (pkg->sample_fname != NULL) {
 3019         pprintf(prn, "<sample-script filename=\"%s\">\n",
 3020                   pkg->sample_fname);
 3021     } else {
 3022         pputs(prn, "<sample-script>\n");
 3023     }
 3024     gretl_xml_put_string(trim_text(pkg->sample), prn);
 3025     pputs(prn, "\n</sample-script>\n");
 3026     }
 3027 
 3028     pputs(prn, "</gretl-function-package>\n");
 3029 
 3030     if (standalone) {
 3031     pputs(prn, "</gretl-functions>\n");
 3032     gretl_print_destroy(prn);
 3033     }
 3034 
 3035     return err;
 3036 }
 3037 
 3038 /**
 3039  * function_package_write_file:
 3040  * @pkg: function package.
 3041  *
 3042  * Write out @pkg as an XML file, using the filename
 3043  * recorded in the package.
 3044  *
 3045  * Returns: 0 on success, non-zero on error.
 3046  */
 3047 
 3048 int function_package_write_file (fnpkg *pkg)
 3049 {
 3050     return real_write_function_package(pkg, NULL);
 3051 }
 3052 
 3053 /* below: apparatus for constructing and saving a gfn function
 3054    package from the command line
 3055 */
 3056 
 3057 static int is_unclaimed (const char *s, char **S, int n)
 3058 {
 3059     int i;
 3060 
 3061     for (i=0; i<n; i++) {
 3062     if (strcmp(s, S[i]) == 0) {
 3063         return 0;
 3064     }
 3065     }
 3066 
 3067     return 1;
 3068 }
 3069 
 3070 static void strip_cr (gchar *s)
 3071 {
 3072     while (*s) {
 3073     if (*s == 0x0d && *(s+1) == 0x0a) {
 3074         /* CR + LF -> LF */
 3075         memmove(s, s+1, strlen(s));
 3076         s++;
 3077     }
 3078     s++;
 3079     }
 3080 }
 3081 
 3082 static gchar *pkg_aux_content (const char *fname, int *err)
 3083 {
 3084     gchar *ret = NULL;
 3085     GError *gerr = NULL;
 3086     gsize len = 0;
 3087 
 3088     g_file_get_contents(fname, &ret, &len, &gerr);
 3089 
 3090     if (gerr != NULL) {
 3091     gretl_errmsg_set(gerr->message);
 3092     g_error_free(gerr);
 3093     *err = E_FOPEN;
 3094     } else if (strchr(ret, '\r')) {
 3095     strip_cr(ret);
 3096     }
 3097 
 3098     return ret;
 3099 }
 3100 
 3101 static int pkg_set_dreq (fnpkg *pkg, const char *s)
 3102 {
 3103     int err = 0;
 3104 
 3105     if (!strcmp(s, NEEDS_TS)) {
 3106     pkg->dreq = FN_NEEDS_TS;
 3107     } else if (!strcmp(s, NEEDS_QM)) {
 3108     pkg->dreq = FN_NEEDS_QM;
 3109     } else if (!strcmp(s, NEEDS_PANEL)) {
 3110     pkg->dreq = FN_NEEDS_PANEL;
 3111     } else if (!strcmp(s, NO_DATA_OK)) {
 3112     pkg->dreq = FN_NODATA_OK;
 3113     } else {
 3114     err = E_PARSE;
 3115     }
 3116 
 3117     return err;
 3118 }
 3119 
 3120 static int pkg_set_modelreq (fnpkg *pkg, const char *s)
 3121 {
 3122     int ci = gretl_command_number(s);
 3123 
 3124     if (ci > 0) {
 3125     pkg->modelreq = ci;
 3126     return 0;
 3127     } else {
 3128     return E_PARSE;
 3129     }
 3130 }
 3131 
 3132 static int pkg_set_datafiles (fnpkg *pkg, const char *s)
 3133 {
 3134     int err = 0;
 3135 
 3136     if (string_is_blank(s)) {
 3137     err = E_DATA;
 3138     } else {
 3139     int n = 0;
 3140 
 3141     pkg->datafiles = gretl_string_split(s, &n, NULL);
 3142     if (pkg->datafiles == NULL) {
 3143         pkg->n_files = 0;
 3144         err = E_ALLOC;
 3145     } else {
 3146         pkg->n_files = n;
 3147     }
 3148     }
 3149 
 3150     if (!err) {
 3151     pkg->uses_subdir = 1;
 3152     }
 3153 
 3154     return err;
 3155 }
 3156 
 3157 static int pkg_set_depends (fnpkg *pkg, const char *s)
 3158 {
 3159     int err = 0;
 3160 
 3161     if (string_is_blank(s)) {
 3162     err = E_DATA;
 3163     } else {
 3164     int n = 0;
 3165 
 3166     pkg->depends = gretl_string_split(s, &n, NULL);
 3167     if (pkg->depends == NULL) {
 3168         pkg->n_depends = 0;
 3169         err = E_ALLOC;
 3170     } else {
 3171         pkg->n_depends = n;
 3172     }
 3173     }
 3174 
 3175     return err;
 3176 }
 3177 
 3178 static int pkg_boolean_from_string (const char *s)
 3179 {
 3180     if (!strcmp(s, "true")) {
 3181     return 1;
 3182     } else {
 3183     return 0;
 3184     }
 3185 }
 3186 
 3187 static int pkg_remove_role (fnpkg *pkg, int role)
 3188 {
 3189     ufunc *u;
 3190     int i;
 3191 
 3192     for (i=0; i<pkg->n_priv; i++) {
 3193     u = pkg->priv[i];
 3194     if (u->pkg_role == role) {
 3195         u->pkg_role = UFUN_ROLE_NONE;
 3196         return 0;
 3197     }
 3198     }
 3199     for (i=0; i<pkg->n_pub; i++) {
 3200     u = pkg->pub[i];
 3201     if (u->pkg_role == role) {
 3202         u->pkg_role = UFUN_ROLE_NONE;
 3203         return 0;
 3204     }
 3205     }
 3206 
 3207     return E_DATA;
 3208 }
 3209 
 3210 static int valid_list_maker (ufunc *u)
 3211 {
 3212     if (u->n_params == 0) {
 3213     return 1; /* OK */
 3214     } else if (u->n_params == 1 &&
 3215            u->params[0].type == GRETL_TYPE_LIST) {
 3216     return 1; /* OK */
 3217     } else {
 3218     return 0;
 3219     }
 3220 }
 3221 
 3222 int function_set_package_role (const char *name, fnpkg *pkg,
 3223                    const char *attr, PRN *prn)
 3224 {
 3225     ufunc *u = NULL;
 3226     int role = pkg_key_get_role(attr);
 3227     int i, j, err = 0;
 3228 
 3229     if (name == NULL) {
 3230     /* removing a role */
 3231     pkg_remove_role(pkg, role);
 3232     return 0;
 3233     }
 3234 
 3235     if (role == UFUN_ROLE_NONE) {
 3236     for (i=0; i<pkg->n_priv; i++) {
 3237         if (!strcmp(name, pkg->priv[i]->name)) {
 3238         u = pkg->priv[i];
 3239         u->pkg_role = role;
 3240         return 0;
 3241         }
 3242     }
 3243     for (i=0; i<pkg->n_pub; i++) {
 3244         if (!strcmp(name, pkg->pub[i]->name)) {
 3245         u = pkg->pub[i];
 3246         u->pkg_role = role;
 3247         return 0;
 3248         }
 3249     }
 3250     return E_DATA;
 3251     }
 3252 
 3253     /* check that the function in question satisfies the
 3254        requirements for its role, and if so, hook it up
 3255     */
 3256 
 3257     if (role == UFUN_GUI_PRECHECK) {
 3258     /* the pre-checker must be a private function */
 3259     for (i=0; i<pkg->n_priv; i++) {
 3260         if (!strcmp(name, pkg->priv[i]->name)) {
 3261         u = pkg->priv[i];
 3262         if (u->rettype != GRETL_TYPE_DOUBLE) {
 3263             pprintf(prn, "%s: must return a scalar\n", attr);
 3264             err = E_TYPES;
 3265         } else if (u->n_params > 0) {
 3266             pprintf(prn, "%s: no parameters are allowed\n", attr);
 3267             err = E_TYPES;
 3268         }
 3269         if (!err) {
 3270             u->pkg_role = role;
 3271         }
 3272         return err; /* found */
 3273         }
 3274     }
 3275     /* not found */
 3276     pprintf(prn, "%s: %s: no such private function\n", attr, name);
 3277     return E_DATA;
 3278     } else if (role == UFUN_LIST_MAKER) {
 3279     /* this too must be a private function */
 3280     for (i=0; i<pkg->n_priv; i++) {
 3281         if (!strcmp(name, pkg->priv[i]->name)) {
 3282         u = pkg->priv[i];
 3283         if (u->rettype != GRETL_TYPE_LIST) {
 3284             pprintf(prn, "%s: must return a list\n", attr);
 3285             err = E_TYPES;
 3286         } else if (!valid_list_maker(u)) {
 3287             pprintf(prn, "%s: must have 0 parameters or a single "
 3288                 "list parameter\n", attr);
 3289             err = E_TYPES;
 3290         }
 3291         if (!err) {
 3292             u->pkg_role = role;
 3293         }
 3294         return err; /* found */
 3295         }
 3296     }
 3297     /* not found */
 3298     pprintf(prn, "%s: %s: no such private function\n", attr, name);
 3299     return E_DATA;
 3300     }
 3301 
 3302     for (i=0; i<pkg->n_pub; i++) {
 3303     /* all other special-role functions must be public */
 3304     if (!strcmp(name, pkg->pub[i]->name)) {
 3305         u = pkg->pub[i];
 3306         if (role == UFUN_GUI_MAIN) {
 3307         ; /* OK, type does not matter */
 3308         } else {
 3309         /* bundle-print, bundle-plot, etc. */
 3310         if (u->n_params == 0) {
 3311             pprintf(prn, "%s: must take a %s argument\n", attr,
 3312                 gretl_type_get_name(GRETL_TYPE_BUNDLE_REF));
 3313             err = E_TYPES;
 3314         }
 3315         for (j=0; j<u->n_params && !err; j++) {
 3316             if (j == 0 && u->params[j].type != GRETL_TYPE_BUNDLE_REF) {
 3317             pprintf(prn, "%s: first param type must be %s\n",
 3318                 attr, gretl_type_get_name(GRETL_TYPE_BUNDLE_REF));
 3319             err = E_TYPES;
 3320             } else if (j == 1 && u->params[j].type != GRETL_TYPE_INT) {
 3321             pprintf(prn, "%s: second param type must be %s\n",
 3322                 attr, gretl_type_get_name(GRETL_TYPE_INT));
 3323             err = E_TYPES;
 3324             } else if (j > 1 && !fn_param_optional(u, j) &&
 3325                    na(fn_param_default(u, j))) {
 3326             pprintf(prn, "%s: params beyond the second must be optional\n",
 3327                 attr);
 3328             err = E_TYPES;
 3329             }
 3330         }
 3331         }
 3332         if (!err) {
 3333         u->pkg_role = role;
 3334         }
 3335         return err;
 3336     }
 3337     }
 3338 
 3339     pprintf(prn, "%s: %s: no such public function\n", attr, name);
 3340 
 3341     return E_DATA;
 3342 }
 3343 
 3344 /* called from the GUI package editor to check whether
 3345    a given function of name @name can be shown as a
 3346    candidate for a specified GUI-special @role
 3347 */
 3348 
 3349 int function_ok_for_package_role (const char *name,
 3350                   int role)
 3351 {
 3352     ufunc *u = NULL;
 3353     int i, err = 0;
 3354 
 3355     if (name == NULL || role == UFUN_ROLE_NONE) {
 3356     return 0;
 3357     }
 3358 
 3359     for (i=0; i<n_ufuns; i++) {
 3360     if (!strcmp(name, ufuns[i]->name)) {
 3361         u = ufuns[i];
 3362         break;
 3363     }
 3364     }
 3365 
 3366     if (u == NULL) {
 3367     return 0;
 3368     }
 3369 
 3370     if (role == UFUN_GUI_PRECHECK) {
 3371     if (u->rettype != GRETL_TYPE_DOUBLE) {
 3372         err = E_TYPES;
 3373     } else if (u->n_params > 0) {
 3374         err = E_TYPES;
 3375     }
 3376     return !err; /* found */
 3377     } else if (role == UFUN_LIST_MAKER) {
 3378     if (u->rettype != GRETL_TYPE_LIST) {
 3379         err = E_TYPES;
 3380     } else if (u->n_params > 0) {
 3381         err = E_TYPES;
 3382     }
 3383     return !err; /* found */
 3384     }
 3385 
 3386     if (role == UFUN_GUI_MAIN) {
 3387     ; /* OK, we don't mind what type it is */
 3388     } else {
 3389     /* bundle-print, bundle-plot, etc. */
 3390     if (u->n_params == 0) {
 3391         err = E_TYPES;
 3392     }
 3393     for (i=0; i<u->n_params && !err; i++) {
 3394         if (i == 0 && u->params[i].type != GRETL_TYPE_BUNDLE_REF) {
 3395         err = E_TYPES;
 3396         } else if (i == 1 && u->params[i].type != GRETL_TYPE_INT) {
 3397         err = E_TYPES;
 3398         } else if (i > 1 && !fn_param_optional(u, i) &&
 3399                na(fn_param_default(u, i))) {
 3400         err = E_TYPES;
 3401         }
 3402     }
 3403     }
 3404 
 3405     return !err;
 3406 }
 3407 
 3408 static int pkg_set_funcs_attribute (fnpkg *pkg, const char *s,
 3409                     int flag)
 3410 {
 3411     char **S;
 3412     int ns = 0, err = 0;
 3413 
 3414     S = gretl_string_split(s, &ns, NULL);
 3415     if (ns == 0) {
 3416     err = E_DATA;
 3417     } else {
 3418     int i, j, match;
 3419 
 3420     for (i=0; i<ns && !err; i++) {
 3421         match = 0;
 3422         for (j=0; j<pkg->n_pub; j++) {
 3423         if (!strcmp(S[i], pkg->pub[j]->name)) {
 3424             pkg->pub[j]->flags |= flag;
 3425             match = 1;
 3426             break;
 3427         }
 3428         }
 3429         if (!match) {
 3430         err = E_DATA;
 3431         }
 3432     }
 3433 
 3434     strings_array_free(S, ns);
 3435     }
 3436 
 3437     return err;
 3438 }
 3439 
 3440 static void function_package_set_auxfile (fnpkg *pkg,
 3441                       const char *id,
 3442                       const char *fname)
 3443 {
 3444     gchar *test = NULL;
 3445 
 3446     /* Maybe set the source filename for an element
 3447        of a function package read from file, but only
 3448        if it's not the standard, default filename for
 3449        the element in question.
 3450     */
 3451 
 3452     if (!strcmp(id, "help-fname")) {
 3453     test = g_strdup_printf("%s_help.txt", pkg->name);
 3454     } else if (!strcmp(id, "gui-help-fname")) {
 3455     test = g_strdup_printf("%s_gui_help.txt", pkg->name);
 3456     } else if (!strcmp(id, "sample-fname")) {
 3457     test = g_strdup_printf("%s_sample.inp", pkg->name);
 3458     }
 3459 
 3460     if (test != NULL) {
 3461     if (strcmp(fname, test)) {
 3462        function_package_set_properties(pkg, id, fname, NULL);
 3463     }
 3464     g_free(test);
 3465     }
 3466 }
 3467 
 3468 static int check_for_pdf_ref (const char *s, fnpkg *pkg,
 3469                   int *err)
 3470 {
 3471     int len, ret = 0;
 3472 
 3473     if (!strncmp(s, "pdfdoc:", 7)) {
 3474     s += 7;
 3475     }
 3476 
 3477     len = strlen(s);
 3478     if (len < 64 && strchr(s, ' ') == NULL && has_suffix(s, ".pdf")) {
 3479     char *tmp = gretl_strndup(s, len - 4);
 3480 
 3481     if (strcmp(tmp, pkg->name)) {
 3482         gretl_errmsg_sprintf(_("PDF doc should be called %s.pdf"), pkg->name);
 3483         *err = E_DATA;
 3484     } else {
 3485         ret = 1;
 3486     }
 3487     free(tmp);
 3488     }
 3489 
 3490     return ret;
 3491 }
 3492 
 3493 static int is_pdf_ref (const char *s)
 3494 {
 3495     if (!strncmp(s, "pdfdoc:", 7)) {
 3496     s += 7;
 3497     }
 3498 
 3499     return strlen(s) < 64 && strchr(s, ' ') == NULL &&
 3500     has_suffix(s, ".pdf");
 3501 }
 3502 
 3503 static int check_R_depends (const char *s)
 3504 {
 3505     int err = 0;
 3506 
 3507     if (strncmp(s, "R ", 2)) {
 3508     err = E_DATA;
 3509     } else {
 3510     /* skip "R " */
 3511     s += 2;
 3512     s += strcspn(s, " ");
 3513     if (*s == '\0') {
 3514         err = E_DATA;
 3515     } else {
 3516         /* skip R version */
 3517         s += strcspn(s, " ");
 3518         while (*s && !err) {
 3519         s += strspn(s, " ");
 3520         if (*s == '\0') break;
 3521         /* R package? */
 3522         s += strcspn(s, " ");
 3523         s += strspn(s, " ");
 3524         if (*s == '\0') {
 3525             /* no version given? */
 3526             err = E_DATA;
 3527         } else {
 3528             /* skip package version */
 3529             s += strcspn(s, " ");
 3530         }
 3531         }
 3532     }
 3533     }
 3534 
 3535     if (err) {
 3536     gretl_errmsg_set("Invalid R-depends line");
 3537     }
 3538 
 3539     return err;
 3540 }
 3541 
 3542 /* Having assembled and checked the function-listing for a new
 3543    package, now retrieve the additional information from the
 3544    spec file (named by @fname, opened as @fp).
 3545 */
 3546 
 3547 static int new_package_info_from_spec (fnpkg *pkg, const char *fname,
 3548                        FILE *fp, gretlopt opt,
 3549                        PRN *prn)
 3550 {
 3551     const char *okstr, *failed;
 3552     gchar *currdir = NULL;
 3553     int quiet = (opt & OPT_Q);
 3554     char *p, line[1024];
 3555     int got = 0;
 3556     int err = 0;
 3557 
 3558     if (opt & OPT_G) {
 3559     /* GUI use */
 3560     okstr = "<@ok>\n";
 3561     failed = "<@fail>\n";
 3562     } else {
 3563     okstr = "OK\n";
 3564     failed = "failed\n";
 3565     }
 3566 
 3567     if (strrchr(fname, SLASH) != NULL) {
 3568     /* directory change needed */
 3569     char dirname[FILENAME_MAX];
 3570 
 3571     strcpy(dirname, fname);
 3572     p = strrchr(dirname, SLASH);
 3573     *p = '\0';
 3574     currdir = g_get_current_dir();
 3575     err = gretl_chdir(dirname);
 3576     }
 3577 
 3578 #if PKG_DEBUG
 3579     fprintf(stderr, "new_package_info_from_spec\n");
 3580 #endif
 3581 
 3582     while (fgets(line, sizeof line, fp) && !err) {
 3583     if (*line == '#' || string_is_blank(line)) {
 3584         continue;
 3585     }
 3586     tailstrip(line);
 3587     p = strchr(line, '=');
 3588     if (p == NULL) {
 3589         continue;
 3590     } else {
 3591         p++;
 3592         p += strspn(p, " ");
 3593         if (!strncmp(line, "author", 6)) {
 3594         err = function_package_set_properties(pkg, "author", p, NULL);
 3595         if (!err) got++;
 3596         } else if (!strncmp(line, "email", 5)) {
 3597         err = function_package_set_properties(pkg, "email", p, NULL);
 3598         } else if (!strncmp(line, "version", 7)) {
 3599         err = function_package_set_properties(pkg, "version", p, NULL);
 3600         if (!err) got++;
 3601         } else if (!strncmp(line, "date", 4)) {
 3602         err = function_package_set_properties(pkg, "date", p, NULL);
 3603         if (!err) got++;
 3604         } else if (!strncmp(line, "description", 11)) {
 3605         err = function_package_set_properties(pkg, "description", p, NULL);
 3606         if (!err) got++;
 3607         } else if (!strncmp(line, "tags", 4)) {
 3608         err = function_package_set_properties(pkg, "tags", p, NULL);
 3609         } else if (!strncmp(line, "label", 5)) {
 3610         err = function_package_set_properties(pkg, "label", p, NULL);
 3611         } else if (!strncmp(line, "menu-attachment", 15)) {
 3612         err = function_package_set_properties(pkg, "menu-attachment", p, NULL);
 3613         } else if (!strncmp(line, "provider", 8)) {
 3614         if (!quiet) {
 3615             pprintf(prn, "Recording provider %s\n", p);
 3616         }
 3617         err = function_package_set_properties(pkg, "provider", p, NULL);
 3618         } else if (!strncmp(line, "help", 4)) {
 3619         gchar *hstr = NULL;
 3620         int pdfdoc;
 3621 
 3622         pdfdoc = check_for_pdf_ref(p, pkg, &err);
 3623         if (pdfdoc) {
 3624             if (!quiet) {
 3625             pprintf(prn, "Recording help reference %s\n", p);
 3626             }
 3627             hstr = g_strdup_printf("pdfdoc:%s", p);
 3628         } else if (!err) {
 3629             if (!quiet) {
 3630             pprintf(prn, "Looking for help text in %s... ", p);
 3631             }
 3632             hstr = pkg_aux_content(p, &err);
 3633             if (err) {
 3634             pputs(prn, failed);
 3635             } else {
 3636             pputs(prn, okstr);
 3637             }
 3638         }
 3639         if (!err) {
 3640             err = function_package_set_properties(pkg, "help", hstr, NULL);
 3641             if (!err) {
 3642             got++;
 3643             if (!pdfdoc) {
 3644                 function_package_set_auxfile(pkg, "help-fname", p);
 3645             }
 3646             }
 3647         }
 3648         g_free(hstr);
 3649         } else if (!strncmp(line, "gui-help", 8)) {
 3650         gchar *ghstr = NULL;
 3651 
 3652         if (!quiet) {
 3653             pprintf(prn, "Looking for GUI help text in %s... ", p);
 3654         }
 3655         ghstr = pkg_aux_content(p, &err);
 3656         if (err) {
 3657             pputs(prn, failed);
 3658         } else {
 3659             pputs(prn, okstr);
 3660             err = function_package_set_properties(pkg, "gui-help", ghstr, NULL);
 3661             if (!err) {
 3662             function_package_set_auxfile(pkg, "gui-help-fname", p);
 3663             }
 3664         }
 3665         g_free(ghstr);
 3666         } else if (!strncmp(line, "sample-script", 13)) {
 3667         gchar *script = NULL;
 3668 
 3669         if (!quiet) {
 3670             pprintf(prn, "Looking for sample script in %s... ", p);
 3671         }
 3672         script = pkg_aux_content(p, &err);
 3673         if (err) {
 3674             pputs(prn, failed);
 3675         } else {
 3676             pputs(prn, okstr);
 3677             err = function_package_set_properties(pkg, "sample-script", script, NULL);
 3678             if (!err) {
 3679             got++;
 3680             function_package_set_auxfile(pkg, "sample-fname", p);
 3681             }
 3682         }
 3683         g_free(script);
 3684         } else if (!strncmp(line, "data-files", 10)) {
 3685         if (!quiet) {
 3686             pprintf(prn, "Recording data-file list: %s\n", p);
 3687         }
 3688         err = pkg_set_datafiles(pkg, p);
 3689         } else if (!strncmp(line, "depends", 7)) {
 3690         if (!quiet) {
 3691             pprintf(prn, "Recording dependency list: %s\n", p);
 3692         }
 3693         err = pkg_set_depends(pkg, p);
 3694         } else if (!strncmp(line, "R-depends", 9)) {
 3695         err = check_R_depends(p);
 3696         if (!err) {
 3697             if (!quiet) {
 3698             pprintf(prn, "Recording R dependency list: %s\n", p);
 3699             }
 3700             err = function_package_set_properties(pkg, "R-depends",p, NULL);
 3701         }
 3702         } else if (!strncmp(line, "data-requirement", 16)) {
 3703         err = pkg_set_dreq(pkg, p);
 3704         } else if (!strncmp(line, "model-requirement", 17)) {
 3705         err = pkg_set_modelreq(pkg, p);
 3706         } else if (!strncmp(line, "min-version", 11)) {
 3707         pkg->minver = gretl_version_number(p);
 3708         got++;
 3709         } else if (!strncmp(line, "lives-in-subdir", 15)) {
 3710         pkg->uses_subdir = pkg_boolean_from_string(p);
 3711         } else if (!strncmp(line, "wants-data-access", 17)) {
 3712         pkg->data_access = pkg_boolean_from_string(p);
 3713         } else if (!strncmp(line, "no-print", 8)) {
 3714         err = pkg_set_funcs_attribute(pkg, p, UFUN_NOPRINT);
 3715         } else if (!strncmp(line, "menu-only", 9)) {
 3716         err = pkg_set_funcs_attribute(pkg, p, UFUN_MENU_ONLY);
 3717         } else {
 3718         const char *key;
 3719         int i;
 3720 
 3721         for (i=0; pkg_lookups[i].key != NULL; i++) {
 3722             key = pkg_lookups[i].key;
 3723             if (!strncmp(line, key, strlen(key))) {
 3724             err = function_set_package_role(p, pkg, key, prn);
 3725             if (!err && !quiet) {
 3726                 pprintf(prn, "%s function is %s, %s", key, p, okstr);
 3727             }
 3728             break;
 3729             }
 3730         }
 3731         }
 3732     }
 3733     }
 3734 
 3735     if (!err && pkg->provider != NULL) {
 3736     /* in case provider isn't registered as a dependency */
 3737     err = strings_array_prepend_uniq(&pkg->depends, &pkg->n_depends,
 3738                      pkg->provider);
 3739     }
 3740 
 3741     if (currdir != NULL) {
 3742     /* go back where we came from */
 3743     gretl_chdir(currdir);
 3744     g_free(currdir);
 3745     }
 3746 
 3747     if (!err && got < 7) {
 3748     gretl_errmsg_set("Some required information was missing");
 3749     err = E_DATA;
 3750     }
 3751 
 3752     return err;
 3753 }
 3754 
 3755 static fnpkg *new_pkg_from_spec_file (const char *gfnname, gretlopt opt,
 3756                       PRN *prn, int *err)
 3757 {
 3758     fnpkg *pkg = NULL;
 3759     char fname[FILENAME_MAX];
 3760     char line[4096], cont[1024];
 3761     int quiet = (opt & OPT_Q);
 3762     FILE *fp;
 3763 
 3764     if (!has_suffix(gfnname, ".gfn")) {
 3765     gretl_errmsg_set("Output must have extension \".gfn\"");
 3766     *err = E_DATA;
 3767     return NULL;
 3768     }
 3769 
 3770     switch_ext(fname, gfnname, "spec");
 3771     fp = gretl_fopen(fname, "r"); /* "rb" ? */
 3772 
 3773     if (fp == NULL) {
 3774     *err = E_FOPEN;
 3775     } else {
 3776     char **pubnames = NULL;
 3777     char **privnames = NULL;
 3778     int npub = 0, npriv = 0;
 3779     ufunc *uf;
 3780     int i;
 3781 
 3782     if (!quiet) {
 3783         pprintf(prn, "Found spec file '%s'\n", fname);
 3784     }
 3785 
 3786     /* first pass: gather names of public functions */
 3787 
 3788     while (fgets(line, sizeof line, fp) && !*err) {
 3789         if (!strncmp(line, "public =", 8)) {
 3790         while (ends_with_backslash(line)) {
 3791             gretl_charsub(line, '\\', '\0');
 3792             *cont = '\0';
 3793             if (fgets(cont, sizeof cont, fp)) {
 3794             strcat(line, cont);
 3795             } else {
 3796             *err = E_DATA;
 3797             }
 3798         }
 3799         if (!*err) {
 3800             tailstrip(line);
 3801             pubnames = gretl_string_split(line + 8, &npub, NULL);
 3802             if (npub == 0) {
 3803             *err = E_DATA;
 3804             }
 3805         }
 3806         }
 3807     }
 3808 
 3809     if (!*err) {
 3810         if (!quiet) {
 3811         pprintf(prn, "number of public interfaces = %d\n", npub);
 3812         }
 3813         for (i=0; i<npub && !*err; i++) {
 3814         uf = get_user_function_by_name(pubnames[i]);
 3815         if (!quiet) {
 3816             pprintf(prn, " %s", pubnames[i]);
 3817         }
 3818         if (uf == NULL) {
 3819             if (!quiet) {
 3820             pputs(prn, ": *** not found");
 3821             }
 3822             gretl_errmsg_sprintf("'%s': no such function", pubnames[i]);
 3823             *err = E_DATA;
 3824         }
 3825         if (!quiet) {
 3826             pputc(prn, '\n');
 3827         }
 3828         }
 3829     }
 3830 
 3831     /* note: any other functions currently loaded are assumed to be
 3832        private functions for this package */
 3833 
 3834     if (!*err) {
 3835         npriv = n_free_functions() - npub;
 3836         if (npriv < 0) {
 3837         npriv = 0;
 3838         }
 3839     }
 3840 
 3841     if (!*err && npriv > 0) {
 3842         npriv = 0;
 3843         for (i=0; i<n_ufuns && !*err; i++) {
 3844         if (ufuns[i]->pkg == NULL && is_unclaimed(ufuns[i]->name, pubnames, npub)) {
 3845             *err = strings_array_add(&privnames, &npriv, ufuns[i]->name);
 3846         }
 3847         }
 3848     }
 3849 
 3850     if (!quiet && !*err && npriv > 0) {
 3851         pprintf(prn, "number of private functions = %d\n", npriv);
 3852         for (i=0; i<npriv; i++) {
 3853         pprintf(prn, " %s\n", privnames[i]);
 3854         }
 3855     }
 3856 
 3857     if (!*err) {
 3858         pkg = function_package_new(gfnname, pubnames, npub,
 3859                        privnames, npriv, err);
 3860     }
 3861 
 3862     strings_array_free(pubnames, npub);
 3863     strings_array_free(privnames, npriv);
 3864 
 3865     if (!*err) {
 3866         rewind(fp);
 3867         *err = new_package_info_from_spec(pkg, fname, fp, opt, prn);
 3868     }
 3869 
 3870     if (*err && pkg != NULL) {
 3871         real_function_package_unload(pkg, 0);
 3872         pkg = NULL;
 3873     }
 3874 
 3875     fclose(fp);
 3876     }
 3877 
 3878     return pkg;
 3879 }
 3880 
 3881 static int cli_validate_package_file (const char *fname,
 3882                       gretlopt opt, PRN *prn)
 3883 {
 3884     char dtdname[FILENAME_MAX];
 3885     xmlDocPtr doc = NULL;
 3886     xmlDtdPtr dtd = NULL;
 3887     int err;
 3888 
 3889     err = gretl_xml_open_doc_root(fname, NULL, &doc, NULL);
 3890     if (err) {
 3891     pprintf(prn, "Couldn't parse %s\n", fname);
 3892     return 1;
 3893     }
 3894 
 3895     *dtdname = '\0';
 3896 
 3897     if (opt & OPT_D) {
 3898     const char *dpath = get_optval_string(MAKEPKG, OPT_D);
 3899 
 3900     if (dpath != NULL && *dpath != '\0') {
 3901         strcat(dtdname, dpath);
 3902     }
 3903     } else {
 3904     sprintf(dtdname, "%sfunctions%cgretlfunc.dtd", gretl_home(), SLASH);
 3905     }
 3906 
 3907     if (*dtdname != '\0') {
 3908     dtd = xmlParseDTD(NULL, (const xmlChar *) dtdname);
 3909     }
 3910 
 3911     if (dtd == NULL) {
 3912     pputs(prn, "Couldn't open DTD to check package\n");
 3913     } else {
 3914     const char *pkgname = path_last_element(fname);
 3915     xmlValidCtxtPtr cvp = xmlNewValidCtxt();
 3916 
 3917     if (cvp == NULL) {
 3918         pputs(prn, "Couldn't get an XML validation context\n");
 3919         xmlFreeDtd(dtd);
 3920         xmlFreeDoc(doc);
 3921         return 0;
 3922     }
 3923 
 3924     cvp->userData = (void *) prn;
 3925     cvp->error    = (xmlValidityErrorFunc) pprintf2;
 3926     cvp->warning  = (xmlValidityWarningFunc) pprintf2;
 3927 
 3928     pprintf(prn, "Checking against %s\n", dtdname);
 3929 
 3930     if (!xmlValidateDtd(cvp, doc, dtd)) {
 3931         err = 1;
 3932     } else {
 3933         pprintf(prn, _("%s: validated against DTD OK"), pkgname);
 3934         pputc(prn, '\n');
 3935     }
 3936 
 3937     xmlFreeValidCtxt(cvp);
 3938     xmlFreeDtd(dtd);
 3939     }
 3940 
 3941     xmlFreeDoc(doc);
 3942 
 3943     return err;
 3944 }
 3945 
 3946 static int get_gfn_info_for_zip (const char *fname,
 3947                  int *pdfdoc,
 3948                  char ***datafiles,
 3949                  int *n_datafiles)
 3950 {
 3951     xmlDocPtr doc = NULL;
 3952     xmlNodePtr node = NULL;
 3953     xmlNodePtr sub;
 3954     int found = 0;
 3955     int err = 0;
 3956 
 3957     err = gretl_xml_open_doc_root(fname, "gretl-functions", &doc, &node);
 3958     if (err) {
 3959     return err;
 3960     }
 3961 
 3962     node = node->xmlChildrenNode;
 3963     while (node != NULL && found < 2) {
 3964     if (!xmlStrcmp(node->name, (XUC) "gretl-function-package")) {
 3965         sub = node->xmlChildrenNode;
 3966         while (sub != NULL && found < 2) {
 3967         if (!xmlStrcmp(sub->name, (XUC) "help")) {
 3968             char *s = NULL;
 3969 
 3970             gretl_xml_node_get_trimmed_string(sub, doc, &s);
 3971             *pdfdoc = is_pdf_ref(s);
 3972             free(s);
 3973             found++;
 3974         } else if (!xmlStrcmp(sub->name, (XUC) "data-files")) {
 3975             *datafiles =
 3976             gretl_xml_get_strings_array(sub, doc, n_datafiles,
 3977                             0, &err);
 3978             found++;
 3979         } else if (!xmlStrcmp(sub->name, (XUC) "gretl-function")) {
 3980             /* we've overshot */
 3981             found = 2;
 3982         }
 3983         sub = sub->next;
 3984         }
 3985     }
 3986     node = node->next;
 3987     }
 3988 
 3989     if (doc != NULL) {
 3990     xmlFreeDoc(doc);
 3991     }
 3992 
 3993     return err;
 3994 }
 3995 
 3996 static int cli_build_zip_package (const char *fname,
 3997                   const char *gfnname,
 3998                   fnpkg *pkg,
 3999                   PRN *prn)
 4000 {
 4001     char **datafiles = NULL;
 4002     int n_datafiles = 0;
 4003     int pdfdoc = 0;
 4004     int freeit = 0;
 4005     int err = 0;
 4006 
 4007     if (pkg != NULL) {
 4008     datafiles = pkg->datafiles;
 4009     n_datafiles = pkg->n_files;
 4010     pdfdoc = is_pdf_ref(pkg->help);
 4011     } else {
 4012     /* grope in the gfn file */
 4013     err = get_gfn_info_for_zip(gfnname,
 4014                    &pdfdoc,
 4015                    &datafiles,
 4016                    &n_datafiles);
 4017     freeit = 1;
 4018     }
 4019 
 4020     if (!err) {
 4021     err = package_make_zipfile(gfnname,
 4022                    pdfdoc,
 4023                    datafiles,
 4024                    n_datafiles,
 4025                    NULL,
 4026                    fname,
 4027                    OPT_NONE,
 4028                    prn);
 4029     }
 4030 
 4031     if (freeit) {
 4032     strings_array_free(datafiles, n_datafiles);
 4033     }
 4034 
 4035     return err;
 4036 }
 4037 
 4038 static int should_rebuild_gfn (const char *gfnname)
 4039 {
 4040     char testname[FILENAME_MAX];
 4041     struct stat b1, b2, b3;
 4042     int err;
 4043 
 4044     err = gretl_stat(gfnname, &b1);
 4045     if (err) {
 4046     /* gfn not found: so have to rebuild */
 4047     return 1;
 4048     }
 4049 
 4050     switch_ext(testname, gfnname, "inp");
 4051     err = gretl_stat(testname, &b2);
 4052     if (err) {
 4053     /* no corresponding inp: can't rebuild */
 4054     return 0;
 4055     }
 4056 
 4057     switch_ext(testname, gfnname, "spec");
 4058     err = gretl_stat(testname, &b3);
 4059     if (err) {
 4060     /* no corresponding spec: can't rebuild */
 4061     return 0;
 4062     }
 4063 
 4064     if (b2.st_mtime > b1.st_mtime ||
 4065     b3.st_mtime > b1.st_mtime) {
 4066     /* inp or spec is newer than gfn */
 4067     return 1;
 4068     }
 4069 
 4070     return 0;
 4071 }
 4072 
 4073 /**
 4074  * create_and_write_function_package:
 4075  * @fname: filename for function package.
 4076  * @opt: may include OPT_I to write a package-index entry,
 4077  * OPT_T to write translatable strings.
 4078  * @prn: printer struct for feedback.
 4079  *
 4080  * Create a package based on the functions currently loaded, and
 4081  * write it out as an XML file. Responds to the makepkg command.
 4082  *
 4083  * Returns: 0 on success, non-zero on error.
 4084  */
 4085 
 4086 int create_and_write_function_package (const char *fname,
 4087                        gretlopt opt,
 4088                        PRN *prn)
 4089 {
 4090     char gfnname[FILENAME_MAX];
 4091     fnpkg *pkg = NULL;
 4092     int build_gfn = 1;
 4093     int build_zip = 0;
 4094     int err = 0;
 4095 
 4096     if (has_suffix(fname, ".zip")) {
 4097     /* building a zip package */
 4098     switch_ext(gfnname, fname, "gfn");
 4099     build_gfn = should_rebuild_gfn(gfnname);
 4100     build_zip = 1;
 4101     } else {
 4102     /* just building a gfn file */
 4103     strcpy(gfnname, fname);
 4104     }
 4105 
 4106     if (build_gfn && n_free_functions() == 0) {
 4107     gretl_errmsg_set(_("No functions are available for packaging at present."));
 4108     err = E_DATA;
 4109     } else if (build_gfn) {
 4110     pkg = new_pkg_from_spec_file(gfnname, opt, prn, &err);
 4111     if (pkg != NULL) {
 4112         err = function_package_write_file(pkg);
 4113         if (!err) {
 4114         err = cli_validate_package_file(gfnname, opt, prn);
 4115         /* should we delete @gfnname ? */
 4116         }
 4117         if (!err) {
 4118         if (opt & OPT_T) {
 4119             package_write_translatable_strings(pkg, prn);
 4120         }
 4121         if (opt & OPT_I) {
 4122             package_write_index(pkg, prn);
 4123         }
 4124         }
 4125     }
 4126     }
 4127 
 4128     if (!err && build_zip) {
 4129     err = cli_build_zip_package(fname, gfnname, pkg, prn);
 4130     }
 4131 
 4132     return err;
 4133 }
 4134 
 4135 /**
 4136  * function_package_get_name:
 4137  * @pkg: function package.
 4138  *
 4139  * Returns: the name of the package.
 4140  */
 4141 
 4142 const char *function_package_get_name (fnpkg *pkg)
 4143 {
 4144     return (pkg != NULL)? pkg->name : NULL;
 4145 }
 4146 
 4147 /**
 4148  * function_package_get_version:
 4149  * @pkg: function package.
 4150  *
 4151  * Returns: the name of the package.
 4152  */
 4153 
 4154 double function_package_get_version (fnpkg *pkg)
 4155 {
 4156     if (pkg == NULL) {
 4157     return NADBL;
 4158     } else {
 4159     return dot_atof(pkg->version);
 4160     }
 4161 }
 4162 
 4163 static int maybe_replace_string_var (char **svar, const char *src)
 4164 {
 4165     if (src == NULL) {
 4166     gretl_errmsg_set("string value is missing");
 4167     return E_DATA;
 4168     } else {
 4169     free(*svar);
 4170     *svar = gretl_strdup(src);
 4171     return (*svar == NULL)? E_ALLOC : 0;
 4172     }
 4173 }
 4174 
 4175 /* unlike the case above, here we'll accept NULL for @src, to wipe
 4176    out an existing string var */
 4177 
 4178 static int maybe_replace_optional_string_var (char **svar, const char *src)
 4179 {
 4180     if (src == NULL) {
 4181     free(*svar);
 4182     *svar = NULL;
 4183     return 0;
 4184     } else {
 4185     free(*svar);
 4186     *svar = gretl_strdup(src);
 4187     return (*svar == NULL)? E_ALLOC : 0;
 4188     }
 4189 }
 4190 
 4191 /* Called (indirectly) from GUI function packager. Note that we're
 4192    careful not to touch UFUN_PRIVATE or UFUN_PLUGIN on the uf->flags
 4193    side, since these flags are not represented in @attrs.
 4194 */
 4195 
 4196 static void pkg_set_gui_attrs (fnpkg *pkg, const unsigned char *attrs)
 4197 {
 4198     ufunc *uf;
 4199     int i, r;
 4200 
 4201     for (r=1; r<UFUN_GUI_PRECHECK; r++) {
 4202     uf = NULL;
 4203     for (i=0; i<n_ufuns; i++) {
 4204         if (ufuns[i]->pkg == pkg && ufuns[i]->pkg_role == r) {
 4205         uf = ufuns[i];
 4206         break;
 4207         }
 4208     }
 4209     if (uf != NULL) {
 4210         if (attrs[r-1] & UFUN_NOPRINT) {
 4211         uf->flags |= UFUN_NOPRINT;
 4212         } else {
 4213         uf->flags &= ~UFUN_NOPRINT;
 4214         }
 4215         if (attrs[r-1] & UFUN_MENU_ONLY) {
 4216         uf->flags |= UFUN_MENU_ONLY;
 4217         } else {
 4218         uf->flags &= ~UFUN_MENU_ONLY;
 4219         }
 4220     }
 4221     }
 4222 }
 4223 
 4224 /* Called (indirectly) from GUI function packager. Note that we scrub
 4225    UFUN_PRIVATE and UFUN_PLUGIN from the user function flags passed to
 4226    the packager: UFUN_PLUGIN is irrelevant and UFUN_PRIVATE is handled
 4227    by a different mechanism.
 4228 */
 4229 
 4230 static void pkg_get_gui_attrs (fnpkg *pkg, unsigned char *attrs)
 4231 {
 4232     ufunc *uf;
 4233     int i, r;
 4234 
 4235     for (r=1; r<UFUN_GUI_PRECHECK; r++) {
 4236     uf = NULL;
 4237     for (i=0; i<n_ufuns; i++) {
 4238         if (ufuns[i]->pkg == pkg && ufuns[i]->pkg_role == r) {
 4239         uf = ufuns[i];
 4240         break;
 4241         }
 4242     }
 4243     if (uf == NULL) {
 4244         attrs[r-1] = 0;
 4245     } else {
 4246         attrs[r-1] = uf->flags & ~(UFUN_PRIVATE | UFUN_PLUGIN);
 4247     }
 4248     }
 4249 }
 4250 
 4251 static char **pkg_strvar_pointer (fnpkg *pkg, const char *key,
 4252                   int *optional)
 4253 {
 4254     *optional = 0;
 4255 
 4256     if (!strcmp(key, "fname")) {
 4257     return &pkg->fname;
 4258     } else if (!strcmp(key, "author")) {
 4259     return &pkg->author;
 4260     } else if (!strcmp(key, "email")) {
 4261     return &pkg->email;
 4262     } else if (!strcmp(key, "version")) {
 4263     return &pkg->version;
 4264     } else if (!strcmp(key, "date")) {
 4265     return &pkg->date;
 4266     } else if (!strcmp(key, "description")) {
 4267     return &pkg->descrip;
 4268     } else if (!strcmp(key, "help")) {
 4269     return &pkg->help;
 4270     } else if (!strcmp(key, "sample-script")) {
 4271     return &pkg->sample;
 4272     }
 4273 
 4274     *optional = 1;
 4275 
 4276     if (!strcmp(key, "tags")) {
 4277     return &pkg->tags; /* FIXME should be non-optional */
 4278     } else if (!strcmp(key, "label")) {
 4279     return &pkg->label;
 4280     } else if (!strcmp(key, "menu-attachment")) {
 4281     return &pkg->mpath;
 4282     } else if (!strcmp(key, "gui-help")) {
 4283     return &pkg->gui_help;
 4284     } else if (!strcmp(key, "R-depends")) {
 4285     return &pkg->Rdeps;
 4286     } else if (!strcmp(key, "help-fname")) {
 4287     return &pkg->help_fname;
 4288     } else if (!strcmp(key, "gui-help-fname")) {
 4289     return &pkg->gui_help_fname;
 4290     } else if (!strcmp(key, "sample-fname")) {
 4291     return &pkg->sample_fname;
 4292     } else if (!strcmp(key, "provider")) {
 4293     return &pkg->provider;
 4294     }
 4295 
 4296     return NULL;
 4297 }
 4298 
 4299 /* varargs function for setting the properties of a function
 4300    package: the settings take the form of a NULL-terminated
 4301    set of (key, value) pairs.
 4302 */
 4303 
 4304 int function_package_set_properties (fnpkg *pkg, ...)
 4305 {
 4306     va_list ap;
 4307     const char *key;
 4308     char **sptr;
 4309     int optional;
 4310     int i, err = 0;
 4311 
 4312     va_start(ap, pkg);
 4313 
 4314     for (i=1; !err; i++) {
 4315     key = va_arg(ap, const char *);
 4316     if (key == NULL) {
 4317         break;
 4318     }
 4319 
 4320     sptr = pkg_strvar_pointer(pkg, key, &optional);
 4321 
 4322     if (sptr != NULL) {
 4323         const char *sval = va_arg(ap, const char *);
 4324 
 4325         if (optional) {
 4326         err = maybe_replace_optional_string_var(sptr, sval);
 4327         } else {
 4328         err = maybe_replace_string_var(sptr, sval);
 4329         }
 4330 
 4331         if (!err && !strcmp(key, "help")) {
 4332         if (!strncmp(sval, "pdfdoc", 6) ||
 4333             is_pdf_ref(sval)) {
 4334             pkg->uses_subdir = 1;
 4335         }
 4336         }
 4337     } else if (!strcmp(key, "gui-attrs")) {
 4338         const unsigned char *np = va_arg(ap, const unsigned char *);
 4339 
 4340         pkg_set_gui_attrs(pkg, np);
 4341     } else {
 4342         int ival = va_arg(ap, int);
 4343 
 4344         if (!strcmp(key, "data-requirement")) {
 4345         pkg->dreq = ival;
 4346         } else if (!strcmp(key, "model-requirement")) {
 4347         pkg->modelreq = ival;
 4348         } else if (!strcmp(key, "min-version")) {
 4349         pkg->minver = ival;
 4350         } else if (!strcmp(key, "lives-in-subdir")) {
 4351         pkg->uses_subdir = (ival != 0);
 4352         } else if (!strcmp(key, "wants-data-access")) {
 4353         pkg->data_access = (ival != 0);
 4354         }
 4355     }
 4356     }
 4357 
 4358     va_end(ap);
 4359 
 4360     return err;
 4361 }
 4362 
 4363 enum {
 4364     PUBLIST,
 4365     GUILIST,
 4366     PRIVLIST
 4367 };
 4368 
 4369 /* From a function package get a list of either its public or its
 4370    private functions, in the form of a simple gretl list.  The
 4371    elements of this list are just the positions of these functions in
 4372    the current recorder array for user-functions.  This is fine if
 4373    the information is to be used right away (as in the GUI function
 4374    call dialog), but it should _not_ be assumed that the identifiers
 4375    will remain valid indefinitely.
 4376 */
 4377 
 4378 static int *function_package_get_list (fnpkg *pkg, int code, int n)
 4379 {
 4380     int *list = NULL;
 4381     int j = 0;
 4382 
 4383     if (n > 0) {
 4384     list = gretl_list_new(n);
 4385     if (list != NULL) {
 4386         int i, priv, menu_only;
 4387 
 4388         for (i=0; i<n_ufuns; i++) {
 4389         if (ufuns[i]->pkg == pkg) {
 4390             priv = function_is_private(ufuns[i]);
 4391             menu_only = function_is_menu_only(ufuns[i]);
 4392             if (code == PRIVLIST && priv) {
 4393             list[++j] = i;
 4394             } else if (code == PUBLIST && !priv) {
 4395             list[++j] = i;
 4396             } else if (code == GUILIST && !priv && !menu_only &&
 4397                    !pkg_aux_role(ufuns[i]->pkg_role)) {
 4398             /* in the GUI list of public functions, don't
 4399                display post-processing functions
 4400             */
 4401             list[++j] = i;
 4402             }
 4403         }
 4404         }
 4405     }
 4406     }
 4407 
 4408     if (list != NULL) {
 4409     if (j == 0) {
 4410         free(list);
 4411         list = NULL;
 4412     } else {
 4413         list[0] = j;
 4414     }
 4415     }
 4416 
 4417     return list;
 4418 }
 4419 
 4420 static char *pkg_get_special_func (fnpkg *pkg, UfunRole role)
 4421 {
 4422     int i;
 4423 
 4424     for (i=0; i<n_ufuns; i++) {
 4425     if (ufuns[i]->pkg == pkg && ufuns[i]->pkg_role == role) {
 4426         return g_strdup(ufuns[i]->name);
 4427     }
 4428     }
 4429 
 4430     return NULL;
 4431 }
 4432 
 4433 static int pkg_get_special_func_id (fnpkg *pkg, UfunRole role)
 4434 {
 4435     int i;
 4436 
 4437     for (i=0; i<n_ufuns; i++) {
 4438     if (ufuns[i]->pkg == pkg && ufuns[i]->pkg_role == role) {
 4439         return i;
 4440     }
 4441     }
 4442 
 4443     return -1;
 4444 }
 4445 
 4446 static void handle_optional_string (char **ps, const char *src)
 4447 {
 4448     if (src == NULL) {
 4449     *ps = NULL;
 4450     } else {
 4451     *ps = g_strdup(src);
 4452     }
 4453 }
 4454 
 4455 /* varargs function for retrieving the properties of a function
 4456    package: the arguments after @pkg take the form of a
 4457    NULL-terminated set of (key, pointer) pairs; values are written to
 4458    the locations given by the pointers.
 4459 */
 4460 
 4461 int function_package_get_properties (fnpkg *pkg, ...)
 4462 {
 4463     va_list ap;
 4464     int npub = 0;
 4465     int npriv = 0;
 4466     int **plist;
 4467     const char *key;
 4468     void *ptr;
 4469     char **ps;
 4470     int *pi;
 4471     int i, err = 0;
 4472 
 4473     g_return_val_if_fail(pkg != NULL, E_DATA);
 4474 
 4475     for (i=0; i<n_ufuns; i++) {
 4476     if (ufuns[i]->pkg == pkg) {
 4477         if (function_is_private(ufuns[i])) {
 4478         npriv++;
 4479         } else {
 4480         npub++;
 4481         }
 4482     }
 4483     }
 4484 
 4485     va_start(ap, pkg);
 4486 
 4487     for (i=1; ; i++) {
 4488     key = va_arg(ap, const char *);
 4489     if (key == NULL) {
 4490         break;
 4491     }
 4492     ptr = va_arg(ap, void *);
 4493     if (ptr == NULL) {
 4494         break;
 4495     }
 4496     if (!strcmp(key, "name")) {
 4497         ps = (char **) ptr;
 4498         *ps = g_strdup(pkg->name);
 4499     } else if (!strcmp(key, "author")) {
 4500         ps = (char **) ptr;
 4501         *ps = g_strdup(pkg->author);
 4502     } else if (!strcmp(key, "email")) {
 4503         ps = (char **) ptr;
 4504         if (pkg->email != NULL) {
 4505         *ps = g_strdup(pkg->email);
 4506         } else {
 4507         *ps = g_strdup(""); /* ? */
 4508         }
 4509     } else if (!strcmp(key, "date")) {
 4510         ps = (char **) ptr;
 4511         *ps = g_strdup(pkg->date);
 4512     } else if (!strcmp(key, "version")) {
 4513         ps = (char **) ptr;
 4514         *ps = g_strdup(pkg->version);
 4515     } else if (!strcmp(key, "description")) {
 4516         ps = (char **) ptr;
 4517         *ps = g_strdup(pkg->descrip);
 4518     } else if (!strcmp(key, "help")) {
 4519         ps = (char **) ptr;
 4520         *ps = g_strdup(pkg->help);
 4521     } else if (!strcmp(key, "gui-help")) {
 4522         ps = (char **) ptr;
 4523         handle_optional_string(ps, pkg->gui_help);
 4524     } else if (!strcmp(key, "R-depends")) {
 4525         ps = (char **) ptr;
 4526         handle_optional_string(ps, pkg->Rdeps);
 4527     } else if (!strcmp(key, "sample-script")) {
 4528         ps = (char **) ptr;
 4529         *ps = g_strdup(pkg->sample);
 4530     } else if (!strcmp(key, "help-fname")) {
 4531         ps = (char **) ptr;
 4532         handle_optional_string(ps, pkg->help_fname);
 4533     } else if (!strcmp(key, "gui-help-fname")) {
 4534         ps = (char **) ptr;
 4535         handle_optional_string(ps, pkg->gui_help_fname);
 4536     } else if (!strcmp(key, "sample-fname")) {
 4537         ps = (char **) ptr;
 4538         handle_optional_string(ps, pkg->sample_fname);
 4539     } else if (!strcmp(key, "tags")) {
 4540         ps = (char **) ptr;
 4541         *ps = g_strdup(pkg->tags);
 4542     } else if (!strcmp(key, "label")) {
 4543         ps = (char **) ptr;
 4544         *ps = g_strdup(pkg->label);
 4545     } else if (!strcmp(key, "menu-attachment")) {
 4546         ps = (char **) ptr;
 4547         *ps = g_strdup(pkg->mpath);
 4548     } else if (!strcmp(key, "provider")) {
 4549         ps = (char **) ptr;
 4550         *ps = g_strdup(pkg->provider);
 4551     } else if (!strcmp(key, "data-requirement")) {
 4552         pi = (int *) ptr;
 4553         *pi = pkg->dreq;
 4554     } else if (!strcmp(key, "model-requirement")) {
 4555         pi = (int *) ptr;
 4556         *pi = pkg->modelreq;
 4557     } else if (!strcmp(key, "min-version")) {
 4558         pi = (int *) ptr;
 4559         *pi = pkg->minver;
 4560     } else if (!strcmp(key, "lives-in-subdir")) {
 4561         pi = (int *) ptr;
 4562         *pi = pkg->uses_subdir;
 4563     } else if (!strcmp(key, "wants-data-access")) {
 4564         pi = (int *) ptr;
 4565         *pi = pkg->data_access;
 4566     } else if (!strcmp(key, "publist")) {
 4567         plist = (int **) ptr;
 4568         *plist = function_package_get_list(pkg, PUBLIST, npub);
 4569     } else if (!strcmp(key, "gui-publist")) {
 4570         plist = (int **) ptr;
 4571         *plist = function_package_get_list(pkg, GUILIST, npub);
 4572     } else if (!strcmp(key, "privlist")) {
 4573         plist = (int **) ptr;
 4574         *plist = function_package_get_list(pkg, PRIVLIST, npriv);
 4575     } else if (!strcmp(key, "gui-main-id")) {
 4576         pi = (int *) ptr;
 4577         *pi = pkg_get_special_func_id(pkg, UFUN_GUI_MAIN);
 4578     } else if (!strcmp(key, BUNDLE_PRINT)) {
 4579         ps = (char **) ptr;
 4580         *ps = pkg_get_special_func(pkg, UFUN_BUNDLE_PRINT);
 4581     } else if (!strcmp(key, BUNDLE_PLOT)) {
 4582         ps = (char **) ptr;
 4583         *ps = pkg_get_special_func(pkg, UFUN_BUNDLE_PLOT);
 4584     } else if (!strcmp(key, BUNDLE_TEST)) {
 4585         ps = (char **) ptr;
 4586         *ps = pkg_get_special_func(pkg, UFUN_BUNDLE_TEST);
 4587     } else if (!strcmp(key, BUNDLE_FCAST)) {
 4588         ps = (char **) ptr;
 4589         *ps = pkg_get_special_func(pkg, UFUN_BUNDLE_FCAST);
 4590     } else if (!strcmp(key, BUNDLE_EXTRA)) {
 4591         ps = (char **) ptr;
 4592         *ps = pkg_get_special_func(pkg, UFUN_BUNDLE_EXTRA);
 4593     } else if (!strcmp(key, GUI_MAIN)) {
 4594         ps = (char **) ptr;
 4595         *ps = pkg_get_special_func(pkg, UFUN_GUI_MAIN);
 4596     } else if (!strcmp(key, GUI_PRECHECK)) {
 4597         ps = (char **) ptr;
 4598         *ps = pkg_get_special_func(pkg, UFUN_GUI_PRECHECK);
 4599     } else if (!strcmp(key, LIST_MAKER)) {
 4600         ps = (char **) ptr;
 4601         *ps = pkg_get_special_func(pkg, UFUN_LIST_MAKER);
 4602     } else if (!strcmp(key, "gui-attrs")) {
 4603         unsigned char *s = (unsigned char *) ptr;
 4604 
 4605         pkg_get_gui_attrs(pkg, s);
 4606     }
 4607     }
 4608 
 4609     va_end(ap);
 4610 
 4611     return err;
 4612 }
 4613 
 4614 /* don't tamper with return value! */
 4615 
 4616 const char *function_package_get_string (fnpkg *pkg,
 4617                      const char *id)
 4618 {
 4619     if (pkg == NULL || id == NULL) {
 4620     return NULL;
 4621     } else if (!strcmp(id, "fname")) {
 4622     return pkg->fname;
 4623     } else if (!strcmp(id, "help-fname")) {
 4624     return pkg->help_fname;
 4625     } else if (!strcmp(id, "gui-help-fname")) {
 4626     return pkg->gui_help_fname;
 4627     } else if (!strcmp(id, "sample-fname")) {
 4628     return pkg->sample_fname;
 4629     } else if (!strcmp(id, "sample-script")) {
 4630     return pkg->sample;
 4631     } else if (!strcmp(id, "help")) {
 4632     return pkg->help;
 4633     } else if (!strcmp(id, "gui-help")) {
 4634     return pkg->gui_help;
 4635     } else if (!strcmp(id, "R-depends")) {
 4636     return pkg->Rdeps;
 4637     } else {
 4638     return NULL;
 4639     }
 4640 }
 4641 
 4642 char **function_package_get_data_files (fnpkg *pkg, int *n)
 4643 {
 4644     char **S = NULL;
 4645 
 4646     *n = 0;
 4647     if (pkg->datafiles != NULL) {
 4648     S = strings_array_dup(pkg->datafiles, pkg->n_files);
 4649     if (S != NULL) {
 4650         *n = pkg->n_files;
 4651     }
 4652     }
 4653 
 4654     return S;
 4655 }
 4656 
 4657 char **function_package_get_depends (fnpkg *pkg, int *n)
 4658 {
 4659     char **S = NULL;
 4660 
 4661     *n = 0;
 4662     if (pkg->depends != NULL) {
 4663     S = strings_array_dup(pkg->depends, pkg->n_depends);
 4664     if (S != NULL) {
 4665         *n = pkg->n_depends;
 4666     }
 4667     }
 4668 
 4669     return S;
 4670 }
 4671 
 4672 int function_package_set_data_files (fnpkg *pkg, char **S, int n)
 4673 {
 4674     int err = 0;
 4675 
 4676     if (pkg->datafiles != NULL) {
 4677     strings_array_free(pkg->datafiles, pkg->n_files);
 4678     pkg->datafiles = NULL;
 4679     pkg->n_files = 0;
 4680     }
 4681 
 4682     if (n > 0) {
 4683     if (S == NULL) {
 4684         err = E_DATA;
 4685     } else {
 4686         pkg->datafiles = strings_array_dup(S, n);
 4687         if (pkg->datafiles == NULL) {
 4688         err = E_ALLOC;
 4689         } else {
 4690         pkg->n_files = n;
 4691         pkg->uses_subdir = 1;
 4692         }
 4693     }
 4694     }
 4695 
 4696     return err;
 4697 }
 4698 
 4699 int function_package_set_depends (fnpkg *pkg, char **S, int n)
 4700 {
 4701     int err = 0;
 4702 
 4703     if (pkg->depends != NULL) {
 4704     strings_array_free(pkg->depends, pkg->n_depends);
 4705     pkg->depends = NULL;
 4706     pkg->n_depends = 0;
 4707     }
 4708 
 4709     if (n > 0) {
 4710     if (S == NULL) {
 4711         err = E_DATA;
 4712     } else {
 4713         pkg->depends = strings_array_dup(S, n);
 4714         if (pkg->depends == NULL) {
 4715         err = E_ALLOC;
 4716         } else {
 4717         pkg->n_depends = n;
 4718         }
 4719     }
 4720     }
 4721 
 4722     if (!err && pkg->provider != NULL) {
 4723     err = strings_array_prepend_uniq(&pkg->depends,
 4724                      &pkg->n_depends,
 4725                      pkg->provider);
 4726     }
 4727 
 4728     return err;
 4729 }
 4730 
 4731 /* quick check to see if there's a gross problem with a package,
 4732    in the context of considering packing it into a gretl
 4733    session file
 4734 */
 4735 
 4736 static int validate_function_package (fnpkg *pkg)
 4737 {
 4738     if (pkg->pub == NULL || pkg->author == NULL ||
 4739     pkg->version == NULL || pkg->date == NULL ||
 4740     pkg->descrip == NULL) {
 4741     return 0;
 4742     } else if (pkg->name[0] == '\0') {
 4743     return 0;
 4744     }
 4745 
 4746     return 1;
 4747 }
 4748 
 4749 /* for session file use, and also MPI: dump all currently defined
 4750    functions, packaged or not, into a single XML file */
 4751 
 4752 int write_loaded_functions_file (const char *fname, int mpicall)
 4753 {
 4754     PRN *prn;
 4755     int i, err = 0;
 4756 
 4757     if (n_ufuns == 0) {
 4758     return 0;
 4759     }
 4760 
 4761     prn = gretl_print_new_with_filename(fname, &err);
 4762     if (prn == NULL) {
 4763     return err;
 4764     }
 4765 
 4766     gretl_xml_header(prn);
 4767     pputs(prn, "<gretl-functions>\n");
 4768 
 4769 #ifdef HAVE_MPI
 4770     if (mpicall) {
 4771     /* if we're launching MPI, record the name of the
 4772        currently executing function, if any
 4773     */
 4774     ufunc *u = currently_called_function();
 4775 
 4776     if (u != NULL) {
 4777         pprintf(prn, "<caller>%s</caller>\n", u->name);
 4778     }
 4779     }
 4780 #endif
 4781 
 4782     /* write any loaded function packages */
 4783 
 4784     for (i=0; i<n_pkgs; i++) {
 4785     if (validate_function_package(pkgs[i])) {
 4786         real_write_function_package(pkgs[i], prn);
 4787     }
 4788     }
 4789 
 4790     /* then any unpackaged functions */
 4791 
 4792     for (i=0; i<n_ufuns; i++) {
 4793     if (ufuns[i]->pkg == NULL) {
 4794         write_function_xml(ufuns[i], prn);
 4795     }
 4796     }
 4797 
 4798     pputs(prn, "</gretl-functions>\n");
 4799 
 4800     gretl_print_destroy(prn);
 4801 
 4802     return 0;
 4803 }
 4804 
 4805 /* De-allocate a function package: this can be done in either of two
 4806    modes.  If 'full' is non-zero then we destroy all functions that
 4807    are children of the given package, otherwise we leave the
 4808    function-children alone (just 'detaching' them from the parent
 4809    package).
 4810 */
 4811 
 4812 static void real_function_package_free (fnpkg *pkg, int full)
 4813 {
 4814     if (pkg != NULL) {
 4815     int i;
 4816 
 4817     if (full) {
 4818         for (i=0; i<pkg->n_pub; i++) {
 4819         ufunc_free(pkg->pub[i]);
 4820         }
 4821         for (i=0; i<pkg->n_priv; i++) {
 4822         ufunc_free(pkg->priv[i]);
 4823         }
 4824     } else {
 4825         for (i=0; i<n_ufuns; i++) {
 4826         if (ufuns[i]->pkg == pkg) {
 4827             /* remove package info */
 4828             ufuns[i]->pkg = NULL;
 4829             set_function_private(ufuns[i], FALSE);
 4830         }
 4831         }
 4832     }
 4833 
 4834     if (pkg->datafiles != NULL && pkg->n_files > 0) {
 4835         strings_array_free(pkg->datafiles, pkg->n_files);
 4836     }
 4837 
 4838     if (pkg->depends != NULL && pkg->n_depends > 0) {
 4839         strings_array_free(pkg->depends, pkg->n_depends);
 4840     }
 4841 
 4842     free(pkg->pub);
 4843     free(pkg->priv);
 4844     free(pkg->fname);
 4845     free(pkg->author);
 4846     free(pkg->email);
 4847     free(pkg->version);
 4848     free(pkg->date);
 4849     free(pkg->descrip);
 4850     free(pkg->help);
 4851     free(pkg->gui_help);
 4852     free(pkg->Rdeps);
 4853     free(pkg->sample);
 4854     free(pkg->help_fname);
 4855     free(pkg->gui_help_fname);
 4856     free(pkg->sample_fname);
 4857     free(pkg->tags);
 4858     free(pkg->label);
 4859     free(pkg->mpath);
 4860     free(pkg->provider);
 4861     free(pkg);
 4862     }
 4863 }
 4864 
 4865 static void function_package_free (fnpkg *pkg)
 4866 {
 4867     real_function_package_free(pkg, 0);
 4868 }
 4869 
 4870 static void function_package_free_full (fnpkg *pkg)
 4871 {
 4872     real_function_package_free(pkg, 1);
 4873 }
 4874 
 4875 /* is the package with filename @fname already in memory? */
 4876 
 4877 static fnpkg *get_loaded_pkg_by_filename (const char *fname,
 4878                       const char **version)
 4879 {
 4880     int i;
 4881 
 4882     if (fname == NULL) {
 4883     return NULL;
 4884     }
 4885 
 4886     for (i=0; i<n_pkgs; i++) {
 4887     if (!strcmp(fname, pkgs[i]->fname)) {
 4888         if (version != NULL) {
 4889         *version = pkgs[i]->version;
 4890         }
 4891         return pkgs[i];
 4892     }
 4893     }
 4894 
 4895     return NULL;
 4896 }
 4897 
 4898 /**
 4899  * function_package_unload_by_filename:
 4900  * @fname: package filename.
 4901  *
 4902  * Unloads the specified function package from memory, if it
 4903  * is currently loaded.  The functions 'owned' by the package
 4904  * are not destroyed; they become available for inclusion in
 4905  * other packages.
 4906  */
 4907 
 4908 void function_package_unload_by_filename (const char *fname)
 4909 {
 4910     fnpkg *pkg = get_loaded_pkg_by_filename(fname, NULL);
 4911 
 4912     if (pkg != NULL) {
 4913     real_function_package_unload(pkg, 0);
 4914     }
 4915 }
 4916 
 4917 /**
 4918  * function_package_unload_full_by_filename:
 4919  * @fname: package filename.
 4920  *
 4921  * Unloads the specified function package from memory, if it
 4922  * is currently loaded.  The functions 'owned' by the package
 4923  * are also unloaded from memory.
 4924  */
 4925 
 4926 void function_package_unload_full_by_filename (const char *fname)
 4927 {
 4928     fnpkg *pkg = get_loaded_pkg_by_filename(fname, NULL);
 4929 
 4930     if (pkg != NULL) {
 4931     real_function_package_unload(pkg, 1);
 4932     }
 4933 }
 4934 
 4935 /* append a function package to the recorder array of loaded
 4936    packages */
 4937 
 4938 static int function_package_record (fnpkg *pkg)
 4939 {
 4940     fnpkg **tmp;
 4941     int err = 0;
 4942 
 4943     tmp = realloc(pkgs, (n_pkgs + 1) * sizeof *tmp);
 4944 
 4945     if (tmp == NULL) {
 4946     err = E_ALLOC;
 4947     } else {
 4948     pkgs = tmp;
 4949     pkgs[n_pkgs] = pkg;
 4950     n_pkgs++;
 4951     }
 4952 
 4953     return err;
 4954 }
 4955 
 4956 static int broken_package_error (fnpkg *pkg)
 4957 {
 4958     gretl_errmsg_sprintf("'%s': package contains "
 4959              "duplicated function names",
 4960              pkg->name);
 4961     return E_DATA;
 4962 }
 4963 
 4964 #define fn_redef_msg(s) fprintf(stderr, "Redefining function '%s'\n", s)
 4965 
 4966 /* When loading a private function the only real conflict would be
 4967    with a function of the same name owned by the same package.
 4968    Obviously this shouldn't happen but we'll whack it if it does.
 4969 */
 4970 
 4971 static int load_private_function (fnpkg *pkg, int i)
 4972 {
 4973     ufunc *fun = pkg->priv[i];
 4974     int j, err = 0;
 4975 
 4976     for (j=0; j<n_ufuns; j++) {
 4977     if (!strcmp(fun->name, ufuns[j]->name)) {
 4978         if (pkg == ufuns[j]->pkg) {
 4979         err = broken_package_error(pkg);
 4980         break;
 4981         }
 4982     }
 4983     }
 4984 
 4985     if (!err) {
 4986     err = add_allocated_ufunc(fun);
 4987     }
 4988 
 4989     if (!err && function_lookup(fun->name)) {
 4990     gretl_warnmsg_sprintf(_("'%s' is the name of a built-in function"),
 4991                   fun->name);
 4992     install_function_override(fun->name, fun->pkg->name, fun);
 4993     pkg->overrides += 1;
 4994     }
 4995 
 4996     return err;
 4997 }
 4998 
 4999 /* When loading a public, packaged function we want to avoid conflicts
 5000    with any non-private functions of the same name.  In case we get a
 5001    conflict with a public member of an already loaded distinct package
 5002    we'll flag an error (otherwise things will get too confusing).
 5003 */
 5004 
 5005 static int load_public_function (fnpkg *pkg, int i)
 5006 {
 5007     ufunc *fun = pkg->pub[i];
 5008     int j, done = 0;
 5009     int err = 0;
 5010 
 5011     for (j=0; j<n_ufuns; j++) {
 5012     if (!strcmp(fun->name, ufuns[j]->name)) {
 5013         if (pkg == ufuns[j]->pkg) {
 5014         /* name duplication in single package */
 5015         err = broken_package_error(pkg);
 5016         } else if (ufuns[j]->pkg == NULL) {
 5017         /* conflicting unpackaged function */
 5018         ufunc_free(ufuns[j]);
 5019         ufuns[j] = fun;
 5020         done = 1;
 5021         } else if (!function_is_private(ufuns[j])) {
 5022         /* got a conflicting package */
 5023         gretl_errmsg_sprintf("The function %s is already defined "
 5024                      "by package '%s'", fun->name,
 5025                      ufuns[j]->pkg->name);
 5026         err = E_DATA;
 5027         break;
 5028         }
 5029     }
 5030     }
 5031 
 5032     if (!err && !done && function_lookup(fun->name)) {
 5033     if (strcmp(fun->name, "bkw")) {
 5034         /* for now, don't throw an error on loading Lee Adkins'
 5035            bkw package */
 5036         gretl_errmsg_sprintf(_("'%s' is the name of a built-in function"),
 5037                  fun->name);
 5038         fprintf(stderr, "%s: function %s would override a built-in\n",
 5039             pkg->name, fun->name);
 5040         err = E_DATA;
 5041     }
 5042     }
 5043 
 5044     if (!err && !done) {
 5045     err = add_allocated_ufunc(fun);
 5046     }
 5047 
 5048     return err;
 5049 }
 5050 
 5051 static int pkg_in_stack (const char *name, GArray *pstack)
 5052 {
 5053     char *s;
 5054     int i;
 5055 
 5056     for (i=0; i<pstack->len; i++) {
 5057     s = g_array_index(pstack, char *, i);
 5058     if (!strcmp(name, s)) {
 5059         return 1;
 5060     }
 5061     }
 5062 
 5063     return 0;
 5064 }
 5065 
 5066 static int load_gfn_dependencies (fnpkg *pkg, GArray *pstack)
 5067 {
 5068     int err = 0;
 5069 
 5070     if (pkg->depends != NULL) {
 5071     char *pkgpath;
 5072     int i;
 5073 
 5074     fprintf(stderr, "*** load_gfn_dependencies for %s ***\n", pkg->name);
 5075 
 5076     for (i=0; i<pkg->n_depends && !err; i++) {
 5077         const char *dep = pkg->depends[i];
 5078 
 5079         if (get_function_package_by_name(dep) != NULL) {
 5080         ; /* OK, already loaded */
 5081         } else if (pkg_in_stack(dep, pstack)) {
 5082         fprintf(stderr, " found %s in pstack\n", dep);
 5083         ; /* don't go into infinite loop! */
 5084         } else {
 5085         fprintf(stderr, " trying for %s\n", dep);
 5086         pkgpath = gretl_function_package_get_path(dep, PKG_ALL);
 5087         if (pkgpath == NULL) {
 5088             err = E_DATA;
 5089             gretl_errmsg_sprintf("%s: dependency %s was not found",
 5090                      pkg->name, dep);
 5091         } else {
 5092             err = load_function_package(pkgpath, OPT_NONE,
 5093                         pstack, NULL);
 5094             free(pkgpath);
 5095             if (!err) {
 5096             g_array_append_val(pstack, dep);
 5097             }
 5098         }
 5099         }
 5100     }
 5101     }
 5102 
 5103     return err;
 5104 }
 5105 
 5106 /* A 'real load' is in contrast to just reading some info from a
 5107    package, as is done in various GUI contexts.  We do the real load
 5108    in response to some GUI commands, the "include" command, and also
 5109    when re-opening a gretl session file that contains function
 5110    packages.
 5111 */
 5112 
 5113 static int real_load_package (fnpkg *pkg, GArray *pstack)
 5114 {
 5115     int i, err = 0;
 5116 
 5117 #if PKG_DEBUG
 5118     fprintf(stderr, "real_load_package:\n loading '%s'\n", pkg->fname);
 5119 #endif
 5120 
 5121     gretl_error_clear();
 5122 
 5123     if (pstack != NULL) {
 5124     err = load_gfn_dependencies(pkg, pstack);
 5125     }
 5126 
 5127     if (!err && pkg->pub != NULL) {
 5128     for (i=0; i<pkg->n_pub && !err; i++) {
 5129         err = load_public_function(pkg, i);
 5130     }
 5131     }
 5132 
 5133     if (!err && pkg->priv != NULL) {
 5134     for (i=0; i<pkg->n_priv && !err; i++) {
 5135         err = load_private_function(pkg, i);
 5136     }
 5137     }
 5138 
 5139     if (!err && pkg->provider != NULL) {
 5140     /* check that provider really got loaded */
 5141     if (get_function_package_by_name(pkg->provider) == NULL) {
 5142         gretl_errmsg_sprintf("Provider package %s is not loaded\n",
 5143                  pkg->provider);
 5144         err = E_DATA;
 5145     }
 5146     }
 5147 
 5148     if (!err) {
 5149     /* add to array of loaded packages */
 5150     err = function_package_record(pkg);
 5151     }
 5152 
 5153     return err;
 5154 }
 5155 
 5156 static const char *data_needs_string (DataReq dr)
 5157 {
 5158     if (dr == FN_NEEDS_TS) {
 5159     return N_("Time-series data");
 5160     } else if (dr == FN_NEEDS_QM) {
 5161     return N_("Quarterly or monthly data");
 5162     } else if (dr == FN_NEEDS_PANEL) {
 5163     return N_("Panel data");
 5164     } else if (dr == FN_NODATA_OK) {
 5165     return N_("none");
 5166     } else {
 5167     return N_("some sort of dataset");
 5168     }
 5169 }
 5170 
 5171 static void print_package_info (const fnpkg *pkg, const char *fname, PRN *prn)
 5172 {
 5173     char vstr[8];
 5174     int remote, pdfdoc;
 5175     int i;
 5176 
 5177     remote = (strstr(fname, "dltmp.") != NULL);
 5178 
 5179     if (!remote && g_path_is_absolute(fname)) {
 5180     pprintf(prn, "<@itl=\"File\">: %s\n\n", fname);
 5181     }
 5182 
 5183     if (pkg->name[0] == '\0' || pkg->author == NULL ||
 5184     pkg->minver <= 0 || pkg->descrip == NULL ||
 5185     pkg->version == NULL || pkg->date == NULL ||
 5186     pkg->help == NULL) {
 5187     pprintf(prn, "\nBroken package! Basic information is missing\n");
 5188     return;
 5189     }
 5190 
 5191     gretl_version_string(vstr, pkg->minver);
 5192     pdfdoc = is_pdf_ref(pkg->help);
 5193 
 5194     pprintf(prn, "<@itl=\"Package\">: %s %s (%s)\n", pkg->name, pkg->version,
 5195         pkg->date);
 5196     pprintf(prn, "<@itl=\"Author\">: %s\n", pkg->author);
 5197     if (pkg->email != NULL && *pkg->email != '\0') {
 5198     pprintf(prn, "<@itl=\"Email\">: %s\n", pkg->email);
 5199     }
 5200     pprintf(prn, "<@itl=\"Required gretl version\">: %s\n", vstr);
 5201     pprintf(prn, "<@itl=\"Data requirement\">: %s\n", _(data_needs_string(pkg->dreq)));
 5202     pprintf(prn, "<@itl=\"Description\">: %s\n", gretl_strstrip(pkg->descrip));
 5203     if (pkg->n_depends > 0) {
 5204     pputs(prn, "<@itl=\"Dependencies\">: ");
 5205     for (i=0; i<pkg->n_depends; i++) {
 5206         pprintf(prn, "%s%s", pkg->depends[i],
 5207             (i < pkg->n_depends-1)? ", " : "\n");
 5208     }
 5209     }
 5210     if (pkg->provider != NULL) {
 5211     pprintf(prn, "<@itl=\"Provider\">: %s\n", pkg->provider);
 5212     }
 5213 
 5214     if (pdfdoc) {
 5215     const char *s = strrchr(pkg->help, ':');
 5216 
 5217     if (remote) {
 5218         pprintf(prn, "<@itl=\"Documentation\">: %s\n\n", s + 1);
 5219     } else {
 5220         gchar *localpdf = g_strdup(fname);
 5221         gchar *p = strrchr(localpdf, '.');
 5222 
 5223         *p = '\0';
 5224         strcat(p, ".pdf");
 5225         pprintf(prn, "<@itl=\"Documentation\">: <@adb=\"%s\">\n\n", localpdf);
 5226         g_free(localpdf);
 5227     }
 5228     } else {
 5229     pputc(prn, '\n');
 5230     }
 5231 
 5232     if (pkg->pub != NULL) {
 5233     if (pkg->n_pub == 1) {
 5234         if (strcmp(pkg->pub[0]->name, pkg->name)) {
 5235         pputs(prn, "<@itl=\"Public interface\">: ");
 5236         pputs(prn, "<mono>\n");
 5237         pprintf(prn, "%s()\n", pkg->pub[0]->name);
 5238         pputs(prn, "</mono>\n\n");
 5239         }
 5240     } else {
 5241         pputs(prn, "<@itl=\"Public interfaces\">:\n\n");
 5242         pputs(prn, "<mono>\n");
 5243         for (i=0; i<pkg->n_pub; i++) {
 5244         pprintf(prn, "  %s()\n", pkg->pub[i]->name);
 5245         }
 5246         pputs(prn, "</mono>\n\n"