Packages January 2023

packages@lists.squeakfoundation.org

1 participants
145 discussions

The Trunk: Regex-Core-tpr.85.mcz
by commits＠source.squeak.org 16 Jan '23

16 Jan '23

tim Rowledge uploaded a new version of Regex-Core to project The Trunk: http://source.squeak.org/trunk/Regex-Core-tpr.85.mcz ==================== Summary ==================== Name: Regex-Core-tpr.85 Author: tpr Time: 15 January 2023, 6:02:40.963166 pm UUID: 8b64a0db-b5f5-447d-ac45-35bc7e07fbec Ancestors: Regex-Core-ct.84 Remove some variable shadowing =============== Diff against Regex-Core-ct.84 =============== Item was changed: ----- Method: RxMatcher>>copy:replacingMatchesWith: (in category 'match enumeration') ----- copy: aString replacingMatchesWith: replacementString "Copy <aString>, except for the matches. Replace each match with <aString>." + ^String new: (aString size min: 1000) streamContents: [ :strm | - ^String new: (aString size min: 1000) streamContents: [ :stream | self copyStream: aString readStream + to: strm - to: stream replacingMatchesWith: replacementString ]!

1 0

The Trunk: Network-tpr.264.mcz
by commits＠source.squeak.org 16 Jan '23

16 Jan '23

tim Rowledge uploaded a new version of Network to project The Trunk: http://source.squeak.org/trunk/Network-tpr.264.mcz ==================== Summary ==================== Name: Network-tpr.264 Author: tpr Time: 15 January 2023, 6:01:24.759824 pm UUID: a2fe0a42-67a4-4cf0-a108-190641256a38 Ancestors: Network-ct.263 Remove some variable shadowing =============== Diff against Network-ct.263 =============== Item was changed: ----- Method: FtpUrl>>retrieveContents (in category 'downloading') ----- retrieveContents "currently assumes directories end in /, and things that don't end in / are files. Also, doesn't handle errors real well...." + | server contents pathString listing auth idx fileName serverName userName | - | server contents pathString listing auth idx fileName serverName userName password | pathString := self pathString. pathString := pathString copyFrom: 2 to: pathString size. "remove the leading /" pathString last = $/ ifTrue:["directory?!!" fileName := nil. ] ifFalse:[ fileName := pathString copyFrom: (pathString lastIndexOf: $/)+1 to: pathString size. pathString := pathString copyFrom: 1 to: (pathString lastIndexOf: $/) - 1. ]. auth := self authority. idx := auth indexOf: $@. idx > 0 ifTrue:[ serverName := (auth copyFrom: idx+1 to: auth size). userName := (auth copyFrom: 1 to: idx-1). password := nil. ] ifFalse:[ serverName := auth. userName := 'anonymous'. password := 'SqueakUser'. ]. server := ServerDirectory servers detect:[:s| s isTypeFTP and:[s server asLowercase = serverName asLowercase]] ifNone:[nil]. server ifNil:[ server := ServerDirectory new. server server: serverName. ] ifNotNil:[server := server copy reset]. server user: userName. password ifNotNil:[server password: password]. server directory: pathString. fileName == nil ifFalse:[ "a file" contents := (server getFileNamed: fileName). server sleep. ^MIMEDocument contentType: (MIMEDocument guessTypeFromName: self path last) content: contents]. "a directory?" listing := String streamContents: [ :stream | stream nextPutAll: '<title>', self pathString, '</title>'; cr. stream nextPutAll: '<h1>Listing for ', self pathString, '</h1>'; cr. stream nextPutAll: '<ul>'; cr. server entries do: [ :entry | stream nextPutAll: '<li>'; nextPutAll: '<a href="', entry name encodeForHTTP. entry isDirectory ifTrue: [ stream nextPut: $/ ]. stream nextPutAll: '">'; nextPutAll: entry name; nextPutAll: '</a>'; cr ] ]. server sleep. ^MIMEDocument contentType: 'text/html' content: listing!

1 0

The Trunk: MorphicTests-tpr.91.mcz
by commits＠source.squeak.org 16 Jan '23

16 Jan '23

tim Rowledge uploaded a new version of MorphicTests to project The Trunk: http://source.squeak.org/trunk/MorphicTests-tpr.91.mcz ==================== Summary ==================== Name: MorphicTests-tpr.91 Author: tpr Time: 15 January 2023, 6:00:29.415403 pm UUID: fd5bf37d-f82b-46a2-b4f1-5856b724dfe6 Ancestors: MorphicTests-eem.90 Remove some variable shadowing =============== Diff against MorphicTests-eem.90 =============== Item was changed: ----- Method: TableLayoutTest>>testScrollPaneBarUpdate (in category 'tests - scroll panes') ----- testScrollPaneBarUpdate + | child | - | child container | container := ScrollPane new color: Color green; extent: 300 @ 300; showVScrollBarOnlyWhenNeeded; showHScrollBarOnlyWhenNeeded. container scroller addMorphBack: (child := Morph new color: Color red; extent: 100 @ 100). self ensureLayout: container. self assert: container hScrollBar owner isNil. self assert: container vScrollBar owner isNil. child extent: 400 @ 100. self ensureLayout: container. self assert: container hScrollBar owner notNil. self assert: container vScrollBar owner isNil. child extent: 400 @ 400. self ensureLayout: container. self assert: container hScrollBar owner notNil. self assert: container hScrollBar owner notNil! Item was changed: ----- Method: TableLayoutTest>>testShrinkWrapIssue (in category 'tests') ----- testShrinkWrapIssue + "A container that has no layout policy does MUST trigger layout computation for its submorphs in time." + | inner item1 item2 | - "A container that has no layout policy does MUST trigger layout computation for its submorphs in time." - - | container inner item1 item2 | container := Morph new hResizing: #shrinkWrap; vResizing: #shrinkWrap; yourself. inner := self newContainer listDirection: #topToBottom; yourself. container addMorphBack: inner. inner addMorphBack: (item1 := self newMorph extent: 50@50; yourself); addMorphBack: (item2 := self newMorph extent: 50@50; yourself). self ensureLayout: container. self assert: 50@100 equals: container extent. item1 width: 100. item2 width: 200. self ensureLayout: container. self assert: 200@100 equals: container extent.! Item was changed: ----- Method: TextAnchorTest>>testResizeAnchoredMorph (in category 'tests') ----- testResizeAnchoredMorph + | priorExtent | - | anchoredMorph priorExtent | anchoredMorph := EllipseMorph new. anchoredMorph extent: 50@50. text := 'Hello, World!!\-> X <-\Hello, World!!' withCRs asText copyReplaceTokens: 'X' with: (Text string: Character startOfHeader asString attribute: (TextAnchor new anchoredMorph: anchoredMorph)). self prepareTextMorph. "Height is easy because morph is higher than the font." priorExtent := textMorph extent. anchoredMorph height: anchoredMorph height + 15. self refreshTextMorph. self assert: priorExtent y + 15 equals: textMorph height. "Width must be at least the text width." anchoredMorph width: textMorph width. self refreshTextMorph. priorExtent := textMorph extent. anchoredMorph width: anchoredMorph width + 15. self refreshTextMorph. self assert: priorExtent x + 15 equals: textMorph width.!

1 0

The Trunk: MorphicExtras-tpr.340.mcz
by commits＠source.squeak.org 16 Jan '23

16 Jan '23

tim Rowledge uploaded a new version of MorphicExtras to project The Trunk: http://source.squeak.org/trunk/MorphicExtras-tpr.340.mcz ==================== Summary ==================== Name: MorphicExtras-tpr.340 Author: tpr Time: 15 January 2023, 5:58:13.807896 pm UUID: b7a3b5ab-6aa5-4d19-bf3a-90a7c22110d9 Ancestors: MorphicExtras-tpr.339 Remove some variable shadowing =============== Diff against MorphicExtras-tpr.339 =============== Item was changed: ----- Method: BookMorph>>insertPageColored: (in category 'insert and delete') ----- insertPageColored: aColor "Insert a new page for the receiver, using the given color as its background color" + | pageExtent newPage newPageBorderWidth backgroundColor | + currentPage + ifNil: + [pageExtent := pageSize. + newPageBorderWidth := 0. + backgroundColor := Color blue muchLighter] + ifNotNil: + [pageExtent := currentPage extent. + newPageBorderWidth := currentPage borderWidth. + backgroundColor := currentPage borderColor]. + newPagePrototype + ifNil: + [newPage := PasteUpMorph new. - | pageExtent newPage borderWidth backgroundColor | - backgroundColor := currentPage isNil - ifTrue: - [pageExtent := pageSize. - borderWidth := 0. - Color blue muchLighter] - ifFalse: - [pageExtent := currentPage extent. - borderWidth := currentPage borderWidth. - currentPage borderColor]. - newPagePrototype ifNil: - [newPage := (PasteUpMorph new) - extent: pageExtent; - color: aColor. newPage + extent: pageExtent; + color: aColor; + borderWidth: newPageBorderWidth; - borderWidth: borderWidth; borderColor: backgroundColor] ifNotNil: [newPage := Cursor wait showWhile: [newPagePrototype veryDeepCopy]]. newPage setNameTo: self defaultNameStemForNewPages. newPage vResizeToFit: false. pages isEmpty ifTrue: [pages add: (currentPage := newPage)] ifFalse: [pages add: newPage after: currentPage]. self nextPage! Item was changed: ----- Method: ObjectsTool>>highlightOnlySubmorph:in: (in category 'tabs') ----- highlightOnlySubmorph: aMorph in: anotherMorph "Distinguish only aMorph with border highlighting (2-pixel wide red); make all my other submorphs have one-pixel-black highlighting. This is a rather special-purpose and hard-coded highlighting regime, of course. Later, if someone cared to do it, we could parameterize the widths and colors via properties, or some such." + anotherMorph submorphs do: + [:m | | newColor | + newColor := m == aMorph + ifTrue: [self buttonActiveColor] + ifFalse: [self buttonColor]. - anotherMorph submorphs do: [:m | | color | - color := m == aMorph ifTrue: [self buttonActiveColor] ifFalse: [self buttonColor]. m + borderWidth: 1; + borderColor: newColor. + m firstSubmorph color: newColor] + ! - borderWidth: 1 px; - borderColor: color. - m firstSubmorph color: color]! Item was changed: ----- Method: SketchEditorMorph>>initializeFor:inBounds:pasteUpMorph: (in category 'initialization') ----- initializeFor: aSketchMorph inBounds: boundsToUse pasteUpMorph: aPasteUpMorph "Initialize the receiver to edit the given sketchMorph in the given bounds, with the resulting object to reside in the given pasteUpMorph." | paintBoxBounds worldBounds | self world paintingFlapTab ifNotNil: [:tab | tab showFlap. ^ self initializeFor: aSketchMorph inBounds: boundsToUse pasteUpMorph: aPasteUpMorph paintBoxPosition: nil]. self setProperty: #recipientPasteUp toValue: aPasteUpMorph. paintBoxBounds := self world paintBox bounds. worldBounds := self world bounds. + aPasteUpMorph standardPalette ifNotNil: [:stdPalette | stdPalette showNoPalette]. - aPasteUpMorph standardPalette ifNotNil: [:palette | palette showNoPalette]. self initializeFor: aSketchMorph inBounds: boundsToUse pasteUpMorph: aPasteUpMorph paintBoxPosition: ((boundsToUse topRight extent: paintBoxBounds extent) translatedToBeWithin: worldBounds) topLeft. !

1 0

The Trunk: Morphic-tpr.2062.mcz
by commits＠source.squeak.org 16 Jan '23

16 Jan '23

tim Rowledge uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-tpr.2062.mcz ==================== Summary ==================== Name: Morphic-tpr.2062 Author: tpr Time: 15 January 2023, 5:55:05.184058 pm UUID: 54eed292-3382-4612-ba90-ac754dab6a07 Ancestors: Morphic-mt.2061 Remove some variable shadowing =============== Diff against Morphic-mt.2061 =============== Item was changed: ----- Method: BorderedMorph>>doFastWindowReframe: (in category 'resize handling') ----- doFastWindowReframe: ptName | newBounds delta | "For fast display, only higlight the rectangle during loop" + newBounds := self bounds newRectButtonPressedDo: + [:f | - newBounds := self bounds newRectButtonPressedDo: [:f | f withSideOrCorner: ptName setToPoint: (self pointFromWorld: Sensor cursorPoint) minExtent: self minimumExtent]. delta := newBounds origin - self bounds origin. self bounds: newBounds. + self flag: #workaround. "mt: Due to a layout-specific 'let us start in the top-left corner of a layout cell'-behavior, we have to go up the owner chain and propagate the delta. See Morph >> #layoutInBounds:positioning: and there section 1.2." + + self allOwnersDo: + [:thisOwner | + (thisOwner layoutPolicy notNil and: [thisOwner ~~ Project current world]) + ifTrue: [thisOwner topLeft: owner topLeft + delta]]. - self allOwnersDo: [:owner | - (owner layoutPolicy notNil and: [owner ~~ Project current world]) - ifTrue: [owner topLeft: owner topLeft + delta]]. ^newBounds.! Item was changed: ----- Method: DockingBarMenuMorph>>popUpAdjacentTo:forHand:from: (in category 'as yet unclassified') ----- popUpAdjacentTo: rightOrLeftPoint forHand: hand from: sourceItem | ownerInWorld world | super popUpAdjacentTo: rightOrLeftPoint forHand: hand from: sourceItem. "Docking bar and protruding menu should appear visually merged. Move the source item behind the receiver. If we did it the other way around, other navigators and docking bars in front of the sourceItem would cover the receiver. For the same reason, we can't use a higher different morphic layer numbers for docking bar menus because this would hide them after all other navigators." world := owner world. + ownerInWorld := sourceItem firstOwnerSuchThat: [:thisOwner | thisOwner owner == world]. - ownerInWorld := sourceItem firstOwnerSuchThat: [:owner | owner owner == world]. world addMorph: ownerInWorld inFrontOf: self.! Item was changed: ----- Method: IndentingListItemMorph>>charactersOccluded (in category 'private') ----- charactersOccluded "Answer the number of characters occluded in my #visibleList by my right edge." | listIndex leftEdgeOfRightmostColumn eachString indexOfLastVisible iconWidth totalWidth | listIndex := 0. leftEdgeOfRightmostColumn := container columns ifNil: [ 0 ] ifNotNil: + [:cols | (1 to: cols size - 1) - [ : cols | (1 to: cols size - 1) inject: 0 + into: [:sum :each | sum + (self widthOfColumn: each) ] ]. - into: - [ : sum : each | sum + (self widthOfColumn: each) ] ]. eachString := container columns ifNil: [ self complexContents asString ] ifNotNil: + [:cols | self contentsAtColumn: container columns size ]. - [ : cols | self contentsAtColumn: container columns size ]. iconWidth := self icon ifNil: [ 0 ] ifNotNil: + [:theIcon | theIcon width + 2 ]. - [ : icon | icon width + 2 ]. totalWidth := self toggleBounds right. indexOfLastVisible := ((1 to: eachString size) detect: + [:stringIndex | (totalWidth := totalWidth + + (self fontToUse widthOf: (eachString at: stringIndex))) > (container width - (container vIsScrollbarShowing - [ : stringIndex | (totalWidth:=totalWidth+(self fontToUse widthOf: (eachString at: stringIndex))) > - (container width - - (container vIsScrollbarShowing ifTrue: [ container vScrollBar width ] ifFalse: [ 0 ]) - iconWidth - leftEdgeOfRightmostColumn) ] ifNone: [ eachString size + 1 ]) - 1. ^ eachString size - indexOfLastVisible! Item was changed: ----- Method: LazyListMorph>>drawOn: (in category 'drawing') ----- drawOn: aCanvas | topRow bottomRow | + self backgroundColor ifNotNil: + [:bkgndColor | + aCanvas fillRectangle: (self topLeft corner: self right @ ((self owner ifNil: [self]) bottom)) color: bkgndColor]. - self backgroundColor ifNotNil: [:color | - aCanvas fillRectangle: (self topLeft corner: self right @ ((self owner ifNil: [self]) bottom)) color: color]. self getListSize = 0 ifTrue: [ ^self ]. self drawPreSelectionOn: aCanvas. topRow := self topVisibleRowForCanvas: aCanvas. bottomRow := self bottomVisibleRowForCanvas: aCanvas. "Draw multi-selection." + self listSource hasMultiSelection ifTrue: + [topRow to: bottomRow do: + [:row | + (self listSource itemSelectedAmongMultiple: row) ifTrue: + [self drawBackgroundForMulti: row on: aCanvas]]]. - self listSource hasMultiSelection ifTrue: [ - topRow to: bottomRow do: [ :row | - (self listSource itemSelectedAmongMultiple: row) ifTrue: [ - self drawBackgroundForMulti: row on: aCanvas ] ] ]. self drawSelectionOn: aCanvas. "Draw hovered row if preference enabled." + PluggableListMorph highlightHoveredRow ifTrue: + [self listSource hoverRow > 0 ifTrue: + [self highlightHoverRow: listSource hoverRow on: aCanvas ]]. - PluggableListMorph highlightHoveredRow ifTrue: [ - self listSource hoverRow > 0 ifTrue: [ - self highlightHoverRow: listSource hoverRow on: aCanvas ] ]. "Draw all visible rows." + topRow to: bottomRow do: + [:row | - topRow to: bottomRow do: [ :row | self display: (self item: row) atRow: row on: aCanvas ]. "Finally, highlight drop row for drag/drop operations.." + self listSource potentialDropRow > 0 ifTrue: + [self highlightPotentialDropRow: self listSource potentialDropRow on: aCanvas ].! - self listSource potentialDropRow > 0 ifTrue: [ - self highlightPotentialDropRow: self listSource potentialDropRow on: aCanvas ].! Item was changed: ----- Method: MenuMorph>>invokeAt:in:allowKeyboard: (in category 'modal control') ----- invokeAt: aPoint in: aWorld allowKeyboard: aBoolean "Add this menu to the given world centered at the given point. Wait for the user to make a selection and answer it. The selection value returned is an integer in keeping with PopUpMenu, if the menu is converted from an MVC-style menu." "Details: This is invoked synchronously from the caller. In order to keep processing inputs and updating the screen while waiting for the user to respond, this method has its own version of the World's event loop." + | w | - | w originalFocusHolder | - originalFocusHolder := aWorld primaryHand keyboardFocus. self popUpAt: aPoint forHand: aWorld primaryHand in: aWorld allowKeyboard: aBoolean. w := aWorld outermostWorldMorph. "containing hand" + [self isInWorld] whileTrue: + [w doOneSubCycle]. + self delete! - [self isInWorld] whileTrue: [w doOneSubCycle]. - self delete. - originalFocusHolder ifNotNil: [aWorld primaryHand newKeyboardFocus: originalFocusHolder]. - ! Item was changed: ----- Method: PluggableListMorph>>getFilteredList (in category 'model access - cached') ----- getFilteredList "Apply the current filter to the list. Maybe shorten the filter term if there are no matches." + | filteredList | + self getFullList ifEmpty: [^ fullList]. - | fullList filteredList | - fullList := self getFullList. self hasFilter ifFalse: [^ fullList]. - fullList ifEmpty: [^ fullList]. filteredList := self filterList: fullList matching: lastKeystrokes. (filteredList isEmpty not or: [ self allowEmptyFilterResult ]) ifFalse: [ "Remove the last character and try filtering again." lastKeystrokes := lastKeystrokes allButLast: 1. ^ self flash; getFilteredList ]. ^ filteredList! Item was changed: ----- Method: PluggableMultiColumnListMorph>>getFilteredList (in category 'filtering') ----- getFilteredList "Apply the current filter to the list. Maybe shorten the filter term if there are no matches." + | filteredList | + self getFullList. - | fullList filteredList | - fullList := self getFullList. self hasFilter ifFalse: [^ fullList]. fullList ifEmpty: [^ fullList]. fullList first ifEmpty: [^ fullList]. filteredList := self filterList: fullList matching: lastKeystrokes. + (filteredList first isEmpty not or: [ self allowEmptyFilterResult ]) ifFalse: + [ "Remove the last character and try filtering again." + lastKeystrokes := lastKeystrokes allButLast: 1. + ^ self + flash; + getFilteredList ]. - (filteredList first isEmpty not or: [ self allowEmptyFilterResult ]) - ifFalse: - [ "Remove the last character and try filtering again." - lastKeystrokes := lastKeystrokes allButLast: 1. - ^ self - flash; - getFilteredList ]. ^ filteredList! Item was changed: ----- Method: PluggableMultiColumnListMorph>>hoverRow: (in category 'accessing') ----- hoverRow: viewIndex hoverRow = viewIndex ifTrue: [^ self]. + listMorphs do: + [:lMorph | + lMorph rowChanged: hoverRow with: viewIndex]. - listMorphs do: [:listMorph | - listMorph rowChanged: hoverRow with: viewIndex]. super hoverRow: viewIndex.! Item was changed: ----- Method: PluggableMultiColumnListMorph>>rowAboutToBecomeSelected: (in category 'selection') ----- rowAboutToBecomeSelected: anInteger + listMorphs do: + [:lMorph | + lMorph preSelectedRow: anInteger]. - listMorphs do: [:listMorph | listMorph preSelectedRow: anInteger]. super rowAboutToBecomeSelected: anInteger.! Item was changed: ----- Method: PluggableMultiColumnListMorph>>rowAtLocation: (in category 'accessing - items') ----- rowAtLocation: aPoint "Return the row at the given point or 0 if outside" | pointInListMorphCoords rowIndex | pointInListMorphCoords := (self scroller transformFrom: self) transform: aPoint. + listMorphs do: + [:lMorph | + rowIndex := lMorph rowAtLocation: pointInListMorphCoords. - listMorphs do: [:listMorph | - rowIndex := listMorph rowAtLocation: pointInListMorphCoords. rowIndex > 0 ifTrue: [^ rowIndex]]. ^ 0 ! Item was changed: ----- Method: PluggableMultiColumnListMorph>>selectionIndex: (in category 'selection') ----- selectionIndex: viewIndex + listMorphs do: + [:lMorph | + lMorph selectedRow: (viewIndex min: self listSize)]. - listMorphs do: [:listMorph | listMorph selectedRow: (viewIndex min: self listSize)]. "ct: As per the invariant defined in #setListParameters, listMorphs always includes listMorph. Subsequently, every super send in #selectionIndex: would be without effect because #selectionIndex already has been updated in the child class. Since selection highlighting is also not relevant for multi-column list morphs (this hook is only used by SimpleHierarchicalListMorph), we can refuse this bequest but send #scrollSelectionIntoView manually." + self scrollSelectionIntoView.! Item was changed: ----- Method: PluggableMultiColumnListMorph>>textColor: (in category 'initialization') ----- textColor: aColor + listMorphs do: + [:lMorph | + lMorph color: aColor]. - listMorphs do: [:listMorph | listMorph color: aColor]. super textColor: aColor.! Item was changed: ----- Method: PluggableMultiColumnListMorph>>updateColumns (in category 'updating') ----- updateColumns "The number of columns must match the number of list morphs." | columnsChanged | columnsChanged := self columnCount ~= listMorphs size. + [self columnCount < listMorphs size] whileTrue: + [listMorphs removeLast delete]. - [self columnCount < listMorphs size] - whileTrue: [ - listMorphs removeLast delete]. + [self columnCount > listMorphs size] whileTrue: + [listMorphs addLast: self createListMorph. + self scroller addMorphBack: listMorphs last]. - [self columnCount > listMorphs size] - whileTrue: [ - listMorphs addLast: self createListMorph. - self scroller addMorphBack: listMorphs last]. + listMorphs withIndexDo: + [:lMorph :columnIndex | + lMorph - listMorphs withIndexDo: [:listMorph :columnIndex | - listMorph columnIndex: columnIndex; color: self textColor; cellPositioning: (self cellPositioningAtColumn: columnIndex); cellInset: (self cellInsetAtColumn: columnIndex); hResizing: (self hResizingAtColumn: columnIndex); spaceFillWeight: (self spaceFillWeightAtColumn: columnIndex)]. columnsChanged ifTrue: [self setListParameters].! Item was changed: ----- Method: SystemWindow>>paneColorToUseWhenNotActive (in category 'colors') ----- paneColorToUseWhenNotActive + ^ (self userInterfaceTheme unfocusedWindowColorModifier ifNil: [ [:col | col darker] ]) - ^ (self userInterfaceTheme unfocusedWindowColorModifier ifNil: [ [:color | color darker] ]) value: self paneColorToUse!

1 0

The Trunk: Monticello-tpr.787.mcz
by commits＠source.squeak.org 16 Jan '23

16 Jan '23

tim Rowledge uploaded a new version of Monticello to project The Trunk: http://source.squeak.org/trunk/Monticello-tpr.787.mcz ==================== Summary ==================== Name: Monticello-tpr.787 Author: tpr Time: 15 January 2023, 4:42:50.007245 pm UUID: b343ba07-4b43-4eae-9293-e18d885d0d06 Ancestors: Monticello-eem.786 Remove some variable shadowing =============== Diff against Monticello-eem.786 =============== Item was changed: ----- Method: MCClassDefinition>>createClass (in category 'installing') ----- createClass | environment superClass class composition | environment := Environment current. superClass := superclassName == #nil ifFalse: [environment valueOf: superclassName ifAbsent: [(KeyNotFound key: superclassName) signal]]. [class := (ClassBuilder new) name: name inEnvironment: environment subclassOf: superClass type: type instanceVariableNames: self instanceVariablesString classVariableNames: self classVariablesString poolDictionaries: self sharedPoolsString + category: category] + on: Warning, DuplicateVariableError + do:[:ex| ex resume]. - category: category. - ] on: Warning, DuplicateVariableError do:[:ex| ex resume]. "The following is written to support traits unloading" + composition := self traitComposition ifNil: [Array empty] ifNotNil: [:traitComp | Compiler evaluate: traitComp]. + (composition isCollection and:[composition isEmpty and:[class traitComposition isEmpty]]) ifFalse: + [class setTraitComposition: composition asTraitComposition]. - composition := self traitComposition ifNil: [Array empty] ifNotNil: [:traitComposition | Compiler evaluate: traitComposition]. - (composition isCollection and:[composition isEmpty and:[class traitComposition isEmpty]]) ifFalse:[ - class setTraitComposition: composition asTraitComposition. - ]. + composition := self classTraitComposition + ifNil: [Array new] + ifNotNil: [:traitComp | Compiler evaluate: traitComp]. + (composition isCollection and:[composition isEmpty and:[class class traitComposition isEmpty]]) ifFalse: + [class class setTraitComposition: composition asTraitComposition]. - composition := self classTraitComposition ifNil: [Array new] ifNotNil: [:traitComposition | Compiler evaluate: traitComposition]. - (composition isCollection and:[composition isEmpty and:[class class traitComposition isEmpty]]) ifFalse:[ - class class setTraitComposition: composition asTraitComposition. - ]. ^class! Item was changed: ----- Method: MCMethodDefinition>>printAnnotations:on: (in category 'annotations') ----- printAnnotations: requests on: aStream "Add a string for an annotation pane, trying to fulfill the annotation requests. These might include anything that Preferences defaultAnnotationRequests might return. Which includes anything in Preferences annotationInfo To edit these, use:" "Preferences editAnnotations" | annotationSeparator annotations | annotationSeparator := ' · '. "Same as in CodeHolder" annotations := requests collect: [:request | request caseOf: { [#timeStamp] -> [self timeStamp]. [#author] -> [ | initials | + initials := self timeStamp findTokens ifNotEmpty: [:tokens | tokens first]. - initials := self timeStamp ifNotNil: [:timeStamp | - timeStamp findTokens ifNotEmpty: [:tokens | tokens first]]. SystemNavigation authorsInverted at: initials ifPresent: [:fullNames | fullNames anyOne] ifAbsent: ['unknown author' translated]]. [#messageCategory] -> [self category]. [#requirements] -> [self requirements joinSeparatedBy: Character space] } otherwise: []] thenSelect: [:annotation | annotation isEmptyOrNil not]. annotations do: [:annotation | aStream nextPutAll: annotation] separatedBy: [aStream nextPutAll: annotationSeparator].!

1 0

The Trunk: KernelTests-tpr.441.mcz
by commits＠source.squeak.org 16 Jan '23

16 Jan '23

tim Rowledge uploaded a new version of KernelTests to project The Trunk: http://source.squeak.org/trunk/KernelTests-tpr.441.mcz ==================== Summary ==================== Name: KernelTests-tpr.441 Author: tpr Time: 15 January 2023, 4:41:44.135551 pm UUID: 2d8e9299-b189-4012-9a86-3fb744ebe79a Ancestors: KernelTests-ct.440 Remove some variable shadowing =============== Diff against KernelTests-ct.440 =============== Item was changed: ----- Method: ProcessTest>>testResumeTerminatingProcess (in category 'tests') ----- testResumeTerminatingProcess "An attempt to resume a terminating process should probably raise an error; leave this test as an expected failure for the moment." + | terminatee terminator resumed | - | terminatee terminator resumed semaphore | - semaphore := Semaphore new. terminatee := [semaphore critical:[]. resumed := true] fork. Processor yield. terminator := [terminatee terminate] newProcess. self assert: terminatee suspendingList == semaphore. self assert: terminator isSuspended. "run terminator and stop inside #terminate" terminator runUntil: [:ctx | ctx selectorToSendOrSelf = #priority:]. self assert: terminator isSuspended. "resume the terminatee process and and check if the VM raises an error; an error is expected because terminatee's suspendedContext equals nil" self should: [terminatee resume] raise: Error. "now let the terminator finish terminating the terminatee process" terminator resume. Processor yield. self assert: resumed isNil. self assert: terminatee isTerminated. self assert: terminator isTerminated! Item was changed: ----- Method: ProcessTest>>testTerminateTerminatingProcess (in category 'tests') ----- testTerminateTerminatingProcess "An attempt to terminate a terminating process should probably raise an error; leave this test as an expected failure for the moment." + | terminatee terminator resumed | - | terminatee terminator resumed semaphore | - semaphore := Semaphore new. terminatee := [semaphore critical:[]. resumed := true] fork. Processor yield. terminator := [terminatee terminate] newProcess. self assert: terminatee suspendingList == semaphore. self assert: terminator isSuspended. "run terminator and stop inside #terminate" terminator runUntil: [:ctx | ctx selectorToSendOrSelf = #priority:]. self assert: terminator isSuspended. "terminate the terminatee process again and let the termination finish; an error is expected because #terminate detected multiple termination" self should: [terminatee terminate] raise: Error. "now let the terminator finish terminating the terminatee process" terminator resume. Processor yield. self assert: resumed isNil. self assert: terminatee isTerminated. self assert: terminator isTerminated!

1 0

The Trunk: Kernel-tpr.1497.mcz
by commits＠source.squeak.org 16 Jan '23

16 Jan '23

tim Rowledge uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-tpr.1497.mcz ==================== Summary ==================== Name: Kernel-tpr.1497 Author: tpr Time: 15 January 2023, 4:40:44.508752 pm UUID: 88b6b837-6df9-4e70-851b-1666f00316a3 Ancestors: Kernel-eem.1496 Remove some variable shadowing. Be nice to Levente's beautiful code =============== Diff against Kernel-eem.1496 =============== Item was changed: ----- Method: Context>>directedSuperSend:numArgs: (in category 'instruction decoding') ----- directedSuperSend: selector numArgs: numArgs "Simulate the action of bytecodes that send a message with selector, selector, starting the message lookup in the superclass of the class on top of stack. The arguments of the message are found in the next numArgs locations on the stack and the receiver just below them." + | class newReceiver arguments | - | class receiver arguments | class := self pop. arguments := Array new: numArgs. numArgs to: 1 by: -1 do: [ :i | arguments at: i put: self pop]. + newReceiver := self pop. - receiver := self pop. QuickStep == self ifTrue: [QuickStep := nil. + ^self quickSend: selector to: newReceiver with: arguments lookupIn: class superclass]. + ^self send: selector to: newReceiver with: arguments lookupIn: class superclass! - ^self quickSend: selector to: receiver with: arguments lookupIn: class superclass]. - ^self send: selector to: receiver with: arguments lookupIn: class superclass! Item was changed: ----- Method: Random>>hashSeed: (in category 'private') ----- hashSeed: anInteger "Use the 32-bit version of the FNV-1a algorithm to hash the seed, and return a 32-bit unsigned integer." | fnvPrime hash | fnvPrime := 16777619 " 32-bit FVN prime ". hash := anInteger negative ifTrue: [ 3490449840 " mix in the sign as (2166136261 bitXor: 2r1010101) * 16777619 bitAnd: 16rFFFFFFFF "] ifFalse: [ 2166136261 " 32-bit FVN offset basis "]. + 1 to: anInteger digitLength do: [ :digitIndex | + hash := 16rFFFFFFFF bitAnd: (hash bitXor: (anInteger digitAt: digitIndex)) * fnvPrime ]. - 1 to: anInteger digitLength do: [ :index | - hash := 16rFFFFFFFF bitAnd: (hash bitXor: (anInteger digitAt: index)) * fnvPrime ]. ^hash! Item was changed: ----- Method: Random>>next:into: (in category 'accessing') ----- next: anInteger into: anArray + 1 to: anInteger do: + [:i | + anArray at: i put: self next]. - 1 to: anInteger do: [:index | anArray at: index put: self next]. ^ anArray! Item was changed: ----- Method: Random>>nextBytes:into:startingAt: (in category 'accessing') ----- nextBytes: anInteger into: aBytesObject startingAt: startIndex "Fill aBytesObject, an object with indexable byte fields, with anInteger number of random bytes starting from startIndex. Assume that MTw is at least 8." + | randomValue remainingBits byteIndex endIndex | - | randomValue remainingBits index endIndex | randomValue := remainingBits := 0. + byteIndex := startIndex. - index := startIndex. endIndex := startIndex + anInteger - 1. + [ byteIndex <= endIndex ] whileTrue: [ - [ index <= endIndex ] whileTrue: [ remainingBits >= 8 ifTrue: [ + aBytesObject basicAt: byteIndex put: (randomValue bitAnd: 16rFF). - aBytesObject basicAt: index put: (randomValue bitAnd: 16rFF). randomValue := randomValue bitShift: -8. remainingBits := remainingBits - 8. + byteIndex := byteIndex + 1 ] - index := index + 1 ] ifFalse: [ remainingBits = 0 ifTrue: [ randomValue := self nextValue ] ifFalse: [ | newRandomValue | newRandomValue := self nextValue. + aBytesObject basicAt: byteIndex put: (randomValue bitShift: 8 - remainingBits) + - aBytesObject basicAt: index put: (randomValue bitShift: 8 - remainingBits) + (newRandomValue bitAnd: (1 bitShift: 8 - remainingBits) - 1). randomValue := newRandomValue bitShift: 0 - remainingBits. + byteIndex := byteIndex + 1 ]. - index := index + 1 ]. remainingBits := MTw - remainingBits ] ]!

1 0

The Trunk: HelpSystem-Core-tpr.141.mcz
by commits＠source.squeak.org 16 Jan '23

16 Jan '23

tim Rowledge uploaded a new version of HelpSystem-Core to project The Trunk: http://source.squeak.org/trunk/HelpSystem-Core-tpr.141.mcz ==================== Summary ==================== Name: HelpSystem-Core-tpr.141 Author: tpr Time: 15 January 2023, 4:32:40.429833 pm UUID: 78bb8fe9-1e02-46b5-9778-b54f49ca2685 Ancestors: HelpSystem-Core-mt.140 Remove some variable shadowing =============== Diff against HelpSystem-Core-mt.140 =============== Item was changed: ----- Method: ClassBasedHelpTopic>>updateSubtopics (in category 'updating') ----- updateSubtopics "build a list of subtopics; start with the list of page names specified by the helpClass' #pages method, remembering that it is an ordered list of - selectors that return a HelpTopic, - or the name of a class that must in turn provide help topics etc. This allows for hierarchies with 'subtrees in the middle'. The order of the pages reflects the order of the selectors and class names given. Then all the subclasses that are not #ignore'd and not already included are added. Finally the list of class names and messages is used to assemble the actual help topics. Questions: is it actually useful to include the possibility of class names as per the CustomHelpHelpBuilder>createTopicFrom: code? is the #ignore testing worth keeping?" | pages | pages := (self helpClass pages collect: [:pageSelectorOrClassName | (Smalltalk hasClassNamed: pageSelectorOrClassName asString) ifTrue: [Smalltalk classNamed: pageSelectorOrClassName asString] ifFalse: [pageSelectorOrClassName]]) asOrderedCollection. self helpClass subclasses select: [:cls | cls ignore not] thenDo: [:cls | pages addIfNotPresent: cls]. + ^ subtopics := pages withIndexCollect: [:pageSelectorOrClass :pagePriority | - ^ subtopics := pages withIndexCollect: [:pageSelectorOrClass :priority | pageSelectorOrClass isBehavior ifFalse: [(self helpClass perform: pageSelectorOrClass) + priority: pagePriority - pages size; - priority: priority - pages size; key: pageSelectorOrClass; in: [:topic | "Use my choice of styling if my subtopics do not care." topic shouldStyle ifNil: [topic shouldStyle: self usesCodeStyling]]; yourself] ifTrue: [pageSelectorOrClass asHelpTopic]]!

1 0

The Trunk: Help-Squeak-Project-tpr.97.mcz
by commits＠source.squeak.org 16 Jan '23

16 Jan '23

tim Rowledge uploaded a new version of Help-Squeak-Project to project The Trunk: http://source.squeak.org/trunk/Help-Squeak-Project-tpr.97.mcz ==================== Summary ==================== Name: Help-Squeak-Project-tpr.97 Author: tpr Time: 15 January 2023, 4:31:41.748939 pm UUID: f052aa8f-0b24-49d7-9685-2d5449d53dda Ancestors: Help-Squeak-Project-ct.96 Remove some variable shadowing =============== Diff against Help-Squeak-Project-ct.96 =============== Item was changed: ----- Method: SqueakMessageCategoriesHelp class>>addAllCategoriesTopicTo: (in category 'private') ----- addAllCategoriesTopicTo: newTopic | mapping allCategoriesTopic | allCategoriesTopic := HelpTopic title: 'All message categories' icon: (HelpIcons iconNamed: #bookIcon) contents: self allCategoriesExplanation. mapping := IdentityDictionary new. SystemNavigation allBehaviorsDo: [:behavior | ((behavior organization categories + reject: [:cat | cat first = $*]) + collect: [:cat | (cat findTokens: '-') first withBlanksTrimmed]) + do: [:cat | + (mapping at: cat asLowercase asSymbol ifAbsentPut: [Set new]) add: behavior]]. - reject: [:category | category first = $*]) - collect: [:category | (category findTokens: '-') first withBlanksTrimmed]) - do: [:category | - (mapping at: category asLowercase asSymbol ifAbsentPut: [Set new]) add: behavior]]. mapping keys sorted do: [:categoryName | allCategoriesTopic addSubtopic: (HelpTopic title: categoryName icon: (HelpIcons iconNamed: #pageIcon) contents: (((mapping at: categoryName) collect: [:c | c printString]) sorted joinSeparatedBy: ',' , String crlf))]. ^ newTopic addSubtopic: allCategoriesTopic!

1 0

← Newer
1
...
6
7
8
9
10
11
12
...
15
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages January 2023