## wire-to-value.pkg
#
# Reppy code to localize exceptions
# thrown in wire_to_value_pith.
# Compiled by:
# src/lib/x-kit/xclient/xclient-internals.sublibstipulate
package fil = file__premicrothread; # file__premicrothread is from src/lib/std/src/posix/file--premicrothread.pkg package v8 = vector_of_one_byte_unts; # vector_of_one_byte_unts is from src/lib/std/src/vector-of-one-byte-unts.pkg package w2v = wire_to_value_pith; # wire_to_value_pith is from src/lib/x-kit/xclient/src/wire/wire-to-value-pith.pkg package xt = xtypes; # xtypes is from src/lib/x-kit/xclient/src/wire/xtypes.pkg package xtr = xlogger; # xlogger is from src/lib/x-kit/xclient/src/stuff/xlogger.pkg #
trace = xtr::log_if xtr::io_logging 0; # Conditionally write strings to tracing.log or whatever.
herein
package wire_to_value
: Wire_To_Value
{
Font_Query_Reply = { all_chars_exist: Bool,
char_infos: List(xt::Char_Info),
default_char: Int,
draw_dir: xt::Font_Drawing_Direction,
#
font_ascent: Int,
font_descent: Int,
#
max_bounds: xt::Char_Info,
min_bounds: xt::Char_Info,
#
max_byte1: Int,
min_byte1: Int,
#
min_char: Int,
max_char: Int,
#
properties: List(xt::Font_Prop)
};
# Convert "abc" -> "61.62.63." etc:
#
fun string_to_hex s
=
string::translate
(\\ c = number_string::pad_left '0' 2 (int::format number_string::HEX (char::to_int c)) + ".")
s;
# As above, starting with byte-vector:
#
fun bytes_to_hex bytes
=
string_to_hex (byte::unpack_string_vector(vector_slice_of_one_byte_unts::make_slice (bytes, 0, NULL)));
fun debug (f, s) x
=
{ trace {. sprintf "wire_to_value:%s: value x=%s (%d types) debug/TOP" s (bytes_to_hex x) (v8::length x); }; result =
(f x)
; trace {. sprintf "wire_to_value::%s: debug/BOT" s; }; result; }
except ex
=
{ fil::print (sprintf "wire_to_value::%s: Uncaught exception %s\n" s (exceptions::exception_name ex) );
#
raise exception ex;
};
fun debug' (f, s) x
=
{ trace {. sprintf "wire_to_value::%s: debug/TOP" s; }; result =
(f x)
; trace {. sprintf "wire_to_value::%s: debug/BOT" s; }; result; }
except ex
=
{ fil::print (sprintf "wire_to_value::%s: Uncaught exception %s\n" s (exceptions::exception_name ex) );
#
raise exception ex;
};
fun decode_connect_request_reply x = debug' (w2v::decode_connect_request_reply, "decode_connect_request_reply" ) x;
fun decode_xpacket x = debug' (w2v::decode_xpacket, "decode_xpacket" ) x;
fun decode_alloc_color_cells_reply x = debug' (w2v::decode_alloc_color_cells_reply, "decode_alloc_color_cells_reply" ) x;
fun decode_alloc_color_planes_reply x = debug' (w2v::decode_alloc_color_planes_reply, "decode_alloc_color_planes_reply" ) x;
fun decode_get_pointer_mapping_reply x = debug' (w2v::decode_get_pointer_mapping_reply, "decode_get_pointer_mapping_reply" ) x;
fun decode_list_extensions_reply x = debug' (w2v::decode_list_extensions_reply, "decode_list_extensions_reply" ) x;
fun decode_query_extension_reply x = debug' (w2v::decode_query_extension_reply, "decode_query_extension_reply" ) x;
fun decode_query_keymap_reply x = debug' (w2v::decode_query_keymap_reply, "decode_query_keymap_reply" ) x;
#
# For above fns arg 'x' type is not v8::Vector, so cannot use above debug() fn.
fun decode_alloc_color_reply x = debug (w2v::decode_alloc_color_reply, "decode_alloc_color_reply" ) x;
fun decode_alloc_named_color_reply x = debug (w2v::decode_alloc_named_color_reply, "decode_alloc_named_color_reply" ) x;
fun decode_error x = debug (w2v::decode_error, "decode_error" ) x;
fun decode_get_atom_name_reply x = debug (w2v::decode_get_atom_name_reply, "decode_get_atom_name_reply" ) x;
fun decode_get_font_path_reply x = debug (w2v::decode_get_font_path_reply, "decode_get_font_path_reply" ) x;
fun decode_get_geometry_reply x = debug (w2v::decode_get_geometry_reply, "decode_get_geometry_reply" ) x;
fun decode_get_image_reply x = debug (w2v::decode_get_image_reply, "decode_get_image_reply" ) x;
fun decode_get_input_focus_reply x = debug (w2v::decode_get_input_focus_reply, "decode_get_input_focus_reply" ) x;
fun decode_get_keyboard_control_reply x = debug (w2v::decode_get_keyboard_control_reply, "decode_get_keyboard_control_reply" ) x;
fun decode_get_keyboard_mapping_reply x = debug (w2v::decode_get_keyboard_mapping_reply, "decode_get_keyboard_mapping_reply" ) x;
fun decode_get_modifier_mapping_reply x = debug (w2v::decode_get_modifier_mapping_reply, "decode_get_modifier_mapping_reply" ) x;
fun decode_get_motion_events_reply x = debug (w2v::decode_get_motion_events_reply, "decode_get_motion_events_reply" ) x;
fun decode_get_pointer_control_reply x = debug (w2v::decode_get_pointer_control_reply, "decode_get_pointer_control_reply" ) x;
fun decode_get_property_reply x = debug (w2v::decode_get_property_reply, "decode_get_property_reply" ) x;
fun decode_get_screen_saver_reply x = debug (w2v::decode_get_screen_saver_reply, "decode_get_screen_saver_reply" ) x;
fun decode_get_selection_owner_reply x = debug (w2v::decode_get_selection_owner_reply, "decode_get_selection_owner_reply" ) x;
fun decode_get_window_attributes_reply x = debug (w2v::decode_get_window_attributes_reply, "decode_get_window_attributes_peply" ) x;
fun decode_grab_keyboard_reply x = debug (w2v::decode_grab_keyboard_reply, "decode_grab_keyboard_reply" ) x;
fun decode_grab_pointer_reply x = debug (w2v::decode_grab_pointer_reply, "decode_grab_pointer_reply" ) x;
fun decode_graphics_expose x = debug (w2v::decode_graphics_expose, "decode_graphics_expose" ) x;
fun decode_intern_atom_reply x = debug (w2v::decode_intern_atom_reply, "decode_intern_atom_reply" ) x;
fun decode_list_fonts_reply x = debug (w2v::decode_list_fonts_reply, "decode_list_fonts_reply" ) x;
fun decode_list_hosts_reply x = debug (w2v::decode_list_hosts_reply, "decode_list_hosts_reply" ) x;
fun decode_list_installed_colormaps_reply x = debug (w2v::decode_list_installed_colormaps_reply, "decode_list_installed_colormaps_reply" ) x;
fun decode_list_properties_reply x = debug (w2v::decode_list_properties_reply, "decode_list_properties_reply" ) x;
fun decode_lookup_color_reply x = debug (w2v::decode_lookup_color_reply, "decode_lookup_color_reply" ) x;
fun decode_no_expose x = debug (w2v::decode_no_expose, "decode_no_expose" ) x;
fun decode_query_best_size_reply x = debug (w2v::decode_query_best_size_reply, "decode_query_best_size_reply" ) x;
fun decode_query_colors_reply x = debug (w2v::decode_query_colors_reply, "decode_query_colors_reply" ) x;
fun decode_query_font_reply x = debug (w2v::decode_query_font_reply, "decode_query_font_reply" ) x;
fun decode_query_pointer_reply x = debug (w2v::decode_query_pointer_reply, "decode_query_pointer_reply" ) x;
fun decode_query_text_extents_reply x = debug (w2v::decode_query_text_extents_reply, "decode_query_text_extents_reply" ) x;
fun decode_query_tree_reply x = debug (w2v::decode_query_tree_reply, "decode_query_tree_reply" ) x;
fun decode_set_modifier_mapping_reply x = debug (w2v::decode_set_modifier_mapping_reply, "decode_set_modifier_mapping_reply" ) x;
fun decode_set_pointer_mapping_reply x = debug (w2v::decode_set_pointer_mapping_reply, "decode_set_pointer_mapping_reply" ) x;
fun decode_translate_coordinates_reply x = debug (w2v::decode_translate_coordinates_reply, "decode_translate_coordinates_reply" ) x;
# NB: The above functions were originally
# all coded in curried form as
#
# decode_xpacket = debug (decode_xpacket, "decode_packet" );
#
# an so forth, but this produced "failed to generalize type
# due to value retriction" type errors on the following fns:
#
# decode_alloc_color_cells_reply
# decode_alloc_color_planes_reply
# decode_get_pointer_mapping_reply
# decode_list_extensions_reply
# decode_query_extension_reply
# decode_query_keymap_reply
#
# Rather than code some curried and some not, I coded all uncurried.
}; # package wire_to_value_debug_wrappers
end;
## COPYRIGHT (c) 1990, 1991 by John H. Reppy. See SMLNJ-COPYRIGHT file for details.
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.