haskal
/
utop
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

better handling of multiple line inputs in emacs mode 

Ignore-this: 917d53810e44b96c6cfa59801634b05

darcs-hash:20110728154023-c41ad-ab46224a3144db4192420db8e0298e51f32411fe
This commit is contained in:
Jeremie Dimino 2011-07-28 17:40:23 +02:00
parent f01d238cd4
commit e0c1b131a3
2 changed files with 99 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

86
src/uTop_emacs.ml
View File

@ -58,32 +58,78 @@ let _ = redirect "stderr" Unix.stderr
| Input |
+-----------------------------------------------------------------+ *)
let rec copy_input buffer offset length =
if offset = length then
return (offset, false)
else
Lwt_io.read_char_opt Lwt_io.stdin >>= function
| Some '\n' ->
buffer.[offset] <- '\n';
return (offset + 1, false)
| Some ch ->
buffer.[offset] <- ch;
copy_input buffer (offset + 1) length
| None ->
return (offset, true)
(* The text typed by the user. *)
let input = ref ""
let read_input prompt buffer length =
match prompt with
(* The position of the text already sent to ocaml in {!input}. *)
let pos = ref 0
let read_command () =
match Lwt_main.run (Lwt_io.read_line_opt Lwt_io.stdin) with
| None ->
None
| Some line ->
match try Some (String.index line ':') with Not_found -> None with
| None ->
send "stderr" "':' missing!";
exit 1
| Some idx ->
Some (String.sub line 0 idx, String.sub line (idx + 1) (String.length line - (idx + 1)))
let rec read_input prompt buffer length =
if !pos = String.length !input then begin
(match prompt with
| "# " ->
(* New phrase. *)
send "prompt" "";
Lwt_main.run (copy_input buffer 0 length)
send "prompt" ""
| "* " | " " ->
(* Continuation of the current phrase. *)
send "continue" "";
Lwt_main.run (copy_input buffer 0 length)
send "continue" ""
| _ ->
send "stderr" "unrecognized prompt";
Printf.ksprintf (send "stderr") "unrecognized prompt %S!" prompt;
exit 1);
match read_command () with
| None ->
(0, true)
| Some (command, argument) ->
process prompt buffer length command argument
end else begin
(* There is still some pending input. *)
let i = ref 0 in
while !i < length && !pos < String.length !input do
buffer.[!i] <- (!input).[!pos];
incr i;
incr pos
done;
(!i, false)
end
and process prompt buffer length command argument =
match command with
| "input" ->
let count =
try
int_of_string argument
with _ ->
send "stderr" "invalid number of line to read!";
exit 1
in
input := "";
pos := 0;
for i = 1 to count do
match read_command () with
| None ->
send "stderr" "wrong number of lines!";
exit 1
| Some ("data", data) ->
input := !input ^ data ^ "\n"
| Some (command, argument) ->
Printf.ksprintf (send "stderr") "'data' command expected, got %S!" command;
exit 1
done;
read_input prompt buffer length
| command ->
Printf.ksprintf (send "stderr") "unrecognized command %S!" command;
exit 1
let () =

13
src/utop.el
View File

@ -264,7 +264,7 @@ sub-process."
(let ((input (buffer-substring-no-properties utop-prompt-max (point-max))))
(if (stringp utop-pending)
(setq utop-pending (concat utop-pending "\n" input))
(setq utop-pending input)))
(setq utop-pending input))
;; Goto the end of the buffer
(goto-char (point-max))
;; Terminate input by a newline
@ -283,8 +283,15 @@ sub-process."
;; Move the prompt to the end of the buffer
(setq utop-prompt-min stop)
(setq utop-prompt-max stop)
;; Send everything after the prompt to utop
(process-send-region utop-process start stop))))
;; Send all lines to utop
(let ((lines (split-string input "\n")))
;; Send the number of lines
(process-send-string utop-process (concat "input:" (int-to-string (length lines)) "\n"))
(while (consp lines)
;; Send the line
(process-send-string utop-process (concat "data:" (car lines) "\n"))
;; Remove it and continue
(setq lines (cdr lines))))))))
;; +-----------------------------------------------------------------+
;; | Completion |