diff -r 2efd2b9419c4 -r f67b97bc683a MethodFinderWindow.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/MethodFinderWindow.st Mon Nov 05 16:48:27 2001 +0100 @@ -0,0 +1,723 @@ +"{ Package: 'stx:libtool2' }" + +ApplicationModel subclass:#MethodFinderWindow + instanceVariableNames:'argumentsEditor messageAnswerEditor receiverEditor receiver + resultSelectors arg2BoxVisible arg1BoxVisible arg4BoxVisible + arg3BoxVisible argCountHolder argCountList argument1Editor + argument2Editor argument3Editor argument4Editor resultSelected + lookAtResultEditor' + classVariableNames:'' + poolDictionaries:'' + category:'MethodFinder-James' +! + + +!MethodFinderWindow class methodsFor:'interface specs'! + +windowSpec + "This resource specification was automatically generated + by the UIPainter of ST/X." + + "Do not manually edit this!! If it is corrupted, + the UIPainter may not be able to read the specification." + + " + UIPainter new openOnClass:MethodFinderWindow andSelector:#windowSpec + MethodFinderWindow new openInterface:#windowSpec + MethodFinderWindow open + " + + + + ^ + #(#FullSpec + #name: #windowSpec + #window: + #(#WindowSpec + #label: 'MethodFinder' + #name: 'MethodFinder' + #min: #(#Point 10 10) + #max: #(#Point 1280 1024) + #bounds: #(#Rectangle 16 47 818 718) + ) + #component: + #(#SpecCollection + #collection: #( + #(#ComboListSpec + #name: 'allowedArgments' + #layout: #(#LayoutFrame 0 0.201912 4 0 0 0.364397 22 0) + #model: #argCountHolder + #comboList: #argCountList + #useIndex: true + ) + #(#ActionButtonSpec + #label: 'Search' + #name: 'Button1' + #layout: #(#LayoutFrame 0 0.426523 132 0 0 0.575866 154 0) + #translateLabel: true + #tabable: true + #model: #search + ) + #(#ActionButtonSpec + #label: 'Clear' + #name: 'Button2' + #layout: #(#LayoutFrame 0 0.258065 132 0 0 0.407407 154 0) + #translateLabel: true + #model: #clear + ) + #(#SequenceViewSpec + #name: 'List1' + #layout: #(#LayoutFrame 0 0 161 0 0 0.6 0 0.5) + #hasHorizontalScrollBar: true + #hasVerticalScrollBar: true + #autoHideScrollBars: true + #valueChangeSelector: #updateImplementorsOf: + #useIndex: true + #sequenceList: #resultHolder + ) + #(#SequenceViewSpec + #name: 'List2' + #layout: #(#LayoutFrame 0 0.6 0 0 0 1 0 0.5) + #hasHorizontalScrollBar: true + #hasVerticalScrollBar: true + #autoHideScrollBars: true + #doubleClickSelector: #openBrowserOn: + #useIndex: false + #sequenceList: #classOfResultHolder + ) + #(#HorizontalPanelViewSpec + #name: 'HorizontalPanel1' + #layout: #(#LayoutFrame 6 0 26 0 0 0.6 129 0) + #horizontalLayout: #fit + #verticalLayout: #fit + #horizontalSpace: 3 + #verticalSpace: 3 + #component: + #(#SpecCollection + #collection: #( + #(#WorkspaceSpec + #name: 'ReceiverEditor' + #tabable: true + #hasHorizontalScrollBar: false + #hasVerticalScrollBar: false + #autoHideScrollBars: true + #extent: #(#Point 156 103) + #postBuildCallback: #receiverWidgetCreated: + ) + #(#VerticalPanelViewSpec + #name: 'VerticalPanel1' + #horizontalLayout: #fit + #verticalLayout: #fit + #horizontalSpace: 3 + #verticalSpace: 3 + #component: + #(#SpecCollection + #collection: #( + #(#ViewSpec + #name: 'Box1' + #visibilityChannel: #arg1BoxVisible + #component: + #(#SpecCollection + #collection: #( + #(#WorkspaceSpec + #name: 'Arg1Editor' + #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0) + #tabable: true + #hasHorizontalScrollBar: false + #hasVerticalScrollBar: false + #autoHideScrollBars: true + #postBuildCallback: #argument1WidgetCreated: + ) + ) + + ) + #extent: #(#Point 156 32) + ) + #(#ViewSpec + #name: 'Box2' + #visibilityChannel: #arg2BoxVisible + #component: + #(#SpecCollection + #collection: #( + #(#WorkspaceSpec + #name: 'TextEditor5' + #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0) + #tabable: true + #hasHorizontalScrollBar: false + #hasVerticalScrollBar: false + #autoHideScrollBars: true + #postBuildCallback: #argument2WidgetCreated: + ) + ) + + ) + #extent: #(#Point 156 33) + ) + #(#ViewSpec + #name: 'Box3' + #visibilityChannel: #arg3BoxVisible + #component: + #(#SpecCollection + #collection: #( + #(#WorkspaceSpec + #name: 'TextEditor6' + #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0) + #tabable: true + #hasHorizontalScrollBar: false + #hasVerticalScrollBar: false + #autoHideScrollBars: true + #postBuildCallback: #argument3WidgetCreated: + ) + ) + + ) + #extent: #(#Point 156 32) + ) + ) + + ) + #extent: #(#Point 156 103) + ) + #(#WorkspaceSpec + #name: 'AnswerEditor' + #tabable: true + #hasHorizontalScrollBar: false + #hasVerticalScrollBar: false + #autoHideScrollBars: true + #extent: #(#Point 157 103) + #postBuildCallback: #messageAnswerWidgetCreated: + ) + ) + + ) + ) + #(#LabelSpec + #label: 'MessageAnswer' + #name: 'MessageAnswerLabel' + #layout: #(#LayoutFrame 325 0 2 0 475 0 25 0) + #translateLabel: true + #adjust: #left + ) + #(#LabelSpec + #label: 'Reciever' + #name: 'RecieverLabel' + #layout: #(#LayoutFrame 7 0 3 0 126 0 26 0) + #translateLabel: true + #adjust: #left + ) + #(#WorkspaceSpec + #name: 'TextEditor4' + #layout: #(#LayoutFrame 0 0 0 0.5 0 1 0 1) + #model: #provideHelpComment + #hasHorizontalScrollBar: true + #hasVerticalScrollBar: true + ) + #(#WorkspaceSpec + #name: 'Workspace1' + #layout: #(#LayoutFrame 0 0 0 0.5 0 0.5 0 1) + #model: #resultSelected + #hasHorizontalScrollBar: true + #hasVerticalScrollBar: true + #postBuildCallback: #lookAtResultEditor: + ) + ) + + ) + ) +! ! + +!MethodFinderWindow methodsFor:'accessing'! + +receiver + "return the value of the instance variable 'receiver' (automatically generated)" + + ^ receiver copy +! ! + +!MethodFinderWindow methodsFor:'actions'! + +argumentEditorsContents + | tempArguments argCounter tempArgument1Editor tempArgument2Editor tempArgument3Editor tempArgument4Editor +associationKey associationValue| + +argCounter:=0. + +tempArgument1Editor:= (self cleanInputs: argument1Editor contents). +tempArgument2Editor:= (self cleanInputs: argument2Editor contents). +tempArgument3Editor:= (self cleanInputs: argument3Editor contents). + +tempArgument1Editor = '' ifFalse:[argCounter:=argCounter +1]. +tempArgument2Editor = '' ifFalse:[argCounter:=argCounter +1]. +tempArgument3Editor = '' ifFalse:[argCounter:=argCounter +1]. + + +argCounter:= (argCounter min: (self argCountHolder value -1)). +tempArguments:= OrderedDictionary new:argCounter. + +(argCounter value >= 1) + ifTrue:[associationValue:= (Compiler evaluate: tempArgument1Editor). + ((self isExpression:tempArgument1Editor) or:[ associationValue isNil]) ifTrue:[ "looks if an expression is typed in" + associationKey:=associationValue printString] + ifFalse:[ + associationKey:=tempArgument1Editor]. + + tempArguments add: associationKey-> associationValue. + ]. +(argCounter value >= 2) + ifTrue:[ associationValue:= (Compiler evaluate: tempArgument2Editor). + (((self isExpression:tempArgument2Editor) or:[ associationValue isNil])) ifTrue:[ "looks if an expression is typed in" + associationKey:=associationValue printString] + ifFalse:[ + associationKey:=tempArgument2Editor]. + + tempArguments add: associationKey-> associationValue]. + +(argCounter value >= 3) + ifTrue:[ associationValue:= (Compiler evaluate: tempArgument3Editor). + ((self isExpression:tempArgument3Editor) or:[ associationValue isNil]) ifTrue:[ "looks if an expression is typed in" + associationKey:=associationValue printString] + ifFalse:[ + associationKey:=tempArgument3Editor]. + + tempArguments add: associationKey-> associationValue]. + + +^tempArguments +! + +clear + "automatically generated by UIPainter ..." + + "*** the code below performs no action" + + "*** (except for some feedback on the Transcript)" + + "*** Please change as required and accept in the browser." + + "action to be added ..." + + receiverEditor contents:nil. + argument1Editor contents:nil. + argument2Editor contents:nil. + argument3Editor contents:nil. + messageAnswerEditor contents:nil. + self resultHolder value:nil. + Transcript showCR:self class name , ': action for reset ...' +! + +isExpression: aString + +(aString includesSubString:': ') ifTrue:[^true]. +(aString includesSubString:'+') ifTrue:[^true]. +(aString includesSubString:'-') ifTrue:[^true]. +(aString includesSubString:'*') ifTrue:[^true]. +(aString includesSubString:'/') ifTrue:[^true]. +(aString includesSubString:'>') ifTrue:[^true]. +(aString includesSubString:'<') ifTrue:[^true]. +(aString includesSubString:' new') ifTrue:[^true]. +(aString includesSubString:'[') & (aString includesSubString:']') & (aString includesSubString:'.') + ifTrue:[^false]. +(aString includesSubString:'.') ifTrue:[^true]. + + ^false +! + +lookAtMessage: anArgument + "Opens browser on theArgument of a specific class. anArgument being a string with the + Class and the selector upon which the browser is to be opened." + + |aClass aSelector x theArgument| + self halt. + + +! + +messageAnswerEditorContents + + | aCleanedAnswerString compiledAnswer | + +aCleanedAnswerString:=self cleanInputs: (messageAnswerEditor contents). + +compiledAnswer:=Compiler evaluate: aCleanedAnswerString. +((self isExpression:aCleanedAnswerString) or:[compiledAnswer isNil]) ifTrue:[ + aCleanedAnswerString:=compiledAnswer printString]. + +^aCleanedAnswerString->compiledAnswer. +! + +openBrowserOn:anArgument + "Opens browser on theArgument of a specific class. anArgument being a string with the + Class and the selector upon which the browser is to be opened." + + |aClass aSelector x theArgument| + + anArgument isNil ifTrue:[ + ^ self + ]. + (anArgument at:1) == $* ifTrue:[ + theArgument := anArgument copyFrom:2 + ] ifFalse:[ + theArgument := anArgument + ]. + aClass := theArgument copyUpTo:(Character space). + x := aClass size + 2. + aSelector := theArgument copyFrom:x. + aClass := Smalltalk classNamed:aClass. + SystemBrowser openInClass:(aClass) selector:(aSelector asSymbol) "/ Compiler evaluate: (aClass asSymbol). +! + +receiverEditorContents + | aCleanedRecieverString compiledReceiver | + +aCleanedRecieverString:=self cleanInputs: (receiverEditor contents). + +compiledReceiver:=Compiler evaluate: aCleanedRecieverString. + +((self isExpression:aCleanedRecieverString) or:[compiledReceiver isNil]) ifTrue:[ + aCleanedRecieverString:=compiledReceiver printString]. +^aCleanedRecieverString->compiledReceiver. +! + +search +| tempReceiver tempAnswer tempArguments anArray resultArray receiverWithArgument mf| + +self resultHolder value: nil. "reset the result list" +self classOfResultHolder value: nil. "reset the implementorOf list" + +tempArguments:=self argumentEditorsContents. +tempReceiver :=self receiverEditorContents . +tempAnswer:= self messageAnswerEditorContents. + +"self cleanInputRec:tempReceiver arg:tempArguments ans:tempAnswer." + + +anArray:=Array new:2. "creates an array which is to be used as input for the method finder." + +receiverWithArgument:=self mergReciever: (tempReceiver value) WithArgument: (tempArguments values). + +anArray at:1 put:receiverWithArgument; + at:2 put: tempAnswer value. + +"an array now holds the following array #(#(receiver argument) answer) or #(#(reciever) answer). which should +be suitable input for the method finder." +self halt. +mf:= MethodFinder new. +resultArray:= mf load: anArray; findMessage. + +((resultArray at: 1 )includesSubString: 'no single') ifTrue:[ + self warn: (resultArray at: 1 ). + ^self + ]. + +"the following then replaces data1 and data2 created by the method finder to the appropriate arguments" +resultArray keysAndValuesDo:[:key :value | | newValue | + newValue:= value replString: 'data1' withString:(tempReceiver key). +(tempArguments size) >= 1 ifTrue:[ + newValue:= newValue replString: 'data2' withString:(tempArguments keyAt:1)]. + +(tempArguments size) > 1 ifTrue:[ + newValue:= newValue replString: 'data3' withString:(tempArguments keyAt:2).]. + +(tempArguments size) > 2 ifTrue:[ + newValue:= newValue replString: 'data4' withString:(tempArguments keyAt:3).]. + + + " newValue:= value replString: 'data3' withString:(self messageAnswer key). " + + newValue:=newValue, ' --> ', (tempAnswer key). + + resultArray at: key put: newValue. + + ]. + +self resultHolder value: resultArray. +resultSelectors:= mf selectors. "used to find implementors so we do not have to " +receiver:=tempReceiver "search the string for the selector found. Stored as an ordered collection" +! + +updateImplementorsOf:anInteger + " Request the implementors of the selected arguments " + |methods classList aNumber| + + self updateWorkSpace: anInteger . + (anInteger isNil) ifTrue:[^self]. + anInteger isNil ifTrue:[aNumber:=1] + ifFalse:[aNumber:=anInteger]. + methods _ SystemBrowser findImplementorsOf: (resultSelectors at:aNumber) in:Smalltalk allClasses ignoreCase:false. + classList _ methods asOrderedCollection collect:[:m | m mclass name , ' ' , m selector]. + + classList:=(self markMatchingClasses:(resultSelectors at:aNumber) classesWithSelector:classList). + + self classOfResultHolder value: classList. +! + +updateWorkSpace: anInteger + + + anInteger isNil ifTrue:[^self]. + resultSelected:= (self resultHolder value at:anInteger). + lookAtResultEditor replace:(resultSelected). +! ! + +!MethodFinderWindow methodsFor:'aspects'! + +arg1BoxVisible + arg1BoxVisible isNil ifTrue:[ + arg1BoxVisible := BlockValue + with:[:vh | vh value >= 2 ] + argument:(self argCountHolder) + ]. + ^ arg1BoxVisible. +! + +arg2BoxVisible + arg2BoxVisible isNil ifTrue:[ + arg2BoxVisible := BlockValue + with:[:vh | vh value >= 3 ] + argument:(self argCountHolder) + ]. + ^ arg2BoxVisible. +! + +arg3BoxVisible + arg3BoxVisible isNil ifTrue:[ + arg3BoxVisible := BlockValue + with:[:vh | vh value >= 4 ] + argument:(self argCountHolder) + ]. + ^ arg3BoxVisible. +! + +arg4BoxVisible + arg4BoxVisible isNil ifTrue:[ + arg4BoxVisible := BlockValue + with:[:vh | vh value >= 5 ] + argument:(self argCountHolder) + ]. + ^ arg4BoxVisible. +! + +argCountHolder + argCountHolder isNil ifTrue:[ + argCountHolder := 2 asValue. + ]. + ^ argCountHolder. +! + +argCountList + argCountList isNil ifTrue:[ + argCountList := #('0 arguments' '1 argument' '2 arguments' '3 arguments') asValue + ]. + ^ argCountList. +! + +classOfResultHolder + "Stores a valueHolder for " + + |holder| + + (holder := builder bindingAt:#classOfResultHolder) isNil ifTrue:[ + holder := ValueHolder new. + builder aspectAt:#classOfResultHolder put:holder + ]. + ^ holder +! + +resultHolder + "automatically generated by UIPainter ..." + + "*** the code below creates a default model when invoked." + "*** (which may not be the one you wanted)" + "*** Please change as required and accept it in the browser." + "*** (and replace this comment by something more useful ;-)" + + |holder| + + (holder := builder bindingAt:#resultHolder) isNil ifTrue:[ + holder := ValueHolder new. + builder aspectAt:#resultHolder put:holder. +"/ if your app needs to be notified of changes, uncomment one of the lines below: +"/ holder addDependent:self. +"/ holder onChangeSend:#resultHolderChanged to:self. + ]. + ^ holder. +! ! + +!MethodFinderWindow methodsFor:'callBacks'! + +argument1WidgetCreated: aWidget + argument1Editor := aWidget scrolledView. +! + +argument2WidgetCreated: aWidget + + argument2Editor := aWidget scrolledView. +! + +argument3WidgetCreated: aWidget + + argument3Editor := aWidget scrolledView. +! + +argumentsWidgetCreated: aWidget + + argumentsEditor := aWidget scrolledView. +! + +lookAtResultEditor: aWidget + + lookAtResultEditor := aWidget scrolledView. +! + +messageAnswerWidgetCreated: aWidget + + messageAnswerEditor := aWidget scrolledView. +! + +provideHelpComment + self halt. +^'test' +! + +receiverWidgetCreated: aWidget + + receiverEditor := aWidget scrolledView. +! ! + +!MethodFinderWindow methodsFor:'controlInput'! + +cleanInputs: aDirtyString + "Find an remove common mistakes. Complain when ill formed." + | aStringToBeCleaned rs position| + + aStringToBeCleaned:=aDirtyString. + +(aStringToBeCleaned endsWith:(Character cr)) ifTrue:[ + aStringToBeCleaned:=aStringToBeCleaned copyFrom:1 to: (aStringToBeCleaned size -1).]. +aStringToBeCleaned:= aStringToBeCleaned withoutSeparators. + + +rs:=ReadStream on: aStringToBeCleaned. +[rs upToAll: '#true'. rs atEnd] whileFalse: [ + position:= rs position. + aStringToBeCleaned:=aStringToBeCleaned copyReplaceFrom: position to: position with: ''. "remove #" + rs:=ReadStream on: aStringToBeCleaned. + ]. + +rs:=ReadStream on: aStringToBeCleaned. +[rs upToAll: '#false'. rs atEnd] whileFalse: [ + position:= rs position. + aStringToBeCleaned:=aStringToBeCleaned copyReplaceFrom: position to: position with: ''. "remove #" + rs:=ReadStream on: aStringToBeCleaned. + rs:=ReadStream on: aStringToBeCleaned. ]. + +[rs upToAll: '#nil'. rs atEnd] whileFalse: [ + position:= rs position. + aStringToBeCleaned:=aStringToBeCleaned copyReplaceFrom: position to: position with: ''. "remove #" + rs:=ReadStream on: aStringToBeCleaned. ]. + ^aStringToBeCleaned +! + +markMatchingClasses + "If an example is used, mark classes matching the example instance with an asterisk." + + | unmarkedClassList firstPartOfSelector receiverString receiver | + + "Only 'example' queries can be marked." + + unmarkedClassList _ resultSelectors copy. + + + + + unmarkedClassList do: + [:classAndMethod | | class | + class _ Compiler evaluate: + ((ReadStream on: classAndMethod) upToAll: firstPartOfSelector). + (receiver class == class) ifTrue: + [resultSelectors add: '*', classAndMethod. + resultSelectors remove: classAndMethod]]. + + resultSelectors sort:[:a :b | |rawA rawB| + rawA := (a startsWith:'*') ifTrue:[a copyFrom:2] ifFalse:[a]. + rawB := (b startsWith:'*') ifTrue:[b copyFrom:2] ifFalse:[b]. + rawA > rawB. ] +! + +markMatchingClasses: aSelector classesWithSelector:anOrderedCollection + "If an example is used, mark classes matching the example instance with an asterisk." + + | unmarkedClassList firstPartOfSelector | + + "Only 'example' queries can be marked." + unmarkedClassList _ anOrderedCollection copy. + + + + + unmarkedClassList do: + [:classAndMethod | | class | + class _ Compiler evaluate: + ((ReadStream on: classAndMethod) upToAll: aSelector). + (receiver value class == class) ifTrue: + [unmarkedClassList add: '*', classAndMethod. + unmarkedClassList remove: classAndMethod]]. + + unmarkedClassList sort:[:a :b | |rawA rawB| + rawA := (a startsWith:'*') ifTrue:[a copyFrom:2] ifFalse:[a]. + rawB := (b startsWith:'*') ifTrue:[b copyFrom:2] ifFalse:[b]. + rawA > rawB. ]. + ^unmarkedClassList +! + +mergReciever: aReceiver WithArgument: arguments + +| tempReceiver tempArguments receiverWithArgument| + + tempReceiver:= aReceiver. + tempArguments := arguments. + +(tempArguments isEmpty or:[(tempArguments) isNil]) + ifTrue:[ receiverWithArgument:=Array new:1."no argument" + receiverWithArgument at:1 put: tempReceiver. + ] + ifFalse:[ + (tempArguments size = 1) + ifTrue:[ receiverWithArgument:=Array new:2. + receiverWithArgument at:1 put: tempReceiver. + receiverWithArgument at:2 put: (tempArguments at:1) + ]. "a receiver with an argument" + + (tempArguments size = 2) + ifTrue:[ receiverWithArgument:=Array new:3. + receiverWithArgument at:1 put: tempReceiver. + (receiverWithArgument at:2 put: (tempArguments at:1)). + (receiverWithArgument at:3 put: (tempArguments at:2)) + ]. "a receiver with an argument" + (tempArguments size = 3) + ifTrue:[ receiverWithArgument:=Array new:4. + receiverWithArgument at:1 put: tempReceiver. + (receiverWithArgument at:2 put: (tempArguments at:1)). + (receiverWithArgument at:3 put: (tempArguments at:2)). + (receiverWithArgument at:4 put: (tempArguments at:3)). + + ]. "a receiver with an argument" + (tempArguments size = 4) + ifTrue:[ receiverWithArgument:=Array new:5. + receiverWithArgument at:1 put: tempReceiver. + (receiverWithArgument at:2 put: (tempArguments at:1)). + (receiverWithArgument at:3 put: (tempArguments at:2)). + (receiverWithArgument at:4 put: (tempArguments at:3)). + (receiverWithArgument at:5 put: (tempArguments at:4)). + + ]. "a receiver with an argument" + + ]. +^receiverWithArgument +! ! + +!MethodFinderWindow class methodsFor:'documentation'! + +version + ^ '$Header$' +! !