Attention une mise à jour du service Gitlab va être effectuée le mardi 18 janvier (et non lundi 17 comme annoncé précédemment) entre 18h00 et 18h30. Cette mise à jour va générer une interruption du service dont nous ne maîtrisons pas complètement la durée mais qui ne devrait pas excéder quelques minutes.

Commit 3d9d86f4 authored by bguillaum's avatar bguillaum
Browse files

more robust color management

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@8452 7838e531-6607-4d57-9587-6c381814729c
parent 71fa6333
......@@ -29,6 +29,12 @@ let conll_string_of_value = function
| String s -> s
| Float i -> String_.of_float i
let dot_color string =
match (string.[0], String.length string) with
| ('#', 4) -> sprintf "\"#%c%c%c%c%c%c\"" string.[1] string.[1] string.[2] string.[2] string.[3] string.[3]
| ('#', 7) -> sprintf "\"%s\"" string
| _ -> string
(* ================================================================================ *)
module Pid = struct
(* type t = int *)
......@@ -190,7 +196,7 @@ module Label = struct
let to_dot ?(deco=false) t =
let style = get_style t in
let dot_items =
(match style.color with Some c -> ["color="^c; "fontcolor="^c] | None -> [])
(match style.color with Some c -> let d = dot_color c in ["color="^d; "fontcolor="^d] | None -> [])
@ (match style.line with
| Dot -> ["style=dotted"]
| Dash -> ["style=dashed"]
......
......@@ -40,7 +40,7 @@ let letter = ['a'-'z' 'A'-'Z']
let ident = (letter | '_') | (letter | '_') (letter | digit | '_' | '.' | '\'' | '-')* (letter | digit | '_' | '\'')
let hex = ['0'-'9' 'a'-'f' 'A'-'F']
let color = hex hex hex hex hex hex
let color = hex hex hex hex hex hex | hex hex hex
rule comment target = parse
| '\n' { incr Parser_global.current_line; Lexing.new_line lexbuf; target lexbuf }
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment