From 87d4811781d7e9183f7710aa6a809b850a38454f Mon Sep 17 00:00:00 2001 From: Jason Felice Date: Tue, 12 Jul 2016 17:02:03 -0400 Subject: [PATCH] - add unicode support to the expression editor. entry and display now work except that combining characters are not treated correctly for line-wrapping. this addresses github issue #32 and part of issue #81. c/expeditor.c, s/expeditor.ss --- LOG | 4 ++++ c/expeditor.c | 49 +++++++++++++++++++++++++++++++++++++------------ s/expeditor.ss | 45 +++++++++++++++++++++------------------------ 3 files changed, 62 insertions(+), 36 deletions(-) diff --git a/LOG b/LOG index 559e4e65a..912e3850e 100644 --- a/LOG +++ b/LOG @@ -256,3 +256,7 @@ - fixed three instances of unchecked mallocs reported by laqrix in github issue #77. io.c, schlib.c, thread.c +- add unicode support to the expression editor. entry and display now work + except that combining characters are not treated correctly for + line-wrapping. this addresses github issue #32 and part of issue #81. + c/expeditor.c, s/expeditor.ss diff --git a/c/expeditor.c b/c/expeditor.c index c93d29acc..34779cd3b 100644 --- a/c/expeditor.c +++ b/c/expeditor.c @@ -539,6 +539,9 @@ static ptr s_ee_get_clipboard(void) { #include #include #include +#include +#include +#include #if defined(TIOCGWINSZ) && defined(SIGWINCH) && defined(EINTR) #define HANDLE_SIGWINCH @@ -561,6 +564,9 @@ static void handle_sigwinch(UNUSED int sig) { #define STDOUT_FD 1 static IBOOL disable_auto_margin = 0, avoid_last_column = 0; +static locale_t term_locale; +static mbstate_t term_in_mbs; +static mbstate_t term_out_mbs; static IBOOL s_ee_init_term(void) { int errret; @@ -613,6 +619,10 @@ static IBOOL s_ee_init_term(void) { sigaction(SIGWINCH, &act, (struct sigaction *)0); #endif + term_locale = newlocale(LC_ALL_MASK, "", NULL); + memset(&term_out_mbs, 0, sizeof(term_out_mbs)); + memset(&term_in_mbs, 0, sizeof(term_in_mbs)); + init_status = 1; } else { init_status = 0; @@ -624,7 +634,8 @@ static IBOOL s_ee_init_term(void) { /* returns char, eof, #t (winched), or #f (nothing ready), the latter only if blockp is false */ static ptr s_ee_read_char(IBOOL blockp) { - ptr msg; int fd = STDIN_FD; int n; char buf[1]; + ptr msg; int fd = STDIN_FD; int n; char buf[1]; wchar_t wch; size_t sz; + locale_t old_locale; #ifdef PTHREADS ptr tc = get_thread_context(); #endif @@ -657,18 +668,24 @@ static ptr s_ee_read_char(IBOOL blockp) { n = READ(fd, buf, 1); } #endif /* PTHREADS */ - } while (n < 0 && errno == EINTR); - if (n == 1) return Schar(buf[0]); - if (n == 0) return Seof_object; + if (n == 1) { + old_locale = uselocale(term_locale); + sz = mbrtowc(&wch, buf, 1, &term_out_mbs); + uselocale(old_locale); + if (sz == 1) { + return Schar(wch); + } + } - msg = n < 0 ? S_strerror(errno) : Sfalse; + } while ((n < 0 && errno == EINTR) || (n == 1 && sz == (size_t)-2)); - if (msg != Sfalse) - S_error1("expeditor", "error reading from console: ~a", msg); - else - S_error("expeditor", "error reading from console"); + if (n == 0) return Seof_object; + msg = S_strerror(errno); + S_error1("expeditor", "error reading from console: ~a", msg); + + memset(&term_out_mbs, 0, sizeof(term_out_mbs)); return Svoid; } @@ -997,9 +1014,17 @@ static ptr s_ee_get_clipboard(void) { #endif /* WIN32 */ -static void s_ee_write_char(INT c) { - if ((unsigned)c > 255) c = '?'; - putchar(c); +static void s_ee_write_char(wchar_t wch) { + locale_t old; char buf[MB_LEN_MAX]; size_t n; + + old = uselocale(term_locale); + n = wcrtomb(buf, wch, &term_in_mbs); + if (n == (size_t)-1) { + putchar('?'); + } else { + fwrite(buf, 1, n, stdout); + } + uselocale(old); } static void s_ee_flush(void) { diff --git a/s/expeditor.ss b/s/expeditor.ss index 98e0a4461..fadd08827 100644 --- a/s/expeditor.ss +++ b/s/expeditor.ss @@ -111,9 +111,6 @@ [(x ...) (p x ... e)] [(x ... y) b1 b2 ...]))])) -; expression editor presently handles only ascii key bindings -(define (ascii? c) ($fxu< (char->integer c) 256)) - ; screen initialization and manipulation routines (module (init-screen raw-mode no-raw-mode @@ -137,7 +134,7 @@ (define init-term (foreign-procedure "(cs)ee_init_term" () boolean)) (define $ee-read-char (foreign-procedure "(cs)ee_read_char" (boolean) scheme-object)) - (define $ee-write-char (foreign-procedure "(cs)ee_write_char" (int) void)) + (define $ee-write-char (foreign-procedure "(cs)ee_write_char" (wchar_t) void)) (define ee-flush (foreign-procedure "(cs)ee_flush" () void)) (define get-screen-size (foreign-procedure "(cs)ee_get_screen_size" () scheme-object)) (define raw-mode (foreign-procedure "(cs)ee_raw" () void)) @@ -226,9 +223,9 @@ (if (fx= cursor-col cols) (begin (exit-am-mode) - ($ee-write-char (char->integer c)) + ($ee-write-char c) (enter-am-mode)) - ($ee-write-char (char->integer c)))) + ($ee-write-char c))) ; comments regarding ee-write-char above apply also to ee-display-string (define (ee-display-string s) @@ -1915,7 +1912,7 @@ (let ([c (ee-read-char)]) (let ([x (if (eof-object? c) (lambda (ee entry c) #f) - (and (ascii? c) (vector-ref table (char->integer c))))]) + (hashtable-ref table c ee-insert-self))]) (cond [(procedure? x) (let ([n (eestate-repeat-count ee)]) @@ -2852,15 +2849,15 @@ (module (dispatch-table? base-dispatch-table ee-bind-key) (define make-dispatch-table (lambda () - (make-vector 256 #f))) + (make-eqv-hashtable 256))) - (define dispatch-table? vector?) + (define dispatch-table? hashtable?) (define ee-bind-key (lambda (key proc) - (unless (or (and (char? key) (ascii? key)) - (and (string? key) (fx> (string-length key) 0) (andmap ascii? (string->list key)))) - ($oops 'ee-bind-key "~s is not a valid key (ascii character or nonempty ascii string)" key)) + (unless (or (char? key) + (and (string? key) (fx> (string-length key) 0))) + ($oops 'ee-bind-key "~s is not a valid key (character or nonempty string)" key)) (unless (procedure? proc) ($oops 'ee-bind-key "~s is not a procedure" proc)) @@ -2871,7 +2868,7 @@ (case c [(#\\) (s-backslash table (fx+ i 1))] [(#\^) (s-caret table (fx+ i 1))] - [else (s-lookup table (fx+ i 1) (char->integer c))]))) + [else (s-lookup table (fx+ i 1) c)]))) (define (s-backslash table i) (when (fx= i n) ($oops 'ee-bind-key @@ -2879,28 +2876,28 @@ key)) (let ([c (string-ref key i)]) (case c - [(#\e) (s-lookup table (fx+ i 1) 27)] + [(#\e) (s-lookup table (fx+ i 1) #\esc)] [(#\\ #\^) (s-lookup table (fx+ i 1) c)] [else ($oops 'ee-bind-key "malformed key ~s (unexpected character following \\)" key)]))) (define (s-caret table i) - (define (^char->integer c) - (fxlogand (char->integer c) #b11111)) + (define (^char c) + (integer->char (fxlogand (char->integer c) #b11111))) (when (fx= i n) ($oops 'ee-bind-key "malformed key ~s (nothing following ^)" key)) - (s-lookup table (fx+ i 1) (^char->integer (string-ref key i)))) - (define (s-lookup table i code) - (let ([x (vector-ref table code)]) + (s-lookup table (fx+ i 1) (^char (string-ref key i)))) + (define (s-lookup table i key) + (let ([x (hashtable-ref table key #f)]) (cond [(fx= i n) (when (dispatch-table? x) (warningf 'ee-bind-key "definition for key ~s disables its use as a prefix" key)) - (vector-set! table code proc)] + (hashtable-set! table key proc)] [(dispatch-table? x) (s0 x i)] [else (when (procedure? x) @@ -2908,15 +2905,15 @@ "definition for key ~s disables its use as a prefix" key)) (let ([x (make-dispatch-table)]) - (vector-set! table code x) + (hashtable-set! table key x) (s0 x i))]))) (s0 base-dispatch-table 0)) - (let ([code (char->integer key)]) - (when (dispatch-table? (vector-ref base-dispatch-table code)) + (begin + (when (dispatch-table? (hashtable-ref base-dispatch-table key #f)) (warningf 'ee-bind-key "definition for key ~s disables its use as a prefix" key)) - (vector-set! base-dispatch-table code proc))))) + (hashtable-set! base-dispatch-table key proc))))) (define base-dispatch-table (make-dispatch-table))