"

 COPYRIGHT (c) 1993 by Claus Gittinger

              All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

Object subclass:#WindowGroup

         instanceVariableNames:'views topViews myProcess mySensor isModal previousGroup'

         classVariableNames:'ActiveGroup ScheduledWindowGroups LeaveSignal'

         poolDictionaries:''

         category:'Interface-Support'

!

WindowGroup comment:'

COPYRIGHT (c) 1993 by Claus Gittinger

              All Rights Reserved

'!

!WindowGroup class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1993 by Claus Gittinger

              All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

version

"

"

!

documentation

"

"

! !

!WindowGroup class methodsFor:'initialization'!

initialize

    LeaveSignal isNil ifTrue:[

        LeaveSignal := (Signal new) mayProceed:true.

        LeaveSignal notifierString:'unhandled leave signal'.

        ScheduledWindowGroups := IdentitySet new.

    ].

    "WindowGroup initialize"

! !

!WindowGroup class methodsFor:'instance creation'!

new

    "create and return a new WindowGroup object"

    ^ self basicNew initialize

! !

!WindowGroup class methodsFor:'accessing'!

activeGroup

    "return the currently active windowGroup"

    ^ ActiveGroup

!

scheduledWindowGroups

    ^ ScheduledWindowGroups

! !

!WindowGroup methodsFor:'accessing'!

sensor

    "return the windowGroups sensor"

    ^ mySensor

!

addView:aView

    "add aView to the windowGroup"

    views isNil ifTrue:[

        views := OrderedCollection new.

    ].

    views add:aView

!

addTopView:aView

    "add a topview to the group"

    topViews isNil ifTrue:[

        topViews := OrderedCollection new.

    ].

    topViews add:aView

!

removeView:aView

    "remove aView from the windowGroup;

     if this was the last view in this group, 

     also shut down the corresponding process"

    views notNil ifTrue:[

        views remove:aView ifAbsent:[].

        views isEmpty ifTrue:[

            views := nil

        ]

    ].

    topViews notNil ifTrue:[

        topViews remove:aView ifAbsent:[].

        topViews isEmpty ifTrue:[

            topViews := nil

        ]

    ].

    "

     wakeup my process to look if last view has been

     removed (and terminate if so)

    "

    mySensor eventSemaphore signal

!

views

    "return the views accociated to this windowGroup"

    ^ views

!

topViews

    "return the topviews accociated to this windowGroup"

    ^ topViews

!

process 

    "return the windowGroups process"

    ^ myProcess

!

isModal

    ^ isModal

!

previousGroup

    "return the windowgroup that started this group.

     (for modal groups only)"

    ^ previousGroup

!

mainGroup

    "return the main windowgroup (that is the top one,

     which is not modal)"

    |g|

    g := self.

    [g notNil and:[g isModal]] whileTrue:[

        g := g previousGroup

    ].

    ^ g

!

sensor:aSensor

    "set the windowGroups sensor"

    mySensor := aSensor

! !

!WindowGroup methodsFor:'enumeration'!

allViewsDo:aBlock

    "evaluate aBlock for all views & topviews in this group"

    topViews notNil ifTrue:[topViews do:aBlock].

    views notNil ifTrue:[views do:aBlock]

! 

allTopViewsExcept:aView do:aBlock

    "evaluate aBlock for all topviews except aView in this group"

    topViews notNil ifTrue:[

        topViews do:[:v |

            v ~~ aView ifTrue:[aBlock value:v]

        ]

    ].

! !

!WindowGroup methodsFor:'special'!

showCursor:aCursor

    "change the cursor to aCursor in all of my views"

    |c|

    c := aCursor.

    self allViewsDo:[:aView |  

        c := c on:(aView device).

        aView device setCursor:c id in:aView id.

    ].

!

restoreCursors

    "restore the original cursors in all of my views"

    |c|

    self allViewsDo:[:aView |  

        c := aView cursor on:(aView device).

        aView device setCursor:(c id) in:(aView id).

    ].

!

withCursor:aCursor do:aBlock

    "evaluate aBlock while showing aCursor in all

     my views (used to show wait-cursor while doing something)"

    |oldCursors|

    oldCursors := IdentityDictionary new.

    self allViewsDo:[:aView |

        oldCursors at:aView put:(aView cursor).

        aView cursor:aCursor

    ].

    aBlock valueNowOrOnUnwindDo:[

        oldCursors keysAndValuesDo:[:view :cursor |

            view cursor:cursor

        ]

    ]

! !

!WindowGroup methodsFor:'event handling'!

processEvent

    "process a single event from either the damage- or user input queues.

     Debugger abort brings us back here."

    |event oldActive|

    oldActive := ActiveGroup.

    Object abortSignal handle:[:ex |

        ex return

    ] do:[

        self processExposeEvents.

        [mySensor hasEvents] whileTrue:[

            event := mySensor nextEvent.

            (views isNil and:[topViews isNil]) ifFalse:[

                ActiveGroup := self.

                event sendEvent.

                ActiveGroup := oldActive

            ].

        ].

    ].

    ActiveGroup := oldActive

!

processExposeEvents

    "process all expose events from the damage queue"

    |event view rect oldActive|

    oldActive := ActiveGroup.

    ActiveGroup := self.

    [mySensor hasDamage] whileTrue:[

        event := mySensor nextDamage.

        (views isNil and:[topViews isNil]) ifFalse:[

            event isDamage ifTrue:[

                view := event view.

                rect := event rectangle.

                view shown ifTrue:[

                    view exposeX:(rect left) y:(rect top) width:(rect width) height:(rect height)

                ]

            ] ifFalse:[

                event sendEvent.

            ]

        ]

    ].

    ActiveGroup := oldActive

!

eventLoop

    "loop executed by windowGroup process;

     wait-for and process events forever"

   self eventLoopWhile:[true]

!

eventLoopWhile:aBlock

    "wait-for and process events while aBlock evaluates to true."

    ScheduledWindowGroups add:self.

    LeaveSignal handle:[:ex |

        ex return

    ] do:[

        |p g|

        aBlock whileTrue:[ 

            (views isNil and:[topViews isNil]) ifTrue:[

                ScheduledWindowGroups remove:self ifAbsent:[].

                myProcess notNil ifTrue:[

                    p := myProcess.

                    myProcess := nil.

                    p terminate.

                    "not reached - there is no life after death"

                 ].

                 "

                  this is the end of a modal loop

                  (not having a private process ...)

                 "

                 ^ self

            ].

            mySensor eventSemaphore wait.

            self processEvent

            "

             if modal, also check for redraw events in my maingroup

             (this is a kludge, since it only handles exposures there

              when events arrive for myself)

            "

            isModal ifTrue:[

                g := self mainGroup.

                g notNil ifTrue:[g processExposeEvents].

            ]

        ]

    ].

    ScheduledWindowGroups remove:self ifAbsent:[].

!

waitForExposeFor:aView

    "wait for a noExpose on aView, then process all exposes.

     To be used after a scroll"

    mySensor waitForExposeFor:aView.

    self processExposeEvents

!

leaveEventLoop

    LeaveSignal raise

! !

!WindowGroup methodsFor:'activation / deactivation'!

restart

    "restart after a snapin."

    topViews notNil ifTrue:[

        "

         need a new semaphore, since obsolete processes 

         (from out previous live) may still sit on the current semaphore

        "

        mySensor eventSemaphore:Semaphore new.

        self startup

    ]

!

startup

    "startup the window-group;

     this creates a new window group process, which

     does the event processing."

    |nm|

    previousGroup := nil.

    myProcess isNil ifTrue:[

        isModal := false.

        ScheduledWindowGroups add:self.

        myProcess := [

            ].

            self eventLoopWhile:[true]

        ] forkAt:Processor userSchedulingPriority.

        (topViews notNil and:[topViews isEmpty not]) ifTrue:[

            "give the handler process a user friendly name"

            nm := topViews first name.

            nm isNil ifTrue:[

                nm := topViews first label.

            ].

            myProcess name:(topViews first name)

        ] ifFalse:[

            myProcess name:'window handler'.

        ].

        "when the process dies, we have to close-down

         the views as well

        "

        myProcess exitAction:[self closeDownViews]

    ]

!

startupModal:checkBlock

    "startup the window-group in a modal loop (i.e. under the

     currently running process);

     checkBlock is evaluated and loop is left, when false is

     returned."

    "set previousGroup to the main (non-modal) group"

    previousGroup := WindowGroup activeGroup.

    isModal := true.

    topViews do:[:aView |

        aView realize.

    ].

    self eventLoopWhile:checkBlock.

!

closeDownViews

    "destroy all views associated to this window group"

    topViews notNil ifTrue:[

        topViews do:[:aTopView | aTopView destroy]

    ].

    views := nil.

    topViews := nil.

!

shutdown

    "shutdow the window group; close all views and

     terminate process"

    |p|

    self closeDownViews.

    myProcess notNil ifTrue:[

        p := myProcess.

        myProcess := nil.

        ScheduledWindowGroups remove:self ifAbsent:[].

        p terminate.

    ]

! !

!WindowGroup methodsFor:'initialization'!

reinitialize

    "throw away old (zombie) process"

    myProcess := nil.

    "throw away old events"

"/    self initialize

    mySensor reinitialize

!

initialize

    "setup the windowgroup, by creating a new sensor

     and an event semaphore"

    mySensor := WindowSensor new.

    mySensor eventSemaphore:Semaphore new

! !

!WindowGroup methodsFor:'printing'!

printString

    "return a printed representation;

     just for more user friendlyness, add name of process."

    myProcess isNil ifTrue:[^ super printString].

    ^ 'WindowGroup(' , myProcess nameOrId , ')'

! !