Squeak-dev January 2023

squeak-dev@lists.squeakfoundation.org

31 participants
224 discussions

Missing ID in DataStream TypeMap for CompiledBlock
by Stéphane Rollandin 01 Feb '23

01 Feb '23

Hello all, While checking if my code works in 6.0, I noticed that a serialization failed because a CompiledBlock is not filed out with its correct type ID (as in DataStream>>#typeIDFor:). Adding the entry in the TypeMap dictionary fixed the problem (CompiledMethod was present with ID 21, but not CompiledBlock). See the attached method. Stef

2 1

The Inbox: Morphic-ct.2082.mcz
by commits＠source.squeak.org 01 Feb '23

01 Feb '23

Christoph Thiede uploaded a new version of Morphic to project The Inbox: http://source.squeak.org/inbox/Morphic-ct.2082.mcz ==================== Summary ==================== Name: Morphic-ct.2082 Author: ct Time: 28 January 2023, 8:57:55.639628 pm UUID: dfcaa928-8758-5a42-a55b-2d89712a2a86 Ancestors: Morphic-mt.2081 To review: Fixes flickering in multi-column lists by ensuring sufficiently stable computation in #maxWidth. This is likely to have a small but noticable negative impact on the performance for large lists, but I think this is inevitable if we want to avoid flickering. Otherwise, we could only consider computing the layout completely lazily during drawing. For instance, the original bug can be reproduced by loading the SimulationMethodFinder from SimulationStudio, doing Morph new exploreProtocol and scrolling down until methodCommentAsBalloonHelp comes into view. =============== Diff against Morphic-mt.2081 =============== Item was changed: ----- Method: LazyListMorph>>maxWidth (in category 'layout') ----- maxWidth + "Approximate the maximum width of this lazy list. Take all visible items as a sample. + + NOTE that we MUST compute the width for all items in view!! Otherwise, maxWidth might be instable and be increased again during drawing in #item:, causing the receiver to flicker after each #layoutChanged (e.g., from PluggableMultiColumnListMorph>>#updateColumns)." - "Approximate the maximum width of this lazy list. Take first n items as a sample." + | listSize visibleBounds topRow bottomRow | + maxWidth ifNotNil: [^maxWidth]. + - | threshold listSize | - maxWidth ifNotNil:[^maxWidth]. - - threshold := 30. listSize := self getListSize. + visibleBounds := self bounds: self owner bounds from: self owner. + topRow := self rowAtLocation: visibleBounds topLeft. + bottomRow := self rowAtLocation: visibleBounds bottomLeft. + maxWidth := 0. + topRow to: bottomRow do: [:index | - 1 to: (threshold min: listSize) do: [:index | maxWidth := maxWidth max: (self widthToDisplayItem: (self getListItem: index))]. + + ^ maxWidth! - - ^ maxWidth - !

4 5

The Inbox: Tools-jar.1189.mcz
by commits＠source.squeak.org 31 Jan '23

31 Jan '23

A new version of Tools was added to project The Inbox: http://source.squeak.org/inbox/Tools-jar.1189.mcz ==================== Summary ==================== Name: Tools-jar.1189 Author: jar Time: 31 January 2023, 6:13:22.676927 pm UUID: 70af9ca9-39c5-3944-a8dc-84124e321288 Ancestors: Tools-mt.1188 fix a bug when doing stepInto; this fix makes the three methods #stepInto, #stepOver and #stepThrough consistent. Sending an example in a separate message. =============== Diff against Tools-mt.1188 =============== Item was changed: ----- Method: Debugger>>send (in category 'context stack menu') ----- send "Send the selected message in the accessed method, and take control in the method invoked to allow further step or send." + | newContext currentContext | self okToChange ifFalse: [^ self]. self interruptedProcessIsReady ifFalse: [^ self shouldNotStep]. self checkContextSelection. + currentContext := self selectedContext. + self handleLabelUpdatesIn: + [interruptedProcess step: currentContext] + whenExecuting: currentContext. - interruptedProcess step: self selectedContext. interruptedProcess ifNil: [^ self shouldNotStep]. + newContext := interruptedProcess stepToSendOrReturn. + self updateProcess. + self contextStackIndex > 1 + ifTrue: [self resetContext: newContext] + ifFalse: + [newContext == currentContext + ifTrue: [self changed: #contentsSelection. + self updateInspectors] + ifFalse: [self resetContext: newContext]]! - self resetContext: interruptedProcess stepToSendOrReturn.!

2 1

The Trunk: Morphic-mt.2082.mcz
by commits＠source.squeak.org 30 Jan '23

30 Jan '23

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.2082.mcz ==================== Summary ==================== Name: Morphic-mt.2082 Author: mt Time: 30 January 2023, 10:47:12.840518 am UUID: 6d4a75d3-9931-2b42-bb00-b3ec6b5942e2 Ancestors: Morphic-mt.2081 In tree widgets, fixes regression that mouse-clicks on toggle nodes should not update the current selection but only expand/collapse that node. =============== Diff against Morphic-mt.2081 =============== Item was changed: ----- Method: SimpleHierarchicalListMorph>>mouseDown: (in category 'event handling') ----- mouseDown: evt + + | aMorph selectors | - | aMorph selectors | - aMorph := self itemFromPoint: evt position. evt yellowButtonPressed "First check for option (menu) click" ifTrue: [ (PluggableListMorph menuRequestUpdatesSelection and: [model okToChange]) ifTrue: [ aMorph == selectedMorph ifFalse: [self setSelectedMorph: aMorph]]. ^ self yellowButtonActivity: evt shiftPressed]. + + aMorph ifNil: [^ super mouseDown: evt]. + (aMorph notNil and:[aMorph inToggleArea: (aMorph point: evt position from: self)]) + ifTrue: [^ self toggleExpandedState: aMorph event: evt]. - ifTrue:[^self toggleExpandedState: aMorph event: evt]. - aMorph ifNil:[^super mouseDown: evt]. PluggableListMorph highlightPreSelection ifTrue: [ aMorph highlightedForMouseDown: true. self setProperty: #highlightedMorph toValue: aMorph]. + self setProperty: #changeSelectionOnMouseUp toValue: true. + selectors := Array with: #click: with: (self doubleClickEnabled ifTrue: [#doubleClick:] ifFalse: [nil]) with: nil with: (self dragEnabled ifTrue:[#startDrag:] ifFalse:[nil]). evt hand waitForClicksOrDrag: self event: evt selectors: selectors threshold: HandMorph dragThreshold "pixels".! Item was changed: ----- Method: SimpleHierarchicalListMorph>>mouseUp: (in category 'event handling') ----- mouseUp: event | clickedMorph | model okToChange ifFalse: [^ self]. (clickedMorph := self itemFromPoint: event position) ifNil: [^ self]. (self valueOfProperty: #highlightedMorph ifAbsent: []) ifNotNil: [:m | m highlightedForMouseDown: false. self removeProperty: #highlightedMorph]. + (self hasProperty: #changeSelectionOnMouseUp) + ifFalse: [^ self] + ifTrue: [self removeProperty: #changeSelectionOnMouseUp]. + ((autoDeselect isNil or: [autoDeselect]) and: [clickedMorph == selectedMorph]) ifTrue: [self setSelectedMorph: nil] ifFalse: [self setSelectedMorph: clickedMorph]. event hand newKeyboardFocus: self. Cursor normal show.!

2 1

The Inbox: KernelTests-jar.443.mcz
by commits＠source.squeak.org 30 Jan '23

30 Jan '23

A new version of KernelTests was added to project The Inbox: http://source.squeak.org/inbox/KernelTests-jar.443.mcz ==================== Summary ==================== Name: KernelTests-jar.443 Author: jar Time: 30 January 2023, 5:33:22.893677 pm UUID: 4f815d5d-a166-d141-8fca-d9d0d57f0b93 Ancestors: KernelTests-tpr.441 Complement Kernel-jar.1498 =============== Diff against KernelTests-tpr.441 =============== Item was removed: - ----- Method: MutexTest>>expectedFailures (in category 'failures') ----- - expectedFailures - - ^ #(testUnwindMutexBlockedInCritical)! Item was added: + ----- Method: MutexTest>>testMutexAfterCriticalWait2 (in category 'tests') ----- + testMutexAfterCriticalWait2 + "This tests whether a process that has just left the primitiveEnterCriticalSection in Mutex>>critical: + leaves it with the mutex correctly released." + | lock p beenHere | + lock := Mutex new. beenHere := false. + p := [lock critical: [beenHere := true]] newProcess. + p priority: Processor activePriority - 1. + lock critical: "We now own it; p can't enter properly" + [p resume. + "wait until p enters the critical section; it doesn't own the Mutex so is blocked..." + [p suspendingList == lock] whileFalse: [(Delay forMilliseconds: 10) wait]. + self deny: lock isEmpty]. + "p is waiting on lock; on our exiting critical: p is now the notional owner. Terminate before it has a chance to run". + p terminate. + self deny: lock isOwned. + self assert: lock isEmpty. + self deny: beenHere! Item was added: + ----- Method: MutexTest>>testMutexAfterCriticalWaitCf (in category 'tests') ----- + testMutexAfterCriticalWaitCf + "This tests whether a process that has just left the primitiveEnterCriticalSection in Mutex>>critical: + leaves it with the mutex correctly released." + | lock p beenHere | + lock := Mutex new. beenHere := false. + p := [lock critical: [beenHere := true]] newProcess. + p priority: Processor activePriority - 1. + lock critical: "We now own it; p can't enter properly" + [p resume. + "wait until p enters the critical section; it doesn't own the Mutex so is blocked..." + [p suspendingList == lock] whileFalse: [(Delay forMilliseconds: 10) wait]. + self deny: lock isEmpty. + "p is waiting on lock; on our exiting critical: p is now the notional owner. Terminate before it has a chance to run". + p terminate]. + self deny: lock isOwned. + self assert: lock isEmpty. + self deny: beenHere! Item was added: + ----- Method: MutexTest>>testMutexAfterCriticalWaitInEnsure (in category 'tests') ----- + testMutexAfterCriticalWaitInEnsure + "This tests whether a process that has just left the primitiveEnterCriticalSection in Mutex>>critical: + leaves it with the mutex correctly released." + | lock p | + lock := Mutex new. + p := [[] ensure: [lock critical: []]] newProcess. + p priority: Processor activePriority - 1. + lock critical: "We now own it; p can't enter properly" + [p resume. + "wait until p enters the critical section; it doesn't own the Mutex so is blocked..." + [p suspendingList == lock] whileFalse: [(Delay forMilliseconds: 10) wait]. + self deny: lock isEmpty]. + "p is waiting on lock; on our exiting critical: p is now the notional owner. Terminate before it has a chance to run". + p terminate. + self deny: lock isOwned. + self assert: lock isEmpty! Item was added: + ----- Method: MutexTest>>testMutexAfterCriticalWaitInEnsure2 (in category 'tests') ----- + testMutexAfterCriticalWaitInEnsure2 + "This tests whether a process that has just left the primitiveEnterCriticalSection in Mutex>>critical: + leaves it with the mutex correctly released." + | lock p beenHere | + lock := Mutex new. beenHere := false. + p := [[] ensure: [lock critical: [beenHere := true]]] newProcess. + p priority: Processor activePriority - 1. + lock critical: "We now own it; p can't enter properly" + [p resume. + "wait until p enters the critical section; it doesn't own the Mutex so is blocked..." + [p suspendingList == lock] whileFalse: [(Delay forMilliseconds: 10) wait]. + self deny: lock isEmpty]. + "p is waiting on lock; on our exiting critical: p is now the notional owner. Terminate before it has a chance to run". + p terminate. + self deny: lock isOwned. + self assert: lock isEmpty. + self assert: beenHere! Item was added: + ----- Method: MutexTest>>testMutexAfterCriticalWaitInEnsureCf (in category 'tests') ----- + testMutexAfterCriticalWaitInEnsureCf + "This tests whether a process that has just left the primitiveEnterCriticalSection in Mutex>>critical: + leaves it with the mutex correctly released." + | lock p beenHere | + lock := Mutex new. beenHere := false. + p := [[] ensure: [lock critical: [beenHere := true]]] newProcess. + p priority: Processor activePriority - 1. + lock critical: "We now own it; p can't enter properly" + [p resume. + "wait until p enters the critical section; it doesn't own the Mutex so is blocked..." + [p suspendingList == lock] whileFalse: [(Delay forMilliseconds: 10) wait]. + self deny: lock isEmpty. + "p is waiting on lock; on our exiting critical: p is now the notional owner. Terminate before it has a chance to run". + p terminate]. + self deny: lock isOwned. + self assert: lock isEmpty. + self deny: beenHere! Item was added: + ----- Method: MutexTest>>testMutexBlockedInCritical (in category 'tests') ----- + testMutexBlockedInCritical + "This tests whether a process that is inside the primitiveEnterCriticalSection in Mutex>>critical: + leaves it unchanged." + | lock sock proc wait | + lock := Mutex new. + sock := Semaphore new. + proc := [lock critical: [sock wait]] fork. + wait := [lock critical: []] fork. + Processor yield. + self assert: proc suspendingList == sock. + self assert: wait suspendingList == lock. + self deny: lock isEmpty. + self assert: lock isOwned. + wait terminate. + Processor yield. + self assert: wait isTerminated. + self assert: proc suspendingList == sock. + self assert: wait suspendingList == nil. + self assert: lock isEmpty. + self assert: lock isOwned. + proc terminate! Item was added: + ----- Method: MutexTest>>testMutexBlockedInCritical2 (in category 'tests') ----- + testMutexBlockedInCritical2 + "This tests whether a process that is inside the primitiveEnterCriticalSection in Mutex>>critical: + leaves it unchanged." + | lock sock proc wait beenHere beenHereToo | + lock := Mutex new. + sock := Semaphore new. + beenHere := beenHereToo := false. + proc := [lock critical: [sock wait]] fork. + wait := [lock critical: [beenHere := true]. beenHereToo := true] fork. + Processor yield. + self assert: proc suspendingList == sock. + self assert: wait suspendingList == lock. + self deny: lock isEmpty. + self assert: lock isOwned. + wait terminate. + Processor yield. + self assert: wait isTerminated. + self assert: proc suspendingList == sock. + self assert: wait suspendingList == nil. + self assert: lock isEmpty. + self assert: lock isOwned. + self deny: beenHere. + self deny: beenHereToo. + proc terminate! Item was added: + ----- Method: MutexTest>>testMutexBlockedInCriticalInEnsure (in category 'tests') ----- + testMutexBlockedInCriticalInEnsure + "This tests whether a process that is inside the primitiveEnterCriticalSection in Mutex>>critical: + leaves it unchanged." + | lock sock proc wait | + lock := Mutex new. + sock := Semaphore new. + proc := [lock critical: [sock wait]] fork. + wait := [[] ensure: [lock critical: []]] fork. + Processor yield. + self assert: proc suspendingList == sock. + self assert: wait suspendingList == lock. + self deny: lock isEmpty. + self assert: lock isOwned. + wait terminate. + Processor yield. + self assert: wait isTerminated. + self assert: proc suspendingList == sock. + self assert: wait suspendingList == nil. + self assert: lock isEmpty. + self assert: lock isOwned. + proc terminate! Item was added: + ----- Method: MutexTest>>testMutexBlockedInCriticalInEnsure2 (in category 'tests') ----- + testMutexBlockedInCriticalInEnsure2 + "This tests whether a process that is inside the primitiveEnterCriticalSection in Mutex>>critical: + leaves it unchanged." + | lock sock proc wait beenHere beenHereToo | + lock := Mutex new. + sock := Semaphore new. + beenHere := beenHereToo := false. + proc := [lock critical: [sock wait]] fork. + wait := [[] ensure: [lock critical: [beenHere := true]. beenHereToo := true]] fork. + Processor yield. + self assert: proc suspendingList == sock. + self assert: wait suspendingList == lock. + self deny: lock isEmpty. + self assert: lock isOwned. + wait terminate. + Processor yield. + self assert: wait isTerminated. + self assert: proc suspendingList == sock. + self assert: wait suspendingList == nil. + self assert: lock isEmpty. + self assert: lock isOwned. + self deny: beenHere. + self assert: beenHereToo. + proc terminate! Item was added: + ----- Method: MutexTest>>testMutexInCriticalWait2 (in category 'tests') ----- + testMutexInCriticalWait2 + "This tests whether a process that has got past the primitiveEnterCriticalSection in Mutex>>critical: + leaves it unowned." + | lock sock proc beenHere beenHereToo | + lock := Mutex new. + sock := Semaphore new. + beenHere := beenHereToo := false. + proc := [lock critical: [sock wait. beenHere := true]. beenHereToo := true] fork. + Processor yield. + self assert: proc suspendingList == sock. + proc terminate. + self deny: lock isOwned. + self assert: lock isEmpty. + self deny: beenHere. + self deny: beenHereToo! Item was added: + ----- Method: MutexTest>>testMutexInCriticalWaitInEnsure (in category 'tests') ----- + testMutexInCriticalWaitInEnsure + "This tests whether a process that has got past the primitiveEnterCriticalSection in Mutex>>critical: + leaves it unowned." + | lock sock proc | + lock := Mutex new. + sock := Semaphore new. + proc := [[] ensure: [lock critical: [sock wait]]] fork. + Processor yield. + self assert: proc suspendingList == sock. + proc terminate. + self deny: lock isOwned. + self assert: lock isEmpty! Item was added: + ----- Method: MutexTest>>testMutexInCriticalWaitInEnsure2 (in category 'tests') ----- + testMutexInCriticalWaitInEnsure2 + "This tests whether a process that has got past the primitiveEnterCriticalSection in Mutex>>critical: + leaves it unowned." + | lock sock proc beenHere beenHereToo | + lock := Mutex new. + sock := Semaphore new. + beenHere := beenHereToo := false. + proc := [[] ensure: [lock critical: [sock wait. beenHere := true]. beenHereToo := true]] fork. + Processor yield. + self assert: proc suspendingList == sock. + proc terminate. + self deny: lock isOwned. + self assert: lock isEmpty. + self assert: beenHere. + self assert: beenHereToo! Item was removed: - ----- Method: MutexTest>>testUnwindMutexBlockedInCritical (in category 'tests') ----- - testUnwindMutexBlockedInCritical "self run: #testMutexBlockedInCritical" - "This tests whether a mutex that is inside the primitiveEnterCriticalSection in Mutex>>critical: - leaves it unchanged." - | lock sock proc wait | - lock := Mutex new. - sock := Semaphore new. - proc := [lock critical: [sock wait]] fork. - wait := [[] ensure: [lock critical: []]] fork. - Processor yield. - self assert: proc suspendingList == sock. - self assert: wait suspendingList == lock. - self deny: lock isEmpty. - self assert: lock isOwned. - wait terminate. - Processor yield. - self assert: wait isTerminated. - self assert: proc suspendingList == sock. - self assert: wait suspendingList == nil. - self assert: lock isEmpty. - self assert: lock isOwned - ! Item was removed: - ----- Method: ProcessTest>>expectedFailures (in category 'failures') ----- - expectedFailures - - ^ #(testTerminateTerminatingProcess testResumeTerminatingProcess)! Item was changed: ----- Method: ProcessTest>>testResumeTerminatingProcess (in category 'tests') ----- testResumeTerminatingProcess + "An attempt to resume a terminating process in the middle of preparing its suspended context should raise an error; + one possible solution is to nil the suspended context of the terminating process while executing the vulnerable code" + + "Note: another solution could be to run the vulnerable part of the code in #terminate using #valueUnpreemptively; + currently, however, #valueUnpreemptively is affected by the #priority: bug described here: + http://lists.squeakfoundation.org/pipermail/squeak-dev/2021-December/217473…" - "An attempt to resume a terminating process should probably raise an error; - leave this test as an expected failure for the moment." + | terminatee terminator unwound | + unwound := false. + terminatee := [[Processor activeProcess suspend] ensure: [unwound := unwound not]] newProcess. + terminatee priority: Processor activePriority + 1. + terminatee resume. - | terminatee terminator resumed | - terminatee := [semaphore critical:[]. resumed := true] fork. - Processor yield. terminator := [terminatee terminate] newProcess. + terminator priority: Processor activePriority + 1. + self assert: terminatee isSuspended. - self assert: terminatee suspendingList == semaphore. self assert: terminator isSuspended. "run terminator and stop inside #terminate" + [terminator suspendedContext selectorToSendOrSelf == #bottomContext] whileFalse: [terminator step]. + self assert: terminatee suspendedContext isNil. + self deny: unwound. - terminator runUntil: [:ctx | ctx selectorToSendOrSelf = #priority:]. self assert: terminator isSuspended. + "resuming the terminatee process should causes the VM to raise an error while its suspended context is nil" - "resume the terminatee process and and check if the VM raises an error; - an error is expected because terminatee's suspendedContext equals nil" self should: [terminatee resume] raise: Error. + self assert: terminatee suspendedContext isNil. + self deny: unwound. + self assert: terminator isSuspended. + "now let the terminator finish its interrupted termination of the terminatee process" - "now let the terminator finish terminating the terminatee process" terminator resume. - Processor yield. - self assert: resumed isNil. self assert: terminatee isTerminated. + self assert: unwound. self assert: terminator isTerminated! Item was changed: ----- Method: ProcessTest>>testTerminateTerminatingProcess (in category 'tests') ----- testTerminateTerminatingProcess + "An attempt to terminate a terminating process in the middle of preparing its suspended context should do nothing; + one possible solution is to nil the suspended context of the terminating process while executing the vulnerable code." + + "Note: another solution could be to run the vulnerable part of the code in #terminate using #valueUnpreemptively; + currently, however, #valueUnpreemptively is affected by the #priority: bug described here: + http://lists.squeakfoundation.org/pipermail/squeak-dev/2021-December/217473…" - "An attempt to terminate a terminating process should probably raise an error; - leave this test as an expected failure for the moment." + | terminatee terminator unwound | + unwound := false. + terminatee := [[Processor activeProcess suspend] ensure: [unwound := unwound not]] newProcess. + terminatee priority: Processor activePriority + 1. + terminatee resume. - | terminatee terminator resumed | - terminatee := [semaphore critical:[]. resumed := true] fork. - Processor yield. terminator := [terminatee terminate] newProcess. + terminator priority: Processor activePriority + 1. + self assert: terminatee isSuspended. - self assert: terminatee suspendingList == semaphore. self assert: terminator isSuspended. "run terminator and stop inside #terminate" + [terminator suspendedContext selectorToSendOrSelf == #bottomContext] whileFalse: [terminator step]. + self assert: terminatee suspendedContext isNil. + self deny: unwound. - terminator runUntil: [:ctx | ctx selectorToSendOrSelf = #priority:]. self assert: terminator isSuspended. + "terminating the terminatee process again should make no difference while its suspended context is nil" + terminatee terminate. + self assert: terminatee suspendedContext isNil. + self deny: unwound. + self assert: terminator isSuspended. + "now let the terminator finish its interrupted termination of the terminatee process" - "terminate the terminatee process again and let the termination finish; - an error is expected because #terminate detected multiple termination" - self should: [terminatee terminate] raise: Error. - "now let the terminator finish terminating the terminatee process" terminator resume. - Processor yield. - self assert: resumed isNil. self assert: terminatee isTerminated. + self assert: unwound. self assert: terminator isTerminated! Item was added: + ----- Method: ProcessTest>>testTerminateTerminatingProcessBeforeUnwindTo (in category 'tests') ----- + testTerminateTerminatingProcessBeforeUnwindTo + "Terminating a terminatee process after the terminator process restarted the terminatee + process should unwind the terminatee process and let the terminator process terminate." + + | terminator terminatee unwound | + unwound := false. + terminatee := [[Semaphore new wait] ensure: [unwound := true]] fork. + Processor yield. + terminator := [terminatee terminate] newProcess. + self assert: terminatee isBlocked. + self assert: terminator isSuspended. + terminator runUntil: [:ctx | ctx selectorToSendOrSelf = #resume]. + "terminator steps until terminatee's unwind context is set" + terminator suspendedContext nextInstruction. "skip terminatee resume instruction" + terminator resume. "and run until parked at wait" + "terminatee is inside its helper stack, about to call #unwindTo:" + self assert: terminatee isSuspended. + terminatee terminate. + self assert: terminatee isTerminated. + self assert: unwound. + Processor yield. + self assert: terminator isTerminated! Item was removed: - ----- Method: SemaphoreTest>>expectedFailures (in category 'failures') ----- - expectedFailures - - ^ #(testUnwindSemaInCriticalWait)! Item was added: + ----- Method: SemaphoreTest>>testSemaAfterCriticalWait2 (in category 'tests') ----- + testSemaAfterCriticalWait2 + "This tests whether a process that has just left the wait in Semaphore>>critical: + leaves it with signaling the associated semaphore." + | s p beenHere | + s := Semaphore new. beenHere := false. + p := [s critical: [beenHere := true]] forkAt: Processor activePriority-1. + "wait until p entered the critical section" + [p suspendingList == s] whileFalse: [(Delay forMilliseconds: 10) wait]. + "Now that p entered it, signal the semaphore. p now 'owns' the semaphore + but since we are running at higher priority than p it will not get to do + anything." + s signal. + p terminate. + self assert: 1 equals: s excessSignals. + self deny: beenHere! Item was added: + ----- Method: SemaphoreTest>>testSemaAfterCriticalWaitInEnsure (in category 'tests') ----- + testSemaAfterCriticalWaitInEnsure + "This tests whether a process that has just left the wait in Semaphore>>critical: + leaves it with signaling the associated semaphore." + | s p | + s := Semaphore new. + p := [[] ensure: [s critical:[]]] forkAt: Processor activePriority-1. + "wait until p entered the critical section" + [p suspendingList == s] whileFalse: [(Delay forMilliseconds: 10) wait]. + "Now that p entered it, signal the semaphore. p now 'owns' the semaphore + but since we are running at higher priority than p it will not get to do + anything." + s signal. + p terminate. + self assert: 1 equals: s excessSignals! Item was added: + ----- Method: SemaphoreTest>>testSemaAfterCriticalWaitInEnsure2 (in category 'tests') ----- + testSemaAfterCriticalWaitInEnsure2 + "This tests whether a process that has just left the wait in Semaphore>>critical: + leaves it with signaling the associated semaphore." + | s p beenHere | + s := Semaphore new. beenHere := false. + p := [[] ensure: [s critical: [beenHere := true]]] forkAt: Processor activePriority-1. + "wait until p entered the critical section" + [p suspendingList == s] whileFalse: [(Delay forMilliseconds: 10) wait]. + "Now that p entered it, signal the semaphore. p now 'owns' the semaphore + but since we are running at higher priority than p it will not get to do + anything." + s signal. + p terminate. + self assert: 1 equals: s excessSignals. + self assert: beenHere! Item was added: + ----- Method: SemaphoreTest>>testSemaInCriticalWait2 (in category 'tests') ----- + testSemaInCriticalWait2 + "This tests whether a process that has entered the wait in Semaphore>>critical: + leaves it without signaling the associated semaphore." + | s p beenHere | + s := Semaphore new. beenHere := false. + p := [s critical: [beenHere := true]] fork. + Processor yield. + self assert: s equals: p suspendingList. + p terminate. + self assert: 0 equals: s excessSignals. + self deny: beenHere! Item was added: + ----- Method: SemaphoreTest>>testSemaInCriticalWaitInEnsure (in category 'tests') ----- + testSemaInCriticalWaitInEnsure + "This tests whether a process that has entered the wait in Semaphore>>critical: + leaves it without signaling the associated semaphore." + | s p | + s := Semaphore new. + p := [[] ensure: [s critical: []]] fork. + Processor yield. + self assert: s equals: p suspendingList. + p terminate. + self assert: 0 equals: s excessSignals! Item was added: + ----- Method: SemaphoreTest>>testSemaInCriticalWaitInEnsure2 (in category 'tests') ----- + testSemaInCriticalWaitInEnsure2 + "This tests whether a process that has entered the wait in Semaphore>>critical: + leaves it without signaling the associated semaphore." + | s p beenHere | + s := Semaphore new. beenHere := false. + p := [[] ensure: [s critical: [beenHere := true]]] fork. + Processor yield. + self assert: s equals: p suspendingList. + p terminate. + self assert: 0 equals: s excessSignals. + self deny: beenHere! Item was removed: - ----- Method: SemaphoreTest>>testUnwindSemaInCriticalWait (in category 'tests') ----- - testUnwindSemaInCriticalWait "self run: #testSemaInCriticalWait" - "This tests whether a semaphore that has entered the wait in Semaphore>>critical: - leaves it without signaling the associated semaphore." - | s p | - s := Semaphore new. - p := [[] ensure: [s critical:[]]] fork. - Processor yield. - self assert:(p suspendingList == s). - p terminate. - self assert: 0 equals: s excessSignals!

1 0

The Inbox: Kernel-jar.1498.mcz
by commits＠source.squeak.org 30 Jan '23

30 Jan '23

A new version of Kernel was added to project The Inbox: http://source.squeak.org/inbox/Kernel-jar.1498.mcz ==================== Summary ==================== Name: Kernel-jar.1498 Author: jar Time: 30 January 2023, 5:33:16.106677 pm UUID: f76b2d65-c441-1a44-a925-e7c1e0d45cbb Ancestors: Kernel-tpr.1497 fix four currently failing tests; improve unwind's behavior in #critical sections and #terminate resiliency in case of accidental preemption; fix a bug in #unwindAndStop:, add more tests and comments complemented by KernelTests-jar.443 please kindly remove KernelTests-jar.437 and Kernel-jar.1487 from the Inbox. =============== Diff against Kernel-tpr.1497 =============== Item was added: + ----- Method: Context>>unwindAndStop: (in category 'private') ----- + unwindAndStop: aProcess + "I'm a helper method to #terminate; I create and answer + a helper stack for a terminating process to unwind itself from. + Note: push a fake return value to create a proper top context." + + ^(self class contextEnsure: [self unwindTo: nil]) + privSender: [aProcess suspend] asContext; + push: nil + ! Item was changed: ----- Method: Process>>suspendAndReleaseCriticalSection (in category 'private') ----- suspendAndReleaseCriticalSection "Figure out if we are terminating a process that is in the ensure: block of a critical section. If it hasn't made progress but is beyond the wait (which we can tell by the oldList being + one of the runnable lists, i.e. a LinkedList, not a Semaphore or Mutex), then the ensure: - one of the runnable lists, i.e. a LinkedList, not a Semaphore or Mutex, et al), then the ensure: block needs to be run." | oldList selectorJustSent | + "Suspend and unblock the receiver from a condition variable using the suspend primitive #88. - "Suspend and unblock the receiver from a condition variable using suspend primitive #88. It answers the list the receiver was on before the suspension." oldList := self suspendAndUnblock. + suspendedContext ifNotNil: [:context | + (context method pragmaAt: #criticalSection) ifNil: [^self]. + "If still blocked at the condition variable of a critical section, skip the rest of the current context." + (oldList isNil or: [oldList class == LinkedList]) ifFalse: [ + suspendedContext := context pc: context endPC. + ^self]. + "Now we are somewhere beyond the wait/lock primitive, figure out where, and if necessary, + step into the ensure block to allow the unwind block to be run." + selectorJustSent := context selectorJustSentOrSelf. - (oldList isNil or: [oldList class == LinkedList]) ifFalse: [^self]. + "If still haven't made progress beyond the wait then the ensure block has not been activated, + so step into it." + selectorJustSent == #wait ifTrue: [ + suspendedContext := context stepToCallee]. - ((suspendedContext ifNil: [^self]) method pragmaAt: #criticalSection) ifNil: [^self]. - selectorJustSent := suspendedContext selectorJustSentOrSelf. + "If still haven't made progress beyond the lock primitive and the lock primitive just acquired ownership + (indicated by it answering false) then the ensure block has not been activated, so step into it." + (selectorJustSent == #primitiveEnterCriticalSection + or: [selectorJustSent == #primitiveTestAndSetOwnershipOfCriticalSection]) ifTrue: [ + (context stackPtr > 0 and: [context top == false]) ifTrue: [ + suspendedContext := context stepToCallee]]]! - "If still at the wait the ensure: block has not been activated, so signal to restore." - selectorJustSent == #wait ifTrue: - [suspendedContext receiver signal]. - - "If still at the lock primitive and the lock primitive just acquired ownership (indicated by it answering false) - then the ensure block has not been activated, so explicitly primitiveExitCriticalSection to unlock." - (selectorJustSent == #primitiveEnterCriticalSection - or: [selectorJustSent == #primitiveTestAndSetOwnershipOfCriticalSection]) ifTrue: - [(suspendedContext stackPtr > 0 - and: [suspendedContext top == false]) ifTrue: - [suspendedContext receiver primitiveExitCriticalSection]]! Item was changed: ----- Method: Process>>terminate (in category 'changing process state') ----- + terminate + "Stop the process that the receiver represents forever. Allow all pending unwind + blocks to run before terminating; if they are currently in progress, let them finish." - terminate - "Stop the process that the receiver represents forever. - Unwind to execute pending #ensure:/#ifCurtailed: blocks before terminating; - allow all unwind blocks to run; if they are currently in progress, let them finish." + "Note: This is the kind of behavior we expect when terminating a healthy process. - "This is the kind of behavior we expect when terminating a healthy process. See further comments in #terminateAggressively and #destroy methods dealing with process termination when closing the debugger or after a catastrophic failure. If terminating the active process, create a new stack and run unwinds from there. If terminating a suspended process (including runnable and blocked), always + suspend the terminating process first so it doesn't accidentally get woken up, + and nil the suspended context to prevent accidental resumption or termination + while manipulating the suspended context. + - suspend the terminating process first so it doesn't accidentally get woken up. Equally important is the side effect of the suspension: In 2022 a new suspend semantics has been introduced: the revised #suspend backs up a process waiting on a conditional variable to the send that invoked the wait state, while the previous #suspend simply removed the process from the conditional variable's list it was previously waiting on; see #suspend and #suspendAndUnblock comments. + + If the process is blocked, waiting to access the #critical: section, release it properly. - - If the process is in the middle of a #critical: critical section, release it properly. To allow a suspended process to unwind itself, create a new stack for the process being terminated and resume the suspended process to complete its termination + from the new, parallel stack. Use a semaphore to make the process that invoked - from the new parallel stack. Use a semaphore to make the process that invoked the termination wait for self's completion. Execute the termination in the ensure argument block to ensure it completes even if the terminator process itself gets terminated before it's finished; see testTerminateInTerminate and others." - | context | self isActiveProcess ifTrue: [ + ^(thisContext unwindAndStop: self) jump]. - context := thisContext. - ^[[] ensure: [context unwindTo: nil]. self suspend] asContext jump]. + [] ensure: [ - [] ensure: [ | terminator | self suspendAndReleaseCriticalSection. + suspendedContext ifNotNil: [:context | | terminator | + suspendedContext := nil. + terminator := Semaphore new. + context bottomContext insertSender: (Context contextEnsure: [terminator signal]). + self priority: Processor activePriority; + suspendedContext: (context unwindAndStop: self); + resume. + terminator wait]]! - context := suspendedContext ifNil: [^self]. - terminator := Semaphore new. - context bottomContext insertSender: (Context contextEnsure: [terminator signal]). - self suspendedContext: [[] ensure: [context unwindTo: nil]. self suspend] asContext; - priority: Processor activePriority; - resume. - terminator wait]!

1 0

The Trunk: Morphic-mt.2085.mcz
by commits＠source.squeak.org 30 Jan '23

30 Jan '23

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.2085.mcz ==================== Summary ==================== Name: Morphic-mt.2085 Author: mt Time: 30 January 2023, 2:48:44.347867 pm UUID: 97957eba-0eae-4f48-bcbf-094ed735dd4f Ancestors: Morphic-mt.2084 In tree widgets, fix filter indication for that "trailing-tab situation" ... may need another tweak ... those "tab-separated values" can be tricky. Hmm... =============== Diff against Morphic-mt.2084 =============== Item was changed: ----- Method: IndentingListItemMorph>>drawLabelInColumnsOn:in: (in category 'drawing') ----- drawLabelInColumnsOn: aCanvas in: drawBounds "Draw the receiver appearing in multiple columns. Use TAB character to move between columns." | columnScanner columnLeft columnRect columnData updateFilter | self assert: [container columns size > 1]. columnScanner := ReadStream on: contents asString. "Update filter matches" updateFilter := backgroundColor notNil and: [filterOffsets isNil]. filterOffsets ifNil: [filterOffsets := OrderedCollection new]. 1 to: container columns size do: [ :column | | columnWidth | "Compute first/next column offset." column = 1 ifTrue: [columnLeft := drawBounds left] ifFalse: [columnLeft := columnRect right + 5 px]. "Draw icon." column = self class iconColumnIndex ifTrue: [ icon ifNotNil: [ aCanvas translucentImage: icon at: columnLeft @ (self top + (self height - icon height // 2)). columnLeft := columnLeft + icon width + 2 px]]. "Compute drawing bounds for label portion." columnWidth := self widthOfColumn: column. column = 1 ifTrue: [ "Reduce width by indentation present in first column only" columnWidth := columnWidth - (drawBounds left - self left) + self hMargin]. columnRect := columnLeft @ drawBounds top extent: columnWidth @ drawBounds height. columnData := columnScanner upTo: Character tab. "Draw label portion." columnData ifNotEmpty: [ aCanvas drawString: columnData in: columnRect font: self fontToUse color: self colorToUse. updateFilter ifTrue: [ (container shouldFilterColumnIndex: column) ifTrue: [filterOffsets addAll: (self getFilterOffsetsFor: columnData column: column)]] ] ]. "Handle trailing TAB issue in string representation." + columnScanner upToEnd ifNotEmpty: [:rest | | fullColumnData | - columnScanner upToEnd ifNotEmpty: [:rest | columnRect := columnLeft + (self fontToUse widthOfString: columnData) @ drawBounds top extent: columnRect extent. + fullColumnData := columnData, String tab, rest. columnData := String tab, rest. aCanvas drawString: columnData in: columnRect font: self fontToUse color: self colorToUse. updateFilter ifTrue: [ (container shouldFilterColumnIndex: container columns size) + ifTrue: [ + self flag: #todo. "mt: Avoid duplicate filter indication." + filterOffsets addAll: (self getFilterOffsetsFor: fullColumnData column: container columns size)]] ].! - ifTrue: [filterOffsets addAll: (self getFilterOffsetsFor: columnData column: container columns size)]] ].!

1 0

The Trunk: ReleaseBuilder-mt.242.mcz
by commits＠source.squeak.org 30 Jan '23

30 Jan '23

Marcel Taeumel uploaded a new version of ReleaseBuilder to project The Trunk: http://source.squeak.org/trunk/ReleaseBuilder-mt.242.mcz ==================== Summary ==================== Name: ReleaseBuilder-mt.242 Author: mt Time: 30 January 2023, 2:34:53.309867 pm UUID: d36086e1-4ed9-454b-95a2-13407e7a0b8c Ancestors: ReleaseBuilder-mt.241 Complement ToolBuilder-Morphic-mt.333 =============== Diff against ReleaseBuilder-mt.241 =============== Item was changed: ----- Method: ReleaseBuilder class>>setPreferences (in category 'scripts') ----- setPreferences "Preferences class defaultValueTableForCurrentRelease" " Preferences outOfTheBox." "<-- uncomment after #defaultValueTableForCurrentRelease is fixed up." "General User interaction" Preferences enable: #generalizedYellowButtonMenu ; enable: #swapMouseButtons; disable: #mouseOverForKeyboardFocus. Morph indicateKeyboardFocus: true. Project uiManager openToolsAttachedToMouseCursor: false. SearchBar useScratchPad: false. HandMorph sendMouseWheelToKeyboardFocus: false. HandMorph synthesizeMouseWheelEvents: true. "Text input." TextEditor autoEnclose: true ; autoIndent: true ; encloseSelection: true ; destructiveBackWord: false ; blinkingCursor: true ; dumbbellCursor: false. PluggableTextMorph simpleFrameAdornments: false. TextMorphForEditView draggableTextSelection: true. "Windows" SystemWindow reuseWindows: false. SystemWindow windowsRaiseOnClick: true. SystemWindow windowTitleActiveOnFirstClick: true. Model windowActiveOnFirstClick: false. "Not good for little screen real estate." Model useColorfulWindows: false. Preferences disable: #fastDragWindowForMorphic. AbstractResizerMorph gripThickness: 4; handleLength: 16. CornerGripMorph drawCornerResizeHandles: false; drawEdgeResizeHandles: false. ProportionalSplitterMorph showSplitterHandles: false; smartHorizontalSplitters: false; smartVerticalSplitters: false. "Scroll bars." Preferences enable: #scrollBarsNarrow; enable: #scrollBarsOnRight; enable: #alwaysHideHScrollbar; disable: #alwaysShowHScrollbar; disable: #alwaysShowVScrollbar. ScrollBar scrollBarsWithoutArrowButtons: true; scrollBarsWithoutMenuButton: true. ScrollPane useRetractableScrollBars: false. "Rounded corners." Morph preferredCornerRadius: 8. SystemWindow roundedWindowCorners: false. DialogWindow roundedDialogCorners: false. MenuMorph roundedMenuCorners: false. PluggableButtonMorph roundedButtonCorners: false. ScrollBar roundedScrollBarLook: false. "Gradients." SystemWindow gradientWindow: false. DialogWindow gradientDialog: false. MenuMorph gradientMenu: false. PluggableButtonMorph gradientButton: false. ScrollBar gradientScrollBar: false. "Shadows" Preferences enable: #menuAppearance3d. Morph useSoftDropShadow: true. "Lists and Trees" PluggableListMorph filterableLists: true; clearFilterAutomatically: false; clearFilterDelay: 500; highlightHoveredRow: true; highlightPreSelection: false; menuRequestUpdatesSelection: true. - PluggableTreeMorph - filterByLabelsOnly: false. "Standard Tools" TheWorldMainDockingBar showWorldMainDockingBar: true; showSecondsInClock: true; twentyFourHourClock: true. SearchBar useSmartSearch: true. Workspace shouldStyle: false. TranscriptStream forceUpdate: true; redirectToStdOut: false; characterLimit: 20000. Browser listClassesHierarchically: true; showClassIcons: true; showMessageIcons: true; sortMessageCategoriesAlphabetically: true. SystemBrowser browseWithDragNDrop: true. MessageSet useUnifiedMessageLabels: true. Preferences enable: #annotationPanes; defaultAnnotationRequests: #(timeStamp author messageCategory implementorsCount allChangeSets); enable: #optionalButtons; disable: #diffsWithPrettyPrint; enable: #traceMessages; enable: #alternativeBrowseIt; enable: #menuWithIcons; enable: #visualExplorer; disable: #showSharedFlaps; maxBalloonHelpLineLength: 45. Preferences disable: #debugLogTimestamp. "Halo" Preferences enable: #showBoundsInHalo ; disable: #alternateHandlesLook; disable: #showDirectionHandles; enable: #biggerHandles. Morph haloForAll: true; metaMenuForAll: true. "System" NetNameResolver enableIPv6: false. Scanner allowUnderscoreAsAssignment: true; prefAllowUnderscoreSelectors: true. Deprecation showDeprecationWarnings: true "that's all, folks"!

1 0

The Trunk: Morphic-mt.2084.mcz
by commits＠source.squeak.org 30 Jan '23

30 Jan '23

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.2084.mcz ==================== Summary ==================== Name: Morphic-mt.2084 Author: mt Time: 30 January 2023, 2:34:29.833867 pm UUID: 05b36277-e56f-0146-b5b9-218981302f8b Ancestors: Morphic-mt.2083 Complement ToolBuilder-Morphic-mt.333 =============== Diff against Morphic-mt.2083 =============== Item was added: + ----- Method: IndentingListItemMorph class>>filterBackgroundColor (in category 'defaults') ----- + filterBackgroundColor + + ^ FilterBackgroundColor! Item was changed: ----- Method: IndentingListItemMorph>>applyFilter: (in category 'filtering') ----- applyFilter: filter + (container matchesPattern: filter contents: contents) - (self matches: filter in: complexContents) ifTrue: [backgroundColor := FilterBackgroundColor. ^ true] ifFalse: [self hideByFilter. ^ false].! Item was added: + ----- Method: IndentingListItemMorph>>applyFilter:column: (in category 'filtering') ----- + applyFilter: filter column: index + + index ifNil: [^ self applyFilter: filter]. + + (container matchesPattern: filter contents: contents column: index) + ifTrue: [backgroundColor := FilterBackgroundColor. ^ true] + ifFalse: [self hideByFilter. ^ false].! Item was changed: ----- Method: IndentingListItemMorph>>drawLabelInColumnsOn:in: (in category 'drawing') ----- drawLabelInColumnsOn: aCanvas in: drawBounds "Draw the receiver appearing in multiple columns. Use TAB character to move between columns." | columnScanner columnLeft columnRect columnData updateFilter | self assert: [container columns size > 1]. columnScanner := ReadStream on: contents asString. "Update filter matches" updateFilter := backgroundColor notNil and: [filterOffsets isNil]. filterOffsets ifNil: [filterOffsets := OrderedCollection new]. 1 to: container columns size do: [ :column | | columnWidth | "Compute first/next column offset." column = 1 ifTrue: [columnLeft := drawBounds left] ifFalse: [columnLeft := columnRect right + 5 px]. "Draw icon." column = self class iconColumnIndex ifTrue: [ icon ifNotNil: [ aCanvas translucentImage: icon at: columnLeft @ (self top + (self height - icon height // 2)). columnLeft := columnLeft + icon width + 2 px]]. "Compute drawing bounds for label portion." columnWidth := self widthOfColumn: column. column = 1 ifTrue: [ "Reduce width by indentation present in first column only" columnWidth := columnWidth - (drawBounds left - self left) + self hMargin]. columnRect := columnLeft @ drawBounds top extent: columnWidth @ drawBounds height. columnData := columnScanner upTo: Character tab. "Draw label portion." columnData ifNotEmpty: [ aCanvas drawString: columnData in: columnRect font: self fontToUse color: self colorToUse. updateFilter ifTrue: [ + (container shouldFilterColumnIndex: column) - (column = 1 or: [PluggableTreeMorph filterByLabelsOnly not]) ifTrue: [filterOffsets addAll: (self getFilterOffsetsFor: columnData column: column)]] ] ]. "Handle trailing TAB issue in string representation." columnScanner upToEnd ifNotEmpty: [:rest | columnRect := columnLeft + (self fontToUse widthOfString: columnData) @ drawBounds top extent: columnRect extent. columnData := String tab, rest. aCanvas drawString: columnData in: columnRect font: self fontToUse color: self colorToUse. updateFilter ifTrue: [ + (container shouldFilterColumnIndex: container columns size) - "column > 1" PluggableTreeMorph filterByLabelsOnly not ifTrue: [filterOffsets addAll: (self getFilterOffsetsFor: columnData column: container columns size)]] ].! Item was removed: - ----- Method: IndentingListItemMorph>>matches:in: (in category 'filtering') ----- - matches: pattern in: wrapper - ^ ((PluggableTreeMorph filterByLabelsOnly - ifTrue: [ wrapper itemName ] - ifFalse: [ contents ]) - findString: pattern - startingAt: 1 - caseSensitive: false) > 0! Item was added: + ----- Method: SimpleHierarchicalListMorph>>drawBackgroundOn: (in category 'drawing') ----- + drawBackgroundOn: aCanvas ! Item was changed: ----- Method: SimpleHierarchicalListMorph>>drawOn: (in category 'drawing') ----- drawOn: aCanvas super drawOn: aCanvas. + + self drawBackgroundOn: aCanvas. self drawHoverOn: aCanvas. self drawSelectionOn: aCanvas. self drawLinesOn: aCanvas.!

1 0

The Trunk: ToolBuilder-Morphic-mt.333.mcz
by commits＠source.squeak.org 30 Jan '23

30 Jan '23

Marcel Taeumel uploaded a new version of ToolBuilder-Morphic to project The Trunk: http://source.squeak.org/trunk/ToolBuilder-Morphic-mt.333.mcz ==================== Summary ==================== Name: ToolBuilder-Morphic-mt.333 Author: mt Time: 30 January 2023, 2:33:48.497867 pm UUID: 9219e0aa-4436-2c44-8dba-a4d8a5b176e9 Ancestors: ToolBuilder-Morphic-mt.332 In tree widgets, narrow down filter column via [TAB] just like in multi-column list widgets. Also affects tree search via [CMD]+[F] (and [CMD]+[G]). Remove the now obsolete preference #filterByLabelsOnly. You can hit [TAB] for that now. =============== Diff against ToolBuilder-Morphic-mt.332 =============== Item was changed: SimpleHierarchicalListMorph subclass: #PluggableTreeMorph + instanceVariableNames: 'rootWrappers selectedWrapper getRootsSelector getChildrenSelector hasChildrenSelector getLabelSelector getIconSelector getSelectedPathSelector setSelectedPathSelector setSelectedParentSelector getHelpSelector dropItemSelector wantsDropSelector dragItemSelector dragTypeSelector nodeClass lastKeystrokeTime lastKeystrokes dragStartedSelector doubleClickSelector findText findQueue filterColumnIndex' - instanceVariableNames: 'rootWrappers selectedWrapper getRootsSelector getChildrenSelector hasChildrenSelector getLabelSelector getIconSelector getSelectedPathSelector setSelectedPathSelector setSelectedParentSelector getHelpSelector dropItemSelector wantsDropSelector dragItemSelector dragTypeSelector nodeClass lastKeystrokeTime lastKeystrokes dragStartedSelector doubleClickSelector findText findQueue' classVariableNames: 'FilterByLabelsOnly MaximumSearchDepth' poolDictionaries: '' category: 'ToolBuilder-Morphic'! !PluggableTreeMorph commentStamp: 'ar 2/12/2005 04:38' prior: 0! A pluggable tree morph.! Item was removed: - ----- Method: PluggableTreeMorph class>>filterByLabelsOnly (in category 'preferences') ----- - filterByLabelsOnly - <preference: 'Filterable Trees by labels only' - category: 'scrolling' - description: 'When using the Filterable Lists option, set this to only match the labels, not the contents, of hierarchical lists. Otherwise, search both labels and contents will be matched.' - type: #Boolean> - ^ FilterByLabelsOnly ifNil: [ false ]! Item was removed: - ----- Method: PluggableTreeMorph class>>filterByLabelsOnly: (in category 'preferences') ----- - filterByLabelsOnly: aBoolean - FilterByLabelsOnly := aBoolean! Item was added: + ----- Method: PluggableTreeMorph>>drawBackgroundOn: (in category 'drawing') ----- + drawBackgroundOn: aCanvas + "Overwritten to indicate current filter column." + + | leftOffset colWidth | + filterColumnIndex ifNil: [^ self]. + columns ifNil: [^ self]. + + leftOffset := scroller left. + 1 to: filterColumnIndex - 1 do: [:col | + leftOffset := leftOffset + (self widthOfColumn: col)]. + + "For #spaceFill columns, just use the remaining space to the right for the highlight." + colWidth := (self widthOfColumn: filterColumnIndex) ifNil: [scroller right - leftOffset]. + aCanvas + fillRectangle: (leftOffset @ scroller top extent: colWidth @ scroller height) + color: IndentingListItemMorph filterBackgroundColor.! Item was added: + ----- Method: PluggableTreeMorph>>filterColumnIndex (in category 'filtering') ----- + filterColumnIndex! Item was changed: ----- Method: PluggableTreeMorph>>filterTreeNow (in category 'filtering') ----- filterTreeNow | any | self hasFilter ifFalse: [^ self removeFilter]. "Show all current items again before filtering them out." scroller submorphsDo: [:m | m removeFilter]. "Filter the children of the current parent. Do not filter the parent." any := false. self selectedParentMorph ifNil: [self roots do: [:each | + (each applyFilter: lastKeystrokes column: filterColumnIndex) ifTrue: [any := true]]] - (each applyFilter: lastKeystrokes) ifTrue: [any := true]]] ifNotNil: [:pm | pm childrenDo: [:each | + (each applyFilter: lastKeystrokes column: filterColumnIndex) ifTrue: [any := true]]]. - (each applyFilter: lastKeystrokes) ifTrue: [any := true]]]. any ifFalse: [ "Remove the last character and try filtering again." lastKeystrokes := lastKeystrokes allButLast: 1. ^ self filterTreeNow]. self adjustSubmorphPositions! Item was changed: ----- Method: PluggableTreeMorph>>findAgainNow (in category 'searching') ----- findAgainNow | currentPath | (findQueue isNil or: [findQueue isEmpty]) ifTrue: [^ self flash]. self flag: #todo. "mt: Ask model about breadth-first or depth-first, indicate search progress in UI, allow find-again-backwards, ..." Cursor wait showWhile: [ [findQueue notEmpty] whileTrue: [ | currentItem | currentPath := findQueue removeFirst. currentItem := currentPath last. currentItem hasContents ifTrue: [ findQueue addAll: (currentItem contents collect: [:nextItem | currentPath copyWith: nextItem])]. (self matches: findText in: currentItem) ifTrue: [ "Search used model data. View might already be outdated. Collapse parent now to get up-to-date children." self selectedMorph isExpanded ifTrue: [ self toggleExpandedState: self selectedMorph]. "Match!! Stop search for now. Select the match." self selectPath: (currentPath collect: [:ea | ea item]). + self selectedMorph ifNil: [ + ^ self inform: 'Could not find path. View up to date?' translated]. "Revert a side-effect from #selectPath:." self selectedMorph isExpanded ifTrue: [ self toggleExpandedState: self selectedMorph]. "Mimic filter function to highlight (and filter) search results." lastKeystrokes := findText. self filterTree. self scrollSelectionAndExtraIntoView. ^ self]]]. self inform: 'Nothing found.' translated.! Item was added: + ----- Method: PluggableTreeMorph>>highlightNextColumn (in category 'filtering') ----- + highlightNextColumn + + columns ifNil: [^ self]. + columns size = 1 ifTrue: [^ self]. + + filterColumnIndex + ifNil: [filterColumnIndex := 1] + ifNotNil: [:i | filterColumnIndex := filterColumnIndex \\ columns size + 1]. + + self filterTree.! Item was added: + ----- Method: PluggableTreeMorph>>highlightNoColumn (in category 'filtering') ----- + highlightNoColumn + + filterColumnIndex := nil. + self removeFilter.! Item was changed: ----- Method: PluggableTreeMorph>>matches:in: (in category 'searching') ----- matches: pattern in: wrapper + ^ filterColumnIndex + ifNil: [self matchesPattern: pattern contents: wrapper asStringOrText] + ifNotNil: [self matchesPattern: pattern contents: wrapper asStringOrText column: filterColumnIndex]! - ^ ((PluggableTreeMorph filterByLabelsOnly - ifTrue: [ wrapper itemName ] - ifFalse: [ wrapper asStringOrText ]) - findString: findText - startingAt: 1 - caseSensitive: false) > 0! Item was added: + ----- Method: PluggableTreeMorph>>matchesPattern:contents: (in category 'searching') ----- + matchesPattern: pattern contents: contents + + ^ (contents + findString: pattern + startingAt: 1 + caseSensitive: false) > 0! Item was added: + ----- Method: PluggableTreeMorph>>matchesPattern:contents:column: (in category 'searching') ----- + matchesPattern: pattern contents: contents column: index + + | columnScanner data | + "self assert: [columns notNil]." + columnScanner := ReadStream on: contents asString. + + index - 1 timesRepeat: [columnScanner upTo: Character tab]. + data := index = columns size + ifTrue: [columnScanner upToEnd "Fix trailing tab issue"] + ifFalse: [columnScanner upTo: Character tab]. + ^ (data + findString: pattern + startingAt: 1 + caseSensitive: false) > 0! Item was added: + ----- Method: PluggableTreeMorph>>shouldFilterColumnIndex: (in category 'filtering') ----- + shouldFilterColumnIndex: anIndex + + ^ filterColumnIndex isNil or: [filterColumnIndex = anIndex]! Item was changed: ----- Method: PluggableTreeMorph>>specialKeyPressed: (in category 'event handling') ----- specialKeyPressed: asciiValue (super specialKeyPressed: asciiValue) ifTrue: [^ true]. + + asciiValue = Character tab asciiValue ifTrue: [ + self highlightNextColumn. + ^ true]. + - (#(8 13) includes: asciiValue) ifTrue: [ "backspace key" + self highlightNoColumn. "i.e., remove filter" - self removeFilter. ^ true]. ^ false!

1 0

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

Jump to page: