diff --git a/Cuis5.0-4871-32.image b/Cuis5.0-4871-32.image deleted file mode 100644 index 07ac66c3..00000000 Binary files a/Cuis5.0-4871-32.image and /dev/null differ diff --git a/Cuis5.0-4871.image b/Cuis5.0-4871.image deleted file mode 100644 index 8d17e512..00000000 Binary files a/Cuis5.0-4871.image and /dev/null differ diff --git a/Cuis5.0-4871-32.changes b/Cuis5.0-4883-32.changes similarity index 99% rename from Cuis5.0-4871-32.changes rename to Cuis5.0-4883-32.changes index bf8bc1a6..cd94a823 100644 --- a/Cuis5.0-4871-32.changes +++ b/Cuis5.0-4883-32.changes @@ -209945,4 +209945,1178 @@ isCloserThan: aNumber toPoint: aPoint ----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4871-imageFormdepth-KernelMorph-JuanVuletich-2021Sep21-10h46m-jmv.001.cs.st----! -----QUIT----(21 September 2021 12:54:16) Cuis5.0-4871-32.image priorSource: 8743091! \ No newline at end of file +----QUIT----(21 September 2021 12:54:16) Cuis5.0-4871-32.image priorSource: 8743091! + +----STARTUP---- (24 September 2021 10:39:50) as C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\Cuis5.0-4871-32.image! + + +'From Cuis 5.0 [latest update: #4862] on 21 September 2021 at 5:57:37 pm'! +!WorldMorph methodsFor: 'geometry' stamp: 'jmv 9/21/2021 17:50:48' overrides: 50556363! + extentChanged: oldExtent + "Our extent changed. Must layout submorphs again." + + super extentChanged: oldExtent. + taskbar ifNotNil: [ taskbar screenSizeChanged ].! ! +!SystemDictionary methodsFor: 'snapshot and quit' stamp: 'jmv 9/21/2021 17:53:08' prior: 50603678! + snapshot: save andQuit: quit embedded: embeddedFlag clearAllClassState: clearAllStateFlag + "This is the main method for image save and / or quit. + See senders." + "WARNING: Current process will be killed. UI Process will be restarted" + "Mark the changes file and close all files as part of #processShutdownList. + If save is true, save the current state of this Smalltalk in the image file. + If quit is true, then exit to the outer OS shell. + The latter part of this method runs when resuming a previously saved image. This resume logic + checks for a document file to process when starting up." + " + To test the full cleanup and startup procedures, evaluate: + Smalltalk snapshot: false andQuit: false embedded: false clearAllClassState: true + + To test the cleanup done when saving the image, evaluate: + Smalltalk snapshot: false andQuit: false embedded: false clearAllClassState: false + " + | activeProc | + activeProc _ Processor activeProcess. + [ | isARealStartup guiRootObject guiRootObjectClass | + save not & quit + ifTrue: [ + (SourceFiles at: 2) ifNotNil: [ :changes | + ChangesInitialFileSize ifNotNil: [ changes truncate: ChangesInitialFileSize ]]] + ifFalse: [ + self + logSnapshot: save + andQuit: quit ]. + clearAllStateFlag ifTrue: [ + TranscriptWindow allInstancesDo: [ :each | + each isInWorld ifTrue: [ + each delete.]]. + UISupervisor ui tearDownDesktop. + Transcript logToFile: false ]. + ActiveModel flushEventSystem. + self processShutDownList: quit. + "Lo que sigue aca podria ir al shutdown de alguien... (se levantan en startup!!)" + Smalltalk stopLowSpaceWatcher. + WeakArray stopFinalizationProcess. + ProcessorScheduler stopBackgroundProcess. + "Cosas que levanto explicitamente abajo" + guiRootObjectClass _ UISupervisor ui class. + guiRootObject _ UISupervisor ui. + "Replace with this to create a new world at startup after 'saveAsNewVersion'" + "guiRootObject _ clearAllStateFlag ifFalse: [ UISupervisor ui ]." + UISupervisor stopUIProcess. + activeProc isTerminated ifFalse: [ activeProc terminate ]. + guiRootObject ifNotNil: [ guiRootObject releaseCachedState ]. + "Clean Globals" + Smalltalk + at: #Sensor + put: nil. + Smalltalk + at: #Display + put: nil. + Smalltalk closeSourceFiles. + Smalltalk + at: #SourceFiles + put: nil. + Smalltalk allClassesDo: [ :cls | + cls releaseClassCachedState ]. + clearAllStateFlag ifTrue: [ + Smalltalk allClassesDo: [ :cls | + cls releaseClassState ]]. + "Ojo con los pool dicts. Creo que no hay ninguno..." + "To keep cleaning stuff that shouldn't be saved..." + clearAllStateFlag ifTrue: [ + Smalltalk printStuffToCleanOnImageSave. + "Remove this call to actually see the image clean report." + Transcript clear. + ]. + "Do image save & quit as apropriate" + (Cursor cursorAt: #writeCursor) activateCursor. + save + ifTrue: [ + "The snapshot primitive answers false if it was just called to do the snapshot. + But image startup is resumed by returning (again) from the primitive, but this time answering true." + isARealStartup _ embeddedFlag + ifTrue: [ self snapshotEmbeddedPrimitive ] + ifFalse: [ self snapshotPrimitive ]] + ifFalse: [ isARealStartup _ false ]. + quit & (isARealStartup == false) ifTrue: [ self quitPrimitive ]. + "If starting from absolute scratch, this would be a good time to recreate Global names" + Smalltalk + at: #Sensor + put: nil. + Smalltalk + at: #Display + put: DisplayScreen new. + Smalltalk + at: #SourceFiles + put: (Array new: 2). + Smalltalk openSourceFiles. + "Here, startup begins!! (isARealStartup might be nil)" + Smalltalk allClassesDo: [ :cls | + cls initClassCachedState ]. + self doStartUp: isARealStartup == true. + UISupervisor spawnNewMorphicProcessFor: (guiRootObject ifNil: [ guiRootObject _ guiRootObjectClass newWorld ]). + self restoreLostChangesIfNecessary. + clearAllStateFlag ifTrue: [ + UISupervisor whenUIinSafeState: [ + guiRootObject recreateDefaultDesktop; restoreDisplay ]] + ifFalse: [ + UISupervisor whenUIinSafeState: [ + guiRootObject restoreDisplay ]]. + "If system is coming up (VM and image just started)" + isARealStartup == true ifTrue: [ + UISupervisor whenUIinSafeState: [ + self processCommandLineArguments. + AppLauncher launchApp ]]. + "Now it's time to raise an error" + isARealStartup ifNil: [ self error: 'Failed to write image file (disk full?)' ]] + forkAt: Processor timingPriority - 1 + named: 'Startup process'.! ! +!DisplayScreen methodsFor: 'private' stamp: 'jmv 9/21/2021 17:53:28' prior: 50604366 overrides: 16848801! + setExtent: aPoint depth: bitsPerPixel + "DisplayScreen startUp" + "This method is critical. If the setExtent fails, there will be no + proper display on which to show the error condition." + + | bitsPerPixelToUse | + (depth = bitsPerPixel and: [aPoint = self extent and: [ + self supportsDisplayDepth: bitsPerPixel]]) ifFalse: [ + bits _ nil. "Free up old bitmap in case space is low" + bitsPerPixelToUse _ (self supportsDisplayDepth: bitsPerPixel) + ifTrue: [ bitsPerPixel ] + ifFalse: [ + (self supportsDisplayDepth: bitsPerPixel negated) + ifTrue: [ bitsPerPixel negated ] + ifFalse: [ self findAnyDisplayDepth ]]. + super setExtent: aPoint depth: bitsPerPixelToUse. + ].! ! +!TaskbarMorph methodsFor: 'events' stamp: 'jmv 9/21/2021 17:50:39' prior: 50379892! + screenSizeChanged + "Respond to change in screen size by repositioning self to bottom of screen" + +" Transcript newLine; print: 'Taskbar screenSizeChanged'. +" + | y e | + self world ifNotNil: [ :w | + y _ w morphExtent y - self defaultHeight. + e _ (self internalizeDistance: w morphExtent x @ self defaultHeight) asIntegerPoint. + self morphPosition: 0@y extent: e ].! ! +!TaskbarMorph methodsFor: 'submorphs-add/remove' stamp: 'jmv 9/21/2021 17:55:51' prior: 50337304 overrides: 50574156! + delete + + | w | + self restoreAll. + super delete. + w _ self world ifNil: [ self runningWorld ]. + w ifNotNil: [ w taskbarDeleted ]! ! +!TaskbarMorph methodsFor: 'submorphs-add/remove' stamp: 'jmv 9/21/2021 17:52:27' prior: 50594381 overrides: 16876712! + noteNewOwner: aMorph + "I have just been added as a submorph of aMorph" + + super noteNewOwner: aMorph. + aMorph submorphsDo: [ :subMorph | + self refreshTaskbarFor: aMorph ].! ! + +TaskbarMorph class removeSelector: #releaseClassCachedState! + +TaskbarMorph class removeSelector: #initClassCachedState! + +!methodRemoval: TaskbarMorph class #initClassCachedState stamp: 'Install-4872-Taskbar-fixesAndCleanup-JuanVuletich-2021Sep21-17h40m-jmv.001.cs.st 9/24/2021 10:39:54'! +initClassCachedState + + "Should use some other way to find relevant instances" + self flag: #jmvVer2. + self allInstancesDo: [ :each | + each notifyDisplayResize ]! + +TaskbarMorph removeSelector: #notifyDisplayResize! + +!methodRemoval: TaskbarMorph #notifyDisplayResize stamp: 'Install-4872-Taskbar-fixesAndCleanup-JuanVuletich-2021Sep21-17h40m-jmv.001.cs.st 9/24/2021 10:39:54'! +notifyDisplayResize + Display + when: #screenSizeChanged + send: #screenSizeChanged + to: self. + self screenSizeChanged! + +"Postscript: +Leave the line above, and replace the rest of this comment by a useful one. +Executable statements should follow this comment, and should +be separated by periods, with no exclamation points (!!). +Be sure to put any further comments in double-quotes, like this one." +TaskbarMorph allInstancesDo: [ :each | + Display removeActionsWithReceiver: each ].! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4872-Taskbar-fixesAndCleanup-JuanVuletich-2021Sep21-17h40m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4871] on 22 September 2021 at 9:35:25 am'! +!DisplayScreen methodsFor: 'other' stamp: 'jmv 4/1/2013 20:12' prior: 50608099! + forceToScreen: aRectangle + "Force the given rectangular section of the Display to be copied to the screen. The primitive call does nothing if the primitive is not implemented. Used when the deferUpdates flag in the virtual machine is on; see #deferUpdates:." + + self primShowRectLeft: aRectangle left + right: aRectangle right + top: aRectangle top + bottom: aRectangle bottom. +! ! +!DisplayScreen class methodsFor: 'screen update' stamp: 'jmv 9/22/2021 09:31:18' prior: 50571555! + screenUpdater + | delay | + delay _ Delay forMilliseconds: 50. + ScreenUpdaterSemaphore _ Semaphore new. + Damage _ nil. + [ + delay wait. + ScreenUpdaterSemaphore wait. + DisplayScreen isDisplayExtentOk ifTrue: [ + Display forceToScreen: Damage. + ScreenUpdaterSemaphore initSignals. + Damage _ nil ]. + ] repeat! ! + +"Postscript: +Leave the line above, and replace the rest of this comment by a useful one. +Executable statements should follow this comment, and should +be separated by periods, with no exclamation points (!!). +Be sure to put any further comments in double-quotes, like this one." + DisplayScreen installScreenUpdater! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4873-screenUpdater-fix-JuanVuletich-2021Sep22-09h31m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4871] on 22 September 2021 at 9:39:51 am'! +!DisplayScreen class methodsFor: 'snapshots' stamp: 'jmv 9/22/2021 09:37:38'! + setupDisplay + " + DisplayScreen setupDisplay. + Display forceToScreen. + " + + self terminateScreenUpdater. + Display setExtent: self actualScreenSize depth: Display nativeDepth. + Display beDisplay. + self installScreenUpdater.! ! +!DisplayScreen class methodsFor: 'snapshots' stamp: 'jmv 9/22/2021 09:37:45' prior: 50608139 overrides: 50335344! + startUp + " + DisplayScreen startUp. + Display forceToScreen. + " + self setupDisplay.! ! +!WorldMorph methodsFor: 'update cycle' stamp: 'jmv 9/22/2021 09:38:22' prior: 50608145! + checkForNewScreenSize + "Check whether the screen size has changed and if so take appropriate actions" + + DisplayScreen isDisplayExtentOk ifFalse: [ + "Minimize the risk of going out of memory: + - First clear existing canvas, to free the memory it uses. + - Then, setup the display. + - Then set up new canvas." + self clearCanvas. + DisplayScreen setupDisplay. + self setMainCanvas. + self whenUIinSafeState: [ Cursor defaultCursor activateCursor ]].! ! + +DisplayScreen class removeSelector: #setupDisplay:! + +!methodRemoval: DisplayScreen class #setupDisplay: stamp: 'Install-4874-setupDisplay-removeSuperfluousPedantry-JuanVuletich-2021Sep22-09h35m-jmv.001.cs.st 9/24/2021 10:39:54'! +setupDisplay: doGarbageCollection + " + DisplayScreen setupDisplay: true. + Display forceToScreen. + " + + self terminateScreenUpdater. + doGarbageCollection ifTrue: [ + Display setExtent: 0@0 depth: 0 bits: nil. + Smalltalk primitiveGarbageCollect. ]. + Display setExtent: self actualScreenSize depth: Display nativeDepth. + Display beDisplay. + self installScreenUpdater.! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4874-setupDisplay-removeSuperfluousPedantry-JuanVuletich-2021Sep22-09h35m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4874] on 22 September 2021 at 3:03:14 pm'! +!TaskbarMorph methodsFor: 'submorphs-add/remove' stamp: 'jmv 9/22/2021 15:02:43' prior: 50609612 overrides: 16876712! + noteNewOwner: aMorph + "I have just been added as a submorph of aMorph" + + super noteNewOwner: aMorph. + aMorph submorphsDo: [ :subMorph | + self refreshTaskbarFor: subMorph ].! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4875-Taskbar-fix-JuanVuletich-2021Sep22-15h02m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4875] on 22 September 2021 at 3:09:47 pm'! +!TaskbarMorph methodsFor: 'submorphs-add/remove' stamp: 'jmv 9/22/2021 15:09:15' prior: 50609771 overrides: 16876712! + noteNewOwner: aMorph + "I have just been added as a submorph of aMorph" + + super noteNewOwner: aMorph. + aMorph submorphsDo: [ :subMorph | + self refreshTaskbarFor: subMorph ]. + self screenSizeChanged.! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4876-Taskbar-fix-JuanVuletich-2021Sep22-15h09m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4876] on 22 September 2021 at 4:08:55 pm'! +!Theme methodsFor: 'colors' stamp: 'jmv 9/22/2021 16:08:06' prior: 50388779! + background + + "^ `Color r: 0.7 g: 0.72 b: 0.83`." + ^ `Color r: 0.167 g: 0.344 b: 0.629`! ! + +"Postscript: +Leave the line above, and replace the rest of this comment by a useful one. +Executable statements should follow this comment, and should +be separated by periods, with no exclamation points (!!). +Be sure to put any further comments in double-quotes, like this one." +self runningWorld color: Theme current background.! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4877-defaultBackgroundColor-JuanVuletich-2021Sep22-16h07m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4877] on 22 September 2021 at 4:22:12 pm'! +!MessageSetWindow class methodsFor: 'opening' stamp: 'jmv 9/22/2021 16:20:42'! + openMessageListUnsorted: methodReferences label: labelString + "Open a system view for a MessageSet on messageList. + Don't sort entries by default." + + | messageSet | + + messageSet _ MessageSet messageList: methodReferences asArray. + + ^self open: messageSet label: labelString ! ! +!ChangeListWindow methodsFor: 'menu commands' stamp: 'jmv 9/22/2021 16:20:50' prior: 16797146! + browseCurrentVersionsOfSelections + "Opens a message-list browser on the current in-memory versions of all methods that are currently seleted" + | aList | + + aList _ model currentVersionsOfSelections. + + aList size = 0 ifTrue: [^ self inform: 'no selected methods have in-memory counterparts']. + MessageSetWindow + openMessageListUnsorted: aList + label: 'Current versions of selected methods in ', model file localName! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4878-browseCurrentVersions-unsortedByDefault-JuanVuletich-2021Sep22-16h20m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4876] on 22 September 2021 at 9:15:23 pm'! + +ChangeSelector subclass: #AddParameter + instanceVariableNames: 'newParameter newParameterValue implementorTrailingString senderTrailingString index isAddingLast' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +!classDefinition: #AddParameter category: #'Tools-Refactoring' stamp: 'Install-4879-ExtractAsParameter-HernanWilkinson-2021Sep22-15h23m-HAW.001.cs.st 9/24/2021 10:39:55'! +ChangeSelector subclass: #AddParameter + instanceVariableNames: 'newParameter newParameterValue implementorTrailingString senderTrailingString index isAddingLast' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +Refactoring subclass: #ExtractAsParameter + instanceVariableNames: 'intervalToExtract sourceMethod addParameter intervalToReplace' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +!classDefinition: #ExtractAsParameter category: #'Tools-Refactoring' stamp: 'Install-4879-ExtractAsParameter-HernanWilkinson-2021Sep22-15h23m-HAW.001.cs.st 9/24/2021 10:39:55'! +Refactoring subclass: #ExtractAsParameter + instanceVariableNames: 'intervalToExtract sourceMethod addParameter intervalToReplace' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +AddParameterApplier subclass: #ExtractAsParameterApplier + instanceVariableNames: 'interval' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +!classDefinition: #ExtractAsParameterApplier category: #'Tools-Refactoring' stamp: 'Install-4879-ExtractAsParameter-HernanWilkinson-2021Sep22-15h23m-HAW.001.cs.st 9/24/2021 10:39:55'! +AddParameterApplier subclass: #ExtractAsParameterApplier + instanceVariableNames: 'interval' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! +!SmalltalkEditor methodsFor: 'contextual add/remove parameter' stamp: 'HAW 9/22/2021 20:24:46'! + contextualExtractAsParameter + + self isEditingClassDefinition + ifTrue: [ morph flash ] + ifFalse: [ self ifSourceCodeRefactoringCanBeAppliedDo: [ self extractAsParameter ]]! ! +!SmalltalkEditor methodsFor: 'contextual add/remove parameter' stamp: 'HAW 9/22/2021 16:36:12'! + contextualExtractAsParameter: aKeyboardEvent + + self contextualExtractAsParameter. + ^true! ! +!SmalltalkEditor methodsFor: 'contextual add/remove parameter' stamp: 'HAW 9/22/2021 20:24:56'! + extractAsParameter + + ^ RefactoringApplier extractAsParameterApplier createAndValueHandlingExceptions: [ + RefactoringApplier extractAsParameterApplier + from: self selectionInterval + on: model textProvider + for: self codeProvider selectedMessageName + in: self selectedClassOrMetaClassOrUndefinedObject ]! ! +!SmalltalkEditor methodsFor: 'contextual rename' stamp: 'HAW 9/22/2021 19:41:21'! + selectedClassOrMetaClassOrUndefinedObject + + "I have to do this because some codeProviders do not answer selectedClassOrMetaClass like the Workspace - Hernan" + + ^ [ self codeProvider selectedClassOrMetaClass ] + on: Error + do: [ :anError | anError return: UndefinedObject ]! ! +!ChangeSelector methodsFor: 'changes' stamp: 'HAW 9/22/2021 20:18:57'! + changes + + ^changes! ! +!AddParameter methodsFor: 'parameter' stamp: 'HAW 9/8/2021 22:37:02'! + newParameter + + ^newParameter! ! +!ExtractAsParameter methodsFor: 'applying' stamp: 'HAW 9/22/2021 20:19:25' overrides: 50438490! + apply + + self + applyAddParameter; + useNewParameter. + + ^addParameter changes + + ! ! +!ExtractAsParameter methodsFor: 'applying - private' stamp: 'HAW 9/22/2021 20:19:25'! + applyAddParameter + + ^ addParameter apply! ! +!ExtractAsParameter methodsFor: 'applying - private' stamp: 'HAW 9/22/2021 20:17:24'! + newSourceCode + + | intermediateSourceCode newInterval newSourceCode originalSourceCodeSize intermediateMethod | + + originalSourceCodeSize := sourceMethod sourceCode size. + intermediateMethod := sourceMethod methodClass >> self newSelector. + intermediateSourceCode := intermediateMethod sourceCode. + newInterval := intervalToReplace + (intermediateSourceCode size - originalSourceCodeSize). + newSourceCode := intermediateSourceCode copyReplaceFrom: newInterval first to: newInterval last with: addParameter newParameter. + + ^newSourceCode ! ! +!ExtractAsParameter methodsFor: 'applying - private' stamp: 'HAW 9/22/2021 20:17:33'! + useNewParameter + + sourceMethod methodClass compile: self newSourceCode. + + ! ! +!ExtractAsParameter methodsFor: 'initialization' stamp: 'HAW 9/21/2021 19:13:59'! + initializeExtractedFrom: anIntervalToExtract replacing: anIntervalToReplace at: aSourceMethod addingParameterWith: anAddParameter + + intervalToExtract := anIntervalToExtract. + intervalToReplace := anIntervalToReplace. + sourceMethod := aSourceMethod. + addParameter := anAddParameter.! ! +!ExtractAsParameter methodsFor: 'selectors' stamp: 'HAW 9/22/2021 19:56:45'! + newSelector + + ^addParameter newSelector ! ! +!ExtractAsParameter class methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 15:39:26'! + assert: aSourceMethod isInImplementors: implementorsCollection + + ^ (implementorsCollection includes: aSourceMethod) ifFalse: [ self signalOrigialMethodMustBeInImplementorsToChange ]! ! +!ExtractAsParameter class methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 20:07:25'! + assertAndCreateNamed: aNewParameter + extractedFrom: anInterval + at: aSourceMethod + implementors: implementorsCollection + senders: sendersCollection + creatingAddParameterWith: addParameterCreator + + | addParameter sourceCodeToExtract trimmedIntervalToReplace intervalToReplace intervals | + + self assert: aSourceMethod isInImplementors: implementorsCollection. + intervals := self assertCanExtractedFrom: anInterval for: aSourceMethod. + + intervalToReplace := intervals first. + trimmedIntervalToReplace := intervals second. + sourceCodeToExtract := aSourceMethod sourceCode copyFrom: trimmedIntervalToReplace first to: trimmedIntervalToReplace last. + + addParameter := addParameterCreator value: sourceCodeToExtract. + + ^self new + initializeExtractedFrom: trimmedIntervalToReplace + replacing: intervalToReplace + at: aSourceMethod + addingParameterWith: addParameter! ! +!ExtractAsParameter class methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 19:01:23'! + assertCanExtractedFrom: anInterval for: aSourceMethod + + | trimmedIntervalToReplace sourceCode node intervalToReplace | + + sourceCode := aSourceMethod sourceCode. + + ExtractMethodNewMethod assertIntervalToExtractIsNotEmpty: anInterval. + ExtractMethodNewMethod assert: anInterval isWithinBoundsOf: sourceCode. + + intervalToReplace := self removeDotsAt: anInterval in: sourceCode. + trimmedIntervalToReplace := intervalToReplace asSourceCodeInterval trimToMatchExpressionOn: sourceCode. + node := self nodeToExtractFrom: aSourceMethod at: trimmedIntervalToReplace or: intervalToReplace. + self assertIsValidToExtract: node. + + ^{ intervalToReplace. trimmedIntervalToReplace } + + ! ! +!ExtractAsParameter class methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 14:26:11'! + assertIsValidAssigmentToExtract: anAssignmentNode + + self assertIsValidToExtract: anAssignmentNode variable. + self assertIsValidToExtract: anAssignmentNode value ! ! +!ExtractAsParameter class methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 09:40:26'! + assertIsValidBlockNodeToExtract: aBlockNode + + aBlockNode block statementsDo: [ :aStatement | self assertIsValidToExtract: aStatement ]! ! +!ExtractAsParameter class methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 20:05:10'! + assertIsValidKeywordForNewParameter: aNewKeyword + + AddParameter assertIsValidKeywordForNewParameter: aNewKeyword! ! +!ExtractAsParameter class methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 15:09:49'! + assertIsValidLiteralNodeToExtract: aNode + + ^ (aNode isLiteralNode + or: [ aNode isTruePseudoVariable + or: [ aNode isFalsePseudoVariable + or: [ aNode isNilPseudoVariable ]]]) ifFalse: [ self signalInvalidExpressionToExtractAsParameter ]! ! +!ExtractAsParameter class methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 15:04:00'! + assertIsValidMessageNodeToExtract: aNode + + self assertIsValidToExtract: aNode receiver. + aNode arguments do: [ :anArgument | self assertIsValidToExtract: anArgument ]! ! +!ExtractAsParameter class methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 19:56:21'! + assertIsValidParameterName: aName + + AddParameter assertIsValidParameterName: aName ! ! +!ExtractAsParameter class methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 15:09:49'! + assertIsValidTempOrArgNodeToExtract: aTempVariableNode + + aTempVariableNode isDeclaredAtMethodLevel ifTrue: [ self signalInvalidExpressionToExtractAsParameter ]! ! +!ExtractAsParameter class methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 15:03:50'! + assertIsValidToExtract: aNode + + aNode isMessageNode ifTrue: [ ^self assertIsValidMessageNodeToExtract: aNode]. + aNode isBlockNode ifTrue: [ ^self assertIsValidBlockNodeToExtract: aNode ]. + aNode isTempOrArg ifTrue: [ ^self assertIsValidTempOrArgNodeToExtract: aNode ]. + aNode isAssignmentToTemporary ifTrue: [ ^self assertIsValidAssigmentToExtract: aNode ]. + self assertIsValidLiteralNodeToExtract: aNode! ! +!ExtractAsParameter class methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 09:28:16'! + is: aRange equalTo: sourceInterval or: intervalToReplace + + "When selecting literals like 1, the range first is one less than the initial character of the literal - Hernan" + + ^aRange = sourceInterval + or: [ aRange = intervalToReplace + or: [ aRange first + 1 = sourceInterval first and: [ aRange value last = sourceInterval last]]]! ! +!ExtractAsParameter class methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 15:45:11'! + nodeToExtractFrom: aSourceMethod at: trimmedIntervalToReplace or: intervalToReplace + + | nodeWithRangeToExtract nodesWithFirstPosition | + + nodesWithFirstPosition := aSourceMethod methodNode parseNodesPathAt: trimmedIntervalToReplace first ifAbsent: [ self signalInvalidSelection ]. + nodeWithRangeToExtract := nodesWithFirstPosition + detect: [ :nodeAndRange | self is: nodeAndRange value equalTo: trimmedIntervalToReplace or: intervalToReplace ] + ifNone: [ self signalInvalidSelection ]. + + ^nodeWithRangeToExtract key. + ! ! +!ExtractAsParameter class methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 15:42:21'! + removeDotsAt: anInterval in: sourceCode + + | lastToReplace | + + lastToReplace := anInterval last. + [(sourceCode at: lastToReplace) = $. ] whileTrue: [ lastToReplace := lastToReplace - 1]. + + ^anInterval first to: lastToReplace! ! +!ExtractAsParameter class methodsFor: 'instance creation' stamp: 'HAW 9/22/2021 15:55:37'! + named: aNewParameter + extractedFrom: anInterval + at: aSourceMethod + implementors: implementorsCollection + senders: sendersCollection + + ^self + assertAndCreateNamed: aNewParameter + extractedFrom: anInterval + at: aSourceMethod + implementors: implementorsCollection + senders: sendersCollection + creatingAddParameterWith: [ :sourceCodeToExtract | + AddParameter + named: aNewParameter + initializedWith: sourceCodeToExtract + toUnarySelector: aSourceMethod selector + implementors: implementorsCollection + senders: sendersCollection ]! ! +!ExtractAsParameter class methodsFor: 'instance creation' stamp: 'HAW 9/22/2021 15:56:38'! + named: aNewParameter + extractedFrom: anInterval + at: aNewKeywordIndex + newKeyword: newKeyword + at: aSourceMethod + implementors: implementorsCollection + senders: sendersCollection + + ^self + assertAndCreateNamed: aNewParameter + extractedFrom: anInterval + at: aSourceMethod + implementors: implementorsCollection + senders: sendersCollection + creatingAddParameterWith: [ :sourceCodeToExtract | + AddParameter + named: aNewParameter + at: aNewKeywordIndex + initializedWith: sourceCodeToExtract + using: newKeyword + toKeywordSelector: aSourceMethod selector + implementors: implementorsCollection + senders: sendersCollection ]! ! +!ExtractAsParameter class methodsFor: 'error messages' stamp: 'HAW 9/22/2021 15:10:01'! + errorMessageForInvalidExpressionToExtractAsParameter + + ^'Only literals, message sends to literals with literal parameters and +blocks with the previous conditions can be extracted as parameters'! ! +!ExtractAsParameter class methodsFor: 'error messages' stamp: 'HAW 9/21/2021 17:31:17'! + errorMessageForInvalidSelection + + ^'The selected source code is invalid for extraction as parameter'! ! +!ExtractAsParameter class methodsFor: 'error messages' stamp: 'HAW 9/22/2021 15:36:27'! + errorMessageForOrigialMethodMustBeInImplementorsToChange + + ^'Method with code to extract must be as implementor to change'! ! +!ExtractAsParameter class methodsFor: 'exceptions' stamp: 'HAW 9/22/2021 15:10:01'! + signalInvalidExpressionToExtractAsParameter + + self refactoringError: self errorMessageForInvalidExpressionToExtractAsParameter ! ! +!ExtractAsParameter class methodsFor: 'exceptions' stamp: 'HAW 9/21/2021 17:30:33'! + signalInvalidSelection + + self refactoringError: self errorMessageForInvalidSelection! ! +!ExtractAsParameter class methodsFor: 'exceptions' stamp: 'HAW 9/22/2021 15:37:55'! + signalOrigialMethodMustBeInImplementorsToChange + + self refactoringError: self errorMessageForOrigialMethodMustBeInImplementorsToChange! ! +!ExtractAsParameter class methodsFor: 'implementors and senders' stamp: 'HAW 9/22/2021 19:57:44'! + addImplementorsOf: anOldSelector to: implementors andSendersTo: senders forClassAndMetaOf: aPotentialClassToRefactor + + ^AddParameter addImplementorsOf: anOldSelector to: implementors andSendersTo: senders forClassAndMetaOf: aPotentialClassToRefactor! ! +!ExtractAsParameter class methodsFor: 'implementors and senders' stamp: 'HAW 9/22/2021 19:59:56'! + addImplementorsOf: anOldSelector to: implementors andSendersTo: senders inCategoriesAndHierarchyOf: aClass organizedBy: anOrganization + + ^AddParameter addImplementorsOf: anOldSelector to: implementors andSendersTo: senders inCategoriesAndHierarchyOf: aClass organizedBy: anOrganization! ! +!ExtractAsParameter class methodsFor: 'implementors and senders' stamp: 'HAW 9/22/2021 19:59:25'! + addImplementorsOf: anOldSelector to: implementors andSendersTo: senders inCategory: aCategory organizedBy: anOrganization + + ^AddParameter addImplementorsOf: anOldSelector to: implementors andSendersTo: senders inCategory: aCategory organizedBy: anOrganization! ! +!ExtractAsParameter class methodsFor: 'implementors and senders' stamp: 'HAW 9/22/2021 19:58:31'! + addImplementorsOf: anOldSelector to: implementors andSendersTo: senders inHierarchyOf: aClass + + ^AddParameter addImplementorsOf: anOldSelector to: implementors andSendersTo: senders inHierarchyOf: aClass +! ! +!ExtractAsParameter class methodsFor: 'implementors and senders' stamp: 'HAW 9/22/2021 20:00:22'! + addImplementorsOf: anOldSelector to: implementors andSendersTo: senders inSystem: aSystem + + ^AddParameter addImplementorsOf: anOldSelector to: implementors andSendersTo: senders inSystem: aSystem +! ! +!RefactoringApplier class methodsFor: 'appliers - registering' stamp: 'HAW 9/22/2021 18:38:54'! + registerExtractAsParameterApplier: anExtractAsParameterApplierClass + + self registerApplierAt: self extractAsParameterApplierId with: anExtractAsParameterApplierClass ! ! +!RefactoringApplier class methodsFor: 'appliers - getting' stamp: 'HAW 9/22/2021 16:35:35'! + extractAsParameterApplier + + ^self applierAt: self extractAsParameterApplierId ifAbsent: [ ExtractAsParameterApplier ]! ! +!RefactoringApplier class methodsFor: 'appliers - id' stamp: 'HAW 9/22/2021 16:35:22'! + extractAsParameterApplierId + + ^#extractAsParameterApplier! ! +!RefactoringApplier class methodsFor: 'appliers - resetting' stamp: 'HAW 9/22/2021 18:39:16'! + resetExtractAsParameterApplier + + self resetApplierAt: self extractAsParameterApplierId! ! +!ExtractAsParameterApplier methodsFor: 'refactoring - parameters request' stamp: 'HAW 9/22/2021 16:30:27' overrides: 50441870! + askNewParameterValue! ! +!ExtractAsParameterApplier methodsFor: 'refactoring - creation' stamp: 'HAW 9/22/2021 20:06:39' overrides: 50441793! + createRefactoringForKeywordSelector + + ^self refactoringClass + named: newParameter + extractedFrom: interval + at: parameterIndex + newKeyword: newKeyword + at: selectedClass >> oldSelector + implementors: implementors + senders: senders ! ! +!ExtractAsParameterApplier methodsFor: 'refactoring - creation' stamp: 'HAW 9/22/2021 19:36:15' overrides: 50441804! + createRefactoringForUnarySelector + + ^self refactoringClass + named: newParameter + extractedFrom: interval + at: selectedClass >> oldSelector + implementors: implementors + senders: senders ! ! +!ExtractAsParameterApplier methodsFor: 'refactoring - creation' stamp: 'HAW 9/22/2021 16:30:58' overrides: 50441814! + refactoringClass + + ^ExtractAsParameter ! ! +!ExtractAsParameterApplier methodsFor: 'initialization' stamp: 'HAW 9/22/2021 19:05:46'! + initializeInterval: anInterval + + interval := anInterval.! ! +!ExtractAsParameterApplier class methodsFor: 'instance creation' stamp: 'HAW 9/22/2021 19:03:29'! +from: anInterval on: aModel for: anOldSelector in: aClassToRefactor + + ExtractAsParameter assertCanExtractedFrom: anInterval for: aClassToRefactor >> anOldSelector. + + ^(super on: aModel for: anOldSelector in: aClassToRefactor) initializeInterval: anInterval ! ! +!SmalltalkEditor methodsFor: 'contextual rename' stamp: 'HAW 9/22/2021 19:41:05' prior: 50573278! + withMethodNodeAndClassDo: aBlock ifErrorsParsing: anErrorBlock + + | selectedClass methodNode | + + selectedClass := self selectedClassOrMetaClassOrUndefinedObject. + [ + [ methodNode := selectedClass methodNodeFor: model actualContents asString ] + on: UndeclaredVariableWarning do: [ :ex | ex resume ] + ] on: Error do: [ :anError | ^ anErrorBlock value: anError ]. + + ^aBlock value: methodNode value: selectedClass.! ! +!AddParameterApplier methodsFor: 'refactoring - parameters request' stamp: 'HAW 9/22/2021 16:27:52' prior: 50441870! + askNewParameterValue + + | enteredString | + + enteredString := self request: 'Enter parameter value for senders'. + newParameterValue := enteredString withBlanksTrimmed. + self refactoringClass assertNewParameterValueIsValid: newParameterValue. +! ! +!RefactoringMenues class methodsFor: 'editor menus' stamp: 'HAW 9/22/2021 16:41:33' prior: 50491927! + smalltalkEditorRefactoringMenuOptions + + ^`{ + { + #itemGroup -> 35. + #itemOrder -> 30. + #label -> 'Add Parameter... (A)'. + #selector -> #contextualAddParameter. + #icon -> #listAddIcon + } asDictionary. + { + #itemGroup -> 35. + #itemOrder -> 35. + #label -> 'Extract as Parameter... (1)'. + #selector -> #contextualExtractAsParameter. + #icon -> #listAddIcon + } asDictionary. + { + #itemGroup -> 35. + #itemOrder -> 40. + #label -> 'Remove Parameter... (S)'. + #selector -> #contextualRemoveParameter. + #icon -> #listRemoveIcon + } asDictionary. + { + #itemGroup -> 35. + #itemOrder -> 50. + #label -> 'Temporary to Instance Variable (O)'. + #selector -> #temporaryToInstanceVariable. + #icon -> #saveAsIcon + } asDictionary. + { + #itemGroup -> 35. + #itemOrder -> 60. + #label -> 'Push Up Instance Variable'. + #selector -> #contextualPushUpInClassDefinition. + #icon -> #goTopIcon + } asDictionary. + { + #itemGroup -> 35. + #itemOrder -> 70. + #label -> 'Push Down Instance Variable'. + #selector -> #contextualPushDownInClassDefinition. + #icon -> #goBottomIcon + } asDictionary. + }`! ! +!RefactoringMenues class methodsFor: 'shortcuts' stamp: 'HAW 9/22/2021 19:34:01' prior: 50507326! + smalltalkEditorCmdShortcutsSpec + + " + SmalltalkEditor initializeCmdShortcuts + " + ^#( + #($R #contextualRename: 'Renames what is under cursor') + #($A #contextualAddParameter: 'Adds parameter to message that is under cursor') + #($S #contextualRemoveParameter: 'Removes parameter to message that is under cursor') + #($O #temporaryToInstanceVariable: 'Extracts temporary variable to instance variable') + #($J #extractToTemporary: 'Extracts the selected code into a temporary variable') + #($K #extractMethod: 'Extracts the selected code into a separate method') + #($1 #contextualExtractAsParameter: 'Extracts the selected code as parameter') + )! ! +!SourceCodeOfMethodToBeExtractedPrecondition methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 14:33:51' prior: 50517377! + assertSourceCodeContainsAValidExpression + + (self intervalCoversCompleteAstNodes + and: [ self startAndEndNodesShareAParentNode + or: [ self intervalMatchesBeginningOfStatement + and: [ self intervalMatchesEndOfStatement ]]]) + ifFalse: [ self signalSourceCodeContainsAnInvalidExpressionError ]! ! +!SourceCodeOfMethodToBeExtractedPrecondition methodsFor: 'private' stamp: 'HAW 9/22/2021 14:55:22' prior: 50508770! + intervalMatchesEndOfStatement + + | closerStatementLastPosition | + + closerStatementLastPosition := (self findSourceRangeOfCloserStatementIn: finalNodeAncestors) last. + ^ closerStatementLastPosition = intervalToExtract last or: [ closerStatementLastPosition - 1 = intervalToExtract last ].! ! + +ExtractAsParameterApplier class removeSelector: #on:for:in:! + +ExtractAsParameter class removeSelector: #assertNamed:extractedFrom:at:implementors:senders:creatingAddParameterWith:! + +ExtractAsParameter class removeSelector: #assertNamed:extractedFrom:at:implementors:senders:! + +ExtractAsParameter removeSelector: #addParameter! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4879-ExtractAsParameter-HernanWilkinson-2021Sep22-15h23m-HAW.001.cs.st----! + +'From Cuis 5.0 [latest update: #4879] on 23 September 2021 at 10:21:47 am'! +!CodeProvider methodsFor: 'annotation' stamp: 'jmv 9/22/2021 18:29:08'! + annotationForSystemCategory: aCategory + "Provide a line of content for an annotation pane, given that the receiver is pointing at the class definition of the given class." + + | separator | + separator _ self annotationSeparator. + ^ String streamContents: [ :strm | + strm + nextPutAll: 'System Category'; + nextPutAll: aCategory; + nextPutAll: separator; + print: (SystemOrganization listAtCategoryNamed: aCategory) size; + nextPutAll: ' classes'; + nextPutAll: separator; + print: (SystemOrganization instanceMethodCountOf: aCategory); + nextPutAll: ' instance methods'; + nextPutAll: separator; + print: (SystemOrganization classMethodCountOf: aCategory); + nextPutAll: ' class methods'; + nextPutAll: separator; + print: (SystemOrganization linesOfCodeOf: aCategory); + nextPutAll: ' total lines of code' ]! ! +!SystemOrganizer methodsFor: 'source code management' stamp: 'jmv 9/23/2021 10:18:03'! + classMethodCountOf: category + + ^ (self superclassOrderIn: category) sum: [ :cl | cl class selectors size ] ifEmpty: 0.! ! +!SystemOrganizer methodsFor: 'source code management' stamp: 'jmv 9/23/2021 10:18:08'! + instanceMethodCountOf: category + + ^ (self superclassOrderIn: category) sum: [ :cl | cl selectors size ] ifEmpty: 0.! ! +!SystemOrganizer methodsFor: 'source code management' stamp: 'jmv 9/23/2021 10:16:49'! + linesOfCodeOf: category +" +SystemOrganization linesOfCodeOf: #'System-Files' +" + "An approximate measure of lines of. + Includes comments, but excludes blank lines." + + ^ (self superclassOrderIn: category) sum: [ :cl | cl linesOfCode ] ifEmpty: 0.! ! +!CodeProvider methodsFor: 'annotation' stamp: 'jmv 9/22/2021 18:45:23' prior: 50518430! + annotationForSelector: aSelector ofClass: aClass + "Provide a line of content for an annotation pane, representing + information about the given selector and class" + + | stamp sendersCount implementorsCount aCategory separator aString aList aComment stream requestList | + aSelector == #Comment + ifTrue: [^ self annotationForClassCommentFor: aClass]. + aSelector == #Definition + ifTrue: [^ self annotationForClassDefinitionFor: aClass]. + aSelector == #Hierarchy + ifTrue: [^ self annotationForHierarchyFor: aClass]. + stream _ WriteStream on: String new. + requestList _ self annotationRequests. + separator _ self annotationSeparator. + requestList + do: [:aRequest | + aRequest == #firstComment + ifTrue: [ + aComment _ aClass firstCommentAt: aSelector. + aComment isEmptyOrNil + ifFalse: [stream position = 0 ifFalse: [stream nextPutAll: separator]. + stream nextPutAll: aComment]]. + aRequest == #masterComment + ifTrue: [ + aComment _ aClass supermostPrecodeCommentFor: aSelector. + aComment isEmptyOrNil + ifFalse: [stream position = 0 ifFalse: [stream nextPutAll: separator]. + stream nextPutAll: aComment]]. + aRequest == #documentation + ifTrue: [ + aComment _ aClass precodeCommentOrInheritedCommentFor: aSelector. + aComment isEmptyOrNil + ifFalse: [stream isEmpty ifFalse: [stream nextPutAll: separator]. + stream nextPutAll: aComment]]. + aRequest == #timeStamp + ifTrue: [ + stamp _ self timeStamp. + stream isEmpty ifFalse: [stream nextPutAll: separator]. + stream nextPutAll: (stamp size > 0 ifTrue: [stamp] ifFalse: ['no timestamp'])]. + aRequest == #linesOfCode + ifTrue: [ + stream isEmpty ifFalse: [stream nextPutAll: separator]. + stream nextPutAll: ((aClass compiledMethodAt: aSelector ifAbsent: nil) + ifNotNil: [ :cm | cm linesOfCode]) printString, ' lines of code']. + aRequest == #messageCategory + ifTrue: [ + aCategory _ aClass organization categoryOfElement: aSelector. + aCategory + ifNotNil: ["woud be nil for a method no longer present, + e.g. in a recent-submissions browser" + stream isEmpty ifFalse: [stream nextPutAll: separator]. + stream nextPutAll: aCategory]]. + aRequest == #sendersCount + ifTrue: [ + sendersCount _ Smalltalk numberOfSendersOf: aSelector. + sendersCount _ sendersCount = 1 + ifTrue: ['1 sender'] + ifFalse: [sendersCount printString , ' senders']. + stream isEmpty ifFalse: [stream nextPutAll: separator]. + stream nextPutAll: sendersCount]. + aRequest == #implementorsCount + ifTrue: [ + implementorsCount _ Smalltalk numberOfImplementorsOf: aSelector. + implementorsCount _ implementorsCount = 1 + ifTrue: ['1 implementor'] + ifFalse: [implementorsCount printString , ' implementors']. + stream isEmpty ifFalse: [stream nextPutAll: separator]. + stream nextPutAll: implementorsCount]. + aRequest == #priorVersionsCount + ifTrue: [ + stream isEmpty ifFalse: [stream nextPutAll: separator]. + self + addPriorVersionsCountForSelector: aSelector + ofClass: aClass + to: stream]. + aRequest == #priorTimeStamp + ifTrue: [ + stamp _ VersionsBrowser + timeStampFor: aSelector + class: aClass + reverseOrdinal: 2. + stamp + ifNotNil: [stream isEmpty ifFalse: [stream nextPutAll: separator]. + stream nextPutAll: 'prior timestamp: ' , stamp]]. + aRequest == #packages + ifTrue: [ + (aClass compiledMethodAt: aSelector ifAbsent: nil) ifNotNil: [ :cm | + stream isEmpty ifFalse: [stream nextPutAll: separator]. + (CodePackage packageOfMethod: cm methodReference ifNone: nil) + ifNil: [ stream nextPutAll: 'in no package' ] + ifNotNil: [ :codePackage | + stream nextPutAll: 'in package '; nextPutAll: codePackage packageName ]]]. + aRequest == #changeSets + ifTrue: [ + stream isEmpty ifFalse: [stream nextPutAll: separator]. + aList _ ChangeSet allChangeSetsWithClass: aClass selector: aSelector. + aList size > 0 + ifTrue: [aList size = 1 + ifTrue: [stream nextPutAll: 'only in change set'] + ifFalse: [stream nextPutAll: 'in change sets:']. + aList + do: [:aChangeSet | stream nextPut: Character space; nextPutAll: aChangeSet name ] + separatedBy: [ stream nextPut: $, ]] + ifFalse: [stream nextPutAll: 'in no change set']]. + aRequest == #allChangeSets + ifTrue: [ + stream isEmpty ifFalse: [stream nextPutAll: separator]. + aList _ ChangeSet allChangeSetsWithClass: aClass selector: aSelector. + aList size > 0 + ifTrue: [aList size = 1 + ifTrue: [stream nextPutAll: 'only in change set'] + ifFalse: [stream nextPutAll: 'in change sets:']. + aList + do: [:aChangeSet | stream nextPut: Character space; nextPutAll: aChangeSet name ] + separatedBy: [ stream nextPut: $, ]] + ifFalse: [stream nextPutAll: 'in no change set']]. + aRequest == #allBaseSystemChangeSets + ifTrue: [ + stream isEmpty ifFalse: [stream nextPutAll: separator]. + aList _ (ChangeSet allChangeSetsWithClass: aClass selector: aSelector) select: [ :it | it isForBaseSystem ]. + aList size > 0 + ifTrue: [ + aList size = 1 + ifTrue: [stream nextPutAll: 'only in base system change set'] + ifFalse: [stream nextPutAll: 'in base system change sets:']. + aList + do: [:aChangeSet | stream nextPut: Character space; nextPutAll: aChangeSet name ] + separatedBy: [ stream nextPut: $, ]] + ifFalse: [stream nextPutAll: 'in no base system change set']]. + aRequest == #closuresInfo + ifTrue: [ + aString _ aClass closuresInfoAt: aSelector. + aString size > 0 + ifTrue: [stream isEmpty ifFalse: [stream nextPutAll: separator]. + stream nextPutAll: aString]]. + ]. + ^ stream contents! ! +!Browser methodsFor: 'annotation' stamp: 'jmv 9/23/2021 10:08:33' prior: 50485527 overrides: 50455416! + annotation + "Provide a line of content for an annotation pane, representing information about the method associated with the selected class and selector in the receiver." + + | aSelector aClass | + (aClass _ self selectedClassOrMetaClass) + ifNil: [ + self selectedSystemCategoryName ifNotNil: [ :sysCat | + ^self annotationForSystemCategory: sysCat ]. + ^ '']. + self editSelection == #editComment + ifTrue: [^ self annotationForSelector: #Comment ofClass: aClass]. + self isEditingExistingClass + ifTrue: [^ self annotationForSelector: #Definition ofClass: aClass]. + (aSelector _ self selectedMessageName) + ifNil: [^ '']. + ^ self annotationForSelector: aSelector ofClass: aClass! ! +!ClassDescription methodsFor: 'source code management' stamp: 'jmv 9/23/2021 10:05:44' prior: 16807069! + linesOfCode +" +Object linesOfCode +" + "An approximate measure of lines of. + Includes comments, but excludes blank lines. + If asked to a class, also include its metaclass (i.e. the class side). + If asked to a metaclass (the class side), don't include the class (the instance side)." + + | lines | + lines _ 0. + self selectorsDo: [ :sel | + lines _ lines + (self compiledMethodAt: sel) linesOfCode ]. + ^self isMeta + ifTrue: [ lines] + ifFalse: [ lines + self class linesOfCode]. +" +(SystemOrganization categories select: [:c | 'Kernel*' match: c]) sum: [:c | + (SystemOrganization superclassOrderIn: c) sum: [:cl | cl linesOfCode]] +" +" +Smalltalk allClasses sum: [:cl | cl linesOfCode] +"! ! +!CompiledMethod methodsFor: 'source code management' stamp: 'jmv 9/23/2021 10:03:40' prior: 16820495! + linesOfCode + "An approximate measure of lines of code. + Use decompiled source code. In this way, the measure: + - Doesn't include comments + - Doesn't include blank lines + - Is not sensitive to code formatting + The motivation is to consider LOC as an expense, not an asset. Minimizing LOC is good. + But it is not like that for comments!!" + + | lines | + lines _ 0. + self decompileString lineIndicesDo: [ :start :endWithoutDelimiters :end | + endWithoutDelimiters - start > 0 ifTrue: [ + lines _ lines+1 ]]. + ^lines! ! +!Preferences class methodsFor: 'parameters' stamp: 'jmv 9/22/2021 18:41:13' prior: 16893315! +annotationInfo + "Answer a list of pairs characterizing all the available kinds of annotations; in each pair, the first element is a symbol representing the info type, and the second element is a string providing the corresponding balloon help" + + ^ #( + (timeStamp 'The time stamp of the last submission of the method.') + (firstComment 'The first comment in the method, if any.') + (masterComment 'The comment at the beginning of the supermost implementor of the method if any.') + (documentation 'Comment at beginning of the method or, if it has none, comment at the beginning of a superclass''s implementation of the method.') + (messageCategory 'Which method category the method lies in.') + (sendersCount 'A report of how many senders there of the message.') + (implementorsCount 'A report of how many implementors there are of the message.') + (allChangeSets 'A list of all change sets bearing the method.') + (priorVersionsCount 'A report of how many previous versions there are of the method.') + (priorTimeStamp 'The time stamp of the penultimate submission of the method, if any.') + (closuresInfo 'Details about BlockClosures in the method.') + (packages 'Details about CodePackages including the method.') + (linesOfCode 'Number of lines of code, including comments but not blank lines.') + )! ! +!CodePackage methodsFor: 'source code management' stamp: 'jmv 9/23/2021 10:27:42' prior: 16810500! + linesOfCode + "An approximate measure of lines of code. + Does not includes comments, or excludes blank lines. + See comment at CompiledMethod >> #linesOfCode" + + ^self methods inject: 0 into: [ :sum :each | + sum + each compiledMethod linesOfCode ].! ! +!Preferences class methodsFor: 'parameters' stamp: 'jmv 9/22/2021 18:42:21' prior: 50419252! + setDefaultAnnotationInfo + " + Preferences setDefaultAnnotationInfo + " + ^ self parameters at: #MethodAnnotations put: #(timeStamp linesOfCode messageCategory implementorsCount sendersCount packages changeSets)! ! + +"Postscript: +Leave the line above, and replace the rest of this comment by a useful one. +Executable statements should follow this comment, and should +be separated by periods, with no exclamation points (!!). +Be sure to put any further comments in double-quotes, like this one." + Preferences setDefaultAnnotationInfo! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4880-LinesOfCode-Enhancements-JuanVuletich-2021Sep23-09h57m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4880] on 23 September 2021 at 11:31:18 am'! +!Preferences class methodsFor: 'parameters' stamp: 'jmv 9/23/2021 11:30:01'! + setCheapAnnotationInfo + " + Preferences setCheapAnnotationInfo + " + ^ self parameters at: #MethodAnnotations put: #(timeStamp messageCategory packages changeSets)! ! +!Preferences class methodsFor: 'themes' stamp: 'jmv 9/23/2021 11:30:57' prior: 50601490! + slowMachine + " + Preferences slowMachine + " + self setPreferencesFrom: #( + #(#drawKeyboardFocusIndicator false ) + (balloonHelpEnabled false) + (browseWithPrettyPrint false) + (caseSensitiveFinds true) + (checkForSlips false) + (cmdDotEnabled true) + (diffsInChangeList true) + (diffsWithPrettyPrint false) + (menuKeyboardControl false) + (optionalButtons false) + (subPixelRenderFonts true) + (thoroughSenders true) + (cheapWindowReframe true) + (syntaxHighlightingAsYouType false) + (tapAndHoldEmulatesButton2 false) + (clickGrabsMorphs true) + ). + self useNoMenuIcons. + self runningWorld backgroundImageData: nil. + Preferences setCheapAnnotationInfo. + " + Smalltalk at: #ClassicTheme ifPresent: [ :cls | cls beCurrent ]. + Taskbar hideTaskbar + "! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4881-Preferences-slowMachine-tweaks-JuanVuletich-2021Sep23-11h29m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4881] on 23 September 2021 at 4:06:09 pm'! +!PluggableButtonMorph methodsFor: 'accessing' stamp: 'KenD 9/17/2021 16:05:19' prior: 50578326! + iconName + + ^ self valueOfProperty: #iconName! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4882-iconName-fix-KenDickey-2021Sep23-16h05m-KenD.001.cs.st----! + +'From Cuis 5.0 [latest update: #4882] on 24 September 2021 at 10:19:33 am'! +!FontFamily class methodsFor: 'accessing fonts' stamp: 'jmv 9/24/2021 10:03:42'! + enableTrueTypeFontsOnly + + AvailableFamilies _ AvailableFamilies select: [ :f | f isTrueTypeFontFamily ].! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4883-EnableOnlyTrueTypeFonts-JuanVuletich-2021Sep24-10h19m-jmv.001.cs.st----! + +----QUIT----(24 September 2021 10:39:59) Cuis5.0-4883-32.image priorSource: 8888107! \ No newline at end of file diff --git a/Cuis5.0-4883-32.image b/Cuis5.0-4883-32.image new file mode 100644 index 00000000..aaa8e303 Binary files /dev/null and b/Cuis5.0-4883-32.image differ diff --git a/Cuis5.0-4871-v3.changes b/Cuis5.0-4883-v3.changes similarity index 99% rename from Cuis5.0-4871-v3.changes rename to Cuis5.0-4883-v3.changes index d36c3de7..4782515e 100644 --- a/Cuis5.0-4871-v3.changes +++ b/Cuis5.0-4883-v3.changes @@ -210003,4 +210003,1178 @@ isCloserThan: aNumber toPoint: aPoint ----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4871-imageFormdepth-KernelMorph-JuanVuletich-2021Sep21-10h46m-jmv.001.cs.st----! -----QUIT----(21 September 2021 12:54:43) Cuis5.0-4871-v3.image priorSource: 8745619! \ No newline at end of file +----QUIT----(21 September 2021 12:54:43) Cuis5.0-4871-v3.image priorSource: 8745619! + +----STARTUP---- (24 September 2021 10:40:14) as C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\Cuis5.0-4871-v3.image! + + +'From Cuis 5.0 [latest update: #4862] on 21 September 2021 at 5:57:37 pm'! +!WorldMorph methodsFor: 'geometry' stamp: 'jmv 9/21/2021 17:50:48' overrides: 50556442! + extentChanged: oldExtent + "Our extent changed. Must layout submorphs again." + + super extentChanged: oldExtent. + taskbar ifNotNil: [ taskbar screenSizeChanged ].! ! +!SystemDictionary methodsFor: 'snapshot and quit' stamp: 'jmv 9/21/2021 17:53:08' prior: 50603757! + snapshot: save andQuit: quit embedded: embeddedFlag clearAllClassState: clearAllStateFlag + "This is the main method for image save and / or quit. + See senders." + "WARNING: Current process will be killed. UI Process will be restarted" + "Mark the changes file and close all files as part of #processShutdownList. + If save is true, save the current state of this Smalltalk in the image file. + If quit is true, then exit to the outer OS shell. + The latter part of this method runs when resuming a previously saved image. This resume logic + checks for a document file to process when starting up." + " + To test the full cleanup and startup procedures, evaluate: + Smalltalk snapshot: false andQuit: false embedded: false clearAllClassState: true + + To test the cleanup done when saving the image, evaluate: + Smalltalk snapshot: false andQuit: false embedded: false clearAllClassState: false + " + | activeProc | + activeProc _ Processor activeProcess. + [ | isARealStartup guiRootObject guiRootObjectClass | + save not & quit + ifTrue: [ + (SourceFiles at: 2) ifNotNil: [ :changes | + ChangesInitialFileSize ifNotNil: [ changes truncate: ChangesInitialFileSize ]]] + ifFalse: [ + self + logSnapshot: save + andQuit: quit ]. + clearAllStateFlag ifTrue: [ + TranscriptWindow allInstancesDo: [ :each | + each isInWorld ifTrue: [ + each delete.]]. + UISupervisor ui tearDownDesktop. + Transcript logToFile: false ]. + ActiveModel flushEventSystem. + self processShutDownList: quit. + "Lo que sigue aca podria ir al shutdown de alguien... (se levantan en startup!!)" + Smalltalk stopLowSpaceWatcher. + WeakArray stopFinalizationProcess. + ProcessorScheduler stopBackgroundProcess. + "Cosas que levanto explicitamente abajo" + guiRootObjectClass _ UISupervisor ui class. + guiRootObject _ UISupervisor ui. + "Replace with this to create a new world at startup after 'saveAsNewVersion'" + "guiRootObject _ clearAllStateFlag ifFalse: [ UISupervisor ui ]." + UISupervisor stopUIProcess. + activeProc isTerminated ifFalse: [ activeProc terminate ]. + guiRootObject ifNotNil: [ guiRootObject releaseCachedState ]. + "Clean Globals" + Smalltalk + at: #Sensor + put: nil. + Smalltalk + at: #Display + put: nil. + Smalltalk closeSourceFiles. + Smalltalk + at: #SourceFiles + put: nil. + Smalltalk allClassesDo: [ :cls | + cls releaseClassCachedState ]. + clearAllStateFlag ifTrue: [ + Smalltalk allClassesDo: [ :cls | + cls releaseClassState ]]. + "Ojo con los pool dicts. Creo que no hay ninguno..." + "To keep cleaning stuff that shouldn't be saved..." + clearAllStateFlag ifTrue: [ + Smalltalk printStuffToCleanOnImageSave. + "Remove this call to actually see the image clean report." + Transcript clear. + ]. + "Do image save & quit as apropriate" + (Cursor cursorAt: #writeCursor) activateCursor. + save + ifTrue: [ + "The snapshot primitive answers false if it was just called to do the snapshot. + But image startup is resumed by returning (again) from the primitive, but this time answering true." + isARealStartup _ embeddedFlag + ifTrue: [ self snapshotEmbeddedPrimitive ] + ifFalse: [ self snapshotPrimitive ]] + ifFalse: [ isARealStartup _ false ]. + quit & (isARealStartup == false) ifTrue: [ self quitPrimitive ]. + "If starting from absolute scratch, this would be a good time to recreate Global names" + Smalltalk + at: #Sensor + put: nil. + Smalltalk + at: #Display + put: DisplayScreen new. + Smalltalk + at: #SourceFiles + put: (Array new: 2). + Smalltalk openSourceFiles. + "Here, startup begins!! (isARealStartup might be nil)" + Smalltalk allClassesDo: [ :cls | + cls initClassCachedState ]. + self doStartUp: isARealStartup == true. + UISupervisor spawnNewMorphicProcessFor: (guiRootObject ifNil: [ guiRootObject _ guiRootObjectClass newWorld ]). + self restoreLostChangesIfNecessary. + clearAllStateFlag ifTrue: [ + UISupervisor whenUIinSafeState: [ + guiRootObject recreateDefaultDesktop; restoreDisplay ]] + ifFalse: [ + UISupervisor whenUIinSafeState: [ + guiRootObject restoreDisplay ]]. + "If system is coming up (VM and image just started)" + isARealStartup == true ifTrue: [ + UISupervisor whenUIinSafeState: [ + self processCommandLineArguments. + AppLauncher launchApp ]]. + "Now it's time to raise an error" + isARealStartup ifNil: [ self error: 'Failed to write image file (disk full?)' ]] + forkAt: Processor timingPriority - 1 + named: 'Startup process'.! ! +!DisplayScreen methodsFor: 'private' stamp: 'jmv 9/21/2021 17:53:28' prior: 50604445 overrides: 16848801! + setExtent: aPoint depth: bitsPerPixel + "DisplayScreen startUp" + "This method is critical. If the setExtent fails, there will be no + proper display on which to show the error condition." + + | bitsPerPixelToUse | + (depth = bitsPerPixel and: [aPoint = self extent and: [ + self supportsDisplayDepth: bitsPerPixel]]) ifFalse: [ + bits _ nil. "Free up old bitmap in case space is low" + bitsPerPixelToUse _ (self supportsDisplayDepth: bitsPerPixel) + ifTrue: [ bitsPerPixel ] + ifFalse: [ + (self supportsDisplayDepth: bitsPerPixel negated) + ifTrue: [ bitsPerPixel negated ] + ifFalse: [ self findAnyDisplayDepth ]]. + super setExtent: aPoint depth: bitsPerPixelToUse. + ].! ! +!TaskbarMorph methodsFor: 'events' stamp: 'jmv 9/21/2021 17:50:39' prior: 50379886! + screenSizeChanged + "Respond to change in screen size by repositioning self to bottom of screen" + +" Transcript newLine; print: 'Taskbar screenSizeChanged'. +" + | y e | + self world ifNotNil: [ :w | + y _ w morphExtent y - self defaultHeight. + e _ (self internalizeDistance: w morphExtent x @ self defaultHeight) asIntegerPoint. + self morphPosition: 0@y extent: e ].! ! +!TaskbarMorph methodsFor: 'submorphs-add/remove' stamp: 'jmv 9/21/2021 17:55:51' prior: 50337302 overrides: 50574235! + delete + + | w | + self restoreAll. + super delete. + w _ self world ifNil: [ self runningWorld ]. + w ifNotNil: [ w taskbarDeleted ]! ! +!TaskbarMorph methodsFor: 'submorphs-add/remove' stamp: 'jmv 9/21/2021 17:52:27' prior: 50594460 overrides: 16876712! + noteNewOwner: aMorph + "I have just been added as a submorph of aMorph" + + super noteNewOwner: aMorph. + aMorph submorphsDo: [ :subMorph | + self refreshTaskbarFor: aMorph ].! ! + +TaskbarMorph class removeSelector: #releaseClassCachedState! + +TaskbarMorph class removeSelector: #initClassCachedState! + +!methodRemoval: TaskbarMorph class #initClassCachedState stamp: 'Install-4872-Taskbar-fixesAndCleanup-JuanVuletich-2021Sep21-17h40m-jmv.001.cs.st 9/24/2021 10:40:19'! +initClassCachedState + + "Should use some other way to find relevant instances" + self flag: #jmvVer2. + self allInstancesDo: [ :each | + each notifyDisplayResize ]! + +TaskbarMorph removeSelector: #notifyDisplayResize! + +!methodRemoval: TaskbarMorph #notifyDisplayResize stamp: 'Install-4872-Taskbar-fixesAndCleanup-JuanVuletich-2021Sep21-17h40m-jmv.001.cs.st 9/24/2021 10:40:19'! +notifyDisplayResize + Display + when: #screenSizeChanged + send: #screenSizeChanged + to: self. + self screenSizeChanged! + +"Postscript: +Leave the line above, and replace the rest of this comment by a useful one. +Executable statements should follow this comment, and should +be separated by periods, with no exclamation points (!!). +Be sure to put any further comments in double-quotes, like this one." +TaskbarMorph allInstancesDo: [ :each | + Display removeActionsWithReceiver: each ].! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4872-Taskbar-fixesAndCleanup-JuanVuletich-2021Sep21-17h40m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4871] on 22 September 2021 at 9:35:25 am'! +!DisplayScreen methodsFor: 'other' stamp: 'jmv 4/1/2013 20:12' prior: 50608178! + forceToScreen: aRectangle + "Force the given rectangular section of the Display to be copied to the screen. The primitive call does nothing if the primitive is not implemented. Used when the deferUpdates flag in the virtual machine is on; see #deferUpdates:." + + self primShowRectLeft: aRectangle left + right: aRectangle right + top: aRectangle top + bottom: aRectangle bottom. +! ! +!DisplayScreen class methodsFor: 'screen update' stamp: 'jmv 9/22/2021 09:31:18' prior: 50571634! + screenUpdater + | delay | + delay _ Delay forMilliseconds: 50. + ScreenUpdaterSemaphore _ Semaphore new. + Damage _ nil. + [ + delay wait. + ScreenUpdaterSemaphore wait. + DisplayScreen isDisplayExtentOk ifTrue: [ + Display forceToScreen: Damage. + ScreenUpdaterSemaphore initSignals. + Damage _ nil ]. + ] repeat! ! + +"Postscript: +Leave the line above, and replace the rest of this comment by a useful one. +Executable statements should follow this comment, and should +be separated by periods, with no exclamation points (!!). +Be sure to put any further comments in double-quotes, like this one." + DisplayScreen installScreenUpdater! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4873-screenUpdater-fix-JuanVuletich-2021Sep22-09h31m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4871] on 22 September 2021 at 9:39:51 am'! +!DisplayScreen class methodsFor: 'snapshots' stamp: 'jmv 9/22/2021 09:37:38'! + setupDisplay + " + DisplayScreen setupDisplay. + Display forceToScreen. + " + + self terminateScreenUpdater. + Display setExtent: self actualScreenSize depth: Display nativeDepth. + Display beDisplay. + self installScreenUpdater.! ! +!DisplayScreen class methodsFor: 'snapshots' stamp: 'jmv 9/22/2021 09:37:45' prior: 50608218 overrides: 50335342! + startUp + " + DisplayScreen startUp. + Display forceToScreen. + " + self setupDisplay.! ! +!WorldMorph methodsFor: 'update cycle' stamp: 'jmv 9/22/2021 09:38:22' prior: 50608224! + checkForNewScreenSize + "Check whether the screen size has changed and if so take appropriate actions" + + DisplayScreen isDisplayExtentOk ifFalse: [ + "Minimize the risk of going out of memory: + - First clear existing canvas, to free the memory it uses. + - Then, setup the display. + - Then set up new canvas." + self clearCanvas. + DisplayScreen setupDisplay. + self setMainCanvas. + self whenUIinSafeState: [ Cursor defaultCursor activateCursor ]].! ! + +DisplayScreen class removeSelector: #setupDisplay:! + +!methodRemoval: DisplayScreen class #setupDisplay: stamp: 'Install-4874-setupDisplay-removeSuperfluousPedantry-JuanVuletich-2021Sep22-09h35m-jmv.001.cs.st 9/24/2021 10:40:19'! +setupDisplay: doGarbageCollection + " + DisplayScreen setupDisplay: true. + Display forceToScreen. + " + + self terminateScreenUpdater. + doGarbageCollection ifTrue: [ + Display setExtent: 0@0 depth: 0 bits: nil. + Smalltalk primitiveGarbageCollect. ]. + Display setExtent: self actualScreenSize depth: Display nativeDepth. + Display beDisplay. + self installScreenUpdater.! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4874-setupDisplay-removeSuperfluousPedantry-JuanVuletich-2021Sep22-09h35m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4874] on 22 September 2021 at 3:03:14 pm'! +!TaskbarMorph methodsFor: 'submorphs-add/remove' stamp: 'jmv 9/22/2021 15:02:43' prior: 50609691 overrides: 16876712! + noteNewOwner: aMorph + "I have just been added as a submorph of aMorph" + + super noteNewOwner: aMorph. + aMorph submorphsDo: [ :subMorph | + self refreshTaskbarFor: subMorph ].! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4875-Taskbar-fix-JuanVuletich-2021Sep22-15h02m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4875] on 22 September 2021 at 3:09:47 pm'! +!TaskbarMorph methodsFor: 'submorphs-add/remove' stamp: 'jmv 9/22/2021 15:09:15' prior: 50609850 overrides: 16876712! + noteNewOwner: aMorph + "I have just been added as a submorph of aMorph" + + super noteNewOwner: aMorph. + aMorph submorphsDo: [ :subMorph | + self refreshTaskbarFor: subMorph ]. + self screenSizeChanged.! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4876-Taskbar-fix-JuanVuletich-2021Sep22-15h09m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4876] on 22 September 2021 at 4:08:55 pm'! +!Theme methodsFor: 'colors' stamp: 'jmv 9/22/2021 16:08:06' prior: 50388773! + background + + "^ `Color r: 0.7 g: 0.72 b: 0.83`." + ^ `Color r: 0.167 g: 0.344 b: 0.629`! ! + +"Postscript: +Leave the line above, and replace the rest of this comment by a useful one. +Executable statements should follow this comment, and should +be separated by periods, with no exclamation points (!!). +Be sure to put any further comments in double-quotes, like this one." +self runningWorld color: Theme current background.! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4877-defaultBackgroundColor-JuanVuletich-2021Sep22-16h07m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4877] on 22 September 2021 at 4:22:12 pm'! +!MessageSetWindow class methodsFor: 'opening' stamp: 'jmv 9/22/2021 16:20:42'! + openMessageListUnsorted: methodReferences label: labelString + "Open a system view for a MessageSet on messageList. + Don't sort entries by default." + + | messageSet | + + messageSet _ MessageSet messageList: methodReferences asArray. + + ^self open: messageSet label: labelString ! ! +!ChangeListWindow methodsFor: 'menu commands' stamp: 'jmv 9/22/2021 16:20:50' prior: 16797146! + browseCurrentVersionsOfSelections + "Opens a message-list browser on the current in-memory versions of all methods that are currently seleted" + | aList | + + aList _ model currentVersionsOfSelections. + + aList size = 0 ifTrue: [^ self inform: 'no selected methods have in-memory counterparts']. + MessageSetWindow + openMessageListUnsorted: aList + label: 'Current versions of selected methods in ', model file localName! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4878-browseCurrentVersions-unsortedByDefault-JuanVuletich-2021Sep22-16h20m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4876] on 22 September 2021 at 9:15:23 pm'! + +ChangeSelector subclass: #AddParameter + instanceVariableNames: 'newParameter newParameterValue implementorTrailingString senderTrailingString index isAddingLast' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +!classDefinition: #AddParameter category: #'Tools-Refactoring' stamp: 'Install-4879-ExtractAsParameter-HernanWilkinson-2021Sep22-15h23m-HAW.001.cs.st 9/24/2021 10:40:20'! +ChangeSelector subclass: #AddParameter + instanceVariableNames: 'newParameter newParameterValue implementorTrailingString senderTrailingString index isAddingLast' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +Refactoring subclass: #ExtractAsParameter + instanceVariableNames: 'intervalToExtract sourceMethod addParameter intervalToReplace' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +!classDefinition: #ExtractAsParameter category: #'Tools-Refactoring' stamp: 'Install-4879-ExtractAsParameter-HernanWilkinson-2021Sep22-15h23m-HAW.001.cs.st 9/24/2021 10:40:20'! +Refactoring subclass: #ExtractAsParameter + instanceVariableNames: 'intervalToExtract sourceMethod addParameter intervalToReplace' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +AddParameterApplier subclass: #ExtractAsParameterApplier + instanceVariableNames: 'interval' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +!classDefinition: #ExtractAsParameterApplier category: #'Tools-Refactoring' stamp: 'Install-4879-ExtractAsParameter-HernanWilkinson-2021Sep22-15h23m-HAW.001.cs.st 9/24/2021 10:40:20'! +AddParameterApplier subclass: #ExtractAsParameterApplier + instanceVariableNames: 'interval' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! +!SmalltalkEditor methodsFor: 'contextual add/remove parameter' stamp: 'HAW 9/22/2021 20:24:46'! + contextualExtractAsParameter + + self isEditingClassDefinition + ifTrue: [ morph flash ] + ifFalse: [ self ifSourceCodeRefactoringCanBeAppliedDo: [ self extractAsParameter ]]! ! +!SmalltalkEditor methodsFor: 'contextual add/remove parameter' stamp: 'HAW 9/22/2021 16:36:12'! + contextualExtractAsParameter: aKeyboardEvent + + self contextualExtractAsParameter. + ^true! ! +!SmalltalkEditor methodsFor: 'contextual add/remove parameter' stamp: 'HAW 9/22/2021 20:24:56'! + extractAsParameter + + ^ RefactoringApplier extractAsParameterApplier createAndValueHandlingExceptions: [ + RefactoringApplier extractAsParameterApplier + from: self selectionInterval + on: model textProvider + for: self codeProvider selectedMessageName + in: self selectedClassOrMetaClassOrUndefinedObject ]! ! +!SmalltalkEditor methodsFor: 'contextual rename' stamp: 'HAW 9/22/2021 19:41:21'! + selectedClassOrMetaClassOrUndefinedObject + + "I have to do this because some codeProviders do not answer selectedClassOrMetaClass like the Workspace - Hernan" + + ^ [ self codeProvider selectedClassOrMetaClass ] + on: Error + do: [ :anError | anError return: UndefinedObject ]! ! +!ChangeSelector methodsFor: 'changes' stamp: 'HAW 9/22/2021 20:18:57'! + changes + + ^changes! ! +!AddParameter methodsFor: 'parameter' stamp: 'HAW 9/8/2021 22:37:02'! + newParameter + + ^newParameter! ! +!ExtractAsParameter methodsFor: 'applying' stamp: 'HAW 9/22/2021 20:19:25' overrides: 50438485! + apply + + self + applyAddParameter; + useNewParameter. + + ^addParameter changes + + ! ! +!ExtractAsParameter methodsFor: 'applying - private' stamp: 'HAW 9/22/2021 20:19:25'! + applyAddParameter + + ^ addParameter apply! ! +!ExtractAsParameter methodsFor: 'applying - private' stamp: 'HAW 9/22/2021 20:17:24'! + newSourceCode + + | intermediateSourceCode newInterval newSourceCode originalSourceCodeSize intermediateMethod | + + originalSourceCodeSize := sourceMethod sourceCode size. + intermediateMethod := sourceMethod methodClass >> self newSelector. + intermediateSourceCode := intermediateMethod sourceCode. + newInterval := intervalToReplace + (intermediateSourceCode size - originalSourceCodeSize). + newSourceCode := intermediateSourceCode copyReplaceFrom: newInterval first to: newInterval last with: addParameter newParameter. + + ^newSourceCode ! ! +!ExtractAsParameter methodsFor: 'applying - private' stamp: 'HAW 9/22/2021 20:17:33'! + useNewParameter + + sourceMethod methodClass compile: self newSourceCode. + + ! ! +!ExtractAsParameter methodsFor: 'initialization' stamp: 'HAW 9/21/2021 19:13:59'! + initializeExtractedFrom: anIntervalToExtract replacing: anIntervalToReplace at: aSourceMethod addingParameterWith: anAddParameter + + intervalToExtract := anIntervalToExtract. + intervalToReplace := anIntervalToReplace. + sourceMethod := aSourceMethod. + addParameter := anAddParameter.! ! +!ExtractAsParameter methodsFor: 'selectors' stamp: 'HAW 9/22/2021 19:56:45'! + newSelector + + ^addParameter newSelector ! ! +!ExtractAsParameter class methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 15:39:26'! + assert: aSourceMethod isInImplementors: implementorsCollection + + ^ (implementorsCollection includes: aSourceMethod) ifFalse: [ self signalOrigialMethodMustBeInImplementorsToChange ]! ! +!ExtractAsParameter class methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 20:07:25'! + assertAndCreateNamed: aNewParameter + extractedFrom: anInterval + at: aSourceMethod + implementors: implementorsCollection + senders: sendersCollection + creatingAddParameterWith: addParameterCreator + + | addParameter sourceCodeToExtract trimmedIntervalToReplace intervalToReplace intervals | + + self assert: aSourceMethod isInImplementors: implementorsCollection. + intervals := self assertCanExtractedFrom: anInterval for: aSourceMethod. + + intervalToReplace := intervals first. + trimmedIntervalToReplace := intervals second. + sourceCodeToExtract := aSourceMethod sourceCode copyFrom: trimmedIntervalToReplace first to: trimmedIntervalToReplace last. + + addParameter := addParameterCreator value: sourceCodeToExtract. + + ^self new + initializeExtractedFrom: trimmedIntervalToReplace + replacing: intervalToReplace + at: aSourceMethod + addingParameterWith: addParameter! ! +!ExtractAsParameter class methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 19:01:23'! + assertCanExtractedFrom: anInterval for: aSourceMethod + + | trimmedIntervalToReplace sourceCode node intervalToReplace | + + sourceCode := aSourceMethod sourceCode. + + ExtractMethodNewMethod assertIntervalToExtractIsNotEmpty: anInterval. + ExtractMethodNewMethod assert: anInterval isWithinBoundsOf: sourceCode. + + intervalToReplace := self removeDotsAt: anInterval in: sourceCode. + trimmedIntervalToReplace := intervalToReplace asSourceCodeInterval trimToMatchExpressionOn: sourceCode. + node := self nodeToExtractFrom: aSourceMethod at: trimmedIntervalToReplace or: intervalToReplace. + self assertIsValidToExtract: node. + + ^{ intervalToReplace. trimmedIntervalToReplace } + + ! ! +!ExtractAsParameter class methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 14:26:11'! + assertIsValidAssigmentToExtract: anAssignmentNode + + self assertIsValidToExtract: anAssignmentNode variable. + self assertIsValidToExtract: anAssignmentNode value ! ! +!ExtractAsParameter class methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 09:40:26'! + assertIsValidBlockNodeToExtract: aBlockNode + + aBlockNode block statementsDo: [ :aStatement | self assertIsValidToExtract: aStatement ]! ! +!ExtractAsParameter class methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 20:05:10'! + assertIsValidKeywordForNewParameter: aNewKeyword + + AddParameter assertIsValidKeywordForNewParameter: aNewKeyword! ! +!ExtractAsParameter class methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 15:09:49'! + assertIsValidLiteralNodeToExtract: aNode + + ^ (aNode isLiteralNode + or: [ aNode isTruePseudoVariable + or: [ aNode isFalsePseudoVariable + or: [ aNode isNilPseudoVariable ]]]) ifFalse: [ self signalInvalidExpressionToExtractAsParameter ]! ! +!ExtractAsParameter class methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 15:04:00'! + assertIsValidMessageNodeToExtract: aNode + + self assertIsValidToExtract: aNode receiver. + aNode arguments do: [ :anArgument | self assertIsValidToExtract: anArgument ]! ! +!ExtractAsParameter class methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 19:56:21'! + assertIsValidParameterName: aName + + AddParameter assertIsValidParameterName: aName ! ! +!ExtractAsParameter class methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 15:09:49'! + assertIsValidTempOrArgNodeToExtract: aTempVariableNode + + aTempVariableNode isDeclaredAtMethodLevel ifTrue: [ self signalInvalidExpressionToExtractAsParameter ]! ! +!ExtractAsParameter class methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 15:03:50'! + assertIsValidToExtract: aNode + + aNode isMessageNode ifTrue: [ ^self assertIsValidMessageNodeToExtract: aNode]. + aNode isBlockNode ifTrue: [ ^self assertIsValidBlockNodeToExtract: aNode ]. + aNode isTempOrArg ifTrue: [ ^self assertIsValidTempOrArgNodeToExtract: aNode ]. + aNode isAssignmentToTemporary ifTrue: [ ^self assertIsValidAssigmentToExtract: aNode ]. + self assertIsValidLiteralNodeToExtract: aNode! ! +!ExtractAsParameter class methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 09:28:16'! + is: aRange equalTo: sourceInterval or: intervalToReplace + + "When selecting literals like 1, the range first is one less than the initial character of the literal - Hernan" + + ^aRange = sourceInterval + or: [ aRange = intervalToReplace + or: [ aRange first + 1 = sourceInterval first and: [ aRange value last = sourceInterval last]]]! ! +!ExtractAsParameter class methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 15:45:11'! + nodeToExtractFrom: aSourceMethod at: trimmedIntervalToReplace or: intervalToReplace + + | nodeWithRangeToExtract nodesWithFirstPosition | + + nodesWithFirstPosition := aSourceMethod methodNode parseNodesPathAt: trimmedIntervalToReplace first ifAbsent: [ self signalInvalidSelection ]. + nodeWithRangeToExtract := nodesWithFirstPosition + detect: [ :nodeAndRange | self is: nodeAndRange value equalTo: trimmedIntervalToReplace or: intervalToReplace ] + ifNone: [ self signalInvalidSelection ]. + + ^nodeWithRangeToExtract key. + ! ! +!ExtractAsParameter class methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 15:42:21'! + removeDotsAt: anInterval in: sourceCode + + | lastToReplace | + + lastToReplace := anInterval last. + [(sourceCode at: lastToReplace) = $. ] whileTrue: [ lastToReplace := lastToReplace - 1]. + + ^anInterval first to: lastToReplace! ! +!ExtractAsParameter class methodsFor: 'instance creation' stamp: 'HAW 9/22/2021 15:55:37'! + named: aNewParameter + extractedFrom: anInterval + at: aSourceMethod + implementors: implementorsCollection + senders: sendersCollection + + ^self + assertAndCreateNamed: aNewParameter + extractedFrom: anInterval + at: aSourceMethod + implementors: implementorsCollection + senders: sendersCollection + creatingAddParameterWith: [ :sourceCodeToExtract | + AddParameter + named: aNewParameter + initializedWith: sourceCodeToExtract + toUnarySelector: aSourceMethod selector + implementors: implementorsCollection + senders: sendersCollection ]! ! +!ExtractAsParameter class methodsFor: 'instance creation' stamp: 'HAW 9/22/2021 15:56:38'! + named: aNewParameter + extractedFrom: anInterval + at: aNewKeywordIndex + newKeyword: newKeyword + at: aSourceMethod + implementors: implementorsCollection + senders: sendersCollection + + ^self + assertAndCreateNamed: aNewParameter + extractedFrom: anInterval + at: aSourceMethod + implementors: implementorsCollection + senders: sendersCollection + creatingAddParameterWith: [ :sourceCodeToExtract | + AddParameter + named: aNewParameter + at: aNewKeywordIndex + initializedWith: sourceCodeToExtract + using: newKeyword + toKeywordSelector: aSourceMethod selector + implementors: implementorsCollection + senders: sendersCollection ]! ! +!ExtractAsParameter class methodsFor: 'error messages' stamp: 'HAW 9/22/2021 15:10:01'! + errorMessageForInvalidExpressionToExtractAsParameter + + ^'Only literals, message sends to literals with literal parameters and +blocks with the previous conditions can be extracted as parameters'! ! +!ExtractAsParameter class methodsFor: 'error messages' stamp: 'HAW 9/21/2021 17:31:17'! + errorMessageForInvalidSelection + + ^'The selected source code is invalid for extraction as parameter'! ! +!ExtractAsParameter class methodsFor: 'error messages' stamp: 'HAW 9/22/2021 15:36:27'! + errorMessageForOrigialMethodMustBeInImplementorsToChange + + ^'Method with code to extract must be as implementor to change'! ! +!ExtractAsParameter class methodsFor: 'exceptions' stamp: 'HAW 9/22/2021 15:10:01'! + signalInvalidExpressionToExtractAsParameter + + self refactoringError: self errorMessageForInvalidExpressionToExtractAsParameter ! ! +!ExtractAsParameter class methodsFor: 'exceptions' stamp: 'HAW 9/21/2021 17:30:33'! + signalInvalidSelection + + self refactoringError: self errorMessageForInvalidSelection! ! +!ExtractAsParameter class methodsFor: 'exceptions' stamp: 'HAW 9/22/2021 15:37:55'! + signalOrigialMethodMustBeInImplementorsToChange + + self refactoringError: self errorMessageForOrigialMethodMustBeInImplementorsToChange! ! +!ExtractAsParameter class methodsFor: 'implementors and senders' stamp: 'HAW 9/22/2021 19:57:44'! + addImplementorsOf: anOldSelector to: implementors andSendersTo: senders forClassAndMetaOf: aPotentialClassToRefactor + + ^AddParameter addImplementorsOf: anOldSelector to: implementors andSendersTo: senders forClassAndMetaOf: aPotentialClassToRefactor! ! +!ExtractAsParameter class methodsFor: 'implementors and senders' stamp: 'HAW 9/22/2021 19:59:56'! + addImplementorsOf: anOldSelector to: implementors andSendersTo: senders inCategoriesAndHierarchyOf: aClass organizedBy: anOrganization + + ^AddParameter addImplementorsOf: anOldSelector to: implementors andSendersTo: senders inCategoriesAndHierarchyOf: aClass organizedBy: anOrganization! ! +!ExtractAsParameter class methodsFor: 'implementors and senders' stamp: 'HAW 9/22/2021 19:59:25'! + addImplementorsOf: anOldSelector to: implementors andSendersTo: senders inCategory: aCategory organizedBy: anOrganization + + ^AddParameter addImplementorsOf: anOldSelector to: implementors andSendersTo: senders inCategory: aCategory organizedBy: anOrganization! ! +!ExtractAsParameter class methodsFor: 'implementors and senders' stamp: 'HAW 9/22/2021 19:58:31'! + addImplementorsOf: anOldSelector to: implementors andSendersTo: senders inHierarchyOf: aClass + + ^AddParameter addImplementorsOf: anOldSelector to: implementors andSendersTo: senders inHierarchyOf: aClass +! ! +!ExtractAsParameter class methodsFor: 'implementors and senders' stamp: 'HAW 9/22/2021 20:00:22'! + addImplementorsOf: anOldSelector to: implementors andSendersTo: senders inSystem: aSystem + + ^AddParameter addImplementorsOf: anOldSelector to: implementors andSendersTo: senders inSystem: aSystem +! ! +!RefactoringApplier class methodsFor: 'appliers - registering' stamp: 'HAW 9/22/2021 18:38:54'! + registerExtractAsParameterApplier: anExtractAsParameterApplierClass + + self registerApplierAt: self extractAsParameterApplierId with: anExtractAsParameterApplierClass ! ! +!RefactoringApplier class methodsFor: 'appliers - getting' stamp: 'HAW 9/22/2021 16:35:35'! + extractAsParameterApplier + + ^self applierAt: self extractAsParameterApplierId ifAbsent: [ ExtractAsParameterApplier ]! ! +!RefactoringApplier class methodsFor: 'appliers - id' stamp: 'HAW 9/22/2021 16:35:22'! + extractAsParameterApplierId + + ^#extractAsParameterApplier! ! +!RefactoringApplier class methodsFor: 'appliers - resetting' stamp: 'HAW 9/22/2021 18:39:16'! + resetExtractAsParameterApplier + + self resetApplierAt: self extractAsParameterApplierId! ! +!ExtractAsParameterApplier methodsFor: 'refactoring - parameters request' stamp: 'HAW 9/22/2021 16:30:27' overrides: 50441865! + askNewParameterValue! ! +!ExtractAsParameterApplier methodsFor: 'refactoring - creation' stamp: 'HAW 9/22/2021 20:06:39' overrides: 50441788! + createRefactoringForKeywordSelector + + ^self refactoringClass + named: newParameter + extractedFrom: interval + at: parameterIndex + newKeyword: newKeyword + at: selectedClass >> oldSelector + implementors: implementors + senders: senders ! ! +!ExtractAsParameterApplier methodsFor: 'refactoring - creation' stamp: 'HAW 9/22/2021 19:36:15' overrides: 50441799! + createRefactoringForUnarySelector + + ^self refactoringClass + named: newParameter + extractedFrom: interval + at: selectedClass >> oldSelector + implementors: implementors + senders: senders ! ! +!ExtractAsParameterApplier methodsFor: 'refactoring - creation' stamp: 'HAW 9/22/2021 16:30:58' overrides: 50441809! + refactoringClass + + ^ExtractAsParameter ! ! +!ExtractAsParameterApplier methodsFor: 'initialization' stamp: 'HAW 9/22/2021 19:05:46'! + initializeInterval: anInterval + + interval := anInterval.! ! +!ExtractAsParameterApplier class methodsFor: 'instance creation' stamp: 'HAW 9/22/2021 19:03:29'! +from: anInterval on: aModel for: anOldSelector in: aClassToRefactor + + ExtractAsParameter assertCanExtractedFrom: anInterval for: aClassToRefactor >> anOldSelector. + + ^(super on: aModel for: anOldSelector in: aClassToRefactor) initializeInterval: anInterval ! ! +!SmalltalkEditor methodsFor: 'contextual rename' stamp: 'HAW 9/22/2021 19:41:05' prior: 50573357! + withMethodNodeAndClassDo: aBlock ifErrorsParsing: anErrorBlock + + | selectedClass methodNode | + + selectedClass := self selectedClassOrMetaClassOrUndefinedObject. + [ + [ methodNode := selectedClass methodNodeFor: model actualContents asString ] + on: UndeclaredVariableWarning do: [ :ex | ex resume ] + ] on: Error do: [ :anError | ^ anErrorBlock value: anError ]. + + ^aBlock value: methodNode value: selectedClass.! ! +!AddParameterApplier methodsFor: 'refactoring - parameters request' stamp: 'HAW 9/22/2021 16:27:52' prior: 50441865! + askNewParameterValue + + | enteredString | + + enteredString := self request: 'Enter parameter value for senders'. + newParameterValue := enteredString withBlanksTrimmed. + self refactoringClass assertNewParameterValueIsValid: newParameterValue. +! ! +!RefactoringMenues class methodsFor: 'editor menus' stamp: 'HAW 9/22/2021 16:41:33' prior: 50491929! + smalltalkEditorRefactoringMenuOptions + + ^`{ + { + #itemGroup -> 35. + #itemOrder -> 30. + #label -> 'Add Parameter... (A)'. + #selector -> #contextualAddParameter. + #icon -> #listAddIcon + } asDictionary. + { + #itemGroup -> 35. + #itemOrder -> 35. + #label -> 'Extract as Parameter... (1)'. + #selector -> #contextualExtractAsParameter. + #icon -> #listAddIcon + } asDictionary. + { + #itemGroup -> 35. + #itemOrder -> 40. + #label -> 'Remove Parameter... (S)'. + #selector -> #contextualRemoveParameter. + #icon -> #listRemoveIcon + } asDictionary. + { + #itemGroup -> 35. + #itemOrder -> 50. + #label -> 'Temporary to Instance Variable (O)'. + #selector -> #temporaryToInstanceVariable. + #icon -> #saveAsIcon + } asDictionary. + { + #itemGroup -> 35. + #itemOrder -> 60. + #label -> 'Push Up Instance Variable'. + #selector -> #contextualPushUpInClassDefinition. + #icon -> #goTopIcon + } asDictionary. + { + #itemGroup -> 35. + #itemOrder -> 70. + #label -> 'Push Down Instance Variable'. + #selector -> #contextualPushDownInClassDefinition. + #icon -> #goBottomIcon + } asDictionary. + }`! ! +!RefactoringMenues class methodsFor: 'shortcuts' stamp: 'HAW 9/22/2021 19:34:01' prior: 50507328! + smalltalkEditorCmdShortcutsSpec + + " + SmalltalkEditor initializeCmdShortcuts + " + ^#( + #($R #contextualRename: 'Renames what is under cursor') + #($A #contextualAddParameter: 'Adds parameter to message that is under cursor') + #($S #contextualRemoveParameter: 'Removes parameter to message that is under cursor') + #($O #temporaryToInstanceVariable: 'Extracts temporary variable to instance variable') + #($J #extractToTemporary: 'Extracts the selected code into a temporary variable') + #($K #extractMethod: 'Extracts the selected code into a separate method') + #($1 #contextualExtractAsParameter: 'Extracts the selected code as parameter') + )! ! +!SourceCodeOfMethodToBeExtractedPrecondition methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 14:33:51' prior: 50517379! + assertSourceCodeContainsAValidExpression + + (self intervalCoversCompleteAstNodes + and: [ self startAndEndNodesShareAParentNode + or: [ self intervalMatchesBeginningOfStatement + and: [ self intervalMatchesEndOfStatement ]]]) + ifFalse: [ self signalSourceCodeContainsAnInvalidExpressionError ]! ! +!SourceCodeOfMethodToBeExtractedPrecondition methodsFor: 'private' stamp: 'HAW 9/22/2021 14:55:22' prior: 50508772! + intervalMatchesEndOfStatement + + | closerStatementLastPosition | + + closerStatementLastPosition := (self findSourceRangeOfCloserStatementIn: finalNodeAncestors) last. + ^ closerStatementLastPosition = intervalToExtract last or: [ closerStatementLastPosition - 1 = intervalToExtract last ].! ! + +ExtractAsParameterApplier class removeSelector: #on:for:in:! + +ExtractAsParameter class removeSelector: #assertNamed:extractedFrom:at:implementors:senders:creatingAddParameterWith:! + +ExtractAsParameter class removeSelector: #assertNamed:extractedFrom:at:implementors:senders:! + +ExtractAsParameter removeSelector: #addParameter! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4879-ExtractAsParameter-HernanWilkinson-2021Sep22-15h23m-HAW.001.cs.st----! + +'From Cuis 5.0 [latest update: #4879] on 23 September 2021 at 10:21:47 am'! +!CodeProvider methodsFor: 'annotation' stamp: 'jmv 9/22/2021 18:29:08'! + annotationForSystemCategory: aCategory + "Provide a line of content for an annotation pane, given that the receiver is pointing at the class definition of the given class." + + | separator | + separator _ self annotationSeparator. + ^ String streamContents: [ :strm | + strm + nextPutAll: 'System Category'; + nextPutAll: aCategory; + nextPutAll: separator; + print: (SystemOrganization listAtCategoryNamed: aCategory) size; + nextPutAll: ' classes'; + nextPutAll: separator; + print: (SystemOrganization instanceMethodCountOf: aCategory); + nextPutAll: ' instance methods'; + nextPutAll: separator; + print: (SystemOrganization classMethodCountOf: aCategory); + nextPutAll: ' class methods'; + nextPutAll: separator; + print: (SystemOrganization linesOfCodeOf: aCategory); + nextPutAll: ' total lines of code' ]! ! +!SystemOrganizer methodsFor: 'source code management' stamp: 'jmv 9/23/2021 10:18:03'! + classMethodCountOf: category + + ^ (self superclassOrderIn: category) sum: [ :cl | cl class selectors size ] ifEmpty: 0.! ! +!SystemOrganizer methodsFor: 'source code management' stamp: 'jmv 9/23/2021 10:18:08'! + instanceMethodCountOf: category + + ^ (self superclassOrderIn: category) sum: [ :cl | cl selectors size ] ifEmpty: 0.! ! +!SystemOrganizer methodsFor: 'source code management' stamp: 'jmv 9/23/2021 10:16:49'! + linesOfCodeOf: category +" +SystemOrganization linesOfCodeOf: #'System-Files' +" + "An approximate measure of lines of. + Includes comments, but excludes blank lines." + + ^ (self superclassOrderIn: category) sum: [ :cl | cl linesOfCode ] ifEmpty: 0.! ! +!CodeProvider methodsFor: 'annotation' stamp: 'jmv 9/22/2021 18:45:23' prior: 50518432! + annotationForSelector: aSelector ofClass: aClass + "Provide a line of content for an annotation pane, representing + information about the given selector and class" + + | stamp sendersCount implementorsCount aCategory separator aString aList aComment stream requestList | + aSelector == #Comment + ifTrue: [^ self annotationForClassCommentFor: aClass]. + aSelector == #Definition + ifTrue: [^ self annotationForClassDefinitionFor: aClass]. + aSelector == #Hierarchy + ifTrue: [^ self annotationForHierarchyFor: aClass]. + stream _ WriteStream on: String new. + requestList _ self annotationRequests. + separator _ self annotationSeparator. + requestList + do: [:aRequest | + aRequest == #firstComment + ifTrue: [ + aComment _ aClass firstCommentAt: aSelector. + aComment isEmptyOrNil + ifFalse: [stream position = 0 ifFalse: [stream nextPutAll: separator]. + stream nextPutAll: aComment]]. + aRequest == #masterComment + ifTrue: [ + aComment _ aClass supermostPrecodeCommentFor: aSelector. + aComment isEmptyOrNil + ifFalse: [stream position = 0 ifFalse: [stream nextPutAll: separator]. + stream nextPutAll: aComment]]. + aRequest == #documentation + ifTrue: [ + aComment _ aClass precodeCommentOrInheritedCommentFor: aSelector. + aComment isEmptyOrNil + ifFalse: [stream isEmpty ifFalse: [stream nextPutAll: separator]. + stream nextPutAll: aComment]]. + aRequest == #timeStamp + ifTrue: [ + stamp _ self timeStamp. + stream isEmpty ifFalse: [stream nextPutAll: separator]. + stream nextPutAll: (stamp size > 0 ifTrue: [stamp] ifFalse: ['no timestamp'])]. + aRequest == #linesOfCode + ifTrue: [ + stream isEmpty ifFalse: [stream nextPutAll: separator]. + stream nextPutAll: ((aClass compiledMethodAt: aSelector ifAbsent: nil) + ifNotNil: [ :cm | cm linesOfCode]) printString, ' lines of code']. + aRequest == #messageCategory + ifTrue: [ + aCategory _ aClass organization categoryOfElement: aSelector. + aCategory + ifNotNil: ["woud be nil for a method no longer present, + e.g. in a recent-submissions browser" + stream isEmpty ifFalse: [stream nextPutAll: separator]. + stream nextPutAll: aCategory]]. + aRequest == #sendersCount + ifTrue: [ + sendersCount _ Smalltalk numberOfSendersOf: aSelector. + sendersCount _ sendersCount = 1 + ifTrue: ['1 sender'] + ifFalse: [sendersCount printString , ' senders']. + stream isEmpty ifFalse: [stream nextPutAll: separator]. + stream nextPutAll: sendersCount]. + aRequest == #implementorsCount + ifTrue: [ + implementorsCount _ Smalltalk numberOfImplementorsOf: aSelector. + implementorsCount _ implementorsCount = 1 + ifTrue: ['1 implementor'] + ifFalse: [implementorsCount printString , ' implementors']. + stream isEmpty ifFalse: [stream nextPutAll: separator]. + stream nextPutAll: implementorsCount]. + aRequest == #priorVersionsCount + ifTrue: [ + stream isEmpty ifFalse: [stream nextPutAll: separator]. + self + addPriorVersionsCountForSelector: aSelector + ofClass: aClass + to: stream]. + aRequest == #priorTimeStamp + ifTrue: [ + stamp _ VersionsBrowser + timeStampFor: aSelector + class: aClass + reverseOrdinal: 2. + stamp + ifNotNil: [stream isEmpty ifFalse: [stream nextPutAll: separator]. + stream nextPutAll: 'prior timestamp: ' , stamp]]. + aRequest == #packages + ifTrue: [ + (aClass compiledMethodAt: aSelector ifAbsent: nil) ifNotNil: [ :cm | + stream isEmpty ifFalse: [stream nextPutAll: separator]. + (CodePackage packageOfMethod: cm methodReference ifNone: nil) + ifNil: [ stream nextPutAll: 'in no package' ] + ifNotNil: [ :codePackage | + stream nextPutAll: 'in package '; nextPutAll: codePackage packageName ]]]. + aRequest == #changeSets + ifTrue: [ + stream isEmpty ifFalse: [stream nextPutAll: separator]. + aList _ ChangeSet allChangeSetsWithClass: aClass selector: aSelector. + aList size > 0 + ifTrue: [aList size = 1 + ifTrue: [stream nextPutAll: 'only in change set'] + ifFalse: [stream nextPutAll: 'in change sets:']. + aList + do: [:aChangeSet | stream nextPut: Character space; nextPutAll: aChangeSet name ] + separatedBy: [ stream nextPut: $, ]] + ifFalse: [stream nextPutAll: 'in no change set']]. + aRequest == #allChangeSets + ifTrue: [ + stream isEmpty ifFalse: [stream nextPutAll: separator]. + aList _ ChangeSet allChangeSetsWithClass: aClass selector: aSelector. + aList size > 0 + ifTrue: [aList size = 1 + ifTrue: [stream nextPutAll: 'only in change set'] + ifFalse: [stream nextPutAll: 'in change sets:']. + aList + do: [:aChangeSet | stream nextPut: Character space; nextPutAll: aChangeSet name ] + separatedBy: [ stream nextPut: $, ]] + ifFalse: [stream nextPutAll: 'in no change set']]. + aRequest == #allBaseSystemChangeSets + ifTrue: [ + stream isEmpty ifFalse: [stream nextPutAll: separator]. + aList _ (ChangeSet allChangeSetsWithClass: aClass selector: aSelector) select: [ :it | it isForBaseSystem ]. + aList size > 0 + ifTrue: [ + aList size = 1 + ifTrue: [stream nextPutAll: 'only in base system change set'] + ifFalse: [stream nextPutAll: 'in base system change sets:']. + aList + do: [:aChangeSet | stream nextPut: Character space; nextPutAll: aChangeSet name ] + separatedBy: [ stream nextPut: $, ]] + ifFalse: [stream nextPutAll: 'in no base system change set']]. + aRequest == #closuresInfo + ifTrue: [ + aString _ aClass closuresInfoAt: aSelector. + aString size > 0 + ifTrue: [stream isEmpty ifFalse: [stream nextPutAll: separator]. + stream nextPutAll: aString]]. + ]. + ^ stream contents! ! +!Browser methodsFor: 'annotation' stamp: 'jmv 9/23/2021 10:08:33' prior: 50485529 overrides: 50455411! + annotation + "Provide a line of content for an annotation pane, representing information about the method associated with the selected class and selector in the receiver." + + | aSelector aClass | + (aClass _ self selectedClassOrMetaClass) + ifNil: [ + self selectedSystemCategoryName ifNotNil: [ :sysCat | + ^self annotationForSystemCategory: sysCat ]. + ^ '']. + self editSelection == #editComment + ifTrue: [^ self annotationForSelector: #Comment ofClass: aClass]. + self isEditingExistingClass + ifTrue: [^ self annotationForSelector: #Definition ofClass: aClass]. + (aSelector _ self selectedMessageName) + ifNil: [^ '']. + ^ self annotationForSelector: aSelector ofClass: aClass! ! +!ClassDescription methodsFor: 'source code management' stamp: 'jmv 9/23/2021 10:05:44' prior: 16807069! + linesOfCode +" +Object linesOfCode +" + "An approximate measure of lines of. + Includes comments, but excludes blank lines. + If asked to a class, also include its metaclass (i.e. the class side). + If asked to a metaclass (the class side), don't include the class (the instance side)." + + | lines | + lines _ 0. + self selectorsDo: [ :sel | + lines _ lines + (self compiledMethodAt: sel) linesOfCode ]. + ^self isMeta + ifTrue: [ lines] + ifFalse: [ lines + self class linesOfCode]. +" +(SystemOrganization categories select: [:c | 'Kernel*' match: c]) sum: [:c | + (SystemOrganization superclassOrderIn: c) sum: [:cl | cl linesOfCode]] +" +" +Smalltalk allClasses sum: [:cl | cl linesOfCode] +"! ! +!CompiledMethod methodsFor: 'source code management' stamp: 'jmv 9/23/2021 10:03:40' prior: 16820495! + linesOfCode + "An approximate measure of lines of code. + Use decompiled source code. In this way, the measure: + - Doesn't include comments + - Doesn't include blank lines + - Is not sensitive to code formatting + The motivation is to consider LOC as an expense, not an asset. Minimizing LOC is good. + But it is not like that for comments!!" + + | lines | + lines _ 0. + self decompileString lineIndicesDo: [ :start :endWithoutDelimiters :end | + endWithoutDelimiters - start > 0 ifTrue: [ + lines _ lines+1 ]]. + ^lines! ! +!Preferences class methodsFor: 'parameters' stamp: 'jmv 9/22/2021 18:41:13' prior: 16893315! +annotationInfo + "Answer a list of pairs characterizing all the available kinds of annotations; in each pair, the first element is a symbol representing the info type, and the second element is a string providing the corresponding balloon help" + + ^ #( + (timeStamp 'The time stamp of the last submission of the method.') + (firstComment 'The first comment in the method, if any.') + (masterComment 'The comment at the beginning of the supermost implementor of the method if any.') + (documentation 'Comment at beginning of the method or, if it has none, comment at the beginning of a superclass''s implementation of the method.') + (messageCategory 'Which method category the method lies in.') + (sendersCount 'A report of how many senders there of the message.') + (implementorsCount 'A report of how many implementors there are of the message.') + (allChangeSets 'A list of all change sets bearing the method.') + (priorVersionsCount 'A report of how many previous versions there are of the method.') + (priorTimeStamp 'The time stamp of the penultimate submission of the method, if any.') + (closuresInfo 'Details about BlockClosures in the method.') + (packages 'Details about CodePackages including the method.') + (linesOfCode 'Number of lines of code, including comments but not blank lines.') + )! ! +!CodePackage methodsFor: 'source code management' stamp: 'jmv 9/23/2021 10:27:42' prior: 16810500! + linesOfCode + "An approximate measure of lines of code. + Does not includes comments, or excludes blank lines. + See comment at CompiledMethod >> #linesOfCode" + + ^self methods inject: 0 into: [ :sum :each | + sum + each compiledMethod linesOfCode ].! ! +!Preferences class methodsFor: 'parameters' stamp: 'jmv 9/22/2021 18:42:21' prior: 50419247! + setDefaultAnnotationInfo + " + Preferences setDefaultAnnotationInfo + " + ^ self parameters at: #MethodAnnotations put: #(timeStamp linesOfCode messageCategory implementorsCount sendersCount packages changeSets)! ! + +"Postscript: +Leave the line above, and replace the rest of this comment by a useful one. +Executable statements should follow this comment, and should +be separated by periods, with no exclamation points (!!). +Be sure to put any further comments in double-quotes, like this one." + Preferences setDefaultAnnotationInfo! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4880-LinesOfCode-Enhancements-JuanVuletich-2021Sep23-09h57m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4880] on 23 September 2021 at 11:31:18 am'! +!Preferences class methodsFor: 'parameters' stamp: 'jmv 9/23/2021 11:30:01'! + setCheapAnnotationInfo + " + Preferences setCheapAnnotationInfo + " + ^ self parameters at: #MethodAnnotations put: #(timeStamp messageCategory packages changeSets)! ! +!Preferences class methodsFor: 'themes' stamp: 'jmv 9/23/2021 11:30:57' prior: 50601569! + slowMachine + " + Preferences slowMachine + " + self setPreferencesFrom: #( + #(#drawKeyboardFocusIndicator false ) + (balloonHelpEnabled false) + (browseWithPrettyPrint false) + (caseSensitiveFinds true) + (checkForSlips false) + (cmdDotEnabled true) + (diffsInChangeList true) + (diffsWithPrettyPrint false) + (menuKeyboardControl false) + (optionalButtons false) + (subPixelRenderFonts true) + (thoroughSenders true) + (cheapWindowReframe true) + (syntaxHighlightingAsYouType false) + (tapAndHoldEmulatesButton2 false) + (clickGrabsMorphs true) + ). + self useNoMenuIcons. + self runningWorld backgroundImageData: nil. + Preferences setCheapAnnotationInfo. + " + Smalltalk at: #ClassicTheme ifPresent: [ :cls | cls beCurrent ]. + Taskbar hideTaskbar + "! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4881-Preferences-slowMachine-tweaks-JuanVuletich-2021Sep23-11h29m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4881] on 23 September 2021 at 4:06:09 pm'! +!PluggableButtonMorph methodsFor: 'accessing' stamp: 'KenD 9/17/2021 16:05:19' prior: 50578405! + iconName + + ^ self valueOfProperty: #iconName! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4882-iconName-fix-KenDickey-2021Sep23-16h05m-KenD.001.cs.st----! + +'From Cuis 5.0 [latest update: #4882] on 24 September 2021 at 10:19:33 am'! +!FontFamily class methodsFor: 'accessing fonts' stamp: 'jmv 9/24/2021 10:03:42'! + enableTrueTypeFontsOnly + + AvailableFamilies _ AvailableFamilies select: [ :f | f isTrueTypeFontFamily ].! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4883-EnableOnlyTrueTypeFonts-JuanVuletich-2021Sep24-10h19m-jmv.001.cs.st----! + +----QUIT----(24 September 2021 10:40:26) Cuis5.0-4883-v3.image priorSource: 8890635! \ No newline at end of file diff --git a/Cuis5.0-4871-v3.image b/Cuis5.0-4883-v3.image similarity index 67% rename from Cuis5.0-4871-v3.image rename to Cuis5.0-4883-v3.image index a024dcea..e3f15386 100644 Binary files a/Cuis5.0-4871-v3.image and b/Cuis5.0-4883-v3.image differ diff --git a/Cuis5.0-4871.changes b/Cuis5.0-4883.changes similarity index 99% rename from Cuis5.0-4871.changes rename to Cuis5.0-4883.changes index 3f080e75..f78d4882 100644 --- a/Cuis5.0-4871.changes +++ b/Cuis5.0-4883.changes @@ -346828,4 +346828,1178 @@ isCloserThan: aNumber toPoint: aPoint ----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4871-imageFormdepth-KernelMorph-JuanVuletich-2021Sep21-10h46m-jmv.001.cs.st----! -----QUIT----(21 September 2021 12:53:41) Cuis5.0-4871.image priorSource: 14294643! \ No newline at end of file +----QUIT----(21 September 2021 12:53:41) Cuis5.0-4871.image priorSource: 14294643! + +----STARTUP---- (24 September 2021 10:39:13) as C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\Cuis5.0-4871.image! + + +'From Cuis 5.0 [latest update: #4862] on 21 September 2021 at 5:57:37 pm'! +!WorldMorph methodsFor: 'geometry' stamp: 'jmv 9/21/2021 17:50:48' overrides: 50729849! + extentChanged: oldExtent + "Our extent changed. Must layout submorphs again." + + super extentChanged: oldExtent. + taskbar ifNotNil: [ taskbar screenSizeChanged ].! ! +!SystemDictionary methodsFor: 'snapshot and quit' stamp: 'jmv 9/21/2021 17:53:08' prior: 50777164! + snapshot: save andQuit: quit embedded: embeddedFlag clearAllClassState: clearAllStateFlag + "This is the main method for image save and / or quit. + See senders." + "WARNING: Current process will be killed. UI Process will be restarted" + "Mark the changes file and close all files as part of #processShutdownList. + If save is true, save the current state of this Smalltalk in the image file. + If quit is true, then exit to the outer OS shell. + The latter part of this method runs when resuming a previously saved image. This resume logic + checks for a document file to process when starting up." + " + To test the full cleanup and startup procedures, evaluate: + Smalltalk snapshot: false andQuit: false embedded: false clearAllClassState: true + + To test the cleanup done when saving the image, evaluate: + Smalltalk snapshot: false andQuit: false embedded: false clearAllClassState: false + " + | activeProc | + activeProc _ Processor activeProcess. + [ | isARealStartup guiRootObject guiRootObjectClass | + save not & quit + ifTrue: [ + (SourceFiles at: 2) ifNotNil: [ :changes | + ChangesInitialFileSize ifNotNil: [ changes truncate: ChangesInitialFileSize ]]] + ifFalse: [ + self + logSnapshot: save + andQuit: quit ]. + clearAllStateFlag ifTrue: [ + TranscriptWindow allInstancesDo: [ :each | + each isInWorld ifTrue: [ + each delete.]]. + UISupervisor ui tearDownDesktop. + Transcript logToFile: false ]. + ActiveModel flushEventSystem. + self processShutDownList: quit. + "Lo que sigue aca podria ir al shutdown de alguien... (se levantan en startup!!)" + Smalltalk stopLowSpaceWatcher. + WeakArray stopFinalizationProcess. + ProcessorScheduler stopBackgroundProcess. + "Cosas que levanto explicitamente abajo" + guiRootObjectClass _ UISupervisor ui class. + guiRootObject _ UISupervisor ui. + "Replace with this to create a new world at startup after 'saveAsNewVersion'" + "guiRootObject _ clearAllStateFlag ifFalse: [ UISupervisor ui ]." + UISupervisor stopUIProcess. + activeProc isTerminated ifFalse: [ activeProc terminate ]. + guiRootObject ifNotNil: [ guiRootObject releaseCachedState ]. + "Clean Globals" + Smalltalk + at: #Sensor + put: nil. + Smalltalk + at: #Display + put: nil. + Smalltalk closeSourceFiles. + Smalltalk + at: #SourceFiles + put: nil. + Smalltalk allClassesDo: [ :cls | + cls releaseClassCachedState ]. + clearAllStateFlag ifTrue: [ + Smalltalk allClassesDo: [ :cls | + cls releaseClassState ]]. + "Ojo con los pool dicts. Creo que no hay ninguno..." + "To keep cleaning stuff that shouldn't be saved..." + clearAllStateFlag ifTrue: [ + Smalltalk printStuffToCleanOnImageSave. + "Remove this call to actually see the image clean report." + Transcript clear. + ]. + "Do image save & quit as apropriate" + (Cursor cursorAt: #writeCursor) activateCursor. + save + ifTrue: [ + "The snapshot primitive answers false if it was just called to do the snapshot. + But image startup is resumed by returning (again) from the primitive, but this time answering true." + isARealStartup _ embeddedFlag + ifTrue: [ self snapshotEmbeddedPrimitive ] + ifFalse: [ self snapshotPrimitive ]] + ifFalse: [ isARealStartup _ false ]. + quit & (isARealStartup == false) ifTrue: [ self quitPrimitive ]. + "If starting from absolute scratch, this would be a good time to recreate Global names" + Smalltalk + at: #Sensor + put: nil. + Smalltalk + at: #Display + put: DisplayScreen new. + Smalltalk + at: #SourceFiles + put: (Array new: 2). + Smalltalk openSourceFiles. + "Here, startup begins!! (isARealStartup might be nil)" + Smalltalk allClassesDo: [ :cls | + cls initClassCachedState ]. + self doStartUp: isARealStartup == true. + UISupervisor spawnNewMorphicProcessFor: (guiRootObject ifNil: [ guiRootObject _ guiRootObjectClass newWorld ]). + self restoreLostChangesIfNecessary. + clearAllStateFlag ifTrue: [ + UISupervisor whenUIinSafeState: [ + guiRootObject recreateDefaultDesktop; restoreDisplay ]] + ifFalse: [ + UISupervisor whenUIinSafeState: [ + guiRootObject restoreDisplay ]]. + "If system is coming up (VM and image just started)" + isARealStartup == true ifTrue: [ + UISupervisor whenUIinSafeState: [ + self processCommandLineArguments. + AppLauncher launchApp ]]. + "Now it's time to raise an error" + isARealStartup ifNil: [ self error: 'Failed to write image file (disk full?)' ]] + forkAt: Processor timingPriority - 1 + named: 'Startup process'.! ! +!DisplayScreen methodsFor: 'private' stamp: 'jmv 9/21/2021 17:53:28' prior: 50777852 overrides: 16848801! + setExtent: aPoint depth: bitsPerPixel + "DisplayScreen startUp" + "This method is critical. If the setExtent fails, there will be no + proper display on which to show the error condition." + + | bitsPerPixelToUse | + (depth = bitsPerPixel and: [aPoint = self extent and: [ + self supportsDisplayDepth: bitsPerPixel]]) ifFalse: [ + bits _ nil. "Free up old bitmap in case space is low" + bitsPerPixelToUse _ (self supportsDisplayDepth: bitsPerPixel) + ifTrue: [ bitsPerPixel ] + ifFalse: [ + (self supportsDisplayDepth: bitsPerPixel negated) + ifTrue: [ bitsPerPixel negated ] + ifFalse: [ self findAnyDisplayDepth ]]. + super setExtent: aPoint depth: bitsPerPixelToUse. + ].! ! +!TaskbarMorph methodsFor: 'events' stamp: 'jmv 9/21/2021 17:50:39' prior: 50555096! + screenSizeChanged + "Respond to change in screen size by repositioning self to bottom of screen" + +" Transcript newLine; print: 'Taskbar screenSizeChanged'. +" + | y e | + self world ifNotNil: [ :w | + y _ w morphExtent y - self defaultHeight. + e _ (self internalizeDistance: w morphExtent x @ self defaultHeight) asIntegerPoint. + self morphPosition: 0@y extent: e ].! ! +!TaskbarMorph methodsFor: 'submorphs-add/remove' stamp: 'jmv 9/21/2021 17:55:51' prior: 50337313 overrides: 50747641! + delete + + | w | + self restoreAll. + super delete. + w _ self world ifNil: [ self runningWorld ]. + w ifNotNil: [ w taskbarDeleted ]! ! +!TaskbarMorph methodsFor: 'submorphs-add/remove' stamp: 'jmv 9/21/2021 17:52:27' prior: 50767866 overrides: 16876712! + noteNewOwner: aMorph + "I have just been added as a submorph of aMorph" + + super noteNewOwner: aMorph. + aMorph submorphsDo: [ :subMorph | + self refreshTaskbarFor: aMorph ].! ! + +TaskbarMorph class removeSelector: #releaseClassCachedState! + +TaskbarMorph class removeSelector: #initClassCachedState! + +!methodRemoval: TaskbarMorph class #initClassCachedState stamp: 'Install-4872-Taskbar-fixesAndCleanup-JuanVuletich-2021Sep21-17h40m-jmv.001.cs.st 9/24/2021 10:39:17'! +initClassCachedState + + "Should use some other way to find relevant instances" + self flag: #jmvVer2. + self allInstancesDo: [ :each | + each notifyDisplayResize ]! + +TaskbarMorph removeSelector: #notifyDisplayResize! + +!methodRemoval: TaskbarMorph #notifyDisplayResize stamp: 'Install-4872-Taskbar-fixesAndCleanup-JuanVuletich-2021Sep21-17h40m-jmv.001.cs.st 9/24/2021 10:39:17'! +notifyDisplayResize + Display + when: #screenSizeChanged + send: #screenSizeChanged + to: self. + self screenSizeChanged! + +"Postscript: +Leave the line above, and replace the rest of this comment by a useful one. +Executable statements should follow this comment, and should +be separated by periods, with no exclamation points (!!). +Be sure to put any further comments in double-quotes, like this one." +TaskbarMorph allInstancesDo: [ :each | + Display removeActionsWithReceiver: each ].! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4872-Taskbar-fixesAndCleanup-JuanVuletich-2021Sep21-17h40m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4871] on 22 September 2021 at 9:35:25 am'! +!DisplayScreen methodsFor: 'other' stamp: 'jmv 4/1/2013 20:12' prior: 50781584! + forceToScreen: aRectangle + "Force the given rectangular section of the Display to be copied to the screen. The primitive call does nothing if the primitive is not implemented. Used when the deferUpdates flag in the virtual machine is on; see #deferUpdates:." + + self primShowRectLeft: aRectangle left + right: aRectangle right + top: aRectangle top + bottom: aRectangle bottom. +! ! +!DisplayScreen class methodsFor: 'screen update' stamp: 'jmv 9/22/2021 09:31:18' prior: 50745040! + screenUpdater + | delay | + delay _ Delay forMilliseconds: 50. + ScreenUpdaterSemaphore _ Semaphore new. + Damage _ nil. + [ + delay wait. + ScreenUpdaterSemaphore wait. + DisplayScreen isDisplayExtentOk ifTrue: [ + Display forceToScreen: Damage. + ScreenUpdaterSemaphore initSignals. + Damage _ nil ]. + ] repeat! ! + +"Postscript: +Leave the line above, and replace the rest of this comment by a useful one. +Executable statements should follow this comment, and should +be separated by periods, with no exclamation points (!!). +Be sure to put any further comments in double-quotes, like this one." + DisplayScreen installScreenUpdater! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4873-screenUpdater-fix-JuanVuletich-2021Sep22-09h31m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4871] on 22 September 2021 at 9:39:51 am'! +!DisplayScreen class methodsFor: 'snapshots' stamp: 'jmv 9/22/2021 09:37:38'! + setupDisplay + " + DisplayScreen setupDisplay. + Display forceToScreen. + " + + self terminateScreenUpdater. + Display setExtent: self actualScreenSize depth: Display nativeDepth. + Display beDisplay. + self installScreenUpdater.! ! +!DisplayScreen class methodsFor: 'snapshots' stamp: 'jmv 9/22/2021 09:37:45' prior: 50781624 overrides: 50335353! + startUp + " + DisplayScreen startUp. + Display forceToScreen. + " + self setupDisplay.! ! +!WorldMorph methodsFor: 'update cycle' stamp: 'jmv 9/22/2021 09:38:22' prior: 50781630! + checkForNewScreenSize + "Check whether the screen size has changed and if so take appropriate actions" + + DisplayScreen isDisplayExtentOk ifFalse: [ + "Minimize the risk of going out of memory: + - First clear existing canvas, to free the memory it uses. + - Then, setup the display. + - Then set up new canvas." + self clearCanvas. + DisplayScreen setupDisplay. + self setMainCanvas. + self whenUIinSafeState: [ Cursor defaultCursor activateCursor ]].! ! + +DisplayScreen class removeSelector: #setupDisplay:! + +!methodRemoval: DisplayScreen class #setupDisplay: stamp: 'Install-4874-setupDisplay-removeSuperfluousPedantry-JuanVuletich-2021Sep22-09h35m-jmv.001.cs.st 9/24/2021 10:39:17'! +setupDisplay: doGarbageCollection + " + DisplayScreen setupDisplay: true. + Display forceToScreen. + " + + self terminateScreenUpdater. + doGarbageCollection ifTrue: [ + Display setExtent: 0@0 depth: 0 bits: nil. + Smalltalk primitiveGarbageCollect. ]. + Display setExtent: self actualScreenSize depth: Display nativeDepth. + Display beDisplay. + self installScreenUpdater.! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4874-setupDisplay-removeSuperfluousPedantry-JuanVuletich-2021Sep22-09h35m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4874] on 22 September 2021 at 3:03:14 pm'! +!TaskbarMorph methodsFor: 'submorphs-add/remove' stamp: 'jmv 9/22/2021 15:02:43' prior: 50783097 overrides: 16876712! + noteNewOwner: aMorph + "I have just been added as a submorph of aMorph" + + super noteNewOwner: aMorph. + aMorph submorphsDo: [ :subMorph | + self refreshTaskbarFor: subMorph ].! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4875-Taskbar-fix-JuanVuletich-2021Sep22-15h02m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4875] on 22 September 2021 at 3:09:47 pm'! +!TaskbarMorph methodsFor: 'submorphs-add/remove' stamp: 'jmv 9/22/2021 15:09:15' prior: 50783256 overrides: 16876712! + noteNewOwner: aMorph + "I have just been added as a submorph of aMorph" + + super noteNewOwner: aMorph. + aMorph submorphsDo: [ :subMorph | + self refreshTaskbarFor: subMorph ]. + self screenSizeChanged.! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4876-Taskbar-fix-JuanVuletich-2021Sep22-15h09m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4876] on 22 September 2021 at 4:08:55 pm'! +!Theme methodsFor: 'colors' stamp: 'jmv 9/22/2021 16:08:06' prior: 50563982! + background + + "^ `Color r: 0.7 g: 0.72 b: 0.83`." + ^ `Color r: 0.167 g: 0.344 b: 0.629`! ! + +"Postscript: +Leave the line above, and replace the rest of this comment by a useful one. +Executable statements should follow this comment, and should +be separated by periods, with no exclamation points (!!). +Be sure to put any further comments in double-quotes, like this one." +self runningWorld color: Theme current background.! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4877-defaultBackgroundColor-JuanVuletich-2021Sep22-16h07m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4877] on 22 September 2021 at 4:22:12 pm'! +!MessageSetWindow class methodsFor: 'opening' stamp: 'jmv 9/22/2021 16:20:42'! + openMessageListUnsorted: methodReferences label: labelString + "Open a system view for a MessageSet on messageList. + Don't sort entries by default." + + | messageSet | + + messageSet _ MessageSet messageList: methodReferences asArray. + + ^self open: messageSet label: labelString ! ! +!ChangeListWindow methodsFor: 'menu commands' stamp: 'jmv 9/22/2021 16:20:50' prior: 16797146! + browseCurrentVersionsOfSelections + "Opens a message-list browser on the current in-memory versions of all methods that are currently seleted" + | aList | + + aList _ model currentVersionsOfSelections. + + aList size = 0 ifTrue: [^ self inform: 'no selected methods have in-memory counterparts']. + MessageSetWindow + openMessageListUnsorted: aList + label: 'Current versions of selected methods in ', model file localName! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4878-browseCurrentVersions-unsortedByDefault-JuanVuletich-2021Sep22-16h20m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4876] on 22 September 2021 at 9:15:23 pm'! + +ChangeSelector subclass: #AddParameter + instanceVariableNames: 'newParameter newParameterValue implementorTrailingString senderTrailingString index isAddingLast' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +!classDefinition: #AddParameter category: #'Tools-Refactoring' stamp: 'Install-4879-ExtractAsParameter-HernanWilkinson-2021Sep22-15h23m-HAW.001.cs.st 9/24/2021 10:39:17'! +ChangeSelector subclass: #AddParameter + instanceVariableNames: 'newParameter newParameterValue implementorTrailingString senderTrailingString index isAddingLast' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +Refactoring subclass: #ExtractAsParameter + instanceVariableNames: 'intervalToExtract sourceMethod addParameter intervalToReplace' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +!classDefinition: #ExtractAsParameter category: #'Tools-Refactoring' stamp: 'Install-4879-ExtractAsParameter-HernanWilkinson-2021Sep22-15h23m-HAW.001.cs.st 9/24/2021 10:39:17'! +Refactoring subclass: #ExtractAsParameter + instanceVariableNames: 'intervalToExtract sourceMethod addParameter intervalToReplace' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +AddParameterApplier subclass: #ExtractAsParameterApplier + instanceVariableNames: 'interval' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +!classDefinition: #ExtractAsParameterApplier category: #'Tools-Refactoring' stamp: 'Install-4879-ExtractAsParameter-HernanWilkinson-2021Sep22-15h23m-HAW.001.cs.st 9/24/2021 10:39:17'! +AddParameterApplier subclass: #ExtractAsParameterApplier + instanceVariableNames: 'interval' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! +!SmalltalkEditor methodsFor: 'contextual add/remove parameter' stamp: 'HAW 9/22/2021 20:24:46'! + contextualExtractAsParameter + + self isEditingClassDefinition + ifTrue: [ morph flash ] + ifFalse: [ self ifSourceCodeRefactoringCanBeAppliedDo: [ self extractAsParameter ]]! ! +!SmalltalkEditor methodsFor: 'contextual add/remove parameter' stamp: 'HAW 9/22/2021 16:36:12'! + contextualExtractAsParameter: aKeyboardEvent + + self contextualExtractAsParameter. + ^true! ! +!SmalltalkEditor methodsFor: 'contextual add/remove parameter' stamp: 'HAW 9/22/2021 20:24:56'! + extractAsParameter + + ^ RefactoringApplier extractAsParameterApplier createAndValueHandlingExceptions: [ + RefactoringApplier extractAsParameterApplier + from: self selectionInterval + on: model textProvider + for: self codeProvider selectedMessageName + in: self selectedClassOrMetaClassOrUndefinedObject ]! ! +!SmalltalkEditor methodsFor: 'contextual rename' stamp: 'HAW 9/22/2021 19:41:21'! + selectedClassOrMetaClassOrUndefinedObject + + "I have to do this because some codeProviders do not answer selectedClassOrMetaClass like the Workspace - Hernan" + + ^ [ self codeProvider selectedClassOrMetaClass ] + on: Error + do: [ :anError | anError return: UndefinedObject ]! ! +!ChangeSelector methodsFor: 'changes' stamp: 'HAW 9/22/2021 20:18:57'! + changes + + ^changes! ! +!AddParameter methodsFor: 'parameter' stamp: 'HAW 9/8/2021 22:37:02'! + newParameter + + ^newParameter! ! +!ExtractAsParameter methodsFor: 'applying' stamp: 'HAW 9/22/2021 20:19:25' overrides: 50613690! + apply + + self + applyAddParameter; + useNewParameter. + + ^addParameter changes + + ! ! +!ExtractAsParameter methodsFor: 'applying - private' stamp: 'HAW 9/22/2021 20:19:25'! + applyAddParameter + + ^ addParameter apply! ! +!ExtractAsParameter methodsFor: 'applying - private' stamp: 'HAW 9/22/2021 20:17:24'! + newSourceCode + + | intermediateSourceCode newInterval newSourceCode originalSourceCodeSize intermediateMethod | + + originalSourceCodeSize := sourceMethod sourceCode size. + intermediateMethod := sourceMethod methodClass >> self newSelector. + intermediateSourceCode := intermediateMethod sourceCode. + newInterval := intervalToReplace + (intermediateSourceCode size - originalSourceCodeSize). + newSourceCode := intermediateSourceCode copyReplaceFrom: newInterval first to: newInterval last with: addParameter newParameter. + + ^newSourceCode ! ! +!ExtractAsParameter methodsFor: 'applying - private' stamp: 'HAW 9/22/2021 20:17:33'! + useNewParameter + + sourceMethod methodClass compile: self newSourceCode. + + ! ! +!ExtractAsParameter methodsFor: 'initialization' stamp: 'HAW 9/21/2021 19:13:59'! + initializeExtractedFrom: anIntervalToExtract replacing: anIntervalToReplace at: aSourceMethod addingParameterWith: anAddParameter + + intervalToExtract := anIntervalToExtract. + intervalToReplace := anIntervalToReplace. + sourceMethod := aSourceMethod. + addParameter := anAddParameter.! ! +!ExtractAsParameter methodsFor: 'selectors' stamp: 'HAW 9/22/2021 19:56:45'! + newSelector + + ^addParameter newSelector ! ! +!ExtractAsParameter class methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 15:39:26'! + assert: aSourceMethod isInImplementors: implementorsCollection + + ^ (implementorsCollection includes: aSourceMethod) ifFalse: [ self signalOrigialMethodMustBeInImplementorsToChange ]! ! +!ExtractAsParameter class methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 20:07:25'! + assertAndCreateNamed: aNewParameter + extractedFrom: anInterval + at: aSourceMethod + implementors: implementorsCollection + senders: sendersCollection + creatingAddParameterWith: addParameterCreator + + | addParameter sourceCodeToExtract trimmedIntervalToReplace intervalToReplace intervals | + + self assert: aSourceMethod isInImplementors: implementorsCollection. + intervals := self assertCanExtractedFrom: anInterval for: aSourceMethod. + + intervalToReplace := intervals first. + trimmedIntervalToReplace := intervals second. + sourceCodeToExtract := aSourceMethod sourceCode copyFrom: trimmedIntervalToReplace first to: trimmedIntervalToReplace last. + + addParameter := addParameterCreator value: sourceCodeToExtract. + + ^self new + initializeExtractedFrom: trimmedIntervalToReplace + replacing: intervalToReplace + at: aSourceMethod + addingParameterWith: addParameter! ! +!ExtractAsParameter class methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 19:01:23'! + assertCanExtractedFrom: anInterval for: aSourceMethod + + | trimmedIntervalToReplace sourceCode node intervalToReplace | + + sourceCode := aSourceMethod sourceCode. + + ExtractMethodNewMethod assertIntervalToExtractIsNotEmpty: anInterval. + ExtractMethodNewMethod assert: anInterval isWithinBoundsOf: sourceCode. + + intervalToReplace := self removeDotsAt: anInterval in: sourceCode. + trimmedIntervalToReplace := intervalToReplace asSourceCodeInterval trimToMatchExpressionOn: sourceCode. + node := self nodeToExtractFrom: aSourceMethod at: trimmedIntervalToReplace or: intervalToReplace. + self assertIsValidToExtract: node. + + ^{ intervalToReplace. trimmedIntervalToReplace } + + ! ! +!ExtractAsParameter class methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 14:26:11'! + assertIsValidAssigmentToExtract: anAssignmentNode + + self assertIsValidToExtract: anAssignmentNode variable. + self assertIsValidToExtract: anAssignmentNode value ! ! +!ExtractAsParameter class methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 09:40:26'! + assertIsValidBlockNodeToExtract: aBlockNode + + aBlockNode block statementsDo: [ :aStatement | self assertIsValidToExtract: aStatement ]! ! +!ExtractAsParameter class methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 20:05:10'! + assertIsValidKeywordForNewParameter: aNewKeyword + + AddParameter assertIsValidKeywordForNewParameter: aNewKeyword! ! +!ExtractAsParameter class methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 15:09:49'! + assertIsValidLiteralNodeToExtract: aNode + + ^ (aNode isLiteralNode + or: [ aNode isTruePseudoVariable + or: [ aNode isFalsePseudoVariable + or: [ aNode isNilPseudoVariable ]]]) ifFalse: [ self signalInvalidExpressionToExtractAsParameter ]! ! +!ExtractAsParameter class methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 15:04:00'! + assertIsValidMessageNodeToExtract: aNode + + self assertIsValidToExtract: aNode receiver. + aNode arguments do: [ :anArgument | self assertIsValidToExtract: anArgument ]! ! +!ExtractAsParameter class methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 19:56:21'! + assertIsValidParameterName: aName + + AddParameter assertIsValidParameterName: aName ! ! +!ExtractAsParameter class methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 15:09:49'! + assertIsValidTempOrArgNodeToExtract: aTempVariableNode + + aTempVariableNode isDeclaredAtMethodLevel ifTrue: [ self signalInvalidExpressionToExtractAsParameter ]! ! +!ExtractAsParameter class methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 15:03:50'! + assertIsValidToExtract: aNode + + aNode isMessageNode ifTrue: [ ^self assertIsValidMessageNodeToExtract: aNode]. + aNode isBlockNode ifTrue: [ ^self assertIsValidBlockNodeToExtract: aNode ]. + aNode isTempOrArg ifTrue: [ ^self assertIsValidTempOrArgNodeToExtract: aNode ]. + aNode isAssignmentToTemporary ifTrue: [ ^self assertIsValidAssigmentToExtract: aNode ]. + self assertIsValidLiteralNodeToExtract: aNode! ! +!ExtractAsParameter class methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 09:28:16'! + is: aRange equalTo: sourceInterval or: intervalToReplace + + "When selecting literals like 1, the range first is one less than the initial character of the literal - Hernan" + + ^aRange = sourceInterval + or: [ aRange = intervalToReplace + or: [ aRange first + 1 = sourceInterval first and: [ aRange value last = sourceInterval last]]]! ! +!ExtractAsParameter class methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 15:45:11'! + nodeToExtractFrom: aSourceMethod at: trimmedIntervalToReplace or: intervalToReplace + + | nodeWithRangeToExtract nodesWithFirstPosition | + + nodesWithFirstPosition := aSourceMethod methodNode parseNodesPathAt: trimmedIntervalToReplace first ifAbsent: [ self signalInvalidSelection ]. + nodeWithRangeToExtract := nodesWithFirstPosition + detect: [ :nodeAndRange | self is: nodeAndRange value equalTo: trimmedIntervalToReplace or: intervalToReplace ] + ifNone: [ self signalInvalidSelection ]. + + ^nodeWithRangeToExtract key. + ! ! +!ExtractAsParameter class methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 15:42:21'! + removeDotsAt: anInterval in: sourceCode + + | lastToReplace | + + lastToReplace := anInterval last. + [(sourceCode at: lastToReplace) = $. ] whileTrue: [ lastToReplace := lastToReplace - 1]. + + ^anInterval first to: lastToReplace! ! +!ExtractAsParameter class methodsFor: 'instance creation' stamp: 'HAW 9/22/2021 15:55:37'! + named: aNewParameter + extractedFrom: anInterval + at: aSourceMethod + implementors: implementorsCollection + senders: sendersCollection + + ^self + assertAndCreateNamed: aNewParameter + extractedFrom: anInterval + at: aSourceMethod + implementors: implementorsCollection + senders: sendersCollection + creatingAddParameterWith: [ :sourceCodeToExtract | + AddParameter + named: aNewParameter + initializedWith: sourceCodeToExtract + toUnarySelector: aSourceMethod selector + implementors: implementorsCollection + senders: sendersCollection ]! ! +!ExtractAsParameter class methodsFor: 'instance creation' stamp: 'HAW 9/22/2021 15:56:38'! + named: aNewParameter + extractedFrom: anInterval + at: aNewKeywordIndex + newKeyword: newKeyword + at: aSourceMethod + implementors: implementorsCollection + senders: sendersCollection + + ^self + assertAndCreateNamed: aNewParameter + extractedFrom: anInterval + at: aSourceMethod + implementors: implementorsCollection + senders: sendersCollection + creatingAddParameterWith: [ :sourceCodeToExtract | + AddParameter + named: aNewParameter + at: aNewKeywordIndex + initializedWith: sourceCodeToExtract + using: newKeyword + toKeywordSelector: aSourceMethod selector + implementors: implementorsCollection + senders: sendersCollection ]! ! +!ExtractAsParameter class methodsFor: 'error messages' stamp: 'HAW 9/22/2021 15:10:01'! + errorMessageForInvalidExpressionToExtractAsParameter + + ^'Only literals, message sends to literals with literal parameters and +blocks with the previous conditions can be extracted as parameters'! ! +!ExtractAsParameter class methodsFor: 'error messages' stamp: 'HAW 9/21/2021 17:31:17'! + errorMessageForInvalidSelection + + ^'The selected source code is invalid for extraction as parameter'! ! +!ExtractAsParameter class methodsFor: 'error messages' stamp: 'HAW 9/22/2021 15:36:27'! + errorMessageForOrigialMethodMustBeInImplementorsToChange + + ^'Method with code to extract must be as implementor to change'! ! +!ExtractAsParameter class methodsFor: 'exceptions' stamp: 'HAW 9/22/2021 15:10:01'! + signalInvalidExpressionToExtractAsParameter + + self refactoringError: self errorMessageForInvalidExpressionToExtractAsParameter ! ! +!ExtractAsParameter class methodsFor: 'exceptions' stamp: 'HAW 9/21/2021 17:30:33'! + signalInvalidSelection + + self refactoringError: self errorMessageForInvalidSelection! ! +!ExtractAsParameter class methodsFor: 'exceptions' stamp: 'HAW 9/22/2021 15:37:55'! + signalOrigialMethodMustBeInImplementorsToChange + + self refactoringError: self errorMessageForOrigialMethodMustBeInImplementorsToChange! ! +!ExtractAsParameter class methodsFor: 'implementors and senders' stamp: 'HAW 9/22/2021 19:57:44'! + addImplementorsOf: anOldSelector to: implementors andSendersTo: senders forClassAndMetaOf: aPotentialClassToRefactor + + ^AddParameter addImplementorsOf: anOldSelector to: implementors andSendersTo: senders forClassAndMetaOf: aPotentialClassToRefactor! ! +!ExtractAsParameter class methodsFor: 'implementors and senders' stamp: 'HAW 9/22/2021 19:59:56'! + addImplementorsOf: anOldSelector to: implementors andSendersTo: senders inCategoriesAndHierarchyOf: aClass organizedBy: anOrganization + + ^AddParameter addImplementorsOf: anOldSelector to: implementors andSendersTo: senders inCategoriesAndHierarchyOf: aClass organizedBy: anOrganization! ! +!ExtractAsParameter class methodsFor: 'implementors and senders' stamp: 'HAW 9/22/2021 19:59:25'! + addImplementorsOf: anOldSelector to: implementors andSendersTo: senders inCategory: aCategory organizedBy: anOrganization + + ^AddParameter addImplementorsOf: anOldSelector to: implementors andSendersTo: senders inCategory: aCategory organizedBy: anOrganization! ! +!ExtractAsParameter class methodsFor: 'implementors and senders' stamp: 'HAW 9/22/2021 19:58:31'! + addImplementorsOf: anOldSelector to: implementors andSendersTo: senders inHierarchyOf: aClass + + ^AddParameter addImplementorsOf: anOldSelector to: implementors andSendersTo: senders inHierarchyOf: aClass +! ! +!ExtractAsParameter class methodsFor: 'implementors and senders' stamp: 'HAW 9/22/2021 20:00:22'! + addImplementorsOf: anOldSelector to: implementors andSendersTo: senders inSystem: aSystem + + ^AddParameter addImplementorsOf: anOldSelector to: implementors andSendersTo: senders inSystem: aSystem +! ! +!RefactoringApplier class methodsFor: 'appliers - registering' stamp: 'HAW 9/22/2021 18:38:54'! + registerExtractAsParameterApplier: anExtractAsParameterApplierClass + + self registerApplierAt: self extractAsParameterApplierId with: anExtractAsParameterApplierClass ! ! +!RefactoringApplier class methodsFor: 'appliers - getting' stamp: 'HAW 9/22/2021 16:35:35'! + extractAsParameterApplier + + ^self applierAt: self extractAsParameterApplierId ifAbsent: [ ExtractAsParameterApplier ]! ! +!RefactoringApplier class methodsFor: 'appliers - id' stamp: 'HAW 9/22/2021 16:35:22'! + extractAsParameterApplierId + + ^#extractAsParameterApplier! ! +!RefactoringApplier class methodsFor: 'appliers - resetting' stamp: 'HAW 9/22/2021 18:39:16'! + resetExtractAsParameterApplier + + self resetApplierAt: self extractAsParameterApplierId! ! +!ExtractAsParameterApplier methodsFor: 'refactoring - parameters request' stamp: 'HAW 9/22/2021 16:30:27' overrides: 50617070! + askNewParameterValue! ! +!ExtractAsParameterApplier methodsFor: 'refactoring - creation' stamp: 'HAW 9/22/2021 20:06:39' overrides: 50616993! + createRefactoringForKeywordSelector + + ^self refactoringClass + named: newParameter + extractedFrom: interval + at: parameterIndex + newKeyword: newKeyword + at: selectedClass >> oldSelector + implementors: implementors + senders: senders ! ! +!ExtractAsParameterApplier methodsFor: 'refactoring - creation' stamp: 'HAW 9/22/2021 19:36:15' overrides: 50617004! + createRefactoringForUnarySelector + + ^self refactoringClass + named: newParameter + extractedFrom: interval + at: selectedClass >> oldSelector + implementors: implementors + senders: senders ! ! +!ExtractAsParameterApplier methodsFor: 'refactoring - creation' stamp: 'HAW 9/22/2021 16:30:58' overrides: 50617014! + refactoringClass + + ^ExtractAsParameter ! ! +!ExtractAsParameterApplier methodsFor: 'initialization' stamp: 'HAW 9/22/2021 19:05:46'! + initializeInterval: anInterval + + interval := anInterval.! ! +!ExtractAsParameterApplier class methodsFor: 'instance creation' stamp: 'HAW 9/22/2021 19:03:29'! +from: anInterval on: aModel for: anOldSelector in: aClassToRefactor + + ExtractAsParameter assertCanExtractedFrom: anInterval for: aClassToRefactor >> anOldSelector. + + ^(super on: aModel for: anOldSelector in: aClassToRefactor) initializeInterval: anInterval ! ! +!SmalltalkEditor methodsFor: 'contextual rename' stamp: 'HAW 9/22/2021 19:41:05' prior: 50746763! + withMethodNodeAndClassDo: aBlock ifErrorsParsing: anErrorBlock + + | selectedClass methodNode | + + selectedClass := self selectedClassOrMetaClassOrUndefinedObject. + [ + [ methodNode := selectedClass methodNodeFor: model actualContents asString ] + on: UndeclaredVariableWarning do: [ :ex | ex resume ] + ] on: Error do: [ :anError | ^ anErrorBlock value: anError ]. + + ^aBlock value: methodNode value: selectedClass.! ! +!AddParameterApplier methodsFor: 'refactoring - parameters request' stamp: 'HAW 9/22/2021 16:27:52' prior: 50617070! + askNewParameterValue + + | enteredString | + + enteredString := self request: 'Enter parameter value for senders'. + newParameterValue := enteredString withBlanksTrimmed. + self refactoringClass assertNewParameterValueIsValid: newParameterValue. +! ! +!RefactoringMenues class methodsFor: 'editor menus' stamp: 'HAW 9/22/2021 16:41:33' prior: 50667125! + smalltalkEditorRefactoringMenuOptions + + ^`{ + { + #itemGroup -> 35. + #itemOrder -> 30. + #label -> 'Add Parameter... (A)'. + #selector -> #contextualAddParameter. + #icon -> #listAddIcon + } asDictionary. + { + #itemGroup -> 35. + #itemOrder -> 35. + #label -> 'Extract as Parameter... (1)'. + #selector -> #contextualExtractAsParameter. + #icon -> #listAddIcon + } asDictionary. + { + #itemGroup -> 35. + #itemOrder -> 40. + #label -> 'Remove Parameter... (S)'. + #selector -> #contextualRemoveParameter. + #icon -> #listRemoveIcon + } asDictionary. + { + #itemGroup -> 35. + #itemOrder -> 50. + #label -> 'Temporary to Instance Variable (O)'. + #selector -> #temporaryToInstanceVariable. + #icon -> #saveAsIcon + } asDictionary. + { + #itemGroup -> 35. + #itemOrder -> 60. + #label -> 'Push Up Instance Variable'. + #selector -> #contextualPushUpInClassDefinition. + #icon -> #goTopIcon + } asDictionary. + { + #itemGroup -> 35. + #itemOrder -> 70. + #label -> 'Push Down Instance Variable'. + #selector -> #contextualPushDownInClassDefinition. + #icon -> #goBottomIcon + } asDictionary. + }`! ! +!RefactoringMenues class methodsFor: 'shortcuts' stamp: 'HAW 9/22/2021 19:34:01' prior: 50682524! + smalltalkEditorCmdShortcutsSpec + + " + SmalltalkEditor initializeCmdShortcuts + " + ^#( + #($R #contextualRename: 'Renames what is under cursor') + #($A #contextualAddParameter: 'Adds parameter to message that is under cursor') + #($S #contextualRemoveParameter: 'Removes parameter to message that is under cursor') + #($O #temporaryToInstanceVariable: 'Extracts temporary variable to instance variable') + #($J #extractToTemporary: 'Extracts the selected code into a temporary variable') + #($K #extractMethod: 'Extracts the selected code into a separate method') + #($1 #contextualExtractAsParameter: 'Extracts the selected code as parameter') + )! ! +!SourceCodeOfMethodToBeExtractedPrecondition methodsFor: 'pre-conditions' stamp: 'HAW 9/22/2021 14:33:51' prior: 50692575! + assertSourceCodeContainsAValidExpression + + (self intervalCoversCompleteAstNodes + and: [ self startAndEndNodesShareAParentNode + or: [ self intervalMatchesBeginningOfStatement + and: [ self intervalMatchesEndOfStatement ]]]) + ifFalse: [ self signalSourceCodeContainsAnInvalidExpressionError ]! ! +!SourceCodeOfMethodToBeExtractedPrecondition methodsFor: 'private' stamp: 'HAW 9/22/2021 14:55:22' prior: 50683968! + intervalMatchesEndOfStatement + + | closerStatementLastPosition | + + closerStatementLastPosition := (self findSourceRangeOfCloserStatementIn: finalNodeAncestors) last. + ^ closerStatementLastPosition = intervalToExtract last or: [ closerStatementLastPosition - 1 = intervalToExtract last ].! ! + +ExtractAsParameterApplier class removeSelector: #on:for:in:! + +ExtractAsParameter class removeSelector: #assertNamed:extractedFrom:at:implementors:senders:creatingAddParameterWith:! + +ExtractAsParameter class removeSelector: #assertNamed:extractedFrom:at:implementors:senders:! + +ExtractAsParameter removeSelector: #addParameter! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4879-ExtractAsParameter-HernanWilkinson-2021Sep22-15h23m-HAW.001.cs.st----! + +'From Cuis 5.0 [latest update: #4879] on 23 September 2021 at 10:21:47 am'! +!CodeProvider methodsFor: 'annotation' stamp: 'jmv 9/22/2021 18:29:08'! + annotationForSystemCategory: aCategory + "Provide a line of content for an annotation pane, given that the receiver is pointing at the class definition of the given class." + + | separator | + separator _ self annotationSeparator. + ^ String streamContents: [ :strm | + strm + nextPutAll: 'System Category'; + nextPutAll: aCategory; + nextPutAll: separator; + print: (SystemOrganization listAtCategoryNamed: aCategory) size; + nextPutAll: ' classes'; + nextPutAll: separator; + print: (SystemOrganization instanceMethodCountOf: aCategory); + nextPutAll: ' instance methods'; + nextPutAll: separator; + print: (SystemOrganization classMethodCountOf: aCategory); + nextPutAll: ' class methods'; + nextPutAll: separator; + print: (SystemOrganization linesOfCodeOf: aCategory); + nextPutAll: ' total lines of code' ]! ! +!SystemOrganizer methodsFor: 'source code management' stamp: 'jmv 9/23/2021 10:18:03'! + classMethodCountOf: category + + ^ (self superclassOrderIn: category) sum: [ :cl | cl class selectors size ] ifEmpty: 0.! ! +!SystemOrganizer methodsFor: 'source code management' stamp: 'jmv 9/23/2021 10:18:08'! + instanceMethodCountOf: category + + ^ (self superclassOrderIn: category) sum: [ :cl | cl selectors size ] ifEmpty: 0.! ! +!SystemOrganizer methodsFor: 'source code management' stamp: 'jmv 9/23/2021 10:16:49'! + linesOfCodeOf: category +" +SystemOrganization linesOfCodeOf: #'System-Files' +" + "An approximate measure of lines of. + Includes comments, but excludes blank lines." + + ^ (self superclassOrderIn: category) sum: [ :cl | cl linesOfCode ] ifEmpty: 0.! ! +!CodeProvider methodsFor: 'annotation' stamp: 'jmv 9/22/2021 18:45:23' prior: 50693628! + annotationForSelector: aSelector ofClass: aClass + "Provide a line of content for an annotation pane, representing + information about the given selector and class" + + | stamp sendersCount implementorsCount aCategory separator aString aList aComment stream requestList | + aSelector == #Comment + ifTrue: [^ self annotationForClassCommentFor: aClass]. + aSelector == #Definition + ifTrue: [^ self annotationForClassDefinitionFor: aClass]. + aSelector == #Hierarchy + ifTrue: [^ self annotationForHierarchyFor: aClass]. + stream _ WriteStream on: String new. + requestList _ self annotationRequests. + separator _ self annotationSeparator. + requestList + do: [:aRequest | + aRequest == #firstComment + ifTrue: [ + aComment _ aClass firstCommentAt: aSelector. + aComment isEmptyOrNil + ifFalse: [stream position = 0 ifFalse: [stream nextPutAll: separator]. + stream nextPutAll: aComment]]. + aRequest == #masterComment + ifTrue: [ + aComment _ aClass supermostPrecodeCommentFor: aSelector. + aComment isEmptyOrNil + ifFalse: [stream position = 0 ifFalse: [stream nextPutAll: separator]. + stream nextPutAll: aComment]]. + aRequest == #documentation + ifTrue: [ + aComment _ aClass precodeCommentOrInheritedCommentFor: aSelector. + aComment isEmptyOrNil + ifFalse: [stream isEmpty ifFalse: [stream nextPutAll: separator]. + stream nextPutAll: aComment]]. + aRequest == #timeStamp + ifTrue: [ + stamp _ self timeStamp. + stream isEmpty ifFalse: [stream nextPutAll: separator]. + stream nextPutAll: (stamp size > 0 ifTrue: [stamp] ifFalse: ['no timestamp'])]. + aRequest == #linesOfCode + ifTrue: [ + stream isEmpty ifFalse: [stream nextPutAll: separator]. + stream nextPutAll: ((aClass compiledMethodAt: aSelector ifAbsent: nil) + ifNotNil: [ :cm | cm linesOfCode]) printString, ' lines of code']. + aRequest == #messageCategory + ifTrue: [ + aCategory _ aClass organization categoryOfElement: aSelector. + aCategory + ifNotNil: ["woud be nil for a method no longer present, + e.g. in a recent-submissions browser" + stream isEmpty ifFalse: [stream nextPutAll: separator]. + stream nextPutAll: aCategory]]. + aRequest == #sendersCount + ifTrue: [ + sendersCount _ Smalltalk numberOfSendersOf: aSelector. + sendersCount _ sendersCount = 1 + ifTrue: ['1 sender'] + ifFalse: [sendersCount printString , ' senders']. + stream isEmpty ifFalse: [stream nextPutAll: separator]. + stream nextPutAll: sendersCount]. + aRequest == #implementorsCount + ifTrue: [ + implementorsCount _ Smalltalk numberOfImplementorsOf: aSelector. + implementorsCount _ implementorsCount = 1 + ifTrue: ['1 implementor'] + ifFalse: [implementorsCount printString , ' implementors']. + stream isEmpty ifFalse: [stream nextPutAll: separator]. + stream nextPutAll: implementorsCount]. + aRequest == #priorVersionsCount + ifTrue: [ + stream isEmpty ifFalse: [stream nextPutAll: separator]. + self + addPriorVersionsCountForSelector: aSelector + ofClass: aClass + to: stream]. + aRequest == #priorTimeStamp + ifTrue: [ + stamp _ VersionsBrowser + timeStampFor: aSelector + class: aClass + reverseOrdinal: 2. + stamp + ifNotNil: [stream isEmpty ifFalse: [stream nextPutAll: separator]. + stream nextPutAll: 'prior timestamp: ' , stamp]]. + aRequest == #packages + ifTrue: [ + (aClass compiledMethodAt: aSelector ifAbsent: nil) ifNotNil: [ :cm | + stream isEmpty ifFalse: [stream nextPutAll: separator]. + (CodePackage packageOfMethod: cm methodReference ifNone: nil) + ifNil: [ stream nextPutAll: 'in no package' ] + ifNotNil: [ :codePackage | + stream nextPutAll: 'in package '; nextPutAll: codePackage packageName ]]]. + aRequest == #changeSets + ifTrue: [ + stream isEmpty ifFalse: [stream nextPutAll: separator]. + aList _ ChangeSet allChangeSetsWithClass: aClass selector: aSelector. + aList size > 0 + ifTrue: [aList size = 1 + ifTrue: [stream nextPutAll: 'only in change set'] + ifFalse: [stream nextPutAll: 'in change sets:']. + aList + do: [:aChangeSet | stream nextPut: Character space; nextPutAll: aChangeSet name ] + separatedBy: [ stream nextPut: $, ]] + ifFalse: [stream nextPutAll: 'in no change set']]. + aRequest == #allChangeSets + ifTrue: [ + stream isEmpty ifFalse: [stream nextPutAll: separator]. + aList _ ChangeSet allChangeSetsWithClass: aClass selector: aSelector. + aList size > 0 + ifTrue: [aList size = 1 + ifTrue: [stream nextPutAll: 'only in change set'] + ifFalse: [stream nextPutAll: 'in change sets:']. + aList + do: [:aChangeSet | stream nextPut: Character space; nextPutAll: aChangeSet name ] + separatedBy: [ stream nextPut: $, ]] + ifFalse: [stream nextPutAll: 'in no change set']]. + aRequest == #allBaseSystemChangeSets + ifTrue: [ + stream isEmpty ifFalse: [stream nextPutAll: separator]. + aList _ (ChangeSet allChangeSetsWithClass: aClass selector: aSelector) select: [ :it | it isForBaseSystem ]. + aList size > 0 + ifTrue: [ + aList size = 1 + ifTrue: [stream nextPutAll: 'only in base system change set'] + ifFalse: [stream nextPutAll: 'in base system change sets:']. + aList + do: [:aChangeSet | stream nextPut: Character space; nextPutAll: aChangeSet name ] + separatedBy: [ stream nextPut: $, ]] + ifFalse: [stream nextPutAll: 'in no base system change set']]. + aRequest == #closuresInfo + ifTrue: [ + aString _ aClass closuresInfoAt: aSelector. + aString size > 0 + ifTrue: [stream isEmpty ifFalse: [stream nextPutAll: separator]. + stream nextPutAll: aString]]. + ]. + ^ stream contents! ! +!Browser methodsFor: 'annotation' stamp: 'jmv 9/23/2021 10:08:33' prior: 50660725 overrides: 50630615! + annotation + "Provide a line of content for an annotation pane, representing information about the method associated with the selected class and selector in the receiver." + + | aSelector aClass | + (aClass _ self selectedClassOrMetaClass) + ifNil: [ + self selectedSystemCategoryName ifNotNil: [ :sysCat | + ^self annotationForSystemCategory: sysCat ]. + ^ '']. + self editSelection == #editComment + ifTrue: [^ self annotationForSelector: #Comment ofClass: aClass]. + self isEditingExistingClass + ifTrue: [^ self annotationForSelector: #Definition ofClass: aClass]. + (aSelector _ self selectedMessageName) + ifNil: [^ '']. + ^ self annotationForSelector: aSelector ofClass: aClass! ! +!ClassDescription methodsFor: 'source code management' stamp: 'jmv 9/23/2021 10:05:44' prior: 16807069! + linesOfCode +" +Object linesOfCode +" + "An approximate measure of lines of. + Includes comments, but excludes blank lines. + If asked to a class, also include its metaclass (i.e. the class side). + If asked to a metaclass (the class side), don't include the class (the instance side)." + + | lines | + lines _ 0. + self selectorsDo: [ :sel | + lines _ lines + (self compiledMethodAt: sel) linesOfCode ]. + ^self isMeta + ifTrue: [ lines] + ifFalse: [ lines + self class linesOfCode]. +" +(SystemOrganization categories select: [:c | 'Kernel*' match: c]) sum: [:c | + (SystemOrganization superclassOrderIn: c) sum: [:cl | cl linesOfCode]] +" +" +Smalltalk allClasses sum: [:cl | cl linesOfCode] +"! ! +!CompiledMethod methodsFor: 'source code management' stamp: 'jmv 9/23/2021 10:03:40' prior: 16820495! + linesOfCode + "An approximate measure of lines of code. + Use decompiled source code. In this way, the measure: + - Doesn't include comments + - Doesn't include blank lines + - Is not sensitive to code formatting + The motivation is to consider LOC as an expense, not an asset. Minimizing LOC is good. + But it is not like that for comments!!" + + | lines | + lines _ 0. + self decompileString lineIndicesDo: [ :start :endWithoutDelimiters :end | + endWithoutDelimiters - start > 0 ifTrue: [ + lines _ lines+1 ]]. + ^lines! ! +!Preferences class methodsFor: 'parameters' stamp: 'jmv 9/22/2021 18:41:13' prior: 16893315! +annotationInfo + "Answer a list of pairs characterizing all the available kinds of annotations; in each pair, the first element is a symbol representing the info type, and the second element is a string providing the corresponding balloon help" + + ^ #( + (timeStamp 'The time stamp of the last submission of the method.') + (firstComment 'The first comment in the method, if any.') + (masterComment 'The comment at the beginning of the supermost implementor of the method if any.') + (documentation 'Comment at beginning of the method or, if it has none, comment at the beginning of a superclass''s implementation of the method.') + (messageCategory 'Which method category the method lies in.') + (sendersCount 'A report of how many senders there of the message.') + (implementorsCount 'A report of how many implementors there are of the message.') + (allChangeSets 'A list of all change sets bearing the method.') + (priorVersionsCount 'A report of how many previous versions there are of the method.') + (priorTimeStamp 'The time stamp of the penultimate submission of the method, if any.') + (closuresInfo 'Details about BlockClosures in the method.') + (packages 'Details about CodePackages including the method.') + (linesOfCode 'Number of lines of code, including comments but not blank lines.') + )! ! +!CodePackage methodsFor: 'source code management' stamp: 'jmv 9/23/2021 10:27:42' prior: 16810500! + linesOfCode + "An approximate measure of lines of code. + Does not includes comments, or excludes blank lines. + See comment at CompiledMethod >> #linesOfCode" + + ^self methods inject: 0 into: [ :sum :each | + sum + each compiledMethod linesOfCode ].! ! +!Preferences class methodsFor: 'parameters' stamp: 'jmv 9/22/2021 18:42:21' prior: 50594453! + setDefaultAnnotationInfo + " + Preferences setDefaultAnnotationInfo + " + ^ self parameters at: #MethodAnnotations put: #(timeStamp linesOfCode messageCategory implementorsCount sendersCount packages changeSets)! ! + +"Postscript: +Leave the line above, and replace the rest of this comment by a useful one. +Executable statements should follow this comment, and should +be separated by periods, with no exclamation points (!!). +Be sure to put any further comments in double-quotes, like this one." + Preferences setDefaultAnnotationInfo! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4880-LinesOfCode-Enhancements-JuanVuletich-2021Sep23-09h57m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4880] on 23 September 2021 at 11:31:18 am'! +!Preferences class methodsFor: 'parameters' stamp: 'jmv 9/23/2021 11:30:01'! + setCheapAnnotationInfo + " + Preferences setCheapAnnotationInfo + " + ^ self parameters at: #MethodAnnotations put: #(timeStamp messageCategory packages changeSets)! ! +!Preferences class methodsFor: 'themes' stamp: 'jmv 9/23/2021 11:30:57' prior: 50774975! + slowMachine + " + Preferences slowMachine + " + self setPreferencesFrom: #( + #(#drawKeyboardFocusIndicator false ) + (balloonHelpEnabled false) + (browseWithPrettyPrint false) + (caseSensitiveFinds true) + (checkForSlips false) + (cmdDotEnabled true) + (diffsInChangeList true) + (diffsWithPrettyPrint false) + (menuKeyboardControl false) + (optionalButtons false) + (subPixelRenderFonts true) + (thoroughSenders true) + (cheapWindowReframe true) + (syntaxHighlightingAsYouType false) + (tapAndHoldEmulatesButton2 false) + (clickGrabsMorphs true) + ). + self useNoMenuIcons. + self runningWorld backgroundImageData: nil. + Preferences setCheapAnnotationInfo. + " + Smalltalk at: #ClassicTheme ifPresent: [ :cls | cls beCurrent ]. + Taskbar hideTaskbar + "! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4881-Preferences-slowMachine-tweaks-JuanVuletich-2021Sep23-11h29m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4881] on 23 September 2021 at 4:06:09 pm'! +!PluggableButtonMorph methodsFor: 'accessing' stamp: 'KenD 9/17/2021 16:05:19' prior: 50751811! + iconName + + ^ self valueOfProperty: #iconName! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4882-iconName-fix-KenDickey-2021Sep23-16h05m-KenD.001.cs.st----! + +'From Cuis 5.0 [latest update: #4882] on 24 September 2021 at 10:19:33 am'! +!FontFamily class methodsFor: 'accessing fonts' stamp: 'jmv 9/24/2021 10:03:42'! + enableTrueTypeFontsOnly + + AvailableFamilies _ AvailableFamilies select: [ :f | f isTrueTypeFontFamily ].! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4883-EnableOnlyTrueTypeFonts-JuanVuletich-2021Sep24-10h19m-jmv.001.cs.st----! + +----QUIT----(24 September 2021 10:39:21) Cuis5.0-4883.image priorSource: 14439627! \ No newline at end of file diff --git a/Cuis5.0-4883.image b/Cuis5.0-4883.image new file mode 100644 index 00000000..d12bfcf8 Binary files /dev/null and b/Cuis5.0-4883.image differ diff --git a/Documentation/GettingStarted-NoCommandLine.md b/Documentation/GettingStarted-NoCommandLine.md index 92b58775..9c1336af 100644 --- a/Documentation/GettingStarted-NoCommandLine.md +++ b/Documentation/GettingStarted-NoCommandLine.md @@ -8,7 +8,7 @@ What follows are instructions for setting up Cuis on Windows or Mac OS X without * extract the contents of the zip file right there ("extract here") * download [`squeak.cog.spur_win32x86_202003021730.zip`](https://github.com/OpenSmalltalk/opensmalltalk-vm/releases/download/202003021730/squeak.cog.spur_win32x86_202003021730.zip), saving it to yourFolder\Cuis-Smalltalk-Dev-master\ (the folder that was just created while extracting the first zip file). * extract the contents of the zip file right there ("extract here") -* drop the Cuis5.0-4871-32.image over the Squeak.exe file. Alternatively, double click on the Squeak.exe file, and when prompted to select an image file, select Cuis5.0-4871-32.image. +* drop the Cuis5.0-4883-32.image over the Squeak.exe file. Alternatively, double click on the Squeak.exe file, and when prompted to select an image file, select Cuis5.0-4883-32.image. * If you get a message like "This publisher could not be verified. Are you sure you want to run this software?", then untag "Always ask before opening this file" (if present) and click [Run]. * If you get a message like "Windows protected your PC", then click on "More info", and click [Run anyway]. @@ -19,10 +19,10 @@ What follows are instructions for setting up Cuis on Windows or Mac OS X without * download [`squeak.cog.spur_macos64x64_202003021730.dmg`](https://github.com/OpenSmalltalk/opensmalltalk-vm/releases/download/202003021730/squeak.cog.spur_macos64x64_202003021730.dmg), saving it to your folder * double click on the dmg file * Drag Squeak to your folder -* drop the Cuis5.0-4871.image over the Squeak.app file +* drop the Cuis5.0-4883.image over the Squeak.app file * If you get "Squeak is an app downloaded from the Internet. Are you sure you want to open it?", click on [Open] ## Troubleshooting ## -* If you can't find Cuis5.0-4871.image, then this document is outdated. Use the Cuis image with the latest update number available. +* If you can't find Cuis5.0-4883.image, then this document is outdated. Use the Cuis image with the latest update number available. * If you can't find the Squeak Cog Spur VM specified, then this document is outdated. Use the the Squeak Cog Spur VM for your platform with the latest Date and Time available from https://github.com/OpenSmalltalk/opensmalltalk-vm/releases/latest or http://opensmalltalk.org/ * If you can't get Cuis to run on your system after trying the above instructions, send mail to the Cuis-Dev mail list. Please give enough detail of your system, what you tried, and any error messages you got. diff --git a/Documentation/GettingStarted.md b/Documentation/GettingStarted.md index 982deb33..a7e222d7 100644 --- a/Documentation/GettingStarted.md +++ b/Documentation/GettingStarted.md @@ -43,7 +43,7 @@ mv ./sqcogspur64linuxht ./cogspur ### Starting Cuis Smalltalk ### ``` -cogspur/squeak Cuis-Smalltalk-Dev/Cuis5.0-4871.image +cogspur/squeak Cuis-Smalltalk-Dev/Cuis5.0-4883.image ``` If you get this error message (you won't get it if you run Cuis as root or sudo): ``` @@ -68,11 +68,11 @@ Drag Squeak.app to your folder ``` ### Starting Cuis Smalltalk ### -* drop the Cuis5.0-4871.image over the Squeak.app file +* drop the Cuis5.0-4883.image over the Squeak.app file * If you get "Squeak is an app downloaded from the Internet. Are you sure you want to open it?", click on [Open] * Alternatively, you might: ``` -./Squeak.app/Contents/MacOS/Squeak Cuis-Smalltalk-Dev-master/Cuis5.0-4871.image +./Squeak.app/Contents/MacOS/Squeak Cuis-Smalltalk-Dev-master/Cuis5.0-4883.image ``` ## For 64 bits Windows (Git Bash) ## @@ -89,7 +89,7 @@ unzip cogspur.zip -d cogspur ### Starting Cuis Smalltalk ### ``` -cogspur/Squeak.exe Cuis-Smalltalk-Dev/Cuis5.0-4871.image +cogspur/Squeak.exe Cuis-Smalltalk-Dev/Cuis5.0-4883.image ``` ## For Raspberry Pi Raspian ## @@ -105,7 +105,7 @@ mv ./sqcogspurlinuxhtRPi ./cogspur ### Starting Cuis Smalltalk ### ``` -cogspur/squeak Cuis-Smalltalk-Dev/Cuis5.0-4871-32.image +cogspur/squeak Cuis-Smalltalk-Dev/Cuis5.0-4883-32.image ``` ## For Chromebooks ## @@ -136,14 +136,14 @@ mv ./sqstkspurlinuxhtRPi ./stkspur ### Starting Cuis Smalltalk ### ``` -cogspur/squeak Cuis-Smalltalk-Dev/Cuis5.0-4871-32.image -stkspur/squeak Cuis-Smalltalk-Dev/Cuis5.0-4871-32.image +cogspur/squeak Cuis-Smalltalk-Dev/Cuis5.0-4883-32.image +stkspur/squeak Cuis-Smalltalk-Dev/Cuis5.0-4883-32.image ``` ## Troubleshooting ## * If when starting the image you get error messages like "This interpreter (vers. 6505) cannot read image file (vers. 68021).", (68021 or some other reasonable number) it means you image and VM are mismatched. For example, one of them is Spur and the other is pre-Spur, or one of them is 32 bits and the other is 64 bits. * If when starting the image you get error messages like "This interpreter (vers. 6505) cannot read image file (vers. 1007290890).", (1007290890 or some other absurd number) it means your git installation is breaking the files. It is usually best to configure git not to do any conversion on files. -* If you can't find Cuis5.0-4871-32.image, then this document is outdated. Use the Cuis spur image with the latest update number available. +* If you can't find Cuis5.0-4883-32.image, then this document is outdated. Use the Cuis spur image with the latest update number available. * If you can't find the Squeak Cog Spur VM specified, then this document is outdated. Use the the Squeak Cog Spur VM for your platform with the latest Date and Time available from http://opensmalltalk.org/ * If you can't get Cuis to run on your system after trying the above instructions, send mail to the Cuis-Dev mail list. Please give enough detail of your system, what you tried, and any error messages you got. * To get the contents of this repository without using Git, you can do