----------------------------------------------------------------------- -- GtkAda - Ada95 binding for the Gimp Toolkit -- -- -- -- Copyright (C) 1998-2000 E. Briot, J. Brobecker and A. Charlet -- -- Copyright (C) 2000-2003 ACT-Europe -- -- -- -- 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 Glib; use Glib; with Gdk; use Gdk; with Gdk.Color; use Gdk.Color; with Gdk.Pixmap; use Gdk.Pixmap; with Gdk.Bitmap; use Gdk.Bitmap; with Gtk; use Gtk; with Gtk.Box; use Gtk.Box; with Gtk.Button; use Gtk.Button; with Gtk.Check_Button; use Gtk.Check_Button; with Gtk.Clist; use Gtk.Clist; with Gtk.Enums; use Gtk.Enums; with Gtk.Label; use Gtk.Label; with Gtk.Option_Menu; use Gtk.Option_Menu; with Gtk.Scrolled_Window; use Gtk.Scrolled_Window; with Gtk.Handlers; use Gtk.Handlers; with Gtk.Style; use Gtk.Style; with Gtk.Widget; use Gtk.Widget; with Gtkada.Types; use Gtkada.Types; with Pango.Font; use Pango.Font; with Common; use Common; with Interfaces.C.Strings; package body Create_Clist is package IC renames Interfaces.C; package ICS renames Interfaces.C.Strings; package Clist_Cb is new Handlers.Callback (Gtk_Clist_Record); package Check_Cb is new Handlers.User_Callback (Gtk_Check_Button_Record, Gtk_Clist); use type Interfaces.C.size_t; Clist_Columns : constant Interfaces.C.size_t := 12; Clist_Rows : Integer := 0; Style1 : Gtk_Style; Style2 : Gtk_Style; Style3 : Gtk_Style; Clist_Omenu_Group : Widget_SList.GSlist; Titles : constant Chars_Ptr_Array (1 .. Clist_Columns) := "Auto resize" + "Not resizable" + "Max width 100" + "Min Width 50" + "Hide column" + "Title 5" + "Title 6" + "Title 7" + "Title 8" + "Title 9" + "Title 10" + "Title 11"; -- Put at the library level to avoid having to allocate/free the -- memory each time "Run" is called... Items : constant Chars_Ptr_Array := "Single" + "Browse" + "Multiple" + "Extended"; ---------- -- Help -- ---------- function Help return String is begin return "!!!! Consider using a @bGtk_Tree_View@B instead !!!!" & ASCII.LF & ASCII.LF & "An @bGtk_Clist@B is like a @bGtk_List@B, except it shows the" & " information on multiple columns. You can have as many columns" & " as you want, each with its own information." & ASCII.LF & "Each line can have its own user_data, although the interface is" & " different from the standard interface. Some specific functions" & " are provided for this usage. The standard inheritance mechanism" & " does not work for rows in a clist, altough of course it does" & " work for the @bGtk_Clist@B itself."; end Help; ---------------- -- Clear_List -- ---------------- procedure Clear_List (List : access Gtk_Clist_Record'Class) is begin Clear (List); Clist_Rows := 0; end Clear_List; ---------------------- -- Remove_Selection -- ---------------------- procedure Remove_Selection (List : access Gtk_Clist_Record'Class) is use Gint_List; I : Gint; begin Freeze (List); loop exit when Length (Get_Selection (List)) = 0; Clist_Rows := Clist_Rows - 1; I := Get_Data (First (Get_Selection (List))); Remove (List, I); exit when Get_Selection_Mode (List) = Selection_Browse; end loop; Thaw (List); end Remove_Selection; ------------------- -- Toggle_Titles -- ------------------- procedure Toggle_Titles (Button : access Gtk_Check_Button_Record'Class; List : in Gtk_Clist) is begin if Get_Active (Button) then Column_Titles_Show (List); else Column_Titles_Hide (List); end if; end Toggle_Titles; ------------------------ -- Toggle_Reorderable -- ------------------------ procedure Toggle_Reorderable (Button : access Gtk_Check_Button_Record'Class; List : in Gtk_Clist) is begin Set_Reorderable (List, Get_Active (Button)); end Toggle_Reorderable; ------------- -- Add1000 -- ------------- procedure Add1000 (List : access Gtk_Clist_Record'Class) is Pixmap : Gdk.Gdk_Pixmap; Mask : Gdk.Gdk_Bitmap; Texts : Chars_Ptr_Array (0 .. Clist_Columns - 1); Row : Gint; Style : constant Gtk_Style := Get_Style (List); begin Create_From_Xpm_D (Pixmap, Get_Clist_Window (List), Mask, Get_White (Style), Gtk_Mini_Xpm); for I in 4 .. Clist_Columns - 1 loop Texts (I) := ICS.New_String ("Column" & IC.size_t'Image (I)); end loop; Texts (0 .. 3) := Null_Ptr + "Right" + "Center" + Null_Ptr; Freeze (List); for I in 0 .. 999 loop ICS.Free (Texts (0)); Texts (0) := ICS.New_String ("CListRow" & Integer'Image (I)); Row := Append (List, Texts); Set_Pixtext (List, Row, 3, "gtk+", 5, Pixmap, Mask); end loop; Clist_Rows := Clist_Rows + 1000; Free (Texts); Thaw (List); Gdk.Pixmap.Unref (Pixmap); Gdk.Bitmap.Unref (Mask); end Add1000; -------------- -- Add10000 -- -------------- procedure Add10000 (List : access Gtk_Clist_Record'Class) is Texts : Chars_Ptr_Array (0 .. Clist_Columns - 1); Row : Gint; pragma Unreferenced (Row); begin for I in 3 .. Clist_Columns - 1 loop Texts (I) := ICS.New_String ("Column" & IC.size_t'Image (I)); end loop; Texts (0 .. 2) := Null_Ptr + "Right" + "Center"; Freeze (List); for I in 0 .. 9999 loop ICS.Free (Texts (0)); Texts (0) := ICS.New_String ("Row" & Integer'Image (I)); Row := Append (List, Texts); end loop; Clist_Rows := Clist_Rows + 10000; Free (Texts); Thaw (List); end Add10000; ---------------- -- Insert_Row -- ---------------- procedure Insert_Row (List : access Gtk_Clist_Record'Class) is Texts : Chars_Ptr_Array (0 .. Clist_Columns - 1) := "This" + "is an" + "inserted" + "row" + "This" + "is an" + "inserted" + "row" + "This" + "is an" + "inserted" + "row"; Col1 : Gdk_Color; Col2 : Gdk_Color; Row : Gint; Style : constant Gtk_Style := Get_Style (List); begin Row := Prepend (List, Texts); if Style1 = Null_Style then Set_Rgb (Col1, 0, 56000, 0); Set_Rgb (Col2, 32000, 0, 56000); -- Note that the memory allocated here is never freed in this -- small example! Style1 := Copy (Style); Set_Base (Style1, State_Normal, Col1); Set_Base (Style1, State_Selected, Col2); Style2 := Copy (Style); Set_Foreground (Style2, State_Normal, Col1); Set_Foreground (Style2, State_Selected, Col2); Style3 := Copy (Style); Set_Foreground (Style3, State_Normal, Col1); Set_Base (Style3, State_Normal, Col2); Set_Font_Description (Style3, From_String ("Courier 120")); end if; Set_Cell_Style (List, Row, 3, Style1); Set_Cell_Style (List, Row, 4, Style2); Set_Cell_Style (List, Row, 0, Style3); Clist_Rows := Clist_Rows + 1; Free (Texts); end Insert_Row; -------------------- -- Undo_Selection -- -------------------- procedure Undo_Selection (List : access Gtk_Clist_Record'Class) is begin Gtk.Clist.Undo_Selection (List); end Undo_Selection; ------------------ -- Click_Column -- ------------------ procedure Click_Column (List : access Gtk_Clist_Record'Class; Column : Gint) is begin if Column = 4 then Set_Column_Visibility (List, Column, False); elsif Column = Get_Sort_Column (List) then if Get_Sort_Type (List) = Ascending then Set_Sort_Type (List, Descending); else Set_Sort_Type (List, Ascending); end if; else Set_Sort_Column (List, Column); end if; Sort (List); end Click_Column; --------- -- Run -- --------- procedure Run (Frame : access Gtk.Frame.Gtk_Frame_Record'Class) is Texts : Chars_Ptr_Array (0 .. Clist_Columns - 1); VBox, HBox : Gtk_Box; Clist : Gtk_Clist; Button : Gtk_Button; Label : Gtk_Label; New_Row : Gint; Scrolled : Gtk_Scrolled_Window; Check : Gtk_Check_Button; Omenu : Gtk_Option_Menu; Col1 : Gdk_Color; Col2 : Gdk_Color; Style : Gtk_Style; pragma Unreferenced (New_Row); begin Clist_Rows := 0; Set_Label (Frame, "Clist"); Gtk_New_Vbox (VBox, False, 0); Add (Frame, VBox); Gtk_New (Scrolled); Set_Border_Width (Scrolled, 5); Set_Policy (Scrolled, Policy_Automatic, Policy_Automatic); Gtk_New (Clist, Gint (Clist_Columns), Titles); Add (Scrolled, Clist); -- TBD: Callback for click column Gtk_New_Hbox (HBox, False, 5); Set_Border_Width (HBox, 5); Pack_Start (VBox, HBox, False, False, 0); Clist_Cb.Connect (Clist, "click_column", Clist_Cb.To_Marshaller (Click_Column'Access)); Gtk_New (Button, "Insert Row"); Pack_Start (HBox, Button, True, True, 0); Clist_Cb.Object_Connect (Button, "clicked", Clist_Cb.To_Marshaller (Insert_Row'Access), Slot_Object => Clist); Gtk_New (Button, "Add 1000 Rows with Pixmaps"); Pack_Start (HBox, Button, True, True, 0); Clist_Cb.Object_Connect (Button, "clicked", Clist_Cb.To_Marshaller (Add1000'Access), Slot_Object => Clist); Gtk_New (Button, "Add 10000 Rows"); Pack_Start (HBox, Button, True, True, 0); Clist_Cb.Object_Connect (Button, "clicked", Clist_Cb.To_Marshaller (Add10000'Access), Slot_Object => Clist); -- Second layer of buttons Gtk_New_Hbox (HBox, False, 5); Set_Border_Width (HBox, 5); Pack_Start (VBox, HBox, False, False, 0); Gtk_New (Button, "Clear List"); Pack_Start (HBox, Button, True, True, 0); Clist_Cb.Object_Connect (Button, "clicked", Clist_Cb.To_Marshaller (Clear_List'Access), Slot_Object => Clist); Gtk_New (Button, "Remove Selection"); Pack_Start (HBox, Button, True, True, 0); Clist_Cb.Object_Connect (Button, "clicked", Clist_Cb.To_Marshaller (Remove_Selection'Access), Slot_Object => Clist); Gtk_New (Button, "Undo Selection"); Pack_Start (HBox, Button, True, True, 0); Clist_Cb.Object_Connect (Button, "clicked", Clist_Cb.To_Marshaller (Undo_Selection'Access), Slot_Object => Clist); -- TBD??? Warning tests button -- Third layer of buttons Gtk_New_Hbox (HBox, False, 5); Set_Border_Width (HBox, 5); Pack_Start (VBox, HBox, False, False, 0); Gtk_New (Check, "Toggle title Buttons"); Pack_Start (HBox, Check, True, True, 0); Check_Cb.Connect (Check, "clicked", Check_Cb.To_Marshaller (Toggle_Titles'Access), Clist); Set_Active (Check, True); Gtk_New (Check, "Reorderable"); Pack_Start (HBox, Check, True, True, 0); Check_Cb.Connect (Check, "clicked", Check_Cb.To_Marshaller (Toggle_Reorderable'Access), Clist); Set_Active (Check, True); Gtk_New (Label, "Selection_Mode :"); Pack_Start (HBox, Label, False, True, 0); Clist_Omenu_Group := Widget_SList.Null_List; Build_Option_Menu (Omenu, Clist_Omenu_Group, Items, 0, null); -- FIXME: Add the missing callback (instead of null). Pack_Start (HBox, Omenu, False, True, 0); Pack_Start (VBox, Scrolled, True, True, 0); Set_Row_Height (Clist, 18); Set_USize (Clist, -1, 300); for I in 0 .. Clist_Columns - 1 loop Set_Column_Width (Clist, Gint (I), 80); end loop; Set_Column_Auto_Resize (Clist, 0, True); Set_Column_Resizeable (Clist, 1, False); Set_Column_Max_Width (Clist, 2, 100); Set_Column_Min_Width (Clist, 3, 50); Set_Selection_Mode (Clist, Selection_Multiple); Set_Column_Justification (Clist, 1, Justify_Right); Set_Column_Justification (Clist, 2, Justify_Center); for I in 1 .. Clist_Columns - 1 loop Texts (I) := ICS.New_String ("Columns " & IC.size_t'Image (I)); end loop; Set_Rgb (Col1, 56000, 0, 0); Set_Rgb (Col2, 0, 56000, 32000); Gtk_New (Style); Set_Foreground (Style, State_Normal, Col1); Set_Base (Style, State_Normal, Col2); Set_Font_Description (Style, From_String ("Helvetica Bold 14")); for I in Gint'(0) .. 9 loop Texts (0) := ICS.New_String ("ClistRow " & Integer'Image (Clist_Rows)); Clist_Rows := Clist_Rows + 1; New_Row := Append (Clist, Texts); ICS.Free (Texts (0)); if I mod 4 = 2 then Set_Row_Style (Clist, I, Style); else Set_Cell_Style (Clist, I, I mod 4, Style); end if; end loop; Show_All (Frame); end Run; end Create_Clist;