#FEATURE by cg
class: DirectoryContentsBrowser
class definition
comment/format in: #dropTargetItemChangedTo:in:
variable renamed in:
#columnDescriptors:
#doResizeImage
changed:
#getPreviewFor:
#updateColumnsCycle
#viewedColumnsChanged
class: DirectoryContentsBrowser class
comment/format in: #viewBrowserMenuSpec
changed: #tableColumns
class: DirectoryContentsBrowser::DirectoryContentsItem
class definition
added:
#smoothPreview
#smoothPreview:
changed:
#preview
#preview:
#resetImageFile
#resetItem
class: DirectoryContentsBrowser::DirectoryContentsItem class
added: #documentation
"{ 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$'
! !