XTkDBImpl.mesa
Copyright Ó 1989, 1990, 1991 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, October 6, 1989 12:58:15 pm PDT
Christian Jacobi, September 25, 1992 5:53 pm PDT
DIRECTORY
Ascii, Customize, IO, Rope, Xl, XlDB, XlPredefinedAtoms, XTkDB, XTk, XTkFriends;
XTkDBImpl: CEDAR MONITOR
IMPORTS Ascii, Customize, IO, Xl, XlDB, XTk, XTkFriends
EXPORTS XTkDB
SHARES Customize
~ BEGIN
ScanGeometry: PUBLIC PROC [val: REF] RETURNS [s: Xl.Size ¬ [Xl.dontUse, Xl.dontUse], p: Xl.Point ¬ [Xl.dontUse, Xl.dontUse], xneg, yneg: BOOL ¬ FALSE] = {
--Scans Geometry spec rope into size and pos fields
ENABLE IO.Error, IO.EndOfStream => GOTO oops;
WITH val SELECT FROM
r: Rope.ROPE => {
i: INT;
char0: CHAR ¬ '+;
char1: CHAR;
stream: IO.STREAM ¬ IO.RIS[r];
i ¬ IO.GetInt[stream]; [] ¬ IO.SkipWhitespace[stream];
char1 ¬ IO.GetChar[stream];
IF Ascii.Upper[char1]='X THEN {
s.width ¬ i;
s.height ¬ IO.GetInt[stream]; [] ¬ IO.SkipWhitespace[stream];
char0 ¬ IO.GetChar[stream];
i ¬ IO.GetInt[stream]; [] ¬ IO.SkipWhitespace[stream];
char1 ¬ IO.GetChar[stream];
};
SELECT char0 FROM
'+ => {};
'- => {xneg ¬ TRUE};
ENDCASE => GOTO oops;
p.x ¬ IF i>=0 THEN i ELSE -i; --not abs to prevent overflow
SELECT char1 FROM
'+ => {};
'- => {yneg ¬ TRUE};
ENDCASE => GOTO oops;
p.y ¬ IO.GetInt[stream];
};
rs: REF Xl.Size => s ¬ rs­;
ENDCASE => {}
EXITS oops => {};
};
ScanInt: PUBLIC PROC [val: REF] RETURNS [i: INT ¬ Xl.dontUse] = {
ENABLE IO.Error, IO.EndOfStream => GOTO oops;
WITH val SELECT FROM
r: Rope.ROPE => {
stream: IO.STREAM ¬ IO.RIS[r];
i ¬ IO.GetInt[stream];
};
ri: REF INT => i ¬ ri­;
rn: REF NAT => i ¬ rn­;
ri: REF INTEGER => i ¬ ri­;
ENDCASE => {}
EXITS oops => {};
};
ScanSize: PUBLIC PROC [val: REF] RETURNS [s: Xl.Size ¬ [Xl.dontUse, Xl.dontUse]] = {
--Scans Size spec rope into size
--Not simply using ScanGeometry because of runtime for catching IO.EndOfStream
ENABLE IO.Error, IO.EndOfStream => GOTO oops;
WITH val SELECT FROM
r: Rope.ROPE => {
stream: IO.STREAM ¬ IO.RIS[r];
s.width ¬ IO.GetInt[stream];
[] ¬ IO.SkipWhitespace[stream];
IF Ascii.Upper[IO.GetChar[stream]]#'X THEN GOTO oops;
s.height ¬ IO.GetInt[stream];
};
rs: REF Xl.Size => s ¬ rs­;
ENDCASE => {}
EXITS oops => {};
};
BuildQueryFromWidget: PUBLIC PROC [w: XTk.Widget, screenPrefix: BOOL ¬ TRUE] RETURNS [query: Customize.Query] = {
RecurseDown: PROC [query: Customize.Query, w: XTk.Widget] RETURNS [Customize.Query] = {
inst: ATOM ¬ w.s.instName;
IF w.parent#NIL THEN query ¬ RecurseDown[query, w.parent];
IF inst#NIL OR w.parent=NIL THEN query ¬ Customize.AppendStep[query, inst, XTk.ClassName[w]];
RETURN [query];
};
query ¬ Customize.NewQuery[];
IF screenPrefix THEN {
XTkFriends.SetupScreenDepth[w];
SELECT TRUE FROM
w.screenDepth=NIL => {
query ¬ Customize.AppendStep[query, $anyscreen, $bw];
query ¬ Customize.AppendOptionOnly[query, $color];
};
w.screenDepth.depth=1 => query ¬ Customize.AppendStep[query, $bw, $anyscreen];
ENDCASE => query ¬ Customize.AppendStep[query, $color, $anyscreen];
};
query ¬ RecurseDown[query, w];
};
DoQueryFromWidget: PUBLIC PROC [w: XTk.Widget, screenPrefix: BOOL ¬ TRUE, key1, key2: ATOM ¬ NIL] RETURNS [val: REF ¬ NIL] = {
--only after connection is initialized and before window is created!
c: Xl.Connection ¬ w.connection;
IF Xl.Alive[c] THEN {
db: Customize.DBreadonly ¬ XlDB.GetStandardDB[c];
query: Customize.Query ¬ BuildQueryFromWidget[w, screenPrefix];
query ¬ Customize.AppendStep[query, key1, key2];
val ¬ Customize.DoQuery[db, query];
Customize.FreeQuery[query];
};
};
GetGeometryFromDB: PUBLIC PROC [w: XTk.Widget] RETURNS [g: Xl.Geometry] = {
val: REF ¬ DoQueryFromWidget[w, TRUE, $geometry, $size];
IF val#NIL THEN {
p: Xl.Point; xneg, yneg: BOOL;
ss: Xl.Size ¬ w.screenDepth.screen.sizeInPixels;
[g.size, p, xneg, yneg] ¬ ScanGeometry[val];
--pos
IF p.x#Xl.dontUse THEN {
SELECT TRUE FROM
~xneg AND p.x<ss.width => {g.pos.x ¬ p.x};
xneg AND p.x<ss.width => {g.pos.x ¬ ss.width - MAX[g.size.width, 0] - p.x};
ENDCASE => {};
};
IF p.y#Xl.dontUse THEN {
SELECT TRUE FROM
~xneg AND p.y<ss.height => {g.pos.y ¬ p.y};
xneg AND p.y<ss.height => {g.pos.y ¬ ss.height - MAX[g.size.height, 0] - p.y};
ENDCASE => {};
};
};
};
GetSizeFromDB: PUBLIC PROC [w: XTk.Widget] RETURNS [s: Xl.Size ¬ [Xl.dontUse, Xl.dontUse]] = {
val: REF ¬ DoQueryFromWidget[w, TRUE, $size, $geometry];
IF val#NIL THEN s ¬ ScanSize[val];
};
END.