[Search for users]
[Overall Top Noters]
[List of all Conferences]
[Download this site]
| Title: | DECWINDOWS 26-JAN-89 to 29-NOV-90 |
| Notice: | See 1639.0 for VMS V5.3 kit; 2043.0 for 5.4 IFT kit |
| Moderator: | STAR::VATNE |
|
| Created: | Mon Oct 30 1989 |
| Last Modified: | Mon Dec 31 1990 |
| Last Successful Update: | Fri Jun 06 1997 |
| Number of topics: | 3726 |
| Total number of notes: | 19516 |
781.0. "Ada and DECwindows problems" by 8899::DIX (I guess I do windows now...) Sun May 14 1989 17:36
I'm having some problems in the use of the change_property and/or the
get_window_property procedure calls for DECwindows from Ada. This note
will be posted in both the DECwindows conference and the Ada conference.
The following is a brief description of the problem I'm running into.
I've overloaded the change_property procedure to allow a record data
structure to be written to the property, but strange things are
happening (twighlight zone music please....) The record structure
consists of 2 elements, both of which are strings. If I initialize
the strings to some initial value (upon declaration of the record), then
change them before calling the change_property procedure, what I end up
with is the initial values that were assigned. If I don't give initial
values when I declare the record, then change the values before calling
the change_property procedure I get out the values that I changed them to.
This probably makes no sense at all, so I've included the code (such the
nice person I am) for anyone to take a look at. This is a baffling
problem, but I'm sure someone out there will be able to arrive at a
solution.
For those interested in attempting to run the program, you can select the
area starting with the --++ through the end of the file, write it out to
a file and compile it all at once. To link, the two main programs are
get_property and write_property. The write_property will bring up a
push button. The get_property procedure will create some output stating
what values were retrieved from the get_window_property call.
Thanks in advance for any help,
Sandy
--++
--
-- This first package contains the overloaded procedure for the change_property
-- call, the "more correct" version of the get_window_property procedure
-- call (there is a known problem with the Ada interface declaration), and
-- the declaration of the record structure.
--
--++
WITH x; USE x;
WITH system; USE system;
PACKAGE new_x IS
--
--=====================================================================
-- The first element has not been initialized in order to demonstrate
-- the problems I'm having. When the program is run, the values are
-- changed as this:
-- element_1(1) := 'A';
-- element_2(1) := 'B';
-- The results that get printed out when the property is retrieved
-- are:
-- element_1(1) => A
-- element_2(1) => 2
--=====================================================================
--
TYPE record_512_type IS
RECORD
element_1 : string(1..256);
element_2 : string(1..256) := (others => '2');
END RECORD;
--
--================================================================
-- There are some known problems with the Ada interface for the
-- GET_WINDOW_PROPERTY procedure call, this (to the best of my
-- knowledge) is a correct version of the procedure call.
--================================================================
--
procedure GET_WINDOW_PROPERTY (
RESULT : out INTEGER;
DISPLAY : in DISPLAY_TYPE;
WINDOW_ID : in WINDOW_ID_TYPE;
PROPERTY_ID : in PROPERTY_ID_TYPE;
LONG_OFFSET : in INTEGER;
LONG_LEN : in INTEGER;
DELETE : in UNSIGNED_LONGWORD;
REQUESTED_TYPE : in UNSIGNED_LONGWORD;
ACTUAL_TYPE_RETURN : out UNSIGNED_LONGWORD;
ACTUAL_FORMAT_RETURN : out INTEGER;
NUM_ITEMS_RETURN : out INTEGER;
BYTES_AFTER_RETURN : out INTEGER;
PROPERTY_DATA_RETURN : out ADDRESS;
PROPERTY_DATA_LEN : in INTEGER := INTEGER'NULL_PARAMETER;
PROPERTY_DATA_BUFF_RETURN : in UNSIGNED_LONGWORD_ARRAY :=
UNSIGNED_LONGWORD_ARRAY'NULL_PARAMETER;
NUM_ELEMENTS_RETURN : in INTEGER := INTEGER'NULL_PARAMETER );
pragma INTERFACE (EXTERNAL, GET_WINDOW_PROPERTY);
pragma IMPORT_VALUED_PROCEDURE
(GET_WINDOW_PROPERTY, "x$get_window_property",
(INTEGER, DISPLAY_TYPE, WINDOW_ID_TYPE, PROPERTY_ID_TYPE, INTEGER,
INTEGER, UNSIGNED_LONGWORD, UNSIGNED_LONGWORD, UNSIGNED_LONGWORD,
INTEGER, INTEGER, INTEGER, ADDRESS, INTEGER, UNSIGNED_LONGWORD_ARRAY,
INTEGER),
(VALUE, REFERENCE, REFERENCE, REFERENCE, REFERENCE, REFERENCE,
REFERENCE, REFERENCE, REFERENCE, REFERENCE, REFERENCE, REFERENCE,
REFERENCE, REFERENCE, REFERENCE, REFERENCE));
--
--======================================================================
-- The CHANGE_PROPERTY procedure call has been overloaded in order to
-- be able to write a record structure to the property for a specified
-- window.
--======================================================================
--
PROCEDURE CHANGE_PROPERTY(
DISPLAY : IN DISPLAY_TYPE;
WINDOW_ID : IN WINDOW_ID_TYPE;
PROPERTY_ID : IN PROPERTY_ID_TYPE;
TYPE_ID : IN TYPE_ID_TYPE;
FORMAT : IN INTEGER;
CHANGE_MODE : IN UNSIGNED_LONGWORD;
PROP_DATA : IN RECORD_512_TYPE;
NUM_ELEMENTS : IN INTEGER );
PRAGMA INTERFACE (EXTERNAL, CHANGE_PROPERTY);
PRAGMA IMPORT_PROCEDURE
(CHANGE_PROPERTY, "X$CHANGE_PROPERTY",
(DISPLAY_TYPE, WINDOW_ID_TYPE, PROPERTY_ID_TYPE, TYPE_ID_TYPE,
INTEGER, UNSIGNED_LONGWORD, RECORD_512_TYPE, INTEGER),
(REFERENCE, REFERENCE, REFERENCE, REFERENCE, REFERENCE, REFERENCE,
REFERENCE, REFERENCE));
end new_x;
--############################################################################--
--++
--
-- The client_procedures package contains the procedure to be executed durring
-- the callback of the write_property procedure.
--
--++
WITH dwt;
PACKAGE Client_Procedures IS
PROCEDURE Send_512_Record( WIDGET : IN dwt.widget_type;
TAG : IN INTEGER;
REASON : IN INTEGER );
--
--================================================
-- Export the procedure for use in the callbacks
--================================================
--
PRAGMA EXPORT_PROCEDURE( Send_512_Record );
END Client_Procedures;
WITH text_io;
WITH new_x;
WITH x;
WITH system;
WITH dwt;
PACKAGE BODY Client_Procedures IS
PROCEDURE Send_512_Record( WIDGET : IN dwt.widget_type;
TAG : IN INTEGER;
REASON : IN INTEGER ) IS
Test_Record : new_x.record_512_type;
Display : dwt.display_type;
Screen : system.unsigned_longword;
Root_Window : x.window_id_type;
Atom_512 : x.atom_id_type;
Num_Elements : integer;
BEGIN
--
--=============================================================
-- Get the display_id of the window in order to determine the
-- root window for which the property is to be changed
--=============================================================
--
dwt.xt_display( result => display,
widget => widget );
x.default_screen_of_display( result => screen,
display => display );
x.root_window_of_screen( result => Root_Window,
screen_id => screen );
--
--=================================================================
-- Use the atom name "atom_512" to identify the atom being changed
--=================================================================
--
x.intern_atom( result => atom_512,
display => display,
atom_name => "atom_512",
only_if_exists => false );
Num_Elements := new_x.record_512_type'size / 32;
--
--======================================================
-- Now change the values before changing the property
--======================================================
--
Test_Record.element_1(1) := 'A';
Test_Record.element_2(1) := 'B';
--
--==================================================================
-- The change property procedure is called, followed by a flush to
-- be sure the event is being handled by the server.
--==================================================================
--
new_x.change_property( display => display,
window_id => root_window,
property_id => atom_512,
type_id => x.c_xa_string,
format => 32,
change_mode => x.c_prop_mode_replace,
prop_data => Test_Record,
num_elements => Num_Elements );
x.flush( display => display );
END Send_512_Record;
END Client_Procedures;
--############################################################################--
--++
--
-- The get_property procedure handles the retrieval of the property and
-- conversion of the address back into the record structure
--
--++
with x;
with system;
with text_io;
with new_x;
procedure get_property is
display : x.display_type;
name_of_display : constant string := "DECW$DISPLAY";
screen : system.unsigned_longword;
depth : integer;
visual : x.visual_type := x.visual_type_init;
attribute_mask : x.window_masks_type := x.window_masks_type_init;
window_attributes : x.set_win_attributes_type :=
x.set_win_attributes_type_init;
window_height : constant system.unsigned_longword := 280;
window_width : constant system.unsigned_longword := 360;
window_x : constant integer := 25;
window_y : constant integer := 100;
root_window : x.window_id_type;
main_window : x.window_id_type;
event : x.event_type;
value : string(1..132);
length : natural;
status : integer;
ret_type : system.unsigned_longword;
ret_fmt_type : integer;
nitems : integer;
nremaining : integer;
data_string : system.address;
record_512_value : new_x.record_512_type;
atom_512 : x.atom_id_type;
--
--========================================================================
-- This procedure uses the address passed back by the get_window_property
-- procedure as the location for the data and returns the data at that
-- address.
--========================================================================
--
procedure address_to_record( location : in system.address;
value : out new_x.record_512_type ) is
rec_val : new_x.record_512_type;
for rec_val use at location;
begin
value := rec_val;
end address_to_record;
begin
x.open_display( result => display,
display_name => name_of_display );
x.default_screen_of_display( result => screen,
display => display );
x.default_depth_of_screen( result => depth,
screen_id => screen );
x.default_visual_of_screen( screen_id => screen,
visual_return => visual );
x.root_window_of_screen( result => root_window,
screen_id => screen );
--
--======================================================================
-- Use the same atom name as specified in the changing of the property
-- in order to retrieve the correct property.
--======================================================================
--
x.intern_atom( result => atom_512,
display => display,
atom_name => "atom_512",
only_if_exists => false );
x.create_window( result => main_window,
display => display,
parent_id => root_window,
x_coord => window_x,
y_coord => window_y,
width => window_width,
height => window_height,
border_width => 3,
depth => depth,
class => x.c_copy_from_parent,
visual_struc => visual,
attributes_mask => attribute_mask,
attributes => window_attributes );
--
--=====================================================================
-- Set up an interest in a property change event for the root window
--=====================================================================
--
attribute_mask.cw_event_mask := true;
window_attributes.swda_event_mask := x.m_property_change;
x.change_window_attributes( display => display,
window_id => root_window,
attributes_mask => attribute_mask,
attributes => window_attributes );
x.map_window( display => display,
window_id => main_window );
--
--======================================================================
-- Loop through retrieving events and getting the property if the event
-- is a property notify for the atom_512.
--======================================================================
--
loop
x.next_event( display => display,
event_return => event );
if event.evnt_type = x.c_property_notify then
if system."=" (event.ppev_atom, atom_512) then
NEW_X.GET_WINDOW_PROPERTY (
RESULT => status,
DISPLAY => Display,
WINDOW_ID => Root_Window,
PROPERTY_ID => atom_512,
LONG_OFFSET => 0,
LONG_LEN => 128,
DELETE => 0,
REQUESTED_TYPE => X.C_XA_STRING,
ACTUAL_TYPE_RETURN => Ret_Type,
ACTUAL_FORMAT_RETURN => Ret_Fmt_type,
NUM_ITEMS_RETURN => nitems,
BYTES_AFTER_RETURN => nremaining,
PROPERTY_DATA_RETURN => data_string );
--
--=======================================================
-- Convert the address returned into a record_512_type
--=======================================================
--
address_to_record( location => data_string,
value => record_512_value );
--
--============================================================
-- Write out what was received in order to determine if the
-- change_property and the get_property worked properly.
--============================================================
--
text_io.put_line("Element 1 => " & record_512_value.element_1(1) );
text_io.put_line("Element 2 => " & record_512_value.element_2(1) );
x.free( buff_ptr => data_string,
buff_len => 512 );
end if;
end if;
end loop;
end get_property;
--############################################################################--
--++
--
-- The write_property procedure creates a push button and uses callbacks to
-- execute the changing of the property.
--
--++
with x;
with dwt;
with system;
with text_io;
with client_procedures;
use client_procedures;
procedure write_property is
main_widget : dwt.widget_type;
top_level_widget : dwt.widget_type;
push_button_512 : dwt.widget_type;
top_level_name : constant string := "T";
button_512_name : constant string := "512 Button";
top_level_class : constant string := "C";
argument_count : dwt.cardinal_type := 0;
argument_list : dwt.arg_array_type( 0..5 ) :=
(others => dwt.arg_type_init);
comp_string : dwt.comp_string_type;
return_status : integer;
callback_arg_list : dwt.callback_array_type( 0..1 ) :=
( 0 =>
( callback_proc => send_512_record'address,
callback_tag => 0 ),
1 => dwt.callback_type_init );
begin
dwt.xt_initialize( widget => top_level_widget,
name => top_level_name,
class_name => top_level_class,
urlist =>
system.unsigned_longword_array'NULL_PARAMETER,
num_urlist => 0,
argcount => argument_count,
argvalue => dwt.address_array'NULL_PARAMETER );
dwt.vms_set_arg( arg => 340,
arglist => argument_list,
argnumber => 0,
argname => dwt.c_nx );
dwt.vms_set_arg( arg => 280,
arglist => argument_list,
argnumber => 1,
argname => dwt.c_ny );
dwt.vms_set_arg( arg => 1,
arglist => argument_list,
argnumber => 2,
argname => dwt.c_nallow_shell_resize );
--
--======================================================================
-- Set the values for the top_level_widget to specify the X/Y location
-- as well as allowing the shell to resize
--======================================================================
--
dwt.xt_set_values( widget => top_level_widget,
arglist => argument_list,
argcount => 3 );
dwt.dialog_box_create( widget => main_widget,
parent_widget => top_level_widget,
name => " ",
override_arglist =>
dwt.arg_array_type'null_parameter,
override_argcount => 0 );
dwt.xt_manage_child( widget => main_widget );
--
--=========================================================
-- Set up the callback array and create the push button
--=========================================================
--
dwt.vms_set_callback_arg( callback_arg => callback_arg_list,
arglist => argument_list,
argnum => 0,
argname => dwt.c_nactivate_callback );
dwt.push_button_create( widget => push_button_512,
parent_widget => main_widget,
name => button_512_name,
override_arglist => argument_list,
override_argcount => 1 );
dwt.xt_manage_child( widget => push_button_512 );
dwt.xt_realize_widget( widget => top_level_widget );
dwt.xt_main_loop;
end write_property;
| T.R | Title | User | Personal
Name | Date | Lines |
|---|
| 781.1 | Customer needs a response | 8899::DIX | I guess I do windows now... | Fri May 19 1989 17:19 | 9 |
|
One thing I forgot to mention in the first note is that the
use of X events and properties is a major design issue on a
very large project for a customer I'm working with. If I
don't get a response I'll assume the engineering people should
be notified via an SPR.
|
| 781.2 | | PSW::WINALSKI | Paul S. Winalski | Fri May 19 1989 21:42 | 6 |
| If it's a major and important problem, you should be escalating it through the
official support channels as well as looking for quick answers in notes
conferences.
--PSW
|
| 781.3 | Solution to the problem.... | 8899::DIX | I guess I do windows now... | Thu May 25 1989 10:33 | 64 |
|
For anyone wishing to know the solution to this dilema, it was
answered in the Ada notes conference and I shall place it here
as well....
<<< TURRIS::NOTE$:[NOTES$LIBRARY]ADA.NOTE;2 >>>
-< DIGITAL Ada >-
================================================================================
Note 1383.5 Ada and DECwindows problem 5 of 6
TLE::MORRIS 50 lines 24-MAY-1989 18:57
-< Be careful with address clauses >-
--------------------------------------------------------------------------------
Hi!
I'm pretty certain I know what the problem is. I believe the problem comes
about from the use of an address clause to overlay storage in the procedure
address_to_record.
From the LRM section 13.5:
An address clause specifies a required address in storage for an entity.
The code from package new_x:
TYPE record_512_type IS
RECORD
element_1 : string(1..256);
element_2 : string(1..256) := (others => '2');
END RECORD;
The code from procedure get_property:
procedure address_to_record( location : in system.address;
value : out new_x.record_512_type ) is
rec_val : new_x.record_512_type;
for rec_val use at location;
begin
value := rec_val;
end address_to_record;
The location passed in is used as the address for storage of rec_val as
the programmer intended, but remember THAT IS ALL THE ADDRESS CLAUSE DOES.
So just as if it was not present, the implicit initialization given in
the type declaration for the record new_x.record_512_type is then executed
writing over the data that the programmer was trying to fetch.
One way to avoid this problem would be to use the generic procedure
defined in system for fetching data given an address as follows:
procedure address_to_record( location : in system.address;
value : out new_x.record_512_type ) is
function fetch_record_512 is new
system.fetch_from_address (target => new_x.record_512_type);
begin
value := fetch_record_512(location);
end address_to_record;
I made this change and get_property seemed to function correctly.
Sorry I wasn't able to look at this sooner.
Greg
|