-------------------------------------------------------------------------------------- -- Ada language interface to OSF/Motif toolkit -- -- Version: 1.0 -- -- Release date: 3/19/91 -- -- 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. -------------------------------------------------------------------------------------- ---------------------------------------------------------------------- -- Package body XM WIDGET SET ---------------------------------------------------------------------- -- CHANGE HISTORY -- Ver. Developer Date Description -- ---- -------- ----- --------------------------------- -- 1.0 E.J.Jones(206)477-3566 12/91 Original version for Ada Motif Bindings -- -- -------------------------------------------------------------------------- with SYSTEM,-- SET_UP, UNCHECKED_CONVERSION, UNCHECKED_DEALLOCATION,C_strings, A_strings; use C_strings, A_strings; -- The use of these two packages will probably be removed; -- the binding to XM_TEXT_GET_STRING was written to return -- an A_string. It would probably be better to return a STRING -- and let the Ada application handle the string by receiving -- it into a temporary buffer and manipulating it from there. package body XM_WIDGET_SET is --------------------------------------------------------------------------------------- subtype C_STRING_TYPE is SYSTEM.ADDRESS; function WC is new UNCHECKED_CONVERSION (SOURCE => SYSTEM.ADDRESS, TARGET => WIDGET_CLASS); -- ************************************************************************************* -- ************************************************************************************* -- * -- * FUNCTIONS THAT RETURN THE WIDGET CLASS FOR VARIOUS OSF/MOTIF WIDGETS AND GADGETS -- * -- ************************************************************************************* -- ************************************************************************************* function XM_ARROW_BUTTON_WIDGET_CLASS return WIDGET_CLASS is function ARROW_BUTTON_WIDGET_CLASS return SYSTEM.ADDRESS; pragma INTERFACE (C, ARROW_BUTTON_WIDGET_CLASS); pragma INTERFACE_NAME (ARROW_BUTTON_WIDGET_CLASS, "xmArrowButtonWidgetFakeClass"); begin return WC (ARROW_BUTTON_WIDGET_CLASS); end XM_ARROW_BUTTON_WIDGET_CLASS; function XM_ARROW_BUTTON_GADGET_CLASS return WIDGET_CLASS is function ARROW_BUTTON_GADGET_CLASS return SYSTEM.ADDRESS; pragma INTERFACE (C, ARROW_BUTTON_GADGET_CLASS); pragma INTERFACE_NAME (ARROW_BUTTON_GADGET_CLASS, "xmArrowButtonGadgetFakeClass"); begin return WC (ARROW_BUTTON_GADGET_CLASS); end XM_ARROW_BUTTON_GADGET_CLASS; function XM_BULLETIN_BOARD_WIDGET_CLASS return WIDGET_CLASS is function BULLETIN_BOARD_WIDGET_CLASS return SYSTEM.ADDRESS; pragma INTERFACE (C, BULLETIN_BOARD_WIDGET_CLASS); pragma INTERFACE_NAME (BULLETIN_BOARD_WIDGET_CLASS, "xmBulletinBoardWidgetFakeClass"); begin return WC (BULLETIN_BOARD_WIDGET_CLASS); end XM_BULLETIN_BOARD_WIDGET_CLASS; function XM_CASCADE_BUTTON_WIDGET_CLASS return WIDGET_CLASS is function CASCADE_BUTTON_WIDGET_CLASS return SYSTEM.ADDRESS; pragma INTERFACE (C, CASCADE_BUTTON_WIDGET_CLASS); pragma INTERFACE_NAME (CASCADE_BUTTON_WIDGET_CLASS, "xmCascadeButtonWidgetFakeClass"); begin return WC (CASCADE_BUTTON_WIDGET_CLASS); end XM_CASCADE_BUTTON_WIDGET_CLASS; function XM_CASCADE_BUTTON_GADGET_CLASS return WIDGET_CLASS is function CASCADE_BUTTON_GADGET_CLASS return SYSTEM.ADDRESS; pragma INTERFACE (C, CASCADE_BUTTON_GADGET_CLASS); pragma INTERFACE_NAME (CASCADE_BUTTON_GADGET_CLASS, "xmCascadeButtonGadgetFakeClass"); begin return WC (CASCADE_BUTTON_GADGET_CLASS); end XM_CASCADE_BUTTON_GADGET_CLASS; function XM_COMMAND_WIDGET_CLASS return WIDGET_CLASS is function COMMAND_WIDGET_CLASS return SYSTEM.ADDRESS; pragma INTERFACE (C, COMMAND_WIDGET_CLASS); pragma INTERFACE_NAME (COMMAND_WIDGET_CLASS, "xmCommandWidgetFakeClass"); begin return WC (COMMAND_WIDGET_CLASS); end XM_COMMAND_WIDGET_CLASS; function XM_DIALOG_SHELL_WIDGET_CLASS return WIDGET_CLASS is function DIALOG_SHELL_WIDGET_CLASS return SYSTEM.ADDRESS; pragma INTERFACE (C, DIALOG_SHELL_WIDGET_CLASS); pragma INTERFACE_NAME (DIALOG_SHELL_WIDGET_CLASS, "xmDialogShellWidgetFakeClass"); begin return WC (DIALOG_SHELL_WIDGET_CLASS); end XM_DIALOG_SHELL_WIDGET_CLASS; function XM_DRAWING_AREA_WIDGET_CLASS return WIDGET_CLASS is function DRAWING_AREA_WIDGET_CLASS return SYSTEM.ADDRESS; pragma INTERFACE (C, DRAWING_AREA_WIDGET_CLASS); pragma INTERFACE_NAME (DRAWING_AREA_WIDGET_CLASS, "xmDrawingAreaWidgetFakeClass"); begin return WC (DRAWING_AREA_WIDGET_CLASS); end XM_DRAWING_AREA_WIDGET_CLASS; function XM_DRAWN_BUTTON_WIDGET_CLASS return WIDGET_CLASS is function DRAWN_BUTTON_WIDGET_CLASS return SYSTEM.ADDRESS; pragma INTERFACE (C, DRAWN_BUTTON_WIDGET_CLASS); pragma INTERFACE_NAME (DRAWN_BUTTON_WIDGET_CLASS, "xmDrawnButtonWidgetFakeClass"); begin return WC (DRAWN_BUTTON_WIDGET_CLASS); end XM_DRAWN_BUTTON_WIDGET_CLASS; function XM_FILE_SELECTION_BOX_WIDGET_CLASS return WIDGET_CLASS is function FILE_SELECTION_BOX_WIDGET_CLASS return SYSTEM.ADDRESS; pragma INTERFACE (C, FILE_SELECTION_BOX_WIDGET_CLASS); pragma INTERFACE_NAME (FILE_SELECTION_BOX_WIDGET_CLASS, "xmFileSelectionBoxWdgtFkClass"); begin return WC (FILE_SELECTION_BOX_WIDGET_CLASS); end XM_FILE_SELECTION_BOX_WIDGET_CLASS; function XM_FORM_WIDGET_CLASS return WIDGET_CLASS is function FORM_WIDGET_CLASS return SYSTEM.ADDRESS; pragma INTERFACE (C, FORM_WIDGET_CLASS); pragma INTERFACE_NAME (FORM_WIDGET_CLASS, "xmFormWidgetFakeClass"); begin return WC (FORM_WIDGET_CLASS); end XM_FORM_WIDGET_CLASS; function XM_FRAME_WIDGET_CLASS return WIDGET_CLASS is function FRAME_WIDGET_CLASS return SYSTEM.ADDRESS; pragma INTERFACE (C, FRAME_WIDGET_CLASS); pragma INTERFACE_NAME (FRAME_WIDGET_CLASS, "xmFrameWidgetFakeClass"); begin return WC (FRAME_WIDGET_CLASS); end XM_FRAME_WIDGET_CLASS; function XM_LABEL_WIDGET_CLASS return WIDGET_CLASS is function LABEL_WIDGET_CLASS return SYSTEM.ADDRESS; pragma INTERFACE (C, LABEL_WIDGET_CLASS); pragma INTERFACE_NAME( LABEL_WIDGET_CLASS, "xmLabelWidgetFakeClass"); begin return WC (LABEL_WIDGET_CLASS); end XM_LABEL_WIDGET_CLASS; function XM_LABEL_GADGET_CLASS return WIDGET_CLASS is function LABEL_GADGET_CLASS return SYSTEM.ADDRESS; pragma INTERFACE (C, LABEL_GADGET_CLASS); pragma INTERFACE_NAME (LABEL_GADGET_CLASS, "xmLabelGadgetFakeClass"); begin return WC (LABEL_GADGET_CLASS); end XM_LABEL_GADGET_CLASS; function XM_LIST_WIDGET_CLASS return WIDGET_CLASS is function LIST_WIDGET_CLASS return SYSTEM.ADDRESS; pragma INTERFACE (C, LIST_WIDGET_CLASS); pragma INTERFACE_NAME (LIST_WIDGET_CLASS, "xmListWidgetFakeClass"); begin return WC (LIST_WIDGET_CLASS); end XM_LIST_WIDGET_CLASS; function XM_MAIN_WINDOW_WIDGET_CLASS return WIDGET_CLASS is function MAIN_WINDOW_WIDGET_CLASS return SYSTEM.ADDRESS; pragma INTERFACE (C, MAIN_WINDOW_WIDGET_CLASS); pragma INTERFACE_NAME (MAIN_WINDOW_WIDGET_CLASS, "xmMainWindowWidgetFakeClass"); begin return WC (MAIN_WINDOW_WIDGET_CLASS); end XM_MAIN_WINDOW_WIDGET_CLASS; function XM_MENU_SHELL_WIDGET_CLASS return WIDGET_CLASS is function MENU_SHELL_WIDGET_CLASS return SYSTEM.ADDRESS; pragma INTERFACE (C, MENU_SHELL_WIDGET_CLASS); pragma INTERFACE_NAME (MENU_SHELL_WIDGET_CLASS, "xmMenuShellWidgetFakeClass"); begin return WC (MENU_SHELL_WIDGET_CLASS); end XM_MENU_SHELL_WIDGET_CLASS; function XM_MESSAGE_BOX_WIDGET_CLASS return WIDGET_CLASS is function MESSAGE_BOX_WIDGET_CLASS return SYSTEM.ADDRESS; pragma INTERFACE (C, MESSAGE_BOX_WIDGET_CLASS); pragma INTERFACE_NAME (MESSAGE_BOX_WIDGET_CLASS, "xmMessageBoxWidgetFakeClass"); begin return WC (MESSAGE_BOX_WIDGET_CLASS); end XM_MESSAGE_BOX_WIDGET_CLASS; function XM_PANED_WINDOW_WIDGET_CLASS return WIDGET_CLASS is function PANED_WINDOW_WIDGET_CLASS return SYSTEM.ADDRESS; pragma INTERFACE (C, PANED_WINDOW_WIDGET_CLASS); pragma INTERFACE_NAME (PANED_WINDOW_WIDGET_CLASS, "xmPanedWindowWidgetFakeClass"); begin return WC (PANED_WINDOW_WIDGET_CLASS); end XM_PANED_WINDOW_WIDGET_CLASS; function XM_PUSH_BUTTON_WIDGET_CLASS return WIDGET_CLASS is function PUSH_BUTTON_WIDGET_CLASS return SYSTEM.ADDRESS; pragma INTERFACE (C, PUSH_BUTTON_WIDGET_CLASS); pragma INTERFACE_NAME (PUSH_BUTTON_WIDGET_CLASS, "xmPushButtonWidgetFakeClass"); begin return WC (PUSH_BUTTON_WIDGET_CLASS); end XM_PUSH_BUTTON_WIDGET_CLASS; function XM_PUSH_BUTTON_GADGET_CLASS return WIDGET_CLASS is function PUSH_BUTTON_GADGET_CLASS return SYSTEM.ADDRESS; pragma INTERFACE (C, PUSH_BUTTON_GADGET_CLASS); pragma INTERFACE_NAME (PUSH_BUTTON_GADGET_CLASS, "xmPushButtonGadgetFakeClass"); begin return WC (PUSH_BUTTON_GADGET_CLASS); end XM_PUSH_BUTTON_GADGET_CLASS; function XM_ROW_COLUMN_WIDGET_CLASS return WIDGET_CLASS is function ROW_COLUMN_WIDGET_CLASS return SYSTEM.ADDRESS; pragma INTERFACE (C, ROW_COLUMN_WIDGET_CLASS); pragma INTERFACE_NAME (ROW_COLUMN_WIDGET_CLASS, "xmRowColumnWidgetFakeClass"); begin return WC (ROW_COLUMN_WIDGET_CLASS); end XM_ROW_COLUMN_WIDGET_CLASS; function XM_SCALE_WIDGET_CLASS return WIDGET_CLASS is function SCALE_WIDGET_CLASS return SYSTEM.ADDRESS; pragma INTERFACE (C, SCALE_WIDGET_CLASS); pragma INTERFACE_NAME (SCALE_WIDGET_CLASS, "xmScaleWidgetFakeClass"); begin return WC (SCALE_WIDGET_CLASS); end XM_SCALE_WIDGET_CLASS; function XM_SCROLL_BAR_WIDGET_CLASS return WIDGET_CLASS is function SCROLL_BAR_WIDGET_CLASS return SYSTEM.ADDRESS; pragma INTERFACE (C, SCROLL_BAR_WIDGET_CLASS); pragma INTERFACE_NAME (SCROLL_BAR_WIDGET_CLASS, "xmScrollBarWidgetFakeClass"); begin return WC (SCROLL_BAR_WIDGET_CLASS); end XM_SCROLL_BAR_WIDGET_CLASS; function XM_SCROLLED_WINDOW_WIDGET_CLASS return WIDGET_CLASS is function SCROLLED_WINDOW_WIDGET_CLASS return SYSTEM.ADDRESS; pragma INTERFACE (C, SCROLLED_WINDOW_WIDGET_CLASS); pragma INTERFACE_NAME (SCROLLED_WINDOW_WIDGET_CLASS, "xmScrolledWindowWidgetFakeClass"); begin return WC (SCROLLED_WINDOW_WIDGET_CLASS); end XM_SCROLLED_WINDOW_WIDGET_CLASS; function XM_SELECTION_BOX_WIDGET_CLASS return WIDGET_CLASS is function SELECTION_BOX_WIDGET_CLASS return SYSTEM.ADDRESS; pragma INTERFACE (C, SELECTION_BOX_WIDGET_CLASS); pragma INTERFACE_NAME (SELECTION_BOX_WIDGET_CLASS, "xmSelectionBoxWidgetFakeClass"); begin return WC (SELECTION_BOX_WIDGET_CLASS); end XM_SELECTION_BOX_WIDGET_CLASS; function XM_SEPARATOR_GADGET_CLASS return WIDGET_CLASS is function SEPARATOR_GADGET_CLASS return SYSTEM.ADDRESS; pragma INTERFACE (C, SEPARATOR_GADGET_CLASS); pragma INTERFACE_NAME (SEPARATOR_GADGET_CLASS, "xmSeparatorGadgetFakeClass"); begin return WC (SEPARATOR_GADGET_CLASS); end XM_SEPARATOR_GADGET_CLASS; function XM_SEPARATOR_WIDGET_CLASS return WIDGET_CLASS is function SEPARATOR_WIDGET_CLASS return SYSTEM.ADDRESS; pragma INTERFACE (C, SEPARATOR_WIDGET_CLASS); pragma INTERFACE_NAME (SEPARATOR_WIDGET_CLASS, "xmSeparatorWidgetFakeClass"); begin return WC (SEPARATOR_WIDGET_CLASS); end XM_SEPARATOR_WIDGET_CLASS; function XM_TEXT_WIDGET_CLASS return WIDGET_CLASS is function TEXT_WIDGET_CLASS return SYSTEM.ADDRESS; pragma INTERFACE (C, TEXT_WIDGET_CLASS); pragma INTERFACE_NAME (TEXT_WIDGET_CLASS, "xmTextWidgetFakeClass"); begin return WC (TEXT_WIDGET_CLASS); end XM_TEXT_WIDGET_CLASS; function XM_TOGGLE_BUTTON_WIDGET_CLASS return WIDGET_CLASS is function TOGGLE_BUTTON_WIDGET_CLASS return SYSTEM.ADDRESS; pragma INTERFACE (C, TOGGLE_BUTTON_WIDGET_CLASS); pragma INTERFACE_NAME (TOGGLE_BUTTON_WIDGET_CLASS, "xmToggleButtonWidgetFakeClass"); begin return WC (TOGGLE_BUTTON_WIDGET_CLASS); end XM_TOGGLE_BUTTON_WIDGET_CLASS; function XM_TOGGLE_BUTTON_GADGET_CLASS return WIDGET_CLASS is function TOGGLE_BUTTON_GADGET_CLASS return SYSTEM.ADDRESS; pragma INTERFACE (C, TOGGLE_BUTTON_GADGET_CLASS); pragma INTERFACE_NAME (TOGGLE_BUTTON_GADGET_CLASS, "xmToggleButtonGadgetFakeClass"); begin return WC (TOGGLE_BUTTON_GADGET_CLASS); end XM_TOGGLE_BUTTON_GADGET_CLASS; function XM_PRIMITIVE_WIDGET_CLASS return WIDGET_CLASS is function PRIMITIVE_WIDGET_CLASS return SYSTEM.ADDRESS; pragma INTERFACE (C, PRIMITIVE_WIDGET_CLASS); pragma INTERFACE_NAME (PRIMITIVE_WIDGET_CLASS, "xmPrimitiveWidgetFakeClass"); begin return WC (PRIMITIVE_WIDGET_CLASS); end XM_PRIMITIVE_WIDGET_CLASS; function XM_GADGET_CLASS return WIDGET_CLASS is function GADGET_CLASS return SYSTEM.ADDRESS; pragma INTERFACE (C, GADGET_CLASS); pragma INTERFACE_NAME (GADGET_CLASS, "xmGadgetFakeClass"); begin return WC (GADGET_CLASS); end XM_GADGET_CLASS; function XM_MANAGER_WIDGET_CLASS return WIDGET_CLASS is function MANAGER_WIDGET_CLASS return SYSTEM.ADDRESS; pragma INTERFACE (C, MANAGER_WIDGET_CLASS); pragma INTERFACE_NAME (MANAGER_WIDGET_CLASS, "xmManagerWidgetFakeClass"); begin return WC (MANAGER_WIDGET_CLASS); end XM_MANAGER_WIDGET_CLASS; -- ********************************************************************************** -- ********************************************************************************** -- * -- * Functions for creating widgets and gadgets -- * -- ********************************************************************************** -- ********************************************************************************** -- -- CREATE ARROW BUTTON -- function XM_CREATE_ARROW_BUTTON ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function XM_CREATE_ARROW_BUTTON ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, XM_CREATE_ARROW_BUTTON); pragma INTERFACE_NAME (XM_CREATE_ARROW_BUTTON, "XmCreateArrowButton"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (XM_CREATE_ARROW_BUTTON (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (XM_CREATE_ARROW_BUTTON (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_ARROW_BUTTON; -- -- CREATE ARROW BUTTON GADGET -- function XM_CREATE_ARROW_BUTTON_GADGET ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_ARROW_BUTTON_GADGET ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_ARROW_BUTTON_GADGET); pragma INTERFACE_NAME (CREATE_ARROW_BUTTON_GADGET, "XmCreateArrowButtonGadget"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_ARROW_BUTTON_GADGET (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_ARROW_BUTTON_GADGET (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_ARROW_BUTTON_GADGET; -- -- CREATE BULLETIN BOARD -- function XM_CREATE_BULLETIN_BOARD ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_BULLETIN_BOARD ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_BULLETIN_BOARD); pragma INTERFACE_NAME (CREATE_BULLETIN_BOARD, "XmCreateBulletinBoard"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_BULLETIN_BOARD (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_BULLETIN_BOARD (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_BULLETIN_BOARD; -- -- CREATE BULLETIN BOARD DIALOG -- function XM_CREATE_BULLETIN_BOARD_DIALOG ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_BULLETIN_BOARD_DIALOG ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_BULLETIN_BOARD_DIALOG); pragma INTERFACE_NAME (CREATE_BULLETIN_BOARD_DIALOG, "XmCreateBulletinBoardDialog"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_BULLETIN_BOARD_DIALOG (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_BULLETIN_BOARD_DIALOG (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_BULLETIN_BOARD_DIALOG; -- -- CREATE CASCADE BUTTON -- function XM_CREATE_CASCADE_BUTTON ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_CASCADE_BUTTON ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_CASCADE_BUTTON); pragma INTERFACE_NAME (CREATE_CASCADE_BUTTON, "XmCreateCascadeButton"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_CASCADE_BUTTON (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_CASCADE_BUTTON (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_CASCADE_BUTTON; -- -- CREATE CASCADE BUTTON GADGET -- function XM_CREATE_CASCADE_BUTTON_GADGET ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_CASCADE_BUTTON_GADGET ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_CASCADE_BUTTON_GADGET); pragma INTERFACE_NAME (CREATE_CASCADE_BUTTON_GADGET, "XmCreateCascadeButtonGadget"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_CASCADE_BUTTON_GADGET (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_CASCADE_BUTTON_GADGET (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_CASCADE_BUTTON_GADGET; -- -- CREATE COMMAND -- function XM_CREATE_COMMAND ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_COMMAND ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_COMMAND); pragma INTERFACE_NAME (CREATE_COMMAND, "XmCreateCommand"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_COMMAND (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_COMMAND (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_COMMAND; -- -- CREATE DIALOG SHELL -- function XM_CREATE_DIALOG_SHELL ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_DIALOG_SHELL ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_DIALOG_SHELL); pragma INTERFACE_NAME (CREATE_DIALOG_SHELL, "XmCreateDialogShell"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_DIALOG_SHELL (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_DIALOG_SHELL (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_DIALOG_SHELL; -- -- CREATE DRAWING AREA -- function XM_CREATE_DRAWING_AREA ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_DRAWING_AREA ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_DRAWING_AREA); pragma INTERFACE_NAME (CREATE_DRAWING_AREA, "XmCreateDrawingArea"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_DRAWING_AREA (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_DRAWING_AREA (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_DRAWING_AREA; -- -- CREATE DRAWN BUTTON -- function XM_CREATE_DRAWN_BUTTON ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_DRAWN_BUTTON ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_DRAWN_BUTTON); pragma INTERFACE_NAME (CREATE_DRAWN_BUTTON, "XmCreateDrawnButton"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_DRAWN_BUTTON (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_DRAWN_BUTTON (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_DRAWN_BUTTON; -- -- CREATE ERROR DIALOG -- function XM_CREATE_ERROR_DIALOG ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_ERROR_DIALOG ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_ERROR_DIALOG); pragma INTERFACE_NAME (CREATE_ERROR_DIALOG, "XmCreateErrorDialog"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_ERROR_DIALOG (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_ERROR_DIALOG (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_ERROR_DIALOG; -- -- CREATE FILE SELECTION BOX -- function XM_CREATE_FILE_SELECTION_BOX ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_FILE_SELECTION_BOX ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_FILE_SELECTION_BOX); pragma INTERFACE_NAME (CREATE_FILE_SELECTION_BOX, "XmCreateFileSelectionBox"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_FILE_SELECTION_BOX (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_FILE_SELECTION_BOX (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_FILE_SELECTION_BOX; -- -- CREATE FILE SELECTION DIALOG -- function XM_CREATE_FILE_SELECTION_DIALOG ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_FILE_SELECTION_DIALOG ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_FILE_SELECTION_DIALOG); pragma INTERFACE_NAME (CREATE_FILE_SELECTION_DIALOG, "XmCreateFileSelectionDialog"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_FILE_SELECTION_DIALOG (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_FILE_SELECTION_DIALOG (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_FILE_SELECTION_DIALOG; -- -- CREATE FORM -- function XM_CREATE_FORM ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_FORM ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_FORM); pragma INTERFACE_NAME (CREATE_FORM, "XmCreateForm"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_FORM (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_FORM (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_FORM; -- -- CREATE FORM DIALOG -- function XM_CREATE_FORM_DIALOG ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_FORM_DIALOG ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_FORM_DIALOG); pragma INTERFACE_NAME (CREATE_FORM_DIALOG, "XmCreateFormDialog"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_FORM_DIALOG (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_FORM_DIALOG (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_FORM_DIALOG; -- -- CREATE FRAME -- function XM_CREATE_FRAME ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_FRAME ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_FRAME); pragma INTERFACE_NAME (CREATE_FRAME, "XmCreateFrame"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_FRAME (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_FRAME (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_FRAME; -- -- CREATE INFORMATION DIALOG -- function XM_CREATE_INFORMATION_DIALOG ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_INFORMATION_DIALOG ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_INFORMATION_DIALOG); pragma INTERFACE_NAME (CREATE_INFORMATION_DIALOG, "XmCreateInformationDialog"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_INFORMATION_DIALOG (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_INFORMATION_DIALOG (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_INFORMATION_DIALOG; -- -- CREATE LABEL -- function XM_CREATE_LABEL ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_LABEL ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_LABEL); pragma INTERFACE_NAME (CREATE_LABEL, "XmCreateLabel"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_LABEL (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_LABEL (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_LABEL; -- -- CREATE LABEL GADGET -- function XM_CREATE_LABEL_GADGET ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_LABEL_GADGET ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_LABEL_GADGET); pragma INTERFACE_NAME (CREATE_LABEL_GADGET, "XmCreateLabelGadget"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_LABEL_GADGET (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_LABEL_GADGET (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_LABEL_GADGET; -- -- CREATE LIST -- function XM_CREATE_LIST ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_LIST ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_LIST); pragma INTERFACE_NAME (CREATE_LIST, "XmCreateList"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_LIST (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_LIST (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_LIST; -- -- CREATE MAIN WINDOW -- function XM_CREATE_MAIN_WINDOW ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_MAIN_WINDOW ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_MAIN_WINDOW); pragma INTERFACE_NAME (CREATE_MAIN_WINDOW, "XmCreateMainWindow"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_MAIN_WINDOW (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_MAIN_WINDOW (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_MAIN_WINDOW; -- -- CREATE MENU SHELL -- function XM_CREATE_MENU_SHELL ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_MENU_SHELL ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_MENU_SHELL); pragma INTERFACE_NAME (CREATE_MENU_SHELL, "XmCreateMenuShell"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_MENU_SHELL (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_MENU_SHELL (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_MENU_SHELL; -- -- CREATE MESSAGE BOX -- function XM_CREATE_MESSAGE_BOX ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_MESSAGE_BOX ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_MESSAGE_BOX); pragma INTERFACE_NAME (CREATE_MESSAGE_BOX, "XmCreateMessageBox"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_MESSAGE_BOX (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_MESSAGE_BOX (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_MESSAGE_BOX; -- -- CREATE MESSAGE DIALOG -- function XM_CREATE_MESSAGE_DIALOG ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_MESSAGE_DIALOG ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_MESSAGE_DIALOG); pragma INTERFACE_NAME (CREATE_MESSAGE_DIALOG, "XmCreateMessageDialog"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_MESSAGE_DIALOG (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_MESSAGE_DIALOG (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_MESSAGE_DIALOG; -- -- CREATE OPTION MENU -- function XM_CREATE_OPTION_MENU ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_OPTION_MENU ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_OPTION_MENU); pragma INTERFACE_NAME (CREATE_OPTION_MENU, "XmCreateOptionMenu"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_OPTION_MENU (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_OPTION_MENU (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_OPTION_MENU; -- -- CREATE MENU BAR -- function XM_CREATE_MENU_BAR ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_MENU_BAR ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_MENU_BAR); pragma INTERFACE_NAME (CREATE_MENU_BAR, "XmCreateMenuBar"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_MENU_BAR (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_MENU_BAR (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_MENU_BAR; -- -- CREATE PANED WINDOW -- function XM_CREATE_PANED_WINDOW ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_PANED_WINDOW ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_PANED_WINDOW); pragma INTERFACE_NAME (CREATE_PANED_WINDOW, "XmCreatePanedWindow"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_PANED_WINDOW (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_PANED_WINDOW (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_PANED_WINDOW; -- -- CREATE POPUP MENU -- function XM_CREATE_POPUP_MENU ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_POPUP_MENU ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_POPUP_MENU); pragma INTERFACE_NAME (CREATE_POPUP_MENU, "XmCreatePopupMenu"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_POPUP_MENU (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_POPUP_MENU (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_POPUP_MENU; -- -- CREATE PROMPT DIALOG -- function XM_CREATE_PROMPT_DIALOG ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_PROMPT_DIALOG ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_PROMPT_DIALOG); pragma INTERFACE_NAME (CREATE_PROMPT_DIALOG, "XmCreatePromptDialog"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_PROMPT_DIALOG (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_PROMPT_DIALOG (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_PROMPT_DIALOG; -- -- CREATE PULLDOWN MENU -- function XM_CREATE_PULLDOWN_MENU ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_PULLDOWN_MENU ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_PULLDOWN_MENU); pragma INTERFACE_NAME (CREATE_PULLDOWN_MENU, "XmCreatePulldownMenu"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_PULLDOWN_MENU (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_PULLDOWN_MENU (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_PULLDOWN_MENU; -- -- CREATE PUSH BUTTON -- function XM_CREATE_PUSH_BUTTON ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_PUSH_BUTTON ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_PUSH_BUTTON); pragma INTERFACE_NAME (CREATE_PUSH_BUTTON, "XmCreatePushButton"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_PUSH_BUTTON (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_PUSH_BUTTON (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_PUSH_BUTTON; -- -- CREATE PUSH BUTTON GADGET -- function XM_CREATE_PUSH_BUTTON_GADGET ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_PUSH_BUTTON_GADGET ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_PUSH_BUTTON_GADGET); pragma INTERFACE_NAME (CREATE_PUSH_BUTTON_GADGET, "XmCreatePushButtonGadget"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_PUSH_BUTTON_GADGET (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_PUSH_BUTTON_GADGET (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_PUSH_BUTTON_GADGET; -- -- CREATE RADIO BOX -- function XM_CREATE_RADIO_BOX ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_RADIO_BOX ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_RADIO_BOX); pragma INTERFACE_NAME (CREATE_RADIO_BOX, "XmCreateRadioBox"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_RADIO_BOX (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_RADIO_BOX (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_RADIO_BOX; -- -- CREATE ROW COLUMN -- function XM_CREATE_ROW_COLUMN ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_ROW_COLUMN ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_ROW_COLUMN); pragma INTERFACE_NAME (CREATE_ROW_COLUMN, "XmCreateRowColumn"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_ROW_COLUMN (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_ROW_COLUMN (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_ROW_COLUMN; -- -- CREATE QUESTION DIALOG -- function XM_CREATE_QUESTION_DIALOG ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function XM_CREATE_QUESTION_DIALOG ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, XM_CREATE_QUESTION_DIALOG); pragma INTERFACE_NAME (XM_CREATE_QUESTION_DIALOG, "XmCreateQuestionDialog"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (XM_CREATE_QUESTION_DIALOG (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (XM_CREATE_QUESTION_DIALOG (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_QUESTION_DIALOG; -- -- CREATE SCALE -- function XM_CREATE_SCALE ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_SCALE ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_SCALE); pragma INTERFACE_NAME (CREATE_SCALE, "XmCreateScale"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_SCALE (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_SCALE (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_SCALE; -- -- CREATE SCROLL BAR -- function XM_CREATE_SCROLL_BAR ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_SCROLL_BAR ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_SCROLL_BAR); pragma INTERFACE_NAME (CREATE_SCROLL_BAR, "XmCreateScrollBar"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_SCROLL_BAR (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_SCROLL_BAR (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_SCROLL_BAR; -- -- CREATE SCROLLED LIST -- function XM_CREATE_SCROLLED_LIST ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_SCROLLED_LIST ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_SCROLLED_LIST); pragma INTERFACE_NAME (CREATE_SCROLLED_LIST, "XmCreateScrolledList"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_SCROLLED_LIST (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_SCROLLED_LIST (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_SCROLLED_LIST; -- -- CREATE SCROLLED TEXT -- function XM_CREATE_SCROLLED_TEXT ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_SCROLLED_TEXT ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_SCROLLED_TEXT); pragma INTERFACE_NAME (CREATE_SCROLLED_TEXT, "XmCreateScrolledText"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_SCROLLED_TEXT (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_SCROLLED_TEXT (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_SCROLLED_TEXT; -- -- CREATE SCROLLED WINDOW -- function XM_CREATE_SCROLLED_WINDOW ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_SCROLLED_WINDOW ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C,CREATE_SCROLLED_WINDOW); pragma INTERFACE_NAME (CREATE_SCROLLED_WINDOW, "XmCreateScrolledWindow"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_SCROLLED_WINDOW (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_SCROLLED_WINDOW (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_SCROLLED_WINDOW; -- -- CREATE SELECTION BOX -- function XM_CREATE_SELECTION_BOX ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_SELECTION_BOX ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_SELECTION_BOX); pragma INTERFACE_NAME (CREATE_SELECTION_BOX, "XmCreateSelectionBox"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_SELECTION_BOX (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_SELECTION_BOX (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_SELECTION_BOX; -- -- CREATE SELECTION DIALOG -- function XM_CREATE_SELECTION_DIALOG ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_SELECTION_DIALOG ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_SELECTION_DIALOG); pragma INTERFACE_NAME (CREATE_SELECTION_DIALOG, "XmCreateSelectionDialog"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_SELECTION_DIALOG (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_SELECTION_DIALOG (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_SELECTION_DIALOG; -- -- CREATE SEPARATOR -- function XM_CREATE_SEPARATOR ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_SEPARATOR ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_SEPARATOR); pragma INTERFACE_NAME (CREATE_SEPARATOR, "XmCreateSeparator"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_SEPARATOR (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_SEPARATOR (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_SEPARATOR; -- -- CREATE SEPARATOR GADGET -- function XM_CREATE_SEPARATOR_GADGET ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_SEPARATOR_GADGET ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_SEPARATOR_GADGET); pragma INTERFACE_NAME (CREATE_SEPARATOR_GADGET, "XmCreateSeparatorGadget"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_SEPARATOR_GADGET (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_SEPARATOR_GADGET (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_SEPARATOR_GADGET; -- -- CREATE TEXT -- function XM_CREATE_TEXT ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_TEXT ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_TEXT); pragma INTERFACE_NAME (CREATE_TEXT, "XmCreateText"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_TEXT (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_TEXT (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_TEXT; -- -- CREATE TOGGLE BUTTON -- function XM_CREATE_TOGGLE_BUTTON ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_TOGGLE_BUTTON ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_TOGGLE_BUTTON); pragma INTERFACE_NAME (CREATE_TOGGLE_BUTTON, "XmCreateToggleButton"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_TOGGLE_BUTTON (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_TOGGLE_BUTTON (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_TOGGLE_BUTTON; -- -- CREATE TOGGLE BUTTON GADGET -- function XM_CREATE_TOGGLE_BUTTON_GADGET ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_TOGGLE_BUTTON_GADGET ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_TOGGLE_BUTTON_GADGET); pragma INTERFACE_NAME (CREATE_TOGGLE_BUTTON_GADGET, "XmCreateToggleButton"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_TOGGLE_BUTTON_GADGET (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_TOGGLE_BUTTON_GADGET (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_TOGGLE_BUTTON_GADGET; -- -- CREATE WARNING DIALOG -- function XM_CREATE_WARNING_DIALOG ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_WARNING_DIALOG ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_WARNING_DIALOG); pragma INTERFACE_NAME (CREATE_WARNING_DIALOG, "XmCreateWarningDialog"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_WARNING_DIALOG (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_WARNING_DIALOG (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_WARNING_DIALOG; -- -- CREATE WORKING DIALOG -- function XM_CREATE_WORKING_DIALOG ( PARENT : in WIDGET; NAME : in STRING; ARGLIST : in ARG_LIST := NULL_ARG_LIST ) return WIDGET is function CREATE_WORKING_DIALOG ( PARENT : in WIDGET; NAME : in SYSTEM.ADDRESS; ARGS : in SYSTEM.ADDRESS; COUNT : in CARDINAL ) return SYSTEM.ADDRESS; pragma INTERFACE (C, CREATE_WORKING_DIALOG); pragma INTERFACE_NAME (CREATE_WORKING_DIALOG, "XmCreateWorkingDialog"); TEMP_NAME : constant STRING := NAME & ASCII.NUL; begin if ARGLIST /= NULL_ARG_LIST then return ADDR_TO_WIDGET (CREATE_WORKING_DIALOG (PARENT, TEMP_NAME'address, ARGLIST.all.LIST'address, CARDINAL(ARGLIST.all.INDEX))); else return ADDR_TO_WIDGET (CREATE_WORKING_DIALOG (PARENT, TEMP_NAME'address, NULL_ADDRESS, 0)); end if; end XM_CREATE_WORKING_DIALOG; -- ************************************************************************************* -- ************************************************************************************* -- * -- * CONVENIENCE ROUTINES AND FUNCTIONS -- * -- ************************************************************************************* -- ************************************************************************************* -- ******************************************************** -- * -- * Clipboard routines -- * -- ******************************************************** -- -- CLIPBOARD UNLOCK -- function XM_CLIPBOARD_UNLOCK ( DISPLAY : XLIB.DISPLAY_POINTER; WINDOW : XLIB.WINDOW_ID; REMOVE_ALL_LOCKS : BOOLEAN ) return AFS_LARGE_INTEGER is function CLIPBOARD_UNLOCK ( DISPLAY : XLIB.DISPLAY_POINTER; WINDOW : XLIB.WINDOW_ID; REMOVE_ALL_LOCKS : AFS_LARGE_INTEGER ) return AFS_LARGE_INTEGER; pragma INTERFACE(C, CLIPBOARD_UNLOCK); pragma INTERFACE_NAME(CLIPBOARD_UNLOCK, "XmClipboardUnlock"); begin return CLIPBOARD_UNLOCK(DISPLAY, WINDOW, BOOLEAN'POS(REMOVE_ALL_LOCKS)); end XM_CLIPBOARD_UNLOCK; -- ******************************************************** -- * -- * List widget routines -- * -- ******************************************************** -- -- LIST ADD ITEM -- procedure XM_LIST_ADD_ITEM( WIDGET : XT.WIDGET; ITEM : XM_COMPOUND_STRING; POS : AFS_LARGE_INTEGER ) is procedure LIST_ADD_ITEM ( WGT : SYSTEM.ADDRESS; ITM : SYSTEM.ADDRESS; P : AFS_LARGE_INTEGER ); pragma INTERFACE(C, LIST_ADD_ITEM); pragma INTERFACE_NAME(LIST_ADD_ITEM, "XmListAddItem"); begin LIST_ADD_ITEM( WIDGET_TO_ADDR(WIDGET),SYSTEM.ADDRESS(ITEM),POS); end XM_LIST_ADD_ITEM; -- -- LIST ADD ITEM UNSELECTED -- procedure XM_LIST_ADD_ITEM_UNSELECTED( WIDGET : XT.WIDGET; ITEM : XM_COMPOUND_STRING; POS : AFS_LARGE_INTEGER ) is procedure LIST_ADD_ITEM_UNSELECTED ( WGT : SYSTEM.ADDRESS; ITM : SYSTEM.ADDRESS; P : AFS_LARGE_INTEGER ); pragma INTERFACE(C, LIST_ADD_ITEM_UNSELECTED); pragma INTERFACE_NAME(LIST_ADD_ITEM_UNSELECTED, "XmListAddItemUnselected"); begin LIST_ADD_ITEM_UNSELECTED( WIDGET_TO_ADDR(WIDGET),SYSTEM.ADDRESS(ITEM),POS); end XM_LIST_ADD_ITEM_UNSELECTED; -- -- LIST ITEM EXISTS -- function XM_LIST_ITEM_EXISTS ( WIDGET : XT.WIDGET; ITEM : XM_COMPOUND_STRING) return BOOLEAN is function LIST_ITEM_EXISTS ( W : SYSTEM.ADDRESS; ITEM : SYSTEM.ADDRESS ) return AFS_LARGE_INTEGER; pragma INTERFACE(C, LIST_ITEM_EXISTS); pragma INTERFACE_NAME(LIST_ITEM_EXISTS, "XmListItemExists"); begin return BOOLEAN'VAL(LIST_ITEM_EXISTS( WIDGET_TO_ADDR(WIDGET),SYSTEM.ADDRESS(ITEM))); end XM_LIST_ITEM_EXISTS; -- -- LIST SELECT ITEM -- procedure XM_LIST_SELECT_ITEM ( WIDGET : XT.WIDGET; ITEM : XM_COMPOUND_STRING; NOTIFY : BOOLEAN ) is procedure LIST_SELECT_ITEM ( W : SYSTEM.ADDRESS; ITEM : SYSTEM.ADDRESS; NOTIFY : AFS_LARGE_INTEGER ); pragma INTERFACE(C, LIST_SELECT_ITEM); pragma INTERFACE_NAME(LIST_SELECT_ITEM, "XmListSelectItem"); begin LIST_SELECT_ITEM ( WIDGET_TO_ADDR(WIDGET), SYSTEM.ADDRESS(ITEM), BOOLEAN'POS(NOTIFY) ); end XM_LIST_SELECT_ITEM; -- -- LIST SELECT POS -- procedure XM_LIST_SELECT_POS ( WIDGET : XT.WIDGET; POSITION : AFS_LARGE_INTEGER; NOTIFY : BOOLEAN ) is procedure LIST_SELECT_POS ( W : SYSTEM.ADDRESS; POS : AFS_LARGE_INTEGER; NOTIFY : AFS_LARGE_INTEGER ); pragma INTERFACE(C, LIST_SELECT_POS); pragma INTERFACE_NAME(LIST_SELECT_POS, "XmListSelectPos"); begin LIST_SELECT_POS ( WIDGET_TO_ADDR(WIDGET), POSITION, BOOLEAN'POS(NOTIFY) ); end XM_LIST_SELECT_POS; -- ******************************************************** -- * -- * Main window routines -- * -- ******************************************************** -- -- MAIN WINDOW SEP1 -- function XM_MAIN_WINDOW_SEP1 ( WIDGET : XT.WIDGET ) return XT.WIDGET is function MAIN_WINDOW_SEP1 ( WIDGET : SYSTEM.ADDRESS ) return SYSTEM.ADDRESS; pragma INTERFACE(C, MAIN_WINDOW_SEP1 ); pragma INTERFACE_NAME(MAIN_WINDOW_SEP1, "XmMainWindowSep1"); begin return ADDR_TO_WIDGET( MAIN_WINDOW_SEP1( WIDGET_TO_ADDR(WIDGET) ) ); end XM_MAIN_WINDOW_SEP1; -- -- MAIN WINDOW SEP2 -- function XM_MAIN_WINDOW_SEP2 ( WIDGET : XT.WIDGET ) return XT.WIDGET is function MAIN_WINDOW_SEP2 ( WIDGET : SYSTEM.ADDRESS ) return SYSTEM.ADDRESS; pragma INTERFACE(C, MAIN_WINDOW_SEP2 ); pragma INTERFACE_NAME(MAIN_WINDOW_SEP2, "XmMainWindowSep2"); begin return ADDR_TO_WIDGET( MAIN_WINDOW_SEP2( WIDGET_TO_ADDR(WIDGET) ) ); end XM_MAIN_WINDOW_SEP2; -- -- MAIN WINDOW SET AREAS -- procedure XM_MAIN_WINDOW_SET_AREAS ( WIDGET : XT.WIDGET; MENU_BAR : XT.WIDGET; COMMAND_WINDOW : XT.WIDGET; HORIZONTAL_SCROLLBAR : XT.WIDGET; VERTICAL_SCROLLBAR : XT.WIDGET; WORK_REGIONS : XT.WIDGET ) is procedure MAIN_WINDOW_SET_AREAS ( WIDGET : SYSTEM.ADDRESS; MENU_BAR : SYSTEM.ADDRESS; COMMAND_WINDOW : SYSTEM.ADDRESS; HORIZONTAL_SCROLLBAR : SYSTEM.ADDRESS; VERTICAL_SCROLLBAR : SYSTEM.ADDRESS; WORK_REGIONS : SYSTEM.ADDRESS ); pragma INTERFACE(C, MAIN_WINDOW_SET_AREAS ); pragma INTERFACE_NAME(MAIN_WINDOW_SET_AREAS, "XmMainWindowSetAreas"); begin MAIN_WINDOW_SET_AREAS ( WIDGET_TO_ADDR (WIDGET ), WIDGET_TO_ADDR (MENU_BAR ), WIDGET_TO_ADDR (COMMAND_WINDOW ), WIDGET_TO_ADDR (HORIZONTAL_SCROLLBAR ), WIDGET_TO_ADDR (VERTICAL_SCROLLBAR ), WIDGET_TO_ADDR (WORK_REGIONS ) ); end XM_MAIN_WINDOW_SET_AREAS; -- ******************************************************** -- * -- * XM_MENU_POSITION -- * -- ******************************************************** -- -- MENU POSITION -- procedure XM_MENU_POSITION( MENU : XT.WIDGET; EVENT : SYSTEM.ADDRESS ) is procedure MENU_POSITION ( M : SYSTEM.ADDRESS; E : SYSTEM.ADDRESS ); pragma INTERFACE (C, MENU_POSITION); pragma INTERFACE_NAME (MENU_POSITION, "XmMenuPosition"); begin MENU_POSITION( WIDGET_TO_ADDR(MENU), EVENT ); end XM_MENU_POSITION; -- ******************************************************** -- * -- * Message Box widget routines -- * -- ******************************************************** -- -- MESSAGE BOX GET CHILD -- function XM_MESSAGE_BOX_GET_CHILD( W : WIDGET; CHILD : AFS_LARGE_INTEGER) return WIDGET is function MESSAGE_BOX_GET_CHILD( W : SYSTEM.ADDRESS; CHILD : AFS_LARGE_INTEGER) return SYSTEM.ADDRESS; pragma INTERFACE (C, MESSAGE_BOX_GET_CHILD); pragma INTERFACE_NAME (MESSAGE_BOX_GET_CHILD, "XmMessageBoxGetChild"); begin return ADDR_TO_WIDGET(MESSAGE_BOX_GET_CHILD( WIDGET_TO_ADDR(W),CHILD)); end XM_MESSAGE_BOX_GET_CHILD; -- ******************************************************** -- * -- * Scale widget routines -- * -- ******************************************************** -- -- SCALE GET VALUE -- --common routine for overloaded calls procedure SCALE_GET_VALUE( WIDGET : SYSTEM.ADDRESS; INT : SYSTEM.ADDRESS ); pragma INTERFACE(C, SCALE_GET_VALUE ); pragma INTERFACE_NAME(SCALE_GET_VALUE, "XmScaleGetValue"); procedure XM_SCALE_GET_VALUE( WIDGET : XT.WIDGET; INT : SYSTEM.ADDRESS ) is begin SCALE_GET_VALUE( WIDGET_TO_ADDR(WIDGET), INT ); end XM_SCALE_GET_VALUE; procedure XM_SCALE_GET_VALUE( WIDGET : XT.WIDGET; INT : AFS_LARGE_INTEGER ) is begin SCALE_GET_VALUE( WIDGET_TO_ADDR(WIDGET), INT'address ); end XM_SCALE_GET_VALUE; -- -- SCALE SET VALUE -- procedure XM_SCALE_SET_VALUE ( WIDGET : XT.WIDGET; INT : AFS_LARGE_INTEGER ) is procedure SCALE_SET_VALUE ( W : SYSTEM.ADDRESS; I : AFS_LARGE_INTEGER ); pragma INTERFACE(C, SCALE_SET_VALUE ); pragma INTERFACE_NAME(SCALE_SET_VALUE, "XmScaleSetValue"); begin SCALE_SET_VALUE( WIDGET_TO_ADDR(WIDGET), INT ); end XM_SCALE_SET_VALUE; -- ******************************************************** -- * -- * Scroll bar related routines -- * -- ******************************************************** -- -- SCROLL BAR GET VALUES -- --common routine for overloaded calls procedure SCROLL_BAR_GET_VALUES( WIDGET : SYSTEM.ADDRESS; VALUE_RETURN : SYSTEM.ADDRESS; SLIDER_SIZE_RETURN : SYSTEM.ADDRESS; INCREMENT_RETURN : SYSTEM.ADDRESS; PAGE_INCREMENT_RETURN : SYSTEM.ADDRESS ); pragma INTERFACE(C,SCROLL_BAR_GET_VALUES); pragma INTERFACE_NAME(SCROLL_BAR_GET_VALUES,"XmScrollBarGetValues"); procedure XM_SCROLL_BAR_GET_VALUES( WIDGET : XT.WIDGET; VALUE_RETURN : SYSTEM.ADDRESS; SLIDER_SIZE_RETURN : SYSTEM.ADDRESS; INCREMENT_RETURN : SYSTEM.ADDRESS; PAGE_INCREMENT_RETURN : SYSTEM.ADDRESS ) is begin SCROLL_BAR_GET_VALUES( WIDGET_TO_ADDR(WIDGET), VALUE_RETURN, SLIDER_SIZE_RETURN, INCREMENT_RETURN, PAGE_INCREMENT_RETURN ); end XM_SCROLL_BAR_GET_VALUES; procedure XM_SCROLL_BAR_GET_VALUES( WIDGET : XT.WIDGET; VALUE_RETURN : AFS_LARGE_INTEGER; SLIDER_SIZE_RETURN : AFS_LARGE_INTEGER; INCREMENT_RETURN : AFS_LARGE_INTEGER; PAGE_INCREMENT_RETURN : AFS_LARGE_INTEGER ) is begin SCROLL_BAR_GET_VALUES( WIDGET_TO_ADDR(WIDGET), VALUE_RETURN'address, SLIDER_SIZE_RETURN'address, INCREMENT_RETURN'address, PAGE_INCREMENT_RETURN'address ); end XM_SCROLL_BAR_GET_VALUES; -- -- SCROLL BAR SET VALUES -- procedure XM_SCROLL_BAR_SET_VALUES( WIDGET : XT.WIDGET; VALUE : AFS_LARGE_INTEGER; SLIDER_SIZE : AFS_LARGE_INTEGER; INCREMENT : AFS_LARGE_INTEGER; PAGE_INCREMENT : AFS_LARGE_INTEGER; NOTIFY : BOOLEAN ) is procedure SCROLL_BAR_SET_VALUES( WIDGET : SYSTEM.ADDRESS; VALUE : AFS_LARGE_INTEGER; SLIDER_SIZE : AFS_LARGE_INTEGER; INCREMENT : AFS_LARGE_INTEGER; PAGE_INCREMENT : AFS_LARGE_INTEGER; NOTIFY : AFS_LARGE_INTEGER ); pragma INTERFACE(C, SCROLL_BAR_SET_VALUES); pragma INTERFACE_NAME(SCROLL_BAR_SET_VALUES,"XmScrollBarSetValues"); begin SCROLL_BAR_SET_VALUES( WIDGET_TO_ADDR(WIDGET), VALUE, SLIDER_SIZE, INCREMENT, PAGE_INCREMENT, BOOLEAN'pos(NOTIFY) ); end XM_SCROLL_BAR_SET_VALUES; -- ******************************************************** -- * -- * Scrolled Window widget routines -- * -- ******************************************************** -- -- SCROLLED WINDOW SET AREAS -- procedure SCROLLED_WINDOW_SET_AREAS( WIDGET : SYSTEM.ADDRESS; HORIZONTAL_SCROLLBAR : SYSTEM.ADDRESS; VERTICAL_SCROLLBAR : SYSTEM.ADDRESS; WORK_REGION : SYSTEM.ADDRESS); pragma INTERFACE(C, SCROLLED_WINDOW_SET_AREAS); pragma INTERFACE_NAME(SCROLLED_WINDOW_SET_AREAS,"XmScrolledWindowSetAreas"); procedure XM_SCROLLED_WINDOW_SET_AREAS( WIDGET : XT.WIDGET; HORIZONTAL_SCROLLBAR : XT.WIDGET; VERTICAL_SCROLLBAR : XT.WIDGET; WORK_REGION : XT.WIDGET) is begin SCROLLED_WINDOW_SET_AREAS( WIDGET_TO_ADDR(WIDGET), WIDGET_TO_ADDR(HORIZONTAL_SCROLLBAR), WIDGET_TO_ADDR(VERTICAL_SCROLLBAR), WIDGET_TO_ADDR(WORK_REGION) ); end XM_SCROLLED_WINDOW_SET_AREAS; -- ******************************************************** -- * -- * Selection Box widget routines -- * -- ******************************************************** -- -- SELECTION BOX GET CHILD -- function SELECTION_BOX_GET_CHILD( WIDGET : SYSTEM.ADDRESS; CHILD : AFS_LARGE_INTEGER) return XT.WIDGET; pragma INTERFACE(C,SELECTION_BOX_GET_CHILD); pragma INTERFACE_NAME(SELECTION_BOX_GET_CHILD,"XmSelectionBoxGetChild"); function XM_SELECTION_BOX_GET_CHILD( WIDGET : XT.WIDGET; CHILD : AFS_LARGE_INTEGER) return XT.WIDGET is begin return( SELECTION_BOX_GET_CHILD( WIDGET_TO_ADDR(WIDGET), CHILD)); end XM_SELECTION_BOX_GET_CHILD; -- -- CASCADE BUTTON HIGHLIGHT -- procedure XM_CASCADE_BUTTON_HIGHLIGHT ( BUTTON : WIDGET; HIGHLIGHT : BOOLEAN ) is procedure BUTTON_HIGHLIGHT ( BUTTON : SYSTEM.ADDRESS; HIGHLIGHT : AFS_LARGE_INTEGER ); pragma INTERFACE (C, BUTTON_HIGHLIGHT); pragma INTERFACE_NAME (BUTTON_HIGHLIGHT, "XmCascadeButtonHighlight"); begin BUTTON_HIGHLIGHT ( WIDGET_TO_ADDR(BUTTON),BOOLEAN'pos (HIGHLIGHT) ); end XM_CASCADE_BUTTON_HIGHLIGHT; -- ******************************************************** -- * -- * String Related Routines -- * -- ******************************************************** -- -- ADA STRING FROM 'C' BUFFER -- -- This is a utility which is used internally by various -- string related routines -- procedure ADA_STR_FROM_BUFFER ( BUFFER : STRING; ADA_STRING : out STRING ) is A_STR : A_STRING; -- APOLLO SPECIFIC CODE begin A_STR := TO_A(TO_C(BUFFER(1)'address)); -- APOLLO SPECIFIC CODE declare TEMP_STRING : STRING(1..ADA_STRING'last) := (OTHERS => ASCII.NUL); begin TEMP_STRING(1..A_STR.len) := A_STR.s; -- APOLLO SPECIFIC CODE ADA_STRING := TEMP_STRING; end; end ADA_STR_FROM_BUFFER; -- -- CVT STRING TO UNIT TYPE -- procedure XM_CVT_STRING_TO_UNIT_TYPE( ARGLIST : in ARG_LIST := NULL_ARG_LIST; FROM_VAL : in STRING; TO_VAL : out AFS_SMALL_INTEGER ) is procedure CVT_STRING_TO_UNIT_TYPE( ARGS : SYSTEM.ADDRESS; NUM_ARGS : CARDINAL; FROM_VAL : SYSTEM.ADDRESS; TO_VAL : SYSTEM.ADDRESS ); pragma INTERFACE (C, CVT_STRING_TO_UNIT_TYPE); pragma INTERFACE_NAME (CVT_STRING_TO_UNIT_TYPE, "XmCvtStringToUnitType"); TEMP_STRING : constant STRING := FROM_VAL & ASCII.NUL; begin CVT_STRING_TO_UNIT_TYPE( ARGS => ARGLIST.all.LIST'address, NUM_ARGS => CARDINAL(ARGLIST.all.INDEX), FROM_VAL => TEMP_STRING'address, TO_VAL => TO_VAL'address ); end XM_CVT_STRING_TO_UNIT_TYPE; -- -- SET FONT UNIT -- procedure XM_SET_FONT_UNIT ( DISPLAY : XLIB.DISPLAY_POINTER; VALUE : AFS_LARGE_INTEGER ) is procedure SET_FONT_UNIT( DISPL : SYSTEM.ADDRESS; VAL : AFS_LARGE_INTEGER ); pragma INTERFACE(C, SET_FONT_UNIT); pragma INTERFACE_NAME(SET_FONT_UNIT, "XmSetFontUnit"); begin SET_FONT_UNIT(XLIB.DISPLAY_POINTER_TO_ADDR(DISPLAY),VALUE); end XM_SET_FONT_UNIT; -- ******************************************************** -- * -- * String Routines -- * -- ******************************************************** -- -- STRING BASELINE -- function XM_STRING_BASELINE( FONTLIST : XM_FONT_LIST; STRING : XM_COMPOUND_STRING ) return DIMENSION is function STRING_BASELINE( FLIST : SYSTEM.ADDRESS; STR : SYSTEM.ADDRESS) return DIMENSION; pragma INTERFACE (C, STRING_BASELINE); pragma INTERFACE_NAME(STRING_BASELINE, "XmStringBaseline"); begin return STRING_BASELINE( SYSTEM.ADDRESS(FONTLIST), SYSTEM.ADDRESS(STRING) ); end XM_STRING_BASELINE; -- -- STRING BYTE COMPARE -- function XM_STRING_BYTE_COMPARE( A : XM_COMPOUND_STRING; B : XM_COMPOUND_STRING ) return BOOLEAN is function STRING_BYTE_COMPARE( A : SYSTEM.ADDRESS; B : SYSTEM.ADDRESS ) return AFS_LARGE_INTEGER; pragma INTERFACE(C,STRING_BYTE_COMPARE); pragma INTERFACE_NAME(STRING_BYTE_COMPARE, "XmStringByteCompare"); begin return BOOLEAN'val(STRING_BYTE_COMPARE(SYSTEM.ADDRESS(A),SYSTEM.ADDRESS(B))); end XM_STRING_BYTE_COMPARE; -- -- STRING COMPARE -- function XM_STRING_COMPARE( A : XM_COMPOUND_STRING; B : XM_COMPOUND_STRING ) return BOOLEAN is function STRING_COMPARE( A : SYSTEM.ADDRESS; B : SYSTEM.ADDRESS ) return AFS_LARGE_INTEGER; pragma INTERFACE(C,STRING_COMPARE); pragma INTERFACE_NAME(STRING_COMPARE, "XmStringCompare"); begin return BOOLEAN'val(STRING_COMPARE(SYSTEM.ADDRESS(A),SYSTEM.ADDRESS(B))); end XM_STRING_COMPARE; -- -- STRING CONCATENATE -- function XM_STRING_CONCAT ( STRING1 : in XM_COMPOUND_STRING; STRING2 : in XM_COMPOUND_STRING ) return XM_COMPOUND_STRING is function STRING_CONCAT ( S1 : XM_COMPOUND_STRING; S2 : XM_COMPOUND_STRING ) return SYSTEM.ADDRESS; pragma INTERFACE (C, STRING_CONCAT); pragma INTERFACE_NAME (STRING_CONCAT, "XmStringConcat"); begin return XM_COMPOUND_STRING( STRING_CONCAT ( STRING1,STRING2)); end XM_STRING_CONCAT; -- -- STRING COPY -- function XM_STRING_COPY( STRING : XM_COMPOUND_STRING ) return XM_COMPOUND_STRING is function STRING_COPY( S1 : XM_COMPOUND_STRING ) return SYSTEM.ADDRESS; pragma INTERFACE (C, STRING_COPY); pragma INTERFACE_NAME (STRING_COPY, "XmStringCopy"); begin return XM_COMPOUND_STRING( STRING_COPY (STRING)); end XM_STRING_COPY; -- -- STRING CREATE -- function XM_STRING_CREATE( TEXT : STRING; CHARSET : in AFS_SMALL_INTEGER := XM_STRING_DEFAULT_CHARSET ) return XM_COMPOUND_STRING is function STRING_CREATE ( T : SYSTEM.ADDRESS; CHRST : SYSTEM.ADDRESS ) return SYSTEM.ADDRESS; pragma INTERFACE (C, STRING_CREATE); pragma INTERFACE_NAME (STRING_CREATE, "XmStringCreate"); TEMP_STR : constant STRING := TEXT & ASCII.NUL; begin return XM_COMPOUND_STRING (STRING_CREATE(TEMP_STR'address,CHARSET'address)); end XM_STRING_CREATE; -- -- STRING CREATE FONT LIST -- function XM_STRING_CREATE_FONT_LIST( FONT : SYSTEM.ADDRESS; CHARSET : AFS_SMALL_INTEGER := XM_STRING_DEFAULT_CHARSET ) return XM_FONT_LIST is function STRING_CREATE_FONT_LIST ( FONT : SYSTEM.ADDRESS; CHARSET : SYSTEM.ADDRESS ) return SYSTEM.ADDRESS; pragma INTERFACE (C, STRING_CREATE_FONT_LIST); pragma INTERFACE_NAME (STRING_CREATE_FONT_LIST,"XmStringCreateFontList"); begin return XM_FONT_LIST (STRING_CREATE_FONT_LIST ( FONT, CHARSET'address)); end XM_STRING_CREATE_FONT_LIST; -- -- STRING CREATE 'LEFT TO RIGHT' -- function STRING_CREATE_L_TO_R ( T : SYSTEM.ADDRESS; CHRST : SYSTEM.ADDRESS ) return SYSTEM.ADDRESS; pragma INTERFACE (C, STRING_CREATE_L_TO_R); pragma INTERFACE_NAME (STRING_CREATE_L_TO_R, "XmStringCreateLtoR"); function XM_STRING_CREATE_L_TO_R( TEXT : SYSTEM.ADDRESS; CHARSET : AFS_SMALL_INTEGER := XM_STRING_DEFAULT_CHARSET ) return XM_COMPOUND_STRING is begin return XM_COMPOUND_STRING (STRING_CREATE_L_TO_R(TEXT,CHARSET'address)); end XM_STRING_CREATE_L_TO_R; function XM_STRING_CREATE_L_TO_R( TEXT : in STRING; CHARSET : in AFS_SMALL_INTEGER := XM_STRING_DEFAULT_CHARSET ) return XM_COMPOUND_STRING is TEMP_STR : constant STRING := TEXT & ASCII.NUL; begin return XM_COMPOUND_STRING (STRING_CREATE_L_TO_R(TEMP_STR'address,CHARSET'address)); end XM_STRING_CREATE_L_TO_R; -- -- STRING EMPTY -- function XM_STRING_EMPTY( STRING : XM_COMPOUND_STRING ) return BOOLEAN is function STRING_EMPTY(STR : SYSTEM.ADDRESS) return AFS_LARGE_INTEGER; pragma INTERFACE(C,STRING_EMPTY); pragma INTERFACE_NAME(STRING_EMPTY,"XmStringEmpty"); begin return BOOLEAN'val(STRING_EMPTY(SYSTEM.ADDRESS(STRING))); end XM_STRING_EMPTY; -- -- STRING EXTENT -- procedure XM_STRING_EXTENT( FONTLIST : in XM_FONT_LIST; STRING : in XM_COMPOUND_STRING; WIDTH : out DIMENSION; HEIGHT : out DIMENSION ) is procedure STRING_EXTENT( FLIST : SYSTEM.ADDRESS; STRNG : SYSTEM.ADDRESS; WDTH : SYSTEM.ADDRESS; HEIGHT : SYSTEM.ADDRESS ); pragma INTERFACE(C, STRING_EXTENT); pragma INTERFACE_NAME(STRING_EXTENT,"XmStringExtent"); TEMP_WIDTH : DIMENSION; TEMP_HEIGHT : DIMENSION; begin STRING_EXTENT( SYSTEM.ADDRESS(FONTLIST), SYSTEM.ADDRESS(STRING), TEMP_WIDTH'address, TEMP_HEIGHT'address ); WIDTH := TEMP_WIDTH; HEIGHT := TEMP_HEIGHT; end XM_STRING_EXTENT; -- -- STRING FREE -- procedure XM_STRING_FREE(STRING : XM_COMPOUND_STRING) is procedure STRING_FREE ( STRING : SYSTEM.ADDRESS ); pragma INTERFACE (C, STRING_FREE); pragma INTERFACE_NAME (STRING_FREE, "XmStringFree"); begin STRING_FREE(SYSTEM.ADDRESS(STRING)); end XM_STRING_FREE; -- -- STRING FREE CONTEXT -- procedure XM_STRING_FREE_CONTEXT ( CONTEXT : XM_STRING_CONTEXT ) is procedure STRING_FREE_CONTEXT ( CNTXT : SYSTEM.ADDRESS ); pragma INTERFACE (C, STRING_FREE_CONTEXT); pragma INTERFACE_NAME (STRING_FREE_CONTEXT, "XmStringFreeContext"); begin STRING_FREE_CONTEXT (SYSTEM.ADDRESS(CONTEXT) ); end XM_STRING_FREE_CONTEXT; -- -- STRING GET NEXT SEGMENT -- procedure XM_STRING_GET_NEXT_SEGMENT (CONTEXT : XM_STRING_CONTEXT; TEXT : in out STRING; CHARSET : in out AFS_SMALL_INTEGER; DIRECTION : in out AFS_LARGE_INTEGER; SEPARATOR : in out BOOLEAN; SUCCESSFUL : in out BOOLEAN) is function STRING_GET_NEXT_SEGMENT (CNTXT : in SYSTEM.ADDRESS; TXT : in SYSTEM.ADDRESS; CHRST : in SYSTEM.ADDRESS; DRCTN : in SYSTEM.ADDRESS; SPRTR : in SYSTEM.ADDRESS) return AFS_LARGE_INTEGER; pragma INTERFACE (C, STRING_GET_NEXT_SEGMENT); pragma INTERFACE_NAME (STRING_GET_NEXT_SEGMENT, "XmStringGetNextSegmentFk"); BUFFER : STRING(1..1024) := (others => ASCII.NUL); SEP_TEMP : AFS_LARGE_INTEGER; DIR_TEMP : AFS_SMALL_INTEGER; begin SUCCESSFUL := BOOLEAN'val ( STRING_GET_NEXT_SEGMENT( SYSTEM.ADDRESS(CONTEXT),BUFFER(1)'address, CHARSET'address,DIR_TEMP'address,SEP_TEMP'address)); ADA_STR_FROM_BUFFER( BUFFER, TEXT); DIRECTION := AFS_LARGE_INTEGER( DIR_TEMP ); SEPARATOR := BOOLEAN'val( SEP_TEMP ); end XM_STRING_GET_NEXT_SEGMENT; -- -- STRING GET 'LEFT TO RIGHT' -- procedure XM_STRING_GET_L_TO_R ( STR : in XM_COMPOUND_STRING; CHARSET : in AFS_SMALL_INTEGER; TEXT : in out STRING; SUCCESSFUL : in out BOOLEAN) is function STRING_GET_L_TO_R ( STR : SYSTEM.ADDRESS; CHARSET : SYSTEM.ADDRESS; TEXT : SYSTEM.ADDRESS) return AFS_LARGE_INTEGER; pragma INTERFACE (C,STRING_GET_L_TO_R); pragma INTERFACE_NAME (STRING_GET_L_TO_R,"XmStringGetLtoRFake"); BUFFER : STRING(1..1024) := (others => ASCII.NUL); begin SUCCESSFUL := BOOLEAN'val(STRING_GET_L_TO_R(SYSTEM.ADDRESS(STR),CHARSET'address,BUFFER(1)'address)); ADA_STR_FROM_BUFFER( BUFFER, TEXT ); end XM_STRING_GET_L_TO_R; -- -- STRING HEIGHT -- function XM_STRING_HEIGHT( FONTLIST : XM_FONT_LIST; STRING : XM_COMPOUND_STRING ) return DIMENSION is function STRING_HEIGHT( FLIST : SYSTEM.ADDRESS; STR : SYSTEM.ADDRESS) return DIMENSION; pragma INTERFACE (C, STRING_HEIGHT); pragma INTERFACE_NAME(STRING_HEIGHT, "XmStringHeight"); begin return STRING_HEIGHT( SYSTEM.ADDRESS(FONTLIST), SYSTEM.ADDRESS(STRING) ); end XM_STRING_HEIGHT; -- -- STRING INITIALIZE CONTEXT -- function XM_STRING_INIT_CONTEXT( CONTEXT : XM_STRING_CONTEXT; STRING : XM_COMPOUND_STRING ) return BOOLEAN is function STRING_INIT_CONTEXT (CTXT : SYSTEM.ADDRESS; STRNG : SYSTEM.ADDRESS ) return AFS_LARGE_INTEGER; pragma INTERFACE (C, STRING_INIT_CONTEXT); pragma INTERFACE_NAME (STRING_INIT_CONTEXT, "XmStringInitContext"); begin return BOOLEAN'val(STRING_INIT_CONTEXT ( SYSTEM.ADDRESS(CONTEXT), SYSTEM.ADDRESS(STRING))); end XM_STRING_INIT_CONTEXT; -- -- STRING 'LEFT TO RIGHT' CREATE -- -- common function for overloaded functions following function STRING_L_TO_R_CREATE ( T : SYSTEM.ADDRESS; CHRST : SYSTEM.ADDRESS ) return SYSTEM.ADDRESS; pragma INTERFACE (C, STRING_L_TO_R_CREATE); pragma INTERFACE_NAME (STRING_L_TO_R_CREATE, "XmStringLtoRCreate"); function XM_STRING_L_TO_R_CREATE( TEXT : SYSTEM.ADDRESS; CHARSET : AFS_SMALL_INTEGER := XM_STRING_DEFAULT_CHARSET ) return XM_COMPOUND_STRING is begin return XM_COMPOUND_STRING (STRING_L_TO_R_CREATE(TEXT,CHARSET'address)); end XM_STRING_L_TO_R_CREATE; function XM_STRING_L_TO_R_CREATE( TEXT : in STRING; CHARSET : in AFS_SMALL_INTEGER := XM_STRING_DEFAULT_CHARSET ) return XM_COMPOUND_STRING is TEMP_STR : constant STRING := TEXT & ASCII.NUL; begin return XM_COMPOUND_STRING (STRING_L_TO_R_CREATE(TEMP_STR'address,CHARSET'address)); end XM_STRING_L_TO_R_CREATE; -- -- STRING LINE COUNT -- function XM_STRING_LINE_COUNT( STRING : XM_COMPOUND_STRING ) return AFS_LARGE_INTEGER is function STRING_LINE_COUNT ( STR : SYSTEM.ADDRESS ) return AFS_LARGE_INTEGER; pragma INTERFACE (C, STRING_LINE_COUNT); pragma INTERFACE_NAME(STRING_LINE_COUNT, "XmStringLineCount"); begin return STRING_LINE_COUNT( SYSTEM.ADDRESS(STRING) ); end XM_STRING_LINE_COUNT; -- -- STRING LENGTH -- function XM_STRING_LENGTH( STRING : XM_COMPOUND_STRING ) return AFS_LARGE_INTEGER is function STRING_LENGTH(STR : SYSTEM.ADDRESS) return AFS_LARGE_INTEGER; pragma INTERFACE(C,STRING_LENGTH); pragma INTERFACE_NAME(STRING_LENGTH,"XmStringLength"); begin return STRING_LENGTH(SYSTEM.ADDRESS(STRING)); end XM_STRING_LENGTH; -- -- STRING N CONCAT -- function XM_STRING_N_CONCAT ( STRING1 : in XM_COMPOUND_STRING; STRING2 : in XM_COMPOUND_STRING; NUM_BYTES : in AFS_LARGE_INTEGER ) return XM_COMPOUND_STRING is function STRING_N_CONCAT ( S1 : SYSTEM.ADDRESS; S2 : SYSTEM.ADDRESS; N : SYSTEM.ADDRESS ) return SYSTEM.ADDRESS; pragma INTERFACE (C, STRING_N_CONCAT); pragma INTERFACE_NAME (STRING_N_CONCAT, "XmStringNConcat"); begin return XM_COMPOUND_STRING( STRING_N_CONCAT (SYSTEM.ADDRESS(STRING1), SYSTEM.ADDRESS(STRING2), NUM_BYTES'address ) ); end XM_STRING_N_CONCAT; -- -- STRING SEGMENT CREATE -- function XM_STRING_SEGMENT_CREATE ( TEXT : in STRING; CHARSET : in AFS_SMALL_INTEGER := XM_STRING_DEFAULT_CHARSET; DIRECTION : in AFS_LARGE_INTEGER := XM_STRING_DIRECTION_L_TO_R; SEPARATOR : in BOOLEAN := FALSE ) return XM_COMPOUND_STRING is function STRING_SEGMENT_CREATE ( TXT : SYSTEM.ADDRESS; CHRST : SYSTEM.ADDRESS; DIR : AFS_LARGE_INTEGER; SEPRTR : AFS_LARGE_INTEGER ) return SYSTEM.ADDRESS; pragma INTERFACE (C, STRING_SEGMENT_CREATE); pragma INTERFACE_NAME (STRING_SEGMENT_CREATE, "XmStringSegmentCreateFake"); TEMP_STRING : constant STRING := TEXT & ASCII.NUL; begin return XM_COMPOUND_STRING( STRING_SEGMENT_CREATE( TEMP_STRING'address, CHARSET'address, DIRECTION, BOOLEAN'pos(SEPARATOR))); end XM_STRING_SEGMENT_CREATE; -- -- STRING SEPARATOR CREATE -- function XM_STRING_SEPARATOR_CREATE (SEPARATOR : BOOLEAN) return XM_COMPOUND_STRING is function STRING_SEPARATOR_CREATE( SEPARATOR : AFS_LARGE_INTEGER) return SYSTEM.ADDRESS; pragma INTERFACE (C, STRING_SEPARATOR_CREATE); pragma INTERFACE_NAME (STRING_SEPARATOR_CREATE, "XmStringSeparatorCreate"); begin return XM_COMPOUND_STRING (STRING_SEPARATOR_CREATE(BOOLEAN'pos(SEPARATOR))); end XM_STRING_SEPARATOR_CREATE; -- -- STRING WIDTH -- function XM_STRING_WIDTH( FONTLIST : XM_FONT_LIST; STRING : XM_COMPOUND_STRING ) return DIMENSION is function STRING_WIDTH( FLIST : SYSTEM.ADDRESS; STR : SYSTEM.ADDRESS) return DIMENSION; pragma INTERFACE (C, STRING_WIDTH); pragma INTERFACE_NAME(STRING_WIDTH, "XmStringWidth"); begin return STRING_WIDTH( SYSTEM.ADDRESS(FONTLIST), SYSTEM.ADDRESS(STRING) ); end XM_STRING_WIDTH; -- ******************************************************** -- * -- * Font List Routines -- * -- ******************************************************** -- -- FONT LIST ADD -- procedure XM_FONT_LIST_ADD ( OLD : XM_FONT_LIST; FONT : XLIB.X_FONT_STRUCT_PTR; CHARSET : AFS_SMALL_INTEGER ) is procedure FONT_LIST_ADD ( OLD : SYSTEM.ADDRESS; FONT : XLIB.X_FONT_STRUCT_PTR; CHARSET : SYSTEM.ADDRESS ); pragma INTERFACE (C, FONT_LIST_ADD); pragma INTERFACE_NAME (FONT_LIST_ADD,"XmFontListAdd"); begin FONT_LIST_ADD( SYSTEM.ADDRESS(OLD),FONT, CHARSET'address); end XM_FONT_LIST_ADD; -- -- FONT LIST COPY -- function XM_FONT_LIST_COPY ( FONTLIST : XM_FONT_LIST ) return XM_FONT_LIST is function FONT_LIST_COPY ( FONTLIST : SYSTEM.ADDRESS ) return SYSTEM.ADDRESS; pragma INTERFACE (C, FONT_LIST_COPY); pragma INTERFACE_NAME (FONT_LIST_COPY, "XmFontListCopy"); begin return XM_FONT_LIST ( FONT_LIST_COPY(SYSTEM.ADDRESS(FONTLIST)) ); end XM_FONT_LIST_COPY; -- -- FONT LIST CREATE -- function XM_FONT_LIST_CREATE ( FONT : in XLIB.X_FONT_STRUCT_PTR; CHARSET : in AFS_SMALL_INTEGER ) return XM_FONT_LIST is function FONT_LIST_CREATE ( FONT : in XLIB.X_FONT_STRUCT_PTR; CHARSET : SYSTEM.ADDRESS ) return SYSTEM.ADDRESS; pragma INTERFACE (C, FONT_LIST_CREATE); pragma INTERFACE_NAME (FONT_LIST_CREATE,"XmFontListCreate"); begin return XM_FONT_LIST (FONT_LIST_CREATE ( FONT, CHARSET'address)); end XM_FONT_LIST_CREATE; -- -- FONT LIST FREE -- procedure XM_FONT_LIST_FREE ( FONTLIST : XM_FONT_LIST ) is procedure FONT_LIST_FREE( FLIST : SYSTEM.ADDRESS ); pragma INTERFACE (C, FONT_LIST_FREE); pragma INTERFACE_NAME (FONT_LIST_FREE, "XmFontListFree"); begin FONT_LIST_FREE(SYSTEM.ADDRESS(FONTLIST)); end XM_FONT_LIST_FREE; function XM_FONT_LIST_TO_ADDR( FONT_LIST : in XM_FONT_LIST ) return SYSTEM.ADDRESS is begin return( SYSTEM.ADDRESS( FONT_LIST )); end XM_FONT_LIST_TO_ADDR; -- ******************************************************** -- * -- * Command Routines -- * -- ******************************************************** -- -- COMMAND APPEND VALUE -- procedure XM_COMMAND_APPEND_VALUE( W : WIDGET; VALUE : XM_COMPOUND_STRING ) is procedure COMMAND_APPEND_VALUE ( W : SYSTEM.ADDRESS; VAL : SYSTEM.ADDRESS); pragma INTERFACE(C, COMMAND_APPEND_VALUE); pragma INTERFACE_NAME(COMMAND_APPEND_VALUE, "XmCommandAppendValue"); begin COMMAND_APPEND_VALUE(WIDGET_TO_ADDR(W),SYSTEM.ADDRESS(VALUE)); end XM_COMMAND_APPEND_VALUE; -- -- COMMAND ERROR -- procedure XM_COMMAND_ERROR( W : WIDGET; ERROR : XM_COMPOUND_STRING ) is procedure COMMAND_ERROR ( W : SYSTEM.ADDRESS; ERR : SYSTEM.ADDRESS); pragma INTERFACE(C, COMMAND_ERROR); pragma INTERFACE_NAME(COMMAND_ERROR, "XmCommandError"); begin COMMAND_ERROR(WIDGET_TO_ADDR(W),SYSTEM.ADDRESS(ERROR)); end XM_COMMAND_ERROR; -- -- COMMAND GET CHILD -- function XM_COMMAND_GET_CHILD( PARENT : WIDGET; CHILD : AFS_LARGE_INTEGER ) return WIDGET is function COMMAND_GET_CHILD( PARENT : SYSTEM.ADDRESS; CHILD : AFS_LARGE_INTEGER ) return SYSTEM.ADDRESS; pragma INTERFACE(C, COMMAND_GET_CHILD); pragma INTERFACE_NAME(COMMAND_GET_CHILD, "XmCommandGetChildFk"); begin return ADDR_TO_WIDGET( COMMAND_GET_CHILD( WIDGET_TO_ADDR(PARENT), CHILD )); end XM_COMMAND_GET_CHILD; -- -- COMMAND SET VALUE -- procedure XM_COMMAND_SET_VALUE( W : WIDGET; VALUE : XM_COMPOUND_STRING ) is procedure COMMAND_SET_VALUE ( W : SYSTEM.ADDRESS; VAL : SYSTEM.ADDRESS); pragma INTERFACE(C, COMMAND_SET_VALUE); pragma INTERFACE_NAME(COMMAND_SET_VALUE, "XmCommandSetValue"); begin COMMAND_SET_VALUE(WIDGET_TO_ADDR(W),SYSTEM.ADDRESS(VALUE)); end XM_COMMAND_SET_VALUE; -- ******************************************************** -- * -- * File Selection Box convenience routines. -- * -- ******************************************************** -- -- FILE SELECTION BOX GET CHILD -- function XM_FILE_SELECTION_BOX_GET_CHILD( FS : WIDGET; WHICH : AFS_LARGE_INTEGER ) return WIDGET is function FILE_SELECTION_BOX_GET_CHILD( F : SYSTEM.ADDRESS; WHCH : AFS_LARGE_INTEGER ) return SYSTEM.ADDRESS; pragma INTERFACE (C, FILE_SELECTION_BOX_GET_CHILD); pragma INTERFACE_NAME(FILE_SELECTION_BOX_GET_CHILD, "XmFileSelectionBoxGetChildFk"); begin return ADDR_TO_WIDGET( FILE_SELECTION_BOX_GET_CHILD( WIDGET_TO_ADDR(FS), WHICH)); end XM_FILE_SELECTION_BOX_GET_CHILD; -- ******************************************************** -- * -- * Text Widget convenience routines. -- * -- ******************************************************** -- -- TEXT GET EDITABLE -- function XM_TEXT_GET_EDITABLE ( WIDGET : XT.WIDGET ) return BOOLEAN is function TEXT_GET_EDITABLE ( WIDGET : SYSTEM.ADDRESS ) return AFS_LARGE_INTEGER; pragma INTERFACE (C, TEXT_GET_EDITABLE ); pragma INTERFACE_NAME (TEXT_GET_EDITABLE, "XmTextGetEditable"); begin return BOOLEAN'val(TEXT_GET_EDITABLE(WIDGET_TO_ADDR(WIDGET))); end XM_TEXT_GET_EDITABLE; -- -- TEXT GET STRING -- -- Version of XM_TEXT_GET_STRING which returns an A_STRING. function XM_TEXT_GET_STRING ( W : WIDGET ) return A_strings.A_STRING is procedure TEXT_GET_STRING( W : SYSTEM.ADDRESS; STR : SYSTEM.ADDRESS ); pragma INTERFACE (C, TEXT_GET_STRING); pragma INTERFACE_NAME(TEXT_GET_STRING, "XmTextGetStringFk"); BUFFER : STRING(1..1024) := (others => ASCII.NUL); begin TEXT_GET_STRING( WIDGET_TO_ADDR(W), BUFFER(1)'address); return C_strings.TO_A(C_strings.TO_C(BUFFER(1)'address)); end XM_TEXT_GET_STRING; -- Version of XM_TEXT_GET_STRING which returns a SYSTEM.ADDRESS function XM_TEXT_GET_STRING( W : WIDGET ) return SYSTEM.ADDRESS is function TEXT_GET_STRING2 ( W : SYSTEM.ADDRESS ) return SYSTEM.ADDRESS; pragma INTERFACE (C, TEXT_GET_STRING2); pragma INTERFACE_NAME(TEXT_GET_STRING2, "XmTextGetString"); begin return TEXT_GET_STRING2( WIDGET_TO_ADDR(W)); end XM_TEXT_GET_STRING; -- -- XM_TEXT_SET_EDITABLE -- procedure XM_TEXT_SET_EDITABLE ( WIDGET : XT.WIDGET; EDITABLE : BOOLEAN ) is procedure TEXT_SET_EDITABLE ( WIDGET : SYSTEM.ADDRESS; EDITABLE : AFS_LARGE_INTEGER ); pragma INTERFACE (C, TEXT_SET_EDITABLE ); pragma INTERFACE_NAME (TEXT_SET_EDITABLE, "XmTextSetEditable"); begin TEXT_SET_EDITABLE( WIDGET_TO_ADDR(WIDGET),BOOLEAN'pos(EDITABLE)); end XM_TEXT_SET_EDITABLE; -- -- TEXT SET STRING -- procedure XM_TEXT_SET_STRING ( W : WIDGET; CHAR : SYSTEM.ADDRESS ) is procedure TEXT_SET_STRING( W : SYSTEM.ADDRESS; CHAR : SYSTEM.ADDRESS ); pragma INTERFACE (C, TEXT_SET_STRING); pragma INTERFACE_NAME(TEXT_SET_STRING, "XmTextSetString"); begin TEXT_SET_STRING ( WIDGET_TO_ADDR(W),CHAR); end XM_TEXT_SET_STRING; -- ******************************************************** -- * -- * Toggle Button convenience routines. -- * -- ******************************************************** -- -- TOGGLE BUTTON GADGET GET STATE -- function XM_TOGGLE_BUTTON_GADGET_GET_STATE ( W : WIDGET ) return BOOLEAN is function TOGGLE_BUTTON_GET_STATE ( W : SYSTEM.ADDRESS ) return AFS_LARGE_INTEGER; pragma INTERFACE(C,TOGGLE_BUTTON_GET_STATE); pragma INTERFACE_NAME(TOGGLE_BUTTON_GET_STATE,"XmToggleButtonGadgetGetState"); begin return BOOLEAN'val(TOGGLE_BUTTON_GET_STATE(WIDGET_TO_ADDR(W))); end XM_TOGGLE_BUTTON_GADGET_GET_STATE; -- -- TOGGLE BUTTON GADGET SET STATE -- procedure XM_TOGGLE_BUTTON_GADGET_SET_STATE ( W : WIDGET; STATE : BOOLEAN; NOTIFY : BOOLEAN ) is procedure TOGGLE_BUTTON_SET_STATE ( W : SYSTEM.ADDRESS ; STATE : AFS_LARGE_INTEGER; NOTIFY : AFS_LARGE_INTEGER); pragma INTERFACE(C,TOGGLE_BUTTON_SET_STATE); pragma INTERFACE_NAME(TOGGLE_BUTTON_SET_STATE,"XmToggleButtonGadgetSetState"); begin TOGGLE_BUTTON_SET_STATE(WIDGET_TO_ADDR(W),BOOLEAN'pos(STATE),BOOLEAN'pos(NOTIFY)); end XM_TOGGLE_BUTTON_GADGET_SET_STATE; -- -- TOGGLE BUTTON GET STATE -- function XM_TOGGLE_BUTTON_GET_STATE ( W : WIDGET ) return BOOLEAN is function TOGGLE_BUTTON_GET_STATE ( W : SYSTEM.ADDRESS ) return AFS_LARGE_INTEGER; pragma INTERFACE(C,TOGGLE_BUTTON_GET_STATE); pragma INTERFACE_NAME(TOGGLE_BUTTON_GET_STATE,"XmToggleButtonGetState"); begin return BOOLEAN'val(TOGGLE_BUTTON_GET_STATE(WIDGET_TO_ADDR(W))); end XM_TOGGLE_BUTTON_GET_STATE; -- -- TOGGLE BUTTON SET STATE -- procedure XM_TOGGLE_BUTTON_SET_STATE ( W : WIDGET; STATE : BOOLEAN; NOTIFY : BOOLEAN ) is procedure TOGGLE_BUTTON_SET_STATE ( W : SYSTEM.ADDRESS ; STATE : AFS_LARGE_INTEGER; NOTIFY : AFS_LARGE_INTEGER); pragma INTERFACE(C,TOGGLE_BUTTON_SET_STATE); pragma INTERFACE_NAME(TOGGLE_BUTTON_SET_STATE,"XmToggleButtonSetState"); begin TOGGLE_BUTTON_SET_STATE(WIDGET_TO_ADDR(W),BOOLEAN'pos(STATE),BOOLEAN'pos(NOTIFY)); end XM_TOGGLE_BUTTON_SET_STATE; procedure XM_UPDATE_DISPLAY( W : XT.WIDGET ) is procedure XMUPDATEDISPLAY( W: XT.WIDGET); pragma INTERFACE( C ,XMUPDATEDISPLAY); pragma INTERFACE_NAME(XMUPDATEDISPLAY,"XmUpdateDisplay"); begin XMUPDATEDISPLAY(W); end XM_UPDATE_DISPLAY; procedure XM_ADD_TAB_GROUP( W : in WIDGET ) is procedure XM_ADD_TAB_GRP( W : in SYSTEM.ADDRESS ); pragma INTERFACE( C, XM_ADD_TAB_GRP ); pragma INTERFACE_NAME( XM_ADD_TAB_GRP, "XmAddTabGroup" ); begin XM_ADD_TAB_GRP( WIDGET_TO_ADDR(W) ); end XM_ADD_TAB_GROUP; procedure XM_REMOVE_TAB_GROUP( W : in WIDGET ) is procedure XM_REMOVE_TAB_GRP( W : in SYSTEM.ADDRESS ); pragma INTERFACE( C, XM_REMOVE_TAB_GRP ); pragma INTERFACE_NAME( XM_REMOVE_TAB_GRP, "XmRemoveTabGroup" ); begin XM_REMOVE_TAB_GRP( WIDGET_TO_ADDR(W) ); end XM_REMOVE_TAB_GROUP; end XM_WIDGET_SET;