From 8b825816b628233eb406f76b1d743aa7468d59f1 Mon Sep 17 00:00:00 2001 From: Juan Vuletich Date: Sun, 22 May 2022 16:39:58 -0300 Subject: [PATCH] =?UTF-8?q?Several=20fixes=20and=20tweaks.=20Thanks=20Hern?= =?UTF-8?q?=C3=A1n.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- ...uanVuletich-2022May19-10h44m-jmv.001.cs.st | 58 ++++++++++ ...uanVuletich-2022May19-13h26m-jmv.001.cs.st | 15 +++ ...uanVuletich-2022May19-13h27m-jmv.001.cs.st | 17 +++ ...uanVuletich-2022May19-13h27m-jmv.001.cs.st | 23 ++++ ...uanVuletich-2022May20-10h29m-jmv.001.cs.st | 53 +++++++++ ...uanVuletich-2022May20-11h18m-jmv.001.cs.st | 98 ++++++++++++++++ ...anWilkinson-2022May21-18h58m-HAW.001.cs.st | 109 ++++++++++++++++++ ...anWilkinson-2022May21-23h26m-HAW.001.cs.st | 78 +++++++++++++ ...anWilkinson-2022May21-23h53m-HAW.001.cs.st | 8 ++ ...anWilkinson-2022May21-23h40m-HAW.001.cs.st | 10 ++ 10 files changed, 469 insertions(+) create mode 100644 CoreUpdates/5174-PositionableStream-cleanup-JuanVuletich-2022May19-10h44m-jmv.001.cs.st create mode 100644 CoreUpdates/5175-UtfStrings-notEmpty-JuanVuletich-2022May19-13h26m-jmv.001.cs.st create mode 100644 CoreUpdates/5176-isCharacterLike-JuanVuletich-2022May19-13h27m-jmv.001.cs.st create mode 100644 CoreUpdates/5177-Character-CodePoint-equality-JuanVuletich-2022May19-13h27m-jmv.001.cs.st create mode 100644 CoreUpdates/5178-basicNext-cleanup-JuanVuletich-2022May20-10h29m-jmv.001.cs.st create mode 100644 CoreUpdates/5179-methodPreambleFromFile-cleanup-JuanVuletich-2022May20-11h18m-jmv.001.cs.st create mode 100644 CoreUpdates/5180-SeeAllPreferences-HernanWilkinson-2022May21-18h58m-HAW.001.cs.st create mode 100644 CoreUpdates/5181-TypoFix-HernanWilkinson-2022May21-23h26m-HAW.001.cs.st create mode 100644 CoreUpdates/5182-ClassTemplateFix-HernanWilkinson-2022May21-23h53m-HAW.001.cs.st create mode 100644 CoreUpdates/5183-SystemCategoryFileOutFix-HernanWilkinson-2022May21-23h40m-HAW.001.cs.st diff --git a/CoreUpdates/5174-PositionableStream-cleanup-JuanVuletich-2022May19-10h44m-jmv.001.cs.st b/CoreUpdates/5174-PositionableStream-cleanup-JuanVuletich-2022May19-10h44m-jmv.001.cs.st new file mode 100644 index 00000000..dd370774 --- /dev/null +++ b/CoreUpdates/5174-PositionableStream-cleanup-JuanVuletich-2022May19-10h44m-jmv.001.cs.st @@ -0,0 +1,58 @@ +'From Cuis 6.0 [latest update: #5173] on 19 May 2022 at 12:00:58 pm'! + +!PositionableStream methodsFor: 'fileIn/Out' stamp: 'jmv 5/19/2022 11:57:58'! +backChunk + "Answer the contents of the receiver back to the previous terminator character. + Doubled delimiter indicate an embedded delimiter character." + + | answer ch firstPosition delimiter prevCh count delimiterCount | + delimiter _ $!!. + "Go to end of chunk, not including delimiter." + ch _ self back. + ch = delimiter ifTrue: [ ch _ self back ]. + + count _ 1. + prevCh _ $$. + "Go back until non-doubled delimiter, or beginning." + [ch notNil and: [ ch ~= delimiter or: [self peekBack = delimiter or: [prevCh = delimiter]]]] whileTrue: [ + count _ count + 1. + prevCh _ ch. + ch _ self back. ]. + "Skip initial delimiter" + ch = delimiter ifTrue: [ + self next. + count _ count-1 ]. + + "This is where chunk starts. Undouble doubled delimiters." + firstPosition _ self position. + answer _ String streamContents: [ :strm | + prevCh _ $$. + delimiterCount _ 0. + count timesRepeat: [ + ch _ self next. + delimiterCount \\ 2 = 0 ifTrue: [ + strm nextPut: ch ]. + delimiterCount _ ch = delimiter + ifTrue: [ delimiterCount+1] + ifFalse: [0]]]. + + "Re position at start." + self position: firstPosition. + ^ answer! ! + +!methodRemoval: PositionableStream #oldBack stamp: 'jmv 5/19/2022 12:00:24'! +PositionableStream removeSelector: #oldBack! +!methodRemoval: PositionableStream #oldPeekBack stamp: 'jmv 5/19/2022 12:00:18'! +PositionableStream removeSelector: #oldPeekBack! + +!PositionableStream reorganize! +('accessing' back contents contentsOfEntireFile crLfNextLine last next: next:into: next:into:startingAt: next:putAll: next:putAll:startingAt: nextAvailable: nextDelimited: nextInto: nextInto:startingAt: nextKeyword nextLine nextWordsInto: originalContents peek peekBack peekFor: untilAnySatisfying: upTo: upTo:delimiterIsTerminator: upToAll: upToAny: upToEnd) +('testing' atEnd isBinary isCharacters isEmpty isFileStream isText notEmpty) +('positioning' backUpTo: match: padTo:put: padToNextLongPut: position position: reset resetContents setToEnd skip: skipTo:) +('fileIn/Out' backChunk checkForPreamble: compileNextChunk compileNextChunkHandlingExceptions compileNextChunkWhenDoesNotStartWithExclamationMark compileNextChunkWhenStartsWithExclamationMark copyMethodChunkFrom: evaluate:printingErrorWith: fileIn fileInAnnouncing: fileInInformingTo: nextChunk skipSeparators unCommand) +('private' collectionSpecies on: positionError setFrom:to:) +('filein/out' copyPreamble:from:at:) +('gui' untilEnd:displayingProgress:) +('que!!hincha!!!!pelot!!' teRompoTodo) +! + diff --git a/CoreUpdates/5175-UtfStrings-notEmpty-JuanVuletich-2022May19-13h26m-jmv.001.cs.st b/CoreUpdates/5175-UtfStrings-notEmpty-JuanVuletich-2022May19-13h26m-jmv.001.cs.st new file mode 100644 index 00000000..82b3b710 --- /dev/null +++ b/CoreUpdates/5175-UtfStrings-notEmpty-JuanVuletich-2022May19-13h26m-jmv.001.cs.st @@ -0,0 +1,15 @@ +'From Cuis 6.0 [latest update: #5174] on 19 May 2022 at 1:27:11 pm'! + +!Utf32String methodsFor: 'testing' stamp: 'jmv 5/16/2022 17:03:13'! +notEmpty + "Answer whether the receiver contains any elements." + + ^ self isEmpty not! ! + + +!Utf8String methodsFor: 'testing' stamp: 'jmv 5/16/2022 17:03:08'! +notEmpty + "Answer whether the receiver contains any elements." + + ^ self isEmpty not! ! + diff --git a/CoreUpdates/5176-isCharacterLike-JuanVuletich-2022May19-13h27m-jmv.001.cs.st b/CoreUpdates/5176-isCharacterLike-JuanVuletich-2022May19-13h27m-jmv.001.cs.st new file mode 100644 index 00000000..246c1b52 --- /dev/null +++ b/CoreUpdates/5176-isCharacterLike-JuanVuletich-2022May19-13h27m-jmv.001.cs.st @@ -0,0 +1,17 @@ +'From Cuis 6.0 [latest update: #5174] on 19 May 2022 at 1:27:55 pm'! + +!Object methodsFor: 'testing' stamp: 'jmv 5/17/2022 16:38:18'! +isCharacterLike + "Overridden to return true in Character and UnicodeCodePoint." + ^ false! ! + + +!Character methodsFor: 'testing' stamp: 'jmv 5/17/2022 16:38:27'! +isCharacterLike + ^true! ! + + +!UnicodeCodePoint methodsFor: 'testing' stamp: 'jmv 5/17/2022 16:37:43'! +isCharacterLike + ^true! ! + diff --git a/CoreUpdates/5177-Character-CodePoint-equality-JuanVuletich-2022May19-13h27m-jmv.001.cs.st b/CoreUpdates/5177-Character-CodePoint-equality-JuanVuletich-2022May19-13h27m-jmv.001.cs.st new file mode 100644 index 00000000..5c6250e6 --- /dev/null +++ b/CoreUpdates/5177-Character-CodePoint-equality-JuanVuletich-2022May19-13h27m-jmv.001.cs.st @@ -0,0 +1,23 @@ +'From Cuis 6.0 [latest update: #5174] on 19 May 2022 at 1:30:55 pm'! + +!UnicodeCodePoint methodsFor: 'comparing' stamp: 'jmv 5/17/2022 16:39:47'! += aCodePointOrCharacter + + self == aCodePointOrCharacter ifTrue: [ ^true ]. + aCodePointOrCharacter isCharacterLike ifFalse: [ ^false ]. + ^self codePoint = aCodePointOrCharacter codePoint! ! + +!UnicodeCodePoint methodsFor: 'comparing' stamp: 'jmv 5/19/2022 13:30:01'! +hash + "Hash is reimplemented because = is implemented." + + ^value hash! ! + + +!Character methodsFor: 'comparing' stamp: 'jmv 5/17/2022 16:39:43'! += aCodePointOrCharacter + + self == aCodePointOrCharacter ifTrue: [ ^true ]. + aCodePointOrCharacter isCharacterLike ifFalse: [ ^false ]. + ^self codePoint = aCodePointOrCharacter codePoint! ! + diff --git a/CoreUpdates/5178-basicNext-cleanup-JuanVuletich-2022May20-10h29m-jmv.001.cs.st b/CoreUpdates/5178-basicNext-cleanup-JuanVuletich-2022May20-10h29m-jmv.001.cs.st new file mode 100644 index 00000000..5d7cb641 --- /dev/null +++ b/CoreUpdates/5178-basicNext-cleanup-JuanVuletich-2022May20-10h29m-jmv.001.cs.st @@ -0,0 +1,53 @@ +'From Cuis 6.0 [latest update: #5177] on 20 May 2022 at 10:36:46 am'! + +!CompiledMethod methodsFor: 'source code management' stamp: 'jmv 5/20/2022 10:30:37'! +getPreambleFrom: aFileStream at: position + | writeStream c p | + writeStream _ String new writeStream. + p _ position - 1. + c _ nil. + aFileStream position: p. + aFileStream atEnd ifTrue: [ ^ nil ]. + [ p >= 0 and: [ c ~~ $!! ]] whileTrue: [ + aFileStream position: p. + c _ aFileStream next. + p _ p - 1 ]. + [ p >= 0] whileTrue: [ + aFileStream position: p. + c _ aFileStream next. + c == $!! + ifTrue: [^ writeStream contents reverse ] + ifFalse: [ writeStream nextPut: c ]. + p _ p - 1 ]. + ^ nil! ! + + +!StandardFileStream methodsFor: 'read, write, position' stamp: 'jmv 5/19/2022 18:23:42'! +next + "Answer the next byte or character (depending on mode) from this file, or nil if at the end of the file." + + | count | + collection ifNotNil: [ + position < readLimit + ifFalse: [ + readLimit := self primRead: fileID into: collection startingAt: 1 count: collection size. + position := 0. + readLimit = 0 ifTrue: [ ^nil ] ]. + ^collection at: (position := position + 1) ]. + count _ self primRead: fileID into: buffer1 startingAt: 1 count: 1. + ^count = 1 + ifTrue: [ buffer1 at: 1 ]! ! + +!StandardFileStream methodsFor: 'read, write, position' stamp: 'jmv 5/20/2022 10:31:01'! +peek + "Answer what would be returned if the message next were sent to the receiver. If the receiver is at the end, answer nil. " + | next | + position < readLimit ifTrue: [ + ^collection at: position+1 ]. + self atEnd ifTrue: [^ nil]. + next _ self next. + self position: self position - 1. + ^ next! ! + +!methodRemoval: StandardFileStream #basicNext stamp: 'jmv 5/20/2022 10:29:57'! +StandardFileStream removeSelector: #basicNext! diff --git a/CoreUpdates/5179-methodPreambleFromFile-cleanup-JuanVuletich-2022May20-11h18m-jmv.001.cs.st b/CoreUpdates/5179-methodPreambleFromFile-cleanup-JuanVuletich-2022May20-11h18m-jmv.001.cs.st new file mode 100644 index 00000000..712297ca --- /dev/null +++ b/CoreUpdates/5179-methodPreambleFromFile-cleanup-JuanVuletich-2022May20-11h18m-jmv.001.cs.st @@ -0,0 +1,98 @@ +'From Cuis 6.0 [latest update: #5178] on 20 May 2022 at 11:19:02 am'! + +!PositionableStream methodsFor: 'filein/out' stamp: 'jmv 5/20/2022 11:06:18'! +copyPreamble: preamble oldPreamble: oldPreamble + "Look for a changeStamp for this method. + Write a method preamble, with that stamp if found." + | terminator stamp i | + terminator := $!!. + + "Look back to find stamp in old preamble, such as... + Polygon methodsFor: 'private' stamp: 'di 6/25/97 21:42' prior: 34957598!! " + stamp := String new. + (i := oldPreamble + findLastOccurrenceOfString: 'stamp:' + startingAt: 1) > 0 ifTrue: + [ stamp := (oldPreamble + copyFrom: i + 8 + to: oldPreamble size) copyUpTo: $' ]. + + "Write the new preamble, with old stamp if any." + self + newLine; + nextPut: terminator. + self nextChunkPut: (String streamContents: + [ :strm | + strm nextPutAll: preamble. + stamp size > 0 ifTrue: + [ strm + nextPutAll: ' stamp: '; + print: stamp ] ]). + self newLine! ! + + +!ClassDescription methodsFor: 'fileIn/Out' stamp: 'jmv 5/20/2022 11:11:11'! +printMethodChunk: selector withPreamble: doPreamble on: outStream moveSource: moveSource toFile: fileIndex + "Copy the source code for the method associated with selector onto the fileStream. If moveSource true, then also set the source code pointer of the method." + | preamble compiledMethod oldPos newPos sourceFile endPos | + doPreamble + ifTrue: [preamble _ self name , ' methodsFor: ' , + (self organization categoryOfElement: selector) asPlainString printString] + ifFalse: [preamble _ '']. + compiledMethod _ self methodDict at: selector ifAbsent: [ + outStream nextPutAll: selector; newLine. + outStream tab; nextPutAll: '** ERROR - THIS METHOD IS MISSING ** '; newLine; newLine. + outStream nextPutAll: ' '. + ^ outStream]. + + ((compiledMethod fileIndex = 0 + or: [(SourceFiles at: compiledMethod fileIndex) == nil]) + or: [(oldPos _ compiledMethod filePosition) = 0]) + ifTrue: [ + "The source code is not accessible. We must decompile..." + preamble size > 0 ifTrue: [ outStream newLine; nextPut: $!!; nextChunkPut: preamble; newLine]. + outStream nextChunkPut: compiledMethod decompileString] + ifFalse: [ + sourceFile _ SourceFiles at: compiledMethod fileIndex. + preamble size > 0 + ifTrue: [ "Copy the preamble" + outStream copyPreamble: preamble oldPreamble: compiledMethod getPreamble ]. + sourceFile position: oldPos. + "Copy the method chunk" + fileIndex = 0 ifFalse: [ + outStream padTo: SourceFiles pointerScaleForWriting put: $ ]. + newPos _ outStream position. + outStream copyMethodChunkFrom: sourceFile. + moveSource ifTrue: [ "Set the new method source pointer" + endPos _ outStream position. + compiledMethod checkOKToAdd: endPos - newPos at: newPos in: compiledMethod fileIndex. + compiledMethod setSourcePosition: newPos inFile: fileIndex]]. + preamble notEmpty ifTrue: [ outStream nextChunkPut: ' ' ]. + ^ outStream newLine! ! + + +!CompiledMethod methodsFor: 'source code management' stamp: 'jmv 5/20/2022 11:14:03'! +getPreamble + | file preamble | + self fileIndex = 0 ifTrue: [^ String new]. "no source pointer for this method" + file _ SourceFiles at: self fileIndex. + file ifNil: [^ '']. "sources file not available" + "file does not exist happens in secure mode" + [ + file name asFileEntry readStreamDo: [ :stream | + stream position: (0 max: self filePosition). + "Skip back blank space." + stream backChunk. + "Find and answer preamble chunk." + preamble _ stream backChunk ] + ] on: FileDoesNotExistException do: [ :ex | preamble _ '' ]. + ^ preamble! ! + +!methodRemoval: PositionableStream #copyPreamble:from:at: stamp: 'jmv 5/20/2022 11:18:45'! +PositionableStream removeSelector: #copyPreamble:from:at:! +!methodRemoval: CompiledMethod #sourceFileStream stamp: 'jmv 5/20/2022 11:18:45'! +CompiledMethod removeSelector: #sourceFileStream! +!methodRemoval: CompiledMethod #getPreambleFrom:at: stamp: 'jmv 5/20/2022 11:18:45'! +CompiledMethod removeSelector: #getPreambleFrom:at:! +!methodRemoval: CompiledMethod #sourceClass stamp: 'jmv 5/20/2022 11:18:45'! +CompiledMethod removeSelector: #sourceClass! diff --git a/CoreUpdates/5180-SeeAllPreferences-HernanWilkinson-2022May21-18h58m-HAW.001.cs.st b/CoreUpdates/5180-SeeAllPreferences-HernanWilkinson-2022May21-18h58m-HAW.001.cs.st new file mode 100644 index 00000000..988a72cd --- /dev/null +++ b/CoreUpdates/5180-SeeAllPreferences-HernanWilkinson-2022May21-18h58m-HAW.001.cs.st @@ -0,0 +1,109 @@ +'From Cuis 6.0 [latest update: #5171] on 21 May 2022 at 7:00:18 pm'! + +!PreferenceNG class methodsFor: 'as yet unclassified' stamp: 'HAW 5/21/2022 18:59:42'! +openPreferencesInspector + "Open a window on the current set of preferences choices, allowing the user to view and change their settings" + + self allPreferences inspectWithLabel: 'Preferences'! ! + + +!TheWorldMenu methodsFor: 'construction' stamp: 'HAW 5/21/2022 18:58:42'! +preferencesMenu + "Build the preferences menu for the world." + + ^ (self menu: 'Preferences...') + addItemsFromDictionaries: { + { + #label -> 'Focus follows mouse'. + #object -> Preferences. + #selector -> #enableFocusFollowsMouse. + #icon -> #windowIcon. + #balloonText -> 'At all times, make the active window and widget the one on which the mouse is located.' + } asDictionary. + { + #label -> 'Click to focus'. + #object -> Preferences. + #selector -> #disableFocusFollowsMouse. + #icon -> #windowIcon. + #balloonText -> 'At all times, make the active window and widget the one where the mouse was clicked.' + } asDictionary. + { + #label -> 'Size of GUI elements...'. + #object -> Theme. + #selector -> #changeFontSizes. + #icon -> #preferencesDesktopFontIcon. + #balloonText -> 'use larger or smaller text and widgets' + } asDictionary. + { + #label -> 'Set System Font...'. + #object -> FontFamily. + #selector -> #promptUserAndSetDefault. + #icon -> #preferencesDesktopFontIcon. + #balloonText -> 'change the current system font family.' + } asDictionary. + { + #label -> 'Load all TrueType Fonts'. + #object -> FontFamily. + #selector -> #readAdditionalTrueTypeFonts. + #icon -> #preferencesDesktopFontIcon. + #balloonText -> 'Load additional TrueType fonts included with Cuis.' + } asDictionary. + { + #label -> 'Icons...'. + #object -> Theme. + #selector -> #changeIcons. + #icon -> #worldIcon. + #balloonText -> 'show more or less icons.' + } asDictionary. + { + #label -> 'Themes...'. + #object -> Theme. + #selector -> #changeTheme. + #icon -> #appearanceIcon. + #balloonText -> 'switch to another theme.' + } asDictionary. + nil. + { + #label -> 'Show taskbar'. + #object -> #myWorld. + #selector -> #showTaskbar. + #icon -> #expandIcon. + #balloonText -> 'show the taskbar' + } asDictionary. + { + #label -> 'Hide taskbar'. + #object -> #myWorld. + #selector -> #hideTaskbar. + #icon -> #collapseIcon. + #balloonText -> 'hide the taskbar' + } asDictionary. + nil. + { + #label -> 'Full screen on'. + #selector -> #fullScreenOn. + #icon -> #viewFullscreenIcon. + #balloonText -> 'puts you in full-screen mode, if not already there.' + } asDictionary. + { + #label -> 'Full screen off'. + #selector -> #fullScreenOff. + #icon -> #exitFullscreenIcon. + #balloonText -> 'if in full-screen mode, takes you out of it.' + } asDictionary. + nil. + { + #label -> 'Set Code Author...'. + #object -> Utilities. + #selector -> #setAuthor. + #icon -> #usersIcon. + #balloonText -> 'supply initials to be used to identify the author of code and other content.' + } asDictionary. + { + #label -> 'All preferences...'. + #object -> PreferenceNG. + #selector -> #openPreferencesInspector. + #icon -> #preferencesIcon. + #balloonText -> 'view and change various options.' + } asDictionary. + }! ! + diff --git a/CoreUpdates/5181-TypoFix-HernanWilkinson-2022May21-23h26m-HAW.001.cs.st b/CoreUpdates/5181-TypoFix-HernanWilkinson-2022May21-23h26m-HAW.001.cs.st new file mode 100644 index 00000000..37308a0e --- /dev/null +++ b/CoreUpdates/5181-TypoFix-HernanWilkinson-2022May21-23h26m-HAW.001.cs.st @@ -0,0 +1,78 @@ +'From Cuis 6.0 [latest update: #5173] on 21 May 2022 at 11:26:58 pm'! + +!RefactoringMenues class methodsFor: 'browser menues' stamp: 'HAW 5/21/2022 23:26:24'! +messageRefactoringMenuOptions + + ^ `{ + { + #itemGroup -> 10. + #itemOrder -> 10. + #label -> 'rename... (R)'. + #selector -> #renameSelector. + #icon -> #saveAsIcon + } asDictionary. + { + #itemGroup -> 10. + #itemOrder -> 15. + #label -> 'change keyword order...'. + #selector -> #changeKeywordOrder. + #icon -> #sendReceiveIcon + } asDictionary. + { + #itemGroup -> 10. + #itemOrder -> 20. + #label -> 'add parameter...'. + #selector -> #addParameter. + #icon -> #listAddIcon + } asDictionary. + { + #itemGroup -> 10. + #itemOrder -> 30. + #label -> 'remove parameter...'. + #selector -> #removeParameter. + #icon -> #listRemoveIcon + } asDictionary. + { + #itemGroup -> 10. + #itemOrder -> 40. + #label -> 'push up'. + #selector -> #pushUpSelector. + #icon -> #goTopIcon + } asDictionary. + { + #itemGroup -> 10. + #itemOrder -> 50. + #label -> 'push down'. + #selector -> #pushDownSelector. + #icon -> #goBottomIcon + } asDictionary. + { + #itemGroup -> 10. + #itemOrder -> 60. + #label -> 'move to instance/class method'. + #selector -> #moveToInstanceOrClassMethod. + #icon -> #changesIcon + } asDictionary. + }`. + + ! ! + + +!BrowserWindow methodsFor: 'refactorings' stamp: 'HAW 5/21/2022 23:26:24'! +messageRefactoringMenu + + ^DynamicMenuBuilder buildTitled: 'Refactorings' targeting: self collectingMenuOptionsWith: #messageRefactoringMenuOptions.! ! + +!methodRemoval: RefactoringMenues class #messsageRefactoringMenuOptions stamp: 'HAW 5/21/2022 23:26:24'! +RefactoringMenues class removeSelector: #messsageRefactoringMenuOptions! + +!BrowserWindow reorganize! +('GUI building' buildLowerPanes buildMorphicClassColumnWith: buildMorphicClassList buildMorphicCommentPane buildMorphicMessageCatList buildMorphicMessageList buildMorphicSwitches buildMorphicSystemCategoryList buildMorphicWindow buildNoSysCatMorphicWindow createClassButton createCodePaneMorph createCommentButton createInstanceButton windowColor) +('menu building' addExtraMenu2ItemsTo: classListMenu classListMenu2 messageCategoryMenu messageListMenu messageListMenu2 systemCatSingletonMenu systemCategoryMenu) +('menu commands' browseAllClasses openSystemCategoryBrowser) +('keyboard shortcuts' messageListKey:from: systemCatListKey:from: systemCatSingletonKey:from:) +('updating' classAdded: classRenamed:from:to:inCategory: disableCodePaneEditing editSelectionChanged enableCodePaneEditing isEditSelectionNone update:) +('refactorings' addInstVar addParameter changeKeywordOrder classRefactoringMenu messageRefactoringMenu moveToInstanceOrClassMethod openClassRefactoringMenu openMessageRefactoringMenu pushDownInstanceVariable pushDownSelector pushUpInstanceVariable pushUpSelector removeAllUnreferencedInstVar removeInstVar removeParameter renameInstVar renameSelector) +('commands' findClass) +! + diff --git a/CoreUpdates/5182-ClassTemplateFix-HernanWilkinson-2022May21-23h53m-HAW.001.cs.st b/CoreUpdates/5182-ClassTemplateFix-HernanWilkinson-2022May21-23h53m-HAW.001.cs.st new file mode 100644 index 00000000..a382ff41 --- /dev/null +++ b/CoreUpdates/5182-ClassTemplateFix-HernanWilkinson-2022May21-23h53m-HAW.001.cs.st @@ -0,0 +1,8 @@ +'From Cuis 6.0 [latest update: #5171] on 21 May 2022 at 11:59:01 pm'! + +!Class class methodsFor: 'instance creation' stamp: 'HAW 5/21/2022 23:57:46'! +template: aSystemCategoryName + "Answer an expression that can be edited and evaluated in order to define a new class." + + ^ self templateForSubclassOf: Object category: aSystemCategoryName ! ! + diff --git a/CoreUpdates/5183-SystemCategoryFileOutFix-HernanWilkinson-2022May21-23h40m-HAW.001.cs.st b/CoreUpdates/5183-SystemCategoryFileOutFix-HernanWilkinson-2022May21-23h40m-HAW.001.cs.st new file mode 100644 index 00000000..ae2a0860 --- /dev/null +++ b/CoreUpdates/5183-SystemCategoryFileOutFix-HernanWilkinson-2022May21-23h40m-HAW.001.cs.st @@ -0,0 +1,10 @@ +'From Cuis 6.0 [latest update: #5173] on 22 May 2022 at 12:52:35 am'! + +!SystemOrganizer methodsFor: 'fileIn/Out' stamp: 'HAW 5/22/2022 00:50:26'! +fileOutCategory: aCategoryRoot + "FileOut all the classes in the named system category." + + DirectoryEntry smalltalkImageDirectory // (aCategoryRoot asFileName , '.st') writeStreamDo: [ :fileStream | + (self categoriesMatching: aCategoryRoot,'*') do: [ :category | + self fileOutCategory: category on: fileStream initializing: true ]]! ! +