"

 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 showMetaFilter

		metaclassesOnlyHolder classesOnlyHolder initialText'

	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'!

currentPackage

    ^ currentPackage

!

initialText:aString

    initialText := aString.

!

showMetaFilter:something

    showMetaFilter := something.

! !

!SearchDialog methodsFor:'accessing-entered values'!

classesOnly

    ^ (classesOnlyHolder ? false) value

    "Created: / 20-08-2012 / 13:25:26 / cg"

!

classesToSearch

    ^ classes.

!

codeToSearch

    ^ selectorOrCode.

!

matchMethods

    ^ isMethodHolder value ? false.

!

metaclassesOnly

    ^ (metaclassesOnlyHolder ? false) value

    "Created: / 20-08-2012 / 13:17:12 / cg"

!

methodsToSearch

    ^ methods.

!

openHow

    ^ openHow.

!

searchAreaSelected

    ^ whereRadioGroup value.

!

searchIgnoringCase

    ^ self searchIsCaseSensitive not

!

searchIsCaseSensitive

    ^ (caseHolder value ? false)

!

searchWithMatch

    ^ matchHolder value ? false.

!

selectorToSearch

    ^ selectorOrCode.

! !

!SearchDialog methodsFor:'obsolete'!

addCheckBoxForClassMethodSearch

    |b|

    b := CheckBox label:(resources string:'Class Protocol').

    b model:(self searchClassProtocolHolder).

    currentPanel add:b.

    ^ b.

!

addCheckBoxForInstanceMethodSearch

    |b|

    b := CheckBox label:(resources string:'Instance Protocol').

    b model:(self searchInstanceProtocolHolder).

    currentPanel add:b.

    ^ b.

! !

!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

    |initialMatch initialCaseSensitive|

    matchHolder := caseHolder := nil.

    searchWhat == #code ifTrue:[

        self addTextEntryFieldForCode.

        ^ self.

    ].

    self addInputFieldForSelectorOrNameOrString.

    withCaseIgnore ifTrue:[

        initialCaseSensitive := false.

        (searchWhat ~~ #resource) ifTrue:[ 

            initialCaseSensitive := (LastSearchWasCaseSensitive ? false) 

        ].  

        self 

            addCheckBox:(resources string:'Case Sensitive')

            on:(caseHolder := initialCaseSensitive asValue).

    ].

    withMatch ifTrue:[

        initialMatch := true.

        (searchWhat ~~ #resource) ifTrue:[ 

            initialMatch := (LastSearchWasMatch ? true) 

        ].

        self 

            addCheckBox:(resources string:'Match')

            on:(matchHolder := initialMatch 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 beScreenDialog.                "raise it above all windows"

    self open.

    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.

                searchWhat ~~ #string ifTrue:[

                    sel := sel withoutSeparators.

                ].

            ].

            sel isEmptyOrNil ifTrue:[ 

                browser warn:((searchWhat == #selector) 

                            ifTrue:[ 'No selector entered for search'. ]

                            ifFalse:[ 'Nothing entered for search'. ]).

                ^ self.

            ].

            sel := sel string.

            (browser ? SystemBrowser) 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 copyButLast.

                        ].

                    ].

                ]

            ]

        ].

    ].

    where isNil ifTrue:[ 

        (browser ? Dialog) 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 ? Dialog) warn:'No class(es) given for search.'.

            ^ self.

        ].

    ] ifFalse:[

        classes := classes asOrderedCollection.

        methods size ~~ 0 ifTrue:[ 

            (browser ? Dialog) 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: / 26-09-2012 / 11:50:45 / cg"

!

setupToAskForMethodSearchTitle:title forBrowser:brwsrArg searchWhat:searchWhatArg 

    searchArea:whereDefault withCaseIgnore:withCaseIgnore withMatch:withMatch 

    withMethodList:withMethodList allowFind:allowFindArg allowBuffer:allowBufferArg 

    allowBrowser:allowBrowserArg withTextEntry:withTextEntryArg 

    "searchWhat:

        one of:#selector 

     searchArea:

        one of: #everywhere

    "

    |where ns methodNameSpaces methodPackages hPanel 

     leftVerticalPanel rightVerticalPanel updateListAction|

    allowFind := allowFindArg.

    allowBuffer := allowBufferArg.

    allowBrowser := allowBrowserArg.

    searchWhat := searchWhatArg.

    withTextEntry := withTextEntryArg.

    (browser := brwsrArg) isNil ifTrue:[

        resources := NewSystemBrowser classResources.

    ] ifFalse:[

        resources := browser resources.

        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 ].

            ].

        ].

    ].

    (self addTextLabel:(resources stringWithCRs:title)) adjust:#left.

    currentClass notNil ifTrue:[

        currentClass := currentClass theNonMetaclass.

    ].

    withTextEntry ifTrue:[

        self addTextEntryWithCaseIgnore:withCaseIgnore withMatch:withMatch.

    ].

    searchAreas := OrderedCollection new.

    self addHorizontalLine.

    "/ self addVerticalSpace.

    (showMetaFilter ? false) ifTrue:[

        currentPanel := self.

        self addCheckBoxForMetaClassesOnly.

    ].

    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 notEmptyOrNil or:[ selectedClasses notEmptyOrNil ]) 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 isEmptyOrNil 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 notEmptyOrNil ifTrue:[

            self addCheckBoxForSelectedClassCategory.

        ].

        (selectedClasses notEmptyOrNil or:[ selectedMethods notEmptyOrNil ]) ifTrue:[

            self addCheckBoxForSelectedClass.

            self addCheckBoxForSelectedClassAndSuperclasses.

            self addCheckBoxForSelectedClassAndSubclasses.

            self addCheckBoxForSelectedClassAndPrivateClasses.

            self addCheckBoxForSelectedClassAndSubclassesAndPrivateClasses.

            self addCheckBoxForOwnerAndItsPrivateClasses.

            self addCheckBoxForOwnerAndItsSubclassesAndItsPrivateClasses.

        ].

    ] ifFalse:[

        (browser notNil and:[browser currentNamespace ~~ Smalltalk]) ifTrue:[

            self addCheckBoxForEverywhere.

            currentNamespace := browser currentNamespace.

            currentNamespace ~= (browser nameListEntryForALL) ifTrue:[

                self addCheckBoxForCurrentNamespace.

            ] ifFalse:[

                (currentClass notNil 

                and:[ (ns := currentClass nameSpace) notNil