--- a/DeviceWorkstation.st Sat Jul 04 16:17:13 2015 +0100
+++ b/DeviceWorkstation.st Fri Jul 24 06:59:47 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
]
"
--- a/ResourcePack.st Sat Jul 04 16:17:13 2015 +0100
+++ b/ResourcePack.st Fri Jul 24 06:59:47 2015 +0200
@@ -43,7 +43,7 @@
This class supports easy customization of smalltalk code (i.e. internationalization
and viewStyle adaption).
ResourcePacks are class specific, meaning that every subclass of View
- and ApplicationModel has an instance of ResourcePack (instVar called 'resources')
+ and ApplicationModel has an instance of ResourcePack (instVar called 'resources')
which is created when the first instance of the view/app is created,
and cached in a class-instVar (so the file is only read once).
@@ -53,31 +53,31 @@
where 'className' is built by the usual abbreviation mechanism (see abbrev-files).
Conditional mappings are possible, by including lines as:
- #if <expression>
- #endif
+ #if <expression>
+ #endif
in the resourcefile. Example:
file 'foo.rs':
- #if Language == #de
- 'abort' 'Abbruch'
- #endif
- #if Language == #fr
- 'abort' 'canceller'
- #endif
+ #if Language == #de
+ 'abort' 'Abbruch'
+ #endif
+ #if Language == #fr
+ 'abort' 'canceller'
+ #endif
the corresponding resource-strings are accessed (from methods within the class)
using:
- resources string:'abort'
+ resources string:'abort'
returning the mapped string (i.e. 'Abbruch' if the global Language is set
to #de)..
If no corresponding entry is found in the resources, the key is returned;
alternatively, use:
- resources string:'foo' default:'bar'
+ resources string:'foo' default:'bar'
which returns 'bar', if no resource definition for 'foo' is found.
Translations can also include arguments, such as:
- resources string:'really delete %1' with:fileName
+ resources string:'really delete %1' with:fileName
This scheme has the advantage, that you can write your programs using your
native language strings. Later, when new languages are to be supported,
@@ -89,14 +89,14 @@
so using percent-placeholders is much better than simple concatenations of
arguments to the question.
- More languages can be added later without any change in the code, or recompilation
- or the like. Even by people without access to the source code (i.e. which only have the
+ More languages can be added later without any change in the code, or recompilation
+ or the like. Even by people without access to the source code (i.e. which only have the
applications binary).
Also, unsupported languages' strings are simply left unchanged - if you
write your application in (say) english, and only plan to use it in english,
no additional work is required (i.e you don't even need a resource file then).
- Strings for unknown languages will come in english
+ Strings for unknown languages will come in english
(which is better than nothing or empty button labels ;-)
Notice, that you can also translate engish to english, by providing an en.rs file.
@@ -106,45 +106,45 @@
Finally, this scheme is also compatible to a pure enum-key based translation mechanism,
as typically used in the C-world.
- Simple use keys as argument, and provide translations for all languages (incl. english).
+ Simple use keys as argument, and provide translations for all languages (incl. english).
For example:
- Button label:(resources string:#BTN_FOO_LABEL)
+ Button label:(resources string:#BTN_FOO_LABEL)
Summary:
- in subclasses of View and ApplicationModel, instead of writing:
+ in subclasses of View and ApplicationModel, instead of writing:
- ...
- b := Button label:'press me'
- ...
+ ...
+ b := Button label:'press me'
+ ...
- always write:
+ always write:
- ...
- b := Button label:(resources string:'press me')
- ...
+ ...
+ b := Button label:(resources string:'press me')
+ ...
- if your class is not a subclass of one of the above, AND you need
- resource translations, you won't inherit the resources variable
- (which is automatically initialized).
- In this case, you have to ask the ResourcePack class explicitely for
- a corresponding package:
+ if your class is not a subclass of one of the above, AND you need
+ resource translations, you won't inherit the resources variable
+ (which is automatically initialized).
+ In this case, you have to ask the ResourcePack class explicitely for
+ a corresponding package:
- ResourcePack for:aClassName
- or (even better):
- ResourcePack forPackage:aPackageID
+ ResourcePack for:aClassName
+ or (even better):
+ ResourcePack forPackage:aPackageID
- as an example, see how the Date class gets the national names of
- week & monthnames.
+ as an example, see how the Date class gets the national names of
+ week & monthnames.
Debugging:
- in the past, it happened that strings as returned by me were modified by someone else
- (replaceAll:with:) and then lead to invalid presentation in the future.
- To detect any bad guy which writes into one of my returned strings, set the DebugModifications
- classVar to true. Then I will return ImmutableStrings which trap on writes.
-
+ in the past, it happened that strings as returned by me were modified by someone else
+ (replaceAll:with:) and then lead to invalid presentation in the future.
+ To detect any bad guy which writes into one of my returned strings, set the DebugModifications
+ classVar to true. Then I will return ImmutableStrings which trap on writes.
+
[author:]
- Claus Gittinger
+ Claus Gittinger
"
!
@@ -184,11 +184,11 @@
and repeat the above.
back to english:
[exBegin]
- Language := #en
+ Language := #en
[exEnd]
back to german:
[exBegin]
- Language := #de
+ Language := #de
[exEnd]
"
! !
@@ -208,8 +208,8 @@
initialize
Packs isNil ifTrue:[
- Packs := WeakArray new:100.
- FailedToLoadPacks := Set new.
+ Packs := WeakArray new:100.
+ FailedToLoadPacks := Set new.
].
"
@@ -228,12 +228,12 @@
^ self for:aClass cached:false
"
- ResourcePack for:TextView
+ ResourcePack for:TextView
ResourcePack for:CodeView
- ResourcePack for:Workspace
- ResourcePack for:View
- ResourcePack for:ErrorLogger
- ResourcePack for:NewLauncher
+ ResourcePack for:Workspace
+ ResourcePack for:View
+ ResourcePack for:ErrorLogger
+ ResourcePack for:NewLauncher
ResourcePack for:SmallSense::SettingsAppl
Workspace classResources
"
@@ -249,8 +249,8 @@
nm := aClass resourcePackName.
cached ifTrue:[
- pack := self searchCacheFor:nm.
- pack notNil ifTrue:[^ pack].
+ pack := self searchCacheFor:nm.
+ pack notNil ifTrue:[^ pack].
].
baseName := (Smalltalk fileNameForClass:nm) , '.rs'.
@@ -258,54 +258,54 @@
"/ CHECK this
"/ (rsrcDir notNil and:[rsrcDir suffix = 'rs']) ifTrue:[
-"/ baseName := (Smalltalk fileNameForClass: rsrcDir tail asFilename withoutSuffix pathName),'.rs'.
+"/ baseName := (Smalltalk fileNameForClass: rsrcDir tail asFilename withoutSuffix pathName),'.rs'.
"/ rsrcDir := rsrcDir head asFilename.
"/ ].
- rsrcDir notNil ifTrue:[
- pack := self new.
- rsrcDir exists ifTrue:[
- (rsrcDir construct:baseName) exists ifTrue:[
- pack := self fromFile:baseName directory:(rsrcDir name) cached:true.
- ].
- ]
+ rsrcDir notNil ifTrue:[
+ pack := self new.
+ rsrcDir exists ifTrue:[
+ (rsrcDir construct:baseName) exists ifTrue:[
+ pack := self fromFile:baseName directory:(rsrcDir name) cached:true.
+ ].
+ ]
] ifFalse:[
- pack := self fromFile:baseName directory:'resources' cached:true.
+ pack := self fromFile:baseName directory:'resources' cached:true.
].
aClass superclass notNil ifTrue:[
- pack superPack:(self for:(aClass superclass)).
+ pack superPack:(self for:(aClass superclass)).
].
pack packsClassOrFileName:nm.
cached ifTrue:[
- self addToCache:pack.
+ self addToCache:pack.
].
pack projectPack:(self forPackage:(aClass resourcePackage) cached:true).
^ pack
- "
+ "
ResourcePack forPackage:'bosch:dapasx' cached:true
- ResourcePack for:TextView
+ ResourcePack for:TextView
ResourcePack for:CodeView
- ResourcePack for:Workspace
- ResourcePack for:View
- ResourcePack for:ErrorLogger
- ResourcePack for:NewLauncher
+ ResourcePack for:Workspace
+ ResourcePack for:View
+ ResourcePack for:ErrorLogger
+ ResourcePack for:NewLauncher
Workspace classResources
"
"Modified: / 01-11-2010 / 09:09:43 / cg"
!
-forPackage:package
+forPackage:package
"get the full resource definitions given a package id (such as stx:libbasic').
Also leave the resulting pack in the cache for faster access next time."
^ self forPackage:package cached:true
"
- ResourcePack forPackage:'stx:libbasic'
- ResourcePack forPackage:'stx:libtool'
+ ResourcePack forPackage:'stx:libbasic'
+ ResourcePack forPackage:'stx:libtool'
"
"Modified: / 18-09-2006 / 18:45:31 / cg"
@@ -318,7 +318,7 @@
^ self forPackage:package resourceFileName:'resources.rs' cached:cached
"
- ResourcePack forPackage:'stx:libbasic' cached:false
+ ResourcePack forPackage:'stx:libbasic' cached:false
"
"Modified: / 19-10-2006 / 23:18:28 / cg"
@@ -334,25 +334,25 @@
fullName := package , '/resources/',resourceFileName.
cached ifTrue:[
- pack := self searchCacheFor:fullName.
- pack notNil ifTrue:[^ pack].
- (FailedToLoadPacks includes:fullName) ifTrue:[^ nil].
+ pack := self searchCacheFor:fullName.
+ pack notNil ifTrue:[^ pack].
+ (FailedToLoadPacks includes:fullName) ifTrue:[^ nil].
].
rsrcDir := Smalltalk projectDirectoryForPackage:package.
rsrcDir isNil ifTrue:[
- file := Smalltalk getResourceFileName:resourceFileName forPackage:package.
- file isNil ifTrue:[
- FailedToLoadPacks add:fullName.
- ^ nil
- ].
- rsrcDir := file asFilename directory.
+ file := Smalltalk getResourceFileName:resourceFileName forPackage:package.
+ file isNil ifTrue:[
+ FailedToLoadPacks add:fullName.
+ ^ nil
+ ].
+ rsrcDir := file asFilename directory.
] ifFalse:[
- rsrcDir := rsrcDir asFilename construct:'resources'.
- rsrcDir exists ifFalse:[
- FailedToLoadPacks add:fullName.
- ^ nil
- ].
+ rsrcDir := rsrcDir asFilename construct:'resources'.
+ rsrcDir exists ifFalse:[
+ FailedToLoadPacks add:fullName.
+ ^ nil
+ ].
].
pack := self fromFile:resourceFileName directory:rsrcDir cached:cached.
@@ -360,7 +360,7 @@
^ pack
"
- ResourcePack forPackage:'stx:libbasic' resourceFileName:'resources.rs' cached:false
+ ResourcePack forPackage:'stx:libbasic' resourceFileName:'resources.rs' cached:false
"
"Modified: / 28-09-2011 / 15:55:30 / cg"
@@ -395,7 +395,7 @@
newPack := self new.
newPack readFromFile:aFileName directory:dirName.
cached ifTrue:[
- self addToCache:newPack.
+ self addToCache:newPack.
].
^ newPack
! !
@@ -406,19 +406,19 @@
|idx|
Packs isNil ifTrue:[
- self initialize.
+ self initialize.
].
idx := Packs identityIndexOf:nil.
idx == 0 ifTrue:[
- idx := Packs identityIndexOf:0
+ idx := Packs findFirst:[:slot | slot class == SmallInteger].
].
idx == 0 ifTrue:[
- "
- throw away oldest
- "
- idx := Packs size.
- Packs replaceFrom:1 to:idx-1 with:Packs startingAt:2.
+ "
+ throw away oldest
+ "
+ idx := Packs size.
+ Packs replaceFrom:1 to:idx-1 with:Packs startingAt:2.
].
aPack at:'__language__' put:(UserPreferences current language,'_',UserPreferences current languageTerritory).
Packs at:idx put:aPack.
@@ -430,36 +430,36 @@
|sz "{ Class: SmallInteger }" lang|
Packs isNil ifTrue:[
- self initialize.
- ^ nil
+ self initialize.
+ ^ nil
].
lang := (UserPreferences current language,'_',UserPreferences current languageTerritory).
sz := Packs size.
1 to:sz do:[:idx |
- |aPack|
+ |aPack|
- aPack := Packs at:idx.
- (aPack notNil and:[aPack ~~ 0]) ifTrue:[
- (aPack at:'__language__' ifAbsent:nil) = lang ifTrue:[
- aClassOrFileName = aPack packsClassOrFileName ifTrue:[
- "
- bring to front for LRU
- "
- idx ~~ 1 ifTrue:[
- Packs replaceFrom:2 to:idx with:Packs startingAt:1.
- Packs at:1 put:aPack.
- ].
- ^ aPack
- ]
- ]
- ]
+ aPack := Packs at:idx.
+ (aPack notNil and:[aPack class ~~ SmallInteger]) ifTrue:[
+ (aPack at:'__language__' ifAbsent:nil) = lang ifTrue:[
+ aClassOrFileName = aPack packsClassOrFileName ifTrue:[
+ "
+ bring to front for LRU
+ "
+ idx ~~ 1 ifTrue:[
+ Packs replaceFrom:2 to:idx with:Packs startingAt:1.
+ Packs at:1 put:aPack.
+ ].
+ ^ aPack
+ ]
+ ]
+ ]
].
^ nil
"
- ResourcePack searchCacheFor:'TextView'
+ ResourcePack searchCacheFor:'TextView'
"
"Modified: / 18-09-2006 / 19:13:13 / cg"
@@ -475,13 +475,13 @@
rest := lineString copyFrom:9.
rest := rest withoutSeparators.
(rest startsWith:'#') ifTrue:[
- rest := rest copyFrom:2.
+ rest := rest copyFrom:2.
].
(rest startsWith:'''') ifTrue:[
- rest := rest copyFrom:2.
- (rest endsWith:'''') ifTrue:[
- rest := rest copyButLast:1.
- ].
+ rest := rest copyFrom:2.
+ (rest endsWith:'''') ifTrue:[
+ rest := rest copyButLast:1.
+ ].
].
encoding := rest asSymbol.
^ encoding.
@@ -491,52 +491,52 @@
"process a single valid line (i.e. #ifdef & #include has already been processed)"
self
- processResourceLine:lineString encoding:encodingSymbolOrEncoder file:fileName printErrorWith:printError for:aResourcePack
- keepUselessTranslations:false.
+ processResourceLine:lineString encoding:encodingSymbolOrEncoder file:fileName printErrorWith:printError for:aResourcePack
+ keepUselessTranslations:false.
!
processResourceLine:lineString encoding:encodingSymbolOrEncoder file:fileName printErrorWith:printError for:aResourcePack keepUselessTranslations:keepUselessTranslations
"process a single valid line (i.e. #ifdef & #include has already been processed)"
- |name lineStream idx rest macroName value
+ |name lineStream idx rest macroName value
conditional hasError decoder oldValue ignoreTranslation indirect|
"/ Transcript showCR:lineString.
encodingSymbolOrEncoder notNil ifTrue:[
- encodingSymbolOrEncoder isSymbol ifTrue:[
- decoder := CharacterEncoder encoderFor:encodingSymbolOrEncoder ifAbsent:nil.
- decoder isNil ifTrue:[ decoder := CharacterEncoder nullEncoderInstance ].
- ] ifFalse:[
- decoder := encodingSymbolOrEncoder
- ].
+ encodingSymbolOrEncoder isSymbol ifTrue:[
+ decoder := CharacterEncoder encoderFor:encodingSymbolOrEncoder ifAbsent:nil.
+ decoder isNil ifTrue:[ decoder := CharacterEncoder nullEncoderInstance ].
+ ] ifFalse:[
+ decoder := encodingSymbolOrEncoder
+ ].
].
decoder notNil ifTrue:[
- lineStream := (decoder decodeString:lineString) readStream.
+ lineStream := (decoder decodeString:lineString) readStream.
] ifFalse:[
- lineStream := lineString readStream.
+ lineStream := lineString readStream.
].
lineStream signalAtEnd:false.
lineStream skipSeparators.
lineStream peek == $# ifTrue:[
- name := Array
- readFrom:lineStream
- onError:[
- printError value:('invalid line <' , lineString , '>').
- nil
- ].
+ name := Array
+ readFrom:lineStream
+ onError:[
+ printError value:('invalid line <' , lineString , '>').
+ nil
+ ].
] ifFalse:[
- lineStream peek == $' ifTrue:[
- name := String
- readSmalltalkStringFrom:lineStream
- onError:[
- printError value:('invalid line <' , lineString , '>').
- nil
- ].
- ] ifFalse:[
- name := lineStream upToSeparator.
- ].
+ lineStream peek == $' ifTrue:[
+ name := String
+ readSmalltalkStringFrom:lineStream
+ onError:[
+ printError value:('invalid line <' , lineString , '>').
+ nil
+ ].
+ ] ifFalse:[
+ name := lineStream upToSeparator.
+ ].
].
name isNil ifTrue:[^ self ].
@@ -548,124 +548,124 @@
idx := lineStream position + 1 + 1.
lineStream peek == $< ifTrue:[
- "
- skip <type> if present
- "
- lineStream skipThrough:$>.
- lineStream skipSeparators.
- idx := lineStream position + 2.
+ "
+ skip <type> if present
+ "
+ lineStream skipThrough:$>.
+ lineStream skipSeparators.
+ idx := lineStream position + 2.
].
conditional := indirect := false.
lineStream peek == $? ifTrue:[
- conditional := true.
- lineStream next.
- lineStream skipSeparators.
+ conditional := true.
+ lineStream next.
+ lineStream skipSeparators.
].
lineStream peek == $@ ifTrue:[
- indirect := true.
- lineStream next.
- lineStream skipSeparators.
+ indirect := true.
+ lineStream next.
+ lineStream skipSeparators.
].
lineStream peek == $= ifTrue:[
- lineStream next.
+ lineStream next.
- macroName := lineStream nextAlphaNumericWord.
- [lineStream peek == $.] whileTrue:[
- lineStream next.
- lineStream peek notNil ifTrue:[
- macroName := macroName , '.' , (lineStream nextAlphaNumericWord)
- ]
- ].
- rest := lineStream upToEnd.
- value := aResourcePack at:macroName ifAbsent:nil.
- (value isNil) ifTrue:[
- hasError := true.
- printError value:('bad (nil-valued) macro: ' , macroName).
- ].
+ macroName := lineStream nextAlphaNumericWord.
+ [lineStream peek == $.] whileTrue:[
+ lineStream next.
+ lineStream peek notNil ifTrue:[
+ macroName := macroName , '.' , (lineStream nextAlphaNumericWord)
+ ]
+ ].
+ rest := lineStream upToEnd.
+ value := aResourcePack at:macroName ifAbsent:nil.
+ (value isNil) ifTrue:[
+ hasError := true.
+ printError value:('bad (nil-valued) macro: ' , macroName).
+ ].
"/ value isBlock ifTrue:[
"/ value := value value
"/ ].
- rest isBlank ifFalse:[
- value := Compiler evaluate:('self ' , rest)
- receiver:value
- notifying:nil
- compile:false.
- (value == #Error) ifTrue:[
- hasError := true.
- printError value:('error in: "self ' , rest , '"').
- ].
- "/ 'self ' print. rest print. ' -> ' print. value printCR.
- ]
+ rest isBlank ifFalse:[
+ value := Compiler evaluate:('self ' , rest)
+ receiver:value
+ notifying:nil
+ compile:false.
+ (value == #Error) ifTrue:[
+ hasError := true.
+ printError value:('error in: "self ' , rest , '"').
+ ].
+ "/ 'self ' print. rest print. ' -> ' print. value printCR.
+ ]
] ifFalse:[
- lineStream peek == $' ifTrue:[
- value := String
- readSmalltalkStringFrom:lineStream
- onError:[
- printError value:('invalid line <' , lineString , '>').
- nil
- ].
- "/ ' -> ' print. value printCR.
- ] ifFalse:[
- rest := lineStream upToEnd.
- [
- value := Compiler evaluate:rest compile:"true" false.
- ] on:Error do:[
- printError value:('invalid line <' , rest , '>').
- "/ value := rest
- ].
- "/ rest print. ' -> ' print. value printCR.
- ].
- (value == #Error) ifTrue:[
- hasError := true.
- printError value:('error in: "' , rest , '"').
- ] ifFalse:[
+ lineStream peek == $' ifTrue:[
+ value := String
+ readSmalltalkStringFrom:lineStream
+ onError:[
+ printError value:('invalid line <' , lineString , '>').
+ nil
+ ].
+ "/ ' -> ' print. value printCR.
+ ] ifFalse:[
+ rest := lineStream upToEnd.
+ [
+ value := Compiler evaluate:rest compile:"true" false.
+ ] on:Error do:[
+ printError value:('invalid line <' , rest , '>').
+ "/ value := rest
+ ].
+ "/ rest print. ' -> ' print. value printCR.
+ ].
+ (value == #Error) ifTrue:[
+ hasError := true.
+ printError value:('error in: "' , rest , '"').
+ ] ifFalse:[
"/ value isString ifTrue:[
"/ decoder notNil ifTrue:[
"/ value := decoder decodeString:value
"/ ]
"/ ]
- ]
+ ]
].
"/ Transcript show:name; show:' -> '; showCR:value.
hasError ifFalse:[
- (conditional not
- or:[(aResourcePack includesKey:name) not]) ifTrue:[
- name = value ifTrue:[
- keepUselessTranslations ifFalse:[
- printError value:('useless resource: "' , name , '"').
- ignoreTranslation := true
- ].
- ].
- ignoreTranslation ifFalse:[
- oldValue := aResourcePack at:name ifAbsent:nil.
- oldValue notNil ifTrue:[
- oldValue ~= value ifTrue:[
- printError value:('conflicting resource: "' , name , '"').
- printError value:('oldValue: ' , oldValue printString).
- printError value:('newValue: ' , value printString).
- ] ifFalse:[
- printError value:('duplicate resource: "' , name , '"').
- ].
- ].
- indirect ifTrue:[
- value := aResourcePack string:value.
- ].
+ (conditional not
+ or:[(aResourcePack includesKey:name) not]) ifTrue:[
+ name = value ifTrue:[
+ keepUselessTranslations ifFalse:[
+ printError value:('useless resource: "' , name , '"').
+ ignoreTranslation := true
+ ].
+ ].
+ ignoreTranslation ifFalse:[
+ oldValue := aResourcePack at:name ifAbsent:nil.
+ oldValue notNil ifTrue:[
+ oldValue ~= value ifTrue:[
+ printError value:('conflicting resource: "' , name , '"').
+ printError value:('oldValue: ' , oldValue printString).
+ printError value:('newValue: ' , value printString).
+ ] ifFalse:[
+ printError value:('duplicate resource: "' , name , '"').
+ ].
+ ].
+ indirect ifTrue:[
+ value := aResourcePack string:value.
+ ].
- DebugModifications == true ifTrue:[
- "/ for debugging only !! (not all primitive code is ready for immutableStrings)
- value class == String ifTrue:[
- value := value asImmutableString.
- ].
- ].
+ DebugModifications == true ifTrue:[
+ "/ for debugging only !! (not all primitive code is ready for immutableStrings)
+ value class == String ifTrue:[
+ value := value asImmutableString.
+ ].
+ ].
- aResourcePack at:name put:value.
- ]
- ]
+ aResourcePack at:name put:value.
+ ]
+ ]
]
"Modified: / 06-02-2014 / 15:33:03 / cg"
@@ -678,7 +678,7 @@
separated by a space. However, it is better to first cut of any leading
and trailing spaces and special characters, such as ':*.,' etc."
- ^ (self resourceFileStringFor:keyString),' ',(self resourceFileStringFor:nationalString)
+ ^ (self resourceFileStringFor:keyString),' ',(self resourceFileStringFor:nationalString)
!
resourceFileStringFor:aString
@@ -690,23 +690,23 @@
^ (self shortenedKeyFor:aString) storeString
"
- self resourceFileStringFor:' foo: '
- self resourceFileStringFor:' foo bar: '
+ self resourceFileStringFor:' foo: '
+ self resourceFileStringFor:' foo bar: '
"
!
shortenedKeyFor:aKey
"if
- aKey is '(...)', then return '...'
- if aKey is '[...]', then return '...'
- if aKey is '{...}', then return '...'
- if aKey starts or ends with any of '\:=.,?!! ', then return aKey without it
+ aKey is '(...)', then return '...'
+ if aKey is '[...]', then return '...'
+ if aKey is '{...}', then return '...'
+ if aKey starts or ends with any of '\:=.,?!! ', then return aKey without it
This means, that only a single translation is required to provide local translations for
- things like
- 'search'
- 'search:'
- 'search...'
+ things like
+ 'search'
+ 'search:'
+ 'search...'
"
|idx idx1 idx2 first last keySize|
@@ -718,26 +718,26 @@
((first == $( and:[last == $) ])
or:[ (first == $[ and:[last == $] ])
or:[ (first == ${ and:[last == $} ]) ]]) ifTrue:[
- ^ self shortenedKeyFor:(aKey copyFrom:2 to:keySize-1).
+ ^ self shortenedKeyFor:(aKey copyFrom:2 to:keySize-1).
].
idx1 := aKey findFirst:[:ch | ch isSeparator not].
idx2 := aKey findLast:[:ch | ch isSeparator not] ifNone:keySize.
(idx1 > 1 or:[idx2 < keySize]) ifTrue:[
- ^ self shortenedKeyFor:(aKey copyFrom:idx1 to:idx2)
+ ^ self shortenedKeyFor:(aKey copyFrom:idx1 to:idx2)
].
idx1 := aKey findFirst:[:ch | ('*:=.?!!,-><\' includes:ch) not].
idx2 := aKey findLast:[:ch | ('*:=.?!!,-><\' includes:ch) not] ifNone:keySize.
(idx1 > 1 or:[idx2 < keySize]) ifTrue:[
- ^ self shortenedKeyFor:(aKey copyFrom:idx1 to:idx2)
+ ^ self shortenedKeyFor:(aKey copyFrom:idx1 to:idx2)
].
"/ change duplicated &'s to single
(idx := aKey indexOf:$&) ~~ 0 ifTrue:[
- (aKey at:idx+1 ifAbsent:nil) ~~ $& ifTrue:[
- ^ self shortenedKeyFor:(aKey copyTo:idx-1),(aKey copyFrom:idx+1).
- ].
+ (aKey at:idx+1 ifAbsent:nil) ~~ $& ifTrue:[
+ ^ self shortenedKeyFor:(aKey copyTo:idx-1),(aKey copyFrom:idx+1).
+ ].
].
^ aKey.
@@ -745,12 +745,12 @@
'abcde' findFirst:[:ch | 'bcd' includes:ch]
'abcde' indexOfAny:'bcd'
- self shortenedKeyFor:'abc'
- self shortenedKeyFor:' abc '
- self shortenedKeyFor:'(abc)'
- self shortenedKeyFor:'abc...'
- self shortenedKeyFor:'(abc...)'
- self shortenedKeyFor:'abc:*'
+ self shortenedKeyFor:'abc'
+ self shortenedKeyFor:' abc '
+ self shortenedKeyFor:'(abc)'
+ self shortenedKeyFor:'abc...'
+ self shortenedKeyFor:'(abc...)'
+ self shortenedKeyFor:'abc:*'
"
! !
@@ -762,7 +762,7 @@
^ anArray collect:[:r | self at:r default:r]
"
- Launcher classResources array:#('file' 'classes')
+ Launcher classResources array:#('file' 'classes')
"
"Modified: / 29.1.1998 / 22:44:22 / cg"
@@ -791,37 +791,37 @@
val notNil ifTrue:[^ val].
(projectPack := self projectPack) notNil ifTrue:[
- val := projectPack localAt:aKey.
- val notNil ifTrue:[^ val].
+ val := projectPack localAt:aKey.
+ val notNil ifTrue:[^ val].
].
alreadySearched := Set new.
projectPack notNil ifTrue:[ alreadySearched add:projectPack ].
pack := self superPack.
[ pack notNil ] whileTrue:[
- val := pack localAt:aKey.
- val notNil ifTrue:[^ val].
+ val := pack localAt:aKey.
+ val notNil ifTrue:[^ val].
- (projectPack := pack projectPack) notNil ifTrue:[
- (alreadySearched includes:projectPack) ifFalse:[
- val := projectPack localAt:aKey.
- val notNil ifTrue:[^ val].
- alreadySearched add:projectPack.
- ].
- ].
- pack := pack superPack
+ (projectPack := pack projectPack) notNil ifTrue:[
+ (alreadySearched includes:projectPack) ifFalse:[
+ val := projectPack localAt:aKey.
+ val notNil ifTrue:[^ val].
+ alreadySearched add:projectPack.
+ ].
+ ].
+ pack := pack superPack
].
alreadySearched copy do:[:projectPack |
- |p|
+ |p|
- p := projectPack superPack.
- [p notNil and:[(alreadySearched includes:p) not]] whileTrue:[
- val := p localAt:aKey.
- val notNil ifTrue:[^ val].
- alreadySearched add:p.
- p := p superPack.
- ].
+ p := projectPack superPack.
+ [p notNil and:[(alreadySearched includes:p) not]] whileTrue:[
+ val := p localAt:aKey.
+ val notNil ifTrue:[^ val].
+ alreadySearched add:p.
+ p := p superPack.
+ ].
].
^ defaultValue value
@@ -832,124 +832,124 @@
localAt:aKey
"translate a string.
Some special 'intelligence' has been added:
- if no value for aKey is found,
- lookup aKey with first character caseChanged and change the results first characters case.
- or aKey is '(...)', then lookup ... wrap () around the result.
- or aKey is '[...]', then lookup ... wrap [] around the result.
- or aKey is '{...}', then lookup ... wrap {} around the result.
- or aKey starts with a '\', then lookup aKey without '\' and prepend '\' to the result.
- or aKey ends with a '\', then lookup aKey without '\' and append '\' to the result.
- or aKey ends with a ':', then lookup aKey without ':' and append ':' to the result.
- or aKey ends with a '=', then lookup aKey without '=' and append '=' to the result.
- or aKey ends with a '.', then lookup aKey without '.' and append '.' to the result.
- or aKey ends with a ',', then lookup aKey without ',' and append ',' to the result.
- or aKey ends with a '?', then lookup aKey without '?' and append '?' to the result.
- or aKey ends with a '!!', then lookup aKey without '!!' and append '!!' to the result.
- or aKey ends with a ' ', then lookup aKey without ' ' and append ' ' to the result.
- or aKey ends with a ' ...', then lookup aKey without ' ...' and append '...' to the result.
- or aKey ends with a '...', then lookup aKey without '...' and append '...' to the result.
- or aKey includes '&', then lookup aKey without '&'.
+ if no value for aKey is found,
+ lookup aKey with first character caseChanged and change the results first characters case.
+ or aKey is '(...)', then lookup ... wrap () around the result.
+ or aKey is '[...]', then lookup ... wrap [] around the result.
+ or aKey is '{...}', then lookup ... wrap {} around the result.
+ or aKey starts with a '\', then lookup aKey without '\' and prepend '\' to the result.
+ or aKey ends with a '\', then lookup aKey without '\' and append '\' to the result.
+ or aKey ends with a ':', then lookup aKey without ':' and append ':' to the result.
+ or aKey ends with a '=', then lookup aKey without '=' and append '=' to the result.
+ or aKey ends with a '.', then lookup aKey without '.' and append '.' to the result.
+ or aKey ends with a ',', then lookup aKey without ',' and append ',' to the result.
+ or aKey ends with a '?', then lookup aKey without '?' and append '?' to the result.
+ or aKey ends with a '!!', then lookup aKey without '!!' and append '!!' to the result.
+ or aKey ends with a ' ', then lookup aKey without ' ' and append ' ' to the result.
+ or aKey ends with a ' ...', then lookup aKey without ' ...' and append '...' to the result.
+ or aKey ends with a '...', then lookup aKey without '...' and append '...' to the result.
+ or aKey includes '&', then lookup aKey without '&'.
This means, that only a single translation is required to provide local translations for
- things like
- 'search'
- 'search:'
- 'search...'
+ things like
+ 'search'
+ 'search:'
+ 'search...'
"
|val alternativeKey usedKey idx first last|
val := super at:aKey ifAbsent:nil.
val notNil ifTrue:[
- ^ val value
+ ^ val value
].
(aKey isString and:[aKey notEmpty]) ifTrue:[
- first := aKey first.
- last := aKey last.
+ first := aKey first.
+ last := aKey last.
- "/ try with case-first swapped...
- first isLetter ifTrue:[
- alternativeKey := first isUppercase
- ifTrue:[aKey asLowercaseFirst]
- ifFalse:[aKey asUppercaseFirst].
- val := super at:alternativeKey ifAbsent:nil.
- val notNil ifTrue:[
- first isUppercase ifTrue:[
- ^ val asUppercaseFirst
- ].
- ^ val asLowercaseFirst.
- ].
- ].
+ "/ try with case-first swapped...
+ first isLetter ifTrue:[
+ alternativeKey := first isUppercase
+ ifTrue:[aKey asLowercaseFirst]
+ ifFalse:[aKey asUppercaseFirst].
+ val := super at:alternativeKey ifAbsent:nil.
+ val notNil ifTrue:[
+ first isUppercase ifTrue:[
+ ^ val asUppercaseFirst
+ ].
+ ^ val asLowercaseFirst.
+ ].
+ ].
- ((first == $( and:[last == $) ])
- or:[ (first == $[ and:[last == $] ])
- or:[ (first == ${ and:[last == $} ]) ]]) ifTrue:[
- usedKey := aKey copyFrom:2 to:aKey size-1.
+ ((first == $( and:[last == $) ])
+ or:[ (first == $[ and:[last == $] ])
+ or:[ (first == ${ and:[last == $} ]) ]]) ifTrue:[
+ usedKey := aKey copyFrom:2 to:aKey size-1.
- val := self localAt:usedKey. "/ recursion
- val notNil ifTrue:[^ first asString,val,last asString].
- ].
+ val := self localAt:usedKey. "/ recursion
+ val notNil ifTrue:[^ first asString,val,last asString].
+ ].
- last == $. ifTrue:[
- (aKey endsWith:' ...') ifTrue:[
- usedKey := aKey copyButLast:4.
+ last == $. ifTrue:[
+ (aKey endsWith:' ...') ifTrue:[
+ usedKey := aKey copyButLast:4.
- val := self localAt:usedKey. "/ recursion
- val notNil ifTrue:[^ val , ' ...'].
- ].
- (aKey endsWith:'...') ifTrue:[
- usedKey := aKey copyButLast:3.
+ val := self localAt:usedKey. "/ recursion
+ val notNil ifTrue:[^ val , ' ...'].
+ ].
+ (aKey endsWith:'...') ifTrue:[
+ usedKey := aKey copyButLast:3.
- val := self localAt:usedKey. "/ recursion
- val notNil ifTrue:[^ val , '...'].
- ].
- ].
+ val := self localAt:usedKey. "/ recursion
+ val notNil ifTrue:[^ val , '...'].
+ ].
+ ].
- first isSeparator ifTrue:[
- usedKey := aKey withoutLeadingSeparators.
+ first isSeparator ifTrue:[
+ usedKey := aKey withoutLeadingSeparators.
- val := self localAt:usedKey. "/ recursion
- val notNil ifTrue:[^ (aKey copyTo:(aKey size - usedKey size)), val]. "/ prepend the stripped separators
- ].
- last isSeparator ifTrue:[
- usedKey := aKey withoutTrailingSeparators.
+ val := self localAt:usedKey. "/ recursion
+ val notNil ifTrue:[^ (aKey copyTo:(aKey size - usedKey size)), val]. "/ prepend the stripped separators
+ ].
+ last isSeparator ifTrue:[
+ usedKey := aKey withoutTrailingSeparators.
- val := self localAt:usedKey. "/ recursion
- val notNil ifTrue:[^ val, (aKey copyFrom:usedKey size + 1)]. "/ append the stripped separators
- ].
+ val := self localAt:usedKey. "/ recursion
+ val notNil ifTrue:[^ val, (aKey copyFrom:usedKey size + 1)]. "/ append the stripped separators
+ ].
- ('*:=.?!!,-><\' includes:last) ifTrue:[
- aKey size >= 2 ifTrue:[
- usedKey := aKey copyButLast:1.
+ ('*:=.?!!,-><\' includes:last) ifTrue:[
+ aKey size >= 2 ifTrue:[
+ usedKey := aKey copyButLast:1.
- val := self localAt:usedKey. "/ recursion
- val notNil ifTrue:[^ val copyWith:last].
- ].
- ].
- ('*:=.?!!-><\' includes:first) ifTrue:[
- aKey size >= 2 ifTrue:[
- usedKey := aKey copyFrom:2.
+ val := self localAt:usedKey. "/ recursion
+ val notNil ifTrue:[^ val copyWith:last].
+ ].
+ ].
+ ('*:=.?!!-><\' includes:first) ifTrue:[
+ aKey size >= 2 ifTrue:[
+ usedKey := aKey copyFrom:2.
- val := self localAt:usedKey. "/ recursion
- val notNil ifTrue:[^ first asString , val].
- ].
- ].
+ val := self localAt:usedKey. "/ recursion
+ val notNil ifTrue:[^ first asString , val].
+ ].
+ ].
- (first == $( and:[last == $)]) ifTrue:[
- usedKey := aKey copyFrom:2 to:(aKey size - 1).
+ (first == $( and:[last == $)]) ifTrue:[
+ usedKey := aKey copyFrom:2 to:(aKey size - 1).
- val := self localAt:usedKey. "/ recursion
- val notNil ifTrue:[^ '(' , val , ')'].
- ].
+ val := self localAt:usedKey. "/ recursion
+ val notNil ifTrue:[^ '(' , val , ')'].
+ ].
- (idx := aKey indexOf:$&) ~~ 0 ifTrue:[
- (aKey at:idx+1 ifAbsent:nil) ~~ $& ifTrue:[
- usedKey := (aKey copyTo:idx-1) , (aKey copyFrom:idx+1).
- val := self localAt:usedKey. "/ recursion
- val notNil ifTrue:[^ val].
- ].
- ].
+ (idx := aKey indexOf:$&) ~~ 0 ifTrue:[
+ (aKey at:idx+1 ifAbsent:nil) ~~ $& ifTrue:[
+ usedKey := (aKey copyTo:idx-1) , (aKey copyFrom:idx+1).
+ val := self localAt:usedKey. "/ recursion
+ val notNil ifTrue:[^ val].
+ ].
+ ].
].
^ nil.
@@ -974,7 +974,7 @@
"
NewLauncher classResources
- string:'LICENCEFILE'
+ string:'LICENCEFILE'
"
!
@@ -985,7 +985,7 @@
"
NewLauncher classResources
- string:'fooBar' default:'Hello world'
+ string:'fooBar' default:'Hello world'
"
!
@@ -997,7 +997,7 @@
"
NewLauncher classResources
- string:'%1 fooBar' default:'Hello %1' with:'foo'
+ string:'%1 fooBar' default:'Hello %1' with:'foo'
"
!
@@ -1108,13 +1108,13 @@
"
NewLauncher classResources
- stringWithCRs:'LICENCEFILE'
+ stringWithCRs:'LICENCEFILE'
"
!
stringWithCRs:s with:arg
"translate, replace \'s with CRs and finally expand arg.
- CR-replacement is donw before args are inserted
+ CR-replacement is donw before args are inserted
i.e. if any arg contains a backslash (DOS filenames), those are not translated."
^ self stringWithCRs:s withArgs:(Array with:arg)
@@ -1124,7 +1124,7 @@
stringWithCRs:s with:arg1 with:arg2
"translate, replace \'s with CRs and finally expand args.
- CR-replacement is donw before args are inserted
+ CR-replacement is donw before args are inserted
i.e. if any arg contains a backslash (DOS filenames), those are not translated."
^ self stringWithCRs:s withArgs:(Array with:arg1 with:arg2)
@@ -1134,7 +1134,7 @@
stringWithCRs:s with:arg1 with:arg2 with:arg3
"translate, replace \'s with CRs and finally expand args.
- CR-replacement is donw before args are inserted
+ CR-replacement is donw before args are inserted
i.e. if any arg contains a backslash (DOS filenames), those are not translated."
^ self stringWithCRs:s withArgs:(Array with:arg1 with:arg2 with:arg3)
@@ -1144,7 +1144,7 @@
stringWithCRs:s with:arg1 with:arg2 with:arg3 with:arg4
"translate, replace \'s with CRs and finally expand args.
- CR-replacement is donw before args are inserted
+ CR-replacement is donw before args are inserted
i.e. if any arg contains a backslash (DOS filenames), those are not translated."
^ self stringWithCRs:s withArgs:(Array with:arg1 with:arg2 with:arg3 with:arg4)
@@ -1154,7 +1154,7 @@
stringWithCRs:s with:arg1 with:arg2 with:arg3 with:arg4 with:arg5
"translate, replace \'s with CRs and finally expand args.
- CR-replacement is donw before args are inserted
+ CR-replacement is donw before args are inserted
i.e. if any arg contains a backslash (DOS filenames), those are not translated."
^ self stringWithCRs:s withArgs:(Array with:arg1 with:arg2 with:arg3 with:arg4 with:arg5)
@@ -1162,9 +1162,9 @@
"Modified: / 21.3.2003 / 14:21:55 / cg"
!
-stringWithCRs:s with:arg1 with:arg2 with:arg3 with:arg4 with:arg5 with:arg6
+stringWithCRs:s with:arg1 with:arg2 with:arg3 with:arg4 with:arg5 with:arg6
"translate, replace \'s with CRs and finally expand args.
- CR-replacement is donw before args are inserted
+ CR-replacement is donw before args are inserted
i.e. if any arg contains a backslash (DOS filenames), those are not translated."
^ self stringWithCRs:s withArgs:(Array with:arg1 with:arg2 with:arg3 with:arg4 with:arg5 with:arg6)
@@ -1174,7 +1174,7 @@
stringWithCRs:s with:arg1 with:arg2 with:arg3 with:arg4 with:arg5 with:arg6 with:arg7
"translate, replace \'s with CRs and finally expand args.
- CR-replacement is donw before args are inserted
+ CR-replacement is donw before args are inserted
i.e. if any arg contains a backslash (DOS filenames), those are not translated."
^ self stringWithCRs:s withArgs:(Array with:arg1 with:arg2 with:arg3 with:arg4 with:arg5 with:arg6 with:arg7)
@@ -1184,7 +1184,7 @@
stringWithCRs:s withArgs:argArray
"translate, replace \'s with CRs and finally expand args.
- CR-replacement is done before args are inserted
+ CR-replacement is done before args are inserted
i.e. if any arg contains a backslash (DOS filenames), those are not translated."
|template|
@@ -1205,37 +1205,37 @@
val notNil ifTrue:[^ self].
(projectPack := self projectPack) notNil ifTrue:[
- val := projectPack localAt:aKey.
- val notNil ifTrue:[^ projectPack].
+ val := projectPack localAt:aKey.
+ val notNil ifTrue:[^ projectPack].
].
alreadySearched := Set new.
projectPack notNil ifTrue:[ alreadySearched add:projectPack ].
pack := self superPack.
[ pack notNil ] whileTrue:[
- val := pack localAt:aKey.
- val notNil ifTrue:[^ pack].
+ val := pack localAt:aKey.
+ val notNil ifTrue:[^ pack].
- (projectPack := pack projectPack) notNil ifTrue:[
- (alreadySearched includes:projectPack) ifFalse:[
- val := projectPack localAt:aKey.
- val notNil ifTrue:[^ projectPack].
- alreadySearched add:projectPack.
- ].
- ].
- pack := pack superPack
+ (projectPack := pack projectPack) notNil ifTrue:[
+ (alreadySearched includes:projectPack) ifFalse:[
+ val := projectPack localAt:aKey.
+ val notNil ifTrue:[^ projectPack].
+ alreadySearched add:projectPack.
+ ].
+ ].
+ pack := pack superPack
].
alreadySearched copy do:[:projectPack |
- |p|
+ |p|
- p := projectPack superPack.
- [p notNil and:[(alreadySearched includes:p) not]] whileTrue:[
- val := p localAt:aKey.
- val notNil ifTrue:[^ p].
- alreadySearched add:p.
- p := p superPack.
- ].
+ p := projectPack superPack.
+ [p notNil and:[(alreadySearched includes:p) not]] whileTrue:[
+ val := p localAt:aKey.
+ val notNil ifTrue:[^ p].
+ alreadySearched add:p.
+ p := p superPack.
+ ].
].
^ nil
@@ -1325,11 +1325,11 @@
"process a single valid line (i.e. #ifdef & #include has already been processed)"
self class
- processResourceLine:lineString
- encoding:encodingSymbolOrEncoder
- file:fileName
- printErrorWith:printError
- for:self
+ processResourceLine:lineString
+ encoding:encodingSymbolOrEncoder
+ file:fileName
+ printErrorWith:printError
+ for:self
!
readFromFile:fileName directory:dirName
@@ -1341,39 +1341,39 @@
"/ need to catch errors here, as the handler might itself need resources.
"/ (happens when da.rs is not present in libbasic/resources.rs)
ExternalStream openErrorSignal handle:[:ex |
- Transcript showCR:'ResourcePack: failed to open file: ',fileName asString,' in ',dirName asString.
- inStream := nil.
+ Transcript showCR:'ResourcePack: failed to open file: ',fileName asString,' in ',dirName asString.
+ inStream := nil.
] do:[
- dirName = 'resources' ifTrue:[
- inStream := Smalltalk resourceFileStreamFor:fileName
- ] ifFalse:[
- inStream := Smalltalk systemFileStreamFor:
- (dirName isNil
- ifTrue:[fileName]
- ifFalse:[dirName asFilename construct:fileName]).
- ].
+ dirName = 'resources' ifTrue:[
+ inStream := Smalltalk resourceFileStreamFor:fileName
+ ] ifFalse:[
+ inStream := Smalltalk systemFileStreamFor:
+ (dirName isNil
+ ifTrue:[fileName]
+ ifFalse:[dirName asFilename construct:fileName]).
+ ].
].
inStream isNil ifTrue:[
- "
- an empty pack
- "
- ^ self nonexistingFileRead
+ "
+ an empty pack
+ "
+ ^ self nonexistingFileRead
].
triedFilename := inStream pathName.
[
- ok := self readFromResourceStream:inStream in:(triedFilename asFilename directoryName).
+ ok := self readFromResourceStream:inStream in:(triedFilename asFilename directoryName).
] ensure:[
- inStream close.
+ inStream close.
].
ok ifTrue:[
- packsFileName := triedFilename
+ packsFileName := triedFilename
] ifFalse:[
- fileReadFailed := true.
+ fileReadFailed := true.
- ('ResourcePack [warning]: "' , triedFilename , '" contains error(s) - data may be incomplete.') errorPrintCR.
+ ('ResourcePack [warning]: "' , triedFilename , '" contains error(s) - data may be incomplete.') errorPrintCR.
].
"Modified: / 20-08-2011 / 17:10:02 / cg"
@@ -1384,21 +1384,21 @@
specify where #include files are searched for.
Return true, if the style sheet could be read without errors, false otherwise."
- |lineString l lineNumber rest value ifLevel skipping first ok encoding decoder pack errorHandler
+ |lineString l lineNumber rest value ifLevel skipping first ok encoding decoder pack errorHandler
printError fileName pushedSkipValues|
- fileName := (inStream isFileStream
- ifTrue:[inStream pathName asFilename baseName]
- ifFalse:['---']).
+ fileName := (inStream isFileStream
+ ifTrue:[inStream pathName asFilename baseName]
+ ifFalse:['---']).
printError := [:message |
- 'ResourcePack [warning]: ' errorPrint.
- message errorPrint.
- ' in file:' errorPrint.
- fileName errorPrint.
- ' line: ' errorPrint.
- lineNumber errorPrintCR
- ].
+ 'ResourcePack [warning]: ' errorPrint.
+ message errorPrint.
+ ' in file:' errorPrint.
+ fileName errorPrint.
+ ' line: ' errorPrint.
+ lineNumber errorPrintCR
+ ].
printError := [:message | ].
@@ -1410,137 +1410,137 @@
lineNumber := 0.
pushedSkipValues := OrderedCollection new.
- errorHandler := [:ex |
- |con|
+ errorHandler := [:ex |
+ |con|
- Transcript showCR:('ResourcePack [warning]: ''' , ex description , '''') "errorPrintCR".
- Transcript showCR:('ResourcePack [info]: file: ' , inStream pathName printString , ' line: ' , lineNumber printString , ': ''' , lineString , '''') "errorPrintCR".
- con := ex suspendedContext.
- Transcript showCR:('ResourcePack [info]: in: ' , con fullPrintString) "errorPrintCR".
- con := con sender.
- Transcript showCR:('ResourcePack [info]: : ' , con fullPrintString) "errorPrintCR".
- con := con sender.
- Transcript showCR:('ResourcePack [info]: : ' , con fullPrintString) "errorPrintCR".
- value := nil.
- ok := false.
- ].
+ Transcript showCR:('ResourcePack [warning]: ''' , ex description , '''') "errorPrintCR".
+ Transcript showCR:('ResourcePack [info]: file: ' , inStream pathName printString , ' line: ' , lineNumber printString , ': ''' , lineString , '''') "errorPrintCR".
+ con := ex suspendedContext.
+ Transcript showCR:('ResourcePack [info]: in: ' , con fullPrintString) "errorPrintCR".
+ con := con sender.
+ Transcript showCR:('ResourcePack [info]: : ' , con fullPrintString) "errorPrintCR".
+ con := con sender.
+ Transcript showCR:('ResourcePack [info]: : ' , con fullPrintString) "errorPrintCR".
+ value := nil.
+ ok := false.
+ ].
[inStream atEnd] whileFalse:[
- lineString := inStream nextLine. lineNumber := lineNumber + 1.
- [lineString notNil and:[lineString endsWith:$\]] whileTrue:[
- lineString := lineString copyButLast:1.
- l := inStream nextLine. lineNumber := lineNumber + 1.
- l notNil ifTrue:[
- lineString := lineString , l.
- ].
- ].
+ lineString := inStream nextLine. lineNumber := lineNumber + 1.
+ [lineString notNil and:[lineString endsWith:$\]] whileTrue:[
+ lineString := lineString copyButLast:1.
+ l := inStream nextLine. lineNumber := lineNumber + 1.
+ l notNil ifTrue:[
+ lineString := lineString , l.
+ ].
+ ].
- (lineString size > 0) ifTrue:[
- first := lineString at:1.
- "/
- "/ for your convenience: treat both ';' AND '"/' as comment-line
- "/
- ((first == $;) or:[lineString startsWith:'"/']) ifFalse:[
- ((first == $#) and:[(lineString startsWith:'#(') not]) ifTrue:[
- "/ a directive
- lineString := (lineString copyFrom:2) withoutSpaces.
+ (lineString size > 0) ifTrue:[
+ first := lineString at:1.
+ "/
+ "/ for your convenience: treat both ';' AND '"/' as comment-line
+ "/
+ ((first == $;) or:[lineString startsWith:'"/']) ifFalse:[
+ ((first == $#) and:[(lineString startsWith:'#(') not]) ifTrue:[
+ "/ a directive
+ lineString := (lineString copyFrom:2) withoutSpaces.
- (lineString startsWith:'if') ifTrue:[
- pushedSkipValues add:skipping.
- skipping ifFalse:[
- rest := lineString copyFrom:3.
- Error, UserInformation
- handle:errorHandler
- do:[
- value := Compiler evaluate:rest compile:false.
- ].
- (value == #Error) ifTrue:[
- printError value:('error in resource:' , lineString).
- ].
- (value == false) ifTrue:[
- skipping := true
- ]
- ].
- ifLevel := ifLevel + 1
- ] ifFalse:[
- (lineString startsWith:'endif') ifTrue:[
- ifLevel == 0 ifTrue:[
- printError value:('if/endif nesting error').
- ] ifFalse:[
- ifLevel := ifLevel - 1.
- skipping := pushedSkipValues removeLast.
- ]
- ] ifFalse:[
- (lineString startsWith:'else') ifTrue:[
- (pushedSkipValues includes:true) ifFalse:[
- skipping := skipping not
- ]
- ] ifFalse:[
- skipping ifFalse:[
- (lineString startsWith:'superpack') ifTrue:[
- rest := lineString copyFrom:('superpack' size + 1).
- value := Compiler evaluate:rest compile:false.
- (value isKindOf:ResourcePack) ifTrue:[
- superPack := value
- ]
- ] ifFalse:[
- (lineString startsWith:'include') ifTrue:[
- (lineString startsWith:'includeResourcesFor') ifTrue:[
- "/ include those resources ...
- rest := lineString copyFrom:('includeResourcesFor' size + 1).
- value := Compiler evaluate:rest compile:false.
- value isBehavior ifTrue:[
- pack := self class for:value.
- pack notNil ifTrue:[
- self addAll:pack.
- ]
- ]
- ] ifFalse:[
- rest := lineString copyFrom:('include' size + 1).
- value := Compiler evaluate:rest compile:false.
- value isString ifFalse:[
- printError value:('bad include filename: ' , value printString, ' "',lineString,'"').
- ] ifTrue:[
- self readFromFile:value directory:dirName
- ]
- ]
- ] ifFalse:[
- (lineString startsWith:'encoding') ifTrue:[
+ (lineString startsWith:'if') ifTrue:[
+ pushedSkipValues add:skipping.
+ skipping ifFalse:[
+ rest := lineString copyFrom:3.
+ Error, UserInformation
+ handle:errorHandler
+ do:[
+ value := Compiler evaluate:rest compile:false.
+ ].
+ (value == #Error) ifTrue:[
+ printError value:('error in resource:' , lineString).
+ ].
+ (value == false) ifTrue:[
+ skipping := true
+ ]
+ ].
+ ifLevel := ifLevel + 1
+ ] ifFalse:[
+ (lineString startsWith:'endif') ifTrue:[
+ ifLevel == 0 ifTrue:[
+ printError value:('if/endif nesting error').
+ ] ifFalse:[
+ ifLevel := ifLevel - 1.
+ skipping := pushedSkipValues removeLast.
+ ]
+ ] ifFalse:[
+ (lineString startsWith:'else') ifTrue:[
+ (pushedSkipValues includes:true) ifFalse:[
+ skipping := skipping not
+ ]
+ ] ifFalse:[
+ skipping ifFalse:[
+ (lineString startsWith:'superpack') ifTrue:[
+ rest := lineString copyFrom:('superpack' size + 1).
+ value := Compiler evaluate:rest compile:false.
+ (value isKindOf:ResourcePack) ifTrue:[
+ superPack := value
+ ]
+ ] ifFalse:[
+ (lineString startsWith:'include') ifTrue:[
+ (lineString startsWith:'includeResourcesFor') ifTrue:[
+ "/ include those resources ...
+ rest := lineString copyFrom:('includeResourcesFor' size + 1).
+ value := Compiler evaluate:rest compile:false.
+ value isBehavior ifTrue:[
+ pack := self class for:value.
+ pack notNil ifTrue:[
+ self addAll:pack.
+ ]
+ ]
+ ] ifFalse:[
+ rest := lineString copyFrom:('include' size + 1).
+ value := Compiler evaluate:rest compile:false.
+ value isString ifFalse:[
+ printError value:('bad include filename: ' , value printString, ' "',lineString,'"').
+ ] ifTrue:[
+ self readFromFile:value directory:dirName
+ ]
+ ]
+ ] ifFalse:[
+ (lineString startsWith:'encoding') ifTrue:[
"/decoder notNil ifTrue:[self halt:'oops - encoding change in file'].
- encoding := self class extractEncodingFromLine:lineString.
- decoder := CharacterEncoder encoderFor:encoding ifAbsent:nil.
- ]
- ]
- ]
- ]
- ]
- ]
- ].
- ] ifFalse:[
- skipping ifFalse:[
- Error, UserInformation
- handle:errorHandler
- do:[
- (lineString at:1) == $!! ifTrue:[
- "/ evaluate the rest
- Compiler evaluate:(lineString copyFrom:2)
- receiver:self
- notifying:nil
- compile:false.
- ] ifFalse:[
- "/ process as resource
- self
- processLine:lineString
- encoding:decoder
- file:(inStream isFileStream
- ifTrue:[inStream pathName]
- ifFalse:['---'])
- printErrorWith:printError
- ]]
- ]
- ]
- ]
- ]
+ encoding := self class extractEncodingFromLine:lineString.
+ decoder := CharacterEncoder encoderFor:encoding ifAbsent:nil.
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
+ ].
+ ] ifFalse:[
+ skipping ifFalse:[
+ Error, UserInformation
+ handle:errorHandler
+ do:[
+ (lineString at:1) == $!! ifTrue:[
+ "/ evaluate the rest
+ Compiler evaluate:(lineString copyFrom:2)
+ receiver:self
+ notifying:nil
+ compile:false.
+ ] ifFalse:[
+ "/ process as resource
+ self
+ processLine:lineString
+ encoding:decoder
+ file:(inStream isFileStream
+ ifTrue:[inStream pathName]
+ ifFalse:['---'])
+ printErrorWith:printError
+ ]]
+ ]
+ ]
+ ]
+ ]
].
^ ok
@@ -1555,9 +1555,9 @@
"/ what a kludge - Dolphin and Squeak mean: printOn: a stream;
"/ ST/X (and some old ST80's) mean: draw-yourself on a GC.
(aGCOrStream isStream) ifTrue:[
- aGCOrStream nextPutAll:'ResourcePack for: '.
- packsClassName printOn:aGCOrStream.
- ^ self.
+ aGCOrStream nextPutAll:'ResourcePack for: '.
+ packsClassName printOn:aGCOrStream.
+ ^ self.
].
^ super displayOn:aGCOrStream
@@ -1566,11 +1566,11 @@
!ResourcePack class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/ResourcePack.st,v 1.162 2015-03-01 21:54:21 cg Exp $'
+ ^ '$Header$'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/ResourcePack.st,v 1.162 2015-03-01 21:54:21 cg Exp $'
+ ^ '$Header$'
! !