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[9];               /* 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       if (lex_match ('('))
 845         {
 846           if (!parse_format_specifier (&input, 0)
 847               || !check_input_specifier (&input, 1)
 848               || !lex_force_match (')'))
 849             {
 850               for (i = 0; i < name_cnt; i++)
 851                 free (name[i]);
 852               free (name);
 853               return 0;
 854             }
 855           convert_fmt_ItoO (&input, &output);
 856         }
 857       else
 858         {
 859           lex_match ('*');
 860           input.type = FMT_F;
 861           input.w = 8;
 862           input.d = 0;
 863           output = get_format();
 864         }
 865
 866       if (input.type == FMT_A || input.type == FMT_AHEX)
 867         width = input.w;
 868       else
 869         width = 0;
 870       for (i = 0; i < name_cnt; i++)
 871         {
 872           struct dls_var_spec *spec;
 873           struct variable *v;
 874
 875           v = dict_create_var (default_dict, name[i], width);
 876           if (!v)
 877             {
 878               msg (SE, _("%s is a duplicate variable name."), name[i]);
 879               return 0;
 880             }
 881           v->print = v->write = output;
 882
 883           if (!case_source_is_complex (vfm_source))
 884             v->init = 0;
 885
 886           spec = xmalloc (sizeof *spec);
 887           spec->input = input;
 888           spec->v = v;
 889           spec->fv = v->fv;
 890           strcpy (spec->name, name[i]);
 891           append_var_spec (first, last, spec);
 892         }
 893       for (i = 0; i < name_cnt; i++)
 894         free (name[i]);
 895       free (name);
 896     }
 897
 898   if (token != '.')
 899     lex_error (_("expecting end of command"));
 900   return 1;
 901 }
 902
 903 /* Displays a table giving information on free-format variable parsing
 904    on DATA LIST. */
 905 static void
 906 dump_free_table (const struct data_list_pgm *dls,
 907                  const struct file_handle *fh)
 908 {
 909   struct tab_table *t;
 910   int i;
 911
 912   {
 913     struct dls_var_spec *spec;
 914     for (i = 0, spec = dls->first; spec; spec = spec->next)
 915       i++;
 916   }
 917
 918   t = tab_create (2, i + 1, 0);
 919   tab_columns (t, TAB_COL_DOWN, 1);
 920   tab_headers (t, 0, 0, 1, 0);
 921   tab_text (t, 0, 0, TAB_CENTER | TAT_TITLE, _("Variable"));
 922   tab_text (t, 1, 0, TAB_CENTER | TAT_TITLE, _("Format"));
 923   tab_box (t, TAL_1, TAL_1, TAL_0, TAL_1, 0, 0, 1, i);
 924   tab_hline (t, TAL_2, 0, 1, 1);
 925   tab_dim (t, tab_natural_dimensions);
 926
 927   {
 928     struct dls_var_spec *spec;
 929
 930     for (i = 1, spec = dls->first; spec; spec = spec->next, i++)
 931       {
 932         tab_text (t, 0, i, TAB_LEFT, spec->v->name);
 933         tab_text (t, 1, i, TAB_LEFT | TAT_FIX, fmt_to_string (&spec->input));
 934       }
 935   }
 936
 937   if (fh != NULL)
 938     tab_title (t, 1, _("Reading free-form data from file %s."),
 939                handle_get_filename (fh));
 940   else
 941     tab_title (t, 1, _("Reading free-form data from the command file."));
 942
 943   tab_submit (t);
 944 }
 945 \f
 946 /* Input procedure. */
 947
 948 /* Extracts a field from the current position in the current
 949    record.  Fields can be unquoted or quoted with single- or
 950    double-quote characters.  *FIELD is set to the field content.
 951    After parsing the field, sets the current position in the
 952    record to just past the field and any trailing delimiter.
 953    END_BLANK is used internally; it should be initialized by the
 954    caller to 0 and left alone afterward.  Returns 0 on failure or
 955    a 1-based column number indicating the beginning of the field
 956    on success. */
 957 static int
 958 cut_field (const struct data_list_pgm *dls, struct fixed_string *field,
 959            int *end_blank)
 960 {
 961   struct fixed_string line;
 962   char *cp;
 963   size_t column_start;
 964
 965   if (dfm_eof (dls->reader))
 966     return 0;
 967   if (dls->delim_cnt == 0)
 968     dfm_expand_tabs (dls->reader);
 969   dfm_get_record (dls->reader, &line);
 970
 971   cp = ls_c_str (&line);
 972   if (dls->delim_cnt == 0)
 973     {
 974       /* Skip leading whitespace. */
 975       while (cp < ls_end (&line) && isspace ((unsigned char) *cp))
 976         cp++;
 977       if (cp >= ls_end (&line))
 978         return 0;
 979
 980       /* Handle actual data, whether quoted or unquoted. */
 981       if (*cp == '\'' || *cp == '"')
 982         {
 983           int quote = *cp;
 984
 985           field->string = ++cp;
 986           while (cp < ls_end (&line) && *cp != quote)
 987             cp++;
 988           field->length = cp - field->string;
 989           if (cp < ls_end (&line))
 990             cp++;
 991           else
 992             msg (SW, _("Quoted string missing terminating `%c'."), quote);
 993         }
 994       else
 995         {
 996           field->string = cp;
 997           while (cp < ls_end (&line)
 998                  && !isspace ((unsigned char) *cp) && *cp != ',')
 999             cp++;
1000           field->length = cp - field->string;
1001         }
1002
1003       /* Skip trailing whitespace and a single comma if present. */
1004       while (cp < ls_end (&line) && isspace ((unsigned char) *cp))
1005         cp++;
1006       if (cp < ls_end (&line) && *cp == ',')
1007         cp++;
1008     }
1009   else
1010     {
1011       if (cp >= ls_end (&line))
1012         {
1013           int column = dfm_column_start (dls->reader);
1014                /* A blank line or a line that ends in \t has a
1015              trailing blank field. */
1016           if (column == 1 || (column > 1 && cp[-1] == '\t'))
1017             {
1018               if (*end_blank == 0)
1019                 {
1020                   *end_blank = 1;
1021                   field->string = ls_end (&line);
1022                   field->length = 0;
1023                   dfm_forward_record (dls->reader);
1024                   return column;
1025                 }
1026               else
1027                 {
1028                   *end_blank = 0;
1029                   return 0;
1030                 }
1031             }
1032           else
1033             return 0;
1034         }
1035       else
1036         {
1037           field->string = cp;
1038           while (cp < ls_end (&line)
1039                  && memchr (dls->delims, *cp, dls->delim_cnt) == NULL)
1040             cp++;
1041           field->length = cp - field->string;
1042           if (cp < ls_end (&line))
1043             cp++;
1044         }
1045     }
1046
1047   dfm_forward_columns (dls->reader, field->string - line.string);
1048   column_start = dfm_column_start (dls->reader);
1049
1050   dfm_forward_columns (dls->reader, cp - field->string);
1051
1052   return column_start;
1053 }
1054
1055 typedef int data_list_read_func (const struct data_list_pgm *, struct ccase *);
1056 static data_list_read_func read_from_data_list_fixed;
1057 static data_list_read_func read_from_data_list_free;
1058 static data_list_read_func read_from_data_list_list;
1059
1060 /* Returns the proper function to read the kind of DATA LIST
1061    data specified by DLS. */
1062 static data_list_read_func *
1063 get_data_list_read_func (const struct data_list_pgm *dls)
1064 {
1065   switch (dls->type)
1066     {
1067     case DLS_FIXED:
1068       return read_from_data_list_fixed;
1069
1070     case DLS_FREE:
1071       return read_from_data_list_free;
1072
1073     case DLS_LIST:
1074       return read_from_data_list_list;
1075
1076     default:
1077       assert (0);
1078       abort ();
1079     }
1080 }
1081
1082 /* Reads a case from the data file into C, parsing it according
1083    to fixed-format syntax rules in DLS.  Returns -1 on success,
1084    -2 at end of file. */
1085 static int
1086 read_from_data_list_fixed (const struct data_list_pgm *dls,
1087                            struct ccase *c)
1088 {
1089   struct dls_var_spec *var_spec = dls->first;
1090   int i;
1091
1092   if (dfm_eof (dls->reader))
1093     return -2;
1094   for (i = 1; i <= dls->rec_cnt; i++)
1095     {
1096       struct fixed_string line;
1097
1098       if (dfm_eof (dls->reader))
1099         {
1100           /* Note that this can't occur on the first record. */
1101           msg (SW, _("Partial case of %d of %d records discarded."),
1102                i - 1, dls->rec_cnt);
1103           return -2;
1104         }
1105       dfm_expand_tabs (dls->reader);
1106       dfm_get_record (dls->reader, &line);
1107
1108       for (; var_spec && i == var_spec->rec; var_spec = var_spec->next)
1109         {
1110           struct data_in di;
1111
1112           data_in_finite_line (&di, ls_c_str (&line), ls_length (&line),
1113                                var_spec->fc, var_spec->lc);
1114           di.v = case_data_rw (c, var_spec->fv);
1115           di.flags = DI_IMPLIED_DECIMALS;
1116           di.f1 = var_spec->fc;
1117           di.format = var_spec->input;
1118
1119           data_in (&di);
1120         }
1121
1122       dfm_forward_record (dls->reader);
1123     }
1124
1125   return -1;
1126 }
1127
1128 /* Reads a case from the data file into C, parsing it according
1129    to free-format syntax rules in DLS.  Returns -1 on success,
1130    -2 at end of file. */
1131 static int
1132 read_from_data_list_free (const struct data_list_pgm *dls,
1133                           struct ccase *c)
1134 {
1135   struct dls_var_spec *var_spec;
1136   int end_blank = 0;
1137
1138   for (var_spec = dls->first; var_spec; var_spec = var_spec->next)
1139     {
1140       struct fixed_string field;
1141       int column;
1142
1143       /* Cut out a field and read in a new record if necessary. */
1144       for (;;)
1145         {
1146           column = cut_field (dls, &field, &end_blank);
1147           if (column != 0)
1148             break;
1149
1150           if (!dfm_eof (dls->reader))
1151             dfm_forward_record (dls->reader);
1152           if (dfm_eof (dls->reader))
1153             {
1154               if (var_spec != dls->first)
1155                 msg (SW, _("Partial case discarded.  The first variable "
1156                            "missing was %s."), var_spec->name);
1157               return -2;
1158             }
1159         }
1160
1161       {
1162         struct data_in di;
1163
1164         di.s = ls_c_str (&field);
1165         di.e = ls_end (&field);
1166         di.v = case_data_rw (c, var_spec->fv);
1167         di.flags = 0;
1168         di.f1 = column;
1169         di.format = var_spec->input;
1170         data_in (&di);
1171       }
1172     }
1173   return -1;
1174 }
1175
1176 /* Reads a case from the data file and parses it according to
1177    list-format syntax rules.  Returns -1 on success, -2 at end of
1178    file. */
1179 static int
1180 read_from_data_list_list (const struct data_list_pgm *dls,
1181                           struct ccase *c)
1182 {
1183   struct dls_var_spec *var_spec;
1184   int end_blank = 0;
1185
1186   if (dfm_eof (dls->reader))
1187     return -2;
1188
1189   for (var_spec = dls->first; var_spec; var_spec = var_spec->next)
1190     {
1191       struct fixed_string field;
1192       int column;
1193
1194       /* Cut out a field and check for end-of-line. */
1195       column = cut_field (dls, &field, &end_blank);
1196       if (column == 0)
1197         {
1198           if (get_undefined ())
1199             msg (SW, _("Missing value(s) for all variables from %s onward.  "
1200                        "These will be filled with the system-missing value "
1201                        "or blanks, as appropriate."),
1202                  var_spec->name);
1203           for (; var_spec; var_spec = var_spec->next)
1204             {
1205               int width = get_format_var_width (&var_spec->input);
1206               if (width == 0)
1207                 case_data_rw (c, var_spec->fv)->f = SYSMIS;
1208               else
1209                 memset (case_data_rw (c, var_spec->fv)->s, ' ', width);
1210             }
1211           break;
1212         }
1213
1214       {
1215         struct data_in di;
1216
1217         di.s = ls_c_str (&field);
1218         di.e = ls_end (&field);
1219         di.v = case_data_rw (c, var_spec->fv);
1220         di.flags = 0;
1221         di.f1 = column;
1222         di.format = var_spec->input;
1223         data_in (&di);
1224       }
1225     }
1226
1227   dfm_forward_record (dls->reader);
1228   return -1;
1229 }
1230
1231 /* Destroys SPEC. */
1232 static void
1233 destroy_dls_var_spec (struct dls_var_spec *spec)
1234 {
1235   struct dls_var_spec *next;
1236
1237   while (spec != NULL)
1238     {
1239       next = spec->next;
1240       free (spec);
1241       spec = next;
1242     }
1243 }
1244
1245 /* Destroys DATA LIST transformation PGM. */
1246 static void
1247 data_list_trns_free (struct trns_header *pgm)
1248 {
1249   struct data_list_pgm *dls = (struct data_list_pgm *) pgm;
1250   free (dls->delims);
1251   destroy_dls_var_spec (dls->first);
1252   dfm_close_reader (dls->reader);
1253   free (pgm);
1254 }
1255
1256 /* Handle DATA LIST transformation T, parsing data into C. */
1257 static int
1258 data_list_trns_proc (struct trns_header *t, struct ccase *c,
1259                      int case_num UNUSED)
1260 {
1261   struct data_list_pgm *dls = (struct data_list_pgm *) t;
1262   data_list_read_func *read_func;
1263   int retval;
1264
1265   dfm_push (dls->reader);
1266
1267   read_func = get_data_list_read_func (dls);
1268   retval = read_func (dls, c);
1269
1270   /* Handle end of file. */
1271   if (retval == -2)
1272     {
1273       /* If we already encountered end of file then this is an
1274          error. */
1275       if (dls->eof == 1)
1276         {
1277           msg (SE, _("Attempt to read past end of file."));
1278           err_failure ();
1279           dfm_pop (dls->reader);
1280           return -2;
1281         }
1282
1283       /* Otherwise simply note it. */
1284       dls->eof = 1;
1285     }
1286   else
1287     dls->eof = 0;
1288
1289   /* If there was an END subcommand handle it. */
1290   if (dls->end != NULL)
1291     {
1292       if (retval == -2)
1293         {
1294           case_data_rw (c, dls->end->fv)->f = 1.0;
1295           retval = -1;
1296         }
1297       else
1298         case_data_rw (c, dls->end->fv)->f = 0.0;
1299     }
1300
1301   dfm_pop (dls->reader);
1302
1303   return retval;
1304 }
1305 \f
1306 /* Reads all the records from the data file and passes them to
1307    write_case(). */
1308 static void
1309 data_list_source_read (struct case_source *source,
1310                        struct ccase *c,
1311                        write_case_func *write_case, write_case_data wc_data)
1312 {
1313   struct data_list_pgm *dls = source->aux;
1314   data_list_read_func *read_func = get_data_list_read_func (dls);
1315
1316   dfm_push (dls->reader);
1317   while (read_func (dls, c) != -2)
1318     if (!write_case (wc_data))
1319       break;
1320   dfm_pop (dls->reader);
1321 }
1322
1323 /* Destroys the source's internal data. */
1324 static void
1325 data_list_source_destroy (struct case_source *source)
1326 {
1327   data_list_trns_free (source->aux);
1328 }
1329
1330 const struct case_source_class data_list_source_class =
1331   {
1332     "DATA LIST",
1333     NULL,
1334     data_list_source_read,
1335     data_list_source_destroy,
1336   };
1337 \f
1338 /* REPEATING DATA. */
1339
1340 /* Represents a number or a variable. */
1341 struct rpd_num_or_var
1342   {
1343     int num;                    /* Value, or 0. */
1344     struct variable *var;       /* Variable, if number==0. */
1345   };
1346
1347 /* REPEATING DATA private data structure. */
1348 struct repeating_data_trns
1349   {
1350     struct trns_header h;
1351     struct dls_var_spec *first, *last;  /* Variable parsing specifications. */
1352     struct dfm_reader *reader;          /* Input file, never NULL. */
1353
1354     struct rpd_num_or_var starts_beg;   /* STARTS=, before the dash. */
1355     struct rpd_num_or_var starts_end;   /* STARTS=, after the dash. */
1356     struct rpd_num_or_var occurs;       /* OCCURS= subcommand. */
1357     struct rpd_num_or_var length;       /* LENGTH= subcommand. */
1358     struct rpd_num_or_var cont_beg;     /* CONTINUED=, before the dash. */
1359     struct rpd_num_or_var cont_end;     /* CONTINUED=, after the dash. */
1360
1361     /* ID subcommand. */
1362     int id_beg, id_end;                 /* Beginning & end columns. */
1363     struct variable *id_var;            /* DATA LIST variable. */
1364     struct fmt_spec id_spec;            /* Input format spec. */
1365     union value *id_value;              /* ID value. */
1366
1367     write_case_func *write_case;
1368     write_case_data wc_data;
1369   };
1370
1371 static trns_free_func repeating_data_trns_free;
1372 static int parse_num_or_var (struct rpd_num_or_var *, const char *);
1373 static int parse_repeating_data (struct dls_var_spec **,
1374                                  struct dls_var_spec **);
1375 static void find_variable_input_spec (struct variable *v,
1376                                       struct fmt_spec *spec);
1377
1378 /* Parses the REPEATING DATA command. */
1379 int
1380 cmd_repeating_data (void)
1381 {
1382   struct repeating_data_trns *rpd;
1383   int table = 1;                /* Print table? */
1384   unsigned seen = 0;            /* Mark subcommands as already seen. */
1385   struct file_handle *const fh = default_handle;
1386
1387   assert (case_source_is_complex (vfm_source));
1388
1389   rpd = xmalloc (sizeof *rpd);
1390   rpd->reader = dfm_open_reader (default_handle);
1391   rpd->first = rpd->last = NULL;
1392   rpd->starts_beg.num = 0;
1393   rpd->starts_beg.var = NULL;
1394   rpd->starts_end = rpd->occurs = rpd->length = rpd->cont_beg
1395     = rpd->cont_end = rpd->starts_beg;
1396   rpd->id_beg = rpd->id_end = 0;
1397   rpd->id_var = NULL;
1398   rpd->id_value = NULL;
1399
1400   lex_match ('/');
1401
1402   for (;;)
1403     {
1404       if (lex_match_id ("FILE"))
1405         {
1406           struct file_handle *file;
1407           lex_match ('=');
1408           file = fh_parse ();
1409           if (file == NULL)
1410             goto error;
1411           if (file != fh)
1412             {
1413               msg (SE, _("REPEATING DATA must use the same file as its "
1414                          "corresponding DATA LIST or FILE TYPE."));
1415               goto error;
1416             }
1417         }
1418       else if (lex_match_id ("STARTS"))
1419         {
1420           lex_match ('=');
1421           if (seen & 1)
1422             {
1423               msg (SE, _("%s subcommand given multiple times."),"STARTS");
1424               goto error;
1425             }
1426           seen |= 1;
1427
1428           if (!parse_num_or_var (&rpd->starts_beg, "STARTS beginning column"))
1429             goto error;
1430
1431           lex_negative_to_dash ();
1432           if (lex_match ('-'))
1433             {
1434               if (!parse_num_or_var (&rpd->starts_end, "STARTS ending column"))
1435                 goto error;
1436             } else {
1437               /* Otherwise, rpd->starts_end is left uninitialized.
1438                  This is okay.  We will initialize it later from the
1439                  record length of the file.  We can't do this now
1440                  because we can't be sure that the user has specified
1441                  the file handle yet. */
1442             }
1443
1444           if (rpd->starts_beg.num != 0 && rpd->starts_end.num != 0
1445               && rpd->starts_beg.num > rpd->starts_end.num)
1446             {
1447               msg (SE, _("STARTS beginning column (%d) exceeds "
1448                          "STARTS ending column (%d)."),
1449                    rpd->starts_beg.num, rpd->starts_end.num);
1450               goto error;
1451             }
1452         }
1453       else if (lex_match_id ("OCCURS"))
1454         {
1455           lex_match ('=');
1456           if (seen & 2)
1457             {
1458               msg (SE, _("%s subcommand given multiple times."),"OCCURS");
1459               goto error;
1460             }
1461           seen |= 2;
1462
1463           if (!parse_num_or_var (&rpd->occurs, "OCCURS"))
1464             goto error;
1465         }
1466       else if (lex_match_id ("LENGTH"))
1467         {
1468           lex_match ('=');
1469           if (seen & 4)
1470             {
1471               msg (SE, _("%s subcommand given multiple times."),"LENGTH");
1472               goto error;
1473             }
1474           seen |= 4;
1475
1476           if (!parse_num_or_var (&rpd->length, "LENGTH"))
1477             goto error;
1478         }
1479       else if (lex_match_id ("CONTINUED"))
1480         {
1481           lex_match ('=');
1482           if (seen & 8)
1483             {
1484               msg (SE, _("%s subcommand given multiple times."),"CONTINUED");
1485               goto error;
1486             }
1487           seen |= 8;
1488
1489           if (!lex_match ('/'))
1490             {
1491               if (!parse_num_or_var (&rpd->cont_beg, "CONTINUED beginning column"))
1492                 goto error;
1493
1494               lex_negative_to_dash ();
1495               if (lex_match ('-')
1496                   && !parse_num_or_var (&rpd->cont_end,
1497                                         "CONTINUED ending column"))
1498                 goto error;
1499
1500               if (rpd->cont_beg.num != 0 && rpd->cont_end.num != 0
1501                   && rpd->cont_beg.num > rpd->cont_end.num)
1502                 {
1503                   msg (SE, _("CONTINUED beginning column (%d) exceeds "
1504                              "CONTINUED ending column (%d)."),
1505                        rpd->cont_beg.num, rpd->cont_end.num);
1506                   goto error;
1507                 }
1508             }
1509           else
1510             rpd->cont_beg.num = 1;
1511         }
1512       else if (lex_match_id ("ID"))
1513         {
1514           lex_match ('=');
1515           if (seen & 16)
1516             {
1517               msg (SE, _("%s subcommand given multiple times."),"ID");
1518               goto error;
1519             }
1520           seen |= 16;
1521
1522           if (!lex_force_int ())
1523             goto error;
1524           if (lex_integer () < 1)
1525             {
1526               msg (SE, _("ID beginning column (%ld) must be positive."),
1527                    lex_integer ());
1528               goto error;
1529             }
1530           rpd->id_beg = lex_integer ();
1531
1532           lex_get ();
1533           lex_negative_to_dash ();
1534
1535           if (lex_match ('-'))
1536             {
1537               if (!lex_force_int ())
1538                 goto error;
1539               if (lex_integer () < 1)
1540                 {
1541                   msg (SE, _("ID ending column (%ld) must be positive."),
1542                        lex_integer ());
1543                   goto error;
1544                 }
1545               if (lex_integer () < rpd->id_end)
1546                 {
1547                   msg (SE, _("ID ending column (%ld) cannot be less than "
1548                              "ID beginning column (%d)."),
1549                        lex_integer (), rpd->id_beg);
1550                   goto error;
1551                 }
1552
1553               rpd->id_end = lex_integer ();
1554               lex_get ();
1555             }
1556           else rpd->id_end = rpd->id_beg;
1557
1558           if (!lex_force_match ('='))
1559             goto error;
1560           rpd->id_var = parse_variable ();
1561           if (rpd->id_var == NULL)
1562             goto error;
1563
1564           find_variable_input_spec (rpd->id_var, &rpd->id_spec);
1565           rpd->id_value = xmalloc (sizeof *rpd->id_value * rpd->id_var->nv);
1566         }
1567       else if (lex_match_id ("TABLE"))
1568         table = 1;
1569       else if (lex_match_id ("NOTABLE"))
1570         table = 0;
1571       else if (lex_match_id ("DATA"))
1572         break;
1573       else
1574         {
1575           lex_error (NULL);
1576           goto error;
1577         }
1578
1579       if (!lex_force_match ('/'))
1580         goto error;
1581     }
1582
1583   /* Comes here when DATA specification encountered. */
1584   if ((seen & (1 | 2)) != (1 | 2))
1585     {
1586       if ((seen & 1) == 0)
1587         msg (SE, _("Missing required specification STARTS."));
1588       if ((seen & 2) == 0)
1589         msg (SE, _("Missing required specification OCCURS."));
1590       goto error;
1591     }
1592
1593   /* Enforce ID restriction. */
1594   if ((seen & 16) && !(seen & 8))
1595     {
1596       msg (SE, _("ID specified without CONTINUED."));
1597       goto error;
1598     }
1599
1600   /* Calculate starts_end, cont_end if necessary. */
1601   if (rpd->starts_end.num == 0 && rpd->starts_end.var == NULL)
1602     rpd->starts_end.num = handle_get_record_width (fh);
1603   if (rpd->cont_end.num == 0 && rpd->starts_end.var == NULL)
1604     rpd->cont_end.num = handle_get_record_width (fh);
1605
1606   /* Calculate length if possible. */
1607   if ((seen & 4) == 0)
1608     {
1609       struct dls_var_spec *iter;
1610
1611       for (iter = rpd->first; iter; iter = iter->next)
1612         {
1613           if (iter->lc > rpd->length.num)
1614             rpd->length.num = iter->lc;
1615         }
1616       assert (rpd->length.num != 0);
1617     }
1618
1619   lex_match ('=');
1620   if (!parse_repeating_data (&rpd->first, &rpd->last))
1621     goto error;
1622
1623   if (table)
1624     dump_fixed_table (rpd->first, fh, rpd->last->rec);
1625
1626   {
1627     struct repeating_data_trns *new_trns;
1628
1629     rpd->h.proc = repeating_data_trns_proc;
1630     rpd->h.free = repeating_data_trns_free;
1631
1632     new_trns = xmalloc (sizeof *new_trns);
1633     memcpy (new_trns, &rpd, sizeof *new_trns);
1634     add_transformation ((struct trns_header *) new_trns);
1635   }
1636
1637   return lex_end_of_command ();
1638
1639  error:
1640   destroy_dls_var_spec (rpd->first);
1641   free (rpd->id_value);
1642   return CMD_FAILURE;
1643 }
1644
1645 /* Finds the input format specification for variable V and puts
1646    it in SPEC.  Because of the way that DATA LIST is structured,
1647    this is nontrivial. */
1648 static void
1649 find_variable_input_spec (struct variable *v, struct fmt_spec *spec)
1650 {
1651   int i;
1652
1653   for (i = 0; i < n_trns; i++)
1654     {
1655       struct data_list_pgm *pgm = (struct data_list_pgm *) t_trns[i];
1656
1657       if (pgm->h.proc == data_list_trns_proc)
1658         {
1659           struct dls_var_spec *iter;
1660
1661           for (iter = pgm->first; iter; iter = iter->next)
1662             if (iter->v == v)
1663               {
1664                 *spec = iter->input;
1665                 return;
1666               }
1667         }
1668     }
1669
1670   assert (0);
1671 }
1672
1673 /* Parses a number or a variable name from the syntax file and puts
1674    the results in VALUE.  Ensures that the number is at least 1; else
1675    emits an error based on MESSAGE.  Returns nonzero only if
1676    successful. */
1677 static int
1678 parse_num_or_var (struct rpd_num_or_var *value, const char *message)
1679 {
1680   if (token == T_ID)
1681     {
1682       value->num = 0;
1683       value->var = parse_variable ();
1684       if (value->var == NULL)
1685         return 0;
1686       if (value->var->type == ALPHA)
1687         {
1688           msg (SE, _("String variable not allowed here."));
1689           return 0;
1690         }
1691     }
1692   else if (lex_is_integer ())
1693     {
1694       value->num = lex_integer ();
1695
1696       if (value->num < 1)
1697         {
1698           msg (SE, _("%s (%d) must be at least 1."), message, value->num);
1699           return 0;
1700         }
1701
1702       lex_get ();
1703     } else {
1704       msg (SE, _("Variable or integer expected for %s."), message);
1705       return 0;
1706     }
1707   return 1;
1708 }
1709
1710 /* Parses data specifications for repeating data groups, adding
1711    them to the linked list with head FIRST and tail LAST.
1712    Returns nonzero only if successful.  */
1713 static int
1714 parse_repeating_data (struct dls_var_spec **first, struct dls_var_spec **last)
1715 {
1716   struct fixed_parsing_state fx;
1717   int i;
1718
1719   fx.recno = 0;
1720   fx.sc = 1;
1721
1722   while (token != '.')
1723     {
1724       if (!parse_DATA_LIST_vars (&fx.name, &fx.name_cnt, PV_NONE))
1725         return 0;
1726
1727       if (lex_is_number ())
1728         {
1729           if (!fixed_parse_compatible (&fx, first, last))
1730             goto fail;
1731         }
1732       else if (token == '(')
1733         {
1734           if (!fixed_parse_fortran (&fx, first, last))
1735             goto fail;
1736         }
1737       else
1738         {
1739           msg (SE, _("SPSS-like or FORTRAN-like format "
1740                "specification expected after variable names."));
1741           goto fail;
1742         }
1743
1744       for (i = 0; i < fx.name_cnt; i++)
1745         free (fx.name[i]);
1746       free (fx.name);
1747     }
1748   if (token != '.')
1749     {
1750       lex_error (_("expecting end of command"));
1751       return 0;
1752     }
1753
1754   return 1;
1755
1756  fail:
1757   for (i = 0; i < fx.name_cnt; i++)
1758     free (fx.name[i]);
1759   free (fx.name);
1760   return 0;
1761 }
1762
1763 /* Obtains the real value for rpd_num_or_var N in case C and returns
1764    it.  The valid range is nonnegative numbers, but numbers outside
1765    this range can be returned and should be handled by the caller as
1766    invalid. */
1767 static int
1768 realize_value (struct rpd_num_or_var *n, struct ccase *c)
1769 {
1770   if (n->num > 0)
1771     return n->num;
1772
1773   assert (n->num == 0);
1774   if (n->var != NULL)
1775     {
1776       double v = case_num (c, n->var->fv);
1777
1778       if (v == SYSMIS || v <= INT_MIN || v >= INT_MAX)
1779         return -1;
1780       else
1781         return v;
1782     }
1783   else
1784     return 0;
1785 }
1786
1787 /* Parameter record passed to rpd_parse_record(). */
1788 struct rpd_parse_info
1789   {
1790     struct repeating_data_trns *trns;  /* REPEATING DATA transformation. */
1791     const char *line;   /* Line being parsed. */
1792     size_t len;         /* Line length. */
1793     int beg, end;       /* First and last column of first occurrence. */
1794     int ofs;            /* Column offset between repeated occurrences. */
1795     struct ccase *c;    /* Case to fill in. */
1796     int verify_id;      /* Zero to initialize ID, nonzero to verify it. */
1797     int max_occurs;     /* Max number of occurrences to parse. */
1798   };
1799
1800 /* Parses one record of repeated data and outputs corresponding
1801    cases.  Returns number of occurrences parsed up to the
1802    maximum specified in INFO. */
1803 static int
1804 rpd_parse_record (const struct rpd_parse_info *info)
1805 {
1806   struct repeating_data_trns *t = info->trns;
1807   int cur = info->beg;
1808   int occurrences;
1809
1810   /* Handle record ID values. */
1811   if (t->id_beg != 0)
1812     {
1813       union value id_temp[MAX_ELEMS_PER_VALUE];
1814
1815       /* Parse record ID into V. */
1816       {
1817         struct data_in di;
1818
1819         data_in_finite_line (&di, info->line, info->len, t->id_beg, t->id_end);
1820         di.v = info->verify_id ? id_temp : t->id_value;
1821         di.flags = 0;
1822         di.f1 = t->id_beg;
1823         di.format = t->id_spec;
1824
1825         if (!data_in (&di))
1826           return 0;
1827       }
1828
1829       if (info->verify_id
1830           && compare_values (id_temp, t->id_value, t->id_var->width) != 0)
1831         {
1832           char expected_str [MAX_FORMATTED_LEN + 1];
1833           char actual_str [MAX_FORMATTED_LEN + 1];
1834
1835           data_out (expected_str, &t->id_var->print, t->id_value);
1836           expected_str[t->id_var->print.w] = '\0';
1837
1838           data_out (actual_str, &t->id_var->print, id_temp);
1839           actual_str[t->id_var->print.w] = '\0';
1840
1841           tmsg (SE, RPD_ERR,
1842                 _("Encountered mismatched record ID \"%s\" expecting \"%s\"."),
1843                 actual_str, expected_str);
1844
1845           return 0;
1846         }
1847     }
1848
1849   /* Iterate over the set of expected occurrences and record each of
1850      them as a separate case.  FIXME: We need to execute any
1851      transformations that follow the current one. */
1852   {
1853     int warned = 0;
1854
1855     for (occurrences = 0; occurrences < info->max_occurs; )
1856       {
1857         if (cur + info->ofs > info->end + 1)
1858           break;
1859         occurrences++;
1860
1861         {
1862           struct dls_var_spec *var_spec = t->first;
1863
1864           for (; var_spec; var_spec = var_spec->next)
1865             {
1866               int fc = var_spec->fc - 1 + cur;
1867               int lc = var_spec->lc - 1 + cur;
1868
1869               if (fc > info->len && !warned && var_spec->input.type != FMT_A)
1870                 {
1871                   warned = 1;
1872
1873                   tmsg (SW, RPD_ERR,
1874                         _("Variable %s starting in column %d extends "
1875                           "beyond physical record length of %d."),
1876                         var_spec->v->name, fc, info->len);
1877                 }
1878
1879               {
1880                 struct data_in di;
1881
1882                 data_in_finite_line (&di, info->line, info->len, fc, lc);
1883                 di.v = case_data_rw (info->c, var_spec->fv);
1884                 di.flags = 0;
1885                 di.f1 = fc + 1;
1886                 di.format = var_spec->input;
1887
1888                 if (!data_in (&di))
1889                   return 0;
1890               }
1891             }
1892         }
1893
1894         cur += info->ofs;
1895
1896         if (!t->write_case (t->wc_data))
1897           return 0;
1898       }
1899   }
1900
1901   return occurrences;
1902 }
1903
1904 /* Reads one set of repetitions of the elements in the REPEATING
1905    DATA structure.  Returns -1 on success, -2 on end of file or
1906    on failure. */
1907 int
1908 repeating_data_trns_proc (struct trns_header *trns, struct ccase *c,
1909                           int case_num UNUSED)
1910 {
1911   struct repeating_data_trns *t = (struct repeating_data_trns *) trns;
1912
1913   struct fixed_string line;       /* Current record. */
1914
1915   int starts_beg;       /* Starting column. */
1916   int starts_end;       /* Ending column. */
1917   int occurs;           /* Number of repetitions. */
1918   int length;           /* Length of each occurrence. */
1919   int cont_beg;         /* Starting column for continuation lines. */
1920   int cont_end;         /* Ending column for continuation lines. */
1921
1922   int occurs_left;      /* Number of occurrences remaining. */
1923
1924   int code;             /* Return value from rpd_parse_record(). */
1925
1926   int skip_first_record = 0;
1927
1928   dfm_push (t->reader);
1929
1930   /* Read the current record. */
1931   dfm_reread_record (t->reader, 1);
1932   dfm_expand_tabs (t->reader);
1933   if (dfm_eof (t->reader))
1934     return -2;
1935   dfm_get_record (t->reader, &line);
1936   dfm_forward_record (t->reader);
1937
1938   /* Calculate occurs, length. */
1939   occurs_left = occurs = realize_value (&t->occurs, c);
1940   if (occurs <= 0)
1941     {
1942       tmsg (SE, RPD_ERR, _("Invalid value %d for OCCURS."), occurs);
1943       return -3;
1944     }
1945   starts_beg = realize_value (&t->starts_beg, c);
1946   if (starts_beg <= 0)
1947     {
1948       tmsg (SE, RPD_ERR, _("Beginning column for STARTS (%d) must be "
1949                            "at least 1."),
1950             starts_beg);
1951       return -3;
1952     }
1953   starts_end = realize_value (&t->starts_end, c);
1954   if (starts_end < starts_beg)
1955     {
1956       tmsg (SE, RPD_ERR, _("Ending column for STARTS (%d) is less than "
1957                            "beginning column (%d)."),
1958             starts_end, starts_beg);
1959       skip_first_record = 1;
1960     }
1961   length = realize_value (&t->length, c);
1962   if (length < 0)
1963     {
1964       tmsg (SE, RPD_ERR, _("Invalid value %d for LENGTH."), length);
1965       length = 1;
1966       occurs = occurs_left = 1;
1967     }
1968   cont_beg = realize_value (&t->cont_beg, c);
1969   if (cont_beg < 0)
1970     {
1971       tmsg (SE, RPD_ERR, _("Beginning column for CONTINUED (%d) must be "
1972                            "at least 1."),
1973             cont_beg);
1974       return -2;
1975     }
1976   cont_end = realize_value (&t->cont_end, c);
1977   if (cont_end < cont_beg)
1978     {
1979       tmsg (SE, RPD_ERR, _("Ending column for CONTINUED (%d) is less than "
1980                            "beginning column (%d)."),
1981             cont_end, cont_beg);
1982       return -2;
1983     }
1984
1985   /* Parse the first record. */
1986   if (!skip_first_record)
1987     {
1988       struct rpd_parse_info info;
1989       info.trns = t;
1990       info.line = ls_c_str (&line);
1991       info.len = ls_length (&line);
1992       info.beg = starts_beg;
1993       info.end = starts_end;
1994       info.ofs = length;
1995       info.c = c;
1996       info.verify_id = 0;
1997       info.max_occurs = occurs_left;
1998       code = rpd_parse_record (&info);
1999       if (!code)
2000         return -2;
2001       occurs_left -= code;
2002     }
2003   else if (cont_beg == 0)
2004     return -3;
2005
2006   /* Make sure, if some occurrences are left, that we have
2007      continuation records. */
2008   if (occurs_left > 0 && cont_beg == 0)
2009     {
2010       tmsg (SE, RPD_ERR,
2011             _("Number of repetitions specified on OCCURS (%d) "
2012               "exceed number of repetitions available in "
2013               "space on STARTS (%d), and CONTINUED not specified."),
2014             occurs, (starts_end - starts_beg + 1) / length);
2015       return -2;
2016     }
2017
2018   /* Go on to additional records. */
2019   while (occurs_left != 0)
2020     {
2021       struct rpd_parse_info info;
2022
2023       assert (occurs_left >= 0);
2024
2025       /* Read in another record. */
2026       if (dfm_eof (t->reader))
2027         {
2028           tmsg (SE, RPD_ERR,
2029                 _("Unexpected end of file with %d repetitions "
2030                   "remaining out of %d."),
2031                 occurs_left, occurs);
2032           return -2;
2033         }
2034       dfm_expand_tabs (t->reader);
2035       dfm_get_record (t->reader, &line);
2036       dfm_forward_record (t->reader);
2037
2038       /* Parse this record. */
2039       info.trns = t;
2040       info.line = ls_c_str (&line);
2041       info.len = ls_length (&line);
2042       info.beg = cont_beg;
2043       info.end = cont_end;
2044       info.ofs = length;
2045       info.c = c;
2046       info.verify_id = 1;
2047       info.max_occurs = occurs_left;
2048       code = rpd_parse_record (&info);;
2049       if (!code)
2050         return -2;
2051       occurs_left -= code;
2052     }
2053
2054   dfm_pop (t->reader);
2055
2056   /* FIXME: This is a kluge until we've implemented multiplexing of
2057      transformations. */
2058   return -3;
2059 }
2060
2061 /* Frees a REPEATING DATA transformation. */
2062 void
2063 repeating_data_trns_free (struct trns_header *rpd_)
2064 {
2065   struct repeating_data_trns *rpd = (struct repeating_data_trns *) rpd_;
2066
2067   destroy_dls_var_spec (rpd->first);
2068   dfm_close_reader (rpd->reader);
2069   free (rpd->id_value);
2070 }
2071
2072 /* Lets repeating_data_trns_proc() know how to write the cases
2073    that it composes.  Not elegant. */
2074 void
2075 repeating_data_set_write_case (struct trns_header *trns,
2076                                write_case_func *write_case,
2077                                write_case_data wc_data)
2078 {
2079   struct repeating_data_trns *t = (struct repeating_data_trns *) trns;
2080
2081   assert (trns->proc == repeating_data_trns_proc);
2082   t->write_case = write_case;
2083   t->wc_data = wc_data;
2084 }