From mboxrd@z Thu Jan  1 00:00:00 1970
X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me
X-Spam-Level: 
X-Spam-Status: No, score=-1.3 required=5.0 tests=BAYES_00,INVALID_MSGID,
	T_FILL_THIS_FORM_SHORT autolearn=no autolearn_force=no version=3.4.4
X-Google-Language: ENGLISH,ASCII-7-bit
X-Google-Thread: 103376,ddba00b4baf322d8,start
X-Google-Attributes: gid103376,public
From: njt@sv1pc161.cs.york.ac.uk (Nigel J. Tracey)
Subject: Access to primitive operations of tagged types
Date: 1997/03/18
Message-ID: <hkbmg5.2h2.ln@localhost>#1/1
X-Deja-AN: 226471313
Organization: The University of York, UK
Newsgroups: comp.lang.ada
Date: 1997-03-18T00:00:00+00:00
List-Id: <comp.lang.ada>


Hi,

I am having a go at writing a class hierarchy to interface to X-Windows/
Motif. My idea was to have tagged types for each of the widgets in
Motif with various functions. Among these functions would be null functions
for the callbacks. The user could then derive there own type from the
widget-tagged type and over-ride these callbacks with there own custom
functions.

My problem is however that I cannot pass an access to the callback functions
when installing the callback routine in X.
The Ada RM states that a dereference of an access-to-subprogram value is
never a dispatching call.

Does this mean I cannot do the above?

With GNAT 3.09 (i686/Linux 2.0.29) and the bindings to X11/Motif
from Intermetrics. I get the following error

primitive-label-pushbutton.adb:27:10:
  subprogram has invalid convention for context

The code is as follows :-

package Primitive is

   type Primitive_Widget is tagged private;

private

   type Primitive_Widget is tagged
      record
         Widget : Xt.Intrinsic.Widget;
      end record;

end Primitive;


package Primitive.Label is

      type Label_Widget is new Primitive_Widget with private;

private

   type Label_Widget is new Primitive_Widget with null record;

end Primitive.Label;


package Primitive.Label.PushButton is

   type PushButton_Widget is new Label_Widget with private;

   procedure Initialize ...

   procedure ActivateCallback ...
   
private

   type PushButton_Widget is new Label_Widget with null record;

end Primitive.Label.PushButton;


package body Primitive.Label.PushButton is

   ...

   procedure Initialize
               (Widget : in out Label_Widget;
                Parent : in     Xt.Intrinsic.Widget;
                Name   : in     String;
                Args   : in     Xt.Intrinsic.ArgList;
                Num    : in     Xt.Intrinsic.Cardinal)
   is
   begin
      Widget.Widget := Xt.Intrinsic.XtCreateWidget
                         (X.Strings.New_String (Name),
                          Motif.PushB.xmPushButtonWidgetClass_obj,
                          Parent,
                          Args,
                          Num);

      Xt.Intrinsic.XtAddCallback
        (Widget.Widget, Motif.XmStrDefs.XmNactivateCallback,
         ActivateCallback'Access,                  -- Line 27 Here
         null);

  end Initialize;

   procedure ActivateCallback
               (Widget      : in Xt.Intrinsic.Widget;
                Client_Data : in Xt.Intrinsic.XtPointer;
                Call_Data   : in Xt.Intrinsic.XtPointer)
   is
   begin
      Ada.Text_IO.Put_Line ("Activate Putton - Standard");
   end ActivateCallback;

   ...
   
end Primitive.Label.PushButton;


Thanks for any clues,

Nigel

--------------------
Nigel J. Tracey MEng, Research Associate (High Integrity Systems Group).
Department of Computer Science,   Office: X/D016
University of York,               Tel   : [0|+44]1904 432769
York, England.                    E-Mail: njt@minster.york.ac.uk
YO1 5DD.