diff --git a/Gofer-Core.package/GoferResolvedReference.class/instance/accessing/version.st b/Gofer-Core.package/GoferResolvedReference.class/instance/accessing/version.st index 6936e660eb..76cec4c60e 100644 --- a/Gofer-Core.package/GoferResolvedReference.class/instance/accessing/version.st +++ b/Gofer-Core.package/GoferResolvedReference.class/instance/accessing/version.st @@ -1,4 +1,4 @@ version "Answer a Monticello version of the receiver." - ^ self repository goferVersionFrom: self \ No newline at end of file + ^ self repository versionFrom: self name \ No newline at end of file diff --git a/Gofer-Core.package/extension/MCFileBasedRepository/instance/goferVersionFrom_.st b/Gofer-Core.package/extension/MCFileBasedRepository/instance/goferVersionFrom_.st deleted file mode 100644 index e819529045..0000000000 --- a/Gofer-Core.package/extension/MCFileBasedRepository/instance/goferVersionFrom_.st +++ /dev/null @@ -1,2 +0,0 @@ -goferVersionFrom: aVersionReference - ^ self loadVersionFromFileNamed: aVersionReference name , '.mcz' \ No newline at end of file diff --git a/Gofer-Core.package/extension/MCRepository/instance/goferVersionFrom_.st b/Gofer-Core.package/extension/MCRepository/instance/goferVersionFrom_.st deleted file mode 100644 index ca9a2eb30b..0000000000 --- a/Gofer-Core.package/extension/MCRepository/instance/goferVersionFrom_.st +++ /dev/null @@ -1,2 +0,0 @@ -goferVersionFrom: aVersionReference - self error: 'Unable to load from ' , self printString \ No newline at end of file diff --git a/Gofer-Core.package/extension/MCDictionaryRepository/instance/goferVersionFrom_.st b/Monticello.package/MCDictionaryRepository.class/instance/accessing/versionFrom_.st similarity index 52% rename from Gofer-Core.package/extension/MCDictionaryRepository/instance/goferVersionFrom_.st rename to Monticello.package/MCDictionaryRepository.class/instance/accessing/versionFrom_.st index 078ac61a8b..537b99a65f 100644 --- a/Gofer-Core.package/extension/MCDictionaryRepository/instance/goferVersionFrom_.st +++ b/Monticello.package/MCDictionaryRepository.class/instance/accessing/versionFrom_.st @@ -1,2 +1,2 @@ -goferVersionFrom: aVersionReference - ^ self dictionary detect: [ :version | version info name = aVersionReference name ] \ No newline at end of file +versionFrom: aVersionReferenceString + ^ self dictionary detect: [ :version | version info name = aVersionReferenceString ] \ No newline at end of file diff --git a/Monticello.package/MCFileBasedRepository.class/instance/accessing/versionFromFileNamed_.st b/Monticello.package/MCFileBasedRepository.class/instance/accessing/versionFromFileNamed_.st index f2853e8105..50f0d77f87 100644 --- a/Monticello.package/MCFileBasedRepository.class/instance/accessing/versionFromFileNamed_.st +++ b/Monticello.package/MCFileBasedRepository.class/instance/accessing/versionFromFileNamed_.st @@ -1,7 +1,7 @@ -versionFromFileNamed: aString - | v | - v := self cache - at: aString - ifAbsent: [ self loadVersionFromFileNamed: aString ]. - self updateCachedVersionFromFileName: aString with: v. - ^ v \ No newline at end of file +versionFromFileNamed: aFileName + | version | + version := self cache + at: aFileName + ifAbsent: [ self loadVersionFromFileNamed: aFileName ]. + self updateCachedVersionFromFileName: aFileName with: version. + ^ version \ No newline at end of file diff --git a/Monticello.package/MCFileBasedRepository.class/instance/accessing/versionFromRepositoryFromFileNamed_.st b/Monticello.package/MCFileBasedRepository.class/instance/accessing/versionFromRepositoryFromFileNamed_.st index d19e1f2e24..4284ee9065 100644 --- a/Monticello.package/MCFileBasedRepository.class/instance/accessing/versionFromRepositoryFromFileNamed_.st +++ b/Monticello.package/MCFileBasedRepository.class/instance/accessing/versionFromRepositoryFromFileNamed_.st @@ -1,7 +1,7 @@ -versionFromRepositoryFromFileNamed: aString - | v | - v := self cache - at: aString - ifAbsent: [ self loadNotCachedVersionFromFileNamed: aString ]. - self updateCachedVersionFromFileName: aString with: v. - ^ v \ No newline at end of file +versionFromRepositoryFromFileNamed: aFileName + | version | + version := self cache + at: aFileName + ifAbsent: [ self loadNotCachedVersionFromFileNamed: aFileName ]. + self updateCachedVersionFromFileName: aFileName with: version. + ^ version \ No newline at end of file diff --git a/Monticello.package/MCFileBasedRepository.class/instance/accessing/versionFrom_.st b/Monticello.package/MCFileBasedRepository.class/instance/accessing/versionFrom_.st new file mode 100644 index 0000000000..f7dad9b0ae --- /dev/null +++ b/Monticello.package/MCFileBasedRepository.class/instance/accessing/versionFrom_.st @@ -0,0 +1,2 @@ +versionFrom: aVersionReferenceString + ^ self loadVersionFromFileNamed: aVersionReferenceString , '.mcz' \ No newline at end of file diff --git a/Monticello.package/MCFileBasedRepository.class/instance/accessing/versionInfoFromFileNamed_.st b/Monticello.package/MCFileBasedRepository.class/instance/accessing/versionInfoFromFileNamed_.st index 90edc78faf..3ed8a61bd1 100644 --- a/Monticello.package/MCFileBasedRepository.class/instance/accessing/versionInfoFromFileNamed_.st +++ b/Monticello.package/MCFileBasedRepository.class/instance/accessing/versionInfoFromFileNamed_.st @@ -1,3 +1,5 @@ -versionInfoFromFileNamed: aString - self cache at: aString ifPresent: [:v | ^ v info]. - ^ self loadVersionInfoFromFileNamed: aString \ No newline at end of file +versionInfoFromFileNamed: aFileName + self cache + at: aFileName + ifPresent: [:version | ^ version info]. + ^ self loadVersionInfoFromFileNamed: aFileName \ No newline at end of file diff --git a/Monticello.package/MCFileBasedRepository.class/instance/accessing/versionNameFromFileName_.st b/Monticello.package/MCFileBasedRepository.class/instance/accessing/versionNameFromFileName_.st index de21541aaf..bf8af5ec72 100644 --- a/Monticello.package/MCFileBasedRepository.class/instance/accessing/versionNameFromFileName_.st +++ b/Monticello.package/MCFileBasedRepository.class/instance/accessing/versionNameFromFileName_.st @@ -1,2 +1,2 @@ -versionNameFromFileName: aString - ^ (aString copyUpToLast: $.) copyUpTo: $( \ No newline at end of file +versionNameFromFileName: aFileName + ^ (aFileName copyUpToLast: $.) copyUpTo: $( \ No newline at end of file diff --git a/Monticello.package/MCRepository.class/instance/accessing/versionFrom_.st b/Monticello.package/MCRepository.class/instance/accessing/versionFrom_.st new file mode 100644 index 0000000000..363465fe59 --- /dev/null +++ b/Monticello.package/MCRepository.class/instance/accessing/versionFrom_.st @@ -0,0 +1,2 @@ +versionFrom: aVersionReferenceString + self error: 'Unable to load from ' , self printString \ No newline at end of file diff --git a/Gofer-Core.package/extension/MCFileTreeRepository/instance/goferVersionFrom_.st b/MonticelloFileTree-Core.package/MCFileTreeRepository.class/instance/accessing/versionFrom_.st similarity index 56% rename from Gofer-Core.package/extension/MCFileTreeRepository/instance/goferVersionFrom_.st rename to MonticelloFileTree-Core.package/MCFileTreeRepository.class/instance/accessing/versionFrom_.st index b11bb1a8c8..050bdbf9a7 100644 --- a/Gofer-Core.package/extension/MCFileTreeRepository/instance/goferVersionFrom_.st +++ b/MonticelloFileTree-Core.package/MCFileTreeRepository.class/instance/accessing/versionFrom_.st @@ -1,9 +1,9 @@ -goferVersionFrom: aVersionReference +versionFrom: aVersionReferenceString "until we no longer find .tree directories in the wild" - ((self readableFileNames collect: [ :fileName | self fileDirectoryOn: fileName ]) - select: [ :packageDirectory | self fileUtils directoryExists: packageDirectory ]) - collect: [ :packageDirectory | - (self versionInfoForPackageDirectory: packageDirectory) name = aVersionReference name + (self readableFileNames collect: [ :fileName | self fileDirectoryOn: fileName ]) + select: [ :packageDirectory | self fileUtils directoryExists: packageDirectory ] + thenCollect: [ :packageDirectory | + (self versionInfoForPackageDirectory: packageDirectory) name = aVersionReferenceString ifTrue: [ ^ self loadVersionFromFileNamed: (self fileUtils directoryName: packageDirectory) ] ]. ^ nil \ No newline at end of file diff --git a/NECompletion.package/extension/Workspace/instance/guessTypeForName_.st b/NECompletion.package/extension/Workspace/instance/guessTypeForName_.st deleted file mode 100644 index de454d2177..0000000000 --- a/NECompletion.package/extension/Workspace/instance/guessTypeForName_.st +++ /dev/null @@ -1,11 +0,0 @@ -guessTypeForName: aString - | binding | - - bindings ifNotNil: [ - binding := bindings - at: aString - ifAbsent: [ nil ]. - binding isNil - ifFalse: [ ^ binding class ] ]. - - ^ nil \ No newline at end of file diff --git a/NECompletion.package/extension/Workspace/instance/hasBindingThatBeginsWith_.st b/NECompletion.package/extension/Workspace/instance/hasBindingThatBeginsWith_.st deleted file mode 100644 index ee609206a8..0000000000 --- a/NECompletion.package/extension/Workspace/instance/hasBindingThatBeginsWith_.st +++ /dev/null @@ -1,2 +0,0 @@ -hasBindingThatBeginsWith: aString - ^false \ No newline at end of file diff --git a/ScriptLoader50.package/ScriptLoader.class/instance/pharo - scripts/script50152.st b/ScriptLoader50.package/ScriptLoader.class/instance/pharo - scripts/script50153.st similarity index 97% rename from ScriptLoader50.package/ScriptLoader.class/instance/pharo - scripts/script50152.st rename to ScriptLoader50.package/ScriptLoader.class/instance/pharo - scripts/script50153.st index bd1050ccfa..2b19f623f2 100644 --- a/ScriptLoader50.package/ScriptLoader.class/instance/pharo - scripts/script50152.st +++ b/ScriptLoader50.package/ScriptLoader.class/instance/pharo - scripts/script50153.st @@ -1,4 +1,4 @@ -script50152 +script50153 ^ 'AST-Core-TheIntegrator.314.mcz AST-Tests-Core-TheIntegrator.70.mcz @@ -94,7 +94,7 @@ Glamour-Tests-Core-AliakseiSyrel.104.mcz Glamour-Tests-Morphic-AndreiChis.124.mcz Glamour-Tests-Resources-AndreiChis.3.mcz Glamour-Tests-Rubric-AndreiChis.14.mcz -Gofer-Core-TheIntegrator.228.mcz +Gofer-Core-TheIntegrator.230.mcz Gofer-Tests-TheIntegrator.164.mcz Graphics-Canvas-TheIntegrator.2.mcz Graphics-Display Objects-TheIntegrator.161.mcz @@ -147,10 +147,10 @@ Metacello-TestsCommonMC.pharo20-EstebanLorenzano.4.mcz Metacello-TestsPlatform.squeakCommon-MarcusDenker.19.mcz Metacello-ToolBox-MarcusDenker.141.mcz Metacello-Tutorial-EstebanLorenzano.27.mcz -Monticello-TheIntegrator.1036.mcz +Monticello-TheIntegrator.1039.mcz Monticello-Tests-TheIntegrator.16.mcz MonticelloConfigurations-MarcusDenker.70.mcz -MonticelloFileTree-Core-TheIntegrator.184.mcz +MonticelloFileTree-Core-TheIntegrator.186.mcz MonticelloFileTree-FileSystem-Utilities-MarcusDenker.32.mcz MonticelloGUI-TheIntegrator.361.mcz MonticelloMocks-EstebanLorenzano.2.mcz @@ -177,7 +177,7 @@ Multilingual-OtherLanguages-TheIntegrator.15.mcz Multilingual-Tests-TheIntegrator.38.mcz Multilingual-TextConversion-TheIntegrator.70.mcz Multilingual-TextConverterOtherLanguages-MarcusDenker.2.mcz -NECompletion-TheIntegrator.201.mcz +NECompletion-TheIntegrator.202.mcz NECompletion-Tests-TheIntegrator.2.mcz NativeBoost-Core-TheIntegrator.168.mcz NativeBoost-Examples-CamilloBruni.16.mcz @@ -268,7 +268,7 @@ Spec-MorphicAdapters-TheIntegrator.214.mcz Spec-PolyWidgets-TheIntegrator.59.mcz Spec-Tests-TheIntegrator.47.mcz Spec-Tools-TheIntegrator.274.mcz -StartupPreferences-TheIntegrator.133.mcz +StartupPreferences-TheIntegrator.135.mcz System-Announcements-TheIntegrator.100.mcz System-Caching-TheIntegrator.26.mcz System-CachingTests-TheIntegrator.14.mcz @@ -295,7 +295,7 @@ System-VMEvents-TheIntegrator.5.mcz Tests-TheIntegrator.734.mcz Text-Core-TheIntegrator.35.mcz Text-Diff-StephaneDucasse.4.mcz -Text-Edition-TheIntegrator.89.mcz +Text-Edition-TheIntegrator.91.mcz Text-Edition-Tests-EstebanLorenzano.3.mcz Text-Scanning-TheIntegrator.26.mcz Text-Tests-EstebanLorenzano.7.mcz @@ -313,7 +313,7 @@ Tool-Profilers-TheIntegrator.17.mcz Tool-SystemReporter-TheIntegrator.12.mcz Tool-Transcript-TheIntegrator.14.mcz Tool-TxWorkspace-TorstenBergmann.5.mcz -Tool-Workspace-TheIntegrator.26.mcz +Tool-Workspace-TheIntegrator.28.mcz Tools-TheIntegrator.1503.mcz ToolsTest-MarcusDenker.denker.71.mcz Traits-TheIntegrator.799.mcz diff --git a/ScriptLoader50.package/ScriptLoader.class/instance/pharo - updates/update50152.st b/ScriptLoader50.package/ScriptLoader.class/instance/pharo - updates/update50152.st deleted file mode 100644 index 382f24154f..0000000000 --- a/ScriptLoader50.package/ScriptLoader.class/instance/pharo - updates/update50152.st +++ /dev/null @@ -1,15 +0,0 @@ -update50152 - "self new update50152" - self withUpdateLog: '7008 Shared Pools to be treated like dictionaries still necessary? - https://pharo.fogbugz.com/f/cases/7008 - -15886 Find class dialog from a scope nautilus window shows all classes - https://pharo.fogbugz.com/f/cases/15886 - -15889 do not call asOrderedCollection on compiled methods - https://pharo.fogbugz.com/f/cases/15889 - -15892 Cleanups: clean annotation handling + rename HookGenerator2 - https://pharo.fogbugz.com/f/cases/15892'. - self loadTogether: self script50152 merge: false. - self flushCaches. diff --git a/ScriptLoader50.package/ScriptLoader.class/instance/pharo - updates/update50153.st b/ScriptLoader50.package/ScriptLoader.class/instance/pharo - updates/update50153.st new file mode 100644 index 0000000000..d6fee63739 --- /dev/null +++ b/ScriptLoader50.package/ScriptLoader.class/instance/pharo - updates/update50153.st @@ -0,0 +1,15 @@ +update50153 + "self new update50153" + self withUpdateLog: '15890 some cleaning + https://pharo.fogbugz.com/f/cases/15890 + +15072 Senders and implementors do not work when one parameter is a string containing : + https://pharo.fogbugz.com/f/cases/15072 + +15899 Remove destructive example + https://pharo.fogbugz.com/f/cases/15899 + +15897 Load new Workspace from AlainPlantec/WorkspaceRevisited + https://pharo.fogbugz.com/f/cases/15897'. + self loadTogether: self script50153 merge: false. + self flushCaches. diff --git a/ScriptLoader50.package/ScriptLoader.class/instance/public/commentForCurrentUpdate.st b/ScriptLoader50.package/ScriptLoader.class/instance/public/commentForCurrentUpdate.st index c7d1cec0b0..1721d6fe66 100644 --- a/ScriptLoader50.package/ScriptLoader.class/instance/public/commentForCurrentUpdate.st +++ b/ScriptLoader50.package/ScriptLoader.class/instance/public/commentForCurrentUpdate.st @@ -1,12 +1,12 @@ commentForCurrentUpdate - ^ '7008 Shared Pools to be treated like dictionaries still necessary? - https://pharo.fogbugz.com/f/cases/7008 + ^ '15890 some cleaning + https://pharo.fogbugz.com/f/cases/15890 -15886 Find class dialog from a scope nautilus window shows all classes - https://pharo.fogbugz.com/f/cases/15886 +15072 Senders and implementors do not work when one parameter is a string containing : + https://pharo.fogbugz.com/f/cases/15072 -15889 do not call asOrderedCollection on compiled methods - https://pharo.fogbugz.com/f/cases/15889 +15899 Remove destructive example + https://pharo.fogbugz.com/f/cases/15899 -15892 Cleanups: clean annotation handling + rename HookGenerator2 - https://pharo.fogbugz.com/f/cases/15892' \ No newline at end of file +15897 Load new Workspace from AlainPlantec/WorkspaceRevisited + https://pharo.fogbugz.com/f/cases/15897' \ No newline at end of file diff --git a/StartupPreferences.package/StartupPreferencesLoader.class/class/example/example3.st b/StartupPreferences.package/StartupPreferencesLoader.class/class/example/example3.st deleted file mode 100644 index 1c737e8314..0000000000 --- a/StartupPreferences.package/StartupPreferencesLoader.class/class/example/example3.st +++ /dev/null @@ -1,10 +0,0 @@ -example3 - " it's my personal script provided as example" - "self example3" - | items | - items := OrderedCollection new. - items add: (StartupAction name: 'Self halt' code: [ self halt ]). "replace it by your name" - items add: (StartupAction name: 'WS' code: [ Workspace open ]). "replace it by your name" - StartupPreferencesLoader default addAtStartupInPreferenceVersionFolder: items named: 'author.st'. - - StartupPreferencesLoader default loadFromDefaultLocations. \ No newline at end of file diff --git a/Text-Edition.package/SmalltalkEditor.class/instance/menu messages/selectedSelector.st b/Text-Edition.package/SmalltalkEditor.class/instance/menu messages/selectedSelector.st index 440b918634..71e203f8e8 100644 --- a/Text-Edition.package/SmalltalkEditor.class/instance/menu messages/selectedSelector.st +++ b/Text-Edition.package/SmalltalkEditor.class/instance/menu messages/selectedSelector.st @@ -1,3 +1,7 @@ selectedSelector "Try to make a selector out of the current text selection" - ^self selection string findSelector \ No newline at end of file + | node | + node := RBParser parseFaultyExpression: self selection string. + node isMessage + ifTrue: [ ^ node selector ] + ifFalse: [ ^ node name ] \ No newline at end of file diff --git a/Tool-Workspace.package/RubWorkspaceBar.class/README.md b/Tool-Workspace.package/RubWorkspaceBar.class/README.md new file mode 100644 index 0000000000..fced63b95d --- /dev/null +++ b/Tool-Workspace.package/RubWorkspaceBar.class/README.md @@ -0,0 +1 @@ +A bottom bar to change the editing mode, switch with/without line numbers and switch wrapping mode \ No newline at end of file diff --git a/Tool-Workspace.package/RubWorkspaceBar.class/class/querying/key.st b/Tool-Workspace.package/RubWorkspaceBar.class/class/querying/key.st new file mode 100644 index 0000000000..312cc7ada2 --- /dev/null +++ b/Tool-Workspace.package/RubWorkspaceBar.class/class/querying/key.st @@ -0,0 +1,2 @@ +key + ^ #workspaceBar \ No newline at end of file diff --git a/Tool-Workspace.package/RubWorkspaceBar.class/definition.st b/Tool-Workspace.package/RubWorkspaceBar.class/definition.st new file mode 100644 index 0000000000..9d423d3a63 --- /dev/null +++ b/Tool-Workspace.package/RubWorkspaceBar.class/definition.st @@ -0,0 +1,5 @@ +RubScrolledTextSideRuler subclass: #RubWorkspaceBar + instanceVariableNames: 'row wrappingPolicyMorph editingModeMorph lineNumbersDisplayMorph' + classVariableNames: '' + poolDictionaries: '' + category: 'Tool-Workspace' \ No newline at end of file diff --git a/Tool-Workspace.package/RubWorkspaceBar.class/instance/accessing/backgroundColor.st b/Tool-Workspace.package/RubWorkspaceBar.class/instance/accessing/backgroundColor.st new file mode 100644 index 0000000000..2cc5a78683 --- /dev/null +++ b/Tool-Workspace.package/RubWorkspaceBar.class/instance/accessing/backgroundColor.st @@ -0,0 +1,2 @@ +backgroundColor + ^ self paragraphProvider backgroundColor darker \ No newline at end of file diff --git a/Tool-Workspace.package/RubWorkspaceBar.class/instance/accessing/fontToUse.st b/Tool-Workspace.package/RubWorkspaceBar.class/instance/accessing/fontToUse.st new file mode 100644 index 0000000000..f40ad35ad2 --- /dev/null +++ b/Tool-Workspace.package/RubWorkspaceBar.class/instance/accessing/fontToUse.st @@ -0,0 +1,2 @@ +fontToUse + ^ RubAbstractTextArea lineNumbersFont \ No newline at end of file diff --git a/Tool-Workspace.package/RubWorkspaceBar.class/instance/accessing/level.st b/Tool-Workspace.package/RubWorkspaceBar.class/instance/accessing/level.st new file mode 100644 index 0000000000..b33eb0118f --- /dev/null +++ b/Tool-Workspace.package/RubWorkspaceBar.class/instance/accessing/level.st @@ -0,0 +1,2 @@ +level + ^ 1 \ No newline at end of file diff --git a/Tool-Workspace.package/RubWorkspaceBar.class/instance/accessing/textColor.st b/Tool-Workspace.package/RubWorkspaceBar.class/instance/accessing/textColor.st new file mode 100644 index 0000000000..46e3d9acc7 --- /dev/null +++ b/Tool-Workspace.package/RubWorkspaceBar.class/instance/accessing/textColor.st @@ -0,0 +1,2 @@ +textColor + ^ self textArea lineNumbersTextColor muchDarker diff --git a/Tool-Workspace.package/RubWorkspaceBar.class/instance/event handling/updateContents.st b/Tool-Workspace.package/RubWorkspaceBar.class/instance/event handling/updateContents.st new file mode 100644 index 0000000000..819f9ed743 --- /dev/null +++ b/Tool-Workspace.package/RubWorkspaceBar.class/instance/event handling/updateContents.st @@ -0,0 +1,6 @@ +updateContents + row ifNil: [ ^self ]. + wrappingPolicyMorph contents: self wrappingPolicyLabel. + editingModeMorph contents: self editingModeLabel. + lineNumbersDisplayMorph contents: self lineNumbersDisplayLabel. + row bounds: self innerBounds \ No newline at end of file diff --git a/Tool-Workspace.package/RubWorkspaceBar.class/instance/geometry/computedHeightFrom_.st b/Tool-Workspace.package/RubWorkspaceBar.class/instance/geometry/computedHeightFrom_.st new file mode 100644 index 0000000000..4d9ec53c86 --- /dev/null +++ b/Tool-Workspace.package/RubWorkspaceBar.class/instance/geometry/computedHeightFrom_.st @@ -0,0 +1,2 @@ +computedHeightFrom: aRectangle + ^ row ifNil: [0] ifNotNil: [row height] \ No newline at end of file diff --git a/Tool-Workspace.package/RubWorkspaceBar.class/instance/geometry/computedWidthFrom_.st b/Tool-Workspace.package/RubWorkspaceBar.class/instance/geometry/computedWidthFrom_.st new file mode 100644 index 0000000000..9520a98321 --- /dev/null +++ b/Tool-Workspace.package/RubWorkspaceBar.class/instance/geometry/computedWidthFrom_.st @@ -0,0 +1,2 @@ +computedWidthFrom: aRectangle + ^ aRectangle width \ No newline at end of file diff --git a/Tool-Workspace.package/RubWorkspaceBar.class/instance/geometry/manageLayoutInBounds_.st b/Tool-Workspace.package/RubWorkspaceBar.class/instance/geometry/manageLayoutInBounds_.st new file mode 100644 index 0000000000..f1872f80b6 --- /dev/null +++ b/Tool-Workspace.package/RubWorkspaceBar.class/instance/geometry/manageLayoutInBounds_.st @@ -0,0 +1,5 @@ +manageLayoutInBounds: aRectangle + | ret | + ret := super manageLayoutInBounds: aRectangle. + self updateContents. + ^ ret \ No newline at end of file diff --git a/Tool-Workspace.package/RubWorkspaceBar.class/instance/initialize-release/initialize.st b/Tool-Workspace.package/RubWorkspaceBar.class/instance/initialize-release/initialize.st new file mode 100644 index 0000000000..0ce601b551 --- /dev/null +++ b/Tool-Workspace.package/RubWorkspaceBar.class/instance/initialize-release/initialize.st @@ -0,0 +1,3 @@ +initialize + super initialize. + self side: #bottom. diff --git a/Tool-Workspace.package/RubWorkspaceBar.class/instance/managing editing mode/chooseEditingMode_.st b/Tool-Workspace.package/RubWorkspaceBar.class/instance/managing editing mode/chooseEditingMode_.st new file mode 100644 index 0000000000..1495e53bc0 --- /dev/null +++ b/Tool-Workspace.package/RubWorkspaceBar.class/instance/managing editing mode/chooseEditingMode_.st @@ -0,0 +1,3 @@ +chooseEditingMode: anEvent + self modeListMenu invokeAt: anEvent position in: self world. + self updateContents \ No newline at end of file diff --git a/Tool-Workspace.package/RubWorkspaceBar.class/instance/managing editing mode/editingModeLabel.st b/Tool-Workspace.package/RubWorkspaceBar.class/instance/managing editing mode/editingModeLabel.st new file mode 100644 index 0000000000..65e1a87a64 --- /dev/null +++ b/Tool-Workspace.package/RubWorkspaceBar.class/instance/managing editing mode/editingModeLabel.st @@ -0,0 +1,2 @@ +editingModeLabel + ^ self paragraphProvider editingMode label \ No newline at end of file diff --git a/Tool-Workspace.package/RubWorkspaceBar.class/instance/managing editing mode/editingModeLabelMorph.st b/Tool-Workspace.package/RubWorkspaceBar.class/instance/managing editing mode/editingModeLabelMorph.st new file mode 100644 index 0000000000..3a91317f20 --- /dev/null +++ b/Tool-Workspace.package/RubWorkspaceBar.class/instance/managing editing mode/editingModeLabelMorph.st @@ -0,0 +1,4 @@ +editingModeLabelMorph + ^ StringMorph + contents: self editingModeLabel + font: self fontToUse \ No newline at end of file diff --git a/Tool-Workspace.package/RubWorkspaceBar.class/instance/managing editing mode/modeListMenu.st b/Tool-Workspace.package/RubWorkspaceBar.class/instance/managing editing mode/modeListMenu.st new file mode 100644 index 0000000000..99d53c9e82 --- /dev/null +++ b/Tool-Workspace.package/RubWorkspaceBar.class/instance/managing editing mode/modeListMenu.st @@ -0,0 +1,8 @@ +modeListMenu + "Answer the menu to be presented to select an editing mode" + + | menu | + menu := MenuMorph new. + menu add: 'Plain text' target: self selector: #switchToPlainTextMode. + menu add: 'Smalltalk scripting' target: self selector: #switchToSmalltalkScriptingMode. + ^ menu \ No newline at end of file diff --git a/Tool-Workspace.package/RubWorkspaceBar.class/instance/managing editing mode/switchToPlainTextMode.st b/Tool-Workspace.package/RubWorkspaceBar.class/instance/managing editing mode/switchToPlainTextMode.st new file mode 100644 index 0000000000..56aa2951e3 --- /dev/null +++ b/Tool-Workspace.package/RubWorkspaceBar.class/instance/managing editing mode/switchToPlainTextMode.st @@ -0,0 +1,2 @@ +switchToPlainTextMode + self paragraphProvider beForPlainText \ No newline at end of file diff --git a/Tool-Workspace.package/RubWorkspaceBar.class/instance/managing editing mode/switchToSmalltalkScriptingMode.st b/Tool-Workspace.package/RubWorkspaceBar.class/instance/managing editing mode/switchToSmalltalkScriptingMode.st new file mode 100644 index 0000000000..7e8629cb0a --- /dev/null +++ b/Tool-Workspace.package/RubWorkspaceBar.class/instance/managing editing mode/switchToSmalltalkScriptingMode.st @@ -0,0 +1,2 @@ +switchToSmalltalkScriptingMode + self paragraphProvider beForSmalltalkScripting \ No newline at end of file diff --git a/Tool-Workspace.package/RubWorkspaceBar.class/instance/managing line numbers/changeLineNumbersDisplay.st b/Tool-Workspace.package/RubWorkspaceBar.class/instance/managing line numbers/changeLineNumbersDisplay.st new file mode 100644 index 0000000000..0cfd8904e4 --- /dev/null +++ b/Tool-Workspace.package/RubWorkspaceBar.class/instance/managing line numbers/changeLineNumbersDisplay.st @@ -0,0 +1,6 @@ +changeLineNumbersDisplay + self paragraphProvider lineNumbersRuler + ifNil: [ self paragraphProvider withLineNumbers ] + ifNotNil: [ self paragraphProvider withoutLineNumbers ]. + self paragraphProvider manageLayout. + self updateContents \ No newline at end of file diff --git a/Tool-Workspace.package/RubWorkspaceBar.class/instance/managing line numbers/lineNumbersDisplayLabel.st b/Tool-Workspace.package/RubWorkspaceBar.class/instance/managing line numbers/lineNumbersDisplayLabel.st new file mode 100644 index 0000000000..d7e3a225f3 --- /dev/null +++ b/Tool-Workspace.package/RubWorkspaceBar.class/instance/managing line numbers/lineNumbersDisplayLabel.st @@ -0,0 +1,4 @@ +lineNumbersDisplayLabel + ^ self paragraphProvider lineNumbersRuler + ifNil: [ '+L' ] + ifNotNil: [ 'L' ] \ No newline at end of file diff --git a/Tool-Workspace.package/RubWorkspaceBar.class/instance/managing line numbers/lineNumbersDisplayLabelMorph.st b/Tool-Workspace.package/RubWorkspaceBar.class/instance/managing line numbers/lineNumbersDisplayLabelMorph.st new file mode 100644 index 0000000000..8bc74e3855 --- /dev/null +++ b/Tool-Workspace.package/RubWorkspaceBar.class/instance/managing line numbers/lineNumbersDisplayLabelMorph.st @@ -0,0 +1,4 @@ +lineNumbersDisplayLabelMorph + ^ StringMorph + contents: self lineNumbersDisplayLabel + font: self fontToUse \ No newline at end of file diff --git a/Tool-Workspace.package/RubWorkspaceBar.class/instance/managing wrapping policy/changeWrappingPolicy.st b/Tool-Workspace.package/RubWorkspaceBar.class/instance/managing wrapping policy/changeWrappingPolicy.st new file mode 100644 index 0000000000..8c07450610 --- /dev/null +++ b/Tool-Workspace.package/RubWorkspaceBar.class/instance/managing wrapping policy/changeWrappingPolicy.st @@ -0,0 +1,6 @@ +changeWrappingPolicy + self paragraphProvider wrapped + ifTrue: [ self paragraphProvider beNotWrapped ] + ifFalse: [ self paragraphProvider beWrapped ]. + self updateContents. + self paragraphProvider changed \ No newline at end of file diff --git a/Tool-Workspace.package/RubWorkspaceBar.class/instance/managing wrapping policy/wrappingPolicyLabel.st b/Tool-Workspace.package/RubWorkspaceBar.class/instance/managing wrapping policy/wrappingPolicyLabel.st new file mode 100644 index 0000000000..718d5d816e --- /dev/null +++ b/Tool-Workspace.package/RubWorkspaceBar.class/instance/managing wrapping policy/wrappingPolicyLabel.st @@ -0,0 +1,4 @@ +wrappingPolicyLabel + ^ self paragraphProvider wrapped + ifTrue: [ 'W' ] + ifFalse: [ 'NW' ] \ No newline at end of file diff --git a/Tool-Workspace.package/RubWorkspaceBar.class/instance/managing wrapping policy/wrappingPolicyLabelMorph.st b/Tool-Workspace.package/RubWorkspaceBar.class/instance/managing wrapping policy/wrappingPolicyLabelMorph.st new file mode 100644 index 0000000000..eccc2fab18 --- /dev/null +++ b/Tool-Workspace.package/RubWorkspaceBar.class/instance/managing wrapping policy/wrappingPolicyLabelMorph.st @@ -0,0 +1,4 @@ +wrappingPolicyLabelMorph + ^ StringMorph + contents: self wrappingPolicyLabel + font: self fontToUse \ No newline at end of file diff --git a/Tool-Workspace.package/RubWorkspaceBar.class/instance/private/spacer_.st b/Tool-Workspace.package/RubWorkspaceBar.class/instance/private/spacer_.st new file mode 100644 index 0000000000..15757ecfd9 --- /dev/null +++ b/Tool-Workspace.package/RubWorkspaceBar.class/instance/private/spacer_.st @@ -0,0 +1,5 @@ +spacer: anInteger + ^ Morph new + borderWidth: 0; + color: Color transparent; + extent: anInteger@3 \ No newline at end of file diff --git a/Tool-Workspace.package/RubWorkspaceBar.class/instance/submorphs-accessing/noteNewOwner_.st b/Tool-Workspace.package/RubWorkspaceBar.class/instance/submorphs-accessing/noteNewOwner_.st new file mode 100644 index 0000000000..d359f56431 --- /dev/null +++ b/Tool-Workspace.package/RubWorkspaceBar.class/instance/submorphs-accessing/noteNewOwner_.st @@ -0,0 +1,23 @@ +noteNewOwner: aMorph + super noteNewOwner: aMorph. + self color: self backgroundColor. + self paragraphProvider beForSmalltalkScripting. + wrappingPolicyMorph := self wrappingPolicyLabelMorph. + editingModeMorph := self editingModeLabelMorph. + lineNumbersDisplayMorph := self lineNumbersDisplayLabelMorph. + row := self theme + newRowIn: self + for: + {(self spacer: 2). + editingModeMorph. + (self spacer: 2). + wrappingPolicyMorph. + (self spacer: 2). + lineNumbersDisplayMorph. + (self spacer: 2)}. + wrappingPolicyMorph on: #mouseDown send: #changeWrappingPolicy to: self. + editingModeMorph on: #mouseDown send: #chooseEditingMode: to: self. + lineNumbersDisplayMorph on: #mouseDown send: #changeLineNumbersDisplay to: self. + row color: Color transparent. + row hResizing: #spaceFill. + self addMorph: row \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/README.md b/Tool-Workspace.package/Workspace.class/README.md index 70158129b7..f4c5407b6e 100644 --- a/Tool-Workspace.package/Workspace.class/README.md +++ b/Tool-Workspace.package/Workspace.class/README.md @@ -1 +1 @@ -A Workspace is a text area plus a lot of support for executable code. It is a great place to execute top-level commands to compute something useful, and it is a great place to develop bits of a program before those bits get put into class methods. To open a new workspace, execute: Workspace open A workspace can have its own variables, called "workspace variables", to hold intermediate results. For example, if you type into a workspace "x := 5" and do-it, then later you could type in "y := x * 2" and y would become 10. Additionally, in Morphic, a workspace can gain access to morphs that are on the screen. If acceptDroppedMorphss is turned on, then whenever a morph is dropped on the workspace, a variable will be created which references that morph. This functionality is toggled with the window-wide menu of a workspace. The instance variables of this class are: bindings - holds the workspace variables for this workspace acceptDroppedMorphss - whether dropped morphs should create new variables \ No newline at end of file +I'm workspace: a great place to execute top-level expressions to compute something useful, and it is a great place to develop bits of a program before those bits get put into class methods. To open a new workspace, execute one of the following expression: [[[ self open self openContents: '''Pharo is cool''' self openLabel: 'A cleaner workspace' self open label: 'Tutu' ]]] \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/class/accessing/lastContents.st b/Tool-Workspace.package/Workspace.class/class/accessing/lastContents.st new file mode 100644 index 0000000000..43d78486b0 --- /dev/null +++ b/Tool-Workspace.package/Workspace.class/class/accessing/lastContents.st @@ -0,0 +1,2 @@ +lastContents + ^ LastContents ifNil: [LastContents := OrderedCollection new] \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/class/accessing/maxKeptContents.st b/Tool-Workspace.package/Workspace.class/class/accessing/maxKeptContents.st new file mode 100644 index 0000000000..425840dedd --- /dev/null +++ b/Tool-Workspace.package/Workspace.class/class/accessing/maxKeptContents.st @@ -0,0 +1,2 @@ +maxKeptContents + ^ 30 \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/class/cleanup/cleanUp.st b/Tool-Workspace.package/Workspace.class/class/cleaning/cleanUp.st similarity index 100% rename from Tool-Workspace.package/Workspace.class/class/cleanup/cleanUp.st rename to Tool-Workspace.package/Workspace.class/class/cleaning/cleanUp.st diff --git a/Tool-Workspace.package/Workspace.class/class/file support/openFile_.st b/Tool-Workspace.package/Workspace.class/class/file support/openFile_.st deleted file mode 100644 index 69f15bf3bd..0000000000 --- a/Tool-Workspace.package/Workspace.class/class/file support/openFile_.st +++ /dev/null @@ -1,7 +0,0 @@ -openFile: aFileName - "Open a new workspace associated with the given file" - - ^ self new - open; - openFile: aFileName; - yourself \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/class/instance creation/open.st b/Tool-Workspace.package/Workspace.class/class/instance creation/open.st index d9fe9621b7..bd205d0e7a 100644 --- a/Tool-Workspace.package/Workspace.class/class/instance creation/open.st +++ b/Tool-Workspace.package/Workspace.class/class/instance creation/open.st @@ -1,2 +1,2 @@ open - ^ self openLabel: self title \ No newline at end of file + ^ self new openLabel: self title ; yourself \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/class/instance creation/openContents_.st b/Tool-Workspace.package/Workspace.class/class/instance creation/openContents_.st index 11532e5720..fa9b071eba 100644 --- a/Tool-Workspace.package/Workspace.class/class/instance creation/openContents_.st +++ b/Tool-Workspace.package/Workspace.class/class/instance creation/openContents_.st @@ -1,8 +1,7 @@ openContents: aString - "Open a new workspace with the given contents. aString has to be Smalltalk code. The style is applied" - + "Open a new workspace with the given contents. It looks better when aString is code since the style is applied" + ^ self new open; - contents: aString; - changed: #contents; + contents: aString; yourself \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/class/instance creation/openContents_label_.st b/Tool-Workspace.package/Workspace.class/class/instance creation/openContents_label_.st deleted file mode 100644 index 43677666ab..0000000000 --- a/Tool-Workspace.package/Workspace.class/class/instance creation/openContents_label_.st +++ /dev/null @@ -1,8 +0,0 @@ -openContents: aString label: aLabel - "Open a new workspace with the given contents" - - ^ self new - openLabel: aLabel; - contents: aString; - changed: #contents; - yourself \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/class/instance creation/title.st b/Tool-Workspace.package/Workspace.class/class/instance creation/title.st index feec3a4819..3f4b16f6e8 100644 --- a/Tool-Workspace.package/Workspace.class/class/instance creation/title.st +++ b/Tool-Workspace.package/Workspace.class/class/instance creation/title.st @@ -1,2 +1,2 @@ -title +title ^ 'Workspace' \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/class/tools registry/registerToolsOn_.st b/Tool-Workspace.package/Workspace.class/class/tool registry/registerToolsOn_.st similarity index 100% rename from Tool-Workspace.package/Workspace.class/class/tools registry/registerToolsOn_.st rename to Tool-Workspace.package/Workspace.class/class/tool registry/registerToolsOn_.st diff --git a/Tool-Workspace.package/Workspace.class/definition.st b/Tool-Workspace.package/Workspace.class/definition.st index 4286602928..d77d7dd8b3 100644 --- a/Tool-Workspace.package/Workspace.class/definition.st +++ b/Tool-Workspace.package/Workspace.class/definition.st @@ -1,5 +1,5 @@ Model subclass: #Workspace - instanceVariableNames: 'bindings acceptDroppedMorphs acceptAction mustDeclareVariables fileName lineEnding encoding stylingActive contents window' + instanceVariableNames: 'textModel bindings window fileName lineEnding encoding' classVariableNames: 'LastContents' poolDictionaries: '' category: 'Tool-Workspace' \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/accessing/acceptAction_.st b/Tool-Workspace.package/Workspace.class/instance/accessing/acceptAction_.st deleted file mode 100644 index b59656d781..0000000000 --- a/Tool-Workspace.package/Workspace.class/instance/accessing/acceptAction_.st +++ /dev/null @@ -1,2 +0,0 @@ -acceptAction: anAction - acceptAction := anAction \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/accessing/acceptContents_.st b/Tool-Workspace.package/Workspace.class/instance/accessing/acceptContents_.st deleted file mode 100644 index 257a1177a8..0000000000 --- a/Tool-Workspace.package/Workspace.class/instance/accessing/acceptContents_.st +++ /dev/null @@ -1,6 +0,0 @@ -acceptContents: aString - - self fileName ifNotNil: [ self saveString: aString asString toFile: self fileName ]. - acceptAction ifNotNil: [ acceptAction value: aString ]. - self contents: aString. - ^ true \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/accessing/codeTextMorph.st b/Tool-Workspace.package/Workspace.class/instance/accessing/codeTextMorph.st deleted file mode 100644 index 28d8eebf31..0000000000 --- a/Tool-Workspace.package/Workspace.class/instance/accessing/codeTextMorph.st +++ /dev/null @@ -1,5 +0,0 @@ -codeTextMorph - ^ self dependents - detect: [ :dep | (dep isKindOf: PluggableTextMorph) - and: [ dep getTextSelector == #contents ]] - ifNone: [] \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/accessing/contents.st b/Tool-Workspace.package/Workspace.class/instance/accessing/contents.st index 3c68f003b8..6ef5b6e899 100644 --- a/Tool-Workspace.package/Workspace.class/instance/accessing/contents.st +++ b/Tool-Workspace.package/Workspace.class/instance/accessing/contents.st @@ -1,3 +1,3 @@ contents - - ^ contents ifNil: [ contents := '' ] \ No newline at end of file + + ^ textModel getText \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/accessing/contents_.st b/Tool-Workspace.package/Workspace.class/instance/accessing/contents_.st index 5b15845a13..6d7ab74648 100644 --- a/Tool-Workspace.package/Workspace.class/instance/accessing/contents_.st +++ b/Tool-Workspace.package/Workspace.class/instance/accessing/contents_.st @@ -1,3 +1,3 @@ -contents: stringOrText - contents := stringOrText. - self changed: #contents. \ No newline at end of file +contents: aString + + ^ textModel setText: aString \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/accessing/doItContext.st b/Tool-Workspace.package/Workspace.class/instance/accessing/doItContext.st new file mode 100644 index 0000000000..c13f0b1d2c --- /dev/null +++ b/Tool-Workspace.package/Workspace.class/instance/accessing/doItContext.st @@ -0,0 +1,2 @@ +doItContext + ^ nil \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/accessing/doItReceiver.st b/Tool-Workspace.package/Workspace.class/instance/accessing/doItReceiver.st new file mode 100644 index 0000000000..2acf2c1be5 --- /dev/null +++ b/Tool-Workspace.package/Workspace.class/instance/accessing/doItReceiver.st @@ -0,0 +1,2 @@ +doItReceiver + ^ nil \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/accessing/label_.st b/Tool-Workspace.package/Workspace.class/instance/accessing/label_.st index 837023c6d2..bac8bb0695 100644 --- a/Tool-Workspace.package/Workspace.class/instance/accessing/label_.st +++ b/Tool-Workspace.package/Workspace.class/instance/accessing/label_.st @@ -1,6 +1,3 @@ label: aString - "Set the window label to the given string" - self containingWindow setLabel: aString - - \ No newline at end of file + window title: aString \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/accessing/lastContents.st b/Tool-Workspace.package/Workspace.class/instance/accessing/lastContents.st index 488ebbeb2f..8832bdf66b 100644 --- a/Tool-Workspace.package/Workspace.class/instance/accessing/lastContents.st +++ b/Tool-Workspace.package/Workspace.class/instance/accessing/lastContents.st @@ -1,3 +1,2 @@ lastContents - LastContents ifNil: [LastContents := OrderedCollection new]. - ^ LastContents \ No newline at end of file + ^ self class lastContents \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/accessing/maxKeptContents.st b/Tool-Workspace.package/Workspace.class/instance/accessing/maxKeptContents.st new file mode 100644 index 0000000000..53924d0c8f --- /dev/null +++ b/Tool-Workspace.package/Workspace.class/instance/accessing/maxKeptContents.st @@ -0,0 +1,2 @@ +maxKeptContents + ^ self class maxKeptContents \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/accessing/mustDeclareVariables_.st b/Tool-Workspace.package/Workspace.class/instance/accessing/mustDeclareVariables_.st deleted file mode 100644 index e94162db90..0000000000 --- a/Tool-Workspace.package/Workspace.class/instance/accessing/mustDeclareVariables_.st +++ /dev/null @@ -1,3 +0,0 @@ -mustDeclareVariables: aBoolean - - mustDeclareVariables := aBoolean \ No newline at end of file diff --git a/NECompletion.package/extension/Workspace/instance/selectedClassOrMetaClass.st b/Tool-Workspace.package/Workspace.class/instance/accessing/selectedClassOrMetaClass.st similarity index 80% rename from NECompletion.package/extension/Workspace/instance/selectedClassOrMetaClass.st rename to Tool-Workspace.package/Workspace.class/instance/accessing/selectedClassOrMetaClass.st index d694a6dd09..b08dc21b4a 100644 --- a/NECompletion.package/extension/Workspace/instance/selectedClassOrMetaClass.st +++ b/Tool-Workspace.package/Workspace.class/instance/accessing/selectedClassOrMetaClass.st @@ -1,2 +1,2 @@ selectedClassOrMetaClass - ^nil + ^ nil \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/binding/bindingOf_.st b/Tool-Workspace.package/Workspace.class/instance/binding/bindingOf_.st deleted file mode 100644 index fcc0a6125a..0000000000 --- a/Tool-Workspace.package/Workspace.class/instance/binding/bindingOf_.st +++ /dev/null @@ -1,9 +0,0 @@ -bindingOf: aString - - mustDeclareVariables ifTrue: [^ nil]. - "I want to have workspace that force the user to declare - variables. Still subclasses may want to do something else" - bindings ifNil: [ self initializeBindings ]. - (bindings includesKey: aString) - ifFalse: [ bindings add: (WorkspaceVariable key: aString asSymbol) ]. - ^ bindings associationAt: aString \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/configuration/historyLength.st b/Tool-Workspace.package/Workspace.class/instance/configuration/historyLength.st deleted file mode 100644 index bf8c52550f..0000000000 --- a/Tool-Workspace.package/Workspace.class/instance/configuration/historyLength.st +++ /dev/null @@ -1,3 +0,0 @@ -historyLength - "Number of contents being stored" - ^ 5 \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/drag and drop/acceptDroppingMorph_event_inMorph_.st b/Tool-Workspace.package/Workspace.class/instance/drag and drop/acceptDroppingMorph_event_inMorph_.st deleted file mode 100644 index c733389664..0000000000 --- a/Tool-Workspace.package/Workspace.class/instance/drag and drop/acceptDroppingMorph_event_inMorph_.st +++ /dev/null @@ -1,12 +0,0 @@ -acceptDroppingMorph: dropee event: evt inMorph: targetMorph - "Return the dropee to its old position, and add a reference to it at the cursor point." - - | bindingName externalName | - externalName := dropee externalName. - externalName := externalName isOctetString - ifTrue: [externalName] ifFalse: ['a' , externalName]. - bindingName := externalName translateToLowercase, dropee identityHash printString. - targetMorph correctSelectionWithString: bindingName, ' '. - (self bindingOf: bindingName) value: dropee. - dropee rejectDropMorphEvent: evt. - ^ true "success" diff --git a/Tool-Workspace.package/Workspace.class/instance/drag and drop/acceptsDroppingMorphForReference.st b/Tool-Workspace.package/Workspace.class/instance/drag and drop/acceptsDroppingMorphForReference.st deleted file mode 100644 index 90ac92fdfd..0000000000 --- a/Tool-Workspace.package/Workspace.class/instance/drag and drop/acceptsDroppingMorphForReference.st +++ /dev/null @@ -1,4 +0,0 @@ -acceptsDroppingMorphForReference - - ^ acceptDroppedMorphs - diff --git a/Tool-Workspace.package/Workspace.class/instance/drag and drop/toggleDroppingMorphForReference.st b/Tool-Workspace.package/Workspace.class/instance/drag and drop/toggleDroppingMorphForReference.st deleted file mode 100644 index aa3fe81945..0000000000 --- a/Tool-Workspace.package/Workspace.class/instance/drag and drop/toggleDroppingMorphForReference.st +++ /dev/null @@ -1,4 +0,0 @@ -toggleDroppingMorphForReference - - acceptDroppedMorphs := acceptDroppedMorphs not. - diff --git a/Tool-Workspace.package/Workspace.class/instance/drag and drop/wantsDroppedMorph_event_inMorph_.st b/Tool-Workspace.package/Workspace.class/instance/drag and drop/wantsDroppedMorph_event_inMorph_.st deleted file mode 100644 index a155f6485c..0000000000 --- a/Tool-Workspace.package/Workspace.class/instance/drag and drop/wantsDroppedMorph_event_inMorph_.st +++ /dev/null @@ -1,4 +0,0 @@ -wantsDroppedMorph: dropee event: evt inMorph: target - - ^ acceptDroppedMorphs - diff --git a/Tool-Workspace.package/Workspace.class/instance/file support/openFile_.st b/Tool-Workspace.package/Workspace.class/instance/file support/openFile_.st index f23508ea87..3a0598a8eb 100644 --- a/Tool-Workspace.package/Workspace.class/instance/file support/openFile_.st +++ b/Tool-Workspace.package/Workspace.class/instance/file support/openFile_.st @@ -1,9 +1,6 @@ openFile: aFileName "Load file content into this workspace. If successful, associate the workspace with this file and change its label" - - aFileName isEmptyOrNil ifTrue: [ ^ self ]. - self contents: (self readStringFromFile: aFileName). + self readStringFromFile: aFileName. self fileName: aFileName. - self label: aFileName. - self changed: #contents \ No newline at end of file + self label: aFileName. \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/file support/readStringFromFile_.st b/Tool-Workspace.package/Workspace.class/instance/file support/readStringFromFile_.st index c150ec8b02..7845afdc02 100644 --- a/Tool-Workspace.package/Workspace.class/instance/file support/readStringFromFile_.st +++ b/Tool-Workspace.package/Workspace.class/instance/file support/readStringFromFile_.st @@ -1,11 +1,7 @@ -readStringFromFile: aFileName - "Read the content of the given file. Perform line endings normalization." - | content | - FileStream - oldFileNamed: aFileName - do: [ :f | - f converter: (TextConverter newForEncoding: encoding). - f wantsLineEndConversion: true. - content := f contents. - lineEnding := f lineEndConvention ]. - ^ content \ No newline at end of file +readStringFromFile: aFileName + "Read the content of the given file." + + | readStream fileContent | + readStream := (File named: aFileName) openForRead readStream. + fileContent := ZnCharacterReadStream on: readStream encoding: encoding. + self contents: fileContent upToEnd asString \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/file support/saveString_toFile_.st b/Tool-Workspace.package/Workspace.class/instance/file support/saveString_toFile_.st index a45ff727c1..e58f1647d8 100644 --- a/Tool-Workspace.package/Workspace.class/instance/file support/saveString_toFile_.st +++ b/Tool-Workspace.package/Workspace.class/instance/file support/saveString_toFile_.st @@ -1,10 +1,7 @@ saveString: aString toFile: aFileName "Save the given string to the given file" - - FileStream forceNewFileNamed: aFileName do: - [ :stream | - stream converter: (TextConverter newForEncoding: encoding). - stream wantsLineEndConversion: true. - stream lineEndConvention: lineEnding. - stream nextPutAll: aString ]. - \ No newline at end of file + + | writeStream fileContent | + writeStream := (File named: aFileName) openForWrite writeStream. + fileContent := ZnCharacterWriteStream on: writeStream encoding: encoding. + fileContent nextPutAll: aString \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/file support/suggestedFileName.st b/Tool-Workspace.package/Workspace.class/instance/file support/suggestedFileName.st index 4b7cd5dd7e..76bd9e2fd9 100644 --- a/Tool-Workspace.package/Workspace.class/instance/file support/suggestedFileName.st +++ b/Tool-Workspace.package/Workspace.class/instance/file support/suggestedFileName.st @@ -2,7 +2,4 @@ suggestedFileName "If the workspace has an associated fileName use that, otherwise derive a reasonable file-name from the window label" self fileName ifNotNil: [ :f | ^ f ]. - - ^ (self containingWindow - ifNil: ['Untitled'] - ifNotNil: [ :window | window label ]), '.ws' \ No newline at end of file + ^ window title, '.ws' \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/history/okToChange.st b/Tool-Workspace.package/Workspace.class/instance/history/okToChange.st deleted file mode 100644 index 3876c4655c..0000000000 --- a/Tool-Workspace.package/Workspace.class/instance/history/okToChange.st +++ /dev/null @@ -1,13 +0,0 @@ -okToChange - "This method is called by SystemWindow just before closing a workspace window. - The caller of this method is SystemWindow>>delete" - - | textMorphs textMorph contentAsString | - textMorphs := self dependents select: [:c | c isKindOf: PluggableTextMorph]. - textMorphs ifEmpty: [ ^ true ]. "This case should normally not happen" - - textMorph := textMorphs first. - contentAsString := (textMorph text) asString. - self lastContents addFirst: contentAsString. - self trimHistoryIfNecessary. - ^ true \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/history/setContent_.st b/Tool-Workspace.package/Workspace.class/instance/history/setContent_.st deleted file mode 100644 index 40a09934cd..0000000000 --- a/Tool-Workspace.package/Workspace.class/instance/history/setContent_.st +++ /dev/null @@ -1,7 +0,0 @@ -setContent: aString - | textMorphs textMorph | - textMorphs := self dependents select: [:c | c isKindOf: PluggableTextMorph]. - textMorphs ifEmpty: [ ^ self ]. "This case should normally not happen" - - textMorph := textMorphs first. - textMorph setText: aString \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/history/trimHistoryIfNecessary.st b/Tool-Workspace.package/Workspace.class/instance/history/trimHistoryIfNecessary.st deleted file mode 100644 index 26a69a5cb7..0000000000 --- a/Tool-Workspace.package/Workspace.class/instance/history/trimHistoryIfNecessary.st +++ /dev/null @@ -1,3 +0,0 @@ -trimHistoryIfNecessary - (self lastContents size > self historyLength) - ifTrue: [ LastContents := LastContents copyFrom: 1 to: self historyLength ] \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/initialization/defaultTextModel.st b/Tool-Workspace.package/Workspace.class/instance/initialization/defaultTextModel.st new file mode 100644 index 0000000000..3325997374 --- /dev/null +++ b/Tool-Workspace.package/Workspace.class/instance/initialization/defaultTextModel.st @@ -0,0 +1,2 @@ +defaultTextModel + ^ RubScrolledTextModel new interactionModel: self \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/initialization/initialExtent.st b/Tool-Workspace.package/Workspace.class/instance/initialization/initialExtent.st deleted file mode 100644 index ce30ef909c..0000000000 --- a/Tool-Workspace.package/Workspace.class/instance/initialization/initialExtent.st +++ /dev/null @@ -1,4 +0,0 @@ -initialExtent - "Start small. Window aspect ratio is 5 sqrt::1" - - ^ 450@200 \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/initialization/initialize.st b/Tool-Workspace.package/Workspace.class/instance/initialization/initialize.st index b9bcbb89a9..f267830b43 100644 --- a/Tool-Workspace.package/Workspace.class/instance/initialization/initialize.st +++ b/Tool-Workspace.package/Workspace.class/instance/initialization/initialize.st @@ -1,12 +1,5 @@ initialize - super initialize. - contents := ''. - acceptDroppedMorphs := false. - mustDeclareVariables := false. - lineEnding := #cr. - "try to guess default line ending" - Smalltalk os isWindows ifTrue: [lineEnding := #crlf]. - Smalltalk os isUnix ifTrue: [lineEnding := #lf]. - - encoding := TextConverter default class encodingNames first. \ No newline at end of file + textModel := self defaultTextModel. + encoding := TextConverter default class encodingNames first. + self initializeBindings \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/binding/initializeBindings.st b/Tool-Workspace.package/Workspace.class/instance/initialization/initializeBindings.st similarity index 100% rename from Tool-Workspace.package/Workspace.class/instance/binding/initializeBindings.st rename to Tool-Workspace.package/Workspace.class/instance/initialization/initializeBindings.st diff --git a/Tool-Workspace.package/Workspace.class/instance/initialization/openLabel_.st b/Tool-Workspace.package/Workspace.class/instance/initialization/openLabel_.st deleted file mode 100644 index 8b8d780608..0000000000 --- a/Tool-Workspace.package/Workspace.class/instance/initialization/openLabel_.st +++ /dev/null @@ -1,7 +0,0 @@ -openLabel: labelString - - window := (SystemWindow labelled: labelString). - window model: self. - window addMorph: self buildTextMorph frame: (0@0 corner: 1@1). - window openInWorld. - ^ window \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/menu/selectedMethod.st b/Tool-Workspace.package/Workspace.class/instance/menu/selectedMethod.st new file mode 100644 index 0000000000..4bd0190275 --- /dev/null +++ b/Tool-Workspace.package/Workspace.class/instance/menu/selectedMethod.st @@ -0,0 +1,2 @@ +selectedMethod + ^ nil \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/other menus/shiftedYellowButtonMenu.st b/Tool-Workspace.package/Workspace.class/instance/menu/shiftedYellowButtonMenu.st similarity index 100% rename from Tool-Workspace.package/Workspace.class/instance/other menus/shiftedYellowButtonMenu.st rename to Tool-Workspace.package/Workspace.class/instance/menu/shiftedYellowButtonMenu.st diff --git a/Tool-Workspace.package/Workspace.class/instance/menu/yellowButtonMenu.st b/Tool-Workspace.package/Workspace.class/instance/menu/yellowButtonMenu.st new file mode 100644 index 0000000000..feeee20dbe --- /dev/null +++ b/Tool-Workspace.package/Workspace.class/instance/menu/yellowButtonMenu.st @@ -0,0 +1,2 @@ +yellowButtonMenu + ^ (PragmaMenuBuilder pragmaKeyword: SmalltalkEditor smalltalkEditorMenuKeyword model: self) menu \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/other menus/codePaneMenu_shifted_.st b/Tool-Workspace.package/Workspace.class/instance/other menus/codePaneMenu_shifted_.st deleted file mode 100644 index 5abbc7a0c0..0000000000 --- a/Tool-Workspace.package/Workspace.class/instance/other menus/codePaneMenu_shifted_.st +++ /dev/null @@ -1,9 +0,0 @@ -codePaneMenu: aMenu shifted: shifted - "Note that unless we override perform:orSendTo:, - PluggableTextController will respond to all menu items in a - text pane" - | donorMenu | - donorMenu := shifted - ifTrue: [self shiftedYellowButtonMenu] - ifFalse: [self yellowButtonMenu]. - ^ aMenu addAllFrom: donorMenu \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/other menus/yellowButtonMenu.st b/Tool-Workspace.package/Workspace.class/instance/other menus/yellowButtonMenu.st deleted file mode 100644 index 48e657c9db..0000000000 --- a/Tool-Workspace.package/Workspace.class/instance/other menus/yellowButtonMenu.st +++ /dev/null @@ -1,4 +0,0 @@ -yellowButtonMenu - ^ (PragmaMenuBuilder - pragmaKeyword: SmalltalkEditor smalltalkEditorMenuKeyword - model: self) menu diff --git a/Tool-Workspace.package/Workspace.class/instance/shout bindings/guessTypeForName_.st b/Tool-Workspace.package/Workspace.class/instance/shout bindings/guessTypeForName_.st new file mode 100644 index 0000000000..433244859c --- /dev/null +++ b/Tool-Workspace.package/Workspace.class/instance/shout bindings/guessTypeForName_.st @@ -0,0 +1,8 @@ +guessTypeForName: aString + | binding | + bindings + ifNotNil: [ + binding := bindings at: aString ifAbsent: [ nil ]. + binding isNil + ifFalse: [ ^ binding class ] ]. + ^ nil \ No newline at end of file diff --git a/NECompletion.package/extension/Workspace/instance/hasBindingOf_.st b/Tool-Workspace.package/Workspace.class/instance/shout bindings/hasBindingOf_.st similarity index 100% rename from NECompletion.package/extension/Workspace/instance/hasBindingOf_.st rename to Tool-Workspace.package/Workspace.class/instance/shout bindings/hasBindingOf_.st diff --git a/Tool-Workspace.package/Workspace.class/instance/shout bindings/hasBindingThatBeginsWith_.st b/Tool-Workspace.package/Workspace.class/instance/shout bindings/hasBindingThatBeginsWith_.st new file mode 100644 index 0000000000..4c38e7c127 --- /dev/null +++ b/Tool-Workspace.package/Workspace.class/instance/shout bindings/hasBindingThatBeginsWith_.st @@ -0,0 +1,2 @@ +hasBindingThatBeginsWith: aString + ^ bindings keys anySatisfy: [:each | each beginsWith: aString] \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/styling/shoutAboutToStyle_.st b/Tool-Workspace.package/Workspace.class/instance/styling/shoutAboutToStyle_.st deleted file mode 100644 index 8a262d301e..0000000000 --- a/Tool-Workspace.package/Workspace.class/instance/styling/shoutAboutToStyle_.st +++ /dev/null @@ -1,2 +0,0 @@ -shoutAboutToStyle: aPluggableShoutMorphOrView - ^ self stylingActive \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/styling/stylingActive.st b/Tool-Workspace.package/Workspace.class/instance/styling/stylingActive.st deleted file mode 100644 index 4c78f5654a..0000000000 --- a/Tool-Workspace.package/Workspace.class/instance/styling/stylingActive.st +++ /dev/null @@ -1,3 +0,0 @@ -stylingActive - - ^ stylingActive ifNil: [ stylingActive := true ] \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/styling/stylingActiveString.st b/Tool-Workspace.package/Workspace.class/instance/styling/stylingActiveString.st deleted file mode 100644 index 26270a9ea2..0000000000 --- a/Tool-Workspace.package/Workspace.class/instance/styling/stylingActiveString.st +++ /dev/null @@ -1,3 +0,0 @@ -stylingActiveString - - ^ self stylingActive -> 'syntax highlighting' translated \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/styling/toggleStylingActive.st b/Tool-Workspace.package/Workspace.class/instance/styling/toggleStylingActive.st deleted file mode 100644 index bbe75befa2..0000000000 --- a/Tool-Workspace.package/Workspace.class/instance/styling/toggleStylingActive.st +++ /dev/null @@ -1,5 +0,0 @@ -toggleStylingActive - - ^ stylingActive := self stylingActive not - - \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/toolbuilder/buildTextMorph.st b/Tool-Workspace.package/Workspace.class/instance/toolbuilder/buildTextMorph.st deleted file mode 100644 index 1983cd5d56..0000000000 --- a/Tool-Workspace.package/Workspace.class/instance/toolbuilder/buildTextMorph.st +++ /dev/null @@ -1,14 +0,0 @@ -buildTextMorph - | morph | - - morph := PluggableTextMorph - on: self - text: #contents - accept: #acceptContents: - readSelection: nil - menu: #codePaneMenu:shifted:. - - morph font: StandardFonts codeFont. - morph styler workspace: self. - - ^ morph \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/update/whenTextAccepted_.st b/Tool-Workspace.package/Workspace.class/instance/update/whenTextAccepted_.st new file mode 100644 index 0000000000..6150406cff --- /dev/null +++ b/Tool-Workspace.package/Workspace.class/instance/update/whenTextAccepted_.st @@ -0,0 +1,4 @@ +whenTextAccepted: anAnnouncement + self lastContents size > self maxKeptContents + ifTrue: [ self lastContents removeFirst ]. + self lastContents add: textModel getText copy \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/variable declarations/mustDeclareVariableWording.st b/Tool-Workspace.package/Workspace.class/instance/variable declarations/mustDeclareVariableWording.st deleted file mode 100644 index c6524b0061..0000000000 --- a/Tool-Workspace.package/Workspace.class/instance/variable declarations/mustDeclareVariableWording.st +++ /dev/null @@ -1,3 +0,0 @@ -mustDeclareVariableWording - - ^ mustDeclareVariables -> 'Automatically create variable declaration' translated \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/variable declarations/toggleVariableDeclarationMode.st b/Tool-Workspace.package/Workspace.class/instance/variable declarations/toggleVariableDeclarationMode.st deleted file mode 100644 index 4b1e4370d7..0000000000 --- a/Tool-Workspace.package/Workspace.class/instance/variable declarations/toggleVariableDeclarationMode.st +++ /dev/null @@ -1,3 +0,0 @@ -toggleVariableDeclarationMode - - mustDeclareVariables := mustDeclareVariables not \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/variable definitions/bindingOf_.st b/Tool-Workspace.package/Workspace.class/instance/variable definitions/bindingOf_.st new file mode 100644 index 0000000000..7bfe2e2aba --- /dev/null +++ b/Tool-Workspace.package/Workspace.class/instance/variable definitions/bindingOf_.st @@ -0,0 +1,4 @@ +bindingOf: aString + (bindings includesKey: aString) + ifFalse: [ bindings add: (WorkspaceVariable key: aString asSymbol) ]. + ^ bindings associationAt: aString \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/binding/browseBindings.st b/Tool-Workspace.package/Workspace.class/instance/variable definitions/browseBindings.st similarity index 100% rename from Tool-Workspace.package/Workspace.class/instance/binding/browseBindings.st rename to Tool-Workspace.package/Workspace.class/instance/variable definitions/browseBindings.st diff --git a/Tool-Workspace.package/Workspace.class/instance/opening/open.st b/Tool-Workspace.package/Workspace.class/instance/view/open.st similarity index 100% rename from Tool-Workspace.package/Workspace.class/instance/opening/open.st rename to Tool-Workspace.package/Workspace.class/instance/view/open.st diff --git a/Tool-Workspace.package/Workspace.class/instance/view/openLabel_.st b/Tool-Workspace.package/Workspace.class/instance/view/openLabel_.st new file mode 100644 index 0000000000..40a7efe248 --- /dev/null +++ b/Tool-Workspace.package/Workspace.class/instance/view/openLabel_.st @@ -0,0 +1,10 @@ +openLabel: aString + + window := StandardWindow new model: self. + window title: aString. + window + addMorph: self textView + fullFrame: LayoutFrame identity. + window openInWorld + + diff --git a/Tool-Workspace.package/Workspace.class/instance/view/textView.st b/Tool-Workspace.package/Workspace.class/instance/view/textView.st new file mode 100644 index 0000000000..de25929090 --- /dev/null +++ b/Tool-Workspace.package/Workspace.class/instance/view/textView.st @@ -0,0 +1,8 @@ +textView + | v | + v := textModel newScrolledText + withRuler: RubWorkspaceBar new; + beWrapped; + yourself. + v announcer subscribe: RubTextAccepted send: #whenTextAccepted: to: self. + ^ v \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/window menu/acceptDroppedMorphsWording.st b/Tool-Workspace.package/Workspace.class/instance/window menu/acceptDroppedMorphsWording.st deleted file mode 100644 index e7c84c8ed1..0000000000 --- a/Tool-Workspace.package/Workspace.class/instance/window menu/acceptDroppedMorphsWording.st +++ /dev/null @@ -1,4 +0,0 @@ -acceptDroppedMorphsWording - - ^ self acceptsDroppingMorphForReference -> 'Create textual references to dropped morphs' translated - \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/window menu/addModelItemsToWindowMenu_.st b/Tool-Workspace.package/Workspace.class/instance/window menu/addModelItemsToWindowMenu_.st index 324f956a5f..6103f57356 100644 --- a/Tool-Workspace.package/Workspace.class/instance/window menu/addModelItemsToWindowMenu_.st +++ b/Tool-Workspace.package/Workspace.class/instance/window menu/addModelItemsToWindowMenu_.st @@ -1,10 +1,9 @@ addModelItemsToWindowMenu: aMenu aMenu addLine. - aMenu add: 'Open...' target: self selector: #openMenuAction. + aMenu add: 'Open...' target: self selector: #openMenuAction. aMenu lastItem icon: Smalltalk ui icons smallOpenIcon. - aMenu add: 'Save as...' target: self selector: #saveAsMenuAction. + aMenu add: 'Save as...' target: self selector: #saveAsMenuAction. aMenu lastItem icon: Smalltalk ui icons smallSaveAsIcon. - self fileName ifNotNil: [ aMenu add: 'Reload' target: self selector: #reloadMenuAction ]. aMenu addLine. aMenu add: 'Encoding' @@ -19,26 +18,7 @@ addModelItemsToWindowMenu: aMenu argumentList: {ea} ]. menu ] value: (UIManager default newMenuIn: self for: self)). aMenu addLine. - aMenu - addUpdating: #itemForCr - target: self - selector: #useLineEnding: - argumentList: {#cr}. - aMenu - addUpdating: #itemForLf - target: self - selector: #useLineEnding: - argumentList: {#lf}. - aMenu - addUpdating: #itemForCrLf - target: self - selector: #useLineEnding: - argumentList: {#crlf}. - aMenu addLine. - aMenu add: 'Inspect variables' target: self selector: #browseBindings. - aMenu add: 'Reset variables' target: self selector: #initializeBindings. - aMenu addUpdating: #mustDeclareVariableWording target: self selector: #toggleVariableDeclarationMode. - aMenu addUpdating: #acceptDroppedMorphsWording target: self selector: #toggleDroppingMorphForReference. + aMenu add: 'Inspect variables' target: self selector: #browseBindings. + aMenu add: 'Reset variables' target: self selector: #initializeBindings. aMenu add: 'Previous contents...' target: self selector: #selectPreviousContent. - aMenu addLine. - aMenu addUpdating: #stylingActiveString target: self selector: #toggleStylingActive \ No newline at end of file + aMenu addLine \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/window menu/itemForCr.st b/Tool-Workspace.package/Workspace.class/instance/window menu/itemForCr.st deleted file mode 100644 index 9886dbd656..0000000000 --- a/Tool-Workspace.package/Workspace.class/instance/window menu/itemForCr.st +++ /dev/null @@ -1,2 +0,0 @@ -itemForCr - ^ (lineEnding = #cr) -> 'CR' \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/window menu/itemForCrLf.st b/Tool-Workspace.package/Workspace.class/instance/window menu/itemForCrLf.st deleted file mode 100644 index 9c06ccac06..0000000000 --- a/Tool-Workspace.package/Workspace.class/instance/window menu/itemForCrLf.st +++ /dev/null @@ -1,2 +0,0 @@ -itemForCrLf - ^ (lineEnding = #crlf) -> 'CR+LF' \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/window menu/itemForLf.st b/Tool-Workspace.package/Workspace.class/instance/window menu/itemForLf.st deleted file mode 100644 index a89d5dbdc7..0000000000 --- a/Tool-Workspace.package/Workspace.class/instance/window menu/itemForLf.st +++ /dev/null @@ -1,2 +0,0 @@ -itemForLf - ^ lineEnding = #lf -> 'LF' \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/window menu/openMenuAction.st b/Tool-Workspace.package/Workspace.class/instance/window menu/openMenuAction.st index 78ae1f4ffb..a670e91664 100644 --- a/Tool-Workspace.package/Workspace.class/instance/window menu/openMenuAction.st +++ b/Tool-Workspace.package/Workspace.class/instance/window menu/openMenuAction.st @@ -6,4 +6,4 @@ openMenuAction (self fileName isNil and: [self contents isEmpty not or: [self hasUnacceptedEdits]]) ifTrue: [userWarned := self warnUser]. (self fileName isNil not and: [self hasUnacceptedEdits]) ifTrue: [userWarned := self warnUser]. - userWarned ifTrue: [self openFile: self askForFileNameToOpen] + userWarned ifTrue: [self openFile: self askForFileNameToOpen] \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/window menu/reloadMenuAction.st b/Tool-Workspace.package/Workspace.class/instance/window menu/reloadMenuAction.st deleted file mode 100644 index f7980fbac7..0000000000 --- a/Tool-Workspace.package/Workspace.class/instance/window menu/reloadMenuAction.st +++ /dev/null @@ -1,4 +0,0 @@ -reloadMenuAction - "Replaces unsaved content with the content of the associated file" - - self warnUser ifTrue: [self openFile: self fileName] \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/window menu/saveAsMenuAction.st b/Tool-Workspace.package/Workspace.class/instance/window menu/saveAsMenuAction.st index 6e1992e255..e77b109a78 100644 --- a/Tool-Workspace.package/Workspace.class/instance/window menu/saveAsMenuAction.st +++ b/Tool-Workspace.package/Workspace.class/instance/window menu/saveAsMenuAction.st @@ -1,17 +1,9 @@ saveAsMenuAction "Save the receiver's contents string to a file, prompting the user for a file-name. Suggest a reasonable file-name." - | suggestedFileName | - + + | suggestedFileName | suggestedFileName := self askForFileNameToSave: self suggestedFileName. - suggestedFileName ifNil: [^ self]. - - FileStream newFileNamed: suggestedFileName do: [ :s | "do nothing"]. + suggestedFileName ifNil: [ ^ self ]. self fileName: suggestedFileName. self label: suggestedFileName. - - self codeTextMorph ifNotNil: - [ :morph | | stringToSave | - stringToSave := morph text string. - self saveString: stringToSave toFile: suggestedFileName. - self contents: stringToSave. - self changed: #contents] \ No newline at end of file + textModel ifNotNil: [ :model | self saveString: model getString toFile: suggestedFileName ] \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/window menu/useEncoding_.st b/Tool-Workspace.package/Workspace.class/instance/window menu/useEncoding_.st index 50c4a7da64..60880bd395 100644 --- a/Tool-Workspace.package/Workspace.class/instance/window menu/useEncoding_.st +++ b/Tool-Workspace.package/Workspace.class/instance/window menu/useEncoding_.st @@ -1,3 +1,3 @@ useEncoding: aString encoding := aString. - self codeTextMorph hasUnacceptedEdits: true. \ No newline at end of file + textModel hasUnacceptedEdits: true \ No newline at end of file diff --git a/Tool-Workspace.package/Workspace.class/instance/window menu/useLineEnding_.st b/Tool-Workspace.package/Workspace.class/instance/window menu/useLineEnding_.st deleted file mode 100644 index ef79e8a222..0000000000 --- a/Tool-Workspace.package/Workspace.class/instance/window menu/useLineEnding_.st +++ /dev/null @@ -1,3 +0,0 @@ -useLineEnding: aSymbol - lineEnding := aSymbol. - self codeTextMorph hasUnacceptedEdits: true. \ No newline at end of file