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