Unverified Commit 07bdeb1e authored by Merlin's avatar Merlin 💧
Browse files

Readline wrapper replaced by ocamline

parent d49e7b8a
Pipeline #11275 failed with stages
in 6 minutes and 1 second
......@@ -3,10 +3,17 @@ let
withStatic = p: p.overrideAttrs (o: { dontDisableStatic = true; });
nixpkgs = import sources.nixpkgs { };
versions = import ./nix/version.nix;
ocamline = nixpkgs.ocamlPackages.buildDunePackage {
pname = "ocamline";
version = sources.ocamline.branch;
src = sources.ocamline;
propagatedBuildInputs = with nixpkgs.ocamlPackages; [ linenoise ];
}; # Should ocamline be upstreamed at some point this can be replaced as we don't do anything special. It is just now packaged currently.
in
with nixpkgs; rec {
cool = ocamlPackages.callPackage ./nix/cool.nix {
inherit versions;
inherit versions ocamline;
minisat = pkgs.minisat;
};
cool-static = let
......
{ lib, buildDunePackage, ounit, ocamlgraph, fetchgit, pgsolver, glibc, readline, zlib, ncurses5, minisat, profile ? null, versions, doCheck ? true }:
{ lib, buildDunePackage, ounit, ocamlgraph, fetchgit, pgsolver, glibc, readline, zlib, ncurses5, minisat, ocamline, profile ? null, versions, doCheck ? true }:
buildDunePackage (rec {
pname = "cool";
......@@ -7,7 +7,7 @@ buildDunePackage (rec {
src = ../.;
buildInputs = [ readline zlib.dev ncurses5 minisat ocamlgraph glibc pgsolver ];
buildInputs = [ readline zlib.dev ncurses5 minisat ocamlgraph glibc pgsolver ocamline ];
buildPhase = ''
runHook preBuild
......
......@@ -22,5 +22,17 @@
"type": "tarball",
"url": "https://github.com/NixOS/nixpkgs/archive/cce26cd83d20356ee96ac9cf1de748e87fcc50b5.tar.gz",
"url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
},
"ocamline": {
"branch": "1.2",
"description": "👨🏻‍💻 Command line interface for user input",
"homepage": "https://chrisnevers.github.io/ocamline/",
"owner": "chrisnevers",
"repo": "ocamline",
"rev": "6a9c5a190844a3ecbbb0b168372248d10fa184d0",
"sha256": "0n4xiwbmqwz1xwv4hhqqfmy28jardsa9hvdyfws4mn7b2zyfcn2a",
"type": "tarball",
"url": "https://github.com/chrisnevers/ocamline/archive/6a9c5a190844a3ecbbb0b168372248d10fa184d0.tar.gz",
"url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
}
}
external set_readline_name : string -> unit = "set_readline_name"
external readline : unit -> string option = "readline_stub"
external readline_prompt : string -> string option = "readline_prompt_stub"
external add_history : string -> unit = "add_history_stub"
external connect_to_curses : unit -> unit = "connect_to_curses"
external line_buffer : unit -> string = "line_buffer_stub"
external wrong_cursor_position : unit -> int = "cursor_position_stub"
let do_nothing = fun () -> ()
let redraw_callback = ref (do_nothing)
let call_callback () : unit = (!redraw_callback) ()
let _ =
Callback.register "readline_redraw_callback" call_callback;
external readline_use_ocaml_callback : unit -> unit = "readline_use_ocaml_callback"
let register_redraw cb =
redraw_callback := cb;
readline_use_ocaml_callback()
let utf8length str =
let count = ref (0) in
let check ch =
if (((Char.code ch) land 0xc0) <> 0x80)
then count := !count + 1
in
String.iter check str;
!count
let readline_state () =
let wrong_cursor = wrong_cursor_position () in
let line = line_buffer () in
line, utf8length (String.sub line 0 wrong_cursor)
(* vim: set et sw=2 sts=2 ts=8 : *)
val set_readline_name : string -> unit
val readline : unit -> string option
val readline_prompt : string -> string option
val add_history : string -> unit
val connect_to_curses : unit -> unit
val line_buffer : unit -> string
val wrong_cursor_position : unit -> int
val utf8length : string -> int
(* returns input and correct cursor utf8-position *)
val readline_state : unit -> string * int
(* registers a new redraw-callback replacing the previous one *)
val register_redraw: (unit -> unit) -> unit
(* vim: set et sw=2 sts=2 ts=8 : *)
extern "C" {
#include <stdio.h>
#include <readline/readline.h>
#include <readline/history.h>
#include <caml/mlvalues.h>
#include <caml/alloc.h>
#include <caml/memory.h>
#include <caml/custom.h>
#include <caml/callback.h>
#include <curses.h>
}
#include <string>
extern "C" {
value set_readline_name(value name);
value readline_stub(value unit);
value readline_prompt_stub(value prompt);
value add_history_stub(value str);
value connect_to_curses(value unit);
value readline_use_ocaml_callback(value unit);
value line_buffer_stub(value unit);
value cursor_position_stub(value unit);
}
static std::string g_readline_name = "";
value set_readline_name(value name)
{
CAMLparam1 (name);
g_readline_name = String_val(name);
rl_readline_name = g_readline_name.c_str();
CAMLreturn (Val_unit);
}
value add_history_stub(value str) {
CAMLparam1 (str);
add_history(String_val(str));
CAMLreturn (Val_unit);
}
// for returning an option see
// http://www.linux-nantes.org/~fmonnier/ocaml/ocaml-wrapping-c.html#ref_option
#define Val_none Val_int(0)
static value Val_some( value v )
{
CAMLparam1( v );
CAMLlocal1( some );
some = caml_alloc(1, 0);
Store_field( some, 0, v );
CAMLreturn( some );
}
value readline_stub(value unit) {
CAMLparam1 (unit);
CAMLlocal1( line_data );
char* line = readline("");
if (line == NULL) {
CAMLreturn( Val_none );
} else {
line_data = caml_alloc_string(strlen(line));
strcpy( String_val(line_data), line);
free(line);
CAMLreturn( Val_some( line_data ) );
}
}
value readline_prompt_stub(value prompt) {
CAMLparam1 (prompt);
CAMLlocal1( line_data );
char* line = readline(String_val(prompt));
if (line == NULL) {
CAMLreturn( Val_none );
} else {
line_data = caml_alloc_string(strlen(line));
strcpy( String_val(line_data), line);
free(line);
CAMLreturn( Val_some( line_data ) );
}
}
// http://stackoverflow.com/questions/691652/using-gnu-readline-how-can-i-add-ncurses-in-the-same-program
int getch_stdin(FILE* f) {
if (f == stdin) return getch();
else return rl_getc(f);
}
value connect_to_curses(value unit) {
CAMLparam1 (unit);
// connect readline to ncurses according to:
rl_getc_function = getch_stdin;
CAMLreturn (Val_unit);
}
// TODO rebind: rl_completion_display_matches_hook
// TODO use: rl_line_buffer
void call_ocaml_redraw() {
static value * closure_f = NULL;
if (closure_f == NULL) {
/* First time around, look up by name */
closure_f = caml_named_value("readline_redraw_callback");
}
caml_callback(*closure_f, Val_unit);
}
value readline_use_ocaml_callback(value unit) {
CAMLparam1 (unit);
rl_redisplay_function = call_ocaml_redraw;
CAMLreturn (Val_unit);
}
value line_buffer_stub(value unit) {
CAMLparam1 (unit);
CAMLlocal1( line_data );
line_data = caml_alloc_string(strlen(rl_line_buffer)+1);
strcpy( String_val(line_data), rl_line_buffer);
CAMLreturn( line_data );
}
value cursor_position_stub(value unit) {
CAMLparam1 (unit);
CAMLreturn (Val_int (rl_point));
}
open Readline
(* name, callback, shortdescription, long description *)
type binding = string * (string list -> unit) * string * string
......@@ -75,26 +73,22 @@ let addHelpBinding bindings =
newBinds true
let start (settings: settings): unit =
session := Some (settings);
let rec loop () =
if (!session = None) then ()
else begin
match (readline_prompt settings.prompt) with
| None -> ()
| Some line -> begin
add_history line;
let cmd = Str.split (Str.regexp "[ \n\t]+") line in
(match cmd with
| [] -> ()
| (v::_) when v = "" -> ()
| (name:: args) ->
doForCommand settings.bindings name (fun (_,callback,_,_) -> callback args)
)
end;
loop()
end
in
loop()
session := Some (settings);
let rec loop () =
if (!session = None) then ()
else begin
let line = (Ocamline.read ~prompt:settings.prompt ()) in
let cmd = Str.split (Str.regexp "[ \n\t]+") line in
ignore (match cmd with
| [] -> ()
| (v::_) when v = "" -> ()
| (name:: args) ->
doForCommand settings.bindings name (fun (_,callback,_,_) -> callback args)
);
loop()
end
in
loop()
let stop () =
session := None
......
......@@ -3,7 +3,7 @@
(wrapped false)
(modes native)
(name interfacencurses)
(cxx_names Curses_stub Readline_stub)
(cxx_flags :standard -std=c++98 -fpermissive) ;; FIXME the permissive flag fixes compilation with newer versions of ocaml which would require a const_cast in the current stub
(c_library_flags :standard -lstdc++ -lm -lncurses -lreadline -ltinfo)
(libraries str))
(cxx_names Curses_stub)
(cxx_flags :standard -std=c++98)
(c_library_flags :standard -lstdc++ -lm -lncurses -ltinfo)
(libraries str ocamline))
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment