1----------------------------------------------------------------------- 2-- GtkAda - Ada95 binding for the Gimp Toolkit -- 3-- -- 4-- Copyright (C) 1998-2000 E. Briot, J. Brobecker and A. Charlet -- 5-- Copyright (C) 2000-2003 ACT-Europe -- 6-- -- 7-- This library is free software; you can redistribute it and/or -- 8-- modify it under the terms of the GNU General Public -- 9-- License as published by the Free Software Foundation; either -- 10-- version 2 of the License, or (at your option) any later version. -- 11-- -- 12-- This library is distributed in the hope that it will be useful, -- 13-- but WITHOUT ANY WARRANTY; without even the implied warranty of -- 14-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- 15-- General Public License for more details. -- 16-- -- 17-- You should have received a copy of the GNU General Public -- 18-- License along with this library; if not, write to the -- 19-- Free Software Foundation, Inc., 59 Temple Place - Suite 330, -- 20-- Boston, MA 02111-1307, USA. -- 21-- -- 22-- As a special exception, if other files instantiate generics from -- 23-- this unit, or you link this unit with other files to produce an -- 24-- executable, this unit does not by itself cause the resulting -- 25-- executable to be covered by the GNU General Public License. This -- 26-- exception does not however invalidate any other reasons why the -- 27-- executable file might be covered by the GNU Public License. -- 28----------------------------------------------------------------------- 29 30with Glib; use Glib; 31with Gdk; use Gdk; 32with Gdk.Color; use Gdk.Color; 33with Gdk.Pixmap; use Gdk.Pixmap; 34with Gdk.Bitmap; use Gdk.Bitmap; 35with Gtk; use Gtk; 36with Gtk.Box; use Gtk.Box; 37with Gtk.Button; use Gtk.Button; 38with Gtk.Check_Button; use Gtk.Check_Button; 39with Gtk.Clist; use Gtk.Clist; 40with Gtk.Enums; use Gtk.Enums; 41with Gtk.Label; use Gtk.Label; 42with Gtk.Option_Menu; use Gtk.Option_Menu; 43with Gtk.Scrolled_Window; use Gtk.Scrolled_Window; 44with Gtk.Handlers; use Gtk.Handlers; 45with Gtk.Style; use Gtk.Style; 46with Gtk.Widget; use Gtk.Widget; 47with Gtkada.Types; use Gtkada.Types; 48with Pango.Font; use Pango.Font; 49with Common; use Common; 50with Interfaces.C.Strings; 51 52package body Create_Clist is 53 package IC renames Interfaces.C; 54 package ICS renames Interfaces.C.Strings; 55 56 package Clist_Cb is new Handlers.Callback (Gtk_Clist_Record); 57 package Check_Cb is new Handlers.User_Callback 58 (Gtk_Check_Button_Record, Gtk_Clist); 59 60 use type Interfaces.C.size_t; 61 62 Clist_Columns : constant Interfaces.C.size_t := 12; 63 Clist_Rows : Integer := 0; 64 Style1 : Gtk_Style; 65 Style2 : Gtk_Style; 66 Style3 : Gtk_Style; 67 Clist_Omenu_Group : Widget_SList.GSlist; 68 69 Titles : constant Chars_Ptr_Array (1 .. Clist_Columns) := 70 "Auto resize" + 71 "Not resizable" + 72 "Max width 100" + 73 "Min Width 50" + 74 "Hide column" + 75 "Title 5" + 76 "Title 6" + 77 "Title 7" + 78 "Title 8" + 79 "Title 9" + 80 "Title 10" + 81 "Title 11"; 82 -- Put at the library level to avoid having to allocate/free the 83 -- memory each time "Run" is called... 84 85 Items : constant Chars_Ptr_Array := 86 "Single" + "Browse" + "Multiple" + "Extended"; 87 88 ---------- 89 -- Help -- 90 ---------- 91 92 function Help return String is 93 begin 94 return "!!!! Consider using a @bGtk_Tree_View@B instead !!!!" 95 & ASCII.LF 96 & ASCII.LF 97 & "An @bGtk_Clist@B is like a @bGtk_List@B, except it shows the" 98 & " information on multiple columns. You can have as many columns" 99 & " as you want, each with its own information." 100 & ASCII.LF 101 & "Each line can have its own user_data, although the interface is" 102 & " different from the standard interface. Some specific functions" 103 & " are provided for this usage. The standard inheritance mechanism" 104 & " does not work for rows in a clist, altough of course it does" 105 & " work for the @bGtk_Clist@B itself."; 106 end Help; 107 108 ---------------- 109 -- Clear_List -- 110 ---------------- 111 112 procedure Clear_List (List : access Gtk_Clist_Record'Class) is 113 begin 114 Clear (List); 115 Clist_Rows := 0; 116 end Clear_List; 117 118 ---------------------- 119 -- Remove_Selection -- 120 ---------------------- 121 122 procedure Remove_Selection (List : access Gtk_Clist_Record'Class) is 123 use Gint_List; 124 I : Gint; 125 begin 126 Freeze (List); 127 loop 128 exit when Length (Get_Selection (List)) = 0; 129 Clist_Rows := Clist_Rows - 1; 130 I := Get_Data (First (Get_Selection (List))); 131 Remove (List, I); 132 exit when Get_Selection_Mode (List) = Selection_Browse; 133 end loop; 134 135 Thaw (List); 136 end Remove_Selection; 137 138 ------------------- 139 -- Toggle_Titles -- 140 ------------------- 141 142 procedure Toggle_Titles (Button : access Gtk_Check_Button_Record'Class; 143 List : in Gtk_Clist) is 144 begin 145 if Get_Active (Button) then 146 Column_Titles_Show (List); 147 else 148 Column_Titles_Hide (List); 149 end if; 150 end Toggle_Titles; 151 152 ------------------------ 153 -- Toggle_Reorderable -- 154 ------------------------ 155 156 procedure Toggle_Reorderable (Button : access Gtk_Check_Button_Record'Class; 157 List : in Gtk_Clist) is 158 begin 159 Set_Reorderable (List, Get_Active (Button)); 160 end Toggle_Reorderable; 161 162 ------------- 163 -- Add1000 -- 164 ------------- 165 166 procedure Add1000 (List : access Gtk_Clist_Record'Class) is 167 Pixmap : Gdk.Gdk_Pixmap; 168 Mask : Gdk.Gdk_Bitmap; 169 Texts : Chars_Ptr_Array (0 .. Clist_Columns - 1); 170 Row : Gint; 171 Style : constant Gtk_Style := Get_Style (List); 172 173 begin 174 Create_From_Xpm_D (Pixmap, Get_Clist_Window (List), 175 Mask, Get_White (Style), 176 Gtk_Mini_Xpm); 177 for I in 4 .. Clist_Columns - 1 loop 178 Texts (I) := ICS.New_String ("Column" & IC.size_t'Image (I)); 179 end loop; 180 Texts (0 .. 3) := Null_Ptr + "Right" + "Center" + Null_Ptr; 181 Freeze (List); 182 183 for I in 0 .. 999 loop 184 ICS.Free (Texts (0)); 185 Texts (0) := ICS.New_String ("CListRow" & Integer'Image (I)); 186 Row := Append (List, Texts); 187 Set_Pixtext (List, Row, 3, "gtk+", 5, Pixmap, Mask); 188 end loop; 189 Clist_Rows := Clist_Rows + 1000; 190 191 Free (Texts); 192 193 Thaw (List); 194 Gdk.Pixmap.Unref (Pixmap); 195 Gdk.Bitmap.Unref (Mask); 196 end Add1000; 197 198 -------------- 199 -- Add10000 -- 200 -------------- 201 202 procedure Add10000 (List : access Gtk_Clist_Record'Class) is 203 Texts : Chars_Ptr_Array (0 .. Clist_Columns - 1); 204 Row : Gint; 205 pragma Unreferenced (Row); 206 207 begin 208 for I in 3 .. Clist_Columns - 1 loop 209 Texts (I) := ICS.New_String ("Column" & IC.size_t'Image (I)); 210 end loop; 211 212 Texts (0 .. 2) := Null_Ptr + "Right" + "Center"; 213 Freeze (List); 214 215 for I in 0 .. 9999 loop 216 ICS.Free (Texts (0)); 217 Texts (0) := ICS.New_String ("Row" & Integer'Image (I)); 218 Row := Append (List, Texts); 219 end loop; 220 221 Clist_Rows := Clist_Rows + 10000; 222 Free (Texts); 223 Thaw (List); 224 end Add10000; 225 226 ---------------- 227 -- Insert_Row -- 228 ---------------- 229 230 procedure Insert_Row (List : access Gtk_Clist_Record'Class) is 231 Texts : Chars_Ptr_Array (0 .. Clist_Columns - 1) := 232 "This" + "is an" + "inserted" + "row" + 233 "This" + "is an" + "inserted" + "row" + 234 "This" + "is an" + "inserted" + "row"; 235 Col1 : Gdk_Color; 236 Col2 : Gdk_Color; 237 Row : Gint; 238 Style : constant Gtk_Style := Get_Style (List); 239 240 begin 241 Row := Prepend (List, Texts); 242 if Style1 = Null_Style then 243 Set_Rgb (Col1, 0, 56000, 0); 244 Set_Rgb (Col2, 32000, 0, 56000); 245 246 -- Note that the memory allocated here is never freed in this 247 -- small example! 248 Style1 := Copy (Style); 249 Set_Base (Style1, State_Normal, Col1); 250 Set_Base (Style1, State_Selected, Col2); 251 252 Style2 := Copy (Style); 253 Set_Foreground (Style2, State_Normal, Col1); 254 Set_Foreground (Style2, State_Selected, Col2); 255 256 Style3 := Copy (Style); 257 Set_Foreground (Style3, State_Normal, Col1); 258 Set_Base (Style3, State_Normal, Col2); 259 260 Set_Font_Description (Style3, From_String ("Courier 120")); 261 end if; 262 263 Set_Cell_Style (List, Row, 3, Style1); 264 Set_Cell_Style (List, Row, 4, Style2); 265 Set_Cell_Style (List, Row, 0, Style3); 266 Clist_Rows := Clist_Rows + 1; 267 Free (Texts); 268 end Insert_Row; 269 270 -------------------- 271 -- Undo_Selection -- 272 -------------------- 273 274 procedure Undo_Selection (List : access Gtk_Clist_Record'Class) is 275 begin 276 Gtk.Clist.Undo_Selection (List); 277 end Undo_Selection; 278 279 ------------------ 280 -- Click_Column -- 281 ------------------ 282 283 procedure Click_Column (List : access Gtk_Clist_Record'Class; 284 Column : Gint) is 285 begin 286 if Column = 4 then 287 Set_Column_Visibility (List, Column, False); 288 elsif Column = Get_Sort_Column (List) then 289 if Get_Sort_Type (List) = Ascending then 290 Set_Sort_Type (List, Descending); 291 else 292 Set_Sort_Type (List, Ascending); 293 end if; 294 else 295 Set_Sort_Column (List, Column); 296 end if; 297 298 Sort (List); 299 end Click_Column; 300 301 --------- 302 -- Run -- 303 --------- 304 305 procedure Run (Frame : access Gtk.Frame.Gtk_Frame_Record'Class) is 306 Texts : Chars_Ptr_Array (0 .. Clist_Columns - 1); 307 VBox, HBox : Gtk_Box; 308 Clist : Gtk_Clist; 309 Button : Gtk_Button; 310 Label : Gtk_Label; 311 New_Row : Gint; 312 Scrolled : Gtk_Scrolled_Window; 313 Check : Gtk_Check_Button; 314 Omenu : Gtk_Option_Menu; 315 Col1 : Gdk_Color; 316 Col2 : Gdk_Color; 317 Style : Gtk_Style; 318 pragma Unreferenced (New_Row); 319 320 begin 321 322 Clist_Rows := 0; 323 Set_Label (Frame, "Clist"); 324 325 Gtk_New_Vbox (VBox, False, 0); 326 Add (Frame, VBox); 327 328 Gtk_New (Scrolled); 329 Set_Border_Width (Scrolled, 5); 330 Set_Policy (Scrolled, Policy_Automatic, Policy_Automatic); 331 332 Gtk_New (Clist, Gint (Clist_Columns), Titles); 333 Add (Scrolled, Clist); 334 -- TBD: Callback for click column 335 336 Gtk_New_Hbox (HBox, False, 5); 337 Set_Border_Width (HBox, 5); 338 Pack_Start (VBox, HBox, False, False, 0); 339 340 Clist_Cb.Connect (Clist, "click_column", 341 Clist_Cb.To_Marshaller (Click_Column'Access)); 342 343 Gtk_New (Button, "Insert Row"); 344 Pack_Start (HBox, Button, True, True, 0); 345 Clist_Cb.Object_Connect (Button, "clicked", 346 Clist_Cb.To_Marshaller (Insert_Row'Access), 347 Slot_Object => Clist); 348 349 Gtk_New (Button, "Add 1000 Rows with Pixmaps"); 350 Pack_Start (HBox, Button, True, True, 0); 351 Clist_Cb.Object_Connect (Button, "clicked", 352 Clist_Cb.To_Marshaller (Add1000'Access), 353 Slot_Object => Clist); 354 355 Gtk_New (Button, "Add 10000 Rows"); 356 Pack_Start (HBox, Button, True, True, 0); 357 Clist_Cb.Object_Connect (Button, "clicked", 358 Clist_Cb.To_Marshaller (Add10000'Access), 359 Slot_Object => Clist); 360 361 -- Second layer of buttons 362 Gtk_New_Hbox (HBox, False, 5); 363 Set_Border_Width (HBox, 5); 364 Pack_Start (VBox, HBox, False, False, 0); 365 366 Gtk_New (Button, "Clear List"); 367 Pack_Start (HBox, Button, True, True, 0); 368 Clist_Cb.Object_Connect (Button, "clicked", 369 Clist_Cb.To_Marshaller (Clear_List'Access), 370 Slot_Object => Clist); 371 372 Gtk_New (Button, "Remove Selection"); 373 Pack_Start (HBox, Button, True, True, 0); 374 Clist_Cb.Object_Connect 375 (Button, "clicked", 376 Clist_Cb.To_Marshaller (Remove_Selection'Access), 377 Slot_Object => Clist); 378 379 Gtk_New (Button, "Undo Selection"); 380 Pack_Start (HBox, Button, True, True, 0); 381 Clist_Cb.Object_Connect 382 (Button, "clicked", 383 Clist_Cb.To_Marshaller (Undo_Selection'Access), 384 Slot_Object => Clist); 385 386 -- TBD??? Warning tests button 387 388 -- Third layer of buttons 389 Gtk_New_Hbox (HBox, False, 5); 390 Set_Border_Width (HBox, 5); 391 Pack_Start (VBox, HBox, False, False, 0); 392 393 Gtk_New (Check, "Toggle title Buttons"); 394 Pack_Start (HBox, Check, True, True, 0); 395 Check_Cb.Connect (Check, "clicked", 396 Check_Cb.To_Marshaller (Toggle_Titles'Access), 397 Clist); 398 Set_Active (Check, True); 399 400 Gtk_New (Check, "Reorderable"); 401 Pack_Start (HBox, Check, True, True, 0); 402 Check_Cb.Connect 403 (Check, "clicked", 404 Check_Cb.To_Marshaller (Toggle_Reorderable'Access), 405 Clist); 406 Set_Active (Check, True); 407 408 Gtk_New (Label, "Selection_Mode :"); 409 Pack_Start (HBox, Label, False, True, 0); 410 411 Clist_Omenu_Group := Widget_SList.Null_List; 412 Build_Option_Menu (Omenu, Clist_Omenu_Group, Items, 0, null); 413 -- FIXME: Add the missing callback (instead of null). 414 Pack_Start (HBox, Omenu, False, True, 0); 415 416 Pack_Start (VBox, Scrolled, True, True, 0); 417 Set_Row_Height (Clist, 18); 418 Set_USize (Clist, -1, 300); 419 420 for I in 0 .. Clist_Columns - 1 loop 421 Set_Column_Width (Clist, Gint (I), 80); 422 end loop; 423 424 Set_Column_Auto_Resize (Clist, 0, True); 425 Set_Column_Resizeable (Clist, 1, False); 426 Set_Column_Max_Width (Clist, 2, 100); 427 Set_Column_Min_Width (Clist, 3, 50); 428 Set_Selection_Mode (Clist, Selection_Multiple); 429 Set_Column_Justification (Clist, 1, Justify_Right); 430 Set_Column_Justification (Clist, 2, Justify_Center); 431 432 for I in 1 .. Clist_Columns - 1 loop 433 Texts (I) := ICS.New_String ("Columns " & IC.size_t'Image (I)); 434 end loop; 435 436 Set_Rgb (Col1, 56000, 0, 0); 437 Set_Rgb (Col2, 0, 56000, 32000); 438 439 Gtk_New (Style); 440 Set_Foreground (Style, State_Normal, Col1); 441 Set_Base (Style, State_Normal, Col2); 442 Set_Font_Description (Style, From_String ("Helvetica Bold 14")); 443 444 for I in Gint'(0) .. 9 loop 445 Texts (0) := 446 ICS.New_String ("ClistRow " & Integer'Image (Clist_Rows)); 447 Clist_Rows := Clist_Rows + 1; 448 New_Row := Append (Clist, Texts); 449 ICS.Free (Texts (0)); 450 if I mod 4 = 2 then 451 Set_Row_Style (Clist, I, Style); 452 else 453 Set_Cell_Style (Clist, I, I mod 4, Style); 454 end if; 455 end loop; 456 457 Show_All (Frame); 458 end Run; 459 460end Create_Clist; 461