g-regist.ads, [...] (Set_Value): new parameter Expand...

2007-12-06  Vasiliy Fofanov  <fofanov@adacore.com>

	* g-regist.ads, g-regist.adb (Set_Value): new parameter Expand; when
	set to True this procedure will create the value of type REG_EXPAND_SZ.
	It was only possible to create REG_SZ values before.

From-SVN: r130842

gcc/ada/g-regist.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---           Copyright (C) 2001-2005, Free Software Foundation, Inc.        --
+--           Copyright (C) 2001-2007, Free Software Foundation, Inc.        --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -154,7 +154,6 @@ package body GNAT.Registry is
 
    procedure Check_Result (Result : LONG; Message : String) is
       use type LONG;
-
    begin
       if Result /= ERROR_SUCCESS then
          Exceptions.Raise_Exception
@@ -169,7 +168,6 @@ package body GNAT.Registry is
 
    procedure Close_Key (Key : HKEY) is
       Result : LONG;
-
    begin
       Result := RegCloseKey (Key);
       Check_Result (Result, "Close_Key");
@@ -198,16 +196,17 @@ package body GNAT.Registry is
       Dispos  : aliased DWORD;
 
    begin
-      Result := RegCreateKeyEx
-        (From_Key,
-         C_Sub_Key (C_Sub_Key'First)'Address,
-         0,
-         C_Class (C_Class'First)'Address,
-         REG_OPTION_NON_VOLATILE,
-         C_Mode,
-         Null_Address,
-         New_Key'Unchecked_Access,
-         Dispos'Unchecked_Access);
+      Result :=
+        RegCreateKeyEx
+          (From_Key,
+           C_Sub_Key (C_Sub_Key'First)'Address,
+           0,
+           C_Class (C_Class'First)'Address,
+           REG_OPTION_NON_VOLATILE,
+           C_Mode,
+           Null_Address,
+           New_Key'Unchecked_Access,
+           Dispos'Unchecked_Access);
 
       Check_Result (Result, "Create_Key " & Sub_Key);
       return New_Key;
@@ -220,7 +219,6 @@ package body GNAT.Registry is
    procedure Delete_Key (From_Key : HKEY; Sub_Key : String) is
       C_Sub_Key : constant String := Sub_Key & ASCII.Nul;
       Result    : LONG;
-
    begin
       Result := RegDeleteKey (From_Key, C_Sub_Key (C_Sub_Key'First)'Address);
       Check_Result (Result, "Delete_Key " & Sub_Key);
@@ -233,7 +231,6 @@ package body GNAT.Registry is
    procedure Delete_Value (From_Key : HKEY; Sub_Key : String) is
       C_Sub_Key : constant String := Sub_Key & ASCII.Nul;
       Result    : LONG;
-
    begin
       Result := RegDeleteValue (From_Key, C_Sub_Key (C_Sub_Key'First)'Address);
       Check_Result (Result, "Delete_Value " & Sub_Key);
@@ -271,32 +268,35 @@ package body GNAT.Registry is
          Size_Sub_Key := Sub_Key'Length;
          Size_Value   := Value'Length;
 
-         Result := RegEnumValue
-           (From_Key, Index,
-            Sub_Key (1)'Address,
-            Size_Sub_Key'Unchecked_Access,
-            null,
-            Type_Sub_Key'Unchecked_Access,
-            Value (1)'Address,
-            Size_Value'Unchecked_Access);
+         Result :=
+           RegEnumValue
+             (From_Key, Index,
+              Sub_Key (1)'Address,
+              Size_Sub_Key'Unchecked_Access,
+              null,
+              Type_Sub_Key'Unchecked_Access,
+              Value (1)'Address,
+              Size_Value'Unchecked_Access);
 
          exit when not (Result = ERROR_SUCCESS);
 
          Quit := False;
 
          if Type_Sub_Key = REG_EXPAND_SZ and then Expand then
-               Action (Natural (Index) + 1,
-                       Sub_Key (1 .. Integer (Size_Sub_Key)),
-                       Directory_Operations.Expand_Path
-                         (Value (1 .. Integer (Size_Value) - 1),
-                          Directory_Operations.DOS),
-                       Quit);
+            Action
+              (Natural (Index) + 1,
+               Sub_Key (1 .. Integer (Size_Sub_Key)),
+               Directory_Operations.Expand_Path
+                 (Value (1 .. Integer (Size_Value) - 1),
+                  Directory_Operations.DOS),
+               Quit);
 
          elsif Type_Sub_Key = REG_SZ or else Type_Sub_Key = REG_EXPAND_SZ then
-            Action (Natural (Index) + 1,
-                    Sub_Key (1 .. Integer (Size_Sub_Key)),
-                    Value (1 .. Integer (Size_Value) - 1),
-                    Quit);
+            Action
+              (Natural (Index) + 1,
+               Sub_Key (1 .. Integer (Size_Sub_Key)),
+               Value (1 .. Integer (Size_Value) - 1),
+               Quit);
          end if;
 
          exit when Quit;
@@ -345,16 +345,17 @@ package body GNAT.Registry is
       C_Sub_Key : constant String := Sub_Key & ASCII.Nul;
       C_Mode    : constant REGSAM := To_C_Mode (Mode);
 
-      New_Key   : aliased HKEY;
-      Result    : LONG;
+      New_Key : aliased HKEY;
+      Result  : LONG;
 
    begin
-      Result := RegOpenKeyEx
-        (From_Key,
-         C_Sub_Key (C_Sub_Key'First)'Address,
-         0,
-         C_Mode,
-         New_Key'Unchecked_Access);
+      Result :=
+        RegOpenKeyEx
+          (From_Key,
+           C_Sub_Key (C_Sub_Key'First)'Address,
+           0,
+           C_Mode,
+           New_Key'Unchecked_Access);
 
       Check_Result (Result, "Open_Key " & Sub_Key);
       return New_Key;
@@ -385,13 +386,14 @@ package body GNAT.Registry is
    begin
       Size_Value := Value'Length;
 
-      Result := RegQueryValueEx
-        (From_Key,
-         C_Sub_Key (C_Sub_Key'First)'Address,
-         null,
-         Type_Value'Unchecked_Access,
-         Value (Value'First)'Address,
-         Size_Value'Unchecked_Access);
+      Result :=
+        RegQueryValueEx
+          (From_Key,
+           C_Sub_Key (C_Sub_Key'First)'Address,
+           null,
+           Type_Value'Unchecked_Access,
+           Value (Value'First)'Address,
+           Size_Value'Unchecked_Access);
 
       Check_Result (Result, "Query_Value " & Sub_Key & " key");
 
@@ -408,23 +410,32 @@ package body GNAT.Registry is
    ---------------
 
    procedure Set_Value
-     (From_Key : HKEY;
-      Sub_Key  : String;
-      Value    : String)
+      (From_Key : HKEY;
+       Sub_Key  : String;
+       Value    : String;
+       Expand   : Boolean := False)
    is
       C_Sub_Key : constant String := Sub_Key & ASCII.Nul;
       C_Value   : constant String := Value & ASCII.Nul;
 
-      Result : LONG;
+      Value_Type : DWORD;
+      Result     : LONG;
 
    begin
-      Result := RegSetValueEx
-        (From_Key,
-         C_Sub_Key (C_Sub_Key'First)'Address,
-         0,
-         REG_SZ,
-         C_Value (C_Value'First)'Address,
-         C_Value'Length);
+      if Expand then
+         Value_Type := REG_EXPAND_SZ;
+      else
+         Value_Type := REG_SZ;
+      end if;
+
+      Result :=
+        RegSetValueEx
+          (From_Key,
+           C_Sub_Key (C_Sub_Key'First)'Address,
+           0,
+           Value_Type,
+           C_Value (C_Value'First)'Address,
+           C_Value'Length);
 
       Check_Result (Result, "Set_Value " & Sub_Key & " key");
    end Set_Value;

gcc/ada/g-regist.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2001-2005, Free Software Foundation, Inc.         --
+--          Copyright (C) 2001-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -95,8 +95,14 @@ package GNAT.Registry is
    --  REG_EXPAND_SZ the returned value will have the %name% variables
    --  replaced by the corresponding environment variable value.
 
-   procedure Set_Value (From_Key : HKEY; Sub_Key : String; Value : String);
-   --  Add the pair (Sub_Key, Value) into From_Key registry key
+   procedure Set_Value
+      (From_Key : HKEY;
+       Sub_Key  : String;
+       Value    : String;
+       Expand   : Boolean := False);
+   --  Add the pair (Sub_Key, Value) into From_Key registry key.
+   --  By default the value created is of type REG_SZ, unless
+   --  Expand is True in which case it is of type REG_EXPAND_SZ
 
    procedure Delete_Key (From_Key : HKEY; Sub_Key : String);
    --  Remove Sub_Key from the registry key From_Key