diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 0000000..b982816 --- /dev/null +++ b/.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 . diff --git a/ansi/private/install.rkt b/ansi/private/install.rkt index 896e3df..5f441fd 100644 --- a/ansi/private/install.rkt +++ b/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))) diff --git a/ansi/private/tty-raw-extension.c b/ansi/private/tty-raw-extension.c deleted file mode 100644 index fa633f3..0000000 --- a/ansi/private/tty-raw-extension.c +++ /dev/null @@ -1,86 +0,0 @@ -/* PLT Racket extension for selecting "raw" TTY mode */ - -#include "escheme.h" - -#include -#include -#include -#include -#include - -#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"); -} diff --git a/ansi/private/tty-raw-extension.rkt b/ansi/private/tty-raw-extension.rkt new file mode 100644 index 0000000..6abc33f --- /dev/null +++ b/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)) diff --git a/ansi/private/tty_raw.c b/ansi/private/tty_raw.c new file mode 100644 index 0000000..abd2b38 --- /dev/null +++ b/ansi/private/tty_raw.c @@ -0,0 +1,48 @@ +#include +#include +#include +#include +#include +#include + +#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); +} diff --git a/ansi/test-raw.rkt b/ansi/test-raw.rkt index 3c18787..bfe647d 100644 --- a/ansi/test-raw.rkt +++ b/ansi/test-raw.rkt @@ -1,6 +1,5 @@ #lang racket/base -(require "private/tty-raw-extension.rkt") (require "main.rkt") (require racket/set) diff --git a/info.rkt b/info.rkt index b65a74e..db83b90 100644 --- a/info.rkt +++ b/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 + '())