add support for light colors terminals

Ignore-this: fb8794243e001dbb59379ac829be0b15

darcs-hash:20110801221835-c41ad-32e00f215b7167d23efc7a3d3e3aa972f0062785
This commit is contained in:
Jeremie Dimino 2011-08-02 00:18:35 +02:00
parent 95ffb03d45
commit c6827f1ba3
5 changed files with 44 additions and 15 deletions

View File

@ -36,30 +36,40 @@ let add_keyword kwd = keywords := String_set.add kwd !keywords
| Prompts | | Prompts |
+-----------------------------------------------------------------+ *) +-----------------------------------------------------------------+ *)
type profile = Dark | Light
let profile, set_profile = S.create Dark
let size = UTop_private.size let size = UTop_private.size
let count = UTop_private.count let count = UTop_private.count
let make_prompt count size recording macro_count = let make_prompt profile count size recording macro_count =
let tm = Unix.localtime (Unix.time ()) in let tm = Unix.localtime (Unix.time ()) in
let color dark light =
match profile with
| Dark -> dark
| Light -> light
in
let bold = profile = Dark in
let txta = let txta =
eval [ eval [
B_bold true; B_bold bold;
B_fg lcyan; B_fg (color lcyan blue);
S "─( "; S "─( ";
B_fg lmagenta; S (Printf.sprintf "%02d:%02d:%02d" tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec); E_fg; 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 " )─< "; S " )─< ";
B_fg lyellow; S (Printf.sprintf "command %d" count); E_fg; B_fg (color lyellow yellow); S (Printf.sprintf "command %d" count); E_fg;
S " >─"; S " >─";
] ]
in in
let txtb = let txtb =
if recording then if recording then
eval [ eval [
B_bold true; B_bold bold;
B_fg lcyan; B_fg (color lcyan blue);
S "[ "; S "[ ";
B_fg lwhite; S (Printf.sprintf "macro: %d" macro_count); E_fg; B_fg (color lwhite black); S (Printf.sprintf "macro: %d" macro_count); E_fg;
S " ]─"; S " ]─";
] ]
else else
@ -73,15 +83,15 @@ let make_prompt count size recording macro_count =
txta; txta;
Array.make Array.make
(size.cols - Array.length txta - Array.length txtb) (size.cols - Array.length txta - Array.length txtb)
(UChar.of_int 0x2500, { none with foreground = Some lcyan; bold = Some true }); (UChar.of_int 0x2500, { none with foreground = Some (color lcyan blue); bold = Some bold });
txtb; txtb;
] ]
) [|(UChar.of_char '#', { none with foreground = Some lgreen }); (UChar.of_char ' ', none)|] ) [|(UChar.of_char '#', { none with foreground = Some (color lgreen green) }); (UChar.of_char ' ', none)|]
let prompt = ref (S.l4 make_prompt count size (Zed_macro.recording LTerm_read_line.macro_recorder) (Zed_macro.count LTerm_read_line.macro_recorder)) let prompt = ref (S.l5 make_prompt profile count size (Zed_macro.recording LTerm_read_line.macro_recorder) (Zed_macro.count LTerm_read_line.macro_recorder))
let prompt_continue = ref (S.const [|(UChar.of_char '>', { none with foreground = Some lgreen }); (UChar.of_char ' ', LTerm_style.none)|]) let prompt_continue = ref (S.map (fun profile -> [|(UChar.of_char '>', { none with foreground = Some (if profile = Dark then lgreen else green) }); (UChar.of_char ' ', LTerm_style.none)|]) profile)
let prompt_comment = ref (S.const [|(UChar.of_char '*', { none with foreground = Some lgreen }); (UChar.of_char ' ', LTerm_style.none)|]) let prompt_comment = ref (S.map (fun profile -> [|(UChar.of_char '*', { none with foreground = Some (if profile = Dark then lgreen else green) }); (UChar.of_char ' ', LTerm_style.none)|]) profile)
(* +-----------------------------------------------------------------+ (* +-----------------------------------------------------------------+
| Help | | Help |
@ -94,7 +104,9 @@ let () =
Hashtbl.add Toploop.directive_table "utop_help" Hashtbl.add Toploop.directive_table "utop_help"
(Toploop.Directive_none (Toploop.Directive_none
(fun () -> (fun () ->
print_endline "You can use the following commands to get more help: print_endline "If colors look too bright, try: UTop.set_profile UTop.Light
You can use the following commands to get more help:
#utop_bindings : list all the current key bindings #utop_bindings : list all the current key bindings
#utop_macro : display the currently recorded macro #utop_macro : display the currently recorded macro

View File

@ -20,6 +20,16 @@ val add_keyword : string -> unit
(** {6 Console specific configuration} *) (** {6 Console specific configuration} *)
type profile = Dark | Light
(** Profile for terminal 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. *)
val set_profile : profile -> unit
(** Sets the profile of the terminal. *)
val size : LTerm_geom.size React.signal val size : LTerm_geom.size React.signal
(** The current size of the terminal. *) (** The current size of the terminal. *)

View File

@ -67,6 +67,11 @@ let init_resources () =
styles.style_blanks <- LTerm_resources.get_style "blanks" res; styles.style_blanks <- LTerm_resources.get_style "blanks" res;
styles.style_error <- LTerm_resources.get_style "error" res; styles.style_error <- LTerm_resources.get_style "error" res;
styles.style_paren <- LTerm_resources.get_style "parenthesis" res; styles.style_paren <- LTerm_resources.get_style "parenthesis" res;
(match String.lowercase (LTerm_resources.get "profile" res) with
| "light" -> UTop.set_profile UTop.Light
| "dark" -> UTop.set_profile UTop.Dark
| "" -> ()
| str -> raise (LTerm_resources.Error (Printf.sprintf "invalid profile %S" str)));
return () return ()
with Unix.Unix_error(Unix.ENOENT, _, _) -> with Unix.Unix_error(Unix.ENOENT, _, _) ->
return () return ()

View File

@ -2,6 +2,7 @@
! Copy this file to ~/.utoprc ! Copy this file to ~/.utoprc
profile: dark
identifier.foreground: none identifier.foreground: none
comment.foreground: x-chocolate1 comment.foreground: x-chocolate1
doc.foreground: x-light-salmon doc.foreground: x-light-salmon

View File

@ -2,6 +2,7 @@
! Copy this file to ~/.utoprc ! Copy this file to ~/.utoprc
profile: light
identifier.foreground: none identifier.foreground: none
comment.foreground: x-firebrick comment.foreground: x-firebrick
doc.foreground: x-rosybrown doc.foreground: x-rosybrown
@ -12,4 +13,4 @@ string.foreground: x-rosybrown
char.foreground: x-rosybrown char.foreground: x-rosybrown
quotation.foreground: x-purple quotation.foreground: x-purple
error.foreground: x-red error.foreground: x-red
parenthesis.background: blue parenthesis.background: lblue