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

96
src/uTop_emacs.ml
View File

@ -58,32 +58,78 @@ let _ = redirect "stderr" Unix.stderr
| Input | | 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
| "# " ->
(* New phrase. *) let read_command () =
send "prompt" ""; match Lwt_main.run (Lwt_io.read_line_opt Lwt_io.stdin) with
Lwt_main.run (copy_input buffer 0 length) | None ->
| "* " | " " -> None
(* Continuation of the current phrase. *) | Some line ->
send "continue" ""; match try Some (String.index line ':') with Not_found -> None with
Lwt_main.run (copy_input buffer 0 length) | None ->
| _ -> send "stderr" "':' missing!";
send "stderr" "unrecognized prompt"; 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" ""
| "* " | " " ->
(* Continuation of the current phrase. *)
send "continue" ""
| _ ->
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 exit 1
let () = let () =

49
src/utop.el
View File

@ -264,27 +264,34 @@ sub-process."
(let ((input (buffer-substring-no-properties utop-prompt-max (point-max)))) (let ((input (buffer-substring-no-properties utop-prompt-max (point-max))))
(if (stringp utop-pending) (if (stringp utop-pending)
(setq utop-pending (concat utop-pending "\n" input)) (setq utop-pending (concat utop-pending "\n" input))
(setq utop-pending input))) (setq utop-pending input))
;; Goto the end of the buffer ;; Goto the end of the buffer
(goto-char (point-max)) (goto-char (point-max))
;; Terminate input by a newline ;; Terminate input by a newline
(insert "\n") (insert "\n")
(let ((start utop-prompt-max) (stop (point-max))) (let ((start utop-prompt-max) (stop (point-max)))
;; Make the text read-only ;; Make the text read-only
(add-text-properties start stop '(read-only t)) (add-text-properties start stop '(read-only t))
;; Make the old prompt sticky so we cannot edit after it ;; Make the old prompt sticky so we cannot edit after it
(let ((inhibit-read-only t)) (let ((inhibit-read-only t))
(remove-text-properties utop-prompt-min utop-prompt-max '(rear-nonsticky nil))) (remove-text-properties utop-prompt-min utop-prompt-max '(rear-nonsticky nil)))
;; Makes the text sent read only and add it the frozen face. ;; Makes the text sent read only and add it the frozen face.
(let ((inhibit-read-only t)) (let ((inhibit-read-only t))
(utop-add-text-properties-rear-nonsticky start stop (utop-add-text-properties-rear-nonsticky start stop
'(read-only t face utop-frozen) '(read-only t face utop-frozen)
'(face read-only))) '(face read-only)))
;; Move the prompt to the end of the buffer ;; Move the prompt to the end of the buffer
(setq utop-prompt-min stop) (setq utop-prompt-min stop)
(setq utop-prompt-max 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 | ;; | Completion |