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

use the custom prompt 

Ignore-this: 1912534fb4073b2f4774bb09fe977365

darcs-hash:20110921042650-c41ad-9a21b4232ac8e2d13af8b0fc588749de3e161212
This commit is contained in:
Jeremie Dimino 2011-09-21 06:26:50 +02:00
parent 4a456f0b59
commit c511fa0f02
6 changed files with 188 additions and 84 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

134
src/common/uTop.ml
View File

@ -15,6 +15,14 @@ open LTerm_style
module String_set = Set.Make(String)
(* +-----------------------------------------------------------------+
| UI |
+-----------------------------------------------------------------+ *)
type ui = UTop_private.ui = Console | GTK | Emacs
let get_ui () = S.value UTop_private.ui
(* +-----------------------------------------------------------------+
| Keywords |
+-----------------------------------------------------------------+ *)
@ -61,73 +69,81 @@ let time = ref 0.
let () = at_new_prompt (fun () -> time := Unix.time ())
let make_prompt profile count size key_sequence (recording, macro_count, macro_counter) =
let make_prompt ui profile count size key_sequence (recording, macro_count, macro_counter) =
let tm = Unix.localtime !time in
let color dark light =
match profile with
| Dark -> dark
| Light -> light
in
let bold = profile = Dark in
let txta =
if key_sequence = [] then
eval [
B_bold bold;
B_fg (color lcyan blue);
S "─( ";
B_fg (color lmagenta magenta); S (Printf.sprintf "%02d:%02d:%02d" tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec); E_fg;
S " )─< ";
B_fg (color lyellow yellow); S (Printf.sprintf "command %d" count); E_fg;
S " >─";
]
else
eval [
B_bold bold;
B_fg (color lcyan blue);
S "─( ";
B_fg (color lmagenta magenta); S (Printf.sprintf "%02d:%02d:%02d" tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec); E_fg;
S " )─< ";
B_fg (color lyellow yellow); S (Printf.sprintf "command %d" count); E_fg;
S " >─[ ";
B_fg (color lgreen green); S (String.concat " " (List.map LTerm_key.to_string_compact key_sequence)); E_fg;
S " ]─";
]
in
let txtb =
if recording then
eval [
B_bold bold;
B_fg (color lcyan blue);
S "{ ";
B_fg (color lwhite black); S (Printf.sprintf "counter: %d" macro_counter); E_fg;
S " }─[ ";
B_fg (color lwhite black); S (Printf.sprintf "macro: %d" macro_count); E_fg;
S " ]─";
]
else
eval [
B_bold bold;
B_fg (color lcyan blue);
S "{ ";
B_fg (color lwhite black); S (Printf.sprintf "counter: %d" macro_counter); E_fg;
S " }─";
]
in
Array.append (
if Array.length txta + Array.length txtb > size.cols then
Array.sub (Array.append txta txtb) 0 size.cols
else
Array.concat [
txta;
Array.make
(size.cols - Array.length txta - Array.length txtb)
(UChar.of_int 0x2500, { none with foreground = Some (color lcyan blue); bold = Some bold });
txtb;
]
) [|(UChar.of_char '#', { none with foreground = Some (color lgreen green) }); (UChar.of_char ' ', none)|]
match ui with
| Emacs ->
[||]
| GTK ->
eval [B_fg (color lcyan blue);
S (Printf.sprintf "utop[%d]> " count)]
| Console ->
let bold = profile = Dark in
let txta =
if key_sequence = [] then
eval [
B_bold bold;
B_fg (color lcyan blue);
S "─( ";
B_fg (color lmagenta magenta); S (Printf.sprintf "%02d:%02d:%02d" tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec); E_fg;
S " )─< ";
B_fg (color lyellow yellow); S (Printf.sprintf "command %d" count); E_fg;
S " >─";
]
else
eval [
B_bold bold;
B_fg (color lcyan blue);
S "─( ";
B_fg (color lmagenta magenta); S (Printf.sprintf "%02d:%02d:%02d" tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec); E_fg;
S " )─< ";
B_fg (color lyellow yellow); S (Printf.sprintf "command %d" count); E_fg;
S " >─[ ";
B_fg (color lgreen green); S (String.concat " " (List.map LTerm_key.to_string_compact key_sequence)); E_fg;
S " ]─";
]
in
let txtb =
if recording then
eval [
B_bold bold;
B_fg (color lcyan blue);
S "{ ";
B_fg (color lwhite black); S (Printf.sprintf "counter: %d" macro_counter); E_fg;
S " }─[ ";
B_fg (color lwhite black); S (Printf.sprintf "macro: %d" macro_count); E_fg;
S " ]─";
]
else
eval [
B_bold bold;
B_fg (color lcyan blue);
S "{ ";
B_fg (color lwhite black); S (Printf.sprintf "counter: %d" macro_counter); E_fg;
S " }─";
]
in
Array.append (
if Array.length txta + Array.length txtb > size.cols then
Array.sub (Array.append txta txtb) 0 size.cols
else
Array.concat [
txta;
Array.make
(size.cols - Array.length txta - Array.length txtb)
(UChar.of_int 0x2500, { none with foreground = Some (color lcyan blue); bold = Some bold });
txtb;
]
) [|(UChar.of_char '#', { none with foreground = Some (color lgreen green) }); (UChar.of_char ' ', none)|]
let prompt = ref (
S.l5 make_prompt
S.l6 make_prompt
UTop_private.ui
profile
count
size

31
src/common/uTop.mli
View File

@ -18,17 +18,23 @@ val keywords : Set.Make(String).t ref
val add_keyword : string -> unit
(** Add a new OCaml keyword. *)
(** {6 Console specific configuration} *)
type ui = Console | GTK | Emacs
(** The user interface in use. *)
val get_ui : unit -> ui
(** Returns the user interface in use. *)
(** {6 Console/GTK specific configuration} *)
type profile = Dark | Light
(** Profile for terminal colors. *)
(** Profile for colors. *)
val profile : profile React.signal
(** The profile of the terminal. It defaults to {!Dark}. This is
used by the default prompt to choose colors. *)
(** The color profile. It defaults to {!Dark}. This is used by the
default prompt to choose colors. *)
val set_profile : profile -> unit
(** Sets the profile of the terminal. *)
(** Sets the color profile. *)
val smart_accept : bool ref
(** If [true], then only lines terminated with ";;" will be sent to
@ -36,28 +42,33 @@ val smart_accept : bool ref
user press Enter. It default to [true]. *)
val size : LTerm_geom.size React.signal
(** The current size of the terminal. *)
(** The current size of the terminal. This is used only in the
console UI. *)
val key_sequence : LTerm_key.t list React.signal
(** The current key sequence entered by the user. *)
(** The current key sequence entered by the user. This is used only
in the console UI. *)
val time : float ref
(** The time of the beginning of the current command. *)
val prompt : LTerm_text.t React.signal ref
(** The current prompt.
For compatibility with ocaml error printing, it must ends with a
line of length 2. *)
line of length 2 in the console UI. *)
val prompt_continue : LTerm_text.t React.signal ref
(** The prompt used to continue unterminated phrase.
For compatibility with ocaml error printing, it must ends with a
line of length 2. *)
line of length 2 in the console UI. *)
val prompt_comment : LTerm_text.t React.signal ref
(** The prompt used to continue unterminated comments.
For compatibility with ocaml error printing, it must ends with a
line of length 2. *)
line of length 2 in the console UI. *)
(** {6 Hooks} *)

4
src/common/uTop_private.ml
View File

@ -18,3 +18,7 @@ let key_sequence, set_key_sequence =
(S.switch (S.const ([] : LTerm_key.t list)) ev, set_key_sequence)
let count, set_count = S.create(-1)
type ui = Console | GTK | Emacs
let ui, set_ui = S.create Console

2
src/console/uTop_console.ml
View File

@ -19,6 +19,8 @@ open UTop_styles
module String_set = Set.Make(String)
let () = UTop_private.set_ui UTop_private.Console
(* +-----------------------------------------------------------------+
| History |
+-----------------------------------------------------------------+ *)

2
src/emacs/uTop_emacs.ml
View File

@ -11,6 +11,8 @@
open Lwt
let () = UTop_private.set_ui UTop_private.Emacs
(* Copy standard output, which will be used to send commands. *)
let command_oc = Unix.out_channel_of_descr (Unix.dup Unix.stdout)

99
src/gtk/uTop_gtk.ml
View File

@ -11,6 +11,8 @@ open Lwt
open Lwt_react
open UTop_styles
let () = UTop_private.set_ui UTop_private.GTK
(* Copy stderr for errors. *)
let stderr_fd = Unix.dup Unix.stderr
let stderr = Unix.out_channel_of_descr stderr_fd
@ -216,6 +218,55 @@ let _ =
~callback:(Gobject.Closure.create changed)
~after:false
(* Insert the prompt. *)
let insert_prompt ?(locked = true) prompt =
if locked then Mutex.lock edit_mutex;
computer_insertion := true;
let iter = edit_buffer#get_iter (`OFFSET !prompt_start) in
(* Remove the previous prompt. *)
if !prompt_start < !prompt_stop then begin
edit_buffer#delete ~start:iter ~stop:(edit_buffer#get_iter (`OFFSET !prompt_stop))
end;
(* Insert the text of the new one. *)
edit_buffer#insert ~iter ~tags:[frozen] (LTerm_text.to_string prompt);
(* Update the end of prompt. *)
prompt_stop := iter#offset;
(* Stylise it. *)
let stylise start stop style =
if start < stop then begin
let start = edit_buffer#get_iter (`OFFSET (start + !prompt_start)) and stop = edit_buffer#get_iter (`OFFSET (stop + !prompt_start)) in
edit_buffer#apply_tag ~start ~stop (tag_of_term_style style)
end
in
let rec loop i j style =
if j = Array.length prompt then
stylise i j style
else begin
let _, style' = prompt.(j) in
if LTerm_style.equal style style' then
loop i (j + 1) style
else begin
stylise i j style;
loop j (j + 1) style'
end
end
in
loop 0 0 LTerm_style.none;
computer_insertion := false;
if locked then Mutex.unlock edit_mutex
(* The current prompt. *)
let current_prompt, set_current_prompt = S.create ~eq:(==) (S.const [||])
(* Update the prompt when it change. *)
let () =
E.keep
(E.map
(fun prompt ->
(* Update it only if we are editing. *)
if edit#editable then insert_prompt ~locked:true prompt)
(S.changes (S.switch (S.value current_prompt) (S.changes current_prompt))))
(* +-----------------------------------------------------------------+
| Standard outputs redirections |
+-----------------------------------------------------------------+ *)
@ -283,15 +334,16 @@ let rec read_input prompt buffer length =
end;
(* Insert the prompt. *)
prompt_start := edit#buffer#end_iter#offset;
computer_insertion := true;
edit_buffer#insert ~iter:edit_buffer#end_iter ~tags:[frozen] prompt;
computer_insertion := false;
prompt_stop := edit_buffer#end_iter#offset;
let offset = edit_buffer#end_iter#offset in
prompt_start := offset;
prompt_stop := offset;
insert_prompt ~locked:false (S.value !UTop.prompt);
Mutex.unlock edit_mutex;
| "* " | " " ->
set_current_prompt !UTop.prompt
| " " ->
(* Continuation of the current phrase. *)
(* Call hooks. *)
@ -299,12 +351,29 @@ let rec read_input prompt buffer length =
(* Insert the prompt. *)
Mutex.lock edit_mutex;
prompt_start := edit#buffer#end_iter#offset;
computer_insertion := true;
edit_buffer#insert ~iter:edit_buffer#end_iter ~tags:[frozen] prompt;
computer_insertion := false;
prompt_stop := edit_buffer#end_iter#offset;
Mutex.unlock edit_mutex
let offset = edit_buffer#end_iter#offset in
prompt_start := offset;
prompt_stop := offset;
insert_prompt ~locked:false (S.value !UTop.prompt_continue);
Mutex.unlock edit_mutex;
set_current_prompt !UTop.prompt_continue
| "* " ->
(* Continuation of the current phrase (in a comment). *)
(* Call hooks. *)
Lwt_sequence.iter_l (fun f -> f ()) UTop.new_prompt_hooks;
(* Insert the prompt. *)
Mutex.lock edit_mutex;
let offset = edit_buffer#end_iter#offset in
prompt_start := offset;
prompt_stop := offset;
insert_prompt ~locked:false (S.value !UTop.prompt_comment);
Mutex.unlock edit_mutex;
set_current_prompt !UTop.prompt_comment
| _ ->
(* Unknown prompt: error. *)
@ -321,6 +390,9 @@ let rec read_input prompt buffer length =
(* Wait for the user to press Return. *)
let () = Lwt_main.run (Lwt_condition.wait accept_cond) in
(* Make the buffer uneditable while ocaml is executing things. *)
edit#set_editable false;
Mutex.lock edit_mutex;
(* Get the user input. *)
let start = edit_buffer#get_iter (`OFFSET !prompt_stop) and stop = edit_buffer#end_iter in
@ -333,9 +405,6 @@ let rec read_input prompt buffer length =
prompt_stop := offset;
Mutex.unlock edit_mutex;
(* Make the buffer uneditable while ocaml is executing things. *)
edit#set_editable false;
input := text;
pos := 0;