"

 COPYRIGHT (c) 1989 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.

"

TopView subclass:#StandardSystemView

       instanceVariableNames:'label icon iconView iconLabel

			      minExtent maxExtent sizeFixed

			      application'

       classVariableNames:   'DefaultIcon TakeFocusWhenMapped'

       poolDictionaries:''

       category:'Views-Basic'

!

StandardSystemView comment:'

COPYRIGHT (c) 1989 by Claus Gittinger

	      All Rights Reserved

'!

!StandardSystemView class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1989 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

"

    I represent topViews i.e. those views which have a title-label,

    an icon etc. Usually StandardSystemViews are subclassed for

    special views.

"

! !

!StandardSystemView class methodsFor:'defaults'!

defaultLabel

    "return the default label for views of my kind.

     This can be redefined in subclasses or overwritten in

     initialize methods."

    ^ 'aView'

!

defaultIcon

    "return the default icon for views.

     This can be redefined in subclasses or overwritten in

     initialize methods."

    DefaultIcon isNil ifTrue:[

	DefaultIcon := Image fromFile:'SmalltalkX.xbm'.

	DefaultIcon notNil ifTrue:[

	    DefaultIcon := DefaultIcon on:Display

	]

    ].

    ^ DefaultIcon

! !

!StandardSystemView class methodsFor:'startup'!

open

    "create, realize the view - this topview and all its subviews will

     run as a separate process with its own windowGroup"

    ^ self new open 

!

start

    "create, realize the view - this topview and all its subviews will

     run as a separate process with its own windowGroup.

     This method exists for backward compatibility - use open."

    ^ self open

! !

!StandardSystemView class methodsFor:'instance creation'!

model:aModel label:aLabel minimumSize:minExtent

    "ST80-style instance creation"

    |newView|

    newView := self origin:nil 

		    extent:minExtent

		     label:aLabel 

		      icon:nil

		 minExtent:minExtent

		 maxExtent:nil.

    newView model:aModel.

"/    newView controller:(self defaultControllerClass new view:newView).

    ^ newView

!

label:aLabel

    "create a new topView and define its label"

    ^ self origin:nil extent:nil

	   label:aLabel icon:nil

	   minExtent:nil maxExtent:nil

!

label:aLabel minExtent:anExtent

    "create a new topView and define its label and minimum extent"

    ^ self origin:nil extent:nil

	   label:aLabel icon:nil

	   minExtent:anExtent maxExtent:nil

!

label:aLabel icon:aForm

    "create a new topView and define its label and icon"

    ^ self origin:nil extent:nil

	   label:aLabel icon:aForm

	   minExtent:nil maxExtent:nil

!

label:aLabel icon:aForm minExtent:anExtent

    "create a new topView and define its label, icon and minumum extent"

    ^ self origin:nil extent:nil

	   label:aLabel icon:aForm

	   minExtent:anExtent maxExtent:nil

!

label:aLabel icon:aForm minExtent:minExtent maxExtent:maxExtent

    "create a new topView and define its label, icon, min and max extents"

    ^ self origin:nil extent:nil

	   label:aLabel icon:aForm

	   minExtent:minExtent maxExtent:maxExtent

!

origin:anOrigin extent:anExtent label:aLabel

    "create a new topView and define its origin, extent and label"

    ^ self origin:anOrigin extent:anExtent

	   label:aLabel icon:nil

	   minExtent:nil maxExtent:nil

!

origin:anOrigin label:aLabel icon:aForm

		minExtent:minExtent maxExtent:maxExtent

    "create a new topView and define its origin, extent, label, icon

     and extent-boundaries."

    ^ self origin:anOrigin extent:nil

	   label:aLabel icon:aForm

	   minExtent:minExtent maxExtent:maxExtent

!

extent:anExtent label:aLabel minExtent:minExtent

    "create a new topView and define its extent, label and minumum extent"

    ^ self origin:nil extent:anExtent

	   label:aLabel icon:nil

	   minExtent:minExtent maxExtent:nil

!

extent:anExtent label:aLabel icon:aForm

    "create a new topView and define its extent, label and icon"

    ^ self origin:nil extent:anExtent

	   label:aLabel icon:aForm

	   minExtent:nil maxExtent:nil

!

extent:anExtent label:aLabel icon:aForm minExtent:minExtent

    ^ self origin:nil extent:anExtent

	   label:aLabel icon:aForm

	   minExtent:minExtent maxExtent:nil

!

extent:anExtent label:aLabel icon:aForm minExtent:minExtent maxExtent:maxExtent

    ^ self origin:nil extent:anExtent

	   label:aLabel icon:aForm

	   minExtent:minExtent maxExtent:maxExtent

! !

!StandardSystemView methodsFor:'initialization'!

initialize

    super initialize.

    borderWidth := 2.         "- notice: many window managers ignore this"

    minExtent := 10 @ 10.

    maxExtent := (device width) @ (device height).

    label isNil ifTrue:[label := self class defaultLabel].

    icon isNil ifTrue:[icon := self class defaultIcon].

    name := self class name.

!

initEvents

    super initEvents.

    self enableFocusEvents.

!

defaultControllerClass

    "for ST-80 compatibility only - not used in ST/X"

    ^ nil "/ StandardSystemController

!

addToCurrentProject

    "add the receiver (a topview) to the current projects set-of-views.

     (If there is a current project)"

    |p|

    "

     the following check allows systems

     without projects and changeSets

    "

    (Project notNil and:[(p := Project current) notNil]) ifTrue:[

	p addView: self

    ]

!

removeFromCurrentProject

    "remove the receiver (a topview) from the current projects set-of-views.

     (If there is a current project)"

    |p|

    "

     the following check allows systems

     without projects and changeSets

    "

    (Project notNil and:[(p := Project current) notNil]) ifTrue:[

	p removeView:self

    ]

!

reinitialize

    "reopen the receiver if if was visible before.

     This is called right after snapIn; Notice, that all instance variables

     (such as shown, realized etc.) are left-overs from the time the snapout

     was done. Remap the receiver, if it was mapped at snapout time"

    |myController|

    "if I have already been reinited - return"

    drawableId notNil ifTrue:[

	^ self

    ].

    "have to kludge with the controller 

     - otherwise its startup performs unwanted actions ..."

    myController := controller.

    controller := nil.

    "physically create the view & subviews"

    self recreate.

    "if I was mapped, do it again"

    realized ifTrue:[

	"if it was iconified, try to remap iconified"

	device mapView:self id:drawableId iconified:(shown not) 

		   atX:left y:top width:width height:height.

	"and restart the window-group process"

	windowGroup notNil ifTrue:[

	    windowGroup restart

	]

    ].

    "restore controller"

    controller := myController

!

recreate

    "recreate the view after a snap-in"

    icon := self convertedIcon.

    super recreate.

    iconView notNil ifTrue:[

	iconView create.

	device setWindowIconWindow:iconView in:drawableId

    ] ifFalse:[

	(icon notNil and:[icon id notNil]) ifTrue:[

	    device setWindowIcon:icon in:drawableId

	].

    ].

    iconLabel notNil ifTrue:[

	device setIconName:iconLabel in:drawableId

    ]

!

reAdjustGeometry

    "when we come up on a smaller display, 

     make certain, that the receiver is visible"

    |dX dY limitRight limitBottom|

    dX := (device horizontalPixelPerMillimeter * 20) rounded.

    dY := (device verticalPixelPerMillimeter * 20) rounded.

    limitRight := device width - dX.

    limitBottom := device height - dY.

    ((self left > limitRight) or:[

      self top > limitBottom]) ifTrue:[

	'moving view into visible area' errorPrintNL.

	self origin:limitRight @ limitBottom

    ]

!

realize

    super realize.

    windowGroup notNil ifTrue:[

	"/

	"/ have to wait till now, since before I had no windowGroup

	"/

	windowGroup focusSequence:self focusSequence.

	"/

	"/ let the application add its views to the current project

	"/

	application notNil ifTrue:[

	    application opened.

	] ifFalse:[

	    self addToCurrentProject.

	].

    ]

!

focusSequence

    "return a sequence which defines the order in which the focus

     is passed for FocusNext and FocusPrevious keys.

     All views which like to support these keys should redefine

     this method and return a collection of (sub-) views.

     Or, if the model is some applicationModel, it may itself define

     the focusSequence.

     Notice: I dont think this is good style: the focusSequence seems

     to belong into the controller, ..."

    "/

    "/ if I have an application, its supposed to

    "/ know about the focusSequence

    "/

    application notNil ifTrue:[

	^ application focusSequence

    ].

    (model notNil

    and:[(model respondsTo:#focusSequence)

    and:[model ~~ self]]) ifTrue:[

	^ model focusSequence

    ].

    ^ nil

! !

!StandardSystemView methodsFor:'destroying'!

terminate

    application notNil ifTrue:[

	application closeRequest

    ] ifFalse:[

	super terminate

    ]

!

saveAndTerminate

    application notNil ifTrue:[

	application saveAndTerminateRequest

    ] ifFalse:[

	super saveAndTerminate

    ]

!

destroy

    self removeFromCurrentProject

    windowGroup notNil ifTrue:[

	windowGroup focusSequence:nil.

    ].

    super destroy.

! !

!StandardSystemView methodsFor:'private'!

convertedIcon

    "make certain, that the icon is a b&w bitmap;

     do so by converting if required.

     Will add a device supportsDeepIcons and only convert when needed;

     for now, we always have to convert (since there are only Xdisplays)."

    |deviceIcon|

    icon isNil ifTrue:[^ nil].

    device supportsDeepIcons ifFalse:[

	icon depth ~~ 1 ifTrue:[

	    "

	     dither to monochrome

	    "

	    deviceIcon := icon asMonochromeFormOn:device.

	] ifFalse:[

	    deviceIcon := icon

	]

    ].

    deviceIcon notNil ifTrue:[

	"

	 get device pixmap (i.e. allocate colors & resource)

	"

	deviceIcon := deviceIcon on:device

    ].

    ^ deviceIcon

! !

!StandardSystemView methodsFor:'realization'!

physicalCreate

    "common code for create & recreate"

    drawableId := device 

		      createWindowFor:self 

		      origin:(left @ top)

		      extent:(width @ height)

		      minExtent:minExtent

		      maxExtent:maxExtent

		      borderWidth:borderWidth

		      subViewOf:nil 

		      onTop:(self createOnTop)

		      inputOnly:(self inputOnly)

		      label:label

		      cursor:cursor

		      icon:icon

		      iconView:iconView.

    extentChanged := false.

    originChanged := false.

    (borderColor notNil and:[borderColor ~~ Black]) ifTrue:[

	borderColor := borderColor on:device.

	self setBorderColor

    ].

"/  (viewGravity notNil "and:[viewGravity ~~ #NorthWest]") ifTrue:[

"/        device setWindowGravity:viewGravity in:drawableId

"/  ].

"/  (bitGravity notNil "and:[bitGravity ~~ #NorthWest]") ifTrue:[

"/      device setBitGravity:bitGravity in:drawableId

"/  ].

    borderShape notNil ifTrue:[

	device setWindowBorderShape:(borderShape id) in:drawableId

    ].

    viewShape notNil ifTrue:[

	device setWindowShape:(viewShape id) in:drawableId

    ].

    (backed notNil and:[backed ~~ false]) ifTrue:[

	device setBackingStore:backed in:drawableId