Squeak-dev March 2022

squeak-dev@lists.squeakfoundation.org

33 participants
304 discussions

The Trunk: ToolBuilder-Morphic-mt.308.mcz
by commits＠source.squeak.org 06 Apr '22

06 Apr '22

Marcel Taeumel uploaded a new version of ToolBuilder-Morphic to project The Trunk: http://source.squeak.org/trunk/ToolBuilder-Morphic-mt.308.mcz ==================== Summary ==================== Name: ToolBuilder-Morphic-mt.308 Author: mt Time: 14 March 2022, 4:39:06.716786 pm UUID: bbb9bbdb-e30d-9243-8123-ea7b6a828e32 Ancestors: ToolBuilder-Morphic-mt.307 Fixes regression in expand button in list-chooser dialogs. Allow longer text lines in pluggable dialogs (e.g., file-save dialog). Make #softLineWrapAtVisualWrapBorder preference functional. Still disabled by default. Only for source-code panes. Tweak #initialExtent in list-chooser dialogs. =============== Diff against ToolBuilder-Morphic-mt.307 =============== Item was changed: ----- Method: DirectoryChooserDialog>>initialExtent (in category 'toolbuilder') ----- initialExtent "Since this is a single list it can be a bit narrower than a FileChooserDialog" + ^ super initialExtent * (0.6 @ 1)! - ^ super initialExtent * (0.5 @ 1)! Item was changed: ----- Method: ListChooser>>initialExtent (in category 'building') ----- initialExtent + | listFont listStyle itemCount maxItemSize | - | listFont itemCount maxItemSize cellSize | listFont := Preferences standardListFont. + listStyle := listFont asNewTextStyle. itemCount := items size. + maxItemSize := (items take: 15) inject: 0 into: [:max :item | max max: item asString size]. - maxItemSize := items inject: 0 into: [:max :item | max max: item asString size]. - cellSize := (listFont widthOf: $m) @ listFont height. + ^ (listStyle compositionWidthFor: (maxItemSize min: 50 max: 35)) - ^ ((maxItemSize min: 20 max: 10) * (listFont widthOf: $m)) @ ((ToolBuilder default listHeightFor: (itemCount min: 15 max: 5)) + self searchBarHeight + ToolBuilder default dialogSpacing)! Item was changed: ----- Method: ListMultipleChooser>>initialExtent (in category 'toolbuilder') ----- initialExtent + | listFont listStyle itemCount maxItemSize | - | listFont itemCount maxItemSize | listFont := Preferences standardListFont. + listStyle := listFont asNewTextStyle. itemCount := labels size. + maxItemSize := (labels take: 15) inject: 0 into: [:max :item | max max: item asString size]. - maxItemSize := labels inject: 0 into: [:max :item | max max: item asString size]. + ^ (listStyle compositionWidthFor: (maxItemSize min: 50 max: 35)) - ^ ((maxItemSize min: 20 max: 10) * (listFont widthOf: $m)) @ (ToolBuilder default listHeightFor: (itemCount min: 15 max: 5))! Item was changed: ----- Method: MorphicToolBuilder>>buildPluggableCodePane: (in category 'widgets optional') ----- buildPluggableCodePane: aSpec | widget | widget := super buildPluggableCodePane: aSpec. "Override code-specific default properties." widget wantsWrapBorder: PluggableTextMorph visualWrapBorder. + PluggableTextMorph softLineWrapAtVisualWrapBorder + ifTrue: [widget numCharactersPerLine: PluggableTextMorph visualWrapBorderLimit]. widget wrapFlag: (aSpec softLineWrap ifNil: [PluggableTextMorph softLineWrap]). ^ widget! Item was changed: ----- Method: MorphicToolBuilder>>buildPluggableDialog: (in category 'widgets optional') ----- buildPluggableDialog: aSpec | widget | widget := self dialogClass new. self register: widget id: aSpec name. widget model: aSpec model. "Set child dependent layout properties. The pane morph holds the special contents." widget paneMorph wantsPaneSplitters: (aSpec wantsResizeHandles ifNil: [true]). self setLayoutHintsFor: widget paneMorph spec: aSpec. widget paneMorph layoutInset: (aSpec padding ifNil: [self dialogPadding]). widget morphicLayerNumber: widget class dialogLayer. "Performance. Flip the #wantsPaneSplitters flag only after all children where added." widget paneMorph cellGap: 0. widget paneMorph wantsPaneSplitters: false; wantsGrips: false. widget paneMorph removePaneSplitters; removeGrips. "Now create the children." panes := OrderedCollection new. aSpec children isSymbol ifTrue: [ widget getChildrenSelector: aSpec children. widget update: aSpec children] ifFalse: [ self buildAll: aSpec children in: widget paneMorph]. "Avoid strange behavior in #addMorph:fullFrame:" widget paneMorph cellGap: (aSpec spacing ifNil: [self dialogSpacing]). widget paneMorph wantsPaneSplitters: (aSpec wantsResizeHandles ifNil: [true]). widget paneMorph wantsPaneSplitters ifTrue: [ widget paneMorph wantsGrips: true. widget paneMorph addPaneSplitters; addCornerGrips"; addEdgeGrips". widget paneMorph grips do: [:ea | ea showHandle: true]]. + "Increase the line width of the dialog's message to allow that longer messages accompany complex paneMorph contents." + widget messageMorph numCharactersPerLine: 65. + "Now create the buttons." aSpec buttons isSymbol ifTrue: [ widget getButtonsSelector: aSpec buttons. widget update: aSpec buttons] ifFalse: [ self buildAll: aSpec buttons in: widget buttonRowMorph. widget updateButtonProperties]. aSpec title ifNotNil: [:label | label isSymbol ifTrue:[widget getTitleSelector: label; update: label] ifFalse:[widget title: label]]. aSpec message ifNotNil: [:label | label isSymbol ifTrue:[widget getMessageSelector: label; update: label] ifFalse:[widget message: label]]. "Interaction behavior." aSpec autoCancel ifNotNil: [:b | widget autoCancel: b]. aSpec exclusive ifNotNil: [:b | widget exclusive: b]. widget closeDialogSelector: aSpec closeAction. self buildHelpFor: widget spec: aSpec. "Everything is shrink-wrapped around the pane morph." widget paneMorph extent: (aSpec extent ifNil:[widget initialExtent]) + (widget paneMorph layoutInset * 2) asPoint. ^ widget! Item was changed: ----- Method: PluggableDialogWindow>>expandDialogPane (in category 'running') ----- expandDialogPane "Expand the dialog pane to its preferred extent, including the pane's extra layout inset used for grips. Then try again to move to the dialog's preferred position." | extra | self flag: #preferredExtentWorkaround. "mt: Working with a widget's min, max, and preferred extent is still very awkward using proportional layouts and layout frames. For now, approximate extra spacing to accommodate ListChooser and ListMultipleChooser only." + extra := PluggableListMorph listMargins. + extra := extra topLeft + extra bottomRight. - extra := LazyListMorph new cellInset. extra := extra topLeft + extra bottomRight. self paneMorph extent: (self model preferredExtent + (self paneMorph layoutInset * 2) asPoint + extra). self moveToPreferredPosition.!

3 2

The Trunk: Morphic-mt.1931.mcz
by commits＠source.squeak.org 06 Apr '22

06 Apr '22

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1931.mcz ==================== Summary ==================== Name: Morphic-mt.1931 Author: mt Time: 11 March 2022, 10:03:20.148495 am UUID: b4055ef5-466d-604e-be51-2affcbba4e6a Ancestors: Morphic-mt.1930 Improves compromise for keyboard shortcuts in TextEditor and SmalltalkTextEditor regarding [CMD]+[0..9]: - [1..5] No TextFontChange anymore in TextEditor bc. incompatible with scale factor and TrueType fonts - [1..4] still argument name insert in SmalltalkEditor - [5] opens emphasis menu (was [6]) - [6..9] add typical emphases: #bold #italic #underlined #struckOut - No #narrow anymore (was [8]) - [0] still removes those emphases - No support for US-only [=/-] anymore; was used for text kern +/- 1 Note that [CTRL]+[0..9] is not affected by this change. =============== Diff against Morphic-mt.1930 =============== Item was changed: ----- Method: SmalltalkEditor>>changeEmphasis: (in category 'editing keys') ----- changeEmphasis: characterStream + "Change emphasis without styling if necessary. NOTE THAT [cmd]+[1..4] will insert the name of the method argument number n." + - "Change emphasis without styling if necessary" self styler ifNil: [^super changeEmphasis: characterStream]. ^ self styler evaluateWithoutStyling: [super changeEmphasis: characterStream].! Item was changed: ----- Method: TextEditor class>>initializeCmdKeyShortcuts (in category 'keyboard shortcut tables') ----- initializeCmdKeyShortcuts "Initialize the (unshifted) command-key (or alt-key) shortcut table." "NOTE: if you don't know what your keyboard generates, use Sensor kbdTest" "TextEditor initialize" | cmdMap cmds | cmdMap := Array new: 256 withAll: #noop:. "use temp in case of a crash" cmdMap at: 1 + 1 put: #cursorHome:. "home key" cmdMap at: 4 + 1 put: #cursorEnd:. "end key" cmdMap at: 8 + 1 put: #backspace:. "ctrl-H or delete key" cmdMap at: 11 + 1 put: #cursorPageUp:. "page up key" cmdMap at: 12 + 1 put: #cursorPageDown:. "page down key" cmdMap at: 13 + 1 put: #crWithIndent:. "cmd-Return" cmdMap at: 27 + 1 put: #offerMenuFromEsc:. "escape key" cmdMap at: 28 + 1 put: #cursorLeft:. "left arrow key" cmdMap at: 29 + 1 put: #cursorRight:. "right arrow key" cmdMap at: 30 + 1 put: #cursorUp:. "up arrow key" cmdMap at: 31 + 1 put: #cursorDown:. "down arrow key" cmdMap at: 32 + 1 put: #selectWord:. "space bar key" cmdMap at: 127 + 1 put: #forwardDelete:. "del key" + '0123456789' - '0123456789-=' do: [:char | cmdMap at: char asciiValue + 1 put: #changeEmphasis:]. cmds := #($a #selectAll: $c #copySelection: $e #exchange: $f #find: $g #findAgain: $j #doAgain: $k #offerFontMenu: $u #align: $v #paste: $w #backWord: $x #cut: $y #swapChars: $z #undo:). 1 to: cmds size by: 2 do: [:i | cmdMap at: (cmds at: i) asciiValue + 1 put: (cmds at: i + 1)]. cmdActions := cmdMap! Item was changed: ----- Method: TextEditor>>changeEmphasis: (in category 'editing keys') ----- changeEmphasis: aKeyboardEvent "Change the emphasis of the current selection or prepare to accept characters with the change in emphasis. Emphasis change amounts to a font change. Keeps typeahead." + "[cmd]+[0..9]" - "control 0..9 -> 0..9" | keyCode attribute oldAttributes index thisSel colors extras | + keyCode := ('0123456789' indexOf: aKeyboardEvent keyCharacter ifAbsent: [1]) - 1. - keyCode := ('0123456789-=' indexOf: aKeyboardEvent keyCharacter ifAbsent: [1]) - 1. oldAttributes := paragraph text attributesAt: self pointIndex. thisSel := self selection. + "mt: Index-based font changes are not compatible with variable point sizes in text styles. Make room for other shortcuts. + (keyCode between: 1 and: 5) ifTrue: [attribute := TextFontChange fontNumber: keyCode]." - "Decipher keyCodes for Command 0-9..." - (keyCode between: 1 and: 5) - ifTrue: [attribute := TextFontChange fontNumber: keyCode]. + keyCode = 5 - keyCode = 6 ifTrue: [ colors := #(#black #magenta #red #yellow #green #blue #cyan #white). extras := self emphasisExtras. + index := Project uiManager chooseFrom: colors , #('choose color...' ), extras. - index := UIManager default chooseFrom:colors , #('choose color...' ), extras - lines: (Array with: colors size + 1). index = 0 ifTrue: [^true]. index <= colors size ifTrue: [attribute := TextColor color: (Color perform: (colors at: index))] ifFalse: [ index := index - colors size - 1. "Re-number!!!!!!" index = 0 ifTrue: [attribute := self chooseColor] ifFalse:[^self handleEmphasisExtra: index with: aKeyboardEvent] "handle an extra"]]. + (keyCode between: 6 and: 9) - (keyCode between: 7 and: 11) ifTrue: [ aKeyboardEvent shiftPressed + ifTrue: [ "Cannot be reached bc. method entry is #keyCharacter based and thus dependent on keyboard layout." + keyCode = 6 ifTrue: [attribute := TextKern kern: -1]. + keyCode = 7 ifTrue: [attribute := TextKern kern: 1]] - ifTrue: [ - keyCode = 10 ifTrue: [attribute := TextKern kern: -1]. - keyCode = 11 ifTrue: [attribute := TextKern kern: 1]] ifFalse: [ + attribute := TextEmphasis + perform: (#(#bold #italic #underlined #struckOut) at: keyCode - 5). + oldAttributes - attribute := TextEmphasis - perform: (#(#bold #italic #narrow #underlined #struckOut) at: keyCode - 6). - oldAttributes do: [:att | (att dominates: attribute) ifTrue: [attribute turnOff]]]]. keyCode = 0 ifTrue: [attribute := TextEmphasis normal]. attribute ifNotNil: [ thisSel size = 0 ifTrue: [ "only change emphasisHere while typing" self insertTypeAhead. emphasisHere := Text addAttribute: attribute toArray: oldAttributes ] ifFalse: [ self replaceSelectionWith: (thisSel asText addAttribute: attribute) ]]. ^true!

4 3

The Trunk: System-mt.1305.mcz
by commits＠source.squeak.org 05 Apr '22

05 Apr '22

Marcel Taeumel uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-mt.1305.mcz ==================== Summary ==================== Name: System-mt.1305 Author: mt Time: 9 February 2022, 5:31:22.718056 pm UUID: f02afc35-14e5-274f-b5c2-7ca510faef0d Ancestors: System-mt.1304 Increase standard window extent by about 8% so that the system browsers 'implementors' button's label is not clipped when opening a fresh browser. Works on all scale factors. =============== Diff against System-mt.1304 =============== Item was changed: ----- Method: RealEstateAgent class>>initialize (in category 'class initialization') ----- initialize "Initialize the class variables in the receiver. 5/22/96 sw" "RealEstateAgent initialize" StaggerOffset := 6 @ 20. ReverseStaggerOffset := -6 @ 20. StaggerOrigin := 200 @ 30. + StandardSize := 650 @ 425.! - StandardSize := 600@400.!

5 6

The Trunk: Collections-eem.992.mcz
by commits＠source.squeak.org 02 Apr '22

02 Apr '22

Eliot Miranda uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-eem.992.mcz ==================== Summary ==================== Name: Collections-eem.992 Author: eem Time: 1 March 2022, 12:39:53.850609 pm UUID: 677dd86e-ae58-41d3-b125-af837d2cdb61 Ancestors: Collections-mt.991 Add some missing features to the imfamous postcard. =============== Diff against Collections-mt.991 =============== Item was changed: ----- Method: Text class>>codeSample (in category 'filler text') ----- codeSample ^ 'exampleWithNumber: x "A method that illustrates every part of Smalltalk method syntax including primitives. It has unary, binary, and keyboard messages, declares arguments and temporaries, accesses a global variable + (but not an instance variable), uses literals (array, character, symbol, + string, integer, float, byte array), uses the pseudo variables nil, true, + false, self, super, and thisContext, shows that within a literal array + nil, true and false are symbols not pseudo variables, and has sequence, + assignment, return, cascade, and tuple (array) creation. It has both + zero argument and one argument blocks, and has a block temporary." - (but not an instance variable), uses literals (array, character, - symbol, string, integer, float), uses the pseudo variables true, - false, nil, self, and super, and has sequence, assignment, return - and cascade. It has both zero argument and one argument blocks." <primitive: ''primitiveCopyBits'' module: #BitBltPlugin error: ec> | y | true & false not & (nil isNil) ifFalse: [self halt]. y := self size + super size. + #($a #a ''a'' "a" 1 1.0 nil true false), { #[65]. thisContext. nil. true. false } + do: [ :each | | class | + class := each class. - #($a #a ''a'' "a" 1 1.0) - do: [ :each | Transcript + show: (class name); - show: (each class name); show: '' '']. ^ x < y'!

6 7

Review Request: robust-forceChangesToDisk.1.cs
by christoph.thiede＠student.hpi.uni-potsdam.de 01 Apr '22

01 Apr '22

Please review. :-) Best, Christoph =============== Summary =============== Change Set: robust-forceChangesToDisk Date: 25 March 2022 Author: Christoph Thiede Increases the robustness of Smalltalk forceChangesToDisk. When this method is interrupted, make sure to maintain the invariant that the source file is always opened and set to the right position. In the course of this, also makes StandardFileStream>>#open:forWrite: more robust. Adds a smoke/regression test. For context: Interrupting Smalltalk forceChangesToDisk is not a fictional scenario. In combination with a slow file system access, I could reproduce this many times when running StringTest>>#testPercentEncodingJa with a too small timeout. =============== Diff =============== SmalltalkImage>>forceChangesToDisk {sources, changes log} · ct 3/25/2022 14:17 (changed) forceChangesToDisk "Ensure that the changes file has been fully written to disk by closing and re-opening it. This makes the system more robust in the face of a power failure or hard-reboot." | changesFile | changesFile := SourceFiles at: 2. (changesFile isKindOf: FileStream) ifTrue: [ changesFile flush. - SecurityManager default hasFileAccess ifTrue:[ - changesFile close. - changesFile open: changesFile name forWrite: true]. - changesFile setToEnd. - ]. + SecurityManager default hasFileAccess + ifTrue: [ + [changesFile close. + changesFile open: changesFile name forWrite: true. + changesFile setToEnd] + ifCurtailed: [ + changesFile closed ifFalse: [changesFile close]. + changesFile open: changesFile name forWrite: true. + changesFile setToEnd]] + ifFalse: [changesFile setToEnd]]. SmalltalkImageTest>>testForceChangesToDiskRobustness {tests} · ct 3/25/2022 14:23 + testForceChangesToDiskRobustness + <timeout: 11 "seconds"> + <fatal "regression test! Unless this bug is fixed, this may damage your image."> + + 50 timesRepeat: + [[[Smalltalk forceChangesToDisk] repeat] valueWithin: 0.1 seconds onTimeout: []]. + + self shouldnt: [Smalltalk logChange: ('Test from {1}' format: {self})] raise: Error. StandardFileStream>>open:forWrite: {open/close} · ct 3/25/2022 14:42 (changed) open: fileName forWrite: writeMode "Open the file with the given name. If writeMode is true, allow writing, otherwise open the file in read-only mode." "Changed to do a GC and retry before failing ar 3/21/98 17:25" - | f | + | f newFileID | f := fileName asVmPathName. - - fileID := StandardFileStream retryWithGC:[self primOpen: f writable: writeMode] - until:[:id| id notNil] - forFileNamed: fileName. + + fileID := nil. + fileID := [StandardFileStream + retryWithGC: + [newFileID := nil. + newFileID := self primOpen: f writable: writeMode] + until: [:id | id notNil] + forFileNamed: fileName] + ifCurtailed: + [newFileID ifNotNil: [self primClose: newFileID]]. fileID ifNil: [^ nil]. "allows sender to detect failure" name := fileName. self register. rwmode := writeMode. buffer1 := String new: 1. - self enableReadBuffering - + self enableReadBuffering. ["robust-forceChangesToDisk.1.cs"] --- Sent from Squeak Inbox Talk ["robust-forceChangesToDisk.1.cs"]

2 2

The Trunk: Tests-ul.480.mcz
by commits＠source.squeak.org 31 Mar '22

31 Mar '22

Levente Uzonyi uploaded a new version of Tests to project The Trunk: http://source.squeak.org/trunk/Tests-ul.480.mcz ==================== Summary ==================== Name: Tests-ul.480 Author: ul Time: 31 March 2022, 5:10:21.743078 pm UUID: 18dce5e3-6390-4fc5-a1a3-f7419181d048 Ancestors: Tests-mt.479 - updated DecompilerTests >> #decompilerFailures to match the actual methods =============== Diff against Tests-mt.479 =============== Item was changed: ----- Method: DecompilerTests>>decompilerFailures (in category 'utilities') ----- decompilerFailures "Here is the list of failures: either a syntax error, a hard error or some failure to decompile correctly. Collected initially via DecompilerTestFailuresCollector new computeFailures. But can be maintained manually." "class name, selector, error class name or nil" ^#( #(BrowserCommentTextMorph showPane SyntaxErrorNotification) - #(CodeHolder getSelectorAndSendQuery:to:with: SyntaxErrorNotification) #(DecompilerTests testDecompileUnreachableParameter Error) #(MVCToolBuilder setLayout:in: SyntaxErrorNotification) "same-name block-local temps in optimized blocks" #(PNGReadWriter copyPixelsGray: SyntaxErrorNotification) #(SHMCClassDefinition withAllSuperclassesDo: SyntaxErrorNotification) "same-name block-local temps in optimized blocks" #(DoItFirst parse: SyntaxErrorNotification) "same-name block-local temps in optimized blocks" + #(TheWorldMainDockingBar listMethodChanges:andClassChanges:on: SyntaxErrorNotification) "same-name block-local temps in optimized blocks" + #(TTFontReader readCharacterMappingTable SyntaxErrorNotification) "same-name block-local temps in optimized blocks" - #(TheWorldMainDockingBar listChangesOn: SyntaxErrorNotification) "same-name block-local temps in optimized blocks" )!

1 0

The Trunk: System-ul.1332.mcz
by commits＠source.squeak.org 31 Mar '22

31 Mar '22

Levente Uzonyi uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-ul.1332.mcz ==================== Summary ==================== Name: System-ul.1332 Author: ul Time: 31 March 2022, 5:09:06.559954 pm UUID: 681b55d7-1b75-4a3e-b571-f29ceaccaad2 Ancestors: System-mt.1331 - use Symbol class >> #lookup: instead of #hasInterned:ifTrue: =============== Diff against System-mt.1331 =============== Item was changed: ----- Method: DiskProxy>>comeFullyUpOnReload: (in category 'i/o') ----- comeFullyUpOnReload: smartRefStream "Internalize myself into a fully alive object after raw loading from a DataStream. (See my class comment.) DataStream will substitute the object from this eval for the DiskProxy." | globalObj symbol pr nn arrayIndex env | symbol := globalObjectName. "See if class is mapped to another name" (smartRefStream respondsTo: #renamed) ifTrue: [| maybeReadDataFromContext maybeReadArrayContext | "Ugh; so ugly and brittle. If there were pragmas in the relevant methods we could search, etc. eem 7/3/2017 15:54" maybeReadArrayContext := thisContext sender sender sender sender. maybeReadDataFromContext := maybeReadArrayContext sender sender sender sender. "If in outPointers in an ImageSegment, remember original class name. See mapClass:installIn:. Would be lost otherwise." "Anyone know where mapClass:installIn: is/was? eem 7/3/2017 15:55" (maybeReadDataFromContext method selector == #readDataFrom:size: and: [maybeReadDataFromContext receiver class == NativeImageSegment and: [maybeReadArrayContext method == (DataStream compiledMethodAt: #readArray)]]) ifTrue: [arrayIndex := maybeReadArrayContext tempAt: 4. "index var in readArray. Later safer to find i on stack of context." smartRefStream renamedConv at: arrayIndex put: symbol]. "save original name" symbol := smartRefStream renamed at: symbol ifAbsent: [symbol]]. "map" env := Environment current. globalObj := env valueOf: symbol ifAbsent: [ preSelector == nil & (constructorSelector = #yourself) ifTrue: [ Transcript cr; show: symbol, ' is undeclared.'. env undeclare: symbol. ^ nil]. ^ self error: 'Global "', symbol, '" not found']. ((symbol == #World) and: [Smalltalk isMorphic not]) ifTrue: [ self inform: 'These objects will work better if opened in a Morphic World. Dismiss and reopen all menus.']. preSelector ifNotNil: [ + (Symbol lookup: preSelector) ifNotNil: [:selector | - Symbol hasInterned: preSelector ifTrue: [:selector | [globalObj := globalObj perform: selector] on: Error do: [:ex | ex messageText = 'key not found' ifTrue: [^ nil]. ^ ex signal]] ]. symbol == #Project ifTrue: [ (constructorSelector = #fromUrl:) ifTrue: [ nn := (constructorArgs first findTokens: '/') last. nn := (nn findTokens: '.|') first. pr := Project named: nn. ^ pr ifNil: [self] ifNotNil: [pr]]. pr := globalObj perform: constructorSelector withArguments: constructorArgs. ^ pr ifNil: [self] ifNotNil: [pr]]. "keep the Proxy if Project does not exist" constructorSelector ifNil: [^ globalObj]. + (Symbol lookup: constructorSelector) ifNotNil: [:selector | - Symbol hasInterned: constructorSelector ifTrue: [:selector | [^ globalObj perform: selector withArguments: constructorArgs] on: Error do: [:ex | ex messageText = 'key not found' ifTrue: [^ nil]. ^ ex signal] ]. "args not checked against Renamed" ^ nil "was not in proper form"! Item was changed: ----- Method: ImageSegment>>comeFullyUpOnReload: (in category 'fileIn') ----- comeFullyUpOnReload: smartRefStream "fix up the objects in the segment that changed size. An object in the segment is the wrong size for the modern version of the class. Construct a fake class that is the old size. Replace the modern class with the old one in outPointers. Load the segment. Traverse the instances, making new instances by copying fields, and running conversion messages. Keep the new instances. Bulk forward become the old to the new. Let go of the fake objects and classes. After the install (below), arrayOfRoots is filled in. Globalize new classes. Caller may want to do some special install on certain objects in arrayOfRoots. May want to write the segment out to disk in its new form." | mapFakeClassesToReal receiverClasses existing forgetDoItsClass endianness | forgetDoItsClass := Set new. RecentlyRenamedClasses := nil. "in case old data hanging around" mapFakeClassesToReal := smartRefStream reshapedClassesIn: outPointers. "Dictionary of just the ones that change shape. Substitute them in outPointers." self fixCapitalizationOfSymbols. endianness := self endianness. segment := self loadSegmentFrom: segment outPointers: outPointers. arrayOfRoots := segment first. mapFakeClassesToReal isEmpty ifFalse: [ self reshapeClasses: mapFakeClassesToReal refStream: smartRefStream ]. "When a Project is stored, arrayOfRoots has all objects in the project, except those in outPointers" arrayOfRoots do: [:importedObject | ((importedObject isMemberOf: WideString) or: [importedObject isMemberOf: WideSymbol]) ifTrue: [ importedObject mutateJISX0208StringToUnicode. importedObject class = WideSymbol ifTrue: [ "self halt." + (Symbol lookup: importedObject) ifNotNil: [:multiSymbol | - Symbol hasInterned: importedObject asString ifTrue: [:multiSymbol | multiSymbol == importedObject ifFalse: [ importedObject becomeForward: multiSymbol. ]. ]. ]. ]. (importedObject isMemberOf: TTCFontSet) ifTrue: [ existing := TTCFontSet familyName: importedObject familyName pointSize: importedObject pointSize. "supplies default" existing == importedObject ifFalse: [importedObject becomeForward: existing]. ]. ]. receiverClasses := self restoreEndianness: endianness ~~ Smalltalk endianness. "rehash sets" smartRefStream checkFatalReshape: receiverClasses. "Classes in this segment." arrayOfRoots do: [:importedObject | importedObject class class == Metaclass ifTrue: [forgetDoItsClass add: importedObject. self declare: importedObject]]. "Let all extensions work with the current arrayOfRoots." self processRoots. mapFakeClassesToReal isEmpty ifFalse: [ mapFakeClassesToReal keysAndValuesDo: [:aFake :aReal | aFake removeFromSystemUnlogged. aFake becomeForward: aReal]. SystemOrganization removeEmptyCategories]. forgetDoItsClass do: [:c | self forgetDoItsInClass: c]. "^ self" ! Item was changed: ----- Method: SmartRefStream>>mapClass: (in category 'read write') ----- mapClass: incoming "See if the old class named nm exists. If so, return it. If not, map it to a new class, and save the mapping in renamed. " <hasLiteralTest: #isConversionSelector:> "To find this method as sender of all conversion methods" | cls oldVer sel nm | self flag: #bobconv. nm := renamed at: incoming ifAbsent: [incoming]. "allow pre-mapping around collisions" (nm endsWith: ' class') ifFalse: [cls := Smalltalk at: nm ifAbsent: [nil]. cls ifNotNil: [^ cls]] "Known class. It will know how to translate the instance." ifTrue: [cls := Smalltalk at: nm substrings first asSymbol ifAbsent: [nil]. cls ifNotNil: [^ cls class]]. "Known class. It will know how to translate the instance." oldVer := self versionSymbol: (structures at: nm). sel := nm asString. sel at: 1 put: (sel at: 1) asLowercase. sel := sel, oldVer. "i.e. #rectangleoc4" + (Symbol lookup: sel) ifNotNil: [:symb | - Symbol hasInterned: sel ifTrue: [:symb | (self class canUnderstand: sel asSymbol) ifTrue: [ reshaped ifNil: [reshaped := Dictionary new]. cls := self perform: sel asSymbol]]. "This class will take responsibility" cls ifNil: [cls := self writeClassRenameMethod: sel was: nm fromInstVars: (structures at: nm). cls isString ifTrue: [cls := nil]]. cls ifNotNil: [renamed at: nm put: cls name]. ^ cls ! Item was changed: ----- Method: SystemDictionary>>hasClassNamed: (in category 'classes and traits') ----- hasClassNamed: aString "Answer whether there is a class of the given name, but don't intern aString if it's not alrady interned. 4/29/96 sw" + ^(Symbol lookup: aString) + ifNil: [ false ] + ifNotNil: [ :aSymbol | (self at: aSymbol ifAbsent: [nil]) isKindOf: Class ]! - Symbol hasInterned: aString ifTrue: - [:aSymbol | ^ (self at: aSymbol ifAbsent: [nil]) isKindOf: Class]. - ^ false!

1 0

The Trunk: ST80-ul.282.mcz
by commits＠source.squeak.org 31 Mar '22

31 Mar '22

Levente Uzonyi uploaded a new version of ST80 to project The Trunk: http://source.squeak.org/trunk/ST80-ul.282.mcz ==================== Summary ==================== Name: ST80-ul.282 Author: ul Time: 31 March 2022, 5:07:26.869823 pm UUID: 43f230dd-7d32-473c-8271-c8b724e16044 Ancestors: ST80-mt.281 - use Symbol class >> #lookup: instead of #hasInterned:ifTrue: =============== Diff against ST80-mt.281 =============== Item was changed: ----- Method: ParagraphEditor>>explain (in category 'menu messages') ----- explain "Try to shed some light on what kind of entity the current selection is. The selection must be a single token or construct. Insert the answer after the selection. Send private messages whose names begin with 'explain' that return a string if they recognize the selection, else nil." Cursor execute showWhile: + [ | string delimitors reply numbers tiVars selectors sorry cgVars | - [ | symbol string delimitors reply numbers tiVars selectors sorry cgVars | sorry := '"Sorry, I can''t explain that. Please select a single token, construct, or special character.'. sorry := sorry , (view canDiscardEdits ifFalse: [' Also, please cancel or accept."'] ifTrue: ['"']). (string := self selection asString) isEmpty ifTrue: [reply := ''] ifFalse: [string := self explainScan: string. "Remove space, tab, cr" "Temps and Instance vars need only test strings that are all letters" (string detect: [:char | (char isLetter or: [char isDigit]) not] ifNone: []) ifNil: [tiVars := self explainTemp: string. tiVars == nil ifTrue: [tiVars := self explainInst: string]]. (tiVars == nil and: [model respondsTo: #explainSpecial:]) ifTrue: [tiVars := model explainSpecial: string]. tiVars == nil ifTrue: [tiVars := ''] ifFalse: [tiVars := tiVars , '\' withCRs]. "Context, Class, Pool, and Global vars, and Selectors need only test symbols" + (Symbol lookup: string) + ifNotNil: [ :symbol | + cgVars := self explainCtxt: symbol. - (Symbol hasInterned: string ifTrue: [:s | symbol := s]) - ifTrue: [cgVars := self explainCtxt: symbol. cgVars == nil ifTrue: [cgVars := self explainClass: symbol. cgVars == nil ifTrue: [cgVars := self explainGlobal: symbol]]. "See if it is a Selector (sent here or not)" selectors := self explainMySel: symbol. selectors == nil ifTrue: [selectors := self explainPartSel: string. selectors == nil ifTrue: [ selectors := self explainAnySel: symbol]]] + ifNil: [selectors := self explainPartSel: string]. - ifFalse: [selectors := self explainPartSel: string]. cgVars == nil ifTrue: [cgVars := ''] ifFalse: [cgVars := cgVars , '\' withCRs]. selectors == nil ifTrue: [selectors := ''] ifFalse: [selectors := selectors , '\' withCRs]. string size = 1 ifTrue: ["single special characters" delimitors := self explainChar: string] ifFalse: ["matched delimitors" delimitors := self explainDelimitor: string]. numbers := self explainNumber: string. numbers == nil ifTrue: [numbers := '']. delimitors == nil ifTrue: [delimitors := '']. reply := tiVars , cgVars , selectors , delimitors , numbers]. reply size = 0 ifTrue: [reply := sorry]. self afterSelectionInsertAndSelect: reply]!

1 0

The Trunk: Morphic-ul.1956.mcz
by commits＠source.squeak.org 31 Mar '22

31 Mar '22

Levente Uzonyi uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-ul.1956.mcz ==================== Summary ==================== Name: Morphic-ul.1956 Author: ul Time: 31 March 2022, 5:06:23.743688 pm UUID: f3e1fb7d-6d9f-41a8-b27e-7ac48a323b48 Ancestors: Morphic-mt.1955 - use Symbol class >> #lookup: instead of #hasInterned:ifTrue: =============== Diff against Morphic-mt.1955 =============== Item was changed: ----- Method: StandardScriptingSystem>>formAtKey: (in category 'form dictionary') ----- formAtKey: aString "Answer the form saved under the given key" + ^(Symbol lookup: aString) + ifNotNil: [ :aKey | FormDictionary at: aKey ifAbsent: [ FormDictionary at: #Cat ] ] + ifNil: [ FormDictionary at: #Cat ]! - Symbol hasInterned: aString ifTrue: - [:aKey | ^ FormDictionary at: aKey ifAbsent: [FormDictionary at: #Cat]]. - ^ FormDictionary at: #Cat! Item was changed: ----- Method: TextEditor>>explain (in category 'menu messages') ----- explain "Try to shed some light on what kind of entity the current selection is. The selection must be a single token or construct. Insert the answer after the selection. Send private messages whose names begin with 'explain' that return a string if they recognize the selection, else nil." Cursor execute showWhile: + [ | string numbers delimitors cgVars reply selectors tiVars sorry | - [ | string numbers delimitors cgVars reply selectors tiVars symbol sorry | sorry := '"Sorry, I can''t explain that. Please select a single token, construct, or special character.'. sorry := sorry , (morph canDiscardEdits ifFalse: [' Also, please cancel or accept."'] ifTrue: ['"']). (string := self selection asString) isEmpty ifTrue: [reply := ''] ifFalse: [string := self explainScan: string. "Remove space, tab, cr" "Temps and Instance vars need only test strings that are all letters" (string allSatisfy: [:char | char isLetter or: [char isDigit]]) ifTrue: [tiVars := self explainTemp: string. tiVars == nil ifTrue: [tiVars := self explainInst: string]]. (tiVars == nil and: [model respondsTo: #explainSpecial:]) ifTrue: [tiVars := model explainSpecial: string]. tiVars == nil ifTrue: [tiVars := ''] ifFalse: [tiVars := tiVars , '\' withCRs]. "Context, Class, Pool, and Global vars, and Selectors need only test symbols" + (Symbol lookup: string) + ifNotNil: [ :symbol | + cgVars := self explainCtxt: symbol. - (Symbol hasInterned: string ifTrue: [:s | symbol := s]) - ifTrue: [cgVars := self explainCtxt: symbol. cgVars == nil ifTrue: [cgVars := self explainClass: symbol. cgVars == nil ifTrue: [cgVars := self explainGlobal: symbol]]. "See if it is a Selector (sent here or not)" selectors := self explainMySel: symbol. selectors == nil ifTrue: [selectors := self explainPartSel: string. selectors == nil ifTrue: [ selectors := self explainAnySel: symbol]]] + ifNil: [selectors := self explainPartSel: string]. - ifFalse: [selectors := self explainPartSel: string]. cgVars == nil ifTrue: [cgVars := ''] ifFalse: [cgVars := cgVars , '\' withCRs]. selectors == nil ifTrue: [selectors := ''] ifFalse: [selectors := selectors , '\' withCRs]. string size = 1 ifTrue: ["single special characters" delimitors := self explainChar: string] ifFalse: ["matched delimitors" delimitors := self explainDelimitor: string]. numbers := self explainNumber: string. numbers == nil ifTrue: [numbers := '']. delimitors == nil ifTrue: [delimitors := '']. reply := tiVars , cgVars , selectors , delimitors , numbers]. reply size = 0 ifTrue: [reply := sorry]. self afterSelectionInsertAndSelect: reply]!

1 0

The Trunk: EToys-ul.470.mcz
by commits＠source.squeak.org 31 Mar '22

31 Mar '22

Levente Uzonyi uploaded a new version of EToys to project The Trunk: http://source.squeak.org/trunk/EToys-ul.470.mcz ==================== Summary ==================== Name: EToys-ul.470 Author: ul Time: 31 March 2022, 5:02:53.124672 pm UUID: d3d57031-36b6-418b-8621-6e5802429be6 Ancestors: EToys-ct.469 - use Symbol class >> #lookup: instead of #hasInterned:ifTrue: - use #includesSubstring: instead of the deprecated #includesSubString: =============== Diff against EToys-ct.469 =============== Item was changed: ----- Method: Player>>changeScript:toStatus: (in category 'scripts-standard') ----- changeScript: scriptName toStatus: statusSymbol "Change the script of the given name to have the given status, and get all relevant script-status controls updated" scriptName ifNil: [^ self]. + (Symbol lookup: scriptName) ifNotNil: - Symbol hasInterned: scriptName ifTrue: [:sym | self instantiatedUserScriptsDo: [:aScriptInstantiation | aScriptInstantiation selector == sym ifTrue: [aScriptInstantiation status: statusSymbol. aScriptInstantiation updateAllStatusMorphs]]]! Item was changed: ----- Method: Player>>doScript: (in category 'scripts-standard') ----- doScript: scriptNameString "On the next tick of the clock, run the given script once" + (Symbol lookup: scriptNameString) ifNotNil: - Symbol hasInterned: scriptNameString ifTrue: [:sym | (self class includesSelector: sym) ifTrue: [costume addAlarm: #triggerScript: with: sym after: 1]]! Item was changed: ----- Method: Player>>existingScriptInstantiationForSelector: (in category 'customevents-scripts-kernel') ----- existingScriptInstantiationForSelector: scriptName "Answer the existing script instantiation for the given selector, or nil if none" scriptName ifNil: [^ nil]. + ^(Symbol lookup: scriptName) ifNotNil: [ :sym | + self costume actorStateOrNil ifNotNil: [ :actorState | + actorState instantiatedUserScriptsDictionary at: sym ifAbsent: [nil]]]! - Symbol hasInterned: scriptName - ifTrue: [ :sym | - self costume actorStateOrNil ifNotNil: [ :actorState | - ^actorState instantiatedUserScriptsDictionary at: sym ifAbsent: [nil]]]. - ^ nil! Item was changed: ----- Method: Player>>performScriptIfCan: (in category 'scripts-standard') ----- performScriptIfCan: scriptNameString "If I understand the given script name, perform it now" + + (Symbol lookup: scriptNameString) + ifNotNil: [:sym | (self class includesSelector: sym) - ^Symbol - hasInterned: scriptNameString - ifTrue: [:sym | (self class includesSelector: sym) ifTrue: [self triggerScript: sym]]! Item was changed: ----- Method: Player>>tellAllSiblings: (in category 'scripts-standard') ----- tellAllSiblings: aMessageSelector "Send the given message selector to all my sibling instances, but not to myself" + (Symbol lookup: aMessageSelector) + ifNotNil: [ :sel | + self belongsToUniClass + ifTrue: [self class allSubInstancesDo: + [:anInstance | + anInstance isInTrash ifFalse: [ + anInstance ~~ self ifTrue: [ anInstance triggerScript: sel ]]]] + ifFalse: [(sel ~~ #emptyScript) ifTrue: + [ScriptingSystem reportToUser: ('Cannot "tell " ' translated, aMessageSelector, ' to ' translated, self externalName) ]]]! - Symbol hasInterned: aMessageSelector - ifTrue: [ :sel | - self belongsToUniClass - ifTrue: [self class allSubInstancesDo: - [:anInstance | - anInstance isInTrash ifFalse: [ - anInstance ~~ self ifTrue: [ anInstance triggerScript: sel ]]]] - ifFalse: [(sel ~~ #emptyScript) ifTrue: - [ScriptingSystem reportToUser: ('Cannot "tell " ' translated, aMessageSelector, ' to ' translated, self externalName) ]]]! Item was changed: ----- Method: Player>>tellSelfAndAllSiblings: (in category 'scripts-standard') ----- tellSelfAndAllSiblings: aMessageSelector "Send the given message selector to all my sibling instances, including myself" + (Symbol lookup: aMessageSelector) ifNotNil: [ :selectorSymbol | + self belongsToUniClass + ifTrue: [self class allSubInstancesDo: + [:anInstance | + anInstance isInTrash ifFalse: [ + (anInstance respondsTo: selectorSymbol) ifTrue: + [anInstance triggerScript: selectorSymbol ]]]] + ifFalse: [(selectorSymbol ~~ #emptyScript) ifTrue: - Symbol hasInterned: aMessageSelector - ifTrue: [ :sel | - self belongsToUniClass - ifTrue: [self class allSubInstancesDo: - [:anInstance | - anInstance isInTrash ifFalse: [ - (anInstance respondsTo: sel) ifTrue: - [anInstance triggerScript: sel ]]]] - ifFalse: [(sel ~~ #emptyScript) ifTrue: [ScriptingSystem reportToUser: ('Cannot "tell " ' translated, aMessageSelector, ' to ' translated, self externalName) ]]]! Item was changed: ----- Method: SoundLibraryTool>>listing (in category 'initialization') ----- listing | list newList format soundData selectorList formatList | list := SampledSound soundLibrary keys sort. selectorList := OrderedCollection new. formatList := OrderedCollection new. list do: [:each | soundData := (SampledSound soundLibrary at: each) second. soundData isNumber ifTrue: [format := 'uncompressed'] + ifFalse: [(soundData includesSubstring: 'Vorbis') - ifFalse: [(soundData includesSubString: 'Vorbis') ifTrue: [format := 'Vorbis'] + ifFalse: [(soundData includesSubstring: 'Speex') - ifFalse: [(soundData includesSubString: 'Speex') ifTrue: [format := 'Speex'] ifFalse: [(soundData includesSubstring: 'GSM') ifTrue: [format := 'GSM']]]]. selectorList add: each. formatList add: format]. newList := OrderedCollection new. newList add: selectorList asArray. showCompression ifTrue:[newList add: formatList asArray] ifFalse:[newList add: (Array new: (formatList size) withAll:' ')]. ^newList!

1 0

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

Jump to page: