Re: Ada/Motif problem...

[Michael K Rohan <mrohan@ix.netcom.com>]

Dale Stanbrough wrote:
> 
> Larry Kilgallen writes:
> 
> "Understanding that you have asked us how to lie to an Ada compiler...
> 
> > Any inspiration on how to pass Ada strings as callback data in Motif?
> 
> Depending on compiler specifics, you may be able to get away with
> an access to a single character (the first in the string).
> 
> Larry Kilgallen"
> 
> But that doesn't really help at the other end, that is the routine that
> gets called and gets passed a pointer to a character. It may know that
> it points to the first character of a string, but how should it know how
> long the string is? We lose the bounds of the string if we do this.
> 
> Dale

Hi,

I am currently learning Motif programming and Ada95 together by going
thru
Power Programming...Motif and implementing the examples in Ada95.  The
pullmenu example of Chapter 4, passes strings as client data.

This response is rather long, but the solution I came up with was to use
a another type (Label) with the unchecked conversion routines.  The
callback spec is

    --
    -- Callbacks used for the PullMenu example program
    --

    with Ada.Unchecked_Conversion;
    with Xt.Intrinsic;

    package Callbacks is

        --
        -- Exception to ``break-out'' of the X event loop
        Finished : exception;

        type Label (L : Positive) is
            record
                Text : String(1..L);
            end record;
        --
        -- Type used for client argument to callbacks (strings)
        type Label_Pointer is access all Label;

        --
        -- Conversion functions to/from Label_Pointer/XtPointer
        function Label_Pointer_To_XtPointer is
            new Ada.Unchecked_Conversion(Label_Pointer,
Xt.Intrinsic.XtPointer);
        function XtPointer_To_Label_Pointer is
            new Ada.Unchecked_Conversion(Xt.Intrinsic.XtPointer,
Label_Pointer);

        --
        -- The exit callback
        procedure Exit_Callback (Widget      : Xt.Intrinsic.Widget;
                                 Client_Data : Xt.Intrinsic.XtPointer;
                                 Call_Data   : Xt.Intrinsic.XtPointer);

        --
        -- The generic callback used for all other callbacks in the
program
        procedure Generic_Callback (Widget : Xt.Intrinsic.Widget;
                                    Client_Data :
Xt.Intrinsic.XtPointer;
                                    Call_Data   :
Xt.Intrinsic.XtPointer);

    private

        pragma Convention(C, Exit_Callback);
        pragma Convention(C, Generic_Callback);

    end Callbacks;

with body

    --
    -- Callbacks used for the Pull_Menu example program
    --

    with Ada.Text_IO;

    package body Callbacks is

        --
        -- The exit callback
        procedure Exit_Callback (Widget      : Xt.Intrinsic.Widget;
                                 Client_Data : Xt.Intrinsic.XtPointer;
                                 Call_Data   : Xt.Intrinsic.XtPointer)
is
        begin
            Generic_Callback(Widget, Client_Data, Call_Data);
            raise Finished;
        end Exit_Callback;

        --
        -- The generic callback used for all other callbacks in the
program
        procedure Generic_Callback (Widget      : Xt.Intrinsic.Widget;
                                    Client_Data :
Xt.Intrinsic.XtPointer;
                                    Call_Data   :
Xt.Intrinsic.XtPointer) is
            L : Label_Pointer :=
XtPointer_To_Label_Pointer(Client_Data);
        begin
            Ada.Text_IO.Put_Line("Menu callback for [" & L.Text & "]");
            Ada.Text_IO.Flush;
        end Generic_Callback;

    end Callbacks;

The main program (Utilities.Create_Push_Button calls XtAddCallback),
abbreviated is,

    --
    -- Main program for the ``Power Programming...Motif'' pullmenu
example
    -- program of Chapter 4.
    --

    procedure PullMenu is

        use Motif.XmStrDefs;
        use Motif.Ada_Support.Stdarg;

        --
        -- Utility routine to generate a Label_Pointer from a string.
        -- Label_Pointer's are passed to the callbacks as the client
data
        function "+" (S: String) return Xt.Intrinsic.XtPointer is
            Result : Callbacks.Label_Pointer := new
Callbacks.Label(S'Length);
        begin
            Result.Text := S;
            return Callbacks.Label_Pointer_To_XtPointer(Result);
        end "+";

        .
        .

    begin
        .
        .

        -- Set up menu choices for File menu.
        W := Utilities.Create_Push_Button(File_Menu, "new",
                                         
Callbacks.Generic_Callback'access,
                                          +"New");
        .
        .
    exception
        when Callbacks.Finished => null;
    end PullMenu;

Have fun,
Michael.