OpenCores
URL https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [ada/] [g-cgideb.adb] - Blame information for rev 410

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 281 jeremybenn 
------------------------------------------------------------------------------
2 
--                                                                          --
3 
--                         GNAT COMPILER COMPONENTS                         --
4 
--                                                                          --
5 
--                        G N A T . C G I . D E B U G                       --
6 
--                                                                          --
7 
--                                 B o d y                                  --
8 
--                                                                          --
9 
--                     Copyright (C) 2000-2008, AdaCore                     --
10 
--                                                                          --
11 
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
12 
-- terms of the  GNU General Public License as published  by the Free Soft- --
13 
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
14 
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
15 
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
16 
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
17 
-- for  more details.  You should have  received  a copy of the GNU General --
18 
-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
19 
-- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
20 
-- Boston, MA 02110-1301, USA.                                              --
21 
--                                                                          --
22 
-- As a special exception,  if other files  instantiate  generics from this --
23 
-- unit, or you link  this unit with other files  to produce an executable, --
24 
-- this  unit  does not  by itself cause  the resulting  executable  to  be --
25 
-- covered  by the  GNU  General  Public  License.  This exception does not --
26 
-- however invalidate  any other reasons why  the executable file  might be --
27 
-- covered by the  GNU Public License.                                      --
28 
--                                                                          --
29 
-- GNAT was originally developed  by the GNAT team at  New York University. --
30 
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
31 
--                                                                          --
32 
------------------------------------------------------------------------------
33 
 
34 
with Ada.Strings.Unbounded;
35 
 
36 
package body GNAT.CGI.Debug is
37 
 
38 
   use Ada.Strings.Unbounded;
39 
 
40 
   --  Define the abstract type which act as a template for all debug IO modes.
41 
   --  To create a new IO mode you must:
42 
   --     1. create a new package spec
43 
   --     2. create a new type derived from IO.Format
44 
   --     3. implement all the abstract routines in IO
45 
 
46 
   package IO is
47 
 
48 
      type Format is abstract tagged null record;
49 
 
50 
      function Output (Mode : Format'Class) return String;
51 
 
52 
      function Variable
53 
        (Mode  : Format;
54 
         Name  : String;
55 
         Value : String) return String is abstract;
56 
      --  Returns variable Name and its associated value
57 
 
58 
      function New_Line (Mode : Format) return String is abstract;
59 
      --  Returns a new line such as this concatenated between two strings
60 
      --  will display the strings on two lines.
61 
 
62 
      function Title (Mode : Format; Str : String) return String is abstract;
63 
      --  Returns Str as a Title. A title must be alone and centered on a
64 
      --  line. Next output will be on the following line.
65 
 
66 
      function Header
67 
        (Mode : Format;
68 
         Str  : String) return String is abstract;
69 
      --  Returns Str as an Header. An header must be alone on its line. Next
70 
      --  output will be on the following line.
71 
 
72 
   end IO;
73 
 
74 
   ----------------------
75 
   -- IO for HTML Mode --
76 
   ----------------------
77 
 
78 
   package HTML_IO is
79 
 
80 
      --  See IO for comments about these routines
81 
 
82 
      type Format is new IO.Format with null record;
83 
 
84 
      function Variable
85 
        (IO    : Format;
86 
         Name  : String;
87 
         Value : String) return String;
88 
 
89 
      function New_Line (IO : Format) return String;
90 
 
91 
      function Title (IO : Format; Str : String) return String;
92 
 
93 
      function Header (IO : Format; Str : String) return String;
94 
 
95 
   end HTML_IO;
96 
 
97 
   ----------------------------
98 
   -- IO for Plain Text Mode --
99 
   ----------------------------
100 
 
101 
   package Text_IO is
102 
 
103 
      --  See IO for comments about these routines
104 
 
105 
      type Format is new IO.Format with null record;
106 
 
107 
      function Variable
108 
        (IO    : Format;
109 
         Name  : String;
110 
         Value : String) return String;
111 
 
112 
      function New_Line (IO : Format) return String;
113 
 
114 
      function Title (IO : Format; Str : String) return String;
115 
 
116 
      function Header (IO : Format; Str : String) return String;
117 
 
118 
   end Text_IO;
119 
 
120 
   --------------
121 
   -- Debug_IO --
122 
   --------------
123 
 
124 
   package body IO is
125 
 
126 
      ------------
127 
      -- Output --
128 
      ------------
129 
 
130 
      function Output (Mode : Format'Class) return String is
131 
         Result : Unbounded_String;
132 
 
133 
      begin
134 
         Result :=
135 
           To_Unbounded_String
136 
             (Title (Mode, "CGI complete runtime environment")
137 
              & Header (Mode, "CGI parameters:")
138 
              & New_Line (Mode));
139 
 
140 
         for K in 1 .. Argument_Count loop
141 
            Result := Result
142 
              & Variable (Mode, Key (K), Value (K))
143 
              & New_Line (Mode);
144 
         end loop;
145 
 
146 
         Result := Result
147 
           & New_Line (Mode)
148 
           & Header (Mode, "CGI environment variables (Metavariables):")
149 
           & New_Line (Mode);
150 
 
151 
         for P in Metavariable_Name'Range loop
152 
            if Metavariable_Exists (P) then
153 
               Result := Result
154 
                 & Variable (Mode,
155 
                             Metavariable_Name'Image (P),
156 
                             Metavariable (P))
157 
                 & New_Line (Mode);
158 
            end if;
159 
         end loop;
160 
 
161 
         return To_String (Result);
162 
      end Output;
163 
 
164 
   end IO;
165 
 
166 
   -------------
167 
   -- HTML_IO --
168 
   -------------
169 
 
170 
   package body HTML_IO is
171 
 
172 
      NL : constant String := (1 => ASCII.LF);
173 
 
174 
      function Bold (S : String) return String;
175 
      --  Returns S as an HTML bold string
176 
 
177 
      function Italic (S : String) return String;
178 
      --  Returns S as an HTML italic string
179 
 
180 
      ----------
181 
      -- Bold --
182 
      ----------
183 
 
184 
      function Bold (S : String) return String is
185 
      begin
186 
         return "<b>" & S & "</b>";
187 
      end Bold;
188 
 
189 
      ------------
190 
      -- Header --
191 
      ------------
192 
 
193 
      function Header (IO : Format; Str : String) return String is
194 
         pragma Unreferenced (IO);
195 
      begin
196 
         return "<h2>" & Str & "</h2>" & NL;
197 
      end Header;
198 
 
199 
      ------------
200 
      -- Italic --
201 
      ------------
202 
 
203 
      function Italic (S : String) return String is
204 
      begin
205 
         return "<i>" & S & "</i>";
206 
      end Italic;
207 
 
208 
      --------------
209 
      -- New_Line --
210 
      --------------
211 
 
212 
      function New_Line (IO : Format) return String is
213 
         pragma Unreferenced (IO);
214 
      begin
215 
         return "<br>" & NL;
216 
      end New_Line;
217 
 
218 
      -----------
219 
      -- Title --
220 
      -----------
221 
 
222 
      function Title (IO : Format; Str : String) return String is
223 
         pragma Unreferenced (IO);
224 
      begin
225 
         return "<p align=center><font size=+2>" & Str & "</font></p>" & NL;
226 
      end Title;
227 
 
228 
      --------------
229 
      -- Variable --
230 
      --------------
231 
 
232 
      function Variable
233 
        (IO    : Format;
234 
         Name  : String;
235 
         Value : String) return String
236 
      is
237 
         pragma Unreferenced (IO);
238 
      begin
239 
         return Bold (Name) & " = " & Italic (Value);
240 
      end Variable;
241 
 
242 
   end HTML_IO;
243 
 
244 
   -------------
245 
   -- Text_IO --
246 
   -------------
247 
 
248 
   package body Text_IO is
249 
 
250 
      ------------
251 
      -- Header --
252 
      ------------
253 
 
254 
      function Header (IO : Format; Str : String) return String is
255 
      begin
256 
         return "*** " & Str & New_Line (IO);
257 
      end Header;
258 
 
259 
      --------------
260 
      -- New_Line --
261 
      --------------
262 
 
263 
      function New_Line (IO : Format) return String is
264 
         pragma Unreferenced (IO);
265 
      begin
266 
         return String'(1 => ASCII.LF);
267 
      end New_Line;
268 
 
269 
      -----------
270 
      -- Title --
271 
      -----------
272 
 
273 
      function Title (IO : Format; Str : String) return String is
274 
         Spaces : constant Natural := (80 - Str'Length) / 2;
275 
         Indent : constant String (1 .. Spaces) := (others => ' ');
276 
      begin
277 
         return Indent & Str & New_Line (IO);
278 
      end Title;
279 
 
280 
      --------------
281 
      -- Variable --
282 
      --------------
283 
 
284 
      function Variable
285 
        (IO    : Format;
286 
         Name  : String;
287 
         Value : String) return String
288 
      is
289 
         pragma Unreferenced (IO);
290 
      begin
291 
         return "   " & Name & " = " & Value;
292 
      end Variable;
293 
 
294 
   end Text_IO;
295 
 
296 
   -----------------
297 
   -- HTML_Output --
298 
   -----------------
299 
 
300 
   function HTML_Output return String is
301 
      HTML : HTML_IO.Format;
302 
   begin
303 
      return IO.Output (Mode => HTML);
304 
   end HTML_Output;
305 
 
306 
   -----------------
307 
   -- Text_Output --
308 
   -----------------
309 
 
310 
   function Text_Output return String is
311 
      Text : Text_IO.Format;
312 
   begin
313 
      return IO.Output (Mode => Text);
314 
   end Text_Output;
315 
 
316 
end GNAT.CGI.Debug;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.