ncurses 5.9 - patch 20130427
[ncurses.git] / Ada95 / samples / sample-explanation.adb
index 8701925dedf3e2066e936e97239c2beab1e0d4b1..5587099b242a0883145275092164cd75a8eaf61e 100644 (file)
@@ -7,7 +7,7 @@
 --                                 B O D Y                                  --
 --                                                                          --
 ------------------------------------------------------------------------------
--- Copyright (c) 1998 Free Software Foundation, Inc.                        --
+-- Copyright (c) 1998-2009,2011 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            --
 -- sale, use or other dealings in this Software without prior written       --
 -- authorization.                                                           --
 ------------------------------------------------------------------------------
---  Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996
+--  Author:  Juergen Pfeifer, 1996
 --  Version Control
---  $Revision: 1.12 $
+--  $Revision: 1.26 $
+--  $Date: 2011/03/26 22:33:29 $
 --  Binding Version 01.00
 ------------------------------------------------------------------------------
 --  Poor mans help system. This scans a sequential file for key lines and
@@ -57,7 +58,7 @@ package body Sample.Explanation is
    Help_Keys : constant String := "HELPKEYS";
    In_Help   : constant String := "INHELP";
 
-   File_Name : String := "explain.msg";
+   File_Name : constant String := "explain.txt";
    F : File_Type;
 
    type Help_Line;
@@ -72,8 +73,8 @@ package body Sample.Explanation is
          Line : String_Access;
       end record;
 
-   procedure Explain (Key : in String;
-                      Win : in Window);
+   procedure Explain (Key : String;
+                      Win : Window);
 
    procedure Release_String is
      new Ada.Unchecked_Deallocation (String,
@@ -85,14 +86,16 @@ package body Sample.Explanation is
    function Search (Key : String) return Help_Line_Access;
    procedure Release_Help (Root : in out Help_Line_Access);
 
-   procedure Explain (Key : in String)
+   function Check_File (Name : String) return Boolean;
+
+   procedure Explain (Key : String)
    is
    begin
       Explain (Key, Null_Window);
    end Explain;
 
-   procedure Explain (Key : in String;
-                      Win : in Window)
+   procedure Explain (Key : String;
+                      Win : Window)
    is
       --  Retrieve the text associated with this key and display it in this
       --  window. If no window argument is passed, the routine will create
@@ -116,7 +119,7 @@ package body Sample.Explanation is
       Current  : Help_Line_Access;
       Top_Line : Help_Line_Access;
 
-      Has_More : Boolean;
+      Has_More : Boolean := True;
 
       procedure Unknown_Key
       is
@@ -125,7 +128,7 @@ package body Sample.Explanation is
          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
@@ -134,9 +137,9 @@ package body Sample.Explanation is
       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;
@@ -180,12 +183,12 @@ package body Sample.Explanation is
          L : Line_Position := 0;
       begin
          loop
-            Add (W, L, 0, C.Line.all);
+            Add (W, L, 0, C.all.Line.all);
             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;
-         if C.Next /= null then
+         if C.all.Next /= null then
             pragma Assert (L = Height);
             More := True;
          else
@@ -247,20 +250,20 @@ package body Sample.Explanation is
                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);
-                           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 =>
-                        if Top_Line.Prev /= null then
+                        if Top_Line.all.Prev /= null then
                            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;
@@ -317,7 +320,7 @@ package body Sample.Explanation is
       Reset (F);
       Outer :
       loop
-         exit when not Next_Line;
+         exit Outer when not Next_Line;
          if Last = (1 + Key'Length) and then Key = Buffer (2 .. Last)
            and then Buffer (1) = '#' then
             loop
@@ -329,8 +332,8 @@ package body Sample.Explanation is
                   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;
@@ -346,8 +349,8 @@ package body Sample.Explanation is
    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;
@@ -359,7 +362,7 @@ package body Sample.Explanation is
       Explain (Context);
    end Explain_Context;
 
-   procedure Notepad (Key : in String)
+   procedure Notepad (Key : String)
    is
       H : constant Help_Line_Access := Search (Key);
       T : Help_Line_Access := H;
@@ -370,7 +373,7 @@ package body Sample.Explanation is
    begin
       if H /= null then
          loop
-            T := T.Next;
+            T := T.all.Next;
             exit when T = null;
             N := N + 1;
          end loop;
@@ -390,9 +393,9 @@ package body Sample.Explanation is
          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;
-            T := T.Next;
+            T := T.all.Next;
             exit when T = null;
          end loop;
          T := H;
@@ -402,7 +405,26 @@ package body Sample.Explanation is
       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
-   Open (F, In_File, File_Name);
+   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."
+                );
+      raise Name_Error;
+   end if;
 end Sample.Explanation;
-