Squeak-dev July 2023

squeak-dev@lists.squeakfoundation.org

21 participants
78 discussions

The Inbox: Tools-ct.1032.mcz
by commits＠source.squeak.org 15 Aug '23

15 Aug '23

A new version of Tools was added to project The Inbox: http://source.squeak.org/inbox/Tools-ct.1032.mcz ==================== Summary ==================== Name: Tools-ct.1032 Author: ct Time: 10 March 2021, 6:51:33.356304 pm UUID: 897e4ea2-3740-6a45-a054-d7da65105568 Ancestors: Tools-mt.1030 In the Message Names tool, show definition, comment, and hierarchy for class hits. In particular helpful to find out efficiently whether a selector belongs to a binding or to an actual class. =============== Diff against Tools-mt.1030 =============== Item was changed: ----- Method: MessageNames>>computeMessageList (in category 'search') ----- computeMessageList + | selector | + selectorListIndex = 0 ifTrue: [^ #()]. + + selector := selectorList at: selectorListIndex. + ^ (selector first isUppercase ifTrue: [Smalltalk classNamed: selector]) + ifNotNil: [:class | + class := Smalltalk classNamed: selector. + #(Definition Comment Hierarchy) collect: [:sel | + MethodReference class: class selector: sel] ] + ifNil: [self systemNavigation allImplementorsOf: selector]! - ^ selectorListIndex = 0 - ifTrue: [#()] - ifFalse: [self systemNavigation - allImplementorsOf: (selectorList at: selectorListIndex)]! Item was changed: ----- Method: MessageNames>>selectedMessageName (in category 'message list') ----- selectedMessageName selectorList basicSize = 0 ifTrue: [^ nil]. "Deals with selectorList nil or empty" + ^super selectedMessageName ifNil: [ + "only message name selected" + selectorList at: (selectorListIndex max: 1) ifAbsent: [nil] "If no selection we can still find a selector"]! - ^selectorList at: (selectorListIndex max: 1) ifAbsent: [nil] "If no selection we can still find a selector"! Item was changed: ----- Method: MessageSet>>aboutToStyle: (in category 'code pane') ----- + aboutToStyle: aStyler + "This is a notification that aStyler is about to re-style its text. + Set the classOrMetaClass in aStyler, so that identifiers will be resolved correctly. - aboutToStyle: aPluggableShoutMorphOrView - "This is a notification that aPluggableShoutMorphOrView is about to re-style its text. - Set the classOrMetaClass in aPluggableShoutMorphOrView, so that identifiers - will be resolved correctly. Answer true to allow styling to proceed, or false to veto the styling" | selectedMessageName showingMethod | self showingSource ifFalse: [^false]. selectedMessageName := self selectedMessageName. showingMethod := (#(Comment Definition Hierarchy) includes: selectedMessageName) not. + aStyler parseAMethod: showingMethod. "Hack!! setting classOrMetaClass: to nil allows doit or class definition colouring." + aStyler classOrMetaClass: (showingMethod ifTrue: [self selectedClassOrMetaClass]). - aPluggableShoutMorphOrView classOrMetaClass: (showingMethod ifTrue: [self selectedClassOrMetaClass]). ^(#(Comment Hierarchy) includes: selectedMessageName) not! Item was changed: ----- Method: MessageSet>>selectedMessage (in category 'message list') ----- selectedMessage "Answer the source method for the currently selected message." - self setClassAndSelectorIn: [:class :selector | | source | class ifNil: [^ 'Class vanished']. selector first isUppercase ifTrue: [selector == #Comment ifTrue: + ["currentCompiledMethod := class organization commentRemoteStr." - [currentCompiledMethod := class organization commentRemoteStr. ^ class comment]. selector == #Definition ifTrue: [^ class definition]. selector == #Hierarchy ifTrue: [^ class printHierarchy]]. source := class sourceMethodAt: selector ifAbsent: [currentCompiledMethod := nil. ^ 'Missing']. self showingDecompile ifTrue: [^ self decompiledSourceIntoContents]. currentCompiledMethod := class compiledMethodAt: selector ifAbsent: [nil]. self showingDocumentation ifTrue: [^ self commentContents]. source := self sourceStringPrettifiedAndDiffed. ^ source asText makeSelectorBoldIn: class]!

3 2

Save/load morph to/from file questions
by Jim Rosenberg 13 Aug '23

13 Aug '23

I am author who for many years has been deploying interactive artistic content via Squeak images. I've been relying heavily on the save morph to file / load morph from file process to preserve content and move it from one image to another. I have quite a few classes of my own which are either directly or indirectly subclasses of various morph classes. I have some questions about the save/load morph process. When a morph is loaded from file, this will inevitably involve creating new morphs, which will almost certainly involve methods that could be overridden by a user-created morph subclass. I'm wondering whether the load morph from file process might have "requirements" -- or even just assumptions -- about morph creation that could cause problems during morph loading that are not apparent when a user-subclass morph is created interactively (say by the "new morph" menu). If the answer is yes, are these documented somewhere? For instance: One of the things that has to happen when a morph is loaded from file is that various instance variables have to have their value restored. I might or might not have code in a new or initialize method which gives those variables a value. I guess I've been assuming that the load morph process will "supersede" my morph creation code in giving loaded morph instance variables the right value. Now I'm thinking that assumption may not be valid, and if I have (say) an initialize instance method, that might get executed *after* load morph instance value restoration happens. Comments please? Related question: Is there an intent in the save/load morph to/from file process to preserve submorph order? Or do I have to have my own code in my subclasses to "guarantee" this? (I've been just assuming submorph order will be preserved.) Is there a way my code can "know" whether a morph is being created from the load morph from file process, rather than interactively? -Thanks, Jim

4 8

#withoutDuplicates on Collection?
by christoph.thiede＠student.hpi.uni-potsdam.de 08 Aug '23

08 Aug '23

Hi all, I was just wondering why we only define #withoutDuplicates on SequenceableCollection, since it does not depend on the order of the receiver and could be applied to other types of collections as well. For instance, Set could override it with ^self copy, Bags would be naturally covered as well, etc. What do you think? Best, Christoph --- Sent from Squeak Inbox Talk

9 17

Line wrapping in the help topic window of the HelpBrowser
by Eduardo Ochs 02 Aug '23

02 Aug '23

Hi all, anyone knows how to control - and disable - the line wrapping in the help topic window of the HelpBrowser? I am using a slightly modified version of the HelpBrowser to store my "executable notes" - its code is here: http://anggtwu.net/SQUEAK/Category-Edrx.st http://anggtwu.net/SQUEAK/Category-Edrx.st.html There are five classes, called "EdrxGuideHelp", "HelpBrowserB", "See", "TestCanvas", "TestLayout", and "TestToolBuilder" in "Category-Edrx", and the annoying line wrapping can be seen in the screenshot... Thanks in advance! Eduardo Ochs http://anggtwu.net/eev-squeak.html

3 2

[BUG] TextMorphForEditView wrapFlag
by karl ramberg 02 Aug '23

02 Aug '23

When a you turn preference wrapFlag off in TextMorphForEditViewyou get Assertion failure in Morph>>#doLayoutIn: ... "2.2) Do one additional run on the layout if requested in #layoutInBounds:." (self hasProperty: #doLayoutAgain) ifTrue: [ self removeProperty: #doLayoutAgain. layout flushLayoutCache. layout layout: self in: layoutBounds]. self assert: (self hasProperty: #doLayoutAgain) not]. ... But redoing the layout can add the property #doLayoutAgain. I think this has to be changed to : ... "2.2) Do one additional run on the layout if requested in #layoutInBounds:." (self hasProperty: #doLayoutAgain) ifTrue: [ layout flushLayoutCache. layout layout: self in: layoutBounds. self removeProperty: #doLayoutAgain.]. self assert: [(self hasProperty: #doLayoutAgain) not]]. ... Best, Karl

4 7

The Inbox: HelpSystem-Core-tpr.143.mcz
by commits＠source.squeak.org 31 Jul '23

31 Jul '23

A new version of HelpSystem-Core was added to project The Inbox: http://source.squeak.org/inbox/HelpSystem-Core-tpr.143.mcz ==================== Summary ==================== Name: HelpSystem-Core-tpr.143 Author: tpr Time: 31 July 2023, 1:27:20.173257 pm UUID: 092f5e99-4701-4fce-8526-d09f98bd80de Ancestors: HelpSystem-Core-mt.142, HelpSystem-Core-tpr.142.partial An attempt at bringing ct's HelpBrowser editing improvements up to date so we can incorporate them. This primarily adds the ability to add/remove (sub)topics, which makes editing Help info much simpler, which in turn might encourage people to expend it. =============== Diff against HelpSystem-Core-mt.142 =============== Item was changed: ----- Method: AbstractHelpTopic>>accept:for: (in category 'editing') ----- accept: newContents for: subtopic + "If this topic is editable, this will be the callback to update its contents."! - "If this topic is editable, this will be the callback to update its contents." - ^ false! Item was added: + ----- Method: AbstractHelpTopic>>canAddSubtopic (in category 'testing') ----- + canAddSubtopic + + ^ false! Item was added: + ----- Method: AbstractHelpTopic>>canRemoveSubtopic (in category 'testing') ----- + canRemoveSubtopic + + ^ false! Item was added: + ----- Method: AbstractHelpTopic>>isClassBasedHelpTopic (in category 'testing') ----- + isClassBasedHelpTopic + + ^ false! Item was changed: ----- Method: AbstractHelpTopic>>topicMenu:parentTopic: (in category 'menus') ----- topicMenu: aMenu parentTopic: parentTopic + | editMenu | - (self canBrowseTopicFromParent: parentTopic) - ifTrue: [ - aMenu - add: 'browse (b)' translated - target: self - selector: #browseTopicFromParent: - argumentList: {parentTopic}; - addLine ]. aMenu + add: 'Inspect (i)' translated target: self action: #inspect; + add: 'Explore (I)' translated target: self action: #explore. + (self canBrowseTopicFromParent: parentTopic) ifTrue: + [aMenu + add: 'Browse (b)' translated + target: self + selector: #browseTopicFromParent: + argumentList: {parentTopic} ]. - add: 'inspect (i)' translated target: self action: #inspect; - add: 'explore (I)' translated target: self action: #explore. + editMenu := aMenu class new target: self. + self canAddSubtopic ifTrue: + [editMenu + add: 'Add topic...' translated + target: self + action: #addSubtopic ]. + parentTopic canRemoveSubtopic ifTrue: + [editMenu + add: 'Remove topic (x)' translated + target: parentTopic + selector: #removeSubtopic: + argumentList: {self} ]. + editMenu hasItems ifTrue: + [aMenu + addLine; + addAllFrom: editMenu ]. + ^ aMenu! Item was changed: ----- Method: AbstractHelpTopic>>topicMenuKey:fromParent: (in category 'menus') ----- topicMenuKey: aChar fromParent: parentTopic aChar caseOf: { [$b] -> [(self canBrowseTopicFromParent: parentTopic) ifTrue: [ self browseTopicFromParent: parentTopic ]]. [$i] -> [self inspect]. + [$I] -> [self explore]. + [$x] -> [parentTopic canRemoveSubtopic ifTrue: [ + parentTopic removeSubtopic: self ]] } - [$I] -> [self explore] } otherwise: [^ false]. ^ true! Item was changed: ----- Method: ClassBasedHelpTopic>>accept:for: (in category 'editing') ----- accept: newContents for: subtopic "Supports indirect content storage in classes other than helpClass." | topicClass topicMethodSelector code indirect | + (subtopic respondsTo: #contentsAsIs) ifFalse: + [^ self inform: 'Cannot store into this topic' translated]. - (subtopic respondsTo: #contentsAsIs) - ifFalse: [^ self inform: 'Cannot store into this topic' translated]. (indirect := subtopic contentsAsIs isMessageSend) + ifFalse: + [topicClass := self helpClass. - ifFalse: [ - topicClass := self helpClass. topicMethodSelector := subtopic key asLegalSelector asSymbol] + ifTrue: + [topicClass := subtopic contentsAsIs receiver. - ifTrue: [ - topicClass := subtopic contentsAsIs receiver. topicMethodSelector := subtopic contentsAsIs selector]. (topicClass class includesSelector: topicMethodSelector) ==> [self okToWriteSelector: topicMethodSelector] ifFalse: [^ false]. + code := String streamContents: + [:s| - code := String streamContents:[:s| s nextPutAll: topicMethodSelector. s crtab; nextPutAll: '"This method was automatically generated. Edit it using:"'. s crtab; nextPutAll: '"', self helpClass name,' edit: ', subtopic key storeString,'"'. + indirect + ifTrue: [s crtab; nextPutAll: '^ ('] + ifFalse: + [s crtab; nextPutAll: '<generated>'. + s crtab; nextPutAll: '^(HelpTopic'. + s crtab: 2; nextPutAll: 'title: ', subtopic title storeString. + s crtab: 2; nextPutAll: 'contents: ']. - indirect ifTrue: [s crtab; nextPutAll: '^ ('] ifFalse: [ - s crtab; nextPutAll: '<generated>'. - s crtab; nextPutAll: '^(HelpTopic'. - s crtab: 2; nextPutAll: 'title: ', subtopic title storeString. - s crtab: 2; nextPutAll: 'contents: ']. + s cr; nextPutAll: (String streamContents: + [:c| + c nextChunkPutWithStyle: newContents]) storeString. - s cr; nextPutAll: (String streamContents:[:c| c nextChunkPutWithStyle: newContents]) storeString. s nextPutAll:' readStream nextChunkText)'. + indirect ifFalse: + [subtopic key ifNotNil: + [s crtab: 3; nextPutAll: 'key: ', subtopic key storeString; nextPutAll: ';']. + subtopic shouldStyle ifNotNil: + [s crtab: 3; nextPutAll: 'shouldStyle: ', subtopic shouldStyle storeString; nextPutAll: ';']. + s crtab: 3; nextPutAll: 'yourself']]. - indirect ifFalse: [ - subtopic key ifNotNil: [s crtab: 3; nextPutAll: 'key: ', subtopic key storeString; nextPutAll: ';']. - subtopic shouldStyle ifNotNil: [s crtab: 3; nextPutAll: 'shouldStyle: ', subtopic shouldStyle storeString; nextPutAll: ';']. - s crtab: 3; nextPutAll: 'yourself'] - ]. topicClass class compile: code classified: ((topicClass class organization categoryOfElement: topicMethodSelector) ifNil:['pages']). ^ true! Item was added: + ----- Method: ClassBasedHelpTopic>>addMethodTopic (in category 'editing') ----- + addMethodTopic + + | title key needsToStorePages oldPages topic | + title := UIManager default request: 'Please enter a topic name:' translated. + title isEmptyOrNil ifTrue: [^ nil]. + key := self makeUniqueKeyFrom: (title asIdentifier: false). + needsToStorePages := self needsToStorePages. + needsToStorePages ifTrue: [ + (self okToWriteSelector: #pages) + ifFalse: [^ false]. + oldPages := self helpClass pages]. + topic := HelpTopic named: title. + topic key: key. + self accept: '' for: topic. + needsToStorePages ifTrue: [ + self storePages: (oldPages copyWith: key)]. + self refresh. + ^ self subtopics detect: [:other | other key = key]! Item was added: + ----- Method: ClassBasedHelpTopic>>addSubclassTopic (in category 'editing') ----- + addSubclassTopic + + | className title subclass | + title := UIManager default request: 'Please enter a book name:' translated. + title isEmptyOrNil ifTrue: [^ nil]. + className := UIManager default + request: 'Please enter a class name:' translated + initialAnswer: (title asIdentifier: true). + className isEmptyOrNil ifTrue: [^ nil]. + className := className asSymbol. + Smalltalk at: className ifPresent: + [:class | self inform: 'Class already exists' translated. + ^ nil]. + subclass := self helpClass subclass: className + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: self helpClass category. + subclass theMetaClass compile: + (String streamContents: + [:stream | + stream nextPutAll: #bookName; + crtab; nextPutAll: '<generated>'; + crtab; nextPut: $^; + store: title]) + classified: #accessing. + subclass asHelpTopic storePages: #(). + self refresh. + ^ self subtopics detect: + [:topic | + topic isClassBasedHelpTopic and: [topic helpClass = subclass]]! Item was added: + ----- Method: ClassBasedHelpTopic>>addSubtopic (in category 'editing') ----- + addSubtopic + + | strategy | + strategy := UIManager default + chooseFrom: (#('Add a method' 'Add a subclass') collect: #translated) + values: #(addMethodTopic addSubclassTopic) + title: 'Choose kind of subtopic' translated. + strategy ifNil: [^ self]. + ^ self perform: strategy! Item was added: + ----- Method: ClassBasedHelpTopic>>canAddSubtopic (in category 'testing') ----- + canAddSubtopic + + ^ true! Item was added: + ----- Method: ClassBasedHelpTopic>>canRemoveSubtopic (in category 'testing') ----- + canRemoveSubtopic + + ^ true! Item was added: + ----- Method: ClassBasedHelpTopic>>isClassBasedHelpTopic (in category 'testing') ----- + isClassBasedHelpTopic + + ^ true! Item was added: + ----- Method: ClassBasedHelpTopic>>makeUniqueKeyFrom: (in category 'editing') ----- + makeUniqueKeyFrom: aKey + + | keyIndex newKey | + newKey := aKey. + keyIndex := 0. + [(self subtopics anySatisfy: [:existing | existing key = newKey])] + whileTrue: [newKey := newKey , (keyIndex := keyIndex + 1)]. + ^ newKey asSymbol! Item was added: + ----- Method: ClassBasedHelpTopic>>needsToStorePages (in category 'testing') ----- + needsToStorePages + + | method | + method := self helpClass theMetaClass lookupSelector: #pages. + method ifNil: [^ true]. + ^ (method hasPragma: #pageInvariant) not! Item was added: + ----- Method: ClassBasedHelpTopic>>okToRemoveClass (in category 'editing') ----- + okToRemoveClass + + | message | + message := ( + 'Are you certain that you want to remove\the class {1}\' + , (self helpClass subclasses ifEmpty: [''] ifNotEmpty: ['and all its {2} subclasses\']) + , 'from the system?') + withCRs translated format: {self helpClass. self helpClass subclasses size}. + ^ self confirm: message! Item was added: + ----- Method: ClassBasedHelpTopic>>removeSubtopic: (in category 'editing') ----- + removeSubtopic: aTopic + + | needsToStorePages oldPages | + aTopic isClassBasedHelpTopic ifTrue: + [| result | + result := aTopic removeTopicClass. + result ifTrue: [self refresh]. + ^ result]. + + aTopic key ifNil: + [self inform: 'Could not find topic' translated. + ^ false]. + + (self confirm: ('Are you sure you want to REMOVE the topic "{1}" from "{2}"?' translated format: {aTopic title. self title})) + ifFalse: [^ false]. + + (needsToStorePages := self needsToStorePages) ifTrue: + [(self okToWriteSelector: #pages) + ifFalse: [^ false]. + oldPages := self helpClass pages]. + + (self systemNavigation + confirmAndRemoveSelector: aTopic key + class: self helpClass theMetaClass) + ifFalse: [^ false]. + + needsToStorePages ifTrue: + [self storePages: (oldPages copyWithout: aTopic key)]. + self refresh. + ^ true! Item was added: + ----- Method: ClassBasedHelpTopic>>removeTopicClass (in category 'editing') ----- + removeTopicClass + + self okToRemoveClass ifFalse: [^ false]. + self helpClass removeFromSystem. + ^ true! Item was added: + ----- Method: ClassBasedHelpTopic>>storePages: (in category 'editing') ----- + storePages: keys + + | class | + class := self helpClass theMetaClass. + class + compile: (String streamContents: [:stream | + stream + nextPutAll: 'pages'. + (class includesSelector: #pages) + ifFalse: [ stream + crtab; nextPutAll: '<pageInvariant>'; + crtab; nextPutAll: '^ self class methodsInCategory: #pages' ] + ifTrue: [ stream + crtab; nextPutAll: '<generated>'; + crtab; nextPut: $^; + store: keys ]]) + classified: #accessing.! 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 + reject: [:cls | cls ignore] - select: [:cls | cls ignore not] thenDo: [:cls | pages addIfNotPresent: cls]. + ^ subtopics := pages withIndexCollect: + [:pageSelectorOrClass :pagePriority | - ^ subtopics := pages withIndexCollect: [:pageSelectorOrClass :pagePriority | pageSelectorOrClass isBehavior ifFalse: [(self helpClass perform: pageSelectorOrClass) priority: pagePriority - 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]]! Item was changed: ----- Method: CustomHelp class>>edit: (in category 'editing') ----- edit: aSelector + (HelpBrowser openOn: self asHelpTopic) model showTopicNamed: aSelector! - (HelpBrowser openOn: self asHelpTopic) model showTopicNamed: aSelector.. - ! Item was changed: ----- Method: DirectoryBasedHelpTopic>>accept:for: (in category 'editing') ----- accept: newContents for: subtopic FileStream forceNewFileNamed: subtopic fileEntry fullName do: [:strm | strm nextChunkPutWithStyle: newContents]. - ^ true ! Item was changed: ----- Method: FileBasedHelpTopic>>accept:for: (in category 'editing') ----- accept: newContents for: subtopic FileStream forceNewFileNamed: self fileEntry fullName do: [:strm | strm nextChunkPutWithStyle: newContents]. + - ^ true !

2 1

The Trunk: Help-Squeak-Project-ct.98.mcz
by commits＠source.squeak.org 30 Jul '23

30 Jul '23

tim Rowledge uploaded a new version of Help-Squeak-Project to project The Trunk: http://source.squeak.org/trunk/Help-Squeak-Project-ct.98.mcz ==================== Summary ==================== Name: Help-Squeak-Project-ct.98 Author: ct Time: 21 July 2023, 12:23:52.490316 am UUID: fed4b138-10f7-044f-893d-353f4c0f2885 Ancestors: Help-Squeak-Project-tpr.97 Updates entry on the Squeak by Example book. =============== Diff against Help-Squeak-Project-tpr.97 =============== Item was changed: ----- Method: SqueakProjectHelp class>>squeakResourcesOnline (in category 'pages') ----- squeakResourcesOnline "This method was automatically generated. Edit it using:" "SqueakProjectHelp edit: #squeakResourcesOnline" <generated> ^(HelpTopic title: 'Squeak Resources Online' contents: 'Web sites Main site of Squeak https://www.squeak.org Issue Tracker for bug reports and other feedback https://bugs.squeak.org Weekly Squeak https://news.squeak.org Downloads for many versions https://www.squeak.org/downloads Main site of OpenSmalltalk VM https://github.com/OpenSmalltalk/opensmalltalk-vm Mailing lists beginners This is the place to ask even the most basic questions. Don''t be afraid. Just ask. The community will help you get started with Squeak. https://lists.squeakfoundation.org/mailman/listinfo/beginners squeak-dev This is the main Squeak mailing list. Join that list to be part in the community. Subscribe to the mail server or read on a forum. https://lists.squeakfoundation.org/mailman/listinfo/squeak-dev For more information on the community and the contribution process, check out the tutorial Contributing to Squeak in the following pages. vm-beginners This is the entry point for people who want to learn more about how Squeak runs on your operating system. You may ask even basic questions. :-) https://lists.squeakfoundation.org/mailman/listinfo/vm-beginners vm-dev This is the place where discussions about the OpenSmalltalk virtual machine happen. Join that list the be a part of the community. https://lists.squeakfoundation.org/mailman/listinfo/vm-dev Books Squeak By Example + A beginners textbook about Squeak''s environment, language, tools, and the Morphic framework, currently based on Squeak 6.0. Available as a colored paperback at lulu and as a free PDF here. The content is maintained on GitHub. - A beginners textbook, currently based on Squeak 5.3 and so a little out of date in some visual aspects and some details. Still a valuable resource. The content is maintained in GitHub at - https://github.com/hpi-swa-lab/SqueakByExample-english - but a prepared and ready to read pdf version can be found at - https://github.com/hpi-swa-lab/SqueakByExample-english/releases Other books Many books about Squeak and Smalltalk in general have been made available: https://squeak.org/documentation/#books!! + ]style[(11 19 1 23 48 1 23 1 14 23 1 27 1 32 1 29 1 49 1 1 13 1 1 10 135 1 61 1 1 10 1 131 62 92 22 25 1 13 144 64 1 1 6 1 131 58 1 1 5 2 17 1 160 4 19 4 31 6 2 1 11 1 75 39)b,I0i,I0,Rhttps://www.squeak.org;I1,I0i,I0,Rhttps://bugs.squeak.org;I1,I… queak.org/documentation/#books;I1!!' readStream nextChunkText) - ]style[(11 19 1 23 48 1 23 1 14 23 1 27 1 32 1 29 1 49 1 1 13 1 1 10 135 1 61 1 1 10 1 131 62 92 22 25 1 13 144 64 1 1 6 1 131 58 1 1 5 2 17 1 187 54 62 63 1 1 11 1 75 39)b,I0i,I0,Rhttps://www.squeak.org;I1,I0i,I0,Rhttps://bugs.squeak.org;I1,I…!!' readStream nextChunkText) key: #squeakResourcesOnline; shouldStyle: false; yourself!

1 0

The Trunk: Network-tpr.280.mcz
by commits＠source.squeak.org 30 Jul '23

30 Jul '23

tim Rowledge uploaded a new version of Network to project The Trunk: http://source.squeak.org/trunk/Network-tpr.280.mcz ==================== Summary ==================== Name: Network-tpr.280 Author: tpr Time: 5 July 2023, 4:48:48.448418 pm UUID: 2e0c8513-b3db-4325-9490-1dfb12c926ec Ancestors: Network-ct.279 Add commentary to some Socket methods to make it clear that the servers involved need to be running relevant services - and that at least some of them are rarely installed these days. In particular the #ping: method doesn't do what we might expect from the ping cmd. =============== Diff against Network-ct.279 =============== Item was changed: ----- Method: Socket class>>ping: (in category 'utilities') ----- ping: hostName + "kinda-Ping the given host. Useful for checking network connectivity. + The host *must* be running a TCP echo server - note that these days very few actually do so and thus you may need to install one. Fortunately this is usually fairly simple; on a Ubuntu type linux system + sudo apt install ncat + sudo ncat -l 7 --keep-open --exec '/bin/cat' + ... ought to work. Ctrl-c to kill the ersatz echoserver when you are done testing. + The ping command in a terminal uses a completely different protocol involving ICMP sockets and sacrifices to the Moon etc." + - "Ping the given host. Useful for checking network connectivity. The host must be running a TCP echo server." "Socket ping: 'squeak.cs.uiuc.edu'" | tcpPort sock serverAddr startTime echoTime | tcpPort := 7. "7 = echo port, 13 = time port, 19 = character generator port" serverAddr := NetNameResolver addressForName: hostName timeout: 10. serverAddr ifNil: [ ^self inform: 'Could not find an address for ', hostName ]. sock := Socket new. sock connectNonBlockingTo: serverAddr port: tcpPort. [sock waitForConnectionFor: 10] on: ConnectionTimedOut do: [:ex | (self confirm: 'Continue to wait for connection to ', hostName, '?') ifTrue: [ex retry] ifFalse: [ sock destroy. ^ self]]. sock sendData: 'echo!!'. startTime := Time millisecondClockValue. [sock waitForDataFor: 15] on: ConnectionTimedOut do: [:ex | (self confirm: 'Packet sent but no echo yet; keep waiting?') ifTrue: [ex retry]]. echoTime := Time millisecondClockValue - startTime. sock destroy. self inform: hostName, ' responded in ', echoTime printString, ' milliseconds'. ! Item was changed: ----- Method: Socket class>>pingPorts:on:timeOutSecs: (in category 'utilities') ----- pingPorts: portList on: hostName timeOutSecs: timeOutSecs + "Attempt to connect to each of the given sockets on the given host. Wait at most timeOutSecs for the connections to be established. Answer an array of strings indicating the available ports. + Remember that the host must actually be running the relevant services for this to do anything useful; for example the port 7 echo is usually not installed on most modern unix servers. See also the #ping: method" - "Attempt to connect to each of the given sockets on the given host. Wait at most timeOutSecs for the connections to be established. Answer an array of strings indicating the available ports." "Socket pingPorts: #(7 13 19 21 23 25 80 110 119) on: 'squeak.org' timeOutSecs: 15" | serverAddr sockets startTime timeoutMsecs done result unconnectedCount connectedCount waitingCount | serverAddr := NetNameResolver addressForName: hostName timeout: 10. serverAddr ifNil: [ self inform: 'Could not find an address for ' , hostName. ^ #() ]. sockets := portList collect: [ :portNum | | sock | sock := Socket new. [ sock connectTo: serverAddr port: portNum ] on: ConnectionTimedOut do: [ ]. sock ]. startTime := Time millisecondClockValue. timeoutMsecs := (1000 * timeOutSecs) truncated. done := false. [ done ] whileFalse: [ unconnectedCount := 0. connectedCount := 0. waitingCount := 0. sockets do: [ :s | s isUnconnectedOrInvalid ifTrue: [ unconnectedCount := unconnectedCount + 1 ] ifFalse: [ s isConnected ifTrue: [ connectedCount := connectedCount + 1 ]. s isWaitingForConnection ifTrue: [ waitingCount := waitingCount + 1 ] ] ]. waitingCount = 0 ifTrue: [ done := true ]. connectedCount = sockets size ifTrue: [ done := true ]. (Time millisecondsSince: startTime) >= timeoutMsecs ifTrue: [ done := true ] ]. result := (sockets select: [ :s | s isConnected ]) collect: [ :s | self nameForWellKnownTCPPort: s remotePort ]. sockets do: [ :s | s destroy ]. ^ result! Item was changed: ----- Method: Socket class>>pingPortsOn: (in category 'utilities') ----- pingPortsOn: hostName + "Attempt to connect to a set of well-known sockets on the given host, and answer the names of the available ports. + See also the comment for #ping: regarding server services. And also note that this is quite likely to seem like a port scanning attack to the server so be careful that it doesn't bite back" - "Attempt to connect to a set of well-known sockets on the given host, and answer the names of the available ports." "Socket pingPortsOn: 'www.disney.com'" ^ Socket pingPorts: #(7 13 19 21 23 25 80 110 119) on: hostName timeOutSecs: 20 !

1 0

The Trunk: Network-tpr.281.mcz
by commits＠source.squeak.org 30 Jul '23

30 Jul '23

tim Rowledge uploaded a new version of Network to project The Trunk: http://source.squeak.org/trunk/Network-tpr.281.mcz ==================== Summary ==================== Name: Network-tpr.281 Author: tpr Time: 6 July 2023, 4:47:54.419547 pm UUID: 72a96109-ef1b-435a-91ad-20428e13d2d9 Ancestors: Network-tpr.280 Add some more commentary to more Socket examples/tests, plus find ncat simulation commands that can allow testing to suceed. It would be nice if we could get those services runing on squeak.org =============== Diff against Network-ct.279 =============== Item was changed: ----- Method: Socket class>>ping: (in category 'utilities') ----- ping: hostName + "kinda-Ping the given host. Useful for checking network connectivity. + The host *must* be running a TCP echo server - note that these days very few actually do so and thus you may need to install one. Fortunately this is usually fairly simple; on a Ubuntu type linux system + sudo apt install ncat + sudo ncat -l 7 --keep-open --exec '/bin/cat' + ... ought to work. Ctrl-c to kill the ersatz echoserver when you are done testing. + + The ping command in a terminal uses a completely different protocol involving ICMP sockets and sacrifices to the Moon etc." + - "Ping the given host. Useful for checking network connectivity. The host must be running a TCP echo server." "Socket ping: 'squeak.cs.uiuc.edu'" | tcpPort sock serverAddr startTime echoTime | tcpPort := 7. "7 = echo port, 13 = time port, 19 = character generator port" serverAddr := NetNameResolver addressForName: hostName timeout: 10. serverAddr ifNil: [ ^self inform: 'Could not find an address for ', hostName ]. sock := Socket new. sock connectNonBlockingTo: serverAddr port: tcpPort. [sock waitForConnectionFor: 10] on: ConnectionTimedOut do: [:ex | (self confirm: 'Continue to wait for connection to ', hostName, '?') ifTrue: [ex retry] ifFalse: [ sock destroy. ^ self]]. sock sendData: 'echo!!'. startTime := Time millisecondClockValue. [sock waitForDataFor: 15] on: ConnectionTimedOut do: [:ex | (self confirm: 'Packet sent but no echo yet; keep waiting?') ifTrue: [ex retry]]. echoTime := Time millisecondClockValue - startTime. sock destroy. self inform: hostName, ' responded in ', echoTime printString, ' milliseconds'. ! Item was changed: ----- Method: Socket class>>pingPorts:on:timeOutSecs: (in category 'utilities') ----- pingPorts: portList on: hostName timeOutSecs: timeOutSecs + "Attempt to connect to each of the given sockets on the given host. Wait at most timeOutSecs for the connections to be established. Answer an array of strings indicating the available ports. + Remember that the host must actually be running the relevant services for this to do anything useful; for example the port 7 echo is usually not installed on most modern unix servers. See also the #ping: method" - "Attempt to connect to each of the given sockets on the given host. Wait at most timeOutSecs for the connections to be established. Answer an array of strings indicating the available ports." "Socket pingPorts: #(7 13 19 21 23 25 80 110 119) on: 'squeak.org' timeOutSecs: 15" | serverAddr sockets startTime timeoutMsecs done result unconnectedCount connectedCount waitingCount | serverAddr := NetNameResolver addressForName: hostName timeout: 10. serverAddr ifNil: [ self inform: 'Could not find an address for ' , hostName. ^ #() ]. sockets := portList collect: [ :portNum | | sock | sock := Socket new. [ sock connectTo: serverAddr port: portNum ] on: ConnectionTimedOut do: [ ]. sock ]. startTime := Time millisecondClockValue. timeoutMsecs := (1000 * timeOutSecs) truncated. done := false. [ done ] whileFalse: [ unconnectedCount := 0. connectedCount := 0. waitingCount := 0. sockets do: [ :s | s isUnconnectedOrInvalid ifTrue: [ unconnectedCount := unconnectedCount + 1 ] ifFalse: [ s isConnected ifTrue: [ connectedCount := connectedCount + 1 ]. s isWaitingForConnection ifTrue: [ waitingCount := waitingCount + 1 ] ] ]. waitingCount = 0 ifTrue: [ done := true ]. connectedCount = sockets size ifTrue: [ done := true ]. (Time millisecondsSince: startTime) >= timeoutMsecs ifTrue: [ done := true ] ]. result := (sockets select: [ :s | s isConnected ]) collect: [ :s | self nameForWellKnownTCPPort: s remotePort ]. sockets do: [ :s | s destroy ]. ^ result! Item was changed: ----- Method: Socket class>>pingPortsOn: (in category 'utilities') ----- pingPortsOn: hostName + "Attempt to connect to a set of well-known sockets on the given host, and answer the names of the available ports. + See also the comment for #ping: regarding server services. And also note that this is quite likely to seem like a port scanning attack to the server so be careful that it doesn't bite back" - "Attempt to connect to a set of well-known sockets on the given host, and answer the names of the available ports." "Socket pingPortsOn: 'www.disney.com'" ^ Socket pingPorts: #(7 13 19 21 23 25 80 110 119) on: hostName timeOutSecs: 20 ! Item was changed: ----- Method: Socket class>>sendTest (in category 'tests') ----- sendTest "Send data to the 'discard' socket of the given host. + Tests the speed of one-way data transfers across the network to the given host. + The host *must* be running a TCP discard server - note that these days very few actually do so and thus you may need to install one. Fortunately this is usually fairly simple; on a Ubuntu type linux system + sudo apt install ncat + sudo ncat -l --keep-open 9 --recv-only > /dev/null + ... ought to work. Ctrl-c to kill the ersatz server when you are done testing. " - Tests the speed of one-way data transfers across the - network to the given host. Note that most hosts - do not run a discard server." "Socket sendTest" | sock bytesToSend sendBuf bytesSent t serverName serverAddr | Transcript cr; show: 'starting send test'; cr. self initializeNetwork. serverName := UIManager default request: 'What is the destination server?' initialAnswer: 'create.ucsb.edu'. serverAddr := NetNameResolver addressForName: serverName timeout: 10. serverAddr = nil ifTrue: [^self inform: 'Could not find an address for ' , serverName]. sock := self new. Transcript show: '---------- Connecting ----------';cr. sock connectTo: serverAddr port: 9. sock isConnected ifFalse: [ sock destroy. ^self inform: 'could not connect']. Transcript show: 'connection established; sending data'; cr. bytesToSend := 1000000. sendBuf := String new: 64 * 1024 withAll: $x. bytesSent := 0. t := Time millisecondsToRun: [[bytesSent < bytesToSend] whileTrue: [sock sendDone ifTrue: [bytesSent := bytesSent + (sock sendSomeData: sendBuf)]]]. sock waitForSendDoneFor: self standardTimeout. sock destroy. Transcript show: '---------- Connection Closed ----------'; cr; show: 'send test done; time = ' , t printString; cr; show: (bytesToSend asFloat / t printShowingMaxDecimalPlaces: 2), ' * 1000 bytes/sec';cr;endEntry! Item was changed: ----- Method: Socket class>>timeTest (in category 'examples') ----- timeTest + "Attempt to connect to an ntp server running a TCP 'daytime' service. Not all do, but as of 2023 the below nist server does. + The host *must* be running a TCP daytime server - note that these days very few actually do so and thus you may need to install one. Fortunately this is usually fairly simple; on a Ubuntu type linux system + sudo apt install ncat + sudo ncat -l 13 --keep-open --send-only --exec '/bin/date' + ... ought to work. Ctrl-c to kill the ersatz server when you are done testing. " "Socket timeTest" | serverName serverAddr s | Transcript show: 'initializing network ... '. self initializeNetwork. Transcript show: 'ok'; cr. serverName := UIManager default request: 'What is your time server?' + initialAnswer: 'time.nist.gov'. - initialAnswer: 'localhost'. serverName isEmpty ifTrue: [^Transcript show: 'never mind'; cr]. serverAddr := NetNameResolver addressForName: serverName timeout: 10. serverAddr = nil ifTrue: [self error: 'Could not find the address for ' , serverName]. s := self new. Transcript show: '---------- Connecting ----------'; cr. s connectTo: serverAddr port: 13. "13 is the 'daytime' port number" s waitForConnectionUntil: (self deadlineSecs: 1). Transcript show: 'the time server reports: ' , s receiveData. s closeAndDestroy. Transcript show: '---------- Connection Closed ----------'; cr! Item was changed: ----- Method: Socket class>>timeTestUDP (in category 'examples') ----- timeTestUDP + "Attempt to connect to an ntp server running a 'daytime' service via UDP. Not all do, including so far as we can tell, the time,nist.gov server that handles the #timeTest method. + The host *must* be running a UDP daytime server - note that these days very few actually do so and thus you may need to install one. Fortunately this is usually fairly simple; on a Ubuntu type linux system + sudo apt install ncat + sudo ncat -l 13 --keep-open --udp --send-only --exec '/bin/date' + ... ought to work. Ctrl-c to kill the ersatz server when you are done testing. " "Socket timeTestUDP" | serverName serverAddr s | Transcript show: 'initializing network ... '. self initializeNetwork. Transcript show: 'ok'; cr. serverName := UIManager default request: 'What is your time server?' initialAnswer: 'localhost'. serverName isEmpty ifTrue: [^Transcript show: 'never mind'; cr]. serverAddr := NetNameResolver addressForName: serverName timeout: 10. serverAddr = nil ifTrue: [self error: 'Could not find the address for ' , serverName]. s := self newUDP. "a 'random' port number will be allocated by the system" "Send a packet to the daytime port and it will reply with the current date." Transcript show: '---------- Sending datagram from port ' , s port printString , ' ----------'; cr. s sendData: '!!' toHost: serverAddr port: 13. "13 is the daytime service" Transcript show: 'the time server reports: ' , s receiveData. s closeAndDestroy. Transcript show: '---------- Socket closed ----------'; cr!

1 0

The Trunk: KernelTests-pre.445.mcz
by commits＠source.squeak.org 28 Jul '23

28 Jul '23

Patrick Rein uploaded a new version of KernelTests to project The Trunk: http://source.squeak.org/trunk/KernelTests-pre.445.mcz ==================== Summary ==================== Name: KernelTests-pre.445 Author: pre Time: 28 July 2023, 10:18:48.347752 am UUID: 0372ac3c-5ca6-f446-9c1e-710ccc2fdd5b Ancestors: KernelTests-mt.444 Tests for Compiler-pre.493. Also moves tests concerning future sends to a dedicated test case class. =============== Diff against KernelTests-mt.444 =============== Item was added: + Object subclass: #FutureMock + instanceVariableNames: 'methodsCalled' + classVariableNames: '' + poolDictionaries: '' + category: 'KernelTests-Processes'! Item was added: + ----- Method: FutureMock>>futureDo:at:args: (in category 'futures - mocked') ----- + futureDo: aSelector at: deltaMSecs args: args + + self methodsCalled add: #do.! Item was added: + ----- Method: FutureMock>>futureSend:at:args: (in category 'futures - mocked') ----- + futureSend: aSelector at: deltaMSecs args: args + + self methodsCalled add: #send.! Item was added: + ----- Method: FutureMock>>methodSend: (in category 'mock') ----- + methodSend: anObject + + "NOP"! Item was added: + ----- Method: FutureMock>>methodsCalled (in category 'accessing') ----- + methodsCalled + + ^ methodsCalled ifNil: [methodsCalled := Set new]! Item was added: + TestCase subclass: #FutureTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'KernelTests-Processes'! Item was added: + ----- Method: FutureTest>>testFutureAtEndOfBlockYieldsPromise (in category 'tests') ----- + testFutureAtEndOfBlockYieldsPromise + + | result | + result := [(2 future: 100) + 3] value. + self assert: result isPromise.! Item was added: + ----- Method: FutureTest>>testFutureRejectionInvisibleError (in category 'tests') ----- + testFutureRejectionInvisibleError + | p | + p := 1 future / 0. + p whenRejected: []. "Installing a rejection handler is enough to cause the exception to be swallowed." + self assert: (self waitUntil: [p isRejected] orCycleCount: 100). + self assert: p isRejected. + self assert: ZeroDivide equals: p error class.! Item was added: + ----- Method: FutureTest>>testFutureRejectionVisibleError (in category 'tests') ----- + testFutureRejectionVisibleError + | p exceptionSeen | + exceptionSeen := false. + p := 1 future / 0. + [ + self assert: (self waitUntil: [p isRejected] orCycleCount: 100) + ] on: ZeroDivide do: [:ex | exceptionSeen := true ]. + self assert: exceptionSeen. + self assert: p isRejected. + self assert: ZeroDivide equals: p error class.! Item was added: + ----- Method: FutureTest>>testFutureResolution (in category 'tests') ----- + testFutureResolution + | p | + p := 3 future + 4. + self assert: (self waitUntil: [p isResolved] orCycleCount: 100). + self assert: p isResolved. + self assert: 7 equals: p value.! Item was added: + ----- Method: FutureTest>>testFutureStoredInVariableYieldsPromise (in category 'tests') ----- + testFutureStoredInVariableYieldsPromise + + | result | + result := (2 future: 100) + 3. + self assert: result isPromise.! Item was added: + ----- Method: FutureTest>>testFutureWithUnusedReturnValueLeadsToFutureDo (in category 'tests') ----- + testFutureWithUnusedReturnValueLeadsToFutureDo + + | mock | + mock := FutureMock new. + [(mock future: 1) methodSend: 3. 5 negated] value. + self waitUntil: [mock methodsCalled notEmpty] orCycleCount: 50. + self + assert: (mock methodsCalled includes: #do); + deny: (mock methodsCalled includes: #send).! Item was added: + ----- Method: FutureTest>>waitUntil:orCycleCount: (in category 'private') ----- + waitUntil: aBlock orCycleCount: anInteger + "This is a gross hack that depends on running the tests in Morphic. + We simply repeatedly do a cycle of the interaction loop, which happens + to also be the way that the queue of pending futures gets serviced." + | counter | + counter := 0. + [ + aBlock value ifTrue: [^ true]. + Project current world doOneSubCycle. + counter := counter + 1. + counter >= anInteger ifTrue: [^ false]. + ] repeat! Item was removed: - ----- Method: PromiseTest>>testFutureRejectionInvisibleError (in category 'tests - future') ----- - testFutureRejectionInvisibleError - | p | - p := 1 future / 0. - p whenRejected: []. "Installing a rejection handler is enough to cause the exception to be swallowed." - self assert: (self waitUntil: [p isRejected] orCycleCount: 100). - self assert: p isRejected. - self assert: ZeroDivide equals: p error class.! Item was removed: - ----- Method: PromiseTest>>testFutureRejectionVisibleError (in category 'tests - future') ----- - testFutureRejectionVisibleError - | p | - p := 1 future / 0. - [ - self assert: (self waitUntil: [p isRejected] orCycleCount: 100) - ] on: ZeroDivide do: [:ex | "Fall through." ]. - self assert: p isRejected. - self assert: ZeroDivide equals: p error class.! Item was removed: - ----- Method: PromiseTest>>testFutureResolution (in category 'tests - future') ----- - testFutureResolution - | p | - p := 3 future + 4. - self assert: (self waitUntil: [p isResolved] orCycleCount: 100). - self assert: p isResolved. - self assert: 7 equals: p value.! Item was removed: - ----- Method: PromiseTest>>waitUntil:orCycleCount: (in category 'private') ----- - waitUntil: aBlock orCycleCount: anInteger - "This is a gross hack that depends on running the tests in Morphic. - We simply repeatedly do a cycle of the interaction loop, which happens - to also be the way that the queue of pending futures gets serviced." - | counter | - counter := 0. - [ - aBlock value ifTrue: [^ true]. - Project current world doOneSubCycle. - counter := counter + 1. - counter >= anInteger ifTrue: [^ false]. - ] repeat!

1 0