'From etoys2.2 of 1 October 2007 [Letztes Update: #1690] on 8 October 2007 at 2:46:56 pm'! "Change Set: noCamels-bf Date: 8 October 2007 Author: Bert Freudenberg Consistently use space instead of capitalization to separate words in tiles. Also export space-separated words into gettext templates, reusing existing translations. ATTENTION: Changeset has been rearranged manually"! !String methodsFor: 'converting' stamp: 'bf 10/8/2007 14:15'! fromCamelCase "convert 'anExampleString' to 'an example string'" | upper nextWord start | upper := ($A to: $Z) asCharacterSet. nextWord := self indexOfAnyOf: upper. nextWord = 0 ifTrue: [^self]. start := 1. ^String streamContents: [:strm | [ strm nextPutAll: (self copyFrom: start to: nextWord-1). strm space; nextPut: (self at: nextWord) asLowercase. start := nextWord+1. nextWord := self indexOfAnyOf: upper startingAt: start. nextWord = 0 ] whileFalse. strm nextPutAll: (self copyFrom: start to: self size). ].! ! !String methodsFor: 'converting' stamp: 'bf 10/8/2007 13:55'! toCamelCase "convert 'an example string' to 'anExampleString'" (self includes: Character space) ifFalse: [^self]. ^String streamContents: [:strm | | space start | space := self indexOf: Character space. strm nextPutAll: (self copyFrom: 1 to: space-1). [ [start := space+1. space := self indexOf: Character space startingAt: start. space = start] whileTrue. space = 0 ifTrue: [space := self size+1]. start <= self size ifTrue: [ strm nextPut: (self at: start) asUppercase. strm nextPutAll: (self copyFrom: start+1 to: space-1)]. space < self size ] whileTrue].! ! !EToyVocabulary class methodsFor: 'as yet unclassified' stamp: 'bf 10/8/2007 11:18'! allPhrasesWithContextToTranslate | etoyVocab results literals | results := OrderedCollection new. etoyVocab := Vocabulary eToyVocabulary. etoyVocab initialize. "just to make sure that it's unfiltered." self morphClassesDeclaringViewerAdditions do: [:cl | (cl class includesSelector: #additionsToViewerCategories) ifTrue: [ literals := OrderedCollection new. cl additionsToViewerCategories do: [:group | group second do: [:tuple | literals add: (ScriptingSystem wordingForOperator: (tuple at: 2)). "wording" literals add: (tuple at: 3). "help string"]]. literals ifNotEmpty: [ results add: {cl category. cl. #additionsToViewerCategories. literals}]]. cl class selectors do: [:aSelector | ((aSelector beginsWith: 'additionsToViewerCategory') and: [(aSelector at: 26 ifAbsent: []) ~= $:]) ifTrue: [ literals := OrderedCollection new. (cl perform: aSelector) second do: [:tuple | literals add: (ScriptingSystem wordingForOperator: (tuple at: 2)). "wording" literals add: (tuple at: 3). "help string"]. literals ifNotEmpty: [ results add: {cl category. cl. #additionsToViewerCategories. literals}]]]]. ^results.! ! !GetTextExporter2 methodsFor: 'private' stamp: 'bf 10/8/2007 14:25'! translationFor: aKey in: translator translator ifNil: [^'']. translator translations at: aKey ifPresent: [:s | ^s]. "If we have old camelCase translations, make space-separated words" translator translations at: aKey toCamelCase ifPresent: [:s | (s includes: Character space) ifTrue: [^s]. ^s fromCamelCase]. ^''! ! !GetTextExporter2 methodsFor: 'file out' stamp: 'bf 10/8/2007 13:26'! exportBody: literals translator: translator "Export a gettext file body. literals is a dictionary of keyword -> #(MethodReference...) in the textDomain." "Build {sortKey. comment. msgid } to optimize sorting (getting category is too slow). If there are two or more methods for a mgsid, only first method (alphabetical) is used for sorting." | sorted msgid sortedMethods category sortKey comment triplets commentUnderLined | triplets := literals associations collect: [:assoc | msgid := assoc key. sortedMethods := assoc value asArray sort. category := (Smalltalk at: sortedMethods first classSymbol) category asString. sortKey := category , ',' , sortedMethods first printString , ',' , msgid. comment := (sortedMethods collect: [:each | each actualClass asString , '>>' , each methodSymbol asString]) inject: category into: [:result :methodName | result , ',' , methodName]. "Replace white spaces to _ because gettext tool might replace a space to a new line some times, and it makes difficult to take a diff." commentUnderLined := comment copyReplaceAll: ' ' with: '_'. Array with: sortKey with: commentUnderLined with: msgid]. "Sort and output the words" sorted := triplets sort: [:a :b | a first <= b first]. sorted do: [:triplet | comment := triplet second. msgid := triplet third. self exportRecordHeader: comment. self exportPhrase: msgid translation: (self translationFor: msgid in: translator)]! ! !StandardScriptingSystem methodsFor: '*WS-Sound-Override' stamp: 'bf 10/8/2007 14:33'! wordingForOperator: aSelector "Answer the wording to be seen by the user for the given operator symbol/string" | wording | wording := aSelector asString. #( (append: 'include at end') (beep: 'make sound') (clearTurtleTrails 'clear pen trails') (clearOwnersPenTrails 'clear all pen trails') (colorSees 'color sees') (distanceToPlayer 'distance to') (doScript: 'do') (forward: 'forward by') (goToRightOf: 'align after') (makeNewDrawingIn: 'start painting in') (noArrowheadsOnAllPens 'no arrowheads on pens') (playButtonHit 'play') (prepend: 'include at beginning') (recordButtonHit 'start recording') (seesColor: 'is over color') (stopButtonHit 'stop') (stopProgramatically 'stop') (tellSelfAndAllSiblings: 'send to all') (turn: 'turn by') (wearCostumeOf: 'look like') (dial: 'dial to') (playSound: 'play frequency of') (soundListening 'listening') (appendVertex 'add a vertex at end') (insertVertexAtCursor 'insert a vertex at cursor') (prependVertex 'add a vertex at beginning') (removeAllButCursor 'remove all vertices but cursor') (removeVertexAtCursor 'remove the vertex at cursor') (lineCurved 'line is curved') (lineOpened 'line is opened') ) do: [:pair | wording = pair first ifTrue: [^ pair second]]. wording := wording fromCamelCase. ^(wording includes: $:) ifTrue: [wording copyWithout: $:] ifFalse: [wording] "StandardScriptingSystem initialize" ! !