File: show_extensions.adb

package info (click to toggle)
libadabindx 0.7.2-4
  • links: PTS
  • area: main
  • in suites: sarge
  • size: 3,136 kB
  • ctags: 32
  • sloc: ada: 35,597; makefile: 556; sh: 10
file content (94 lines) | stat: -rw-r--r-- 4,273 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
-------------------------------------------------------------------------------
--                                                                           --
--  Ada Interface to the X Window System and Motif(tm)/Lesstif               --
--  Copyright (c) 1996-2002 Hans-Frieder Vogt                                --
--                                                                           --
--  Adabindx is free software; you can redistribute it and/or modify it      --
--  under the terms of the GNU General Public License as published by the    --
--  Free Software Foundation; either version 2 of the License, or (at your   --
--  option) any later version.                                               --
--                                                                           --
--  This program is distributed in the hope that it will be useful, but      --
--  WITHOUT 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        --
--  along with this program; if not, write to the                            --
--  Free Software Foundation, Inc.,                                          --
--  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 General Public License.                               --
--                                                                           --
--  X Window System is copyrighted by the X Consortium                       --
--  Motif(tm)       is copyrighted by the Open Software Foundation, Inc.     --
--                  and by The Open Group                                    --
--                                                                           --
--                                                                           --
-------------------------------------------------------------------------------

-------------------------------------------------------------------------------
--
-- HISTORY:
--          June 20, 1998 begin of history
--          Nov 14, 1998 HFVogt: X_List_Extensions is in X_Lib.Extensions now!
--          9 Feb 2002 H.-F. Vogt: sort extension before listing them
--
-------------------------------------------------------------------------------

with X_Toolkit,
     X_Lib.Extensions,
--     X_Lib.Tasking,
     Ada.Text_Io,
     Bubble_Sort,
     String_List;
use  X_Toolkit,
     X_Lib,
     Ada.Text_Io,
     String_List;
procedure Show_Extensions is

   Appshell : Widget;
   Display  : Display_Pointer;
   App_Con  : Xt_App_Context;

   Exts : Element_Access_List;

   type String_Access is access all String;
   type String_Array  is array (Natural range <>) of String_Access;

   function "<" (Left, Right : in String_Access) return Boolean is
   begin
      return Left.all < Right.all;
   end "<";

   --  sort routine
   procedure String_Sort is
      new Bubble_Sort (Natural, String_Access, String_Array, "<");

begin
--   X_Lib.Tasking.Resource.Seize;

   Xt_App_Initialize (Appshell, App_Con, "ShowHosts");
   Display := Xt_Display (Appshell);

   Exts := Extensions.X_List_Extensions (Display);
   declare
      Arry : String_Array (1 .. Length (Exts));
   begin
      for I in Arry'Range loop
         Arry (I) := new String'(Element (Exts, I));
      end loop;
      String_Sort (Arry);
      for I in Arry'Range loop
         Ada.Text_Io.Put_Line (Arry (I).all);
      end loop;
   end;

end Show_Extensions;