better handling of multiple line inputs in emacs mode

Ignore-this: 917d53810e44b96c6cfa59801634b05

darcs-hash:20110728154023-c41ad-ab46224a3144db4192420db8e0298e51f32411fe

src/uTop_emacs.ml

@@ -58,32 +58,78 @@ let _ = redirect "stderr" Unix.stderr
    | Input                                                           |
    +-----------------------------------------------------------------+ *)
 
-let rec copy_input buffer offset length =
+(* The text typed by the user. *)
-  if offset = length then
+let input = ref ""
-    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)
 
-let read_input prompt buffer length =
+(* The position of the text already sent to ocaml in {!input}. *)
-  match prompt with
+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" "";
+           send "prompt" ""
-        Lwt_main.run (copy_input buffer 0 length)
        | "* " | "  " ->
            (* Continuation of the current phrase. *)
-        send "continue" "";
+           send "continue" ""
-        Lwt_main.run (copy_input buffer 0 length)
        | _ ->
-        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 () =

src/utop.el

@@ -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
+        ;; Send all lines to utop
-      (process-send-region utop-process start stop))))
+        (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                                                      |