Commit | Line | Data |
---|---|---|
36284627 | 1 | /* Copyright (C) 2000,2001 Free Software Foundation, Inc. |
eb46d7af MD |
2 | * |
3 | * This program is free software; you can redistribute it and/or modify | |
4 | * it under the terms of the GNU General Public License as published by | |
5 | * the Free Software Foundation; either version 2, or (at your option) | |
6 | * any later version. | |
7 | * | |
8 | * This program 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 | |
11 | * GNU General Public License for more details. | |
12 | * | |
13 | * You should have received a copy of the GNU General Public License | |
14 | * along with this software; see the file COPYING. If not, write to | |
15 | * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, | |
16 | * Boston, MA 02111-1307 USA | |
17 | * | |
18 | * As a special exception, the Free Software Foundation gives permission | |
19 | * for additional uses of the text contained in its release of GUILE. | |
20 | * | |
21 | * The exception is that, if you link the GUILE library with other files | |
22 | * to produce an executable, this does not by itself cause the | |
23 | * resulting executable to be covered by the GNU General Public License. | |
24 | * Your use of that executable is in no way restricted on account of | |
25 | * linking the GUILE library code into it. | |
26 | * | |
27 | * This exception does not however invalidate any other reasons why | |
28 | * the executable file might be covered by the GNU General Public License. | |
29 | * | |
30 | * This exception applies only to the code released by the | |
31 | * Free Software Foundation under the name GUILE. If you copy | |
32 | * code from other Free Software Foundation releases into a copy of | |
33 | * GUILE, as the General Public License permits, the exception does | |
34 | * not apply to the code that you add in this way. To avoid misleading | |
35 | * anyone as to the status of such modified files, you must delete | |
36 | * this exception notice from them. | |
37 | * | |
38 | * If you write modifications of your own for GUILE, it is your choice | |
39 | * whether to permit this exception to apply to your modifications. | |
40 | * If you do not wish that, delete this exception notice. | |
41 | */ | |
42 | ||
43 | \f | |
44 | ||
45 | /* From NEWS: | |
46 | * | |
47 | * * New primitive: `simple-format', affects `scm-error', scm_display_error, & scm_error message strings | |
48 | * | |
49 | * (ice-9 boot) makes `format' an alias for `simple-format' until possibly | |
50 | * extended by the more sophisticated version in (ice-9 format) | |
51 | * | |
52 | * (simple-format port message . args) | |
53 | * Write MESSAGE to DESTINATION, defaulting to `current-output-port'. | |
54 | * MESSAGE can contain ~A (was %s) and ~S (was %S) escapes. When printed, | |
55 | * the escapes are replaced with corresponding members of ARGS: | |
56 | * ~A formats using `display' and ~S formats using `write'. | |
57 | * If DESTINATION is #t, then use the `current-output-port', | |
58 | * if DESTINATION is #f, then return a string containing the formatted text. | |
59 | * Does not add a trailing newline." | |
60 | * | |
61 | * The two C procedures: scm_display_error and scm_error, as well as the | |
62 | * primitive `scm-error', now use scm_format to do their work. This means | |
63 | * that the message strings of all code must be updated to use ~A where %s | |
64 | * was used before, and ~S where %S was used before. | |
65 | * | |
66 | * During the period when there still are a lot of old Guiles out there, | |
67 | * you might want to support both old and new versions of Guile. | |
68 | * | |
69 | * There are basically two methods to achieve this. Both methods use | |
70 | * autoconf. Put | |
71 | * | |
72 | * AC_CHECK_FUNCS(scm_simple_format) | |
73 | * | |
74 | * in your configure.in. | |
75 | * | |
76 | * Method 1: Use the string concatenation features of ANSI C's | |
77 | * preprocessor. | |
78 | * | |
79 | * In C: | |
80 | * | |
81 | * #ifdef HAVE_SCM_SIMPLE_FORMAT | |
82 | * #define FMT_S "~S" | |
83 | * #else | |
84 | * #define FMT_S "%S" | |
85 | * #endif | |
86 | * | |
87 | * Then represent each of your error messages using a preprocessor macro: | |
88 | * | |
89 | * #define E_SPIDER_ERROR "There's a spider in your " ## FMT_S ## "!!!" | |
90 | * | |
91 | * In Scheme: | |
92 | * | |
93 | * (define fmt-s (if (defined? 'simple-format) "~S" "%S")) | |
94 | * (define make-message string-append) | |
95 | * | |
96 | * (define e-spider-error | |
97 | * (make-message "There's a spider in your " fmt-s "!!!")) | |
98 | * | |
99 | * Method 2: Use the oldfmt function found in doc/oldfmt.c. | |
100 | * | |
101 | * In C: | |
102 | * | |
103 | * scm_misc_error ("picnic", scm_c_oldfmt0 ("There's a spider in your ~S!!!"), | |
104 | * ...); | |
105 | * | |
106 | * In Scheme: | |
107 | * | |
108 | * (scm-error 'misc-error "picnic" (oldfmt "There's a spider in your ~S!!!") | |
109 | * ...) | |
110 | * | |
111 | */ | |
112 | ||
113 | /* | |
114 | * Take a format string FROM adhering to the new standard format (~A and ~S | |
115 | * as placeholders) of length N and return a string which is adapted | |
116 | * to the format used by the Guile interpreter which you are running. | |
117 | * | |
118 | * On successive calls with similar strings but different storage, the | |
119 | * same string with same storage is returned. This is necessary since | |
120 | * the existence of a garbage collector in the system may cause the same | |
121 | * format string to be represented with different storage at different | |
122 | * calls. | |
123 | */ | |
124 | ||
125 | char * | |
126 | scm_c_oldfmt (char *from, int n) | |
127 | { | |
128 | #ifdef HAVE_SCM_SIMPLE_FORMAT | |
129 | return from; | |
130 | #else | |
131 | static struct { int n; char *from; char *to; } *strings; | |
132 | static int size = 0; | |
133 | static int n_strings = 0; | |
134 | char *to; | |
135 | int i; | |
136 | ||
137 | for (i = 0; i < n_strings; ++i) | |
138 | if (n == strings[i].n && strncmp (from, strings[i].from, n) == 0) | |
139 | return strings[i].to; | |
140 | ||
141 | if (n_strings == size) | |
142 | { | |
143 | if (size == 0) | |
144 | { | |
145 | size = 10; | |
146 | strings = scm_must_malloc (size * sizeof (*strings), s_oldfmt); | |
147 | } | |
148 | else | |
149 | { | |
150 | int oldsize = size; | |
151 | size = 3 * oldsize / 2; | |
152 | strings = scm_must_realloc (strings, | |
153 | oldsize * sizeof (*strings), | |
154 | size * sizeof (*strings), | |
155 | s_oldfmt); | |
156 | } | |
157 | } | |
158 | ||
159 | strings[n_strings].n = n; | |
160 | strings[n_strings].from = strncpy (scm_must_malloc (n, s_oldfmt), from, n); | |
161 | to = strings[n_strings].to = scm_must_malloc (n + 1, s_oldfmt); | |
162 | n_strings++; | |
163 | ||
164 | for (i = 0; i < n; ++i) | |
165 | { | |
166 | if (from[i] == '~' && ++i < n) | |
167 | { | |
168 | if (from[i] == 'A') | |
169 | { | |
170 | to[i - 1] = '%'; | |
171 | to[i] = 's'; | |
172 | } | |
173 | else if (from[i] == 'S') | |
174 | { | |
175 | to[i - 1] = '%'; | |
176 | to[i] = 'S'; | |
177 | } | |
178 | else | |
179 | { | |
180 | to[i - 1] = '~'; | |
181 | to[i] = from[i]; | |
182 | } | |
183 | continue; | |
184 | } | |
185 | to[i] = from[i]; | |
186 | } | |
187 | to[i] = '\0'; | |
188 | ||
189 | return to; | |
190 | #endif | |
191 | } | |
192 | ||
193 | char * | |
194 | scm_c_oldfmt0 (char *s) | |
195 | { | |
196 | #ifdef HAVE_SCM_SIMPLE_FORMAT | |
197 | return s; | |
198 | #else | |
199 | return scm_c_oldfmt (s, strlen (s)); | |
200 | #endif | |
201 | } | |
202 | ||
203 | SCM_PROC (s_oldfmt, "oldfmt", 1, 0, 0, scm_oldfmt); | |
204 | ||
205 | SCM | |
206 | scm_oldfmt (SCM s) | |
207 | { | |
208 | #ifdef HAVE_SCM_SIMPLE_FORMAT | |
209 | return s; | |
210 | #else | |
211 | int n; | |
212 | SCM_ASSERT (SCM_NIMP (s) && SCM_STRINGP (s), s, 1, s_oldfmt); | |
213 | n = SCM_LENGTH (s); | |
36284627 DH |
214 | return scm_return_first (scm_mem2string (scm_c_oldfmt (SCM_ROCHARS (s), n), |
215 | n), | |
eb46d7af MD |
216 | s); |
217 | #endif | |
218 | } |