--- a/SystemBrowser.st Wed Jun 26 20:12:01 2013 +0200
+++ b/SystemBrowser.st Wed Jun 26 20:12:41 2013 +0200
@@ -17,7 +17,7 @@
EmphasisForDifferentPackage EmphasisForModifiedBuffer
EmphasisForObsoleteCode EmphasisForReadVariable
EmphasisForWrittenVariable EmphasisForChangedCode
- LastSearchPatterns'
+ LastSearchPatterns LastClassSearchBoxShowedFullName'
poolDictionaries:''
category:'Interface-Browsers'
!
@@ -342,6 +342,10 @@
^ self classHistory
collect:[:e | e className]
thenSelect:[:nm | nm notEmptyOrNil]
+
+ "
+ Tools::NewSystemBrowser visitedClassNamesHistory
+ "
! !
!SystemBrowser class methodsFor:'defaults'!
@@ -5649,6 +5653,7 @@
"
SystemBrowser askThenBrowseClass
+ Tools::NewSystemBrowser askThenBrowseClass
"
!
@@ -5657,6 +5662,7 @@
"
SystemBrowser askThenBrowseClassHierarchy
+ Tools::NewSystemBrowser askThenBrowseClassHierarchy
"
!
@@ -5665,38 +5671,232 @@
"
SystemBrowser askThenBrowseFullClassProtocol
- "
-!
-
-getClassThenPerform:aSelector
- |enterBox resources|
-
- resources := self classResources.
-
- enterBox := EnterBox title:(self classResources stringWithCRs:'Browse which class:').
- enterBox okText:(resources string:'Browse').
- enterBox entryCompletionBlock:(DoWhatIMeanSupport classNameEntryCompletionBlock).
- enterBox action:[:className |
- |cls|
-
- cls := Smalltalk classNamed:className.
- cls isNil ifTrue:[
- self warn:(resources string:'No such class').
- ] ifFalse:[
- self perform:aSelector with:cls
- ]
- ].
- enterBox showAtPointer
-
- "
- SystemBrowser getClassThenPerform:#browseClass:
- "
-
- "Modified: / 10-08-2006 / 12:54:20 / cg"
+ Tools::NewSystemBrowser askThenBrowseFullClassProtocol
+ "
! !
!SystemBrowser class methodsFor:'utilities'!
+askForClass
+ |className|
+
+ className := self askForClassName.
+ className notEmptyOrNil ifTrue:[
+ ^ Smalltalk classNamed:className
+ ].
+ ^ nil
+
+ "
+ Tools::NewSystemBrowser askForClass
+ "
+!
+
+askForClassName
+ self
+ askForClassToSearch:nil
+ single:true
+ msgTail:''
+ resources:(self classResources)
+ forBrowser:nil
+ thenDo:[:className :single :doWhat |
+ ^ className
+ ].
+ ^ nil
+
+ "
+ Tools::NewSystemBrowser askForClassName
+ "
+!
+
+askForClassToSearch:doWhatByDefault single:singleClass msgTail:msgTail resources:resourcesOrNil 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."
+
+ |box boxLabel title okText className canFind doWhat classNameHolder updateList
+ allClasses classNamesInChangeSet
+ allNames allFullNames initialShortNames initialFullNames
+ colorizedFullNames colorizedShortNames
+ resources check showingWhatLabel showFullNameHolder genShortNameListEntry|
+
+ resources := resourcesOrNil ? self classResources.
+ showFullNameHolder := (LastClassSearchBoxShowedFullName ? false) asValue.
+
+ doWhat := doWhatByDefault.
+ canFind := false.
+
+ title := ''.
+ boxLabel := (resources string:'Select a class').
+ okText := 'OK'.
+
+ genShortNameListEntry :=
+ [:cls |
+ |ns|
+ cls isNil ifTrue:[
+ nil
+ ] ifFalse:[
+ ns := cls topNameSpace name.
+ ns = 'Smalltalk'
+ ifTrue:[ ns := '' ]
+ ifFalse:[ns := ' (in ',ns,')'].
+ cls nameWithoutNameSpacePrefix,ns
+ ].
+ ].
+
+ classNamesInChangeSet := ChangeSet current changedClasses
+ collect:[:each | each theNonMetaclass name].
+
+ initialFullNames := self visitedClassNamesHistory.
+ initialShortNames := initialFullNames collect:[:nm | genShortNameListEntry value:(Smalltalk at:nm)] thenSelect:[:nm | nm notNil].
+
+ colorizedFullNames := initialFullNames collect:[:clsName |
+ (classNamesInChangeSet includes:clsName) ifTrue:[
+ clsName asText emphasisAllAdd:(UserPreferences current emphasisForChangedCode)
+ ] ifFalse:[
+ clsName
+ ].
+ ].
+
+ colorizedShortNames := initialShortNames with:initialFullNames collect:[:shortName :clsName |
+ (classNamesInChangeSet includes:clsName) ifTrue:[
+ shortName asText emphasisAllAdd:(UserPreferences current emphasisForChangedCode)
+ ] ifFalse:[
+ shortName
+ ].
+ ].
+
+ title := (resources string:title) , msgTail , '.\' , (resources string:'(TAB to complete; matchPattern allowed):').
+
+ box := self
+ enterBoxForClassWithCodeSelectionTitle:title withCRs
+ withList:(showFullNameHolder value ifTrue:[colorizedFullNames] ifFalse:[colorizedShortNames])
+ okText:okText
+ forBrowser:nil.
+
+ box label:boxLabel.
+
+ allClasses := Smalltalk allClasses copyAsOrderedCollection.
+
+ allNames := (allClasses
+ collect:[:cls |
+ |ns nm|
+
+ 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
+ ].
+ (classNamesInChangeSet includes:cls name) ifTrue:[
+ nm asText emphasisAllAdd:(UserPreferences current emphasisForChangedCode)
+ ] ifFalse:[
+ nm
+ ].
+ ]) sortWith:allClasses; yourself.
+
+ allFullNames := (allClasses
+ collect:[:cls |
+ |nm|
+
+ nm := cls name.
+ (classNamesInChangeSet includes:cls name) ifTrue:[
+ nm asText emphasisAllAdd:(UserPreferences current emphasisForChangedCode)
+ ] ifFalse:[
+ nm
+ ].
+ ]) sortWith:allClasses; yourself.
+
+ updateList := [
+ |nameToSearch list namesStarting namesIncluding lcName nameList|
+
+ (nameToSearch := classNameHolder value withoutSeparators) isEmpty ifTrue:[
+ showingWhatLabel label:(resources string:'Recently visited:').
+ list := (showFullNameHolder value ifTrue:[colorizedFullNames] ifFalse:[colorizedShortNames]).
+ ] 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
+
+ "Modified: / 23-07-2012 / 11:00:22 / cg"
+!
+
classWithNameSimilarTo:className
"helper for class-name entry; finds a class by name tolerant w.r.t. case"
@@ -5805,6 +6005,134 @@
"Modified: / 22-08-2006 / 14:53:38 / cg"
!
+enterBoxForClassWithCodeSelectionTitle:title withList:listOrNil okText:okText forBrowser:aBrowserOrNil
+ "convenient method: setup an enterBox with initial text taken
+ from the codeviews selection."
+
+ |sel box initialText superclass currentClass
+ methods someMethod offeredClass anyClose closeName s usedGlobals list|
+
+ list := listOrNil.
+
+ aBrowserOrNil notNil ifTrue:[
+ currentClass := aBrowserOrNil theSingleSelectedClass.
+
+ sel := aBrowserOrNil selectionInCodeView.
+ sel notNil ifTrue:[
+ aBrowserOrNil selectedNamespacesValue doWithExit:[:eachNs :exit |
+ s := eachNs , '::' , sel asSymbol.
+ (s knownAsSymbol
+ and:[(Smalltalk at:s asSymbol) isBehavior]) ifTrue:[
+ "/ a private class of current ...
+ sel := eachNs , '::' , sel asSymbol.
+ exit value:nil.
+ ].
+ ].
+ (sel knownAsSymbol and:[currentClass notNil
+ and:[(currentClass theNonMetaclass privateClassesAt:sel asSymbol) notNil]]) ifTrue:[
+ "/ a private class of current ...
+ sel := (currentClass theNonMetaclass privateClassesAt:sel asSymbol) name
+ ] ifFalse:[
+ (sel knownAsSymbol and:[(Smalltalk at:sel asSymbol) isBehavior]) ifFalse:[
+ "/ ignore it, if there is no class-name which comes close.
+ anyClose := false.
+ Smalltalk keysAndValuesDo:[:aGlobalName :aGlobal|
+ aGlobal isBehavior ifTrue:[
+ aGlobal isMeta ifFalse:[
+ aGlobal name == aGlobalName ifTrue:[
+ ((aGlobalName startsWith:sel)
+ or:[(sel startsWith:aGlobalName)]) ifTrue:[
+ closeName isNil ifTrue:[closeName := aGlobalName].
+ anyClose := true.
+ ]
+ ]
+ ]
+ ]
+ ].
+ anyClose ifFalse:[
+ sel := nil
+ ] ifTrue:[
+ sel := closeName
+ ]
+ ]
+ ]
+ ].
+
+ sel notNil ifTrue:[
+ initialText := sel asString withoutSeparators
+ ] ifFalse:[
+ aBrowserOrNil codeAspect == SyntaxHighlighter codeAspectMethod ifTrue:[
+ methods := aBrowserOrNil selectedMethodsValue.
+ methods size > 0 ifTrue:[
+ someMethod := methods first.
+ usedGlobals := someMethod usedGlobals collect:[:eachVar | eachVar asSymbol].
+ usedGlobals := usedGlobals select:[:eachVar | (Smalltalk at:eachVar) isBehavior].
+ usedGlobals size > 0 ifTrue:[
+ list := list reject:[:each | usedGlobals includes:each ].
+ list := usedGlobals asOrderedCollection sort , list.
+ offeredClass := Smalltalk at:usedGlobals first
+ ] ifFalse:[
+ offeredClass := someMethod mclass
+ ]
+ ]
+ ] ifFalse:[
+ (aBrowserOrNil navigationState isVersionDiffBrowser
+ or:[aBrowserOrNil navigationState isClassDocumentationBrowser]) ifTrue:[
+ offeredClass := currentClass.
+ (offeredClass notNil and:[offeredClass isPrivate]) ifTrue:[
+ offeredClass := offeredClass owningClass
+ ]
+ ] ifFalse:[
+ (currentClass notNil
+ and:[(superclass := currentClass superclass) notNil]) ifTrue:[
+ offeredClass := superclass
+ ]
+ ]
+ ].
+ offeredClass notNil ifTrue:[
+ initialText := offeredClass theNonMetaclass name
+ ]
+ ].
+ ].
+
+ box := self
+ enterBoxTitle:(self classResources string:title)
+ withList:list
+ okText:(self classResources string:okText).
+
+ initialText notNil ifTrue:[
+ box initialText:initialText
+ ].
+ ^ box
+
+ "Created: / 13-02-2000 / 20:56:18 / cg"
+ "Modified: / 27-07-2012 / 22:18:34 / cg"
+!
+
+enterBoxTitle:title withList:aListOrNil okText:okText
+ "convenient method: setup enterBox"
+
+ |box rsrcs|
+
+ aListOrNil notNil ifTrue:[
+ box := ListSelectionBox new.
+ "/ box := EnterBoxWithList new.
+ box list:aListOrNil.
+ ] ifFalse:[
+ box := EnterBox new.
+ ].
+ rsrcs := self classResources.
+ box title:(rsrcs string:title) okText:(rsrcs string:okText).
+ ^ box
+
+ "
+ self enterBoxTitle:'bla' withList:#('a' 'b' 'c') okText:'gaga'
+ "
+
+ "Created: / 13.2.2000 / 20:53:53 / cg"
+ "Modified: / 1.3.2000 / 11:15:09 / cg"
+!
+
extractClassAndSelectorFrom:aString into:aBlock
"given a string which can be either 'class>>sel' or
'class sel', extract className and selector, and call aBlock with
@@ -5903,6 +6231,37 @@
"Modified: / 6.2.2000 / 00:57:08 / cg"
!
+getClassThenPerform:aSelector
+ |classNameEntered classEntered enterBox resources|
+
+ "/ new Code:
+ classNameEntered := self askForClassName.
+
+ "/ old Code:
+"/ resources := self classResources.
+"/
+"/ enterBox := EnterBox title:(self classResources stringWithCRs:'Browse which class:').
+"/ enterBox okText:(resources string:'Browse').
+"/ enterBox entryCompletionBlock:(DoWhatIMeanSupport classNameEntryCompletionBlock).
+"/ enterBox action:[:className | classNameEntered := className].
+"/ enterBox showAtPointer.
+"/
+ classNameEntered notEmptyOrNil ifTrue:[
+ classEntered := Smalltalk classNamed:classNameEntered.
+ classEntered isNil ifTrue:[
+ self warn:(resources string:'No such class').
+ ] ifFalse:[
+ self perform:aSelector with:classEntered
+ ]
+ ].
+
+ "
+ SystemBrowser getClassThenPerform:#browseClass:
+ "
+
+ "Modified: / 10-08-2006 / 12:54:20 / cg"
+!
+
resourceEditorClassFor:aResource
"resources are from a methods resource-info;
return an appropriate editor class."
@@ -6030,15 +6389,15 @@
!SystemBrowser class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/SystemBrowser.st,v 1.324 2013-06-21 00:22:31 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/SystemBrowser.st,v 1.325 2013-06-26 18:12:41 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/SystemBrowser.st,v 1.324 2013-06-21 00:22:31 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/SystemBrowser.st,v 1.325 2013-06-26 18:12:41 cg Exp $'
!
version_SVN
- ^ '$Id: SystemBrowser.st,v 1.324 2013-06-21 00:22:31 cg Exp $'
+ ^ '$Id: SystemBrowser.st,v 1.325 2013-06-26 18:12:41 cg Exp $'
! !