X-Git-Url: https://ncurses.scripts.mit.edu/?p=ncurses.git;a=blobdiff_plain;f=Ada95%2Fsamples%2Fsample-explanation.adb;h=a2d18226fc3d5bbd886be2c79b3d806ed1d31e5d;hp=3129dfd76a742b15d7ab4fa274db2e7306d8edf3;hb=0237f10a296593d54fd8b2aa144921983085e002;hpb=f36e772702d4b512a4395e2db96470803485b6df diff --git a/Ada95/samples/sample-explanation.adb b/Ada95/samples/sample-explanation.adb index 3129dfd7..a2d18226 100644 --- a/Ada95/samples/sample-explanation.adb +++ b/Ada95/samples/sample-explanation.adb @@ -7,7 +7,7 @@ -- B O D Y -- -- -- ------------------------------------------------------------------------------ --- Copyright (c) 1998-2006,2009 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 -- @@ -35,8 +35,8 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control --- $Revision: 1.21 $ --- $Date: 2009/12/26 17:38:58 $ +-- $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 @@ -58,7 +58,7 @@ package body Sample.Explanation is Help_Keys : constant String := "HELPKEYS"; In_Help : constant String := "INHELP"; - File_Name : constant String := "explain.msg"; + File_Name : constant String := "explain.txt"; F : File_Type; type Help_Line; @@ -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 Check_File (Name : String) return Boolean; + 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, "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 @@ -135,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; @@ -181,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 @@ -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 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; @@ -319,8 +321,10 @@ package body Sample.Explanation is 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) = '#'; @@ -330,8 +334,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; @@ -347,8 +351,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; @@ -371,7 +375,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; @@ -391,9 +395,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; @@ -403,6 +407,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;