'From Squeak3.8gamma of ''24 November 2004'' [latest update: #6548] on 23 March 2005 at 4:50:57 pm'! !Compiler methodsFor: 'public access' stamp: 'ab 3/23/2005 16:47'! compiledMethodFor: aString in: aContext to: aReceiver "evaluate aString in the given context, and return the result. 2/2/96 sw" | result | result _ self compiledMethodFor: aString in: aContext to: aReceiver notifying: nil ifFail: [^#Failed] logged: false. ^ result! ! !Compiler methodsFor: 'public access' stamp: 'ab 3/23/2005 16:48'! compiledMethodFor: textOrStream in: aContext to: receiver notifying: aRequestor ifFail: failBlock logged: logFlag "Compiles the sourceStream into a parse tree, then generates code into a method. This method is then installed in the receiver's class so that it can be invoked. In other words, if receiver is not nil, then the text can refer to instance variables of that receiver (the Inspector uses this). If aContext is not nil, the text can refer to temporaries in that context (the Debugger uses this). If aRequestor is not nil, then it will receive a notify:at: message before the attempt to evaluate is aborted. Finally, the compiled method is invoked from here as DoIt or (in the case of evaluation in aContext) DoItIn:. The method is subsequently removed from the class, but this will not get done if the invocation causes an error which is terminated. Such garbage can be removed by executing: Smalltalk allBehaviorsDo: [:cl | cl removeSelector: #DoIt; removeSelector: #DoItIn:]." | methodNode method | class _ (aContext == nil ifTrue: [receiver] ifFalse: [aContext receiver]) class. self from: textOrStream class: class context: aContext notifying: aRequestor. methodNode _ self translate: sourceStream noPattern: true ifFail: [^failBlock value]. method _ methodNode generate: #(0 0 0 0). self interactive ifTrue: [method _ method copyWithTempNames: methodNode tempNames]. logFlag ifTrue: [SystemChangeNotifier uniqueInstance evaluated: sourceStream contents context: aContext]. ^ method.! ! !Debugger methodsFor: 'initialize' stamp: 'ab 3/23/2005 14:03'! customButtonSpecs "Answer an array of elements of the form wording, selector, help-message, that characterize the custom button row of a debugger." | list | list _ #(('Proceed' proceed 'close the debugger and proceed.') ('Restart' restart 'reset this context to its start.') ('Into' send 'step Into message sends') ('Over' doStep 'step Over message sends') ('Through' stepIntoBlock 'step into a block') ('Full Stack' fullStack 'show full stack') ('Where' where 'select current pc range') ('Tally' tally 'time in milliseconds to execute')). Preferences restartAlsoProceeds ifTrue: [list _ list collect: [:each | each second == #restart ifTrue: [each copy at: 3 put: 'proceed from the beginning of this context.'; yourself] ifFalse: [each]]]. ^ list! ! !Debugger methodsFor: 'tally support' stamp: 'ab 3/23/2005 16:43'! getSelectedText | m interval text | m := self getTextMorph. interval := m selectionInterval. text := m text. ^ text copyFrom: interval first to: interval last ! ! !Debugger methodsFor: 'tally support' stamp: 'ab 3/23/2005 16:43'! getTextMorph ^ (self dependents select: [:m| m class == PluggableTextMorph]) first! ! !Debugger methodsFor: 'tally support' stamp: 'ab 3/23/2005 16:42'! tally self getTextMorph tallyIt. ! ! !ParagraphEditor methodsFor: 'do-its' stamp: 'ab 3/23/2005 16:49'! tallyIt ^ self tallySelection! ! !ParagraphEditor methodsFor: 'do-its' stamp: 'ab 3/23/2005 16:49'! tallySelection "Treat the current selection as an expression; evaluate it and return the time took for this evaluation" | result rcvr ctxt cm v valueAsString | self lineSelectAndEmptyCheck: [^ -1]. (model respondsTo: #doItReceiver) ifTrue: [FakeClassPool adopt: model selectedClass. "Include model pool vars if any" rcvr _ model doItReceiver. ctxt _ model doItContext] ifFalse: [rcvr _ ctxt _ nil]. result _ [ cm := rcvr class evaluatorClass new compiledMethodFor: self selectionAsStream in: ctxt to: rcvr notifying: self ifFail: [FakeClassPool adopt: nil. ^ #failedDoit] logged: false. Time millisecondsToRun: [v := cm valueWithReceiver: rcvr arguments: (Array with: ctxt)]. ] on: OutOfScopeNotification do: [ :ex | ex resume: true]. FakeClassPool adopt: nil. "We do not want to have large result displayed" valueAsString := v printString. (valueAsString size > 30) ifTrue: [valueAsString := (valueAsString copyFrom: 1 to: 30), '...']. PopUpMenu inform: 'Time to compile and execute: ', result printString, 'ms res: ', valueAsString. ! ! !ParagraphEditor class methodsFor: 'class initialization' stamp: 'ab 3/23/2005 16:50'! initializeTextEditorMenus "Initialize the yellow button pop-up menu and corresponding messages." "ParagraphEditor initializeTextEditorMenus" TextEditorYellowButtonMenu _ SelectionMenu fromArray: { {'find...(f)' translated. #find}. {'find again (g)' translated. #findAgain}. {'set search string (h)' translated. #setSearchString}. #-. {'do again (j)' translated. #again}. {'undo (z)' translated. #undo}. #-. {'copy (c)' translated. #copySelection}. {'cut (x)' translated. #cut}. {'paste (v)' translated. #paste}. {'paste...' translated. #pasteRecent}. #-. {'do it (d)' translated. #doIt}. {'print it (p)' translated. #printIt}. {'inspect it (i)' translated. #inspectIt}. {'explore it (I)' translated. #exploreIt}. {'debug it' translated. #debugIt}. {'tally it' translated. #tallyIt}. #-. {'accept (s)' translated. #accept}. {'cancel (l)' translated. #cancel}. #-. {'show bytecodes' translated. #showBytecodes}. #-. {'more...' translated. #shiftedTextPaneMenuRequest}. } ! ! !PluggableTextMorph methodsFor: 'menu commands' stamp: 'ab 3/23/2005 16:50'! tallyIt self handleEdit: [textMorph editor tallyIt]! ! !Debugger reorganize! ('initialize' buildMVCDebuggerViewLabel:minSize: buildMVCNotifierButtonView buildMVCNotifierViewLabel:message:minSize: buildMVCOptionalButtonsButtonsView buttonRowForPreDebugWindow: customButtonRow customButtonSpecs debugAt: errorWasInUIProcess: initialExtent notifierButtonHeight openFullMorphicLabel: openFullNoSuspendLabel: openNotifierContents:label: optionalAnnotationHeight optionalButtonHeight optionalButtonPairs optionalButtonRow preDebugButtonQuads preDebugNotifierContentsFrom: release wantsOptionalButtons windowIsClosing) ('accessing' contents contents:notifying: contextVariablesInspector doNothing: interruptedContext interruptedProcess isNotifier labelString labelString: proceedValue proceedValue: receiver receiverInspector) ('notifier menu' debug storeLog) ('context stack (message list)' contextStackIndex contextStackList expandStack fullyExpandStack messageListIndex selectedMessage selectedMessageName toggleContextStackIndex:) ('context stack menu' abandon abandon: askForCategoryIn:default: browseMessages browseSendersOfMessages browseVersions buildMessageBrowser buildMorphicNotifierLabelled:message: close: contextStackKey:from: contextStackMenu:shifted: debugProceedMenu: doStep down fullStack implement:inClass: mailOutBugReport messageListMenu:shifted: peelToFirst populateImplementInMenu: proceed proceed: restart returnValue selectPC send stepIntoBlock up where) ('code pane' contentsSelection createSyntaxMorph doItContext doItReceiver pc pcRange toggleSyntaxMorph) ('code pane menu' perform:orSendTo:) ('message category list' selectedMessageCategoryName) ('class list' selectedClass selectedClassOrMetaClass) ('dependents access' step updateInspectors wantsSteps) ('private' askForSuperclassOf:toImplement:ifCancel: checkContextSelection contextStackIndex:oldContextWas: createMethod externalInterrupt: isolationRecoveryAdvice lowSpaceChoices newStack: process:controller:context: process:controller:context:isolationHead: resetContext: resumeProcess: selectedContext) ('controls' addOptionalButtonsTo:at:plus:) ('as yet unclassified' codePaneMenu:shifted: runToSelection:) ('breakpoints' toggleBreakOnEntry) ('tally support' getSelectedText getTextMorph tally) ! !Compiler reorganize! ('error handling' interactive notify: notify:at:) ('public access' compile:in:notifying:ifFail: compileNoPattern:in:context:notifying:ifFail: compiledMethodFor:in:to: compiledMethodFor:in:to:notifying:ifFail:logged: evaluate:in:to: evaluate:in:to:notifying:ifFail: evaluate:in:to:notifying:ifFail:logged: format:in:notifying:contentsSymbol: format:in:notifying:decorated: parse:in:notifying: parse:in:notifying:dialect:) ('private' cacheDoItNode: dialectParserClass format:noPattern:ifFail: from:class:context:notifying: parserClass parserClass: translate:noPattern:ifFail:) ('*tallysupport-public') ! ParagraphEditor initializeTextEditorMenus!