--- a/Tools__NewSystemBrowser.st Fri Sep 20 10:52:30 2013 +0100
+++ b/Tools__NewSystemBrowser.st Sat Sep 21 02:18:20 2013 +0100
@@ -12494,256 +12494,256 @@
^
#(Menu
- (
- (MenuItem
- label: 'Toolbar'
- translateLabel: true
- hideMenuOnActivated: false
- indication: toolBarVisibleHolder
- )
- (MenuItem
- label: 'Bookmarks'
- translateLabel: true
- hideMenuOnActivated: false
- indication: bookmarkBarVisibleHolder
- )
- (MenuItem
- label: 'Searchbar'
- translateLabel: true
- hideMenuOnActivated: false
- indication: stringSearchToolVisibleHolder
- )
- (MenuItem
- label: 'Info'
- translateLabel: true
- hideMenuOnActivated: false
- indication: codeInfoVisible
- )
- (MenuItem
- label: '-'
- )
- (MenuItem
- label: 'Multitab Mode'
- translateLabel: true
- hideMenuOnActivated: false
- indication: showMultitabMode
- )
- (MenuItem
- label: 'Enable Embedded Resource Editors'
- translateLabel: true
- hideMenuOnActivated: false
- indication: showSpecialResourceEditors
- )
- (MenuItem
- label: 'Coverage Info'
- translateLabel: true
- hideMenuOnActivated: false
- indication: showCoverageInformation
- )
- (MenuItem
- label: 'Browslet'
- itemValue: showPlugin:
- translateLabel: true
- isVisible: false
- hideMenuOnActivated: false
- indication: showPlugin
- )
- (MenuItem
- label: '-'
- )
- (MenuItem
- label: 'Class'
- translateLabel: true
- submenu:
- (Menu
- (
- (MenuItem
- label: 'Hide Unloaded Classes'
- translateLabel: true
- hideMenuOnActivated: false
- indication: hideUnloadedClasses
- )
- (MenuItem
- label: 'Show All Classes in NameSpace View'
- translateLabel: true
- hideMenuOnActivated: false
- indication: showAllClassesInNameSpaceOrganisation
- )
- (MenuItem
- label: '-'
- )
- (MenuItem
- enabled: showUnloadedClasses
- label: 'Emphasize Unloaded Classes'
- translateLabel: true
- hideMenuOnActivated: false
- indication: emphasizeUnloadedClasses
- )
- (MenuItem
- label: 'Show Class Type Indicator'
- translateLabel: true
- hideMenuOnActivated: false
- indication: markApplicationsHolder
- )
- (MenuItem
- label: 'Short Class Names in Tabs'
- translateLabel: true
- hideMenuOnActivated: false
- indication: shortNamesInTabs
- )
- (MenuItem
- label: 'Show Class-Packages'
- translateLabel: true
- hideMenuOnActivated: false
- indication: showClassPackages
- )
- (MenuItem
- label: '-'
- )
- (MenuItem
- label: 'Sort and Indent by Inheritance'
- translateLabel: true
- hideMenuOnActivated: false
- indication: sortByNameAndInheritance
- )
- )
- nil
- nil
- )
- )
- (MenuItem
- label: 'Protocol'
- translateLabel: true
- submenu:
- (Menu
- (
- (MenuItem
- label: 'Show Pseudo Protocols'
- translateLabel: true
- hideMenuOnActivated: false
- indication: showPseudoProtocols
- )
- )
- nil
- nil
- )
- )
- (MenuItem
- label: 'Selector'
- translateLabel: true
- submenu:
- (Menu
- (
- (MenuItem
- label: 'Show Inherited Methods'
- translateLabel: true
- hideMenuOnActivated: false
- choice: methodVisibilityHolder
- choiceValue: all
- )
- (MenuItem
- label: 'Show Inherited Methods except Object''s'
- translateLabel: true
- hideMenuOnActivated: false
- choice: methodVisibilityHolder
- choiceValue: allButObject
- )
- (MenuItem
- label: 'Do not Show Inherited Methods'
- translateLabel: true
- hideMenuOnActivated: false
- choice: methodVisibilityHolder
- choiceValue: class
- )
- (MenuItem
- label: '-'
- )
- (MenuItem
- label: 'Show Synthetic Methods'
- translateLabel: true
- hideMenuOnActivated: false
- indication: showSyntheticMethods
- )
- (MenuItem
- label: '-'
- )
- (MenuItem
- label: 'Show Method Inheritance Indicator'
- translateLabel: true
- hideMenuOnActivated: false
- indication: showMethodInheritance
- )
- (MenuItem
- label: 'Show Method Type Indicator'
- translateLabel: true
- hideMenuOnActivated: false
- indication: showMethodTypeIcon
- )
- (MenuItem
- enabled: hasOOMPackageLoadedHolder
- label: 'Show Method-Complexity'
- translateLabel: true
- hideMenuOnActivated: false
- indication: showMethodComplexity
- )
- )
- nil
- nil
- )
- )
- (MenuItem
- label: 'Code'
- translateLabel: true
- submenu:
- (Menu
- (
- (MenuItem
- label: 'Syntax Coloring'
- translateLabel: true
- hideMenuOnActivated: false
- indication: doSyntaxColoring
- )
- (MenuItem
- enabled: doSyntaxColoring
- label: 'Immediate Syntax Coloring'
- translateLabel: true
- hideMenuOnActivated: false
- indication: doImmediateSyntaxColoring
- )
- (MenuItem
- label: 'Immediate Explaining'
- translateLabel: true
- hideMenuOnActivated: false
- indication: doImmediateExplaining
- )
- (MenuItem
- label: 'Auto-Format Code'
- translateLabel: true
- hideMenuOnActivated: false
- indication: doAutoFormat
- )
- (MenuItem
- label: 'Show MethodTemplate for New Methods'
- translateLabel: true
- hideMenuOnActivated: false
- indication: showMethodTemplate
- )
- )
- nil
- nil
- )
- )
- (MenuItem
- label: '-'
- )
- (MenuItem
- label: 'Settings...'
- itemValue: openSettingsDialog
- translateLabel: true
- )
- )
- nil
- nil
+ (
+ (MenuItem
+ label: 'Toolbar'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: toolBarVisibleHolder
+ )
+ (MenuItem
+ label: 'Bookmarks'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: bookmarkBarVisibleHolder
+ )
+ (MenuItem
+ label: 'Searchbar'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: stringSearchToolVisibleHolder
+ )
+ (MenuItem
+ label: 'Info'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: codeInfoVisible
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
+ label: 'Multitab Mode'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: showMultitabMode
+ )
+ (MenuItem
+ label: 'Enable Embedded Resource Editors'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: showSpecialResourceEditors
+ )
+ (MenuItem
+ label: 'Coverage Info'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: showCoverageInformation
+ )
+ (MenuItem
+ label: 'Browslet'
+ itemValue: showPlugin:
+ translateLabel: true
+ isVisible: false
+ hideMenuOnActivated: false
+ indication: showPlugin
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
+ label: 'Class'
+ translateLabel: true
+ submenu:
+ (Menu
+ (
+ (MenuItem
+ label: 'Hide Unloaded Classes'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: hideUnloadedClasses
+ )
+ (MenuItem
+ label: 'Show All Classes in NameSpace View'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: showAllClassesInNameSpaceOrganisation
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
+ enabled: showUnloadedClasses
+ label: 'Emphasize Unloaded Classes'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: emphasizeUnloadedClasses
+ )
+ (MenuItem
+ label: 'Show Class Type Indicator'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: markApplicationsHolder
+ )
+ (MenuItem
+ label: 'Short Class Names in Tabs'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: shortNamesInTabs
+ )
+ (MenuItem
+ label: 'Show Class-Packages'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: showClassPackages
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
+ label: 'Sort and Indent by Inheritance'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: sortByNameAndInheritance
+ )
+ )
+ nil
+ nil
+ )
+ )
+ (MenuItem
+ label: 'Protocol'
+ translateLabel: true
+ submenu:
+ (Menu
+ (
+ (MenuItem
+ label: 'Show Pseudo Protocols'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: showPseudoProtocols
+ )
+ )
+ nil
+ nil
+ )
+ )
+ (MenuItem
+ label: 'Selector'
+ translateLabel: true
+ submenu:
+ (Menu
+ (
+ (MenuItem
+ label: 'Show Inherited Methods'
+ translateLabel: true
+ hideMenuOnActivated: false
+ choice: methodVisibilityHolder
+ choiceValue: all
+ )
+ (MenuItem
+ label: 'Show Inherited Methods except Object''s'
+ translateLabel: true
+ hideMenuOnActivated: false
+ choice: methodVisibilityHolder
+ choiceValue: allButObject
+ )
+ (MenuItem
+ label: 'Do not Show Inherited Methods'
+ translateLabel: true
+ hideMenuOnActivated: false
+ choice: methodVisibilityHolder
+ choiceValue: class
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
+ label: 'Show Synthetic Methods'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: showSyntheticMethods
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
+ label: 'Show Method Inheritance Indicator'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: showMethodInheritance
+ )
+ (MenuItem
+ label: 'Show Method Type Indicator'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: showMethodTypeIcon
+ )
+ (MenuItem
+ enabled: hasOOMPackageLoadedHolder
+ label: 'Show Method-Complexity'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: showMethodComplexity
+ )
+ )
+ nil
+ nil
+ )
+ )
+ (MenuItem
+ label: 'Code'
+ translateLabel: true
+ submenu:
+ (Menu
+ (
+ (MenuItem
+ label: 'Syntax Coloring'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: doSyntaxColoring
+ )
+ (MenuItem
+ enabled: doSyntaxColoring
+ label: 'Immediate Syntax Coloring'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: doImmediateSyntaxColoring
+ )
+ (MenuItem
+ label: 'Immediate Explaining'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: doImmediateExplaining
+ )
+ (MenuItem
+ label: 'Auto-Format Code'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: doAutoFormat
+ )
+ (MenuItem
+ label: 'Show MethodTemplate for New Methods'
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: showMethodTemplate
+ )
+ )
+ nil
+ nil
+ )
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
+ label: 'Settings...'
+ itemValue: openSettingsDialog
+ translateLabel: true
+ )
+ )
+ nil
+ nil
)
!
@@ -17862,230 +17862,230 @@
doWhat := doWhatByDefault.
canFind := aBrowserOrNil notNil
- and:[aBrowserOrNil navigationState notNil and:[ aBrowserOrNil navigationState isFullBrowser ]].
+ and:[aBrowserOrNil navigationState notNil and:[ aBrowserOrNil navigationState isFullBrowser ]].
(doWhat isNil or:[aBrowserOrNil isNil]) ifTrue:[
- title := ''.
- boxLabel := (resources string:'Select a class').
- okText := 'OK'.
- okText2 := nil. doWhat2 := nil.
- okText3 := nil. doWhat3 := nil.
- ] ifFalse:[
- title := (singleClass ifTrue:[ 'Class to browse' ] ifFalse:[ 'Class(es) to browse' ]).
- boxLabel := (resources string:'Browse or Search').
-
- (doWhat isNil and:[canFind not]) ifTrue:[
- doWhat := #newBuffer.
- ].
-
- doWhat == #newBrowser ifTrue:[
- okText := 'Open'.
- okText2 := 'Add Buffer'. doWhat2 := #newBuffer.
- okText3 := 'Find'. doWhat3 := nil.
- ] ifFalse:[ doWhat == #newBuffer ifTrue:[
- okText := 'Add Buffer'.
- okText2 := 'Open New'. doWhat2 := #newBrowser.
- okText3 := 'Find'. doWhat3 := nil.
- ] ifFalse:[
- title := (singleClass ifTrue:[ 'Class to find' ] ifFalse:[ 'Class(es) to find' ]).
- okText := 'Find'.
- okText2 := 'Open New'. doWhat2 := #newBrowser.
- okText3 := 'Add Buffer'. doWhat3 := #newBuffer.
- ]].
+ title := ''.
+ boxLabel := (resources string:'Select a class').
+ okText := 'OK'.
+ okText2 := nil. doWhat2 := nil.
+ okText3 := nil. doWhat3 := nil.
+ ] ifFalse:[
+ title := (singleClass ifTrue:[ 'Class to browse' ] ifFalse:[ 'Class(es) to browse' ]).
+ boxLabel := (resources string:'Browse or Search').
+
+ (doWhat isNil and:[canFind not]) ifTrue:[
+ doWhat := #newBuffer.
+ ].
+
+ doWhat == #newBrowser ifTrue:[
+ okText := 'Open'.
+ okText2 := 'Add Buffer'. doWhat2 := #newBuffer.
+ okText3 := 'Find'. doWhat3 := nil.
+ ] ifFalse:[ doWhat == #newBuffer ifTrue:[
+ okText := 'Add Buffer'.
+ okText2 := 'Open New'. doWhat2 := #newBrowser.
+ okText3 := 'Find'. doWhat3 := nil.
+ ] ifFalse:[
+ title := (singleClass ifTrue:[ 'Class to find' ] ifFalse:[ 'Class(es) to find' ]).
+ okText := 'Find'.
+ okText2 := 'Open New'. doWhat2 := #newBrowser.
+ okText3 := 'Add Buffer'. doWhat3 := #newBuffer.
+ ]].
].
genShortNameListEntry :=
- [:cls |
- |ns|
-
- cls isNil ifTrue:[
- nil
- ] ifFalse:[
- ns := cls topNameSpace name.
- ns = 'Smalltalk'
- ifTrue:[ ns := '' ]
- ifFalse:[ns := ' (in ',ns,')'].
- cls nameWithoutNameSpacePrefix,ns
- ].
- ].
+ [: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
- select: (filterOrNil ? [:cls | true])
- thenCollect:[:each | each theNonMetaclass name].
+ select: (filterOrNil ? [:cls | true])
+ thenCollect:[:each | each theNonMetaclass name].
initialFullNames := self visitedClassNamesHistory.
(filterOrNil notNil) ifTrue:[
- initialFullNames := initialFullNames select:[:nm | filterOrNil value:(Smalltalk at:nm)].
+ initialFullNames := initialFullNames select:[:nm | filterOrNil value:(Smalltalk at:nm)].
].
initialFullNames := initialFullNames select:[:nm | nm notNil].
- initialShortNames := initialFullNames collect:[:nm |
- |cls|
-
- cls := Smalltalk at:nm.
- cls isNil ifTrue:[
- "/ class no longer exists (removed?)
- nm colorizeAllWith:(Color grey)
- ] ifFalse:[
- genShortNameListEntry value:(Smalltalk at:nm)
- ].
- ].
-
- 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
- ].
- ].
+ initialShortNames := initialFullNames collect:[:nm |
+ |cls|
+
+ cls := Smalltalk at:nm.
+ cls isNil ifTrue:[
+ "/ class no longer exists (removed?)
+ nm colorizeAllWith:(Color grey)
+ ] ifFalse:[
+ genShortNameListEntry value:(Smalltalk at:nm)
+ ].
+ ].
+
+ 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 - "*" for all):').
box := self
- enterBoxForClassWithCodeSelectionTitle:title withCRs
- withList:(showFullNameHolder value ifTrue:[colorizedFullNames] ifFalse:[colorizedShortNames])
- okText:okText
- forBrowser:aBrowserOrNil.
+ enterBoxForClassWithCodeSelectionTitle:title withCRs
+ withList:(showFullNameHolder value ifTrue:[colorizedFullNames] ifFalse:[colorizedShortNames])
+ okText:okText
+ forBrowser:aBrowserOrNil.
box label:boxLabel.
doWhat notNil ifTrue:[
- button2 := Button label:(resources string:okText2).
- (aBrowserOrNil notNil and:[aBrowserOrNil navigationState isFullBrowser]) "singleClass" ifTrue:[
- button3 := Button label:(resources string:okText3)
- ].
- box addButton:button2 after:(box okButton).
- button3 notNil ifTrue:[box addButton:button3 after:button2].
-
- button2 action:[
- doWhat := doWhat2.
- box doAccept.
- box okPressed.
- ].
- button3 notNil ifTrue:[
- button3 action:[
- doWhat := doWhat3.
- box doAccept.
- box okPressed.
- ].
- ].
+ button2 := Button label:(resources string:okText2).
+ (aBrowserOrNil notNil and:[aBrowserOrNil navigationState isFullBrowser]) "singleClass" ifTrue:[
+ button3 := Button label:(resources string:okText3)
+ ].
+ box addButton:button2 after:(box okButton).
+ button3 notNil ifTrue:[box addButton:button3 after:button2].
+
+ button2 action:[
+ doWhat := doWhat2.
+ box doAccept.
+ box okPressed.
+ ].
+ button3 notNil ifTrue:[
+ button3 action:[
+ doWhat := doWhat3.
+ box doAccept.
+ box okPressed.
+ ].
+ ].
].
allClasses := Smalltalk allClasses copyAsOrderedCollection.
filterOrNil notNil ifTrue:[
- allClasses := allClasses select: filterOrNil
+ allClasses := allClasses select: filterOrNil
].
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.
+ 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)
- ].
+ |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.
+ 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.
+ 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 enterField
- onKey:#CursorDown
- leaveWith:[
- box listView windowGroup focusView:box listView byTab:true.
- box listView hasSelection ifFalse:[
- box listView selectFirst
- ] ifTrue:[
- box listView selectNext
- ].
- ].
+ box enterField
+ onKey:#CursorDown
+ leaveWith:[
+ box listView windowGroup focusView:box listView byTab:true.
+ box listView hasSelection ifFalse:[
+ box listView selectFirst
+ ] ifTrue:[
+ box listView selectNext
+ ].
+ ].
box listView origin:(0 @ check corner y).
box extent:(400 @ 350).
@@ -18096,23 +18096,23 @@
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
- ].
+ (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
+ ].
].
(doWhat isNil or:[aBrowserOrNil isNil]) ifTrue:[
- aBlock notNil ifTrue:[aBlock value:className optionalArgument:singleClass and:doWhat].
- ^ className
+ aBlock notNil ifTrue:[aBlock value:className optionalArgument:singleClass and:doWhat].
+ ^ className
].
aBrowserOrNil withSearchCursorDo:[
- aBlock value:className value:singleClass value:doWhat.
+ aBlock value:className value:singleClass value:doWhat.
].
^ className
@@ -19021,8 +19021,6 @@
"Created: / 24.2.2000 / 23:28:06 / cg"
! !
-
-
!NewSystemBrowser methodsFor:'aspects-organization'!
categoryMenuVisible
@@ -22718,7 +22716,6 @@
^ UserPreferences current useSearchBarInBrowser or:[self codeView searchBarActionBlock notNil]
! !
-
!NewSystemBrowser methodsFor:'change & update'!
categorySelectionChanged
@@ -22918,100 +22915,100 @@
self enqueueDelayedUpdateBufferLabel.
navigationState isClassDocumentationBrowser ifTrue:[
- "/ show classes documentation
- self showClassDocumentation.
- ^ self.
+ "/ show classes documentation
+ self showClassDocumentation.
+ ^ self.
].
navigationState isVersionDiffBrowser ifTrue:[
- "/ show version differences
- self showVersionDiff.
- ^ self.
+ "/ show version differences
+ self showVersionDiff.
+ ^ self.
].
codeView := self codeView.
checkModified ifTrue:[
- ((codeView notNil and:[codeView modified])
- or:[navigationState modified])
- ifTrue:[
- "/ recheck against the code (could have been unedited)
- (self reallyModified:navigationState) ifTrue:[
- "/ do not overwrite the user's modifications;
- "/ instead, flash and show the code all-red
- "/ (to tell user, that she is possibly editing obsolete code)
+ ((codeView notNil and:[codeView modified])
+ or:[navigationState modified])
+ ifTrue:[
+ "/ recheck against the code (could have been unedited)
+ (self reallyModified:navigationState) ifTrue:[
+ "/ do not overwrite the user's modifications;
+ "/ instead, flash and show the code all-red
+ "/ (to tell user, that she is possibly editing obsolete code)
"/ self codeHolder
"/ value:(codeView contentsAsString asText
"/ emphasizeAllWith:(UserPreferences current emphasisForObsoleteCode)).
"/ self codeHolder changed:#value.
- codeView flash.
- ^ self.
- ]
- ].
+ codeView flash.
+ ^ self.
+ ]
+ ].
].
navigationState isFullClassSourceBrowser ifTrue:[
- "/ show full classes source - set accept action for fileIn
- self showFullClassSource.
- ^ self.
+ "/ show full classes source - set accept action for fileIn
+ self showFullClassSource.
+ ^ self.
].
"/ show method, or class definition
methods := self selectedMethodsValue.
methods size == 1 ifTrue:[
- mthd := methods first.
+ mthd := methods first.
].
mthd notNil ifTrue:[
- "/ show methods source - set accept action to compile that single method
- self setAcceptActionForMethod.
- self showMethodsCode:mthd.
-
- "/ if there is a variable filter,
- "/ set the autoSearch for it
- (navigationState isMethodListBrowser
- or:[navigationState isFullProtocolBrowser
- or:[navigationState isMethodBrowser]]) ifFalse:[
- filteredVariables := self variableFilter value.
- filteredVariables size > 0 ifTrue:[
- self searchVariables:filteredVariables readers:true writers:true asAutoSearch:false.
- "/ codeView notNil ifTrue:[codeView searchFwd]
- ] ifFalse:[
- self autoSearchPattern:nil
- ].
- ].
- ] ifFalse:[
- self updatePackageInfoForMethod:nil.
-
- protocol := self theSingleSelectedProtocol.
- (protocol isNil or:[protocol = BrowserList nameListEntryForALL]) ifTrue:[
- doShowMethodTemplate := false
- ] ifFalse:[
- navigationState showMethodTemplate ifTrue:[
- doShowMethodTemplate := self showMethodTemplate value
+ "/ show methods source - set accept action to compile that single method
+ self setAcceptActionForMethod.
+ self showMethodsCode:mthd.
+
+ "/ if there is a variable filter,
+ "/ set the autoSearch for it
+ (navigationState isMethodListBrowser
+ or:[navigationState isFullProtocolBrowser
+ or:[navigationState isMethodBrowser]]) ifFalse:[
+ filteredVariables := self variableFilter value.
+ filteredVariables size > 0 ifTrue:[
+ self searchVariables:filteredVariables readers:true writers:true asAutoSearch:false.
+ "/ codeView notNil ifTrue:[codeView searchFwd]
+ ] ifFalse:[
+ self autoSearchPattern:nil
+ ].
+ ].
+ ] ifFalse:[
+ self updatePackageInfoForMethod:nil.
+
+ protocol := self theSingleSelectedProtocol.
+ (protocol isNil or:[protocol = BrowserList nameListEntryForALL]) ifTrue:[
+ doShowMethodTemplate := false
+ ] ifFalse:[
+ navigationState showMethodTemplate ifTrue:[
+ doShowMethodTemplate := self showMethodTemplate value
"/ and:[ShowMethodTemplateWhenProtocolIsSelected == true
"/ or:[ navigationState methodList size == 0 ]].
- ]
- ].
- doShowMethodTemplate ifTrue:[
- methods size > 1 ifTrue:[
- code := nil.
- ] ifFalse:[
- code := self methodTemplate.
- ].
- self setAcceptActionForMethod.
- self codeAspect:SyntaxHighlighter codeAspectMethod.
- self showCode:code.
- ] ifFalse:[
- self hasProtocolSelected ifTrue:[
- self showCode:''.
- self setAcceptActionForMethod.
- self codeAspect:SyntaxHighlighter codeAspectMethod.
- ] ifFalse:[
- selectedClass := self theSingleSelectedClass.
- selectedClass notNil ifTrue:[
- self showClassAspect:(self codeAspect) forClass:selectedClass.
- ] ifFalse:[
+ ]
+ ].
+ doShowMethodTemplate ifTrue:[
+ methods size > 1 ifTrue:[
+ code := nil.
+ ] ifFalse:[
+ code := self methodTemplate.
+ ].
+ self setAcceptActionForMethod.
+ self codeAspect:SyntaxHighlighter codeAspectMethod.
+ self showCode:code.
+ ] ifFalse:[
+ self hasProtocolSelected ifTrue:[
+ self showCode:''.
+ self setAcceptActionForMethod.
+ self codeAspect:SyntaxHighlighter codeAspectMethod.
+ ] ifFalse:[
+ selectedClass := self theSingleSelectedClass.
+ selectedClass notNil ifTrue:[
+ self showClassAspect:(self codeAspect) forClass:selectedClass.
+ ] ifFalse:[
"/ self organizerMode value == OrganizerCanvas organizerModeProject ifTrue:[
"/ package := self theSingleSelectedProject.
"/ package notNil ifTrue:[
@@ -23023,54 +23020,54 @@
"/ self showCode:code ? ''.
"/ self setAcceptActionForProjectComment.
"/ ] ifFalse:[
- self showCode:code ? ''.
- self setAcceptActionForClass.
+ self showCode:code ? ''.
+ self setAcceptActionForClass.
"/ ]
- ]
- ]
- ]
+ ]
+ ]
+ ]
].
self updateSpecialCodeEditorVisibility.
codeView notNil ifTrue:[
- "/ perform an auto-search, unless the user did some other search
- "/ in the meanwhile (i.e. the codeViews searchPattern is different from the autoSearchPattern)
- withAutoSearch ifTrue:[
- codeView numberOfLines > 0 ifTrue:[
- searchAction := navigationState autoSearchAction.
- searchAction notNil ifTrue:[
- true "codeView searchAction isNil" ifTrue:[
- true "codeView searchPattern isNil" ifTrue:[
- codeView
- cursorHome;
- searchAction:searchAction;
- searchUsingSearchAction:#forward ifAbsent:nil.
-
- "/ The searchAction is mantained until a cut/replace or a search with a user selection is done
+ "/ perform an auto-search, unless the user did some other search
+ "/ in the meanwhile (i.e. the codeViews searchPattern is different from the autoSearchPattern)
+ withAutoSearch ifTrue:[
+ codeView numberOfLines > 0 ifTrue:[
+ searchAction := navigationState autoSearchAction.
+ searchAction notNil ifTrue:[
+ true "codeView searchAction isNil" ifTrue:[
+ true "codeView searchPattern isNil" ifTrue:[
+ codeView
+ cursorHome;
+ searchAction:searchAction;
+ searchUsingSearchAction:#forward ifAbsent:nil.
+
+ "/ The searchAction is mantained until a cut/replace or a search with a user selection is done
"/ codeView clearSearchAction.
- ]
+ ]
"/ ] ifFalse:[
"/ codeView
"/ cursorHome;
"/ searchUsingSearchAction:#forward ifAbsent:nil
- ].
- ] ifFalse:[
- searchPattern := navigationState autoSearchPattern.
- searchPattern notNil ifTrue:[
- searchPattern = codeView searchPattern ifTrue:[
- codeView
- cursorHome;
- cursorRight; "/ to avoid finding the selector
- searchFwd:searchPattern
- ignoreCase:(navigationState autoSearchIgnoreCase)
- ifAbsent:[codeView cursorHome].
- ].
- ].
- ].
- ].
- ] ifFalse:[
- codeView clearSearchAction.
- ].
+ ].
+ ] ifFalse:[
+ searchPattern := navigationState autoSearchPattern.
+ searchPattern notNil ifTrue:[
+ searchPattern = codeView searchPattern ifTrue:[
+ codeView
+ cursorHome;
+ cursorRight; "/ to avoid finding the selector
+ searchFwd:searchPattern
+ ignoreCase:(navigationState autoSearchIgnoreCase)
+ ifAbsent:[codeView cursorHome].
+ ].
+ ].
+ ].
+ ].
+ ] ifFalse:[
+ codeView clearSearchAction.
+ ].
].
navigationState modified:false.
@@ -31993,38 +31990,38 @@
classesToRemove size == 0 ifTrue:[^ self].
self withWaitCursorDo:[
- self canUseRefactoringSupport ifFalse:[
- classesToRemove do:[:each |
- each removeFromSystem.
- ].
- ^ self.
- ].
-
- pullUpSubclasses ifTrue:[
- classesToRemove do:[:eachClass |
- self performRefactoring:(RemoveClassRefactoring className:eachClass name).
- ]
- ] ifFalse:[
- numClasses := classesToRemove size.
- numClasses > 1 ifTrue:[
- numClasses == 2 ifTrue:[
- nm := 'Remove ', classesToRemove first theNonMetaclass name , ' and ' , classesToRemove second theNonMetaclass name
- ] ifFalse:[
- nm := 'Remove ', numClasses printString , ' classes'
- ]
- ] ifFalse:[
- nm := 'Remove ', classesToRemove first theNonMetaclass name
- ].
- change := CompositeRefactoryChange named:nm.
- classesToRemove do:[:eachClass |
- eachClass programmingLanguage isSmalltalk ifTrue:[
- change removeClass:eachClass
- ] ifFalse:[
- eachClass removeFromSystem.
- ]
- ].
- RefactoryChangeManager performChange:change
- ]
+ self canUseRefactoringSupport ifFalse:[
+ classesToRemove do:[:each |
+ each removeFromSystem.
+ ].
+ ^ self.
+ ].
+
+ pullUpSubclasses ifTrue:[
+ classesToRemove do:[:eachClass |
+ self performRefactoring:(RemoveClassRefactoring className:eachClass name).
+ ]
+ ] ifFalse:[
+ numClasses := classesToRemove size.
+ numClasses > 1 ifTrue:[
+ numClasses == 2 ifTrue:[
+ nm := 'Remove ', classesToRemove first theNonMetaclass name , ' and ' , classesToRemove second theNonMetaclass name
+ ] ifFalse:[
+ nm := 'Remove ', numClasses printString , ' classes'
+ ]
+ ] ifFalse:[
+ nm := 'Remove ', classesToRemove first theNonMetaclass name
+ ].
+ change := CompositeRefactoryChange named:nm.
+ classesToRemove do:[:eachClass |
+ eachClass programmingLanguage isSmalltalk ifTrue:[
+ change removeClass:eachClass
+ ] ifFalse:[
+ eachClass removeFromSystem.
+ ]
+ ].
+ RefactoryChangeManager performChange:change
+ ]
]
"Modified: / 11-09-2013 / 04:38:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -33514,12 +33511,9 @@
!
classMenuCheckInExtensions
- "check a classes extensions into the source repository (with checks)"
-
- |doChecks|
-
- doChecks := (UserPreferences current at:#checkClassesWhenCheckingIn ifAbsent:true).
- ^ self classMenuCheckInExtensions:doChecks
+ "check a classes extensions into the source repository"
+
+ ^ self classMenuCheckInExtensionsUsingManager:nil
!
classMenuCheckInExtensions:doCheck
@@ -33567,6 +33561,48 @@
"Modified: / 08-09-2011 / 04:07:58 / cg"
!
+classMenuCheckInExtensionsFor:aProjectID usingManager:manager
+ "check some of a classes extensions into the source repository."
+
+ (self askIfModified:'Code was modified.\\CheckIn (without that modification) anyway ?')
+ ifFalse:[^ self].
+ self withWaitCursorDo:[
+ self
+ projectMenuCheckInProject:aProjectID
+ classes:false
+ extensions:true
+ buildSupport:false
+ askForMethodsInOtherPackages:false
+ usingManager:manager.
+ ]
+
+ "Modified: / 08-09-2011 / 04:07:58 / cg"
+!
+
+classMenuCheckInExtensionsUsingManager:managerOrNil
+ "check a classes extensions into the source repository.
+ "
+
+ |projects|
+
+ (self askIfModified:'Code was modified.\\CheckIn (without that modification) anyway ?')
+ ifFalse:[^ self].
+
+ projects := Set new.
+ self selectedClassesDo:[:eachClass |
+ eachClass instAndClassSelectorsAndMethodsDo:[:sel :mthd | projects add:mthd package].
+ ].
+ projects do:[:eachProject |
+ self
+ projectMenuCheckInProject:eachProject
+ classes:false
+ extensions:true
+ buildSupport:false
+ askForMethodsInOtherPackages:false
+ usingManager:managerOrNil.
+ ].
+!
+
classMenuCheckInP4
"check a class into the source repository (with checks)"
@@ -33639,15 +33675,17 @@
"Created: / 21-12-2011 / 20:16:21 / cg"
!
-classMenuCheckOutNewestUsingManagerNamed: managerName
+classMenuCheckOutNewestUsingManagerNamed: sourceCodeManagerClassName
"check-out the newest version of the selected class(es) from the source repository.
Offer chance to either overwrite the current version,
or merge-in the repository version.
"
- ^self classMenuCheckOutNewestUsingManager: (Smalltalk at:managerName asSymbol)
-
- "Created: / 02-02-2012 / 10:52:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ |mgr|
+
+ mgr := Smalltalk at:sourceCodeManagerClassName asSymbol.
+ self assert:(mgr notNil).
+ self classMenuCheckOutNewestUsingManager: mgr
!
classMenuCheckOutUsingManager: manager
@@ -33663,6 +33701,20 @@
"Created: / 21-12-2011 / 20:16:41 / cg"
!
+classMenuCheckOutUsingManagerNamed: sourceCodeManagerClassName
+ "check-out selected class(es) from the source repository.
+ Individually ask for class revisions.
+ Offer chance to either overwrite the current version,
+ or merge-in the repository version.
+ "
+
+ |mgr|
+
+ mgr := Smalltalk at:sourceCodeManagerClassName asSymbol.
+ self assert:(mgr notNil).
+ self classMenuCheckOutUsingManager: mgr
+!
+
classMenuCompareAgainstNewestInRepository
"open a diff-textView comparing the current (in-image) version
with the the newest version found in the repository.
@@ -33804,6 +33856,17 @@
self classMenuCompareAgainstVersionInRepository:rev usingManager: manager
!
+classMenuCompareAgainstStableInRepositoryUsingManagerNamed: sourceCodeManagerClassName
+ "open a diff-textView comparing the current (in-image) version
+ with the stable version found in the repository."
+
+ |mgr|
+
+ mgr := Smalltalk at:sourceCodeManagerClassName asSymbol.
+ self assert:(mgr notNil).
+ self classMenuCheckOutUsingManager: mgr
+!
+
classMenuCompareAgainstVersionInRepository:rev usingManager: manager
"open a diff-textView comparing the current (in-image) version
with a version found in the repository.
@@ -34068,6 +34131,12 @@
"Created: / 21-12-2011 / 20:28:28 / cg"
!
+classMenuCompareExtensionsWithRepositoryUsingManagerNamed: aManager
+ ^ Dialog warn: 'Not yet implemented'
+
+ "Created: / 21-12-2011 / 20:28:28 / cg"
+!
+
classMenuCompareTwoRepositoryVersions
"open a diff-textView comparing two versions found in the repository."
@@ -34645,34 +34714,34 @@
"/ find the highest numbered patchfile
'stxPatches' asFilename directoryContentsDo:[:fn |
- (fn includes:$_) ifTrue:[
- nrString := fn upTo:$_.
- nr := Integer readFrom:nrString onError:nil.
- nr notNil ifTrue:[
- nr > (highest ? -1) ifTrue:[
- highest := nr.
- highestString := nrString.
- ]
- ].
- ].
+ (fn includes:$_) ifTrue:[
+ nrString := fn upTo:$_.
+ nr := Integer readFrom:nrString onError:nil.
+ nr notNil ifTrue:[
+ nr > (highest ? -1) ifTrue:[
+ highest := nr.
+ highestString := nrString.
+ ]
+ ].
+ ].
].
highest isNil ifTrue:[
- fileNamePrefix := '01'
- ] ifFalse:[
- fileNamePrefix := (highest+1) printStringLeftPaddedTo:(highestString size) with:$0.
+ fileNamePrefix := '01'
+ ] ifFalse:[
+ fileNamePrefix := (highest+1) printStringLeftPaddedTo:(highestString size) with:$0.
].
changedClassesAndMetaclasses := diffSet changedClasses.
changedClasses := changedClassesAndMetaclasses collect:[:clsOrMeta | clsOrMeta theNonMetaclass].
- changedOwningClasses := changedClasses collect:[:each | each isPrivate
- ifTrue:[ each owningClass ]
- ifFalse:[ each ]] as:Set.
+ changedOwningClasses := changedClasses collect:[:each | each isPrivate
+ ifTrue:[ each owningClass ]
+ ifFalse:[ each ]] as:Set.
changedOwningClasses := changedOwningClasses asOrderedCollection.
changedOwningClasses size == 1 ifTrue:[
- fileNameMiddle := changedOwningClasses first nameWithoutPrefix
- ] ifFalse:[
- fileNameMiddle := 'patches'
+ fileNameMiddle := changedOwningClasses first nameWithoutPrefix
+ ] ifFalse:[
+ fileNameMiddle := 'patches'
].
fileNameMiddle := fileNameMiddle asFilename makeLegalFilename name.
fileName := (fileNamePrefix,'_',fileNameMiddle,'.st') asFilename.
@@ -34683,24 +34752,24 @@
tempStream nextPutLine:('"/ first, a guard, to ignore the patch if the library already contains an up-to-date class:').
tempStream nextPutLine:('"/').
changedOwningClasses do:[:eachClass |
- tempStream nextPutLine:('(AbstractSourceCodeManager isRevision:(%2 revision) sameOrAfter:''%1'') ifTrue:[ AbortSignal raiseErrorString:''patch is for older version'' ].'
- bindWith:eachClass revision
- with:eachClass name).
+ tempStream nextPutLine:('(AbstractSourceCodeManager isRevision:(%2 revision) sameOrAfter:''%1'') ifTrue:[ AbortSignal raiseErrorString:''patch is for older version'' ].'
+ bindWith:eachClass revision
+ with:eachClass name).
].
tempStream nextPutChunkSeparator; cr; cr.
changeSet := ChangeSet fromDiffSet:diffSet.
changeSet fileOutOn:tempStream.
tempStream syncData; close.
-
+
generatedPatchFilename := ('stxPatches' asFilename construct:fileName).
tempStream fileName renameTo:generatedPatchFilename.
- (Dialog
- confirm:('Created new patchFile as: "%1"' bindWith:generatedPatchFilename name)
- yesLabel:'Show' noLabel:'OK')
+ (Dialog
+ confirm:('Created new patchFile as: "%1"' bindWith:generatedPatchFilename name)
+ yesLabel:'Show' noLabel:'OK')
ifTrue:[
- UserPreferences fileBrowserClass openOn:generatedPatchFilename
+ UserPreferences fileBrowserClass openOn:generatedPatchFilename
].
"Created: / 26-09-2012 / 15:13:07 / cg"
@@ -38127,7 +38196,6 @@
HTMLDocumentView openFullOnDocumentationFile:'TOP.html'
! !
-
!NewSystemBrowser methodsFor:'menu actions-inheritance'!
inheritanceMenuNavigateToClass
@@ -44710,198 +44778,198 @@
mselector := method selector.
className := mclass name.
[
- |set|
-
- set := ChangeSet forExistingMethods:(Array with:method).
- set := set select:[:c | c isMethodChange].
- lastChange := set first.
+ |set|
+
+ set := ChangeSet forExistingMethods:(Array with:method).
+ set := set select:[:c | c isMethodChange].
+ lastChange := set first.
] value.
thisIsAnExtensionMethod := (method isExtension).
thisIsAnExtensionMethod ifTrue:[
- packageId := method package asPackageId.
- mgr := manager
- ] ifFalse:[
- packageId := mclass package asPackageId.
- "/ mgr := packageId projectDefinitionClass sourceCodeManager.
- mgr := manager.
- "/self assert:(mgr = packageId projectDefinitionClass sourceCodeManager).
+ packageId := method package asPackageId.
+ mgr := manager
+ ] ifFalse:[
+ packageId := mclass package asPackageId.
+ "/ mgr := packageId projectDefinitionClass sourceCodeManager.
+ mgr := manager.
+ "/self assert:(mgr = packageId projectDefinitionClass sourceCodeManager).
].
directory := packageId directory.
module := packageId module.
self withWaitCursorDo:[
- |revisionLog start stop answer t tS list msg first|
-
- thisIsAnExtensionMethod ifTrue:[
- revisionLog := mgr
- revisionLogOf:nil
- fromRevision:nil
- toRevision:nil
- numberOfRevisions:nil
- fileName:'extensions.st'
- directory:directory
- module:module.
- ] ifFalse:[
- revisionLog := mgr revisionLogOf:mclass.
- ].
- revisions := revisionLog at:#revisions.
-
- start := 1.
- stop := revisions size.
- stop > 20 ifTrue:[
- thisIsAnExtensionMethod ifTrue:[
- t := 500. "/ fake time
- ] ifFalse:[
- "/ measure the time it takes to checkout a version...
- t := Time millisecondsToRun:[
- |revSourceStream|
-
- revSourceStream := mgr getSourceStreamFor:mclass revision:((revisions at:10) at:#revision).
- ChangeSet fromStream:revSourceStream.
- revSourceStream close.
- ].
- ].
-
- list := revisions collect:[:entry |
- |rev author dateString date msg|
-
- rev := entry at:#revision.
- author := entry at:#author.
- dateString := entry at:#date.
- date := Timestamp readGeneralizedFrom:dateString.
- dateString := date printStringFormat:'%(year)-%(mon)-%(day) %h:%m:%s'.
- entry at:#date put:dateString.
- msg := ((entry at:#logMessage) asStringCollection firstIfEmpty:'') asString.
- rev,' ',author,' ',dateString,' ',msg
- ].
- msg := 'There are %1 revisions to extract from the repository'.
- t := (t * revisions size / 1000) rounded.
- t < 10 ifTrue:[
- msg := msg,'\(this will take a few seconds).'.
- tS := t.
- ] ifFalse:[
- t := t * revisions size // 1000 // 10 * 10.
- tS := (TimeDuration fromSeconds:t) printStringForApproximation.
- msg := msg,'\(this will take roughly %2).'
- ].
- msg := msg,'\\Do you want to see all or only some of the revisions ?'.
-
- answer := Dialog
- choose:(resources stringWithCRs:msg
- with:revisions size
- with:tS)
- fromList:list values:revisions initialSelection:nil
- buttons:nil
- values:nil
- default:nil
- lines:20
- cancel:[^ self]
- multiple:false
- title:(resources string:'Confirmation')
- postBuildBlock:[:dialog |
- |b|
-
- b := Button label:(resources string:'Browse Newer than Selected').
- b action:[ stop := (dialog componentAt:#ListView) selection. dialog okPressed].
- b := dialog addButton:b before:dialog okButton.
-
- dialog okButton label:(resources string:'Browse All').
- dialog okButton action:[ stop := revisions size. dialog okPressed].
- ].
-
- stop isNil ifTrue:[^ self ].
- ].
+ |revisionLog start stop answer t tS list msg first|
+
+ thisIsAnExtensionMethod ifTrue:[
+ revisionLog := mgr
+ revisionLogOf:nil
+ fromRevision:nil
+ toRevision:nil
+ numberOfRevisions:nil
+ fileName:'extensions.st'
+ directory:directory
+ module:module.
+ ] ifFalse:[
+ revisionLog := mgr revisionLogOf:mclass.
+ ].
+ revisions := revisionLog at:#revisions.
+
+ start := 1.
+ stop := revisions size.
+ stop > 20 ifTrue:[
+ thisIsAnExtensionMethod ifTrue:[
+ t := 500. "/ fake time
+ ] ifFalse:[
+ "/ measure the time it takes to checkout a version...
+ t := Time millisecondsToRun:[
+ |revSourceStream|
+
+ revSourceStream := mgr getSourceStreamFor:mclass revision:((revisions at:10) at:#revision).
+ ChangeSet fromStream:revSourceStream.
+ revSourceStream close.
+ ].
+ ].
+
+ list := revisions collect:[:entry |
+ |rev author dateString date msg|
+
+ rev := entry at:#revision.
+ author := entry at:#author.
+ dateString := entry at:#date.
+ date := Timestamp readGeneralizedFrom:dateString.
+ dateString := date printStringFormat:'%(year)-%(mon)-%(day) %h:%m:%s'.
+ entry at:#date put:dateString.
+ msg := ((entry at:#logMessage) asStringCollection firstIfEmpty:'') asString.
+ rev,' ',author,' ',dateString,' ',msg
+ ].
+ msg := 'There are %1 revisions to extract from the repository'.
+ t := (t * revisions size / 1000) rounded.
+ t < 10 ifTrue:[
+ msg := msg,'\(this will take a few seconds).'.
+ tS := t.
+ ] ifFalse:[
+ t := t * revisions size // 1000 // 10 * 10.
+ tS := (TimeDuration fromSeconds:t) printStringForApproximation.
+ msg := msg,'\(this will take roughly %2).'
+ ].
+ msg := msg,'\\Do you want to see all or only some of the revisions ?'.
+
+ answer := Dialog
+ choose:(resources stringWithCRs:msg
+ with:revisions size
+ with:tS)
+ fromList:list values:revisions initialSelection:nil
+ buttons:nil
+ values:nil
+ default:nil
+ lines:20
+ cancel:[^ self]
+ multiple:false
+ title:(resources string:'Confirmation')
+ postBuildBlock:[:dialog |
+ |b|
+
+ b := Button label:(resources string:'Browse Newer than Selected').
+ b action:[ stop := (dialog componentAt:#ListView) selection. dialog okPressed].
+ b := dialog addButton:b before:dialog okButton.
+
+ dialog okButton label:(resources string:'Browse All').
+ dialog okButton action:[ stop := revisions size. dialog okPressed].
+ ].
+
+ stop isNil ifTrue:[^ self ].
+ ].
t := Time millisecondsToRun:[
- previousMethods := ChangeSet new.
- lastSource := currentSource := method source.
- lastRevision := lastDate := nil.
- first := true.
-
- revisions from:start to:stop do:[:eachLogEntry |
- |revision date revSourceStream|
-
- revision := eachLogEntry at:#revision.
- date := eachLogEntry at:#date.
-
- [
- |chg nChg classChangeSet changeSource changeName|
-
- self activityNotification:('Fetching revision ',revision,'...').
- thisIsAnExtensionMethod ifTrue:[
- revSourceStream := mgr
- streamForClass:nil
- fileName:'extensions.st'
- revision:revision
- directory:directory
- module:module
- cache:true.
- ] ifFalse:[
- revSourceStream := mgr getSourceStreamFor:mclass revision:revision.
- ].
- revSourceStream isNil ifTrue:[
- self warn:'could not load source for ' , mclass name , ' revision ', revision, ' from repository'.
- chg := nil.
- ] ifFalse:[
- classChangeSet := ChangeSet fromStream:revSourceStream.
-
- chg := classChangeSet
- detect:[:chg | chg isMethodChange
- and:[chg selector = mselector
- and:[chg className = className]]]
- ifNone:nil.
- ].
-
- chg isNil ifTrue:[
- "the method was created in the next version (previous one processed)"
- ] ifFalse:[
- changeSource := chg source.
- ].
- ((changeSource isNil and:[lastSource isNil])
- or:[ changeSource asString = lastSource asString ]) ifTrue:[
- ] ifFalse:[
- lastChange isNil ifTrue:[
- "/ mhm - was not in the previous version
- ] ifFalse:[
- nChg := lastChange asNamedMethodChange
- ].
- lastRevision isNil ifTrue:[
- (stop = revisions size) ifTrue:[
- changeName := 'current (not in the repository)'.
- ] ifFalse:[
- "/ not showing all - dont really know
- changeName := 'current'.
- ].
- ] ifFalse:[
- changeName := lastRevision,' [',lastDate,']'.
- first ifTrue:[
- changeName := changeName,' (= current)'.
- ]
- ].
- nChg notNil ifTrue:[
- nChg changeName:changeName.
- previousMethods add:nChg.
- ].
- lastSource := changeSource.
- lastChange := chg.
-
- first := false.
- ].
- lastRevision := revision.
- lastDate := date.
- ] ensure:[
- revSourceStream notNil ifTrue:[revSourceStream close].
- ].
- ].
+ previousMethods := ChangeSet new.
+ lastSource := currentSource := method source.
+ lastRevision := lastDate := nil.
+ first := true.
+
+ revisions from:start to:stop do:[:eachLogEntry |
+ |revision date revSourceStream|
+
+ revision := eachLogEntry at:#revision.
+ date := eachLogEntry at:#date.
+
+ [
+ |chg nChg classChangeSet changeSource changeName|
+
+ self activityNotification:('Fetching revision ',revision,'...').
+ thisIsAnExtensionMethod ifTrue:[
+ revSourceStream := mgr
+ streamForClass:nil
+ fileName:'extensions.st'
+ revision:revision
+ directory:directory
+ module:module
+ cache:true.
+ ] ifFalse:[
+ revSourceStream := mgr getSourceStreamFor:mclass revision:revision.
+ ].
+ revSourceStream isNil ifTrue:[
+ self warn:'could not load source for ' , mclass name , ' revision ', revision, ' from repository'.
+ chg := nil.
+ ] ifFalse:[
+ classChangeSet := ChangeSet fromStream:revSourceStream.
+
+ chg := classChangeSet
+ detect:[:chg | chg isMethodChange
+ and:[chg selector = mselector
+ and:[chg className = className]]]
+ ifNone:nil.
+ ].
+
+ chg isNil ifTrue:[
+ "the method was created in the next version (previous one processed)"
+ ] ifFalse:[
+ changeSource := chg source.
+ ].
+ ((changeSource isNil and:[lastSource isNil])
+ or:[ changeSource asString = lastSource asString ]) ifTrue:[
+ ] ifFalse:[
+ lastChange isNil ifTrue:[
+ "/ mhm - was not in the previous version
+ ] ifFalse:[
+ nChg := lastChange asNamedMethodChange
+ ].
+ lastRevision isNil ifTrue:[
+ (stop = revisions size) ifTrue:[
+ changeName := 'current (not in the repository)'.
+ ] ifFalse:[
+ "/ not showing all - dont really know
+ changeName := 'current'.
+ ].
+ ] ifFalse:[
+ changeName := lastRevision,' [',lastDate,']'.
+ first ifTrue:[
+ changeName := changeName,' (= current)'.
+ ]
+ ].
+ nChg notNil ifTrue:[
+ nChg changeName:changeName.
+ previousMethods add:nChg.
+ ].
+ lastSource := changeSource.
+ lastChange := chg.
+
+ first := false.
+ ].
+ lastRevision := revision.
+ lastDate := date.
+ ] ensure:[
+ revSourceStream notNil ifTrue:[revSourceStream close].
+ ].
+ ].
].
"/ Transcript showCR:('it took %1 seconds' bindWith:(t /1000)printString).
- self activityNotification:nil.
- browser := (UserPreferences current changeSetBrowserClass) openOn:previousMethods.
- browser window label:('Revisions of ' , mclass name , ' ' , mselector).
- browser readOnly:true.
+ self activityNotification:nil.
+ browser := (UserPreferences current changeSetBrowserClass) openOn:previousMethods.
+ browser window label:('Revisions of ' , mclass name , ' ' , mselector).
+ browser readOnly:true.
].
"Modified: / 01-07-2011 / 16:34:29 / cg"
@@ -47589,7 +47657,6 @@
"Modified: / 28-02-2012 / 16:48:38 / cg"
! !
-
!NewSystemBrowser methodsFor:'menu actions-variables'!
browseVarRefsOrModsWithTitle:browserTitle boxTitle:boxTitle variables:varType access:accessType all:browseAll
@@ -49049,8 +49116,19 @@
browseClassExtensionsMenu
<resource: #programMenu >
+ ^ self browseClassExtensionsMenuUsingManagerNamed:nil
+!
+
+browseClassExtensionsMenuUsingManagerNamed:sourceCodeManagerNameOrNil
+ <resource: #programMenu >
+
^ [
- |m extensionProjectIDs classPackage item|
+ |m extensionProjectIDs classPackage item mgr|
+
+ sourceCodeManagerNameOrNil notNil ifTrue:[
+ mgr := Smalltalk at:sourceCodeManagerNameOrNil asSymbol.
+ self assert:(mgr notNil).
+ ].
extensionProjectIDs := Set new.
@@ -49066,13 +49144,13 @@
m := Menu new.
extensionProjectIDs size > 1 ifTrue:[
item := MenuItem label:'All'.
- item itemValue:#'classMenuCheckInExtensions:'.
+ item itemValue:[ self classMenuCheckInExtensionsUsingManager:mgr ].
m addItem:item.
m addSeparator.
].
extensionProjectIDs asSortedCollection do:[:eachExtensionPackage |
item := MenuItem label:eachExtensionPackage.
- item itemValue:#'classMenuCheckInExtensionsFor:' argument:eachExtensionPackage.
+ item itemValue:[ self classMenuCheckInExtensionsFor: eachExtensionPackage usingManager:mgr ].
m addItem:item.
].
].
@@ -49433,9 +49511,9 @@
codeView := self codeView.
sensor := codeView sensor.
sensor shiftDown ifTrue:[
- sensor ctrlDown ifFalse:[
- ^ shiftedMenu
- ].
+ sensor ctrlDown ifFalse:[
+ ^ shiftedMenu
+ ].
].
menu := codeView editMenu.
@@ -49449,26 +49527,26 @@
"/ menuOthers := menu.
"/ ]
"/ ] ifFalse:[
- (menu isKindOf:Menu) ifTrue:[
- "/ a newStyle menuPanel
- "/ (menu atNameKey:'refactor') "atMenuItemLabeled:'Refactor'" putSubmenu:shiftedMenu visible:true.
- (menu menuItemLabeled:(resources string:'Refactor')) notNil ifTrue:[
- menu atMenuItemLabeled:(resources string:'Refactor') putSubmenu:shiftedMenu visible:true.
- ].
- ] ifFalse:[
- "/ an oldStyle popUpMenu
- "/ this is a kludge...
- shiftedMenu := shiftedMenu asOldStylePopUpMenuFor:self.
- "/ would like to add the shifted-menu here
- menu menuView
- addLabels:(Array with:'-' with:(resources string:'Refactor'))
- selectors:#( nil refactorings)
- accelerators:#(nil 'Shift')
- after:#accept.
- menu subMenuAt:#refactorings put:shiftedMenu.
-
- menuOthers := menu subMenuAt:#others.
- ].
+ (menu isKindOf:Menu) ifTrue:[
+ "/ a newStyle menuPanel
+ "/ (menu atNameKey:'refactor') "atMenuItemLabeled:'Refactor'" putSubmenu:shiftedMenu visible:true.
+ (menu menuItemLabeled:(resources string:'Refactor')) notNil ifTrue:[
+ menu atMenuItemLabeled:(resources string:'Refactor') putSubmenu:shiftedMenu visible:true.
+ ].
+ ] ifFalse:[
+ "/ an oldStyle popUpMenu
+ "/ this is a kludge...
+ shiftedMenu := shiftedMenu asOldStylePopUpMenuFor:self.
+ "/ would like to add the shifted-menu here
+ menu menuView
+ addLabels:(Array with:'-' with:(resources string:'Refactor'))
+ selectors:#( nil refactorings)
+ accelerators:#(nil 'Shift')
+ after:#accept.
+ menu subMenuAt:#refactorings put:shiftedMenu.
+
+ menuOthers := menu subMenuAt:#others.
+ ].
"/ ].
"/ sensor shiftDown ifFalse:[
@@ -49826,36 +49904,36 @@
(mthd notNil and:[ (mSel := mthd selector) notNil]) ifTrue:[
- "/ JV: Following code should be language-specific. For Smalltalk, use the old code.
- "/ For the rest, delegate to the language's toolbox (if any)
- mthd programmingLanguage isSmalltalk ifFalse:[
- | toolbox |
-
- toolbox := mthd programmingLanguage toolbox.
- toolbox isNil ifTrue:[
- m addItem:((MenuItem label: (resources string: 'Not supported for %1 (no toolbox)'with: mthd programmingLanguage name))
- enabled: false).
- ^ m.
- ].
- toolbox browser: self.
- toolbox environment: environment.
- ^ toolbox messagesMenuFor:actionSelector
- withMethods: (Array with: mthd)
- withMethodSelectors:withCurrentSelector
- withSentSelectors: true
- withSelfSelectorsOnly: selfSendsOnly
- ].
-
- needSep := false.
-
- contractedSelector := mSel contractTo:80.
-
- withCurrentSelector ifTrue:[
- item := MenuItem label:(' ' , contractedSelector , ' '). "/ ' ' is a kludge - to allow '-' selector
- item itemValue:actionSelector argument:mSel.
- m addItem:item.
- needSep := true.
- ].
+ "/ JV: Following code should be language-specific. For Smalltalk, use the old code.
+ "/ For the rest, delegate to the language's toolbox (if any)
+ mthd programmingLanguage isSmalltalk ifFalse:[
+ | toolbox |
+
+ toolbox := mthd programmingLanguage toolbox.
+ toolbox isNil ifTrue:[
+ m addItem:((MenuItem label: (resources string: 'Not supported for %1 (no toolbox)'with: mthd programmingLanguage name))
+ enabled: false).
+ ^ m.
+ ].
+ toolbox browser: self.
+ toolbox environment: environment.
+ ^ toolbox messagesMenuFor:actionSelector
+ withMethods: (Array with: mthd)
+ withMethodSelectors:withCurrentSelector
+ withSentSelectors: true
+ withSelfSelectorsOnly: selfSendsOnly
+ ].
+
+ needSep := false.
+
+ contractedSelector := mSel contractTo:80.
+
+ withCurrentSelector ifTrue:[
+ item := MenuItem label:(' ' , contractedSelector , ' '). "/ ' ' is a kludge - to allow '-' selector
+ item itemValue:actionSelector argument:mSel.
+ m addItem:item.
+ needSep := true.
+ ].
"/ true "withInstanceProtocolOnly" ifTrue:[
"/ item := MenuItem label:(resources string:' %1 - Instance Protocol Only' with:contractedSelector).
"/ item value:actionSelector.
@@ -49869,63 +49947,63 @@
"/ m addItem:item.
"/ ].
- (withLocalSenders or:[ withSenderChain or:[ withLocalImplementors or:[ withImplementorChain]]]) ifTrue:[
- needSep ifTrue:[ m addSeparator ].
- needSep := false.
- ].
-
- withLocalSenders ifTrue:[
- "/ item := MenuItem label:(resources string:' %1 - Local Senders' with:contractedSelector).
- item := MenuItem label:(resources string:'Local Senders of %1' with:contractedSelector).
- item itemValue:#spawnLocalSendersBuffer.
- m addItem:item. needSep := true
- ].
- withSenderChain ifTrue:[
- "/ item := MenuItem label:(resources string:' %1 - Sender Chain' with:contractedSelector).
- item := MenuItem label:(resources string:'Sender Chain of %1' with:contractedSelector).
- item itemValue:#spawnSenderChainBuffer.
- m addItem:item. needSep := true
- ].
- (withCallersOfThisMethod and:[mthd isInstrumented]) ifTrue:[
- item := MenuItem label:(resources string:'Callers of this %1' with:contractedSelector).
- item itemValue:#spawnCallersBuffer.
- m addItem:item. needSep := true
- ].
-
- withLocalImplementors ifTrue:[
- item := MenuItem label:(resources string:'Local Implementors of %1' with:contractedSelector).
- item itemValue:#spawnLocalImplementorsBuffer.
- m addItem:item. needSep := true
- ].
- withImplementorChain ifTrue:[
- item := MenuItem label:(resources string:'Implementor Chain of %1' with:contractedSelector).
- item itemValue:#spawnImplementorChainBuffer.
- m addItem:item. needSep := true
- ].
- withMethodsCalledByThisMethod ifTrue:[
- item := MenuItem label:(resources string:'Methods Called by %1' with:contractedSelector).
- item itemValue:#spawnMethodsCalledByBuffer.
- m addItem:item. needSep := true
- ].
-
- selfSendsOnly ifTrue:[
- l := mthd messagesSentToSelf.
- l := l , (mthd messagesSentToSuper asArray collect:[:each | { each . mthd mclass superclass }]).
- l := l , ((mthd messagesPossiblySent
- select:[:sel | mthd mclass canUnderstand:sel])
- asArray collect:[:each | each colorizeAllWith:Color darkGrey]).
- ] ifFalse:[
- l := mthd messagesSent asArray.
- l := l , (mthd messagesPossiblySent asArray collect:[:each | each colorizeAllWith:Color darkGrey]).
- ].
- l size > 0 ifTrue:[
- l := l asOrderedCollection sort:[:a :b |
- |sA sB|
- sA := a isArray ifTrue:[a first] ifFalse:[a string].
- sB := b isArray ifTrue:[b first] ifFalse:[b string].
- sA < sB].
-
- needSep ifTrue:[ m addSeparator ].
+ (withLocalSenders or:[ withSenderChain or:[ withLocalImplementors or:[ withImplementorChain]]]) ifTrue:[
+ needSep ifTrue:[ m addSeparator ].
+ needSep := false.
+ ].
+
+ withLocalSenders ifTrue:[
+ "/ item := MenuItem label:(resources string:' %1 - Local Senders' with:contractedSelector).
+ item := MenuItem label:(resources string:'Local Senders of %1' with:contractedSelector).
+ item itemValue:#spawnLocalSendersBuffer.
+ m addItem:item. needSep := true
+ ].
+ withSenderChain ifTrue:[
+ "/ item := MenuItem label:(resources string:' %1 - Sender Chain' with:contractedSelector).
+ item := MenuItem label:(resources string:'Sender Chain of %1' with:contractedSelector).
+ item itemValue:#spawnSenderChainBuffer.
+ m addItem:item. needSep := true
+ ].
+ (withCallersOfThisMethod and:[mthd isInstrumented]) ifTrue:[
+ item := MenuItem label:(resources string:'Callers of this %1' with:contractedSelector).
+ item itemValue:#spawnCallersBuffer.
+ m addItem:item. needSep := true
+ ].
+
+ withLocalImplementors ifTrue:[
+ item := MenuItem label:(resources string:'Local Implementors of %1' with:contractedSelector).
+ item itemValue:#spawnLocalImplementorsBuffer.
+ m addItem:item. needSep := true
+ ].
+ withImplementorChain ifTrue:[
+ item := MenuItem label:(resources string:'Implementor Chain of %1' with:contractedSelector).
+ item itemValue:#spawnImplementorChainBuffer.
+ m addItem:item. needSep := true
+ ].
+ withMethodsCalledByThisMethod ifTrue:[
+ item := MenuItem label:(resources string:'Methods Called by %1' with:contractedSelector).
+ item itemValue:#spawnMethodsCalledByBuffer.
+ m addItem:item. needSep := true
+ ].
+
+ selfSendsOnly ifTrue:[
+ l := mthd messagesSentToSelf.
+ l := l , (mthd messagesSentToSuper asArray collect:[:each | { each . mthd mclass superclass }]).
+ l := l , ((mthd messagesPossiblySent
+ select:[:sel | mthd mclass canUnderstand:sel])
+ asArray collect:[:each | each colorizeAllWith:Color darkGrey]).
+ ] ifFalse:[
+ l := mthd messagesSent asArray.
+ l := l , (mthd messagesPossiblySent asArray collect:[:each | each colorizeAllWith:Color darkGrey]).
+ ].
+ l size > 0 ifTrue:[
+ l := l asOrderedCollection sort:[:a :b |
+ |sA sB|
+ sA := a isArray ifTrue:[a first] ifFalse:[a string].
+ sB := b isArray ifTrue:[b first] ifFalse:[b string].
+ sA < sB].
+
+ needSep ifTrue:[ m addSeparator ].
"/ (l size > 30) ifTrue:[
"/ l removeAllFoundIn:#(ifTrue: ifFalse: ifTrue:ifFalse: ifFalse:ifTrue:
@@ -49942,120 +50020,120 @@
"/ l := l copyTo:30
"/ ].
- l do:[:eachMessageOrPair |
- |selector class label arg|
-
- eachMessageOrPair isArray ifTrue:[
- selector := eachMessageOrPair first.
- class := eachMessageOrPair second.
- arg := eachMessageOrPair.
- ] ifFalse:[
- selector := eachMessageOrPair.
- arg := eachMessageOrPair string asSymbol.
- ].
- label := (selector contractTo:100).
- class notNil ifTrue:[
- label := label , ' (super)'.
- ].
- item := MenuItem label:(' ' , label, ' '). "/ ' ' is a kludge - to allow '-' selector (i.e. not confuse with separator)
- item itemValue:actionSelector argument:arg.
- m addItem:item.
- ].
+ l do:[:eachMessageOrPair |
+ |selector class label arg|
+
+ eachMessageOrPair isArray ifTrue:[
+ selector := eachMessageOrPair first.
+ class := eachMessageOrPair second.
+ arg := eachMessageOrPair.
+ ] ifFalse:[
+ selector := eachMessageOrPair.
+ arg := eachMessageOrPair string asSymbol.
+ ].
+ label := (selector contractTo:100).
+ class notNil ifTrue:[
+ label := label , ' (super)'.
+ ].
+ item := MenuItem label:(' ' , label, ' '). "/ ' ' is a kludge - to allow '-' selector (i.e. not confuse with separator)
+ item itemValue:actionSelector argument:arg.
+ m addItem:item.
+ ].
"/ cut ifTrue:[
"/ m addItem:(MenuItem label:'-').
"/ m addItem:(MenuItem label:'<< more items ignored >>').
"/ ]
- ]
- ] ifFalse:[
- | methodsPerLanguage |
-
- allMessagesSent := Set new.
-
- "/ not exactly one method selected;
- "/ generate a menu for all selected method's implementors and sent messages.
- methods := self selectedMethodsValue.
- methods isEmptyOrNil ifTrue:[
- methods := OrderedCollection new.
- self selectedClassesDo:[:cls |
- cls methodsDo:[:eachMethod | methods add:eachMethod].
- ].
- ].
- methodsPerLanguage := Dictionary new.
- methods do:[:each |
- (methodsPerLanguage at: each programmingLanguage ifAbsentPut:[Set new]) add: each.
- ].
- methodsPerLanguage keysAndValuesDo:[:language :methods |
- language isSmalltalk ifTrue:[
- "/ Do it as before...
- methods do:[:eachMethod |
- mSel := eachMethod selector ? '?'.
- contractedSelector := mSel contractTo:80.
-
- item := MenuItem label:(' ' , contractedSelector , ' '). "/ ' ' is a kludge - to allow '-' selector
- item itemValue:actionSelector argument:mSel.
- m addItem:item.
-
- selfSendsOnly ifTrue:[
- allMessagesSent addAll:(eachMethod messagesSentToSelf).
- ] ifFalse:[
- allMessagesSent addAll:(eachMethod messagesSent).
- ].
- ].
- ] ifFalse:[
- "/ Not a Smalltalk, must ask toolbox
- | toolbox |
-
- toolbox := language toolbox.
- toolbox environment: environment.
- toolbox notNil ifTrue:[
- m addItemsFrom:
- (toolbox messagesMenuFor:actionSelector
- withMethods: methods
- withMethodSelectors:true
- withSentSelectors: false
- withSelfSelectorsOnly: selfSendsOnly)
- ].
- ].
- ].
-
- needSep := true.
- methodsPerLanguage keysAndValuesDo:[:language :methods |
- language isSmalltalk ifTrue:[
- "/ Do it as before...
- allMessagesSent := allMessagesSent asSortedCollection.
- allMessagesSent size > 0 ifTrue:[
- needSep ifTrue:[
- m addSeparator.
- needSep := false.
- ].
- allMessagesSent do:[:eachMessage |
- item := MenuItem label:(' ' , (eachMessage contractTo:100), ' '). "/ ' ' is a kludge - to allow '-' selector
- item itemValue:actionSelector argument:eachMessage asSymbol.
- m addItem:item.
- ].
- ].
- ] ifFalse:[
- "/ Not a Smalltalk, must ask toolbox
- | toolbox |
-
- toolbox := language toolbox.
- toolbox notNil ifTrue:[
- | lm |
-
- lm := toolbox messagesMenuFor:actionSelector
- withMethods: methods
- withMethodSelectors:false
- withSentSelectors: true
- withSelfSelectorsOnly: selfSendsOnly.
- (lm items notEmptyOrNil and:[needSep]) ifTrue:[
- m addSeparator.
- needSep := false.
- ].
- m addItemsFrom: lm.
- ].
- ].
- ].
+ ]
+ ] ifFalse:[
+ | methodsPerLanguage |
+
+ allMessagesSent := Set new.
+
+ "/ not exactly one method selected;
+ "/ generate a menu for all selected method's implementors and sent messages.
+ methods := self selectedMethodsValue.
+ methods isEmptyOrNil ifTrue:[
+ methods := OrderedCollection new.
+ self selectedClassesDo:[:cls |
+ cls methodsDo:[:eachMethod | methods add:eachMethod].
+ ].
+ ].
+ methodsPerLanguage := Dictionary new.
+ methods do:[:each |
+ (methodsPerLanguage at: each programmingLanguage ifAbsentPut:[Set new]) add: each.
+ ].
+ methodsPerLanguage keysAndValuesDo:[:language :methods |
+ language isSmalltalk ifTrue:[
+ "/ Do it as before...
+ methods do:[:eachMethod |
+ mSel := eachMethod selector ? '?'.
+ contractedSelector := mSel contractTo:80.
+
+ item := MenuItem label:(' ' , contractedSelector , ' '). "/ ' ' is a kludge - to allow '-' selector
+ item itemValue:actionSelector argument:mSel.
+ m addItem:item.
+
+ selfSendsOnly ifTrue:[
+ allMessagesSent addAll:(eachMethod messagesSentToSelf).
+ ] ifFalse:[
+ allMessagesSent addAll:(eachMethod messagesSent).
+ ].
+ ].
+ ] ifFalse:[
+ "/ Not a Smalltalk, must ask toolbox
+ | toolbox |
+
+ toolbox := language toolbox.
+ toolbox environment: environment.
+ toolbox notNil ifTrue:[
+ m addItemsFrom:
+ (toolbox messagesMenuFor:actionSelector
+ withMethods: methods
+ withMethodSelectors:true
+ withSentSelectors: false
+ withSelfSelectorsOnly: selfSendsOnly)
+ ].
+ ].
+ ].
+
+ needSep := true.
+ methodsPerLanguage keysAndValuesDo:[:language :methods |
+ language isSmalltalk ifTrue:[
+ "/ Do it as before...
+ allMessagesSent := allMessagesSent asSortedCollection.
+ allMessagesSent size > 0 ifTrue:[
+ needSep ifTrue:[
+ m addSeparator.
+ needSep := false.
+ ].
+ allMessagesSent do:[:eachMessage |
+ item := MenuItem label:(' ' , (eachMessage contractTo:100), ' '). "/ ' ' is a kludge - to allow '-' selector
+ item itemValue:actionSelector argument:eachMessage asSymbol.
+ m addItem:item.
+ ].
+ ].
+ ] ifFalse:[
+ "/ Not a Smalltalk, must ask toolbox
+ | toolbox |
+
+ toolbox := language toolbox.
+ toolbox notNil ifTrue:[
+ | lm |
+
+ lm := toolbox messagesMenuFor:actionSelector
+ withMethods: methods
+ withMethodSelectors:false
+ withSentSelectors: true
+ withSelfSelectorsOnly: selfSendsOnly.
+ (lm items notEmptyOrNil and:[needSep]) ifTrue:[
+ m addSeparator.
+ needSep := false.
+ ].
+ m addItemsFrom: lm.
+ ].
+ ].
+ ].
].
^ m
@@ -50862,7 +50940,6 @@
"Modified: / 19-10-2011 / 16:48:31 / cg"
! !
-
!NewSystemBrowser methodsFor:'menus-dynamic-popup'!
categoryPopUpMenu
@@ -51317,72 +51394,72 @@
ns classes|
aClass isNil ifTrue:[
- ^ self
+ ^ self
].
aSelector notNil ifTrue:[
- mthd := aClass compiledMethodAt:aSelector.
+ mthd := aClass compiledMethodAt:aSelector.
].
(navigationState isMethodListBrowser
or:[navigationState isMethodBrowser]) ifTrue:[
- "/ must check if that method is in the list ...
-
- mthd isNil ifTrue:[
+ "/ must check if that method is in the list ...
+
+ mthd isNil ifTrue:[
"/ (self confirm:'Add a buffer for the class ?' withCRs) ifFalse:[
"/ ^ self
"/ ].
- self spawnFullBrowserInClass:aClass selector:nil in:#newBuffer.
- ^ self
- ].
-
- navigationState methodListApplication isNil ifTrue:[
- self spawnFullBrowserInClass:aClass selector:aSelector in:#newBuffer.
- ^ self
- ].
-
- (navigationState methodList includesIdentical:mthd) ifFalse:[
- answer := OptionBox request:'Method not in list.\\Add a buffer for it ?' withCRs
- label:'New Browser ?'
- image:(WarningBox iconBitmap)
- buttonLabels:(resources array:#('New Browser' 'Add Buffer' 'Cancel'))
- values:#(#newBrowser #newBuffer nil)
- default:#newBuffer
- onCancel:nil.
- answer notNil ifTrue:[
- self spawnFullBrowserInClass:aClass selector:aSelector in:answer.
- ].
- ^ self
- ].
- self selectedMethods value:(OrderedCollection with:mthd).
- ^ self
+ self spawnFullBrowserInClass:aClass selector:nil in:#newBuffer.
+ ^ self
+ ].
+
+ navigationState methodListApplication isNil ifTrue:[
+ self spawnFullBrowserInClass:aClass selector:aSelector in:#newBuffer.
+ ^ self
+ ].
+
+ (navigationState methodList includesIdentical:mthd) ifFalse:[
+ answer := OptionBox request:'Method not in list.\\Add a buffer for it ?' withCRs
+ label:'New Browser ?'
+ image:(WarningBox iconBitmap)
+ buttonLabels:(resources array:#('New Browser' 'Add Buffer' 'Cancel'))
+ values:#(#newBrowser #newBuffer nil)
+ default:#newBuffer
+ onCancel:nil.
+ answer notNil ifTrue:[
+ self spawnFullBrowserInClass:aClass selector:aSelector in:answer.
+ ].
+ ^ self
+ ].
+ self selectedMethods value:(OrderedCollection with:mthd).
+ ^ self
].
mthd isNil ifTrue:[
- self selectedMethods value:(OrderedCollection new).
- ] ifFalse:[
- self selectedMethods value:(OrderedCollection with:mthd).
+ self selectedMethods value:(OrderedCollection new).
+ ] ifFalse:[
+ self selectedMethods value:(OrderedCollection with:mthd).
].
(navigationState isClassBrowser) ifTrue:[
- "/ must check if that class is in the list ...
- ((navigationState classList value ? #()) includesIdentical:aClass) ifFalse:[
- navigationState isSingleClassBrowser ifTrue:[
- navigationState classList value:(Array with:aClass).
- ] ifFalse:[
- (self confirm:'Class not in list.\\Add a buffer for it ?' withCRs) ifTrue:[
- self spawnFullBrowserInClass:aClass selector:aSelector in:#newBuffer.
- ].
- ^ self
- ].
- ].
- self selectedClasses value:(OrderedCollection with:aClass).
- ^ self
+ "/ must check if that class is in the list ...
+ ((navigationState classList value ? #()) includesIdentical:aClass) ifFalse:[
+ navigationState isSingleClassBrowser ifTrue:[
+ navigationState classList value:(Array with:aClass).
+ ] ifFalse:[
+ (self confirm:'Class not in list.\\Add a buffer for it ?' withCRs) ifTrue:[
+ self spawnFullBrowserInClass:aClass selector:aSelector in:#newBuffer.
+ ].
+ ^ self
+ ].
+ ].
+ self selectedClasses value:(OrderedCollection with:aClass).
+ ^ self
].
(navigationState isProtocolBrowser) ifTrue:[
- (self confirm:'Add a buffer for it ?' withCRs) ifTrue:[
- self spawnFullBrowserInClass:aClass selector:aSelector in:#newBuffer.
- ].
- ^ self
+ (self confirm:'Add a buffer for it ?' withCRs) ifTrue:[
+ self spawnFullBrowserInClass:aClass selector:aSelector in:#newBuffer.
+ ].
+ ^ self
].
orgMode := self organizerMode value.
@@ -51390,34 +51467,34 @@
"/ if the class is a namespace, ask if mode should be changed
(aClass isNameSpace and:[aClass ~~ Smalltalk]) ifTrue:[
- orgMode ~~ OrganizerCanvas organizerModeNamespace ifTrue:[
- answer := self
- confirmWithCancel:(resources string:'Browser: %1 is a namespace - switch organizers display mode ?' with:aClass name)
- defaultAnswer:false.
- answer isNil ifTrue:[
- AbortOperationRequest raise.
- ^ self
- ].
- answer ifTrue:[
- self organizerMode value:(OrganizerCanvas organizerModeNamespace).
- orgMode := self organizerMode value.
- ] ifFalse:[
- ((self selectedClassesValue) contains:[:cls | cls nameSpace == aClass]) ifTrue:[^ self ].
-
- "/ select the first class of that namespace
- classes := aClass allClasses.
- classes notEmpty ifTrue:[
- self switchToClass:(classes first) selector:nil.
- ^ self.
- ]
- ]
- ].
+ orgMode ~~ OrganizerCanvas organizerModeNamespace ifTrue:[
+ answer := self
+ confirmWithCancel:(resources string:'Browser: %1 is a namespace - switch organizers display mode ?' with:aClass name)
+ defaultAnswer:false.
+ answer isNil ifTrue:[
+ AbortOperationRequest raise.
+ ^ self
+ ].
+ answer ifTrue:[
+ self organizerMode value:(OrganizerCanvas organizerModeNamespace).
+ orgMode := self organizerMode value.
+ ] ifFalse:[
+ ((self selectedClassesValue) contains:[:cls | cls nameSpace == aClass]) ifTrue:[^ self ].
+
+ "/ select the first class of that namespace
+ classes := aClass allClasses.
+ classes notEmpty ifTrue:[
+ self switchToClass:(classes first) selector:nil.
+ ^ self.
+ ]
+ ]
+ ].
].
"/ if the class is unloaded, turn hideUnloaded off
(aClass isLoaded not
and:[self hideUnloadedClasses value == true]) ifTrue:[
- self hideUnloadedClasses value:false
+ self hideUnloadedClasses value:false
].
doSwitchMeta := true.
@@ -51428,9 +51505,9 @@
ns := aClass topNameSpace.
ns notNil ifTrue:[nsName := ns name].
(namespaces includes:nsName) ifFalse:[
- (namespaces includes:(NavigatorModel nameListEntryForALL)) ifFalse:[
- self selectedNamespaces value:(OrderedCollection with: NavigatorModel nameListEntryForALL)
- ]
+ (namespaces includes:(NavigatorModel nameListEntryForALL)) ifFalse:[
+ self selectedNamespaces value:(OrderedCollection with: NavigatorModel nameListEntryForALL)
+ ]
].
"/ namespaces := self nameSpaceFilter value ? #().
"/ (namespaces includes:aClass nameSpace name) ifFalse:[
@@ -51439,73 +51516,73 @@
"/ ]
"/ ].
orgMode == OrganizerCanvas organizerModeCategory ifTrue:[
- cat := aClass category ? '* no category *'.
- (self selectedCategoriesValue includes:cat) ifFalse:[
- self selectedCategories value:(OrderedCollection with:cat).
- ]
+ cat := aClass category ? '* no category *'.
+ (self selectedCategoriesValue includes:cat) ifFalse:[
+ self selectedCategories value:(OrderedCollection with:cat).
+ ]
] ifFalse:[ orgMode == OrganizerCanvas organizerModeNamespace ifTrue:[
- aClass isNameSpace ifTrue:[
- nsName := aClass name.
- ] ifFalse:[
- nsName := aClass nameSpace name.
- ].
- (self selectedNamespacesValue includes:nsName) ifFalse:[
- self selectedNamespaces value:(OrderedCollection with:nsName).
- ]
+ aClass isNameSpace ifTrue:[
+ nsName := aClass name.
+ ] ifFalse:[
+ nsName := aClass nameSpace name.
+ ].
+ (self selectedNamespacesValue includes:nsName) ifFalse:[
+ self selectedNamespaces value:(OrderedCollection with:nsName).
+ ]
] ifFalse:[ orgMode == OrganizerCanvas organizerModeProject ifTrue:[
- pkg := aClass package.
- holder := self selectedProjects.
- newValue := holder value ? #().
- (newValue includes:pkg) ifFalse:[
- newValue := OrderedCollection with:pkg.
- ].
- mthd notNil ifTrue:[
- "/ careful - the method could be in an extension ...
- mthd package ~= pkg ifTrue:[
- (newValue includes:mthd package) ifFalse:[
- newValue := newValue asOrderedCollection.
- newValue add:mthd package.
- ].
- ].
- ].
- newValue ~= holder value ifTrue:[
- holder value:newValue.
- ].
+ pkg := aClass package.
+ holder := self selectedProjects.
+ newValue := holder value ? #().
+ (newValue includes:pkg) ifFalse:[
+ newValue := OrderedCollection with:pkg.
+ ].
+ mthd notNil ifTrue:[
+ "/ careful - the method could be in an extension ...
+ mthd package ~= pkg ifTrue:[
+ (newValue includes:mthd package) ifFalse:[
+ newValue := newValue asOrderedCollection.
+ newValue add:mthd package.
+ ].
+ ].
+ ].
+ newValue ~= holder value ifTrue:[
+ holder value:newValue.
+ ].
] ifFalse:[ (orgMode == OrganizerCanvas organizerModeClassHierarchy
- or:[orgMode == OrganizerCanvas organizerModeClassInheritance]) ifTrue:[
- "/ make sure, that the class is in the hierarchy;
- "/ if required, update the hierarchy.
-
- holder := self classHierarchyTopClass.
- cls := holder value.
- (cls isNil or:[(cls withAllSuperclasses includesIdentical:aClass) not]) ifTrue:[
- holder value:aClass.
- ].
- doSwitchMeta := false.
+ or:[orgMode == OrganizerCanvas organizerModeClassInheritance]) ifTrue:[
+ "/ make sure, that the class is in the hierarchy;
+ "/ if required, update the hierarchy.
+
+ holder := self classHierarchyTopClass.
+ cls := holder value.
+ (cls isNil or:[(cls withAllSuperclasses includesIdentical:aClass) not]) ifTrue:[
+ holder value:aClass.
+ ].
+ doSwitchMeta := false.
]]]].
doSwitchMeta ifTrue:[
- self meta value:(aClass isMeta).
+ self meta value:(aClass isMeta).
].
(self selectedClassesValue includesIdentical:aClass) ifFalse:[
- self selectedClasses value:(OrderedCollection with:aClass).
+ self selectedClasses value:(OrderedCollection with:aClass).
].
mthd notNil ifTrue:[
- (self selectedProtocolsValue contains:[:cat | (cat isNil and:[mthd category isNil]) or:[cat string = mthd category]]) ifFalse:[
- self selectProtocols:(OrderedCollection with:mthd category).
- ].
- self switchToMethod:mthd.
- ] ifFalse:[
- self switchToSelector:aSelector.
+ (self selectedProtocolsValue contains:[:cat | (cat isNil and:[mthd category isNil]) or:[cat string = mthd category]]) ifFalse:[
+ self selectProtocols:(OrderedCollection with:mthd category).
+ ].
+ self switchToMethod:mthd.
+ ] ifFalse:[
+ self switchToSelector:aSelector.
].
self immediateUpdate value:false.
updateHistory ifTrue:[
- self addToHistory:aClass selector:aSelector
+ self addToHistory:aClass selector:aSelector
].
self normalLabel.
@@ -51540,109 +51617,109 @@
|className class implementors answer classesMatchingCaseless|
aMatchString isEmptyOrNil ifTrue:[
- ^ self.
+ ^ self.
].
aMatchString knownAsSymbol ifTrue:[
- class := environment classNamed:aMatchString.
- class notNil ifTrue:[
- self switchToClass:class.
- ^ self.
- ].
- classesMatchingCaseless := environment keys select:[:nm | nm sameAs:aMatchString].
+ class := environment classNamed:aMatchString.
+ class notNil ifTrue:[
+ self switchToClass:class.
+ ^ self.
+ ].
+ classesMatchingCaseless := environment keys select:[:nm | nm sameAs:aMatchString].
"/ matchStringLowercase := aMatchString asLowercase.
"/ classesWithPrefixCaseless := environment keys select:[:nm | nm asLowercase startsWith:aMatchString].
"/ impl := environment allImplementorsOf:aMatchString asSymbol.
"/ impl notEmptyOrNil ifTrue:[
"/ ].
- (aMatchString first isLetter not
- or:[ aMatchString first isLowercase]) ifTrue:[
- implementors := SystemBrowser findImplementorsMatching:aMatchString in:(environment allClasses) ignoreCase:true.
- implementors size > 0 ifTrue:[
- (classesMatchingCaseless isEmpty and:[implementors size == 1]) ifTrue:[
- answer := Dialog
- confirm:(resources
- stringWithCRs:'No class named "%1".\But "%2" implements it. Go there ?'
- with:aMatchString allBold
- with:implementors first mclass name).
- answer ifTrue:[
- self switchToClass:implementors first mclass selector:implementors first selector.
- ].
- ^ self.
- ].
- implementors := implementors asOrderedCollection sort:[:a :b | a mclass name < b mclass name].
- classesMatchingCaseless isEmpty ifTrue:[
- answer := Dialog
- choose:(resources
- stringWithCRs:'No class named "%1.\But there are %2 implementors of it.\\Goto one of them ?'
- with:aMatchString allBold
- with:implementors size)
- fromList:(implementors collect:[:m | m mclass name])
- values:implementors
- buttons:#('No, Search for a Class' 'Show all Implementors') values:#(searchClass browseAllImplementors)
- lines:10 cancel:nil
- postBuildBlock:[:box | box minExtent:300@250].
- ] ifFalse:[
- answer := Dialog
- choose:(resources
- stringWithCRs:'No class named "%1".\But there are %2 implementors of it and %3 '
- , (classesMatchingCaseless size == 1 ifTrue:['class'] ifFalse:['classes'])
- ,' with a similar name.\\Goto one of them ?'
- with:aMatchString allBold
- with:implementors size
- with:classesMatchingCaseless size)
- fromList:({'Implementors:' colorizeAllWith:Color grey}
- ,(implementors collect:[:m | m mclass name])
- ,{'Classes:' colorizeAllWith:Color grey}
- ,classesMatchingCaseless)
- values:(#(nil),implementors,#(nil),classesMatchingCaseless)
- buttons:#('No, Search for a Class' 'Show all Implementors') values:#(searchClass browseAllImplementors)
- lines:10 cancel:nil
- postBuildBlock:[:box | box minExtent:300@250].
- ].
-
- answer isNil ifTrue:[^ self].
- answer == #browseAllImplementors ifTrue:[
- self
- spawnMethodBrowserForSearch:[
- SystemBrowser
- findImplementorsOf:aMatchString
- in:environment allClasses
- ignoreCase:false.
- ]
- sortBy:#class
- in:#newBuffer
- label:(resources string:'Implementors of %1' string with:aMatchString).
- ^ self
- ].
- answer ~~ #searchClass ifTrue:[
- answer isSymbol ifTrue:[
- self switchToClass:(environment classNamed:answer).
- ] ifFalse:[
- self switchToClass:(answer mclass) selector:(answer selector).
- ].
- ^ self.
- ].
- ].
- ].
+ (aMatchString first isLetter not
+ or:[ aMatchString first isLowercase]) ifTrue:[
+ implementors := SystemBrowser findImplementorsMatching:aMatchString in:(environment allClasses) ignoreCase:true.
+ implementors size > 0 ifTrue:[
+ (classesMatchingCaseless isEmpty and:[implementors size == 1]) ifTrue:[
+ answer := Dialog
+ confirm:(resources
+ stringWithCRs:'No class named "%1".\But "%2" implements it. Go there ?'
+ with:aMatchString allBold
+ with:implementors first mclass name).
+ answer ifTrue:[
+ self switchToClass:implementors first mclass selector:implementors first selector.
+ ].
+ ^ self.
+ ].
+ implementors := implementors asOrderedCollection sort:[:a :b | a mclass name < b mclass name].
+ classesMatchingCaseless isEmpty ifTrue:[
+ answer := Dialog
+ choose:(resources
+ stringWithCRs:'No class named "%1.\But there are %2 implementors of it.\\Goto one of them ?'
+ with:aMatchString allBold
+ with:implementors size)
+ fromList:(implementors collect:[:m | m mclass name])
+ values:implementors
+ buttons:#('No, Search for a Class' 'Show all Implementors') values:#(searchClass browseAllImplementors)
+ lines:10 cancel:nil
+ postBuildBlock:[:box | box minExtent:300@250].
+ ] ifFalse:[
+ answer := Dialog
+ choose:(resources
+ stringWithCRs:'No class named "%1".\But there are %2 implementors of it and %3 '
+ , (classesMatchingCaseless size == 1 ifTrue:['class'] ifFalse:['classes'])
+ ,' with a similar name.\\Goto one of them ?'
+ with:aMatchString allBold
+ with:implementors size
+ with:classesMatchingCaseless size)
+ fromList:({'Implementors:' colorizeAllWith:Color grey}
+ ,(implementors collect:[:m | m mclass name])
+ ,{'Classes:' colorizeAllWith:Color grey}
+ ,classesMatchingCaseless)
+ values:(#(nil),implementors,#(nil),classesMatchingCaseless)
+ buttons:#('No, Search for a Class' 'Show all Implementors') values:#(searchClass browseAllImplementors)
+ lines:10 cancel:nil
+ postBuildBlock:[:box | box minExtent:300@250].
+ ].
+
+ answer isNil ifTrue:[^ self].
+ answer == #browseAllImplementors ifTrue:[
+ self
+ spawnMethodBrowserForSearch:[
+ SystemBrowser
+ findImplementorsOf:aMatchString
+ in:environment allClasses
+ ignoreCase:false.
+ ]
+ sortBy:#class
+ in:#newBuffer
+ label:(resources string:'Implementors of %1' string with:aMatchString).
+ ^ self
+ ].
+ answer ~~ #searchClass ifTrue:[
+ answer isSymbol ifTrue:[
+ self switchToClass:(environment classNamed:answer).
+ ] ifFalse:[
+ self switchToClass:(answer mclass) selector:(answer selector).
+ ].
+ ^ self.
+ ].
+ ].
+ ].
].
(aMatchString includes: $.) ifTrue:[
- "/ Java class?
- className := (aMatchString copyReplaceAll: $. with: $/) asSymbolIfInterned.
- className notNil ifTrue:[
- environment allClassesDo: [:cls |
- cls name = className ifTrue:[
- self switchToClass:cls.
- ]
- ].
- ].
+ "/ Java class?
+ className := (aMatchString copyReplaceAll: $. with: $/) asSymbolIfInterned.
+ className notNil ifTrue:[
+ environment allClassesDo: [:cls |
+ cls name = className ifTrue:[
+ self switchToClass:cls.
+ ]
+ ].
+ ].
].
className := self askForClassNameMatching:aMatchString.
className notNil ifTrue:[
- self switchToClassNamed:className.
+ self switchToClassNamed:className.
]
"Modified: / 04-07-2006 / 18:48:25 / fm"
@@ -51691,14 +51768,14 @@
cls := environment at:entry className.
"/ Care for Java classes!!
cls isNil ifTrue:[
- environment allClasses detect:[:cls | cls name = entry className ].
+ environment allClasses detect:[:cls | cls name = entry className ].
].
cls isNil ifTrue:[
- self warn:'Oops - class is gone'.
- ^ self
+ self warn:'Oops - class is gone'.
+ ^ self
].
entry meta ifTrue:[
- cls := cls theMetaclass
+ cls := cls theMetaclass
].
self switchToClass:cls selector:entry selector updateHistory: false
@@ -51742,30 +51819,30 @@
|mthd cls orgMode pkg holder|
aSelector notNil ifTrue:[
- (cls := self theSingleSelectedClass) notNil ifTrue:[
- mthd := cls compiledMethodAt:aSelector asSymbol.
- mthd notNil ifTrue:[
-
- "/ care for method being in another package
- orgMode := self organizerMode value.
- orgMode == OrganizerCanvas organizerModeProject ifTrue:[
- pkg := mthd package.
- holder := self selectedProjects.
- ((holder value ? #()) includes:pkg) ifFalse:[
- holder value:(Array with:pkg).
- ]
- ].
-
- (self selectedProtocolsValue contains:[:p | (p isNil and:[mthd category isNil]) or:[p string = mthd category]]) ifFalse:[
- (self selectedProtocolsValue includes:BrowserList nameListEntryForALL) ifFalse:[
- self selectProtocols:(Array with:mthd category).
- ]
- ].
- self theSingleSelectedMethod ~~ mthd ifTrue:[
- self selectedMethods value:(Array with:mthd).
- ]
- ]
- ]
+ (cls := self theSingleSelectedClass) notNil ifTrue:[
+ mthd := cls compiledMethodAt:aSelector asSymbol.
+ mthd notNil ifTrue:[
+
+ "/ care for method being in another package
+ orgMode := self organizerMode value.
+ orgMode == OrganizerCanvas organizerModeProject ifTrue:[
+ pkg := mthd package.
+ holder := self selectedProjects.
+ ((holder value ? #()) includes:pkg) ifFalse:[
+ holder value:(Array with:pkg).
+ ]
+ ].
+
+ (self selectedProtocolsValue contains:[:p | (p isNil and:[mthd category isNil]) or:[p string = mthd category]]) ifFalse:[
+ (self selectedProtocolsValue includes:BrowserList nameListEntryForALL) ifFalse:[
+ self selectProtocols:(Array with:mthd category).
+ ]
+ ].
+ self theSingleSelectedMethod ~~ mthd ifTrue:[
+ self selectedMethods value:(Array with:mthd).
+ ]
+ ]
+ ]
].
"Created: / 04-02-2000 / 23:20:34 / cg"
@@ -52063,33 +52140,33 @@
s := '' writeStream.
(aClass isRealNameSpace) ifTrue:[
- aClass fileOutDefinitionOn:s
- ] ifFalse:[
- aClass theNonMetaclass isJavaClass ifTrue:[
- | src |
- src := aClass theNonMetaclass source.
- src notNil ifTrue:[ ^ src ].
- s nextPutLine: '// *** WARNING ***'.
- s nextPutLine: '// Following code has been decompiled from loaded class'.
- s nextPutLine: '// *** WARNING ***'.
- s cr.
- aClass theNonMetaclass fileOutDefinitionOn:s
- ] ifFalse:[
- aClass isMeta ifTrue:[
- aClass
- fileOutClassInstVarDefinitionOn:s
- withNameSpace:true.
- ] ifFalse:[
- "/
- "/ here, show it with a nameSpace pragma
- "/ and prefer short names.
- "/
- aClass
- basicFileOutDefinitionOn:s
- withNameSpace:true
- withPackage:false
- ].
- ].
+ aClass fileOutDefinitionOn:s
+ ] ifFalse:[
+ aClass theNonMetaclass isJavaClass ifTrue:[
+ | src |
+ src := aClass theNonMetaclass source.
+ src notNil ifTrue:[ ^ src ].
+ s nextPutLine: '// *** WARNING ***'.
+ s nextPutLine: '// Following code has been decompiled from loaded class'.
+ s nextPutLine: '// *** WARNING ***'.
+ s cr.
+ aClass theNonMetaclass fileOutDefinitionOn:s
+ ] ifFalse:[
+ aClass isMeta ifTrue:[
+ aClass
+ fileOutClassInstVarDefinitionOn:s
+ withNameSpace:true.
+ ] ifFalse:[
+ "/
+ "/ here, show it with a nameSpace pragma
+ "/ and prefer short names.
+ "/
+ aClass
+ basicFileOutDefinitionOn:s
+ withNameSpace:true
+ withPackage:false
+ ].
+ ].
].
^ s contents withTabsExpanded.
@@ -52370,34 +52447,34 @@
"JV@2012-07-05: Some class definitions could be quite big, such as Java classes.
Don't format the code here, do it in background instead..."
definition size < 2500 ifTrue:[
- self doSyntaxColoring value ~~ false ifTrue:[
- highlighter := aClass syntaxHighlighterClass.
- highlighter notNil ifTrue:[
- definition := highlighter formatClassDefinition:definition in:nil.
- ]
- ].
+ self doSyntaxColoring value ~~ false ifTrue:[
+ highlighter := aClass syntaxHighlighterClass.
+ highlighter notNil ifTrue:[
+ definition := highlighter formatClassDefinition:definition in:nil.
+ ]
+ ].
].
self showCode:definition.
self normalLabel.
aClass isLoaded ifTrue:[
- "/ continue fetching the documentation,
- "/ which may take longer, if the source must be fetched
- "/ from the repository.
-
- "
- add documentation as a comment, if there is any
- "
- info := self commentOrDocumentationStringFromClass:aClass.
- text := definition.
- info notNil ifTrue:[
- text := definition,(Character cr),info.
- ].
- self codeHolder setValue:text.
- self codeView notNil ifTrue:[
- self codeView setContents:text
- ].
+ "/ continue fetching the documentation,
+ "/ which may take longer, if the source must be fetched
+ "/ from the repository.
+
+ "
+ add documentation as a comment, if there is any
+ "
+ info := self commentOrDocumentationStringFromClass:aClass.
+ text := definition.
+ info notNil ifTrue:[
+ text := definition,(Character cr),info.
+ ].
+ self codeHolder setValue:text.
+ self codeView notNil ifTrue:[
+ self codeView setContents:text
+ ].
].
self updatePackageInfoForClass:aClass.
@@ -52868,84 +52945,84 @@
doAutoFormat := self doAutoFormat value and:[RBFormatter notNil and:[mthd programmingLanguage isSmalltalk]].
doShowFullClassSource := self navigationState isFullClassSourceBrowser
- or:[mthd isJavaMethod and:[JavaMethod showFullSource]].
+ or:[mthd isJavaMethod and:[JavaMethod showFullSource]].
doUpdateCode := true.
codeView := self codeView.
self assert:codeView notNil.
code := self sourceOfMethod:mthd.
code isText ifTrue:[
- "/Already done...
- doSyntaxColoring := false.
- ] ifFalse:[
- "/Do no coloring here if CodeView2 is used,
- "/since CodeView2 itself cares about the coloring!!
- "/Not working correctly -> do the coloring until fixed in CodeView2
- "/JV: Then make a bug report because otherwise it won't be
- "/ ever fixed.
- "(UserPreferences current useCodeView2In: #Browser)"false ifTrue:[
- doSyntaxColoring := code size < 2000
- ] ifFalse:[
- doSyntaxColoring := self doSyntaxColoring value == true.
- ].
+ "/Already done...
+ doSyntaxColoring := false.
+ ] ifFalse:[
+ "/Do no coloring here if CodeView2 is used,
+ "/since CodeView2 itself cares about the coloring!!
+ "/Not working correctly -> do the coloring until fixed in CodeView2
+ "/JV: Then make a bug report because otherwise it won't be
+ "/ ever fixed.
+ "(UserPreferences current useCodeView2In: #Browser)"false ifTrue:[
+ doSyntaxColoring := code size < 2000
+ ] ifFalse:[
+ doSyntaxColoring := self doSyntaxColoring value == true.
+ ].
].
doAutoFormat ifTrue:[
- Error catch:[
- code := RBFormatter format:code
- ].
+ Error catch:[
+ code := RBFormatter format:code
+ ].
].
doShowFullClassSource ifTrue:[
- "As whole class source coce is shown,
- there is no need to set codeview's content if previous method
- belonged to the same class. Code is already shown, we need only
- to scrool to it..."
- "hmm...hmm...how implement it in a better, more generic way?"
- mthd isSynthetic not ifTrue:[
- prevMthd := navigationState lastMethodShownInCodeView.
- prevMthd notNil ifTrue:[
- doUpdateCode := prevMthd isSynthetic or:[mthd mclass ~~ prevMthd mclass]
- ].
-
-
- ].
+ "As whole class source coce is shown,
+ there is no need to set codeview's content if previous method
+ belonged to the same class. Code is already shown, we need only
+ to scrool to it..."
+ "hmm...hmm...how implement it in a better, more generic way?"
+ mthd isSynthetic not ifTrue:[
+ prevMthd := navigationState lastMethodShownInCodeView.
+ prevMthd notNil ifTrue:[
+ doUpdateCode := prevMthd isSynthetic or:[mthd mclass ~~ prevMthd mclass]
+ ].
+
+
+ ].
].
doUpdateCode ifTrue:[
- doSyntaxColoring ifTrue:[
- "/ immediate coloring, if code is not too large;
- "/ otherwise, do it in the background.
- code size < 2000 " 10000 " ifTrue:[
- Error handle:[:ex |
- Transcript showCR:'error in syntaxHighlighter: ',ex description.
- ] do:[
- code := self syntaxHighlightedCodeFor:code method:mthd.
- ].
- ] ifFalse:[
- self enqueueDelayedStartSyntaxHighlightProcess.
- ].
-
- [
- codeView modifiedChannel removeDependent:self.
- codeView modified:false.
- self showCode:code scrollToTop:doScrollToTop.
- ] ensure:[
- codeView modifiedChannel addDependent:self.
- ]
- ] ifFalse:[
- self showCode:code scrollToTop:doScrollToTop.
- ].
+ doSyntaxColoring ifTrue:[
+ "/ immediate coloring, if code is not too large;
+ "/ otherwise, do it in the background.
+ code size < 2000 " 10000 " ifTrue:[
+ Error handle:[:ex |
+ Transcript showCR:'error in syntaxHighlighter: ',ex description.
+ ] do:[
+ code := self syntaxHighlightedCodeFor:code method:mthd.
+ ].
+ ] ifFalse:[
+ self enqueueDelayedStartSyntaxHighlightProcess.
+ ].
+
+ [
+ codeView modifiedChannel removeDependent:self.
+ codeView modified:false.
+ self showCode:code scrollToTop:doScrollToTop.
+ ] ensure:[
+ codeView modifiedChannel addDependent:self.
+ ]
+ ] ifFalse:[
+ self showCode:code scrollToTop:doScrollToTop.
+ ].
].
navigationState lastMethodShownInCodeView: mthd.
"/ scroll, for file-based classes (java, ruby, etc.)
doShowFullClassSource ifTrue:[
- mthd sourceLineNumber ~~ 1 ifTrue:[
- doScrollToTop ifTrue:[ "/ifFalse:[
- codeView scrollToLine:mthd sourceLineNumber
- ]
- ].
+ mthd sourceLineNumber ~~ 1 ifTrue:[
+ doScrollToTop ifTrue:[ "/ifFalse:[
+ codeView scrollToLine:mthd sourceLineNumber
+ ]
+ ].
].
self codeAspect:(code ifNil:[nil] ifNotNil:[SyntaxHighlighter codeAspectMethod]).
self normalLabel.
@@ -53656,16 +53733,16 @@
self builder window beep
].
].
- box enterField
- onKey:#CursorDown
- leaveWith:[
- box listView windowGroup focusView:box listView byTab:true.
- box listView hasSelection ifFalse:[
- box listView selectFirst
- ] ifTrue:[
- box listView selectNext
- ]
- ].
+ box enterField
+ onKey:#CursorDown
+ leaveWith:[
+ box listView windowGroup focusView:box listView byTab:true.
+ box listView hasSelection ifFalse:[
+ box listView selectFirst
+ ] ifTrue:[
+ box listView selectNext
+ ]
+ ].
box open.
^ retVal
@@ -55368,7 +55445,6 @@
^ navigationState projectListApplication
! !
-
!NewSystemBrowser methodsFor:'private-history'!
lastSearchPatterns
@@ -55611,36 +55687,36 @@
explainTookTooLong := false.
withTimeout ifTrue:[
- explanation :=
- [ self explanationForCode:code short:short ]
- valueWithWatchDog:[explainTookTooLong := true]
- afterMilliseconds:200.
- ] ifFalse:[
- explanation := self explanationForCode:code short:short
+ explanation :=
+ [ self explanationForCode:code short:short ]
+ valueWithWatchDog:[explainTookTooLong := true]
+ afterMilliseconds:200.
+ ] ifFalse:[
+ explanation := self explanationForCode:code short:short
].
self activityNotification:nil.
explainTookTooLong ifTrue:[
- self showInfo:'Explain took too long - cancelled.'.
- ^ self.
+ self showInfo:'Explain took too long - cancelled.'.
+ ^ self.
].
explanation notEmptyOrNil ifTrue:[
- short ifTrue:[
- self showInfo:explanation
- ] ifFalse:[
- explanation isArray ifTrue:[
- html := explanation detect:[:entry | entry key == #html] ifNone:nil.
- html notNil ifTrue:[
- "/ todo: need a stripped down viewer (small, popup, modal)
- HTMLDocumentView openFullOnText:(html value).
- ^ self.
- ].
- explanation := explanation first value.
- ].
- self information:explanation
- ].
- builder window flush
+ short ifTrue:[
+ self showInfo:explanation
+ ] ifFalse:[
+ explanation isArray ifTrue:[
+ html := explanation detect:[:entry | entry key == #html] ifNone:nil.
+ html notNil ifTrue:[
+ "/ todo: need a stripped down viewer (small, popup, modal)
+ HTMLDocumentView openFullOnText:(html value).
+ ^ self.
+ ].
+ explanation := explanation first value.
+ ].
+ self information:explanation
+ ].
+ builder window flush
].
"Created: / 05-09-2006 / 10:37:04 / cg"
@@ -57716,7 +57792,7 @@
ex proceed.
] do:[
self withWaitCursorDo:[
- DoWhatIMeanSupport codeCompletionForClass:cls context:nil codeView:codeView.
+ DoWhatIMeanSupport codeCompletionForLanguage: cls programmingLanguage class:cls context:nil codeView:codeView.
]
].
^ self.
@@ -57766,6 +57842,7 @@
"Modified: / 04-07-2006 / 18:48:26 / fm"
"Modified: / 03-07-2011 / 16:18:31 / cg"
+ "Modified: / 18-09-2013 / 14:17:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
codeCompletionForMessage:node inClass:cls
@@ -58386,52 +58463,52 @@
code := codeArg asString.
returnValue := false.
language := languageOrNil
- ifNotNil: [languageOrNil]
- ifNil: [self hasMethodSelected
- ifTrue:[self selectedMethodsValue first programmingLanguage]
- ifFalse:[cls programmingLanguage]].
+ ifNotNil: [languageOrNil]
+ ifNil: [self hasMethodSelected
+ ifTrue:[self selectedMethodsValue first programmingLanguage]
+ ifFalse:[cls programmingLanguage]].
"/ a quick parse for the selector, to check if we overwrite an existing method...
newSelector := self selectorOfMethodFromCode:code in:cls.
existingMethod := cls compiledMethodAt:newSelector ifAbsent:[].
cat := self protocolToAcceptMethod:newSelector class:cls.
cat isNil ifTrue:[
- cat := cls isMeta
- ifTrue:[BrowserList nameListEntryForStatic]
- ifFalse:[BrowserList nameListEntryForNonStatic]
+ cat := cls isMeta
+ ifTrue:[BrowserList nameListEntryForStatic]
+ ifFalse:[BrowserList nameListEntryForNonStatic]
].
AbortOperationRequest catch:[
- (Class methodRedefinitionNotification) handle:[:ex |
- |answer|
-
- answer := SystemBrowser askForPackageChangeFrom:ex oldPackage to:ex newPackage.
- (answer ~~ #cancel) ifTrue:[
- ex proceedWith:answer
- ].
- ] do:[
- |codeView package oldMethod oldSelector defPackage answer rslt lang wasInstrumented|
-
- "/ used to be
- "/ oldSelector := self theSingleSelectedSelector.
- "/ here; however, with Ruby, a funny selector (fact) instead of fact: is returned...
- wasInstrumented := false.
-
- oldMethod := self theSingleSelectedMethod.
- oldMethod notNil ifTrue:[
- oldSelector := oldMethod selector.
- (oldSelector isNil and:[existingMethod notNil]) ifTrue:[
- "/ wrapped/unwrapped?
- true "(existingMethod isWrapped or:[existingMethod isMethodWithBreakpoints])" ifTrue:[
- oldSelector := existingMethod selector
- ]
- ].
- wasInstrumented := oldMethod isInstrumented.
- ].
-
- "/ check for overwritten version method
- (cls isMeta and:[(AbstractSourceCodeManager isVersionMethodSelector:newSelector)]) ifTrue:[
- (self confirm:'ATTENTION: you are about to accept the classes version method.
+ (Class methodRedefinitionNotification) handle:[:ex |
+ |answer|
+
+ answer := SystemBrowser askForPackageChangeFrom:ex oldPackage to:ex newPackage.
+ (answer ~~ #cancel) ifTrue:[
+ ex proceedWith:answer
+ ].
+ ] do:[
+ |codeView package oldMethod oldSelector defPackage answer rslt lang wasInstrumented|
+
+ "/ used to be
+ "/ oldSelector := self theSingleSelectedSelector.
+ "/ here; however, with Ruby, a funny selector (fact) instead of fact: is returned...
+ wasInstrumented := false.
+
+ oldMethod := self theSingleSelectedMethod.
+ oldMethod notNil ifTrue:[
+ oldSelector := oldMethod selector.
+ (oldSelector isNil and:[existingMethod notNil]) ifTrue:[
+ "/ wrapped/unwrapped?
+ true "(existingMethod isWrapped or:[existingMethod isMethodWithBreakpoints])" ifTrue:[
+ oldSelector := existingMethod selector
+ ]
+ ].
+ wasInstrumented := oldMethod isInstrumented.
+ ].
+
+ "/ check for overwritten version method
+ (cls isMeta and:[(AbstractSourceCodeManager isVersionMethodSelector:newSelector)]) ifTrue:[
+ (self confirm:'ATTENTION: you are about to accept the classes version method.
This method is required by the sourceCodeManager and should correctly return
the classes version as present in the source repository.
An incorrect version method may lead to failures when accessing/showing/changing
@@ -58439,137 +58516,137 @@
You have been warned.
Accept anyway ?')
- ifFalse:[
- ^ false
- ]
- ] ifFalse:[
- "/ check if accepting a different selector than the selected one,
- "/ and a method for the new selector exists.
- (existingMethod notNil and:[oldSelector ~= newSelector]) ifTrue:[
- "/ seems to be the same selector; however, we must really compile to see if it is not going
- "/ to end up in another namespace. In that case, we give a different warning message.
- Parser parseErrorSignal catch:[
- rslt := language compilerClass
- compile:code
- forClass:cls
- inCategory:cat
- notifying:nil
- install:false.
- ].
- (rslt notNil and:[ rslt nameSpace notNil ]) ifTrue:[
- newSelector := (':',rslt nameSpace name,'::',newSelector) asSymbol.
- existingMethod := cls compiledMethodAt:newSelector.
- ].
- ].
- (existingMethod notNil and:[oldSelector ~= newSelector]) ifTrue:[
- answer := OptionBox
- request:('You are about to overwrite an existing method.\\Accept anyway ?' withCRs)
- label:(resources string:'Attention')
- image:(WarningBox iconBitmap)
- buttonLabels:(resources array:#('Cancel' 'Compare' 'Yes'))
- values:#(false #compare true)
- default:false
- onCancel:false.
-
- answer == false ifTrue:[ ^ false ].
- answer == #compare ifTrue:[
- self openDiffViewForText:code againstSourceOfMethod:existingMethod.
- ^ false
- ].
- ]
- ].
-
- codeView := self codeView.
- codeView cursorMovementWhenUpdating:nil.
- codeView scrollWhenUpdating:nil.
-
- existingMethod notNil ifTrue:[
- "keep old package if selector does already exist in class"
- package := existingMethod package.
- ] ifFalse:[
- "/ JV: Used to be
- "/
- "/ cls theNonMetaclass canHaveExtensions ifFalse:[
- "/
- "/ but this is actually matter of method's language rather than class's language.
- "/ Otherwise we could not have Smalltalk (Ruby) extensions in Java classes!!
- "/
- (languageOrNil notNil and:[languageOrNil supportsExtensionMethods]) ifFalse:[
- defPackage := package := cls package.
- ] ifTrue:[
- defPackage := Class packageQuerySignal query.
- ].
-
- "/ if in project-mode,
- "/ assign the currently selected packageID (or ask, if there is none or multiple)
- "/ otherwise, use the current project
-
- (navigationState isProjectBrowser
- or:[navigationState organizerMode value == OrganizerCanvas organizerModeProject])
- ifTrue:[
- "/ JV: Used to be
- "/
- "/ cls theNonMetaclass canHaveExtensions ifFalse:[
- "/
- "/ but this is actually matter of method's language rather than class's language.
- "/ Otherwise we could not have Smalltalk (Ruby) extensions in Java classes!!
- "/
- (languageOrNil notNil and:[languageOrNil supportsExtensionMethods]) ifTrue:[
- package := self theSingleSelectedProject.
- ].
- package isNil ifTrue:[
- package := self
- askForProject:'Method shall be assigned to which project ?'
- initialText:(LastAcceptPackage ? cls package).
- package isNil ifTrue:[^ false].
- LastAcceptPackage := package.
- ] ifFalse:[
- package := package asSymbol.
- "/ if the current project is different from the selected one
- package ~= defPackage ifTrue:[
- "/ and the current project is not the default project
- (defPackage = PackageId noProjectID) ifFalse:[
- "/ ask
- package := self
- askForProject:('The browsers selected project is ''%1''\however, your currently active (default) project is ''%2''.\\To which project shall the method be assigned ?'
- bindWith:package allBold with:defPackage allBold) withCRs
- initialText:package.
- package isNil ifTrue:[^ false].
- LastAcceptPackage := package.
- ]
- ]
- ].
- ].
- package isNil ifTrue:[ package := defPackage ].
- ].
-
- lang := oldMethod notNil
- ifTrue:[ oldMethod programmingLanguage ]
- ifFalse:[ cls programmingLanguage ].
-
- "/ notice: when compiling, the classes change message will already
- "/ be noticed by the methodList and lead to an update
- "/ to be enqueued.
-
- [
- |codeCritics|
-
- "/ cg: for now, only smalltalk critics is possible...
- (self enforceCodeStyle and:[lang isSmalltalk]) ifTrue:[
- codeCritics := CodeCritics checkCodeQuality:code.
- codeCritics notNil ifTrue:[
- codeCritics do:[:eachCritic |
- codeView
- highlightingErrorLine:(eachCritic key)
- do:[
- Dialog
- warn:(resources
- stringWithCRs:'Ugly code warning\\ %1\\Please beautify.'
- with:eachCritic value allBold).
- ].
- ].
- ].
- ].
+ ifFalse:[
+ ^ false
+ ]
+ ] ifFalse:[
+ "/ check if accepting a different selector than the selected one,
+ "/ and a method for the new selector exists.
+ (existingMethod notNil and:[oldSelector ~= newSelector]) ifTrue:[
+ "/ seems to be the same selector; however, we must really compile to see if it is not going
+ "/ to end up in another namespace. In that case, we give a different warning message.
+ Parser parseErrorSignal catch:[
+ rslt := language compilerClass
+ compile:code
+ forClass:cls
+ inCategory:cat
+ notifying:nil
+ install:false.
+ ].
+ (rslt notNil and:[ rslt nameSpace notNil ]) ifTrue:[
+ newSelector := (':',rslt nameSpace name,'::',newSelector) asSymbol.
+ existingMethod := cls compiledMethodAt:newSelector.
+ ].
+ ].
+ (existingMethod notNil and:[oldSelector ~= newSelector]) ifTrue:[
+ answer := OptionBox
+ request:('You are about to overwrite an existing method.\\Accept anyway ?' withCRs)
+ label:(resources string:'Attention')
+ image:(WarningBox iconBitmap)
+ buttonLabels:(resources array:#('Cancel' 'Compare' 'Yes'))
+ values:#(false #compare true)
+ default:false
+ onCancel:false.
+
+ answer == false ifTrue:[ ^ false ].
+ answer == #compare ifTrue:[
+ self openDiffViewForText:code againstSourceOfMethod:existingMethod.
+ ^ false
+ ].
+ ]
+ ].
+
+ codeView := self codeView.
+ codeView cursorMovementWhenUpdating:nil.
+ codeView scrollWhenUpdating:nil.
+
+ existingMethod notNil ifTrue:[
+ "keep old package if selector does already exist in class"
+ package := existingMethod package.
+ ] ifFalse:[
+ "/ JV: Used to be
+ "/
+ "/ cls theNonMetaclass canHaveExtensions ifFalse:[
+ "/
+ "/ but this is actually matter of method's language rather than class's language.
+ "/ Otherwise we could not have Smalltalk (Ruby) extensions in Java classes!!
+ "/
+ (languageOrNil notNil and:[languageOrNil supportsExtensionMethods]) ifFalse:[
+ defPackage := package := cls package.
+ ] ifTrue:[
+ defPackage := Class packageQuerySignal query.
+ ].
+
+ "/ if in project-mode,
+ "/ assign the currently selected packageID (or ask, if there is none or multiple)
+ "/ otherwise, use the current project
+
+ (navigationState isProjectBrowser
+ or:[navigationState organizerMode value == OrganizerCanvas organizerModeProject])
+ ifTrue:[
+ "/ JV: Used to be
+ "/
+ "/ cls theNonMetaclass canHaveExtensions ifFalse:[
+ "/
+ "/ but this is actually matter of method's language rather than class's language.
+ "/ Otherwise we could not have Smalltalk (Ruby) extensions in Java classes!!
+ "/
+ (languageOrNil notNil and:[languageOrNil supportsExtensionMethods]) ifTrue:[
+ package := self theSingleSelectedProject.
+ ].
+ package isNil ifTrue:[
+ package := self
+ askForProject:'Method shall be assigned to which project ?'
+ initialText:(LastAcceptPackage ? cls package).
+ package isNil ifTrue:[^ false].
+ LastAcceptPackage := package.
+ ] ifFalse:[
+ package := package asSymbol.
+ "/ if the current project is different from the selected one
+ package ~= defPackage ifTrue:[
+ "/ and the current project is not the default project
+ (defPackage = PackageId noProjectID) ifFalse:[
+ "/ ask
+ package := self
+ askForProject:('The browsers selected project is ''%1''\however, your currently active (default) project is ''%2''.\\To which project shall the method be assigned ?'
+ bindWith:package allBold with:defPackage allBold) withCRs
+ initialText:package.
+ package isNil ifTrue:[^ false].
+ LastAcceptPackage := package.
+ ]
+ ]
+ ].
+ ].
+ package isNil ifTrue:[ package := defPackage ].
+ ].
+
+ lang := oldMethod notNil
+ ifTrue:[ oldMethod programmingLanguage ]
+ ifFalse:[ cls programmingLanguage ].
+
+ "/ notice: when compiling, the classes change message will already
+ "/ be noticed by the methodList and lead to an update
+ "/ to be enqueued.
+
+ [
+ |codeCritics|
+
+ "/ cg: for now, only smalltalk critics is possible...
+ (self enforceCodeStyle and:[lang isSmalltalk]) ifTrue:[
+ codeCritics := CodeCritics checkCodeQuality:code.
+ codeCritics notNil ifTrue:[
+ codeCritics do:[:eachCritic |
+ codeView
+ highlightingErrorLine:(eachCritic key)
+ do:[
+ Dialog
+ warn:(resources
+ stringWithCRs:'Ugly code warning\\ %1\\Please beautify.'
+ with:eachCritic value allBold).
+ ].
+ ].
+ ].
+ ].
"/ done elsewhere
"/ self enforceComment ifTrue:[
"/ "/ allow simple getters, setters, basicNew etc...
@@ -58581,122 +58658,122 @@
"/ ].
"/ ].
- "/ do not react on the methodSelectionChanged notification
- "/ (which is enforced by the methodList)
- self selectedMethods retractInterestsFor:self.
- "/ self immediateUpdate value:true.
-
- "/ Transcript showCR:'accepting in package: ', (package ? '__NoPackage__').
- Class packageQuerySignal answer:package do:[ |change|
- ClassDescription updateHistoryLineQuerySignal answer:true do:[
- (ClassDescription updateChangeFileQuerySignal
- , ClassDescription updateChangeListQuerySignal) answer:self suppressChangeSetUpdate not
- do:[
+ "/ do not react on the methodSelectionChanged notification
+ "/ (which is enforced by the methodList)
+ self selectedMethods retractInterestsFor:self.
+ "/ self immediateUpdate value:true.
+
+ "/ Transcript showCR:'accepting in package: ', (package ? '__NoPackage__').
+ Class packageQuerySignal answer:package do:[ |change|
+ ClassDescription updateHistoryLineQuerySignal answer:true do:[
+ (ClassDescription updateChangeFileQuerySignal
+ , ClassDescription updateChangeListQuerySignal) answer:self suppressChangeSetUpdate not
+ do:[
Class nameSpaceQuerySignal
answer:(self currentNamespace)
do:[
- ("self canUseRefactoringSupport"
- language isSmalltalk
- and:[(environment at:cls theNonMetaclass name)==cls
- and:[cls programmingLanguage == language
- and:[InteractiveAddMethodChange notNil]]]
- ) ifTrue:[
- "/ cg: Q: is the AddMethodChange prepared for languages ?
- change := InteractiveAddMethodChange compile:code in:cls classified:cat.
- change controller:codeView.
- "/ change named:('Accept method ' , newSelector ? '???').
- Parser parseErrorSignal handle:[:ex |
- rslt := nil
- ] do:[
- RefactoryChangeManager performChange: change.
- rslt := cls compiledMethodAt:newSelector.
- ]
- ] ifFalse:[
- rslt := language compilerClass
- compile:code
- forClass:cls
- inCategory:cat
- notifying:codeView
- install:true.
- ].
- wasInstrumented ifTrue:[
- rslt := InstrumentingCompiler
- compile:code
- forClass:cls
- inCategory:cat
- notifying:nil
- install:true.
- ].
+ ("self canUseRefactoringSupport"
+ language isSmalltalk
+ and:[(environment at:cls theNonMetaclass name)==cls
+ and:[cls programmingLanguage == language
+ and:[InteractiveAddMethodChange notNil]]]
+ ) ifTrue:[
+ "/ cg: Q: is the AddMethodChange prepared for languages ?
+ change := InteractiveAddMethodChange compile:code in:cls classified:cat.
+ change controller:codeView.
+ "/ change named:('Accept method ' , newSelector ? '???').
+ Parser parseErrorSignal handle:[:ex |
+ rslt := nil
+ ] do:[
+ RefactoryChangeManager performChange: change.
+ rslt := cls compiledMethodAt:newSelector.
+ ]
+ ] ifFalse:[
+ rslt := language compilerClass
+ compile:code
+ forClass:cls
+ inCategory:cat
+ notifying:codeView
+ install:true.
+ ].
+ wasInstrumented ifTrue:[
+ rslt := InstrumentingCompiler
+ compile:code
+ forClass:cls
+ inCategory:cat
+ notifying:nil
+ install:true.
+ ].
].
- ].
- ].
- ].
-
-
- "/ give subcanvases a chance to synchronize ...
-
- "/ self immediateUpdate value:true.
-
- rslt isMethod ifTrue:[
+ ].
+ ].
+ ].
+
+
+ "/ give subcanvases a chance to synchronize ...
+
+ "/ self immediateUpdate value:true.
+
+ rslt isMethod ifTrue:[
"/ rslt resourceType == #image ifTrue:[
"/ Icon flushCachedIcons
"/ ].
- rslt package. "/ sigh: has side effect of setting the instvar in the method (is this needed?)
- navigationState realModifiedState:false.
- codeView modified:false.
-
- "/ immediateUpdate value:true.
- "/ self switchToSelector:rslt selector.
-
- codeView cursorMovementWhenUpdating:nil.
- codeView scrollWhenUpdating:nil.
- codeView setSearchPattern:nil.
- lastMethodCategory := rslt category.
-
- (self selectedProtocolsValue contains:[:p | p string = lastMethodCategory]) ifFalse:[
- (self selectedProtocolsValue includes:BrowserList nameListEntryForALL) ifFalse:[
- "/ self selectedProtocols setValue:(Array with:rslt category).
- self selectProtocols:(Array with:lastMethodCategory).
- ]
- ].
-
- oldSelector ~= rslt selector ifTrue:[
- self selectedMethods value:(Array with:rslt).
- "/ self switchToSelector:rslt selector
- ] ifFalse:[
+ rslt package. "/ sigh: has side effect of setting the instvar in the method (is this needed?)
+ navigationState realModifiedState:false.
+ codeView modified:false.
+
+ "/ immediateUpdate value:true.
+ "/ self switchToSelector:rslt selector.
+
+ codeView cursorMovementWhenUpdating:nil.
+ codeView scrollWhenUpdating:nil.
+ codeView setSearchPattern:nil.
+ lastMethodCategory := rslt category.
+
+ (self selectedProtocolsValue contains:[:p | p string = lastMethodCategory]) ifFalse:[
+ (self selectedProtocolsValue includes:BrowserList nameListEntryForALL) ifFalse:[
+ "/ self selectedProtocols setValue:(Array with:rslt category).
+ self selectProtocols:(Array with:lastMethodCategory).
+ ]
+ ].
+
+ oldSelector ~= rslt selector ifTrue:[
+ self selectedMethods value:(Array with:rslt).
+ "/ self switchToSelector:rslt selector
+ ] ifFalse:[
"/ "/ do not notify myself (to avoid scroll-to-top)
"/
"/ self selectedMethods value:(Array with:rslt).
- ].
+ ].
"/ self showMethodsCode:rslt scrollToTop:false.
"/ self selectedMethods setValue:(Array with:rslt).
"/ self switchToClass:cls selector:rslt selector.
- immediateUpdate value:false.
- doCheck ifTrue:[
- self checkAcceptedMethod:rslt inClass:cls.
- ].
+ immediateUpdate value:false.
+ doCheck ifTrue:[
+ self checkAcceptedMethod:rslt inClass:cls.
+ ].
"/ wasInstrumented ifTrue:[
"/ self recompileMethodWithInstrumentation:rslt.
"/ ].
- returnValue := true.
- "/ self updateBufferLabel.
- ].
- ] ensure:[
- "/ do again react on the methodSelectionChanged notification
- "/ JV: MUST do it asynchronously because the update is caught
- "/ by method list which updates its selection ASYNCHRONOUSLY.
- "/ so by pushing this into even queue we make sure that
- "/ we re-register ourself AFTER all such delayed updates are
- "/ processed.
- self window sensor pushAction:[
- self selectedMethods onChangeSend:#methodsSelectionChanged to:self.
- ].
- immediateUpdate value:false.
- ].
- ]
+ returnValue := true.
+ "/ self updateBufferLabel.
+ ].
+ ] ensure:[
+ "/ do again react on the methodSelectionChanged notification
+ "/ JV: MUST do it asynchronously because the update is caught
+ "/ by method list which updates its selection ASYNCHRONOUSLY.
+ "/ so by pushing this into even queue we make sure that
+ "/ we re-register ourself AFTER all such delayed updates are
+ "/ processed.
+ self window sensor pushAction:[
+ self selectedMethods onChangeSend:#methodsSelectionChanged to:self.
+ ].
+ immediateUpdate value:false.
+ ].
+ ]
].
^ returnValue.
@@ -60811,11 +60888,11 @@
!NewSystemBrowser class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1984 2013-09-16 15:12:57 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1986 2013-09-18 13:45:33 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1984 2013-09-16 15:12:57 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1986 2013-09-18 13:45:33 cg Exp $'
!
version_HG
@@ -60824,7 +60901,7 @@
!
version_SVN
- ^ '$Id: Tools__NewSystemBrowser.st,v 1.1984 2013-09-16 15:12:57 cg Exp $'
+ ^ '$Id: Tools__NewSystemBrowser.st,v 1.1986 2013-09-18 13:45:33 cg Exp $'
! !