--- a/AbstractFileApplicationNoteBookComponent.st Fri Mar 15 10:14:37 2013 +0000
+++ b/AbstractFileApplicationNoteBookComponent.st Fri Mar 22 09:21:23 2013 +0000
@@ -41,6 +41,7 @@
"
! !
+
!AbstractFileApplicationNoteBookComponent class methodsFor:'defaults'!
tabStringFor:aApplicationType
@@ -58,6 +59,7 @@
"Created: / 01-03-2007 / 21:35:39 / cg"
! !
+
!AbstractFileApplicationNoteBookComponent class methodsFor:'queries'!
canOpenItem:anItem
@@ -74,6 +76,7 @@
^ true
! !
+
!AbstractFileApplicationNoteBookComponent methodsFor:'accessing'!
notify:msg
@@ -101,6 +104,7 @@
sameFileIndex := something.
! !
+
!AbstractFileApplicationNoteBookComponent methodsFor:'actions'!
changeItem:anItem
@@ -121,6 +125,7 @@
^ true
! !
+
!AbstractFileApplicationNoteBookComponent methodsFor:'aspects'!
cursorColLabelHolder
@@ -149,6 +154,7 @@
"Created: / 11-09-2006 / 12:32:37 / cg"
! !
+
!AbstractFileApplicationNoteBookComponent methodsFor:'drag & drop support'!
doStartDrag:aDropSource in:aView
@@ -165,6 +171,7 @@
hdl startDragFrom:aView dropSource:aDropSource offset:#topLeft
! !
+
!AbstractFileApplicationNoteBookComponent methodsFor:'queries'!
additionalInfo
@@ -179,6 +186,10 @@
"Created: / 27-01-2012 / 15:00:22 / cg"
!
+cvsMenusAreShown
+ ^ ConfigurableFeatures includesFeature: #CVSSupportEnabled
+!
+
fileName
item notNil ifTrue:[
^ item fileName.
@@ -323,6 +334,7 @@
^ (self type == #directoryDescription)
! !
+
!AbstractFileApplicationNoteBookComponent methodsFor:'resources'!
resources
@@ -332,14 +344,15 @@
^ super resources
! !
+
!AbstractFileApplicationNoteBookComponent class methodsFor:'documentation'!
version
- ^ '$Id: AbstractFileApplicationNoteBookComponent.st 7854 2012-01-30 17:49:41Z vranyj1 $'
+ ^ '$Header: /cvs/stx/stx/libtool/AbstractFileApplicationNoteBookComponent.st,v 1.24 2013-03-20 19:55:23 cg Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libtool/AbstractFileApplicationNoteBookComponent.st,v 1.23 2012/01/27 14:01:09 cg Exp §'
+ ^ '$Header: /cvs/stx/stx/libtool/AbstractFileApplicationNoteBookComponent.st,v 1.24 2013-03-20 19:55:23 cg Exp $'
!
version_HG
--- a/AbstractFileBrowser.st Fri Mar 15 10:14:37 2013 +0000
+++ b/AbstractFileBrowser.st Fri Mar 22 09:21:23 2013 +0000
@@ -1393,6 +1393,12 @@
isVisible: systemIsDOS
)
(MenuItem
+ label: 'Open Finder'
+ itemValue: doOpenFinder
+ translateLabel: true
+ isVisible: systemIsOSX
+ )
+ (MenuItem
label: 'C Browser'
itemValue: doOpenCBrowser
translateLabel: true
@@ -1669,6 +1675,7 @@
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
+
"
MenuEditor new openOnClass:AbstractFileBrowser andSelector:#fileMenu
(Menu new fromLiteralArrayEncoding:(AbstractFileBrowser fileMenu)) startUp
@@ -1682,7 +1689,6 @@
(MenuItem
label: 'Open'
itemValue: doShowFileContents
- translateLabel: true
)
(MenuItem
label: '-'
@@ -1691,20 +1697,22 @@
enabled: hasFileSelection
label: 'FileIn'
itemValue: fileFileIn
- translateLabel: true
)
(MenuItem
enabled: hasFileSelection
label: 'FileIn to Namespace...'
itemValue: fileFileInToNameSpace
- translateLabel: true
+ )
+ (MenuItem
+ enabled: hasPackageDirectorySelected
+ label: 'Load Package from Here'
+ itemValue: fileFileInPackage
)
(MenuItem
label: '-'
)
(MenuItem
label: 'New'
- translateLabel: true
submenuChannel: newMenu
keepLinkedMenu: true
)
@@ -1715,31 +1723,26 @@
enabled: hasSelection
label: 'Cut'
itemValue: cutFiles
- translateLabel: true
)
(MenuItem
enabled: hasSelection
label: 'Copy'
itemValue: copyFiles
- translateLabel: true
)
(MenuItem
enabled: canPaste
label: 'Paste'
itemValue: pasteFiles
- translateLabel: true
)
(MenuItem
enabled: hasSelection
label: 'Delete'
itemValue: deleteFiles
- translateLabel: true
)
(MenuItem
enabled: hasSelection
label: 'Erase'
itemValue: eraseFiles
- translateLabel: true
)
(MenuItem
label: '-'
@@ -1748,26 +1751,22 @@
enabled: hasSelection
label: 'Rename...'
itemValue: renameSelection
- translateLabel: true
shortcutKey: Rename
)
(MenuItem
enabled: hasSelection
label: 'Move To...'
itemValue: moveSelectionTo
- translateLabel: true
)
(MenuItem
enabled: hasSelection
label: 'Copy To...'
itemValue: copySelectionTo
- translateLabel: true
)
(MenuItem
enabled: hasSelection
label: 'Properties...'
itemValue: doShowProperties
- translateLabel: true
)
(MenuItem
label: '-'
@@ -1776,25 +1775,21 @@
(MenuItem
enabled: canAddToClassPath
label: 'Add to Java Class Path'
- translateLabel: true
isVisible: javaSupportLoaded
)
(MenuItem
enabled: canRemoveFromClassPath
label: 'Remove from Java Class Path'
- translateLabel: true
isVisible: javaSupportLoaded
)
(MenuItem
enabled: canAddToSourcePath
label: 'Add to Java Source Path'
- translateLabel: true
isVisible: javaSupportLoaded
)
(MenuItem
enabled: canRemoveFromSourcePath
label: 'Remove from Java Source Path'
- translateLabel: true
isVisible: javaSupportLoaded
)
(MenuItem
@@ -1803,15 +1798,12 @@
(MenuItem
enabled: enableFileHistory
label: 'File History'
- translateLabel: true
submenuChannel: menuFileHistory
)
)
nil
nil
)
-
- "Modified: / 07-02-2007 / 18:44:54 / cg"
!
fileOpMenu
@@ -4279,7 +4271,7 @@
directoryOrNil isNil ifTrue:[
dir := self theSingleSelectedDirectoryOrNil.
dir isNil ifTrue:[
- Dialog warn:'Please select a single directory.'.
+ Dialog warn:(resources string:'Please select a single directory.').
AbortSignal raise.
^ nil
].
@@ -5694,36 +5686,53 @@
self killAllRunningBackgroundProcesses.
toRemove := OrderedCollection new.
- executionBlock := [ : stream |
- |cmd logArg|
-
- OperatingSystem isMSWINDOWSlike ifTrue:[
- logArg := '-m "' , 'removed via FileBrowser' , '"'.
- ] ifFalse:[
- logArg := '-m ''' , 'removed via FileBrowser' , ''''.
- ].
-
- filesToRemove do:[:fileName |
- OperatingSystem accessDeniedErrorSignal handle:[:ex|
- "was not able to remove it"
- | lastError msg |
- lastError := OperatingSystem lastErrorString.
- msg := (resources string:'cannot remove ''%1'' !!' with:fileName).
- lastError isNil ifFalse:[
- msg := msg , '\\(' , lastError , ')'
+ executionBlock :=
+ [:stream |
+ |cmd logArg prevDir prevFiles|
+
+ OperatingSystem isMSWINDOWSlike ifTrue:[
+ logArg := '-m "' , 'removed via FileBrowser' , '"'.
+ ] ifFalse:[
+ logArg := '-m ''' , 'removed via FileBrowser' , ''''.
+ ].
+ prevFiles := ''.
+
+ filesToRemove do:[:fileName |
+ |dir file|
+
+ dir := fileName directory.
+ (prevDir notNil and:[prevDir ~= dir]) ifTrue:[
+ cmd := 'cvs commit -l ',logArg, ' ',prevFiles.
+ "/ Transcript show:prevDir; space; showCR:cmd.
+ (self getExecutionBlockForCommand:cmd inDirectory:prevDir) value:stream.
+ prevFiles := ''.
].
- Dialog warn:msg withCRs
- ] do:[
- (fileName isSymbolicLink) ifFalse:[
- fileName remove.
- cmd := ('cvs remove -f "',fileName baseName,'"').
- (self getExecutionBlockForCommand:cmd) value:stream.
- ]
+
+ OperatingSystem accessDeniedErrorSignal handle:[:ex|
+ "was not able to remove it"
+ | lastError msg |
+ lastError := OperatingSystem lastErrorString.
+ msg := (resources string:'cannot remove ''%1'' !!' with:fileName).
+ lastError isNil ifFalse:[
+ msg := msg , '\\(' , lastError , ')'
+ ].
+ Dialog warn:msg withCRs
+ ] do:[
+ (fileName isSymbolicLink) ifFalse:[
+ fileName remove.
+ file := fileName baseName.
+ cmd := ('cvs remove -f "',file,'"').
+ (self getExecutionBlockForCommand:cmd inDirectory:dir) value:stream.
+ "/ Transcript show:dir; space; showCR:cmd.
+ ]
+ ].
+ prevDir := dir.
+ prevFiles := prevFiles,' ',file.
].
- ].
- cmd := 'cvs commit -l ',logArg.
- (self getExecutionBlockForCommand:cmd) value:stream.
- ].
+ cmd := 'cvs commit -l ',logArg, ' ',prevFiles.
+ "/ Transcript show:prevDir; space; showCR:cmd.
+ (self getExecutionBlockForCommand:cmd inDirectory:prevDir) value:stream.
+ ].
nameString := 'Command> cvs remove and commit ', filesToRemove first baseName.
filesToRemove size > 1 ifTrue:[
nameString := nameString, ' ...'.
@@ -5732,28 +5741,10 @@
!
cvsRemoveFileAndCVSContainer
- |sel question aswer|
-
- sel := self currentSelectedFiles copy.
- sel size > 0 ifTrue:[
- sel size > 1 ifTrue:[
- question := resources string:'Remove %1 selected files and their CVS containers ?' with:(sel size)
- ] ifFalse:[
- question := resources string:'Remove ''%1'' and its CVS container ?' with:(sel first baseName allBold)
- ].
-
- aswer := Dialog
- confirm:question withCRs
- yesLabel:(resources string:'Remove')
- noLabel:(resources string:'Cancel').
- aswer ifTrue:[
- self withActivityIndicationDo:[
- self cvsRemoveAndRemoveFromCVS:sel
- ]
- ]
- ]
-
- "Modified: / 25-07-2006 / 09:07:09 / cg"
+ |files|
+
+ files := self currentSelectedFiles copy.
+ self removeFilesAndCVSContainers:files
!
cvsRevisionLog
@@ -5850,6 +5841,29 @@
stream nextPutAll:'" '.
].
^ stream contents.
+!
+
+removeFilesAndCVSContainers:files
+ |numFiles question aswer|
+
+ (numFiles := files size) > 0 ifTrue:[
+ numFiles > 1 ifTrue:[
+ question := resources string:'Remove %1 selected files and their CVS containers ?' with:numFiles
+ ] ifFalse:[
+ question := resources string:'Remove ''%1'' and its CVS container ?' with:(files first baseName allBold)
+ ].
+
+ aswer := Dialog
+ confirm:question withCRs
+ yesLabel:(resources string:'Remove')
+ noLabel:(resources string:'Cancel').
+
+ aswer ifTrue:[
+ self withActivityIndicationDo:[
+ self cvsRemoveAndRemoveFromCVS:files
+ ]
+ ]
+ ]
! !
@@ -6418,6 +6432,12 @@
"Modified: / 21-07-2012 / 12:28:36 / cg"
!
+doOpenFinder
+ self currentDirectory asFilename openFinder
+
+ "Modified: / 21-07-2012 / 12:28:36 / cg"
+!
+
doOpenSettings
self openSettingsDialog
!
@@ -6519,6 +6539,29 @@
"Modified: / 20-09-2006 / 14:29:24 / cg"
!
+fileFileInPackage
+ "assuming the current directory is a package directory, load it"
+
+ |packageDir dir path top packageID|
+
+ "/ find a reasonable package-id (walk up until we find stx)
+ path := ''.
+ dir := packageDir := self currentDirectory.
+
+ top := (Smalltalk projectDirectoryForPackage:'stx') asFilename.
+ [ (dir / 'stx') = top ] whileFalse:[
+ path := dir baseName , '/' , path.
+ dir := dir directory.
+ dir isNil ifTrue:[
+ Dialog warning:'Could not find a path from "stx" to the current directory.'.
+ "/ should ask the user for a packageID and proceed...
+ ^ self.
+ ].
+ ].
+ packageID := path copyWithoutLast:1.
+ Smalltalk loadPackage:packageID fromDirectory:packageDir asAutoloaded:true
+!
+
fileFileInToNameSpace
"fileIn the selected file(s)<into a nameSpace"
@@ -8548,6 +8591,11 @@
^ OperatingSystem isMSDOSlike
!
+systemIsOSX
+
+ ^ OperatingSystem isOSXlike
+!
+
systemIsUnix
^ OperatingSystem isUNIXlike
! !
@@ -8588,6 +8636,14 @@
"Modified: / 04-12-2006 / 13:14:25 / cg"
!
+compressTabsOnSave
+ "if true, compress leading spaces (multiples of 8) with a tab character
+ when saving.
+ Default is true"
+
+ ^ true
+!
+
currentFilesAreInSameDirectory
^ self parentDirectoriesOfCurrentFiles size < 2
@@ -8709,6 +8765,15 @@
^ nil
!
+hasPackageDirectorySelected
+ |dir|
+
+ dir := self currentDirectory.
+ ^ dir notNil
+ and:[ dir exists
+ and:[ (dir / 'abbrev.stc') exists ]]
+!
+
parentDirectoriesOfCurrentFiles
^ self currentSelectedObjects
collect:[:file | file directory] as:Set
@@ -9278,11 +9343,11 @@
!AbstractFileBrowser class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/AbstractFileBrowser.st,v 1.512 2013-03-02 13:19:08 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/AbstractFileBrowser.st,v 1.516 2013-03-21 11:50:39 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/AbstractFileBrowser.st,v 1.512 2013-03-02 13:19:08 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/AbstractFileBrowser.st,v 1.516 2013-03-21 11:50:39 cg Exp $'
!
version_HG
--- a/AbstractLauncherApplication.st Fri Mar 15 10:14:37 2013 +0000
+++ b/AbstractLauncherApplication.st Fri Mar 22 09:21:23 2013 +0000
@@ -621,7 +621,8 @@
genLabel := [:v |
- |app appName busyOrNot sensor pending process|
+ |app appName busyOrNot iconifiedOrNot
+ sensor pending process|
app := v application.
appName := (app isNil
@@ -640,7 +641,11 @@
]
]
].
- appName,'"',(v label ? 'aView'),'"',busyOrNot
+ iconifiedOrNot := ''.
+ v topView isCollapsed ifTrue:[
+ iconifiedOrNot := ' (iconified)' colorizeAllWith:Color blue.
+ ].
+ appName,'"',(v label ? 'aView'),'"',busyOrNot,iconifiedOrNot
].
knownTopViews := IdentitySet new.
@@ -2131,12 +2136,15 @@
"after a second (to allow redraw of views under menu ...),
save a view's contents as bitmap image."
- aView topView raiseDeiconified.
- aView topView makeFullyVisible.
+ |top|
+
+ top := aView topView.
+ top raiseDeiconified; makeFullyVisible.
+
"do a pushEvent, in case its me myself and I have to redraw first..."
self enqueueDelayedAction:[
Delay waitForSeconds:1. "/ give view a chance to redraw itself.
- self saveScreenImage:(Image fromView:(aView topView)) defaultName:'hardcopy'
+ self saveScreenImage:(Image fromView:top) defaultName:'hardcopy'
].
aView windowGroup processExposeEvents
@@ -6995,11 +7003,11 @@
!AbstractLauncherApplication class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/AbstractLauncherApplication.st,v 1.423 2012-11-26 11:24:30 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/AbstractLauncherApplication.st,v 1.425 2013-03-21 20:17:09 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/AbstractLauncherApplication.st,v 1.423 2012-11-26 11:24:30 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/AbstractLauncherApplication.st,v 1.425 2013-03-21 20:17:09 cg Exp $'
!
version_HG
--- a/AbstractSettingsApplication.st Fri Mar 15 10:14:37 2013 +0000
+++ b/AbstractSettingsApplication.st Fri Mar 22 09:21:23 2013 +0000
@@ -16274,6 +16274,63 @@
! !
+!AbstractSettingsApplication::SystemBrowserSettingsAppl class methodsFor:'help specs'!
+
+helpSpec
+ "This resource specification was automatically generated
+ by the UIHelpTool of ST/X."
+
+ "Do not manually edit this!! If it is corrupted,
+ the UIHelpTool may not be able to read the specification."
+
+ "
+ UIHelpTool openOnClass:AbstractSettingsApplication::SystemBrowserSettingsAppl
+ "
+
+ <resource: #help>
+
+ ^ super helpSpec addPairsFrom:#(
+
+#compactSCMLayout
+'Arrange source code manager menu items in a compact layout'
+
+#inPlaceSearch
+'In-place search to browser lists'
+
+#inlineSCMLayout
+'Arrange source code manager menu items in a falt inline layout'
+
+#oldSCMMenuLayout
+'Arrange source code manager menu items in the old, traditional layout'
+
+#searchBarInBrowser
+'Add a search bar to the browser (like in web browsers)'
+
+#showBookmarksBar
+'Show the bookmarks bar'
+
+#showGlobalHistory
+'Show a toolbar button to navigate the global visited classes history'
+
+#showLocalHistory
+'Show a toolbar button to navigate the local (per browser) visited classes history'
+
+#showMethodTemplate
+'Show a method code template when no method is selected'
+
+#sortAndIndentClassesByInheritance
+'Sort and indent classes by inheritance within a category (as opposed to sorting by name)'
+
+#useEmbeddedTestRunner
+'Show a panel to start sUnit tests, whenever a testcase class is selected'
+
+#webBrowserLikeLayout
+'Use a layout similar to web browsers'
+
+)
+! !
+
+
!AbstractSettingsApplication::SystemBrowserSettingsAppl class methodsFor:'image specs'!
defaultIcon
@@ -16346,13 +16403,24 @@
(CheckBoxSpec
label: 'Use the Embedded Test Runner'
name: 'UseEmbeddedTestRunner'
+ activeHelpKey: useEmbeddedTestRunner
model: showEmbeddedTestRunnerInBrowser
translateLabel: true
extent: (Point 579 25)
)
(CheckBoxSpec
+ label: 'Web Browser Like Layout (Toolbars are Part of the Tab - experimental)'
+ name: 'CheckBox1'
+ activeHelpKey: webBrowserLikeLayout
+ initiallyInvisible: true
+ model: webBrowserLikeLayout
+ translateLabel: true
+ extent: (Point 607 25)
+ )
+ (CheckBoxSpec
label: 'Show Bookmarks Bar'
name: 'ShowBookmarksBar'
+ activeHelpKey: showBookmarksBar
model: showBookmarkBar
translateLabel: true
extent: (Point 579 25)
@@ -16360,21 +16428,15 @@
(CheckBoxSpec
label: 'Sort and Indent Classes by Inheritance'
name: 'SortAndIndentClassesByInheritance'
+ activeHelpKey: sortAndIndentClassesByInheritance
model: sortAndIndentClassesByInheritance
translateLabel: true
extent: (Point 579 25)
)
(CheckBoxSpec
- label: 'Web Browser Like Layout (Toolbars are Part of the Tab - experimental)'
- name: 'CheckBox1'
- initiallyInvisible: true
- model: webBrowserLikeLayout
- translateLabel: true
- extent: (Point 607 25)
- )
- (CheckBoxSpec
label: 'Show Local Navigation History (Separate History per Browser Tab)'
name: 'CheckBox2'
+ activeHelpKey: showLocalHistory
model: showLocalHistory
translateLabel: true
extent: (Point 579 25)
@@ -16382,6 +16444,7 @@
(CheckBoxSpec
label: 'Show Global Navigation History (Global History for all Browsers)'
name: 'CheckBox3'
+ activeHelpKey: showGlobalHistory
model: showGlobalHistory
translateLabel: true
extent: (Point 579 25)
@@ -16389,6 +16452,7 @@
(CheckBoxSpec
label: 'Show Search Bar in Browser'
name: 'ShowSearchBarInBrowser'
+ activeHelpKey: searchBarInBrowser
model: useSearchBarInBrowser
translateLabel: true
extent: (Point 579 25)
@@ -16396,6 +16460,7 @@
(CheckBoxSpec
label: 'Use in-place Search in Browser Lists (experimental)'
name: 'CheckBox4'
+ activeHelpKey: inPlaceSearch
model: useInPlaceSearchInBrowserLists
translateLabel: true
extent: (Point 579 22)
@@ -16403,6 +16468,7 @@
(CheckBoxSpec
label: 'Show Method Template'
name: 'MethodTemplate'
+ activeHelpKey: showMethodTemplate
model: showMethodTemplate
translateLabel: true
extent: (Point 579 25)
@@ -16438,6 +16504,7 @@
(RadioButtonSpec
label: 'Old (default)'
name: 'SCMMenuLayoutOld'
+ activeHelpKey: oldSCMMenuLayout
translateLabel: true
model: sourceCodeManagementMenuLayout
isTriggerOnDown: true
@@ -16447,6 +16514,7 @@
(RadioButtonSpec
label: 'Inline (experimental)'
name: 'SCMMenuLayoutInline'
+ activeHelpKey: inlineSCMLayout
translateLabel: true
model: sourceCodeManagementMenuLayout
isTriggerOnDown: true
@@ -16456,6 +16524,7 @@
(RadioButtonSpec
label: 'Compact (experimental)'
name: 'SCMMenuLayoutCompact'
+ activeHelpKey: compactSCMLayout
translateLabel: true
model: sourceCodeManagementMenuLayout
isTriggerOnDown: true
@@ -18437,11 +18506,11 @@
!AbstractSettingsApplication class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/AbstractSettingsApplication.st,v 1.460 2013-02-22 09:18:11 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/AbstractSettingsApplication.st,v 1.461 2013-03-19 11:50:07 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/AbstractSettingsApplication.st,v 1.460 2013-02-22 09:18:11 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/AbstractSettingsApplication.st,v 1.461 2013-03-19 11:50:07 cg Exp $'
!
version_HG
--- a/FileApplicationNoteBook.st Fri Mar 15 10:14:37 2013 +0000
+++ b/FileApplicationNoteBook.st Fri Mar 22 09:21:23 2013 +0000
@@ -125,6 +125,7 @@
"
! !
+
!FileApplicationNoteBook class methodsFor:'application list'!
applicationList
@@ -177,6 +178,7 @@
^ aApplicationListItem at:2
! !
+
!FileApplicationNoteBook class methodsFor:'classAccess'!
textEditorClass
@@ -184,6 +186,7 @@
^ TextEditor
! !
+
!FileApplicationNoteBook class methodsFor:'defaults'!
openAnotherApplicationOnSameItem
@@ -191,6 +194,7 @@
^ false
! !
+
!FileApplicationNoteBook class methodsFor:'interface specs'!
windowSpec
@@ -238,6 +242,7 @@
)
! !
+
!FileApplicationNoteBook class methodsFor:'menu specs'!
tabMenu
@@ -306,6 +311,7 @@
"Modified: / 27-03-2007 / 11:13:52 / cg"
! !
+
!FileApplicationNoteBook methodsFor:'accessing'!
listOfApplications
@@ -330,6 +336,7 @@
selectionHistoryList := aCol
! !
+
!FileApplicationNoteBook methodsFor:'accessing-applications'!
getAllApplicationsByClass:aClass andType:aType
@@ -371,6 +378,7 @@
].
! !
+
!FileApplicationNoteBook methodsFor:'actions-app-common'!
changeItem:anItem for:anAppl
@@ -745,6 +753,7 @@
"Modified (format): / 29-11-2011 / 19:07:57 / cg"
! !
+
!FileApplicationNoteBook methodsFor:'actions-app-spec'!
addTerminalIn:aDirectory
@@ -883,12 +892,14 @@
preSetItem:[:aTextEditor | aTextEditor presentation:#hexDump].
! !
+
!FileApplicationNoteBook methodsFor:'applicationlist access'!
applicationList
^ self class applicationList
! !
+
!FileApplicationNoteBook methodsFor:'aspects'!
canvasHolder
@@ -1014,6 +1025,7 @@
tabList := aValue.
! !
+
!FileApplicationNoteBook methodsFor:'change & update'!
canvasChanged
@@ -1101,6 +1113,7 @@
^ self.
! !
+
!FileApplicationNoteBook methodsFor:'menu & actions'!
destroyTabAt:idx
@@ -1124,6 +1137,7 @@
"Modified: / 27-03-2007 / 10:57:25 / cg"
! !
+
!FileApplicationNoteBook methodsFor:'queries'!
getSameFilesModifiedFor:aAppl
@@ -1142,6 +1156,7 @@
^ colOfChanged
! !
+
!FileApplicationNoteBook methodsFor:'selection'!
currentTabMenusApplication
@@ -1179,6 +1194,7 @@
^ canvas application.
! !
+
!FileApplicationNoteBook methodsFor:'startup & release'!
closeRequest
@@ -1228,6 +1244,7 @@
^ true
! !
+
!FileApplicationNoteBook::ArchiveViewApplication class methodsFor:'defaults'!
tabStringFor:aApplicationType
@@ -1238,6 +1255,7 @@
"Modified: / 01-03-2007 / 21:43:13 / cg"
! !
+
!FileApplicationNoteBook::ArchiveViewApplication class methodsFor:'help specs'!
flyByHelpSpec
@@ -1300,6 +1318,7 @@
)
! !
+
!FileApplicationNoteBook::ArchiveViewApplication class methodsFor:'image specs'!
extract28x28Icon
@@ -1381,6 +1400,7 @@
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@a') ; colorMapFromArray:#[0 0 0 8 4 8 105 133 190 121 133 157 129 129 129 194 194 194 255 0 0]; mask:((Depth1Image new) width: 28; height: 22; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@LC@@@A!! @@@L0@@@A8@@@@L@@@@G @@@CL@@@A!! @@@0L@@@@@@@BY=5LAIUUT S5UU8D!!UUPAFU\#@@@@@@@LR9@@D)J @A:R(@@P$*@@CIN @@@@@@@@@a') ; yourself); yourself]
! !
+
!FileApplicationNoteBook::ArchiveViewApplication class methodsFor:'interface specs'!
windowSpec
@@ -1478,6 +1498,7 @@
)
! !
+
!FileApplicationNoteBook::ArchiveViewApplication class methodsFor:'menu specs'!
fileListMenu
@@ -1615,6 +1636,7 @@
"Modified: / 12-01-2012 / 00:34:06 / cg"
! !
+
!FileApplicationNoteBook::ArchiveViewApplication class methodsFor:'queries'!
canOpenItem:anItem
@@ -1645,6 +1667,7 @@
^ false
! !
+
!FileApplicationNoteBook::ArchiveViewApplication class methodsFor:'tableColumns specs'!
tableColumns
@@ -1806,6 +1829,7 @@
! !
+
!FileApplicationNoteBook::ArchiveViewApplication methodsFor:'accessing'!
archiver
@@ -1872,6 +1896,7 @@
^ temporaryDirectory
! !
+
!FileApplicationNoteBook::ArchiveViewApplication methodsFor:'actions'!
changeItem:anItem
@@ -1982,6 +2007,7 @@
].
! !
+
!FileApplicationNoteBook::ArchiveViewApplication methodsFor:'aspects'!
archiveFileList
@@ -2059,6 +2085,7 @@
^ viewErrorList
! !
+
!FileApplicationNoteBook::ArchiveViewApplication methodsFor:'change & update'!
update:something with:aParameter from:changedObject
@@ -2078,6 +2105,7 @@
self errorListVisibilityHolder value:viewListValue.
! !
+
!FileApplicationNoteBook::ArchiveViewApplication methodsFor:'command execution'!
getErrorBlock
@@ -2195,6 +2223,7 @@
].
! !
+
!FileApplicationNoteBook::ArchiveViewApplication methodsFor:'command helper'!
selectDirectoryDialog
@@ -2257,6 +2286,7 @@
^ dir
! !
+
!FileApplicationNoteBook::ArchiveViewApplication methodsFor:'commands add'!
addFilesToArchive:colOfFiles
@@ -2282,6 +2312,7 @@
^ true
! !
+
!FileApplicationNoteBook::ArchiveViewApplication methodsFor:'commands extract'!
extractAll
@@ -2318,6 +2349,7 @@
"/ self updateFileBrowserIfPresentWith:dir.
! !
+
!FileApplicationNoteBook::ArchiveViewApplication methodsFor:'commands extract private'!
extractAllTo:aDirectory
@@ -2401,6 +2433,7 @@
"Modified (format): / 29-11-2011 / 18:58:01 / cg"
! !
+
!FileApplicationNoteBook::ArchiveViewApplication methodsFor:'commands list'!
listAllFiles
@@ -2425,6 +2458,7 @@
]
! !
+
!FileApplicationNoteBook::ArchiveViewApplication methodsFor:'commands remove'!
removeFilesFromArchive
@@ -2454,6 +2488,7 @@
self archiveFileList value removeAllFoundIn:realSel
! !
+
!FileApplicationNoteBook::ArchiveViewApplication methodsFor:'drag & drop'!
canDrop:aContext
@@ -2533,6 +2568,7 @@
^ sel collect:[:el| DropObject newFileInArchive:(el fileName asFilename) ].
! !
+
!FileApplicationNoteBook::ArchiveViewApplication methodsFor:'event handling'!
processEvent:anEvent
@@ -2557,6 +2593,7 @@
^ false
! !
+
!FileApplicationNoteBook::ArchiveViewApplication methodsFor:'initialization & release'!
postBuildFileTable:aWidget
@@ -2603,6 +2640,7 @@
^ super release.
! !
+
!FileApplicationNoteBook::ArchiveViewApplication methodsFor:'queries'!
canDelete
@@ -2650,6 +2688,7 @@
^ newSel.
! !
+
!FileApplicationNoteBook::ArchiveViewApplication methodsFor:'sorting'!
generateSortBlock:instanceName
@@ -2711,6 +2750,7 @@
fileList addAll:sortCol.
! !
+
!FileApplicationNoteBook::ArchiveViewApplication::ArchivItem methodsFor:'accessing'!
compressSize
@@ -2963,12 +3003,14 @@
self year:(Integer readFrom:yearString)
! !
+
!FileApplicationNoteBook::ArchiveViewApplication::ArchivItem methodsFor:'printing'!
printOn:aStream
aStream nextPutAll:self fileName asString
! !
+
!FileApplicationNoteBook::ArchiveViewApplication::ArchivItem methodsFor:'queries'!
hasDirectoryPart
@@ -2976,6 +3018,7 @@
^ self fileName asFilename components size ~= 1
! !
+
!FileApplicationNoteBook::CommandResult class methodsFor:'defaults'!
tabStringFor:aApplicationType
@@ -2991,6 +3034,7 @@
^ false
! !
+
!FileApplicationNoteBook::CommandResult class methodsFor:'interface specs'!
windowSpec
@@ -3052,6 +3096,7 @@
)
! !
+
!FileApplicationNoteBook::CommandResult class methodsFor:'menu specs'!
menu
@@ -3099,6 +3144,7 @@
"Modified: / 12-01-2012 / 00:33:56 / cg"
! !
+
!FileApplicationNoteBook::CommandResult methodsFor:'accessing'!
resultStream
@@ -3113,6 +3159,7 @@
resultStream := something.
! !
+
!FileApplicationNoteBook::CommandResult methodsFor:'actions'!
changeTabTo:aString
@@ -3136,6 +3183,7 @@
].
! !
+
!FileApplicationNoteBook::CommandResult methodsFor:'aspects'!
enableStopButton
@@ -3156,6 +3204,7 @@
^ process
! !
+
!FileApplicationNoteBook::CommandResult methodsFor:'change & update'!
update:something with:aParameter from:changedObject
@@ -3166,6 +3215,7 @@
super update:something with:aParameter from:changedObject
! !
+
!FileApplicationNoteBook::CommandResult methodsFor:'initialization & release'!
postBuildTextCollector:aBuilder
@@ -3193,12 +3243,14 @@
^ super release
! !
+
!FileApplicationNoteBook::CommandResult methodsFor:'printing'!
printOn:aStream
aStream nextPutAll:'CommandResult Application'.
! !
+
!FileApplicationNoteBook::DigitalNotepadFileViewApplication class methodsFor:'defaults'!
tabStringFor:anApplicationType
@@ -3209,6 +3261,7 @@
"Modified: / 01-03-2007 / 21:43:23 / cg"
! !
+
!FileApplicationNoteBook::DigitalNotepadFileViewApplication class methodsFor:'documentation'!
documentation
@@ -3218,6 +3271,7 @@
"
! !
+
!FileApplicationNoteBook::DigitalNotepadFileViewApplication class methodsFor:'help specs'!
flyByHelpSpec
@@ -3241,6 +3295,7 @@
)
! !
+
!FileApplicationNoteBook::DigitalNotepadFileViewApplication class methodsFor:'interface specs'!
windowSpec
@@ -3297,6 +3352,7 @@
)
! !
+
!FileApplicationNoteBook::DigitalNotepadFileViewApplication class methodsFor:'menu specs'!
menu
@@ -3355,6 +3411,7 @@
)
! !
+
!FileApplicationNoteBook::DigitalNotepadFileViewApplication class methodsFor:'queries'!
canOpenItem:anItem
@@ -3366,6 +3423,7 @@
^ false
! !
+
!FileApplicationNoteBook::DigitalNotepadFileViewApplication methodsFor:'accessing'!
imageView
@@ -3395,6 +3453,7 @@
"/ self notify:msg.
! !
+
!FileApplicationNoteBook::DigitalNotepadFileViewApplication methodsFor:'actions'!
changeItem:anItem
@@ -3408,6 +3467,7 @@
imageView readFile:self fileName
! !
+
!FileApplicationNoteBook::DigitalNotepadFileViewApplication methodsFor:'aspects'!
fitSize
@@ -3420,6 +3480,7 @@
^ fitSize
! !
+
!FileApplicationNoteBook::DigitalNotepadFileViewApplication methodsFor:'change & update'!
update:something with:aParameter from:changedObject
@@ -3434,6 +3495,7 @@
super update:something with:aParameter from:changedObject
! !
+
!FileApplicationNoteBook::DigitalNotepadFileViewApplication methodsFor:'initialization & release'!
postBuildImageView:aWidget
@@ -3466,6 +3528,7 @@
super postOpenWith:aBuilder
! !
+
!FileApplicationNoteBook::HtmlViewApplication class methodsFor:'defaults'!
tabStringFor:aApplicationType
@@ -3476,6 +3539,7 @@
"Modified: / 01-03-2007 / 21:43:18 / cg"
! !
+
!FileApplicationNoteBook::HtmlViewApplication class methodsFor:'help specs'!
helpSpec
@@ -3499,6 +3563,7 @@
)
! !
+
!FileApplicationNoteBook::HtmlViewApplication class methodsFor:'interface specs'!
windowSpec
@@ -3640,6 +3705,7 @@
"Modified: / 11-08-2011 / 00:34:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!FileApplicationNoteBook::HtmlViewApplication class methodsFor:'menu specs'!
menu
@@ -3743,6 +3809,7 @@
)
! !
+
!FileApplicationNoteBook::HtmlViewApplication class methodsFor:'queries'!
canOpenItem:anItem
@@ -3755,6 +3822,7 @@
^ false
! !
+
!FileApplicationNoteBook::HtmlViewApplication methodsFor:'accessing'!
htmlView
@@ -3779,6 +3847,7 @@
^ retVal
! !
+
!FileApplicationNoteBook::HtmlViewApplication methodsFor:'accessing - subapps'!
webBrowserPage
@@ -3792,6 +3861,7 @@
"Created: / 11-08-2011 / 00:32:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!FileApplicationNoteBook::HtmlViewApplication methodsFor:'actions'!
doEdit
@@ -3846,6 +3916,7 @@
"Modified: / 17-02-2011 / 14:01:35 / cg"
! !
+
!FileApplicationNoteBook::HtmlViewApplication methodsFor:'aspects'!
labelHolder
@@ -3856,6 +3927,7 @@
^ labelHolder.
! !
+
!FileApplicationNoteBook::HtmlViewApplication methodsFor:'initialization & release'!
postBuildHtmlView:aWidget
@@ -3893,6 +3965,7 @@
"Modified: / 17-02-2011 / 13:27:12 / cg"
! !
+
!FileApplicationNoteBook::ImageViewApplication class methodsFor:'defaults'!
tabStringFor:aApplicationType
@@ -3903,6 +3976,7 @@
"Modified: / 01-03-2007 / 21:43:23 / cg"
! !
+
!FileApplicationNoteBook::ImageViewApplication class methodsFor:'documentation'!
documentation
@@ -3912,6 +3986,7 @@
"
! !
+
!FileApplicationNoteBook::ImageViewApplication class methodsFor:'help specs'!
flyByHelpSpec
@@ -3935,6 +4010,7 @@
)
! !
+
!FileApplicationNoteBook::ImageViewApplication class methodsFor:'image specs'!
fitSize20x20Icon
@@ -3966,6 +4042,7 @@
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@a') ; yourself); yourself]
! !
+
!FileApplicationNoteBook::ImageViewApplication class methodsFor:'interface specs'!
windowSpec
@@ -4022,6 +4099,7 @@
)
! !
+
!FileApplicationNoteBook::ImageViewApplication class methodsFor:'menu specs'!
menu
@@ -4080,6 +4158,7 @@
)
! !
+
!FileApplicationNoteBook::ImageViewApplication class methodsFor:'queries'!
canOpenItem:anItem
@@ -4092,6 +4171,7 @@
^ false
! !
+
!FileApplicationNoteBook::ImageViewApplication methodsFor:'accessing'!
image:something
@@ -4126,6 +4206,7 @@
self notify:msg.
! !
+
!FileApplicationNoteBook::ImageViewApplication methodsFor:'actions'!
changeItem:anItem
@@ -4181,6 +4262,7 @@
"Modified: / 25-07-2006 / 09:09:33 / cg"
! !
+
!FileApplicationNoteBook::ImageViewApplication methodsFor:'aspects'!
fitSize
@@ -4193,6 +4275,7 @@
^ fitSize
! !
+
!FileApplicationNoteBook::ImageViewApplication methodsFor:'change & update'!
update:something with:aParameter from:changedObject
@@ -4207,6 +4290,7 @@
super update:something with:aParameter from:changedObject
! !
+
!FileApplicationNoteBook::ImageViewApplication methodsFor:'initialization & release'!
postBuildImageView:aWidget
@@ -4240,6 +4324,7 @@
super postOpenWith:aBuilder
! !
+
!FileApplicationNoteBook::Terminal class methodsFor:'defaults'!
defaultLineLimit
@@ -4262,6 +4347,7 @@
"Modified: / 01-03-2007 / 21:43:38 / cg"
! !
+
!FileApplicationNoteBook::Terminal class methodsFor:'help specs'!
helpSpec
@@ -4285,6 +4371,7 @@
)
! !
+
!FileApplicationNoteBook::Terminal class methodsFor:'interface specs'!
windowSpec
@@ -4340,6 +4427,7 @@
)
! !
+
!FileApplicationNoteBook::Terminal class methodsFor:'menu specs'!
menu
@@ -4385,6 +4473,7 @@
)
! !
+
!FileApplicationNoteBook::Terminal methodsFor:'accessing'!
terminalView
@@ -4407,6 +4496,7 @@
"Modified: / 05-04-2012 / 15:58:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!FileApplicationNoteBook::Terminal methodsFor:'actions'!
saveAs
@@ -4414,6 +4504,7 @@
self terminalView save.
! !
+
!FileApplicationNoteBook::Terminal methodsFor:'initialization & release'!
shellFinished
@@ -4440,6 +4531,7 @@
vt100 startShellIn:(self fileName).
! !
+
!FileApplicationNoteBook::Terminal methodsFor:'printing'!
printOn:aStream
@@ -4447,6 +4539,7 @@
self fileName baseName printOn:aStream.
! !
+
!FileApplicationNoteBook::Terminal methodsFor:'queries'!
getTabValueString
@@ -4457,6 +4550,7 @@
"Created: / 01-03-2007 / 21:39:56 / cg"
! !
+
!FileApplicationNoteBook::Terminal methodsFor:'startup & release'!
postOpenWith:aBuilder
@@ -4470,6 +4564,7 @@
super postOpenWith:aBuilder.
! !
+
!FileApplicationNoteBook::TextEditor class methodsFor:'defaults'!
checkModifiedDelayTime
@@ -4498,6 +4593,7 @@
^ false
! !
+
!FileApplicationNoteBook::TextEditor class methodsFor:'documentation'!
documentation
@@ -4507,6 +4603,7 @@
"
! !
+
!FileApplicationNoteBook::TextEditor class methodsFor:'help specs'!
helpSpec
@@ -4530,6 +4627,7 @@
)
! !
+
!FileApplicationNoteBook::TextEditor class methodsFor:'interface specs'!
windowSpec
@@ -4661,6 +4759,7 @@
)
! !
+
!FileApplicationNoteBook::TextEditor class methodsFor:'menu specs'!
menu
@@ -4780,6 +4879,7 @@
)
! !
+
!FileApplicationNoteBook::TextEditor methodsFor:'accessing'!
fileEncoding
@@ -4847,6 +4947,7 @@
self changeInformation.
! !
+
!FileApplicationNoteBook::TextEditor methodsFor:'actions'!
accept
@@ -5253,15 +5354,15 @@
|answer fn master defaultDir dir base fnDir|
master := self masterApplication.
- self fileName notNil ifTrue:[
- dir := self fileName directory.
- base := self fileName baseName.
+ (fn := self fileName) notNil ifTrue:[
+ dir := fn directory.
+ base := fn baseName.
].
ask ifTrue:[
defaultDir := master notNil ifTrue:[ master currentDirectory ] ifFalse:[ nil ].
defaultDir isNil ifTrue:[
- self fileName notNil ifTrue:[
+ fn notNil ifTrue:[
defaultDir := dir.
]
].
@@ -5271,8 +5372,6 @@
fromDirectory:defaultDir.
answer isEmptyOrNil ifTrue:[^ self].
fn := answer asFilename.
- ] ifFalse:[
- fn := self fileName
].
(master notNil and:[master class openAnotherApplicationOnSameItem]) ifTrue:[
@@ -5288,7 +5387,8 @@
^ self.
]
].
- (editView saveAs:fn) ifFalse:[^ self].
+
+ (editView saveAs:fn doAppend:false compressTabs:master compressTabsOnSave) ifFalse:[^ self].
textEditorModificationTime := self fileName modificationTime.
@@ -5468,6 +5568,7 @@
].
! !
+
!FileApplicationNoteBook::TextEditor methodsFor:'aspects'!
cursorColLabelHolder
@@ -5607,6 +5708,7 @@
^ viewModifiedChannel.
! !
+
!FileApplicationNoteBook::TextEditor methodsFor:'aspects-visibility'!
closeButtonShown
@@ -5651,6 +5753,7 @@
"Modified: / 06-10-2011 / 12:46:41 / cg"
! !
+
!FileApplicationNoteBook::TextEditor methodsFor:'change & update'!
changeTextColorForChanged
@@ -5826,6 +5929,7 @@
"Created: / 23-06-2011 / 16:32:44 / cg"
! !
+
!FileApplicationNoteBook::TextEditor methodsFor:'initialization'!
initialize
@@ -5833,6 +5937,7 @@
semaChangeItem := Semaphore forMutualExclusion.
! !
+
!FileApplicationNoteBook::TextEditor methodsFor:'printing'!
printOn:aStream
@@ -5844,6 +5949,7 @@
]
! !
+
!FileApplicationNoteBook::TextEditor methodsFor:'private-process'!
checkItemForChanges
@@ -5900,6 +6006,7 @@
Processor addTimedBlock:checkModifiedBlock afterSeconds:(self class checkModifiedDelayTime).
! !
+
!FileApplicationNoteBook::TextEditor methodsFor:'queries'!
additionalInfo
@@ -5923,6 +6030,7 @@
^ true
! !
+
!FileApplicationNoteBook::TextEditor methodsFor:'startup & release'!
closeRequest
@@ -6044,6 +6152,7 @@
"Modified: / 10-04-2007 / 15:24:22 / cg"
! !
+
!FileApplicationNoteBook::XMLViewApplication class methodsFor:'defaults'!
tabStringFor:aApplicationType
@@ -6054,6 +6163,7 @@
"Modified: / 17-02-2011 / 13:28:22 / cg"
! !
+
!FileApplicationNoteBook::XMLViewApplication class methodsFor:'help specs'!
helpSpec
@@ -6077,6 +6187,7 @@
"Modified: / 17-02-2011 / 13:28:28 / cg"
! !
+
!FileApplicationNoteBook::XMLViewApplication class methodsFor:'interface specs'!
windowSpec
@@ -6133,6 +6244,7 @@
)
! !
+
!FileApplicationNoteBook::XMLViewApplication class methodsFor:'menu specs'!
menu
@@ -6181,6 +6293,7 @@
"Modified: / 17-02-2011 / 17:30:26 / cg"
! !
+
!FileApplicationNoteBook::XMLViewApplication class methodsFor:'queries'!
canOpenItem:anItem
@@ -6196,6 +6309,7 @@
^ false
! !
+
!FileApplicationNoteBook::XMLViewApplication methodsFor:'accessing'!
item:anItem
@@ -6240,6 +6354,7 @@
"Modified: / 17-02-2011 / 17:39:15 / cg"
! !
+
!FileApplicationNoteBook::XMLViewApplication methodsFor:'actions'!
reload
@@ -6248,6 +6363,7 @@
"Created: / 17-02-2011 / 17:46:36 / cg"
! !
+
!FileApplicationNoteBook::XMLViewApplication methodsFor:'aspects'!
labelHolder
@@ -6258,6 +6374,7 @@
^ labelHolder.
! !
+
!FileApplicationNoteBook::XMLViewApplication methodsFor:'initialization & release'!
postBuildXMLCanvas:aWidget
@@ -6267,6 +6384,7 @@
"Modified: / 17-02-2011 / 13:39:18 / cg"
! !
+
!FileApplicationNoteBook::XViewApplication class methodsFor:'defaults'!
maxNumberOfVNCRestarts
@@ -6304,6 +6422,7 @@
^ true
! !
+
!FileApplicationNoteBook::XViewApplication class methodsFor:'interface specs'!
windowSpec
@@ -6360,6 +6479,7 @@
)
! !
+
!FileApplicationNoteBook::XViewApplication class methodsFor:'menu specs'!
menu
@@ -6395,6 +6515,7 @@
)
! !
+
!FileApplicationNoteBook::XViewApplication class methodsFor:'queries'!
canOpenItem:anItem
@@ -6417,6 +6538,7 @@
^ true
! !
+
!FileApplicationNoteBook::XViewApplication methodsFor:'accessing'!
xView
@@ -6431,6 +6553,7 @@
xView := something.
! !
+
!FileApplicationNoteBook::XViewApplication methodsFor:'actions'!
changeInformation
@@ -6469,6 +6592,7 @@
self startViewer.
! !
+
!FileApplicationNoteBook::XViewApplication methodsFor:'actions VNC'!
setupView
@@ -6637,6 +6761,7 @@
^ true
! !
+
!FileApplicationNoteBook::XViewApplication methodsFor:'actions viewer'!
startViewer
@@ -6714,6 +6839,7 @@
"/ Dialog information:'viewer has terminated'.
! !
+
!FileApplicationNoteBook::XViewApplication methodsFor:'initialization & release'!
postBuildXView:aWidget
@@ -6756,14 +6882,15 @@
^ super release
! !
+
!FileApplicationNoteBook class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/FileApplicationNoteBook.st,v 1.275 2013-01-29 14:20:07 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/FileApplicationNoteBook.st,v 1.276 2013-03-19 13:53:54 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/FileApplicationNoteBook.st,v 1.275 2013-01-29 14:20:07 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/FileApplicationNoteBook.st,v 1.276 2013-03-19 13:53:54 cg Exp $'
!
version_HG
--- a/FindFileApplication.st Fri Mar 15 10:14:37 2013 +0000
+++ b/FindFileApplication.st Fri Mar 22 09:21:23 2013 +0000
@@ -250,7 +250,7 @@
acceptOnPointerLeave: false
)
(LabelSpec
- label: 'But Not Named:'
+ label: 'But not Named:'
name: 'Label1'
layout: (LayoutFrame 2 0 55 0 154 0 72 0)
activeHelpKey: excludedNamePattern
@@ -541,7 +541,6 @@
)
)
-
! !
@@ -569,18 +568,15 @@
enabled: hasOneFileSelected
label: 'Open in New File Browser'
itemValue: openInNewBrowser
- translateLabel: true
)
(MenuItem
enabled: hasOneFileSelected
label: 'Select in Browser'
itemValue: selectInBrowser
- translateLabel: true
isVisible: isEmbeddedApplication
)
(MenuItem
label: 'Autoselect in Browser'
- translateLabel: true
indication: autoSelectInBrowserHolder
)
(MenuItem
@@ -590,7 +586,6 @@
enabled: hasOneFileSelected
label: 'FileIn'
itemValue: fileInInBrowser
- translateLabel: true
)
(MenuItem
label: '-'
@@ -599,7 +594,6 @@
enabled: hasSelectionInResultList
label: 'Copy Selected Filenames to Clipboard'
itemValue: copySelectedFileNamesToClipboard
- translateLabel: true
)
(MenuItem
label: '-'
@@ -608,13 +602,17 @@
enabled: hasSelection
label: 'Delete Selected File(s)...'
itemValue: deleteSelectedFiles
- translateLabel: true
+ )
+ (MenuItem
+ enabled: hasSelection
+ isVisible: cvsMenusAreShown
+ label: 'Delete Selected File(s) and CVS Container(s)...'
+ itemValue: deleteSelectedFilesAndCVSContainers
)
(MenuItem
enabled: hasListEntries
label: 'Delete all Files...'
itemValue: deleteAllFiles
- translateLabel: true
isVisible: false
)
(MenuItem
@@ -624,13 +622,11 @@
enabled: hasSelection
label: 'Remove Selected from Resultlist'
itemValue: removeSelectedFilesFromResultList
- translateLabel: true
)
(MenuItem
enabled: hasListEntries
label: 'Clear Resultlist'
itemValue: clearResultList
- translateLabel: true
)
(MenuItem
label: '-'
@@ -638,14 +634,12 @@
(MenuItem
label: 'Show Matched Files (After SameContents-Search)'
itemValue: showMatchedFiles:
- translateLabel: true
isVisible: notShowingMatchedFiles
argument: true
)
(MenuItem
label: 'Show Matching Files (After SameContents-Search)'
itemValue: showMatchedFiles:
- translateLabel: true
isVisible: showingMatchedFiles
argument: false
)
@@ -800,6 +794,14 @@
"Modified: / 29-03-2012 / 10:05:39 / cg"
!
+deleteSelectedFilesAndCVSContainers
+ |sel files|
+
+ sel := self selectionHolder value.
+ files := sel collect:[:idx | (self shownList at:idx) asFilename ].
+ masterApplication removeFilesAndCVSContainers:files
+!
+
doSearch
|namePatterns excludedNamePatterns contentsPattern notContentsPattern dir fileToCompareAgainst ignoreCaseInName ignoreCaseInExcludedName
ignoreCaseInContents ignoreCaseInNotContents|
@@ -1833,11 +1835,11 @@
!FindFileApplication class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/FindFileApplication.st,v 1.106 2013-02-27 11:21:35 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/FindFileApplication.st,v 1.107 2013-03-20 19:57:16 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/FindFileApplication.st,v 1.106 2013-02-27 11:21:35 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/FindFileApplication.st,v 1.107 2013-03-20 19:57:16 cg Exp $'
!
version_HG
--- a/InspectorView.st Fri Mar 15 10:14:37 2013 +0000
+++ b/InspectorView.st Fri Mar 22 09:21:23 2013 +0000
@@ -13,13 +13,14 @@
SimpleView subclass:#InspectorView
instanceVariableNames:'listView labelView workspace inspectedObject selectedLine nShown
- hasMore monitorProcess hideReceiver integerDisplayRadix
- inspectHistory allowFollow isStandaloneInspector selectionIndex
- object inspectedObjectHolder displayStringMessage
- suppressPseudoSlots dereferenceValueHolders suppressHeadline
- headLineLabel sortOrder hideMessages hideHashes'
+ hasMore monitorProcess hideReceiver integerDisplayRadix
+ inspectHistory allowFollow isStandaloneInspector selectionIndex
+ object inspectedObjectHolder displayStringMessage
+ suppressPseudoSlots dereferenceValueHolders suppressHeadline
+ headLineLabel sortOrder hideMessages hideHashes
+ holderChangeInterest'
classVariableNames:'DefaultIcon IdDictionary NextSequentialID LastExtent
- DefaultIntegerDisplayRadix ExpandArraysInAllLists'
+ DefaultIntegerDisplayRadix ExpandArraysInAllLists'
poolDictionaries:''
category:'Interface-Inspector'
!
@@ -103,7 +104,6 @@
"
! !
-
!InspectorView class methodsFor:'instance creation'!
for:anObject
@@ -203,7 +203,6 @@
^ self openOn:anObject
! !
-
!InspectorView class methodsFor:'common label support'!
commonLabelFor:anObject
@@ -280,7 +279,6 @@
"Created: / 15-07-2011 / 16:20:06 / cg"
! !
-
!InspectorView class methodsFor:'defaults'!
defaultExtent
@@ -358,7 +356,6 @@
"Created: / 23-10-2007 / 19:10:02 / cg"
! !
-
!InspectorView class methodsFor:'image specs'!
imageFor_arrays
@@ -756,7 +753,6 @@
M#L3NBH"H#\@@@@@@@@@@@@-JS 8JSH@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@a') ; colorMapFromArray:#[226 226 226 176 176 176 155 155 155 169 169 169 152 152 152 164 164 164 149 149 149 192 192 192 240 240 240 255 255 255 202 202 202 201 201 201 151 151 151 162 162 162 148 148 148 158 158 158 173 173 173 154 154 154 167 167 167 150 150 150 160 160 160 180 180 180 156 156 156 170 170 170 153 153 153 165 165 165 183 183 183 98 255 0 75 198 0 25 74 0 57 156 0 34 99 0 92 206 16 60 132 16 31 74 0 79 206 0 128 131 142 88 231 0 70 189 0 38 90 0 148 198 123 57 115 16 92 239 0 103 255 8 76 189 0 154 198 123 85 214 0 53 132 0 106 255 0 138 255 49 107 156 74 44 115 0 119 206 66 85 222 0 142 206 99 68 139 33 33 90 0 57 148 0 135 206 99]; mask:((Depth1Image new) width: 16; height: 16; photometric:(#blackIs0); bitsPerSample:(#[1]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@@@@@@A>@O<A?8G? _>A?8G? _>@?0A>@@@@@@@@@b') ; yourself); yourself]
! !
-
!InspectorView class methodsFor:'queries-plugin'!
aspectSelectors
@@ -765,7 +761,6 @@
"Modified: / 10.2.2000 / 12:25:28 / cg"
! !
-
!InspectorView methodsFor:'accessing'!
allowFollow:aBoolean
@@ -961,7 +956,6 @@
^ workspace
! !
-
!InspectorView methodsFor:'accessing-channels'!
inspectedObjectHolder
@@ -987,9 +981,18 @@
"Created: / 10.2.2000 / 13:34:53 / cg"
! !
-
!InspectorView methodsFor:'change & update'!
+holderChanged:aValueHolder
+ "a valueHolder of which I have registered an iterest
+ has changed (see the menu item: 'Catch Change').
+ Remove the interest (no further notifications) either by evaluating:
+ self doUncatchChanges
+ here, or via the field menu"
+
+ self halt:'ValueHolder has changed - please proceed'.
+!
+
update:something with:aParameter from:changedObject
"Invoked when one of my dependees sends a change notification."
@@ -1013,7 +1016,6 @@
"Modified: / 10.2.2000 / 13:48:18 / cg"
! !
-
!InspectorView methodsFor:'drag & drop'!
getDisplayObjects
@@ -1032,7 +1034,6 @@
"Modified: / 18-09-2006 / 21:11:31 / cg"
! !
-
!InspectorView methodsFor:'event handling'!
doubleClickOnLine:lineNr
@@ -1090,7 +1091,6 @@
].
! !
-
!InspectorView methodsFor:'initialization & release'!
destroy
@@ -1250,7 +1250,6 @@
].
! !
-
!InspectorView methodsFor:'menu'!
fieldMenu
@@ -1308,6 +1307,19 @@
"/ ('Trap change to any instVar' #doTrapAnyInstVarChange )
).
+ sel isValueModel ifTrue:[
+ (holderChangeInterest notNil
+ and:[ (sel interestsFor:holderChangeInterest) notEmptyOrNil ]) ifTrue:[
+ items := items , #(
+ ('Uncatch Changes' #doUncatchChanges )
+ ).
+ ] ifFalse:[
+ items := items , #(
+ ('Catch Changes' #doCatchChanges )
+ ).
+ ].
+ ].
+
allowFollow ifTrue:[
items := #(
('Follow' #doFollow )
@@ -1460,9 +1472,9 @@
!
optionalByteArraySelectionItems
- |sel|
-
- sel := self selection.
+"/ |sel|
+"/
+"/ sel := self selection.
(object isByteArray) ifTrue:[
^ #(
('Save Bytes to File...' #saveBytesToFile)
@@ -1585,7 +1597,6 @@
"Created: / 20-07-2012 / 10:47:53 / cg"
! !
-
!InspectorView methodsFor:'menu actions'!
browse
@@ -1699,6 +1710,18 @@
self doInspect:true
!
+doCatchChanges
+ |sel|
+
+ holderChangeInterest isNil ifTrue:[
+ "/ remember the interest, in order to be able to retract later
+ holderChangeInterest := [ self holderChanged:sel ]
+ ].
+
+ sel := self selection.
+ sel onChangeSend:#value to:holderChangeInterest.
+!
+
doFollow
"user selected follow-menu entry"
@@ -1816,6 +1839,15 @@
]
!
+doUncatchChanges
+ |sel|
+
+ holderChangeInterest notNil ifTrue:[
+ sel := self selection.
+ sel retractInterestsFor:holderChangeInterest
+ ].
+!
+
doUntrace
"remove traps/traces"
@@ -2060,7 +2092,6 @@
"Modified: / 6.2.2000 / 13:47:37 / cg"
! !
-
!InspectorView methodsFor:'presentation'!
appendDisplayStringForElementsOf:val indent:lvl pad:padding to:aStream
@@ -2083,11 +2114,13 @@
basicDisplayStringForValue:someValue
"return the value's displayString to be pasted into the workspace."
- |s|
+ |s maxStringLength|
+
+ maxStringLength := 100000.
Error handle:[:ex |
(ex signal == WriteError and:[s isStream]) ifTrue:[
- "hit the write limit set below"
+ "hit the write limit"
s writeLimit:nil.
s nextPutAll:' ...'.
^ s contents.
@@ -2114,7 +2147,7 @@
].
(someValue isMemberOf:ByteArray) ifTrue:[
s := WriteStream on:(String new:10).
- s writeLimit:100000.
+ s writeLimit:maxStringLength.
someValue printOn:s base:integerDisplayRadix showRadix:true.
^ s contents
]
@@ -2129,7 +2162,7 @@
].
s := CharacterWriteStream on:(String new:10).
- s writeLimit:1000.
+ s writeLimit:maxStringLength.
"/ mhmh - avoid sending #perform: (bad for proxy objects which pass it to somewhere..)
displayStringMessage == #displayString ifTrue:[
@@ -2414,7 +2447,6 @@
"Created: / 13-06-2012 / 12:04:31 / cg"
! !
-
!InspectorView methodsFor:'private'!
baseInspectedObjectClass
@@ -2695,7 +2727,6 @@
"/ ^ list.
"Modified: / 27-09-2012 / 21:51:58 / cg"
- "Modified: / 06-07-2012 / 10:37:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
indexedValueAtIndex:idx
@@ -3149,7 +3180,6 @@
"Modified: / 06-06-2012 / 11:57:54 / cg"
! !
-
!InspectorView methodsFor:'queries'!
canInspect:anObject
@@ -3214,7 +3244,6 @@
^ suppressPseudoSlots ? false
! !
-
!InspectorView methodsFor:'selection'!
selection:lineNr
@@ -3270,7 +3299,6 @@
"Modified: / 28-10-2012 / 11:03:04 / cg"
! !
-
!InspectorView methodsFor:'user interaction'!
doAccept:theText
@@ -3421,7 +3449,6 @@
"Created: / 16-11-2001 / 13:48:51 / cg"
! !
-
!InspectorView methodsFor:'workspace protocol'!
modified:aBoolean
@@ -3432,23 +3459,13 @@
workspace saveAs:file doAppend:doAppend
! !
-
!InspectorView class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/InspectorView.st,v 1.298 2013-03-11 17:00:59 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/InspectorView.st,v 1.300 2013-03-21 09:40:25 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/InspectorView.st,v 1.298 2013-03-11 17:00:59 cg Exp $'
-!
-
-version_HG
-
- ^ '$Changeset: <not expanded> $'
-!
-
-version_SVN
- ^ '$Id: InspectorView.st 8083 2013-01-14 11:48:37Z vranyj1 $'
+ ^ '$Header: /cvs/stx/stx/libtool/InspectorView.st,v 1.300 2013-03-21 09:40:25 cg Exp $'
! !
--- a/Makefile Fri Mar 15 10:14:37 2013 +0000
+++ b/Makefile Fri Mar 22 09:21:23 2013 +0000
@@ -1,19 +1,21 @@
#
-# DO NOT EDIT
-#
-# make uses this file (Makefile) only, if there is no
-# file named "makefile" (lower-case m) in the same directory.
-# My only task is to generate the real makefile and call make again.
-# Thereafter, I am no longer used and needed.
+# DO NOT EDIT
+# automagically generated from Make.proto (by make mf)
#
-
-.PHONY: run
+include ../rules/stdHeader
+include ../configurations/COMMON/defines
+include ../configurations/vendorConf
+include ../configurations/myConf
+include ../rules/stdHeader2
+include Make.spec
+include Make.proto
-run: makefile
- $(MAKE) -f makefile
+BASE_CONF=osx_x
+BASE_CONF_VENDOR=mac
+CONF_PACKS=
+CONF_TOOLS=
-#only needed for the definition of $(TOP)
-include Make.proto
+include ../rules/stdRules
makefile: mf
--- a/MultiViewToolApplication.st Fri Mar 15 10:14:37 2013 +0000
+++ b/MultiViewToolApplication.st Fri Mar 22 09:21:23 2013 +0000
@@ -44,6 +44,7 @@
"
! !
+
!MultiViewToolApplication class methodsFor:'defaults'!
defaultEditToolbarVisible
@@ -64,6 +65,7 @@
"Created: / 14-07-2007 / 16:38:47 / cg"
! !
+
!MultiViewToolApplication class methodsFor:'help specs'!
flyByHelpSpec
@@ -75,16 +77,17 @@
'Add another page (tab)'
#hideToolBar
-'Hide the toolbar. Show again via the "View"-Menu'
+'Hide the toolbar. Show again via the "View"-menu'
#hideEditToolBar
-'Hide Edit-Toolbar. Show again via the "View"-Menu'
+'Hide the edit-toolbar. Show again via the "View"-menu'
)
"Modified: / 06-07-2011 / 18:08:57 / cg"
! !
+
!MultiViewToolApplication class methodsFor:'image specs'!
hideToolBarIcon
@@ -95,6 +98,7 @@
"Created: / 18-02-2007 / 14:53:38 / cg"
! !
+
!MultiViewToolApplication class methodsFor:'interface specs'!
windowSpec
@@ -203,6 +207,7 @@
"Modified: / 11-05-2012 / 11:43:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!MultiViewToolApplication class methodsFor:'menu specs'!
editToolBarMenu
@@ -543,6 +548,7 @@
)
! !
+
!MultiViewToolApplication class methodsFor:'queries'!
isVisualStartable
@@ -553,6 +559,7 @@
^ super isVisualStartable
! !
+
!MultiViewToolApplication methodsFor:'accessing'!
selectedWorkspace
@@ -654,6 +661,7 @@
^ workspaces
! !
+
!MultiViewToolApplication methodsFor:'aspects'!
editToolBarVisibleHolder
@@ -721,6 +729,7 @@
"Modified: / 14-07-2007 / 16:39:55 / cg"
! !
+
!MultiViewToolApplication methodsFor:'aspects-queries'!
canRemoveAllWorkspacesExcept:idx
@@ -756,6 +765,7 @@
and:[v list contains:[:l | l notEmptyOrNil]]]
! !
+
!MultiViewToolApplication methodsFor:'change & update'!
infoVisibilityChanged
@@ -836,6 +846,7 @@
"Modified: / 14-07-2007 / 16:46:14 / cg"
! !
+
!MultiViewToolApplication methodsFor:'defaults'!
defaultFileNameForLoad
@@ -862,6 +873,7 @@
"Created: / 25-10-2006 / 14:57:18 / cg"
! !
+
!MultiViewToolApplication methodsFor:'initialization'!
hideToolBarButtonCreated:aButton
@@ -886,6 +898,7 @@
"Modified: / 22-01-2011 / 11:46:35 / cg"
! !
+
!MultiViewToolApplication methodsFor:'menu-actions'!
addWindow:aWindow named:name
@@ -1165,6 +1178,7 @@
].
! !
+
!MultiViewToolApplication methodsFor:'menu-actions-editing'!
copySelection
@@ -1241,6 +1255,7 @@
]
! !
+
!MultiViewToolApplication methodsFor:'private'!
askForFile:question default:defaultFilename thenDo:aBlock
@@ -1360,6 +1375,7 @@
^ view allSubViewsDetect:[:v| v name = #Workspace] ifNone:nil.
! !
+
!MultiViewToolApplication methodsFor:'user actions'!
hideEditToolbar
@@ -1372,10 +1388,11 @@
"Created: / 18-02-2007 / 14:55:54 / cg"
! !
+
!MultiViewToolApplication class methodsFor:'documentation'!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/MultiViewToolApplication.st,v 1.45 2012-08-03 20:25:30 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/MultiViewToolApplication.st,v 1.46 2013-03-19 18:38:58 cg Exp $'
!
version_HG
--- a/NewLauncher.st Fri Mar 15 10:14:37 2013 +0000
+++ b/NewLauncher.st Fri Mar 22 09:21:23 2013 +0000
@@ -128,6 +128,7 @@
"
! !
+
!NewLauncher class methodsFor:'accessing'!
label
@@ -137,6 +138,7 @@
! !
+
!NewLauncher class methodsFor:'defaults'!
defaultInfoLineTemplate
@@ -172,6 +174,7 @@
"Modified: / 17.8.1998 / 10:07:09 / cg"
! !
+
!NewLauncher class methodsFor:'help specs'!
flyByHelpSpec
@@ -782,6 +785,7 @@
"Modified: / 21-09-2012 / 10:59:33 / cg"
! !
+
!NewLauncher class methodsFor:'interface specs'!
windowSpec
@@ -969,6 +973,7 @@
)
! !
+
!NewLauncher class methodsFor:'menu configuration'!
addMenuItem:newItem from:anApplicationWhichProvidesResourcesOrNil in:where position:positionSpecOrNilArg space:space
@@ -1130,6 +1135,7 @@
"
! !
+
!NewLauncher class methodsFor:'menu specs'!
aboutMenu
@@ -3179,6 +3185,7 @@
)
! !
+
!NewLauncher class methodsFor:'oldstyle-menu specs'!
settingsMenu
@@ -3335,6 +3342,7 @@
)
! !
+
!NewLauncher methodsFor:'accessing'!
errorListCanvas
@@ -3442,6 +3450,7 @@
^ transcript
! !
+
!NewLauncher methodsFor:'aspects'!
canDoTerminal
@@ -3613,6 +3622,7 @@
^ false
! !
+
!NewLauncher methodsFor:'change & update'!
update:something with:aParameter from:changedObject
@@ -3734,6 +3744,7 @@
^projectInfo.
! !
+
!NewLauncher methodsFor:'help'!
defaultInfoLabel
@@ -3752,6 +3763,7 @@
^ text
! !
+
!NewLauncher methodsFor:'menu configuration'!
addMenuItem:newItem from:anApplicationClassWhichProvidesResourcesOrNil in:where position:positionSpecOrNilArg space:space
@@ -4116,6 +4128,7 @@
! !
+
!NewLauncher methodsFor:'menus-dynamic'!
allWindowsMenu
@@ -4126,7 +4139,7 @@
menu := Menu new receiver: self.
allViewsAndLabels := self allTopViewsAndLabelsSortedFilteringWindowGroups:nil.
allViewsAndLabels do:[:assoc |
- |view label submenu likeThis info|
+ |view label submenu likeThis info item|
view := assoc value.
label := assoc key.
@@ -4136,12 +4149,15 @@
label: 'Raise Deiconified';
itemValue: [view raiseDeiconified; setForegroundWindow];
translateLabel: true).
- submenu addItem:(MenuItem new
+ submenu addItem:(item := MenuItem new
label: 'Iconify';
itemValue: [view collapse];
translateLabel: true).
+ view topView isCollapsed ifTrue:[
+ item disable
+ ].
submenu addItem:(MenuItem new
- label: 'Migrate';
+ label: 'Migrate...';
itemValue: [self migrateWindow:view];
enabled:(view windowGroup isModal not);
translateLabel: true).
@@ -4412,6 +4428,7 @@
"Created: / 12-11-2006 / 16:06:06 / cg"
! !
+
!NewLauncher methodsFor:'private-settings callBacks'!
reopenLauncher
@@ -4428,6 +4445,7 @@
^ newLauncher
! !
+
!NewLauncher methodsFor:'queries'!
preferredExtent
@@ -4448,6 +4466,7 @@
^ XWorkstation notNil
! !
+
!NewLauncher methodsFor:'startup & release'!
allButOpenInterface:anInterface
@@ -4628,6 +4647,7 @@
Project notNil ifTrue:[Project removeDependent:self]
! !
+
!NewLauncher methodsFor:'user actions-classes'!
enableGlobalCoverageAnalysis
@@ -4698,6 +4718,7 @@
DebugView stopIgnoringHalts
! !
+
!NewLauncher methodsFor:'user actions-demos'!
openDemo:className
@@ -4762,6 +4783,7 @@
self openApplication:'TicTacToeGame' nameSpace:Games with:#open2UserGame
! !
+
!NewLauncher methodsFor:'user actions-file'!
clearTranscript
@@ -4800,6 +4822,7 @@
].
! !
+
!NewLauncher methodsFor:'user actions-help'!
activeHelp
@@ -4822,6 +4845,7 @@
"Modified: / 18.8.1998 / 16:06:27 / cg"
! !
+
!NewLauncher methodsFor:'user actions-system'!
initJavaVM
@@ -4868,12 +4892,14 @@
"Modified: / 20-04-2005 / 18:59:28 / janfrog"
! !
+
!NewLauncher methodsFor:'user actions-windows'!
redrawAllWindows
device redrawAllWindows.
! !
+
!NewLauncher::AddedToolInfo methodsFor:'accessing'!
before
@@ -4941,14 +4967,15 @@
where := something.
! !
+
!NewLauncher class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/NewLauncher.st,v 1.450 2013-01-26 21:04:03 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/NewLauncher.st,v 1.451 2013-03-21 20:55:36 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/NewLauncher.st,v 1.450 2013-01-26 21:04:03 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/NewLauncher.st,v 1.451 2013-03-21 20:55:36 cg Exp $'
!
version_HG
--- a/SystemBrowser.st Fri Mar 15 10:14:37 2013 +0000
+++ b/SystemBrowser.st Fri Mar 22 09:21:23 2013 +0000
@@ -2954,7 +2954,7 @@
top20 := SortedCollection new.
top20 sortBlock:[:a :b | (a spellAgainst:aSelectorString) > (b spellAgainst:aSelectorString)].
Smalltalk allMethodsWithSelectorDo:[:eachMethod :eachSelector |
- (eachSelector spellAgainst:aSelectorString) > 50 ifTrue:[
+ ((eachSelector asLowercase startsWith:aSelectorString) or:[(eachSelector spellAgainst:aSelectorString) > 50]) ifTrue:[
(allSelectors includes:eachSelector) ifFalse:[
allSelectors add:eachSelector.
top20 add:eachSelector.
@@ -5932,7 +5932,7 @@
!SystemBrowser class methodsFor:'documentation'!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/SystemBrowser.st,v 1.308 2012-12-04 10:13:26 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/SystemBrowser.st,v 1.309 2013-03-18 13:25:35 cg Exp $'
!
version_HG
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Tools_ClassCategoryList.st Fri Mar 22 09:21:23 2013 +0000
@@ -0,0 +1,985 @@
+"
+ COPYRIGHT (c) 2004 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+"{ Package: 'stx:libtool' }"
+
+"{ NameSpace: Tools }"
+
+BrowserList subclass:#ClassCategoryList
+ instanceVariableNames:'categoryList classes allSelected showPseudoCategories
+ rawCategoryList cookedCategoryList categoryListView'
+ classVariableNames:'AdditionalEmptyCategories'
+ poolDictionaries:''
+ category:'Interface-Browsers-New'
+!
+
+!ClassCategoryList class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 2004 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+!
+
+documentation
+"
+ embeddable application displaying the class-categories.
+ Provides an outputGenerator, which enumerates the classes in
+ the selected categories.
+
+ [author:]
+ Claus Gittinger (cg@exept.de)
+"
+! !
+
+!ClassCategoryList class methodsFor:'interface specs'!
+
+singleCategoryWindowSpec
+ "This resource specification was automatically generated
+ by the UIPainter of ST/X."
+
+ "Do not manually edit this!! If it is corrupted,
+ the UIPainter may not be able to read the specification."
+
+ "
+ UIPainter new openOnClass:ClassCategoryList andSelector:#singleCategoryWindowSpec
+ ClassCategoryList new openInterface:#singleCategoryWindowSpec
+ "
+
+ <resource: #canvas>
+
+ ^
+ #(#FullSpec
+ #name: #singleCategoryWindowSpec
+ #window:
+ #(#WindowSpec
+ #label: 'ClassCategoryList'
+ #name: 'ClassCategoryList'
+ #min: #(#Point 0 0)
+ #max: #(#Point 1024 721)
+ #bounds: #(#Rectangle 218 175 518 475)
+ )
+ #component:
+ #(#SpecCollection
+ #collection: #(
+ #(#LabelSpec
+ #label: 'ClassCategoryName'
+ #name: 'ClassCategoryLabel'
+ #layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 25 0)
+ #translateLabel: true
+ #labelChannel: #classCategoryLabelHolder
+ #menu: #menuHolder
+ )
+ )
+
+ )
+ )
+!
+
+windowSpec
+ "This resource specification was automatically generated
+ by the UIPainter of ST/X."
+
+ "Do not manually edit this!! If it is corrupted,
+ the UIPainter may not be able to read the specification."
+
+ "
+ UIPainter new openOnClass:Tools::ClassCategoryList andSelector:#windowSpec
+ Tools::ClassCategoryList new openInterface:#windowSpec
+ Tools::ClassCategoryList open
+ "
+
+ <resource: #canvas>
+
+ ^
+ #(FullSpec
+ name: windowSpec
+ window:
+ (WindowSpec
+ label: 'ClassCategoryList'
+ name: 'ClassCategoryList'
+ min: (Point 0 0)
+ bounds: (Rectangle 0 0 300 300)
+ )
+ component:
+ (SpecCollection
+ collection: (
+ (SequenceViewSpec
+ name: 'List'
+ layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
+ tabable: true
+ model: selectedCategories
+ menu: menuHolder
+ hasHorizontalScrollBar: true
+ hasVerticalScrollBar: true
+ miniScrollerHorizontal: true
+ isMultiSelect: true
+ valueChangeSelector: selectionChangedByClick
+ useIndex: false
+ sequenceList: categoryList
+ doubleClickChannel: doubleClickChannel
+ properties:
+ (PropertyListDictionary
+ canDropSelector: canDropContext:
+ dragArgument: nil
+ dropArgument: nil
+ dropSelector: doDropContext:
+ )
+ postBuildCallback: postBuildCategoryListView:
+ )
+ )
+
+ )
+ )
+! !
+
+!ClassCategoryList class methodsFor:'plugIn spec'!
+
+aspectSelectors
+ "This resource specification was automatically generated
+ by the UIPainter of ST/X."
+
+ "Do not manually edit this. If it is corrupted,
+ the UIPainter may not be able to read the specification."
+
+ "Return a description of exported aspects;
+ these can be connected to aspects of an embedding application
+ (if this app is embedded in a subCanvas)."
+
+ ^ #(
+ #(doubleClickChannel action)
+ #forceGeneratorTrigger
+ #hideUnloadedClasses
+ #immediateUpdate
+ #inGeneratorHolder
+ #menuHolder
+ #nameSpaceFilter
+ #organizerMode
+ #outGeneratorHolder
+ #packageFilter
+ #selectedCategories
+ #selectionChangeCondition
+ #showCoverageInformation
+ #slaveMode
+ #updateTrigger
+ ).
+
+! !
+
+!ClassCategoryList class methodsFor:'special'!
+
+addAdditionalCategory:aCategory
+ "/ those are simulated - in ST/X, empty categories do not
+ "/ really exist; however, during browsing, it makes sense.
+
+ AdditionalEmptyCategories isNil ifTrue:[
+ AdditionalEmptyCategories := Set new.
+ ].
+ AdditionalEmptyCategories add:aCategory.
+ Smalltalk changed:#organization with:(nil -> aCategory). "/ not really ... to force update
+!
+
+removeAdditionalCategories:aListOfCategories
+ "/ those are simulated - in ST/X, empty categories do not
+ "/ really exist; however, during browsing, it makes sense.
+
+ AdditionalEmptyCategories isNil ifTrue:[^ self].
+ aListOfCategories do:[:eachCategory |
+ AdditionalEmptyCategories remove:eachCategory ifAbsent:nil.
+ ].
+
+ Smalltalk changed:#organization "/ not really ... to force update
+!
+
+removeAllAdditionalCategories
+ "/ those are simulated - in ST/X, empty categories do not
+ "/ really exist; however, during browsing, it makes sense.
+
+ AdditionalEmptyCategories := nil
+!
+
+renameAdditionalCategories:oldNames to:newName
+ "/ those are simulated - in ST/X, empty categories do not
+ "/ really exist; however, during browsing, it makes sense.
+
+ self removeAdditionalCategories:oldNames.
+ self addAdditionalCategory:newName.
+! !
+
+!ClassCategoryList methodsFor:'aspects'!
+
+categoryList
+ categoryList isNil ifTrue:[
+ categoryList := ValueHolder new.
+ ].
+ ^ categoryList
+
+ "Created: / 25.2.2000 / 02:23:08 / cg"
+!
+
+categoryList:aValueHolder
+ categoryList notNil ifTrue:[
+ categoryList removeDependent:self
+ ].
+ categoryList := aValueHolder.
+ categoryList notNil ifTrue:[
+ categoryList addDependent:self
+ ].
+
+ "Created: / 18.8.2000 / 15:21:42 / cg"
+!
+
+classCategoryLabelHolder
+ ^ self pseudoListLabelHolder
+!
+
+selectedCategories
+ ^ self selectionHolder
+!
+
+selectedCategories:aValueHolder
+ ^ self selectionHolder:aValueHolder
+!
+
+selectionHolder
+"/ self halt.
+ ^ super selectionHolder
+!
+
+selectionHolder:aValueHolder
+ "/ self halt.
+ super selectionHolder:aValueHolder
+! !
+
+!ClassCategoryList methodsFor:'change & update'!
+
+delayedUpdate:something with:aParameter from:changedObject
+ |selectedCategories allSelectedBefore
+ nameListEntryForALL categoryOfClass wg|
+
+ selectedCategories := self selectedCategoriesStrings.
+
+ changedObject == Smalltalk ifTrue:[
+ ((something == #classVariables)
+ or:[something == #classDefinition]) ifTrue:[
+ listValid == true ifTrue:[
+ categoryOfClass := aParameter category.
+ (rawCategoryList includes:categoryOfClass) ifFalse:[
+ self invalidateList.
+ ].
+ slaveMode value ~~ true ifTrue:[
+ (selectedCategories includes:categoryOfClass) ifTrue:[
+ "/ a selected class has changed
+ "/ in order to give others a chance to update their list before,
+ "/ this one is always enqueued for delayed update (even if immediateUpdate is true)
+ "/ self enqueueDelayedUpdateOutputGenerator
+ self enqueueMessage:#updateOutputGenerator for:self arguments:#()
+ ].
+ ].
+ ].
+ ^ self
+ ].
+ something == #newClass ifTrue:[
+ categoryOfClass := aParameter category.
+ listValid == false ifTrue:[
+ ^ self
+ ].
+
+ (rawCategoryList includes:categoryOfClass) ifFalse:[
+ self invalidateList.
+ ].
+
+ slaveMode value ~~ true ifTrue:[
+ (selectedCategories includes:categoryOfClass) ifTrue:[
+ self enqueueDelayedUpdateOutputGenerator
+ ].
+ ].
+ ^ self
+ ].
+
+ self invalidateList.
+
+ (something == #classRemove
+ or:[something == #projectOrganization
+ or:[something == #organization]]) ifTrue:[
+ slaveMode value ~~ true ifTrue:[
+ "/ sorry: cannot filter on category (already changed to #removed)
+ self enqueueDelayedUpdateOutputGenerator
+ ].
+ ].
+ ^ self
+ ].
+
+ changedObject == ChangeSet ifTrue:[
+ "/ remove all other change notifications from the eventQueue
+ wg := self windowGroup.
+ wg isNil ifTrue:[
+ "/ oops - should no longer be dependent...
+ changedObject removeDependent:self.
+ ] ifFalse:[
+ wg sensor
+ flushEventsFor:self
+ where:[:ev | ev isMessageSendEvent
+ and:[ev selector == #delayedUpdate:with:from:
+ and:[(ev arguments at:3) == ChangeSet]]].
+ ].
+
+ something == #addChange: ifTrue:[
+ "/ only need to invalidate, if that change changes my emphasis
+ "/ (i.e. if its a new methodChange)
+ self window topView shown ifFalse:[
+ self invalidateList.
+ ^ self
+ ].
+
+"/ self invalidateList.
+
+ aParameter isMethodChange ifTrue:[
+ aParameter changeClass notNil ifTrue:[
+ (ChangeSet current
+ count:[:chg | chg notNil and:[chg isMethodChange
+ and:[ chg className = aParameter className ]]])
+ == 1 ifTrue:[
+ "/ that methodChange is the first for this method.
+ self colorizeCategoryAsChanged:(aParameter changeClass category).
+ ]
+ ]
+ ].
+ ^ self
+ ].
+
+ self invalidateList.
+ ^ self
+ ].
+
+ changedObject == nameSpaceFilter ifTrue:[
+ "/ all might be more or less than before ...
+ allSelected := false.
+ "/ self invalidateList - done in super
+ ].
+ changedObject == packageFilter ifTrue:[
+ "/ all might be more or less than before ...
+ allSelected := false.
+ "/ self invalidateList - done in super
+ ].
+
+ changedObject == self selectedCategories ifTrue:[
+ listValid ifFalse:[
+ "/ oops - hurry up
+ self invalidateList.
+ ].
+
+ nameListEntryForALL := self class nameListEntryForALL.
+
+ selectedCategories size > 1 ifTrue:[
+ (selectedCategories includes:nameListEntryForALL) ifTrue:[
+ self makeSelectionOtherThanAllVisible.
+ ]
+ ].
+
+ "/ if all selected before AND allSelected after, no need to update the output generator
+ allSelectedBefore := allSelected ? false.
+ allSelected := selectedCategories includes:nameListEntryForALL.
+ (allSelectedBefore and:[allSelected]) ifTrue:[
+ ^ self
+ ].
+ ].
+ changedObject == categoryList ifTrue:[
+ self halt.
+ ].
+ super delayedUpdate:something with:aParameter from:changedObject
+
+ "Created: / 5.2.2000 / 13:42:12 / cg"
+ "Modified: / 12.11.2001 / 19:36:16 / cg"
+!
+
+forceUpdateList
+ self categoryList setValue:#().
+ self updateList.
+ self categoryList changed.
+!
+
+selectionChangedByClick
+ "we are not interested in that - get another notification
+ via the changed valueHolder"
+
+ "Created: / 11.2.2000 / 11:39:48 / cg"
+!
+
+update:something with:aParameter from:changedObject
+ |categoryOfClass|
+
+ changedObject == Smalltalk ifTrue:[
+ (something == #methodInClass
+ or:[ something == #classComment
+ or:[ something == #methodDictionary
+ or:[ something == #methodTrap
+ or:[ something == #methodCoverageInfo
+ or:[ something == #methodInClassRemoved ]]]]]) ifTrue:[
+ ^ self
+ ].
+
+ (something == #classVariables
+ or:[something == #classDefinition]) ifTrue:[
+ categoryOfClass := aParameter category.
+ (self selectedCategoriesStrings includes:categoryOfClass) ifTrue:[
+"/ self halt.
+ self updateOutputGenerator.
+ ].
+ ].
+ ].
+
+"/ changedObject == ChangeSet ifTrue:[
+"/ something == #addChange: ifTrue:[
+"/ ^ self
+"/ ]
+"/ ].
+
+ super update:something with:aParameter from:changedObject
+
+ "Modified: / 20-07-2011 / 18:50:04 / cg"
+! !
+
+!ClassCategoryList methodsFor:'drag & drop'!
+
+canDropContext:aDropContext
+ |cat objects droppedClasses|
+
+ objects := aDropContext dropObjects collect:[:obj | obj theObject].
+ (self objectsAreClassFiles:objects) ifTrue:[^ true].
+
+ (objects conform:[:aClass | aClass isClass]) ifFalse:[^ false].
+ droppedClasses := objects.
+ (droppedClasses contains:[:aClass | aClass isPrivate not]) ifFalse:[^ false].
+
+ cat := self categoryAtTargetPointOf:aDropContext.
+ cat isNil ifTrue:[ ^ false ].
+ cat = '* obsolete *' ifTrue:[ ^ false ].
+
+ (droppedClasses contains:[:aClass | aClass category ~= cat]) ifFalse:[^ false].
+ ^ true.
+
+ "Modified: / 17-10-2006 / 18:28:04 / cg"
+!
+
+categoryAtTargetPointOf:aDropContext
+ |p categoryListView lineNr cat|
+
+ p := aDropContext targetPoint.
+
+ categoryListView := aDropContext targetWidget.
+
+ lineNr := categoryListView lineAtY:p y.
+ lineNr isNil ifTrue:[^ nil].
+
+ cat := rawCategoryList at:lineNr.
+ cat := cat string.
+ cat = self class nameListEntryForALL ifTrue:[^ nil].
+
+ (cat endsWith:(self stringForExtensions)) ifTrue:[
+ cat := cat copyWithoutLast:(self stringForExtensions size)
+ ].
+ ^ cat
+!
+
+doDropContext:aDropContext
+ |cat objects|
+
+ objects := aDropContext dropObjects collect:[:aDropObject | aDropObject theObject].
+ (objects conform:[:something | something isClass]) ifTrue:[
+ cat := self categoryAtTargetPointOf:aDropContext.
+ cat notNil ifTrue:[
+ self masterApplication moveClasses:objects toCategory:cat.
+ ].
+ ^ self
+ ].
+ (objects conform:[:something | something isFilename]) ifTrue:[
+ self dropClassFiles:objects.
+ ^ self
+ ].
+
+ "Modified: / 17-10-2006 / 18:29:25 / cg"
+! !
+
+!ClassCategoryList methodsFor:'generators'!
+
+makeGenerator
+ "return a generator which enumerates the classes from the selected category."
+
+ |cats hideUnloadedClasses allName nameSpaceFilter packageFilter
+ showChangedClasses showUnloaded showUndocumented showExtendedClasses inclusionTest changedClasses|
+
+ cats := self selectedCategoriesStrings.
+ cats size == 0 ifTrue:[
+ ^ #()
+ ].
+
+ allName := self class nameListEntryForALL.
+
+ (cats includes:allName) ifTrue:[
+ inGeneratorHolder value isOrderedCollection ifTrue:[
+ cats := rawCategoryList copyWithout:allName.
+ ]
+ ].
+
+ showChangedClasses := cats includes:(self class nameListEntryForChanged).
+ showUnloaded := cats includes:(self class nameListEntryForUnloaded).
+ showUndocumented := cats includes:(self class nameListEntryForUndocumented).
+ showExtendedClasses := cats includes:(self class nameListEntryForExtendedClasses).
+
+ hideUnloadedClasses := self hideUnloadedClasses value ? false.
+ nameSpaceFilter := self nameSpaceFilter value.
+ nameSpaceFilter notNil ifTrue:[
+ (nameSpaceFilter includes:allName) ifTrue:[nameSpaceFilter := nil].
+ ].
+ packageFilter := self packageFilter value.
+ packageFilter notNil ifTrue:[
+ (packageFilter includes:allName) ifTrue:[packageFilter := nil].
+ ].
+
+ (cats includes:allName) ifTrue:[
+ hideUnloadedClasses ifTrue:[
+ inclusionTest := [:cls | cls isLoaded].
+ ] ifFalse:[
+ inclusionTest := [:cls | true].
+ ].
+ ] ifFalse:[
+ inclusionTest :=
+ [:cls |
+ |cat isLoaded included|
+
+ isLoaded := cls isLoaded.
+ included := isLoaded not and:[ showUnloaded ].
+ included ifFalse:[
+ (hideUnloadedClasses not or:[isLoaded]) ifTrue:[
+ cat := cls category ? '* no category *'.
+ included := cats includes:cat.
+ included ifFalse:[
+ included := showChangedClasses
+ and:[ (changedClasses includes:cls theNonMetaclass)
+ or:[(changedClasses includes:cls theMetaclass)] ].
+ included ifFalse:[
+ included := showUndocumented
+ and:[ isLoaded
+ and:[ cls isPrivate not
+ and:[ (cls theMetaclass includesSelector:#documentation) not ]]].
+ included ifFalse:[
+ included := showExtendedClasses
+ and:[ cls hasExtensions ].
+ ].
+ ].
+ ].
+ ].
+ ].
+ included
+ ].
+ ].
+
+ ^ Iterator on:[:whatToDo |
+ showChangedClasses ifTrue:[ changedClasses := ChangeSet current changedClasses ].
+
+ Smalltalk allClassesDo:[:cls |
+ (cls isRealNameSpace) ifFalse:[
+ (inclusionTest value:cls) ifTrue:[
+ (nameSpaceFilter isNil
+ or:[self isClass:cls shownWithNameSpaceFilter:nameSpaceFilter]) ifTrue:[
+ (packageFilter isNil
+ or:[self isClass:cls shownWithPackageFilter:packageFilter]) ifTrue:[
+ whatToDo value:cls
+ ]
+ ]
+ ].
+ ].
+ ].
+ ].
+
+ "Created: / 05-02-2000 / 13:42:12 / cg"
+ "Modified: / 10-11-2006 / 17:13:26 / cg"
+! !
+
+!ClassCategoryList methodsFor:'private'!
+
+colorizeCategoryAsChanged:category
+ |colorizedCategoryItem categoryList idx|
+
+ colorizedCategoryItem := self colorizeForChangedCode:category copy asText.
+
+ categoryList := self categoryList value.
+ idx := categoryList indexOf:category.
+ idx ~~ 0 ifTrue:[
+ ((categoryList at:idx) sameStringAndEmphasisAs:colorizedCategoryItem) ifFalse:[
+ categoryList at:idx put:colorizedCategoryItem.
+ self categoryList changed.
+ ]
+ ].
+!
+
+listOfCategories
+ |categories categoriesBag hideUnloadedClasses generator nameSpaceFilter packageFilter allName
+ categoriesWithExtensions categoriesWithChangedCode categoriesWithRemoteChangedCode
+ classesInChangeSet classesInRemoteChangeSet classesWithExtensions
+ numClassesInChangeSet numClasses numUnloaded numUndocumented numExtendedClasses
+ pseudoEntryColor showCounts|
+
+ showCounts := true.
+
+ allName := self class nameListEntryForALL.
+
+ hideUnloadedClasses := self hideUnloadedClasses value.
+ nameSpaceFilter := self nameSpaceFilter value.
+ nameSpaceFilter notNil ifTrue:[
+ (nameSpaceFilter includes:allName) ifTrue:[nameSpaceFilter := nil].
+ ].
+ packageFilter := self packageFilter value.
+ packageFilter notNil ifTrue:[
+ (packageFilter includes:allName) ifTrue:[packageFilter := nil].
+ ].
+
+ numClasses := numUndocumented := numUnloaded := numClassesInChangeSet := numExtendedClasses := 0.
+
+ categories := Set new.
+ categoriesBag := Bag new.
+ categoriesWithExtensions := Set new.
+ categoriesWithChangedCode := Set new.
+ categoriesWithRemoteChangedCode := Set new.
+
+ classesInChangeSet := ChangeSet current changedClasses.
+ classesInChangeSet := classesInChangeSet collect:[:eachClass | eachClass theNonMetaclass].
+
+ classesInRemoteChangeSet := SmallTeam isNil ifTrue:[#()] ifFalse:[ SmallTeam changedClasses ].
+ classesInRemoteChangeSet := classesInRemoteChangeSet collect:[:each | each theNonMetaclass].
+
+ classesWithExtensions := IdentitySet new.
+
+ classes := IdentitySet new.
+ inGeneratorHolder isNil ifTrue:[
+ Smalltalk allClassesDo:[:cls |
+ |cat isLoaded|
+
+ (cls isRealNameSpace) ifFalse:[
+ (nameSpaceFilter isNil
+ or:[self isClass:cls shownWithNameSpaceFilter:nameSpaceFilter]) ifTrue:[
+ (packageFilter isNil
+ or:[self isClass:cls shownWithPackageFilter:packageFilter]) ifTrue:[
+
+ isLoaded := cls isLoaded.
+ isLoaded ifTrue:[
+ numUnloaded := numUnloaded + 1.
+ cls isPrivate ifFalse:[
+ (cls theMetaclass includesSelector:#documentation) ifFalse:[
+ numUndocumented := numUndocumented + 1.
+ ].
+ ].
+ ].
+
+ (hideUnloadedClasses not or:[isLoaded])
+ ifTrue:[
+ numClasses := numClasses + 1.
+
+ cat := cls category ? '* no category *'.
+ cat isString ifFalse:[self halt:'oops - strange category'].
+ categories add:cat.
+ classes add:cls.
+ categoriesBag add:cat.
+
+ (classesInChangeSet includes:cls theNonMetaclass) ifTrue:[
+ categoriesWithChangedCode add:cat
+ ].
+ (classesInRemoteChangeSet includes:cls theNonMetaclass) ifTrue:[
+ categoriesWithRemoteChangedCode add:cat
+ ].
+ cls hasExtensions ifTrue:[
+ categoriesWithExtensions add:cat.
+ classesWithExtensions add:cls.
+ numExtendedClasses := numExtendedClasses + 1.
+ ].
+ ]
+ ]
+ ]
+ ]
+ ].
+
+ "/ those are simulated - in ST/X, empty categories do not
+ "/ really exist; however, during browsing, it makes sense.
+ AdditionalEmptyCategories size > 0 ifTrue:[
+ "/ remove those that are present ...
+ AdditionalEmptyCategories := AdditionalEmptyCategories select:[:cat | (categories includes:cat) not].
+ categories addAll:AdditionalEmptyCategories.
+ categoriesBag addAll:AdditionalEmptyCategories withOccurrences:0.
+ ].
+ ] ifFalse:[
+ |setOfCategories|
+
+ generator := inGeneratorHolder value.
+ generator isNil ifTrue:[^ #() ].
+ setOfCategories := Set withAll:generator.
+ generator do:[:cat | categories add:cat string].
+
+ Smalltalk allClassesDo:[:each |
+ |cat|
+
+ each isNameSpace ifFalse:[
+ cat := each category string asSymbol.
+ (setOfCategories includes:cat) ifTrue:[
+ categoriesBag add:cat.
+ ].
+ ]
+ ].
+ ].
+
+ pseudoEntryColor := self class pseudoEntryForegroundColor.
+
+ categories := categories asOrderedCollection.
+
+ categories sort.
+ rawCategoryList := categories.
+
+ categories :=
+ categories collect:[:cat |
+ |item isInChangeSet|
+
+ isInChangeSet := categoriesWithChangedCode includes:cat.
+ isInChangeSet ifTrue:[
+ item := self colorizeForChangedCode:cat copy asText
+ ] ifFalse:[
+ (categoriesWithExtensions includes:cat) ifTrue:[
+ item := self colorizeForDifferentPackage:cat copy asText
+ "/ cannot add a + here - need separate list for presentation and filter
+ "/ cat , (self colorizeForDifferentPackage:self stringForExtensions)
+ ] ifFalse:[
+ (categoriesWithRemoteChangedCode includes:cat) ifTrue:[
+ item := self colorizeForChangedCodeInSmallTeam:cat copy asText
+ ] ifFalse:[
+ item := cat
+ ]
+ ]
+ ].
+ showCounts ifTrue:[
+ item := item , ((' (%1)' bindWith:(categoriesBag occurrencesOf:cat))
+ colorizeAllWith:pseudoEntryColor).
+ ].
+ isInChangeSet ifTrue:[
+ item := item , self class markForBeingInChangeList
+ ].
+
+ item
+ ].
+
+ numUndocumented > 0 ifTrue:[
+ rawCategoryList add:self class nameListEntryForUndocumented.
+ categories add:((self class nameListEntryForUndocumentedWithCount bindWith:numUndocumented) allItalic colorizeAllWith:pseudoEntryColor).
+ ].
+ numUnloaded > 0 ifTrue:[
+ rawCategoryList add:self class nameListEntryForUnloaded.
+ categories add:((self class nameListEntryForUnloadedWithCount bindWith:numUnloaded) allItalic colorizeAllWith:pseudoEntryColor).
+ ].
+ numExtendedClasses > 0 ifTrue:[
+ rawCategoryList add:self class nameListEntryForExtendedClasses.
+ categories add:((self class nameListEntryForExtendedClassesWithCount bindWith:numExtendedClasses) allItalic colorizeAllWith:pseudoEntryColor).
+ ].
+ numClassesInChangeSet := (ChangeSet current changedClasses collect:[:c | c theNonMetaclass]) asSet size.
+ numClassesInChangeSet > 0 ifTrue:[
+ rawCategoryList addFirst:self class nameListEntryForChanged.
+ categories addFirst:((self class nameListEntryForChangedWithCount bindWith:numClassesInChangeSet) allItalic colorizeAllWith:pseudoEntryColor).
+ ].
+
+ categories size > 0 ifTrue:[
+ categories size == 1 ifTrue:[
+ self classCategoryLabelHolder value:(categories first)
+ ].
+ rawCategoryList addFirst:self class nameListEntryForALL.
+ categories addFirst:((self class nameListEntryForALLWithCount bindWith:numClasses) allItalic colorizeAllWith:pseudoEntryColor).
+ ].
+
+ cookedCategoryList := categories.
+ ^ rawCategoryList.
+
+ "Created: / 05-02-2000 / 13:42:12 / cg"
+ "Modified: / 27-10-2012 / 12:34:19 / cg"
+!
+
+listView
+ ^ self componentAt:#List
+!
+
+makeDependent
+ Smalltalk addDependent:self.
+ ChangeSet addDependent:self.
+
+ "Created: / 5.2.2000 / 13:42:13 / cg"
+!
+
+makeIndependent
+ Smalltalk removeDependent:self.
+ ChangeSet removeDependent:self.
+
+ "Created: / 5.2.2000 / 13:42:13 / cg"
+!
+
+makeItemVisible:item
+ |idx listView|
+
+ idx := categoryList value indexOf:item.
+ idx ~~ 0 ifTrue:[
+ (listView := self listView) notNil ifTrue:[
+ listView makeLineVisible:idx.
+ ]
+ ]
+!
+
+makeSelectionOtherThanAllVisible
+ |selectedCategories item|
+
+ selectedCategories := self selectedCategoriesStrings.
+ "/ the first item after the *all* item
+ item := (selectedCategories copy remove:self class nameListEntryForALL; yourself) first.
+ self makeItemVisible:item.
+!
+
+release
+ super release.
+
+ categoryList removeDependent:self.
+!
+
+selectedCategoriesStrings
+ |selectedCategories stringForExtensions|
+
+ stringForExtensions := self stringForExtensions.
+
+ selectedCategories := self selectedCategories value ? #().
+
+"/ selectedCategories := selectedCategories
+"/ collect:[:each |
+"/ |s|
+"/ s := each string.
+"/ (s endsWith:stringForExtensions) ifTrue:[
+"/ s := s copyWithoutLast:(stringForExtensions size).
+"/ ].
+"/ s
+"/ ].
+ ^ selectedCategories
+
+ "Modified: / 23-08-2006 / 11:38:26 / cg"
+!
+
+stringForExtensions
+ ^ ' [ + ]'
+!
+
+updateList
+ |oldList newList oldSelection newSelection prevClasses
+ selectedCategoriesHolder|
+
+ selectedCategoriesHolder := self selectedCategories.
+ oldSelection := selectedCategoriesHolder value ? #().
+ prevClasses := classes copy.
+
+ newList := self listOfCategories. "/ sigh - sideeffect of setting rawList
+ oldList := (self categoryList value) ? #().
+ (newList sameContentsAs:oldList whenComparedWith:[:a :b | a sameStringAndEmphasisAs: b])
+ ifFalse:[
+ "/ a real change, or only emphasis ?
+ (newList sameContentsAs:oldList whenComparedWith:[:a :b | a asString string = b asString string]) ifTrue:[
+ "/ only emphasis
+ oldSelection size > 0 ifTrue:[
+ selectedCategoriesHolder removeDependent:self.
+ selectedCategoriesHolder value:#().
+ selectedCategoriesHolder addDependent:self.
+ ].
+ categoryList value:newList.
+
+ oldSelection size > 0 ifTrue:[
+ newSelection := oldSelection select:[:cat | newList includes:cat].
+ selectedCategoriesHolder value:newSelection.
+ ]
+ ] ifFalse:[
+ "/ a real change
+
+ categoryList value:newList.
+
+ "/ in case the same categories are present, but classes have changed ...
+ (prevClasses isNil or:[(classes identicalContentsAs:prevClasses) not]) ifTrue:[
+ self updateOutputGenerator.
+ ]
+ ]
+ ] ifTrue:[
+ "/ in case the same categories are present, but classes have changed ...
+ (prevClasses isNil or:[(classes identicalContentsAs:prevClasses) not]) ifTrue:[
+ self updateOutputGenerator.
+ ]
+ ].
+ listValid := true.
+
+ "Created: / 05-02-2000 / 13:42:13 / cg"
+ "Modified: / 17-08-2011 / 09:52:13 / cg"
+! !
+
+!ClassCategoryList methodsFor:'setup'!
+
+commonPostBuild
+ |listView|
+
+ listView := self listView.
+ listView notNil ifTrue:[
+ listView scrollWhenUpdating:nil
+ ].
+ super commonPostBuild
+!
+
+postBuildCategoryListView:aView
+ categoryListView := aView.
+ categoryListView visualBlock:[:view :lineNr | cookedCategoryList at:lineNr].
+ categoryListView selectedVisualBlock:[:view :lineNr | (cookedCategoryList at:lineNr) string]
+! !
+
+!ClassCategoryList methodsFor:'special'!
+
+addAdditionalCategory:aCategory
+ "/ those are simulated - in ST/X, empty categories do not
+ "/ really exist; however, during browsing, it makes sense.
+
+ self class addAdditionalCategory:aCategory
+!
+
+removeAdditionalCategories:aListOfCategories
+ self class removeAdditionalCategories:aListOfCategories
+!
+
+removeAllAdditionalCategories
+ self class removeAllAdditionalCategories
+!
+
+renameAdditionalCategories:oldNames to:newName
+ "/ those are simulated - in ST/X, empty categories do not
+ "/ really exist; however, during browsing, it makes sense.
+
+ self class renameAdditionalCategories:oldNames to:newName
+! !
+
+!ClassCategoryList class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassCategoryList.st,v 1.42 2013-03-20 10:37:35 cg Exp $'
+!
+
+version_CVS
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassCategoryList.st,v 1.42 2013-03-20 10:37:35 cg Exp $'
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Tools_ClassList.st Fri Mar 22 09:21:23 2013 +0000
@@ -0,0 +1,2035 @@
+"
+ COPYRIGHT (c) 2004 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+"{ Package: 'stx:libtool' }"
+
+"{ NameSpace: Tools }"
+
+BrowserList subclass:#ClassList
+ instanceVariableNames:'classList classNameList meta lastSelectedClasses
+ selectedClassNameIndices currentNamespace hidePrivateClasses
+ unloadedClassesColor markApplicationsHolder classFilterBlock
+ sortByNameAndInheritance outGeneratorHolderForMethods'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Interface-Browsers-New'
+!
+
+!ClassList class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 2004 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+!
+
+documentation
+"
+ embeddable application displaying the classes as listed by
+ the inputGenerator.
+ Provides an outputGenerator, which enumerates the classes and
+ their protocols (method-categories) in the selected classes.
+
+ [author:]
+ Claus Gittinger (cg@exept.de)
+"
+
+
+! !
+
+!ClassList class methodsFor:'interface specs'!
+
+singleClassWindowSpec
+ "This resource specification was automatically generated
+ by the UIPainter of ST/X."
+
+ "Do not manually edit this!! If it is corrupted,
+ the UIPainter may not be able to read the specification."
+
+ "
+ UIPainter new openOnClass:ClassList andSelector:#singleClassWindowSpec
+ ClassList new openInterface:#singleClassWindowSpec
+ "
+
+ <resource: #canvas>
+
+ ^
+ #(#FullSpec
+ #name: #windowSpec
+ #window:
+ #(#WindowSpec
+ #label: 'ClassList'
+ #name: 'ClassList'
+ #min: #(#Point 0 0)
+ #max: #(#Point 1024 721)
+ #bounds: #(#Rectangle 12 22 312 322)
+ )
+ #component:
+ #(#SpecCollection
+ #collection: #(
+ #(#LabelSpec
+ #label: 'ClassName'
+ #name: 'ClassLabel'
+ #layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 25 0)
+ #translateLabel: true
+ #labelChannel: #classLabelHolder
+ #menu: #menuHolder
+ )
+"/ #(#UISubSpecification
+"/ #name: 'MetaToggleSpec'
+"/ #layout: #(#LayoutFrame 0 0.0 -25 1.0 0 1.0 0 1.0)
+"/ #minorKey: #metaSpec
+"/ )
+ )
+
+ )
+ )
+!
+
+windowSpec
+ "This resource specification was automatically generated
+ by the UIPainter of ST/X."
+
+ "Do not manually edit this!! If it is corrupted,
+ the UIPainter may not be able to read the specification."
+
+ "
+ UIPainter new openOnClass:ClassList andSelector:#windowSpec
+ ClassList new openInterface:#windowSpec
+ ClassList open
+ "
+
+ <resource: #canvas>
+
+ ^
+ #(#FullSpec
+ #name: #windowSpec
+ #window:
+ #(#WindowSpec
+ #label: 'ClassList'
+ #name: 'ClassList'
+ #min: #(#Point 0 0)
+ #bounds: #(#Rectangle 16 46 316 346)
+ )
+ #component:
+ #(#SpecCollection
+ #collection: #(
+ #(#SequenceViewSpec
+ #name: 'List'
+ #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
+ #tabable: true
+ #model: #selectedClassNameIndices
+ #menu: #menuHolder
+ #hasHorizontalScrollBar: true
+ #hasVerticalScrollBar: true
+ #miniScrollerHorizontal: true
+ #isMultiSelect: true
+ #valueChangeSelector: #selectionChangedByClick
+ #useIndex: true
+ #sequenceList: #classNameList
+ #doubleClickChannel: #doubleClickChannel
+ #properties:
+ #(#PropertyListDictionary
+ #dragArgument: nil
+ #dropArgument: nil
+ #canDropSelector: #canDropContext:
+ #dropSelector: #doDropContext:
+ )
+ )
+ )
+
+ )
+ )
+! !
+
+!ClassList class methodsFor:'plugIn spec'!
+
+aspectSelectors
+ "This resource specification was automatically generated
+ by the UIPainter of ST/X."
+
+ "Do not manually edit this. If it is corrupted,
+ the UIPainter may not be able to read the specification."
+
+ "Return a description of exported aspects;
+ these can be connected to aspects of an embedding application
+ (if this app is embedded in a subCanvas)."
+
+ ^ #(
+ #currentNamespace
+ #(#doubleClickChannel #action )
+ #forceGeneratorTrigger
+ #hidePrivateClasses
+ #hideUnloadedClasses
+ #sortByNameAndInheritance
+ #immediateUpdate
+ #inGeneratorHolder
+ #menuHolder
+ #meta
+ #organizerMode
+ #outGeneratorHolder
+ #packageFilter
+ #nameSpaceFilter
+ #selectedClasses
+ #selectionChangeCondition
+ #showClassPackages
+ #slaveMode
+ #updateTrigger
+ #markApplicationsHolder
+ #showCoverageInformation
+ #outGeneratorHolderForMethods
+ ).
+
+ "Modified: / 04-07-2011 / 18:34:44 / cg"
+ "Modified: / 07-08-2011 / 19:02:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!ClassList methodsFor:'accessing'!
+
+markApplications
+ "return the value of the instance variable 'markApplications' (automatically generated)"
+
+ ^ self markApplicationsHolder value
+
+ "Created: / 3.11.2001 / 14:06:19 / cg"
+!
+
+markApplications:something
+ "set the value of the instance variable 'markApplications' (automatically generated)"
+
+ self markApplicationsHolder value:something.
+
+ "Created: / 3.11.2001 / 14:06:25 / cg"
+!
+
+unloadedClassesColor
+ "return the value of the instance variable 'unloadedClassesColor' (automatically generated)"
+
+ ^ unloadedClassesColor
+!
+
+unloadedClassesColor:something
+ "set the value of the instance variable 'unloadedClassesColor' (automatically generated)"
+
+ unloadedClassesColor := something.
+! !
+
+!ClassList methodsFor:'aspects'!
+
+classLabelHolder
+ ^ self pseudoListLabelHolder
+!
+
+classList
+ classList isNil ifTrue:[
+ classList := ValueHolder new.
+ ].
+ ^ classList
+
+ "Created: / 5.2.2000 / 13:42:16 / cg"
+ "Modified: / 25.2.2000 / 02:21:07 / cg"
+!
+
+classNameList
+ classNameList isNil ifTrue:[
+ classNameList := ValueHolder new
+ ].
+ ^ classNameList
+!
+
+currentNamespace:aValueHolder
+ currentNamespace notNil ifTrue:[
+ currentNamespace removeDependent:self
+ ].
+ currentNamespace := aValueHolder.
+ currentNamespace notNil ifTrue:[
+ currentNamespace isBehavior ifTrue:[self halt:'should not happen'].
+ currentNamespace addDependent:self
+ ].
+
+ "Modified: / 4.2.2000 / 23:34:28 / cg"
+ "Created: / 5.2.2000 / 21:37:57 / cg"
+!
+
+doubleClick
+ self halt:'should not happen'.
+!
+
+hidePrivateClasses
+ hidePrivateClasses isNil ifTrue:[
+ hidePrivateClasses := false asValue.
+ hidePrivateClasses addDependent:self.
+ ].
+ ^ hidePrivateClasses.
+
+ "Created: / 24.2.2000 / 15:06:44 / cg"
+!
+
+hidePrivateClasses:aValueHolder
+ hidePrivateClasses notNil ifTrue:[
+ hidePrivateClasses removeDependent:self
+ ].
+ hidePrivateClasses := aValueHolder.
+ hidePrivateClasses notNil ifTrue:[
+ hidePrivateClasses addDependent:self
+ ].
+
+ "Created: / 24.2.2000 / 15:06:46 / cg"
+!
+
+markApplicationsHolder
+ markApplicationsHolder isNil ifTrue:[
+ markApplicationsHolder := true asValue.
+ markApplicationsHolder addDependent:self.
+ ].
+ ^ markApplicationsHolder.
+!
+
+markApplicationsHolder:aValueHolder
+ markApplicationsHolder notNil ifTrue:[
+ markApplicationsHolder removeDependent:self
+ ].
+ markApplicationsHolder := aValueHolder.
+ markApplicationsHolder notNil ifTrue:[
+ markApplicationsHolder addDependent:self
+ ].
+
+ "Created: / 24.2.2000 / 15:06:46 / cg"
+!
+
+meta
+ meta isNil ifTrue:[
+ meta := false asValue.
+ meta addDependent:self
+ ].
+ ^ meta
+
+ "Modified: / 31.1.2000 / 01:19:59 / cg"
+ "Created: / 5.2.2000 / 13:42:16 / cg"
+!
+
+meta:aValueHolder
+"/ (aValueHolder == true or:[aValueHolder == false]) ifTrue:[self halt].
+
+ meta notNil ifTrue:[
+ meta removeDependent:self
+ ].
+ meta := aValueHolder.
+ meta notNil ifTrue:[
+ meta addDependent:self
+ ].
+!
+
+selectClass:aClass
+ self selectedClasses value:(Array with:aClass)
+!
+
+selectedClassNameIndices
+ selectedClassNameIndices isNil ifTrue:[
+ selectedClassNameIndices := #() asValue.
+ selectedClassNameIndices addDependent:self
+ ].
+ ^ selectedClassNameIndices.
+
+ "Created: / 5.2.2000 / 21:31:48 / cg"
+ "Modified: / 5.2.2000 / 21:43:02 / cg"
+!
+
+selectedClasses
+ "bad name- it's a holder, baby"
+
+ ^ self selectionHolder
+!
+
+selectedClasses:aValueHolder
+ "bad name- its a holder, baby"
+
+ ^ self selectionHolder:aValueHolder
+!
+
+showClassPackages
+ showClassPackages isNil ifTrue:[
+ showClassPackages := false asValue.
+ showClassPackages addDependent:self.
+ ].
+ ^ showClassPackages.
+
+ "Created: / 24.2.2000 / 15:06:44 / cg"
+!
+
+showClassPackages:aValueHolder
+ showClassPackages notNil ifTrue:[
+ showClassPackages removeDependent:self
+ ].
+ showClassPackages := aValueHolder.
+ showClassPackages notNil ifTrue:[
+ showClassPackages addDependent:self
+ ].
+!
+
+sortByNameAndInheritance
+ sortByNameAndInheritance isNil ifTrue:[
+ sortByNameAndInheritance := false asValue.
+ sortByNameAndInheritance addDependent:self.
+ ].
+ ^ sortByNameAndInheritance.
+
+ "Created: / 04-07-2011 / 18:28:15 / cg"
+!
+
+sortByNameAndInheritance:aValueHolder
+ sortByNameAndInheritance notNil ifTrue:[
+ sortByNameAndInheritance removeDependent:self
+ ].
+ sortByNameAndInheritance := aValueHolder.
+ sortByNameAndInheritance notNil ifTrue:[
+ sortByNameAndInheritance addDependent:self
+ ].
+
+ "Created: / 04-07-2011 / 18:33:43 / cg"
+! !
+
+!ClassList methodsFor:'change & update'!
+
+classDefinitionChanged:aClassOrNil
+
+ listValid ifFalse:[^ self].
+
+ slaveMode value == true ifTrue:[
+ self invalidateList.
+ ^ self.
+ ].
+ self slaveMode value isNil ifTrue:[
+ self window shown ifFalse:[
+ self invalidateList.
+ ^ self
+ ].
+ ].
+
+ aClassOrNil isNil ifTrue:[
+ self halt:'should not happen'.
+ ].
+
+ "/ if that class is in my list ...
+ ((self classList value ? #()) contains:[:cls | cls notNil and:[cls theNonMetaclass name = aClassOrNil theNonMetaclass name]])
+ ifTrue:[
+ self updateListsFor:aClassOrNil.
+ "/ force update
+ self selectedClassNameIndices value:(self selectedClassNameIndices value).
+
+ ((self selectedClasses value ? #()) contains:[:cls | cls notNil ifTrue:[cls theNonMetaclass name = aClassOrNil theNonMetaclass name] ifFalse:[false]])
+ ifTrue:[
+ self updateOutputGenerator
+ ].
+ ] ifFalse:[
+ self invalidateList
+ ]
+
+
+ "Modified: / 29.2.2000 / 00:15:23 / cg"
+!
+
+classRemoved:aClass
+ |list|
+
+ list := self classList value.
+ list notNil ifTrue:[
+ (list includesIdentical:aClass) ifTrue:[
+ self invalidateList.
+ ]
+ ]
+
+ "Modified: / 25.2.2000 / 23:53:51 / cg"
+!
+
+delayedUpdate:something with:aParameter from:changedObject
+ |cls classes chgClass wg savedList|
+
+ classes := self classList value ? #().
+
+"/ (self slaveMode value == true) ifTrue:[^ self].
+"/ self slaveMode value isNil ifTrue:[
+"/ self window shown ifFalse:[
+"/ self invalidateList.
+"/ ^ self
+"/ ].
+"/ ].
+
+ changedObject == slaveMode ifTrue:[
+ "/ a previously suppressed update is now due
+ listValid ~~ true ifTrue:[
+ self enqueueDelayedUpdateList.
+ ].
+ self enqueueDelayedClassSelectionChanged.
+ ^ self
+ ].
+
+ changedObject == self selectedClasses ifTrue:[
+ self inSlaveMode ifFalse:[
+ savedList := self selectedClasses value.
+ lastSelectedClasses := nil.
+ listValid == true ifFalse:[
+ self updateList
+ ].
+ self selectedClasses setValue:savedList.
+ self selectedClassesChanged.
+ self updateOutputGenerator.
+ ] ifTrue:[
+"/ listValid := false.
+ self selectedClassesChanged.
+ ].
+ ^ self
+ ].
+
+ (changedObject == meta
+ or:[changedObject == selectedClassNameIndices]) ifTrue:[
+ self inSlaveMode ifFalse:[
+ self selectionChanged.
+ ] ifTrue:[
+ listValid := false.
+ self selectedClassesChanged.
+ ].
+ ^ self
+ ].
+
+ self inSlaveModeOrInvisible ifTrue:[
+ self invalidateList.
+ ^ self.
+ ].
+
+ changedObject == Smalltalk ifTrue:[
+ something == #methodInClass ifTrue:[
+ ^ self "no interest"
+ ].
+ something == #methodInClassRemoved ifTrue:[
+ "/ must update the list, if the methods package is different from
+ "/ the classes package (to undo any has-exension highlighting)
+ cls := aParameter first.
+ self updateListsFor:cls.
+ ^ self
+ ].
+ something == #organization ifTrue:[^ self "no interest" ].
+
+ (something == #classDefinition
+ or:[something == #classVariables
+ or:[something == #newClass]]) ifTrue:[
+ "/ update that class in my classList and the selection
+ listValid ifTrue:[
+ self classDefinitionChanged:aParameter.
+ ].
+ ^ self.
+ ].
+ (something == #lastTestRunResult) ifTrue:[
+ "/ update that class in my classList and the selection
+ listValid ifTrue:[
+ self updateListsFor:aParameter.
+ "/ self classDefinitionChanged:aParameter.
+ ].
+ ^ self.
+ ].
+ something == #classRemove ifTrue:[
+ "/ update my classList and the selection
+ self classRemoved:aParameter.
+ ^ self.
+ ].
+ something == #classRename ifTrue:[
+ "/ update that class in my classList and the selection
+ listValid ifTrue:[
+ aParameter isArray ifTrue:[
+ cls := aParameter at:1.
+ self classDefinitionChanged:cls.
+ ]
+ ].
+ ^ self.
+ ].
+
+ something == #projectOrganization ifTrue:[
+ aParameter isNil ifTrue:[
+ self invalidateList.
+ organizerMode value == #project ifTrue:[
+ self enqueueDelayedUpdateOutputGenerator.
+ ].
+ ^ self
+ ].
+
+ cls := aParameter at:1.
+ cls notNil ifTrue:[ "/ should not happen (but does occasionally)
+ ((classes includes:cls theMetaclass)
+ or:[(classes includes:cls theNonMetaclass)]) ifTrue:[
+ self invalidateList.
+ organizerMode value == #project ifTrue:[
+ self enqueueDelayedUpdateOutputGenerator.
+ ]
+ ].
+ ].
+ ^ self
+ ].
+ ^ self.
+ ].
+
+ (something == #lastTestRunResult) ifTrue:[
+ ^ self
+ ].
+
+ changedObject == ChangeSet ifTrue:[
+ wg := self windowGroup.
+ wg isNil ifTrue:[
+ changedObject removeDependent:self.
+ ] ifFalse:[
+ "/ react on changes of the changeSet to recolorize items
+ ((something ~~ #addChange:)
+ or:[
+ chgClass := aParameter changeClass.
+ chgClass notNil
+ and:[ (classes includes:chgClass theNonMetaclass)
+ or:[classes includes:chgClass theMetaclass]]
+ ]
+ ) ifTrue:[
+ wg sensor
+ flushEventsFor:self
+ where:[:ev | ev isMessageSendEvent
+ and:[ev selector == #delayedUpdate:with:from:
+ and:[(ev arguments at:3) == ChangeSet]]].
+ self enqueueDelayedAction:[self reconstructNameList].
+ ].
+ ].
+ ^ self
+ ].
+
+ changedObject == showClassPackages ifTrue:[
+ self classNameList value:nil.
+ self invalidateList.
+ ^ self
+ ].
+
+ (changedObject == hideUnloadedClasses
+ or:[changedObject == hidePrivateClasses
+ or:[changedObject == nameSpaceFilter
+ or:[changedObject == packageFilter]]]) ifTrue:[
+ self invalidateList.
+ ^ self
+ ].
+
+ super delayedUpdate:something with:aParameter from:changedObject
+
+ "Modified: / 13.11.2001 / 11:32:10 / cg"
+!
+
+enqueueDelayedClassSelectionChanged
+ (NewSystemBrowser synchronousUpdate == true
+ or:[ immediateUpdate value == true ])
+ ifTrue:[
+ self selectedClassesChanged.
+ ^ self.
+ ].
+
+ self enqueueMessage:#selectedClassesChanged for:self arguments:#()
+!
+
+getSelectedClassIndicesFromClasses
+ "the class selection has changed;
+ return a collection of selection-indices"
+
+ |classes selectedClasses numSelected|
+
+ classes := self classList value.
+ selectedClasses := self selectedClasses value.
+
+ numSelected := selectedClasses size.
+ numSelected == 0 ifTrue:[
+ ^ #()
+ ].
+
+ numSelected == classes size ifTrue:[
+ "/ all selected - easy
+ ^ (1 to:numSelected) asOrderedCollection
+ ].
+ meta value ifTrue:[
+ classes := classes collect:[:eachClass | eachClass theMetaclass].
+ ].
+
+ classes := selectedClasses collect:[:aSelectedClass | classes identityIndexOf:aSelectedClass.].
+ classes := classes select:[:idx | idx ~= 0].
+ ^ classes
+
+ "Created: / 24.2.2000 / 19:47:52 / cg"
+!
+
+getSelectedClassesFromIndices
+ "the selection-index collection has changed;
+ return a collection of corresponding classes"
+
+ |selected classes allEntrySelected isMeta anyLost selectedClassNameIndices|
+
+ allEntrySelected := false.
+
+ classes := classList value.
+ classes isNil ifTrue:[
+ self updateList.
+ classes := classList value.
+ ].
+
+ isMeta := meta value.
+ anyLost := false.
+
+ selectedClassNameIndices := self selectedClassNameIndices value.
+ selectedClassNameIndices size == classes size ifTrue:[
+ selectedClassNameIndices size == 0 ifTrue:[^ #()].
+ isMeta ifTrue:[
+ ^ classes collect:[:eachClass | eachClass theMetaclass].
+ ].
+ ^ classes collect:[:eachClass | eachClass theNonMetaclass].
+ ].
+
+ selected := selectedClassNameIndices
+ collect:[:idx |
+ |cls|
+
+ cls := classes at:idx.
+ cls == (self class nameListEntryForALL) ifTrue:[
+ allEntrySelected := true.
+ ] ifFalse:[
+ cls notNil ifTrue:[
+ isMeta ifTrue:[
+ cls := cls theMetaclass
+ ] ifFalse:[
+ cls := cls theNonMetaclass
+ ].
+ ] ifFalse:[
+ anyLost := true
+ ].
+ ].
+ cls
+ ].
+ anyLost ifTrue:[
+ selected := selected select:[:each | each notNil].
+ ].
+
+"/ allEntrySelected ifTrue:[
+"/ selected := classList value select:[:cls | cls ~~ AllEntry].
+"/ meta value ifTrue:[
+"/ selected := selected collect:[:cls | cls theMetaclass].
+"/ ] ifFalse:[
+"/ selected := selected collect:[:cls | cls theNonMetaclass].
+"/ ].
+"/ ].
+
+ ^ selected.
+
+ "Created: / 24.2.2000 / 19:43:37 / cg"
+!
+
+selectedClassesChanged
+ |indices selectedClassNameIndicesHolder|
+
+ self classList value size == 0 ifTrue:[
+ "/ this may happen during early startup,
+ "/ when invoked with a preset classSelection,
+ "/ and the classGenerator has not yet been setup
+ "/ to not clobber the selection, defer the update
+ "/ until the classList arrives ...
+ ^ self
+ ].
+ "/ lastSelectedClasses := self selectedClasses value copy.
+
+ indices := self getSelectedClassIndicesFromClasses.
+ selectedClassNameIndicesHolder := self selectedClassNameIndices.
+ selectedClassNameIndicesHolder value ~= indices ifTrue:[
+ "/ in slaveMode, do not update selectedClasses from indices
+ true "slaveMode value" ifTrue:[
+ selectedClassNameIndicesHolder value:indices withoutNotifying:self
+ ] ifFalse:[
+ selectedClassNameIndicesHolder value:indices.
+ ]
+ ]
+
+ "Created: / 13.2.2000 / 22:18:10 / cg"
+ "Modified: / 24.2.2000 / 19:48:56 / cg"
+!
+
+selectionChanged
+ "the lists selection has changed. Since the list uses indices,
+ update the corresponding selectedClasses collection"
+
+ |selected prevSelection selectedClassesHolder|
+
+ selectedClassesHolder := self selectedClasses.
+
+ selected := self getSelectedClassesFromIndices.
+
+ prevSelection := selectedClassesHolder value ? #().
+
+ prevSelection ~= selected ifTrue:[
+ selectedClassesHolder value:selected.
+ ].
+!
+
+selectionChangedByClick
+ "we are not interested in that - get another notification
+ via the changed valueHolder"
+
+ |selected master|
+
+ selected := self getSelectedClassesFromIndices.
+ (selected = lastSelectedClasses and:[selected size == 1])
+ ifTrue:[
+ "/ thats a kludge - we want to turn off the protocol selection,
+ "/ when a class is reselected.
+
+ masterApplication notNil ifTrue:[
+ master := masterApplication.
+ masterApplication masterApplication notNil ifTrue:[
+ master := masterApplication masterApplication.
+ ].
+ (master respondsTo:#classReselected) ifTrue:[
+ master classReselected.
+ ].
+ ]
+ ] ifFalse:[
+ lastSelectedClasses := selected copy.
+ ]
+!
+
+update:something with:aParameter from:changedObject
+ |cls sel mthd newMethod oldMethod idx classListValue|
+
+ self inSlaveMode ifTrue:[
+ something == #methodInClass ifTrue:[ ^ self ].
+ something == #addChange: ifTrue:[ self invalidateList. ^ self ].
+ something == #methodCoverageInfo ifTrue:[ self invalidateList. ^ self ].
+ ].
+"/ self window sensor isNil ifTrue:[
+"/ "/ not visible ...
+"/ self invalidateList.
+"/ ^ self
+"/ ].
+
+ classListValue := classList value.
+
+ changedObject == Smalltalk ifTrue:[
+ something == #classComment ifTrue:[
+ ^ self.
+ ].
+ something == #methodDictionary ifTrue:[
+ ^ self
+ ].
+ something == #methodTrap ifTrue:[
+ ^ self
+ ].
+ something == #coverageInfo ifTrue:[
+ listValid == true ifTrue:[
+ self enqueueDelayedUpdateList
+ ].
+ ^ self.
+ ].
+ something == #methodCoverageInfo ifTrue:[
+ listValid == true ifTrue:[
+ mthd := aParameter.
+ cls := mthd mclass.
+ cls notNil ifTrue:[
+ classListValue size > 0 ifTrue:[
+ ((classListValue includesIdentical:cls theNonMetaclass)
+ or:[(classListValue includesIdentical:cls theMetaclass)]) ifTrue:[
+ self enqueueDelayedUpdateList
+ ]
+ ]
+ ].
+ ].
+ ^ self
+ ].
+ something == #lastTestRunResult ifTrue:[
+ cls := aParameter at:1.
+ sel := aParameter at:2.
+ (cls notNil and:[sel isNil]) ifTrue:[
+ classListValue size > 0 ifTrue:[
+ ((classListValue includesIdentical:cls theNonMetaclass)
+ or:[(classListValue includesIdentical:cls theMetaclass)]) ifTrue:[
+ self enqueueDelayedUpdateList
+ ]
+ ]
+ ].
+ ^ self
+ ].
+
+ something == #methodInClassRemoved ifTrue:[
+ self inSlaveMode ifFalse:[
+ cls := aParameter at:1.
+ cls notNil ifTrue:[
+ classListValue size > 0 ifTrue:[
+ ((classListValue includesIdentical:cls theNonMetaclass)
+ or:[(classListValue includesIdentical:cls theMetaclass)]) ifTrue:[
+ self enqueueDelayedUpdateList
+ ]
+ ]
+ ].
+ ].
+ ^ self
+ ].
+
+ something == #methodInClass ifTrue:[
+ cls := aParameter at:1.
+ cls notNil ifTrue:[
+ classListValue size > 0 ifTrue:[
+ ((classListValue includesIdentical:cls theNonMetaclass)
+ or:[(classListValue includesIdentical:cls theMetaclass)]) ifTrue:[
+ newMethod := cls compiledMethodAt:(aParameter at:2).
+ oldMethod := aParameter at:3.
+ ((oldMethod isNil
+ and:[newMethod package ~= cls package])
+ or:[oldMethod notNil
+ and:[newMethod package ~= oldMethod package]])
+ ifTrue:[
+ "/ must update the list (for the package-info)
+ self enqueueDelayedUpdateList
+ ]
+ ]
+ ]
+ ].
+ ^ self
+ ].
+
+ "/ kludge: must be careful if my inGenerator is a constant list.
+ "/ in that case, I have to update it
+ "/ (sigh - all a consequence of not #becoming the new class)
+ ((something == #classDefinition) or:[something == #newClass]) ifTrue:[
+ inGeneratorHolder value isOrderedCollection ifTrue:[
+ idx := inGeneratorHolder value findFirst:[:eachClass | eachClass name = aParameter theNonMetaclass name].
+ idx ~~ 0 ifTrue:[
+ inGeneratorHolder value at:idx put:aParameter.
+ self updateListsFor:aParameter.
+ "/ self enqueueDelayedUpdateList.
+ ]
+ ] ifFalse:[
+ classListValue size > 0 ifTrue:[
+ idx := classListValue findFirst:[:eachClass | eachClass name = aParameter theNonMetaclass name].
+ idx ~~ 0 ifTrue:[
+ listValid ifTrue:[
+ self classDefinitionChanged:aParameter.
+ ^ self.
+ ]
+ ]
+ ].
+ ].
+ ].
+ ].
+
+ changedObject == sortByNameAndInheritance ifTrue:[
+ self invalidateList.
+ ^ self.
+ ].
+
+ super update:something with:aParameter from:changedObject
+
+ "Modified: / 05-06-2012 / 23:39:34 / cg"
+! !
+
+!ClassList methodsFor:'drag & drop'!
+
+canDropContext:aDropContext
+ |objects|
+
+ objects := aDropContext dropObjects collect:[:obj | obj theObject].
+ (objects conform:[:anObject | anObject isMethod]) ifTrue:[
+ |methods cls|
+
+ methods := objects.
+ cls := self classAtTargetPointOf:aDropContext.
+ cls isNil ifTrue:[^ false].
+
+ ^ methods contains:[:aMethod | aMethod mclass ~= cls]
+ ].
+ (self objectsAreClassFiles:objects) ifTrue:[^ true].
+ ^ false.
+
+ "Modified: / 17-10-2006 / 18:26:07 / cg"
+!
+
+classAtTargetPointOf:aDropContext
+ |p classListView lineNr cls|
+
+ p := aDropContext targetPoint.
+
+ classListView := aDropContext targetWidget.
+
+ lineNr := classListView lineAtY:p y.
+ lineNr isNil ifTrue:[^ nil].
+
+ cls := classList value at:lineNr.
+ ^ cls
+!
+
+doDropContext:aDropContext
+ |objects browser|
+
+ browser := self masterApplication.
+
+ objects := aDropContext dropObjects collect:[:aDropObject | aDropObject theObject].
+ (objects conform:[:something | something isMethod]) ifTrue:[
+ |cls methods|
+
+ methods := objects.
+ cls := self classAtTargetPointOf:aDropContext.
+ methods first mclass isMeta ifTrue:[
+ cls := cls theMetaclass
+ ].
+
+ cls notNil ifTrue:[
+ methods := methods reject:[:mthd | mthd mclass theNonMetaclass == cls theNonMetaclass].
+ methods notEmpty ifTrue:[
+ aDropContext dragType == DropContext dragTypeCopy ifTrue:[
+ browser copyMethods:methods toClass:cls.
+ ] ifFalse:[
+ browser moveMethods:methods toClass:cls.
+ ].
+ ]
+ ].
+ ^ self
+ ].
+ (objects conform:[:something | something isFilename]) ifTrue:[
+ self dropClassFiles:objects.
+ ^ self
+ ].
+
+ "Modified: / 21-10-2006 / 20:39:55 / cg"
+! !
+
+!ClassList methodsFor:'generators'!
+
+makeGenerator
+ "return a generator which enumerates the method categories from the selected class;
+ that generator generates 2-element elements (includes the class), in order
+ to make the consumers only depend on one input (i.e. no need for another
+ classHolder in the methodList)."
+
+ ^ Iterator
+ on:[:whatToDo |
+ |allEntry classes cls already anyMethod packages classIsInPackage
+ showChanged changedClasses|
+
+ allEntry := self class nameListEntryForALL.
+
+ classes := self selectedClasses value ? #().
+ packages := packageFilter value value.
+
+ (packages notNil and:[packages includes:allEntry]) ifTrue:[packages := nil].
+
+ showChanged := packages notNil and:[packages includes:NavigatorModel nameListEntryForChanged].
+ showChanged ifTrue:[
+ changedClasses := ChangeSet current changedClasses.
+ ].
+
+ classes do:[:cls |
+ (cls notNil and:[cls ~~ allEntry]) ifTrue:[
+ anyMethod := false.
+ classIsInPackage := packages isNil
+ or:[(packages includes:cls package)
+ or:[ showChanged and:[changedClasses includes:cls]] ].
+
+ cls theNonMetaclass isJavaClass ifTrue:[
+ cls isMeta ifTrue:[
+ whatToDo value:cls theNonMetaclass value:(self class nameListEntryForStatic).
+ ] ifFalse:[
+ whatToDo value:cls value:(self class nameListEntryForNonStatic).
+ ]
+ ] ifFalse:[
+ cls supportsMethodCategories ifFalse:[
+ whatToDo value:cls value:(self class nameListEntryForNILCategory).
+ ] ifTrue:[
+ already := Set new.
+ cls methodDictionary keysAndValuesDo:[:sel :mthd |
+ |cat|
+
+ cat := mthd category.
+ (already includes:cat) ifFalse:[
+ (classIsInPackage
+ or:[packages isNil
+ or:[(packages includes:mthd package) ]])
+ ifTrue:[
+ already add:cat.
+ whatToDo value:cls value:cat.
+ ]
+ ]
+ ].
+ ].
+ ].
+
+ anyMethod ifFalse:[
+ "/ tell the one below, which classes are seen here,
+ "/ (even if no method is present)
+ "/ to allow him to decide if the className is to be shown in the list
+ whatToDo value:cls value:nil.
+ ].
+ ].
+ ].
+ ]
+
+ "Modified: / 24.2.2000 / 23:18:26 / cg"
+!
+
+makeGeneratorForMethods
+
+ ^ Iterator
+ on:[:whatToDo |
+ |allEntry classes cls already packages classIsInPackage
+ showChanged changedClasses cat |
+
+ allEntry := self class nameListEntryForALL.
+
+ classes := self selectedClasses value ? #().
+ packages := packageFilter value value.
+ (packages notNil and:[packages includes:allEntry]) ifTrue:[packages := nil].
+
+ showChanged := packages notNil and:[packages includes:NavigatorModel nameListEntryForChanged].
+ showChanged ifTrue:[
+ changedClasses := ChangeSet current changedClasses.
+ ].
+
+ classes do:[:cls |
+ (cls notNil and:[cls ~~ allEntry]) ifTrue:[
+ classIsInPackage := packages isNil
+ or:[(packages includes:cls package)
+ or:[ showChanged and:[changedClasses includes:cls]] ].
+ cls isMeta ifTrue:[
+ cat := self class nameListEntryForStatic.
+ ] ifFalse:[
+ cat := self class nameListEntryForNonStatic.
+ ].
+ cls methodDictionary keysAndValuesDo:[:sel :mthd |
+ whatToDo value:cls value:cat value:sel value:mthd.
+ ].
+
+ ].
+ ].
+ ]
+
+ "Modified: / 24-02-2000 / 23:18:26 / cg"
+ "Created: / 07-08-2011 / 19:01:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+outGeneratorHolderForMethods
+ ^ outGeneratorHolderForMethods
+!
+
+outGeneratorHolderForMethods:something
+ outGeneratorHolderForMethods := something.
+!
+
+updateOutputGenerator
+ "create a generator which enumerates my elements,
+ and place it into the outputGenerator holder"
+
+ super updateOutputGenerator.
+ outGeneratorHolderForMethods notNil ifTrue:[
+ outGeneratorHolderForMethods value: self makeGeneratorForMethods.
+ ].
+
+ "Modified: / 04-02-2000 / 17:16:34 / cg"
+ "Created: / 05-02-2000 / 13:42:08 / cg"
+ "Created: / 07-08-2011 / 18:51:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!ClassList methodsFor:'initialize-release'!
+
+release
+ super release.
+
+ currentNamespace removeDependent:self.
+ sortByNameAndInheritance removeDependent:self.
+ hidePrivateClasses removeDependent:self.
+ markApplicationsHolder removeDependent:self.
+ meta removeDependent:self.
+ selectedClassNameIndices removeDependent:self.
+ showClassPackages removeDependent:self.
+
+ "Created: / 05-02-2000 / 13:42:18 / cg"
+! !
+
+!ClassList methodsFor:'private'!
+
+listOfClasses
+ |classesAlready classesOrdered generator nameSpaceFilter packageFilter allName hidePrivate
+ privateClassesPerClass nameFilterIncludesMatchCharacters lcNameFilter|
+
+ self sortByNameAndInheritance value ifTrue:[
+ ^ self listOfClassesByInheritance
+ ].
+
+ allName := self class nameListEntryForALL.
+ (self showAllClassesInNameSpaceOrganisation value) ifFalse:[
+ nameSpaceFilter := self nameSpaceFilter value.
+ nameSpaceFilter notNil ifTrue:[
+ (nameSpaceFilter includes:allName) ifTrue:[
+ nameSpaceFilter := nil
+ ].
+ ].
+ ].
+"/ packageFilter := self packageFilter value.
+"/ packageFilter notNil ifTrue:[
+"/ (packageFilter includes:allName) ifTrue:[packageFilter := nil].
+"/ ].
+
+ inGeneratorHolder isNil ifTrue:[
+ "/ for standAlone testing
+ generator := Smalltalk allClasses.
+ (self hideUnloadedClasses value) ifTrue:[
+ generator := generator select:[:cls | cls isLoaded]
+ ].
+ ] ifFalse:[
+ generator := inGeneratorHolder value.
+ generator isNil ifTrue:[^ #() ].
+ ].
+
+ classesAlready := IdentitySet new.
+ classesOrdered := OrderedCollection new.
+ hidePrivate := self hidePrivateClasses value.
+
+ privateClassesPerClass := IdentityDictionary new.
+ nameFilterIncludesMatchCharacters := nameFilter notNil and:[nameFilter includesMatchCharacters].
+ nameFilter notNil ifTrue:[ lcNameFilter := nameFilter asLowercase].
+
+ generator do:[:cls |
+ |owner bucket|
+
+ "JV@2011-08-07: FIXME: Ugly code, hard to extend!! And duplicated in listOfClassesByInheritance !!!!!!!!"
+ (hidePrivate not or:[cls isPrivate not])
+ ifTrue:[
+ (nameSpaceFilter isNil
+ or:[self isClass:cls shownWithNameSpaceFilter:nameSpaceFilter]) ifTrue:[
+ (packageFilter isNil
+ or:[self isClass:cls shownWithPackageFilter:packageFilter]) ifTrue:[
+ (classesAlready includes:cls) ifFalse:[
+ (classFilterBlock isNil
+ or:[(classFilterBlock value:cls)]) ifTrue:[
+ classesAlready add:cls.
+ (nameFilter isNil
+ or:[ (nameFilterIncludesMatchCharacters not and:[ cls name asLowercase startsWith:lcNameFilter])
+ or:[ (nameFilterIncludesMatchCharacters and:[nameFilter match:cls name ignoreCase:true]) ]]) ifTrue:[
+ (owner := cls owningClass) notNil ifTrue:[
+ bucket := privateClassesPerClass
+ at:owner
+ ifAbsentPut:[SortedCollection new
+ sortBlock:[:a :b | (a name ? '?') < (b name ? '?')] ].
+ bucket add:cls.
+ ] ifFalse:[
+ "Do not show Java anonymous classes"
+ cls isJavaClass ifTrue:[
+ cls isAnonymous ifFalse:[
+ classesOrdered add:cls.
+ ]
+ ] ifFalse:[
+ classesOrdered add:cls.
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
+ ].
+
+ "/ are there any private classes, for which the owner is not in the list ?
+ privateClassesPerClass keysAndValuesDo:[:eachOwnerClass :privateClasses|
+ (classesAlready includes:eachOwnerClass) ifFalse:[
+ classesOrdered add:eachOwnerClass.
+ classesAlready add:eachOwnerClass.
+"/ privateClasses do:[:privateClass |
+"/ (classesOrdered includes:privateClass) ifFalse:[
+"/ classesOrdered add:privateClass.
+"/ ].
+"/ ].
+ ].
+ ].
+
+ classesOrdered size == 1 ifTrue:[
+ self classLabelHolder value:(classesOrdered first name)
+ ] ifFalse:[
+"/ self classLabelHolder value:(classes size printString , ' classes').
+ sortBy value ~~ #doNotSort ifTrue:[
+ classesOrdered sort:[:a :b | a name < b name].
+ ]
+ ].
+
+ privateClassesPerClass notEmpty ifTrue:[
+ |stream action|
+
+ stream := WriteStream on:(Array new).
+
+ action :=
+ [:eachClass |
+ |bucket|
+
+ stream nextPut:eachClass.
+
+ bucket := privateClassesPerClass at:eachClass ifAbsent:nil.
+ bucket notNil ifTrue:[
+ bucket do:action.
+ ]
+ ].
+
+ classesOrdered do:action.
+ classesOrdered := stream contents.
+ ].
+
+"/
+"/ does not work (yet)
+"/ classes addFirst:AllEntry.
+ ^ classesOrdered
+
+ "Modified: / 04-07-2011 / 18:33:56 / cg"
+ "Modified (format): / 07-08-2011 / 16:02:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+listOfClassesByInheritance
+ "TODO: needs refatoring and common code extract with listOfClasses,
+ but I have no time at the moment..."
+
+ |classesAlready classes classesOrdered generator nameSpaceFilter packageFilter allName hidePrivate
+ privateClassesPerClass nameFilterIncludesMatchCharacters lcNameFilter|
+
+ allName := self class nameListEntryForALL.
+ nameSpaceFilter := self nameSpaceFilter value.
+ nameSpaceFilter notNil ifTrue:[
+ (nameSpaceFilter includes:allName) ifTrue:[nameSpaceFilter := nil].
+ ].
+ packageFilter := self packageFilter value.
+ packageFilter notNil ifTrue:[
+ (packageFilter includes:allName) ifTrue:[packageFilter := nil].
+ ].
+
+ inGeneratorHolder isNil ifTrue:[
+ "/ for standAlone testing
+ generator := Smalltalk allClasses.
+ (self hideUnloadedClasses value) ifTrue:[
+ generator := generator select:[:cls | cls isLoaded]
+ ].
+ ] ifFalse:[
+ generator := inGeneratorHolder value.
+ generator isNil ifTrue:[^ #() ].
+ ].
+
+ classesAlready := IdentitySet new.
+ classes := Set new.
+ classesOrdered := OrderedCollection new.
+ hidePrivate := self hidePrivateClasses value.
+
+ privateClassesPerClass := IdentityDictionary new.
+ nameFilterIncludesMatchCharacters := nameFilter notNil and:[nameFilter includesMatchCharacters].
+ nameFilter notNil ifTrue:[ lcNameFilter := nameFilter asLowercase].
+
+ generator do:[:cls |
+ |owner bucket|
+
+ (hidePrivate not or:[cls isPrivate not])
+ ifTrue:[
+ (nameSpaceFilter isNil
+ or:[self isClass:cls shownWithNameSpaceFilter:nameSpaceFilter]) ifTrue:[
+ (packageFilter isNil
+ or:[self isClass:cls shownWithPackageFilter:packageFilter]) ifTrue:[
+ (classesAlready includes:cls) ifFalse:[
+ classesAlready add:cls.
+ (owner := cls owningClass) notNil ifTrue:[
+ bucket := privateClassesPerClass at:owner ifAbsentPut:[SortedCollection new sortBlock:[:a :b | a name < b name] ].
+ bucket add:cls.
+ ] ifFalse:[
+ cls isJavaClass ifTrue:[
+ cls isAnonymous ifFalse:[
+ classes add:cls.
+ ]
+ ] ifFalse:[
+ classes add:cls.
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
+ ].
+
+ privateClassesPerClass keysAndValuesDo:
+ [:owner :privateClasses|
+ (owner isPrivate not and:[(classes includes: owner) not])
+ ifTrue:[classes addAll: privateClasses]].
+
+
+ classes size == 1 ifTrue:[
+ classesOrdered := classes asArray.
+ self classLabelHolder value:(classes first name)
+ ] ifFalse:[
+"/ self classLabelHolder value:(classes size printString , ' classes').
+" sortBy value ~~ #doNotSort ifTrue:[
+ classesOrdered sort:[:a :b | a name < b name].
+ ]"
+ classesOrdered := ClassSorter sort: classes.
+ ].
+
+ privateClassesPerClass notEmpty ifTrue:[
+ |stream action|
+
+ stream := WriteStream on:(Array new).
+
+ action := [:eachClass |
+ |bucket|
+
+ stream nextPut:eachClass.
+
+ bucket := privateClassesPerClass at:eachClass ifAbsent:nil.
+ bucket notNil ifTrue:[
+ bucket do:action.
+ ]
+ ].
+
+ classesOrdered do:action.
+ classesOrdered := stream contents.
+ ].
+
+"/
+"/ does not work (yet)
+"/ classes addFirst:AllEntry.
+ ^ classesOrdered
+
+ "Modified: / 18-08-2000 / 20:34:10 / cg"
+ "Modified: / 21-01-2008 / 19:43:04 / janfrog"
+ "Modified: / 24-08-2010 / 20:17:07 / Jan Vrany <enter your email here>"
+ "Created: / 04-07-2011 / 18:27:34 / cg"
+ "Modified: / 07-08-2011 / 16:14:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+makeDependent
+ Smalltalk addDependent:self.
+ ChangeSet addDependent:self.
+
+ "Created: / 5.2.2000 / 13:42:17 / cg"
+!
+
+makeIndependent
+ Smalltalk removeDependent:self.
+ ChangeSet removeDependent:self.
+!
+
+nameListForClasses:aClassList
+ |orgMode namespaces showNamespaces fullNameList nameList
+ filteredPackages filteredNameSpaces classesInRemoteChangeSet
+ classNamesInChangeSet classNamesInRemoteChangeSet|
+
+ showNamespaces := false.
+
+ filteredNameSpaces := nameSpaceFilter value.
+ (filteredNameSpaces isNil
+ and:[self organizerMode value ~~ OrganizerCanvas organizerModeNamespace]) ifTrue:[
+ showNamespaces := true. "/ if no filter, always show the namespace.
+ ] ifFalse:[
+ (filteredNameSpaces size > 1
+ or:[(filteredNameSpaces size > 0)
+ and:[filteredNameSpaces includes:(self class nameListEntryForALL)]]) ifTrue:[
+ showNamespaces := true
+ ] ifFalse:[
+ "/ if there are classes from multiple namespaces,
+ "/ show the full name
+
+ namespaces := IdentitySet new.
+ fullNameList := OrderedCollection new.
+
+ aClassList
+ do:[:cls | |nm|
+ nm := cls nameInBrowser.
+ fullNameList add:nm.
+ namespaces add:cls topNameSpace.
+ ].
+ showNamespaces := namespaces size > 1
+ ].
+ ].
+
+ orgMode := organizerMode value.
+ filteredPackages := packageFilter value value.
+
+ classNamesInChangeSet := ChangeSet current changedClasses
+ collect:[:each | each theNonMetaclass name].
+
+ classesInRemoteChangeSet := SmallTeam isNil ifTrue:[#()] ifFalse:[ SmallTeam changedClasses ].
+ classNamesInRemoteChangeSet := classesInRemoteChangeSet collect:[:each | each theNonMetaclass name].
+
+ nameList := aClassList
+ collect:[:cls |
+
+ |className nm pkg emPkg hasExtensions isInChangeSet isInRemoteChangeSet icon
+ clr|
+
+ className := cls theNonMetaclass name.
+ isInChangeSet := classNamesInChangeSet includes:className.
+ isInRemoteChangeSet := classNamesInRemoteChangeSet includes:className.
+
+ nm := self nameListEntryFor:cls withNameSpace:showNamespaces.
+
+ self showCoverageInformation value ifTrue:[
+ clr := self colorForCoverageInformationOfClass:cls.
+ clr notNil ifTrue:[
+ nm := self colorize:nm with:#color -> clr
+ ].
+ ].
+ clr isNil ifTrue:[
+ isInChangeSet ifTrue:[
+ nm := self emphasizeForChangedCode:nm
+ ].
+ isInRemoteChangeSet ifTrue:[
+ nm := (self colorizeForChangedCodeInSmallTeam:'!! '),nm
+ ].
+ ].
+
+ pkg := cls package ? '-'.
+ hasExtensions := cls hasExtensions.
+ hasExtensions ifTrue:[
+ emPkg := self emphasizeForDifferentPackage:'+'. "/ self emphasizeForDifferentPackage:pkg.
+ ].
+
+ orgMode == OrganizerCanvas organizerModeProject ifTrue:[
+ (filteredPackages notNil
+ and:[(filteredPackages includes:cls package) not]) ifTrue:[
+ "/ class is in another packae;
+ "/ however, class is listed due to methods
+ "/ in the filtered package
+ hasExtensions ifTrue:[
+ nm := nm , emPkg.
+ ] ifFalse:[
+ nm := nm , ' [ ' , pkg, ' ]'.
+ ].
+ ] ifFalse:[
+ "/ any methods from other packages in this class ?
+ hasExtensions ifTrue:[
+ nm := nm , (self emphasizeForDifferentPackage:'+').
+ ].
+ ].
+ ] ifFalse:[
+ showClassPackages value == true ifTrue:[
+ "/ add the package;
+ hasExtensions ifTrue:[
+ nm := nm , ' [ ' , pkg, ' ]' , (self emphasizeForDifferentPackage:'+').
+"/ isInChangeSet ifFalse:[
+"/ nm := self colorizeForDifferentPackage:nm
+"/ ].
+ ] ifFalse:[
+ nm := nm , (self colorizeGrey:(' [ ' , pkg, ' ]')).
+ ].
+ ] ifFalse:[
+ hasExtensions ifTrue:[
+ nm := nm , emPkg.
+"/ isInChangeSet ifFalse:[
+"/ nm := self colorizeForDifferentPackage:nm
+"/ ]
+ ].
+ ]
+ ].
+
+ isInChangeSet ifTrue:[
+ nm := nm , self class markForBeingInChangeList
+ ].
+"/ cls isVisualStartable ifTrue:[
+"/ nm := LabelAndIcon icon:((SystemBrowser visualStartableClassIcon)
+"/ onDevice:self window device)
+"/ string:nm
+"/ ].
+ markApplicationsHolder value== true ifTrue:[
+ icon := self iconForClass:cls theNonMetaclass.
+ icon isNil ifTrue:[
+ icon := SystemBrowser emptyIcon
+ ].
+ nm := LabelAndIcon icon:icon string:nm
+
+ ].
+ nm
+ ].
+
+ ^ nameList
+
+ "Modified: / 27-10-2012 / 12:32:20 / cg"
+!
+
+reconstructNameList
+ "only reconstruct the names - class list & selection remains unschanged.
+ Invoked when the organizerMode mode changes"
+
+ |prevMode listView oldNameList newNameList sav|
+
+ self classList value isNil ifTrue:[
+ self updateList
+ ].
+
+ newNameList := self nameListForClasses:(classList value ? #()).
+ oldNameList := self classNameList value ? #().
+ (newNameList
+ sameContentsAs: oldNameList
+ whenComparedWith:[:a :b | (a sameStringAndEmphasisAs: b)
+ and:[ a hasImage == b hasImage
+ and:[ a hasIcon == b hasIcon ]]]
+ )
+ ifTrue:[
+ "/ no need to update
+ ] ifFalse:[
+ builder notNil ifTrue:[
+ listView := builder componentAt:#List.
+ ].
+ (listView isNil or:[listView scrolledView isNil]) ifTrue:[
+ "/ invoked very early during setup
+ self classNameList value:newNameList
+ ] ifFalse:[
+ "/ avoid flicker and useless redraws
+
+ prevMode := listView scrollWhenUpdating.
+ listView scrollWhenUpdating:nil.
+
+ "/ this will lead to a selectionIndex change (done by the selListView);
+ "/ however, we dont want this here, since it recurses into
+ "/ a selectionChange. Therefore, temporarily disconnect the selectionIndexHolder...
+ [
+ self selectedClassNameIndices removeDependent:self.
+ "/ also, dont want a callback (selectionChangedByClick)
+ sav := listView action.
+ listView action:nil.
+ self classNameList value:newNameList.
+ ] ensure:[
+ listView action:sav.
+ self selectedClassNameIndices addDependent:self.
+ listView scrollWhenUpdating:prevMode.
+ ].
+ ]
+ ].
+
+ "Modified: / 31.10.2001 / 11:33:21 / cg"
+!
+
+updateClassesIn:aCollection
+ "replace any obsolete class in aCollection;
+ return true, if any was found"
+
+ |found meta classes|
+
+ found := false.
+
+ aCollection isSequenceable ifFalse:[
+ classes := aCollection copy.
+ aCollection removeAll.
+ classes do:[:cls |
+ |newClass|
+
+ meta := cls isMeta.
+ newClass := Smalltalk at:(cls theNonMetaclass name).
+ newClass isNil ifTrue:[
+ newClass := cls
+ ] ifFalse:[
+ meta ifTrue:[
+ newClass := newClass class
+ ]
+ ].
+ found := cls ~~ newClass.
+ aCollection add:newClass.
+ ].
+ ] ifTrue:[
+ aCollection keysAndValuesDo:[:idx :cls |
+ |newClass|
+
+ cls notNil ifTrue:[
+ meta := cls isMeta.
+ newClass := Smalltalk at:(cls theNonMetaclass name).
+ newClass isNil ifTrue:[
+ newClass := cls
+ ] ifFalse:[
+ meta ifTrue:[
+ newClass := newClass class
+ ]
+ ].
+ found := cls ~~ newClass.
+ aCollection at:idx put:newClass.
+ ]
+ ].
+ ].
+ ^ found
+!
+
+updateList
+ |prevSelection oldList newList newSelectionIndices
+ forceSelectionChange selectedClassNameIndicesHolder classList
+ classesAddedToList classesRemovedFromList newSet oldSet|
+
+ newList := self listOfClasses.
+ classList := self classList.
+ oldList := classList value ? #().
+
+ autoSelect == true ifTrue:[
+ classesRemovedFromList := OrderedCollection new.
+ newSet := newList asSet.
+ oldSet := oldList asSet.
+ classesAddedToList := newSet select:[:eachNewClass | (oldSet includes:eachNewClass) not].
+ classesRemovedFromList := oldSet select:[:eachOldClass | (newSet includes:eachOldClass) not].
+ ].
+
+ (newList ~= oldList
+ or:[self classNameList value isNil and:[newList size > 0]]) ifTrue:[
+ prevSelection := lastSelectedClasses ? #().
+ prevSelection := prevSelection select:[:each | each notNil].
+
+ (newList collect:[:each | each name]) = (oldList collect:[:each | each name]) ifTrue:[
+ "/ no need to tell anybody
+ classList setValue:newList.
+ ] ifFalse:[
+ classList value:newList.
+ ].
+ self reconstructNameList.
+
+ (prevSelection size == 0
+ and:[self selectedClasses value size ~~ 0]) ifTrue:[
+ "/ this happens during early startup time,
+ "/ when the selection is already (pre-)set,
+ "/ and the classList is generated the first time
+ "/ (i.e. when opened with preset selection)
+
+ "/ do not clobber the selection in this case.
+ prevSelection := self selectedClasses value.
+ prevSelection := prevSelection select:[:cls | cls notNil].
+ "/ simulate a change, to force selection update in listView
+ forceSelectionChange := true.
+ ].
+
+ autoSelect == true ifTrue:[
+ prevSelection isNil ifTrue:[
+ prevSelection := OrderedCollection new
+ ].
+ prevSelection := prevSelection asOrderedCollection.
+
+ classesAddedToList do:[:eachNewClass |
+ (prevSelection includes:eachNewClass) ifFalse:[
+ prevSelection add:eachNewClass.
+ ].
+ ].
+ classesRemovedFromList do:[:eachOldClass |
+ prevSelection remove:eachOldClass ifAbsent:[].
+ ].
+ ].
+
+ newSelectionIndices := prevSelection
+ collect:[:item | |cls|
+ cls := Smalltalk at:item theNonMetaclass name.
+ newList identityIndexOf:cls]
+ thenSelect:[:index | index ~~ 0].
+
+ selectedClassNameIndicesHolder := self selectedClassNameIndices.
+
+ ((selectedClassNameIndicesHolder value size ~~ self selectedClasses value size)
+ or:[newSelectionIndices ~= selectedClassNameIndicesHolder value])
+ ifTrue:[
+ newSelectionIndices notEmpty ifTrue:[
+ "/ force change (for dependents)
+ "/ selectedClassNameIndicesHolder value:newSelectionIndices.
+ ] ifFalse:[
+ prevSelection := self selectedClasses value.
+ newSelectionIndices := #().
+ ].
+ selectedClassNameIndicesHolder value:newSelectionIndices.
+
+ prevSelection notNil ifTrue:[
+ lastSelectedClasses := prevSelection.
+ ].
+ self updateOutputGenerator.
+ ].
+
+ ] ifFalse:[
+ "/ same classes - but name(s) could be differnet
+ newList size > 0 ifTrue:[
+ self reconstructNameList
+ ]
+ ].
+ listValid := true.
+
+ "Created: / 5.2.2000 / 13:42:18 / cg"
+ "Modified: / 31.10.2001 / 11:35:39 / cg"
+!
+
+updateListsFor:aClass
+ |classes found foundInSelection|
+
+ found := foundInSelection := false.
+
+ "/ update for a changed class in the classList
+ (classes := classList value) size > 0 ifTrue:[
+ (self updateClassesIn:classes) ifTrue:[
+ found := true
+ ].
+ (classes includes:nil) ifTrue:[
+"/ self halt:'should not happen'.
+ classList value:(classes := classes select:[:each | each notNil]).
+ ].
+ ].
+ "/ possibly in the generator
+ ((classes := inGeneratorHolder value) isOrderedCollection
+ and:[classes size > 0]) ifTrue:[
+ (self updateClassesIn:classes) ifTrue:[
+ found := true
+ ].
+ (classes includes:nil) ifTrue:[
+"/ self halt:'should not happen'.
+ inGeneratorHolder value:(classes select:[:each | each notNil]).
+ ]
+ ].
+ "/ and in the selection
+ (classes := self selectedClasses value) size > 0 ifTrue:[
+ (self updateClassesIn:classes) ifTrue:[
+ found := true.
+ foundInSelection := true.
+ ].
+ (classes includes:nil) ifTrue:[
+"/ self halt:'should not happen'.
+ self selectedClasses value:(classes select:[:each | each notNil]).
+ ]
+ ].
+ "/ and in the last selection
+ (classes := lastSelectedClasses) size > 0 ifTrue:[
+ (self updateClassesIn:classes) ifTrue:[
+ found := true
+ ].
+ (classes includes:nil) ifTrue:[
+"/ self halt:'should not happen'.
+ lastSelectedClasses := (classes select:[:each | each notNil]).
+ ]
+ ].
+
+ found ifFalse:[
+ "/ could be a new class (or no-longer autolaoded one).
+ listValid ifTrue:[
+ self enqueueDelayedUpdateList.
+ ].
+ ].
+ foundInSelection ifTrue:[
+ "/ force update of output generator
+ self selectedClasses
+ removeDependent:self;
+ changed;
+ addDependent:self.
+ ].
+
+ "Modified: / 05-06-2012 / 23:39:25 / cg"
+! !
+
+!ClassList methodsFor:'private-presentation'!
+
+colorForCoverageInformationOfClass:aClass
+ |instrumented anyPartiallyCovered anyCalled anyNotCalled|
+
+ instrumented := anyPartiallyCovered := anyCalled := anyNotCalled := false.
+ aClass instAndClassMethodsDo:[:m |
+ m category = 'documentation' ifFalse:[
+ m isInstrumented ifTrue:[
+ instrumented := true.
+ m hasBeenCalled ifFalse:[
+ anyNotCalled := true.
+ ] ifTrue:[
+ anyCalled := true.
+ m haveAllBlocksBeenExecuted ifFalse:[
+ anyPartiallyCovered := true.
+ "/ no need to search further...
+ ^ UserPreferences current colorForInstrumentedPartiallyCoveredCode
+ ]
+ ].
+ ].
+ ].
+ ].
+ instrumented ifFalse:[ ^ nil].
+
+ anyCalled ifFalse:[ ^ UserPreferences current colorForInstrumentedNeverCalledCode ].
+ anyNotCalled ifFalse:[ ^ UserPreferences current colorForInstrumentedFullyCoveredCode ].
+ ^ UserPreferences current colorForInstrumentedPartiallyCoveredCode
+
+ "Created: / 28-04-2010 / 14:05:27 / cg"
+!
+
+iconForClass:aClass
+ ^ SystemBrowser iconForClass:aClass
+
+ "Created: / 17-08-2006 / 09:12:32 / cg"
+!
+
+indentPerPrivacyLevel
+ ^ 4
+!
+
+nameListEntryFor:aClass withNameSpace:useFullName
+ |sortByNameAndInheritance nm indent owner orgMode indentString javaPackage|
+
+ aClass == (self class nameListEntryForALL) ifTrue:[ ^ aClass ].
+
+ sortByNameAndInheritance := self sortByNameAndInheritance value.
+
+ sortByNameAndInheritance ifTrue:[
+ nm := (self nameListIndentStringFor: aClass withNameSpace: useFullName) , aClass nameInBrowser.
+ ] ifFalse:[
+ nm := aClass nameInBrowser.
+ ].
+
+ aClass isLoaded ifFalse:[
+ unloadedClassesColor notNil ifTrue:[
+ nm := nm colorizeAllWith:unloadedClassesColor
+ ]
+ ].
+
+ aClass isLoaded ifFalse:[
+ "/ nm := nm,(' (?) ' colorizeAllWith:Color grey).
+ ] ifTrue:[
+ nm := nm,((' (%1+%2) ' bindWith:(aClass methodDictionary size) with:(aClass class methodDictionary size))
+ colorizeAllWith:self class pseudoEntryForegroundColor).
+ ].
+
+ orgMode := organizerMode value.
+ orgMode == OrganizerCanvas organizerModeHierarchy ifTrue:[
+ "/ always show the full name
+ ^ nm
+ ].
+ orgMode == OrganizerCanvas organizerModeClassHierarchy ifTrue:[
+ "/ always show the full name
+ ^ nm
+ ].
+
+ aClass isJavaClass ifTrue:[
+ "/ only show the last name, unless multiple packages are shown in the list
+ javaPackage := aClass package.
+ (self classList value contains:[:cls | cls package ~= javaPackage]) ifTrue:[
+ ^ nm
+ ].
+ ^ aClass lastName
+ ].
+
+ useFullName ifFalse:[
+ aClass isPrivate ifFalse:[
+ sortByNameAndInheritance ifTrue:[
+ ^ (self nameListIndentStringFor: aClass withNameSpace: useFullName) , aClass nameWithoutNameSpacePrefix
+ ].
+ ^ aClass nameWithoutNameSpacePrefix
+ ]
+ ].
+
+ "/ full name required if owner is not in the list
+ owner := aClass owningClass.
+ (owner isNil
+ or:[(self classList value includesIdentical:owner) not]) ifFalse:[
+
+ "/ namespace
+ indent := (nm count:[:char | char == $:]) // 2.
+ indent > 0 ifTrue:[
+ indent := indent * self indentPerPrivacyLevel.
+ indentString := String new:indent withAll:Character space.
+ sortByNameAndInheritance ifTrue:[
+ nm := (self nameListIndentStringFor:owner withNameSpace:useFullName)
+ , indentString , '::' , aClass nameWithoutPrefix.
+ ] ifFalse:[
+ nm := indentString , '::' , aClass nameWithoutPrefix
+ ]
+ ].
+ ].
+
+ ^ nm
+
+ "Modified: / 04-07-2011 / 19:00:45 / cg"
+!
+
+nameListIndentStringFor:aClass withNameSpace:useFullName
+ | indent indentString cls |
+
+ indent := 0.
+ indentString := ''.
+ cls := aClass superclass.
+ [self classList value includesIdentical:cls]
+ whileTrue:
+ [indent := indent + 1.
+ cls := cls superclass].
+
+ indent == 0 ifFalse:[
+ indent <= 5 ifTrue:[
+ indentString := #(
+ ''
+ ' '
+ ' '
+ ' '
+ ' '
+ ' '
+ ) at:indent+1.
+ ] ifFalse:[
+ indentString := String new:indent*2 withAll:Character space.
+ ].
+
+ ].
+ ^indentString
+
+ "Modified: / 24-02-2000 / 17:52:28 / cg"
+ "Created: / 21-01-2008 / 19:02:07 / janfrog"
+ "Modified (format): / 04-07-2011 / 18:30:20 / cg"
+! !
+
+!ClassList methodsFor:'queries'!
+
+supportsSearch
+
+ ^(self componentAt: #List) notNil
+
+ "Created: / 28-07-2011 / 17:46:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!ClassList methodsFor:'setup'!
+
+autoSelect:aBoolean
+ autoSelect ~~ aBoolean ifTrue:[
+ autoSelect := aBoolean.
+ classList value:nil.
+ ].
+!
+
+classFilterBlock:aBlock
+ "use this to filter away unwanted packages"
+
+ classFilterBlock := aBlock
+!
+
+postBuildWith:aBuilder
+ |classListView|
+
+ super postBuildWith:aBuilder.
+
+ classListView := aBuilder componentAt:'List'.
+ classListView notNil ifTrue:[
+ classListView allowDrag:true.
+ classListView dragObjectConverter:[:obj |
+ |nm class idx|
+
+ nm := obj theObject asString.
+ idx := classNameList value indexOf:nm.
+ idx == 0 ifTrue:[
+ idx := classNameList value indexOf:nm string.
+ ].
+ class := classList value at:idx.
+ DropObject newClass:class.
+ ].
+ ]
+! !
+
+!ClassList class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassList.st,v 1.71 2013-03-13 23:56:35 cg Exp $'
+!
+
+version_CVS
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassList.st,v 1.71 2013-03-13 23:56:35 cg Exp $'
+! !
+
--- a/Tools_MethodCategoryList.st Fri Mar 15 10:14:37 2013 +0000
+++ b/Tools_MethodCategoryList.st Fri Mar 22 09:21:23 2013 +0000
@@ -850,29 +850,31 @@
(i.e. to pass multiple-class and multiple-protocol info
without a need for another classHolder/protocolHolder in the methodList)."
+ |protocols noPackage noCat static notStatic|
+
+ noPackage := PackageId noProjectID.
+ noCat := (self class nameListEntryForNILCategory).
+ static := (self class nameListEntryForStatic).
+ notStatic := (self class nameListEntryForNonStatic).
+
+ protocols := self selectedProtocols value ? #().
+ protocols := protocols collect:[:each | (each ifNil:[noCat]) string].
+ lastGeneratedProtocols := protocols.
+ protocols := protocols asSet.
+
^ Iterator
on:[:whatToDo |
- |protocols
+ |
allProtocols superSendProtocols uncommentedProtocols obsoleteProtocols
documentationProtocols longProtocols extensionProtocols redefinedProtocols
redefineProtocols overrideProtocols
missingRequiredProtocols subclassResponsibilities
notInstrumentedProtocols annotatedProtocols fullyCoveredProtocols
partiallyCoveredProtocols uncoveredProtocols
- noCat static notStatic classSelectorPairsAlreadyDone
- packages remainingClasses remainingCategories classesAlreadyDone noPackage
+ classSelectorPairsAlreadyDone
+ packages remainingClasses remainingCategories classesAlreadyDone
catListed showChanged|
- noPackage := PackageId noProjectID.
- noCat := (self class nameListEntryForNILCategory).
- static := (self class nameListEntryForStatic).
- notStatic := (self class nameListEntryForNonStatic).
-
- protocols := self selectedProtocols value ? #().
- protocols := protocols collect:[:each | (each ifNil:[noCat]) string].
- lastGeneratedProtocols := protocols.
- protocols := protocols asSet.
-
(leafClasses size > 0 and:[protocols size > 0]) ifTrue:[
allProtocols := protocols includes:(self class nameListEntryForALL).
superSendProtocols := protocols includes:(self class nameListEntryForSuperSend).
@@ -1225,6 +1227,7 @@
numRedefine := numRedefined := numOverride := numExtension := numMissingRequired := numSubclassResponsibility := 0.
numNotInstrumented := numFullyCovered := numPartiallyCovered := numUncovered := 0.
numAnnotated := 0.
+ numAll := 0.
generator do:[:clsIn :catIn |
|emptyProtocols clsName doHighLight doHighLightRed includedCats|
@@ -1297,6 +1300,7 @@
and:[ (packageFilter includes:mthd package) not
and:[ showChanges not ]].
suppress ifFalse:[
+ numAll := numAll + 1.
categoryBag add:cat.
suppressPseudoProtocolsNow ifFalse:[
info := self methodInfoFor:mthd in:cls selector:sel lazy:suppressPseudoProtocolsNow.
@@ -1327,8 +1331,6 @@
]
].
- numAll := 0.
-
changeSet := ChangeSet current.
classesProcessed do:[:eachClass |
@@ -1349,13 +1351,13 @@
].
mPackage ~~ classPackage ifTrue:[
(mCategory notNil and:[mPackage ~= PackageId noProjectID]) ifTrue:[
- itemsWithExtensions add:mCategory.
-
(packageFilter notNil
and:[ (packageFilter includes:mPackage) not])
ifTrue:[
itemsWithSuppressedExtensions add:mCategory.
- ].
+ ] ifFalse:[
+ itemsWithExtensions add:mCategory.
+ ]
].
].
@@ -1382,7 +1384,13 @@
].
].
(changeSet includesChangeForClass:eachClass selector:mSelector) ifTrue:[
- itemsInChangeSet add:mCategory.
+ (packageFilter notNil
+ and:[ (packageFilter includes:mPackage) not])
+ ifTrue:[
+ "/ itemsInChangeSetSuppressed add:mCategory.
+ ] ifFalse:[
+ itemsInChangeSet add:mCategory.
+ ]
].
(SmallTeam notNil and:[ SmallTeam includesChangeForClass:eachClass selector:mSelector] ) ifTrue:[
itemsInRemoteChangeSet add:mCategory.
@@ -1396,7 +1404,6 @@
numMissingRequired := numMissingRequired + required size.
].
].
- numAll := numAll + (eachClass methodDictionary size)
].
pseudoEntryColor := self class pseudoEntryForegroundColor.
@@ -2073,11 +2080,11 @@
!MethodCategoryList class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.90 2013-02-08 19:01:05 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.92 2013-03-16 09:49:32 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.90 2013-02-08 19:01:05 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.92 2013-03-16 09:49:32 cg Exp $'
! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Tools_SearchDialog.st Fri Mar 22 09:21:23 2013 +0000
@@ -0,0 +1,1402 @@
+"
+ COPYRIGHT (c) 2000 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+"{ Package: 'stx:libtool' }"
+
+"{ NameSpace: Tools }"
+
+DialogBox subclass:#SearchDialog
+ instanceVariableNames:'openHow classes methods selectedClasses selectedCategories
+ selectedMethods selectedPackages currentClass currentNamespace
+ currentClassCategory currentPackage browser whereRadioGroup
+ currentPanel searchAreas caseHolder matchHolder isMethodHolder
+ codeField selectorHolder defaultOpenHow withTextEntry allowFind
+ allowBuffer allowBrowser searchWhat searchClassProtocolHolder
+ searchInstanceProtocolHolder selectorOrCode selectionList
+ listHolder matchProcess inputField showMetaFilter
+ metaclassesOnlyHolder classesOnlyHolder'
+ classVariableNames:'LastCodeSearched LastCodeSearchWasMethod LastGlobalSearched
+ LastStringSearched LastSearchWasMatch LastSearchWasCaseSensitive
+ LastStringSearchArea LastCodeSearchArea AREA_LISTOFMETHODS
+ LastResourceSearched'
+ poolDictionaries:''
+ category:'Interface-Browsers-New'
+!
+
+!SearchDialog class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 2000 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+! !
+
+!SearchDialog class methodsFor:'initialization'!
+
+initialize
+ AREA_LISTOFMETHODS := #listOfMethods
+
+ "Created: / 19-11-2010 / 12:00:18 / cg"
+! !
+
+!SearchDialog class methodsFor:'constants'!
+
+constantForListOfMethodsArea
+ ^ AREA_LISTOFMETHODS
+
+ "Created: / 19-11-2010 / 12:11:50 / cg"
+! !
+
+!SearchDialog class methodsFor:'queries'!
+
+lastCodeSearchArea
+ ^ LastCodeSearchArea
+!
+
+lastStringSearchArea
+ ^ LastStringSearchArea
+! !
+
+!SearchDialog methodsFor:'accessing'!
+
+currentPackage
+ ^ currentPackage
+!
+
+showMetaFilter:something
+ showMetaFilter := something.
+! !
+
+!SearchDialog methodsFor:'accessing-entered values'!
+
+classesOnly
+ ^ (classesOnlyHolder ? false) value
+
+ "Created: / 20-08-2012 / 13:25:26 / cg"
+!
+
+classesToSearch
+ ^ classes.
+!
+
+codeToSearch
+ ^ selectorOrCode.
+!
+
+matchMethods
+ ^ isMethodHolder value ? false.
+!
+
+metaclassesOnly
+ ^ (metaclassesOnlyHolder ? false) value
+
+ "Created: / 20-08-2012 / 13:17:12 / cg"
+!
+
+methodsToSearch
+ ^ methods.
+!
+
+openHow
+ ^ openHow.
+!
+
+searchAreaSelected
+ ^ whereRadioGroup value.
+!
+
+searchIgnoringCase
+ ^ self searchIsCaseSensitive not
+!
+
+searchIsCaseSensitive
+ ^ (caseHolder value ? false)
+!
+
+searchWithMatch
+ ^ matchHolder value ? false.
+!
+
+selectorToSearch
+ ^ selectorOrCode.
+! !
+
+!SearchDialog methodsFor:'obsolete'!
+
+addCheckBoxForClassMethodSearch
+ |b|
+
+ b := CheckBox label:(resources string:'Class Protocol').
+ b model:(self searchClassProtocolHolder).
+ currentPanel add:b.
+ ^ b.
+!
+
+addCheckBoxForInstanceMethodSearch
+ |b|
+
+ b := CheckBox label:(resources string:'Instance Protocol').
+ b model:(self searchInstanceProtocolHolder).
+ currentPanel add:b.
+ ^ b.
+! !
+
+!SearchDialog methodsFor:'private'!
+
+searchClassProtocolHolder
+ searchClassProtocolHolder isNil ifTrue:[
+ searchClassProtocolHolder := true asValue
+ ].
+ ^ searchClassProtocolHolder
+!
+
+searchInstanceProtocolHolder
+ searchInstanceProtocolHolder isNil ifTrue:[
+ searchInstanceProtocolHolder := true asValue
+ ].
+ ^ searchInstanceProtocolHolder
+!
+
+showHelpOnCodePatterns
+ HTMLDocumentView openFullOnHelpFile:'Browser/RBSearchPatterns.html'
+!
+
+updateListOfMatchingSelectorsFor:s
+ |p|
+
+ (p := matchProcess) notNil ifTrue:[
+ p terminate.
+ ].
+ listHolder isNil ifTrue:[^ self].
+
+ matchProcess :=
+ [
+ |what matching|
+
+ [
+ searchWhat == #globalName ifFalse:[
+ what := DoWhatIMeanSupport selectorCompletion:s inEnvironment:Smalltalk match:(matchHolder value) ignoreCase:(caseHolder value not)
+ ] ifTrue:[
+ what := DoWhatIMeanSupport globalNameCompletion:s inEnvironment:Smalltalk match:(matchHolder value).
+ ].
+ "/ best := what first.
+ matching := what second.
+ self sensor pushAction:[ listHolder contents:matching ].
+ ] ensure:[
+ matchProcess := nil.
+ ].
+ ] fork.
+
+ "Modified: / 26-10-2010 / 20:33:05 / cg"
+! !
+
+!SearchDialog methodsFor:'public'!
+
+addTextEntryWithCaseIgnore:withCaseIgnore withMatch:withMatch
+ matchHolder := caseHolder := nil.
+
+ searchWhat == #code ifTrue:[
+ self addTextEntryFieldForCode.
+ ^ self.
+ ].
+
+ self addInputFieldForSelectorOrNameOrString.
+ withCaseIgnore ifTrue:[
+ self
+ addCheckBox:(resources string:'Case Sensitive')
+ on:(caseHolder := (LastSearchWasCaseSensitive ? false) asValue).
+ ].
+ withMatch ifTrue:[
+ self
+ addCheckBox:(resources string:'Match')
+ on:(matchHolder := (LastSearchWasMatch ? true) asValue).
+"/ (isSelector and:[ sel notNil. ]) ifTrue:[
+"/ sel includesMatchCharacters ifTrue:[
+"/ matchHolder value:false.
+"/ ].
+"/ ].
+ ]
+
+ "Modified (format): / 06-07-2011 / 11:56:31 / cg"
+!
+
+askThenDo:aBlock
+ |where code sel matchHolderValue caseHolderValue|
+
+ self beScreenDialog. "raise it above all windows"
+ self open.
+ self accepted ifFalse:[
+ ^ self.
+ ].
+
+ openHow isNil ifTrue:[
+ openHow := defaultOpenHow.
+ ].
+ where := whereRadioGroup value.
+ withTextEntry ifTrue:[
+ searchWhat == #code ifTrue:[
+ code := codeField contentsAsString.
+ LastCodeSearched := code.
+ LastCodeSearchArea := where.
+ ] ifFalse:[
+ (selectionList notNil and:[selectionList hasSelection]) ifTrue:[
+ sel := selectionList selectionValue.
+ ] ifFalse:[
+ sel := selectorHolder value withoutSeparators.
+ ].
+ sel isEmptyOrNil ifTrue:[
+ browser warn:((searchWhat == #selector)
+ ifTrue:[ 'No selector entered for search'. ]
+ ifFalse:[ 'Nothing entered for search'. ]).
+ ^ self.
+ ].
+ sel := sel string.
+
+ (browser ? SystemBrowser) rememberSearchPattern:sel.
+ searchWhat == #globalName ifTrue:[
+ LastGlobalSearched := sel.
+ ] ifFalse:[
+ searchWhat == #string ifTrue:[
+ LastStringSearched := sel.
+ LastStringSearchArea := where.
+ ] ifFalse:[
+ (sel startsWith:'#''') ifTrue:[
+ sel := sel copyFrom:3.
+ (sel endsWith:$') ifTrue:[
+ sel := sel copyWithoutLast:1.
+ ].
+ ].
+ ]
+ ]
+ ].
+ ].
+ where isNil ifTrue:[
+ (browser ? Dialog) warn:'No class(es) for search'.
+ ^ self.
+ ].
+ self getClassesAndMethodsFor:where.
+
+ (#(#classesWithPrivateClasses #classHierarchiesWithPrivateClasses #ownersWithPrivateClasses #ownersHierarchiesWithPrivateClasses)
+ includes:where)
+ ifTrue:[
+ |toSearch|
+
+ toSearch := IdentitySet withAll:classes.
+ classes := IdentitySet withAll:toSearch.
+ [ toSearch notEmpty ] whileTrue:[
+ |cls|
+
+ cls := toSearch removeFirst.
+ classes addAll:cls allPrivateClasses.
+ ].
+ ].
+
+ classes size == 0 ifTrue:[
+ classes := nil.
+ methods size == 0 ifTrue:[
+ (browser ? Dialog) warn:'No class(es) given for search.'.
+ ^ self.
+ ].
+ ] ifFalse:[
+ classes := classes asOrderedCollection.
+ methods size ~~ 0 ifTrue:[
+ (browser ? Dialog) warn:'oops'.
+ methods := nil.
+ ].
+ ].
+
+ matchHolderValue := matchHolder value.
+ matchHolderValue notNil ifTrue:[
+ LastSearchWasMatch := matchHolderValue
+ ].
+ caseHolderValue := caseHolder value.
+ caseHolderValue notNil ifTrue:[
+ LastSearchWasCaseSensitive := caseHolderValue
+ ].
+
+ selectorOrCode := sel ? code.
+
+ aBlock numArgs == 7 ifTrue:[
+ "/ old style
+ aBlock
+ value:classes
+ value:(sel ? code)
+ value:(self searchIgnoringCase)
+ value:openHow
+ value:(matchHolderValue ? false)
+ value:methods
+ value:(isMethodHolder value ? false).
+ ] ifFalse:[
+ aBlock value.
+ ]
+
+ "Modified: / 26-09-2012 / 11:50:45 / cg"
+!
+
+setupToAskForMethodSearchTitle:title forBrowser:brwsrArg searchWhat:searchWhatArg
+ searchArea:whereDefault withCaseIgnore:withCaseIgnore withMatch:withMatch
+ withMethodList:withMethodList allowFind:allowFindArg allowBuffer:allowBufferArg
+ allowBrowser:allowBrowserArg withTextEntry:withTextEntryArg
+
+ |where ns methodNameSpaces methodPackages hPanel leftVerticalPanel rightVerticalPanel|
+
+ allowFind := allowFindArg.
+ allowBuffer := allowBufferArg.
+ allowBrowser := allowBrowserArg.
+ searchWhat := searchWhatArg.
+
+ withTextEntry := withTextEntryArg.
+
+ (browser := brwsrArg) isNil ifTrue:[
+ resources := NewSystemBrowser classResources.
+ ] ifFalse:[
+ resources := browser resources.
+ selectedClasses := browser selectedClasses value.
+ selectedCategories := browser selectedCategoriesValue.
+ selectedCategories := selectedCategories reject:[:cat | NavigatorModel isPseudoCategory:cat].
+ selectedMethods := browser selectedMethods value.
+ currentClass := browser theSingleSelectedClass.
+ currentClassCategory := browser theSingleSelectedCategory.
+ currentPackage := browser theSingleSelectedProject.
+ currentClass isNil ifTrue:[
+ browser hasMethodSelected ifTrue:[
+ currentClass := selectedMethods first mclass.
+ "/ selectedClasses := (selectedMethods collect:[:each | each mclass ]) asIdentitySet.
+ "/ selectedClasses := selectedClasses select:[:each | each notNil ].
+ ].
+ ].
+ ].
+
+ (self addTextLabel:(resources stringWithCRs:title)) adjust:#left.
+
+ currentClass notNil ifTrue:[
+ currentClass := currentClass theNonMetaclass.
+ ].
+ withTextEntry ifTrue:[
+ self addTextEntryWithCaseIgnore:withCaseIgnore withMatch:withMatch.
+ ].
+
+ searchAreas := OrderedCollection new.
+
+ self addHorizontalLine.
+ "/ self addVerticalSpace.
+
+ (showMetaFilter ? false) ifTrue:[
+ currentPanel := self.
+ self addCheckBoxForMetaClassesOnly.
+ ].
+
+
+ hPanel := HorizontalPanelView "SimpleView" new.
+ hPanel verticalLayout:#top.
+ hPanel horizontalLayout:#left.
+
+ leftVerticalPanel := currentPanel := VerticalPanelView new.
+ leftVerticalPanel verticalLayout:#topSpace.
+ leftVerticalPanel horizontalLayout:#fitSpace.
+
+ (self addTextLabel:(resources string:'Search in:')) adjust:#left.
+
+ whereRadioGroup := RadioButtonGroup new.
+
+ (selectedCategories size > 0 or:[ selectedClasses size > 0 ]) ifTrue:[
+ self addCheckBoxForEverywhere.
+ "/ classMethodListView notNil ifTrue:[
+ "/ b := CheckBox label:(resources string:'Shown Methods').
+ "/ panel add:b. whereChannel add:b value:#currentMethodList.
+ "/ areas add:#currentMethodList.
+ "/ self makeTabable:b.
+ "/ ].
+ browser isMethodListBrowser ifTrue:[
+ methods := browser selectedMethods value ? #().
+ methodNameSpaces := methods
+ select:[:eachMethod | eachMethod mclass notNil]
+ thenCollect:[:eachMethod | eachMethod mclass topNameSpace ].
+ methodPackages := methods
+ collect:[:eachMethod | eachMethod package ].
+ ].
+ methodNameSpaces size == 1 ifTrue:[
+ currentNamespace := methodNameSpaces first.
+ ] ifFalse:[
+ currentNamespace := browser currentNamespace.
+ selectedClasses size == 0 ifTrue:[
+ |classesInAllSelectedCategories nameSpacesOfAllClassesInAllSelectedCategories|
+ classesInAllSelectedCategories := Smalltalk allClasses select:[:cls | selectedCategories includes:cls category].
+ nameSpacesOfAllClassesInAllSelectedCategories := classesInAllSelectedCategories collect:[:eachClass | eachClass topNameSpace].
+ nameSpacesOfAllClassesInAllSelectedCategories size == 1 ifTrue:[
+ currentNamespace := nameSpacesOfAllClassesInAllSelectedCategories first.
+ ].
+ ].
+ ].
+
+ (currentNamespace notNil
+ and:[ currentNamespace ~= (browser nameListEntryForALL) ])
+ ifTrue:[ self addCheckBoxForCurrentNamespace ]
+ ifFalse:[
+ (currentClass notNil
+ and:[ (ns := currentClass nameSpace) notNil and:[ ns ~~ Smalltalk ] ])
+ ifTrue:[ self addCheckBoxForClassesNamespace:ns ].
+ ].
+
+ methodPackages size == 1 ifTrue:[
+ currentPackage := methodPackages first.
+ ] ifFalse:[
+ currentPackage := browser currentProject.
+"/ selectedClasses size == 0 ifTrue:[
+"/ |classesInAllSelectedCategories packagesOfAllClassesInAllSelectedCategories|
+"/ classesInAllSelectedCategories := Smalltalk allClasses select:[:cls | selectedCategories includes:cls category].
+"/ packagesOfAllClassesInAllSelectedCategories := classesInAllSelectedCategories collect:[:eachClass | eachClass package].
+"/ packagesOfAllClassesInAllSelectedCategories size == 1 ifTrue:[
+"/ currentPackage := packagesOfAllClassesInAllSelectedCategories first.
+"/ ].
+"/ ].
+ ].
+
+ (currentPackage notNil
+ and:[ currentPackage ~= (browser nameListEntryForALL) ])
+ ifTrue:[ self addCheckBoxForCurrentPackage ]
+ ifFalse:[
+ (currentClass notNil) ifTrue:[
+ self addCheckBoxForClassesPackage:(currentClass package)
+ ].
+ ].
+
+ selectedCategories size > 0 ifTrue:[
+ self addCheckBoxForSelectedClassCategory.
+ ].
+ (selectedClasses size > 0 or:[ selectedMethods size > 0 ]) ifTrue:[
+ self addCheckBoxForSelectedClass.
+ self addCheckBoxForSelectedClassAndSuperclasses.
+ self addCheckBoxForSelectedClassAndSubclasses.
+ self addCheckBoxForSelectedClassAndPrivateClasses.
+ self addCheckBoxForSelectedClassAndSubclassesAndPrivateClasses.
+ self addCheckBoxForOwnerAndItsPrivateClasses.
+ self addCheckBoxForOwnerAndItsSubclassesAndItsPrivateClasses.
+ ].
+ ] ifFalse:[
+ (browser notNil and:[browser currentNamespace ~~ Smalltalk]) ifTrue:[
+ self addCheckBoxForEverywhere.
+ currentNamespace := browser currentNamespace.
+ currentNamespace ~= (browser nameListEntryForALL) ifTrue:[
+ self addCheckBoxForCurrentNamespace.
+ ] ifFalse:[
+ (currentClass notNil
+ and:[ (ns := currentClass nameSpace) notNil
+ and:[ ns ~~ Smalltalk ] ])
+ ifTrue:[
+ self addCheckBoxForClassesNamespace:ns
+ ].
+ ].
+ ].
+ ].
+ searchAreas size == 0 ifTrue:[
+ self addCheckBoxForEverywhere.
+ ].
+ self addCheckBoxForChangedClassesList.
+
+ withMethodList ifTrue:[
+ browser isMethodListBrowser ifTrue:[
+ searchAreas size == 0 ifTrue:[
+ self addCheckBoxForEverywhere.
+ ].
+ self addCheckBoxForMethodList.
+ self addCheckBoxForSelectedMethods.
+ self addCheckBoxForSelectedMethodClasses.
+ self addCheckBoxForSelectedMethodPackages.
+ ] ifFalse:[
+ searchAreas size == 0 ifTrue:[
+ self addCheckBoxForEverywhere.
+ ].
+ self addCheckBoxForChangedMethodList.
+ ].
+ ].
+
+ searchAreas size == 0 ifTrue:[
+ whereRadioGroup := #everywhere asValue.
+ self addDummyCheckBoxForEverywhere.
+ ] ifFalse:[
+ whereDefault notNil ifTrue:[
+ (searchAreas includes:whereDefault) ifTrue:[
+ where := whereDefault asSymbol.
+ ] ifFalse:[
+ where := searchAreas first.
+ ].
+ ] ifFalse:[
+ where := #everywhere.
+ ].
+ whereRadioGroup value:where.
+ ].
+
+ hPanel add:leftVerticalPanel.
+
+false ifTrue:[
+ "/ noone liked the right panel...
+ rightVerticalPanel := currentPanel := VerticalPanelView new.
+ rightVerticalPanel verticalLayout:#topSpace.
+ rightVerticalPanel horizontalLayout:#fitSpace.
+
+ self addCheckBoxForClassMethodSearch.
+ self addCheckBoxForInstanceMethodSearch.
+"/ rightVerticalPanel origin:0.75@0.0 corner:1.0@1.0.
+ hPanel
+ preferredExtent:(leftVerticalPanel preferredWidth + rightVerticalPanel preferredWidth)
+ @
+ (leftVerticalPanel preferredHeight max:rightVerticalPanel preferredHeight).
+ hPanel add:rightVerticalPanel.
+] ifFalse:[
+
+"/ rightVerticalPanel origin:0.75@0.0 corner:1.0@1.0.
+ hPanel
+ preferredExtent:(leftVerticalPanel preferredWidth) @ (leftVerticalPanel preferredHeight).
+].
+
+ self addComponent:hPanel indent:0.
+
+ "/ panel has its own idea of indenting
+ "/ self addVerticalSpace.
+ searchWhat == #selector ifTrue:[
+ "/ not yet implemented
+ "/ self addHorizontalLine.
+ "/ self addCheckBoxesForClassAndMetaSearch.
+
+ selectionList := self addFilteredListOfMatchingSelectors.
+ self stickAtBottomWithVariableHeight:selectionList.
+ matchHolder notNil ifTrue:[
+ matchHolder onChangeEvaluate:[ self updateListOfMatchingSelectorsFor:inputField contents ]
+ ].
+ inputField notNil ifTrue:[ self updateListOfMatchingSelectorsFor:inputField contents ].
+ ] ifFalse:[
+ self addHorizontalLine.
+ ].
+ self addButtons.
+
+ self label:(resources string:'Search').
+
+ "Modified: / 20-08-2012 / 13:25:03 / cg"
+! !
+
+!SearchDialog methodsFor:'setup'!
+
+addCheckBox:b forSearchArea:area
+ currentPanel add:b.
+ whereRadioGroup add:b value:area.
+ searchAreas add:area.
+ self makeTabable:b.
+!
+
+addCheckBoxForChangedClassesList
+ |b|
+
+ b := CheckBox label:(resources string:'Changed Classes').
+ self addCheckBox:b forSearchArea:#listOfChangedClasses.
+ ChangeSet current changedClasses isEmpty ifTrue:[
+ b disable
+ ].
+ ^ b.
+!
+
+addCheckBoxForChangedMethodList
+ |b|
+
+ b := CheckBox label:(resources string:'Changed Methods').
+ self addCheckBox:b forSearchArea:#listOfChangedMethods.
+ ChangeSet current changeSelectors isEmpty ifTrue:[
+ b disable
+ ].
+ ^ b.
+!
+
+addCheckBoxForClassesNamespace:ns
+ |b|
+
+ b := CheckBox
+ label:(resources string:'Classes'' nameSpace ("%1")' with:ns name).
+ self addCheckBox:b forSearchArea:#currentClassesNameSpace.
+ ^ b.
+!
+
+addCheckBoxForClassesPackage:pkg
+ |b|
+
+ b := CheckBox
+ label:(resources string:'Classes'' package ("%1")' with:pkg).
+ self addCheckBox:b forSearchArea:#currentClassesPackage.
+ ^ b.
+
+ "Created: / 21-09-2006 / 17:39:55 / cg"
+!
+
+addCheckBoxForCurrentNamespace
+ |b|
+
+ b := CheckBox
+ label:(resources string:'Current nameSpace ("%1")' with:currentNamespace name).
+ self addCheckBox:b forSearchArea:#currentNameSpace.
+ ^ b.
+
+ "Modified: / 10-10-2006 / 15:28:47 / cg"
+!
+
+addCheckBoxForCurrentPackage
+ |b|
+
+ b := CheckBox
+ label:(resources string:'Current package ("%1")' with:currentPackage).
+ self addCheckBox:b forSearchArea:#currentPackage.
+ ^ b.
+
+ "Modified: / 10-10-2006 / 15:28:51 / cg"
+!
+
+addCheckBoxForCurrentPackage:pkg
+ |b|
+
+ b := CheckBox
+ label:(resources string:'Classes'' package ("%1")' with:pkg).
+ self addCheckBox:b forSearchArea:#currentClassesPackage.
+ ^ b.
+
+ "Modified: / 10-10-2006 / 15:29:06 / cg"
+!
+
+addCheckBoxForEverywhere
+ |b|
+
+ b := CheckBox label:(resources string:'Everywhere').
+ self addCheckBox:b forSearchArea:#everywhere.
+ ^ b.
+!
+
+addCheckBoxForMetaClassesOnly
+ |p b|
+
+ p := View new.
+
+ b := CheckBox label:(resources string:'Metaclasses Only') in:p.
+ b model:(metaclassesOnlyHolder := false asValue).
+ metaclassesOnlyHolder onChangeEvaluate:[metaclassesOnlyHolder value ifTrue:[classesOnlyHolder value:false]].
+ self makeTabable:b.
+
+ b := CheckBox label:(resources string:'Classes Only') in:p.
+ b left:0.5.
+ b model:(classesOnlyHolder := false asValue).
+ classesOnlyHolder onChangeEvaluate:[classesOnlyHolder value ifTrue:[metaclassesOnlyHolder value:false]].
+ self makeTabable:b.
+
+ currentPanel add:p.
+ ^ nil.
+
+ "Created: / 20-08-2012 / 11:32:15 / cg"
+!
+
+addCheckBoxForMethodList
+ |b|
+
+ b := CheckBox label:(resources string:'Methodlist').
+ self addCheckBox:b forSearchArea:AREA_LISTOFMETHODS.
+ ^ b.
+
+ "Modified: / 19-11-2010 / 12:00:52 / cg"
+!
+
+addCheckBoxForOwnerAndItsPrivateClasses
+ |b lbl arg|
+
+ (currentClass notNil and:[ currentClass isPrivate. ]) ifTrue:[
+ lbl := 'Owner (%1) & all its private classes'.
+ arg := currentClass owningClass name.
+ ] ifFalse:[
+ lbl := 'Owners & all their private classes'.
+ ].
+ b := CheckBox label:(resources string:lbl with:arg).
+ self addCheckBox:b forSearchArea:#ownersWithPrivateClasses.
+ (selectedClasses contains:[ :cls | cls isPrivate. ]) ifFalse:[
+ b disable.
+ ].
+ ^ b.
+!
+
+addCheckBoxForOwnerAndItsSubclassesAndItsPrivateClasses
+ |b lbl arg|
+
+ (currentClass notNil and:[ currentClass isPrivate. ]) ifTrue:[
+ lbl := 'Owner (%1) & its subclasses & all its private classes'.
+ arg := currentClass owningClass name.
+ ] ifFalse:[
+ lbl := 'Owners & their subclasses & all their private classes'.
+ ].
+ b := CheckBox label:(resources string:lbl with:arg).
+ self addCheckBox:b forSearchArea:#ownersHierarchiesWithPrivateClasses.
+ (selectedClasses contains:[ :cls | cls isPrivate. ]) ifFalse:[
+ b disable.
+ ].
+ ^ b.
+!
+
+addCheckBoxForSelectedClass
+ |b lbl arg|
+
+ (browser isMethodListBrowser
+ or:[ currentClass isNil
+ or:[ selectedClasses size > 1] ]) ifTrue:[
+ selectedClasses size == 1 ifTrue:[
+ lbl := 'Selected class ("%1")'.
+ arg := selectedClasses first theNonMetaclass name.
+ ] ifFalse:[
+ lbl := 'Selected classes (%1)'.
+ arg := selectedClasses size.
+ ].
+ ] ifFalse:[
+ lbl := 'Class ("%1")'.
+ arg := currentClass name.
+ ].
+ b := CheckBox label:(resources string:lbl with:arg).
+ self addCheckBox:b forSearchArea:#classes.
+ ^ b.
+!
+
+addCheckBoxForSelectedClassAndPrivateClasses
+ |b lbl|
+
+ (browser isMethodListBrowser
+ or:[ currentClass isNil
+ or:[ selectedClasses size > 1] ]) ifTrue:[
+ lbl := 'Selected classes & all private classes'.
+ ] ifFalse:[
+ lbl := 'Class & private classes'.
+ ].
+ b := CheckBox label:(resources string:lbl).
+ self addCheckBox:b forSearchArea:#classesWithPrivateClasses.
+ (selectedClasses
+ contains:[ :cls | cls theNonMetaclass privateClasses size > 0. ])
+ ifFalse:[ b disable. ].
+ ^ b.
+!
+
+addCheckBoxForSelectedClassAndSubclasses
+ |b lbl|
+
+ (browser isMethodListBrowser
+ or:[ currentClass isNil
+ or:[ selectedClasses size > 1] ]) ifTrue:[
+ lbl := 'Selected classes & all subclasses'.
+ ] ifFalse:[
+ lbl := 'Class & subclasses'.
+ ].
+ b := CheckBox label:(resources string:lbl).
+ self addCheckBox:b forSearchArea:#classHierarchies.
+ (selectedClasses
+ contains:[ :cls | cls theNonMetaclass subclasses size > 0. ])
+ ifFalse:[ b disable. ].
+ ^ b.
+!
+
+addCheckBoxForSelectedClassAndSubclassesAndPrivateClasses
+ |b lbl|
+
+ (browser isMethodListBrowser
+ or:[ currentClass isNil
+ or:[ selectedClasses size > 1] ]) ifTrue:[
+ lbl := 'Selected classes & all subclasses & all private classes'.
+ ] ifFalse:[
+ lbl := 'Class & subclasses & all private classes'.
+ ].
+ b := CheckBox label:(resources string:lbl).
+ self addCheckBox:b forSearchArea:#classHierarchiesWithPrivateClasses.
+ (selectedClasses
+ contains:[ :cls | cls theNonMetaclass privateClasses size > 0. ])
+ ifFalse:[ b disable. ].
+ ^ b.
+!
+
+addCheckBoxForSelectedClassAndSuperclasses
+ |b lbl|
+
+ (browser isMethodListBrowser
+ or:[ currentClass isNil
+ or:[ selectedClasses size > 1] ]) ifTrue:[
+ lbl := 'Selected classes & all superclasses'.
+ ] ifFalse:[
+ lbl := 'Class & superclasses'.
+ ].
+ b := CheckBox label:(resources string:lbl).
+ self addCheckBox:b forSearchArea:#classesAndSuperclasses.
+ (selectedClasses
+ contains:[ :cls | cls theNonMetaclass superclass notNil. ])
+ ifFalse:[ b disable. ].
+ ^ b.
+!
+
+addCheckBoxForSelectedClassCategory
+ |b lbl arg|
+
+ currentClassCategory notNil ifTrue:[
+ lbl := 'Class category ("%1")'.
+ arg := currentClassCategory.
+ ] ifFalse:[
+ lbl := 'Selected class categories (%1)'.
+ arg := selectedCategories size.
+ ].
+ b := CheckBox label:(resources string:lbl with:arg).
+ self addCheckBox:b forSearchArea:#classCategories.
+ ^ b.
+!
+
+addCheckBoxForSelectedMethodClasses
+ |b classes numClasses|
+
+ classes := ((browser selectedMethods value ? #())
+ select:[:m | m mclass notNil]
+ thenCollect:[:m | m mclass theNonMetaclass]) asSet.
+ numClasses := classes size.
+ numClasses == 0 ifTrue:[^ self]. "/ comment this to show, but disabled
+
+ numClasses == 1 ifTrue:[
+ b := CheckBox label:(resources string:'Selected method''s class ("%1")'
+ with:classes first name).
+ ] ifFalse:[
+ b := CheckBox label:(resources string:'Selected methods'' classes (%1)'
+ with:numClasses).
+ numClasses == 0 ifTrue:[
+ b disable
+ ].
+ ].
+ self addCheckBox:b forSearchArea:#listOfSelectedMethodClasses.
+ ^ b.
+
+ "Modified (comment): / 20-07-2012 / 11:40:44 / cg"
+!
+
+addCheckBoxForSelectedMethodPackages
+ |b packages numPackages|
+
+ packages := ((browser selectedMethods value ? #())
+ collect:[:m | m package]) asSet.
+ numPackages := packages size.
+ numPackages size == 0 ifTrue:[^ self]. "/ comment this to show, but disabled
+
+ numPackages == 1 ifTrue:[
+ b := CheckBox label:(resources string:'Selected method''s package ("%1")'
+ with:packages first).
+ ] ifFalse:[
+ b := CheckBox label:(resources string:'Selected methods'' packages (%1)'
+ with:numPackages).
+ numPackages == 0 ifTrue:[
+ b disable
+ ].
+ ].
+ self addCheckBox:b forSearchArea:#listOfSelectedMethodPackages.
+ ^ b.
+
+ "Created: / 29-02-2012 / 19:42:26 / cg"
+!
+
+addCheckBoxForSelectedMethods
+ |b numSelected|
+
+ numSelected := browser selectedMethods value size.
+ numSelected == 0 ifTrue:[^ self]. "/ comment this to show, but disabled
+
+ b := CheckBox label:(resources string:'Selected methods (%1)' with:numSelected).
+ self addCheckBox:b forSearchArea:#listOfSelectedMethods.
+ numSelected == 0 ifTrue:[b disable].
+ ^ b.
+
+ "Modified (comment): / 20-07-2012 / 11:40:33 / cg"
+!
+
+addCheckBoxForSelectedPackage
+ |b lbl arg|
+
+ currentClassCategory notNil ifTrue:[
+ lbl := 'Class category ("%1")'.
+ arg := currentClassCategory.
+ ] ifFalse:[
+ lbl := 'Selected classes categories (%1)'.
+ arg := selectedCategories size.
+ ].
+ b := CheckBox label:(resources string:lbl with:arg).
+ self addCheckBox:b forSearchArea:#classCategories.
+ ^ b.
+!
+
+addCheckBoxesForClassAndMetaSearch
+ |y b1 b2|
+
+ y := self yPosition.
+ b1 := self addCheckBox:(resources string:'Instance Protocol') on:(self searchInstanceProtocolHolder).
+ "/ b1 width:0.5.
+
+ "/ self yPosition:y.
+ b2 := self addCheckBox:(resources string:'Class Protocol') on:(self searchClassProtocolHolder).
+ "/ b2 left:0.5; width:0.5.
+
+ "Created: / 06-12-2011 / 11:24:11 / cg"
+!
+
+addDummyCheckBoxForEverywhere
+ |b|
+
+ b := CheckBox label:(resources string:'Everywhere').
+ b turnOn.
+ b disable.
+
+ currentPanel add:b.
+!
+
+addFilteredListOfMatchingSelectors
+ |l|
+
+ listHolder := List new.
+
+ l := HVScrollableView for:SelectionInListView.
+ l listHolder:listHolder.
+ self addComponent:l.
+ l doubleClickAction:[
+ selectorHolder value:(l selectionValue).
+ matchHolder value:false.
+ caseHolder value:false.
+ self doAccept.
+ self okPressed.
+ ].
+ ^ l.
+!
+
+addInputFieldForSelectorOrNameOrString
+ |sel lastSearchPatterns|
+
+ browser notNil ifTrue:[
+ searchWhat == #selector ifTrue:[
+ sel := browser selectorToSearchFor.
+ ] ifFalse:[
+ searchWhat == #globalName ifTrue:[
+ sel := browser globalNameToSearchFor ? LastGlobalSearched.
+ ] ifFalse:[
+ searchWhat == #string ifTrue:[
+ sel := browser stringToSearchFor ? LastStringSearched.
+ ] ifFalse:[
+ searchWhat == #resource ifTrue:[
+ sel := browser stringToSearchFor ? LastResourceSearched.
+ ] ifFalse:[
+ sel := browser selectorToSearchFor.
+ ]
+ ]
+ ].
+ ].
+ ].
+ lastSearchPatterns := (browser ? SystemBrowser) lastSearchPatterns.
+
+ sel isEmptyOrNil ifTrue:[
+ "/ use last searchString
+ lastSearchPatterns size > 0 ifTrue:[
+ sel := lastSearchPatterns first.
+ ].
+ ].
+ selectorHolder := (sel ? '') withoutSeparators asValue.
+
+ inputField := self addComboBoxOn:selectorHolder tabable:true.
+ inputField list:lastSearchPatterns.
+ inputField selectAllInitially.
+ inputField immediateAccept:true.
+ inputField takeFocus.
+ inputField
+ entryCompletionBlock:[ :contents |
+ |s what|
+
+ s := contents withoutSpaces.
+ self topView
+ withWaitCursorDo:[
+ |best matching|
+
+ searchWhat == #resource ifTrue:[
+ what := DoWhatIMeanSupport resourceCompletion:s inEnvironment:Smalltalk match:true ignoreCase:false.
+ ] ifFalse:[
+ searchWhat == #globalName ifFalse:[
+ what := DoWhatIMeanSupport selectorCompletion:s inEnvironment:Smalltalk.
+ ] ifTrue:[
+ what := DoWhatIMeanSupport globalNameCompletion:s inEnvironment:Smalltalk match:true.
+ ].
+ ].
+ best := what first.
+ matching := what second.
+ inputField contents:best.
+ "/ listHolder contents:matching.
+ matching size ~~ 1 ifTrue:[
+ (browser ? self) window beep.
+ ].
+ ].
+ ].
+
+ selectorHolder onChangeEvaluate:[ self updateListOfMatchingSelectorsFor:inputField contents ].
+
+ "Modified: / 14-02-2012 / 14:13:52 / cg"
+!
+
+addTextEntryFieldForCode
+ |initial box panel patternInfoBox infoLabel helpButton errMessageField checkCodeAction
+ metaBox b|
+
+ box := View new.
+ box extent:(600 @ 200).
+
+ panel := VariableHorizontalPanel in:box.
+ panel origin:0.0@0.0 corner:(1.0@1.0).
+
+ codeField := CodeView in:panel.
+ codeField canTab:true.
+"/ codeField origin:0.0@0.0 corner:(0.75@1.0).
+
+ patternInfoBox := View in:panel.
+
+ infoLabel := Label in:patternInfoBox.
+ infoLabel geometryLayout:(LayoutFrame bottomInset:30).
+
+ infoLabel font:(codeField font asSize:(codeField font size - 2)).
+ infoLabel adjust:#left.
+ infoLabel label:(self helpTextForMetaPatterns).
+
+ panel relativeCorners:#(0.6 1.0).
+ panel showHandle:true.
+
+ helpButton := Button label:(resources string:'Pattern Help') in:patternInfoBox.
+ helpButton layout:((AlignmentOrigin fractionalFromPoint:0.5@1.0)
+ leftOffset:2
+ topOffset:helpButton preferredHeight negated;
+ leftAlignmentFraction:0.5 topAlignmentFraction:0).
+ helpButton topInset:0.75@1.0.
+ helpButton action:[self showHelpOnCodePatterns].
+
+
+ self addComponent:box tabable:true.
+
+ metaBox := HorizontalPanelView new.
+ metaBox horizontalLayout:#leftMax.
+ b := Button label:'+Lit' action:[ codeField pasteOrReplace:'`#n' ] in:metaBox.
+ b helpKey:#matchAnyLiteral.
+ b := Button label:'+Var' action:[ codeField pasteOrReplace:'`v' ] in:metaBox.
+ b helpKey:#matchAnyVariable.
+ b := Button label:'+Expr' action:[ codeField pasteOrReplace:'`@e' ] in:metaBox.
+ b helpKey:#matchAnyExpression.
+ b := Button label:'+Msg' action:[ codeField pasteOrReplace:'`@m:' ] in:metaBox.
+ b helpKey:#matchAnyMessage.
+ b := Button label:'+Node' action:[ codeField pasteOrReplace:'`{:node | node isLiteral and:[node value isSymbol] }' ] in:metaBox.
+ b helpKey:#matchAnyNode.
+ b := Button label:'+Stats' action:[ codeField pasteOrReplace:'`.@stats' ] in:metaBox.
+ b helpKey:#matchAnyStats.
+ self addComponent:metaBox.
+
+ errMessageField := (self addTextLabel:'') adjust:#left.
+ errMessageField level:-1.
+ self addCheckBox:(resources string:'Method') on:self isMethodHolder.
+
+ checkCodeAction := [ self checkCodeIn:codeField notifying:errMessageField. ].
+
+ codeField modifiedChannel onChangeEvaluate:checkCodeAction.
+ self isMethodHolder onChangeEvaluate:checkCodeAction.
+
+ initial := browser selectionInCodeView.
+ initial isEmptyOrNil ifTrue:[
+ initial := LastCodeSearched ? ''
+ ].
+ codeField contents:initial.
+ checkCodeAction value.
+
+ "Modified: / 23-07-2011 / 10:35:14 / cg"
+!
+
+checkCodeIn:codeField notifying:errMessageField
+ |codeString tree errAction|
+
+ codeString := codeField contents asString string.
+ errAction := [:str :pos |
+ |line col badLine|
+
+ line := codeField lineOfCharacterPosition:pos.
+ col := (codeField colOfCharacterPosition:pos) max:1.
+
+ badLine := (codeField listAt:line) ? ''.
+ col <= badLine size size ifTrue:[
+ codeField
+ listAt:line
+ put:(badLine asText
+ emphasisAt:col
+ put:(UserPreferences current unknownIdentifierEmphasis)).
+ "/ codeField selectFromCharacterPosition:pos to:pos.
+ ].
+ errMessageField label:('line: ',line printString,' ',str).
+ errMessageField backgroundColor:Color red.
+ codeField requestFocus.
+ nil.
+ ].
+
+ isMethodHolder value ifTrue:[
+ tree := RBParser parseRewriteMethod:codeString onError: errAction.
+ ] ifFalse:[
+ tree := RBParser parseRewriteExpression:codeString onError: errAction.
+ ].
+ tree notNil ifTrue:[
+ errMessageField backgroundColor:View defaultViewBackgroundColor.
+ errMessageField label:nil
+ ].
+ codeField modifiedChannel setValue:false.
+!
+
+getClassesAndMethodsFor:where
+ where == #everywhere ifTrue:[
+ classes := Smalltalk allClasses.
+ methods := nil.
+ ^ self.
+ ].
+ where == #currentNameSpace ifTrue:[
+ classes := currentNamespace allClassesWithAllPrivateClasses.
+ methods := nil.
+ ^ self.
+ ].
+ where == #currentClassesNameSpace ifTrue:[
+ currentClass isPrivate ifTrue:[
+ classes := currentClass topOwningClass nameSpace
+ allClassesWithAllPrivateClasses.
+ ] ifFalse:[
+ classes := currentClass nameSpace allClassesWithAllPrivateClasses.
+ ].
+ methods := nil.
+ ^ self.
+ ].
+ where == #currentPackage ifTrue:[
+ classes := Smalltalk allClassesInPackage:currentPackage.
+ methods := nil.
+ ^ self.
+ ].
+ where == #currentClassesPackage ifTrue:[
+ classes := Smalltalk allClassesInPackage:currentClass package.
+ methods := nil.
+ ^ self.
+ ].
+ where == #classCategories ifTrue:[
+ classes := Smalltalk allClasses
+ select:[ :cls | selectedCategories includes:cls category. ].
+ classes := classes collect:[ :each | each theNonMetaclass. ].
+ methods := nil.
+ ^ self.
+ ].
+ (where == #classes or:[ where == #classesWithPrivateClasses. ]) ifTrue:[
+ classes := selectedClasses collect:[ :each | each theNonMetaclass. ].
+ methods := nil.
+ ^ self.
+ ].
+ (where == #classHierarchies or:[ where == #classHierarchiesWithPrivateClasses. ])
+ ifTrue:[
+ classes := IdentitySet new.
+ selectedClasses do:[ :cls |
+ classes addAll:cls theNonMetaclass withAllSubclasses.
+ ].
+ methods := nil.
+ ^ self.
+ ].
+ where == #ownersWithPrivateClasses ifTrue:[
+ classes := IdentitySet new.
+ selectedClasses do:[ :cls |
+ |c|
+
+ c := cls theNonMetaclass.
+ classes add:(c owningClass ? c).
+ ].
+ methods := nil.
+ ^ self.
+ ].
+ where == #ownersHierarchiesWithPrivateClasses ifTrue:[
+ classes := IdentitySet new.
+ selectedClasses do:[ :cls |
+ |c|
+
+ c := cls theNonMetaclass.
+ classes addAll:(c owningClass ? c) withAllSubclasses.
+ ].
+ methods := nil.
+ ^ self.
+ ].
+ (where == #classesAndSuperclasses) ifTrue:[
+ classes := IdentitySet new.
+ selectedClasses do:[ :cls |
+ classes addAll:cls theNonMetaclass withAllSuperclasses.
+ ].
+ methods := nil.
+ ^ self.
+ ].
+ (where == AREA_LISTOFMETHODS) ifTrue:[
+ classes := nil.
+ methods := browser methodListApp methodList value.
+ ^ self.
+ ].
+ (where == #listOfSelectedMethods) ifTrue:[
+ classes := nil.
+ methods := browser selectedMethods value ? #().
+ ^ self.
+ ].
+ (where == #listOfSelectedMethodClasses) ifTrue:[
+ classes := ((browser selectedMethods value ? #()) collect:[:m | m mclass theNonMetaclass]) asSet asOrderedCollection.
+ methods := nil.
+ ^ self.
+ ].
+ (where == #listOfSelectedMethodPackages) ifTrue:[
+ classes := (((browser selectedMethods value ? #()) collect:[:m | m package]) asSet
+ collectAll:[:p | Smalltalk allClassesInPackage:p ]) asOrderedCollection.
+ methods := nil.
+ ^ self.
+ ].
+ (where == #listOfChangedClasses) ifTrue:[
+ classes := ChangeSet current changedClasses.
+ methods := nil.
+ ^ self.
+ ].
+ (where == #listOfChangedMethods) ifTrue:[
+ classes := nil.
+ methods := Set new.
+ ChangeSet current do:[:chg |
+ |mthd|
+
+ chg notNil ifTrue:[
+ chg isMethodChange ifTrue:[
+ mthd := chg changeMethod.
+ mthd notNil ifTrue:[
+ methods add:mthd
+ ]
+ ]
+ ]
+ ].
+ methods := methods asOrderedCollection.
+ ^ self.
+ ].
+
+ self halt:'inumplemented search'.
+
+ "Modified: / 05-10-2011 / 15:48:20 / az"
+ "Modified: / 29-02-2012 / 19:47:42 / cg"
+!
+
+helpTextForMetaPatterns
+ ^ 'MetaPatterns:
+ ' , '`' allBold , ' = meta
+ ' , '@' allBold , ' = list/any
+ ' , '.' allBold , ' = statement
+ ' , '`' allBold , ' = recurse
+
+ ' , '`#n' allBold , ' any lit
+ ' , '`v' allBold , ' any var (`V => global)
+ ' , '`@e' allBold , ' any expr
+ ' , '`@m:' allBold , ' any message (`m => unary)
+ ' , '`{:n|...}' allBold , ' node pattern
+ ' , '`''a.*''' allBold , ' regex on string const
+'.
+
+ "Modified: / 08-08-2011 / 20:33:03 / cg"
+!
+
+isMethodHolder
+ isMethodHolder isNil ifTrue:[isMethodHolder := (LastCodeSearchWasMethod ? false) asValue].
+ ^ isMethodHolder
+! !
+
+!SearchDialog methodsFor:'setup-buttons'!
+
+addBrowseButton
+ |b|
+
+ b := Button label:(resources string:'Browse').
+ (DialogBox defaultOKButtonAtLeft) ifTrue:[
+ self addButton:b before:nil.
+ ] ifFalse:[
+ self addButton:b after:nil.
+ ].
+ b
+ action:[
+ openHow := #newBrowser.
+ self doAccept.
+ self okPressed.
+ ].
+ ^ b.
+!
+
+addBufferButton
+ |b|
+
+ b := Button label:(resources string:'Add Buffer').
+ (DialogBox defaultOKButtonAtLeft) ifTrue:[
+ self addButton:b before:nil.
+ ] ifFalse:[
+ self addButton:b after:nil.
+ ].
+ b
+ action:[
+ openHow := #newBuffer.
+ self doAccept.
+ self okPressed.
+ ].
+ ^ b.
+!
+
+addButtons
+ "add find/newBrowser/newBuffer buttons"
+
+ |prevButton|
+
+ allowFind ifTrue:[
+ defaultOpenHow := #showHere.
+ prevButton := self addFindButton.
+ ].
+ allowBrowser ifTrue:[
+ defaultOpenHow := #newBrowser.
+ prevButton := self addBrowseButton.
+ ].
+ allowBuffer ifTrue:[
+ defaultOpenHow := #newBuffer.
+ prevButton := self addBufferButton.
+ ].
+ prevButton notNil ifTrue:[
+ prevButton isReturnButton:true.
+ ].
+ self addAbortButton.
+!
+
+addFindButton
+ |b|
+
+ b := Button label:(resources string:'Find').
+ (DialogBox defaultOKButtonAtLeft) ifTrue:[
+ self addButton:b before:nil.
+ ] ifFalse:[
+ self addButton:b after:nil.
+ ].
+ b
+ action:[
+ openHow := #showHere.
+ self doAccept.
+ self okPressed.
+ ].
+ ^ b.
+! !
+
+!SearchDialog class methodsFor:'documentation'!
+
+version_CVS
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_SearchDialog.st,v 1.74 2013-03-16 16:12:51 cg Exp $'
+! !
+
+
+SearchDialog initialize!
--- a/Tools__CodeNavigationService.st Fri Mar 15 10:14:37 2013 +0000
+++ b/Tools__CodeNavigationService.st Fri Mar 22 09:21:23 2013 +0000
@@ -86,8 +86,7 @@
defaultSelectorEmphasis
DefaultSelectorEmphasis isNil ifTrue:[
- DefaultSelectorEmphasis :=
- Array with:(#backgroundColor -> (Color rgbValue:16rADD9FF "16rDBEEFF"))
+ ^ Array with:(#backgroundColor -> (UserPreferences current selectorBackgroundColorForNavigationService))
].
^ DefaultSelectorEmphasis
@@ -96,7 +95,7 @@
defaultVariableEmphasis
DefaultVariableEmphasis isNil ifTrue:[
- DefaultVariableEmphasis := Array with:(#backgroundColor -> (Color gray: 80 "90"))
+ ^ Array with:(#backgroundColor -> (UserPreferences current variableBackgroundColorForNavigationService))
].
^ DefaultVariableEmphasis
@@ -656,8 +655,12 @@
!CodeNavigationService class methodsFor:'documentation'!
+version
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__CodeNavigationService.st,v 1.22 2013-03-19 19:23:55 cg Exp $'
+!
+
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools__CodeNavigationService.st,v 1.20 2013-01-30 17:54:04 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__CodeNavigationService.st,v 1.22 2013-03-19 19:23:55 cg Exp $'
!
version_HG
--- a/Tools__InlineMessageDialog.st Fri Mar 15 10:14:37 2013 +0000
+++ b/Tools__InlineMessageDialog.st Fri Mar 22 09:21:23 2013 +0000
@@ -106,6 +106,7 @@
"
! !
+
!InlineMessageDialog class methodsFor:'accessing-colors'!
defaultInformationBackground
@@ -122,6 +123,7 @@
"Created: / 10-04-2012 / 19:30:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!InlineMessageDialog class methodsFor:'interface specs'!
messageInfoSpec
@@ -315,12 +317,14 @@
)
! !
+
!InlineMessageDialog class methodsFor:'others'!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools__InlineMessageDialog.st,v 1.8 2013-02-21 16:30:02 vrany Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__InlineMessageDialog.st,v 1.7 2012-05-17 15:31:22 vrany Exp $'
! !
+
!InlineMessageDialog methodsFor:'accessing'!
backgroundColor: aColor
@@ -358,6 +362,7 @@
"Created: / 28-10-2010 / 18:24:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!InlineMessageDialog methodsFor:'accessing-presentation'!
changeLayoutUponShowHide: aBoolean
@@ -372,6 +377,7 @@
"Modified (comment): / 17-05-2012 / 13:56:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!InlineMessageDialog methodsFor:'actions'!
doAbort
@@ -386,18 +392,15 @@
] do:[
AbortOperationRequest raise.
].
+ ].
+ (worker notNil and:[worker isDead not]) ifTrue:[
+ worker terminate.
+ "/ raise its prio to make it terminate quickly
worker priority:(Processor userSchedulingPriority + 1).
- worker terminate.
worker := nil.
].
-"/ (worker notNil and:[worker isDead not]) ifTrue:[
-"/ worker terminate.
-"/ "/ raise its prio to make it terminate quickly
-"/
-"/ worker := nil.
-"/ ].
- "Modified: / 13-03-2013 / 13:17:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 11-04-2012 / 16:24:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
doAbortIfWorking
@@ -410,16 +413,17 @@
<resource: #uiCallback>
(worker notNil and:[worker isDead not]) ifTrue:[
+ worker := nil.
+ worker terminate.
"/ raise its prio to make it terminate quickly
- worker priority:(Processor userSchedulingPriority + 1).
- worker terminate.
- worker := nil.
+ worker priority:(Processor userSchedulingPriority + 1)
].
self hide.
- "Modified: / 27-07-2012 / 15:42:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 11-04-2012 / 13:18:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!InlineMessageDialog methodsFor:'adding & removing components'!
addButton: aButton
@@ -521,6 +525,7 @@
"Created: / 11-04-2012 / 00:51:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!InlineMessageDialog methodsFor:'aspects'!
backgroundColorHolder
@@ -632,6 +637,7 @@
"Modified: / 28-10-2010 / 18:29:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!InlineMessageDialog methodsFor:'change & update'!
update:aspect with:parameter from:changedObject
@@ -646,6 +652,7 @@
"Modified: / 10-04-2012 / 19:36:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!InlineMessageDialog methodsFor:'hooks'!
commonPostBuild
@@ -674,6 +681,7 @@
"Created: / 10-02-2012 / 10:42:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!InlineMessageDialog methodsFor:'private'!
getMyView
@@ -772,6 +780,7 @@
"Created: / 29-10-2010 / 11:48:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!InlineMessageDialog methodsFor:'utilities'!
reset
@@ -866,6 +875,7 @@
"Created: / 11-04-2012 / 13:38:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!InlineMessageDialog methodsFor:'utilities-obsolete'!
information: message
@@ -934,15 +944,11 @@
"Created: / 13-02-2012 / 16:59:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!InlineMessageDialog class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools__InlineMessageDialog.st,v 1.8 2013-02-21 16:30:02 vrany Exp $'
-!
-
-version_HG
-
- ^ '$Changeset: <not expanded> $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__InlineMessageDialog.st,v 1.7 2012-05-17 15:31:22 vrany Exp $'
!
version_SVN
--- a/Tools__NewSystemBrowser.st Fri Mar 15 10:14:37 2013 +0000
+++ b/Tools__NewSystemBrowser.st Fri Mar 22 09:21:23 2013 +0000
@@ -448,7 +448,7 @@
'Hide toolbar. Show again via the "View"-Menu'
#hideBookmarkBar
-'Hide bookmarkbar. Show again via the "View"-Menu'
+'Hide the bookmark-bar. Show again via the "View"-menu'
#redoOperation
'Redo undone operation'
@@ -459,15 +459,15 @@
).
(RefactoryChangeManager notNil and:[ RefactoryChangeManager isLoaded ]) ifTrue:[
- manager := RefactoryChangeManager instance.
- manager hasUndoableOperations
- ifTrue:[
- spec at:#undoOperation put:(self resources string:'Undo (%1)' with:manager undoChange name).
- ].
- manager hasRedoableOperations
- ifTrue:[
- spec at:#redoOperation put:(self resources string:'Redo (%1)' with:manager redoChange name).
- ].
+ manager := RefactoryChangeManager instance.
+ manager hasUndoableOperations
+ ifTrue:[
+ spec at:#undoOperation put:(self resources string:'Undo (%1)' with:manager undoChange name).
+ ].
+ manager hasRedoableOperations
+ ifTrue:[
+ spec at:#redoOperation put:(self resources string:'Redo (%1)' with:manager redoChange name).
+ ].
].
^ spec.
@@ -8820,143 +8820,149 @@
^
#(Menu
- (
- (MenuItem
- enabled: canUseRefactoringSupport
- label: 'Variables'
- translateLabel: true
- submenu:
- (Menu
- (
- (MenuItem
- enabled: hasTemporaryVariableSelectedInCodeViewHolder
- label: 'Rename Local Variable...'
- itemValue: codeMenuRenameTemporary
- translateLabel: true
- showBusyCursorWhilePerforming: true
- )
- (MenuItem
- label: '-'
- )
- (MenuItem
- enabled: hasTemporaryVariableSelectedInCodeViewHolder
- label: 'Move to Inner Scope...'
- itemValue: codeMenuMoveVariableToInnerScope
- translateLabel: true
- showBusyCursorWhilePerforming: true
- )
- (MenuItem
- label: '-'
- )
- (MenuItem
- enabled: hasTemporaryVariableSelectedInCodeViewHolder
- label: 'Make Instance Variable'
- itemValue: codeMenuMakeInstanceVariable
- translateLabel: true
- isVisible: hasNotMultipleTemporaryVariablesSelectedInCodeViewHolder
- showBusyCursorWhilePerforming: true
- )
- (MenuItem
- enabled: hasMultipleTemporaryVariablesSelectedInCodeViewHolder
- label: 'Make Instance Variables'
- itemValue: codeMenuMakeInstanceVariable
- translateLabel: true
- isVisible: hasMultipleTemporaryVariablesSelectedInCodeViewHolder
- showBusyCursorWhilePerforming: true
- )
- (MenuItem
- label: '-'
- )
- (MenuItem
- enabled: hasUndefinedUppercaseIdentifierSelectedInCodeViewHolder
- label: 'Declare as Class Variable'
- itemValue: codeMenuDeclareSelectionAsClassVariable
- translateLabel: true
- )
- )
- nil
- nil
- )
- )
- (MenuItem
- label: '-'
- )
- (MenuItem
- enabled: hasSingleMethodSelectedAndSelectionInCodeViewAndCanUseRefactoringSupportHolder
- label: 'Inline Message'
- itemValue: codeMenuInlineMessage
- translateLabel: true
- showBusyCursorWhilePerforming: true
- )
- (MenuItem
- enabled: hasSingleMethodSelectedAndSelectionInCodeViewAndCanUseRefactoringSupportHolder
- label: 'Extract Selection to Temporary...'
- itemValue: codeMenuExtractSelectionToTemporary
- translateLabel: true
- showBusyCursorWhilePerforming: true
- )
- (MenuItem
- enabled: hasSingleMethodSelectedAndSelectionInCodeViewAndCanUseRefactoringSupportHolder
- label: 'Extract Method...'
- itemValue: codeMenuExtractMethod
- translateLabel: true
- showBusyCursorWhilePerforming: true
- )
- (MenuItem
- enabled: hasSingleMethodSelectedAndSelectionInCodeViewAndCanUseRefactoringSupportHolder
- label: 'Extract Method to Component...'
- itemValue: codeMenuExtractMethodToComponent
- translateLabel: true
- showBusyCursorWhilePerforming: true
- )
- (MenuItem
- label: '-'
- )
- (MenuItem
- enabled: hasSingleMethodSelectedAndCanUseRefactoringSupportHolder
- label: 'Add Parameter to Method...'
- itemValue: codeMenuAddParameter
- translateLabel: true
- showBusyCursorWhilePerforming: true
- )
- (MenuItem
- enabled: hasSingleMethodSelectedAndSelectionInCodeViewAndSingleSelectedMethodHasParameterAndCanUseRefactoringSupportHolder
- label: 'Inline Parameter of Method'
- itemValue: codeMenuInlineParameter
- translateLabel: true
- showBusyCursorWhilePerforming: true
- )
- (MenuItem
- enabled: hasSingleMethodSelectedAndSelectionInCodeViewAndSingleSelectedMethodHasParameterAndCanUseRefactoringSupportHolder
- label: 'Remove Parameter from Method'
- itemValue: codeMenuRemoveParameter
- translateLabel: true
- showBusyCursorWhilePerforming: true
- )
- (MenuItem
- label: '-'
- )
- (MenuItem
- enabled: hasSingleMethodSelectedAndCanUseRefactoringSupportHolder
- label: 'Format'
- itemValue: codeMenuFormat
- translateLabel: true
- showBusyCursorWhilePerforming: true
- )
- (MenuItem
- label: '-'
- isVisible: canLoadRefactoringSupport
- )
- (MenuItem
- label: 'Load Refactoring and Undo Features'
- itemValue: doLoadRefactoringSupport
- translateLabel: true
- isVisible: canLoadRefactoringSupport
- showBusyCursorWhilePerforming: true
- )
- )
- nil
- nil
+ (
+ (MenuItem
+ enabled: canUseRefactoringSupport
+ label: 'Variables'
+ translateLabel: true
+ submenu:
+ (Menu
+ (
+ (MenuItem
+ enabled: hasTemporaryVariableSelectedInCodeViewHolder
+ label: 'Rename Local Variable...'
+ itemValue: codeMenuRenameTemporary
+ translateLabel: true
+ showBusyCursorWhilePerforming: true
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
+ enabled: hasTemporaryVariableSelectedInCodeViewHolder
+ label: 'Move to Inner Scope...'
+ itemValue: codeMenuMoveVariableToInnerScope
+ translateLabel: true
+ showBusyCursorWhilePerforming: true
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
+ enabled: hasTemporaryVariableSelectedInCodeViewHolder
+ label: 'Make Instance Variable'
+ itemValue: codeMenuMakeInstanceVariable
+ translateLabel: true
+ isVisible: hasNotMultipleTemporaryVariablesSelectedInCodeViewHolder
+ showBusyCursorWhilePerforming: true
+ )
+ (MenuItem
+ enabled: hasMultipleTemporaryVariablesSelectedInCodeViewHolder
+ label: 'Make Instance Variables'
+ itemValue: codeMenuMakeInstanceVariable
+ translateLabel: true
+ isVisible: hasMultipleTemporaryVariablesSelectedInCodeViewHolder
+ showBusyCursorWhilePerforming: true
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
+ enabled: hasUndefinedUppercaseIdentifierSelectedInCodeViewHolder
+ label: 'Declare as Class Variable'
+ itemValue: codeMenuDeclareSelectionAsClassVariable
+ translateLabel: true
+ )
+ )
+ nil
+ nil
+ )
+ )
+ (MenuItem
+ enabled: hasLiteralConstantSelectedInCodeViewHolder
+ label: 'Eliminate Constant...'
+ itemValue: codeMenuEliminateConstant
+ translateLabel: true
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
+ enabled: hasSingleMethodSelectedAndSelectionInCodeViewAndCanUseRefactoringSupportHolder
+ label: 'Inline Message'
+ itemValue: codeMenuInlineMessage
+ translateLabel: true
+ showBusyCursorWhilePerforming: true
+ )
+ (MenuItem
+ enabled: hasSingleMethodSelectedAndSelectionInCodeViewAndCanUseRefactoringSupportHolder
+ label: 'Extract Selection to Temporary...'
+ itemValue: codeMenuExtractSelectionToTemporary
+ translateLabel: true
+ showBusyCursorWhilePerforming: true
+ )
+ (MenuItem
+ enabled: hasSingleMethodSelectedAndSelectionInCodeViewAndCanUseRefactoringSupportHolder
+ label: 'Extract Method...'
+ itemValue: codeMenuExtractMethod
+ translateLabel: true
+ showBusyCursorWhilePerforming: true
+ )
+ (MenuItem
+ enabled: hasSingleMethodSelectedAndSelectionInCodeViewAndCanUseRefactoringSupportHolder
+ label: 'Extract Method to Component...'
+ itemValue: codeMenuExtractMethodToComponent
+ translateLabel: true
+ showBusyCursorWhilePerforming: true
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
+ enabled: hasSingleMethodSelectedAndCanUseRefactoringSupportHolder
+ label: 'Add Parameter to Method...'
+ itemValue: codeMenuAddParameter
+ translateLabel: true
+ showBusyCursorWhilePerforming: true
+ )
+ (MenuItem
+ enabled: hasSingleMethodSelectedAndSelectionInCodeViewAndSingleSelectedMethodHasParameterAndCanUseRefactoringSupportHolder
+ label: 'Inline Parameter of Method'
+ itemValue: codeMenuInlineParameter
+ translateLabel: true
+ showBusyCursorWhilePerforming: true
+ )
+ (MenuItem
+ enabled: hasSingleMethodSelectedAndSelectionInCodeViewAndSingleSelectedMethodHasParameterAndCanUseRefactoringSupportHolder
+ label: 'Remove Parameter from Method'
+ itemValue: codeMenuRemoveParameter
+ translateLabel: true
+ showBusyCursorWhilePerforming: true
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
+ enabled: hasSingleMethodSelectedAndCanUseRefactoringSupportHolder
+ label: 'Format'
+ itemValue: codeMenuFormat
+ translateLabel: true
+ showBusyCursorWhilePerforming: true
+ )
+ (MenuItem
+ label: '-'
+ isVisible: canLoadRefactoringSupport
+ )
+ (MenuItem
+ label: 'Load Refactoring and Undo Features'
+ itemValue: doLoadRefactoringSupport
+ translateLabel: true
+ isVisible: canLoadRefactoringSupport
+ showBusyCursorWhilePerforming: true
+ )
+ )
+ nil
+ nil
)
"Modified: / 04-07-2011 / 17:51:17 / cg"
@@ -11532,6 +11538,7 @@
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
+
"
MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#selectorMenuSearchSlice
(Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser selectorMenuSearchSlice)) startUp
@@ -11539,69 +11546,63 @@
<resource: #menu>
- ^
- #(Menu
- (
- (MenuItem
- label: 'Senders...'
- itemValue: browseSendersOf
- translateLabel: true
- )
- (MenuItem
- label: 'Senders of Any...'
- itemValue: browseSendersOfAny
- translateLabel: true
- isVisible: hasMultipleMethodsSelectedHolder
- )
- (MenuItem
- label: 'Senders'
- translateLabel: true
- isVisible: hasSingleMethodSelectedHolder
- submenuChannel: sentMessagesMenu
- )
- (MenuItem
- label: 'Implementors...'
- itemValue: browseMenuImplementorsOf
- translateLabel: true
- shortcutKey: #'Cmdi'
-ignoreShortcutKeys: true
- )
- (MenuItem
- label: 'Implementors of Any...'
- itemValue: browseMenuImplementorsOfAny
- translateLabel: true
- isVisible: hasMultipleMethodsSelectedHolder
- )
- (MenuItem
- label: 'Implementors'
- translateLabel: true
- "/ isVisible: hasSingleMethodSelectedHolder
- submenuChannel: implementedMessagesMenu
- )
- (MenuItem
- label: 'Globals'
- translateLabel: true
- "/ isVisible: hasSingleMethodSelectedHolder
- submenuChannel: globalReferencesMenu
- )
- (MenuItem
- label: 'String Search...'
- itemValue: browseMenuMethodsWithString
- translateLabel: true
- shortcutKey: #'Cmdt'
-ignoreShortcutKeys: true
- )
- (MenuItem
- label: 'Code Search...'
- itemValue: browseMenuMethodsWithCode
- translateLabel: true
- )
- )
- nil
- nil
- )
-
- "Modified: / 26-10-2011 / 18:08:38 / cg"
+ ^
+ #(Menu
+ (
+ (MenuItem
+ label: 'Senders...'
+ itemValue: browseSendersOf
+ )
+ (MenuItem
+ label: 'Senders of Any...'
+ itemValue: browseSendersOfAny
+ isVisible: hasMultipleMethodsSelectedHolder
+ )
+ (MenuItem
+ label: 'Senders'
+ isVisible: hasSingleMethodSelectedHolder
+ submenuChannel: sentMessagesMenu
+ )
+ (MenuItem
+ label: 'Implementors...'
+ itemValue: browseMenuImplementorsOf
+ shortcutKey: Cmdi
+ ignoreShortcutKeys: true
+ )
+ (MenuItem
+ label: 'Implementors of Any...'
+ itemValue: browseMenuImplementorsOfAny
+ isVisible: hasMultipleMethodsSelectedHolder
+ )
+ (MenuItem
+ label: 'Implementors'
+ translateLabel: true
+ "/ isVisible: hasSingleMethodSelectedHolder
+ submenuChannel: implementedMessagesMenu
+ )
+ (MenuItem
+ label: 'Follow Implementation'
+ submenuChannel: followImplementorMessagesMenu
+ enabled: hasMethodWithSelfSendSelected
+ )
+ (MenuItem
+ label: 'Globals'
+ submenuChannel: globalReferencesMenu
+ )
+ (MenuItem
+ label: 'String Search...'
+ itemValue: browseMenuMethodsWithString
+ shortcutKey: Cmdt
+ ignoreShortcutKeys: true
+ )
+ (MenuItem
+ label: 'Code Search...'
+ itemValue: browseMenuMethodsWithCode
+ )
+ )
+ nil
+ nil
+ )
!
selectorMenuSpawnSlice
@@ -16823,6 +16824,43 @@
"Modified: / 29-09-2006 / 16:11:08 / cg"
! !
+!NewSystemBrowser class methodsFor:'menu specs-monticello'!
+
+projectMonticelloMenu
+ "This resource specification was automatically generated
+ by the MenuEditor of ST/X."
+
+ "Do not manually edit this!! If it is corrupted,
+ the MenuEditor may not be able to read the specification."
+
+
+ "
+ MenuEditor new openOnClass:Tools::NewSystemBrowser andSelector:#projectMonticelloMenu
+ (Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser projectMonticelloMenu)) startUp
+ "
+
+ <resource: #menu>
+
+ ^
+ #(Menu
+ (
+ (MenuItem
+ label: 'Commit or Generate mcz File...'
+ itemValue: projectMenuMonticelloCommit
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
+ enabled: false
+ label: 'Not yet finished...'
+ )
+ )
+ nil
+ nil
+ )
+! !
+
!NewSystemBrowser class methodsFor:'menu specs-popup'!
categoryPopUpMenu
@@ -20980,6 +21018,14 @@
^ builder booleanValueAspectFor:#hasMethodWithBreakPointSelectedHolder.
!
+hasMethodWithSelfSendSelected
+ ^ self hasAnyMethodSelectedForWhich:[:m |
+ m messagesSentToSelf notEmpty
+ or:[ m messagesSentToSuper notEmpty ]]
+
+ "Modified: / 28-02-2012 / 16:23:11 / cg"
+!
+
hasMethodWithTracePointSelected
^ self hasAnyMethodSelectedForWhich:[:m | m isWrapped and:[m isBreakpointed not] ]
@@ -22349,12 +22395,12 @@
"/ self classWizardVisibleHolder value:(selectedClasses size == 0).
(navigationState isClassDocumentationBrowser) ifTrue:[
- "/ kludge - docBrowser can only show one single class
- selectedClasses size > 1 ifTrue:[
- selectedClassesHolder value:(Array with:selectedClasses first).
- self enqueueDelayedUpdateBufferLabel.
- ^ self.
- ]
+ "/ kludge - docBrowser can only show one single class
+ selectedClasses size > 1 ifTrue:[
+ selectedClassesHolder value:(Array with:selectedClasses first).
+ self enqueueDelayedUpdateBufferLabel.
+ ^ self.
+ ]
].
"/ selectedClasses size == 1 ifTrue:[
@@ -22362,8 +22408,9 @@
"/ ].
navigationState isVersionDiffBrowser ifFalse:[
- self class addToHistory:(self theSingleSelectedClass) selector:nil.
- ].
+ self class addToHistory:(self theSingleSelectedClass) selector:nil.
+ ].
+
self enqueueDelayedClassSelectionChange.
"Modified: / 25.2.2000 / 14:07:08 / cg"
@@ -22396,6 +22443,7 @@
self updateInitSharedPoolVisibility.
self updateLaunchApplicationVisibility.
self updateTextEditorBehavior.
+ self delayedUpdateCode.
"Modified: / 01-06-2012 / 23:01:52 / cg"
!
@@ -22750,11 +22798,10 @@
!
enqueueDelayedUpdateCode
-^ self delayedUpdateCode.
- ^ self
- enqueueMessage:#delayedUpdateCode
- for:self
- arguments:#()
+ ^ self
+ enqueueMessage:#delayedUpdateCode
+ for:self
+ arguments:#()
"Modified: / 06-09-2006 / 19:07:15 / cg"
!
@@ -26272,8 +26319,9 @@
categoryMenuRecompileInstrumented
self selectedCategoryClassesDo:[:eachClass |
- self recompileClassWithInstrumentation:eachClass
- ].
+ self recompileClassWithInstrumentation:eachClass
+ ].
+ self infoLabelHolder value:nil.
self askForGlobalCoverageRecording.
"Created: / 31-05-2012 / 09:15:44 / cg"
@@ -29934,8 +29982,9 @@
classMenuRecompileInstrumented
self selectedClassesDo:[:eachClass |
- self recompileClassWithInstrumentation:eachClass
- ].
+ self recompileClassWithInstrumentation:eachClass
+ ].
+ self infoLabelHolder value:nil.
self askForGlobalCoverageRecording.
"Modified: / 10-08-2010 / 14:36:42 / cg"
@@ -31348,35 +31397,38 @@
(aClass == IdentityDictionary) ifTrue:[^ self].
(aClass == SmallInteger) ifTrue:[^ self].
-"/ aClass theNonMetaclass recompileUsingCompilerClass:InstrumentingCompiler.
-"/ aClass theMetaclass recompileUsingCompilerClass:InstrumentingCompiler.
+ self infoLabelHolder value:('recompiling ',aClass name,'...').
compile :=
- [:cls :sel :mthd |
- ((mthd sends:#subclassResponsibility)
- or:[ (mthd sends:#subclassResponsibility:) ]) ifFalse:[
- mthd hasPrimitiveCode ifFalse:[
- cls recompile:sel usingCompiler:InstrumentingCompiler new
- ]
- ]
- ].
+ [:cls :sel :mthd |
+ ((mthd sends:#subclassResponsibility)
+ or:[ (mthd sends:#subclassResponsibility:) ]) ifFalse:[
+ mthd hasPrimitiveCode ifFalse:[
+ cls recompile:sel usingCompiler:InstrumentingCompiler new
+ ]
+ ]
+ ].
(cls := aClass theNonMetaclass)
- selectorsAndMethodsDo:[:aSelector :aMethod |
- compile value:cls value:aSelector value:aMethod.
- ].
+ selectorsAndMethodsDo:[:aSelector :aMethod |
+ aMethod isInstrumented ifFalse:[
+ compile value:cls value:aSelector value:aMethod.
+ ].
+ ].
(cls := aClass theMetaclass)
- selectorsAndMethodsDo:[:aSelector :aMethod |
- aMethod category ~= 'documentation' ifTrue:[
- compile value:cls value:aSelector value:aMethod.
- ]
- ].
+ selectorsAndMethodsDo:[:aSelector :aMethod |
+ aMethod category ~= 'documentation' ifTrue:[
+ aMethod isInstrumented ifFalse:[
+ compile value:cls value:aSelector value:aMethod.
+ ]
+ ]
+ ].
self showCoverageInformation value ifFalse:[
- true "(Dialog confirm:(resources string:'Turn on coverage display now ?'))" ifTrue:[
- self showCoverageInformation value:true
- ].
+ true "(Dialog confirm:(resources string:'Turn on coverage display now ?'))" ifTrue:[
+ self showCoverageInformation value:true
+ ].
].
"Created: / 10-08-2010 / 14:36:45 / cg"
@@ -35012,26 +35064,28 @@
selectedClass := self theSingleSelectedClass.
selectedClass isNil ifTrue:[
- mthd := self theSingleSelectedMethod.
- mthd isNil ifTrue:[
- Dialog information:'Please select a class or method'.
- ^ self
- ].
- selectedClass := mthd mclass
+ mthd := self theSingleSelectedMethod.
+ mthd isNil ifTrue:[
+ Dialog information:'Please select a class or method'.
+ ^ self
+ ].
+ selectedClass := mthd mclass
].
selectedClass isMeta ifTrue:[
- LastLiteralReplacementType == #instanceMethod ifTrue:[ LastLiteralReplacementType := #classMethod ].
- LastLiteralReplacementType == #instanceVariable ifTrue:[ LastLiteralReplacementType := #classVariable ].
+ LastLiteralReplacementType == #instanceMethod ifTrue:[ LastLiteralReplacementType := #classMethod ].
+ LastLiteralReplacementType == #instanceVariable ifTrue:[ LastLiteralReplacementType := #classVariable ].
].
radioModel := RadioButtonGroup new value:(LastLiteralReplacementType ? #classMethod).
initialNewName :=
- DoWhatIMeanSupport
- goodRenameDefaultFor:literalString
- lastOld:LastLiteralReplacementOldLiteral
- lastNew:LastLiteralReplacementNewName.
+ DoWhatIMeanSupport
+ goodRenameDefaultFor:literalString
+ lastOld:LastLiteralReplacementOldLiteral
+ lastNew:LastLiteralReplacementNewName.
initialNewName isEmptyOrNil ifTrue:[ initialNewName := literalString "(LastLiteralReplacementNewName ? '')" ].
+ initialNewName first isDigit ifTrue:[ initialNewName := 'const_',initialNewName ].
+ initialNewName first isLetter ifFalse:[ initialNewName := 'const_XXX_',literalValue className ].
nameHolder := initialNewName asValue.
box := DialogBox new.
@@ -35064,131 +35118,131 @@
numMethodsAdded := numMethodsRewritten := 0.
(changeHow == #instanceMethod or:[changeHow == #instanceVariable]) ifTrue:[
- targetClass := selectedClass theNonMetaclass
- ] ifFalse:[
- targetClass := selectedClass theMetaclass
+ targetClass := selectedClass theNonMetaclass
+ ] ifFalse:[
+ targetClass := selectedClass theMetaclass
].
(changeHow == #instanceMethod or:[changeHow == #classMethod]) ifTrue:[
- (targetClass includesSelector:name asSymbol) ifFalse:[
- refactoring compile:('%1\ ^ %2' withCRs bindWith:name with:literalString) in:targetClass classified:'constants'.
- numMethodsAdded := numMethodsAdded + 1.
- ] ifTrue:[
- "/ if the getter already exists, it must return the same literal
- mthd := targetClass compiledMethodAt:name asSymbol.
- ((ParseTreeSearcher isJustReturningLiteralString:literalString)
- executeTree:(mthd parseTree) initialAnswer:nil) notNil
- ifFalse:[
- Dialog information:(resources
- stringWithCRs:'A method named "%1" already exists\with different semantics (does not return "%2")'
- with:name
- with:literalString).
- ^ self.
- ].
- ].
- ] ifFalse:[
- changeHow == #instanceVariable ifTrue:[
- (targetClass theNonMetaclass allInstVarNames includes:name) ifTrue:[
- "/ already present
- Dialog information:(resources
- stringWithCRs:'An instance variable named "%1" already exists'
- with:name).
- ^ self.
- ].
- refactoring addInstanceVariable:name to:targetClass theNonMetaclass.
- ] ifFalse:[
- "/ class variable
- (targetClass theNonMetaclass allClassVarNames includes:name) ifTrue:[
- "/ already present
- Dialog information:(resources
- stringWithCRs:'A class variable named "%1" already exists'
- with:name).
- ^ self.
- ].
- refactoring addClassVariable:name to:targetClass theNonMetaclass.
- ].
-
- (targetClass includesSelector:#initialize) ifFalse:[
- refactoring compile:('initialize\ %1 := %2.' withCRs bindWith:name with:literalString) in:targetClass classified:'initialization'.
- numMethodsAdded := numMethodsAdded + 1.
- ] ifTrue:[
- |setToThis setToOther rewriter newSource change|
-
- setToThis := setToOther := false.
-
- mthd := targetClass compiledMethodAt:#initialize.
-
- "/ already a setting for that variable ?
- "/ cannot happen now, as we only allow not-already-existing vars in the above code.
- "/ if we ever support this, must check if the existing init-code is already correct for the new value
- (ParseTreeSearcher new
- answer:false;
- matches:('%1 := ``@expr' bindWith:name) do:[:aNode :ans | self halt. false];
- yourself)
- executeTree:(mthd parseTree) initialAnswer:false.
-
- setToOther ifTrue:[
- Dialog information:(resources
- stringWithCRs:'Variable named "%1" is already initialized to a different value'
- with:name).
- ^ self.
- ].
- setToThis ifFalse:[
- "/ sigh - the source rewriter is very limited; it cannot append code yet...
- rewriter := "ParseTreeSourceRewriter "ParseTreeRewriter new
- replace: '| `@temps | ``@.stats. '
- with:('| `@temps | ``@.stats.\ %1 := %2.' withCRs bindWith:name with:literalString).
-
- rewriter executeTree: mthd parseTree.
- newSource := rewriter tree formattedCode.
+ (targetClass includesSelector:name asSymbol) ifFalse:[
+ refactoring compile:('%1\ ^ %2' withCRs bindWith:name with:literalString) in:targetClass classified:'constants'.
+ numMethodsAdded := numMethodsAdded + 1.
+ ] ifTrue:[
+ "/ if the getter already exists, it must return the same literal
+ mthd := targetClass compiledMethodAt:name asSymbol.
+ ((ParseTreeSearcher isJustReturningLiteralString:literalString)
+ executeTree:(mthd parseTree) initialAnswer:nil) notNil
+ ifFalse:[
+ Dialog information:(resources
+ stringWithCRs:'A method named "%1" already exists\with different semantics (does not return "%2")'
+ with:name
+ with:literalString).
+ ^ self.
+ ].
+ ].
+ ] ifFalse:[
+ changeHow == #instanceVariable ifTrue:[
+ (targetClass theNonMetaclass allInstVarNames includes:name) ifTrue:[
+ "/ already present
+ Dialog information:(resources
+ stringWithCRs:'An instance variable named "%1" already exists'
+ with:name).
+ ^ self.
+ ].
+ refactoring addInstanceVariable:name to:targetClass theNonMetaclass.
+ ] ifFalse:[
+ "/ class variable
+ (targetClass theNonMetaclass allClassVarNames includes:name) ifTrue:[
+ "/ already present
+ Dialog information:(resources
+ stringWithCRs:'A class variable named "%1" already exists'
+ with:name).
+ ^ self.
+ ].
+ refactoring addClassVariable:name to:targetClass theNonMetaclass.
+ ].
+
+ (targetClass includesSelector:#initialize) ifFalse:[
+ refactoring compile:('initialize\ %1 := %2.' withCRs bindWith:name with:literalString) in:targetClass classified:'initialization'.
+ numMethodsAdded := numMethodsAdded + 1.
+ ] ifTrue:[
+ |setToThis setToOther rewriter newSource change|
+
+ setToThis := setToOther := false.
+
+ mthd := targetClass compiledMethodAt:#initialize.
+
+ "/ already a setting for that variable ?
+ "/ cannot happen now, as we only allow not-already-existing vars in the above code.
+ "/ if we ever support this, must check if the existing init-code is already correct for the new value
+ (ParseTreeSearcher new
+ answer:false;
+ matches:('%1 := ``@expr' bindWith:name) do:[:aNode :ans | self halt. false];
+ yourself)
+ executeTree:(mthd parseTree) initialAnswer:false.
+
+ setToOther ifTrue:[
+ Dialog information:(resources
+ stringWithCRs:'Variable named "%1" is already initialized to a different value'
+ with:name).
+ ^ self.
+ ].
+ setToThis ifFalse:[
+ "/ sigh - the source rewriter is very limited; it cannot append code yet...
+ rewriter := "ParseTreeSourceRewriter "ParseTreeRewriter new
+ replace: '| `@temps | ``@.stats. '
+ with:('| `@temps | ``@.stats.\ %1 := %2.' withCRs bindWith:name with:literalString).
+
+ rewriter executeTree: mthd parseTree.
+ newSource := rewriter tree formattedCode.
"/ newSource := rewriter executeReplacementsInSource:mthd source.
"/ rewriter forgetReplacements.
- change := InteractiveAddMethodChange compile:newSource in:mthd mclass classified:mthd category.
- refactoring addChange:change.
- numMethodsRewritten := numMethodsRewritten + 1.
- ].
- ]
+ change := InteractiveAddMethodChange compile:newSource in:mthd mclass classified:mthd category.
+ refactoring addChange:change.
+ numMethodsRewritten := numMethodsRewritten + 1.
+ ].
+ ]
].
matchingMethods := OrderedCollection new.
targetClass theNonMetaclass methodDictionary keysAndValuesDo:[:selector :mth |
- selector ~= name ifTrue:[
- (ParseTreeSearcher new)
- matches:literalString do:[:aNode :answer | matchingMethods add:mth ];
- executeTree:mth parseTree.
- ].
+ selector ~= name ifTrue:[
+ (ParseTreeSearcher new)
+ matches:literalString do:[:aNode :answer | matchingMethods add:mth ];
+ executeTree:mth parseTree.
+ ].
].
(changeHow == #classVariable or:[changeHow == #classMethod]) ifTrue:[
- targetClass theMetaclass methodDictionary keysAndValuesDo:[:selector :mth |
- selector ~= name ifTrue:[
- (ParseTreeSearcher new)
- matches:literalString do:[:aNode :answer | matchingMethods add:mth ];
- executeTree:mth parseTree.
- ].
- ].
+ targetClass theMetaclass methodDictionary keysAndValuesDo:[:selector :mth |
+ selector ~= name ifTrue:[
+ (ParseTreeSearcher new)
+ matches:literalString do:[:aNode :answer | matchingMethods add:mth ];
+ executeTree:mth parseTree.
+ ].
+ ].
].
matchingMethods do:[:mth |
- |change replacementSource rewriter newSource|
-
- (changeHow == #instanceVariable or:[changeHow == #classVariable]) ifTrue:[
- replacementSource := name.
- ] ifFalse:[
- (changeHow == #instanceMethod) ifTrue:[
- replacementSource := ('self ',name).
- ] ifFalse:[
- mth mclass isMeta ifTrue:[
- replacementSource := ('self ',name).
- ] ifFalse:[
- replacementSource := ('self class ',name).
- ].
- ].
- ].
- rewriter := ParseTreeSourceRewriter "ParseTreeRewriter" new
- replace: literalString
- with: replacementSource.
+ |change replacementSource rewriter newSource|
+
+ (changeHow == #instanceVariable or:[changeHow == #classVariable]) ifTrue:[
+ replacementSource := name.
+ ] ifFalse:[
+ (changeHow == #instanceMethod) ifTrue:[
+ replacementSource := ('self ',name).
+ ] ifFalse:[
+ mth mclass isMeta ifTrue:[
+ replacementSource := ('self ',name).
+ ] ifFalse:[
+ replacementSource := ('self class ',name).
+ ].
+ ].
+ ].
+ rewriter := ParseTreeSourceRewriter "ParseTreeRewriter" new
+ replace: literalString
+ with: replacementSource.
"/ "/ with the original ParseTreeRewriter, you would
"/ "/ get a new tree, loose all formatting and some comments...
@@ -35197,32 +35251,32 @@
"/ tree.
"/ newSource := newTree formattedCode.
- "/ so we use the new in-place ParseTreeSourceRewriter
- rewriter executeTree: mth parseTree.
- newSource := rewriter executeReplacementsInSource:mth source.
- rewriter forgetReplacements.
-
- change := InteractiveAddMethodChange compile:newSource in:mth mclass classified:mth category.
- refactoring addChange:change.
- numMethodsRewritten := numMethodsRewritten + 1.
+ "/ so we use the new in-place ParseTreeSourceRewriter
+ rewriter executeTree: mth parseTree.
+ newSource := rewriter executeReplacementsInSource:mth source.
+ rewriter forgetReplacements.
+
+ change := InteractiveAddMethodChange compile:newSource in:mth mclass classified:mth category.
+ refactoring addChange:change.
+ numMethodsRewritten := numMethodsRewritten + 1.
].
(numMethodsRewritten+numMethodsAdded) > 1 ifTrue:[
- informationMessage :=
- numMethodsRewritten > 0
- ifTrue:[
- numMethodsAdded > 0
- ifTrue:[ 'rewrite %1 and add %2 methods' ]
- ifFalse:[ 'rewrite %1 methods' ] ]
- ifFalse:[ 'add %2 methods' ].
- confirmationQuestion := 'OK to ',informationMessage.
- "/ (Dialog confirm:(resources string:confirmationQuestion with:numMethodsRewritten with:numMethodsAdded)) ifFalse:[^ self].
+ informationMessage :=
+ numMethodsRewritten > 0
+ ifTrue:[
+ numMethodsAdded > 0
+ ifTrue:[ 'rewrite %1 and add %2 methods' ]
+ ifFalse:[ 'rewrite %1 methods' ] ]
+ ifFalse:[ 'add %2 methods' ].
+ confirmationQuestion := 'OK to ',informationMessage.
+ "/ (Dialog confirm:(resources string:confirmationQuestion with:numMethodsRewritten with:numMethodsAdded)) ifFalse:[^ self].
].
self performRefactoring:refactoring.
"/ set the class variable
(changeHow == #classVariable) ifTrue:[
- targetClass classVarAt:name asSymbol put:literalValue
+ targetClass classVarAt:name asSymbol put:literalValue
].
self showInfo:(resources string:informationMessage with:numMethodsRewritten with:numMethodsAdded).
@@ -37129,12 +37183,13 @@
testedClasses := Set new.
self selectedNonAbstractTestCaseClassesDo:[:eachClass |
- testedClasses addAll:(eachClass coveredClasses).
+ testedClasses addAll:(eachClass coveredClasses).
].
testedClasses do:[:eachClass |
- self recompileClassWithInstrumentation:eachClass
- ].
-
+ self recompileClassWithInstrumentation:eachClass
+ ].
+
+ self infoLabelHolder value:nil.
self askForGlobalCoverageRecording.
self runTestCasesWithDebug:false protocols:nil.
@@ -37525,6 +37580,7 @@
"Modified: / 28-02-2012 / 16:27:44 / cg"
! !
+
!NewSystemBrowser methodsFor:'menu actions-namespace'!
nameSpaceMenuCheckOut
@@ -39735,38 +39791,40 @@
currentProject := self theSingleSelectedProject ? 'selected projects'.
dirName := self
- askForDirectoryToFileOut:(resources string:'FileOut %1 in:'
- with:currentProject)
- default:nil.
+ askForDirectoryToFileOut:(resources string:'FileOut %1 in:'
+ with:currentProject)
+ default:nil.
dirName isNil ifTrue:[
- ^ self
+ ^ self
].
dirName asFilename exists ifFalse:[
- dirName asFilename recursiveMakeDirectory
- ].
-
- self
- fileOutEachClassIn:self selectedProjectClasses
- in:dirName
- withFormat:aFormatSymbolOrNil.
+ dirName asFilename recursiveMakeDirectory
+ ].
+
+ self
+ fileOutEachClassIn:self selectedProjectClasses
+ in:dirName
+ withFormat:aFormatSymbolOrNil.
+
+ "/ extensions...
methodsToFileOut := OrderedCollection new.
Smalltalk allClassesDo:[:eachClass |
- eachClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
- |mPckg|
-
- mPckg := mthd package.
- (mPckg = currentProject and:[mPckg ~= eachClass package]) ifTrue:[
- methodsToFileOut add:mthd
- ]
- ]
+ eachClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
+ |mPckg|
+
+ mPckg := mthd package.
+ (mPckg = currentProject and:[mPckg ~= eachClass package]) ifTrue:[
+ methodsToFileOut add:mthd
+ ]
+ ]
].
dirName := dirName asFilename.
fileNameForExtensions := (dirName construct:'extensions') withSuffix:(self fileSuffixForFormat:aFormatSymbolOrNil).
self
- fileOutMethods:methodsToFileOut
- format:aFormatSymbolOrNil
- toFile:fileNameForExtensions
- withPackage:true
+ fileOutMethods:methodsToFileOut
+ format:aFormatSymbolOrNil
+ toFile:fileNameForExtensions
+ withPackage:true
"Modified: / 05-09-2011 / 22:02:48 / cg"
!
@@ -40464,8 +40522,9 @@
projectMenuRecompileInstrumented
self selectedProjectClasses do:[:eachClass |
- self recompileClassWithInstrumentation:eachClass
- ].
+ self recompileClassWithInstrumentation:eachClass
+ ].
+ self infoLabelHolder value:nil.
self askForGlobalCoverageRecording.
"Created: / 27-04-2010 / 12:39:43 / cg"
@@ -40986,10 +41045,10 @@
selectedProjectsDo:aBlock
|selectedProjects allProjects|
- selectedProjects := self selectedProjects value.
+ selectedProjects := self selectedProjects value ? #().
(selectedProjects includes:(BrowserList nameListEntryForALL)) ifTrue:[
- allProjects := Smalltalk allClasses collect:[:eachClass | eachClass package] as:Set.
- selectedProjects := allProjects select:[:each| each notNil].
+ allProjects := Smalltalk allClasses collect:[:eachClass | eachClass package] as:Set.
+ selectedProjects := allProjects select:[:each| each notNil].
].
selectedProjects := selectedProjects asOrderedCollection.
selectedProjects sort do:aBlock
@@ -42209,51 +42268,53 @@
currentMethod := self theSingleSelectedMethod.
searchClass := self theSingleSelectedClass.
searchClass isNil ifTrue:[
- searchClass := self classHierarchyTopClass value.
- searchClass isNil ifTrue:[
- currentMethod notNil ifTrue:[
- searchClass := currentMethod mclass
- ].
- ].
- searchClass isNil ifTrue:[
- self information:'No class or method selected (cannot search).'.
- ^ self
- ]
+ searchClass := self classHierarchyTopClass value.
+ searchClass isNil ifTrue:[
+ currentMethod notNil ifTrue:[
+ searchClass := currentMethod mclass
+ ].
+ ].
+ searchClass isNil ifTrue:[
+ self information:'No class or method selected (cannot search).'.
+ ^ self
+ ]
].
(currentMethod notNil
and:[currentMethod selector == selector]) ifTrue:[
- searchClass := searchClass superclass.
+ searchClass := searchClass superclass.
].
"/ search for the implementaion
class := searchClass whichClassIncludesSelector:selector.
class isNil ifTrue:[
- searchClass isMeta ifTrue:[
- class := searchClass theNonMetaclass whichClassIncludesSelector:selector.
- ] ifFalse:[
- class := searchClass theMetaclass whichClassIncludesSelector:selector.
- ]
+ searchClass isMeta ifTrue:[
+ class := searchClass theNonMetaclass whichClassIncludesSelector:selector.
+ ] ifFalse:[
+ class := searchClass theMetaclass whichClassIncludesSelector:selector.
+ ]
].
"/ cannot switch method in a singleMethod browser ...
- (where isNil and:[navigationState isSingleMethodBrowser])
+ (where isNil
+ and:[navigationState isSingleMethodBrowser
+ or:[ navigationState isMethodListBrowser and:[(navigationState methodList includesIdentical:mthd) not] ] ])
ifTrue:[
- where := #newBuffer.
+ where := #newBuffer.
].
class isNil ifTrue:[
- self information:'None found'.
- ] ifFalse:[
- mthd := class compiledMethodAt:selector.
-
- where isNil ifTrue:[
- self rememberLocationInHistory.
- self switchToClass:class selector:selector.
- ] ifFalse:[
- self spawnMethodBrowserFor:(Array with:mthd) in:where
- label:(resources string:'Response to %1' with:selector)
- ]
+ self information:'None found'.
+ ] ifFalse:[
+ mthd := class compiledMethodAt:selector.
+
+ where isNil ifTrue:[
+ self rememberLocationInHistory.
+ self switchToClass:class selector:selector.
+ ] ifFalse:[
+ self spawnMethodBrowserFor:(Array with:mthd) in:where
+ label:(resources string:'Response to %1' with:selector)
+ ]
].
!
@@ -42491,6 +42552,10 @@
]
"Modified: / 02-06-2011 / 11:35:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+selectResponseTo:selector
+ self findResponseTo:selector in:nil
! !
!NewSystemBrowser methodsFor:'menu actions-selector'!
@@ -48441,6 +48506,23 @@
"Modified: / 09-09-2012 / 13:06:07 / cg"
!
+followImplementorMessagesMenu
+ ^ [
+ self
+ messagesMenuFor: #'selectResponseTo:'
+ withCurrentSelector:false
+ withSenderChain: false
+ withImplementorChain: false
+ withLocalSenders: false
+ withLocalImplementors: false
+ withCallersOfThisMethod: false
+ withMethodsCalledByThisMethod: false
+ selfSendsOnly:true
+ ]
+
+ "Modified: / 05-09-2006 / 10:34:10 / cg"
+!
+
globalReferencesMenu
"a menu allowing to browse the referenced globals (typically: classes) of the
selected method(s)"
@@ -48624,6 +48706,166 @@
"Created: / 02-07-2011 / 18:39:15 / cg"
!
+messagesMenuFor:actionSelector
+ withCurrentSelector:withCurrentSelector
+ withSenderChain:withSenderChain withImplementorChain:withImplementorChain
+ withLocalSenders:withLocalSenders withLocalImplementors:withLocalImplementors
+ withCallersOfThisMethod:withCallersOfThisMethod withMethodsCalledByThisMethod:withMethodsCalledByThisMethod
+ selfSendsOnly:selfSendsOnly
+
+ <resource: #programMenu >
+
+ |m mthd mSel contractedSelector item l methods allMessagesSent needSep|
+
+ m := Menu new.
+
+ mthd := self theSingleSelectedMethod.
+ (mthd notNil and:[ (mSel := mthd selector) notNil]) ifTrue:[
+ 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.
+"/ item argument:(#instanceProtocolOnly -> mSel).
+"/ m addItem:item.
+"/ ].
+"/ true "withClassProtocolOnly" ifTrue:[
+"/ item := MenuItem label:(resources string:' %1 - Class Protocol Only' with:contractedSelector).
+"/ item value:actionSelector.
+"/ item argument:(#classProtocolOnly -> mSel).
+"/ 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.
+ ] ifFalse:[
+ l := mthd messagesSent asArray.
+ l := l , (mthd messagesPossiblySent asArray collect:[:each | each colorizeAllWith:Color darkGrey]).
+ ].
+ l size > 0 ifTrue:[
+ l := l asSortedCollection.
+ needSep ifTrue:[ m addSeparator ].
+
+"
+ (l size > 30) ifTrue:[
+ l removeAllFoundIn:#(ifTrue: ifFalse: ifTrue:ifFalse: ifFalse:ifTrue:
+ whileTrue: whileFalse:
+ isNil notNil
+ and: or:
+ ).
+ (l size > 30) ifTrue:[
+ l removeAllFoundIn:#(#'==' #'~~' class
+ ).
+ ]
+ ].
+ (cut := l size > 30) ifTrue:[
+ l := l copyTo:30
+ ].
+"
+ l do:[:eachMessage |
+ item := MenuItem label:(' ' , (eachMessage contractTo:100), ' '). "/ ' ' is a kludge - to allow '-' selector
+ item itemValue:actionSelector argument:eachMessage string asSymbol.
+ m addItem:item.
+ ].
+
+"
+ cut ifTrue:[
+ m addItem:(MenuItem label:'-').
+ m addItem:(MenuItem label:'<< more items ignored >>').
+ ]
+"
+ ]
+ ] ifFalse:[
+ 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].
+ ].
+ ].
+ 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).
+ ].
+ ].
+
+ allMessagesSent := allMessagesSent asSortedCollection.
+ allMessagesSent size > 0 ifTrue:[
+ m addSeparator.
+ allMessagesSent do:[:eachMessage |
+ item := MenuItem label:(' ' , (eachMessage contractTo:100), ' '). "/ ' ' is a kludge - to allow '-' selector
+ item itemValue:actionSelector argument:eachMessage asSymbol.
+ m addItem:item.
+ ].
+ ].
+ ].
+
+ ^ m
+
+ "Created: / 27-04-2010 / 15:05:52 / cg"
+ "Modified: / 09-09-2012 / 13:20:43 / cg"
+!
+
messagesMenuFor:actionSelector withSenderChain:withSenderChain withImplementorChain:withImplementorChain
^ self
messagesMenuFor:actionSelector
@@ -48674,150 +48916,13 @@
<resource: #programMenu >
- |m mthd mSel contractedSelector item l methods allMessagesSent|
-
- m := Menu new.
-
- mthd := self theSingleSelectedMethod.
- (mthd notNil and:[ (mSel := mthd selector) notNil]) ifTrue:[
- contractedSelector := mSel contractTo:80.
-
- item := MenuItem label:(' ' , contractedSelector , ' '). "/ ' ' is a kludge - to allow '-' selector
- item itemValue:actionSelector argument:mSel.
- m addItem:item.
-
-"/ true "withInstanceProtocolOnly" ifTrue:[
-"/ item := MenuItem label:(resources string:' %1 - Instance Protocol Only' with:contractedSelector).
-"/ item value:actionSelector.
-"/ item argument:(#instanceProtocolOnly -> mSel).
-"/ m addItem:item.
-"/ ].
-"/ true "withClassProtocolOnly" ifTrue:[
-"/ item := MenuItem label:(resources string:' %1 - Class Protocol Only' with:contractedSelector).
-"/ item value:actionSelector.
-"/ item argument:(#classProtocolOnly -> mSel).
-"/ m addItem:item.
-"/ ].
-
- (withLocalSenders or:[ withSenderChain or:[ withLocalImplementors or:[ withImplementorChain]]]) ifTrue:[
- m addSeparator.
- ].
-
- 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.
- ].
- 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.
- ].
- (withCallersOfThisMethod and:[mthd isInstrumented]) ifTrue:[
- item := MenuItem label:(resources string:'Callers of this %1' with:contractedSelector).
- item itemValue:#spawnCallersBuffer.
- m addItem:item.
- ].
-
- withLocalImplementors ifTrue:[
- item := MenuItem label:(resources string:'Local Implementors of %1' with:contractedSelector).
- item itemValue:#spawnLocalImplementorsBuffer.
- m addItem:item.
- ].
- withImplementorChain ifTrue:[
- item := MenuItem label:(resources string:'Implementor Chain of %1' with:contractedSelector).
- item itemValue:#spawnImplementorChainBuffer.
- m addItem:item.
- ].
- withMethodsCalledByThisMethod ifTrue:[
- item := MenuItem label:(resources string:'Methods Called by %1' with:contractedSelector).
- item itemValue:#spawnMethodsCalledByBuffer.
- m addItem:item.
- ].
-
- selfSendsOnly ifTrue:[
- l := mthd messagesSentToSelf.
- ] ifFalse:[
- l := mthd messagesSent asArray.
- l := l , (mthd messagesPossiblySent asArray collect:[:each | each colorizeAllWith:Color darkGrey]).
- ].
- l size > 0 ifTrue:[
- l := l asSortedCollection.
- m addSeparator.
-
-"
- (l size > 30) ifTrue:[
- l removeAllFoundIn:#(ifTrue: ifFalse: ifTrue:ifFalse: ifFalse:ifTrue:
- whileTrue: whileFalse:
- isNil notNil
- and: or:
- ).
- (l size > 30) ifTrue:[
- l removeAllFoundIn:#(#'==' #'~~' class
- ).
- ]
- ].
- (cut := l size > 30) ifTrue:[
- l := l copyTo:30
- ].
-"
- l do:[:eachMessage |
- item := MenuItem label:(' ' , (eachMessage contractTo:100), ' '). "/ ' ' is a kludge - to allow '-' selector
- item itemValue:actionSelector argument:eachMessage string asSymbol.
- m addItem:item.
- ].
-
-"
- cut ifTrue:[
- m addItem:(MenuItem label:'-').
- m addItem:(MenuItem label:'<< more items ignored >>').
- ]
-"
- ]
- ] ifFalse:[
- 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].
- ].
- ].
- 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).
- ].
- ].
-
- allMessagesSent := allMessagesSent asSortedCollection.
- allMessagesSent size > 0 ifTrue:[
- m addSeparator.
- allMessagesSent do:[:eachMessage |
- item := MenuItem label:(' ' , (eachMessage contractTo:100), ' '). "/ ' ' is a kludge - to allow '-' selector
- item itemValue:actionSelector argument:eachMessage asSymbol.
- m addItem:item.
- ].
- ].
- ].
-
- ^ m
-
- "Created: / 27-04-2010 / 15:05:52 / cg"
- "Modified: / 09-09-2012 / 13:20:43 / cg"
+ ^ self
+ messagesMenuFor:actionSelector
+ withCurrentSelector:true
+ withSenderChain:withSenderChain withImplementorChain:withImplementorChain
+ withLocalSenders:withLocalSenders withLocalImplementors:withLocalImplementors
+ withCallersOfThisMethod:withCallersOfThisMethod withMethodsCalledByThisMethod:withMethodsCalledByThisMethod
+ selfSendsOnly:selfSendsOnly
!
operationsMenu
@@ -49955,67 +50060,67 @@
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
].
(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.
@@ -50023,34 +50128,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.
@@ -50061,9 +50166,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:[
@@ -50072,75 +50177,77 @@
"/ ]
"/ ].
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 string = mthd category]) ifFalse:[
- self selectProtocols:(OrderedCollection with:mthd category).
- ].
- self switchToMethod:mthd.
- ] ifFalse:[
- self switchToSelector:aSelector.
+ (self selectedProtocolsValue contains:[:cat | 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.
+
+ "/ self selectedMethods value:nil.
self enqueueDelayedClassSelectionChange.
"Created: / 22-02-2008 / 09:05:51 / janfrog"
@@ -51764,14 +51871,14 @@
setup an enterBox with text from codeView or selected
method for browsing based on a selector. Set action and launch box.
SearchArea may be one of
- #everywhere,
- #currentNameSpace
- #currentClassesNameSpace
- #classCategories
- #classes
- #classesWithPrivateClasses
- #classHierarchies
- #classHierarchiesWithPrivateClasses
+ #everywhere,
+ #currentNameSpace
+ #currentClassesNameSpace
+ #classCategories
+ #classes
+ #classesWithPrivateClasses
+ #classHierarchies
+ #classHierarchiesWithPrivateClasses
aSelectorOrBlock is either a search selector (to be sent to SystemBrowser, such as findMethods:...)
or a block, or a pair containing class- and methodlist search selectors.
@@ -51782,189 +51889,202 @@
|restart dialog|
dialog := SearchDialog new
- showMetaFilter:true;
- setupToAskForMethodSearchTitle:title
- forBrowser:self
- searchWhat:searchWhat
- searchArea:whereDefault
- withCaseIgnore:withCaseIgnore
- withMatch:withMatch
- withMethodList:withMethodList
- allowFind:(self navigationState isMethodBrowser)
- allowBuffer:true
- allowBrowser:true
- withTextEntry:withTextEntry.
+ showMetaFilter:true;
+ setupToAskForMethodSearchTitle:title
+ forBrowser:self
+ searchWhat:searchWhat
+ searchArea:whereDefault
+ withCaseIgnore:withCaseIgnore
+ withMatch:withMatch
+ withMethodList:withMethodList
+ allowFind:(self navigationState isMethodBrowser)
+ allowBuffer:true
+ allowBrowser:true
+ withTextEntry:withTextEntry.
restart := Signal new.
restart
- handle:[:ex |
- ex restart
- ]
- do:[
- dialog askThenDo:[
- |classes string ignoreCase openHow match methods isMethod searchAction|
-
- classes := dialog classesToSearch.
- string := dialog selectorToSearch.
- ignoreCase := dialog searchIgnoringCase.
- openHow := dialog openHow.
- match := dialog searchWithMatch.
- methods := dialog methodsToSearch.
- isMethod := dialog matchMethods.
-
- self withSearchCursorDo:[
- |initialList list newBrowser numFound label selector entities arguments numArgs answer
- alternativeSelector question altArguments t|
-
- aSelectorOrBlock isArray ifTrue:[
- classes notNil ifTrue:[
- selector := aSelectorOrBlock first.
- entities := classes.
- ] ifFalse:[
- selector := aSelectorOrBlock second.
- entities := methods.
- ].
- numArgs := selector numArgs.
- ] ifFalse:[
- entities := classes.
- aSelectorOrBlock isSymbol ifTrue:[
- selector := aSelectorOrBlock.
- ] ifFalse:[
- selector := nil
- ].
- numArgs := aSelectorOrBlock numArgs.
- ].
- (selector notNil
- and:[ (selector numArgs == 1)
- and:[ (selector endsWith:'In:') or:[ selector endsWith:'inMethods:' ]]]) ifTrue:[
- arguments := Array with:entities
- ] ifFalse:[
- arguments := (Array
- with:string
- with:entities
- with:((selector notNil and:[selector endsWith:'isMethod:']) ifTrue:[isMethod] ifFalse:[ignoreCase])
- with:match
- ) copyTo:numArgs.
- ].
-
- searchAction :=
- [
- |result|
-
- selector notNil ifTrue:[
- result := self class perform:selector withArguments:arguments.
- ] ifFalse:[
- result := aSelectorOrBlock valueWithArguments:arguments
- ].
- dialog metaclassesOnly ifTrue:[
- result := result select:[:m | m mclass isMeta]
- ] ifFalse:[
- dialog classesOnly ifTrue:[
- result := result select:[:m | m mclass isMeta not]
- ].
- ].
- result
- ].
-
- t := TimeDuration toRun:
- [
- false "classes size > 1" ifTrue:[
- self
- showMessage:'Searching...'
- while:[
- initialList := searchAction value.
- ]
- ] ifFalse:[
- initialList := searchAction value.
- ].
- ].
-
- label := labelHolderOrBlock value.
-
- numFound := initialList size.
- numFound == 0 ifTrue:[
- question := resources stringWithCRs:label with:((string ? '') allBold colorizeAllWith:Color red darkened).
- question := question , (resources string:' - none found.').
-
- ((selector == #findImplementors:in:ignoreCase:match:)
- and:[ (arguments first numArgs == 0)
- and:[
- string := ((arguments at:1),':') asSymbol.
- altArguments := arguments copy.
- altArguments at:1 put:string.
- initialList := self class perform:selector withArguments:altArguments.
- numFound := initialList size.
- numFound ~~ 0
- ]]) ifTrue:[
- question := question,(resources stringWithCRs:'\\But there are %1 implementations of %2 (with colon).\Browse those ?' with:numFound with:(altArguments first)).
- answer := Dialog
- confirmWithCancel:question
- labels:(resources array:#('Cancel' 'Search Again' 'Yes'))
- default:2.
-
- answer isNil ifTrue:[
- ^ self
- ].
- answer ifFalse:[
- restart raiseRequest
- ].
- arguments := altArguments.
-
- ] ifFalse:[
- answer := Dialog
- confirm:question
- yesLabel:(resources string:'Search Again')
- noLabel:(resources string:'Cancel').
- answer ifFalse:[
- ^ self
- ].
- restart raiseRequest
- ].
- ].
-
- (initialList asSet = self selectedMethodsValue asSet)
- "/ (numFound == 1 and:[initialList first == self theSingleSelectedMethod])
- ifTrue:[
- answer := Dialog
- confirmWithCancel:((resources stringWithCRs:label with:(string ? 'messages') allBold)
- , '.\\' withCRs
- , (resources stringWithCRs:'Only the selected method(s) found.\Browse anyway ?'))
- labels:(resources array:#('Cancel' 'Search Again' 'Yes' ))
- values:#(nil #again true)
- default:2.
-
- answer == nil ifTrue:[
- ^ self
- ].
- answer == #again ifTrue:[
- restart raiseRequest
- ]
- ].
-
- newBrowser := self
- spawnMethodBrowserForSearch:[
- initialList notNil ifTrue:[
- list := initialList.
- initialList := nil
- ] ifFalse:[
- list := searchAction value
- ].
- list
- ]
- sortBy:#class
- in:openHow
- label:(resources string:label string with:string).
-
- setSearchPatternAction notNil ifTrue:[
- setSearchPatternAction value:newBrowser value:string value:((selector notNil and:[selector endsWith:'isMethod:']) ifTrue:[isMethod] ifFalse:[ignoreCase]) value:match.
- ].
- t > 5 seconds ifTrue:[
- newBrowser methodListApp autoUpdateOnChange: false.
- ].
- ^ newBrowser.
- ].
- ].
- ].
+ handle:[:ex |
+ ex restart
+ ]
+ do:[
+ dialog askThenDo:[
+ |classes string ignoreCase openHow match methods isMethod searchAction|
+
+ classes := dialog classesToSearch.
+ string := dialog selectorToSearch.
+ ignoreCase := dialog searchIgnoringCase.
+ openHow := dialog openHow.
+ match := dialog searchWithMatch.
+ methods := dialog methodsToSearch.
+ isMethod := dialog matchMethods.
+
+ self withSearchCursorDo:[
+ |initialList list newBrowser numFound label
+ selector entities arguments numArgs answer
+ alternativeSelector question altArguments t|
+
+ aSelectorOrBlock isArray ifTrue:[
+ classes notNil ifTrue:[
+ selector := aSelectorOrBlock first.
+ entities := classes.
+ ] ifFalse:[
+ selector := aSelectorOrBlock second.
+ entities := methods.
+ ].
+ numArgs := selector numArgs.
+ ] ifFalse:[
+ entities := classes.
+ aSelectorOrBlock isSymbol ifTrue:[
+ selector := aSelectorOrBlock.
+ ] ifFalse:[
+ selector := nil
+ ].
+ numArgs := aSelectorOrBlock numArgs.
+ ].
+ (selector notNil
+ and:[ (selector numArgs == 1)
+ and:[ (selector endsWith:'In:') or:[ selector endsWith:'inMethods:' ]]]) ifTrue:[
+ arguments := Array with:entities
+ ] ifFalse:[
+ arguments := (Array
+ with:string
+ with:entities
+ with:((selector notNil and:[selector endsWith:'isMethod:']) ifTrue:[isMethod] ifFalse:[ignoreCase])
+ with:match
+ ) copyTo:numArgs.
+ ].
+
+ searchAction :=
+ [
+ |result moreResults extensionMethods arguments2|
+
+ selector notNil ifTrue:[
+ result := self class perform:selector withArguments:arguments.
+ ] ifFalse:[
+ result := aSelectorOrBlock valueWithArguments:arguments
+ ].
+ "/ sorry for this special case: when searching in a package,
+ "/ also search extensionMethods
+ dialog searchAreaSelected == #currentPackage ifTrue:[
+ aSelectorOrBlock isArray ifTrue:[
+ "/ findSendersOf:inMethods:ignoreCase:match:
+ extensionMethods := Smalltalk allExtensionsForPackage:(dialog currentPackage).
+ arguments2 := arguments copy.
+ arguments2 at:2 put:extensionMethods.
+ moreResults := self class perform:(aSelectorOrBlock at:2) withArguments:arguments2.
+ result := result , moreResults.
+ ]
+ ].
+ dialog metaclassesOnly ifTrue:[
+ result := result select:[:m | m mclass isMeta]
+ ] ifFalse:[
+ dialog classesOnly ifTrue:[
+ result := result select:[:m | m mclass isMeta not]
+ ].
+ ].
+ result
+ ].
+
+ t := TimeDuration toRun:
+ [
+ false "classes size > 1" ifTrue:[
+ self
+ showMessage:'Searching...'
+ while:[
+ initialList := searchAction value.
+ ]
+ ] ifFalse:[
+ initialList := searchAction value.
+ ].
+ ].
+
+ label := labelHolderOrBlock value.
+
+ numFound := initialList size.
+ numFound == 0 ifTrue:[
+ question := resources stringWithCRs:label with:((string ? '') allBold colorizeAllWith:Color red darkened).
+ question := question , (resources string:' - none found.').
+
+ ((selector == #findImplementors:in:ignoreCase:match:)
+ and:[ (arguments first numArgs == 0)
+ and:[
+ string := ((arguments at:1),':') asSymbol.
+ altArguments := arguments copy.
+ altArguments at:1 put:string.
+ initialList := self class perform:selector withArguments:altArguments.
+ numFound := initialList size.
+ numFound ~~ 0
+ ]]) ifTrue:[
+ question := question,(resources stringWithCRs:'\\But there are %1 implementations of %2 (with colon).\Browse those ?' with:numFound with:(altArguments first)).
+ answer := Dialog
+ confirmWithCancel:question
+ labels:(resources array:#('Cancel' 'Search Again' 'Yes'))
+ default:2.
+
+ answer isNil ifTrue:[
+ ^ self
+ ].
+ answer ifFalse:[
+ restart raiseRequest
+ ].
+ arguments := altArguments.
+
+ ] ifFalse:[
+ answer := Dialog
+ confirm:question
+ yesLabel:(resources string:'Search Again')
+ noLabel:(resources string:'Cancel').
+ answer ifFalse:[
+ ^ self
+ ].
+ restart raiseRequest
+ ].
+ ].
+
+ (initialList asSet = self selectedMethodsValue asSet)
+ "/ (numFound == 1 and:[initialList first == self theSingleSelectedMethod])
+ ifTrue:[
+ answer := Dialog
+ confirmWithCancel:((resources stringWithCRs:label with:(string ? 'messages') allBold)
+ , '.\\' withCRs
+ , (resources stringWithCRs:'Only the selected method(s) found.\Browse anyway ?'))
+ labels:(resources array:#('Cancel' 'Search Again' 'Yes' ))
+ values:#(nil #again true)
+ default:2.
+
+ answer == nil ifTrue:[
+ ^ self
+ ].
+ answer == #again ifTrue:[
+ restart raiseRequest
+ ]
+ ].
+
+ newBrowser := self
+ spawnMethodBrowserForSearch:[
+ initialList notNil ifTrue:[
+ list := initialList.
+ initialList := nil
+ ] ifFalse:[
+ list := searchAction value
+ ].
+ list
+ ]
+ sortBy:#class
+ in:openHow
+ label:(resources string:label string with:string).
+
+ setSearchPatternAction notNil ifTrue:[
+ setSearchPatternAction value:newBrowser value:string value:((selector notNil and:[selector endsWith:'isMethod:']) ifTrue:[isMethod] ifFalse:[ignoreCase]) value:match.
+ ].
+ t > 5 seconds ifTrue:[
+ newBrowser methodListApp autoUpdateOnChange: false.
+ ].
+ ^ newBrowser.
+ ].
+ ].
+ ].
"Modified: / 20-08-2012 / 13:26:06 / cg"
!
@@ -58798,11 +58918,11 @@
!NewSystemBrowser class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1838 2013-03-10 21:41:42 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1843 2013-03-21 18:58:38 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1838 2013-03-10 21:41:42 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1843 2013-03-21 18:58:38 cg Exp $'
!
version_HG
--- a/Tools__TestRunner2.st Fri Mar 15 10:14:37 2013 +0000
+++ b/Tools__TestRunner2.st Fri Mar 22 09:21:23 2013 +0000
@@ -1314,6 +1314,7 @@
browser recompileClassWithInstrumentation:eachClass
].
+ browser infoLabelHolder value:nil.
self withWaitCursorDo:[
InstrumentationContext runForCoverage:[
result := self runSuite: self selectedTestSuite.
@@ -1844,7 +1845,7 @@
!TestRunner2::ClassList class methodsFor:'documentation'!
version
- ^'$Header: /cvs/stx/stx/libtool/Tools__TestRunner2.st,v 1.35 2013-03-08 22:40:52 stefan Exp $'
+ ^'$Header: /cvs/stx/stx/libtool/Tools__TestRunner2.st,v 1.36 2013-03-13 13:14:03 cg Exp $'
! !
!TestRunner2::ClassList methodsFor:'private'!
@@ -2341,11 +2342,11 @@
!TestRunner2 class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools__TestRunner2.st,v 1.35 2013-03-08 22:40:52 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__TestRunner2.st,v 1.36 2013-03-13 13:14:03 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools__TestRunner2.st,v 1.35 2013-03-08 22:40:52 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__TestRunner2.st,v 1.36 2013-03-13 13:14:03 cg Exp $'
!
version_HG
--- a/WorkspaceApplication.st Fri Mar 15 10:14:37 2013 +0000
+++ b/WorkspaceApplication.st Fri Mar 22 09:21:23 2013 +0000
@@ -110,6 +110,15 @@
^ super flyByHelpSpec addPairsFrom:#(
+#editCopy
+'Copy the selected text to the clipboard'
+
+#editCut
+'Cut the selected text to the clipboard'
+
+#editDelete
+'Delete the selected text'
+
#addTerminal
'Add a tab with an embedded console-terminal'
@@ -4096,11 +4105,11 @@
!WorkspaceApplication class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/WorkspaceApplication.st,v 1.237 2013-02-06 16:36:40 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/WorkspaceApplication.st,v 1.238 2013-03-19 12:12:14 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/WorkspaceApplication.st,v 1.237 2013-02-06 16:36:40 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/WorkspaceApplication.st,v 1.238 2013-03-19 12:12:14 cg Exp $'
!
version_HG
--- a/lcmake.bat Fri Mar 15 10:14:37 2013 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,8 +0,0 @@
-@REM -------
-@REM make using lcc compiler
-@REM type lcmake, and wait...
-@REM do not edit - automatically generated from ProjectDefinition
-@REM -------
-make.exe -N -f bc.mak USELCC=1 %1 %2
-
-
--- a/resources/de.rs Fri Mar 15 10:14:37 2013 +0000
+++ b/resources/de.rs Fri Mar 22 09:21:23 2013 +0000
@@ -1,6 +1,6 @@
#encoding utf8
-; $Header: /cvs/stx/stx/libtool/resources/de.rs,v 1.206 2013-02-23 12:16:49 cg Exp $
+; $Header: /cvs/stx/stx/libtool/resources/de.rs,v 1.211 2013-03-20 20:30:55 cg Exp $
;
; German Workspace (and other tools) resources
;
@@ -117,10 +117,9 @@
'Insert new UUID' 'Neue UUID einfgen'
'AutoIndent' 'Automatisch einrcken'
-'Hide Toolbar. Show again via the "View"-Menu' 'Werkzeugleiste ausblenden. Wiederherstellen ber das "Ansicht"-Menu'
-; 'Hide Editor-Toolbar. Show again via the "View"-Menu' 'Editor-Werkzeugleiste ausblenden. Wiederherstellen ber das "Ansicht"-Menu'
-'Hide Edit-Toolbar. Show again via the "View"-Menu' 'Editor-Werkzeugleiste ausblenden. Wiederherstellen ber das "Ansicht"-Menu'
-'Hide Bookmarkbar. Show again via the "View"-Menu' 'Lesezeichenleiste ausblenden. Wiederherstellen ber das "Ansicht"-Menu'
+'Hide the toolbar. Show again via the "View"-menu' 'Werkzeugleiste ausblenden. Wiederherstellen ber das "Ansicht"-Menu'
+'Hide the edit-toolbar. Show again via the "View"-menu' 'Editor-Werkzeugleiste ausblenden. Wiederherstellen ber das "Ansicht"-Menu'
+'Hide the bookmark-bar. Show again via the "View"-menu' 'Lesezeichenleiste ausblenden. Wiederherstellen ber das "Ansicht"-Menu'
;--------------------------------------------------------------------------------------------
;
@@ -2514,6 +2513,7 @@
'Columns in Filelist' 'Spalten in der Dateiliste'
'Search Files Named' 'Dateien mit Name'
+'But not Named' 'Aber nicht'
'Containing' 'Mit Inhalt'
'Not Containing' 'Ohne Inhalt'
'Same Contents As' 'Gleicher Inhalt wie'
@@ -2560,6 +2560,8 @@
'Autoselect in Browser' 'Im Browser automatisch auswhlen'
'Delete all Files' 'Alle Dateien lschen'
'Delete Selected Files' 'Ausgewhlte Dateien lschen'
+'Delete Selected File(s)' 'Ausgewhlte Datei(en) lschen'
+'Delete Selected File(s) and CVS Container(s)' 'Ausgewhlte Datei(en) und CVS Container lschen'
'Remove Selected from Resultlist' 'Ausgewhlte von der Resultatliste nehmen'
'Clear Resultlist' 'Resultatliste lschen'
'Show Matched Files (After SameContents-Search)' 'Gefundene Originale zeigen (Nach Gleicher-Inhaltsuche)'
--- a/stx_libtool.st Fri Mar 15 10:14:37 2013 +0000
+++ b/stx_libtool.st Fri Mar 22 09:21:23 2013 +0000
@@ -70,6 +70,11 @@
#'stx:goodies/communication' "SmalltalkShareClient - referenced by AbstractLauncherApplication>>remoteImageBrowserAvailable "
#'stx:goodies/monticello' "MCInteractiveLoadingQuery - referenced by Tools::ChangeSetBrowser2>>changeMenuApplyChange: "
#'stx:goodies/rdoit' "RDoItServer - referenced by AbstractLauncherApplication::LauncherDialogs class>>communicationsSettings "
+ #'stx:goodies/refactoryBrowser/browser' "CategoryEnvironment - referenced by Tools::NewSystemBrowser>>selectedCategoriesAsEnvironment "
+ #'stx:goodies/refactoryBrowser/changes' "RefactoryChangeManager - referenced by Tools::NewSystemBrowser>>hasUndoableOperations "
+ #'stx:goodies/refactoryBrowser/helpers' "BrowserEnvironment - referenced by Tools::NewSystemBrowser>>selectedSelectorsAsEnvironment "
+ #'stx:goodies/refactoryBrowser/lint' "SmalllintChecker - referenced by Tools::NewSystemBrowser>>smalllintRunRule:onEnvironment: "
+ #'stx:goodies/refactoryBrowser/refactoring' "InlineMethodRefactoring - referenced by Tools::NewSystemBrowser>>codeMenuInlineMessage "
#'stx:goodies/sif' "SmalltalkInterchangeSTXFileOutManager - referenced by Tools::NewSystemBrowser>>projectMenuFileOutAsWithFormat: "
#'stx:goodies/simpleServices' "STXScriptingServer - referenced by AbstractSettingsApplication::RDoItServerSettingsAppl>>scriptingServerPortOrPath "
#'stx:goodies/soap' "SOAP::SoapHttpModule - referenced by AbstractLauncherApplication::LauncherDialogs class>>communicationsSettings "
@@ -151,11 +156,6 @@
exclude individual packages in the #excludedFromPreRequisites method."
^ #(
- #'stx:goodies/refactoryBrowser/browser' "CategoryEnvironment - referenced by Tools::NewSystemBrowser>>selectedCategoriesAsEnvironment "
- #'stx:goodies/refactoryBrowser/changes' "RefactoryChangeManager - referenced by Tools::NewSystemBrowser>>hasUndoableOperations "
- #'stx:goodies/refactoryBrowser/helpers' "BrowserEnvironment - referenced by Tools::NewSystemBrowser>>selectedSelectorsAsEnvironment "
- #'stx:goodies/refactoryBrowser/lint' "SmalllintChecker - referenced by Tools::NewSystemBrowser>>smalllintRunRule:onEnvironment: "
- #'stx:goodies/refactoryBrowser/refactoring' "InlineMethodRefactoring - referenced by Tools::NewSystemBrowser>>codeMenuInlineMessage "
#'stx:libwidg3' "ClockView - referenced by WorkspaceApplication>>addStopWatch "
)
! !
@@ -579,12 +579,7 @@
"Modified: / 18-07-2012 / 19:11:53 / cg"
!
-productInstallDirBaseName
- "Returns a default installDir which will appear in <app>.nsi.
- This is usually not the one you want to keep"
- ^ (self package asCollectionOfSubstringsSeparatedByAny:':/') last
-!
productName
"Return a product name which will appear in <lib>.rc"
@@ -615,11 +610,11 @@
!stx_libtool class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/stx_libtool.st,v 1.88 2013-03-08 23:52:23 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/stx_libtool.st,v 1.90 2013-03-18 13:57:34 stefan Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/stx_libtool.st,v 1.88 2013-03-08 23:52:23 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/stx_libtool.st,v 1.90 2013-03-18 13:57:34 stefan Exp $'
!
version_HG