--- a/DeviceWorkstation.st Sat Nov 02 13:26:33 2019 +0100
+++ b/DeviceWorkstation.st Sat Nov 02 15:27:40 2019 +0100
@@ -2,7 +2,7 @@
"
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
@@ -22,7 +22,7 @@
resolutionHor resolutionVer lastId lastView knownViews
dispatching dispatchProcess exitOnLastClose ctrlDown leftCtrlDown
rightCtrlDown shiftDown leftShiftDown rightShiftDown metaDown
- altDown superDown motionEventCompression keyboardMap rootView
+ altDown superDown motionEventCompression keyboardMap modifiedMap rootView
isSlow activeKeyboardGrab activePointerGrab buttonTranslation
multiClickTimeDelta altModifiers metaModifiers ctrlModifiers
shiftModifiers superModifiers buttonModifiers supportsDeepIcons
@@ -57,7 +57,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
@@ -88,7 +88,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 collection of known screens
[see also:]
- GraphicsContext DeviceDrawable
- WindowSensor WindowGroup WindowEvent
- ProcessorScheduler
- PSMedium
+ GraphicsContext DeviceDrawable
+ WindowSensor WindowGroup WindowEvent
+ ProcessorScheduler
+ PSMedium
[author:]
- Claus Gittinger
+ Claus Gittinger
"
!
@@ -184,9 +184,9 @@
Individual events can be enabled or disabled.
The ones that are enabled by default are:
- keypress / keyRelease
- buttonPress / buttonRelease / buttonMotion (i.e. motion with button pressed)
- pointerEnter / pointerLeave
+ keypress / keyRelease
+ buttonPress / buttonRelease / buttonMotion (i.e. motion with button pressed)
+ pointerEnter / pointerLeave
Other events have to be enabled by sending a corresponding #enableXXXEvent
message to the view which shall receive those events.
@@ -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.
@@ -389,8 +389,8 @@
MultiClickTimeDelta := 300. "a click within 300ms is considered a double one"
CopyBufferHistorySize := 40.
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"
@@ -413,11 +413,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,
@@ -445,43 +445,43 @@
"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
- ElectronWorkstation nil
- ) 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
+ ElectronWorkstation nil
+ ) 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.
@@ -494,7 +494,7 @@
screen (if background processes ask for one)"
CurrentScreenQuerySignal isNil ifTrue:[
- DeviceWorkstation initialize
+ DeviceWorkstation initialize
].
^ CurrentScreenQuerySignal
@@ -564,7 +564,7 @@
Display := aDevice.
old ~~ aDevice ifTrue:[
- DisplayRootView initialize.
+ DisplayRootView initialize.
].
! !
@@ -574,31 +574,31 @@
"aBuffer (my current selection) as a string"
aBuffer isString ifTrue:[
- ^ aBuffer string.
+ ^ aBuffer string.
].
aBuffer isNil ifTrue:[
- ^ ''
+ ^ ''
].
aBuffer isStringCollection ifTrue:[
- ^ aBuffer
- from:1
- to:aBuffer size
- asStringWith:Character cr
- compressTabs:false
- final:nil
- withEmphasis:false.
+ ^ aBuffer
+ from:1
+ to:aBuffer size
+ asStringWith:Character cr
+ compressTabs:false
+ final:nil
+ withEmphasis:false.
].
Error handle:[:ex |
- Transcript showCR:'error while converting copyBuffer to store string: ', ex description.
- Error handle:[:ex |
- Transcript showCR:'error while converting copyBuffer to print string: ', ex description.
- ^ ''
- ] do:[
- ^ aBuffer printString
- ]
+ Transcript showCR:'error while converting copyBuffer to store string: ', ex description.
+ Error handle:[:ex |
+ Transcript showCR:'error while converting copyBuffer to print string: ', ex description.
+ ^ ''
+ ] do:[
+ ^ aBuffer printString
+ ]
] do:[
^ aBuffer storeString
]
@@ -624,9 +624,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.
@@ -638,20 +638,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 ...
@@ -659,24 +659,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.
]].
Logger info:'%1 - %2' with:msg with:badResource.
@@ -688,75 +688,75 @@
that caused the timeout."
(errID ~~ #DisplayIOTimeoutError and:[theDevice notNil]) ifTrue:[
- p := theDevice dispatchProcess.
- (p notNil and:[p ~~ Processor activeProcess]) ifTrue:[
- Logger info:'interrupting: %1' with:p.
-
- p interruptWith:[
- (errID == #DisplayError and:[theSignal isHandled not]) ifTrue:[
- "unhandled display errors are ignored"
- ErrorPrinting ifTrue:[
- Logger error:msg.
- ].
- ] ifFalse:[
- Logger info:'raising exception ...'.
- theSignal raiseSignalWith:badResource errorString:msg.
- Logger warning:'exception returned - send brokenConnection'.
- theDevice brokenConnection.
- Logger warning:'stopping dispatch'.
- theDevice stopDispatch.
- ].
- ].
- ^ self.
+ p := theDevice dispatchProcess.
+ (p notNil and:[p ~~ Processor activeProcess]) ifTrue:[
+ Logger info:'interrupting: %1' with:p.
+
+ p interruptWith:[
+ (errID == #DisplayError and:[theSignal isHandled not]) ifTrue:[
+ "unhandled display errors are ignored"
+ ErrorPrinting ifTrue:[
+ Logger error:msg.
+ ].
+ ] ifFalse:[
+ Logger info:'raising exception ...'.
+ theSignal raiseSignalWith:badResource errorString:msg.
+ Logger warning:'exception returned - send brokenConnection'.
+ theDevice brokenConnection.
+ Logger warning:'stopping dispatch'.
+ 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:[
- Logger info:'raising signal in current process' "with:Processor activeProcess displayString".
- theSignal raiseSignalWith:badResource errorString:msg.
+ Logger info:'raising signal in current process' "with:Processor activeProcess displayString".
+ theSignal raiseSignalWith:badResource errorString:msg.
].
errID == #DisplayError ifTrue:[
- "unhandled display errors are ignored"
- ^ self.
+ "unhandled display errors are ignored"
+ ^ self.
].
theDevice notNil ifTrue:[
- Logger info:'sending #brokenConnection'.
- theDevice brokenConnection.
- theDevice dispatchProcess == Processor activeProcess ifTrue:[
- "I am running in the dispatch process
- and nobody handles theSignal, so abort the dispatcher"
-
- Logger info:'raising AbortOperationRequest'.
- 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|
+ Logger info:'sending #brokenConnection'.
+ theDevice brokenConnection.
+ theDevice dispatchProcess == Processor activeProcess ifTrue:[
+ "I am running in the dispatch process
+ and nobody handles theSignal, so abort the dispatcher"
+
+ Logger info:'raising AbortOperationRequest'.
+ 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:[
- Logger info:'unwind the draw operation: %1'
- with:context methodPrintString.
+ 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:[
+ Logger info:'unwind the draw operation: %1'
+ with:context methodPrintString.
"/ context fullPrintAll.
- context unwind.
- "not reached"
- ].
- ]
+ context unwind.
+ "not reached"
+ ].
+ ]
].
Logger info:'proceeding after error'.
@@ -824,24 +824,24 @@
"/ take that ... it ought to be the 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
+ ]
].
"/
@@ -851,14 +851,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
+ ].
].
"/
@@ -868,7 +868,7 @@
"/ 'DevWorkstation [info]: cannot figure out current screen - use default' infoPrintCR.
Display isNil ifTrue:[
- 'DevWorkstation [info]: Display is nil.' infoPrintCR.
+ 'DevWorkstation [info]: Display is nil.' infoPrintCR.
].
^ Display
@@ -914,7 +914,7 @@
"look for a '-display xxx' commandline argument"
displayName := Smalltalk commandLineArgumentNamed:'-display'.
displayName isNil ifTrue:[
- displayName := OperatingSystem getEnvironment:'DISPLAY'.
+ displayName := OperatingSystem getEnvironment:'DISPLAY'.
].
^ displayName.
@@ -1001,8 +1001,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 display's 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
@@ -1020,8 +1020,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 display's 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|
@@ -1032,16 +1032,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.
@@ -1059,8 +1059,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 display's 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|
@@ -1071,7 +1071,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
@@ -1096,14 +1096,14 @@
root paint:self blackColor.
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.
]
"
@@ -1135,7 +1135,7 @@
"
Display restoreAfter:[
- Display displayOpaqueString:'hello' x:10 y:10.
+ Display displayOpaqueString:'hello' x:10 y:10.
]
"
@@ -1158,7 +1158,7 @@
"
Display restoreAfter:[
- Display displayString:'hello' x:10 y:10.
+ Display displayString:'hello' x:10 y:10.
]
"
@@ -1182,7 +1182,7 @@
"
Display restoreAfter:[
- Display fill:(10@10 corner:100@100) fillColor:Color yellow
+ Display fill:(10@10 corner:100@100) fillColor:Color yellow
]
"
@@ -1197,12 +1197,12 @@
"
Display restoreAfter:[
- Display fillWhite
+ Display fillWhite
]
"
"
Display restoreAfter:[
- Display fillWhite:(10@10 corner:100@100)
+ Display fillWhite:(10@10 corner:100@100)
]
"
@@ -1217,7 +1217,7 @@
"
Display restoreAfter:[
- Display fillWhite:(10@10 corner:100@100)
+ Display fillWhite:(10@10 corner:100@100)
]
"
@@ -1383,9 +1383,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))
!
@@ -1501,7 +1501,7 @@
It is not guaranteed, that a particular display device supports this."
rootView isNil ifTrue:[
- rootView := DisplayRootView onDevice:self
+ rootView := DisplayRootView onDevice:self
].
^ rootView
@@ -1609,22 +1609,22 @@
w2 := window2 ? self rootView.
(w1 device ~~ self or:[w2 device ~~ self]) ifTrue:[
- 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:[
- "/ can be a graphic element inside a view
- offset1 := w1 origin.
- w1 := w1 container.
+ "/ can be a graphic element inside a view
+ offset1 := w1 origin.
+ w1 := w1 container.
].
w2 isView ifTrue:[
- offset2 := 0
+ offset2 := 0
] ifFalse:[
- "/ can be a graphic element inside a view
- offset2 := w2 origin.
- w2 := w2 container.
+ "/ can be a graphic element inside a view
+ offset2 := w2 origin.
+ w2 := w2 container.
].
devicePoint := self translatePoint:aPoint from:(w1 drawableId) to:(w2 drawableId).
devicePoint isNil ifTrue:[ ^ aPoint].
@@ -1664,20 +1664,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
@@ -1697,18 +1697,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
@@ -1744,8 +1744,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
@@ -1761,8 +1761,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
@@ -1795,8 +1795,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
@@ -1812,8 +1812,8 @@
This is the same as 'Color black onDevice:device', but much faster."
blackColor isNil ifTrue:[
- "not yet initialized"
- ^ Color black onDevice:self.
+ "not yet initialized"
+ ^ Color black onDevice:self.
].
^ blackColor
@@ -2000,9 +2000,9 @@
visualType := aSymbol.
(visualType == #StaticGray or:[visualType == #GrayScale]) ifTrue:[
- hasColors := false
+ hasColors := false
] ifFalse:[
- hasColors := true
+ hasColors := true
]
!
@@ -2011,8 +2011,8 @@
This is the same as 'Color white onDevice:device', but much faster."
whiteColor isNil ifTrue:[
- "not yet initialized"
- ^ Color white onDevice:self.
+ "not yet initialized"
+ ^ Color white onDevice:self.
].
^ whiteColor
@@ -2036,9 +2036,9 @@
pos := self pointerPosition.
pos isNil ifTrue:[
- bounds := self bounds
+ bounds := self bounds
] ifFalse:[
- bounds:= self monitorBoundsAt:pos.
+ bounds:= self monitorBoundsAt:pos.
].
^ bounds center rounded.
@@ -2285,22 +2285,22 @@
|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
- ] ifFalse:[
- 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
+ ] ifFalse:[
+ preferredIconSize := 48@48
+ ].
].
^ preferredIconSize
@@ -2731,8 +2731,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"
@@ -2747,7 +2747,7 @@
is returned (happens when an additional external monitor is
connected to a retina).
Thus, you can override the resolution via:
- Display horizontalPixelPerMillimeter:pixels"
+ Display horizontalPixelPerMillimeter:pixels"
^ self horizontalPixelPerMillimeter * 25.4
@@ -2774,10 +2774,10 @@
is returned (happens when an additional external monitor is
connected to a retina).
Thus, you can override the resolution via:
- Display horizontalPixelPerMillimeter:pixels"
+ Display horizontalPixelPerMillimeter:pixels"
resolutionHor notNil ifTrue:[
- ^ resolutionHor
+ ^ resolutionHor
].
resolutionHor := (width / widthMM) asFloat.
^ resolutionHor
@@ -2800,7 +2800,7 @@
is returned (happens when an additional external monitor is
connected to a retina).
Thus, you can override the resolution via:
- Display horizontalPixelPerMillimeter:pixels"
+ Display horizontalPixelPerMillimeter:pixels"
resolutionHor := aNumber
!
@@ -2901,12 +2901,12 @@
is returned (happens when an additional external monitor is
connected to a retina).
Thus, you can override the resolution via:
- Display verticalPixelPerMillimeter:pixels"
+ Display verticalPixelPerMillimeter:pixels"
^ self verticalPixelPerMillimeter * 25.4
"
- Display verticalPixelPerInch
+ Display verticalPixelPerInch
"
"Modified (comment): / 12-04-2018 / 16:45:47 / stefan"
@@ -2921,10 +2921,10 @@
is returned (happens when an additional external monitor is
connected to a retina).
Thus, you can override the resolution via:
- Display verticalPixelPerMillimeter:pixels"
+ Display verticalPixelPerMillimeter:pixels"
resolutionVer notNil ifTrue:[
- ^ resolutionVer
+ ^ resolutionVer
].
resolutionVer := (height / heightMM) asFloat.
^ resolutionVer
@@ -2939,7 +2939,7 @@
is returned (happens when an additional external monitor is
connected to a retina).
Thus, you can override the resolution via:
- Display verticalPixelPerMillimeter:pixels"
+ Display verticalPixelPerMillimeter:pixels"
resolutionVer := aNumber
!
@@ -2996,8 +2996,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"
@@ -3078,11 +3078,11 @@
untranslatedKeys := OrderedCollection new.
self keyboardMap keysAndValuesDo:[:k :v | v == symbolicOrRawKey ifTrue:[untranslatedKeys add:k]].
untranslatedKeys size == 0 ifTrue:[
- "/ if it's not an explicit command key (Ctrl-*, Alt-* or Cmd-*),
- "/ but a symbolic key, return nil.
- (#('Cmd' 'Ctrl' 'Alt' 'Meta' 'Shift')
- contains:[:k | (symbolicOrRawKey startsWith:k) ])
- ifFalse:[^ nil].
+ "/ if it's not an explicit command key (Ctrl-*, Alt-* or Cmd-*),
+ "/ but a symbolic key, return nil.
+ (#('Cmd' 'Ctrl' 'Alt' 'Meta' 'Shift')
+ contains:[:k | (symbolicOrRawKey startsWith:k) ])
+ ifFalse:[^ nil].
"/ (aSymbolicKey startsWith:'Cmd') ifFalse:[
"/ (aSymbolicKey startsWith:'Ctrl') ifFalse:[
@@ -3095,43 +3095,43 @@
"/ ].
"/ ].
"/ ].
- untranslatedKey := symbolicOrRawKey.
+ untranslatedKey := symbolicOrRawKey.
] 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
@@ -3259,42 +3259,42 @@
iconIsImage := icon isImage. "/ could also be a pixmap (i.e. allocated inside the device)
self supportsDeepIcons ifFalse:[
- (iconsDepth ~~ 1 or:[iconIsImage]) ifTrue:[
- "/ dither to monochrome
- toMono := true.
- ]
+ (iconsDepth ~~ 1 or:[iconIsImage]) ifTrue:[
+ "/ dither to monochrome
+ toMono := true.
+ ]
] ifTrue:[
- iconsDepth == 1 ifTrue:[
- icon colorMap notNil ifTrue:[
- iconIsImage ifFalse:[
- toMono := true.
- ] ifTrue:[
- toDeep := true.
- ]
- ]
- ] ifFalse:[
- iconsDepth ~~ myDepth ifTrue:[
- iconIsImage ifFalse:[
- toMono := true.
- ] ifTrue:[
- toDeep := true.
- ]
- ]
- ]
+ iconsDepth == 1 ifTrue:[
+ icon colorMap notNil ifTrue:[
+ iconIsImage ifFalse:[
+ toMono := true.
+ ] ifTrue:[
+ toDeep := true.
+ ]
+ ]
+ ] ifFalse:[
+ iconsDepth ~~ myDepth ifTrue:[
+ iconIsImage ifFalse:[
+ toMono := true.
+ ] ifTrue:[
+ toDeep := true.
+ ]
+ ]
+ ]
].
deviceIcon := icon.
toDeep ifTrue:[
- deviceIcon := (Image implementorForDepth:myDepth) fromImage:icon.
+ deviceIcon := (Image implementorForDepth:myDepth) fromImage:icon.
] ifFalse:[
- toMono ifTrue:[
- deviceIcon := icon asMonochromeFormOn:self.
- ].
+ toMono ifTrue:[
+ deviceIcon := icon asMonochromeFormOn:self.
+ ].
].
deviceIcon notNil ifTrue:[
- "/ get a device pixmap (i.e. allocate colors & resource)
- deviceIcon := deviceIcon onDevice:self
+ "/ get a device pixmap (i.e. allocate colors & resource)
+ deviceIcon := deviceIcon onDevice:self
].
^ deviceIcon
@@ -3310,7 +3310,7 @@
self supportsIconMasks ifFalse:[^ nil].
aMask depth == 1 ifTrue:[
- ^ aMask onDevice:self.
+ ^ aMask onDevice:self.
].
^ aMask asMonochromeFormOn:self
@@ -3343,10 +3343,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
@@ -3502,12 +3502,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.
@@ -3520,13 +3520,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"
@@ -3553,7 +3553,7 @@
viewID := aView drawableId.
viewID notNil ifTrue:[ "/ if the view is not already closed
- self setClipboardObject:something owner:viewID.
+ self setClipboardObject:something owner:viewID.
]
!
@@ -3579,16 +3579,16 @@
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 drawableId.
viewID notNil ifTrue:[ "/ if the view is not already closed
- "/ TODO: should add support to pass emphasis information too
- s := s string.
- self setClipboardText:s owner:viewID.
+ "/ TODO: should add support to pass emphasis information too
+ s := s string.
+ self setClipboardText:s owner:viewID.
] ifFalse:[
- Transcript showCR:'DeviceWorkstation [warning]: setClipboardText - view has no id; selection only kept locally'
+ Transcript showCR:'DeviceWorkstation [warning]: setClipboardText - view has no id; selection only kept locally'
].
!
@@ -3642,13 +3642,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
@@ -3678,15 +3678,15 @@
depthUsed mapArray|
visualType == #DirectColor ifTrue:[
- Logger info:'directColor displays not fully supported'.
- ^ nil
+ Logger info:'directColor displays not fully supported'.
+ ^ nil
].
(visualType == #StaticGray or:[visualType == #TrueColor]) ifTrue:[
- "
- those have no colorMap - we're done
- "
- ^ nil
+ "
+ those have no colorMap - we're done
+ "
+ ^ nil
].
"
@@ -3699,12 +3699,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).
@@ -3712,9 +3712,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.
@@ -3732,10 +3732,10 @@
therefore, don't 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'
@@ -3760,9 +3760,9 @@
and the returned colorID is formed by simply packing the RGB values."
visualType == #TrueColor ifTrue:[
- ^ (((red asInteger bitShift:-8) bitShift:redShift)
- bitOr:((green asInteger bitShift:-8) bitShift:greenShift))
- bitOr:((blue asInteger bitShift:-8) bitShift:blueShift)
+ ^ (((red asInteger bitShift:-8) bitShift:redShift)
+ bitOr:((green asInteger bitShift:-8) bitShift:greenShift))
+ bitOr:((blue asInteger bitShift:-8) bitShift:blueShift)
].
self subclassResponsibility:'this fallback is only valid for trueColor displays'
@@ -3814,7 +3814,7 @@
triple := self getScaledRGBFrom:index.
triple notNil ifTrue:[
- ^ triple collect:[:val | self deviceColorValueToPercent:val]
+ ^ triple collect:[:val | self deviceColorValueToPercent:val]
].
^ nil
!
@@ -3827,7 +3827,7 @@
triple := self getRGBFrom:index.
triple notNil ifTrue:[
- ^ aBlock valueWithArguments:triple.
+ ^ aBlock valueWithArguments:triple.
].
^ nil
@@ -3844,61 +3844,61 @@
colorName := colorNameArg.
(colorName startsWith:$#) ifTrue:[
- "/ color in r/g/b hex notation
- colorName size < 7 ifTrue:[
- "/ that's an error, but some web pages do that
- colorName := '#',((colorName copyFrom:2) leftPaddedTo:6 with:$0).
- ].
- 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
+ colorName size < 7 ifTrue:[
+ "/ that's an error, but some web pages do that
+ colorName := '#',((colorName copyFrom:2) leftPaddedTo:6 with:$0).
+ ].
+ 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
!
@@ -3911,9 +3911,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
@@ -3937,7 +3937,7 @@
triple := self getScaledRGBFrom:index.
triple notNil ifTrue:[
- ^ aBlock valueWithArguments:triple.
+ ^ aBlock valueWithArguments:triple.
].
^ nil
@@ -3951,7 +3951,7 @@
triple := self getRGBFromName:colorName.
triple notNil ifTrue:[
- ^ triple collect:[:val | self percentToDeviceColorValue:val].
+ ^ triple collect:[:val | self percentToDeviceColorValue:val].
].
^ nil.
@@ -3966,7 +3966,7 @@
triple := self getScaledRGBFromName:colorName.
triple notNil ifTrue:[
- ^ aBlock valueWithArguments:triple.
+ ^ aBlock valueWithArguments:triple.
].
^ nil
!
@@ -4203,7 +4203,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
@@ -4233,11 +4233,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.
]
!
@@ -4246,13 +4246,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
@@ -4260,11 +4260,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
@@ -4291,7 +4291,7 @@
(n := xColl size) == yColl size ifFalse:[self error].
1 to:n do:[:idx |
- self displayPointX:(xColl at:idx) y:(yColl at:idx) in:aDrawableId with:aGCId
+ self displayPointX:(xColl at:idx) y:(yColl at:idx) in:aDrawableId with:aGCId
].
"Created: / 17-01-2019 / 13:09:11 / Claus Gittinger"
@@ -4313,18 +4313,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
+ ]
]
!
@@ -4343,14 +4343,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
@@ -4364,34 +4364,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
@@ -4404,12 +4404,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.
@@ -4422,23 +4422,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.
@@ -4446,21 +4446,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.
@@ -4470,21 +4470,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
@@ -4520,7 +4520,7 @@
knownTopViewsAndLabels := OrderedCollection new.
self allTopViewsFilteringWindowGroups:windowGroupFilterOrNil withLabelsDo:[:v :lbl |
- knownTopViewsAndLabels add:(lbl -> v)
+ knownTopViewsAndLabels add:(lbl -> v)
].
knownTopViewsAndLabels sort:[:a :b | a key < b key].
^ knownTopViewsAndLabels
@@ -4536,63 +4536,63 @@
|knownTopViews genLabel|
- genLabel := [:v |
- |app appName busyOrNot iconifiedOrNot
- sensor pending process|
-
- app := v application.
- appName := (app isNil
- ifTrue:['']
- ifFalse:[app class nameWithoutPrefix,': ']).
- busyOrNot := ''.
- (sensor := v windowGroup sensor) notNil ifTrue:[
- (pending := sensor pendingEvent) notNil ifTrue:[
- (Timestamp now secondDeltaFrom: pending timeStamp) > 1 ifTrue:[
- ((process := v windowGroup process) notNil and:[ process isDebugged]) ifTrue:[
- busyOrNot := ' [debug]'
- ] ifFalse:[
- busyOrNot := ' [busy]'
- ].
- busyOrNot := busyOrNot allBold allRed
- ]
- ]
- ].
- iconifiedOrNot := ''.
- v topView isCollapsed ifTrue:[
- iconifiedOrNot := ' (iconified)' withColor:Color blue.
- ].
- appName,'"',(v label ? 'aView'),'"',busyOrNot,iconifiedOrNot
- ].
+ genLabel := [:v |
+ |app appName busyOrNot iconifiedOrNot
+ sensor pending process|
+
+ app := v application.
+ appName := (app isNil
+ ifTrue:['']
+ ifFalse:[app class nameWithoutPrefix,': ']).
+ busyOrNot := ''.
+ (sensor := v windowGroup sensor) notNil ifTrue:[
+ (pending := sensor pendingEvent) notNil ifTrue:[
+ (Timestamp now secondDeltaFrom: pending timeStamp) > 1 ifTrue:[
+ ((process := v windowGroup process) notNil and:[ process isDebugged]) ifTrue:[
+ busyOrNot := ' [debug]'
+ ] ifFalse:[
+ busyOrNot := ' [busy]'
+ ].
+ busyOrNot := busyOrNot allBold allRed
+ ]
+ ]
+ ].
+ iconifiedOrNot := ''.
+ v topView isCollapsed ifTrue:[
+ iconifiedOrNot := ' (iconified)' withColor:Color blue.
+ ].
+ appName,'"',(v label ? 'aView'),'"',busyOrNot,iconifiedOrNot
+ ].
knownTopViews := IdentitySet new.
self allViewsDo:[:aView |
- |top showIt wg|
-
- aView notNil ifTrue:[
- top := aView topView.
- (knownTopViews includes:top) ifFalse:[
- (top isDebugView) ifTrue:[
- "/ although modal, show it.
- showIt := top realized
- ] ifFalse:[
- (top isKindOf:TopView) ifTrue:[
- wg := top windowGroup.
- showIt := (wg notNil and:[wg isModal not]).
- showIt ifTrue:[
- windowGroupFilterOrNil notNil ifTrue:[
- showIt := windowGroupFilterOrNil includes:wg
- ]
- ]
- ] ifFalse:[
- showIt := false
- ].
- ].
- showIt ifTrue:[
- aBlock value: top value:(genLabel value:top).
- knownTopViews add: top.
- ]
- ]
- ]
+ |top showIt wg|
+
+ aView notNil ifTrue:[
+ top := aView topView.
+ (knownTopViews includes:top) ifFalse:[
+ (top isDebugView) ifTrue:[
+ "/ although modal, show it.
+ showIt := top realized
+ ] ifFalse:[
+ (top isKindOf:TopView) ifTrue:[
+ wg := top windowGroup.
+ showIt := (wg notNil and:[wg isModal not]).
+ showIt ifTrue:[
+ windowGroupFilterOrNil notNil ifTrue:[
+ showIt := windowGroupFilterOrNil includes:wg
+ ]
+ ]
+ ] ifFalse:[
+ showIt := false
+ ].
+ ].
+ showIt ifTrue:[
+ aBlock value: top value:(genLabel value:top).
+ knownTopViews add: top.
+ ]
+ ]
+ ]
].
"Created: / 27-04-2012 / 12:56:53 / cg"
@@ -4604,7 +4604,7 @@
(never remove elements from an enumerated collection)"
knownViews notNil ifTrue:[
- knownViews do:aBlock
+ knownViews do:aBlock
].
"
@@ -4631,11 +4631,11 @@
Check what was wrong and raise a corresponding error here."
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
].
^ self primitiveFailed
!
@@ -4649,32 +4649,32 @@
|addr|
id isNil ifTrue:[
- "nil id is no resource"
- ^ nil
+ "nil id is no resource"
+ ^ nil
].
self allViewsDo:[:aView |
- (aView drawableId = id or:[aView gcId = id]) ifTrue:[^ aView].
+ (aView drawableId = id or:[aView gcId = id]) ifTrue:[^ aView].
].
Form allSubInstancesDo:[:f |
- (f drawableId = id and:[f graphicsDevice == self]) ifTrue:[^ f]
+ (f drawableId = id and:[f graphicsDevice == self]) ifTrue:[^ f]
].
Font allInstancesDo:[:f |
- (f fontId = id and:[f graphicsDevice == self]) ifTrue:[^ f]
+ (f fontId = id and:[f graphicsDevice == self]) ifTrue:[^ f]
].
"KLUDGE: XWorkstation stores all IDs in ExternalAddresses,
- only colorId is stored as SmallInteger,
- But resourceOfLastError returns an ExternalAddress even for colors."
+ only colorId is stored as SmallInteger,
+ But resourceOfLastError returns an ExternalAddress even for colors."
(id respondsTo:#address) ifTrue:[
- addr := id address.
+ addr := id address.
].
Color allInstancesDo:[:c |
- (c graphicsDevice == self
- and:[ c colorId = id or:[ c colorId = addr ]]) ifTrue:[^ c].
+ (c graphicsDevice == self
+ and:[ c colorId = id or:[ c colorId = addr ]]) ifTrue:[^ c].
].
^ nil
! !
@@ -4685,8 +4685,8 @@
"forward a button-motion for some view"
aView isNil ifTrue:[
- "/ event arrived, after I destroyed it myself
- ^ self
+ "/ event arrived, after I destroyed it myself
+ ^ self
].
aView sensor buttonMotion:buttonAndModifierState x:x y:y view:aView
!
@@ -4695,8 +4695,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
!
@@ -4707,25 +4707,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
!
@@ -4736,17 +4736,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
!
@@ -4755,8 +4755,8 @@
"forward a configure (i.e. size or position change) 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 configureX:x y:y width:w height:h view:aView
!
@@ -4766,12 +4766,12 @@
(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
].
otherView isNil ifTrue:[
- "/ event arrived, after otherView destroyed itself
- ^ self
+ "/ event arrived, after otherView destroyed itself
+ ^ self
].
aView sensor coveredBy:otherView view:aView
!
@@ -4782,8 +4782,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
@@ -4791,7 +4791,7 @@
"/ sensor.
sensor := aView sensor.
sensor notNil ifTrue:[
- sensor destroyedView:aView
+ sensor destroyedView:aView
].
!
@@ -4799,8 +4799,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
!
@@ -4809,8 +4809,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
!
@@ -4819,8 +4819,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
!
@@ -4829,8 +4829,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
!
@@ -4840,8 +4840,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
!
@@ -4854,30 +4854,30 @@
|untranslatedKey|
untranslatedKeyArg isInteger ifTrue:[
- untranslatedKey := Character value:untranslatedKeyArg
+ untranslatedKey := Character value:untranslatedKeyArg
] ifFalse:[
- untranslatedKey := untranslatedKeyArg
+ untranslatedKey := untranslatedKeyArg
].
"/ Timestamp now print. 'X: ' print. untranslatedKey printCR.
"/ ctrl/meta-ESC give up focus& escapes an activePointerGrab
untranslatedKey == #Escape ifTrue:[
- (activePointerGrab notNil
- and:[ctrlDown or:[metaDown]]) ifTrue:[
- "/ 'Display: ungrab' printCR.
- self ungrabPointer.
- self ungrabKeyboard.
- self setInputFocusTo:nil
- ]
+ (activePointerGrab notNil
+ and:[ctrlDown or:[metaDown]]) ifTrue:[
+ "/ 'Display: ungrab' printCR.
+ self ungrabPointer.
+ self ungrabKeyboard.
+ self setInputFocusTo:nil
+ ]
].
self modifierKeyProcessing:untranslatedKey down:true.
aView isNil ifTrue:[
- "/ event arrived, after I destroyed it myself
- "/ 'Display: key for no view' printCR.
- ^ self
+ "/ event arrived, after I destroyed it myself
+ "/ 'Display: key for no view' printCR.
+ ^ self
].
"/ xlatedKey := self translateKey:untranslatedKey forView:aView.
@@ -4901,16 +4901,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.
@@ -4923,8 +4923,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
!
@@ -4936,15 +4936,15 @@
|amount|
aView isNil ifTrue:[
- "/ event arrived, after I destroyed it myself
- ^ self
+ "/ event arrived, after I destroyed it myself
+ ^ self
].
amount := amountArg.
UserPreferences current mouseWheelDirectionReversed ifTrue:[
- amount := amount negated
+ amount := amount negated
].
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
"
UserPreferences current mouseWheelDirectionReversed:true
@@ -4957,8 +4957,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
!
@@ -4967,8 +4967,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
!
@@ -4977,8 +4977,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
!
@@ -4987,8 +4987,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
!
@@ -4997,8 +4997,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.
!
@@ -5007,8 +5007,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
! !
@@ -5017,7 +5017,7 @@
addToKnownScreens
AllScreens isNil ifTrue:[
- AllScreens := IdentitySet new:1
+ AllScreens := IdentitySet new:1
].
AllScreens add:self.
!
@@ -5030,27 +5030,27 @@
dispatching ifFalse:[^ self].
(self == Display and:[ExitOnLastClose ~~ true]) ifTrue:[
- ^ self.
+ ^ self.
].
exitOnLastClose ~~ true ifTrue:[^ self].
knownViews isNil ifTrue:[
- "if knownViews is nil, no view has ever been opened, so simply return"
- ^ self.
+ "if knownViews is nil, no view has ever been opened, so simply return"
+ ^ self.
].
"if knownViews is empty, there has been an open view which is gone.
If there is no non-popup topview, stop dispatching"
(knownViews contains:[:eachKnownView |
- eachKnownView notNil
- and:[self viewIsRelevantInCheckForEndOfDispatch:eachKnownView]
+ eachKnownView notNil
+ and:[self viewIsRelevantInCheckForEndOfDispatch:eachKnownView]
]) ifFalse:[
- "/ my last view was closed
- dispatching := false.
- Logger info:'finished dispatch (last view closed): %1' with:self.
+ "/ my last view was closed
+ dispatching := false.
+ Logger info:'finished dispatch (last view closed): %1' with:self.
thisContext fullPrintAll.
- self releaseDeviceResources.
- eventSema notNil ifTrue:[eventSema signal]. "/ get dispatchLoop out of its wait...
+ self releaseDeviceResources.
+ eventSema notNil ifTrue:[eventSema signal]. "/ get dispatchLoop out of its wait...
]
"Modified: / 19-09-1995 / 11:31:54 / claus"
@@ -5060,20 +5060,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
+ ]
]
!
@@ -5100,14 +5100,14 @@
"the actual event dispatching loop."
[dispatching] whileTrue:[
- "abortAll is handled, but not asked for here!!"
- AbortAllOperationRequest handle:[:ex |
- ex return
- ] do:[
- [self eventPending] whileFalse:[
- Processor activeProcess setStateTo:#ioWait if:#active.
- eventSema wait.
- "/ a temporary hack & workaround for semaphore-bug
+ "abortAll is handled, but not asked for here!!"
+ AbortAllOperationRequest handle:[:ex |
+ ex return
+ ] do:[
+ [self eventPending] whileFalse:[
+ Processor activeProcess setStateTo:#ioWait if:#active.
+ eventSema wait.
+ "/ a temporary hack & workaround for semaphore-bug
"/ (eventSema waitWithTimeoutMs:500) isNil ifTrue:[
"/ "/ timeout
"/ eventSema wouldBlock ifFalse:[
@@ -5118,12 +5118,12 @@
"/ ].
"/ ].
"/ ].
- dispatching ifFalse:[^ self].
- ].
- dispatching ifTrue:[
- self dispatchPendingEvents.
- ].
- ]
+ dispatching ifFalse:[^ self].
+ ].
+ dispatching ifTrue:[
+ self dispatchPendingEvents.
+ ].
+ ]
]
"Modified: / 09-02-2011 / 13:59:43 / cg"
@@ -5146,17 +5146,17 @@
"
myFd := self displayFileDescriptor.
aBlock 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
+ ].
]
"Modified (format): / 07-02-2017 / 12:50:58 / stefan"
@@ -5166,14 +5166,14 @@
"go dispatch events as long as there is one."
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.
+ ]
]
"Modified (comment): / 03-05-2018 / 17:42:09 / stefan"
@@ -5194,7 +5194,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
].
!
@@ -5286,11 +5286,11 @@
"/ is available or #eventPending returns true
(fd isNil or:[ OperatingSystem isOSXlike]) ifTrue:[
- "no fd -- so have to check for input also"
- checkBlock := [self eventPending].
+ "no fd -- so have to check for input also"
+ checkBlock := [self eventPending].
] ifFalse:[
- "there is a fd, so checkblock has to check only the internal queue"
- checkBlock := [self eventQueued].
+ "there is a fd, so checkblock has to check only the internal queue"
+ checkBlock := [self eventQueued].
].
"/ handle all incoming events from the device, sitting on a semaphore.
@@ -5303,30 +5303,30 @@
Processor signal:eventSema onInput:fd orCheck:checkBlock.
DeviceIOErrorSignal handle:[:ex |
- "test for handlerBlock until the signal is changed to be class-based"
- ex creator handlerBlock notNil ifTrue:[
- ex defaultAction.
- ] ifFalse:[
- (self == self class default and:[AllScreens size == 1]) ifTrue:[
- 'DeviceWorkstation [error]: I/O error for default display - writing crash.img and exiting' _errorPrintCR.
- SnapshotError catch:[ ObjectMemory writeCrashImage ].
- Smalltalk exit:1.
- ].
- 'DeviceWorkstation [warning]: stop dispatch due to I/O error: ' errorPrint.
- self errorPrintCR.
- self brokenConnection.
- ].
- ex return.
+ "test for handlerBlock until the signal is changed to be class-based"
+ ex creator handlerBlock notNil ifTrue:[
+ ex defaultAction.
+ ] ifFalse:[
+ (self == self class default and:[AllScreens size == 1]) ifTrue:[
+ 'DeviceWorkstation [error]: I/O error for default display - writing crash.img and exiting' _errorPrintCR.
+ SnapshotError catch:[ ObjectMemory writeCrashImage ].
+ Smalltalk exit:1.
+ ].
+ 'DeviceWorkstation [warning]: stop dispatch due to I/O error: ' errorPrint.
+ self errorPrintCR.
+ self brokenConnection.
+ ].
+ ex return.
] do:[
- self initializeDeviceResources.
- [
- self dispatchLoop
- ] ifCurtailed:[
- self cleanupAfterDispatch.
- self emergencyCloseConnection.
- ].
- self cleanupAfterDispatch.
- self close.
+ self initializeDeviceResources.
+ [
+ self dispatchLoop
+ ] ifCurtailed:[
+ self cleanupAfterDispatch.
+ self emergencyCloseConnection.
+ ].
+ self cleanupAfterDispatch.
+ self close.
].
"Modified: / 29-09-2006 / 12:28:04 / cg"
@@ -5352,9 +5352,9 @@
"/ give the process a nice name (for the processMonitor)
"/
(nm := self displayName) notNil ifTrue:[
- nm := 'Display: event dispatcher (' , nm , ')'.
+ nm := 'Display: event dispatcher (' , nm , ')'.
] ifFalse:[
- nm := 'Display: event dispatcher'.
+ nm := 'Display: event dispatcher'.
].
p name:nm.
p priority:(Processor userInterruptPriority).
@@ -5371,14 +5371,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
]
!
@@ -5396,8 +5396,8 @@
exitOnLastClose flag is set."
^ aView isRootView not
- and:[ aView isTopView
- and:[ aView isPopUpView not ]]
+ and:[ aView isTopView
+ and:[ aView isPopUpView not ]]
"Modified (format): / 01-03-2019 / 11:46:12 / Stefan Vogel"
! !
@@ -5422,34 +5422,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
].
@@ -5459,11 +5459,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.
@@ -5554,14 +5554,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"
@@ -5603,7 +5603,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"
@@ -5646,15 +5646,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"
@@ -5665,15 +5665,15 @@
But only those matching filter (if nonNil)."
^ self
- fontsFiltering:[:fntDescr |
- (aFamilyName match:fntDescr family caseSensitive:false)
- and:[ (aFaceName match:fntDescr face caseSensitive:false)
- and:[ (filter isNil or:[filter value:fntDescr]) ]]
- ]
+ fontsFiltering:[:fntDescr |
+ (aFamilyName match:fntDescr family caseSensitive:false)
+ and:[ (aFaceName match:fntDescr face caseSensitive:false)
+ and:[ (filter isNil or:[filter value:fntDescr]) ]]
+ ]
"
Display fontsInFamily:'fixed' face:'medium' filtering:[:f |
- f encoding notNil and:[f encoding startsWith:'jis']]
+ f encoding notNil and:[f encoding startsWith:'jis']]
"
"Created: / 29-02-1996 / 04:32:56 / cg"
@@ -5687,20 +5687,20 @@
But only those matching filter (if nonNIl)."
^ self
- fontsFiltering:[:fntDescr |
- (aFamilyName match:fntDescr family caseSensitive:false)
- and:[ (aFaceName match:fntDescr face caseSensitive:false)
- and:[ (aStyleName match:fntDescr style caseSensitive:false)
- and:[ (filter isNil or:[filter value:fntDescr]) ]]]
- ]
+ fontsFiltering:[:fntDescr |
+ (aFamilyName match:fntDescr family caseSensitive:false)
+ and:[ (aFaceName match:fntDescr face caseSensitive:false)
+ and:[ (aStyleName match:fntDescr style caseSensitive:false)
+ and:[ (filter isNil or:[filter value:fntDescr]) ]]]
+ ]
"
Display fontsInFamily:'fixed' face:'medium' style:'roman' filtering:[:f |
- f encoding notNil and:[f encoding startsWith:'jis']]
+ f encoding notNil and:[f encoding startsWith:'jis']]
"
"
Display fontsInFamily:'fixed' face:'*' style:'roman' filtering:[:f |
- f encoding notNil and:[f encoding startsWith:'jis']]
+ f encoding notNil and:[f encoding startsWith:'jis']]
"
"
Display fontsInFamily:'courier' face:'medium' style:'roman' filtering:nil
@@ -5717,18 +5717,18 @@
But only those matching filterBlock (if nonNil)."
^ self
- fontsFiltering:[:fntDescr |
- (aFamilyName match:fntDescr family caseSensitive:false)
- and:[ (filter isNil or:[filter value:fntDescr]) ]
- ]
+ fontsFiltering:[:fntDescr |
+ (aFamilyName match:fntDescr family caseSensitive:false)
+ and:[ (filter isNil or:[filter value:fntDescr]) ]
+ ]
"
Display fontsInFamily:'fixed' filtering:[:f |
- f encoding notNil and:[f encoding startsWith:'jis']]
+ f encoding notNil and:[f encoding startsWith:'jis']]
"
"
Display fontsInFamily:'*' filtering:[:f |
- f encoding notNil and:[f encoding startsWith:'jis']]
+ f encoding notNil and:[f encoding startsWith:'jis']]
"
"Created: 29.2.1996 / 04:27:49 / cg"
@@ -5760,12 +5760,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
@@ -5774,12 +5774,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
@@ -5803,7 +5803,7 @@
sz := aString size.
sz == 0 ifTrue:[
- ^ 0.
+ ^ 0.
].
^ self heightOf:aString from:1 to:sz inFont:aFontId
!
@@ -5822,27 +5822,27 @@
|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 pixelSize "height"] thenSelect:[:pixelSize| pixelSize notNil].
"
Display
- pixelSizesInFamily:'fixed' face:'medium' style:'roman'
- filtering:[:f |
- f encoding notNil and:[f encoding startsWith:'jis']
- ]
+ pixelSizesInFamily:'fixed' face:'medium' style:'roman'
+ filtering:[:f |
+ f encoding notNil and:[f encoding startsWith:'jis']
+ ]
Display
- pixelSizesInFamily:'arial' face:'medium' style:'roman'
- filtering:[:f |
- f encoding == #'ms-ansi'
- ]
+ pixelSizesInFamily:'arial' face:'medium' style:'roman'
+ filtering:[:f |
+ f encoding == #'ms-ansi'
+ ]
"
"Created: 27.2.1996 / 01:37:56 / cg"
@@ -5876,18 +5876,18 @@
|fonts|
fonts := self
- fontsInFamily:aFamilyName face:aFaceName style:aStyleName
- filtering:[:f |
- (f size notNil or:[f isScaledFont])
- and:[filterBlock isNil or:[filterBlock value:f]]
- ].
+ fontsInFamily:aFamilyName face:aFaceName style:aStyleName
+ filtering:[:f |
+ (f size notNil or:[f isScaledFont])
+ 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"
@@ -5914,18 +5914,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-02-1996 / 01:35:22 / cg"
@@ -5975,16 +5975,16 @@
|vid|
activeKeyboardGrab notNil ifTrue:[
- self ungrabKeyboard.
- activeKeyboardGrab := nil
+ self ungrabKeyboard.
+ activeKeyboardGrab := nil
].
vid := aView drawableId.
"/ the view might be already gone...
vid notNil ifTrue:[
- (self grabKeyboardIn:vid) ifTrue:[
- activeKeyboardGrab := aView.
- ^ true
- ].
+ (self grabKeyboardIn:vid) ifTrue:[
+ activeKeyboardGrab := aView.
+ ^ true
+ ].
].
^ false
!
@@ -6025,19 +6025,19 @@
|cId vId|
activePointerGrab notNil ifTrue:[
- self ungrabPointer.
- activePointerGrab := nil
+ self ungrabPointer.
+ activePointerGrab := nil
].
vId := aView drawableId.
"/ the view might be already gone...
vId notNil ifTrue:[
- aCursorOrNil notNil ifTrue:[
- cId := aCursorOrNil id.
- ].
- (self grabPointerIn:vId withCursorId:cId) ifTrue:[
- activePointerGrab := aView.
- ^ true
- ].
+ aCursorOrNil notNil ifTrue:[
+ cId := aCursorOrNil id.
+ ].
+ (self grabPointerIn:vId withCursorId:cId) ifTrue:[
+ activePointerGrab := aView.
+ ^ true
+ ].
].
^ false
@@ -6082,17 +6082,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:[
- Logger warning:'could not set bg color'.
+ Logger warning:'could not set bg color'.
] ifFalse:[
- self setBackground:colorId in:aGCId.
+ self setBackground:colorId in:aGCId.
]
!
@@ -6165,26 +6165,26 @@
|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:[
- Logger warning:'could not set fg color'.
+ Logger warning:'could not set fg color'.
] ifFalse:[
- self setForeground:colorId in:aGCId.
+ self setForeground:colorId in:aGCId.
]
!
setFunction:aFunctionSymbol in:aGCId
"set alu function to be drawn with.
functionSymbol is one of:
- #copy,#copyInverted,#xor,#and,#andReverse
- #andInverted,#or,#orReverse,#orInverted
- #invert,#clear,#set,#noop,#equiv,#nand
+ #copy,#copyInverted,#xor,#and,#andReverse
+ #andInverted,#or,#orReverse,#orInverted
+ #invert,#clear,#set,#noop,#equiv,#nand
"
^ self subclassResponsibility
@@ -6218,7 +6218,7 @@
addModalWindowListener:aListener
aboutToOpenModalWindowHooks isNil ifTrue:[
- aboutToOpenModalWindowHooks := IdentitySet new.
+ aboutToOpenModalWindowHooks := IdentitySet new.
].
aboutToOpenModalWindowHooks add:aListener
@@ -6227,7 +6227,7 @@
addNonModalWindowListener:aListener
aboutToOpenNonModalWindowHooks isNil ifTrue:[
- aboutToOpenNonModalWindowHooks := IdentitySet new.
+ aboutToOpenNonModalWindowHooks := IdentitySet new.
].
aboutToOpenNonModalWindowHooks add:aListener
@@ -6240,7 +6240,7 @@
modalWindowListenersDo:aBlock
aboutToOpenModalWindowHooks notNil ifTrue:[
- aboutToOpenModalWindowHooks do:aBlock
+ aboutToOpenModalWindowHooks do:aBlock
].
"
@@ -6252,7 +6252,7 @@
nonModalWindowListenersDo:aBlock
aboutToOpenNonModalWindowHooks notNil ifTrue:[
- aboutToOpenNonModalWindowHooks do:aBlock
+ aboutToOpenNonModalWindowHooks do:aBlock
].
"Created: / 24-10-2010 / 14:58:43 / cg"
@@ -6260,8 +6260,8 @@
removeModalWindowListener:aListener
aboutToOpenModalWindowHooks notNil ifTrue:[
- aboutToOpenModalWindowHooks remove:aListener ifAbsent:[].
- aboutToOpenModalWindowHooks := aboutToOpenModalWindowHooks asNilIfEmpty.
+ aboutToOpenModalWindowHooks remove:aListener ifAbsent:[].
+ aboutToOpenModalWindowHooks := aboutToOpenModalWindowHooks asNilIfEmpty.
]
"Created: / 24-10-2010 / 14:58:02 / cg"
@@ -6269,8 +6269,8 @@
removeNonModalWindowListener:aListener
aboutToOpenNonModalWindowHooks notNil ifTrue:[
- aboutToOpenNonModalWindowHooks remove:aListener ifAbsent:[].
- aboutToOpenNonModalWindowHooks := aboutToOpenNonModalWindowHooks asNilIfEmpty.
+ aboutToOpenNonModalWindowHooks remove:aListener ifAbsent:[].
+ aboutToOpenNonModalWindowHooks := aboutToOpenNonModalWindowHooks asNilIfEmpty.
]
"Created: / 24-10-2010 / 14:58:19 / cg"
@@ -6301,42 +6301,42 @@
"the connection to the display device was lost."
dispatching ifTrue:[
- Logger info:'finished dispatch (broken connection): %1' with:self.
- dispatching := false.
+ Logger info:'finished dispatch (broken connection): %1' with:self.
+ 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.
@@ -6350,14 +6350,14 @@
self releaseDeviceResources.
self closeConnection.
self == Display ifTrue:[
- Display := nil.
+ Display := nil.
].
dispatching ifTrue:[
- Logger info:'finished dispatch (close): %1' with:self.
- dispatching := false.
+ Logger info:'finished dispatch (close): %1' with:self.
+ dispatching := false.
].
dispatchProcess notNil ifTrue:[
- dispatchProcess terminate.
+ dispatchProcess terminate.
].
"Modified: 13.1.1997 / 22:13:18 / cg"
@@ -6386,7 +6386,7 @@
event dispatching should stop when the last view is closed."
self == Display ifTrue:[
- ExitOnLastClose := aBoolean
+ ExitOnLastClose := aBoolean
].
exitOnLastClose := aBoolean.
@@ -6411,10 +6411,10 @@
isSlow := false.
motionEventCompression := true.
buttonTranslation isNil ifTrue:[
- buttonTranslation := ButtonTranslation.
+ buttonTranslation := ButtonTranslation.
].
multiClickTimeDelta isNil ifTrue:[
- multiClickTimeDelta := MultiClickTimeDelta.
+ multiClickTimeDelta := MultiClickTimeDelta.
].
shiftDown := leftShiftDown := rightShiftDown := false.
ctrlDown := leftCtrlDown := rightCtrlDown := false.
@@ -6430,9 +6430,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"
@@ -6465,8 +6465,8 @@
"
keyboardMap isNil ifTrue:[
- keyboardMap := KeyboardMap new.
- self initializeDefaultKeyboardMappingsIn:keyboardMap
+ keyboardMap := KeyboardMap new.
+ self initializeDefaultKeyboardMappingsIn:keyboardMap
].
"
@@ -6491,7 +6491,7 @@
"setup screen specific properties."
supportsDeepIcons isNil ifTrue:[
- supportsDeepIcons := true.
+ supportsDeepIcons := true.
].
fixColors := fixGrayColors := ditherColors := nil.
@@ -6502,8 +6502,8 @@
hasColors := hasGreyscales := true.
(visualType == #StaticGray or:[ visualType == #GrayScale]) ifTrue:[
- hasColors := false.
- monitorType := #monochrome.
+ hasColors := false.
+ monitorType := #monochrome.
].
"Modified: / 23-07-2007 / 21:19:57 / cg"
@@ -6513,13 +6513,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.
+ ].
].
!
@@ -6551,10 +6551,10 @@
self reinitialize.
blackColor notNil ifTrue:[
- blackColor releaseFromDevice.
+ blackColor releaseFromDevice.
].
whiteColor notNil ifTrue:[
- whiteColor releaseFromDevice.
+ whiteColor releaseFromDevice.
].
self releaseDeviceFonts.
self releaseDeviceCursors.
@@ -6574,7 +6574,7 @@
self initializeFor:aDisplayName.
displayId isNil ifTrue:[
- ^ nil
+ ^ nil
].
"
@@ -6585,47 +6585,47 @@
Form reinitializeAllOn:self.
prevKnownViews notNil ifTrue:[
- "
- first round: flush all device specific stuff
- "
- prevKnownViews do:[:aView |
- aView notNil ifTrue:[
- aView prepareForReinit
- ]
- ].
-
- "
- 2nd round: all views should reinstall themself
- on the new display
- "
-
- prevKnownViews do:[:aView |
- aView notNil 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 ifTrue:[
- aView reAdjustGeometry
- ]
- ].
- ]
+ "
+ first round: flush all device specific stuff
+ "
+ prevKnownViews do:[:aView |
+ aView notNil ifTrue:[
+ aView prepareForReinit
+ ]
+ ].
+
+ "
+ 2nd round: all views should reinstall themself
+ on the new display
+ "
+
+ prevKnownViews do:[:aView |
+ aView notNil 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 ifTrue:[
+ aView reAdjustGeometry
+ ]
+ ].
+ ]
].
dispatching := false.
@@ -6638,8 +6638,8 @@
(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.
@@ -6648,12 +6648,12 @@
self releaseGraphicsContexts.
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.
@@ -6714,42 +6714,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 drawableId
- 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 wait.
- ]
- ].
- 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 drawableId
+ 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 wait.
+ ]
+ ].
+ root displayRectangle:rect.
].
self ungrabPointer.
prevGrab notNil ifTrue:[
- self grabPointerInView:prevGrab.
+ self grabPointerInView:prevGrab.
].
"flush all events pending on my display"
@@ -6790,8 +6790,8 @@
Show aCursor while waiting."
^ self
- pointFromUserShowing:aCursor
- positionFeedback:nil
+ pointFromUserShowing:aCursor
+ positionFeedback:nil
"
Display pointFromUserShowing:(Cursor stop)
@@ -6823,39 +6823,39 @@
wait for no leftButton...
"
[self leftButtonPressed] whileTrue:[
- delay wait.
+ delay wait.
].
^ [
- self grabKeyboardInView:(self rootView).
-
- "
- wait for leftButton...
- ctrl, shift or escape terminate that operation
- "
- [self leftButtonPressed] whileFalse:[
- (self ctrlDown or:[self shiftDown or:[activePointerGrab == nil]]) ifTrue:[
- AbortOperationRequest raise.
- ^ nil
- ].
- feedbackBlockOrNil notNil ifTrue:[
- feedbackBlockOrNil value:(self pointerPosition)
- ].
- delay wait.
- ].
-
- self pointerPosition.
+ self grabKeyboardInView:(self rootView).
+
+ "
+ wait for leftButton...
+ ctrl, shift or escape terminate that operation
+ "
+ [self leftButtonPressed] whileFalse:[
+ (self ctrlDown or:[self shiftDown or:[activePointerGrab == nil]]) ifTrue:[
+ AbortOperationRequest raise.
+ ^ nil
+ ].
+ feedbackBlockOrNil notNil ifTrue:[
+ feedbackBlockOrNil value:(self pointerPosition)
+ ].
+ delay wait.
+ ].
+
+ self pointerPosition.
] ensure:[
- self ungrabKeyboard.
- prevKbdGrab notNil ifTrue:[
- self grabKeyboardInView:prevKbdGrab
- ].
- self ungrabPointer.
- prevGrab notNil ifTrue:[
- self grabPointerInView:prevGrab
- ].
- "flush all events pending on myself"
- self disposeButtonEventsFor:nil.
+ self ungrabKeyboard.
+ prevKbdGrab notNil ifTrue:[
+ self grabKeyboardInView:prevKbdGrab
+ ].
+ self ungrabPointer.
+ prevGrab notNil ifTrue:[
+ self grabPointerInView:prevGrab
+ ].
+ "flush all events pending on myself"
+ self disposeButtonEventsFor:nil.
].
@@ -6927,9 +6927,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.
@@ -6945,91 +6945,91 @@
delay := Delay forSeconds:0.05.
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 wait].
-
- 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 wait.
- ]
- ].
- 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 wait].
+
+ 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 wait.
+ ]
+ ].
+ root displayRectangle:rect.
].
self ungrabPointer.
prevGrab notNil ifTrue:[
- self grabPointerInView:prevGrab
+ self grabPointerInView:prevGrab
].
"flush all events pending on my display"
@@ -7063,7 +7063,7 @@
v := self viewFromUser.
v notNil ifTrue:[
- v := v topView
+ v := v topView
].
^ v
@@ -7198,23 +7198,23 @@
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.
- (key == #'Shift_L') ifTrue:[leftShiftDown := pressed].
- (key == #'Shift_R') ifTrue:[rightShiftDown := pressed].
- ] ifFalse:[
- (ctrlModifiers notNil and:[ctrlModifiers includes:key]) ifTrue:[
- ctrlDown := pressed.
- (key == #'Control_L') ifTrue:[leftCtrlDown := pressed].
- (key == #'Control_R') ifTrue:[rightCtrlDown := pressed].
- ]
- ]
- ]
+ (metaModifiers notNil and:[metaModifiers includes:key]) ifTrue:[
+ metaDown := pressed
+ ] ifFalse:[
+ (shiftModifiers notNil and:[shiftModifiers includes:key]) ifTrue:[
+ shiftDown := pressed.
+ (key == #'Shift_L') ifTrue:[leftShiftDown := pressed].
+ (key == #'Shift_R') ifTrue:[rightShiftDown := pressed].
+ ] ifFalse:[
+ (ctrlModifiers notNil and:[ctrlModifiers includes:key]) ifTrue:[
+ ctrlDown := pressed.
+ (key == #'Control_L') ifTrue:[leftCtrlDown := pressed].
+ (key == #'Control_R') ifTrue:[rightCtrlDown := pressed].
+ ]
+ ]
+ ]
]
"Modified: / 02-01-1996 / 15:00:25 / cg"
@@ -7230,34 +7230,34 @@
keyTop := key.
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
- ].
- keyTop := t.
+ t := modifiers first.
+ (t includes:$_) ifTrue:[
+ t := t copyTo:(t indexOf:$_)-1
+ ].
+ keyTop := t.
].
"/ hack: xlate 'Mode' to 'Apple-CMD'
OperatingSystem isOSXlike ifTrue:[
- keyTop = 'Mode' ifTrue:[
- keyTop := 'Cmd'.
- "/ not in our default font - sigh
- "/ keyTop := ( Character value:16r2318 ) asString.
- ].
+ keyTop = 'Mode' ifTrue:[
+ keyTop := 'Cmd'.
+ "/ not in our default font - sigh
+ "/ keyTop := ( Character value:16r2318 ) asString.
+ ].
].
^ keyTop
@@ -7275,45 +7275,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
@@ -7325,13 +7325,13 @@
"a list of possible modifiers"
^ #( #Control #'Control_L' #'Control_R'
- #Ctrl #'Ctrl_L' #'Ctrl_R'
- #'Shift' #'Shift_L' #'Shift_R'
- #'Alt' #'Alt_L' #'Alt_R'
- #'Meta' #'Meta_L' #'Meta_R'
- #'Cmd' #'Cmd_L' #'Cmd_R'
- #'Super' #'Super_L' #'Super_R'
- #'Menu' #'Menu_L' #'Menu_R'
+ #Ctrl #'Ctrl_L' #'Ctrl_R'
+ #'Shift' #'Shift_L' #'Shift_R'
+ #'Alt' #'Alt_L' #'Alt_R'
+ #'Meta' #'Meta_L' #'Meta_R'
+ #'Cmd' #'Cmd_L' #'Cmd_R'
+ #'Super' #'Super_L' #'Super_R'
+ #'Menu' #'Menu_L' #'Menu_R'
)
!
@@ -7339,8 +7339,8 @@
|xlatedKey s modifier k|
(ctrlDown and:[ metaDown ]) ifTrue:[
- "/ right-ALT: already xlated (I hope)
- ^ untranslatedKey
+ "/ right-ALT: already xlated (I hope)
+ ^ untranslatedKey
].
xlatedKey := untranslatedKey.
@@ -7354,49 +7354,49 @@
"/ only prepend, if this is not a modifier (otherwise, we get CmdCmd or CtrlCtrl)
"/
modifier notNil ifTrue:[
- xlatedKey isCharacter ifFalse:[
- xlatedKey := xlatedKey asSymbol
- ].
+ xlatedKey isCharacter ifFalse:[
+ xlatedKey := xlatedKey asSymbol
+ ].
] ifFalse:[
- 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:[
- "/ prepend Shift modifier
- "/ if done unconditionally, this breaks a lot of code.
- "/ which is not prepared for that and checks shiftDown instead.
- "/ Therefore, this must be changed at the places where shiftDown is checked for!!
- "/ In the meanwhile, only do it iff there is a translation.
- shiftDown ifTrue:[
- (k := ('Shift' , s) asSymbolIfInterned) notNil ifTrue:[
- (self keyboardMap hasBindingFor:k) ifTrue:[
- xlatedKey := k.
- "/ Transcript show:k ; show:' -> '; showCR:(self keyboardMap valueFor:k).
- ]
- ].
- ].
-
- "/ 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:[
+ "/ prepend Shift modifier
+ "/ if done unconditionally, this breaks a lot of code.
+ "/ which is not prepared for that and checks shiftDown instead.
+ "/ Therefore, this must be changed at the places where shiftDown is checked for!!
+ "/ In the meanwhile, only do it iff there is a translation.
+ shiftDown ifTrue:[
+ (k := ('Shift' , s) asSymbolIfInterned) notNil ifTrue:[
+ (self keyboardMap hasBindingFor:k) ifTrue:[
+ xlatedKey := k.
+ "/ Transcript show:k ; show:' -> '; showCR:(self keyboardMap valueFor:k).
+ ]
+ ].
+ ].
+
+ "/ sigh: twoByteSymbols are not (yet) allowed
+ xlatedKey isWideString ifFalse:[
+ xlatedKey := xlatedKey asSymbol
+ ].
+ ].
].
^ xlatedKey
@@ -7434,21 +7434,21 @@
and:[untranslatedKey first == $U
and:[(code := Integer readFrom:(untranslatedKey copyFrom:2) radix:16 onError:nil) notNil
]]]) ifTrue:[
- xlatedKey := Character value:code.
+ xlatedKey := Character value:code.
] ifFalse:[
- "/ translate via keyboardMap
- "/ Stderr show:'k1: '; showCR:xlatedKey storeString.
- xlatedKey := self prependModifierToKey:xlatedKey.
- "/ Stderr show:'k2: '; showCR:xlatedKey storeString.
- xlatedKey := aView keyboardMap valueFor:xlatedKey.
- "/ Stderr show:'k3: '; showCR:xlatedKey storeString.
- xlatedKey notNil ifTrue:[
- xlatedKey isCharacter ifFalse:[
- xlatedKey isWideString ifFalse:[
- xlatedKey := xlatedKey asSymbol.
- ]
- ]
- ].
+ "/ translate via keyboardMap
+ "/ Stderr show:'k1: '; showCR:xlatedKey storeString.
+ xlatedKey := self prependModifierToKey:xlatedKey.
+ "/ Stderr show:'k2: '; showCR:xlatedKey storeString.
+ xlatedKey := aView keyboardMap valueFor:xlatedKey.
+ "/ Stderr show:'k3: '; showCR:xlatedKey storeString.
+ xlatedKey notNil ifTrue:[
+ xlatedKey isCharacter ifFalse:[
+ xlatedKey isWideString ifFalse:[
+ xlatedKey := xlatedKey asSymbol.
+ ]
+ ]
+ ].
].
@@ -7560,7 +7560,7 @@
"{ Pragma: +optSpace }"
UserPreferences current beepEnabled ifTrue:[
- Stdout nextPut:(Character bell)
+ Stdout nextPut:(Character bell)
]
"Modified: / 13.1.1997 / 22:56:13 / cg"
@@ -7577,7 +7577,7 @@
"{ Pragma: +optSpace }"
UserPreferences current beepInEditor ifTrue:[
- self beep
+ self beep
]
"Modified: / 13.1.1997 / 22:56:13 / cg"
@@ -7654,9 +7654,9 @@
redrawAllWindows
self allViewsDo:[:eachView |
- (eachView shown and:[eachView isRootView not]) ifTrue:[
- eachView clearView; invalidate
- ].
+ (eachView shown and:[eachView isRootView not]) ifTrue:[
+ eachView clearView; invalidate
+ ].
].
"
@@ -7681,13 +7681,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.
@@ -7969,15 +7969,15 @@
aStream nextPut:$(.
self == Display ifTrue:[
- name := '= Display'
+ name := '= Display'
] ifFalse:[
- (name := self displayName) isNil ifTrue:[
- name := 'defaultName'
- ].
+ (name := self displayName) isNil ifTrue:[
+ name := 'defaultName'
+ ].
].
aStream nextPutAll:name.
self isOpen ifFalse:[
- aStream nextPutAll:' - closed'.
+ aStream nextPutAll:' - closed'.
].
aStream nextPut:$).
! !
@@ -8014,12 +8014,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"
@@ -8033,12 +8033,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"
@@ -8063,45 +8063,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:[
- ^ self blackColor
+ ^ self blackColor
].
aKey == #borderWidth ifTrue:[
- ^ 1
+ ^ 1
].
aKey == #shadowColor ifTrue:[
- ^ self blackColor
+ ^ self blackColor
].
aKey == #lightColor ifTrue:[
- ^ self whiteColor
+ ^ self whiteColor
].
aKey == #viewBackgroundColor ifTrue:[
- ^ self whiteColor
+ ^ self whiteColor
].
aKey == #scrollerViewBackgroundColor ifTrue:[
- ^ self whiteColor
+ ^ self whiteColor
].
aKey == #textForegroundColor ifTrue:[
- ^ self blackColor.
+ ^ self blackColor.
].
aKey == #textBackgroundColor ifTrue:[
- ^ self whiteColor.
+ ^ self whiteColor.
].
aKey == #selectionForegroundColor ifTrue:[
- ^ self whiteColor.
+ ^ self whiteColor.
].
aKey == #selectionBackgroundColor ifTrue:[
- ^ self blackColor.
+ ^ self blackColor.
].
^ nil.
@@ -8157,7 +8157,7 @@
the view's id (which is passed along with the devices event) quickly."
knownViews isNil ifTrue:[
- knownViews := WeakValueDictionary new:1500.
+ knownViews := WeakValueDictionary new:1500.
].
knownViews at:aWindowID put:aView.
@@ -8182,25 +8182,25 @@
|removedView|
knownViews isNil ifTrue:[
- ^ self.
+ ^ self.
].
aViewId notNil ifTrue:[
- lastId = aViewId ifTrue:[
- lastId := nil.
- lastView := nil.
- ].
- removedView := knownViews removeKey:aViewId ifAbsent:[].
+ lastId = aViewId ifTrue:[
+ lastId := nil.
+ lastView := nil.
+ ].
+ removedView := knownViews removeKey:aViewId ifAbsent:[].
] ifFalse:[
- lastView == aView ifTrue:[
- lastId := nil.
- lastView := nil.
- ].
- removedView := aView.
- knownViews removeIdentityValue:aView ifAbsent:[].
+ lastView == aView ifTrue:[
+ lastId := nil.
+ lastView := nil.
+ ].
+ removedView := aView.
+ knownViews removeIdentityValue:aView ifAbsent:[].
].
focusView == removedView ifTrue:[
- focusView := nil.
+ focusView := nil.
].
self checkForEndOfDispatch.
@@ -8217,17 +8217,17 @@
|view|
knownViews isNil ifTrue:[
- ^ nil.
+ ^ nil.
].
lastId = aWindowID ifTrue:[
- ^ lastView.
+ ^ lastView.
].
view := knownViews at:aWindowID ifAbsent:[].
view notNil ifTrue:[
- lastView := view.
- lastId := aWindowID.
+ lastView := view.
+ lastId := aWindowID.
].
^ view.
@@ -8282,12 +8282,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
@@ -8365,14 +8365,14 @@
This undoes the effect of #setCursors:"
self allViewsDo:[:aView |
- |c vid cid|
-
- (vid := aView drawableId) notNil ifTrue:[
- c := aView cursor.
- (c notNil and:[(cid := c id) notNil]) ifTrue:[
- self setCursor:cid in:vid
- ]
- ]
+ |c vid cid|
+
+ (vid := aView drawableId) notNil ifTrue:[
+ c := aView cursor.
+ (c notNil and:[(cid := c id) notNil]) ifTrue:[
+ self setCursor:cid in:vid
+ ]
+ ]
].
self flush.
@@ -8421,14 +8421,14 @@
id := (aCursor onDevice:self) id.
id notNil ifTrue:[
- self allViewsDo:[:aView |
- |vid|
-
- (vid := aView id) notNil ifTrue:[
- self setCursor:id in:vid
- ]
- ].
- self flush
+ self allViewsDo:[:aView |
+ |vid|
+
+ (vid := aView id) notNil ifTrue:[
+ self setCursor:id in:vid
+ ]
+ ].
+ self flush
]
"
@@ -8543,9 +8543,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
@@ -8567,12 +8567,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
!