-------------------------------------------------------------------------------------- -- Ada language interface to OSF/Motif toolkit -- -- Version: 1.0 -- -- Release date: -- -- Compiled under: -- VADS 5.5+ on Apollo Domain / DEC Ultrix / SCO Unix -- -- This is an Ada binding to the OSF Motif toolkit. -- Requires: -- OSF/Motif toolkit -- Verdix (or Verdix-derived) Ada libraries -- -- Author: -- Boeing Commercial Airplanes Avionics Flight Systems Organization -- -- -- Mailing Address: -- P.O. Box 3999, M/S 65-07 -- Seattle, WA 98124 -- Attn: E. J. Jones -- -- -- Approved for public release; distribution is unlimited. Per DoD Directive -- 5230.24. -- -- Copyright (c) 1991, The Boeing Company, Seattle, Washington. This software, -- the BCA Ada language interface to the OSF/Motif toolkit, produced by the -- Boeing Commercial Airplane Company and made available under STARS (Software -- Technology for Adaptable, Reliable Systems) is approved for release under -- Distribution "A" of the Scientific and Technical Information Program -- Classification Scheme (DoD Directive 5230.24) unless otherwise indicated. -- Sponsored by the U.S. Defense Advanced Research Project Agency (DARPA) under -- contract F19628-88-D-0028, the STARS program is supported by the military -- services, SEI, and MITRE, with the U.S. Air Force as the executive -- contracting agent. The code identified herein is subject to change. -- -- Permission to use, modify, copy, and comment on this software for purposes -- stated under Distribution "A" and without fee is hereby granted. This -- software retains Contractor indemnification to the Government regarding -- copyrights pursuant to the above referenced STARS contract. The Government -- disclaims all responsibility against liability, including costs and expenses -- for violation of proprietary rights, or copyrights arising out of the -- creation or use of this software. -- -- In addition, the Government and The Boeing Company disclaim all warranties -- with regard to this software, including all implied warranties of -- merchantability and fitness. In no event shall the Government or The Boeing -- Company be liable for any special, indirect or consequential damages or any -- damages whatsoever resulting from the loss of use, data or profits, whether -- in action of contract, negligence or other tortuous action, arising in -- connection with the use or performance of this software. The Boeing Company -- does not agree to support or maintain this software or to produce any -- future versions. -------------------------------------------------------------------------------------- ------------------------------------------------------------------------------- -- Title : MOTIF WIDGET SET BINDINGS -- -- -- -- Description : -- -- The Motif Widget Set Ada bindings were initially designed for use -- -- by Avionics/Flight Systems. These bindings are to be used in conjunc- -- -- with the OSF Motif Widget Set written in C. Thus these Ada bindings -- -- are termed "shallow." -- -- -- ---------------------------------------------------------------------- -- CHANGE HISTORY -- Ver. Developer Date Description -- ---- -------- ----- --------------------------------- -- 1.0 E.J.Jones(206)477-3566 12/91 Original version for Ada Motif Bindings -- -- ------------------------------------------------------------------------------- with SYSTEM; package body MOTIF_RESOURCE_MANAGER is procedure MRM_INITIALIZE is procedure MRM_INIT; pragma INTERFACE (C, MRM_INIT); pragma INTERFACE_NAME ( MRM_INIT, "MrmInitialize"); begin MRM_INIT; end; --------------------------------------------------------------- function MRM_OPEN_HIERARCHY( NUM_FILES : in AFS.AFS_LARGE_INTEGER; NAMES_LIST : in SYSTEM.ADDRESS; ANCILLARY_STRUCT_LIST : in SYSTEM.ADDRESS := XT.NULL_ADDRESS; HIERARCHY_ID : in SYSTEM.ADDRESS ) return MRM_STATUS is function OPEN_HIERARCHY( NUM_FILES : in AFS.AFS_LARGE_INTEGER; NAMES_LIST : in SYSTEM.ADDRESS; ANCILLARY_STRUCT_LIST : in SYSTEM.ADDRESS := XT.NULL_ADDRESS; HIERARCHY_ID : in SYSTEM.ADDRESS ) return MRM_STATUS; pragma INTERFACE( C, OPEN_HIERARCHY ); pragma INTERFACE_NAME ( OPEN_HIERARCHY, "MrmOpenHierarchy"); begin return (OPEN_HIERARCHY( NUM_FILES => NUM_FILES, NAMES_LIST => NAMES_LIST, ANCILLARY_STRUCT_LIST => ANCILLARY_STRUCT_LIST, HIERARCHY_ID => HIERARCHY_ID)); end MRM_OPEN_HIERARCHY; --------------------------------------------------------------- function MRM_REGISTER_NAMES( REGISTER_LIST : in MRM_REGISTER_ARG_LIST; REGISTER_COUNT : in XT.CARDINAL) return MRM_STATUS is function REGISTER_NAMES( REGISTER_LIST : in SYSTEM.ADDRESS; REGISTER_COUNT : in XT.CARDINAL) return MRM_STATUS; pragma INTERFACE (C, REGISTER_NAMES); pragma INTERFACE_NAME ( REGISTER_NAMES, "MrmRegisterNames"); begin return( REGISTER_NAMES( REGISTER_LIST => REGISTER_LIST'address, REGISTER_COUNT=> REGISTER_COUNT)); end; function MRM_FETCH_WIDGET( HIERARCHY_ID : in MRM_HIERARCHY; INDEX : in STRING; PARENT_WIDGET : in XT.WIDGET; WIDGET : in SYSTEM.ADDRESS; CLASS : in SYSTEM.ADDRESS ) return MRM_STATUS is function FETCH_WIDGET( HIERARCHY_ID : in MRM_HIERARCHY; INDEX : in SYSTEM.ADDRESS; PARENT_WIDGET : in XT.WIDGET; WIDGET : in SYSTEM.ADDRESS; CLASS : in SYSTEM.ADDRESS ) return MRM_STATUS; pragma INTERFACE (C, FETCH_WIDGET); pragma INTERFACE_NAME ( FETCH_WIDGET, "MrmFetchWidget"); begin return(FETCH_WIDGET( HIERARCHY_ID => HIERARCHY_ID, INDEX => INDEX'address, PARENT_WIDGET=> PARENT_WIDGET, WIDGET => WIDGET, CLASS => CLASS )); end MRM_FETCH_WIDGET; ------------------------------------------------------------------ function MRM_CLOSE_HIERARCHY( HIERARCHY_ID : in MRM_HIERARCHY) return MRM_STATUS is function CLOSE_HIERARCHY( HIER_ID : in MRM_HIERARCHY ) return MRM_STATUS; pragma INTERFACE (C, CLOSE_HIERARCHY); pragma INTERFACE_NAME ( CLOSE_HIERARCHY, "MrmCloseHierarchy"); begin return( CLOSE_HIERARCHY( HIER_ID => HIERARCHY_ID)); end MRM_CLOSE_HIERARCHY; ------------------------------------------------------------------------- function MRM_REGISTER_CLASS( CLASS_CODE : in MRM_TYPE; CLASS_NAME : in STRING; CREATE_NAME : in STRING; CREATE_PROC : in SYSTEM.ADDRESS; CLASS_RECORD : in XT.WIDGET_CLASS) return MRM_STATUS is CLASS_NAME_STRING : constant STRING:= CLASS_NAME & ASCII.NUL; CREATE_NAME_STRING: constant STRING := CREATE_NAME & ASCII.NUL; function REGISTER_CLASS( CLASS_CODE : in MRM_TYPE; CLASS_NAME : in SYSTEM.ADDRESS; CREATE_NAME : in SYSTEM.ADDRESS; CREATE_PROC : in SYSTEM.ADDRESS; CLASS_RECORD : in XT.WIDGET_CLASS) return MRM_STATUS; pragma INTERFACE( C, REGISTER_CLASS ); pragma INTERFACE_NAME(REGISTER_CLASS,"MrmRegisterClass"); begin return( REGISTER_CLASS( CLASS_CODE => CLASS_CODE, CLASS_NAME => CLASS_NAME_STRING'ADDRESS, CREATE_NAME => CREATE_NAME_STRING'ADDRESS, CREATE_PROC => CREATE_PROC, CLASS_RECORD => CLASS_RECORD)); end MRM_REGISTER_CLASS; ------------------------------------------------------------------------- function MRM_FETCH_INTERFACE_MODULE( HIERARCHY_ID : in MRM_HIERARCHY; MODULE_NAME : in STRING; PARENT_WIDGET : in XT.WIDGET; WIDGET : in SYSTEM.ADDRESS) return MRM_STATUS is MODULE_NAME_STRING : constant STRING := MODULE_NAME & ASCII.NUL; function FETCH_INTERFACE_MODULE( HIERARCHY_ID : in MRM_HIERARCHY; MODULE_NAME : in SYSTEM.ADDRESS; PARENT_WIDGET : in XT.WIDGET; WIDGET : in SYSTEM.ADDRESS) return MRM_STATUS; pragma INTERFACE( C, FETCH_INTERFACE_MODULE); pragma INTERFACE_NAME( FETCH_INTERFACE_MODULE, "MrmFetchInterfaceModule"); begin return FETCH_INTERFACE_MODULE( HIERARCHY_ID => HIERARCHY_ID , MODULE_NAME => MODULE_NAME_STRING'ADDRESS, PARENT_WIDGET => PARENT_WIDGET, WIDGET => WIDGET); end MRM_FETCH_INTERFACE_MODULE; ------------------------------------------------------------------------ function MRM_FETCH_SET_VALUES( HIERARCHY_ID : in MRM_HIERARCHY; WIDGET : in XT.WIDGET; ARGS : in XT.ARG_LIST; NUM_ARGS : in XT.CARDINAL) return MRM_STATUS is function FETCH_SET_VALUES( HIERARCHY_ID : in MRM_HIERARCHY; WIDGET : in XT.WIDGET; ARGS : in XT.ARG_LIST; NUM_ARGS : in XT.CARDINAL) return MRM_STATUS; pragma INTERFACE(C,FETCH_SET_VALUES); pragma INTERFACE_NAME(FETCH_SET_VALUES,"MrmFetchSetValues"); begin return FETCH_SET_VALUES( HIERARCHY_ID => HIERARCHY_ID, WIDGET => WIDGET, ARGS => ARGS, NUM_ARGS => NUM_ARGS) ; end MRM_FETCH_SET_VALUES; ------------------------------------------------------------------------- function MRM_FETCH_WIDGET_OVERRIDE( HIERARCHY_ID : in MRM_HIERARCHY; INDEX : in STRING; PARENT_WIDGET : in XT.WIDGET; OVERRIDE_NAME : in STRING; OVERRIDE_ARGS : in XT.ARG_LIST; OVERRIDE_NUM_ARGS : in XT.CARDINAL; WIDGET : in SYSTEM.ADDRESS; CLASS : in SYSTEM.ADDRESS) return MRM_STATUS is function FETCH_WIDGET_OVERRIDE( HIERARCHY_ID : in MRM_HIERARCHY; INDEX : in SYSTEM.ADDRESS; PARENT_WIDGET : in XT.WIDGET; OVERRIDE_NAME : in SYSTEM.ADDRESS; OVERRIDE_ARGS : in XT.ARG_LIST; OVERRIDE_NUM_ARGS : in XT.CARDINAL; WIDGET : in SYSTEM.ADDRESS; CLASS : in SYSTEM.ADDRESS) return MRM_STATUS; pragma INTERFACE( C, FETCH_WIDGET_OVERRIDE); pragma INTERFACE_NAME( FETCH_WIDGET_OVERRIDE, "MrmFetchWidgetOverride"); OVERRIDE_STRING_NAME : constant STRING := OVERRIDE_NAME & ASCII.NUL; INDEX_STRING : constant STRING := INDEX & ASCII.NUL; begin return (FETCH_WIDGET_OVERRIDE( HIERARCHY_ID => HIERARCHY_ID, INDEX => INDEX_STRING'address, PARENT_WIDGET => PARENT_WIDGET, OVERRIDE_NAME => OVERRIDE_STRING_NAME'address, OVERRIDE_ARGS => OVERRIDE_ARGS, OVERRIDE_NUM_ARGS => OVERRIDE_NUM_ARGS, WIDGET => WIDGET, CLASS => CLASS)); end MRM_FETCH_WIDGET_OVERRIDE; ------------------------------------------------------------------------ function MRM_STATUS_IS_EQUAL ( A,B:in MRM_STATUS) return BOOLEAN is begin return ( A = B); -- return ( MRM_STATUS'POS(A) = MRM_STATUS'POS(B) ); end; end MOTIF_RESOURCE_MANAGER;