Add scratch file handles.
[pspp-builds.git] / src / print.c
index b3098d673a1bc5b6ac8dacf2df493156fb47a312..966c481395d9c924342a8fef156110677b044130 100644 (file)
@@ -14,8 +14,8 @@
 
    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
-   Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-   02111-1307, USA. */
+   Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+   02110-1301, USA. */
 
 /* FIXME: seems like a lot of code duplication with data-list.c. */
 
 #include "error.h"
 #include <stdlib.h>
 #include "alloc.h"
+#include "case.h"
 #include "command.h"
-#include "dfm.h"
+#include "dfm-write.h"
 #include "error.h"
-#include "expr.h"
+#include "expressions/public.h"
 #include "file-handle.h"
 #include "lexer.h"
 #include "misc.h"
@@ -34,6 +35,9 @@
 #include "tab.h"
 #include "var.h"
 
+#include "gettext.h"
+#define _(msgid) gettext (msgid)
+
 /* Describes what to do when an output field is encountered. */
 enum
   {
@@ -69,14 +73,14 @@ enum
     PRT_CMD_MASK = 1,          /* Command type mask. */
     PRT_PRINT = 0,             /* PRINT transformation identifier. */
     PRT_WRITE = 1,             /* WRITE transformation identifier. */
-    PRT_EJECT = 002            /* Can be combined with CMD_PRINT only. */
+    PRT_EJECT = 002,           /* Can be combined with CMD_PRINT only. */
+    PRT_BINARY = 004            /* File is binary, omit newlines. */
   };
 
 /* PRINT, PRINT EJECT, WRITE private data structure. */
 struct print_trns
   {
-    struct trns_header h;
-    struct file_handle *handle;        /* Output file, NULL=listing file. */
+    struct dfm_writer *writer; /* Output file, NULL=listing file. */
     int options;               /* PRT_* bitmapped field. */
     struct prt_out_spec *spec; /* Output specifications. */
     int max_width;             /* Maximum line width including null. */
@@ -99,8 +103,8 @@ static int internal_cmd_print (int flags);
 static trns_proc_func print_trns_proc;
 static trns_free_func print_trns_free;
 static int parse_specs (void);
-static void dump_table (void);
-static void append_var_spec (struct prt_out_spec *spec);
+static void dump_table (const struct file_handle *);
+static void append_var_spec (struct prt_out_spec *);
 static void alloc_line (void);
 \f
 /* Basic parsing. */
@@ -131,16 +135,12 @@ cmd_write (void)
 static int
 internal_cmd_print (int f)
 {
-  /* 0=print no table, 1=print table.  (TABLE subcommand.)  */
-  int table = 0;
-
-  /* malloc()'d transformation. */
-  struct print_trns *trns;
+  int table = 0;                /* Print table? */
+  struct print_trns *trns;      /* malloc()'d transformation. */
+  struct file_handle *fh = NULL;
 
   /* Fill in prt to facilitate error-handling. */
-  prt.h.proc = print_trns_proc;
-  prt.h.free = print_trns_free;
-  prt.handle = NULL;
+  prt.writer = NULL;
   prt.options = f;
   prt.spec = NULL;
   prt.line = NULL;
@@ -156,16 +156,16 @@ internal_cmd_print (int f)
        {
          lex_match ('=');
 
-         prt.handle = fh_parse_file_handle ();
-         if (!prt.handle)
-           goto lossage;
+         fh = fh_parse (FH_REF_FILE);
+         if (fh == NULL)
+           goto error;
        }
       else if (lex_match_id ("RECORDS"))
        {
          lex_match ('=');
          lex_match ('(');
          if (!lex_force_int ())
-           goto lossage;
+           goto error;
          nrec = lex_integer ();
          lex_get ();
          lex_match (')');
@@ -177,20 +177,27 @@ internal_cmd_print (int f)
       else
        {
          lex_error (_("expecting a valid subcommand"));
-         goto lossage;
+         goto error;
        }
     }
 
   /* Parse variables and strings. */
   if (!parse_specs ())
-    goto lossage;
-  
-  if (prt.handle != NULL && !dfm_open_for_writing (prt.handle))
-    goto lossage;
+    goto error;
+
+  if (fh != NULL)
+    {
+      prt.writer = dfm_open_writer (fh);
+      if (prt.writer == NULL)
+        goto error;
+
+      if (fh_get_mode (fh) == FH_MODE_BINARY)
+        prt.options |= PRT_BINARY;
+    }
 
   /* Output the variable table if requested. */
   if (table)
-    dump_table ();
+    dump_table (fh);
 
   /* Count the maximum line width.  Allocate linebuffer if
      applicable. */
@@ -199,12 +206,12 @@ internal_cmd_print (int f)
   /* Put the transformation in the queue. */
   trns = xmalloc (sizeof *trns);
   memcpy (trns, &prt, sizeof *trns);
-  add_transformation ((struct trns_header *) trns);
+  add_transformation (print_trns_proc, print_trns_free, trns);
 
   return CMD_SUCCESS;
 
lossage:
-  print_trns_free ((struct trns_header *) & prt);
error:
+  print_trns_free (&prt);
   return CMD_FAILURE;
 }
 
@@ -239,8 +246,8 @@ struct fmt_list
 static struct
   {
     struct variable **v;               /* variable list */
-    int nv;                    /* number of variables in list */
-    int cv;                    /* number of variables from list used up so far
+    size_t nv;                 /* number of variables in list */
+    size_t cv;                 /* number of variables from list used up so far
                                   by the FORTRAN-like format specifiers */
 
     int recno;                 /* current 1-based record number */
@@ -280,7 +287,7 @@ parse_specs (void)
          int prev_recno = fx.recno;
 
          fx.recno++;
-         if (token == T_NUM)
+         if (lex_is_number ())
            {
              if (!lex_force_int ())
                return 0;
@@ -342,7 +349,7 @@ parse_string_argument (void)
   lex_get ();
 
   /* Parse the included column range. */
-  if (token == T_NUM)
+  if (lex_is_number ())
     {
       /* Width of column range in characters. */
       int c_len;
@@ -353,7 +360,7 @@ parse_string_argument (void)
       /* 1-based index of last column in range. */
       int lc;
 
-      if (!lex_integer_p () || lex_integer () <= 0)
+      if (!lex_is_integer () || lex_integer () <= 0)
        {
          msg (SE, _("%g is not a valid column location."), tokval);
          goto fail;
@@ -364,7 +371,7 @@ parse_string_argument (void)
       lex_negative_to_dash ();
       if (lex_match ('-'))
        {
-         if (!lex_integer_p ())
+         if (!lex_is_integer ())
            {
              msg (SE, _("Column location expected following `%d-'."),
                   fx.spec.fc + 1);
@@ -427,7 +434,7 @@ parse_variable_argument (void)
   if (!parse_variables (default_dict, &fx.v, &fx.nv, PV_DUPLICATE))
     return 0;
 
-  if (token == T_NUM)
+  if (lex_is_number ())
     {
       if (!fixed_parse_compatible ())
        goto fail;
@@ -442,7 +449,7 @@ parse_variable_argument (void)
   else
     {
       /* User wants dictionary format specifiers. */
-      int i;
+      size_t i;
 
       lex_match ('*');
       for (i = 0; i < fx.nv; i++)
@@ -471,13 +478,28 @@ fail:
   return 0;
 }
 
+/* Verifies that FORMAT doesn't need a variable wider than WIDTH.
+   Returns true iff that is the case. */
+static bool
+check_string_width (const struct fmt_spec *format, const struct variable *v) 
+{
+  if (get_format_var_width (format) > v->width)
+    {
+      msg (SE, _("Variable %s has width %d so it cannot be output "
+                 "as format %s."),
+           v->name, v->width, fmt_to_string (format));
+      return false;
+    }
+  return true;
+}
+
 /* Parses a column specification for parse_specs(). */
 static int
 fixed_parse_compatible (void)
 {
-  int dividend;
+  int individual_var_width;
   int type;
-  int i;
+  size_t i;
 
   type = fx.v[0]->type;
   for (i = 1; i < fx.nv; i++)
@@ -546,7 +568,7 @@ fixed_parse_compatible (void)
       else
        fx.spec.u.v.f.type = FMT_F;
 
-      if (token == T_NUM)
+      if (lex_is_number ())
        {
          if (!lex_force_int ())
            return 0;
@@ -585,40 +607,28 @@ fixed_parse_compatible (void)
 
   if ((fx.lc - fx.fc + 1) % fx.nv)
     {
-      msg (SE, _("The %d columns %d-%d can't be evenly divided into %d "
-                "fields."), fx.lc - fx.fc + 1, fx.fc + 1, fx.lc + 1, fx.nv);
+      msg (SE, _("The %d columns %d-%d can't be evenly divided into %u "
+                "fields."),
+           fx.lc - fx.fc + 1, fx.fc + 1, fx.lc + 1, (unsigned) fx.nv);
       return 0;
     }
 
-  dividend = (fx.lc - fx.fc + 1) / fx.nv;
-  fx.spec.u.v.f.w = dividend;
-  if (!check_output_specifier (&fx.spec.u.v.f))
+  individual_var_width = (fx.lc - fx.fc + 1) / fx.nv;
+  fx.spec.u.v.f.w = individual_var_width;
+  if (!check_output_specifier (&fx.spec.u.v.f, true)
+      || !check_specifier_type (&fx.spec.u.v.f, type, true))
     return 0;
-  if ((type == ALPHA) ^ (formats[fx.spec.u.v.f.type].cat & FCAT_STRING))
-    {
-      msg (SE, _("%s variables cannot be displayed with format %s."),
-          type == ALPHA ? _("String") : _("Numeric"),
-          fmt_to_string (&fx.spec.u.v.f));
-      return 0;
-    }
-
-  /* Check that, for string variables, the user didn't specify a width
-     longer than an actual string width. */
   if (type == ALPHA)
     {
-      /* Minimum width of all the string variables specified. */
-      int min_len = fx.v[0]->width;
-
-      for (i = 1; i < fx.nv; i++)
-       min_len = min (min_len, fx.v[i]->width);
-      if (!check_string_specifier (&fx.spec.u.v.f, min_len))
-       return 0;
+      for (i = 0; i < fx.nv; i++)
+        if (!check_string_width (&fx.spec.u.v.f, fx.v[i]))
+          return false;
     }
 
   fx.spec.type = PRT_VAR;
   for (i = 0; i < fx.nv; i++)
     {
-      fx.spec.fc = fx.fc + dividend * i;
+      fx.spec.fc = fx.fc + individual_var_width * i;
       fx.spec.u.v.v = fx.v[i];
       append_var_spec (&fx.spec);
     }
@@ -627,7 +637,7 @@ fixed_parse_compatible (void)
 
 /* Destroy a format list and, optionally, all its sublists. */
 static void
-destroy_fmt_list (struct fmt_list * f, int recurse)
+destroy_fmt_list (struct fmt_list *f, int recurse)
 {
   struct fmt_list *next;
 
@@ -644,7 +654,7 @@ destroy_fmt_list (struct fmt_list * f, int recurse)
    FORTRAN-like format specifications, like 4(F10,2X)) into the
    structure prt. */
 static int
-dump_fmt_list (struct fmt_list * f)
+dump_fmt_list (struct fmt_list *f)
 {
   int i;
 
@@ -681,15 +691,10 @@ dump_fmt_list (struct fmt_list * f)
              }
 
            v = fx.v[fx.cv++];
-           if ((v->type == ALPHA) ^ (formats[f->f.type].cat & FCAT_STRING))
-             {
-               msg (SE, _("Display format %s may not be used with a "
-                          "%s variable."), fmt_to_string (&f->f),
-                    v->type == ALPHA ? _("string") : _("numeric"));
-               return 0;
-             }
-           if (!check_string_specifier (&f->f, v->width))
-             return 0;
+            if (!check_output_specifier (&f->f, true)
+                || !check_specifier_type (&f->f, v->type, true)
+                || !check_string_width (&f->f, v))
+              return false;
 
            fx.spec.type = PRT_VAR;
            fx.spec.u.v.v = v;
@@ -720,9 +725,9 @@ fixed_parse_fortran (void)
       else
        head = fl = xmalloc (sizeof *fl);
 
-      if (token == T_NUM)
+      if (lex_is_number ())
        {
-         if (!lex_integer_p ())
+         if (!lex_is_integer ())
            goto fail;
          fl->count = lex_integer ();
          lex_get ();
@@ -741,8 +746,8 @@ fixed_parse_fortran (void)
        }
       else if (lex_match ('/'))
        fl->f.type = FMT_NEWREC;
-      else if (!parse_format_specifier (&fl->f, 1)
-              || !check_output_specifier (&fl->f))
+      else if (!parse_format_specifier (&fl->f, FMTP_ALLOW_XT)
+              || !check_output_specifier (&fl->f, 1))
        goto fail;
 
       lex_match (',');
@@ -774,7 +779,7 @@ fail:
 /* Prints the table produced by the TABLE subcommand to the listing
    file. */
 static void
-dump_table (void)
+dump_table (const struct file_handle *fh)
 {
   struct prt_out_spec *spec;
   struct tab_table *t;
@@ -830,11 +835,13 @@ dump_table (void)
        assert (0);
       }
 
-  if (prt.handle != NULL)
-    tab_title (t, 1, _("Writing %d record(s) to file %s."),
-               recno, handle_get_filename (prt.handle));
+  if (fh != NULL)
+    tab_title (t, 1, ngettext ("Writing %d record to %s.",
+                               "Writing %d records to %s.", recno),
+               recno, fh_get_name (fh));
   else
-    tab_title (t, 1, _("Writing %d record(s) to the listing file."), recno);
+    tab_title (t, 1, ngettext ("Writing %d record.",
+                               "Writing %d records.", recno), recno);
   tab_submit (t);
 }
 
@@ -891,11 +898,10 @@ alloc_line (void)
 
 /* Performs the transformation inside print_trns T on case C. */
 static int
-print_trns_proc (struct trns_header * trns, struct ccase * c,
-                 int case_num UNUSED)
+print_trns_proc (void *trns_, struct ccase *c, int case_num UNUSED)
 {
   /* Transformation. */
-  struct print_trns *t = (struct print_trns *) trns;
+  struct print_trns *t = trns_;
 
   /* Iterator. */
   struct prt_out_spec *i;
@@ -910,15 +916,14 @@ print_trns_proc (struct trns_header * trns, struct ccase * c,
   if (t->options & PRT_EJECT)
     som_eject_page ();
 
-  /* Note that a field written to a place where a field has already
-     been written truncates the record.  `PRINT /A B (T10,F8,T1,F8).'
-     only outputs B.  This is an example of bug-for-bug compatibility,
-     in the author's opinion. */
+  /* Note that a field written to a place where a field has
+     already been written truncates the record.  `PRINT /A B
+     (T10,F8,T1,F8).' only outputs B.  */
   for (i = t->spec; i; i = i->next)
     switch (i->type)
       {
       case PRT_NEWLINE:
-       if (t->handle == NULL)
+       if (t->writer == NULL)
          {
            buf[len] = 0;
            tab_output_text (TAT_FIX | TAT_NOWRAP, buf);
@@ -926,7 +931,7 @@ print_trns_proc (struct trns_header * trns, struct ccase * c,
        else
          {
            if ((t->options & PRT_CMD_MASK) == PRT_PRINT
-               || handle_get_mode (t->handle) != MODE_BINARY)
+                || !(t->options & PRT_BINARY))
              {
                /* PORTME: Line ends. */
 #ifdef __MSDOS__
@@ -935,7 +940,7 @@ print_trns_proc (struct trns_header * trns, struct ccase * c,
                buf[len++] = '\n';
              }
 
-           dfm_put_record (t->handle, buf, len);
+           dfm_put_record (t->writer, buf, len);
          }
 
        memset (buf, ' ', t->max_width);
@@ -950,7 +955,7 @@ print_trns_proc (struct trns_header * trns, struct ccase * c,
        break;
 
       case PRT_VAR:
-        data_out (&buf[i->fc], &i->u.v.f, &c->data[i->u.v.v->fv]);
+        data_out (&buf[i->fc], &i->u.v.f, case_data (c, i->u.v.v->fv));
        len = i->fc + i->u.v.f.w;
        break;
 
@@ -969,11 +974,12 @@ print_trns_proc (struct trns_header * trns, struct ccase * c,
 
 /* Frees all the data inside print_trns T.  Does not free T. */
 static void
-print_trns_free (struct trns_header * t)
+print_trns_free (void *prt_)
 {
+  struct print_trns *prt = prt_;
   struct prt_out_spec *i, *n;
 
-  for (i = ((struct print_trns *) t)->spec; i; i = n)
+  for (i = prt->spec; i; i = n)
     {
       switch (i->type)
        {
@@ -992,7 +998,10 @@ print_trns_free (struct trns_header * t)
       n = i->next;
       free (i);
     }
-  free (((struct print_trns *) t)->line);
+  if (prt->writer != NULL)
+    dfm_close_writer (prt->writer);
+  free (prt->line);
+  free (prt);
 }
 \f
 /* PRINT SPACE. */
@@ -1000,9 +1009,7 @@ print_trns_free (struct trns_header * t)
 /* PRINT SPACE transformation. */
 struct print_space_trns
 {
-  struct trns_header h;
-
-  struct file_handle *handle;  /* Output file, NULL=listing file. */
+  struct dfm_writer *writer;    /* Output data file. */
   struct expression *e;                /* Number of lines; NULL=1. */
 }
 print_space_trns;
@@ -1014,24 +1021,25 @@ int
 cmd_print_space (void)
 {
   struct print_space_trns *t;
-  struct file_handle *handle;
+  struct file_handle *fh;
   struct expression *e;
+  struct dfm_writer *writer;
 
   if (lex_match_id ("OUTFILE"))
     {
       lex_match ('=');
 
-      handle = fh_parse_file_handle ();
-      if (handle == NULL)
+      fh = fh_parse (FH_REF_FILE);
+      if (fh == NULL)
        return CMD_FAILURE;
       lex_get ();
     }
   else
-    handle = NULL;
+    fh = NULL;
 
   if (token != '.')
     {
-      e = expr_parse (EXPR_NUMERIC);
+      e = expr_parse (default_dict, EXPR_NUMBER);
       if (token != '.')
        {
          expr_free (e);
@@ -1042,51 +1050,45 @@ cmd_print_space (void)
   else
     e = NULL;
 
-  if (handle != NULL && !dfm_open_for_writing (handle))
+  if (fh != NULL)
     {
-      expr_free (e);
-      return CMD_FAILURE;
+      writer = dfm_open_writer (fh);
+      if (writer == NULL) 
+        {
+          expr_free (e);
+          return CMD_FAILURE;
+        } 
     }
-
-  t = xmalloc (sizeof *t);
-  t->h.proc = print_space_trns_proc;
-  if (e)
-    t->h.free = print_space_trns_free;
   else
-    t->h.free = NULL;
-  t->handle = handle;
+    writer = NULL;
+  
+  t = xmalloc (sizeof *t);
+  t->writer = writer;
   t->e = e;
 
-  add_transformation ((struct trns_header *) t);
+  add_transformation (print_space_trns_proc, print_space_trns_free, t);
   return CMD_SUCCESS;
 }
 
 static int
-print_space_trns_proc (struct trns_header * trns, struct ccase * c,
+print_space_trns_proc (void *t_, struct ccase *c,
                        int case_num UNUSED)
 {
-  struct print_space_trns *t = (struct print_space_trns *) trns;
-  int n;
+  struct print_space_trns *t = t_;
+  double n = 1.;
 
   if (t->e)
     {
-      union value v;
-
-      expr_evaluate (t->e, c, case_num, &v);
-      n = v.f;
-      if (n < 0)
-       {
-         msg (SW, _("The expression on PRINT SPACE evaluated to %d.  It's "
-                    "not possible to PRINT SPACE a negative number of "
-                    "lines."),
-              n);
-         n = 1;
-       }
+      n = expr_evaluate_num (t->e, c, case_num);
+      if (n == SYSMIS) 
+        msg (SW, _("The expression on PRINT SPACE evaluated to the "
+                   "system-missing value."));
+      else if (n < 0)
+        msg (SW, _("The expression on PRINT SPACE evaluated to %g."), n);
+      n = 1.;
     }
-  else
-    n = 1;
 
-  if (t->handle == NULL)
+  if (t->writer == NULL)
     while (n--)
       som_blank_line ();
   else
@@ -1101,14 +1103,16 @@ print_space_trns_proc (struct trns_header * trns, struct ccase * c,
       buf[0] = '\n';
 #endif
       while (n--)
-       dfm_put_record (t->handle, buf, LINE_END_WIDTH);
+       dfm_put_record (t->writer, buf, LINE_END_WIDTH);
     }
 
   return -1;
 }
 
 static void
-print_space_trns_free (struct trns_header * trns)
+print_space_trns_free (void *trns_)
 {
-  expr_free (((struct print_space_trns *) trns)->e);
+  struct print_space_trns *trns = trns_;
+  expr_free (trns->e);
+  free (trns);
 }