## root-window-old.pkg
#
# This widget represents the root window on an X screen
# -- the one on which the wallpaper is drawn. X stores
# various things like the X resource database as properties
# on the root window.
# Compiled by:
# src/lib/x-kit/widget/xkit-widget.sublib### "Deep in their roots, all flowers keep the light."
###
### -- Theodore Roethke
# See also:
#
# src/lib/x-kit/widget/old/basic/root-window-old.apistipulate
include package threadkit; # threadkit is from src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg #
package xc = xclient; # xclient is from src/lib/x-kit/xclient/xclient.pkg package ii = image_imp; # image_imp is from src/lib/x-kit/widget/lib/image-imp.pkg package pxc = ro_pixmap_cache_old; # ro_pixmap_cache_old is from src/lib/x-kit/widget/old/lib/ro-pixmap-cache-old.pkg package si = shade_imp_old; # shade _imp_old is from src/lib/x-kit/widget/old/lib/shade-imp-old.pkg package wa = widget_attribute_old; # widget_attribute_old is from src/lib/x-kit/widget/old/lib/widget-attribute-old.pkg package wy = widget_style_old; # widget_style_old is from src/lib/x-kit/widget/old/lib/widget-style-old.pkg# Temporary kludge just to force compilation:
package ix = image_ximp; # image_ximp is from src/lib/x-kit/widget/lib/image-ximp.pkg package sx = shade_ximp; # shade _ximp is from src/lib/x-kit/widget/lib/shade-ximp.pkg package rpx = ro_pixmap_ximp; # ro_pixmap_ximp is from src/lib/x-kit/widget/lib/ro-pixmap-ximp.pkgUnused1 = ix::Exports;
Unused2 = sx::Exports;
Unused3 = rpx::Exports;
herein
package root_window_old { # Why is this not ": Root_Window" ??? XXX QUERO FIXME
# Root record corresponding to display/screen pair.
# server = "" => "unix:0.0"
# = ":d" => "unix:d.0"
# = "host:d" => "host:d.0"
# = "host:d.s" => "host:d.s"
# where host is an internet address (e.g., "128.84.254.97") or "unix".
#
# At present, screen is always the default screen.
Root_Window
=
{ screen: xc::Screen,
id: Ref( Void ), # Here we are just taking advantage of the fact that all REFs are distinct.
# # We should eventually convert this to a proper small-int id -- eventually
# # one wants to use the id as a key for lookup. -- 2013-07-21 CrT
make_shade: xc::Rgb -> si::Shades,
make_tile: String -> xc::Ro_Pixmap,
#
style: wy::Widget_Style,
next_widget_id: Void -> Int
};
init_images
=
[ (quark::quark "lightGray", standard_clientside_pixmaps_old::light_gray),
(quark::quark "gray", standard_clientside_pixmaps_old::gray )
];
fun make_root_window # Called (mainly) from make_root_window in src/lib/x-kit/widget/old/lib/run-in-x-window-old.pkg ( server: String, # Typically from DISPLAY environment variable.
xauthentication: Null_Or( xc::Xauthentication ) # Ultimately from ~/.Xauthority.
)
=
{ screen = xc::default_screen_of (xc::open_xsession (server, xauthentication));
#
widget_id_slot = make_mailslot ();
fun widget_id_loop i
=
{ put_in_mailslot (widget_id_slot, i);
#
widget_id_loop (i+1);
};
is = ii::make_image_imp init_images;
ts = pxc::make_readonly_pixmap_cache (screen, ii::get_image is);
shade_imp = si::make_shade_imp screen;
tilef = pxc::get_ro_pixmap ts;
make_thread "widget_id factory" {. widget_id_loop 0; };
{ id => REF (),
screen,
style => wy::empty_style { screen, tilef },
make_tile => tilef,
make_shade => si::get_shades shade_imp,
next_widget_id => \\ () = take_from_mailslot widget_id_slot # Gets used (only) in widget::make_widget, in src/lib/x-kit/widget/old/basic/widget.pkg }
: Root_Window
;
};
fun screen_of ({ screen, ... }: Root_Window ) = screen;
fun xsession_of ({ screen, ... }: Root_Window ) = xc::xsession_of_screen screen;
fun delete_root_window root
=
xc::close_xsession (xsession_of root);
fun same_root ({ id, ... }: Root_Window, { id=>id', ... }: Root_Window )
=
id == id';
fun shades ({ make_shade, ... }: Root_Window ) c = make_shade c;
fun ro_pixmap ({ make_tile, ... }: Root_Window ) s = make_tile s;
fun color_of
({ screen, ... }: Root_Window )
color_spec
=
xc::get_color color_spec;
fun open_font ({ screen, ... }: Root_Window )
=
xc::find_else_open_font # Misnomer -- this version actually always opens font via round-trip to X server. But this is old code due to be replaced soon.
(xc::xsession_of_screen screen);
fun get_standard_xcursor ({ screen, ... }: Root_Window ) = xc::get_standard_xcursor (xc::xsession_of_screen screen);
fun ring_bell ({ screen, ... }: Root_Window ) = xc::ring_bell (xc::xsession_of_screen screen);
fun size_of_screen ({ screen, ... }: Root_Window ) = xc::size_of_screen screen;
fun mm_size_of_screen ({ screen, ... }: Root_Window ) = xc::mm_size_of_screen screen;
fun depth_of_screen ({ screen, ... }: Root_Window ) = xc::depth_of_screen screen;
fun style_of ({ style, ... }: Root_Window ) = style;
fun is_monochrome ({ screen, ... }: Root_Window )
=
xc::display_class_of_screen screen == xc::STATIC_GRAY and
xc::depth_of_screen screen == 1;
fun style_from_strings ({ screen, make_tile, ... }: Root_Window, sl)
=
wy::style_from_strings ( { screen, tilef=>make_tile }, sl);
fun strings_from_style sty = wy::strings_from_style sty;
fun merge_styles (sty1, sty2) = wy::merge_styles (sty1, sty2);
fun style_from_xrdb root
=
{ xsession = xsession_of root;
screen = xc::default_screen_of xsession;
stl = xc::xrdb_of_screen screen;
# (file::print ("XRDB strings:\n"$(string::join "\n" stl)$"\n"));
style_from_strings (root, stl);
};
Opt_Name = wy::Opt_Name;
Arg_Name = wy::Arg_Name;
Opt_Kind = wy::Opt_Kind;
Opt_Spec = wy::Opt_Spec;
Opt_Db = wy::Opt_Db;
# widget_attribute is from src/lib/x-kit/widget/lib/widget-attribute.pkg Value = wa::Value;
fun parse_command (o_spec) sl
=
wy::parse_command (o_spec) sl;
fun find_named_opt (o_db: wy::Opt_Db) (o_nam: wy::Opt_Name) ({ screen, make_tile, ... }: Root_Window )
=
wy::find_named_opt o_db o_nam { screen, tilef=>make_tile };
fun style_from_opt_db ({ screen, make_tile, ... }: Root_Window, o_db)
=
wy::style_from_opt_db ( { screen, tilef=>make_tile }, o_db);
fun find_named_opt_strings (o_db: wy::Opt_Db) (o_nam: wy::Opt_Name)
=
wy::find_named_opt_strings o_db o_nam;
fun help_string_from_opt_spec (o_spec)
=
wy::help_string_from_opt_spec o_spec;
}; # package root_window
end;