The Trunk: Tools-mt.1375.mcz
| Newsgroups | gmane.comp.lang.smalltalk.squeak.general |
|---|---|
| Message-ID | <[email protected]> |
Marcel Taeumel uploaded a new version of Tools to project The Trunk:
http://source.squeak.org/trunk/Tools-mt.1375.mcz
==================== Summary ====================
Name: Tools-mt.1375
Author: mt
Time: 7 August 2026, 3:55:09.011413 pm
UUID: 34352dd4-0a6d-4c4c-b4b6-4fe3fbc11297
Ancestors: Tools-mt.1374
Fixes minor slips in the area of locale and user-interface translations.
Note that #translated must be sent to the literal string. If not feasible, #translatedNoop can be used to flag the literal for extraction and #translate later. The combination of #withCRs and #asTextFromHtml is unfortunate for the performance as '<br>' can be used to insert line breaks.
=============== Diff against Tools-mt.1374 ===============
Item was changed:
----- Method: Browser>>copyClassesFromEnvironment:inCategory:toEnvironment:category:removeSource: (in category 'drag and drop') -----
copyClassesFromEnvironment: sourceEnvironment inCategory: sourceCategory toEnvironment: targetEnvironment category: targetCategoryOrNil removeSource: aBoolean
| allClasses classes |
classes := allClasses := (sourceEnvironment organization listAtCategoryNamed: sourceCategory) sorted
collect: [:name | sourceEnvironment classNamed: name].
((targetEnvironment allClassesAndTraits collect: [:ea | ea name]) intersection: (classes collect: [:ea | ea name])) ifNotEmpty: [:existing |
(Project uiManager
confirm:
+ ('The following <b>{2}</b> classes are already defined on the target environment <b>{1}</b>:<br><br>{3}' translated asTextFromHtml
- ('The following <b>{2}</b> classes are already defined on the target environment <b>{1}</b>:\\{3}' withCRs translated asTextFromHtml
format: {targetEnvironment. existing size. (existing collect: #printString) asCommaStringAnd truncateWithElipsisTo: 400})
trueChoice: 'Overwrite them' translated
falseChoice: 'Skip them' translated)
ifNil: [^ false];
ifFalse: [classes := classes reject: [:ea | existing includes: ea name]]].
classes do: [:class |
(self requestFullCopyOfClass: class withCategory: targetCategoryOrNil environment: targetEnvironment)
ifNil: [^ false].
aBoolean ifTrue: [
sourceEnvironment removeClassNamed: class name]].
^ classes size = allClasses size!
Item was changed:
----- Method: Browser>>copyMessageCategory:fromClass:toMessageCategory:inClass:removeSource: (in category 'drag and drop') -----
copyMessageCategory: sourceCategory fromClass: sourceClass toMessageCategory: targetCategory inClass: targetClass removeSource: aBoolean
| isSameHierarchy |
sourceClass == targetClass ifTrue: [
sourceCategory = sourceClass organization class allCategory
ifTrue: [
(self confirm: ('Really classify ALL selectors in class <b>{1}</b> under <b>{2}</b>?' translated asTextFromHtml
format: {sourceClass. targetCategory}))
ifFalse: [^ false].
sourceClass organization
classifyAll: sourceClass selectors
under: targetCategory
suppressIfDefault: false.
aBoolean ifTrue: [
sourceClass organization removeEmptyCategories]]
ifFalse: [
self
renameMessageCategory: sourceCategory
to: targetCategory
moveOrCopy: (aBoolean ifFalse: [#copy] ifTrue: [#move])].
self changed: #messageCategoryList.
self changed: #messageList.
^ true].
isSameHierarchy := (targetClass inheritsFrom: sourceClass)
or: [sourceClass inheritsFrom: targetClass].
(aBoolean not or: [isSameHierarchy]) ifFalse: [
+ (self confirm: ('Classes <b>{1}</b> and <b>{2}</b> are unrelated.<br>Are you sure you want to move this message category?' translated asTextFromHtml
- (self confirm: ('Classes <b>{1}</b> and <b>{2}</b> are unrelated.\Are you sure you want to move this message category?' withCRs translated asTextFromHtml
format: {sourceClass. targetClass}))
ifFalse: [^ false]].
self
copySelectorsFromClass: sourceClass
inCategory: sourceCategory
toClass: targetClass
category:
(targetCategory = sourceClass organization class allCategory
ifTrue: [sourceCategory]
ifFalse: [targetCategory])
removeSource: aBoolean.
self changed: #messageCategoryList.
self changed: #messageList.
^ true!
Item was changed:
----- Method: Browser>>copySelectorsFromClass:inCategory:toClass:category:removeSource: (in category 'drag and drop') -----
copySelectorsFromClass: sourceClass inCategory: sourceCategory toClass: targetClass category: targetCategoryOrNil removeSource: aBoolean
| allSelectors selectors |
selectors := allSelectors := sourceClass selectorsInCategory: sourceCategory.
(targetClass selectors intersection: selectors) ifNotEmpty: [:existing |
(Project uiManager
confirm:
+ ('The following <b>{2}</b> selectors are already implemented on the target class <b>{1}</b>:<br><br>{3}' translated asTextFromHtml
- ('The following <b>{2}</b> selectors are already implemented on the target class <b>{1}</b>:\\{3}' withCRs translated asTextFromHtml
format: {targetClass name. existing size. (existing collect: #printString) asCommaStringAnd truncateWithElipsisTo: 400})
trueChoice: 'Overwrite them' translated
falseChoice: 'Skip them' translated)
ifNil: [^ nil];
ifFalse: [selectors := selectors copyWithoutAll: existing]].
selectors do: [:selector |
self
copyMethod: sourceClass >> selector
toClass: targetClass
category: targetCategoryOrNil
removeSource: aBoolean].
^ selectors size = allSelectors size
ifTrue: [aBoolean ifTrue: [sourceClass organization removeCategory: sourceCategory]];
yourself!
Item was changed:
----- Method: Browser>>dropClass:onSystemCategory:copy: (in category 'drag and drop') -----
dropClass: aClass onSystemCategory: category copy: aBoolean
| sourceEnvironment targetEnvironment destCat newClass |
sourceEnvironment := aClass environment.
targetEnvironment := self environment.
destCat := (self isSpecialSystemCategory: category)
ifTrue: [Categorizer default "ouch ... SystemOrganizer default refuses the bequest."]
ifFalse: [category].
sourceEnvironment == targetEnvironment ifTrue: [
aBoolean ifTrue:
[newClass := (self requestFullCopyOfClass: aClass withCategory: destCat)
ifNil: [^ false].
self changed: #classList.
^ true].
self selectedEnvironment organization
classify: aClass instanceSide name
under: destCat
suppressIfDefault: true.
self changed: #classList.
^ true].
(self confirm:
((aBoolean
ifFalse: ['Are you sure you want to move the class<br><br>	<b>{1}</b><br><br>from the environment <b>{2}</b> to the environment <b>{3}</b>?' translated asTextFromHtml]
+ ifTrue: ['Are you sure you want to copy the class<br><br>	<b>{1}</b><br><br>from the environment <b>{2}</b> to the environment <b>{3}</b>?' translated asTextFromHtml])
- ifTrue: ['Are you sure you want to copy the class<br><br>	<b>{1}</b><br><br>from the environment <b>{2}</b> to the environment <b>{3}</b>?' withCRs translated asTextFromHtml])
format: {aClass. aClass environment. targetEnvironment}))
ifFalse: [^ false].
newClass := (self requestFullCopyOfClass: aClass withCategory: destCat environment: targetEnvironment)
ifNil: [^ false].
aBoolean ifFalse: [
sourceEnvironment removeClassNamed: aClass name].
self changed: #classList.
^ true!
Item was changed:
----- Method: Browser>>dropMethod:onClass:category:copy: (in category 'drag and drop') -----
dropMethod: method onClass: targetClass category: categoryBlock copy: copy
| sourceClass getCat isSameHierarchy |
sourceClass := method methodClass.
isSameHierarchy := nil.
getCat := [(categoryBlock cull: isSameHierarchy) ifNil: [sourceClass whichCategoryIncludesSelector: method selector]].
sourceClass == targetClass ifTrue: [
isSameHierarchy := true.
targetClass organization
classify: method selector
under: getCat value
suppressIfDefault: false
logged: true.
self changed: #messageCategoryList.
self changed: #messageList.
^ true].
isSameHierarchy := (targetClass inheritsFrom: sourceClass)
or: [sourceClass inheritsFrom: targetClass].
(copy or: [isSameHierarchy])
ifFalse: [
+ (self confirm: ('Classes <b>{1}</b> and <b>{2}</b> are unrelated.<br>Are you sure you want to move this method?' translated asTextFromHtml
- (self confirm: ('Classes <b>{1}</b> and <b>{2}</b> are unrelated.\Are you sure you want to move this method?' withCRs translated asTextFromHtml
format: {sourceClass. targetClass}))
ifFalse: [^ false]].
(targetClass includesSelector: method selector) ifTrue:
+ [(self confirm: ('Class <b>{1}</b> already contains a method <b>{2}</b>.<br>Do you want to overwrite it?' translated asTextFromHtml format: {targetClass. method selector}))
- [(self confirm: ('Class <b>{1}</b> already contains a method <b>{2}</b>.\Do you want to overwrite it?' withCRs translated asTextFromHtml format: {targetClass. method selector}))
ifFalse: [^ false]].
self
copyMethod: method
toClass: targetClass
category: getCat value
removeSource: copy not.
self changed: #messageCategoryList.
self changed: #messageList.
^ true!
Item was changed:
----- Method: Browser>>requestFullCopyOfClass:title:superclass:category:environment: (in category 'drag and drop') -----
requestFullCopyOfClass: aClass title: title superclass: superclassOrNil category: categoryOrNil environment: anEnvironment
| definition newClass newName |
self flag: #refactor. "ct: we really need a ClassDefinition object for parsing without building..."
definition := aClass definition.
superclassOrNil ifNotNil: [:superclass |
definition := definition
copyWithRegex: ('^{1}(?= (s|\\p\{L\}+S)ubclass\\:)' format: {aClass superclass name escapeForRegex})
matchesReplacedWith: superclass name].
categoryOrNil ifNotNil: [:category |
definition := definition
copyWithRegex: ('(?<=category\\: ''){1}(?='')' format: {aClass category escapeForRegex})
matchesReplacedWith: category].
[definition := Project uiManager
multiLineRequest: title
initialAnswer: definition.
definition isEmptyOrNil ifTrue: [^ nil].
newName := Symbol readFromString:
('(?<=((s|\p{L}+S)ubclass\:|named\:) )#\S+' asRegex
search: definition;
subexpression: 1).
(anEnvironment classNamed: newName) ifNil: [true] ifNotNil: [:existing |
(Project uiManager
+ confirm: ('Environment <b>{1}</b> already contains a class <b>{2}</b>.' translated asTextFromHtml format: {anEnvironment. existing})
- confirm: ('Environment <b>{1}</b> already contains a class <b>{2}</b>.' withCRs translated asTextFromHtml format: {anEnvironment. existing})
trueChoice: 'Overwrite it' translated
falseChoice: 'Choose different name' translated)
ifNil: [^ nil]]]
whileFalse.
newClass := anEnvironment beCurrentDuring:
[Compiler evaluate: definition environment: anEnvironment].
self copySelectorsFromClass: aClass toClass: newClass.
^ newClass!
Item was changed:
----- Method: Debugger>>contextVariablesInspectorHelp (in category 'toolbuilder') -----
contextVariablesInspectorHelp
^ self hasContextSelected
+ ifTrue: ['Other\Context\Bindings' translated withCRs]
+ ifFalse: ['Process\Bindings' translated withCRs]!
- ifTrue: ['Other\Context\Bindings' withCRs translated]
- ifFalse: ['Process\Bindings' withCRs translated]!
Item was changed:
----- Method: Debugger>>receiverInspectorHelp (in category 'toolbuilder') -----
receiverInspectorHelp
^ self hasContextSelected
+ ifTrue: ['Receiver''s\Instance\Variables' translated withCRs]
+ ifFalse: ['Signaled\Exception' translated withCRs]!
- ifTrue: ['Receiver''s\Instance\Variables' withCRs translated]
- ifFalse: ['Signaled\Exception' withCRs translated]!
Item was changed:
----- Method: Inspector>>replaceSelectionValue: (in category 'selection') -----
replaceSelectionValue: anObject
"Set the value of the selected field to anObject. We have to answer whether this replacement worked or not."
| target |
(target := self ensureSelectedField) ifNil: [^ false].
target type = #self ifTrue: [
^ (self confirm: 'This will exchange the inspected object.' translated)
ifTrue: [self inspect: anObject. true]
ifFalse: [false]].
target isReadOnly ifTrue: [
+ self inform: 'You cannot replace the selected field because\it is read-only. Try to add a field setter.' translated withCRs.
- self inform: 'You cannot replace the selected field because\it is read-only. Try to add a field setter.' withCRs translated.
^ false].
self contentsTyped: nil. "Ensure to refresh the contents view."
target
setValueFor: self
to: anObject.
^ true!
Squeak-dev mailing list -- [email protected]
To unsubscribe send an email to [email protected]