"

 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

		codeField selectorHolder defaultOpenHow withTextEntry allowFind

		allowBuffer allowBrowser isSelector searchClassProtocolHolder

		searchInstanceProtocolHolder selectorOrCode'

	classVariableNames:'LastCodeSearched LastCodeSearchWasMethod LastGlobalSearched

		LastStringSearched LastSearchWasMatch LastSearchWasIgnoringCase

		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

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

! !

!SearchDialog methodsFor:'public'!

addTextEntryWithCaseIgnore:withCaseIgnore withMatch:withMatch 

    isSelector == #code ifTrue:[

        self addTextEntryFieldForCode.

    ] ifFalse:[

        self addInputFieldForSelectorOrNameOrString.

        withCaseIgnore ifTrue:[

            self 

                addCheckBox:(resources string:'Ignore case')

                on:(caseHolder := (LastSearchWasIgnoringCase ? true) 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 accepted ifFalse:[ 

        ^ self.

    ].

    openHow isNil ifTrue:[ 

        openHow := defaultOpenHow.

    ].

    where := whereRadioGroup value.

    withTextEntry ifTrue:[ 

        isSelector == #code ifTrue:[

            code := codeField contentsAsString.

            LastCodeSearched := code.

            LastCodeSearchArea := where.

        ] ifFalse:[

            sel := selectorHolder value.

            sel isEmptyOrNil ifTrue:[ 

                browser warn:(isSelector 

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

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

                ^ self.

            ].

            sel := sel string.

            browser rememberSearchPattern:sel.

            isSelector == #globalName ifTrue:[ 

                LastGlobalSearched := sel.

            ] ifFalse:[

                isSelector == #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:[

        LastSearchWasIgnoringCase := caseHolderValue

    ].

    selectorOrCode := sel ? code.

    aBlock numArgs == 7 ifTrue:[

        "/ old style

        aBlock

            value:classes

            value:(sel ? code)

            value:(caseHolderValue ? false)

            value:openHow

            value:(matchHolderValue ? false)

            value:methods

            value:(isMethodHolder value ? false).

    ] ifFalse:[

        aBlock value.

    ]

!

setupToAskForMethodSearchTitle:title forBrowser:brwsrArg isSelector:isSelectorArg 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.

    isSelector := isSelectorArg.

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

    self addHorizontalLine.

    self addButtons.

    self label:(resources string:'Search').

    "Modified: / 10-10-2006 / 15:30:52 / cg"

! !

!SearchDialog methodsFor:'setup'!

addCheckBox:b forSearchArea:area 

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

    ^ b.

!

addCheckBoxForClassesNamespace:ns 

    |b|

    b := CheckBox 

                label:(resources string:'Classes'' nameSpace ("%1")' with:ns name).

    self addCheckBox:b forSearchArea:#currentClassesNameSpace.

    ^ b.