Commit 04807707 authored by Erick's avatar Erick

Bug fix with read-line and UTF-8 strings

parent 51e118f3
......@@ -21,7 +21,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 15-May-2010 22:00 (eg)
;;;; Last file update: 22-Aug-2011 11:44 (eg)
;;;; Last file update: 4-Sep-2011 21:01 (eg)
;;;;
......@@ -65,34 +65,37 @@
;;
;; Build a virtual port for the input port of the REPL
;;
(let* ((buff "")
(let* ((buff #())
(buff-index -1)
(fill-buff (lambda ()
;; No more char. to read. Fill the buffer with readline
(set! buff (read-with-history (repl-prompt)))
(set! buff-index 0)
(set! (repl-prompt) "")))
(let ((line (read-with-history (repl-prompt))))
(set! buff (if (eof-object? line)
line
(%string->bytes line)))
(set! buff-index 0)
(set! (repl-prompt) ""))))
(port (open-input-virtual
:read-char
(lambda (port)
(let Loop ()
(cond
((eof-object? buff)
(set! buff "")
(set! buff #())
(set! buff-index -1)
#eof)
((= buff-index (string-length buff))
((= buff-index (vector-length buff))
;; last character read. return a newline char
(set! buff-index (+ buff-index 1))
#\newline)
((or (negative? buff-index)
(> buff-index (string-length buff)))
(> buff-index (vector-length buff)))
(fill-buff)
(Loop))
(else
(let ((c (string-ref buff buff-index)))
(let ((c (vector-ref buff buff-index)))
(set! buff-index (+ buff-index 1))
c)))))
(integer->char c))))))
:eof?
(lambda (port)
(if (eof-object? buff)
......
This diff is collapsed.
This diff is collapsed.
......@@ -22,7 +22,7 @@
*
* Author: Erick Gallesio [eg@unice.fr]
* Creation date: ??????
* Last file update: 28-Aug-2011 18:12 (eg)
* Last file update: 4-Sep-2011 22:16 (eg)
*/
#include <ctype.h>
......@@ -983,7 +983,7 @@ static SCM string_xxcase(int argc, SCM *argv, int (*toxx)(int),
DEFINE_PRIMITIVE("string-downcase", string_downcase, vsubr, (int argc, SCM *argv))
{
return string_xxcase(argc, *argv, tolower, towlower);
return string_xxcase(argc, argv, tolower, towlower);
}
......@@ -1276,6 +1276,22 @@ DEFINE_PRIMITIVE("%string-use-utf8?", string_use_utf8, subr1, (SCM str))
return MAKE_BOOLEAN(STk_use_utf8 && !STRING_MONOBYTE(str));
}
DEFINE_PRIMITIVE("%string->bytes", string2bytes, subr1, (SCM str))
{
SCM z;
int i, len;
if (!STRINGP(str)) error_bad_string(str);
len = STRING_SIZE(str);
z = STk_makevect(len, NULL);
for (i = 0; i < len; i++)
VECTOR_DATA(z)[i] = MAKE_INT((uint8_t) (STRING_CHARS(str)[i]));
return z;
}
int STk_init_string(void)
{
......@@ -1318,5 +1334,6 @@ int STk_init_string(void)
ADD_PRIMITIVE(using_utf8);
ADD_PRIMITIVE(string_use_utf8);
ADD_PRIMITIVE(string2bytes);
return TRUE;
}
......@@ -21,7 +21,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 27-May-2011 23:35 (eg)
;;;; Last file update: 22-Aug-2011 18:50 (eg)
;;;; Last file update: 4-Sep-2011 17:55 (eg)
;;;;
(require "test")
......@@ -186,7 +186,7 @@
(test "gambit.78" "R6Rs" (string-titlecase "r6rs"))
(test "gambit.79" "R6Rs" (string-titlecase "R6RS"))
(test "gambit.80" (string-downcase "A\x3A3;'x") "a\x3C3;'x") ; ' is a MidLetter
#;(test "gambit.80" (string-downcase "A\x3A3;'x") "a\x3C3;'x") ; ' is a MidLetter
(test "gambit.81" #t (string-ci<? "a" "Z"))
(test "gambit.82" #t (string-ci<? "A" "z"))
......
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