Adopt use of gnulib for portability.
[pspp] / src / print.c
index b2ef755cf11bc3fde5f53b158d0e65e0f49604f2..ccbb8c8c2d69ef9579e48334fbcaaa8c456c935f 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. */
 
@@ -27,7 +27,7 @@
 #include "command.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"
@@ -35,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
   {
@@ -287,7 +290,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;
@@ -349,7 +352,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;
@@ -360,7 +363,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;
@@ -371,7 +374,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);
@@ -434,7 +437,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;
@@ -478,6 +481,21 @@ 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)
@@ -553,7 +571,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;
@@ -599,27 +617,14 @@ fixed_parse_compatible (void)
 
   dividend = (fx.lc - fx.fc + 1) / fx.nv;
   fx.spec.u.v.f.w = dividend;
-  if (!check_output_specifier (&fx.spec.u.v.f))
+  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;
@@ -688,15 +693,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;
@@ -727,9 +727,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 ();
@@ -748,8 +748,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 (',');
@@ -977,9 +977,10 @@ print_trns_proc (struct trns_header * trns, struct ccase * c,
 static void
 print_trns_free (struct trns_header * t)
 {
+  struct print_trns *prt = (struct print_trns *) t;
   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)
        {
@@ -998,7 +999,9 @@ 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);
 }
 \f
 /* PRINT SPACE. */
@@ -1038,7 +1041,7 @@ cmd_print_space (void)
 
   if (token != '.')
     {
-      e = expr_parse (EXPR_NUMERIC);
+      e = expr_parse (default_dict, EXPR_NUMBER);
       if (token != '.')
        {
          expr_free (e);
@@ -1079,25 +1082,18 @@ print_space_trns_proc (struct trns_header * trns, struct ccase * c,
                        int case_num UNUSED)
 {
   struct print_space_trns *t = (struct print_space_trns *) trns;
-  int n;
+  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->writer == NULL)
     while (n--)