home *** CD-ROM | disk | FTP | other *** search
- Path: sparky!uunet!noc.near.net!genrad.com!genrad.com!not-for-mail
- From: amj@sparcle.genrad.com (Andrew M. Jackson)
- Newsgroups: comp.lang.ada
- Subject: DEC - OSF/Motif - Ada Bindings
- Date: 20 Nov 1992 11:07:18 -0500
- Organization: GenRad, Inc.
- Lines: 95
- Message-ID: <1ej2fmINN260@sparcle.genrad.com>
- NNTP-Posting-Host: sparcle.genrad.com
- Keywords: Help
-
- I am trying to learn Ada and I would like to use the Motif bindings in a small
- program I am writing. I am using a DEC compiler on a VMS system. My question
- is how do I pass a procedure's address when registering a callback? In the code
- below the procedure call XTADDCALLBACK is intending to pass the procedure
- finish's address as an argument. The compiler gives an error of address evaluating
- to zero and nor import/export pragma specified.
-
- Could someone please tell me how this should be done.
-
- Thanks,
- Andrew
- ----------------------------------------------------------------------------------
- with SYSTEM; use SYSTEM;
- with STARLET; use STARLET;
- with X;
- with MOTIF; use MOTIF;
- with Text_IO;
-
- package line is
-
- top_level : WIDGET_TYPE;
- form : WIDGET_TYPE;
- canvas : WIDGET_TYPE;
- menubar : WIDGET_TYPE;
- option : UNSIGNED_LONGWORD_ARRAY(1..10);
- done : WIDGET_TYPE;
- wargs : ARG_TYPE_ARRAY(1..10);
-
-
- procedure line_draw(ARGC : in out CARDINAL_TYPE;
- ARGV : in out ADDRESS_ARRAY);
- procedure set_args(ARGLIST : in out ARG_TYPE_ARRAY; ARG_NUM : in INTEGER;
- NAME : in ADDRESS; VALUE : in XTARGVAL_TYPE);
- procedure finish(CLIENT_DATA : in XTPOINTER_TYPE);
- end line;
-
- package body line is
-
- procedure line_draw(ARGC : in out CARDINAL_TYPE; ARGV : in out ADDRESS_ARRAY) is
- call_back_data : XTCALLBACKPROC_TYPE;
- begin
-
- XTINITIALIZE(top_level, "line_draw", "Line_draw", option, 0, ARGC, ARGV);
-
- XTCREATEMANAGEDWIDGET(form, "formtest", XMFORMWIDGETCLASS, top_level, wargs, 0);
-
- XTCREATEMANAGEDWIDGET(canvas, "canvas", XMFORMWIDGETCLASS, form, wargs, 0);
-
- set_args(wargs, 1, XTNWIDTH'ADDRESS, 400);
- set_args(wargs, 2, XTNHEIGHT'ADDRESS, 400);
- XTSETVALUES(canvas, wargs, 2);
-
- XMCREATEMENUBAR(menubar, form, "menubar", wargs, 0);
- XTMANAGECHILD(menubar);
-
- XTCREATEMANAGEDWIDGET(done, "DONE", XMCASCADEBUTTONWIDGETCLASS, menubar, wargs, 0);
- XTADDCALLBACK(done, XMNACTIVATECALLBACK, finish'ADDRESS, call_back_data);
-
- set_args(wargs, 1, XMNTOPATTACHMENT'ADDRESS, XMATTACH_FORM);
- set_args(wargs, 2, XMNLEFTATTACHMENT'ADDRESS, XMATTACH_FORM);
- set_args(wargs, 3, XMNRIGHTATTACHMENT'ADDRESS, XMATTACH_FORM);
- XTSETVALUES(menubar, wargs, 3);
-
- set_args(wargs, 1, XMNTOPATTACHMENT'ADDRESS, XMATTACH_WIDGET);
- set_args(wargs, 2, XMNLEFTATTACHMENT'ADDRESS, XMATTACH_FORM);
- set_args(wargs, 3, XMNRIGHTATTACHMENT'ADDRESS, XMATTACH_FORM);
- set_args(wargs, 4, XMNBOTTOMATTACHMENT'ADDRESS, XMATTACH_FORM);
- XTSETVALUES(canvas, wargs, 4);
-
- XTREALIZEWIDGET(top_level);
- XTMAINLOOP;
-
- end line_draw;
-
- procedure set_args(ARGLIST : in out ARG_TYPE_ARRAY; ARG_NUM : in INTEGER;
- NAME : in ADDRESS; VALUE : in XTARGVAL_TYPE) is
- begin
-
- ARGLIST(ARG_NUM).NAME := NAME;
- ARGLIST(ARG_NUM).VALUE := VALUE;
-
- end set_args;
-
- procedure finish(CLIENT_DATA : in XTPOINTER_TYPE) is
-
- begin
- Text_IO.Put_Line("Done Button has been selected");
- end finish;
-
- end line;
-
-
-
-
-
-