Squeak-dev February 2017

squeak-dev@lists.squeakfoundation.org

40 participants
201 discussions

The Inbox: Tests-jr.366.mcz
by commits＠source.squeak.org 28 Feb '17

28 Feb '17

A new version of Tests was added to project The Inbox: http://source.squeak.org/inbox/Tests-jr.366.mcz ==================== Summary ==================== Name: Tests-jr.366 Author: jr Time: 28 February 2017, 2:27:19.211388 pm UUID: a91286d9-df10-e24e-b128-dc03557db77a Ancestors: Tests-eem.363 fix: MCEnvironmentLoadTest must import required classes the "curiously" comment is apparently out of date =============== Diff against Tests-eem.363 =============== Item was changed: ----- Method: MCEnvironmentLoadTest>>setUp (in category 'running') ----- setUp environment := Environment named: 'MCEnvironmentLoadTest'. "This is required in order to not importSelf more than once" environment stopObserving: environment. "This is required to make own declarations visible in environment" environment importSelf. "Import the required PoolDictionary used by the package" environment bindingOf: #MCMockAPoolDictionary + ifAbsent: [environment from: Smalltalk globals import: #MCMockAPoolDictionary]. + environment from: Smalltalk globals import: #(MCMock MCSnapshotTest Object).! - ifAbsent: [environment from: Smalltalk globals import: #MCMockAPoolDictionary] - - "Curiously, the superclass MCMock will be used, but does not have to be imported, don't ask why..."!

1 0

The Inbox: Tests-jr.365.mcz
by commits＠source.squeak.org 28 Feb '17

28 Feb '17

A new version of Tests was added to project The Inbox: http://source.squeak.org/inbox/Tests-jr.365.mcz ==================== Summary ==================== Name: Tests-jr.365 Author: jr Time: 28 February 2017, 2:23:20.261388 pm UUID: 972a25d7-62b8-4141-b85e-832a66b4760d Ancestors: Tests-eem.363 fix: MCEnvironmentLoadTest must import required classes the "curiously" comment is apparently out of date =============== Diff against Tests-eem.363 =============== Item was changed: SystemOrganization addCategory: #'Tests-Bugs'! SystemOrganization addCategory: #'Tests-Compiler'! SystemOrganization addCategory: #'Tests-Dependencies'! SystemOrganization addCategory: #'Tests-Digital Signatures'! SystemOrganization addCategory: #'Tests-Environments'! SystemOrganization addCategory: #'Tests-Exceptions'! SystemOrganization addCategory: #'Tests-FilePackage'! SystemOrganization addCategory: #'Tests-Files'! SystemOrganization addCategory: #'Tests-Finalization'! SystemOrganization addCategory: #'Tests-Hex'! SystemOrganization addCategory: #'Tests-Installer-Core'! SystemOrganization addCategory: #'Tests-Localization'! SystemOrganization addCategory: #'Tests-Monticello'! SystemOrganization addCategory: #'Tests-Monticello-Mocks'! SystemOrganization addCategory: #'Tests-Monticello-Utils'! SystemOrganization addCategory: #'Tests-Object Events'! SystemOrganization addCategory: #'Tests-ObjectsAsMethods'! SystemOrganization addCategory: #'Tests-PrimCallController'! SystemOrganization addCategory: #'Tests-Release'! SystemOrganization addCategory: #'Tests-System-Object Storage'! SystemOrganization addCategory: #'Tests-System-Support'! SystemOrganization addCategory: #'Tests-Utilities'! SystemOrganization addCategory: #'Tests-VM'! SystemOrganization addCategory: #'Tests-System-Digital Signatures'! SystemOrganization addCategory: #'Tests-System-Preferences'! + SystemOrganization addCategory: #'Tests-OSProcess'! + SystemOrganization addCategory: #'Tests-MonticelloMocks'! Item was changed: ----- Method: MCEnvironmentLoadTest>>setUp (in category 'running') ----- setUp environment := Environment named: 'MCEnvironmentLoadTest'. "This is required in order to not importSelf more than once" environment stopObserving: environment. "This is required to make own declarations visible in environment" environment importSelf. "Import the required PoolDictionary used by the package" environment bindingOf: #MCMockAPoolDictionary + ifAbsent: [environment from: Smalltalk globals import: #MCMockAPoolDictionary]. + environment from: Smalltalk globals import: #(MCMock MCSnapshotTest Object).! - ifAbsent: [environment from: Smalltalk globals import: #MCMockAPoolDictionary] - - "Curiously, the superclass MCMock will be used, but does not have to be imported, don't ask why..."!

1 0

The Inbox: ToolsTests-jr.79.mcz
by commits＠source.squeak.org 28 Feb '17

28 Feb '17

A new version of ToolsTests was added to project The Inbox: http://source.squeak.org/inbox/ToolsTests-jr.79.mcz ==================== Summary ==================== Name: ToolsTests-jr.79 Author: jr Time: 28 February 2017, 2:07:52.478388 pm UUID: 633800f6-1e23-1744-8e1a-01ecd6e88cd2 Ancestors: ToolsTests-eem.78 change testSelectedEnvironment to fit with Tools-jr.745 =============== Diff against ToolsTests-eem.78 =============== Item was changed: ----- Method: BrowserTest>>testSelectedEnvironment (in category 'as yet unclassified') ----- testSelectedEnvironment browser selectSystemCategory: browser class category. + self assert: browser selectedEnvironment = Smalltalk globals. - self assert: browser selectedEnvironment = Smalltalk. + "browser selectSystemCategory: nil. + self assert: browser selectedEnvironment isNil." + "selectedClass would not work in a hierarchy browser that has to display classes from different environments (because the correct categories might be missing)"! - browser selectSystemCategory: nil. - self assert: browser selectedEnvironment isNil.!

1 0

Changes between 4.5 & 4.6 broke the ScorePlayerMorph sliders
by tim Rowledge 28 Feb '17

28 Feb '17

Whilst looking for usages of SimpleSlider I tried out a ScorePlayerMorph and found something weird looking; the supposed sliders for volume etc do not work and do not look anything like they used to. The code creating them hasn’t changed in a long time (as in, since 2003) so even though setting a slider’s extent to 80@2 looks odd, that isn’t the problem. I can see that there some recent changes to Slider layout stuff but it’s not currently making a lot of sense. Marcel, it seems to be your initials lurking in the area, so maybe you remember what was changed? tim -- tim Rowledge; tim(a)rowledge.org; http://www.rowledge.org/tim Useful random insult:- Has a one-way ticket on the Disoriented Express.

1 2

Resuming a SocketStream after a ConnectionClosed exception?
by tim Rowledge 28 Feb '17

28 Feb '17

My MQTT stuff needs to handle the occasional ConnectionClosed type error. I don’t see anything in SocketStream code that suggests any sort of reconnect, and indeed the ConnectionClosed exception is non-resumable. What on earth does one do when a socket dies? My two i/o loops are basically just [[outboundSharedQueue next outputOn: socketStream] repeat] and [[self handleIncoming: (MQTTPacket readFrom: socketStream)] repeat] forked off as separate processes. The socketStream can raise the ConnectionClosed when either doing the #next as part of the reading, or in the #nextPut: whilst writing; obviously. Right now I’m trying to make it work with the read process modified to [[[packet := [MQTTPacket readFrom: socketStream] on: NetworkError do:[:e| some stuff to reconnect. e retry]. self handleIncoming: packet] repeat] forkThing What ought to happen is the socket stream gets reconnected/replaced, the MQTT connection is re-established and then the [MQTTPacket readFrom: socketStream] is restarted. There’s some extra fun for dealing with interrupted multi-part handshaking sequences too, but that’s a different colour of fish-kettle. Clearly the ‘some stuff to reconnect’ is not currently doing the job I thought it was since it doesn’t seem to reconnect and hookup again. I’m beginning to think that I ought to suspend the other process before doing the reconnect, and also that I’ve stared at this so much I’m not seeing the wood for the trees. I’m not picking up any particular inspiration from WebClient or WebServer and haven’t googled into anything that seems relevant. Any ideas out there? tim -- tim Rowledge; tim(a)rowledge.org; http://www.rowledge.org/tim How many of you believe in telekinesis? Raise my hands....

7 18

The Inbox: Monticello-jr.663.mcz
by commits＠source.squeak.org 28 Feb '17

28 Feb '17

A new version of Monticello was added to project The Inbox: http://source.squeak.org/inbox/Monticello-jr.663.mcz ==================== Summary ==================== Name: Monticello-jr.663 Author: jr Time: 28 February 2017, 3:23:47.576081 am UUID: a39bff3c-bb90-704a-bbdc-1c9ce084747b Ancestors: Monticello-ul.662 add environments support to Monticello Neither PackageInfo nor MCPackage are naturally bound to an environment, so choose MCWorkingCopy as the keeper of one. To make sure that an MCPackage creates its snapshot from the correct environment, wrap a working copy's package in a decorator that activates the environment when a snapshot is requested. This is kind of hacky, but otherwise all senders of #snapshot would have to take care to activate the correct environment. It would be complicated because there is code breaking the Law of Demeter as follows: aWorkingCopyOrVersion package snapshot So with this solution, be sure to snapshot/load via the working copy if possible. Add a 'change environment' menu item to the working copies list. Afterwards, snapshots will be taken in the chosen environment, and new code will be compiled in it. Add a 'load into other environment' menu item to snapshot browsers. Depends on Compiler-jr.329 for compiling text in other environments, on Environments-jr.71 for choosing an environment, and Tools-jr.745 would help enable system navigation independently from this version. =============== Diff against Monticello-ul.662 =============== Item was changed: SystemOrganization addCategory: #'Monticello-Base'! SystemOrganization addCategory: #'Monticello-Chunk Format'! SystemOrganization addCategory: #'Monticello-Loading'! SystemOrganization addCategory: #'Monticello-Merging'! SystemOrganization addCategory: #'Monticello-Modeling'! SystemOrganization addCategory: #'Monticello-Patching'! SystemOrganization addCategory: #'Monticello-Repositories'! SystemOrganization addCategory: #'Monticello-Storing'! SystemOrganization addCategory: #'Monticello-UI'! SystemOrganization addCategory: #'Monticello-Versioning'! + SystemOrganization addCategory: #'Monticello-Environments'! Item was added: + ----- Method: Environment>>provisions (in category '*Monticello-Loading') ----- + provisions + "In contrast to #keys, return also the imported names" + ^ bindings keys! Item was changed: ----- Method: MCClassDefinition>>actualClass (in category 'accessing') ----- actualClass + ^ self actualClassIn: Environment current! - ^Smalltalk classNamed: self className! Item was added: + ----- Method: MCClassDefinition>>actualClassIn: (in category 'accessing') ----- + actualClassIn: anEnvironment + ^anEnvironment classNamed: self className! Item was changed: ----- Method: MCClassDefinition>>createClass (in category 'installing') ----- createClass + | environment superClass class composition | + environment := Environment current. - | superClass class composition | superClass := superclassName == #nil ifFalse: + [environment valueOf: superclassName + ifAbsent: [(KeyNotFound key: superclassName) signal]]. - [Smalltalk at: superclassName]. [class := (ClassBuilder new) name: name + inEnvironment: environment - inEnvironment: (CurrentEnvironment signal ifNil: [superClass environment]) subclassOf: superClass type: type instanceVariableNames: self instanceVariablesString classVariableNames: self classVariablesString poolDictionaries: self sharedPoolsString category: category. ] on: Warning, DuplicateVariableError do:[:ex| ex resume]. "The following is written to support traits unloading" composition := self traitComposition ifNil: [Array new] ifNotNil: [:traitComposition | Compiler evaluate: traitComposition]. (composition isCollection and:[composition isEmpty and:[class traitComposition isEmpty]]) ifFalse:[ class setTraitComposition: composition asTraitComposition. ]. composition := self classTraitComposition ifNil: [Array new] ifNotNil: [:traitComposition | Compiler evaluate: traitComposition]. (composition isCollection and:[composition isEmpty and:[class class traitComposition isEmpty]]) ifFalse:[ class class setTraitComposition: composition asTraitComposition. ]. ^class! Item was changed: ----- Method: MCClassDefinition>>unload (in category 'installing') ----- unload + Environment current removeClassNamed: name! - Smalltalk removeClassNamed: name! Item was changed: MCTool subclass: #MCCodeTool + instanceVariableNames: 'items environmentInDisplayingImage' - instanceVariableNames: 'items' classVariableNames: '' poolDictionaries: '' category: 'Monticello-UI'! !MCCodeTool commentStamp: 'nk 11/10/2003 22:00' prior: 0! MCCodeTool is an abstract superclass for those Monticello browsers that display code. It contains copies of the various CodeHolder methods that perform the various menu operations in the method list. ! Item was added: + ----- Method: MCCodeTool>>environmentInDisplayingImage (in category 'accessing') ----- + environmentInDisplayingImage + ^ environmentInDisplayingImage ifNil: [Smalltalk globals]! Item was added: + ----- Method: MCCodeTool>>environmentInDisplayingImage: (in category 'accessing') ----- + environmentInDisplayingImage: anEnvironment + environmentInDisplayingImage := anEnvironment! Item was added: + ----- Method: MCDefinition>>actualClassIn: (in category 'accessing') ----- + actualClassIn: anEnvironment + + ^nil! Item was changed: ----- Method: MCMethodDefinition>>actualClass (in category 'accessing') ----- actualClass + ^ self actualClassIn: Environment current! - ^Smalltalk at: className ifPresent: [:class | - class isBehavior ifTrue: [classIsMeta ifTrue: [class classSide] ifFalse: [class]]]! Item was added: + ----- Method: MCMethodDefinition>>actualClassIn: (in category 'accessing') ----- + actualClassIn: anEnvironment + ^ (anEnvironment at: className ifAbsent: [anEnvironment valueOf: className]) + ifNotNil: [:class | + class isBehavior ifTrue: [classIsMeta ifTrue: [class classSide] ifFalse: [class]]]! Item was changed: ----- Method: MCOperationsBrowser>>revertSelection (in category 'actions') ----- revertSelection | loader | selection ifNotNil: [loader := MCPackageLoader new. selection inverse applyTo: loader. + self environmentInDisplayingImage beCurrentDuring: [loader loadWithName: self changeSetNameForInstall]. - loader loadWithName: self changeSetNameForInstall. self reverts add: selection. self advanceSelection; changed: #list ]! Item was changed: ----- Method: MCOperationsBrowser>>selectedClass (in category 'subclassResponsibility') ----- selectedClass | definition | selection ifNil: [ ^nil ]. (definition := selection definition) ifNil: [ ^nil ]. definition isMethodDefinition ifFalse: [ ^nil ]. + definition className in: [:className | | environment | + environment := self environmentInDisplayingImage. + ^ environment at: className ifAbsent: [environment valueOf: className]]! - ^Smalltalk at: definition className ifAbsent: [ ]! Item was changed: ----- Method: MCOperationsBrowser>>selectedClassOrMetaClass (in category 'subclassResponsibility') ----- selectedClassOrMetaClass | definition | selection ifNil: [ ^nil ]. (definition := selection definition) ifNil: [ ^nil ]. (definition isMethodDefinition or: [definition isClassDefinition]) ifFalse: [ ^nil ]. + ^ definition actualClassIn: self environmentInDisplayingImage! - ^definition actualClass! Item was added: + ----- Method: MCPackage>>inEnvironment: (in category 'environments') ----- + inEnvironment: anEnvironment + "Answer a decorator for me that activates anEnvironment for certain operations." + ^ MCPackageInEnvironment decorating: self in: anEnvironment! Item was changed: ----- Method: MCPackage>>packageInfo (in category 'accessing') ----- packageInfo + "Activate my working copy's environment so the PackageInfo is added to the + correct EnvironmentInfo's packages." + | getPackageInfo | + getPackageInfo := [PackageInfo named: name]. + ^ self hasWorkingCopy + ifTrue: [self workingCopy withEnvironmentActiveDo: getPackageInfo] + ifFalse: getPackageInfo! - ^ PackageInfo named: name! Item was added: + ProtoObject subclass: #MCPackageInEnvironment + instanceVariableNames: 'package environment' + classVariableNames: '' + poolDictionaries: '' + category: 'Monticello-Environments'! + + !MCPackageInEnvironment commentStamp: 'jr 2/27/2017 23:05' prior: 0! + I am a decorator for an MCPackage, activating an Environment for relevant operations. + + Instance Variables + environment: <Environment> should be the current one for some of my operations + package: <MCPackage> my substance! Item was added: + ----- Method: MCPackageInEnvironment class>>decorating:in: (in category 'instance creation') ----- + decorating: aPackage in: anEnvironment + | instance | + instance := self new. + instance initializeWithPackage: aPackage in: anEnvironment. + ^ instance! Item was added: + ----- Method: MCPackageInEnvironment>>basicInspect (in category 'object behavior') ----- + basicInspect + "Create and schedule an Inspector in which the user can examine the + receiver's variables. This method should not be overriden." + ^ToolSet basicInspect: self! Item was added: + ----- Method: MCPackageInEnvironment>>doesNotUnderstand: (in category 'delegating') ----- + doesNotUnderstand: aMessage + ^ aMessage sendTo: package! Item was added: + ----- Method: MCPackageInEnvironment>>environment (in category 'accessing') ----- + environment + + ^ environment! Item was added: + ----- Method: MCPackageInEnvironment>>environment: (in category 'accessing') ----- + environment: anObject + + environment := anObject! Item was added: + ----- Method: MCPackageInEnvironment>>inEnvironment: (in category 'initialize-release') ----- + inEnvironment: anEnvironment + environment == anEnvironment ifTrue: [^ self]. + ^ MCPackageInEnvironment decorating: package in: anEnvironment! Item was added: + ----- Method: MCPackageInEnvironment>>initializeWithPackage:in: (in category 'initialize-release') ----- + initializeWithPackage: aPackage in: anEnvironment + package := aPackage. + environment := anEnvironment.! Item was added: + ----- Method: MCPackageInEnvironment>>respondsTo: (in category 'delegating') ----- + respondsTo: aSymbol + ^ (MCPackageInEnvironment canUnderstand: aSymbol) + or: [package respondsTo: aSymbol]! Item was added: + ----- Method: MCPackageInEnvironment>>snapshot (in category 'input/output') ----- + snapshot + ^ environment beCurrentDuring: [package snapshot]! Item was changed: ----- Method: MCPackageLoader>>provisions (in category 'private') ----- provisions + ^ provisions ifNil: [provisions := Set withAll: Environment current provisions] ! - ^ provisions ifNil: [provisions := Set withAll: Smalltalk globals keys]! Item was changed: ----- Method: MCPackageManager>>initializeWithPackage: (in category 'initialize-release') ----- initializeWithPackage: aPackage + package := aPackage inEnvironment: Environment current. - package := aPackage. self initialize.! Item was changed: ----- Method: MCSnapshotBrowser>>classListMenu: (in category 'menus') ----- classListMenu: aMenu classSelection ifNil: [ ^aMenu ]. super classListMenu: aMenu. aMenu addLine; add: ('load class {1}' translated format: {classSelection}) + action: #loadClassSelection; + add: ('load class {1} into other Environment...' translated format: {classSelection}) + action: #loadClassSelectionIntoOtherEnvironment. - action: #loadClassSelection. ^ aMenu! Item was added: + ----- Method: MCSnapshotBrowser>>loadClassSelectionIntoOtherEnvironment (in category 'menus') ----- + loadClassSelectionIntoOtherEnvironment + | env | + classSelection ifNil: [ ^self ]. + env := EnvironmentRequest signal. + env beCurrentDuring: [ + (self packageClasses detect: [ :ea | ea className = classSelection ] ifNone: [ ^self ]) + load. + self methodsForSelectedClass do: [ :m | m load ]].! Item was changed: ----- Method: MCSnapshotBrowser>>selectedClass (in category 'accessing') ----- selectedClass + | environment | classSelection ifNil: [ ^nil ]. + environment := self environmentInDisplayingImage. + ^ environment at: classSelection ifAbsent: [environment valueOf: classSelection] - ^Smalltalk at: classSelection ifAbsent: [ nil ]. ! Item was changed: ----- Method: MCTraitDefinition>>createClass (in category 'visiting') ----- createClass ^ClassDescription newTraitNamed: name uses: (Compiler evaluate: self traitCompositionString) category: category + in: Environment current ! Item was changed: ----- Method: MCVersion>>load (in category 'actions') ----- load + self workingCopy withEnvironmentActiveDo: [MCVersionLoader loadVersion: self]! - MCVersionLoader loadVersion: self! Item was changed: ----- Method: MCVersion>>merge (in category 'actions') ----- merge + self workingCopy withEnvironmentActiveDo: [MCVersionMerger mergeVersion: self]! - MCVersionMerger mergeVersion: self! Item was changed: MCPackageManager subclass: #MCWorkingCopy + instanceVariableNames: 'versionInfo ancestry counter repositoryGroup requiredPackages environment' - instanceVariableNames: 'versionInfo ancestry counter repositoryGroup requiredPackages' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Versioning'! Item was added: + ----- Method: MCWorkingCopy>>environment (in category 'accessing') ----- + environment + ^ environment ifNil: [Smalltalk globals]! Item was added: + ----- Method: MCWorkingCopy>>environment: (in category 'accessing') ----- + environment: anEnvironment + "Anything that is loaded to me should go into anEnvironment from now on." + environment := anEnvironment. + package := package inEnvironment: anEnvironment.! Item was changed: ----- Method: MCWorkingCopy>>unload (in category 'operations') ----- unload + self withEnvironmentActiveDo: [MCPackageLoader unloadPackage: self package]. - MCPackageLoader unloadPackage: self package. self unregisterSubpackages. self unregister.! Item was added: + ----- Method: MCWorkingCopy>>withEnvironmentActiveDo: (in category 'private') ----- + withEnvironmentActiveDo: aBlock + ^ self environment beCurrentDuring: aBlock! Item was added: + ----- Method: MCWorkingCopyBrowser>>changeEnvironment (in category 'actions') ----- + changeEnvironment + workingCopy ifNil: [^ self]. + workingCopy environment: EnvironmentRequest signal! Item was changed: ----- Method: MCWorkingCopyBrowser>>viewChanges (in category 'actions') ----- viewChanges | patch | self canSave ifTrue: [patch := workingCopy changesRelativeToRepository: self repository. patch isNil ifTrue: [^ self]. patch isEmpty ifTrue: [ workingCopy modified: false. self inform: 'No changes' ] ifFalse: [ workingCopy modified: true. (MCPatchBrowser forPatch: patch) label: 'Patch Browser: ', workingCopy description; + environmentInDisplayingImage: workingCopy environment; show]]! Item was changed: ----- Method: MCWorkingCopyBrowser>>workingCopyListMenu: (in category 'morphic ui') ----- workingCopyListMenu: aMenu workingCopy ifNil: [^ aMenu]. self fillMenu: aMenu fromSpecs: #(('add required package' #addRequiredPackage) ('clear required packages' #clearRequiredPackages) ('add repository...' #addPackageRepository) ('browse package' #browseWorkingCopy) ('view changes' #viewChanges) ('view history' #viewHistory) ('search history' #searchHistory) ('recompile package' #recompilePackage) ('revert package...' #revertPackage) ('unload package' #unloadPackage) ('delete working copy' #deleteWorkingCopy) ('inspect working copy' #inspectWorkingCopy) + ('rename package...' #renamePackage) + ('change environment...' #changeEnvironment)). - ('rename package...' #renamePackage)). (Smalltalk includesKey: #SARMCPackageDumper) ifTrue: [ aMenu add: 'make SAR' target: self selector: #fileOutAsSAR ]. self fillMenu: aMenu fromSpecs: #( addLine ('check all packages for changes' #checkAllPackages)). self insertExternalMenuEntries: aMenu. ^aMenu! Item was changed: ----- Method: MethodAddition>>createCompiledMethod (in category 'as yet unclassified') ----- createCompiledMethod | notification | [methodAndNode := myClass compile: text asString + environment: Environment current notifying: requestor trailer: (myClass defaultMethodTrailerIfLogSource: logSource) ifFail: [^nil]] on: SyntaxErrorNotification do: [:exc | notification := exc. exc pass]. notification ifNotNil: [notification newSource ifNotNil: [:newSource | text := newSource]]. selector := methodAndNode selector. compiledMethod := methodAndNode method. self writeSourceToLog. priorMethodOrNil := myClass compiledMethodAt: selector ifAbsent: [nil]. !

1 0

The Inbox: Environments-jr.71.mcz
by commits＠source.squeak.org 28 Feb '17

28 Feb '17

A new version of Environments was added to project The Inbox: http://source.squeak.org/inbox/Environments-jr.71.mcz ==================== Summary ==================== Name: Environments-jr.71 Author: jr Time: 28 February 2017, 2:36:25.745081 am UUID: a50d4dbb-f587-6d46-bd22-bfcba43c4187 Ancestors: Environments-jr.69 add a signal to ask for an environment to be used by Monticello to choose an environment =============== Diff against Environments-jr.69 =============== Item was changed: SystemOrganization addCategory: #'Environments-Core'! SystemOrganization addCategory: #'Environments-Loading'! SystemOrganization addCategory: #'Environments-Policies'! SystemOrganization addCategory: #'Environments-Help'! + SystemOrganization addCategory: #'Environments-Notifications'! Item was added: + Notification subclass: #EnvironmentRequest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Environments-Notifications'! + + !EnvironmentRequest commentStamp: 'jr 1/15/2017 00:34' prior: 0! + I represent a request for an Environment that is not necessarily the CurrentEnvironment, but any Environment available in the system. + + Instance Variables + ! Item was added: + ----- Method: EnvironmentRequest>>defaultAction (in category 'exceptionDescription') ----- + defaultAction + | all environment | + all := Environment allInstances. + environment := UIManager default chooseFrom: all values: all. + self resume: environment.!

1 0

The Inbox: Tools-jr.745.mcz
by commits＠source.squeak.org 28 Feb '17

28 Feb '17

A new version of Tools was added to project The Inbox: http://source.squeak.org/inbox/Tools-jr.745.mcz ==================== Summary ==================== Name: Tools-jr.745 Author: jr Time: 28 February 2017, 2:20:44.822081 am UUID: c3e3bfae-ac2c-0d4e-a606-c41b7d388d67 Ancestors: Tools-cmm.744 improve Tools support for environments allows... - navigating senders/implementors - using the hierarchy browser - defining new classes and traits - enjoying a Workspace ...in other environments Also ensure all objects understand #environment, so tools can send it without fear. Depends on ToolBuilder-Kernel-jr.109 for choosing something in 'find class'. =============== Diff against Tools-cmm.744 =============== Item was changed: ----- Method: Browser>>copyClass (in category 'class functions') ----- copyClass | originalClass originalName copysName | self hasClassSelected ifFalse: [^ self]. self okToChange ifFalse: [^ self]. originalClass := self selectedClass. originalName := originalClass name. copysName := self request: 'Please type new class name' initialAnswer: originalName. copysName = '' ifTrue: [^ self]. " Cancel returns '' " copysName := copysName asSymbol. copysName = originalName ifTrue: [^ self]. + (self environment hasClassNamed: copysName) - (Smalltalk hasClassNamed: copysName) ifTrue: [^ self error: copysName , ' already exists']. Cursor wait showWhile: [ | newDefinition newMetaDefinition newClass | newDefinition := originalClass definition copyReplaceAll: originalName printString with: copysName printString. + newClass := Compiler evaluate: newDefinition environment: self environment + logged: true. - newClass := Compiler evaluate: newDefinition logged: true. newMetaDefinition := originalClass class definition copyReplaceAll: originalClass class name with: newClass class name. + Compiler evaluate: newMetaDefinition environment: self environment + logged: true. - Compiler evaluate: newMetaDefinition logged: true. newClass copyAllCategoriesFrom: originalClass. newClass class copyAllCategoriesFrom: originalClass class. originalClass hasComment ifTrue: [ newClass comment: originalClass comment ] ]. self classListIndex: 0. self changed: #classList! Item was changed: ----- Method: Browser>>defineClass:notifying: (in category 'class functions') ----- defineClass: defString notifying: aController "The receiver's textual content is a request to define a new class. The source code is defString. If any errors occur in compilation, notify aController." | oldClass class newClassName defTokens keywdIx envt | oldClass := self selectedClassOrMetaClass. defTokens := defString findTokens: Character separators. ((defTokens first = 'Trait' and: [defTokens second = 'named:']) or: [defTokens second = 'classTrait']) ifTrue: [^self defineTrait: defString notifying: aController]. keywdIx := defTokens findFirst: [:x | x beginsWith: 'category']. + envt := self selectedEnvironment. - envt := Smalltalk. keywdIx := defTokens findFirst: [:x | '*subclass*' match: x]. newClassName := (defTokens at: keywdIx+1) copyWithoutAll: '#()'. ((oldClass isNil or: [oldClass theNonMetaClass name asString ~= newClassName]) and: [envt includesKey: newClassName asSymbol]) ifTrue: ["Attempting to define new class over existing one when not looking at the original one in this browser..." (self confirm: ((newClassName , ' is an existing class in this system. Redefining it might cause serious problems. Is this really what you want to do?') asText makeBoldFrom: 1 to: newClassName size)) ifFalse: [^ false]]. "ar 8/29/1999: Use oldClass superclass for defining oldClass since oldClass superclass knows the definerClass of oldClass." oldClass ifNotNil:[oldClass := oldClass superclass]. + class := envt beCurrentDuring: + [oldClass subclassDefinerClass - class := oldClass subclassDefinerClass evaluate: defString + in: envt notifying: aController + logged: false]. - logged: false. (class isKindOf: Behavior) ifTrue: [self changed: #systemCategoryList. self changed: #classList. self clearUserEditFlag. self setClass: class selector: nil. "self clearUserEditFlag; editClass." ^ true] ifFalse: [^ false]! Item was changed: ----- Method: Browser>>defineTrait:notifying: (in category 'traits') ----- defineTrait: defString notifying: aController | defTokens keywdIx envt oldTrait newTraitName trait | oldTrait := self selectedClassOrMetaClass. defTokens := defString findTokens: Character separators. keywdIx := defTokens findFirst: [:x | x = 'category']. envt := self selectedEnvironment. keywdIx := defTokens findFirst: [:x | x = 'named:']. newTraitName := (defTokens at: keywdIx+1) copyWithoutAll: '#()'. ((oldTrait isNil or: [oldTrait baseTrait name asString ~= newTraitName]) and: [envt includesKey: newTraitName asSymbol]) ifTrue: ["Attempting to define new class/trait over existing one when not looking at the original one in this browser..." (self confirm: ((newTraitName , ' is an existing class/trait in this system. Redefining it might cause serious problems. Is this really what you want to do?') asText makeBoldFrom: 1 to: newTraitName size)) ifFalse: [^ false]]. + trait := envt beCurrentDuring: + [Compiler evaluate: defString in: envt notifying: aController logged: true]. - trait := Compiler evaluate: defString notifying: aController logged: true. ^(trait isTrait) ifTrue: [ self changed: #classList. self classListIndex: (self classListIndexOf: trait baseTrait name). self clearUserEditFlag; editClass. true] ifFalse: [ false ] ! Item was added: + ----- Method: Browser>>environment (in category 'accessing') ----- + environment + ^ environment ifNil: [super environment]! Item was changed: ----- Method: Browser>>findClass (in category 'system category functions') ----- findClass "Search for a class by name." | foundClass | (self multiWindowState notNil or: [self okToChange]) ifFalse: [^self classNotFound]. + foundClass := UIManager default chooseClassOrTraitFrom: self environment. - foundClass := UIManager default chooseClassOrTrait. foundClass ifNil: [^self classNotFound]. (self selectedClass notNil and: [self multiWindowState notNil "Can only support multi-window if original window has all the right panes." and: [self multiWindowState prototype isHierarchy not]]) ifTrue: [(self classList includes: foundClass name) ifTrue: [self multiWindowState copyWindow] ifFalse: [self multiWindowState addNewWindow]]. self selectCategoryForClass: foundClass. self selectClass: foundClass! Item was changed: ----- Method: Browser>>hierarchicalClassList (in category 'class list') ----- hierarchicalClassList "classNames are an arbitrary collection of classNames of the system. Reorder those class names so that they are sorted and indended by inheritance" | classes | "Creating the hierarchy is *really slow* for the full class list. Skip it for now." self selectedSystemCategory = SystemOrganizer allCategory ifTrue: [^ self defaultClassList]. + classes := self defaultClassList collect: [:sym | self environment classNamed: sym]. - classes := self defaultClassList collect: [:sym | Smalltalk classNamed: sym]. ^ self flattenHierarchyTree: (self createHierarchyTreeOf: classes) on: OrderedCollection new indent: ''.! Item was changed: ----- Method: Browser>>selectedClass (in category 'class list') ----- selectedClass "Answer the class that is currently selected. Answer nil if no selection exists." | name envt | (name := self selectedClassName) ifNil: [^ nil]. (envt := self selectedEnvironment) ifNil: [^ nil]. + ^ envt at: name ifAbsent: [envt valueOf: name ifAbsent: [nil]]! - ^ envt at: name ifAbsent: [nil]! Item was changed: ----- Method: Browser>>selectedEnvironment (in category 'system category list') ----- selectedEnvironment + "Answer the browsed environment. If this returned a system category dependent + value and possibly nil (as it did in previous versions), selectedClass would not work in + a hierarchy browser that has to display classes from different environments + (because the correct categories might be missing in the browser)" - "Answer the name of the selected system category or nil." + ^ environment ifNil: [Smalltalk globals]! - self hasSystemCategorySelected ifFalse: [^nil]. - ^ environment ifNil: [Smalltalk]! Item was changed: ----- Method: ChangeList>>diffedVersionContents (in category 'viewing access') ----- diffedVersionContents "Answer diffed version contents, maybe pretty maybe not" | change class earlier later | (listIndex = 0 or: [changeList size < listIndex]) ifTrue: [^ '']. change := changeList at: listIndex. later := change text. + class := change methodClass: self environment. - class := change methodClass. (listIndex == changeList size or: [class == nil]) ifTrue: [^ (self showingPrettyDiffs and: [class notNil]) ifTrue: [class prettyPrinterClass format: later in: class notifying: nil] ifFalse: [later]]. earlier := (changeList at: listIndex + 1) text. ^ TextDiffBuilder buildDisplayPatchFrom: earlier to: later inClass: class prettyDiffs: self showingPrettyDiffs! Item was changed: ----- Method: ChangeList>>fileInSelections (in category 'menu actions') ----- fileInSelections | any | any := false. + self selectedClass environment beCurrentDuring: [ + listSelections with: changeList do: + [:selected :item | selected ifTrue: [any := true. item fileIn]]]. - listSelections with: changeList do: - [:selected :item | selected ifTrue: [any := true. item fileIn]]. any ifFalse: [self inform: 'nothing selected, so nothing done']! Item was changed: ----- Method: DependencyBrowser>>selectedEnvironment (in category 'accessing') ----- selectedEnvironment "Answer the name of the selected package or nil." self hasPackageSelected ifFalse: [^nil]. + ^ Smalltalk globals! - ^ Smalltalk! Item was changed: ----- Method: HierarchyBrowser>>classList (in category 'class list') ----- classList + classDisplayList := classDisplayList select: [:each | (self environment valueOf: each withBlanksTrimmed asSymbol) notNil]. - classDisplayList := classDisplayList select: [:each | Smalltalk includesKey: each withBlanksTrimmed asSymbol]. ^ classDisplayList! Item was changed: ----- Method: HierarchyBrowser>>classListIndex: (in category 'initialization') ----- classListIndex: newIndex "Cause system organization to reflect appropriate category" | newClassName ind | newIndex ~= 0 ifTrue: [newClassName := (classDisplayList at: newIndex) copyWithout: $ . selectedSystemCategory := (systemOrganizer categories at: + (systemOrganizer numberOfCategoryOfElement: newClassName) + ifAbsent: [nil])]. - (systemOrganizer numberOfCategoryOfElement: newClassName))]. ind := super classListIndex: newIndex. "What I'd like to write:" "self selectedClassName ifNotNil: [ selectedSystemCategory := self selectedClass category ]." self changed: #systemCategorySingleton. ^ ind! Item was changed: ----- Method: HierarchyBrowser>>initHierarchyForClass: (in category 'initialization') ----- initHierarchyForClass: aClassOrMetaClass | nonMetaClass superclasses | centralClass := aClassOrMetaClass. nonMetaClass := aClassOrMetaClass theNonMetaClass. + self selectEnvironment: aClassOrMetaClass environment. - self systemOrganizer: SystemOrganization. metaClassIndicated := aClassOrMetaClass isMeta. classDisplayList := OrderedCollection new. (superclasses := nonMetaClass allSuperclasses reversed) withIndexDo: [ : each : indent | classDisplayList add: (String streamContents: [ : stream | indent - 1 timesRepeat: [ stream nextPutAll: ' ' ]. stream nextPutAll: each name ]) ]. nonMetaClass allSubclassesWithLevelDo: [ : eachClass : lvl | classDisplayList add: (String streamContents: [ : stream | lvl timesRepeat: [ stream nextPutAll: ' ' ]. stream nextPutAll: eachClass name ]) ] startingLevel: superclasses size. self changed: #classList. self selectClass: nonMetaClass! Item was changed: ----- Method: MessageSet class>>parse:toClassAndSelector: (in category 'utilities') ----- parse: methodRef toClassAndSelector: csBlock "Decode strings of the form <className> [class] <selectorName>." | tuple cl | self flag: #mref. "compatibility with pre-MethodReference lists" methodRef ifNil: [^ csBlock value: nil value: nil]. methodRef isString ifFalse: [^methodRef setClassAndSelectorIn: csBlock]. methodRef isEmpty ifTrue: [^csBlock value: nil value: nil]. tuple := (methodRef asString includesSubstring: '>>') ifTrue: [(methodRef findTokens: '>>') fold: [:a :b| (a findTokens: ' '), {b first = $# ifTrue: [b allButFirst] ifFalse: [b]}]] ifFalse: [methodRef asString findTokens: ' .']. + self flag: #environments. "missing information about the class environment" cl := Smalltalk at: tuple first asSymbol ifAbsent: [^ csBlock value: nil value: nil]. ^(tuple size = 2 or: [tuple size > 2 and: [(tuple at: 2) ~= 'class']]) ifTrue: [csBlock value: cl value: (tuple at: 2) asSymbol] ifFalse: [csBlock value: cl class value: (tuple at: 3) asSymbol]! Item was changed: ----- Method: MessageTrace>>filteredSelectorsNamed: (in category 'filtering') ----- filteredSelectorsNamed: selectorSymbol + ^(SystemNavigation for: self environment) allImplementorsOf: selectorSymbol - ^SystemNavigation new allImplementorsOf: selectorSymbol ! Item was added: + ----- Method: Model>>environment (in category '*Tools') ----- + environment + ^ (self selectedClass ifNil: [self class]) environment! Item was added: + ----- Method: Object>>environment (in category '*Tools') ----- + environment + "This is a fallback for models that do not inherit from Model or something else that provides + a useful Environment answer. You should consider copying this method to (base) classes of + objects from which you expect exactly the behavior below. + Absolutely feel free to override this method for objects that have or operate on a dedicated + environment, such as references to classes, code loaders, or tools." + ^ self class environment! Item was changed: StringHolder subclass: #Workspace + instanceVariableNames: 'bindings acceptDroppedMorphs acceptAction mustDeclareVariables shouldStyle environment' - instanceVariableNames: 'bindings acceptDroppedMorphs acceptAction mustDeclareVariables shouldStyle' classVariableNames: 'LookupPools ShouldStyle' poolDictionaries: '' category: 'Tools-Base'! !Workspace commentStamp: 'fbs 6/2/2012 20:46' prior: 0! A Workspace is a text area plus a lot of support for executable code. It is a great place to execute top-level commands to compute something useful, and it is a great place to develop bits of a program before those bits get put into class methods. To open a new workspace, execute: Workspace open A workspace can have its own variables, called "workspace variables", to hold intermediate results. For example, if you type into a workspace "x := 5" and do-it, then later you could type in "y := x * 2" and y would become 10. Additionally, in Morphic, a workspace can gain access to morphs that are on the screen. If acceptDroppedMorphs is turned on, then whenever a morph is dropped on the workspace, a variable will be created which references that morph. This functionality is toggled with the window-wide menu of a workspace. The instance variables of this class are: bindings - holds the workspace variables for this workspace acceptDroppedMorphs - whether dropped morphs should create new variables! Item was added: + ----- Method: Workspace>>environment (in category 'accessing') ----- + environment + ^ environment ifNil: [Smalltalk globals]! Item was added: + ----- Method: Workspace>>environment: (in category 'accessing') ----- + environment: anEnvironment + + environment := anEnvironment.! Item was changed: ----- Method: Workspace>>initialize (in category 'initialize-release') ----- initialize super initialize. self initializeBindings. acceptDroppedMorphs := false. + mustDeclareVariables := false. + environment := Environment current.! - mustDeclareVariables := false!

1 0

The Inbox: System-jr.928.mcz
by commits＠source.squeak.org 28 Feb '17

28 Feb '17

A new version of System was added to project The Inbox: http://source.squeak.org/inbox/System-jr.928.mcz ==================== Summary ==================== Name: System-jr.928 Author: jr Time: 28 February 2017, 1:52:26.276081 am UUID: 3b79a197-c860-eb40-8f04-645f64bc7988 Ancestors: System-jr.927 return an environment dependent systemNavigation mainly to be used by tools that override #environment =============== Diff against System-jr.927 =============== Item was changed: ----- Method: Object>>systemNavigation (in category '*system-support') ----- systemNavigation + ^ SystemNavigation for: self environment! - ^ SystemNavigation default!

1 0

The Inbox: ToolBuilder-Kernel-jr.109.mcz
by commits＠source.squeak.org 28 Feb '17

28 Feb '17

A new version of ToolBuilder-Kernel was added to project The Inbox: http://source.squeak.org/inbox/ToolBuilder-Kernel-jr.109.mcz ==================== Summary ==================== Name: ToolBuilder-Kernel-jr.109 Author: jr Time: 28 February 2017, 1:37:47.610081 am UUID: edda3c34-f8df-fc4f-b6a5-6404053750f1 Ancestors: ToolBuilder-Kernel-tfel.108 offer a class selection from another environment =============== Diff against ToolBuilder-Kernel-tfel.108 =============== Item was changed: ----- Method: UIManager>>chooseClassOrTrait (in category 'ui requests') ----- chooseClassOrTrait "Let the user choose a Class or Trait" + ^self chooseClassOrTraitFrom: Smalltalk globals! - ^self chooseClassOrTrait: 'Class name or fragment?'! Item was added: + ----- Method: UIManager>>chooseClassOrTraitFrom: (in category 'ui requests') ----- + chooseClassOrTraitFrom: anEnvironment + "Let the user choose a Class or Trait from the given environment" + + ^self chooseClassOrTrait: 'Class name or fragment?' from: anEnvironment! Item was changed: ----- Method: UIManager>>classFromPattern:withCaption: (in category 'system introspecting') ----- classFromPattern: pattern withCaption: aCaption + ^self classFromPattern: pattern withCaption: aCaption in: Smalltalk environment - "If there is a class or trait whose name exactly given by pattern, return it. - If there is only one class or trait in the system whose name matches pattern, return it. - Otherwise, put up a menu offering the names of all classes that match pattern, and return the class chosen, else nil if nothing chosen. - This method ignores separator characters in the pattern" - - ^self classOrTraitFrom: Smalltalk environment pattern: pattern label: aCaption " self classFromPattern: 'CharRecog' withCaption: '' self classFromPattern: 'rRecog' withCaption: '' self classFromPattern: 'znak' withCaption: '' self classFromPattern: 'orph' withCaption: '' self classFromPattern: 'TCompil' withCaption: '' " ! Item was added: + ----- Method: UIManager>>classFromPattern:withCaption:in: (in category 'system introspecting') ----- + classFromPattern: pattern withCaption: aCaption in: anEnvironment + "If there is a class or trait whose name exactly given by pattern, return it. + If there is only one class or trait in the system whose name matches pattern, return it. + Otherwise, put up a menu offering the names of all classes that match pattern, and return the class chosen, else nil if nothing chosen. + This method ignores separator characters in the pattern" + + ^self classOrTraitFrom: anEnvironment pattern: pattern label: aCaption + " + for examples, see #classFromPattern:withCaption: + " + !

1 0

← Newer
1
2
3
4
5
6
7
...
21
Older →

Jump to page: