[Pkg] The Trunk: Tools-bf.531.mcz
commits at source.squeak.org
commits at source.squeak.org
Mon Dec 8 01:13:54 UTC 2014
Bert Freudenberg uploaded a new version of Tools to project The Trunk:
http://source.squeak.org/trunk/Tools-bf.531.mcz
==================== Summary ====================
Name: Tools-bf.531
Author: bf
Time: 8 December 2014, 2:13:00.471 am
UUID: ebd4d50d-4200-4361-b1b1-f1eb44a30a7d
Ancestors: Tools-eem.530
Restore timestamps lost in assignment conversion.
=============== Diff against Tools-eem.530 ===============
Item was changed:
----- Method: ArchiveViewer class>>deleteTemporaryDirectory (in category 'class initialization') -----
deleteTemporaryDirectory
"
ArchiveViewer deleteTemporaryDirectory
"
| dir |
(dir := self temporaryDirectory) exists ifTrue: [ dir recursiveDelete ].!
Item was changed:
----- Method: ArchiveViewer class>>fileReaderServicesForFile:suffix: (in category 'fileIn/Out') -----
fileReaderServicesForFile: fullName suffix: suffix
| services |
services := OrderedCollection new.
services add: self serviceAddToNewZip.
({'zip'.'sar'.'pr'. 'mcz'. '*'} includes: suffix)
ifTrue: [services add: self serviceOpenInZipViewer.
services add: self serviceExtractAll].
^ services!
Item was changed:
----- Method: ArchiveViewer class>>openOn: (in category 'instance creation') -----
openOn: aFileName
| newMe |
newMe := self new.
newMe createWindow; fileName: aFileName; openInWorld.
^newMe!
Item was changed:
----- Method: ArchiveViewer class>>services (in category 'fileIn/Out') -----
services
^ Array
with: self serviceAddToNewZip
with: self serviceOpenInZipViewer
!
Item was changed:
----- Method: ArchiveViewer>>addDirectory (in category 'member operations') -----
addDirectory
| directory |
self canAddMember ifFalse: [ ^self ].
directory := FileList2 modalFolderSelector.
directory
ifNil: [^ self].
archive addTree: directory removingFirstCharacters: directory pathName size + 1.
self memberIndex: 0.
self changed: #memberList.!
Item was changed:
----- Method: ArchiveViewer>>archive: (in category 'initialization') -----
archive: aZipArchive
archive := aZipArchive.
self model: aZipArchive.
self setLabel: 'New Zip Archive'.
self memberIndex: 0.
self changed: #memberList!
Item was changed:
----- Method: ArchiveViewer>>briefContents (in category 'initialization') -----
briefContents
"Trim to 5000 characters. If the member is longer, then point out that it is trimmed.
Also warn if the member has a corrupt CRC-32."
| stream subContents errorMessage |
self selectedMember ifNil: [^ ''].
errorMessage := ''.
stream := WriteStream on: (String new: (self selectedMember uncompressedSize min: 5500)).
[ self selectedMember uncompressedSize > 5000
ifTrue: [ | lastLineEndingIndex tempIndex |
subContents := self selectedMember contentsFrom: 1 to: 5000.
lastLineEndingIndex := subContents lastIndexOf: Character cr.
tempIndex := subContents lastIndexOf: Character lf.
tempIndex > lastLineEndingIndex ifTrue: [lastLineEndingIndex := tempIndex].
lastLineEndingIndex = 0
ifFalse: [subContents := subContents copyFrom: 1 to: lastLineEndingIndex]]
ifFalse: [ subContents := self selectedMember contents ]]
on: CRCError do: [ :ex |
errorMessage := String streamContents: [ :s |
s nextPutAll: '[ ';
nextPutAll: (ex messageText copyUpToLast: $( );
nextPutAll: ' ]' ].
ex proceed ].
(errorMessage isEmpty not or: [ self selectedMember isCorrupt ]) ifTrue: [
stream nextPutAll: '********** WARNING!! Member is corrupt!! ';
nextPutAll: errorMessage;
nextPutAll: ' **********'; cr ].
self selectedMember uncompressedSize > 5000
ifTrue: [
stream nextPutAll: 'File ';
print: self selectedMember fileName;
nextPutAll: ' is ';
print: self selectedMember uncompressedSize;
nextPutAll: ' bytes long.'; cr;
nextPutAll: 'Click the ''View All Contents'' button above to see the entire file.'; cr; cr;
nextPutAll: 'Here are the first ';
print: subContents size;
nextPutAll: ' characters...'; cr;
next: 40 put: $-; cr;
nextPutAll: subContents;
next: 40 put: $-; cr;
nextPutAll: '... end of the first ';
print: subContents size;
nextPutAll: ' characters.' ]
ifFalse: [ stream nextPutAll: self selectedMember contents ].
^stream contents
!
Item was changed:
----- Method: ArchiveViewer>>buildWindowMenu (in category 'menu') -----
buildWindowMenu
| menu |
menu := super buildWindowMenu.
menu addLine.
menu add: 'inspect archive' target: archive action: #inspect.
menu add: 'write prepending file...' target: self action: #writePrependingFile.
^menu.!
Item was changed:
----- Method: ArchiveViewer>>contents (in category 'initialization') -----
contents
| contents errorMessage |
self selectedMember ifNil: [^ ''].
viewAllContents ifFalse: [^ self briefContents].
[ contents := self selectedMember contents ]
on: CRCError
do: [ :ex | errorMessage := String streamContents: [ :stream |
stream nextPutAll: '********** WARNING!! Member is corrupt!! [ ';
nextPutAll: (ex messageText copyUpToLast: $( );
nextPutAll: '] **********'; cr ].
ex proceed ].
^self selectedMember isCorrupt
ifFalse: [ contents ]
ifTrue: [ errorMessage, contents ]!
Item was changed:
----- Method: ArchiveViewer>>createNewArchive (in category 'archive operations') -----
createNewArchive
self setLabel: '(new archive)'.
archive := ZipArchive new.
self memberIndex: 0.
self changed: #memberList.!
Item was changed:
----- Method: ArchiveViewer>>extractMember (in category 'member operations') -----
extractMember
"Extract the member after prompting for a filename.
Answer the filename, or nil if error."
| result name |
self canExtractMember ifFalse: [ ^nil ].
result := StandardFileMenu newFile.
result ifNil: [ ^nil ].
name := (result directory fullNameFor: result name).
(archive canWriteToFileNamed: name)
ifFalse: [ self inform: name, ' is used by one or more members
in your archive, and cannot be overwritten.
Try extracting to another file name'.
^nil ].
self selectedMember extractToFileNamed: name.
^name!
Item was changed:
----- Method: ArchiveViewer>>fileName: (in category 'initialization') -----
fileName: aString
archive := ZipArchive new readFrom: aString.
self setLabel: aString.
self memberIndex: 0.
self changed: #memberList!
Item was changed:
----- Method: ArchiveViewer>>fullName (in category 'accessing') -----
fullName
"For compatibility with FileList services.
If this is called, it means that a service that requires a real filename has been requested.
So extract the selected member to a temporary file and return that name."
| fullName dir |
self canExtractMember ifFalse: [ ^nil ].
dir := FileDirectory default directoryNamed: '.archiveViewerTemp'.
fullName := dir fullNameFor: self selectedMember localFileName.
self selectedMember extractInDirectory: dir.
^fullName!
Item was changed:
----- Method: ArchiveViewer>>initialize (in category 'initialization') -----
initialize
super initialize.
memberIndex := 0.
viewAllContents := false.
!
Item was changed:
----- Method: ArchiveViewer>>memberIndex: (in category 'member list') -----
memberIndex: n
memberIndex := n.
viewAllContents := false.
self changed: #memberIndex.
self changed: #contents.!
Item was changed:
----- Method: ArchiveViewer>>stream: (in category 'initialization') -----
stream: aStream
archive := ZipArchive new readFrom: aStream.
self setLabel: aStream fullName.
self memberIndex: 0.
self changed: #memberList!
Item was changed:
----- Method: ArchiveViewer>>writePrependingFile (in category 'archive operations') -----
writePrependingFile
| result name prependedName |
self canSaveArchive ifFalse: [ ^self ].
result := (StandardFileMenu newFileMenu: FileDirectory default)
startUpWithCaption: 'Destination Zip File Name:'.
result ifNil: [ ^self ].
name := result directory fullNameFor: result name.
(archive canWriteToFileNamed: name)
ifFalse: [ self inform: name, ' is used by one or more members
in your archive, and cannot be overwritten.
Try writing to another file name'.
^self ].
result := (StandardFileMenu oldFileMenu: FileDirectory default)
startUpWithCaption: 'Prepended File:'.
result ifNil: [ ^self ].
prependedName := result directory fullNameFor: result name.
[ archive writeToFileNamed: name prependingFileNamed: prependedName ]
on: Error
do: [ :ex | self inform: ex description. ].
self changed: #memberList "in case CRC's and compressed sizes got set"!
Item was changed:
----- Method: BasicInspector>>inspect: (in category 'as yet unclassified') -----
inspect: anObject
"Initialize the receiver so that it is inspecting anObject. There is no
current selection."
self initialize.
object := anObject.
selectionIndex := 0.
contents := ''!
Item was changed:
----- Method: Browser class>>fullOnClass: (in category 'instance creation') -----
fullOnClass: aClass
"Open a new full browser set to class."
| brow |
brow := self new.
brow setClass: aClass selector: nil.
^ self
openBrowserView: (brow openEditString: nil)
label: 'System Browser'!
Item was changed:
----- Method: Browser class>>fullOnClass:selector: (in category 'instance creation') -----
fullOnClass: aClass selector: aSelector
"Open a new full browser set to class."
| brow classToUse |
classToUse := SystemBrowser default.
brow := classToUse new.
brow setClass: aClass selector: aSelector.
^ classToUse
openBrowserView: (brow openEditString: nil)
label: brow labelString!
Item was changed:
----- Method: Browser class>>newOnClass:label: (in category 'instance creation') -----
newOnClass: aClass label: aLabel
"Open a new class browser on this class."
| newBrowser |
newBrowser := self new.
newBrowser setClass: aClass selector: nil.
^ self
openBrowserView: (newBrowser openOnClassWithEditString: nil)
label: aLabel
!
Item was changed:
----- Method: Browser class>>newOnClass:selector: (in category 'instance creation') -----
newOnClass: aClass selector: aSymbol
"Open a new class browser on this class."
| newBrowser |
newBrowser := self new.
newBrowser setClass: aClass selector: aSymbol.
^ self
openBrowserView: (newBrowser openOnClassWithEditString: nil)
label: 'Class Browser: ', aClass name
!
Item was changed:
----- Method: Browser>>browseAllClasses (in category 'system category functions') -----
browseAllClasses
"Create and schedule a new browser on all classes alphabetically."
| newBrowser |
newBrowser := HierarchyBrowser new initAlphabeticListing.
self class openBrowserView: (newBrowser openSystemCatEditString: nil)
label: 'All Classes Alphabetically'!
Item was changed:
----- Method: Browser>>categorizeAllUncategorizedMethods (in category 'message category list') -----
categorizeAllUncategorizedMethods
"Categorize methods by looking in parent classes for a method category."
| organizer organizers |
organizer := self classOrMetaClassOrganizer.
organizers := self selectedClassOrMetaClass withAllSuperclasses collect: [:ea | ea organization].
(organizer listAtCategoryNamed: ClassOrganizer default) do: [:sel | | found |
found := (organizers collect: [ :org | org categoryOfElement: sel])
detect: [:ea | ea ~= ClassOrganizer default and: [ ea ~= nil]]
ifNone: [].
found ifNotNil: [organizer classify: sel under: found]].
self changed: #messageCategoryList!
Item was changed:
----- Method: Browser>>categoryOfCurrentMethod (in category 'message category functions') -----
categoryOfCurrentMethod
"Determine the method category associated with the receiver at the current moment, or nil if none"
| aCategory |
^ super categoryOfCurrentMethod ifNil:
[(aCategory := self messageCategoryListSelection) == ClassOrganizer allCategory
ifTrue:
[nil]
ifFalse:
[aCategory]]!
Item was changed:
----- Method: Browser>>classCommentText (in category 'class functions') -----
classCommentText
"return the text to display for the comment of the currently selected class"
| theClass |
theClass := self selectedClassOrMetaClass.
theClass ifNil: [ ^''].
^ theClass hasComment
ifTrue: [ theClass comment ]
ifFalse: [ self noCommentNagString ]!
Item was changed:
----- Method: Browser>>classListSingleton (in category 'class list') -----
classListSingleton
| name |
name := self selectedClassName.
^ name ifNil: [Array new]
ifNotNil: [Array with: name]!
Item was changed:
----- Method: Browser>>editSelection: (in category 'accessing') -----
editSelection: aSelection
"Set the editSelection as requested."
editSelection := aSelection.
self changed: #editSelection.!
Item was changed:
----- Method: Browser>>messageCatListSingleton (in category 'message category list') -----
messageCatListSingleton
| name |
name := self selectedMessageCategoryName.
^ name ifNil: [Array new]
ifNotNil: [Array with: name]!
Item was changed:
----- Method: Browser>>messageListSingleton (in category 'message list') -----
messageListSingleton
| name |
name := self selectedMessageName.
^ name ifNil: [Array new]
ifNotNil: [Array with: name]!
Item was changed:
----- Method: Browser>>selectedMessageName: (in category 'message list') -----
selectedMessageName: aSelector
"Make the given selector be the selected message name"
| anIndex |
anIndex := self messageList indexOf: aSelector.
anIndex > 0 ifTrue:
[self messageListIndex: anIndex]!
Item was changed:
----- Method: Browser>>setSelector: (in category 'initialize-release') -----
setSelector: aSymbol
"Make the receiver point at the given selector, in the currently chosen class"
| aClass messageCatIndex |
aSymbol ifNil: [^ self].
(aClass := self selectedClassOrMetaClass) ifNil: [^ self].
messageCatIndex := aClass organization numberOfCategoryOfElement: aSymbol.
self messageCategoryListIndex: messageCatIndex + 1.
messageCatIndex = 0 ifTrue: [^ self].
self messageListIndex:
((aClass organization listAtCategoryNumber: messageCatIndex)
indexOf: aSymbol)!
Item was changed:
----- Method: Browser>>showHomeCategory (in category 'message category functions') -----
showHomeCategory
"Show the home category of the selected method. This is only really useful if one is in a tool that supports the showing of categories. Thus, it's good in browsers and hierarchy browsers but not in message-list browsers"
| aSelector |
self okToChange ifTrue:
[(aSelector := self selectedMessageName) ifNotNil:
[self selectOriginalCategoryForCurrentMethod.
self selectedMessageName: aSelector]]!
Item was changed:
----- Method: CPUWatcher class>>startMonitoringPeriod:rate:threshold: (in category 'as yet unclassified') -----
startMonitoringPeriod: pd rate: rt threshold: th
"CPUWatcher startMonitoring"
CurrentCPUWatcher ifNotNil: [ ^CurrentCPUWatcher startMonitoring. ].
CurrentCPUWatcher := (self new)
monitorProcessPeriod: pd sampleRate: rt;
threshold: th;
yourself.
^CurrentCPUWatcher
!
Item was changed:
----- Method: CPUWatcher class>>stopMonitoring (in category 'as yet unclassified') -----
stopMonitoring
"CPUWatcher stopMonitoring"
CurrentCPUWatcher ifNotNil: [ CurrentCPUWatcher stopMonitoring. ].
CurrentCPUWatcher := nil.
!
Item was changed:
----- Method: CPUWatcher>>catchThePig: (in category 'porcine capture') -----
catchThePig: aProcess
| rules |
"nickname, allow-stop, allow-debug"
rules := ProcessBrowser nameAndRulesFor: aProcess.
(ProcessBrowser isUIProcess: aProcess)
ifTrue: [ "aProcess debugWithTitle: 'Interrupted from the CPUWatcher'." ]
ifFalse: [ rules second ifFalse: [ ^self ].
ProcessBrowser suspendProcess: aProcess.
self openWindowForSuspendedProcess: aProcess ]
!
Item was changed:
----- Method: CPUWatcher>>debugProcess: (in category 'process operations') -----
debugProcess: aProcess
| uiPriority oldPriority |
uiPriority := Processor activeProcess priority.
aProcess priority >= uiPriority ifTrue: [
oldPriority := ProcessBrowser setProcess: aProcess toPriority: uiPriority - 1
].
ProcessBrowser debugProcess: aProcess.!
Item was changed:
----- Method: CPUWatcher>>findThePig (in category 'porcine capture') -----
findThePig
"tally has been updated. Look at it to see if there is a bad process.
This runs at a very high priority, so make it fast"
| countAndProcess |
countAndProcess := tally sortedCounts first.
(countAndProcess key / tally size > self threshold) ifTrue: [ | proc |
proc := countAndProcess value.
proc == Processor backgroundProcess ifTrue: [ ^self ]. "idle process? OK"
self catchThePig: proc
].
!
Item was changed:
----- Method: CPUWatcher>>monitorProcessPeriod:sampleRate: (in category 'startup-shutdown') -----
monitorProcessPeriod: secs sampleRate: msecs
self stopMonitoring.
watcher := [ [ | promise |
promise := Processor tallyCPUUsageFor: secs every: msecs.
tally := promise value.
promise := nil.
self findThePig.
] repeat ] forkAt: Processor highestPriority.
Processor yield !
Item was changed:
----- Method: CPUWatcher>>openMorphicWindowForSuspendedProcess: (in category 'porcine capture') -----
openMorphicWindowForSuspendedProcess: aProcess
| menu rules |
menu := MenuMorph new.
"nickname allow-stop allow-debug"
rules := ProcessBrowser nameAndRulesFor: aProcess.
menu add: 'Dismiss this menu' target: menu selector: #delete; addLine.
menu add: 'Open Process Browser' target: ProcessBrowser selector: #open.
menu add: 'Resume'
target: self
selector: #resumeProcess:fromMenu:
argumentList: { aProcess . menu }.
menu add: 'Terminate'
target: self
selector: #terminateProcess:fromMenu:
argumentList: { aProcess . menu }.
rules third ifTrue: [
menu add: 'Debug at a lower priority'
target: self
selector: #debugProcess:fromMenu:
argumentList: { aProcess . menu }.
].
menu addTitle: aProcess identityHash asString,
' ', rules first,
' is taking too much time and has been suspended.
What do you want to do with it?'.
menu stayUp: true.
menu popUpInWorld
!
Item was changed:
----- Method: CPUWatcher>>stopMonitoring (in category 'startup-shutdown') -----
stopMonitoring
watcher ifNotNil: [
ProcessBrowser terminateProcess: watcher.
watcher := nil.
]!
Item was changed:
----- Method: CPUWatcher>>threshold: (in category 'accessing') -----
threshold: thresh
"What fraction of the time can a process be the active process before we stop it?"
threshold := (thresh max: 0.02) min: 1.0!
Item was changed:
----- Method: ChangeList class>>browseRecentLogOn: (in category 'public access') -----
browseRecentLogOn: origChangesFile
"figure out where the last snapshot or quit was, then browse the recent entries."
| end done block pos chunk changesFile positions prevBlock |
changesFile := origChangesFile readOnlyCopy.
positions := SortedCollection new.
end := changesFile size.
prevBlock := end.
block := end - 1024 max: 0.
done := false.
[done
or: [positions size > 0]]
whileFalse: [changesFile position: block.
"ignore first fragment"
changesFile nextChunk.
[changesFile position < prevBlock]
whileTrue: [pos := changesFile position.
chunk := changesFile nextChunk.
((chunk indexOfSubCollection: '----' startingAt: 1) = 1) ifTrue: [
({ '----QUIT'. '----SNAPSHOT' } anySatisfy: [ :str |
chunk beginsWith: str ])
ifTrue: [positions add: pos]]].
block = 0
ifTrue: [done := true]
ifFalse: [prevBlock := block.
block := block - 1024 max: 0]].
changesFile close.
positions isEmpty
ifTrue: [self inform: 'File ' , changesFile name , ' does not appear to be a changes file']
ifFalse: [self browseRecentLogOn: origChangesFile startingFrom: positions last]!
Item was changed:
----- Method: ChangeList class>>fileReaderServicesForFile:suffix: (in category 'fileIn/Out') -----
fileReaderServicesForFile: fullName suffix: suffix
| services |
services := OrderedCollection new.
(FileStream isSourceFileSuffix: suffix) | (suffix = '*')
ifTrue: [ services add: self serviceBrowseChangeFile ].
(suffix = 'changes') | (suffix = '*')
ifTrue: [ services add: self serviceBrowseDotChangesFile ].
(fullName asLowercase endsWith: '.cs.gz') | (suffix = '*')
ifTrue: [ services add: self serviceBrowseCompressedChangeFile ].
^services!
Item was changed:
----- Method: ChangeList>>annotation (in category 'viewing access') -----
annotation
"Answer the string to be shown in an annotation pane. Make plain that the annotation is associated with the current in-image version of the code, not of the selected disk-based version, and if the corresponding method is missing from the in-image version, mention that fact."
| annot aChange aClass |
annot := super annotation.
annot asString = '------' ifTrue: [^ annot].
^ ((aChange := self currentChange) notNil and: [aChange methodSelector notNil])
ifFalse:
[annot]
ifTrue:
[((aClass := aChange methodClass) isNil or: [(aClass includesSelector: aChange methodSelector) not])
ifTrue:
[aChange methodClassName, ' >> ', aChange methodSelector, ' is not present in the current image.']
ifFalse:
['current version: ', annot]]!
Item was changed:
----- Method: ChangeList>>browseVersions (in category 'menu actions') -----
browseVersions
| change class browser |
listIndex = 0
ifTrue: [^ nil ].
change := changeList at: listIndex.
((class := change methodClass) notNil
and: [class includesSelector: change methodSelector])
ifFalse: [ ^nil ].
browser := super browseVersions.
browser ifNotNil: [ browser addedChangeRecord: change ].
^browser!
Item was changed:
----- Method: ChangeList>>compareToCurrentVersion (in category 'menu actions') -----
compareToCurrentVersion
"If the current selection corresponds to a method in the system, then spawn a window showing the diffs as text"
| change class s1 s2 |
listIndex = 0
ifTrue: [^ self].
change := changeList at: listIndex.
((class := change methodClass) notNil
and: [class includesSelector: change methodSelector])
ifTrue: [s1 := (class sourceCodeAt: change methodSelector) asString.
s2 := change string.
s1 = s2
ifTrue: [^ self inform: 'Exact Match'].
(StringHolder new
textContents: (TextDiffBuilder buildDisplayPatchFrom: s1 to: s2 inClass: class prettyDiffs: self showingPrettyDiffs))
openLabel: 'Comparison to Current Version']
ifFalse: [self flash]!
Item was changed:
----- Method: ChangeList>>deselectAll (in category 'menu actions') -----
deselectAll
"Deselect all items in the list pane, and clear the code pane"
listIndex := 0.
listSelections atAllPut: false.
self changed: #allSelections.
self contentsChanged!
Item was changed:
----- Method: ChangeList>>destroyCurrentCodeOfSelections (in category 'menu actions') -----
destroyCurrentCodeOfSelections
"Actually remove from the system any in-memory methods with class and selector identical to items current selected. This may seem rather arcane but believe me it has its great uses, when trying to split out code. To use effectively, first file out a change set that you wish to split off. Then open a ChangeList browser on that fileout. Now look through the methods, and select any of them which you want to remove completely from the system, then issue this command. For those methods where you have made changes to pre-existing versions, of course, you won't want to remove them from the system, so use this mechanism with care!!"
| aClass aChange aList |
aList := OrderedCollection new.
1 to: changeList size do:
[:index |
(listSelections at: index) ifTrue:
[aChange := changeList at: index.
(aChange type = #method
and: [(aClass := aChange methodClass) notNil
and: [aClass includesSelector: aChange methodSelector]])
ifTrue:
[aList add: {aClass. aChange methodSelector}]]].
aList size > 0 ifTrue:
[(self confirm: 'Warning!! This will actually remove ', aList size printString, ' method(s) from the system!!') ifFalse: [^ self]].
aList do:
[:aPair | Transcript cr; show: 'Removed: ', aPair first printString, '.', aPair second.
aPair first removeSelector: aPair second]!
Item was changed:
----- Method: ChangeList>>diffedVersionContents (in category 'viewing access') -----
diffedVersionContents
"Answer diffed version contents, maybe pretty maybe not"
| change class earlier later |
(listIndex = 0
or: [changeList size < listIndex])
ifTrue: [^ ''].
change := changeList at: listIndex.
later := change text.
class := change methodClass.
(listIndex == changeList size or: [class == nil])
ifTrue: [^ later].
earlier := (changeList at: listIndex + 1) text.
^ TextDiffBuilder buildDisplayPatchFrom: earlier to: later inClass: class prettyDiffs: self showingPrettyDiffs!
Item was changed:
----- Method: ChangeList>>fileInSelections (in category 'menu actions') -----
fileInSelections
| any |
any := false.
listSelections with: changeList do:
[:selected :item | selected ifTrue: [any := true. item fileIn]].
any ifFalse:
[self inform: 'nothing selected, so nothing done']!
Item was changed:
----- Method: ChangeList>>initialize (in category 'initialization-release') -----
initialize
"Initialize a blank ChangeList. Set the contentsSymbol to reflect whether diffs will initally be shown or not"
contentsSymbol := Preferences diffsInChangeList
ifTrue:
[self defaultDiffsSymbol]
ifFalse:
[#source].
changeList := OrderedCollection new.
list := OrderedCollection new.
listIndex := 0.
super initialize!
Item was changed:
----- Method: ChangeList>>invertSelections (in category 'menu actions') -----
invertSelections
"Invert the selectedness of each item in the changelist"
listSelections := listSelections collect: [ :ea | ea not].
listIndex := 0.
self changed: #allSelections.
self contentsChanged!
Item was changed:
----- Method: ChangeList>>listSelections (in category 'accessing') -----
listSelections
listSelections ifNil: [
list ifNotNil: [
listSelections := Array new: list size withAll: false]].
^ listSelections!
Item was changed:
----- Method: ChangeList>>removeDoIts (in category 'menu actions') -----
removeDoIts
"Remove doits from the receiver, other than initializes. 1/26/96 sw"
| newChangeList newList |
newChangeList := OrderedCollection new.
newList := OrderedCollection new.
changeList with: list do:
[:chRec :str |
(chRec type ~~ #doIt or:
[str endsWith: 'initialize'])
ifTrue:
[newChangeList add: chRec.
newList add: str]].
newChangeList size < changeList size
ifTrue:
[changeList := newChangeList.
list := newList.
listIndex := 0.
listSelections := Array new: list size withAll: false].
self changed: #list.
!
Item was changed:
----- Method: ChangeList>>selectedClassOrMetaClass (in category 'viewing access') -----
selectedClassOrMetaClass
| c |
^ (c := self currentChange) ifNotNil: [c methodClass]!
Item was changed:
----- Method: ChangeList>>selectedMessageName (in category 'viewing access') -----
selectedMessageName
| c |
^ (c := self currentChange) ifNotNil: [c methodSelector]!
Item was changed:
----- Method: ChangeList>>setLostMethodPointer: (in category 'accessing') -----
setLostMethodPointer: sourcePointer
lostMethodPointer := sourcePointer!
Item was changed:
----- Method: ChangeList>>toggleListIndex: (in category 'viewing access') -----
toggleListIndex: newListIndex
listIndex ~= 0 ifTrue: [listSelections at: listIndex put: false].
newListIndex ~= 0 ifTrue: [listSelections at: newListIndex put: true].
listIndex := newListIndex.
self changed: #listIndex.
self contentsChanged!
Item was changed:
----- Method: ChangeListForProjects>>currentDiffedFromContents (in category 'contents') -----
currentDiffedFromContents
"Answer the current in-memory method diffed from the current contents"
| aChange aClass |
listIndex = 0
ifTrue: [^ ''].
aChange := changeList at: listIndex.
^ ((aChange type == #method
and: [(aClass := aChange methodClass) notNil])
and: [aClass includesSelector: aChange methodSelector])
ifTrue: [TextDiffBuilder
buildDisplayPatchFrom: aChange text
to: (aClass sourceCodeAt: aChange methodSelector)
inClass: aClass
prettyDiffs: self showingPrettyDiffs]
ifFalse: [(changeList at: listIndex) text]!
Item was changed:
----- Method: ChangeSetBrowser>>addModelItemsToWindowMenu: (in category 'initialization') -----
addModelItemsToWindowMenu: aMenu
"Add model-related items to the given window menu"
| oldTarget |
oldTarget := aMenu defaultTarget.
aMenu defaultTarget: self.
aMenu addLine.
aMenu add: 'rename change set' action: #rename.
aMenu add: 'make changes go to me' action: #newCurrent.
aMenu addLine.
aMenu add: 'file out' action: #fileOut.
aMenu add: 'browse methods' action: #browseChangeSet.
aMenu addLine.
myChangeSet hasPreamble
ifTrue:
[aMenu add: 'edit preamble' action: #addPreamble.
aMenu add: 'remove preamble' action: #removePreamble]
ifFalse:
[aMenu add: 'add preamble' action: #addPreamble].
myChangeSet hasPostscript
ifTrue:
[aMenu add: 'edit postscript...' action: #editPostscript.
aMenu add: 'remove postscript' action: #removePostscript]
ifFalse:
[aMenu add: 'add postscript...' action: #editPostscript].
aMenu addLine.
aMenu add: 'destroy change set' action: #remove.
aMenu addLine.
Smalltalk isMorphic ifTrue:
[aMenu addLine.
aMenu add: 'what to show...' target: self action: #offerWhatToShowMenu].
aMenu addLine.
aMenu add: 'more...' action: #offerShiftedChangeSetMenu.
aMenu defaultTarget: oldTarget.
^ aMenu!
Item was changed:
----- Method: ChangeSorter class>>unload (in category 'deprecated') -----
unload
"Unload the receiver from global registries"
self environment at: #FileList ifPresent: [:cl |
cl unregisterFileReader: self].
self environment at: #Flaps ifPresent: [:cl |
cl unregisterQuadsWithReceiver: self] !
Item was changed:
----- Method: ChangeSorter>>addPreamble (in category 'changeSet menu') -----
addPreamble
myChangeSet assurePreambleExists.
self okToChange ifTrue:
[currentClassName := nil.
currentSelector := nil.
self showChangeSet: myChangeSet]!
Item was changed:
----- Method: ChangeSorter>>clearChangeSet (in category 'changeSet menu') -----
clearChangeSet
"Clear out the current change set, after getting a confirmation."
| message |
self okToChange ifFalse: [^ self].
myChangeSet isEmpty ifFalse:
[message := 'Are you certain that you want to\forget all the changes in this set?' withCRs.
(self confirm: message) ifFalse: [^ self]].
myChangeSet clear.
self changed: #classList.
self changed: #messageList.
self setContents.
self contentsChanged.
!
Item was changed:
----- Method: ChangeSorter>>copyAllToOther (in category 'changeSet menu') -----
copyAllToOther
"Copy this entire change set into the one on the other side"
| companionSorter |
self checkThatSidesDiffer: [^ self].
(companionSorter := parent other: self) changeSetCurrentlyDisplayed assimilateAllChangesFoundIn: myChangeSet.
companionSorter changed: #classList. "Later the changeSet itself will notice..."
companionSorter changed: #messageList!
Item was changed:
----- Method: ChangeSorter>>copyClassToOther (in category 'class list') -----
copyClassToOther
"Place these changes in the other changeSet also"
| otherSorter otherChangeSet |
self checkThatSidesDiffer: [^ self].
self okToChange ifFalse: [^ Beeper beep].
currentClassName ifNil: [^ Beeper beep].
otherSorter := parent other: self.
otherChangeSet := otherSorter changeSet.
otherChangeSet absorbClass: self selectedClassOrMetaClass name from: myChangeSet.
otherSorter showChangeSet: otherChangeSet.!
Item was changed:
----- Method: ChangeSorter>>currentClassName: (in category 'class list') -----
currentClassName: aString
currentClassName := aString.
currentSelector := nil. "fix by wod"
self changed: #currentClassName.
self changed: #messageList.
self setContents.
self contentsChanged.!
Item was changed:
----- Method: ChangeSorter>>currentSelector: (in category 'message list') -----
currentSelector: messageName
currentSelector := messageName.
self changed: #currentSelector.
self setContents.
self contentsChanged.!
Item was changed:
----- Method: ChangeSorter>>forget (in category 'message list') -----
forget
"Drop this method from the changeSet"
self okToChange ifFalse: [^ self].
currentSelector ifNotNil: [
myChangeSet removeSelectorChanges: self selectedMessageName
class: self selectedClassOrMetaClass.
currentSelector := nil.
self showChangeSet: myChangeSet]!
Item was changed:
----- Method: ChangeSorter>>goToChangeSetsProject (in category 'changeSet menu') -----
goToChangeSetsProject
"Transport the user to a project which bears the selected changeSet as its current changeSet"
| aProject |
(aProject := myChangeSet correspondingProject)
ifNotNil:
[aProject enter: false revert: false saveForRevert: false]
ifNil:
[self inform: 'Has no project']!
Item was changed:
----- Method: ChangeSorter>>myChangeSet: (in category 'access') -----
myChangeSet: anObject
myChangeSet := anObject!
Item was changed:
----- Method: ChangeSorter>>parent: (in category 'access') -----
parent: anObject
parent := anObject!
Item was changed:
----- Method: ChangeSorter>>removeFromCurrentChanges (in category 'message list') -----
removeFromCurrentChanges
"Redisplay after removal in case we are viewing the current changeSet"
super removeFromCurrentChanges.
currentSelector := nil.
self showChangeSet: myChangeSet!
Item was changed:
----- Method: ChangeSorter>>selectedClass (in category 'class list') -----
selectedClass
"Answer the currently-selected class. If there is no selection, or if the selection refers to a class no longer extant, return nil"
| c |
^ currentClassName ifNotNil: [(c := self selectedClassOrMetaClass)
ifNotNil: [c theNonMetaClass]]!
Item was changed:
----- Method: ChangeSorter>>showChangeSet: (in category 'access') -----
showChangeSet: chgSet
myChangeSet == chgSet ifFalse: [
myChangeSet := chgSet.
currentClassName := nil.
currentSelector := nil].
self changed: #relabel.
self changed: #currentCngSet. "new -- list of sets"
self changed: #mainButtonName. "old, button"
self changed: #classList.
self changed: #messageList.
self setContents.
self contentsChanged.!
Item was changed:
----- Method: ChangeSorter>>veryDeepFixupWith: (in category 'creation') -----
veryDeepFixupWith: deepCopier
super veryDeepFixupWith: deepCopier.
parent := deepCopier references at: parent ifAbsent: [parent].
self updateIfNecessary!
Item was changed:
----- Method: ChangeSorter>>veryDeepInner: (in category 'creation') -----
veryDeepInner: deepCopier
"Copy all of my instance variables. Some need to be not copied at all, but shared."
super veryDeepInner: deepCopier.
"parent := parent. Weakly copied"
"myChangeSet := myChangeSet. Weakly copied"
currentClassName := currentClassName veryDeepCopyWith: deepCopier.
"currentSelector := currentSelector. Symbol"
priorChangeSetList := priorChangeSetList veryDeepCopyWith: deepCopier.
!
Item was changed:
----- Method: ChangedMessageSet class>>openFor: (in category 'as yet unclassified') -----
openFor: aChangeSet
"Open up a ChangedMessageSet browser on the given change set; this is a conventional message-list browser whose message-list consists of all the methods in aChangeSet. After any method submission, the message list is refigured, making it plausibly dynamic"
| messageSet |
messageSet := aChangeSet changedMessageListAugmented select: [ :each | each isValid].
self
openMessageList: messageSet
name: 'Methods in Change Set ', aChangeSet name
autoSelect: nil
changeSet: aChangeSet!
Item was changed:
----- Method: ClassCommentVersionsBrowser class>>commentRecordsOf: (in category 'utilities') -----
commentRecordsOf: aClass
"Return a list of ChangeRecords for all versions of the method at selector. Source code can be retrieved by sending string to any one. Return nil if the method is absent."
| aList |
aList := self new
scanVersionsOf: aClass.
^ aList ifNotNil: [aList changeList]!
Item was changed:
----- Method: ClassCommentVersionsBrowser class>>timeStampFor:class:reverseOrdinal: (in category 'utilities') -----
timeStampFor: aSelector class: aClass reverseOrdinal: anInteger
"Answer the time stamp corresponding to some version of the given method, nil if none. The reverseOrdinal parameter is interpreted as: 1 = current version; 2 = last-but-one version, etc."
| aChangeList |
aChangeList := self new scanVersionsOf: aClass.
^ aChangeList ifNil: [nil] ifNotNil:
[aChangeList list size >= anInteger
ifTrue:
[(aChangeList changeList at: anInteger) stamp]
ifFalse:
[nil]]!
Item was changed:
----- Method: ClassCommentVersionsBrowser>>compareToCurrentVersion (in category 'menu') -----
compareToCurrentVersion
"If the current selection corresponds to a method in the system, then spawn a window showing the diffs as text"
| change s1 s2 |
listIndex = 0
ifTrue: [^ self].
change := changeList at: listIndex.
s1 := classOfMethod organization classComment.
s2 := change string.
s1 = s2
ifTrue: [^ self inform: 'Exact Match'].
(StringHolder new
textContents: (TextDiffBuilder buildDisplayPatchFrom: s1 to: s2 inClass: classOfMethod prettyDiffs: self showingPrettyDiffs))
openLabel: 'Comparison to Current Version'!
Item was changed:
----- Method: ClassCommentVersionsBrowser>>diffedVersionContents (in category 'basic function') -----
diffedVersionContents
"Answer diffed version contents, maybe pretty maybe not"
| change class earlier later |
(listIndex = 0
or: [changeList size < listIndex])
ifTrue: [^ ''].
change := changeList at: listIndex.
later := change text.
class := self selectedClass.
(listIndex == changeList size or: [class == nil])
ifTrue: [^ later].
earlier := (changeList at: listIndex + 1) text.
^ TextDiffBuilder buildDisplayPatchFrom: earlier to: later inClass: class prettyDiffs: self showingPrettyDiffs!
Item was changed:
----- Method: ClassCommentVersionsBrowser>>priorSourceOrNil (in category 'misc') -----
priorSourceOrNil
"If the currently-selected method has a previous version, return its source, else return nil"
| aClass aSelector changeRecords |
(aClass := self selectedClass) ifNil: [^ nil].
(aSelector := self selectedMessageName) ifNil: [^ nil].
changeRecords := self class commentRecordsOf: self selectedClass.
(changeRecords == nil or: [changeRecords size <= 1]) ifTrue: [^ nil].
^ (changeRecords at: 2) string
!
Item was changed:
----- Method: ClassCommentVersionsBrowser>>reformulateList (in category 'basic function') -----
reformulateList
classOfMethod organization classComment ifNil: [^ self].
self scanVersionsOf: classOfMethod.
self changed: #list. "for benefit of mvc"
listIndex := 1.
self changed: #listIndex.
self contentsChanged!
Item was changed:
----- Method: ClassCommentVersionsBrowser>>updateListsAndCodeIn: (in category 'basic function') -----
updateListsAndCodeIn: aWindow
| aComment |
aComment := classOfMethod organization commentRemoteStr.
aComment == currentCompiledMethod
ifFalse:
["Do not attempt to formulate if there is no source pointer.
It probably means it has been recompiled, but the source hasn't been written
(as during a display of the 'save text simply?' confirmation)."
aComment last ~= 0 ifTrue: [self reformulateList]].
^ true
!
Item was changed:
----- Method: ClassListBrowser>>defaultTitle: (in category 'title') -----
defaultTitle: aTitle
"Set the browser's default title"
defaultTitle := aTitle!
Item was changed:
----- Method: CodeHolder>>annotationForClassCommentFor: (in category 'annotation') -----
annotationForClassCommentFor: aClass
"Provide a line of content for an annotation pane, given that the receiver is pointing at the clas comment of the given class."
| aStamp nonMeta |
aStamp := (nonMeta := aClass theNonMetaClass) organization commentStamp.
^ aStamp
ifNil:
[nonMeta name, ' has no class comment']
ifNotNil:
['class comment for ', nonMeta name,
(aStamp = '<historical>'
ifFalse:
[' - ', aStamp]
ifTrue:
[''])]!
Item was changed:
----- Method: CodeHolder>>browseImplementors (in category 'commands') -----
browseImplementors
"Create and schedule a message set browser on all implementors of the currently selected message selector. Do nothing if no message is selected."
| aMessageName |
(aMessageName := self selectedMessageName) ifNotNil:
[self systemNavigation browseAllImplementorsOf: aMessageName]!
Item was changed:
----- Method: CodeHolder>>buildClassBrowserEditString: (in category 'construction') -----
buildClassBrowserEditString: aString
"Create and schedule a new class browser for the current selection, with initial textual contents set to aString. This is used specifically in spawning where a class is established but a method-category is not."
| newBrowser |
newBrowser := Browser new.
newBrowser setClass: self selectedClassOrMetaClass selector: nil.
newBrowser editSelection: #newMessage.
Browser openBrowserView: (newBrowser openOnClassWithEditString: aString)
label: 'Class Browser: ', self selectedClassOrMetaClass name
!
Item was changed:
----- Method: CodeHolder>>categoryOfCurrentMethod (in category 'categories') -----
categoryOfCurrentMethod
"Answer the category that owns the current method. If unable to determine a category, answer nil."
| aClass aSelector |
^ (aClass := self selectedClassOrMetaClass)
ifNotNil: [(aSelector := self selectedMessageName)
ifNotNil: [aClass whichCategoryIncludesSelector: aSelector]]!
Item was changed:
----- Method: CodeHolder>>changeCategory (in category 'categories') -----
changeCategory
"Present a menu of the categories of messages for the current class,
and let the user choose a new category for the current message"
| aClass aSelector |
(aClass := self selectedClassOrMetaClass) ifNotNil:
[(aSelector := self selectedMessageName) ifNotNil:
[(self letUserReclassify: aSelector in: aClass) ifTrue:
["ChangeSet current reorganizeClass: aClass."
"Decided on further review that the above, when present, could cause more
unexpected harm than good"
self methodCategoryChanged]]]!
Item was changed:
----- Method: CodeHolder>>codePaneProvenanceString (in category 'controls') -----
codePaneProvenanceString
"Answer a string that reports on code-pane-provenance"
| symsAndWordings |
(symsAndWordings := self contentsSymbolQuints) do:
[:aQuad |
contentsSymbol == aQuad first ifTrue: [^ aQuad fourth]].
^ symsAndWordings first fourth "default to plain source, for example if nil as initially"!
Item was changed:
----- Method: CodeHolder>>contentsSymbol: (in category 'contents') -----
contentsSymbol: aSymbol
"Set the contentsSymbol as indicated. #source means to show source code, #comment means to show the first comment found in the source code"
contentsSymbol := aSymbol!
Item was changed:
----- Method: CodeHolder>>diffFromPriorSourceFor: (in category 'diffs') -----
diffFromPriorSourceFor: sourceCode
"If there is a prior version of source for the selected method, return a diff, else just return the source code"
| prior |
^ (prior := self priorSourceOrNil)
ifNil: [sourceCode]
ifNotNil: [TextDiffBuilder buildDisplayPatchFrom: prior to: sourceCode inClass: self selectedClass prettyDiffs: self showingPrettyDiffs]!
Item was changed:
----- Method: CodeHolder>>listPaneWithSelector: (in category 'categories & search pane') -----
listPaneWithSelector: aSelector
"If, among my window's paneMorphs, there is a list pane defined with aSelector as its retriever, answer it, else answer nil"
| aWindow |
^ (aWindow := self containingWindow) ifNotNil:
[aWindow paneMorphSatisfying:
[:aMorph | (aMorph isKindOf: PluggableListMorph) and:
[aMorph getListSelector == aSelector]]]!
Item was changed:
----- Method: CodeHolder>>newSearchPane (in category 'categories & search pane') -----
newSearchPane
"Answer a new search pane for the receiver"
| aTextMorph |
aTextMorph := PluggableTextMorph on: self
text: #lastSearchString accept: #lastSearchString:
readSelection: nil menu: nil.
aTextMorph setProperty: #alwaysAccept toValue: true.
aTextMorph askBeforeDiscardingEdits: false.
aTextMorph acceptOnCR: true.
aTextMorph setBalloonText: 'Type here and hit ENTER, and all methods whose selectors match what you typed will appear in the list pane below.'.
^ aTextMorph!
Item was changed:
----- Method: CodeHolder>>priorSourceOrNil (in category 'misc') -----
priorSourceOrNil
"If the currently-selected method has a previous version, return its source, else return nil"
| aClass aSelector changeRecords |
(aClass := self selectedClassOrMetaClass) ifNil: [^ nil].
(aSelector := self selectedMessageName) ifNil: [^ nil].
changeRecords := aClass changeRecordsAt: aSelector.
(changeRecords == nil or: [changeRecords size <= 1]) ifTrue: [^ nil].
^ (changeRecords at: 2) string
!
Item was changed:
----- Method: CodeHolder>>releaseCachedState (in category 'misc') -----
releaseCachedState
"Can always be found again. Don't write on a file."
currentCompiledMethod := nil.!
Item was changed:
----- Method: CodeHolder>>removeClass (in category 'commands') -----
removeClass
"Remove the selected class from the system, at interactive user request. Make certain the user really wants to do this, since it is not reversible. Answer true if removal actually happened."
| message className classToRemove result |
self okToChange ifFalse: [^ false].
classToRemove := self selectedClassOrMetaClass ifNil: [Beeper beep. ^ false].
classToRemove := classToRemove theNonMetaClass.
className := classToRemove name.
message := 'Are you certain that you
want to REMOVE the class ', className, '
from the system?'.
(result := self confirm: message)
ifTrue:
[classToRemove subclasses size > 0
ifTrue: [(self confirm: 'class has subclasses: ' , message)
ifFalse: [^ false]].
classToRemove removeFromSystem.
self changed: #classList.
true].
^ result!
Item was changed:
----- Method: CodeHolder>>restoreTextualCodingPane (in category 'diffs') -----
restoreTextualCodingPane
"If the receiver is showing tiles, restore the textual coding pane"
self showingTiles ifTrue:
[contentsSymbol := #source.
self installTextualCodingPane]!
Item was changed:
----- Method: CodeHolder>>sampleInstanceOfSelectedClass (in category 'misc') -----
sampleInstanceOfSelectedClass
| aClass |
"Return a sample instance of the class currently being pointed at"
(aClass := self selectedClassOrMetaClass) ifNil: [^ nil].
^ aClass theNonMetaClass initializedInstance!
Item was changed:
----- Method: CodeHolder>>setClassAndSelectorIn: (in category 'misc') -----
setClassAndSelectorIn: csBlock
"Evaluate csBlock with my selected class and and selector as its arguments; provide nil arguments if I don't have a method currently selected"
| aName |
(aName := self selectedMessageName)
ifNil:
[csBlock value: nil value: nil]
ifNotNil:
[csBlock value: self selectedClassOrMetaClass value: aName]
!
Item was changed:
----- Method: CodeHolder>>setContentsToForceRefetch (in category 'what to show') -----
setContentsToForceRefetch
"Set the receiver's contents such that on the next update the contents will be formulated afresh. This is a critical and obscure difference between Browsers on the one hand and MessageSets on the other, and has over the years been the source of much confusion and much difficulty. By centralizing the different handling here, we don't need so many idiosyncratic overrides in MessageSet any more"
contents := nil!
Item was changed:
----- Method: CodeHolder>>showByteCodes: (in category 'what to show') -----
showByteCodes: aBoolean
"Get into or out of bytecode-showoing mode"
self okToChange ifFalse: [^ self changed: #flash].
aBoolean
ifTrue:
[contentsSymbol := #byteCodes]
ifFalse:
[contentsSymbol == #byteCodes ifTrue: [contentsSymbol := #source]].
self contentsChanged!
Item was changed:
----- Method: CodeHolder>>showDiffs: (in category 'diffs') -----
showDiffs: aBoolean
"Set whether I'm showing diffs as indicated; use the global preference to determine which kind of diffs to institute."
self showingAnyKindOfDiffs
ifFalse:
[aBoolean ifTrue:
[contentsSymbol := self defaultDiffsSymbol]]
ifTrue:
[aBoolean ifFalse:
[contentsSymbol := #source]].
self setContentsToForceRefetch.
self contentsChanged!
Item was changed:
----- Method: CodeHolder>>showPrettyDiffs: (in category 'diffs') -----
showPrettyDiffs: aBoolean
"Set whether I'm showing pretty diffs as indicated"
self showingPrettyDiffs
ifFalse:
[aBoolean ifTrue:
[contentsSymbol := #prettyDiffs]]
ifTrue:
[aBoolean ifFalse:
[contentsSymbol := #source]].
self setContentsToForceRefetch.
self contentsChanged!
Item was changed:
----- Method: CodeHolder>>showRegularDiffs: (in category 'diffs') -----
showRegularDiffs: aBoolean
"Set whether I'm showing regular diffs as indicated"
self showingRegularDiffs
ifFalse:
[aBoolean ifTrue:
[contentsSymbol := #showDiffs]]
ifTrue:
[aBoolean ifFalse:
[contentsSymbol := #source]].
self setContentsToForceRefetch.
self contentsChanged!
Item was changed:
----- Method: CodeHolder>>spawnToClass: (in category 'commands') -----
spawnToClass: aClass
"Used to copy down code from a superclass to a subclass in one easy step, if you know what you're doing. Spawns a new message-category browser for the indicated class, populating it with the source code seen in the current tool."
| aCategory newBrowser org |
(aCategory := self categoryOfCurrentMethod)
ifNil:
[self buildClassBrowserEditString: self contents]
ifNotNil:
[((org := aClass organization) categories includes: aCategory)
ifFalse: [org addCategory: aCategory].
newBrowser := Browser new setClass: aClass selector: nil.
newBrowser selectMessageCategoryNamed: aCategory.
Browser openBrowserView: (newBrowser openMessageCatEditString: self contents)
label: 'category "', aCategory, '" in ',
newBrowser selectedClassOrMetaClassName]!
Item was changed:
----- Method: CodeHolder>>textPaneWithSelector: (in category 'categories & search pane') -----
textPaneWithSelector: aSelector
"If, among my window's paneMorphs, there is a text pane defined with aSelector as its retriever, answer it, else answer nil"
| aWindow |
^ (aWindow := self containingWindow) ifNotNil:
[aWindow paneMorphSatisfying:
[:aMorph | (aMorph isKindOf: PluggableTextMorph) and:
[aMorph getTextSelector == aSelector]]]!
Item was changed:
----- Method: CodeHolder>>toggleDecompile (in category 'what to show') -----
toggleDecompile
"Toggle the setting of the showingDecompile flag, unless there are unsubmitted edits that the user declines to discard"
| wasShowing |
self okToChange ifTrue:
[wasShowing := self showingDecompile.
self restoreTextualCodingPane.
self showDecompile: wasShowing not.
self setContentsToForceRefetch.
self contentsChanged]
!
Item was changed:
----- Method: CodeHolder>>toggleDiffing (in category 'diffs') -----
toggleDiffing
"Toggle whether diffs should be shown in the code pane. If any kind of diffs were being shown, stop showing diffs. If no kind of diffs were being shown, start showing whatever kind of diffs are called for by default."
| wasShowingDiffs |
self okToChange ifTrue:
[wasShowingDiffs := self showingAnyKindOfDiffs.
self restoreTextualCodingPane.
self showDiffs: wasShowingDiffs not.
self setContentsToForceRefetch.
self contentsChanged]
!
Item was changed:
----- Method: CodeHolder>>togglePlainSource (in category 'diffs') -----
togglePlainSource
"Toggle whether plain source shown in the code pane"
| wasShowingPlainSource |
self okToChange ifTrue:
[wasShowingPlainSource := self showingPlainSource.
self restoreTextualCodingPane.
wasShowingPlainSource
ifTrue:
[self showDocumentation: true]
ifFalse:
[contentsSymbol := #source].
self setContentsToForceRefetch.
self changed: #contents]
!
Item was changed:
----- Method: CodeHolder>>togglePrettyDiffing (in category 'diffs') -----
togglePrettyDiffing
"Toggle whether pretty-diffing should be shown in the code pane"
| wasShowingDiffs |
self okToChange ifTrue:
[wasShowingDiffs := self showingPrettyDiffs.
self restoreTextualCodingPane.
self showPrettyDiffs: wasShowingDiffs not.
self setContentsToForceRefetch.
self contentsChanged]
!
Item was changed:
----- Method: CodeHolder>>togglePrettyPrint (in category 'diffs') -----
togglePrettyPrint
"Toggle whether pretty-print is in effectin the code pane"
self restoreTextualCodingPane.
self okToChange ifTrue:
[self showingPrettyPrint
ifTrue:
[contentsSymbol := #source]
ifFalse:
[contentsSymbol := #prettyPrint].
self setContentsToForceRefetch.
self contentsChanged]
!
Item was changed:
----- Method: CodeHolder>>toggleRegularDiffing (in category 'diffs') -----
toggleRegularDiffing
"Toggle whether regular-diffing should be shown in the code pane"
| wasShowingDiffs |
self okToChange ifTrue:
[wasShowingDiffs := self showingRegularDiffs.
self restoreTextualCodingPane.
self showRegularDiffs: wasShowingDiffs not.
self setContentsToForceRefetch.
self contentsChanged]
!
Item was changed:
----- Method: CodeHolder>>toggleShowDocumentation (in category 'what to show') -----
toggleShowDocumentation
"Toggle the setting of the showingDocumentation flag, unless there are unsubmitted edits that the user declines to discard"
| wasShowing |
self okToChange ifTrue:
[wasShowing := self showingDocumentation.
self restoreTextualCodingPane.
self showDocumentation: wasShowing not.
self setContentsToForceRefetch.
self contentsChanged]
!
Item was changed:
----- Method: Debugger class>>informExistingDebugger:label: (in category 'instance creation') -----
informExistingDebugger: aContext label: aString
"Walking the context chain, we try to find out if we're in a debugger stepping situation.
If we find the relevant contexts, we must rearrange them so they look just like they would
if the methods were excuted outside of the debugger."
| ctx quickStepMethod oldSender baseContext |
ctx := thisContext.
quickStepMethod := ContextPart compiledMethodAt: #quickSend:to:with:super:.
[ctx sender == nil or: [ctx sender method == quickStepMethod]] whileFalse: [ctx := ctx sender].
ctx sender == nil ifTrue: [^self].
baseContext := ctx.
"baseContext is now the context created by the #quickSend... method."
oldSender := ctx := ctx sender home sender.
"oldSender is the context which originally sent the #quickSend... method"
[ctx == nil or: [ctx receiver isKindOf: self]] whileFalse: [ctx := ctx sender].
ctx == nil ifTrue: [^self].
"ctx is the context of the Debugger method #doStep"
ctx receiver labelString: aString.
ctx receiver externalInterrupt: false; proceedValue: aContext receiver.
baseContext swapSender: baseContext sender sender sender. "remove intervening contexts"
thisContext swapSender: oldSender. "make myself return to debugger"
ErrorRecursion := false.
^aContext!
Item was changed:
----- Method: Debugger class>>initialize (in category 'class initialization') -----
initialize
ErrorRecursion := false.
ContextStackKeystrokes := Dictionary new
at: $e put: #send;
at: $t put: #doStep;
at: $T put: #stepIntoBlock;
at: $p put: #proceed;
at: $r put: #restart;
at: $f put: #fullStack;
at: $w put: #where;
yourself.
"Debugger initialize"!
Item was changed:
----- Method: Debugger>>contextStackKey:from: (in category 'context stack menu') -----
contextStackKey: aChar from: view
"Respond to a keystroke in the context list"
| selector |
selector := ContextStackKeystrokes at: aChar ifAbsent: [nil].
selector ifNil: [self messageListKey: aChar from: view]
ifNotNil: [self perform: selector]!
Item was changed:
----- Method: Debugger>>doStep (in category 'context stack menu') -----
doStep
"Send the selected message in the accessed method, and regain control
after the invoked method returns."
| currentContext newContext |
self okToChange ifFalse: [^ self].
self checkContextSelection.
currentContext := self selectedContext.
newContext := interruptedProcess completeStep: currentContext.
newContext == currentContext ifTrue: [
newContext := interruptedProcess stepToSendOrReturn].
self contextStackIndex > 1
ifTrue: [self resetContext: newContext]
ifFalse: [newContext == currentContext
ifTrue: [self changed: #contentsSelection.
self updateInspectors]
ifFalse: [self resetContext: newContext]].
!
Item was changed:
----- Method: Debugger>>errorWasInUIProcess: (in category 'initialize') -----
errorWasInUIProcess: boolean
errorWasInUIProcess := boolean!
Item was changed:
----- Method: Debugger>>labelString: (in category 'accessing') -----
labelString: aString
labelString := aString.
self changed: #relabel!
Item was changed:
----- Method: Debugger>>perform:orSendTo: (in category 'code pane menu') -----
perform: selector orSendTo: otherTarget
"Selector was just chosen from a menu by a user. If can respond, then perform it on myself. If not, send it to otherTarget, presumably the editPane from which the menu was invoked."
| result |
(#(debug proceed) includes: selector) "When I am a notifier window"
ifTrue: [^ self perform: selector]
ifFalse: [result := super perform: selector orSendTo: otherTarget.
selector == #doIt ifTrue: [
result ~~ #failedDoit ifTrue: [self proceedValue: result]].
^ result]!
Item was changed:
----- Method: Debugger>>restart (in category 'context stack menu') -----
restart
"Proceed from the initial state of the currently selected context. The
argument is a controller on a view of the receiver. That view is closed."
"Closing now depends on a preference #restartAlsoProceeds - hmm 9/7/2001 16:46"
| ctxt noUnwindError |
self okToChange ifFalse: [^ self].
self checkContextSelection.
ctxt := interruptedProcess popTo: self selectedContext.
noUnwindError := false.
ctxt == self selectedContext ifTrue: [
noUnwindError := true.
interruptedProcess restartTop; stepToSendOrReturn].
self resetContext: ctxt.
(Preferences restartAlsoProceeds and: [noUnwindError]) ifTrue: [self proceed].
!
Item was changed:
----- Method: Debugger>>runToSelection: (in category 'code pane menu') -----
runToSelection: selectionInterval
| currentContext |
self pc first >= selectionInterval first ifTrue: [ ^self ].
currentContext := self selectedContext.
[ currentContext == self selectedContext and: [ self pc first < selectionInterval first ] ] whileTrue: [ self doStep ].!
Item was changed:
----- Method: Debugger>>where (in category 'context stack menu') -----
where
"Select the expression whose evaluation was interrupted."
selectingPC := true.
self contextStackIndex: contextStackIndex oldContextWas: self selectedContext
!
Item was changed:
----- Method: Dictionary>>inspectorClass (in category '*Tools-Inspector') -----
inspectorClass
"Answer the class of the inspector to be used on the receiver. Called by inspect;
use basicInspect to get a normal (less useful) type of inspector."
^ DictionaryInspector!
Item was changed:
----- Method: DictionaryInspector>>addEntry: (in category 'selecting') -----
addEntry: aKey
object at: aKey put: nil.
self calculateKeyArray.
selectionIndex := self numberOfFixedFields + (keyArray indexOf: aKey).
self changed: #inspectObject.
self changed: #selectionIndex.
self changed: #fieldList.
self update!
Item was changed:
----- Method: DictionaryInspector>>calculateKeyArray (in category 'selecting') -----
calculateKeyArray
"Recalculate the KeyArray from the object being inspected"
keyArray := object keysSortedSafely asArray.
selectionIndex := 0.
!
Item was changed:
----- Method: DictionaryInspector>>refreshView (in category 'selecting') -----
refreshView
| i |
i := selectionIndex.
self calculateKeyArray.
selectionIndex := i.
self changed: #fieldList.
self changed: #contents.!
Item was changed:
----- Method: DictionaryInspector>>removeSelection (in category 'menu') -----
removeSelection
selectionIndex = 0 ifTrue: [^ self changed: #flash].
object removeKey: (keyArray at: selectionIndex - self numberOfFixedFields).
selectionIndex := 0.
contents := ''.
self calculateKeyArray.
self changed: #inspectObject.
self changed: #selectionIndex.
self changed: #fieldList.
self changed: #selection.!
Item was changed:
----- Method: ExternalStructureInspector>>recordFieldList (in category 'accessing') -----
recordFieldList
| fields |
fields := object class fields.
(fields first isKindOf: Array) ifFalse: [fields := Array with: fields].
^fields collect: [ :field | field first ] thenSelect: [:name | name notNil]!
Item was changed:
----- Method: FileContentsBrowser>>browseVersions (in category 'other') -----
browseVersions
"Create and schedule a message set browser on all versions of the
currently selected message selector."
| class selector |
(selector := self selectedMessageName) ifNotNil:
[class := self selectedClassOrMetaClass.
(class exists and: [class realClass includesSelector: selector]) ifTrue:
[VersionsBrowser
browseVersionsOf: (class realClass compiledMethodAt: selector)
class: class realClass theNonMetaClass
meta: class realClass isMeta
category: self selectedMessageCategoryName
selector: selector]]!
Item was changed:
----- Method: FileContentsBrowser>>contents:notifying: (in category 'accessing') -----
contents: input notifying: aController
"The retrieved information has changed and its source must now be
updated. The information can be a variety of things, depending on the
list selections (such as templates for class or message definition, methods)
or the user menu commands (such as definition, comment, hierarchy).
Answer the result of updating the source."
| aString aText theClass |
aString := input asString.
aText := input asText.
editSelection == #editComment
ifTrue: [theClass := self selectedClass.
theClass ifNil: [self inform: 'You must select a class
before giving it a comment.'.
^ false].
theClass comment: aText. ^ true].
editSelection == #editMessageCategories
ifTrue: [^ self changeMessageCategories: aString].
self inform:'You cannot change the current selection'.
^false
!
Item was changed:
----- Method: FileContentsBrowser>>didCodeChangeElsewhere (in category 'other') -----
didCodeChangeElsewhere
"Determine whether the code for the currently selected method and class has been changed somewhere else."
| aClass |
(aClass := self selectedClassOrMetaClass) ifNil: [^ false].
(aClass isKindOf: PseudoClass) ifTrue: [^ false]. "class not installed"
^super didCodeChangeElsewhere!
Item was changed:
----- Method: FileContentsBrowser>>methodDiffFor:class:selector:meta: (in category 'diffs') -----
methodDiffFor: aString class: aPseudoClass selector: selector meta: meta
"Answer the diff between the current copy of the given class/selector/meta for the string provided"
| theClass source |
theClass := Smalltalk
at: aPseudoClass name
ifAbsent: [^ aString copy].
meta
ifTrue: [theClass := theClass class].
(theClass includesSelector: selector)
ifFalse: [^ aString copy].
source := theClass sourceCodeAt: selector.
^ Cursor wait
showWhile: [TextDiffBuilder buildDisplayPatchFrom: source to: aString inClass: theClass prettyDiffs: self showingPrettyDiffs]!
Item was changed:
----- Method: FileContentsBrowser>>removeUnmodifiedCategories (in category 'removing') -----
removeUnmodifiedCategories
| theClass |
self okToChange ifFalse: [^self].
theClass := self selectedClass.
theClass isNil ifTrue: [^self].
Cursor wait showWhile:
[theClass removeUnmodifiedMethods: theClass selectors.
theClass metaClass removeUnmodifiedMethods: theClass metaClass selectors].
self messageCategoryListIndex: 0.
self changed: #messageCategoryList.!
Item was changed:
----- Method: FileContentsBrowser>>selectedClassOrMetaClass (in category 'metaclass') -----
selectedClassOrMetaClass
"Answer the selected class or metaclass."
| cls |
self metaClassIndicated
ifTrue: [^ (cls := self selectedClass) ifNotNil: [cls metaClass]]
ifFalse: [^ self selectedClass]!
Item was changed:
----- Method: FileList>>askServerInfo (in category 'server list') -----
askServerInfo
"Get the user to create a ServerDirectory for a new server. Fill in and say Accept."
| template |
template := '"Please fill in the following info, then select all text and choose DoIt."
| aa |
self flag: #ViolateNonReferenceToOtherClasses.
aa := ServerDirectory new.
aa server: ''st.cs.uiuc.edu''. "host"
aa user: ''anonymous''.
aa password: ''yourEmail at school.edu''.
aa directory: ''/Smalltalk/Squeak/Goodies''.
aa url: ''''. "<- this is optional. Only used when *writing* update files."
ServerDirectory addServer: aa named: ''UIUCArchive''. "<- known by this name in Squeak"'.
(StringHolder new contents: template) openLabel: 'FTP Server Form'
!
Item was added:
+ ----- Method: FileList2 class>>morphicView (in category 'as yet unclassified') -----
+ morphicView
+ ^ self morphicViewOnDirectory: FileDirectory default!
Item was changed:
----- Method: FloatArray>>inspectorClass (in category '*Tools-Inspector') -----
inspectorClass
"Answer the class of the inspector to be used on the receiver. Called by inspect;
use basicInspect to get a normal (less useful) type of inspector."
^OrderedCollectionInspector!
Item was changed:
----- Method: HierarchyBrowser class>>newFor: (in category 'instance creation') -----
newFor: aClass
"Open a new HierarchyBrowser on the given class"
| newBrowser |
newBrowser := HierarchyBrowser new initHierarchyForClass: aClass.
Browser openBrowserView: (newBrowser openSystemCatEditString: nil)
label: newBrowser labelString
"HierarchyBrowser newFor: Boolean"!
Item was changed:
----- Method: HierarchyBrowser class>>newFor:labeled: (in category 'instance creation') -----
newFor: aClass labeled: aLabel
"Open a new HierarchyBrowser on the given class, using aLabel as the window title."
| newBrowser |
newBrowser := HierarchyBrowser new initHierarchyForClass: aClass.
Browser openBrowserView: (newBrowser openSystemCatEditString: nil)
label: aLabel
"HierarchyBrowser newFor: Boolean labeled: 'Testing'"!
Item was changed:
----- Method: HierarchyBrowser>>systemCategorySingleton (in category 'initialization') -----
systemCategorySingleton
| cls |
cls := self selectedClass.
^ cls ifNil: [Array new]
ifNotNil: [Array with: cls category]!
Item was changed:
----- Method: Inspector>>context: (in category 'accessing') -----
context: ctxt
"Set the context of inspection. Currently only used by my subclass ClosureEnvInspector. The inst var is here because we do primitiveChangeClassTo: between subclasses (see inspect:) between different subclasses, but also context could be used as a general concept in all inspectors"
context := ctxt!
Item was changed:
----- Method: Inspector>>convertToCurrentVersion:refStream: (in category 'object fileIn') -----
convertToCurrentVersion: varDict refStream: smartRefStrm
timeOfLastListUpdate ifNil: [timeOfLastListUpdate := 0].
^super convertToCurrentVersion: varDict refStream: smartRefStrm.
!
Item was changed:
----- Method: Inspector>>copyName (in category 'menu commands') -----
copyName
"Copy the name of the current variable, so the user can paste it into the
window below and work with is. If collection, do (xxx at: 1)."
| sel aClass variableNames |
self selectionUnmodifiable
ifTrue: [^ self changed: #flash].
aClass := self object class.
variableNames := aClass allInstVarNames.
(aClass isVariable and: [selectionIndex > (variableNames size + 2)])
ifTrue: [sel := '(self basicAt: ' , (selectionIndex - (variableNames size + 2)) asString , ')']
ifFalse: [sel := variableNames at: selectionIndex - 2].
(self selection isKindOf: Collection)
ifTrue: [sel := '(' , sel , ' at: 1)'].
Clipboard clipboardText: sel asText!
Item was changed:
----- Method: Inspector>>defsOfSelection (in category 'menu commands') -----
defsOfSelection
"Open a browser on all defining references to the selected instance variable, if that's what currently selected. "
| aClass sel |
self selectionUnmodifiable ifTrue: [^ self changed: #flash].
(aClass := self object class) isVariable ifTrue: [^ self changed: #flash].
sel := aClass allInstVarNames at: self selectionIndex - 2.
self systemNavigation browseAllStoresInto: sel from: aClass!
Item was changed:
----- Method: Inspector>>initialize (in category 'initialize-release') -----
initialize
selectionIndex := 0.
super initialize!
Item was changed:
----- Method: Inspector>>modelWakeUpIn: (in category 'accessing') -----
modelWakeUpIn: aWindow
| newText |
self updateListsAndCodeIn: aWindow.
newText := self contentsIsString
ifTrue: [newText := self selection]
ifFalse: ["keep it short to reduce time to compute it"
self selectionPrintString ].
newText = contents ifFalse:
[contents := newText.
self changed: #contents]!
Item was changed:
----- Method: Inspector>>noteSelectionIndex:for: (in category 'accessing') -----
noteSelectionIndex: anInteger for: aSymbol
aSymbol == #fieldList
ifTrue:
[selectionIndex := anInteger]!
Item was changed:
----- Method: Inspector>>object: (in category 'accessing') -----
object: anObject
"Set anObject to be the object being inspected by the receiver."
| oldIndex |
anObject == object
ifTrue: [self update]
ifFalse:
[oldIndex := selectionIndex <= 2 ifTrue: [selectionIndex] ifFalse: [0].
self inspect: anObject.
oldIndex := oldIndex min: self fieldList size.
self changed: #inspectObject.
oldIndex > 0
ifTrue: [self toggleIndex: oldIndex].
self changed: #fieldList.
self changed: #contents]!
Item was changed:
----- Method: Inspector>>referencesToSelection (in category 'menu commands') -----
referencesToSelection
"Open a browser on all references to the selected instance variable, if that's what currently selected. 1/25/96 sw"
| aClass sel |
self selectionUnmodifiable ifTrue: [^ self changed: #flash].
(aClass := self object class) isVariable ifTrue: [^ self changed: #flash].
sel := aClass allInstVarNames at: self selectionIndex - 2.
self systemNavigation browseAllAccessesTo: sel from: aClass!
Item was changed:
----- Method: Inspector>>selection (in category 'selecting') -----
selection
"The receiver has a list of variables of its inspected object.
One of these is selected. Answer the value of the selected variable."
| basicIndex |
selectionIndex = 0 ifTrue: [^ ''].
selectionIndex = 1 ifTrue: [^ object].
selectionIndex = 2 ifTrue: [^ object longPrintStringLimitedTo: 20000].
(selectionIndex - 2) <= object class instSize
ifTrue: [^ object instVarAt: selectionIndex - 2].
basicIndex := selectionIndex - 2 - object class instSize.
(object basicSize <= (self i1 + self i2) or: [basicIndex <= self i1])
ifTrue: [^ object basicAt: basicIndex]
ifFalse: [^ object basicAt: object basicSize - (self i1 + self i2) + basicIndex]!
Item was changed:
----- Method: Inspector>>stepAt:in: (in category 'stepping') -----
stepAt: millisecondClockValue in: aWindow
| newText |
(Preferences smartUpdating and: [(millisecondClockValue - self timeOfLastListUpdate) > 8000]) "Not more often than once every 8 seconds"
ifTrue:
[self updateListsAndCodeIn: aWindow.
timeOfLastListUpdate := millisecondClockValue].
newText := self contentsIsString
ifTrue: [self selection]
ifFalse: ["keep it short to reduce time to compute it"
self selectionPrintString ].
newText = contents ifFalse:
[contents := newText.
self changed: #contents]!
Item was changed:
----- Method: Inspector>>timeOfLastListUpdate (in category 'accessing') -----
timeOfLastListUpdate
^ timeOfLastListUpdate ifNil: [timeOfLastListUpdate := 0]!
Item was changed:
----- Method: Inspector>>toggleIndex: (in category 'selecting') -----
toggleIndex: anInteger
"The receiver has a list of variables of its inspected object. One of these
is selected. If anInteger is the index of this variable, then deselect it.
Otherwise, make the variable whose index is anInteger be the selected
item."
selectionUpdateTime := 0.
selectionIndex = anInteger
ifTrue:
["same index, turn off selection"
selectionIndex := 0.
contents := '']
ifFalse:
["different index, new selection"
selectionIndex := anInteger.
self contentsIsString
ifTrue: [contents := self selection]
ifFalse: [contents := self selectionPrintString]].
self changed: #selection.
self changed: #contents.
self changed: #selectionIndex.!
Item was changed:
----- Method: Inspector>>update (in category 'accessing') -----
update
"Reshow contents, assuming selected value may have changed."
selectionIndex = 0
ifFalse:
[self contentsIsString
ifTrue: [contents := self selection]
ifFalse: [contents := self selectionPrintString].
self changed: #contents.
self changed: #selection.
self changed: #selectionIndex]!
Item was changed:
----- Method: InspectorBrowser class>>openAsMorphOn: (in category 'as yet unclassified') -----
openAsMorphOn: anObject
"(InspectorBrowser openAsMorphOn: SystemOrganization) openInMVC"
| window inspector |
inspector := self inspect: anObject.
window := (SystemWindow labelled: anObject defaultLabelForInspector)
model: inspector.
window addMorph: (PluggableListMorph on: inspector list: #fieldList
selected: #selectionIndex changeSelected: #toggleIndex: menu: #fieldListMenu:)
frame: (0 at 0 corner: 0.3 at 0.5).
window addMorph: (PluggableTextMorph on: inspector text: #contents accept: #accept:
readSelection: nil menu: #codePaneMenu:shifted:)
frame: (0.3 at 0 corner: 1.0 at 0.5).
window addMorph: (PluggableListMorph on: inspector list: #msgList
selected: #msgListIndex changeSelected: #msgListIndex: menu: #msgListMenu:)
frame: (0 at 0.5 corner: 0.3 at 1.0).
window addMorph: (PluggableTextMorph on: inspector text: #msgText accept: #msgAccept:from:
readSelection: nil menu: #msgPaneMenu:shifted:)
frame: (0.3 at 0.5 corner: 1.0 at 1.0).
window setUpdatablePanesFrom: #(fieldList msgList).
window position: 16 at 0. "Room for scroll bar."
^ window!
Item was changed:
----- Method: InspectorBrowser>>fieldList (in category 'as yet unclassified') -----
fieldList
fieldList ifNotNil: [^ fieldList].
^ (fieldList := super fieldList)!
Item was changed:
----- Method: InspectorBrowser>>initialize (in category 'initialize-release') -----
initialize
super initialize.
fieldList := nil.
msgListIndex := 0.
self changed: #msgText
!
Item was changed:
----- Method: InspectorBrowser>>inspect: (in category 'initialize-release') -----
inspect: anObject
"Initialize the receiver so that it is inspecting anObject. There is no current selection.
Overriden so that my class is not changed to 'anObject inspectorClass'."
object := anObject.
self initialize
!
Item was changed:
----- Method: InspectorBrowser>>msgAccept:from: (in category 'as yet unclassified') -----
msgAccept: newText from: editor
| category |
category := msgListIndex = 0
ifTrue: [ClassOrganizer default]
ifFalse: [object class organization categoryOfElement: (msgList at: msgListIndex)].
^ (object class compile: newText classified: category notifying: editor) ~~ nil!
Item was changed:
----- Method: InspectorBrowser>>msgList (in category 'messages') -----
msgList
msgList ifNotNil: [^ msgList].
^ (msgList := object class selectors asSortedArray)!
Item was changed:
----- Method: InspectorBrowser>>msgListIndex: (in category 'as yet unclassified') -----
msgListIndex: anInteger
"A selection has been made in the message pane"
msgListIndex := anInteger.
self changed: #msgText.!
Item was changed:
----- Method: InspectorBrowser>>step (in category 'as yet unclassified') -----
step
| list fieldString msg |
(list := super fieldList) = fieldList ifFalse:
[fieldString := selectionIndex > 0 ifTrue: [fieldList at: selectionIndex] ifFalse: [nil].
fieldList := list.
selectionIndex := fieldList indexOf: fieldString ifAbsent: [0].
self changed: #fieldList.
self changed: #selectionIndex].
list := msgList. msgList := nil. "force recomputation"
list = self msgList ifFalse:
[msg := msgListIndex > 0 ifTrue: [list at: msgListIndex] ifFalse: [nil].
msgListIndex := msgList indexOf: msg ifAbsent: [0].
self changed: #msgList.
self changed: #msgListIndex].
super step!
Item was changed:
----- Method: MessageNames>>copyName (in category 'message list menu') -----
copyName
"Copy the current selector to the clipboard"
| selector |
(selector := self selectorList at: selectorListIndex ifAbsent: [nil]) ifNotNil:
[Clipboard clipboardText: selector asString asText]!
Item was changed:
----- Method: MessageNames>>searchString (in category 'search') -----
searchString
"Answer the current searchString, initializing it if need be"
| pane |
searchString isEmptyOrNil ifTrue:
[searchString := 'type here, then hit Search'.
pane := self containingWindow findDeepSubmorphThat:
[:m | m knownName = 'Search'] ifAbsent: ["this happens during window creation" ^ searchString].
pane setText: searchString.
pane setTextMorphToSelectAllOnMouseEnter.
pane selectAll].
^ searchString!
Item was changed:
----- Method: MessageNames>>selectorList (in category 'selector list') -----
selectorList
"Answer the selectorList"
selectorList ifNil:
[self computeSelectorListFromSearchString.
selectorListIndex := selectorList size > 0
ifTrue: [1]
ifFalse: [0].
messageList := nil].
^ selectorList!
Item was changed:
----- Method: MessageNames>>selectorListIndex: (in category 'selector list') -----
selectorListIndex: anInteger
"Set the selectorListIndex as specified, and propagate consequences"
selectorListIndex := anInteger.
selectorListIndex = 0
ifTrue: [^ self].
messageList := nil.
self changed: #selectorListIndex.
self changed: #messageList!
Item was changed:
----- Method: MessageNames>>showOnlyImplementedSelectors (in category 'search') -----
showOnlyImplementedSelectors
"Caution -- can be slow!! Filter my selector list down such that it only
shows selectors that are actually implemented somewhere in the system."
self okToChange
ifTrue: [Cursor wait
showWhile: [selectorList := self systemNavigation allSelectorsWithAnyImplementorsIn: selectorList.
self changed: #selectorList.
self changed: #messageList]]!
Item was changed:
----- Method: MessageSet>>adjustWindowTitleAfterFiltering (in category 'private') -----
adjustWindowTitleAfterFiltering
"Set the title of the receiver's window, if any, to reflect the just-completed filtering"
| aWindow existingLabel newLabel |
(aWindow := self containingWindow) ifNil: [^ self].
(existingLabel := aWindow label) isEmptyOrNil ifTrue: [^ self].
(((existingLabel size < 3) or: [existingLabel last ~~ $]]) or: [(existingLabel at: (existingLabel size - 1)) isDigit not]) ifTrue: [^ self].
existingLabel size to: 1 by: -1 do:
[:anIndex | ((existingLabel at: anIndex) == $[) ifTrue:
[newLabel := (existingLabel copyFrom: 1 to: anIndex),
'Filtered: ',
messageList size printString,
']'.
^ aWindow setLabel: newLabel]]
!
Item was changed:
----- Method: MessageSet>>contents:notifying: (in category 'private') -----
contents: aString notifying: aController
"Compile the code in aString. Notify aController of any syntax errors.
Answer false if the compilation fails. Otherwise, if the compilation
created a new method, deselect the current selection. Then answer true."
| category selector class oldSelector |
self okayToAccept ifFalse: [^ false].
self setClassAndSelectorIn: [:c :os | class := c. oldSelector := os].
class ifNil: [^ false].
(oldSelector ~~ nil and: [oldSelector first isUppercase]) ifTrue:
[oldSelector = #Comment ifTrue:
[class comment: aString stamp: Utilities changeStamp.
self changed: #annotation.
self clearUserEditFlag.
^ false].
oldSelector = #Definition ifTrue:
["self defineClass: aString notifying: aController."
class subclassDefinerClass
evaluate: aString
notifying: aController
logged: true.
self clearUserEditFlag.
^ false].
oldSelector = #Hierarchy ifTrue:
[self inform: 'To change the hierarchy, edit the class definitions'.
^ false]].
"Normal method accept"
category := class organization categoryOfElement: oldSelector.
selector := class compile: aString
classified: category
notifying: aController.
selector == nil ifTrue: [^ false].
self noteAcceptanceOfCodeFor: selector.
selector == oldSelector ifFalse:
[self reformulateListNoting: selector].
contents := aString copy.
self changed: #annotation.
^ true!
Item was changed:
----- Method: MessageSet>>dragPassengerFor:inMorph: (in category 'drag and drop') -----
dragPassengerFor: item inMorph: dragSource
| transferType |
transferType := self dragTransferTypeForMorph: dragSource.
transferType == #messageList
ifTrue: [^self selectedClassOrMetaClass->(item contents findTokens: ' ') second asSymbol].
transferType == #classList
ifTrue: [^self selectedClass].
^nil!
Item was changed:
----- Method: MessageSet>>filterFrom: (in category 'filtering') -----
filterFrom: aBlock
"Filter the receiver's list down to only those items that satisfy aBlock, which takes a class an a selector as its arguments."
| newList |
newList := messageList select:
[:anElement |
self class parse: anElement toClassAndSelector: [ :cls :sel |
(self class isPseudoSelector: sel) not and: [ aBlock value: cls value: sel ]]].
self setFilteredList: newList!
Item was changed:
----- Method: MessageSet>>growable: (in category 'message list') -----
growable: aBoolean
"Give or take away the growable trait; when a message set is growable, methods submitted within it will be added to its message list"
growable := aBoolean!
Item was changed:
----- Method: MessageSet>>selectedClassName (in category 'class list') -----
selectedClassName
"Answer the name of class of the currently selected message. Answer nil if no selection
exists."
| cls |
(cls := self selectedClass) ifNil: [^ nil].
^ cls name!
Item was changed:
----- Method: MessageSet>>selectedMessageName (in category 'message list') -----
selectedMessageName
"Answer the name of the currently selected message."
"wod 6/16/1998: answer nil if none are selected."
messageListIndex = 0 ifTrue: [^ nil].
^ self setClassAndSelectorIn: [:class :selector | ^ selector]!
Item was changed:
----- Method: MessageSet>>setClassAndSelectorIn: (in category 'private') -----
setClassAndSelectorIn: csBlock
| sel |
"Decode strings of the form <className> [class] <selectorName>."
self flag: #mref. "compatibility with pre-MethodReference lists"
sel := self selection.
^(sel isKindOf: MethodReference) ifTrue: [
sel setClassAndSelectorIn: csBlock
] ifFalse: [
MessageSet parse: sel toClassAndSelector: csBlock
]!
Item was changed:
----- Method: MessageSet>>setContentsToForceRefetch (in category 'contents') -----
setContentsToForceRefetch
"Set the receiver's contents such that on the next update the contents will be formulated afresh. This is a critical and obscure difference between Browsers on the one hand and MessageSets on the other, and has over the years been the source of much confusion and much difficulty. By centralizing the different handling here, we don't need so many idiosyncratic overrides in MessageSet any more"
contents := ''!
Item was changed:
----- Method: MethodHolder>>changeMethodSelectorTo: (in category 'miscellaneous') -----
changeMethodSelectorTo: aSelector
"Change my method selector as noted. Reset currentCompiledMethod"
methodSelector := aSelector.
currentCompiledMethod := methodClass compiledMethodAt: aSelector ifAbsent: [nil]!
Item was changed:
----- Method: MethodHolder>>identifyScript (in category 'miscellaneous') -----
identifyScript
| msg aPlayer |
msg := methodClass isUniClass
ifTrue:
[aPlayer := methodClass someInstance.
aPlayer costume
ifNotNil:
['This holds code for a script
named ', methodSelector, ' belonging
to an object named ', aPlayer externalName]
ifNil:
['This formerly held code for a script
named ', methodSelector, ' for a Player
who once existed but now is moribund.']]
ifFalse:
['This holds code for the method
named ', methodSelector, '
for class ', methodClass name].
self inform: msg!
Item was changed:
----- Method: MethodHolder>>methodClass:methodSelector: (in category 'miscellaneous') -----
methodClass: aClass methodSelector: aSelector
methodClass := aClass.
methodSelector := aSelector.
currentCompiledMethod := aClass compiledMethodAt: aSelector ifAbsent: [nil]!
Item was changed:
----- Method: ObjectExplorer>>chasePointers (in category 'menus') -----
chasePointers
"Open a PointerFinder on the selected item"
| path sel savedRoot saved |
path := OrderedCollection new.
sel := currentSelection.
[ sel isNil ] whileFalse: [ path addFirst: sel asString. sel := sel parent ].
path addFirst: #openPath.
path := path asArray.
savedRoot := rootObject.
saved := self object.
[ rootObject := nil.
self changed: #getList.
(Smalltalk includesKey: #PointerFinder)
ifTrue: [PointerFinder on: saved]
ifFalse: [self objectReferencesToSelection ]]
ensure: [ rootObject := savedRoot.
self changed: #getList.
self changed: path.
]!
Item was changed:
----- Method: ObjectExplorer>>defsOfSelection (in category 'menus') -----
defsOfSelection
"Open a browser on all defining references to the selected instance variable, if that's what's currently selected."
| aClass sel |
(aClass := self parentObject class) isVariable ifTrue: [^ self changed: #flash].
sel := self selector.
self systemNavigation browseAllStoresInto: sel from: aClass!
Item was changed:
----- Method: ObjectExplorer>>explorerKey:from: (in category 'menus') -----
explorerKey: aChar from: view
"Similar to #genericMenu:..."
| insideObject parentObject |
currentSelection ifNotNil: [
insideObject := self object.
parentObject := self parentObject.
inspector ifNil: [inspector := Inspector new].
inspector
inspect: parentObject;
object: insideObject.
aChar == $i ifTrue: [^ self inspectSelection].
aChar == $I ifTrue: [^ self exploreSelection].
aChar == $b ifTrue: [^ inspector browseMethodFull].
aChar == $h ifTrue: [^ inspector classHierarchy].
aChar == $c ifTrue: [^ inspector copyName].
aChar == $p ifTrue: [^ inspector browseFullProtocol].
aChar == $N ifTrue: [^ inspector browseClassRefs].
aChar == $t ifTrue: [^ inspector tearOffTile].
aChar == $v ifTrue: [^ inspector viewerForValue]].
^ self arrowKey: aChar from: view!
Item was changed:
----- Method: ObjectExplorer>>monitorList (in category 'monitoring') -----
monitorList
^monitorList ifNil: [ monitorList := WeakIdentityKeyDictionary new ].!
Item was changed:
----- Method: ObjectExplorer>>referencesToSelection (in category 'menus') -----
referencesToSelection
"Open a browser on all references to the selected instance variable, if that's what's currently selected."
| aClass sel |
(aClass := self parentObject class) isVariable ifTrue: [^ self changed: #flash].
sel := self selector.
self systemNavigation browseAllAccessesTo: sel from: aClass!
Item was changed:
----- Method: ObjectExplorer>>stopMonitoring (in category 'monitoring') -----
stopMonitoring
monitorList := nil.
self world stopStepping: self selector: #step!
Item was changed:
----- Method: OrderedCollection>>inspectorClass (in category '*Tools-Inspector') -----
inspectorClass
"Answer the class of the inspector to be used on the receiver. Called by inspect;
use basicInspect to get a normal (less useful) type of inspector."
^OrderedCollectionInspector!
Item was changed:
----- Method: OrderedCollectionInspector>>selectedObjectIndex (in category 'as yet unclassified') -----
selectedObjectIndex
"Answer the index of the inspectee's collection that the current selection refers to."
| basicIndex |
basicIndex := selectionIndex - 2 - object class instSize.
^ (object size <= (self i1 + self i2) or: [basicIndex <= self i1])
ifTrue: [basicIndex]
ifFalse: [object size - (self i1 + self i2) + basicIndex]!
Item was changed:
----- Method: PackagePaneBrowser>>changeCategoryForClass:srcSystemCategory:atListMorph:internal:copy: (in category 'dragNDrop') -----
changeCategoryForClass: class srcSystemCategory: srcSystemCategorySel atListMorph: dstListMorph internal: internal copy: copyFlag
"only move semantic"
| newClassCategory success |
self flag: #stringSymbolProblem.
success := copyFlag not ifFalse: [^ false].
newClassCategory := self dstCategoryDstListMorph: dstListMorph internal: internal.
(success := newClassCategory notNil & (newClassCategory ~= class category))
ifTrue:
[class category: newClassCategory.
self changed: #classList.
internal ifFalse: [self selectClass: class]].
^ success!
Item was changed:
----- Method: PointerFinder>>goal: (in category 'application') -----
goal: anObject
goal := anObject!
Item was changed:
----- Method: PointerFinder>>initialize (in category 'application') -----
initialize
parents := IdentityDictionary new: 20000.
parents at: Smalltalk put: nil.
parents at: Processor put: nil.
parents at: self put: nil.
toDo := OrderedCollection new: 5000.
toDo add: Smalltalk.
toDoNext := OrderedCollection new: 5000!
Item was changed:
----- Method: PointerFinder>>pointerListIndex: (in category 'pointer-list') -----
pointerListIndex: anInteger
pointerListIndex := anInteger.
self changed: #pointerListIndex!
Item was changed:
----- Method: PointerFinder>>search (in category 'application') -----
search
Smalltalk garbageCollect.
self initialize.
Cursor wait showWhile: [
[[toDo isEmpty or: [self followObject: toDo removeFirst]] whileFalse.
toDo isEmpty and: [toDoNext isEmpty not]]
whileTrue:
[toDo := toDoNext.
toDoNext := OrderedCollection new: 5000]].
self buildList!
Item was changed:
----- Method: ProcessBrowser class>>dumpTallyOnTranscript: (in category 'CPU utilization') -----
dumpTallyOnTranscript: tally
"tally is from ProcessorScheduler>>tallyCPUUsageFor:
Dumps lines with percentage of time, hash of process, and a friendly name"
tally sortedCounts do: [ :assoc | | procName |
procName := (self nameAndRulesFor: assoc value) first.
Transcript print: (((assoc key / tally size) * 100.0) roundTo: 1);
nextPutAll: '% ';
print: assoc value identityHash; space;
nextPutAll: procName;
cr.
].
Transcript flush.!
Item was changed:
----- Method: ProcessBrowser class>>resumeProcess: (in category 'process control') -----
resumeProcess: aProcess
| priority |
priority := self suspendedProcesses
removeKey: aProcess
ifAbsent: [aProcess priority].
aProcess priority: priority.
aProcess suspendedContext ifNotNil: [ aProcess resume ]
!
Item was changed:
----- Method: ProcessBrowser class>>setProcess:toPriority: (in category 'process control') -----
setProcess: aProcess toPriority: priority
| oldPriority |
oldPriority := self suspendedProcesses at: aProcess ifAbsent: [ ].
oldPriority ifNotNil: [ self suspendedProcesses at: aProcess put: priority ].
aProcess priority: priority.
^oldPriority!
Item was changed:
----- Method: ProcessBrowser class>>suspendProcess: (in category 'process control') -----
suspendProcess: aProcess
| priority |
priority := aProcess priority.
self suspendedProcesses at: aProcess put: priority.
"Need to take the priority down below the caller's
so that it can keep control after signaling the Semaphore"
(aProcess suspendingList isKindOf: Semaphore)
ifTrue: [aProcess priority: Processor lowestPriority.
aProcess suspendingList signal].
[aProcess suspend]
on: Error
do: [:ex | self suspendedProcesses removeKey: aProcess].
aProcess priority: priority.
!
Item was changed:
----- Method: ProcessBrowser class>>suspendedProcesses (in category 'process control') -----
suspendedProcesses
"Answer a collection of processes that my instances have suspended.
This is so that they don't get garbage collected."
^ SuspendedProcesses
ifNil: [SuspendedProcesses := IdentityDictionary new]!
Item was changed:
----- Method: ProcessBrowser>>changeStackListTo: (in category 'stack list') -----
changeStackListTo: aCollection
stackList := aCollection.
self changed: #stackNameList.
self stackListIndex: 0!
Item was changed:
----- Method: ProcessBrowser>>chasePointers (in category 'process actions') -----
chasePointers
| saved |
selectedProcess
ifNil: [^ self].
saved := selectedProcess.
[selectedProcess := nil.
(Smalltalk includesKey: #PointerFinder)
ifTrue: [PointerFinder on: saved]
ifFalse: [self inspectPointers]]
ensure: [selectedProcess := saved]!
Item was changed:
----- Method: ProcessBrowser>>prettyNameForProcess: (in category 'process list') -----
prettyNameForProcess: aProcess
| nameAndRules |
aProcess ifNil: [ ^'<nil>' ].
nameAndRules := self nameAndRulesFor: aProcess.
^ aProcess browserPrintStringWith: nameAndRules first!
Item was changed:
----- Method: ProcessBrowser>>processListMenu: (in category 'process list') -----
processListMenu: menu
| pw |
selectedProcess
ifNotNil: [| nameAndRules |
nameAndRules := self nameAndRulesForSelectedProcess.
menu addList: {{'inspect (i)'. #inspectProcess}. {'explore (I)'. #exploreProcess}. {'inspect Pointers (P)'. #inspectPointers}}.
(Smalltalk includesKey: #PointerFinder)
ifTrue: [ menu add: 'chase pointers (c)' action: #chasePointers. ].
nameAndRules second
ifTrue: [menu add: 'terminate (t)' action: #terminateProcess.
selectedProcess isSuspended
ifTrue: [menu add: 'resume (r)' action: #resumeProcess]
ifFalse: [menu add: 'suspend (s)' action: #suspendProcess]].
nameAndRules third
ifTrue: [menu addList: {{'change priority (p)'. #changePriority}. {'debug (d)'. #debugProcess}}].
menu addList: {{'profile messages (m)'. #messageTally}}.
(selectedProcess suspendingList isKindOf: Semaphore)
ifTrue: [menu add: 'signal Semaphore (S)' action: #signalSemaphore].
menu add: 'full stack (k)' action: #moreStack.
menu addLine].
menu addList: {{'find context... (f)'. #findContext}. {'find again (g)'. #nextContext}}.
menu addLine.
menu
add: (self isAutoUpdating
ifTrue: ['turn off auto-update (a)']
ifFalse: ['turn on auto-update (a)'])
action: #toggleAutoUpdate.
menu add: 'update list (u)' action: #updateProcessList.
pw := Smalltalk at: #CPUWatcher ifAbsent: [].
pw ifNotNil: [
menu addLine.
pw isMonitoring
ifTrue: [ menu add: 'stop CPUWatcher' action: #stopCPUWatcher ]
ifFalse: [ menu add: 'start CPUWatcher' action: #startCPUWatcher ]
].
^ menu!
Item was changed:
----- Method: ProcessBrowser>>processNameList (in category 'process list') -----
processNameList
"since processList is a WeakArray, we have to strengthen the result"
| pw tally |
pw := Smalltalk at: #CPUWatcher ifAbsent: [ ].
tally := pw ifNotNil: [ pw current ifNotNil: [ pw current tally ] ].
^ (processList asOrderedCollection
copyWithout: nil)
collect: [:each | | percent |
percent := tally
ifNotNil: [ ((((tally occurrencesOf: each) * 100.0 / tally size) roundTo: 1)
asString padded: #left to: 2 with: $ ), '% ' ]
ifNil: [ '' ].
percent, (self prettyNameForProcess: each)
] !
Item was changed:
----- Method: ProcessBrowser>>selectedMethod (in category 'accessing') -----
selectedMethod
^ methodText ifNil: [methodText := selectedContext
ifNil: ['']
ifNotNil: [| pcRange |
methodText := [ selectedContext sourceCode ]
ifError: [ :err :rcvr | 'error getting method text' ].
pcRange := self pcRange.
methodText asText
addAttribute: TextColor red
from: pcRange first
to: pcRange last;
addAttribute: TextEmphasis bold
from: pcRange first
to: pcRange last]]!
Item was changed:
----- Method: ProcessBrowser>>stackListMenu: (in category 'stack list') -----
stackListMenu: aMenu
| menu |
selectedContext
ifNil: [^ aMenu].
menu := aMenu
labels: 'inspect context (c)
explore context (C)
inspect receiver (i)
explore receiver (I)
browse (b)'
lines: #(2 4 )
selections: #(#inspectContext #exploreContext #inspectReceiver #exploreReceiver #browseContext ).
^ menu!
Item was changed:
----- Method: ProcessBrowser>>startCPUWatcher (in category 'initialize-release') -----
startCPUWatcher
"Answers whether I started the CPUWatcher"
| pw |
pw := Smalltalk at: #CPUWatcher ifAbsent: [ ^self ].
pw ifNotNil: [
pw isMonitoring ifFalse: [
pw startMonitoringPeriod: 5 rate: 100 threshold: 0.85.
self setUpdateCallbackAfter: 7.
^true
]
].
^false
!
Item was changed:
----- Method: ProcessBrowser>>stopAutoUpdate (in category 'updating') -----
stopAutoUpdate
autoUpdateProcess ifNotNil: [
autoUpdateProcess terminate.
autoUpdateProcess := nil].
self updateProcessList!
Item was changed:
----- Method: ProcessBrowser>>stopCPUWatcher (in category 'initialize-release') -----
stopCPUWatcher
| pw |
pw := Smalltalk at: #CPUWatcher ifAbsent: [ ^self ].
pw ifNotNil: [
pw stopMonitoring.
self updateProcessList.
startedCPUWatcher := false. "so a manual restart won't be killed later"
]
!
Item was changed:
----- Method: ProcessBrowser>>updateProcessList (in category 'process list') -----
updateProcessList
| oldSelectedProcess newIndex now |
now := Time millisecondClockValue.
now - lastUpdate < 500
ifTrue: [^ self].
"Don't update too fast"
lastUpdate := now.
oldSelectedProcess := selectedProcess.
processList := selectedProcess := selectedSelector := nil.
Smalltalk garbageCollectMost.
"lose defunct processes"
processList := Process allSubInstances
reject: [:each | each isTerminated].
processList := processList
sortBy: [:a :b | a priority >= b priority].
processList := WeakArray withAll: processList.
newIndex := processList
indexOf: oldSelectedProcess
ifAbsent: [0].
self changed: #processNameList.
self processListIndex: newIndex!
Item was changed:
----- Method: ProcessBrowser>>updateStackList: (in category 'stack list') -----
updateStackList: depth
| suspendedContext oldHighlight |
selectedProcess
ifNil: [^ self changeStackListTo: nil].
(stackList notNil and: [ stackListIndex > 0 ])
ifTrue: [oldHighlight := stackList at: stackListIndex].
selectedProcess == Processor activeProcess
ifTrue: [self
changeStackListTo: (thisContext stackOfSize: depth)]
ifFalse: [suspendedContext := selectedProcess suspendedContext.
suspendedContext
ifNil: [self changeStackListTo: nil]
ifNotNil: [self
changeStackListTo: (suspendedContext stackOfSize: depth)]].
self
stackListIndex: (stackList
ifNil: [0]
ifNotNil: [stackList indexOf: oldHighlight])!
Item was changed:
----- Method: RecentMessageSet>>contents:notifying: (in category 'contents') -----
contents: c notifying: n
| result |
result := super contents: c notifying: n.
result == true ifTrue:
[self reformulateList].
^ result!
Item was changed:
----- Method: SelectorBrowser>>implementors (in category 'as yet unclassified') -----
implementors
| aSelector |
(aSelector := self selectedMessageName) ifNotNil:
[self systemNavigation browseAllImplementorsOf: aSelector]!
Item was changed:
----- Method: SelectorBrowser>>messageListIndex: (in category 'as yet unclassified') -----
messageListIndex: anInteger
"Set the selected message selector to be the one indexed by anInteger.
Find all classes it is in."
selectorIndex := anInteger.
selectorIndex = 0
ifTrue: [^ self].
classList := self systemNavigation allImplementorsOf: self selectedMessageName.
self markMatchingClasses.
classListIndex := 0.
self changed: #messageListIndex.
"update my selection"
self changed: #classList!
Item was changed:
----- Method: SelectorBrowser>>selectedClass (in category 'as yet unclassified') -----
selectedClass
"Answer the currently selected class."
| pairString |
self flag: #mref. "allows for old-fashioned style"
classListIndex = 0 ifTrue: [^nil].
pairString := classList at: classListIndex.
(pairString isKindOf: MethodReference) ifTrue: [
^pairString actualClass
].
(pairString includes: $*) ifTrue: [pairString := pairString allButFirst].
MessageSet
parse: pairString
toClassAndSelector: [:cls :sel | ^ cls].!
Item was changed:
----- Method: SelectorBrowser>>selectedMessageName (in category 'as yet unclassified') -----
selectedMessageName
"Answer the name of the currently selected message."
| example tokens |
selectorIndex = 0 ifTrue: [^nil].
example := selectorList at: selectorIndex.
tokens := Scanner new scanTokens: example.
tokens size = 1 ifTrue: [^ tokens first].
tokens first == #'^' ifTrue: [^ nil].
(tokens second includes: $:) ifTrue: [^ example findSelector].
Symbol hasInterned: tokens second ifTrue: [:aSymbol | ^ aSymbol].
^ nil!
Item was changed:
----- Method: SelectorBrowser>>senders (in category 'as yet unclassified') -----
senders
| aSelector |
(aSelector := self selectedMessageName) ifNotNil:
[self systemNavigation browseAllCallsOn: aSelector]!
Item was changed:
----- Method: Set>>inspectorClass (in category '*Tools-Inspector') -----
inspectorClass
"Answer the class of the inspector to be used on the receiver. Called by inspect;
use basicInspect to get a normal (less useful) type of inspector."
^ SetInspector!
Item was changed:
----- Method: SetInspector>>copyName (in category 'menu commands') -----
copyName
"Copy the name of the current variable, so the user can paste it into the
window below and work with is. If collection, do (xxx at: 1)."
| sel |
self selectionIndex <= (2 + object class instSize)
ifTrue: [super copyName]
ifFalse: [sel := '(self array at: '
, (String streamContents:
[:strm | self arrayIndexForSelection storeOn: strm]) , ')'.
Clipboard clipboardText: sel asText]!
Item was changed:
----- Method: SetInspector>>removeSelection (in category 'menu') -----
removeSelection
(selectionIndex <= object class instSize) ifTrue: [^ self changed: #flash].
object remove: self selection.
selectionIndex := 0.
contents := ''.
self changed: #inspectObject.
self changed: #fieldList.
self changed: #selection.
self changed: #selectionIndex.!
Item was changed:
----- Method: StringHolder>>browseAllMessages (in category '*Tools') -----
browseAllMessages
"Create and schedule a message set browser on all implementors of all the messages sent by the current method."
| aClass aName method filteredList |
(aName := self selectedMessageName) ifNotNil: [
method := (aClass := self selectedClassOrMetaClass) compiledMethodAt: aName.
filteredList := method messages reject:
[:each | #(new initialize = ) includes: each].
self systemNavigation browseAllImplementorsOfList: filteredList asSortedCollection
title: 'All messages sent in ', aClass name, '.', aName]
!
Item was changed:
----- Method: StringHolder>>browseUnusedMethods (in category '*Tools') -----
browseUnusedMethods
| classes unsent messageList cls |
(cls := self selectedClass)
ifNil: [^ self].
classes := Array with: cls with: cls class.
unsent := Set new.
classes
do: [:c | unsent addAll: c selectors].
unsent := self systemNavigation allUnSentMessagesIn: unsent.
messageList := OrderedCollection new.
classes
do: [:c | (c selectors
select: [:s | unsent includes: s]) asSortedCollection
do: [:sel | messageList add: c name , ' ' , sel]].
self systemNavigation browseMessageList: messageList name: 'Unsent Methods in ' , cls name!
Item was changed:
----- Method: StringHolder>>browseVersions (in category '*Tools') -----
browseVersions
"Create and schedule a Versions Browser, showing all versions of the
currently selected message. Answer the browser or nil."
| selector class |
self classCommentIndicated
ifTrue: [ ClassCommentVersionsBrowser browseCommentOf: self selectedClass.
^nil ].
(selector := self selectedMessageName)
ifNil:[ self inform: 'Sorry, only actual methods have retrievable versions.'. ^nil ]
ifNotNil: [
class := self selectedClassOrMetaClass.
^VersionsBrowser
browseVersionsOf: (class compiledMethodAt: selector)
class: self selectedClass
meta: class isMeta
category: (class organization categoryOfElement: selector)
selector: selector]!
Item was changed:
----- Method: StringHolder>>copyName (in category '*Tools') -----
copyName
"Copy the current selector to the clipboard"
| selector |
(selector := self selectedMessageName) ifNotNil:
[Clipboard clipboardText: selector asString asText]!
Item was changed:
----- Method: StringHolder>>copySelector (in category '*Tools') -----
copySelector
"Copy the selected selector to the clipboard"
| selector |
(selector := self selectedMessageName) ifNotNil:
[Clipboard clipboardText: selector asString]!
Item was changed:
----- Method: StringHolder>>findMethodInChangeSets (in category '*Tools') -----
findMethodInChangeSets
"Find and open a changeSet containing the current method."
| aName |
(aName := self selectedMessageName) ifNotNil: [
ChangeSorter browseChangeSetsWithClass: self selectedClassOrMetaClass
selector: aName]!
Item was changed:
----- Method: StringHolder>>inspectInstances (in category '*Tools') -----
inspectInstances
"Inspect all instances of the selected class."
| myClass |
(myClass := self selectedClassOrMetaClass) ifNotNil:
[myClass theNonMetaClass inspectAllInstances].
!
Item was changed:
----- Method: StringHolder>>inspectSubInstances (in category '*Tools') -----
inspectSubInstances
"Inspect all instances of the selected class and all its subclasses"
| aClass |
(aClass := self selectedClassOrMetaClass) ifNotNil: [
aClass theNonMetaClass inspectSubInstances].
!
Item was changed:
----- Method: StringHolder>>messageListKey:from: (in category '*Tools') -----
messageListKey: aChar from: view
"Respond to a Command key. I am a model with a code pane, and I also
have a listView that has a list of methods. The view knows how to get
the list and selection."
| sel class |
aChar == $D ifTrue: [^ self toggleDiffing].
sel := self selectedMessageName.
aChar == $m ifTrue: "These next two put up a type in if no message selected"
[^ self useSelector: sel orGetSelectorAndSendQuery: #browseAllImplementorsOf: to: self systemNavigation].
aChar == $n ifTrue:
[^ self useSelector: sel orGetSelectorAndSendQuery: #browseAllCallsOn: to: self systemNavigation].
"The following require a class selection"
(class := self selectedClassOrMetaClass) ifNil: [^ self arrowKey: aChar from: view].
aChar == $b ifTrue: [^ Browser fullOnClass: class selector: sel].
aChar == $N ifTrue: [^ self browseClassRefs].
aChar == $i ifTrue: [^ self methodHierarchy].
aChar == $h ifTrue: [^ self classHierarchy].
aChar == $p ifTrue: [^ self browseFullProtocol].
"The following require a method selection"
sel ifNotNil:
[aChar == $o ifTrue: [^ self fileOutMessage].
aChar == $c ifTrue: [^ self copySelector].
aChar == $v ifTrue: [^ self browseVersions].
aChar == $O ifTrue: [^ self openSingleMessageBrowser].
aChar == $x ifTrue: [^ self removeMessage]].
^ self arrowKey: aChar from: view!
Item was changed:
----- Method: StringHolder>>offerDurableMenuFrom:shifted: (in category '*Tools') -----
offerDurableMenuFrom: menuRetriever shifted: aBoolean
"Pop up (morphic only) a menu whose target is the receiver and whose contents are provided by sending the menuRetriever to the receiver. The menuRetriever takes two arguments: a menu, and a boolean representing the shift state; put a stay-up item at the top of the menu."
| aMenu |
aMenu := MenuMorph new defaultTarget: self.
aMenu addStayUpItem.
self perform: menuRetriever with: aMenu with: aBoolean.
aMenu popUpInWorld!
Item was changed:
----- Method: StringHolder>>revertToPreviousVersion (in category '*Tools') -----
revertToPreviousVersion
"Revert to the previous version of the current method"
| aClass aSelector changeRecords |
self okToChange ifFalse: [^ self].
aClass := self selectedClassOrMetaClass.
aClass ifNil: [^ self changed: #flash].
aSelector := self selectedMessageName.
changeRecords := aClass changeRecordsAt: aSelector.
(changeRecords == nil or: [changeRecords size <= 1]) ifTrue: [self changed: #flash. ^ Beeper beep].
changeRecords second fileIn.
self contentsChanged
!
Item was changed:
----- Method: StringMorph>>balloonTextForClassAndMethodString (in category '*Tools') -----
balloonTextForClassAndMethodString
"Answer suitable balloon text for the receiver thought of as an encoding of the form
<className> [ class ] <selector>"
| aComment |
Preferences balloonHelpInMessageLists
ifFalse: [^ nil].
MessageSet parse: self contents asString toClassAndSelector:
[:aClass :aSelector |
(aClass notNil and: [aSelector notNil]) ifTrue:
[aComment := aClass precodeCommentOrInheritedCommentFor: aSelector]].
^ aComment
!
Item was changed:
----- Method: StringMorph>>balloonTextForLexiconString (in category '*Tools') -----
balloonTextForLexiconString
"Answer suitable balloon text for the receiver thought of as an encoding (used in Lexicons) of the form
<selector> <spaces> (<className>>)"
| aComment contentsString aSelector aClassName |
Preferences balloonHelpInMessageLists
ifFalse: [^ nil].
contentsString := self contents asString.
aSelector := contentsString upTo: $ .
aClassName := contentsString copyFrom: ((contentsString indexOf: $() + 1) to: ((contentsString indexOf: $)) - 1).
MessageSet parse: (aClassName, ' dummy') toClassAndSelector:
[:cl :sel | cl ifNotNil:
[aComment := cl precodeCommentOrInheritedCommentFor: aSelector]].
^ aComment
!
Item was changed:
----- Method: StringMorph>>balloonTextForMethodString (in category '*Tools') -----
balloonTextForMethodString
"Answer suitable balloon text for the receiver thought of as a method belonging to the currently-selected class of a browser tool."
| aWindow aCodeHolder aClass |
Preferences balloonHelpInMessageLists
ifFalse: [^ nil].
aWindow := self ownerThatIsA: SystemWindow.
(aWindow isNil or: [((aCodeHolder := aWindow model) isKindOf: CodeHolder) not])
ifTrue: [^ nil].
((aClass := aCodeHolder selectedClassOrMetaClass) isNil or:
[(aClass includesSelector: contents asSymbol) not])
ifTrue: [^ nil].
^ aClass precodeCommentOrInheritedCommentFor: contents asSymbol
!
Item was changed:
----- Method: TimeProfileBrowser>>initializeMessageList: (in category 'private') -----
initializeMessageList: anArray
messageList := anArray.
messageListIndex := 0.
contents := ''!
Item was changed:
----- Method: VersionsBrowser class>>browseVersionsOf:class:meta:category:selector:lostMethodPointer: (in category 'instance creation') -----
browseVersionsOf: method class: class meta: meta category: msgCategory selector: selector lostMethodPointer: sourcePointer
| changeList browser |
Cursor read showWhile:
[changeList := (browser := self new)
scanVersionsOf: method class: class meta: meta
category: msgCategory selector: selector].
changeList ifNil: [ self inform: 'No versions available'. ^nil ].
sourcePointer ifNotNil:
[changeList setLostMethodPointer: sourcePointer].
self open: changeList name: 'Recent versions of ' ,
selector multiSelect: false.
^browser!
Item was changed:
----- Method: VersionsBrowser class>>timeStampFor:class:reverseOrdinal: (in category 'instance creation') -----
timeStampFor: aSelector class: aClass reverseOrdinal: anInteger
"Answer the time stamp corresponding to some version of the given method, nil if none. The reverseOrdinal parameter is interpreted as: 1 = current version; 2 = last-but-one version, etc."
| method aChangeList |
method := aClass compiledMethodAt: aSelector ifAbsent: [^ nil].
aChangeList := self new
scanVersionsOf: method class: aClass meta: aClass isMeta
category: nil selector: aSelector.
^ aChangeList ifNil: [nil] ifNotNil:
[aChangeList list size >= anInteger
ifTrue:
[(aChangeList changeList at: anInteger) stamp]
ifFalse:
[nil]]!
Item was changed:
----- Method: VersionsBrowser class>>versionCountForSelector:class: (in category 'instance creation') -----
versionCountForSelector: aSelector class: aClass
"Answer the number of versions known to the system for the given class and method, including the current version. A result of greater than one means that there is at least one superseded version. Answer zero if no logged version can be obtained."
| method aChangeList |
method := aClass compiledMethodAt: aSelector ifAbsent: [^ 0].
aChangeList := self new
scanVersionsOf: method class: aClass meta: aClass isMeta
category: nil selector: aSelector.
^ aChangeList ifNil: [0] ifNotNil: [aChangeList list size]!
Item was changed:
----- Method: VersionsBrowser>>addedChangeRecord: (in category 'init & update') -----
addedChangeRecord: aChangeRecord
addedChangeRecord := aChangeRecord.
self reformulateList.!
Item was changed:
----- Method: VersionsBrowser>>findOriginalChangeSet (in category 'menu') -----
findOriginalChangeSet
| changeSet |
self currentChange ifNil: [^ self].
changeSet := self currentChange originalChangeSetForSelector: self selectedMessageName.
changeSet = #sources ifTrue:
[^ self inform: 'This version is in the .sources file.'].
changeSet ifNil:
[^ self inform: 'This version was not found in any changeset nor in the .sources file.'].
(ChangeSorter new myChangeSet: changeSet) open!
Item was changed:
----- Method: VersionsBrowser>>reformulateList (in category 'init & update') -----
reformulateList
| aMethod |
"Some uncertainty about how to deal with lost methods here"
aMethod := classOfMethod compiledMethodAt: selectorOfMethod ifAbsent: [^ self].
self scanVersionsOf: aMethod class: classOfMethod theNonMetaClass meta: classOfMethod isMeta category: (classOfMethod whichCategoryIncludesSelector: selectorOfMethod) selector: selectorOfMethod.
self changed: #list. "for benefit of mvc"
listIndex := 1.
self changed: #listIndex.
self contentsChanged
!
Item was changed:
----- Method: VersionsBrowser>>updateListsAndCodeIn: (in category 'init & update') -----
updateListsAndCodeIn: aWindow
| aMethod |
aMethod := classOfMethod compiledMethodAt: selectorOfMethod ifAbsent: [^ false].
aMethod == currentCompiledMethod
ifFalse:
["Do not attempt to formulate if there is no source pointer.
It probably means it has been recompiled, but the source hasn't been written
(as during a display of the 'save text simply?' confirmation)."
aMethod last ~= 0 ifTrue: [self reformulateList]].
^ true
!
Item was changed:
----- Method: WeakSet>>inspectorClass (in category '*Tools-Inspector') -----
inspectorClass
^ WeakSetInspector!
Item was changed:
----- Method: WeakSetInspector>>initialize (in category 'initialize-release') -----
initialize
super initialize.
flagObject := object instVarNamed: 'flag'. !
Item was changed:
----- Method: Workspace>>acceptDroppingMorph:event:inMorph: (in category 'drag and drop') -----
acceptDroppingMorph: dropee event: evt inMorph: targetMorph
"Return the dropee to its old position, and add a reference to it at the cursor point."
| bindingName externalName |
externalName := dropee externalName.
externalName := externalName isOctetString
ifTrue: [externalName] ifFalse: ['a' , externalName].
bindingName := externalName translateToLowercase, dropee identityHash printString.
targetMorph correctSelectionWithString: bindingName, ' '.
(self bindingOf: bindingName) value: dropee.
dropee rejectDropMorphEvent: evt.
^ true "success"
!
Item was changed:
----- Method: Workspace>>acceptsDroppingMorphForReference: (in category 'drag and drop') -----
acceptsDroppingMorphForReference: trueFalse
acceptDroppedMorphs := trueFalse
!
Item was changed:
----- Method: Workspace>>appendContentsOfFile (in category 'menu commands') -----
appendContentsOfFile
"Prompt for a file, and if one is obtained, append its contents to the contents of the receiver. Caution: as currently implemented this abandons any custom style information previously in the workspace. Someone should fix this. Also, for best results you should accept the contents of the workspace before requesting this."
| aFileStream |
(aFileStream := FileList2 modalFileSelector) ifNil: [^ self].
contents := (contents ifNil: ['']) asString, aFileStream contentsOfEntireFile.
aFileStream close.
self changed: #contents!
Item was changed:
----- Method: Workspace>>convertToCurrentVersion:refStream: (in category 'object fileIn') -----
convertToCurrentVersion: varDict refStream: smartRefStrm
acceptDroppedMorphs ifNil: [acceptDroppedMorphs := false].
^super convertToCurrentVersion: varDict refStream: smartRefStrm.
!
Item was changed:
----- Method: Workspace>>setBindings: (in category 'accessing') -----
setBindings: aDictionary
"Sets the Workspace to use the specified dictionary as its namespace"
bindings := aDictionary.
!
Item was changed:
----- Method: Workspace>>toggleDroppingMorphForReference (in category 'drag and drop') -----
toggleDroppingMorphForReference
acceptDroppedMorphs := acceptDroppedMorphs not.
!
More information about the Packages
mailing list