Commit 8ddedef7 authored by Erick's avatar Erick

Bug fix on write-char with UTF8 characters

parent 8589d46d
......@@ -20,7 +20,7 @@
*
* Author: Erick Gallesio [eg@unice.fr]
* Creation date: 17-Feb-1993 12:27
* Last file update: 14-Jul-2018 19:38 (eg)
* Last file update: 18-Jul-2018 16:14 (eg)
*
*/
......@@ -208,7 +208,7 @@ DEFINE_PRIMITIVE("%set-std-port!", set_std_port, subr2, (SCM index, SCM port))
case SCM_LONG(0): if (!IPORTP(port)) goto badport; vm->iport = port; break;
case SCM_LONG(1): if (!OPORTP(port)) goto badport; vm->oport = port; break;
case SCM_LONG(2): if (!OPORTP(port)) goto badport; vm->eport = port; break;
default: STk_error_bad_io_param("bad code ~S", index);
default: STk_error_bad_io_param("bad port number ~S", index);
}
return STk_void;
badport:
......@@ -307,7 +307,6 @@ DEFINE_PRIMITIVE("read-char", read_char, subr01, (SCM port))
c = STk_get_character(port);
if (c == UTF8_INCORRECT_SEQUENCE)
error_bad_utf8_character(c);
return (c == EOF) ? STk_eof : MAKE_CHARACTER(c);
}
......@@ -624,7 +623,7 @@ DEFINE_PRIMITIVE("write-char", write_char, subr12, (SCM c, SCM port))
{
if (!CHARACTERP(c)) STk_error_bad_io_param("bad character ~S", c);
port = verify_port(port, PORT_WRITE);
STk_putc(CHARACTER_VAL(c), port);
STk_put_character(CHARACTER_VAL(c), port);
return STk_void;
}
......
/*
* s i o . c -- Low level I/O
* s i o . c -- Low level I/O
*
* Copyright © 1993-2011 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
* Copyright © 1993-2018 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
*
*
* This program is free software; you can redistribute it and/or modify
......@@ -20,9 +20,9 @@
* USA.
*
*
* Author: Erick Gallesio [eg@kaolin.unice.fr]
* Author: Erick Gallesio [eg@kaolin.unice.fr]
* Creation date: ????
* Last file update: 1-May-2011 22:49 (eg)
* Last file update: 18-Jul-2018 16:24 (eg)
*
*
* Completely rewritten for the STklos version (Jan. 2000)
......@@ -60,11 +60,15 @@ STk_getc(SCM port)
int
STk_get_character(SCM port) /* result may be a wide character */
{
return (PORT_UNGETC(port) != EOF) ?
/* we have an ungetted char, call normal getc */
STk_getc(port):
/* try to read it as an UTF-8 sequence */
STk_utf8_read_char(port);
if (STk_use_utf8)
return (PORT_UNGETC(port) != EOF) ?
/* we have an ungetted char, call normal getc */
STk_getc(port):
/* try to read it as an UTF-8 sequence */
// FIXME: on ne gère pas la ligne ici!!!
STk_utf8_read_char(port);
else
return STk_getc(port);
}
......@@ -110,6 +114,30 @@ STk_putc(int c, SCM port)
return n;
}
int
STk_put_character(int c, SCM port) /* c may be a wide char */
{
if (!STk_use_utf8)
return STk_putc(c, port);
else {
char str[5] = {}, *s;
int n = STk_char2utf8(c, str);
str[n] = '\0';
n = 0;
for (s = str; *s; s++)
n += PORT_PUTC(port)(*s, PORT_STREAM(port));
if (n >= 0)
PORT_POS(port) += 1;
return n;
}
}
int
STk_puts(char *s, SCM port)
{
......
......@@ -21,7 +21,7 @@
*
* Author: Erick Gallesio [eg@unice.fr]
* Creation date: 28-Dec-1999 22:58 (eg)
* Last file update: 11-Jul-2018 16:30 (eg)
* Last file update: 18-Jul-2018 16:17 (eg)
*/
......@@ -953,6 +953,7 @@ int STk_get_character(SCM port); /* result may be a wide char */
int STk_ungetc(int c, SCM port);
int STk_close(SCM port);
int STk_putc(int c, SCM port);
int STk_put_character(int c, SCM port); /* c may be a wide char */
int STk_puts(char *s, SCM port);
int STk_putstring(SCM s, SCM port);
int STk_nputs(SCM port, char *s, int len);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment