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
28 #include "file-handle.h"
35 #include "debug-print.h"
37 /* Describes what to do when an output field is encountered. */
40 PRT_ERROR, /* Invalid value. */
41 PRT_NEWLINE, /* Newline. */
42 PRT_CONST, /* Constant string. */
43 PRT_VAR, /* Variable. */
44 PRT_SPACE /* A single space. */
47 /* Describes how to output one field. */
50 struct prt_out_spec *next;
51 int type; /* PRT_* constant. */
52 int fc; /* 0-based first column. */
55 char *c; /* PRT_CONST: Associated string. */
58 struct variable *v; /* PRT_VAR: Associated variable. */
59 struct fmt_spec f; /* PRT_VAR: Output spec. */
66 /* Enums for use with print_trns's `options' field. */
69 PRT_CMD_MASK = 1, /* Command type mask. */
70 PRT_PRINT = 0, /* PRINT transformation identifier. */
71 PRT_WRITE = 1, /* WRITE transformation identifier. */
72 PRT_EJECT = 002 /* Can be combined with CMD_PRINT only. */
75 /* PRINT, PRINT EJECT, WRITE private data structure. */
79 struct file_handle *handle; /* Output file, NULL=listing file. */
80 int options; /* PRT_* bitmapped field. */
81 struct prt_out_spec *spec; /* Output specifications. */
82 int max_width; /* Maximum line width including null. */
83 char *line; /* Buffer for sticking lines in. */
86 /* PRT_PRINT or PRT_WRITE. */
89 /* Holds information on parsing the data file. */
90 static struct print_trns prt;
92 /* Last prt_out_spec in the chain. Used for building the linked-list. */
93 static struct prt_out_spec *next;
95 /* Number of records. */
98 static int internal_cmd_print (int flags);
99 static int print_trns_proc (struct trns_header *, struct ccase *);
100 static void print_trns_free (struct trns_header *);
101 static int parse_specs (void);
102 static void dump_table (void);
103 static void append_var_spec (struct prt_out_spec *spec);
104 static void alloc_line (void);
107 void debug_print (void);
112 /* Parses PRINT command. */
116 lex_match_id ("PRINT");
117 return internal_cmd_print (PRT_PRINT);
120 /* Parses PRINT EJECT command. */
122 cmd_print_eject (void)
124 lex_match_id ("EJECT");
125 return internal_cmd_print (PRT_PRINT | PRT_EJECT);
128 /* Parses WRITE command. */
132 lex_match_id ("WRITE");
133 return internal_cmd_print (PRT_WRITE);
136 /* Parses the output commands. F is PRT_PRINT, PRT_WRITE, or
137 PRT_PRINT|PRT_EJECT. */
139 internal_cmd_print (int f)
141 /* 0=print no table, 1=print table. (TABLE subcommand.) */
144 /* malloc()'d transformation. */
145 struct print_trns *trns;
147 /* Fill in prt to facilitate error-handling. */
148 prt.h.proc = print_trns_proc;
149 prt.h.free = print_trns_free;
157 which_cmd = f & PRT_CMD_MASK;
159 /* Parse the command options. */
160 while (!lex_match ('/'))
162 if (lex_match_id ("OUTFILE"))
166 prt.handle = fh_parse_file_handle ();
170 else if (lex_match_id ("RECORDS"))
174 if (!lex_force_int ())
176 nrec = lex_integer ();
180 else if (lex_match_id ("TABLE"))
182 else if (lex_match_id ("NOTABLE"))
186 lex_error (_("expecting a valid subcommand"));
191 /* Parse variables and strings. */
195 /* Output the variable table if requested. */
199 /* Count the maximum line width. Allocate linebuffer if
203 /* Put the transformation in the queue. */
204 trns = xmalloc (sizeof *trns);
205 memcpy (trns, &prt, sizeof *trns);
206 add_transformation ((struct trns_header *) trns);
215 print_trns_free ((struct trns_header *) & prt);
219 /* Appends the field output specification SPEC to the list maintained
222 append_var_spec (struct prt_out_spec *spec)
225 prt.spec = next = xmalloc (sizeof *spec);
227 next = next->next = xmalloc (sizeof *spec);
229 memcpy (next, spec, sizeof *spec);
233 /* Field parsing. Mostly stolen from data-list.c. */
235 /* Used for chaining together fortran-like format specifiers. */
238 struct fmt_list *next;
241 struct fmt_list *down;
244 /* Used as "local" variables among the fixed-format parsing funcs. If
245 it were guaranteed that PSPP were going to be compiled by gcc,
246 I'd make all these functions a single set of nested functions. */
249 struct variable **v; /* variable list */
250 int nv; /* number of variables in list */
251 int cv; /* number of variables from list used up so far
252 by the FORTRAN-like format specifiers */
254 int recno; /* current 1-based record number */
255 int sc; /* 1-based starting column for next variable */
257 struct prt_out_spec spec; /* next format spec to append to list */
258 int fc, lc; /* first, last 1-based column number of current
261 int level; /* recursion level for FORTRAN-like format
266 static int fixed_parse_compatible (void);
267 static struct fmt_list *fixed_parse_fortran (void);
269 static int parse_string_argument (void);
270 static int parse_variable_argument (void);
272 /* Parses all the variable and string specifications on a single
273 PRINT, PRINT EJECT, or WRITE command into the prt structure.
278 /* Return code from called function. */
286 while (lex_match ('/'))
288 int prev_recno = fx.recno;
293 if (!lex_force_int ())
295 if (lex_integer () < fx.recno)
297 msg (SE, _("The record number specified, %ld, is "
298 "before the previous record, %d. Data "
299 "fields must be listed in order of "
300 "increasing record number."),
301 lex_integer (), fx.recno - 1);
304 fx.recno = lex_integer ();
308 fx.spec.type = PRT_NEWLINE;
309 while (prev_recno++ < fx.recno)
310 append_var_spec (&fx.spec);
315 if (token == T_STRING)
316 code = parse_string_argument ();
318 code = parse_variable_argument ();
322 fx.spec.type = PRT_NEWLINE;
323 append_var_spec (&fx.spec);
327 else if (fx.recno > nrec)
329 msg (SE, _("Variables are specified on records that "
330 "should not exist according to RECORDS subcommand."));
336 lex_error (_("expecting end of command"));
343 /* Parses a string argument to the PRINT commands. Returns success. */
345 parse_string_argument (void)
347 fx.spec.type = PRT_CONST;
348 fx.spec.fc = fx.sc - 1;
349 fx.spec.u.c = xstrdup (ds_value (&tokstr));
352 /* Parse the included column range. */
355 /* Width of column range in characters. */
358 /* Width of constant string in characters. */
361 /* 1-based index of last column in range. */
364 if (!lex_integer_p () || lex_integer () <= 0)
366 msg (SE, _("%g is not a valid column location."), tokval);
369 fx.spec.fc = lex_integer () - 1;
372 lex_negative_to_dash ();
375 if (!lex_integer_p ())
377 msg (SE, _("Column location expected following `%d-'."),
381 if (lex_integer () <= 0)
383 msg (SE, _("%g is not a valid column location."), tokval);
386 if (lex_integer () < fx.spec.fc + 1)
388 msg (SE, _("%d-%ld is not a valid column range. The second "
389 "column must be greater than or equal to the first."),
390 fx.spec.fc + 1, lex_integer ());
393 lc = lex_integer () - 1;
398 /* If only a starting location is specified then the field is
399 the width of the provided string. */
400 lc = fx.spec.fc + strlen (fx.spec.u.c) - 1;
402 /* Apply the range. */
403 c_len = lc - fx.spec.fc + 1;
404 s_len = strlen (fx.spec.u.c);
406 fx.spec.u.c[c_len] = 0;
407 else if (s_len < c_len)
409 fx.spec.u.c = xrealloc (fx.spec.u.c, c_len + 1);
410 memset (&fx.spec.u.c[s_len], ' ', c_len - s_len);
411 fx.spec.u.c[c_len] = 0;
417 /* If nothing is provided then the field is the width of the
419 fx.sc += strlen (fx.spec.u.c);
421 append_var_spec (&fx.spec);
429 /* Parses a variable argument to the PRINT commands by passing it off
430 to fixed_parse_compatible() or fixed_parse_fortran() as appropriate.
433 parse_variable_argument (void)
435 if (!parse_variables (default_dict, &fx.v, &fx.nv, PV_DUPLICATE))
440 if (!fixed_parse_compatible ())
443 else if (token == '(')
447 if (!fixed_parse_fortran ())
452 /* User wants dictionary format specifiers. */
456 for (i = 0; i < fx.nv; i++)
459 fx.spec.type = PRT_VAR;
460 fx.spec.fc = fx.sc - 1;
461 fx.spec.u.v.v = fx.v[i];
462 fx.spec.u.v.f = fx.v[i]->print;
463 append_var_spec (&fx.spec);
464 fx.sc += fx.v[i]->print.w;
467 fx.spec.type = PRT_SPACE;
468 fx.spec.fc = fx.sc - 1;
469 append_var_spec (&fx.spec);
482 /* Parses a column specification for parse_specs(). */
484 fixed_parse_compatible (void)
490 type = fx.v[0]->type;
491 for (i = 1; i < fx.nv; i++)
492 if (type != fx.v[i]->type)
494 msg (SE, _("%s is not of the same type as %s. To specify "
495 "variables of different types in the same variable "
496 "list, use a FORTRAN-like format specifier."),
497 fx.v[i]->name, fx.v[0]->name);
501 if (!lex_force_int ())
503 fx.fc = lex_integer () - 1;
506 msg (SE, _("Column positions for fields must be positive."));
511 lex_negative_to_dash ();
514 if (!lex_force_int ())
516 fx.lc = lex_integer () - 1;
519 msg (SE, _("Column positions for fields must be positive."));
522 else if (fx.lc < fx.fc)
524 msg (SE, _("The ending column for a field must not "
525 "be less than the starting column."));
533 fx.spec.u.v.f.w = fx.lc - fx.fc + 1;
536 struct fmt_desc *fdp;
542 fx.spec.u.v.f.type = parse_format_specifier_name (&cp, 0);
543 if (fx.spec.u.v.f.type == -1)
547 msg (SE, _("A format specifier on this line "
548 "has extra characters on the end."));
555 fx.spec.u.v.f.type = FMT_F;
559 if (!lex_force_int ())
561 if (lex_integer () < 1)
563 msg (SE, _("The value for number of decimal places "
564 "must be at least 1."));
567 fx.spec.u.v.f.d = lex_integer ();
573 fdp = &formats[fx.spec.u.v.f.type];
574 if (fdp->n_args < 2 && fx.spec.u.v.f.d)
576 msg (SE, _("Input format %s doesn't accept decimal places."),
580 if (fx.spec.u.v.f.d > 16)
581 fx.spec.u.v.f.d = 16;
583 if (!lex_force_match (')'))
588 fx.spec.u.v.f.type = FMT_F;
594 if ((fx.lc - fx.fc + 1) % fx.nv)
596 msg (SE, _("The %d columns %d-%d can't be evenly divided into %d "
597 "fields."), fx.lc - fx.fc + 1, fx.fc + 1, fx.lc + 1, fx.nv);
601 dividend = (fx.lc - fx.fc + 1) / fx.nv;
602 fx.spec.u.v.f.w = dividend;
603 if (!check_output_specifier (&fx.spec.u.v.f))
605 if ((type == ALPHA) ^ (formats[fx.spec.u.v.f.type].cat & FCAT_STRING))
607 msg (SE, _("%s variables cannot be displayed with format %s."),
608 type == ALPHA ? _("String") : _("Numeric"),
609 fmt_to_string (&fx.spec.u.v.f));
613 /* Check that, for string variables, the user didn't specify a width
614 longer than an actual string width. */
617 /* Minimum width of all the string variables specified. */
618 int min_len = fx.v[0]->width;
620 for (i = 1; i < fx.nv; i++)
621 min_len = min (min_len, fx.v[i]->width);
622 if (!check_string_specifier (&fx.spec.u.v.f, min_len))
626 fx.spec.type = PRT_VAR;
627 for (i = 0; i < fx.nv; i++)
629 fx.spec.fc = fx.fc + dividend * i;
630 fx.spec.u.v.v = fx.v[i];
631 append_var_spec (&fx.spec);
636 /* Destroy a format list and, optionally, all its sublists. */
638 destroy_fmt_list (struct fmt_list * f, int recurse)
640 struct fmt_list *next;
645 if (recurse && f->f.type == FMT_DESCEND)
646 destroy_fmt_list (f->down, 1);
651 /* Recursively puts the format list F (which represents a set of
652 FORTRAN-like format specifications, like 4(F10,2X)) into the
655 dump_fmt_list (struct fmt_list * f)
659 for (; f; f = f->next)
660 if (f->f.type == FMT_X)
662 else if (f->f.type == FMT_T)
664 else if (f->f.type == FMT_NEWREC)
666 fx.recno += f->count;
668 fx.spec.type = PRT_NEWLINE;
669 for (i = 0; i < f->count; i++)
670 append_var_spec (&fx.spec);
673 for (i = 0; i < f->count; i++)
674 if (f->f.type == FMT_DESCEND)
676 if (!dump_fmt_list (f->down))
685 msg (SE, _("The number of format "
686 "specifications exceeds the number of variable "
692 if ((v->type == ALPHA) ^ (formats[f->f.type].cat & FCAT_STRING))
694 msg (SE, _("Display format %s may not be used with a "
695 "%s variable."), fmt_to_string (&f->f),
696 v->type == ALPHA ? _("string") : _("numeric"));
699 if (!check_string_specifier (&f->f, v->width))
702 fx.spec.type = PRT_VAR;
704 fx.spec.u.v.f = f->f;
705 fx.spec.fc = fx.sc - 1;
706 append_var_spec (&fx.spec);
713 /* Recursively parses a list of FORTRAN-like format specifiers. Calls
714 itself to parse nested levels of parentheses. Returns to its
715 original caller NULL, to indicate error, non-NULL, but nothing
716 useful, to indicate success (it returns a free()'d block). */
717 static struct fmt_list *
718 fixed_parse_fortran (void)
720 struct fmt_list *head;
721 struct fmt_list *fl = NULL;
723 lex_get (); /* skip opening parenthesis */
727 fl = fl->next = xmalloc (sizeof *fl);
729 head = fl = xmalloc (sizeof *fl);
733 if (!lex_integer_p ())
735 fl->count = lex_integer ();
743 fl->f.type = FMT_DESCEND;
745 fl->down = fixed_parse_fortran ();
750 else if (lex_match ('/'))
751 fl->f.type = FMT_NEWREC;
752 else if (!parse_format_specifier (&fl->f, 1)
753 || !check_output_specifier (&fl->f))
765 dump_fmt_list (head);
766 destroy_fmt_list (head, 1);
769 msg (SE, _("There aren't enough format specifications "
770 "to match the number of variable names given."));
777 destroy_fmt_list (head, 0);
782 /* Prints the table produced by the TABLE subcommand to the listing
787 struct prt_out_spec *spec;
788 const char *filename;
793 for (nspec = 0, spec = prt.spec; spec; spec = spec->next)
794 if (spec->type == PRT_CONST || spec->type == PRT_VAR)
796 t = tab_create (4, nspec + 1, 0);
797 tab_columns (t, TAB_COL_DOWN, 1);
798 tab_box (t, TAL_1, TAL_1, TAL_0, TAL_1, 0, 0, 3, nspec);
799 tab_hline (t, TAL_2, 0, 3, 1);
800 tab_headers (t, 0, 0, 1, 0);
801 tab_text (t, 0, 0, TAB_CENTER | TAT_TITLE, _("Variable"));
802 tab_text (t, 1, 0, TAB_CENTER | TAT_TITLE, _("Record"));
803 tab_text (t, 2, 0, TAB_CENTER | TAT_TITLE, _("Columns"));
804 tab_text (t, 3, 0, TAB_CENTER | TAT_TITLE, _("Format"));
805 tab_dim (t, tab_natural_dimensions);
806 for (nspec = recno = 0, spec = prt.spec; spec; spec = spec->next)
814 int len = strlen (spec->u.c);
816 tab_text (t, 0, nspec, TAB_LEFT | TAT_FIX | TAT_PRINTF,
817 "\"%s\"", spec->u.c);
818 tab_text (t, 1, nspec, TAT_PRINTF, "%d", recno + 1);
819 tab_text (t, 2, nspec, TAT_PRINTF, "%3d-%3d",
820 spec->fc + 1, spec->fc + len);
821 tab_text (t, 3, nspec, TAB_LEFT | TAT_FIX | TAT_PRINTF,
828 tab_text (t, 0, nspec, TAB_LEFT, spec->u.v.v->name);
829 tab_text (t, 1, nspec, TAT_PRINTF, "%d", recno + 1);
830 tab_text (t, 2, nspec, TAT_PRINTF, "%3d-%3d",
831 spec->fc + 1, spec->fc + spec->u.v.f.w);
832 tab_text (t, 3, nspec, TAB_LEFT | TAT_FIX,
833 fmt_to_string (&spec->u.v.f));
842 filename = fh_handle_name (prt.handle);
843 tab_title (t, 1, (prt.handle != NULL
844 ? _("Writing %3d records to file %s.")
845 : _("Writing %3d records to the listing file.")),
848 fh_handle_name (NULL);
851 /* PORTME: The number of characters in a line terminator. */
853 #define LINE_END_WIDTH 2 /* \r\n */
855 #define LINE_END_WIDTH 1 /* \n */
858 /* Calculates the maximum possible line width and allocates a buffer
859 big enough to contain it */
863 /* Cumulative maximum line width (excluding null terminator) so far. */
866 /* Width required by current this prt_out_spec. */
867 int pot_w; /* Potential w. */
870 struct prt_out_spec *i;
872 for (i = prt.spec; i; i = i->next)
880 pot_w = i->fc + strlen (i->u.c);
883 pot_w = i->fc + i->u.v.f.w;
895 prt.max_width = w + LINE_END_WIDTH + 1;
896 prt.line = xmalloc (prt.max_width);
899 /* Transformation. */
901 /* Performs the transformation inside print_trns T on case C. */
903 print_trns_proc (struct trns_header * trns, struct ccase * c)
905 /* Transformation. */
906 struct print_trns *t = (struct print_trns *) trns;
909 struct prt_out_spec *i;
914 /* Length of the line in buf. */
916 memset (buf, ' ', t->max_width);
918 if (t->options & PRT_EJECT)
921 /* Note that a field written to a place where a field has already
922 been written truncates the record. `PRINT /A B (T10,F8,T1,F8).'
923 only outputs B. This is an example of bug-for-bug compatibility,
924 in the author's opinion. */
925 for (i = t->spec; i; i = i->next)
929 if (t->handle == NULL)
932 tab_output_text (TAT_FIX | TAT_NOWRAP, buf);
936 if ((t->options & PRT_CMD_MASK) == PRT_PRINT
937 || t->handle->mode != FH_MD_BINARY)
939 /* PORTME: Line ends. */
946 dfm_put_record (t->handle, buf, len);
949 memset (buf, ' ', t->max_width);
954 /* FIXME: Should be revised to keep track of the string's
955 length outside the loop, probably in i->u.c[0]. */
956 memcpy (&buf[i->fc], i->u.c, strlen (i->u.c));
957 len = i->fc + strlen (i->u.c);
961 data_out (&buf[i->fc], &i->u.v.f, &c->data[i->u.v.v->fv]);
962 len = i->fc + i->u.v.f.w;
966 /* PRT_SPACE always immediately follows PRT_VAR. */
978 /* Frees all the data inside print_trns T. Does not free T. */
980 print_trns_free (struct trns_header * t)
982 struct prt_out_spec *i, *n;
984 for (i = ((struct print_trns *) t)->spec; i; i = n)
1003 free (((struct print_trns *) t)->line);
1008 /* PRINT SPACE transformation. */
1009 struct print_space_trns
1011 struct trns_header h;
1013 struct file_handle *handle; /* Output file, NULL=listing file. */
1014 struct expression *e; /* Number of lines; NULL=1. */
1018 static int print_space_trns_proc (struct trns_header *, struct ccase *);
1019 static void print_space_trns_free (struct trns_header *);
1022 cmd_print_space (void)
1024 struct print_space_trns *t;
1025 struct file_handle *handle;
1026 struct expression *e;
1028 lex_match_id ("SPACE");
1029 if (lex_match_id ("OUTFILE"))
1034 handle = fh_get_handle_by_name (tokid);
1035 else if (token == T_STRING)
1036 handle = fh_get_handle_by_filename (tokid);
1039 msg (SE, _("A file name or handle was expected in the "
1040 "OUTFILE subcommand."));
1053 e = expr_parse (PXP_NUMERIC);
1057 lex_error (_("expecting end of command"));
1064 t = xmalloc (sizeof *t);
1065 t->h.proc = print_space_trns_proc;
1067 t->h.free = print_space_trns_free;
1073 add_transformation ((struct trns_header *) t);
1078 print_space_trns_proc (struct trns_header * trns, struct ccase * c)
1080 struct print_space_trns *t = (struct print_space_trns *) trns;
1087 expr_evaluate (t->e, c, &v);
1091 msg (SW, _("The expression on PRINT SPACE evaluated to %d. It's "
1092 "not possible to PRINT SPACE a negative number of "
1101 if (t->handle == NULL)
1106 char buf[LINE_END_WIDTH];
1108 /* PORTME: Line ends. */
1116 dfm_put_record (t->handle, buf, LINE_END_WIDTH);
1123 print_space_trns_free (struct trns_header * trns)
1125 expr_free (((struct print_space_trns *) trns)->e);
1128 /* Debugging code. */
1134 struct prt_out_spec *p;
1136 if (prt.handle == NULL)
1143 printf ("WRITE OUTFILE=%s", handle_name (prt.handle));
1144 printf (" MAX_WIDTH=%d", prt.max_width);
1146 for (p = prt.spec; p; p = p->next)
1150 printf (_("<ERROR>"));
1156 printf (" \"%s\" %d-%d", p->u.c, p->fc + 1, p->fc + strlen (p->u.c));
1159 printf (" %s %d %d-%d (%s)", p->u.v.v->name, p->u.v.v->fv, p->fc + 1,
1160 p->fc + p->u.v.v->print.w, fmt_to_string (&p->u.v.v->print));
1163 printf (" \" \" %d", p->fc + 1);
1168 #endif /* DEBUGGING */