--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Tools__SearchDialog.st Sun Jan 29 12:53:39 2012 +0000
@@ -0,0 +1,1270 @@
+"
+ COPYRIGHT (c) 2000 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+"{ Package: 'stx:libtool' }"
+
+"{ NameSpace: Tools }"
+
+DialogBox subclass:#SearchDialog
+ instanceVariableNames:'openHow classes methods selectedClasses selectedCategories
+ selectedMethods selectedPackages currentClass currentNamespace
+ currentClassCategory currentPackage browser whereRadioGroup
+ currentPanel searchAreas caseHolder matchHolder isMethodHolder
+ codeField selectorHolder defaultOpenHow withTextEntry allowFind
+ allowBuffer allowBrowser searchWhat searchClassProtocolHolder
+ searchInstanceProtocolHolder selectorOrCode selectionList
+ listHolder matchProcess inputField'
+ classVariableNames:'LastCodeSearched LastCodeSearchWasMethod LastGlobalSearched
+ LastStringSearched LastSearchWasMatch LastSearchWasCaseSensitive
+ LastStringSearchArea LastCodeSearchArea AREA_LISTOFMETHODS
+ LastResourceSearched'
+ poolDictionaries:''
+ category:'Interface-Browsers-New'
+!
+
+!SearchDialog class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 2000 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+! !
+
+!SearchDialog class methodsFor:'initialization'!
+
+initialize
+ AREA_LISTOFMETHODS := #listOfMethods
+
+ "Created: / 19-11-2010 / 12:00:18 / cg"
+! !
+
+!SearchDialog class methodsFor:'constants'!
+
+constantForListOfMethodsArea
+ ^ AREA_LISTOFMETHODS
+
+ "Created: / 19-11-2010 / 12:11:50 / cg"
+! !
+
+!SearchDialog class methodsFor:'queries'!
+
+lastCodeSearchArea
+ ^ LastCodeSearchArea
+!
+
+lastStringSearchArea
+ ^ LastStringSearchArea
+! !
+
+!SearchDialog methodsFor:'accessing-entered values'!
+
+classesToSearch
+ ^ classes.
+!
+
+codeToSearch
+ ^ selectorOrCode.
+!
+
+matchMethods
+ ^ isMethodHolder value ? false.
+!
+
+methodsToSearch
+ ^ methods.
+!
+
+openHow
+ ^ openHow.
+!
+
+searchIgnoringCase
+ ^ self searchIsCaseSensitive not
+!
+
+searchIsCaseSensitive
+ ^ (caseHolder value ? false)
+!
+
+searchWithMatch
+ ^ matchHolder value ? false.
+!
+
+selectorToSearch
+ ^ selectorOrCode.
+! !
+
+!SearchDialog methodsFor:'private'!
+
+searchClassProtocolHolder
+ searchClassProtocolHolder isNil ifTrue:[
+ searchClassProtocolHolder := true asValue
+ ].
+ ^ searchClassProtocolHolder
+!
+
+searchInstanceProtocolHolder
+ searchInstanceProtocolHolder isNil ifTrue:[
+ searchInstanceProtocolHolder := true asValue
+ ].
+ ^ searchInstanceProtocolHolder
+!
+
+showHelpOnCodePatterns
+ HTMLDocumentView openFullOnHelpFile:'Browser/RBSearchPatterns.html'
+!
+
+updateListOfMatchingSelectorsFor:s
+ |p|
+
+ (p := matchProcess) notNil ifTrue:[
+ p terminate.
+ ].
+ listHolder isNil ifTrue:[^ self].
+
+ matchProcess :=
+ [
+ |what matching|
+
+ [
+ searchWhat == #globalName ifFalse:[
+ what := DoWhatIMeanSupport selectorCompletion:s inEnvironment:Smalltalk match:(matchHolder value) ignoreCase:(caseHolder value not)
+ ] ifTrue:[
+ what := DoWhatIMeanSupport globalNameCompletion:s inEnvironment:Smalltalk match:(matchHolder value).
+ ].
+ "/ best := what first.
+ matching := what second.
+ self sensor pushAction:[ listHolder contents:matching ].
+ ] ensure:[
+ matchProcess := nil.
+ ].
+ ] fork.
+
+ "Modified: / 26-10-2010 / 20:33:05 / cg"
+! !
+
+!SearchDialog methodsFor:'public'!
+
+addTextEntryWithCaseIgnore:withCaseIgnore withMatch:withMatch
+ matchHolder := caseHolder := nil.
+
+ searchWhat == #code ifTrue:[
+ self addTextEntryFieldForCode.
+ ^ self.
+ ].
+
+ self addInputFieldForSelectorOrNameOrString.
+ withCaseIgnore ifTrue:[
+ self
+ addCheckBox:(resources string:'Case Sensitive')
+ on:(caseHolder := (LastSearchWasCaseSensitive ? false) asValue).
+ ].
+ withMatch ifTrue:[
+ self
+ addCheckBox:(resources string:'Match')
+ on:(matchHolder := (LastSearchWasMatch ? true) asValue).
+"/ (isSelector and:[ sel notNil. ]) ifTrue:[
+"/ sel includesMatchCharacters ifTrue:[
+"/ matchHolder value:false.
+"/ ].
+"/ ].
+ ]
+
+ "Modified (format): / 06-07-2011 / 11:56:31 / cg"
+!
+
+askThenDo:aBlock
+ |where code sel matchHolderValue caseHolderValue|
+
+ self open.
+ self beScreenDialog. "raise it above all windows"
+ self accepted ifFalse:[
+ ^ self.
+ ].
+
+ openHow isNil ifTrue:[
+ openHow := defaultOpenHow.
+ ].
+ where := whereRadioGroup value.
+ withTextEntry ifTrue:[
+ searchWhat == #code ifTrue:[
+ code := codeField contentsAsString.
+ LastCodeSearched := code.
+ LastCodeSearchArea := where.
+ ] ifFalse:[
+ (selectionList notNil and:[selectionList hasSelection]) ifTrue:[
+ sel := selectionList selectionValue.
+ ] ifFalse:[
+ sel := selectorHolder value.
+ ].
+ sel isEmptyOrNil ifTrue:[
+ browser warn:((searchWhat == #selector)
+ ifTrue:[ 'No selector entered for search'. ]
+ ifFalse:[ 'Nothing entered for search'. ]).
+ ^ self.
+ ].
+ sel := sel string.
+
+ browser rememberSearchPattern:sel.
+ searchWhat == #globalName ifTrue:[
+ LastGlobalSearched := sel.
+ ] ifFalse:[
+ searchWhat == #string ifTrue:[
+ LastStringSearched := sel.
+ LastStringSearchArea := where.
+ ] ifFalse:[
+ (sel startsWith:'#''') ifTrue:[
+ sel := sel copyFrom:3.
+ (sel endsWith:$') ifTrue:[
+ sel := sel copyWithoutLast:1.
+ ].
+ ].
+ ]
+ ]
+ ].
+ ].
+ where isNil ifTrue:[
+ browser warn:'No class(es) for search'.
+ ^ self.
+ ].
+ self getClassesAndMethodsFor:where.
+
+ (#(#classesWithPrivateClasses #classHierarchiesWithPrivateClasses #ownersWithPrivateClasses #ownersHierarchiesWithPrivateClasses)
+ includes:where)
+ ifTrue:[
+ |toSearch|
+
+ toSearch := IdentitySet withAll:classes.
+ classes := IdentitySet withAll:toSearch.
+ [ toSearch notEmpty ] whileTrue:[
+ |cls|
+
+ cls := toSearch removeFirst.
+ classes addAll:cls allPrivateClasses.
+ ].
+ ].
+
+ classes size == 0 ifTrue:[
+ classes := nil.
+ methods size == 0 ifTrue:[
+ browser warn:'No class(es) given for search.'.
+ ^ self.
+ ].
+ ] ifFalse:[
+ classes := classes asOrderedCollection.
+ methods size ~~ 0 ifTrue:[
+ browser warn:'oops'.
+ methods := nil.
+ ].
+ ].
+
+ matchHolderValue := matchHolder value.
+ matchHolderValue notNil ifTrue:[
+ LastSearchWasMatch := matchHolderValue
+ ].
+ caseHolderValue := caseHolder value.
+ caseHolderValue notNil ifTrue:[
+ LastSearchWasCaseSensitive := caseHolderValue
+ ].
+
+ selectorOrCode := sel ? code.
+
+ aBlock numArgs == 7 ifTrue:[
+ "/ old style
+ aBlock
+ value:classes
+ value:(sel ? code)
+ value:(self searchIgnoringCase)
+ value:openHow
+ value:(matchHolderValue ? false)
+ value:methods
+ value:(isMethodHolder value ? false).
+ ] ifFalse:[
+ aBlock value.
+ ]
+
+ "Modified: / 04-08-2011 / 23:18:42 / cg"
+!
+
+setupToAskForMethodSearchTitle:title forBrowser:brwsrArg searchWhat:searchWhatArg
+ searchArea:whereDefault withCaseIgnore:withCaseIgnore withMatch:withMatch
+ withMethodList:withMethodList allowFind:allowFindArg allowBuffer:allowBufferArg
+ allowBrowser:allowBrowserArg withTextEntry:withTextEntryArg
+
+ |where ns methodNameSpaces methodPackages hPanel leftVerticalPanel rightVerticalPanel|
+
+ allowFind := allowFindArg.
+ allowBuffer := allowBufferArg.
+ allowBrowser := allowBrowserArg.
+ searchWhat := searchWhatArg.
+
+ withTextEntry := withTextEntryArg.
+ browser := brwsrArg.
+ resources := browser resources.
+
+ (self addTextLabel:(resources stringWithCRs:title)) adjust:#left.
+
+ selectedClasses := browser selectedClasses value.
+ selectedCategories := browser selectedCategoriesValue.
+ selectedCategories := selectedCategories reject:[:cat | NavigatorModel isPseudoCategory:cat].
+ selectedMethods := browser selectedMethods value.
+ currentClass := browser theSingleSelectedClass.
+ currentClassCategory := browser theSingleSelectedCategory.
+ currentPackage := browser theSingleSelectedProject.
+ currentClass isNil ifTrue:[
+ browser hasMethodSelected ifTrue:[
+ currentClass := selectedMethods first mclass.
+ "/ selectedClasses := (selectedMethods collect:[:each | each mclass ]) asIdentitySet.
+ "/ selectedClasses := selectedClasses select:[:each | each notNil ].
+ ].
+ ].
+ currentClass notNil ifTrue:[
+ currentClass := currentClass theNonMetaclass.
+ ].
+ withTextEntry ifTrue:[
+ self addTextEntryWithCaseIgnore:withCaseIgnore withMatch:withMatch.
+ ].
+ searchAreas := OrderedCollection new.
+
+ self addHorizontalLine.
+ self addVerticalSpace.
+
+ hPanel := HorizontalPanelView "SimpleView" new.
+ hPanel verticalLayout:#top.
+ hPanel horizontalLayout:#left.
+
+ leftVerticalPanel := currentPanel := VerticalPanelView new.
+ leftVerticalPanel verticalLayout:#topSpace.
+ leftVerticalPanel horizontalLayout:#fitSpace.
+
+ (self addTextLabel:(resources string:'Search in:')) adjust:#left.
+ whereRadioGroup := RadioButtonGroup new.
+
+ (selectedCategories size > 0 or:[ selectedClasses size > 0 ]) ifTrue:[
+ self addCheckBoxForEverywhere.
+ "/ classMethodListView notNil ifTrue:[
+ "/ b := CheckBox label:(resources string:'Shown Methods').
+ "/ panel add:b. whereChannel add:b value:#currentMethodList.
+ "/ areas add:#currentMethodList.
+ "/ self makeTabable:b.
+ "/ ].
+ browser isMethodListBrowser ifTrue:[
+ methods := browser selectedMethods value ? #().
+ methodNameSpaces := methods
+ select:[:eachMethod | eachMethod mclass notNil]
+ thenCollect:[:eachMethod | eachMethod mclass topNameSpace ].
+ methodPackages := methods
+ collect:[:eachMethod | eachMethod package ].
+ ].
+ methodNameSpaces size == 1 ifTrue:[
+ currentNamespace := methodNameSpaces first.
+ ] ifFalse:[
+ currentNamespace := browser currentNamespace.
+ selectedClasses size == 0 ifTrue:[
+ |classesInAllSelectedCategories nameSpacesOfAllClassesInAllSelectedCategories|
+ classesInAllSelectedCategories := Smalltalk allClasses select:[:cls | selectedCategories includes:cls category].
+ nameSpacesOfAllClassesInAllSelectedCategories := classesInAllSelectedCategories collect:[:eachClass | eachClass topNameSpace].
+ nameSpacesOfAllClassesInAllSelectedCategories size == 1 ifTrue:[
+ currentNamespace := nameSpacesOfAllClassesInAllSelectedCategories first.
+ ].
+ ].
+ ].
+
+ (currentNamespace notNil
+ and:[ currentNamespace ~= (browser nameListEntryForALL) ])
+ ifTrue:[ self addCheckBoxForCurrentNamespace ]
+ ifFalse:[
+ (currentClass notNil
+ and:[ (ns := currentClass nameSpace) notNil and:[ ns ~~ Smalltalk ] ])
+ ifTrue:[ self addCheckBoxForClassesNamespace:ns ].
+ ].
+
+ methodPackages size == 1 ifTrue:[
+ currentPackage := methodPackages first.
+ ] ifFalse:[
+ currentPackage := browser currentProject.
+"/ selectedClasses size == 0 ifTrue:[
+"/ |classesInAllSelectedCategories packagesOfAllClassesInAllSelectedCategories|
+"/ classesInAllSelectedCategories := Smalltalk allClasses select:[:cls | selectedCategories includes:cls category].
+"/ packagesOfAllClassesInAllSelectedCategories := classesInAllSelectedCategories collect:[:eachClass | eachClass package].
+"/ packagesOfAllClassesInAllSelectedCategories size == 1 ifTrue:[
+"/ currentPackage := packagesOfAllClassesInAllSelectedCategories first.
+"/ ].
+"/ ].
+ ].
+
+ (currentPackage notNil
+ and:[ currentPackage ~= (browser nameListEntryForALL) ])
+ ifTrue:[ self addCheckBoxForCurrentPackage ]
+ ifFalse:[
+ (currentClass notNil) ifTrue:[
+ self addCheckBoxForClassesPackage:(currentClass package)
+ ].
+ ].
+
+ selectedCategories size > 0 ifTrue:[
+ self addCheckBoxForSelectedClassCategory.
+ ].
+ (selectedClasses size > 0 or:[ selectedMethods size > 0 ]) ifTrue:[
+ self addCheckBoxForSelectedClass.
+ self addCheckBoxForSelectedClassAndSuperclasses.
+ self addCheckBoxForSelectedClassAndSubclasses.
+ self addCheckBoxForSelectedClassAndPrivateClasses.
+ self addCheckBoxForSelectedClassAndSubclassesAndPrivateClasses.
+ self addCheckBoxForOwnerAndItsPrivateClasses.
+ self addCheckBoxForOwnerAndItsSubclassesAndItsPrivateClasses.
+ ].
+ ] ifFalse:[
+ browser currentNamespace ~~ Smalltalk ifTrue:[
+ self addCheckBoxForEverywhere.
+ currentNamespace := browser currentNamespace.
+ currentNamespace ~= (browser nameListEntryForALL) ifTrue:[
+ self addCheckBoxForCurrentNamespace.
+ ] ifFalse:[
+ (currentClass notNil
+ and:[ (ns := currentClass nameSpace) notNil
+ and:[ ns ~~ Smalltalk ] ])
+ ifTrue:[
+ self addCheckBoxForClassesNamespace:ns
+ ].
+ ].
+ ].
+ ].
+ searchAreas size == 0 ifTrue:[
+ self addCheckBoxForEverywhere.
+ ].
+ self addCheckBoxForChangedClassesList.
+
+ (withMethodList and:[ browser isMethodListBrowser ]) ifTrue:[
+ searchAreas size == 0 ifTrue:[
+ self addCheckBoxForEverywhere.
+ ].
+ self addCheckBoxForMethodList.
+ browser selectedMethods value size > 1 ifTrue:[
+ self addCheckBoxForSelectedMethods.
+ ].
+ self addCheckBoxForSelectedMethodClasses.
+ ] ifFalse:[
+ searchAreas size == 0 ifTrue:[
+ self addCheckBoxForEverywhere.
+ ].
+ self addCheckBoxForChangedMethodList.
+ ].
+
+ searchAreas size == 0 ifTrue:[
+ whereRadioGroup := #everywhere asValue.
+ self addDummyCheckBoxForEverywhere.
+ ] ifFalse:[
+ whereDefault notNil ifTrue:[
+ (searchAreas includes:whereDefault) ifTrue:[
+ where := whereDefault asSymbol.
+ ] ifFalse:[
+ where := searchAreas first.
+ ].
+ ] ifFalse:[
+ where := #everywhere.
+ ].
+ whereRadioGroup value:where.
+ ].
+
+ hPanel add:leftVerticalPanel.
+
+ rightVerticalPanel := currentPanel := VerticalPanelView new.
+ rightVerticalPanel verticalLayout:#topSpace.
+ rightVerticalPanel horizontalLayout:#fitSpace.
+
+false ifTrue:[
+ self addCheckBoxForClassMethodSearch.
+ self addCheckBoxForInstanceMethodSearch.
+].
+
+"/ rightVerticalPanel origin:0.75@0.0 corner:1.0@1.0.
+ hPanel
+ preferredExtent:(leftVerticalPanel preferredHeight + rightVerticalPanel preferredHeight)
+ @
+ (leftVerticalPanel preferredHeight max:rightVerticalPanel preferredHeight).
+ hPanel add:rightVerticalPanel.
+ self addComponent:hPanel indent:0.
+
+ "/ panel has its own idea of indenting
+ self addVerticalSpace.
+ searchWhat == #selector ifTrue:[
+ selectionList := self addFilteredListOfMatchingSelectors.
+ self stickAtBottomWithVariableHeight:selectionList.
+ matchHolder notNil ifTrue:[
+ matchHolder onChangeEvaluate:[ self updateListOfMatchingSelectorsFor:inputField contents ]
+ ].
+ inputField notNil ifTrue:[ self updateListOfMatchingSelectorsFor:inputField contents ].
+ ] ifFalse:[
+ self addHorizontalLine.
+ ].
+ self addButtons.
+
+ self label:(resources string:'Search').
+
+ "Modified: / 10-10-2006 / 15:30:52 / cg"
+ "Modified (format): / 06-07-2011 / 11:53:23 / cg"
+! !
+
+!SearchDialog methodsFor:'setup'!
+
+addCheckBox:b forSearchArea:area
+ currentPanel add:b.
+ whereRadioGroup add:b value:area.
+ searchAreas add:area.
+ self makeTabable:b.
+!
+
+addCheckBoxForChangedClassesList
+ |b|
+
+ b := CheckBox label:(resources string:'Changed Classes').
+ self addCheckBox:b forSearchArea:#listOfChangedClasses.
+ ChangeSet current changedClasses isEmpty ifTrue:[
+ b disable
+ ].
+ ^ b.
+!
+
+addCheckBoxForChangedMethodList
+ |b|
+
+ b := CheckBox label:(resources string:'Changed Methods').
+ self addCheckBox:b forSearchArea:#listOfChangedMethods.
+ ChangeSet current changeSelectors isEmpty ifTrue:[
+ b disable
+ ].
+ ^ b.
+!
+
+addCheckBoxForClassMethodSearch
+ |b|
+
+ b := CheckBox label:(resources string:'Class Protocol').
+ b model:(self searchClassProtocolHolder).
+ currentPanel add:b.
+ ^ b.
+!
+
+addCheckBoxForClassesNamespace:ns
+ |b|
+
+ b := CheckBox
+ label:(resources string:'Classes'' nameSpace ("%1")' with:ns name).
+ self addCheckBox:b forSearchArea:#currentClassesNameSpace.
+ ^ b.
+!
+
+addCheckBoxForClassesPackage:pkg
+ |b|
+
+ b := CheckBox
+ label:(resources string:'Classes'' package ("%1")' with:pkg).
+ self addCheckBox:b forSearchArea:#currentClassesPackage.
+ ^ b.
+
+ "Created: / 21-09-2006 / 17:39:55 / cg"
+!
+
+addCheckBoxForCurrentNamespace
+ |b|
+
+ b := CheckBox
+ label:(resources string:'Current nameSpace ("%1")' with:currentNamespace name).
+ self addCheckBox:b forSearchArea:#currentNameSpace.
+ ^ b.
+
+ "Modified: / 10-10-2006 / 15:28:47 / cg"
+!
+
+addCheckBoxForCurrentPackage
+ |b|
+
+ b := CheckBox
+ label:(resources string:'Current package ("%1")' with:currentPackage).
+ self addCheckBox:b forSearchArea:#currentPackage.
+ ^ b.
+
+ "Modified: / 10-10-2006 / 15:28:51 / cg"
+!
+
+addCheckBoxForCurrentPackage:pkg
+ |b|
+
+ b := CheckBox
+ label:(resources string:'Classes'' package ("%1")' with:pkg).
+ self addCheckBox:b forSearchArea:#currentClassesPackage.
+ ^ b.
+
+ "Modified: / 10-10-2006 / 15:29:06 / cg"
+!
+
+addCheckBoxForEverywhere
+ |b|
+
+ b := CheckBox label:(resources string:'Everywhere').
+ self addCheckBox:b forSearchArea:#everywhere.
+ ^ b.
+!
+
+addCheckBoxForInstanceMethodSearch
+ |b|
+
+ b := CheckBox label:(resources string:'Instance Protocol').
+ b model:(self searchInstanceProtocolHolder).
+ currentPanel add:b.
+ ^ b.
+!
+
+addCheckBoxForMethodList
+ |b|
+
+ b := CheckBox label:(resources string:'Methodlist').
+ self addCheckBox:b forSearchArea:AREA_LISTOFMETHODS.
+ ^ b.
+
+ "Modified: / 19-11-2010 / 12:00:52 / cg"
+!
+
+addCheckBoxForOwnerAndItsPrivateClasses
+ |b lbl arg|
+
+ (currentClass notNil and:[ currentClass isPrivate. ]) ifTrue:[
+ lbl := 'Owner (%1) & all its private classes'.
+ arg := currentClass owningClass name.
+ ] ifFalse:[
+ lbl := 'Owners & all their private classes'.
+ ].
+ b := CheckBox label:(resources string:lbl with:arg).
+ self addCheckBox:b forSearchArea:#ownersWithPrivateClasses.
+ (selectedClasses contains:[ :cls | cls isPrivate. ]) ifFalse:[
+ b disable.
+ ].
+ ^ b.
+!
+
+addCheckBoxForOwnerAndItsSubclassesAndItsPrivateClasses
+ |b lbl arg|
+
+ (currentClass notNil and:[ currentClass isPrivate. ]) ifTrue:[
+ lbl := 'Owner (%1) & its subclasses & all its private classes'.
+ arg := currentClass owningClass name.
+ ] ifFalse:[
+ lbl := 'Owners & their subclasses & all their private classes'.
+ ].
+ b := CheckBox label:(resources string:lbl with:arg).
+ self addCheckBox:b forSearchArea:#ownersHierarchiesWithPrivateClasses.
+ (selectedClasses contains:[ :cls | cls isPrivate. ]) ifFalse:[
+ b disable.
+ ].
+ ^ b.
+!
+
+addCheckBoxForSelectedClass
+ |b lbl arg|
+
+ (browser isMethodListBrowser
+ or:[ currentClass isNil
+ or:[ selectedClasses size > 1] ]) ifTrue:[
+ selectedClasses size == 1 ifTrue:[
+ lbl := 'Selected class ("%1")'.
+ arg := selectedClasses first theNonMetaclass name.
+ ] ifFalse:[
+ lbl := 'Selected classes (%1)'.
+ arg := selectedClasses size.
+ ].
+ ] ifFalse:[
+ lbl := 'Class ("%1")'.
+ arg := currentClass name.
+ ].
+ b := CheckBox label:(resources string:lbl with:arg).
+ self addCheckBox:b forSearchArea:#classes.
+ ^ b.
+!
+
+addCheckBoxForSelectedClassAndPrivateClasses
+ |b lbl|
+
+ (browser isMethodListBrowser
+ or:[ currentClass isNil
+ or:[ selectedClasses size > 1] ]) ifTrue:[
+ lbl := 'Selected classes & all private classes'.
+ ] ifFalse:[
+ lbl := 'Class & private classes'.
+ ].
+ b := CheckBox label:(resources string:lbl).
+ self addCheckBox:b forSearchArea:#classesWithPrivateClasses.
+ (selectedClasses
+ contains:[ :cls | cls theNonMetaclass privateClasses size > 0. ])
+ ifFalse:[ b disable. ].
+ ^ b.
+!
+
+addCheckBoxForSelectedClassAndSubclasses
+ |b lbl|
+
+ (browser isMethodListBrowser
+ or:[ currentClass isNil
+ or:[ selectedClasses size > 1] ]) ifTrue:[
+ lbl := 'Selected classes & all subclasses'.
+ ] ifFalse:[
+ lbl := 'Class & subclasses'.
+ ].
+ b := CheckBox label:(resources string:lbl).
+ self addCheckBox:b forSearchArea:#classHierarchies.
+ (selectedClasses
+ contains:[ :cls | cls theNonMetaclass subclasses size > 0. ])
+ ifFalse:[ b disable. ].
+ ^ b.
+!
+
+addCheckBoxForSelectedClassAndSubclassesAndPrivateClasses
+ |b lbl|
+
+ (browser isMethodListBrowser
+ or:[ currentClass isNil
+ or:[ selectedClasses size > 1] ]) ifTrue:[
+ lbl := 'Selected classes & all subclasses & all private classes'.
+ ] ifFalse:[
+ lbl := 'Class & subclasses & all private classes'.
+ ].
+ b := CheckBox label:(resources string:lbl).
+ self addCheckBox:b forSearchArea:#classHierarchiesWithPrivateClasses.
+ (selectedClasses
+ contains:[ :cls | cls theNonMetaclass privateClasses size > 0. ])
+ ifFalse:[ b disable. ].
+ ^ b.
+!
+
+addCheckBoxForSelectedClassAndSuperclasses
+ |b lbl|
+
+ (browser isMethodListBrowser
+ or:[ currentClass isNil
+ or:[ selectedClasses size > 1] ]) ifTrue:[
+ lbl := 'Selected classes & all superclasses'.
+ ] ifFalse:[
+ lbl := 'Class & superclasses'.
+ ].
+ b := CheckBox label:(resources string:lbl).
+ self addCheckBox:b forSearchArea:#classesAndSuperclasses.
+ (selectedClasses
+ contains:[ :cls | cls theNonMetaclass superclass notNil. ])
+ ifFalse:[ b disable. ].
+ ^ b.
+!
+
+addCheckBoxForSelectedClassCategory
+ |b lbl arg|
+
+ currentClassCategory notNil ifTrue:[
+ lbl := 'Class category ("%1")'.
+ arg := currentClassCategory.
+ ] ifFalse:[
+ lbl := 'Selected classes categories (%1)'.
+ arg := selectedCategories size.
+ ].
+ b := CheckBox label:(resources string:lbl with:arg).
+ self addCheckBox:b forSearchArea:#classCategories.
+ ^ b.
+!
+
+addCheckBoxForSelectedMethodClasses
+ |b classes|
+
+ classes := ((browser selectedMethods value ? #())
+ select:[:m | m mclass notNil]
+ thenCollect:[:m | m mclass theNonMetaclass]) asSet.
+ classes size == 1 ifTrue:[
+ b := CheckBox label:(resources string:'Selected method''s class (%1)'
+ with:classes first name).
+ ] ifFalse:[
+ b := CheckBox label:(resources string:'Selected methods'' classes (%1)'
+ with:classes size).
+ ].
+ self addCheckBox:b forSearchArea:#listOfSelectedMethodClasses.
+ ^ b.
+
+ "Modified: / 01-11-2010 / 21:35:46 / cg"
+!
+
+addCheckBoxForSelectedMethods
+ |b|
+
+ b := CheckBox label:(resources string:'Selected methods (%1)'
+ with:browser selectedMethods value size).
+ self addCheckBox:b forSearchArea:#listOfSelectedMethods.
+ ^ b.
+!
+
+addCheckBoxForSelectedPackage
+ |b lbl arg|
+
+ currentClassCategory notNil ifTrue:[
+ lbl := 'Class category ("%1")'.
+ arg := currentClassCategory.
+ ] ifFalse:[
+ lbl := 'Selected classes categories (%1)'.
+ arg := selectedCategories size.
+ ].
+ b := CheckBox label:(resources string:lbl with:arg).
+ self addCheckBox:b forSearchArea:#classCategories.
+ ^ b.
+!
+
+addDummyCheckBoxForEverywhere
+ |b|
+
+ b := CheckBox label:(resources string:'Everywhere').
+ b turnOn.
+ b disable.
+
+ currentPanel add:b.
+!
+
+addFilteredListOfMatchingSelectors
+ |l|
+
+ listHolder := List new.
+
+ l := HVScrollableView for:SelectionInListView.
+ l listHolder:listHolder.
+ self addComponent:l.
+ l doubleClickAction:[
+ selectorHolder value:(l selectionValue).
+ matchHolder value:false.
+ caseHolder value:false.
+ self doAccept.
+ self okPressed.
+ ].
+ ^ l.
+!
+
+addInputFieldForSelectorOrNameOrString
+ |sel lastSearchPatterns|
+
+ searchWhat == #selector ifTrue:[
+ sel := browser selectorToSearchFor.
+ ] ifFalse:[
+ searchWhat == #globalName ifTrue:[
+ sel := browser globalNameToSearchFor ? LastGlobalSearched.
+ ] ifFalse:[
+ searchWhat == #string ifTrue:[
+ sel := browser stringToSearchFor ? LastStringSearched.
+ ] ifFalse:[
+ searchWhat == #resource ifTrue:[
+ sel := browser stringToSearchFor ? LastResourceSearched.
+ ] ifFalse:[
+ sel := browser selectorToSearchFor.
+ ]
+ ]
+ ].
+ ].
+
+ lastSearchPatterns := browser lastSearchPatterns.
+ sel isEmptyOrNil ifTrue:[
+ "/ use last searchString
+ lastSearchPatterns size > 0 ifTrue:[
+ sel := lastSearchPatterns first.
+ ].
+ ].
+ selectorHolder := (sel ? '') withoutSeparators asValue.
+
+ inputField := self addComboBoxOn:selectorHolder tabable:true.
+ inputField list:lastSearchPatterns.
+ inputField selectAllInitially.
+ inputField immediateAccept:true.
+ inputField takeFocus.
+ inputField
+ entryCompletionBlock:[ :contents |
+ |s what|
+
+ s := contents withoutSpaces.
+ self topView
+ withWaitCursorDo:[
+ |best matching|
+
+ searchWhat == #resource ifTrue:[
+ what := DoWhatIMeanSupport resourceCompletion:s inEnvironment:Smalltalk match:true ignoreCase:false.
+ ] ifFalse:[
+ searchWhat == #globalName ifFalse:[
+ what := DoWhatIMeanSupport selectorCompletion:s inEnvironment:Smalltalk.
+ ] ifTrue:[
+ what := DoWhatIMeanSupport globalNameCompletion:s inEnvironment:Smalltalk match:true.
+ ].
+ ].
+ best := what first.
+ matching := what second.
+ inputField contents:best.
+ "/ listHolder contents:matching.
+ matching size ~~ 1 ifTrue:[
+ browser window beep.
+ ].
+ ].
+ ].
+
+ selectorHolder onChangeEvaluate:[ self updateListOfMatchingSelectorsFor:inputField contents ].
+
+ "Modified: / 06-07-2011 / 12:07:12 / cg"
+!
+
+addTextEntryFieldForCode
+ |initial box panel patternInfoBox infoLabel helpButton errMessageField checkCodeAction
+ metaBox b|
+
+ box := View new.
+ box extent:(600 @ 200).
+
+ panel := VariableHorizontalPanel in:box.
+ panel origin:0.0@0.0 corner:(1.0@1.0).
+
+ codeField := CodeView in:panel.
+ codeField canTab:true.
+"/ codeField origin:0.0@0.0 corner:(0.75@1.0).
+
+ patternInfoBox := View in:panel.
+
+ infoLabel := Label in:patternInfoBox.
+ infoLabel geometryLayout:(LayoutFrame bottomInset:30).
+
+ infoLabel font:(codeField font asSize:(codeField font size - 2)).
+ infoLabel adjust:#left.
+ infoLabel label:(self helpTextForMetaPatterns).
+
+ panel relativeCorners:#(0.6 1.0).
+ panel showHandle:true.
+
+ helpButton := Button label:(resources string:'Pattern Help') in:patternInfoBox.
+ helpButton layout:((AlignmentOrigin fractionalFromPoint:0.5@1.0)
+ leftOffset:2
+ topOffset:helpButton preferredHeight negated;
+ leftAlignmentFraction:0.5 topAlignmentFraction:0).
+ helpButton topInset:0.75@1.0.
+ helpButton action:[self showHelpOnCodePatterns].
+
+
+ self addComponent:box tabable:true.
+
+ metaBox := HorizontalPanelView new.
+ metaBox horizontalLayout:#leftMax.
+ b := Button label:'+Lit' action:[ codeField pasteOrReplace:'`#n' ] in:metaBox.
+ b helpKey:#matchAnyLiteral.
+ b := Button label:'+Var' action:[ codeField pasteOrReplace:'`v' ] in:metaBox.
+ b helpKey:#matchAnyVariable.
+ b := Button label:'+Expr' action:[ codeField pasteOrReplace:'`@e' ] in:metaBox.
+ b helpKey:#matchAnyExpression.
+ b := Button label:'+Msg' action:[ codeField pasteOrReplace:'`@m:' ] in:metaBox.
+ b helpKey:#matchAnyMessage.
+ b := Button label:'+Node' action:[ codeField pasteOrReplace:'`{:node | node isLiteral and:[node value isSymbol] }' ] in:metaBox.
+ b helpKey:#matchAnyNode.
+ b := Button label:'+Stats' action:[ codeField pasteOrReplace:'`.@stats' ] in:metaBox.
+ b helpKey:#matchAnyStats.
+ self addComponent:metaBox.
+
+ errMessageField := (self addTextLabel:'') adjust:#left.
+ errMessageField level:-1.
+ self addCheckBox:(resources string:'Method') on:self isMethodHolder.
+
+ checkCodeAction := [ self checkCodeIn:codeField notifying:errMessageField. ].
+
+ codeField modifiedChannel onChangeEvaluate:checkCodeAction.
+ self isMethodHolder onChangeEvaluate:checkCodeAction.
+
+ initial := browser selectionInCodeView.
+ initial isEmptyOrNil ifTrue:[
+ initial := LastCodeSearched ? ''
+ ].
+ codeField contents:initial.
+ checkCodeAction value.
+
+ "Modified: / 23-07-2011 / 10:35:14 / cg"
+!
+
+checkCodeIn:codeField notifying:errMessageField
+ |codeString tree errAction|
+
+ codeString := codeField contents asString string.
+ errAction := [:str :pos |
+ |line col badLine|
+
+ line := codeField lineOfCharacterPosition:pos.
+ col := (codeField colOfCharacterPosition:pos) max:1.
+
+ badLine := (codeField listAt:line) ? ''.
+ col <= badLine size size ifTrue:[
+ codeField
+ listAt:line
+ put:(badLine asText
+ emphasisAt:col
+ put:(UserPreferences current unknownIdentifierEmphasis)).
+ "/ codeField selectFromCharacterPosition:pos to:pos.
+ ].
+ errMessageField label:('line: ',line printString,' ',str).
+ errMessageField backgroundColor:Color red.
+ codeField requestFocus.
+ nil.
+ ].
+
+ isMethodHolder value ifTrue:[
+ tree := RBParser parseRewriteMethod:codeString onError: errAction.
+ ] ifFalse:[
+ tree := RBParser parseRewriteExpression:codeString onError: errAction.
+ ].
+ tree notNil ifTrue:[
+ errMessageField backgroundColor:View defaultViewBackgroundColor.
+ errMessageField label:nil
+ ].
+ codeField modifiedChannel setValue:false.
+!
+
+getClassesAndMethodsFor:where
+ where == #everywhere ifTrue:[
+ classes := Smalltalk allClasses.
+ methods := nil.
+ ^ self.
+ ].
+ where == #currentNameSpace ifTrue:[
+ classes := currentNamespace allClassesWithAllPrivateClasses.
+ methods := nil.
+ ^ self.
+ ].
+ where == #currentClassesNameSpace ifTrue:[
+ currentClass isPrivate ifTrue:[
+ classes := currentClass topOwningClass nameSpace
+ allClassesWithAllPrivateClasses.
+ ] ifFalse:[
+ classes := currentClass nameSpace allClassesWithAllPrivateClasses.
+ ].
+ methods := nil.
+ ^ self.
+ ].
+ where == #currentPackage ifTrue:[
+ classes := Smalltalk allClassesInPackage:currentPackage.
+ methods := nil.
+ ^ self.
+ ].
+ where == #currentClassesPackage ifTrue:[
+ classes := Smalltalk allClassesInPackage:currentClass package.
+ methods := nil.
+ ^ self.
+ ].
+ where == #classCategories ifTrue:[
+ classes := Smalltalk allClasses
+ select:[ :cls | selectedCategories includes:cls category. ].
+ classes := classes collect:[ :each | each theNonMetaclass. ].
+ methods := nil.
+ ^ self.
+ ].
+ (where == #classes or:[ where == #classesWithPrivateClasses. ]) ifTrue:[
+ classes := selectedClasses collect:[ :each | each theNonMetaclass. ].
+ methods := nil.
+ ^ self.
+ ].
+ (where == #classHierarchies or:[ where == #classHierarchiesWithPrivateClasses. ])
+ ifTrue:[
+ classes := IdentitySet new.
+ selectedClasses do:[ :cls |
+ classes addAll:cls theNonMetaclass withAllSubclasses.
+ ].
+ methods := nil.
+ ^ self.
+ ].
+ where == #ownersWithPrivateClasses ifTrue:[
+ classes := IdentitySet new.
+ selectedClasses do:[ :cls |
+ |c|
+
+ c := cls theNonMetaclass.
+ classes add:(c owningClass ? c).
+ ].
+ methods := nil.
+ ^ self.
+ ].
+ where == #ownersHierarchiesWithPrivateClasses ifTrue:[
+ classes := IdentitySet new.
+ selectedClasses do:[ :cls |
+ |c|
+
+ c := cls theNonMetaclass.
+ classes addAll:(c owningClass ? c) withAllSubclasses.
+ ].
+ methods := nil.
+ ^ self.
+ ].
+ (where == #classesAndSuperclasses) ifTrue:[
+ classes := IdentitySet new.
+ selectedClasses do:[ :cls |
+ classes addAll:cls theNonMetaclass withAllSuperclasses.
+ ].
+ methods := nil.
+ ^ self.
+ ].
+ (where == AREA_LISTOFMETHODS) ifTrue:[
+ classes := nil.
+ methods := browser methodListApp methodList value.
+ ^ self.
+ ].
+ (where == #listOfSelectedMethods) ifTrue:[
+ classes := nil.
+ methods := browser selectedMethods value.
+ ^ self.
+ ].
+ (where == #listOfSelectedMethodClasses) ifTrue:[
+ classes := (browser selectedMethods value collect:[:m | m mclass theNonMetaclass]) asSet asOrderedCollection.
+ methods := nil.
+ ^ self.
+ ].
+ (where == #listOfChangedClasses) ifTrue:[
+ classes := ChangeSet current changedClasses.
+ methods := nil.
+ ^ self.
+ ].
+ (where == #listOfChangedMethods) ifTrue:[
+ classes := nil.
+ methods := Set new.
+ ChangeSet current do:[:chg |
+ |mthd|
+
+ chg notNil ifTrue:[
+ chg isMethodChange ifTrue:[
+ mthd := chg changeMethod.
+ mthd notNil ifTrue:[
+ methods add:mthd
+ ]
+ ]
+ ]
+ ].
+ methods := methods asOrderedCollection.
+ ^ self.
+ ].
+
+ self halt:'inumplemented search'.
+
+ "Modified: / 19-11-2010 / 12:01:15 / cg"
+!
+
+helpTextForMetaPatterns
+ ^ 'MetaPatterns:
+ ' , '`' allBold , ' = meta
+ ' , '@' allBold , ' = list/any
+ ' , '.' allBold , ' = statement
+ ' , '`' allBold , ' = recurse
+
+ ' , '`#n' allBold , ' any lit
+ ' , '`v' allBold , ' any var (`V => global)
+ ' , '`@e' allBold , ' any expr
+ ' , '`@m:' allBold , ' any message (`m => unary)
+ ' , '`{:n|...}' allBold , ' node pattern
+ ' , '`''a.*''' allBold , ' regex on string const
+'.
+
+ "Modified: / 08-08-2011 / 20:33:03 / cg"
+!
+
+isMethodHolder
+ isMethodHolder isNil ifTrue:[isMethodHolder := (LastCodeSearchWasMethod ? false) asValue].
+ ^ isMethodHolder
+! !
+
+!SearchDialog methodsFor:'setup-buttons'!
+
+addBrowseButton
+ |b|
+
+ b := Button label:(resources string:'Browse').
+ (DialogBox defaultOKButtonAtLeft) ifTrue:[
+ self addButton:b before:nil.
+ ] ifFalse:[
+ self addButton:b after:nil.
+ ].
+ b
+ action:[
+ openHow := #newBrowser.
+ self doAccept.
+ self okPressed.
+ ].
+ ^ b.
+!
+
+addBufferButton
+ |b|
+
+ b := Button label:(resources string:'Add Buffer').
+ (DialogBox defaultOKButtonAtLeft) ifTrue:[
+ self addButton:b before:nil.
+ ] ifFalse:[
+ self addButton:b after:nil.
+ ].
+ b
+ action:[
+ openHow := #newBuffer.
+ self doAccept.
+ self okPressed.
+ ].
+ ^ b.
+!
+
+addButtons
+ "add find/newBrowser/newBuffer buttons"
+
+ |prevButton|
+
+ allowFind ifTrue:[
+ defaultOpenHow := #showHere.
+ prevButton := self addFindButton.
+ ].
+ allowBrowser ifTrue:[
+ defaultOpenHow := #newBrowser.
+ prevButton := self addBrowseButton.
+ ].
+ allowBuffer ifTrue:[
+ defaultOpenHow := #newBuffer.
+ prevButton := self addBufferButton.
+ ].
+ prevButton notNil ifTrue:[
+ prevButton isReturnButton:true.
+ ].
+ self addAbortButton.
+!
+
+addFindButton
+ |b|
+
+ b := Button label:(resources string:'Find').
+ (DialogBox defaultOKButtonAtLeft) ifTrue:[
+ self addButton:b before:nil.
+ ] ifFalse:[
+ self addButton:b after:nil.
+ ].
+ b
+ action:[
+ openHow := #showHere.
+ self doAccept.
+ self okPressed.
+ ].
+ ^ b.
+! !
+
+!SearchDialog class methodsFor:'documentation'!
+
+version_CVS
+ ^ '§Header: /cvs/stx/stx/libtool/Tools_SearchDialog.st,v 1.65 2011/08/08 18:47:27 cg Exp §'
+! !
+
+SearchDialog initialize!
\ No newline at end of file