File : win32.adb
-- $Source : /nile.c/cvs/Dev/NT/Win32Ada/src/win32.adb, v $
-- $Revision : 1.1 $ $Date : 1998/04/07 21 :53 :55 $ $Author : obry $
with Ada.Unchecked_Conversion;
5 with System;
package body Win32 is
function Cat (Left, Right : String) return String is
10 Nul : constant Character := Character'First;
begin
if Left (Left'Last) = Nul then
if Right (Right'Last) = Nul then
return Left (Left'First .. Left'Last - 1) & Right;
15 else
return Left (Left'First .. Left'Last - 1) & Right & Nul;
end if;
else
if Right (Right'Last) = Nul then
20 return Left & Right;
else
return Left & Right & Nul;
end if;
end if;
25 end Cat;
function Cat (Left, Right : Wide_String) return Wide_String is
Nul : constant Wide_Character := Wide_Character'First;
begin
30 if Left (Left'Last) = Nul then
if Right (Right'Last) = Nul then
return Left (Left'First .. Left'Last - 1) & Right;
else
return Left (Left'First .. Left'Last - 1) & Right & Nul;
35 end if;
else
if Right (Right'Last) = Nul then
return Left & Right;
else
40 return Left & Right & Nul;
end if;
end if;
end Cat;
45 function Cat (Left, Right : CHAR_Array) return CHAR_Array is
Nul : constant CHAR := CHAR'First;
use type Win32.CHAR;
begin
if Left (Left'Last) = Nul then
50 if Right (Right'Last) = Nul then
return Left (Left'First .. Left'Last - 1) & Right;
else
return Left (Left'First .. Left'Last - 1) & Right & Nul;
end if;
55 else
if Right (Right'Last) = Nul then
return Left & Right;
else
return Left & Right & Nul;
60 end if;
end if;
end Cat;
function Cat (Left, Right : WCHAR_Array) return WCHAR_Array is
65 Nul : constant WCHAR := WCHAR'First;
use type Win32.WCHAR;
begin
if Left (Left'Last) = Nul then
if Right (Right'Last) = Nul then
70 return Left (Left'First .. Left'Last - 1) & Right;
else
return Left (Left'First .. Left'Last - 1) & Right & Nul;
end if;
else
75 if Right (Right'Last) = Nul then
return Left & Right;
else
return Left & Right & Nul;
end if;
80 end if;
end Cat;
function Addr (S : String) return PSTR is
function To_PSTR is new
85 Ada.Unchecked_Conversion (System.Address, PSTR);
begin
return To_PSTR (S (S'First)'Address);
end Addr;
90 function Addr (S : String) return PCSTR is
function To_PCSTR is new
Ada.Unchecked_Conversion (System.Address, PCSTR);
begin
return To_PCSTR (S (S'First)'Address);
95 end Addr;
function Addr (S : Wide_String) return PWSTR is
function To_PWSTR is new
Ada.Unchecked_Conversion (System.Address, PWSTR);
100 begin
return To_PWSTR (S (S'First)'Address);
end Addr;
function Addr (S : Wide_String) return PCWSTR is
105 function To_PCWSTR is new
Ada.Unchecked_Conversion (System.Address, PCWSTR);
begin
return To_PCWSTR (S (S'First)'Address);
end Addr;
110
function Addr (S : CHAR_Array) return PSTR is
function To_PSTR is new
Ada.Unchecked_Conversion (System.Address, PSTR);
begin
115 return To_PSTR (S (S'First)'Address);
end Addr;
function Addr (S : CHAR_Array) return PCSTR is
function To_PCSTR is new
120 Ada.Unchecked_Conversion (System.Address, PCSTR);
begin
return To_PCSTR (S (S'First)'Address);
end Addr;
125 function Addr (S : WCHAR_Array) return PWSTR is
function To_PWSTR is new
Ada.Unchecked_Conversion (System.Address, PWSTR);
begin
return To_PWSTR (S (S'First)'Address);
130 end Addr;
function Addr (S : WCHAR_Array) return PCWSTR is
function To_PCWSTR is new
Ada.Unchecked_Conversion (System.Address, PCWSTR);
135 begin
return To_PCWSTR (S (S'First)'Address);
end Addr;
function To_Chars_Ptr (STR : PSTR) return Interfaces.C.Strings.chars_ptr is
140 function UC1 is new
Ada.Unchecked_Conversion (PSTR, Interfaces.C.Strings.chars_ptr);
begin
return UC1 (STR);
end To_Chars_Ptr;
145
function To_Chars_Ptr (STR : PCSTR) return Interfaces.C.Strings.chars_ptr is
function UC2 is new
Ada.Unchecked_Conversion (PCSTR, Interfaces.C.Strings.chars_ptr);
begin
150 return UC2 (STR);
end To_Chars_Ptr;
function To_PSTR (CP : Interfaces.C.Strings.chars_ptr) return PSTR is
function UC3 is new
155 Ada.Unchecked_Conversion (Interfaces.C.Strings.chars_ptr, PSTR);
begin
return UC3 (CP);
end To_PSTR;
160 function To_PCSTR (CP : Interfaces.C.Strings.chars_ptr) return PCSTR is
function UC4 is new
Ada.Unchecked_Conversion (Interfaces.C.Strings.chars_ptr, PCSTR);
begin
return UC4 (CP);
165 end To_PCSTR;
function To_C (S : CHAR_Array) return Interfaces.C.char_array is
Res : Interfaces.C.char_array (
Interfaces.C.size_t (S'First) ..
170 Interfaces.C.size_t (S'Last));
begin
Res := Interfaces.C.char_array (S);
return Res;
end To_C;
175
function To_Win (S : Interfaces.C.char_array) return CHAR_Array is
Low : Integer := Integer (S'First);
High : Integer := Integer (S'Last);
Res : CHAR_Array (Low .. High);
180 begin
Res := CHAR_Array (S);
return Res;
end To_Win;
185 function To_Win (S : Interfaces.C.wchar_array) return WCHAR_Array is
Low : Integer := Integer (S'First);
High : Integer := Integer (S'Last);
Res : WCHAR_Array (Low .. High);
begin
190 Res := WCHAR_Array (S);
return Res;
end To_Win;
----------------------------------------------------------------------------
195 --
-- THIS FILE AND ANY ASSOCIATED DOCUMENTATION IS FURNISHED "AS IS"
-- WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESS OR IMPLIED,
-- INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
-- MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE. The
200 -- user assumes the entire risk as to the accuracy and the use of
-- this file.
--
-- Copyright (c) Intermetrics, Inc. 1995
-- Royalty-free, unlimited, worldwide, non-exclusive use, modification,
205 -- reproduction and further distribution of this file is permitted.
--
----------------------------------------------------------------------------
end Win32;
210
-- Log
-- 05/04/1998 - remove Pragma Linker_Options ("-lwin32ada") - this option
-- is already set in the spec.
215