-- Last Edited by: Maxwell, January 18, 1984 9:11 am -- Last Edited by: Paul Rovner, June 15, 1983 5:26 pm -- Last Edited by: Butler, July 15, 1984 4:19:30 pm PDT DIRECTORY Buttons USING [ButtonProc, SetDisplayStyle], MBQueue, Menus USING [ClickProc, CreateEntry, MenuEntry], NutButtons, NutViewer, Process USING [Detach, DisableTimeout, EnableAborts], Rope USING [ROPE], ViewerClasses USING [Viewer, ViewerRec]; NutButtonQImpl: CEDAR MONITOR LOCKS q USING q: Queue IMPORTS Buttons, Menus, NutButtons, Process EXPORTS NutButtons = BEGIN Viewer: TYPE = NutViewer.Viewer; ROPE: TYPE = Rope.ROPE; ClientProgrammingError: ERROR = CODE; InternalProgrammingError: ERROR = CODE; -- A Queue represents a context for button clicks. It contains a list of pending events. -- If pushModel, then notifierRunning is a BOOL that indicates whether or not a process --is currently processing an event. (notifierRunning is ignored if NOT pushModel). -- If NOT pushModel, then newEvent is a CONDITION on which a client process may --wait for the next event to occur. (newEvent is ignored if pushModel). Queue: TYPE = REF QueueObj; QueueObj: PUBLIC TYPE = MONITORED RECORD [ firstEvent: Event _ NIL, pushModel: BOOL, newEvent: CONDITION, notifierRunning: BOOL _ FALSE]; -- An Action represents a single click or client-defined action. -- It contains the information needed to process the click when the notifier gets around --to it, including all the arguments to a button proc. Action: TYPE = MBQueue.Action; Event: TYPE = LIST OF Action; -- NutClickInfo is stored in the clientData field maintained by Viewers. Since we assign -- an MBQueue ClickProc and clientData with the button, we need this record to save the -- real clientData and ClickProc. We also save the queue, so we know the context of the click. NutClickInfo: TYPE = REF NutClickInfoObj; NutClickInfoObj: TYPE = RECORD[ proc: Menus.ClickProc, clientData: REF ANY, q: Queue ]; -- Public procedures CreateQueue: PUBLIC PROC [pushModel: BOOL] RETURNS [queue: Queue] = TRUSTED { queue _ NEW[QueueObj_ [pushModel: pushModel]]; Process.DisableTimeout[@queue.newEvent]; Process.EnableAborts[@queue.newEvent]; RETURN[queue]; }; CreateQMenuEntry: PUBLIC PROC [ q: Queue, name: Rope.ROPE, proc: Menus.ClickProc, clientData: REF ANY _ NIL, documentation: REF ANY _ NIL, fork: BOOL _ TRUE, guarded: BOOL _ FALSE] RETURNS [Menus.MenuEntry] = { RETURN[Menus.CreateEntry[ name, UserClick, NEW[NutClickInfoObj_ [proc, clientData, q]], documentation, FALSE, guarded]] }; QueueButton: PUBLIC PROC [ q: Queue, info: ViewerClasses.ViewerRec _ [], proc: Buttons.ButtonProc, clientData: REF ANY _ NIL, fork: BOOL _ TRUE, font: NutButtons.ButtonFontInfo _ NIL, documentation: REF ANY _ NIL, guarded: BOOL _ FALSE, paint: BOOL _ TRUE] RETURNS [NutButtons.NutButton] = { RETURN[NutButtons.Create[ info, UserClick, NEW[NutClickInfoObj_ [proc, clientData, q]], FALSE, documentation, font, guarded, paint]] }; QueueClientAction: PUBLIC PROC [ q: Queue, proc: PROC [REF ANY], data: REF ANY] = { -- Like UserClick defined later, but queues a client-defined .action newEvent: Event _ CONS[first: [client[proc, data]], rest: NIL]; Enqueue[q, newEvent]; }; DequeueAction: PUBLIC ENTRY PROC [q: Queue] RETURNS [Action] = { event: Event; IF q.pushModel THEN RETURN WITH ERROR ClientProgrammingError; WHILE q.firstEvent=NIL DO WAIT q.newEvent ENDLOOP; event _ q.firstEvent; q.firstEvent_ q.firstEvent.rest; RETURN [event.first]; }; Flush: PUBLIC ENTRY PROC [q: Queue] = { q.firstEvent_ NIL }; -- Private procedures Enqueue: ENTRY PROC [q: Queue, e: Event] = { -- Adds another event e to the end of q's event list, and set a notifier running again -- if there wasn't one. Note that the caller of this procedure does the NEW of the Event, -- outside the monitor, but leaves the rest field NIL to be assigned by this procedure. qEnd: Event; IF q.firstEvent=NIL THEN q.firstEvent_ e ELSE { FOR qEnd_ q.firstEvent, qEnd.rest UNTIL qEnd.rest=NIL DO ENDLOOP; qEnd.rest_ e }; IF q.pushModel THEN { IF q.notifierRunning THEN RETURN; q.notifierRunning_ TRUE; TRUSTED {Process.Detach[FORK Notifier[q]]}; } ELSE NOTIFY q.newEvent }; Notifier: PROC [q: Queue] = { -- This process is not under the queue monitor. There are exactly one or zero notifiers per -- queue, so that no more than one event happens at a time. -- FORKed from Enqueue. event: Event; UNTIL (event_ Dequeue[q])=NIL DO ENABLE ABORTED => {Flush[q]; LOOP}; WITH event.first SELECT FROM e1: Action.user => { viewer: Viewer; IF ISTYPE[e1.parent, Viewer] THEN viewer _ NARROW[e1.parent]; IF viewer # NIL AND viewer.class.flavor = $NutButton THEN Buttons.SetDisplayStyle[viewer, $BlackOnGrey]; e1.proc[e1.parent, e1.clientData, e1.mouseButton, e1.shift, e1.control]; IF viewer # NIL AND viewer.class.flavor = $NutButton THEN Buttons.SetDisplayStyle[viewer, $BlackOnWhite]}; e2: Action.client => e2.proc[e2.data]; ENDCASE => ERROR; ENDLOOP; }; Dequeue: ENTRY PROC [q: Queue] RETURNS [event: Event] = -- Removes the first event on q's event list, returning NIL if list empty. -- Called from Notifier. BEGIN IF NOT q.pushModel THEN RETURN WITH ERROR InternalProgrammingError; IF q.firstEvent=NIL THEN {q.notifierRunning_ FALSE; RETURN[NIL]}; event_ q.firstEvent; q.firstEvent_ q.firstEvent.rest; END; UserClick: Menus.ClickProc = { -- Adds another event to the end of q's event list mci: NutClickInfo _ NARROW[clientData]; newEvent: Event_ CONS[ first: [user[mci.proc, parent, mci.clientData, mouseButton, shift, control]], rest: NIL]; Enqueue[mci.q, newEvent]; }; END. File: NutButtonQImpl.mesa -- Contents: impl'n of NutButtonQImpl -- Created by Cattell and Haugeland October 20, 1982 4:20 pm -- Last edit by: -- Cattell on October 25, 1982 1:54 pm -- MBrown on October 22, 1982 1:09 pm -- Willie-Sue on October 25, 1982 4:04 pm ĘÁ˜JšœŠ™ŠJšĪc4˜4Jš&6œ9Īk œ žœ3žœKžœ0žœžœžœ)žœžœžœžœ žœ/žœžœ žœžœžœžœ˜ÃJš,œžœžœžœžœŸœžœžœžœžœž œžœžœžœž œžœžœŅœ žœžœžœžœ ’˜Ä Jšœžœžœ˜)Jš œžœžœ)žœžœ˜]Jšœ˜JšĪn œžœžœ žœžœžœ žœzžœ ˜éJšCœŸœžœžœžœ%žœžœžœžœžœžœžœžœ žœžœžœžœ.žœ>žœŸ œžœžœ[žœžœžœžœžœ<žœžœžœ žœžœ žœžœ˜ņJš œžœžœ-žœ/žœ-˜ŊJš6Ÿœžœžœžœžœžœ žœžœEœžœ$žœ!Ÿ œžœžœžœ žœ žœ žœžœžœžœžœžœžœžœ žœ?žœ˜šJš œŸœž œžœ žœ˜ZJ˜Jš3œŸœžœžœWœ[œXœžœžœžœžœžœžœ žœžœžœžœ žœžœžœžœžœžœžœžœžœ˜“Jš;œŸœžœ]œ<œœžœžœžœžœžœžœžœ žœžœ:žœžœžœ žœžœ žœžœ"žœžœ žœžœ"žœnžœžœžœ˜äJš5œŸœžœžœ žœKœœžœžœžœ žœžœžœžœžœžœžœžœžœžœ@žœŸ œ3œžœ!žœZžœ&žœ˜‘—…—úÍ