Conference bulova::decw_jan-89_to_nov-90

1932.0. "Server its CPU on cleanup of hudreds of widgets" by TAV02::GAN () Sun Dec 17 1989 05:12

	Following is a small ADA program + UIL file that demonstrates
	a problem in DECWINDOWS: It try to create hundreds of PUSHBUTTON
	widgets. It works fine. When exiting out of the program, it takes
	a lot of time (in minutes) to the server to clean up. On the exit
	time, the server "eats" a lot of CPU. Is it a problem in DECWINDOWS
	server, or there is a better programming way that do NOT cause this
	behavior?

************* ADA DEMO Program: *****************************************

-- This sample program represent a problem (?) that we found :-
--
-- We wanted to build an application which will present the user with a parent dialog box, which contains a matrix of 
-- push buttons ( about 40 * 30 ) .
-- This matrix is to be build in low-level routines . One of the options that the user has is to increase/decrease his matrix
-- up to a certain limit ( 64 ) . 
-- The idea is to build a fixed dialog box and to change the size of the push buttons according to the matrix sizes .
-- In-order to do that, we have to unmanage the current push buttons, destory them ( to save resources ) ,build and manage them
-- again and represent the new matrix to the user .
--
-- So far so good . But we discovered that when we try to unmanage ( destory ) a big matrix which contains more than a 100 push 
-- buttons, the "Decw$Serever" takes a lot ( several minutes ) to handle such a request . 
-- From monitoring the program we discovered that the program stop almost immediatly and the "Dec$Server" is left to deal with
-- our request asynchronaly .
--
-- The same problem happens when the user requests to quit .
--
-- In this program the user has to determine the sizes of the matrix using the scales, and then press the "Apply" button to build
-- it . When you want to remove the matrix use the option "Reset" which is in the menu option "File" .
--
-- The most important procedures in this demo program are "Create_Matrix" and "Destroy_Matrix".
--
-- Our main question are :
-- 	What is the fastest way to unmange all the children of a parent widget ?
--	,,   ,,   ,,  ,,    ,,   ,, manage and present all the children of a parent widget ?

with DWT, SYSTEM;
package DIGITAL_PKG is

    -- Define an enumerated type for all the possible widgets.  The
    -- values for each enumeration must match the definitions given
    -- in the DIGITAL.UIL module.
    --
    type WIDGET_NAMES_TYPE is (
	FILE_PDME, 
	RESET_OPTION, 
	EXIT_OPTION, 
	LENGTH_SCALE, 
	WIDTH_SCALE, 
	APPLY_MATRIX, 
	MENU_BAR, 
	FILE_MENU, 
	DIALOG_BOX,
	MATRIX_BOX );    

    for WIDGET_NAMES_TYPE use (
	FILE_PDME	=> 1,
	RESET_OPTION	=> 2, 
	EXIT_OPTION	=> 3, 
	LENGTH_SCALE	=> 4,
	WIDTH_SCALE	=> 5, 
	APPLY_MATRIX	=> 6, 
	MENU_BAR	=> 7, 
	FILE_MENU	=> 8, 
	DIALOG_BOX	=> 9,
	MATRIX_BOX	=> 10 );

    -- Variables used in the application.
    --
    TOPLEVEL_WIDGET: DWT.WIDGET_TYPE;	    -- Root widget ID of our
					    -- application
    MAIN_WINDOW_WIDGET: DWT.WIDGET_TYPE;    -- Root widget ID of our
					    -- main DRM fetch

    DRM_HIERARCHY: DWT.DRM_HIERARCHY_TYPE;  -- Hierarchy ID

    WIDGET_ARRAY: array (WIDGET_NAMES_TYPE)
	of DWT.WIDGET_TYPE :=		    -- Place to keep all other
	(OTHERS => SYSTEM.ADDRESS_ZERO);    -- widget IDs

    subtype MATRIX_AMOUNT is INTEGER range 1..64*64;
    MATRIX_ARRAY:   DWT.WIDGET_ARRAY_TYPE (MATRIX_AMOUNT):=	-- Push buttons matrix
	(OTHERS => SYSTEM.ADDRESS_ZERO);

    MATRIX_WIDTH    :	INTEGER;
    MATRIX_LENGTH   :	INTEGER;
    WIDGET_COUNT    :	INTEGER;


    EXIT_APPLICATION: exception;	    -- Raised when application
					    -- is to be terminated

    -- Routine declarations
    --
    procedure S_ERROR (			    -- Prints error message and
	MESSAGE: in STRING);		    -- exits application

    procedure GET_INTEGER (		    -- Gets an integer attribute
	W: in DWT.WIDGET_TYPE;
	RESOURCE: in STRING;
	VALUE: out INTEGER);

    procedure GET_CSTRING (		    -- Gets a compound string attribute
	W: in DWT.WIDGET_TYPE;
	RESOURCE: in STRING;
	VALUE: out DWT.COMP_STRING_TYPE);

    procedure SET_INTEGER (		    -- Sets an integer attribute
	W: in DWT.WIDGET_TYPE;
	RESOURCE: in STRING;
	VALUE: in INTEGER);
    
    procedure SET_CSTRING (		    -- Sets a compound string attribute
	W: in DWT.WIDGET_TYPE;
	RESOURCE: in STRING;
	VALUE: in DWT.COMP_STRING_TYPE);
    
    procedure SET_WIDGET (		    -- Sets a widget attribute
	W: in DWT.WIDGET_TYPE;
	RESOURCE: in STRING;
	VALUE: in DWT.WIDGET_TYPE);
    
    procedure CREATE_MATRIX;

    procedure DESTROY_MATRIX;

    procedure ACTIVATE_PROC (		    -- Push button routine
	W: in DWT.WIDGET_TYPE;
	TAG: in WIDGET_NAMES_TYPE;
	REASON: in INTEGER);
    pragma EXPORT_PROCEDURE (ACTIVATE_PROC);
    ACTIVATE_PROC_NAME: constant STRING := "activate_proc"&ASCII.NUL;

    procedure SCALE_PROC (		    -- Burger quantity scale routine
	W: in DWT.WIDGET_TYPE;
	TAG: in WIDGET_NAMES_TYPE;
	SCALE: in DWT.SCALE_CB_ST_TYPE);
    pragma EXPORT_PROCEDURE (SCALE_PROC);
    SCALE_PROC_NAME: constant STRING := "scale_proc"&ASCII.NUL;

    procedure CREATE_PROC (		    -- Create widget routine
	W: in DWT.WIDGET_TYPE;
	TAG: in WIDGET_NAMES_TYPE;
	REASON: in INTEGER);
    pragma EXPORT_PROCEDURE (CREATE_PROC);
    CREATE_PROC_NAME: constant STRING := "create_proc"&ASCII.NUL;

    procedure PULL_PROC (		    -- Pulldown menu routine
	W: in DWT.WIDGET_TYPE;
	TAG: in WIDGET_NAMES_TYPE;
	REASON: in INTEGER);
    pragma EXPORT_PROCEDURE (PULL_PROC);
    PULL_PROC_NAME: constant STRING := "pull_proc"&ASCII.NUL;
	
end DIGITAL_PKG;




with DWT, STARLET, DIGITAL_PKG, SYSTEM;
use DIGITAL_PKG, SYSTEM;
procedure DIGITAL is

    --  Descriptor for hierarchy file name
    --
    HIERARCHY_FILE_NAME: constant STRING := "DIGITAL.UID";
    HIERARCHY_FILE_DESCR: DWT.DESCRIPTOR_TYPE :=
	(LENGTH  => HIERARCHY_FILE_NAME'LENGTH,
	 POINTER => HIERARCHY_FILE_NAME'ADDRESS,
	 CLASS   => STARLET.DSC_K_CLASS_S,
	 DTYPE   => STARLET.DSC_K_DTYPE_T);

    HIERARCHY_FILE_LIST: DWT.ADDRESS_ARRAY (0..0) :=
	(0 => HIERARCHY_FILE_DESCR'ADDRESS);


    -- Argument list for registering callback routines.  The names
    -- do not have to be in order.
    --
    DRM_REGISTER_LIST: DWT.DRMREG_ARG_ARRAY_TYPE (0..3) :=
	(0 => (DRMR_NAME  => ACTIVATE_PROC_NAME'ADDRESS,
	       DRMR_VALUE => ACTIVATE_PROC'ADDRESS),
	 1 => (DRMR_NAME  => PULL_PROC_NAME'ADDRESS,
	       DRMR_VALUE => PULL_PROC'ADDRESS),
	 2 => (DRMR_NAME  => SCALE_PROC_NAME'ADDRESS,
	       DRMR_VALUE => SCALE_PROC'ADDRESS),
	 3 => (DRMR_NAME  => CREATE_PROC_NAME'ADDRESS,
	       DRMR_VALUE => CREATE_PROC'ADDRESS));

    -- Arguments required by initialization calls
    --
    ARGC    : DWT.CARDINAL_TYPE:= 0;
    ARGV    : DWT.ADDRESS_ARRAY (0..0);
    OPTIONS : SYSTEM.UNSIGNED_LONGWORD_ARRAY (0..0);
    CLASS   : DWT.DRM_TYPE_TYPE;

    OPEN_STATUS, 
    REGISTER_STATUS, 
    FETCH_STATUS	: DWT.CARDINAL_TYPE;
    
begin
    -- Initialize the DRM
    --
    DWT.INITIALIZE_DRM;

    -- If we had user-defined widgets, we would register them with
    -- the DRM here.
    --

    -- Initialize the X Toolkit.  We get back a top-level shell widget.
    --
    DWT.XT_INITIALIZE (
	WIDGET	    => TOPLEVEL_WIDGET,
	NAME	    => "Welcome to DIGITAL",	-- Main window banner text
	CLASS_NAME  => "example",		-- Root class name
	URLIST	    => OPTIONS,			-- Not used
	NUM_URLIST  => 0,			-- Not used
	ARGCOUNT    => ARGC,			-- Required and writeable
	ARGVALUE    => ARGV);			-- Required but not used


    -- Open the hierarchy file
    --
    DWT.OPEN_HIERARCHY (
	STATUS	    => OPEN_STATUS,		-- Status of operation
	NUM_FILES   => HIERARCHY_FILE_LIST'LENGTH, -- Number of files
	FILE_NAMES_LIST => HIERARCHY_FILE_LIST,	-- File names
	HIERARCHY_ID_RETURN => DRM_HIERARCHY);	-- Opened hierarchy ID
    if OPEN_STATUS /= DWT.C_DRM_SUCCESS then
	S_ERROR ("Can't open hierarchy");
    end if;

    -- Register the items DRM needs to bind for us
    --
    DWT.REGISTER_DRM_NAMES (
	STATUS	       => REGISTER_STATUS,	-- Status of operation
	REGISTER_LIST  => DRM_REGISTER_LIST,	-- List of items
	REGISTER_COUNT => DRM_REGISTER_LIST'LENGTH); -- Number of items
    if REGISTER_STATUS /= DWT.C_DRM_SUCCESS then
	S_ERROR ("Can't register callbacks");
    end if;

    -- Get the main part of the application
    --
    DWT.FETCH_WIDGET (
	STATUS		=> FETCH_STATUS,	-- Status of operation
	HIERARCHY_ID	=> DRM_HIERARCHY,	-- Hierarchy to fetch from
	INDEX		=> "DIGITAL_MAIN_WINDOW",	-- Name of widget to fetch
	PARENT		=> TOPLEVEL_WIDGET,	-- Parent widget
	W_RETURN	=> MAIN_WINDOW_WIDGET,	-- Window widget
	CLASS_RETURN	=> CLASS);		-- Not used
    if FETCH_STATUS /= DWT.C_DRM_SUCCESS then
	S_ERROR ("Can't fetch main window");
    end if;

    -- Manage the main part and realize everything.  The interface
    -- comes up on the display now.
    --
    DWT.XT_MANAGE_CHILD (
	WIDGET => MAIN_WINDOW_WIDGET);
    DWT.XT_REALIZE_WIDGET (
	WIDGET => TOPLEVEL_WIDGET);

    -- Sit around forever waiting to process X-events.  We never leave
    -- XT_MAIN_LOOP.  From here on, we only execute our callback routines.
    -- The program is terminated by raising the EXIT_APPLICATION exception.
    --
    DWT.XT_MAIN_LOOP;
    
exception
    when EXIT_APPLICATION =>
	NULL;		    -- Leave the main block and exit the program
end DIGITAL;



with DWT, SYSTEM;
package body DIGITAL_PKG is

-- Routines, declared separate for clarity.
--
    procedure S_ERROR (
	MESSAGE: in STRING) is separate;

    procedure GET_INTEGER (
	W: in DWT.WIDGET_TYPE;
	RESOURCE: in STRING;
	VALUE: out INTEGER) is separate;

    procedure GET_CSTRING (
	W: in DWT.WIDGET_TYPE;
	RESOURCE: in STRING;
	VALUE: out DWT.COMP_STRING_TYPE) is separate;

    procedure SET_INTEGER (
	W: in DWT.WIDGET_TYPE;
	RESOURCE: in STRING;
	VALUE: in INTEGER) is separate;
    
    procedure SET_CSTRING (
	W: in DWT.WIDGET_TYPE;
	RESOURCE: in STRING;
	VALUE: in DWT.COMP_STRING_TYPE) is separate;
    
    procedure SET_WIDGET (
	W: in DWT.WIDGET_TYPE;
	RESOURCE: in STRING;
	VALUE: in DWT.WIDGET_TYPE) is separate;
    
    procedure CREATE_MATRIX is separate;

    procedure DESTROY_MATRIX is separate;

    procedure ACTIVATE_PROC (
	W: in DWT.WIDGET_TYPE;
	TAG: in WIDGET_NAMES_TYPE;
	REASON: in INTEGER) is separate;

    procedure SCALE_PROC (
	W: in DWT.WIDGET_TYPE;
	TAG: in WIDGET_NAMES_TYPE;
	SCALE: in DWT.SCALE_CB_ST_TYPE) is separate;

    procedure CREATE_PROC (
	W: in DWT.WIDGET_TYPE;
	TAG: in WIDGET_NAMES_TYPE;
	REASON: in INTEGER) is separate;

    procedure PULL_PROC (
	W: in DWT.WIDGET_TYPE;
	TAG: in WIDGET_NAMES_TYPE;
	REASON: in INTEGER) is separate;

end DIGITAL_PKG;


-- Routine to print an error message and terminate the program
-- 
with TEXT_IO;
separate (DIGITAL_PKG)
procedure S_ERROR (
    MESSAGE: in STRING) is 
begin
    TEXT_IO.PUT_LINE (MESSAGE);
    raise EXIT_APPLICATION;
end S_ERROR;


-- Simplified GET_VALUE routine to use only when fetching a single
-- attribute.  If we need to fetch more than one, all new values
-- should be put into one arglist and we should make one XT_GET_VALUES
-- call (which is more efficient).  We have two versions, one for integers,
-- one for compound strings.
--
with DWT;
separate (DIGITAL_PKG)
procedure GET_INTEGER (
    W: in DWT.WIDGET_TYPE;
    RESOURCE: in STRING;
    VALUE: out INTEGER) is
ARG_LIST: DWT.ARG_ARRAY_TYPE (0..0);
LCL_VALUE: INTEGER;
begin
    DWT.VMS_SET_ARG (
	ARG	=> LCL_VALUE'ADDRESS,
	ARGLIST => ARG_LIST,
	ARGNUMBER => ARG_LIST'FIRST,
	ARGNAME	=> RESOURCE);
    DWT.XT_GET_VALUES (
	WIDGET	=> W,
	ARGLIST	=> ARG_LIST,
	ARGCOUNT => ARG_LIST'LENGTH);
    VALUE := LCL_VALUE;
end GET_INTEGER;



with DWT,SYSTEM;
separate (DIGITAL_PKG)
procedure GET_CSTRING (
    W: in DWT.WIDGET_TYPE;
    RESOURCE: in STRING;
    VALUE: out DWT.COMP_STRING_TYPE) is
ARG_LIST: DWT.ARG_ARRAY_TYPE (0..0);
LCL_VALUE: DWT.COMP_STRING_TYPE;
begin
    DWT.VMS_SET_ARG (
	ARG	=> LCL_VALUE'ADDRESS,
	ARGLIST => ARG_LIST,
	ARGNUMBER => ARG_LIST'FIRST,
	ARGNAME	=> RESOURCE);
    DWT.XT_GET_VALUES (
	WIDGET	=> W,
	ARGLIST	=> ARG_LIST,
	ARGCOUNT => ARG_LIST'LENGTH);
    VALUE := LCL_VALUE;
end GET_CSTRING;



-- Simplified SET_VALUE routine to use only when changing a single
-- attribute.  If we need to change more than one, all new values
-- should be put into one arglist and we should make one XT_SET_VALUES
-- call (which is more efficient).  We have three versions, one for integers,
-- one for compound strings, one for widgets.
--
with DWT;
separate (DIGITAL_PKG)
procedure SET_INTEGER (
    W: in DWT.WIDGET_TYPE;
    RESOURCE: in STRING;
    VALUE: in INTEGER) is
ARG_LIST: DWT.ARG_ARRAY_TYPE (0..0);
begin
    DWT.VMS_SET_ARG (
	ARG	=> VALUE,
	ARGLIST => ARG_LIST,
	ARGNUMBER => ARG_LIST'FIRST,
	ARGNAME	=> RESOURCE);
    DWT.XT_SET_VALUES (
	WIDGET	=> W,
	ARGLIST	=> ARG_LIST,
	ARGCOUNT => ARG_LIST'LENGTH);
end SET_INTEGER;



with DWT,SYSTEM;
separate (DIGITAL_PKG)
procedure SET_CSTRING (
    W: in DWT.WIDGET_TYPE;
    RESOURCE: in STRING;
    VALUE: in DWT.COMP_STRING_TYPE) is
ARG_LIST: DWT.ARG_ARRAY_TYPE (0..0);
begin
    DWT.VMS_SET_ARG (
	ARG	=> VALUE,
	ARGLIST => ARG_LIST,
	ARGNUMBER => ARG_LIST'FIRST,
	ARGNAME	=> RESOURCE);
    DWT.XT_SET_VALUES (
	WIDGET	=> W,
	ARGLIST	=> ARG_LIST,
	ARGCOUNT => ARG_LIST'LENGTH);
end SET_CSTRING;



with DWT,SYSTEM;
separate (DIGITAL_PKG)
procedure SET_WIDGET (
    W: in DWT.WIDGET_TYPE;
    RESOURCE: in STRING;
    VALUE: in DWT.WIDGET_TYPE) is
ARG_LIST: DWT.ARG_ARRAY_TYPE (0..0);
begin
    DWT.VMS_SET_ARG (
	ARG	=> VALUE,
	ARGLIST => ARG_LIST,
	ARGNUMBER => ARG_LIST'FIRST,
	ARGNAME	=> RESOURCE);
    DWT.XT_SET_VALUES (
	WIDGET	=> W,
	ARGLIST	=> ARG_LIST,
	ARGCOUNT => ARG_LIST'LENGTH);
end SET_WIDGET;


-- This procedure creates a pop dialog box in a fixed size which contains a matrix of push buttons.
-- The size of the matrix is set according to the user's selection .

with X,DWT,SYSTEM;
separate (DIGITAL_PKG)
procedure CREATE_MATRIX is

PUSH_BUTTON_WIDTH   :	INTEGER;
PUSH_BUTTON_LENGTH  :	INTEGER;

ARG_ARRAY	    :	DWT.ARG_ARRAY_TYPE(0..20);

TOP_ATTACH	    :	INTEGER;
LEFT_ATTACH	    :	INTEGER;


begin

-- Creating the dialog box .
    
    DWT.VMS_SET_ARG(
	ARG	    =>	DWT.C_PIXEL_UNITS,
	ARGLIST	    =>	ARG_ARRAY,
	ARGNUMBER   =>	0,
	ARGNAME	    =>	DWT.C_NUNITS);	

    DWT.VMS_SET_ARG(
	ARG	    =>	1000,
	ARGLIST	    =>	ARG_ARRAY,
	ARGNUMBER   =>	1,
	ARGNAME	    =>	DWT.C_NWIDTH);	

    DWT.VMS_SET_ARG(
	ARG	    =>	600,
	ARGLIST	    =>	ARG_ARRAY,
	ARGNUMBER   =>	2,
	ARGNAME	    =>	DWT.C_NHEIGHT);	

    DWT.DIALOG_BOX_POPUP_CREATE(
	WIDGET		    =>	WIDGET_ARRAY(MATRIX_BOX),
	PARENT_WIDGET	    =>	TOPLEVEL_WIDGET,
	NAME		    =>	"Matrix Box",
	OVERRIDE_ARGLIST    =>	ARG_ARRAY,
	OVERRIDE_ARGCOUNT   =>	3);	

-- Setting more attributes to the dialog box.
    
    DWT.VMS_SET_ARG(
	ARG	    =>  200,
	ARGLIST	    =>	ARG_ARRAY,
	ARGNUMBER   =>	0,
	ARGNAME	    =>	DWT.C_NY);

    DWT.VMS_SET_ARG(
	ARG	    =>	DWT.C_FALSE,
	ARGLIST	    =>	ARG_ARRAY,
	ARGNUMBER   =>	1,
	ARGNAME	    =>	DWT.C_NNO_RESIZE);	

    DWT.XT_SET_VALUES(
	WIDGET	    =>	WIDGET_ARRAY(MATRIX_BOX),
	ARGLIST	    =>	ARG_ARRAY,
	ARGCOUNT    =>	2);


    -- Building the matrix which will be place in the dialog box .

    PUSH_BUTTON_WIDTH  := ( 1000 / MATRIX_WIDTH  );
    PUSH_BUTTON_LENGTH := (  600 / MATRIX_LENGTH );

    -- Setting the fixed attributes which are the same to all the push buttons .

    DWT.VMS_SET_ARG(
	ARG	    =>  PUSH_BUTTON_WIDTH,
	ARGLIST	    =>	ARG_ARRAY,
	ARGNUMBER   =>	0,
	ARGNAME	    =>	DWT.C_NWIDTH);

    DWT.VMS_SET_ARG(
	ARG	    =>  PUSH_BUTTON_LENGTH,
	ARGLIST	    =>	ARG_ARRAY,
	ARGNUMBER   =>	1,
	ARGNAME	    =>	DWT.C_NHEIGHT);

    DWT.VMS_SET_ARG(
	ARG	    =>  DWT.C_FALSE,
	ARGLIST	    =>	ARG_ARRAY,
	ARGNUMBER   =>	2,
	ARGNAME	    =>	DWT.C_NSHADOW);

    DWT.VMS_SET_ARG(
	ARG	    =>  3,
	ARGLIST	    =>	ARG_ARRAY,
	ARGNUMBER   =>	3,
	ARGNAME	    =>	DWT.C_NBORDER_WIDTH);


    WIDGET_COUNT := 1;

    TOP_ATTACH   := 1;


    -- Creating the matrix in a loop

    for I in 1..MATRIX_LENGTH loop

	LEFT_ATTACH  := 1;

	for J in 1..MATRIX_WIDTH loop

	    DWT.PUSH_BUTTON_CREATE(
		WIDGET		    =>	MATRIX_ARRAY(WIDGET_COUNT),
		PARENT_WIDGET	    =>	WIDGET_ARRAY(MATRIX_BOX),
		NAME		    =>	INTEGER'image(WIDGET_COUNT),
		OVERRIDE_ARGLIST    =>	ARG_ARRAY,
		OVERRIDE_ARGCOUNT   =>	0);


	    -- Setting more attributes which are different for each push button

	    DWT.VMS_SET_ARG(
		ARG	    =>  LEFT_ATTACH,
		ARGLIST	    =>	ARG_ARRAY,
		ARGNUMBER   =>	4,
		ARGNAME	    =>	DWT.C_NX);


	    DWT.VMS_SET_ARG(
		ARG	    =>  TOP_ATTACH,
		ARGLIST	    =>	ARG_ARRAY,
		ARGNUMBER   =>	5,
		ARGNAME	    =>	DWT.C_NY);

	    DWT.XT_SET_VALUES(
		WIDGET	    =>	MATRIX_ARRAY(WIDGET_COUNT),
		ARGLIST	    =>	ARG_ARRAY,
		ARGCOUNT    =>	6);


	    WIDGET_COUNT := WIDGET_COUNT + 1;
	    LEFT_ATTACH  := LEFT_ATTACH  + PUSH_BUTTON_WIDTH;

	end loop;

	TOP_ATTACH   := TOP_ATTACH   + PUSH_BUTTON_LENGTH;

    end loop;


    -- Managing all the matrix in a single call

    DWT.XT_MANAGE_CHILDREN(
	WIDGET_LIST	=>  MATRIX_ARRAY,
	NUM_CHILDREN	=>  DWT.CARDINAL_TYPE(WIDGET_COUNT- 1));

    -- Managing the dialog box .

    DWT.XT_MANAGE_CHILD(
	WIDGET	    =>	WIDGET_ARRAY(MATRIX_BOX));


end CREATE_MATRIX;


-- This procedure is used to reset the matrix . I.E., unmanage all the children and destroy the dialog box .

with DWT,SYSTEM;
separate (DIGITAL_PKG)
procedure DESTROY_MATRIX is

begin
    
    DWT.XT_UNMANAGE_CHILDREN(
	WIDGET_LIST	=>  MATRIX_ARRAY,
	NUM_CHILDREN	=>  DWT.CARDINAL_TYPE(WIDGET_COUNT- 1));

    DWT.XT_DESTROY_WIDGET(
	WIDGET		=>  WIDGET_ARRAY(MATRIX_BOX));

end DESTROY_MATRIX;


-- Routine called by all push buttons.  We use the tag to tell us
-- which widget it is, then react accordingly.
--
with DWT,SYSTEM;
use SYSTEM;
separate (DIGITAL_PKG)
procedure ACTIVATE_PROC (
    W: in DWT.WIDGET_TYPE;
    TAG: in WIDGET_NAMES_TYPE;
    REASON: in INTEGER) is

    MANAGE_STATUS   :	BOOLEAN;
    CLASS	    :	DWT.DRM_TYPE_TYPE;
    STATUS	    :	DWT.CARDINAL_TYPE;

begin

    -- Select action based on widget name
    --
    case TAG is

	when RESET_OPTION =>
		DESTROY_MATRIX;

	when EXIT_OPTION =>
	    raise EXIT_APPLICATION;

	when APPLY_MATRIX =>
		CREATE_MATRIX;

	when OTHERS =>

	    null;
    
    end case;

end ACTIVATE_PROC;



with DWT;
separate (DIGITAL_PKG)
procedure SCALE_PROC (
    W: in DWT.WIDGET_TYPE;
    TAG: in WIDGET_NAMES_TYPE;
    SCALE: in DWT.SCALE_CB_ST_TYPE) is
begin
    case TAG is
	when LENGTH_SCALE =>
	    MATRIX_LENGTH := SCALE.SC_VALUE;

	when WIDTH_SCALE =>
	    MATRIX_WIDTH  := SCALE.SC_VALUE;

	when OTHERS =>
	    null;

	end case;

	
end SCALE_PROC;


with DWT;
separate (DIGITAL_PKG)
procedure CREATE_PROC (
    W: in DWT.WIDGET_TYPE;
    TAG: in WIDGET_NAMES_TYPE;
    REASON: in INTEGER) is

begin
    WIDGET_ARRAY(TAG) := W;
end CREATE_PROC;


-- This routine is called just as a pulldown menu is about to be pulled
-- down.  It fetches the menu if it is currently empty, and does other
-- special processing as required.
-- 
with DWT, SYSTEM;
use SYSTEM;
separate (DIGITAL_PKG)
procedure PULL_PROC (		    -- Pulldown menu routine
    W: in DWT.WIDGET_TYPE;
    TAG: in WIDGET_NAMES_TYPE;
    REASON: in INTEGER) is

    FETCH_STATUS: DWT.CARDINAL_TYPE;
    CLASS: DWT.DRM_TYPE_TYPE;
    IS_MANAGED: BOOLEAN;

begin
    case TAG is
	when FILE_PDME =>
	    if WIDGET_ARRAY(FILE_MENU) = SYSTEM.ADDRESS_ZERO then
		DWT.FETCH_WIDGET (FETCH_STATUS, DRM_HIERARCHY,
		    "FILE_MENU", WIDGET_ARRAY(MENU_BAR),
		    WIDGET_ARRAY(FILE_MENU), CLASS);
		if FETCH_STATUS /= DWT.C_DRM_SUCCESS then
		    S_ERROR ("Can't fetch file pulldown menu widget");
		end if;
		SET_WIDGET (WIDGET_ARRAY(FILE_PDME), DWT.C_NSUB_MENU_ID,
		    WIDGET_ARRAY(FILE_MENU));
	    end if;

	when OTHERS =>
	    NULL;
    end case;

end PULL_PROC;

************ DEMO Program's  UIL File: *********************************

module digital
	version	=	'v1.0'
	names	=	case_sensitive
	objects	=	{
				separator	=	gadget;
				label		=	gadget;
				push_button	=	gadget;
			}

include file 'DwtAppl.uil';

procedure
	activate_proc	(integer);
	scale_proc	(integer);
	pull_proc	(integer);
	create_proc	(integer);

value
	tl_file_menu_option	:	compound_string("File");
value
	tl_reset_option		:	compound_string("Reset");
	tl_exit_option		:	compound_string("Exit");
value
	tl_width_scale		:	compound_string("Width");
	tl_length_scale		:	compound_string("Length");
	tl_apply_button		:	compound_string("Apply");

value
	p_file_pdme		:	1;
	p_reset_option		:	2;
	p_exit_option		:	3;
	p_length_scale		:	4;
	p_width_scale		:	5;
	p_apply			:	6;
	p_menu_bar		:	7;
	p_file_menu		:	8;
	p_dialog_box		:	9;
	p_matrix		:	10;

value
	red			:	color('red',foreground);
	blue			:	color('blue',foreground);
	black			:	color('black',foreground);
	lightblue		:	color('lightblue',background);

value
	adb_top_attachment	:	argument('adbTopAttachment',integer);
	adb_top_offset		:	argument('adbTopOffset',integer);
	adb_top_widget		:	argument('adbTopWidget',any);
	adb_bottom_attachment	:	argument('adbBottomAttachment',integer);
	adb_left_widget		:	argument('adbLeftWidget',any);
	adb_left_attachment	:	argument('adbLeftAttachment',integer);
	adb_left_offset		:	argument('adbLeftOffset',integer);
	adb_right_attachment	:	argument('adbRightAttachment',integer);
	adb_right_offset	:	argument('adbRightOffset',integer);

object
	DIGITAL_MAIN_WINDOW	:	main_window	{
		arguments	{
			x	=	10;
			y	=	20;
			width	=	0;
			height	=	0;
				};
		controls	{
			menu_bar		DIGITAL_MENU_BAR;
			attached_dialog_box	DIGITAL_DIALOG_BOX;
				};
							};

object
	DIGITAL_MENU_BAR		:	menu_bar	{
		arguments	{
			orientation	=	DwtOrientationHorizontal;
				};
		controls	{
			pulldown_entry	FILE_MENU_ENTRY;
				};
		callbacks	{
			create =	procedure create_proc(p_menu_bar);
				};
							};

object
	FILE_MENU_ENTRY		:	pulldown_entry	{
		arguments	{
			label_label	=	tl_file_menu_option;
				};
		controls	{
			pulldown_menu	FILE_MENU;
				};
		callbacks	{
			create =	procedure create_proc(p_file_pdme);
			pulling =	procedure pull_proc(p_file_pdme);
				};
							};

object
	FILE_MENU		:	pulldown_menu	{
		controls	{
			push_button	RESET_OPTION;
			separator	{};
			push_button	EXIT_OPTION;
				};
		callbacks	{
			create =	procedure create_proc(p_file_menu);
				};
							};

object
	RESET_OPTION		:	push_button	{
		arguments	{
			label_label	=	tl_reset_option;
				};
		callbacks	{
			create =	procedure create_proc(p_reset_option);
			activate =	procedure activate_proc(p_reset_option);
				};
							};

object
	EXIT_OPTION		:	push_button	{
		arguments	{
			label_label	=	tl_exit_option;
				};
		callbacks	{
			create =	procedure create_proc(p_exit_option);
			activate =	procedure activate_proc(p_exit_option);
				};
							};

object	
	DIGITAL_DIALOG_BOX		:	attached_dialog_box	{
		arguments	{
				};
		controls	{
			scale			WIDTH_MATRIX_SCALE;
			scale			LENGTH_MATRIX_SCALE;
			push_button		APPLY_MATRIX_PUSH_BUTTON;
				};
		callbacks	{
			create =	procedure create_proc(p_dialog_box);
				};
							};


object
	WIDTH_MATRIX_SCALE	:	scale	{
		arguments	{
			adb_top_attachment
					=	DwtAttachAdb;
			adb_left_attachment
					=	DwtAttachAdb;
			min_value	=	1;
			max_value	=	64;
			title		=	tl_width_scale;
			border_color	=	red;
			slider_color	=	black;		
				};
		callbacks	{
			create =	procedure create_proc(p_width_scale);
			value_changed =		
				procedure scale_proc(p_width_scale);
				};
						};

object
	LENGTH_MATRIX_SCALE	:	scale	{
		arguments	{
			adb_left_attachment 
					=	DwtAttachAdb;
			adb_top_attachment
					=	DwtAttachWidget;
			adb_top_widget	=	scale WIDTH_MATRIX_SCALE;
			adb_top_offset	=	5;
			min_value	=	1;
			max_value	=	64;
			title		=	tl_length_scale;
			border_color	=	red;
			slider_color	=	black;		
				};
		callbacks	{
			create =	procedure create_proc(p_length_scale);
			value_changed =		
				procedure scale_proc(p_length_scale);
				};
						};


object
	APPLY_MATRIX_PUSH_BUTTON	:	push_button widget	{
		arguments	{
			adb_left_attachment 
					=	DwtAttachWidget;
			adb_left_widget	=	scale LENGTH_MATRIX_SCALE;
			adb_left_offset	=	30;
			adb_bottom_attachment
					=	DwtAttachAdb;
			label_label	=	tl_apply_button;
			foreground_color=	red;
				};
		callbacks	{
			create =	procedure create_proc(p_apply);
			activate =	procedure activate_proc(p_apply);
				};
									};


end module;

**************************************************************************

		Thanks in advance
		Ofer Gan, ISO

	You might be interested in the Matrixlist widget.
	See note 221 in ELKTRA::DW_EXAMPLES.

Are happy to handle lots of windows (particularly the R4 server).

There was some rumor that at least the window code from the MIT server was
going to make it into the VMS server.  Any developer out there care to
confirm or deny said rumor?

I tend to agree with the idea that a 40x30 array of windows (widgets) is
beginning to push things, but only just....
				- Jim