Motif Hello_World with UIL

["John J Cupak Jr, CCP" <jcj@swl.msd.ray.com>]

[-- Attachment #1: Type: text/plain, Size: 1178 bytes --]

Greetings, Oh Ada Wizards of the Ether!

We have a customer who wishes to reuse their existing GUI, expressed in
UIL, with their application software that they are rewriting in Ada 95.

By way of support, I am attempting to translate the hello_world.c
program on page 778 of O'Reilly's Motif Programming Manual, Volume 6A
into Ada 95 using the Ada 95 Xlib bindings. 

Now, I profess to know Ada 95, and have done a bit of X and Motif
programming (in Ada, no less), but seem to be having problems
implementing this particular example. So, I have attached my poor
attempt to this message in the hopes that some kindly soul will point
out my not-to-obvious errors.

I will repost the solution to the net when it's done for anyone else to
use.

Thanks

(Ducking my head to avoid the flame-throwers!)

-- 
--------------------------------------------------------------
-                 John J. Cupak Jr, CCP                      -
- Raytheon Systems Company - Software Engineering Laboratory -
- tel: 978-858-1222   email (work): jcj@swl.msd.ray.com      -
- fax: 978-858-4336   email (home): jcupak@aol.com           -
--------------------------------------------------------------

[-- Attachment #2: hello_world.adb --]
[-- Type: text/plain, Size: 4606 bytes --]

   with Motif.Xm;      -- #include <Xm/Xm.h>
   with Mrm.MrmPublic; -- #include <Mrm/MrmPublic.h>
   with Mrm.MrmDecls;  -- #include <Mrm/MrmDecls.h>
   with Xt.Intrinsic;  -- #include <Xt/Xt.h>
   with Xt.Composite;  -- #include <Xt/Xt.h>
   with X.Args;
   with X.Strings;
   with Stdarg;

   with Ada.Text_IO;   -- #include <stdio.h>
   with Ada.Command_Line; -- Error reporting
   with Interfaces.C;

   procedure Hello_World is -- (int argc, char *argv[])
   
      --
      -- error - Print an error message and exit with failure status.
      --
      procedure Error(Message : in String) is
      begin
         Ada.Text_IO.Put_Line
            (Ada.Text_IO.Standard_Error,
            "hello_world: " & Message);
         Ada.Command_Line.Set_Exit_Status(Ada.Command_Line.Failure); -- exit(1)
      end Error;
   
      --
      -- quit - The quit callback procedure.  Exits the program with success status.
      --
      procedure Quit
      (W           : in Xt.Intrinsic.Widget;
      Client_Data : in Xt.Intrinsic.XtPointer;
      Call_Data   : in Xt.Intrinsic.XtPointer);
   
   pragma Convention(C, Quit);
   
      procedure Quit
      (W           : in Xt.Intrinsic.Widget;
      Client_Data : in Xt.Intrinsic.XtPointer;
      Call_Data   : in Xt.Intrinsic.XtPointer) is
      begin -- Quit
         Ada.Text_IO.Put_Line(Client_Data); -- Convert to String first
         Ada.Command_Line.Set_Exit_Status(Ada.Command_Line.Success); -- exit(0)
      end Quit;
   
   
      Callback_List : constant Mrm.MrmPublic.MrmRegisterArgList := (("Quit", Quit'Access));
   
      App_Context   : aliased Xt.Intrinsic.XtAppContext;             -- Application Context
      TopLevel      : Xt.Intrinsic.Widget;         -- Top level widget
      Hello_Main    : aliased Xt.Intrinsic.Widget; -- Main Widget (for 'access)
      Status        : Xt.Intrinsic.Cardinal;       -- Mrm return status
   
      UID_File_List : constant String := "hello_world"; 
      Hierarchy     : aliased Mrm.MrmPublic.MrmHierarchy;
      Class_Code    : aliased Mrm.MrmPublic.MrmType; -- for 'access
   
      The_String    : Motif.Xm.XmString;   -- Label and Pushbutton string
   
      Null_String   : constant X.Strings.Const_Charp := null;
   
      function "&" is new Stdarg.Concat(X.Strings.Const_Charp);
      function "&" is new Stdarg.Concat(Motif.Xm.XmString);
   
      use type Xt.Intrinsic.Cardinal; -- Compare status values
   
   begin -- Hello_World
   
      Xt.Intrinsic.XtSetLanguageProc(null, null, null); -- app_context,proc,client_data
   
      TopLevel := Xt.Intrinsic.XtVaAppInitialize
         (App_Context'access,         -- Application context
         "Hello",                     -- Application class name
         null,                        -- Command-line option list
         0,                           -- No Options
         X.Args.Argc'access,          -- Arg count
         X.Args.Argv,                 -- Args
         null,                        -- No app-defaults file
         Stdarg.Empty & Null_String); -- No arguments
   
      Status := Mrm.MrmDecls.MrmOpenHierarchyPerDisplay
         (Xt.Intrinsic.XtDisplay(TopLevel), -- Display
         UID_File_List'length,              -- Num files
         UID_File_List,                     -- File list *** NEED access to "Charp" ***
         null,                              -- OS Data
         Hierarchy'Access);
   
      if (Status /= Mrm.MrmPublic.MrmSUCCESS) then
         Error("Unable to open hello_world.uid file.");
      end if;
   
     -- Instead of the XtNumber macro, in Ada use Array'Length
   
      Status := Mrm.MrmDecls.MrmRegisterNames
   	  (Callback_List,
         Callback_List'length); -- *** Must be array ***
   
      if (Status /= Mrm.MrmPublic.MrmSUCCESS) then
         Error("Unable to register callback functions with Mrm");
      end if;
   
      The_String := Motif.Xm.XmStringCreateSimple("Hello_World");
      Status := Mrm.MrmDecls.MrmFetchWidget
         (Hierarchy,          -- Hierarchy to search
         Stdarg.Empty & The_String & Null_String,
         TopLevel,           -- Parent
         Hello_World'Access, -- Widget created
         Class_Code'Access); -- Widget's class code 
   
      if (Status /= Mrm.MrmPublic.MrmSUCCESS) then
         Error("Unable to create interface from UID file.");
      end if;
   
      Mrm.MrmDecls.MrmCloseHierarchy(Hierarchy); -- *** Expect procedure name in procedure call!
   
      Xt.Composite.XtManageChild(Hello_Main);
      Xt.Intrinsic.XtRealizeWidget(TopLevel);
   
      Xt.Intrinsic.XtAppMainLoop(App_Context);
   
   end Hello_World;