src/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., 59 Temple Place - Suite 330, Boston, MA
  18    02111-1307, USA. */
  19
  20 #include <config.h>
  21 #include <assert.h>
  22 #include <stdlib.h>
  23 #include "alloc.h"
  24 #include "command.h"
  25 #include "dfm.h"
  26 #include "error.h"
  27 #include "expr.h"
  28 #include "file-handle.h"
  29 #include "lexer.h"
  30 #include "misc.h"
  31 #include "som.h"
  32 #include "tab.h"
  33 #include "var.h"
  34
  35 #include "debug-print.h"
  36
  37 /* Describes what to do when an output field is encountered. */
  38 enum
  39   {
  40     PRT_ERROR,                  /* Invalid value. */
  41     PRT_NEWLINE,                /* Newline. */
  42     PRT_CONST,                  /* Constant string. */
  43     PRT_VAR,                    /* Variable. */
  44     PRT_SPACE                   /* A single space. */
  45   };
  46
  47 /* Describes how to output one field. */
  48 struct prt_out_spec
  49   {
  50     struct prt_out_spec *next;
  51     int type;                   /* PRT_* constant. */
  52     int fc;                     /* 0-based first column. */
  53     union
  54       {
  55         char *c;                /* PRT_CONST: Associated string. */
  56         struct
  57           {
  58             struct variable *v; /* PRT_VAR: Associated variable. */
  59             struct fmt_spec f;  /* PRT_VAR: Output spec. */
  60           }
  61         v;
  62       }
  63     u;
  64   };
  65
  66 /* Enums for use with print_trns's `options' field. */
  67 enum
  68   {
  69     PRT_CMD_MASK = 1,           /* Command type mask. */
  70     PRT_PRINT = 0,              /* PRINT transformation identifier. */
  71     PRT_WRITE = 1,              /* WRITE transformation identifier. */
  72     PRT_EJECT = 002             /* Can be combined with CMD_PRINT only. */
  73   };
  74
  75 /* PRINT, PRINT EJECT, WRITE private data structure. */
  76 struct print_trns
  77   {
  78     struct trns_header h;
  79     struct file_handle *handle; /* Output file, NULL=listing file. */
  80     int options;                /* PRT_* bitmapped field. */
  81     struct prt_out_spec *spec;  /* Output specifications. */
  82     int max_width;              /* Maximum line width including null. */
  83     char *line;                 /* Buffer for sticking lines in. */
  84   };
  85
  86 /* PRT_PRINT or PRT_WRITE. */
  87 int which_cmd;
  88
  89 /* Holds information on parsing the data file. */
  90 static struct print_trns prt;
  91
  92 /* Last prt_out_spec in the chain.  Used for building the linked-list. */
  93 static struct prt_out_spec *next;
  94
  95 /* Number of records. */
  96 static int nrec;
  97
  98 static int internal_cmd_print (int flags);
  99 static trns_proc_func print_trns_proc;
 100 static trns_free_func print_trns_free;
 101 static int parse_specs (void);
 102 static void dump_table (void);
 103 static void append_var_spec (struct prt_out_spec *spec);
 104 static void alloc_line (void);
 105
 106 #if DEBUGGING
 107 void debug_print (void);
 108 #endif
 109 \f
 110 /* Basic parsing. */
 111
 112 /* Parses PRINT command. */
 113 int
 114 cmd_print (void)
 115 {
 116   lex_match_id ("PRINT");
 117   return internal_cmd_print (PRT_PRINT);
 118 }
 119
 120 /* Parses PRINT EJECT command. */
 121 int
 122 cmd_print_eject (void)
 123 {
 124   lex_match_id ("EJECT");
 125   return internal_cmd_print (PRT_PRINT | PRT_EJECT);
 126 }
 127
 128 /* Parses WRITE command. */
 129 int
 130 cmd_write (void)
 131 {
 132   lex_match_id ("WRITE");
 133   return internal_cmd_print (PRT_WRITE);
 134 }
 135
 136 /* Parses the output commands.  F is PRT_PRINT, PRT_WRITE, or
 137    PRT_PRINT|PRT_EJECT. */
 138 static int
 139 internal_cmd_print (int f)
 140 {
 141   /* 0=print no table, 1=print table.  (TABLE subcommand.)  */
 142   int table = 0;
 143
 144   /* malloc()'d transformation. */
 145   struct print_trns *trns;
 146
 147   /* Fill in prt to facilitate error-handling. */
 148   prt.h.proc = print_trns_proc;
 149   prt.h.free = print_trns_free;
 150   prt.handle = NULL;
 151   prt.options = f;
 152   prt.spec = NULL;
 153   prt.line = NULL;
 154   next = NULL;
 155   nrec = 0;
 156
 157   which_cmd = f & PRT_CMD_MASK;
 158
 159   /* Parse the command options. */
 160   while (!lex_match ('/'))
 161     {
 162       if (lex_match_id ("OUTFILE"))
 163         {
 164           lex_match ('=');
 165
 166           prt.handle = fh_parse_file_handle ();
 167           if (!prt.handle)
 168             goto lossage;
 169         }
 170       else if (lex_match_id ("RECORDS"))
 171         {
 172           lex_match ('=');
 173           lex_match ('(');
 174           if (!lex_force_int ())
 175             goto lossage;
 176           nrec = lex_integer ();
 177           lex_get ();
 178           lex_match (')');
 179         }
 180       else if (lex_match_id ("TABLE"))
 181         table = 1;
 182       else if (lex_match_id ("NOTABLE"))
 183         table = 0;
 184       else
 185         {
 186           lex_error (_("expecting a valid subcommand"));
 187           goto lossage;
 188         }
 189     }
 190
 191   /* Parse variables and strings. */
 192   if (!parse_specs ())
 193     goto lossage;
 194
 195   /* Output the variable table if requested. */
 196   if (table)
 197     dump_table ();
 198
 199   /* Count the maximum line width.  Allocate linebuffer if
 200      applicable. */
 201   alloc_line ();
 202
 203   /* Put the transformation in the queue. */
 204   trns = xmalloc (sizeof *trns);
 205   memcpy (trns, &prt, sizeof *trns);
 206   add_transformation ((struct trns_header *) trns);
 207
 208 #if 0 && DEBUGGING
 209   debug_print ();
 210 #endif
 211
 212   return CMD_SUCCESS;
 213
 214  lossage:
 215   print_trns_free ((struct trns_header *) & 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     int nv;                     /* number of variables in list */
 251     int 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 (token == T_NUM)
 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_value (&tokstr));
 350   lex_get ();
 351
 352   /* Parse the included column range. */
 353   if (token == T_NUM)
 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_integer_p () || 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_integer_p ())
 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 (token == T_NUM)
 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       int 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 /* Parses a column specification for parse_specs(). */
 483 static int
 484 fixed_parse_compatible (void)
 485 {
 486   int dividend;
 487   int type;
 488   int i;
 489
 490   type = fx.v[0]->type;
 491   for (i = 1; i < fx.nv; i++)
 492     if (type != fx.v[i]->type)
 493       {
 494         msg (SE, _("%s is not of the same type as %s.  To specify "
 495                    "variables of different types in the same variable "
 496                    "list, use a FORTRAN-like format specifier."),
 497              fx.v[i]->name, fx.v[0]->name);
 498         return 0;
 499       }
 500
 501   if (!lex_force_int ())
 502     return 0;
 503   fx.fc = lex_integer () - 1;
 504   if (fx.fc < 0)
 505     {
 506       msg (SE, _("Column positions for fields must be positive."));
 507       return 0;
 508     }
 509   lex_get ();
 510
 511   lex_negative_to_dash ();
 512   if (lex_match ('-'))
 513     {
 514       if (!lex_force_int ())
 515         return 0;
 516       fx.lc = lex_integer () - 1;
 517       if (fx.lc < 0)
 518         {
 519           msg (SE, _("Column positions for fields must be positive."));
 520           return 0;
 521         }
 522       else if (fx.lc < fx.fc)
 523         {
 524           msg (SE, _("The ending column for a field must not "
 525                      "be less than the starting column."));
 526           return 0;
 527         }
 528       lex_get ();
 529     }
 530   else
 531     fx.lc = fx.fc;
 532
 533   fx.spec.u.v.f.w = fx.lc - fx.fc + 1;
 534   if (lex_match ('('))
 535     {
 536       struct fmt_desc *fdp;
 537
 538       if (token == T_ID)
 539         {
 540           const char *cp;
 541
 542           fx.spec.u.v.f.type = parse_format_specifier_name (&cp, 0);
 543           if (fx.spec.u.v.f.type == -1)
 544             return 0;
 545           if (*cp)
 546             {
 547               msg (SE, _("A format specifier on this line "
 548                          "has extra characters on the end."));
 549               return 0;
 550             }
 551           lex_get ();
 552           lex_match (',');
 553         }
 554       else
 555         fx.spec.u.v.f.type = FMT_F;
 556
 557       if (token == T_NUM)
 558         {
 559           if (!lex_force_int ())
 560             return 0;
 561           if (lex_integer () < 1)
 562             {
 563               msg (SE, _("The value for number of decimal places "
 564                          "must be at least 1."));
 565               return 0;
 566             }
 567           fx.spec.u.v.f.d = lex_integer ();
 568           lex_get ();
 569         }
 570       else
 571         fx.spec.u.v.f.d = 0;
 572
 573       fdp = &formats[fx.spec.u.v.f.type];
 574       if (fdp->n_args < 2 && fx.spec.u.v.f.d)
 575         {
 576           msg (SE, _("Input format %s doesn't accept decimal places."),
 577                fdp->name);
 578           return 0;
 579         }
 580       if (fx.spec.u.v.f.d > 16)
 581         fx.spec.u.v.f.d = 16;
 582
 583       if (!lex_force_match (')'))
 584         return 0;
 585     }
 586   else
 587     {
 588       fx.spec.u.v.f.type = FMT_F;
 589       fx.spec.u.v.f.d = 0;
 590     }
 591
 592   fx.sc = fx.lc + 1;
 593
 594   if ((fx.lc - fx.fc + 1) % fx.nv)
 595     {
 596       msg (SE, _("The %d columns %d-%d can't be evenly divided into %d "
 597                  "fields."), fx.lc - fx.fc + 1, fx.fc + 1, fx.lc + 1, fx.nv);
 598       return 0;
 599     }
 600
 601   dividend = (fx.lc - fx.fc + 1) / fx.nv;
 602   fx.spec.u.v.f.w = dividend;
 603   if (!check_output_specifier (&fx.spec.u.v.f))
 604     return 0;
 605   if ((type == ALPHA) ^ (formats[fx.spec.u.v.f.type].cat & FCAT_STRING))
 606     {
 607       msg (SE, _("%s variables cannot be displayed with format %s."),
 608            type == ALPHA ? _("String") : _("Numeric"),
 609            fmt_to_string (&fx.spec.u.v.f));
 610       return 0;
 611     }
 612
 613   /* Check that, for string variables, the user didn't specify a width
 614      longer than an actual string width. */
 615   if (type == ALPHA)
 616     {
 617       /* Minimum width of all the string variables specified. */
 618       int min_len = fx.v[0]->width;
 619
 620       for (i = 1; i < fx.nv; i++)
 621         min_len = min (min_len, fx.v[i]->width);
 622       if (!check_string_specifier (&fx.spec.u.v.f, min_len))
 623         return 0;
 624     }
 625
 626   fx.spec.type = PRT_VAR;
 627   for (i = 0; i < fx.nv; i++)
 628     {
 629       fx.spec.fc = fx.fc + dividend * i;
 630       fx.spec.u.v.v = fx.v[i];
 631       append_var_spec (&fx.spec);
 632     }
 633   return 1;
 634 }
 635
 636 /* Destroy a format list and, optionally, all its sublists. */
 637 static void
 638 destroy_fmt_list (struct fmt_list * f, int recurse)
 639 {
 640   struct fmt_list *next;
 641
 642   for (; f; f = next)
 643     {
 644       next = f->next;
 645       if (recurse && f->f.type == FMT_DESCEND)
 646         destroy_fmt_list (f->down, 1);
 647       free (f);
 648     }
 649 }
 650
 651 /* Recursively puts the format list F (which represents a set of
 652    FORTRAN-like format specifications, like 4(F10,2X)) into the
 653    structure prt. */
 654 static int
 655 dump_fmt_list (struct fmt_list * f)
 656 {
 657   int i;
 658
 659   for (; f; f = f->next)
 660     if (f->f.type == FMT_X)
 661       fx.sc += f->count;
 662     else if (f->f.type == FMT_T)
 663       fx.sc = f->f.w;
 664     else if (f->f.type == FMT_NEWREC)
 665       {
 666         fx.recno += f->count;
 667         fx.sc = 1;
 668         fx.spec.type = PRT_NEWLINE;
 669         for (i = 0; i < f->count; i++)
 670           append_var_spec (&fx.spec);
 671       }
 672     else
 673       for (i = 0; i < f->count; i++)
 674         if (f->f.type == FMT_DESCEND)
 675           {
 676             if (!dump_fmt_list (f->down))
 677               return 0;
 678           }
 679         else
 680           {
 681             struct variable *v;
 682
 683             if (fx.cv >= fx.nv)
 684               {
 685                 msg (SE, _("The number of format "
 686                            "specifications exceeds the number of variable "
 687                            "names given."));
 688                 return 0;
 689               }
 690
 691             v = fx.v[fx.cv++];
 692             if ((v->type == ALPHA) ^ (formats[f->f.type].cat & FCAT_STRING))
 693               {
 694                 msg (SE, _("Display format %s may not be used with a "
 695                            "%s variable."), fmt_to_string (&f->f),
 696                      v->type == ALPHA ? _("string") : _("numeric"));
 697                 return 0;
 698               }
 699             if (!check_string_specifier (&f->f, v->width))
 700               return 0;
 701
 702             fx.spec.type = PRT_VAR;
 703             fx.spec.u.v.v = v;
 704             fx.spec.u.v.f = f->f;
 705             fx.spec.fc = fx.sc - 1;
 706             append_var_spec (&fx.spec);
 707
 708             fx.sc += f->f.w;
 709           }
 710   return 1;
 711 }
 712
 713 /* Recursively parses a list of FORTRAN-like format specifiers.  Calls
 714    itself to parse nested levels of parentheses.  Returns to its
 715    original caller NULL, to indicate error, non-NULL, but nothing
 716    useful, to indicate success (it returns a free()'d block). */
 717 static struct fmt_list *
 718 fixed_parse_fortran (void)
 719 {
 720   struct fmt_list *head = NULL;
 721   struct fmt_list *fl = NULL;
 722
 723   lex_get ();                   /* skip opening parenthesis */
 724   while (token != ')')
 725     {
 726       if (fl)
 727         fl = fl->next = xmalloc (sizeof *fl);
 728       else
 729         head = fl = xmalloc (sizeof *fl);
 730
 731       if (token == T_NUM)
 732         {
 733           if (!lex_integer_p ())
 734             goto fail;
 735           fl->count = lex_integer ();
 736           lex_get ();
 737         }
 738       else
 739         fl->count = 1;
 740
 741       if (token == '(')
 742         {
 743           fl->f.type = FMT_DESCEND;
 744           fx.level++;
 745           fl->down = fixed_parse_fortran ();
 746           fx.level--;
 747           if (!fl->down)
 748             goto fail;
 749         }
 750       else if (lex_match ('/'))
 751         fl->f.type = FMT_NEWREC;
 752       else if (!parse_format_specifier (&fl->f, 1)
 753                || !check_output_specifier (&fl->f))
 754         goto fail;
 755
 756       lex_match (',');
 757     }
 758   fl->next = NULL;
 759   lex_get ();
 760
 761   if (fx.level)
 762     return head;
 763
 764   fl->next = NULL;
 765   dump_fmt_list (head);
 766   destroy_fmt_list (head, 1);
 767   if (fx.cv < fx.nv)
 768     {
 769       msg (SE, _("There aren't enough format specifications "
 770            "to match the number of variable names given."));
 771       goto fail;
 772     }
 773   return head;
 774
 775 fail:
 776   fl->next = NULL;
 777   destroy_fmt_list (head, 0);
 778
 779   return NULL;
 780 }
 781
 782 /* Prints the table produced by the TABLE subcommand to the listing
 783    file. */
 784 static void
 785 dump_table (void)
 786 {
 787   struct prt_out_spec *spec;
 788   const char *filename;
 789   struct tab_table *t;
 790   int recno;
 791   int nspec;
 792
 793   for (nspec = 0, spec = prt.spec; spec; spec = spec->next)
 794     if (spec->type == PRT_CONST || spec->type == PRT_VAR)
 795       nspec++;
 796   t = tab_create (4, nspec + 1, 0);
 797   tab_columns (t, TAB_COL_DOWN, 1);
 798   tab_box (t, TAL_1, TAL_1, TAL_0, TAL_1, 0, 0, 3, nspec);
 799   tab_hline (t, TAL_2, 0, 3, 1);
 800   tab_headers (t, 0, 0, 1, 0);
 801   tab_text (t, 0, 0, TAB_CENTER | TAT_TITLE, _("Variable"));
 802   tab_text (t, 1, 0, TAB_CENTER | TAT_TITLE, _("Record"));
 803   tab_text (t, 2, 0, TAB_CENTER | TAT_TITLE, _("Columns"));
 804   tab_text (t, 3, 0, TAB_CENTER | TAT_TITLE, _("Format"));
 805   tab_dim (t, tab_natural_dimensions);
 806   for (nspec = recno = 0, spec = prt.spec; spec; spec = spec->next)
 807     switch (spec->type)
 808       {
 809       case PRT_NEWLINE:
 810         recno++;
 811         break;
 812       case PRT_CONST:
 813         {
 814           int len = strlen (spec->u.c);
 815           nspec++;
 816           tab_text (t, 0, nspec, TAB_LEFT | TAT_FIX | TAT_PRINTF,
 817                         "\"%s\"", spec->u.c);
 818           tab_text (t, 1, nspec, TAT_PRINTF, "%d", recno + 1);
 819           tab_text (t, 2, nspec, TAT_PRINTF, "%3d-%3d",
 820                         spec->fc + 1, spec->fc + len);
 821           tab_text (t, 3, nspec, TAB_LEFT | TAT_FIX | TAT_PRINTF,
 822                         "A%d", len);
 823           break;
 824         }
 825       case PRT_VAR:
 826         {
 827           nspec++;
 828           tab_text (t, 0, nspec, TAB_LEFT, spec->u.v.v->name);
 829           tab_text (t, 1, nspec, TAT_PRINTF, "%d", recno + 1);
 830           tab_text (t, 2, nspec, TAT_PRINTF, "%3d-%3d",
 831                         spec->fc + 1, spec->fc + spec->u.v.f.w);
 832           tab_text (t, 3, nspec, TAB_LEFT | TAT_FIX,
 833                         fmt_to_string (&spec->u.v.f));
 834           break;
 835         }
 836       case PRT_SPACE:
 837         break;
 838       case PRT_ERROR:
 839         assert (0);
 840       }
 841
 842   filename = fh_handle_name (prt.handle);
 843   tab_title (t, 1, (prt.handle != NULL
 844                     ? _("Writing %3d records to file %s.")
 845                     : _("Writing %3d records to the listing file.")),
 846              recno, filename);
 847   tab_submit (t);
 848   fh_handle_name (NULL);
 849 }
 850
 851 /* PORTME: The number of characters in a line terminator. */
 852 #ifdef __MSDOS__
 853 #define LINE_END_WIDTH 2        /* \r\n */
 854 #else
 855 #define LINE_END_WIDTH 1        /* \n */
 856 #endif
 857
 858 /* Calculates the maximum possible line width and allocates a buffer
 859    big enough to contain it */
 860 static void
 861 alloc_line (void)
 862 {
 863   /* Cumulative maximum line width (excluding null terminator) so far. */
 864   int w = 0;
 865
 866   /* Width required by current this prt_out_spec. */
 867   int pot_w;                    /* Potential w. */
 868
 869   /* Iterator. */
 870   struct prt_out_spec *i;
 871
 872   for (i = prt.spec; i; i = i->next)
 873     {
 874       switch (i->type)
 875         {
 876         case PRT_NEWLINE:
 877           pot_w = 0;
 878           break;
 879         case PRT_CONST:
 880           pot_w = i->fc + strlen (i->u.c);
 881           break;
 882         case PRT_VAR:
 883           pot_w = i->fc + i->u.v.f.w;
 884           break;
 885         case PRT_SPACE:
 886           pot_w = i->fc + 1;
 887           break;
 888         case PRT_ERROR:
 889         default:
 890           assert (0);
 891         }
 892       if (pot_w > w)
 893         w = pot_w;
 894     }
 895   prt.max_width = w + LINE_END_WIDTH + 1;
 896   prt.line = xmalloc (prt.max_width);
 897 }
 898 \f
 899 /* Transformation. */
 900
 901 /* Performs the transformation inside print_trns T on case C. */
 902 static int
 903 print_trns_proc (struct trns_header * trns, struct ccase * c,
 904                  int case_num UNUSED)
 905 {
 906   /* Transformation. */
 907   struct print_trns *t = (struct print_trns *) trns;
 908
 909   /* Iterator. */
 910   struct prt_out_spec *i;
 911
 912   /* Line buffer. */
 913   char *buf = t->line;
 914
 915   /* Length of the line in buf. */
 916   int len = 0;
 917   memset (buf, ' ', t->max_width);
 918
 919   if (t->options & PRT_EJECT)
 920     som_eject_page ();
 921
 922   /* Note that a field written to a place where a field has already
 923      been written truncates the record.  `PRINT /A B (T10,F8,T1,F8).'
 924      only outputs B.  This is an example of bug-for-bug compatibility,
 925      in the author's opinion. */
 926   for (i = t->spec; i; i = i->next)
 927     switch (i->type)
 928       {
 929       case PRT_NEWLINE:
 930         if (t->handle == NULL)
 931           {
 932             buf[len] = 0;
 933             tab_output_text (TAT_FIX | TAT_NOWRAP, buf);
 934           }
 935         else
 936           {
 937             if ((t->options & PRT_CMD_MASK) == PRT_PRINT
 938                 || t->handle->mode != FH_MD_BINARY)
 939               {
 940                 /* PORTME: Line ends. */
 941 #ifdef __MSDOS__
 942                 buf[len++] = '\r';
 943 #endif
 944                 buf[len++] = '\n';
 945               }
 946
 947             dfm_put_record (t->handle, buf, len);
 948           }
 949
 950         memset (buf, ' ', t->max_width);
 951         len = 0;
 952         break;
 953
 954       case PRT_CONST:
 955         /* FIXME: Should be revised to keep track of the string's
 956            length outside the loop, probably in i->u.c[0]. */
 957         memcpy (&buf[i->fc], i->u.c, strlen (i->u.c));
 958         len = i->fc + strlen (i->u.c);
 959         break;
 960
 961       case PRT_VAR:
 962         data_out (&buf[i->fc], &i->u.v.f, &c->data[i->u.v.v->fv]);
 963         len = i->fc + i->u.v.f.w;
 964         break;
 965
 966       case PRT_SPACE:
 967         /* PRT_SPACE always immediately follows PRT_VAR. */
 968         buf[len++] = ' ';
 969         break;
 970
 971       case PRT_ERROR:
 972         assert (0);
 973         break;
 974       }
 975
 976   return -1;
 977 }
 978
 979 /* Frees all the data inside print_trns T.  Does not free T. */
 980 static void
 981 print_trns_free (struct trns_header * t)
 982 {
 983   struct prt_out_spec *i, *n;
 984
 985   for (i = ((struct print_trns *) t)->spec; i; i = n)
 986     {
 987       switch (i->type)
 988         {
 989         case PRT_CONST:
 990           free (i->u.c);
 991           /* fall through */
 992         case PRT_NEWLINE:
 993         case PRT_VAR:
 994         case PRT_SPACE:
 995           /* nothing to do */
 996           break;
 997         case PRT_ERROR:
 998           assert (0);
 999           break;
1000         }
1001       n = i->next;
1002       free (i);
1003     }
1004   free (((struct print_trns *) t)->line);
1005 }
1006 \f
1007 /* PRINT SPACE. */
1008
1009 /* PRINT SPACE transformation. */
1010 struct print_space_trns
1011 {
1012   struct trns_header h;
1013
1014   struct file_handle *handle;   /* Output file, NULL=listing file. */
1015   struct expression *e;         /* Number of lines; NULL=1. */
1016 }
1017 print_space_trns;
1018
1019 static trns_proc_func print_space_trns_proc;
1020 static trns_free_func print_space_trns_free;
1021
1022 int
1023 cmd_print_space (void)
1024 {
1025   struct print_space_trns *t;
1026   struct file_handle *handle;
1027   struct expression *e;
1028
1029   lex_match_id ("SPACE");
1030   if (lex_match_id ("OUTFILE"))
1031     {
1032       lex_match ('=');
1033
1034       if (token == T_ID)
1035         handle = fh_get_handle_by_name (tokid);
1036       else if (token == T_STRING)
1037         handle = fh_get_handle_by_filename (tokid);
1038       else
1039         {
1040           msg (SE, _("A file name or handle was expected in the "
1041                      "OUTFILE subcommand."));
1042           return CMD_FAILURE;
1043         }
1044
1045       if (!handle)
1046         return CMD_FAILURE;
1047       lex_get ();
1048     }
1049   else
1050     handle = NULL;
1051
1052   if (token != '.')
1053     {
1054       e = expr_parse (PXP_NUMERIC);
1055       if (token != '.')
1056         {
1057           expr_free (e);
1058           lex_error (_("expecting end of command"));
1059           return CMD_FAILURE;
1060         }
1061     }
1062   else
1063     e = NULL;
1064
1065   t = xmalloc (sizeof *t);
1066   t->h.proc = print_space_trns_proc;
1067   if (e)
1068     t->h.free = print_space_trns_free;
1069   else
1070     t->h.free = NULL;
1071   t->handle = handle;
1072   t->e = e;
1073
1074   add_transformation ((struct trns_header *) t);
1075   return CMD_SUCCESS;
1076 }
1077
1078 static int
1079 print_space_trns_proc (struct trns_header * trns, struct ccase * c,
1080                        int case_num UNUSED)
1081 {
1082   struct print_space_trns *t = (struct print_space_trns *) trns;
1083   int n;
1084
1085   if (t->e)
1086     {
1087       union value v;
1088
1089       expr_evaluate (t->e, c, case_num, &v);
1090       n = v.f;
1091       if (n < 0)
1092         {
1093           msg (SW, _("The expression on PRINT SPACE evaluated to %d.  It's "
1094                      "not possible to PRINT SPACE a negative number of "
1095                      "lines."),
1096                n);
1097           n = 1;
1098         }
1099     }
1100   else
1101     n = 1;
1102
1103   if (t->handle == NULL)
1104     while (n--)
1105       som_blank_line ();
1106   else
1107     {
1108       char buf[LINE_END_WIDTH];
1109
1110       /* PORTME: Line ends. */
1111 #ifdef __MSDOS__
1112       buf[0] = '\r';
1113       buf[1] = '\n';
1114 #else
1115       buf[0] = '\n';
1116 #endif
1117       while (n--)
1118         dfm_put_record (t->handle, buf, LINE_END_WIDTH);
1119     }
1120
1121   return -1;
1122 }
1123
1124 static void
1125 print_space_trns_free (struct trns_header * trns)
1126 {
1127   expr_free (((struct print_space_trns *) trns)->e);
1128 }
1129 \f
1130 /* Debugging code. */
1131
1132 #if 0 && DEBUGGING
1133 void
1134 debug_print (void)
1135 {
1136   struct prt_out_spec *p;
1137
1138   if (prt.handle == NULL)
1139     {
1140       printf ("PRINT");
1141       if (prt.eject)
1142         printf (" EJECT");
1143     }
1144   else
1145     printf ("WRITE OUTFILE=%s", handle_name (prt.handle));
1146   printf (" MAX_WIDTH=%d", prt.max_width);
1147   printf (" /");
1148   for (p = prt.spec; p; p = p->next)
1149     switch (p->type)
1150       {
1151       case PRT_ERROR:
1152         printf (_("<ERROR>"));
1153         break;
1154       case PRT_NEWLINE:
1155         printf ("\n /");
1156         break;
1157       case PRT_CONST:
1158         printf (" \"%s\" %d-%d", p->u.c, p->fc + 1, p->fc + strlen (p->u.c));
1159         break;
1160       case PRT_VAR:
1161         printf (" %s %d %d-%d (%s)", p->u.v.v->name, p->u.v.v->fv, p->fc + 1,
1162                 p->fc + p->u.v.v->print.w, fmt_to_string (&p->u.v.v->print));
1163         break;
1164       case PRT_SPACE:
1165         printf (" \" \" %d", p->fc + 1);
1166         break;
1167       }
1168   printf (".\n");
1169 }
1170 #endif /* DEBUGGING */