Skip to content

Commit

Permalink
- add unicode support to the expression editor. entry and display now…
Browse files Browse the repository at this point in the history 
… work

  except that combining characters are not treated correctly for
  line-wrapping.  this addresses github issue cisco#32 and part of issue cisco#81.
    c/expeditor.c, s/expeditor.ss
  • Loading branch information
@eraserhd
eraserhd committed Jul 21, 2016
1 parent fe172bf commit 87d4811
Show file tree
Hide file tree
Showing 3 changed files with 62 additions and 36 deletions.
4 changes: 4 additions & 0 deletions LOG
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
49 changes: 37 additions & 12 deletions c/expeditor.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -539,6 +539,9 @@ static ptr s_ee_get_clipboard(void) {
#include <time.h>
#include <fcntl.h>
#include <sys/ioctl.h>
#include <wchar.h>
#include <locale.h>
#include <xlocale.h>

#if defined(TIOCGWINSZ) && defined(SIGWINCH) && defined(EINTR)
#define HANDLE_SIGWINCH
Expand All @@ -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;
Expand Down Expand Up @@ -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;
Expand All @@ -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
Expand Down Expand Up @@ -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;
}

Expand Down Expand Up @@ -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) {
Expand Down
45 changes: 21 additions & 24 deletions s/expeditor.ss
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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))
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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)])
Expand Down Expand Up @@ -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))

Expand All @@ -2871,52 +2868,52 @@
(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
"malformed key ~s (nothing following \\)"
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)
(warningf 'ee-bind-key
"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))

Expand Down

0 comments on commit 87d4811

Please sign in to comment.