1 /* PSPP - computes sample statistics.
2 Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
3 Written by Ben Pfaff <blp@gnu.org>.
5 This program is free software; you can redistribute it and/or
6 modify it under the terms of the GNU General Public License as
7 published by the Free Software Foundation; either version 2 of the
8 License, or (at your option) any later version.
10 This program is distributed in the hope that it will be useful, but
11 WITHOUT ANY WARRANTY; without even the implied warranty of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 General Public License for more details.
15 You should have received a copy of the GNU General Public License
16 along with this program; if not, write to the Free Software
17 Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
20 /* FIXME: seems like a lot of code duplication with data-list.c. */
30 #include "file-handle.h"
37 #include "debug-print.h"
39 /* Describes what to do when an output field is encountered. */
42 PRT_ERROR, /* Invalid value. */
43 PRT_NEWLINE, /* Newline. */
44 PRT_CONST, /* Constant string. */
45 PRT_VAR, /* Variable. */
46 PRT_SPACE /* A single space. */
49 /* Describes how to output one field. */
52 struct prt_out_spec *next;
53 int type; /* PRT_* constant. */
54 int fc; /* 0-based first column. */
57 char *c; /* PRT_CONST: Associated string. */
60 struct variable *v; /* PRT_VAR: Associated variable. */
61 struct fmt_spec f; /* PRT_VAR: Output spec. */
68 /* Enums for use with print_trns's `options' field. */
71 PRT_CMD_MASK = 1, /* Command type mask. */
72 PRT_PRINT = 0, /* PRINT transformation identifier. */
73 PRT_WRITE = 1, /* WRITE transformation identifier. */
74 PRT_EJECT = 002 /* Can be combined with CMD_PRINT only. */
77 /* PRINT, PRINT EJECT, WRITE private data structure. */
81 struct file_handle *handle; /* Output file, NULL=listing file. */
82 int options; /* PRT_* bitmapped field. */
83 struct prt_out_spec *spec; /* Output specifications. */
84 int max_width; /* Maximum line width including null. */
85 char *line; /* Buffer for sticking lines in. */
88 /* PRT_PRINT or PRT_WRITE. */
91 /* Holds information on parsing the data file. */
92 static struct print_trns prt;
94 /* Last prt_out_spec in the chain. Used for building the linked-list. */
95 static struct prt_out_spec *next;
97 /* Number of records. */
100 static int internal_cmd_print (int flags);
101 static trns_proc_func print_trns_proc;
102 static trns_free_func print_trns_free;
103 static int parse_specs (void);
104 static void dump_table (void);
105 static void append_var_spec (struct prt_out_spec *spec);
106 static void alloc_line (void);
109 void debug_print (void);
114 /* Parses PRINT command. */
118 lex_match_id ("PRINT");
119 return internal_cmd_print (PRT_PRINT);
122 /* Parses PRINT EJECT command. */
124 cmd_print_eject (void)
126 lex_match_id ("EJECT");
127 return internal_cmd_print (PRT_PRINT | PRT_EJECT);
130 /* Parses WRITE command. */
134 lex_match_id ("WRITE");
135 return internal_cmd_print (PRT_WRITE);
138 /* Parses the output commands. F is PRT_PRINT, PRT_WRITE, or
139 PRT_PRINT|PRT_EJECT. */
141 internal_cmd_print (int f)
143 /* 0=print no table, 1=print table. (TABLE subcommand.) */
146 /* malloc()'d transformation. */
147 struct print_trns *trns;
149 /* Fill in prt to facilitate error-handling. */
150 prt.h.proc = print_trns_proc;
151 prt.h.free = print_trns_free;
159 which_cmd = f & PRT_CMD_MASK;
161 /* Parse the command options. */
162 while (!lex_match ('/'))
164 if (lex_match_id ("OUTFILE"))
168 prt.handle = fh_parse_file_handle ();
172 else if (lex_match_id ("RECORDS"))
176 if (!lex_force_int ())
178 nrec = lex_integer ();
182 else if (lex_match_id ("TABLE"))
184 else if (lex_match_id ("NOTABLE"))
188 lex_error (_("expecting a valid subcommand"));
193 /* Parse variables and strings. */
197 /* Output the variable table if requested. */
201 /* Count the maximum line width. Allocate linebuffer if
205 /* Put the transformation in the queue. */
206 trns = xmalloc (sizeof *trns);
207 memcpy (trns, &prt, sizeof *trns);
208 add_transformation ((struct trns_header *) trns);
217 print_trns_free ((struct trns_header *) & prt);
221 /* Appends the field output specification SPEC to the list maintained
224 append_var_spec (struct prt_out_spec *spec)
227 prt.spec = next = xmalloc (sizeof *spec);
229 next = next->next = xmalloc (sizeof *spec);
231 memcpy (next, spec, sizeof *spec);
235 /* Field parsing. Mostly stolen from data-list.c. */
237 /* Used for chaining together fortran-like format specifiers. */
240 struct fmt_list *next;
243 struct fmt_list *down;
246 /* Used as "local" variables among the fixed-format parsing funcs. If
247 it were guaranteed that PSPP were going to be compiled by gcc,
248 I'd make all these functions a single set of nested functions. */
251 struct variable **v; /* variable list */
252 int nv; /* number of variables in list */
253 int cv; /* number of variables from list used up so far
254 by the FORTRAN-like format specifiers */
256 int recno; /* current 1-based record number */
257 int sc; /* 1-based starting column for next variable */
259 struct prt_out_spec spec; /* next format spec to append to list */
260 int fc, lc; /* first, last 1-based column number of current
263 int level; /* recursion level for FORTRAN-like format
268 static int fixed_parse_compatible (void);
269 static struct fmt_list *fixed_parse_fortran (void);
271 static int parse_string_argument (void);
272 static int parse_variable_argument (void);
274 /* Parses all the variable and string specifications on a single
275 PRINT, PRINT EJECT, or WRITE command into the prt structure.
280 /* Return code from called function. */
288 while (lex_match ('/'))
290 int prev_recno = fx.recno;
295 if (!lex_force_int ())
297 if (lex_integer () < fx.recno)
299 msg (SE, _("The record number specified, %ld, is "
300 "before the previous record, %d. Data "
301 "fields must be listed in order of "
302 "increasing record number."),
303 lex_integer (), fx.recno - 1);
306 fx.recno = lex_integer ();
310 fx.spec.type = PRT_NEWLINE;
311 while (prev_recno++ < fx.recno)
312 append_var_spec (&fx.spec);
317 if (token == T_STRING)
318 code = parse_string_argument ();
320 code = parse_variable_argument ();
324 fx.spec.type = PRT_NEWLINE;
325 append_var_spec (&fx.spec);
329 else if (fx.recno > nrec)
331 msg (SE, _("Variables are specified on records that "
332 "should not exist according to RECORDS subcommand."));
338 lex_error (_("expecting end of command"));
345 /* Parses a string argument to the PRINT commands. Returns success. */
347 parse_string_argument (void)
349 fx.spec.type = PRT_CONST;
350 fx.spec.fc = fx.sc - 1;
351 fx.spec.u.c = xstrdup (ds_value (&tokstr));
354 /* Parse the included column range. */
357 /* Width of column range in characters. */
360 /* Width of constant string in characters. */
363 /* 1-based index of last column in range. */
366 if (!lex_integer_p () || lex_integer () <= 0)
368 msg (SE, _("%g is not a valid column location."), tokval);
371 fx.spec.fc = lex_integer () - 1;
374 lex_negative_to_dash ();
377 if (!lex_integer_p ())
379 msg (SE, _("Column location expected following `%d-'."),
383 if (lex_integer () <= 0)
385 msg (SE, _("%g is not a valid column location."), tokval);
388 if (lex_integer () < fx.spec.fc + 1)
390 msg (SE, _("%d-%ld is not a valid column range. The second "
391 "column must be greater than or equal to the first."),
392 fx.spec.fc + 1, lex_integer ());
395 lc = lex_integer () - 1;
400 /* If only a starting location is specified then the field is
401 the width of the provided string. */
402 lc = fx.spec.fc + strlen (fx.spec.u.c) - 1;
404 /* Apply the range. */
405 c_len = lc - fx.spec.fc + 1;
406 s_len = strlen (fx.spec.u.c);
408 fx.spec.u.c[c_len] = 0;
409 else if (s_len < c_len)
411 fx.spec.u.c = xrealloc (fx.spec.u.c, c_len + 1);
412 memset (&fx.spec.u.c[s_len], ' ', c_len - s_len);
413 fx.spec.u.c[c_len] = 0;
419 /* If nothing is provided then the field is the width of the
421 fx.sc += strlen (fx.spec.u.c);
423 append_var_spec (&fx.spec);
431 /* Parses a variable argument to the PRINT commands by passing it off
432 to fixed_parse_compatible() or fixed_parse_fortran() as appropriate.
435 parse_variable_argument (void)
437 if (!parse_variables (default_dict, &fx.v, &fx.nv, PV_DUPLICATE))
442 if (!fixed_parse_compatible ())
445 else if (token == '(')
449 if (!fixed_parse_fortran ())
454 /* User wants dictionary format specifiers. */
458 for (i = 0; i < fx.nv; i++)
461 fx.spec.type = PRT_VAR;
462 fx.spec.fc = fx.sc - 1;
463 fx.spec.u.v.v = fx.v[i];
464 fx.spec.u.v.f = fx.v[i]->print;
465 append_var_spec (&fx.spec);
466 fx.sc += fx.v[i]->print.w;
469 fx.spec.type = PRT_SPACE;
470 fx.spec.fc = fx.sc - 1;
471 append_var_spec (&fx.spec);
484 /* Parses a column specification for parse_specs(). */
486 fixed_parse_compatible (void)
492 type = fx.v[0]->type;
493 for (i = 1; i < fx.nv; i++)
494 if (type != fx.v[i]->type)
496 msg (SE, _("%s is not of the same type as %s. To specify "
497 "variables of different types in the same variable "
498 "list, use a FORTRAN-like format specifier."),
499 fx.v[i]->name, fx.v[0]->name);
503 if (!lex_force_int ())
505 fx.fc = lex_integer () - 1;
508 msg (SE, _("Column positions for fields must be positive."));
513 lex_negative_to_dash ();
516 if (!lex_force_int ())
518 fx.lc = lex_integer () - 1;
521 msg (SE, _("Column positions for fields must be positive."));
524 else if (fx.lc < fx.fc)
526 msg (SE, _("The ending column for a field must not "
527 "be less than the starting column."));
535 fx.spec.u.v.f.w = fx.lc - fx.fc + 1;
538 struct fmt_desc *fdp;
544 fx.spec.u.v.f.type = parse_format_specifier_name (&cp, 0);
545 if (fx.spec.u.v.f.type == -1)
549 msg (SE, _("A format specifier on this line "
550 "has extra characters on the end."));
557 fx.spec.u.v.f.type = FMT_F;
561 if (!lex_force_int ())
563 if (lex_integer () < 1)
565 msg (SE, _("The value for number of decimal places "
566 "must be at least 1."));
569 fx.spec.u.v.f.d = lex_integer ();
575 fdp = &formats[fx.spec.u.v.f.type];
576 if (fdp->n_args < 2 && fx.spec.u.v.f.d)
578 msg (SE, _("Input format %s doesn't accept decimal places."),
582 if (fx.spec.u.v.f.d > 16)
583 fx.spec.u.v.f.d = 16;
585 if (!lex_force_match (')'))
590 fx.spec.u.v.f.type = FMT_F;
596 if ((fx.lc - fx.fc + 1) % fx.nv)
598 msg (SE, _("The %d columns %d-%d can't be evenly divided into %d "
599 "fields."), fx.lc - fx.fc + 1, fx.fc + 1, fx.lc + 1, fx.nv);
603 dividend = (fx.lc - fx.fc + 1) / fx.nv;
604 fx.spec.u.v.f.w = dividend;
605 if (!check_output_specifier (&fx.spec.u.v.f))
607 if ((type == ALPHA) ^ (formats[fx.spec.u.v.f.type].cat & FCAT_STRING))
609 msg (SE, _("%s variables cannot be displayed with format %s."),
610 type == ALPHA ? _("String") : _("Numeric"),
611 fmt_to_string (&fx.spec.u.v.f));
615 /* Check that, for string variables, the user didn't specify a width
616 longer than an actual string width. */
619 /* Minimum width of all the string variables specified. */
620 int min_len = fx.v[0]->width;
622 for (i = 1; i < fx.nv; i++)
623 min_len = min (min_len, fx.v[i]->width);
624 if (!check_string_specifier (&fx.spec.u.v.f, min_len))
628 fx.spec.type = PRT_VAR;
629 for (i = 0; i < fx.nv; i++)
631 fx.spec.fc = fx.fc + dividend * i;
632 fx.spec.u.v.v = fx.v[i];
633 append_var_spec (&fx.spec);
638 /* Destroy a format list and, optionally, all its sublists. */
640 destroy_fmt_list (struct fmt_list * f, int recurse)
642 struct fmt_list *next;
647 if (recurse && f->f.type == FMT_DESCEND)
648 destroy_fmt_list (f->down, 1);
653 /* Recursively puts the format list F (which represents a set of
654 FORTRAN-like format specifications, like 4(F10,2X)) into the
657 dump_fmt_list (struct fmt_list * f)
661 for (; f; f = f->next)
662 if (f->f.type == FMT_X)
664 else if (f->f.type == FMT_T)
666 else if (f->f.type == FMT_NEWREC)
668 fx.recno += f->count;
670 fx.spec.type = PRT_NEWLINE;
671 for (i = 0; i < f->count; i++)
672 append_var_spec (&fx.spec);
675 for (i = 0; i < f->count; i++)
676 if (f->f.type == FMT_DESCEND)
678 if (!dump_fmt_list (f->down))
687 msg (SE, _("The number of format "
688 "specifications exceeds the number of variable "
694 if ((v->type == ALPHA) ^ (formats[f->f.type].cat & FCAT_STRING))
696 msg (SE, _("Display format %s may not be used with a "
697 "%s variable."), fmt_to_string (&f->f),
698 v->type == ALPHA ? _("string") : _("numeric"));
701 if (!check_string_specifier (&f->f, v->width))
704 fx.spec.type = PRT_VAR;
706 fx.spec.u.v.f = f->f;
707 fx.spec.fc = fx.sc - 1;
708 append_var_spec (&fx.spec);
715 /* Recursively parses a list of FORTRAN-like format specifiers. Calls
716 itself to parse nested levels of parentheses. Returns to its
717 original caller NULL, to indicate error, non-NULL, but nothing
718 useful, to indicate success (it returns a free()'d block). */
719 static struct fmt_list *
720 fixed_parse_fortran (void)
722 struct fmt_list *head = NULL;
723 struct fmt_list *fl = NULL;
725 lex_get (); /* skip opening parenthesis */
729 fl = fl->next = xmalloc (sizeof *fl);
731 head = fl = xmalloc (sizeof *fl);
735 if (!lex_integer_p ())
737 fl->count = lex_integer ();
745 fl->f.type = FMT_DESCEND;
747 fl->down = fixed_parse_fortran ();
752 else if (lex_match ('/'))
753 fl->f.type = FMT_NEWREC;
754 else if (!parse_format_specifier (&fl->f, 1)
755 || !check_output_specifier (&fl->f))
767 dump_fmt_list (head);
768 destroy_fmt_list (head, 1);
771 msg (SE, _("There aren't enough format specifications "
772 "to match the number of variable names given."));
779 destroy_fmt_list (head, 0);
784 /* Prints the table produced by the TABLE subcommand to the listing
789 struct prt_out_spec *spec;
790 const char *filename;
795 for (nspec = 0, spec = prt.spec; spec; spec = spec->next)
796 if (spec->type == PRT_CONST || spec->type == PRT_VAR)
798 t = tab_create (4, nspec + 1, 0);
799 tab_columns (t, TAB_COL_DOWN, 1);
800 tab_box (t, TAL_1, TAL_1, TAL_0, TAL_1, 0, 0, 3, nspec);
801 tab_hline (t, TAL_2, 0, 3, 1);
802 tab_headers (t, 0, 0, 1, 0);
803 tab_text (t, 0, 0, TAB_CENTER | TAT_TITLE, _("Variable"));
804 tab_text (t, 1, 0, TAB_CENTER | TAT_TITLE, _("Record"));
805 tab_text (t, 2, 0, TAB_CENTER | TAT_TITLE, _("Columns"));
806 tab_text (t, 3, 0, TAB_CENTER | TAT_TITLE, _("Format"));
807 tab_dim (t, tab_natural_dimensions);
808 for (nspec = recno = 0, spec = prt.spec; spec; spec = spec->next)
816 int len = strlen (spec->u.c);
818 tab_text (t, 0, nspec, TAB_LEFT | TAT_FIX | TAT_PRINTF,
819 "\"%s\"", spec->u.c);
820 tab_text (t, 1, nspec, TAT_PRINTF, "%d", recno + 1);
821 tab_text (t, 2, nspec, TAT_PRINTF, "%3d-%3d",
822 spec->fc + 1, spec->fc + len);
823 tab_text (t, 3, nspec, TAB_LEFT | TAT_FIX | TAT_PRINTF,
830 tab_text (t, 0, nspec, TAB_LEFT, spec->u.v.v->name);
831 tab_text (t, 1, nspec, TAT_PRINTF, "%d", recno + 1);
832 tab_text (t, 2, nspec, TAT_PRINTF, "%3d-%3d",
833 spec->fc + 1, spec->fc + spec->u.v.f.w);
834 tab_text (t, 3, nspec, TAB_LEFT | TAT_FIX,
835 fmt_to_string (&spec->u.v.f));
844 filename = fh_handle_name (prt.handle);
845 tab_title (t, 1, (prt.handle != NULL
846 ? _("Writing %3d records to file %s.")
847 : _("Writing %3d records to the listing file.")),
850 fh_handle_name (NULL);
853 /* PORTME: The number of characters in a line terminator. */
855 #define LINE_END_WIDTH 2 /* \r\n */
857 #define LINE_END_WIDTH 1 /* \n */
860 /* Calculates the maximum possible line width and allocates a buffer
861 big enough to contain it */
865 /* Cumulative maximum line width (excluding null terminator) so far. */
868 /* Width required by current this prt_out_spec. */
869 int pot_w; /* Potential w. */
872 struct prt_out_spec *i;
874 for (i = prt.spec; i; i = i->next)
882 pot_w = i->fc + strlen (i->u.c);
885 pot_w = i->fc + i->u.v.f.w;
897 prt.max_width = w + LINE_END_WIDTH + 1;
898 prt.line = xmalloc (prt.max_width);
901 /* Transformation. */
903 /* Performs the transformation inside print_trns T on case C. */
905 print_trns_proc (struct trns_header * trns, struct ccase * c,
908 /* Transformation. */
909 struct print_trns *t = (struct print_trns *) trns;
912 struct prt_out_spec *i;
917 /* Length of the line in buf. */
919 memset (buf, ' ', t->max_width);
921 if (t->options & PRT_EJECT)
924 /* Note that a field written to a place where a field has already
925 been written truncates the record. `PRINT /A B (T10,F8,T1,F8).'
926 only outputs B. This is an example of bug-for-bug compatibility,
927 in the author's opinion. */
928 for (i = t->spec; i; i = i->next)
932 if (t->handle == NULL)
935 tab_output_text (TAT_FIX | TAT_NOWRAP, buf);
939 if ((t->options & PRT_CMD_MASK) == PRT_PRINT
940 || t->handle->mode != FH_MD_BINARY)
942 /* PORTME: Line ends. */
949 dfm_put_record (t->handle, buf, len);
952 memset (buf, ' ', t->max_width);
957 /* FIXME: Should be revised to keep track of the string's
958 length outside the loop, probably in i->u.c[0]. */
959 memcpy (&buf[i->fc], i->u.c, strlen (i->u.c));
960 len = i->fc + strlen (i->u.c);
964 data_out (&buf[i->fc], &i->u.v.f, &c->data[i->u.v.v->fv]);
965 len = i->fc + i->u.v.f.w;
969 /* PRT_SPACE always immediately follows PRT_VAR. */
981 /* Frees all the data inside print_trns T. Does not free T. */
983 print_trns_free (struct trns_header * t)
985 struct prt_out_spec *i, *n;
987 for (i = ((struct print_trns *) t)->spec; i; i = n)
1006 free (((struct print_trns *) t)->line);
1011 /* PRINT SPACE transformation. */
1012 struct print_space_trns
1014 struct trns_header h;
1016 struct file_handle *handle; /* Output file, NULL=listing file. */
1017 struct expression *e; /* Number of lines; NULL=1. */
1021 static trns_proc_func print_space_trns_proc;
1022 static trns_free_func print_space_trns_free;
1025 cmd_print_space (void)
1027 struct print_space_trns *t;
1028 struct file_handle *handle;
1029 struct expression *e;
1031 lex_match_id ("SPACE");
1032 if (lex_match_id ("OUTFILE"))
1037 handle = fh_get_handle_by_name (tokid);
1038 else if (token == T_STRING)
1039 handle = fh_get_handle_by_filename (tokid);
1042 msg (SE, _("A file name or handle was expected in the "
1043 "OUTFILE subcommand."));
1056 e = expr_parse (PXP_NUMERIC);
1060 lex_error (_("expecting end of command"));
1067 t = xmalloc (sizeof *t);
1068 t->h.proc = print_space_trns_proc;
1070 t->h.free = print_space_trns_free;
1076 add_transformation ((struct trns_header *) t);
1081 print_space_trns_proc (struct trns_header * trns, struct ccase * c,
1082 int case_num UNUSED)
1084 struct print_space_trns *t = (struct print_space_trns *) trns;
1091 expr_evaluate (t->e, c, case_num, &v);
1095 msg (SW, _("The expression on PRINT SPACE evaluated to %d. It's "
1096 "not possible to PRINT SPACE a negative number of "
1105 if (t->handle == NULL)
1110 char buf[LINE_END_WIDTH];
1112 /* PORTME: Line ends. */
1120 dfm_put_record (t->handle, buf, LINE_END_WIDTH);
1127 print_space_trns_free (struct trns_header * trns)
1129 expr_free (((struct print_space_trns *) trns)->e);
1132 /* Debugging code. */
1138 struct prt_out_spec *p;
1140 if (prt.handle == NULL)
1147 printf ("WRITE OUTFILE=%s", handle_name (prt.handle));
1148 printf (" MAX_WIDTH=%d", prt.max_width);
1150 for (p = prt.spec; p; p = p->next)
1154 printf (_("<ERROR>"));
1160 printf (" \"%s\" %d-%d", p->u.c, p->fc + 1, p->fc + strlen (p->u.c));
1163 printf (" %s %d %d-%d (%s)", p->u.v.v->name, p->u.v.v->fv, p->fc + 1,
1164 p->fc + p->u.v.v->print.w, fmt_to_string (&p->u.v.v->print));
1167 printf (" \" \" %d", p->fc + 1);
1172 #endif /* DEBUGGING */