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] = { 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]] = { 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] = { 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]; IF p.x#Xl.dontUse THEN { SELECT TRUE FROM ~xneg AND p.x {g.pos.x ¬ p.x}; xneg AND p.x {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 {g.pos.y ¬ p.y}; xneg AND p.y {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. Ύ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 --Scans Geometry spec rope into size and pos fields --Scans Size spec rope into size --Not simply using ScanGeometry because of runtime for catching IO.EndOfStream --only after connection is initialized and before window is created! --pos Κ –(cedarcode) style•NewlineDelimiter ˜code™Kšœ Οeœ=™HK™