----------------------------------------------------------------------- -- GtkAda - Ada95 binding for Gtk+/Gnome -- -- -- -- Copyright (C) 2002-2010, AdaCore -- -- -- -- This library 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 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 -- -- General Public License for more details. -- -- -- -- You should have received a copy of the GNU General Public -- -- License along with this library; if not, write to the -- -- Free Software Foundation, Inc., 59 Temple Place - Suite 330, -- -- Boston, MA 02111-1307, USA. -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- ----------------------------------------------------------------------- with Gtkada.C; use Gtkada.C; with Gdk.Types; use Gdk.Types; with Interfaces.C.Strings; use Interfaces.C.Strings; with Gtk.Selection; use Gtk.Selection; with Gtkada.Types; with System; use System; package body Gtk.Clipboard is package Atom_Arrays is new Gtkada.C.Unbounded_Arrays (Gdk.Types.Gdk_Atom, Gdk.Types.Gdk_None, Natural, Gdk.Types.Gdk_Atom_Array); --------------- -- Set_Image -- --------------- procedure Set_Image (Clipboard : Gtk_Clipboard; Pixbuf : Gdk.Pixbuf.Gdk_Pixbuf) is procedure Internal (Clipboard : Gtk_Clipboard; Pixbuf : System.Address); pragma Import (C, Internal, "gtk_clipboard_set_image"); begin Internal (Clipboard, Get_Object (Pixbuf)); end Set_Image; -------------- -- Set_Text -- -------------- procedure Set_Text (Clipboard : Gtk_Clipboard; Text : UTF8_String) is procedure Internal (Clipboard : Gtk_Clipboard; Str : UTF8_String; Len : Integer); pragma Import (C, Internal, "gtk_clipboard_set_text"); begin Internal (Clipboard, Text, Text'Length); end Set_Text; -------------------- -- Wait_For_Image -- -------------------- function Wait_For_Image (Clipboard : Gtk_Clipboard) return Gdk.Pixbuf.Gdk_Pixbuf is function Internal (Clipboard : Gtk_Clipboard) return System.Address; pragma Import (C, Internal, "gtk_clipboard_wait_for_image"); begin return Gdk.Pixbuf.Convert (Internal (Clipboard)); end Wait_For_Image; ------------------- -- Wait_For_Text -- ------------------- function Wait_For_Text (Clipboard : Gtk_Clipboard) return UTF8_String is function Internal (Clipboard : Gtk_Clipboard) return chars_ptr; pragma Import (C, Internal, "gtk_clipboard_wait_for_text"); S : constant chars_ptr := Internal (Clipboard); begin if S /= Null_Ptr then declare Result : constant UTF8_String := Value (S); begin Gtkada.Types.g_free (S); return Result; end; end if; return ""; end Wait_For_Text; ---------------------------- -- Wait_Is_Text_Available -- ---------------------------- function Wait_Is_Text_Available (Clipboard : Gtk_Clipboard) return Boolean is function Internal (Clipboard : Gtk_Clipboard) return Gboolean; pragma Import (C, Internal, "gtk_clipboard_wait_is_text_available"); begin return Internal (Clipboard) /= 0; end Wait_Is_Text_Available; --------------- -- Get_Owner -- --------------- function Get_Owner (Clipboard : Gtk_Clipboard) return Glib.Object.GObject is function Internal (Clipboard : Gtk_Clipboard) return System.Address; pragma Import (C, Internal, "gtk_clipboard_get_owner"); Stub : GObject_Record; begin return Get_User_Data (Internal (Clipboard), Stub); end Get_Owner; ------------------- -- Set_Can_Store -- ------------------- procedure Set_Can_Store (Clipboard : Gtk_Clipboard; Targets : Gtk.Selection.Target_Entry_Array) is procedure Internal (Clipboard : Gtk_Clipboard; Targets : System.Address; N_Targets : Gint); pragma Import (C, Internal, "gtk_clipboard_set_can_store"); begin if Targets'Length = 0 then Internal (Clipboard, System.Null_Address, 0); else Internal (Clipboard, Targets (Targets'First)'Address, Targets'Length); end if; end Set_Can_Store; ------------------- -- Set_With_Data -- ------------------- function Set_With_Data (Clipboard : Gtk_Clipboard; Targets : Target_Entry_Array; Get_Func : Gtk_Clipboard_Get_Func; Clear_Func : Gtk_Clipboard_Clear_Func; User_Data : System.Address) return Boolean is function Internal (Clipboard : Gtk_Clipboard; Targets : System.Address; N_Targets : Guint; Get_Func : Gtk_Clipboard_Get_Func; Clear_Func : Gtk_Clipboard_Clear_Func; User_Data : System.Address) return Gboolean; pragma Import (C, Internal, "gtk_clipboard_set_with_data"); begin return Boolean'Val (Internal (Clipboard, Targets (Targets'First)'Address, Targets'Length, Get_Func, Clear_Func, User_Data)); end Set_With_Data; -------------------- -- Set_With_Owner -- -------------------- function Set_With_Owner (Clipboard : Gtk_Clipboard; Targets : Target_Entry_Array; Get_Func : Gtk_Clipboard_Get_Func; Clear_Func : Gtk_Clipboard_Clear_Func; Owner : access Glib.Object.GObject_Record'Class) return Boolean is function Internal (Clipboard : Gtk_Clipboard; Targets : System.Address; N_Targets : Guint; Get_Func : Gtk_Clipboard_Get_Func; Clear_Func : Gtk_Clipboard_Clear_Func; Owner : System.Address) return Gboolean; pragma Import (C, Internal, "gtk_clipboard_set_with_owner"); begin return Boolean'Val (Internal (Clipboard, Targets (Targets'First)'Address, Targets'Length, Get_Func, Clear_Func, Get_Object (Owner))); end Set_With_Owner; ------------------- -- Get_Clipboard -- ------------------- function Get_Clipboard (Widget : access Gtk.Widget.Gtk_Widget_Record'Class; Selection : Gdk.Types.Gdk_Atom) return Gtk_Clipboard is function Internal (Widget : System.Address; Selection : Gdk_Atom) return Gtk_Clipboard; pragma Import (C, Internal, "gtk_widget_get_clipboard"); -- External binding: gtk_widget_get_clipboard begin return Internal (Get_Object (Widget), Selection); end Get_Clipboard; ----------------------------- -- Wait_Is_Image_Available -- ----------------------------- function Wait_Is_Image_Available (Clipboard : Gtk_Clipboard) return Boolean is function Internal (Clipboard : Gtk_Clipboard) return Gboolean; pragma Import (C, Internal, "gtk_clipboard_wait_is_image_available"); begin return Boolean'Val (Internal (Clipboard)); end Wait_Is_Image_Available; ------------------------------ -- Wait_Is_Target_Available -- ------------------------------ function Wait_Is_Target_Available (Clipboard : Gtk_Clipboard; Target : Gdk_Atom) return Boolean is function Internal (Clipboard : Gtk_Clipboard; Target : Gdk_Atom) return Gboolean; pragma Import (C, Internal, "gtk_clipboard_wait_is_target_available"); begin return Boolean'Val (Internal (Clipboard, Target)); end Wait_Is_Target_Available; ---------------------- -- Wait_For_Targets -- ---------------------- function Wait_For_Targets (Clipboard : Gtk_Clipboard) return Gdk.Types.Gdk_Atom_Array is use Atom_Arrays; function Internal (Clipboard : Gtk_Clipboard; Targets : access Unbounded_Array_Access; N_Targets : access Gint) return Gboolean; pragma Import (C, Internal, "gtk_clipboard_wait_for_targets"); Output : aliased Unbounded_Array_Access; N_Targets : aliased Gint; begin if Internal (Clipboard, Output'Unchecked_Access, N_Targets'Unchecked_Access) = 0 then G_Free (Output); Output := null; end if; declare Result : constant Gdk_Atom_Array := To_Array (Output, Integer (N_Targets)); begin if Output /= null then G_Free (Output); end if; return Result; end; end Wait_For_Targets; ---------------------- -- Request_Contents -- ---------------------- procedure Request_Contents (Clipboard : Gtk_Clipboard; Target : Gdk_Atom; Callback : Gtk_Clipboard_Received_Func; User_Data : System.Address) is procedure Internal (Clipboard : Gtk_Clipboard; Target : Gdk_Atom; Callback : Gtk_Clipboard_Received_Func; User_Data : System.Address); pragma Import (C, Internal, "gtk_clipboard_request_contents"); begin Internal (Clipboard, Target, Callback, User_Data); end Request_Contents; --------------------- -- Request_Targets -- --------------------- procedure Request_Targets (Clipboard : Gtk_Clipboard; Callback : Gtk_Clipboard_Targets_Received_Func; User_Data : System.Address) is procedure Internal (Clipboard : Gtk_Clipboard; Callback : Gtk_Clipboard_Targets_Received_Func; User_Data : System.Address); pragma Import (C, Internal, "gtk_clipboard_request_targets"); begin Internal (Clipboard, Callback, User_Data); end Request_Targets; end Gtk.Clipboard;