34cca99a4156c2354fbad81a61fa797a15122b88
[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 /* FIXME: seems like a lot of code duplication with data-list.c. */
21
22 #include <config.h>
23
24 #include <stdlib.h>
25
26 #include <data/case.h>
27 #include <data/procedure.h>
28 #include <data/transformations.h>
29 #include <data/variable.h>
30 #include <language/command.h>
31 #include <language/data-io/data-writer.h>
32 #include <language/data-io/file-handle.h>
33 #include <language/expressions/public.h>
34 #include <language/lexer/lexer.h>
35 #include <libpspp/alloc.h>
36 #include <libpspp/compiler.h>
37 #include <libpspp/message.h>
38 #include <libpspp/message.h>
39 #include <libpspp/misc.h>
40 #include <output/manager.h>
41 #include <output/table.h>
42
43 #include "gettext.h"
44 #define _(msgid) gettext (msgid)
45
46 /* Describes what to do when an output field is encountered. */
47 enum
48   {
49     PRT_ERROR,                  /* Invalid value. */
50     PRT_NEWLINE,                /* Newline. */
51     PRT_CONST,                  /* Constant string. */
52     PRT_VAR,                    /* Variable. */
53     PRT_SPACE                   /* A single space. */
54   };
55
56 /* Describes how to output one field. */
57 struct prt_out_spec
58   {
59     struct prt_out_spec *next;
60     int type;                   /* PRT_* constant. */
61     int fc;                     /* 0-based first column. */
62     union
63       {
64         char *c;                /* PRT_CONST: Associated string. */
65         struct
66           {
67             struct variable *v; /* PRT_VAR: Associated variable. */
68             struct fmt_spec f;  /* PRT_VAR: Output spec. */
69           }
70         v;
71       }
72     u;
73   };
74
75 /* Enums for use with print_trns's `options' field. */
76 enum
77   {
78     PRT_CMD_MASK = 1,           /* Command type mask. */
79     PRT_PRINT = 0,              /* PRINT transformation identifier. */
80     PRT_WRITE = 1,              /* WRITE transformation identifier. */
81     PRT_EJECT = 002,            /* Can be combined with CMD_PRINT only. */
82     PRT_BINARY = 004            /* File is binary, omit newlines. */
83   };
84
85 /* PRINT, PRINT EJECT, WRITE private data structure. */
86 struct print_trns
87   {
88     struct dfm_writer *writer;  /* Output file, NULL=listing file. */
89     int options;                /* PRT_* bitmapped field. */
90     struct prt_out_spec *spec;  /* Output specifications. */
91     int max_width;              /* Maximum line width including null. */
92     char *line;                 /* Buffer for sticking lines in. */
93   };
94
95 /* PRT_PRINT or PRT_WRITE. */
96 int which_cmd;
97
98 /* Holds information on parsing the data file. */
99 static struct print_trns prt;
100
101 /* Last prt_out_spec in the chain.  Used for building the linked-list. */
102 static struct prt_out_spec *next;
103
104 /* Number of records. */
105 static int nrec;
106
107 static int internal_cmd_print (int flags);
108 static trns_proc_func print_trns_proc;
109 static trns_free_func print_trns_free;
110 static int parse_specs (void);
111 static void dump_table (const struct file_handle *);
112 static void append_var_spec (struct prt_out_spec *);
113 static void alloc_line (void);
114 \f
115 /* Basic parsing. */
116
117 /* Parses PRINT command. */
118 int
119 cmd_print (void)
120 {
121   return internal_cmd_print (PRT_PRINT);
122 }
123
124 /* Parses PRINT EJECT command. */
125 int
126 cmd_print_eject (void)
127 {
128   return internal_cmd_print (PRT_PRINT | PRT_EJECT);
129 }
130
131 /* Parses WRITE command. */
132 int
133 cmd_write (void)
134 {
135   return internal_cmd_print (PRT_WRITE);
136 }
137
138 /* Parses the output commands.  F is PRT_PRINT, PRT_WRITE, or
139    PRT_PRINT|PRT_EJECT. */
140 static int
141 internal_cmd_print (int f)
142 {
143   int table = 0;                /* Print table? */
144   struct print_trns *trns = NULL; /* malloc()'d transformation. */
145   struct file_handle *fh = NULL;
146
147   /* Fill in prt to facilitate error-handling. */
148   prt.writer = NULL;
149   prt.options = f;
150   prt.spec = NULL;
151   prt.line = NULL;
152   next = NULL;
153   nrec = 0;
154
155   which_cmd = f & PRT_CMD_MASK;
156
157   /* Parse the command options. */
158   while (!lex_match ('/'))
159     {
160       if (lex_match_id ("OUTFILE"))
161         {
162           lex_match ('=');
163
164           fh = fh_parse (FH_REF_FILE);
165           if (fh == NULL)
166             goto error;
167         }
168       else if (lex_match_id ("RECORDS"))
169         {
170           lex_match ('=');
171           lex_match ('(');
172           if (!lex_force_int ())
173             goto error;
174           nrec = lex_integer ();
175           lex_get ();
176           lex_match (')');
177         }
178       else if (lex_match_id ("TABLE"))
179         table = 1;
180       else if (lex_match_id ("NOTABLE"))
181         table = 0;
182       else
183         {
184           lex_error (_("expecting a valid subcommand"));
185           goto error;
186         }
187     }
188
189   /* Parse variables and strings. */
190   if (!parse_specs ())
191     goto error;
192
193   if (fh != NULL)
194     {
195       prt.writer = dfm_open_writer (fh);
196       if (prt.writer == NULL)
197         goto error;
198
199       if (fh_get_mode (fh) == FH_MODE_BINARY)
200         prt.options |= PRT_BINARY;
201     }
202
203   /* Output the variable table if requested. */
204   if (table)
205     dump_table (fh);
206
207   /* Count the maximum line width.  Allocate linebuffer if
208      applicable. */
209   alloc_line ();
210
211   /* Put the transformation in the queue. */
212   trns = xmalloc (sizeof *trns);
213   memcpy (trns, &prt, sizeof *trns);
214   add_transformation (print_trns_proc, print_trns_free, trns);
215
216   return CMD_SUCCESS;
217
218  error:
219   print_trns_free (&prt);
220   return CMD_FAILURE;
221 }
222
223 /* Appends the field output specification SPEC to the list maintained
224    in prt. */
225 static void
226 append_var_spec (struct prt_out_spec *spec)
227 {
228   if (next == 0)
229     prt.spec = next = xmalloc (sizeof *spec);
230   else
231     next = next->next = xmalloc (sizeof *spec);
232
233   memcpy (next, spec, sizeof *spec);
234   next->next = NULL;
235 }
236 \f
237 /* Field parsing.  Mostly stolen from data-list.c. */
238
239 /* Used for chaining together fortran-like format specifiers. */
240 struct fmt_list
241 {
242   struct fmt_list *next;
243   int count;
244   struct fmt_spec f;
245   struct fmt_list *down;
246 };
247
248 /* Used as "local" variables among the fixed-format parsing funcs.  If
249    it were guaranteed that PSPP were going to be compiled by gcc,
250    I'd make all these functions a single set of nested functions. */
251 static struct
252   {
253     struct variable **v;                /* variable list */
254     size_t nv;                  /* number of variables in list */
255     size_t cv;                  /* number of variables from list used up so far
256                                    by the FORTRAN-like format specifiers */
257
258     int recno;                  /* current 1-based record number */
259     int sc;                     /* 1-based starting column for next variable */
260
261     struct prt_out_spec spec;           /* next format spec to append to list */
262     int fc, lc;                 /* first, last 1-based column number of current
263                                    var */
264
265     int level;                  /* recursion level for FORTRAN-like format
266                                    specifiers */
267   }
268 fx;
269
270 static int fixed_parse_compatible (void);
271 static struct fmt_list *fixed_parse_fortran (void);
272
273 static int parse_string_argument (void);
274 static int parse_variable_argument (void);
275
276 /* Parses all the variable and string specifications on a single
277    PRINT, PRINT EJECT, or WRITE command into the prt structure.
278    Returns success. */
279 static int
280 parse_specs (void)
281 {
282   /* Return code from called function. */
283   int code;
284
285   fx.recno = 1;
286   fx.sc = 1;
287
288   while (token != '.')
289     {
290       while (lex_match ('/'))
291         {
292           int prev_recno = fx.recno;
293
294           fx.recno++;
295           if (lex_is_number ())
296             {
297               if (!lex_force_int ())
298                 return 0;
299               if (lex_integer () < fx.recno)
300                 {
301                   msg (SE, _("The record number specified, %ld, is "
302                              "before the previous record, %d.  Data "
303                              "fields must be listed in order of "
304                              "increasing record number."),
305                        lex_integer (), fx.recno - 1);
306                   return 0;
307                 }
308               fx.recno = lex_integer ();
309               lex_get ();
310             }
311
312           fx.spec.type = PRT_NEWLINE;
313           while (prev_recno++ < fx.recno)
314             append_var_spec (&fx.spec);
315
316           fx.sc = 1;
317         }
318
319       if (token == T_STRING)
320         code = parse_string_argument ();
321       else
322         code = parse_variable_argument ();
323       if (!code)
324         return 0;
325     }
326   fx.spec.type = PRT_NEWLINE;
327   append_var_spec (&fx.spec);
328
329   if (!nrec)
330     nrec = fx.recno;
331   else if (fx.recno > nrec)
332     {
333       msg (SE, _("Variables are specified on records that "
334                  "should not exist according to RECORDS subcommand."));
335       return 0;
336     }
337       
338   if (token != '.')
339     {
340       lex_error (_("expecting end of command"));
341       return 0;
342     }
343   
344   return 1;
345 }
346
347 /* Parses a string argument to the PRINT commands.  Returns success. */
348 static int
349 parse_string_argument (void)
350 {
351   fx.spec.type = PRT_CONST;
352   fx.spec.fc = fx.sc - 1;
353   fx.spec.u.c = ds_xstrdup (&tokstr);
354   lex_get ();
355
356   /* Parse the included column range. */
357   if (lex_is_number ())
358     {
359       /* Width of column range in characters. */
360       int c_len;
361
362       /* Width of constant string in characters. */
363       int s_len;
364
365       /* 1-based index of last column in range. */
366       int lc;
367
368       if (!lex_is_integer () || lex_integer () <= 0)
369         {
370           msg (SE, _("%g is not a valid column location."), tokval);
371           goto fail;
372         }
373       fx.spec.fc = lex_integer () - 1;
374
375       lex_get ();
376       lex_negative_to_dash ();
377       if (lex_match ('-'))
378         {
379           if (!lex_is_integer ())
380             {
381               msg (SE, _("Column location expected following `%d-'."),
382                    fx.spec.fc + 1);
383               goto fail;
384             }
385           if (lex_integer () <= 0)
386             {
387               msg (SE, _("%g is not a valid column location."), tokval);
388               goto fail;
389             }
390           if (lex_integer () < fx.spec.fc + 1)
391             {
392               msg (SE, _("%d-%ld is not a valid column range.  The second "
393                    "column must be greater than or equal to the first."),
394                    fx.spec.fc + 1, lex_integer ());
395               goto fail;
396             }
397           lc = lex_integer () - 1;
398
399           lex_get ();
400         }
401       else
402         /* If only a starting location is specified then the field is
403            the width of the provided string. */
404         lc = fx.spec.fc + strlen (fx.spec.u.c) - 1;
405
406       /* Apply the range. */
407       c_len = lc - fx.spec.fc + 1;
408       s_len = strlen (fx.spec.u.c);
409       if (s_len > c_len)
410         fx.spec.u.c[c_len] = 0;
411       else if (s_len < c_len)
412         {
413           fx.spec.u.c = xrealloc (fx.spec.u.c, c_len + 1);
414           memset (&fx.spec.u.c[s_len], ' ', c_len - s_len);
415           fx.spec.u.c[c_len] = 0;
416         }
417
418       fx.sc = lc + 1;
419     }
420   else
421     /* If nothing is provided then the field is the width of the
422        provided string. */
423     fx.sc += strlen (fx.spec.u.c);
424
425   append_var_spec (&fx.spec);
426   return 1;
427
428 fail:
429   free (fx.spec.u.c);
430   return 0;
431 }
432
433 /* Parses a variable argument to the PRINT commands by passing it off
434    to fixed_parse_compatible() or fixed_parse_fortran() as appropriate.
435    Returns success. */
436 static int
437 parse_variable_argument (void)
438 {
439   if (!parse_variables (default_dict, &fx.v, &fx.nv, PV_DUPLICATE))
440     return 0;
441
442   if (lex_is_number ())
443     {
444       if (!fixed_parse_compatible ())
445         goto fail;
446     }
447   else if (token == '(')
448     {
449       fx.level = 0;
450       fx.cv = 0;
451       if (!fixed_parse_fortran ())
452         goto fail;
453     }
454   else
455     {
456       /* User wants dictionary format specifiers. */
457       size_t i;
458
459       lex_match ('*');
460       for (i = 0; i < fx.nv; i++)
461         {
462           /* Variable. */
463           fx.spec.type = PRT_VAR;
464           fx.spec.fc = fx.sc - 1;
465           fx.spec.u.v.v = fx.v[i];
466           fx.spec.u.v.f = fx.v[i]->print;
467           append_var_spec (&fx.spec);
468           fx.sc += fx.v[i]->print.w;
469
470           /* Space. */
471           fx.spec.type = PRT_SPACE;
472           fx.spec.fc = fx.sc - 1;
473           append_var_spec (&fx.spec);
474           fx.sc++;
475         }
476     }
477
478   free (fx.v);
479   return 1;
480
481 fail:
482   free (fx.v);
483   return 0;
484 }
485
486 /* Verifies that FORMAT doesn't need a variable wider than WIDTH.
487    Returns true iff that is the case. */
488 static bool
489 check_string_width (const struct fmt_spec *format, const struct variable *v) 
490 {
491   if (get_format_var_width (format) > v->width)
492     {
493       msg (SE, _("Variable %s has width %d so it cannot be output "
494                  "as format %s."),
495            v->name, v->width, fmt_to_string (format));
496       return false;
497     }
498   return true;
499 }
500
501 /* Parses a column specification for parse_specs(). */
502 static int
503 fixed_parse_compatible (void)
504 {
505   int individual_var_width;
506   int type;
507   size_t i;
508
509   type = fx.v[0]->type;
510   for (i = 1; i < fx.nv; i++)
511     if (type != fx.v[i]->type)
512       {
513         msg (SE, _("%s is not of the same type as %s.  To specify "
514                    "variables of different types in the same variable "
515                    "list, use a FORTRAN-like format specifier."),
516              fx.v[i]->name, fx.v[0]->name);
517         return 0;
518       }
519
520   if (!lex_force_int ())
521     return 0;
522   fx.fc = lex_integer () - 1;
523   if (fx.fc < 0)
524     {
525       msg (SE, _("Column positions for fields must be positive."));
526       return 0;
527     }
528   lex_get ();
529
530   lex_negative_to_dash ();
531   if (lex_match ('-'))
532     {
533       if (!lex_force_int ())
534         return 0;
535       fx.lc = lex_integer () - 1;
536       if (fx.lc < 0)
537         {
538           msg (SE, _("Column positions for fields must be positive."));
539           return 0;
540         }
541       else if (fx.lc < fx.fc)
542         {
543           msg (SE, _("The ending column for a field must not "
544                      "be less than the starting column."));
545           return 0;
546         }
547       lex_get ();
548     }
549   else
550     fx.lc = fx.fc;
551
552   fx.spec.u.v.f.w = fx.lc - fx.fc + 1;
553   if (lex_match ('('))
554     {
555       struct fmt_desc *fdp;
556
557       if (token == T_ID)
558         {
559           const char *cp;
560
561           fx.spec.u.v.f.type = parse_format_specifier_name (&cp, 0);
562           if (fx.spec.u.v.f.type == -1)
563             return 0;
564           if (*cp)
565             {
566               msg (SE, _("A format specifier on this line "
567                          "has extra characters on the end."));
568               return 0;
569             }
570           lex_get ();
571           lex_match (',');
572         }
573       else
574         fx.spec.u.v.f.type = FMT_F;
575
576       if (lex_is_number ())
577         {
578           if (!lex_force_int ())
579             return 0;
580           if (lex_integer () < 1)
581             {
582               msg (SE, _("The value for number of decimal places "
583                          "must be at least 1."));
584               return 0;
585             }
586           fx.spec.u.v.f.d = lex_integer ();
587           lex_get ();
588         }
589       else
590         fx.spec.u.v.f.d = 0;
591
592       fdp = &formats[fx.spec.u.v.f.type];
593       if (fdp->n_args < 2 && fx.spec.u.v.f.d)
594         {
595           msg (SE, _("Input format %s doesn't accept decimal places."),
596                fdp->name);
597           return 0;
598         }
599       if (fx.spec.u.v.f.d > 16)
600         fx.spec.u.v.f.d = 16;
601
602       if (!lex_force_match (')'))
603         return 0;
604     }
605   else
606     {
607       fx.spec.u.v.f.type = FMT_F;
608       fx.spec.u.v.f.d = 0;
609     }
610
611   fx.sc = fx.lc + 1;
612
613   if ((fx.lc - fx.fc + 1) % fx.nv)
614     {
615       msg (SE, _("The %d columns %d-%d can't be evenly divided into %u "
616                  "fields."),
617            fx.lc - fx.fc + 1, fx.fc + 1, fx.lc + 1, (unsigned) fx.nv);
618       return 0;
619     }
620
621   individual_var_width = (fx.lc - fx.fc + 1) / fx.nv;
622   fx.spec.u.v.f.w = individual_var_width;
623   if (!check_output_specifier (&fx.spec.u.v.f, true)
624       || !check_specifier_type (&fx.spec.u.v.f, type, true))
625     return 0;
626   if (type == ALPHA)
627     {
628       for (i = 0; i < fx.nv; i++)
629         if (!check_string_width (&fx.spec.u.v.f, fx.v[i]))
630           return false;
631     }
632
633   fx.spec.type = PRT_VAR;
634   for (i = 0; i < fx.nv; i++)
635     {
636       fx.spec.fc = fx.fc + individual_var_width * i;
637       fx.spec.u.v.v = fx.v[i];
638       append_var_spec (&fx.spec);
639     }
640   return 1;
641 }
642
643 /* Destroy a format list and, optionally, all its sublists. */
644 static void
645 destroy_fmt_list (struct fmt_list *f, int recurse)
646 {
647   struct fmt_list *next;
648
649   for (; f; f = next)
650     {
651       next = f->next;
652       if (recurse && f->f.type == FMT_DESCEND)
653         destroy_fmt_list (f->down, 1);
654       free (f);
655     }
656 }
657
658 /* Recursively puts the format list F (which represents a set of
659    FORTRAN-like format specifications, like 4(F10,2X)) into the
660    structure prt. */
661 static int
662 dump_fmt_list (struct fmt_list *f)
663 {
664   int i;
665
666   for (; f; f = f->next)
667     if (f->f.type == FMT_X)
668       fx.sc += f->count;
669     else if (f->f.type == FMT_T)
670       fx.sc = f->f.w;
671     else if (f->f.type == FMT_NEWREC)
672       {
673         fx.recno += f->count;
674         fx.sc = 1;
675         fx.spec.type = PRT_NEWLINE;
676         for (i = 0; i < f->count; i++)
677           append_var_spec (&fx.spec);
678       }
679     else
680       for (i = 0; i < f->count; i++)
681         if (f->f.type == FMT_DESCEND)
682           {
683             if (!dump_fmt_list (f->down))
684               return 0;
685           }
686         else
687           {
688             struct variable *v;
689
690             if (fx.cv >= fx.nv)
691               {
692                 msg (SE, _("The number of format "
693                            "specifications exceeds the number of variable "
694                            "names given."));
695                 return 0;
696               }
697
698             v = fx.v[fx.cv++];
699             if (!check_output_specifier (&f->f, true)
700                 || !check_specifier_type (&f->f, v->type, true)
701                 || !check_string_width (&f->f, v))
702               return false;
703
704             fx.spec.type = PRT_VAR;
705             fx.spec.u.v.v = v;
706             fx.spec.u.v.f = f->f;
707             fx.spec.fc = fx.sc - 1;
708             append_var_spec (&fx.spec);
709
710             fx.sc += f->f.w;
711           }
712   return 1;
713 }
714
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)
721 {
722   struct fmt_list *head = NULL;
723   struct fmt_list *fl = NULL;
724
725   lex_get ();                   /* skip opening parenthesis */
726   while (token != ')')
727     {
728       if (fl)
729         fl = fl->next = xmalloc (sizeof *fl);
730       else
731         head = fl = xmalloc (sizeof *fl);
732
733       if (lex_is_number ())
734         {
735           if (!lex_is_integer ())
736             goto fail;
737           fl->count = lex_integer ();
738           lex_get ();
739         }
740       else
741         fl->count = 1;
742
743       if (token == '(')
744         {
745           fl->f.type = FMT_DESCEND;
746           fx.level++;
747           fl->down = fixed_parse_fortran ();
748           fx.level--;
749           if (!fl->down)
750             goto fail;
751         }
752       else if (lex_match ('/'))
753         fl->f.type = FMT_NEWREC;
754       else if (!parse_format_specifier (&fl->f, FMTP_ALLOW_XT)
755                || !check_output_specifier (&fl->f, 1))
756         goto fail;
757
758       lex_match (',');
759     }
760   fl->next = NULL;
761   lex_get ();
762
763   if (fx.level)
764     return head;
765
766   fl->next = NULL;
767   dump_fmt_list (head);
768   destroy_fmt_list (head, 1);
769   if (fx.cv < fx.nv)
770     {
771       msg (SE, _("There aren't enough format specifications "
772            "to match the number of variable names given."));
773       goto fail;
774     }
775   return head;
776
777 fail:
778   fl->next = NULL;
779   destroy_fmt_list (head, 0);
780
781   return NULL;
782 }
783
784 /* Prints the table produced by the TABLE subcommand to the listing
785    file. */
786 static void
787 dump_table (const struct file_handle *fh)
788 {
789   struct prt_out_spec *spec;
790   struct tab_table *t;
791   int recno;
792   int nspec;
793
794   for (nspec = 0, spec = prt.spec; spec; spec = spec->next)
795     if (spec->type == PRT_CONST || spec->type == PRT_VAR)
796       nspec++;
797   t = tab_create (4, nspec + 1, 0);
798   tab_columns (t, TAB_COL_DOWN, 1);
799   tab_box (t, TAL_1, TAL_1, TAL_0, TAL_1, 0, 0, 3, nspec);
800   tab_hline (t, TAL_2, 0, 3, 1);
801   tab_headers (t, 0, 0, 1, 0);
802   tab_text (t, 0, 0, TAB_CENTER | TAT_TITLE, _("Variable"));
803   tab_text (t, 1, 0, TAB_CENTER | TAT_TITLE, _("Record"));
804   tab_text (t, 2, 0, TAB_CENTER | TAT_TITLE, _("Columns"));
805   tab_text (t, 3, 0, TAB_CENTER | TAT_TITLE, _("Format"));
806   tab_dim (t, tab_natural_dimensions);
807   for (nspec = recno = 0, spec = prt.spec; spec; spec = spec->next)
808     switch (spec->type)
809       {
810       case PRT_NEWLINE:
811         recno++;
812         break;
813       case PRT_CONST:
814         {
815           int len = strlen (spec->u.c);
816           nspec++;
817           tab_text (t, 0, nspec, TAB_LEFT | TAB_FIX | TAT_PRINTF,
818                         "\"%s\"", spec->u.c);
819           tab_text (t, 1, nspec, TAT_PRINTF, "%d", recno + 1);
820           tab_text (t, 2, nspec, TAT_PRINTF, "%3d-%3d",
821                         spec->fc + 1, spec->fc + len);
822           tab_text (t, 3, nspec, TAB_LEFT | TAB_FIX | TAT_PRINTF,
823                         "A%d", len);
824           break;
825         }
826       case PRT_VAR:
827         {
828           nspec++;
829           tab_text (t, 0, nspec, TAB_LEFT, spec->u.v.v->name);
830           tab_text (t, 1, nspec, TAT_PRINTF, "%d", recno + 1);
831           tab_text (t, 2, nspec, TAT_PRINTF, "%3d-%3d",
832                         spec->fc + 1, spec->fc + spec->u.v.f.w);
833           tab_text (t, 3, nspec, TAB_LEFT | TAB_FIX,
834                         fmt_to_string (&spec->u.v.f));
835           break;
836         }
837       case PRT_SPACE:
838         break;
839       case PRT_ERROR:
840         assert (0);
841       }
842
843   if (fh != NULL)
844     tab_title (t, ngettext ("Writing %d record to %s.",
845                             "Writing %d records to %s.", recno),
846                recno, fh_get_name (fh));
847   else
848     tab_title (t, ngettext ("Writing %d record.",
849                             "Writing %d records.", recno), recno);
850   tab_submit (t);
851 }
852
853 /* Calculates the maximum possible line width and allocates a buffer
854    big enough to contain it */
855 static void
856 alloc_line (void)
857 {
858   /* Cumulative maximum line width (excluding null terminator) so far. */
859   int w = 0;
860
861   /* Width required by current this prt_out_spec. */
862   int pot_w;                    /* Potential w. */
863
864   /* Iterator. */
865   struct prt_out_spec *i;
866
867   for (i = prt.spec; i; i = i->next)
868     {
869       switch (i->type)
870         {
871         case PRT_NEWLINE:
872           pot_w = 0;
873           break;
874         case PRT_CONST:
875           pot_w = i->fc + strlen (i->u.c);
876           break;
877         case PRT_VAR:
878           pot_w = i->fc + i->u.v.f.w;
879           break;
880         case PRT_SPACE:
881           pot_w = i->fc + 1;
882           break;
883         case PRT_ERROR:
884         default:
885           assert (0);
886           abort ();
887         }
888       if (pot_w > w)
889         w = pot_w;
890     }
891   prt.max_width = w + 2;
892   prt.line = xmalloc (prt.max_width);
893 }
894 \f
895 /* Transformation. */
896
897 /* Performs the transformation inside print_trns T on case C. */
898 static int
899 print_trns_proc (void *trns_, struct ccase *c, int case_num UNUSED)
900 {
901   /* Transformation. */
902   struct print_trns *t = trns_;
903
904   /* Iterator. */
905   struct prt_out_spec *i;
906
907   /* Line buffer. */
908   char *buf = t->line;
909
910   /* Length of the line in buf. */
911   int len = 0;
912   memset (buf, ' ', t->max_width);
913
914   if (t->options & PRT_EJECT)
915     som_eject_page ();
916
917   /* Note that a field written to a place where a field has
918      already been written truncates the record.  `PRINT /A B
919      (T10,F8,T1,F8).' only outputs B.  */
920   for (i = t->spec; i; i = i->next)
921     switch (i->type)
922       {
923       case PRT_NEWLINE:
924         if (t->writer == NULL)
925           {
926             buf[len] = 0;
927             tab_output_text (TAB_FIX | TAT_NOWRAP, buf);
928           }
929         else
930           {
931             if ((t->options & PRT_CMD_MASK) == PRT_PRINT
932                 || !(t->options & PRT_BINARY))
933               buf[len++] = '\n';
934
935             dfm_put_record (t->writer, buf, len);
936           }
937
938         memset (buf, ' ', t->max_width);
939         len = 0;
940         break;
941
942       case PRT_CONST:
943         /* FIXME: Should be revised to keep track of the string's
944            length outside the loop, probably in i->u.c[0]. */
945         memcpy (&buf[i->fc], i->u.c, strlen (i->u.c));
946         len = i->fc + strlen (i->u.c);
947         break;
948
949       case PRT_VAR:
950         data_out (&buf[i->fc], &i->u.v.f, case_data (c, i->u.v.v->fv));
951         len = i->fc + i->u.v.f.w;
952         break;
953
954       case PRT_SPACE:
955         /* PRT_SPACE always immediately follows PRT_VAR. */
956         buf[len++] = ' ';
957         break;
958
959       case PRT_ERROR:
960         assert (0);
961         break;
962       }
963
964   if (t->writer != NULL && dfm_write_error (t->writer))
965     return TRNS_ERROR;
966   return TRNS_CONTINUE;
967 }
968
969 /* Frees all the data inside print_trns PRT.  Does not free PRT. */
970 static bool
971 print_trns_free (void *prt_)
972 {
973   struct print_trns *prt = prt_;
974   struct prt_out_spec *i, *n;
975   bool ok = true;
976
977   for (i = prt->spec; i; i = n)
978     {
979       switch (i->type)
980         {
981         case PRT_CONST:
982           free (i->u.c);
983           /* fall through */
984         case PRT_NEWLINE:
985         case PRT_VAR:
986         case PRT_SPACE:
987           /* nothing to do */
988           break;
989         case PRT_ERROR:
990           assert (0);
991           break;
992         }
993       n = i->next;
994       free (i);
995     }
996   if (prt->writer != NULL)
997     ok = dfm_close_writer (prt->writer);
998   free (prt->line);
999   return ok;
1000 }
1001 \f
1002 /* PRINT SPACE. */
1003
1004 /* PRINT SPACE transformation. */
1005 struct print_space_trns
1006 {
1007   struct dfm_writer *writer;    /* Output data file. */
1008   struct expression *e;         /* Number of lines; NULL=1. */
1009 }
1010 print_space_trns;
1011
1012 static trns_proc_func print_space_trns_proc;
1013 static trns_free_func print_space_trns_free;
1014
1015 int
1016 cmd_print_space (void)
1017 {
1018   struct print_space_trns *t;
1019   struct file_handle *fh;
1020   struct expression *e;
1021   struct dfm_writer *writer;
1022
1023   if (lex_match_id ("OUTFILE"))
1024     {
1025       lex_match ('=');
1026
1027       fh = fh_parse (FH_REF_FILE);
1028       if (fh == NULL)
1029         return CMD_FAILURE;
1030       lex_get ();
1031     }
1032   else
1033     fh = NULL;
1034
1035   if (token != '.')
1036     {
1037       e = expr_parse (default_dict, EXPR_NUMBER);
1038       if (token != '.')
1039         {
1040           expr_free (e);
1041           lex_error (_("expecting end of command"));
1042           return CMD_FAILURE;
1043         }
1044     }
1045   else
1046     e = NULL;
1047
1048   if (fh != NULL)
1049     {
1050       writer = dfm_open_writer (fh);
1051       if (writer == NULL) 
1052         {
1053           expr_free (e);
1054           return CMD_FAILURE;
1055         } 
1056     }
1057   else
1058     writer = NULL;
1059   
1060   t = xmalloc (sizeof *t);
1061   t->writer = writer;
1062   t->e = e;
1063
1064   add_transformation (print_space_trns_proc, print_space_trns_free, t);
1065   return CMD_SUCCESS;
1066 }
1067
1068 /* Executes a PRINT SPACE transformation. */
1069 static int
1070 print_space_trns_proc (void *t_, struct ccase *c,
1071                        int case_num UNUSED)
1072 {
1073   struct print_space_trns *t = t_;
1074   int n;
1075
1076   n = 1;
1077   if (t->e)
1078     {
1079       double f = expr_evaluate_num (t->e, c, case_num);
1080       if (f == SYSMIS) 
1081         msg (SW, _("The expression on PRINT SPACE evaluated to the "
1082                    "system-missing value."));
1083       else if (f < 0 || f > INT_MAX)
1084         msg (SW, _("The expression on PRINT SPACE evaluated to %g."), f);
1085       else
1086         n = f;
1087     }
1088
1089   while (n--)
1090     if (t->writer == NULL)
1091       som_blank_line ();
1092     else
1093       dfm_put_record (t->writer, "\n", 1);
1094
1095   if (t->writer != NULL && dfm_write_error (t->writer))
1096     return TRNS_ERROR;
1097   return TRNS_CONTINUE;
1098 }
1099
1100 /* Frees a PRINT SPACE transformation.
1101    Returns true if successful, false if an I/O error occurred. */
1102 static bool
1103 print_space_trns_free (void *trns_)
1104 {
1105   struct print_space_trns *trns = trns_;
1106   bool ok = dfm_close_writer (trns->writer);
1107   expr_free (trns->e);
1108   free (trns);
1109   return ok;
1110 }