src/data-list.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 "data-list.h"
  22 #include "error.h"
  23 #include <ctype.h>
  24 #include <float.h>
  25 #include <stdio.h>
  26 #include <stdlib.h>
  27 #include "alloc.h"
  28 #include "case.h"
  29 #include "command.h"
  30 #include "data-in.h"
  31 #include "debug-print.h"
  32 #include "dfm-read.h"
  33 #include "dictionary.h"
  34 #include "error.h"
  35 #include "file-handle.h"
  36 #include "format.h"
  37 #include "lexer.h"
  38 #include "misc.h"
  39 #include "settings.h"
  40 #include "str.h"
  41 #include "tab.h"
  42 #include "var.h"
  43 #include "vfm.h"
  44 \f
  45 /* Utility function. */
  46
  47 /* FIXME: Either REPEATING DATA must be the last transformation, or we
  48    must multiplex the transformations that follow (i.e., perform them
  49    for every case that we produce from a repetition instance).
  50    Currently we do neither.  We should do one or the other. */
  51
  52 /* Describes how to parse one variable. */
  53 struct dls_var_spec
  54   {
  55     struct dls_var_spec *next;  /* Next specification in list. */
  56
  57     /* Both free and fixed formats. */
  58     struct fmt_spec input;      /* Input format of this field. */
  59     struct variable *v;         /* Associated variable.  Used only in
  60                                    parsing.  Not safe later. */
  61     int fv;                     /* First value in case. */
  62
  63     /* Fixed format only. */
  64     int rec;                    /* Record number (1-based). */
  65     int fc, lc;                 /* Column numbers in record. */
  66
  67     /* Free format only. */
  68     char name[SHORT_NAME_LEN + 1];              /* Name of variable. */
  69   };
  70
  71 /* Constants for DATA LIST type. */
  72 /* Must match table in cmd_data_list(). */
  73 enum
  74   {
  75     DLS_FIXED,
  76     DLS_FREE,
  77     DLS_LIST
  78   };
  79
  80 /* DATA LIST private data structure. */
  81 struct data_list_pgm
  82   {
  83     struct trns_header h;
  84
  85     struct dls_var_spec *first, *last;  /* Variable parsing specifications. */
  86     struct dfm_reader *reader;  /* Data file reader. */
  87
  88     int type;                   /* A DLS_* constant. */
  89     struct variable *end;       /* Variable specified on END subcommand. */
  90     int eof;                    /* End of file encountered. */
  91     int rec_cnt;                /* Number of records. */
  92     size_t case_size;           /* Case size in bytes. */
  93     char *delims;               /* Delimiters if any; not null-terminated. */
  94     size_t delim_cnt;           /* Number of delimiter, or 0 for spaces. */
  95   };
  96
  97 static int parse_fixed (struct data_list_pgm *);
  98 static int parse_free (struct dls_var_spec **, struct dls_var_spec **);
  99 static void dump_fixed_table (const struct dls_var_spec *,
 100                               const struct file_handle *, int rec_cnt);
 101 static void dump_free_table (const struct data_list_pgm *,
 102                              const struct file_handle *);
 103 static void destroy_dls_var_spec (struct dls_var_spec *);
 104 static trns_free_func data_list_trns_free;
 105 static trns_proc_func data_list_trns_proc;
 106
 107 /* Message title for REPEATING DATA. */
 108 #define RPD_ERR "REPEATING DATA: "
 109
 110 int
 111 cmd_data_list (void)
 112 {
 113   struct data_list_pgm *dls;     /* DATA LIST program under construction. */
 114   int table = -1;                /* Print table if nonzero, -1=undecided. */
 115   struct file_handle *fh = NULL; /* File handle of source, NULL=inline file. */
 116
 117   if (!case_source_is_complex (vfm_source))
 118     discard_variables ();
 119
 120   dls = xmalloc (sizeof *dls);
 121   dls->reader = NULL;
 122   dls->type = -1;
 123   dls->end = NULL;
 124   dls->eof = 0;
 125   dls->rec_cnt = 0;
 126   dls->delims = NULL;
 127   dls->delim_cnt = 0;
 128   dls->first = dls->last = NULL;
 129
 130   while (token != '/')
 131     {
 132       if (lex_match_id ("FILE"))
 133         {
 134           lex_match ('=');
 135           fh = fh_parse ();
 136           if (fh == NULL)
 137             goto error;
 138           if (case_source_is_class (vfm_source, &file_type_source_class)
 139               && fh != default_handle)
 140             {
 141               msg (SE, _("DATA LIST may not use a different file from "
 142                          "that specified on its surrounding FILE TYPE."));
 143               goto error;
 144             }
 145         }
 146       else if (lex_match_id ("RECORDS"))
 147         {
 148           lex_match ('=');
 149           lex_match ('(');
 150           if (!lex_force_int ())
 151             goto error;
 152           dls->rec_cnt = lex_integer ();
 153           lex_get ();
 154           lex_match (')');
 155         }
 156       else if (lex_match_id ("END"))
 157         {
 158           if (dls->end)
 159             {
 160               msg (SE, _("The END subcommand may only be specified once."));
 161               goto error;
 162             }
 163
 164           lex_match ('=');
 165           if (!lex_force_id ())
 166             goto error;
 167           dls->end = dict_lookup_var (default_dict, tokid);
 168           if (!dls->end)
 169             dls->end = dict_create_var_assert (default_dict, tokid, 0);
 170           lex_get ();
 171         }
 172       else if (token == T_ID)
 173         {
 174           if (lex_match_id ("NOTABLE"))
 175             table = 0;
 176           else if (lex_match_id ("TABLE"))
 177             table = 1;
 178           else
 179             {
 180               int type;
 181               if (lex_match_id ("FIXED"))
 182                 type = DLS_FIXED;
 183               else if (lex_match_id ("FREE"))
 184                 type = DLS_FREE;
 185               else if (lex_match_id ("LIST"))
 186                 type = DLS_LIST;
 187               else
 188                 {
 189                   lex_error (NULL);
 190                   goto error;
 191                 }
 192
 193               if (dls->type != -1)
 194                 {
 195                   msg (SE, _("Only one of FIXED, FREE, or LIST may "
 196                              "be specified."));
 197                   goto error;
 198                 }
 199               dls->type = type;
 200
 201               if ((dls->type == DLS_FREE || dls->type == DLS_LIST)
 202                   && lex_match ('('))
 203                 {
 204                   while (!lex_match (')'))
 205                     {
 206                       int delim;
 207
 208                       if (lex_match_id ("TAB"))
 209                         delim = '\t';
 210                       else if (token == T_STRING && tokstr.length == 1)
 211                         {
 212                           delim = tokstr.string[0];
 213                           lex_get();
 214                         }
 215                       else
 216                         {
 217                           lex_error (NULL);
 218                           goto error;
 219                         }
 220
 221                       dls->delims = xrealloc (dls->delims, dls->delim_cnt + 1);
 222                       dls->delims[dls->delim_cnt++] = delim;
 223
 224                       lex_match (',');
 225                     }
 226                 }
 227             }
 228         }
 229       else
 230         {
 231           lex_error (NULL);
 232           goto error;
 233         }
 234     }
 235
 236   dls->case_size = dict_get_case_size (default_dict);
 237   default_handle = fh;
 238
 239   if (dls->type == -1)
 240     dls->type = DLS_FIXED;
 241
 242   if (table == -1)
 243     {
 244       if (dls->type == DLS_FREE)
 245         table = 0;
 246       else
 247         table = 1;
 248     }
 249
 250   if (dls->type == DLS_FIXED)
 251     {
 252       if (!parse_fixed (dls))
 253         goto error;
 254       if (table)
 255         dump_fixed_table (dls->first, fh, dls->rec_cnt);
 256     }
 257   else
 258     {
 259       if (!parse_free (&dls->first, &dls->last))
 260         goto error;
 261       if (table)
 262         dump_free_table (dls, fh);
 263     }
 264
 265   dls->reader = dfm_open_reader (fh);
 266   if (dls->reader == NULL)
 267     goto error;
 268
 269   if (vfm_source != NULL)
 270     {
 271       struct data_list_pgm *new_pgm;
 272
 273       dls->h.proc = data_list_trns_proc;
 274       dls->h.free = data_list_trns_free;
 275
 276       new_pgm = xmalloc (sizeof *new_pgm);
 277       memcpy (new_pgm, &dls, sizeof *new_pgm);
 278       add_transformation (&new_pgm->h);
 279     }
 280   else
 281     vfm_source = create_case_source (&data_list_source_class, dls);
 282
 283   return CMD_SUCCESS;
 284
 285  error:
 286   destroy_dls_var_spec (dls->first);
 287   free (dls->delims);
 288   free (dls);
 289   return CMD_FAILURE;
 290 }
 291
 292 /* Adds SPEC to the linked list with head at FIRST and tail at
 293    LAST. */
 294 static void
 295 append_var_spec (struct dls_var_spec **first, struct dls_var_spec **last,
 296                  struct dls_var_spec *spec)
 297 {
 298   spec->next = NULL;
 299
 300   if (*first == NULL)
 301     *first = spec;
 302   else
 303     (*last)->next = spec;
 304   *last = spec;
 305 }
 306 \f
 307 /* Fixed-format parsing. */
 308
 309 /* Used for chaining together fortran-like format specifiers. */
 310 struct fmt_list
 311   {
 312     struct fmt_list *next;
 313     int count;
 314     struct fmt_spec f;
 315     struct fmt_list *down;
 316   };
 317
 318 /* State of parsing DATA LIST. */
 319 struct fixed_parsing_state
 320   {
 321     char **name;                /* Variable names. */
 322     int name_cnt;               /* Number of names. */
 323
 324     int recno;                  /* Index of current record. */
 325     int sc;                     /* 1-based column number of starting column for
 326                                    next field to output. */
 327   };
 328
 329 static int fixed_parse_compatible (struct fixed_parsing_state *,
 330                                    struct dls_var_spec **,
 331                                    struct dls_var_spec **);
 332 static int fixed_parse_fortran (struct fixed_parsing_state *,
 333                                 struct dls_var_spec **,
 334                                 struct dls_var_spec **);
 335
 336 /* Parses all the variable specifications for DATA LIST FIXED,
 337    storing them into DLS.  Returns nonzero if successful. */
 338 static int
 339 parse_fixed (struct data_list_pgm *dls)
 340 {
 341   struct fixed_parsing_state fx;
 342   int i;
 343
 344   fx.recno = 0;
 345   fx.sc = 1;
 346
 347   while (token != '.')
 348     {
 349       while (lex_match ('/'))
 350         {
 351           fx.recno++;
 352           if (lex_is_integer ())
 353             {
 354               if (lex_integer () < fx.recno)
 355                 {
 356                   msg (SE, _("The record number specified, %ld, is "
 357                              "before the previous record, %d.  Data "
 358                              "fields must be listed in order of "
 359                              "increasing record number."),
 360                        lex_integer (), fx.recno - 1);
 361                   return 0;
 362                 }
 363
 364               fx.recno = lex_integer ();
 365               lex_get ();
 366             }
 367           fx.sc = 1;
 368         }
 369
 370       if (!parse_DATA_LIST_vars (&fx.name, &fx.name_cnt, PV_NONE))
 371         return 0;
 372
 373       if (lex_is_number ())
 374         {
 375           if (!fixed_parse_compatible (&fx, &dls->first, &dls->last))
 376             goto fail;
 377         }
 378       else if (token == '(')
 379         {
 380           if (!fixed_parse_fortran (&fx, &dls->first, &dls->last))
 381             goto fail;
 382         }
 383       else
 384         {
 385           msg (SE, _("SPSS-like or FORTRAN-like format "
 386                "specification expected after variable names."));
 387           goto fail;
 388         }
 389
 390       for (i = 0; i < fx.name_cnt; i++)
 391         free (fx.name[i]);
 392       free (fx.name);
 393     }
 394   if (dls->first == NULL)
 395     {
 396       msg (SE, _("At least one variable must be specified."));
 397       return 0;
 398     }
 399   if (dls->rec_cnt && dls->last->rec > dls->rec_cnt)
 400     {
 401       msg (SE, _("Variables are specified on records that "
 402                  "should not exist according to RECORDS subcommand."));
 403       return 0;
 404     }
 405   else if (!dls->rec_cnt)
 406     dls->rec_cnt = dls->last->rec;
 407   if (token != '.')
 408     {
 409       lex_error (_("expecting end of command"));
 410       return 0;
 411     }
 412   return 1;
 413
 414 fail:
 415   for (i = 0; i < fx.name_cnt; i++)
 416     free (fx.name[i]);
 417   free (fx.name);
 418   return 0;
 419 }
 420
 421 /* Parses a variable specification in the form 1-10 (A) based on
 422    FX and adds specifications to the linked list with head at
 423    FIRST and tail at LAST. */
 424 static int
 425 fixed_parse_compatible (struct fixed_parsing_state *fx,
 426                         struct dls_var_spec **first, struct dls_var_spec **last)
 427 {
 428   struct fmt_spec input;
 429   int fc, lc;
 430   int width;
 431   int i;
 432
 433   /* First column. */
 434   if (!lex_force_int ())
 435     return 0;
 436   fc = lex_integer ();
 437   if (fc < 1)
 438     {
 439       msg (SE, _("Column positions for fields must be positive."));
 440       return 0;
 441     }
 442   lex_get ();
 443
 444   /* Last column. */
 445   lex_negative_to_dash ();
 446   if (lex_match ('-'))
 447     {
 448       if (!lex_force_int ())
 449         return 0;
 450       lc = lex_integer ();
 451       if (lc < 1)
 452         {
 453           msg (SE, _("Column positions for fields must be positive."));
 454           return 0;
 455         }
 456       else if (lc < fc)
 457         {
 458           msg (SE, _("The ending column for a field must be "
 459                      "greater than the starting column."));
 460           return 0;
 461         }
 462
 463       lex_get ();
 464     }
 465   else
 466     lc = fc;
 467
 468   /* Divide columns evenly. */
 469   input.w = (lc - fc + 1) / fx->name_cnt;
 470   if ((lc - fc + 1) % fx->name_cnt)
 471     {
 472       msg (SE, _("The %d columns %d-%d "
 473                  "can't be evenly divided into %d fields."),
 474            lc - fc + 1, fc, lc, fx->name_cnt);
 475       return 0;
 476     }
 477
 478   /* Format specifier. */
 479   if (lex_match ('('))
 480     {
 481       struct fmt_desc *fdp;
 482
 483       if (token == T_ID)
 484         {
 485           const char *cp;
 486
 487           input.type = parse_format_specifier_name (&cp, 0);
 488           if (input.type == -1)
 489             return 0;
 490           if (*cp)
 491             {
 492               msg (SE, _("A format specifier on this line "
 493                          "has extra characters on the end."));
 494               return 0;
 495             }
 496
 497           lex_get ();
 498           lex_match (',');
 499         }
 500       else
 501         input.type = FMT_F;
 502
 503       if (lex_is_integer ())
 504         {
 505           if (lex_integer () < 1)
 506             {
 507               msg (SE, _("The value for number of decimal places "
 508                          "must be at least 1."));
 509               return 0;
 510             }
 511
 512           input.d = lex_integer ();
 513           lex_get ();
 514         }
 515       else
 516         input.d = 0;
 517
 518       fdp = &formats[input.type];
 519       if (fdp->n_args < 2 && input.d)
 520         {
 521           msg (SE, _("Input format %s doesn't accept decimal places."),
 522                fdp->name);
 523           return 0;
 524         }
 525
 526       if (input.d > 16)
 527         input.d = 16;
 528
 529       if (!lex_force_match (')'))
 530         return 0;
 531     }
 532   else
 533     {
 534       input.type = FMT_F;
 535       input.d = 0;
 536     }
 537   if (!check_input_specifier (&input, 1))
 538     return 0;
 539
 540   /* Start column for next specification. */
 541   fx->sc = lc + 1;
 542
 543   /* Width of variables to create. */
 544   if (input.type == FMT_A || input.type == FMT_AHEX)
 545     width = input.w;
 546   else
 547     width = 0;
 548
 549   /* Create variables and var specs. */
 550   for (i = 0; i < fx->name_cnt; i++)
 551     {
 552       struct dls_var_spec *spec;
 553       struct variable *v;
 554
 555       v = dict_create_var (default_dict, fx->name[i], width);
 556       if (v != NULL)
 557         {
 558           convert_fmt_ItoO (&input, &v->print);
 559           v->write = v->print;
 560           if (!case_source_is_complex (vfm_source))
 561             v->init = 0;
 562         }
 563       else
 564         {
 565           v = dict_lookup_var_assert (default_dict, fx->name[i]);
 566           if (vfm_source == NULL)
 567             {
 568               msg (SE, _("%s is a duplicate variable name."), fx->name[i]);
 569               return 0;
 570             }
 571           if ((width != 0) != (v->width != 0))
 572             {
 573               msg (SE, _("There is already a variable %s of a "
 574                          "different type."),
 575                    fx->name[i]);
 576               return 0;
 577             }
 578           if (width != 0 && width != v->width)
 579             {
 580               msg (SE, _("There is already a string variable %s of a "
 581                          "different width."), fx->name[i]);
 582               return 0;
 583             }
 584         }
 585
 586       spec = xmalloc (sizeof *spec);
 587       spec->input = input;
 588       spec->v = v;
 589       spec->fv = v->fv;
 590       spec->rec = fx->recno;
 591       spec->fc = fc + input.w * i;
 592       spec->lc = spec->fc + input.w - 1;
 593       append_var_spec (first, last, spec);
 594     }
 595   return 1;
 596 }
 597
 598 /* Destroy format list F and, if RECURSE is nonzero, all its
 599    sublists. */
 600 static void
 601 destroy_fmt_list (struct fmt_list *f, int recurse)
 602 {
 603   struct fmt_list *next;
 604
 605   for (; f; f = next)
 606     {
 607       next = f->next;
 608       if (recurse && f->f.type == FMT_DESCEND)
 609         destroy_fmt_list (f->down, 1);
 610       free (f);
 611     }
 612 }
 613
 614 /* Takes a hierarchically structured fmt_list F as constructed by
 615    fixed_parse_fortran(), and flattens it, adding the variable
 616    specifications to the linked list with head FIRST and tail
 617    LAST.  NAME_IDX is used to take values from the list of names
 618    in FX; it should initially point to a value of 0. */
 619 static int
 620 dump_fmt_list (struct fixed_parsing_state *fx, struct fmt_list *f,
 621                struct dls_var_spec **first, struct dls_var_spec **last,
 622                int *name_idx)
 623 {
 624   int i;
 625
 626   for (; f; f = f->next)
 627     if (f->f.type == FMT_X)
 628       fx->sc += f->count;
 629     else if (f->f.type == FMT_T)
 630       fx->sc = f->f.w;
 631     else if (f->f.type == FMT_NEWREC)
 632       {
 633         fx->recno += f->count;
 634         fx->sc = 1;
 635       }
 636     else
 637       for (i = 0; i < f->count; i++)
 638         if (f->f.type == FMT_DESCEND)
 639           {
 640             if (!dump_fmt_list (fx, f->down, first, last, name_idx))
 641               return 0;
 642           }
 643         else
 644           {
 645             struct dls_var_spec *spec;
 646             int width;
 647             struct variable *v;
 648
 649             if (formats[f->f.type].cat & FCAT_STRING)
 650               width = f->f.w;
 651             else
 652               width = 0;
 653             if (*name_idx >= fx->name_cnt)
 654               {
 655                 msg (SE, _("The number of format "
 656                            "specifications exceeds the given number of "
 657                            "variable names."));
 658                 return 0;
 659               }
 660
 661             v = dict_create_var (default_dict, fx->name[(*name_idx)++], width);
 662             if (!v)
 663               {
 664                 msg (SE, _("%s is a duplicate variable name."), fx->name[i]);
 665                 return 0;
 666               }
 667
 668             if (!case_source_is_complex (vfm_source))
 669               v->init = 0;
 670
 671             spec = xmalloc (sizeof *spec);
 672             spec->v = v;
 673             spec->input = f->f;
 674             spec->fv = v->fv;
 675             spec->rec = fx->recno;
 676             spec->fc = fx->sc;
 677             spec->lc = fx->sc + f->f.w - 1;
 678             append_var_spec (first, last, spec);
 679
 680             convert_fmt_ItoO (&spec->input, &v->print);
 681             v->write = v->print;
 682
 683             fx->sc += f->f.w;
 684           }
 685   return 1;
 686 }
 687
 688 /* Recursively parses a FORTRAN-like format specification into
 689    the linked list with head FIRST and tail TAIL.  LEVEL is the
 690    level of recursion, starting from 0.  Returns the parsed
 691    specification if successful, or a null pointer on failure.  */
 692 static struct fmt_list *
 693 fixed_parse_fortran_internal (struct fixed_parsing_state *fx,
 694                               struct dls_var_spec **first,
 695                               struct dls_var_spec **last)
 696 {
 697   struct fmt_list *head = NULL;
 698   struct fmt_list *tail = NULL;
 699
 700   lex_force_match ('(');
 701   while (token != ')')
 702     {
 703       /* New fmt_list. */
 704       struct fmt_list *new = xmalloc (sizeof *new);
 705       new->next = NULL;
 706
 707       /* Append new to list. */
 708       if (head != NULL)
 709         tail->next = new;
 710       else
 711         head = new;
 712       tail = new;
 713
 714       /* Parse count. */
 715       if (lex_is_integer ())
 716         {
 717           new->count = lex_integer ();
 718           lex_get ();
 719         }
 720       else
 721         new->count = 1;
 722
 723       /* Parse format specifier. */
 724       if (token == '(')
 725         {
 726           new->f.type = FMT_DESCEND;
 727           new->down = fixed_parse_fortran_internal (fx, first, last);
 728           if (new->down == NULL)
 729             goto fail;
 730         }
 731       else if (lex_match ('/'))
 732         new->f.type = FMT_NEWREC;
 733       else if (!parse_format_specifier (&new->f, FMTP_ALLOW_XT)
 734                || !check_input_specifier (&new->f, 1))
 735         goto fail;
 736
 737       lex_match (',');
 738     }
 739   lex_force_match (')');
 740
 741   return head;
 742
 743 fail:
 744   destroy_fmt_list (head, 0);
 745
 746   return NULL;
 747 }
 748
 749 /* Parses a FORTRAN-like format specification into the linked
 750    list with head FIRST and tail LAST.  Returns nonzero if
 751    successful. */
 752 static int
 753 fixed_parse_fortran (struct fixed_parsing_state *fx,
 754                      struct dls_var_spec **first, struct dls_var_spec **last)
 755 {
 756   struct fmt_list *list;
 757   int name_idx;
 758
 759   list = fixed_parse_fortran_internal (fx, first, last);
 760   if (list == NULL)
 761     return 0;
 762
 763   name_idx = 0;
 764   dump_fmt_list (fx, list, first, last, &name_idx);
 765   destroy_fmt_list (list, 1);
 766   if (name_idx < fx->name_cnt)
 767     {
 768       msg (SE, _("There aren't enough format specifications "
 769                  "to match the number of variable names given."));
 770       return 0;
 771     }
 772
 773   return 1;
 774 }
 775
 776 /* Displays a table giving information on fixed-format variable
 777    parsing on DATA LIST. */
 778 /* FIXME: The `Columns' column should be divided into three columns,
 779    one for the starting column, one for the dash, one for the ending
 780    column; then right-justify the starting column and left-justify the
 781    ending column. */
 782 static void
 783 dump_fixed_table (const struct dls_var_spec *specs,
 784                   const struct file_handle *fh, int rec_cnt)
 785 {
 786   const struct dls_var_spec *spec;
 787   struct tab_table *t;
 788   int i;
 789
 790   for (i = 0, spec = specs; spec; spec = spec->next)
 791     i++;
 792   t = tab_create (4, i + 1, 0);
 793   tab_columns (t, TAB_COL_DOWN, 1);
 794   tab_headers (t, 0, 0, 1, 0);
 795   tab_text (t, 0, 0, TAB_CENTER | TAT_TITLE, _("Variable"));
 796   tab_text (t, 1, 0, TAB_CENTER | TAT_TITLE, _("Record"));
 797   tab_text (t, 2, 0, TAB_CENTER | TAT_TITLE, _("Columns"));
 798   tab_text (t, 3, 0, TAB_CENTER | TAT_TITLE, _("Format"));
 799   tab_box (t, TAL_1, TAL_1, TAL_0, TAL_1, 0, 0, 3, i);
 800   tab_hline (t, TAL_2, 0, 3, 1);
 801   tab_dim (t, tab_natural_dimensions);
 802
 803   for (i = 1, spec = specs; spec; spec = spec->next, i++)
 804     {
 805       tab_text (t, 0, i, TAB_LEFT, spec->v->name);
 806       tab_text (t, 1, i, TAT_PRINTF, "%d", spec->rec);
 807       tab_text (t, 2, i, TAT_PRINTF, "%3d-%3d",
 808                     spec->fc, spec->lc);
 809       tab_text (t, 3, i, TAB_LEFT | TAT_FIX,
 810                     fmt_to_string (&spec->input));
 811     }
 812
 813   if (fh != NULL)
 814     tab_title (t, 1, ngettext ("Reading %d record from file %s.",
 815                                "Reading %d records from file %s.", rec_cnt),
 816                rec_cnt, handle_get_filename (fh));
 817   else
 818     tab_title (t, 1, ngettext ("Reading %d record from the command file.",
 819                                "Reading %d records from the command file.",
 820                                rec_cnt),
 821                rec_cnt);
 822   tab_submit (t);
 823 }
 824 \f
 825 /* Free-format parsing. */
 826
 827 /* Parses variable specifications for DATA LIST FREE and adds
 828    them to the linked list with head FIRST and tail LAST.
 829    Returns nonzero only if successful. */
 830 static int
 831 parse_free (struct dls_var_spec **first, struct dls_var_spec **last)
 832 {
 833   lex_get ();
 834   while (token != '.')
 835     {
 836       struct fmt_spec input, output;
 837       char **name;
 838       int name_cnt;
 839       int width;
 840       int i;
 841
 842       if (!parse_DATA_LIST_vars (&name, &name_cnt, PV_NONE))
 843         return 0;
 844
 845       if (lex_match ('('))
 846         {
 847           if (!parse_format_specifier (&input, 0)
 848               || !check_input_specifier (&input, 1)
 849               || !lex_force_match (')'))
 850             {
 851               for (i = 0; i < name_cnt; i++)
 852                 free (name[i]);
 853               free (name);
 854               return 0;
 855             }
 856           convert_fmt_ItoO (&input, &output);
 857         }
 858       else
 859         {
 860           lex_match ('*');
 861           input.type = FMT_F;
 862           input.w = 8;
 863           input.d = 0;
 864           output = get_format();
 865         }
 866
 867       if (input.type == FMT_A || input.type == FMT_AHEX)
 868         width = input.w;
 869       else
 870         width = 0;
 871       for (i = 0; i < name_cnt; i++)
 872         {
 873           struct dls_var_spec *spec;
 874           struct variable *v;
 875
 876           v = dict_create_var (default_dict, name[i], width);
 877
 878           if (!v)
 879             {
 880               msg (SE, _("%s is a duplicate variable name."), name[i]);
 881               return 0;
 882             }
 883           v->print = v->write = output;
 884
 885           if (!case_source_is_complex (vfm_source))
 886             v->init = 0;
 887
 888           spec = xmalloc (sizeof *spec);
 889           spec->input = input;
 890           spec->v = v;
 891           spec->fv = v->fv;
 892           strcpy (spec->name, v->name);
 893           append_var_spec (first, last, spec);
 894         }
 895       for (i = 0; i < name_cnt; i++)
 896         free (name[i]);
 897       free (name);
 898     }
 899
 900   if (token != '.')
 901     lex_error (_("expecting end of command"));
 902   return 1;
 903 }
 904
 905 /* Displays a table giving information on free-format variable parsing
 906    on DATA LIST. */
 907 static void
 908 dump_free_table (const struct data_list_pgm *dls,
 909                  const struct file_handle *fh)
 910 {
 911   struct tab_table *t;
 912   int i;
 913
 914   {
 915     struct dls_var_spec *spec;
 916     for (i = 0, spec = dls->first; spec; spec = spec->next)
 917       i++;
 918   }
 919
 920   t = tab_create (2, i + 1, 0);
 921   tab_columns (t, TAB_COL_DOWN, 1);
 922   tab_headers (t, 0, 0, 1, 0);
 923   tab_text (t, 0, 0, TAB_CENTER | TAT_TITLE, _("Variable"));
 924   tab_text (t, 1, 0, TAB_CENTER | TAT_TITLE, _("Format"));
 925   tab_box (t, TAL_1, TAL_1, TAL_0, TAL_1, 0, 0, 1, i);
 926   tab_hline (t, TAL_2, 0, 1, 1);
 927   tab_dim (t, tab_natural_dimensions);
 928
 929   {
 930     struct dls_var_spec *spec;
 931
 932     for (i = 1, spec = dls->first; spec; spec = spec->next, i++)
 933       {
 934         tab_text (t, 0, i, TAB_LEFT, spec->v->name);
 935         tab_text (t, 1, i, TAB_LEFT | TAT_FIX, fmt_to_string (&spec->input));
 936       }
 937   }
 938
 939   if (fh != NULL)
 940     tab_title (t, 1, _("Reading free-form data from file %s."),
 941                handle_get_filename (fh));
 942   else
 943     tab_title (t, 1, _("Reading free-form data from the command file."));
 944
 945   tab_submit (t);
 946 }
 947 \f
 948 /* Input procedure. */
 949
 950 /* Extracts a field from the current position in the current
 951    record.  Fields can be unquoted or quoted with single- or
 952    double-quote characters.  *FIELD is set to the field content.
 953    After parsing the field, sets the current position in the
 954    record to just past the field and any trailing delimiter.
 955    END_BLANK is used internally; it should be initialized by the
 956    caller to 0 and left alone afterward.  Returns 0 on failure or
 957    a 1-based column number indicating the beginning of the field
 958    on success. */
 959 static int
 960 cut_field (const struct data_list_pgm *dls, struct fixed_string *field,
 961            int *end_blank)
 962 {
 963   struct fixed_string line;
 964   char *cp;
 965   size_t column_start;
 966
 967   if (dfm_eof (dls->reader))
 968     return 0;
 969   if (dls->delim_cnt == 0)
 970     dfm_expand_tabs (dls->reader);
 971   dfm_get_record (dls->reader, &line);
 972
 973   cp = ls_c_str (&line);
 974   if (dls->delim_cnt == 0)
 975     {
 976       /* Skip leading whitespace. */
 977       while (cp < ls_end (&line) && isspace ((unsigned char) *cp))
 978         cp++;
 979       if (cp >= ls_end (&line))
 980         return 0;
 981
 982       /* Handle actual data, whether quoted or unquoted. */
 983       if (*cp == '\'' || *cp == '"')
 984         {
 985           int quote = *cp;
 986
 987           field->string = ++cp;
 988           while (cp < ls_end (&line) && *cp != quote)
 989             cp++;
 990           field->length = cp - field->string;
 991           if (cp < ls_end (&line))
 992             cp++;
 993           else
 994             msg (SW, _("Quoted string missing terminating `%c'."), quote);
 995         }
 996       else
 997         {
 998           field->string = cp;
 999           while (cp < ls_end (&line)
1000                  && !isspace ((unsigned char) *cp) && *cp != ',')
1001             cp++;
1002           field->length = cp - field->string;
1003         }
1004
1005       /* Skip trailing whitespace and a single comma if present. */
1006       while (cp < ls_end (&line) && isspace ((unsigned char) *cp))
1007         cp++;
1008       if (cp < ls_end (&line) && *cp == ',')
1009         cp++;
1010     }
1011   else
1012     {
1013       if (cp >= ls_end (&line))
1014         {
1015           int column = dfm_column_start (dls->reader);
1016                /* A blank line or a line that ends in \t has a
1017              trailing blank field. */
1018           if (column == 1 || (column > 1 && cp[-1] == '\t'))
1019             {
1020               if (*end_blank == 0)
1021                 {
1022                   *end_blank = 1;
1023                   field->string = ls_end (&line);
1024                   field->length = 0;
1025                   dfm_forward_record (dls->reader);
1026                   return column;
1027                 }
1028               else
1029                 {
1030                   *end_blank = 0;
1031                   return 0;
1032                 }
1033             }
1034           else
1035             return 0;
1036         }
1037       else
1038         {
1039           field->string = cp;
1040           while (cp < ls_end (&line)
1041                  && memchr (dls->delims, *cp, dls->delim_cnt) == NULL)
1042             cp++;
1043           field->length = cp - field->string;
1044           if (cp < ls_end (&line))
1045             cp++;
1046         }
1047     }
1048
1049   dfm_forward_columns (dls->reader, field->string - line.string);
1050   column_start = dfm_column_start (dls->reader);
1051
1052   dfm_forward_columns (dls->reader, cp - field->string);
1053
1054   return column_start;
1055 }
1056
1057 typedef int data_list_read_func (const struct data_list_pgm *, struct ccase *);
1058 static data_list_read_func read_from_data_list_fixed;
1059 static data_list_read_func read_from_data_list_free;
1060 static data_list_read_func read_from_data_list_list;
1061
1062 /* Returns the proper function to read the kind of DATA LIST
1063    data specified by DLS. */
1064 static data_list_read_func *
1065 get_data_list_read_func (const struct data_list_pgm *dls)
1066 {
1067   switch (dls->type)
1068     {
1069     case DLS_FIXED:
1070       return read_from_data_list_fixed;
1071
1072     case DLS_FREE:
1073       return read_from_data_list_free;
1074
1075     case DLS_LIST:
1076       return read_from_data_list_list;
1077
1078     default:
1079       assert (0);
1080       abort ();
1081     }
1082 }
1083
1084 /* Reads a case from the data file into C, parsing it according
1085    to fixed-format syntax rules in DLS.  Returns -1 on success,
1086    -2 at end of file. */
1087 static int
1088 read_from_data_list_fixed (const struct data_list_pgm *dls,
1089                            struct ccase *c)
1090 {
1091   struct dls_var_spec *var_spec = dls->first;
1092   int i;
1093
1094   if (dfm_eof (dls->reader))
1095     return -2;
1096   for (i = 1; i <= dls->rec_cnt; i++)
1097     {
1098       struct fixed_string line;
1099
1100       if (dfm_eof (dls->reader))
1101         {
1102           /* Note that this can't occur on the first record. */
1103           msg (SW, _("Partial case of %d of %d records discarded."),
1104                i - 1, dls->rec_cnt);
1105           return -2;
1106         }
1107       dfm_expand_tabs (dls->reader);
1108       dfm_get_record (dls->reader, &line);
1109
1110       for (; var_spec && i == var_spec->rec; var_spec = var_spec->next)
1111         {
1112           struct data_in di;
1113
1114           data_in_finite_line (&di, ls_c_str (&line), ls_length (&line),
1115                                var_spec->fc, var_spec->lc);
1116           di.v = case_data_rw (c, var_spec->fv);
1117           di.flags = DI_IMPLIED_DECIMALS;
1118           di.f1 = var_spec->fc;
1119           di.format = var_spec->input;
1120
1121           data_in (&di);
1122         }
1123
1124       dfm_forward_record (dls->reader);
1125     }
1126
1127   return -1;
1128 }
1129
1130 /* Reads a case from the data file into C, parsing it according
1131    to free-format syntax rules in DLS.  Returns -1 on success,
1132    -2 at end of file. */
1133 static int
1134 read_from_data_list_free (const struct data_list_pgm *dls,
1135                           struct ccase *c)
1136 {
1137   struct dls_var_spec *var_spec;
1138   int end_blank = 0;
1139
1140   for (var_spec = dls->first; var_spec; var_spec = var_spec->next)
1141     {
1142       struct fixed_string field;
1143       int column;
1144
1145       /* Cut out a field and read in a new record if necessary. */
1146       for (;;)
1147         {
1148           column = cut_field (dls, &field, &end_blank);
1149           if (column != 0)
1150             break;
1151
1152           if (!dfm_eof (dls->reader))
1153             dfm_forward_record (dls->reader);
1154           if (dfm_eof (dls->reader))
1155             {
1156               if (var_spec != dls->first)
1157                 msg (SW, _("Partial case discarded.  The first variable "
1158                            "missing was %s."), var_spec->name);
1159               return -2;
1160             }
1161         }
1162
1163       {
1164         struct data_in di;
1165
1166         di.s = ls_c_str (&field);
1167         di.e = ls_end (&field);
1168         di.v = case_data_rw (c, var_spec->fv);
1169         di.flags = 0;
1170         di.f1 = column;
1171         di.format = var_spec->input;
1172         data_in (&di);
1173       }
1174     }
1175   return -1;
1176 }
1177
1178 /* Reads a case from the data file and parses it according to
1179    list-format syntax rules.  Returns -1 on success, -2 at end of
1180    file. */
1181 static int
1182 read_from_data_list_list (const struct data_list_pgm *dls,
1183                           struct ccase *c)
1184 {
1185   struct dls_var_spec *var_spec;
1186   int end_blank = 0;
1187
1188   if (dfm_eof (dls->reader))
1189     return -2;
1190
1191   for (var_spec = dls->first; var_spec; var_spec = var_spec->next)
1192     {
1193       struct fixed_string field;
1194       int column;
1195
1196       /* Cut out a field and check for end-of-line. */
1197       column = cut_field (dls, &field, &end_blank);
1198       if (column == 0)
1199         {
1200           if (get_undefined ())
1201             msg (SW, _("Missing value(s) for all variables from %s onward.  "
1202                        "These will be filled with the system-missing value "
1203                        "or blanks, as appropriate."),
1204                  var_spec->name);
1205           for (; var_spec; var_spec = var_spec->next)
1206             {
1207               int width = get_format_var_width (&var_spec->input);
1208               if (width == 0)
1209                 case_data_rw (c, var_spec->fv)->f = SYSMIS;
1210               else
1211                 memset (case_data_rw (c, var_spec->fv)->s, ' ', width);
1212             }
1213           break;
1214         }
1215
1216       {
1217         struct data_in di;
1218
1219         di.s = ls_c_str (&field);
1220         di.e = ls_end (&field);
1221         di.v = case_data_rw (c, var_spec->fv);
1222         di.flags = 0;
1223         di.f1 = column;
1224         di.format = var_spec->input;
1225         data_in (&di);
1226       }
1227     }
1228
1229   dfm_forward_record (dls->reader);
1230   return -1;
1231 }
1232
1233 /* Destroys SPEC. */
1234 static void
1235 destroy_dls_var_spec (struct dls_var_spec *spec)
1236 {
1237   struct dls_var_spec *next;
1238
1239   while (spec != NULL)
1240     {
1241       next = spec->next;
1242       free (spec);
1243       spec = next;
1244     }
1245 }
1246
1247 /* Destroys DATA LIST transformation PGM. */
1248 static void
1249 data_list_trns_free (struct trns_header *pgm)
1250 {
1251   struct data_list_pgm *dls = (struct data_list_pgm *) pgm;
1252   free (dls->delims);
1253   destroy_dls_var_spec (dls->first);
1254   dfm_close_reader (dls->reader);
1255   free (pgm);
1256 }
1257
1258 /* Handle DATA LIST transformation T, parsing data into C. */
1259 static int
1260 data_list_trns_proc (struct trns_header *t, struct ccase *c,
1261                      int case_num UNUSED)
1262 {
1263   struct data_list_pgm *dls = (struct data_list_pgm *) t;
1264   data_list_read_func *read_func;
1265   int retval;
1266
1267   dfm_push (dls->reader);
1268
1269   read_func = get_data_list_read_func (dls);
1270   retval = read_func (dls, c);
1271
1272   /* Handle end of file. */
1273   if (retval == -2)
1274     {
1275       /* If we already encountered end of file then this is an
1276          error. */
1277       if (dls->eof == 1)
1278         {
1279           msg (SE, _("Attempt to read past end of file."));
1280           err_failure ();
1281           dfm_pop (dls->reader);
1282           return -2;
1283         }
1284
1285       /* Otherwise simply note it. */
1286       dls->eof = 1;
1287     }
1288   else
1289     dls->eof = 0;
1290
1291   /* If there was an END subcommand handle it. */
1292   if (dls->end != NULL)
1293     {
1294       if (retval == -2)
1295         {
1296           case_data_rw (c, dls->end->fv)->f = 1.0;
1297           retval = -1;
1298         }
1299       else
1300         case_data_rw (c, dls->end->fv)->f = 0.0;
1301     }
1302
1303   dfm_pop (dls->reader);
1304
1305   return retval;
1306 }
1307 \f
1308 /* Reads all the records from the data file and passes them to
1309    write_case(). */
1310 static void
1311 data_list_source_read (struct case_source *source,
1312                        struct ccase *c,
1313                        write_case_func *write_case, write_case_data wc_data)
1314 {
1315   struct data_list_pgm *dls = source->aux;
1316   data_list_read_func *read_func = get_data_list_read_func (dls);
1317
1318   dfm_push (dls->reader);
1319   while (read_func (dls, c) != -2)
1320     if (!write_case (wc_data))
1321       break;
1322   dfm_pop (dls->reader);
1323 }
1324
1325 /* Destroys the source's internal data. */
1326 static void
1327 data_list_source_destroy (struct case_source *source)
1328 {
1329   data_list_trns_free (source->aux);
1330 }
1331
1332 const struct case_source_class data_list_source_class =
1333   {
1334     "DATA LIST",
1335     NULL,
1336     data_list_source_read,
1337     data_list_source_destroy,
1338   };
1339 \f
1340 /* REPEATING DATA. */
1341
1342 /* Represents a number or a variable. */
1343 struct rpd_num_or_var
1344   {
1345     int num;                    /* Value, or 0. */
1346     struct variable *var;       /* Variable, if number==0. */
1347   };
1348
1349 /* REPEATING DATA private data structure. */
1350 struct repeating_data_trns
1351   {
1352     struct trns_header h;
1353     struct dls_var_spec *first, *last;  /* Variable parsing specifications. */
1354     struct dfm_reader *reader;          /* Input file, never NULL. */
1355
1356     struct rpd_num_or_var starts_beg;   /* STARTS=, before the dash. */
1357     struct rpd_num_or_var starts_end;   /* STARTS=, after the dash. */
1358     struct rpd_num_or_var occurs;       /* OCCURS= subcommand. */
1359     struct rpd_num_or_var length;       /* LENGTH= subcommand. */
1360     struct rpd_num_or_var cont_beg;     /* CONTINUED=, before the dash. */
1361     struct rpd_num_or_var cont_end;     /* CONTINUED=, after the dash. */
1362
1363     /* ID subcommand. */
1364     int id_beg, id_end;                 /* Beginning & end columns. */
1365     struct variable *id_var;            /* DATA LIST variable. */
1366     struct fmt_spec id_spec;            /* Input format spec. */
1367     union value *id_value;              /* ID value. */
1368
1369     write_case_func *write_case;
1370     write_case_data wc_data;
1371   };
1372
1373 static trns_free_func repeating_data_trns_free;
1374 static int parse_num_or_var (struct rpd_num_or_var *, const char *);
1375 static int parse_repeating_data (struct dls_var_spec **,
1376                                  struct dls_var_spec **);
1377 static void find_variable_input_spec (struct variable *v,
1378                                       struct fmt_spec *spec);
1379
1380 /* Parses the REPEATING DATA command. */
1381 int
1382 cmd_repeating_data (void)
1383 {
1384   struct repeating_data_trns *rpd;
1385   int table = 1;                /* Print table? */
1386   unsigned seen = 0;            /* Mark subcommands as already seen. */
1387   struct file_handle *const fh = default_handle;
1388
1389   assert (case_source_is_complex (vfm_source));
1390
1391   rpd = xmalloc (sizeof *rpd);
1392   rpd->reader = dfm_open_reader (default_handle);
1393   rpd->first = rpd->last = NULL;
1394   rpd->starts_beg.num = 0;
1395   rpd->starts_beg.var = NULL;
1396   rpd->starts_end = rpd->occurs = rpd->length = rpd->cont_beg
1397     = rpd->cont_end = rpd->starts_beg;
1398   rpd->id_beg = rpd->id_end = 0;
1399   rpd->id_var = NULL;
1400   rpd->id_value = NULL;
1401
1402   lex_match ('/');
1403
1404   for (;;)
1405     {
1406       if (lex_match_id ("FILE"))
1407         {
1408           struct file_handle *file;
1409           lex_match ('=');
1410           file = fh_parse ();
1411           if (file == NULL)
1412             goto error;
1413           if (file != fh)
1414             {
1415               msg (SE, _("REPEATING DATA must use the same file as its "
1416                          "corresponding DATA LIST or FILE TYPE."));
1417               goto error;
1418             }
1419         }
1420       else if (lex_match_id ("STARTS"))
1421         {
1422           lex_match ('=');
1423           if (seen & 1)
1424             {
1425               msg (SE, _("%s subcommand given multiple times."),"STARTS");
1426               goto error;
1427             }
1428           seen |= 1;
1429
1430           if (!parse_num_or_var (&rpd->starts_beg, "STARTS beginning column"))
1431             goto error;
1432
1433           lex_negative_to_dash ();
1434           if (lex_match ('-'))
1435             {
1436               if (!parse_num_or_var (&rpd->starts_end, "STARTS ending column"))
1437                 goto error;
1438             } else {
1439               /* Otherwise, rpd->starts_end is left uninitialized.
1440                  This is okay.  We will initialize it later from the
1441                  record length of the file.  We can't do this now
1442                  because we can't be sure that the user has specified
1443                  the file handle yet. */
1444             }
1445
1446           if (rpd->starts_beg.num != 0 && rpd->starts_end.num != 0
1447               && rpd->starts_beg.num > rpd->starts_end.num)
1448             {
1449               msg (SE, _("STARTS beginning column (%d) exceeds "
1450                          "STARTS ending column (%d)."),
1451                    rpd->starts_beg.num, rpd->starts_end.num);
1452               goto error;
1453             }
1454         }
1455       else if (lex_match_id ("OCCURS"))
1456         {
1457           lex_match ('=');
1458           if (seen & 2)
1459             {
1460               msg (SE, _("%s subcommand given multiple times."),"OCCURS");
1461               goto error;
1462             }
1463           seen |= 2;
1464
1465           if (!parse_num_or_var (&rpd->occurs, "OCCURS"))
1466             goto error;
1467         }
1468       else if (lex_match_id ("LENGTH"))
1469         {
1470           lex_match ('=');
1471           if (seen & 4)
1472             {
1473               msg (SE, _("%s subcommand given multiple times."),"LENGTH");
1474               goto error;
1475             }
1476           seen |= 4;
1477
1478           if (!parse_num_or_var (&rpd->length, "LENGTH"))
1479             goto error;
1480         }
1481       else if (lex_match_id ("CONTINUED"))
1482         {
1483           lex_match ('=');
1484           if (seen & 8)
1485             {
1486               msg (SE, _("%s subcommand given multiple times."),"CONTINUED");
1487               goto error;
1488             }
1489           seen |= 8;
1490
1491           if (!lex_match ('/'))
1492             {
1493               if (!parse_num_or_var (&rpd->cont_beg, "CONTINUED beginning column"))
1494                 goto error;
1495
1496               lex_negative_to_dash ();
1497               if (lex_match ('-')
1498                   && !parse_num_or_var (&rpd->cont_end,
1499                                         "CONTINUED ending column"))
1500                 goto error;
1501
1502               if (rpd->cont_beg.num != 0 && rpd->cont_end.num != 0
1503                   && rpd->cont_beg.num > rpd->cont_end.num)
1504                 {
1505                   msg (SE, _("CONTINUED beginning column (%d) exceeds "
1506                              "CONTINUED ending column (%d)."),
1507                        rpd->cont_beg.num, rpd->cont_end.num);
1508                   goto error;
1509                 }
1510             }
1511           else
1512             rpd->cont_beg.num = 1;
1513         }
1514       else if (lex_match_id ("ID"))
1515         {
1516           lex_match ('=');
1517           if (seen & 16)
1518             {
1519               msg (SE, _("%s subcommand given multiple times."),"ID");
1520               goto error;
1521             }
1522           seen |= 16;
1523
1524           if (!lex_force_int ())
1525             goto error;
1526           if (lex_integer () < 1)
1527             {
1528               msg (SE, _("ID beginning column (%ld) must be positive."),
1529                    lex_integer ());
1530               goto error;
1531             }
1532           rpd->id_beg = lex_integer ();
1533
1534           lex_get ();
1535           lex_negative_to_dash ();
1536
1537           if (lex_match ('-'))
1538             {
1539               if (!lex_force_int ())
1540                 goto error;
1541               if (lex_integer () < 1)
1542                 {
1543                   msg (SE, _("ID ending column (%ld) must be positive."),
1544                        lex_integer ());
1545                   goto error;
1546                 }
1547               if (lex_integer () < rpd->id_end)
1548                 {
1549                   msg (SE, _("ID ending column (%ld) cannot be less than "
1550                              "ID beginning column (%d)."),
1551                        lex_integer (), rpd->id_beg);
1552                   goto error;
1553                 }
1554
1555               rpd->id_end = lex_integer ();
1556               lex_get ();
1557             }
1558           else rpd->id_end = rpd->id_beg;
1559
1560           if (!lex_force_match ('='))
1561             goto error;
1562           rpd->id_var = parse_variable ();
1563           if (rpd->id_var == NULL)
1564             goto error;
1565
1566           find_variable_input_spec (rpd->id_var, &rpd->id_spec);
1567           rpd->id_value = xmalloc (sizeof *rpd->id_value * rpd->id_var->nv);
1568         }
1569       else if (lex_match_id ("TABLE"))
1570         table = 1;
1571       else if (lex_match_id ("NOTABLE"))
1572         table = 0;
1573       else if (lex_match_id ("DATA"))
1574         break;
1575       else
1576         {
1577           lex_error (NULL);
1578           goto error;
1579         }
1580
1581       if (!lex_force_match ('/'))
1582         goto error;
1583     }
1584
1585   /* Comes here when DATA specification encountered. */
1586   if ((seen & (1 | 2)) != (1 | 2))
1587     {
1588       if ((seen & 1) == 0)
1589         msg (SE, _("Missing required specification STARTS."));
1590       if ((seen & 2) == 0)
1591         msg (SE, _("Missing required specification OCCURS."));
1592       goto error;
1593     }
1594
1595   /* Enforce ID restriction. */
1596   if ((seen & 16) && !(seen & 8))
1597     {
1598       msg (SE, _("ID specified without CONTINUED."));
1599       goto error;
1600     }
1601
1602   /* Calculate starts_end, cont_end if necessary. */
1603   if (rpd->starts_end.num == 0 && rpd->starts_end.var == NULL)
1604     rpd->starts_end.num = handle_get_record_width (fh);
1605   if (rpd->cont_end.num == 0 && rpd->starts_end.var == NULL)
1606     rpd->cont_end.num = handle_get_record_width (fh);
1607
1608   /* Calculate length if possible. */
1609   if ((seen & 4) == 0)
1610     {
1611       struct dls_var_spec *iter;
1612
1613       for (iter = rpd->first; iter; iter = iter->next)
1614         {
1615           if (iter->lc > rpd->length.num)
1616             rpd->length.num = iter->lc;
1617         }
1618       assert (rpd->length.num != 0);
1619     }
1620
1621   lex_match ('=');
1622   if (!parse_repeating_data (&rpd->first, &rpd->last))
1623     goto error;
1624
1625   if (table)
1626     dump_fixed_table (rpd->first, fh, rpd->last->rec);
1627
1628   {
1629     struct repeating_data_trns *new_trns;
1630
1631     rpd->h.proc = repeating_data_trns_proc;
1632     rpd->h.free = repeating_data_trns_free;
1633
1634     new_trns = xmalloc (sizeof *new_trns);
1635     memcpy (new_trns, &rpd, sizeof *new_trns);
1636     add_transformation ((struct trns_header *) new_trns);
1637   }
1638
1639   return lex_end_of_command ();
1640
1641  error:
1642   destroy_dls_var_spec (rpd->first);
1643   free (rpd->id_value);
1644   return CMD_FAILURE;
1645 }
1646
1647 /* Finds the input format specification for variable V and puts
1648    it in SPEC.  Because of the way that DATA LIST is structured,
1649    this is nontrivial. */
1650 static void
1651 find_variable_input_spec (struct variable *v, struct fmt_spec *spec)
1652 {
1653   int i;
1654
1655   for (i = 0; i < n_trns; i++)
1656     {
1657       struct data_list_pgm *pgm = (struct data_list_pgm *) t_trns[i];
1658
1659       if (pgm->h.proc == data_list_trns_proc)
1660         {
1661           struct dls_var_spec *iter;
1662
1663           for (iter = pgm->first; iter; iter = iter->next)
1664             if (iter->v == v)
1665               {
1666                 *spec = iter->input;
1667                 return;
1668               }
1669         }
1670     }
1671
1672   assert (0);
1673 }
1674
1675 /* Parses a number or a variable name from the syntax file and puts
1676    the results in VALUE.  Ensures that the number is at least 1; else
1677    emits an error based on MESSAGE.  Returns nonzero only if
1678    successful. */
1679 static int
1680 parse_num_or_var (struct rpd_num_or_var *value, const char *message)
1681 {
1682   if (token == T_ID)
1683     {
1684       value->num = 0;
1685       value->var = parse_variable ();
1686       if (value->var == NULL)
1687         return 0;
1688       if (value->var->type == ALPHA)
1689         {
1690           msg (SE, _("String variable not allowed here."));
1691           return 0;
1692         }
1693     }
1694   else if (lex_is_integer ())
1695     {
1696       value->num = lex_integer ();
1697
1698       if (value->num < 1)
1699         {
1700           msg (SE, _("%s (%d) must be at least 1."), message, value->num);
1701           return 0;
1702         }
1703
1704       lex_get ();
1705     } else {
1706       msg (SE, _("Variable or integer expected for %s."), message);
1707       return 0;
1708     }
1709   return 1;
1710 }
1711
1712 /* Parses data specifications for repeating data groups, adding
1713    them to the linked list with head FIRST and tail LAST.
1714    Returns nonzero only if successful.  */
1715 static int
1716 parse_repeating_data (struct dls_var_spec **first, struct dls_var_spec **last)
1717 {
1718   struct fixed_parsing_state fx;
1719   int i;
1720
1721   fx.recno = 0;
1722   fx.sc = 1;
1723
1724   while (token != '.')
1725     {
1726       if (!parse_DATA_LIST_vars (&fx.name, &fx.name_cnt, PV_NONE))
1727         return 0;
1728
1729       if (lex_is_number ())
1730         {
1731           if (!fixed_parse_compatible (&fx, first, last))
1732             goto fail;
1733         }
1734       else if (token == '(')
1735         {
1736           if (!fixed_parse_fortran (&fx, first, last))
1737             goto fail;
1738         }
1739       else
1740         {
1741           msg (SE, _("SPSS-like or FORTRAN-like format "
1742                "specification expected after variable names."));
1743           goto fail;
1744         }
1745
1746       for (i = 0; i < fx.name_cnt; i++)
1747         free (fx.name[i]);
1748       free (fx.name);
1749     }
1750   if (token != '.')
1751     {
1752       lex_error (_("expecting end of command"));
1753       return 0;
1754     }
1755
1756   return 1;
1757
1758  fail:
1759   for (i = 0; i < fx.name_cnt; i++)
1760     free (fx.name[i]);
1761   free (fx.name);
1762   return 0;
1763 }
1764
1765 /* Obtains the real value for rpd_num_or_var N in case C and returns
1766    it.  The valid range is nonnegative numbers, but numbers outside
1767    this range can be returned and should be handled by the caller as
1768    invalid. */
1769 static int
1770 realize_value (struct rpd_num_or_var *n, struct ccase *c)
1771 {
1772   if (n->num > 0)
1773     return n->num;
1774
1775   assert (n->num == 0);
1776   if (n->var != NULL)
1777     {
1778       double v = case_num (c, n->var->fv);
1779
1780       if (v == SYSMIS || v <= INT_MIN || v >= INT_MAX)
1781         return -1;
1782       else
1783         return v;
1784     }
1785   else
1786     return 0;
1787 }
1788
1789 /* Parameter record passed to rpd_parse_record(). */
1790 struct rpd_parse_info
1791   {
1792     struct repeating_data_trns *trns;  /* REPEATING DATA transformation. */
1793     const char *line;   /* Line being parsed. */
1794     size_t len;         /* Line length. */
1795     int beg, end;       /* First and last column of first occurrence. */
1796     int ofs;            /* Column offset between repeated occurrences. */
1797     struct ccase *c;    /* Case to fill in. */
1798     int verify_id;      /* Zero to initialize ID, nonzero to verify it. */
1799     int max_occurs;     /* Max number of occurrences to parse. */
1800   };
1801
1802 /* Parses one record of repeated data and outputs corresponding
1803    cases.  Returns number of occurrences parsed up to the
1804    maximum specified in INFO. */
1805 static int
1806 rpd_parse_record (const struct rpd_parse_info *info)
1807 {
1808   struct repeating_data_trns *t = info->trns;
1809   int cur = info->beg;
1810   int occurrences;
1811
1812   /* Handle record ID values. */
1813   if (t->id_beg != 0)
1814     {
1815       union value id_temp[MAX_ELEMS_PER_VALUE];
1816
1817       /* Parse record ID into V. */
1818       {
1819         struct data_in di;
1820
1821         data_in_finite_line (&di, info->line, info->len, t->id_beg, t->id_end);
1822         di.v = info->verify_id ? id_temp : t->id_value;
1823         di.flags = 0;
1824         di.f1 = t->id_beg;
1825         di.format = t->id_spec;
1826
1827         if (!data_in (&di))
1828           return 0;
1829       }
1830
1831       if (info->verify_id
1832           && compare_values (id_temp, t->id_value, t->id_var->width) != 0)
1833         {
1834           char expected_str [MAX_FORMATTED_LEN + 1];
1835           char actual_str [MAX_FORMATTED_LEN + 1];
1836
1837           data_out (expected_str, &t->id_var->print, t->id_value);
1838           expected_str[t->id_var->print.w] = '\0';
1839
1840           data_out (actual_str, &t->id_var->print, id_temp);
1841           actual_str[t->id_var->print.w] = '\0';
1842
1843           tmsg (SE, RPD_ERR,
1844                 _("Encountered mismatched record ID \"%s\" expecting \"%s\"."),
1845                 actual_str, expected_str);
1846
1847           return 0;
1848         }
1849     }
1850
1851   /* Iterate over the set of expected occurrences and record each of
1852      them as a separate case.  FIXME: We need to execute any
1853      transformations that follow the current one. */
1854   {
1855     int warned = 0;
1856
1857     for (occurrences = 0; occurrences < info->max_occurs; )
1858       {
1859         if (cur + info->ofs > info->end + 1)
1860           break;
1861         occurrences++;
1862
1863         {
1864           struct dls_var_spec *var_spec = t->first;
1865
1866           for (; var_spec; var_spec = var_spec->next)
1867             {
1868               int fc = var_spec->fc - 1 + cur;
1869               int lc = var_spec->lc - 1 + cur;
1870
1871               if (fc > info->len && !warned && var_spec->input.type != FMT_A)
1872                 {
1873                   warned = 1;
1874
1875                   tmsg (SW, RPD_ERR,
1876                         _("Variable %s starting in column %d extends "
1877                           "beyond physical record length of %d."),
1878                         var_spec->v->name, fc, info->len);
1879                 }
1880
1881               {
1882                 struct data_in di;
1883
1884                 data_in_finite_line (&di, info->line, info->len, fc, lc);
1885                 di.v = case_data_rw (info->c, var_spec->fv);
1886                 di.flags = 0;
1887                 di.f1 = fc + 1;
1888                 di.format = var_spec->input;
1889
1890                 if (!data_in (&di))
1891                   return 0;
1892               }
1893             }
1894         }
1895
1896         cur += info->ofs;
1897
1898         if (!t->write_case (t->wc_data))
1899           return 0;
1900       }
1901   }
1902
1903   return occurrences;
1904 }
1905
1906 /* Reads one set of repetitions of the elements in the REPEATING
1907    DATA structure.  Returns -1 on success, -2 on end of file or
1908    on failure. */
1909 int
1910 repeating_data_trns_proc (struct trns_header *trns, struct ccase *c,
1911                           int case_num UNUSED)
1912 {
1913   struct repeating_data_trns *t = (struct repeating_data_trns *) trns;
1914
1915   struct fixed_string line;       /* Current record. */
1916
1917   int starts_beg;       /* Starting column. */
1918   int starts_end;       /* Ending column. */
1919   int occurs;           /* Number of repetitions. */
1920   int length;           /* Length of each occurrence. */
1921   int cont_beg;         /* Starting column for continuation lines. */
1922   int cont_end;         /* Ending column for continuation lines. */
1923
1924   int occurs_left;      /* Number of occurrences remaining. */
1925
1926   int code;             /* Return value from rpd_parse_record(). */
1927
1928   int skip_first_record = 0;
1929
1930   dfm_push (t->reader);
1931
1932   /* Read the current record. */
1933   dfm_reread_record (t->reader, 1);
1934   dfm_expand_tabs (t->reader);
1935   if (dfm_eof (t->reader))
1936     return -2;
1937   dfm_get_record (t->reader, &line);
1938   dfm_forward_record (t->reader);
1939
1940   /* Calculate occurs, length. */
1941   occurs_left = occurs = realize_value (&t->occurs, c);
1942   if (occurs <= 0)
1943     {
1944       tmsg (SE, RPD_ERR, _("Invalid value %d for OCCURS."), occurs);
1945       return -3;
1946     }
1947   starts_beg = realize_value (&t->starts_beg, c);
1948   if (starts_beg <= 0)
1949     {
1950       tmsg (SE, RPD_ERR, _("Beginning column for STARTS (%d) must be "
1951                            "at least 1."),
1952             starts_beg);
1953       return -3;
1954     }
1955   starts_end = realize_value (&t->starts_end, c);
1956   if (starts_end < starts_beg)
1957     {
1958       tmsg (SE, RPD_ERR, _("Ending column for STARTS (%d) is less than "
1959                            "beginning column (%d)."),
1960             starts_end, starts_beg);
1961       skip_first_record = 1;
1962     }
1963   length = realize_value (&t->length, c);
1964   if (length < 0)
1965     {
1966       tmsg (SE, RPD_ERR, _("Invalid value %d for LENGTH."), length);
1967       length = 1;
1968       occurs = occurs_left = 1;
1969     }
1970   cont_beg = realize_value (&t->cont_beg, c);
1971   if (cont_beg < 0)
1972     {
1973       tmsg (SE, RPD_ERR, _("Beginning column for CONTINUED (%d) must be "
1974                            "at least 1."),
1975             cont_beg);
1976       return -2;
1977     }
1978   cont_end = realize_value (&t->cont_end, c);
1979   if (cont_end < cont_beg)
1980     {
1981       tmsg (SE, RPD_ERR, _("Ending column for CONTINUED (%d) is less than "
1982                            "beginning column (%d)."),
1983             cont_end, cont_beg);
1984       return -2;
1985     }
1986
1987   /* Parse the first record. */
1988   if (!skip_first_record)
1989     {
1990       struct rpd_parse_info info;
1991       info.trns = t;
1992       info.line = ls_c_str (&line);
1993       info.len = ls_length (&line);
1994       info.beg = starts_beg;
1995       info.end = starts_end;
1996       info.ofs = length;
1997       info.c = c;
1998       info.verify_id = 0;
1999       info.max_occurs = occurs_left;
2000       code = rpd_parse_record (&info);
2001       if (!code)
2002         return -2;
2003       occurs_left -= code;
2004     }
2005   else if (cont_beg == 0)
2006     return -3;
2007
2008   /* Make sure, if some occurrences are left, that we have
2009      continuation records. */
2010   if (occurs_left > 0 && cont_beg == 0)
2011     {
2012       tmsg (SE, RPD_ERR,
2013             _("Number of repetitions specified on OCCURS (%d) "
2014               "exceed number of repetitions available in "
2015               "space on STARTS (%d), and CONTINUED not specified."),
2016             occurs, (starts_end - starts_beg + 1) / length);
2017       return -2;
2018     }
2019
2020   /* Go on to additional records. */
2021   while (occurs_left != 0)
2022     {
2023       struct rpd_parse_info info;
2024
2025       assert (occurs_left >= 0);
2026
2027       /* Read in another record. */
2028       if (dfm_eof (t->reader))
2029         {
2030           tmsg (SE, RPD_ERR,
2031                 _("Unexpected end of file with %d repetitions "
2032                   "remaining out of %d."),
2033                 occurs_left, occurs);
2034           return -2;
2035         }
2036       dfm_expand_tabs (t->reader);
2037       dfm_get_record (t->reader, &line);
2038       dfm_forward_record (t->reader);
2039
2040       /* Parse this record. */
2041       info.trns = t;
2042       info.line = ls_c_str (&line);
2043       info.len = ls_length (&line);
2044       info.beg = cont_beg;
2045       info.end = cont_end;
2046       info.ofs = length;
2047       info.c = c;
2048       info.verify_id = 1;
2049       info.max_occurs = occurs_left;
2050       code = rpd_parse_record (&info);;
2051       if (!code)
2052         return -2;
2053       occurs_left -= code;
2054     }
2055
2056   dfm_pop (t->reader);
2057
2058   /* FIXME: This is a kluge until we've implemented multiplexing of
2059      transformations. */
2060   return -3;
2061 }
2062
2063 /* Frees a REPEATING DATA transformation. */
2064 void
2065 repeating_data_trns_free (struct trns_header *rpd_)
2066 {
2067   struct repeating_data_trns *rpd = (struct repeating_data_trns *) rpd_;
2068
2069   destroy_dls_var_spec (rpd->first);
2070   dfm_close_reader (rpd->reader);
2071   free (rpd->id_value);
2072 }
2073
2074 /* Lets repeating_data_trns_proc() know how to write the cases
2075    that it composes.  Not elegant. */
2076 void
2077 repeating_data_set_write_case (struct trns_header *trns,
2078                                write_case_func *write_case,
2079                                write_case_data wc_data)
2080 {
2081   struct repeating_data_trns *t = (struct repeating_data_trns *) trns;
2082
2083   assert (trns->proc == repeating_data_trns_proc);
2084   t->write_case = write_case;
2085   t->wc_data = wc_data;
2086 }