------------------------------------------------------------------------------- -- -- -- Ada Interface to the X Window System and Motif(tm)/Lesstif -- -- Copyright (c) 1996-2002 Hans-Frieder Vogt -- -- -- -- This program 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. -- -- -- -- -- -- X Window System is copyrighted by the X Consortium -- -- Motif(tm) is copyrighted by the Open Software Foundation, Inc. -- -- -- -- -- ------------------------------------------------------------------------------- ------------------------------------------------------------------------------- -- -- HISTORY: -- adapted 25.1.98 to adabindx 0.5 -- 20 Jan 2002 H.-F. Vogt: Speed up of reading in text -- improved user interface (new function -- Line_For, modified Actualize_Status, -- About_CB) -- ------------------------------------------------------------------------------- with Ada.Characters.Latin_1, Xm_Widgets.Primitive.Text, Xm_Widgets.Primitive.Label, Xm_Widgets.Manager.Bulletin_Board.Message_Box; use Ada.Characters.Latin_1, Xm_Widgets.Primitive.Text, Xm_Widgets.Primitive.Label, Xm_Widgets.Manager.Bulletin_Board.Message_Box; package body XmMore_Global is Insert_Pos : Long_Integer := 0; Try_1 : Natural := 1; function Line_For (Pos : in Long_Integer) return Natural is Lower, Upper : Natural; begin -- find the row/column info -- use a binary search -- Lower := 1; Upper := Lines; while not (Pos >= Line_Array (Try_1) and then Pos < Line_Array (Try_1 + 1)) loop if Pos >= Line_Array (Try_1 + 1) then Lower := Try_1 + 1; else Upper := Try_1; end if; Try_1 := (Lower + Upper) / 2; end loop; return Try_1; end Line_For; procedure Actualize_Status (Cur_Pos : in Long_Integer) is Status_String : Xm_String; begin Argl := Null_Arg_List; Append_Set (Argl, Xm_Widgets.Primitive.Label.Xm_N_Label_Type, Is_String); if Array_Completed then if Cur_Pos >= Characters then Status_String := Xm_String_Create_L_To_R (File_Name (1 .. File_Name_L) & " (" & Long_Integer'Image (Characters) & " bytes)" & " v " & Natural'Image (Lines+1) & ", > 0", Xm_String_ISO8859_1); else Try_1 := Line_For (Cur_Pos + 1); Status_String := Xm_String_Create_L_To_R (File_Name (1 .. File_Name_L) & " (" & Long_Integer'Image (Characters) & " bytes)" & " v " & Natural'Image (Try_1) & ", > " & Natural'Image (Natural (Cur_Pos + 1 - Line_Array (Try_1))), Xm_String_ISO8859_1); end if; else Status_String := Xm_String_Create_L_To_R (File_Name (1 .. File_Name_L) & " (" & Long_Integer'Image (Characters) & " bytes)" & " v 1, > 0", Xm_String_ISO8859_1); end if; Append_Set (Argl, Xm_Widgets.Primitive.Label.Xm_N_Label_String, Status_String); Xt_Set_Values (The_Status, Argl); Xm_String_Free (Status_String); Insert_Pos := Cur_Pos; end Actualize_Status; procedure About_CB (W : in Widget; Closure : Xt_Pointer; Call_Data : Xt_Pointer) is Button : Widget; About_Text : constant String := "XmMore -- a *tif version of more" & LF & "(c)1996-2002 Hans-Frieder Vogt" & LF & "(example program for Ada interface to Motif(tm))"; About_String : Xm_String; begin if About_Dialog = Null_Widget then About_Dialog := Xm_Create_Information_Dialog (Appshell, "about_dialog"); About_String := Xm_String_Create_L_To_R (About_Text, Xm_String_ISO8859_1); Argl := Null_Arg_List; Append_Set (Argl, Xm_N_Message_String, About_String); Xt_Set_Values (About_Dialog, Argl); Xm_String_Free (About_String); Button := Xt_Name_To_Widget (About_Dialog, Cancel_Button_Name); Xt_Unmanage_Child (Button); Button := Xt_Name_To_Widget (About_Dialog, Help_Button_Name); Xt_Unmanage_Child (Button); Xt_Manage_Child (About_Dialog); else if not Xt_Is_Managed (About_Dialog) then Xt_Manage_Child (About_Dialog); end if; end if; end About_CB; procedure Quit_CB (W : in Widget; Closure : Xt_Pointer; Call_Data : Xt_Pointer) is begin raise Leave_XmMore; end Quit_CB; procedure Text_CB (W : in Widget; Closure : Xt_Pointer; Call_Data : Xt_Pointer) is Callback_Str : Xm_Text_Verify_Callback_Struct_Access; begin Callback_Str := To_Callback_Struct (Call_Data); Actualize_Status (Long_Integer (Callback_Str.New_Insert)); end Text_CB; end XmMore_Global;