From c6827f1ba3bcedfd051c71900d645984c954e0ff Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Tue, 2 Aug 2011 00:18:35 +0200 Subject: [PATCH] add support for light colors terminals Ignore-this: fb8794243e001dbb59379ac829be0b15 darcs-hash:20110801221835-c41ad-32e00f215b7167d23efc7a3d3e3aa972f0062785 --- src/uTop.ml | 40 ++++++++++++++++++++++++++-------------- src/uTop.mli | 10 ++++++++++ src/uTop_console.ml | 5 +++++ utoprc-dark | 1 + utoprc-light | 3 ++- 5 files changed, 44 insertions(+), 15 deletions(-) diff --git a/src/uTop.ml b/src/uTop.ml index 1d468fd..af851a0 100644 --- a/src/uTop.ml +++ b/src/uTop.ml @@ -36,30 +36,40 @@ let add_keyword kwd = keywords := String_set.add kwd !keywords | Prompts | +-----------------------------------------------------------------+ *) +type profile = Dark | Light + +let profile, set_profile = S.create Dark + let size = UTop_private.size 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 color dark light = + match profile with + | Dark -> dark + | Light -> light + in + let bold = profile = Dark in let txta = eval [ - B_bold true; - B_fg lcyan; + B_bold bold; + B_fg (color lcyan blue); 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 " )─< "; - 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 " >─"; ] in let txtb = if recording then eval [ - B_bold true; - B_fg lcyan; + B_bold bold; + B_fg (color lcyan blue); 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 " ]─"; ] else @@ -73,15 +83,15 @@ let make_prompt count size recording macro_count = txta; Array.make (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; ] - ) [|(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_comment = 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.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 | @@ -94,7 +104,9 @@ let () = Hashtbl.add Toploop.directive_table "utop_help" (Toploop.Directive_none (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_macro : display the currently recorded macro diff --git a/src/uTop.mli b/src/uTop.mli index 803b2a8..958c02b 100644 --- a/src/uTop.mli +++ b/src/uTop.mli @@ -20,6 +20,16 @@ val add_keyword : string -> unit (** {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 (** The current size of the terminal. *) diff --git a/src/uTop_console.ml b/src/uTop_console.ml index 489897f..87c3329 100644 --- a/src/uTop_console.ml +++ b/src/uTop_console.ml @@ -67,6 +67,11 @@ let init_resources () = styles.style_blanks <- LTerm_resources.get_style "blanks" res; styles.style_error <- LTerm_resources.get_style "error" 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 () with Unix.Unix_error(Unix.ENOENT, _, _) -> return () diff --git a/utoprc-dark b/utoprc-dark index f8b34ec..14de473 100644 --- a/utoprc-dark +++ b/utoprc-dark @@ -2,6 +2,7 @@ ! Copy this file to ~/.utoprc +profile: dark identifier.foreground: none comment.foreground: x-chocolate1 doc.foreground: x-light-salmon diff --git a/utoprc-light b/utoprc-light index 96a0928..c9bc751 100644 --- a/utoprc-light +++ b/utoprc-light @@ -2,6 +2,7 @@ ! Copy this file to ~/.utoprc +profile: light identifier.foreground: none comment.foreground: x-firebrick doc.foreground: x-rosybrown @@ -12,4 +13,4 @@ string.foreground: x-rosybrown char.foreground: x-rosybrown quotation.foreground: x-purple error.foreground: x-red -parenthesis.background: blue +parenthesis.background: lblue