Squeak-dev February 2022

squeak-dev@lists.squeakfoundation.org

30 participants
331 discussions

Monticello Repositories
by Eliot Miranda 07 Jul '22

07 Jul '22

Hi all, I want to add and satisfy two requirements for Monticello repositories. The first is that - there is a page on squeak.org that describes how to set up a Monticello repository and either points to the code necessary to build a Monticello repository image, or points to downloadable Monticello repository image & changes files. There is at least two paragraphs on Monticello in the Welcome workspace/Help tool that cover its general power (distributed VCS that can work fully disconnected) and how easy it is to set up. The second is that repositories and repository inspectors are extended to include the equivalent of a README.md, a top-level readme for the entire repository, in which repository maintainers can give high-level, lay-of-the-land information. The README would appear at the top of the list of packages in a repository inspector. The first requirement is for developers who wish to set up private and/or personal Monticello repositories. This is easy to do, but only if one knows how. Currently that information is missing from squeak.org and the Welcome workspace/Help tool. The second requirement is to make loading code from repositories easier. I just had to ask Levente how to load a full configuration from the Cryptography repository because there is no where in the repository, visible from within the image, specifically visible from a repository inspector, to get this info. Can we make this so? _,,,^..^,,,_ (phone)

2 3

Dead primitive 103 makes scrolling truetype fonts very, very slow. Let's get rid of it
by Tony Garnock-Jones 07 Jul '22

07 Jul '22

Hi all, Commenting out "<primitive 103>" in CharacterScanner>>primScanCharactersFrom:to:in:rightX:stopConditions:kern: immediately and dramatically improves the performance of scrolling anything truetype-font-ish on my very slow arm64 cellphone. It's still not *fast* (why is it re-layouting when I just change the TransformMorph's offset??) but it's faster than it was before, which was "lock up the entire UI for ten seconds while thinking about failing primitive 103"-speed. Interestingly, fast x86_64 machines aren't immune either! Running a tally in the same image on my x86_64 pc with a modern VM, and doing the same scrolly thing, showed primitives to be taking a significant chunk of time. Commenting out "<primitive 103>" there immediately eliminated a lot of wasted CPU usage, though the machine is so fast it's not easy to notice the improvement at squishy meatbody sensory refresh rates. So, should I commit a change that comments out "<primitive 103>" for good? I don't see a downside! Is there one? Cheers, Tony

3 20

The Trunk: Tools-tpr.1008.mcz
by commits＠source.squeak.org 22 Jun '22

22 Jun '22

tim Rowledge uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-tpr.1008.mcz ==================== Summary ==================== Name: Tools-tpr.1008 Author: tpr Time: 25 October 2020, 5:52:09.007789 pm UUID: 2ebe15ce-0c25-4b8d-b993-f1c51203dee5 Ancestors: Tools-tpr.1003, Tools-mt.1007 Rework the window label handing of MessageSet/Trace to be a bit more accurate, and to work within the normal style of labels. Instead of assuming the size of the list passed to the MessageSet/Trace is correct, derive it from the post-processing list. We process the list to remove duplicates, which e.g. the #allUnimplementedCalls method produces. This required adding an instvar to M-Set, removing one from M-Trace, setting the new one properly, dumping some dodgy code that used to half-assedly derive the old one, use the proper #changed: #windowTitle to, y'know, change the title, and some faffing with the messageList. As a result we are better placed to make further improvements if/when we develop a way to correctly hightlight multi-part keywords (or indeed, multiple messages) within a single method, which would greatly improve many browsers. This benefits from being accompanied by the single-method change in the System-tpr.1181 package =============== Diff against Tools-mt.1007 =============== Item was changed: CodeHolder subclass: #MessageSet + instanceVariableNames: 'growable messageList messageListFormatted autoSelectString messageListIndex editSelection windowLabel' - instanceVariableNames: 'growable messageList messageListFormatted autoSelectString messageListIndex editSelection' classVariableNames: 'UseUnifiedMessageLabels' poolDictionaries: '' category: 'Tools-Browser'! !MessageSet commentStamp: '<historical>' prior: 0! I represent a query path of the retrieval result of making a query about methods in the system. The result is a set of methods, denoted by a message selector and the class in which the method was found. As a StringHolder, the string I represent is the source code of the currently selected method. I am typically viewed in a Message Set Browser consisting of a MessageListView and a BrowserCodeView.! Item was changed: ----- Method: MessageSet class>>openMessageList:name:autoSelect: (in category 'instance creation') ----- openMessageList: messageList name: labelString autoSelect: autoSelectString "Open a system view for a MessageSet on messageList. + The labelString is passed to the model to use as a base label, depending on the selection state" - 1/24/96 sw: the there-are-no msg now supplied by my sender" | messageSet | messageSet := self messageList: messageList. + messageSet + autoSelectString: autoSelectString; + setInitialLabel: labelString. + ^ToolBuilder open: messageSet! - messageSet autoSelectString: autoSelectString. - ^ToolBuilder open: messageSet label: labelString! Item was changed: ----- Method: MessageSet>>adjustWindowTitleAfterFiltering (in category 'private') ----- adjustWindowTitleAfterFiltering + "Set the title of the receiver's window, if any, to reflect the just-completed filtering. Avoid re-doing it if fitering is re-done" - "Set the title of the receiver's window, if any, to reflect the just-completed filtering" + (windowLabel endsWith: 'Filtered') + ifFalse: [windowLabel := windowLabel , ' Filtered'. + self changed: #windowTitle]! - | aWindow existingLabel newLabel | - - (aWindow := self containingWindow) ifNil: [^ self]. - (existingLabel := aWindow label) isEmptyOrNil ifTrue: [^ self]. - (((existingLabel size < 3) or: [existingLabel last ~~ $]]) or: [(existingLabel at: (existingLabel size - 1)) isDigit not]) ifTrue: [^ self]. - existingLabel size to: 1 by: -1 do: - [:anIndex | ((existingLabel at: anIndex) == $[) ifTrue: - [newLabel := (existingLabel copyFrom: 1 to: anIndex), - 'Filtered: ', - messageList size printString, - ']'. - ^ aWindow setLabel: newLabel]] - - - ! Item was changed: ----- Method: MessageSet>>initializeMessageList: (in category 'private') ----- initializeMessageList: anArray "Initialize my messageList from the given list of MethodReference or string objects. NB: special handling for uniclasses. Do /not/ replace the elements of anArray if they are already MethodReferences, so as to allow users to construct richer systems, such as differencers between existing and edited versions of code." + messageList := Set new. - messageList := OrderedCollection new. anArray do: [:each | each isMethodReference + ifTrue: [messageList add: each] - ifTrue: [messageList addLast: each] ifFalse: [ MessageSet parse: each toClassAndSelector: + [ : class : sel | class ifNotNil: [ messageList add: (MethodReference class: class selector: sel) ] ] ] ]. + messageList := messageList asOrderedCollection sort. - [ : class : sel | class ifNotNil: [ messageList addLast: (MethodReference class: class selector: sel) ] ] ] ]. "Unify labels if wanted." self class useUnifiedMessageLabels ifTrue: [ messageList withIndexDo: [ : each : index | | cls | cls := each actualClass. each stringVersion: (self indentionPrefixOfSize: (self indentionsIn: each stringVersion)) , (cls ifNil: [each asString] ifNotNil: [cls isUniClass ifTrue: [cls typicalInstanceName, ' ', each selector] ifFalse: [ cls name , ' ' , each selector , ' {' , ((cls organization categoryOfElement: each selector) ifNil: ['']) , '}' , ' {', cls category, '}' ] ]) ] ]. messageListIndex := messageList isEmpty ifTrue: [0] ifFalse: [1]. contents := String empty! Item was changed: ----- Method: MessageSet>>messageListIndex: (in category 'message list') ----- messageListIndex: anInteger + "Set the index of the selected item to be anInteger. + Update the message list morph, the text edit morph and the assorted buttons" - "Set the index of the selected item to be anInteger." messageListIndex := anInteger. contents := messageListIndex ~= 0 ifTrue: [self selectedMessage] ifFalse: ['']. self changed: #messageListIndex. "update my selection" self editSelection: #editMessage. self contentsChanged. (messageListIndex ~= 0 and: [ autoSelectString notNil and: [ self contents notEmpty ] ]) ifTrue: [ self changed: #autoSelect ]. self decorateButtons ! Item was added: + ----- Method: MessageSet>>setInitialLabel: (in category 'accessing') ----- + setInitialLabel: aString + "set the base label for the window, as returned by #windowTitle" + + windowLabel := aString! Item was added: + ----- Method: MessageSet>>windowTitle (in category 'user interface') ----- + windowTitle + "just return the basic label for now" + + ^windowLabel! Item was changed: MessageSet subclass: #MessageTrace + instanceVariableNames: 'autoSelectStrings messageSelections anchorIndex' - instanceVariableNames: 'autoSelectStrings messageSelections anchorIndex defaultSelectString' classVariableNames: '' poolDictionaries: '' category: 'Tools-Browser'! !MessageTrace commentStamp: 'cmm 3/2/2010 20:26' prior: 0! A MessageTrace is a MessageSet allowing efficient sender/implementor message following. With implementors indented below, and senders outdended above, message flow is succinctly expressed, hierarchically. My autoSelectStrings and messageSelections are Arrays of Booleans, parallel to my messageList. Each boolean indicates whether that message is selected. Each autoSelectStrings indicates which string should be highlighted in the code for each method in my messageList.! Item was changed: ----- Method: MessageTrace>>browseAllImplementorsOf: (in category 'actions') ----- browseAllImplementorsOf: selectorSymbol | selectorToBrowse | selectorToBrowse := self selection ifNil: [ selectorSymbol ] + ifNotNil: [ self getImplementorNamed: selectorSymbol asSymbol "since we can get passed literals"]. - ifNotNil: [ self getImplementorNamed: selectorSymbol ]. (self hasUnacceptedEdits or: [ Preferences traceMessages not ]) ifTrue: [ super browseAllImplementorsOf: selectorToBrowse ] ifFalse: [ self addChildMethodsNamed: selectorToBrowse ] ! Item was changed: ----- Method: MessageTrace>>initializeMessageList: (in category 'private initializing') ----- initializeMessageList: anArray - messageSelections := (Array new: anArray size withAll: false) asOrderedCollection. super initializeMessageList: anArray. + messageSelections := (Array new: messageList size withAll: false) asOrderedCollection. self messageAt: messageListIndex beSelected: true. "autoSelectStrings is initialized right after this method, in autoSelectString:" ! Item was changed: ----- Method: MessageTrace>>messageListIndex: (in category 'actions') ----- messageListIndex: anInteger + "Set the index of the selected item to be anInteger. + Find the relevant auto select string to use, do my superclass' work and update the window title" + autoSelectStrings ifNotEmpty: [ autoSelectString := anInteger = 0 + ifTrue: [ "clear the autoSelectString" + String empty ] + ifFalse: [autoSelectStrings at: anInteger] + ]. + + anInteger > 0 ifTrue: [ self + messageAt: anInteger + beSelected: true + ]. + super messageListIndex: anInteger. + self changed: #windowTitle - ifTrue: - [ defaultSelectString ifNotNil: [:default| self containingWindow setLabel: default]. - "clear the autoSelectString" - '' ] - ifFalse: - [ messageListIndex := anInteger. - "setting the window label, below, can't wait for this.." - self containingWindow setLabel: (self windowLabelAt: anInteger). - "work out the string to ask the text view to pre-select. We should do better than this; after all the debugger does" - (autoSelectStrings at: anInteger)] ]. - anInteger > 0 ifTrue: - [ self - messageAt: anInteger - beSelected: true ]. - super messageListIndex: anInteger ! Item was changed: ----- Method: MessageTrace>>windowLabelAt: (in category 'private accessing') ----- windowLabelAt: anInteger + "return a suitable window label when there is an actual list item selected; work out what it should be based upon the array of autoSelectStrings or the current selection" + ^(autoSelectStrings at: anInteger) + ifNil: [ 'Implementors of ', - | str | - defaultSelectString ifNil: - [defaultSelectString := self containingWindow label]. - ^(str := autoSelectStrings at: anInteger) - ifNil: - [ 'Implementors of ', (self class parse: self selection + toClassAndSelector: [ :class :selector | selector ]) + ] + ifNotNil: [:str| 'Senders of ', str ] - toClassAndSelector: [ :class :selector | selector ]) ] - ifNotNil: - [ 'Senders of ', str ] ! Item was added: + ----- Method: MessageTrace>>windowTitle (in category 'building') ----- + windowTitle + "set the window label to suit the selection state; + if no selection, use saved widow label and add the number of items in the messageList + if something is selected, use the relevant string provided by windowLabelAt: which considers the index" + + ^messageListIndex = 0 + ifTrue:[String streamContents: [:str| str nextPutAll: windowLabel; + space; + nextPut: $[; + nextPutAll: messageList size asString; + nextPut: $] + ] + ] + ifFalse: [self windowLabelAt: messageListIndex]!

3 5

Unicode
by Thiede, Christoph 15 Jun '22

15 Jun '22

Hi all! :-) After some recent fun with the Unicode class, I found out that its data is quite out of date (for example, the comments do not even "know" that code points can be longer than 4 bytes. Younger characters such as 😺❤🤓 are not categorized correctly, etc. ...). Luckily, there is already some logic to fetch the latest data from www.unicode.org<http://www.unicode.org>. I'm currently reworking this logic because it's not completely automated yet and has some slips, but so long, I have one general question for you: At the moment, we have 30 class variables each for one Unicode category number. These class vars map in alphabetical order to the integers from 0 to: 29. Is this tedious structure really necessary? For different purposes, I would like to get the category name of a specific code point from a client. The current design makes this impossible without writing additional mappings. Tl;dr: I would like to propose to drop these class variables and use Symbols instead. They are comparable like integers, and as they are flyweights, this should not be a performance issue either. Of course, #generalCategoryOf: will have to keep returning numbers, but we could deprecate it and use a new #generalTagOf: in the future. Furthermore, this would also allow us to deal with later added category names (though I don't know whether this will ever happen). Examples: Unicode generalTagOf: $a asUnicode. "#Ll" Unicode class >> isLetterCode: charCode ^ (self generalTagOf: charCode) first = $L Unicode class >> isAlphaNumericCode: charCode | tag| ^ (tag := self generalCategoryOf: charCode) first = $L or: [tag = #Nd] How do you think about this proposal? Please let me know and I will go ahead! :D Best, Christoph

9 26

Re-signalling an already signaled exception
by mail＠jaromir.net 12 Jun '22

12 Jun '22

Hi all, You can signal an already signaled exception; the nested #signal will start searching for an exception handler from the most recently created exception handler. I wonder if this is a legitimate and reasonable interpretation of ANSI's #signal: Quote: The current exception environment is searched for an exception handler whose exception selector matches the signaled exception. The search proceeds from the most recently created exception handler to the oldest exception handler. Repeated #signal would differ from #outer in that #outer starts serching for a handler from the current handler context and not from the most recently created handler context. Here's a motivation example: [1/0] on: Error do: [:ex | [ex signal] on: ZeroDivide do: [Transcript show: #ZeroDivide] ] Would you expect this code to work and pick up the ZeroDivide handler? Current implementation will ignore the ZeroDivide handler and open a debugger as the default action. It because currently a repeated signal is made equivalent to #outer. If you agree with the above interpretation then The Inbox: Kernel-jar.1407 provides its implementation and Tests-jar.464 some tests. The point or a use case is to provide additional (finer, more specific) handlers inside the general handler rather than wrap the general handler inside more specific handlers. More specific handlers can even be inside a method so the readability would not degrade. Here's a simple example: [1/o] on: Error do: [:ex | [[ex signal] on: ZeroDivide do: [Transcript show: #ZeroDivide]] on: MessageNotUnderstood do: [Transcript show: #MNU] ] or even [1/o] on: Error do: [:ex | self dissect: ex] instead of [[1/o] on: ZeroDivide do: [Transcript show: #ZeroDivide]] on: MessageNotUnderstood do: [Transcript show: #MNU] Does this make sense? Thanks for your opinion. best, Jaromir ^[^ -- Sent from Squeak Inbox Talk

6 12

Review Request: genericDropSourceCode.cs & complements
by christoph.thiede＠student.hpi.uni-potsdam.de 05 Jun '22

05 Jun '22

This review requests consists of 3 changesets, for each of which I am appending a summary below: - genericDropSourceCode.cs - browse&drop-Monticello.cs - browse&drag-Tools+System.cs tl;dr: You can now drop pretty much everything into the world to spawn a new tool for it. See also the attached screencast that I have recorded just for your entertainment. :-) Screencast: https://shorturl.at/gkwC6 Please review & let me know when I can merge it! :D Best, Christoph =============== Summary (genericDropSourceCode.cs) =============== Change Set: genericDropSourceCode Date: 26 January 2022 Author: Christoph Thiede This changeset simplifies & generalizes the #dropSourceCode mechanism which you can observe by dragging a class or method from a tool into the world. With this patch, the coupling between PasteUpMorph and tools is eliminated, and other classes can easily participate in the mechanism by specifying the dragTransferType #sourceCode and providing a passenger that implements #browse and answers the tool-buildable or a window. In addition, it is now also possible to drag a string or text into the world to spawn a new workspace. =============== Diff =============== Object>>browse {*Tools-Browsing} · ct 1/26/2022 21:54 (changed) browse - ToolSet browseClass: self class + ^ ToolSet browseClass: self class PasteUpMorph>>acceptDroppingMorph:event: {dropping/grabbing} · ct 1/27/2022 00:39 (changed) acceptDroppingMorph: dropped event: evt "The supplied morph, known to be acceptable to the receiver, is now to be assimilated; the precipitating event is supplied" | aMorph | (self isWorldMorph and: [dropped isTransferMorph]) ifTrue: [ dropped dragTransferType = #filesAndDirectories ifTrue: [^ self dropFiles: dropped passenger event: evt]. dropped dragTransferType = #sourceCode - ifTrue: [^ self dropSourceCode: dropped passenger event: evt]]. + ifTrue: [^ self dropSourceCode: dropped passenger event: evt]. + (dropped passenger isString or: [dropped passenger isText]) + ifTrue: [^ self dropEditable: dropped passenger event: evt]]. aMorph := self morphToDropFrom: dropped. self isWorldMorph ifFalse: [super acceptDroppingMorph: aMorph event: evt] ifTrue: ["Add the given morph to this world and start stepping it if it wants to be." aMorph isInWorld ifFalse: [aMorph position: evt position]. self addMorphFront: aMorph. (aMorph fullBounds intersects: self viewBox) ifFalse: [Beeper beep. aMorph position: self bounds center]]. aMorph submorphsDo: [:m | (m isKindOf: HaloMorph) ifTrue: [m delete]]. aMorph allMorphsDo: "Establish any penDown morphs in new world" [:m | | tfm mm | m player ifNotNil: [m player getPenDown ifTrue: [((mm := m player costume) notNil and: [(tfm := mm owner transformFrom: self) notNil]) ifTrue: [self noteNewLocation: (tfm localPointToGlobal: mm referencePosition) forPlayer: m player]]]]. self isPartsBin ifTrue: [aMorph isPartsDonor: true. aMorph stopSteppingSelfAndSubmorphs. aMorph suspendEventHandler] ifFalse: [self world startSteppingSubmorphsOf: aMorph]. " self presenter morph: aMorph droppedIntoPasteUpMorph: self." self showingListView ifTrue: [self sortSubmorphsBy: (self valueOfProperty: #sortOrder). self currentWorld abandonAllHalos]. self bringTopmostsToFront. PasteUpMorph>>dropEditable:event: {event handling} · ct 1/27/2022 00:38 + dropEditable: aStringOrText event: evt + + ^ self dropTool: aStringOrText edit event: evt PasteUpMorph>>dropSourceCode:event: {event handling} · ct 1/27/2022 00:37 (changed) dropSourceCode: anObject event: evt - (anObject isMethodReference and: [anObject isValid]) - ifTrue: [^ self dropSourceCode: anObject compiledMethod event: evt]. - - (anObject isBehavior or: [anObject isCompiledMethod]) - ifTrue: [ - | tool window | - tool := anObject isBehavior - ifTrue: [Browser new - setClass: anObject] - ifFalse: [CodeHolder new - setClass: anObject methodClass - selector: anObject selector]. - window := ToolBuilder open: tool. - window center: evt position. - window bounds: (window bounds translatedToBeWithin: self bounds)]. - - anObject isString - ifTrue: [anObject edit]. + ^ self dropTool: anObject browse event: evt PasteUpMorph>>dropTool:event: {event handling} · ct 1/27/2022 00:37 + dropTool: tool event: evt + + | window | + tool ifNil: [^ self]. + + window := tool containingWindow ifNil: [ToolBuilder open: tool]. + window center: evt position. + window bounds: (window bounds translatedToBeWithin: self bounds). + ^ window PasteUpMorph>>wantsDroppedTransferMorph: {dropping/grabbing} · ct 1/26/2022 22:11 (changed) wantsDroppedTransferMorph: transferMorph ^ self hasTransferMorphConverter or: [transferMorph dragTransferType = #filesAndDirectories] - or: [transferMorph dragTransferType = #sourceCode] + or: [transferMorph dragTransferType = #sourceCode] + or: [transferMorph passenger isString or: [transferMorph passenger isText]] String>>edit {*toolbuilder-kernel} · ct 1/26/2022 22:13 (changed) edit - UIManager default edit: self. + ^ Project uiManager edit: self. SystemWindow>>openAsTool {*ToolBuilder-Morphic-opening} · ct 1/26/2022 21:53 (changed) openAsTool "Open this window as a tool, that is, honor the preferences such as #reuseWindows and #openToolsAttachedToMouseCursor." - + | meOrSimilarWindow | meOrSimilarWindow := self openInWorldExtent: self extent. - (Project uiManager openToolsAttachedToMouseCursor "and: [ | event | - event := self currentEvent. - event isMouse and: [event isMouseUp]]") ifTrue: [ - meOrSimilarWindow setProperty: #initialDrop toValue: true. - meOrSimilarWindow hasDropShadow: false. - self currentHand attachMorph: meOrSimilarWindow]. + (Project uiManager openToolsAttachedToMouseCursor + and: [ | event | + event := self currentEvent. + (event isMouse and: [event isMouseUp]) or: [event isDropEvent]]) + ifTrue: [ + meOrSimilarWindow setProperty: #initialDrop toValue: true. + meOrSimilarWindow hasDropShadow: false. + self currentHand attachMorph: meOrSimilarWindow]. ^ meOrSimilarWindow Text>>edit {*ToolBuilder-Kernel} · ct 1/26/2022 22:13 (changed) edit - UIManager default edit: self. + ^ Project uiManager edit: self. =============== Summary (browse&drop-Monticello.cs) =============== Change Set: browse&drop-Monticello Date: 27 January 2022 Author: Christoph Thiede This changeset complements genericDropSourceCode.cs by specifying the #dragItem/#dragType protocol for most tools in the Monticello UI and providing proper implementations of #browse in the model classes. At a few places, multilingual support is improved, too. As an entrypoint to this changeset, please read: MCToolWindowBuilder>>#listMorph:selection:menu:keystroke:drag: =============== Diff =============== MCClassDefinition>>browseVersions {browsing} · ct 1/26/2022 22:59 + browseVersions + + ^ self actualClass browse MCConfiguration>>browse {actions} · ct 1/26/2022 22:02 (changed) browse | browser | browser := MCConfigurationBrowser new configuration: self copyForEdit. name ifNotNil: [:nm | browser label: browser defaultLabel , ' ' , nm]. - browser show + ^ browser show MCDefinition>>browseVersions {browsing} · ct 1/26/2022 22:58 + browseVersions + + ^ nil MCFileBasedRepository>>morphicOpen: {user interface} · ct 1/26/2022 22:22 (changed) morphicOpen: aWorkingCopy - (MCFileRepositoryInspector repository: self workingCopy: aWorkingCopy) + ^ (MCFileRepositoryInspector repository: self workingCopy: aWorkingCopy) show MCMethodDefinition>>actualMethod {accessing} · ct 1/26/2022 22:39 + actualMethod + ^ self actualMethodIn: Environment current MCMethodDefinition>>actualMethodIn: {accessing} · ct 1/27/2022 00:43 + actualMethodIn: anEnvironment + "Answer the installed compiled method that belongs to this definition, or a change record if this version of the method is no longer installed." + | class method | + class := (self actualClassIn: anEnvironment) ifNil: [^ nil]. + method := class compiledMethodAt: self selector ifAbsent: [nil]. + (method isNil or: [method timeStamp = self timeStamp]) + ifFalse: [method := (class changeRecordsAt: self selector) + detect: [:record | record stamp = self timeStamp] + ifNone: [nil]]. + ^ method MCMethodDefinition>>browse {browsing} · ct 1/26/2022 23:00 (changed and recategorized) browse - | browser | - browser := MCSnapshotBrowser forSnapshot: (MCSnapshot fromDefinitions: {self}). - browser - categorySelection: 1; - classSelection: 1. - classIsMeta ifTrue: [browser switchBeClass]. - browser - protocolSelection: 1; - methodSelection: 1; - showLabelled: 'Snapshot of ', self summary. - ^ browser + + ^ self actualMethod ifNotNil: [:method | method isCompiledMethod + ifTrue: [method browse] + ifFalse: [self browseVersions]] MCMethodDefinition>>browseVersions {browsing} · ct 1/26/2022 23:00 + browseVersions + + ^ ToolSet browseVersionsOf: self actualClass selector: self selector MCOperationsBrowser>>methodAt: {accessing} · ct 1/26/2022 22:53 + methodAt: index + + ^ self items at: index MCOperationsBrowser>>widgetSpecs {ui} · ct 1/26/2022 22:51 (changed) widgetSpecs Preferences annotationPanes ifFalse: [ ^#( - ((listMorph:selection:menu:keystroke: list selection methodListMenu: methodListKey:from:) (0 0 1 0.4) (0 0 0 0)) + ((listMorph:selection:menu:keystroke:drag: list selection methodListMenu: methodListKey:from: methodAt:) (0 0 1 0.4) (0 0 0 0)) ((textMorph: text) (0 0.4 1 1)) ) ]. ^ #( - ((listMorph:selection:menu:keystroke: list selection methodListMenu: methodListKey:from:) (0 0 1 0.4) (0 0 0 0)) + ((listMorph:selection:menu:keystroke:drag: list selection methodListMenu: methodListKey:from: methodAt:) (0 0 1 0.4) (0 0 0 0)) ((textMorph: annotations) (0 0.4 1 0.4) (0 0 0 defaultAnnotationPaneHeight)) ((textMorph: text) (0 0.4 1 1) (0 defaultAnnotationPaneHeight 0 0)) ) MCOperationsList>>browse {ui} · ct 1/26/2022 22:02 (changed) browse - (self browserClass items: operations) show + ^ (self browserClass items: operations) show MCPatch>>browse {ui} · ct 1/26/2022 22:02 (changed) browse - (self browserClass forPatch: self) show + ^ (self browserClass forPatch: self) show MCPatchOperation>>browse {browsing} · ct 1/26/2022 22:58 + browse + + ^ self definition browseVersions MCRepository>>browse {user interface} · ct 1/26/2022 22:21 + browse + + ^ self morphicOpen MCRepository>>morphicOpen {user interface} · ct 1/26/2022 22:21 (changed) morphicOpen - self morphicOpen: nil + ^ self morphicOpen: nil MCRepository>>morphicOpen: {user interface} · ct 1/26/2022 22:21 (changed) morphicOpen: aWorkingCopy - (MCRepositoryInspector repository: self workingCopy: aWorkingCopy) show + ^ (MCRepositoryInspector repository: self workingCopy: aWorkingCopy) show MCRepositoryInspector>>packageAt: {morphic ui} · ct 1/26/2022 22:24 + packageAt: index + ^ nil MCRepositoryInspector>>versionAt: {morphic ui} · ct 1/26/2022 22:25 + versionAt: index + + ^ repository versionNamed: (self versionNames at: index) MCSnapshotBrowser>>categoryAt: {listing} · ct 1/26/2022 22:36 + categoryAt: index + ^ nil MCSnapshotBrowser>>classAt: {listing} · ct 1/26/2022 22:37 + classAt: index + | className environment | + className := self visibleClasses at: index. + environment := self environmentInDisplayingImage. + ^ environment at: className ifAbsent: + [environment valueOf: className] MCSnapshotBrowser>>methodAt: {listing} · ct 1/26/2022 22:34 + methodAt: index + ^ self visibleMethods at: index MCSnapshotBrowser>>protocolAt: {listing} · ct 1/26/2022 22:35 + protocolAt: index + ^ nil MCSnapshotBrowser>>widgetSpecs {morphic ui} · ct 1/27/2022 00:24 (changed) widgetSpecs Preferences annotationPanes ifFalse: [ ^#( ((listMorph: category) (0 0 0.25 0.4)) ((listMorph: class) (0.25 0 0.50 0.4) (0 0 0 -30)) ((listMorph: protocol) (0.50 0 0.75 0.4)) - ((listMorph:selection:menu:keystroke: methodList methodSelection methodListMenu: methodListKey:from:) (0.75 0 1 0.4)) + ((listMorph:selection:menu:keystroke:drag: methodList methodSelection methodListMenu: methodListKey:from: methodAt:) (0.75 0 1 0.4)) ((buttonRow) (0.25 0.4 0.5 0.4) (0 -30 0 0)) ((codePane: text) (0 0.4 1 1)) ) ]. ^#( ((listMorph: category) (0 0 0.25 0.4)) ((listMorph: class) (0.25 0 0.50 0.4) (0 0 0 -30)) ((listMorph: protocol) (0.50 0 0.75 0.4)) - ((listMorph:selection:menu:keystroke: methodList methodSelection methodListMenu: methodListKey:from:) (0.75 0 1 0.4)) + ((listMorph:selection:menu:keystroke:drag: methodList methodSelection methodListMenu: methodListKey:from: methodAt:) (0.75 0 1 0.4)) ((buttonRow) (0.25 0.4 0.5 0.4) (0 -30 0 0)) ((inputMorph: annotations) (0 0.4 1 0.4) (0 0 0 defaultInputFieldHeight)) ((codePane: text) (0 0.4 1 1) (0 defaultInputFieldHeight 0 0)) ) MCTool>>dragType: {morphic ui} · ct 1/26/2022 22:16 + dragType: anObject + + ^ #sourceCode MCToolWindowBuilder>>listMorph: {building-parts} · ct 1/26/2022 22:19 (changed) listMorph: listSymbol ^ self listMorph: (listSymbol, 'List') asSymbol selection: (listSymbol, 'Selection') asSymbol - menu: (listSymbol, 'ListMenu:') asSymbol + menu: (listSymbol, 'ListMenu:') asSymbol + keystroke: nil + drag: (listSymbol, 'At:') asSymbol MCToolWindowBuilder>>listMorph:selection: {building-parts} · ct 1/26/2022 22:27 (changed) listMorph: listSymbol selection: selectionSymbol - self listMorph: listSymbol selection: selectionSymbol menu: nil + ^ self listMorph: listSymbol selection: selectionSymbol menu: nil MCToolWindowBuilder>>listMorph:selection:menu: {building-parts} · ct 1/26/2022 22:17 (changed) listMorph: listSymbol selection: selectionSymbol menu: menuSymbol - self listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: nil + ^ self listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: nil MCToolWindowBuilder>>listMorph:selection:menu:keystroke: {building-parts} · ct 1/26/2022 22:17 (changed) listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: keystrokeSymbol - | list | - list := builder pluggableListSpec new. - list - model: tool; - list: listSymbol; - getIndex: selectionSymbol; - setIndex: (selectionSymbol, ':') asSymbol; - frame: currentFrame. - menuSymbol ifNotNil: [list menu: menuSymbol]. - keystrokeSymbol ifNotNil: [list keyPress: keystrokeSymbol]. - window children add: list + ^ self listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: nil drag: nil MCToolWindowBuilder>>listMorph:selection:menu:keystroke:drag: {building-parts} · ct 1/26/2022 22:27 + listMorph: listSymbol selection: selectionSymbol menu: menuSymbol keystroke: keystrokeSymbol drag: dragSymbol + | list | + list := builder pluggableListSpec new. + list + model: tool; + list: listSymbol; + getIndex: selectionSymbol; + setIndex: (selectionSymbol, ':') asSymbol; + frame: currentFrame; + dragItem: dragSymbol; + dragType: #dragType:. + menuSymbol ifNotNil: [list menu: menuSymbol]. + keystrokeSymbol ifNotNil: [list keyPress: keystrokeSymbol]. + window children add: list MCVersion>>browse {actions} · ct 1/27/2022 00:24 (changed) browse - (MCSnapshotBrowser forSnapshot: self snapshot) - label: 'Snapshot of ', self fileName; + ^ (MCSnapshotBrowser forSnapshot: self snapshot) + label: ('Snapshot of {1}' translated format: {self fileName}); show MCVersionHistoryBrowser>>versionAt: {accessing} · ct 1/27/2022 00:16 + versionAt: index + ^ self repositoryGroup versionWithInfo: (self infos at: index) MCVersionHistoryBrowser>>widgetSpecs {morphic ui} · ct 1/27/2022 00:16 (changed) widgetSpecs ^ #( - ((listMorph:selection:menu: list selection getMenu:) (0 0 0.3 1)) + ((listMorph:selection:menu:keystroke:drag: list selection getMenu: nil versionAt:) (0 0 0.3 1)) ((textMorph: summary) (0.3 0 1 1)) ) MCVersionInspector>>browse {accessing} · ct 1/26/2022 22:02 (changed) browse - self version browse + ^ self version browse MCWorkingCopy>>browse {ui} · ct 1/27/2022 00:25 (changed) browse - (MCSnapshotBrowser forSnapshot: self package snapshot) - label: 'Snapshot Browser: ', self packageName; - show. + ^ (MCSnapshotBrowser forSnapshot: self package snapshot) + label: ('Snapshot Browser: {1}' translated format: {self packageName}); + show MCWorkingCopyBrowser>>repositoryAt: {morphic ui} · ct 1/26/2022 22:20 + repositoryAt: index + ^ self repositories at: index MCWorkingCopyBrowser>>workingCopyAt: {morphic ui} · ct 1/26/2022 22:19 + workingCopyAt: index + ^ self workingCopies at: index =============== Summary (browse&drag-Tools+System.cs) =============== Change Set: browse&drag-Tools+System Date: 27 January 2022 Author: Christoph Thiede This changeset complements genericDropSourceCode.cs by specifying the #dragItem/#dragType protocol for some changes tools and browsers, and providing proper implementations of #browse for changes. All affected tools: - Change sorters (single + dual), change set browser - Dependency browser - Package browser - Preferences (no UI support yet, just follow the idiom to answer the browsing tool from #browse) =============== Postscript =============== ('accessing' author classChanges classRemoves editPostscript hasPostscript methodChanges methodInfoFromRemoval: name name: numberOfChanges postscriptHasDependents printOn: removePostscript structures superclasses) ('change logging' addClass: changeClass:from: event: noteNewMethod:forClass:selector:priorMethod: removeSelector:class:priorMethod:lastMethodInfo: renameClass:from:to:) ('class changes' changedClassNames changedClasses changedClassesDo: classChangeAt: commentClass: containsClass: fatDefForClass: noteClassForgotten: noteClassStructure: noteRemovalOf: reorganizeClass: trimHistory) ('converting' convertApril2000:using: convertToCurrentVersion:refStream:) ('fileIn/Out' askAddedInstVars: askRemovedInstVars: askRenames:addTo:using: assurePostscriptExists assurePreambleExists buildMessageForMailOutWithUser: checkForAlienAuthorship checkForAnyAlienAuthorship checkForConversionMethods checkForSlips checkForUnclassifiedMethods checkForUncommentedClasses checkForUncommentedMethods checkForUnsentMessages chooseSubjectPrefixForEmail defaultChangeSetDirectory fileOut fileOutChangesFor:on: fileOutOn: fileOutPSFor:on: fileOutPostscriptOn: fileOutPreambleOn: lookForSlips mailOut objectForDataStream: postscript postscriptString postscriptString: postscript: preamble preambleString preambleString: preambleTemplate preamble: setPreambleToSay: summaryString summaryStringDelta: verboseFileOut) ('initialize-release' beIsolationSetFor: clear initialize isMoribund veryDeepCopyWith: wither zapHistory) ('isolation layers' invoke isolatedProject isolationSet: revoke uninstall) ('method changes' adoptSelector:forClass: atSelector:class:put: changedMessageList changedMessageListAugmented changedMethods changedMethodsDo: hasAnyChangeForSelector: messageListForChangesWhich:ifNone: methodChangesAtClass: removeSelectorChanges:class: selectorsInClass:) ('moving changes' absorbClass:from: absorbMethod:class:from: absorbStructureOfClass:from: assimilateAllChangesFoundIn: editPreamble expungeEmptyClassChangeEntries expungeUniclasses forgetAllChangesFoundIn: forgetChangesForClass:in: hasPreamble methodsWithAnyInitialsOtherThan: methodsWithInitialsOtherThan: methodsWithoutComments removeClassAndMetaClassChanges: removeClassChanges: removePreamble) ('testing' belongsToAProject containsMethodAtPosition: correspondingProject isEmpty methodsWithoutClassifications okayToRemove okayToRemoveInforming: projectsBelongedTo) ('private' addCoherency: atClass:add: atClass:includes: atSelector:class: changed:with: changeRecorderFor: fileOutClassDefinition:on: oldNameFor:) ('*Monticello-testing' isForPackageLoad) ('*Etoys-Squeakland-fileIn/Out' checkForSUnit) ('*Tools-Browsing' browse) =============== Diff =============== ChangeSet>>browse {*Tools-Browsing} · ct 1/26/2022 22:03 + browse + + ^ ChangeSetBrowser openOn: self ChangeSorter>>buildChangeSetListWith: {toolbuilder} · ct 1/26/2022 22:04 (changed) buildChangeSetListWith: builder | listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; list: #changeSetList; getSelected: #currentCngSet; setSelected: #showChangeSetNamed:; menu: #changeSetMenu:shifted:; keyPress: #changeSetListKey:from:; dragItem: #dragChangeSet:; + dragType: #dragTypeForChangeSet:; autoDeselect: false. ^ listSpec ChangeSorter>>buildClassListWith: {toolbuilder} · ct 1/26/2022 22:06 (changed) buildClassListWith: builder | listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; list: #classList; getSelected: #currentClassName; setSelected: #currentClassName:; menu: #classListMenu:shifted:; keyPress: #classListKey:from:; - dragItem: #dragClass:. + dragItem: #dragClass:; + dragType: #dragTypeForClass:. ^ listSpec ChangeSorter>>buildMessageListWith: {toolbuilder} · ct 1/26/2022 22:07 (changed) buildMessageListWith: builder | listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; list: #messageList; getSelected: #currentSelector; setSelected: #currentSelector:; menu: #messageMenu:shifted:; keyPress: #messageListKey:from:; - dragItem: #dragMessage:. + dragItem: #dragMessage:; + dragType: #dragTypeForMessage:. ^ listSpec ChangeSorter>>dragTypeForChangeSet: {dragging} · ct 1/26/2022 22:04 + dragTypeForChangeSet: anIndex + + ^ #sourceCode ChangeSorter>>dragTypeForClass: {dragging} · ct 1/26/2022 22:06 + dragTypeForClass: anIndex + + ^ #sourceCode ChangeSorter>>dragTypeForMessage: {dragging} · ct 1/26/2022 22:06 + dragTypeForMessage: anIndex + + ^ #sourceCode DependencyBrowser>>buildClassDepsWith: {toolbuilder} · ct 1/27/2022 00:03 (changed) buildClassDepsWith: builder | listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; name: 'Required Classes' ; list: #classDepsList; getIndex: #classDepsIndex; setIndex: #classDepsIndex:; menu: #classDepsMenu:; - keyPress: #classDepsKey:from:. + keyPress: #classDepsKey:from:; + dragItem: #dragFromClassDepAt:; + dragType: #dragTypeForClassDepAt:. ^listSpec DependencyBrowser>>buildClassListWith: {toolbuilder} · ct 1/27/2022 00:07 (changed) buildClassListWith: builder | listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; name: 'Client classes' ; list: #classList; getIndex: #classListIndex; setIndex: #classListIndex:; menu: #classListMenu:; - keyPress: #classListKey:from:. + keyPress: #classListKey:from:; + dragItem: #dragFromClassAt:; + dragType: #dragTypeForClassAt:. ^listSpec DependencyBrowser>>buildMessageListWith: {toolbuilder} · ct 1/27/2022 00:05 (changed) buildMessageListWith: builder | listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; name: 'Client methods' ; list: #messageList; getIndex: #messageListIndex; setIndex: #messageListIndex:; menu: #messageListMenu:; - keyPress: #messageListKey:from:. + keyPress: #messageListKey:from:; + dragItem: #dragFromMessageAt:; + dragType: #dragTypeForMessageAt:. ^listSpec DependencyBrowser>>buildPackageDepsWith: {toolbuilder} · ct 1/27/2022 00:05 (changed) buildPackageDepsWith: builder | listSpec | listSpec := builder pluggableListSpec new. - listSpec + listSpec model: self; - name: 'Required Packages' ; - list: #packageDepsList; - getIndex: #packageDepsIndex; - setIndex: #packageDepsIndex:; - menu: #packageDepsMenu:; - keyPress: #packageDepsKey:from:. - ^listSpec + name: 'Required Packages'; + list: #packageDepsList; + getIndex: #packageDepsIndex; + setIndex: #packageDepsIndex:; + menu: #packageDepsMenu:; + keyPress: #packageDepsKey:from:; + dragItem: #dragFromPackageDepAt:; + dragType: #dragTypeForPackageDepAt:. + ^ listSpec DependencyBrowser>>buildPackageListWith: {toolbuilder} · ct 1/27/2022 00:06 (changed) buildPackageListWith: builder | listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; name: 'Packages' ; list: #packageList; getIndex: #packageListIndex; setIndex: #packageListIndex:; menu: #packageListMenu:; - keyPress: #packageListKey:from:. + keyPress: #packageListKey:from:; + dragItem: #dragFromPackageAt:; + dragType: #dragTypeForPackageAt:. ^listSpec DependencyBrowser>>dragFromClassAt: {class list} · ct 1/27/2022 00:08 + dragFromClassAt: anInteger + + ^ self environment classNamed: (self classList at: anInteger) DependencyBrowser>>dragFromClassDepAt: {class dependencies} · ct 1/27/2022 00:04 + dragFromClassDepAt: anInteger + + ^ self environment classNamed: (self classDeps at: anInteger) DependencyBrowser>>dragFromMessageAt: {message list} · ct 1/27/2022 00:08 + dragFromMessageAt: anInteger + + ^ self selectedClass >> (self messageList at: anInteger) DependencyBrowser>>dragFromPackageAt: {package list} · ct 1/27/2022 00:10 + dragFromPackageAt: anInteger + + ^ PackageInfo named: (self packageList at: anInteger) DependencyBrowser>>dragFromPackageDepAt: {package dependencies} · ct 1/27/2022 00:11 + dragFromPackageDepAt: anInteger + + ^ PackageInfo named: (self packageDeps at: anInteger) DependencyBrowser>>dragTypeForClassAt: {class list} · ct 1/27/2022 00:07 + dragTypeForClassAt: anInteger + + ^ #sourceCode DependencyBrowser>>dragTypeForClassDepAt: {class dependencies} · ct 1/27/2022 00:04 + dragTypeForClassDepAt: anInteger + + ^ #sourceCode DependencyBrowser>>dragTypeForMessageAt: {message list} · ct 1/27/2022 00:08 + dragTypeForMessageAt: anInteger + + ^ #sourceCode DependencyBrowser>>dragTypeForPackageAt: {package list} · ct 1/27/2022 00:10 + dragTypeForPackageAt: anInteger + + ^ #sourceCode DependencyBrowser>>dragTypeForPackageDepAt: {package dependencies} · ct 1/27/2022 00:09 + dragTypeForPackageDepAt: anInteger + + ^ #sourceCode PackagePaneBrowser>>buildPackageListWith: {toolbuilder} · ct 1/27/2022 00:11 (changed) buildPackageListWith: builder | listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; name: #packageList; list: #packageList; getIndex: #packageListIndex; setIndex: #packageListIndex:; menu: #packageMenu:; - keyPress: #packageListKey:from:. + keyPress: #packageListKey:from:; + dragItem: #dragFromPackageAt:; + dragType: #dragTypeForPackageAt:. ^listSpec PackagePaneBrowser>>dragFromPackageAt: {package list} · ct 1/27/2022 00:12 + dragFromPackageAt: anInteger + + ^ PackageInfo named: (self packageList at: anInteger) PackagePaneBrowser>>dragTypeForPackageAt: {package list} · ct 1/27/2022 00:11 + dragTypeForPackageAt: anInteger + + ^ #sourceCode PragmaPreference>>browse {browsing} · ct 1/26/2022 22:02 (changed) browse - ToolSet + ^ ToolSet browse: self provider class - selector: self selectors first. + selector: self selectors first Preference>>browse {browsing} · ct 1/26/2022 22:02 (changed) browse - ToolSet + ^ ToolSet browse: Preferences class - selector: self selectors first. + selector: self selectors first --- Sent from Squeak Inbox Talk ["genericDropSourceCode.1.cs"] ["browse&drop-Monticello.1.cs"] ["browse&drag-Tools+System.1.cs"]

8 10

Merge Request: autoEncloseBeforeSpace.cs
by christoph.thiede＠student.hpi.uni-potsdam.de 02 Jun '22

02 Jun '22

Hi all! This changeset refines the existing autoEnclose mechanism. Instead of having inserted enclosing brackets always, you can now activate a new preference to only insert these characters if there is any space after the cursor. This matches VS Code's setting value "beforeWhitespace" for "editor.autoClosingBrackets". To me, this mode feels much more convenient because when having traditional autoEnclose enabled, I have been getting angry again and again when I wanted to bracketize an existing expression in some code and suddenly was disrupted by an unneeded closing bracket. The changeset does not manipulate any defaults. The PreferenceWizard and the ReleaseBuilder are updated, too. Please honor the postscript of the changeset when merging it. Best, Christoph --- Sent from Squeak Inbox Talk

15 79

The Trunk: ToolsTests-ct.107.mcz
by commits＠source.squeak.org 22 May '22

22 May '22

Christoph Thiede uploaded a new version of ToolsTests to project The Trunk: http://source.squeak.org/trunk/ToolsTests-ct.107.mcz ==================== Summary ==================== Name: ToolsTests-ct.107 Author: ct Time: 16 December 2021, 2:29:44.341664 am UUID: 6b771eec-03fe-0a4d-91c9-50480d259573 Ancestors: ToolsTests-mt.106 Complements Kernel-ct.1434 (revised termination modi on Process). Adds end-to-end tests for abandoning vs. terminating a debugger inside an active unwind context. Makes proper use of new termination modi in clean-ups for other tests. =============== Diff against ToolsTests-mt.106 =============== Item was changed: ----- Method: DebuggerTests>>tearDown (in category 'running') ----- tearDown debugger ifNotNil: [debugger close]. + process ifNotNil: [process terminateAggressively]. - process ifNotNil: [process terminate]. process := nil. debugger := nil. window := nil. reset do: #value. super tearDown.! Item was changed: ----- Method: DebuggerTests>>test16HandleSimulationError (in category 'tests') ----- test16HandleSimulationError "Regression test. In the past, the scenario below led to an infinite debugger chain freezing your image. Be careful when running this test in an unpatched image!! For more information, see http://forum.world.st/I-broke-the-debugger-td5110752.html." | userProcess | process := Process forBlock: [ "the faulty user code" thisContext pc: nil]. debugger := process debug. [userProcess := [debugger stepThrough] fork. Processor yield. self deny: [process isTerminated]. self assert: [userProcess isSuspended]] ensure: [ + process destroy. - process suspendedContext: nil; terminate. debugger close. process := userProcess. self findDebugger "for correct tearDown"].! Item was changed: ----- Method: DebuggerTests>>test17HandleBlockCannotReturn (in category 'tests') ----- test17HandleBlockCannotReturn "Regression test. In the past, the scenario below led to an infinite debugger chain freezing your image. Be careful when running this test in an unpatched image!! For more information, see http://forum.world.st/I-broke-the-debugger-td5110752.html." | userProcess | process := Process forBlock: [ "the faulty user code" [] ensure: [thisContext privSender: nil]]. debugger := process debug. [userProcess := [debugger stepOver] fork. Processor yield. self assert: [process isTerminated]. self deny: [userProcess isRunnable]] ensure: [ + process terminateAggressively. - process terminate. debugger close. process := userProcess. self findDebugger "for correct tearDown"].! Item was changed: ----- Method: DebuggerTests>>test18HandleNestedBlockCannotReturn (in category 'tests') ----- test18HandleNestedBlockCannotReturn "Regression test. In the past, the scenario below led to an infinite debugger chain freezing your image. Be careful when running this test in an unpatched image!! For more information, see http://forum.world.st/I-broke-the-debugger-td5110752.html." | metaProcess metaDebugger userProcess | process := Process forBlock: [ "the faulty user code" [] ensure: [thisContext privSender: nil]]. debugger := process debug. metaProcess := Process forBlock: [ debugger stepOver]. metaDebugger := metaProcess debug. [userProcess := [metaDebugger stepOver] fork. Processor yield. self assert: [process isTerminated]. self deny: [userProcess isRunnable]] ensure: [ + process terminateAggressively. - process terminate. debugger close. + metaProcess terminateAggressively. - metaProcess terminate. metaDebugger close. process := userProcess. self findDebugger "for correct tearDown"].! Item was added: + ----- Method: DebuggerTests>>test19Abandon (in category 'tests') ----- + test19Abandon + "When the debugger is abandoned, the interrupted process is terminated aggressively, i.e., all not yet started unwind contexts are executed. Further errors that occur during unwinding lead to another debugger showing up. This is the acceptance test equivalent for ProcessTest >> #testTerminateNestedUnwindAggressively." + + | x y z userProcess | + process := Process + forBlock: + [x := 1. + [y := 1. + self error: #first. + y := 2] ensure: + [z := 1. + self error: #second. + z := 2]. + x := 2] + runUntil: [:ctx | y = 1]. + self should: {x. y. z} = {1. 1. nil}. + debugger := process debug. + + userProcess := [debugger proceed] forkAt: Processor activePriority + 1. + Processor yield. + self findDebugger. + + self deny: process isTerminated. + self assert: userProcess isTerminated. + self deny: debugger isNil. + self assert: {1. 1. nil} equals: {x. y. z}. + self assert: (debugger containingWindow label includesSubstring: #first). + + userProcess := [debugger abandon] forkAt: Processor activePriority + 1. + Processor yield. + self findDebugger. + + self deny: process isTerminated. + self assert: userProcess isTerminated. + self deny: debugger isNil. + self assert: {1. 1. 1} equals: {x. y. z}. + self assert: (debugger containingWindow label includesSubstring: #second). + + userProcess := [debugger proceed] forkAt: Processor activePriority + 1. + Processor yield. + self findDebugger. + + self assert: process isTerminated. + self assert: userProcess isTerminated. + self assert: debugger isNil. + self assert: {1. 1. 2} equals: {x. y. z}.! Item was added: + ----- Method: DebuggerTests>>test20TerminateProcess (in category 'tests') ----- + test20TerminateProcess + "When the debugger's process is terminated, all unwind contexts, including already entered ones, are executed. Further errors that occur during unwinding lead to another debugger showing up. This is the acceptance test equivalent for ProcessTest >> #testTerminateNestedUnwind." + + | x y z userProcess | + process := Process + forBlock: + [x := 1. + [y := 1. + self error: #first. + y := 2] ensure: + [z := 1. + self error: #second. + z := 2]. + x := 2] + runUntil: [:ctx | y = 1]. + self should: {x. y. z} = {1. 1. nil}. + debugger := process debug. + + userProcess := [debugger proceed] forkAt: Processor activePriority + 1. + Processor yield. + self findDebugger. + + self deny: process isTerminated. + self assert: userProcess isTerminated. + self deny: debugger isNil. + self assert: {1. 1. nil} equals: {x. y. z}. + self assert: (debugger containingWindow label includesSubstring: #first). + + userProcess := [debugger terminateProcess] forkAt: Processor activePriority + 1. + Processor yield. + self findDebugger. + + self deny: process isTerminated. + self assert: userProcess isTerminated. + self deny: debugger isNil. + self assert: {1. 2. 1} equals: {x. y. z}. + self assert: (debugger containingWindow label includesSubstring: #second). + + userProcess := [debugger proceed] forkAt: Processor activePriority + 1. + Processor yield. + self findDebugger. + + self assert: process isTerminated. + self assert: userProcess isTerminated. + self assert: debugger isNil. + self assert: {2. 2. 2} equals: {x. y. z}.!

4 7

The Trunk: TrueType-mt.73.mcz
by commits＠source.squeak.org 09 May '22

09 May '22

Marcel Taeumel uploaded a new version of TrueType to project The Trunk: http://source.squeak.org/trunk/TrueType-mt.73.mcz ==================== Summary ==================== Name: TrueType-mt.73 Author: mt Time: 25 February 2022, 10:37:20.57863 am UUID: 9a7bc579-7e0f-8c48-8a25-10f8a5466379 Ancestors: TrueType-mt.72 Move extral scale/gap from TTFontDescription up to TTCFont -- Step 2 of 2 Activate the use of TTCFont's #extraGlyphScale and #extraLineGap. (Note that this also fixes clipping artifacts of over-height and over-wide glyphs. That is, left/top/right/bottom bearings in a glyph are not respected.) =============== Diff against TrueType-mt.72 =============== Item was changed: TTCFont subclass: #LinedTTCFont instanceVariableNames: 'emphasis lineGlyph contourWidth' classVariableNames: '' poolDictionaries: '' category: 'TrueType-Fonts'! + + !LinedTTCFont commentStamp: 'mt 2/24/2022 16:24' prior: 0! + I am a TrueType font that uses the glyph for $_ to appear with underlined emphasis. If that glyph's decent is too close the baseline, the underlined font might look awkward.! Item was changed: ----- Method: LinedTTCFont>>computeForm: (in category 'private') ----- computeForm: char "Overwritten to add line glyph." + ^ ttcDescription renderGlyph: char height: self height extraScale: self extraGlyphScale fgColor: foregroundColor bgColor: Color transparent depth: self depth lineGlyph: lineGlyph lineGlyphWidth: contourWidth emphasis: emphasis! - ^ ttcDescription renderGlyph: char height: self height fgColor: foregroundColor bgColor: Color transparent depth: self depth lineGlyph: lineGlyph lineGlyphWidth: contourWidth emphasis: emphasis! Item was changed: ----- Method: TTCFont>>computeForm: (in category 'character shapes') ----- + computeForm: aCharacter - computeForm: char "Compute the glyph form for the given character" + + ^ ttcDescription + renderGlyph: aCharacter + height: self height "in pixels" + extraScale: self extraGlyphScale + fgColor: foregroundColor + bgColor: Color transparent + depth: self depth! - ^ttcDescription renderGlyph: char height: self height fgColor: foregroundColor bgColor: Color transparent depth: self depth! Item was changed: ----- Method: TTCFont>>displayString:on:from:to:at:kern:baselineY: (in category 'displaying') ----- displayString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta baselineY: baselineY | form glyphInfo destX destY hereX nextX actualFont | destX := aPoint x. glyphInfo := Array new: 5. startIndex to: stopIndex do: [:charIndex | self glyphInfoOf: (aString at: charIndex) into: glyphInfo. form := glyphInfo at: 1. hereX := glyphInfo at: 2. nextX := glyphInfo at: 3. (actualFont := glyphInfo at: 5) == aBitBlt lastFont ifFalse: [actualFont installOn: aBitBlt]. destY := baselineY - (glyphInfo at: 4). aBitBlt sourceForm: form. + aBitBlt destX: destX + form offset x. - aBitBlt destX: destX. aBitBlt destY: destY + form offset y. "Compensate overdraw. See #extraScale:." aBitBlt sourceX: hereX; sourceY: 0. + aBitBlt width: form width. - aBitBlt width: nextX - hereX. aBitBlt height: form height. aBitBlt copyBits. destX := destX + (nextX - hereX) + kernDelta. ]. ^ destX @ destY ! Item was changed: ----- Method: TTCFont>>glyphInfoOf:into: (in category 'displaying') ----- glyphInfoOf: aCharacter into: glyphInfoArray "return the glyph info for aCharacter; if I don't have such a character, try my fallback font" | form | (self hasGlyphOf: aCharacter) ifFalse: [ ^ self fallbackFont glyphInfoOf: aCharacter into: glyphInfoArray. ]. form := self formOf: aCharacter. glyphInfoArray at: 1 put: form; + at: 2 put: 0; "hereX -- relative, unlike StrikeFont" + at: 3 put: form advanceWidth; "nextX -- relative, unlike StrikeFont" - at: 2 put: 0; - at: 3 put: form width; at: 4 put: self ascent "(self ascentOf: aCharacter)"; at: 5 put: self. ^ glyphInfoArray. ! Item was changed: ----- Method: TTCFont>>lineGap (in category 'accessing') ----- lineGap + "Answer the line gap in pixels. Scale from #typographicLineGap to make larger texts more ledigble." - "Answer the line gap from the ttf description. Use #typographicLineGap to make larger tests more ledigble." + ^ lineGap ifNil: [lineGap := (self pixelTypoScale * (ttcDescription typographicLineGap + self extraLineGap)) rounded] + + "Do not use the non-typo values: + ^ (self pixelScale * (ttcDescription lineGap + ttcDescription extraGap) rounded + "! - "^ (self pixelScale * (ttcDescription lineGap + ttcDescription extraGap) rounded" - ^ lineGap ifNil: [lineGap := (self pixelTypoScale * (ttcDescription typographicLineGap + ttcDescription extraGap)) rounded]! Item was changed: + ----- Method: TTCFont>>widthOf: (in category 'measuring') ----- - ----- Method: TTCFont>>widthOf: (in category 'public') ----- widthOf: aCharacter + "Overwritten to use the #advanceWidth and not the #width of the form. See TTGlyphForm" + - "This method cannot use #formOf: because formOf: discriminates the color and causes unnecessary bitmap creation." (self hasGlyphOf: aCharacter) ifFalse: [^ self fallbackFont widthOf: aCharacter]. + ^(self formOf: aCharacter) advanceWidth! - ^(self formOf: aCharacter) width! Item was changed: ----- Method: TTFileDescription>>renderGlyph:height:fgColor:bgColor:depth: (in category 'rendering') ----- renderGlyph: code height: fontHeight fgColor: fgColor bgColor: bgColor depth: depth "Render the glyph with the given code point at the specified pixel height." + self flag: #deprecated. ^ self + renderGlyph: code height: fontHeight extraScale: 1.0 - renderGlyph: code height: fontHeight fgColor: fgColor bgColor: bgColor depth: depth lineGlyph: nil lineGlyphWidth: 0 emphasis: 0! Item was changed: ----- Method: TTFileDescription>>renderGlyph:height:fgColor:bgColor:depth:lineGlyph:lineGlyphWidth:emphasis: (in category 'rendering') ----- + renderGlyph: code height: fontHeight fgColor: fgColor bgColor: bgColor depth: depth lineGlyph: lineGlyphOrNil lineGlyphWidth: lWidth emphasis: emphasis - renderGlyph: code height: fontHeight fgColor: fgColor bgColor: bgColor depth: depth lineGlyph: lineGlyph lineGlyphWidth: lWidth emphasis: emphasis "Render the glyph with the given code point at the specified pixel height. Underline it with lineGlyph." + self flag: #deprecated. + ^ self + renderGlyph: code height: fontHeight extraScale: 1.0 - | form pixelScale offset | - pixelScale := fontHeight asFloat / self fontHeight. - offset := 0 @ ( (((self ascender) - ((self ascender) * self extraScale)) * pixelScale) truncated). - form := (self at: code) - asFormWithScale: pixelScale * self extraScale - ascender: self ascender - descender: self descender fgColor: fgColor bgColor: bgColor depth: depth + lineGlyph: lineGlyphOrNil lineGlyphWidth: lWidth emphasis: emphasis! - replaceColor: false - lineGlyph: lineGlyph lineGlyphWidth: lWidth - emphasis: emphasis. - form offset: offset. - ^ form! Item was changed: ----- Method: TTFontDescription>>renderGlyph:height:fgColor:bgColor:depth: (in category 'rendering') ----- renderGlyph: code height: fontHeight fgColor: fgColor bgColor: bgColor depth: depth "Render the glyph with the given code point at the specified pixel height." + self flag: #deprecated. ^ self + renderGlyph: code height: fontHeight extraScale: 1.0 - renderGlyph: code height: fontHeight fgColor: fgColor bgColor: bgColor depth: depth lineGlyph: nil lineGlyphWidth: 0 emphasis: 0! Item was changed: ----- Method: TTFontDescription>>renderGlyph:height:fgColor:bgColor:depth:lineGlyph:lineGlyphWidth:emphasis: (in category 'rendering') ----- renderGlyph: code height: fontHeight fgColor: fgColor bgColor: bgColor depth: depth lineGlyph: lineGlyphOrNil lineGlyphWidth: lWidth emphasis: emphasis "Render the glyph with the given code point at the specified pixel height. Underline it with lineGlyph." + self flag: #deprecated. + ^ self + renderGlyph: code height: fontHeight extraScale: 1.0 - | form pixelScale offset | - pixelScale := fontHeight asFloat / self fontHeight. - offset := 0 @ ( (((self ascender) - ((self ascender) * self extraScale)) * pixelScale) truncated). - form := (self at: code) - asFormWithScale: pixelScale * self extraScale - ascender: self ascender - descender: self descender fgColor: fgColor bgColor: bgColor depth: depth + lineGlyph: lineGlyphOrNil lineGlyphWidth: lWidth emphasis: emphasis! - replaceColor: false - lineGlyph: lineGlyphOrNil lineGlyphWidth: lWidth - emphasis: emphasis. - form offset: offset. - ^ form! Item was changed: ----- Method: TTGlyph>>asFormWithScale:ascender:descender:fgColor:bgColor:depth:replaceColor:lineGlyph:lineGlyphWidth:emphasis: (in category 'converting') ----- asFormWithScale: scale ascender: ascender descender: descender fgColor: fgColor bgColor: bgColor depth: depth replaceColor: replaceColorFlag lineGlyph: lineGlyph lineGlyphWidth: lWidth emphasis: code + | topBearing bottomBearing pixelBox pixelOutset form canvas newScale renderOffset | + topBearing := bounds bottom - ascender max: 0. + bottomBearing := bounds top - descender min: 0. + renderOffset := leftSideBearing abs @ (ascender+topBearing) negated. + + "Prepare the pixel box" + pixelBox := ((advanceWidth @ (ascender - descender)) * scale) rounded. + pixelOutset := ((leftSideBearing abs @ topBearing "abs" ) * scale) rounded + corner: ((rightSideBearing abs @ bottomBearing abs ) * scale) rounded. + form := TTGlyphForm extent: pixelBox + + pixelOutset left + pixelOutset top + + pixelOutset right + pixelOutset bottom + depth: depth. + form advanceWidth: pixelBox x. + form offset: pixelOutset topLeft negated. + - | form canvas newScale | - form := Form extent: ((advanceWidth @ (ascender - descender)) * scale) rounded depth: depth. form fillColor: bgColor. canvas := form getCanvas asBalloonCanvas. canvas aaLevel: 4. canvas transformBy: (MatrixTransform2x3 withScale: scale asPoint * (1 @ -1)). + canvas transformBy: (MatrixTransform2x3 withOffset: renderOffset). - canvas transformBy: (MatrixTransform2x3 withOffset: 0 @ ascender negated). canvas drawGeneralBezierShape: self contours color: fgColor borderWidth: 0 borderColor: fgColor. ((code bitAnd: 4) ~= 0 or: [(code bitAnd: 16) ~= 0]) ifTrue: [ + newScale := (pixelBox x + 1) asFloat / lineGlyph calculateWidth asFloat. - newScale := (form width + 1) asFloat / lineGlyph calculateWidth asFloat. canvas transformBy: (MatrixTransform2x3 withScale: (newScale / scale)(a)1.0). (code bitAnd: 4) ~= 0 ifTrue: [ canvas drawGeneralBezierShape: lineGlyph contours color: fgColor borderWidth: 0 borderColor: fgColor. ]. + (code bitAnd: 16) ~= 0 ifTrue: [ | renderLineOffset | + renderLineOffset := renderOffset x @ (renderOffset y negated // 2). + canvas transformBy: (MatrixTransform2x3 withOffset: renderLineOffset). - (code bitAnd: 16) ~= 0 ifTrue: [ - canvas transformBy: (MatrixTransform2x3 withOffset: 0@(ascender // 2)). canvas drawGeneralBezierShape: lineGlyph contours color: fgColor borderWidth: 0 borderColor: fgColor. ]. ]. replaceColorFlag ifTrue: [ form replaceColor: bgColor withColor: Color transparent. ]. ^ form! Item was added: + (PackageInfo named: 'TrueType') postscript: '"Moves extra glyph scale and extra line gap from font description (i.e., TTFontDescription) up to font instance (i.e., TTCFont). Restore glyph scale for default fonts. Note that we might want to rename their #familyName(:) in the future to make that clear. Scale factors were chosen to look good on various scale factors at 10.5 pt." + + #( + BitstreamVeraSans 1.059 24 + BitstreamVeraSansMono 1.059 24 + BitstreamVeraSerif 1.11 47 + ) groupsDo: [:name :scale :gap | + (TextStyle named: name) defaultFont + extraGlyphScale: scale; + extraLineGap: gap]. + TTCFont shutDown: true. "Reset glyph caches"'!

3 4

The Trunk: System-mt.1302.mcz
by commits＠source.squeak.org 06 May '22

06 May '22

Marcel Taeumel uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-mt.1302.mcz ==================== Summary ==================== Name: System-mt.1302 Author: mt Time: 5 February 2022, 4:08:47.918491 pm UUID: 947ea0f6-19a2-1147-aefe-55f0b773544b Ancestors: System-mt.1301 Tweaks Accujen point size. Resets recommended #extraScale for our BitstreamVera fonts, optimized for 75% to 150% scale factor. Update all texts to use the recommended #extraGap in each TrueType font. Note that you can adjust #extraScale and #extraGap in each TrueType font family via Help > Font Size Summary or About Squeak > Image Fonts. Also see #chooseExtraScale and #chooseExtraGap. =============== Diff against System-mt.1301 =============== Item was changed: + (PackageInfo named: 'System') postscript: '"Fixes Accujen point sizes." + (TextStyle named: #Accujen) ifNotNil: [:style | + (style fontArray at: 2) pointSize: 9.5. + (style fontArray at: 3) pointSize: 11.0]. - (PackageInfo named: 'System') postscript: '"Add missing sTypo values for our Bitstream Vera fonts." - TTFontDescription allInstancesDo: [:ea | (ea familyName beginsWith: ''Bitstream Vera'') - ifTrue: [ea setTypographicAscender: 1556 descender: -492 lineGap: 410 ]]. + "Reset extraScale for BitstreamVera fonts." + TTCFont allSubInstancesDo: [:ea | | tt | ((tt := ea ttcDescription) familyName beginsWith: ''Bitstream Vera'') ifTrue: [tt instVarNamed: #extraScale put: nil]]. + + "Update #leading in all text styles using the default font''s #lineGap. Also remove all cached glyphs. Supports #extraGap now." - "Update #leading in all text styles using the default font''s #lineGap. Also remove all cached glyphs." AbstractFont allSubInstancesDo: [ :font | font pixelsPerInchChanged ]. TextStyle allInstancesDo: [ :style | style pixelsPerInchChanged ]. + '! - - "Fix default font sizes in existing text styles according to the current UserInterfaceTheme." - UserInterfaceTheme current installSystemFont: TextStyle defaultFont.'!

4 4

← Newer
1
2
3
4
5
6
7
8
...
34
Older →

Jump to page: