andrius
/
mes
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

core: Display and write string and char compliance. 

* src/lib.c (display_helper): Display and write char and string compliance.
This commit is contained in:
Jan Nieuwenhuizen 2018-01-22 23:45:46 +01:00
parent 5a7db9749d
commit d176d1bf6c
1 changed files with 27 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
src/lib.c
View File

@ -32,8 +32,25 @@ display_helper (SCM x, int cont, char* sep, int fd, int write_p)
{
case TCHAR:
{
fputs ("#\\", fd);
fputc (VALUE (x), fd);
if (!write_p)
fputc (VALUE (x), fd);
else
{
fputs ("#\\", fd);
switch (VALUE (x))
{
case '\0': fputs ("nul", fd); break;
case '\a': fputs ("alarm", fd); break;
case '\b': fputs ("backspace", fd); break;
case '\t': fputs ("tab", fd); break;
case '\n': fputs ("newline", fd); break;
case '\v': fputs ("vtab", fd); break;
case '\f': fputs ("page", fd); break;
case '\r': fputs ("return", fd); break;
case ' ': fputs ("space", fd); break;
default: fputc (VALUE (x), fd);
}
}
break;
}
case TCLOSURE:
@ -109,7 +126,14 @@ display_helper (SCM x, int cont, char* sep, int fd, int write_p)
SCM t = CAR (x);
while (t && t != cell_nil)
{
fputc (VALUE (CAR (t)), fd);
switch (write_p ? VALUE (CAR (t)) : 0)
{
case '\t': fputs ("\\t", fd); break;
case '\n': fputs ("\\n", fd); break;
case '\\': fputs ("\\\\", fd); break;
case '"': fputs ("\\\"", fd); break;
default: fputc (VALUE (CAR (t)), fd);
}
t = CDR (t);
}
if (write_p && TYPE (x) == TSTRING) fputc ('"', fd);