GtkAda Contributions

version 3.27



Dmitry A. Kazakov and Maxim Reznik (mailbox@dmitry-kazakov.de)

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.

As a special exception, if other files instantiate generics from this unit, or you link this unit with other files to produce an executable, this unit does not by itself cause the resulting executable to be covered by the GNU General Public License. This exception does not however invalidate any other reasons why the executable file might be covered by the GNU Public License.

ARM Intel Download GtkAda Contributions Platform: v7 64- 32bit Fedora packages precompiled and packaged using RPM CentOS packages precompiled and packaged using RPM Debian packages precompiled and packaged for dpkg Ubuntu packages precompiled and packaged for dpkg Source distribution (any platform) gtkada_contributions_3_27.tgz (tar + gzip, Windows users may use WinZip)

Download XPM to GtkAda converter (embedding images into GtkAda applications see) 64- 32bit Windows i686 xpm2gtkada.exe.gz (gzip compressed, Windows users may use WinZip) Fedora packages is a part of the developing package (has devel suffix) CentOS packages is a part of the developing package (has devel suffix) Debian packages is a part of the developing package (has dev suffix) Ubuntu packages is a part of the developing package (has dev suffix)

See also:

The described here packages are proposed as a contribution to GtkAda, an Ada bindings to GTK+. It deals with the following issues:

Tasking support;

Custom models for tree view widget;

Custom cell renderers for tree view widget;

Multi-columned derived model;

Extension derived model (to add columns to an existing model);

Abstract caching model for directory-like data;

Tree view and list view widgets for navigational browsing of abstract caching models;

File system navigation widgets with wildcard filtering;

Resource styles;

Capturing resources of a widget;

Embeddable images;

Some missing subprograms and bug fixes;

Measurement unit selection widget and dialogs;

Improved hue-luminance-saturation color model;

Simplified image buttons and buttons customizable by style properties;

Controlled Ada types for GTK+ strong and weak references;

Simplified means to create lists of strings;

Spawning processes synchronously and asynchronously with pipes;

Capturing asynchronous process standard I/O by Ada tasks and by text buffers;

Source view widget support;

SVG images support.

See also changes log.

1. Tasking with GTK+

The package Gtk.Main.Router provides a synchronization mechanism to use GTK+ framework with Ada tasks. GTK+ is known to be task unsafe. In particular, all calls need to be made from the same task (thread). Further GTK+ has a callback-based architecture which makes it difficult to use Ada's entry points for synchronization, because callback subprograms cannot act as entries. This package allows Ada tasks triggering some GTK+ actions to synchronize on a protected object with the task handling GTK+ events. Basically, the task waits for GTK+ be ready to serve it. Serving occurs upon idle loop processing, which performs the requested action on the context of the main GTK+ thread. Upon action completion the task is unblocked and continues its work. For the task it appears much as a rendezvous with the GTK+ main thread.



The package provides three ways to request an action to be performed on the context of GTK+ main thread.

Extensible tagged type. The task that needs to call some GTK+ subroutines, derives from the type Request_Data and places the parameters there. It overrides the procedure Service with a sequence of calls, needed to be done. Then it calls to Request one or multiple times. Exceptions raised in Service are propagated to the task called Request. It is safe to use this Request from any task, including one of the main GTK+ loop. In the latter case Request will not block.

Plain callback routine. The type Gtk_Callback is a pointer to a parameterless procedure. The procedure Request with the parameter of this type can be used to request a call to the procedure on the context of the main GTK+ loop. Similarly to the variant with a tagged type, it is safe to call Request on any context.

Generic package Generic_Callback_Request can be instantiated with an appropriate type of callback routine parameters. The procedure Request defined in the package acts like a plain callback routine described above and also accepts a parameter of the user-defined type.

Generic package Generic_Message is provided for potentially asynchronous execution of user-defined handlers on the GTK+ context. Differently to the methods listed above it the caller does not wait for request completion.

Note that the package is based on timer events.

Quit_Error : exception ;

Busy_Error : exception ;

The exception propagated when servicing is impossible because the main GTK+ loop was prematurely left.

function Get_Max_Asynchronous return Positive;

This function returns the maximum number of asynchronous requests pending in the queue. When the limit is reached the new asynchronous requests are blocked. When a request stays until timeout expiration, it fails with Busy_Error exception.

function Get_Request_Info return String;

This function returns a string containing information about current requests. It is used for debugging purpose.

procedure Init

( Window : not null access Gtk_Window_Record'Class;

Period : Duration := 0.2 ;

GPS_Port : Natural := 50_000

);

This procedure should be called once from the main GTK+ thread after Init. Usually it is done before entering the loop of processing events and before starting tasks which might use the package functionality. Period specifies how frequently the mail loop will poll for graphic requests from other tasks. The parameter Window is the application window for which the main loop is used. The parameter GPS_Port specifies the port used to connect to the GPS, when the latter is in the server mode.

function Is_Active return Boolean;

This function returns true if servicing is active. When inactive requests fail with Quit_Error exceptions.

procedure Quit;

This procedure stops servicing request. All pending and future requests propagate Quit_Error. Normally it is not necessary to use this procedure because servicing is stopped automatically when the window specified in Init is destroyed.

procedure Set_Max_Asynchronous (Max : Positive);

This procedure sets the maximum number of asynchronous requests pending in the queue. This limit does not affect the synchronous requests because these are limited by the total number of tasks.

type Request_Data is abstract

new Ada.Finalization.Limited_Controlled with null record ;

The base type of a request.

procedure Request (Data : in out Request_Data'Class);

This procedure is called in order to request Data to be serviced on the context of the main GTK+ task. The call is blocking. The caller will wait until the request will be serviced through a call to Service on the GTK+ context. Program_Error is propagated when Init was not called. Other exceptions are the exceptions propagated out of Service and re-raised on the caller's context. Quit_Error is propagated when the main GTK+ loop was quitted before the request was serviced.

procedure Service (Data : in out Request_Data) is abstract ;

This abstract procedure which any derived type should implement. All GTK+ calls shall be placed here. Note that Service is called on the context of the main GTK+ thread. An implementation may propagate exceptions which are caught and re-raised on the context of Request.

procedure Request (Service : Gtk_Callback);

The caller will wait until the request will be serviced through a call to Service on the GTK+ context. Service is a parameterless procedure. Program_Error is propagated when Init was not called. Other exceptions are the exceptions propagated out of Service and re-raised on the caller's context. Quit_Error is propagated when the main GTK+ loop was quitted before the request was serviced.

generic

type User_Data (<>) is limited private ;

package Generic_Callback_Request is ...

The package is instantiated with the user data type. It declares the type:

type Callback_Procedure is

access procedure (Data : not null access User_Data);

This is the procedure to be called on the GTK+ context.

procedure Request

( Callback : Callback_Procedure;

Data : not null access User_Data

);

The caller will wait until the request will be serviced through a call to Callback on the GTK+ context. Program_Error is propagated when Init was not called. Other exceptions are the exceptions propagated out of Callback and re-raised on the caller's context. Quit_Error is propagated when the main GTK+ loop was quitted before the request was serviced.

generic

type User_Data is private;

package Generic_Message is ...

The package is provided for execution of user-defined procedures on the GTK+ context asynchronously to the caller. The package formal parameter is the data type passed to a call. Note that the type is not limited because the values of are marshaled. Note also that this package does not provide any performance advantages over synchronous calls. It is provided for rare cases when servicing the request requires completion of the caller. For example, when the caller is a task that performs some lengthy action which upon completion should destroy a widget that owns the task. When widget destruction is requested from the task it will also wait for the task to finalize. When accomplished synchronously this would deadlock. Observe that for this reason use of Generic_Message on the GTK+ context is meaningless, though allowed.

type Handler_Procedure is access procedure (Data : in out User_Data);

This is the procedure to be called on the GTK+ context.

procedure Send

( Handler : Handler_Procedure;

Data : User_Data;

Timeout : Duration := 0.5

);

This call requests execution of Handler with Data parameters. It does not block the caller unless the maximum number of asynchronous requests is reached (see Set_Max_Asynchronous). When called on the context of the main loop, the callback is postponed until messages loop end. Data is marshaled. Program_Error is propagated when Init was not called. Quit_Error is propagated when the main GTK+ loop was quitted before the request was serviced. Busy_Error is propagated when Timeout is expired.

1.1. Example

The following is a small test program illustrating use of the package.

with Ada.Exceptions; use Ada.Exceptions;

with GtkAda.Handlers; use GtkAda.Handlers;

with Gtk.Main.Router; use Gtk.Main.Router;

with Gtk.Window; use Gtk.Window;

with Gtk.Widget; use Gtk.Widget;

with Gtk.Table; use Gtk.Table;

with Gtk.Label; use Gtk.Label;



with Ada.Unchecked_Conversion;

with Gtk.Missed;



procedure Test_Gtk_Tasking is

--

-- All data are global, for the sake of simplicity

--

Window : Gtk_Window;

Grid : Gtk_Table;

Label : Gtk_Label;

Counter : Integer;



-- Circumvention of access rules, don't do it, it is here only to

-- simplify the test

type Local_Callback is access procedure ;

function " + " is

new Ada.Unchecked_Conversion (Local_Callback, Gtk_Callback);



task type Process;



-- Update will write the label

procedure Update is

begin

Label.Set_Text (" Counter " & Integer'Image (Counter));

end Update;



-- The task that calls to Update

task body Process is

begin

for Index in Positive'Range loop

Counter := Index;

Request (+Update' Access ); -- Request execution of Update

delay 0.5 ;

end loop ;

exception

when Quit_Error => -- Main loop was quitted, we follow

null ;

when Error : others =>

Say (Exception_Information (Error)); -- This is safe

end Process;



begin

Gtk.Main.Init;

Gtk.Window.Gtk_New (Window);

Gtk.Main.Router.Init (Window); -- This must be called once

Window.Set_Title (" Test ");

Window.On_Delete_Event (Gtk.Missed.Delete_Event_Handler'Access);

Window.On_Destroy (Gtk.Missed.Destroy_Handler'Access);

Gtk_New (Grid, 1 , 1 , False);

Window.Add (Grid);

Gtk_New (Label, " label ");

Grid.Attach (Label, 0 , 1 , 0 , 1 );



Label.Show;

Grid.Show;

Window.Show;

declare

Worker : Process; -- Now the task is on

begin

-- Enter the events processing loop

Gtk.Main.Main;

end ;

exception

when Error : others =>

Say (Exception_Information (Error)); -- This is safe

end Test_Gtk_Tasking;

1.2. Debugging tools

The package Gtk.Main.Router also provides two procedures for simple debugging and messaging purposes:

procedure Say

( Message : UTF8_String;

Title : UTF8_String := "";

Mode : UTF8_String := Stock_Dialog_Info;

Justification : Gtk_Justification := Justify_Left;

Parent : access Gtk_Widget_Record'Class := null

);

This procedure pops a dialog box with Message in it. It can be called from any task.

procedure Trace

( Message : UTF8_String;

Break : Boolean := False

);

This procedure represents a simplified tracing mechanism. When called first time it pops up a dialog box containing Message.

All further calls add new messages to the box. The dialog box has the check button break. When this button is checked each call to Trace blocks until user confirmation. When the button is unchecked the procedure adds its message without waiting. The button break can be checked at any time. Once checked it will hold on the next message. Then the button next continues execution until a next message. It has the effect of checking the break button. The button record continues without further confirmations, and thus it resets the check state of break. The button quit closes the box. The box will be automatically reopened empty on the next message. The parameter Break when set to true overrides unchecked break button and enters wait after adding the message. This can be useful when the message indicates a certain error.

procedure Trace

( Error : Exception_Occurence;

Break : Boolean := True

);

This procedure is a shortcut for

Trace (Ada.Exceptions.Exception_Information (Error), Break);

It typically is used like:

... -- A suspicious code fragment

exception

when Error : others => -- Breaks execution, shows

Trace (Error); -- the exception message

raise ;

end ;

1.3. GNAT-specific debugging tools

The child package Gtk.Main.Router.GNAT_Stack provides procedures Say and Trace of the same profile as its parent. They add stack symbolic traceback to the message printed:

procedure Say

( Message : UTF8_String;

Title : UTF8_String := "";

Mode : UTF8_String := Stock_Dialog_Info;

Justification : Gtk_Justification := Justify_Left;

Parent : access Gtk_Widget_Record'Class := null

);

procedure Trace

( Message : UTF8_String;

Break : Boolean := False

);

procedure Trace

( Error : Exception_Occurence;

Break : Boolean := True

);

Trace can be used as follows:

... -- A suspicious code fragment

exception

when Error : others => -- Breaks execution, shows

Gtk.Main.Router.GNAT_Stack.Trace (Error); -- the exception message

raise ; -- and the call stack

end ;

The procedures use GNAT.Traceback.Symbolic for this purpose. Please refer to the GNAT Reference Manual for the prerequisites of.

procedure Set_Log_Trace

( Domain : String;

Level : Log_Level_Flags := Log_Fatal_Mask or Log_Level_Critical

);

procedure Set_Log_Trace;

This procedure is used for catching GTK+ log messages. Usually these messages indicate very severe errors which are extremely difficult to track down, because they occur in the core libraries of GTK+ written in C. The procedure eases debugging such errors by causing a log message to appear in the tracing dialog box accompanied by the call stack dump. Doing that it stops the application until user confirmation. The parameters of the procedure are Domain indicating which messages has to be caught and Level specifying the severity level of. When this procedure is called several times its effect is accumulated. Some domain names are:

Gtk stands for the Gtk library;

stands for the Gtk library; GLib-GObject is for GLib's objects;

is for GLib's objects; GtkAda+ is used by this library.

Please refer GTK+ documentation for further domain names. When Domain and Level are omitted, all messages from all domains are caught. Note that this happens only if the messages are not caught by other means, i.e. it acts as a default message handler.

procedure Indent

( Message : UTF8_String;

Break : Boolean := False;

Step : Positive := 2

);

This procedure places Message in the messages box adding as the prefix a chain of spaces, which length is Step multiplied by the depth of the call step: It can be useful to trace recursive subprograms in order to determine which instance of the caller has printed the message.

type Log_Filter is abstract tagged limited private ;

An object of this type is used to filter messages additionally to the domain and level.

function Ignore

( Filter : not null access Log_Filter;

Domain : String;

Level : Log_Level_Flags;

Message : UTF8_String

) return Boolean is abstract ;

This function returns true if the message must be ignored. If any of the filters returns true the message is not traced.

1.4. Translation of addresses into the source lines

Right mouse click on the trace dialog brings the dropdown menu expanded with two items as shown below (the look and feel may vary as it depends on the operating system):

The choice paste stack traceback is used to paste GNAT exception traceback. The traceback is a part of Exception_Information. It has the format:

0x5e1b6e 0x5e109f 0x5f1c28 0x5f850a 0x5f7511 0x5f06df 0x59544b 0x5a66a5

When pasted it is replaced by the symbolic traceback as the utility addr2line does. The prerequisite is that the application is build with debug information included.

1.5. Source navigation

The choice go to the source location is used to open a file in the GPS. When the mouse cursor point at a traceback line which contains a reference to a source file, then GPS is asked to open the file at the line specified in the traceback line. The prerequisites are

The application has debug information; The file is a part of the project; GPS is running and has the project open; GPS is running in the server mode; The port GPS server listens must be available for the application (e.g. not blocked by the firewall).

The server mode of GPS is activated as follows:

> gps --server=50000

Here 50000 is the TCP/IP port GPS will listen. The port number is specified in the Init call.

1.6. Debugging GTK+ programs

It is sometimes quite tedious to track down bugs in a GTK+ application. Many of the safeguards, the Ada language has, do not really work with GTK+. Errors are usually detected at run-time at the context of the GTK+, where little can be done. Here is a summary of the basic techniques for designing and debugging GTK+ programs in Ada:

Begin your GTK+ program with:

begin

Gtk.Main.Init;

Gtk.Main.Router.Init; -- Start routing and tracing

Gtk.Main.Router.GNAT_Stack.Set_Log_Trace (" Gdk ");

Gtk.Main.Router.GNAT_Stack.Set_Log_Trace (" Gtk ");

Gtk.Main.Router.GNAT_Stack.Set_Log_Trace (" GLib-GObject ");

Gtk.Main.Router.GNAT_Stack.Set_Log_Trace (" GtkAda+ ");

Gtk.Main.Router.GNAT_Stack.Set_Log_Trace (" my_application ");

...

Gtk.Main.Main;

This enables routing and tracing, while catching GTK+ errors. The procedure Set_Log_Trace described above turns on tracing for the errors in Gdk, Gtk, GLib, GtkAda contributions and the application itself. The most of errors happen in event handlers. Note that a handler is called on the context of GTK+. Propagation of an exception out of a handler will most likely crash the application. This is the reason why all handlers should rather catch exceptions. E.g.:

procedure Button_Clicked (Button : access Gtk_Button_Record'Class) is

begin

...

exception

when Error : others =>

Log

( " my_application ",

Log_Level_Critical,

" Fault in Button_Clicked: " & Exception_Information (Error)

);

end Button_Clicked;

In combination with an initialization shown above, the effect of an exception in Button_Clicked will cause the trace dialog popped up, with the exception information in it. The application will be stopped. If the GPS is active and in the server mode, you will be able to navigate the call stack of the error inspecting the source code locations as described above. The application can be continued from the trace dialog, which will not crash it. As it was said above it is meaningless to propagate an exception out of an event handler.

The GPS in server mode is started as:

> gps --server=50000 my-project-name.gpr

Note that even release version can be built with the -g switch. This does not have any effect on the program performance, since it only adds the debugging information necessary to translate stack trace back into source line locations.

2. GTK+ tree view

Notes about sizing tree views placed in a scrolled window. The tree view widget does not automatically shrink or expand its parent scrolled window. The effect is that the vertical height of the tree view is often too small when the scrolled window containing it is in turn a part of a top level window, such as a dialog. An application might wish to find a better size for the scroll window than GTK+ does. That is - no blank rows beneath the last visible row, all expanded rows visible when there is not too many of them. The following code snippet illustrates a possible approach:

. . . -- Placing items into the model, expanding rows, etc

declare

Dummy : GInt;

Height : GInt;

Width : GInt;

begin

Tree_View.Columns_Autosize; -- Size columns

Tree_View.Get_Preferred_Width (Dummy, Width); -- Query the integral

Tree_View.Get_Preferred_Height (Dummy, Height); -- tree view size

Tree_View.Set_Size_Request -- Set new size

( GInt'Min (Width, 600 ),

GInt'Min (Height, 500 )

);

end ;

Here Get_Preferred_Width and Get_Preferred_Height ask the tree view to return its integral size. Note that at this point the rows should be already added and expanded as necessary. Then Set_Size_Request sets the new tree view size to the returned height and width, but not greater than some reasonable limits, usually chosen to fit into the screen size or parent window. The container widget (a scrolled window) will automatically resize together with the tree view.

2.1. Abstract custom model

The package Gtk.Tree_Model.Abstract_Store provides an abstract base type (Gtk_Abstract_Model_Record) for developing custom tree view models:

type Gtk_Abstract_Model_Record is

abstract new Gtk_Root_Tree_Model_Record with private ;

Objects of the types derived from Gtk_Abstract_Model_Record will implement the GtkTreeModel interface. The implementation maps GTK+ virtual functions to the abstract primitive operations of the base type. A derived type shall provide implementations for them. The abstract primitive operations to override are:

Children returns the first child node of a tree node. Each node of the tree corresponds to a row;

returns the first child node of a tree node. Each node of the tree corresponds to a row; Get_Column_Type returns the type of a column. Columns are numbered from 0;

returns the type of a column. Columns are numbered from 0; Get_Flags returns the flags of the model;

returns the flags of the model; Get_Iter converts a path to the corresponding iterator. An iterator uniquely identifies a row. A path uniquely identifies a sequence of rows bound by a parent-child relation;

converts a path to the corresponding iterator. An iterator uniquely identifies a row. A path uniquely identifies a sequence of rows bound by a parent-child relation; Get_N_Columns returns the number of columns;

returns the number of columns; Get_Path converts an iterator to the corresponding path;

converts an iterator to the corresponding path; Get_Value returns a cell value specified by the column and row. The latter is indicated by an iterator;

returns a cell value specified by the column and row. The latter is indicated by an iterator; Has_Child returns true if a tree node has children;

returns if a tree node has children; Next returns an iterator to the next sibling of a node;

returns an iterator to the next sibling of a node; Nth_Child returns an iterator to the Nth child of a node;

returns an iterator to the Nth child of a node; N_Children returns the number of children of a node;

returns the number of children of a node; Parent returns an iterator to the parent node;

returns an iterator to the parent node; Previous returns an iterator to the previous sibling of a node.

The following operations have a default implementation:

Ref_Node notifies that a node is in use

notifies that a node is in use Unref_Node notifies that a node is no more in use

Other operations:

Finalize can be overridden to provide an Ada-style finalization. When overridden, it must call the default implementation from the body;

can be overridden to provide an Ada-style finalization. When overridden, it must call the default implementation from the body; Initialize shall be called by any derived type;

shall be called by any derived type; Register shall be called once, to register the GTK+ type of the implementation.

function Children

( Model : not null access Gtk_Abstract_Model_Record;

Parent : Gtk_Tree_Iter

) return Gtk_Tree_Iter is abstract ;

This function return the first child of Parent or Null_Iter. When Parent is Null_Iter, the first top node should be the result.

procedure Finalize

( Model : not null access Gtk_Abstract_Model_Record

) is null ;

This procedure is called upon object destruction. The override, if any, shall call the parent's version.

function Get_Column_Type

( Model : not null access Gtk_Abstract_Model_Record;

Index : GInt

) return GType is abstract ;

This function returns the type of the model column. Index is the column number, zero based. GType_Invalid is returned when the column does not exist.

function Get_Flags (Model : not null access Gtk_Abstract_Model_Record)

return Tree_Model_Flags is abstract ;

This function returns the flags of Model.

function Get_Iter

( Model : not null access Gtk_Abstract_Model_Record;

Path : Gtk_Tree_Path

) return Gtk_Tree_Iter is abstract ;

This function converts Path to iterator. The result is Null_Iter when the path is invalid.

function Get_N_Columns (Model : not null access Gtk_Abstract_Model_Record)

return GInt is abstract ;

This function returns number of columns in Model.

function Get_Path

( Model : not null access Gtk_Abstract_Model_Record;

Iter : Gtk_Tree_Iter

) return Gtk_Tree_Path is abstract ;

This function gets the path from an iterator. A path is dynamically allocated and has to be freed later using Path_Free.

procedure Get_Value

( Model : not null access Gtk_Abstract_Model_Record;

Iter : Gtk_Tree_Iter;

Column : Gint;

Value : out GValue

) is abstract ;

This procedure is used to query a value from Model for the iterator Iter and column Column (zero-based). The result is returned in Value. Values are freed by the caller using Unset. It means that the implementation must always initialize Value. When no value can be returned because of some errors an invalid value can be used instead:

Init (Value, GType_Invalid);

Here the value is initialized for the type GType_Invalid.

function Has_Child

( Model : not null access Gtk_Abstract_Model_Record;

Iter : Gtk_Tree_Iter

) return Boolean is abstract ;

This function returns true if the row indicated by Iter has a child in Model.

procedure Initialize

( Model : not null access Gtk_Abstract_Model_Record'Class;

Type_Of : GType

);

This procedure has to be called by any derived type upon object construction. Normally it is the first call of its Initialize, which in turn is called from a Gtk_New. The parameter Type_Of must be a value returned by Register called with the name assigned to the GTK+ type of the derived type. Note that Register shall be called only once. So its result must be stored somewhere in the package that derives the type. The following code snippets illustrate use of Register: The package specification:

type My_Model_Record is new Gtk_Abstract_Model_Record with private ;

type My_Model is access all My_Model_Record'Class;



function Get_Type return Gtk_Type;

function Gtk_New (Model : out My_Model);

procedure Initialize (Model : not null access My_Model_Record'Class);

. . . -- Overriding primitive operations

The package body:

My_Model_Type : GType := GType_Invalid;



function Get_Type return Gtk_Type is

begin

if My_Model_Type = GType_Invalid then

My_Model_Type := Register (" MyModel ");

end if ;

return My_Model_Type; -- Registering the GTK+ type

end Get_Type;



procedure Initialize (Model : not null access My_Model_Record'Class) is

begin

Initialize (Model, Get_Type);

. . . -- Custom initialization

end Initialize;

procedure Next

( Model : not null access Gtk_Abstract_Model_Record;

Iter : in out Gtk_Tree_Iter

) is abstract ;

This function moves Iter to the next sibling node. Null_Iter is the result when there is no more siblings.

function Nth_Child

( Model : not null access Gtk_Abstract_Model_Record;

Parent : Gtk_Tree_Iter;

N : GInt

) return Gtk_Tree_Iter is abstract ;

This gets iterator to a child of Parent by its zero-based number N. Null_Iter is the result when there is no such child. When Parent is Null_Iter roots are returned.

function N_Children

( Model : not null access Gtk_Abstract_Model_Record;

Iter : Gtk_Tree_Iter := Null_Iter

) return GInt is abstract ;

This function returns the number of children of Iter.

function Parent

( Model : not null access Gtk_Abstract_Model_Record;

Child : Gtk_Tree_Iter

) return GInt is abstract ;

This function returns the parent of Child. For roots Null_Iter is returned.

procedure Previous

( Model : not null access Gtk_Abstract_Model_Record;

Iter : in out Gtk_Tree_Iter

) is abstract ;

This function moves Iter to the previous sibling node. Null_Iter is the result when there is no more siblings.

procedure Ref_Node

( Model : not null access Gtk_Abstract_Model_Record;

Iter : Gtk_Tree_Iter

);

The default implementation does nothing.

function Register

( Name : String;

Signals : Chars_Ptr_Array := Null_Array;

Parameters : Signal_Parameter_Types :=

Null_Parameter_Types

) return GType;

For each non-abstract derived type of Gtk_Abstract_Model_Record this function shall be called once before creation of the first object of. For each element of Signals a signal with this name and parameters from the corresponding row of Parameters is added to the registered type. The rows of the array Parameters are padded by GType_None.

procedure Unref_Node

( Model : not null access Gtk_Abstract_Model_Record;

Iter : Gtk_Tree_Iter

);

The default implementation does nothing.

2.1.1. Custom model example

Here we consider using the package Gtk_Abstract_Model_Record for developing a custom tree view model. The custom store is based on a doubly-linked list of records. The records contain imaginary transaction data:

Account number,

User name,

Amount,

Timestamp.

The subdirectory test_gtkada contains the full source:

with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;

with Ada.Calendar; use Ada.Calendar;

with GLib; use GLib;

with GLib.Values; use GLib.Values;

with Gtk.Tree_Model; use Gtk.Tree_Model;

with Gtk.Tree_Model.Abstract_Store; use Gtk.Tree_Model.Abstract_Store;



package Gtk.Tree_Model.Custom_Store is

type Account_No is range 1 .. 100_000_000 ;

type Currency is delta 0.01 range - 1_000_000_000.0 .. 1_000_000_000.0 ;

--

-- Gtk_Transaction_Store_Record -- The type of the model

--

type Gtk_Transaction_Store_Record is

new Gtk_Abstract_Model_Record with private ;

--

-- Gtk_Transaction_Store -- The access type to deal with the objects of

--

type Gtk_Transaction_Store is

access all Gtk_Transaction_Store_Record'Class;

--

-- Insert -- Add a new row into the model

--

procedure Insert

( Model : not null access Gtk_Transaction_Store_Record;

Account : Account_No;

User : String;

Amount : Currency;

Date : Time

);

--

-- Gtk_New -- Create a new object

--

-- Model - The result

--

procedure Gtk_New (Model : out Gtk_Transaction_Store);

The package defines the types of the record fields. Then Gtk_Transaction_Store_Record is derived from Gtk_Abstract_Model_Record. According to GtkAda conventions this type is not used directly. An access type Gtk_Transaction_Store to it is used instead. The rationale is that GTK+ objects are subject of garbage collection. So they are never allocated on the stack and are never freed explicitly.

Finally the public part of the interface contains the procedure Insert used to add new record to the store and the procedure Gtk_New, whch creates an empty store.

private

type Transaction_Record;

type Transaction_Record_Ptr is access Transaction_Record;

--

-- Gtk_Transaction_Store_Record -- Implemenbtation is a doubly-linked

-- list of Transaction_Record. The store

-- holds a pointer to the first element in the list.

--

type Gtk_Transaction_Store_Record is

new Gtk_Abstract_Model_Record with

record

First : Transaction_Record_Ptr;

end record ;

In the private part the Gtk_Transaction_Store_Record completed. It holds a pointer to the first element of a doubly-linked list of Transaction_Record items. Then the abstract primitive operations of Gtk_Abstract_Model_Record get overridden:

--

-- Now, the implementation of the Gtk_Abstract_Model_Record primitive

-- operations follows:

--

function Children

( Model : not null access Gtk_Transaction_Store_Record;

Parent : Gtk_Tree_Iter

) return Gtk_Tree_Iter;

function Get_Column_Type

( Model : not null access Gtk_Transaction_Store_Record;

Index : GInt

) return GType;

function Get_Flags (Model : not null access Gtk_Transaction_Store_Record)

return Tree_Model_Flags;

function Get_Iter

( Model : not null access Gtk_Transaction_Store_Record;

Path : Gtk_Tree_Path

) return Gtk_Tree_Iter;

function Get_N_Columns (Model : not null access Gtk_Transaction_Store_Record)

return GInt;

function Get_Path

( Model : not null access Gtk_Transaction_Store_Record;

Iter : Gtk_Tree_Iter

) return Gtk_Tree_Path;

procedure Get_Value

( Model : not null access Gtk_Transaction_Store_Record;

Iter : Gtk_Tree_Iter;

Column : Gint;

Value : out GValue

);

procedure Finalize (Model : not null access Gtk_Transaction_Store_Record);

function Has_Child

( Model : not null access Gtk_Transaction_Store_Record;

Iter : Gtk_Tree_Iter

) return Boolean;

procedure Next

( Model : not null access Gtk_Transaction_Store_Record;

Iter : in out Gtk_Tree_Iter

);

function Nth_Child

( Model : not null access Gtk_Transaction_Store_Record;

Parent : Gtk_Tree_Iter;

N : GInt

) return Gtk_Tree_Iter;

function N_Children

( Model : not null access Gtk_Transaction_Store_Record;

Iter : Gtk_Tree_Iter := Null_Iter

) return GInt;

function Parent

( Model : not null access Gtk_Transaction_Store_Record;

Child : Gtk_Tree_Iter

) return Gtk_Tree_Iter;

procedure Previous

( Model : not null access Gtk_Transaction_Store_Record;

Iter : in out Gtk_Tree_Iter

);

And finally Transaction_Record is defined. It contains the data fields described above and two pointers to link items of the list.

--

-- Transaction_Record -- Describes one row of the store

--

type Transaction_Record is record

Account : Account_No;

User : Unbounded_String;

Amount : Currency;

Date : Time;

Previous : Transaction_Record_Ptr;

Next : Transaction_Record_Ptr;

end record ;

end Gtk.Tree_Model.Custom_Store;

The implementation of the package specification:

with Ada.Unchecked_Conversion;

with Ada.Unchecked_Deallocation;

with System.Address_To_Access_Conversions;



package body Gtk.Tree_Model.Custom_Store is



GTK_Type : GType := GType_Invalid;

The implementation starts with the definition of the GTK+ type used for the store object. The type cannot be determined until GTK+ runs, so it is initialized as invalid and will be resolved later at run-time.

function To_Iter (Node : Transaction_Record_Ptr)

return Gtk_Tree_Iter is

function To_Address is

new Ada.Unchecked_Conversion

( Transaction_Record_Ptr,

System.Address

);

begin

return

( Stamp => 1 ,

User_Data => To_Address (Node),

User_Data2 => System.Null_Address,

User_Data3 => System.Null_Address

);

end To_Iter;



function To_Ptr (Node : Gtk_Tree_Iter)

return Transaction_Record_Ptr is

function To_Transaction_Record_Ptr is

new Ada.Unchecked_Conversion

( System.Address,

Transaction_Record_Ptr

);

begin

if Node = Null_Iter then

return null ;

else

return To_Transaction_Record_Ptr (Node.User_Data);

end if ;

end To_Ptr;

The first thing we need to consider is an implementation of the iterators. An iterator unambiguously identifies a row of the store. In our case rows are represented by Transaction_Record accessed via pointers. So it is naturally to pack pointers into iterators. In GTK+ an iterator has four fields. Three of them have address size. We will use the first field to store a pointer to Transaction_Record. The function To_Iter converts a pointer to the item to an iterator. It simply converts the pointer to an address and stores it into the first address field. The backward conversion provides the function To_Ptr. Null-iterators are converted to null . A more advanced implementation would perform some additional sanity checks, but this is out of the scope of this small example.

function Children

( Model : not null access Gtk_Transaction_Store_Record;

Parent : Gtk_Tree_Iter

) return Gtk_Tree_Iter is

begin

return Null_Iter;

end Children;

Our store is a pure list, so there is no children and parents, i.e neither row can have any child rows.

function Get_Column_Type

( Model : not null access Gtk_Transaction_Store_Record;

Index : GInt

) return GType is

begin

case Index is

when 0 => return GType_Int; -- Account_No

when 1 => return GType_String; -- User

when 2 => return GType_Double; -- Amount

when 3 => return GType_Int; -- Year

when 4 => return GType_Int; -- Month

when 5 => return GType_Int; -- Day

when 6 => return GType_Int; -- Hour

when 7 => return GType_Int; -- Minute

when 8 => return GType_Double; -- Seconds

when others => return GType_Invalid;

end case ;

end Get_Column_Type;

The store publishes 8 columns, which GTK+ types of are reported by Get_Column_Type. The columns 0..2 represent Account No., User name and Amount. The following 5 represent the time stamp. In a more advanced application you might want to put more complex types into columns, for example by using handles. For such types you would probably need to develop a custom cell renderer as well.

function Get_Flags (Model : not null access Gtk_Transaction_Store_Record)

return Tree_Model_Flags is

begin

return Tree_Model_Iters_Persist + Tree_Model_List_Only;

end Get_Flags;

The function Get_Flags informs GTK+ about heuristics it can apply to the store, like that the store is not a tree. The value Tree_Model_Iters_Persist indicates that the iterators stay valid after changes applied to rows. This is true in out case because iterators are just wrapped pointers.

function Get_Iter

( Model : not null access Gtk_Transaction_Store_Record;

Path : Gtk_Tree_Path

) return Gtk_Tree_Iter is

begin

if Get_Depth (Path) = 1 and Model.First /= null then

declare

Indices : GInt_Array renames Get_Indices (Path);

This : Transaction_Record_Ptr := Model.First;

begin

for Row in 0 ..Indices (Indices'First) - 1 loop

if This.Next = Model.First then

return Null_Iter;

end if ;

This := This.Next;

end loop ;

return To_Iter (This);

end ;

end if ;

return Null_Iter;

end Get_Iter;

This function converts a tree path to an iterator. In GTK+ a path is an array of child numbers. All children rows of a row are enumerated from 0. So any path is equivalent to some iterator and reverse. In our case conversion first checks if the path is exactly one item long. After this check the child number is the number of the row. We walk through the list of records to that record. Then the pointer to it is converted to an iterator using To_Iter function described above. Observe, that this has O(n) complexity. Obviously, for relatively long lists a more elaborated implementation would definitely use some indexing schema to improve performance.

function Get_N_Columns (Model : not null access Gtk_Transaction_Store_Record)

return GInt is

begin

return 9 ;

end Get_N_Columns;



function Get_Path

( Model : access Gtk_Transaction_Store_Record;

Iter : Gtk_Tree_Iter

) return Gtk_Tree_Path is

This : Transaction_Record_Ptr := Model.First;

That : Transaction_Record_Ptr := To_Ptr (Iter);

No : GInt := 0 ;

begin

if This = null or else That = null then

return null ;

end if ;

while This /= That loop

if This.Next = Model.First then

return null ;

end if ;

This := This.Next;

No := No + 1 ;

end loop ;

declare

Path : Gtk_Tree_Path := Gtk_New;

begin

Append_Index (Path, No);

return Path;

end ;

end Get_Path;

The function Get_N_Columns returns the number of columns. The function Get_Path is reverse to Get_Iter described above.

procedure Get_Value

( Model : not null access Gtk_Transaction_Store_Record;

Iter : Gtk_Tree_Iter;

Column : Gint;

Value : out GValue

) is

Node : Transaction_Record_Ptr := To_Ptr (Iter);

Year : Year_Number;

Month : Month_Number;

Day : Day_Number;

Seconds : Duration;

begin

if Node /= null then

case Column is

when 0 => -- Account_No

Init (Value, GType_Int);

Set_Int (Value, GInt (Node.Account));

when 1 => -- User

Init (Value, GType_String);

Set_String (Value, To_String (Node.User));

when 2 => -- Amount

Init (Value, GType_Double);

Set_Double (Value, GDouble (Node.Amount));

when 3 => -- Time, year

Split (Node.Date, Year, Month, Day, Seconds);

Init (Value, GType_Int);

Set_Int (Value, GInt (Year));

when 4 => -- Time, month

Split (Node.Date, Year, Month, Day, Seconds);

Init (Value, GType_Int);

Set_Int (Value, GInt (Month));

when 5 => -- Time, day

Split (Node.Date, Year, Month, Day, Seconds);

Init (Value, GType_Int);

Set_Int (Value, GInt (Day));

when 6 => -- Time, hour

Split (Node.Date, Year, Month, Day, Seconds);

Init (Value, GType_Int);

Set_Int (Value, GInt (Seconds) / 3600 );

when 7 => -- Time, minute

Split (Node.Date, Year, Month, Day, Seconds);

Init (Value, GType_Int);

Set_Int (Value, (GInt (Seconds) / 60 ) mod 60 );

when 8 => -- Time, seconds

Split (Node.Date, Year, Month, Day, Seconds);

Init (Value, GType_Double);

Set_Double

( Value,

GDouble'Remainder (GDouble (Seconds), 60.0 )

);

when others =>

Init (Value, GType_Invalid);

end case ;

end if ;

end Get_Value;

For the given row and column Get_Value returns the value of the cell. The row is specified by an iterator. The column is by its zero-based number. The parameter Value is the result. The pair of GTK+ procedures Init, Set_type is the way to place a value there. Init specifies the GTK+ type of the value. Set_type stores the value there. The caller is responsible to call Unset on Value.

procedure Gtk_New (Model : out Gtk_Transaction_Store) is

begin

if GTK_Type = GType_Invalid then

GTK_Type := Register (" GtkTransactionStore ");

end if ;

Model := new Gtk_Transaction_Store_Record;

Initialize (Model, GTK_Type);

end Gtk_New;

The procedure Gtk_New is the store factory. It creates a new store object. First it checks if the GTK+ type was already registered. If not it registers it under the name GtkTransactionStore. This name can be later used in the GTK+ files for instance. Register shall be called once before any use of any store object. Initialize shall be called for each store object. Note that it takes the GTK+ type as a paramter.

procedure Finalize (Model : not null access Gtk_Transaction_Store_Record) is

procedure Free is

new Ada.Unchecked_Deallocation

( Transaction_Record,

Transaction_Record_Ptr

);

This : Transaction_Record_Ptr := Model.First;

Next : Transaction_Record_Ptr := This;

begin

Finalize (Gtk_Abstract_Model_Record'Class (Model. all )' Access );

while This /= null loop

Next := This.Next;

Free (This);

This := Next;

end loop ;

end Finalize;

Finalize is provided for custom finalization. It is analogous to the Ada.Finalization's one. The implementation calls to the parent Finalize and then deletes all items of the list.

function Has_Child

( Model : not null access Gtk_Transaction_Store_Record;

Iter : Gtk_Tree_Iter

) return Boolean is

begin

return False;

end Has_Child;

There is no children, it is not a tree.

procedure Insert

( Model : not null access Gtk_Transaction_Store_Record;

Account : Account_No;

User : String;

Amount : Currency;

Date : Time

) is

Node : Transaction_Record_Ptr :=

new Transaction_Record'

( Account => Account,

User => To_Unbounded_String (User),

Amount => Amount,

Date => Date,

Next => null ,

Previous => null

);

begin

if Model.First = null then

Model.First := Node;

Node.Next := Node;

Node.Previous := Node;

else

Node.Next := Model.First;

Node.Previous := Model.First.Previous;

Node.Next.Previous := Node;

Node.Previous.Next := Node;

end if ;

Row_Inserted -- Notify about changes made

( Model,

Get_Path (Model, To_Iter (Node)),

To_Iter (Node)

);

end Insert;

The procedure Insert allocates a new record, initializes its fields according to the parameters and appends the record to the list. Then, very importantly, it emits a GTK+ signal that a row was inserted. For this it calls Row_Inserted of Gtk.Tree_Model. The parameters are the path and the iterator of the new row. Get_Path and To_Iter are used to obtain them.

procedure Next

( Model : not null access Gtk_Transaction_Store_Record;

Iter : in out Gtk_Tree_Iter

) is

Node : Transaction_Record_Ptr := To_Ptr (Iter);

begin

if Node = null or else Node.Next = Model.First then

Iter := Null_Iter;

else

Iter := To_Iter (Node.Next);

end if ;

end Next;

The procedure Next moves the iterator to the next row.

function Nth_Child

( Model : not null access Gtk_Transaction_Store_Record;

Parent : Gtk_Tree_Iter;

N : GInt

) return Gtk_Tree_Iter is

This : Transaction_Record_Ptr := Model.First;

begin

if Parent = Null_Iter then

for Index in 0 ..N - 1 loop

if This.Next = Model.First then

return Null_Iter;

end if ;

This := This.Next;

end loop ;

return To_Iter (This);

end if ;

return Null_Iter;

end Nth_Child;

The function Nth_Child returns an iterator to the n-th child of a row. Note that when Parent is null-iterator the result is the n-th row. This is the only case we should take care of. Remember the note of O(n) complexity of such operations on doubly-linked lists.

function N_Children

( Model : not null access Gtk_Transaction_Store_Record;

Iter : Gtk_Tree_Iter := Null_Iter

) return GInt is

This : Transaction_Record_Ptr := Model.First;

Count : GInt := 0 ;

begin

if Iter = Null_Iter and then This /= null then

loop

Count := Count + 1 ;

exit when This.Next = Model.First;

This := This.Next;

end loop ;

end if ;

return Count;

end N_Children;

This function is analogous to Nth_Child, it counts the children. Again our case is when the parameter is null-iterator.

function Parent

( Model : not null access Gtk_Transaction_Store_Record;

Child : Gtk_Tree_Iter

) return Gtk_Tree_Iter is

begin

return Null_Iter;

end Parent;

We have no children and parents, so the implementation of Parent is trivial.

procedure Previous

( Model : not null access Gtk_Transaction_Store_Record;

Iter : in out Gtk_Tree_Iter

) is

Node : Transaction_Record_Ptr := To_Ptr (Iter);

begin

if Node = null or else Node = Model.First then

Iter := Null_Iter;

else

Iter := To_Iter (Node.Next);

end if ;

end Previous;



end Gtk.Tree_Model.Custom_Store;

The same subdirectory test_gtkada contains a small test program for this store in the file test_custom_store.adb. The program creates a store and tree view. Observe, that it adds some records to the store in a quasi-concurrent way from GTK+ timer to illustrate that tree view would properly react on the content changes.

2.2. Generic sortable model

The generic package Gtk.Tree_Model.Generic_Sort provides an interface to GtkTreeSortable. The package is instantiated with a custom tree model derived from Gtk_Abstract_Model_Record:

generic

type Tree_Model_Record (<>) is

new Gtk_Abstract_Model_Record with private ;

type Tree_Model is access all Tree_Model_Record'Class;

package Gtk.Tree_Model.Generic_Sort is

...

The generic parameters are a type derived from Gtk_Abstract_Model_Record and an access type used with it. The package defines a new model based on one of Gtk_Abstract_Model_Record, which has the sorted data of the underlying model. The type of the new model is:

type Gtk_Tree_Model_Sort_Record is

new Gtk_Tree_Model_Record with private ;

type Gtk_Tree_Model_Sort is

access all Gtk_Tree_Model_Sort_Record'Class;

The type Gtk_Tree_Model_Sort_Record is normally used as a base type for a derived user type which overrides the function Compare, which is used to when the widget sorts its contents:

function Compare

( Store : not null access Gtk_Tree_Model_Sort_Record;

Left : Gtk_Tree_Iter;

Right : Gtk_Tree_Iter

) return Gtk.Missed.Row_Order;

This function is used for sorting if Set_Sort_Func was called for the current sort column or as a default. Left and Right are the iterators in the unsorted model. The current sort column can be queried using Get_Sort_Column_ID. The unsorted model can be obtained using Get_Model. Note that the sort order as returned by Get_Sort_Column_ID should not influence the result of this function. The caller automatically translates the result into descending order if necessary. The type Row_Order is defined in Gtk.Missed as follows:

type Row_Order is (Before, Equal, After);

The procedure Set_Sort_Func is used to activate Compare for desired columns:

procedure Set_Sort_Func

( Store : not null access Gtk_Tree_Model_Sort_Record'Class;

Column : GInt

);

procedure Set_Sort_Func

( Store : not null access Gtk_Tree_Model_Sort_Record'Class

);

The second variant activates Compare for default sorting. Default sorting in GTK+ refers to an unsorted model.

2.3. Custom cell renderer

This package Gtk.Cell_Renderer.Abstract_Renderer provides an abstract base type Gtk_Abstract_Renderer_Record_for GTK+ tree view column renderers. An object of this type functions as GtkCellRenderer. The type is declared as:

type Gtk_Abstract_Renderer_Record is

abstract new Gtk_Cell_Renderer_Record with private ;

A derived type shall override the following primitive operations:

function Get_Aligned_Area

( Cell : not null access Gtk_Abstract_Renderer_Record;

Widget : not null access Gtk_Widget_Record'Class;

Flags : Gtk_Cell_Renderer_State;

Cell_Area : Gdk_Rectangle

) return Gdk_Rectangle is abstract ;

This function returns the are inside Cell_Area that would be used to render the content.

function Get_Size

( Cell : not null access Gtk_Abstract_Renderer_Record;

Widget : not null access Gtk.Widget.Gtk_Widget_Record'Class;

Cell_Area : Gdk_Rectangle

) return Gdk_Rectangle is abstract ;

function Get_Size

( Cell : not null access Gtk_Abstract_Renderer_Record;

Widget : not null access Gtk.Widget.Gtk_Widget_Record'Class

) return Gdk_Rectangle is abstract ;

These functions return the desired area of the renderer in the form of a rectangle.

procedure Render

( Cell : not null access Gtk_Abstract_Renderer_Record;

Context : Cairo_Context;

Widget : not null access Gtk_Widget_Record'Class;

Background_Area : Gdk_Rectangle;

Cell_Area : Gdk_Rectangle;

Flags : Gtk_Cell_Renderer_State

) is abstract ;

This procedure is called to perform rendering. Context is the drawing context. Background_Area is the rectangle around the cell which includes the border. Cell_Area is the area where things should be drawn into.

Other operations include:

overriding

function Activate

( Cell : not null access Gtk_Abstract_Renderer_Record;

Event : Gdk_Event;

Widget : not null access Gtk_Widget_Record'Class;

Path : UTF8_String;

Background_Area : Gdk_Rectangle;

Cell_Area : Gdk_Rectangle;

Flags : Gtk_Cell_Renderer_State

) return Boolean;

This function can be overridden to make the renderer activatable. Such a renderer may hold a toggle button in it. The default implementation returns false . Path specifies the activation event location, e.g. the tree path to the model.

procedure Commit (Cell : not null access Gtk_Abstract_Renderer_Record);

This procedure is used to notify the tree view about the changes made (this is used for editable renderers). From here the render changes the model.

procedure Finalize (Cell : not null access Gtk_Abstract_Renderer_Record);

This procedure can be overridden to provide an Ada-style finalization. When overridden, it must call the default implementation from the body.

function Get_Mode (Cell : not null access Gtk_Abstract_Renderer_Record)

return Gtk_Cell_Renderer_Mode;

This function returns the renderer mode, such as inert, editable or activatable.

function Get_Path (Cell : not null access Gtk_Abstract_Renderer_Record)

return UTF8_String;

This function returns returns the path of the cell being edited.

overriding

procedure Get_Preferred_Height

( Cell : not null access Gtk_Abstract_Renderer_Record;

Widget : not null access Gtk_Widget_Record'Class;

Minimum_Height : out GInt;

Natural_Height : out GInt

);

This procedure retrieves the renderer's height if rendered to Widget. The default implementation re-dispatches to Get_Size.

overriding

procedure Get_Preferred_Height_For_Width

( Cell : not null access Gtk_Abstract_Renderer_Record;

Widget : not null access Gtk_Widget_Record'Class;

Width : GInt;

Minimum_Height : out GInt;

Natural_Height : out GInt

);

This procedure retrieves the renderer's width for given Width if rendered to Widget. The default implementation re-dispatches to Get_Size.

overriding

procedure Get_Preferred_Get_Width

( Cell : not null access Gtk_Abstract_Renderer_Record;

Widget : not null access Gtk_Widget_Record'Class;

Minimum_Height : out GInt;

Natural_Height : out GInt

);

This procedure retrieves the renderer's width if rendered to Widget. The default implementation re-dispatches to Get_Size.

overriding

procedure Get_Preferred_Width_For_Height

( Cell : not null access Gtk_Abstract_Renderer_Record;

Widget : not null access Gtk_Widget_Record'Class;

Height : GInt;

Minimum_Width : out GInt;

Natural_Width : out GInt

);

This procedure retrieves the renderer's width for given Height if rendered to Widget. The default implementation re-dispatches to Get_Size.

procedure Get_Property

( Cell : not null access Gtk_Abstract_Renderer_Record;

Param_ID : Property_ID;

Value : out GValue;

Property_Spec : Param_Spec

);

This procedure returns the value of a GTK+ property the renderer understands. The properties are the values the renderer can show. Each property is specified as a text string which then appears in Add_Attribute. The procedure shall initialize Value. It is the caller's responsibility to unset it.

overriding

function Get_Request_Mode

( Cell : not null access Gtk_Abstract_Renderer_Record;

) return Gtk_Size_Request_Mode;

This function returns preferred method of estimation of the area needed to renderer content. The default implementation returns Constant_Size.

function Get_X_Align

( Cell : not null access Gtk_Abstract_Renderer_Record

) return GFloat;

function Get_X_Pad

( Cell : not null access Gtk_Abstract_Renderer_Record

) return GUInt;

function Get_Y_Align

( Cell : not null access Gtk_Abstract_Renderer_Record

) return GFloat;

function Get_Y_Pad

( Cell : not null access Gtk_Abstract_Renderer_Record

) return GUInt;

These functions return some widget properties.

procedure Initialize

( Cell : not null access Gtk_Abstract_Renderer_Record'Class;

Type_Of : GType

);

This procedure has to be called by any derived type upon object construction. Normally it is the first call of its Initialize, which in turn is called from a Gtk_New. The parameter Type_Of must be a value returned by Register called with the name assigned to the GTK+ type of the derived type. Note that Register shall be called only once. So its result must be stored somewhere in the package that derives the type.

type Commit_Callback is access procedure

( Cell : not null access Gtk_Abstract_Renderer_Record'Class

);



procedure On_Commit

( Cell : not null access Gtk_Abstract_Renderer_Record;

Handler : not null Commit_Callback;

After : Boolean := False

);

This procedure can be used to attach a handler to the commit signal.

function Register

( Name : String;

Init : not null C_Class_Init := Base_Class_Init'Access

) return GType;

This procedure is used to register the GTK+ type of the renderer. The following code snippets illustrate use of Register: In the package specification:

type My_Renderer_Record is new Gtk_Abstract_Renderer_Record with private ;

type My_Renderer is access all My_Renderer_Record'Class;



function Get_Type return Gtk_Type;

function Gtk_New (Cell : out My_Renderer);

overriding

procedure Initialize (Cell : not null access My_Renderer_Record'Class);

. . . -- Overriding primitive operations

In the package body:

My_Renderer_Type : GType := GType_Invalid;



function Get_Type return Gtk_Type is

begin

if My_Renderer_Type = GType_Invalid then

My_Renderer_Type := Register (" MyRenderer ", My_Class_Initialize' Access );

end if ;

return My_Renderer_Type; -- Registering the GTK+ type

end Get_Type;



procedure Initialize (Cell : not null access My_Renderer_Record'Class) is

begin

Initialize (Cell, Get_Type);

. . . -- Custom initialization

end Initialize;

Usually Register specifies a user-provided procedure to be called upon initialization of the GTK+ class of the renderer. It is necessary to declare GTK+ properties of the renderer. The procedure has the following profile:

type C_Class_Init is access procedure (Class : GObject_Class);

pragma Convention (C, C_Class_Init);

The parameter Class is the class to initialize. When a user-defined procedure is provided, it shall call to Base_Class_Init from its body, before it begins to declare properties of the renderer.

procedure Set_Mode

( Cell : not null access Gtk_Abstract_Renderer_Record;

Mode : Gtk_Cell_Renderer_Mode

);

This procedure sets the renderer's mode property. The renderer can be inert, activatable or editable.

procedure Set_Property

( Cell : not null access Gtk_Abstract_Renderer_Record;

Param_ID : Property_ID;

Value : GValue;

Property_Spec : Param_Spec

);

This procedure sets the value of a GTK+ property. The default implementation calls the parent's version.

function Start_Editing

( Cell : not null access Gtk_Abstract_Renderer_Record;

Event : Gdk_Event;

Widget : not null access Gtk_Widget_Record'Class;

Path : UTF8_String;

Background_Area : Gdk_Rectangle;

Cell_Area : Gdk_Rectangle;

Flags : Gtk_Cell_Renderer_State

) return Gtk_Widget;

This procedure is called for editable cells upon start editing. The implementation returns a widget responsible for editing or null . The widget returned should implement the Gtk_Cell_Editable interface. Otherwise, the behaviour of the renderer will be as if Start_Editing would return null . The caller is responsible to Ref the result it gets and to Unref where appropriate. The default implementation returns null . A typical implementation would create a Gtk_Cell_Editable widget, like Gtk_Entry, initialize it with the current renderer's value, connect to the editing_done and focus_out_event signals of the widget and return the widget as the result.

overriding

procedure Stop_Editing

( Cell : not null access Gtk_Abstract_Renderer_Record;

Cancelled : Boolean

);

This procedure ends editing.

The widget declares commit signal, which is emitted by a call to the procedure Commit. This signal a tree view widget or its model would like to connect to, when an editable renderer is used in the widget. The handler of the signal would set the modified value into the tree model.

2.4. Editable renderers

The protocol of an editable GTK+ cell render is as follows. When the renderer's mode is Cell_Renderer_Editable (see Get_Mode) then:

Upon editing activation the cell renderer receives a start editing notification. This is translated into a call to the Start_Editing primitive operation; If Start_Editing rejects editing attempt, it returns null . Otherwise it creates a widget with Gtk_Cell_Editable interface. Usually it is Gtk_Entry. Normally the returned widget should be initialized with the current cell value. The implementation might also wish to connect to the editing_done and focus_out_event signals of the widget; Upon focus_out_event the handler of calls Stop_Editing with Canceled set to true ; Upon editing_done the handler of takes the edited value from the widget. If it decides to dismiss the value, it calls to Stop_Editing with Canceled set to true . If it accepts the value, it calls Stop_Editing with Canceled set to false followed by a call to Commit, which notifies about the changes made. Commit emits the signal commit; The renderer does not touch the tree model. It is the responsibility the commit handler. Within the handler Get_Path can be called to determine the string representation of the row, of which cell has been edited (see Get_Iter_From_String). Note that due to limitations of GTK+, there is no obvious way to determine the column of the cell. It should become known to the handler in some other way. The handler sets the value into the tree model. This ends editing.

2.5. Fixed-point renderer

The package Gtk.Cell_Renderer_Fixed provides a simple, yet, usable example a cell renderer. It defines a fixed-point numeric renderer. The numbers are represented in the form xxxx.yyyy using facilities of the package Ada.Text_IO.Float_IO. The renderer aligns all numbers along the positions of their decimal points. The renderer is editable. The package defines the rendrerer's type:

type Gtk_Cell_Renderer_Fixed_Record is

new Gtk.Cell_Renderer.Abstract_Renderer.

Gtk_Abstract_Renderer_Record with private ;

type Gtk_Cell_Renderer_Fixed is

access all Gtk_Cell_Renderer_Fixed_Record'Class;

and the operations on it:

function Get_Type return Gtk_Type;

This function returns the GTK+ type of the fixed-point renderers.

procedure Gtk_New

( Cell : out Gtk_Cell_Renderer_Fixed;

After : Natural := 0

);

This procedure creates a new renderer. The parameter After determines the number of decimal places shown after the point.

procedure Initialize

( Cell : access Gtk_Cell_Renderer_Fixed_Record'Class;

After : Natural

);

This procedure shall be called from any type derived from Cell_Renderer_Fixed upon initialization.

The renderer provides the following properties:

value is the rendered value. The type of the property is GDouble.

is the rendered value. The type of the property is GDouble. after is the number of digits shown after the decimal point. The type of the property is GUint.

2.4.1. Annotated source code of the renderer

The package specification file:

with Cairo; use Cairo;

with Gdk.Event; use Gdk.Event;

with Gdk.Rectangle; use Gdk.Rectangle;

with GLib.Properties.Creation; use GLib.Properties.Creation;

with GLib.Values; use GLib.Values;

with Gtk.Cell_Renderer; use Gtk.Cell_Renderer;

with Gtk.GEntry; use Gtk.GEntry;

with Gtk.Handlers; use Gtk.Handlers;

with Gtk.Widget; use Gtk.Widget;

with Pango.Layout; use Pango.Layout;



with Gtk.Cell_Renderer.Abstract_Renderer;

with Gdk.Event;



package Gtk.Cell_Renderer_Fixed is

pragma Elaborate_Body (Gtk.Cell_Renderer_Fixed);

--

-- Gtk_Cell_Renderer_Fixed_Record -- The renderer type

--

-- Customary, we need to declare a representation record type and an

-- interface access type for dealing with renderer's objects. The record

-- type is never used directly, though all operations are defined in its

-- terms.

--

type Gtk_Cell_Renderer_Fixed_Record is

new Gtk.Cell_Renderer.Abstract_Renderer.

Gtk_Abstract_Renderer_Record with private ;

type Gtk_Cell_Renderer_Fixed is

access all Gtk_Cell_Renderer_Fixed_Record'Class;

The type Gtk_Cell_Renderer_Fixed_Record is derived from the abstract cell renderer type Gtk_Abstract_Cell_Renderer_Record. The GtkAda convention is that the names of implementation types ends with the suffix _Record. The public type to use is Cell_Renderer_Fixed, which is an access type. GTK+ uses a reference counting to collect objects like Gtk_Abstract_Cell_Renderer_Record, more or less transparently to the user.

--

-- Finalize -- Overrides Gtk.Cell_Renderer.Abstract_Renderer...

--

overriding

procedure Finalize (Cell : not null access Gtk_Cell_Renderer_Fixed_Record);

The procedure Finalize of the parent type is overridden to have an ability to clean-up some internal data upon object finalization.

--

-- Get_Aligned_Area -- Overrides Gtk.Cell_Renderer.Abstract_Renderer...

--

overriding

function Get_Aligned_Area

( Cell : not null access Gtk_Cell_Renderer_Fixed_Record;

Widget : not null access Gtk_Widget_Record'Class;

Flags : Gtk_Cell_Renderer_State;

Cell_Area : Gdk_Rectangle

) return Gdk_Rectangle;

This function determines the area of the widget which will be used by the renderer.

--

-- Get_Property -- Overrides Gtk.Cell_Renderer.Abstract_Renderer...

--

overriding

procedure Get_Property

( Cell : not null access Gtk_Cell_Renderer_Fixed_Record;

Param_ID : Property_ID;

Value : out GValue;

Property_Spec : Param_Spec

);

Get_Property needs to be overridden to provide interface to the renderer's properties. The properties is the way GTK+ communicates with the renderer when it renders a cell. It extracts the cell value and sets the corresponding property of the renderer. Then it ask the renderer about the size required to show the value or ask it to render the value.

--

-- Get_Size -- Overrides Gtk.Cell_Renderer.Abstract_Renderer...

--

overriding

function Get_Size

( Cell : not null access Gtk_Cell_Renderer_Fixed_Record;

Widget : not null access Gtk.Widget.Gtk_Widget_Record'Class;

Cell_Area : Gdk_Rectangle

) return Gdk_Rectangle;

overriding

function Get_Size

( Cell : not null access Gtk_Cell_Renderer_Fixed_Record;

Widget : not null access Gtk.Widget.Gtk_Widget_Record'Class

) return Gdk_Rectangle;

--

-- Get_Type -- Get the type of cell renderer

--

-- Returns :

--

-- The type of

--

function Get_Type return Gtk_Type;

The procedures Get_Size are called to get the screen size required to render the currently set property of the renderer. The function Get_Type returns the GTK+ type of the renderer.

--

-- Gtk_New -- Factory

--

-- Cell - The result

-- After - The number of digits after decimal point

--

procedure Gtk_New

( Cell : out Gtk_Cell_Renderer_Fixed;

After : Natural := 0

);

--

-- Initialize -- Construction to be called once by any derived type

--

-- Cell - The renderer to initialize

-- After - The number of digits after decimal point

--

-- This procedure is never called directly, only from Gtk_New or else

-- from Initialize of a derived type. In the latter case a call to

-- Initialize is obligatory.

--

procedure Initialize

( Cell : not null access

Gtk_Cell_Renderer_Fixed_Record'Class;

After : Natural

);

The procedure Get_New provides the standard way to create a new renderer object. Internally, it calls to Iniialize, which shall be called by any derived type upon initialization of the latter.

--

-- Render -- Overrides Gtk.Cell_Renderer.Abstract_Renderer...

--

overriding

procedure Render

( Cell : not null access Gtk_Cell_Renderer_Fixed_Record;

Context : Cairo_Context;

Widget : not null access Gtk_Widget_Record'Class;

Background_Area : Gdk_Rectangle;

Cell_Area : Gdk_Rectangle;

Flags : Gtk_Cell_Renderer_State

);

--

-- Set_Property -- Overrides Gtk.Cell_Renderer.Abstract_Renderer...

--

overriding

procedure Set_Property

( Cell : not null access Gtk_Cell_Renderer_Fixed_Record;

Param_ID : Property_ID;

Value : GValue;

Property_Spec : Param_Spec

);

Render is called to display the renderer's property on the screen. Set_Property is a counterpart of Get_Property described above.

--

-- Start_Editing -- Overrides Gtk.Cell_Renderer.Abstract_Renderer...

--

overriding

function Start_Editing

( Cell : not null access Gtk_Cell_Renderer_Fixed_Record;

Event : Gdk_Event;

Widget : not null access Gtk_Widget_Record'Class;

Path : UTF8_String;

Background_Area : Gdk_Rectangle;

Cell_Area : Gdk_Rectangle;

Flags : Gtk_Cell_Renderer_State

) return Gtk_Widget;

Because the renderer is editable Start_Editing is overridden to provide the functionality.

private

--

-- Gtk_Cell_Renderer_Fixed_Record -- Implementation

--

-- The renderer maintains its state global to the column it renders.

-- That is the text widget it uses to render the number, the number of

-- places after the decimal point and the maximal width of the number

-- places before the point including the sign. This field is evaluated

-- dynamically and adjusted each time the renderer is queried for its

-- size or asked to render a cell. This heuristics might not work if new

-- rows are added to the tree model after it was rendered once.

--

type Gtk_Cell_Renderer_Fixed_Record is

new Gtk.Cell_Renderer.

Abstract_Renderer.Gtk_Abstract_Renderer_Record with

record

Text : Pango_Layout; -- The text to display

Value : GDouble := 0.0 ; -- Current value

After : Natural := 0 ; -- Places after the point

Max_Offset : GInt := 0 ; -- Pixel offset to the point

Height : GInt := 0 ; -- Current pixel height

Width : GInt := 0 ; -- Current pixel width

Left_Width : GInt; -- Current space before the point

Focus_Out : Handler_Id; -- Current focus_out_event handler

end record ;

The renderer's implementation consists of the following fields:

Text is a widget actually responsible for rendering texts;

is a widget actually responsible for rendering texts; Value holds the current value property of the renderer;

holds the current property of the renderer; After keeps the after property;

keeps the property; Max_Offset is the number of pixels to the place where the decimal point is shown. It is evaluated as the maximum length of among all cells of the rendered column. Which allows to align the numbers. This might happen not working if new rows are added without re-rendering all column cells, or when rows are removed.

is the number of pixels to the place where the decimal point is shown. It is evaluated as the maximum length of among all cells of the rendered column. Which allows to align the numbers. This might happen not working if new rows are added without re-rendering all column cells, or when rows are removed. Height and Width are in pixels. They are the rendered text's height and width for the current value of the property value .

and are in pixels. They are the rendered text's height and width for the current value of the property . Left_Width is the width of the rendered text before the decimal point. Max_Offset is calculated as a maximum of Left_Width;

is the width of the rendered text before the decimal point. Max_Offset is calculated as a maximum of Left_Width; Focus_Out.is the ID of the current focus_out_event handler. It is needed to disconnect the handler upon end of editing.

--

-- Editing_Done -- The handler of editing_done

--

procedure Editing_Done

( Editor : access Gtk_Entry_Record'Class;

Cell : Gtk_Cell_Renderer_Fixed

);

--

-- Focus_Out -- The handler of focus_out

--

function Focus_Out

( Editor : access Gtk_Entry_Record'Class;

Event : Gdk.Event.Gdk_Event;

Cell : Gtk_Cell_Renderer_Fixed

) return Boolean;

--

-- Entry_Callbacks -- To handle editing_done

--

package Entry_Callbacks is

new Gtk.Handlers.User_Callback

( Widget_Type => Gtk_Entry_Record,

User_Type => Gtk_Cell_Renderer_Fixed

);

--

-- Entry_Return_Callbacks -- To handle focus_out_event

--

package Entry_Return_Callbacks is

new Gtk.Handlers.User_Return_Callback

( Widget_Type => Gtk_Entry_Record,

Return_Type => Boolean,

User_Type => Gtk_Cell_Renderer_Fixed

);

end Gtk.Cell_Renderer_Fixed;

Here we declare the handlers for editing_done and focus_out_event. The handles will be connected to a Gtk_Entry widget, which will perform editing. We also instantiate User_Callback to connect Editing_Done and User_Return_Callback to connect Focus_Out.

The implementation of the package:

with Ada.Strings.Fixed; use Ada.Strings.Fixed;

with GLib.Properties; use GLib.Properties;

with Gtk.Enums; use Gtk.Enums;

with Gtk.Missed; use Gtk.Missed;

with Gtk.Style; use Gtk.Style;

with Gtk.Style_Context; use Gtk.Style_Context;

with Gtk.Widget; use Gtk.Widget;

with Pango.Cairo; use Pango.Cairo;

with Pango.Enums; use Pango.Enums;

with Pango.Font; use Pango.Font;



with Ada.Text_IO;



package body Gtk.Cell_Renderer_Fixed is



package GDouble_IO is new Ada.Text_IO.Float_IO (GDouble);

use GDouble_IO;

The package GDouble_IO is an instance of Ada.Text_IO.Float_IO used to render GDouble numbers to text.

Renderer_Type : GType := GType_Invalid;

Value_ID : constant Property_ID := 1 ;

After_ID : constant Property_ID := 2 ;



procedure Class_Init (Class : GObject_Class);

pragma Convention (C, Class_Init);



procedure Class_Init (Class : GObject_Class) is

use Gtk.Cell_Renderer.Abstract_Renderer;

begin

Base_Class_Init (Class);

Class_Install_Property

( Class,

Value_ID,

Gnew_Double

( Name => " value ",

Nick => " value ",

Blurb => " fixed point number ",

Minimum => GDouble'First,

Maximum => GDouble'Last,

Default => 0.0

) );

Class_Install_Property

( Class,

After_ID,

Gnew_UInt

( Name => " after ",

Nick => " aft ",

Blurb => " digits after decimal point ",

Minimum => 0 ,

Maximum => GDouble'Digits,

Default => 0

) );

end Class_Init;

The variable Renderer_Type holds the GTK+ type of the renderer. It is queried by Get_Type to determine whether the type is already registered in GTK+. Upon registration the procedure Class_Init will be called. The next two constants are the identifiers of the renderer's properties. GTK+ translates property name to the identifier when it calls Get_Property or Set_Property.

The procedure Class_Init is called by Get_Type once upon type registration. The implementation of Class_Init calls to the parent's Class_Init and then registers the properties of the renderer. Each renderer object will have these two properties.

procedure Editing_Done

( Editor : access Gtk_Entry_Record'Class;

Cell : Gtk_Cell_Renderer_Fixed

) is

begin

if Cell.Focus_Out.Id /= Null_Handler_Id then

Disconnect (Editor, Cell.Focus_Out);

Cell.Focus_Out.Id := Null_Handler_Id;

end if ;

Cell.Value :=

GDouble'Value (Trim (Get_Text (Editor), Ada.Strings.Both));

Stop_Editing (Cell, False);

Commit (Cell);

exception

when others =>

Stop_Editing (Cell, True);

end Editing_Done;

The handler of editing_done receives the Gtk_Entry widget as the parameter. The second parameter is the user data identifying the renderer. First the handler disconnects the renderer from focus_out_event. Then it takes the text from the entry widget and converts it to GDouble. Upon any error it cancels editing by calling Stop_Editing with Canceled = true . Otherwise it stores the new value into the renderer. Then it stops editing using, this time by using Stop_Editing with Canceled = false . Then it calls Commit to emit the commit signal.

procedure Finalize

( Cell : not null access Gtk_Cell_Renderer_Fixed_Record

) is

use Gtk.Cell_Renderer.Abstract_Renderer;

begin

if Cell.Text /= null then

Unref (Cell.Text);

end if ;

Finalize (Gtk_Abstract_Renderer_Record (Cell. all )' Access );

end Finalize;

Finalize releases the field Text and then calls the parent type's Finalize.

function Focus_Out

( Editor : access Gtk_Entry_Record'Class;

Event : Gdk.Event.Gdk_Event;

Cell : Gtk_Cell_Renderer_Fixed

) return Boolean is

begin

Editing_Done (Editor, Cell);

return False;

end Focus_Out;

The handler of focus_out_event simply calls to Editing_Done and returns.

function Get_Aligned_Area

( Cell : not null access Gtk_Cell_Renderer_Fixed_Record;

Widget : not null access Gtk_Widget_Record'Class;

Flags : Gtk_Cell_Renderer_State;

Cell_Area : Gdk_Rectangle

) return Gdk_Rectangle is

Area : Gdk_Rectangle := Cell.Get_Size (Widget, Cell_Area);

Result : Gdk_Rectangle;

begin

Result.X :=

( Cell_Area.X

+ GInt (Get_X_Pad (Cell))

+ Area.X

+ (Cell.Max_Offset - Cell.Left_Width)

);

Result.Y :=

( Cell_Area.Y

+ GInt (Get_Y_Pad (Cell))

+ Area.Y

);

Result.Width :=

GInt'Min

( Result.X - Cell_Area.X + Cell_Area.Width,

Area.Width

);

Result.Height :=

GInt'Min (Result.Y - Cell_Area.Y + Cell_Area.Height, Area.Height);

return Result;

end Get_Aligned_Area;

This function evaluates the area which will be used to render the value, see implementation of Render below.

procedure Get_Property

( Cell : not null access Gtk_Cell_Renderer_Fixed_Record;

Param_ID : Property_ID;

Value : out GValue;

Property_Spec : Param_Spec

) is

begin

case Param_ID is

when Value_ID =>

Init (Value, GType_Double);

Set_Double (Value, Cell.Value);

when After_ID =>

Init (Value, GType_UInt);

Set_UInt (Value, GUInt (Cell.After));

when others =>

Init (Value, GType_String);

Set_String (Value, " unknown ");

end case ;

end Get_Property;

The implementation of Get_Property is straightforward. It receives the identifier of the property and has to initialize the parameter Value with the value of the type of the property. Then it sets the property value into Value.

--

-- Update -- The widget associated with the renderer

--

-- Cell - The renderer

-- Widget - The widget it is used at

--

-- This procedure is used upon each call to either to render or to

-- evaluate the geometry of a cell. The renderer has no data associated

-- with any concrete cell of the tree view. It is called at random to

-- indicate all of them.

--

procedure Update

( Cell : in out Gtk_Cell_Renderer_Fixed_Record'Class;

Widget : in out Gtk.Widget.Gtk_Widget_Record'Class

) is

Text : String ( 1 .. 40 );

Start_Pos : Integer := Text'Last + 1 ;

Point_Pos : Integer := Text'Last + 1 ;

Right : GInt := Cell.Width - Cell.Max_Offset;

Line : GInt;

begin

if Cell.Text = null then

Cell.Text := Widget.Create_Pango_Layout;

end if ;

Put (Text, Cell.Value, Cell.After, 0 );

for Index in reverse Text'Range loop

-- Find the beginning of the number in the output string

if ' ' = Text (Index) then

Start_Pos := Index + 1 ;

exit ;

end if ;

end loop ;

for Index in Start_Pos..Text'Last loop

-- Find the position of the decimal point in the output

if ' . ' = Text (Index) then

Point_Pos := Index;

exit ;

end if;

end loop ;

Cell.Text.Set_Text (Text (Start_Pos..Text'Last));

Cell.Text.Get_Pixel_Size (Cell.Width, Cell.Height);

if Point_Pos <= Text'Last then

Cell.Text.Index_To_Line_X

( GInt (Point_Pos - Start_Pos),

False,

Line,

Cell.Left_Width

);

Cell.Left_Width := To_Pixels (Cell.Left_Width);

else

Cell.Left_Width := Cell.Width;

end if ;

Cell.Max_Offset := GInt'Max (Cell.Left_Width, Cell.Max_Offset);

Cell.Width :=

( Cell.Max_Offset

+ GInt'Max (Right, Cell.Width - Cell.Left_Width)

);

end Update;

The procedure Update is used internally to evaluate the renderer's state. First it checks if the field Text is already initialized. If not, it creates it using Create_Pango_Layout call. Note that it cannot be made earlier, upon renderer construction, because Create_Pango_Layout requires a widget parameter. The procedure Finalize will destroy this field.

Then the value of the property value is rendered to text using the procedure Put. It is guaranteed UTF-8, so there is no need to care about any conversions from Latin-1 encoding. The next two loops determine where the output starts in the output string Text (the variable Start_Pos) and where the decimal point is located (the variable Point_Pos).

The rendered text is set into the field Text and its size in pixels is calculated. After that, Index_To_Line_X is used to calculate the horizontal offset to the point. The result is in units, so it is converted to pixels; before placing into Left_Width field. The value of Left_Width influences Max_Offset, which is the maximum of all Left_Widths seen.

Then the total width of the cell is calculated as the sum of the space required before the decimal point and after it. The former obviously is Max_Offset. The latter is the maximum the space required for the current value and one has been required before the call (stored Cell.Width - Cell.Max_Offset).

function Get_Size

( Cell : not null access Gtk_Cell_Renderer_Fixed_Record;

Widget : not null access Gtk.Widget.Gtk_Widget_Record'Class

) return Gdk_Rectangle is

begin

Update (Cell. all , Widget. all );

return

( X => 0 ,

Y => 0 ,

Width => Cell.Width,

Height => Cell.Height

);

end Get_Size;

This variant of Get_Size is interested in only width and height of the rendered value. The implementation calls to Update and then returns the fields Width and Height.

function Get_Size

( Cell : not null access Gtk_Cell_Renderer_Fixed_Record;

Widget : not null access Gtk.Widget.Gtk_Widget_Record'Class;

Cell_Area : Gdk_Rectangle

) return Gdk_Rectangle is

begin

Update (Cell. all , Widget. all );

return

( X => GInt

( Get_X_Align (Cell)

* GFloat (Cell_Area.Width - Cell.Width)

),

Y => GInt

( Get_Y_Align (Cell)

* GFloat (Cell_Area.Height - Cell.Height)

),

Width => Cell.Width,

Height => Cell.Height

);

end Get_Size;

This variant is a little bit more complex because it specifies the surrounding rectangle. Again, Update is called and the positions of the left top corner are evaluated using alignment properties of the renderer.

function Get_Type return Gtk_Type is

use Gtk.Cell_Renderer.Abstract_Renderer;

begin

if Renderer_Type = GType_Invalid then

Renderer_Type :=

Register (" GtkCellRendererFixed ", Class_Init' Access );

end if ;

return Renderer_Type;

end Get_Type;

The function Get_Type checks if the renderer's GTK+ type is not yet registered and if so, then registers it by calling to Register of Gtk_Abstract_Renderer_Record. Two parameters of the function Register are the name of the GTK+ class and the class initialization procedure. Class_Init described above is used for the second.

procedure Gtk_New

( Cell : out Gtk_Cell_Renderer_Fixed;

After : Natural := 0

) is

begin

Cell := new Gtk_Cell_Renderer_Fixed_Record;

Initialize (Cell, After);

end Gtk_New;



procedure Initialize

( Cell : not null access

Gtk_Cell_Renderer_Fixed_Record'Class;

After : Natural

) is

use Gtk.Cell_Renderer.Abstract_Renderer;

begin

Initialize (Cell, Get_Type);

Cell.After := After;

end Initialize;

The implementation of Gtk_New allocates the object and calls to Initialize. The first thing Initialize has to do is to call parent's Initialize of Gtk_Abstract_Renderer_Record. The second parameter of it is the renderer's type. So it calls to Get_Type, which in turn registers the GTK+ type as necessary.

procedure Render

( Cell : not null access Gtk_Cell_Renderer_Fixed_Record;

Context : Cairo_Context;

Widget : not null access Gtk_Widget_Record'Class;

Background_Area : Gdk_Rectangle;

Cell_Area : Gdk_Rectangle;

Flags : Gtk_Cell_Renderer_State

) is

Area : Gdk_Rectangle := Cell.Get_Size (Widget, Cell_Area);

Style : Gtk_Style_Context := Get_Style_Context (Widget);

begin

Save (Context);

Rectangle

( Context,

GDouble (Cell_Area.X),

GDouble (Cell_Area.Y),

GDouble (Cell_Area.Width),

GDouble (Cell_Area.Height)

);

Clip (Context);

Render_Layout

( Style,

Context,

Get_Text_GC (Get_Style (Widget), Text_State),

( Cell_Area.X

+ GInt (Get_X_Pad (Cell))

+ Area.X

+ (Cell.Max_Offset - Cell.Left_Width)

),

( Cell_Area.Y

+ GInt (Get_Y_Pad (Cell))

+ Area.Y

),

Cell.Text

);

Restore (Context);

end Render;

The implementation of Render first calls to Get_Size to update the renderer's state and get the rectangle where the value has to be drawn into. The current style context of the widget is stored in Style. The drawing context is saved. Then the clipping rectangle determined by the parameter Cell_Area is set in the context. After that Render_Layout is called to draw the text of the field Text. The position of the left-top corner of the output is determined by the Cell_Area parameter of the procedure Render. Get_X_Pad and Get_Y_Pad are called to obtain actual padding. Area.X and Area.Y are returned by Get_Size and relative to the corner. The horizontal offset should be additionally adjusted to the difference between the maximal width of the output field before the decimal point and the width of the rendered text of the current value. Finally the context is restored.

procedure Set_Property

( Cell : not null access Gtk_Cell_Renderer_Fixed_Record;

Param_ID : Property_ID;

Value : GValue;

Property_Spec : Param_Spec

) is

begin

case Param_ID is

when Value_ID =>

Cell.Value := Get_Double (Value);

when After_ID =>

Cell.After := Integer (Get_UInt (Value));

when others =>

null ;

end case;

end Set_Property;

The procedure Set_Property is reverse to Get_Property described above.

function Start_Editing

( Cell : not null access Gtk_Cell_Renderer_Fixed_Record;

Event : Gdk_Event;

Widget : not null access Gtk_Widget_Record'Class;

Path : UTF8_String;

Background_Area : Gdk_Rectangle;

Cell_Area : Gdk_Rectangle;

Flags : Gtk_Cell_Renderer_State

) return Gtk_Widget is

Editor : Gtk_Entry;

Text : String ( 1 .. 40 );

Start_Pos : Integer := Text'Last + 1 ;

begin

Put (Text, Cell.Value, Cell.After, 0);

for Index in reverse Text'Range loop

-- Find the beginning of the number in the output string

if ' ' = Text (Index) then

Start_Pos := Index + 1 ;

exit ;

end if ;

end loop ;

The procedure Start_Editing is called upon editing request. For example when a cell is doubly clicked. First the renderer formats a string with the current value of the cell. The parameters of Start_Editing are similar to ones of Render. The additional parameter Path identifies the row the cell being edited belongs to. You don't need to store this string because the base type does it for you. Get_Path can be later used to obtain it. First, Start_Editing stores the current value in Text (1..Start_Pos).

Gtk_New (Editor);

Set_Property (Editor, Build (" xalign "), Get_X_Align (Cell));

Set_Property (Editor, Build (" has-frame "), False);

Editor.Set_Text (Text (Start_Pos..Text'Last));

Select_Region (Editor, 0 , - 1 );

Entry_Callbacks.Connect

( Editor,

" editing_done ",

Entry_Callbacks.To_Marshaller (Editing_Done' Access ),

Cell.all' Access

);

Cell.Focus_Out :=

Entry_Return_Callbacks.Connect

( Editor,

" focus_out_event ",

Entry_Return_Callbacks.To_Marshaller (Focus_Out' Access ),

Cell.all'Access

);

Editor.Show;

return Editor.all' Access ;

end Start_Editing;

end Gtk.Cell_Renderer_Fixed;

Then an entry widget is created and the text is set into the widget. Some additional settings are applied to the widget. Its horizontal alignment is set from the corresponding renderer's property. Its frame is removed. The content is selected (Select_Region). Then Editing_Done and Focus_Out are connected to the widget. Finally, it is shown and returned. Note that there is no need to care about removing the widget, it is a responsibility of the caller.

2.4.2. Test program

File test_gtk_fixed.adb:



with Ada.Numerics.Float_Random; use Ada.Numerics.Float_Random;

with GLib; use GLib;

with GLib.Properties; use GLib.Properties;

with GLib.Values; use GLib.Values;

with Gtk.Enums; use Gtk.Enums;

with Gdk.Event; use Gdk.Event;

with Gtk.List_Store; use Gtk.List_Store;

with Gtk.Widget; use Gtk.Widget;

with Gtk.Window; use Gtk.Window;

with Gtk.Cell_Renderer_Fixed; use Gtk.Cell_Renderer_Fixed;

with Gtk.Cell_Renderer_Text; use Gtk.Cell_Renderer_Text;

with Gtk.Tree_View_Column; use Gtk.Tree_View_Column;

with Gtk.Tree_Model; use Gtk.Tree_Model;

with Gtk.Tree_View; use Gtk.Tree_View;

with Gtk.Scrolled_Window; use Gtk.Scrolled_Window;



with Ada.Unchecked_Conversion;

with Gtk.Main;

with Gtk.Missed;

with Test_Gtk_Fixed_Handlers;



procedure Test_Gtk_Fixed is



Window : Gtk_Window;

Table_View : Gtk_Tree_View;

Scroller : Gtk_Scrolled_Window;



type Local_Callback is access procedure

( Cell : access Gtk_Cell_Renderer_Fixed_Record'Class;

Store : Gtk_List_Store

);

function " + " is

new Ada.Unchecked_Conversion

( Local_Callback,

Test_Gtk_Fixed_Handlers.Simple_Handler

);



procedure Commit

( Cell : access Gtk_Cell_Renderer_Fixed_Record'Class;

Store : Gtk_List_Store

) is

Row : Gtk_Tree_Iter :=

Get_Iter_From_String (Store, Get_Path (Cell));

Value : GValue;

begin

if Row /= Null_Iter then

Init (Value, GType_Double);

Set_Double (Value, Get_Property (Cell, Build (" value ")));

Set_Value (Store, Row, 0 , Value);

Unset (Value);

end if ;

end Commit;



begin

Gtk.Main.Init;

Gtk.Window.Gtk_New (Window);

Window.Set_Title (" Test Fixed-Point Cell Renderer ");

Window.On_Delete_Event (Gtk.Missed.Delete_Event_Handler' Access );

Window.On_Destroy (Gtk.Missed.Destroy_Handler' Access );

Gtk_New (Scroller);

Gtk_New (Table_View);

The above is mostly standard GTK+ initialization stuff, except the procedure Commit and instantiation of User_Callback for it. The variables Table_View is a tree view widget and its scroll bar. The procedure Commit is attached to the renderer to store editing changes into the list store. It uses Get_Iter_From_String applied to Get_Path to obtain the iterator of the edited row. Then it queries the value from the renderer and stores it into the first column of the row. The package Test_Gtk_Fixed_Handlers is the following instantiation of event handlers:

File test_gtk_fixed_handlers.ads:



with Gtk.Cell_Renderer_Fixed; use Gtk.Cell_Renderer_Fixed;

with Gtk.List_Store; use Gtk.List_Store;



with Gtk.Handlers;



package Test_Gtk_Fixed_Handlers is

new Gtk.Handlers.User_Callback

( Gtk_Cell_Renderer_Fixed_Record,

Gtk_List_Store

);

File test_gtk_fixed.adb (continued):



-- Creating a column of numbers (list store)

declare

Table : Gtk_List_Store;

declare

Row : Gtk_Tree_Iter := Null_Iter;

Value : GValue;

Source : Generator;

begin

Init (Value, GType_Double);

Gtk_New (Table, ( 0 => GType_Double));

-- Filling the column with random numbers

for Item in 1 .. 1000 loop

Table.Append (Row);

Set_Double

( Value,

GDouble ( 100.0 * (Random (Source) - 0.5 ))

);

Set_Value (Table, Row, 0 , Value);

end loop ;

-- Attaching the column store to its view

Table_View.Set_Model (To_Interface (Table));

Unset (Value);

end ;

This fragment creates a list store (Table) consisting of one column of GDouble data. The column is filled with randomly generated numbers from in the range -50..50. Finally the store is attached to the widget.

File test_gtk_fixed.adb (continued):



-- Creating columns in the view

declare

Column_No : GInt;

Column : Gtk_Tree_View_Column;

Numeric : Gtk_Cell_Renderer_Fixed;

Text : Gtk_Cell_Renderer_Text;

begin

-- The first column will use the fixed-point renderer

Gtk_New (Column);

Column.Set_Title (" Value ");

Gtk_New (Numeric, 3 );

Numeric.Set_Mode (Cell_Renderer_Mode_Editable);

Commit_Handlers.Connect

( Numeric,

" commit ",

Commit'Access,

Table

);

Column.Pack_Start (Numeric, False);

-- Map column's renderer to the table's column 0

Column.Add_Attribute (Numeric, " value ", 0 );

Column_No := Table_View.Append_Column (Column);

Column.Set_Resizable (True);

Column.Set_Sort_Column_Id ( 0 );



-- The second column uses the standard text renderer

Gtk_New (Column);

Column.Set_Title (" Text ");

Gtk_New (Text);

Column.Pack_Start (Text, True);

-- Map column's renderer to the table's column 0

Column.Add_Attribute (Text, " text ", 0 );

Column_No := Table_View.Append_Column (Column);

Column.Set_Resizable (True);

Column.Set_Sort_Column_Id ( 0 );

end ;

end ;

Here the two columns are added to the tree view widget. The first column uses Gtk_Cell_Renderer_Fixed to render the first column of the list store. Note that Add_Attribute refers to the property value of the renderer. The renderer is set to editable mode using Set_Mode. The procedure Commit is connected to the commit signal of the renderer. The second column uses the standard text renderer to render the same first column of the store.

File test_gtk_fixed.adb (continued):



Scroller.Set_Policy (Policy_Automatic, Policy_Automatic);

Scroller.Add (Table_View);

Window.Add (Scroller);



Table_View.Show;

Scroller.Show;

Window.Show;

Gtk.Main.Main;

end Test_Gtk_Fixed;

Finally the scroll bar is added to the widget, all things are shown and messages loop is entered. The result might look like:

2.6. Columned model

The package Gtk.Tree_Model.Columned_Store provides a derived tree model. The model contains columns of the reference model composed in n columns. When the reference model itself has m columns then the derived model will have total n · m columns. The cells of the reference model are arranged top-bottom, left-to-right as shown on the figure:

Reference model,

m=3 Derived columned model,

with n=3 major columns a 1 b 1 c 1 a 2 b 2 c 2 a 3 b 3 c 3 a 4 b 4 c 4 a 5 b 5 c 5 a 6 b 6 c 6 a 7 b 7 c 7 a 8 b 8 c 8 a 1 b 1 c 1 a 4 b 4 c 4 a 7 b 7 c 7 a 2 b 2 c 2 a 5 b 5 c 5 a 8 b 8 c 8 a 3 b 3 c 3 a 6 b 6 c 6

The model is flat as a list and contains the immediate descendants of a node from the reference model. Note also the model itself does not have means to manipulate its content. When it is necessary to modify the content, the reference model is dealt with. The columned model will automatically follow the changes made on the reference model. This includes translation of the reference model signals into ones of the columned model. For example reference model row removal may manifest itself as a series of columned model signals like row changing and row deletion. Additionally to the standard signals of a tree model the signal root-changed is emitted immediately after changing the root of the columned store. This may happen, for example, when the root of the columned model is deleted from the reference one. That causes it to change to the most nested ancestor node.

type Gtk_Columned_Store_Record is

new Gtk_Abstract_Model_Record with private ;

type Gtk_Columned_Store is

access all Gtk_Columned_Store_Record'Class;

The following subprograms are defined in the package:

function From_Columned

( Model : not null access Gtk_Columned_Store_Record;

Iter : Gtk_Tree_Iter;

Column : Positive

) return Gtk_Tree_Iter;

function From_Columned

( Model : not null access Gtk_Columned_Store_Record;

Path : Gtk_Tree_Path;

Column : Positive

) return Gtk_Tree_Path;

These functions convert an iterator or path of the columned model to the corresponding iterator or path of the reference model. The additional parameter is the major column number 1..n, where n is the number of columns specified upon model creation in Gtk_New. The result is Null_Iter or null path on an error. Note that the returned path has to be freed using Path_Free.

function Get_Column_Height

( Model : not null access Gtk_Columned_Store_Record;

Column : Positive

) return Natural;

This function returns the number of filled rows in the major column Column. The result is 0 when Column is greater than the number of major columns.

function Get_Major_Columns

( Model : not null access Gtk_Columned_Store_Record

) return Positive;

This function returns the number of major columns, i.e. the parameter Columns as it was specified upon model creation in Gtk_New or Set_Reference.

function Get_Reference

( Model : not null access Gtk_Columned_Store_Record

) return Gtk_Tree_Model;

This function returns the reference model.

function Get_Reference_Iter

( Model : not null access Gtk_Columned_Store_Record;

Row : Positive;

Column : Positive

) return Gtk_Tree_Iter;

This function composes an iterator to the reference model row specified by its Row and Column. The result is Null_Iter when Row and Column do not specify a reference model row.

function Get_Root

( Model : not null access Gtk_Columned_Store_Record

) return Gtk_Tree_Iter;

This function returns an iterator of reference model to the root of the derived model. All nodes of the derived model are immediate descendants of.

function Get_Root

( Model : not null access Gtk_Columned_Store_Record

) return Gtk_Tree_Path;

This function returns the path in reference model to the root of the derived model. The result shall be freed using Path_Free if not null .

function Get_Rows

( Model : not null access Gtk_Columned_Store_Record;

Filled : Boolean

) return Natural;

This function returns the number of rows. When the parameter Filled is true , only complete rows count. Otherwise any does.

function Get_Row_Width

( Model : not null access Gtk_Columned_Store_Record;

Row : Positive

) return Natural;

This function returns the number of filled columns in the row Row. The result is 0 when Row is greater than the number of rows.

procedure Gtk_New

( Model : out Gtk_Columned_Store;

Reference : not null access Gtk_Root_Tree_Model_Record'Class;

Columns : Positive;

Root : Gtk_Tree_Iter := Null_Iter

);

The model is constructed by specifying the reference model, the number of columns and the derived model's root (the parameter Root). By default the root is one of the reference model. The derived model will contain only immediate children on Root.

procedure Gtk_New (Model : out Gtk_Columned_Store);

This variant construct an empty model which can be later bound to a reference model using Set_Reference.

procedure Initialize

( Model : not null access Gtk_Columned_Store_Record'Class;

Reference : not null access Gtk_Root_Tree_Model_Record'Class;

Columns : Positive;

Parent : Gtk_Tree_Iter

);

procedure Initialize (Model : access Gtk_Columned_Store_Record'Class);

One of these procedures is to be called by any derived type from its Initialize.

function Is_Ancestor

( Model : not null access Gtk_Columned_Store_Record;

Iter : Gtk_Tree_Iter

) return Boolean;

function Is_Ancestor

( Model : not null access Gtk_Columned_Store_Record;

Path : Gtk_Tree_Iter

) return Boolean;

These functions return true if the root of the columned model is an ancestor of the iterator or path specified in the reference model.

function Is_Descendant

( Model : not null access Gtk_Columned_Store_Record;

Iter : Gtk_Tree_Iter

) return Boolean;

function Is_Descendant

( Model : not null access Gtk_Columned_Store_Record;

Path : Gtk_Tree_Iter

) return Boolean;

These functions return true if the root of the columned model is a descendant of the iterator or path in the reference model.

function To_Columned

( Model : not null access Gtk_Columned_Store_Record;

Iter : Gtk_Tree_Iter

) return Gtk_Tree_Iter;

function To_Columned

( Model : not null access Gtk_Columned_Store_Record;

Path : Gtk_Tree_Path

) return Gtk_Tree_Path;

These functions convert an iterator or path of the reference model to the corresponding iterator or path of the columned model. The result is Null_Iter or null path on an error. Note that the returned path has to be freed using Path_Free.

procedure To_Columned

( Model : not null access Gtk_Columned_Store_Record;

Iter : in out Gtk_Tree_Iter;

Column : out Positive

);

This procedure is a variant of iterator conversion which also yields the major column number 1..n, where n is the number of columns specifi