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