X-Git-Url: https://ncurses.scripts.mit.edu/?p=ncurses.git;a=blobdiff_plain;f=Ada95%2Fsamples%2Fsample-explanation.adb;h=5587099b242a0883145275092164cd75a8eaf61e;hp=8701925dedf3e2066e936e97239c2beab1e0d4b1;hb=fd52bfa49753d67673ba8d7aef9239f5b16c1ad0;hpb=0eb88fc5281804773e2a0c7a488a4452463535ce;ds=inline diff --git a/Ada95/samples/sample-explanation.adb b/Ada95/samples/sample-explanation.adb index 8701925d..5587099b 100644 --- a/Ada95/samples/sample-explanation.adb +++ b/Ada95/samples/sample-explanation.adb @@ -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 -- @@ -33,9 +33,10 @@ -- sale, use or other dealings in this Software without prior written -- -- authorization. -- ------------------------------------------------------------------------------ --- Author: Juergen Pfeifer 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; -