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