"{ Package: 'stx:libtool' }"

"{ NameSpace: Tools }"

Object subclass:#ClassSearchDialog
	instanceVariableNames:'browser resources classFilter classNamesInChangeSet
		visitedShortNames visitedFullNames reallyAllClasses allClasses
		classNameHolder onlyShowJavaClassesHolder showFullNameHolder
		doFuzzyMatchHolder allNames allFullNames allClassesByFullName
		setOfClassNamesInChangeSet showingWhatLabel okText box'
	classVariableNames:'LastClassSearchBoxShowedFullName LastClassSearchBoxShowedJavaOnly
		LastClassSearchUsedFuzzyCompare'
	poolDictionaries:''
	category:'Interface-Browsers-Support'
!

!ClassSearchDialog class methodsFor:'documentation'!

documentation
"
    code extracted from SystemBrowser class,
    to make it easier to refactor and to reuse.
"
! !

!ClassSearchDialog methodsFor:'asking'!

askForClassToSearch:doWhatByDefault single:singleClass msgTail:msgTail resources:resourcesOrNil filter:filterOrNil forBrowser:aBrowserOrNil thenDo:aBlock
    "utility common code for both opening a new browser on a class and
     to search for a class in an existing browser.
     If singleClass is true, a single class will be asked for and browsed,
     otherwise, a match pattern is allowed and a multi-class browser is opened.
     Moved from instance protocol for better reusability."

    |boxLabel title okText2 okText3 okText4 className canFind
     button2 button3 button4 doWhat doWhat2 doWhat3 doWhat4 check 
     navigationState enableFuzzyHolder|

    classFilter := filterOrNil. 
    self getResourcesFrom:resourcesOrNil orBrowser:aBrowserOrNil.

    showFullNameHolder := (LastClassSearchBoxShowedFullName ? false) asValue.
    onlyShowJavaClassesHolder := (LastClassSearchBoxShowedJavaOnly ? false) asValue.
    doFuzzyMatchHolder := (LastClassSearchUsedFuzzyCompare ? false) asValue.
    enableFuzzyHolder := true asValue. 
    
    aBrowserOrNil notNil ifTrue:[ navigationState := aBrowserOrNil navigationState].

    doWhat := doWhatByDefault.
    canFind := navigationState notNil and:[ navigationState isFullBrowser ].

    (doWhat isNil or:[aBrowserOrNil isNil]) ifTrue:[
        title := 'Select a class'.
        boxLabel := 'Select a class'.
        okText := 'OK'.
        okText2 := nil. doWhat2 := nil.
        okText3 := nil. doWhat3 := nil.
        okText4 := nil. doWhat4 := nil.
    ] ifFalse:[
        title := (singleClass ifTrue:[ 'Class to browse' ] ifFalse:[ 'Class(es) to browse' ]).
        boxLabel := 'Browse or Search'.

        (doWhat isNil and:[canFind not]) ifTrue:[
            doWhat := #newBuffer.
        ].

        doWhat == #newBrowser ifTrue:[
            okText := 'Open'.
            okText2 := 'Add Buffer'. doWhat2 := #newBuffer.
            okText3 := 'Open All'.   doWhat3 := #newBrowserForAll.
            okText4 := 'Find'.       doWhat4 := nil.
        ] ifFalse:[ doWhat == #newBuffer ifTrue:[
            okText := 'Add Buffer'.
            okText2 := 'Open New'.   doWhat2 := #newBrowser.
            okText3 := 'Open All'.   doWhat3 := #newBrowserForAll.
            okText4 := 'Find'.       doWhat4 := nil.
        ] ifFalse:[
            title := (singleClass ifTrue:[ 'Class to find' ] ifFalse:[ 'Class(es) to find' ]).
            okText := 'Find'.
            okText2 := 'Open New'.   doWhat2 := #newBrowser.
            okText3 := 'Open All'.   doWhat3 := #newBrowserForAll.
            okText4 := 'Add Buffer'. doWhat4 := #newBuffer.
        ]].
    ].

    self getClassNamesInChangeSet.
    self getVisitedNames.
    self getAllClasses.

    self createDialogBox:msgTail title:title label:boxLabel.

    doWhat notNil ifTrue:[
        button2 := Button label:(resources string:okText2).
        (navigationState notNil and:[navigationState isFullBrowser]) "singleClass" ifTrue:[
            button3 := Button label:(resources string:okText3).
            button4 := Button label:(resources string:okText4).
        ].
        box addButton:button2 after:(box okButton).
        button3 notNil ifTrue:[box addButton:button3 after:button2].
        button4 notNil ifTrue:[box addButton:button4 after:button3].

        button2
            action:[
                doWhat := doWhat2.
                box doAccept; okPressed.
            ].
        button3 notNil ifTrue:[
            button3
                action:[
                    doWhat := doWhat3.
                    box doAccept; okPressed.
                ].
        ].
        button4 notNil ifTrue:[
            button4
                action:[
                    doWhat := doWhat4.
                    box doAccept; okPressed.
                ].
        ].
    ].

    classNameHolder := '' asValue.
    box enterField model:classNameHolder; immediateAccept:true.
    classNameHolder onChangeEvaluate:[
        enableFuzzyHolder value:(classNameHolder value includesMatchCharacters not).
        self updateList
    ].

    box entryCompletionBlock:(DoWhatIMeanSupport classNameEntryCompletionBlock).
    box action:[:aString | className := aString ].

    box panelView
        addSubView:(showingWhatLabel := (Label label:(resources string:'Recently Visited:')) adjust:#left) before:nil.

    (JavaVM notNil and:[JavaVM isLoaded]) ifTrue:[
        box panelView
            addSubView:(check := CheckBox label:(resources string:'Only show Java Classes') model:onlyShowJavaClassesHolder) before:nil.
    ].
    box panelView
        addSubView:(check := CheckBox label:(resources string:'Show Full Name (do not Strip off Namespace)') model:showFullNameHolder) before:nil.
    box panelView
        addSubView:(check := CheckBox label:(resources string:'Fuzzy Match (Instead of Substring Search)') model:doFuzzyMatchHolder) before:nil.
    check enableChannel:enableFuzzyHolder.
    
    doFuzzyMatchHolder onChangeEvaluate:[self updateList].   
    showFullNameHolder onChangeEvaluate:[self updateList].
    onlyShowJavaClassesHolder onChangeEvaluate:[ self getAllClasses. self updateList].

"/    box enterField 
"/        onKey:#CursorDown leaveWith:[
"/            |listView|
"/            
"/            listView := box listView.
"/            listView windowGroup focusView:listView byTab:true.
"/            listView hasSelection ifFalse:[
"/                listView selectFirst
"/            ] ifTrue:[
"/                listView selectNext
"/            ].
"/        ].
    box enterField 
        origin:(0 @ check corner y).
    box listView origin:(0 @ check corner y).

    box extent:(400 @ 550).
    box open.

    className isEmptyOrNil ifTrue:[^ nil "cancel"].

    LastClassSearchBoxShowedFullName := showFullNameHolder value.
    LastClassSearchBoxShowedJavaOnly := onlyShowJavaClassesHolder value.
    LastClassSearchUsedFuzzyCompare := doFuzzyMatchHolder value.
    
    (className endsWith:$) ) ifTrue:[
        (className indexOfSubCollection:'(in ') == 0 ifTrue:[
            "/ a namespace
            className := (className copyTo:(className indexOfSubCollection:'(Name')-1) withoutSeparators
        ] ifFalse:[
            className := ((className copyFrom:(className indexOfSubCollection:'(in ')+4)
                            copyButLast)
                         , '::' , className asCollectionOfWords first
        ].
        ((className startsWith:'JAVA::') and:[className includes:$.]) ifTrue:[
            className := className copyReplaceString:'.' withString:'::'
        ].
    ].

    (doWhat isNil or:[aBrowserOrNil isNil]) ifTrue:[
        aBlock notNil ifTrue:[aBlock value:className optionalArgument:singleClass and:doWhat].
        ^ className
    ].

    aBrowserOrNil withSearchCursorDo:[
        aBlock value:className value:singleClass value:doWhat.
    ].
    ^ className

    "Created: / 03-08-2017 / 12:25:45 / cg"
    "Modified: / 04-08-2017 / 13:02:36 / cg"
!

old_askForClassToSearch:doWhatByDefault single:singleClass msgTail:msgTail resources:resourcesOrNil filter:filterOrNil forBrowser:aBrowserOrNil thenDo:aBlock
    "utility common code for both opening a new browser on a class and
     to search for a class in an existing browser.
     If singleClass is true, a single class will be asked for and browsed,
     otherwise, a match pattern is allowed and a multi-class browser is opened.
     Moved from instance protocol for better reusability."

    "
     self new 
        old_askForClassToSearch:doWhatByDefault 
        single:singleClass 
        msgTail:msgTail 
        resources:resourcesOrNil 
        filter:filterOrNil 
        forBrowser:aBrowserOrNil 
        thenDo:aBlock
    "
    
    |className doWhat updateList check  |

    classFilter := filterOrNil.
    self getResourcesFrom:resourcesOrNil orBrowser:aBrowserOrNil.
    
    showFullNameHolder := (LastClassSearchBoxShowedFullName ? false) asValue.

    doWhat := doWhatByDefault.

    okText := 'OK'.

    self getClassNamesInChangeSet.
    self getVisitedNames.
    self getAllClasses.

    self createDialogBox:msgTail title:'Select a class' label:'Select a class'.

    updateList := [ self halt. self updateList ].
"/    updateList := [
"/            |nameToSearch list namesStarting namesIncluding lcName nameList|
"/
"/            (nameToSearch := classNameHolder value withoutSeparators) isEmpty ifTrue:[
"/                showingWhatLabel label:(resources string:'Recently visited:').
"/                list := (showFullNameHolder value ifTrue:[visitedFullNames] ifFalse:[visitedShortNames]).
"/            ] ifFalse:[
"/                showingWhatLabel label:(resources string:'Matching classes:').
"/                nameList := showFullNameHolder value
"/                                ifTrue:[ allFullNames ]
"/                                ifFalse:[ allNames ].
"/
"/                lcName := nameToSearch asLowercase.
"/                (lcName includesString:'::') ifTrue:[
"/                    list := OrderedCollection new.
"/                    allClasses doWithIndex:[:cls :idx |
"/                        |isIncluded|
"/
"/                        (nameToSearch includesMatchCharacters) ifTrue:[
"/                            isIncluded := (lcName match:cls name asLowercase)
"/                        ] ifFalse:[
"/                            isIncluded := (cls name includesString:lcName caseSensitive:false)
"/                        ].
"/                        isIncluded ifTrue:[
"/                            list add:(nameList at:idx)
"/                        ].
"/                    ].
"/                ] ifFalse:[
"/                    (nameToSearch includesMatchCharacters) ifTrue:[
"/                        list := nameList select:[:nm | lcName match:nm asLowercase]
"/                    ] ifFalse:[
"/                        namesIncluding := nameList
"/                                            select:[:nm |
"/                                                "/ nm asLowercase startsWith:lcName
"/                                                nm asLowercase includesString:lcName caseSensitive:false
"/                                            ].
"/                        namesStarting := namesIncluding select:[:nm | nm asLowercase startsWith:lcName].
"/                        list := namesStarting , {nil} , (namesIncluding \ namesStarting).
"/                    ]
"/                ]
"/            ].
"/            box listView
"/                list:list;
"/                scrollToLine:((list findFirst:[:line | (line ? '') startsWith:lcName]) max:1)
"/        ].

    classNameHolder := '' asValue.
    box enterField model:classNameHolder; immediateAccept:true.
    classNameHolder onChangeEvaluate:updateList.

    box entryCompletionBlock:(DoWhatIMeanSupport classNameEntryCompletionBlock).
    box action:[:aString | className := aString].

    box panelView
        addSubView:(showingWhatLabel := (Label label:(resources string:'Recently visited:')) adjust:#left) before:nil;
        addSubView:(check := CheckBox label:(resources string:'Show Full Name (do not strip off Namespace)') model:showFullNameHolder) before:nil.
    showFullNameHolder onChangeEvaluate:updateList.
    box enterField origin:(0 @ check corner y).
    box listView origin:(0 @ check corner y).

    box extent:(400 @ 350).
    box open.

    className isEmptyOrNil ifTrue:[^ nil "cancel"].

    LastClassSearchBoxShowedFullName := showFullNameHolder value.

    (className endsWith:$) ) ifTrue:[
        (className indexOfSubCollection:'(in ') == 0 ifTrue:[
            "/ a namespace
            className := (className copyTo:(className indexOfSubCollection:'(Name')-1) withoutSeparators
        ] ifFalse:[
            className := ((className copyFrom:(className indexOfSubCollection:'(in ')+4)
                            copyButLast:1)
                         , '::' , className asCollectionOfWords first
        ].
    ].

    aBlock notNil ifTrue:[aBlock value:className optionalArgument:singleClass and:doWhat].
    ^ className

    "Created: / 03-08-2017 / 12:31:08 / cg"
    "Modified: / 03-08-2017 / 14:14:39 / cg"
! !

!ClassSearchDialog methodsFor:'private helpers'!

createDialogBox:msg title:boxTitle label:boxLabel
    |title|
    
    title := (resources string:boxTitle) , msg , '.\' , (resources string:'(TAB to complete; matchPattern allowed - "*" for all):').

    box := SystemBrowser
                enterBoxForClassWithCodeSelectionTitle:title withCRs
                withList:(showFullNameHolder value ifTrue:[visitedFullNames] ifFalse:[visitedShortNames])
                okText:(okText ? 'OK')
                forBrowser:browser.

    box label:(resources string:boxLabel).
    ^ box

    "Created: / 03-08-2017 / 14:02:33 / cg"
!

genShortNameListEntry:cls
    |ns|

    cls isNil ifTrue:[
        ^ nil
    ].
    
    ns := cls topNameSpace name.
    ns = 'Smalltalk'
        ifTrue:[ ns := '' ]
        ifFalse:[ns := ' (in ',ns,')'].

    ^ cls nameWithoutNameSpacePrefix,ns

    "Created: / 03-08-2017 / 12:41:04 / cg"
!

getAllClasses
    "
     self new getAllClasses
     
     Time millisecondsToRun:[
        self new getAllClasses
     ]
    "
    
    |prefs emphasisForChanged |
    
    prefs := UserPreferences current.
    emphasisForChanged := prefs emphasisForChangedCode.

    setOfClassNamesInChangeSet isNil ifTrue:[
        self getClassNamesInChangeSet 
    ].

    reallyAllClasses isNil ifTrue:[
        reallyAllClasses := Smalltalk allClasses copyAsOrderedCollection
    ].    
    allClasses := reallyAllClasses.
    (onlyShowJavaClassesHolder value ? false) ifTrue:[
        allClasses := allClasses select:[:cls | cls isJavaClass].
    ].
    classFilter notNil ifTrue:[
        allClasses := allClasses select:classFilter
    ].
    allClassesByFullName := allClasses copy.

    allNames := (allClasses
                collect:[:cls |
                    |ns nm|

                    cls isJavaClass ifTrue:[
                        nm := cls javaName,' (in JAVA)'
                    ] ifFalse:[
                        ns := cls topNameSpace name.
                        ns = 'Smalltalk'
                            ifTrue:[ ns := '' ]
                            ifFalse:[ns := ' (in ',ns,')'].
                        cls isNameSpace ifTrue:[
                            nm := cls nameWithoutNameSpacePrefix,ns,' (Namespace)'
                        ] ifFalse:[
                            nm := cls nameWithoutNameSpacePrefix,ns
                        ].
                    ].
                    (setOfClassNamesInChangeSet includes:cls name) ifTrue:[
                        nm asText emphasisAllAdd:emphasisForChanged
                    ] ifFalse:[
                        nm
                    ].
                ]) sortWith:allClasses; yourself.

    allFullNames := (allClasses
                collect:[:cls |
                    |nm|

                    nm := cls name.
                    (setOfClassNamesInChangeSet includes:nm) ifTrue:[
                        nm asText emphasisAllAdd:emphasisForChanged
                    ] ifFalse:[
                        nm
                    ].
                ]) sortWith:allClassesByFullName; yourself.

    "Created: / 03-08-2017 / 12:59:51 / cg"
!

getClassNamesInChangeSet
    |classesInChangeSet|
    
    classesInChangeSet := ChangeSet current changedClasses.
    classFilter notNil ifTrue:[
        classesInChangeSet := classesInChangeSet select:classFilter
    ].    
        
    classNamesInChangeSet := classesInChangeSet collect:[:each | each theNonMetaclass name].
    setOfClassNamesInChangeSet := classNamesInChangeSet asSet.

    "Created: / 03-08-2017 / 12:47:00 / cg"
!

getResourcesFrom:resourcesOrNil orBrowser:aBrowserOrNil
    resources := resourcesOrNil.
    resources isNil ifTrue:[
        aBrowserOrNil notNil ifTrue:[
            resources := aBrowserOrNil resources.
        ].
        resources isNil ifTrue:[
            resources := SystemBrowser classResources.
        ].
    ].

    "Created: / 03-08-2017 / 12:31:58 / cg"
!

getVisitedNames
    |initialFullNames initialShortNames prefs 
     emphasisForChanged setOfClassNamesInChangeSet|
    
    initialFullNames := SystemBrowser visitedClassNamesHistory.
    (classFilter notNil) ifTrue:[
        initialFullNames := initialFullNames 
                                select:[:nm | 
                                    |cls|

                                    (cls := Smalltalk at:nm) notNil 
                                    and:[classFilter value:cls]
                                ].
    ].

    initialFullNames := initialFullNames select:[:nm | nm notNil].
    initialShortNames := initialFullNames collect:[:nm |
                            |cls|

                            cls := Smalltalk classNamed:nm.
                            cls isNil ifTrue:[
                                "/ class no longer exists (removed?)
                                nm withColor:(Color gray)
                            ] ifFalse:[
                                cls isJavaClass ifTrue:[
                                    cls javaName
                                ] ifFalse:[
                                    self genShortNameListEntry:(Smalltalk classNamed:nm)
                                ].
                            ].
                        ].

    prefs := UserPreferences current.
    emphasisForChanged := prefs emphasisForChangedCode.

    setOfClassNamesInChangeSet := classNamesInChangeSet asSet.
    
    visitedFullNames := initialFullNames collect:[:clsName |
                                (setOfClassNamesInChangeSet includes:clsName) ifTrue:[
                                    clsName asText emphasisAllAdd:emphasisForChanged
                                ] ifFalse:[
                                    clsName
                                ].
                            ].

    visitedShortNames := initialShortNames with:initialFullNames collect:[:shortName :clsName |
                                (setOfClassNamesInChangeSet includes:clsName) ifTrue:[
                                    shortName asText emphasisAllAdd:emphasisForChanged
                                ] ifFalse:[
                                    shortName
                                ].
                            ].

    "Created: / 03-08-2017 / 12:54:10 / cg"
!

updateList
    |nameToSearch list namesStarting namesNotStarting lcName nameList classList 
     isGlobOrRegexMatch isFuzzySearch labelText sort|

    (nameToSearch := classNameHolder value withoutSeparators) isEmpty ifTrue:[
        labelText := 'Recently visited:'.
        list := (showFullNameHolder value ifTrue:[visitedFullNames] ifFalse:[visitedShortNames]).
    ] ifFalse:[
        (nameToSearch includesString:'>>') ifTrue:[
            nameToSearch := (nameToSearch copyTo:(nameToSearch indexOfString:'>>')-1) withoutSeparators.
        ].    
        isGlobOrRegexMatch := nameToSearch includesMatchCharacters.
        isFuzzySearch := isGlobOrRegexMatch not and:[doFuzzyMatchHolder value].

        labelText := 'Matching classes:'.
        labelText := isGlobOrRegexMatch 
                        ifTrue:['Matching classes (pattern):'] 
                        ifFalse:[
                            isFuzzySearch ifTrue:[
                                'Matching classes (fuzzy match):'
                            ] ifFalse:[
                                'Matching classes (substring):'
                            ].
                        ].

        nameList := showFullNameHolder value ifTrue:[ allFullNames ] ifFalse:[ allNames ].
        classList := showFullNameHolder value ifTrue:[ allClassesByFullName ] ifFalse:[ allClasses ].
        lcName := nameToSearch asLowercase.
        false "(lcName includesString:'::')" ifTrue:[
            list := OrderedCollection new.
            allClasses doWithIndex:[:cls :idx |
                |isIncluded|

                isGlobOrRegexMatch ifTrue:[
                    isIncluded := (lcName match:cls name asLowercase)
                ] ifFalse:[
                    isIncluded := (cls name includesString:lcName caseSensitive:false)
                ].
                isIncluded ifTrue:[
                    list add:(nameList at:idx)
                ].
            ].
        ] ifFalse:[
            isGlobOrRegexMatch ifTrue:[
                list := (1 to:allFullNames size)
                            select:
                                [:idx |
                                    |nm1 nm2|
                                    nm1 := (allFullNames at:idx) asLowercase.
                                    nm2 := (classList at:idx) name asLowercase.
                                    (lcName match:nm1)
                                    or:[ (nm1~=nm2) and:[ lcName match:nm2]]
                                ] 
                            thenCollect:[:idx | "nameList "allFullNames"" at:idx].

            ] ifFalse:[
                (doFuzzyMatchHolder value and:[FuzzyMatcher notNil]) ifTrue:[
                    |matcher matches|

                    matches := OrderedCollection new.
                    matcher := FuzzyMatcher pattern:lcName.
                    allFullNames "nameList" do:[:eachClassName | 
                        matcher 
                            match:eachClassName
                            ifScored: [:score | 
                                matches add: { eachClassName . score . (matcher indexes copy) }
                            ] 
                    ].
                    matches 
                        sort:[:a :b |
                            |score_a score_b|

                            score_a := a at:2.
                            score_b := b at:2.
                            score_a < score_b
                            or:[ score_a = score_b and:[ (a at:1) > (b at:1)]
                        ]
                    ].
                    matches reverse.
                    list := (matches copyTo:(matches size min:150)) 
                                        collect:[:triple |
                                            |name score indexes|
                                            name := triple first.
                                            indexes := triple third.
                                            name := name asText withColor:Color gray slightlyDarkened.
                                            indexes do:[:each |
                                                "/ name emphasiseFrom:each to:each with:{ #bold . #color->Color black }  
                                                name emphasiseFrom:each to:each with:{ #color->Color black }  
                                            ].
                                            name
                                        ].
                ] ifFalse:[    
                    list := (1 to:nameList size)
                                        select:[:idx |
                                            |nm|
                                            nm := nameList at:idx.
                                            (nm includesString:lcName caseSensitive:false)
                                            or:[ (classList at:idx) name includesString:lcName caseSensitive:false]
                                        ] thenCollect:[:idx | 
                                            |name matchPos|
                                            
                                            name := nameList at:idx.
                                            matchPos := name indexOfSubCollection:lcName caseSensitive:false.
                                            name := name asText withColor:Color gray slightlyDarkened.
                                            matchPos ~~ 0 ifTrue:[
                                                name := name emphasiseFrom:matchPos to:matchPos+lcName size-1 with:{ #color->Color black }  
                                            ].
                                            name
                                        ].
                ].
            ]
        ].

        sort := 
            [:list |
                |list2 nameForDistance|

                nameForDistance := nameToSearch copyWithoutAll:'*#'.

                list2 := list collect:[:nm | nm -> (nm levenshteinTo:nameForDistance)].
                list2 sortBySelector:#value.
                list2 collect:#key
            ].

        namesStarting := list select:[:nm | nm asLowercase startsWith:lcName].
        namesNotStarting := (list \ namesStarting).
        list := (sort value:namesStarting) , {nil} , (sort value:namesNotStarting).
    ].
    
    showingWhatLabel label:(resources string:labelText).
    box listView
        list:list;
        scrollToLine:((list findFirst:[:line | (line ? '') startsWith:lcName]) max:1)

    "Created: / 03-08-2017 / 14:10:37 / cg"
    "Modified: / 04-08-2017 / 12:59:06 / cg"
! !

!ClassSearchDialog class methodsFor:'documentation'!

version
    ^ '$Header$'
!

version_CVS
    ^ '$Header$'
! !