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