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

add colors for modules and directives 

Ignore-this: 318635e4f07f427549dbe99980e4c46f

darcs-hash:20110803083828-c41ad-f2e8bf6cdfb2991b965725e356dac9bc64a906fc
This commit is contained in:
Jeremie Dimino 2011-08-03 10:38:28 +02:00
parent ee02c487ee
commit 5eff3286aa
4 changed files with 215 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
man/utoprc.5
View File

@ -41,6 +41,7 @@ in
The following style keys are used by utop:
* identifier
* module
* comment
* doc
* constant
@ -50,7 +51,9 @@ The following style keys are used by utop:
* char
* quotation
* error
* directive
* parenthesis
* blanks
For each of these keys, the following sub-keys are used:

232
src/uTop_console.ml
View File

@ -26,6 +26,7 @@ type styles = {
mutable style_keyword : LTerm_style.t;
mutable style_symbol : LTerm_style.t;
mutable style_ident : LTerm_style.t;
mutable style_module : LTerm_style.t;
mutable style_constant : LTerm_style.t;
mutable style_char : LTerm_style.t;
mutable style_string : LTerm_style.t;
@ -34,6 +35,7 @@ type styles = {
mutable style_doc : LTerm_style.t;
mutable style_blanks : LTerm_style.t;
mutable style_error : LTerm_style.t;
mutable style_directive : LTerm_style.t;
mutable style_paren : LTerm_style.t;
}
@ -41,6 +43,7 @@ let styles = {
style_keyword = LTerm_style.none;
style_symbol = LTerm_style.none;
style_ident = LTerm_style.none;
style_module = LTerm_style.none;
style_constant = LTerm_style.none;
style_char = LTerm_style.none;
style_string = LTerm_style.none;
@ -49,6 +52,7 @@ let styles = {
style_doc = LTerm_style.none;
style_blanks = LTerm_style.none;
style_error = LTerm_style.none;
style_directive = LTerm_style.none;
style_paren = LTerm_style.none;
}
@ -58,6 +62,7 @@ let init_resources () =
styles.style_keyword <- LTerm_resources.get_style "keyword" res;
styles.style_symbol <- LTerm_resources.get_style "symbol" res;
styles.style_ident <- LTerm_resources.get_style "identifier" res;
styles.style_module <- LTerm_resources.get_style "module" res;
styles.style_constant <- LTerm_resources.get_style "constant" res;
styles.style_char <- LTerm_resources.get_style "char" res;
styles.style_string <- LTerm_resources.get_style "string" res;
@ -66,6 +71,7 @@ let init_resources () =
styles.style_doc <- LTerm_resources.get_style "doc" res;
styles.style_blanks <- LTerm_resources.get_style "blanks" res;
styles.style_error <- LTerm_resources.get_style "error" res;
styles.style_directive <- LTerm_resources.get_style "directive" 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
@ -120,46 +126,218 @@ object(self)
let styled, position = super#stylise last in
(* Syntax highlighting *)
let tokens = UTop_lexer.lex_string (pending ^ LTerm_text.to_string styled) in
let stylise start stop token_style =
for i = max 0 (start - pending_length) to stop - pending_length - 1 do
let ch, style = styled.(i) in
styled.(i) <- (ch, LTerm_style.merge token_style style)
done
in
let rec loop tokens =
match tokens with
| [] ->
()
| (token, start, stop, src) :: rest ->
let token_style =
match token with
| Symbol -> styles.style_symbol
| Lident -> if String_set.mem src !UTop.keywords then styles.style_keyword else styles.style_ident
| Uident -> styles.style_ident
| Constant -> styles.style_constant
| Char -> styles.style_char
| String _ -> styles.style_string
| Quotation _ -> styles.style_quotation
| Comment _ -> styles.style_comment
| Doc _ -> styles.style_doc
| Blanks -> styles.style_blanks
| Error -> styles.style_error
in
for i = start - pending_length to stop - pending_length - 1 do
let ch, style = styled.(i) in
styled.(i) <- (ch, LTerm_style.merge token_style style)
done;
| Symbol ->
stylise start stop styles.style_symbol;
loop rest
in
let rec skip tokens =
| Lident ->
stylise start stop
(if String_set.mem src !UTop.keywords then
styles.style_keyword
else
styles.style_ident);
loop rest
| Uident ->
if String_set.mem src !UTop.keywords then begin
stylise start stop styles.style_keyword;
loop rest
end else
loop_after_uident start stop rest
| Constant ->
stylise start stop styles.style_constant;
loop rest
| Char ->
stylise start stop styles.style_char;
loop rest
| String _ ->
stylise start stop styles.style_string;
loop rest
| Quotation _ ->
stylise start stop styles.style_quotation;
loop rest
| Comment _ ->
stylise start stop styles.style_comment;
loop rest
| Doc _ ->
stylise start stop styles.style_doc;
loop rest
| Blanks ->
stylise start stop styles.style_blanks;
loop rest
| Error ->
stylise start stop styles.style_error;
loop rest
and loop_after_uident uid_start uid_stop tokens =
match tokens with
| [] ->
()
| (token, start, stop, src) :: rest ->
if stop = pending_length then
loop rest
else if stop > pending_length then
loop ((token, pending_length, stop, Zed_utf8.sub src (pending_length - start) (stop - pending_length)) :: rest)
match token with
| Symbol ->
if src = "." then
stylise uid_start uid_stop styles.style_module
else
skip rest
stylise uid_start uid_stop styles.style_ident;
stylise start stop styles.style_symbol;
loop rest
| Lident ->
stylise uid_start uid_stop styles.style_ident;
stylise start stop
(if String_set.mem src !UTop.keywords then
styles.style_keyword
else
styles.style_ident);
loop rest
| Uident ->
stylise uid_start uid_stop styles.style_ident;
if String_set.mem src !UTop.keywords then begin
stylise start stop styles.style_keyword;
loop rest
end else
loop_after_uident start stop rest
| Constant ->
stylise uid_start uid_stop styles.style_ident;
stylise start stop styles.style_constant;
loop rest
| Char ->
stylise uid_start uid_stop styles.style_ident;
stylise start stop styles.style_char;
loop rest
| String _ ->
stylise uid_start uid_stop styles.style_ident;
stylise start stop styles.style_string;
loop rest
| Quotation _ ->
stylise uid_start uid_stop styles.style_ident;
stylise start stop styles.style_quotation;
loop rest
| Comment _ ->
stylise uid_start uid_stop styles.style_ident;
stylise start stop styles.style_comment;
loop_after_uident uid_start uid_stop rest
| Doc _ ->
stylise uid_start uid_stop styles.style_ident;
stylise start stop styles.style_doc;
loop_after_uident uid_start uid_stop rest
| Blanks ->
stylise uid_start uid_stop styles.style_ident;
stylise start stop styles.style_blanks;
loop_after_uident uid_start uid_stop rest
| Error ->
stylise uid_start uid_stop styles.style_ident;
stylise start stop styles.style_error;
loop rest
and loop_sharp tokens =
match tokens with
| [] ->
()
| (token, start, stop, src) :: rest ->
match token with
| Symbol ->
if src = "#" then begin
stylise start stop styles.style_directive;
loop_directive rest
end else begin
stylise start stop styles.style_symbol;
loop rest
end
| Lident ->
stylise start stop
(if String_set.mem src !UTop.keywords then
styles.style_keyword
else
styles.style_ident);
loop rest
| Uident ->
if String_set.mem src !UTop.keywords then begin
stylise start stop styles.style_keyword;
loop rest
end else
loop_after_uident start stop rest
| Constant ->
stylise start stop styles.style_constant;
loop rest
| Char ->
stylise start stop styles.style_char;
loop rest
| String _ ->
stylise start stop styles.style_string;
loop rest
| Quotation _ ->
stylise start stop styles.style_quotation;
loop rest
| Comment _ ->
stylise start stop styles.style_comment;
loop_sharp rest
| Doc _ ->
stylise start stop styles.style_doc;
loop_sharp rest
| Blanks ->
stylise start stop styles.style_blanks;
loop_sharp rest
| Error ->
stylise start stop styles.style_error;
loop rest
and loop_directive tokens =
match tokens with
| [] ->
()
| (token, start, stop, src) :: rest ->
match token with
| Symbol ->
stylise start stop styles.style_symbol;
loop rest
| Lident ->
stylise start stop
(if String_set.mem src !UTop.keywords then
styles.style_keyword
else
styles.style_directive);
loop rest
| Uident ->
if String_set.mem src !UTop.keywords then begin
stylise start stop styles.style_keyword;
loop rest
end else
loop_after_uident start stop rest
| Constant ->
stylise start stop styles.style_constant;
loop rest
| Char ->
stylise start stop styles.style_char;
loop rest
| String _ ->
stylise start stop styles.style_string;
loop rest
| Quotation _ ->
stylise start stop styles.style_quotation;
loop rest
| Comment _ ->
stylise start stop styles.style_comment;
loop_directive rest
| Doc _ ->
stylise start stop styles.style_doc;
loop_directive rest
| Blanks ->
stylise start stop styles.style_blanks;
loop_directive rest
| Error ->
stylise start stop styles.style_error;
loop rest
in
if pending_length = 0 then loop tokens else skip tokens;
let tokens = UTop_lexer.lex_string (pending ^ LTerm_text.to_string styled) in
loop_sharp tokens;
(* Parenthesis matching. *)

2
utoprc-dark
View File

@ -4,6 +4,7 @@
profile: dark
identifier.foreground: none
module.foreground: x-palegreen
comment.foreground: x-chocolate1
doc.foreground: x-light-salmon
constant.foreground: x-aquamarine
@ -13,4 +14,5 @@ string.foreground: x-light-salmon
char.foreground: x-light-salmon
quotation.foreground: x-purple
error.foreground: x-red
directive.foreground: x-lightsteelblue
parenthesis.background: blue

2
utoprc-light
View File

@ -4,6 +4,7 @@
profile: light
identifier.foreground: none
module.foreground: x-forestgreen
comment.foreground: x-firebrick
doc.foreground: x-violetred4
constant.foreground: x-darkcyan
@ -13,4 +14,5 @@ string.foreground: x-violetred4
char.foreground: x-violetred4
quotation.foreground: x-purple
error.foreground: x-red
directive.foreground: x-mediumorchid4
parenthesis.background: light-blue