1 /* Copyright (C) 2000,2001, 2006, 2008 Free Software Foundation, Inc.
3 * This program is free software; you can redistribute it and/or
4 * modify it under the terms of the GNU Lesser General Public License
5 * as published by the Free Software Foundation; either version 3, or
6 * (at your option) any later version.
8 * This program is distributed in the hope that it will be useful, but
9 * WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
11 * Lesser General Public License for more details.
13 * You should have received a copy of the GNU Lesser General Public
14 * License along with this software; see the file COPYING.LESSER. If
15 * not, write to the Free Software Foundation, Inc., 51 Franklin
16 * Street, Fifth Floor, Boston, MA 02110-1301 USA
23 * * New primitive: `simple-format', affects `scm-error', scm_display_error, & scm_error message strings
25 * (ice-9 boot) makes `format' an alias for `simple-format' until possibly
26 * extended by the more sophisticated version in (ice-9 format)
28 * (simple-format port message . args)
29 * Write MESSAGE to DESTINATION, defaulting to `current-output-port'.
30 * MESSAGE can contain ~A (was %s) and ~S (was %S) escapes. When printed,
31 * the escapes are replaced with corresponding members of ARGS:
32 * ~A formats using `display' and ~S formats using `write'.
33 * If DESTINATION is #t, then use the `current-output-port',
34 * if DESTINATION is #f, then return a string containing the formatted text.
35 * Does not add a trailing newline."
37 * The two C procedures: scm_display_error and scm_error, as well as the
38 * primitive `scm-error', now use scm_format to do their work. This means
39 * that the message strings of all code must be updated to use ~A where %s
40 * was used before, and ~S where %S was used before.
42 * During the period when there still are a lot of old Guiles out there,
43 * you might want to support both old and new versions of Guile.
45 * There are basically two methods to achieve this. Both methods use
48 * AC_CHECK_FUNCS(scm_simple_format)
50 * in your configure.in.
52 * Method 1: Use the string concatenation features of ANSI C's
57 * #ifdef HAVE_SCM_SIMPLE_FORMAT
63 * Then represent each of your error messages using a preprocessor macro:
65 * #define E_SPIDER_ERROR "There's a spider in your " ## FMT_S ## "!!!"
69 * (define fmt-s (if (defined? 'simple-format) "~S" "%S"))
70 * (define make-message string-append)
72 * (define e-spider-error
73 * (make-message "There's a spider in your " fmt-s "!!!"))
75 * Method 2: Use the oldfmt function found in doc/oldfmt.c.
79 * scm_misc_error ("picnic", scm_c_oldfmt0 ("There's a spider in your ~S!!!"),
84 * (scm-error 'misc-error "picnic" (oldfmt "There's a spider in your ~S!!!")
90 * Take a format string FROM adhering to the new standard format (~A and ~S
91 * as placeholders) of length N and return a string which is adapted
92 * to the format used by the Guile interpreter which you are running.
94 * On successive calls with similar strings but different storage, the
95 * same string with same storage is returned. This is necessary since
96 * the existence of a garbage collector in the system may cause the same
97 * format string to be represented with different storage at different
102 scm_c_oldfmt (char *from
, int n
)
104 #ifdef HAVE_SCM_SIMPLE_FORMAT
107 static struct { int n
; char *from
; char *to
; } *strings
;
109 static int n_strings
= 0;
113 for (i
= 0; i
< n_strings
; ++i
)
114 if (n
== strings
[i
].n
&& strncmp (from
, strings
[i
].from
, n
) == 0)
115 return strings
[i
].to
;
117 if (n_strings
== size
)
122 strings
= scm_must_malloc (size
* sizeof (*strings
), s_oldfmt
);
127 size
= 3 * oldsize
/ 2;
128 strings
= scm_must_realloc (strings
,
129 oldsize
* sizeof (*strings
),
130 size
* sizeof (*strings
),
135 strings
[n_strings
].n
= n
;
136 strings
[n_strings
].from
= strncpy (scm_must_malloc (n
, s_oldfmt
), from
, n
);
137 to
= strings
[n_strings
].to
= scm_must_malloc (n
+ 1, s_oldfmt
);
140 for (i
= 0; i
< n
; ++i
)
142 if (from
[i
] == '~' && ++i
< n
)
149 else if (from
[i
] == 'S')
170 scm_c_oldfmt0 (char *s
)
172 #ifdef HAVE_SCM_SIMPLE_FORMAT
175 return scm_c_oldfmt (s
, strlen (s
));
179 SCM_PROC (s_oldfmt
, "oldfmt", 1, 0, 0, scm_oldfmt
);
184 #ifdef HAVE_SCM_SIMPLE_FORMAT
188 SCM_ASSERT (SCM_NIMP (s
) && SCM_STRINGP (s
), s
, 1, s_oldfmt
);
190 return scm_return_first (scm_mem2string (scm_c_oldfmt (SCM_ROCHARS (s
), n
),