<> <> <> <<>> <> <> DIRECTORY Rope, MBQueue USING [CreateButton, CreateMenuEntry, Queue], Buttons USING[ButtonProc, Create], Containers USING [ChildXBound, ChildYBound], Labels USING[Create], Menus USING[MenuEntry, MenuProc], Rules USING [Create], TypeScript USING [Create], ViewerClasses, ViewerTools USING [MakeNewTextViewer, SetContents], ViewerSpecs USING [openTopY], VFonts USING[defaultFont, Font], WalnutViewer; WalnutViewerImpl: CEDAR PROGRAM IMPORTS Buttons, Containers, Labels, MBQueue, Rules, TypeScript, ViewerSpecs, ViewerTools, VFonts EXPORTS WalnutViewer = BEGIN OPEN WalnutViewer; <> entryHeight: INTEGER = 14; <> xTextFudge: INTEGER = 8; xFudge: INTEGER = 4; <> Viewer: TYPE = ViewerClasses.Viewer; ViewerRec: TYPE = ViewerClasses.ViewerRec; ROPE: TYPE = Rope.ROPE; Queue: TYPE = MBQueue.Queue; <> NextTextViewer: PUBLIC PROC[sib: Viewer] RETURNS [nV: Viewer] = BEGIN nV_ ViewerTools.MakeNewTextViewer[ info: [parent: sib.parent, wy: sib.wy+sib.wh, ww: sib.parent.ww, wh: ViewerSpecs.openTopY]]; Containers.ChildXBound[sib.parent, nV]; Containers.ChildYBound[sib.parent, nV]; END; <> <> NextRightTextViewer: PUBLIC PROC[sib: Viewer, w: INTEGER] RETURNS [nV: Viewer] = BEGIN IF ~CheckAborted[sib] THEN RETURN; nV_ ViewerTools.MakeNewTextViewer[ info: [parent: sib.parent, wx: sib.wx+sib.ww+xFudge, wy: sib.wy, ww: w, wh: entryHeight, border: FALSE]]; END; <> FirstLabel: PUBLIC PROC[name: ROPE, parent: Viewer] RETURNS [nV: Viewer] = BEGIN IF ~CheckAborted[parent] THEN RETURN; nV_ Labels.Create[ info: [name: name, parent: parent, wh: entryHeight, wy: 1, wx: IF parent.scrollable THEN 0 ELSE xFudge, border: FALSE]] END; <> AnotherLabel: PUBLIC PROC[name: ROPE, sib: Viewer_ NIL, newLine: BOOL_ FALSE] RETURNS [nV: Viewer] = BEGIN info: ViewerRec_ [name: name, parent: sib.parent, wy: sib.wy, wh: entryHeight, border: FALSE]; IF ~CheckAborted[sib] THEN RETURN; IF newLine THEN { info.wx_ IF sib.parent.scrollable THEN 0 ELSE xFudge; info.wy_ info.wy + sib.wh; } ELSE info.wx_ sib.wx+sib.ww; nV_ Labels.Create[info: info]; END; <> <> <> FirstButton: PUBLIC PROC[q: Queue, name: ROPE, proc: Buttons.ButtonProc, parent: Viewer, data: REF ANY_ NIL, border: BOOL_ FALSE, width: INTEGER_ 0, guarded: BOOL_ FALSE, font: VFonts.Font _ VFonts.defaultFont, paint: BOOL_ TRUE] RETURNS [nV: Viewer] = BEGIN info: ViewerRec_ [name: name, parent: parent, wh: entryHeight, wy: 1, ww: width, wx: IF parent.scrollable THEN 0 ELSE xFudge, border: border]; IF ~CheckAborted[parent] THEN RETURN; nV_ MBQueue.CreateButton[ q: q, info: info, proc: proc, clientData: data, font: font, guarded: guarded, paint: paint]; END; <> AnotherButton: PUBLIC PROC[q: Queue, name: ROPE, proc: Buttons.ButtonProc, sib: Viewer, data: REF ANY_ NIL, border: BOOL_ FALSE, width: INTEGER_ 0, guarded: BOOL_ FALSE, font: VFonts.Font _ VFonts.defaultFont, newLine: BOOL_ FALSE, paint: BOOL_ TRUE] RETURNS [nV: Viewer] = BEGIN info: ViewerRec_ [name: name, wy: sib.wy, ww: width, wh: entryHeight, parent: sib.parent, border: border]; IF ~CheckAborted[sib] THEN RETURN; IF newLine THEN -- first button on new line { info.wy_ sib.wy + sib.wh + (IF border THEN 1 ELSE 0); -- extra bit info.wx_ IF sib.parent.scrollable THEN 0 ELSE xFudge; } ELSE -- next button right on same line as previous info.wx_ sib.wx+sib.ww+xFudge; RETURN[MBQueue.CreateButton[ q: q, info: info, proc: proc, clientData: data, font: font, guarded: guarded, paint: paint]] END; ImmediateButton: PUBLIC PROC[name: ROPE, proc: Buttons.ButtonProc, border: BOOL, sib: Viewer, fork: BOOL_ TRUE, guarded: BOOL_ FALSE, newLine: BOOL_ FALSE] RETURNS[Viewer] = BEGIN info: ViewerClasses.ViewerRec_ [name: name, wy: sib.wy, wh: entryHeight, parent: sib.parent, border: border]; IF newLine THEN -- first button on new line { info.wy_ sib.wy + sib.wh + (IF border THEN 1 ELSE 0); -- extra bit info.wx_ IF sib.parent.scrollable THEN 0 ELSE xFudge; } ELSE -- next button right on same line as previous info.wx_ sib.wx+sib.ww+xFudge; RETURN[Buttons.Create[info: info, proc: proc, fork: fork, guarded: guarded]]; END; CreateMenuEntry: PUBLIC PROC[q: Queue, name: ROPE, proc: Menus.MenuProc, clientData: REF ANY_ NIL, documentation: REF ANY_ NIL, fork: BOOL_ TRUE, guarded: BOOL_ FALSE] RETURNS[Menus.MenuEntry] = { RETURN[MBQueue.CreateMenuEntry[q, name, proc, clientData, documentation, fork, guarded]]}; <> MakeTypescript: PUBLIC PROC[sib: Viewer] RETURNS [ts: Viewer] = BEGIN y: INTEGER_ sib.wy+sib.wh+xFudge; IF ~CheckAborted[sib] THEN RETURN; ts_ TypeScript.Create[ info: [parent: sib.parent, ww: sib.cw, wy: y, wh: sib.parent.ch - y, border: FALSE] ]; Containers.ChildYBound[sib.parent, ts]; Containers.ChildXBound[sib.parent, ts]; END; MakeBigTextBox: PUBLIC PROC[sib: Viewer, contents: ROPE] RETURNS [nV: Viewer]= <> BEGIN y: INTEGER_ 0; oldV: Viewer_ sib.parent; h: INTEGER; IF ~CheckAborted[sib] THEN RETURN; IF oldV = NIL THEN oldV_ sib ELSE y_ sib.wy+sib.wh+xFudge; h_ oldV.ch - y; nV _ ViewerTools.MakeNewTextViewer[ info: [parent: oldV, wy: y, border: FALSE, ww: oldV.ww, wh: h], paint: FALSE]; ViewerTools.SetContents[nV, contents]; Containers.ChildYBound[oldV, nV]; Containers.ChildXBound[oldV, nV]; END; MakeRuler: PUBLIC PROC[sib: Viewer, h: INTEGER_ 1] RETURNS [r: Viewer] = <> BEGIN IF ~CheckAborted[sib] THEN RETURN; r_ Rules.Create[ info: [parent: sib.parent, wy: sib.wy+sib.wh+1, ww: sib.parent.ww, wh: h]]; Containers.ChildXBound[sib.parent, r]; END; CheckAborted: PROC[sib: Viewer] RETURNS[ok: BOOL] = BEGIN IF sib = NIL THEN RETURN[TRUE]; IF sib.destroyed THEN RETURN[FALSE]; RETURN[TRUE]; END; END.