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. */
31 #include "file-handle.h"
38 /* Describes what to do when an output field is encountered. */
41 PRT_ERROR, /* Invalid value. */
42 PRT_NEWLINE, /* Newline. */
43 PRT_CONST, /* Constant string. */
44 PRT_VAR, /* Variable. */
45 PRT_SPACE /* A single space. */
48 /* Describes how to output one field. */
51 struct prt_out_spec *next;
52 int type; /* PRT_* constant. */
53 int fc; /* 0-based first column. */
56 char *c; /* PRT_CONST: Associated string. */
59 struct variable *v; /* PRT_VAR: Associated variable. */
60 struct fmt_spec f; /* PRT_VAR: Output spec. */
67 /* Enums for use with print_trns's `options' field. */
70 PRT_CMD_MASK = 1, /* Command type mask. */
71 PRT_PRINT = 0, /* PRINT transformation identifier. */
72 PRT_WRITE = 1, /* WRITE transformation identifier. */
73 PRT_EJECT = 002 /* Can be combined with CMD_PRINT only. */
76 /* PRINT, PRINT EJECT, WRITE private data structure. */
80 struct file_handle *handle; /* Output file, NULL=listing file. */
81 int options; /* PRT_* bitmapped field. */
82 struct prt_out_spec *spec; /* Output specifications. */
83 int max_width; /* Maximum line width including null. */
84 char *line; /* Buffer for sticking lines in. */
87 /* PRT_PRINT or PRT_WRITE. */
90 /* Holds information on parsing the data file. */
91 static struct print_trns prt;
93 /* Last prt_out_spec in the chain. Used for building the linked-list. */
94 static struct prt_out_spec *next;
96 /* Number of records. */
99 static int internal_cmd_print (int flags);
100 static trns_proc_func print_trns_proc;
101 static trns_free_func print_trns_free;
102 static int parse_specs (void);
103 static void dump_table (void);
104 static void append_var_spec (struct prt_out_spec *spec);
105 static void alloc_line (void);
109 /* Parses PRINT command. */
113 return internal_cmd_print (PRT_PRINT);
116 /* Parses PRINT EJECT command. */
118 cmd_print_eject (void)
120 return internal_cmd_print (PRT_PRINT | PRT_EJECT);
123 /* Parses WRITE command. */
127 return internal_cmd_print (PRT_WRITE);
130 /* Parses the output commands. F is PRT_PRINT, PRT_WRITE, or
131 PRT_PRINT|PRT_EJECT. */
133 internal_cmd_print (int f)
135 /* 0=print no table, 1=print table. (TABLE subcommand.) */
138 /* malloc()'d transformation. */
139 struct print_trns *trns;
141 /* Fill in prt to facilitate error-handling. */
142 prt.h.proc = print_trns_proc;
143 prt.h.free = print_trns_free;
151 which_cmd = f & PRT_CMD_MASK;
153 /* Parse the command options. */
154 while (!lex_match ('/'))
156 if (lex_match_id ("OUTFILE"))
160 prt.handle = fh_parse_file_handle ();
164 else if (lex_match_id ("RECORDS"))
168 if (!lex_force_int ())
170 nrec = lex_integer ();
174 else if (lex_match_id ("TABLE"))
176 else if (lex_match_id ("NOTABLE"))
180 lex_error (_("expecting a valid subcommand"));
185 /* Parse variables and strings. */
189 if (prt.handle != NULL && !dfm_open_for_writing (prt.handle))
192 /* Output the variable table if requested. */
196 /* Count the maximum line width. Allocate linebuffer if
200 /* Put the transformation in the queue. */
201 trns = xmalloc (sizeof *trns);
202 memcpy (trns, &prt, sizeof *trns);
203 add_transformation ((struct trns_header *) trns);
208 print_trns_free ((struct trns_header *) & prt);
212 /* Appends the field output specification SPEC to the list maintained
215 append_var_spec (struct prt_out_spec *spec)
218 prt.spec = next = xmalloc (sizeof *spec);
220 next = next->next = xmalloc (sizeof *spec);
222 memcpy (next, spec, sizeof *spec);
226 /* Field parsing. Mostly stolen from data-list.c. */
228 /* Used for chaining together fortran-like format specifiers. */
231 struct fmt_list *next;
234 struct fmt_list *down;
237 /* Used as "local" variables among the fixed-format parsing funcs. If
238 it were guaranteed that PSPP were going to be compiled by gcc,
239 I'd make all these functions a single set of nested functions. */
242 struct variable **v; /* variable list */
243 int nv; /* number of variables in list */
244 int cv; /* number of variables from list used up so far
245 by the FORTRAN-like format specifiers */
247 int recno; /* current 1-based record number */
248 int sc; /* 1-based starting column for next variable */
250 struct prt_out_spec spec; /* next format spec to append to list */
251 int fc, lc; /* first, last 1-based column number of current
254 int level; /* recursion level for FORTRAN-like format
259 static int fixed_parse_compatible (void);
260 static struct fmt_list *fixed_parse_fortran (void);
262 static int parse_string_argument (void);
263 static int parse_variable_argument (void);
265 /* Parses all the variable and string specifications on a single
266 PRINT, PRINT EJECT, or WRITE command into the prt structure.
271 /* Return code from called function. */
279 while (lex_match ('/'))
281 int prev_recno = fx.recno;
286 if (!lex_force_int ())
288 if (lex_integer () < fx.recno)
290 msg (SE, _("The record number specified, %ld, is "
291 "before the previous record, %d. Data "
292 "fields must be listed in order of "
293 "increasing record number."),
294 lex_integer (), fx.recno - 1);
297 fx.recno = lex_integer ();
301 fx.spec.type = PRT_NEWLINE;
302 while (prev_recno++ < fx.recno)
303 append_var_spec (&fx.spec);
308 if (token == T_STRING)
309 code = parse_string_argument ();
311 code = parse_variable_argument ();
315 fx.spec.type = PRT_NEWLINE;
316 append_var_spec (&fx.spec);
320 else if (fx.recno > nrec)
322 msg (SE, _("Variables are specified on records that "
323 "should not exist according to RECORDS subcommand."));
329 lex_error (_("expecting end of command"));
336 /* Parses a string argument to the PRINT commands. Returns success. */
338 parse_string_argument (void)
340 fx.spec.type = PRT_CONST;
341 fx.spec.fc = fx.sc - 1;
342 fx.spec.u.c = xstrdup (ds_c_str (&tokstr));
345 /* Parse the included column range. */
348 /* Width of column range in characters. */
351 /* Width of constant string in characters. */
354 /* 1-based index of last column in range. */
357 if (!lex_integer_p () || lex_integer () <= 0)
359 msg (SE, _("%g is not a valid column location."), tokval);
362 fx.spec.fc = lex_integer () - 1;
365 lex_negative_to_dash ();
368 if (!lex_integer_p ())
370 msg (SE, _("Column location expected following `%d-'."),
374 if (lex_integer () <= 0)
376 msg (SE, _("%g is not a valid column location."), tokval);
379 if (lex_integer () < fx.spec.fc + 1)
381 msg (SE, _("%d-%ld is not a valid column range. The second "
382 "column must be greater than or equal to the first."),
383 fx.spec.fc + 1, lex_integer ());
386 lc = lex_integer () - 1;
391 /* If only a starting location is specified then the field is
392 the width of the provided string. */
393 lc = fx.spec.fc + strlen (fx.spec.u.c) - 1;
395 /* Apply the range. */
396 c_len = lc - fx.spec.fc + 1;
397 s_len = strlen (fx.spec.u.c);
399 fx.spec.u.c[c_len] = 0;
400 else if (s_len < c_len)
402 fx.spec.u.c = xrealloc (fx.spec.u.c, c_len + 1);
403 memset (&fx.spec.u.c[s_len], ' ', c_len - s_len);
404 fx.spec.u.c[c_len] = 0;
410 /* If nothing is provided then the field is the width of the
412 fx.sc += strlen (fx.spec.u.c);
414 append_var_spec (&fx.spec);
422 /* Parses a variable argument to the PRINT commands by passing it off
423 to fixed_parse_compatible() or fixed_parse_fortran() as appropriate.
426 parse_variable_argument (void)
428 if (!parse_variables (default_dict, &fx.v, &fx.nv, PV_DUPLICATE))
433 if (!fixed_parse_compatible ())
436 else if (token == '(')
440 if (!fixed_parse_fortran ())
445 /* User wants dictionary format specifiers. */
449 for (i = 0; i < fx.nv; i++)
452 fx.spec.type = PRT_VAR;
453 fx.spec.fc = fx.sc - 1;
454 fx.spec.u.v.v = fx.v[i];
455 fx.spec.u.v.f = fx.v[i]->print;
456 append_var_spec (&fx.spec);
457 fx.sc += fx.v[i]->print.w;
460 fx.spec.type = PRT_SPACE;
461 fx.spec.fc = fx.sc - 1;
462 append_var_spec (&fx.spec);
475 /* Parses a column specification for parse_specs(). */
477 fixed_parse_compatible (void)
483 type = fx.v[0]->type;
484 for (i = 1; i < fx.nv; i++)
485 if (type != fx.v[i]->type)
487 msg (SE, _("%s is not of the same type as %s. To specify "
488 "variables of different types in the same variable "
489 "list, use a FORTRAN-like format specifier."),
490 fx.v[i]->name, fx.v[0]->name);
494 if (!lex_force_int ())
496 fx.fc = lex_integer () - 1;
499 msg (SE, _("Column positions for fields must be positive."));
504 lex_negative_to_dash ();
507 if (!lex_force_int ())
509 fx.lc = lex_integer () - 1;
512 msg (SE, _("Column positions for fields must be positive."));
515 else if (fx.lc < fx.fc)
517 msg (SE, _("The ending column for a field must not "
518 "be less than the starting column."));
526 fx.spec.u.v.f.w = fx.lc - fx.fc + 1;
529 struct fmt_desc *fdp;
535 fx.spec.u.v.f.type = parse_format_specifier_name (&cp, 0);
536 if (fx.spec.u.v.f.type == -1)
540 msg (SE, _("A format specifier on this line "
541 "has extra characters on the end."));
548 fx.spec.u.v.f.type = FMT_F;
552 if (!lex_force_int ())
554 if (lex_integer () < 1)
556 msg (SE, _("The value for number of decimal places "
557 "must be at least 1."));
560 fx.spec.u.v.f.d = lex_integer ();
566 fdp = &formats[fx.spec.u.v.f.type];
567 if (fdp->n_args < 2 && fx.spec.u.v.f.d)
569 msg (SE, _("Input format %s doesn't accept decimal places."),
573 if (fx.spec.u.v.f.d > 16)
574 fx.spec.u.v.f.d = 16;
576 if (!lex_force_match (')'))
581 fx.spec.u.v.f.type = FMT_F;
587 if ((fx.lc - fx.fc + 1) % fx.nv)
589 msg (SE, _("The %d columns %d-%d can't be evenly divided into %d "
590 "fields."), fx.lc - fx.fc + 1, fx.fc + 1, fx.lc + 1, fx.nv);
594 dividend = (fx.lc - fx.fc + 1) / fx.nv;
595 fx.spec.u.v.f.w = dividend;
596 if (!check_output_specifier (&fx.spec.u.v.f))
598 if ((type == ALPHA) ^ (formats[fx.spec.u.v.f.type].cat & FCAT_STRING))
600 msg (SE, _("%s variables cannot be displayed with format %s."),
601 type == ALPHA ? _("String") : _("Numeric"),
602 fmt_to_string (&fx.spec.u.v.f));
606 /* Check that, for string variables, the user didn't specify a width
607 longer than an actual string width. */
610 /* Minimum width of all the string variables specified. */
611 int min_len = fx.v[0]->width;
613 for (i = 1; i < fx.nv; i++)
614 min_len = min (min_len, fx.v[i]->width);
615 if (!check_string_specifier (&fx.spec.u.v.f, min_len))
619 fx.spec.type = PRT_VAR;
620 for (i = 0; i < fx.nv; i++)
622 fx.spec.fc = fx.fc + dividend * i;
623 fx.spec.u.v.v = fx.v[i];
624 append_var_spec (&fx.spec);
629 /* Destroy a format list and, optionally, all its sublists. */
631 destroy_fmt_list (struct fmt_list * f, int recurse)
633 struct fmt_list *next;
638 if (recurse && f->f.type == FMT_DESCEND)
639 destroy_fmt_list (f->down, 1);
644 /* Recursively puts the format list F (which represents a set of
645 FORTRAN-like format specifications, like 4(F10,2X)) into the
648 dump_fmt_list (struct fmt_list * f)
652 for (; f; f = f->next)
653 if (f->f.type == FMT_X)
655 else if (f->f.type == FMT_T)
657 else if (f->f.type == FMT_NEWREC)
659 fx.recno += f->count;
661 fx.spec.type = PRT_NEWLINE;
662 for (i = 0; i < f->count; i++)
663 append_var_spec (&fx.spec);
666 for (i = 0; i < f->count; i++)
667 if (f->f.type == FMT_DESCEND)
669 if (!dump_fmt_list (f->down))
678 msg (SE, _("The number of format "
679 "specifications exceeds the number of variable "
685 if ((v->type == ALPHA) ^ (formats[f->f.type].cat & FCAT_STRING))
687 msg (SE, _("Display format %s may not be used with a "
688 "%s variable."), fmt_to_string (&f->f),
689 v->type == ALPHA ? _("string") : _("numeric"));
692 if (!check_string_specifier (&f->f, v->width))
695 fx.spec.type = PRT_VAR;
697 fx.spec.u.v.f = f->f;
698 fx.spec.fc = fx.sc - 1;
699 append_var_spec (&fx.spec);
706 /* Recursively parses a list of FORTRAN-like format specifiers. Calls
707 itself to parse nested levels of parentheses. Returns to its
708 original caller NULL, to indicate error, non-NULL, but nothing
709 useful, to indicate success (it returns a free()'d block). */
710 static struct fmt_list *
711 fixed_parse_fortran (void)
713 struct fmt_list *head = NULL;
714 struct fmt_list *fl = NULL;
716 lex_get (); /* skip opening parenthesis */
720 fl = fl->next = xmalloc (sizeof *fl);
722 head = fl = xmalloc (sizeof *fl);
726 if (!lex_integer_p ())
728 fl->count = lex_integer ();
736 fl->f.type = FMT_DESCEND;
738 fl->down = fixed_parse_fortran ();
743 else if (lex_match ('/'))
744 fl->f.type = FMT_NEWREC;
745 else if (!parse_format_specifier (&fl->f, 1)
746 || !check_output_specifier (&fl->f))
758 dump_fmt_list (head);
759 destroy_fmt_list (head, 1);
762 msg (SE, _("There aren't enough format specifications "
763 "to match the number of variable names given."));
770 destroy_fmt_list (head, 0);
775 /* Prints the table produced by the TABLE subcommand to the listing
780 struct prt_out_spec *spec;
785 for (nspec = 0, spec = prt.spec; spec; spec = spec->next)
786 if (spec->type == PRT_CONST || spec->type == PRT_VAR)
788 t = tab_create (4, nspec + 1, 0);
789 tab_columns (t, TAB_COL_DOWN, 1);
790 tab_box (t, TAL_1, TAL_1, TAL_0, TAL_1, 0, 0, 3, nspec);
791 tab_hline (t, TAL_2, 0, 3, 1);
792 tab_headers (t, 0, 0, 1, 0);
793 tab_text (t, 0, 0, TAB_CENTER | TAT_TITLE, _("Variable"));
794 tab_text (t, 1, 0, TAB_CENTER | TAT_TITLE, _("Record"));
795 tab_text (t, 2, 0, TAB_CENTER | TAT_TITLE, _("Columns"));
796 tab_text (t, 3, 0, TAB_CENTER | TAT_TITLE, _("Format"));
797 tab_dim (t, tab_natural_dimensions);
798 for (nspec = recno = 0, spec = prt.spec; spec; spec = spec->next)
806 int len = strlen (spec->u.c);
808 tab_text (t, 0, nspec, TAB_LEFT | TAT_FIX | TAT_PRINTF,
809 "\"%s\"", spec->u.c);
810 tab_text (t, 1, nspec, TAT_PRINTF, "%d", recno + 1);
811 tab_text (t, 2, nspec, TAT_PRINTF, "%3d-%3d",
812 spec->fc + 1, spec->fc + len);
813 tab_text (t, 3, nspec, TAB_LEFT | TAT_FIX | TAT_PRINTF,
820 tab_text (t, 0, nspec, TAB_LEFT, spec->u.v.v->name);
821 tab_text (t, 1, nspec, TAT_PRINTF, "%d", recno + 1);
822 tab_text (t, 2, nspec, TAT_PRINTF, "%3d-%3d",
823 spec->fc + 1, spec->fc + spec->u.v.f.w);
824 tab_text (t, 3, nspec, TAB_LEFT | TAT_FIX,
825 fmt_to_string (&spec->u.v.f));
834 if (prt.handle != NULL)
835 tab_title (t, 1, _("Writing %d record(s) to file %s."),
836 recno, handle_get_filename (prt.handle));
838 tab_title (t, 1, _("Writing %d record(s) to the listing file."), recno);
842 /* PORTME: The number of characters in a line terminator. */
844 #define LINE_END_WIDTH 2 /* \r\n */
846 #define LINE_END_WIDTH 1 /* \n */
849 /* Calculates the maximum possible line width and allocates a buffer
850 big enough to contain it */
854 /* Cumulative maximum line width (excluding null terminator) so far. */
857 /* Width required by current this prt_out_spec. */
858 int pot_w; /* Potential w. */
861 struct prt_out_spec *i;
863 for (i = prt.spec; i; i = i->next)
871 pot_w = i->fc + strlen (i->u.c);
874 pot_w = i->fc + i->u.v.f.w;
887 prt.max_width = w + LINE_END_WIDTH + 1;
888 prt.line = xmalloc (prt.max_width);
891 /* Transformation. */
893 /* Performs the transformation inside print_trns T on case C. */
895 print_trns_proc (struct trns_header * trns, struct ccase * c,
898 /* Transformation. */
899 struct print_trns *t = (struct print_trns *) trns;
902 struct prt_out_spec *i;
907 /* Length of the line in buf. */
909 memset (buf, ' ', t->max_width);
911 if (t->options & PRT_EJECT)
914 /* Note that a field written to a place where a field has already
915 been written truncates the record. `PRINT /A B (T10,F8,T1,F8).'
916 only outputs B. This is an example of bug-for-bug compatibility,
917 in the author's opinion. */
918 for (i = t->spec; i; i = i->next)
922 if (t->handle == NULL)
925 tab_output_text (TAT_FIX | TAT_NOWRAP, buf);
929 if ((t->options & PRT_CMD_MASK) == PRT_PRINT
930 || handle_get_mode (t->handle) != MODE_BINARY)
932 /* PORTME: Line ends. */
939 dfm_put_record (t->handle, buf, len);
942 memset (buf, ' ', t->max_width);
947 /* FIXME: Should be revised to keep track of the string's
948 length outside the loop, probably in i->u.c[0]. */
949 memcpy (&buf[i->fc], i->u.c, strlen (i->u.c));
950 len = i->fc + strlen (i->u.c);
954 data_out (&buf[i->fc], &i->u.v.f, case_data (c, i->u.v.v->fv));
955 len = i->fc + i->u.v.f.w;
959 /* PRT_SPACE always immediately follows PRT_VAR. */
971 /* Frees all the data inside print_trns T. Does not free T. */
973 print_trns_free (struct trns_header * t)
975 struct prt_out_spec *i, *n;
977 for (i = ((struct print_trns *) t)->spec; i; i = n)
996 free (((struct print_trns *) t)->line);
1001 /* PRINT SPACE transformation. */
1002 struct print_space_trns
1004 struct trns_header h;
1006 struct file_handle *handle; /* Output file, NULL=listing file. */
1007 struct expression *e; /* Number of lines; NULL=1. */
1011 static trns_proc_func print_space_trns_proc;
1012 static trns_free_func print_space_trns_free;
1015 cmd_print_space (void)
1017 struct print_space_trns *t;
1018 struct file_handle *handle;
1019 struct expression *e;
1021 if (lex_match_id ("OUTFILE"))
1025 handle = fh_parse_file_handle ();
1035 e = expr_parse (EXPR_NUMERIC);
1039 lex_error (_("expecting end of command"));
1046 if (handle != NULL && !dfm_open_for_writing (handle))
1052 t = xmalloc (sizeof *t);
1053 t->h.proc = print_space_trns_proc;
1055 t->h.free = print_space_trns_free;
1061 add_transformation ((struct trns_header *) t);
1066 print_space_trns_proc (struct trns_header * trns, struct ccase * c,
1067 int case_num UNUSED)
1069 struct print_space_trns *t = (struct print_space_trns *) trns;
1076 expr_evaluate (t->e, c, case_num, &v);
1080 msg (SW, _("The expression on PRINT SPACE evaluated to %d. It's "
1081 "not possible to PRINT SPACE a negative number of "
1090 if (t->handle == NULL)
1095 char buf[LINE_END_WIDTH];
1097 /* PORTME: Line ends. */
1105 dfm_put_record (t->handle, buf, LINE_END_WIDTH);
1112 print_space_trns_free (struct trns_header * trns)
1114 expr_free (((struct print_space_trns *) trns)->e);