Updated MANIFEST.
[virt-top.git] / mlvirtmanager / mlvirtmanager_helpers.ml
1 (* virt-manager-like graphical management tool.
2    (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc.
3    http://libvirt.org/
4
5    This program is free software; you can redistribute it and/or modify
6    it under the terms of the GNU General Public License as published by
7    the Free Software Foundation; either version 2 of the License, or
8    (at your option) any later version.
9
10    This program is distributed in the hope that it will be useful,
11    but WITHOUT ANY WARRANTY; without even the implied warranty of
12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13    GNU General Public License for more details.
14
15    You should have received a copy of the GNU General Public License
16    along with this program; if not, write to the Free Software
17    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
18 *)
19
20 module C = Libvirt.Connect
21 module D = Libvirt.Domain
22 module N = Libvirt.Network
23
24 (* Given two lists, xs and ys, return a list of items which have been
25  * added to ys, items which are the same, and items which have been
26  * removed from ys.
27  * Returns a triplet (list of added, list of same, list of removed).
28  *)
29 let differences xs ys =
30   let rec d = function
31     | [], [] -> (* Base case. *)
32         ([], [], [])
33     | [], ys -> (* All ys have been added. *)
34         (ys, [], [])
35     | xs, [] -> (* All xs have been removed. *)
36         ([], [], xs)
37     | (x :: xs), (y :: ys) when x = y -> (* Not added or removed. *)
38         let added, unchanged, removed = d (xs, ys) in
39         added, x :: unchanged, removed
40     | (x :: xs), ((y :: _) as ys) when x < y -> (* x removed. *)
41         let added, unchanged, removed = d (xs, ys) in
42         added, unchanged, x :: removed
43     | ((x :: _) as xs), (y :: ys) (* when x > y *) -> (* y added. *)
44         let added, unchanged, removed = d (xs, ys) in
45         y :: added, unchanged, removed
46   in
47   d (List.sort compare xs, List.sort compare ys)
48
49 let string_of_domain_state = function
50   | D.InfoNoState -> "unknown"
51   | D.InfoRunning -> "running"
52   | D.InfoBlocked -> "blocked"
53   | D.InfoPaused -> "paused"
54   | D.InfoShutdown -> "shutdown"
55   | D.InfoShutoff -> "shutoff"
56   | D.InfoCrashed -> "crashed"
57
58 (* Filter top level rows (only) in a tree_store.  If function f returns
59  * true then the row remains, but if it returns false then the row is
60  * removed.
61  *)
62 let rec filter_top_level_rows (model : GTree.tree_store) f =
63   match model#get_iter_first with
64   | None -> ()
65   | Some iter -> filter_rows model f iter
66
67 (* Filter rows in a tree_store at a particular level. *)
68 and filter_rows model f row =
69   let keep = f row in
70   let iter_still_valid =
71     if not keep then model#remove row else model#iter_next row in
72   if iter_still_valid then filter_rows model f row
73
74 (* Find the first top level row matching predicate f and return it. *)
75 let rec find_top_level_row (model : GTree.tree_store) f =
76   match model#get_iter_first with
77   | None -> raise Not_found (* no rows *)
78   | Some row -> find_row model f row
79
80 (* Find the first row matching predicate f at a particular level. *)
81 and find_row model f row =
82   if f row then row
83   else if model#iter_next row then find_row model f row
84   else raise Not_found
85
86 (* Iterate over top level rows (only) in a tree_store. *)
87 let rec iter_top_level_rows (model : GTree.tree_store) f =
88   match model#get_iter_first with
89   | None -> ()
90   | Some iter -> iter_rows model f iter
91
92 (* Iterate over rows in a tree_store at a particular level. *)
93 and iter_rows model f row =
94   f row;
95   if model#iter_next row then iter_rows model f row