[Date Prev] [Date Next] [Thread Prev] [Thread Next] Date Index Thread Index Search archive:
Date:Mon Jun 24 14:57:56 1993 
Subject:Re: setting X resources from Poplog 
From:Ian Rogers 
Volume-ID:930624.02 

A.Sloman@uk.ac.bham.cs ("A.Sloman") writes:
> I wonder if anyone can see anything wrong with this. Here's the
> code for a procedure xsetresource, with a help section giving
> examples of its use. Suggestions for improvement welcome.

I don't know if the following is better, but it's an alternative. In
particular there's not really enough checking of arguments, but it does
avoid the fork in -sysobey-.

Examples at the end.

Ian.


section;


uses xlib;
uses XConstants;
uses xt_display;

constant syntax endxrdb;

extend_searchlist("xrdb", vedopeners) -> vedopeners;
extend_searchlist("endxrdb", vedclosers) -> vedclosers;

exload 'rdb'
	(language C)
	constant raw_XrmGetStringDatabase
        = #XptImportProcedure <- XrmGetStringDatabase;
	constant raw_XrmGetFileDatabase
        = #XptImportProcedure <- XrmGetFileDatabase;
	constant raw_XrmPutFileDatabase
        = #XptImportProcedure <- XrmPutFileDatabase;
	constant raw_XrmMergeDatabases = #XptImportProcedure <- XrmMergeDatabases;
endexload;

define lconstant fail_coerce(e);
lvars e;
	if e = consexternal_ptr() then
		false
	else
		e
	endif;
enddefine;


define global XrmGetStringDatabase(s) -> db;
lvars	s, db;

    check_string(s);
	exacc (1) :exptr raw_XrmGetStringDatabase(s) -> db;

    fail_coerce(db) -> db;
enddefine;


define global XrmGetFileDatabase(fname) -> db;
lvars	fname, db;

	exacc (1) :exptr raw_XrmGetFileDatabase(fname) -> db;

	fail_coerce(db) -> db;
enddefine;


define global XrmPutFileDatabase(db, fname);
lvars	fname, db;
	exacc (2) raw_XrmPutFileDatabase(db, fname);
enddefine;


define global XrmMergeDatabases(src, dst);
lvars	src, dst;
	exacc (2) raw_XrmMergeDatabases(src, dst);
enddefine;

define global XprmGetDisplayDatabasePtr(display) -> db;
lvars	display, db;
	;;; eek!!!
	exacc [@] :Display display.db -> db
enddefine;

define global XprmGetDisplayDatabase(display) -> db;
lvars	display, db;
	;;; eek!!!
	exacc :Display display.db -> db
enddefine;


define syntax xrdb;
lconstant	alpha 	= item_chartype(`a`),
			sep		= item_chartype(`.`),
	;
dlocal	popnewline					= true,
		%	item_chartype(`.`)	%	= alpha,
		%	item_chartype(`'`)	%	= alpha,
		%	item_chartype(`\s`)	%	= sep,
	;
lvars
		xrdb_str,
	;

	pop11_try_nextitem(";") -> ;

	rdstringto([endxrdb]) -> xrdb_str;
	unless poplastitem == "endxrdb" then
		mishap('Expecting endxrdb, found ' >< poplastitem, []);
	endunless;

	sysPUSHQ(xrdb_str);
	sysCALL("XrmGetStringDatabase");
	sysPUSH("XptDefaultDisplay");
	sysCALL("XprmGetDisplayDatabasePtr");
	sysCALL("XrmMergeDatabases");
enddefine;

define xsetresource(xrdb_str);
	lvars	xrdb_str, i,
		;
	if xrdb_str.islist then
		consstring(#|
			for i in xrdb_str do
				explode(i), `\n`,
			endfor;
		|#) -> xrdb_str
	endif;
	XrmMergeDatabases(
		XrmGetStringDatabase(xrdb_str),
		XprmGetDisplayDatabasePtr(XptDefaultDisplay)
	);
enddefine;


endsection;


/*** examples

vars gfx = XptWidgetSet("Poplog")("GraphicWidget");

vars grum = XptNewWindow('Default', {20 20}, [], gfx);

xrdb;
	Poplog*Background: pink
endxrdb;

vars baz = XptNewWindow('Pinky', {20 20}, [], gfx);

xsetresource('Poplog*Background: lightblue');

vars foo = XptNewWindow('Bluey', {20 20}, [], gfx);

XrmPutFileDatabase(XprmGetDisplayDatabase(XptDefaultDisplay), 'xrdb');
edit('xrdb');

***/