X-Git-Url: https://oss.titaniummirror.com/gitweb?a=blobdiff_plain;f=gcc%2Fada%2Fg-cgideb.adb;fp=gcc%2Fada%2Fg-cgideb.adb;h=0000000000000000000000000000000000000000;hb=6fed43773c9b0ce596dca5686f37ac3fc0fa11c0;hp=1868914a86cf32f3eba757451eab751982cbf5c0;hpb=27b11d56b743098deb193d510b337ba22dc52e5c;p=msp430-gcc.git diff --git a/gcc/ada/g-cgideb.adb b/gcc/ada/g-cgideb.adb deleted file mode 100644 index 1868914a..00000000 --- a/gcc/ada/g-cgideb.adb +++ /dev/null @@ -1,332 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- G N A T . C G I . D E B U G -- --- -- --- B o d y -- --- -- --- $Revision: 1.1 $ --- -- --- Copyright (C) 2000-2001 Ada Core Technologies, 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- -- --- ware Foundation; either version 2, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNAT; see file COPYING. If not, write -- --- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- --- MA 02111-1307, USA. -- --- -- --- As a special exception, if other files instantiate generics from this -- --- unit, or you link this unit with other files to produce an executable, -- --- this unit does not by itself cause the resulting executable to be -- --- covered by the GNU General Public License. This exception does not -- --- however invalidate any other reasons why the executable file might be -- --- covered by the GNU Public License. -- --- -- --- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). -- --- -- ------------------------------------------------------------------------------- - -with Ada.Strings.Unbounded; - -package body GNAT.CGI.Debug is - - use Ada.Strings.Unbounded; - - -- - -- Define the abstract type which act as a template for all debug IO mode. - -- To create a new IO mode you must: - -- 1. create a new package spec - -- 2. create a new type derived from IO.Format - -- 3. implement all the abstract rountines in IO - -- - - package IO is - - type Format is abstract tagged null record; - - function Output (Mode : in Format'Class) return String; - - function Variable - (Mode : Format; - Name : String; - Value : String) - return String - is abstract; - -- Returns variable Name and its associated value. - - function New_Line - (Mode : Format) - return String - is abstract; - -- Returns a new line such as this concatenated between two strings - -- will display the strings on two lines. - - function Title - (Mode : Format; - Str : String) - return String - is abstract; - -- Returns Str as a Title. A title must be alone and centered on a - -- line. Next output will be on the following line. - - function Header - (Mode : Format; - Str : String) - return String - is abstract; - -- Returns Str as an Header. An header must be alone on its line. Next - -- output will be on the following line. - - end IO; - - -- - -- IO for HTML mode - -- - - package HTML_IO is - - -- see IO for comments about these routines. - - type Format is new IO.Format with null record; - - function Variable - (IO : Format; - Name : String; - Value : String) - return String; - - function New_Line (IO : in Format) return String; - - function Title (IO : in Format; Str : in String) return String; - - function Header (IO : in Format; Str : in String) return String; - - end HTML_IO; - - -- - -- IO for plain text mode - -- - - package Text_IO is - - -- See IO for comments about these routines - - type Format is new IO.Format with null record; - - function Variable - (IO : Format; - Name : String; - Value : String) - return String; - - function New_Line (IO : in Format) return String; - - function Title (IO : in Format; Str : in String) return String; - - function Header (IO : in Format; Str : in String) return String; - - end Text_IO; - - -------------- - -- Debug_IO -- - -------------- - - package body IO is - - ------------ - -- Output -- - ------------ - - function Output (Mode : in Format'Class) return String is - Result : Unbounded_String; - - begin - Result := Result - & Title (Mode, "CGI complete runtime environment"); - - Result := Result - & Header (Mode, "CGI parameters:") - & New_Line (Mode); - - for K in 1 .. Argument_Count loop - Result := Result - & Variable (Mode, Key (K), Value (K)) - & New_Line (Mode); - end loop; - - Result := Result - & New_Line (Mode) - & Header (Mode, "CGI environment variables (Metavariables):") - & New_Line (Mode); - - for P in Metavariable_Name'Range loop - if Metavariable_Exists (P) then - Result := Result - & Variable (Mode, - Metavariable_Name'Image (P), - Metavariable (P)) - & New_Line (Mode); - end if; - end loop; - - return To_String (Result); - end Output; - - end IO; - - ------------- - -- HTML_IO -- - ------------- - - package body HTML_IO is - - NL : constant String := (1 => ASCII.LF); - - function Bold (S : in String) return String; - -- Returns S as an HTML bold string. - - function Italic (S : in String) return String; - -- Returns S as an HTML italic string. - - ---------- - -- Bold -- - ---------- - - function Bold (S : in String) return String is - begin - return "" & S & ""; - end Bold; - - ------------ - -- Header -- - ------------ - - function Header (IO : in Format; Str : in String) return String is - begin - return "

" & Str & "

" & NL; - end Header; - - ------------ - -- Italic -- - ------------ - - function Italic (S : in String) return String is - begin - return "" & S & ""; - end Italic; - - -------------- - -- New_Line -- - -------------- - - function New_Line (IO : in Format) return String is - begin - return "
" & NL; - end New_Line; - - ----------- - -- Title -- - ----------- - - function Title (IO : in Format; Str : in String) return String is - begin - return "

" & Str & "

" & NL; - end Title; - - -------------- - -- Variable -- - -------------- - - function Variable - (IO : Format; - Name : String; - Value : String) - return String - is - begin - return Bold (Name) & " = " & Italic (Value); - end Variable; - - end HTML_IO; - - ------------- - -- Text_IO -- - ------------- - - package body Text_IO is - - ------------ - -- Header -- - ------------ - - function Header (IO : in Format; Str : in String) return String is - begin - return "*** " & Str & New_Line (IO); - end Header; - - -------------- - -- New_Line -- - -------------- - - function New_Line (IO : in Format) return String is - begin - return String'(1 => ASCII.LF); - end New_Line; - - ----------- - -- Title -- - ----------- - - function Title (IO : in Format; Str : in String) return String is - Spaces : constant Natural := (80 - Str'Length) / 2; - Indent : constant String (1 .. Spaces) := (others => ' '); - - begin - return Indent & Str & New_Line (IO); - end Title; - - -------------- - -- Variable -- - -------------- - - function Variable - (IO : Format; - Name : String; - Value : String) - return String - is - begin - return " " & Name & " = " & Value; - end Variable; - - end Text_IO; - - ----------------- - -- HTML_Output -- - ----------------- - - function HTML_Output return String is - HTML : HTML_IO.Format; - - begin - return IO.Output (Mode => HTML); - end HTML_Output; - - ----------------- - -- Text_Output -- - ----------------- - - function Text_Output return String is - Text : Text_IO.Format; - - begin - return IO.Output (Mode => Text); - end Text_Output; - -end GNAT.CGI.Debug;