Allow a comma between specifications on PRINT.
[pspp-builds.git] / src / language / data-io / print.c
1 /* PSPP - computes sample statistics.
2    Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
3    Written by Ben Pfaff <blp@gnu.org>.
4
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.
9
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.
14
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., 51 Franklin Street, Fifth Floor, Boston, MA
18    02110-1301, USA. */
19
20 #include <config.h>
21
22 #include <stdlib.h>
23
24 #include <data/case.h>
25 #include <data/procedure.h>
26 #include <data/transformations.h>
27 #include <data/variable.h>
28 #include <language/command.h>
29 #include <language/data-io/data-writer.h>
30 #include <language/data-io/file-handle.h>
31 #include <language/data-io/placement-parser.h>
32 #include <language/lexer/format-parser.h>
33 #include <language/lexer/lexer.h>
34 #include <language/lexer/variable-parser.h>
35 #include <libpspp/alloc.h>
36 #include <libpspp/assertion.h>
37 #include <libpspp/compiler.h>
38 #include <libpspp/ll.h>
39 #include <libpspp/message.h>
40 #include <libpspp/misc.h>
41 #include <libpspp/pool.h>
42 #include <output/manager.h>
43 #include <output/table.h>
44
45 #include "gettext.h"
46 #define _(msgid) gettext (msgid)
47
48 /* Describes what to do when an output field is encountered. */
49 enum field_type
50   {
51     PRT_LITERAL,                /* Literal string. */
52     PRT_VAR                     /* Variable. */
53   };
54
55 /* Describes how to output one field. */
56 struct prt_out_spec
57   {
58     /* All fields. */
59     struct ll ll;               /* In struct print_trns `specs' list. */
60     enum field_type type;       /* What type of field this is. */
61     int record;                 /* 1-based record number. */
62     int first_column;           /* 0-based first column. */
63
64     /* PRT_VAR only. */
65     struct variable *var;       /* Associated variable. */
66     struct fmt_spec format;     /* Output spec. */
67     bool add_space;             /* Add trailing space? */
68
69     /* PRT_LITERAL only. */
70     struct string string;       /* String to output. */
71   };
72
73 static inline struct prt_out_spec *
74 ll_to_prt_out_spec (struct ll *ll) 
75 {
76   return ll_data (ll, struct prt_out_spec, ll);
77 }
78
79 /* PRINT, PRINT EJECT, WRITE private data structure. */
80 struct print_trns
81   {
82     struct pool *pool;          /* Stores related data. */
83     bool eject;                 /* Eject page before printing? */
84     bool omit_new_lines;        /* Omit new-line characters? */
85     struct dfm_writer *writer;  /* Output file, NULL=listing file. */
86     struct ll_list specs;       /* List of struct prt_out_specs. */
87     size_t record_cnt;          /* Number of records to write. */
88     struct string line;         /* Output buffer. */
89   };
90
91 enum which_formats
92   {
93     PRINT, 
94     WRITE
95   };
96
97 static int internal_cmd_print (enum which_formats, bool eject);
98 static trns_proc_func print_trns_proc;
99 static trns_free_func print_trns_free;
100 static bool parse_specs (struct pool *tmp_pool, struct print_trns *,
101                          enum which_formats);
102 static void dump_table (struct print_trns *, const struct file_handle *);
103 \f
104 /* Basic parsing. */
105
106 /* Parses PRINT command. */
107 int
108 cmd_print (void)
109 {
110   return internal_cmd_print (PRINT, false);
111 }
112
113 /* Parses PRINT EJECT command. */
114 int
115 cmd_print_eject (void)
116 {
117   return internal_cmd_print (PRINT, true);
118 }
119
120 /* Parses WRITE command. */
121 int
122 cmd_write (void)
123 {
124   return internal_cmd_print (WRITE, false);
125 }
126
127 /* Parses the output commands. */
128 static int
129 internal_cmd_print (enum which_formats which_formats, bool eject)
130 {
131   bool print_table = 0;
132   struct print_trns *trns;
133   struct file_handle *fh = NULL;
134   struct pool *tmp_pool;
135
136   /* Fill in prt to facilitate error-handling. */
137   trns = pool_create_container (struct print_trns, pool);
138   trns->eject = eject;
139   trns->writer = NULL;
140   trns->record_cnt = 0;
141   ll_init (&trns->specs);
142   ds_init_empty (&trns->line);
143   ds_register_pool (&trns->line, trns->pool);
144
145   tmp_pool = pool_create_subpool (trns->pool);
146
147   /* Parse the command options. */
148   while (token != '/')
149     {
150       if (lex_match_id ("OUTFILE"))
151         {
152           lex_match ('=');
153
154           fh = fh_parse (FH_REF_FILE);
155           if (fh == NULL)
156             goto error;
157         }
158       else if (lex_match_id ("RECORDS"))
159         {
160           lex_match ('=');
161           lex_match ('(');
162           if (!lex_force_int ())
163             goto error;
164           trns->record_cnt = lex_integer ();
165           lex_get ();
166           lex_match (')');
167         }
168       else if (lex_match_id ("TABLE"))
169         print_table = true;
170       else if (lex_match_id ("NOTABLE"))
171         print_table = false;
172       else
173         {
174           lex_error (_("expecting a valid subcommand"));
175           goto error;
176         }
177     }
178
179   /* Parse variables and strings. */
180   if (!parse_specs (tmp_pool, trns, which_formats))
181     goto error;
182
183   if (lex_end_of_command () != CMD_SUCCESS)
184     goto error;
185
186   if (fh != NULL)
187     {
188       trns->writer = dfm_open_writer (fh);
189       if (trns->writer == NULL)
190         goto error;
191
192       trns->omit_new_lines = (which_formats == WRITE
193                               && fh_get_mode (fh) == FH_MODE_BINARY);
194     }
195
196   /* Output the variable table if requested. */
197   if (print_table)
198     dump_table (trns, fh);
199
200   /* Put the transformation in the queue. */
201   add_transformation (print_trns_proc, print_trns_free, trns);
202
203   pool_destroy (tmp_pool);
204
205   return CMD_SUCCESS;
206
207  error:
208   print_trns_free (trns);
209   return CMD_FAILURE;
210 }
211 \f
212 static bool parse_string_argument (struct print_trns *,
213                                    int record, int *column);
214 static bool parse_variable_argument (struct print_trns *,
215                                      struct pool *tmp_pool,
216                                      int *record, int *column,
217                                      enum which_formats);
218
219 /* Parses all the variable and string specifications on a single
220    PRINT, PRINT EJECT, or WRITE command into the prt structure.
221    Returns success. */
222 static bool
223 parse_specs (struct pool *tmp_pool, struct print_trns *trns,
224              enum which_formats which_formats)
225 {
226   int record = 0;
227   int column = 1;
228
229   while (token != '.')
230     {
231       bool ok;
232
233       if (!parse_record_placement (&record, &column))
234         return false;
235
236       if (token == T_STRING)
237         ok = parse_string_argument (trns, record, &column);
238       else
239         ok = parse_variable_argument (trns, tmp_pool, &record, &column,
240                                       which_formats);
241       if (!ok)
242         return 0;
243
244       lex_match (',');
245     }
246
247   if (trns->record_cnt != 0 && trns->record_cnt != record)
248     msg (SW, _("Output calls for %d records but %d specified on RECORDS "
249                "subcommand."),
250          record, trns->record_cnt);
251   trns->record_cnt = record;
252
253   return true;
254 }
255
256 /* Parses a string argument to the PRINT commands.  Returns success. */
257 static bool
258 parse_string_argument (struct print_trns *trns, int record, int *column)
259 {
260   struct prt_out_spec *spec = pool_alloc (trns->pool, sizeof *spec);
261   spec->type = PRT_LITERAL;
262   spec->record = record;
263   spec->first_column = *column;
264   ds_init_string (&spec->string, &tokstr);
265   ds_register_pool (&spec->string, trns->pool);
266   lex_get ();
267
268   /* Parse the included column range. */
269   if (lex_is_number ())
270     {
271       int first_column, last_column;
272       bool range_specified;
273
274       if (!parse_column_range (&first_column, &last_column, &range_specified)) 
275         return false; 
276
277       spec->first_column = first_column;
278       if (range_specified)
279         ds_set_length (&spec->string, last_column - first_column + 1, ' ');
280     }
281   *column = spec->first_column + ds_length (&spec->string);
282
283   ll_push_tail (&trns->specs, &spec->ll);
284   return true;
285 }
286
287 /* Parses a variable argument to the PRINT commands by passing it off
288    to fixed_parse_compatible() or fixed_parse_fortran() as appropriate.
289    Returns success. */
290 static bool
291 parse_variable_argument (struct print_trns *trns, struct pool *tmp_pool,
292                          int *record, int *column,
293                          enum which_formats which_formats)
294 {
295   struct variable **vars;
296   size_t var_cnt, var_idx;
297   struct fmt_spec *formats, *f;
298   size_t format_cnt;
299   bool add_space;
300   
301   if (!parse_variables_pool (tmp_pool,
302                              default_dict, &vars, &var_cnt, PV_DUPLICATE))
303     return false;
304
305   if (lex_is_number () || token == '(')
306     {
307       if (!parse_var_placements (tmp_pool, var_cnt, &formats, &format_cnt))
308         return false;
309       add_space = false;
310     }
311   else
312     {
313       size_t i;
314
315       lex_match ('*');
316       
317       formats = pool_nmalloc (tmp_pool, var_cnt, sizeof *formats);
318       format_cnt = var_cnt;
319       for (i = 0; i < var_cnt; i++) 
320         {
321           struct variable *v = vars[i];
322           formats[i] = which_formats == PRINT ? v->print : v->write; 
323         }
324       add_space = true;
325     }
326
327   var_idx = 0;
328   for (f = formats; f < &formats[format_cnt]; f++)
329     if (!execute_placement_format (f, record, column))
330       {
331         struct variable *var;
332         struct prt_out_spec *spec;
333
334         var = vars[var_idx++];
335         if (!check_specifier_width (f, var->width, true))
336           return false;
337
338         spec = pool_alloc (trns->pool, sizeof *spec);
339         spec->type = PRT_VAR;
340         spec->record = *record;
341         spec->first_column = *column;
342         spec->var = var;
343         spec->format = *f;
344         spec->add_space = add_space;
345         ll_push_tail (&trns->specs, &spec->ll);
346
347         *column += f->w + add_space;
348       }
349   assert (var_idx == var_cnt);
350
351   return true;
352 }
353
354 /* Prints the table produced by the TABLE subcommand to the listing
355    file. */
356 static void
357 dump_table (struct print_trns *trns, const struct file_handle *fh)
358 {
359   struct prt_out_spec *spec;
360   struct tab_table *t;
361   int spec_cnt;
362   int row;
363
364   spec_cnt = ll_count (&trns->specs);
365   t = tab_create (4, spec_cnt + 1, 0);
366   tab_columns (t, TAB_COL_DOWN, 1);
367   tab_box (t, TAL_1, TAL_1, TAL_0, TAL_1, 0, 0, 3, spec_cnt);
368   tab_hline (t, TAL_2, 0, 3, 1);
369   tab_headers (t, 0, 0, 1, 0);
370   tab_text (t, 0, 0, TAB_CENTER | TAT_TITLE, _("Variable"));
371   tab_text (t, 1, 0, TAB_CENTER | TAT_TITLE, _("Record"));
372   tab_text (t, 2, 0, TAB_CENTER | TAT_TITLE, _("Columns"));
373   tab_text (t, 3, 0, TAB_CENTER | TAT_TITLE, _("Format"));
374   tab_dim (t, tab_natural_dimensions);
375   row = 1;
376   ll_for_each (spec, struct prt_out_spec, ll, &trns->specs) 
377     {
378       int width;
379       switch (spec->type)
380         {
381         case PRT_LITERAL:
382           tab_text (t, 0, row, TAB_LEFT | TAB_FIX | TAT_PRINTF, "\"%.*s\"",
383                     (int) ds_length (&spec->string), ds_data (&spec->string));
384           width = ds_length (&spec->string);
385           break;
386         case PRT_VAR:
387           tab_text (t, 0, row, TAB_LEFT, spec->var->name);
388           tab_text (t, 3, row, TAB_LEFT | TAB_FIX,
389                     fmt_to_string (&spec->format));
390           width = spec->format.w;
391           break;
392         default:
393           NOT_REACHED ();
394         }
395       tab_text (t, 1, row, TAT_PRINTF, "%d", spec->record);
396       tab_text (t, 2, row, TAT_PRINTF, "%3d-%3d",
397                 spec->first_column, spec->first_column + width - 1);
398       row++;
399     }
400
401   if (fh != NULL)
402     tab_title (t, ngettext ("Writing %d record to %s.",
403                             "Writing %d records to %s.", trns->record_cnt),
404                trns->record_cnt, fh_get_name (fh));
405   else
406     tab_title (t, ngettext ("Writing %d record.",
407                             "Writing %d records.", trns->record_cnt),
408                trns->record_cnt);
409   tab_submit (t);
410 }
411 \f
412 /* Transformation. */
413
414 static void flush_records (struct print_trns *,
415                            int target_record, int *record);
416
417 /* Performs the transformation inside print_trns T on case C. */
418 static int
419 print_trns_proc (void *trns_, struct ccase *c, int case_num UNUSED)
420 {
421   struct print_trns *trns = trns_;
422   struct prt_out_spec *spec;
423   int record;
424
425   if (trns->eject)
426     som_eject_page ();
427
428   record = 1;
429   ds_clear (&trns->line);
430   ll_for_each (spec, struct prt_out_spec, ll, &trns->specs) 
431     {
432       flush_records (trns, spec->record, &record);
433  
434       ds_set_length (&trns->line, spec->first_column - 1, ' ');
435       if (spec->type == PRT_VAR)
436         {
437           data_out (ds_put_uninit (&trns->line, spec->format.w),
438                     &spec->format, case_data (c, spec->var->fv));
439           if (spec->add_space)
440             ds_put_char (&trns->line, ' ');
441         }
442       else 
443         ds_put_substring (&trns->line, ds_ss (&spec->string));
444     }
445   flush_records (trns, trns->record_cnt + 1, &record);
446   
447   if (trns->writer != NULL && dfm_write_error (trns->writer))
448     return TRNS_ERROR;
449   return TRNS_CONTINUE;
450 }
451
452 static void
453 flush_records (struct print_trns *trns, int target_record, int *record)
454 {
455   while (target_record > *record) 
456     {
457       if (trns->writer == NULL)
458         tab_output_text (TAB_FIX | TAT_NOWRAP, ds_cstr (&trns->line));
459       else
460         {
461           if (!trns->omit_new_lines)
462             ds_put_char (&trns->line, '\n');
463
464           dfm_put_record (trns->writer,
465                           ds_data (&trns->line), ds_length (&trns->line));
466         }
467       ds_clear (&trns->line);
468
469       (*record)++;
470     }
471 }
472
473 /* Frees TRNS. */
474 static bool
475 print_trns_free (void *trns_)
476 {
477   struct print_trns *trns = trns_;
478   bool ok = true;
479
480   if (trns->writer != NULL)
481     ok = dfm_close_writer (trns->writer);
482   pool_destroy (trns->pool);
483
484   return ok;
485 }
486