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