ncurses 6.0 - patch 20160130

[ncurses.git] / Ada95 / samples / sample-explanation.adb

diff --git a/Ada95/samples/sample-explanation.adb b/Ada95/samples/sample-explanation.adb
index 09f882c32ed4718fd7529a70ce2e4681c804fa5b..a2d18226fc3d5bbd886be2c79b3d806ed1d31e5d 100644 (file)
--- a/Ada95/samples/sample-explanation.adb
+++ b/Ada95/samples/sample-explanation.adb
@@ -7,7 +7,7 @@
 --                                 B O D Y                                  --
 --                                                                          --
 ------------------------------------------------------------------------------
 --                                 B O D Y                                  --
 --                                                                          --
 ------------------------------------------------------------------------------

--- Copyright (c) 1998-2009,2011 Free Software Foundation, Inc.              --
+-- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc.              --

 --                                                                          --
 -- Permission is hereby granted, free of charge, to any person obtaining a  --
 -- copy of this software and associated documentation files (the            --
 --                                                                          --
 -- Permission is hereby granted, free of charge, to any person obtaining a  --
 -- copy of this software and associated documentation files (the            --


@@ -35,8 +35,8 @@
 ------------------------------------------------------------------------------
 --  Author:  Juergen Pfeifer, 1996
 --  Version Control
 ------------------------------------------------------------------------------
 --  Author:  Juergen Pfeifer, 1996
 --  Version Control

---  $Revision: 1.23 $
---  $Date: 2011/03/08 00:44:36 $
+--  $Revision: 1.27 $
+--  $Date: 2014/09/13 19:10:18 $

 --  Binding Version 01.00
 ------------------------------------------------------------------------------
 --  Poor mans help system. This scans a sequential file for key lines and
 --  Binding Version 01.00
 ------------------------------------------------------------------------------
 --  Poor mans help system. This scans a sequential file for key lines and


@@ -86,6 +86,8 @@ package body Sample.Explanation is
    function Search (Key : String) return Help_Line_Access;
    procedure Release_Help (Root : in out Help_Line_Access);
 
    function Search (Key : String) return Help_Line_Access;
    procedure Release_Help (Root : in out Help_Line_Access);
 

+   function Check_File (Name : String) return Boolean;
+

    procedure Explain (Key : String)
    is
    begin
    procedure Explain (Key : String)
    is
    begin


@@ -126,7 +128,7 @@ package body Sample.Explanation is
          Add (W, Key);
          Add (W, " not found.");
          Add (W, Character'Val (10));
          Add (W, Key);
          Add (W, " not found.");
          Add (W, Character'Val (10));

-         Add (W, "Press the Function key labelled 'Quit' key to continue.");
+         Add (W, "Press the Function key labeled 'Quit' key to continue.");

       end Unknown_Key;
 
       procedure Redo
       end Unknown_Key;
 
       procedure Redo


@@ -135,9 +137,9 @@ package body Sample.Explanation is
       begin
          if Top_Line /= null then
             for L in 0 .. (Height - 1) loop
       begin
          if Top_Line /= null then
             for L in 0 .. (Height - 1) loop

-               Add (W, L, 0, H.Line.all);
-               exit when H.Next = null;
-               H := H.Next;
+               Add (W, L, 0, H.all.Line.all);
+               exit when H.all.Next = null;
+               H := H.all.Next;

             end loop;
          else
             Unknown_Key;
             end loop;
          else
             Unknown_Key;


@@ -181,12 +183,12 @@ package body Sample.Explanation is
          L : Line_Position := 0;
       begin
          loop
          L : Line_Position := 0;
       begin
          loop

-            Add (W, L, 0, C.Line.all);
+            Add (W, L, 0, C.all.Line.all);

             L := L + 1;
             L := L + 1;

-            exit when C.Next = null or else L = Height;
-            C := C.Next;
+            exit when C.all.Next = null or else L = Height;
+            C := C.all.Next;

          end loop;
          end loop;

-         if C.Next /= null then
+         if C.all.Next /= null then

             pragma Assert (L = Height);
             More := True;
          else
             pragma Assert (L = Height);
             More := True;
          else


@@ -248,20 +250,20 @@ package body Sample.Explanation is
                if K in Special_Key_Code'Range then
                   case K is
                      when Key_Cursor_Down =>
                if K in Special_Key_Code'Range then
                   case K is
                      when Key_Cursor_Down =>

-                        if Current.Next /= null then
+                        if Current.all.Next /= null then

                            Move_Cursor (W, Height - 1, 0);
                            Scroll (W, 1);
                            Move_Cursor (W, Height - 1, 0);
                            Scroll (W, 1);

-                           Current := Current.Next;
-                           Top_Line := Top_Line.Next;
-                           Add (W, Current.Line.all);
+                           Current := Current.all.Next;
+                           Top_Line := Top_Line.all.Next;
+                           Add (W, Current.all.Line.all);

                         end if;
                      when Key_Cursor_Up =>
                         end if;
                      when Key_Cursor_Up =>

-                        if Top_Line.Prev /= null then
+                        if Top_Line.all.Prev /= null then

                            Move_Cursor (W, 0, 0);
                            Scroll (W, -1);
                            Move_Cursor (W, 0, 0);
                            Scroll (W, -1);

-                           Top_Line := Top_Line.Prev;
-                           Current := Current.Prev;
-                           Add (W, Top_Line.Line.all);
+                           Top_Line := Top_Line.all.Prev;
+                           Current := Current.all.Prev;
+                           Add (W, Top_Line.all.Line.all);

                         end if;
                      when QUIT_CODE => exit;
                         when others => null;
                         end if;
                      when QUIT_CODE => exit;
                         when others => null;


@@ -319,8 +321,10 @@ package body Sample.Explanation is
       Outer :
       loop
          exit Outer when not Next_Line;
       Outer :
       loop
          exit Outer when not Next_Line;

-         if Last = (1 + Key'Length) and then Key = Buffer (2 .. Last)
-           and then Buffer (1) = '#' then
+         if Last = (1 + Key'Length)
+           and then Key = Buffer (2 .. Last)
+           and then Buffer (1) = '#'
+         then

             loop
                exit when not Next_Line;
                exit when Buffer (1) = '#';
             loop
                exit when not Next_Line;
                exit when Buffer (1) = '#';


@@ -330,8 +334,8 @@ package body Sample.Explanation is
                   Release_Help (Root);
                   Root := Current;
                else
                   Release_Help (Root);
                   Root := Current;
                else

-                  Tail.Next := Current;
-                  Current.Prev := Tail;
+                  Tail.all.Next := Current;
+                  Current.all.Prev := Tail;

                end if;
                Tail := Current;
             end loop;
                end if;
                Tail := Current;
             end loop;


@@ -347,8 +351,8 @@ package body Sample.Explanation is
    begin
       loop
          exit when Root = null;
    begin
       loop
          exit when Root = null;

-         Next := Root.Next;
-         Release_String (Root.Line);
+         Next := Root.all.Next;
+         Release_String (Root.all.Line);

          Release_Help_Line (Root);
          Root := Next;
       end loop;
          Release_Help_Line (Root);
          Root := Next;
       end loop;


@@ -371,7 +375,7 @@ package body Sample.Explanation is
    begin
       if H /= null then
          loop
    begin
       if H /= null then
          loop

-            T := T.Next;
+            T := T.all.Next;

             exit when T = null;
             N := N + 1;
          end loop;
             exit when T = null;
             N := N + 1;
          end loop;


@@ -391,9 +395,9 @@ package body Sample.Explanation is
          P := New_Panel (W);
          T := H;
          loop
          P := New_Panel (W);
          T := H;
          loop

-            Add (W, L + 1, 1, T.Line.all, Integer (Columns - 2));
+            Add (W, L + 1, 1, T.all.Line.all, Integer (Columns - 2));

             L := L + 1;
             L := L + 1;

-            T := T.Next;
+            T := T.all.Next;

             exit when T = null;
          end loop;
          T := H;
             exit when T = null;
          end loop;
          T := H;


@@ -403,12 +407,26 @@ package body Sample.Explanation is
       end if;
    end Notepad;
 
       end if;
    end Notepad;
 

+   function Check_File (Name : String) return Boolean is
+      The_File : File_Type;
+   begin
+      Open (The_File, In_File, Name);
+      Close (The_File);
+      return True;
+   exception
+      when Name_Error =>
+         return False;
+   end Check_File;
+

 begin
 begin

-   Open (F, In_File, File_Name);
-exception
-   when Name_Error =>
+   if Check_File ("/usr/share/AdaCurses/" & File_Name) then
+      Open (F, In_File, "/usr/share/AdaCurses/" & File_Name);
+   elsif Check_File (File_Name) then
+      Open (F, In_File, File_Name);
+   else

       Put_Line (Standard_Error,
                 "The file explain.txt was not found in the current directory."
                 );
       Put_Line (Standard_Error,
                 "The file explain.txt was not found in the current directory."
                 );

-      raise;
+      raise Name_Error;
+   end if;

 end Sample.Explanation;
 end Sample.Explanation;