DIRECTORY Buttons, DB, IO, Containers, Menus, MBQueue, NutOps USING [Do], NutViewer, Process USING [Detach], Rope, Rules USING [Create], ViewerOps, ViewerClasses, ViewerSpecs, ViewerTools USING [MakeNewTextViewer, SetContents], VFonts USING[defaultFont, Font]; NutViewerMiscImpl: CEDAR PROGRAM IMPORTS Buttons, MBQueue, Menus, NutViewer, Rules, NutOps, Process, ViewerOps, Containers, ViewerTools, VFonts EXPORTS NutViewer = BEGIN OPEN DB; -- Types and global variables Queue: TYPE = MBQueue.Queue; FieldHandle: TYPE = REF FieldObject; FieldObject: TYPE = RECORD[ tuple: Relship, attribute: Attribute ]; entryHeight: INTEGER = 14; -- yTextFudge: INTEGER = 0; xTextFudge: INTEGER = 8; xFudge: INTEGER = 4; -- yFudge: INTEGER = 0; Viewer: TYPE = ViewerClasses.Viewer; ViewerRec: TYPE = ViewerClasses.ViewerRec; ROPE: TYPE = Rope.ROPE; defaultDBQueue: Queue; DBQueue: PUBLIC PROC RETURNS[Queue] = {RETURN[defaultDBQueue]}; NextRightTextViewer: PUBLIC PROC[sib: Viewer, w: INTEGER] RETURNS [nV: Viewer] = -- creates a text viewer, next right on the same line as v -- v must be a Viewer, not NIL BEGIN CheckAborted[sib]; nV_ ViewerTools.MakeNewTextViewer[ info: [parent: sib.parent, wx: sib.wx+sib.ww+xFudge, wy: sib.wy, ww: w, wh: entryHeight, border: FALSE]]; END; MakeButton: 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] RETURNS [nV: Viewer] = -- The sib is a viewer to the left or above the button to be made. -- If q#NIL THEN button will be serialized with other buttons/menus on q, -- otherwise it uses defaultDBQueue -- Makes a button which is the first one on line if newLine=TRUE. BEGIN info: ViewerRec_ [name: name, wy: sib.wy, ww: width, wh: entryHeight, parent: sib.parent, border: border]; CheckAborted[sib]; 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; IF q=NIL THEN RETURN[Buttons.Create[ info: info, proc: proc, clientData: data, fork: FALSE, font: font, guarded: guarded]] ELSE RETURN[ MBQueue.CreateButton[ q: q, info: info, proc: proc, clientData: data, font: font, guarded: guarded]] END; MakeMenuEntry: 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] = { IF q=NIL THEN RETURN[ Menus.CreateEntry[name, proc, clientData, documentation, fork, guarded]] ELSE RETURN[ MBQueue.CreateMenuEntry[q, name, proc, clientData, documentation, fork, guarded]] }; CheckAborted: PUBLIC PROCEDURE[sib: Viewer] = BEGIN state: ATOM; IF sib = NIL THEN RETURN; IF sib.parent # NIL THEN sib _ sib.parent; state _ NARROW[ViewerOps.FetchProp[sib, $NutViewerState]]; IF state = $beingDestroyed THEN ERROR ABORTED; -- caught by NutImpl.Display END; DefaultFreezeProc: PUBLIC Menus.MenuProc = BEGIN self: Viewer = NARROW[parent]; frozen: Menus.MenuEntry = Menus.FindEntry[self.menu, "Freeze"]; IF frozen = NIL THEN RETURN; Menus.ReplaceMenuEntry[self.menu, frozen]; ViewerOps.PaintViewer[self, menu]; ViewerOps.AddProp[self, $Frozen, self]; END; DBNotifier: PROC [q: MBQueue.Queue] = { -- Just like Notifier provided by MBQueue, except catches generic database errors success: BOOL; -- set if operations succeeds; x1: MBQueue.Action.user; x2: MBQueue.Action.client; Do1: PROC[ REF ANY ] = {x1.proc[x1.parent, x1.clientData, x1.mouseButton, x1.shift, x1.control]}; Do2: PROC[ REF ANY ] = {x2.proc[x2.data]}; DO -- forever ENABLE ABORTED => {MBQueue.Flush[q]; LOOP}; event: MBQueue.Action_ MBQueue.DequeueAction[q]; WITH event SELECT FROM e1: MBQueue.Action.user => { x1_ e1; success_ NutOps.Do[proc: Do1, msgViewer: NARROW[e1.parent]] }; e2: MBQueue.Action.client => { x2_ e2; success_ NutOps.Do[proc: e2.proc]}; ENDCASE => ERROR; IF NOT success THEN MBQueue.Flush[q]; ENDLOOP; }; StartTrap: PROC = TRUSTED { defaultDBQueue_ MBQueue.Create[pushModel: FALSE]; Process.Detach[FORK DBNotifier[defaultDBQueue]]}; MakeTypescript: PUBLIC PROC[sib: Viewer] RETURNS [ts: Viewer] = BEGIN y: INTEGER_ sib.wy+sib.wh+xFudge; NutViewer.CheckAborted[sib]; ts_ ViewerOps.CreateViewer[flavor: $Typescript, 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; MakeRuler: PUBLIC PROC[sib: Viewer, h: INTEGER_ 1] RETURNS [nV: Viewer] = -- Make a one-bit wide line after sib BEGIN NutViewer.CheckAborted[sib]; nV_ Rules.Create[ info: [parent: sib.parent, wy: sib.wy+sib.wh+1, ww: sib.parent.ww, wh: h]]; Containers.ChildXBound[sib.parent, nV]; END; MakeBigTextBox: PUBLIC PROC[sib: Viewer, contents: ROPE] RETURNS [nV: Viewer]= -- Makes editable text viewer taking rest of sib.parent's viewer, -- suitable for msg body or whatever. BEGIN y: INTEGER_ 0; oldV: Viewer_ sib.parent; h: INTEGER; NutViewer.CheckAborted[sib]; 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; NextTextViewer: PUBLIC PROC[sib: Viewer] RETURNS [nV: Viewer] = -- Creates text viewer on line after sib, full width of parent BEGIN NutViewer.CheckAborted[sib]; nV_ ViewerTools.MakeNewTextViewer[ info: [parent: sib.parent, wy: sib.wy+sib.wh, ww: sib.parent.ww, wh: ViewerSpecs.openLeftTopY]]; Containers.ChildXBound[sib.parent, nV]; Containers.ChildYBound[sib.parent, nV]; END; StartTrap[]; END. -- Change log WS 23-Feb-82 16:37:41: took out paint: FALSE on all viewer creations made all Buttons have border: FALSE Rick 1March or so: fixed bug in ProcessSelection: check that tuple is not null (deleted). Rick March 25, 1982 4:01 pm: Moved CommitEditableTuple here since it was only proc in NutEditorImpl. Rick August 3, 1982 4:11 pm: catch AttributeValueTypeMismatch in CommitEditableTuple & recover. Cattell June 3, 1983 11:27 am: Added fancy Message stuff here, completely reorganized NextXViewer stuff to simplify. Cattell June 6, 1983 3:24 pm: Attempt to recover from aborted transactions in DBNotifier. Butler, June 26, 1984: Many small changes to go with major rewrite/reorganization of Nut and Squirrel dFile: NutViewerMiscImpl.mesa -- Contents: Implementation of most of Squirrel Viewers interface (NutViewer). -- Last edited by: -- Cattell on July 22, 1983 3:48 pm -- Willie-Sue on January 21, 1983 8:48 am -- Donahue, April 5, 1983 11:18 am -- Widom, June 18, 1984 8:46:54 am PDT -- Butler, June 26, 1984 4:51:20 pm PDT Exported procedures Ê˘JšœÈ™ÈJš#œÏk œœœ-œœœFœ,œ)œœœœœœœÏcœœ˜±Jšœœœ ˜&Jšœœœ)˜EJšœœžœ œœžœ œ$œœœœ˜ÿJ˜Jšœ™JšÇœÏnœœœœœŸœœœœœž`œœ¤œœŸ œœœœ0œœœ œœ œœœ3œœœžÿœœ‰œ œžœ"œœœž œœœœœž/œœœœœEœ#œœmœŸ œœœœ&œœœœœœœœ œœœœœœœRœœ`Ÿ œœœ œœœœœœœœœ/œœœœžœœÏbœœœœLœ œœœ}œ˜·Jš/œ  œœwœ`œœœWœœœœœœœ5œœœ]œoœœœœœœ˜¥J˜Jš Ðbn œœœ/œœ˜„J˜J˜JšŸœœœœœœ»œ[œ˜ôJšœŸ œœœœœž'œœ±œ˜±Jš!œŸœœœœœžlœœœ(œ%œœœ œ}œ#œvœ˜îJšœŸœœœœžAœœŒœ˜™Jš œœžœœ&œ:œõ˜‡J˜J˜e—…—& U