--- a/DeviceWorkstation.st Mon Oct 28 12:40:57 2013 +0100
+++ b/DeviceWorkstation.st Wed Oct 30 09:49:34 2013 +0100
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1993 by Claus Gittinger
- All Rights Reserved
+ 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
@@ -12,40 +12,40 @@
"{ Package: 'stx:libview' }"
HostGraphicsDevice subclass:#DeviceWorkstation
- instanceVariableNames:'visualType monitorType depth ncells bitsPerRGB bitsRed bitsGreen
- bitsBlue redMask greenMask blueMask redShift greenShift blueShift
- hasColors hasGreyscales width height widthMM heightMM
- resolutionHor resolutionVer idToTableIndexMapping knownViews
- knownIds knownBitmaps knownBitmapIds dispatching dispatchProcess
- exitOnLastClose ctrlDown shiftDown metaDown altDown superDown
- motionEventCompression lastId lastView keyboardMap rootView
- isSlow activeKeyboardGrab activePointerGrab buttonTranslation
- multiClickTimeDelta altModifiers metaModifiers ctrlModifiers
- shiftModifiers superModifiers buttonModifiers supportsDeepIcons
- preferredIconSize ditherColors fixColors numFixRed numFixGreen
- numFixBlue fixGrayColors copyBuffer blackColor whiteColor
- focusMode activeView clipBoardEncoding maxClipBoardSize focusView
- deviceErrorSignal deviceIOErrorSignal mayOpenDebugger
- suppressDebugger eventSema buttonLongPressedHandlerProcess
- buttonPressTimeForMenu aboutToOpenModalWindowHooks
- aboutToOpenNonModalWindowHooks'
- classVariableNames:'ButtonTranslation MultiClickTimeDelta DeviceErrorSignal
- DeviceOpenErrorSignal DeviceIOErrorSignal
- DeviceIOTimeoutErrorSignal ErrorPrinting DefaultScreen AllScreens
- CurrentScreenQuerySignal LastActiveScreen LastActiveProcess
- WindowsRightButtonBehavior ExitOnLastClose
- DrawingOnClosedDeviceSignal CopyBufferHistory
- CopyBufferHistorySize DefaultButtonPressTimeForMenu'
- poolDictionaries:''
- category:'Interface-Graphics'
+ instanceVariableNames:'visualType monitorType depth ncells bitsPerRGB bitsRed bitsGreen
+ bitsBlue redMask greenMask blueMask redShift greenShift blueShift
+ hasColors hasGreyscales width height widthMM heightMM
+ resolutionHor resolutionVer idToTableIndexMapping knownViews
+ knownIds knownBitmaps knownBitmapIds dispatching dispatchProcess
+ exitOnLastClose ctrlDown shiftDown metaDown altDown superDown
+ motionEventCompression lastId lastView keyboardMap rootView
+ isSlow activeKeyboardGrab activePointerGrab buttonTranslation
+ multiClickTimeDelta altModifiers metaModifiers ctrlModifiers
+ shiftModifiers superModifiers buttonModifiers supportsDeepIcons
+ preferredIconSize ditherColors fixColors numFixRed numFixGreen
+ numFixBlue fixGrayColors copyBuffer blackColor whiteColor
+ focusMode activeView clipBoardEncoding maxClipBoardSize focusView
+ deviceErrorSignal deviceIOErrorSignal mayOpenDebugger
+ suppressDebugger eventSema buttonLongPressedHandlerProcess
+ buttonPressTimeForMenu aboutToOpenModalWindowHooks
+ aboutToOpenNonModalWindowHooks'
+ classVariableNames:'ButtonTranslation MultiClickTimeDelta DeviceErrorSignal
+ DeviceOpenErrorSignal DeviceIOErrorSignal
+ DeviceIOTimeoutErrorSignal ErrorPrinting DefaultScreen AllScreens
+ CurrentScreenQuerySignal LastActiveScreen LastActiveProcess
+ WindowsRightButtonBehavior ExitOnLastClose
+ DrawingOnClosedDeviceSignal CopyBufferHistory
+ CopyBufferHistorySize DefaultButtonPressTimeForMenu'
+ poolDictionaries:''
+ category:'Interface-Graphics'
!
Object subclass:#DeviceFontMetrics
- instanceVariableNames:'encoding ascent descent maxAscent maxDescent minWidth maxWidth
- averageWidth minCode maxCode direction'
- classVariableNames:''
- poolDictionaries:''
- privateIn:DeviceWorkstation
+ instanceVariableNames:'encoding ascent descent maxAscent maxDescent minWidth maxWidth
+ averageWidth minCode maxCode direction'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:DeviceWorkstation
!
!DeviceWorkstation class methodsFor:'documentation'!
@@ -53,7 +53,7 @@
copyright
"
COPYRIGHT (c) 1993 by Claus Gittinger
- All Rights Reserved
+ 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
@@ -84,7 +84,7 @@
depth <SmallInteger> bits per color
ncells <SmallInteger> number of colors (i.e. colormap size; not always == 2^depth)
bitsPerRGB <SmallInteger> number of valid bits per rgb component
- (actual number taken in A/D converter; not all devices report the true value)
+ (actual number taken in A/D converter; not all devices report the true value)
bitsRed <SmallInteger> number of red bits (only valid for TrueColor displays)
bitsGreen <SmallInteger> number of green bits (only valid for TrueColor displays)
bitsBlue <SmallInteger> number of blue bits (only valid for TrueColor displays)
@@ -112,8 +112,8 @@
dispatching <Boolean> true, if currently in dispatch loop
exitDispatchOnLastWindowClose
- <Boolean> if true, dispatch is finished when the last
- window closes (default:true).
+ <Boolean> if true, dispatch is finished when the last
+ window closes (default:true).
ctrlDown <Boolean> true, if control key currently pressed
shiftDown <Boolean> true, if shift key currently pressed
@@ -121,8 +121,8 @@
altDown <Boolean> true, if alt key is currently pressed
motionEventCompression
- <Boolean> if true motion events are compressed
- (obsolete: now done in sensor)
+ <Boolean> if true motion events are compressed
+ (obsolete: now done in sensor)
lastId <Number> the id of the last events view (internal)
lastView <View> the last events view (internal, for faster id->view mapping)
@@ -130,38 +130,38 @@
keyboardMap <KeyBdMap> mapping for keys
rootView <DisplayRootView> this displays root window
isSlow <Boolean> set/cleared from startup - used to turn off
- things like popup-shadows etc.
+ things like popup-shadows etc.
focusMode <Symbol> nil, #pointer or #activeWindow
activeWindow <View> WINDOWS only: the currently active (foreground) view
clipBoardEncoding
- <Symbol> encoding of pasted clipBoard text;
- nil means: iso8859.
- set this to #shiftJis, if pasting
- SJIS text (for example, from netscape)
- Some systems pass encoding information
- in the clipBoard - there, this is not
- needed.
+ <Symbol> encoding of pasted clipBoard text;
+ nil means: iso8859.
+ set this to #shiftJis, if pasting
+ SJIS text (for example, from netscape)
+ Some systems pass encoding information
+ in the clipBoard - there, this is not
+ needed.
[class variables:]
MultiClickTimeDelta in ms; controls how long of a delay is
- required between two clicks, to NOT take
- it as a multi-click.
+ required between two clicks, to NOT take
+ it as a multi-click.
ErrorPrinting controls low-level (X-) error message printing
AllScreens a collectin of known screens
[see also:]
- GraphicsContext DeviceDrawable
- WindowSensor WindowGroup WindowEvent
- ProcessorScheduler
- PSMedium
+ GraphicsContext DeviceDrawable
+ WindowSensor WindowGroup WindowEvent
+ ProcessorScheduler
+ PSMedium
[author:]
- Claus Gittinger
+ Claus Gittinger
"
!
@@ -211,20 +211,20 @@
Currently, there is are twoconcrete display classes (released to the public):
- XWorkstation - a plain X window interface
-
- GLXWorkstation - an X window interface with a GL(tm) (3D graphic library)
- extension; either simulated (VGL) or a real GL
- (real GL is only available on SGI machines)
+ XWorkstation - a plain X window interface
+
+ GLXWorkstation - an X window interface with a GL(tm) (3D graphic library)
+ extension; either simulated (VGL) or a real GL
+ (real GL is only available on SGI machines)
the following are coming soon:
- OpenGLWorkstation
- - an X window interface with a openGL(tm) (3D graphic library)
- extension; either simulated (MESA) or a real openGL
- (real openGL is only available on SGI/NT machines)
-
- WinWorkstation - what will that be ?
+ OpenGLWorkstation
+ - an X window interface with a openGL(tm) (3D graphic library)
+ extension; either simulated (MESA) or a real openGL
+ (real openGL is only available on SGI/NT machines)
+
+ WinWorkstation - what will that be ?
An experimental version for a NeXTStep interface exists, but is currently
no longer maintained and not released.
@@ -246,15 +246,15 @@
- create a new instance of XWorkstation:
- Smalltalk at:#Display2 put:(XWorkstation new).
+ Smalltalk at:#Display2 put:(XWorkstation new).
or:
- Smalltalk at:#Display2 put:(GLXWorkstation new).
+ Smalltalk at:#Display2 put:(GLXWorkstation new).
- have it connect to the display (i.e. the xServer):
(replace 'localhost' below with the name of your display)
- Display2 := Display2 initializeFor:'localhost:0.0'
+ Display2 := Display2 initializeFor:'localhost:0.0'
returns nil, if connection is refused
- leaving you with Display2==nil in this case.
@@ -263,31 +263,31 @@
- start an event dispatcher process for it:
(this is now no longer needed - the first opened view will do it for you)
- Display2 startDispatch
+ Display2 startDispatch
- optionally set its keyboard map
(since this is usually done for Display in the startup-file,
the new display does not have all your added key bindings)
- Display2 keyboardMap:(Display keyboardMap)
+ Display2 keyboardMap:(Display keyboardMap)
- create a view for it:
- (FileBrowser onDevice:Display2) open
-
- (Workspace onDevice:Display2) open
-
- (Launcher onDevice:Display2) open
- does not work with Launcher, since its an ApplicationModel (not a view)
- use:
- Launcher openOnDevice:Display2
- instead.
+ (FileBrowser onDevice:Display2) open
+
+ (Workspace onDevice:Display2) open
+
+ (Launcher onDevice:Display2) open
+ does not work with Launcher, since its an ApplicationModel (not a view)
+ use:
+ Launcher openOnDevice:Display2
+ instead.
For all of the above, there is now a convenient helper method in
ApplicationModel, which allows to write:
- Application openOnXScreenNamed:'foo:0'
+ Application openOnXScreenNamed:'foo:0'
However, as mentioned above, there may be a few places, where the default
display 'Display' is still hard-coded - especially, in contributed and
@@ -314,21 +314,21 @@
event dispatchers context.
For a save environment, you should add static exception handler blocks on those
signals; i.e. the setup for remote displays should look somewhat like:
- |newDpy|
-
- newDpy := GLXWorkstation new.
- newDpy := newDpy initializeFor:'localhost:0.0'.
- newDpy isNil ifTrue:[
- self warn:'cannot connect ...'.
- ] ifFalse:[
- newDpy deviceIOErrorSignal handlerBlock:[:ex |
- Transcript beep.
- Transcript showCR:'Display (' , newDpy displayName , '): connection broken.'.
- AbortSignal raise.
- ].
- newDpy startDispatch.
- Launcher openOnDevice:newDpy.
- ].
+ |newDpy|
+
+ newDpy := GLXWorkstation new.
+ newDpy := newDpy initializeFor:'localhost:0.0'.
+ newDpy isNil ifTrue:[
+ self warn:'cannot connect ...'.
+ ] ifFalse:[
+ newDpy deviceIOErrorSignal handlerBlock:[:ex |
+ Transcript beep.
+ Transcript showCR:'Display (' , newDpy displayName , '): connection broken.'.
+ AbortSignal raise.
+ ].
+ newDpy startDispatch.
+ Launcher openOnDevice:newDpy.
+ ].
There may still some problems to be expected,
if the screens have different display capabilities (b&w vs. greyscale vs.
@@ -346,29 +346,29 @@
"create local error signals; enable errorPrinting"
DeviceErrorSignal isNil ifTrue:[
- DeviceErrorSignal := (Signal new) mayProceed:true.
- DeviceErrorSignal notifierString:'device error'.
- DeviceErrorSignal nameClass:self message:#deviceErrorSignal.
-
- DeviceOpenErrorSignal := DeviceErrorSignal newSignalMayProceed:true.
- DeviceOpenErrorSignal nameClass:self message:#deviceOpenErrorSignal.
- DeviceOpenErrorSignal notifierString:'cannot open device'.
-
- DeviceIOErrorSignal := (Signal new) mayProceed:false.
- DeviceIOErrorSignal notifierString:'device IO error'.
- DeviceIOErrorSignal nameClass:self message:#deviceIOErrorSignal.
-
- DeviceIOTimeoutErrorSignal := DeviceIOErrorSignal newSignalMayProceed:false.
- DeviceIOTimeoutErrorSignal notifierString:'device IO timeout error'.
- DeviceIOTimeoutErrorSignal nameClass:self message:#deviceIOTimeoutErrorSignal.
-
- CurrentScreenQuerySignal := QuerySignal new.
- CurrentScreenQuerySignal nameClass:self message:#currentScreenQuerySignal.
- CurrentScreenQuerySignal notifierString:'asking for current screen'.
-
- DrawingOnClosedDeviceSignal := DeviceErrorSignal newSignalMayProceed:true.
- DrawingOnClosedDeviceSignal nameClass:self message:#drawingOnClosedDeviceSignal.
- DrawingOnClosedDeviceSignal notifierString:'drawing attempt on closed graphics device'.
+ DeviceErrorSignal := (Signal new) mayProceed:true.
+ DeviceErrorSignal notifierString:'device error'.
+ DeviceErrorSignal nameClass:self message:#deviceErrorSignal.
+
+ DeviceOpenErrorSignal := DeviceErrorSignal newSignalMayProceed:true.
+ DeviceOpenErrorSignal nameClass:self message:#deviceOpenErrorSignal.
+ DeviceOpenErrorSignal notifierString:'cannot open device'.
+
+ DeviceIOErrorSignal := (Signal new) mayProceed:false.
+ DeviceIOErrorSignal notifierString:'device IO error'.
+ DeviceIOErrorSignal nameClass:self message:#deviceIOErrorSignal.
+
+ DeviceIOTimeoutErrorSignal := DeviceIOErrorSignal newSignalMayProceed:false.
+ DeviceIOTimeoutErrorSignal notifierString:'device IO timeout error'.
+ DeviceIOTimeoutErrorSignal nameClass:self message:#deviceIOTimeoutErrorSignal.
+
+ CurrentScreenQuerySignal := QuerySignal new.
+ CurrentScreenQuerySignal nameClass:self message:#currentScreenQuerySignal.
+ CurrentScreenQuerySignal notifierString:'asking for current screen'.
+
+ DrawingOnClosedDeviceSignal := DeviceErrorSignal newSignalMayProceed:true.
+ DrawingOnClosedDeviceSignal nameClass:self message:#drawingOnClosedDeviceSignal.
+ DrawingOnClosedDeviceSignal notifierString:'drawing attempt on closed graphics device'.
].
ErrorPrinting := true.
@@ -387,8 +387,8 @@
MultiClickTimeDelta := 300. "a click within 300ms is considered a double one"
CopyBufferHistorySize := 20.
ButtonTranslation isNil ifTrue:[
- ButtonTranslation := #(1 2 2 2 2 2 2) "all other buttons to middleButton menu"
- "/ ButtonTranslation := #(1 2 3 4 5 6 7) "identity translation"
+ ButtonTranslation := #(1 2 2 2 2 2 2) "all other buttons to middleButton menu"
+ "/ ButtonTranslation := #(1 2 3 4 5 6 7) "identity translation"
].
"Modified: / 25-08-2010 / 21:57:43 / cg"
@@ -411,11 +411,11 @@
newDevice := self newFor:aScreenName.
newDevice startDispatch.
(someScreen := Screen current) isNil ifTrue:[
- someScreen := Screen default.
+ someScreen := Screen default.
].
someScreen notNil ifTrue:[
- newDevice keyboardMap:(someScreen keyboardMap).
- newDevice buttonTranslation:(someScreen buttonTranslation).
+ newDevice keyboardMap:(someScreen keyboardMap).
+ newDevice buttonTranslation:(someScreen buttonTranslation).
].
"/ arrange for it to finish its event dispatch loop,
@@ -443,42 +443,42 @@
"find out about the concrete Workstation class"
Screen isAbstract ifTrue:[
- |wsClass wsClasses|
-
- wsClasses := OrderedCollection new.
-
- #(OpenGLWorkstation GLXWorkstation XWorkstation)
- detect:[:eachClassNameSymbol| (wsClass := Smalltalk classNamed:eachClassNameSymbol) notNil] ifNone:nil.
- wsClass notNil ifTrue:[wsClasses add:wsClass].
-
- "preparation for WIN32/NeXTStep/OS2 and Mac interfacing;
- But if X11 is linked in and it is capable of setting up a connection, that will be used."
- #(
- "/ #NeXTWorkstation nil
- OS2Workstation isOS2like
- MacWorkstation isMAClike
- WinWorkstation isMSWINDOWSlike
- ) pairWiseDo:[:wsClassName :checkSel|
- (checkSel isNil or:[OperatingSystem perform:checkSel]) ifTrue:[
- (wsClass := Smalltalk classNamed:wsClassName) notNil ifTrue:[
- wsClasses add:wsClass.
- ]
- ].
- ].
-
- "/ try all classes until open of display works.
- wsClasses detect:[:cls|
- [
- display := cls newFor:displayName.
- ] on:Screen deviceOpenErrorSignal do:[:ex| ].
- display notNil
- ] ifNone:nil.
+ |wsClass wsClasses|
+
+ wsClasses := OrderedCollection new.
+
+ #(OpenGLWorkstation GLXWorkstation XWorkstation)
+ detect:[:eachClassNameSymbol| (wsClass := Smalltalk classNamed:eachClassNameSymbol) notNil] ifNone:nil.
+ wsClass notNil ifTrue:[wsClasses add:wsClass].
+
+ "preparation for WIN32/NeXTStep/OS2 and Mac interfacing;
+ But if X11 is linked in and it is capable of setting up a connection, that will be used."
+ #(
+ "/ #NeXTWorkstation nil
+ OS2Workstation isOS2like
+ MacWorkstation isMAClike
+ WinWorkstation isMSWINDOWSlike
+ ) pairWiseDo:[:wsClassName :checkSel|
+ (checkSel isNil or:[OperatingSystem perform:checkSel]) ifTrue:[
+ (wsClass := Smalltalk classNamed:wsClassName) notNil ifTrue:[
+ wsClasses add:wsClass.
+ ]
+ ].
+ ].
+
+ "/ try all classes until open of display works.
+ wsClasses detect:[:cls|
+ [
+ display := cls newFor:displayName.
+ ] on:Screen deviceOpenErrorSignal do:[:ex| ].
+ display notNil
+ ] ifNone:nil.
] ifFalse:[
- display := Screen newFor:displayName.
+ display := Screen newFor:displayName.
].
display isNil ifTrue:[
- Screen deviceOpenErrorSignal raiseWith:displayName.
+ Screen deviceOpenErrorSignal raiseWith:displayName.
].
Screen := display class.
Screen default:display.
@@ -491,7 +491,7 @@
screen (if background processes ask for one)"
CurrentScreenQuerySignal isNil ifTrue:[
- DeviceWorkstation initialize
+ DeviceWorkstation initialize
].
^ CurrentScreenQuerySignal
@@ -561,7 +561,7 @@
Display := aDevice.
old ~~ aDevice ifTrue:[
- DisplayRootView initialize.
+ DisplayRootView initialize.
].
! !
@@ -616,9 +616,9 @@
"an error in the devices low level code (typically Xlib or XtLib)
This is invoked via
- XError->errorInterrupt:#DisplayError->registeredErrorInterruptHandlers
+ XError->errorInterrupt:#DisplayError->registeredErrorInterruptHandlers
or
- XError->errorInterrupt:#DisplayIOError->registeredErrorInterruptHandlers
+ XError->errorInterrupt:#DisplayIOError->registeredErrorInterruptHandlers
looks if a signal handler for DeviceErrorSignal is present,
and - if so raises the signal.
@@ -630,20 +630,20 @@
|badResource msg theDevice theSignal p signalHolder|
errID notNil ifTrue:[
- "/
- "/ timeoutError passes the device;
- "/ the others pass the devicesID
- "/
- errID == #DisplayIOTimeoutError ifTrue:[
- theDevice := aParameter.
- "/ 'device timeout error' printCR.
- ] ifFalse:[
- AllScreens do:[:aDisplayDevice |
- aDisplayDevice id = aParameter ifTrue:[
- theDevice := aDisplayDevice.
- ]
- ]
- ]
+ "/
+ "/ timeoutError passes the device;
+ "/ the others pass the devicesID
+ "/
+ errID == #DisplayIOTimeoutError ifTrue:[
+ theDevice := aParameter.
+ "/ 'device timeout error' printCR.
+ ] ifFalse:[
+ AllScreens do:[:aDisplayDevice |
+ aDisplayDevice id = aParameter ifTrue:[
+ theDevice := aDisplayDevice.
+ ]
+ ]
+ ]
].
"/ now, we have the bad guy at hand ...
@@ -651,24 +651,24 @@
signalHolder := theDevice ? self.
errID == #DisplayIOError ifTrue:[
- "always raises an exception"
- theSignal := signalHolder deviceIOErrorSignal.
- msg := 'Display I/O Error'.
- badResource := theDevice.
+ "always raises an exception"
+ theSignal := signalHolder deviceIOErrorSignal.
+ msg := 'Display I/O Error'.
+ badResource := theDevice.
] ifFalse:[errID == #DisplayIOTimeoutError ifTrue:[
- "always raises an exception for the current process"
- theSignal := signalHolder deviceIOTimeoutErrorSignal.
- msg := 'Display I/O timeout Error'.
- badResource := theDevice.
+ "always raises an exception for the current process"
+ theSignal := signalHolder deviceIOTimeoutErrorSignal.
+ msg := 'Display I/O timeout Error'.
+ badResource := theDevice.
] ifFalse:[ "errID == #DisplayError"
- "only raises an exception if handled"
- theSignal := signalHolder deviceErrorSignal.
- theDevice notNil ifTrue:[
- "/ #resourceIdOfLastError will become instance-specific information in
- "/ the near future ...
- badResource := theDevice resourceOfId:self resourceIdOfLastError.
- ].
- msg := 'Display error: ' , self lastErrorString.
+ "only raises an exception if handled"
+ theSignal := signalHolder deviceErrorSignal.
+ theDevice notNil ifTrue:[
+ "/ #resourceIdOfLastError will become instance-specific information in
+ "/ the near future ...
+ badResource := theDevice resourceOfId:self resourceIdOfLastError.
+ ].
+ msg := 'Display error: ' , self lastErrorString.
]].
'DeviceWorkstation [info]: ' infoPrint. msg infoPrint. ' - ' infoPrint. badResource infoPrintCR.
@@ -680,75 +680,75 @@
that caused the timeout."
(errID ~~ #DisplayIOTimeoutError and:[theDevice notNil]) ifTrue:[
- p := theDevice dispatchProcess.
- (p notNil and:[p ~~ Processor activeProcess]) ifTrue:[
- 'DeviceWorkstation [info]: interrupting: ' infoPrint. p infoPrintCR.
- p interruptWith:[
- (errID == #DisplayError and:[theSignal isHandled not]) ifTrue:[
- "unhandled display errors are ignored"
- ErrorPrinting ifTrue:[
- ('DeviceWorkstation [error]: ' , msg) errorPrintCR
- ].
- ] ifFalse:[
- 'DeviceWorkstation [info]: raising exception ...' infoPrintCR.
- theSignal raiseSignalWith:badResource errorString:msg.
- 'DeviceWorkstation [warning]: exception returned - send brokenConnection' errorPrintCR.
- theDevice brokenConnection.
- 'DeviceWorkstation [warning]: stopping dispatch' errorPrintCR.
- theDevice stopDispatch.
- ].
- ].
- ^ self.
+ p := theDevice dispatchProcess.
+ (p notNil and:[p ~~ Processor activeProcess]) ifTrue:[
+ 'DeviceWorkstation [info]: interrupting: ' infoPrint. p infoPrintCR.
+ p interruptWith:[
+ (errID == #DisplayError and:[theSignal isHandled not]) ifTrue:[
+ "unhandled display errors are ignored"
+ ErrorPrinting ifTrue:[
+ ('DeviceWorkstation [error]: ' , msg) errorPrintCR
+ ].
+ ] ifFalse:[
+ 'DeviceWorkstation [info]: raising exception ...' infoPrintCR.
+ theSignal raiseSignalWith:badResource errorString:msg.
+ 'DeviceWorkstation [warning]: exception returned - send brokenConnection' errorPrintCR.
+ theDevice brokenConnection.
+ 'DeviceWorkstation [warning]: stopping dispatch' errorPrintCR.
+ theDevice stopDispatch.
+ ].
+ ].
+ ^ self.
"/ Processor reschedule.
"/ AbortOperationRequest raise.
- ].
+ ].
].
"If we come here, this is a DiplayIOTimeoutError, we don't know
the display device or we are running on top of the dispatchProcess"
(theSignal isHandled or:[theSignal handlerBlock notNil]) ifTrue:[
- 'DeviceWorkstation [info]: raising signal in current process' infoPrintCR.
+ 'DeviceWorkstation [info]: raising signal in current process' infoPrintCR.
"/ Processor activeProcess displayString infoPrintCR.
- theSignal raiseSignalWith:badResource errorString:msg.
+ theSignal raiseSignalWith:badResource errorString:msg.
].
errID == #DisplayError ifTrue:[
- "unhandled display errors are ignored"
- ^ self.
+ "unhandled display errors are ignored"
+ ^ self.
].
theDevice notNil ifTrue:[
- 'DeviceWorkstation [info]: sending #brokenConnection' infoPrintCR.
- theDevice brokenConnection.
- theDevice dispatchProcess == Processor activeProcess ifTrue:[
- "I am running in the dispatch process
- and nobody handles theSignal, so abort the dispatcher"
-
- 'DeviceWorkstation [info]: raising AbortOperationRequest' infoPrintCR.
- AbortOperationRequest raise.
- ] ifFalse:[
- "Some other process (probably not even guilty - like someone doing a draw after a change) ...
- ... see if we can unwind out of the drawing operation"
-
- |context|
+ 'DeviceWorkstation [info]: sending #brokenConnection' infoPrintCR.
+ theDevice brokenConnection.
+ theDevice dispatchProcess == Processor activeProcess ifTrue:[
+ "I am running in the dispatch process
+ and nobody handles theSignal, so abort the dispatcher"
+
+ 'DeviceWorkstation [info]: raising AbortOperationRequest' infoPrintCR.
+ AbortOperationRequest raise.
+ ] ifFalse:[
+ "Some other process (probably not even guilty - like someone doing a draw after a change) ...
+ ... see if we can unwind out of the drawing operation"
+
+ |context|
"/ thisContext fullPrintAll.
- context := thisContext.
- [
- "find the first returnable context where theDevice is the receiver"
- context := context sender.
- ] doUntil:[
- context isNil or:[context receiver == theDevice and:[context canReturn]].
- ].
- context notNil ifTrue:[
- 'DeviceWorkstation [info]: unwind the draw operation: ' infoPrint.
- context methodPrintString infoPrintCR.
+ context := thisContext.
+ [
+ "find the first returnable context where theDevice is the receiver"
+ context := context sender.
+ ] doUntil:[
+ context isNil or:[context receiver == theDevice and:[context canReturn]].
+ ].
+ context notNil ifTrue:[
+ 'DeviceWorkstation [info]: unwind the draw operation: ' infoPrint.
+ context methodPrintString infoPrintCR.
"/ context fullPrintAll.
- context unwind.
- "not reached"
- ].
- ]
+ context unwind.
+ "not reached"
+ ].
+ ]
].
'DeviceWorkstation [info]: proceeding after error' infoPrintCR.
@@ -816,24 +816,24 @@
"/ take that ... it ought to be display
"/
AllScreens size <= 1 ifTrue:[
- LastActiveProcess := LastActiveScreen := nil.
- Display notNil ifTrue:[
- ^ Display
- ]
+ LastActiveProcess := LastActiveScreen := nil.
+ Display notNil ifTrue:[
+ ^ Display
+ ]
].
"/
"/ someone willing to tell me ?
"/
(dev := self currentScreenQuerySignal query) notNil ifTrue:[
- ^ dev
+ ^ dev
].
thisProcess := Processor activeProcess.
LastActiveScreen notNil ifTrue:[
- LastActiveProcess == thisProcess ifTrue:[
- ^ LastActiveScreen
- ]
+ LastActiveProcess == thisProcess ifTrue:[
+ ^ LastActiveScreen
+ ]
].
"/
@@ -843,14 +843,14 @@
"/ the current windowGroup got corrupted somehow ...
(wg := WindowGroup activeGroup) notNil ifTrue:[
- "/
- "/ ok, not a background process or scheduler ...
- "/
- (dev := wg graphicsDevice) notNil ifTrue:[
- LastActiveScreen := dev.
- LastActiveProcess := thisProcess.
- ^ dev
- ].
+ "/
+ "/ ok, not a background process or scheduler ...
+ "/
+ (dev := wg graphicsDevice) notNil ifTrue:[
+ LastActiveScreen := dev.
+ LastActiveProcess := thisProcess.
+ ^ dev
+ ].
].
"/
@@ -903,7 +903,7 @@
"look for a '-display xxx' commandline argument"
displayName := Smalltalk commandLineArgumentNamed:'-display'.
displayName isNil ifTrue:[
- displayName := OperatingSystem getEnvironment:'DISPLAY'.
+ displayName := OperatingSystem getEnvironment:'DISPLAY'.
].
^ displayName.
@@ -979,8 +979,8 @@
"animate a rubber-rectangle from startRect to endRect.
Can be used by buttons, which open some dialog for nicer user feedback.
Notice: since the displays window manager typically allows a topWindow
- to be placed by the user, this should not be used for modeless
- topViews.
+ to be placed by the user, this should not be used for modeless
+ topViews.
"
^ self zoom:startRect to:endRect duration:300
@@ -997,8 +997,8 @@
"animate a rubber-rectangle from startRect to endRect.
Can be used by buttons, which open some dialog for nicer user feedback.
Notice: since the displays window manager typically allows a topWindow
- to be placed by the user, this should not be used for modeless
- topViews.
+ to be placed by the user, this should not be used for modeless
+ topViews.
"
|steps dExt dOrg org ext root|
@@ -1009,16 +1009,16 @@
dExt := (endRect extent - startRect extent) / steps.
dOrg := (endRect origin - startRect origin) / steps.
0 to:steps do:[:step |
- org := (startRect origin + (dOrg * step)) rounded.
- ext := (startRect extent + (dExt * step)) rounded.
- root clippedByChildren:false.
- root xoring:[
- root displayRectangleX:org x y:org y width:ext x height:ext y
- ].
- Delay waitForMilliseconds:(milliseconds // steps).
- root xoring:[
- root displayRectangleX:org x y:org y width:ext x height:ext y
- ].
+ org := (startRect origin + (dOrg * step)) rounded.
+ ext := (startRect extent + (dExt * step)) rounded.
+ root clippedByChildren:false.
+ root xoring:[
+ root displayRectangleX:org x y:org y width:ext x height:ext y
+ ].
+ Delay waitForMilliseconds:(milliseconds // steps).
+ root xoring:[
+ root displayRectangleX:org x y:org y width:ext x height:ext y
+ ].
].
root clippedByChildren:true.
@@ -1035,8 +1035,8 @@
Can be used by buttons, which open some dialog for nicer user feedback.
The speed is computed for the longest edge to run at the given speed.
Notice: since the displays window manager typically allows a topWindow
- to be placed by the user, this should not be used for modeless
- topViews.
+ to be placed by the user, this should not be used for modeless
+ topViews.
"
|maxDistance|
@@ -1047,7 +1047,7 @@
maxDistance := maxDistance max:(endRect corner - startRect corner).
maxDistance := maxDistance x max:(maxDistance y).
^ self
- zoom:startRect to:endRect duration:(maxDistance abs / pixelsPerSecond * 1000)
+ zoom:startRect to:endRect duration:(maxDistance abs / pixelsPerSecond * 1000)
"
Screen current zoom:(10@10 corner:20@20) to:(20@20 corner:1000@1000) speed:1000
@@ -1072,14 +1072,14 @@
root paint:Color black.
r := aRectangle.
0 to:bw-1 do:[:i |
- root displayRectangle:r.
- r := r insetBy:1.
+ root displayRectangle:r.
+ r := r insetBy:1.
].
root clippedByChildren:true.
"
Display restoreAfter:[
- Display border:(10@10 corner:100@100) width:2.
+ Display border:(10@10 corner:100@100) width:2.
]
"
@@ -1105,7 +1105,7 @@
"
Display restoreAfter:[
- Display displayOpaqueString:'hello' x:10 y:10.
+ Display displayOpaqueString:'hello' x:10 y:10.
]
"
@@ -1128,7 +1128,7 @@
"
Display restoreAfter:[
- Display displayString:'hello' x:10 y:10.
+ Display displayString:'hello' x:10 y:10.
]
"
@@ -1152,7 +1152,7 @@
"
Display restoreAfter:[
- Display fill:(10@10 corner:100@100) fillColor:Color yellow
+ Display fill:(10@10 corner:100@100) fillColor:Color yellow
]
"
@@ -1167,12 +1167,12 @@
"
Display restoreAfter:[
- Display fillWhite
+ Display fillWhite
]
"
"
Display restoreAfter:[
- Display fillWhite:(10@10 corner:100@100)
+ Display fillWhite:(10@10 corner:100@100)
]
"
@@ -1187,7 +1187,7 @@
"
Display restoreAfter:[
- Display fillWhite:(10@10 corner:100@100)
+ Display fillWhite:(10@10 corner:100@100)
]
"
@@ -1330,9 +1330,9 @@
"reverse buttonTranslation"
buttonTranslation notNil ifTrue:[
- buttonNr := buttonTranslation indexOf:aButton ifAbsent:[1].
+ buttonNr := buttonTranslation indexOf:aButton ifAbsent:[1].
] ifFalse:[
- buttonNr := aButton.
+ buttonNr := aButton.
].
^ (aMask bitTest:(self buttonMotionMask:buttonNr))
!
@@ -1463,7 +1463,7 @@
It is not guaranteed, that a particular display device supports this."
rootView isNil ifTrue:[
- rootView := DisplayRootView onDevice:self
+ rootView := DisplayRootView onDevice:self
].
^ rootView
@@ -1569,20 +1569,20 @@
w2 := window2 ? self rootView.
(w1 device == self and:[w2 device == self]) ifFalse:[
- self error:'Huh - Cross device translation' mayProceed:true.
- ^ aPoint
+ self error:'Huh - Cross device translation' mayProceed:true.
+ ^ aPoint
].
w1 isView ifTrue:[
- offset1 := 0
+ offset1 := 0
] ifFalse:[
- offset1 := w1 origin.
- w1 := w1 container.
+ offset1 := w1 origin.
+ w1 := w1 container.
].
w2 isView ifTrue:[
- offset2 := 0
+ offset2 := 0
] ifFalse:[
- offset2 := w2 origin.
- w2 := w2 container.
+ offset2 := w2 origin.
+ w2 := w2 container.
].
devicePoint := self translatePoint:aPoint from:(w1 id) to:(w2 id).
devicePoint isNil ifTrue:[ ^ aPoint].
@@ -1620,20 +1620,20 @@
id := self viewIdFromPoint:aScreenPoint.
view := self viewFromId:id.
view isNil ifTrue:[
- "/ search on other devices (if present).
- "/ This may find the view, in case another device
- "/ has its views on the same display screen
- "/ (i.e. under X, if its another display connection to the same
- "/ X-server)
- Screen allScreens do:[:aScreen |
- |v|
-
- aScreen ~~ self ifTrue:[
- (v := aScreen viewFromId:id) notNil ifTrue:[
- ^ v
- ]
- ]
- ]
+ "/ search on other devices (if present).
+ "/ This may find the view, in case another device
+ "/ has its views on the same display screen
+ "/ (i.e. under X, if its another display connection to the same
+ "/ X-server)
+ Screen allScreens do:[:aScreen |
+ |v|
+
+ aScreen ~~ self ifTrue:[
+ (v := aScreen viewFromId:id) notNil ifTrue:[
+ ^ v
+ ]
+ ]
+ ]
].
^ view
!
@@ -1651,18 +1651,18 @@
"/ along with an illegal id (which happens, if a view from another
"/ screen-device is picked ...)
self class deviceErrorSignal handle:[:ex |
- ^ nil
+ ^ nil
] do:[
- n := 0.
- [searchId notNil] whileTrue:[
- n := n + 1.
- n > 1000 ifTrue:[
- self error:'endless view hierarchy'.
- ^ nil
- ].
- foundId := searchId.
- searchId := self viewIdFromPoint:aScreenPoint in:searchId.
- ]
+ n := 0.
+ [searchId notNil] whileTrue:[
+ n := n + 1.
+ n > 1000 ifTrue:[
+ self error:'endless view hierarchy'.
+ ^ nil
+ ].
+ foundId := searchId.
+ searchId := self viewIdFromPoint:aScreenPoint in:searchId.
+ ]
].
^ foundId
!
@@ -1694,8 +1694,8 @@
"return the number of valid bits in the blue component."
bitsBlue isNil ifTrue:[
- "/ not a truecolor display
- ^ bitsPerRGB
+ "/ not a truecolor display
+ ^ bitsPerRGB
].
^ bitsBlue
@@ -1711,8 +1711,8 @@
"return the number of valid bits in the green component."
bitsGreen isNil ifTrue:[
- "/ not a truecolor display
- ^ bitsPerRGB
+ "/ not a truecolor display
+ ^ bitsPerRGB
].
^ bitsGreen
@@ -1745,8 +1745,8 @@
"return the number of valid bits in the red component."
bitsRed isNil ifTrue:[
- "/ not a truecolor display
- ^ bitsPerRGB
+ "/ not a truecolor display
+ ^ bitsPerRGB
].
^ bitsRed
@@ -1939,9 +1939,9 @@
visualType := aSymbol.
(visualType == #StaticGray or:[visualType == #GrayScale]) ifTrue:[
- hasColors := false
+ hasColors := false
] ifFalse:[
- hasColors := true
+ hasColors := true
]
!
@@ -2220,24 +2220,24 @@
|sizes spec sz sz2|
preferredIconSize isNil ifTrue:[
- sizes := self iconSizes.
- sizes notNil ifTrue:[
- spec := sizes first.
-
- "/ we prefer square icons ...
-
- sz := (spec at:#maxWidth) min: (spec at:#maxHeight).
- sz > 64 ifTrue:[
- sz2 := (spec at:#minWidth) max: (spec at:#minHeight).
- sz2 <= 48 ifTrue:[
- sz := 48
- ]
- ].
- preferredIconSize := sz @ sz
- ].
- preferredIconSize isNil ifTrue:[
- preferredIconSize := 48@48
- ].
+ sizes := self iconSizes.
+ sizes notNil ifTrue:[
+ spec := sizes first.
+
+ "/ we prefer square icons ...
+
+ sz := (spec at:#maxWidth) min: (spec at:#maxHeight).
+ sz > 64 ifTrue:[
+ sz2 := (spec at:#minWidth) max: (spec at:#minHeight).
+ sz2 <= 48 ifTrue:[
+ sz := 48
+ ]
+ ].
+ preferredIconSize := sz @ sz
+ ].
+ preferredIconSize isNil ifTrue:[
+ preferredIconSize := 48@48
+ ].
].
^ preferredIconSize
@@ -2569,8 +2569,8 @@
- needed since some displays do not tell the truth or do not know it"
aNumber > 0 ifTrue:[
- heightMM := aNumber.
- resolutionVer := nil.
+ heightMM := aNumber.
+ resolutionVer := nil.
]
"Modified: 10.9.1996 / 14:25:39 / cg"
@@ -2586,7 +2586,7 @@
"return the number of horizontal pixels per millimeter of the display"
resolutionHor notNil ifTrue:[
- ^ resolutionHor
+ ^ resolutionHor
].
resolutionHor := (width / widthMM) asFloat.
^ resolutionHor
@@ -2615,6 +2615,14 @@
^ self pixelPerInch
!
+setUsableHeight:h
+ height := h
+!
+
+setUsableWidth:w
+ width := w
+!
+
smallestMonitorHeight
"returns the usable height of the smallest monitor in a mult-monitor setup.
Subclasses supporting multi-monitors redefine this."
@@ -2673,7 +2681,7 @@
"return the number of vertical pixels per millimeter of the display"
resolutionVer notNil ifTrue:[
- ^ resolutionVer
+ ^ resolutionVer
].
resolutionVer := (height / heightMM) asFloat.
^ resolutionVer
@@ -2731,8 +2739,8 @@
- needed since some displays do not tell the truth or do not know it"
aNumber > 0 ifTrue:[
- widthMM := aNumber.
- resolutionHor := nil.
+ widthMM := aNumber.
+ resolutionHor := nil.
].
"Modified: 10.9.1996 / 14:25:27 / cg"
@@ -2797,11 +2805,11 @@
untranslatedKeys := OrderedCollection new.
self keyboardMap keysAndValuesDo:[:k :v | v == aSymbolicKey ifTrue:[untranslatedKeys add:k]].
untranslatedKeys size == 0 ifTrue:[
- "/ if its not an explicit command key (Ctrl-*, Alt-* or Cmd-*),
- "/ but a symbolic key, return nil.
- (#('Cmd' 'Ctrl' 'Alt' 'Meta' 'Shift')
- contains:[:k | (aSymbolicKey startsWith:k) ])
- ifFalse:[^ nil].
+ "/ if its not an explicit command key (Ctrl-*, Alt-* or Cmd-*),
+ "/ but a symbolic key, return nil.
+ (#('Cmd' 'Ctrl' 'Alt' 'Meta' 'Shift')
+ contains:[:k | (aSymbolicKey startsWith:k) ])
+ ifFalse:[^ nil].
"/ (aSymbolicKey startsWith:'Cmd') ifFalse:[
"/ (aSymbolicKey startsWith:'Ctrl') ifFalse:[
@@ -2814,43 +2822,43 @@
"/ ].
"/ ].
"/ ].
- untranslatedKey := aSymbolicKey.
+ untranslatedKey := aSymbolicKey.
] ifFalse:[
- untranslatedKeys size == 1 ifTrue:[
- untranslatedKey := untranslatedKeys first.
- ] ifFalse:[
- "if there are multiple mappings, show the Ctrl or the F-key mapping"
- untranslatedKey := untranslatedKeys
- detect:[:k |k startsWith:'Ctrl']
- ifNone:[
- untranslatedKeys
- detect:[:k |k startsWith:'F']
- ifNone:[untranslatedKeys first]].
- ].
+ untranslatedKeys size == 1 ifTrue:[
+ untranslatedKey := untranslatedKeys first.
+ ] ifFalse:[
+ "if there are multiple mappings, show the Ctrl or the F-key mapping"
+ untranslatedKey := untranslatedKeys
+ detect:[:k |k startsWith:'Ctrl']
+ ifNone:[
+ untranslatedKeys
+ detect:[:k |k startsWith:'F']
+ ifNone:[untranslatedKeys first]].
+ ].
].
"/
"/ some modifier-key combination ?
"/
(untranslatedKey startsWith:#Cmd) ifTrue:[
- prefix := #Cmd.
+ prefix := #Cmd.
] ifFalse:[(untranslatedKey startsWith:#Alt) ifTrue:[
- prefix := #Alt.
+ prefix := #Alt.
] ifFalse:[(untranslatedKey startsWith:#Meta) ifTrue:[
- prefix := #Meta.
+ prefix := #Meta.
] ifFalse:[(untranslatedKey startsWith:#Ctrl) ifTrue:[
- prefix := #Ctrl.
+ prefix := #Ctrl.
]]]].
prefix notNil ifTrue:[
- |modifier rest|
-
- modifier := self modifierKeyTopFor:prefix.
- modifier := (modifier ? prefix).
- rest := (untranslatedKey copyFrom:(prefix size + 1)).
- rest isEmpty ifTrue:[^ modifier ].
- modifier := modifier , (self shortKeyPrefixSeparator).
- ^ modifier , rest
+ |modifier rest|
+
+ modifier := self modifierKeyTopFor:prefix.
+ modifier := (modifier ? prefix).
+ rest := (untranslatedKey copyFrom:(prefix size + 1)).
+ rest isEmpty ifTrue:[^ modifier ].
+ modifier := modifier , (self shortKeyPrefixSeparator).
+ ^ modifier , rest
].
^ untranslatedKey
@@ -2959,45 +2967,45 @@
d := icon depth.
self supportsDeepIcons ifFalse:[
- (d ~~ 1 or:[icon isImage]) ifTrue:[
- "
- dither to monochrome
- "
- toMono := true.
- ]
+ (d ~~ 1 or:[icon isImage]) ifTrue:[
+ "
+ dither to monochrome
+ "
+ toMono := true.
+ ]
] ifTrue:[
- d == 1 ifTrue:[
- icon colorMap notNil ifTrue:[
- icon isImage ifFalse:[
- toMono := true.
- ] ifTrue:[
- toDeep := true.
- ]
- ]
- ] ifFalse:[
- d ~~ self depth ifTrue:[
- icon isImage ifFalse:[
- toMono := true.
- ] ifTrue:[
- toDeep := true.
- ]
- ]
- ]
+ d == 1 ifTrue:[
+ icon colorMap notNil ifTrue:[
+ icon isImage ifFalse:[
+ toMono := true.
+ ] ifTrue:[
+ toDeep := true.
+ ]
+ ]
+ ] ifFalse:[
+ d ~~ self depth ifTrue:[
+ icon isImage ifFalse:[
+ toMono := true.
+ ] ifTrue:[
+ toDeep := true.
+ ]
+ ]
+ ]
].
deviceIcon := icon.
toMono ifTrue:[
- deviceIcon := icon asMonochromeFormOn:self.
+ deviceIcon := icon asMonochromeFormOn:self.
].
toDeep ifTrue:[
- deviceIcon := (Image implementorForDepth:self depth) fromImage:icon.
+ deviceIcon := (Image implementorForDepth:self depth) fromImage:icon.
].
deviceIcon notNil ifTrue:[
- "
- get device pixmap (i.e. allocate colors & resource)
- "
- deviceIcon := deviceIcon onDevice:self
+ "
+ get device pixmap (i.e. allocate colors & resource)
+ "
+ deviceIcon := deviceIcon onDevice:self
].
^ deviceIcon
@@ -3012,7 +3020,7 @@
self supportsIconMasks ifFalse:[^ nil].
aMask depth == 1 ifTrue:[
- ^ aMask onDevice:self.
+ ^ aMask onDevice:self.
].
^ aMask asMonochromeFormOn:self
@@ -3051,10 +3059,10 @@
!
createWindowFor:aView type:typeSymbol origin:org extent:ext
- minExtent:minE maxExtent:maxE borderWidth:bw subViewOf:sv
- style:styleSymbol inputOnly:inp
- label:label owner:owner
- icon:icn iconMask:icnM iconView:icnV
+ minExtent:minE maxExtent:maxE borderWidth:bw subViewOf:sv
+ style:styleSymbol inputOnly:inp
+ label:label owner:owner
+ icon:icn iconMask:icnM iconView:icnV
"must be implemented by a concrete class"
^ self subclassResponsibility
@@ -3210,12 +3218,12 @@
but only do so, if it is a string"
copyBuffer size == 0 ifTrue:[
- ^ self
+ ^ self
].
copyBuffer isString ifFalse:[
- copyBuffer isStringCollection ifFalse:[
- ^ self
- ]
+ copyBuffer isStringCollection ifFalse:[
+ ^ self
+ ]
].
self rememberInCopyBufferHistory:copyBuffer.
@@ -3228,13 +3236,13 @@
(via Shift-Paste)"
CopyBufferHistory isNil ifTrue:[
- CopyBufferHistory := OrderedCollection new.
+ CopyBufferHistory := OrderedCollection new.
].
CopyBufferHistory remove:aString ifAbsent:nil.
CopyBufferHistory addFirst:aString.
CopyBufferHistory size > (CopyBufferHistorySize ? 20) ifTrue:[
- CopyBufferHistory removeLast
+ CopyBufferHistory removeLast
].
"Created: / 25-08-2010 / 21:57:08 / cg"
@@ -3261,7 +3269,7 @@
viewID := aView id.
viewID notNil ifTrue:[ "/ if the view is not already closed
- self setClipboardObject:something owner:viewID.
+ self setClipboardObject:something owner:viewID.
]
!
@@ -3287,14 +3295,14 @@
s := aString ? ''.
s isString ifFalse:[
- s := s asStringWithCRsFrom:1 to:(s size) compressTabs:false withCR:false
+ s := s asStringWithCRsFrom:1 to:(s size) compressTabs:false withCR:false
].
viewID := aView id.
viewID notNil ifTrue:[ "/ if the view is not already closed
- "/ for now - should add support to pass emphasis information too
- s := s string.
- self setClipboardText:s owner:viewID.
+ "/ for now - should add support to pass emphasis information too
+ s := s string.
+ self setClipboardText:s owner:viewID.
]
!
@@ -3348,13 +3356,13 @@
s := IdentitySet new.
fixColors notNil ifTrue:[
- s addAll:fixColors.
+ s addAll:fixColors.
].
fixGrayColors notNil ifTrue:[
- s addAll:fixGrayColors.
+ s addAll:fixGrayColors.
].
ditherColors notNil ifTrue:[
- s addAll:ditherColors.
+ s addAll:ditherColors.
].
^ s asArray
@@ -3384,15 +3392,15 @@
depthUsed mapArray|
visualType == #DirectColor ifTrue:[
- 'DeviceWorkstation [info]: directColor displays not fully supported.' infoPrintCR.
- ^ nil
+ 'DeviceWorkstation [info]: directColor displays not fully supported.' infoPrintCR.
+ ^ nil
].
(visualType == #StaticGray or:[visualType == #TrueColor]) ifTrue:[
- "
- those have no colorMap - we're done
- "
- ^ nil
+ "
+ those have no colorMap - we're done
+ "
+ ^ nil
].
"
@@ -3405,12 +3413,12 @@
"/ than 8 bits ...)
depthUsed == 15 ifTrue:[
- depthUsed := 16
+ depthUsed := 16
].
depthUsed > 16 ifTrue:[
- "/ do not allocate zillions of colors ...
- self error:'unreasonably large colorMap ...'.
- ^ nil
+ "/ do not allocate zillions of colors ...
+ self error:'unreasonably large colorMap ...'.
+ ^ nil
].
mapSize := (1 bitShift:depthUsed).
@@ -3418,9 +3426,9 @@
"/ get the palette
mapArray := Array new:mapSize.
1 to:mapSize do:[:i |
- self getRGBFrom:(i-1) into:[:r :g :b |
- mapArray at:i put:(Color red:r green:g blue:b)
- ]
+ self getRGBFrom:(i-1) into:[:r :g :b |
+ mapArray at:i put:(Color red:r green:g blue:b)
+ ]
].
^ mapArray.
@@ -3438,10 +3446,10 @@
therefore, dont use this method; at least only for the common names such as red, green, blue etc."
^ self
- getScaledRGBFromName:aString
- into:[:r :g :b |
- self colorScaledRed:r scaledGreen:g scaledBlue:b
- ]
+ getScaledRGBFromName:aString
+ into:[:r :g :b |
+ self colorScaledRed:r scaledGreen:g scaledBlue:b
+ ]
"
Screen current colorNamed:'red'
@@ -3462,9 +3470,9 @@
colorScaledRed:red scaledGreen:green scaledBlue:blue
visualType == #TrueColor ifTrue:[
- ^ (((red bitShift:-8) bitShift:redShift)
- bitOr:((green bitShift:-8) bitShift:greenShift))
- bitOr:((blue bitShift:-8) bitShift:blueShift)
+ ^ (((red bitShift:-8) bitShift:redShift)
+ bitOr:((green bitShift:-8) bitShift:greenShift))
+ bitOr:((blue bitShift:-8) bitShift:blueShift)
].
self subclassResponsibility
!
@@ -3513,7 +3521,7 @@
triple := self getScaledRGBFrom:index.
triple notNil ifTrue:[
- ^ triple collect:[:val | self deviceColorValueToPercent:val]
+ ^ triple collect:[:val | self deviceColorValueToPercent:val]
].
^ nil
!
@@ -3526,7 +3534,7 @@
triple := self getRGBFrom:index.
triple notNil ifTrue:[
- ^ aBlock valueWithArguments:triple.
+ ^ aBlock valueWithArguments:triple.
].
^ nil
@@ -3542,57 +3550,57 @@
|idx names triple r g b|
(colorName startsWith:$#) ifTrue:[
- "/ color in r/g/b hex notation
- r := Integer readFrom:(colorName copyFrom:2 to:3) radix:16.
- g := Integer readFrom:(colorName copyFrom:4 to:5) radix:16.
- b := Integer readFrom:(colorName copyFrom:6 to:7) radix:16.
- r := (r * 100 / 255).
- g := (g * 100 / 255).
- b := (b * 100 / 255).
- ^ Array with:r with:g with:b
+ "/ color in r/g/b hex notation
+ r := Integer readFrom:(colorName copyFrom:2 to:3) radix:16.
+ g := Integer readFrom:(colorName copyFrom:4 to:5) radix:16.
+ b := Integer readFrom:(colorName copyFrom:6 to:7) radix:16.
+ r := (r * 100 / 255).
+ g := (g * 100 / 255).
+ b := (b * 100 / 255).
+ ^ Array with:r with:g with:b
].
names := #(
- 'red'
- 'green'
- 'blue'
- 'yellow'
- 'magenta'
- 'cyan'
- 'white'
- 'black'
-
- 'olive'
- 'teal'
- 'silver'
- 'lime'
- 'fuchsia'
- 'aqua'
- ).
+ 'red'
+ 'green'
+ 'blue'
+ 'yellow'
+ 'magenta'
+ 'cyan'
+ 'white'
+ 'black'
+
+ 'olive'
+ 'teal'
+ 'silver'
+ 'lime'
+ 'fuchsia'
+ 'aqua'
+ ).
idx := names indexOf:colorName.
idx == 0 ifTrue:[
- idx := names indexOf:colorName asLowercase.
+ idx := names indexOf:colorName asLowercase.
].
idx ~~ 0 ifTrue:[
- triple := #(
- (100 0 0) "red"
- ( 0 100 0) "green"
- ( 0 0 100) "blue"
- (100 100 0) "yellow"
- (100 0 100) "magenta"
- ( 0 100 100) "cyan"
- (100 100 100) "white"
- ( 0 0 0) "black"
-
- ( 50 50 0) "olive"
- ( 0 50 50) "teal"
- ( 40 40 40) "silver"
- ( 20 100 0) "lime"
- ( 60 3 100) "fuchsia"
- ( 10 100 100) "aqua"
- ) at:idx.
-
- ^ triple
+ triple := #(
+ (100 0 0) "red"
+ ( 0 100 0) "green"
+ ( 0 0 100) "blue"
+ (100 100 0) "yellow"
+ (100 0 100) "magenta"
+ ( 0 100 100) "cyan"
+ (100 100 100) "white"
+ ( 0 0 0) "black"
+
+ ( 50 50 0) "olive"
+ ( 0 50 50) "teal"
+ ( 40 40 40) "silver"
+ ( 20 100 0) "lime"
+ ( 60 3 100) "fuchsia"
+ ( 10 100 100) "aqua"
+ ) at:idx.
+
+ ^ triple
].
^ nil
@@ -3606,9 +3614,9 @@
triple := self getScaledRGBFromName:colorName.
triple notNil ifTrue:[
- ^ aBlock value:(self deviceColorValueToPercent:(triple at:1))
- value:(self deviceColorValueToPercent:(triple at:2))
- value:(self deviceColorValueToPercent:(triple at:3))
+ ^ aBlock value:(self deviceColorValueToPercent:(triple at:1))
+ value:(self deviceColorValueToPercent:(triple at:2))
+ value:(self deviceColorValueToPercent:(triple at:3))
].
^ nil
@@ -3632,7 +3640,7 @@
triple := self getScaledRGBFrom:index.
triple notNil ifTrue:[
- ^ aBlock valueWithArguments:triple.
+ ^ aBlock valueWithArguments:triple.
].
^ nil
@@ -3646,7 +3654,7 @@
triple := self getRGBFromName:colorName.
triple notNil ifTrue:[
- ^ triple collect:[:val | self percentToDeviceColorValue:val].
+ ^ triple collect:[:val | self percentToDeviceColorValue:val].
].
^ nil.
@@ -3661,7 +3669,7 @@
triple := self getScaledRGBFromName:colorName.
triple notNil ifTrue:[
- ^ aBlock valueWithArguments:triple.
+ ^ aBlock valueWithArguments:triple.
].
^ nil
!
@@ -3894,7 +3902,7 @@
!
displayArcX:x y:y width:width height:height from:startAngle angle:angle
- in:aDrawableId with:aGCId
+ in:aDrawableId with:aGCId
"draw an arc"
^ self subclassResponsibility
@@ -3924,11 +3932,11 @@
xLast := xStart.
yLast := (ydata at:1) * yScale + yTrans.
ydata from:2 do:[:y | |yT|
- x := xLast + xStep.
- yT := y * yScale + yTrans.
- self displayLineFromX:xLast rounded y:yLast rounded toX:x rounded y:yT rounded in:drawableId with:gcId.
- xLast := x.
- yLast := y.
+ x := xLast + xStep.
+ yT := y * yScale + yTrans.
+ self displayLineFromX:xLast rounded y:yLast rounded toX:x rounded y:yT rounded in:drawableId with:gcId.
+ xLast := x.
+ yLast := y.
]
!
@@ -3937,13 +3945,13 @@
If the coordinates are not integers, retry with rounded."
self displayString:aString
- from:index1
- to:index2
- x:x
- y:y
- in:aDrawableId
- with:aGCId
- opaque:true
+ from:index1
+ to:index2
+ x:x
+ y:y
+ in:aDrawableId
+ with:aGCId
+ opaque:true
!
displayOpaqueString:aString x:x y:y in:aDrawableId with:aGCId
@@ -3951,11 +3959,11 @@
If the coordinates are not integers, retry with rounded."
self displayString:aString
- x:x
- y:y
- in:aDrawableId
- with:aGCId
- opaque:true
+ x:x
+ y:y
+ in:aDrawableId
+ with:aGCId
+ opaque:true
!
displayPointX:x y:y in:aDrawableId with:aGCId
@@ -3986,18 +3994,18 @@
|startPoint p|
1 to:arrayOfPoints size by:2 do:[:idx |
- p := arrayOfPoints at:idx.
- idx odd ifTrue:[
- startPoint := p
- ] ifFalse:[
- self
- displayLineFromX:startPoint x
- y:startPoint y
- toX:p x
- y:p y
- in:aDrawableId
- with:aGCId
- ]
+ p := arrayOfPoints at:idx.
+ idx odd ifTrue:[
+ startPoint := p
+ ] ifFalse:[
+ self
+ displayLineFromX:startPoint x
+ y:startPoint y
+ toX:p x
+ y:p y
+ in:aDrawableId
+ with:aGCId
+ ]
]
!
@@ -4016,14 +4024,14 @@
If the coordinates are not integers, retry with rounded."
self
- displayString:aString
- from:index1
- to:index2
- x:x
- y:y
- in:aDrawableId
- with:aGCId
- opaque:false
+ displayString:aString
+ from:index1
+ to:index2
+ x:x
+ y:y
+ in:aDrawableId
+ with:aGCId
+ opaque:false
!
displayString:aString from:i1 to:i2 x:x y:y in:aDrawableId with:aGCId opaque:opaque
@@ -4037,34 +4045,34 @@
If the coordinates are not integers, retry with rounded."
self
- displayString:aString
- x:x
- y:y
- in:aDrawableId
- with:aGCId
- opaque:false
+ displayString:aString
+ x:x
+ y:y
+ in:aDrawableId
+ with:aGCId
+ opaque:false
!
displayString:aString x:x y:y in:aDrawableId with:aGCId opaque:opaque
"draw a string"
self displayString:aString
- from:1
- to:aString size
- x:x
- y:y
- in:aDrawableId
- with:aGCId
- opaque:opaque
+ from:1
+ to:aString size
+ x:x
+ y:y
+ in:aDrawableId
+ with:aGCId
+ opaque:opaque
!
drawBits:imageBits bitsPerPixel:bitsPerPixel depth:imageDepth padding:pad
- width:imageWidth height:imageHeight
- x:srcx y:srcy
- into:aDrawableId
- x:dstx y:dsty
- width:w height:h
- with:aGCId
+ width:imageWidth height:imageHeight
+ x:srcx y:srcy
+ into:aDrawableId
+ x:dstx y:dsty
+ width:w height:h
+ with:aGCId
"draw a bitimage which has depth id, width iw and height ih into
the drawable. draw a region of w/h pixels from srcx/srcy to dstx/dsty.
It has to be checked elsewhere, that server can do it with the given
@@ -4077,12 +4085,12 @@
!
drawBits:imageBits bitsPerPixel:bitsPerPixel depth:imageDepth
- width:imageWidth height:imageHeight
- x:srcx y:srcy
- into:aDrawableId
- x:dstx y:dsty
- width:w height:h
- with:aGCId
+ width:imageWidth height:imageHeight
+ x:srcx y:srcy
+ into:aDrawableId
+ x:dstx y:dsty
+ width:w height:h
+ with:aGCId
"draw a bitimage which has depth id, width iw and height ih into
the drawable. draw a region of w/h pixels from srcx/srcy to dstx/dsty.
@@ -4095,23 +4103,23 @@
which is the natural padding within ST/X."
^ self
- drawBits:imageBits
- bitsPerPixel:bitsPerPixel
- depth:imageDepth
- padding:8
- width:imageWidth height:imageHeight
- x:srcx y:srcy
- into:aDrawableId
- x:dstx y:dsty
- width:w height:h
- with:aGCId
+ drawBits:imageBits
+ bitsPerPixel:bitsPerPixel
+ depth:imageDepth
+ padding:8
+ width:imageWidth height:imageHeight
+ x:srcx y:srcy
+ into:aDrawableId
+ x:dstx y:dsty
+ width:w height:h
+ with:aGCId
"Created: / 16.4.1997 / 14:55:57 / cg"
"Modified: / 21.1.1998 / 13:27:58 / cg"
!
drawBits:imageBits depth:imageDepth padding:pad width:imageWidth height:imageHeight
- x:srcx y:srcy into:aDrawableId x:dstx y:dsty width:w height:h with:aGCId
+ x:srcx y:srcy into:aDrawableId x:dstx y:dsty width:w height:h with:aGCId
"draw a bitimage which has depth id, width iw and height ih into
the drawable. draw a region of w/h pixels from srcx/srcy to dstx/dsty.
@@ -4119,21 +4127,21 @@
depth; also it is assumed, that the colormap is setup correctly"
^ self
- drawBits:imageBits
- bitsPerPixel:imageDepth
- depth:imageDepth
- padding:pad
- width:imageWidth height:imageHeight
- x:srcx y:srcy
- into:aDrawableId
- x:dstx y:dsty
- width:w height:h
- with:aGCId
+ drawBits:imageBits
+ bitsPerPixel:imageDepth
+ depth:imageDepth
+ padding:pad
+ width:imageWidth height:imageHeight
+ x:srcx y:srcy
+ into:aDrawableId
+ x:dstx y:dsty
+ width:w height:h
+ with:aGCId
!
drawBits:imageBits depth:imageDepth width:imageWidth height:imageHeight
- x:srcx y:srcy
- into:aDrawableId x:dstx y:dsty width:w height:h with:aGCId
+ x:srcx y:srcy
+ into:aDrawableId x:dstx y:dsty width:w height:h with:aGCId
"draw a bitimage which has depth id, width iw and height ih into
the drawable. draw a region of w/h pixels from srcx/srcy to dstx/dsty.
@@ -4143,21 +4151,21 @@
which is the natural padding within ST/X."
^ self
- drawBits:imageBits
- bitsPerPixel:imageDepth
- depth:imageDepth
- width:imageWidth height:imageHeight
- x:srcx y:srcy
- into:aDrawableId
- x:dstx y:dsty
- width:w height:h
- with:aGCId
+ drawBits:imageBits
+ bitsPerPixel:imageDepth
+ depth:imageDepth
+ width:imageWidth height:imageHeight
+ x:srcx y:srcy
+ into:aDrawableId
+ x:dstx y:dsty
+ width:w height:h
+ with:aGCId
"Modified: / 21.1.1998 / 13:28:34 / cg"
!
fillArcX:x y:y width:width height:height from:startAngle angle:angle
- in:aDrawableId with:aGCId
+ in:aDrawableId with:aGCId
"fill an arc"
^ self subclassResponsibility
@@ -4194,7 +4202,7 @@
setOfViews := IdentitySet new.
knownViews notNil ifTrue:[
- knownViews validElementsDo:[:v | setOfViews add:v].
+ knownViews validElementsDo:[:v | setOfViews add:v].
].
^ setOfViews
@@ -4215,7 +4223,7 @@
"/ ]
knownViews notNil ifTrue:[
- knownViews validElementsDo:aBlock
+ knownViews validElementsDo:aBlock
]
"
@@ -4238,11 +4246,11 @@
primitiveFailedOrClosedConnection
self isOpen ifFalse:[
- "/ ignore in end-user apps
- (Smalltalk isSmalltalkDevelopmentSystem) ifTrue:[
- DrawingOnClosedDeviceSignal raiseRequestWith:self.
- ].
- ^ nil
+ "/ ignore in end-user apps
+ (Smalltalk isSmalltalkDevelopmentSystem) ifTrue:[
+ DrawingOnClosedDeviceSignal raiseRequestWith:self.
+ ].
+ ^ nil
].
^ super primitiveFailed
!
@@ -4309,8 +4317,8 @@
"forward a button-multi-press event for some view"
aView isNil ifTrue:[
- "/ event arrived, after I destroyed it myself
- ^ self
+ "/ event arrived, after I destroyed it myself
+ ^ self
].
aView sensor buttonMultiPress:button x:x y:y view:aView
!
@@ -4321,25 +4329,25 @@
|sensor button|
aView isNil ifTrue:[
- "/ event arrived, after I destroyed it myself
- ^ self
+ "/ event arrived, after I destroyed it myself
+ ^ self
].
button := buttonArg.
"/ used that for X on a mac, with a single button.
"/ No longer done automatically.
(metaDown and:[button == 1]) ifTrue:[
- UserPreferences current button2WithAltKey ifTrue:[
- button := 2.
- ].
+ UserPreferences current button2WithAltKey ifTrue:[
+ button := 2.
+ ].
].
sensor := aView sensor.
WindowsRightButtonBehavior == true ifTrue:[
- button >= 2 ifTrue:[
- sensor buttonPress:1 x:x y:y view:aView.
- ^ self.
- ]
+ button >= 2 ifTrue:[
+ sensor buttonPress:1 x:x y:y view:aView.
+ ^ self.
+ ]
].
sensor buttonPress:button x:x y:y view:aView
!
@@ -4350,17 +4358,17 @@
|sensor|
aView isNil ifTrue:[
- "/ event arrived, after I destroyed it myself
- ^ self
+ "/ event arrived, after I destroyed it myself
+ ^ self
].
sensor := aView sensor.
WindowsRightButtonBehavior == true ifTrue:[
- button >= 2 ifTrue:[
- sensor buttonRelease:1 x:x y:y view:aView.
- sensor buttonPress:button x:x y:y view:aView.
- sensor buttonRelease:button x:x y:y view:aView.
- ^ self.
- ].
+ button >= 2 ifTrue:[
+ sensor buttonRelease:1 x:x y:y view:aView.
+ sensor buttonPress:button x:x y:y view:aView.
+ sensor buttonRelease:button x:x y:y view:aView.
+ ^ self.
+ ].
].
sensor buttonRelease:button x:x y:y view:aView
!
@@ -4369,8 +4377,8 @@
"forward a configure for some view"
aView isNil ifTrue:[
- "/ event arrived, after I destroyed it myself
- ^ self
+ "/ event arrived, after I destroyed it myself
+ ^ self
].
aView sensor configureX:x y:y width:w height:h view:aView
!
@@ -4380,8 +4388,8 @@
(aView has been covered by otherView)"
aView isNil ifTrue:[
- "/ event arrived, after I destroyed it myself
- ^ self
+ "/ event arrived, after I destroyed it myself
+ ^ self
].
aView sensor coveredBy:otherView view:aView
!
@@ -4392,8 +4400,8 @@
|sensor|
aView isNil ifTrue:[
- "/ event arrived, after I destroyed it myself
- ^ self
+ "/ event arrived, after I destroyed it myself
+ ^ self
].
"/ this one has special treatment - the destroyed could
@@ -4401,7 +4409,7 @@
"/ sensor.
sensor := aView sensor.
sensor notNil ifTrue:[
- sensor destroyedView:aView
+ sensor destroyedView:aView
].
!
@@ -4409,8 +4417,8 @@
"forward an expose for some view"
aView isNil ifTrue:[
- "/ event arrived, after I destroyed it myself
- ^ self
+ "/ event arrived, after I destroyed it myself
+ ^ self
].
aView sensor exposeX:x y:y width:w height:h view:aView
!
@@ -4419,8 +4427,8 @@
"forward a focusIn event for some view"
aView isNil ifTrue:[
- "/ event arrived, after I destroyed it myself
- ^ self
+ "/ event arrived, after I destroyed it myself
+ ^ self
].
aView sensor focusInView:aView
!
@@ -4429,8 +4437,8 @@
"forward a focusOut event for some view"
aView isNil ifTrue:[
- "/ event arrived, after I destroyed it myself
- ^ self
+ "/ event arrived, after I destroyed it myself
+ ^ self
].
aView sensor focusOutView:aView
!
@@ -4439,8 +4447,8 @@
"forward a graphic expose for some view"
aView isNil ifTrue:[
- "/ event arrived, after I destroyed it myself
- ^ self
+ "/ event arrived, after I destroyed it myself
+ ^ self
].
aView sensor graphicsExposeX:x y:y width:w height:h final:final view:aView
!
@@ -4450,8 +4458,8 @@
"
aView isNil ifTrue:[
- "/ event arrived, after I destroyed it myself
- ^ self
+ "/ event arrived, after I destroyed it myself
+ ^ self
].
aView sensor hotkeyWithId:aHotkeyId key:aKey view:aView
!
@@ -4464,9 +4472,9 @@
|untranslatedKey|
untranslatedKeyArg isInteger ifTrue:[
- untranslatedKey := Character value:untranslatedKeyArg
+ untranslatedKey := Character value:untranslatedKeyArg
] ifFalse:[
- untranslatedKey := untranslatedKeyArg
+ untranslatedKey := untranslatedKeyArg
].
"/ Timestamp now print. 'X: ' print. untranslatedKey printCR.
@@ -4475,18 +4483,18 @@
"/ ctrl-Esc gives up focus
"/
untranslatedKey == #Escape ifTrue:[
- (ctrlDown or:[metaDown]) ifTrue:[
- self ungrabPointer.
- self ungrabKeyboard.
- self setInputFocusTo:nil
- ]
+ (ctrlDown or:[metaDown]) ifTrue:[
+ self ungrabPointer.
+ self ungrabKeyboard.
+ self setInputFocusTo:nil
+ ]
].
self modifierKeyProcessing:untranslatedKey down:true.
aView isNil ifTrue:[
- "/ event arrived, after I destroyed it myself
- ^ self
+ "/ event arrived, after I destroyed it myself
+ ^ self
].
"/ xlatedKey := self translateKey:untranslatedKey forView:aView.
@@ -4509,16 +4517,16 @@
|untranslatedKey xlatedKey|
untranslatedKeyArg isInteger ifTrue:[
- untranslatedKey := Character value:untranslatedKeyArg
+ untranslatedKey := Character value:untranslatedKeyArg
] ifFalse:[
- untranslatedKey := untranslatedKeyArg
+ untranslatedKey := untranslatedKeyArg
].
self modifierKeyProcessing:untranslatedKey down:false.
aView isNil ifTrue:[
- "/ event arrived, after I destroyed it myself
- ^ self
+ "/ event arrived, after I destroyed it myself
+ ^ self
].
xlatedKey := self translateKey:untranslatedKey forView:aView.
@@ -4531,8 +4539,8 @@
"forward a mapped event for some view"
aView isNil ifTrue:[
- "/ event arrived, after I destroyed it myself
- ^ self
+ "/ event arrived, after I destroyed it myself
+ ^ self
].
aView sensor mappedView:aView
!
@@ -4542,11 +4550,11 @@
This event is sent to the current pointer view (like keyPress/release)."
aView isNil ifTrue:[
- "/ event arrived, after I destroyed it myself
- ^ self
+ "/ event arrived, after I destroyed it myself
+ ^ self
].
aView sensor
- mouseWheelMotion:buttonState x:x y:y amount:amount deltaTime:dTime view:aView
+ mouseWheelMotion:buttonState x:x y:y amount:amount deltaTime:dTime view:aView
"Modified: / 21.5.1999 / 13:05:53 / cg"
!
@@ -4555,8 +4563,8 @@
"forward a noExpose event for some view"
aView isNil ifTrue:[
- "/ event arrived, after I destroyed it myself
- ^ self
+ "/ event arrived, after I destroyed it myself
+ ^ self
].
aView sensor noExposeView:aView
!
@@ -4565,8 +4573,8 @@
"forward a pointer enter for some view"
aView isNil ifTrue:[
- "/ event arrived, after I destroyed it myself
- ^ self
+ "/ event arrived, after I destroyed it myself
+ ^ self
].
aView sensor pointerEnter:buttonState x:x y:y view:aView
!
@@ -4575,8 +4583,8 @@
"forward a pointer leave for some view"
aView isNil ifTrue:[
- "/ event arrived, after I destroyed it myself
- ^ self
+ "/ event arrived, after I destroyed it myself
+ ^ self
].
aView sensor pointerLeave:buttonState view:aView
!
@@ -4585,8 +4593,8 @@
"forward a saveAndTerminate event for some view"
aView isNil ifTrue:[
- "/ event arrived, after I destroyed it myself
- ^ self
+ "/ event arrived, after I destroyed it myself
+ ^ self
].
aView sensor saveAndTerminateView:aView
!
@@ -4595,8 +4603,8 @@
"forward a terminate event for some view"
aView isNil ifTrue:[
- "/ event arrived, after I destroyed it myself
- ^ self
+ "/ event arrived, after I destroyed it myself
+ ^ self
].
aView sensor terminateView:aView.
!
@@ -4605,8 +4613,8 @@
"forward an unmapped event for some view"
aView isNil ifTrue:[
- "/ event arrived, after I destroyed it myself
- ^ self
+ "/ event arrived, after I destroyed it myself
+ ^ self
].
aView sensor unmappedView:aView
! !
@@ -4622,31 +4630,31 @@
dispatching ifFalse:[^ self].
self == Display ifTrue:[
- ExitOnLastClose == true ifFalse:[^ self].
+ ExitOnLastClose == true ifFalse:[^ self].
].
exitOnLastClose == true ifFalse:[^ self].
knownViews notNil ifTrue:[
- "/ if there is no non-popup topview, stop dispatching
- (knownViews contains:[:slot |
- slot notNil
- and:[slot ~~ 0
- and:[slot isRootView not
- and:[slot isTopView
- and:[slot isPopUpView not
- and:[true "slot isModal not"
- "and:[slot realized]"]]]]]])
- ifFalse:[
- "/ my last view was closed
- dispatching := false.
- 'DeviceWorkstation [info]: finished dispatch (last view closed): ' infoPrint.
- self infoPrintCR.
- LastActiveScreen == self ifTrue:[
- LastActiveScreen := nil.
- LastActiveProcess := nil.
- ].
- eventSema notNil ifTrue:[eventSema signal]. "/ get dispatchLoop out of its wait...
- ]
+ "/ if there is no non-popup topview, stop dispatching
+ (knownViews contains:[:slot |
+ slot notNil
+ and:[slot ~~ 0
+ and:[slot isRootView not
+ and:[slot isTopView
+ and:[slot isPopUpView not
+ and:[true "slot isModal not"
+ "and:[slot realized]"]]]]]])
+ ifFalse:[
+ "/ my last view was closed
+ dispatching := false.
+ 'DeviceWorkstation [info]: finished dispatch (last view closed): ' infoPrint.
+ self infoPrintCR.
+ LastActiveScreen == self ifTrue:[
+ LastActiveScreen := nil.
+ LastActiveProcess := nil.
+ ].
+ eventSema notNil ifTrue:[eventSema signal]. "/ get dispatchLoop out of its wait...
+ ]
].
"Modified: 19.9.1995 / 11:31:54 / claus"
@@ -4655,20 +4663,20 @@
cleanupAfterDispatch
eventSema notNil ifTrue:[
- Processor disableSemaphore:eventSema.
- eventSema := nil.
+ Processor disableSemaphore:eventSema.
+ eventSema := nil.
].
dispatchProcess := nil.
DefaultScreen == self ifTrue:[
- (Transcript isView and:[Transcript topView device ~~ self]) ifTrue:[
- DefaultScreen := Transcript topView device
- ] ifFalse:[
- "/ what should the defaultScreen be - help !!!!!!
-
- DefaultScreen := DeviceWorkstation allSubInstances
- detect:[:aDevice | aDevice isOpen] ifNone:nil
- ]
+ (Transcript isView and:[Transcript topView device ~~ self]) ifTrue:[
+ DefaultScreen := Transcript topView device
+ ] ifFalse:[
+ "/ what should the defaultScreen be - help !!!!!!
+
+ DefaultScreen := DeviceWorkstation allSubInstances
+ detect:[:aDevice | aDevice isOpen] ifNone:nil
+ ]
]
!
@@ -4739,17 +4747,17 @@
"
myFd := self displayFileDescriptor.
[aBlock value] whileTrue:[
- self eventPending ifFalse:[
- myFd isNil ifTrue:[
- OperatingSystem millisecondDelay:50
- ] ifFalse:[
- OperatingSystem selectOn:myFd withTimeOut:50.
- ].
- Processor evaluateTimeouts.
- ].
- self eventPending ifTrue:[
- self dispatchEvent
- ].
+ self eventPending ifFalse:[
+ myFd isNil ifTrue:[
+ OperatingSystem millisecondDelay:50
+ ] ifFalse:[
+ OperatingSystem selectOn:myFd withTimeOut:50.
+ ].
+ Processor evaluateTimeouts.
+ ].
+ self eventPending ifTrue:[
+ self dispatchEvent
+ ].
]
!
@@ -4759,14 +4767,14 @@
(i.e. when in the modal debugger)"
OSSignalInterrupt handle:[:ex |
- ex return
+ ex return
] do:[
- [self eventPending] whileTrue:[
- self dispatchEventFor:nil withMask:nil.
- "/ multi-screen config: give others a chance
- "/ (needed because we run at high (non-timesliced) prio)
- Processor yield.
- ]
+ [self eventPending] whileTrue:[
+ self dispatchEventFor:nil withMask:nil.
+ "/ multi-screen config: give others a chance
+ "/ (needed because we run at high (non-timesliced) prio)
+ Processor yield.
+ ]
]
!
@@ -4785,7 +4793,7 @@
"dispose (i.e. forget) all events pending on this display"
[self eventPending] whileTrue:[
- self getEventFor:nil withMask:nil into:nil
+ self getEventFor:nil withMask:nil into:nil
].
!
@@ -4933,7 +4941,7 @@
dispatching := true.
AllScreens isNil ifTrue:[
- AllScreens := IdentitySet new:1
+ AllScreens := IdentitySet new:1
].
AllScreens add:self.
@@ -4943,9 +4951,9 @@
"/ give the process a nice name (for the processMonitor)
"/
(nm := self displayName) notNil ifTrue:[
- nm := 'event dispatcher (' , nm , ')'.
+ nm := 'event dispatcher (' , nm , ')'.
] ifFalse:[
- nm := 'event dispatcher'.
+ nm := 'event dispatcher'.
].
p name:nm.
p priority:(Processor userInterruptPriority).
@@ -4960,14 +4968,14 @@
|p|
LastActiveScreen == self ifTrue:[
- LastActiveScreen := nil.
- LastActiveProcess := nil.
+ LastActiveScreen := nil.
+ LastActiveProcess := nil.
].
(p := dispatchProcess) notNil ifTrue:[
- dispatchProcess := nil.
- p terminateWithAllSubprocessesInGroup.
- p terminateNoSignal. "/ just in case
+ dispatchProcess := nil.
+ p terminateWithAllSubprocessesInGroup.
+ p terminateNoSignal. "/ just in case
]
!
@@ -4997,34 +5005,34 @@
events.
Only a few control characters are supported.
Notice: not all alien views allow this kind of synthetic input;
- some simply ignore it."
+ some simply ignore it."
|control code state|
aCharacterOrString isString ifTrue:[
- aCharacterOrString do:[:char |
- self simulateKeyboardInput:char inViewId:viewId
- ].
- ^ self
+ aCharacterOrString do:[:char |
+ self simulateKeyboardInput:char inViewId:viewId
+ ].
+ ^ self
].
control := false.
code := aCharacterOrString codePoint.
(aCharacterOrString == Character cr) ifTrue:[
- code := #Return
+ code := #Return
] ifFalse:[
- (aCharacterOrString == Character tab) ifTrue:[
- code := #Tab
- ] ifFalse:[
- (aCharacterOrString == Character esc) ifTrue:[
- code := #Escape
- ]
- ]
+ (aCharacterOrString == Character tab) ifTrue:[
+ code := #Tab
+ ] ifFalse:[
+ (aCharacterOrString == Character esc) ifTrue:[
+ code := #Escape
+ ]
+ ]
].
control ifTrue:[
- state := self ctrlModifierMask
+ state := self ctrlModifierMask
].
@@ -5034,11 +5042,11 @@
"/ Hopefully, this is correct ...
code isNumber ifTrue:[
- code >= $A codePoint ifTrue:[
- code <= $Z codePoint ifTrue:[
- state := self shiftModifierMask
- ]
- ]
+ code >= $A codePoint ifTrue:[
+ code <= $Z codePoint ifTrue:[
+ state := self shiftModifierMask
+ ]
+ ]
].
self sendKeyOrButtonEvent:#keyPress x:0 y:0 keyOrButton:code state:state toViewId:viewId.
@@ -5129,14 +5137,14 @@
|fonts|
fonts := self fontsInFamily:aFamilyName
- filtering:[:f| f face notNil and:[filterBlock isNil or:[filterBlock value:f]]].
+ filtering:[:f| f face notNil and:[filterBlock isNil or:[filterBlock value:f]]].
fonts size == 0 ifTrue:[^ nil].
^ fonts collect:[:descr | descr face]
"
Display facesInFamily:'fixed' filtering:[:f |
- f encoding notNil and:[f encoding startsWith:'jis']]
+ f encoding notNil and:[f encoding startsWith:'jis']]
"
"Created: 27.2.1996 / 01:33:25 / cg"
@@ -5178,7 +5186,7 @@
"
Display fontFamiliesFiltering:[:f |
- f encoding notNil and:[f encoding startsWith:'jis']]
+ f encoding notNil and:[f encoding startsWith:'jis']]
"
"Modified: 29.2.1996 / 04:31:51 / cg"
@@ -5221,15 +5229,15 @@
fonts := Set new.
allFonts do:[:fntDescr |
- (aFilterBlock isNil or:[aFilterBlock value:fntDescr]) ifTrue:[
- fonts add:fntDescr
- ]
+ (aFilterBlock isNil or:[aFilterBlock value:fntDescr]) ifTrue:[
+ fonts add:fntDescr
+ ]
].
^ fonts
"
Display fontsFiltering:[:f |
- f encoding notNil and:[f encoding startsWith:'jis']]
+ f encoding notNil and:[f encoding startsWith:'jis']]
"
"Modified: 29.2.1996 / 04:30:35 / cg"
@@ -5334,12 +5342,12 @@
"/ for backward comaptibility - will vanish
^ self
- getFontWithFamily:familyString
- face:faceString
- style:styleString
- size:sizeArg
- sizeUnit:#px
- encoding:encodingSym
+ getFontWithFamily:familyString
+ face:faceString
+ style:styleString
+ size:sizeArg
+ sizeUnit:#px
+ encoding:encodingSym
!
getFontWithFamily:familyString face:faceString style:styleString size:sizeArg encoding:encodingSym
@@ -5348,12 +5356,12 @@
If no font fits, return nil"
^ self
- getFontWithFamily:familyString
- face:faceString
- style:styleString
- size:sizeArg
- sizeUnit:#pt
- encoding:encodingSym
+ getFontWithFamily:familyString
+ face:faceString
+ style:styleString
+ size:sizeArg
+ sizeUnit:#pt
+ encoding:encodingSym
!
getFontWithFamily:familyString face:faceString style:styleString size:sizeArg sizeUnit:sizeUnit encoding:encodingSym
@@ -5377,7 +5385,7 @@
sz := aString size.
sz == 0 ifTrue:[
- ^ 0.
+ ^ 0.
].
^ self heightOf:aString from:1 to:sz inFont:aFontId
!
@@ -5450,18 +5458,18 @@
|fonts|
fonts := self
- fontsInFamily:aFamilyName face:aFaceName style:aStyleName
- filtering:[:f |
- f size notNil
- and:[filterBlock isNil or:[filterBlock value:f]]
- ].
+ fontsInFamily:aFamilyName face:aFaceName style:aStyleName
+ filtering:[:f |
+ f size notNil
+ and:[filterBlock isNil or:[filterBlock value:f]]
+ ].
fonts size == 0 ifTrue:[^ nil].
^ fonts collect:[:descr | descr size].
"
Display sizesInFamily:'fixed' face:'medium' style:'roman' filtering:[:f |
- f encoding notNil and:[f encoding startsWith:'jis']]
+ f encoding notNil and:[f encoding startsWith:'jis']]
"
"Created: 27.2.1996 / 01:37:56 / cg"
@@ -5488,18 +5496,18 @@
|fonts|
fonts := self
- fontsInFamily:aFamilyName face:aFaceName
- filtering:[:f|
- f style notNil
- and:[filterBlock isNil or:[filterBlock value:f]]
- ].
+ fontsInFamily:aFamilyName face:aFaceName
+ filtering:[:f|
+ f style notNil
+ and:[filterBlock isNil or:[filterBlock value:f]]
+ ].
fonts size == 0 ifTrue:[^ nil].
^ fonts collect:[:descr | descr style]
"
Display stylesInFamily:'fixed' face:'medium' filtering:[:f |
- f encoding notNil and:[f encoding startsWith:'jis']]
+ f encoding notNil and:[f encoding startsWith:'jis']]
"
"Created: 27.2.1996 / 01:35:22 / cg"
@@ -5546,12 +5554,12 @@
Return true if ok, false if it failed for some reason."
activeKeyboardGrab notNil ifTrue:[
- self ungrabKeyboard.
- activeKeyboardGrab := nil
+ self ungrabKeyboard.
+ activeKeyboardGrab := nil
].
(self grabKeyboardIn:(aView id)) ifTrue:[
- activeKeyboardGrab := aView.
- ^ true
+ activeKeyboardGrab := aView.
+ ^ true
].
^ false
!
@@ -5592,20 +5600,20 @@
|cId vId ok|
activePointerGrab notNil ifTrue:[
- self ungrabPointer.
- activePointerGrab := nil
+ self ungrabPointer.
+ activePointerGrab := nil
].
vId := aView id.
aCursorOrNil notNil ifTrue:[
- cId := aCursorOrNil id.
- ok := self grabPointerIn:vId withCursorId:cId.
+ cId := aCursorOrNil id.
+ ok := self grabPointerIn:vId withCursorId:cId.
] ifFalse:[
- ok := self grabPointerIn:vId.
+ ok := self grabPointerIn:vId.
].
ok ifTrue:[
- activePointerGrab := aView.
- ^ true
+ activePointerGrab := aView.
+ ^ true
].
^ false
!
@@ -5648,17 +5656,17 @@
|colorId deviceColor|
(color isOnDevice:self) ifTrue:[
- colorId := color colorId.
+ colorId := color colorId.
] ifFalse:[
- deviceColor := color onDevice:self.
- deviceColor notNil ifTrue:[
- colorId := deviceColor colorId.
- ]
+ deviceColor := color onDevice:self.
+ deviceColor notNil ifTrue:[
+ colorId := deviceColor colorId.
+ ]
].
colorId isNil ifTrue:[
- 'DeviceWorkstation [warning]: could not set bg color' infoPrintCR.
+ 'DeviceWorkstation [warning]: could not set bg color' infoPrintCR.
] ifFalse:[
- self setBackground:colorId in:aGCId.
+ self setBackground:colorId in:aGCId.
]
!
@@ -5722,17 +5730,17 @@
|colorId deviceColor|
(color isOnDevice:self) ifTrue:[
- colorId := color colorId.
+ colorId := color colorId.
] ifFalse:[
- deviceColor := color onDevice:self.
- deviceColor notNil ifTrue:[
- colorId := deviceColor colorId.
- ]
+ deviceColor := color onDevice:self.
+ deviceColor notNil ifTrue:[
+ colorId := deviceColor colorId.
+ ]
].
colorId isNil ifTrue:[
- 'DeviceWorkstation [warning]: could not set fg color' infoPrintCR.
+ 'DeviceWorkstation [warning]: could not set fg color' infoPrintCR.
] ifFalse:[
- self setForeground:colorId in:aGCId.
+ self setForeground:colorId in:aGCId.
]
!
@@ -5770,7 +5778,7 @@
addModalWindowListener:aListener
aboutToOpenModalWindowHooks isNil ifTrue:[
- aboutToOpenModalWindowHooks := IdentitySet new.
+ aboutToOpenModalWindowHooks := IdentitySet new.
].
aboutToOpenModalWindowHooks add:aListener
@@ -5779,7 +5787,7 @@
addNonModalWindowListener:aListener
aboutToOpenNonModalWindowHooks isNil ifTrue:[
- aboutToOpenNonModalWindowHooks := IdentitySet new.
+ aboutToOpenNonModalWindowHooks := IdentitySet new.
].
aboutToOpenNonModalWindowHooks add:aListener
@@ -5792,7 +5800,7 @@
modalWindowListenersDo:aBlock
aboutToOpenModalWindowHooks notNil ifTrue:[
- aboutToOpenModalWindowHooks do:aBlock
+ aboutToOpenModalWindowHooks do:aBlock
].
"
@@ -5804,7 +5812,7 @@
nonModalWindowListenersDo:aBlock
aboutToOpenNonModalWindowHooks notNil ifTrue:[
- aboutToOpenNonModalWindowHooks do:aBlock
+ aboutToOpenNonModalWindowHooks do:aBlock
].
"Created: / 24-10-2010 / 14:58:43 / cg"
@@ -5838,43 +5846,43 @@
"the connection to the display device was lost."
dispatching ifTrue:[
- 'DeviceWorkstation [info]: finished dispatch (broken connection): ' infoPrint.
- self infoPrintCR.
- dispatching := false.
+ 'DeviceWorkstation [info]: finished dispatch (broken connection): ' infoPrint.
+ self infoPrintCR.
+ dispatching := false.
].
self emergencyCloseConnection.
displayId := nil.
LastActiveScreen == self ifTrue:[
- LastActiveScreen := nil.
- LastActiveProcess := nil.
+ LastActiveScreen := nil.
+ LastActiveProcess := nil.
].
"/ tell all of my top views about this.
self allTopViews do:[:eachTopView |
- |wg sensor model|
-
- "notice: we must manually wakeup the windowGroup process here
- (it might be waiting on an event,
- and the destroy below is executed by another thread.
- Otherwise, the windowGroup process would
- not terminate itself in this case."
-
- (wg := eachTopView windowGroup) notNil ifTrue:[
- sensor := wg sensor
- ].
- eachTopView destroyed.
-
- "the #destroyed above should release the application model - but is doesn't
- yet (2006-10) - so we do it here"
- model := eachTopView model.
- model notNil ifTrue:[
- model release.
- ].
- sensor notNil ifTrue:[
- sensor eventSemaphore signal.
- ].
+ |wg sensor model|
+
+ "notice: we must manually wakeup the windowGroup process here
+ (it might be waiting on an event,
+ and the destroy below is executed by another thread.
+ Otherwise, the windowGroup process would
+ not terminate itself in this case."
+
+ (wg := eachTopView windowGroup) notNil ifTrue:[
+ sensor := wg sensor
+ ].
+ eachTopView destroyed.
+
+ "the #destroyed above should release the application model - but is doesn't
+ yet (2006-10) - so we do it here"
+ model := eachTopView model.
+ model notNil ifTrue:[
+ model release.
+ ].
+ sensor notNil ifTrue:[
+ sensor eventSemaphore signal.
+ ].
].
self releaseDeviceResources.
@@ -5888,12 +5896,12 @@
self releaseDeviceResources.
self closeConnection.
dispatching ifTrue:[
- 'DeviceWorkstation [info]: finished dispatch (close): ' infoPrint.
- self infoPrintCR.
- dispatching := false.
+ 'DeviceWorkstation [info]: finished dispatch (close): ' infoPrint.
+ self infoPrintCR.
+ dispatching := false.
].
dispatchProcess notNil ifTrue:[
- dispatchProcess terminate.
+ dispatchProcess terminate.
].
"Modified: 13.1.1997 / 22:13:18 / cg"
@@ -5922,7 +5930,7 @@
event dispatching should stop when the last view is closed."
self == Display ifTrue:[
- ExitOnLastClose := aBoolean
+ ExitOnLastClose := aBoolean
].
exitOnLastClose := aBoolean
@@ -5941,10 +5949,10 @@
isSlow := false.
motionEventCompression := true.
buttonTranslation isNil ifTrue:[
- buttonTranslation := ButtonTranslation.
+ buttonTranslation := ButtonTranslation.
].
multiClickTimeDelta isNil ifTrue:[
- multiClickTimeDelta := MultiClickTimeDelta.
+ multiClickTimeDelta := MultiClickTimeDelta.
].
shiftDown := false.
ctrlDown := false.
@@ -5958,9 +5966,9 @@
"initialize heavily used device resources - to avoid looking them up later"
blackColor isNil ifTrue:[
- blackColor := Color black onDevice:self.
- whiteColor := Color white onDevice:self.
- Color getPrimaryColorsOn:self.
+ blackColor := Color black onDevice:self.
+ whiteColor := Color white onDevice:self.
+ Color getPrimaryColorsOn:self.
]
"Modified: 24.2.1997 / 22:07:50 / cg"
@@ -5993,8 +6001,8 @@
"
keyboardMap isNil ifTrue:[
- keyboardMap := KeyboardMap new.
- self initializeDefaultKeyboardMappingsIn:keyboardMap
+ keyboardMap := KeyboardMap new.
+ self initializeDefaultKeyboardMappingsIn:keyboardMap
].
"
@@ -6019,7 +6027,7 @@
"setup screen specific properties."
supportsDeepIcons isNil ifTrue:[
- supportsDeepIcons := true.
+ supportsDeepIcons := true.
].
fixColors := fixGrayColors := ditherColors := nil.
@@ -6035,13 +6043,13 @@
"late viewStyle init - if no viewStyle has been read yet."
self class currentScreenQuerySignal answer:self do:[
- SimpleView styleSheet isNil ifTrue:[
- SimpleView readStyleSheetAndUpdateAllStyleCaches
- ] ifFalse:[
- "maybe some view classes have been loaded and theit styles have to
- be initialized"
- SimpleView updateAllStyleCaches.
- ].
+ SimpleView styleSheet isNil ifTrue:[
+ SimpleView readStyleSheetAndUpdateAllStyleCaches
+ ] ifFalse:[
+ "maybe some view classes have been loaded and theit styles have to
+ be initialized"
+ SimpleView updateAllStyleCaches.
+ ].
].
!
@@ -6067,10 +6075,10 @@
self reinitialize.
blackColor notNil ifTrue:[
- blackColor releaseFromDevice.
+ blackColor releaseFromDevice.
].
whiteColor notNil ifTrue:[
- whiteColor releaseFromDevice.
+ whiteColor releaseFromDevice.
].
self releaseDeviceFonts.
self releaseDeviceCursors.
@@ -6095,7 +6103,7 @@
self initializeFor:aDisplayName.
displayId isNil ifTrue:[
- ^ nil
+ ^ nil
].
"
@@ -6107,50 +6115,50 @@
"/ prevMapping notNil ifTrue:[
prevKnownViews notNil ifTrue:[
- "
- first round: flush all device specific stuff
- "
+ "
+ first round: flush all device specific stuff
+ "
"/ prevMapping keysAndValuesDo:[:anId :aView |
- prevKnownViews do:[:aView |
- (aView notNil and:[aView ~~ 0]) ifTrue:[
- aView prepareForReinit
- ]
- ].
-
- "
- 2nd round: all views should reinstall themself
- on the new display
- "
+ prevKnownViews do:[:aView |
+ (aView notNil and:[aView ~~ 0]) ifTrue:[
+ aView prepareForReinit
+ ]
+ ].
+
+ "
+ 2nd round: all views should reinstall themself
+ on the new display
+ "
"/ prevMapping keysAndValuesDo:[:anId :aView |
- prevKnownViews do:[:aView |
- (aView notNil and:[aView ~~ 0]) ifTrue:[
- "have to re-create the view"
- "abortAll is handled, but not asked for here!!"
- (UserInterrupt, AbortAllOperationRequest) catch:[
- GraphicsContext drawingOnClosedDrawableSignal handle:[:ex |
- 'DeviceWorkstation [warning]: drawing attempt on closed drawable during reinit' errorPrintCR.
- ex return
- ] do:[
- aView reinitialize
- ]
- ]
- ]
- ].
-
- (prevWidth ~~ width
- or:[prevHeight ~~ height]) ifTrue:[
- "
- 3rd round: all views get a chance to handle
- changed environment (colors, font sizes etc)
- "
+ prevKnownViews do:[:aView |
+ (aView notNil and:[aView ~~ 0]) ifTrue:[
+ "have to re-create the view"
+ "abortAll is handled, but not asked for here!!"
+ (UserInterrupt, AbortAllOperationRequest) catch:[
+ GraphicsContext drawingOnClosedDrawableSignal handle:[:ex |
+ 'DeviceWorkstation [warning]: drawing attempt on closed drawable during reinit' errorPrintCR.
+ ex return
+ ] do:[
+ aView reinitialize
+ ]
+ ]
+ ]
+ ].
+
+ (prevWidth ~~ width
+ or:[prevHeight ~~ height]) ifTrue:[
+ "
+ 3rd round: all views get a chance to handle
+ changed environment (colors, font sizes etc)
+ "
"/ prevMapping keysAndValuesDo:[:anId :aView |
- prevKnownViews do:[:aView |
- (aView notNil and:[aView ~~ 0]) ifTrue:[
- aView reAdjustGeometry
- ]
- ].
- ]
+ prevKnownViews do:[:aView |
+ (aView notNil and:[aView ~~ 0]) ifTrue:[
+ aView reAdjustGeometry
+ ]
+ ].
+ ]
].
dispatching := false.
@@ -6163,20 +6171,20 @@
(i.e. be prepared to not be able to release resources regularily)"
LastActiveScreen == self ifTrue:[
- LastActiveScreen := nil.
- LastActiveProcess := nil.
+ LastActiveScreen := nil.
+ LastActiveProcess := nil.
].
Image releaseResourcesOnDevice:self.
"This unregisters all the finalization handles"
DeviceGraphicsContext releaseResourcesOnDevice:self.
blackColor notNil ifTrue:[
- blackColor releaseFromDevice.
- blackColor := nil.
+ blackColor releaseFromDevice.
+ blackColor := nil.
].
whiteColor notNil ifTrue:[
- whiteColor releaseFromDevice.
- whiteColor := nil.
+ whiteColor releaseFromDevice.
+ whiteColor := nil.
].
self releaseDeviceColors.
self releaseDeviceCursors.
@@ -6236,42 +6244,42 @@
root foreground:blackColor background:whiteColor.
root xoring:[
- |left right top bottom newOrigin newCorner p|
-
- rect := origin extent:extent.
- root displayRectangle:rect.
-
- prevGrab := activePointerGrab.
- self grabPointerInView:root withCursor:curs.
-
- [self leftButtonPressed] whileTrue:[
- newOrigin := self pointerPosition.
-
- (newOrigin ~= origin) ifTrue:[
- root displayRectangle:rect.
-
- self
- grabPointerIn:root id
- withCursor:curs id
- pointerMode:#async
- keyboardMode:#sync
- confineTo:nil.
-
- rect := newOrigin extent:extent.
- root displayRectangle:rect.
- self disposeButtonEventsFor:nil.
- self flush.
- origin := newOrigin.
- ] ifFalse:[
- Delay waitForSeconds:0.05
- ]
- ].
- root displayRectangle:rect.
+ |left right top bottom newOrigin newCorner p|
+
+ rect := origin extent:extent.
+ root displayRectangle:rect.
+
+ prevGrab := activePointerGrab.
+ self grabPointerInView:root withCursor:curs.
+
+ [self leftButtonPressed] whileTrue:[
+ newOrigin := self pointerPosition.
+
+ (newOrigin ~= origin) ifTrue:[
+ root displayRectangle:rect.
+
+ self
+ grabPointerIn:root id
+ withCursor:curs id
+ pointerMode:#async
+ keyboardMode:#sync
+ confineTo:nil.
+
+ rect := newOrigin extent:extent.
+ root displayRectangle:rect.
+ self disposeButtonEventsFor:nil.
+ self flush.
+ origin := newOrigin.
+ ] ifFalse:[
+ Delay waitForSeconds:0.05
+ ]
+ ].
+ root displayRectangle:rect.
].
self ungrabPointer.
prevGrab notNil ifTrue:[
- self grabPointerInView:prevGrab.
+ self grabPointerInView:prevGrab.
].
"flush all events pending on my display"
@@ -6311,8 +6319,8 @@
Show aCursor while waiting."
^ self
- pointFromUserShowing:aCursor
- positionFeedback:nil
+ pointFromUserShowing:aCursor
+ positionFeedback:nil
"
Display pointFromUserShowing:(Cursor stop)
@@ -6436,9 +6444,9 @@
doRegrab := self class ~~ WinWorkstation.
keepExtent ifTrue:[
- curs1 := Cursor origin
+ curs1 := Cursor origin
] ifFalse:[
- curs1 := Cursor corner
+ curs1 := Cursor corner
].
curs1 := curs1 onDevice:self.
root := self rootView.
@@ -6452,91 +6460,91 @@
root foreground:blackColor background:whiteColor.
root xoring:[
- |left right top bottom newOrigin newCorner p curs|
-
- keepExtent ifFalse:[
- corner := origin.
- rect := origin corner:corner.
- root displayRectangle:rect.
- ].
-
- prevGrab := activePointerGrab.
- self grabPointerInView:root withCursor:curs1.
-
- "
- just in case; wait for button to be down ...
- "
- [self leftButtonPressed] whileFalse:[Delay waitForSeconds:0.05].
-
- keepExtent ifTrue:[
- p := self pointerPosition.
- origin := p.
- corner := origin + initialRectangle extent.
- rect := origin corner:corner.
- root displayRectangle:rect.
- ].
-
- [self leftButtonPressed] whileTrue:[
- left := initialRectangle origin x.
- top := initialRectangle origin y.
- right := initialRectangle corner x.
- bottom := initialRectangle corner y.
-
- p := self pointerPosition.
- keepExtent ifTrue:[
- newOrigin := p.
- newCorner := newOrigin + initialRectangle extent.
- curs := curs1.
- ] ifFalse:[
- p x < initialRectangle left ifTrue:[
- p y < initialRectangle top ifTrue:[
- curs := Cursor topLeft.
- left := p x.
- top := p y.
- ] ifFalse:[
- curs := Cursor bottomLeft.
- left := p x.
- bottom := p y
- ]
- ] ifFalse:[
- p y < initialRectangle top ifTrue:[
- curs := Cursor topRight.
- right := p x.
- top := p y
- ] ifFalse:[
- curs := Cursor bottomRight.
- right := p x.
- bottom := p y
- ]
- ].
-
- newOrigin := left @ top.
- newCorner := right @ bottom.
- ].
-
- ((newOrigin ~= origin) or:[newCorner ~= corner]) ifTrue:[
- root displayRectangle:rect.
- doRegrab ifTrue:[
- self grabPointerInView:root withCursor:curs1.
- ].
-
- origin := newOrigin.
- corner := newCorner.
- rect := origin corner:corner.
- root displayRectangle:rect.
- self disposeButtonEventsFor:nil.
- self flush.
- ] ifFalse:[
- Delay waitForSeconds:0.05
- ]
- ].
- root displayRectangle:rect.
+ |left right top bottom newOrigin newCorner p curs|
+
+ keepExtent ifFalse:[
+ corner := origin.
+ rect := origin corner:corner.
+ root displayRectangle:rect.
+ ].
+
+ prevGrab := activePointerGrab.
+ self grabPointerInView:root withCursor:curs1.
+
+ "
+ just in case; wait for button to be down ...
+ "
+ [self leftButtonPressed] whileFalse:[Delay waitForSeconds:0.05].
+
+ keepExtent ifTrue:[
+ p := self pointerPosition.
+ origin := p.
+ corner := origin + initialRectangle extent.
+ rect := origin corner:corner.
+ root displayRectangle:rect.
+ ].
+
+ [self leftButtonPressed] whileTrue:[
+ left := initialRectangle origin x.
+ top := initialRectangle origin y.
+ right := initialRectangle corner x.
+ bottom := initialRectangle corner y.
+
+ p := self pointerPosition.
+ keepExtent ifTrue:[
+ newOrigin := p.
+ newCorner := newOrigin + initialRectangle extent.
+ curs := curs1.
+ ] ifFalse:[
+ p x < initialRectangle left ifTrue:[
+ p y < initialRectangle top ifTrue:[
+ curs := Cursor topLeft.
+ left := p x.
+ top := p y.
+ ] ifFalse:[
+ curs := Cursor bottomLeft.
+ left := p x.
+ bottom := p y
+ ]
+ ] ifFalse:[
+ p y < initialRectangle top ifTrue:[
+ curs := Cursor topRight.
+ right := p x.
+ top := p y
+ ] ifFalse:[
+ curs := Cursor bottomRight.
+ right := p x.
+ bottom := p y
+ ]
+ ].
+
+ newOrigin := left @ top.
+ newCorner := right @ bottom.
+ ].
+
+ ((newOrigin ~= origin) or:[newCorner ~= corner]) ifTrue:[
+ root displayRectangle:rect.
+ doRegrab ifTrue:[
+ self grabPointerInView:root withCursor:curs1.
+ ].
+
+ origin := newOrigin.
+ corner := newCorner.
+ rect := origin corner:corner.
+ root displayRectangle:rect.
+ self disposeButtonEventsFor:nil.
+ self flush.
+ ] ifFalse:[
+ Delay waitForSeconds:0.05
+ ]
+ ].
+ root displayRectangle:rect.
].
self ungrabPointer.
prevGrab notNil ifTrue:[
- self grabPointerInView:prevGrab
+ self grabPointerInView:prevGrab
].
"flush all events pending on my display"
@@ -6569,7 +6577,7 @@
v := self viewFromUser.
v notNil ifTrue:[
- v := v topView
+ v := v topView
].
^ v
@@ -6674,19 +6682,19 @@
Called with every keyPress/keyRelease to update the xxxDown flags."
(altModifiers notNil and:[altModifiers includes:key]) ifTrue:[
- altDown := pressed
+ altDown := pressed
] ifFalse:[
- (metaModifiers notNil and:[metaModifiers includes:key]) ifTrue:[
- metaDown := pressed
- ] ifFalse:[
- (shiftModifiers notNil and:[shiftModifiers includes:key]) ifTrue:[
- shiftDown := pressed
- ] ifFalse:[
- (ctrlModifiers notNil and:[ctrlModifiers includes:key]) ifTrue:[
- ctrlDown := pressed
- ]
- ]
- ]
+ (metaModifiers notNil and:[metaModifiers includes:key]) ifTrue:[
+ metaDown := pressed
+ ] ifFalse:[
+ (shiftModifiers notNil and:[shiftModifiers includes:key]) ifTrue:[
+ shiftDown := pressed
+ ] ifFalse:[
+ (ctrlModifiers notNil and:[ctrlModifiers includes:key]) ifTrue:[
+ ctrlDown := pressed
+ ]
+ ]
+ ]
]
"Modified: 2.1.1996 / 15:00:25 / cg"
@@ -6699,26 +6707,26 @@
|t modifiers|
key == #Alt ifTrue:[
- modifiers := altModifiers
+ modifiers := altModifiers
] ifFalse:[
- key == #Cmd ifTrue:[
- modifiers := metaModifiers
- ]
+ key == #Cmd ifTrue:[
+ modifiers := metaModifiers
+ ]
].
"/ temporary kludge ...
(modifiers size > 0) ifTrue:[
- (modifiers includes:'Num_Lock') ifTrue:[
- modifiers := modifiers copyWithout:'Num_Lock'
- ]
+ (modifiers includes:'Num_Lock') ifTrue:[
+ modifiers := modifiers copyWithout:'Num_Lock'
+ ]
].
(modifiers size > 0) ifTrue:[
- t := modifiers first.
- (t includes:$_) ifTrue:[
- t := t copyTo:(t indexOf:$_)-1
- ].
- ^ t
+ t := modifiers first.
+ (t includes:$_) ifTrue:[
+ t := t copyTo:(t indexOf:$_)-1
+ ].
+ ^ t
].
^ key
@@ -6736,45 +6744,45 @@
(untranslatedKey == #Control
or:[untranslatedKey == #'Control_L'
or:[untranslatedKey == #'Control_R']]) ifTrue:[
- ^ #Ctrl
+ ^ #Ctrl
].
(untranslatedKey == #Ctrl
or:[untranslatedKey == #'Ctrl_L'
or:[untranslatedKey == #'Ctrl_R']]) ifTrue:[
- ^ #Ctrl
+ ^ #Ctrl
].
(untranslatedKey == #'Shift'
or:[untranslatedKey == #'Shift_L'
or:[untranslatedKey == #'Shift_R']]) ifTrue:[
- ^ #Shift
+ ^ #Shift
].
(untranslatedKey == #'Alt'
or:[untranslatedKey == #'Alt_L'
or:[untranslatedKey == #'Alt_R']]) ifTrue:[
- ^ #Alt
+ ^ #Alt
].
(untranslatedKey == #'Meta'
or:[untranslatedKey == #'Meta_L'
or:[untranslatedKey == #'Meta_R']]) ifTrue:[
- ^ #Meta
+ ^ #Meta
].
(untranslatedKey == #'Cmd'
or:[untranslatedKey == #'Cmd_L'
or:[untranslatedKey == #'Cmd_R']]) ifTrue:[
- ^ #Cmd
+ ^ #Cmd
].
(untranslatedKey == #'Super'
or:[untranslatedKey == #'Super_L'
or:[untranslatedKey == #'Super_R']]) ifTrue:[
- ^ #Super
+ ^ #Super
].
"/ I know - this is stupid; however the tradition was Cmd for this...
(untranslatedKey == #'Menu'
or:[untranslatedKey == #'Menu_L'
or:[untranslatedKey == #'Menu_R']]) ifTrue:[
- ^ #Cmd
+ ^ #Cmd
].
^ nil
@@ -6800,13 +6808,13 @@
|xlatedKey s modifier|
(ctrlDown and:[ metaDown ]) ifTrue:[
- "/ right-ALT: already xlated (I hope)
- ^ untranslatedKey
+ "/ right-ALT: already xlated (I hope)
+ ^ untranslatedKey
].
xlatedKey := untranslatedKey.
xlatedKey isCharacter ifFalse:[
- xlatedKey := xlatedKey asSymbol
+ xlatedKey := xlatedKey asSymbol
].
modifier := self modifierKeyTranslationFor:untranslatedKey.
@@ -6819,37 +6827,37 @@
"/ only prepend, if this is not a modifier (otherwise, we get CmdCmd or CtrlCtrl)
"/
modifier isNil ifTrue:[
- s := xlatedKey asString.
-
- "/ NO, do not prepend the Shift modifier.
- "/ although logical, this makes many keyPress methods incompatible.
- "/ sigh.
+ s := xlatedKey asString.
+
+ "/ NO, do not prepend the Shift modifier.
+ "/ although logical, this makes many keyPress methods incompatible.
+ "/ sigh.
"/ xlatedKey isSymbol ifTrue:[
"/ shiftDown ifTrue:[
"/ xlatedKey := 'Shift' , s
"/ ].
"/ ].
- ctrlDown ifTrue:[
- xlatedKey := 'Ctrl' , s
- ].
- metaDown ifTrue:[ "/ sigh - new hp's have both CMD and META keys.
- xlatedKey := 'Cmd' , s
- ].
- altDown ifTrue:[
- xlatedKey := 'Alt' , s
- ].
- xlatedKey isCharacter ifFalse:[
- "/ no - breaks a lot of code which is not prepared for that
- "/ and checks shiftDown instead...
- "/ shiftDown ifTrue:[
- "/ xlatedKey := 'Shift' , s
- "/].
-
- "/ sigh: twoByteSymbols are not (yet) allowed
- xlatedKey isWideString ifFalse:[
- xlatedKey := xlatedKey asSymbol
- ].
- ].
+ ctrlDown ifTrue:[
+ xlatedKey := 'Ctrl' , s
+ ].
+ metaDown ifTrue:[ "/ sigh - new hp's have both CMD and META keys.
+ xlatedKey := 'Cmd' , s
+ ].
+ altDown ifTrue:[
+ xlatedKey := 'Alt' , s
+ ].
+ xlatedKey isCharacter ifFalse:[
+ "/ no - breaks a lot of code which is not prepared for that
+ "/ and checks shiftDown instead...
+ "/ shiftDown ifTrue:[
+ "/ xlatedKey := 'Shift' , s
+ "/].
+
+ "/ sigh: twoByteSymbols are not (yet) allowed
+ xlatedKey isWideString ifFalse:[
+ xlatedKey := xlatedKey asSymbol
+ ].
+ ].
].
^ xlatedKey
@@ -6885,11 +6893,11 @@
xlatedKey := aView keyboardMap valueFor:xlatedKey.
xlatedKey notNil ifTrue:[
- xlatedKey isCharacter ifFalse:[
- xlatedKey isWideString ifFalse:[
- xlatedKey := xlatedKey asSymbol
- ]
- ]
+ xlatedKey isCharacter ifFalse:[
+ xlatedKey isWideString ifFalse:[
+ xlatedKey := xlatedKey asSymbol
+ ]
+ ]
].
^ xlatedKey
@@ -6977,7 +6985,7 @@
"output an audible beep or bell"
UserPreferences current beepEnabled ifTrue:[
- Stdout nextPut:(Character bell)
+ Stdout nextPut:(Character bell)
]
"Modified: / 13.1.1997 / 22:56:13 / cg"
@@ -7036,11 +7044,11 @@
setOfViews := self knownViews.
setOfViews do:[:aView |
- aView shown ifTrue:[
- aView isRootView ifFalse:[
- aView clearView; invalidate
- ]
- ]
+ aView shown ifTrue:[
+ aView isRootView ifFalse:[
+ aView clearView; invalidate
+ ]
+ ]
]
"
@@ -7065,13 +7073,13 @@
newBits := ByteArray new:(bytesPerLineWanted * height).
srcIndex := dstIndex := 1.
1 to:height do:[:row |
- newBits
- replaceFrom:dstIndex
- to:(dstIndex + bytesPerLineWanted - 1)
- with:givenBits
- startingAt:srcIndex.
- dstIndex := dstIndex + bytesPerLineWanted.
- srcIndex := srcIndex + bytesPerLineGiven.
+ newBits
+ replaceFrom:dstIndex
+ to:(dstIndex + bytesPerLineWanted - 1)
+ with:givenBits
+ startingAt:srcIndex.
+ dstIndex := dstIndex + bytesPerLineWanted.
+ srcIndex := srcIndex + bytesPerLineGiven.
].
^ newBits.
@@ -7308,11 +7316,11 @@
aStream nextPut:$(.
(name := self displayName) isNil ifTrue:[
- name := 'defaultDisplay'
+ name := 'defaultDisplay'
].
aStream nextPutAll:name.
self isOpen ifFalse:[
- aStream nextPutAll:' - closed'.
+ aStream nextPutAll:' - closed'.
].
aStream nextPut:$).
! !
@@ -7377,12 +7385,12 @@
in advance, since the X-server is free to return whatever it thinks is a good padding."
^ self
- getBitsFromId:aDrawableId
- x:srcx
- y:srcy
- width:w
- height:h
- into:imageBits
+ getBitsFromId:aDrawableId
+ x:srcx
+ y:srcy
+ width:w
+ height:h
+ into:imageBits
"Created: 19.3.1997 / 13:43:04 / cg"
"Modified: 19.3.1997 / 13:43:38 / cg"
@@ -7396,12 +7404,12 @@
in advance, since the X-server is free to return whatever it thinks is a good padding."
^ self
- getBitsFromId:aDrawableId
- x:srcx
- y:srcy
- width:w
- height:h
- into:imageBits
+ getBitsFromId:aDrawableId
+ x:srcx
+ y:srcy
+ width:w
+ height:h
+ into:imageBits
"Created: 19.3.1997 / 13:43:04 / cg"
"Modified: 19.3.1997 / 13:43:42 / cg"
@@ -7426,45 +7434,45 @@
where the systemDefaults are used ..."
<resource: #style (#viewSpacing
- #borderColor #borderWidth
- #viewBackgroundColor #shadowColor #lightColor
- )>
+ #borderColor #borderWidth
+ #viewBackgroundColor #shadowColor #lightColor
+ )>
aKey == #viewSpacing ifTrue:[
- ^ self verticalPixelPerMillimeter rounded "/ 1 millimeter
+ ^ self verticalPixelPerMillimeter rounded "/ 1 millimeter
].
aKey == #borderColor ifTrue:[
- ^ Color black
+ ^ Color black
].
aKey == #borderWidth ifTrue:[
- ^ 1
+ ^ 1
].
aKey == #shadowColor ifTrue:[
- ^ Color black
+ ^ Color black
].
aKey == #lightColor ifTrue:[
- ^ Color white
+ ^ Color white
].
aKey == #viewBackgroundColor ifTrue:[
- ^ Color white
+ ^ Color white
].
aKey == #scrollerViewBackgroundColor ifTrue:[
- ^ Color white
+ ^ Color white
].
aKey == #textForegroundColor ifTrue:[
- ^ Color black.
+ ^ Color black.
].
aKey == #textBackgroundColor ifTrue:[
- ^ Color white.
+ ^ Color white.
].
aKey == #selectionForegroundColor ifTrue:[
- ^ Color white.
+ ^ Color white.
].
aKey == #selectionBackgroundColor ifTrue:[
- ^ Color black.
+ ^ Color black.
].
^ nil.
@@ -7524,49 +7532,49 @@
wasBlocked := OperatingSystem blockInterrupts.
knownViews isNil ifTrue:[
- knownViews := WeakArray new:50.
- knownIds := Array new:50.
- freeIdx := 1.
+ knownViews := WeakArray new:50.
+ knownIds := Array new:50.
+ freeIdx := 1.
] ifFalse:[
- knownIndex := knownViews identityIndexOf: aView.
- knownIndex ~~ 0 ifTrue:[
- knownIds at:knownIndex put:aWindowID.
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- ^self.
- ].
- freeIdx := knownViews identityIndexOf:nil.
- freeIdx == 0 ifTrue:[
- freeIdx := knownViews identityIndexOf:0.
- [freeIdx ~~ 0
- and:[(knownIds at:freeIdx) notNil]] whileTrue:[
- "/ mhmh - the view is already clear in the weakArray
- "/ but the id is not.
- "/ (i.e. its collected, but not yet finalized)
- "/ skip this entry.
- "/ 'XXX ' print. (knownIds at:freeIdx) displayString printCR.
- freeIdx := knownViews identityIndexOf:0 startingAt:(freeIdx + 1).
- ].
- ].
+ knownIndex := knownViews identityIndexOf: aView.
+ knownIndex ~~ 0 ifTrue:[
+ knownIds at:knownIndex put:aWindowID.
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ ^self.
+ ].
+ freeIdx := knownViews identityIndexOf:nil.
+ freeIdx == 0 ifTrue:[
+ freeIdx := knownViews identityIndexOf:0.
+ [freeIdx ~~ 0
+ and:[(knownIds at:freeIdx) notNil]] whileTrue:[
+ "/ mhmh - the view is already clear in the weakArray
+ "/ but the id is not.
+ "/ (i.e. its collected, but not yet finalized)
+ "/ skip this entry.
+ "/ 'XXX ' print. (knownIds at:freeIdx) displayString printCR.
+ freeIdx := knownViews identityIndexOf:0 startingAt:(freeIdx + 1).
+ ].
+ ].
].
freeIdx == 0 ifTrue:[
- sz := knownViews size.
- newSize := sz * 2.
- newArr := WeakArray new:newSize.
- newArr replaceFrom:1 to:sz with:knownViews.
- knownViews := newArr.
-
- newArr := Array new:newSize.
- newArr replaceFrom:1 to:sz with:knownIds.
- knownIds := newArr.
- freeIdx := sz + 1.
+ sz := knownViews size.
+ newSize := sz * 2.
+ newArr := WeakArray new:newSize.
+ newArr replaceFrom:1 to:sz with:knownViews.
+ knownViews := newArr.
+
+ newArr := Array new:newSize.
+ newArr replaceFrom:1 to:sz with:knownIds.
+ knownIds := newArr.
+ freeIdx := sz + 1.
].
knownViews at:freeIdx put:aView.
knownIds at:freeIdx put:aWindowID.
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
idToTableIndexMapping notNil ifTrue:[
- idToTableIndexMapping at:aWindowID put:freeIdx.
+ idToTableIndexMapping at:aWindowID put:freeIdx.
].
"/ dispatching ifFalse:[
@@ -7594,80 +7602,80 @@
lastId := nil.
lastView := nil.
focusView == aView ifTrue:[
- focusView := nil
+ focusView := nil
].
knownViews notNil ifTrue:[
- wasBlocked := OperatingSystem blockInterrupts.
-
- index := 0.
- aViewId notNil ifTrue:[
- idToTableIndexMapping notNil ifTrue:[
- index := idToTableIndexMapping at:aViewId ifAbsent:0.
- ]
- ].
- index == 0 ifTrue:[
- aView notNil ifTrue:[
- index := knownViews identityIndexOf:aView.
- ].
- ].
-
- index ~~ 0 ifTrue:[
- idToTableIndexMapping notNil ifTrue:[
- aViewId notNil ifTrue:[
- idToTableIndexMapping removeKey:aViewId ifAbsent:nil
- ] ifFalse:[
- id := knownIds at:index.
- id notNil ifTrue:[
- idToTableIndexMapping removeKey:id ifAbsent:nil.
- ]
- ]
- ].
- knownViews at:index put:nil.
- knownIds at:index put:nil.
- lastId := nil.
- lastView := nil.
- ].
-
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
-
- (aView notNil and:[aView isTopView]) ifTrue:[
- "/ check for sparsely filled knownViews - array
- wasBlocked := OperatingSystem blockInterrupts.
- n := 0.
- knownViews do:[:v |
- (v notNil and:[v ~~ 0]) ifTrue:[
- n := n + 1
- ].
- ].
- n < (knownViews size * 2 // 3) ifTrue:[
- newSize := n * 3 // 2.
- newSize > 50 ifTrue:[
- nV := WeakArray new:newSize.
- nI := Array new:newSize.
- dstIdx := 1.
- 1 to:knownViews size do:[:srcIdx |
- v := knownViews at:srcIdx.
- (v notNil and:[v ~~ 0]) ifTrue:[
- nV at:dstIdx put:v.
- nI at:dstIdx put:(knownIds at:srcIdx).
- dstIdx := dstIdx + 1.
- ].
- ].
- idToTableIndexMapping := nil.
- knownViews := nV.
- knownIds := nI.
- idToTableIndexMapping := Dictionary new.
- knownIds keysAndValuesDo:[:idx :id |
- id notNil ifTrue:[
- idToTableIndexMapping at:id put:idx
- ]
- ].
- ].
- ].
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- self checkForEndOfDispatch.
- ].
+ wasBlocked := OperatingSystem blockInterrupts.
+
+ index := 0.
+ aViewId notNil ifTrue:[
+ idToTableIndexMapping notNil ifTrue:[
+ index := idToTableIndexMapping at:aViewId ifAbsent:0.
+ ]
+ ].
+ index == 0 ifTrue:[
+ aView notNil ifTrue:[
+ index := knownViews identityIndexOf:aView.
+ ].
+ ].
+
+ index ~~ 0 ifTrue:[
+ idToTableIndexMapping notNil ifTrue:[
+ aViewId notNil ifTrue:[
+ idToTableIndexMapping removeKey:aViewId ifAbsent:nil
+ ] ifFalse:[
+ id := knownIds at:index.
+ id notNil ifTrue:[
+ idToTableIndexMapping removeKey:id ifAbsent:nil.
+ ]
+ ]
+ ].
+ knownViews at:index put:nil.
+ knownIds at:index put:nil.
+ lastId := nil.
+ lastView := nil.
+ ].
+
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+
+ (aView notNil and:[aView isTopView]) ifTrue:[
+ "/ check for sparsely filled knownViews - array
+ wasBlocked := OperatingSystem blockInterrupts.
+ n := 0.
+ knownViews do:[:v |
+ (v notNil and:[v ~~ 0]) ifTrue:[
+ n := n + 1
+ ].
+ ].
+ n < (knownViews size * 2 // 3) ifTrue:[
+ newSize := n * 3 // 2.
+ newSize > 50 ifTrue:[
+ nV := WeakArray new:newSize.
+ nI := Array new:newSize.
+ dstIdx := 1.
+ 1 to:knownViews size do:[:srcIdx |
+ v := knownViews at:srcIdx.
+ (v notNil and:[v ~~ 0]) ifTrue:[
+ nV at:dstIdx put:v.
+ nI at:dstIdx put:(knownIds at:srcIdx).
+ dstIdx := dstIdx + 1.
+ ].
+ ].
+ idToTableIndexMapping := nil.
+ knownViews := nV.
+ knownIds := nI.
+ idToTableIndexMapping := Dictionary new.
+ knownIds keysAndValuesDo:[:idx :id |
+ id notNil ifTrue:[
+ idToTableIndexMapping at:id put:idx
+ ]
+ ].
+ ].
+ ].
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ self checkForEndOfDispatch.
+ ].
]
"Created: 22.3.1997 / 14:56:20 / cg"
@@ -7680,37 +7688,37 @@
|index v idx|
aWindowID = lastId ifTrue:[
- lastView notNil ifTrue:[
- ^ lastView
- ]
+ lastView notNil ifTrue:[
+ ^ lastView
+ ]
].
idToTableIndexMapping notNil ifTrue:[
- idx := idToTableIndexMapping at:aWindowID ifAbsent:nil.
- idx notNil ifTrue:[
- v := knownViews at:idx.
- (v notNil and:[v ~~ 0]) ifTrue:[
- lastView := v.
- lastId := aWindowID.
- ^ v
- ].
- ]
+ idx := idToTableIndexMapping at:aWindowID ifAbsent:nil.
+ idx notNil ifTrue:[
+ v := knownViews at:idx.
+ (v notNil and:[v ~~ 0]) ifTrue:[
+ lastView := v.
+ lastId := aWindowID.
+ ^ v
+ ].
+ ]
].
knownIds isNil ifTrue:[
- ^ nil
+ ^ nil
].
index := knownIds indexOf:aWindowID.
index == 0 ifTrue:[
- ^ nil
+ ^ nil
].
v := knownViews at:index.
v == 0 ifTrue:[
- knownViews at:index put:nil.
- knownIds at:index put:nil.
- ^ nil
+ knownViews at:index put:nil.
+ knownIds at:index put:nil.
+ ^ nil
].
lastId := aWindowID.
@@ -7727,20 +7735,20 @@
|index v|
aWindowID = lastId ifTrue:[
- lastView notNil ifTrue:[
- ^ true
- ]
+ lastView notNil ifTrue:[
+ ^ true
+ ]
].
idToTableIndexMapping notNil ifTrue:[
- index := idToTableIndexMapping at:aWindowID ifAbsent:nil.
+ index := idToTableIndexMapping at:aWindowID ifAbsent:nil.
].
index isNil ifTrue:[
- index := knownIds indexOf:aWindowID.
+ index := knownIds indexOf:aWindowID.
].
index ~~ 0 ifTrue:[
- v := knownViews at:index.
- ^ (v notNil and:[v ~~ 0])
+ v := knownViews at:index.
+ ^ (v notNil and:[v ~~ 0])
].
^ false.
@@ -7786,12 +7794,12 @@
"/ use mapView:...minWidth:minHeight:maxWidth:maxHeight:
^ self
- mapView:aView id:aWindowId iconified:aBoolean atX:xPos y:yPos
- width:w height:h minExtent:nil maxExtent:nil
+ mapView:aView id:aWindowId iconified:aBoolean atX:xPos y:yPos
+ width:w height:h minExtent:nil maxExtent:nil
!
mapView:aView id:aWindowId iconified:aBoolean atX:xPos y:yPos
- width:w height:h minExtent:minExt maxExtent:maxExt
+ width:w height:h minExtent:minExt maxExtent:maxExt
"make a window visible - either as icon or as a real view - needed for restart"
^ self subclassResponsibility
@@ -7867,17 +7875,17 @@
This undoes the effect of #setCursors:"
knownViews notNil ifTrue:[
- knownViews validElementsDo:[:aView |
- |c vid cid|
-
- (vid := aView id) notNil ifTrue:[
- c := aView cursor.
- (c notNil and:[(cid := c id) notNil]) ifTrue:[
- self setCursor:cid in:vid
- ]
- ]
- ].
- self flush
+ knownViews validElementsDo:[:aView |
+ |c vid cid|
+
+ (vid := aView id) notNil ifTrue:[
+ c := aView cursor.
+ (c notNil and:[(cid := c id) notNil]) ifTrue:[
+ self setCursor:cid in:vid
+ ]
+ ]
+ ].
+ self flush
]
"
@@ -7925,14 +7933,14 @@
id := (aCursor onDevice:self) id.
id notNil ifTrue:[
- knownViews validElementsDo:[:aView |
- |vid|
-
- (vid := aView id) notNil ifTrue:[
- self setCursor:id in:vid
- ]
- ].
- self flush
+ knownViews validElementsDo:[:aView |
+ |vid|
+
+ (vid := aView id) notNil ifTrue:[
+ self setCursor:id in:vid
+ ]
+ ].
+ self flush
]
"
@@ -8047,9 +8055,9 @@
"define a bitmap to be used as icon"
self
- setWindowIcon:aForm
- mask:nil
- in:aWindowId
+ setWindowIcon:aForm
+ mask:nil
+ in:aWindowId
!
setWindowIcon:aForm mask:aMaskForm in:aWindowId
@@ -8071,12 +8079,12 @@
|minW minH maxW maxH|
minExt notNil ifTrue:[
- minW := minExt x.
- minH := minExt y.
+ minW := minExt x.
+ minH := minExt y.
].
maxExt notNil ifTrue:[
- maxW := maxExt x.
- maxH := maxExt y.
+ maxW := maxExt x.
+ maxH := maxExt y.
].
self setWindowMinExtentX:minW y:minH maxExtentX:maxW y:maxH in:aWindowId
!
@@ -8263,11 +8271,11 @@
!DeviceWorkstation class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.594 2013-10-28 11:38:42 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.595 2013-10-30 08:49:34 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.594 2013-10-28 11:38:42 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/DeviceWorkstation.st,v 1.595 2013-10-30 08:49:34 cg Exp $'
! !