[squeak-dev] The Trunk: System-fbs.533.mcz

commits at source.squeak.org commits at source.squeak.org
Mon May 20 18:34:45 UTC 2013


Frank Shearar uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-fbs.533.mcz

==================== Summary ====================

Name: System-fbs.533
Author: fbs
Time: 20 May 2013, 7:33:42.666 pm
UUID: 845089de-faef-4831-b224-ba7ffbea91c9
Ancestors: System-fbs.532, System-fbs.529

More work on make SystemNavigation Environmentally aware. It skirts the issue of what to do with Smalltalk specialSelectors and Smalltalk presumedSentMessages in #allSentMessagesWithout:.

My own feeling is that these two might be fine for the "top level" Environment (even though eventually there ought not to be such a thing), but that it's wrong to add these selectors to #allSentMessagesWithout:'s result: a particular Environment might never send these messages.

=============== Diff against System-fbs.529 ===============

Item was added:
+ NaturalLanguageTranslator subclass: #GetTextTranslator
+ 	instanceVariableNames: 'moFiles'
+ 	classVariableNames: 'LocaleDirsForDomain SystemDefaultLocaleDirs UserDefaultLocaleDirs'
+ 	poolDictionaries: ''
+ 	category: 'System-Localization'!
+ 
+ !GetTextTranslator commentStamp: '<historical>' prior: 0!
+ emulation of gettext runtime
+ Known limitation:  
+      currently doesn't support plural forms.
+ !

Item was added:
+ ----- Method: GetTextTranslator class>>addSystemDefaultLocaleDir: (in category 'translation data layout') -----
+ addSystemDefaultLocaleDir: dir
+ 	"new dir will be put as first"
+  	self systemDefaultLocaleDirs addFirst: dir!

Item was added:
+ ----- Method: GetTextTranslator class>>availableLanguageLocaleIDs (in category 'accessing') -----
+ availableLanguageLocaleIDs
+ 	"GetTextTranslator availableLanguageLocaleIDs"
+ 	| ids dirs localeDirForLang directoryNames |
+ 	ids := Set new.
+ 	dirs := Set new.
+ 	dirs addAll: LocaleDirsForDomain values.
+ 	dirs addAll: self defaultLocaleDirs.
+ 	dirs do: [:dir |
+ 		| localesDir |
+ 		localesDir := FileDirectory on: dir. 
+ 		directoryNames := [localesDir directoryNames] on: InvalidDirectoryError do: [:e | #()].
+ 		directoryNames
+ 				do: [:langDirName | 
+ 					| localeID  |
+ 					localeID := LocaleID posixName: langDirName.
+ 					localeDirForLang := localesDir directoryNamed: (self langDirNameForLocaleID: localeID).
+ 					localeDirForLang ifNotNil: [
+ 						(localeDirForLang fileNamesMatching: '*.mo') ifNotEmpty: [ids add: localeID]
+ 					]
+ 				].
+ 	].
+ 	^ids!

Item was added:
+ ----- Method: GetTextTranslator class>>defaultLocaleDirs (in category 'translation data layout') -----
+ defaultLocaleDirs
+ 	| dirs |
+ 	dirs := OrderedCollection new.
+ 	UserDefaultLocaleDirs ifNotNil: [dirs addAll: UserDefaultLocaleDirs].
+ 	dirs addAll: self systemDefaultLocaleDirs.
+ 	^dirs
+ !

Item was added:
+ ----- Method: GetTextTranslator class>>findMOForLocaleID:domain: (in category 'private') -----
+ findMOForLocaleID: id domain: aDomainName
+ 	| sepa langSubDir path |
+ 	sepa := FileDirectory slash.
+ 	langSubDir := self langDirNameForLocaleID: id.
+ 	(self localeDirsForDomain: aDomainName)
+ 		do: [:each |
+ 			path := each , sepa , langSubDir, sepa , (self moNameForDomain: aDomainName).
+ 			[(FileDirectory default fileExists: path)
+ 				 ifTrue: [^path]] on: InvalidDirectoryError do: [:e | ^nil]].
+ 	^nil.!

Item was added:
+ ----- Method: GetTextTranslator class>>initialize (in category 'class initialization') -----
+ initialize
+ 	SystemDefaultLocaleDirs := OrderedCollection new.
+ 	UserDefaultLocaleDirs := OrderedCollection new.
+ 	LocaleDirsForDomain := Dictionary new.!

Item was added:
+ ----- Method: GetTextTranslator class>>langDirNameForLocaleID: (in category 'private') -----
+ langDirNameForLocaleID: id
+ 	"returns relative path from locale directory to actual directory containing MOs"
+ 	^(id posixName) , (FileDirectory slash)  , 'LC_MESSAGES'!

Item was added:
+ ----- Method: GetTextTranslator class>>localeDirForDomain: (in category 'translation data layout') -----
+ localeDirForDomain: aDomainName
+ 	"returns registered localeDirectory for the textdomain. returns nil if not registered"
+ 	^LocaleDirsForDomain at: aDomainName ifAbsent: [nil]!

Item was added:
+ ----- Method: GetTextTranslator class>>localeDirsForDomain (in category 'private') -----
+ localeDirsForDomain
+ 	^LocaleDirsForDomain ifNil: [LocaleDirsForDomain := Dictionary new]!

Item was added:
+ ----- Method: GetTextTranslator class>>localeDirsForDomain: (in category 'translation data layout') -----
+ localeDirsForDomain: aDomainName
+ 	"returns collection of locale directories for text domain.  
+ 	This includes user defined one for the domain, user defaults and system defaults" 
+ 	| dirs dir |
+ 	dirs := OrderedCollection new.
+ 	dir := self localeDirForDomain: aDomainName.
+ 	dir ifNotNil: [dirs add: dir].
+ 	dirs addAll:  self defaultLocaleDirs.
+ 	^dirs!

Item was added:
+ ----- Method: GetTextTranslator class>>moNameForDomain: (in category 'private') -----
+ moNameForDomain: domainName
+ 	^domainName , '.mo'!

Item was added:
+ ----- Method: GetTextTranslator class>>newForLocaleID: (in category 'instance creation') -----
+ newForLocaleID: id
+ 	^self new localeID: id!

Item was added:
+ ----- Method: GetTextTranslator class>>privateStartUp (in category 'class initialization') -----
+ privateStartUp
+ 	self setupLocaleDirs.
+ 	self availableLanguageLocaleIDs do: [ :localeID |
+ 		NaturalLanguageTranslator translators 
+ 				at: localeID 
+ 				put: (self newForLocaleID: localeID).
+ 	]!

Item was added:
+ ----- Method: GetTextTranslator class>>setLocaleDir:forDoamin: (in category 'translation data layout') -----
+ setLocaleDir: path forDoamin: aDomainName
+ 	self LocaleDirsForDomain
+ 		at: aDomainName
+ 		put: path.!

Item was added:
+ ----- Method: GetTextTranslator class>>setupLocaleDirs (in category 'translation data layout') -----
+ setupLocaleDirs
+ 	| dirs sepa localesDirName |
+ 	sepa := FileDirectory slash.
+ 	SystemDefaultLocaleDirs := nil.
+ 	dirs := self systemDefaultLocaleDirs.
+ 	localesDirName := 'locale'.
+ 	dirs add:  (SmalltalkImage current imagePath) , sepa , localesDirName.
+ 	dirs add:  (SmalltalkImage current vmPath) , sepa , localesDirName.
+ 	^dirs!

Item was added:
+ ----- Method: GetTextTranslator class>>systemDefaultLocaleDirs (in category 'translation data layout') -----
+ systemDefaultLocaleDirs
+ 	^SystemDefaultLocaleDirs ifNil: [SystemDefaultLocaleDirs := OrderedCollection new]
+ !

Item was added:
+ ----- Method: GetTextTranslator class>>userDefaultLocaleDirs (in category 'translation data layout') -----
+ userDefaultLocaleDirs
+ 	^UserDefaultLocaleDirs ifNil: [UserDefaultLocaleDirs := OrderedCollection new]
+ !

Item was added:
+ ----- Method: GetTextTranslator>>atRandom (in category 'accessing') -----
+ atRandom
+ 
+ 	| v |
+ 	moFiles ifEmpty: [^ ''].
+ 	(v := moFiles atRandom value) ifNil: [^ ''].
+ 	^ v atRandom.
+ !

Item was added:
+ ----- Method: GetTextTranslator>>domainRegistered: (in category 'accessing') -----
+ domainRegistered: aDomainName
+ 	"only current translator actually load the MO, to minimize loading time.
+ 	 other translator will load anyway when it goes current"
+ 	(self class current == self) 
+ 		ifTrue: [self moFileForDomain: aDomainName].
+ 	!

Item was added:
+ ----- Method: GetTextTranslator>>domainUnregistered: (in category 'accessing') -----
+ domainUnregistered: aDomainName
+ 	moFiles removeKey: aDomainName ifAbsent: [^self]
+ 	!

Item was added:
+ ----- Method: GetTextTranslator>>initialize (in category 'initialize-release') -----
+ initialize
+ 	moFiles := Dictionary new.!

Item was added:
+ ----- Method: GetTextTranslator>>isDomainLoaded: (in category 'accessing') -----
+ isDomainLoaded: aDomainName
+ 	| mo |
+ 	mo := moFiles at: aDomainName ifAbsent: [nil].
+ 	^mo isNil not.
+ !

Item was added:
+ ----- Method: GetTextTranslator>>loadMOFileForDomain: (in category 'private') -----
+ loadMOFileForDomain: aDomainName
+ 	| moName |
+ 	moName := self class findMOForLocaleID: self localeID 
+ 								domain: aDomainName.
+ 	moName notNil
+ 			 ifTrue: [^MOFile new load: moName
+ 								localeID: self localeID]
+ 			ifFalse: [^nil]
+ !

Item was added:
+ ----- Method: GetTextTranslator>>loadMOFiles (in category 'accessing') -----
+ loadMOFiles
+ 	TextDomainManager allKnownDomains 
+ 		do: [:domainName |
+ 			self moFileForDomain: domainName
+ 		].!

Item was added:
+ ----- Method: GetTextTranslator>>moFileForDomain: (in category 'private') -----
+ moFileForDomain: domainName
+ 	^moFiles at: domainName ifAbsentPut: [self loadMOFileForDomain: domainName]!

Item was added:
+ ----- Method: GetTextTranslator>>reloadMOFiles (in category 'accessing') -----
+ reloadMOFiles
+ 	moFiles := Dictionary new.
+ 	self loadMOFiles.!

Item was added:
+ ----- Method: GetTextTranslator>>setCurrent (in category 'language switching') -----
+ setCurrent
+ 	"ensure actual contents of MOs is loaded on switching language"
+ 	self loadMOFiles!

Item was added:
+ ----- Method: GetTextTranslator>>translate:inDomain: (in category 'translation') -----
+ translate: aString inDomain: aDomainName
+ 	| mo |
+ 	mo := self moFileForDomain: aDomainName.
+ 	^mo isNil 
+ 		ifTrue: [aString] 
+ 		ifFalse: [mo translationFor: aString]
+ !

Item was added:
+ Object subclass: #MOFile
+ 	instanceVariableNames: 'localeID fileName isLittleEndian magic revision nStrings originalTableOffset translatedTableOffset hashTableSize hashTableOffset hashTable originalStrings translatedStrings translations'
+ 	classVariableNames: 'Cr Lf'
+ 	poolDictionaries: ''
+ 	category: 'System-Localization'!
+ 
+ !MOFile commentStamp: '<historical>' prior: 0!
+ Wrapper for MO file of gettext.
+ Known limitation:  
+ 	currently don't support prural form.
+ 	translation strings have to be encoded in utf-8.
+ 
+ Implementation notes:
+ 	Testing on XO showed emulation of hash search without plugin + on demand loading is slow.
+ 	The test also showed conversion of utf8 string to Squeak's String is really slow (especially for non-latin language).
+ 	so in this version, all of original/translated strings are loaded on initiaization,
+ 	but "translated strings" is left as ByteString on loading time, to reduce loading time.
+ 	After that the translated string is converted on demand. 
+ !

Item was added:
+ ----- Method: MOFile class>>fileName:localeID: (in category 'instance creation') -----
+ fileName: path localeID: id
+ 	^self new 
+ 			load:path localeID: id!

Item was added:
+ ----- Method: MOFile class>>initialize (in category 'class initialization') -----
+ initialize
+ 	Cr := Character cr.
+ 	Lf := Character lf.
+ !

Item was added:
+ ----- Method: MOFile>>atRandom (in category 'public') -----
+ atRandom
+ 
+ 	^ self translatedString:nStrings atRandom.
+ !

Item was added:
+ ----- Method: MOFile>>fileName (in category 'public') -----
+ fileName
+ 	^fileName!

Item was added:
+ ----- Method: MOFile>>fileName: (in category 'public') -----
+ fileName: path
+ 	fileName := path!

Item was added:
+ ----- Method: MOFile>>hashPjw: (in category 'experimental') -----
+ hashPjw: aString
+ 	"So called `hashpjw' function by P.J. Weinberger
+    	[see Aho/Sethi/Ullman, COMPILERS: Principles, Techniques and Tools,
+    	1986, 1987 Bell Telephone Laboratories, Inc.] "
+ 	| stringSize hash g |
+ 	stringSize := aString size.
+ 	hash := 0.
+ 	1 to: stringSize do: [:pos |
+ 		hash := hash bitShift: 4.
+ 		hash := hash + ((aString at: pos) asInteger).
+ 		g := hash bitAnd: 16rF0000000.
+ 		g = 0 ifFalse: [
+ 			hash := hash  bitXor: (g bitShift: -24).
+ 			hash := hash bitXor: g.
+ 		]
+ 	].
+ 	^hash.
+ !

Item was added:
+ ----- Method: MOFile>>load1:localeID: (in category 'experimental') -----
+ load1: aFileName localeID: id
+ 	"CASE1: 
+ 		all of strings are loaded. 
+ 		translation strings are converted to Squeak format on load time.
+ 		original-string/index pairs are registerd to Dictionary on load time.
+ 		hash search can't be used"
+ 	| strm originalTable translatedTable |
+ 	localeID := id.
+ 	strm := FileStream readOnlyFileNamed: aFileName.
+ 	fileName := aFileName.
+ 	[
+ 		self loadHeader: strm.
+ 		originalTable := self loadStringPointers: strm 
+ 								offset: originalTableOffset.
+ 
+ 		originalStrings := self loadStrings: strm 
+ 								pointers: originalTable.
+ 
+ 		translatedTable := self loadStringPointers: strm 
+ 								offset: translatedTableOffset.
+ 
+ 		translatedStrings := self loadStrings: strm 
+ 								pointers: translatedTable
+ 								encoding: 'utf8'
+ 								languageEnvironment: (Locale localeID: localeID) languageEnvironment .
+ 
+ 		translations := Dictionary new.
+ 		1 to: nStrings do: [:index |
+ 			| key |
+ 			key := originalStrings at: index.
+ 			translations at: key put: index.
+ 		].
+ 		originalTable := nil.
+ 	] ensure: [strm close].!

Item was added:
+ ----- Method: MOFile>>load4:localeID: (in category 'experimental') -----
+ load4: aFileName localeID: id
+ 	"CASE4: 
+ 		all of strings are loaded. 
+ 		loading and conversion of translation strings to Squeak format is executed on initialization time.
+ 		only hash search can be used"
+ 	| strm originalTable translatedTable |
+ 	localeID := id.
+ 	strm := FileStream readOnlyFileNamed: aFileName.
+ 	fileName := aFileName.
+ 	[
+ 		self loadHeader: strm.
+ 		self loadHashTable: strm.
+ 		originalTable := self loadStringPointers: strm 
+ 								offset: originalTableOffset.
+ 
+ 		originalStrings := self loadStrings: strm 
+ 								pointers: originalTable.
+ 
+ 		translatedTable := self loadStringPointers: strm 
+ 								offset: translatedTableOffset.
+ 
+ 		translatedStrings := self loadStrings: strm 
+ 								pointers: translatedTable
+ 								encoding: 'utf-8'
+ 								languageEnvironment: (Locale localeID: localeID) languageEnvironment .
+ 	] ensure: [strm close].!

Item was added:
+ ----- Method: MOFile>>load:localeID: (in category 'public') -----
+ load: aFileName localeID: id
+ 	"all of original/translated strings are loaded. 
+ 		but conversion of translation string (in utf-8 bytestring) to Squeak format will be defered.
+ 		original-string/index pairs are registerd to Dictionary on load time.
+ 		hash search can't be used"
+ 	| strm originalTable translatedTable |
+ 	localeID := id.
+ 	strm := FileStream readOnlyFileNamed: aFileName.
+ 	fileName := aFileName.
+ 	[
+ 		self loadHeader: strm.
+ 		originalTable := self loadStringPointers: strm 
+ 								offset: originalTableOffset.
+ 
+ 		originalStrings := self loadStrings: strm 
+ 								pointers: originalTable.
+ 
+ 		translatedTable := self loadStringPointers: strm 
+ 								offset: translatedTableOffset.
+ 
+ 		translatedStrings := self loadStrings: strm 
+ 								pointers: translatedTable.
+ 
+ 		translations := Dictionary new: nStrings * 2.  "make too enough room to avoid #grow"
+ 		1 to: nStrings do: [:index |
+ 			| key |
+ 			key := originalStrings at: index.
+ 			translations at: key put: index.
+ 		].
+ 		originalStrings := nil.
+ 	] ensure: [strm close].!

Item was added:
+ ----- Method: MOFile>>loadHashTable: (in category 'experimental') -----
+ loadHashTable: strm
+ 	| entry |
+ 	hashTable := IntegerArray  ofSize: hashTableSize.
+ 	strm binary.
+ 	strm position: hashTableOffset.
+ 	1 to: hashTableSize do: [:index |
+ 		entry := self nextInt32From: strm.
+ 		hashTable at:  index put: entry.
+ 	]!

Item was added:
+ ----- Method: MOFile>>loadHeader: (in category 'private') -----
+ loadHeader: strm
+ 	strm binary.
+ 	magic :=  strm uint32.
+ 	magic = 16rDE120495 
+ 		ifTrue: [isLittleEndian := true]
+ 		ifFalse: [
+ 			magic = 16r950412DE 
+ 				ifTrue: [isLittleEndian := false]
+ 				ifFalse: [ self error: 'invalid MO']
+ 		].
+ 	revision := self nextInt32From: strm.
+ 	nStrings := self nextInt32From: strm.
+ 	originalTableOffset := self nextInt32From: strm.
+ 	translatedTableOffset := self nextInt32From: strm.
+ 	hashTableSize := self nextInt32From: strm.
+ 	hashTableOffset := self nextInt32From: strm.
+ !

Item was added:
+ ----- Method: MOFile>>loadString:pointer:length: (in category 'private') -----
+ loadString: strm pointer: top  length: len
+ 	| str |
+ 	str := ByteString new: len.
+ 	strm position:  top.
+ 	strm nextInto: str.
+ 	^str replaceAll: Lf with: Cr.
+ !

Item was added:
+ ----- Method: MOFile>>loadStringPointers:offset: (in category 'private') -----
+ loadStringPointers: strm offset: tableOffset
+ 	"returns tupple {arrayOfOffsetToString  arrayOfLengthOfString}"
+ 	| offsetTable lenTable len offset tupple |
+ 	offsetTable := IntegerArray new: nStrings.
+ 	lenTable := IntegerArray new: nStrings.
+ 	strm binary.
+ 	strm position: tableOffset.
+ 	1 to: nStrings do: [:index |
+ 		len := self nextInt32From: strm.
+ 		offset := self nextInt32From: strm.
+ 		offsetTable at: index put: offset.
+ 		lenTable at: index put: len.
+ 	].
+ 	tupple := Array new: 2.
+ 	tupple at: 1 put: offsetTable.
+ 	tupple at: 2 put:  lenTable.
+ 	^tupple
+ !

Item was added:
+ ----- Method: MOFile>>loadStrings:pointers: (in category 'private') -----
+ loadStrings: strm pointers: table
+ 	^self loadStrings: strm pointers: table encoding: nil languageEnvironment: nil
+ !

Item was added:
+ ----- Method: MOFile>>loadStrings:pointers:encoding:languageEnvironment: (in category 'private') -----
+ loadStrings: strm pointers: tupple encoding: encodingName languageEnvironment: env
+ 	| strings rawStr str offsetTable lenTable |
+ 	offsetTable :=  tupple first.
+ 	lenTable := tupple second.
+ 	strings := Array new: nStrings.
+ 	1 to: nStrings do: [:index |
+ 		rawStr := self loadString: strm 
+ 					pointer:  (offsetTable at: index)
+ 					length: (lenTable at: index).
+ 		str := encodingName isNil ifTrue: [rawStr] 
+ 						ifFalse: [ encodingName = 'utf8' 
+ 									ifTrue: [rawStr utf8ToSqueak applyLanguageInfomation: env]
+ 									ifFalse: [self error: 'this encoding isn''t supported']
+ 						].
+ 		strings at: index put: str.
+ 	].
+ 	^strings.!

Item was added:
+ ----- Method: MOFile>>nextInt32From: (in category 'private') -----
+ nextInt32From: strm
+ 	^isLittleEndian 
+ 			ifTrue: [^strm nextLittleEndianNumber: 4]
+ 			ifFalse: [^strm nextInt32]!

Item was added:
+ ----- Method: MOFile>>originalString: (in category 'private') -----
+ originalString: index
+ 	^originalStrings at: index.
+ !

Item was added:
+ ----- Method: MOFile>>searchByDictionary: (in category 'public') -----
+ searchByDictionary: aString
+ 	| index |
+ 	index := translations at: aString ifAbsent: [^nil].
+ 	^self translatedString: index
+ 	
+ !

Item was added:
+ ----- Method: MOFile>>searchByHash: (in category 'experimental') -----
+ searchByHash: aString
+ 	| hashValue nstr index incr key |
+ 	hashValue :=  self hashPjw: aString.
+ 	incr := 1 + (hashValue \\ (hashTableSize -2)).
+ 	index := (hashValue \\ hashTableSize) .
+ 	[ 	nstr := (hashTable at: index +1 ).
+ 		nstr = 0 ifTrue: [^nil].
+ 		key := self originalString: nstr.
+ 		key = aString ifTrue: [^self translatedString: nstr].
+ 		index >= (hashTableSize - incr) 
+ 				ifTrue: [index := index - (hashTableSize - incr)  ]
+ 				ifFalse:[index := index + incr].	
+ 	] doWhileTrue: true.!

Item was added:
+ ----- Method: MOFile>>testSearchByDictionary (in category 'experimental') -----
+ testSearchByDictionary
+ 	InternalTranslator allKnownPhrases 
+ 		do: [:each |
+ 			self searchByDictionary: each
+ 		].
+ 	!

Item was added:
+ ----- Method: MOFile>>testSearchByHash (in category 'experimental') -----
+ testSearchByHash
+ 	InternalTranslator allKnownPhrases 
+ 		do: [:each |
+ 			self searchByHash: each
+ 		].
+ 	!

Item was added:
+ ----- Method: MOFile>>translateByHash: (in category 'experimental') -----
+ translateByHash: aString
+ 	| trans |
+ 	trans := self searchByHash: aString.
+ 	trans isNil ifTrue: [^aString]
+ 			ifFalse: [^trans].
+ !

Item was added:
+ ----- Method: MOFile>>translatedString: (in category 'private') -----
+ translatedString: index
+ 	"KNOWN PROBLEM: conversion is executed everytimes this method called"
+ 	| str |
+ 	str := translatedStrings at: index.
+ 
+ 	^str utf8ToSqueak applyLanguageInfomation: (Locale localeID: localeID) languageEnvironment.
+ !

Item was added:
+ ----- Method: MOFile>>translationFor: (in category 'public') -----
+ translationFor: aString 
+ 	| |
+ 	aString size = 0 ifTrue: [^ '']. "Gettext header"
+ 	^ (self searchByDictionary: aString) ifNil: [aString]
+ !

Item was changed:
  ----- Method: Project>>future:send:at:args: (in category 'futures') -----
  future: receiver send: aSelector at: deltaMSecs args: args
  	"Send a message deltaSeconds into the future.  Answers a Promise that will be resolved at some time in the future."
+ 	| pr closure |
- 	| pr |
  	pr := Promise new.
+ 	closure := [pr resolveWith: (receiver perform: aSelector withArguments: args)].
  	deltaMSecs = 0
+ 		ifTrue: [self addDeferredUIMessage: closure]
- 		ifTrue: [
- 			self addDeferredUIMessage: 
- 				[pr resolveWith: (receiver perform: aSelector withArguments: args)]
- 		]
  		ifFalse: [
  			[	(Delay forMilliseconds: deltaMSecs) wait.
  				self addDeferredUIMessage: 
+ 					closure
- 					[pr resolveWith: (receiver perform: aSelector withArguments: args)]
  			] forkAt: Processor userSchedulingPriority + 1.
  		].
  	^pr
  		!

Item was added:
+ ----- Method: String>>literalStringsDo: (in category '*System-Localization') -----
+ literalStringsDo: aBlock 
+ 	"Assuming the receiver receiver is a literal, evaluate aBlock with all Strings (but not Symbols) within it."
+ 	aBlock value: self!

Item was added:
+ ----- Method: String>>translated (in category '*System-Localization') -----
+ translated
+ 	"answer the receiver translated to the default language"
+ 	| translation |
+ 	translation := self
+ 		translatedTo: LocaleID current
+ 		inDomain: (TextDomainManager domainOfMethod: thisContext sender method).
+ 	self == translation ifTrue: [^self translatedInAllDomains].
+ 	^translation!

Item was added:
+ ----- Method: String>>translatedIfCorresponds (in category '*System-Localization') -----
+ translatedIfCorresponds
+ 	"answer the receiver translated to the default language only if 
+ 	the receiver begins and ends with an underscore (_)"
+ 	^ ('_*_' match: self)
+ 		ifTrue: [(self copyFrom: 2 to: self size - 1) translated]
+ 		ifFalse: [self]!

Item was added:
+ ----- Method: String>>translatedInAllDomains (in category '*System-Localization') -----
+ translatedInAllDomains
+ 	| translation |
+ 	"Transcript show: self printString, ' translatedInAllDomains'; cr."
+ 	TextDomainManager allKnownDomains do: [:domain |
+ 		translation := self translatedTo: LocaleID current inDomain: domain.
+ 		self = translation ifFalse: [^translation]
+ 	].
+ 	^self!

Item was added:
+ ----- Method: String>>translatedInAnyDomain (in category '*System-Localization') -----
+ translatedInAnyDomain
+ 	| translation |
+ 	Transcript show: self printString, ' translatedInAnyDomain'; cr.
+ 	TextDomainManager allKnownDomains do: [:domain |
+ 		translation := self translatedInDomain: domain.
+ 		self = translation ifFalse: [^translation]].
+ 	^self!

Item was added:
+ ----- Method: String>>translatedInDomain: (in category '*System-Localization') -----
+ translatedInDomain: aDomainName
+ 	| translation |
+ 	translation := self translatedTo: LocaleID current inDomain: aDomainName.
+ 	self == translation ifTrue: [^self translatedInAllDomains].
+ 	^translation
+ !

Item was added:
+ ----- Method: String>>translatedInDomain:or: (in category '*System-Localization') -----
+ translatedInDomain: aDomainName or: anotherDomainName
+ 	| translation |
+ 	translation := self translatedTo: LocaleID current inDomain: aDomainName.
+ 	self == translation ifTrue: [^self translatedInDomain: anotherDomainName].
+ 	^translation
+ !

Item was added:
+ ----- Method: String>>translatedNoop (in category '*System-Localization') -----
+ translatedNoop
+ 	"This is correspondence gettext_noop() in gettext."
+ 	^ self!

Item was added:
+ ----- Method: String>>translatedTo: (in category '*System-Localization') -----
+ translatedTo: localeID 
+ 	"answer the receiver translated to the given locale id"
+ 	^ self translatedTo: localeID inDomain: (TextDomainManager domainOfMethod: thisContext sender method).!

Item was added:
+ ----- Method: String>>translatedTo:inDomain: (in category '*System-Localization') -----
+ translatedTo: localeID inDomain: aDomainName
+ 	"answer the receiver translated to the given locale id in the textdomain"
+ 
+ 	^ NaturalLanguageTranslator translate: self 
+ 								toLocaleID: localeID 
+ 								inDomain:  aDomainName!

Item was changed:
  Object subclass: #SystemNavigation
+ 	instanceVariableNames: 'browserClass hierarchyBrowserClass environment'
- 	instanceVariableNames: 'browserClass hierarchyBrowserClass'
  	classVariableNames: 'Default'
  	poolDictionaries: ''
  	category: 'System-Support'!
  
  !SystemNavigation commentStamp: 'mha 8/26/2010 09:02' prior: 0!
  I support the navigation of the system. I act as a facade but as I could require some state
  or different way of navigating the system all my behavior are on the instance side.
  
  
  For example if you want to look at all methods you have written or changed in the current image do
  
  SystemNavigation new browseAllSelect: [ :method |
         method fileIndex > 1 "only look at changes file"
         and: [ method timeStamp beginsWith: 'your-initials-here' ] ].
  
  !

Item was added:
+ ----- Method: SystemNavigation class>>for: (in category 'accessing') -----
+ for: anEnvironment
+ 	^ self basicNew initializeWithEnvironment: anEnvironment.!

Item was changed:
  ----- Method: SystemNavigation>>allBehaviorsDo: (in category 'query') -----
  allBehaviorsDo: aBlock 
  	"Evaluate the argument, aBlock, for each kind of Behavior in the system 
  	(that is, Object and its subclasses and Traits).
  	ar 7/15/1999: The code below will not enumerate any obsolete or anonymous
  	behaviors for which the following should be executed:
  
  		Smalltalk allObjectsDo:[:obj| obj isBehavior ifTrue:[aBlock value: obj]].
  
  	but what follows is way faster than enumerating all objects."
  
+ 	self environment allClassesAndTraitsDo: aBlock.!
- 	Class rootsOfTheWorld do:
- 		[:root|
- 		root withAllSubclassesDo:
- 			[:class|
- 			class isMeta ifFalse: "The metaclasses are rooted at Class; don't include them twice."
- 				[aBlock value: class; value: class class]]].
- 	ClassDescription allTraitsDo: aBlock!

Item was changed:
  ----- Method: SystemNavigation>>allClasses (in category 'query') -----
  allClasses
  	"currently returns all the classes defined in Smalltalk but could be customized 
  	for dealing with environments and in such a case would return on really all the classes"
  
+ 	^ self environment allClasses!
- 	^ Smalltalk allClasses
- 
- 	!

Item was changed:
  ----- Method: SystemNavigation>>allClassesAndTraits (in category 'query') -----
  allClassesAndTraits
  	
+ 	^ self environment allClassesAndTraits
- 	^ Smalltalk allClassesAndTraits
  
  	!

Item was changed:
  ----- Method: SystemNavigation>>allClassesDo: (in category 'query') -----
  allClassesDo: aBlock
  	"currently returns all the classes defined in Smalltalk but could be customized 
  	for dealing with environments and  in such a case would work on really all the classes"
  
+ 	^ self environment allClassesDo: aBlock
- 	^ Smalltalk allClassesDo: aBlock
  
  	!

Item was changed:
  ----- Method: SystemNavigation>>allGlobalRefsWithout: (in category 'query') -----
  allGlobalRefsWithout: classesAndMessagesPair 
  	"Answer a set of symbols that may be refs to Global names. In some  
  	sense we should only need the associations, but this will also catch, eg,  
  	HTML tag types. This method computes its result in the absence of  
  	specified classes and messages."
  	"may be a problem if namespaces are introduced as for the moment  
  	only Smalltalk is queried. sd 29/4/03"
  	| globalRefs absentClasses absentSelectors |
  	globalRefs := IdentitySet new: CompiledMethod instanceCount.
  	absentClasses := classesAndMessagesPair first.
  	absentSelectors := classesAndMessagesPair second.
- 	self flag: #shouldBeRewrittenUsingSmalltalkAllClassesDo:.
  	"sd 29/04/03"
  	Cursor execute
+ 		showWhile: [self environment allClassesDo:
+ 				[:cls | ((absentClasses includes: cls name)
- 		showWhile: [Smalltalk classNames
- 				do: [:cName | ((absentClasses includes: cName)
  						ifTrue: [{}]
+ 						ifFalse: [{cls. cls class}])
- 						ifFalse: [{Smalltalk at: cName. (Smalltalk at: cName) class}])
  						do: [:cl | (absentSelectors isEmpty
  								ifTrue: [cl selectors]
  								ifFalse: [cl selectors copyWithoutAll: absentSelectors])
  								do: [:sel | "Include all capitalized symbols for good 
  									measure"
  									(cl compiledMethodAt: sel) literalsDo: [:m |
  										((m isSymbol)
  												and: [m size > 0
  														and: [m first canBeGlobalVarInitial]])
  											ifTrue: [globalRefs add: m].
  										(m isMemberOf: Array)
  											ifTrue: [m
  													do: [:x | ((x isSymbol)
  																and: [x size > 0
  																		and: [x first canBeGlobalVarInitial]])
  															ifTrue: [globalRefs add: x]]].
  										m isVariableBinding
  											ifTrue: [m key
  													ifNotNil: [globalRefs add: m key]]]]]]].
  	^ globalRefs!

Item was changed:
  ----- Method: SystemNavigation>>allImplementedMessagesWithout: (in category 'query') -----
  allImplementedMessagesWithout: behaviorsAndSelectorsPair 
  	"Answer a set of all the selectors that are implemented in the system, computed in the absence of the supplied behaviors and selectors."
  	
  	| selectors behaviorsToReject |
  	selectors := IdentitySet new.
  	behaviorsToReject := behaviorsAndSelectorsPair first asIdentitySet.
+ 	self environment allClassesAndTraitsDo: [ :behavior |
- 	Smalltalk allClassesAndTraitsDo: [ :behavior |
  		(behaviorsToReject includes: behavior name) ifFalse: [
  			selectors
  				addAll: behavior selectors;
  				addAll: behavior classSide selectors ] ].
  	behaviorsAndSelectorsPair second do: [ :each |
  		selectors remove: each ].
  	^selectors!

Item was changed:
  ----- Method: SystemNavigation>>allSentMessagesWithout: (in category 'query') -----
  allSentMessagesWithout: classesAndMessagesPair 
  	"Answer the set of selectors which are sent somewhere in the system,  
  	computed in the absence of the supplied classes and messages."
  	| sent absentClasses absentSelectors |
  	sent := IdentitySet new: CompiledMethod instanceCount.
  	absentClasses := classesAndMessagesPair first.
  	absentSelectors := classesAndMessagesPair second.
- 	self flag: #shouldBeRewrittenUsingSmalltalkAllClassesDo:.
  	"sd 29/04/03"
  	Cursor execute showWhile: [
+ 		self environment allClassesAndTraitsDo: [:cls |
+ 			((absentClasses includes: cls name)
- 		Smalltalk classNames , Smalltalk traitNames do: [:name |
- 			((absentClasses includes: name)
  				ifTrue: [{}]
+ 				ifFalse: [{cls. cls classSide}])
- 				ifFalse: [{Smalltalk at: name. (Smalltalk at: name) classSide}])
  					do: [:each | (absentSelectors isEmpty
  						ifTrue: [each selectors]
  						ifFalse: [each selectors copyWithoutAll: absentSelectors])
  						do: [:sel | "Include all sels, but not if sent by self"
  							(each compiledMethodAt: sel) literalsDo: [:m | 
  									(m isSymbol)
  										ifTrue: ["might be sent"
  											m == sel
  												ifFalse: [sent add: m]].
  									(m isMemberOf: Array)
  										ifTrue: ["might be performed"
  											m
  												do: [:x | (x isSymbol)
  														ifTrue: [x == sel
+ 																ifFalse: [sent add: x]]]]]]]]].
+ 	"The following may be sent without being in any literal frame"
+ 	Smalltalk specialSelectors do: [:sel | sent add: sel].
+ 	Smalltalk presumedSentMessages	do: [:sel | sent add: sel].
+ 	^ sent.!
- 																ifFalse: [sent add: x]]]]]]]].
- 			"The following may be sent without being in any literal frame"
- 			1
- 				to: Smalltalk specialSelectorSize
- 				do: [:index | sent
- 						add: (Smalltalk specialSelectorAt: index)]].
- 	Smalltalk presumedSentMessages
- 		do: [:sel | sent add: sel].
- 	^ sent!

Item was changed:
  ----- Method: SystemNavigation>>allUnusedClassesWithout: (in category 'query') -----
  allUnusedClassesWithout: classesAndMessagesPair 
  	"Enumerates all classes in the system and returns a list of those that are 
  	apparently unused. A class is considered in use if it (a) has subclasses  
  	or (b) is referred to by some method or (c) has its name in use as a  
  	literal."
  	"SystemNavigation new unusedClasses"
  
  	| unused |
+ 	unused := self environment classNames asIdentitySet
- 	unused := Smalltalk classNames asIdentitySet
  				copyWithoutAll: (self allGlobalRefsWithout: classesAndMessagesPair).
  	^ unused
  		reject: [:cName | | cl | 
+ 			cl := self environment at: cName.
- 			cl := Smalltalk at: cName.
  			cl subclasses isEmpty not
  				or: [cl inheritsFrom: FileDirectory]]!

Item was added:
+ ----- Method: SystemNavigation>>environment (in category 'private') -----
+ environment
+ 	^ environment ifNil: [environment := Smalltalk globals].!

Item was added:
+ ----- Method: SystemNavigation>>initializeWithEnvironment: (in category 'initialize-release') -----
+ initializeWithEnvironment: anEnvironment
+ 	self initialize.
+ 	environment := anEnvironment.!

Item was added:
+ Object subclass: #TextDomainManager
+ 	instanceVariableNames: ''
+ 	classVariableNames: 'ClassCategories Classes DefaultDomain DomainInfos LoneClasses Packages'
+ 	poolDictionaries: ''
+ 	category: 'System-Localization'!
+ TextDomainManager class
+ 	instanceVariableNames: 'defaultDomain'!
+ 
+ !TextDomainManager commentStamp: 'fbs 5/12/2013 13:04' prior: 0!
+ I manage mapping from class category to textdomain.
+ 
+ Class variables:
+  ClassCategories	IdentityDictionary -- classCategory -> domainName 
+  Classes			IdentityDictionary -- class name (a Symbol) -> domainName   (a cache only!!)
+  DefaultDomain	String -- the default domain name
+  DomainInfos		Dictionary -- domainName -> a TextDomainInfo
+  LoneClasses		IdentityDictionary -- class name (a Symbol) -> domainName.  For classes whose entire category are not all in the same domain (BookMorph and QuickGuideMorph)
+ 
+ TextDomainManager registerCategoryPrefix: 'DrGeoII' domain: 'DrGeoII'.
+ TextDomainManager unregisterDomain: 'DrGeoII'.
+ 
+ TextDomainManager registerClass: #QuickGuideMorph domain: 'quickguides'.
+ TextDomainManager registerClass: #QuickGuideHolderMorph  domain: 'quickguides'.
+ !
+ TextDomainManager class
+ 	instanceVariableNames: 'defaultDomain'!

Item was added:
+ ----- Method: TextDomainManager class>>allKnownDomains (in category 'accessing') -----
+ allKnownDomains
+ 	"Every package has its own text domain now so it's not necessary to keep a registry of all domains, we can simply return all the packages in the image.
+ 	PROBLEM: If a package doesn't contain translations, it won't have a mo file but the GetTextTranslator will try to load it anyway. This happens when we switch languages. So far I tested it briefly and it seems to work..."
+ 	^PackageOrganizer default packageNames , {'Etoys-Tiles'}!

Item was added:
+ ----- Method: TextDomainManager class>>allMethodsWithTranslations (in category 'accessing') -----
+ allMethodsWithTranslations
+ 	"Look for #translated calls"
+ 	| methodsWithTranslations |
+ 	methodsWithTranslations := TranslatedReceiverFinder new stringReceiversWithContext: #translated.
+ 	methodsWithTranslations := methodsWithTranslations ,
+ 		(TranslatedReceiverFinder new stringReceiversWithContext: #translatedNoop).
+ 
+ 	methodsWithTranslations := methodsWithTranslations collect: [:each | each key compiledMethod].
+ 
+ 	"Look for Etoys tiles and vocabularies"
+ 	methodsWithTranslations := methodsWithTranslations , (EToyVocabulary allPhrasesWithContextToTranslate collect: [:r |
+ 		(MethodReference new setStandardClass: r second methodSymbol: r third) compiledMethod]).
+ 
+ 	^methodsWithTranslations!

Item was added:
+ ----- Method: TextDomainManager class>>cleanUp: (in category 'private') -----
+ cleanUp: aggressive
+ 	aggressive ifTrue: [self clearAllDomains].!

Item was added:
+ ----- Method: TextDomainManager class>>clearAllDomains (in category 'private') -----
+ clearAllDomains
+ 	"TextDomainManager clearAllDomains"
+ 	self systemNavigation allBehaviorsDo:
+ 		[:b|
+ 		b selectorsAndMethodsDo:
+ 			[:s :m |
+ 			m removeProperty: self textDomainProperty ifAbsent: []]]!

Item was added:
+ ----- Method: TextDomainManager class>>defaultDomain (in category 'accessing') -----
+ defaultDomain
+ 	"I'm not sure we still need a default domain. AFAIK the default domain will only be used when no domain is found. In that case, wouldn't it be better to just look for a translation in all domains?"
+ 	^defaultDomain!

Item was added:
+ ----- Method: TextDomainManager class>>defaultDomain: (in category 'accessing') -----
+ defaultDomain: aDomainName
+ 	defaultDomain := aDomainName!

Item was added:
+ ----- Method: TextDomainManager class>>domainForClass: (in category 'accessing') -----
+ domainForClass: aClass
+ 	^'etoys'!

Item was added:
+ ----- Method: TextDomainManager class>>domainForPackage: (in category 'accessing') -----
+ domainForPackage: aPackageInfo
+ 	"Package names and text domains are synonyms now"
+ 	^aPackageInfo name!

Item was added:
+ ----- Method: TextDomainManager class>>domainOfMethod: (in category 'accessing') -----
+ domainOfMethod: aCompiledMethod 
+ 	^ aCompiledMethod
+ 		propertyValueAt: self textDomainProperty
+ 		ifAbsent: [self updateDomainOfMethod: aCompiledMethod] !

Item was added:
+ ----- Method: TextDomainManager class>>initialize (in category 'class initialization') -----
+ initialize
+ 	"	TextDomainManager initialize	"
+ 	self defaultDomain: 'Etoys'!

Item was added:
+ ----- Method: TextDomainManager class>>textDomainProperty (in category 'private') -----
+ textDomainProperty
+ 	^#textDomain!

Item was added:
+ ----- Method: TextDomainManager class>>updateDomainOfAllMethodsWithTranslations (in category 'private') -----
+ updateDomainOfAllMethodsWithTranslations
+ 	self allMethodsWithTranslations do: [:each |
+ 		self updateDomainOfMethod: each]!

Item was added:
+ ----- Method: TextDomainManager class>>updateDomainOfMethod: (in category 'private') -----
+ updateDomainOfMethod: aCompiledMethod 
+ 	"First it looks for the package of the method reference (using
+ 	the PackageOrganizer: deadly slow). If the method doesn't
+ 	belong to any package it uses the default domain. Finally it
+ 	stores the text domain of the method using a method
+ 	property, this way we gain performance the next time we
+ 	translate the same method because we avoid the use of
+ 	PackageOrganizer. Have I mentioned it is really slow? :)"
+ 	| package |
+ 	package := PackageOrganizer default
+ 				packageOfMethod: aCompiledMethod methodReference
+ 				ifNone: [].
+ 	^ aCompiledMethod
+ 		propertyValueAt: self textDomainProperty
+ 		put: (package isNil
+ 				ifTrue: [TextDomainManager defaultDomain]
+ 				ifFalse: [package name])!

Item was added:
+ Object subclass: #TranslatedReceiverFinder
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'System-Localization'!

Item was added:
+ ----- Method: TranslatedReceiverFinder class>>browseNonLiteralReceivers (in category 'utilities') -----
+ browseNonLiteralReceivers
+ 	"TranslatedReceiverFinder browseNonLiteralReceivers"
+ 	SystemNavigation default
+ 		browseMessageList: self new nonLiteralReceivers  asSortedCollection
+ 		name: 'Non literal receivers of #translated'
+ 		autoSelect: 'translated'!

Item was added:
+ ----- Method: TranslatedReceiverFinder class>>makeJapaneseTranslationFile (in category 'as yet unclassified') -----
+ makeJapaneseTranslationFile
+ 	| t n |
+ 	NaturalLanguageTranslator initializeKnownPhrases.
+ 	t := TranslatedReceiverFinder new senders.
+ 	n := NaturalLanguageTranslator
+ 				localeID: (LocaleID isoLanguage: 'ja').
+ 	t
+ 		do: [:w | 
+ 			NaturalLanguageTranslator registerPhrase: w.
+ 			self
+ 				at: w
+ 				ifPresent: [:k | n phrase: w translation: k]].
+ 	n saveToFileNamed: 'ja.translation'!

Item was added:
+ ----- Method: TranslatedReceiverFinder>>arraySearch:fromArray:addTo: (in category 'private') -----
+ arraySearch: aSymbol fromArray: anArray addTo: aCollection 
+ 	"Find literals ahead of aSymbol from arrays in the method."
+ 	"BUG: it can handle just one occurrence"
+ 	"self new arraySearch: #hello fromArray: #(ignore (ignore detected
+ 	hello ignore)) addTo: Set new"
+ 	| index |
+ 	(index := anArray identityIndexOf: aSymbol) > 1
+ 		ifTrue: [aCollection add: (anArray at: index - 1) asString].
+ 	(anArray
+ 		select: [:each | each isMemberOf: Array])
+ 		do: [:each | self
+ 				arraySearch: aSymbol
+ 				fromArray: each
+ 				addTo: aCollection].
+ 	^ aCollection!

Item was added:
+ ----- Method: TranslatedReceiverFinder>>arraySearch:messageNode:addTo: (in category 'private') -----
+ arraySearch: aSymbol messageNode: aParseNode addTo: aCollection 
+ 	"Find literals ahead of aSymbol from arrays in the method."
+ 	"self new arraySearch: #hello messageNode: (self
+ 	decompile: #arraySearch:messageNode:addTo:) addTo: Set new"
+ 	self flag: #(#ignore #detected #hello ).
+ 	((aParseNode isMemberOf: LiteralNode)
+ 			and: [aParseNode key isMemberOf: Array])
+ 		ifTrue: [self
+ 				arraySearch: aSymbol
+ 				fromArray: aParseNode key
+ 				addTo: aCollection].
+ 	(aParseNode notNil
+ 			and: [aParseNode isLeaf not])
+ 		ifTrue: [aParseNode getAllChildren
+ 				do: [:child | self
+ 						arraySearch: aSymbol
+ 						messageNode: child
+ 						addTo: aCollection]].
+ 	^ aCollection!

Item was added:
+ ----- Method: TranslatedReceiverFinder>>findWordsWith:in: (in category 'accessing') -----
+ findWordsWith: aSymbol in: aMethodReference 
+ 	"Find words for translation with the symbol in a method. See
+ 	LanguageEditorTest >>testFindTranslatedWords"
+ 	"| message | 
+ 	message := MethodReference new setStandardClass: Morph class
+ 	methodSymbol: #supplementaryPartsDescriptions.
+ 	self new findWordsWIth: #translatedNoop in: message"
+ 	| messages keywords aParseNode |
+ 	aParseNode := aMethodReference decompile.
+ 	"Find from string literal"
+ 	messages := Set new.
+ 	self
+ 		search: aSymbol
+ 		messageNode: aParseNode
+ 		addTo: messages.
+ 	keywords := OrderedCollection new.
+ 	messages
+ 		select: [:aMessageNode | aMessageNode receiver isMemberOf: LiteralNode]
+ 		thenDo: [:aMessageNode | aMessageNode receiver key
+ 				literalStringsDo: [:literal | keywords add: literal]].
+ 	"Find from array literal"
+ 	self
+ 		arraySearch: aSymbol
+ 		messageNode: aParseNode
+ 		addTo: keywords.
+ 	^ keywords!

Item was added:
+ ----- Method: TranslatedReceiverFinder>>nonLiteralReceivers (in category 'accessing') -----
+ nonLiteralReceivers
+ 	"self new nonLiteralReceivers"
+ 	| receivers |
+ 	"Answer method references of non literal senders of #translated"
+ 	^ (SystemNavigation default allCallsOn: #translated)
+ 		select: [:message | 
+ 			receivers := OrderedCollection new.
+ 			self search: #translated messageNode: message decompile addTo: receivers.
+ 			receivers
+ 				anySatisfy: [:each | (each receiver isMemberOf: LiteralNode) not]]!

Item was added:
+ ----- Method: TranslatedReceiverFinder>>search:messageNode:addTo: (in category 'private') -----
+ search: aSymbol messageNode: aParseNode addTo: aCollection 
+ 	"self new search: #translated messageNode: (Project decompile: #updateLocaleDependentsWithPreviousSupplies:gently:) addTo: OrderedCollection new"
+ 
+ 	((aParseNode isMemberOf: MessageNode)
+ 			and: [(aParseNode selector isMemberOf: SelectorNode)
+ 					and: [aParseNode selector key = aSymbol]])
+ 		ifTrue: [aCollection add: aParseNode].
+ 	(aParseNode notNil
+ 			and: [aParseNode isLeaf not])
+ 		ifTrue: [aParseNode getAllChildren
+ 				do: [:child | self
+ 						search: aSymbol
+ 						messageNode: child
+ 						addTo: aCollection]].
+ 	^ aCollection!

Item was added:
+ ----- Method: TranslatedReceiverFinder>>searchBlockNode:addTo: (in category 'as yet unclassified') -----
+ searchBlockNode: aBlockNode addTo: aCollection
+ 
+ 	aBlockNode statements do: [:e |
+ 		(e isMemberOf: MessageNode) ifTrue: [self searchMessageNode: e addTo: aCollection].
+ 		(e isMemberOf: ReturnNode) ifTrue: [self searchReturnNode: e addTo: aCollection].
+ 	].
+ !

Item was added:
+ ----- Method: TranslatedReceiverFinder>>searchMessageNode:addTo: (in category 'as yet unclassified') -----
+ searchMessageNode: aMessageNode addTo: aCollection
+ 
+ 	((aMessageNode receiver isMemberOf: LiteralNode) and: [(aMessageNode selector isMemberOf: SelectorNode) and: [aMessageNode selector key = #translated]]) ifTrue: [
+ 		aCollection add: aMessageNode receiver key.
+ 	].
+ 
+ 	(aMessageNode receiver isMemberOf: BlockNode) ifTrue: [self searchBlockNode: aMessageNode receiver addTo: aCollection].
+ 	(aMessageNode receiver isMemberOf: MessageNode) ifTrue: [self searchMessageNode: aMessageNode receiver addTo: aCollection].
+ 	(aMessageNode receiver isMemberOf: ReturnNode) ifTrue: [self searchReturnNode: aMessageNode receiver addTo: aCollection].
+ 
+ 	aMessageNode arguments do: [:a |
+ 		(a isMemberOf: BlockNode) ifTrue: [self searchBlockNode: a addTo: aCollection].
+ 		(a isMemberOf: MessageNode) ifTrue: [self searchMessageNode: a addTo: aCollection].
+ 		(a isMemberOf: ReturnNode) ifTrue: [self searchReturnNode: a addTo: aCollection].
+ 	].
+ !

Item was added:
+ ----- Method: TranslatedReceiverFinder>>searchMethodNode:addTo: (in category 'as yet unclassified') -----
+ searchMethodNode: aMethodNode addTo: aCollection
+ 
+ 	(aMethodNode block isMemberOf: BlockNode) ifTrue: [self searchBlockNode: aMethodNode block addTo: aCollection].
+ 	(aMethodNode block isMemberOf: MessageNode) ifTrue: [self searchMessageNode: aMethodNode block addTo: aCollection].
+ 	(aMethodNode block isMemberOf: ReturnNode) ifTrue: [self searchReturnNode: aMethodNode block addTo: aCollection].
+ !

Item was added:
+ ----- Method: TranslatedReceiverFinder>>searchReturnNode:addTo: (in category 'as yet unclassified') -----
+ searchReturnNode: aReturnNode addTo: aCollection
+ 
+ 	(aReturnNode expr isMemberOf: BlockNode) ifTrue: [self searchBlockNode: aReturnNode expr addTo: aCollection].
+ 	(aReturnNode expr isMemberOf: MessageNode) ifTrue: [self searchMessageNode: aReturnNode expr addTo: aCollection].
+ !

Item was added:
+ ----- Method: TranslatedReceiverFinder>>senders (in category 'as yet unclassified') -----
+ senders
+ 
+ 	| m o |
+ 	m := SystemNavigation default allCallsOn: #translated.
+ 	m := m collect: [:e |
+ 		e classIsMeta ifTrue: [
+ 			(Smalltalk at: e classSymbol) class decompile: e methodSymbol.
+ 		] ifFalse: [
+ 			(Smalltalk at: e classSymbol) decompile: e methodSymbol.
+ 		]
+ 	].
+ 
+ 	o := OrderedCollection new.
+ 	m do: [:e | self searchMethodNode: e addTo: o].
+ 	^ o sort
+ !

Item was added:
+ ----- Method: TranslatedReceiverFinder>>stringReceivers (in category 'accessing') -----
+ stringReceivers
+ 	"TranslatedReceiverFinder new stringReceivers"
+ 	| stringReceivers messages |
+ 	messages := Set new.
+ 	(SystemNavigation default allCallsOn: #translated)
+ 		do: [:message | self search: #translated messageNode: message decompile addTo: messages].
+ 	stringReceivers := messages
+ 				select: [:each | each receiver isMemberOf: LiteralNode]
+ 				thenCollect: [:each | each receiver key].
+ 	^ stringReceivers asArray sort!

Item was added:
+ ----- Method: TranslatedReceiverFinder>>stringReceiversWithContext (in category 'accessing') -----
+ stringReceiversWithContext
+ 	| mrs results rr cls mn t o |
+ 	mrs := SystemNavigation default allCallsOn: #translated.
+ 	results := OrderedCollection new.
+ 	mrs do: [:mr |
+ 		rr := OrderedCollection new.
+ 		cls := Smalltalk at: mr classSymbol.
+ 		rr add: cls category.
+ 		rr add: mr classSymbol.
+ 		rr add: mr methodSymbol.
+ 		mr classIsMeta ifTrue: [
+ 			mn :=  cls class decompile: mr methodSymbol.
+ 		] ifFalse: [
+ 			mn := cls decompile: mr methodSymbol.
+ 		].
+ 		o := OrderedCollection new.
+ 		t := Set new.
+ 		self searchMessageNode: mn addTo: t.
+ 		t do: [ :te |
+ 			(te receiver isMemberOf: LiteralNode) ifTrue: [ 
+ 			    o add: te receiver key.
+ 			].
+ 		].
+ 		o ifNotEmpty: [
+ 			rr add: o.
+ 			results add: rr.
+ 		].
+ 	].
+ 	^ results.
+ 
+ !

Item was added:
+ ----- Method: TranslatedReceiverFinder>>stringReceiversWithContext: (in category 'accessing') -----
+ stringReceiversWithContext: aSymbol
+ 	"Find string receivers for a symbol.
+ 	Answer a collection of aMethodReference -> {keyword. keyword...}"
+ 	"self new stringReceiversWithContext: #translated"
+ 	| keywords methodReferences |
+ 	methodReferences := SystemNavigation default allCallsOn: aSymbol.
+ 	^ methodReferences inject: OrderedCollection new into: [:list :next |
+ 		keywords := self findWordsWith: aSymbol in: next.
+ 		keywords
+ 			ifNotEmpty: [list add: next -> keywords].
+ 		list]
+ !



More information about the Squeak-dev mailing list