misc-deps
/
racket-ansi
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Use standard compilation approach for the C extension

This commit is contained in:
Tony Garnock-Jones 2017-02-25 16:11:17 -05:00
parent 89dfc9bab5
commit c2454badf7
4 changed files with 33 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
ansi/main.rkt
View File

@ -2,8 +2,8 @@
(require "ansi.rkt" (require "ansi.rkt"
"lcd-terminal.rkt" "lcd-terminal.rkt"
"private/tty-raw-extension") "private/tty-raw-extension.rkt")
(provide (all-from-out "ansi.rkt") (provide (all-from-out "ansi.rkt")
(all-from-out "lcd-terminal.rkt") (all-from-out "lcd-terminal.rkt")
(all-from-out "private/tty-raw-extension")) (all-from-out "private/tty-raw-extension.rkt"))

38
ansi/private/install.rkt
View File

@ -1,29 +1,19 @@
#lang racket/base #lang racket/base
(require make/setup-extension)
(provide pre-installer) (provide pre-installer)
(require racket/file)
(require dynext/file)
(require dynext/compile)
(require dynext/link)
(define (pre-installer collections-top-path collection-path) (define (pre-installer collections-top-path collection-path)
(define private-path (build-path collection-path "private")) (pre-install collection-path
(parameterize ((current-directory private-path)) (build-path collection-path "private")
(define shared-object-target-path (build-path private-path "tty-raw-extension.c"
"compiled" "."
"native" '()
(system-library-subpath))) '()
(define shared-object-target (build-path shared-object-target-path '()
(append-extension-suffix "tty-raw-extension"))) '()
(when (file-exists? shared-object-target) (delete-file shared-object-target)) '()
(define c-source (build-path private-path "tty-raw-extension.c")) '()
(define object (build-path shared-object-target-path "tty-raw-extension.o")) (lambda (thunk) (thunk))
(make-directory* shared-object-target-path) #t))
(compile-extension #f ;; not quiet
c-source
object
'())
(link-extension #f ;; not quiet
(list object)
shared-object-target)))

20
ansi/private/tty-raw-extension.c
View File

@ -13,7 +13,9 @@
static int is_raw = 0; static int is_raw = 0;
static struct termios saved; static struct termios saved;
static int ttyraw(void) { static int ttyraw(void)
XFORM_SKIP_PROC
{
/* Based on the settings given in http://www.minek.com/files/unix_examples/raw.html */ /* Based on the settings given in http://www.minek.com/files/unix_examples/raw.html */
struct termios t; struct termios t;
@ -36,7 +38,9 @@ static int ttyraw(void) {
return 0; return 0;
} }
static int ttyrestore(void) { static int ttyrestore(void)
XFORM_SKIP_PROC
{
if (!is_raw) return 0; if (!is_raw) return 0;
if (tcsetattr(STDIN_FD, TCSAFLUSH, &saved) < 0) return -1; if (tcsetattr(STDIN_FD, TCSAFLUSH, &saved) < 0) return -1;
@ -46,11 +50,15 @@ static int ttyrestore(void) {
} }
static Scheme_Object *sch_ttyraw(int argc, Scheme_Object **argv) { static Scheme_Object *sch_ttyraw(int argc, Scheme_Object **argv) {
return ttyraw() == 0 ? scheme_true : scheme_false; int result;
result = ttyraw();
return result == 0 ? scheme_true : scheme_false;
} }
static Scheme_Object *sch_ttyrestore(int argc, Scheme_Object **argv) { static Scheme_Object *sch_ttyrestore(int argc, Scheme_Object **argv) {
return ttyrestore() == 0 ? scheme_true : scheme_false; int result;
result = ttyrestore();
return result == 0 ? scheme_true : scheme_false;
} }
Scheme_Object *scheme_reload(Scheme_Env *env) { Scheme_Object *scheme_reload(Scheme_Env *env) {
@ -66,7 +74,9 @@ Scheme_Object *scheme_reload(Scheme_Env *env) {
return scheme_void; return scheme_void;
} }
Scheme_Object *scheme_initialize(Scheme_Env *env) { Scheme_Object *scheme_initialize(Scheme_Env *env)
XFORM_SKIP_PROC
{
atexit((void (*)(void)) ttyrestore); atexit((void (*)(void)) ttyrestore);
return scheme_reload(env); return scheme_reload(env);
} }

2
ansi/test-raw.rkt
View File

@ -1,6 +1,6 @@
#lang racket/base #lang racket/base
(require "private/tty-raw-extension") (require "private/tty-raw-extension.rkt")
(require "main.rkt") (require "main.rkt")
(require racket/set) (require racket/set)