"
 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
		verticalPanel searchAreas caseHolder matchHolder isMethodHolder
		codeField selectorHolder defaultOpenHow withTextEntry allowFind
		allowBuffer allowBrowser isSelector searchClassProtocolHolder
		searchInstanceProtocolHolder selectorOrCode'
	classVariableNames:'LastCodeSearched LastCodeSearchWasMethod LastGlobalSearched
		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 isEmpty 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:[
                    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.
    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 := verticalPanel := 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 
                ].
            ].
        ].
    ].
    (withMethodList and:[ browser isMethodListBrowser ]) ifTrue:[
        searchAreas size == 0 ifTrue:[
            self addCheckBoxForEverywhere.
        ].
        self addCheckBoxForMethodList.
        browser selectedMethods value size > 1 ifTrue:[
            self addCheckBoxForSelectedMethods.
        ].
    ].

    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 := verticalPanel := 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 preferredExtent y + rightVerticalPanel preferredExtent y)
                        @
                        (leftVerticalPanel preferredExtent y max:rightVerticalPanel preferredExtent y).
    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 
    verticalPanel add:b.
    whereRadioGroup add:b value:area.
    searchAreas add:area.
    self makeTabable:b.
!

addCheckBoxForClassMethodSearch
    |b|

    b := CheckBox label:(resources string:'Class Protocol').
    b model:(self searchClassProtocolHolder).
    verticalPanel 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).
    verticalPanel add:b.
    ^ b.
!

addCheckBoxForMethodList
    |b|

    b := CheckBox label:(resources string:'Methodlist').
    self addCheckBox:b forSearchArea:#listOfMethods.
    ^ b.
!

addCheckBoxForOwnerAndItsPrivateClasses
    |b lbl|

    (currentClass notNil and:[ currentClass isPrivate. ]) ifTrue:[ 
	lbl := resources string:'Owner (%1) & all its private classes'
		    with:currentClass owningClass name.
    ] ifFalse:[ 
	lbl := resources string:'Owners & all their private classes'.
    ].
    b := CheckBox label:lbl.
    self addCheckBox:b forSearchArea:#ownersWithPrivateClasses.
    (selectedClasses contains:[ :cls | cls isPrivate. ]) ifFalse:[ 
	b disable.
    ].
    ^ b.
!

addCheckBoxForOwnerAndItsSubclassesAndItsPrivateClasses
    |b lbl|

    (currentClass notNil and:[ currentClass isPrivate. ]) ifTrue:[ 
	lbl := resources 
		    string:'Owner (%1) & its subclasses & all its private classes'
		    with:currentClass owningClass name.
    ] ifFalse:[ 
	lbl := resources 
		    string:'Owners & their subclasses & all their private classes'.
    ].
    b := CheckBox label:lbl.
    self addCheckBox:b forSearchArea:#ownersHierarchiesWithPrivateClasses.
    (selectedClasses contains:[ :cls | cls isPrivate. ]) ifFalse:[ 
	b disable.
    ].
    ^ b.
!

addCheckBoxForSelectedClass
    |b lbl|

    (browser isMethodListBrowser or:[ currentClass isNil. ]) ifTrue:[ 
	selectedClasses size == 1 ifTrue:[ 
	    lbl := resources string:'Selected class (''%1'')'
			with:selectedClasses first theNonMetaclass name.
	] ifFalse:[ 
	    lbl := resources string:'Selected classes (%1)' with:selectedClasses size.
	].
    ] ifFalse:[ 
	lbl := resources string:'Class (''%1'')' with:currentClass name.
    ].
    b := CheckBox label:lbl.
    self addCheckBox:b forSearchArea:#classes.
    ^ b.
!

addCheckBoxForSelectedClassAndPrivateClasses
    |b lbl|

    (browser isMethodListBrowser or:[ currentClass isNil. ]) 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. ]) 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. ]) 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. ]) 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|

    currentClassCategory notNil ifTrue:[ 
	lbl := resources string:'Class category (''%1'')'
		    with:currentClassCategory.
    ] ifFalse:[ 
	lbl := resources string:'Selected classes categories (%1)'
		    with:selectedCategories size.
    ].
    b := CheckBox label:lbl.
    self addCheckBox:b forSearchArea:#classCategories.
    ^ b.
!

addCheckBoxForSelectedMethods
    |b|

    b := CheckBox label:(resources string:'Selected methods (%1)'
			with:browser selectedMethods value size).
    self addCheckBox:b forSearchArea:#listOfSelectedMethods.
    ^ b.
!

addCheckBoxForSelectedPackage
    |b lbl|

    currentClassCategory notNil ifTrue:[ 
        lbl := resources string:'Class category (''%1'')'
                    with:currentClassCategory.
    ] ifFalse:[ 
        lbl := resources string:'Selected classes categories (%1)'
                    with:selectedCategories size.
    ].
    b := CheckBox label:lbl.
    self addCheckBox:b forSearchArea:#classCategories.
    ^ b.
!

addDummyCheckBoxForEverywhere
    |b|

    b := CheckBox label:(resources string:'Everywhere').
    b turnOn.
    b disable.

    verticalPanel add:b.
!

addInputFieldForSelectorOrNameOrString
    |sel inputField lastSearchPatterns|

    isSelector == true ifTrue:[ 
	sel := browser selectorToSearchFor.
    ] ifFalse:[ 
	isSelector == #globalName ifTrue:[ 
	    sel := browser globalNameToSearchFor ? LastGlobalSearched.
	] ifFalse:[ 
	    sel := browser stringToSearchFor.
	].
    ].
    sel size == 0 ifTrue:[ 
	"/ use last searchString
	lastSearchPatterns := browser lastSearchPatterns.
	lastSearchPatterns size > 0 ifTrue:[ 
	    sel := lastSearchPatterns first.
	].
    ].
    selectorHolder := sel asValue.

    inputField := self addComboBoxOn:selectorHolder tabable:true.
    inputField list:lastSearchPatterns .
    inputField selectAll.
    inputField 
	entryCompletionBlock:[ :contents | 
	    |s what|

	    s := contents withoutSpaces.
	    self topView 
		withWaitCursorDo:[ 
		    isSelector == #globalName ifFalse:[ 
			what := Smalltalk selectorCompletion:s.
		    ] ifTrue:[ 
			what := Smalltalk globalNameCompletion:s.
		    ].
		    inputField contents:what first.
		    (what at:2) size ~~ 1 ifTrue:[ 
			browser window beep.
		    ].
		].
	].
!

addTextEntryFieldForCode
    |initial box panel 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 origin:0.0@0.0 corner:(0.75@1.0).

    infoLabel := Label in:panel.
"/    infoLabel origin:0.75@0.0 corner:(1.0@1.0).
    infoLabel font:(codeField font).
    infoLabel adjust:#left.
    infoLabel label:'MetaPatterns:

' , '`' allBold , ' = meta 

' , '@' allBold , ' = list/any
' , '.' allBold , ' = statement
' , '`' allBold , ' = recurse

' , '`#n' allBold , ' any lit
' , '`v' allBold , '  any var
' , '`@e' allBold , ' any expr
'.

    panel relativeCorners:#(0.6 1.0).

    helpButton := Button label:(resources string:'Pattern Help') in:infoLabel.
    helpButton layout:((AlignmentOrigin fractionalFromPoint:0.5@1.0) 
                            leftOffset:2
                            topOffset:helpButton preferredExtent y 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 paste:'`#n' ] in:metaBox.
    b := Button label:'Var' action:[ codeField paste:'`v' ] in:metaBox.
    b := Button label:'Expr' action:[ codeField paste:'`@e' ] in:metaBox.
    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.

    initial := browser selectionInCodeView.
    initial isEmptyOrNil ifTrue:[
        initial := LastCodeSearched ? ''
    ].
    codeField contents:initial.
    checkCodeAction value.
!

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 == #listOfMethods) ifTrue:[ 
        classes := nil.
        methods := browser methodListApp methodList value.
        ^ self.
    ].
    (where == #listOfSelectedMethods) ifTrue:[ 
        classes := nil.
        methods := browser selectedMethods value.
        ^ self.
    ].
"/    self halt.

    "Modified: / 09-10-2006 / 12:34:40 / 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
    ^ '$Header: /cvs/stx/stx/libtool/Tools_SearchDialog.st,v 1.21 2006-10-10 13:35:16 cg Exp $'
! !