1 /* Copyright (C) 2000,2001, 2006, 2008 Free Software Foundation, Inc.
3 * This library is free software; you can redistribute it and/or
4 * modify it under the terms of the GNU Lesser General Public
5 * License as published by the Free Software Foundation; either
6 * version 2.1 of the License, or (at your option) any later version.
8 * This library is distributed in the hope that it will be useful,
9 * but 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 library; if not, write to the Free Software
15 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
22 * * New primitive: `simple-format', affects `scm-error', scm_display_error, & scm_error message strings
24 * (ice-9 boot) makes `format' an alias for `simple-format' until possibly
25 * extended by the more sophisticated version in (ice-9 format)
27 * (simple-format port message . args)
28 * Write MESSAGE to DESTINATION, defaulting to `current-output-port'.
29 * MESSAGE can contain ~A (was %s) and ~S (was %S) escapes. When printed,
30 * the escapes are replaced with corresponding members of ARGS:
31 * ~A formats using `display' and ~S formats using `write'.
32 * If DESTINATION is #t, then use the `current-output-port',
33 * if DESTINATION is #f, then return a string containing the formatted text.
34 * Does not add a trailing newline."
36 * The two C procedures: scm_display_error and scm_error, as well as the
37 * primitive `scm-error', now use scm_format to do their work. This means
38 * that the message strings of all code must be updated to use ~A where %s
39 * was used before, and ~S where %S was used before.
41 * During the period when there still are a lot of old Guiles out there,
42 * you might want to support both old and new versions of Guile.
44 * There are basically two methods to achieve this. Both methods use
47 * AC_CHECK_FUNCS(scm_simple_format)
49 * in your configure.in.
51 * Method 1: Use the string concatenation features of ANSI C's
56 * #ifdef HAVE_SCM_SIMPLE_FORMAT
62 * Then represent each of your error messages using a preprocessor macro:
64 * #define E_SPIDER_ERROR "There's a spider in your " ## FMT_S ## "!!!"
68 * (define fmt-s (if (defined? 'simple-format) "~S" "%S"))
69 * (define make-message string-append)
71 * (define e-spider-error
72 * (make-message "There's a spider in your " fmt-s "!!!"))
74 * Method 2: Use the oldfmt function found in doc/oldfmt.c.
78 * scm_misc_error ("picnic", scm_c_oldfmt0 ("There's a spider in your ~S!!!"),
83 * (scm-error 'misc-error "picnic" (oldfmt "There's a spider in your ~S!!!")
89 * Take a format string FROM adhering to the new standard format (~A and ~S
90 * as placeholders) of length N and return a string which is adapted
91 * to the format used by the Guile interpreter which you are running.
93 * On successive calls with similar strings but different storage, the
94 * same string with same storage is returned. This is necessary since
95 * the existence of a garbage collector in the system may cause the same
96 * format string to be represented with different storage at different
101 scm_c_oldfmt (char *from
, int n
)
103 #ifdef HAVE_SCM_SIMPLE_FORMAT
106 static struct { int n
; char *from
; char *to
; } *strings
;
108 static int n_strings
= 0;
112 for (i
= 0; i
< n_strings
; ++i
)
113 if (n
== strings
[i
].n
&& strncmp (from
, strings
[i
].from
, n
) == 0)
114 return strings
[i
].to
;
116 if (n_strings
== size
)
121 strings
= scm_must_malloc (size
* sizeof (*strings
), s_oldfmt
);
126 size
= 3 * oldsize
/ 2;
127 strings
= scm_must_realloc (strings
,
128 oldsize
* sizeof (*strings
),
129 size
* sizeof (*strings
),
134 strings
[n_strings
].n
= n
;
135 strings
[n_strings
].from
= strncpy (scm_must_malloc (n
, s_oldfmt
), from
, n
);
136 to
= strings
[n_strings
].to
= scm_must_malloc (n
+ 1, s_oldfmt
);
139 for (i
= 0; i
< n
; ++i
)
141 if (from
[i
] == '~' && ++i
< n
)
148 else if (from
[i
] == 'S')
169 scm_c_oldfmt0 (char *s
)
171 #ifdef HAVE_SCM_SIMPLE_FORMAT
174 return scm_c_oldfmt (s
, strlen (s
));
178 SCM_PROC (s_oldfmt
, "oldfmt", 1, 0, 0, scm_oldfmt
);
183 #ifdef HAVE_SCM_SIMPLE_FORMAT
187 SCM_ASSERT (SCM_NIMP (s
) && SCM_STRINGP (s
), s
, 1, s_oldfmt
);
189 return scm_return_first (scm_mem2string (scm_c_oldfmt (SCM_ROCHARS (s
), n
),