1 | ------------------------------------------------------------------------------
|
---|
2 | -- --
|
---|
3 | -- GNAT ncurses Binding --
|
---|
4 | -- --
|
---|
5 | -- Terminal_Interface.Curses.Trace --
|
---|
6 | -- --
|
---|
7 | -- B O D Y --
|
---|
8 | -- --
|
---|
9 | ------------------------------------------------------------------------------
|
---|
10 | -- Copyright (c) 2000-2004,2009 Free Software Foundation, Inc. --
|
---|
11 | -- --
|
---|
12 | -- Permission is hereby granted, free of charge, to any person obtaining a --
|
---|
13 | -- copy of this software and associated documentation files (the --
|
---|
14 | -- "Software"), to deal in the Software without restriction, including --
|
---|
15 | -- without limitation the rights to use, copy, modify, merge, publish, --
|
---|
16 | -- distribute, distribute with modifications, sublicense, and/or sell --
|
---|
17 | -- copies of the Software, and to permit persons to whom the Software is --
|
---|
18 | -- furnished to do so, subject to the following conditions: --
|
---|
19 | -- --
|
---|
20 | -- The above copyright notice and this permission notice shall be included --
|
---|
21 | -- in all copies or substantial portions of the Software. --
|
---|
22 | -- --
|
---|
23 | -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
|
---|
24 | -- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
|
---|
25 | -- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
|
---|
26 | -- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
|
---|
27 | -- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
|
---|
28 | -- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
|
---|
29 | -- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
|
---|
30 | -- --
|
---|
31 | -- Except as contained in this notice, the name(s) of the above copyright --
|
---|
32 | -- holders shall not be used in advertising or otherwise to promote the --
|
---|
33 | -- sale, use or other dealings in this Software without prior written --
|
---|
34 | -- authorization. --
|
---|
35 | ------------------------------------------------------------------------------
|
---|
36 | -- Author: Juergen Pfeifer, 1996
|
---|
37 | -- Version Control:
|
---|
38 | -- $Revision: 1.7 $
|
---|
39 | -- Binding Version 01.00
|
---|
40 | ------------------------------------------------------------------------------
|
---|
41 | #if ADA_TRACE then
|
---|
42 | with Interfaces.C; use Interfaces.C;
|
---|
43 | with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
|
---|
44 | with Ada.Unchecked_Conversion;
|
---|
45 | #end if;
|
---|
46 |
|
---|
47 | package body Terminal_Interface.Curses.Trace is
|
---|
48 |
|
---|
49 | #if ADA_TRACE then
|
---|
50 | type C_TraceType is new C_UInt;
|
---|
51 |
|
---|
52 | function TraceAda_To_TraceC is new
|
---|
53 | Ada.Unchecked_Conversion (Source => Trace_Attribute_Set,
|
---|
54 | Target => C_TraceType);
|
---|
55 |
|
---|
56 | procedure Trace_On (x : Trace_Attribute_Set) is
|
---|
57 | procedure traceC (y : C_TraceType);
|
---|
58 | pragma Import (C, traceC, "trace");
|
---|
59 | begin
|
---|
60 | traceC (TraceAda_To_TraceC (x));
|
---|
61 | end Trace_On;
|
---|
62 |
|
---|
63 | -- 75. (12) A C function that takes a variable number of arguments can
|
---|
64 | -- correspond to several Ada subprograms, taking various specific
|
---|
65 | -- numbers and types of parameters.
|
---|
66 |
|
---|
67 | procedure Trace_Put (str : String) is
|
---|
68 | procedure tracef (format : char_array; s : char_array);
|
---|
69 | pragma Import (C, tracef, "_traces");
|
---|
70 | Txt : char_array (0 .. str'Length);
|
---|
71 | Length : size_t;
|
---|
72 | formatstr : constant String := "%s" & ASCII.NUL;
|
---|
73 | formattxt : char_array (0 .. formatstr'Length);
|
---|
74 | begin
|
---|
75 | To_C (formatstr, formattxt, Length);
|
---|
76 | To_C (str, Txt, Length);
|
---|
77 | tracef (formattxt, Txt);
|
---|
78 | end Trace_Put;
|
---|
79 | #else
|
---|
80 | procedure Trace_On (x : Trace_Attribute_Set) is
|
---|
81 | #if PRAGMA_UNREF
|
---|
82 | pragma Unreferenced (x);
|
---|
83 | #end if;
|
---|
84 | begin
|
---|
85 | null;
|
---|
86 | end Trace_On;
|
---|
87 |
|
---|
88 | procedure Trace_Put (str : String) is
|
---|
89 | #if PRAGMA_UNREF
|
---|
90 | pragma Unreferenced (str);
|
---|
91 | #end if;
|
---|
92 | begin
|
---|
93 | null;
|
---|
94 | end Trace_Put;
|
---|
95 | #end if;
|
---|
96 |
|
---|
97 | end Terminal_Interface.Curses.Trace;
|
---|