static int function_in_gretl (const char *funword)
{
#if 1
return 1;
#else
int i;
for (i=1; i<NC; i++) {
if (!strcmp(funword, gretl_command_word(i))) {
return 1;
}
}
return 0;
#endif
}
static void cli_exec_callback (ExecState *s, void *ptr,
GretlObjType type)
{
int ci = s->cmd->ci;
if (ci == MODELTAB || ci == GRAPHPG) {
pprintf(s->prn, _("%s: command not available\n"),
gretl_command_word(ci));
} else if (ci == OPEN) {
char *fname = (char *) ptr;
if (fname != NULL && *fname != '\0') {
strncpy(datafile, fname, MAXLEN - 1);
}
data_status = 1;
}
/* otherwise, no-op */
}
gretl_bundle *bundle_from_model (MODEL *pmod,
DATASET *dset,
int *err)
{
gretl_bundle *b = NULL;
gretl_matrix *m;
double *x;
double val;
int *list;
const char *s;
const char *key;
int i, t, berr;
if (pmod == NULL) {
/* get the "last model" */
GretlObjType type = 0;
void *p = get_last_model(&type);
if (p == NULL || type != GRETL_OBJ_EQN) {
*err = E_DATA;
return NULL;
} else {
pmod = p;
}
}
x = malloc(dset->n * sizeof *x);
if (x == NULL) {
*err = E_ALLOC;
return NULL;
}
b = gretl_bundle_new();
if (b == NULL) {
free(x);
*err = E_ALLOC;
return NULL;
}
for (i=M_ESS; i<M_SCALAR_MAX && !*err; i++) {
berr = 0;
val = gretl_model_get_scalar(pmod, i, dset, &berr);
if (!berr) {
key = mvarname(i) + 1;
*err = gretl_bundle_set_scalar(b, key, val);
}
}
for (i=M_SCALAR_MAX+1; i<M_SERIES_MAX && !*err; i++) {
for (t=0; t<dset->n; t++) {
x[t] = NADBL;
}
berr = gretl_model_get_series(x, pmod, dset, i);
if (!berr) {
key = mvarname(i) + 1;
*err = gretl_bundle_set_series(b, key, x, dset->n);
}
}
for (i=M_SERIES_MAX+1; i<M_MATRIX_MAX && !*err; i++) {
berr = 0;
m = gretl_model_get_matrix(pmod, i, &berr);
if (!berr) {
key = mvarname(i) + 1;
*err = gretl_bundle_donate_data(b, key, m,
GRETL_TYPE_MATRIX,
0);
}
}
for (i=M_MBUILD_MAX+1; i<M_LIST_MAX && !*err; i++) {
list = NULL;
if (i == M_XLIST) {
list = gretl_model_get_x_list(pmod);
} else if (i == M_YLIST) {
list = gretl_model_get_y_list(pmod);
}
if (list != NULL) {
/* convert list to matrix for bundling */
m = matrix_from_list(list);
if (m != NULL) {
key = mvarname(i) + 1;
*err = gretl_bundle_donate_data(b, key, m,
GRETL_TYPE_MATRIX,
0);
}
free(list);
}
}
for (i=M_LIST_MAX+1; i<M_STR_MAX && !*err; i++) {
s = NULL;
if (i == M_DEPVAR) {
s = gretl_model_get_depvar_name(pmod, dset);
} else if (i == M_COMMAND) {
s = gretl_command_word(pmod->ci);
}
if (s != NULL && *s != '\0') {
key = mvarname(i) + 1;
*err = gretl_bundle_set_string(b, key, s);
}
}
free(x);
/* don't return a broken bundle */
if (*err && b != NULL) {
gretl_bundle_destroy(b);
b = NULL;
}
return b;
}
void output_lang2_file (void)
{
char **strs;
int nopts;
int i, n;
puts("<?xml version=\"1.0\" encoding=\"UTF-8\"?>");
puts("<language id=\"gretl\" _name=\"gretl\" version=\"2.0\" _section=\"Scripts\">");
puts("<metadata>");
puts(" <property name=\"mimetypes\">application/x-gretlscript</property>");
puts(" <property name=\"globs\">*.inp</property>");
puts("</metadata>");
puts("<styles>");
puts(" <style id=\"comment\" _name=\"Comment\" map-to=\"def:comment\"/>");
puts(" <style id=\"function\" _name=\"Function\" map-to=\"def:function\"/>");
puts(" <style id=\"data-type\" _name=\"Data Type\" map-to=\"def:type\"/>");
puts(" <style id=\"string\" _name=\"String\" map-to=\"def:string\"/>");
puts(" <style id=\"keyword\" _name=\"Keyword\" map-to=\"def:keyword\"/>");
puts("</styles>");
puts("<definitions>");
puts(" <context id=\"line-comment\" style-ref=\"comment\" end-at-line-end=\"true\">");
puts(" <start>#</start>");
puts(" <include>");
puts(" <context ref=\"def:escape\"/>");
puts(" <context ref=\"def:line-continue\"/>");
puts(" </include>");
puts(" </context>");
puts(" <context id=\"block-comment\" style-ref=\"comment\">");
puts(" <start>/\\*</start>");
puts(" <end>\\*/</end>");
puts(" <include>");
puts(" <context ref=\"def:escape\"/>");
puts(" <context ref=\"def:line-continue\"/>");
puts(" </include>");
puts(" </context>");
puts(" <context id=\"string\" style-ref=\"string\" end-at-line-end=\"true\">");
puts(" <start>\"</start>");
puts(" <end>\"</end>");
puts(" <include>");
puts(" <context ref=\"def:escape\"/>");
puts(" <context ref=\"def:line-continue\"/>");
puts(" </include>");
puts(" </context>");
#if 0 /* not yet */
puts(" <context id=\"foreign\" style-inside=\"true\" style-ref=\"comment\">");
puts(" <start>(?<=foreign language)</start>");
puts(" <end>(?=end foreign)</end>");
puts(" </context>");
#endif
/* gretl data types */
puts(" <context id=\"gretl-types\" style-ref=\"data-type\">");
for (i=0; gretl_data_types[i] != NULL; i++) {
printf(" <keyword>%s</keyword>\n", gretl_data_types[i]);
}
puts(" </context>");
/* gretl functions */
puts(" <context id=\"genr-functions\" style-ref=\"function\">");
n = gen_func_count();
for (i=0; i<n; i++) {
printf(" <keyword>%s</keyword>\n", gen_func_name(i));
}
printf(" <keyword>catch</keyword>\n");
puts(" </context>");
/* gretl commands */
puts(" <context id=\"commands\" style-ref=\"keyword\">");
puts(" <prefix>(^|\\040|\\011)</prefix>");
puts(" <suffix>(?![\\w\\-\\.\\(])</suffix>");
for (i=1; i<NC; i++) {
printf(" <keyword>%s</keyword>\n", gretl_command_word(i));
}
/* plus a few specials */
for (i=0; special_keyword[i] != NULL; i++) {
printf(" <keyword>%s</keyword>\n", special_keyword[i]);
}
puts(" </context>");
/* command option strings */
strs = get_all_option_strings(&nopts);
qsort(strs, nopts, sizeof *strs, compare_options);
if (strs != NULL) {
puts(" <context id=\"options\" style-ref=\"data-type\">");
puts(" <prefix>--</prefix>");
for (i=1; i<nopts; i++) {
printf(" <keyword>%s</keyword>\n", strs[i]);
}
puts(" </context>");
strings_array_free(strs, nopts);
}
/* dollar variables */
puts(" <context id=\"internalvars\" style-ref=\"data-type\">");
puts(" <prefix>\\$</prefix>");
puts(" <suffix></suffix>");
strs = make_var_name_list(&n);
if (strs != NULL) {
for (i=0; i<n; i++) {
printf(" <keyword>%s</keyword>\n", strs[i]);
}
strings_array_free(strs, n);
}
puts(" </context>");
puts(" <context id=\"gretl\">");
puts(" <include>");
puts(" <context ref=\"line-comment\"/>");
puts(" <context ref=\"block-comment\"/>");
puts(" <context ref=\"string\"/>");
puts(" <context ref=\"gretl-types\"/>");
puts(" <context ref=\"commands\"/>");
puts(" <context ref=\"genr-functions\"/>");
puts(" <context ref=\"options\"/>");
puts(" <context ref=\"internalvars\"/>");
puts(" </include>");
puts(" </context>");
puts("</definitions>");
puts("</language>");
}
void output_emacs_block (void)
{
char **strs;
int nopts;
int i, n;
/* gretl commands */
n = 1;
fputs("(defvar gretl-command-words\n '(", stdout);
for (i=1; i<NC; i++) {
printf("\"%s\"", gretl_command_word(i));
if (n % 8 == 0) {
fputs("\n ", stdout);
} else {
putchar(' ');
}
n++;
}
for (i=0; special_keyword[i] != NULL; i++) {
printf("\"%s\"", special_keyword[i]);
if (special_keyword[i+1] != NULL) {
if (n % 8 == 0) {
fputs("\n ", stdout);
} else {
putchar(' ');
}
}
n++;
}
puts(")\n \"Commands in Gretl (these names are also reserved).\")\n");
/* functions in "genr" command */
fputs("(defvar gretl-genr-functions\n '(", stdout);
n = gen_func_count();
for (i=0; i<n; i++) {
printf("\"%s\"", gen_func_name(i));
if (i < n-1) {
if ((i+1) % 8 == 0) {
fputs("\n ", stdout);
} else {
putchar(' ');
}
}
}
puts(")\n \"Builtin functions for Gretl's genr command.\")\n");
/* option strings */
strs = get_all_option_strings(&nopts);
if (strs != NULL) {
n = 1;
fputs("(defvar gretl-option-flags\n '(", stdout);
for (i=1; i<nopts; i++) {
printf("\"%s\"", strs[i]);
if (i < nopts-1) {
if (n % 4 == 0) {
fputs("\n ", stdout);
} else {
putchar(' ');
}
}
n++;
}
puts(")\n \"Gretl option flags.\")\n");
strings_array_free(strs, nopts);
}
/* internal "dollar" variables */
fputs("(defvar gretl-internal-vars\n '(", stdout);
strs = make_var_name_list(&n);
if (strs != NULL) {
for (i=0; i<n; i++) {
printf("\"%s\"", strs[i]);
if ((i+1) % 7 == 0) {
fputs("\n ", stdout);
} else {
putchar(' ');
}
}
strings_array_free(strs, n);
}
puts(")\n \"Model- and dataset-related variables.\")\n");
}
void print_skel_for_command (int ci)
{
const char *cmdword;
const char **opts;
char section[32];
int i, nopt;
/* Get the string associated with each command index
number, from libgretl */
cmdword = gretl_command_word(ci);
fprintf(stderr, "ci = %d, command word = '%s'\n",
ci, cmdword);
/* (Try to) get a list of the options recognized as
valid for the given command */
opts = get_opts_for_command(ci, &nopt);
if (MODEL_COMMAND(ci)) {
strcpy(section, "Estimation");
} else if (is_model_ref_cmd(ci)) {
strcpy(section, "Tests");
} else {
strcpy(section, "Unknown");
}
printf(" <command name=\"%s\" section=\"%s\">\n",
cmdword, section);
puts("\n <usage>");
puts(" <arguments>");
puts(" <argument>.</argument>");
puts(" <argument>.</argument>");
puts(" </arguments>");
if (opts != NULL) {
fprintf(stderr, " Got some options for '%s'\n", cmdword);
fputs(" <options>\n", stdout);
for (i=0; i<nopt; i++) {
puts(" <option>");
printf(" <flag>--%s</flag>\n", opts[i]);
printf(" <effect>.</effect>\n");
puts(" </option>");
}
puts(" </options>");
free(opts);
} else {
fprintf(stderr, " Found no options for '%s'\n", cmdword);
}
puts(" <examples>");
puts(" <example>.</example>");
puts(" </examples>");
puts(" </usage>");
puts("\n <description><para>Description goes here.</para>");
puts(" </description>");
puts("\n <gui-access>");
puts(" <menu-path>.</menu-path>");
puts(" <other-access>.</other-access>");
puts(" </gui-access>");
puts("\n </command>\n");
}
