Added new files resulting from directory restructuring.
[pspp-builds.git] / src / data / data-out.c
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 #include "message.h"
22 #include <ctype.h>
23 #include <math.h>
24 #include <float.h>
25 #include <stdlib.h>
26 #include <time.h>
27 #include "calendar.h"
28 #include "message.h"
29 #include "format.h"
30 #include "magic.h"
31 #include "misc.h"
32 #include "misc.h"
33 #include "settings.h"
34 #include "str.h"
35 #include "variable.h"
36
37 #include "gettext.h"
38 #define _(msgid) gettext (msgid)
39
40 #include "debug-print.h"
41 \f
42 /* Public functions. */
43
44 typedef int numeric_converter (char *, const struct fmt_spec *, double);
45 static numeric_converter convert_F, convert_N, convert_E, convert_F_plus;
46 static numeric_converter convert_Z, convert_IB, convert_P, convert_PIB;
47 static numeric_converter convert_PIBHEX, convert_PK, convert_RB;
48 static numeric_converter convert_RBHEX, convert_CCx, convert_date;
49 static numeric_converter convert_time, convert_WKDAY, convert_MONTH;
50
51 static numeric_converter try_F, convert_infinite;
52
53 typedef int string_converter (char *, const struct fmt_spec *, const char *);
54 static string_converter convert_A, convert_AHEX;
55
56 /* Converts binary value V into printable form in the exactly
57    FP->W character in buffer S according to format specification
58    FP.  No null terminator is appended to the buffer.  */
59 bool
60 data_out (char *s, const struct fmt_spec *fp, const union value *v)
61 {
62   int cat = formats[fp->type].cat;
63   int ok;
64
65   assert (check_output_specifier (fp, 0));
66   if (!(cat & FCAT_STRING)) 
67     {
68       /* Numeric formatting. */
69       double number = v->f;
70
71       /* Handle SYSMIS turning into blanks. */
72       if ((cat & FCAT_BLANKS_SYSMIS) && number == SYSMIS)
73         {
74           memset (s, ' ', fp->w);
75           s[fp->w - fp->d - 1] = '.';
76           return true;
77         }
78
79       /* Handle decimal shift. */
80       if ((cat & FCAT_SHIFT_DECIMAL) && number != SYSMIS && fp->d)
81         number *= pow (10.0, fp->d);
82
83       switch (fp->type) 
84         {
85         case FMT_F:
86           ok = convert_F (s, fp, number);
87           break;
88
89         case FMT_N:
90           ok = convert_N (s, fp, number);
91           break;
92
93         case FMT_E:
94           ok = convert_E (s, fp, number);
95           break;
96
97         case FMT_COMMA: case FMT_DOT: case FMT_DOLLAR: case FMT_PCT:
98           ok = convert_F_plus (s, fp, number);
99           break;
100
101         case FMT_Z:
102           ok = convert_Z (s, fp, number);
103           break;
104
105         case FMT_A:
106           assert (0);
107           abort ();
108
109         case FMT_AHEX:
110           assert (0);
111           abort ();
112
113         case FMT_IB:
114           ok = convert_IB (s, fp, number);
115           break;
116
117         case FMT_P:
118           ok = convert_P (s, fp, number);
119           break;
120
121         case FMT_PIB:
122           ok = convert_PIB (s, fp, number);
123           break;
124
125         case FMT_PIBHEX:
126           ok = convert_PIBHEX (s, fp, number);
127           break;
128
129         case FMT_PK:
130           ok = convert_PK (s, fp, number);
131           break;
132
133         case FMT_RB:
134           ok = convert_RB (s, fp, number);
135           break;
136
137         case FMT_RBHEX:
138           ok = convert_RBHEX (s, fp, number);
139           break;
140
141         case FMT_CCA: case FMT_CCB: case FMT_CCC: case FMT_CCD: case FMT_CCE:
142           ok = convert_CCx (s, fp, number);
143           break;
144
145         case FMT_DATE: case FMT_EDATE: case FMT_SDATE: case FMT_ADATE:
146         case FMT_JDATE: case FMT_QYR: case FMT_MOYR: case FMT_WKYR:
147         case FMT_DATETIME: 
148           ok = convert_date (s, fp, number);
149           break;
150
151         case FMT_TIME: case FMT_DTIME:
152           ok = convert_time (s, fp, number);
153           break;
154
155         case FMT_WKDAY:
156           ok = convert_WKDAY (s, fp, number);
157           break;
158
159         case FMT_MONTH:
160           ok = convert_MONTH (s, fp, number);
161           break;
162
163         default:
164           assert (0);
165           abort ();
166         }
167     }
168   else 
169     {
170       /* String formatting. */
171       const char *string = v->s;
172
173       switch (fp->type) 
174         {
175         case FMT_A:
176           ok = convert_A (s, fp, string);
177           break;
178
179         case FMT_AHEX:
180           ok = convert_AHEX (s, fp, string);
181           break;
182
183         default:
184           assert (0);
185           abort ();
186         }
187     }
188
189   /* Error handling. */
190   if (!ok)
191     strncpy (s, "ERROR", fp->w);
192   
193   return ok;
194 }
195
196 /* Converts V into S in F format with width W and D decimal places,
197    then deletes trailing zeros.  S is not null-terminated. */
198 void
199 num_to_string (double v, char *s, int w, int d)
200 {
201   struct fmt_spec f = make_output_format (FMT_F, w, d);
202   convert_F (s, &f, v);
203 }
204 \f
205 /* Main conversion functions. */
206
207 static void insert_commas (char *dst, const char *src,
208                            const struct fmt_spec *fp);
209 static int year4 (int year);
210 static int try_CCx (char *s, const struct fmt_spec *fp, double v);
211
212 #if FLT_RADIX!=2
213 #error Write your own floating-point output routines.
214 #endif
215
216 /* Converts a number between 0 and 15 inclusive to a `hexit'
217    [0-9A-F]. */
218 #define MAKE_HEXIT(X) ("0123456789ABCDEF"[X])
219
220 /* Table of powers of 10. */
221 static const double power10[] =
222   {
223     0,  /* Not used. */
224     1e01, 1e02, 1e03, 1e04, 1e05, 1e06, 1e07, 1e08, 1e09, 1e10,
225     1e11, 1e12, 1e13, 1e14, 1e15, 1e16, 1e17, 1e18, 1e19, 1e20,
226     1e21, 1e22, 1e23, 1e24, 1e25, 1e26, 1e27, 1e28, 1e29, 1e30,
227     1e31, 1e32, 1e33, 1e34, 1e35, 1e36, 1e37, 1e38, 1e39, 1e40,
228   };
229
230 /* Handles F format. */
231 static int
232 convert_F (char *dst, const struct fmt_spec *fp, double number)
233 {
234   if (!try_F (dst, fp, number))
235     convert_E (dst, fp, number);
236   return 1;
237 }
238
239 /* Handles N format. */
240 static int
241 convert_N (char *dst, const struct fmt_spec *fp, double number)
242 {
243   double d = floor (number);
244
245   if (d < 0 || d == SYSMIS)
246     {
247       msg (ME, _("The N output format cannot be used to output a "
248                  "negative number or the system-missing value."));
249       return 0;
250     }
251   
252   if (d < power10[fp->w])
253     {
254       char buf[128];
255       sprintf (buf, "%0*.0f", fp->w, number);
256       memcpy (dst, buf, fp->w);
257     }
258   else
259     memset (dst, '*', fp->w);
260
261   return 1;
262 }
263
264 /* Handles E format.  Also operates as fallback for some other
265    formats. */
266 static int
267 convert_E (char *dst, const struct fmt_spec *fp, double number)
268 {
269   /* Temporary buffer. */
270   char buf[128];
271   
272   /* Ranged number of decimal places. */
273   int d;
274
275   if (!finite (number))
276     return convert_infinite (dst, fp, number);
277
278   /* Check that the format is wide enough.
279      Although PSPP generally checks this, convert_E() can be called as
280      a fallback from other formats which do not check. */
281   if (fp->w < 6)
282     {
283       memset (dst, '*', fp->w);
284       return 1;
285     }
286
287   /* Put decimal places in usable range. */
288   d = min (fp->d, fp->w - 6);
289   if (number < 0)
290     d--;
291   if (d < 0)
292     d = 0;
293   sprintf (buf, "%*.*E", fp->w, d, number);
294
295   /* What we do here is force the exponent part to have four
296      characters whenever possible.  That is, 1.00E+99 is okay (`E+99')
297      but 1.00E+100 (`E+100') must be coerced to 1.00+100 (`+100').  On
298      the other hand, 1.00E1000 (`E+100') cannot be canonicalized.
299      Note that ANSI C guarantees at least two digits in the
300      exponent. */
301   if (fabs (number) > 1e99)
302     {
303       /* Pointer to the `E' in buf. */
304       char *cp;
305
306       cp = strchr (buf, 'E');
307       if (cp)
308         {
309           /* Exponent better not be bigger than an int. */
310           int exp = atoi (cp + 1); 
311
312           if (abs (exp) > 99 && abs (exp) < 1000)
313             {
314               /* Shift everything left one place: 1.00e+100 -> 1.00+100. */
315               cp[0] = cp[1];
316               cp[1] = cp[2];
317               cp[2] = cp[3];
318               cp[3] = cp[4];
319             }
320           else if (abs (exp) >= 1000)
321             memset (buf, '*', fp->w);
322         }
323     }
324
325   /* The C locale always uses a period `.' as a decimal point.
326      Translate to comma if necessary. */
327   if ((get_decimal() == ',' && fp->type != FMT_DOT)
328       || (get_decimal() == '.' && fp->type == FMT_DOT))
329     {
330       char *cp = strchr (buf, '.');
331       if (cp)
332         *cp = ',';
333     }
334
335   memcpy (dst, buf, fp->w);
336   return 1;
337 }
338
339 /* Handles COMMA, DOT, DOLLAR, and PCT formats. */
340 static int
341 convert_F_plus (char *dst, const struct fmt_spec *fp, double number)
342 {
343   char buf[40];
344   
345   if (try_F (buf, fp, number))
346     insert_commas (dst, buf, fp);
347   else
348     convert_E (dst, fp, number);
349
350   return 1;
351 }
352
353 static int
354 convert_Z (char *dst, const struct fmt_spec *fp, double number)
355 {
356   static int warned = 0;
357
358   if (!warned)
359     {
360       msg (MW, 
361         _("Quality of zoned decimal (Z) output format code is "
362           "suspect.  Check your results. Report bugs to %s."),
363         PACKAGE_BUGREPORT);
364       warned = 1;
365     }
366
367   if (number == SYSMIS)
368     {
369       msg (ME, _("The system-missing value cannot be output as a zoned "
370                  "decimal number."));
371       return 0;
372     }
373   
374   {
375     char buf[41];
376     double d;
377     int i;
378     
379     d = fabs (floor (number));
380     if (d >= power10[fp->w])
381       {
382         msg (ME, _("Number %g too big to fit in field with format Z%d.%d."),
383              number, fp->w, fp->d);
384         return 0;
385       }
386
387     sprintf (buf, "%*.0f", fp->w, number);
388     for (i = 0; i < fp->w; i++)
389       dst[i] = (buf[i] - '0') | 0xf0;
390     if (number < 0)
391       dst[fp->w - 1] &= 0xdf;
392   }
393
394   return 1;
395 }
396
397 static int
398 convert_A (char *dst, const struct fmt_spec *fp, const char *string)
399 {
400   memcpy (dst, string, fp->w);
401   return 1;
402 }
403
404 static int
405 convert_AHEX (char *dst, const struct fmt_spec *fp, const char *string)
406 {
407   int i;
408
409   for (i = 0; i < fp->w / 2; i++)
410     {
411       *dst++ = MAKE_HEXIT ((string[i]) >> 4);
412       *dst++ = MAKE_HEXIT ((string[i]) & 0xf);
413     }
414
415   return 1;
416 }
417
418 static int
419 convert_IB (char *dst, const struct fmt_spec *fp, double number)
420 {
421   /* Strategy: Basically the same as convert_PIBHEX() but with
422      base 256. Then negate the two's-complement result if number
423      is negative. */
424
425   /* Used for constructing the two's-complement result. */
426   unsigned temp[8];
427
428   /* Fraction (mantissa). */
429   double frac;
430
431   /* Exponent. */
432   int exp;
433
434   /* Difference between exponent and (-8*fp->w-1). */
435   int diff;
436
437   /* Counter. */
438   int i;
439
440   /* Make the exponent (-8*fp->w-1). */
441   frac = frexp (fabs (number), &exp);
442   diff = exp - (-8 * fp->w - 1);
443   exp -= diff;
444   frac *= ldexp (1.0, diff);
445
446   /* Extract each base-256 digit. */
447   for (i = 0; i < fp->w; i++)
448     {
449       modf (frac, &frac);
450       frac *= 256.0;
451       temp[i] = floor (frac);
452     }
453
454   /* Perform two's-complement negation if number is negative. */
455   if (number < 0)
456     {
457       /* Perform NOT operation. */
458       for (i = 0; i < fp->w; i++)
459         temp[i] = ~temp[i];
460       /* Add 1 to the whole number. */
461       for (i = fp->w - 1; i >= 0; i--)
462         {
463           temp[i]++;
464           if (temp[i])
465             break;
466         }
467     }
468   memcpy (dst, temp, fp->w);
469 #ifndef WORDS_BIGENDIAN
470   buf_reverse (dst, fp->w);
471 #endif
472
473   return 1;
474 }
475
476 static int
477 convert_P (char *dst, const struct fmt_spec *fp, double number)
478 {
479   /* Buffer for fp->w*2-1 characters + a decimal point if library is
480      not quite compliant + a null. */
481   char buf[17];
482
483   /* Counter. */
484   int i;
485
486   /* Main extraction. */
487   sprintf (buf, "%0*.0f", fp->w * 2 - 1, floor (fabs (number)));
488
489   for (i = 0; i < fp->w; i++)
490     ((unsigned char *) dst)[i]
491       = ((buf[i * 2] - '0') << 4) + buf[i * 2 + 1] - '0';
492
493   /* Set sign. */
494   dst[fp->w - 1] &= 0xf0;
495   if (number >= 0.0)
496     dst[fp->w - 1] |= 0xf;
497   else
498     dst[fp->w - 1] |= 0xd;
499
500   return 1;
501 }
502
503 static int
504 convert_PIB (char *dst, const struct fmt_spec *fp, double number)
505 {
506   /* Strategy: Basically the same as convert_IB(). */
507
508   /* Fraction (mantissa). */
509   double frac;
510
511   /* Exponent. */
512   int exp;
513
514   /* Difference between exponent and (-8*fp->w). */
515   int diff;
516
517   /* Counter. */
518   int i;
519
520   /* Make the exponent (-8*fp->w). */
521   frac = frexp (fabs (number), &exp);
522   diff = exp - (-8 * fp->w);
523   exp -= diff;
524   frac *= ldexp (1.0, diff);
525
526   /* Extract each base-256 digit. */
527   for (i = 0; i < fp->w; i++)
528     {
529       modf (frac, &frac);
530       frac *= 256.0;
531       ((unsigned char *) dst)[i] = floor (frac);
532     }
533 #ifndef WORDS_BIGENDIAN
534   buf_reverse (dst, fp->w);
535 #endif
536
537   return 1;
538 }
539
540 static int
541 convert_PIBHEX (char *dst, const struct fmt_spec *fp, double number)
542 {
543   /* Strategy: Use frexp() to create a normalized result (but mostly
544      to find the base-2 exponent), then change the base-2 exponent to
545      (-4*fp->w) using multiplication and division by powers of two.
546      Extract each hexit by multiplying by 16. */
547
548   /* Fraction (mantissa). */
549   double frac;
550
551   /* Exponent. */
552   int exp;
553
554   /* Difference between exponent and (-4*fp->w). */
555   int diff;
556
557   /* Counter. */
558   int i;
559
560   /* Make the exponent (-4*fp->w). */
561   frac = frexp (fabs (number), &exp);
562   diff = exp - (-4 * fp->w);
563   exp -= diff;
564   frac *= ldexp (1.0, diff);
565
566   /* Extract each hexit. */
567   for (i = 0; i < fp->w; i++)
568     {
569       modf (frac, &frac);
570       frac *= 16.0;
571       *dst++ = MAKE_HEXIT ((int) floor (frac));
572     }
573
574   return 1;
575 }
576
577 static int
578 convert_PK (char *dst, const struct fmt_spec *fp, double number)
579 {
580   /* Buffer for fp->w*2 characters + a decimal point if library is not
581      quite compliant + a null. */
582   char buf[18];
583
584   /* Counter. */
585   int i;
586
587   /* Main extraction. */
588   sprintf (buf, "%0*.0f", fp->w * 2, floor (fabs (number)));
589
590   for (i = 0; i < fp->w; i++)
591     ((unsigned char *) dst)[i]
592       = ((buf[i * 2] - '0') << 4) + buf[i * 2 + 1] - '0';
593
594   return 1;
595 }
596
597 static int
598 convert_RB (char *dst, const struct fmt_spec *fp, double number)
599 {
600   union
601     {
602       double d;
603       char c[8];
604     }
605   u;
606
607   u.d = number;
608   memcpy (dst, u.c, fp->w);
609
610   return 1;
611 }
612
613 static int
614 convert_RBHEX (char *dst, const struct fmt_spec *fp, double number)
615 {
616   union
617   {
618     double d;
619     char c[8];
620   }
621   u;
622
623   int i;
624
625   u.d = number;
626   for (i = 0; i < fp->w / 2; i++)
627     {
628       *dst++ = MAKE_HEXIT (u.c[i] >> 4);
629       *dst++ = MAKE_HEXIT (u.c[i] & 15);
630     }
631
632   return 1;
633 }
634
635 static int
636 convert_CCx (char *dst, const struct fmt_spec *fp, double number)
637 {
638   if (try_CCx (dst, fp, number))
639     return 1;
640   else
641     {
642       struct fmt_spec f;
643       
644       f.type = FMT_COMMA;
645       f.w = fp->w;
646       f.d = fp->d;
647   
648       return convert_F_plus (dst, &f, number);
649     }
650 }
651
652 static int
653 convert_date (char *dst, const struct fmt_spec *fp, double number)
654 {
655   static const char *months[12] =
656     {
657       "JAN", "FEB", "MAR", "APR", "MAY", "JUN",
658       "JUL", "AUG", "SEP", "OCT", "NOV", "DEC",
659     };
660
661   char buf[64] = {0};
662   int ofs = number / 86400.;
663   int month, day, year;
664
665   if (ofs < 1)
666     return 0;
667
668   calendar_offset_to_gregorian (ofs, &year, &month, &day);
669   switch (fp->type)
670     {
671     case FMT_DATE:
672       if (fp->w >= 11)
673         sprintf (buf, "%02d-%s-%04d", day, months[month - 1], year);
674       else
675         sprintf (buf, "%02d-%s-%02d", day, months[month - 1], year % 100);
676       break;
677     case FMT_EDATE:
678       if (fp->w >= 10)
679         sprintf (buf, "%02d.%02d.%04d", day, month, year);
680       else
681         sprintf (buf, "%02d.%02d.%02d", day, month, year % 100);
682       break;
683     case FMT_SDATE:
684       if (fp->w >= 10)
685         sprintf (buf, "%04d/%02d/%02d", year, month, day);
686       else
687         sprintf (buf, "%02d/%02d/%02d", year % 100, month, day);
688       break;
689     case FMT_ADATE:
690       if (fp->w >= 10)
691         sprintf (buf, "%02d/%02d/%04d", month, day, year);
692       else
693         sprintf (buf, "%02d/%02d/%02d", month, day, year % 100);
694       break;
695     case FMT_JDATE:
696       {
697         int yday = calendar_offset_to_yday (ofs);
698         
699         if (fp->w < 7)
700           sprintf (buf, "%02d%03d", year % 100, yday); 
701         else if (year4 (year))
702           sprintf (buf, "%04d%03d", year, yday);
703         else
704         break;
705       }
706     case FMT_QYR:
707       if (fp->w >= 8)
708         sprintf (buf, "%d Q% 04d", (month - 1) / 3 + 1, year);
709       else
710         sprintf (buf, "%d Q% 02d", (month - 1) / 3 + 1, year % 100);
711       break;
712     case FMT_MOYR:
713       if (fp->w >= 8)
714         sprintf (buf, "%s% 04d", months[month - 1], year);
715       else
716         sprintf (buf, "%s% 02d", months[month - 1], year % 100);
717       break;
718     case FMT_WKYR:
719       {
720         int yday = calendar_offset_to_yday (ofs);
721         
722         if (fp->w >= 10)
723           sprintf (buf, "%02d WK% 04d", (yday - 1) / 7 + 1, year);
724         else
725           sprintf (buf, "%02d WK% 02d", (yday - 1) / 7 + 1, year % 100);
726       }
727       break;
728     case FMT_DATETIME:
729       {
730         char *cp;
731
732         cp = spprintf (buf, "%02d-%s-%04d %02d:%02d",
733                        day, months[month - 1], year,
734                        (int) fmod (floor (number / 60. / 60.), 24.),
735                        (int) fmod (floor (number / 60.), 60.));
736         if (fp->w >= 20)
737           {
738             int w, d;
739
740             if (fp->w >= 22 && fp->d > 0)
741               {
742                 d = min (fp->d, fp->w - 21);
743                 w = 3 + d;
744               }
745             else
746               {
747                 w = 2;
748                 d = 0;
749               }
750
751             cp = spprintf (cp, ":%0*.*f", w, d, fmod (number, 60.));
752           }
753       }
754       break;
755     default:
756       assert (0);
757     }
758
759   if (buf[0] == 0)
760     return 0;
761   buf_copy_str_rpad (dst, fp->w, buf);
762   return 1;
763 }
764
765 static int
766 convert_time (char *dst, const struct fmt_spec *fp, double number)
767 {
768   char temp_buf[40];
769   char *cp;
770
771   double time;
772   int width;
773
774   if (fabs (number) > 1e20)
775     {
776       msg (ME, _("Time value %g too large in magnitude to convert to "
777            "alphanumeric time."), number);
778       return 0;
779     }
780
781   time = number;
782   width = fp->w;
783   cp = temp_buf;
784   if (time < 0)
785     *cp++ = '-', time = -time;
786   if (fp->type == FMT_DTIME)
787     {
788       double days = floor (time / 60. / 60. / 24.);
789       cp = spprintf (temp_buf, "%02.0f ", days);
790       time = time - days * 60. * 60. * 24.;
791       width -= 3;
792     }
793   else
794     cp = temp_buf;
795
796   cp = spprintf (cp, "%02.0f:%02.0f",
797                  fmod (floor (time / 60. / 60.), 24.),
798                  fmod (floor (time / 60.), 60.));
799
800   if (width >= 8)
801     {
802       int w, d;
803
804       if (width >= 10 && fp->d >= 0 && fp->d != 0)
805         d = min (fp->d, width - 9), w = 3 + d;
806       else
807         w = 2, d = 0;
808
809       cp = spprintf (cp, ":%0*.*f", w, d, fmod (time, 60.));
810     }
811   buf_copy_str_rpad (dst, fp->w, temp_buf);
812
813   return 1;
814 }
815
816 static int
817 convert_WKDAY (char *dst, const struct fmt_spec *fp, double wkday)
818 {
819   static const char *weekdays[7] =
820     {
821       "SUNDAY", "MONDAY", "TUESDAY", "WEDNESDAY",
822       "THURSDAY", "FRIDAY", "SATURDAY",
823     };
824
825   if (wkday < 1 || wkday > 7)
826     {
827       msg (ME, _("Weekday index %f does not lie between 1 and 7."),
828            (double) wkday);
829       return 0;
830     }
831   buf_copy_str_rpad (dst, fp->w, weekdays[(int) wkday - 1]);
832
833   return 1;
834 }
835
836 static int
837 convert_MONTH (char *dst, const struct fmt_spec *fp, double month)
838 {
839   static const char *months[12] =
840     {
841       "JANUARY", "FEBRUARY", "MARCH", "APRIL", "MAY", "JUNE",
842       "JULY", "AUGUST", "SEPTEMBER", "OCTOBER", "NOVEMBER", "DECEMBER",
843     };
844
845   if (month < 1 || month > 12)
846     {
847       msg (ME, _("Month index %f does not lie between 1 and 12."),
848            month);
849       return 0;
850     }
851   
852   buf_copy_str_rpad (dst, fp->w, months[(int) month - 1]);
853
854   return 1;
855 }
856 \f
857 /* Helper functions. */
858
859 /* Copies SRC to DST, inserting commas and dollar signs as appropriate
860    for format spec *FP.  */
861 static void
862 insert_commas (char *dst, const char *src, const struct fmt_spec *fp)
863 {
864   /* Number of leading spaces in the number.  This is the amount of
865      room we have for inserting commas and dollar signs. */
866   int n_spaces;
867
868   /* Number of digits before the decimal point.  This is used to
869      determine the Number of commas to insert. */
870   int n_digits;
871
872   /* Number of commas to insert. */
873   int n_commas;
874
875   /* Number of items ,%$ to insert. */
876   int n_items;
877
878   /* Number of n_items items not to use for commas. */
879   int n_reserved;
880
881   /* Digit iterator. */
882   int i;
883
884   /* Source pointer. */
885   const char *sp;
886
887   /* Count spaces and digits. */
888   sp = src;
889   while (sp < src + fp->w && *sp == ' ')
890     sp++;
891   n_spaces = sp - src;
892   sp = src + n_spaces;
893   if (*sp == '-')
894     sp++;
895   n_digits = 0;
896   while (sp + n_digits < src + fp->w && isdigit ((unsigned char) sp[n_digits]))
897     n_digits++;
898   n_commas = (n_digits - 1) / 3;
899   n_items = n_commas + (fp->type == FMT_DOLLAR || fp->type == FMT_PCT);
900
901   /* Check whether we have enough space to do insertions. */
902   if (!n_spaces || !n_items)
903     {
904       memcpy (dst, src, fp->w);
905       return;
906     }
907   if (n_items > n_spaces)
908     {
909       n_items -= n_commas;
910       if (!n_items)
911         {
912           memcpy (dst, src, fp->w);
913           return;
914         }
915     }
916
917   /* Put spaces at the beginning if there's extra room. */
918   if (n_spaces > n_items)
919     {
920       memset (dst, ' ', n_spaces - n_items);
921       dst += n_spaces - n_items;
922     }
923
924   /* Insert $ and reserve space for %. */
925   n_reserved = 0;
926   if (fp->type == FMT_DOLLAR)
927     {
928       *dst++ = '$';
929       n_items--;
930     }
931   else if (fp->type == FMT_PCT)
932     n_reserved = 1;
933
934   /* Copy negative sign and digits, inserting commas. */
935   if (sp - src > n_spaces)
936     *dst++ = '-';
937   for (i = n_digits; i; i--)
938     {
939       if (i % 3 == 0 && n_digits > i && n_items > n_reserved)
940         {
941           n_items--;
942           *dst++ = fp->type == FMT_COMMA ? get_grouping() : get_decimal();
943         }
944       *dst++ = *sp++;
945     }
946
947   /* Copy decimal places and insert % if necessary. */
948   memcpy (dst, sp, fp->w - (sp - src));
949   if (fp->type == FMT_PCT && n_items > 0)
950     dst[fp->w - (sp - src)] = '%';
951 }
952
953 /* Returns 1 if YEAR (i.e., 1987) can be represented in four digits, 0
954    otherwise. */
955 static int
956 year4 (int year)
957 {
958   if (year >= 1 && year <= 9999)
959     return 1;
960   msg (ME, _("Year %d cannot be represented in four digits for "
961              "output formatting purposes."), year);
962   return 0;
963 }
964
965 static int
966 try_CCx (char *dst, const struct fmt_spec *fp, double number)
967 {
968   const struct custom_currency *cc = get_cc(fp->type - FMT_CCA);
969
970   struct fmt_spec f;
971
972   char buf[64];
973   char buf2[64];
974   char *cp;
975
976   /* Determine length available, decimal character for number
977      proper. */
978   f.type = cc->decimal == get_decimal () ? FMT_COMMA : FMT_DOT;
979   f.w = fp->w - strlen (cc->prefix) - strlen (cc->suffix);
980   if (number < 0)
981     f.w -= strlen (cc->neg_prefix) + strlen (cc->neg_suffix) - 1;
982   else
983     /* Convert -0 to +0. */
984     number = fabs (number);
985   f.d = fp->d;
986
987   if (f.w <= 0)
988     return 0;
989
990   /* There's room for all that currency crap.  Let's do the F
991      conversion first. */
992   if (!convert_F (buf, &f, number) || *buf == '*')
993     return 0;
994   insert_commas (buf2, buf, &f);
995
996   /* Postprocess back into buf. */
997   cp = buf;
998   if (number < 0)
999     cp = stpcpy (cp, cc->neg_prefix);
1000   cp = stpcpy (cp, cc->prefix);
1001   {
1002     char *bp = buf2;
1003     while (*bp == ' ')
1004       bp++;
1005
1006     assert ((number >= 0) ^ (*bp == '-'));
1007     if (number < 0)
1008       bp++;
1009
1010     memcpy (cp, bp, f.w - (bp - buf2));
1011     cp += f.w - (bp - buf2);
1012   }
1013   cp = stpcpy (cp, cc->suffix);
1014   if (number < 0)
1015     cp = stpcpy (cp, cc->neg_suffix);
1016
1017   /* Copy into dst. */
1018   assert (cp - buf <= fp->w);
1019   if (cp - buf < fp->w)
1020     {
1021       memcpy (&dst[fp->w - (cp - buf)], buf, cp - buf);
1022       memset (dst, ' ', fp->w - (cp - buf));
1023     }
1024   else
1025     memcpy (dst, buf, fp->w);
1026
1027   return 1;
1028 }
1029
1030 static int
1031 format_and_round (char *dst, double number, const struct fmt_spec *fp,
1032                   int decimals);
1033
1034 /* Tries to format NUMBER into DST as the F format specified in
1035    *FP.  Return true if successful, false on failure. */
1036 static int
1037 try_F (char *dst, const struct fmt_spec *fp, double number)
1038 {
1039   assert (fp->w <= 40);
1040   if (finite (number)) 
1041     {
1042       if (fabs (number) < power10[fp->w])
1043         {
1044           /* The value may fit in the field. */
1045           if (fp->d == 0) 
1046             {
1047               /* There are no decimal places, so there's no way
1048                  that the value can be shortened.  Either it fits
1049                  or it doesn't. */
1050               char buf[41];
1051               sprintf (buf, "%*.0f", fp->w, number);
1052               if (strlen (buf) <= fp->w) 
1053                 {
1054                   buf_copy_str_lpad (dst, fp->w, buf);
1055                   return true; 
1056                 }
1057               else 
1058                 return false;
1059             }
1060           else 
1061             {
1062               /* First try to format it with 2 extra decimal
1063                  places.  This gives us a good chance of not
1064                  needing even more decimal places, but it also
1065                  avoids wasting too much time formatting more
1066                  decimal places on the first try. */
1067               int result = format_and_round (dst, number, fp, fp->d + 2);
1068               if (result >= 0)
1069                 return result;
1070
1071               /* 2 extra decimal places weren't enough to
1072                  correctly round.  Try again with the maximum
1073                  number of places. */
1074               return format_and_round (dst, number, fp, LDBL_DIG + 1);
1075             }
1076         }
1077       else 
1078         {
1079           /* The value is too big to fit in the field. */
1080           return false;
1081         }
1082     }
1083   else
1084     return convert_infinite (dst, fp, number);
1085 }
1086
1087 /* Tries to compose NUMBER into DST in format FP by first
1088    formatting it with DECIMALS decimal places, then rounding off
1089    to as many decimal places will fit or the number specified in
1090    FP, whichever is fewer.
1091
1092    Returns 1 if conversion succeeds, 0 if this try at conversion
1093    failed and so will any other tries (because the integer part
1094    of the number is too long), or -1 if this try failed but
1095    another with higher DECIMALS might succeed (because we'd be
1096    able to properly round). */
1097 static int
1098 format_and_round (char *dst, double number, const struct fmt_spec *fp,
1099                   int decimals)
1100 {
1101   /* Number of characters before the decimal point,
1102      which includes digits and possibly a minus sign. */
1103   int predot_chars;
1104
1105   /* Number of digits in the output fraction,
1106      which may be smaller than fp->d if there's not enough room. */
1107   int fraction_digits;
1108
1109   /* Points to last digit that will remain in the fraction after
1110      rounding. */
1111   char *final_frac_dig;
1112
1113   /* Round up? */
1114   bool round_up;
1115   
1116   char buf[128];
1117   
1118   assert (decimals > fp->d);
1119   if (decimals > LDBL_DIG)
1120     decimals = LDBL_DIG + 1;
1121
1122   sprintf (buf, "%.*f", decimals, number);
1123
1124   /* Omit integer part if it's 0. */
1125   if (!memcmp (buf, "0.", 2))
1126     memmove (buf, buf + 1, strlen (buf));
1127   else if (!memcmp (buf, "-0.", 3))
1128     memmove (buf + 1, buf + 2, strlen (buf + 1));
1129
1130   predot_chars = strcspn (buf, ".");
1131   if (predot_chars > fp->w) 
1132     {
1133       /* Can't possibly fit. */
1134       return 0; 
1135     }
1136   else if (predot_chars == fp->w)
1137     {
1138       /* Exact fit for integer part and sign. */
1139       memcpy (dst, buf, fp->w);
1140       return 1;
1141     }
1142   else if (predot_chars + 1 == fp->w) 
1143     {
1144       /* There's room for the decimal point, but not for any
1145          digits of the fraction.
1146          Right-justify the integer part and sign. */
1147       dst[0] = ' ';
1148       memcpy (dst + 1, buf, fp->w);
1149       return 1;
1150     }
1151
1152   /* It looks like we have room for at least one digit of the
1153      fraction.  Figure out how many. */
1154   fraction_digits = fp->w - predot_chars - 1;
1155   if (fraction_digits > fp->d)
1156     fraction_digits = fp->d;
1157   final_frac_dig = buf + predot_chars + fraction_digits;
1158
1159   /* Decide rounding direction and truncate string. */
1160   if (final_frac_dig[1] == '5'
1161       && strspn (final_frac_dig + 2, "0") == strlen (final_frac_dig + 2)) 
1162     {
1163       /* Exactly 1/2. */
1164       if (decimals <= LDBL_DIG)
1165         {
1166           /* Don't have enough fractional digits to know which way to
1167              round.  We can format with more decimal places, so go
1168              around again. */
1169           return -1;
1170         }
1171       else 
1172         {
1173           /* We used up all our fractional digits and still don't
1174              know.  Round to even. */
1175           round_up = (final_frac_dig[0] - '0') % 2 != 0;
1176         }
1177     }
1178   else
1179     round_up = final_frac_dig[1] >= '5';
1180   final_frac_dig[1] = '\0';
1181
1182   /* Do rounding. */
1183   if (round_up) 
1184     {
1185       char *cp = final_frac_dig;
1186       for (;;) 
1187         {
1188           if (*cp >= '0' && *cp <= '8')
1189             {
1190               (*cp)++;
1191               break; 
1192             }
1193           else if (*cp == '9') 
1194             *cp = '0';
1195           else
1196             assert (*cp == '.');
1197
1198           if (cp == buf || *--cp == '-')
1199             {
1200               size_t length;
1201               
1202               /* Tried to go past the leftmost digit.  Insert a 1. */
1203               memmove (cp + 1, cp, strlen (cp) + 1);
1204               *cp = '1';
1205
1206               length = strlen (buf);
1207               if (length > fp->w) 
1208                 {
1209                   /* Inserting the `1' overflowed our space.
1210                      Drop a decimal place. */
1211                   buf[--length] = '\0';
1212
1213                   /* If that was the last decimal place, drop the
1214                      decimal point too. */
1215                   if (buf[length - 1] == '.')
1216                     buf[length - 1] = '\0';
1217                 }
1218               
1219               break;
1220             }
1221         }
1222     }
1223
1224   /* Omit `-' if value output is zero. */
1225   if (buf[0] == '-' && buf[strspn (buf, "-.0")] == '\0')
1226     memmove (buf, buf + 1, strlen (buf));
1227
1228   buf_copy_str_lpad (dst, fp->w, buf);
1229   return 1;
1230 }
1231
1232 /* Formats non-finite NUMBER into DST according to the width
1233    given in FP. */
1234 static int
1235 convert_infinite (char *dst, const struct fmt_spec *fp, double number)
1236 {
1237   assert (!finite (number));
1238   
1239   if (fp->w >= 3)
1240     {
1241       const char *s;
1242
1243       if (isnan (number))
1244         s = "NaN";
1245       else if (isinf (number))
1246         s = number > 0 ? "+Infinity" : "-Infinity";
1247       else
1248         s = "Unknown";
1249
1250       buf_copy_str_lpad (dst, fp->w, s);
1251     }
1252   else 
1253     memset (dst, '*', fp->w);
1254
1255   return true;
1256 }