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