------------------------------------------------------------------------------ -- -- -- XVIEW ADA LIBRARY COMPONENTS -- -- -- -- XVIEW_TEXTSW_PACKAGE -- -- -- -- B o d y -- -- -- -- Copyright (c) 1995 Andreas Almroth, All Rights Reserved -- -- -- -- The XVIEW ADA library is free software; you can redistribute it and/or -- -- modify it under terms of the GNU Library General Public License as -- -- published by the Free Software Foundation; either version 2, or (at your -- -- option) any later version. The XVIEW ADA library 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 Library General Public License for more details. -- -- You should have received a copy of the GNU Library General Public -- -- License along with the XVIEW ADA library; see the file COPYING.LIB. If -- -- not, write to the Free Software Foundation, 675 Mass Ave, Cambridge, -- -- MA 02139, USA. -- -- -- ------------------------------------------------------------------------------ -- Lots of bindings to XView C functions needs the Interfaces.C package. with Interfaces.C,Interfaces.C.Strings; package body Xv_Textsw_Package is XV_SHOW : constant := 1079052545; XV_WIDTH : constant := 1246234689; XV_HEIGHT : constant := 1246300289; XV_X : constant := 1246103617; XV_Y : constant := 1246169217; TEXTSW_FILE : constant := 1461717345; TEXTSW_LENGTH : constant := 1463158785; TEXTSW_FONT : constant := 1245710849; TEXTSW_STATUS : constant := 1464338945; TEXTSW_FIRST : constant := 1462241281; TEXTSW_MODIFIED : constant := 1463683329; TEXTSW_INSERTION_POINT : constant := 1462765569; TEXTSW_UNIT_IS_CHAR : constant := 1073741825; TEXTSW_UNIT_IS_WORD : constant := 1073741826; TEXTSW_UNIT_IS_LINE : constant := 1073742081; TEXTSW_FILE_CONTENTS : constant := 1461979489; TEXTSW_CONTENTS : constant := 1460799841; TEXTSW_INSERT_FROM_FILE : constant := 1462896993; TEXTSW_LINE_BREAK_ACTION : constant := 1463290145; Status : aliased Integer; Top_Value : aliased Integer; Bottom_Value : aliased Integer; Start_Value : aliased Integer; Finish_Value : aliased Integer; ----------------------------------------------------------------------------- function xv_set (owner : Xv_opaque; cmd : Integer; data : Integer; term : Integer) return Xv_object; pragma import (C,xv_set,"xv_set"); function xv_set (owner : Xv_opaque; cmd : Integer; data1: Int_Ptr; cmd2 : Integer; data2 : Interfaces.C.char_array; Cmd3 : Integer; Data3 : Integer; term : Integer) return Xv_object; pragma import (C,xv_set,"xv_set"); function xv_set (owner : Xv_opaque; cmd : Integer; data1: Int_Ptr; data2 : Interfaces.C.char_array; term : Integer) return Xv_object; pragma import (C,xv_set,"xv_set"); function xv_set (owner : Xv_opaque; cmd : Integer; data2 : Interfaces.C.char_array; Data3 : Integer; term : Integer) return Xv_object; pragma import (C,xv_set,"xv_set"); function xv_set (owner : Xv_Opaque; Cmd : Integer; Func : Callback_Textsw_Ptr; Term : Integer) return Xv_object; pragma import (C,xv_set,"xv_set"); ----------------------------------------------------------------------------- procedure xv_destroy_safe (object : Xv_Opaque); pragma import (C,xv_destroy_safe,"xv_destroy_safe"); ----------------------------------------------------------------------------- function xv_get (owner : Xv_opaque; cmd : Integer; term : Integer) return Integer; pragma import (C,xv_get,"xv_get"); function xv_get (owner : Xv_opaque; cmd : Integer; Data1 : Integer; Data2 : Interfaces.C.Char_Array; Len : Integer; term : Integer) return Integer; pragma import (C,xv_get,"xv_get"); ----------------------------------------------------------------------------- function Textsw_Edit (Obj : Textsw; Unit, Count, Direction : Integer) return Textsw_Index; pragma Import (C,Textsw_Edit,"textsw_edit"); ----------------------------------------------------------------------------- ----------------------------------------------------------------------------- -- xv_textsw ----------------------------------------------------------------------------- ----------------------------------------------------------------------------- procedure Initialize (V : in out Xv_Textsw) is -- Declare C binding for xv_create function Xv_Create (Owner : Frame; Pkg : Xv_Pkg_Ptr; Term : Integer) return Textsw; pragma Import (C,Xv_Create,"xv_create"); -- Initialize panel_base pointer Xv_Textsw_Pkg : Xv_Pkg_Ptr; pragma Import (C,Xv_Textsw_pkg,"my_xv_textsw_pkg"); begin V.Base := Xv_Create(V.Parent,Xv_Textsw_pkg,0); end Initialize; ----------------------------------------------------------------------------- procedure Finalize (V : in out Xv_Textsw) is begin Xv_Destroy_Safe(Xv_Opaque(V.Base)); end Finalize; ----------------------------------------------------------------------------- procedure Set_Pos (V : in Xv_Textsw; X,Y : Integer) is Xv_Rc : Xv_Object; begin Xv_Rc := Xv_Set(Xv_Opaque(V.Base),XV_X,X,0); Xv_Rc := Xv_Set(Xv_Opaque(V.Base),XV_Y,Y,0); end Set_Pos; ----------------------------------------------------------------------------- procedure Set_Size (V : in Xv_Textsw; W,H : Integer) is Xv_Rc : Xv_Object; begin Xv_Rc := Xv_Set(Xv_Opaque(V.base),XV_WIDTH,W,0); Xv_Rc := Xv_Set(Xv_Opaque(V.base),XV_HEIGHT,H,0); end Set_Size; ----------------------------------------------------------------------------- function Get_Textsw (V : in Xv_Textsw) return Textsw is begin return V.Base; end Get_Textsw; ----------------------------------------------------------------------------- function Load_File (V : in Xv_Textsw; File_Name : String; Position : Integer) return Boolean is Xv_Rc : Xv_Object; begin Xv_Rc := Xv_Set(Xv_Opaque(V.Base),TEXTSW_STATUS,Status'access, TEXTSW_FILE,Interfaces.C.To_C(File_Name,True), TEXTSW_FIRST,Position,0); if Status = 0 then return True; else return False; end if; end Load_File; ----------------------------------------------------------------------------- function Save_File (V : in Xv_Textsw) return Boolean is function Textsw_Save (Obj : Textsw; Loc_X, Loc_Y : Integer) return Integer; pragma Import (C,Textsw_Save,"textsw_save"); Xv_Rc : Integer; begin Xv_Rc := Textsw_Save(V.Base,0,0); if Xv_Rc = 0 then return True; else return False; end if; end Save_File; ----------------------------------------------------------------------------- function Store_File (V : in Xv_Textsw; File_Name : String) return Boolean is function Textsw_Store (Obj : Textsw; Filename : Interfaces.C.Char_Array; Loc_X, Loc_Y : Integer) return Integer; pragma Import (C,Textsw_Store,"textsw_store_file"); Xv_Rc : Integer; begin Xv_Rc := Textsw_Store(V.Base,Interfaces.C.To_C(File_Name,True),0,0); if Xv_Rc = 0 then return True; else return False; end if; end Store_File; ----------------------------------------------------------------------------- procedure Discard (V : in Xv_Textsw) is procedure Textsw_Reset (Obj : Textsw; Loc_X, Loc_Y : Integer); pragma Import (C,Textsw_Reset,"textsw_reset"); begin Textsw_Reset(V.Base,0,0); end Discard; ----------------------------------------------------------------------------- function Is_Modified (V : in Xv_Textsw) return Boolean is Xv_Rc : Integer; begin Xv_Rc := Xv_Get(Xv_Opaque(V.Base),TEXTSW_MODIFIED,0); if Xv_Rc = 0 then return False; else return True; end if; end Is_Modified; ----------------------------------------------------------------------------- function Insert_Text (V : in Xv_Textsw; Txt : String) return Textsw_Index is function Textsw_Insert (Obj : Textsw; Txt : Interfaces.C.Char_Array; Length : Integer) return Textsw_Index; pragma Import (C,Textsw_Insert,"textsw_insert"); begin return Textsw_Insert(V.Base,Interfaces.C.To_C(Txt,True),Txt'Last); end Insert_Text; ----------------------------------------------------------------------------- procedure Move_Point (V : in Xv_Textsw; Position : Textsw_Index) is procedure Textsw_Possibly_normalize (Obj : Textsw; Position : Integer); pragma Import (C,Textsw_Possibly_Normalize,"textsw_possibly_normalize"); Xv_Rc : Xv_Object; begin Xv_Rc := Xv_Set(Xv_Opaque(V.Base),TEXTSW_INSERTION_POINT, Integer(Position),0); Textsw_Possibly_Normalize(V.Base,Integer(Position)); end Move_Point; ----------------------------------------------------------------------------- function Get_Point (V : in Xv_Textsw) return Textsw_Index is begin return Textsw_Index(Xv_Get(Xv_Opaque(V.Base),TEXTSW_INSERTION_POINT,0)); end Get_Point; ----------------------------------------------------------------------------- function Delete_Text (V : in Xv_Textsw; First, Last : Textsw_Index) return Textsw_Index is function Textsw_Delete (Obj : Textsw; First, Last : Integer) return Textsw_Index; pragma Import (C,Textsw_Delete,"textsw_delete"); begin return Textsw_Delete(V.Base,Integer(First),Integer(Last) + 1); end Delete_Text; ----------------------------------------------------------------------------- function Delete_Char (V : in Xv_Textsw; Count, Direction : Integer) return Textsw_Index is begin return Textsw_Edit(V.Base,TEXTSW_UNIT_IS_CHAR,Count,Direction); end Delete_Char; ----------------------------------------------------------------------------- function Delete_Word (V : in Xv_Textsw; Count, Direction : Integer) return Textsw_Index is begin return Textsw_Edit(V.Base,TEXTSW_UNIT_IS_WORD,Count,Direction); end Delete_Word; ----------------------------------------------------------------------------- function Delete_Line (V : in Xv_Textsw; Count, Direction : Integer) return Textsw_Index is begin return Textsw_Edit(V.Base,TEXTSW_UNIT_IS_LINE,Count,Direction); end Delete_Line; ----------------------------------------------------------------------------- function Replace_Text (V : in Xv_Textsw; First, Last : Textsw_Index; Txt : String) return Textsw_Index is function Textsw_Replace_bytes (Obj : Textsw; First, Last : Integer; Txt : Interfaces.C.Char_Array; Length : Integer) return Textsw_Index; pragma Import (C,Textsw_Replace_Bytes,"textsw_replace_bytes"); begin return Textsw_Replace_Bytes(V.Base,Integer(First),Integer(Last) + 1, Interfaces.C.To_C(Txt,True),Txt'Last); end Replace_Text; ----------------------------------------------------------------------------- function Get_Text_Size (V : in Xv_Textsw) return Textsw_Index is begin return Textsw_Index(Xv_Get(Xv_Opaque(V.Base),TEXTSW_LENGTH,0)); end Get_Text_Size; ----------------------------------------------------------------------------- procedure Set_Font (V : in Xv_Textsw; Fnt : Font)is Xv_Rc : Xv_Object; begin Xv_Rc := Xv_Set(Xv_Opaque(V.Base),TEXTSW_FONT,Integer(Fnt),0); end Set_Font; ----------------------------------------------------------------------------- procedure File_Contents (V : in Xv_Textsw; File_Name : String; Position : Integer) is Xv_Rc : Xv_Object; begin Xv_Rc := Xv_Set(Xv_Opaque(V.Base),TEXTSW_FILE_CONTENTS, Interfaces.C.To_C(File_Name,True),Position,0); end File_Contents; ----------------------------------------------------------------------------- procedure Contents (V : in Xv_Textsw; Txt : String; Position : Integer) is Xv_Rc : Xv_Object; begin Xv_Rc := Xv_Set(Xv_Opaque(V.Base),TEXTSW_CONTENTS, Interfaces.C.To_C(Txt,True),Position,0); end Contents; ----------------------------------------------------------------------------- function Get_Contents (V : in Xv_Textsw; From : Textsw_Index; Max_Len : Integer) return String is Xv_Rc : Integer; Work : Interfaces.C.Char_Array(1..Interfaces.C.Size_T(Max_Len)); begin Xv_Rc := Xv_Get(Xv_Opaque(V.Base),TEXTSW_CONTENTS,Integer(From), Work,Max_Len + 1,0); return Interfaces.C.To_Ada(Work); end Get_Contents; ----------------------------------------------------------------------------- function Insert_File (V : in Xv_Textsw; File_Name : String) return Boolean is Xv_Rc : Xv_Object; begin Xv_Rc := Xv_Set(Xv_Opaque(V.Base),TEXTSW_INSERT_FROM_FILE,Status'Access, Interfaces.C.To_C(File_Name,True),0); if Status = 0 then return True; else return False; end if; end Insert_File; ----------------------------------------------------------------------------- procedure Set_Line_Break (V : in Xv_Textsw; State : Boolean) is Xv_Rc : Xv_Object; begin if State = True then Xv_Rc := Xv_Set(Xv_Opaque(V.Base),TEXTSW_LINE_BREAK_ACTION,Integer(5),0); else Xv_Rc := Xv_Set(Xv_Opaque(V.Base),TEXTSW_LINE_BREAK_ACTION,Integer(6),0); end if; end Set_Line_Break; ----------------------------------------------------------------------------- procedure Scroll_Line (V : in Xv_Textsw; Lines: Integer) is procedure Textsw_Scroll_Lines (Obj : Textsw; Lines : Integer); pragma Import (C,Textsw_Scroll_Lines,"textsw_scroll_lines"); begin Textsw_Scroll_Lines(V.Base,Lines); end Scroll_Line; ----------------------------------------------------------------------------- function Get_Screen_Lines (V : in Xv_Textsw) return Integer is function Textsw_Screen_Line_Count (Obj : Textsw) return Integer; pragma Import (C,Textsw_Screen_Line_Count,"textsw_screen_line_count"); begin return Textsw_Screen_Line_Count(V.Base); end Get_Screen_Lines; ----------------------------------------------------------------------------- procedure Get_Visible_File_Lines (V : in Xv_Textsw; Top : in out Integer; Bottom : in out Integer) is procedure Textsw_File_Lines_Visible (Obj : Textsw; Top,bottom : Int_Ptr); pragma Import (C,Textsw_File_Lines_visible,"textsw_file_lines_visible"); begin Textsw_File_Lines_Visible(V.Base,Top_Value'access,Bottom_Value'access); Top := Top_Value; Bottom := Bottom_Value; end Get_Visible_File_Lines; ----------------------------------------------------------------------------- procedure Find_Text (V : in Xv_Textsw; Start : in out Textsw_Index; Finish : in out Textsw_Index; Txt : String) is function Textsw_Find_Bytes (Obj : Textsw; Start, Finish : Int_Ptr; Txt : Interfaces.C.Char_Array; Buf_Len : Integer) return Integer; pragma Import (C,Textsw_Find_Bytes,"textsw_find_bytes"); Xv_Rc : Integer; begin Xv_Rc := Textsw_Find_Bytes(V.Base,Start_Value'access,Finish_Value'Access, Interfaces.C.To_C(Txt,True),Txt'Length); if Xv_Rc > -1 then Start := Textsw_Index(Start_Value); Finish := Textsw_Index(Finish_Value); else Start := -1; Finish := -1; end if; end Find_Text; end Xv_Textsw_Package;