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');
***/
|