142 lines
5.1 KiB
OCaml
142 lines
5.1 KiB
OCaml
(* Lightweight thread library for Objective Caml
|
|
* http://www.ocsigen.org/lwt
|
|
* Module Lwt_top
|
|
* Copyright (C) 2009 Jérémie Dimino
|
|
*
|
|
* This program is free software; you can redistribute it and/or modify
|
|
* it under the terms of the GNU Lesser General Public License as
|
|
* published by the Free Software Foundation, with linking exceptions;
|
|
* either version 2.1 of the License, or (at your option) any later
|
|
* version. See COPYING file for details.
|
|
*
|
|
* This program is distributed in the hope that it will be useful, but
|
|
* WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
* Lesser General Public License for more details.
|
|
*
|
|
* You should have received a copy of the GNU Lesser General Public
|
|
* License along with this program; if not, write to the Free Software
|
|
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
|
|
* 02111-1307, USA.
|
|
*)
|
|
|
|
(* Integration with the toplevel:
|
|
|
|
readline + let threads runs while reading user input. *)
|
|
|
|
open Lwt_unix
|
|
open Lwt
|
|
open Lwt_text
|
|
open Lwt_term
|
|
|
|
(* +-----------------------------------------------------------------+
|
|
| Completion |
|
|
+-----------------------------------------------------------------+ *)
|
|
|
|
module TextSet = Set.Make(Text)
|
|
|
|
let complete (before, after) =
|
|
Lwt_ocaml_completion.complete_input before after (Lexing.from_string before)
|
|
|
|
(* +-----------------------------------------------------------------+
|
|
| Read-line wrapper |
|
|
+-----------------------------------------------------------------+ *)
|
|
|
|
let mode = ref `real_time
|
|
let completion_mode () = !mode
|
|
let set_completion_mode m = mode := m
|
|
|
|
let history = ref []
|
|
|
|
let _ =
|
|
let hist_name = Filename.concat (try Unix.getenv "HOME" with _ -> "") ".lwt-top-history" in
|
|
Lwt_main.at_exit (fun () -> Lwt_read_line.save_history hist_name !history);
|
|
history := Lwt_main.run (Lwt_read_line.load_history hist_name)
|
|
|
|
let input = ref ""
|
|
let pos = ref 0
|
|
|
|
let rec read_input prompt buffer len =
|
|
try
|
|
if !pos = String.length !input then begin
|
|
let prompt' = if prompt = " " then [fg blue; text "> "] else [fg yellow; text prompt] in
|
|
!Lwt_ocaml_completion.restart ();
|
|
let txt = Lwt_main.run begin
|
|
lwt l = Lwt_read_line.Control.result
|
|
(Lwt_read_line.Control.make
|
|
~complete
|
|
~mode:!mode
|
|
~history:(!history)
|
|
~prompt:(fun _ -> React.S.const prompt')
|
|
~filter:(fun state command ->
|
|
match command with
|
|
| Lwt_read_line.Command.Accept_line ->
|
|
(* Do not accept the line if it does not terminates with ";;" *)
|
|
let text = Lwt_read_line.Engine.all_input (Lwt_read_line.Control.engine_state state) in
|
|
if Text.ends_with (Text.rstrip text) ";;" then
|
|
return Lwt_read_line.Command.Accept_line
|
|
else
|
|
return (Lwt_read_line.Command.Char "\n")
|
|
| command ->
|
|
return command)
|
|
~map_result:return
|
|
())
|
|
in
|
|
lwt () = Lwt_text.flush Lwt_text.stdout in
|
|
return l
|
|
end in
|
|
history := Lwt_read_line.add_entry txt !history;
|
|
input := txt ^ "\n";
|
|
pos := 0;
|
|
read_input prompt buffer len
|
|
end else begin
|
|
let i = ref 0 in
|
|
while !i < len && !pos < String.length !input do
|
|
buffer.[!i] <- (!input).[!pos];
|
|
incr i;
|
|
incr pos
|
|
done;
|
|
(!i, false)
|
|
end
|
|
with
|
|
| Lwt_read_line.Interrupt ->
|
|
(0, true)
|
|
|
|
let read_input_non_interactive prompt buffer len =
|
|
let rec loop i =
|
|
if i = len then
|
|
return (i, false)
|
|
else
|
|
Lwt_io.read_char_opt Lwt_io.stdin >>= function
|
|
| Some c ->
|
|
buffer.[i] <- c;
|
|
if c = '\n' then
|
|
return (i + 1, false)
|
|
else
|
|
loop (i + 1)
|
|
| None ->
|
|
return (i, true)
|
|
in
|
|
Lwt_main.run (Lwt_io.write Lwt_io.stdout prompt >> loop 0)
|
|
|
|
let _ =
|
|
(* If input is a tty, use interactive read-line and display and
|
|
welcome message: *)
|
|
if Unix.isatty Unix.stdin then begin
|
|
Toploop.read_interactive_input := read_input;
|
|
|
|
let txt = "Welcome to the Lwt powered OCaml toplevel!" in
|
|
let col_border = cyan and col_txt = yellow in
|
|
let len = Text.length txt in
|
|
let col = React.S.value Lwt_term.columns in
|
|
let space = (col - 4 - len) / 2 in
|
|
let rep n txt = text (Text.repeat n txt) in
|
|
Lwt_main.run
|
|
(lwt () = printlc [fg col_border; rep space "─"; text "┬─"; rep len "─"; text "─┬"; rep (col - 4 - len - space) "─"] in
|
|
lwt () = printlc [rep space " "; fg col_border; text "│ "; fg col_txt; text txt; fg col_border; text " │"] in
|
|
lwt () = printlc [rep space " "; fg col_border; text "└─"; rep len "─"; text "─┘"] in
|
|
Lwt_io.flush Lwt_io.stdout)
|
|
end else
|
|
(* Otherwise fallback to classic non-interactive mode: *)
|
|
Toploop.read_interactive_input := read_input_non_interactive;
|