Squeak-dev April 2022

squeak-dev@lists.squeakfoundation.org

29 participants
332 discussions

Faster window drag for Morphic
by Tim Johnson 09 Jun '22

09 Jun '22

Hi, I've been surprised about how SystemWindows become active when dragging other SystemWindows, Inspectors, PluggableXYZ windows (or morphs in general?) on top of (or over) them. It produces a noticable lag in the UI. This is only evident when the preference 'Fast window drag for Morphic' is turned OFF and whole windows are being dragged. (Having Soft shadows enabled slows it down further, I think.) IMHO these windows would not accept the drop, so they should not become active. I did some spying on the UI process and found that all code panes are being redrawn (?) when dragging morphs over SystemWindows. This is easily and quickly defeated/remedied by commenting out 'self activate' in the following method, as follows: SystemWindow>>#mouseEnterDragging: evt "unlock children for drop operations" self flag: #performance. "mt: There may be no need to change appearance if no widget wants the drop." self isActive ifTrue: [self lookFocused]. (self isActive not and: [evt hand hasSubmorphs]) ifTrue: [ "self activate." "unlock contents for drop" evt hand addMouseListener: self. "for drop completion on submorph" ]. My question: could the drag-and-drop "#wantsXYZ" protocol be followed here to optimize this? Or perhaps there is some other way to /not/ make the window active (and thus redraw all its panes, I think?) when a morph /it does not want/ is dragged over it? Thanks Tim

6 14

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

SIGTRAP when Proceeding from BlockCannotReturn
by Lauren Pullen 13 May '22

13 May '22

I found a VM crash while doing my UI testing. platform sources revision VM: 202204190959 runner@Mac-1650369142700.local:work/opensmalltalk-vm/opensmalltalk-vm Date: Tue Apr 19 11:59:48 2022 CommitHash: 2a0e785 Plugins: 202204190959 runner@Mac-1650369142700.local:work/opensmalltalk-vm/opensmalltalk-vm If you make the novice mistake of putting a ^ in a block and evaluating that block after the method returns, a debugger window helpfully appears saying BlockCannotReturn. If you press Proceed the OS will kill Squeak. No crash.dmp file is created for this crash. The debugger does not respect the value of #isResumable (which BlockCannotReturn returns true for, by the way) and always permits the user to resume the operation using the Proceed button. I believe there is a method on Exception that also disregards #isResumable To force an operation to never proceed you must return the Exception after signaling it. Where is the best place to fix this? We can make the debugger respect #isResumable and set BlockCannotReturn to return false. We can also make Context>>cannotReturn:to: never return normally. We can also catch nil in the VM.

7 42

The Inbox: Multilingual-lrnp.283.mcz
by commits＠source.squeak.org 11 May '22

11 May '22

A new version of Multilingual was added to project The Inbox: http://source.squeak.org/inbox/Multilingual-lrnp.283.mcz ==================== Summary ==================== Name: Multilingual-lrnp.283 Author: lrnp Time: 28 April 2022, 9:55:49.009678 pm UUID: 82a0ff0c-f979-4ca4-bec5-2aad22b265bc Ancestors: Multilingual-mt.281 cleanUp clears known environment instances cache Stale instances of LanguageEnvironment may also contain stale instances of TextConverter and must be cleared as well. Fixes an issue where a non-conforming instance of UTF8TextConverter was saved into the trunk image, causing new instances to behave as expected but methods that used Locale to look up a TextConverter to fail. Loading this version will automatically clear the cache. =============== Diff against Multilingual-mt.281 =============== Item was added: + ----- Method: LanguageEnvironment class>>cleanUp (in category 'class initialization') ----- + cleanUp + KnownEnvironments := nil! Item was changed: + (PackageInfo named: 'Multilingual') postscript: 'TextConverter cleanUp: true. "Initialize all uninitialized latin-1 tables... issue #6" + LanguageEnvironment cleanUp.'! - (PackageInfo named: 'Multilingual') postscript: 'TextConverter cleanUp: true. "Initialize all uninitialized latin-1 tables... issue #6"'!

4 11

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 Inbox: Morphic-ct.1958.mcz
by commits＠source.squeak.org 06 May '22

06 May '22

A new version of Morphic was added to project The Inbox: http://source.squeak.org/inbox/Morphic-ct.1958.mcz ==================== Summary ==================== Name: Morphic-ct.1958 Author: ct Time: 1 April 2022, 6:16:24.044058 pm UUID: dbc1bb59-95b0-bf46-9cc5-d6c6a58bc1c4 Ancestors: Morphic-ul.1956 Proposal: Add "select change set..." item to the new changes menu in the docking bar. =============== Diff against Morphic-ul.1956 =============== Item was changed: ----- Method: TheWorldMainDockingBar>>listChangesOn: (in category 'submenu - changes') ----- listChangesOn: menu | fetchChangesBlock | + menu addItem: [:item | item + contents: 'Select change set...' translated; + help: 'Switch to another change set or create a new one' translated; + target: self; + selector: #selectChangeSet; + arguments: #()]. { 'Browse current change set' translated. #browseChangeSet. nil. 'Browse changed methods' translated. #browseChangedMethods. nil. nil. nil. nil. 'Simple Change Sorter' translated. #browseChanges. ChangeSorter. 'Dual Change Sorter' translated. #browseChangesDual. DualChangeSorter. nil. nil. nil. } groupsDo: [:label :selector :modelClass | label ifNil: [menu addLine] ifNotNil: [ menu addItem: [:item | item contents: label; icon: ((modelClass ifNotNil: [self colorIcon: modelClass basicNew windowColorToUse]) ifNil: [MenuIcons blankIcon]); target: self; selector: selector]] ]. fetchChangesBlock := [ | latestMethodChanges latestClassChanges updateBlock | self flag: #concurrency. "mt: Is this safe enough given the current update frequency of change sets and when this code is executed?" latestMethodChanges := (Array streamContents: [:s | ChangeSet current changedMethodsDo: [:method :changeType :dateAndTime :category | s nextPut: { dateAndTime. method. changeType. category }]]) sorted: [:a :b | a first >= b first]. latestClassChanges := (Array streamContents: [:s | ChangeSet current changedClassesDo: [:class :changeTypes :dateAndTime :category | "We are not interested in classes whose method's did only change." changeTypes ifNotEmpty: [s nextPut: { dateAndTime. class. changeTypes. category }]]]) sorted: [:a :b | a first >= b first]. updateBlock := [self listMethodChanges: latestMethodChanges andClassChanges: latestClassChanges on: menu]. Project current uiProcess == Processor activeProcess ifTrue: updateBlock ifFalse: [Project current addDeferredUIMessage: [ menu isInWorld ifTrue: [menu lastItem delete. updateBlock value]] ]]. ChangeSet current numberOfChanges <= 30 ifTrue: fetchChangesBlock ifFalse: [ "We have too much data to process. Do it in the background to keep the UI responsive." menu add: '... fetching changes ...' translated action: nil. menu lastItem isEnabled: false. fetchChangesBlock forkAt: Processor userBackgroundPriority].! Item was added: + ----- Method: TheWorldMainDockingBar>>selectChangeSet (in category 'submenu - changes') ----- + selectChangeSet + + | changeSets choice set | + changeSets := ChangeSet allChangeSetNames reverse. + choice := Project uiManager chooseFromOrAddTo: changeSets lines: #() title: 'Select or add change set...' translated. + choice ifNil: [^ self]. + set := ChangeSet assuredChangeSetNamed: choice. + set ifNotNil: [ChangeSet newChanges: set].!

4 7

The Inbox: Compiler-ct.473.mcz
by commits＠source.squeak.org 06 May '22

06 May '22

A new version of Compiler was added to project The Inbox: http://source.squeak.org/inbox/Compiler-ct.473.mcz ==================== Summary ==================== Name: Compiler-ct.473 Author: ct Time: 1 April 2022, 6:41:06.522422 pm UUID: fa612011-d500-8946-a772-b460d0743c67 Ancestors: Compiler-eem.472 Proposal: Treat non-breaking space (16ra0) as delimiter in parser/scanner. Compiler evaluate: '2 + 3'. =============== Diff against Compiler-eem.472 =============== Item was changed: ----- Method: Scanner class>>initializeTypeTable (in category 'initialization') ----- initializeTypeTable "self initializeTypeTable" | newTable | newTable := Array new: 256 withAll: #xBinary. "default" + newTable atAll: #(9 10 12 13 32 16ra0) put: #xDelimiter. "tab lf ff cr space nbsp" - newTable atAll: #(9 10 12 13 32 ) put: #xDelimiter. "tab lf ff cr space" newTable atAll: ($0 asciiValue to: $9 asciiValue) put: #xDigit. 1 to: 255 do: [:index | (Character value: index) isLetter ifTrue: [newTable at: index put: #xLetter]]. newTable at: $" asciiValue put: #xDoubleQuote. newTable at: $# asciiValue put: #xLitQuote. newTable at: $$ asciiValue put: #xDollar. newTable at: $' asciiValue put: #xSingleQuote. newTable at: $: asciiValue put: #xColon. newTable at: $( asciiValue put: #leftParenthesis. newTable at: $) asciiValue put: #rightParenthesis. newTable at: $. asciiValue put: #period. newTable at: $; asciiValue put: #semicolon. newTable at: $[ asciiValue put: #leftBracket. newTable at: $] asciiValue put: #rightBracket. newTable at: ${ asciiValue put: #leftBrace. newTable at: $} asciiValue put: #rightBrace. newTable at: $^ asciiValue put: #upArrow. newTable at: $_ asciiValue put: #xUnderscore. newTable at: $| asciiValue put: #verticalBar. TypeTable := newTable "bon voyage!!"!

7 7

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
9
...
34
Older →

Jump to page: