Tab to space fixes, now passes 'make syntax-check'

diff --git a/HACKING b/HACKING
index ca5b9a9..d4e030c 100644 (file)
--- a/HACKING
+++ b/HACKING
@@ -120,10 +120,10 @@ ruby/
         Ruby bindings.
 
 tools/
         Ruby bindings.
 
 tools/

-       Command line tools like virt-cat, virt-df, virt-edit and more.
-       In versions <= 1.0.73 these were all in separate directories
-       like cat/, df/, edit/, but since then we moved them all into
-       one directory to simplify builds.
+        Command line tools like virt-cat, virt-df, virt-edit and more.
+        In versions <= 1.0.73 these were all in separate directories
+        like cat/, df/, edit/, but since then we moved them all into
+        one directory to simplify builds.

 
 src/
         Source code to the C library.
 
 src/
         Source code to the C library.

diff --git a/daemon/find.c b/daemon/find.c
index c5d26d7..98895ab 100644 (file)
--- a/daemon/find.c
+++ b/daemon/find.c
@@ -128,7 +128,7 @@ do_find (const char *dir)
 
   sort_strings (res, size-1);
 
 
   sort_strings (res, size-1);
 

-  return res;                  /* caller frees */
+  return res;                        /* caller frees */

 }
 
 /* The code below assumes each path returned can fit into a protocol
 }
 
 /* The code below assumes each path returned can fit into a protocol


@@ -212,20 +212,19 @@ do_find0 (const char *dir)
 
   if (ferror (fp)) {
     perror (dir);
 
   if (ferror (fp)) {
     perror (dir);

-    send_file_end (1);         /* Cancel. */
+    send_file_end (1);                /* Cancel. */

     pclose (fp);
     return -1;
   }
 
   if (pclose (fp) != 0) {
     perror (dir);
     pclose (fp);
     return -1;
   }
 
   if (pclose (fp) != 0) {
     perror (dir);

-    send_file_end (1);         /* Cancel. */
+    send_file_end (1);                /* Cancel. */

     return -1;
   }
 
     return -1;
   }
 

-  if (send_file_end (0))       /* Normal end of file. */
+  if (send_file_end (0))        /* Normal end of file. */

     return -1;
 
   return 0;
 }
     return -1;
 
   return 0;
 }

-

diff --git a/inspector/inspector_generator.ml b/inspector/inspector_generator.ml
index a1d1aa5..20d2b01 100644 (file)
--- a/inspector/inspector_generator.ml
+++ b/inspector/inspector_generator.ml
@@ -59,15 +59,15 @@ let input = "inspector/virt-inspector.rng"
  * able to parse the specific input file.
  *)
 type rng =
  * able to parse the specific input file.
  *)
 type rng =

-  | Element of string * rng list       (* <element name=name/> *)
-  | Attribute of string * rng list     (* <attribute name=name/> *)
-  | Interleave of rng list             (* <interleave/> *)
-  | ZeroOrMore of rng                  (* <zeroOrMore/> *)
-  | OneOrMore of rng                   (* <oneOrMore/> *)
-  | Optional of rng                    (* <optional/> *)
-  | Choice of string list              (* <choice><value/>*</choice> *)
-  | Value of string                    (* <value>str</value> *)
-  | Text                               (* <text/> *)
+  | Element of string * rng list        (* <element name=name/> *)
+  | Attribute of string * rng list        (* <attribute name=name/> *)
+  | Interleave of rng list                (* <interleave/> *)
+  | ZeroOrMore of rng                        (* <zeroOrMore/> *)
+  | OneOrMore of rng                        (* <oneOrMore/> *)
+  | Optional of rng                        (* <optional/> *)
+  | Choice of string list                (* <choice><value/>*</choice> *)
+  | Value of string                        (* <value>str</value> *)
+  | Text                                (* <text/> *)

 
 let rec string_of_rng = function
   | Element (name, xs) ->
 
 let rec string_of_rng = function
   | Element (name, xs) ->


@@ -101,31 +101,31 @@ let rec parse_rng ?defines context = function
       (match rng with
        | [child] -> ZeroOrMore child :: parse_rng ?defines context rest
        | _ ->
       (match rng with
        | [child] -> ZeroOrMore child :: parse_rng ?defines context rest
        | _ ->

-          failwithf "%s: <zeroOrMore> contains more than one child element"
-            context
+           failwithf "%s: <zeroOrMore> contains more than one child element"
+             context

       )
   | Xml.Element ("oneOrMore", [], [child]) :: rest ->
       let rng = parse_rng ?defines context [child] in
       (match rng with
        | [child] -> OneOrMore child :: parse_rng ?defines context rest
        | _ ->
       )
   | Xml.Element ("oneOrMore", [], [child]) :: rest ->
       let rng = parse_rng ?defines context [child] in
       (match rng with
        | [child] -> OneOrMore child :: parse_rng ?defines context rest
        | _ ->

-          failwithf "%s: <oneOrMore> contains more than one child element"
-            context
+           failwithf "%s: <oneOrMore> contains more than one child element"
+             context

       )
   | Xml.Element ("optional", [], [child]) :: rest ->
       let rng = parse_rng ?defines context [child] in
       (match rng with
        | [child] -> Optional child :: parse_rng ?defines context rest
        | _ ->
       )
   | Xml.Element ("optional", [], [child]) :: rest ->
       let rng = parse_rng ?defines context [child] in
       (match rng with
        | [child] -> Optional child :: parse_rng ?defines context rest
        | _ ->

-          failwithf "%s: <optional> contains more than one child element"
-            context
+           failwithf "%s: <optional> contains more than one child element"
+             context

       )
   | Xml.Element ("choice", [], children) :: rest ->
       let values = List.map (
       )
   | Xml.Element ("choice", [], children) :: rest ->
       let values = List.map (

-       function Xml.Element ("value", [], [Xml.PCData value]) -> value
-       | _ ->
-           failwithf "%s: can't handle anything except <value> in <choice>"
-             context
+        function Xml.Element ("value", [], [Xml.PCData value]) -> value
+        | _ ->
+            failwithf "%s: can't handle anything except <value> in <choice>"
+              context

       ) children in
       Choice values
       :: parse_rng ?defines context rest
       ) children in
       Choice values
       :: parse_rng ?defines context rest


@@ -140,10 +140,10 @@ let rec parse_rng ?defines context = function
        *)
       (match defines with
        | None ->
        *)
       (match defines with
        | None ->

-          failwithf "%s: contains <ref>, but no refs are defined yet" context
+           failwithf "%s: contains <ref>, but no refs are defined yet" context

        | Some map ->
        | Some map ->

-          let rng = StringMap.find name map in
-          rng @ parse_rng ?defines context rest
+           let rng = StringMap.find name map in
+           rng @ parse_rng ?defines context rest

       )
   | x :: _ ->
       failwithf "%s: can't handle '%s' in schema" context (Xml.to_string x)
       )
   | x :: _ ->
       failwithf "%s: can't handle '%s' in schema" context (Xml.to_string x)


@@ -152,16 +152,16 @@ let grammar =
   let xml = Xml.parse_file input in
   match xml with
   | Xml.Element ("grammar", _,
   let xml = Xml.parse_file input in
   match xml with
   | Xml.Element ("grammar", _,

-                Xml.Element ("start", _, gram) :: defines) ->
+                 Xml.Element ("start", _, gram) :: defines) ->

       (* The <define/> elements are referenced in the <start> section,
        * so build a map of those first.
        *)
       let defines = List.fold_left (
       (* The <define/> elements are referenced in the <start> section,
        * so build a map of those first.
        *)
       let defines = List.fold_left (

-       fun map ->
-         function Xml.Element ("define", ["name", name], defn) ->
-           StringMap.add name defn map
-         | _ ->
-             failwithf "%s: expected <define name=name/>" input
+        fun map ->
+          function Xml.Element ("define", ["name", name], defn) ->
+            StringMap.add name defn map
+          | _ ->
+              failwithf "%s: expected <define name=name/>" input

       ) StringMap.empty defines in
       let defines = StringMap.mapi parse_rng defines in
 
       ) StringMap.empty defines in
       let defines = StringMap.mapi parse_rng defines in
 


@@ -258,37 +258,37 @@ let generate_types xs =
    * new line (BOL context).
    *)
   let rec generate_type = function
    * new line (BOL context).
    *)
   let rec generate_type = function

-    | Text ->                          (* string *)
-       "string", true
-    | Choice values ->                 (* [`val1|`val2|...] *)
-       "[" ^ String.concat "|" (List.map ((^)"`") values) ^ "]", true
-    | ZeroOrMore rng ->                        (* <rng> list *)
-       let t, is_simple = generate_type rng in
-       t ^ " list (* 0 or more *)", is_simple
-    | OneOrMore rng ->                 (* <rng> list *)
-       let t, is_simple = generate_type rng in
-       t ^ " list (* 1 or more *)", is_simple
-                                       (* virt-inspector hack: bool *)
+    | Text ->                                (* string *)
+        "string", true
+    | Choice values ->                        (* [`val1|`val2|...] *)
+        "[" ^ String.concat "|" (List.map ((^)"`") values) ^ "]", true
+    | ZeroOrMore rng ->                        (* <rng> list *)
+        let t, is_simple = generate_type rng in
+        t ^ " list (* 0 or more *)", is_simple
+    | OneOrMore rng ->                        (* <rng> list *)
+        let t, is_simple = generate_type rng in
+        t ^ " list (* 1 or more *)", is_simple
+                                        (* virt-inspector hack: bool *)

     | Optional (Attribute (name, [Value "1"])) ->
     | Optional (Attribute (name, [Value "1"])) ->

-       "bool", true
-    | Optional rng ->                  (* <rng> list *)
-       let t, is_simple = generate_type rng in
-       t ^ " option", is_simple
+        "bool", true
+    | Optional rng ->                        (* <rng> list *)
+        let t, is_simple = generate_type rng in
+        t ^ " option", is_simple

                                         (* type name = { fields ... } *)
     | Element (name, fields) when is_attrs_interleave fields ->
                                         (* type name = { fields ... } *)
     | Element (name, fields) when is_attrs_interleave fields ->

-       generate_type_struct name (get_attrs_interleave fields)
-    | Element (name, [field])          (* type name = field *)
+        generate_type_struct name (get_attrs_interleave fields)
+    | Element (name, [field])                (* type name = field *)

     | Attribute (name, [field]) ->
     | Attribute (name, [field]) ->

-       let t, is_simple = generate_type field in
-       if is_simple then (t, true)
-       else (
-         pr "type %s = %s\n" name t;
-         name, false
-       )
-    | Element (name, fields) ->              (* type name = { fields ... } *)
-       generate_type_struct name fields
+        let t, is_simple = generate_type field in
+        if is_simple then (t, true)
+        else (
+          pr "type %s = %s\n" name t;
+          name, false
+        )
+    | Element (name, fields) ->              (* type name = { fields ... } *)
+        generate_type_struct name fields

     | rng ->
     | rng ->

-       failwithf "generate_type failed at: %s" (string_of_rng rng)
+        failwithf "generate_type failed at: %s" (string_of_rng rng)

 
   and is_attrs_interleave = function
     | [Interleave _] -> true
 
   and is_attrs_interleave = function
     | [Interleave _] -> true


@@ -300,7 +300,7 @@ let generate_types xs =
     | [Interleave fields] -> fields
     | ((Attribute _) as field) :: fields
     | ((Optional (Attribute _)) as field) :: fields ->
     | [Interleave fields] -> fields
     | ((Attribute _) as field) :: fields
     | ((Optional (Attribute _)) as field) :: fields ->

-       field :: get_attrs_interleave fields
+        field :: get_attrs_interleave fields

     | _ -> assert false
 
   and generate_types xs =
     | _ -> assert false
 
   and generate_types xs =


@@ -317,25 +317,25 @@ let generate_types xs =
      *)
     match types with
     | ["string"; other] ->
      *)
     match types with
     | ["string"; other] ->

-       let fname1, fname2 =
-         match fields with
-         | [f1; f2] -> name_of_field f1, name_of_field f2
-         | _ -> assert false in
-       pr "type %s = string * %s (* %s -> %s *)\n" name other fname1 fname2;
-       name, false
+        let fname1, fname2 =
+          match fields with
+          | [f1; f2] -> name_of_field f1, name_of_field f2
+          | _ -> assert false in
+        pr "type %s = string * %s (* %s -> %s *)\n" name other fname1 fname2;
+        name, false

 
     | types ->
 
     | types ->

-       pr "type %s = {\n" name;
-       List.iter (
-         fun (field, ftype) ->
-           let fname = name_of_field field in
-           pr "  %s_%s : %s;\n" name fname ftype
-       ) (List.combine fields types);
-       pr "}\n";
-       (* Return the name of this type, and
-        * false because it's not a simple type.
-        *)
-       name, false
+        pr "type %s = {\n" name;
+        List.iter (
+          fun (field, ftype) ->
+            let fname = name_of_field field in
+            pr "  %s_%s : %s;\n" name fname ftype
+        ) (List.combine fields types);
+        pr "}\n";
+        (* Return the name of this type, and
+         * false because it's not a simple type.
+         *)
+        name, false

   in
 
   generate_types xs
   in
 
   generate_types xs


@@ -347,45 +347,45 @@ let generate_parsers xs =
    * called in BOL context.
    *)
   let rec generate_parser = function
    * called in BOL context.
    *)
   let rec generate_parser = function

-    | Text ->                          (* string *)
-       "string_child_or_empty"
-    | Choice values ->                 (* [`val1|`val2|...] *)
-       sprintf "(fun x -> match Xml.pcdata (first_child x) with %s | str -> failwith (\"unexpected field value: \" ^ str))"
-         (String.concat "|"
-            (List.map (fun v -> sprintf "%S -> `%s" v v) values))
-    | ZeroOrMore rng ->                        (* <rng> list *)
-       let pa = generate_parser rng in
-       sprintf "(fun x -> List.map %s (Xml.children x))" pa
-    | OneOrMore rng ->                 (* <rng> list *)
-       let pa = generate_parser rng in
-       sprintf "(fun x -> List.map %s (Xml.children x))" pa
-                                       (* virt-inspector hack: bool *)
+    | Text ->                                (* string *)
+        "string_child_or_empty"
+    | Choice values ->                        (* [`val1|`val2|...] *)
+        sprintf "(fun x -> match Xml.pcdata (first_child x) with %s | str -> failwith (\"unexpected field value: \" ^ str))"
+          (String.concat "|"
+             (List.map (fun v -> sprintf "%S -> `%s" v v) values))
+    | ZeroOrMore rng ->                        (* <rng> list *)
+        let pa = generate_parser rng in
+        sprintf "(fun x -> List.map %s (Xml.children x))" pa
+    | OneOrMore rng ->                        (* <rng> list *)
+        let pa = generate_parser rng in
+        sprintf "(fun x -> List.map %s (Xml.children x))" pa
+                                        (* virt-inspector hack: bool *)

     | Optional (Attribute (name, [Value "1"])) ->
     | Optional (Attribute (name, [Value "1"])) ->

-       sprintf "(fun x -> try ignore (Xml.attrib x %S); true with Xml.No_attribute _ -> false)" name
-    | Optional rng ->                  (* <rng> list *)
-       let pa = generate_parser rng in
-       sprintf "(function None -> None | Some x -> Some (%s x))" pa
+        sprintf "(fun x -> try ignore (Xml.attrib x %S); true with Xml.No_attribute _ -> false)" name
+    | Optional rng ->                        (* <rng> list *)
+        let pa = generate_parser rng in
+        sprintf "(function None -> None | Some x -> Some (%s x))" pa

                                         (* type name = { fields ... } *)
     | Element (name, fields) when is_attrs_interleave fields ->
                                         (* type name = { fields ... } *)
     | Element (name, fields) when is_attrs_interleave fields ->

-       generate_parser_struct name (get_attrs_interleave fields)
-    | Element (name, [field]) ->       (* type name = field *)
-       let pa = generate_parser field in
-       let parser_name = sprintf "parse_%s_%d" name (unique ()) in
-       pr "let %s =\n" parser_name;
-       pr "  %s\n" pa;
-       pr "let parse_%s = %s\n" name parser_name;
-       parser_name
+        generate_parser_struct name (get_attrs_interleave fields)
+    | Element (name, [field]) ->        (* type name = field *)
+        let pa = generate_parser field in
+        let parser_name = sprintf "parse_%s_%d" name (unique ()) in
+        pr "let %s =\n" parser_name;
+        pr "  %s\n" pa;
+        pr "let parse_%s = %s\n" name parser_name;
+        parser_name

     | Attribute (name, [field]) ->
     | Attribute (name, [field]) ->

-       let pa = generate_parser field in
-       let parser_name = sprintf "parse_%s_%d" name (unique ()) in
-       pr "let %s =\n" parser_name;
-       pr "  %s\n" pa;
-       pr "let parse_%s = %s\n" name parser_name;
-       parser_name
-    | Element (name, fields) ->              (* type name = { fields ... } *)
-       generate_parser_struct name ([], fields)
+        let pa = generate_parser field in
+        let parser_name = sprintf "parse_%s_%d" name (unique ()) in
+        pr "let %s =\n" parser_name;
+        pr "  %s\n" pa;
+        pr "let parse_%s = %s\n" name parser_name;
+        parser_name
+    | Element (name, fields) ->              (* type name = { fields ... } *)
+        generate_parser_struct name ([], fields)

     | rng ->
     | rng ->

-       failwithf "generate_parser failed at: %s" (string_of_rng rng)
+        failwithf "generate_parser failed at: %s" (string_of_rng rng)

 
   and is_attrs_interleave = function
     | [Interleave _] -> true
 
   and is_attrs_interleave = function
     | [Interleave _] -> true


@@ -397,8 +397,8 @@ let generate_parsers xs =
     | [Interleave fields] -> [], fields
     | ((Attribute _) as field) :: fields
     | ((Optional (Attribute _)) as field) :: fields ->
     | [Interleave fields] -> [], fields
     | ((Attribute _) as field) :: fields
     | ((Optional (Attribute _)) as field) :: fields ->

-       let attrs, interleaves = get_attrs_interleave fields in
-       (field :: attrs), interleaves
+        let attrs, interleaves = get_attrs_interleave fields in
+        (field :: attrs), interleaves

     | _ -> assert false
 
   and generate_parsers xs =
     | _ -> assert false
 
   and generate_parsers xs =


@@ -424,48 +424,48 @@ let generate_parsers xs =
     let comma = ref false in
     List.iter (
       fun x ->
     let comma = ref false in
     List.iter (
       fun x ->

-       if !comma then pr ",\n    ";
-       comma := true;
-       match x with
-       | Optional (Attribute (fname, [field])), pa ->
-           pr "%s x" pa
-       | Optional (Element (fname, [field])), pa ->
-           pr "%s (optional_child %S x)" pa fname
-       | Attribute (fname, [Text]), _ ->
-           pr "attribute %S x" fname
-       | (ZeroOrMore _ | OneOrMore _), pa ->
-           pr "%s x" pa
-       | Text, pa ->
-           pr "%s x" pa
-       | (field, pa) ->
-           let fname = name_of_field field in
-           pr "%s (child %S x)" pa fname
+        if !comma then pr ",\n    ";
+        comma := true;
+        match x with
+        | Optional (Attribute (fname, [field])), pa ->
+            pr "%s x" pa
+        | Optional (Element (fname, [field])), pa ->
+            pr "%s (optional_child %S x)" pa fname
+        | Attribute (fname, [Text]), _ ->
+            pr "attribute %S x" fname
+        | (ZeroOrMore _ | OneOrMore _), pa ->
+            pr "%s x" pa
+        | Text, pa ->
+            pr "%s x" pa
+        | (field, pa) ->
+            let fname = name_of_field field in
+            pr "%s (child %S x)" pa fname

     ) (List.combine fields pas);
     pr "\n  ) in\n";
 
     (match fields with
      | [Element (_, [Text]) | Attribute (_, [Text]); _] ->
     ) (List.combine fields pas);
     pr "\n  ) in\n";
 
     (match fields with
      | [Element (_, [Text]) | Attribute (_, [Text]); _] ->

-        pr "  t\n"
+         pr "  t\n"

 
      | _ ->
 
      | _ ->

-        pr "  (Obj.magic t : %s)\n" name
+         pr "  (Obj.magic t : %s)\n" name

 (*
 (*

-        List.iter (
-          function
-          | (Optional (Attribute (fname, [field])), pa) ->
-              pr "  %s_%s =\n" name fname;
-              pr "    %s x;\n" pa
-          | (Optional (Element (fname, [field])), pa) ->
-              pr "  %s_%s =\n" name fname;
-              pr "    (let x = optional_child %S x in\n" fname;
-              pr "     %s x);\n" pa
-          | (field, pa) ->
-              let fname = name_of_field field in
-              pr "  %s_%s =\n" name fname;
-              pr "    (let x = child %S x in\n" fname;
-              pr "     %s x);\n" pa
-        ) (List.combine fields pas);
-        pr "}\n"
+         List.iter (
+           function
+           | (Optional (Attribute (fname, [field])), pa) ->
+               pr "  %s_%s =\n" name fname;
+               pr "    %s x;\n" pa
+           | (Optional (Element (fname, [field])), pa) ->
+               pr "  %s_%s =\n" name fname;
+               pr "    (let x = optional_child %S x in\n" fname;
+               pr "     %s x);\n" pa
+           | (field, pa) ->
+               let fname = name_of_field field in
+               pr "  %s_%s =\n" name fname;
+               pr "    (let x = child %S x in\n" fname;
+               pr "     %s x);\n" pa
+         ) (List.combine fields pas);
+         pr "}\n"

 *)
     );
     sprintf "parse_%s" name
 *)
     );
     sprintf "parse_%s" name


@@ -612,7 +612,7 @@ let output_to filename =
 
     (* Is the new file different from the current file? *)
     if Sys.file_exists filename && files_equal filename filename_new then
 
     (* Is the new file different from the current file? *)
     if Sys.file_exists filename && files_equal filename filename_new then

-      Unix.unlink filename_new         (* same, so skip it *)
+      Unix.unlink filename_new                (* same, so skip it *)

     else (
       (* different, overwrite old one *)
       (try Unix.chmod filename 0o644 with Unix.Unix_error _ -> ());
     else (
       (* different, overwrite old one *)
       (try Unix.chmod filename 0o644 with Unix.Unix_error _ -> ());

diff --git a/inspector/virt-inspector b/inspector/virt-inspector
index 13673af..071f0b0 100755 (executable)
--- a/inspector/virt-inspector
+++ b/inspector/virt-inspector
@@ -550,23 +550,23 @@ sub output_xml_os
     }
 
     if ($os->{kernels}) {
     }
 
     if ($os->{kernels}) {

-       $xml->startTag("kernels");
-       my @kernels = @{$os->{kernels}};
-       foreach (@kernels) {
-           $xml->startTag("kernel",
-                          "version" => $_->{version},
-                          "arch" => $_->{arch});
-           $xml->startTag("modules");
-           my @modules = @{$_->{modules}};
-           foreach (@modules) {
-               $xml->dataElement("module", $_);
-           }
-           $xml->endTag("modules");
-           $xml->dataElement("path", $_->{path}) if(defined($_->{path}));
-           $xml->dataElement("package", $_->{package}) if(defined($_->{package}));
-           $xml->endTag("kernel");
-       }
-       $xml->endTag("kernels");
+        $xml->startTag("kernels");
+        my @kernels = @{$os->{kernels}};
+        foreach (@kernels) {
+            $xml->startTag("kernel",
+                           "version" => $_->{version},
+                           "arch" => $_->{arch});
+            $xml->startTag("modules");
+            my @modules = @{$_->{modules}};
+            foreach (@modules) {
+                $xml->dataElement("module", $_);
+            }
+            $xml->endTag("modules");
+            $xml->dataElement("path", $_->{path}) if(defined($_->{path}));
+            $xml->dataElement("package", $_->{package}) if(defined($_->{package}));
+            $xml->endTag("kernel");
+        }
+        $xml->endTag("kernels");

     }
 
     if (exists $os->{root}->{registry}) {
     }
 
     if (exists $os->{root}->{registry}) {

diff --git a/inspector/virt-inspector.rng b/inspector/virt-inspector.rng
index 1da58fc..c8f6075 100644 (file)
--- a/inspector/virt-inspector.rng
+++ b/inspector/virt-inspector.rng
@@ -20,36 +20,36 @@
   <start>
     <element name="operatingsystems">
       <oneOrMore>
   <start>
     <element name="operatingsystems">
       <oneOrMore>

-       <element name="operatingsystem">
-         <interleave>
-
-           <!-- required fields for an operating system -->
-           <element name="name">
-             <choice>
-               <value>linux</value>
-               <value>windows</value>
-             </choice>
-           </element>
-           <element name="arch"><text/></element>
-           <element name="root"><text/></element>
-
-           <!-- optional fields for an operating system -->
-           <optional><element name="distro"><text/></element></optional>
-           <optional><element name="major_version"><text/></element></optional>
-           <optional><element name="minor_version"><text/></element></optional>
-           <optional><element name="package_format"><text/></element></optional>
-           <optional><element name="package_management"><text/></element></optional>
-
-           <ref name="mountpoints"/>
-           <ref name="filesystems"/>
-           <optional><ref name="applications"/></optional>
-           <optional><ref name="modprobealiases"/></optional>
-           <optional><ref name="initrds"/></optional>
-           <optional><ref name="kernels"/></optional>
-           <optional><ref name="boot"/></optional>
-
-         </interleave>
-       </element>
+        <element name="operatingsystem">
+          <interleave>
+
+            <!-- required fields for an operating system -->
+            <element name="name">
+              <choice>
+                <value>linux</value>
+                <value>windows</value>
+              </choice>
+            </element>
+            <element name="arch"><text/></element>
+            <element name="root"><text/></element>
+
+            <!-- optional fields for an operating system -->
+            <optional><element name="distro"><text/></element></optional>
+            <optional><element name="major_version"><text/></element></optional>
+            <optional><element name="minor_version"><text/></element></optional>
+            <optional><element name="package_format"><text/></element></optional>
+            <optional><element name="package_management"><text/></element></optional>
+
+            <ref name="mountpoints"/>
+            <ref name="filesystems"/>
+            <optional><ref name="applications"/></optional>
+            <optional><ref name="modprobealiases"/></optional>
+            <optional><ref name="initrds"/></optional>
+            <optional><ref name="kernels"/></optional>
+            <optional><ref name="boot"/></optional>
+
+          </interleave>
+        </element>

       </oneOrMore>
     </element>
   </start>
       </oneOrMore>
     </element>
   </start>


@@ -58,10 +58,10 @@
   <define name="mountpoints">
     <element name="mountpoints">
       <oneOrMore>
   <define name="mountpoints">
     <element name="mountpoints">
       <oneOrMore>

-       <element name="mountpoint">
-         <attribute name="dev"><text/></attribute>
-         <text/>
-       </element>
+        <element name="mountpoint">
+          <attribute name="dev"><text/></attribute>
+          <text/>
+        </element>

       </oneOrMore>
     </element>
   </define>
       </oneOrMore>
     </element>
   </define>


@@ -70,16 +70,16 @@
   <define name="filesystems">
     <element name="filesystems">
       <oneOrMore>
   <define name="filesystems">
     <element name="filesystems">
       <oneOrMore>

-       <element name="filesystem">
-         <attribute name="dev"><text/></attribute>
-         <interleave>
-           <element name="type"><text/></element>
-           <optional><element name="content"><text/></element></optional>
-           <optional><element name="label"><text/></element></optional>
-           <optional><element name="uuid"><text/></element></optional>
-           <optional><element name="spec"><text/></element></optional>
-         </interleave>
-       </element>
+        <element name="filesystem">
+          <attribute name="dev"><text/></attribute>
+          <interleave>
+            <element name="type"><text/></element>
+            <optional><element name="content"><text/></element></optional>
+            <optional><element name="label"><text/></element></optional>
+            <optional><element name="uuid"><text/></element></optional>
+            <optional><element name="spec"><text/></element></optional>
+          </interleave>
+        </element>

       </oneOrMore>
     </element>
   </define>
       </oneOrMore>
     </element>
   </define>


@@ -88,10 +88,10 @@
   <define name="applications">
     <element name="applications">
       <zeroOrMore>
   <define name="applications">
     <element name="applications">
       <zeroOrMore>

-       <element name="application">
-         <element name="name"><text/></element>
-         <element name="version"><text/></element>
-       </element>
+        <element name="application">
+          <element name="name"><text/></element>
+          <element name="version"><text/></element>
+        </element>

       </zeroOrMore>
     </element>
   </define>
       </zeroOrMore>
     </element>
   </define>


@@ -100,14 +100,14 @@
   <define name="modprobealiases">
     <element name="modprobealiases">
       <zeroOrMore>
   <define name="modprobealiases">
     <element name="modprobealiases">
       <zeroOrMore>

-       <element name="alias">
-         <attribute name="device"><text/></attribute>
-         <interleave>
-           <element name="modulename"><text/></element>
-           <optional><element name="augeas"><text/></element></optional>
-           <element name="file"><text/></element>
-         </interleave>
-       </element>
+        <element name="alias">
+          <attribute name="device"><text/></attribute>
+          <interleave>
+            <element name="modulename"><text/></element>
+            <optional><element name="augeas"><text/></element></optional>
+            <element name="file"><text/></element>
+          </interleave>
+        </element>

       </zeroOrMore>
     </element>
   </define>
       </zeroOrMore>
     </element>
   </define>


@@ -116,12 +116,12 @@
   <define name="initrds">
     <element name="initrds">
       <zeroOrMore>
   <define name="initrds">
     <element name="initrds">
       <zeroOrMore>

-       <element name="initrd">
-         <attribute name="version"><text/></attribute>
-         <zeroOrMore>
-           <element name="module"><text/></element>
-         </zeroOrMore>
-       </element>
+        <element name="initrd">
+          <attribute name="version"><text/></attribute>
+          <zeroOrMore>
+            <element name="module"><text/></element>
+          </zeroOrMore>
+        </element>

       </zeroOrMore>
     </element>
   </define>
       </zeroOrMore>
     </element>
   </define>


@@ -130,16 +130,16 @@
   <define name="boot">
     <element name="boot">
       <zeroOrMore>
   <define name="boot">
     <element name="boot">
       <zeroOrMore>

-       <element name="config">
-         <optional>
-           <attribute name="default"><value>1</value></attribute>
-         </optional>
-         <interleave>
-           <element name="title"><text/></element>
-           <element name="kernel"><text/></element>
-           <element name="cmdline"><text/></element>
-         </interleave>
-       </element>
+        <element name="config">
+          <optional>
+            <attribute name="default"><value>1</value></attribute>
+          </optional>
+          <interleave>
+            <element name="title"><text/></element>
+            <element name="kernel"><text/></element>
+            <element name="cmdline"><text/></element>
+          </interleave>
+        </element>

       </zeroOrMore>
     </element>
   </define>
       </zeroOrMore>
     </element>
   </define>


@@ -148,19 +148,19 @@
   <define name="kernels">
     <element name="kernels">
       <zeroOrMore>
   <define name="kernels">
     <element name="kernels">
       <zeroOrMore>

-       <element name="kernel">
-         <attribute name="version"><text/></attribute>
-         <attribute name="arch"><text/></attribute>
-         <interleave>
-           <element name="modules">
-             <zeroOrMore>
-               <element name="module"><text/></element>
-             </zeroOrMore>
-           </element>
-           <optional><element name="path"><text/></element></optional>
-           <optional><element name="package"><text/></element></optional>
-         </interleave>
-       </element>
+        <element name="kernel">
+          <attribute name="version"><text/></attribute>
+          <attribute name="arch"><text/></attribute>
+          <interleave>
+            <element name="modules">
+              <zeroOrMore>
+                <element name="module"><text/></element>
+              </zeroOrMore>
+            </element>
+            <optional><element name="path"><text/></element></optional>
+            <optional><element name="package"><text/></element></optional>
+          </interleave>
+        </element>

       </zeroOrMore>
     </element>
   </define>
       </zeroOrMore>
     </element>
   </define>

diff --git a/ocaml/examples/viewer.ml b/ocaml/examples/viewer.ml
index eeff525..6cd465a 100644 (file)
--- a/ocaml/examples/viewer.ml
+++ b/ocaml/examples/viewer.ml
@@ -63,7 +63,7 @@ module G = Guestfs
 module M = Mutex
 module Q = Queue
 
 module M = Mutex
 module Q = Queue
 

-let verbose = ref false                       (* Verbose mode. *)
+let verbose = ref false                       (* Verbose mode. *)

 
 let debug fs =
   let f str = if !verbose then ( prerr_string str; prerr_newline () ) in
 
 let debug fs =
   let f str = if !verbose then ( prerr_string str; prerr_newline () ) in


@@ -78,9 +78,9 @@ module Slave : sig
   type 'a callback = 'a -> unit
 
   type partinfo = {
   type 'a callback = 'a -> unit
 
   type partinfo = {

-    pt_name : string;          (** device / LV name *)
-    pt_size : int64;           (** in bytes *)
-    pt_content : string;       (** the output of the 'file' command *)
+    pt_name : string;                (** device / LV name *)
+    pt_size : int64;                (** in bytes *)
+    pt_content : string;        (** the output of the 'file' command *)

     pt_statvfs : G.statvfs option; (** None if not mountable *)
   }
 
     pt_statvfs : G.statvfs option; (** None if not mountable *)
   }
 


@@ -89,33 +89,33 @@ module Slave : sig
 
   val set_failure_callback : exn callback -> unit
     (** Set the function that is called in the main thread whenever
 
   val set_failure_callback : exn callback -> unit
     (** Set the function that is called in the main thread whenever

-       there is a command failure in the slave.  The command queue
-       is cleared before this is sent.  [exn] is the exception
-       associated with the failure. *)
+        there is a command failure in the slave.  The command queue
+        is cleared before this is sent.  [exn] is the exception
+        associated with the failure. *)

 
   val set_busy_callback : [`Busy|`Idle] callback -> unit
     (** Set the function that is called in the main thread whenever
 
   val set_busy_callback : [`Busy|`Idle] callback -> unit
     (** Set the function that is called in the main thread whenever

-       the slave thread goes busy or idle. *)
+        the slave thread goes busy or idle. *)

 
   val exit_thread : unit -> unit
     (** [exit_thread ()] causes the slave thread to exit. *)
 
   val connect : string option -> string option callback -> unit
     (** [connect uri cb] connects to libvirt [uri], and calls [cb]
 
   val exit_thread : unit -> unit
     (** [exit_thread ()] causes the slave thread to exit. *)
 
   val connect : string option -> string option callback -> unit
     (** [connect uri cb] connects to libvirt [uri], and calls [cb]

-       if it completes successfully.  Any previous connection is
-       automatically cleaned up and disconnected. *)
+        if it completes successfully.  Any previous connection is
+        automatically cleaned up and disconnected. *)

 
   val get_domains : string list callback -> unit
     (** [get_domains cb] gets the list of active domains from libvirt,
 
   val get_domains : string list callback -> unit
     (** [get_domains cb] gets the list of active domains from libvirt,

-       and calls [cb domains] with the names of those domains. *)
+        and calls [cb domains] with the names of those domains. *)

 
   val open_domain : string -> partinfo list callback -> unit
     (** [open_domain dom cb] sets the domain [dom] as the current
 
   val open_domain : string -> partinfo list callback -> unit
     (** [open_domain dom cb] sets the domain [dom] as the current

-       domain, and launches a libguestfs handle for it.  Any previously
-       current domain and libguestfs handle is closed.  Once the
-       libguestfs handle is opened (which usually takes some time),
-       callback [cb] is called with the list of partitions found
-       in the guest. *)
+        domain, and launches a libguestfs handle for it.  Any previously
+        current domain and libguestfs handle is closed.  Once the
+        libguestfs handle is opened (which usually takes some time),
+        callback [cb] is called with the list of partitions found
+        in the guest. *)

 
   val slave_loop : unit -> unit
     (** The slave thread's main loop, running in the slave thread. *)
 
   val slave_loop : unit -> unit
     (** The slave thread's main loop, running in the slave thread. *)


@@ -168,7 +168,7 @@ end = struct
     | Either r -> r
     | Or exn -> raise exn
 
     | Either r -> r
     | Or exn -> raise exn
 

-  let q = Q.create ()                  (* queue of commands *)
+  let q = Q.create ()                        (* queue of commands *)

   let q_lock = M.create ()
   let q_cond = Cd.create ()
 
   let q_lock = M.create ()
   let q_cond = Cd.create ()
 


@@ -177,8 +177,8 @@ end = struct
     debug "sending to slave: %s" (string_of_command c);
     with_lock q_lock (
       fun () ->
     debug "sending to slave: %s" (string_of_command c);
     with_lock q_lock (
       fun () ->

-       Q.push c q;
-       Cd.signal q_cond
+        Q.push c q;
+        Cd.signal q_cond

     )
 
   let exit_thread () =
     )
 
   let exit_thread () =


@@ -198,9 +198,9 @@ end = struct
    * any references to these objects to escape from the slave
    * thread.
    *)
    * any references to these objects to escape from the slave
    * thread.
    *)

-  let conn = ref None                  (* libvirt connection *)
-  let dom = ref None                   (* libvirt domain *)
-  let g = ref None                     (* libguestfs handle *)
+  let conn = ref None                        (* libvirt connection *)
+  let dom = ref None                        (* libvirt domain *)
+  let g = ref None                        (* libguestfs handle *)

 
   let quit = ref false
 
 
   let quit = ref false
 


@@ -208,11 +208,11 @@ end = struct
     debug "Slave.slave_loop: waiting for a command";
     let c =
       with_lock q_lock (
     debug "Slave.slave_loop: waiting for a command";
     let c =
       with_lock q_lock (

-       fun () ->
-         while Q.is_empty q do
-           Cd.wait q_cond q_lock
-         done;
-         Q.pop q
+        fun () ->
+          while Q.is_empty q do
+            Cd.wait q_cond q_lock
+          done;
+          Q.pop q

       ) in
 
     (try
       ) in
 
     (try


@@ -223,9 +223,9 @@ end = struct
        debug "Slave.slave_loop: command succeeded";
      with exn ->
        (* If an exception is thrown, it means the command failed.  In
        debug "Slave.slave_loop: command succeeded";
      with exn ->
        (* If an exception is thrown, it means the command failed.  In

-       * this case we clear the command queue and deliver the failure
-       * callback in the main thread.
-       *)
+        * this case we clear the command queue and deliver the failure
+        * callback in the main thread.
+        *)

        debug "Slave.slave_loop: command failed";
 
        !busy_cb `Idle;
        debug "Slave.slave_loop: command failed";
 
        !busy_cb `Idle;


@@ -238,69 +238,69 @@ end = struct
 
   and exec_command = function
     | Exit_thread ->
 
   and exec_command = function
     | Exit_thread ->

-       quit := true; (* quit first in case disconnect_all throws an exn *)
-       disconnect_all ()
+        quit := true; (* quit first in case disconnect_all throws an exn *)
+        disconnect_all ()

 
     | Connect (name, cb) ->
 
     | Connect (name, cb) ->

-       disconnect_all ();
-       conn := Some (C.connect_readonly ?name ());
-       cb name
+        disconnect_all ();
+        conn := Some (C.connect_readonly ?name ());
+        cb name

 
     | Get_domains cb ->
 
     | Get_domains cb ->

-       let conn = Option.get !conn in
-       let doms = D.get_domains conn [D.ListAll] in
-       (* Only return the names, so that the libvirt objects
-        * aren't leaked outside the slave thread.
-        *)
-       let doms = List.map D.get_name doms in
-       cb doms
+        let conn = Option.get !conn in
+        let doms = D.get_domains conn [D.ListAll] in
+        (* Only return the names, so that the libvirt objects
+         * aren't leaked outside the slave thread.
+         *)
+        let doms = List.map D.get_name doms in
+        cb doms

 
     | Open_domain (domname, cb) ->
 
     | Open_domain (domname, cb) ->

-       let conn = Option.get !conn in
-       disconnect_dom ();
-       dom := Some (D.lookup_by_name conn domname);
-       let dom = Option.get !dom in
-
-       (* Get the devices. *)
-       let xml = D.get_xml_desc dom in
-       let devs = get_devices_from_xml xml in
-
-       (* Create the libguestfs handle and launch it. *)
-       let g' = G.create () in
-       List.iter (G.add_drive_ro g') devs;
-       G.launch g';
-       g := Some g';
-
-       (* Get the list of partitions. *)
-       let parts = Array.to_list (G.list_partitions g') in
-       (* Remove any which are PVs. *)
-       let pvs = Array.to_list (G.pvs g') in
-       let parts = List.filter (fun part -> not (List.mem part pvs)) parts in
-       let lvs = Array.to_list (G.lvs g') in
-       let parts = parts @ lvs in
-
-       let parts = List.map (
-         fun part ->
-           (* Find out the size of each partition. *)
-           let size = G.blockdev_getsize64 g' part in
-
-           (* Find out what's on each partition. *)
-           let content = G.file g' part in
-
-           (* Try to mount it. *)
-           let statvfs =
-             try
-               G.mount_ro g' part "/";
-               Some (G.statvfs g' "/")
-             with _ -> None in
-           G.umount_all g';
-
-           { pt_name = part; pt_size = size; pt_content = content;
-             pt_statvfs = statvfs }
-       ) parts in
-
-       (* Call the callback. *)
-       cb parts
+        let conn = Option.get !conn in
+        disconnect_dom ();
+        dom := Some (D.lookup_by_name conn domname);
+        let dom = Option.get !dom in
+
+        (* Get the devices. *)
+        let xml = D.get_xml_desc dom in
+        let devs = get_devices_from_xml xml in
+
+        (* Create the libguestfs handle and launch it. *)
+        let g' = G.create () in
+        List.iter (G.add_drive_ro g') devs;
+        G.launch g';
+        g := Some g';
+
+        (* Get the list of partitions. *)
+        let parts = Array.to_list (G.list_partitions g') in
+        (* Remove any which are PVs. *)
+        let pvs = Array.to_list (G.pvs g') in
+        let parts = List.filter (fun part -> not (List.mem part pvs)) parts in
+        let lvs = Array.to_list (G.lvs g') in
+        let parts = parts @ lvs in
+
+        let parts = List.map (
+          fun part ->
+            (* Find out the size of each partition. *)
+            let size = G.blockdev_getsize64 g' part in
+
+            (* Find out what's on each partition. *)
+            let content = G.file g' part in
+
+            (* Try to mount it. *)
+            let statvfs =
+              try
+                G.mount_ro g' part "/";
+                Some (G.statvfs g' "/")
+              with _ -> None in
+            G.umount_all g';
+
+            { pt_name = part; pt_size = size; pt_content = content;
+              pt_statvfs = statvfs }
+        ) parts in
+
+        (* Call the callback. *)
+        cb parts

 
   (* Close all libvirt/libguestfs handles. *)
   and disconnect_all () =
 
   (* Close all libvirt/libguestfs handles. *)
   and disconnect_all () =


@@ -323,7 +323,7 @@ end = struct
     let xs = {{ [xml] }} in
     let xs = {{ (((xs.(<domain..>_)) / .(<devices..>_)) / .(<disk..>_)) / }} in
     let xs = {{ map xs with
     let xs = {{ [xml] }} in
     let xs = {{ (((xs.(<domain..>_)) / .(<devices..>_)) / .(<disk..>_)) / }} in
     let xs = {{ map xs with

-               | <source dev=(Latin1 & s) ..>_
+                | <source dev=(Latin1 & s) ..>_

                 | <source file=(Latin1 & s) ..>_ -> [s]
                 | _ -> [] }} in
     {: xs :}
                 | <source file=(Latin1 & s) ..>_ -> [s]
                 | _ -> [] }} in
     {: xs :}


@@ -384,7 +384,7 @@ let main_window opened_domain repaint =
   ignore (window#connect#destroy ~callback:GMain.quit);
   ignore (window#event#connect#delete ~callback:quit);
   ignore (quit_item#connect#activate
   ignore (window#connect#destroy ~callback:GMain.quit);
   ignore (window#event#connect#delete ~callback:quit);
   ignore (quit_item#connect#activate

-           ~callback:(fun () -> ignore (quit ()); ()));
+            ~callback:(fun () -> ignore (quit ()); ()));

 
   (* Top status area. *)
   let hbox = GPack.hbox ~border_width:4 ~packing:vbox#pack () in
 
   (* Top status area. *)
   let hbox = GPack.hbox ~border_width:4 ~packing:vbox#pack () in


@@ -397,8 +397,8 @@ let main_window opened_domain repaint =
     model#clear ();
     List.iter (
       fun name ->
     model#clear ();
     List.iter (
       fun name ->

-       let row = model#append () in
-       model#set ~row ~column name
+        let row = model#append () in
+        model#set ~row ~column name

     ) names
   in
 
     ) names
   in
 


@@ -409,9 +409,9 @@ let main_window opened_domain repaint =
     GMisc.image ~pixbuf:static ~packing:(hbox#pack ~from:`END) () in
   let throbber_set = function
     | `Busy -> (*throbber#set_pixbuf animation*)
     GMisc.image ~pixbuf:static ~packing:(hbox#pack ~from:`END) () in
   let throbber_set = function
     | `Busy -> (*throbber#set_pixbuf animation*)

-       (* Workaround because no binding for GdkPixbufAnimation: *)
-       let file = Filename.dirname Sys.argv.(0) // "Throbber.gif" in
-       throbber#set_file file
+        (* Workaround because no binding for GdkPixbufAnimation: *)
+        let file = Filename.dirname Sys.argv.(0) // "Throbber.gif" in
+        throbber#set_file file

     | `Idle -> throbber#set_pixbuf static
   in
 
     | `Idle -> throbber#set_pixbuf static
   in
 


@@ -460,13 +460,13 @@ let main_window opened_domain repaint =
     let combo, (model, column) = vmcombo in
     combo#connect#changed
       ~callback:(
     let combo, (model, column) = vmcombo in
     combo#connect#changed
       ~callback:(

-       fun () ->
-         match combo#active_iter with
-         | None -> ()
-         | Some row ->
-             let name = model#get ~row ~column in
-             ds.set_statusbar (sprintf "Opening %s ..." name);
-             Slave.open_domain name (opened_domain ds))
+        fun () ->
+          match combo#active_iter with
+          | None -> ()
+          | Some row ->
+              let name = model#get ~row ~column in
+              ds.set_statusbar (sprintf "Opening %s ..." name);
+              Slave.open_domain name (opened_domain ds))

   );
 
   ignore (da#event#connect#expose ~callback:(repaint ds));
   );
 
   ignore (da#event#connect#expose ~callback:(repaint ds));


@@ -523,8 +523,8 @@ and real_repaint ds parts =
   let parts =
     List.map (
       fun ({ Slave.pt_size = size } as part) ->
   let parts =
     List.map (
       fun ({ Slave.pt_size = size } as part) ->

-       let h = scale *. Int64.to_float size in
-       (h, part)
+        let h = scale *. Int64.to_float size in
+        (h, part)

     ) parts in
 
   (*
     ) parts in
 
   (*


@@ -532,7 +532,7 @@ and real_repaint ds parts =
     eprintf "real_repaint: before borrowing:\n";
     List.iter (
       fun (h, part) ->
     eprintf "real_repaint: before borrowing:\n";
     List.iter (
       fun (h, part) ->

-       eprintf "%s\t%g pix\n" part.Slave.pt_name h
+        eprintf "%s\t%g pix\n" part.Slave.pt_name h

     ) parts
   );
   *)
     ) parts
   );
   *)


@@ -544,34 +544,34 @@ and real_repaint ds parts =
   let rec borrow needed = function
     | [] -> 0., []
     | (h, part) :: parts ->
   let rec borrow needed = function
     | [] -> 0., []
     | (h, part) :: parts ->

-       let spare = h -. min_h in
-       if spare >= needed then (
-         needed, (h -. needed, part) :: parts
-       ) else if spare > 0. then (
-         let needed = needed -. spare in
-         let spare', parts = borrow needed parts in
-         spare +. spare', (h -. spare, part) :: parts
-       ) else (
-         let spare', parts = borrow needed parts in
-         spare', (h, part) :: parts
-       )
+        let spare = h -. min_h in
+        if spare >= needed then (
+          needed, (h -. needed, part) :: parts
+        ) else if spare > 0. then (
+          let needed = needed -. spare in
+          let spare', parts = borrow needed parts in
+          spare +. spare', (h -. spare, part) :: parts
+        ) else (
+          let spare', parts = borrow needed parts in
+          spare', (h, part) :: parts
+        )

   in
   let rec loop = function
     | parts, [] -> List.rev parts
     | prev, ((h, part) :: parts) ->
   in
   let rec loop = function
     | parts, [] -> List.rev parts
     | prev, ((h, part) :: parts) ->

-       let needed = min_h -. h in
-       let h, prev, parts =
-         if needed > 0. then (
-           (* Find some spare height in a succeeding partition(s). *)
-           let spare, parts = borrow needed parts in
-           (* Or if not, in a preceeding partition(s). *)
-           let spare, prev =
-             if spare = 0. then borrow needed prev else spare, prev in
-           h +. spare, prev, parts
-         ) else (
-           h, prev, parts
-         ) in
-       loop (((h, part) :: prev), parts)
+        let needed = min_h -. h in
+        let h, prev, parts =
+          if needed > 0. then (
+            (* Find some spare height in a succeeding partition(s). *)
+            let spare, parts = borrow needed parts in
+            (* Or if not, in a preceeding partition(s). *)
+            let spare, prev =
+              if spare = 0. then borrow needed prev else spare, prev in
+            h +. spare, prev, parts
+          ) else (
+            h, prev, parts
+          ) in
+        loop (((h, part) :: prev), parts)

   in
   let parts = loop ([], parts) in
 
   in
   let parts = loop ([], parts) in
 


@@ -580,7 +580,7 @@ and real_repaint ds parts =
     eprintf "real_repaint: after borrowing:\n";
     List.iter (
       fun (h, part) ->
     eprintf "real_repaint: after borrowing:\n";
     List.iter (
       fun (h, part) ->

-       eprintf "%s\t%g pix\n" part.Slave.pt_name h
+        eprintf "%s\t%g pix\n" part.Slave.pt_name h

     ) parts
   );
   *)
     ) parts
   );
   *)


@@ -589,12 +589,12 @@ and real_repaint ds parts =
   let parts = List.map (
     fun (h, part) ->
       let used =
   let parts = List.map (
     fun (h, part) ->
       let used =

-       match part.Slave.pt_statvfs with
-       | None -> 0.
-       | Some { G.bavail = bavail; blocks = blocks } ->
-           let num = Int64.to_float (Int64.sub blocks bavail) in
-           let denom = Int64.to_float blocks in
-           num /. denom in
+        match part.Slave.pt_statvfs with
+        | None -> 0.
+        | Some { G.bavail = bavail; blocks = blocks } ->
+            let num = Int64.to_float (Int64.sub blocks bavail) in
+            let denom = Int64.to_float blocks in
+            num /. denom in

       (h, used, part)
   ) parts in
 
       (h, used, part)
   ) parts in
 


@@ -602,54 +602,54 @@ and real_repaint ds parts =
   ignore (
     List.fold_left (
       fun y (h, used, part) ->
   ignore (
     List.fold_left (
       fun y (h, used, part) ->

-       (* This partition occupies pixels 8+y .. 8+y+h-1 *)
-       let yb = 8 + int_of_float y
-       and yt = 8 + int_of_float (y +. h) in
-
-       ds.draw#set_foreground `WHITE;
-       ds.draw#rectangle ~x:8 ~y:yb ~width:(width-16) ~height:(yt-yb)
-         ~filled:true ();
-
-       let col =
-         if used < 0.6 then `NAME "grey"
-         else if used < 0.8 then `NAME "pink"
-         else if used < 0.9 then `NAME "hot pink"
-         else `NAME "red" in
-       ds.draw#set_foreground col;
-       let w = int_of_float (used *. (float width -. 16.)) in
-       ds.draw#rectangle ~x:8 ~y:yb ~width:w ~height:(yt-yb) ~filled:true ();
-
-       ds.draw#set_foreground `BLACK;
-       ds.draw#rectangle ~x:8 ~y:yb ~width:(width-16) ~height:(yt-yb) ();
-
-       (* Large text - the device name. *)
-       let txt = ds.pango_large_context#create_layout in
-       Pango.Layout.set_text txt part.Slave.pt_name;
-       let fore = `NAME "dark slate grey" in
-       ds.draw#put_layout ~x:12 ~y:(yb+4) ~fore txt;
-
-       let { Pango.height = txtheight; Pango.width = txtwidth } =
-         Pango.Layout.get_pixel_extent txt in
-
-       (* Small text below - the content. *)
-       let txt = ds.pango_small_context#create_layout in
-       Pango.Layout.set_text txt part.Slave.pt_content;
-       let fore = `BLACK in
-       ds.draw#put_layout ~x:12 ~y:(yb+4+txtheight) ~fore txt;
-
-       (* Small text right - size. *)
-       let size =
-         match part.Slave.pt_statvfs with
-         | None -> printable_size part.Slave.pt_size
-         | Some { G.blocks = blocks; bsize = bsize } ->
-             let bytes = Int64.mul blocks bsize in
-             let pc = 100. *. used in
-             sprintf "%s (%.1f%% used)" (printable_size bytes) pc in
-       let txt = ds.pango_small_context#create_layout in
-       Pango.Layout.set_text txt size;
-       ds.draw#put_layout ~x:(16+txtwidth) ~y:(yb+4) ~fore txt;
-
-       (y +. h)
+        (* This partition occupies pixels 8+y .. 8+y+h-1 *)
+        let yb = 8 + int_of_float y
+        and yt = 8 + int_of_float (y +. h) in
+
+        ds.draw#set_foreground `WHITE;
+        ds.draw#rectangle ~x:8 ~y:yb ~width:(width-16) ~height:(yt-yb)
+          ~filled:true ();
+
+        let col =
+          if used < 0.6 then `NAME "grey"
+          else if used < 0.8 then `NAME "pink"
+          else if used < 0.9 then `NAME "hot pink"
+          else `NAME "red" in
+        ds.draw#set_foreground col;
+        let w = int_of_float (used *. (float width -. 16.)) in
+        ds.draw#rectangle ~x:8 ~y:yb ~width:w ~height:(yt-yb) ~filled:true ();
+
+        ds.draw#set_foreground `BLACK;
+        ds.draw#rectangle ~x:8 ~y:yb ~width:(width-16) ~height:(yt-yb) ();
+
+        (* Large text - the device name. *)
+        let txt = ds.pango_large_context#create_layout in
+        Pango.Layout.set_text txt part.Slave.pt_name;
+        let fore = `NAME "dark slate grey" in
+        ds.draw#put_layout ~x:12 ~y:(yb+4) ~fore txt;
+
+        let { Pango.height = txtheight; Pango.width = txtwidth } =
+          Pango.Layout.get_pixel_extent txt in
+
+        (* Small text below - the content. *)
+        let txt = ds.pango_small_context#create_layout in
+        Pango.Layout.set_text txt part.Slave.pt_content;
+        let fore = `BLACK in
+        ds.draw#put_layout ~x:12 ~y:(yb+4+txtheight) ~fore txt;
+
+        (* Small text right - size. *)
+        let size =
+          match part.Slave.pt_statvfs with
+          | None -> printable_size part.Slave.pt_size
+          | Some { G.blocks = blocks; bsize = bsize } ->
+              let bytes = Int64.mul blocks bsize in
+              let pc = 100. *. used in
+              sprintf "%s (%.1f%% used)" (printable_size bytes) pc in
+        let txt = ds.pango_small_context#create_layout in
+        Pango.Layout.set_text txt size;
+        ds.draw#put_layout ~x:(16+txtwidth) ~y:(yb+4) ~fore txt;
+
+        (y +. h)

     ) 0. parts
   )
 
     ) 0. parts
   )
 


@@ -671,7 +671,7 @@ let argspec = Arg.align [
 
 let anon_fun _ =
   failwith (sprintf "%s: unknown command line argument"
 
 let anon_fun _ =
   failwith (sprintf "%s: unknown command line argument"

-             (Filename.basename Sys.executable_name))
+              (Filename.basename Sys.executable_name))

 
 let usage_msg =
   sprintf "\
 
 let usage_msg =
   sprintf "\

diff --git a/ocaml/examples/xmllight_loader.ml b/ocaml/examples/xmllight_loader.ml
index 46dd77f..6f0c536 100644 (file)
--- a/ocaml/examples/xmllight_loader.ml
+++ b/ocaml/examples/xmllight_loader.ml
@@ -6,9 +6,9 @@ let from_xml ?ns xml =
   let l = make ?ns () in
   let rec aux = function
     | Element (tag, attrs, child) ->
   let l = make ?ns () in
   let rec aux = function
     | Element (tag, attrs, child) ->

-       start_elem l tag attrs; List.iter aux child; end_elem l ()
+        start_elem l tag attrs; List.iter aux child; end_elem l ()

     | PCData s ->
     | PCData s ->

-       text l s in
+        text l s in

   aux xml;
   get l
 
   aux xml;
   get l
 

diff --git a/tools/virt-ls b/tools/virt-ls
index a55f6c3..6ab6021 100755 (executable)
--- a/tools/virt-ls
+++ b/tools/virt-ls
@@ -202,8 +202,8 @@ unless ($mode) {
     my $r;
     my $line;
     while (($r = read (F, $line, 1024)) > 0) {
     my $r;
     my $line;
     while (($r = read (F, $line, 1024)) > 0) {

-       $line =~ tr{\0}{\n};
-       print $line;
+        $line =~ tr{\0}{\n};
+        print $line;

     }
     close F;
 }
     }
     close F;
 }