================================================================== pub/Smalltalk/Squeak/Goodies/Object-vs exce... base patch.st ================================================================== 'From Squeak 1.2 of June 29, 1997 on 19 August 1997 at 7:34:44 pm'! !Object methodsFor: 'vs exceptions base patch' stamp: 'taj 8/19/97 19:31'! doesNotUnderstand: aMessage Error signal: aMessage printString! ! !Object methodsFor: 'vs exceptions base patch' stamp: 'taj 8/19/97 19:32'! error: aString Error signal: aString! ! ================================================================== pub/Smalltalk/Squeak/Goodies/deepSenders.st ================================================================== ''This fileIn augments the functionality of 'senders' so literal arrays will be searched recursively (like VW)."! 'From Squeak 1.21 of July 17, 1997 on 27 September 1997 at 4:14:24 pm'! !Object methodsFor: 'browsing' stamp: 'sn 9/27/97 16:14'! containsLiteral: aLiteral ^self == aLiteral! ! 'From Squeak 1.21 of July 17, 1997 on 27 September 1997 at 4:16:30 pm'! !Array methodsFor: 'browsing' stamp: 'sn 9/27/97 16:16'! containsLiteral: aLiteral self == aLiteral ifTrue: [^true]. 1 to: self size do: [:index | ((self at: index) containsLiteral: aLiteral) ifTrue: [^true]]. ^false! ! 'From Squeak 1.21 of July 17, 1997 on 27 September 1997 at 4:28:15 pm'! !CompiledMethod methodsFor: 'browsing' stamp: 'sn 9/27/97 16:25'! containsLiteral: aLiteral | literals | literals _ self literals. 1 to: literals size do: [:index | ((literals at: index) containsLiteral: aLiteral) ifTrue: [^true]]. ^false! ! 'From Squeak 1.21 of July 17, 1997 on 27 September 1997 at 4:30:58 pm'! !Behavior methodsFor: 'testing method dictionary' stamp: 'sn 9/27/97 16:29'! whichSelectorsReferTo: literal special: specialFlag byte: specialByte "Answer a set of selectors whose methods access the argument as a literal." | who method | who _ Set new. methodDict associationsDo: [:assn | method _ assn value. ((method containsLiteral: literal) or: [specialFlag and: [method scanFor: specialByte]]) ifTrue: [((literal isKindOf: Association) not or: [method sendsToSuper not or: [method literals allButLast includes: literal]]) ifTrue: [who add: assn key]]]. ^who! ! ================================================================== pub/Smalltalk/Squeak/Goodies/fastdebug.st ================================================================== ''This fileIn contains a first draft of a fast debugger. This comment is in three sections: (1) general idea, (2) how it should work, and (3) how it works now. General Idea The general idea of fast debugging is to replace the call to the bytecode simulator with a real perform:. There is only one main pitfall to doing this: non-local ^-returns through blocks. If a non-local block return is taken to a context below the currently selected context in the debugger, the debugger will lose control of execution-- the process will just go on executing. So these 'runaway' blocks need to be caught. There are choices as to how non-local returns may be intercepted: one may intercept calls to value, or intercept ^-returns themselves; there may be other possibilities as well. I've opted to check all ^-returns in blocks. This is done by sending a message just before the ^-return is about to occur. The idea here is that a message is necessary because the image should handle all the non-local phenomena of an ^-return. This especially includes traversing all the intervening contexts between the returning block and the resumption point, the block's home's sender. I think we need to allow unwinding to occur if it is requested. This is something that clearly should not be handled by the VM alone. The message is also necessary in order for the debugger to regain control of execution. Finally, sending a message is a reflective operation: we are notifying the image that a previously 'unconscious' operation, an ^-return, is going to occur. How is should work I think the VM should send a message to the returning block when it executes an ^-return bytecode. The image can then futz around with safety, interception, unwinding, and whatever navel-gazing it wants. Finally, (barring continuations, which I would prefer), the VM should provide a primitive which actually performs the ^-return. This primitive would take one argument, the return value, and would do the usual thing: push the return value on the resuming context's stack and make that context the active context. Of course, method contexts executing an ^-return should behave as they do now, since that is just return to sender, a local operation. In the case of special bytecodes like ^self, ^true, and so on, there are several options, one of which would be for the VM to send a slightly different message to the returning block-- a message with an argument which is the return value. How it works now This fileIn is a somewhat laborious simulation at the image level of what is described above for the VM. The idea is to find all ^-returns in real (non-inlined) blocks and transform them as follows: ^expr --> ^expr upArrow Most of the code in this fileIn is actually devoted to accomplishing this alone. Also, sending upArrow to the return value rather than the context was done just for brevity; a gyration is done to get the context itself. Once we get the block itself, we need to determine as quickly as possible whether this block may cause a runaway in a debugger. This is done in BlockContext|doUpArrow:. An unused instance variable, receiverMap, is used as a mark for suspicious home contexts. The debugger marks all the contexts on its stack ahead of time, so when the ^ is taken at full speed, the mark will already be there. If the home is unmarked, execution resumes (this is where I would like to call the primitive described above). If the home is marked, the return is simulated and execution continues as it would in the debugger."! (Smalltalk allImplementorsOf: #upArrow) isEmpty not ifTrue: [self error: 'Fast debugger already loaded. Close this notifier']! 'From Squeak 1.21 of July 17, 1997 on 4 October 1997 at 5:57:50 pm'! !BlockContext methodsFor: 'instruction decoding' stamp: 'sn 9/26/97 18:49'! blockReturnTop "Simulate the interpreter's action when a ReturnTopOfStack bytecode is encountered in the receiver." | save dest | save _ home. "Needed because return code will nil it" dest _ super return: self pop to: self sender. home _ save. sender _ nil. ^dest! ! !BlockContext methodsFor: 'fast debugger' stamp: 'sn 10/4/97 17:51'! doUpArrow: returnValue | debugger returnContext stopContext | self home receiverMap == true ifFalse: [^returnValue]. debugger _ self getDebugger. debugger isNil ifTrue: [self return: returnValue]. "Just resume" returnContext _ super return: returnValue to: self home sender. stopContext _ debugger selectedContext catchCallee: returnContext. debugger resetContext: stopContext. debugger return! ! !BlockContext methodsFor: 'fast debugger' stamp: 'sn 9/25/97 21:29'! makeReturnBlock ^[:returnValue | ^returnValue]! ! !BlockContext methodsFor: 'fast debugger' stamp: 'sn 9/25/97 21:31'! return: returnValue "Execute a method return from the receiver." | returnBlock | returnBlock _ self makeReturnBlock. returnBlock home swapSender: self home sender. returnBlock value: returnValue! ! !BlockContext methodsFor: 'fast debugger' stamp: 'sn 9/26/97 19:19'! return: value to: sendr "Simulate the return of value to sendr." | debugger returnContext stopContext | debugger _ self getDebugger. debugger isNil ifTrue: [^super return: value to: sendr]. returnContext _ super return: value to: sendr. stopContext _ debugger selectedContext completeCallee: returnContext. debugger resetContext: stopContext. debugger return! ! 'From Squeak 1.21 of July 17, 1997 on 3 October 1997 at 2:46:06 pm'! !MethodContext methodsFor: 'fast debugger' stamp: 'sn 10/1/97 21:20'! doUpArrow: returnValue | debugger | debugger _ self getDebugger. debugger isNil ifTrue: [self error: 'No Debugger found']. debugger selectedContext doUpArrow: returnValue! ! !MethodContext methodsFor: 'fast debugger' stamp: 'sn 10/1/97 21:16'! getDebugger "Look down my stack for the Debugger that launched me." | ctxt | ctxt _ self. [ctxt == nil or: [ctxt receiver class == Debugger]] whileFalse: [ctxt _ ctxt sender]. ^ctxt isNil ifTrue: [nil] ifFalse: [ctxt receiver] ! ! !MethodContext methodsFor: 'fast debugger' stamp: 'sn 10/3/97 14:32'! receiverMap ^receiverMap! ! !MethodContext methodsFor: 'fast debugger' stamp: 'sn 10/3/97 14:32'! receiverMap: aBoolean receiverMap _ aBoolean! ! 'From Squeak 1.21 of July 17, 1997 on 3 October 1997 at 3:19:10 pm'! !ContextPart methodsFor: 'fast debugger' stamp: 'sn 9/26/97 19:12'! catchCallee: aContext "Execute bytecodes until a return to the receiver." | ctxt current | current _ nil. self class initPrimitives. ctxt _ aContext. [ctxt == current or: [ctxt hasSender: self]] whileTrue: [current _ ctxt. ctxt _ ctxt leap]. ^ctxt leapToSendOrReturn! ! !ContextPart methodsFor: 'system simulation' stamp: 'sn 9/26/97 19:12'! completeCallee: aContext "Simulate the execution of bytecodes until a return to the receiver." | ctxt current | current _ nil. self class initPrimitives. ctxt _ aContext. [ctxt == current or: [ctxt hasSender: self]] whileTrue: [current _ ctxt. ctxt _ ctxt step]. ^ctxt stepToSendOrReturn! ! !ContextPart methodsFor: 'fast debugger' stamp: 'sn 9/24/97 22:56'! getDebugger "Answer the Debugger containing the receiver, if any." | bottom debuggers | bottom _ self home stackBottom. debuggers _ Debugger allInstances select: [:debugger | debugger receiverInspector notNil and: [debugger selectedContext stackBottom == bottom]]. ^debuggers isEmpty ifTrue: [nil] ifFalse: [debuggers first]! ! !ContextPart methodsFor: 'fast debugger' stamp: 'sn 9/23/97 18:01'! leap "Execute the receiver's next bytecode. Answer the context that would be the active context after this bytecode." ^self leapNextInstructionFor: self! ! !ContextPart methodsFor: 'fast debugger' stamp: 'sn 9/23/97 17:53'! leap: selector super: superFlag numArgs: numArgs "Execute the action of bytecodes that send a message with selector, selector. The argument, superFlag, tells whether the receiver of the message was specified with 'super' in the source method. The arguments of the message are found in the top numArgs locations on the stack and the receiver just below them." | receiver arguments value | arguments _ Array new: numArgs. numArgs to: 1 by: -1 do: [ :i | arguments at: i put: self pop]. receiver _ self pop. (selector == #halt or: [selector == #halt:]) ifTrue: [self error: 'Cant simulate halt. Proceed to bypass it.'. self push: nil. ^self]. ^selector == #blockCopy: ifTrue: [self push: ((BlockContext new: receiver size) home: receiver home startpc: pc + 2 nargs: arguments first)] ifFalse: [value _ receiver perform: selector withArguments: arguments asArray. self push: value. self]! ! !ContextPart methodsFor: 'fast debugger' stamp: 'sn 9/23/97 18:18'! leapToSendOrReturn "Excucute bytecodes until either sending a message or returning a value to the receiver (that is, until switching contexts)." [self willReallySend | self willReturn] whileFalse: [self leap]! ! !ContextPart methodsFor: 'fast debugger' stamp: 'sn 10/3/97 14:45'! markForCatch "Mark the receiver as being in a Debugger, and potentially a place where leaping should stop." self home receiverMap: true! ! !ContextPart methodsFor: 'fast debugger' stamp: 'sn 10/3/97 14:48'! markStackForCatch "Mark the receiver and its entire sender chain downwards as being possible landing sites of a block ^-return. A Debugger is probably being opened on the receiver." | ctxt | ctxt _ self. [ctxt == nil] whileFalse: [ctxt markForCatch. ctxt _ ctxt sender]. ^ctxt! ! !ContextPart methodsFor: 'controlling' stamp: 'sn 9/26/97 18:55'! return: value to: sendr "Simulate the return of value to sendr." "self releaseTo: sendr." ^sendr push: value! ! !ContextPart methodsFor: 'fast debugger' stamp: 'sn 9/24/97 22:48'! stackBottom "Answer the bottom of the stack the receiver is in." | ctxt | ctxt _ self. [ctxt sender == nil] whileFalse: [ctxt _ ctxt sender]. ^ctxt! ! 'From Squeak 1.21 of July 17, 1997 on 27 September 1997 at 4:14:24 pm'! !Object methodsFor: 'browsing' stamp: 'sn 9/27/97 16:14'! containsLiteral: aLiteral ^self == aLiteral! ! 'From Squeak 1.21 of July 17, 1997 on 27 September 1997 at 4:16:30 pm'! !Array methodsFor: 'browsing' stamp: 'sn 9/27/97 16:16'! containsLiteral: aLiteral self == aLiteral ifTrue: [^true]. 1 to: self size do: [:index | ((self at: index) containsLiteral: aLiteral) ifTrue: [^true]]. ^false! ! 'From Squeak 1.21 of July 17, 1997 on 27 September 1997 at 4:28:15 pm'! !CompiledMethod methodsFor: 'browsing' stamp: 'sn 9/27/97 16:25'! containsLiteral: aLiteral | literals | literals _ self literals. 1 to: literals size do: [:index | ((literals at: index) containsLiteral: aLiteral) ifTrue: [^true]]. ^false! ! 'From Squeak 1.21 of July 17, 1997 on 27 September 1997 at 4:30:58 pm'! !Behavior methodsFor: 'testing method dictionary' stamp: 'sn 9/27/97 16:29'! whichSelectorsReferTo: literal special: specialFlag byte: specialByte "Answer a set of selectors whose methods access the argument as a literal." | who method | who _ Set new. methodDict associationsDo: [:assn | method _ assn value. ((method containsLiteral: literal "faster than hasLiteral:") or: [specialFlag and: [method scanFor: specialByte]]) ifTrue: [((literal isKindOf: Association) not or: [method sendsToSuper not or: [method literals allButLast includes: literal]]) ifTrue: [who add: assn key]]]. ^who! ! 'From Squeak 1.21 of July 17, 1997 on 25 September 1997 at 10:05:37 pm'! !CompiledMethod methodsFor: 'fast debugger' stamp: 'sn 9/25/97 21:59'! hasBlockUpArrow "Answer true if the receiver has a block which contains a method return; false otherwise." | scanner | scanner _ InstructionStream on: self. ^scanner scanFor: [:x | x == 200 "Block here." and: [self hasUpArrowInBlock: scanner pc + 3]]! ! !CompiledMethod methodsFor: 'fast debugger' stamp: 'sn 9/25/97 21:54'! hasUpArrowInBlock: startpc "Answer true if the receiver has a method return in the block starting at startpc." | end scanner | end _ (self at: startpc-2)\\16-4*256 + (self at: startpc-1) + startpc - 1. scanner _ InstructionStream new method: self pc: startpc. scanner scanFor: [:byte | (byte between: 120 and: 124) or: [scanner pc > end]]. ^scanner pc <= end! ! 'From Squeak 1.21 of July 17, 1997 on 12 September 1997 at 4:52:43 pm'! !Debugger methodsFor: 'private' stamp: 'sn 9/12/97 16:44'! hasVisibleSend: aContext "Answer true if aContext about to do a send or return that is actually visible." ^ (sourceMap detect: [:assoc | assoc key == aContext pc] ifNone: []) notNil! ! 'From Squeak 1.21 of July 17, 1997 on 12 September 1997 at 4:52:37 pm'! !Debugger methodsFor: 'private' stamp: 'sn 9/12/97 16:45'! stepToVisibleSendOrReturn: currentContext "Keep stepping until we see a send or return that is actually in the source code-- not compiler-generated." [currentContext willReturn or: [self hasVisibleSend: currentContext]] whileFalse: [currentContext step. currentContext stepToSendOrReturn]! ! 'From Squeak 1.21 of July 17, 1997 on 12 September 1997 at 5:01:28 pm'! !Debugger methodsFor: 'code execution' stamp: 'sn 9/12/97 16:54'! step "Send the selected message in the accessed method, and regain control after the invoked method returns." | currentContext | self okToChange ifFalse: [^ self]. self checkContextSelection. externalInterrupt ifFalse: [contextStackTop push: proceedValue]. externalInterrupt _ true. "simulation leaves same state as interrupting" currentContext _ self selectedContext. self contextStackIndex > 1 ifTrue: [currentContext completeCallee: contextStackTop. self stepToVisibleSendOrReturn: currentContext. self resetContext: currentContext] ifFalse: [currentContext stepToSendOrReturn. currentContext willReturn ifTrue: [currentContext _ currentContext step. self resetContext: currentContext. self stepToVisibleSendOrReturn: currentContext. self changed: #pc] ifFalse: [currentContext completeCallee: currentContext step. self stepToVisibleSendOrReturn: currentContext. self changed: #pc. self updateInspectors]]! ! 'From Squeak 1.21 of July 17, 1997 on 12 September 1997 at 5:01:25 pm'! !Debugger methodsFor: 'code execution' stamp: 'sn 9/12/97 16:51'! send "Send the selected message in the accessed method, and take control in the method invoked to allow further step or send." | currentContext | Sensor leftShiftDown ifTrue: [self halt]. self okToChange ifFalse: [^ self]. self checkContextSelection. externalInterrupt ifFalse: [contextStackTop push: proceedValue]. externalInterrupt _ true. "simulation leaves same state as interrupting" currentContext _ self selectedContext. currentContext stepToSendOrReturn. self contextStackIndex > 1 | currentContext willReturn ifTrue: [self changed: #notChanged] ifFalse: [currentContext _ currentContext step. currentContext stepToSendOrReturn. self resetContext: currentContext. self stepToVisibleSendOrReturn: currentContext. self changed: #pc]! ! 'From Squeak 1.21 of July 17, 1997 on 12 September 1997 at 6:24:56 pm'! !SelectorNode methodsFor: 'code generation' stamp: 'sn 9/12/97 18:24'! emit: stack args: nArgs on: aStream super: supered | index pc | stack pop: nArgs. (supered not and: [code - Send < SendLimit and: [nArgs < 3]]) ifTrue: ["short send" code < Send ifTrue: [aStream nextPut: code. ^aStream position] ifFalse: [aStream nextPut: nArgs * 16 + code. ^aStream position]]. index _ code < 256 ifTrue: [code - Send] ifFalse: [code \\ 256]. (index <= 31 and: [nArgs <= 7]) ifTrue: ["extended (2-byte) send [131 and 133]" aStream nextPut: SendLong + (supered ifTrue: [2] ifFalse: [0]). pc _ aStream position. aStream nextPut: nArgs * 32 + index. ^pc]. (supered not and: [index <= 63 and: [nArgs <= 3]]) ifTrue: ["new extended (2-byte) send [134]" aStream nextPut: SendLong2. pc _ aStream position. aStream nextPut: nArgs * 64 + index. ^pc]. "long (3-byte) send" aStream nextPut: DblExtDoAll. pc _ aStream position. aStream nextPut: nArgs + (supered ifTrue: [32] ifFalse: [0]). aStream nextPut: index. ^pc! ! 'From Squeak 1.21 of July 17, 1997 on 12 September 1997 at 6:25:40 pm'! !MessageNode methodsFor: 'code generation' stamp: 'sn 9/12/97 18:25'! emitForValue: stack on: strm special > 0 ifTrue: [self perform: (MacroEmitters at: special) with: stack with: strm with: true. pc _ 0] ifFalse: [receiver ~~ nil ifTrue: [receiver emitForValue: stack on: strm]. arguments do: [:argument | argument emitForValue: stack on: strm]. pc _ selector emit: stack args: arguments size on: strm super: receiver == NodeSuper]! ! 'From Squeak 1.21 of July 17, 1997 on 19 September 1997 at 7:31:40 pm'! !Parser methodsFor: 'private' stamp: 'sn 9/19/97 19:31'! previousTokenSize "Answer the size of the previous token. Bugfix for Strings." hereType == #number ifTrue: [^mark - prevMark]. hereType == #string ifTrue: [^here size + 2]. "One for each single quote" ^here size! ! 'From Squeak 1.21 of July 17, 1997 on 19 September 1997 at 7:32:10 pm'! !Parser methodsFor: 'scanning' stamp: 'sn 9/19/97 19:32'! advance | this | prevMark _ hereMark. prevToken _ "Now means prev size" self previousTokenSize. this _ here. here _ token. hereType _ tokenType. hereMark _ mark. self scanToken. ^this! ! 'From Squeak 1.21 of July 17, 1997 on 20 September 1997 at 10:12:57 pm'! !CompiledMethod methodsFor: 'scanning' stamp: 'sn 9/20/97 22:11'! sendPriorTo: pc in: sourceMap "Answer the send just prior to the current pc." | prior | sourceMap isEmpty ifTrue: [^0]. prior _ sourceMap first. sourceMap do: [:assoc | (pc - assoc key) negative ifTrue: [^prior] ifFalse: [prior _ assoc]]. ^prior! ! 'From Squeak 1.21 of July 17, 1997 on 23 September 1997 at 5:19:14 pm'! !Debugger methodsFor: 'pc selection' stamp: 'sn 9/23/97 17:18'! pcRange "Answer the indices in the source code for the method corresponding to the selected context's program counter value." | i methodNode pc end selectedContext chosenRange priorSend lastChar | (selectingPC and: [contextStackIndex ~= 0]) ifFalse: [^1 to: 0]. sourceMap == nil ifTrue: [methodNode _ self selectedClass compilerClass new parse: self selectedMessage in: self selectedClass notifying: nil. sourceMap _ methodNode sourceMap. tempNames _ methodNode tempNames. self selectedContext method cacheTempNames: tempNames]. sourceMap size = 0 ifTrue: [^1 to: 0]. pc_ self selectedContext pc - ((externalInterrupt and: [contextStackIndex=1]) ifTrue: [1] ifFalse: [2]). i _ sourceMap indexForInserting: (Association key: pc value: nil). i < 1 ifTrue: [^1 to: 0]. "Method not started; probably won't get here" i > sourceMap size "Default return self at end of method" ifTrue: [end _ sourceMap inject: 0 into: [:prev :this | prev max: this value last]. ^ end+1 to: end]. selectedContext _ self selectedContext. ^(selectedContext willReturn and: [self contextStackIndex == 1]) ifTrue: [chosenRange _ sourceMap "explicit return" detect: [:assoc | assoc key == selectedContext pc] ifNone: [nil "Block return"]. chosenRange isNil ifTrue: [priorSend _ selectedContext method sendPriorTo: selectedContext pc in: sourceMap. lastChar _ priorSend value last. lastChar + 1 to: lastChar] ifFalse: [chosenRange value]] ifFalse: [priorSend _ selectedContext method "send" sendPriorTo: selectedContext pc in: sourceMap. priorSend value]! ! StringHolder subclass: #Debugger instanceVariableNames: 'interruptedProcess interruptedController contextStack contextStackTop contextStackIndex contextStackList receiverInspector contextVariablesInspector externalInterrupt proceedValue selectingPC sourceMap tempNames catchContinuation ' classVariableNames: '' poolDictionaries: '' category: 'Interface-Debugger'! ParseNode subclass: #BlockNode instanceVariableNames: 'arguments statements returns nArgsNode size remoteCopyNode isReal ' classVariableNames: '' poolDictionaries: '' category: 'System-Compiler'! !Debugger methodsFor: 'fast debugger' stamp: 'sn 9/26/97 18:41'! return "Cause the receiver to get control from the contexts that have been executing." catchContinuation value! ! !Debugger methodsFor: 'code execution' stamp: 'sn 9/28/97 19:24'! step "Send the selected message in the accessed method, and regain control after the invoked method returns." | currentContext newContext | catchContinuation _ [^nil]. self okToChange ifFalse: [^ self]. self checkContextSelection. externalInterrupt ifFalse: [contextStackTop push: proceedValue]. externalInterrupt _ true. "simulation leaves same state as interrupting" currentContext _ self selectedContext. self contextStackIndex > 1 ifTrue: [currentContext completeCallee: contextStackTop. self stepToVisibleSendOrReturn: currentContext. self resetContext: currentContext] ifFalse: [currentContext stepToSendOrReturn. currentContext willReturn ifTrue: [currentContext _ currentContext step. self resetContext: currentContext. self stepToVisibleSendOrReturn: currentContext. self changed: #pc] ifFalse: [newContext _ Sensor leftShiftDown ifTrue: [currentContext leap] ifFalse: [currentContext step]. currentContext completeCallee: newContext. self stepToVisibleSendOrReturn: currentContext. self changed: #pc. self updateInspectors]]! ! 'From Squeak 1.21 of July 17, 1997 on 23 September 1997 at 6:22:09 pm'! !InstructionStream methodsFor: 'fast debugger' stamp: 'sn 9/23/97 17:59'! leapExtension: offset in: method for: client | type offset2 byte2 byte3 | offset <=6 ifTrue: ["Extended op codes 128-134" byte2 _ method at: pc. pc _ pc + 1. offset <= 2 ifTrue: ["128-130: extended pushes and pops" type _ byte2 // 64. offset2 _ byte2 \\ 64. offset = 0 ifTrue: [type = 0 ifTrue: [^ client pushReceiverVariable: offset2]. type = 1 ifTrue: [^ client pushTemporaryVariable: offset2]. type = 2 ifTrue: [^ client pushConstant: (method literalAt: offset2 + 1)]. type = 3 ifTrue: [^ client pushLiteralVariable: (method literalAt: offset2 + 1)]]. offset = 1 ifTrue: [type = 0 ifTrue: [^ client storeIntoReceiverVariable: offset2]. type = 1 ifTrue: [^ client storeIntoTemporaryVariable: offset2]. type = 2 ifTrue: [self error: 'illegalStore']. type = 3 ifTrue: [^ client storeIntoLiteralVariable: (method literalAt: offset2 + 1)]]. offset = 2 ifTrue: [type = 0 ifTrue: [^ client popIntoReceiverVariable: offset2]. type = 1 ifTrue: [^ client popIntoTemporaryVariable: offset2]. type = 2 ifTrue: [self error: 'illegalStore']. type = 3 ifTrue: [^ client popIntoLiteralVariable: (method literalAt: offset2 + 1)]]]. "131-134: extended sends" offset = 3 ifTrue: "Single extended send" [^ client leap: (method literalAt: byte2 \\ 32 + 1) super: false numArgs: byte2 // 32]. offset = 4 ifTrue: "Double extended do-anything" [byte3 _ method at: pc. pc _ pc + 1. type _ byte2 // 32. type = 0 ifTrue: [^ client leap: (method literalAt: byte3 + 1) super: false numArgs: byte2 \\ 32]. type = 1 ifTrue: [^ client leap: (method literalAt: byte3 + 1) super: true numArgs: byte2 \\ 32]. type = 2 ifTrue: [^ client pushReceiverVariable: byte3]. type = 3 ifTrue: [^ client pushConstant: (method literalAt: byte3 + 1)]. type = 4 ifTrue: [^ client pushLiteralVariable: (method literalAt: byte3 + 1)]. type = 5 ifTrue: [^ client storeIntoReceiverVariable: byte3]. type = 6 ifTrue: [^ client popIntoReceiverVariable: byte3]. type = 7 ifTrue: [^ client storeIntoLiteralVariable: (method literalAt: byte3 + 1)]]. offset = 5 ifTrue: "Single extended send to super" [^ client leap: (method literalAt: byte2 \\ 32 + 1) super: true numArgs: byte2 // 32]. offset = 6 ifTrue: "Second extended send" [^ client leap: (method literalAt: byte2 \\ 64 + 1) super: false numArgs: byte2 // 64]]. offset = 7 ifTrue: [^ client doPop]. offset = 8 ifTrue: [^ client doDup]. offset = 9 ifTrue: [^ client pushActiveContext]. self error: 'unusedBytecode'! ! !InstructionStream methodsFor: 'fast debugger' stamp: 'sn 9/23/97 18:00'! leapNextInstructionFor: client "Send to the argument, client, a message that specifies the type of the next instruction." | byte type offset method | method _ self method. byte _ method at: pc. type _ byte // 16. offset _ byte \\ 16. pc _ pc+1. type=0 ifTrue: [^client pushReceiverVariable: offset]. type=1 ifTrue: [^client pushTemporaryVariable: offset]. type=2 ifTrue: [^client pushConstant: (method literalAt: offset+1)]. type=3 ifTrue: [^client pushConstant: (method literalAt: offset+17)]. type=4 ifTrue: [^client pushLiteralVariable: (method literalAt: offset+1)]. type=5 ifTrue: [^client pushLiteralVariable: (method literalAt: offset+17)]. type=6 ifTrue: [offset<8 ifTrue: [^client popIntoReceiverVariable: offset] ifFalse: [^client popIntoTemporaryVariable: offset-8]]. type=7 ifTrue: [offset=0 ifTrue: [^client pushReceiver]. offset<8 ifTrue: [^client pushConstant: (SpecialConstants at: offset)]. offset=8 ifTrue: [^client methodReturnReceiver]. offset<12 ifTrue: [^client methodReturnConstant: (SpecialConstants at: offset-8)]. offset=12 ifTrue: [^client methodReturnTop]. offset=13 ifTrue: [^client blockReturnTop]. offset>13 ifTrue: [^self error: 'unusedBytecode']]. type=8 ifTrue: [^self leapExtension: offset in: method for: client]. type=9 ifTrue: "short jumps" [offset<8 ifTrue: [^client jump: offset+1]. ^client jump: offset-8+1 if: false]. type=10 ifTrue: "long jumps" [byte_ method at: pc. pc_ pc+1. offset<8 ifTrue: [^client jump: offset-4*256 + byte]. ^client jump: (offset bitAnd: 3)*256 + byte if: offset<12]. type=11 ifTrue: [^client leap: (Smalltalk specialSelectorAt: offset+1) super: false numArgs: (Smalltalk specialNargsAt: offset+1)]. type=12 ifTrue: [^client leap: (Smalltalk specialSelectorAt: offset+17) super: false numArgs: (Smalltalk specialNargsAt: offset+17)]. type>12 ifTrue: [^client leap: (method literalAt: offset+1) super: false numArgs: type-13]! ! 'From Squeak 1.21 of July 17, 1997 on 30 September 1997 at 2:21:48 pm'! !Encoder methodsFor: 'source mapping' stamp: 'sn 9/30/97 14:21'! sourceMap "Answer with a sorted set of associations (pc range)." | goodKeys | goodKeys _ sourceRanges keys select: [:node | node pc notNil]. ^ (goodKeys collect: [:key | Association key: key pc value: (sourceRanges at: key)]) asSortedCollection! ! !Encoder methodsFor: 'fast debugger' stamp: 'sn 9/27/97 15:49'! sourceRangeForNode: aNode ^sourceRanges at: aNode! ! 'From Squeak 1.21 of July 17, 1997 on 28 September 1997 at 2:38:22 pm'! !AssignmentNode methodsFor: 'fast debugger' stamp: 'sn 9/28/97 14:38'! transformUpArrowIn: anEncoder block: aBoolean aBoolean ifTrue: [value _ value transformUpArrowIn: anEncoder]. value transformUpArrowIn: anEncoder block: aBoolean! ! 'From Squeak 1.21 of July 17, 1997 on 28 September 1997 at 2:46:31 pm'! !BlockNode methodsFor: 'fast debugger' stamp: 'sn 9/28/97 13:14'! initialize "Assume this is a real block (not inlined) until proven otherwise." isReal _ true! ! !BlockNode methodsFor: 'fast debugger' stamp: 'sn 9/27/97 17:17'! isReal ^isReal! ! !BlockNode methodsFor: 'fast debugger' stamp: 'sn 9/27/97 17:17'! notReal isReal _ false! ! !BlockNode methodsFor: 'fast debugger' stamp: 'sn 9/28/97 14:46'! transformUpArrowIn: anEncoder block: aBoolean | newStatements shouldTransform | (shouldTransform _ aBoolean or: [self isReal]) ifTrue: [newStatements _ self statements collect: [:statement | statement transformUpArrowIn: anEncoder]. self statements: newStatements]. self statements do: [:statement | statement transformUpArrowIn: anEncoder block: shouldTransform] ! ! 'From Squeak 1.21 of July 17, 1997 on 28 September 1997 at 6:46:12 pm'! !BlockNode class methodsFor: 'fast debugger' stamp: 'sn 9/28/97 18:45'! new ^super new initialize! ! 'From Squeak 1.21 of July 17, 1997 on 28 September 1997 at 8:08:31 pm'! !MessageNode methodsFor: 'fast debugger' stamp: 'sn 9/28/97 14:53'! markArgumentsUnreal "The arguments to the receiver are going to be inlined (ifTrue: whileTrue:, etc.). Mark them as such." arguments do: [:block | block notReal] ! ! !MessageNode methodsFor: 'fast debugger' stamp: 'sn 9/28/97 14:04'! shouldTransformWhile: encoder (self checkBlock: receiver as: 'receiver' from: encoder) ifFalse: [^ false]. arguments size = 0 "transform bodyless form to body form" ifTrue: [selector _ SelectorNode new key: (special = 10 ifTrue: [#whileTrue:] ifFalse: [#whileFalse:]) code: #macro. arguments _ Array with: (BlockNode withJust: NodeNil). ^ true] ifFalse: [^ self transformBoolean: encoder]! ! !MessageNode methodsFor: 'macro transformations' stamp: 'sn 9/28/97 13:39'! transformAnd: encoder (self transformBoolean: encoder) ifTrue: [arguments _ Array with: (arguments at: 1) with: (BlockNode withJust: NodeFalse). self markArgumentsUnreal. ^true] ifFalse: [^false]! ! !MessageNode methodsFor: 'macro transformations' stamp: 'sn 9/28/97 13:40'! transformIfFalse: encoder (self transformBoolean: encoder) ifTrue: [arguments _ Array with: (BlockNode withJust: NodeNil) with: (arguments at: 1). self markArgumentsUnreal. ^true] ifFalse: [^false]! ! !MessageNode methodsFor: 'macro transformations' stamp: 'sn 9/28/97 13:42'! transformIfFalseIfTrue: encoder ((self checkBlock: (arguments at: 1) as: 'False arg' from: encoder) and: [self checkBlock: (arguments at: 2) as: 'True arg' from: encoder]) ifTrue: [selector _ #ifTrue:ifFalse:. arguments swap: 1 with: 2. self markArgumentsUnreal. ^true] ifFalse: [^false]! ! !MessageNode methodsFor: 'macro transformations' stamp: 'sn 9/28/97 13:42'! transformIfTrue: encoder (self transformBoolean: encoder) ifTrue: [arguments _ Array with: (arguments at: 1) with: (BlockNode withJust: NodeNil). self markArgumentsUnreal. ^true] ifFalse: [^false]! ! !MessageNode methodsFor: 'macro transformations' stamp: 'sn 9/28/97 13:42'! transformIfTrueIfFalse: encoder | isNormal | isNormal _ (self checkBlock: (arguments at: 1) as: 'True arg' from: encoder) and: [self checkBlock: (arguments at: 2) as: 'False arg' from: encoder]. isNormal ifTrue: [self markArgumentsUnreal]. ^isNormal! ! !MessageNode methodsFor: 'macro transformations' stamp: 'sn 9/28/97 13:42'! transformOr: encoder (self transformBoolean: encoder) ifTrue: [arguments _ Array with: (BlockNode withJust: NodeTrue) with: (arguments at: 1). self markArgumentsUnreal. ^true] ifFalse: [^false]! ! !MessageNode methodsFor: 'macro transformations' stamp: 'sn 9/28/97 14:12'! transformToDo: encoder " var _ rcvr. L1: [var <= arg1] Bfp(L2) [block body. var _ var + inc] Jmp(L1) L2: " | limit increment block initStmt test incStmt limitInit blockVar | "First check for valid arguments" ((arguments last isMemberOf: BlockNode) and: [arguments last numberOfArguments = 1]) ifFalse: [^ false]. arguments last firstArgument isVariableReference ifFalse: [^ false]. "As with debugger remote vars" arguments size = 3 ifTrue: [increment _ arguments at: 2. increment isConstantNumber ifFalse: [^ false]] ifFalse: [increment _ encoder encodeLiteral: 1]. arguments size < 3 ifTrue: "transform to full form" [selector _ SelectorNode new key: #to:by:do: code: #macro]. "Now generate auxiliary structures" block _ arguments last. block notReal. blockVar _ block firstArgument. initStmt _ AssignmentNode new variable: blockVar value: receiver. limit _ arguments at: 1. limit isVariableReference | limit isConstantNumber ifTrue: [limitInit _ nil] ifFalse: "Need to store limit in a var" [limit _ encoder autoBind: blockVar key , 'LimiT'. limit scope: -2. "Already done parsing block" limitInit _ AssignmentNode new variable: limit value: (arguments at: 1)]. test _ MessageNode new receiver: blockVar selector: (increment key > 0 ifTrue: [#<=] ifFalse: [#>=]) arguments: (Array with: limit) precedence: precedence from: encoder. incStmt _ AssignmentNode new variable: blockVar value: (MessageNode new receiver: blockVar selector: #+ arguments: (Array with: increment) precedence: precedence from: encoder). arguments _ (Array with: limit with: increment with: block) , (Array with: initStmt with: test with: incStmt with: limitInit). ^ true! ! !MessageNode methodsFor: 'fast debugger' stamp: 'sn 9/28/97 20:06'! transformUpArrowIn: anEncoder block: aBoolean aBoolean ifTrue: [self transformUpArrowLocallyIn: anEncoder]. self receiver transformUpArrowIn: anEncoder block: aBoolean. self arguments do: [:arg | arg notNil ifTrue: [arg transformUpArrowIn: anEncoder block: aBoolean]]! ! !MessageNode methodsFor: 'fast debugger' stamp: 'sn 9/28/97 20:08'! transformUpArrowLocallyIn: anEncoder self receiver notNil ifTrue: [self receiver: (self receiver transformUpArrowIn: anEncoder)]. arguments _ arguments collect: [:arg | arg notNil ifTrue: [arg transformUpArrowIn: anEncoder]]! ! !MessageNode methodsFor: 'macro transformations' stamp: 'sn 9/28/97 14:07'! transformWhile: encoder | answer | answer _ self shouldTransformWhile: encoder. answer ifTrue: [receiver notReal. self markArgumentsUnreal]. ^answer! ! 'From Squeak 1.21 of July 17, 1997 on 28 September 1997 at 6:59:17 pm'! !MethodNode methodsFor: 'fast debugger' stamp: 'sn 9/28/97 15:12'! transformUpArrowIn: anEncoder block: aBoolean block transformUpArrowIn: anEncoder block: false! ! !MethodNode methodsFor: 'fast debugger' stamp: 'sn 9/28/97 18:59'! transformUpArrows self transformUpArrowIn: encoder block: false! ! 'From Squeak 1.21 of July 17, 1997 on 4 October 1997 at 5:57:33 pm'! !Object methodsFor: 'fast debugger'! upArrow "The receiver is about to be returned via a method return from a real (non-inlined) block. Intercept this in case a debugger needs to see the resulting context." ^thisContext sender doUpArrow: self! ! 'From Squeak 1.21 of July 17, 1997 on 28 September 1997 at 3:01:10 pm'! !ParseNode methodsFor: 'fast debugger' stamp: 'sn 9/28/97 14:35'! transformUpArrowIn: encoder "Not a ReturnNode. Do nothing."! ! !ParseNode methodsFor: 'fast debugger' stamp: 'sn 9/28/97 15:01'! transformUpArrowIn: anEncoder block: aBoolean "The default is to do nothing."! ! 'From Squeak 1.21 of July 17, 1997 on 1 October 1997 at 8:08:20 pm'! !ReturnNode methodsFor: 'fast debugger' stamp: 'sn 10/1/97 20:06'! transformUpArrowIn: encoder "Transform my expr to a message node: ^expr upArrow." expr _ MessageNode new receiver: expr selector: #upArrow arguments: #() precedence: 1 from: encoder sourceRange: (encoder sourceRangeForNode: self)! ! !ReturnNode methodsFor: 'fast debugger' stamp: 'sn 9/28/97 15:10'! transformUpArrowIn: anEncoder block: aBoolean aBoolean ifTrue: [expr _ expr transformUpArrowIn: anEncoder]. expr transformUpArrowIn: anEncoder block: aBoolean! ! 'From Squeak 1.21 of July 17, 1997 on 10 November 1997 at 7:49:09 pm'! !Debugger class methodsFor: 'fast debugger' stamp: 'sn 11/10/97 19:39'! recompileBlockUpArrows "Recompile all methods which have method returns from real blocks so the fast debugger can be used." | meth classCount currentCount | classCount _ 0. Smalltalk allBehaviorsDo: [:class | classCount _ classCount + 1]. 'Recompiling non-local returns...' displayProgressAt: Sensor cursorPoint from: 0 to: classCount during: [:bar | currentCount _ 0. Smalltalk allBehaviorsDo: [:class | bar value: (currentCount _ currentCount + 1). class selectors do: [:sel | meth _ class compiledMethodAt: sel. (meth hasBlockUpArrow and: [sel ~~ #makeReturnBlock]) ifTrue: [class recompile: sel from: class]]]]! ! 'From Squeak 1.21 of July 17, 1997 on 28 September 1997 at 3:06:10 pm'! !Parser methodsFor: 'expression types' stamp: 'sn 9/28/97 15:05'! method: doit context: ctxt " pattern [ | temporaries ] block => MethodNode." | sap blk prim temps messageComment methodNode | sap _ self pattern: doit inContext: ctxt. "sap={selector, arguments, precedence}" (sap at: 2) do: [:argNode | argNode isArg: true]. temps _ self temporaries. messageComment _ currentComment. currentComment _ nil. prim _ doit ifTrue: [0] ifFalse: [self primitive]. self statements: #() innerBlock: doit. blk _ parseNode. blk notReal. doit ifTrue: [blk returnLast] ifFalse: [blk returnSelfIfNoOther]. hereType == #doIt ifFalse: [^self expected: 'Nothing more']. self interactive ifTrue: [self removeUnusedTemps]. methodNode _ MethodNode new comment: messageComment. ^methodNode selector: (sap at: 1) arguments: (sap at: 2) precedence: (sap at: 3) temporaries: temps block: blk encoder: encoder primitive: prim! ! 'From Squeak 1.21 of July 17, 1997 on 10 November 1997 at 7:55:17 pm'! !ClassDescription methodsFor: 'compiling' stamp: 'sn 11/10/97 19:54'! compile: code notifying: requestor trailer: bytes ifFail: failBlock elseSetSelectorAndNode: selAndNodeBlock "Intercept this message in order to remember system changes. 5/15/96 sw: modified so that if the class does not wish its methods logged in the changes file, then they also won't be accumulated in the current change set. 7/12/96 sw: use wantsChangeSetLogging to determine whether to put in change set" | methodNode selector method | methodNode _ self compilerClass new compile: code in: self notifying: requestor ifFail: failBlock. methodNode transformUpArrows. selector _ methodNode selector. selAndNodeBlock value: selector value: methodNode. self wantsChangeSetLogging ifTrue: [(methodDict includesKey: selector) ifTrue: [Smalltalk changes changeSelector: selector class: self] ifFalse: [Smalltalk changes addSelector: selector class: self]]. methodNode encoder requestor: requestor. "Why was this not preserved?" method _ methodNode generate: bytes. self addSelector: selector withMethod: method. ^ method! ! 'From Squeak 1.21 of July 17, 1997 on 2 October 1997 at 5:55:56 pm'! !Behavior methodsFor: 'creating method dictionary' stamp: 'sn 10/2/97 17:55'! recompile: selector from: oldClass "Compile the method associated with selector in the receiver's method dictionary." | method trailer methodNode | method _ self compiledMethodAt: selector. trailer _ (method size - 3 to: method size) collect: [:i | method at: i]. methodNode _ self compilerClass new compile: (oldClass sourceCodeAt: selector) in: self notifying: nil ifFail: [^ self]. "Assume OK after proceed from SyntaxError" methodNode transformUpArrows. selector == methodNode selector ifFalse: [self error: 'selector changed!!']. self addSelector: selector withMethod: (methodNode generate: trailer). ! ! 'From Squeak 1.21 of July 17, 1997 on 4 October 1997 at 5:58:45 pm'! !Debugger methodsFor: 'pc selection' stamp: 'sn 9/30/97 18:00'! pcRange "Answer the indices in the source code for the method corresponding to the selected context's program counter value." | i methodNode pc end selectedContext chosenRange priorSend lastChar updatedMethodNode | (selectingPC and: [contextStackIndex ~= 0]) ifFalse: [^1 to: 0]. sourceMap == nil ifTrue: [methodNode _ self selectedClass compilerClass new parse: self selectedMessage in: self selectedClass notifying: nil. updatedMethodNode _ (self selectedContext method messages includes: #upArrow) ifTrue: [methodNode transformUpArrows] ifFalse: [methodNode]. sourceMap _ updatedMethodNode sourceMap. tempNames _ methodNode tempNames. self selectedContext method cacheTempNames: tempNames]. sourceMap size = 0 ifTrue: [^1 to: 0]. pc_ self selectedContext pc - ((externalInterrupt and: [contextStackIndex=1]) ifTrue: [1] ifFalse: [2]). i _ sourceMap indexForInserting: (Association key: pc value: nil). i < 1 ifTrue: [^1 to: 0]. "Method not started; probably won't get here" i > sourceMap size "Default return self at end of method" ifTrue: [end _ sourceMap inject: 0 into: [:prev :this | prev max: this value last]. ^ end+1 to: end]. selectedContext _ self selectedContext. ^(selectedContext willReturn and: [self contextStackIndex == 1]) ifTrue: [chosenRange _ sourceMap "explicit return" detect: [:assoc | assoc key == selectedContext pc] ifNone: [nil "Block return"]. chosenRange isNil ifTrue: [priorSend _ selectedContext method sendPriorTo: selectedContext pc in: sourceMap. lastChar _ priorSend value last. lastChar + 1 to: lastChar] ifFalse: [chosenRange value]] ifFalse: [priorSend _ selectedContext method "send" sendPriorTo: selectedContext pc in: sourceMap. priorSend value]! ! !Debugger methodsFor: 'private' stamp: 'sn 10/4/97 17:13'! process: aProcess controller: aController context: aContext super initialize. contents _ nil. interruptedProcess _ aProcess. interruptedController _ aController. aContext markStackForCatch. contextStackTop _ aContext. self newStack: (contextStackTop stackOfSize: 1). contextStackIndex _ 1. externalInterrupt _ false. selectingPC _ true! ! !Debugger methodsFor: 'fast debugger' stamp: 'sn 9/26/97 18:41'! return "Cause the receiver to get control from the contexts that have been executing." catchContinuation value! ! !Debugger methodsFor: 'code execution' stamp: 'sn 10/4/97 17:58'! send "Send the selected message in the accessed method, and take control in the method invoked to allow further step or send." | currentContext | self okToChange ifFalse: [^ self]. self checkContextSelection. externalInterrupt ifFalse: [contextStackTop push: proceedValue]. externalInterrupt _ true. "simulation leaves same state as interrupting" currentContext _ self selectedContext. currentContext stepToSendOrReturn. self contextStackIndex > 1 | currentContext willReturn ifTrue: [self changed: #notChanged] ifFalse: [currentContext _ currentContext step. currentContext stepToSendOrReturn. currentContext markForCatch. self resetContext: currentContext. self stepToVisibleSendOrReturn: currentContext. self changed: #pc]! ! !Debugger methodsFor: 'code execution' stamp: 'sn 10/1/97 20:57'! step "Send the selected message in the accessed method, and regain control after the invoked method returns." | currentContext newContext | catchContinuation _ [^nil]. self okToChange ifFalse: [^ self]. self checkContextSelection. externalInterrupt ifFalse: [contextStackTop push: proceedValue]. externalInterrupt _ true. "simulation leaves same state as interrupting" currentContext _ self selectedContext. self contextStackIndex > 1 ifTrue: [currentContext catchCallee: contextStackTop. self stepToVisibleSendOrReturn: currentContext. self resetContext: currentContext] ifFalse: [currentContext stepToSendOrReturn. currentContext willReturn ifTrue: [currentContext _ currentContext step. self resetContext: currentContext. self stepToVisibleSendOrReturn: currentContext. self changed: #pc] ifFalse: [newContext _ currentContext leap. currentContext catchCallee: newContext. self stepToVisibleSendOrReturn: currentContext. self changed: #pc. self updateInspectors]]! ! Debugger recompileBlockUpArrows! ================================================================== pub/Smalltalk/Squeak/Goodies/MathDD/CATALOG-CARD ================================================================== '' NAME Core Math Double Dispatching AUTHOR tkc@bmi.net; tgriggs@keyww.com (Travis Griggs) URL (none) FUNCTION Changes core math functions for base Number types to use double dispatching KEYWORDS math number ST-VERSIONS Squeak PREREQUISITES (none) CONFLICTS (none known) DISTRIBUTION world VERSION 1.0 DATE 31-Jan-98 INSTALLATION MathDD1.csMathDD2.cs SUMMARY see file MathDD.txt Travis Griggs ''! ================================================================== pub/Smalltalk/Squeak/Goodies/SSAPowerTools/CATALOG-CARD ================================================================== '' NAME Windoze Scrollbar Junta for Squeak AUTHOR ssadams@us.ibm.com (Sam S. Adams) URL (none) FUNCTION Adds Windoze-like scroll bars to Squeak KEYWORDS Squeak Windoze Scrollbar Scroll bar ST-VERSIONS Squeak PREREQUISITES (none) CONFLICTS (none known) DISTRIBUTION world VERSION 1.3.1 (superceeds 1.3) DATE 27-Jan-98 INSTALLATION load in this order: ScrollBars-1.3.1.cs ScrollJunta-1.3.1.cs SUMMARY ScrollBars adds the scrollbar functionality but does not override existing windows. ScrollJunta overrides existing windows to use the new scrollbars. Note: this goodie goes nicely with the 'Windoze 3D borders and title bar' goodie also in this archive. Sam S. Adams ''! ================================================================== pub/Smalltalk/Squeak/Goodies/SyntaxHighlighting.st ================================================================== 'From Squeak 1.2 of June 29, 1997 on 7 October 1997 at 1:26:24 am'!Parser subclass: #SyntaxHighlightingParser instanceVariableNames: 'colorText runs controlStream sourceClass ' classVariableNames: 'DoSyntaxHighlighting EmphasizeBuffer ' poolDictionaries: '' category: 'Interface-SyntaxHighlighting'! TextAttribute subclass: #SyntaxHighlightingTextAttribute instanceVariableNames: 'name emphasisCode fontNumber color setMode ' classVariableNames: 'Palette ' poolDictionaries: '' category: 'Interface-SyntaxHighlighting'! !Browser methodsFor: 'initialize-release' stamp: 'mtw 8/26/97 23:48'! defaultBackgroundColor ^#white ''^ #lightGreen"! ! !BrowserCodeView methodsFor: 'updating' stamp: 'mtw 10/6/97 22:59'! updateDisplayContents "Refer to the comment in StringHolderView|updateDisplayContents." | contents | contents _ model contents. displayContents asString ~= contents ifTrue: [model messageListIndex ~= 0 ifTrue: [SyntaxHighlightingParser doSyntaxHighlighting ifTrue: [contents _ SyntaxHighlightingParser new emphasize: contents inClass: controller model selectedClass] ifFalse: [contents _ contents asText makeSelectorBoldIn: model selectedClassOrMetaClass] ]. self editString: contents. self displayView. model editSelection == #newMessage ifTrue: [controller selectFrom: 1 to: contents size]]! ! !CodeBrowser methodsFor: 'input events' stamp: 'mtw 10/6/97 23:09'! messagePaneNewSelection: arg1 | contents | codePane scroller removeAllMorphs. arg1 ifNil: [^ self]. SyntaxHighlightingParser doSyntaxHighlighting ifTrue: [contents _ SyntaxHighlightingParser new emphasize: (self selectedClassOrMetaClass sourceMethodAt: arg1) inClass: self selectedClassOrMetaClass] ifFalse: [contents _ contents asText makeSelectorBoldIn: (self selectedClassOrMetaClass sourceMethodAt: arg1)]. codePane scroller addMorph: (TextMorph new contents: contents)! ! !ContextStackCodeView methodsFor: 'updating' stamp: 'mtw 10/6/97 23:27'! updateDisplayContents "Refer to the comment in StringHolderView|updateDisplayContents." | contents | contents _ model contents. displayContents string ~= contents ifTrue: [SyntaxHighlightingParser doSyntaxHighlighting ifTrue: [displayContents _ (SyntaxHighlightingParser new emphasize: contents inClass: model selectedClassOrMetaClass) asParagraph] ifFalse: [displayContents _ (contents asText makeSelectorBoldIn: model selectedClassOrMetaClass) asParagraph]. self positionDisplayContents. self controller changeParagraph: displayContents. self displayView. self highlightPC]! ! SyntaxHighlightingParser comment: 'SyntaxHighlightingParser makes emphasized Text of Method-Strings. The emphasizes are named SyntaxHighlightingAttributes and can be changed at the class-side of SyntaxHighlightingAttributes to your favorite-style. To get rid of SyntaxHighlighting (Perhaps because you think it''s to slow on your system) just press leftShift while browsing one method. All following browsed methods are without SyntaxHighlighting. To reactivate it again just press leftShift again while browsing. The SyntaxHighlightingParser is called with #emphasize:inClass: . In this first release only connected to System-Tools with three different methods (that enables it only to emphasizes when browsing, not jet when accepting or formating) : BrowserCodeView updateDisplayContents (for Browser) ContextStackCodeView updateDisplayContents (for Debugger) CodeBrowser messagePaneNewSelection: (for the Demo-Morphic-Browser) SyntaxHighlightingParser gets its abilities just from its superclass Parser, so every change on Parser may have influence to SyntaxHighlighting. Since most methods are just copied down and enlarged with #emphasizeSourceTextAs:from:to: , everybody who changes Parser may also change SyntaxHighlightingParser (For example if we finally get block-Local-Variables). There are still a view little bugs in this release (wrong highligthing with some literals) and many possibilities to integrate it better with the system. Since I did this for VisualWorks before and had to change it very often when the Tools and Widgets changed I leave that for now, because of the upcoming Morphic-Views. (September 97, Martin Wollenweber, D-45879-Gelsenkirchen, Germany, wollenweber@cww.de) Instance Variables colorText the emphasized SourceText runs the runs of colorText to influence it directly for more speed controlStream a Stream that is written and displayed in Transcript when commandKey (Alt) is pressed, to control the work of SyntaxHighlightingParser sourceClass as name says ... Class Variables DoSyntaxHighlighting toggle for switching on and of EmphasizeBuffer Buffer for faster highlighting while browsing with the disatvantage of getteing sometimes wrong highlightings after Changes. It is activated in #useBuffer '! !SyntaxHighlightingParser methodsFor: 'emphasizing' stamp: 'mtw 10/7/97 00:47'! emphasize: aString colorText _ aString asText addAttribute: (SyntaxHighlightingTextAttribute getAttributeNamed: #allOther). runs _ colorText runs. self parse: (ReadStream on: aString) class: sourceClass noPattern: false context: nil notifying: nil ifFail: [^ colorText]. colorText runs setRuns: runs runs setValues: runs values. ^colorText! ! !SyntaxHighlightingParser methodsFor: 'emphasizing' stamp: 'mtw 10/7/97 01:00'! emphasizeSourceTextAs: aSymbol from: tokenStart to: tokenEnd InputSensor default commandKeyPressed ifTrue: [controlStream nextPutAll: (colorText size printString , ' ' , tokenStart printString , ' ' , tokenEnd printString , ' ' , (colorText copyFrom: tokenStart to: tokenEnd) , ' ' , aSymbol) asText; nextPut: Character cr]. runs _ runs copyReplaceFrom: tokenStart to: tokenEnd with: (RunArray new: tokenEnd - tokenStart + 1 withAll: (SyntaxHighlightingTextAttribute getAttributeNamed: aSymbol))! ! !SyntaxHighlightingParser methodsFor: 'emphasizing' stamp: 'mtw 10/7/97 01:03'! emphasizeWithBuffer: aString EmphasizeBuffer isNil ifTrue: [EmphasizeBuffer _ OrderedCollection new]. (colorText _ self getBufferedColorText: aString inClass: sourceClass) isNil ifTrue: [colorText _ self emphasize: aString. EmphasizeBuffer add: (Array with: sourceClass with: colorText). [EmphasizeBuffer size > self bufferSize] whileTrue: [EmphasizeBuffer removeFirst]. nil]. ^ colorText ! ! !SyntaxHighlightingParser methodsFor: 'emphasizing' stamp: 'mtw 10/7/97 00:48'! getBufferedColorText: aString inClass: class | stringSize aColorText | EmphasizeBuffer do: [:eEmphArray | (((eEmphArray at: 1) = class and: [(stringSize _ aString size) = (aColorText _ eEmphArray at: 2) size]) and: [(aString asString charactersExactlyMatching: aColorText) = stringSize]) ifTrue: [^ aColorText]. nil]. ^ nil! ! !SyntaxHighlightingParser methodsFor: 'public access' stamp: 'mtw 10/7/97 00:48'! bufferSize ^100! ! !SyntaxHighlightingParser methodsFor: 'public access' stamp: 'mtw 10/7/97 01:01'! emphasize: aString inClass: class controlStream _ TextStream on: ''. controlStream nextPut: Character cr. sourceClass _ class. Cursor wait showWhile: [self useBuffer ifTrue: [self emphasizeWithBuffer: aString] ifFalse: [self emphasize: aString]]. InputSensor default commandKeyPressed ifTrue: [Transcript show: controlStream contents]. ^ colorText! ! !SyntaxHighlightingParser methodsFor: 'public access' stamp: 'mtw 10/7/97 00:35'! useBuffer ^true! ! !SyntaxHighlightingParser methodsFor: 'expression types' stamp: 'mtw 9/21/97 09:25'! argumentName | anArgumentName varEnd varStart | varStart _ self startOfNextToken + requestorOffset. hereType == #word ifFalse: [^ self expected: 'Argument name']. anArgumentName _ self advance. varEnd _ self endOfLastToken + requestorOffset. self emphasizeSourceTextAs: #argumentVariable from: varStart to: varEnd. ^ anArgumentName ! ! !SyntaxHighlightingParser methodsFor: 'expression types' stamp: 'mtw 10/2/97 22:20'! assignment: varNode | loc | self emphasizeSourceTextAs: #leftArrow from: hereMark to: hereMark + 1. (loc _ varNode assignmentCheck: encoder at: prevMark + requestorOffset) >= 0 ifTrue: [^ self notify: 'Cannot store into' at: loc]. varNode nowHasDef. self advance. self expression ifFalse: [^ self expected: 'Expression']. parseNode _ AssignmentNode new variable: varNode value: parseNode from: encoder. ^ true! ! !SyntaxHighlightingParser methodsFor: 'expression types' stamp: 'mtw 10/5/97 23:11'! getEmphasizeForVarNode: aVarNode | aKey | ((aKey _ aVarNode key) isKindOf: Association) ifTrue: [((sourceClass classPool keys) includes: aKey key)ifTrue: [^ #classVariable]. (Undeclared keys includes: aKey key)ifTrue: [^ #undefinedVariable]. (aKey value isKindOf: Behavior) ifTrue: [^ #className]. ^ #globalVariable]. (#(nil true false self super ) includes: aKey asSymbol) ifTrue: [^ #pseudoVariable]. aVarNode isTemp ifTrue: [aVarNode isArg ifTrue: [^ #argumentVariable]. ^ #localVariable]. ^ #instanceVariable! ! !SyntaxHighlightingParser methodsFor: 'expression types' stamp: 'mtw 10/4/97 21:40'! messagePart: level repeat: repeat | start receiver selector args precedence words keywordStart keywordEnd | false ifTrue: [^ super messagePart: level repeat: repeat]. [receiver _ parseNode. (hereType == #keyword and: [level >= 3]) ifTrue: [start _ self startOfNextToken. selector _ WriteStream on: (String new: 32). args _ OrderedCollection new. words _ OrderedCollection new. [hereType == #keyword] whileTrue: [keywordStart _ self startOfNextToken + requestorOffset. selector nextPutAll: self advance. words addLast: (keywordStart to: (keywordEnd _ self endOfLastToken + requestorOffset)). self primaryExpression ifFalse: [^ self expected: 'Argument']. self emphasizeSourceTextAs: #messageSelectorPart from: keywordStart to: keywordEnd. self messagePart: 2 repeat: true. args addLast: parseNode]. (Symbol hasInterned: selector contents ifTrue: [:sym | selector _ sym]) ifFalse: [selector _ self correctSelector: selector contents wordIntervals: words exprInterval: (start to: self endOfLastToken) ifAbort: [^ self fail]]. precedence _ 3] ifFalse: [((hereType == #binary or: [hereType == #verticalBar]) and: [level >= 2]) ifTrue: [start _ self startOfNextToken. selector _ self advance asSymbol. self primaryExpression ifFalse: [^ self expected: 'Argument']. self emphasizeSourceTextAs: #messageSelectorPart from: start to: start. self messagePart: 1 repeat: true. args _ Array with: parseNode. precedence _ 2] ifFalse: [hereType == #word ifTrue: [start _ self startOfNextToken. selector _ self advance. args _ #(). words _ OrderedCollection with: (start + requestorOffset to: (keywordEnd _ self endOfLastToken + requestorOffset)). (Symbol hasInterned: selector ifTrue: [:sym | selector _ sym]) ifFalse: [selector _ self correctSelector: selector wordIntervals: words exprInterval: (start to: self endOfLastToken) ifAbort: [^ self fail]]. self emphasizeSourceTextAs: #messageSelectorPart from: start to: keywordEnd. precedence _ 1] ifFalse: [^ args notNil]]]. parseNode _ MessageNode new receiver: receiver selector: selector arguments: args precedence: precedence from: encoder sourceRange: (start to: self endOfLastToken). repeat] whileTrue. ^ true! ! !SyntaxHighlightingParser methodsFor: 'expression types' stamp: 'mtw 10/4/97 21:25'! pattern: fromDoit inContext: ctxt " unarySelector | binarySelector arg | keyword arg {keyword arg} => {selector, arguments, precedence}." | args selector answer start end | fromDoit ifTrue: [ctxt == nil ifTrue: [^ Array with: #DoIt with: #() with: 1] ifFalse: [^ Array with: #DoItIn: with: (Array with: (encoder encodeVariable: 'homeContext')) with: 3]]. hereType == #word ifTrue: [start _ self startOfNextToken + requestorOffset. answer _ Array with: self advance asSymbol with: #() with: 1. end _ self endOfLastToken + requestorOffset. self emphasizeSourceTextAs: #methodNamePart from: start to: end. ^ answer]. (hereType == #binary or: [hereType == #verticalBar]) ifTrue: [selector _ self advance asSymbol. args _ Array with: (encoder bindArg: self argumentName). ^ Array with: selector with: args with: 2]. hereType == #keyword ifTrue: [selector _ WriteStream on: (String new: 32). args _ OrderedCollection new. [hereType == #keyword] whileTrue: [start _ self startOfNextToken + requestorOffset. selector nextPutAll: self advance. end _ self endOfLastToken + requestorOffset. self emphasizeSourceTextAs: #methodNamePart from: start to: end. args addLast: (encoder bindArg: self argumentName)]. ^ Array with: selector contents asSymbol with: args with: 3]. ^ self expected: 'Message pattern'! ! !SyntaxHighlightingParser methodsFor: 'expression types' stamp: 'mtw 10/6/97 18:30'! primaryExpression hereType == #word ifTrue: [parseNode _ self variable. (parseNode isUndefTemp and: [self interactive]) ifTrue: [self queryUndefined]. parseNode nowHasRef. ^ true]. hereType == #leftBracket ifTrue: [self advance. self blockExpression. ^ true]. hereType == #leftBrace ifTrue: [self braceExpression. ^ true]. hereType == #leftParenthesis ifTrue: [self advance. self expression ifFalse: [^ self expected: 'expression']. (self match: #rightParenthesis) ifFalse: [^ self expected: 'right parenthesis']. ^ true]. hereType == #string ifTrue: [parseNode _ encoder encodeLiteral: self advance. "self emphasizeSourceTextAs: #literalConstant from: prevMark + 1 to: self endOfLastToken + 1." ^ true]. (hereType == #number or: [hereType == #literal]) ifTrue: [ parseNode _ encoder encodeLiteral: self advance. "Transcript show: parseNode key printString,' ',parseNode key class printString;cr." (parseNode key isKindOf: Number)ifTrue:[self emphasizeSourceTextAs: #literalConstant from: prevMark to: prevMark+parseNode key printString size-1]. (parseNode key isKindOf: Symbol)ifTrue:[self emphasizeSourceTextAs: #literalConstant from: prevMark-1 to: prevMark+parseNode key size-1]. (parseNode key isKindOf: Array)ifTrue:[]. ^ true]. (here == #- and: [tokenType == #number]) ifTrue: [self advance. parseNode _ encoder encodeLiteral: self advance negated. ^ true]. ^ false! ! !SyntaxHighlightingParser methodsFor: 'expression types' stamp: 'mtw 10/6/97 00:48'! scanLitVec | s | true ifTrue: [^ super scanLitVec]. s _ WriteStream on: (Array new: 16). [tokenType = #rightParenthesis or: [tokenType = #doIt]] whileFalse: [tokenType = #leftParenthesis ifTrue: [self scanToken; scanLitVec] ifFalse: [tokenType = #word | (tokenType = #keyword) ifTrue: [self scanLitWord] ifFalse: [(token == #- and: [(typeTable at: hereChar asciiValue) = #xDigit]) ifTrue: [self scanToken. token _ token negated]]]. s nextPut: token. self scanToken]. token _ s contents! ! !SyntaxHighlightingParser methodsFor: 'expression types' stamp: 'mtw 10/6/97 18:07'! statements: argNodes innerBlock: inner | stmts returns start more blockComment | stmts _ OrderedCollection new. "give initial comment to block, since others trail statements" blockComment _ currentComment. currentComment _ nil. returns _ false. more _ hereType ~~ #rightBracket. [more] whileTrue: [start _ self startOfNextToken. (returns _ self match: #upArrow) ifTrue: [self emphasizeSourceTextAs: #upArrow from: prevMark to: self endOfLastToken. self expression ifFalse: [^ self expected: 'Expression to return']. self addComment. stmts addLast: (parseNode isReturningIf ifTrue: [parseNode] ifFalse: [ReturnNode new expr: parseNode encoder: encoder sourceRange: (start to: self endOfLastToken)])] ifFalse: [self expression ifTrue: [self addComment. stmts addLast: parseNode] ifFalse: [self addComment. stmts size = 0 ifTrue: [stmts addLast: (encoder encodeVariable: (inner ifTrue: ['nil'] ifFalse: ['self']))]]]. returns ifTrue: [self match: #period. (hereType == #rightBracket or: [hereType == #doIt]) ifFalse: [^ self expected: 'End of block']]. more _ returns not and: [self match: #period]]. parseNode _ BlockNode new arguments: argNodes statements: stmts returns: returns from: encoder. parseNode comment: blockComment. ^ true! ! !SyntaxHighlightingParser methodsFor: 'expression types' stamp: 'mtw 9/21/97 23:03'! temporaries | vars aNode | (self match: #verticalBar) ifFalse: [tempsMark _ hereMark. ^ #()]. vars _ OrderedCollection new. [hereType == #word] whileTrue: [aNode := (encoder bindTemp: self advance). self emphasizeSourceTextAs: #localVariable from: prevMark to: (hereMark-1). vars addLast: aNode]. (self match: #verticalBar) ifTrue: [tempsMark _ prevMark. ^ vars]. ^ self expected: 'Vertical bar'! ! !SyntaxHighlightingParser methodsFor: 'expression types' stamp: 'mtw 10/4/97 16:21'! variable | varName varStart varEnd aVarNode | varStart _ self startOfNextToken + requestorOffset. varName _ self advance. varEnd _ self endOfLastToken + requestorOffset. aVarNode _ encoder encodeVariable: varName ifUnknown: [self correctVariable: varName interval: (varStart to: varEnd)]. self emphasizeSourceTextAs: (self getEmphasizeForVarNode: aVarNode) from: varStart to: varEnd. ^ aVarNode ! ! !SyntaxHighlightingParser methodsFor: 'multi-character scans' stamp: 'mtw 10/6/97 17:33'! xDollar "Form a Character literal." self step. "pass over $" token _ self step. self emphasizeSourceTextAs: #literalConstant from: mark-1 to: mark+1. tokenType _ #number "really should be Char, but rest of compiler doesn't know"! ! !SyntaxHighlightingParser methodsFor: 'multi-character scans' stamp: 'mtw 10/6/97 17:44'! xDoubleQuote | aStream stopChar commentStart | false ifTrue: [^ super xDoubleQuote]. commentStart _ mark. stopChar _ 30 asCharacter. aStream _ WriteStream on: (String new: 200). self step. [aStream nextPut: self step. hereChar == $"] whileFalse: [(hereChar == stopChar and: [source atEnd]) ifTrue: [^ self offEnd: 'Unmatched comment quote']]. self step. currentComment == nil ifTrue: [currentComment _ OrderedCollection with: aStream contents] ifFalse: [currentComment add: aStream contents]. self emphasizeSourceTextAs: #comment from: commentStart to: commentStart + aStream contents size+1. self scanToken! ! !SyntaxHighlightingParser methodsFor: 'multi-character scans' stamp: 'mtw 10/6/97 18:11'! xLitQuote | start tokenStart | tokenStart _ mark. self step. self scanToken. tokenType = #leftParenthesis ifTrue: [start _ mark. self scanToken; scanLitVec. self emphasizeSourceTextAs: #literalConstant from: tokenStart to: mark. tokenType == #doIt ifTrue: [mark _ start. self offEnd: 'Unmatched parenthesis']] ifFalse: [(#(word keyword colon ) includes: tokenType) ifTrue: [self scanLitWord] ifFalse: [tokenType == #literal ifTrue: [(token isMemberOf: Association) ifTrue: [token _ nil -> token key]. (token isMemberOf: Symbol) ifTrue: [token _ token -> nil]]]]. tokenType _ #literal! ! !SyntaxHighlightingParser methodsFor: 'multi-character scans' stamp: 'mtw 10/6/97 17:41'! xSingleQuote | stringStart | stringStart _ mark. self step. buffer reset. [hereChar = $' and: [aheadChar = $' ifTrue: [self step. false] ifFalse: [true]]] whileFalse: [buffer nextPut: self step. (hereChar = 30 asCharacter and: [source atEnd]) ifTrue: [^ self offEnd: 'Unmatched string quote']]. self step. token _ buffer contents. tokenType _ #string. self emphasizeSourceTextAs: #literalConstant from: stringStart to: stringStart + token size + 1! ! !SyntaxHighlightingParser methodsFor: 'error handling' stamp: 'mtw 10/6/97 22:36'! notify: string at: location "Do all Errors silent" ^self fail ! ! !SyntaxHighlightingParser class methodsFor: 'class accesing' stamp: 'mtw 10/7/97 01:05'! doSyntaxHighlighting "Every time before SyntaxHighlighting is used we ask if we should use it. When Shift is pressed at this moment we switch the use/dontuse-state" DoSyntaxHighlighting isNil ifTrue: [DoSyntaxHighlighting _ true]. InputSensor default leftShiftDown ifTrue: [DoSyntaxHighlighting _ DoSyntaxHighlighting not]. DoSyntaxHighlighting ifFalse: [EmphasizeBuffer _ OrderedCollection new]. ^ DoSyntaxHighlighting ! ! SyntaxHighlightingTextAttribute comment: 'Look for comment of SyntaxHighlightingParser'! !SyntaxHighlightingTextAttribute methodsFor: 'all' stamp: 'mtw 10/4/97 16:21'! color ^ color! ! !SyntaxHighlightingTextAttribute methodsFor: 'all' stamp: 'mtw 10/4/97 16:21'! color: aColor color _ aColor! ! !SyntaxHighlightingTextAttribute methodsFor: 'all' stamp: 'mtw 10/4/97 16:21'! dominates: another "Subclasses may override condense multiple attributes" ^ true! ! !SyntaxHighlightingTextAttribute methodsFor: 'all' stamp: 'mtw 10/4/97 16:21'! emphasisCode ^ emphasisCode! ! !SyntaxHighlightingTextAttribute methodsFor: 'all' stamp: 'mtw 10/4/97 16:21'! emphasisCode: int emphasisCode _ int. setMode _ true! ! !SyntaxHighlightingTextAttribute methodsFor: 'all' stamp: 'mtw 10/4/97 17:42'! emphasizeScanner: scanner "Set the emphasist for text display" scanner addEmphasis: emphasisCode. "Set the font for text display" scanner setFont: fontNumber. "Set the emphasis for text display" scanner textColor: color! ! !SyntaxHighlightingTextAttribute methodsFor: 'all' stamp: 'mtw 10/4/97 16:21'! fontNumber ^ fontNumber! ! !SyntaxHighlightingTextAttribute methodsFor: 'all' stamp: 'mtw 10/4/97 16:21'! fontNumber: int fontNumber _ int! ! !SyntaxHighlightingTextAttribute methodsFor: 'all' stamp: 'mtw 10/4/97 16:21'! name ^name ! ! !SyntaxHighlightingTextAttribute methodsFor: 'all' stamp: 'mtw 10/4/97 16:21'! name: aName name := aName.! ! !SyntaxHighlightingTextAttribute methodsFor: 'all' stamp: 'mtw 10/4/97 16:21'! printOn: strm super printOn: strm. strm nextPutAll: ' ',name.! ! !SyntaxHighlightingTextAttribute methodsFor: 'all' stamp: 'mtw 10/4/97 16:21'! set true ifTrue:[^true]. ^ setMode and: [emphasisCode ~= 0]! ! !SyntaxHighlightingTextAttribute methodsFor: 'all' stamp: 'mtw 10/4/97 16:21'! turnOff setMode _ false! ! !SyntaxHighlightingTextAttribute class methodsFor: 'instance creation' stamp: 'mtw 10/4/97 17:42'! newName: aName color: aColor emphasis: anEmphasis fontNr: aFontNr | aNewAtt | aNewAtt _ self new. aNewAtt name: aName; color: aColor; emphasisCode: anEmphasis emphasisCode; fontNumber: aFontNr. ^ aNewAtt ! ! !SyntaxHighlightingTextAttribute class methodsFor: 'class accessing' stamp: 'mtw 10/4/97 16:21'! getAttributeNamed: aName ^(Palette at: aName)! ! !SyntaxHighlightingTextAttribute class methodsFor: 'class initialization' stamp: 'mtw 10/6/97 22:30'! allAttributeNames ^#(allOther className globalVariable methodNamePart messageSelectorPart comment argumentVariable localVariable instanceVariable classVariable pseudoVariable undefinedVariable undefinedVariable literalConstant leftArrow upArrow)! ! !SyntaxHighlightingTextAttribute class methodsFor: 'class initialization' stamp: 'mtw 10/4/97 21:10'! changeAttributeNamed: aName color: aColor (Palette at: aName)color: aColor! ! !SyntaxHighlightingTextAttribute class methodsFor: 'class initialization' stamp: 'mtw 10/6/97 23:12'! chooseColorOfAnAttribute "SyntaxHighlightingTextAttribute chooseColorOfAnAttribute" SyntaxHighlightingTextAttribute changeAttributeNamed: (SelectionMenu selections: (SyntaxHighlightingTextAttribute allAttributeNames)) startUp asSymbol color: Color fromUser ! ! !SyntaxHighlightingTextAttribute class methodsFor: 'class initialization' stamp: 'mtw 10/6/97 23:13'! initialize "SyntaxHighlightingTextAttribute initialize" "SyntaxHighlightingTextAttribute changeAttributeNamed: ((((SelectionMenu selections:(SyntaxHighlightingTextAttribute allAttributeNames))startUp)asSymbol)) color: Color fromUser" Palette _ Dictionary new. self makeAllAttributes! ! !SyntaxHighlightingTextAttribute class methodsFor: 'class initialization' stamp: 'mtw 10/6/97 23:19'! makeAllAttributes "SyntaxHighlightingTextAttribute initialize" self makeAttributeNamed: #allOther color: (Color black) emphasis: TextEmphasis normal fontNr: 1. self makeAttributeNamed: #className color: (Color r:0 g:0.4 b: 0.2) emphasis: TextEmphasis bold fontNr: 1. self makeAttributeNamed: #globalVariable color: Color magenta emphasis: TextEmphasis bold fontNr: 1. self makeAttributeNamed: #methodNamePart color: Color black emphasis: TextEmphasis bold fontNr: 1. self makeAttributeNamed: #messageSelectorPart color: Color darkGray emphasis: TextEmphasis normal fontNr: 1. self makeAttributeNamed: #comment color: Color red emphasis: TextEmphasis normal fontNr: 1. self makeAttributeNamed: #argumentVariable color: (Color r:0.0 g:0.4 b: 1.0) emphasis: TextEmphasis normal fontNr: 1. self makeAttributeNamed: #localVariable color: Color blue emphasis: TextEmphasis normal fontNr: 1. self makeAttributeNamed: #instanceVariable color: (Color r:0.2 g:0 b:0.6) emphasis: TextEmphasis bold fontNr: 1. self makeAttributeNamed: #classVariable color: (Color r:0.2 g:0 b:0.6) emphasis: TextEmphasis bold fontNr: 1. self makeAttributeNamed: #pseudoVariable color: (Color r:0.2 g:0 b:0.6) emphasis: TextEmphasis italic fontNr: 1. self makeAttributeNamed: #undefinedVariable color: Color black emphasis: TextEmphasis struckOut fontNr: 1. self makeAttributeNamed: #literalConstant color: Color brown emphasis: TextEmphasis normal fontNr: 1. self makeAttributeNamed: #leftArrow color: Color orange emphasis: TextEmphasis bold fontNr: 1. self makeAttributeNamed: #upArrow color: Color orange emphasis: TextEmphasis bold fontNr: 1! ! !SyntaxHighlightingTextAttribute class methodsFor: 'class initialization' stamp: 'mtw 10/6/97 23:12'! makeAttributeNamed: aName color: aColor emphasis: anEmphasis fontNr: aFontNr Palette at: aName put: (SyntaxHighlightingTextAttribute newName: aName color: aColor emphasis: anEmphasis fontNr: aFontNr)! ! SyntaxHighlightingTextAttribute initialize! ================================================================== pub/Smalltalk/Squeak/Goodies/CrLfFileStream.st ================================================================== '' NAME CrLfFileStream.st AUTHOR raab@isg.cs.uni-magdeburg.de (Andreas Raab) URL (none) FUNCTION Detect and process line end conventions in file streams KEYWORDS files, stream, line end convention, cross-platform ST-VERSIONS Squeak PREREQUISITES (none) CONFLICTS (none known) DISTRIBUTION world VERSION 1.0 DATE 23-Jan-98 SUMMARY Provides class CrLfFileStream for automaticallydetecting line end conventions on external files. You can install it permanently by changing FileStream class>>concreteStream as follows: FileStream class>>concreteStream 'Who should we really direct class queries to? ' ^CrLfFileStream Andreas Raab ''! ================================================================== pub/Smalltalk/Squeak/Goodies/Siren1/CATALOG-CARD ================================================================== '' NAME Siren 1.31 Beta AUTHOR stp@create.ucsb.edu (Stephen Travis Pope) URL (none) FUNCTION Squeak Smalltalk Music/Sound Framework and Toolkit KEYWORDS muisc, sound, MIDI, real-time ST-VERSIONS Squeak PREREQUISITES Squeak 1.31 CONFLICTS (none known) DISTRIBUTION world VERSION 1.31 DATE 26-Feb-98 INSTALLATION See on-line build script SUMMARY The Siren system is a general-purpose music description and composition system; it is a re-implementation of the Musical Object Development Environment (MODE), the software component of the Interim DynaPiano project. Siren is a collection of Squeak Smalltalk class libraries for building musical applications; it is known to work on Squeak version 1.31 running on an Apple PowerPC-based Macintosh computer with support for the Opcode MIDI System (OMS) drivers and CD-quality stereo audio I/O. The Siren 1.31 beta release is now available via anonymous Internet ftp file transfer from the directory pub/Smalltalk/Music/Siren on the server ftp.create.ucsb.edu (i.e., the URL of the directory is ftp://ftp.create.ucsb.edu/pub/Smalltalk/Music/Siren). Stephen Travis Pope ''! ================================================================== pub/Smalltalk/Squeak/Goodies/PointDD/CATALOG-CARD ================================================================== '' NAME Point Double Dispatching AUTHOR tkc@bmi.net; tgriggs@keyww.com (Travis Griggs) URL (none) FUNCTION Changes Point to use double dispatching for math ops KEYWORDS point math number ST-VERSIONS Squeak PREREQUISITES Core Math Double Dispatching CONFLICTS (none known) DISTRIBUTION world VERSION 1.0 DATE 31-Jan-98 INSTALLATION PointDD1.csPointDD2.csPointDD3.cs SUMMARY see PointDD.txt Travis Griggs ''! ================================================================== pub/Smalltalk/Squeak/Goodies/Fraction-sumFromInteger.st ================================================================== '' NAME Patch to TAG's Squeak double-dispatching AUTHOR Stephen Pope (stp@create.ucsb.edu) URL (none) FUNCTION Fix for (1 + (1/4)) mixed-mode math ST-VERSIONS Squeak PREREQUISITES Squeak 1.3 CONFLICTS (none) DISTRIBUTION world VERSION 1.3.0 (first version for Squeak 1.3) DATE 2/18/98 SUMMARY There are a few methods missing from TAG's excellent double-dispatching code--here's one of them that fixes (int + fraction). ''! ================================================================== pub/Smalltalk/Squeak/Goodies/FileContentsBrowser-v0.1a.st ================================================================== '' NAME FileContentsBrowser.st AUTHOR raab@isg.cs.uni-magdeburg.de (Andreas Raab) URL (none) FUNCTION Browser for the contents of files containing Smalltalk source code KEYWORDS Browser, Smalltalk source files ST-VERSIONS Squeak PREREQUISITES (none) CONFLICTS (none known) DISTRIBUTION world VERSION 0.1 DATE 28-Mar-98 SUMMARY This file contains a browser to view the contentsof Smalltalk source files by a standard classbrowser. The contents of the source file(s) isscanned and grouped into package/class/category.After this package has been filed in choose'browse selected class' from the file list menu. Andreas Raab ''! ================================================================== pub/Smalltalk/Squeak/Goodies/FileContentsBrowser.st ================================================================== '' NAME FileContentsBrowser.st AUTHOR raab@isg.cs.uni-magdeburg.de (Andreas Raab) URL (none) FUNCTION Browser for the contents of files containing Smalltalk source code KEYWORDS Browser, Smalltalk source files ST-VERSIONS Squeak PREREQUISITES (none) CONFLICTS (none known) DISTRIBUTION world VERSION 0.1 DATE 28-Mar-98 SUMMARY This file contains a browser to view the contentsof Smalltalk source files by a standard classbrowser. The contents of the source file(s) isscanned and grouped into package/class/category.After this package has been filed in choose'browse selected class' from the file list menu. Andreas Raab ''! ================================================================== pub/Smalltalk/Squeak/Goodies/CrLfFileStream-v1.1..st ================================================================== '' NAME CrLfFileStream.st AUTHOR raab@isg.cs.uni-magdeburg.de (Andreas Raab) URL (none) FUNCTION Detect and process line end conventions in file streams KEYWORDS files, stream, line end convention, cross-platform ST-VERSIONS Squeak PREREQUISITES (none) CONFLICTS (none known) DISTRIBUTION world VERSION 1.1 DATE 28-Mar-98 SUMMARY Provides class CrLfFileStream for automaticallydetecting line end conventions on external files. You can install it permanently by changingFileStream class>>concreteStream as follows:FileStream class>>concreteStream 'Who should we really direct class queries to? ' ^CrLfFileStream Andreas Raab ''! ================================================================== pub/Smalltalk/Squeak/Goodies/FileContentsBrowser-v0.2.st ================================================================== '' NAME FileContentsBrowser AUTHOR raab@isg.cs.uni-magdeburg.de (Andreas Raab) URL (none) FUNCTION Browser for the contents of files containing Smalltalk source code KEYWORDS Browser, Smalltalk source files, Porting ST-VERSIONS Squeak PREREQUISITES (none) CONFLICTS (none known) DISTRIBUTION world VERSION 0.2 DATE 04-Apr-98 SUMMARY While the class browser is a great tool it can currently not be used to give us a 'structured view' on a (syntactically correct) Smalltalk source code file. That's exactly what the FileContentsBrowser is doing.It just scans the file and you can browse the classes and methods of this file _without_ having to actually install it. You can browse the classes, methods, and comments just like in a real class browser. Even better, you can rename/remove/reorganize all the stuff and once you're done you can either file it in (i.e., install it) or file it out again for later work.Features: * Browse either single files or entire collections * Rename/Remove/Reorganize classes or methods * Remove all unchanged methods so that you see where actual differences are * Highlights differences in already existing methods * Highlights differences to already existing class definitions * Keeps all unknown doIts so you can decide what to do with them * Install entire packages, classes, categories, or methods from a package * FileOut modified packages so you can distribute or work later on themHow to use it: After installing FileContentsBrowser.st open a NEW FileList and select 'browse selected file(s)' from it. If you have selected a file it will just browse the single file. If you haven't selected a file than you can give a pattern for the files from the current directory. Andreas Raab ''! ================================================================== pub/Smalltalk/Squeak/Goodies/XBaseFile.st ================================================================== '' NAME XBaseFile AUTHOR criter@tin.it (Antonio d'Avino - NAPLES (ITALY)) URL (none) FUNCTION Creating and accessing xBase file (DBIII/IV, Clipper etc.) KEYWORDS DBase sDBase DBIII DBIV CLIPPER ST-VERSIONS Squeak PREREQUISITES (none) CONFLICTS (none known) DISTRIBUTION world VERSION 1.00 DATE 16-Apr-98 SUMMARY -----------------------A pure Smalltalk class giving a full access to xDBase files. --------------------------- Fully compatible with CLIPPER(TM) 5.xx and DB III/IV (TM) Files. V. 1.00 Feb 13, 1998. Please, feel free to post your messages to andavino@tin.it. NEXT STEPS * Index management * Visual xBase files maintenance tool ...... stay tuned !-----------------------A pure Smalltalk class giving a full access to xDBase files. --------------------------- Fully compatible with CLIPPER(TM) 5.xx and DB III/IV (TM) Files. V. 1.00 Feb 13, 1998. Please, feel free to post your messages to criter@tin.it NEXT STEPS * Index management* Visual xBase files maintenance tool Antonio d'Avino - NAPLES (ITALY) ''!