StandardSystemView.st
author claus
Tue, 06 Jun 1995 06:09:07 +0200
changeset 151 8123ec03c52f
parent 144 cf645a1ebbb3
child 153 c56277fa4865
permissions -rw-r--r--
.

"
 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 windowEventsForApplication'
       classVariableNames:   'DefaultIcon TakeFocusWhenMapped'
       poolDictionaries:''
       category:'Views-Basic'
!

StandardSystemView comment:'
COPYRIGHT (c) 1989 by Claus Gittinger
	      All Rights Reserved

$Header: /cvs/stx/stx/libview/StandardSystemView.st,v 1.28 1995-06-06 04:08:54 claus Exp $
'!

!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
"
$Header: /cvs/stx/stx/libview/StandardSystemView.st,v 1.28 1995-06-06 04:08:54 claus Exp $
"
!

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
    "realize the view i.e. make it visible."

    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.
	].
    ]
!

restarted
    "sent by my windowGroup, when restarted from an image.
     Nothing done here, but can be redefined to perform any actions
     required to reset the application after an image-restart.
     (for example: check if application files are still around, restart
     subprocesses etc.)."

    application notNil ifTrue:[
	application restarted
    ].
! !

!StandardSystemView methodsFor:'destroying'!

terminate
    "terminate request from the windowManager. If there is an application,
     let it decide if it really wants to be close. Otherwise, forward it to
     superclasses terminate which knows how to do this."

    application notNil ifTrue:[
	application closeRequest
    ] ifFalse:[
	super terminate
    ]
!

saveAndTerminate
    "save & terminate request from the windowManager. The application should 
     save its data/files/text etc. somehow and close.
     If there is an application, let it decide how do do that.
     Otherwise, forward it to superclasses which knows how to do this.
     (it defaults to a terminate there)"

    application notNil ifTrue:[
	application saveAndTerminateRequest
    ] ifFalse:[
	super saveAndTerminate
    ]
!

destroy
    "destroy the view."

    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
    ].
    saveUnder ifTrue:[
	device setSaveUnder:true in:drawableId
    ].
!

create
    "create - make certain that icon is available"

    icon := self convertedIcon.
    super create.

    iconView notNil ifTrue:[
	iconView create.
	device setWindowIconWindow:iconView in:drawableId
    ].
    iconLabel notNil ifTrue:[
	device setIconName:iconLabel in:drawableId
    ]
!

openWithPriority:aPriority
    "open the view, run the windowgroup process at
     other than UserScehdulingPriority."

    self open.
    windowGroup process priority:aPriority.
! !

!StandardSystemView methodsFor:'printing & storing'!

displayString
    "just for your convenience in inspectors ...
     ... add the views label to the displayString."

    |s|

    s := super displayString.
    label notNil ifTrue:[
	s := s , '(' , label , ')'
    ].
    ^ s
! !

!StandardSystemView methodsFor:'queries'!

processName
    "return a string to be shown for my process in the
     process monitor"

    application notNil ifTrue:[
	^ application processName
    ].
    label notNil ifTrue:[^ label].
    ^ super processName
!

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:'accessing'!

label
    "return the views name in the title area"

    ^ label
!

label:aString
    "define the views name in the windows title area"

    label := aString.
    drawableId notNil ifTrue: [
	device setWindowName:aString in:drawableId.
	"
	 unbuffered - to make it visible right NOW
	"
	device flush.
    ]
!

iconLabel
    "return the name displayed in the icon"

    ^ iconLabel
!

iconLabel:aString
    "define the name to be displayed in the icon"

    iconLabel := aString.
    drawableId notNil ifTrue:[
	device setIconName:aString in:drawableId.
	"
	 unbuffered - to make it visible right NOW
	"
	device flush.
    ]
!

name
    "return the topViews label"

    ^ label
!

icon
    "return the form defined as icon"

    ^ icon
!

icon:aForm
    "define the form (bitmap) used as icon"

    |invertedIcon i|

    icon := aForm.
    icon notNil ifTrue:[
	drawableId notNil ifTrue:[
	    icon depth ~~ 1 ifTrue:[
		icon := icon asMonochromeFormOn:device.
	    ].
	    "icons assume 1s as black - invert icon if the device thinks different"
	    (device depth == 1 and:[device whitepixel ~~ 0]) ifTrue:[
		i := icon on:device.
		i notNil ifTrue:[
		    invertedIcon := Form width:icon width height:icon height on:device.
		    invertedIcon function:#copy.
		    invertedIcon foreground:Color noColor background:Color allColor.
		    invertedIcon copyFrom:i x:0 y:0 toX:0 y:0 width:icon width height:icon height.
		    i := invertedIcon.
		]
	    ] ifFalse:[
		i := icon on:device.
	    ].
	    (i notNil and:[i id notNil]) ifTrue:[
		device setWindowIcon:i in:drawableId
	    ]
	]
    ]
!

iconView
    "return the view used as icon-view"

    ^ iconView
!

iconView:aView
    "specify the view to be used as icon"

    iconView := aView.
    drawableId notNil ifTrue:[
	aView create.
	device setWindowIconWindow:aView in:drawableId
    ]
!

iconName:aString
    "this method will vanish soon ... - for backward compatibility"

    self iconLabel:aString
!

maximumSize:anExtent
    "same as maxExtent: for ST-80 compatibility"

    ^ self maxExtent:anExtent
!

minimumSize
    "same as minExtent for ST-80 compatibility"

    ^ self minExtent
!

minimumSize:anExtent
    "same as minExtent: for ST-80 compatibility"

    ^ self minExtent:anExtent
!

minExtent
    "return the views minimum allowed extent"

    ^ minExtent
!

minExtent:min
    "define the minimum extent the view may have -
     depends on good-will of window manager"

    minExtent := min.
    (width notNil and:[height notNil]) ifTrue:[
	((width < (minExtent x)) or:
	 [height < (minExtent y)]) ifTrue: [
	    self extent:minExtent
	]
    ]
!

maxExtent
    "return the views maximum allowed extent"

    ^ maxExtent
!

maxExtent:max
    "define the maximum extent the view may have -
     depends on good-will of window manager"

    maxExtent := max.
    (width notNil and:[height notNil]) ifTrue:[
	((width > (maxExtent x)) or:
	 [height > (maxExtent y)]) ifTrue: [
	    self extent:maxExtent
	]
    ]
!

sizeFixed:aBoolean
    "this prevents the view from resizing itself when realized.
     For normal topViews, this is void, since they dont do this anyway.

     However, modalBoxes (especially: DialogBoxes) typically resize themselfes 
     to the preferredExtent of their components. In some cases, this behavior is 
     not desired and it should be turned off by setting sizeFixed to true.

     To avoid confusion:
	This does NOT prevent the window manager from resizing the view, 
	instead it tells the view to NOT resize ITSELF."

    sizeFixed := aBoolean.

    "example: dialog which resizes itself on #open: 
	      (thereby ignoring the 200@200 extent)

	|dialog|

	dialog := Dialog new.
	dialog addInputFieldOn:'' asValue.
	dialog addOkButton.
	dialog extent:200@200.
	dialog open.


    using sizeFixed:

	|dialog|

	dialog := Dialog new.
	dialog addInputFieldOn:'' asValue.
	dialog addOkButton.
	dialog extent:200@200; sizeFixed:true.
	dialog open.


    using openWithExtent (also sets sizeFixed):

	|dialog|

	dialog := Dialog new.
	dialog addInputFieldOn:'' asValue.
	dialog addOkButton.
	dialog openWithExtent:200@200.
    "
!

application
    "return the topViews application.
     This is new protocol for ST-80 compatibility and not yet fully supported"

    ^ application
!

application:anApplicationModel
    "set the topViews application.
     This is new protocol for ST-80 compatibility and not yet fully supported"

    application := anApplicationModel
! !

!StandardSystemView methodsFor:'event handling'!

sendWindowEvents:collectionOfEventSymbols
    "define the events that are to be forwarded to the application.
     This is being implemented ..."

    windowEventsForApplication := collectionOfEventSymbols
!

focusOut
    "the view lost keyboard focus"

    |v|

    windowGroup notNil ifTrue:[
	(v := windowGroup focusView) notNil ifTrue:[
	    v showNoFocus
	]
    ].
!

focusIn
    "the view got the keyboard focus"

    |v|

    windowGroup notNil ifTrue:[
	(v := windowGroup focusView) notNil ifTrue:[
	    v showFocus
	]
    ].
!

mapped
    "the view got mapped"

    super mapped.
    "
     ask for the focus - this avoids having to click on the
     view with WM's which need an explicit click.
     Q: is this a good idea ?
    "
    TakeFocusWhenMapped == true ifTrue:[
	self getKeyboardFocus.
    ]
! !