Squeak-dev January 2024

squeak-dev@lists.squeakfoundation.org

22 participants
89 discussions

The Inbox: Chronology-Core-jar.90.mcz
by commits＠source.squeak.org 05 Jan '24

05 Jan '24

A new version of Chronology-Core was added to project The Inbox: http://source.squeak.org/inbox/Chronology-Core-jar.90.mcz ==================== Summary ==================== Name: Chronology-Core-jar.90 Author: jar Time: 5 January 2024, 12:03:49.89018 pm UUID: 498e4b92-020c-2442-bb24-ad77536e626f Ancestors: Chronology-Core-mt.88 fix a bug in #valueWithin:onTimeout: see https://github.com/squeak-smalltalk/squeak-object-memory/issues/108 Issue: the method starts a watchdog at high priority before entering the ensure: method. But the active process may terminate before entering the ensure: inside valueWithin:onTimeout:, and thus the cleanup ensure argument block will not be executed during the unwind. As a result the watchod will assume the active process has not completed the watched block and will erroneously signal the TimedOut exception and a failure (BCR exception) inside #signalException will follow. =============== Diff against Chronology-Core-mt.88 =============== Item was changed: ----- Method: BlockClosure>>valueWithin:onTimeout: (in category '*chronology-core') ----- valueWithin: aDuration onTimeout: timeoutBlock "Evaluate the receiver. If the evaluation does not complete in less than aDuration evaluate the timeoutBlock instead" | theProcess delay watchdog tag | aDuration <= Duration zero ifTrue: [^ timeoutBlock value ]. "the block will be executed in the current process" theProcess := Processor activeProcess. delay := aDuration asDelay. tag := self. "make a watchdog process" watchdog := [ delay wait. "wait for timeout or completion" theProcess ifNotNil:[ theProcess signalException: (TimedOut new tag: tag)] ] newProcess. "Watchdog needs to run at high priority to do its job (but not at timing priority)" watchdog priority: Processor timingPriority-1. "catch the timeout signal" + ^ [ [watchdog resume. "start up the watchdog" + self value] ensure:[ "evaluate the receiver" - ^ [ watchdog resume. "start up the watchdog" - self ensure:[ "evaluate the receiver" theProcess := nil. "it has completed, so ..." delay delaySemaphore signal. "arrange for the watchdog to exit" ]] on: TimedOut do: [ :e | e tag == tag ifTrue:[ timeoutBlock value ] ifFalse:[ e pass]].!

1 0

The Inbox: Chronology-Core-jar.89.mcz
by commits＠source.squeak.org 05 Jan '24

05 Jan '24

A new version of Chronology-Core was added to project The Inbox: http://source.squeak.org/inbox/Chronology-Core-jar.89.mcz ==================== Summary ==================== Name: Chronology-Core-jar.89 Author: jar Time: 5 January 2024, 1:35:51.398632 am UUID: d4f4b018-1b84-1c4a-910e-428004aac88c Ancestors: Chronology-Core-mt.88 suggest a patch for Christoph's example in https://github.com/squeak-smalltalk/squeak-object-memory/issues/108 =============== Diff against Chronology-Core-mt.88 =============== Item was changed: ----- Method: BlockClosure>>valueWithin:onTimeout: (in category '*chronology-core') ----- valueWithin: aDuration onTimeout: timeoutBlock "Evaluate the receiver. If the evaluation does not complete in less than aDuration evaluate the timeoutBlock instead" | theProcess delay watchdog tag | aDuration <= Duration zero ifTrue: [^ timeoutBlock value ]. "the block will be executed in the current process" theProcess := Processor activeProcess. delay := aDuration asDelay. tag := self. "make a watchdog process" watchdog := [ delay wait. "wait for timeout or completion" + (theProcess notNil and: [theProcess isTerminated not]) ifTrue: [theProcess signalException: (TimedOut new tag: tag)] - theProcess ifNotNil:[ theProcess signalException: (TimedOut new tag: tag)] ] newProcess. "Watchdog needs to run at high priority to do its job (but not at timing priority)" watchdog priority: Processor timingPriority-1. "catch the timeout signal" ^ [ watchdog resume. "start up the watchdog" self ensure:[ "evaluate the receiver" theProcess := nil. "it has completed, so ..." delay delaySemaphore signal. "arrange for the watchdog to exit" ]] on: TimedOut do: [ :e | e tag == tag ifTrue:[ timeoutBlock value ] ifFalse:[ e pass]].!

1 0

Using the TraceDebugger to debug the Shout parser
by Thiede, Christoph 04 Jan '24

04 Jan '24

Hi all, As promised, I would like to illustrate some of the potential of our recently announced TraceDebugger [1, 2] by describing a few possible use cases. In this post, I will explain how we can use the TraceDebugger to debug a bug in the Shout (syntax highlighting as you type) parser. Let's start with the bug we want to examine: When you type the following expression into a workspace or browser with syntax highlighting enabled, it will be displayed as valid: self griffle; plonk wiffy. However, if we try to evaluate it, we can see that it is actually not valid: self griffle; plonk "Nothing more expected ->"wiffy We can reproduce this bug in Shout with the following do-it: SHParserST80 new source: 'self griffle; plonk wiffy'; parse; ranges. --> an OrderedCollection(a SHRange(#self, 1, 4) a SHRange(#unary, 6, 9) a SHRange(#cascadeSeparator, 10, 10) a SHRange(#unary, 12, 14) a SHRange(#unary, 16, 18)) As we can see, the last token (wiffy) is parsed as a unary range. What we would want to see instead would be #excessCode like in this example: SHParserST80 new source: 'self griffle ^2'; parse; ranges. --> an OrderedCollection(a SHRange(#self, 1, 4) a SHRange(#unary, 6, 12) a SHRange(#excessCode, 13, 15)) So, let's start to debug this bug by selecting the expression and performing a normal debug-it (Cmd + Shift + D). We could now use the regular debugger to step into the different methods of the parser, but this is not without a challenge. For instance, let's assume we have reached SHParserST80>>#parseStatementList, and the next message send is parseStatement: [cid:6a8e7363-2c90-4029-aadf-cd371f9927d6] If we are not sure where the last range is parsed, we might step over this message send. However, this turns out as wrong, and we can see that after that message send, all the five ranges have already been produced: [cid:627ad45a-cb4b-4e8f-aa2b-daaa3e31dc68] Unfortunately, there is no easy way back from here. We might try to restart from this method, but the parser has already changed the value of sourcePosition, so if we just executed this method again, these side-effects would not be undone and we could not reproduce the original behavior again. Alternatively, we could restart the debugger from the original do-it and tediously navigate back to the previous position in this method. This is a general limitation of traditional debuggers: not being able to go back again. In fear of such situations, I often find myself stepping into probably irrelevant messages on spec, just to avoid stepping too far. Obviously, this causes me to lose a lot of time and distract myself with irrelevant implementation details. After all of this introduction, how can the TraceDebugger help us investigate such situations more conveniently and efficiently? To try that out, let's revert our existing debugger to the beginning again. We can do that by selecting the DoIt method and restarting from there, or just by performing a debug-it on the original snippet again: [cid:58cf98eb-b787-405e-ba3f-576565e91ed4] From here, we can now press the new Trace It button at the right to convert the existing debugger into a trace debugger: [cid:a0982d9b-41df-4321-b146-14d3ace15513] We can notice that the trace debugger looks very similar to a normal debugger, but there are three important differences: first, instead of the context stack, it displays us a context tree (which currently looks similar to a stack, but this will change in the next step), and second, there is a new Step Back button (which is disabled right now, but that will change, too). Third, the window title displays the current time index of the execution ("@ 0"). Let's use this trace debugger to perform the same steps we have done in the regular Smalltalk debugger before: [cid:7dbed99b-e1fc-48ae-aa86-09e154aa4475] As we stepped into the different parser methods, we can see that the time index in the window title has advanced ("@ 779", the number of instructions performed so far), and the context tree has grown step by step and displays not only the current stack (the black methods) but also all prior method invocations (in gray) that we have stepped over. Note that I have set up the DoIt method as a border context from its context menu to declutter the tree a little bit. And that tree is not there for decoration only but we can actually use it to explore all these method invocations. For example, we can expand some of the context nodes or hover one of them to see all its arguments and its return value: [cid:c3d4326c-ed82-4257-b512-e877eb4d0488] If we find that method interesting, we can select it to explore its execution again: [cid:0b32434c-9787-464c-8023-2b0fbd049ff5] There are two things to note here: first, the time index in the window title has decreased and has been complemented by the note "[historic]", as we are now watching a method that has been executed in the past. This is also visualized through the background color of the window which has changed to brown. Second, the color of the methods in the tree has changed, and now the stack of SHParserST80>>parseVerticalBarForTemporaries: is displayed as active while SHParserST80>>parseStatementList has turned gray. Despite we are now exploring a historic method execution, we can still use the stepping buttons to navigate through this execution and reenact what messages it has sent. Anyway, the TraceDebugger does not only record past method invocations but also past states. We can see that when we navigate back to SHParserST80>>parseTemporaries and press Restart to rewind this method to its beginning. If we select one of the receiver's or temporary variables at the bottom of the trace debugger, we can see their prior value at this point in time: [cid:2775bf56-258b-48f8-9a9f-bdcec1c34daf] Only if we step after the assignment to our variable, the new value is displayed in this inspector: [cid:df22b70a-2599-4030-8315-7cacc770ee26] So, we can retrace all state changes or side effects in the TraceDebugger. And that's not all! Next to selecting variables in the inspector, we can also send any messages to them, right back into the past: [cid:57d7eeb0-72bf-44f5-bf18-d31d62a351a1] While that's obviously a toy example, it shows that we can execute any code in the historic context of the currently selected time index in the trace debugger, which can be very useful to see earlier printStrings of objects, retrieve information by sending test selectors to them, or add custom inspector fields to ask objects how they would have responded to a certain question in the past. I will expand on that in a later post. However, after all of that playing around, let's come back to our actual question (why is the wiffy token not parsed as an excessCode range?). To do that, we need to go back (or rather forward) to SHParserST80>>parseStatementList again. We can do that by selecting this method in the tree again, but another way is to press Cmd + Shift + D while focusing the context tree to jump to present (you can also find that command, plus a few others, in the context menu of the tree). Note that this also removes the [historic] note in the window title and changes the trace debugger's color back to a vivid red: [cid:917d98ab-e81c-442c-96ad-9618a93d4626] At this point, the ranges array of the parser is still empty, so we can step a bit forward again. After stepping over parseStatement, we have that "Oh no, I've stepped too far" situation from above again as all the ranges have already been produced: [cid:f08879b7-6049-4cd9-b89c-1c23a0d302b3] But this time, this is not a problem, since we have traced everything inside that message send. We can now press the new Step Back button to revert the trace debugger just by one step before the parseStatement again: [cid:0745e751-e393-4316-b2e0-c5d341f79559] And then finally step into it to retrace its behavior: [cid:3e2a83d1-3932-47e5-abc4-e60941110034] So in other words, with the TraceDebugger we can overcome the limitation of unidirectional navigation (i.e., only being able to step forward) from traditional debuggers and navigate multidirectionally instead: forward, backward, or arbitrarily by selecting specific methods in the context tree. In the same fashion, we can continue to descend into the tree by performing something like a hierarchical binary search and stepping over or into message sends as they seem interesting or back as we missed a relevant message send. A bit later, we discover SHParserST80>>parseCascade which first parses the receiver with the first message send, then the semicolon (#cascadeSeparator), and finally the last two tokens as unaries as we step over the second #parseKeyword send: [cid:d014e7a0-7e1e-4507-b6ab-05a5cd6306f6] What can this discovery tell us? #parseKeyword can parse an entire chain of messages which is legal for the first part of the cascade, but illegal after the first semicolon. Thus the shout parser should likely not send the same parsing method for both cases. A possible fix might extract the first #scanPast: sends from #parseUnary and #parseBinary into separate methods so #parseCacade could ask for a single message send after the cascade separator. However, this post is not primarily about a small bug in Shout but about using the TraceDebugger to investigate bugs like it. So to sum up, in this post we have seen how we can invoke a trace debugger, record expressions in it, explore their executions in the context tree, retrace them by navigating using the tree and the forward/stepping buttons in a multidirectional fashion, and inspect and interact with the prior state of objects and temporary variables. This allows us to overcome the limitation of regular debuggers where we can only explore programs in the order of their original execution, but navigate through them with an increased degree of freedom. More broadly, the TraceDebugger provides first-class objects for the execution of programs that can be explored in an unconstrained, declarative fashion. I hope you like it! This is the first time I wrote a detailed tutorial like this on the mailing list, so any feedback is welcome - both regarding the tutorial and the TraceDebugger. :-) Best, Christoph [1] https://github.com/hpi-swa-lab/squeak-tracedebugger [2] https://lists.squeakfoundation.org/archives/list/squeak-dev@lists.squeakfou…

3 2

The Inbox: Morphic-ct.2154.mcz
by commits＠source.squeak.org 03 Jan '24

03 Jan '24

Christoph Thiede uploaded a new version of Morphic to project The Inbox: http://source.squeak.org/inbox/Morphic-ct.2154.mcz ==================== Summary ==================== Name: Morphic-ct.2154 Author: ct Time: 3 January 2024, 10:32:55.304904 pm UUID: e8537454-a78c-614f-99c4-aef07633d14e Ancestors: Morphic-ct.2150 Accelerates SystemWindow>>#setLabel: when the label has not changed. Significantly increased my FPS in a scenario. =============== Diff against Morphic-ct.2150 =============== Item was changed: ----- Method: SystemWindow>>setLabel: (in category 'label') ----- setLabel: aString | frame | (model windowReqNewLabel: aString) ifFalse: [^ self]. + labelString = aString ifTrue: [^ self]. labelString := aString. label ifNil: [^ self]. label contents: (aString ifNil: ['']). self labelWidgetAllowance. "Sets it if not already" self isCollapsed ifTrue: [self extent: (label width + labelWidgetAllowance) @ (self labelHeight + 2)] ifFalse: [label fitContents; setWidth: (label width min: self width - labelWidgetAllowance). label align: label bounds topCenter with: self topCenter + (0@self borderWidth). collapsedFrame ifNotNil: [collapsedFrame := collapsedFrame withWidth: label width + labelWidgetAllowance]]. frame := LayoutFrame new. frame leftFraction: 0.5; topFraction: 0.5; leftOffset: label width negated // 2; topOffset: label height negated // 2. label layoutFrame: frame. !

1 0

The Trunk: Kernel-ct.1549.mcz
by commits＠source.squeak.org 03 Jan '24

03 Jan '24

Christoph Thiede uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-ct.1549.mcz ==================== Summary ==================== Name: Kernel-ct.1549 Author: ct Time: 3 January 2024, 9:58:38.182344 pm UUID: 7d4853d0-2aa0-824d-94c1-37478505a3ed Ancestors: Kernel-ct.1545 Fixes simulation of primitive 84 (primitivePerformWithArgs) and primitive 100 (primitivePerformInSuperclass) when the selector is not a symbol, analogously to Kernel-ct.1489. =============== Diff against Kernel-ct.1545 =============== Item was changed: ----- Method: Context>>doPrimitive:method:receiver:args: (in category 'private') ----- doPrimitive: primitiveIndex method: meth receiver: receiver args: arguments "Simulate a primitive method whose index is primitiveIndex. The simulated receiver and arguments are given as arguments to this message. If successful, push result and return resuming context, else ^ {errCode, PrimitiveFailToken}. Any primitive which provokes execution needs to be intercepted and simulated to avoid execution running away." | value | "Judicious use of primitive 19 (a null primitive that doesn't do anything) prevents the debugger from entering various run-away activities such as spawning a new process, etc. Injudicious use results in the debugger not being able to debug interesting code, such as the debugger itself. Hence use primitive 19 with care :-)" "SystemNavigation new browseAllSelect: [:m| m primitive = 19]" primitiveIndex = 19 ifTrue: [ [self notify: ('The code being simulated is trying to control a process ({1}). Process controlling cannot be simulated. If you proceed, things may happen outside the observable area of the simulator.' translated format: {meth reference})] ifCurtailed: [self push: nil "Cheap fix of the context's internal state"]]. ((primitiveIndex between: 201 and: 222) and: [(self objectClass: receiver) includesBehavior: BlockClosure]) ifTrue: [(primitiveIndex = 206 or: [primitiveIndex = 208]) ifTrue: "[Full]BlockClosure>>valueWithArguments:" [^receiver simulateValueWithArguments: arguments first caller: self]. ((primitiveIndex between: 201 and: 209) "[Full]BlockClosure>>value[:value:...]" or: [primitiveIndex between: 221 and: 222]) ifTrue: "[Full]BlockClosure>>valueNoContextSwitch[:]" [^receiver simulateValueWithArguments: arguments caller: self]]. primitiveIndex = 83 ifTrue: "afr 9/11/1998 19:50" "Object>>perform:[with:...]" [| selector | selector := arguments at: 1 ifAbsent: [^ self class primitiveFailTokenFor: #'bad argument']. (selector isSymbol and: [arguments size - 1 ~= selector numArgs]) ifTrue: [^ self class primitiveFailTokenFor: #'bad number of arguments']. ^self send: selector to: receiver with: arguments allButFirst]. primitiveIndex = 84 ifTrue: "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:" [| selector args | arguments size = 2 ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. selector := arguments first. args := arguments second. args isArray ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. + (selector isSymbol and: [args size ~= selector numArgs]) ifTrue: - args size = selector numArgs ifFalse: [^ self class primitiveFailTokenFor: #'bad number of arguments']. ^self send: selector to: receiver with: args]. primitiveIndex = 100 ifTrue: "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:" [| rcvr selector args superclass | arguments size caseOf: { [3] -> [ rcvr := receiver. selector := arguments first. args := arguments second. superclass := arguments third]. [4] -> ["mirror primitive" rcvr := arguments first. selector := arguments second. args := arguments third. superclass := arguments fourth] } otherwise: [^ self class primitiveFailTokenFor: #'bad number of arguments']. args isArray ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. + (selector isSymbol and: [args size ~= selector numArgs]) ifTrue: - args size = selector numArgs ifFalse: [^ self class primitiveFailTokenFor: #'bad number of arguments']. ((self objectClass: rcvr) includesBehavior: superclass) ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. ^self send: selector to: rcvr with: args lookupIn: superclass]. "Mutex>>primitiveEnterCriticalSection Mutex>>primitiveTestAndSetOwnershipOfCriticalSection" (primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue: [| effective | effective := Processor activeProcess effectiveProcess. "active == effective" value := primitiveIndex = 186 ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: effective] ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective]. ^(self isPrimFailToken: value) ifTrue: [value] ifFalse: [self push: value]]. primitiveIndex = 188 ifTrue: "Object>>withArgs:executeMethod: CompiledMethod class>>receiver:withArguments:executeMethod: VMMirror>>ifFail:object:with:executeMethod: et al" [| n args methodArg thisReceiver | ((n := arguments size) between: 2 and: 4) ifFalse: [^self class primitiveFailTokenFor: #'unsupported operation']. ((self objectClass: (args := arguments at: n - 1)) == Array and: [(self objectClass: (methodArg := arguments at: n)) includesBehavior: CompiledMethod]) ifFalse: [^self class primitiveFailTokenFor: #'bad argument']. methodArg numArgs = args size ifFalse: [^self class primitiveFailTokenFor: #'bad number of arguments']. thisReceiver := arguments at: n - 2 ifAbsent: [receiver]. methodArg primitive > 0 ifTrue: [methodArg isQuick ifTrue: [^self push: (methodArg valueWithReceiver: thisReceiver arguments: args)]. ^self doPrimitive: methodArg primitive method: methodArg receiver: thisReceiver args: args]. ^self activateMethod: methodArg withArgs: args receiver: thisReceiver]. primitiveIndex = 118 ifTrue: "[receiver:]tryPrimitive:withArgs:; avoid recursing in the VM" [(arguments size = 3 and: [(self objectClass: arguments second) == SmallInteger and: [(self objectClass: arguments last) == Array]]) ifTrue: [^self doPrimitive: arguments second method: meth receiver: arguments first args: arguments last]. (arguments size = 2 and: [(self objectClass: arguments first) == SmallInteger and: [(self objectClass: arguments last) == Array]]) ifFalse: [^self class primitiveFailTokenFor: nil]. ^self doPrimitive: arguments first method: meth receiver: receiver args: arguments last]. value := primitiveIndex = 120 "FFI method" ifTrue: [(meth literalAt: 1) tryInvokeWithArguments: arguments] ifFalse: [primitiveIndex = 117 "named primitives" ifTrue: [self tryNamedPrimitiveIn: meth for: receiver withArgs: arguments] ifFalse: "should use self receiver: receiver tryPrimitive: primitiveIndex withArgs: arguments but this is only in later VMs (and appears to be broken)" [receiver tryPrimitive: primitiveIndex withArgs: arguments]]. ^(self isPrimFailToken: value) ifTrue: [value] ifFalse: [self push: value]!

1 0

The Inbox: Morphic-ct.2153.mcz
by commits＠source.squeak.org 03 Jan '24

03 Jan '24

Christoph Thiede uploaded a new version of Morphic to project The Inbox: http://source.squeak.org/inbox/Morphic-ct.2153.mcz ==================== Summary ==================== Name: Morphic-ct.2153 Author: ct Time: 3 January 2024, 8:05:30.254115 pm UUID: a35cf269-72b7-a94e-bf8f-f455c54437d5 Ancestors: Morphic-ct.2150 Fixes issues with absorbed events while running the profiler from the docking bar. See https://github.com/squeak-smalltalk/squeak-object-memory/issues/107. Still, the side effects of Sensor remain unsolved. =============== Diff against Morphic-ct.2150 =============== Item was changed: ----- Method: TheWorldMainDockingBar>>startMessageTally (in category 'menu actions') ----- startMessageTally | world | world := Project current world. (self confirm: 'MessageTally will start now, and stop when the cursor goes to the top of the screen') ifTrue: [MessageTally spyOn: + [[self currentHand position y > 0] whileTrue: [world doOneCycle]]]! - [[Sensor peekPosition y > 0] whileTrue: [world doOneCycle]]]!

1 0

Let's discuss the future of Etoys in Squeak 6.1 (and beyond)
by Marcel Taeumel 02 Jan '24

02 Jan '24

Hi all -- Please find attached a change-set that unloads Etoys from Squeak 6.1alpha #22748 (and later). Let us use this artifact to discuss the future of Etoys in Squeak 6.1 and beyond. You can use Monticello or the ChangeSorter to take a look at what's needed besides unloading the Etoys package itself. Also check preamble and postscript of the attached change-set. !!! Yes, simply re-loading the Etoys package is not enough to restore basic Etoys functionality. There are several sub-method changes needed for the Etoys integration into the base system. Here is what would still work through the package MorphicExtras: - Games - Sketches and PaintBox - Flaps - CalendarMorph - SpectrumAnalyzerMorph Here is what would still "work" through the package System: - Object storage (ImageSegment etc.) - ProjectLoading Here is what would still work through the package Protocols: - Lexicon tool - Vocabulary framework Here is what would be gone: - Tiles, viewers, and scripts - Players and costumes - Pen trails, Turtles, ... - References, CustomEventsRegistry, ScriptingSystem - Siblings for (Player-only) uni-classes - DeepCopier support for (Player-only) uni-classes - Preferences #noviceMode, #eToyFriendly, and more Note that we still have several Etoys-compatible releases such as Etoys 4/5/6 and Squeak 5.1/5.2/5.3/6.0. Best compatibility is probably with Etoys 5. Most updated base system is probably Squeak 6.0. :-) So...should we remove Etoys from Trunk at this point? Please share your thoughts. And feel free to also report issues with loading/using the attached change-set itself. Best, Marcel

14 30

The Inbox: Ocompletion-ct.125.mcz
by commits＠source.squeak.org 02 Jan '24

02 Jan '24

Christoph Thiede uploaded a new version of Ocompletion to project The Inbox: http://source.squeak.org/inbox/Ocompletion-ct.125.mcz ==================== Summary ==================== Name: Ocompletion-ct.125 Author: ct Time: 2 January 2024, 4:41:16.711236 pm UUID: e3a5a612-4b31-ba4f-84bc-05f5731b5452 Ancestors: Ocompletion-ul.124 Fixes unloading of OCompletion. ==================== Snapshot ==================== SystemOrganization addCategory: #Ocompletion! SystemOrganization addCategory: #'Ocompletion-ECModel'! SystemOrganization addCategory: #'Ocompletion-ECSqueak'! SystemOrganization addCategory: #'Ocompletion-ECView'! ----- Method: Symbol>>separateKeywords (in category '*Ocompletion') ----- separateKeywords ^self isKeyword ifFalse: [ self ] ifTrue: [ (self copyReplaceAll: ':' with: ': ') withBlanksTrimmed ] ! BorderedMorph subclass: #ECDetailMorph instanceVariableNames: 'title description arrowPosition label itemHeight' classVariableNames: '' poolDictionaries: '' category: 'Ocompletion-ECView'! !ECDetailMorph commentStamp: '<historical>' prior: 0! I display some detail information for a selected ECEntry in the ECMenuMorph. The content I show, is provided by an ECDetailContentProvider subclass. ! ----- Method: ECDetailMorph class>>height (in category 'as yet unclassified') ----- height ^ ECMenuMorph itemHeight * 15.5! ----- Method: ECDetailMorph class>>width (in category 'as yet unclassified') ----- width ^ ECMenuMorph itemWidth * 2.0! ----- Method: ECDetailMorph>>bounds (in category 'drawing') ----- bounds ^ super bounds topLeft extent: self class width @ self class height! ----- Method: ECDetailMorph>>contentBounds (in category 'drawing') ----- contentBounds | factor rectangle | factor := ECMenuMorph messageHeight. rectangle := self bounds top: self bounds top + 3. rectangle := rectangle left: rectangle left + (factor * 2.0). rectangle := rectangle bottom: rectangle bottom - factor. ^ rectangle! ----- Method: ECDetailMorph>>defaultColor (in category 'drawing') ----- defaultColor ^ ECMenuMorph backgroundColor. ! ----- Method: ECDetailMorph>>descriptionBounds (in category 'accessing') ----- descriptionBounds ^ self contentBounds top: self contentBounds top + ECMenuMorph messageHeight + ECMenuMorph titleHeight ! ----- Method: ECDetailMorph>>drawArrowOn: (in category 'drawing') ----- drawArrowOn: aCanvas | point factor poligon | factor := self itemHeight. point := arrowPosition. poligon := OrderedCollection new. poligon add: point. poligon add: (point := point translateBy: factor / 2 @ 0). poligon add: (point := point translateBy: 0 @ (factor * -0.5)). poligon add: (point := point translateBy: factor @ factor). poligon add: (point := point translateBy: factor * -1 @ factor). poligon add: (point := point translateBy: 0 @ (factor * -0.5)). poligon add: (point := point translateBy: factor * -0.5 @ 0). aCanvas drawPolygon: poligon fillStyle: ECMenuMorph scrollColor! ----- Method: ECDetailMorph>>drawMessageOn: (in category 'drawing') ----- drawMessageOn: aCanvas | rectangle width browseMessage | rectangle := self bounds top: self bounds bottom - ECMenuMorph messageHeight. rectangle := rectangle left: self contentBounds left. aCanvas line: rectangle topLeft to: rectangle topRight - (1@0) color: Color gray. rectangle := rectangle insetBy: 1. aCanvas drawString: '<- close detail' in: rectangle font: ECMenuMorph messageFont color: Color gray. browseMessage := 'browse ->'. width := ECMenuMorph messageFont widthOfString: browseMessage . aCanvas drawString: browseMessage in: (rectangle left: rectangle right - width) font: ECMenuMorph messageFont color: Color gray! ----- Method: ECDetailMorph>>drawOn: (in category 'drawing') ----- drawOn: aCanvas super drawOn: aCanvas. arrowPosition ifNotNil: [ self drawArrowOn: aCanvas. self drawMessageOn: aCanvas]! ----- Method: ECDetailMorph>>entryDescription: (in category 'accessing') ----- entryDescription: anECEntryDescription | categoryContents entryDescription | entryDescription := anECEntryDescription. title contents: (entryDescription title ifNil: [description bounds: self titleBounds. String new] ifNotNil: [description bounds: self descriptionBounds. entryDescription title]). description contentsWrapped: entryDescription description. categoryContents := entryDescription label. label contents: categoryContents! ----- Method: ECDetailMorph>>initialize (in category 'accessing') ----- initialize | childBounds | super initialize. self borderWidth: 1. self borderColor: Color gray. childBounds := self contentBounds. label := StringMorph contents: '' font: ECMenuMorph messageFont. label bounds: childBounds. self addMorph: label. title := StringMorph contents: '' font: ECMenuMorph titleFont. title bounds: self titleBounds. self addMorph: title. description := TextMorph new. description autoFit: false. description bounds: self descriptionBounds. description borderWidth: 0. self addMorph: description! ----- Method: ECDetailMorph>>itemHeight (in category 'accessing') ----- itemHeight ^ itemHeight ifNil: [itemHeight := ECMenuMorph itemHeight]! ----- Method: ECDetailMorph>>position:menuWidth: (in category 'drawing') ----- position: aPoint menuWidth: anInteger | y x | arrowPosition := aPoint. y := aPoint y + self class height. y := y > Display height ifTrue: [Display height - self class height] ifFalse: [aPoint y - self itemHeight]. x := aPoint x. x := x + self class width > Display width ifTrue: [arrowPosition := (self positionOnLeft: anInteger) @ aPoint y. arrowPosition x] ifFalse: [x]. self position: x @ y! ----- Method: ECDetailMorph>>positionOnLeft: (in category 'private') ----- positionOnLeft: anInteger "tightened up the positioning. MAD" ^ arrowPosition x - self class width - anInteger + 2! ----- Method: ECDetailMorph>>titleBounds (in category 'accessing') ----- titleBounds ^ self contentBounds top: self contentBounds top + ECMenuMorph messageHeight! BorderedMorph subclass: #ECMenuMorph instanceVariableNames: 'selected firstVisible titleStringMorph controller context pageHeight itemHeight detailMorph detailPosition' classVariableNames: '' poolDictionaries: '' category: 'Ocompletion-ECView'! ECMenuMorph class instanceVariableNames: 'messageFont titleFont'! !ECMenuMorph commentStamp: '<historical>' prior: 0! I show the possible completions in a menu like appearance. The user may choose an entry from my list and complete the word he was typing in the editor. I'm showed with the Tab key and will be deleted when with ESC key or when a successful completion occurs. The following keystrokes are supported: Ctrl-Space or Tab: Open a new morph. Tab requires at least one character in front of the cursor. When already open complete the selected entry. Esc: Close me Ctrl+u: Change to untyped mode, so I show all selectors of all classes in the system and the variables that are accessible to the current context. Arrow Up: Move one entry up. Arrow Down: Move one entry down Enter: (like Ctrl-Space and Tab): Complete with the selected item and close the morph any letter or digit: Narrow the completion further Ctrl+t: Toggle the expand flag. When expand is disabled, you don't see selectors belonging to Object and ProtoObject. ! ECMenuMorph class instanceVariableNames: 'messageFont titleFont'! ----- Method: ECMenuMorph class>>backgroundColor (in category 'preferences') ----- backgroundColor "ECMenuMorph backgroundColor" ^ Color gray: 0.95! ----- Method: ECMenuMorph class>>borderColor (in category 'preferences') ----- borderColor ^ Color gray! ----- Method: ECMenuMorph class>>controller:position: (in category 'instance creation') ----- controller: aECController position: aPoint | newObject | newObject := self new. newObject setController: aECController position: aPoint. ^ newObject! ----- Method: ECMenuMorph class>>convertToSHSymbol: (in category 'preferences') ----- convertToSHSymbol: aSymbol ^ (SHTextStylerST80 new attributesFor: aSymbol) isNil ifTrue: [#default] ifFalse: [aSymbol] ! ----- Method: ECMenuMorph class>>helpText (in category 'preferences') ----- helpText | text | text := TextStream new. text withAttribute: TextEmphasis bold do: [ text nextPut: 'hello' ] text! ----- Method: ECMenuMorph class>>itemHeight (in category 'preferences') ----- itemHeight "height must be forced to be even to allow the detail arrow to be drawn correctly" ^ (self listFont height + 2) roundUpTo: 2"14".! ----- Method: ECMenuMorph class>>itemWidth (in category 'preferences') ----- itemWidth ^ ECMenuMorph listFont widthOfString:'SphinxOfBlackQuartzHearMyVow1234567890' "212."! ----- Method: ECMenuMorph class>>listFont (in category 'preferences') ----- listFont ^ECPreferences listFont! ----- Method: ECMenuMorph class>>maxLength (in category 'preferences') ----- maxLength "CompletionMorph maxLength " ^30.! ----- Method: ECMenuMorph class>>messageFont (in category 'preferences') ----- messageFont "hard code a strike font for tidiness" ^ StrikeFont familyName: 'Accujen' pointSize: 10 emphasized: 0. ! ----- Method: ECMenuMorph class>>messageHeight (in category 'preferences') ----- messageHeight ^ self messageFont height + 2! ----- Method: ECMenuMorph class>>scrollArrowSize (in category 'preferences') ----- scrollArrowSize ^8! ----- Method: ECMenuMorph class>>scrollColor (in category 'preferences') ----- scrollColor ^ECPreferences menuSelectionColor ! ----- Method: ECMenuMorph class>>selectColorFor: (in category 'preferences') ----- selectColorFor: aSymbol | attribute | attribute := self convertToSHSymbol: aSymbol. ^ (SHTextStylerST80 new attributesFor: attribute) first color! ----- Method: ECMenuMorph class>>selectFontFor: (in category 'preferences') ----- selectFontFor: aSymbol | emphasized attributes | attributes := SHTextStylerST80 new attributesFor: (self convertToSHSymbol: aSymbol). emphasized := attributes size > 1 ifTrue: [attributes second emphasisCode] ifFalse: [0]. ^ self listFont emphasized: emphasized! ----- Method: ECMenuMorph class>>titleFont (in category 'preferences') ----- titleFont "use a strikefont, as TT fonts don't rotate nicely. Don't cache, as it gets manipulated later" ^ StrikeFont familyName: 'Accujen' pointSize: 12 emphasized: 1! ----- Method: ECMenuMorph class>>titleHeight (in category 'preferences') ----- titleHeight ^ self titleFont height + 2! ----- Method: ECMenuMorph>>browse (in category 'actions') ----- browse (self selectedEntry browseWith: context) ifTrue: [controller closeMenu]! ----- Method: ECMenuMorph>>createTitle (in category 'initialization') ----- createTitle | transformationMorph titleString | titleString := context model title. titleString ifNil: [^ self]. transformationMorph := TransformationMorph new. self addMorph: transformationMorph. titleStringMorph := StringMorph new. titleStringMorph font: self class titleFont. transformationMorph addMorph: titleStringMorph. transformationMorph rotationDegrees: -90.0. titleStringMorph contents: titleString. transformationMorph topLeft: (self topLeft + (0@12))! ----- Method: ECMenuMorph>>currentPage (in category 'paging') ----- currentPage ^(self selected - 1 // self pageHeight ) + 1.! ----- Method: ECMenuMorph>>delete (in category 'private') ----- delete super delete. controller menuClosed! ----- Method: ECMenuMorph>>detailMessage (in category 'drawing') ----- detailMessage ^ detailMorph ifNil: [self helpText, ' | -> open detail'] ifNotNil: [self helpText, ' | <- close detail']! ----- Method: ECMenuMorph>>detailPosition: (in category 'accessing') ----- detailPosition: aPoint detailPosition := aPoint. self triggerEvent: #positionChanged! ----- Method: ECMenuMorph>>drawBottomScrollArrowOn: (in category 'drawing') ----- drawBottomScrollArrowOn: aCanvas | aPoligon point arrowHeight | point := self bounds bottomLeft translateBy: 6 @ -12. arrowHeight := self class scrollArrowSize. aPoligon := Array with: point with: (point translateBy: arrowHeight @ 0) with: (point translateBy: (arrowHeight / 2) @ arrowHeight). aCanvas drawPolygon: aPoligon fillStyle: self class scrollColor! ----- Method: ECMenuMorph>>drawMessageOn:in: (in category 'drawing') ----- drawMessageOn: aCanvas in: rectangle self hasMessage ifFalse:[^self]. context model isEmpty ifFalse:[ aCanvas line: rectangle topLeft + (0 @ 1) to: rectangle topRight + (0 @ 1) color: Color gray]. self drawModelMessageOn: aCanvas in:rectangle. self drawPageCountMessageOn: aCanvas in: rectangle.! ----- Method: ECMenuMorph>>drawModelMessageOn:in: (in category 'drawing') ----- drawModelMessageOn: aCanvas in: rectangle | message | message := context model hasMessage ifTrue: [context model message, ' | ', self helpText] ifFalse: [self detailMessage]. aCanvas drawString: message in: (rectangle insetBy: 1) font: self class messageFont color: Color gray! ----- Method: ECMenuMorph>>drawOn: (in category 'drawing') ----- drawOn: aCanvas | rectangle model textColor | super drawOn: aCanvas. self drawTitleOn: aCanvas. rectangle := self bounds copy. rectangle bottom: rectangle top + self itemHeight. rectangle := rectangle left: rectangle left + 20. model := context model. self extent: self extent. self firstVisible > 1 ifTrue: [self drawTopScrollArrowOn: aCanvas]. self lastVisible ~= self itemsCount ifTrue: [self drawBottomScrollArrowOn: aCanvas]. model notEmpty ifTrue: [self firstVisible to: self lastVisible do: [:index | | symbol type string | symbol := model entries at: index. string := symbol contents. type := symbol type. textColor := self selectColor: type. index = self selected ifTrue: [| rect | rect := rectangle withBottom: rectangle top + self class itemHeight. aCanvas fillRectangle: rect color: self class scrollColor. self detailPosition: rect topRight - (1@0). textColor := textColor negated ]. aCanvas drawString: string in: (rectangle insetBy: 1) font: (self selectFont: type) color: textColor. rectangle := self prepareRectForNextRow: rectangle]]. "tweak rectangle to display message" rectangle := rectangle top: (self bounds bottom - self class messageHeight). self drawMessageOn: aCanvas in: rectangle! ----- Method: ECMenuMorph>>drawPageCountMessageOn:in: (in category 'drawing') ----- drawPageCountMessageOn: aCanvas in: rectangle | msg font msgWidth | self pageCount > 1 ifFalse:[^self]. msg := self currentPage printString, '/', self pageCountString. font := self class messageFont. msgWidth := font widthOfString: msg. aCanvas drawString: msg in: (rectangle translateBy: (rectangle width - msgWidth - 3) @ 1) font: font color: Color gray. ! ----- Method: ECMenuMorph>>drawTitleOn: (in category 'drawing') ----- drawTitleOn: aCanvas "| morphicTransform angle | angle := 90 degreesToRadians. morphicTransform := MorphicTransform offset: self position angle: angle scale: 1.0. aCanvas transformBy: morphicTransform clippingTo: self owner innerBounds during: [:myCanvas | myCanvas drawString:'Ruben' at: self position font: self class titleFont color: Color blue] smoothing: 1." ! ----- Method: ECMenuMorph>>drawTopScrollArrowOn: (in category 'drawing') ----- drawTopScrollArrowOn: aCanvas | aPoligon point arrowHeight | arrowHeight := self class scrollArrowSize. point := self bounds topLeft translateBy: 6 @ 11. aPoligon := Array with: point with: (point translateBy: arrowHeight @ 0) with: (point translateBy: arrowHeight / 2 @ arrowHeight negated). aCanvas drawPolygon: aPoligon fillStyle: self class scrollColor. ! ----- Method: ECMenuMorph>>end (in category 'actions') ----- end self gotoPage: self pageCount. self changed.! ----- Method: ECMenuMorph>>expand (in category 'actions') ----- expand context model toggleExpand. self narrowCompletion! ----- Method: ECMenuMorph>>firstVisible (in category 'private') ----- firstVisible ^firstVisible min: context model entryCount! ----- Method: ECMenuMorph>>gotoPage: (in category 'paging') ----- gotoPage: anInteger | item | item := ((anInteger - 1) * self pageHeight) + 1. item >= self itemsCount ifTrue:[^self]. item < 1 ifTrue:[item := 1]. firstVisible := item. self selected: firstVisible. ! ----- Method: ECMenuMorph>>handleMouseEnter: (in category 'event handling') ----- handleMouseEnter: anEvent controller editor ifNotNil: [:editor| self activeHand newKeyboardFocus: editor morph]. anEvent wasHandled: true. ! ----- Method: ECMenuMorph>>hasMessage (in category 'drawing') ----- hasMessage ^ true ! ----- Method: ECMenuMorph>>height (in category 'accessing') ----- height | height | height := self visible ifTrue: [Display height - self bounds topLeft y / self itemHeight - 1 min: self class maxLength] ifFalse: [self class maxLength]. height asInteger isZero ifTrue: [^ 1] ifFalse: [^ height].! ----- Method: ECMenuMorph>>help (in category 'actions') ----- help ECHelpMorph new openInWorld! ----- Method: ECMenuMorph>>helpText (in category 'drawing') ----- helpText ^ '?=help'! ----- Method: ECMenuMorph>>hideDetail (in category 'actions') ----- hideDetail detailMorph ifNil: [ ^ self ]. self removeMorph: detailMorph. detailMorph delete. detailMorph := nil. self changed! ----- Method: ECMenuMorph>>home (in category 'actions') ----- home self gotoPage: 1. self changed! ----- Method: ECMenuMorph>>initialize (in category 'initialization') ----- initialize super initialize. self color: self class backgroundColor. self borderWidth: 1. self borderColor: self class borderColor. self when: #positionChanged send: #updateDetail to: self! ----- Method: ECMenuMorph>>insertCompletion: (in category 'actions') ----- insertCompletion: aString | startIndex oldSelectionInterval editor | editor := controller editor. startIndex := editor startIndex. oldSelectionInterval := startIndex - context completionToken size to: startIndex - 1. editor selectInvisiblyFrom: oldSelectionInterval first to: oldSelectionInterval last. editor replaceSelectionWith: aString. editor selectAt: startIndex + (aString indexOf: Character space ifAbsent: [ aString size ]) - oldSelectionInterval size! ----- Method: ECMenuMorph>>insertSelected (in category 'actions') ----- insertSelected context model isEmpty ifTrue: [^ false]. self insertCompletion: (context model completionAt: self selected). self delete. ^ true! ----- Method: ECMenuMorph>>isClosed (in category 'private') ----- isClosed ^ owner isNil! ----- Method: ECMenuMorph>>itemHeight (in category 'accessing') ----- itemHeight "cached to minimise recalculation" ^ itemHeight ifNil: [itemHeight := self class itemHeight]! ----- Method: ECMenuMorph>>itemsCount (in category 'private') ----- itemsCount ^context model entryCount! ----- Method: ECMenuMorph>>lastVisible (in category 'private') ----- lastVisible ^ (self firstVisible + self height - 1) min: (self itemsCount).! ----- Method: ECMenuMorph>>moveDown (in category 'actions') ----- moveDown self selected: self selected + 1. (self selected > self lastVisible and: [self selected <= self itemsCount]) ifTrue: [firstVisible := firstVisible + 1]. self changed! ----- Method: ECMenuMorph>>moveUp (in category 'actions') ----- moveUp (self selected = 0 and: [self firstVisible = 1]) ifTrue: [^ self]. self selected: self selected - 1. self selected < self firstVisible ifTrue: [firstVisible := firstVisible - 1]. self changed. ! ----- Method: ECMenuMorph>>narrowCompletion (in category 'actions') ----- narrowCompletion | model | self selected: 0. firstVisible := 1. model := context model. model narrowWith: context completionToken. (model entries size = 1 and: [ context completionToken notEmpty ]) ifTrue: [ self insertCompletion: (model completionAt: 1). self delete. ^ false ]. model notEmpty ifTrue: [ self selected: 1 ]. self show. ^ true! ----- Method: ECMenuMorph>>pageCount (in category 'paging') ----- pageCount | count | self itemsCount == self pageHeight ifTrue: [^ 1]. count := self itemsCount // self pageHeight. (self itemsCount \\ self pageHeight) > 0 ifTrue:[count := count + 1]. ^count! ----- Method: ECMenuMorph>>pageCountString (in category 'paging') ----- pageCountString ^ self itemsCount = 501 ifTrue: [ 'more' ] ifFalse: [ self pageCount asString ]! ----- Method: ECMenuMorph>>pageDown (in category 'actions') ----- pageDown self gotoPage: self currentPage + 1. self changed. ! ----- Method: ECMenuMorph>>pageHeight (in category 'paging') ----- pageHeight ^pageHeight.! ----- Method: ECMenuMorph>>pageUp (in category 'actions') ----- pageUp self gotoPage: self currentPage - 1. self changed. ! ----- Method: ECMenuMorph>>prepareRectForNextRow: (in category 'drawing') ----- prepareRectForNextRow: aRectangle ^aRectangle translateBy: 0 @ self itemHeight! ----- Method: ECMenuMorph>>removeTitle (in category 'title') ----- removeTitle titleStringMorph ifNil: [^ self]. self removeMorph: titleStringMorph owner. titleStringMorph := nil! ----- Method: ECMenuMorph>>selectColor: (in category 'drawing') ----- selectColor: type ^ self class selectColorFor: type! ----- Method: ECMenuMorph>>selectFont: (in category 'drawing') ----- selectFont: aSymbol ^ self class selectFontFor: aSymbol! ----- Method: ECMenuMorph>>selected (in category 'accessing') ----- selected "Answer the value of selected" selected ifNil: [ selected := self firstVisible ]. ^ selected! ----- Method: ECMenuMorph>>selected: (in category 'accessing') ----- selected: aNumber "Set the value of selected" context model notEmpty ifTrue: [ ((1 to: self itemsCount) includes: aNumber) ifTrue: [ aNumber ~= selected ifTrue: [ selected := aNumber ] ] ]! ----- Method: ECMenuMorph>>selectedEntry (in category 'accessing') ----- selectedEntry ^ context model entries at: self selected! ----- Method: ECMenuMorph>>setController:position: (in category 'initialization') ----- setController: aECController position: aPoint controller := aECController. context := controller context. self createTitle. self position: aPoint - (20 @ 0). self narrowCompletion ifTrue: [self openInWorld]. ! ----- Method: ECMenuMorph>>show (in category 'drawing') ----- show | extent height | firstVisible := 1. height := self visibleItemsCount * self itemHeight. pageHeight := self height asInteger. self hasMessage ifTrue: [height := height + self class itemHeight]. titleStringMorph ifNotNil: [height := height max: titleStringMorph width + 30]. extent := self class itemWidth @ height. self extent: extent. self changed! ----- Method: ECMenuMorph>>showDetail (in category 'actions') ----- showDetail detailMorph ifNotNil: [ ^ self browse ]. self itemsCount isZero ifTrue: [ ^ self ]. detailMorph := ECDetailMorph new. self addMorph: detailMorph. self updateDetail! ----- Method: ECMenuMorph>>switchToUntyped (in category 'actions') ----- switchToUntyped context switchToUntyped. self removeTitle; narrowCompletion; changed! ----- Method: ECMenuMorph>>updateDetail (in category 'private') ----- updateDetail detailMorph ifNil: [^ self]. detailMorph entryDescription: (self selectedEntry descriptionWith: context). detailMorph position: detailPosition menuWidth: self width. detailMorph show! ----- Method: ECMenuMorph>>visibleItemsCount (in category 'private') ----- visibleItemsCount. ^ self lastVisible - self firstVisible + 1! ECMenuMorph subclass: #OMenuMorph instanceVariableNames: 'lastActivity' classVariableNames: '' poolDictionaries: '' category: 'Ocompletion'! ----- Method: OMenuMorph class>>backgroundColor (in category 'as yet unclassified') ----- backgroundColor "ECMenuMorph backgroundColor" ^ (Color gray: 0.9) alpha: 0.8! ----- Method: OMenuMorph class>>itemWidth (in category 'as yet unclassified') ----- itemWidth ^ ECMenuMorph listFont widthOfString:'SphinxOfBlackQuartzHearMyVow' "212."! ----- Method: OMenuMorph class>>scrollColor (in category 'as yet unclassified') ----- scrollColor ^super scrollColor alpha: 0.8! ----- Method: OMenuMorph class>>selectFontFor: (in category 'as yet unclassified') ----- selectFontFor: aSymbol | emphasized attributes | attributes := SHTextStylerST80 new attributesFor: (self convertToSHSymbol: aSymbol). emphasized := attributes size > 1 ifTrue: [attributes second emphasisCode] ifFalse: [0]. ^ECPreferences menuFont emphasized: emphasized! ----- Method: OMenuMorph>>context (in category 'as yet unclassified') ----- context ^ context! ----- Method: OMenuMorph>>context: (in category 'as yet unclassified') ----- context: ctx context := ctx.! ----- Method: OMenuMorph>>createTitle (in category 'as yet unclassified') ----- createTitle! ----- Method: OMenuMorph>>drawOn: (in category 'as yet unclassified') ----- drawOn: aCanvas | rectangle model textColor | context model isEmpty ifTrue: [^self]. "super drawOn: aCanvas." rectangle := self bounds copy. rectangle bottom: rectangle top + self class itemHeight. rectangle := rectangle left: rectangle left + 20. aCanvas fillRectangle: rectangle fillStyle: self fillStyle borderStyle: self borderStyle. model := context model. self extent: self extent. self firstVisible > 1 ifTrue: [self drawTopScrollArrowOn: aCanvas]. self lastVisible ~= self itemsCount ifTrue: [self drawBottomScrollArrowOn: aCanvas]. model notEmpty ifTrue: [self firstVisible to: self lastVisible do: [:index | | symbol type string | symbol := model entries at: index. string := symbol contents. type := symbol type. textColor := self selectColor: type. index = self selected ifTrue: [| rect | rect := rectangle withBottom: rectangle top + self class itemHeight. aCanvas fillRectangle: rect color: self class scrollColor. self detailPosition: rect topRight. textColor := Color white ]. aCanvas drawString: string in: (rectangle insetBy: 1) font: (self selectFont: type) color: textColor. rectangle := self prepareRectForNextRow: rectangle]]. self drawMessageOn: aCanvas in: rectangle! ----- Method: OMenuMorph>>drawTopScrollArrowOn: (in category 'as yet unclassified') ----- drawTopScrollArrowOn: aCanvas ! ----- Method: OMenuMorph>>hasMessage (in category 'as yet unclassified') ----- hasMessage ^ false! ----- Method: OMenuMorph>>height (in category 'as yet unclassified') ----- height ^ 4! ----- Method: OMenuMorph>>initialize (in category 'as yet unclassified') ----- initialize super initialize. self on: #mouseDown send: #delete to: self. self startStepping! ----- Method: OMenuMorph>>lastActivity (in category 'as yet unclassified') ----- lastActivity lastActivity ifNil: [self stillActive]. ^ lastActivity ! ----- Method: OMenuMorph>>narrowCompletion (in category 'as yet unclassified') ----- narrowCompletion | model | self selected: 0. firstVisible := 1. model := context model. model narrowWith: context completionToken. "(model entries size = 1 and: [context completionToken notEmpty]) ifTrue: [self insertCompletion: (model completionAt: 1). self delete. ^ false]." model notEmpty ifTrue: [self selected: 1]. self show. ^ true! ----- Method: OMenuMorph>>step (in category 'as yet unclassified') ----- step self timeOfLastActivity > self timeout ifTrue: [ self delete ] ifFalse: [self updateColor]! ----- Method: OMenuMorph>>stepTime (in category 'as yet unclassified') ----- stepTime ^ 100! ----- Method: OMenuMorph>>stillActive (in category 'as yet unclassified') ----- stillActive lastActivity := Time millisecondClockValue.! ----- Method: OMenuMorph>>timeOfLastActivity (in category 'as yet unclassified') ----- timeOfLastActivity ^ (Time millisecondClockValue - self lastActivity) ! ----- Method: OMenuMorph>>timeout (in category 'as yet unclassified') ----- timeout ^ 5000! ----- Method: OMenuMorph>>updateColor (in category 'as yet unclassified') ----- updateColor | remaining alpha | remaining := (self timeout - self timeOfLastActivity). remaining < 1000 ifTrue: [ alpha := remaining / 1000.0. self color: (self color alpha: alpha). self borderColor: (self borderColor alpha: alpha) ]! ECMenuMorph subclass: #OXMenuMorph instanceVariableNames: 'lastActivity' classVariableNames: '' poolDictionaries: '' category: 'Ocompletion'! ----- Method: OXMenuMorph class>>scrollColor (in category 'as yet unclassified') ----- scrollColor ^super scrollColor alpha: 0.8! ----- Method: OXMenuMorph class>>selectFontFor: (in category 'as yet unclassified') ----- selectFontFor: aSymbol | emphasized attributes | attributes := SHTextStylerST80 new attributesFor: (self convertToSHSymbol: aSymbol). emphasized := attributes size > 1 ifTrue: [attributes second emphasisCode] ifFalse: [0]. ^ECPreferences menuFont emphasized: emphasized! ----- Method: OXMenuMorph>>context (in category 'as yet unclassified') ----- context ^ context! ----- Method: OXMenuMorph>>context: (in category 'as yet unclassified') ----- context: ctx context := ctx.! ----- Method: OXMenuMorph>>delete (in category 'as yet unclassified') ----- delete super delete. controller retract! ----- Method: OXMenuMorph>>hasMessage (in category 'as yet unclassified') ----- hasMessage ^ false! ----- Method: OXMenuMorph>>height (in category 'as yet unclassified') ----- height ^ 7! ----- Method: OXMenuMorph>>initialize (in category 'as yet unclassified') ----- initialize super initialize. self on: #mouseDown send: #delete to: self. self startStepping ! ----- Method: OXMenuMorph>>insertCompletion: (in category 'as yet unclassified') ----- insertCompletion: aString super insertCompletion: aString. controller retract! ----- Method: OXMenuMorph>>lastActivity (in category 'as yet unclassified') ----- lastActivity lastActivity ifNil: [self stillActive]. ^ lastActivity ! ----- Method: OXMenuMorph>>narrowCompletion (in category 'as yet unclassified') ----- narrowCompletion | model | self selected: 0. firstVisible := 1. model := context model. model narrowWith: context completionToken. model notEmpty ifTrue: [self selected: 1]. model entries size < self selected ifTrue: [self selected: model entries size]. self show. ^ true! ----- Method: OXMenuMorph>>step (in category 'as yet unclassified') ----- step self timeOfLastActivity > self timeout ifTrue: [ self delete ] ifFalse: [self updateColor]! ----- Method: OXMenuMorph>>stepTime (in category 'as yet unclassified') ----- stepTime ^ 100! ----- Method: OXMenuMorph>>stillActive (in category 'as yet unclassified') ----- stillActive lastActivity := Time millisecondClockValue.! ----- Method: OXMenuMorph>>timeOfLastActivity (in category 'as yet unclassified') ----- timeOfLastActivity ^ (Time millisecondClockValue - self lastActivity) ! ----- Method: OXMenuMorph>>timeout (in category 'as yet unclassified') ----- timeout ^ 5000! ----- Method: OXMenuMorph>>updateColor (in category 'as yet unclassified') ----- updateColor | remaining alpha | remaining := (self timeout - self timeOfLastActivity). remaining < 1000 ifTrue: [ alpha := remaining / 1000.0. self color: (self color alpha: alpha). self borderColor: (self borderColor alpha: alpha) ]! ----- Method: StringHolder>>completionController (in category '*Ocompletion') ----- completionController | controller | controller := self dependents detect: [ :each | each isKindOf: ECController ] ifNone: [ "This is just the migration code from the old #actionMap hack." (self triggerEvent: #getCompletionController) ifNotNil: [ :theController | self addDependent: theController ] ]. ^controller ifNil: [ self initializeCompletionController ] ! ----- Method: StringHolder>>createCompletionController (in category '*Ocompletion') ----- createCompletionController ^(ECPreferences useECompletionInsteadOfOCompletion ifFalse: [ OController ] ifTrue: [ ECController ]) model: self ! ----- Method: StringHolder>>guessTypeForName: (in category '*Ocompletion') ----- guessTypeForName: aString ^nil! ----- Method: StringHolder>>initializeCompletionController (in category '*Ocompletion') ----- initializeCompletionController ^self addDependent: self createCompletionController! SystemWindow subclass: #ECHelpMorph instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Ocompletion-ECView'! !ECHelpMorph commentStamp: '<historical>' prior: 0! I am a system window that displays the keybindings of eCompletion. The text is static and generated in the class methods.! ----- Method: ECHelpMorph class>>explanationAttributes (in category 'private') ----- explanationAttributes ^{TextIndent spaceUsed; tabs: 2}! ----- Method: ECHelpMorph class>>helpText (in category 'help-text') ----- helpText | stream | stream := TextStream on: Text new. self section: 'character completion' on: stream. self shortcut: 'works on' text: ' [] {} () <> '''' ""' on: stream. self shortcut: 'usage 1' text: 'enter open character - closing character is entered as well' on: stream. self shortcut: 'usage 2' text: 'select some text, enter a smart character and the selected text get surrounded by the opening and closing character.' on: stream. self section: 'open/close menu' on: stream. self shortcut: 'ctrl-space or tab' text: 'open the completion menu' on: stream. self shortcut: 'ESC' text: 'close menu' on: stream. self shortcut: '?, ctl-h' text: 'open this help' on: stream. self section: 'menu navigation' on: stream. self shortcut: 'Arrows up/down' text: 'move the selection up and down' on: stream. self shortcut: 'Page up/down' text: 'page up and down' on: stream. self shortcut: 'Home/End' text: 'move to first or last page of the menu' on: stream. self section: 'show details and browse' on: stream. self shortcut: 'right arrow (detail closed)' text: 'show details about the selected item. This may be the type of the variable, the source of a method or the implementors of the selector.' on: stream. self shortcut: 'right arrow (detail open)' text: 'open a new browser for the selected item.' on: stream. self shortcut: 'left arrow' text: 'close the details' on: stream. self section: 'changing menu contents' on: stream. self shortcut: 'ctrl-u' text: 'switch to untyped mode in a typed menu' on: stream. self shortcut: 'ctrl-t' text: 'filter out methods of class Object in a typed menu. press again to make the reappear.' on: stream. self shortcut: 'alphanumeric character' text: 'filter the menu to the given input' on: stream. self shortcut: 'backspace' text: 'delete an input character, adjust menu to the new input.' on: stream. self section: 'inserting completion' on: stream. self shortcut: 'ctrl-space or tab' text: 'close the menu and insert selected completion. if there only one item left in the menu this done automaticly.' on: stream. ^ stream contents! ----- Method: ECHelpMorph class>>section:on: (in category 'private') ----- section: aString on: aTextStream aTextStream withAttributes: self sectionAttributes do: [aTextStream nextPutAll: aString]. aTextStream cr! ----- Method: ECHelpMorph class>>sectionAttributes (in category 'private') ----- sectionAttributes ^ {TextEmphasis bold}! ----- Method: ECHelpMorph class>>shortcut:text:on: (in category 'private') ----- shortcut: aString text: secondString on: aTextStream aTextStream withAttributes: self shortcutAttributes do: [aTextStream nextPutAll: aString; cr]. aTextStream withAttributes: self explanationAttributes do: [aTextStream nextPutAll: secondString; cr]. ! ----- Method: ECHelpMorph class>>shortcutAttributes (in category 'private') ----- shortcutAttributes ^ {TextIndent spaceUsed; tabs: 1. TextEmphasis italic }! ----- Method: ECHelpMorph>>contents (in category 'initialize') ----- contents ^self class helpText ! ----- Method: ECHelpMorph>>defaultColor (in category 'initialize') ----- defaultColor ^ ECMenuMorph backgroundColor! ----- Method: ECHelpMorph>>initialize (in category 'initialize') ----- initialize "textMorph _ TextMorph new contents: self class helpText; yourself. self addMorph: textMorph" | text | super initialize. self setLabel: 'eCompletion Keyboard Help'. "self height: ECMenuMorph itemHeight * 60." text := PluggableTextMorph on: self text: #contents accept: nil readSelection: nil menu: nil. self addMorph: text frame: (0 @ 0 corner: 1.0 @ 1.0). text lock.! ----- Method: Behavior>>allSelectorsForCompletionWithout: (in category '*Ocompletion') ----- allSelectorsForCompletionWithout: behaviors | selectors | selectors := IdentitySet new. self withAllSuperclassesDo: [:class | (behaviors includes: class) ifFalse: [selectors addAll: class selectors.]]. ^ selectors asOrderedCollection ! ----- Method: Debugger>>guessTypeForName: (in category '*Ocompletion') ----- guessTypeForName: aString | index object | index := (self selectedContext debuggerMap tempNamesForContext: self selectedContext) indexOf: aString ifAbsent: []. object := index ifNil: [index := self receiver class allInstVarNames indexOf: aString ifAbsent: []. index ifNil: [^ nil]. self receiver instVarAt: index] ifNotNil: [self selectedContext tempAt: index]. ^ object class ! ----- Method: Workspace>>completionAdditionals (in category '*Ocompletion') ----- completionAdditionals bindings ifNil: [ ^#() ]. ^bindings keys asArray replace: [ :each | ECLocalEntry contents: each type: #local ]! ----- Method: Workspace>>createCompletionController (in category '*Ocompletion') ----- createCompletionController ^(ECPreferences useECompletionInsteadOfOCompletion ifFalse: [ OController ] ifTrue: [ ECWorkspaceController ]) model: self ! ----- Method: Workspace>>guessTypeForName: (in category '*Ocompletion') ----- guessTypeForName: aString | binding | bindings ifNotNil: [ binding := bindings at: aString ifAbsent: [ ]. binding ifNotNil: [ ^ binding class ] ]. ^ super guessTypeForName: aString! InstructionClient subclass: #ECVarTypeGuesser instanceVariableNames: 'types receiverClass variableName found currentMethod hasSend contextCount' classVariableNames: '' poolDictionaries: '' category: 'Ocompletion-ECModel'! !ECVarTypeGuesser commentStamp: '<historical>' prior: 0! I'm an InstructionClient that tries to guess the type of a given instance variable name of a class. ! ECVarTypeGuesser subclass: #ECClassVarTypeGuesser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Ocompletion-ECModel'! ----- Method: ECClassVarTypeGuesser>>methodRefs (in category 'as yet unclassified') ----- methodRefs | theClass classVarAssoc | theClass := receiverClass classThatDefinesClassVariable: variableName. classVarAssoc := theClass classPool associationAt: variableName asSymbol. classVarAssoc value ifNil: [ ^ SystemNavigation new allCallsOn: classVarAssoc ] ifNotNil: [ ^ classVarAssoc value class ]! ----- Method: ECClassVarTypeGuesser>>popIntoLiteralVariable: (in category 'as yet unclassified') ----- popIntoLiteralVariable: anAssociation anAssociation key == variableName asSymbol ifTrue: [ found := true ] ifFalse: [ self reset ]! ----- Method: ECClassVarTypeGuesser>>popIntoReceiverVariable: (in category 'as yet unclassified') ----- popIntoReceiverVariable: offset self reset! ----- Method: ECClassVarTypeGuesser>>send:super:numArgs: (in category 'as yet unclassified') ----- send: selector super: supered numArgs: numberArguments ! ECVarTypeGuesser subclass: #ECInstVarTypeGuesser instanceVariableNames: 'varIndex' classVariableNames: '' poolDictionaries: '' category: 'Ocompletion-ECModel'! !ECInstVarTypeGuesser commentStamp: '<historical>' prior: 0! I'm a simple InstructionClient that tries to guess the type of a given instance variable name of a class. ! ----- Method: ECInstVarTypeGuesser>>methodRefs (in category 'as yet unclassified') ----- methodRefs | theClass selectors | theClass := receiverClass classThatDefinesInstanceVariable: variableName. theClass ifNil: [ ^ nil ]. selectors := theClass whichSelectorsStoreInto: variableName. ^ selectors collect: [ :each | MethodReference new setStandardClass: theClass methodSymbol: each ]! ----- Method: ECInstVarTypeGuesser>>popIntoReceiverVariable: (in category 'bytecode decoding') ----- popIntoReceiverVariable: offset varIndex = offset ifTrue: [ found := true ] ifFalse: [ self reset ]! ----- Method: ECInstVarTypeGuesser>>prepare: (in category 'as yet unclassified') ----- prepare: aCompiledMethod | theClass | super prepare: aCompiledMethod. theClass := aCompiledMethod actualClass. varIndex := (theClass allInstVarNames indexOf: variableName) - 1! ----- Method: ECVarTypeGuesser class>>getClassFromTypeSuggestingName: (in category 'as yet unclassified') ----- getClassFromTypeSuggestingName: aString | firstUppercaseLetter className aStream aClass | aStream := WriteStream on: String new. aStream nextPut: aString first asUppercase. aStream nextPutAll: (aString copyFrom: 2 to: aString size). className := aStream contents. aClass := Smalltalk at: className asSymbol ifAbsent: []. (aClass isKindOf: Class) ifTrue: [^ aClass]. firstUppercaseLetter := aString findFirst: [ :each | each isUppercase ]. className := firstUppercaseLetter > 1 ifTrue: [aString copyFrom: firstUppercaseLetter to: aString size] ifFalse: [^ nil]. aClass := Smalltalk at: className asSymbol ifAbsent: []. (aClass isKindOf: Class) ifTrue: [^ aClass]. ^ nil! ----- Method: ECVarTypeGuesser class>>variableName:class: (in category 'as yet unclassified') ----- variableName: aString class: aClass ^self variableName: aString source: nil class: aClass ! ----- Method: ECVarTypeGuesser class>>variableName:source:class: (in category 'as yet unclassified') ----- variableName: aString source: sourceString class: aClass | newInstance | newInstance := self basicNew initialize. newInstance setVariableName: aString source: sourceString class: aClass. ^ newInstance! ----- Method: ECVarTypeGuesser>>blockReturnTop (in category 'bytecode decoding') ----- blockReturnTop contextCount := contextCount - 1! ----- Method: ECVarTypeGuesser>>computeVarType (in category 'bytecode decoding') ----- computeVarType | info tempNames name | types ifEmpty: [ ^ nil ]. info := types first. (hasSend and: [ info isDefinedByMessageSend not ]) ifTrue: [ info type: nil. ^ info ]. info isDefinedByTemporary not ifTrue: [ ^ info ]. tempNames := (receiverClass compilerClass new parse: currentMethod getSourceFromFile asString in: receiverClass notifying: nil) tempNames. name := tempNames at: info temporaryOffset + 1. info type: (self class getClassFromTypeSuggestingName: name). ^ info! ----- Method: ECVarTypeGuesser>>initialize (in category 'instance creation') ----- initialize super initialize. types := OrderedCollection new. hasSend := false. contextCount := 0! ----- Method: ECVarTypeGuesser>>interpretNextInstructionUsing: (in category 'bytecode decoding') ----- interpretNextInstructionUsing: aScanner found := false. aScanner interpretNextInstructionFor: self. ^found ! ----- Method: ECVarTypeGuesser>>methodRefs (in category 'public') ----- methodRefs ^Array new! ----- Method: ECVarTypeGuesser>>perform (in category 'public') ----- perform | minPriorityInfo methodRefs | variableName isEmpty ifTrue: [^ nil]. methodRefs := self methodRefs. methodRefs ifNil: [^ nil]. methodRefs isBehavior ifTrue: [^ methodRefs]. contextCount := 0. minPriorityInfo := nil. methodRefs do: [:each | | infosOfMethod | self prepare: each. infosOfMethod := self typeOfVarIn: each compiledMethod. (infosOfMethod detectMin: #priority) ifNotNil: [ :possibleMinPrioriotyInfo | minPriorityInfo ifNil: [ minPriorityInfo := possibleMinPrioriotyInfo ] ifNotNil: [ minPriorityInfo priority <= possibleMinPrioriotyInfo priority ifFalse: [ minPriorityInfo := possibleMinPrioriotyInfo ] ] ] ]. ^minPriorityInfo ifNotNil: [ minPriorityInfo type ]! ----- Method: ECVarTypeGuesser>>popIntoLiteralVariable: (in category 'bytecode decoding') ----- popIntoLiteralVariable: anAssociation "Remove Top Of Stack And Store Into Literal Variable bytecode." self reset! ----- Method: ECVarTypeGuesser>>popIntoTemporaryVariable: (in category 'bytecode decoding') ----- popIntoTemporaryVariable: offset "Remove Top Of Stack And Store Into Temporary Variable bytecode." self reset ! ----- Method: ECVarTypeGuesser>>prepare: (in category 'bytecode decoding') ----- prepare: aCompiledMethod ! ----- Method: ECVarTypeGuesser>>pushActiveContext (in category 'bytecode decoding') ----- pushActiveContext "Push Active Context On Top Of Its Own Stack bytecode." contextCount := contextCount + 1! ----- Method: ECVarTypeGuesser>>pushConstant: (in category 'bytecode decoding') ----- pushConstant: value "Push Constant, value, on Top Of Stack bytecode." | info | contextCount > 0 ifTrue: [ ^ self ]. value ifNotNil: [ info := ECTypeInfo definedByLiteral: value class. types add: info ]! ----- Method: ECVarTypeGuesser>>pushLiteralVariable: (in category 'bytecode decoding') ----- pushLiteralVariable: anAssociation "Push Contents Of anAssociation On Top Of Stack bytecode." | info | contextCount > 0 ifTrue:[^self]. info := ECTypeInfo definedByMessageSend: anAssociation value. types add: info! ----- Method: ECVarTypeGuesser>>pushTemporaryVariable: (in category 'bytecode decoding') ----- pushTemporaryVariable: offset "Push Contents Of Temporary Variable Whose Index Is the argument, offset, On Top Of Stack bytecode." | info | contextCount > 0 ifTrue:[^self]. info := ECTypeInfo definedByTemporaryVar: offset. types add: info! ----- Method: ECVarTypeGuesser>>reset (in category 'private') ----- reset contextCount > 0 ifTrue:[^self]. types reset. hasSend := false.! ----- Method: ECVarTypeGuesser>>send:super:numArgs: (in category 'bytecode decoding') ----- send: selector super: supered numArgs: numberArguments "Send Message With Selector, selector, bytecode. The argument, supered, indicates whether the receiver of the message is specified with 'super' in the source method. The arguments of the message are found in the top numArguments locations on the stack and the receiver just below them." contextCount > 0 ifTrue:[^self]. hasSend := true! ----- Method: ECVarTypeGuesser>>setVariableName:source:class: (in category 'instance creation') ----- setVariableName: aString source: aSourceString class: aClass variableName := aString. receiverClass := aClass! ----- Method: ECVarTypeGuesser>>typeOfVarIn: (in category 'bytecode decoding') ----- typeOfVarIn: aMethod "Answer whether the receiver references an instance variable." | scanner end type infos | scanner := InstructionStream on: aMethod. end := scanner method endPC. currentMethod := aMethod. infos := OrderedCollection new. [ scanner pc <= end ] whileTrue: [ (self interpretNextInstructionUsing: scanner) ifTrue: [ type := self computeVarType. type ifNotNil: [ infos add: type ] ] ]. ^ infos! ----- Method: SHRange>>asType (in category '*Ocompletion') ----- asType type == #symbol ifTrue: [ ^Symbol ]. type == #character ifTrue: [ ^Character ]. type == #string ifTrue: [ ^String ]. type == #number ifTrue: [ ^Number ]. type == #true ifTrue: [ ^True ]. type == #false ifTrue: [ ^False ]. type == #arrayEnd ifTrue: [ ^Array ]. type == #byteArrayEnd ifTrue: [ ^ByteArray ]. self isBlockEnd ifTrue: [ ^BlockClosure ]. ^nil! ----- Method: SHRange>>includesPosition: (in category '*Ocompletion') ----- includesPosition: anInteger ^start <= anInteger and: [ end >= anInteger ]! ----- Method: SHRange>>isArgument (in category '*Ocompletion') ----- isArgument ^type == #methodArg! ----- Method: SHRange>>isAssignment (in category '*Ocompletion') ----- isAssignment ^type == #assignment or: [ type == #ansiAssignment ]! ----- Method: SHRange>>isBinary (in category '*Ocompletion') ----- isBinary ^type == #binary! ----- Method: SHRange>>isBlockEnd (in category '*Ocompletion') ----- isBlockEnd ^ type beginsWith: 'blockEnd'! ----- Method: SHRange>>isBlockStart (in category '*Ocompletion') ----- isBlockStart ^type beginsWith: 'blockStart'! ----- Method: SHRange>>isBlockTemporary (in category '*Ocompletion') ----- isBlockTemporary ^type == #blockPatternTempVar or: [ type == #blockPatternArg ]! ----- Method: SHRange>>isClassVariable (in category '*Ocompletion') ----- isClassVariable ^type == #classVar! ----- Method: SHRange>>isComment (in category '*Ocompletion') ----- isComment ^ type == #comment! ----- Method: SHRange>>isConstant (in category '*Ocompletion') ----- isConstant ^self asType notNil! ----- Method: SHRange>>isGlobal (in category '*Ocompletion') ----- isGlobal ^type == #globalVar! ----- Method: SHRange>>isInstanceVariable (in category '*Ocompletion') ----- isInstanceVariable ^type == #instVar! ----- Method: SHRange>>isKeyword (in category '*Ocompletion') ----- isKeyword ^ type == #keyword or:[type == #undefinedKeyword]! ----- Method: SHRange>>isOpening (in category '*Ocompletion') ----- isOpening ^(type beginsWith: 'blockStart') or: [ type beginsWith: 'leftParenthesis' ] ! ----- Method: SHRange>>isSelf (in category '*Ocompletion') ----- isSelf ^type == #self! ----- Method: SHRange>>isSeparator (in category '*Ocompletion') ----- isSeparator ^#(#methodTempBar #statementSeparator #patternUnary #patternArg #blockPatternArg #blockArgsBar #return #primitiveOrExternalCallEnd) identityIncludes: type! ----- Method: SHRange>>isSuper (in category '*Ocompletion') ----- isSuper ^type == #super! ----- Method: SHRange>>isTemporaryVariable (in category '*Ocompletion') ----- isTemporaryVariable ^#(#tempVar #blockTempVar workspaceVar ) identityIncludes: type! ----- Method: SHRange>>isUnfinished (in category '*Ocompletion') ----- isUnfinished ^#(#unfinishedString #unfinishedComment ) identityIncludes: type! ----- Method: SHRange>>isVariable (in category '*Ocompletion') ----- isVariable ^ self isTemporaryVariable or: [self isInstanceVariable or: [self isSelf or:[self isSuper]]]! ----- Method: SHRange>>isVariablesOnly (in category '*Ocompletion') ----- isVariablesOnly ^ self isAssignment or: [self isVariable or: [self isConstant or: [self isSeparator or:[self isBinary]]]]! ----- Method: String>>beginsWithEmpty:caseSensitive: (in category '*Ocompletion') ----- beginsWithEmpty: prefix caseSensitive: aBoolean "Answer whether the receiver begins with the given prefix string. The comparison is case-sensitive." ^(self indexOfSubStringWithEmpty: prefix caseSensitive: aBoolean) = 1! ----- Method: String>>indexOfSubStringWithEmpty:caseSensitive: (in category '*Ocompletion') ----- indexOfSubStringWithEmpty: subString caseSensitive: caseSensitive "Answer the index of the given subString in the receiver. Return 0 if the subString is not found." subString isEmpty ifTrue: [ ^1 ]. self size < subString size ifTrue: [ ^0 ]. ^self findString: subString startingAt: 1 caseSensitive: caseSensitive! ----- Method: String>>wordBefore: (in category '*Ocompletion') ----- wordBefore: anIndex | sep tok | tok := false. sep := anIndex. [ sep > 0 and: [ (self at: sep) tokenish ] ] whileTrue: [ tok := true. sep := sep - 1 ]. ^ tok ifTrue: [ self copyFrom: sep + 1 to: anIndex ] ifFalse: [ String new ]! Object subclass: #ECContext instanceVariableNames: 'source position theClass ranges completionIndex recurseCount receiverClass completionToken model controller variables selectors typeInfos' classVariableNames: '' poolDictionaries: '' category: 'Ocompletion-ECModel'! !ECContext commentStamp: '<historical>' prior: 0! A completion is started by the ECController. The controller creates me to compute the context of the completion. The most important information about the context are the receiverClass and the completionToken. I create a ECModel or subclass when requested by the 'model' method. I use SHParser and SHRange to parse the text input.! ----- Method: ECContext class>>controller:class:source:position: (in category 'instance creation') ----- controller: aECController class: aClass source: aString position: anInteger ^ self basicNew initialize setController: aECController class: aClass source: aString position: anInteger! ----- Method: ECContext>>blockTemporaries (in category 'private-temporaries') ----- blockTemporaries | blocks range vars | blocks := OrderedCollection new. 1 to: completionIndex - 1 do: [ :index | range := ranges at: index. self handleBlockStack: blocks with: range. range isBlockTemporary ifTrue: [ vars := blocks last. vars add: range ] ]. ^ self convertBlocksToVariables: blocks! ----- Method: ECContext>>checkForZeroPosition (in category 'private-compute-index') ----- checkForZeroPosition ^ (position = 0 or: [ranges isEmpty]) and: [self insertEmptyRangeAt: 1 start: 0 end: 1. true]! ----- Method: ECContext>>checkImpossibleReceiver (in category 'private-receiver-guessing') ----- checkImpossibleReceiver ^ self isSelectorsAndVariables ifTrue: [self configureSelectorsAndVariables] ifFalse: [self isVariablesOnly ifTrue: [self configureVariablesOnly] ifFalse: [self isSelectorsOnly and: [self configureSelectorsOnly]]]. ! ----- Method: ECContext>>completionToken (in category 'accessing') ----- completionToken completionToken ifNil: [ | range | range := ranges at: completionIndex. completionToken := self sourceOf: range stopAt: position. completionToken := completionToken wordBefore: completionToken size ]. ^ completionToken! ----- Method: ECContext>>compute (in category 'private') ----- compute completionIndex := self computeIndexOfPosition. receiverClass := self computeReceiverClass! ----- Method: ECContext>>computeIndexOfPosition (in category 'private-compute-index') ----- computeIndexOfPosition | current | self checkForZeroPosition ifTrue: [ ^ 1 ]. 1 to: ranges size do: [ :index | current := ranges at: index. (current includesPosition: position) ifTrue: [ ^ index ] ifFalse: [ current end > position ifTrue: [ ^ self createEmptyRangeForGapAt: index ] ] ]. ^ self createEmptyRangeAtTail! ----- Method: ECContext>>computeReceiverClass (in category 'private') ----- computeReceiverClass | previous found | recurseCount := 0. completionIndex = 1 ifTrue: [^nil]. found := self checkImpossibleReceiver. found ifTrue: [^nil]. previous := ranges at: completionIndex - 1. previous type = #cascadeSeparator ifTrue: [^self guessCascadeReceiver: completionIndex - 1]. (previous type = #unary and: [(self sourceOf: previous) = 'new' and: [completionIndex > 2]]) ifTrue: [previous := ranges at: completionIndex - 2. previous type = #globalVar ifTrue: [^self guessTypeOf: completionIndex - 2] ifFalse: [self configureSelectorsOnly. ^nil]]. ^self guessTypeOf: completionIndex - 1! ----- Method: ECContext>>configureSelectorsAndVariables (in category 'private-configure') ----- configureSelectorsAndVariables variables := true. selectors := true. ^true! ----- Method: ECContext>>configureSelectorsOnly (in category 'private-configure') ----- configureSelectorsOnly variables := false. selectors := true. ^true! ----- Method: ECContext>>configureVariablesOnly (in category 'private-configure') ----- configureVariablesOnly variables := true. selectors := false. ^true! ----- Method: ECContext>>convertBlocksToVariables: (in category 'private-temporaries') ----- convertBlocksToVariables: anOrderedCollection | result blockStack | blockStack := anOrderedCollection. result := OrderedCollection new. blockStack do: [ :each | result addAll: each ]. ^ result! ----- Method: ECContext>>createEmptyRangeAtTail (in category 'private-compute-index') ----- createEmptyRangeAtTail | previous | previous := ranges last. ranges add: (SHRange start: previous end + 1 end: source size type: #empty). ^ ranges size! ----- Method: ECContext>>createEmptyRangeForGapAt: (in category 'private-compute-index') ----- createEmptyRangeForGapAt: index | current previous | index = 1 ifTrue: [self insertEmptyRangeAt: 1 start: 0 end: 1. ^ index]. current := ranges at: index. previous := ranges at: index - 1. self insertEmptyRangeAt: index start: previous end + 1 end: current start - 1. ^ index! ----- Method: ECContext>>createModel (in category 'accessing') ----- createModel | modelClass | self receiverClass ifNotNil: [^ ECTypedModel class: receiverClass]. (controller workspace isNil and: [theClass notNil]) ifTrue: [completionIndex = 1 ifTrue: [^ ECOverrideModel class: theClass]]. modelClass := ECUntypedModel. (controller model respondsTo: #modelClass) ifTrue: [controller model modelClass ifNotNil: [:class | modelClass := class]]. ^ modelClass class: theClass temporaries: self temporaries additionals: controller additionals variables: variables selectors: selectors! ----- Method: ECContext>>createRanges (in category 'private') ----- createRanges | parser | parser := SHParserST80 new. ranges := parser rangesIn: source classOrMetaClass: theClass workspace: controller workspace environment: nil. ranges := ranges select: [:each | each type ~= #comment]! ----- Method: ECContext>>findCommonSuperclass: (in category 'private-roel-typer') ----- findCommonSuperclass: aCollection | current | aCollection isEmpty ifTrue: [ ^ nil ]. current := aCollection first. aCollection do: [ :class | [ class includesBehavior: current ] whileFalse: [ current := current superclass ] ]. ^ current! ----- Method: ECContext>>findSourceRangeFor: (in category 'private') ----- findSourceRangeFor: aNumber aNumber to: ranges size by: 2 do: [:index | index + 3 > ranges size ifTrue: [^ nil]. (ranges at: index + 1) isAssignment ifTrue: [(ranges at: index + 3) type = #statementSeparator ifTrue: [^ index + 2] ifFalse: [(ranges at: index + 2) type = #globalVar ifTrue: [^ index + 2] ifFalse: [(ranges at: index + 1) isAssignment ifFalse: [^ nil]]]]]! ----- Method: ECContext>>guessArgument: (in category 'private-type-guessing') ----- guessArgument: aSHRange | name | name := self sourceOf: aSHRange. (name = 'html' and: [ (Smalltalk at: #WARenderCanvas ifAbsent: [ ]) notNil ]) ifTrue: [ ^ Smalltalk at: #WARenderCanvas ]. ^ ECInstVarTypeGuesser getClassFromTypeSuggestingName: name! ----- Method: ECContext>>guessCascadeReceiver: (in category 'private') ----- guessCascadeReceiver: aNumber | type | aNumber to: 1 by: -1 do: [ :index | type := (ranges at: index) type. ((#(#statementSeparator #assignment #ansiAssignment ) includes: type) or: [ (type beginsWith: 'pattern') or: [ type beginsWith: 'methodTemp' ] ]) ifTrue: [ ^ self guessTypeOf: index + 1 ] ]. ^ nil! ----- Method: ECContext>>guessClassVarClass: (in category 'private') ----- guessClassVarClass: aSHRange | aClass name | name := self sourceOf: aSHRange. aClass := controller guessTypeFor: name. aClass ifNotNil: [^ aClass]. ^ (ECClassVarTypeGuesser variableName: name class: theClass theMetaClass) perform! ----- Method: ECContext>>guessGlobal: (in category 'private-type-guessing') ----- guessGlobal: aNumber | aClass | aClass := Smalltalk at: (self sourceOf: (ranges at: aNumber)) asSymbol ifAbsent: [ ^ nil ]. aClass isBehavior ifFalse: [ ^ nil ]. aNumber = (completionIndex - 1) ifTrue: [ ^ aClass class ]. (ranges size >= (aNumber + 1) and: [ (ranges at: aNumber + 1) type = #statementSeparator ]) ifTrue: [ ^ aClass class ]. ^ aClass! ----- Method: ECContext>>guessInstVarClass: (in category 'private') ----- guessInstVarClass: aSHRange | aClass name | name := self sourceOf: aSHRange. aClass := controller guessTypeFor: name. aClass ifNotNil: [ ^ aClass ]. aClass := self guessWithRoelTyper: name class: theClass. aClass ifNotNil: [ ^ aClass ]. ^ (ECInstVarTypeGuesser variableName: name class: theClass) perform! ----- Method: ECContext>>guessTempVarClass: (in category 'private') ----- guessTempVarClass: aSHRange ^self guessTempVarClass: (self sourceOf: aSHRange) type: aSHRange type. ! ----- Method: ECContext>>guessTempVarClass:type: (in category 'private') ----- guessTempVarClass: aString type: aSymbol | current type varName varType sourceIndex aClass | aClass := controller guessTypeFor: aString. aClass ifNotNil: [ ^ aClass ]. varName := aString. varType := aSymbol. completionIndex to: 1 by: -1 do: [ :index | current := ranges at: index. (current type = varType and: [ (self sourceOf: current) = varName and: [ index + 3 <= ranges size ] ]) ifTrue: [ (sourceIndex := self findSourceRangeFor: index) notNil ifTrue: [ type := self guessTypeOf: sourceIndex. type ifNotNil: [ ^ type ] ] ] ]. ^ nil! ----- Method: ECContext>>guessTypeOf: (in category 'private-type-guessing') ----- guessTypeOf: aNumber | range | self configureSelectorsOnly. recurseCount > 10 ifTrue: [ ^ nil ]. recurseCount := recurseCount + 1. range := ranges at: aNumber. range isSelf ifTrue: [ ^theClass ]. range isSuper ifTrue: [ ^theClass ifNotNil: [ (theClass isKindOf: Class) ifTrue: [ "It may be a Trait or something else." theClass superclass ] ] ]. range asType ifNotNil: [ :type | "Constant" type == Number ifFalse: [ ^type ]. ^(SqNumberParser parse: ( source copyFrom: range start to: range end) onError: [ ^Number ]) class ]. range isArgument ifTrue: [ ^self guessArgument: range ]. range isTemporaryVariable ifTrue: [ ^self guessTempVarClass: range ]. range isInstanceVariable ifTrue: [ ^self guessInstVarClass: range ]. range isClassVariable ifTrue: [ ^self guessClassVarClass: range ]. range isGlobal ifTrue: [ ^self guessGlobal: aNumber ]. ^nil! ----- Method: ECContext>>guessWithRoelTyper:class: (in category 'private-roel-typer') ----- guessWithRoelTyper: aString class: aClass | typeCollector typeClass typeInfo types type | typeCollector := Smalltalk classNamed: #TypeCollector. typeCollector ifNil: [ ^ nil ]. typeClass := aClass whichClassDefinesInstVar: aString. typeClass ifNil: [ ^ nil ]. typeInfo := (typeCollector typeInstvarsOfClass: typeClass) at: aString asSymbol ifAbsent: [ ^ nil ]. types := typeInfo types size <= 2 ifTrue: [ typeInfo types ] ifFalse: [ typeInfo types intersection: typeInfo assignments ]. type := types isEmpty ifFalse: [ self findCommonSuperclass: types ]. ^ type == Object ifFalse: [ type ]! ----- Method: ECContext>>handleBlockStack:with: (in category 'private-temporaries') ----- handleBlockStack: aCollection with: aSHRange | range blockStack | range := aSHRange. blockStack := aCollection. range isBlockStart ifTrue: [ blockStack add: OrderedCollection new ] ifFalse: [ range isBlockEnd ifTrue: [ blockStack removeLast ] ]! ----- Method: ECContext>>initialize (in category 'initialize-release') ----- initialize super initialize. source := String new. position := 0. recurseCount := 0. variables := true. selectors := true. ranges := OrderedCollection new. completionIndex := 0. completionToken := nil! ----- Method: ECContext>>insertEmptyRangeAt:start:end: (in category 'private-compute-index') ----- insertEmptyRangeAt: index start: start end: end ranges add: (SHRange start: start end: end type: #empty) beforeIndex: index! ----- Method: ECContext>>isSelectorsAndVariables (in category 'private-receiver-guessing') ----- isSelectorsAndVariables | current | current := ranges at: completionIndex. ^current isUnfinished! ----- Method: ECContext>>isSelectorsOnly (in category 'private-receiver-guessing') ----- isSelectorsOnly | previous | previous := ranges at: completionIndex - 1. ^previous isOpening! ----- Method: ECContext>>isVariablesOnly (in category 'private-receiver-guessing') ----- isVariablesOnly | current previous | current := ranges at: completionIndex. ^ current isVariablesOnly or: [ current isOpening or: [ previous := ranges at: completionIndex - 1. previous isOpening or: [ previous isSeparator or: [ previous isKeyword or: [ previous isAssignment or: [ previous isBinary ] ] ] ] ] ]! ----- Method: ECContext>>model (in category 'accessing') ----- model model isNil ifTrue: [ model := self createModel ]. ^ model! ----- Method: ECContext>>narrowWith: (in category 'action') ----- narrowWith: aString completionToken := aString. model ifNotNil: [ model narrowWith: aString ]! ----- Method: ECContext>>receiverClass (in category 'private') ----- receiverClass ^ receiverClass! ----- Method: ECContext>>setController:class:source:position: (in category 'initialize-release') ----- setController: aECController class: aClass source: aString position: anInteger controller := aECController. theClass := aClass. source := aString. position := anInteger. self createRanges. self compute! ----- Method: ECContext>>sourceOf: (in category 'private') ----- sourceOf: aSHRange ^aSHRange isString ifTrue: [aSHRange] ifFalse: [self sourceOf: aSHRange stopAt: aSHRange end]! ----- Method: ECContext>>sourceOf:stopAt: (in category 'private') ----- sourceOf: aSHRange stopAt: aNumber ^ aSHRange type = #empty ifTrue: [String new] ifFalse: [source copyFrom: aSHRange start to: aNumber]! ----- Method: ECContext>>switchToUntyped (in category 'action') ----- switchToUntyped receiverClass := nil. self configureSelectorsAndVariables. model := self createModel! ----- Method: ECContext>>temporaries (in category 'accessing') ----- temporaries | tempRanges | tempRanges := ranges select: [ :each | #(#patternTempVar #patternArg ) includes: each type ]. tempRanges addAll: self blockTemporaries. ^ tempRanges collect: [ :each | ECLocalEntry contents: (self sourceOf: each) type: each type ]! ----- Method: ECContext>>theClass (in category 'accessing') ----- theClass ^theClass! ----- Method: ECContext>>typeInfosFor: (in category 'private-roel-typer') ----- typeInfosFor: aClass | roelTyper | (roelTyper := Smalltalk at: #TypeCollector ifAbsent: [ ]) ifNil: [ ^ nil ]. typeInfos ifNil: [ typeInfos := roelTyper typeInstvarsOfClass: aClass ]. ^ typeInfos! ECContext subclass: #OContext instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Ocompletion'! ----- Method: OContext>>createModel (in category 'model creation') ----- createModel | mdl | mdl := OModel class: theClass temporaries: self temporaries additionals: controller additionals variables: variables selectors: selectors. controller expanded ifTrue: [mdl expand]. ^ mdl ! Object subclass: #ECController instanceVariableNames: 'model menuMorph editor context oppositeChar caret inverseMapping' classVariableNames: '' poolDictionaries: '' category: 'Ocompletion-ECView'! !ECController commentStamp: '<historical>' prior: 0! I live as an instance variable in a Browser, Debugger, Workspace or other window. I'm the glue between all participants of the completion system. I create the ECContext and pass myself to the ECMenuMorph. I process the keyboard events and pass them to the ECMenuMorph or close the morph if needed.! ----- Method: ECController class>>allowModel: (in category 'testing') ----- allowModel: aModel ^ aModel respondsTo: #completionController! ----- Method: ECController class>>model: (in category 'instance creation') ----- model: aStringHolder ^self new setModel: aStringHolder! ----- Method: ECController>>additionals (in category 'accessing') ----- additionals ^ nil! ----- Method: ECController>>closeMenu (in category 'menu morph') ----- closeMenu menuMorph ifNotNil: [ menuMorph delete. menuMorph := nil ]! ----- Method: ECController>>context (in category 'accessing') ----- context ^context! ----- Method: ECController>>contextClass (in category 'accessing') ----- contextClass ^ECContext! ----- Method: ECController>>editor (in category 'accessing') ----- editor ^editor ifNotNil: [ editor at: 1 ] ! ----- Method: ECController>>editor: (in category 'accessing') ----- editor: theEditor (editor ifNil: [ editor := WeakArray new: 1 ]) at: 1 put: theEditor ! ----- Method: ECController>>guessTypeFor: (in category 'type guessing') ----- guessTypeFor: aString ^self model ifNotNil: [ :theModel | theModel guessTypeForName: aString ]! ----- Method: ECController>>handleKeystrokeAfter:editor: (in category 'keyboard') ----- handleKeystrokeAfter: aKeyboardEvent editor: anEditor (anEditor isNil or:[self isMenuOpen not]) ifTrue:[^self]. self setModel: anEditor model. context narrowWith: anEditor wordAtCaret. menuMorph narrowCompletion! ----- Method: ECController>>handleKeystrokeBefore:editor: (in category 'keyboard') ----- handleKeystrokeBefore: aKeyboardEvent editor: anEditor "I return a boolean. true when I have handled the event and no futher processing is needed by the caller." | theEditor keyValue controlKeyPressed isSpaceKey | self editor: anEditor. theEditor := self editor. self setModel: theEditor model. keyValue := aKeyboardEvent keyValue. controlKeyPressed := aKeyboardEvent controlKeyPressed. isSpaceKey := #(0 32 ) includes: keyValue. "Ctrl-Space or Tab for open" self isMenuOpen ifFalse: [(isSpaceKey & controlKeyPressed or: [keyValue = 9 and: [theEditor isCaretBehindChar and: [controlKeyPressed not]]]) ifTrue: [self openMenuFor: theEditor. ^ true] ifFalse: [(self smartInput: keyValue) ifNotNil: [^ true]]. ^ false]. "Home" keyValue = 1 ifTrue: [menuMorph home. ^ true]. "End" (keyValue = 4 and: [controlKeyPressed not]) ifTrue: [menuMorph end. ^ true]. (keyValue = 8 and:[controlKeyPressed ]) ifTrue:[menuMorph help. ^true]. "Right-Arrow" keyValue = 29 ifTrue: [menuMorph showDetail. ^ true]. "Left Arrow" keyValue = 28 ifTrue: [menuMorph hideDetail. ^ true]. "Arrow up" keyValue = 30 ifTrue: [menuMorph moveUp. ^ true]. "Arrow down" keyValue = 31 ifTrue: [menuMorph moveDown. ^ true]. "Page up" keyValue = 11 ifTrue: [menuMorph pageUp. ^ true]. "Page down" keyValue = 12 ifTrue: [menuMorph pageDown. ^ true]. "Tab or Ctrl-Space" (keyValue = 13 or: [isSpaceKey & controlKeyPressed or: [keyValue = 9]]) ifTrue: [menuMorph insertSelected ifTrue: [^ true]]. "Ctrl-u" keyValue = 21 & controlKeyPressed ifTrue: [menuMorph switchToUntyped. ^ true]. "Crtl-t" (keyValue = 20 and: [controlKeyPressed]) ifTrue: [menuMorph expand. ^ true]. "All keys but the alphanumeric chars (without command and control ) and the backspace key do close the menu" keyValue = 8 ifTrue: [theEditor isCaretBehindChar not ifTrue: [self closeMenu]. ^ false]. (controlKeyPressed not & aKeyboardEvent commandKeyPressed not and: [aKeyboardEvent keyCharacter isAlphaNumeric]) ifFalse: [self closeMenu. ^ keyValue = 27]. ^ false! ----- Method: ECController>>invalidateEditorMorph (in category 'keyboard') ----- invalidateEditorMorph | theEditor | theEditor := self editor ifNil: [ ^self ]. theEditor morph invalidRect: theEditor morph bounds. ! ----- Method: ECController>>isMenuOpen (in category 'menu morph') ----- isMenuOpen ^menuMorph notNil and: [menuMorph itemsCount > 0 ifTrue: [true] ifFalse: [self closeMenu. false]] ! ----- Method: ECController>>menuClosed (in category 'menu morph') ----- menuClosed menuMorph := nil. context := nil.! ----- Method: ECController>>menuMorph (in category 'accessing') ----- menuMorph ^ECMenuMorph! ----- Method: ECController>>model (in category 'accessing') ----- model ^model isArray ifTrue: [model first] ifFalse: [model]! ----- Method: ECController>>openMenuFor: (in category 'menu morph') ----- openMenuFor: anEditor | theMenu class | "Now I check if the method exist, it prevent for crashing each time a key is pressed" (self model class respondsTo: #selectedClassOrMetaClass) ifTrue: [ class := self model selectedClassOrMetaClass ] ifFalse: [ class := nil ]. self closeMenu. context := self contextClass controller: self class: class source: anEditor text string position: anEditor startIndex - 1. self editor: anEditor. theMenu := self menuMorph controller: self position: (anEditor selectionPosition: context completionToken). theMenu isClosed ifFalse: [ menuMorph := theMenu ]! ----- Method: ECController>>setModel: (in category 'initialize-release') ----- setModel: aStringHolder model := WeakArray with: aStringHolder! ----- Method: ECController>>smartBackspace (in category 'keyboard') ----- smartBackspace | opposite theEditor | theEditor := self editor ifNil: [ ^nil ]. theEditor hasSelection ifTrue: [ ^nil ]. opposite := ECPreferences smartCharactersMapping at: (theEditor text at: theEditor startIndex - 1 ifAbsent: [ ^ nil ]) ifAbsent: [ ^ nil ]. opposite = (theEditor text at: theEditor stopIndex ifAbsent: [ ^ nil ]) ifFalse: [ ^ nil ]. theEditor selectInvisiblyFrom: theEditor startIndex - 1 to: theEditor stopIndex. theEditor replaceSelectionWith: String new. self invalidateEditorMorph. ^ true ! ----- Method: ECController>>smartCharacter: (in category 'keyboard') ----- smartCharacter: aCharacter | theEditor opposite previous next | theEditor := self editor ifNil: [ ^nil ]. theEditor hasSelection ifTrue: [ opposite := ECPreferences smartCharactersMapping at: aCharacter ifAbsent: [ ^nil ]. theEditor replaceSelectionWith: aCharacter asString, theEditor selection, opposite asString. ECPreferences keepSelectionAfterAddingSmartCharacters ifTrue: [ theEditor selectFrom: theEditor startIndex + 1 to: theEditor stopIndex - 2 ] ifFalse: [ theEditor selectFrom: theEditor stopIndex to: theEditor stopIndex - 1 ]. self invalidateEditorMorph. ^ true ]. opposite := ECPreferences smartCharactersMapping at: aCharacter ifAbsent: [ "If this is not a closing pair for a smart character then do nothing." (ECPreferences smartCharactersMapping includes: aCharacter) ifFalse: [ ^nil ]. theEditor blinkPrevParen: aCharacter. (theEditor text at: theEditor startIndex ifAbsent: [ ^ nil ]) = aCharacter ifFalse: [ ^ nil ]. theEditor selectFrom: theEditor startIndex + 1 to: theEditor startIndex. self invalidateEditorMorph. ^ true ]. previous := theEditor text at: theEditor startIndex - 1 ifAbsent: [ Character space ]. next := theEditor text at: theEditor startIndex ifAbsent: [ Character space ]. (previous isSeparator or: [ next isSeparator ]) ifFalse: [ ^ nil ]. (opposite = aCharacter and: [ next = aCharacter ]) ifTrue: [ theEditor selectFrom: theEditor startIndex + 1 to: theEditor startIndex. self invalidateEditorMorph. ^ true ]. theEditor replaceSelectionWith: (String with: aCharacter with: opposite). theEditor selectFrom: theEditor startIndex + 1 to: theEditor startIndex. self invalidateEditorMorph. ^ true! ----- Method: ECController>>smartInput: (in category 'keyboard') ----- smartInput: anInteger ECPreferences smartCharacters ifFalse: [ ^nil ]. ^ anInteger = 8 ifTrue: [ self smartBackspace ] ifFalse: [ self smartCharacter: anInteger asCharacter ]! ----- Method: ECController>>update: (in category 'updating') ----- update: aSymbol "Close the menu when the contents of the model changes." aSymbol == #contents ifTrue: [ self closeMenu ]. ^super update: aSymbol ! ----- Method: ECController>>workspace (in category 'accessing') ----- workspace ^nil! ECController subclass: #ECWorkspaceController instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Ocompletion-ECView'! !ECWorkspaceController commentStamp: '<historical>' prior: 0! I'm a specialized controller, that works with Workspaces.! ----- Method: ECWorkspaceController>>additionals (in category 'accessing') ----- additionals ^ self workspace completionAdditionals! ----- Method: ECWorkspaceController>>workspace (in category 'accessing') ----- workspace ^self model! ECController subclass: #OController instanceVariableNames: 'expanded contextClass' classVariableNames: '' poolDictionaries: '' category: 'Ocompletion'! ----- Method: OController>>contextClass (in category 'accessing') ----- contextClass ^ contextClass! ----- Method: OController>>expand (in category 'as yet unclassified') ----- expand expanded := true. (self model isKindOf: OModel) ifTrue: [self model expand].! ----- Method: OController>>expanded (in category 'as yet unclassified') ----- expanded ^ expanded ifNil: [expanded := false]! ----- Method: OController>>handleKeystrokeBefore:editor: (in category 'keyboard') ----- handleKeystrokeBefore: kbEvent editor: theEditor "I return a boolean. true when I have handled the event and no futher processing is needed by the caller." | keyValue ctrl cmd down tab colon alphanum del esc enter up | self editor: theEditor. self setModel: theEditor model. keyValue := kbEvent keyValue. ctrl := kbEvent controlKeyPressed. cmd := kbEvent commandKeyPressed. down := keyValue = 31. up := keyValue = 30. tab := kbEvent keyCharacter = Character tab. enter := kbEvent keyCharacter = Character cr. colon := kbEvent keyCharacter = $:. alphanum := kbEvent keyCharacter isAlphaNumeric. del := keyValue = 8. esc := #[27 "esc" 11 "page up" 12 "page down"] includes: keyValue. self isMenuOpen ifTrue: [menuMorph stillActive]. del ifTrue: [ self smartBackspace ]. self expanded ifTrue: [ ^ super handleKeystrokeBefore: kbEvent editor: theEditor ]. esc ifTrue: [self isMenuOpen ifTrue: [self retract; closeMenu. ^ true]]. ((tab) and: [theEditor wordAtCaret notEmpty]) ifTrue: [ (context notNil and: [context model notEmpty and: [menuMorph selected > 0]]) ifTrue: [menuMorph insertSelected ifTrue: [ ^ true ] ] ifFalse: [enter ifFalse: [self openXMenuFor: theEditor. ^true]]]. self isMenuOpen & (colon | alphanum | up | down | tab | del) not ifTrue: [self retract; closeMenu.]. del ifTrue: [ theEditor isCaretBehindChar not ifTrue: [ self closeMenu ]. ^ false]. (ctrl not & cmd not & alphanum) ifTrue: [ theEditor text ifEmpty: [^ false]. theEditor selection ifNotEmpty: [theEditor replaceSelectionWith: '']. self isMenuOpen ifFalse: [ self openMenuFor: theEditor ]. theEditor text ifNotNil: [ menuMorph changed ]. ^false] ifFalse: [ (self smartInput: keyValue) ifNotNil: [^ true]]. down & self isMenuOpen ifTrue: [ menuMorph selected = 3 ifTrue: [self openXMenuFor: theEditor]. menuMorph moveDown. ^ true ]. up & self isMenuOpen ifTrue: [ menuMorph moveUp. ^ true]. ^ super handleKeystrokeBefore: kbEvent editor: theEditor ! ----- Method: OController>>initialize (in category 'initialize-release') ----- initialize contextClass := OContext.! ----- Method: OController>>menuMorph (in category 'accessing') ----- menuMorph ^ self expanded ifTrue: [OXMenuMorph] ifFalse: [OMenuMorph]! ----- Method: OController>>openXMenuFor: (in category 'menu morph') ----- openXMenuFor: anEditor | theMenu | self closeMenu. context := menuMorph ifNotNil: [menuMorph context] ifNil: [self contextClass controller: self class: self model selectedClassOrMetaClass source: anEditor text string position: anEditor startIndex - 1]. self editor: anEditor. self expand. theMenu := self menuMorph controller: self position: (anEditor selectionPosition: context completionToken). theMenu isClosed ifFalse: [menuMorph := theMenu]. menuMorph moveDown; moveDown. ! ----- Method: OController>>retract (in category 'as yet unclassified') ----- retract expanded := false. (self model isKindOf: OModel) ifTrue: [self model contract].! Object subclass: #ECEntry instanceVariableNames: 'contents type description' classVariableNames: '' poolDictionaries: '' category: 'Ocompletion-ECModel'! !ECEntry commentStamp: 'bar 10/5/2005 23:31' prior: 0! I represent a completion entry that is management by a ECModel and shown in the ECMenuMorph as a menu entry.! ECEntry subclass: #ECClassVarEntry instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Ocompletion-ECModel'! ----- Method: ECClassVarEntry>>guessTypeWith: (in category 'as yet unclassified') ----- guessTypeWith: anECContext ^ anECContext guessClassVarClass: contents! ----- Method: ECClassVarEntry>>label (in category 'as yet unclassified') ----- label ^ 'class variable'! ----- Method: ECEntry class>>contents:type: (in category 'as yet unclassified') ----- contents: aString type: aSymbol ^ self new setContents: aString type: aSymbol! ----- Method: ECEntry>><= (in category 'as yet unclassified') ----- <= aECEntry ^ contents <= aECEntry contents! ----- Method: ECEntry>>browseWith: (in category 'as yet unclassified') ----- browseWith: anECContext type := self guessTypeWith: anECContext. type ifNil: [^ false]. SystemNavigation default browseClass: type. ^ true! ----- Method: ECEntry>>completion (in category 'as yet unclassified') ----- completion ^ self contents asSymbol! ----- Method: ECEntry>>contents (in category 'as yet unclassified') ----- contents ^contents! ----- Method: ECEntry>>contentsAsSymbol (in category 'as yet unclassified') ----- contentsAsSymbol ^ contents asSymbol ! ----- Method: ECEntry>>createDescriptionWith: (in category 'detail information') ----- createDescriptionWith: anECContext | clazz | clazz := self guessTypeWith: anECContext. ^ clazz ifNil: [ ECEntryDescription label: self label ] ifNotNil: [ ECEntryDescription label: self label title: clazz printString description: clazz comment ]! ----- Method: ECEntry>>descriptionWith: (in category 'as yet unclassified') ----- descriptionWith: anECContext description ifNotNil: [ ^ description ]. ^ description := self createDescriptionWith: anECContext! ----- Method: ECEntry>>guessTypeWith: (in category 'as yet unclassified') ----- guessTypeWith: anECContext ^ nil! ----- Method: ECEntry>>isInstance (in category 'as yet unclassified') ----- isInstance ^ false! ----- Method: ECEntry>>isLocal (in category 'as yet unclassified') ----- isLocal ^ false! ----- Method: ECEntry>>isSelector (in category 'as yet unclassified') ----- isSelector ^ false! ----- Method: ECEntry>>label (in category 'as yet unclassified') ----- label ^ 'unknown'! ----- Method: ECEntry>>printOn: (in category 'as yet unclassified') ----- printOn: aStream aStream nextPutAll: self class name; nextPut: $(; nextPutAll: contents; nextPut: $,; nextPutAll: type; nextPut: $)! ----- Method: ECEntry>>setContents:type: (in category 'as yet unclassified') ----- setContents: aString type: aSymbol contents := aString. type := aSymbol! ----- Method: ECEntry>>type (in category 'as yet unclassified') ----- type ^type! ECEntry subclass: #ECGlobalEntry instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Ocompletion-ECModel'! ----- Method: ECGlobalEntry>>guessTypeWith: (in category 'as yet unclassified') ----- guessTypeWith: anECContext | globalEntry | globalEntry := Smalltalk at: contents ifAbsent: [^ nil]. globalEntry isBehavior ifTrue: [^ globalEntry]. globalEntry ifNotNil: [^ globalEntry class]. ^ nil! ----- Method: ECGlobalEntry>>label (in category 'as yet unclassified') ----- label ^ 'global'! ECEntry subclass: #ECInstVarEntry instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Ocompletion-ECModel'! ----- Method: ECInstVarEntry>>guessTypeWith: (in category 'as yet unclassified') ----- guessTypeWith: anECContext ^ anECContext guessInstVarClass: contents! ----- Method: ECInstVarEntry>>isInstance (in category 'as yet unclassified') ----- isInstance ^true! ----- Method: ECInstVarEntry>>label (in category 'as yet unclassified') ----- label ^ 'instance variable'! ECEntry subclass: #ECLocalEntry instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Ocompletion-ECModel'! ----- Method: ECLocalEntry>>guessTypeWith: (in category 'as yet unclassified') ----- guessTypeWith: anECContext ^ (anECContext guessTempVarClass: contents type: type) ifNil: [anECContext guessArgument: contents]! ----- Method: ECLocalEntry>>isLocal (in category 'as yet unclassified') ----- isLocal ^true! ----- Method: ECLocalEntry>>label (in category 'as yet unclassified') ----- label ^ 'local variable'! ECEntry subclass: #ECSelectorEntry instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Ocompletion-ECModel'! ----- Method: ECSelectorEntry>>browseWith: (in category 'private') ----- browseWith: anECContext ^ self findMethodWith: anECContext do: [ :class :method | Browser fullOnClass: class selector: method selector. true ] ifAbsent: [ :selector | (SystemBrowser default name beginsWith: 'OB') ifTrue: [OBImplementorsBrowser openRoot: (OBSelectorNode on: selector).] ifFalse: [self systemNavigation browseAllImplementorsOf: selector]. true ]! ----- Method: ECSelectorEntry>>createDescriptionWith: (in category 'as yet unclassified') ----- createDescriptionWith: anECContext ^ self findMethodWith: anECContext do: [:clazz :method | self methodSourceDescription: clazz method: method ] ifAbsent: [:selector | self implementorsDescription: selector]! ----- Method: ECSelectorEntry>>findMethodWith:do:ifAbsent: (in category 'private') ----- findMethodWith: anECContext do: foundBlock ifAbsent: notfoundBlock | theClass result implementors | theClass := anECContext model theClass. result := theClass ifNil: [implementors := self systemNavigation allImplementorsOf: contents. implementors size == 1 ifTrue: [| ref | ref := implementors first. self lookupSelector: ref methodSymbol class: ref actualClass] ifFalse: [^ notfoundBlock value: contents]] ifNotNil: [self lookupSelector: contents class: theClass]. ^ foundBlock value: result first value: result second! ----- Method: ECSelectorEntry>>implementorsDescription: (in category 'private') ----- implementorsDescription: aSymbol | implementors output | output := WriteStream on: String new. implementors := self systemNavigation allImplementorsOf: aSymbol. implementors isEmpty ifTrue: [ ^ ECEntryDescription label: 'symbol' title: '(no implementors)' description: 'This is just symbol.' ]. implementors do: [ :each | output nextPutAll: each classSymbol printString; cr ]. ^ ECEntryDescription label: self label title: '(Implementors)' description: output contents! ----- Method: ECSelectorEntry>>label (in category 'as yet unclassified') ----- label ^ 'method'! ----- Method: ECSelectorEntry>>lookupSelector:class: (in category 'private') ----- lookupSelector: aSymbol class: aClass "Look up the given selector in my methodDictionary. Return the corresponding method if found. Otherwise chase the superclass chain and try again. Return nil if no method is found." | lookupClass | lookupClass := aClass. [lookupClass isNil] whileFalse: [(lookupClass includesSelector: aSymbol) ifTrue: [^ Array with: lookupClass with: (lookupClass compiledMethodAt: aSymbol)]. lookupClass := lookupClass superclass]. ^ nil! ----- Method: ECSelectorEntry>>methodSourceDescription:method: (in category 'as yet unclassified') ----- methodSourceDescription: aClass method: aCompiledMethod | styler | styler := SHTextStylerST80 new. styler classOrMetaClass: aClass. ^ ECEntryDescription label: self label title: aClass printString description: (styler styledTextFor: (self methodSourceOn: aCompiledMethod ) asText)! ----- Method: ECSelectorEntry>>methodSourceOn: (in category 'private') ----- methodSourceOn: aCompiledMethod ^ aCompiledMethod getSourceFor: aCompiledMethod selector in: aCompiledMethod methodClass! ECSelectorEntry subclass: #ODatedEntry instanceVariableNames: 'date next previous' classVariableNames: '' poolDictionaries: '' category: 'Ocompletion'! ----- Method: ODatedEntry>><= (in category 'as yet unclassified') ----- <= anEntry ^ date = anEntry date ifTrue: [contents <= anEntry contents] ifFalse: [date > anEntry date]! ----- Method: ODatedEntry>>date (in category 'as yet unclassified') ----- date ^ date! ----- Method: ODatedEntry>>date: (in category 'as yet unclassified') ----- date: d date := d! ----- Method: ODatedEntry>>link: (in category 'as yet unclassified') ----- link: anODatedEntry "Link the given entry after me." anODatedEntry next: next; previous: self. next previous: anODatedEntry. next := anODatedEntry! ----- Method: ODatedEntry>>matches: (in category 'as yet unclassified') ----- matches: pref ^contents beginsWithEmpty: pref caseSensitive: false! ----- Method: ODatedEntry>>next (in category 'as yet unclassified') ----- next ^next! ----- Method: ODatedEntry>>next: (in category 'as yet unclassified') ----- next: anODatedEntry next := anODatedEntry! ----- Method: ODatedEntry>>now (in category 'as yet unclassified') ----- now date := DateAndTime now! ----- Method: ODatedEntry>>previous (in category 'as yet unclassified') ----- previous ^previous! ----- Method: ODatedEntry>>previous: (in category 'as yet unclassified') ----- previous: anODatedEntry previous := anODatedEntry! ----- Method: ODatedEntry>>unlink (in category 'as yet unclassified') ----- unlink next previous: previous. previous next: next! ECEntry subclass: #ECSelfEntry instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Ocompletion-ECModel'! ----- Method: ECSelfEntry>>guessTypeWith: (in category 'as yet unclassified') ----- guessTypeWith: anECContext ^ anECContext theClass! ----- Method: ECSelfEntry>>label (in category 'as yet unclassified') ----- label ^ 'self'! ECEntry subclass: #ECSuperEntry instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Ocompletion-ECModel'! ----- Method: ECSuperEntry>>guessTypeWith: (in category 'as yet unclassified') ----- guessTypeWith: anECContext ^ anECContext theClass ifNotNil: [anECContext theClass superclass]! ----- Method: ECSuperEntry>>label (in category 'as yet unclassified') ----- label ^ 'super'! Object subclass: #ECEntryDescription instanceVariableNames: 'title description label' classVariableNames: '' poolDictionaries: '' category: 'Ocompletion-ECModel'! ----- Method: ECEntryDescription class>>label: (in category 'as yet unclassified') ----- label: firstString ^ self new setLabel: firstString title: '(unknown)' description: nil! ----- Method: ECEntryDescription class>>label:title:description: (in category 'as yet unclassified') ----- label: firstString title: secondString description: thirdString ^ self new setLabel: firstString title: secondString description: thirdString! ----- Method: ECEntryDescription>>description (in category 'accessing') ----- description ( description isNil or:[description isEmpty]) ifTrue:[^'-']. ^ description! ----- Method: ECEntryDescription>>label (in category 'accessing') ----- label ^ label! ----- Method: ECEntryDescription>>setLabel:title:description: (in category 'initialize-release') ----- setLabel: firstString title: secondString description: thirdString label := firstString. title := secondString. description := thirdString! ----- Method: ECEntryDescription>>title (in category 'accessing') ----- title ^ title! Object subclass: #ECModel instanceVariableNames: 'clazz selectors narrowString entries' classVariableNames: '' poolDictionaries: '' category: 'Ocompletion-ECModel'! !ECModel commentStamp: '<historical>' prior: 0! I'm an abstract class that stores the entries to be completed.! ----- Method: ECModel class>>class: (in category 'instance creation') ----- class: aClass | newInstance | newInstance := self basicNew initialize. newInstance setClass: aClass. ^ newInstance! ----- Method: ECModel>>addToEntries: (in category 'accessing') ----- addToEntries: anOrderedCollection | frontMatching innerMatching caseSensitive matchSubStrings | caseSensitive := ECPreferences caseSensitive. matchSubStrings := ECPreferences matchSubStrings. frontMatching := OrderedCollection new. innerMatching := OrderedCollection new. anOrderedCollection do: [ :each | | index | index := each contents indexOfSubStringWithEmpty: narrowString caseSensitive: caseSensitive. index = 1 ifTrue: [ frontMatching add: each ] ifFalse: [ (matchSubStrings and: [ index > 1 ]) ifTrue: [ innerMatching add: each ] ] ]. innerMatching sort. frontMatching sort. entries addAll: frontMatching; addAll: innerMatching! ----- Method: ECModel>>at: (in category 'accessing') ----- at: aNumber ^ entries at: aNumber ! ----- Method: ECModel>>completionAt: (in category 'action') ----- completionAt: aNumber ^ (self at: aNumber) completion separateKeywords, ' '! ----- Method: ECModel>>entries (in category 'accessing') ----- entries ^entries! ----- Method: ECModel>>entriesOfType: (in category 'accessing') ----- entriesOfType: aSymbol | collection | collection := entries select: [ :each | each type == aSymbol ]. ^ collection collect: [ :each | each contents ]! ----- Method: ECModel>>entryCount (in category 'accessing') ----- entryCount ^entries size! ----- Method: ECModel>>hasMessage (in category 'accessing') ----- hasMessage ^ self message notNil! ----- Method: ECModel>>initialize (in category 'initialize-release') ----- initialize self reset! ----- Method: ECModel>>initializeSelectors (in category 'accessing') ----- initializeSelectors self subclassResponsibility ! ----- Method: ECModel>>isEmpty (in category 'testing') ----- isEmpty ^ entries isEmpty! ----- Method: ECModel>>message (in category 'accessing') ----- message ^self isEmpty ifTrue: ['no completions found'] ifFalse: [nil]! ----- Method: ECModel>>narrowString: (in category 'private') ----- narrowString: aString narrowString := aString! ----- Method: ECModel>>narrowWith: (in category 'action') ----- narrowWith: aString self subclassResponsibility ! ----- Method: ECModel>>notEmpty (in category 'testing') ----- notEmpty ^self isEmpty not! ----- Method: ECModel>>reset (in category 'private') ----- reset self resetSelectors. self resetEntries. narrowString := String new! ----- Method: ECModel>>resetEntries (in category 'private') ----- resetEntries entries := OrderedCollection new! ----- Method: ECModel>>resetSelectors (in category 'private') ----- resetSelectors selectors ifNil: [ selectors := OrderedCollection new: 500 ] ifNotNil: [ selectors reset ]! ----- Method: ECModel>>setClass: (in category 'initialize-release') ----- setClass: aClass clazz := aClass. self initializeSelectors. self narrowWith: String new! ----- Method: ECModel>>theClass (in category 'action') ----- theClass ^nil! ----- Method: ECModel>>title (in category 'action') ----- title ^nil! ----- Method: ECModel>>toggleExpand (in category 'initialize-release') ----- toggleExpand ! ECModel subclass: #ECTypedModel instanceVariableNames: 'expanded' classVariableNames: '' poolDictionaries: '' category: 'Ocompletion-ECModel'! !ECTypedModel commentStamp: '<historical>' prior: 0! I'm the model for a typed completion, that means when a receiver class is known. I only have selectors. I have an expand toggle: When false I filter out Object and ProtoObject selectors. The default value is true.! ECTypedModel subclass: #ECOverrideModel instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Ocompletion-ECModel'! !ECOverrideModel commentStamp: '<historical>' prior: 0! I'm used when completing a method override. I contain all selectors of the superclass minus the already implemented selectors of the current class. When a completion occurs I complete a method template with a send to super.! ----- Method: ECOverrideModel>>computeReturn: (in category 'private') ----- computeReturn: aString | lastLine | lastLine := aString lineCorrespondingToIndex: aString size. ^(lastLine detect: [:each | each = $^] ifNone: []) ifNil: [''] ifNotNil: ['^']. ! ----- Method: ECOverrideModel>>initializeSelectors (in category 'initialize-release') ----- initializeSelectors self initializeSelectorsFor: clazz superclass. clazz methodDictionary keysDo: [ :each | | entry | entry := selectors detect: [ :ea | ea contentsAsSymbol == each ] ifNone: [ ]. entry notNil ifTrue: [ selectors remove: entry ifAbsent: [ ] ] ]! ----- Method: ECOverrideModel>>methodAt: (in category 'private') ----- methodAt: aNumber ^ clazz lookupSelector: (self at: aNumber) contentsAsSymbol! ----- Method: ECOverrideModel>>methodSourceAt: (in category 'private') ----- methodSourceAt: aNumber ^(self methodAt: aNumber) getSource asString! ----- Method: ECOverrideModel>>title (in category 'action') ----- title ^ '(override) ' , clazz superclass name! ----- Method: ECTypedModel>>initialize (in category 'initialize-release') ----- initialize super initialize. expanded := false. ! ----- Method: ECTypedModel>>initializeSelectors (in category 'private') ----- initializeSelectors self initializeSelectorsFor: clazz! ----- Method: ECTypedModel>>initializeSelectorsFor: (in category 'private') ----- initializeSelectorsFor: aClass |excludedClasses| selectors reset. excludedClasses := (expanded ifTrue: [#()] ifFalse: [Object withAllSuperclasses]). selectors addAll: ((aClass allSelectorsForCompletionWithout: excludedClasses) collect: [:each | ECSelectorEntry contents: each type: #selector])! ----- Method: ECTypedModel>>narrowWith: (in category 'action') ----- narrowWith: aString self narrowString: aString ; initializeSelectors. entries reset. self addToEntries: selectors! ----- Method: ECTypedModel>>theClass (in category 'action') ----- theClass ^clazz! ----- Method: ECTypedModel>>title (in category 'action') ----- title ^clazz name! ----- Method: ECTypedModel>>toggleExpand (in category 'action') ----- toggleExpand expanded := expanded not. self initializeSelectors. self narrowWith: narrowString! ECModel subclass: #ECUntypedModel instanceVariableNames: 'instVars localVars includeVariables includeSelectors classVars' classVariableNames: '' poolDictionaries: '' category: 'Ocompletion-ECModel'! !ECUntypedModel commentStamp: '<historical>' prior: 0! When no receiver class is known, I'm the right model. I store all temporary variables, instance variables of the selected class and all selectors in system. For performance reasons I only collect selectors when at least one character is known.! ECUntypedModel subclass: #ECUnseparatedModel instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Ocompletion-ECModel'! ----- Method: ECUnseparatedModel>>completionAt: (in category 'action') ----- completionAt: aNumber ^ (self at: aNumber) completion! ----- Method: ECUntypedModel class>>class:temporaries: (in category 'instance creation') ----- class: aClass temporaries: aCollection ^self class: aClass temporaries: aCollection additionals: #() variables: true selectors: true! ----- Method: ECUntypedModel class>>class:temporaries:additionals:variables:selectors: (in category 'instance creation') ----- class: aClass temporaries: aCollection additionals: additionalCollection variables: variablesBoolean selectors: selectorsBoolean | newInstance | newInstance := self basicNew initialize. newInstance setClass: aClass temporaries: aCollection additionals: additionalCollection variables: variablesBoolean selectors: selectorsBoolean. ^ newInstance! ----- Method: ECUntypedModel>>addAdditionals: (in category 'private') ----- addAdditionals: aCollection aCollection ifNil: [ ^self ]. aCollection do: [ :each | each isLocal ifTrue: [ localVars add: each value ] ifFalse: [ each isInstance ifTrue: [ instVars add: each value ] ifFalse: [ each isSelector ifTrue: [ selectors add: each value ] ] ] ]! ----- Method: ECUntypedModel>>addSelectors (in category 'private') ----- addSelectors self initializeSelectors; addToEntries: selectors! ----- Method: ECUntypedModel>>addVariables (in category 'private') ----- addVariables includeVariables ifFalse: [^ self]. self addToEntries: localVars. self addToEntries: instVars. self addToEntries: classVars! ----- Method: ECUntypedModel>>initialize (in category 'initialize-release') ----- initialize super initialize. localVars := OrderedCollection new. instVars := OrderedCollection new. classVars := OrderedCollection new. includeSelectors := true. includeVariables := true! ----- Method: ECUntypedModel>>initializeClassVars (in category 'initialize-release') ----- initializeClassVars (clazz isNil or: [ includeVariables not ]) ifTrue: [ ^ self ]. classVars := clazz theNonMetaClass allClassVarNames asOrderedCollection replace: [ :each | ECClassVarEntry contents: each type: #classVar ]! ----- Method: ECUntypedModel>>initializeInstVars (in category 'initialize-release') ----- initializeInstVars (clazz isNil or: [ includeVariables not ]) ifTrue: [ ^ self ]. instVars := clazz allInstVarNames asOrderedCollection replace: [ :each | ECInstVarEntry contents: each type: #instVar ]. instVars add: (ECSelfEntry contents: 'self' type: #self). instVars add: (ECSuperEntry contents: 'super' type: #super)! ----- Method: ECUntypedModel>>initializeSelectors (in category 'private') ----- initializeSelectors self resetSelectors. includeSelectors ifFalse: [ Smalltalk environment keysDo: [ :each | selectors add: (ECGlobalEntry contents: each type: #globalVar) ]. ^ self ]. narrowString ifEmpty: [ ^ self ]. ECSymbols contains: narrowString caseSensitive: ECPreferences caseSensitive do: [ :each | (includeVariables or: [ each first isLowercase ]) ifTrue: [ selectors add: (ECSelectorEntry contents: each type: #selector). selectors size > 500 ifTrue: [ ^ self ] ] ]! ----- Method: ECUntypedModel>>message (in category 'accessing') ----- message ^ (includeSelectors and: [ narrowString isEmpty ]) ifTrue: [ selectors size = 500 ifTrue: [ 'more...' ] ifFalse: [ 'press key for selectors' ] ] ifFalse: [ super message ]! ----- Method: ECUntypedModel>>narrowString: (in category 'initialize-release') ----- narrowString: aString (narrowString isEmpty or: [aString isEmpty or: [aString first ~= narrowString first]]) ifTrue: [self reset]. super narrowString: aString! ----- Method: ECUntypedModel>>narrowWith: (in category 'action') ----- narrowWith: aString self narrowString: aString. self resetEntries. self addVariables. self addSelectors! ----- Method: ECUntypedModel>>noVariables (in category 'initialize-release') ----- noVariables includeVariables := false.! ----- Method: ECUntypedModel>>setClass:temporaries:additionals:variables:selectors: (in category 'initialize-release') ----- setClass: aClass temporaries: aCollection additionals: additionalCollection variables: variablesBoolean selectors: selectorsBoolean includeVariables := variablesBoolean. includeSelectors := selectorsBoolean. clazz := aClass. self initializeInstVars. self initializeClassVars. includeVariables ifTrue: [ localVars := aCollection. self addAdditionals: additionalCollection ] ifFalse: [ localVars := OrderedCollection new ]. self resetEntries; addVariables; addSelectors! ECUntypedModel subclass: #OModel instanceVariableNames: 'table expand nextModel cachedEntries ctable' classVariableNames: '' poolDictionaries: '' category: 'Ocompletion'! ----- Method: OModel>>addEntry: (in category 'accessing') ----- addEntry: ent (self tableForEntry: ent) addEntry: ent ! ----- Method: OModel>>addSelectors (in category 'accessing') ----- addSelectors ! ----- Method: OModel>>at: (in category 'accessing') ----- at: aNumber ^ self entries at: (aNumber max: 1) ! ----- Method: OModel>>completionAt: (in category 'accessing') ----- completionAt: aNumber | entry | "when an entry is selected, update its date (for inlined messages which do not appear in the method's body" entry := (self at: aNumber) completion. self addEntry: entry. ^ entry separateKeywords, ' '.! ----- Method: OModel>>contract (in category 'accessing') ----- contract expand := false. nextModel := nil.! ----- Method: OModel>>entries (in category 'accessing') ----- entries | ent more | entries ifNotEmpty: [^expand not & (entries size > 3) ifTrue: [entries first: 3] ifFalse: [entries ]]. ent := (narrowString notEmpty and: [narrowString first isUppercase]) ifTrue: [ctable entriesMatching: narrowString] ifFalse: [includeSelectors ifTrue: [table entriesMatching: narrowString] ifFalse: [ent := super entries]]. ent := ent asOrderedCollection. ent size > 7 ifTrue: [ent := ent first: 7. ]. ent addAll: (self nextModel entries reject: [:e | ent anySatisfy: [:ea | ea contents = e contents]]). entries := ent. ^ expand not & (ent size > 3) ifTrue: [ent first: 3] ifFalse: [ent]! ----- Method: OModel>>entryCount (in category 'accessing') ----- entryCount ^ self entries size! ----- Method: OModel>>expand (in category 'accessing') ----- expand expand := true.! ----- Method: OModel>>initialize (in category 'accessing') ----- initialize super initialize. self contract. table := OCompletionTable default. ctable := OCompletionTable classes.! ----- Method: OModel>>initializeSelectors (in category 'accessing') ----- initializeSelectors! ----- Method: OModel>>narrowWith: (in category 'accessing') ----- narrowWith: aString self narrowString: aString. self resetEntries. self addVariables. self nextModel ifNotNil: [:nm | nm narrowWith: aString].! ----- Method: OModel>>nextModel (in category 'accessing') ----- nextModel ^ expand ifTrue: [nextModel ifNil: [nextModel := ECUntypedModel class: clazz temporaries: localVars additionals: #() variables: includeVariables selectors: includeSelectors. nextModel narrowWith: narrowString] ifNotNil: [nextModel]] ifFalse: [OEmptyModel new]! ----- Method: OModel>>noNextModel (in category 'accessing') ----- noNextModel nextModel := OEmptyModel new.! ----- Method: OModel>>resetEntries (in category 'accessing') ----- resetEntries super resetEntries. "table ifNotNil: [table reset]. ctable ifNotNil: [ctable reset]"! ----- Method: OModel>>table (in category 'accessing') ----- table ^ table! ----- Method: OModel>>tableForEntry: (in category 'accessing') ----- tableForEntry: ent ^ (ent notEmpty and: [ent first isUppercase]) ifTrue: [ctable] ifFalse: [table]! ----- Method: OModel>>useUniqueTable (in category 'accessing') ----- useUniqueTable table := OCompletionTable new entriesPerPrefix: 20. ! Object subclass: #ECPreferences instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Ocompletion-ECSqueak'! ECPreferences class instanceVariableNames: 'enabled caseSensitive smartCharacters smartCharactersMapping useECompletionInsteadOfOCompletion matchSubStrings keepSelectionAfterAddingSmartCharacters'! ECPreferences class instanceVariableNames: 'enabled caseSensitive smartCharacters smartCharactersMapping useECompletionInsteadOfOCompletion matchSubStrings keepSelectionAfterAddingSmartCharacters'! ----- Method: ECPreferences class>>caseSensitive (in category 'accessing - preferences') ----- caseSensitive <preference: 'Case Sensitive' category: 'OCompletion' description: 'Decide if you want OCompletion to be case sensitive or not.' type: #Boolean> ^caseSensitive ifNil: [ true ] ! ----- Method: ECPreferences class>>caseSensitive: (in category 'accessing - preferences') ----- caseSensitive: aBoolean caseSensitive := aBoolean! ----- Method: ECPreferences class>>enabled (in category 'accessing - preferences') ----- enabled <preference: 'Enable OCompletion' category: 'OCompletion' description: 'Enable or disable OCompletion in browsers, debuggers and workspaces.' type: #Boolean> ^enabled ifNil: [ true ] ! ----- Method: ECPreferences class>>enabled: (in category 'accessing - preferences') ----- enabled: aBoolean enabled := aBoolean! ----- Method: ECPreferences class>>initialize (in category 'initialization') ----- initialize smartCharactersMapping := Dictionary new. smartCharactersMapping at: $( put: $); at: $[ put: $]; at: ${ put: $}; at: $" put: $"; at: $' put: $'! ----- Method: ECPreferences class>>keepSelectionAfterAddingSmartCharacters (in category 'accessing - preferences') ----- keepSelectionAfterAddingSmartCharacters <preference: 'Keep Selection After Adding Smart Characters' category: 'OCompletion' description: 'Decide if you want OCompletion to keep the text selected after inserting smart characters.' type: #Boolean> ^keepSelectionAfterAddingSmartCharacters ifNil: [ false ]! ----- Method: ECPreferences class>>keepSelectionAfterAddingSmartCharacters: (in category 'accessing - preferences') ----- keepSelectionAfterAddingSmartCharacters: aBoolean keepSelectionAfterAddingSmartCharacters := aBoolean! ----- Method: ECPreferences class>>listFont (in category 'accessing') ----- listFont Smalltalk at: #StandardFonts ifPresent: [ :standardFonts | "Pharo" ^standardFonts listFont ]. Smalltalk at: #Preferences ifPresent: [ :preferences | "Squeak" ^preferences standardListFont ]! ----- Method: ECPreferences class>>matchSubStrings (in category 'accessing - preferences') ----- matchSubStrings <preference: 'Match SubStrings' category: 'OCompletion' description: 'Decide if you want OCompletion to perform subString searches, which can be slower, rather than only front-matching selectors.' type: #Boolean> ^ matchSubStrings ifNil: [ false ]! ----- Method: ECPreferences class>>matchSubStrings: (in category 'accessing - preferences') ----- matchSubStrings: aBoolean matchSubStrings := aBoolean! ----- Method: ECPreferences class>>menuFont (in category 'accessing') ----- menuFont Smalltalk at: #StandardFonts ifPresent: [ :standardFonts | "Pharo" ^standardFonts menuFont ]. Smalltalk at: #Preferences ifPresent: [ :preferences | "Squeak" ^preferences standardMenuFont ]! ----- Method: ECPreferences class>>menuSelectionColor (in category 'accessing') ----- menuSelectionColor Smalltalk at: #UITheme ifPresent: [ :uiTheme | "Pharo" ^uiTheme current settings selectionColor ]. Smalltalk at: #UserInterfaceTheme ifPresent: [ :userInterfaceTheme | "Squeak 5.1+" (userInterfaceTheme current get: #selectionColor for: MenuItemMorph) ifNotNil: [ :color | ^color ] ]. Smalltalk at: #Preferences ifPresent: [ :preferences | "Squeak pre 5.1" (preferences respondsTo: #menuSelectionColor) ifTrue: [ ^preferences menuSelectionColor ] ]. "Fallback" ^Color r: 0.4 g: 0.5 b: 0.7! ----- Method: ECPreferences class>>smartCharacters (in category 'accessing - preferences') ----- smartCharacters <preference: 'Smart Characters' category: 'OCompletion' description: 'Decide if you want OCompletion to use smart characters, e.g, to automatically close brackets.' type: #Boolean> ^smartCharacters ifNil: [ true ]! ----- Method: ECPreferences class>>smartCharacters: (in category 'accessing - preferences') ----- smartCharacters: aBoolean smartCharacters := aBoolean! ----- Method: ECPreferences class>>smartCharactersMapping (in category 'accessing') ----- smartCharactersMapping ^ smartCharactersMapping! ----- Method: ECPreferences class>>smartCharactersMapping: (in category 'accessing') ----- smartCharactersMapping: aDictionary smartCharactersMapping := aDictionary! ----- Method: ECPreferences class>>useECompletionInsteadOfOCompletion (in category 'accessing - preferences') ----- useECompletionInsteadOfOCompletion <preference: 'Use eCompletion instead of OCompletion' category: 'OCompletion' description: 'Decide if you want to use eCompletion in newly opened tools instead of OCompletion.' type: #Boolean> ^useECompletionInsteadOfOCompletion ifNil: [ false ] ! ----- Method: ECPreferences class>>useECompletionInsteadOfOCompletion: (in category 'accessing - preferences') ----- useECompletionInsteadOfOCompletion: aBoolean useECompletionInsteadOfOCompletion := aBoolean ! Object subclass: #ECSymbols instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Ocompletion-ECSqueak'! ----- Method: ECSymbols class>>contains:caseSensitive:do: (in category 'as yet unclassified') ----- contains: aString caseSensitive: aBoolean do: aBlock | separators | separators := CharacterSet separators. Symbol allSymbolTablesDo: [ :each | ((each indexOfAnyOf: separators startingAt: 1) = 0 and: [ each includesSubstring: aString caseSensitive: aBoolean]) ifTrue: [ aBlock value: each ] ]! Object subclass: #ECTypeInfo instanceVariableNames: 'type kind temporaryOffset' classVariableNames: '' poolDictionaries: '' category: 'Ocompletion-ECModel'! !ECTypeInfo commentStamp: '<historical>' prior: 0! I'm used in ECInstVarTypeGuesser to store found type informations.! ----- Method: ECTypeInfo class>>definedByLiteral: (in category 'as yet unclassified') ----- definedByLiteral: aClass | newInstance | newInstance := self new. newInstance setType: aClass kind: 1. ^ newInstance! ----- Method: ECTypeInfo class>>definedByMessageSend: (in category 'as yet unclassified') ----- definedByMessageSend: aClass | newInstance | newInstance := self new. newInstance setType: aClass kind: 2. ^ newInstance! ----- Method: ECTypeInfo class>>definedByTemporaryVar: (in category 'as yet unclassified') ----- definedByTemporaryVar: anInteger | newInstance | newInstance := self new. newInstance setType: nil kind: 3. newInstance temporaryOffset: anInteger. ^ newInstance! ----- Method: ECTypeInfo>>isDefinedByMessageSend (in category 'as yet unclassified') ----- isDefinedByMessageSend ^kind == 2! ----- Method: ECTypeInfo>>isDefinedByTemporary (in category 'as yet unclassified') ----- isDefinedByTemporary ^ kind == 3! ----- Method: ECTypeInfo>>priority (in category 'as yet unclassified') ----- priority ^kind! ----- Method: ECTypeInfo>>setType:kind: (in category 'as yet unclassified') ----- setType: aClass kind: anInteger type := aClass. kind := anInteger! ----- Method: ECTypeInfo>>temporaryOffset (in category 'as yet unclassified') ----- temporaryOffset ^temporaryOffset! ----- Method: ECTypeInfo>>temporaryOffset: (in category 'as yet unclassified') ----- temporaryOffset: anInteger temporaryOffset := anInteger! ----- Method: ECTypeInfo>>type (in category 'as yet unclassified') ----- type ^type! ----- Method: ECTypeInfo>>type: (in category 'as yet unclassified') ----- type: aClass type := aClass! Object subclass: #OCompletionTable instanceVariableNames: 'table numberofEntries' classVariableNames: '' poolDictionaries: '' category: 'Ocompletion'! OCompletionTable class instanceVariableNames: 'table ctable'! OCompletionTable class instanceVariableNames: 'table ctable'! ----- Method: OCompletionTable class>>classes (in category 'accessing') ----- classes ^ ctable ifNil: [ctable := self new entriesPerPrefix: 40]! ----- Method: OCompletionTable class>>default (in category 'accessing') ----- default ^ table ifNil: [table := self new entriesPerPrefix: 40]! ----- Method: OCompletionTable class>>initialize (in category 'initialize-release') ----- initialize SystemChangeNotifier uniqueInstance noMoreNotificationsFor: self; "avoid double registration" notify: self ofSystemChangesOfItem: #method using: #methodChanged:. self initializeTable.! ----- Method: OCompletionTable class>>initializeTable (in category 'initialize-release') ----- initializeTable self initializeWithInlinedMessages. self initializeWithPackages. self initializeWithRecentChanges.! ----- Method: OCompletionTable class>>initializeWithInlinedMessages (in category 'initialize-release') ----- initializeWithInlinedMessages #(ifTrue: ifFalse: whileTrue: whileFalse: ifNil: ifNotNil: to:do: at:put: next: next size atEnd class value value: do: new: new) do: [:e | self default addEntry: e].! ----- Method: OCompletionTable class>>initializeWithPackages (in category 'initialize-release') ----- initializeWithPackages | pkgs | pkgs := 'Kernel* Collection*'. pkgs ifNotNil: [ (pkgs findTokens: ' ' ) do: [:e | self default quickFillWithCategoriesMatching: e ]] ! ----- Method: OCompletionTable class>>initializeWithRecentChanges (in category 'initialize-release') ----- initializeWithRecentChanges ORecentChanges new readRecentChanges fillCompletionTable.! ----- Method: OCompletionTable class>>lookForOB (in category 'as yet unclassified') ----- lookForOB (Smalltalk at: #OBTextPanel ifAbsent: [^self]) compile: 'createCompletionController ^(ECPreferences useECompletionInsteadOfOCompletion ifFalse: [ OController ] ifTrue: [ ECController ]) model: self'! ----- Method: OCompletionTable class>>methodChanged: (in category 'system changes') ----- methodChanged: event | default | (event isRemoved or: [event isRecategorized or: [event item isNil]]) ifTrue: [^self]. "event item isNil true if syntax errors are proceeded through" (default := self default) totalNumberOfEntries < 200 ifTrue: [default quickFillWithCategoryOf: event itemClass]. default totalNumberOfEntries < 500 ifTrue: [default quickFillWithClass: event itemClass]. default justCompiled: event itemSelector in: event itemClass! ----- Method: OCompletionTable class>>unload (in category 'initialize-release') ----- unload SystemChangeNotifier uniqueInstance noMoreNotificationsFor: self. table := nil.! ----- Method: OCompletionTable>>addEntry: (in category 'as yet unclassified') ----- addEntry: aString | d | d := DateAndTime now. self addEntry: aString date: d! ----- Method: OCompletionTable>>addEntry:date: (in category 'as yet unclassified') ----- addEntry: aString date: d | lists | lists := self listsForPrefix: aString. lists do: [:e | e addEntry: aString date: d] ! ----- Method: OCompletionTable>>classesInCategory: (in category 'as yet unclassified') ----- classesInCategory: category ^ (Smalltalk organization listAtCategoryNamed: category) collect: [:className | Smalltalk at: className]! ----- Method: OCompletionTable>>compiled:in:date: (in category 'as yet unclassified') ----- compiled: selector in: class date: date | method | self addEntry: selector date: date. self class classes addEntry: class theNonMetaClass name date: date. (class canUnderstand: selector) ifFalse: [ ^self ]. method := class compiledMethodAt: selector ifAbsent: [ ^self ]. method messages do: [ :m | self addEntry: m date: date ]. method literals do: [ :each | (each isVariableBinding and: [ each key notNil and: [ each key first isUppercase ] ]) ifTrue: [ self class classes addEntry: each key date: date ] ]! ----- Method: OCompletionTable>>entriesMatching: (in category 'as yet unclassified') ----- entriesMatching: prefix | list | list := self listForPrefix: prefix. ^ list entriesMatching: prefix! ----- Method: OCompletionTable>>entriesPerPrefix: (in category 'as yet unclassified') ----- entriesPerPrefix: n numberofEntries := n! ----- Method: OCompletionTable>>fillRate (in category 'as yet unclassified') ----- fillRate ^ self totalNumberOfEntries / self maxNumberOfEntries ! ----- Method: OCompletionTable>>initialize (in category 'initialize-release') ----- initialize table := Dictionary new.! ----- Method: OCompletionTable>>justCompiled:in: (in category 'as yet unclassified') ----- justCompiled: selector in: class | date | date := DateAndTime now. self compiled: selector in: class date: date! ----- Method: OCompletionTable>>listForPrefix: (in category 'as yet unclassified') ----- listForPrefix: aString | prefix | aString isEmpty ifTrue: [^ OEntryList ofSize: numberofEntries]. prefix := aString size = 1 ifTrue: [ aString first asLowercase asString] ifFalse: [(aString first: 2) collect: [:e | e asLowercase]]. ^ table at: prefix ifAbsentPut: [ OEntryList ofSize: numberofEntries ]! ----- Method: OCompletionTable>>listsForPrefix: (in category 'as yet unclassified') ----- listsForPrefix: aString | prefixes | aString isEmpty ifTrue: [^ Array with: (OEntryList ofSize: numberofEntries)]. prefixes := OrderedCollection with: aString first asLowercase asString. aString size > 1 ifTrue: [prefixes add: ((aString first: 2) collect: [:e | e asLowercase])]. ^ prefixes collect: [:prefix | table at: prefix ifAbsentPut: [ OEntryList ofSize: numberofEntries ]]! ----- Method: OCompletionTable>>maxNumberOfEntries (in category 'as yet unclassified') ----- maxNumberOfEntries ^ 26 * 26 * numberofEntries ! ----- Method: OCompletionTable>>numberOfEntries (in category 'as yet unclassified') ----- numberOfEntries ^ numberofEntries! ----- Method: OCompletionTable>>quickFillWithCategoriesMatching: (in category 'as yet unclassified') ----- quickFillWithCategoriesMatching: pattern (Smalltalk organization categoriesMatching: pattern) do: [:category | (self classesInCategory: category) do: [:e | self quickFillWithClass: e]]! ----- Method: OCompletionTable>>quickFillWithCategoryOf: (in category 'as yet unclassified') ----- quickFillWithCategoryOf: cls (self classesInCategory: cls theNonMetaClass category) do: [:e | self quickFillWithClass: e]! ----- Method: OCompletionTable>>quickFillWithClass: (in category 'as yet unclassified') ----- quickFillWithClass: cls cls methodsDo: [:e | self justCompiled: e selector in: cls] ! ----- Method: OCompletionTable>>reset (in category 'accessing') ----- reset table := Dictionary new.! ----- Method: OCompletionTable>>totalNumberOfEntries (in category 'as yet unclassified') ----- totalNumberOfEntries ^ table inject: 0 into: [:total :list | total + list numEntries]! Object subclass: #OEmptyModel instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Ocompletion'! ----- Method: OEmptyModel>>entries (in category 'as yet unclassified') ----- entries ^ Array new! ----- Method: OEmptyModel>>entryCount (in category 'as yet unclassified') ----- entryCount ^ 0! ----- Method: OEmptyModel>>narrowString: (in category 'as yet unclassified') ----- narrowString: string! ----- Method: OEmptyModel>>narrowWith: (in category 'as yet unclassified') ----- narrowWith: string ! Object subclass: #OEntryList instanceVariableNames: 'size entries entryHead' classVariableNames: '' poolDictionaries: '' category: 'Ocompletion'! ----- Method: OEntryList class>>ofSize: (in category 'as yet unclassified') ----- ofSize: n ^ self new setSize: n; yourself! ----- Method: OEntryList>>addEntry: (in category 'adding') ----- addEntry: aSymbol self addEntry: aSymbol date: DateAndTime now! ----- Method: OEntryList>>addEntry:date: (in category 'adding') ----- addEntry: aSymbol date: aDate | entry currentEntry | entry := entries at: aSymbol ifAbsent: nil. entry ifNotNil: [ entry unlink ] ifNil: [ entry := ODatedEntry contents: aSymbol type: #selector. entries at: aSymbol put: entry ]. entry date: aDate. currentEntry := entryHead previous. [ currentEntry == entryHead or: [ currentEntry date <= aDate ] ] whileFalse: [ currentEntry := currentEntry previous ]. currentEntry link: entry. entries size > size ifTrue: [ entry := entryHead next unlink. entries removeKey: entry contents ]! ----- Method: OEntryList>>entriesMatching: (in category 'accessing') ----- entriesMatching: prefix ^Array new: entries size // 4 + 1 streamContents: [ :stream | | entry | entry := self firstEntry. [ entry == entryHead ] whileFalse: [ (entry matches: prefix) ifTrue: [ stream nextPut: entry ]. entry := entry previous ] ]! ----- Method: OEntryList>>first (in category 'accessing') ----- first ^self firstEntry contents! ----- Method: OEntryList>>firstEntry (in category 'accessing') ----- firstEntry ^ entryHead previous! ----- Method: OEntryList>>last (in category 'accessing') ----- last ^self lastEntry contents! ----- Method: OEntryList>>lastEntry (in category 'accessing') ----- lastEntry ^ entryHead next! ----- Method: OEntryList>>numEntries (in category 'accessing') ----- numEntries ^ entries size! ----- Method: OEntryList>>setSize: (in category 'as yet unclassified') ----- setSize: n size := n. entries := Dictionary new: n. entryHead := ODatedEntry contents: #'' size type: #selector. entryHead next: entryHead; previous: entryHead. ! Object subclass: #ORecentChanges instanceVariableNames: 'records' classVariableNames: '' poolDictionaries: '' category: 'Ocompletion'! ----- Method: ORecentChanges>>fillCompletionTable (in category 'as yet unclassified') ----- fillCompletionTable records do: [:e | self fillCompletionTable: OCompletionTable default withRecord: e]! ----- Method: ORecentChanges>>fillCompletionTable:withRecord: (in category 'as yet unclassified') ----- fillCompletionTable: table withRecord: r r methodClass ifNotNil: [:cls | table compiled: r methodSelector in: cls date: r timeStamp]! ----- Method: ORecentChanges>>readRecentChanges (in category 'as yet unclassified') ----- readRecentChanges | changeFile end changeList | changeFile := (SourceFiles at: 2) readOnlyCopy setConverterForCode. end := changeFile size. changeList := Cursor read showWhile: [ ChangeList new scanFile: changeFile from: (0 max: end - 50000) to: end ]. records := changeList changeList select: [:e | e type = #method]. !

1 0

Squeak 4.20.7 for OpenIndiana
by stes＠telenet.be 01 Jan '24

01 Jan '24

-----BEGIN PGP SIGNED MESSAGE----- Hash: SHA256 Hello, There is a new version of Squeak in the OpenIndiana repository : Squeak version 4.20.7 This version is a slightly patched version of the subversion C code sources. Squeak for OpenIndiana is built with : developer/cmake(a)3.28.1 developer/gcc-13(a)13.2.0 and using the latest versions of dependencies such as cairo, pango, freetype-2, pulseaudio and others. More info at: http://docs.openindiana.org/handbook/community/squeak/index.html Regards, David Stes -----BEGIN PGP SIGNATURE----- Version: GnuPG v2 iQEcBAEBCAAGBQJlkvQTAAoJEJUsOki4xWlQDAgH/jZSxop9bfPDLszss07xLJ7J o5QKmfejSQXuXMxPGYpv8ve8bjXSxi8dpkx6x01bFdkBO28AgBNOrFxqEJ2o5FJz Lpfyj6J6P2QTe1lHhzdG9OrknIg7/XCJIUsElGS9JnTtIHbJu5yVykShgoZAA1D4 WdVkmQ6Vkux3orzjytr1uXtR7fwcYObxY2f8Z3nZVpyzoDc921AIinEo9W0ndmmL xQqAm8uSuNKa12o8JZ+o9RsFejSl3xpRj61Q+r+mFrk162gRbOm+WTt8XFPCLpAC TnYZRPvrhHaqhmwKdfkwAzMXe0L0ByPBkez5i61q+Cxp9+WvCUW474hRJfsDplw= =0HpT -----END PGP SIGNATURE-----

1 0