git.maemo.org Git - gnuplot/blob - src/util.c

   1 #ifndef lint
   2 static char *RCSid() { return RCSid("$Id: util.c,v 1.65.2.9 2009/02/05 17:17:25 sfeam Exp $"); }
   3 #endif
   4
   5 /* GNUPLOT - util.c */
   6
   7 /*[
   8  * Copyright 1986 - 1993, 1998, 2004   Thomas Williams, Colin Kelley
   9  *
  10  * Permission to use, copy, and distribute this software and its
  11  * documentation for any purpose with or without fee is hereby granted,
  12  * provided that the above copyright notice appear in all copies and
  13  * that both that copyright notice and this permission notice appear
  14  * in supporting documentation.
  15  *
  16  * Permission to modify the software is granted, but not the right to
  17  * distribute the complete modified source code.  Modifications are to
  18  * be distributed as patches to the released version.  Permission to
  19  * distribute binaries produced by compiling modified sources is granted,
  20  * provided you
  21  *   1. distribute the corresponding source modifications from the
  22  *    released version in the form of a patch file along with the binaries,
  23  *   2. add special version identification to distinguish your version
  24  *    in addition to the base release version number,
  25  *   3. provide your name and address as the primary contact for the
  26  *    support of your modified version, and
  27  *   4. retain our contact information in regard to use of the base
  28  *    software.
  29  * Permission to distribute the released version of the source code along
  30  * with corresponding source modifications in the form of a patch file is
  31  * granted with same provisions 2 through 4 for binary distributions.
  32  *
  33  * This software is provided "as is" without express or implied warranty
  34  * to the extent permitted by applicable law.
  35 ]*/
  36
  37 #include "util.h"
  38
  39 #include "alloc.h"
  40 #include "command.h"
  41 #include "datafile.h"           /* for df_showdata and df_reset_after_error */
  42 #include "misc.h"
  43 #include "plot.h"
  44 /*  #include "setshow.h" */             /* for month names etc */
  45 #include "term_api.h"           /* for term_end_plot() used by graph_error() */
  46
  47 #if defined(HAVE_DIRENT_H)
  48 # include <sys/types.h>
  49 # include <dirent.h>
  50 #elif defined(_Windows)
  51 # include <windows.h>
  52 #endif
  53
  54 #if defined(HAVE_PWD_H)
  55 # include <sys/types.h>
  56 # include <pwd.h>
  57 #elif defined(_Windows)
  58 # include <windows.h>
  59 # if !defined(INFO_BUFFER_SIZE)
  60 #  define INFO_BUFFER_SIZE 32767
  61 # endif
  62 #endif
  63
  64 /* Exported (set-table) variables */
  65
  66 /* decimal sign */
  67 char *decimalsign = NULL;
  68
  69 const char *current_prompt = NULL; /* to be set by read_line() */
  70
  71 /* internal prototypes */
  72
  73 static void mant_exp __PROTO((double, double, TBOOLEAN, double *, int *, const char *));
  74 static void parse_sq __PROTO((char *));
  75
  76 #if 0 /* UNUSED */
  77 /*
  78  * chr_in_str() compares the characters in the string of token number t_num
  79  * with c, and returns TRUE if a match was found.
  80  */
  81 int
  82 chr_in_str(int t_num, int c)
  83 {
  84     int i;
  85
  86     if (!token[t_num].is_token)
  87         return (FALSE);         /* must be a value--can't be equal */
  88     for (i = 0; i < token[t_num].length; i++) {
  89         if (input_line[token[t_num].start_index + i] == c)
  90             return (TRUE);
  91     }
  92     return FALSE;
  93 }
  94 #endif
  95
  96 /*
  97  * equals() compares string value of token number t_num with str[], and
  98  *   returns TRUE if they are identical.
  99  */
 100 int
 101 equals(int t_num, const char *str)
 102 {
 103     int i;
 104
 105     if (!token[t_num].is_token)
 106         return (FALSE);         /* must be a value--can't be equal */
 107     for (i = 0; i < token[t_num].length; i++) {
 108         if (gp_input_line[token[t_num].start_index + i] != str[i])
 109             return (FALSE);
 110     }
 111     /* now return TRUE if at end of str[], FALSE if not */
 112     return (str[i] == NUL);
 113 }
 114
 115
 116
 117 /*
 118  * almost_equals() compares string value of token number t_num with str[], and
 119  *   returns TRUE if they are identical up to the first $ in str[].
 120  */
 121 int
 122 almost_equals(int t_num, const char *str)
 123 {
 124     int i;
 125     int after = 0;
 126     int start = token[t_num].start_index;
 127     int length = token[t_num].length;
 128
 129     if (!str)
 130         return FALSE;
 131     if (!token[t_num].is_token)
 132         return FALSE;           /* must be a value--can't be equal */
 133     for (i = 0; i < length + after; i++) {
 134         if (str[i] != gp_input_line[start + i]) {
 135             if (str[i] != '$')
 136                 return (FALSE);
 137             else {
 138                 after = 1;
 139                 start--;        /* back up token ptr */
 140             }
 141         }
 142     }
 143
 144     /* i now beyond end of token string */
 145
 146     return (after || str[i] == '$' || str[i] == NUL);
 147 }
 148
 149
 150
 151 int
 152 isstring(int t_num)
 153 {
 154
 155     return (token[t_num].is_token &&
 156             (gp_input_line[token[t_num].start_index] == '\'' ||
 157              gp_input_line[token[t_num].start_index] == '"'));
 158 }
 159
 160 /* Test for the existence of a variable without triggering errors.
 161  * Return values:
 162  *  0   variable does not exist or is not defined
 163  * >0   type of variable: INTGR, CMPLX, STRING
 164  */
 165 int
 166 type_udv(int t_num)
 167 {
 168     struct udvt_entry **udv_ptr = &first_udv;
 169
 170     while (*udv_ptr) {
 171         if (equals(t_num, (*udv_ptr)->udv_name)) {
 172             if ((*udv_ptr)->udv_undef)
 173                 return 0;
 174             else
 175                 return (*udv_ptr)->udv_value.type;
 176             }
 177         udv_ptr = &((*udv_ptr)->next_udv);
 178     }
 179     return 0;
 180 }
 181
 182 int
 183 isanumber(int t_num)
 184 {
 185     return (!token[t_num].is_token);
 186 }
 187
 188
 189 int
 190 isletter(int t_num)
 191 {
 192     return (token[t_num].is_token &&
 193             ((isalpha((unsigned char) gp_input_line[token[t_num].start_index])) ||
 194              (gp_input_line[token[t_num].start_index] == '_')));
 195 }
 196
 197
 198 /*
 199  * is_definition() returns TRUE if the next tokens are of the form
 200  *   identifier =
 201  *              -or-
 202  *   identifier ( identifer {,identifier} ) =
 203  */
 204 int
 205 is_definition(int t_num)
 206 {
 207     /* variable? */
 208     if (isletter(t_num) && equals(t_num + 1, "="))
 209         return 1;
 210
 211     /* function? */
 212     /* look for dummy variables */
 213     if (isletter(t_num) && equals(t_num + 1, "(") && isletter(t_num + 2)) {
 214         t_num += 3;             /* point past first dummy */
 215         while (equals(t_num, ",")) {
 216             if (!isletter(++t_num))
 217                 return 0;
 218             t_num += 1;
 219         }
 220         return (equals(t_num, ")") && equals(t_num + 1, "="));
 221     }
 222     /* neither */
 223     return 0;
 224 }
 225
 226
 227
 228 /*
 229  * copy_str() copies the string in token number t_num into str, appending
 230  *   a null.  No more than max chars are copied (including \0).
 231  */
 232 void
 233 copy_str(char *str, int t_num, int max)
 234 {
 235     int i = 0;
 236     int start = token[t_num].start_index;
 237     int count = token[t_num].length;
 238
 239     if (count >= max) {
 240         count = max - 1;
 241         FPRINTF((stderr, "str buffer overflow in copy_str"));
 242     }
 243
 244     do {
 245         str[i++] = gp_input_line[start++];
 246     } while (i != count);
 247     str[i] = NUL;
 248
 249 }
 250
 251 /* length of token string */
 252 size_t
 253 token_len(int t_num)
 254 {
 255     return (size_t)(token[t_num].length);
 256 }
 257
 258 /*
 259  * quote_str() does the same thing as copy_str, except it ignores the
 260  *   quotes at both ends.  This seems redundant, but is done for
 261  *   efficency.
 262  */
 263 void
 264 quote_str(char *str, int t_num, int max)
 265 {
 266     int i = 0;
 267     int start = token[t_num].start_index + 1;
 268     int count;
 269
 270     if ((count = token[t_num].length - 2) >= max) {
 271         count = max - 1;
 272         FPRINTF((stderr, "str buffer overflow in quote_str"));
 273     }
 274     if (count > 0) {
 275         do {
 276             str[i++] = gp_input_line[start++];
 277         } while (i != count);
 278     }
 279     str[i] = NUL;
 280     /* convert \t and \nnn (octal) to char if in double quotes */
 281     if (gp_input_line[token[t_num].start_index] == '"')
 282         parse_esc(str);
 283     else
 284         parse_sq(str);
 285 }
 286
 287
 288 /*
 289  * capture() copies into str[] the part of gp_input_line[] which lies between
 290  * the begining of token[start] and end of token[end].
 291  */
 292 void
 293 capture(char *str, int start, int end, int max)
 294 {
 295     int i, e;
 296
 297     e = token[end].start_index + token[end].length;
 298     if (e - token[start].start_index >= max) {
 299         e = token[start].start_index + max - 1;
 300         FPRINTF((stderr, "str buffer overflow in capture"));
 301     }
 302     for (i = token[start].start_index; i < e && gp_input_line[i] != NUL; i++)
 303         *str++ = gp_input_line[i];
 304     *str = NUL;
 305 }
 306
 307
 308 /*
 309  * m_capture() is similar to capture(), but it mallocs storage for the
 310  * string.
 311  */
 312 void
 313 m_capture(char **str, int start, int end)
 314 {
 315     int i, e;
 316     char *s;
 317
 318     e = token[end].start_index + token[end].length;
 319     *str = gp_realloc(*str, (e - token[start].start_index + 1), "string");
 320     s = *str;
 321     for (i = token[start].start_index; i < e && gp_input_line[i] != NUL; i++)
 322         *s++ = gp_input_line[i];
 323     *s = NUL;
 324 }
 325
 326
 327 /*
 328  * m_quote_capture() is similar to m_capture(), but it removes
 329  * quotes from either end of the string.
 330  */
 331 void
 332 m_quote_capture(char **str, int start, int end)
 333 {
 334     int i, e;
 335     char *s;
 336
 337     e = token[end].start_index + token[end].length - 1;
 338     *str = gp_realloc(*str, (e - token[start].start_index + 1), "string");
 339     s = *str;
 340     for (i = token[start].start_index + 1; i < e && gp_input_line[i] != NUL; i++)
 341         *s++ = gp_input_line[i];
 342     *s = NUL;
 343
 344     if (gp_input_line[token[start].start_index] == '"')
 345         parse_esc(*str);
 346     else
 347         parse_sq(*str);
 348
 349 }
 350
 351 /*
 352  * Wrapper for isstring + m_quote_capture that can be used with
 353  * or without GP_STRING_VARS enabled.
 354  * EAM Aug 2004
 355  */
 356 char *
 357 try_to_get_string()
 358 {
 359     char *newstring = NULL;
 360
 361 #ifdef GP_STRING_VARS
 362     struct value a;
 363     int save_token = c_token;
 364     if (END_OF_COMMAND)
 365         return NULL;
 366     const_string_express(&a);
 367     if (a.type == STRING)
 368         newstring = a.v.string_val;
 369     else
 370         c_token = save_token;
 371 #else
 372     if (!END_OF_COMMAND && isstring(c_token)) {
 373         m_quote_capture(&newstring, c_token, c_token);
 374         c_token++;
 375     }
 376 #endif
 377
 378     return newstring;
 379 }
 380
 381
 382 /* Our own version of strdup()
 383  * Make copy of string into gp_alloc'd memory
 384  * As with all conforming str*() functions,
 385  * it is the caller's responsibility to pass
 386  * valid parameters!
 387  */
 388 char *
 389 gp_strdup(const char *s)
 390 {
 391     char *d;
 392
 393     if (!s)
 394         return NULL;
 395
 396 #ifndef HAVE_STRDUP
 397     d = gp_alloc(strlen(s) + 1, "gp_strdup");
 398     if (d)
 399         memcpy (d, s, strlen(s) + 1);
 400 #else
 401     d = strdup(s);
 402 #endif
 403     return d;
 404 }
 405
 406 /*
 407  * Allocate a new string and initialize it by concatenating two
 408  * existing strings.
 409  */
 410 char *
 411 gp_stradd(const char *a, const char *b)
 412 {
 413     char *new = gp_alloc(strlen(a)+strlen(b)+1,"gp_stradd");
 414     strcpy(new,a);
 415     strcat(new,b);
 416     return new;
 417 }
 418
 419 /* HBB 20020405: moved these functions here from axis.c, where they no
 420  * longer truly belong. */
 421 /*{{{  mant_exp - split into mantissa and/or exponent */
 422 /* HBB 20010121: added code that attempts to fix rounding-induced
 423  * off-by-one errors in 10^%T and similar output formats */
 424 static void
 425 mant_exp(
 426     double log10_base,
 427     double x,
 428     TBOOLEAN scientific,        /* round to power of 3 */
 429     double *m,                  /* results */
 430     int *p,
 431     const char *format)         /* format string for fixup */
 432 {
 433     int sign = 1;
 434     double l10;
 435     int power;
 436     double mantissa;
 437
 438     /*{{{  check 0 */
 439     if (x == 0) {
 440         if (m)
 441             *m = 0;
 442         if (p)
 443             *p = 0;
 444         return;
 445     }
 446     /*}}} */
 447     /*{{{  check -ve */
 448     if (x < 0) {
 449         sign = (-1);
 450         x = (-x);
 451     }
 452     /*}}} */
 453
 454     l10 = log10(x) / log10_base;
 455     power = floor(l10);
 456     mantissa = pow(10.0, log10_base * (l10 - power));
 457
 458     /* round power to an integer multiple of 3, to get what's
 459      * sometimes called 'scientific' or 'engineering' notation. Also
 460      * useful for handling metric unit prefixes like 'kilo' or 'micro'
 461      * */
 462     if (scientific) {
 463         /* Scientific mode makes no sense whatsoever if the base of
 464          * the logarithmic axis is anything but 10.0 */
 465         assert(log10_base == 1.0);
 466
 467         /* HBB FIXED 20040701: negative modulo positive may yield
 468          * negative result.  But we always want an effectively
 469          * positive modulus --> adjust input by one step */
 470         switch (power % 3) {
 471         case -1:
 472             power -= 3;
 473         case 2:
 474             mantissa *= 100;
 475             break;
 476         case -2:
 477             power -= 3;
 478         case 1:
 479             mantissa *= 10;
 480             break;
 481         case 0:
 482             break;
 483         default:
 484             int_error (NO_CARET, "Internal error in scientific number formatting");
 485         }
 486         power -= (power % 3);
 487     }
 488
 489     /* HBB 20010121: new code for decimal mantissa fixups.  Looks at
 490      * format string to see how many decimals will be put there.  Iff
 491      * the number is so close to an exact power of 10 that it will be
 492      * rounded up to 10.0e??? by an sprintf() with that many digits of
 493      * precision, increase the power by 1 to get a mantissa in the
 494      * region of 1.0.  If this handling is not wanted, pass NULL as
 495      * the format string */
 496     /* HBB 20040521: extended to also work for bases other than 10.0 */
 497     if (format) {
 498         double actual_base = (scientific ? 1000 : pow(10.0, log10_base));
 499         int precision = 0;
 500         double tolerance;
 501
 502         format = strchr (format, '.');
 503         if (format != NULL)
 504             /* a decimal point was found in the format, so use that
 505              * precision. */
 506             precision = strtol(format + 1, NULL, 10);
 507
 508         /* See if mantissa would be right on the border.  The
 509          * condition to watch out for is that the mantissa is within
 510          * one printing precision of the next power of the logarithm
 511          * base.  So add the 0.5*10^-precision to the mantissa, and
 512          * see if it's now larger than the base of the scale */
 513         tolerance = pow(10.0, -precision) / 2;
 514         if (mantissa + tolerance >= actual_base) {
 515             mantissa /= actual_base;
 516             power += (scientific ? 3 : 1);
 517         }
 518     }
 519     if (m)
 520         *m = sign * mantissa;
 521     if (p)
 522         *p = power;
 523 }
 524
 525 /*}}} */
 526
 527 /*
 528  * Kludge alert!!
 529  * Workaround until we have a better solution ...
 530  * Note: this assumes that all calls to sprintf in gprintf have
 531  * exactly three args. Lars
 532  */
 533 #ifdef HAVE_SNPRINTF
 534 # define sprintf(str,fmt,arg) \
 535     if (snprintf((str),count,(fmt),(arg)) > count) \
 536       fprintf (stderr,"%s:%d: Warning: too many digits for format\n",__FILE__,__LINE__)
 537 #endif
 538
 539 /*{{{  gprintf */
 540 /* extended s(n)printf */
 541 /* HBB 20010121: added code to maintain consistency between mantissa
 542  * and exponent across sprintf() calls.  The problem: format string
 543  * '%t*10^%T' will display 9.99 as '10.0*10^0', but 10.01 as
 544  * '1.0*10^1'.  This causes problems for people using the %T part,
 545  * only, with logscaled axes, in combination with the occasional
 546  * round-off error. */
 547 void
 548 gprintf(
 549     char *dest,
 550     size_t count,
 551     char *format,
 552     double log10_base,
 553     double x)
 554 {
 555     char temp[MAX_LINE_LEN + 1];
 556     char *t;
 557     TBOOLEAN seen_mantissa = FALSE; /* memorize if mantissa has been
 558                                        output, already */
 559     int stored_power = 0;       /* power that matches the mantissa
 560                                    output earlier */
 561     TBOOLEAN got_hash = FALSE;
 562
 563     for (;;) {
 564         /*{{{  copy to dest until % */
 565         while (*format != '%')
 566             if (!(*dest++ = *format++))
 567                 return;         /* end of format */
 568         /*}}} */
 569
 570         /*{{{  check for %% */
 571         if (format[1] == '%') {
 572             *dest++ = '%';
 573             format += 2;
 574             continue;
 575         }
 576         /*}}} */
 577
 578         /*{{{  copy format part to temp, excluding conversion character */
 579         t = temp;
 580         *t++ = '%';
 581         if (format[1] == '#') {
 582             *t++ = '#';
 583             format++;
 584             got_hash = TRUE;
 585         }
 586         /* dont put isdigit first since sideeffect in macro is bad */
 587         while (*++format == '.' || isdigit((unsigned char) *format)
 588                || *format == '-' || *format == '+' || *format == ' '
 589                || *format == '\'')
 590             *t++ = *format;
 591         /*}}} */
 592
 593         /*{{{  convert conversion character */
 594         switch (*format) {
 595             /*{{{  x and o */
 596         case 'x':
 597         case 'X':
 598         case 'o':
 599         case 'O':
 600             t[0] = *format;
 601             t[1] = 0;
 602             sprintf(dest, temp, (int) x);
 603             break;
 604             /*}}} */
 605             /*{{{  e, f and g */
 606         case 'e':
 607         case 'E':
 608         case 'f':
 609         case 'F':
 610         case 'g':
 611         case 'G':
 612             t[0] = *format;
 613             t[1] = 0;
 614             sprintf(dest, temp, x);
 615             break;
 616             /*}}} */
 617             /*{{{  l --- mantissa to current log base */
 618         case 'l':
 619             {
 620                 double mantissa;
 621
 622                 t[0] = 'f';
 623                 t[1] = 0;
 624                 mant_exp(log10_base, x, FALSE, &mantissa, &stored_power, temp);
 625                 seen_mantissa = TRUE;
 626                 sprintf(dest, temp, mantissa);
 627                 break;
 628             }
 629             /*}}} */
 630             /*{{{  t --- base-10 mantissa */
 631         case 't':
 632             {
 633                 double mantissa;
 634
 635                 t[0] = 'f';
 636                 t[1] = 0;
 637                 mant_exp(1.0, x, FALSE, &mantissa, &stored_power, temp);
 638                 seen_mantissa = TRUE;
 639                 sprintf(dest, temp, mantissa);
 640                 break;
 641             }
 642             /*}}} */
 643             /*{{{  s --- base-1000 / 'scientific' mantissa */
 644         case 's':
 645             {
 646                 double mantissa;
 647
 648                 t[0] = 'f';
 649                 t[1] = 0;
 650                 mant_exp(1.0, x, TRUE, &mantissa, &stored_power, temp);
 651                 seen_mantissa = TRUE;
 652                 sprintf(dest, temp, mantissa);
 653                 break;
 654             }
 655             /*}}} */
 656             /*{{{  L --- power to current log base */
 657         case 'L':
 658             {
 659                 int power;
 660
 661                 t[0] = 'd';
 662                 t[1] = 0;
 663                 if (seen_mantissa)
 664                     power = stored_power;
 665                 else
 666                     mant_exp(log10_base, x, FALSE, NULL, &power, "%.0f");
 667                 sprintf(dest, temp, power);
 668                 break;
 669             }
 670             /*}}} */
 671             /*{{{  T --- power of ten */
 672         case 'T':
 673             {
 674                 int power;
 675
 676                 t[0] = 'd';
 677                 t[1] = 0;
 678                 if (seen_mantissa)
 679                     power = stored_power;
 680                 else
 681                     mant_exp(1.0, x, FALSE, NULL, &power, "%.0f");
 682                 sprintf(dest, temp, power);
 683                 break;
 684             }
 685             /*}}} */
 686             /*{{{  S --- power of 1000 / 'scientific' */
 687         case 'S':
 688             {
 689                 int power;
 690
 691                 t[0] = 'd';
 692                 t[1] = 0;
 693                 if (seen_mantissa)
 694                     power = stored_power;
 695                 else
 696                     mant_exp(1.0, x, TRUE, NULL, &power, "%.0f");
 697                 sprintf(dest, temp, power);
 698                 break;
 699             }
 700             /*}}} */
 701             /*{{{  c --- ISO decimal unit prefix letters */
 702         case 'c':
 703             {
 704                 int power;
 705
 706                 t[0] = 'c';
 707                 t[1] = 0;
 708                 if (seen_mantissa)
 709                     power = stored_power;
 710                 else
 711                     mant_exp(1.0, x, TRUE, NULL, &power, "%.0f");
 712
 713                 if (power >= -18 && power <= 18) {
 714                     /* -18 -> 0, 0 -> 6, +18 -> 12, ... */
 715                     /* HBB 20010121: avoid division of -ve ints! */
 716                     power = (power + 18) / 3;
 717                     sprintf(dest, temp, "afpnum kMGTPE"[power]);
 718                 } else {
 719                     /* please extend the range ! */
 720                     /* name  power   name  power
 721                        -------------------------
 722                        atto   -18    Exa    18
 723                        femto  -15    Peta   15
 724                        pico   -12    Tera   12
 725                        nano    -9    Giga    9
 726                        micro   -6    Mega    6
 727                        milli   -3    kilo    3   */
 728
 729                     /* for the moment, print e+21 for example */
 730                     sprintf(dest, "e%+02d", (power - 6) * 3);
 731                 }
 732
 733                 break;
 734             }
 735             /*}}} */
 736             /*{{{  P --- multiple of pi */
 737         case 'P':
 738             {
 739                 t[0] = 'f';
 740                 t[1] = 0;
 741                 sprintf(dest, temp, x / M_PI);
 742                 break;
 743             }
 744             /*}}} */
 745         default:
 746             int_error(NO_CARET, "Bad format character");
 747         } /* switch */
 748         /*}}} */
 749
 750         if (got_hash && (format != strpbrk(format,"oeEfFgG")))
 751            int_error(NO_CARET, "Bad format character");
 752
 753     /* change decimal `.' to the actual entry in decimalsign */
 754         if (decimalsign != NULL) {
 755             char *dotpos1 = dest, *dotpos2;
 756             size_t newlength = strlen(decimalsign);
 757             int dot;
 758
 759             /* dot is the default decimalsign we will be replacing */
 760 #ifdef HAVE_LOCALE_H
 761             dot = *(localeconv()->decimal_point);
 762 #else
 763             dot = '.';
 764 #endif
 765
 766             /* replace every dot by the contents of decimalsign */
 767             while ((dotpos2 = strchr(dotpos1,dot)) != NULL) {
 768                 size_t taillength = strlen(dotpos2);
 769
 770                 dotpos1 = dotpos2 + newlength;
 771                 /* test if the new value for dest would be too long */
 772                 if (dotpos1 - dest + taillength > count)
 773                     int_error(NO_CARET,
 774                               "format too long due to long decimalsign string");
 775                 /* move tail end of string out of the way */
 776                 memmove(dotpos1, dotpos2 + 1, taillength);
 777                 /* insert decimalsign */
 778                 memcpy(dotpos2, decimalsign, newlength);
 779             }
 780             /* clear temporary variables for safety */
 781             dotpos1=NULL;
 782             dotpos2=NULL;
 783         }
 784
 785         /* this was at the end of every single case, before: */
 786         dest += strlen(dest);
 787         ++format;
 788     } /* for ever */
 789 }
 790
 791 /*}}} */
 792 #ifdef HAVE_SNPRINTF
 793 # undef sprintf
 794 #endif
 795
 796 /* some macros for the error and warning functions below
 797  * may turn this into a utility function later
 798  */
 799 #define PRINT_MESSAGE_TO_STDERR                         \
 800 do {                                                    \
 801     fprintf(stderr, "\n%s%s\n",                         \
 802             current_prompt ? current_prompt : "",       \
 803             gp_input_line);                             \
 804 } while (0)
 805
 806 #define PRINT_SPACES_UNDER_PROMPT               \
 807 do {                                            \
 808     const char *p;                              \
 809                                                 \
 810     if (!current_prompt)                        \
 811         break;                                  \
 812     for (p = current_prompt; *p != '\0'; p++)   \
 813         (void) fputc(' ', stderr);              \
 814 } while (0)
 815
 816 #define PRINT_SPACES_UPTO_TOKEN                                         \
 817 do {                                                                    \
 818     int i;                                                              \
 819                                                                         \
 820     for (i = 0; i < token[t_num].start_index; i++)                      \
 821         (void) fputc((gp_input_line[i] == '\t') ? '\t' : ' ', stderr);  \
 822 } while(0)
 823
 824 #define PRINT_CARET fputs("^\n",stderr);
 825
 826 #define PRINT_FILE_AND_LINE                                             \
 827 if (!interactive) {                                                     \
 828     if (infile_name != NULL)                                            \
 829         fprintf(stderr, "\"%s\", line %d: ", infile_name, inline_num);  \
 830     else fprintf(stderr, "line %d: ", inline_num);                      \
 831 }
 832
 833 /* TRUE if command just typed; becomes FALSE whenever we
 834  * send some other output to screen.  If FALSE, the command line
 835  * will be echoed to the screen before the ^ error message.
 836  */
 837 TBOOLEAN screen_ok;
 838
 839 #if defined(VA_START) && defined(STDC_HEADERS)
 840 void
 841 os_error(int t_num, const char *str,...)
 842 #else
 843 void
 844 os_error(int t_num, const char *str, va_dcl)
 845 #endif
 846 {
 847 #ifdef VA_START
 848     va_list args;
 849 #endif
 850 #ifdef VMS
 851     static status[2] = { 1, 0 };                /* 1 is count of error msgs */
 852 #endif /* VMS */
 853
 854     /* reprint line if screen has been written to */
 855
 856     if (t_num == DATAFILE) {
 857         df_showdata();
 858     } else if (t_num != NO_CARET) {     /* put caret under error */
 859         if (!screen_ok)
 860             PRINT_MESSAGE_TO_STDERR;
 861
 862         PRINT_SPACES_UNDER_PROMPT;
 863         PRINT_SPACES_UPTO_TOKEN;
 864         PRINT_CARET;
 865     }
 866     PRINT_SPACES_UNDER_PROMPT;
 867
 868 #ifdef VA_START
 869     VA_START(args, str);
 870 # if defined(HAVE_VFPRINTF) || _LIBC
 871     vfprintf(stderr, str, args);
 872 # else
 873     _doprnt(str, args, stderr);
 874 # endif
 875     va_end(args);
 876 #else
 877     fprintf(stderr, str, a1, a2, a3, a4, a5, a6, a7, a8);
 878 #endif
 879     putc('\n', stderr);
 880
 881     PRINT_SPACES_UNDER_PROMPT;
 882     PRINT_FILE_AND_LINE;
 883
 884 #ifdef VMS
 885     status[1] = vaxc$errno;
 886     sys$putmsg(status);
 887     (void) putc('\n', stderr);
 888 #else /* VMS */
 889     perror("util.c");
 890     putc('\n', stderr);
 891 #endif /* VMS */
 892
 893     bail_to_command_line();
 894 }
 895
 896
 897 #if defined(VA_START) && defined(STDC_HEADERS)
 898 void
 899 int_error(int t_num, const char *str,...)
 900 #else
 901 void
 902 int_error(int t_num, const char str[], va_dcl)
 903 #endif
 904 {
 905 #ifdef VA_START
 906     va_list args;
 907 #endif
 908
 909     /* reprint line if screen has been written to */
 910
 911     if (t_num == DATAFILE) {
 912         df_showdata();
 913     } else if (t_num != NO_CARET) { /* put caret under error */
 914         if (!screen_ok)
 915             PRINT_MESSAGE_TO_STDERR;
 916
 917         PRINT_SPACES_UNDER_PROMPT;
 918         PRINT_SPACES_UPTO_TOKEN;
 919         PRINT_CARET;
 920     }
 921     PRINT_SPACES_UNDER_PROMPT;
 922     PRINT_FILE_AND_LINE;
 923
 924 #ifdef VA_START
 925     VA_START(args, str);
 926 # if defined(HAVE_VFPRINTF) || _LIBC
 927     vfprintf(stderr, str, args);
 928 # else
 929     _doprnt(str, args, stderr);
 930 # endif
 931     va_end(args);
 932 #else
 933     fprintf(stderr, str, a1, a2, a3, a4, a5, a6, a7, a8);
 934 #endif
 935     fputs("\n\n", stderr);
 936
 937     /* We are bailing out of nested context without ever reaching */
 938     /* the normal cleanup code. Reset any flags before bailing.   */
 939     df_reset_after_error();
 940
 941     update_gpval_variables(2);
 942
 943     bail_to_command_line();
 944 }
 945
 946 /* Warn without bailing out to command line. Not a user error */
 947 #if defined(VA_START) && defined(STDC_HEADERS)
 948 void
 949 int_warn(int t_num, const char *str,...)
 950 #else
 951 void
 952 int_warn(int t_num, const char str[], va_dcl)
 953 #endif
 954 {
 955 #ifdef VA_START
 956     va_list args;
 957 #endif
 958
 959     /* reprint line if screen has been written to */
 960
 961     if (t_num == DATAFILE) {
 962         df_showdata();
 963     } else if (t_num != NO_CARET) { /* put caret under error */
 964         if (!screen_ok)
 965             PRINT_MESSAGE_TO_STDERR;
 966
 967         PRINT_SPACES_UNDER_PROMPT;
 968         PRINT_SPACES_UPTO_TOKEN;
 969         PRINT_CARET;
 970     }
 971     PRINT_SPACES_UNDER_PROMPT;
 972     PRINT_FILE_AND_LINE;
 973
 974     fputs("warning: ", stderr);
 975 #ifdef VA_START
 976     VA_START(args, str);
 977 # if defined(HAVE_VFPRINTF) || _LIBC
 978     vfprintf(stderr, str, args);
 979 # else
 980     _doprnt(str, args, stderr);
 981 # endif
 982     va_end(args);
 983 #else  /* VA_START */
 984     fprintf(stderr, str, a1, a2, a3, a4, a5, a6, a7, a8);
 985 #endif /* VA_START */
 986     putc('\n', stderr);
 987 }
 988
 989 /*{{{  graph_error() */
 990 /* handle errors during graph-plot in a consistent way */
 991 /* HBB 20000430: move here, from graphics.c */
 992 #if defined(VA_START) && defined(STDC_HEADERS)
 993 void
 994 graph_error(const char *fmt, ...)
 995 #else
 996 void
 997 graph_error(const char *fmt, va_dcl)
 998 #endif
 999 {
1000 #ifdef VA_START
1001     va_list args;
1002 #endif
1003
1004     multiplot = FALSE;
1005     term_end_plot();
1006
1007 #ifdef VA_START
1008     VA_START(args, fmt);
1009 #if 0
1010     /* HBB 20001120: this seems not to work at all. Probably because a
1011      * va_list argument, is, after all, something else than a varargs
1012      * list (i.e. a '...') */
1013     int_error(NO_CARET, fmt, args);
1014 #else
1015     /* HBB 20001120: instead, copy the core code from int_error() to
1016      * here: */
1017     PRINT_SPACES_UNDER_PROMPT;
1018     PRINT_FILE_AND_LINE;
1019
1020 # if defined(HAVE_VFPRINTF) || _LIBC
1021     vfprintf(stderr, fmt, args);
1022 # else
1023     _doprnt(fmt, args, stderr);
1024 # endif
1025     va_end(args);
1026     fputs("\n\n", stderr);
1027
1028     bail_to_command_line();
1029 #endif /* 1/0 */
1030     va_end(args);
1031 #else
1032     int_error(NO_CARET, fmt, a1, a2, a3, a4, a5, a6, a7, a8);
1033 #endif
1034
1035 }
1036
1037 /*}}} */
1038
1039
1040 /* Lower-case the given string (DFK) */
1041 /* Done in place. */
1042 void
1043 lower_case(char *s)
1044 {
1045     char *p = s;
1046
1047     while (*p) {
1048         if (isupper((unsigned char)*p))
1049             *p = tolower((unsigned char)*p);
1050         p++;
1051     }
1052 }
1053
1054 /* Squash spaces in the given string (DFK) */
1055 /* That is, reduce all multiple white-space chars to single spaces */
1056 /* Done in place. */
1057 void
1058 squash_spaces(char *s)
1059 {
1060     char *r = s;        /* reading point */
1061     char *w = s;        /* writing point */
1062     TBOOLEAN space = FALSE;     /* TRUE if we've already copied a space */
1063
1064     for (w = r = s; *r != NUL; r++) {
1065         if (isspace((unsigned char) *r)) {
1066             /* white space; only copy if we haven't just copied a space */
1067             if (!space) {
1068                 space = TRUE;
1069                 *w++ = ' ';
1070             }                   /* else ignore multiple spaces */
1071         } else {
1072             /* non-space character; copy it and clear flag */
1073             *w++ = *r;
1074             space = FALSE;
1075         }
1076     }
1077     *w = NUL;                   /* null terminate string */
1078 }
1079
1080
1081 /* postprocess single quoted strings: replace "''" by "'"
1082 */
1083 void
1084 parse_sq(char *instr)
1085 {
1086     char *s = instr, *t = instr;
1087
1088     /* the string will always get shorter, so we can do the
1089      * conversion in situ
1090      */
1091
1092     while (*s != NUL) {
1093         if (*s == '\'' && *(s+1) == '\'')
1094             s++;
1095         *t++ = *s++;
1096     }
1097     *t = NUL;
1098 }
1099
1100
1101 void
1102 parse_esc(char *instr)
1103 {
1104     char *s = instr, *t = instr;
1105
1106     /* the string will always get shorter, so we can do the
1107      * conversion in situ
1108      */
1109
1110     while (*s != NUL) {
1111         if (*s == '\\') {
1112             s++;
1113             if (*s == '\\') {
1114                 *t++ = '\\';
1115                 s++;
1116             } else if (*s == 'n') {
1117                 *t++ = '\n';
1118                 s++;
1119             } else if (*s == 'r') {
1120                 *t++ = '\r';
1121                 s++;
1122             } else if (*s == 't') {
1123                 *t++ = '\t';
1124                 s++;
1125             } else if (*s == '\"') {
1126                 *t++ = '\"';
1127                 s++;
1128             } else if (*s >= '0' && *s <= '7') {
1129                 int i, n;
1130                 char *octal = (*s == '0' ? "%4o%n" : "%3o%n");
1131                 if (sscanf(s, octal, &i, &n) > 0) {
1132                     *t++ = i;
1133                     s += n;
1134                 } else {
1135                     /* int_error("illegal octal number ", c_token); */
1136                     *t++ = '\\';
1137                     *t++ = *s++;
1138                 }
1139             }
1140         } else if (df_separator && *s == '\"' && *(s+1) == '\"') {
1141         /* EAM Mar 2003 - For parsing CSV strings with quoted quotes */
1142             *t++ = *s++; s++;
1143         } else {
1144             *t++ = *s++;
1145         }
1146     }
1147     *t = NUL;
1148 }
1149
1150
1151 /* FIXME HH 20020915: This function does nothing if dirent.h and windows.h
1152  * not available. */
1153 TBOOLEAN
1154 existdir (const char *name)
1155 {
1156 #ifdef HAVE_DIRENT_H
1157     DIR *dp;
1158     if (! (dp = opendir(name) ) )
1159         return FALSE;
1160
1161     closedir(dp);
1162     return TRUE;
1163 #elif defined(_Windows)
1164     HANDLE FileHandle;
1165     WIN32_FIND_DATA finddata;
1166
1167     FileHandle = FindFirstFile(name, &finddata);
1168     if (FileHandle != INVALID_HANDLE_VALUE) {
1169         if (finddata.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY)
1170             return TRUE;
1171     }
1172     return FALSE;
1173 #elif defined(VMS)
1174     return FALSE;
1175 #else
1176     int_warn(NO_CARET,
1177              "Test on directory existence not supported\n\t('%s!')",
1178              name);
1179     return FALSE;
1180 #endif
1181 }
1182
1183 char *
1184 getusername ()
1185 {
1186     char *username = NULL;
1187     char *fullname = NULL;
1188
1189     username=getenv("USER");
1190     if (!username)
1191         username=getenv("USERNAME");
1192
1193 #ifdef HAVE_PWD_H
1194     if (username) {
1195         struct passwd *pwentry = NULL;
1196         pwentry=getpwnam(username);
1197         if (pwentry && strlen(pwentry->pw_gecos)) {
1198             fullname = gp_alloc(strlen(pwentry->pw_gecos)+1,"getusername");
1199             strcpy(fullname, pwentry->pw_gecos);
1200         } else {
1201             fullname = gp_alloc(strlen(username)+1,"getusername");
1202             strcpy(fullname, username);
1203         }
1204     }
1205 #elif defined(_Windows)
1206     if (username) {
1207         DWORD bufCharCount = INFO_BUFFER_SIZE;
1208         fullname = gp_alloc(INFO_BUFFER_SIZE + 1,"getusername");
1209         if (!GetUserName(fullname,&bufCharCount)) {
1210             free(fullname);
1211             fullname = NULL;
1212         }
1213     }
1214 #else
1215     fullname = gp_alloc(strlen(username)+1,"getusername");
1216     strcpy(fullname, username);
1217 #endif /* HAVE_PWD_H */
1218
1219     return fullname;
1220 }