diff --git a/src/dGraphTreeLayout.ml b/src/dGraphTreeLayout.ml index b8ad38cc..3297a80e 100644 --- a/src/dGraphTreeLayout.ml +++ b/src/dGraphTreeLayout.ml @@ -237,6 +237,7 @@ struct mutable style : [ `Rounded | `Filled | `Solid | `Dashed | `Dotted | `Bold | `Invis ] list; mutable width : float option; + mutable tooltip : string option; mutable fillcolor : int32 option; } @@ -257,6 +258,7 @@ struct | `Shape shape -> vattrs.shape <- set_if_none vattrs.shape shape | `Style s -> vattrs.style <- s :: vattrs.style | `Width w -> vattrs.width <- set_if_none vattrs.width w + | `Tooltip t -> vattrs.tooltip <- set_if_none vattrs.tooltip t | `Fillcolor c -> vattrs.fillcolor <- set_if_none vattrs.fillcolor (Graphviz.color_to_color_with_transparency c) @@ -285,6 +287,7 @@ struct shape = None; style = []; width = None; + tooltip = None; fillcolor = None } in let dgraph_layout_default = @@ -455,7 +458,8 @@ struct mutable labelfontcolor : int option; mutable labelfontname : string option; mutable labelfontsize : int option; - mutable style : [ `Solid | `Dashed | `Dotted | `Bold | `Invis ] list + mutable style : [ `Solid | `Dashed | `Dotted | `Bold | `Invis ] list; + mutable tooltip : string option } let rec attributes_list_to_eattributes (eattrs:eattributes) @@ -502,6 +506,9 @@ struct | `Style s :: q -> eattrs.style <- s :: eattrs.style; attributes_list_to_eattributes eattrs q + | `Tooltip t :: q -> + eattrs.tooltip <- set_if_none eattrs.tooltip t; + attributes_list_to_eattributes eattrs q | (`Arrowhead _ | `Arrowsize _ | `Arrowtail _ | `Comment _ | `Constraint _ | `Headlabel _ | `Headport _ | `Headurl _ | `Labelangle _ |`Labeldistance _ | `Labelfloat _ | `Layer _ | `Minlen _ | `Penwidth _ @@ -522,7 +529,8 @@ struct labelfontcolor = None; labelfontname = None; labelfontsize = None; - style = [] } + style = []; + tooltip = None } in let dgraph_layout_default = [ `Color 0xFF0000; `Decorate false; `Dir `Forward; `Fontcolor 0x00000; diff --git a/src/graphviz.ml b/src/graphviz.ml index 75ce965d..5e8b0a08 100644 --- a/src/graphviz.ml +++ b/src/graphviz.ml @@ -141,6 +141,8 @@ module CommonAttributes = struct | `OrderingOut (** Constrains order of out-edges in a subgraph according to their file sequence *) + | `Tooltip of string + (** Sets the tooltip (mouse hover text) attached to the graph. *) ] (** Attributes of nodes. *) @@ -205,6 +207,8 @@ module CommonAttributes = struct simultaneously. *) | `Width of float (** Sets the minimum width. Default value is [0.75]. *) + | `Tooltip of string + (** Sets the tooltip (mouse hover text) attached to the vertex. *) ] (** Attributes of edges. *) @@ -245,6 +249,8 @@ module CommonAttributes = struct | `Style of [ `Solid | `Dashed | `Dotted | `Bold | `Invis ] (** Sets the layout style of the edge. Several styles may be combined simultaneously. *) + | `Tooltip of string + (** Sets the tooltip (mouse hover text) attached to the edge. *) ] (** Pretty-print. *) @@ -265,6 +271,7 @@ module CommonAttributes = struct | `Pagedir a -> fprintf ppf "pagedir=%a" fprint_dir a | `Size (x, y) -> fprintf ppf "size=\"%f,%f\"" x y | `OrderingOut -> fprintf ppf "ordering=out" + | `Tooltip s -> fprintf ppf "tooltip=%a" fprint_string s let fprint_shape ppf = function | `Ellipse -> fprintf ppf "ellipse" @@ -353,6 +360,7 @@ module CommonAttributes = struct | `Shape a -> fprintf ppf "shape=%a" fprint_shape a | `Style _ -> assert false | `Width f -> fprintf ppf "width=%f" f + | `Tooltip s -> fprintf ppf "tooltip=%a" fprint_string s let fprint_arrow_direction ppf = function `Forward -> fprintf ppf "forward" @@ -377,6 +385,7 @@ module CommonAttributes = struct | `Labelfontsize i -> fprintf ppf "labelfontsize=%i" i | `Penwidth f -> fprintf ppf "penwidth=%f" f | `Style _ -> assert false + | `Tooltip s -> fprintf ppf "tooltip=%a" fprint_string s let rec filter_style al sl l = match l with | [] -> al, sl diff --git a/src/graphviz.mli b/src/graphviz.mli index 0e86e442..7b60710e 100644 --- a/src/graphviz.mli +++ b/src/graphviz.mli @@ -104,6 +104,8 @@ module CommonAttributes : sig | `OrderingOut (** Constrains order of out-edges in a subgraph according to their file sequence *) + | `Tooltip of string + (** Sets the tooltip (mouse hover text) attached to the graph. *) ] (** Attributes of vertices. *) @@ -178,6 +180,8 @@ module CommonAttributes : sig Several styles may be combined simultaneously. *) | `Width of float (** Sets the minimum width. Default value is [0.75]. *) + | `Tooltip of string + (** Sets the tooltip (mouse hover text) attached to the vertex. *) ] (** Attributes of edges. *) @@ -223,6 +227,8 @@ module CommonAttributes : sig | `Style of [ `Solid | `Dashed | `Dotted | `Bold | `Invis ] (** Sets the layout style of the edge. Several styles may be combined simultaneously. *) + | `Tooltip of string + (** Sets the tooltip (mouse hover text) attached to the edge. *) ] end diff --git a/tests/dot.expected b/tests/dot.expected index 4fb53d9e..edee0ebf 100644 --- a/tests/dot.expected +++ b/tests/dot.expected @@ -8,11 +8,11 @@ digraph G { "task_eat"; - "task_menu" -> "task_ingredients" [label=, ]; - "task_ingredients" -> "task_cook" [label=, ]; - "task_invitation" -> "task_cook" [label=, ]; - "task_cook" -> "task_eat" [label=, ]; - "task_table" -> "task_eat" [label=, ]; + "task_menu" -> "task_ingredients" [tooltip="description", label=, ]; + "task_ingredients" -> "task_cook" [tooltip="description", label=, ]; + "task_invitation" -> "task_cook" [tooltip="description", label=, ]; + "task_cook" -> "task_eat" [tooltip="description", label=, ]; + "task_table" -> "task_eat" [tooltip="description", label=, ]; } ========= END output graph ========= \ No newline at end of file diff --git a/tests/dot.ml b/tests/dot.ml index f924588a..40f86b38 100644 --- a/tests/dot.ml +++ b/tests/dot.ml @@ -38,7 +38,7 @@ module Display = struct let default_vertex_attributes _ = [] let vertex_attributes _ = [] let default_edge_attributes _ = [] - let edge_attributes _ = [ `HtmlLabel "f$oo" ] + let edge_attributes _ = [ `HtmlLabel "f$oo"; `Tooltip "description" ] let get_subgraph _ = None end module DotOutput = Graphviz.Dot(Display)