Packages May 2023

packages@lists.squeakfoundation.org

1 participants
55 discussions

The Trunk: Kernel-mt.1513.mcz
by commits＠source.squeak.org 12 May '23

12 May '23

Marcel Taeumel uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-mt.1513.mcz ==================== Summary ==================== Name: Kernel-mt.1513 Author: mt Time: 12 May 2023, 9:47:22.555412 am UUID: da4aac4d-9677-7a43-ab46-8fe9e08f1fb0 Ancestors: Kernel-eem.1512 Fix issue with categorization of classes. Better support for default category. Do not allow empty class category. =============== Diff against Kernel-eem.1512 =============== Item was changed: ----- Method: Categorizer>>classify:under:suppressIfDefault: (in category 'classifying') ----- classify: element under: heading suppressIfDefault: aBoolean "Store the argument, element, in the category named heading. If aBoolean is true, then invoke special logic such that the classification is NOT done if the new heading is the Default and the element already had a non-Default classification -- useful for filein" | catName catIndex elemIndex realHeading | + realHeading := (heading isEmptyOrNil or: [self isSpecialCategoryName: heading]) - realHeading := (heading isNil or: [self isSpecialCategoryName: heading]) ifTrue: [Default] ifFalse: [heading asSymbol]. (catName := self categoryOfElement: element) = realHeading ifTrue: [^ self]. "done if already under that category" catName ifNotNil: [ (aBoolean and: [realHeading = Default]) ifTrue: [^ self]. "return if non-Default category already assigned in memory" self basicRemoveElement: element]. "remove if in another category" (categoryArray indexOf: realHeading) = 0 ifTrue: [self addCategory: realHeading]. catIndex := categoryArray indexOf: realHeading. elemIndex := catIndex > 1 ifTrue: [categoryStops at: catIndex - 1] ifFalse: [0]. [(elemIndex := elemIndex + 1) <= (categoryStops at: catIndex) and: [element >= (elementArray at: elemIndex)]] whileTrue. "elemIndex is now the index for inserting the element. Do the insertion before it." elementArray := elementArray copyReplaceFrom: elemIndex to: elemIndex-1 with: (Array with: element). "add one to stops for this and later categories" catIndex to: categoryArray size do: [:i | categoryStops at: i put: (categoryStops at: i) + 1]. ((categoryArray includes: Default) and: [(self listAtCategoryNamed: Default) size = 0]) ifTrue: [self removeCategory: Default]. self assertInvariant.! Item was changed: ----- Method: ClassBuilder>>name:inEnvironment:subclassOf:type:instanceVariableNames:classVariableNames:poolDictionaries:category:unsafe: (in category 'class definition') ----- name: className inEnvironment: env subclassOf: newSuper type: type instanceVariableNames: instVarString classVariableNames: classVarString poolDictionaries: poolString category: category unsafe: unsafe "Define a new class in the given environment. If unsafe is true do not run any validation checks. This facility is provided to implement important system changes." | oldClass instVars classVars copyOfOldClass newClass | environ := env. instVars := Scanner new scanFieldNames: instVarString. classVars := (Scanner new scanFieldNames: classVarString) collect: [:x | x asSymbol]. "Validate the proposed name" unsafe ifFalse:[(self validateClassName: className) ifFalse:[^nil]]. oldClass := env at: className ifAbsent:[nil]. oldClass isBehavior ifFalse: [oldClass := nil] "Already checked in #validateClassName:" ifTrue: [ copyOfOldClass := oldClass copy. copyOfOldClass superclass addSubclass: copyOfOldClass]. [ | newCategory needNew force organization oldCategory | unsafe ifFalse:[ "Run validation checks so we know that we have a good chance for recompilation" (self validateSuperclass: newSuper forSubclass: oldClass) ifFalse:[^nil]. (self validateInstvars: instVars from: oldClass forSuper: newSuper) ifFalse:[^nil]. (self validateClassvars: classVars from: oldClass forSuper: newSuper) ifFalse:[^nil]. (self validateSubclassFormat: type from: oldClass forSuper: newSuper extra: instVars size) ifFalse:[^nil]]. "See if we need a new subclass" needNew := self needsSubclassOf: newSuper type: type instanceVariables: instVars from: oldClass. needNew == nil ifTrue:[^nil]. "some error" (needNew and:[unsafe not]) ifTrue:[ "Make sure we don't redefine any dangerous classes" (self tooDangerousClasses includes: oldClass name) ifTrue:[ self error: oldClass name, ' cannot be changed'. ]. "Check if the receiver should not be redefined" (oldClass ~~ nil and:[oldClass shouldNotBeRedefined]) ifTrue:[ self notify: oldClass name asText allBold, ' should not be redefined. \Proceed to store over it.' withCRs]]. needNew ifTrue:[ "Create the new class" newClass := self newSubclassOf: newSuper type: type instanceVariables: instVars from: oldClass. newClass == nil ifTrue:[^nil]. "Some error" newClass setName: className. newClass environment: environ. ] ifFalse:[ "Reuse the old class" newClass := oldClass. ]. "Install the class variables and pool dictionaries... " force := (newClass declare: classVarString) | (newClass sharing: poolString). "... classify ..." + newCategory := category ifNotNil: [category asSymbol]. + organization := environ ifNotNil:[environ organization]. + oldClass isNil ifFalse: [oldCategory := (organization categoryOfElement: oldClass name) asSymbol]. + organization classify: newClass name under: newCategory suppressIfDefault: true. + newCategory := organization categoryOfElement: newClass name. "if default" - category ifNotNil: [ - newCategory := category asSymbol. - organization := environ ifNotNil:[environ organization]. - oldClass isNil ifFalse: [oldCategory := (organization categoryOfElement: oldClass name) asSymbol]. - organization classify: newClass name under: newCategory suppressIfDefault: true]. "... recompile ..." newClass := self recompile: force from: oldClass to: newClass mutate: false. "... export if not yet done ..." (environ at: newClass name ifAbsent:[nil]) == newClass ifFalse:[ [environ at: newClass name put: newClass] on: AttemptToWriteReadOnlyGlobal do:[:ex| ex resume: true]. environ flushClassNameCache. ]. newClass doneCompiling. "... notify interested clients ..." oldClass isNil ifTrue: [ SystemChangeNotifier uniqueInstance classAdded: newClass inCategory: newCategory. ^ newClass]. newCategory ~= oldCategory ifTrue: [SystemChangeNotifier uniqueInstance class: newClass recategorizedFrom: oldCategory to: category] ifFalse: [SystemChangeNotifier uniqueInstance classDefinitionChangedFrom: copyOfOldClass to: newClass.]. ] ensure: [copyOfOldClass ifNotNil: [copyOfOldClass superclass removeSubclass: copyOfOldClass]. Behavior flushObsoleteSubclasses. ]. ^newClass!

1 0

The Trunk: Tools-mt.1201.mcz
by commits＠source.squeak.org 12 May '23

12 May '23

Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-mt.1201.mcz ==================== Summary ==================== Name: Tools-mt.1201 Author: mt Time: 12 May 2023, 9:32:33.304412 am UUID: 1d78afe7-8c20-4e4d-b091-3807faf620a4 Ancestors: Tools-mt.1200 In TreeBrowser, add message category "-- core --" to all classes that have extensions to be able to filter/browse through not-extension methods. The name 'core' stems from #coreMethods in PackageInfo. =============== Diff against Tools-mt.1200 =============== Item was added: + ----- Method: TreeBrowser class>>coreCategory (in category 'defaults') ----- + coreCategory + "The name 'core' stems from #coreMethods in PackageInfo." + + ^ #'-- core --'! Item was changed: ----- Method: TreeBrowser>>messageCategoryChildren: (in category 'message category tree') ----- messageCategoryChildren: category | all | category = ClassOrganizer allCategory ifTrue: [^ #()]. + category = self class coreCategory ifTrue: [^ #()]. all := (category = self class extensionCategory or: [category notEmpty and: [category first == $*]]) ifTrue: [lastMessageCategoryList select: [:cat | cat first == $*]] ifFalse: [lastMessageCategoryList reject: [:cat | cat first == $*]]. ^ self for: (category = self class extensionCategory ifTrue: [''] ifFalse: [category]) from: all select: [:prefix :cat | self hasMessageCategory: cat prefix: prefix] thenCollect: [:cat :start | self findTrimmedPrefix: cat startingAt: start]! Item was changed: ----- Method: TreeBrowser>>messageCategoryHasChildren: (in category 'message category tree') ----- messageCategoryHasChildren: category | predicate | category == ClassOrganizer allCategory ifTrue: [^ false]. + category = self class coreCategory ifTrue: [^ false]. predicate := category == self class extensionCategory ifTrue: [ [:cat | cat first == $*] ] ifFalse: [ [:cat | self hasMessageCategory: cat prefix: category] ]. ^ lastMessageCategoryList anySatisfy: [:cat | predicate value: cat]! Item was changed: ----- Method: TreeBrowser>>messageCategoryLabel: (in category 'message category tree') ----- messageCategoryLabel: category | label | category = ClassOrganizer allCategory ifTrue: [^ category]. category = self class extensionCategory ifTrue: [^ category]. + category = self class coreCategory ifTrue: [^ category]. label := self findTrimmedSuffix: category. (self classOrMetaClassOrganizer categories includes: category) ifFalse: [ label := '(', label, ')']. ^ label! Item was changed: ----- Method: TreeBrowser>>messageCategoryPath (in category 'message category tree') ----- messageCategoryPath "Answer the path represented by the category. Ensure to fill the cache." self hasClassSelected ifFalse: [^ #()]. self hasMessageCategorySelected ifFalse: [^ #()]. selectedMessageCategoryName = ClassOrganizer allCategory ifTrue: [^ {selectedMessageCategoryName}]. selectedMessageCategoryName = self class extensionCategory ifTrue: [^ {selectedMessageCategoryName}]. + selectedMessageCategoryName = self class coreCategory ifTrue: [^ {selectedMessageCategoryName}]. ^ Array streamContents: [:s | | parent | selectedMessageCategoryName first == $* "Is extension category?" ifTrue: [s nextPut: (parent := self class extensionCategory)] ifFalse: [parent := '']. [parent notNil] whileTrue: [ (self messageCategoryChildren: parent) detect: [:ea | selectedMessageCategoryName beginsWith: ea] ifFound: [:ea | s nextPut: (parent := ea)] ifNone: [parent := nil]]]! Item was changed: ----- Method: TreeBrowser>>messageCategoryRoots (in category 'message category tree') ----- messageCategoryRoots | hasExtensions hasAny roots | self hasClassSelected ifFalse: [^ Array new]. hasAny := self classOrMetaClassOrganizer isEmpty not. hasExtensions := self classOrMetaClassOrganizer categories anySatisfy: [:cat | cat first == $*]. roots := OrderedCollection new. hasAny ifTrue: [roots add: ClassOrganizer allCategory]. + hasExtensions ifTrue: [ + roots add: self class coreCategory. + roots add: self class extensionCategory]. - hasExtensions ifTrue: [roots add: self class extensionCategory]. roots addAll: (self messageCategoryChildren: ''). ^ roots! Item was changed: ----- Method: TreeBrowser>>messageList (in category 'message list') ----- messageList "Overwritten to show all extensions when the '-- extensions --' category is selected." + self selectedMessageCategoryName = self class coreCategory + ifTrue: [ + ^ Array streamContents: [:coreSelectors | + self classOrMetaClassOrganizer categories + reject: [:cat | cat first == $*] + thenDo: [:extCat | (self classOrMetaClassOrganizer listAtCategoryNamed: extCat) + do: [:extSel | coreSelectors nextPut: (self formattedLabel: extSel)]]]]. + ^ self selectedMessageCategoryName = self class extensionCategory ifFalse: [super messageList] ifTrue: [ Array streamContents: [:extensionSelectors | self classOrMetaClassOrganizer categories select: [:cat | cat first == $*] thenDo: [:extCat | (self classOrMetaClassOrganizer listAtCategoryNamed: extCat) do: [:extSel | extensionSelectors nextPut: (self formattedLabel: extSel)]]]]!

1 0

The Trunk: Compiler-mt.491.mcz
by commits＠source.squeak.org 05 May '23

05 May '23

Marcel Taeumel uploaded a new version of Compiler to project The Trunk: http://source.squeak.org/trunk/Compiler-mt.491.mcz ==================== Summary ==================== Name: Compiler-mt.491 Author: mt Time: 5 May 2023, 3:39:26.933945 pm UUID: e15f8291-ec32-9a4a-8af3-5328323a2ca3 Ancestors: Compiler-mt.490 Allow #pvt* methods to be overridden and extended in subclasses, that is, allow "super pvtFoo" calls. For example, Cuis' VectorEngine needs this. =============== Diff against Compiler-mt.490 =============== Item was changed: ----- Method: MessageNode>>pvtCheckForPvtSelector: (in category 'private') ----- pvtCheckForPvtSelector: encoder + "If the code being compiled is trying to send a private message (e.g. 'pvtCheckForPvtSelector:') to anyone other than self (or super), then complain to encoder." - "If the code being compiled is trying to send a private message (e.g. 'pvtCheckForPvtSelector:') to anyone other than self, then complain to encoder." selector isPvtSelector ifTrue: + [receiver isSelfOrSuperPseudoVariable ifFalse: + [encoder notify: 'Private messages may only be sent to self or super']].! - [receiver isSelfPseudoVariable ifFalse: - [encoder notify: 'Private messages may only be sent to self']].! Item was added: + ----- Method: ParseNode>>isSelfOrSuperPseudoVariable (in category 'testing') ----- + isSelfOrSuperPseudoVariable + + ^ self isSelfPseudoVariable or: [self isSuperPseudoVariable]! Item was added: + ----- Method: ParseNode>>isSuperPseudoVariable (in category 'testing') ----- + isSuperPseudoVariable + "Overridden in VariableNode." + ^false! Item was added: + ----- Method: VariableNode>>isSuperPseudoVariable (in category 'testing') ----- + isSuperPseudoVariable + "Answer if this ParseNode represents the 'super' pseudo-variable." + + ^ key = 'super' or: [name = '{{super}}']!

1 0

The Trunk: Environments-eem.85.mcz
by commits＠source.squeak.org 04 May '23

04 May '23

Eliot Miranda uploaded a new version of Environments to project The Trunk: http://source.squeak.org/trunk/Environments-eem.85.mcz ==================== Summary ==================== Name: Environments-eem.85 Author: eem Time: 4 May 2023, 12:18:59.95869 pm UUID: 162eabaa-b8ca-479f-8062-8e2c4fc3aea9 Ancestors: Environments-ul.84 Neater, faster classOrTraitNamed:, which almost always is given a class name, not a metaclass or trait class name. =============== Diff against Environments-ul.84 =============== Item was changed: ----- Method: Environment>>classOrTraitNamed: (in category 'classes and traits') ----- classOrTraitNamed: aString "aString is either a class or trait name or a class or trait name followed by ' class' or 'classTrait' respectively. + Answer the class or metaclass it names, or nil if not found." - Answer the class or metaclass it names." + | spaceIndex postFix meta baseName | + spaceIndex := aString indexOf: Character space. + spaceIndex = 0 + ifTrue: + [meta := false. + baseName := aString] + ifFalse: + [postFix := aString copyFrom: spaceIndex + 1 to: aString size. + baseName := aString copyFrom: 1 to: spaceIndex - 1. + (postFix = 'class' or: [postFix = 'classTrait']) + ifTrue: [meta := true] + ifFalse: [^nil]]. + ^(Symbol lookup: baseName) ifNotNil: + [ :baseNameSymbol | + declarations + at: baseNameSymbol + ifPresent: + [ :global | + global isBehavior ifTrue: + [meta + ifFalse: [ global ] + ifTrue: [ global classSide ] ] ] ]! - | meta baseName | - (aString endsWith: ' class') - ifTrue: [ - meta := true. - baseName := aString copyFrom: 1 to: aString size - 6 ] - ifFalse: [ - (aString endsWith: ' classTrait') - ifTrue: [ - meta := true. - baseName := aString copyFrom: 1 to: aString size - 11 ] - ifFalse: [ - meta := false. - baseName := aString ] ]. - ^(Symbol lookup: baseName) ifNotNil: [ :baseNameSymbol | - declarations at: baseNameSymbol ifPresent: [ :global | - global isBehavior ifTrue: [ - meta - ifFalse: [ global ] - ifTrue: [ global classSide ] ] ] ]!

1 0

The Trunk: Files-eem.203.mcz
by commits＠source.squeak.org 03 May '23

03 May '23

Eliot Miranda uploaded a new version of Files to project The Trunk: http://source.squeak.org/trunk/Files-eem.203.mcz ==================== Summary ==================== Name: Files-eem.203 Author: eem Time: 2 May 2023, 3:03:46.035929 pm UUID: 1f6149df-859d-47aa-8926-5a0d8c368377 Ancestors: Files-mt.202 Cheaper implementation of FileDirectory class>>extensionFor:. Include error code in StandardFileStream>>primClose: (latest VMs answer a meaningful error if primitiveFileClose fails). =============== Diff against Files-mt.202 =============== Item was changed: ----- Method: FileDirectory class>>extensionFor: (in category 'name utilities') ----- + extensionFor: fileNameString + "Answer the extension of the given file name string, if any, or the empty string if none." - extensionFor: fileName - "Return the extension of given file name, if any." + | i | + i := fileNameString lastIndexOf: DirectoryClass extensionDelimiter. + ^i = 0 + ifTrue: [''] + ifFalse: [fileNameString copyFrom: i + 1 to: fileNameString size]! - | delim i | - delim := DirectoryClass extensionDelimiter. - i := fileName findLast: [:c | c = delim]. - i = 0 - ifTrue: [^ ''] - ifFalse: [^ fileName copyFrom: i + 1 to: fileName size]. - ! Item was changed: ----- Method: StandardFileStream>>primClose: (in category 'primitives') ----- primClose: id "Close this file." + <primitive: 'primitiveFileClose' module: 'FilePlugin' error: ec> - <primitive: 'primitiveFileClose' module: 'FilePlugin'> self primitiveFailed !

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages May 2023