src/language/utilities/set.q

   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., 51 Franklin Street, Fifth Floor, Boston, MA
  18    02110-1301, USA. */
  19
  20 #include <config.h>
  21
  22 #include <stdio.h>
  23 #include <errno.h>
  24 #include <stdlib.h>
  25 #include <time.h>
  26
  27 #include <data/dictionary.h>
  28 #include <data/format.h>
  29 #include <data/procedure.h>
  30 #include <data/settings.h>
  31 #include <data/variable.h>
  32 #include <language/command.h>
  33 #include <language/lexer/lexer.h>
  34 #include <language/line-buffer.h>
  35 #include <libpspp/alloc.h>
  36 #include <libpspp/compiler.h>
  37 #include <libpspp/copyleft.h>
  38 #include <libpspp/magic.h>
  39 #include <libpspp/message.h>
  40 #include <math/random.h>
  41 #include <output/output.h>
  42
  43 #if HAVE_LIBTERMCAP
  44 #if HAVE_TERMCAP_H
  45 #include <termcap.h>
  46 #else /* !HAVE_TERMCAP_H */
  47 int tgetent (char *, const char *);
  48 int tgetnum (const char *);
  49 #endif /* !HAVE_TERMCAP_H */
  50 #endif /* !HAVE_LIBTERMCAP */
  51
  52 #include "gettext.h"
  53 #define _(msgid) gettext (msgid)
  54
  55 /* (specification)
  56    "SET" (stc_):
  57      blanks=custom;
  58      block=string "x==1" "one character long";
  59      boxstring=string "x==3 || x==11" "3 or 11 characters long";
  60      case=size:upper/uplow;
  61      cca=string;
  62      ccb=string;
  63      ccc=string;
  64      ccd=string;
  65      cce=string;
  66      compression=compress:on/off;
  67      cpi=integer "x>0" "%s must be greater than 0";
  68      cprompt=string;
  69      decimal=dec:dot/comma;
  70      disk=custom;
  71      dprompt=string;
  72      echo=echo:on/off;
  73      endcmd=string "x==1" "one character long";
  74      epoch=custom;
  75      errorbreak=errbrk:on/off;
  76      errors=errors:on/off/terminal/listing/both/none;
  77      format=custom;
  78      headers=headers:no/yes/blank;
  79      highres=hires:on/off;
  80      histogram=string "x==1" "one character long";
  81      include=inc:on/off;
  82      journal=custom;
  83      length=custom;
  84      listing=custom;
  85      lowres=lores:auto/on/off;
  86      lpi=integer "x>0" "%s must be greater than 0";
  87      menus=menus:standard/extended;
  88      messages=messages:on/off/terminal/listing/both/none;
  89      mexpand=mexp:on/off;
  90      miterate=integer "x>0" "%s must be greater than 0";
  91      mnest=integer "x>0" "%s must be greater than 0";
  92      mprint=mprint:on/off;
  93      mxerrs=integer "x >= 1" "%s must be at least 1";
  94      mxloops=integer "x >=1" "%s must be at least 1";
  95      mxmemory=integer;
  96      mxwarns=integer;
  97      nulline=null:on/off;
  98      printback=prtbck:on/off;
  99      prompt=string;
 100      results=res:on/off/terminal/listing/both/none;
 101      safer=safe:on;
 102      scompression=scompress:on/off;
 103      scripttab=string "x==1" "one character long";
 104      seed=custom;
 105      tb1=string "x==3 || x==11" "3 or 11 characters long";
 106      tbfonts=string;
 107      undefined=undef:warn/nowarn;
 108      width=custom;
 109      workspace=integer "x>=1024" "%s must be at least 1 MB";
 110      xsort=xsort:yes/no.
 111 */
 112
 113 /* (headers) */
 114
 115 /* (declarations) */
 116
 117 /* (_functions) */
 118
 119 static bool do_cc (const char *cc_string, int idx);
 120
 121 int
 122 cmd_set (void)
 123 {
 124   struct cmd_set cmd;
 125   bool ok = true;
 126
 127   if (!parse_set (&cmd, NULL))
 128     return CMD_FAILURE;
 129
 130   if (cmd.sbc_cca)
 131     ok = ok && do_cc (cmd.s_cca, 0);
 132   if (cmd.sbc_ccb)
 133     ok = ok && do_cc (cmd.s_ccb, 1);
 134   if (cmd.sbc_ccc)
 135     ok = ok && do_cc (cmd.s_ccc, 2);
 136   if (cmd.sbc_ccd)
 137     ok = ok && do_cc (cmd.s_ccd, 3);
 138   if (cmd.sbc_cce)
 139     ok = ok && do_cc (cmd.s_cce, 4);
 140
 141   if (cmd.sbc_prompt)
 142     getl_set_prompt (GETL_PROMPT_FIRST, cmd.s_prompt);
 143   if (cmd.sbc_cprompt)
 144     getl_set_prompt (GETL_PROMPT_LATER, cmd.s_cprompt);
 145   if (cmd.sbc_dprompt)
 146     getl_set_prompt (GETL_PROMPT_DATA, cmd.s_dprompt);
 147
 148   if (cmd.sbc_decimal)
 149     set_decimal (cmd.dec == STC_DOT ? '.' : ',');
 150   if (cmd.sbc_echo)
 151     set_echo (cmd.echo == STC_ON);
 152   if (cmd.sbc_endcmd)
 153     set_endcmd (cmd.s_endcmd[0]);
 154   if (cmd.sbc_errorbreak)
 155     set_errorbreak (cmd.errbrk == STC_ON);
 156   if (cmd.sbc_include)
 157     set_include (cmd.inc == STC_ON);
 158   if (cmd.sbc_mxerrs)
 159     set_mxerrs (cmd.n_mxerrs[0]);
 160   if (cmd.sbc_mxwarns)
 161     set_mxwarns (cmd.n_mxwarns[0]);
 162   if (cmd.sbc_nulline)
 163     set_nulline (cmd.null == STC_ON);
 164   if (cmd.sbc_safer)
 165     set_safer_mode ();
 166   if (cmd.sbc_scompression)
 167     set_scompression (cmd.scompress == STC_ON);
 168   if (cmd.sbc_undefined)
 169     set_undefined (cmd.undef == STC_WARN);
 170   if (cmd.sbc_workspace)
 171     set_workspace (cmd.n_workspace[0] * 1024L);
 172
 173   if (cmd.sbc_block)
 174     msg (SW, _("%s is obsolete."), "BLOCK");
 175   if (cmd.sbc_boxstring)
 176     msg (SW, _("%s is obsolete."), "BOXSTRING");
 177   if (cmd.sbc_histogram)
 178     msg (SW, _("%s is obsolete."), "HISTOGRAM");
 179   if (cmd.sbc_menus)
 180     msg (SW, _("%s is obsolete."), "MENUS");
 181   if (cmd.sbc_xsort)
 182     msg (SW, _("%s is obsolete."), "XSORT");
 183   if (cmd.sbc_mxmemory)
 184     msg (SE, _("%s is obsolete."), "MXMEMORY");
 185   if (cmd.sbc_scripttab)
 186     msg (SE, _("%s is obsolete."), "SCRIPTTAB");
 187   if (cmd.sbc_tbfonts)
 188     msg (SW, _("%s is obsolete."), "TBFONTS");
 189   if (cmd.sbc_tb1 && cmd.s_tb1)
 190     msg (SW, _("%s is obsolete."), "TB1");
 191
 192   if (cmd.sbc_case)
 193     msg (SW, _("%s is not implemented."), "CASE");
 194
 195   if (cmd.sbc_compression)
 196     msg (SW, _("Active file compression is not implemented."));
 197
 198   return CMD_SUCCESS;
 199 }
 200
 201 /* Find the grouping characters in CC_STRING and set CC's
 202    grouping and decimal members appropriately.  Returns true if
 203    successful, false otherwise. */
 204 static bool
 205 find_cc_separators (const char *cc_string, struct custom_currency *cc)
 206 {
 207   const char *sp;
 208   int comma_cnt, dot_cnt;
 209
 210   /* Count commas and periods.  There must be exactly three of
 211      one or the other, except that an apostrophe acts escapes a
 212      following comma or period. */
 213   comma_cnt = dot_cnt = 0;
 214   for (sp = cc_string; *sp; sp++)
 215     if (*sp == ',')
 216       comma_cnt++;
 217     else if (*sp == '.')
 218       dot_cnt++;
 219     else if (*sp == '\'' && (sp[1] == '.' || sp[1] == ',' || sp[1] == '\''))
 220       sp++;
 221
 222   if ((comma_cnt == 3) == (dot_cnt == 3))
 223     return false;
 224
 225   if (comma_cnt == 3)
 226     {
 227       cc->decimal = '.';
 228       cc->grouping = ',';
 229     }
 230   else
 231     {
 232       cc->decimal = ',';
 233       cc->grouping = '.';
 234     }
 235   return true;
 236 }
 237
 238 /* Extracts a token from IN into TOKEn.  Tokens are delimited by
 239    GROUPING.  The token is truncated to at most CC_WIDTH
 240    characters (including null terminator).  Returns the first
 241    character following the token. */
 242 static const char *
 243 extract_cc_token (const char *in, int grouping, char token[CC_WIDTH])
 244 {
 245   char *out = token;
 246
 247   for (; *in != '\0' && *in != grouping; in++)
 248     {
 249       if (*in == '\'' && in[1] == grouping)
 250         in++;
 251       if (out < &token[CC_WIDTH - 1])
 252         *out++ = *in;
 253     }
 254   *out = '\0';
 255
 256   if (*in == grouping)
 257     in++;
 258   return in;
 259 }
 260
 261 /* Sets custom currency specifier CC having name CC_NAME ('A' through
 262    'E') to correspond to the settings in CC_STRING. */
 263 static bool
 264 do_cc (const char *cc_string, int idx)
 265 {
 266   struct custom_currency cc;
 267
 268   /* Determine separators. */
 269   if (!find_cc_separators (cc_string, &cc))
 270     {
 271       msg (SE, _("CC%c: Custom currency string `%s' does not contain "
 272                  "exactly three periods or commas (not both)."),
 273            "ABCDE"[idx], cc_string);
 274       return false;
 275     }
 276
 277   cc_string = extract_cc_token (cc_string, cc.grouping, cc.neg_prefix);
 278   cc_string = extract_cc_token (cc_string, cc.grouping, cc.prefix);
 279   cc_string = extract_cc_token (cc_string, cc.grouping, cc.suffix);
 280   cc_string = extract_cc_token (cc_string, cc.grouping, cc.neg_suffix);
 281
 282   set_cc (idx, &cc);
 283
 284   return true;
 285 }
 286
 287 /* Parses the BLANKS subcommand, which controls the value that
 288    completely blank fields in numeric data imply.  X, Wnd: Syntax is
 289    SYSMIS or a numeric value. */
 290 static int
 291 stc_custom_blanks (struct cmd_set *cmd UNUSED, void *aux UNUSED)
 292 {
 293   lex_match ('=');
 294   if ((token == T_ID && lex_id_match ("SYSMIS", tokid)))
 295     {
 296       lex_get ();
 297       set_blanks (SYSMIS);
 298     }
 299   else
 300     {
 301       if (!lex_force_num ())
 302         return 0;
 303       set_blanks (lex_number ());
 304       lex_get ();
 305     }
 306   return 1;
 307 }
 308
 309 /* Parses the EPOCH subcommand, which controls the epoch used for
 310    parsing 2-digit years. */
 311 static int
 312 stc_custom_epoch (struct cmd_set *cmd UNUSED, void *aux UNUSED)
 313 {
 314   lex_match ('=');
 315   if (lex_match_id ("AUTOMATIC"))
 316     set_epoch (-1);
 317   else if (lex_is_integer ())
 318     {
 319       int new_epoch = lex_integer ();
 320       lex_get ();
 321       if (new_epoch < 1500)
 322         {
 323           msg (SE, _("EPOCH must be 1500 or later."));
 324           return 0;
 325         }
 326       set_epoch (new_epoch);
 327     }
 328   else
 329     {
 330       lex_error (_("expecting AUTOMATIC or year"));
 331       return 0;
 332     }
 333
 334   return 1;
 335 }
 336
 337 static int
 338 stc_custom_length (struct cmd_set *cmd UNUSED, void *aux UNUSED)
 339 {
 340   int page_length;
 341
 342   lex_match ('=');
 343   if (lex_match_id ("NONE"))
 344     page_length = -1;
 345   else
 346     {
 347       if (!lex_force_int ())
 348         return 0;
 349       if (lex_integer () < 1)
 350         {
 351           msg (SE, _("LENGTH must be at least 1."));
 352           return 0;
 353         }
 354       page_length = lex_integer ();
 355       lex_get ();
 356     }
 357
 358   if (page_length != -1)
 359     set_viewlength (page_length);
 360
 361   return 1;
 362 }
 363
 364 static int
 365 stc_custom_seed (struct cmd_set *cmd UNUSED, void *aux UNUSED)
 366 {
 367   lex_match ('=');
 368   if (lex_match_id ("RANDOM"))
 369     set_rng (time (0));
 370   else
 371     {
 372       if (!lex_force_num ())
 373         return 0;
 374       set_rng (lex_number ());
 375       lex_get ();
 376     }
 377
 378   return 1;
 379 }
 380
 381 static int
 382 stc_custom_width (struct cmd_set *cmd UNUSED, void *aux UNUSED)
 383 {
 384   lex_match ('=');
 385   if (lex_match_id ("NARROW"))
 386     set_viewwidth (79);
 387   else if (lex_match_id ("WIDE"))
 388     set_viewwidth (131);
 389   else
 390     {
 391       if (!lex_force_int ())
 392         return 0;
 393       if (lex_integer () < 40)
 394         {
 395           msg (SE, _("WIDTH must be at least 40."));
 396           return 0;
 397         }
 398       set_viewwidth (lex_integer ());
 399       lex_get ();
 400     }
 401
 402   return 1;
 403 }
 404
 405 /* Parses FORMAT subcommand, which consists of a numeric format
 406    specifier. */
 407 static int
 408 stc_custom_format (struct cmd_set *cmd UNUSED, void *aux UNUSED)
 409 {
 410   struct fmt_spec fmt;
 411
 412   lex_match ('=');
 413   if (!parse_format_specifier (&fmt, 0))
 414     return 0;
 415   if ((formats[fmt.type].cat & FCAT_STRING) != 0)
 416     {
 417       msg (SE, _("FORMAT requires numeric output format as an argument.  "
 418                  "Specified format %s is of type string."),
 419            fmt_to_string (&fmt));
 420       return 0;
 421     }
 422
 423   set_format (&fmt);
 424   return 1;
 425 }
 426
 427 static int
 428 stc_custom_journal (struct cmd_set *cmd UNUSED, void *aux UNUSED)
 429 {
 430   lex_match ('=');
 431   if (!lex_match_id ("ON") && !lex_match_id ("OFF"))
 432     {
 433       if (token == T_STRING)
 434         lex_get ();
 435       else
 436         {
 437           lex_error (NULL);
 438           return 0;
 439         }
 440     }
 441   return 1;
 442 }
 443
 444 static int
 445 stc_custom_listing (struct cmd_set *cmd UNUSED, void *aux UNUSED)
 446 {
 447   bool listing;
 448
 449   lex_match ('=');
 450   if (lex_match_id ("ON") || lex_match_id ("YES"))
 451     listing = true;
 452   else if (lex_match_id ("OFF") || lex_match_id ("NO"))
 453     listing = false;
 454   else
 455     {
 456       /* FIXME */
 457       return 0;
 458     }
 459   outp_enable_device (listing, OUTP_DEV_LISTING);
 460
 461   return 1;
 462 }
 463
 464 static int
 465 stc_custom_disk (struct cmd_set *cmd UNUSED, void *aux)
 466 {
 467   return stc_custom_listing (cmd, aux);
 468 }
 469 \f
 470 static void
 471 show_blanks (void)
 472 {
 473   if (get_blanks () == SYSMIS)
 474     msg (SN, _("BLANKS is SYSMIS."));
 475   else
 476     msg (SN, _("BLANKS is %g."), get_blanks ());
 477
 478 }
 479
 480 static char *
 481 format_cc (const char *in, char grouping, char *out)
 482 {
 483   while (*in != '\0')
 484     {
 485       if (*in == grouping || *in == '\'')
 486         *out++ = '\'';
 487       *out++ = *in++;
 488     }
 489   return out;
 490 }
 491
 492 static void
 493 show_cc (int idx)
 494 {
 495   const struct custom_currency *cc = get_cc (idx);
 496   char cc_string[CC_WIDTH * 4 * 2 + 3 + 1];
 497   char *out;
 498
 499   out = format_cc (cc->neg_prefix, cc->grouping, cc_string);
 500   *out++ = cc->grouping;
 501   out = format_cc (cc->prefix, cc->grouping, out);
 502   *out++ = cc->grouping;
 503   out = format_cc (cc->suffix, cc->grouping, out);
 504   *out++ = cc->grouping;
 505   out = format_cc (cc->neg_suffix, cc->grouping, out);
 506   *out = '\0';
 507
 508   msg (SN, _("CC%c is \"%s\"."), "ABCDE"[idx], cc_string);
 509 }
 510
 511
 512 static void
 513 show_cca (void)
 514 {
 515   show_cc (0);
 516 }
 517
 518 static void
 519 show_ccb (void)
 520 {
 521   show_cc (1);
 522 }
 523
 524 static void
 525 show_ccc (void)
 526 {
 527   show_cc (2);
 528 }
 529
 530 static void
 531 show_ccd (void)
 532 {
 533   show_cc (3);
 534 }
 535
 536 static void
 537 show_cce (void)
 538 {
 539   show_cc (4);
 540 }
 541
 542 static void
 543 show_decimals (void)
 544 {
 545   msg (SN, _("DECIMAL is \"%c\"."), get_decimal ());
 546 }
 547
 548 static void
 549 show_endcmd (void)
 550 {
 551   msg (SN, _("ENDCMD is \"%c\"."), get_endcmd ());
 552 }
 553
 554 static void
 555 show_format (void)
 556 {
 557   msg (SN, _("FORMAT is %s."), fmt_to_string (get_format ()));
 558 }
 559
 560 static void
 561 show_length (void)
 562 {
 563   msg (SN, _("LENGTH is %d."), get_viewlength ());
 564 }
 565
 566 static void
 567 show_mxerrs (void)
 568 {
 569   msg (SN, _("MXERRS is %d."), get_mxerrs ());
 570 }
 571
 572 static void
 573 show_mxloops (void)
 574 {
 575   msg (SN, _("MXLOOPS is %d."), get_mxloops ());
 576 }
 577
 578 static void
 579 show_mxwarns (void)
 580 {
 581   msg (SN, _("MXWARNS is %d."), get_mxwarns ());
 582 }
 583
 584 static void
 585 show_scompression (void)
 586 {
 587   if (get_scompression ())
 588     msg (SN, _("SCOMPRESSION is ON."));
 589   else
 590     msg (SN, _("SCOMPRESSION is OFF."));
 591 }
 592
 593 static void
 594 show_undefined (void)
 595 {
 596   if (get_undefined ())
 597     msg (SN, _("UNDEFINED is WARN."));
 598   else
 599     msg (SN, _("UNDEFINED is NOWARN."));
 600 }
 601
 602 static void
 603 show_weight (void)
 604 {
 605   struct variable *var = dict_get_weight (default_dict);
 606   if (var == NULL)
 607     msg (SN, _("WEIGHT is off."));
 608   else
 609     msg (SN, _("WEIGHT is variable %s."), var->name);
 610 }
 611
 612 static void
 613 show_width (void)
 614 {
 615   msg (SN, _("WIDTH is %d."), get_viewwidth ());
 616 }
 617
 618 struct show_sbc
 619   {
 620     const char *name;
 621     void (*function) (void);
 622   };
 623
 624 struct show_sbc show_table[] =
 625   {
 626     {"BLANKS", show_blanks},
 627     {"CCA", show_cca},
 628     {"CCB", show_ccb},
 629     {"CCC", show_ccc},
 630     {"CCD", show_ccd},
 631     {"CCE", show_cce},
 632     {"DECIMALS", show_decimals},
 633     {"ENDCMD", show_endcmd},
 634     {"FORMAT", show_format},
 635     {"LENGTH", show_length},
 636     {"MXERRS", show_mxerrs},
 637     {"MXLOOPS", show_mxloops},
 638     {"MXWARNS", show_mxwarns},
 639     {"SCOMPRESSION", show_scompression},
 640     {"UNDEFINED", show_undefined},
 641     {"WEIGHT", show_weight},
 642     {"WIDTH", show_width},
 643   };
 644
 645 static void
 646 show_all (void)
 647 {
 648   size_t i;
 649
 650   for (i = 0; i < sizeof show_table / sizeof *show_table; i++)
 651     show_table[i].function ();
 652 }
 653
 654 static void
 655 show_all_cc (void)
 656 {
 657   int i;
 658
 659   for (i = 0; i < 5; i++)
 660     show_cc (i);
 661 }
 662
 663 static void
 664 show_warranty (void)
 665 {
 666   msg (MN, lack_of_warranty);
 667 }
 668
 669 static void
 670 show_copying (void)
 671 {
 672   msg (MN, copyleft);
 673 }
 674
 675 int
 676 cmd_show (void)
 677 {
 678   if (token == '.')
 679     {
 680       show_all ();
 681       return CMD_SUCCESS;
 682     }
 683
 684   do
 685     {
 686       if (lex_match (T_ALL))
 687         show_all ();
 688       else if (lex_match_id ("CC"))
 689         show_all_cc ();
 690       else if (lex_match_id ("WARRANTY"))
 691         show_warranty ();
 692       else if (lex_match_id ("COPYING"))
 693         show_copying ();
 694       else if (token == T_ID)
 695         {
 696           int i;
 697
 698           for (i = 0; i < sizeof show_table / sizeof *show_table; i++)
 699             if (lex_match_id (show_table[i].name))
 700               {
 701                 show_table[i].function ();
 702                 goto found;
 703               }
 704           lex_error (NULL);
 705           return CMD_FAILURE;
 706
 707         found: ;
 708         }
 709       else
 710         {
 711           lex_error (NULL);
 712           return CMD_FAILURE;
 713         }
 714
 715       lex_match ('/');
 716     }
 717   while (token != '.');
 718
 719   return CMD_SUCCESS;
 720 }
 721
 722 /*
 723    Local Variables:
 724    mode: c
 725    End:
 726 */