"

 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 listHolder

		matchProcess inputField'

	classVariableNames:'LastCodeSearched LastCodeSearchWasMethod LastGlobalSearched

		LastStringSearched LastSearchWasMatch LastSearchWasCaseSensitive

		LastStringSearchArea LastCodeSearchArea'

	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:'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.

    ] ifFalse:[

        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.

"/                    ].

"/                ].

        ]

    ]

!

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:[

            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.

    ]

!

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 l|

    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:[

        l := self addFilteredListOfMatchingSelectors.

        self stickAtBottomWithVariableHeight:l.

        matchHolder notNil ifTrue:[

            matchHolder onChangeEvaluate:[ self updateListOfMatchingSelectorsFor:inputField contents ]

        ].

        inputField notNil ifTrue:[ self updateListOfMatchingSelectorsFor:inputField contents ].

    ] ifFalse:[

        self addHorizontalLine.

    ].