300 |
void |
void |
301 |
scm_print_symbol_name (const char *str, size_t len, SCM port) |
scm_print_symbol_name (const char *str, size_t len, SCM port) |
302 |
{ |
{ |
303 |
size_t pos; |
/* This points to the first character that has not yet been written to the |
304 |
|
* port. */ |
305 |
|
size_t pos = 0; |
306 |
|
/* This points to the character we're currently looking at. */ |
307 |
size_t end; |
size_t end; |
308 |
int weird; |
/* If the name contains weird characters, we'll escape them with |
309 |
int maybe_weird; |
* backslashes and set this flag; it indicates that we should surround the |
310 |
|
* name with "#{" and "}#". */ |
311 |
|
int weird = 0; |
312 |
|
/* Backslashes are not sufficient to make a name weird, but if a name is |
313 |
|
* weird because of other characters, backslahes need to be escaped too. |
314 |
|
* The first time we see a backslash, we set maybe_weird, and mw_pos points |
315 |
|
* to the backslash. Then if the name turns out to be weird, we re-process |
316 |
|
* everything starting from mw_pos. */ |
317 |
|
int maybe_weird = 0; |
318 |
size_t mw_pos = 0; |
size_t mw_pos = 0; |
319 |
|
/* If the name is purely numeric, then it's weird as a whole, even though |
320 |
pos = 0; |
* none of the individual characters is weird. But we won't know this |
321 |
weird = 0; |
* until we reach the end of the name. This flag describes the part of the |
322 |
maybe_weird = 0; |
* name we've looked at so far. */ |
323 |
|
int all_digits = 1; |
|
/* XXX - Lots of weird symbol names are missed, such as "12" or |
|
|
"'a". */ |
|
324 |
|
|
325 |
if (len == 0) |
if (len == 0 || str[0] == '\'' || str[0] == ':' || str[len-1] == ':') |
|
scm_lfwrite ("#{}#", 4, port); |
|
|
else if (str[0] == '#' || str[0] == ':' || str[len-1] == ':') |
|
326 |
{ |
{ |
327 |
scm_lfwrite ("#{", 2, port); |
scm_lfwrite ("#{", 2, port); |
328 |
weird = 1; |
weird = 1; |
329 |
} |
} |
330 |
|
|
331 |
for (end = pos; end < len; ++end) |
for (end = pos; end < len; ++end) |
332 |
switch (str[end]) |
switch (str[end]) |
333 |
{ |
{ |
339 |
case ')': |
case ')': |
340 |
case '"': |
case '"': |
341 |
case ';': |
case ';': |
342 |
|
case '#': |
343 |
case SCM_WHITE_SPACES: |
case SCM_WHITE_SPACES: |
344 |
case SCM_LINE_INCREMENTORS: |
case SCM_LINE_INCREMENTORS: |
345 |
|
all_digits = 0; |
346 |
weird_handler: |
weird_handler: |
347 |
if (maybe_weird) |
if (maybe_weird) |
348 |
{ |
{ |
355 |
weird = 1; |
weird = 1; |
356 |
} |
} |
357 |
if (pos < end) |
if (pos < end) |
358 |
{ |
scm_lfwrite (str + pos, end - pos, port); |
|
scm_lfwrite (str + pos, end - pos, port); |
|
|
} |
|
359 |
{ |
{ |
360 |
char buf[2]; |
char buf[2]; |
361 |
buf[0] = '\\'; |
buf[0] = '\\'; |
365 |
pos = end + 1; |
pos = end + 1; |
366 |
break; |
break; |
367 |
case '\\': |
case '\\': |
368 |
|
all_digits = 0; |
369 |
if (weird) |
if (weird) |
370 |
goto weird_handler; |
goto weird_handler; |
371 |
if (!maybe_weird) |
if (!maybe_weird) |
374 |
mw_pos = pos; |
mw_pos = pos; |
375 |
} |
} |
376 |
break; |
break; |
377 |
case '}': |
case '0': case '1': case '2': case '3': case '4': |
378 |
case '#': |
case '5': case '6': case '7': case '8': case '9': |
|
if (weird) |
|
|
goto weird_handler; |
|
379 |
break; |
break; |
380 |
default: |
default: |
381 |
|
all_digits = 0; |
382 |
break; |
break; |
383 |
} |
} |
384 |
|
if (all_digits) |
385 |
|
{ |
386 |
|
scm_lfwrite ("#{", 2, port); |
387 |
|
weird = 1; |
388 |
|
} |
389 |
if (pos < end) |
if (pos < end) |
390 |
scm_lfwrite (str + pos, end - pos, port); |
scm_lfwrite (str + pos, end - pos, port); |
391 |
if (weird) |
if (weird) |