Support Racket on Chez Scheme

Use the FFI instead of depending on Racket BC's C API.

(But we still build a shared C library, because I'm not sure
about the portability of the `struct termios` type.)

Closes https://github.com/tonyg/racket-ansi/issues/6

.travis.yml

@@ -0,0 +1,51 @@
+language: c
+
+# Based on: https://github.com/greghendershott/travis-racket
+
+dist: bionic
+
+env:
+  global:
+    # Supply a global RACKET_DIR environment variable. This is where
+    # Racket will be installed. A good idea is to use ~/racket because
+    # that doesn't require sudo to install and is therefore compatible
+    # with Travis CI's newer container infrastructure.
+    - RACKET_DIR=~/racket
+  matrix:
+    # Supply at least one RACKET_VERSION environment variable. This is
+    # used by the install-racket.sh script (run at before_install,
+    # below) to select the version of Racket to download and install.
+    #
+    # Supply more than one RACKET_VERSION (as in the example below) to
+    # create a Travis-CI build matrix to test against multiple Racket
+    # versions.
+    - RACKET_VERSION=7.6
+    - RACKET_VERSION=HEAD
+    - RACKET_VERSION=HEADCS
+
+matrix:
+  allow_failures:
+#   - env: RACKET_VERSION=HEAD
+  fast_finish: true
+
+before_install:
+- git clone https://github.com/greghendershott/travis-racket.git ~/travis-racket
+- cat ~/travis-racket/install-racket.sh | bash # pipe to bash not sh!
+- export PATH="${RACKET_DIR}/bin:${PATH}" #install-racket.sh can't set for us
+
+install:
+ - raco pkg install -j 4 --auto --name ansi
+
+before_script:
+
+# Here supply steps such as raco make, raco test, etc.  You can run
+# `raco pkg install --deps search-auto` to install any required
+# packages without it getting stuck on a confirmation prompt.
+script:
+ - raco test -x -p ansi
+
+after_success:
+ - raco setup --check-pkg-deps --pkgs ansi
+# These cause a problem with test-ansi.rkt
+# - raco pkg install --deps search-auto cover cover-coveralls
+# - raco cover -b -f coveralls -d $TRAVIS_BUILD_DIR/coverage .

ansi/private/install.rkt

@@ -1,19 +1,32 @@
 #lang racket/base
 
-(require make/setup-extension)
+(require dynext/file
+         dynext/link
+         racket/file)
 
 (provide pre-installer)
 
-(define (pre-installer collections-top-path collection-path)
-  (pre-install collection-path
-	       (build-path collection-path "private")
-	       "tty-raw-extension.c"
-	       "."
-	       '()
-	       '()
-	       '()
-	       '()
-	       '()
-	       '()
-	       (lambda (thunk) (thunk))
-	       #t))
+;; Used by "../info.rkt" (so this-collection-path is "..").
+
+;; Heavily based on Sam Tobin-Hochstadt's bcrypt/private/install.rkt
+;; https://github.com/samth/bcrypt.rkt
+
+(define (pre-installer collections-top-path this-collection-path)
+  (define ansi/private/
+    (build-path this-collection-path "private"))
+  (parameterize ([current-directory ansi/private/]
+                 [current-use-mzdyn #f])
+    (define tty_raw.c
+      (build-path ansi/private/ "tty_raw.c"))
+    (define libtty_raw.so
+      (build-path ansi/private/
+                  "compiled"
+                  "native"
+                  (system-library-subpath #f)
+                  (append-extension-suffix "libtty_raw")))
+    (when (file-exists? libtty_raw.so)
+      (delete-file libtty_raw.so))
+    (make-parent-directory* libtty_raw.so)
+    (link-extension #f ;; not quiet
+                    (list tty_raw.c)
+                    libtty_raw.so)))

ansi/private/tty-raw-extension.c

@@ -1,86 +0,0 @@
-/* PLT Racket extension for selecting "raw" TTY mode */
-
-#include "escheme.h"
-
-#include <stdio.h>
-#include <signal.h>
-#include <termios.h>
-#include <stdlib.h>
-#include <unistd.h>
-
-#define STDIN_FD 0
-
-static int is_raw = 0;
-static struct termios saved;
-
-static int ttyraw(void)
-  XFORM_SKIP_PROC
-{
-  /* Based on the settings given in http://www.minek.com/files/unix_examples/raw.html */
-  struct termios t;
-
-  if (is_raw) return 0;
-
-  if (tcgetattr(STDIN_FD, &saved) < 0) return -1;
-  t = saved;
-
-  t.c_lflag &= ~(ECHO | ICANON | IEXTEN | ISIG);
-  t.c_iflag &= ~(BRKINT | ICRNL | INPCK | ISTRIP | IXON);
-  t.c_cflag &= ~(CSIZE | PARENB);
-  t.c_cflag |= CS8;
-  t.c_oflag &= ~(OPOST);
-  t.c_cc[VMIN] = 1;
-  t.c_cc[VTIME] = 0;
-
-  if (tcsetattr(STDIN_FD, TCSAFLUSH, &t) < 0) return -1;
-
-  is_raw = 1;
-  return 0;
-}
-
-static int ttyrestore(void)
-  XFORM_SKIP_PROC
-{
-  if (!is_raw) return 0;
-
-  if (tcsetattr(STDIN_FD, TCSAFLUSH, &saved) < 0) return -1;
-
-  is_raw = 0;
-  return 0;
-}
-
-static Scheme_Object *sch_ttyraw(int argc, Scheme_Object **argv) {
-  int result;
-  result = ttyraw();
-  return result == 0 ? scheme_true : scheme_false;
-}
-
-static Scheme_Object *sch_ttyrestore(int argc, Scheme_Object **argv) {
-  int result;
-  result = ttyrestore();
-  return result == 0 ? scheme_true : scheme_false;
-}
-
-Scheme_Object *scheme_reload(Scheme_Env *env) {
-  Scheme_Env *mod_env;
-  mod_env = scheme_primitive_module(scheme_intern_symbol("tty-raw-extension"), env);
-  scheme_add_global("tty-raw!",
-		    scheme_make_prim_w_arity(sch_ttyraw, "tty-raw!", 0, 0),
-		    mod_env);
-  scheme_add_global("tty-restore!",
-		    scheme_make_prim_w_arity(sch_ttyrestore, "tty-restore!", 0, 0),
-		    mod_env);
-  scheme_finish_primitive_module(mod_env);
-  return scheme_void;
-}
-
-Scheme_Object *scheme_initialize(Scheme_Env *env)
-  XFORM_SKIP_PROC
-{
-  atexit((void (*)(void)) ttyrestore);
-  return scheme_reload(env);
-}
-
-Scheme_Object *scheme_module_name(void) {
-  return scheme_intern_symbol("tty-raw-extension");
-}

ansi/private/tty-raw-extension.rkt

@@ -0,0 +1,39 @@
+#lang racket/base
+
+(require ffi/unsafe
+         ffi/unsafe/global
+         ffi/unsafe/define)
+
+(provide (protect-out tty-raw!
+                      tty-restore!))
+
+(define (local-lib-dirs)
+  ;; FIXME: There's probably a better way to do this with
+  ;; define-runtime-path and cross-system-library-subpath,
+  ;; but this is what the bcrypt package is doing.
+  (list (build-path (collection-path "ansi")
+                    "private"
+                    "compiled"
+                    "native"
+                    (system-library-subpath #f))))
+
+(define libtty_raw
+  (ffi-lib "libtty_raw" #:get-lib-dirs local-lib-dirs))
+
+(define-ffi-definer define-tty libtty_raw
+  #:default-make-fail make-not-available)
+
+(define-tty tty-raw!
+  (_fun #:in-original-place? #t
+        -> _stdbool)
+  #:c-id tty_raw)
+
+(define-tty tty-restore!
+  (_fun #:in-original-place? #t
+        -> _stdbool)
+  #:c-id tty_restore)
+
+(unless (register-process-global #"ansi-private-tty-raw-has-set-restore-at-exit" #"")
+  (define-tty tty_set_restore_at_exit
+    (_fun -> _void))
+  (tty_set_restore_at_exit))

ansi/private/tty_raw.c

@@ -0,0 +1,48 @@
+#include <stdio.h>
+#include <stdbool.h>
+#include <signal.h>
+#include <termios.h>
+#include <stdlib.h>
+#include <unistd.h>
+
+#define STDIN_FD 0
+
+static bool is_raw = false;
+static struct termios saved;
+
+bool tty_raw(void) {
+  /* Based on the settings given in:
+   *  https://web.archive.org/web/20180516224400/http://www.minek.com:80/files/unix_examples/raw.html */
+  struct termios t;
+
+  if (is_raw) return true;
+
+  if (tcgetattr(STDIN_FD, &saved) < 0) return false;
+  t = saved;
+
+  t.c_lflag &= ~(ECHO | ICANON | IEXTEN | ISIG);
+  t.c_iflag &= ~(BRKINT | ICRNL | INPCK | ISTRIP | IXON);
+  t.c_cflag &= ~(CSIZE | PARENB);
+  t.c_cflag |= CS8;
+  t.c_oflag &= ~(OPOST);
+  t.c_cc[VMIN] = 1;
+  t.c_cc[VTIME] = 0;
+
+  if (tcsetattr(STDIN_FD, TCSAFLUSH, &t) < 0) return false;
+
+  is_raw = true;
+  return true;
+}
+
+bool tty_restore(void) {
+  if (!is_raw) return true;
+
+  if (tcsetattr(STDIN_FD, TCSAFLUSH, &saved) < 0) return false;
+
+  is_raw = false;
+  return true;
+}
+
+void tty_set_restore_at_exit(void) {
+    atexit((void (*)(void)) tty_restore);
+}

ansi/test-raw.rkt

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

info.rkt

@@ -1,4 +1,8 @@
 #lang setup/infotab
+(define pkg-name 'ansi)
 (define collection 'multi)
-(define deps '("base" "dynext-lib" "make"))
-(define build-deps '("rackunit-lib"))
+(define deps
+  '("base"
+    "dynext-lib"))
+(define build-deps
+  '())