--- a/DeviceWorkstation.st Thu Jul 23 12:45:09 2015 +0200
+++ b/DeviceWorkstation.st Thu Jul 23 12:52:19 2015 +0200
@@ -1585,20 +1585,20 @@
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:[
- offset1 := w1 origin.
- w1 := w1 container.
+ offset1 := w1 origin.
+ w1 := w1 container.
].
w2 isView ifTrue:[
- offset2 := 0
+ offset2 := 0
] ifFalse:[
- offset2 := w2 origin.
- w2 := w2 container.
+ offset2 := w2 origin.
+ w2 := w2 container.
].
devicePoint := self translatePoint:aPoint from:(w1 id) to:(w2 id).
devicePoint isNil ifTrue:[ ^ aPoint].
@@ -2843,7 +2843,7 @@
"For given symbolic or raw key, return a user-friendly shortcut description string.
Examples:
#Find -> Ctrl+f (depending on your settings)
- #CtrlX -> Ctrl+X
+ #CtrlX -> Ctrl+X
This method is used in menu panel (#shortcutKeyAsString) to display shortcuts in menus.
"
@@ -2857,11 +2857,11 @@
untranslatedKeys := OrderedCollection new.
self keyboardMap keysAndValuesDo:[:k :v | v == symbolicOrRawKey ifTrue:[untranslatedKeys add:k]].
untranslatedKeys size == 0 ifTrue:[
- "/ if its not an explicit command key (Ctrl-*, Alt-* or Cmd-*),
- "/ but a symbolic key, return nil.
- (#('Cmd' 'Ctrl' 'Alt' 'Meta' 'Shift')
- contains:[:k | (symbolicOrRawKey startsWith:k) ])
- ifFalse:[^ nil].
+ "/ if its not an explicit command key (Ctrl-*, Alt-* or Cmd-*),
+ "/ but a symbolic key, return nil.
+ (#('Cmd' 'Ctrl' 'Alt' 'Meta' 'Shift')
+ contains:[:k | (symbolicOrRawKey startsWith:k) ])
+ ifFalse:[^ nil].
"/ (aSymbolicKey startsWith:'Cmd') ifFalse:[
"/ (aSymbolicKey startsWith:'Ctrl') ifFalse:[
@@ -2874,48 +2874,48 @@
"/ ].
"/ ].
"/ ].
- 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
"
- Screen current shortKeyStringFor: #Find
+ Screen current shortKeyStringFor: #Find
Screen current shortKeyStringFor: #CtrlX
Screen current shortKeyStringFor: #CursorLeft
"
@@ -3354,16 +3354,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 id.
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'
].
!
@@ -3531,9 +3531,9 @@
colorScaledRed:red scaledGreen:green scaledBlue:blue
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:'only supported for trueColor displays'
@@ -3614,61 +3614,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
!
@@ -4311,16 +4311,16 @@
!DeviceWorkstation methodsFor:'error handling'!
-primitiveFailedOrClosedConnection
+primitiveFailedOrClosedConnection
"sent by all primitives here, when something is wrong.
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
!
@@ -4334,32 +4334,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
! !
@@ -4440,8 +4440,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
!
@@ -4614,15 +4614,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
@@ -4695,7 +4695,7 @@
addToKnownScreens
AllScreens isNil ifTrue:[
- AllScreens := IdentitySet new:1
+ AllScreens := IdentitySet new:1
].
AllScreens add:self.
!
@@ -4717,7 +4717,7 @@
"/ if there is no non-popup topview, stop dispatching
(knownViews contains:[:slot |
slot notNil
- and:[slot ~~ 0
+ and:[slot class ~~ SmallInteger
and:[(self viewIsRelevantInCheckForEndOfDispatch:slot)
and:[true "slot isModal not"
"and:[slot realized]"]]]])
@@ -4780,14 +4780,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:[
@@ -4798,12 +4798,12 @@
"/ ].
"/ ].
"/ ].
- dispatching ifFalse:[^ self].
- ].
- dispatching ifTrue:[
- self dispatchPendingEvents.
- ].
- ]
+ dispatching ifFalse:[^ self].
+ ].
+ dispatching ifTrue:[
+ self dispatchPendingEvents.
+ ].
+ ]
]
"Modified: / 09-02-2011 / 13:59:43 / cg"
@@ -5027,9 +5027,9 @@
"/ give the process a nice name (for the processMonitor)
"/
(nm := self displayName) notNil ifTrue:[
- nm := 'event dispatcher (' , nm , ')'.
+ nm := 'event dispatcher (' , nm , ')'.
] ifFalse:[
- nm := 'event dispatcher'.
+ nm := 'event dispatcher'.
].
p name:nm.
p priority:(Processor userInterruptPriority).
@@ -5544,18 +5544,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"
@@ -6225,7 +6225,7 @@
"
"/ prevMapping keysAndValuesDo:[:anId :aView |
prevKnownViews do:[:aView |
- (aView notNil and:[aView ~~ 0]) ifTrue:[
+ (aView notNil and:[aView class ~~ SmallInteger]) ifTrue:[
aView prepareForReinit
]
].
@@ -6237,7 +6237,7 @@
"/ prevMapping keysAndValuesDo:[:anId :aView |
prevKnownViews do:[:aView |
- (aView notNil and:[aView ~~ 0]) ifTrue:[
+ (aView notNil and:[aView class ~~ SmallInteger]) ifTrue:[
"have to re-create the view"
"abortAll is handled, but not asked for here!!"
(UserInterrupt, AbortAllOperationRequest) catch:[
@@ -6259,7 +6259,7 @@
"
"/ prevMapping keysAndValuesDo:[:anId :aView |
prevKnownViews do:[:aView |
- (aView notNil and:[aView ~~ 0]) ifTrue:[
+ (aView notNil and:[aView class ~~ SmallInteger]) ifTrue:[
aView reAdjustGeometry
]
].
@@ -6923,13 +6923,13 @@
|xlatedKey s modifier k|
(ctrlDown and:[ metaDown ]) ifTrue:[
- "/ right-ALT: already xlated (I hope)
- ^ untranslatedKey
+ "/ right-ALT: already xlated (I hope)
+ ^ untranslatedKey
].
xlatedKey := untranslatedKey.
xlatedKey isCharacter ifFalse:[
- xlatedKey := xlatedKey asSymbol
+ xlatedKey := xlatedKey asSymbol
].
modifier := self modifierKeyTranslationFor:untranslatedKey.
@@ -6942,45 +6942,45 @@
"/ only prepend, if this is not a modifier (otherwise, we get CmdCmd or CtrlCtrl)
"/
modifier isNil ifTrue:[
- s := xlatedKey asString.
-
- "/ NO, do not prepend the Shift modifier.
- "/ although logical, this makes many keyPress methods incompatible.
- "/ sigh.
+ s := xlatedKey asString.
+
+ "/ NO, do not prepend the Shift modifier.
+ "/ although logical, this makes many keyPress methods incompatible.
+ "/ sigh.
"/ xlatedKey isSymbol ifTrue:[
"/ shiftDown ifTrue:[
"/ xlatedKey := 'Shift' , s
"/ ].
"/ ].
- ctrlDown ifTrue:[
- xlatedKey := 'Ctrl' , s
- ].
- metaDown ifTrue:[ "/ sigh - new hp's have both CMD and META keys.
- xlatedKey := 'Cmd' , s
- ].
- altDown ifTrue:[
- xlatedKey := 'Alt' , s
- ].
- xlatedKey isCharacter ifFalse:[
- "/ 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
@@ -7108,7 +7108,7 @@
"{ Pragma: +optSpace }"
UserPreferences current beepEnabled ifTrue:[
- Stdout nextPut:(Character bell)
+ Stdout nextPut:(Character bell)
]
"Modified: / 13.1.1997 / 22:56:13 / cg"
@@ -7701,7 +7701,7 @@
].
freeIdx := knownViews identityIndexOf:nil.
freeIdx == 0 ifTrue:[
- freeIdx := knownViews identityIndexOf:0.
+ freeIdx := knownViews findFirst:[:slot | slot class == SmallInteger].
[freeIdx ~~ 0
and:[(knownIds at:freeIdx) notNil]] whileTrue:[
"/ mhmh - the view is already clear in the weakArray
@@ -7709,7 +7709,7 @@
"/ (i.e. its collected, but not yet finalized)
"/ skip this entry.
"/ 'XXX ' print. (knownIds at:freeIdx) displayString printCR.
- freeIdx := knownViews identityIndexOf:0 startingAt:(freeIdx + 1).
+ freeIdx := knownViews findFirst:[:slot | slot class == SmallInteger] startingAt:(freeIdx + 1).
].
].
].
@@ -7760,87 +7760,87 @@
lastId := nil.
lastView := nil.
focusView == aView ifTrue:[
- focusView := nil
+ focusView := nil
].
knownViews notNil ifTrue:[
- wasBlocked := OperatingSystem blockInterrupts.
-
- viewToRemove := aView.
- index := 0.
- aViewId notNil ifTrue:[
- idToTableIndexMapping notNil ifTrue:[
- index := idToTableIndexMapping at:aViewId ifAbsent:0.
- ]
- ].
- index == 0 ifTrue:[
- viewToRemove notNil ifTrue:[
- index := knownViews identityIndexOf:viewToRemove.
- ].
- ] ifFalse:[
- viewToRemove isNil ifTrue:[
- viewToRemove := knownViews at:index ifAbsent:nil.
- ].
- ].
-
- index ~~ 0 ifTrue:[
- idToTableIndexMapping notNil ifTrue:[
- aViewId notNil ifTrue:[
- idToTableIndexMapping removeKey:aViewId ifAbsent:nil
- ] ifFalse:[
- id := knownIds at:index.
- id notNil ifTrue:[
- idToTableIndexMapping removeKey:id ifAbsent:nil.
- ]
- ]
- ].
- knownViews at:index put:nil.
- knownIds at:index put:nil.
- lastId := nil.
- lastView := nil.
- ].
-
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
-
- (viewToRemove notNil
- and:[ viewToRemove ~~ 0
- and:[ viewToRemove isTopView ]]) ifTrue:[
- "/ check for sparsely filled knownViews - array
- wasBlocked := OperatingSystem blockInterrupts.
- n := 0.
- knownViews do:[:v |
- (v notNil and:[v ~~ 0]) ifTrue:[
- n := n + 1
- ].
- ].
- n < (knownViews size * 2 // 3) ifTrue:[
- newSize := n * 3 // 2.
- newSize > 50 ifTrue:[
- nV := WeakArray new:newSize.
- nI := Array new:newSize.
- dstIdx := 1.
- 1 to:knownViews size do:[:srcIdx |
- v := knownViews at:srcIdx.
- (v notNil and:[v ~~ 0]) ifTrue:[
- nV at:dstIdx put:v.
- nI at:dstIdx put:(knownIds at:srcIdx).
- dstIdx := dstIdx + 1.
- ].
- ].
- idToTableIndexMapping := nil.
- knownViews := nV.
- knownIds := nI.
- idToTableIndexMapping := Dictionary new.
- knownIds keysAndValuesDo:[:idx :id |
- id notNil ifTrue:[
- idToTableIndexMapping at:id put:idx
- ]
- ].
- ].
- ].
- wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- self checkForEndOfDispatch.
- ].
+ wasBlocked := OperatingSystem blockInterrupts.
+
+ viewToRemove := aView.
+ index := 0.
+ aViewId notNil ifTrue:[
+ idToTableIndexMapping notNil ifTrue:[
+ index := idToTableIndexMapping at:aViewId ifAbsent:0.
+ ]
+ ].
+ index == 0 ifTrue:[
+ viewToRemove notNil ifTrue:[
+ index := knownViews identityIndexOf:viewToRemove.
+ ].
+ ] ifFalse:[
+ viewToRemove isNil ifTrue:[
+ viewToRemove := knownViews at:index ifAbsent:nil.
+ ].
+ ].
+
+ index ~~ 0 ifTrue:[
+ idToTableIndexMapping notNil ifTrue:[
+ aViewId notNil ifTrue:[
+ idToTableIndexMapping removeKey:aViewId ifAbsent:nil
+ ] ifFalse:[
+ id := knownIds at:index.
+ id notNil ifTrue:[
+ idToTableIndexMapping removeKey:id ifAbsent:nil.
+ ]
+ ]
+ ].
+ knownViews at:index put:nil.
+ knownIds at:index put:nil.
+ lastId := nil.
+ lastView := nil.
+ ].
+
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+
+ (viewToRemove notNil
+ and:[ viewToRemove class ~~ SmallInteger
+ and:[ viewToRemove isTopView ]]) ifTrue:[
+ "/ check for sparsely filled knownViews - array
+ wasBlocked := OperatingSystem blockInterrupts.
+ n := 0.
+ knownViews do:[:v |
+ (v notNil and:[v class ~~ SmallInteger]) ifTrue:[
+ n := n + 1
+ ].
+ ].
+ n < (knownViews size * 2 // 3) ifTrue:[
+ newSize := n * 3 // 2.
+ newSize > 50 ifTrue:[
+ nV := WeakArray new:newSize.
+ nI := Array new:newSize.
+ dstIdx := 1.
+ 1 to:knownViews size do:[:srcIdx |
+ v := knownViews at:srcIdx.
+ (v notNil and:[v class ~~ SmallInteger]) ifTrue:[
+ nV at:dstIdx put:v.
+ nI at:dstIdx put:(knownIds at:srcIdx).
+ dstIdx := dstIdx + 1.
+ ].
+ ].
+ idToTableIndexMapping := nil.
+ knownViews := nV.
+ knownIds := nI.
+ idToTableIndexMapping := Dictionary new.
+ knownIds keysAndValuesDo:[:idx :id |
+ id notNil ifTrue:[
+ idToTableIndexMapping at:id put:idx
+ ]
+ ].
+ ].
+ ].
+ wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
+ self checkForEndOfDispatch.
+ ].
]
"Created: 22.3.1997 / 14:56:20 / cg"
@@ -7849,43 +7849,43 @@
viewFromId:aWindowID
"given an Id, return the corresponding view.
- Return nil for unknown windows
+ Return nil for unknown windows
(can happen for external window, if a key grab is active)"
|index v idx|
aWindowID = lastId ifTrue:[
- lastView notNil ifTrue:[
- ^ lastView
- ]
+ lastView notNil ifTrue:[
+ ^ lastView
+ ]
].
idToTableIndexMapping notNil ifTrue:[
- idx := idToTableIndexMapping at:aWindowID ifAbsent:nil.
- idx notNil ifTrue:[
- v := knownViews at:idx.
- (v notNil and:[v ~~ 0]) ifTrue:[
- lastView := v.
- lastId := aWindowID.
- ^ v
- ].
- ]
+ idx := idToTableIndexMapping at:aWindowID ifAbsent:nil.
+ idx notNil ifTrue:[
+ v := knownViews at:idx.
+ (v notNil and:[v class ~~ SmallInteger]) ifTrue:[
+ lastView := v.
+ lastId := aWindowID.
+ ^ v
+ ].
+ ]
].
knownIds isNil ifTrue:[
- ^ nil
+ ^ nil
].
index := knownIds indexOf:aWindowID.
index == 0 ifTrue:[
- ^ nil
+ ^ nil
].
v := knownViews at:index.
- v == 0 ifTrue:[
- knownViews at:index put:nil.
- knownIds at:index put:nil.
- ^ nil
+ v class == SmallInteger ifTrue:[
+ knownViews at:index put:nil.
+ knownIds at:index put:nil.
+ ^ nil
].
lastId := aWindowID.
@@ -7915,7 +7915,7 @@
].
index ~~ 0 ifTrue:[
v := knownViews at:index.
- ^ (v notNil and:[v ~~ 0])
+ ^ (v notNil and:[v class ~~ SmallInteger])
].
^ false.
@@ -8100,14 +8100,14 @@
id := (aCursor onDevice:self) id.
id notNil ifTrue:[
- knownViews validElementsDo:[:aView |
- |vid|
-
- (vid := aView id) notNil ifTrue:[
- self setCursor:id in:vid
- ]
- ].
- self flush
+ knownViews validElementsDo:[:aView |
+ |vid|
+
+ (vid := aView id) notNil ifTrue:[
+ self setCursor:id in:vid
+ ]
+ ].
+ self flush
]
"