Add Jambon's tree printer
This commit is contained in:
parent
c5587f4a96
commit
5cf1896703
2
Makefile
2
Makefile
|
@ -8,7 +8,7 @@ DOC = cpdfunicodedata cpdferror cpdfdebug cpdfjson cpdfstrftime cpdfcoord \
|
||||||
cpdfsqueeze cpdfdraft cpdfspot cpdfpagelabels cpdfcreate cpdfannot \
|
cpdfsqueeze cpdfdraft cpdfspot cpdfpagelabels cpdfcreate cpdfannot \
|
||||||
cpdfxobject cpdfimpose cpdfchop cpdftweak cpdftexttopdf cpdftoc \
|
cpdfxobject cpdfimpose cpdfchop cpdftweak cpdftexttopdf cpdftoc \
|
||||||
cpdfjpeg cpdfjpeg2000 cpdfpng cpdfimage cpdfdraw cpdfcomposition \
|
cpdfjpeg cpdfjpeg2000 cpdfpng cpdfimage cpdfdraw cpdfcomposition \
|
||||||
cpdfshape cpdfcolours cpdfdrawcontrol cpdfua cpdfcommand
|
cpdfshape cpdfcolours cpdfdrawcontrol cpdfprinttree cpdfua cpdfcommand
|
||||||
|
|
||||||
MODS = $(NONDOC) $(DOC)
|
MODS = $(NONDOC) $(DOC)
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1,24 @@
|
||||||
|
(* Courtesy Martin Jambon, in the public domain. *)
|
||||||
|
let rec titer f = function
|
||||||
|
| [] -> ()
|
||||||
|
| [x] -> f true x
|
||||||
|
| x :: tl -> f false x; titer f tl
|
||||||
|
|
||||||
|
let to_buffer ?(line_prefix = "") ~get_name ~get_children buf x =
|
||||||
|
let rec print_root indent x =
|
||||||
|
Printf.bprintf buf "%s\n" (get_name x);
|
||||||
|
let children = get_children x in
|
||||||
|
titer (print_child indent) children
|
||||||
|
and print_child indent is_last x =
|
||||||
|
let line = if is_last then "└── " else "├── " in
|
||||||
|
Printf.bprintf buf "%s%s" indent line;
|
||||||
|
let extra_indent = if is_last then " " else "│ " in
|
||||||
|
print_root (indent ^ extra_indent) x
|
||||||
|
in
|
||||||
|
Buffer.add_string buf line_prefix;
|
||||||
|
print_root line_prefix x
|
||||||
|
|
||||||
|
let to_string ?line_prefix ~get_name ~get_children x =
|
||||||
|
let buf = Buffer.create 1000 in
|
||||||
|
to_buffer ?line_prefix ~get_name ~get_children buf x;
|
||||||
|
Buffer.contents buf
|
|
@ -0,0 +1,5 @@
|
||||||
|
(** Print trees *)
|
||||||
|
|
||||||
|
val to_buffer : ?line_prefix: string -> get_name: ('a -> string) -> get_children: ('a -> 'a list) -> Buffer.t -> 'a -> unit
|
||||||
|
|
||||||
|
val to_string : ?line_prefix: string -> get_name: ('a -> string) -> get_children: ('a -> 'a list) -> 'a -> string
|
Loading…
Reference in New Issue