------------------------------------------------------------------------------- -- -- -- 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: -- June 20, 1998 begin of history -- Nov 14, 1998 HFVogt: adapted to new Widget_List -- 20 Jan 2002 H.-F. Vogt: Speed up of reading in text -- improved user interface -- ------------------------------------------------------------------------------- with Ada.Text_Io, Ada.Characters.Latin_1, Ada.Unchecked_Deallocation, X_Command_Line, -- X_Lib.Tasking, X_Toolkit, Xm_Widgets.Manager.Row_Column, Xm_Widgets.Manager.Scrolled_Window.Main_Window, Xm_Widgets.Primitive.Label.Cascade_Button, Xm_Widgets.Primitive.Label.Push_Button, Xm_Widgets.Primitive.Separator, Xm_Widgets.Primitive.Text, Xmmore_Global, Fallback; use Ada.Text_Io, Ada.Characters.Latin_1, X_Command_Line, X_Toolkit, Xm_Widgets, Xm_Widgets.Manager.Row_Column, Xm_Widgets.Manager.Scrolled_Window, Xm_Widgets.Manager.Scrolled_Window.Main_Window, Xm_Widgets.Primitive.Label, Xm_Widgets.Primitive.Label.Cascade_Button, Xm_Widgets.Primitive.Label.Push_Button, Xm_Widgets.Primitive.Separator, Xm_Widgets.Primitive.Text, XmMore_Global; procedure XmMore is procedure Free is new Ada.Unchecked_Deallocation (Long_Array, Long_Array_Access); Buffer : String (1 .. 1024); Buffer_L : Natural; Str : String (1 .. 100*1024); Str_L : Natural := 0; Insert_Pos : Xm_Text_Position; Tmp_Line_Array : Long_Array_Access; procedure Init_File_Menu is Menu, Pane, Exit_Btn : Widget; begin Pane := Xm_Create_Pulldown_Menu (The_Menu_Bar, "file_pane"); Exit_Btn := Xm_Create_Push_Button (Pane, "file_exit"); Xt_Manage_Child (Exit_Btn); Argl := Null_Arg_List; Append_Set (Argl, Xm_Widgets.Primitive.Label.Cascade_Button.Xm_N_Sub_Menu_Id, Pane); Menu := Xm_Create_Cascade_Button (The_Menu_Bar, "file_menu", Argl); Xt_Manage_Child (Menu); -- install the callbacks Xt_Add_Callback (Exit_Btn, Xm_Widgets.Primitive.Label.Push_Button.Xm_N_Activate_Callback, Quit_CB'Access); end Init_File_Menu; procedure Init_Help_Menu is Menu, Pane, About_Btn : Widget; begin Pane := Xm_Create_Pulldown_Menu (The_Menu_Bar, "help_pane"); About_Btn := Xm_Create_Push_Button (Pane, "help_about"); Xt_Manage_Child (About_Btn); Argl := Null_Arg_List; Append_Set (Argl, Xm_Widgets.Primitive.Label.Cascade_Button.Xm_N_Sub_Menu_Id, Pane); Menu := Xm_Create_Cascade_Button (The_Menu_Bar, "help_menu", Argl); Xt_Manage_Child (Menu); Argl := Null_Arg_List; Append_Set (Argl, Xm_N_Menu_Help_Widget, Menu); Xt_Set_Values (The_Menu_Bar, Argl); Xt_Add_Callback (About_Btn, Xm_Widgets.Primitive.Label.Push_Button.Xm_N_Activate_Callback, About_CB'Access); end Init_Help_Menu; procedure Init_Menu_Bar is begin The_Menu_Bar := Xm_Create_Menu_Bar (The_Main, "menubar"); Xt_Manage_Child (The_Menu_Bar); Init_File_Menu; Init_Help_Menu; end Init_Menu_Bar; procedure Init_Work_Area is begin Argl := Null_Arg_List; Append_Set (Argl, Xm_N_Edit_Mode, Multi_Line_Edit); Append_Set (Argl, Xm_N_Editable, False); Append_Set (Argl, Xm_N_Cursor_Position_Visible, True); The_Text := Xm_Create_Scrolled_Text (The_Main, "text", Argl); Xt_Manage_Child (The_Text); -- set default size Argl := Null_Arg_List; Append_Set (Argl, Xm_N_Columns, Integer'(80)); Append_Set (Argl, Xm_N_Rows, Integer'(30)); Xt_Set_Values (The_Text, Argl); -- install the callbacks Xt_Add_Callback (The_Text, Xm_N_Motion_Verify_Callback, Text_CB'Access); end Init_Work_Area; procedure Init_Status is begin The_Status := Xm_Create_Label (The_Main, "status"); Xt_Manage_Child (The_Status); -- set default alignment Argl := Null_Arg_List; Append_Set (Argl, Xm_N_Alignment, Alignment_Beginning); Xt_Set_Values (The_Status, Argl); end Init_Status; begin -- X_Lib.Tasking.Resource.Seize; Xt_App_Initialize (Appshell, App_Con, "XmMore", Fallback_Resources => Fallback.XmMore_Fallback); Display := Xt_Display (Appshell); The_Main := Xm_Create_Main_Window (Appshell, "mainwin"); Xt_Manage_Child (The_Main); Init_Menu_Bar; Init_Work_Area; Init_Status; Xm_Main_Window_Set_Areas (The_Main, The_Menu_Bar, The_Status, Null_Widget, Null_Widget, Xt_Parent (The_Text)); if Argument_Count > 1 then Put_Line (Standard_Error, "WARNING: too many arguments!"); end if; if Argument_Count > 0 then declare Filename : constant String := Argument (1); Input_File : File_Type; begin File_Name_L := Filename'Length; File_Name (1 .. File_Name_L) := Filename; Open (Input_File, In_File, Filename); Set_Input (Input_File); exception when others => Put_Line (Standard_Error, "ERROR: couldn't open file """ & Filename & """"); raise; end; else File_Name_L := 14; File_Name (1 .. File_Name_L) := "Standard Input"; end if; -- read in the text -- Line_Array := new Long_Array (1 .. 1000); while not End_Of_File loop Get_Line (Buffer, Buffer_L); -- if our main buffer hasn't enough space left, first flush it -- if Str_L + Buffer_L + 1 > Str'Length then Insert_Pos := Xm_Text_Get_Insertion_Position (The_Text); Xm_Text_Insert (The_Text, Insert_Pos, Str (1 .. Str_L)); Str_L := 0; end if; Str (Str_L+1 .. Str_L + Buffer_L + 1) := Buffer (1 .. Buffer_L) & LF; if Line_Array.all'Length <= Lines then Tmp_Line_Array := Line_Array; Line_Array := new Long_Array (1 .. Tmp_Line_Array.all'Length + 100); Line_Array.all (1 .. Tmp_Line_Array.all'Length) := Tmp_Line_Array.all (1 .. Tmp_Line_Array.all'Length); Free (Tmp_Line_Array); end if; Line_Array.all (Lines+1) := Characters + 1; Str_L := Str_L + Buffer_L + 1; Characters := Characters + Long_Integer (Buffer_L) + 1; Lines := Lines + 1; end loop; if Str_L > 0 then Insert_Pos := Xm_Text_Get_Insertion_Position (The_Text); Xm_Text_Insert (The_Text, Insert_Pos, Str (1 .. Str_L)); end if; -- we need a dummy line in the array -- if Line_Array.all'Length <= Lines then Tmp_Line_Array := Line_Array; Line_Array := new Long_Array (1 .. Tmp_Line_Array.all'Length + 1000); Line_Array.all (1 .. Tmp_Line_Array.all'Length) := Tmp_Line_Array.all (1 .. Tmp_Line_Array.all'Length); Free (Tmp_Line_Array); end if; Line_Array.all (Lines+1) := Characters + 1; Ada.Text_Io.Put_Line ("found " & Natural'Image (Lines) & " lines and " & Long_Integer'Image (Characters) & " characters"); Array_Completed := True; Xm_Text_Show_Position (The_Text, 0); Actualize_Status (0); Xt_Realize_Widget (Appshell); Xt_App_Main_Loop (App_Con); exception when Leave_XmMore => null; end XmMore;